From 3953ac337134532624449c4ad562ad4965a5c9ca Mon Sep 17 00:00:00 2001 From: aarne Date: Tue, 4 Feb 2014 15:24:06 +0000 Subject: [PATCH] PredicationEng complete with all agreement forms and questions; questions with contracted auxiliaries still to do --- lib/src/experimental/PredicationEng.gf | 312 ++++++++++++++++++------- 1 file changed, 229 insertions(+), 83 deletions(-) diff --git a/lib/src/experimental/PredicationEng.gf b/lib/src/experimental/PredicationEng.gf index 901fdcbe5..759faaab2 100644 --- a/lib/src/experimental/PredicationEng.gf +++ b/lib/src/experimental/PredicationEng.gf @@ -7,7 +7,10 @@ concrete PredicationEng of Predication = open Prelude in { -- a question: would it make sense to make this into a functor? param - Agr = Sg | Pl ; + Number = Sg | Pl ; + Person = P1 | P2 | P3 ; + Agr = Ag Number Person ; + VAgr = VASgP1 | VASgP3 | VAPl ; Case = Nom | Acc ; STense = Pres | Past | Fut | Cond ; Anteriority = Simul | Anter ; @@ -17,11 +20,44 @@ param FocusType = NoFoc | FocSubj | FocObj ; -- sover hon/om hon sover, vem älskar hon/vem hon älskar, vem sover/vem som sover + Unit = UUnit ; oper - defaultAgr = Sg ; + NAgr = Number ; + AAgr = Unit ; + IPAgr = Number ; + + defaultAgr : Agr = Ag Sg P3 ; ComplCase = Str ; -- preposition +-- omitting rich Agr information + agr2vagr : Agr -> VAgr = \a -> case a of { + Ag Sg P1 => VASgP1 ; + Ag Sg P3 => VASgP3 ; + _ => VAPl + } ; + + agr2aagr : Agr -> AAgr = \n -> UUnit ; + + agr2nagr : Agr -> NAgr = \a -> case a of { + Ag n _ => n + } ; + +-- restoring full Agr + ipagr2agr : IPAgr -> Agr = \n -> Ag n P3 ; + + ipagr2vagr : IPAgr -> VAgr = \n -> case n of { + Sg => VASgP3 ; + Pl => VAPl + } ; + +--- this is only needed in VPC formation + vagr2agr : VAgr -> Agr = \a -> case a of { + VASgP1 => Ag Sg P1 ; + VASgP3 => Ag Sg P3 ; + VAPl => Ag Pl P3 + } ; + lincat Arg = {s : Str} ; @@ -33,8 +69,9 @@ lincat isAux : Bool ; } ; - VP = { - v : Agr => Str * Str * Str ; -- ska,ha,sovit +oper + VerbPhrase = { + v : VAgr => Str * Str * Str ; -- ska,ha,sovit inf : Str * Str ; -- ha,sovit c1 : ComplCase ; c2 : ComplCase ; @@ -43,10 +80,11 @@ lincat obj2 : (Agr => Str) * Bool ; -- subject control = True adv : Str ; adV : Str ; - ext : Str + ext : Str ; + qforms : VAgr => Str * Str -- special Eng for introducing "do" in questions } ; -oper Clause = { + Clause = { v : Str * Str * Str ; inf : Str * Str ; adj,obj1,obj2 : Str ; @@ -54,10 +92,12 @@ oper Clause = { adV : Str ; ext : Str ; subj : Str ; - c3 : ComplCase -- for a slashed adjunct, not belonging to the verb valency + c3 : ComplCase ; -- for a slashed adjunct, not belonging to the verb valency + qforms : Str * Str } ; lincat + VP = VerbPhrase ; Cl = Clause ; QCl = Clause ** { @@ -66,7 +106,7 @@ lincat } ; VPC = { - v : Agr => Str ; + v : VAgr => Str ; inf : Agr => Str ; c1 : ComplCase ; c2 : ComplCase @@ -86,18 +126,16 @@ lincat S = {s : Str} ; Utt = {s : Str} ; AP = { - s : Agr => Str ; + s : AAgr => Str ; c1, c2 : ComplCase ; - obj1 : - Agr => Str + obj1 : Agr => Str } ; CN = { - s : Agr => Str ; + s : NAgr => Str ; c1, c2 : ComplCase ; - obj1 : - Agr => Str + obj1 : Agr => Str } ; - IP = {s : Str ; a : Agr} ; + IP = {s : Str ; a : IPAgr} ; Prep = {s : Str} ; Conj = {s : Str} ; IAdv = {s : Str} ; @@ -127,6 +165,7 @@ lin adV = negAdV p ; adv = [] ; ext = [] ; + qforms = \\agr => qformsV (a.s ++ t.s ++ p.s) t.t a.a p.p agr v ; } ; PassUseV a t p _ v = { @@ -140,6 +179,7 @@ lin adV = negAdV p ; adv = [] ; ext = [] ; + qforms = \\agr => qformsBe (a.s ++ t.s ++ p.s) t.t a.a p.p agr ; } ; AgentPassUseV a t p _ v np = { @@ -153,6 +193,7 @@ lin adV = negAdV p ; adv = appComplCase agentCase np ; ---- add a specific field for agent? ext = [] ; + qforms = \\agr => qformsBe (a.s ++ t.s ++ p.s) t.t a.a p.p agr ; } ; UseAP a t p _ ap = { @@ -160,12 +201,13 @@ lin inf = tenseInfV a.s a.a p.p Act be_V ; c1 = ap.c1 ; c2 = ap.c2 ; - adj = \\a => ap.s ! a ; + adj = \\a => ap.s ! agr2aagr a ; obj1 = ; obj2 = ; --- there are no A3's adV = negAdV p ; adv = [] ; ext = [] ; + qforms = \\agr => qformsBe (a.s ++ t.s ++ p.s) t.t a.a p.p agr ; } ; SlashV2 x vp np = vp ** { @@ -180,9 +222,9 @@ lin ComplVV x vp vpo = addObj2VP vp (\\a => infVP a vpo) ; ---- infForm - ComplVA x vp ap = addObj2VP vp (\\a => ap.s ! a ++ ap.obj1 ! a) ; ---- adjForm + ComplVA x vp ap = addObj2VP vp (\\a => ap.s ! agr2aagr a ++ ap.obj1 ! a) ; ---- adjForm - ComplVN x vp cn = addObj2VP vp (\\a => cn.s ! a ++ cn.obj1 ! a) ; ---- cnForm + ComplVN x vp cn = addObj2VP vp (\\a => cn.s ! agr2nagr a ++ cn.obj1 ! a) ; ---- cnForm SlashV2S x vp cl = addExtVP vp (that_Compl ++ declSubordCl (lin Cl cl)) ; ---- sentence form @@ -190,9 +232,9 @@ lin SlashV2V x vp vpo = addObj2VP vp (\\a => infVP a (lin VP vpo)) ; ---- infForm - SlashV2A x vp ap = addObj2VP vp (\\a => ap.s ! a ++ ap.obj1 ! a) ; ---- adjForm + SlashV2A x vp ap = addObj2VP vp (\\a => ap.s ! agr2aagr a ++ ap.obj1 ! a) ; ---- adjForm - SlashV2N x vp cn = addObj2VP vp (\\a => cn.s ! a ++ cn.obj1 ! a) ; ---- cn form + SlashV2N x vp cn = addObj2VP vp (\\a => cn.s ! agr2nagr a ++ cn.obj1 ! a) ; ---- cn form ReflVP x vp = vp ** { obj1 : (Agr => Str) * Agr = <\\a => reflPron a, defaultAgr> ; --- hack: defaultAgr will not be used but subj.a instead @@ -203,12 +245,13 @@ lin } ; PredVP x np vp = vp ** { - v = vp.v ! np.a ; + v = vp.v ! agr2vagr np.a ; subj = np.s ! Nom ; adj = vp.adj ! np.a ; obj1 = vp.c1 ++ vp.obj1.p1 ! np.a ; ---- apply complCase obj2 = vp.c2 ++ vp.obj2.p1 ! (case vp.obj2.p2 of {True => np.a ; False => vp.obj1.p2}) ; ---- apply complCase c3 = noComplCase ; -- for one more prep to build ClSlash + qforms = vp.qforms ! agr2vagr np.a ; } ; PrepCl p x cl = cl ** { -- Cl/NP ::= Cl PP/NP @@ -226,15 +269,17 @@ lin QuestIAdv x iadv cl = cl ** {foc = iadv.s ; focType = FocObj} ; -- FocObj implies Foc + V + Subj: varför älskar hon oss - QuestVP x ip vp = vp ** { - v = vp.v ! ip.a ; + QuestVP x ip vp = let ipa = ipagr2agr ip.a in + vp ** { + v = vp.v ! ipagr2vagr ip.a ; foc = ip.s ; -- vem älskar henne focType = FocSubj ; subj = [] ; - adj = vp.adj ! ip.a ; - obj1 = vp.c1 ++ vp.obj1.p1 ! ip.a ; ---- appComplCase - obj2 = vp.c2 ++ vp.obj2.p1 ! (case vp.obj2.p2 of {True => ip.a ; False => vp.obj1.p2}) ; ---- appComplCase + adj = vp.adj ! ipa ; + obj1 = vp.c1 ++ vp.obj1.p1 ! ipa ; ---- appComplCase + obj2 = vp.c2 ++ vp.obj2.p1 ! (case vp.obj2.p2 of {True => ipa ; False => vp.obj1.p2}) ; ---- appComplCase c3 = noComplCase ; -- for one more prep to build ClSlash ---- ever needed for QCl? + qforms = vp.qforms ! ipagr2vagr ip.a ; } ; QuestSlash x ip cl = @@ -287,13 +332,16 @@ lin StartVPC c x v w = { ---- some loss of quality seems inevitable v = \\a => - let vv = v.v ! a ; wv = w.v ! a + let + vv = v.v ! a ; + wv = w.v ! a ; + vpa = vagr2agr a ; in - vv.p1 ++ v.adV ++ vv.p2 ++ vv.p3 ++ v.adj ! a ++ - v.c1 ++ v.obj1.p1 ! a ++ v.c2 ++ v.obj2.p1 ! a ++ v.adv ++ v.ext ---- appComplCase + vv.p1 ++ v.adV ++ vv.p2 ++ vv.p3 ++ v.adj ! vpa ++ + v.c1 ++ v.obj1.p1 ! vpa ++ v.c2 ++ v.obj2.p1 ! vpa ++ v.adv ++ v.ext ---- appComplCase ++ c.s ++ - wv.p1 ++ w.adV ++ wv.p2 ++ wv.p3 ++ w.adj ! a ++ ---- appComplCase - w.c1 ++ w.obj1.p1 ! a ++ w.c2 ++ w.obj2.p1 ! a ++ w.adv ++ w.ext ; + wv.p1 ++ w.adV ++ wv.p2 ++ wv.p3 ++ w.adj ! vpa ++ ---- appComplCase + w.c1 ++ w.obj1.p1 ! vpa ++ w.c2 ++ w.obj2.p1 ! vpa ++ w.adv ++ w.ext ; inf = \\a => infVP a (lin VP v) ++ c.s ++ infVP a (lin VP w) ; c1 = [] ; ---- w.c1 ? --- the full story is to unify v and w... @@ -310,6 +358,7 @@ lin obj2 = ; adv,adV = [] ; ext = [] ; + qforms = \\a => <"do", vpc.inf ! defaultAgr> ; ---- do/does/did } ; StartClC c x a b = { @@ -328,43 +377,75 @@ lin adv = [] ; ext = [] ; c3 = cl.c3 ; + qforms = <[],[]> ; ---- qforms } ; - ---- the following may become parameters for a functor oper - vPastPart : Agr -> VForm = \_ -> VPastPart ; - vPresPart : Agr -> VForm = \_ -> VPresPart ; + vPastPart : AAgr -> VForm = \_ -> VPastPart ; + vPresPart : AAgr -> VForm = \_ -> VPresPart ; be_V : V = lin V {v = mkVerb "be" "is" "was" "been" "being" ; c1,c2 = [] ; isAux = True ; isSubjectControl = False} ; negAdV : Pol -> Str = \p -> p.s ; - reflPron : Agr -> Str = \a -> case a of {Sg => "herself" ; Pl => "us"} ; + reflPron : Agr -> Str = \a -> case a of { + Ag Sg P1 => "myself" ; + Ag Sg P2 => "yourself" ; + Ag Sg P3 => "herself" | "himself" | "itself" ; ---- + Ag Pl P1 => "ourselves" ; + Ag Pl P2 => "ourselves" ; + Ag Pl P3 => "yourselves" + } ; infVP : Agr -> VP -> Str = \a,vp -> let a2 = case vp.obj2.p2 of {True => a ; False => vp.obj1.p2} in - vp.adV ++ (vp.inf.p1 | []) ++ vp.inf.p2 ++ ---- *hon tvingar oss att sovit + vp.adV ++ vp.inf.p1 ++ vp.inf.p2 ++ vp.adj ! a ++ vp.c1 ++ vp.obj1.p1 ! a ++ vp.c2 ++ vp.obj2.p1 ! a2 ++ vp.adv ++ vp.ext ; - tenseV : Str -> STense -> Anteriority -> Polarity -> Voice -> Agr -> V -> Str * Str * Str = - \sta,t,a,p,o,agr,v -> case o of { - Act => tenseActV sta t a p agr v ; - Pass => tensePassV sta t a p agr v + qformsV : Str -> STense -> Anteriority -> Polarity -> VAgr -> V -> Str * Str = + \sta,t,a,p,agr,v -> + let + verb = tenseActV sta t a Neg agr v ; + averb = tenseActV sta t a p agr v + in case of { + => case p of { + Pos => < verb.p1, verb.p3> ; -- does , sleep + Neg => < verb.p1, verb.p2> -- does , not sleep ---- TODO: doesn't , sleep + } ; + _ => } ; - tenseActV : Str -> STense -> Anteriority -> Polarity -> Agr -> V -> Str * Str * Str = \sta,t,a,p,agr,v -> - let vt = case of { - => VPres ; + qformsBe : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str = + \sta,t,a,p,agr -> + let verb = be_AuxL sta t a p agr + in ; -- is , not ---- TODO isn't , + + tenseV : Str -> STense -> Anteriority -> Polarity -> Voice -> VAgr -> V -> Str * Str * Str = + \sta,t,a,p,o,agr,v -> + case o of { + Act => tenseActV sta t a p agr v ; + Pass => tensePassV sta t a p agr v + } + | ---- leaving out variants makes compilation time go down from 900ms to 300ms. + ---- parsing time of "she sleeps" goes down from 300ms to 60ms. 4/2/2014 + case o of { + Act => tenseActVContracted sta t a p agr v ; + Pass => tensePassVContracted sta t a p agr v + } ; + + tenseActV : Str -> STense -> Anteriority -> Polarity -> VAgr -> V -> Str * Str * Str = \sta,t,a,p,agr,v -> + let vt : VForm = case of { + => VPres ; => VPast ; _ => VInf - } + } ; in case of { => @@ -372,21 +453,49 @@ oper True => ; False => case p of { Pos => <[], sta ++ v.v ! vt, []> ; -- this is the deviating case - Neg => - | + Neg => } } ; - => - | ; - => - | ; - => - | + + => ; + => ; + => } ; - tensePassV : Str -> STense -> Anteriority -> Polarity -> Agr -> V -> Str * Str * Str = \sta,t,a,p,agr,v -> + tenseActVContracted : Str -> STense -> Anteriority -> Polarity -> VAgr -> V -> Str * Str * Str = \sta,t,a,p,agr,v -> + let vt : VForm = case of { + => VPres ; + => VPast ; + _ => VInf + } ; + in + + case of { + => + case v.isAux of { + True => ; + False => case p of { + Pos => <[], sta ++ v.v ! vt, []> ; -- this is the deviating case + Neg => + } + } ; + => + | ; + => + | ; + => + | + } ; + + tensePassV : Str -> STense -> Anteriority -> Polarity -> VAgr -> V -> Str * Str * Str = \sta,t,a,p,agr,v -> let - be = be_Aux sta t a p agr ; + be = be_AuxL sta t a p agr ; + done = v.v ! VPastPart + in + ; + tensePassVContracted : Str -> STense -> Anteriority -> Polarity -> VAgr -> V -> Str * Str * Str = \sta,t,a,p,agr,v -> + let + be = be_AuxC sta t a p agr ; done = v.v ! VPastPart in ; @@ -397,26 +506,41 @@ oper Anter => -- hon vill (ha) sovit } ; - be_Aux : Str -> STense -> Anteriority -> Polarity -> Agr -> Str * Str * Str = \sta,t,a,p,agr -> +----- dangerous variants for PMCFG generation - keep apart as long as possible + be_Aux : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str * Str = \sta,t,a,p,agr -> + be_AuxL sta t a p agr | be_AuxC sta t a p agr ; + be_AuxL : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str * Str = \sta,t,a,p,agr -> let beV = tenseActV sta t a p agr be_V in case of { - => <"is" ++ sta, [], []> - | ; - => <"are" ++ sta, [], []> - | ; - => <"is" ++ sta, "not", []> - | - | <"isn't" ++ sta, [], []> ; - => <"are" ++ sta, "not", []> - | - | <"aren't" ++ sta, [], []> ; - => <"were" ++ sta, [], []> ; - => <"was" ++ sta, "not", []> - | <"wasn't" ++ sta, [], []> ; - => <"were" ++ sta, "not", []> - | <"weren't" ++ sta, [], []> ; + => <"is" ++ sta, [], []> ; + => <"am" ++ sta, [], []> ; + => <"are" ++ sta, [], []> ; + => <"is" ++ sta, "not", []> ; + => <"am" ++ sta, "not", []> ; + => <"are" ++ sta, "not", []> ; + => <"were" ++ sta, [], []> ; + => <"were" ++ sta, "not", []> ; + => <"was" ++ sta, "not", []> ; + _ => beV + } ; + be_AuxC : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str * Str = \sta,t,a,p,agr -> + let + beV = tenseActVContracted sta t a p agr be_V + in + case of { + => ; + => ; + => ; + => + | <"isn't" ++ sta, [], []> ; + => ; + => + | <"aren't" ++ sta, [], []> ; + => <"were" ++ sta, [], []> ; + => <"weren't" ++ sta, [], []> ; + => <"wasn't" ++ sta, [], []> ; _ => beV } ; @@ -424,15 +548,19 @@ oper declSubordCl : Clause -> Str = declCl ; declInvCl : Clause -> Str = declCl ; - questCl : QCl -> Str = \cl -> cl.foc ++ cl.v.p1 ++ cl.subj ++ cl.adV ++ cl.v.p2 ++ restCl cl ; + questCl : QCl -> Str = \cl -> case cl.focType of { + NoFoc => cl.foc ++ cl.qforms.p1 ++ cl.subj ++ cl.adV ++ cl.qforms.p2 ++ restCl cl ; -- does she sleep + FocObj => cl.foc ++ cl.qforms.p1 ++ cl.subj ++ cl.adV ++ cl.qforms.p2 ++ restCl cl ; -- who does she love + FocSubj => cl.foc ++ cl.v.p1 ++ cl.subj ++ cl.adV ++ cl.v.p2 ++ restCl cl -- who loves her + } ; questSubordCl : QCl -> Str = \cl -> let rest = cl.subj ++ cl.adV ++ cl.v.p1 ++ (cl.v.p2 | []) ++ restCl cl in case cl.focType of { - NoFoc => "if" ++ cl.foc ++ rest ; -- om hon sover - FocObj => cl.foc ++ rest ; -- vem älskar hon / varför hon sover - FocSubj => cl.foc ++ "som" ++ rest -- vem som älskar henne + NoFoc => "if" ++ cl.foc ++ rest ; -- om she sleeps + FocObj => cl.foc ++ rest ; -- who she loves / why she sleeps + FocSubj => cl.foc ++ rest -- who loves her } ; that_Compl : Str = "that" | [] ; @@ -450,11 +578,11 @@ oper noObj : Agr => Str = \\_ => [] ; - addObj2VP : VP -> (Agr => Str) -> VP = \vp,obj -> vp ** { + addObj2VP : VerbPhrase -> (Agr => Str) -> VerbPhrase = \vp,obj -> vp ** { obj2 = <\\a => vp.obj2.p1 ! a ++ obj ! a, vp.obj2.p2> ; } ; - addExtVP : VP -> Str -> VP = \vp,ext -> vp ** { + addExtVP : VerbPhrase -> Str -> VerbPhrase = \vp,ext -> vp ** { ext = ext ; } ; @@ -489,8 +617,8 @@ lin professor_N = {s = table {Sg => "professor" ; Pl => "professors"} ; c1 = [] ; c2 = [] ; obj1 = \\_ => []} ; manager_N2 = {s = table {Sg => "manager" ; Pl => "managers"} ; c1 = "for" ; c2 = [] ; obj1 = \\_ => []} ; - she_NP = {s = table {Nom => "she" ; Acc => "her"} ; a = Sg} ; - we_NP = {s = table {Nom => "we" ; Acc => "us"} ; a = Pl} ; + she_NP = {s = table {Nom => "she" ; Acc => "her"} ; a = Ag Sg P3} ; + we_NP = {s = table {Nom => "we" ; Acc => "us"} ; a = Ag Pl P1} ; today_Adv = {s = "today" ; isAdV = False} ; always_AdV = {s = "always" ; isAdV = True} ; @@ -523,19 +651,34 @@ oper edV : Str -> Str = \s -> case s of {us + "e" => us ; _ => s} + "ed" ; ingV : Str -> Str = \s -> case s of {us + "e" => us ; _ => s} + "ing" ; +---- have to split the tables to two to get reasonable PMCFG generation will_Aux : VForm -> Polarity -> Str = \vf,p -> case of { - => "will" | Predef.BIND ++ "'ll" ; + => varAux "will" "ll" ; => "won't" ; - => "would" | Predef.BIND ++ "'d" ; + => varAux "would" "d" ; + => "wouldn't" + } ; + will_AuxC : VForm -> Polarity -> Str = \vf,p -> case of { + => varAuxC "will" "ll" ; + => "won't" ; + => varAuxC "would" "d" ; => "wouldn't" } ; have_Aux : VForm -> Polarity -> Str = \vf,p -> case of { - => "have" | Predef.BIND ++ "'ve" ; --- slightly overgenerating as used in infinitive + => varAux "have" "ve" ; --- slightly overgenerating if used in infinitive => "haven't" ; - => "has" | Predef.BIND ++ "'s" ; + => varAux "has" "s" ; => "hasn't" ; - => "had" | Predef.BIND ++ "'d" ; + => varAux "had" "d" ; + => "hadn't" + } ; + have_AuxC : VForm -> Polarity -> Str = \vf,p -> case of { + => varAuxC "have" "ve" ; --- slightly overgenerating if used in infinitive + => "haven't" ; + => varAuxC "has" "s" ; + => "hasn't" ; + => varAuxC "had" "d" ; => "hadn't" } ; @@ -548,6 +691,9 @@ oper => "didn't" } ; + varAux : Str -> Str -> Str = \long,short -> long ; ----| Predef.BIND ++ ("'" + short) ; + varAuxC : Str -> Str -> Str = \long,short -> Predef.BIND ++ ("'" + short) ; + not_Str : Polarity -> Str = \p -> case p of {Pos => [] ; Neg => "not"} ; } \ No newline at end of file