msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

record type extension freshness check

Browse Source
This commit is contained in:
aarne
2005-02-15 10:06:30 +00:00
parent 0c4ae414ef
commit fa87001298
9 changed files with 107 additions and 60 deletions
Download Patch File Download Diff File Expand all files Collapse all files

33
lib/resource/french/MorphoFre.gf
View File

@@ -57,7 +57,15 @@ oper
mkCNomInvar : Str -> Gender -> CNom = \cas ->
mkCNomIrreg cas cas ;
mkNomReg : Str -> Gender -> CNom = \cas ->
let cass = case last cas of {
"s" => cas ;
"x" => cas ;
"z" => cas ;
_ => cas + "s"
}
in mkCNomIrreg cas cass ;
-- The definite article has quite some variation: three parameters and
-- elision. This is the simples definition we have been able to find.
@@ -111,7 +119,11 @@ oper
adjHeureux : Str -> Adj = \heureux ->
let {heureu = Predef.tk 1 heureux} in
mkAdj heureux heureu (heureu+"se") (heureu+"sement") ;
mkAdj heureux (heureu+"s") (heureu+"se") (heureu+"sement") ;
adjBanal : Str -> Adj = \banal ->
let {bana = Predef.tk 1 banal} in
mkAdj banal (bana + "ux") (banal+"e") (banal+"ement") ;
adjJeune : Str -> Adj = \jeune ->
mkAdj jeune (jeune+"s") jeune (jeune+"ment") ;
@@ -126,6 +138,23 @@ oper
let {ch = Predef.tk 2 cher} in
mkAdj cher (cher + "s") (ch + "ère") (ch + "èrement") ;
mkAdjReg : Str -> Adj = \creux ->
case Predef.dp 3 creux of {
"eux" => adjHeureux creux ;
_ => case Predef.dp 2 creux of {
"al" => adjBanal creux ;
"en" => adjIndien creux ;
"on" => adjIndien creux ;
"er" => adjCher creux ;
_ => case Predef.dp 1 creux of {
"s" => adjFrancais creux ;
"e" => adjJeune creux ;
"é" => adjJoli creux ;
"i" => adjJoli creux ;
_ => adjGrand creux
}
}
} ;
--2 Personal pronouns

3
lib/resource/french/SyntaxFre.gf
View File

