diff --git a/lib/src/experimental/PredEng.gf b/lib/src/experimental/PredEng.gf index 031b10339..7dd261ff1 100644 --- a/lib/src/experimental/PredEng.gf +++ b/lib/src/experimental/PredEng.gf @@ -1,11 +1,93 @@ concrete PredEng of Pred = CatEng [Ant,NP,Utt,IP,IAdv,IComp,Conj,RP,RS] ** - PredFunctor - [QuestIComp] ---- IComp has no parameters in Eng + PredFunctor - [ + -- for all these, special qforms added in Eng + PassUseV, + AgentPassUseV, + UseVPC, + PredVP, + QuestVP, + RelVP, + + QuestIComp ---- IComp has no parameters in Eng + ] with (PredInterface = PredInstanceEng) ** open PredInstanceEng, (R = ResEng) in { +-- overrides + +lin + PassUseV x a t p v = initPrVerbPhraseV a t p v ** { + v = \\agr => tenseV (a.s ++ t.s ++ p.s) t.t a.a p.p passive agr v ; + inf = \\vt => tenseInfV a.s a.a p.p passive v vt ; + obj2 = ; -- becomes subject control even if object control otherwise "*she was promised by us to love ourselves" + qforms = \\agr => qformsCopula (a.s ++ t.s ++ p.s) t.t a.a p.p agr ; + } ; + + AgentPassUseV x a t p v np = initPrVerbPhraseV a t p v ** { + v = \\agr => tenseV (a.s ++ t.s ++ p.s) t.t a.a p.p passive agr v ; + inf = \\vt => tenseInfV a.s a.a p.p passive v vt ; + obj2 = ; -- becomes subject control even if object control otherwise "*she was promised by us to love ourselves" + adv = appComplCase agentCase np ; + qforms = \\agr => qformsCopula (a.s ++ t.s ++ p.s) t.t a.a p.p agr ; + } ; + + + PredVP x np vp = vp ** { + v = applyVerb vp (agr2vagr np.a) ; + subj = appSubjCase np ; + adj = vp.adj ! np.a ; + obj1 = vp.part ++ strComplCase vp.c1 ++ vp.obj1.p1 ! np.a ; ---- apply complCase ---- place of part depends on obj + obj2 = strComplCase vp.c2 ++ vp.obj2.p1 ! (case vp.obj2.p2 of {True => np.a ; False => vp.obj1.p2}) ; ---- apply complCase + c3 = vp.c1 ; -- in case there is any free slot left ---- could be c2 + qforms = qformsVP vp (agr2vagr np.a) ; + } ; + + QuestVP x ip vp = + let + ipa = ipagr2agr ip.n + in { + v = applyVerb vp (ipagr2vagr ip.n) ; + foc = ip.s ! subjCase ; + focType = FocSubj ; + subj = [] ; + adj = vp.adj ! ipa ; + obj1 = vp.part ++ strComplCase vp.c1 ++ vp.obj1.p1 ! ipa ; ---- appComplCase + obj2 = strComplCase 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 = qformsVP vp (ipagr2vagr ip.n) ; + } ; + + RelVP rp vp = + let + cl : Agr -> PrClause = \a -> + let rpa = rpagr2agr rp.a a in + + vp ** { + v = applyVerb vp (agr2vagr rpa) ; + subj = rp.s ! subjRPCase a ; + adj = vp.adj ! rpa ; + obj1 = vp.part ++ strComplCase vp.c1 ++ vp.obj1.p1 ! rpa ; ---- apply complCase ---- place of part depends on obj + obj2 = strComplCase vp.c2 ++ vp.obj2.p1 ! (case vp.obj2.p2 of {True => rpa ; False => vp.obj1.p2}) ; ---- apply complCase + c3 = noComplCase ; -- for one more prep to build ClSlash + qforms = qformsVP vp (agr2vagr rpa) ; + } + in {s = \\a => declCl (cl a) ; c = subjCase} ; + + UseVPC x vpc = initPrVerbPhrase ** { ---- big loss of quality (overgeneration) seems inevitable + v = \\a => <[], [], vpc.s1 ++ vpc.v ! a> ; + inf = \\vt => vpc.inf ! defaultAgr ! vt ; ---- agr + imp = vpc.imp ; + c1 = vpc.c1 ; + c2 = vpc.c2 ; + qforms = \\a => <"do", vpc.inf ! defaultAgr ! vvInfinitive> ; ---- do/does/did + } ; + lin QuestIComp a t p icomp np = let vagr = (agr2vagr np.a) in @@ -17,12 +99,13 @@ lin qforms = qformsCopula (a.s ++ t.s ++ p.s) t.t a.a p.p vagr ; } ; +-- not in functor anyway + NomVPNP vpi = { s = \\c => vpi.s ! R.VVPresPart ! defaultAgr ; a = defaultAgr } ; - ByVP x vp vpi = vp ** {adv = "by" ++ vpi.s ! R.VVPresPart ! defaultAgr} ; ---- agr WhenVP x vp vpi = vp ** {adv = "when" ++ vpi.s ! R.VVPresPart ! defaultAgr} ; ---- agr BeforeVP x vp vpi = vp ** {adv = "before" ++ vpi.s ! R.VVPresPart ! defaultAgr} ; ---- agr diff --git a/lib/src/experimental/PredFunctor.gf b/lib/src/experimental/PredFunctor.gf index 56d68dc4a..dcb5abe67 100644 --- a/lib/src/experimental/PredFunctor.gf +++ b/lib/src/experimental/PredFunctor.gf @@ -89,7 +89,6 @@ lin v = \\agr => tenseV (a.s ++ t.s ++ p.s) t.t a.a p.p passive agr v ; inf = \\vt => tenseInfV a.s a.a p.p passive v vt ; obj2 = ; -- becomes subject control even if object control otherwise "*she was promised by us to love ourselves" - qforms = \\agr => qformsCopula (a.s ++ t.s ++ p.s) t.t a.a p.p agr ; } ; AgentPassUseV x a t p v np = initPrVerbPhraseV a t p v ** { @@ -97,7 +96,6 @@ lin inf = \\vt => tenseInfV a.s a.a p.p passive v vt ; obj2 = ; -- becomes subject control even if object control otherwise "*she was promised by us to love ourselves" adv = appComplCase agentCase np ; - qforms = \\agr => qformsCopula (a.s ++ t.s ++ p.s) t.t a.a p.p agr ; } ; UseAP x a t p ap = useCopula a t p ** { @@ -170,7 +168,6 @@ lin obj1 = vp.part ++ strComplCase vp.c1 ++ vp.obj1.p1 ! np.a ; ---- apply complCase ---- place of part depends on obj obj2 = strComplCase vp.c2 ++ vp.obj2.p1 ! (case vp.obj2.p2 of {True => np.a ; False => vp.obj1.p2}) ; ---- apply complCase c3 = vp.c1 ; -- in case there is any free slot left ---- could be c2 - qforms = qformsVP vp (agr2vagr np.a) ; } ; SlashClNP x cl np = cl ** { -- Cl ::= Cl/NP NP @@ -197,7 +194,6 @@ lin adv = vp.adv ; adV = vp.adV ; ext = vp.ext ; - qforms = qformsVP vp (ipagr2vagr ip.n) ; } ; QuestSlash x ip cl = @@ -234,7 +230,6 @@ lin adV = negAdV p ; foc = icomp.s ! agr2icagr np.a ; focType = FocObj ; - qforms = qformsCopula (a.s ++ t.s ++ p.s) t.t a.a p.p vagr ; } ; RelVP rp vp = @@ -249,7 +244,6 @@ lin obj1 = vp.part ++ strComplCase vp.c1 ++ vp.obj1.p1 ! rpa ; ---- apply complCase ---- place of part depends on obj obj2 = strComplCase vp.c2 ++ vp.obj2.p1 ! (case vp.obj2.p2 of {True => rpa ; False => vp.obj1.p2}) ; ---- apply complCase c3 = noComplCase ; -- for one more prep to build ClSlash - qforms = qformsVP vp (agr2vagr rpa) ; } in {s = \\a => declCl (cl a) ; c = subjCase} ; @@ -347,7 +341,7 @@ lin imp = vpc.imp ; c1 = vpc.c1 ; c2 = vpc.c2 ; - qforms = \\a => <"do", vpc.inf ! defaultAgr ! vvInfinitive> ; ---- do/does/did + } ; StartClC x c a b = { diff --git a/lib/src/experimental/PredInstanceEng.gf b/lib/src/experimental/PredInstanceEng.gf index 8441fc85f..32d9db8cd 100644 --- a/lib/src/experimental/PredInstanceEng.gf +++ b/lib/src/experimental/PredInstanceEng.gf @@ -1,4 +1,50 @@ -instance PredInstanceEng of PredInterface = open ResEng, (X = ParamX), Prelude in { +instance PredInstanceEng of PredInterface - [ + PrVerbPhrase, PrClause, + initPrVerbPhrase, initPrVerbPhraseV, initPrClause, + useCopula, questCl, linrefPrQCl + ] = + + open ResEng, (X = ParamX), Prelude in { + +----- overrides ---------------- + +oper + + PrVerbPhrase = BasePrVerbPhrase ** {qforms : VAgr => Str * Str} ; + PrClause = BasePrClause ** {qforms : Str * Str} ; + + initPrVerbPhrase : PrVerbPhrase = initBasePrVerbPhrase ** { + qforms = \\agr => <[],[]> ; + } ; + + initPrVerbPhraseV : + {s : Str ; a : Anteriority} -> {s : Str ; t : STense} -> {s : Str ; p : Polarity} -> PrVerb -> PrVerbPhrase = + \a,t,p,v -> initBasePrVerbPhraseV a t p v ** { + qforms = \\agr => qformsV (a.s ++ t.s ++ p.s) t.t a.a p.p agr v + } ; + + + initPrClause : PrClause = initBasePrClause ** { + qforms = <[],[]> ; + } ; + + useCopula : {s : Str ; a : Anteriority} -> {s : Str ; t : STense} -> {s : Str ; p : Polarity} -> + PrVerbPhrase = + \a,t,p -> initPrVerbPhrase ** { + v = \\agr => tenseCopula (a.s ++ t.s ++ p.s) t.t a.a p.p agr ; + inf = \\vt => tenseInfCopula a.s a.a p.p vt ; + imp = \\n => tenseImpCopula p.s p.p n ; + adV = negAdV p ; + qforms = \\agr => qformsCopula (a.s ++ t.s ++ p.s) t.t a.a p.p agr ; + } ; + + 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 + } ; + + linrefPrQCl : PrQuestionClause -> Str = \qcl -> questCl qcl ; --------------------- -- parameters ------- @@ -292,12 +338,6 @@ oper 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 @@ -307,6 +347,15 @@ oper FocSubj => cl.foc ++ rest -- who loves her } ; + +--- only needed in Eng because of do questions + qformsV : Str -> STense -> Anteriority -> Polarity -> VAgr -> PrVerb -> Str * Str ; + qformsCopula : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str ; + + qformsVP : PrVerbPhrase -> VAgr -> Str * Str + = \vp,vagr -> vp.qforms ! vagr ; + + that_Compl : Str = "that" | [] ; -- this part is usually the same in all reconfigurations diff --git a/lib/src/experimental/PredInstanceSwe.gf b/lib/src/experimental/PredInstanceSwe.gf index a48ba8807..980a6293b 100644 --- a/lib/src/experimental/PredInstanceSwe.gf +++ b/lib/src/experimental/PredInstanceSwe.gf @@ -105,10 +105,6 @@ oper vp.adj ! a ++ vp.c1 ++ vp.obj1.p1 ! a ++ vp.c2 ++ vp.obj2.p1 ! a ++ vp.adv ++ vp.ext ; - qformsV : Str -> STense -> Anteriority -> Polarity -> VAgr -> PrVerb -> Str * Str = - \sta,t,a,p,agr,v -> <[],[]> ; ----- not needed in Swedish - - declCl : PrClause -> Str = \cl -> cl.subj ++ cl.v.p1 ++ cl.adV ++ cl.v.p2 ++ restCl cl ; declSubordCl : PrClause -> Str = \cl -> cl.subj ++ cl.adV ++ cl.v.p1 ++ (cl.v.p2 | []) ++ restCl cl ; declInvCl : PrClause -> Str = \cl -> cl.v.p1 ++ cl.subj ++ cl.adV ++ cl.v.p2 ++ restCl cl ; @@ -185,12 +181,6 @@ oper liftV : Verb -> PrVerb = \v -> {s = v.s ; p = v.part ; c1,c2 = [] ; isSubjectControl = True ; vtype = v.vtype ; vvtype = vvInfinitive} ; ---- vvtype ---- junk - - qformsV : Str -> STense -> Anteriority -> Polarity -> VAgr -> PrVerb -> Str * Str = - \sta,t,a,p,agr,v -> <[],[]> ; - qformsCopula : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str = - \sta,t,a,p,agr -> <[],[]> ; } \ No newline at end of file diff --git a/lib/src/experimental/PredInterface.gf b/lib/src/experimental/PredInterface.gf index dd587726d..441ad2e6a 100644 --- a/lib/src/experimental/PredInterface.gf +++ b/lib/src/experimental/PredInterface.gf @@ -99,19 +99,24 @@ oper applyVerb : PrVerbPhrase -> VAgr -> Str * Str * Str = \vp,a -> vp.v ! a ; ---- only needed in Eng because of do questions - qformsV : Str -> STense -> Anteriority -> Polarity -> VAgr -> PrVerb -> Str * Str ; - qformsCopula : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str ; - - qformsVP : PrVerbPhrase -> VAgr -> Str * Str - = \vp,vagr -> vp.qforms ! vagr ; - ------------------------------- --- type synonyms ------------------------------- oper - PrVerb = { + PrVerb = BasePrVerb ; + PrVerbPhrase = BasePrVerbPhrase ; + PrClause = BasePrClause ; + PrQuestionClause = BasePrQuestionClause ; + + initPrVerb = initBasePrVerb ; + initPrVerbPhrase = initBasePrVerbPhrase ; + initPrVerbPhraseV = initBasePrVerbPhraseV ; + initPrClause = initBasePrClause ; + + + + BasePrVerb = { s : VForm => Str ; p : Str ; -- verb particle c1 : ComplCase ; @@ -121,7 +126,7 @@ oper vvtype : VVType ; } ; - initPrVerb : PrVerb = { + initBasePrVerb : BasePrVerb = { s = \\_ => [] ; p = [] ; c1 = noComplCase ; @@ -131,7 +136,7 @@ oper vvtype = vvInfinitive ; } ; - PrVerbPhrase = { + BasePrVerbPhrase = { v : VAgr => Str * Str * Str ; -- would,have,slept inf : VVType => Str ; -- (not) ((to)(sleep|have slept) | (sleeping|having slept) imp : ImpType => Str ; @@ -145,10 +150,9 @@ oper adv : Str ; adV : Str ; ext : Str ; - qforms : VAgr => Str * Str -- special Eng for introducing "do" in questions } ; - initPrVerbPhrase : PrVerbPhrase = { + initBasePrVerbPhrase : BasePrVerbPhrase = { v : VAgr => Str * Str * Str = \\_ => <[],[],[]> ; inf : VVType => Str = \\_ => [] ; imp : ImpType => Str = \\_ => [] ; @@ -162,12 +166,11 @@ oper adv : Str = [] ; adV : Str = [] ; ext : Str = [] ; - qforms : VAgr => Str * Str = \\_ => <[],[]> -- special Eng for introducing "do" in questions } ; - initPrVerbPhraseV : - {s : Str ; a : Anteriority} -> {s : Str ; t : STense} -> {s : Str ; p : Polarity} -> PrVerb -> PrVerbPhrase = - \a,t,p,v -> initPrVerbPhrase ** { + initBasePrVerbPhraseV : + {s : Str ; a : Anteriority} -> {s : Str ; t : STense} -> {s : Str ; p : Polarity} -> PrVerb -> BasePrVerbPhrase = + \a,t,p,v -> initBasePrVerbPhrase ** { v = \\agr => tenseV (a.s ++ t.s ++ p.s) t.t a.a p.p active agr v ; inf = \\vt => tenseInfV a.s a.a p.p active v vt ; imp = \\it => imperativeV p.s p.p it v ; @@ -178,10 +181,9 @@ oper obj2 = ; vvtype = v.vvtype ; adV = negAdV p ; --- just p.s in Eng - qforms = \\agr => qformsV (a.s ++ t.s ++ p.s) t.t a.a p.p agr v ; } ; - PrClause = { + BasePrClause = { v : Str * Str * Str ; adj,obj1,obj2 : Str ; adv : Str ; @@ -189,25 +191,34 @@ oper ext : Str ; subj : Str ; c3 : ComplCase ; -- for a slashed adjunct, not belonging to the verb valency - qforms : Str * Str } ; - initPrClause : PrClause = { + initBasePrClause : BasePrClause = { v : Str * Str * Str = <[],[],[]> ; adj,obj1,obj2 : Str = [] ; adv,adV,ext : Str = [] ; subj : Str = [] ; c3 : ComplCase = noComplCase ; -- for a slashed adjunct, not belonging to the verb valency - qforms : Str * Str = <[],[]> } ; - PrQuestionClause = PrClause ** { + BasePrQuestionClause = 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* } ; PrAdverb = {s : Str ; isAdV : Bool ; c1 : ComplCase} ; + + useCopula : {s : Str ; a : Anteriority} -> {s : Str ; t : STense} -> {s : Str ; p : Polarity} -> + PrVerbPhrase = + \a,t,p -> initPrVerbPhrase ** { + v = \\agr => tenseCopula (a.s ++ t.s ++ p.s) t.t a.a p.p agr ; + inf = \\vt => tenseInfCopula a.s a.a p.p vt ; + imp = \\n => tenseImpCopula p.s p.p n ; + adV = negAdV p ; + } ; + + linrefPrVP : PrVerbPhrase -> Str = \vp -> let agr = defaultAgr ; @@ -264,13 +275,4 @@ oper not_Str : Polarity -> Str ; - useCopula : {s : Str ; a : Anteriority} -> {s : Str ; t : STense} -> {s : Str ; p : Polarity} -> PrVerbPhrase = - \a,t,p -> initPrVerbPhrase ** { - v = \\agr => tenseCopula (a.s ++ t.s ++ p.s) t.t a.a p.p agr ; - inf = \\vt => tenseInfCopula a.s a.a p.p vt ; - imp = \\n => tenseImpCopula p.s p.p n ; - adV = negAdV p ; - qforms = \\agr => qformsCopula (a.s ++ t.s ++ p.s) t.t a.a p.p agr ; - } ; - } diff --git a/lib/src/experimental/PredSwe.gf b/lib/src/experimental/PredSwe.gf index ee8000cc0..84c6f2860 100644 --- a/lib/src/experimental/PredSwe.gf +++ b/lib/src/experimental/PredSwe.gf @@ -19,7 +19,6 @@ lin obj1 = vp.part ++ strComplCase vp.c1 ++ vp.obj1.p1 ! rpa ; ---- apply complCase ---- place of part depends on obj obj2 = strComplCase vp.c2 ++ vp.obj2.p1 ! (case vp.obj2.p2 of {True => rpa ; False => vp.obj1.p2}) ; ---- apply complCase c3 = noComplCase ; -- for one more prep to build ClSlash - qforms = qformsVP vp (agr2vagr rpa) ; } in {s = \\a,c => declCl (cl a c) ; c = subjCase} ;