diff --git a/lib/src/french/exper/ConstructionFre.gf b/lib/src/french/exper/ConstructionFre.gf new file mode 100644 index 000000000..7ba2f37bb --- /dev/null +++ b/lib/src/french/exper/ConstructionFre.gf @@ -0,0 +1,148 @@ +--# -path=alltenses:.:../abstract + +concrete ConstructionFre of Construction = CatFre ** + open SyntaxFre, SymbolicFre, ParadigmsFre, + (L = LexiconFre), (E = ExtraFre), (I = IrregFre), (R = ResFre), (C = CommonRomance), + Prelude in { +flags coding=utf8 ; + + +lin + hungry_VP = E.ComplCN have_V2 (mkCN (mkN "faim")) ; + thirsty_VP = E.ComplCN have_V2 (mkCN (mkN "soif")) ; + has_age_VP card = mkVP have_V2 (mkNP L.year_N) ; + + have_name_Cl x y = mkCl x (mkV2 (reflV (mkV "appeler"))) y ; +---- married_Cl x y = mkCl (lin NP x) L.married_A2 (lin NP y) | mkCl (mkNP and_Conj (lin NP x) (lin NP y)) (mkA "marié") ; + +---- what_name_QCl x = mkQCl how_IAdv (mkCl (lin NP x) (reflV (mkV "appeler"))) ; +---- how_old_QCl x = mkQCl (mkIP whichSg_IDet (mkN "âge" masculine)) (lin NP x) have_V2 ; + how_far_QCl x = mkQCl (mkIAdv dative (mkIP which_IDet (mkN "distance"))) x ; + +-- some more things + weather_adjCl ap = mkCl (mkVP (mkVA (mkV I.faire_V2)) (lin AP ap)) ; + + is_right_VP = E.ComplCN have_V2 (mkCN (mkN "raison")) ; + is_wrong_VP = E.ComplCN have_V2 (mkCN (mkN "tort")) ; + + n_units_AP card cn a = mkAP (lin AdA (mkUtt (mkNP (lin CN cn)))) (lin A a) ; + + bottle_of_CN np = mkCN (lin N2 (mkN2 (mkN "bouteille" feminine) part_Prep)) np ; + cup_of_CN np = mkCN (lin N2 (mkN2 (mkN "tasse") part_Prep)) np ; + glass_of_CN np = mkCN (lin N2 (mkN2 (mkN "verre") part_Prep)) np ; + +{- +-- spatial deixis and motion verbs + + where_go_QCl np = mkQCl where_IAdv (mkCl np (mkVP L.go_V)) ; + where_come_from_QCl np = mkQCl (lin IAdv (ss "d'où")) (mkCl np (mkVP L.go_V)) ; + + go_here_VP = mkVP (mkVP L.go_V) here_Adv ; + come_here_VP = mkVP (mkVP L.come_V) here_Adv ; + come_from_here_VP = mkVP (mkVP L.come_V) (mkAdv "d'ici") ; + + go_there_VP = mkVP (mkVP L.go_V) there_Adv ; + come_there_VP = mkVP (mkVP L.come_V) there_Adv ; + come_from_there_VP = mkVP (mkVP L.come_V) (mkAdv "de là") ; +-} + +lincat + Weekday = N ; + Monthday = NP ; + Month = N ; + Year = NP ; +oper + noPrep : Prep = mkPrep [] ; + +lin + weekdayPunctualAdv w = lin Adv {s = w.s ! C.Sg} ; -- lundi + weekdayHabitualAdv w = SyntaxFre.mkAdv noPrep (mkNP the_Det w) ; -- le lundi + weekdayLastAdv w = SyntaxFre.mkAdv noPrep (mkNP the_Det (mkCN (mkA "dernier") w)) ; -- le lundi dernier + weekdayNextAdv w = SyntaxFre.mkAdv noPrep (mkNP the_Det (mkCN (mkA "prochain") w)) ; -- le lundi prochain + + monthAdv m = lin Adv {s = "en" ++ m.s ! C.Sg} ; -- en mai + yearAdv y = SyntaxFre.mkAdv (mkPrep "en") y ; + dayMonthAdv d m = ParadigmsFre.mkAdv ("le" ++ (d.s ! R.Nom).comp ++ m.s ! C.Sg) ; -- le 17 mai ---- le 1 mai should be le 1er mai + monthYearAdv m y = lin Adv {s = "en" ++ m.s ! C.Sg ++ (y.s ! R.Nom).comp} ; -- en mai 2012 + dayMonthYearAdv d m y = ParadigmsFre.mkAdv ("le" ++ (d.s ! R.Nom).comp ++ m.s ! C.Sg ++ (y.s ! R.Nom).comp) ; -- le 17 mai 2013 + + intYear = symb ; + intMonthday = symb ; + + +lincat Language = N ; + +lin InLanguage l = SyntaxFre.mkAdv (mkPrep "en") (mkNP l) ; + +lin + weekdayN w = w ; + + weekdayPN w = mkPN w ; + monthPN m = mkPN m ; + + languageCN l = mkCN l ; + languageNP l = mkNP the_Det l ; + +oper mkLanguage : Str -> N = \s -> mkN s ; + +---------------------------------------------- +---- lexicon of special names + +lin monday_Weekday = mkN "lundi" ; +lin tuesday_Weekday = mkN "mardi" ; +lin wednesday_Weekday = mkN "mercredi" ; +lin thursday_Weekday = mkN "jeudi" ; +lin friday_Weekday = mkN "vendredi" ; +lin saturday_Weekday = mkN "samedi" ; +lin sunday_Weekday = mkN "dimanche" masculine ; + +lin january_Month = mkN "janvier" ; +lin february_Month = mkN "février" ; +lin march_Month = mkN "mars" ; +lin april_Month = mkN "avril" ; +lin may_Month = mkN "mai" ; +lin june_Month = mkN "juin" ; +lin july_Month = mkN "juillet" ; +lin august_Month = mkN "août" ; +lin september_Month = mkN "septembre" ; +lin october_Month = mkN "octobre" ; +lin november_Month = mkN "novembre" ; +lin december_Month = mkN "décembre" ; + +lin afrikaans_Language = mkLanguage "afrikaans" ; +lin amharic_Language = mkLanguage "amharique" ; ---- +lin arabic_Language = mkLanguage "arabe" ; +lin bulgarian_Language = mkLanguage "bulgare" ; +lin catalan_Language = mkLanguage "catalan" ; +lin chinese_Language = mkLanguage "chinois" ; +lin danish_Language = mkLanguage "danois" ; +lin dutch_Language = mkLanguage "hollandais" ; +lin english_Language = mkLanguage "anglais" ; +lin estonian_Language = mkLanguage "estonien" ; +lin finnish_Language = mkLanguage "finnois" ; +lin french_Language = mkLanguage "français" ; +lin german_Language = mkLanguage "allemand" ; +lin greek_Language = mkLanguage "grècque" ; +lin hebrew_Language = mkLanguage "hebreu" ; +lin hindi_Language = mkLanguage "hindi" ; +lin japanese_Language = mkLanguage "japonais" ; +lin italian_Language = mkLanguage "italien" ; +lin latin_Language = mkLanguage "latin" ; +lin latvian_Language = mkLanguage "letton" ; +lin maltese_Language = mkLanguage "maltais" ; +lin nepali_Language = mkLanguage "nepali" ; +lin norwegian_Language = mkLanguage "norvégien" ; +lin persian_Language = mkLanguage "persien" ; +lin polish_Language = mkLanguage "polonais" ; +lin punjabi_Language = mkLanguage "punjabi" ; +lin romanian_Language = mkLanguage "roumain" ; +lin russian_Language = mkLanguage "russe" ; +lin sindhi_Language = mkLanguage "sindhi" ; +lin spanish_Language = mkLanguage "espagnol" ; +lin swahili_Language = mkLanguage "swahili" ; +lin swedish_Language = mkLanguage "suédois" ; +lin thai_Language = mkLanguage "thaï" ; +lin turkish_Language = mkLanguage "turque" ; +lin urdu_Language = mkLanguage "urdu" ; + +} diff --git a/lib/src/french/exper/ExtraFre.gf b/lib/src/french/exper/ExtraFre.gf new file mode 100644 index 000000000..ada77cfe6 --- /dev/null +++ b/lib/src/french/exper/ExtraFre.gf @@ -0,0 +1,89 @@ +concrete ExtraFre of ExtraFreAbs = ExtraRomanceFre ** + open CommonRomance, PhonoFre, MorphoFre, ParadigmsFre, ParamX, ResFre, Prelude in { + + flags coding=utf8 ; + lin + EstcequeS qs = {s = "est-ce" ++ elisQue ++ qs.s ! Indic} ; + EstcequeIAdvS idet qs = {s = idet.s ++ "est-ce" ++ elisQue ++ qs.s ! Indic} ; + + QueestcequeIP = { + s = table { + c => prepQue c ++ "est-ce" ++ caseQue c + } ; + a = aagr Fem Pl + } ; + + QuiestcequeIP = { + s = table { + c => prepQue c ++ "qui" ++ "est-ce" ++ caseQue c + } ; + a = aagr Fem Pl + } ; + + i8fem_Pron = mkPronoun + (elision "j") (elision "m") (elision "m") "moi" "mon" (elisPoss "m") "mes" + Fem Sg P1 ; + these8fem_NP = makeNP ["celles-ci"] Fem Pl ; + they8fem_Pron = mkPronoun + "elles" "les" "leur" "eux" "leur" "leur" "leurs" + Fem Pl P3 ; + this8fem_NP = pn2np (mkPN ["celle-ci"] Fem) ; + those8fem_NP = makeNP ["celles-là"] Fem Pl ; + we8fem_Pron = mkPronoun "nous" "nous" "nous" "nous" "notre" "notre" "nos" + Fem Pl P1 ; + whoPl8fem_IP = + {s = \\c => "les" + quelPron ! a ; a = a} + where {a = aagr Fem Pl} ; + whoSg8fem_IP = + {s = \\c => "la" + quelPron ! a ; a = a} + where {a = aagr Fem Pl} ; + + youSg8fem_Pron = mkPronoun + "tu" (elision "t") (elision "t") "toi" "ton" (elisPoss "t") "tes" + Fem Sg P2 ; + youPl8fem_Pron = + let vous = mkPronoun "vous" "vous" "vous" "vous" "votre" "votre" "vos" Fem Pl P2 + in + {s = vous.s ; hasClit = vous.hasClit ; poss = vous.poss ; a = vous.a ; isPol = False ; isNeg = False} ; + youPol8fem_Pron = + let vous = mkPronoun "vous" "vous" "vous" "vous" "votre" "votre" "vos" Fem Pl P2 + in + {s = vous.s ; hasClit = vous.hasClit ; poss = vous.poss ; a = vous.a ; isPol = True ; isNeg = False} ; + + ce_Pron = + let ce = elision "c" + in + mkPronoun ce ce ce ("cela" | "ça") "son" (elisPoss "s") "ses" Masc Sg P3 ; ---- variants? + + AdvDatVP = insertClit3 datClit ; + AdvGenVP = insertClit3 genClit ; + + oper + prepQue : Case -> Str = \c -> case c of { + Nom | Acc => elisQue ; + _ => prepCase c ++ "qui" --- + } ; + caseQue : Case -> Str = \c -> case c of { + Nom => "qui" ; + _ => elisQue + } ; + + lin + tout_Det = { + s = \\g,c => prepCase c ++ genForms "tout" "toute" ! g ; + sp = \\g,c => prepCase c ++ genForms "tout" "toute" ! g ; + n = Sg ; + s2 = [] ; + isNeg = False + } ; + + PNegNe = {s = [] ; p = RNeg True} ; + + ExistsNP np = + mknpClause "il" (insertComplement (\\_ => (np.s ! Nom).ton) (predV (regV "exister"))) ; ---- np.a + +--- in ExtraRomance +-- PassAgentVPSlash vps np = passVPSlash +-- vps ("par" ++ (np.s ! Acc).ton) ; + +} diff --git a/lib/src/french/exper/IdiomFre.gf b/lib/src/french/exper/IdiomFre.gf new file mode 100644 index 000000000..d374a8d91 --- /dev/null +++ b/lib/src/french/exper/IdiomFre.gf @@ -0,0 +1,67 @@ +concrete IdiomFre of Idiom = CatFre ** + open (P = ParamX), PhonoFre, MorphoFre, ParadigmsFre, Prelude in { + + flags optimize=all_subs ; + flags coding=utf8 ; + + lin + ImpersCl vp = mknpClause "il" vp ; + GenericCl vp = mknpClause "on" vp ; + + ExistNP np = + mknpClause "il" + (insertClit3 "y" (insertComplement (\\_ => (np.s ! Acc).ton) (predV avoir_V))) ; + + ExistIP ip = + mknpClause "il" + (insertClit3 "y" (predV avoir_V)) ** {ip = ip.s ! Nom ; isSent = False} ; + + CleftNP np rs = mknpClause elisCe ---- True np.isPol (agrP3 Masc Sg) + (insertComplement (\\_ => rs.s ! Indic ! np.a) + (insertComplement (\\_ => (np.s ! rs.c).ton) (predV copula))) ; + + CleftAdv ad s = mknpClause elisCe + (insertComplement (\\_ => conjThat ++ s.s ! Indic) + (insertComplement (\\_ => ad.s) (predV copula))) ; + + + ProgrVP vp = + insertComplement + (\\a => "en" ++ "train" ++ elisDe ++ infVP vp a) + (predV copula) ; + + ImpPl1 vp = { + s = mkImperative False P1 vp ! RPos ! Masc ! Pl --- fem + } ; + + ImpP3 np vp = { + s = (mkClause (np.s ! Nom).comp np.hasClit False np.a vp).s + ! DInv ! RPres ! Simul ! RPos ! Conjunct + } ; + + + SelfAdvVP vp = insertComplement memePron vp ; + SelfAdVVP vp = insertComplement memePron vp ; ---- should be AdV + SelfNP np = heavyNP { + s = \\c => (np.s ! c).ton ++ memePron ! np.a ; ---- moi moi-même ? + a = np.a + } ; + + oper + elisCe = elision "c" ; + + memePron : Agr => Str = table { + {n = Sg ; p = P1} => "moi-même" ; + {n = Sg ; p = P2} => "toi-même" ; + {g = Masc ; n = Sg ; p = P3} => "lui-même" ; + {g = Fem ; n = Sg ; p = P3} => "elle-même" ; + {n = Pl ; p = P1} => "nous-mêmes" ; + {n = Pl ; p = P2} => "vous-mêmes" ; + {g = Masc ; n = Pl ; p = P3} => "eux-mêmes" ; + {g = Fem ; n = Pl ; p = P3} => "elles-mêmes" + } ; + + +} + + diff --git a/lib/src/french/exper/TranslateFre.gf b/lib/src/french/exper/TranslateFre.gf new file mode 100644 index 000000000..538c42b1d --- /dev/null +++ b/lib/src/french/exper/TranslateFre.gf @@ -0,0 +1,75 @@ +--# -path=.:../chunk:alltenses + +concrete TranslateFre of Translate = + TenseFre, + NounFre - [PPartNP], + AdjectiveFre, + NumeralFre, + SymbolFre [ + PN, Symb, String, CN, Card, NP, MkSymb, SymbPN, CNNumNP + ], + ConjunctionFre, + VerbFre - [ + UseCopula, + PassV2 -- generalized in Extensions + ], + AdverbFre, + PhraseFre, + SentenceFre, + QuestionFre ---- - [ +---- QuestCl,QuestIAdv -- french-specific overrides +---- ] + , + RelativeFre, + IdiomFre, + ConstructionFre, + DocumentationFre, + + ChunkFre, + ExtensionsFre [ + CompoundN,AdAdV,UttAdV,ApposNP,MkVPI, MkVPS, PredVPS, PassVPSlash, PassAgentVPSlash, CompoundAP + , PastPartAP, PastPartAgentAP, PresPartAP, GerundNP, GerundAdv + , WithoutVP, InOrderToVP, ByVP + ], + + DictionaryFre ** +open PhonoFre, MorphoFre, ResFre, CommonRomance, ParadigmsFre, SyntaxFre, Prelude, (G = GrammarFre) in { + +flags + literal=Symb ; + coding = utf8 ; + +-- overrides from Lang +{- ----- +lin + QuestCl cl = + {s = \\t,a,p => -- est-ce qu'il dort ? + let cls = cl.s ! DDir ! t ! a ! p + in table { + QDir => "est-ce" ++ elisQue ++ cls ! Indic ; + QIndir => subjIf ++ cls ! Indic + } + } + | {s = \\t,a,p => -- dort-il ? + let cls = cl.s ! DInv ! t ! a ! p + in table { + QDir => cls ! Indic ; + QIndir => subjIf ++ cls ! Indic + } + } + | G.QuestCl cl -- il dort ? + ; + + + QuestIAdv iadv cl = + G.QuestIAdv iadv cl -- où dort-il + | {s = \\t,a,p,q => -- où est-ce qu'il dort + let + ord = DDir ; + cls = cl.s ! ord ! t ! a ! p ! Indic ; + why = iadv.s + in why ++ "est-ce" ++ elisQue ++ cls + } ; +-} + +} diff --git a/lib/src/romance/exper/CatRomance.gf b/lib/src/romance/exper/CatRomance.gf new file mode 100644 index 000000000..090216d52 --- /dev/null +++ b/lib/src/romance/exper/CatRomance.gf @@ -0,0 +1,137 @@ +incomplete concrete CatRomance of Cat = CommonX - [SC,Pol] + ** open Prelude, CommonRomance, ResRomance, (R = ParamX) in { + + flags optimize=all_subs ; + coding=utf8 ; + + lincat + +-- exception to CommonX, due to the distinction ne/ne-pas + + Pol = {s : Str ; p : RPolarity} ; + +-- Tensed/Untensed + + S = {s : Mood => Str} ; + QS = {s : QForm => Str} ; + RS = {s : Mood => Agr => Str ; c : Case} ; + SSlash = { + s : AAgr => Mood => Str ; + c2 : Compl + } ; + + SC = {s : Case => Str} ; -- de dormir / à dormir + +-- Sentence + + Cl = Clause ; + ClSlash = SlashClause ; + Imp = {s : RPolarity => ImpForm => Gender => Str} ; + +-- Question + + QCl = QuestClause ; + IP = {s : Case => Str ; a : AAgr} ; + IComp = {s : AAgr => Str} ; + IDet = {s : Gender => Case => Str ; n : Number} ; + IQuant = {s : Number => Gender => Case => Str} ; + +-- Relative + + RCl = RelClause ; + RP = RelPron ; + +-- Verb + + VP = ResRomance.VP ; + VPSlash = ResRomance.VP ** {c2 : Compl} ; + Comp = {s : Agr => Str} ; + +-- Adjective + + AP = {s : AForm => Str ; isPre : Bool} ; + +-- Noun + + CN = {s : Number => Str ; g : Gender} ; + Pron = Pronoun ; + NP = NounPhrase ; + Det = { + s : Gender => Case => Str ; + n : Number ; + s2 : Str ; -- -ci + sp : Gender => Case => Str ; -- substantival: mien, mienne + isNeg : Bool -- negative element, e.g. aucun + } ; + Quant = { + s : Bool => Number => Gender => Case => Str ; + s2 : Str ; + sp : Number => Gender => Case => Str ; + isNeg : Bool -- negative element, e.g. aucun + } ; + Predet = { + s : AAgr => Case => Str ; + c : Case ; -- c : la plupart de + a : PAgr -- if an agr is forced, e.g. chacun de nous + } ; + Num = {s : Gender => Str ; isNum : Bool ; n : Number} ; + Card = {s : Gender => Str ; n : Number} ; + Ord = {s : AAgr => Str} ; + +-- Numeral + + Numeral = {s : CardOrd => Str ; n : Number} ; + Digits = {s : CardOrd => Str ; n : Number} ; + +-- Structural + +---b Conj = {s : Str ; n : Number} ; +---b DConj = {s1,s2 : Str ; n : Number} ; + Conj = {s1,s2 : Str ; n : Number} ; + Subj = {s : Str ; m : Mood} ; + Prep = {s : Str ; c : Case ; isDir : Bool} ; + +-- Open lexical classes, e.g. Lexicon + + V, VQ, VA = Verb ; + V2, VV, V2S, V2Q = Verb ** {c2 : Compl} ; + V3, V2A, V2V = Verb ** {c2,c3 : Compl} ; + VS = Verb ** {m : RPolarity => Mood} ; + + A = {s : Degree => AForm => Str ; isPre : Bool} ; + A2 = {s : Degree => AForm => Str ; c2 : Compl} ; + + N = Noun ; + N2 = Noun ** {c2 : Compl} ; + N3 = Noun ** {c2,c3 : Compl} ; + PN = {s : Str ; g : Gender} ; + +-- tense augmented with passé simple + lincat + Temp = {s : Str ; t : RTense ; a : Anteriority} ; + Tense = {s : Str ; t : RTense} ; + + linref + SSlash = \ss -> ss.s ! aagr Masc Sg ! Indic ++ ss.c2.s ; +---- ClSlash = \cls -> cls.s ! aagr Masc Sg ! DDir ! RPres ! Simul ! RPos ! Indic ++ cls.c2.s ; + + VP = \vp -> infVP vp (agrP3 Masc Sg) ; + VPSlash = \vps -> infVP vps (agrP3 Masc Sg) ++ vps.c2.s ; + + V, VS, VQ, VA = \v -> infVP (predV v) (agrP3 Masc Sg); + V2, V2A, V2Q, V2S = \v -> infVP (predV v) (agrP3 Masc Sg) ++ v.c2.s ; + V3 = \v -> infVP (predV v) (agrP3 Masc Sg) ++ v.c2.s ++ v.c3.s ; + VV = \v -> infVP (predV v) (agrP3 Masc Sg) ; + V2V = \v -> infVP (predV v) (agrP3 Masc Sg) ; + + NP = \np -> (np.s ! Nom).comp ; + Conj = \c -> c.s2 ; + + A = \a -> a.s ! Posit ! AF Masc Sg ; + A2 = \a -> a.s ! Posit ! AF Masc Sg ++ a.c2.s ; + + N = \n -> n.s ! Sg ; + N2 = \n -> n.s ! Sg ++ n.c2.s ; + N3 = \n -> n.s ! Sg ++ n.c2.s ++ n.c3.s ; + +} diff --git a/lib/src/romance/exper/QuestionRomance.gf b/lib/src/romance/exper/QuestionRomance.gf new file mode 100644 index 000000000..295837ff2 --- /dev/null +++ b/lib/src/romance/exper/QuestionRomance.gf @@ -0,0 +1,114 @@ +incomplete concrete QuestionRomance of Question = + CatRomance ** open CommonRomance, ResRomance, Prelude in { + + flags optimize=all_subs ; + + lin + + QuestCl cl = cl ** {ip = [] ; isSent = True} ; + + QuestVP qp vp = {np = heavyNP {s = qp.s ; a = agrP3 qp.a.g qp.a.n} ; vp = vp ; ip = [] ; isSent = False} ; + + QuestSlash ip slash = slash ** {ip = ip.s ! slash.c2.c ; isSent = False} ; + +{- ---- + s = \\t,a,p => + let + cl = oldClause slash ; + cls : Direct -> Str = + \d -> cl.s ! d ! t ! a ! p ! Indic ; +---- \d -> cl.s ! ip.a ! d ! t ! a ! p ! Indic ; + who = slash.c2.s ++ ip.s ! slash.c2.c + in table { + QDir => who ++ cls DInv ; + QIndir => who ++ cls DDir + } +-} + + QuestIAdv iadv cl = cl ** {ip = iadv.s ; isSent = False} ; +{- + s = \\t,a,p,q => + let + ord = case q of { + QDir => DInv ; + QIndir => DInv + } ; + cl = oldClause ncl ; + cls = cl.s ! ord ! t ! a ! p ! Indic ; + why = iadv.s + in why ++ cls +-} + + QuestIComp icomp np = {np = np ; vp = predV copula ; ip = icomp.s ! complAgr np.a ; isSent = False} ; +{- + s = \\t,a,p,_ => + let + vp = predV copula ; + cls = (mkClause (np.s ! Nom).comp np.hasClit np.isPol np.a vp).s ! + DInv ! t ! a ! p ! Indic ; + why = icomp.s ! complAgr np.a ; + in why ++ cls +-} + + PrepIP p ip = { + s = p.s ++ ip.s ! p.c + } ; + + AdvIP ip adv = { + s = \\c => ip.s ! c ++ adv.s ; + a = ip.a + } ; + + IdetCN idet cn = + let + g = cn.g ; + n = idet.n ; + a = aagr g n + in { + s = \\c => idet.s ! g ! c ++ cn.s ! n ; + a = a + } ; + + IdetIP idet = + let + g = Masc ; ---- Fem in Extra + n = idet.n ; + a = aagr g n + in { + s = \\c => idet.s ! g ! c ; + a = a + } ; + + IdetQuant idet num = + let + n = num.n ; + in { + s = \\g,c => idet.s ! n ! g ! c ++ num.s ! g ; + n = n + } ; + + AdvIAdv i a = {s = i.s ++ a.s} ; + + CompIAdv a = {s = \\_ => a.s} ; + + CompIP p = {s = \\_ => p.s ! Nom} ; + + lincat + QVP = ResRomance.VP ; + lin + ComplSlashIP vp ip = insertObject vp.c2 (heavyNP {s = ip.s ; a = {g = ip.a.g ; n = ip.a.n ; p = P3}}) vp ; + AdvQVP vp adv = insertAdv adv.s vp ; + AddAdvQVP vp adv = insertAdv adv.s vp ; + + QuestQVP qp vp = {np = heavyNP {s = qp.s ; a = agrP3 qp.a.g qp.a.n} ; vp = vp ; ip = [] ; isSent = False} ; ---- + +{- + s = \\t,a,b,_ => + let + cl = mkClause (qp.s ! Nom) False False (agrP3 qp.a.g qp.a.n) vp + in + cl.s ! DDir ! t ! a ! b ! Indic +-} + +} + diff --git a/lib/src/romance/exper/RelativeRomance.gf b/lib/src/romance/exper/RelativeRomance.gf new file mode 100644 index 000000000..cb6f78d00 --- /dev/null +++ b/lib/src/romance/exper/RelativeRomance.gf @@ -0,0 +1,66 @@ +incomplete concrete RelativeRomance of Relative = + CatRomance ** open Prelude, CommonRomance, ResRomance in { + + flags optimize=all_subs ; + + lin + + RelCl cl = cl ** {c2 = complNom ; rp = \\aag => pronSuch ! aag ++ conjThat} ; +{- +let cl = oldClause ncl in { + s = \\ag,t,a,p,m => pronSuch ! complAgr ag ++ conjThat ++ + cl.s ! DDir ! t ! a ! p ! m ; + c = Nom + } ; +-} + + RelVP rp vp = { + np = heavyNP {s = rp.s ! False ! {g = Masc ; n = Sg} ; a = Ag rp.a.g rp.a.n P3} ; ---- agr,agr + vp = vp ; + rp = \\_ => [] ; + c2 = complNom + } ; +{- + --- more efficient to compile than case inside mkClause; see log.txt +case rp.hasAgr of { + True => {s = \\ag => + (mkClause + (rp.s ! False ! complAgr ag ! Nom) False False + (Ag rp.a.g rp.a.n P3) + vp).s ! DDir ; c = Nom} ; + False => {s = \\ag => + (mkClause + (rp.s ! False ! complAgr ag ! Nom) False False + ag + vp).s ! DDir ; c = Nom + } + } ; +-} + + RelSlash rp slash = slash ** {rp = \\aag => rp.s ! False ! aag ! slash.c2.c ; c2 = complAcc} ; + +{- + s = \\ag,t,a,p,m => + let + aag = complAgr ag ; + cl = oldClause slash + in + slash.c2.s ++ + rp.s ! False ! aag ! slash.c2.c ++ + cl.s ! DDir ! t ! a ! p ! m ; --- ragr +---- slash.s ! aag ! DDir ! t ! a ! p ! m ; --- ragr + c = Acc +-} + + FunRP p np rp = { + s = \\_,a,c => (np.s ! Nom).ton ++ p.s ++ rp.s ! True ! a ! p.c ; + a = complAgr np.a ; + hasAgr = True + } ; + IdRP = { + s = relPron ; + a = {g = Masc ; n = Sg} ; + hasAgr = False + } ; + +} diff --git a/lib/src/romance/exper/ResRomance.gf b/lib/src/romance/exper/ResRomance.gf new file mode 100644 index 000000000..4877854cc --- /dev/null +++ b/lib/src/romance/exper/ResRomance.gf @@ -0,0 +1,353 @@ +--1 Romance auxiliary operations. +-- + +interface ResRomance = DiffRomance ** open CommonRomance, Prelude in { + +flags optimize=all ; + coding=utf8 ; + +--2 Constants uniformly defined in terms of language-dependent constants + +oper + + nominative : Case = Nom ; + accusative : Case = Acc ; + + NounPhrase : Type = { + s : Case => {c1,c2,comp,ton : Str} ; + a : Agr ; + hasClit : Bool ; + isPol : Bool ; --- only needed for French complement agr + isNeg : Bool --- needed for negative NP's such as "personne" + } ; + Pronoun : Type = { + s : Case => {c1,c2,comp,ton : Str} ; + a : Agr ; + hasClit : Bool ; + isPol : Bool ; --- only needed for French complement agr + poss : Number => Gender => Str ---- also: substantival + } ; + + heavyNP : {s : Case => Str ; a : Agr} -> NounPhrase = heavyNPpol False ; + + heavyNPpol : Bool -> {s : Case => Str ; a : Agr} -> NounPhrase = \isNeg,np -> { + s = \\c => {comp,ton = np.s ! c ; c1,c2 = []} ; + a = np.a ; + hasClit = False ; + isPol = False ; + isNeg = isNeg + } ; + + Compl : Type = {s : Str ; c : Case ; isDir : Bool} ; + + complAcc : Compl = {s = [] ; c = accusative ; isDir = True} ; + complGen : Compl = {s = [] ; c = genitive ; isDir = False} ; + complDat : Compl = {s = [] ; c = dative ; isDir = True} ; + complNom : Compl = {s = [] ; c = Nom ; isDir = False} ; + + pn2np : {s : Str ; g : Gender} -> NounPhrase = pn2npPol False ; + pn2npNeg : {s : Str ; g : Gender} -> NounPhrase = pn2npPol True ; + + pn2npPol : Bool -> {s : Str ; g : Gender} -> NounPhrase = \isNeg, pn -> heavyNPpol isNeg { + s = \\c => prepCase c ++ pn.s ; + a = agrP3 pn.g Sg + } ; + + npform2case : NPForm -> Case = \p -> case p of { + Ton x => x ; + Poss _ => genitive ; + Aton x => x + } ; + + case2npform : Case -> NPForm = \c -> case c of { + Nom => Ton Nom ; + Acc => Ton Acc ; + _ => Ton c + } ; + +-- Pronouns in $NP$ lists are always in stressed forms. + + stressedCase : NPForm -> NPForm = \c -> case c of { + Aton k => Ton k ; + _ => c + } ; + + appCompl : Compl -> NounPhrase -> Str = \comp,np -> + comp.s ++ (np.s ! comp.c).ton ; + + oper + + + predV : Verb -> VP = \verb -> + let + typ = verb.vtyp ; + in { + s = verb ; + agr = partAgr typ ; + neg = negation ; + clit1 = [] ; + clit2 = [] ; + clit3 = {s,imp = [] ; hasClit = False} ; --- refl is treated elsewhere + isNeg = False ; + comp = \\a => [] ; + ext = \\p => [] + } ; + + insertObject : Compl -> NounPhrase -> VP -> VP = \c,np,vp -> + let + obj = np.s ! c.c ; + in { + s = vp.s ; + agr = case of { + => vpAgrClit np.a ; + _ => vp.agr -- must be dat + } ; + clit1 = vp.clit1 ++ obj.c1 ; + clit2 = vp.clit2 ++ obj.c2 ; + clit3 = addClit3 np.hasClit [] (imperClit np.a obj.c1 obj.c2) vp.clit3 ; + isNeg = orB vp.isNeg np.isNeg ; + comp = \\a => c.s ++ obj.comp ++ vp.comp ! a ; + neg = vp.neg ; + ext = vp.ext ; + } ; + + insertComplement : (Agr => Str) -> VP -> VP = \co,vp -> { + s = vp.s ; + agr = vp.agr ; + clit1 = vp.clit1 ; + clit2 = vp.clit2 ; + clit3 = vp.clit3 ; + isNeg = vp.isNeg ; --- can be in compl as well + neg = vp.neg ; + comp = \\a => vp.comp ! a ++ co ! a ; + ext = vp.ext ; + } ; + + +-- Agreement with preceding relative or interrogative: +-- "les femmes que j'ai aimées" + + insertAgr : AAgr -> VP -> VP = \ag,vp -> { + s = vp.s ; + agr = vpAgrClit (agrP3 ag.g ag.n) ; + clit1 = vp.clit1 ; + clit2 = vp.clit2 ; + clit3 = vp.clit3 ; + isNeg = vp.isNeg ; + neg = vp.neg ; + comp = vp.comp ; + ext = vp.ext ; + } ; + + insertRefl : VP -> VP = \vp -> { + s = vp.s ** {vtyp = vRefl vp.s.vtyp} ; + agr = VPAgrSubj ; + clit1 = vp.clit1 ; + clit2 = vp.clit2 ; + clit3 = vp.clit3 ; + isNeg = vp.isNeg ; + neg = vp.neg ; + comp = vp.comp ; + ext = vp.ext ; + } ; + + insertAdv : Str -> VP -> VP = \co,vp -> { + s = vp.s ; + agr = vp.agr ; + clit1 = vp.clit1 ; + clit2 = vp.clit2 ; + clit3 = vp.clit3 ; + isNeg = vp.isNeg ; --- adv could be neg + neg = vp.neg ; + comp = \\a => vp.comp ! a ++ co ; + ext = vp.ext ; + } ; + + insertAdV : Str -> VP -> VP = \co,vp -> { + s = vp.s ; + agr = vp.agr ; + clit1 = vp.clit1 ; + clit2 = vp.clit2 ; + clit3 = vp.clit3 ; + isNeg = vp.isNeg ; + neg = \\b => let vpn = vp.neg ! b in {p1 = vpn.p1 ; p2 = vpn.p2 ++ co} ; + comp = vp.comp ; + ext = vp.ext ; + } ; + + insertClit3 : Str -> VP -> VP = \co,vp -> { + s = vp.s ; + agr = vp.agr ; + clit1 = vp.clit1 ; + clit2 = vp.clit2 ; + clit3 = addClit3 True co vp.clit3.imp vp.clit3 ; + isNeg = vp.isNeg ; + neg = vp.neg ; + comp = vp.comp ; + ext = vp.ext ; + } ; + + insertExtrapos : (RPolarity => Str) -> VP -> VP = \co,vp -> { + s = vp.s ; + agr = vp.agr ; + clit1 = vp.clit1 ; + clit2 = vp.clit2 ; + clit3 = vp.clit3 ; + isNeg = vp.isNeg ; + neg = vp.neg ; + comp = vp.comp ; + ext = \\p => vp.ext ! p ++ co ! p ; + } ; + + mkVPSlash : Compl -> VP -> VP ** {c2 : Compl} = \c,vp -> vp ** {c2 = c} ; + +----- new stuff 28/11/2014 ------------- + Clause : Type = {np : NounPhrase ; vp : VP} ; + SlashClause : Type = Clause ** {c2 : Compl} ; + QuestClause : Type = Clause ** {ip : Str ; isSent : Bool} ; -- if IP is subject then it is np, and ip is empty + RelClause : Type = SlashClause ** {rp : AAgr => Str} ; -- if RP is subject then it is np, and rp is empty + + mknClause : NounPhrase -> VP -> Clause = \np, vp -> {np = np ; vp = vp} ; + mknpClause : Str -> VP -> Clause = \s, vp -> mknClause (heavyNP {s = \\_ => s ; a = agrP3 Masc Sg}) vp ; + + RelPron : Type = {s : Bool => AAgr => Case => Str ; a : AAgr ; hasAgr : Bool} ; + + OldClause : Type = {s : Direct => RTense => Anteriority => RPolarity => Mood => Str} ; + OldQuestClause : Type = {s : QForm => RTense => Anteriority => RPolarity => Mood => Str} ; + OldRelClause : Type = {s : Agr => RTense => Anteriority => RPolarity => Mood => Str ; c : Case} ; + + oldClause : Clause -> OldClause = \cl -> + let np = cl.np in + mkClausePol np.isNeg (np.s ! Nom).comp np.hasClit np.isPol np.a cl.vp ; + + oldQuestClause : QuestClause -> OldQuestClause = \qcl -> + let + np = qcl.np ; + cl = mkClause (np.s ! Nom).comp False False np.a qcl.vp ; + in { + s = table { + QDir => \\t,a,r,m => qcl.ip ++ cl.s ! DInv ! t ! a ! r ! m ; + QIndir => \\t,a,r,m => case qcl.isSent of {True => subjIf ; _ => []} ++ qcl.ip ++ cl.s ! DDir ! t ! a ! r ! m + } + } ; + + oldRelClause : RelClause -> OldRelClause = \rcl -> + let + np = rcl.np ; + cl = mkClause (np.s ! Nom).comp False False np.a rcl.vp ; ---- Ag rp.a.g rp.a.n P3 + in { + s = \\agr => cl.s ! DDir ; + c = rcl.c2.c + } ; + + + + +--------------------------------------- + + + mkClause : Str -> Bool -> Bool -> Agr -> VP -> + {s : Direct => RTense => Anteriority => RPolarity => Mood => Str} = + mkClausePol False ; + + -- isNeg = True if subject NP is a negative element, e.g. "personne" + mkClausePol : Bool -> Str -> Bool -> Bool -> Agr -> VP -> + {s : Direct => RTense => Anteriority => RPolarity => Mood => Str} = + \isNeg, subj, hasClit, isPol, agr, vp -> { + s = \\d,te,a,b,m => + let + + pol : RPolarity = case of { + <_,True,RPos,_> => RNeg True ; + => RNeg True ; + => polNegDirSubj ; + _ => b + } ; + + neg = vp.neg ! pol ; + + gen = agr.g ; + num = agr.n ; + per = agr.p ; + + particle = vp.s.p ; + + compl = particle ++ case isPol of { + True => vp.comp ! {g = gen ; n = Sg ; p = per} ; + _ => vp.comp ! agr + } ; + ext = vp.ext ! b ; + + vtyp = vp.s.vtyp ; + refl = case isVRefl vtyp of { + True => reflPron num per Acc ; ---- case ? + _ => [] + } ; + clit = refl ++ vp.clit1 ++ vp.clit2 ++ vp.clit3.s ; ---- refl first? + + verb = vp.s.s ; + vaux = auxVerb vp.s.vtyp ; + + part = case vp.agr of { + VPAgrSubj => verb ! VPart agr.g agr.n ; + VPAgrClit g n => verb ! VPart g n + } ; + + vps : Str * Str = case of { + => ; --# notpresent + => ; --# notpresent + => ; --# notpresent + => ; --# notpresent + => ; --# notpresent + => ; --# notpresent + => ; --# notpresent + => ; --# notpresent + => ; --# notpresent + => + } ; + + fin = vps.p1 ; + inf = vps.p2 ; + + in + case d of { + DDir => + subj ++ neg.p1 ++ clit ++ fin ++ neg.p2 ++ inf ++ compl ++ ext ; + DInv => + invertedClause vp.s.vtyp hasClit neg clit fin inf compl subj ext + } + } ; + +--- in French, pronouns should +--- have a "-" with possibly a special verb form with "t": +--- "comment fera-t-il" vs. "comment fera Pierre" + + infVP : VP -> Agr -> Str = nominalVP VInfin ; + + gerVP : VP -> Agr -> Str = nominalVP (\_ -> VGer) ; + + nominalVP : (Bool -> VF) -> VP -> Agr -> Str = \vf,vp,agr -> + let + iform = orB vp.clit3.hasClit (isVRefl vp.s.vtyp) ; + inf = vp.s.s ! vf iform ; + neg = vp.neg ! RPos ; --- Neg not in API + obj = vp.s.p ++ vp.comp ! agr ++ vp.ext ! RPos ; ---- pol + refl = case isVRefl vp.s.vtyp of { + True => reflPron agr.n agr.p Acc ; ---- case ? + _ => [] + } ; + in + neg.p1 ++ neg.p2 ++ clitInf iform (refl ++ vp.clit1 ++ vp.clit2 ++ vp.clit3.s) inf ++ obj ; -- ne pas dormant + +} + +-- insertObject: +-- p -cat=Cl -tr "la femme te l' envoie" +-- PredVP (DetCN (DetSg DefSg NoOrd) (UseN woman_N)) +-- (ComplV3 send_V3 (UsePron he_Pron) (UsePron thou_Pron)) +-- la femme te l' a envoyé +-- +-- p -cat=Cl -tr "la femme te lui envoie" +-- PredVP (DetCN (DetSg DefSg NoOrd) (UseN woman_N)) +-- (ComplV3 send_V3 (UsePron thou_Pron) (UsePron he_Pron)) +-- la femme te lui a envoyée diff --git a/lib/src/romance/exper/SentenceRomance.gf b/lib/src/romance/exper/SentenceRomance.gf new file mode 100644 index 000000000..e0b0d96ba --- /dev/null +++ b/lib/src/romance/exper/SentenceRomance.gf @@ -0,0 +1,69 @@ +incomplete concrete SentenceRomance of Sentence = + CatRomance ** open Prelude, CommonRomance, ResRomance in { + + flags optimize=all_subs ; + coding=utf8 ; + + lin + PredVP np vp = mknClause np vp ; + + PredSCVP sc vp = mknClause (heavyNP {s = sc.s ; a = agrP3 Masc Sg}) vp ; + + ImpVP vp = { + s = \\p,i,g => case i of { + ImpF n b => mkImperative b P2 vp ! p ! g ! n ---- AgPol ? + } + } ; + + SlashVP np vps = {np = np ; vp = vps ; c2 = vps.c2} ; + + AdvSlash slash adv = slash ** {vp = insertAdv adv.s slash.vp} ; + + SlashPrep cl prep = cl ** {c2 = {s = prep.s ; c = prep.c ; isDir = False}} ; + + SlashVS np vs slash = { + np = np ; + vp = insertExtrapos (\\b => conjThat ++ slash.s ! {g = Masc ; n = Sg} ! (vs.m ! b)) (predV vs) ; ---- aag + c2 = slash.c2 + } ; +{- + {s = \\ag => + (mkClausePol np.isNeg + (np.s ! Nom).comp False np.isPol np.a + (insertExtrapos (\\b => conjThat ++ slash.s ! ag ! (vs.m ! b)) + (predV vs)) + ).s ; + c2 = slash.c2 + } ; +-} + EmbedS s = {s = \\_ => conjThat ++ s.s ! Indic} ; --- mood + EmbedQS qs = {s = \\_ => qs.s ! QIndir} ; + EmbedVP vp = {s = \\c => prepCase c ++ infVP vp (agrP3 Masc Sg)} ; --- agr ---- compl + + UseCl t p ncl = let cl = oldClause ncl in { + s = \\o => t.s ++ p.s ++ cl.s ! DDir ! t.t ! t.a ! p.p ! o + } ; + UseQCl t p qcl = let cl = oldQuestClause qcl in { + s = \\q => t.s ++ p.s ++ cl.s ! q ! t.t ! t.a ! p.p ! Indic + } ; + UseRCl t p rcl = let cl = oldRelClause rcl in { + s = \\r,ag => t.s ++ p.s ++ cl.s ! ag ! t.t ! t.a ! p.p ! r ; + c = cl.c + } ; + UseSlash t p ncl = let cl = oldClause ncl in { + s = \\ag,mo => + t.s ++ p.s ++ cl.s ! DDir ! t.t ! t.a ! p.p ! mo ; +---- t.s ++ p.s ++ cl.s ! ag ! DDir ! t.t ! t.a ! p.p ! mo ; + c2 = ncl.c2 + } ; + + AdvS a s = {s = \\o => a.s ++ s.s ! o} ; + ExtAdvS a s = {s = \\o => a.s ++ "," ++ s.s ! o} ; + + SSubjS a s b = {s = \\m => a.s ! m ++ s.s ++ b.s ! s.m} ; + + RelS s r = { + s = \\o => s.s ! o ++ "," ++ partQIndir ++ r.s ! Indic ! agrP3 Masc Sg + } ; + +}