@@ -1,6 +1,7 @@
--# -path=.:../romance:../../prelude
instance SyntaxFre of SyntaxRomance = TypesFre ** open Prelude, (CO=Coordination), MorphoFre in {
instance SyntaxFre of SyntaxRomance = TypesFre **
open Prelude, (CO=Coordination), MorphoFre in {
flags optimize=parametrize ;

2
lib/resource/romance/CategoriesRomance.gf
View File

@@ -49,7 +49,7 @@ lincat
AP = Adjective ;
AS = Adjective ** {mp,mn : Mode} ; --- "more difficult for him to come than..."
A2S = Adjective ** {s2 : Preposition} ;
AV = Adjective ;
AV = Adjective ** {c : CaseA} ;
A2V = Adjective ** {s2 : Preposition} ;
V = Verb ;

8
lib/resource/romance/ClauseRomance.gf
View File

@@ -17,17 +17,15 @@ incomplete concrete ClauseRomance of Clause = CategoriesRomance **
SPredV2A np v x y = predVerbClause np v (complDitransAdjVerb v x y) ;
SPredSubjV2V np v x y = predVerbClause np v (complDitransVerbVerb False v x y) ;
SPredObjV2V np v x y = predVerbClause np v (complDitransVerbVerb True v x y) ;
{-
SPredV2S np v x y = predVerbClause np v (complDitransSentVerb v x y) ;
SPredV2Q np v x y = predVerbClause np v (complDitransQuestVerb v x y) ;
-}
-- SPredV2S np v x y = predVerbClause np v (complDitransSentVerb v x y) ;
-- SPredV2Q np v x y = predVerbClause np v (complDitransQuestVerb v x y) ;
SPredAP np v = predCopula np (complAdjective v) ;
SPredSuperl np a = predCopula np (complAdjective (superlAdjPhrase a)) ;
SPredCN np v = predCopula np (complCommNoun v) ;
SPredNP np v = predCopula np (complNounPhrase v) ;
SPredPP np v = predCopula np (complAdverb v) ;
{-
SPredAV np v x = predCopula np (complVerbAdj v x) ;
{-
SPredObjA2V np v x y = predCopula np (complVerbAdj2 True v x y) ;
SPredProgVP = progressiveClause ;

82
lib/resource/romance/SyntaxRomance.gf
View File

@@ -215,7 +215,7 @@ oper
--3 Comparison adjectives
--
-- The type is defined in $types.Romance.gf$. Syntax adds to lexicon the position
-- The type is defined in $TypesRomance$. Syntax adds to lexicon the position
-- information.
AdjDegr = AdjComp ** {p : Bool} ;
@@ -489,6 +489,11 @@ oper
complAdverb : Adverb -> Complemnt = \dehors ->
complCopula (\\_,_,_ => dehors.s) ;
complVerbAdj : (Adjective ** {c : CaseA}) -> VerbPhrase -> Complemnt = \facile,ouvrir ->
complCopula (\\g,n,p =>
facile.s ! AF g n ++ prepCase facile.c ++
ouvrir.s ! VIInfinit ! g ! n ! p) ;
-- Passivization is like adjectival predication.
passVerb : Verb -> Complemnt = \aimer ->
@@ -531,6 +536,11 @@ oper
-- More will be needed when we add ditransitive verbs.
complTransVerb : TransVerb -> NounPhrase -> Complemnt = \aime,jean ->
complTransVerbGen aime jean (\\_,_,_ => []) ;
complTransVerbGen : TransVerb -> NounPhrase ->
(Gender => Number => Person => Str) -> Complemnt =
\aime,jean,ici ->
let
clit = andB (isNounPhraseClit jean) (isTransVerbClit aime) ;
Jean = jean.s ! (case2pformClit aime.c) ;
@@ -538,9 +548,12 @@ oper
(aime.s ! VPart (pgen2gen jean.g) jean.n)
(aime.s ! VPart Masc Sg)
in
\\_,_,_ => case clit of {
True => {clit = Jean ; part = aimee ; compl = []} ;
False => {clit = [] ; part = aimee ; compl = Jean}
\\g,n,p =>
let Ici = ici ! g ! n ! p
in
case clit of {
True => {clit = Jean ; part = aimee ; compl = Ici} ;
False => {clit = [] ; part = aimee ; compl = Jean ++ Ici}
} ;
----- add auxVerb to Complemnt to switch to $esse$ in refl ?
@@ -625,35 +638,23 @@ oper
complDitransAdjVerb :
TransVerb -> NounPhrase -> AdjPhrase -> Complemnt = \rend,toi,sec ->
let
rendtoi = complTransVerb rend toi
in
\\g,n,p =>
let rt = rendtoi ! g ! n ! p in
{clit = rt.clit ; part = rt.part ;
compl = rt.compl ++ sec.s ! AF g n
} ;
complTransVerbGen rend toi (\\g,n,_ => sec.s ! AF g n) ;
DitransVerbVerb = TransVerb ** {c3 : CaseA} ;
complDitransVerbVerb :
Bool -> DitransVerbVerb -> NounPhrase -> VerbPhrase -> Complemnt =
\obj, demander, toi, nager ->
let
rendtoi = complTransVerb demander toi
in
\\g,n,p =>
let
rt = rendtoi ! g ! n ! p ;
agr : Gender * Number * Person = case obj of {
True => <pgen2gen toi.g, toi.n, toi.p> ;
False => <g, n, p>
}
in
{clit = rt.clit ; part = rt.part ;
compl = rt.compl ++ prepCase demander.c ++
nager.s ! VIInfinit ! agr.p1 ! agr.p2 ! agr.p3
} ;
complTransVerbGen demander toi
(\\g,n,p =>
let
agr : Gender * Number * Person = case obj of {
True => <pgen2gen toi.g, toi.n, toi.p> ;
False => <g, n, p>
}
in
prepCase demander.c ++
nager.s ! VIInfinit ! agr.p1 ! agr.p2 ! agr.p3) ;
--2 Adverbs
@@ -763,27 +764,28 @@ oper
co = comp ! pgen2gen np.g ! np.n ! np.p ;
la = co.clit ;
ici = co.compl ;
aimee = co.part ;
aime : TMode -> Str = \t -> verb.s ! (VFin t np.n np.p) ;
avoir : TMode -> Str = \t -> (auxVerb verb).s ! (VFin t np.n np.p) ;
aimee = co.part ;
aimer = verb.s ! VInfin ;
avoirr = (auxVerb verb).s ! VInfin
in
\\b => table {
ClPres Simul m => <jean, posNeg b (la ++ aime (VPres m)) ici> ;
ClPres a m => <jean, posNeg b (la ++ avoir (VPres m)) (aimee ++ ici)> ;
ClImperf Simul m => <jean, posNeg b (la ++ aime (VImperf m)) ici> ;
ClImperf a m => <jean, posNeg b (la ++ avoir (VImperf m)) (aimee ++ ici)> ;
ClPasse Simul => <jean, posNeg b (la ++ aime VPasse) ici> ;
ClPasse a => <jean, posNeg b (la ++ avoir VPasse) (aimee ++ ici)> ;
ClFut Simul => <jean, posNeg b (la ++ aime VFut) ici> ;
ClFut a => <jean, posNeg b (la ++ avoir VFut) (aimee ++ ici)> ;
ClCondit Simul => <jean, posNeg b (la ++ aime VFut) ici> ;
ClCondit a => <jean, posNeg b (la ++ avoir VFut) (aimee ++ ici)> ;
ClInfinit Simul => <jean, posNeg b (la ++ aimer) ici> ;
ClInfinit a => <jean, posNeg b (la ++ avoirr) (aimee ++ ici)>
ClPres Simul m => <jean, posNeg b (la ++ aime (VPres m)) ici> ;
ClPres a m => <jean, posNeg b (la ++ avoir (VPres m)) (aimee ++ ici)> ;
ClImperf Simul m => <jean, posNeg b (la ++ aime (VImperf m)) ici> ;
ClImperf a m => <jean, posNeg b (la ++ avoir (VImperf m)) (aimee ++ ici)> ;
ClPasse Simul => <jean, posNeg b (la ++ aime VPasse) ici> ;
ClPasse a => <jean, posNeg b (la ++ avoir VPasse) (aimee ++ ici)> ;
ClFut Simul => <jean, posNeg b (la ++ aime VFut) ici> ;
ClFut a => <jean, posNeg b (la ++ avoir VFut) (aimee ++ ici)> ;
ClCondit Simul => <jean, posNeg b (la ++ aime VFut) ici> ;
ClCondit a => <jean, posNeg b (la ++ avoir VFut) (aimee ++ ici)> ;
ClInfinit Simul => <jean, posNeg b (la ++ aimer) ici> ;
ClInfinit a => <jean, posNeg b (la ++ avoirr) (aimee ++ ici)>
} ;
--3 Sentence-complement verbs
--
-- Sentence-complement verbs take sentences as complements.

8
src/GF/Compile/CheckGrammar.hs
View File

@@ -276,7 +276,7 @@ computeLType gr t = do
r' <- comp r
s' <- comp s
case (r',s') of
(RecType rs, RecType ss) -> return $ RecType (rs ++ ss)
(RecType rs, RecType ss) -> checkErr $ plusRecType r' s'
_ -> return $ ExtR r' s'
_ | isPredefConstant ty -> return ty
@@ -414,9 +414,13 @@ inferLType gr trm = case trm of
rT' <- comp rT
(s',sT) <- infer s
sT' <- comp sT
let trm' = ExtR r' s'
---- trm' <- checkErr $ plusRecord r' s'
case (rT', sT') of
(RecType rs, RecType ss) -> return (trm', RecType (rs ++ ss))
(RecType rs, RecType ss) -> do
rt <- checkErr $ plusRecType rT' sT'
return (trm', rt)
_ | rT' == typeType && sT' == typeType -> return (trm', typeType)
_ -> prtFail "records or record types expected in" trm

18
src/GF/Grammar/Compute.hs
View File

@@ -86,17 +86,21 @@ computeTerm gr = comp where
t' <- comp g t
case t' of
FV rs -> mapM (\c -> comp g (P c l)) rs >>= returnC . FV
R r -> maybe (prtBad "no value for label" l) (comp g . snd) $ lookup l r
R r -> maybe (prtBad "no value for label" l) (comp g . snd) $
lookup l $ reverse r
ExtR (R a) b -> -- NOT POSSIBLE both a and b records!
case comp g (P (R a) l) of
Ok v -> return v
_ -> comp g (P b l)
ExtR a (R b) ->
case comp g (P (R b) l) of
Ok v -> return v
_ -> comp g (P a l)
--- { - --- this is incorrect, since b can contain the proper value
ExtR (R a) b -> -- NOT POSSIBLE both a and b records!
case comp g (P (R a) l) of
Ok v -> return v
_ -> comp g (P b l)
--- - } ---
Alias _ _ r -> comp g (P r l)
S (T i cs) e -> prawitz g i (flip P l) cs e
@@ -207,8 +211,8 @@ computeTerm gr = comp where
(Alias _ _ d, _) -> comp g $ ExtR d s'
(_, Alias _ _ d) -> comp g $ Glue r' d
(R rs, R ss) -> return $ R (rs ++ ss)
(RecType rs, RecType ss) -> return $ RecType (rs ++ ss)
(R rs, R ss) -> plusRecord r' s'
(RecType rs, RecType ss) -> plusRecType r' s'
_ -> return $ ExtR r' s'
-- case-expand tables

5
src/GF/Grammar/Lockfield.hs
View File

@@ -24,6 +24,11 @@ import Operations
-- AR 8/2/2005 detached from compile/MkResource
lockRecType :: Ident -> Type -> Err Type
lockRecType c t@(RecType rs) =
let lab = lockLabel c in
return $ if elem lab (map fst rs)
then t --- don't add an extra copy of the lock field
else RecType (rs ++ [(lockLabel c, RecType [])])
lockRecType c t = plusRecType t $ RecType [(lockLabel c, RecType [])]
unlockRecord :: Ident -> Term -> Err Term

8
src/GF/Grammar/Macros.hs
View File

@@ -339,13 +339,17 @@ mkFunType tt t = mkProd ([(wildIdent, ty) | ty <- tt], t, []) -- nondep prod
plusRecType :: Type -> Type -> Err Type
plusRecType t1 t2 = case (unComputed t1, unComputed t2) of
(RecType r1, RecType r2) -> return (RecType (r1 ++ r2))
(RecType r1, RecType r2) -> case
filter (`elem` (map fst r1)) (map fst r2) of
[] -> return (RecType (r1 ++ r2))
ls -> Bad $ "clashing labels" +++ unwords (map prt ls)
_ -> Bad ("cannot add record types" +++ prt t1 +++ "and" +++ prt t2)
plusRecord :: Term -> Term -> Err Term
plusRecord t1 t2 =
case (t1,t2) of
(R r1, R r2 ) -> return (R (r1 ++ r2))
(R r1, R r2 ) -> return (R ([(l,v) | -- overshadowing of old fields
(l,v) <- r1, not (elem l (map fst r2)) ] ++ r2))
(_, FV rs) -> mapM (plusRecord t1) rs >>= return . FV
(FV rs,_ ) -> mapM (`plusRecord` t2) rs >>= return . FV
_ -> Bad ("cannot add records" +++ prt t1 +++ "and" +++ prt t2)