diff --git a/lib/src/experimental/Pred.gf b/lib/src/experimental/Pred.gf index 8a17a6bd0..2bf263f6a 100644 --- a/lib/src/experimental/Pred.gf +++ b/lib/src/experimental/Pred.gf @@ -1,25 +1,19 @@ -abstract Pred = Cat [Ant,Tense,Pol,NP,Utt,IP,IAdv,Conj] ** { +abstract Pred = Cat [Ant,NP,Utt,IP,IAdv,Conj] ** { cat Arg ; PrV Arg ; PrVP Arg ; VPC Arg ; -- conjunction of VP --- Ant ; --- Tense ; --- Pol ; + Tense ; + Pol ; PrCl Arg ; ClC Arg ; -- conjunction of Cl PrQCl Arg ; --- NP ; PrAdv Arg ; PrS ; --- Utt ; PrAP Arg ; PrCN Arg ; -- the country he became the president of --- IP ; --- Conj ; --- IAdv ; fun aNone, aS, aV, aQ, aA, aN : Arg ; diff --git a/lib/src/experimental/PredEng.gf b/lib/src/experimental/PredEng.gf index 19e8160ab..d70233f5e 100644 --- a/lib/src/experimental/PredEng.gf +++ b/lib/src/experimental/PredEng.gf @@ -1,763 +1,4 @@ -concrete PredEng of Pred = CatEng - [Pol] ** open ResEng, TenseX, Prelude in { - ---------------------- --- parameters ------- ---------------------- - --- standard general -param -{- - Number = Sg | Pl ; - Person = P1 | P2 | P3 ; - Anteriority = Simul | Anter ; - Polarity = Pos | Neg ; - STense = Pres | Past | Fut | Cond ; --} - Voice = Act | Pass ; - Unit = UUnit ; - --- predication specific - FocusType = NoFoc | FocSubj | FocObj ; -- sover hon/om hon sover, vem älskar hon/vem hon älskar, vem sover/vem som sover - -{- --- standard English - Gender = Neutr | Masc | Fem ; - Agr = AgP1 Number | AgP2 Number | AgP3Sg Gender | AgP3Pl ; - Case = Nom | Acc ; - NPCase = NCase Case | NPAcc | NPNomPoss ; - VForm = VInf | VPres | VPast | VPPart | VPresPart ; - - VVForm = VVF VForm | VVPresNeg | VVPastNeg ---- TODO: add all these to VForm - VVType = VVAux | VVInf | VVPresPart --} - -oper - STense = ResEng.Tense ; - --- language dependent -param - VAgr = VASgP1 | VASgP3 | VAPl ; - VType = VTAct | VTRefl | VTAux ; - -oper - subjCase : NPCase = NCase Nom ; - objCase : NPCase = NPAcc ; - - agentCase : ComplCase = "by" ; - - ComplCase = Str ; -- preposition - - NounPhrase = {s : NPCase => Str ; a : Agr} ; - Preposition = {s : Str} ; - - appComplCase : ComplCase -> NounPhrase -> Str = \p,np -> p ++ np.s ! objCase ; - noComplCase : ComplCase = [] ; - prepComplCase : Preposition -> ComplCase = \p -> p.s ; - - noObj : Agr => Str = \\_ => [] ; - - NAgr = Number ; - AAgr = Agr ; -- because of reflexives: "happy with itself" - IPAgr = Number ; - - defaultAgr : Agr = AgP3Sg Neutr ; - --- omitting rich Agr information - agr2vagr : Agr -> VAgr = \a -> case a of { - AgP1 Sg => VASgP1 ; - AgP3Sg _ => VASgP3 ; - _ => VAPl - } ; - - agr2aagr : Agr -> AAgr = \a -> a ; - - agr2nagr : Agr -> NAgr = \a -> case a of { - AgP1 n => n ; - AgP2 n => n ; - AgP3Sg _ => Sg ; - AgP3Pl => Pl - } ; - --- restoring full Agr - ipagr2agr : IPAgr -> Agr = \n -> case n of { - Sg => AgP3Sg Neutr ; ---- gender - Pl => AgP3Pl - } ; - - 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 => AgP1 Sg ; - VASgP3 => AgP3Sg Neutr ; - VAPl => AgP3Pl - } ; - - vPastPart : AAgr -> VForm = \_ -> VPPart ; - vPresPart : AAgr -> VForm = \_ -> VPresPart ; - ------------------------------------- --- lincats -------------------------------------- -lincat -{- --- standard general - Tense = {s : Str ; t : STense} ; - Ant = {s : Str ; a : Anteriority} ; - Pol = {s : Str ; p : Polarity} ; - Utt = {s : Str} ; - IAdv = {s : Str} ; --} - Pol = {s : Str ; p : Polarity} ; - --- predication-specific - Arg = {s : Str} ; - - PrV = { - s : VForm => Str ; - p : Str ; -- verb particle - c1 : ComplCase ; - c2 : ComplCase ; - isSubjectControl : Bool ; - vtype : VType ; - vvtype : VVType ; - } ; - -oper - PrVerbPhrase = { - v : VAgr => Str * Str * Str ; -- would,have,slept - inf : VVType => Str ; -- (not) ((to)(sleep|have slept) | (sleeping|having slept) - c1 : ComplCase ; - c2 : ComplCase ; - part : Str ; -- (look) up - adj : Agr => Str ; - obj1 : (Agr => Str) * Agr ; -- agr for object control - obj2 : (Agr => Str) * Bool ; -- subject control = True - vvtype : VVType ; -- type of VP complement - adv : Str ; - adV : Str ; - ext : Str ; - qforms : VAgr => Str * Str -- special Eng for introducing "do" in questions - } ; - - PrClause = { - v : Str * Str * Str ; - adj,obj1,obj2 : Str ; - adv : Str ; - adV : Str ; - ext : Str ; - subj : Str ; - c3 : ComplCase ; -- for a slashed adjunct, not belonging to the verb valency - qforms : Str * Str - } ; - -lincat - PrVP = PrVerbPhrase ; - PrCl = PrClause ; - - PrQCl = PrClause ** { - foc : Str ; -- the focal position at the beginning: *who* does she love - focType : FocusType ; --- if already filled, then use other place: who loves *who* - } ; - - VPC = { - v : VAgr => Str ; - inf : Agr => Str ; - c1 : ComplCase ; - c2 : ComplCase - } ; - - ClC = { - s : Str ; - c3 : ComplCase ; - } ; - - PrAdv = {s : Str ; isAdV : Bool ; c1 : Str} ; - PrS = {s : Str} ; - - PrAP = { - s : AAgr => Str ; - c1, c2 : ComplCase ; - obj1 : Agr => Str - } ; - - PrCN = { - s : NAgr => Str ; - c1, c2 : ComplCase ; - obj1 : Agr => Str - } ; - -{- --- language specific - NP = {s : NPCase => Str ; a : Agr} ; - IP = {s : NPCase => Str ; n : IPAgr} ; ---- n : Number in Eng - Conj = {s1,s2 : Str ; n : Number} ; --} - - --- reference linearizations for chunking - -linref - PrVP = \vp -> - let - agr = defaultAgr ; - vagr = agr2vagr agr ; - verb = vp.v ! vagr ; - in - verb.p1 ++ verb.p2 ++ vp.adV ++ verb.p3 ++ vp.part ++ - vp.adj ! agr ++ vp.obj1.p1 ! agr ++ vp.obj2.p1 ! agr ++ vp.adv ++ vp.ext ; - - PrCl = \cl -> declCl cl ; ----- PrQCl = \qcl -> questCl (lin PrQCl qcl) ; - PrAdv = \adv -> adv.c1 ++ adv.s ; - PrAP = \ap -> ap.s ! defaultAgr ++ ap.obj1 ! defaultAgr ; - PrCN = \cn -> cn.s ! Sg ++ cn.obj1 ! defaultAgr ; - ----------------------------- ---- linearization rules ---- ----------------------------- - -lin - --- standard general - - TPres = {s = [] ; t = Pres} ; - TPast = {s = [] ; t = Past} ; - TFut = {s = [] ; t = Fut} ; - TCond = {s = [] ; t = Cond} ; - ASimul = {s = [] ; a = Simul} ; - AAnter = {s = [] ; a = Anter} ; - PPos = {s = [] ; p = Pos} ; - PNeg = {s = [] ; p = Neg} ; - --- predication specific - - aNone, aS, aV, aA, aQ, aN = {s = []} ; - aNP a = a ; - - UseV a t p _ v = { - v = \\agr => tenseV (a.s ++ t.s ++ p.s) t.t a.a p.p Act agr v ; - inf = tenseInfV a.s a.a p.p Act v ; - c1 = v.c1 ; - c2 = v.c2 ; - part = v.p ; - adj = noObj ; - obj1 = \\a => reflPron ! a ; _ => \\_ => []}, defaultAgr> ; ---- not used, just default value - obj2 = ; - vvtype = v.vvtype ; - adV = negAdV p ; --- just p.s in Eng - adv = [] ; - ext = [] ; - qforms = \\agr => qformsV (a.s ++ t.s ++ p.s) t.t a.a p.p agr v ; - } ; - - - PassUseV a t p _ v = { - v = \\agr => tenseV (a.s ++ t.s ++ p.s) t.t a.a p.p Pass agr v ; - inf = tenseInfV a.s a.a p.p Pass v ; - c1 = v.c1 ; - c2 = v.c2 ; - part = v.p ; - adj = noObj ; - obj1 = ; ---- not used, just default value - obj2 = ; -- becomes subject control even if object control otherwise "*she was promised by us to love ourselves" - vvtype = v.vvtype ; - 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 = { - v = \\agr => tenseV (a.s ++ t.s ++ p.s) t.t a.a p.p Pass agr v ; - inf = tenseInfV a.s a.a p.p Pass v ; - c1 = v.c1 ; - c2 = v.c2 ; - part = v.p ; - adj = \\a => [] ; - obj1 = ; - obj2 = ; - vvtype = v.vvtype ; - adV = negAdV p ; - adv = appComplCase agentCase np ; - ext = [] ; - qforms = \\agr => qformsBe (a.s ++ t.s ++ p.s) t.t a.a p.p agr ; - } ; - - UseAP a t p _ ap = { - v = \\agr => be_Aux (a.s ++ t.s ++ p.s) t.t a.a p.p agr ; - inf = tenseInfV a.s a.a p.p Act be_V ; - c1 = ap.c1 ; - c2 = ap.c2 ; - part = [] ; - adj = \\a => ap.s ! agr2aagr a ; - obj1 = ; - obj2 = ; --- there are no A3's - vvtype = be_V.vvtype ; - 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 ** { - obj1 : (Agr => Str) * Agr = <\\a => np.s ! objCase, np.a> -- np.a for object control - } ; - - SlashV3 x vp np = addObj2VP vp (\\a => np.s ! objCase) ; -- control is preserved - - ComplVS x vp cl = addExtVP vp (that_Compl ++ declSubordCl (lin Cl cl)) ; ---- sentence form - - ComplVQ x vp qcl = addExtVP vp (questSubordCl qcl) ; ---- question form - - ComplVV x vp vpo = addObj2VP vp (\\a => infVP vp.vvtype a vpo) ; - - ComplVA x vp ap = addObj2VP vp (\\a => ap.s ! agr2aagr a ++ ap.obj1 ! a) ; ---- adjForm - - 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 - - SlashV2Q x vp cl = addExtVP vp (questSubordCl (lin QCl cl)) ; ---- question form - - SlashV2V x vp vpo = addObj2VP vp (\\a => infVP vp.vvtype a (lin VP vpo)) ; - - SlashV2A x vp ap = addObj2VP vp (\\a => ap.s ! agr2aagr a ++ ap.obj1 ! a) ; ---- adjForm - - 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> ; --- defaultAgr will not be used but subj.a instead - } ; - - ReflVP2 x vp = vp ** { - obj2 : (Agr => Str) * Bool = <\\a => reflPron ! a, vp.obj2.p2> ; --- subj/obj control doesn't matter any more - } ; - - PredVP x np vp = vp ** { - v = vp.v ! agr2vagr np.a ; - subj = np.s ! subjCase ; - adj = vp.adj ! np.a ; - obj1 = vp.part ++ vp.c1 ++ vp.obj1.p1 ! np.a ; ---- apply complCase ---- place of part depends on obj - 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 - c3 = prepComplCase p ; - } ; - - SlashClNP x cl np = cl ** { -- Cl ::= Cl/NP NP - adv = cl.adv ++ appComplCase cl.c3 np ; ---- again, adv just added - c3 = noComplCase ; -- complCase has been consumed - } ; - - --- QCl ::= Cl by just adding focus field - QuestCl x cl = cl ** {foc = [] ; focType = NoFoc} ; -- NoFoc implies verb first: does she love us - - QuestIAdv x iadv cl = cl ** {foc = iadv.s ; focType = FocObj} ; -- FocObj implies Foc + V + Subj: why does she love us - - QuestVP x ip vp = let ipa = ipagr2agr ip.n in - vp ** { - v = vp.v ! ipagr2vagr ip.n ; - foc = ip.s ! subjCase ; -- who (loves her) - focType = FocSubj ; - subj = [] ; - adj = vp.adj ! ipa ; - obj1 = vp.part ++ 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.n ; - } ; - - QuestSlash x ip cl = - let - prep = cl.c3 ; - ips = ip.s ! objCase ; -- in Cl/NP, c3 is the only prep ---- appComplCase for ip - focobj = case cl.focType of { - NoFoc => ; -- put ip object to focus if there is no focus yet - t => <[], prep ++ ips, t,noComplCase> -- put ip object in situ if there already is a focus - } ; - in - cl ** { -- preposition stranding - foc = focobj.p1 ; - focType = focobj.p3 ; - obj1 = cl.obj1 ++ focobj.p2 ; ---- just add to a field? - c3 = focobj.p4 ; - } ; -{- ----- this is giving four records instead of two AR 5/2/2014 - | - cl ** { -- pied piping - foc = focobj.p4 ++ focobj.p1 ; - focType = focobj.p3 ; - obj1 = cl.obj1 ++ focobj.p2 ; ---- just add to a field? - c3 = noComplCase ; - } ; --} - - UseCl cl = {s = declCl cl} ; - UseQCl cl = {s = questCl cl} ; - ----- UseAdvCl adv cl = {s = adv.s ++ declInvCl cl} ; - - UttS s = s ; - - - AdvCl x a cl = case a.isAdV of { - True => cl ** {adV = cl.adV ++ a.s ; adv = cl.adv ; c3 = a.c1} ; - False => cl ** {adv = cl.adv ++ a.s ; adV = cl.adV ; c3 = a.c1} - } ; - - AdvQCl x a cl = case a.isAdV of { - True => cl ** {adV = cl.adV ++ a.s ; adv = cl.adv ; c3 = a.c1} ; - False => cl ** {adv = cl.adv ++ a.s ; adV = cl.adV ; c3 = a.c1} - } ; - - - PresPartAP x v = { - s = \\a => v.s ! vPresPart a ; - c1 = v.c1 ; -- looking at her - c2 = v.c2 ; - obj1 = noObj ; - } ; - - PastPartAP x v = { - s = \\a => v.s ! vPastPart a ; - c1 = v.c1 ; - c2 = v.c2 ; - obj1 = noObj ; - } ; - - AgentPastPartAP x v np = { - s = \\a => v.s ! vPastPart a ; - c1 = v.c1 ; - c2 = v.c2 ; - obj1 = \\_ => appComplCase agentCase np ; ---- addObj - } ; - - - StartVPC c x v w = { ---- some loss of quality seems inevitable - 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 ! vpa ++ - v.c1 ++ v.obj1.p1 ! vpa ++ v.c2 ++ v.obj2.p1 ! vpa ++ v.adv ++ v.ext ---- appComplCase - ++ c.s2 ++ - 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 => - PredEng.infVP v.vvtype a v ++ c.s2 ++ PredEng.infVP w.vvtype a w ; - c1 = [] ; ---- w.c1 ? --- the full story is to unify v and w... - c2 = [] ; ---- w.c2 ? - } ; - - UseVPC x vpc = { ---- big loss of quality (overgeneration) seems inevitable - v = \\a => <[], [], vpc.v ! a> ; - inf = \\_ => vpc.inf ! defaultAgr ; ---- agreement - c1 = vpc.c1 ; - c2 = vpc.c2 ; - part = [] ; - adj = \\a => [] ; - obj1 = ; - obj2 = ; - vvtype = VVInf ; ---- - adv,adV = [] ; - ext = [] ; - qforms = \\a => <"do", vpc.inf ! defaultAgr> ; ---- do/does/did - } ; - - StartClC c x a b = { - s = declCl (lin Cl a) ++ c.s2 ++ declCl (lin Cl b) ; - c3 = b.c3 ; ---- - } ; - - UseClC x cl = { - subj = [] ; - v = <[],[],cl.s> ; ---- - inf = [] ; - adj = [] ; - obj1 = [] ; - obj2 = [] ; - adV = [] ; - adv = [] ; - ext = [] ; - c3 = cl.c3 ; - qforms = <[],[]> ; ---- qforms - } ; - - ComplAdv x p np = {s = p.c1 ++ np.s ! objCase ; isAdV = p.isAdV ; c1 = []} ; - - - - - -oper - infVP : VVType -> Agr -> PrVerbPhrase -> Str = \vt, a,vp -> - let - a2 = case vp.obj2.p2 of {True => a ; False => vp.obj1.p2} ; - in - vp.adV ++ vp.inf ! vt ++ vp.part ++ - vp.adj ! a ++ vp.c1 ++ vp.obj1.p1 ! a ++ vp.c2 ++ vp.obj2.p1 ! a2 ++ vp.adv ++ vp.ext ; - - qformsV : Str -> STense -> Anteriority -> Polarity -> VAgr -> PrV -> 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 - } ; - _ => - } ; - - 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 -> PrV -> 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 these 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 -> PrV -> Str * Str * Str = \sta,t,a,p,agr,v -> - let vt : VForm = case of { - => VPres ; - => VPast ; - _ => VInf - } ; - in - case of { - => - case v.vtype of { - VTAux => ; - _ => case p of { - Pos => <[], sta ++ v.s ! vt, []> ; -- this is the deviating case - Neg => - } - } ; - - => ; - => ; - => - } ; - - tenseActVContracted : Str -> STense -> Anteriority -> Polarity -> VAgr -> PrV -> Str * Str * Str = \sta,t,a,p,agr,v -> - let vt : VForm = case of { - => VPres ; - => VPast ; - _ => VInf - } ; - in - - case of { - => - case v.vtype of { - VTAux => ; - _ => case p of { - Pos => <[], sta ++ v.s ! vt, []> ; -- this is the deviating case - Neg => - } - } ; - => - | ; - => - | ; - => - | - } ; - - tensePassV : Str -> STense -> Anteriority -> Polarity -> VAgr -> PrV -> Str * Str * Str = \sta,t,a,p,agr,v -> - let - be = be_AuxL sta t a p agr ; - done = v.s ! VPPart - in - ; - tensePassVContracted : Str -> STense -> Anteriority -> Polarity -> VAgr -> PrV -> Str * Str * Str = \sta,t,a,p,agr,v -> - let - be = be_AuxC sta t a p agr ; - done = v.s ! VPPart - in - ; - - tenseInfV : Str -> Anteriority -> Polarity -> Voice -> PrV -> VVType => Str = \sa,a,p,o,v -> \\vt => - let - not = case p of {Pos => [] ; Neg => "not"} ; - in - case vt of { - VVInf => - case a of { - Simul => not ++ "to" ++ sa ++ v.s ! VInf ; -- (she wants) (not) to sleep - Anter => not ++ "to" ++ have_Aux VInf Pos ++ sa ++ v.s ! VPPart -- (she wants) (not) to have slept - } ; - VVAux => - case a of { - Simul => not ++ sa ++ v.s ! VInf ; -- (she must) (not) sleep - Anter => not ++ have_Aux VInf Pos ++ sa ++ v.s ! VPPart -- (she must) (not) have slept - } ; - VVPresPart => - case a of { - Simul => not ++ sa ++ v.s ! VPresPart ; -- (she starts) (not) sleeping - Anter => not ++ "having" ++ sa ++ v.s ! VPPart -- (she starts) (not) having slept - } - } ; - ------ 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, [], []> ; - => <"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 - } ; - - declCl : PrClause -> Str = \cl -> cl.subj ++ cl.v.p1 ++ cl.adV ++ cl.v.p2 ++ restCl cl ; - declSubordCl : PrClause -> Str = declCl ; - declInvCl : PrClause -> Str = declCl ; - - questCl : PrQCl -> 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 : PrQCl -> 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 she sleeps - FocObj => cl.foc ++ rest ; -- who she loves / why she sleeps - FocSubj => cl.foc ++ rest -- who loves her - } ; - - that_Compl : Str = "that" | [] ; - - -- this part is usually the same in all reconfigurations - restCl : PrClause -> Str = \cl -> cl.v.p3 ++ cl.adj ++ cl.obj1 ++ cl.obj2 ++ cl.adv ++ cl.ext ++ cl.c3 ; - - - addObj2VP : PrVerbPhrase -> (Agr => Str) -> PrVerbPhrase = \vp,obj -> vp ** { - obj2 = <\\a => vp.obj2.p1 ! a ++ obj ! a, vp.obj2.p2> ; - } ; - - addExtVP : PrVerbPhrase -> Str -> PrVerbPhrase = \vp,ext -> vp ** { - ext = ext ; - } ; - - - - -oper - be_V : PrV = lin PrV { - s = table { - VInf => "be" ; - VPres => "is" ; - VPast => "was" ; - VPPart => "been" ; - VPresPart => "being" - } ; - p,c1,c2 = [] ; vtype = VTAux ; vvtype = VVInf ; isSubjectControl = False - } ; - - negAdV : PredEng.Pol -> Str = \p -> p.s ; - - - - - - -oper ----- have to split the tables to two to get reasonable PMCFG generation - will_Aux : VForm -> Polarity -> Str = \vf,p -> case of { - => varAux "will" "ll" ; - => "won't" ; - => 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 { - => varAux "have" "ve" ; --- slightly overgenerating if used in infinitive - => "haven't" ; - => varAux "has" "s" ; - => "hasn't" ; - => 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" - } ; - - do_Aux : VForm -> Polarity -> Str = \vf,p -> case of { - => "do" ; - => "don't" ; - => "does" ; - => "doesn't" ; - => "did" ; - => "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 +concrete PredEng of Pred = + CatEng [Ant,NP,Utt,IP,IAdv,Conj] ** + PredFunctor with + (PredInterface = PredInstanceEng) ; diff --git a/lib/src/experimental/PredFunctor.gf b/lib/src/experimental/PredFunctor.gf new file mode 100644 index 000000000..be508b3ff --- /dev/null +++ b/lib/src/experimental/PredFunctor.gf @@ -0,0 +1,346 @@ +incomplete concrete PredFunctor of Pred = Cat [Ant,NP,Utt,IP,IAdv,Conj] ** + open + PredInterface, + ParamX, + Prelude + in { + +------------------------------------ +-- lincats +------------------------------------- + +lincat + Tense = {s : Str ; t : PredInterface.STense} ; + Pol = {s : Str ; p : PredInterface.Polarity} ; + + Arg = {s : Str} ; + + PrV = PrVerb ; + PrVP = PrVerbPhrase ; + PrCl = PrClause ; + + PrQCl = PrQuestionClause ; + + VPC = { + v : VAgr => Str ; + inf : Agr => Str ; + c1 : ComplCase ; + c2 : ComplCase + } ; + + ClC = { + s : Str ; + c3 : ComplCase ; + } ; + + PrAdv = {s : Str ; isAdV : Bool ; c1 : Str} ; + PrS = {s : Str} ; + + PrAP = { + s : AAgr => Str ; + c1, c2 : ComplCase ; + obj1 : Agr => Str + } ; + + PrCN = { + s : NAgr => Str ; + c1, c2 : ComplCase ; + obj1 : Agr => Str + } ; + +-- reference linearizations for chunking + +linref + PrVP = \vp -> + let + agr = defaultAgr ; + vagr = agr2vagr agr ; + verb = vp.v ! vagr ; + in + verb.p1 ++ verb.p2 ++ vp.adV ++ verb.p3 ++ vp.part ++ + vp.adj ! agr ++ vp.obj1.p1 ! agr ++ vp.obj2.p1 ! agr ++ vp.adv ++ vp.ext ; + + PrCl = \cl -> declCl cl ; +---- PrQCl = \qcl -> questCl (lin PrQCl qcl) ; + PrAdv = \adv -> adv.c1 ++ adv.s ; + PrAP = \ap -> ap.s ! defaultAgr ++ ap.obj1 ! defaultAgr ; + PrCN = \cn -> cn.s ! Sg ++ cn.obj1 ! defaultAgr ; + +---------------------------- +--- linearization rules ---- +---------------------------- + +lin + +-- standard general + + TPres = {s = [] ; t = Pres} ; + TPast = {s = [] ; t = Past} ; + TFut = {s = [] ; t = Fut} ; + TCond = {s = [] ; t = Cond} ; + ASimul = {s = [] ; a = Simul} ; + AAnter = {s = [] ; a = Anter} ; + PPos = {s = [] ; p = Pos} ; + PNeg = {s = [] ; p = Neg} ; + +-- predication specific + + aNone, aS, aV, aA, aQ, aN = {s = []} ; + aNP a = a ; + + UseV a t p _ v = { + v = \\agr => tenseV (a.s ++ t.s ++ p.s) t.t a.a p.p Act agr v ; + inf = tenseInfV a.s a.a p.p Act v ; + c1 = v.c1 ; + c2 = v.c2 ; + part = v.p ; + adj = noObj ; + obj1 = \\a => reflPron a ; _ => \\_ => []}, defaultAgr> ; ---- not used, just default value + obj2 = ; + vvtype = v.vvtype ; + adV = negAdV p ; --- just p.s in Eng + adv = [] ; + ext = [] ; + qforms = \\agr => qformsV (a.s ++ t.s ++ p.s) t.t a.a p.p agr v ; + } ; + + PassUseV a t p _ v = { + v = \\agr => tenseV (a.s ++ t.s ++ p.s) t.t a.a p.p Pass agr v ; + inf = tenseInfV a.s a.a p.p Pass v ; + c1 = v.c1 ; + c2 = v.c2 ; + part = v.p ; + adj = noObj ; + obj1 = ; ---- not used, just default value + obj2 = ; -- becomes subject control even if object control otherwise "*she was promised by us to love ourselves" + vvtype = v.vvtype ; + 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 = { + v = \\agr => tenseV (a.s ++ t.s ++ p.s) t.t a.a p.p Pass agr v ; + inf = tenseInfV a.s a.a p.p Pass v ; + c1 = v.c1 ; + c2 = v.c2 ; + part = v.p ; + adj = \\a => [] ; + obj1 = ; + obj2 = ; + vvtype = v.vvtype ; + adV = negAdV p ; + adv = appComplCase agentCase np ; + ext = [] ; + qforms = \\agr => qformsBe (a.s ++ t.s ++ p.s) t.t a.a p.p agr ; + } ; + + UseAP a t p _ ap = { + v = \\agr => be_Aux (a.s ++ t.s ++ p.s) t.t a.a p.p agr ; + inf = tenseInfV a.s a.a p.p Act be_V ; + c1 = ap.c1 ; + c2 = ap.c2 ; + part = [] ; + adj = \\a => ap.s ! agr2aagr a ; + obj1 = ; + obj2 = ; --- there are no A3's + vvtype = be_V.vvtype ; + 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 ** { + obj1 = <\\a => np.s ! objCase, np.a> -- np.a for object control + } ; + + SlashV3 x vp np = addObj2VP vp (\\a => np.s ! objCase) ; -- control is preserved + + ComplVS x vp cl = addExtVP vp (that_Compl ++ declSubordCl (lin Cl cl)) ; ---- sentence form + + ComplVQ x vp qcl = addExtVP vp (questSubordCl qcl) ; ---- question form + + ComplVV x vp vpo = addObj2VP vp (\\a => infVP vp.vvtype a vpo) ; + + ComplVA x vp ap = addObj2VP vp (\\a => ap.s ! agr2aagr a ++ ap.obj1 ! a) ; ---- adjForm + + 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 + + SlashV2Q x vp cl = addExtVP vp (questSubordCl (lin QCl cl)) ; ---- question form + + SlashV2V x vp vpo = addObj2VP vp (\\a => infVP vp.vvtype a (lin VP vpo)) ; + + SlashV2A x vp ap = addObj2VP vp (\\a => ap.s ! agr2aagr a ++ ap.obj1 ! a) ; ---- adjForm + + SlashV2N x vp cn = addObj2VP vp (\\a => cn.s ! agr2nagr a ++ cn.obj1 ! a) ; ---- cn form + + ReflVP x vp = vp ** { + obj1 = <\\a => reflPron a, defaultAgr> ; --- defaultAgr will not be used but subj.a instead + } ; + + ReflVP2 x vp = vp ** { + obj2 = <\\a => reflPron a, vp.obj2.p2> ; --- subj/obj control doesn't matter any more + } ; + + PredVP x np vp = vp ** { + v = vp.v ! agr2vagr np.a ; + subj = np.s ! subjCase ; + adj = vp.adj ! np.a ; + obj1 = vp.part ++ vp.c1 ++ vp.obj1.p1 ! np.a ; ---- apply complCase ---- place of part depends on obj + 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 ; + } ; + + SlashClNP x cl np = cl ** { -- Cl ::= Cl/NP NP + adv = cl.adv ++ appComplCase cl.c3 np ; ---- again, adv just added + c3 = noComplCase ; -- complCase has been consumed + } ; + + QuestCl x cl = cl ** {foc = [] ; focType = NoFoc} ; -- NoFoc implies verb first: does she love us + + QuestIAdv x iadv cl = cl ** {foc = iadv.s ; focType = FocObj} ; -- FocObj implies Foc + V + Subj: why does she love us + + QuestVP x ip vp = + let + ipa = ipagr2agr ip.n + in { + v = vp.v ! ipagr2vagr ip.n ; + foc = ip.s ! subjCase ; -- who (loves her) + focType = FocSubj ; + subj = [] ; + adj = vp.adj ! ipa ; + obj1 = vp.part ++ 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? + adv = vp.adv ; + adV = vp.adV ; + ext = vp.ext ; + qforms = vp.qforms ! ipagr2vagr ip.n ; + } ; + + + QuestSlash x ip cl = + let + prep = cl.c3 ; + ips = ip.s ! objCase ; -- in Cl/NP, c3 is the only prep ---- appComplCase for ip + focobj = case cl.focType of { + NoFoc => ; -- put ip object to focus if there is no focus yet + t => <[], prep ++ ips, t,noComplCase> -- put ip object in situ if there already is a focus + } ; + in + cl ** { -- preposition stranding + foc = focobj.p1 ; + focType = focobj.p3 ; + obj1 = cl.obj1 ++ focobj.p2 ; ---- just add to a field? + c3 = focobj.p4 ; + } ; +{- +---- this is giving four records instead of two AR 5/2/2014 + | + cl ** { -- pied piping + foc = focobj.p4 ++ focobj.p1 ; + focType = focobj.p3 ; + obj1 = cl.obj1 ++ focobj.p2 ; ---- just add to a field? + c3 = noComplCase ; + } ; +-} + + UseCl cl = {s = declCl cl} ; + UseQCl cl = {s = questCl cl} ; + +---- UseAdvCl adv cl = {s = adv.s ++ declInvCl cl} ; + + UttS s = s ; + + + AdvCl x a cl = case a.isAdV of { + True => cl ** {adV = cl.adV ++ a.s ; adv = cl.adv ; c3 = a.c1} ; + False => cl ** {adv = cl.adv ++ a.s ; adV = cl.adV ; c3 = a.c1} + } ; + + AdvQCl x a cl = case a.isAdV of { + True => cl ** {adV = cl.adV ++ a.s ; adv = cl.adv ; c3 = a.c1} ; + False => cl ** {adv = cl.adv ++ a.s ; adV = cl.adV ; c3 = a.c1} + } ; + + PresPartAP x v = { + s = \\a => vPresPart v a ; + c1 = v.c1 ; -- looking at her + c2 = v.c2 ; + obj1 = noObj ; + } ; + + PastPartAP x v = { + s = \\a => vPastPart v a ; + c1 = v.c1 ; + c2 = v.c2 ; + obj1 = noObj ; + } ; + + AgentPastPartAP x v np = { + s = \\a => vPastPart v a ; + c1 = v.c1 ; + c2 = v.c2 ; + obj1 = \\_ => appComplCase agentCase np ; ---- addObj + } ; + + StartVPC c x v w = { ---- some loss of quality seems inevitable + 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 ! vpa ++ + v.c1 ++ v.obj1.p1 ! vpa ++ v.c2 ++ v.obj2.p1 ! vpa ++ v.adv ++ v.ext ---- appComplCase + ++ c.s2 ++ + 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 v.vvtype a v ++ c.s2 ++ infVP w.vvtype a w ; + c1 = [] ; ---- w.c1 ? --- the full story is to unify v and w... + c2 = [] ; ---- w.c2 ? + } ; + + UseVPC x vpc = { ---- big loss of quality (overgeneration) seems inevitable + v = \\a => <[], [], vpc.v ! a> ; + inf = \\_ => vpc.inf ! defaultAgr ; ---- agreement + c1 = vpc.c1 ; + c2 = vpc.c2 ; + part = [] ; + adj = \\a => [] ; + obj1 = ; + obj2 = ; + vvtype = vvInfinitive ; ---- + adv,adV = [] ; + ext = [] ; + qforms = \\a => <"do", vpc.inf ! defaultAgr> ; ---- do/does/did + } ; + + StartClC c x a b = { + s = declCl (lin Cl a) ++ c.s2 ++ declCl (lin Cl b) ; + c3 = b.c3 ; ---- + } ; + + UseClC x cl = { + subj = [] ; + v = <[],[],cl.s> ; ---- + inf = [] ; + adj = [] ; + obj1 = [] ; + obj2 = [] ; + adV = [] ; + adv = [] ; + ext = [] ; + c3 = cl.c3 ; + qforms = <[],[]> ; ---- qforms + } ; + + ComplAdv x p np = {s = p.c1 ++ np.s ! objCase ; isAdV = p.isAdV ; c1 = []} ; + +} \ No newline at end of file diff --git a/lib/src/experimental/PredInstanceEng.gf b/lib/src/experimental/PredInstanceEng.gf new file mode 100644 index 000000000..c19835708 --- /dev/null +++ b/lib/src/experimental/PredInstanceEng.gf @@ -0,0 +1,344 @@ +instance PredInstanceEng of PredInterface = open ResEng, (X = ParamX), Prelude in { + +--------------------- +-- parameters ------- +--------------------- + +oper + Gender = ResEng.Gender ; + Agr = ResEng.Agr ; + Case = ResEng.Case ; + NPCase = ResEng.NPCase ; + VForm = ResEng.VForm ; + VVType = ResEng.VVType ; + +--oper STense = ResEng.Tense ; + +param + VAgr = VASgP1 | VASgP3 | VAPl ; + VType = VTAct | VTRefl | VTAux ; + +oper + subjCase : NPCase = NCase Nom ; + objCase : NPCase = NPAcc ; + + agentCase : ComplCase = "by" ; + + ComplCase = Str ; -- preposition + + NounPhrase = {s : NPCase => Str ; a : Agr} ; + + appComplCase : ComplCase -> NounPhrase -> Str = \p,np -> p ++ np.s ! objCase ; + noComplCase : ComplCase = [] ; + + noObj : Agr => Str = \\_ => [] ; + + NAgr = Number ; + IPAgr = Number ; + + defaultAgr : Agr = AgP3Sg Neutr ; + +-- omitting rich Agr information + agr2vagr : Agr -> VAgr = \a -> case a of { + AgP1 Sg => VASgP1 ; + AgP3Sg _ => VASgP3 ; + _ => VAPl + } ; + + agr2aagr : Agr -> AAgr = \a -> a ; + + agr2nagr : Agr -> NAgr = \a -> case a of { + AgP1 n => n ; + AgP2 n => n ; + AgP3Sg _ => Sg ; + AgP3Pl => Pl + } ; + +-- restoring full Agr + ipagr2agr : IPAgr -> Agr = \n -> case n of { + Sg => AgP3Sg Neutr ; ---- gender + Pl => AgP3Pl + } ; + + 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 => AgP1 Sg ; + VASgP3 => AgP3Sg Neutr ; + VAPl => AgP3Pl + } ; + + vPastPart : PrVerb -> AAgr -> Str = \v,_ -> v.s ! VPPart ; + vPresPart : PrVerb -> AAgr -> Str = \v,_ -> v.s ! VPresPart ; + + vvInfinitive : VVType = VVInf ; + +----------------------- +-- concrete opers +----------------------- + +oper + reflPron : Agr -> Str = \a -> ResEng.reflPron ! a ; + + infVP : VVType -> Agr -> PrVerbPhrase -> Str = \vt, a,vp -> + let + a2 = case vp.obj2.p2 of {True => a ; False => vp.obj1.p2} ; + in + vp.adV ++ vp.inf ! vt ++ vp.part ++ + vp.adj ! a ++ vp.c1 ++ vp.obj1.p1 ! a ++ vp.c2 ++ vp.obj2.p1 ! a2 ++ vp.adv ++ vp.ext ; + + qformsV : Str -> STense -> Anteriority -> Polarity -> VAgr -> PrVerb -> 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 + } ; + _ => + } ; + + 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 -> PrVerb -> 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 these 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 -> PrVerb -> Str * Str * Str = \sta,t,a,p,agr,v -> + let vt : VForm = case of { + => VPres ; + => VPast ; + _ => VInf + } ; + in + case of { + => + case v.vtype of { + VTAux => ; + _ => case p of { + Pos => <[], sta ++ v.s ! vt, []> ; -- this is the deviating case + Neg => + } + } ; + + => ; + => ; + => + } ; + + tenseActVContracted : Str -> STense -> Anteriority -> Polarity -> VAgr -> PrVerb -> Str * Str * Str = \sta,t,a,p,agr,v -> + let vt : VForm = case of { + => VPres ; + => VPast ; + _ => VInf + } ; + in + + case of { + => + case v.vtype of { + VTAux => ; + _ => case p of { + Pos => <[], sta ++ v.s ! vt, []> ; -- this is the deviating case + Neg => + } + } ; + => + | ; + => + | ; + => + | + } ; + + tensePassV : Str -> STense -> Anteriority -> Polarity -> VAgr -> PrVerb -> Str * Str * Str = \sta,t,a,p,agr,v -> + let + be = be_AuxL sta t a p agr ; + done = v.s ! VPPart + in + ; + tensePassVContracted : Str -> STense -> Anteriority -> Polarity -> VAgr -> PrVerb -> Str * Str * Str = \sta,t,a,p,agr,v -> + let + be = be_AuxC sta t a p agr ; + done = v.s ! VPPart + in + ; + + tenseInfV : Str -> Anteriority -> Polarity -> Voice -> PrVerb -> VVType => Str = \sa,a,p,o,v -> \\vt => + let + not = case p of {Pos => [] ; Neg => "not"} ; + in + case vt of { + VVInf => + case a of { + Simul => not ++ "to" ++ sa ++ v.s ! VInf ; -- (she wants) (not) to sleep + Anter => not ++ "to" ++ have_Aux VInf Pos ++ sa ++ v.s ! VPPart -- (she wants) (not) to have slept + } ; + VVAux => + case a of { + Simul => not ++ sa ++ v.s ! VInf ; -- (she must) (not) sleep + Anter => not ++ have_Aux VInf Pos ++ sa ++ v.s ! VPPart -- (she must) (not) have slept + } ; + VVPresPart => + case a of { + Simul => not ++ sa ++ v.s ! VPresPart ; -- (she starts) (not) sleeping + Anter => not ++ "having" ++ sa ++ v.s ! VPPart -- (she starts) (not) having slept + } + } ; + +----- 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, [], []> ; + => <"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 + } ; + + declCl : PrClause -> Str = \cl -> cl.subj ++ cl.v.p1 ++ cl.adV ++ cl.v.p2 ++ restCl cl ; + declSubordCl : PrClause -> Str = declCl ; + declInvCl : PrClause -> Str = declCl ; + + questCl : PrQuestionClause -> 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 : PrQuestionClause -> 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 she sleeps + FocObj => cl.foc ++ rest ; -- who she loves / why she sleeps + FocSubj => cl.foc ++ rest -- who loves her + } ; + + that_Compl : Str = "that" | [] ; + + -- this part is usually the same in all reconfigurations + restCl : PrClause -> Str = \cl -> cl.v.p3 ++ cl.adj ++ cl.obj1 ++ cl.obj2 ++ cl.adv ++ cl.ext ++ cl.c3 ; + + + addObj2VP : PrVerbPhrase -> (Agr => Str) -> PrVerbPhrase = \vp,obj -> vp ** { + obj2 = <\\a => vp.obj2.p1 ! a ++ obj ! a, vp.obj2.p2> ; + } ; + + addExtVP : PrVerbPhrase -> Str -> PrVerbPhrase = \vp,ext -> vp ** { + ext = ext ; + } ; + + + + +oper + be_V : PrVerb = { + s = table { + VInf => "be" ; + VPres => "is" ; + VPast => "was" ; + VPPart => "been" ; + VPresPart => "being" + } ; + p,c1,c2 = [] ; vtype = VTAux ; vvtype = VVInf ; isSubjectControl = False + } ; + + negAdV : {s : Str ; p : Polarity} -> Str = \p -> p.s ; + + + + +oper +---- have to split the tables to two to get reasonable PMCFG generation + will_Aux : VForm -> Polarity -> Str = \vf,p -> case of { + => varAux "will" "ll" ; + => "won't" ; + => 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 { + => varAux "have" "ve" ; --- slightly overgenerating if used in infinitive + => "haven't" ; + => varAux "has" "s" ; + => "hasn't" ; + => 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" + } ; + + do_Aux : VForm -> Polarity -> Str = \vf,p -> case of { + => "do" ; + => "don't" ; + => "does" ; + => "doesn't" ; + => "did" ; + => "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 diff --git a/lib/src/experimental/PredInterface.gf b/lib/src/experimental/PredInterface.gf new file mode 100644 index 000000000..3b67d873b --- /dev/null +++ b/lib/src/experimental/PredInterface.gf @@ -0,0 +1,158 @@ +interface PredInterface = open Prelude, (X = ParamX) in { + +--------------------- +-- parameters ------- +--------------------- + +-- standard usually general +oper + Number : PType = X.Number ; + Person : PType = X.Person ; + Anteriority : PType = X.Anteriority ; + Polarity : PType = X.Polarity ; + STense : PType = X.Tense ; + +param + Voice = Act | Pass ; --- should be in ParamX + Unit = UUnit ; --- should be in Prelude + +-- this works for typical "wh movement" languages + + FocusType = NoFoc | FocSubj | FocObj ; -- sover hon/om hon sover, vem älskar hon/vem hon älskar, vem sover/vem som sover + +-- language-dependent + +oper + Gender : PType ; + Agr : PType ; -- full agreement, inherent in NP + Case : PType ; -- case of CN + NPCase : PType ; -- full case of NP + VForm : PType ; -- inflection form of V + VVType : PType ; -- infinitive form required by VV + + +-- language dependent +param + VAgr ; -- agr features that a verb form depends on + VType ; -- reflexive, auxiliary, deponent,... + +oper + subjCase : NPCase ; + objCase : NPCase ; + + ComplCase : Type ; -- e.g. preposition + agentCase : ComplCase ; + + + NounPhrase : Type = {s : NPCase => Str ; a : Agr} ; + + appComplCase : ComplCase -> NounPhrase -> Str ; + noComplCase : ComplCase ; + + noObj : Agr => Str = \\_ => [] ; + + NAgr : PType ; + AAgr = Agr ; -- because of reflexives: "happy with itself" + IPAgr : PType ; + + defaultAgr : Agr ; + +-- omitting parts of Agr information + + agr2vagr : Agr -> VAgr ; + agr2aagr : Agr -> AAgr ; + agr2nagr : Agr -> NAgr ; + +-- restoring full Agr + ipagr2agr : IPAgr -> Agr ; + ipagr2vagr : IPAgr -> VAgr ; + +--- this is only needed in VPC formation + vagr2agr : VAgr -> Agr ; + +-- participles as adjectives + vPastPart : PrVerb -> AAgr -> Str ; + vPresPart : PrVerb -> AAgr -> Str ; + + vvInfinitive : VVType ; + +------------------------------- +--- type synonyms +------------------------------- + +oper + PrVerb = { + s : VForm => Str ; + p : Str ; -- verb particle + c1 : ComplCase ; + c2 : ComplCase ; + isSubjectControl : Bool ; + vtype : VType ; + vvtype : VVType ; + } ; + + PrVerbPhrase = { + v : VAgr => Str * Str * Str ; -- would,have,slept + inf : VVType => Str ; -- (not) ((to)(sleep|have slept) | (sleeping|having slept) + c1 : ComplCase ; + c2 : ComplCase ; + part : Str ; -- (look) up + adj : Agr => Str ; + obj1 : (Agr => Str) * Agr ; -- agr for object control + obj2 : (Agr => Str) * Bool ; -- subject control = True + vvtype : VVType ; -- type of VP complement + adv : Str ; + adV : Str ; + ext : Str ; + qforms : VAgr => Str * Str -- special Eng for introducing "do" in questions + } ; + + PrClause = { + v : Str * Str * Str ; + adj,obj1,obj2 : Str ; + adv : Str ; + adV : Str ; + ext : Str ; + subj : Str ; + c3 : ComplCase ; -- for a slashed adjunct, not belonging to the verb valency + qforms : Str * Str + } ; + + PrQuestionClause = PrClause ** { + foc : Str ; -- the focal position at the beginning: *who* does she love + focType : FocusType ; --- if already filled, then use other place: who loves *who* + } ; + +--------------------------- +---- concrete syntax opers +--------------------------- + +oper + reflPron : Agr -> Str ; + + infVP : VVType -> Agr -> PrVerbPhrase -> Str ; + + tenseV : Str -> STense -> Anteriority -> Polarity -> Voice -> VAgr -> PrVerb -> Str * Str * Str ; + + tenseInfV : Str -> Anteriority -> Polarity -> Voice -> PrVerb -> VVType => Str ; + + declCl : PrClause -> Str ; + declSubordCl : PrClause -> Str ; + declInvCl : PrClause -> Str ; + + questCl : PrQuestionClause -> Str ; + questSubordCl : PrQuestionClause -> Str ; + + that_Compl : Str ; + + addObj2VP : PrVerbPhrase -> (Agr => Str) -> PrVerbPhrase = \vp,obj -> vp ** { + obj2 = <\\a => vp.obj2.p1 ! a ++ obj ! a, vp.obj2.p2> ; + } ; + + addExtVP : PrVerbPhrase -> Str -> PrVerbPhrase = \vp,ext -> vp ** { + ext = ext ; + } ; + + not_Str : Polarity -> Str ; + +} diff --git a/lib/src/experimental/Trans.gf b/lib/src/experimental/Trans.gf index af8cc3972..44e16e74e 100644 --- a/lib/src/experimental/Trans.gf +++ b/lib/src/experimental/Trans.gf @@ -1,9 +1,9 @@ --# -path=.:../translator abstract Trans = - RGLBase + RGLBase - [Pol,Tense] ,Pred - ,Dictionary + ,Dictionary - [Pol,Tense] ** { flags diff --git a/lib/src/experimental/TransEng.gf b/lib/src/experimental/TransEng.gf index 6eca24f8e..53d70cb40 100644 --- a/lib/src/experimental/TransEng.gf +++ b/lib/src/experimental/TransEng.gf @@ -1,11 +1,11 @@ --# -path=.:../translator concrete TransEng of Trans = - RGLBaseEng - [Pol] + RGLBaseEng - [Pol,Tense] ,PredEng - ,DictionaryEng - [Pol] + ,DictionaryEng - [Pol,Tense] - ** open ResEng, Prelude, (Pr = PredEng) in { + ** open ResEng, PredInstanceEng, Prelude, (Pr = PredEng) in { flags literal=Symb ;