diff --git a/lib/resource/french/MorphoFre.gf b/lib/resource/french/MorphoFre.gf index a50c8294f..e9f93e001 100644 --- a/lib/resource/french/MorphoFre.gf +++ b/lib/resource/french/MorphoFre.gf @@ -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 diff --git a/lib/resource/french/SyntaxFre.gf b/lib/resource/french/SyntaxFre.gf index 9684c5c6c..24272ad3b 100644 --- a/lib/resource/french/SyntaxFre.gf +++ b/lib/resource/french/SyntaxFre.gf @@ -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 ; diff --git a/lib/resource/romance/CategoriesRomance.gf b/lib/resource/romance/CategoriesRomance.gf index de40714d5..a438d7279 100644 --- a/lib/resource/romance/CategoriesRomance.gf +++ b/lib/resource/romance/CategoriesRomance.gf @@ -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 ; diff --git a/lib/resource/romance/ClauseRomance.gf b/lib/resource/romance/ClauseRomance.gf index ee653c50a..19061bf04 100644 --- a/lib/resource/romance/ClauseRomance.gf +++ b/lib/resource/romance/ClauseRomance.gf @@ -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 ; diff --git a/lib/resource/romance/SyntaxRomance.gf b/lib/resource/romance/SyntaxRomance.gf index ecece8436..c50498b6c 100644 --- a/lib/resource/romance/SyntaxRomance.gf +++ b/lib/resource/romance/SyntaxRomance.gf @@ -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 => ; - False => - } - 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 => ; + False => + } + 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 => ; - ClPres a m => ; - ClImperf Simul m => ; - ClImperf a m => ; - ClPasse Simul => ; - ClPasse a => ; - ClFut Simul => ; - ClFut a => ; - ClCondit Simul => ; - ClCondit a => ; - ClInfinit Simul => ; - ClInfinit a => + ClPres Simul m => ; + ClPres a m => ; + ClImperf Simul m => ; + ClImperf a m => ; + ClPasse Simul => ; + ClPasse a => ; + ClFut Simul => ; + ClFut a => ; + ClCondit Simul => ; + ClCondit a => ; + ClInfinit Simul => ; + ClInfinit a => } ; + --3 Sentence-complement verbs -- -- Sentence-complement verbs take sentences as complements. diff --git a/src/GF/Compile/CheckGrammar.hs b/src/GF/Compile/CheckGrammar.hs index eef7a14d9..f4f1ccd40 100644 --- a/src/GF/Compile/CheckGrammar.hs +++ b/src/GF/Compile/CheckGrammar.hs @@ -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 diff --git a/src/GF/Grammar/Compute.hs b/src/GF/Grammar/Compute.hs index 2ddce3a6c..643621119 100644 --- a/src/GF/Grammar/Compute.hs +++ b/src/GF/Grammar/Compute.hs @@ -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 diff --git a/src/GF/Grammar/Lockfield.hs b/src/GF/Grammar/Lockfield.hs index 3cdfdaa54..f283dde93 100644 --- a/src/GF/Grammar/Lockfield.hs +++ b/src/GF/Grammar/Lockfield.hs @@ -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 diff --git a/src/GF/Grammar/Macros.hs b/src/GF/Grammar/Macros.hs index cfc71b1a5..cb4dcc526 100644 --- a/src/GF/Grammar/Macros.hs +++ b/src/GF/Grammar/Macros.hs @@ -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)