diff --git a/lib/src/experimental/LiftFin.gf b/lib/src/experimental/LiftFin.gf index 44a6d22ce..90c137e21 100644 --- a/lib/src/experimental/LiftFin.gf +++ b/lib/src/experimental/LiftFin.gf @@ -3,32 +3,32 @@ concrete LiftFin of Lift = ,PredFin ** open ResFin, + StemFin, PredInstanceFin, Prelude in { --flags literal=Symb ; -{- oper - liftV = PredInstanceFin.liftV ; + vliftV : SVerb1 -> PrVerb = PredInstanceFin.liftV ; lin - LiftV v = liftV v ; - LiftV2 v = : PrVerb> ** {c1 = v.c2.s} ; - LiftVS v = liftV v ; - LiftVQ v = liftV v ; - LiftVA v = liftV v ; ---- c1? - LiftVN v = liftV v ; ---- c1? - LiftVV v = : PrVerb> ** {c1 = v.c2.s} ; + LiftV v = vliftV v ; + LiftV2 v = vliftV v ** {c1 = v.c2} ; + LiftVS v = vliftV v ; + LiftVQ v = vliftV v ; + LiftVA v = vliftV v ** {c1 = v.c2} ; + LiftVN v = vliftV v ** {c1 = v.c2} ; + LiftVV v = vliftV v ** {vvType = v.vi} ; - LiftV3 v = : PrVerb> ** {c1 = v.c2.s ; c2 = v.c3.s} ; - - LiftV2S v = : PrVerb> ** {c1 = v.c2.s} ; - LiftV2Q v = : PrVerb> ** {c1 = v.c2.s} ; - LiftV2V v = : PrVerb> ** {c1 = v.c2.s ; c2 = v.c3.s} ; - LiftV2A v = : PrVerb> ** {c1 = v.c2.s} ; - LiftV2N v = : PrVerb> ** {c1 = v.c2.s} ; + LiftV3 v = vliftV v ** {c1 = v.c2 ; c2 = v.c3} ; + LiftV2S v = vliftV v ** {c1 = v.c2} ; + LiftV2Q v = vliftV v ** {c1 = v.c2} ; + LiftV2V v = vliftV v ** {c1 = v.c2 ; vvType = v.vi} ; + LiftV2A v = vliftV v ** {c1 = v.c2 ; c2 = v.c3} ; + LiftV2N v = vliftV v ** {c1 = v.c2 ; c2 = v.c3} ; +{- LiftAP ap = {s = \\a => ap.s ! agr2aformpos a ; c1,c2 = [] ; obj1 = \\_ => []} ; --- isPre LiftA2 ap = {s = \\a => ap.s ! AF (APosit (agr2aformpos a)) Nom ; c1 = ap.c2.s ; c2 = [] ; obj1 = \\_ => []} ; --- isPre diff --git a/lib/src/experimental/NDPredFunctor.gf b/lib/src/experimental/NDPredFunctor.gf index e54e70bdc..521d9cff9 100644 --- a/lib/src/experimental/NDPredFunctor.gf +++ b/lib/src/experimental/NDPredFunctor.gf @@ -54,7 +54,7 @@ linref PrCl_none, PrCl_np = \cl -> declCl cl ; PrQCl_none, PrQCl_np = \qcl -> questCl qcl ; - PrAdv_none, PrAdv_np = \adv -> adv.c1 ++ adv.s ; + PrAdv_none, PrAdv_np = \adv -> strComplCase adv.c1 ++ adv.s ; PrAP_none, PrAP_np = \ap -> ap.s ! defaultAgr ++ ap.obj1 ! defaultAgr ; PrCN_none, PrCN_np = \cn -> cn.s ! Sg ++ cn.obj1 ! defaultAgr ; diff --git a/lib/src/experimental/PredFin.gf b/lib/src/experimental/PredFin.gf index 2ceaacf90..f7aa28a8e 100644 --- a/lib/src/experimental/PredFin.gf +++ b/lib/src/experimental/PredFin.gf @@ -1,12 +1,18 @@ concrete PredFin of Pred = CatFin [Ant,NP,Utt,IP,IAdv,Conj] ** - PredFunctor - [StartVPC, ContVPC, ---- need generalization - AgentPassUseV,AgentPastPartAP] ---- moreover slow +-- PredFunctor [NP,Pol,Tense,Ant,Arg, PPos, TPres, ASimul, aNone, +-- PrV,PrVP,PrCl,PrS,UseV,PredVP,UseCl] +-- - [StartVPC, ContVPC, ---- need generalization +-- AgentPassUseV,AgentPastPartAP] ---- moreover slow + + PredFunctor - + [StartVPC, ContVPC, AgentPassUseV, ComplVA, ComplVN, ComplVV,SlashV2A,SlashV2V,SlashV2N] with (PredInterface = PredInstanceFin) ** { -lin StartVPC, ContVPC, AgentPassUseV, AgentPastPartAP = variants {} ; ---- just to make it compile as instance of Pred - +lin + StartVPC, ContVPC, AgentPassUseV, ComplVA, ComplVN, ComplVV,SlashV2A,SlashV2V,SlashV2N + = variants {} ; ---- just to make it compile as instance of Pred } diff --git a/lib/src/experimental/PredFunctor.gf b/lib/src/experimental/PredFunctor.gf index 0fd88ef99..f3b3ec67c 100644 --- a/lib/src/experimental/PredFunctor.gf +++ b/lib/src/experimental/PredFunctor.gf @@ -25,12 +25,14 @@ lincat v : VAgr => Str ; inf : Agr => Str ; c1 : ComplCase ; - c2 : ComplCase + c2 : ComplCase ; + s1 : Str ; -- storing both in both-and } ; ClC = { s : Str ; c3 : ComplCase ; + s1 : Str ; } ; PrAdv = {s : Str ; isAdV : Bool ; c1 : ComplCase} ; @@ -88,51 +90,20 @@ lin aNone, aS, aV, aA, aQ, aN = {s = []} ; aNP a = a ; - UseV x a t p v = { - 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 ; - 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 ; - } ; + UseV x a t p v = initPrVerbPhraseV a t p v ; - PassUseV x a t p v = { + 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 ; - 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 => qformsCopula (a.s ++ t.s ++ p.s) t.t a.a p.p agr ; } ; - AgentPassUseV x a t p v np = { + 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 ; - c1 = v.c1 ; - c2 = v.c2 ; - part = v.p ; - adj = \\a => [] ; - obj1 = ; - obj2 = ; - vvtype = v.vvtype ; - adV = negAdV p ; + obj2 = ; -- becomes subject control even if object control otherwise "*she was promised by us to love ourselves" adv = appComplCase agentCase np ; - ext = [] ; qforms = \\agr => qformsCopula (a.s ++ t.s ++ p.s) t.t a.a p.p agr ; } ; @@ -312,6 +283,7 @@ lin infVP v.vvtype a v ++ c.s2 ++ infVP w.vvtype a w ; c1 = noComplCase ; ---- w.c1 ? --- the full story is to unify v and w... c2 = noComplCase ; ---- w.c2 ? + s1 = c.s1 ; } ; ContVPC x v w = { ---- some loss of quality seems inevitable @@ -329,45 +301,32 @@ lin infVP v.vvtype a v ++ "," ++ w.inf ! a ; c1 = noComplCase ; ---- w.c1 ? --- the full story is to unify v and w... c2 = noComplCase ; ---- w.c2 ? + s1 = w.s1 ; } ; - UseVPC x vpc = { ---- big loss of quality (overgeneration) seems inevitable - v = \\a => <[], [], vpc.v ! a> ; + UseVPC x vpc = initPrVerbPhrase ** { ---- big loss of quality (overgeneration) seems inevitable + v = \\a => <[], [], vpc.s1 ++ 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 x c a b = { s = declCl a ++ c.s2 ++ declCl b ; c3 = b.c3 ; ---- + s1 = c.s1 ; } ; ContClC x a b = { s = declCl a ++ "," ++ b.s ; c3 = b.c3 ; ---- + s1 = b.s1 ; } ; - UseClC x cl = { - subj = [] ; - v = <[],[],cl.s> ; ---- - inf = [] ; - adj = [] ; - obj1 = [] ; - obj2 = [] ; - adV = [] ; - adv = [] ; - ext = [] ; + UseClC x cl = initPrClause ** { + v = <[],[], cl.s1 ++ cl.s> ; ---- c3 = cl.c3 ; - qforms = <[],[]> ; ---- qforms } ; ComplAdv x p np = {s = appComplCase p.c1 np ; isAdV = p.isAdV ; c1 = noComplCase} ; diff --git a/lib/src/experimental/PredInstanceEng.gf b/lib/src/experimental/PredInstanceEng.gf index 844b9f220..65f2a941b 100644 --- a/lib/src/experimental/PredInstanceEng.gf +++ b/lib/src/experimental/PredInstanceEng.gf @@ -23,6 +23,8 @@ oper active : SVoice = Act ; passive : SVoice = Pass ; + defaultVType : VType = VTAct ; + subjCase : NPCase = NCase Nom ; objCase : NPCase = NPAcc ; diff --git a/lib/src/experimental/PredInstanceFin.gf b/lib/src/experimental/PredInstanceFin.gf index 2bd7df74c..573284c94 100644 --- a/lib/src/experimental/PredInstanceFin.gf +++ b/lib/src/experimental/PredInstanceFin.gf @@ -1,5 +1,9 @@ -instance PredInstanceFin of PredInterface - [NounPhrase,PrVerb] = - open ResFin, (P = ParadigmsFin), (S = StemFin), (X = ParamX), Prelude in { +instance PredInstanceFin of + PredInterface - [ + NounPhrase, + PrVerb, initPrVerb + ] = + open ResFin, (P = ParadigmsFin), (S = StemFin), (X = ParamX), Prelude in { -- overrides @@ -22,7 +26,7 @@ oper Case = ResFin.Case ; NPCase = ResFin.NPForm ; VForm = S.SVForm ; - VVType = ResFin.InfForm ; + VVType = Unit ; ----ResFin.InfForm ; VType = Unit ; ---- Gender = Unit ; ---- @@ -34,6 +38,8 @@ oper active = Act ; passive = Pass ; + defaultVType = UUnit ; + subjCase : NPCase = ResFin.NPCase Nom ; objCase : NPCase = NPAcc ; @@ -69,7 +75,7 @@ oper vPastPart : PrVerb -> AAgr -> Str = \v,a -> (S.sverb2verbSep v).s ! PastPartPass (AN (NCase Sg Part)) ; ---- case vPresPart : PrVerb -> AAgr -> Str = \v,a -> (S.sverb2verbSep v).s ! PresPartAct (AN (NCase Sg Part)) ; ---- case - vvInfinitive : VVType = Inf1 ; + vvInfinitive : VVType = UUnit ; ---- vvInfinitive : VVType = Inf1 ; isRefl : PrVerb -> Bool = \_ -> False ; ---- @@ -117,7 +123,7 @@ oper tenseInfV : Str -> Anteriority -> Polarity -> SVoice -> PrVerb -> VVType -> Str = \sa,a,pol,o,v,vt -> - let + let vt = Inf1 ; ---- ovps = (S.vp2old_vp (S.predV v)).s ! VIInf vt ! a ! pol ! defaultAgr ; -- VIForm => Anteriority => Polarity => Agr => {fin, inf : Str} ; in sa ++ ovps.fin ++ ovps.inf ; @@ -139,8 +145,15 @@ oper not_Str : Polarity -> Str = \p -> case p of {Pos => [] ; Neg => "inte"} ; - liftV : S.SVerb1 -> PrVerb = \v -> - v ** {c1,c2 = noComplCase ; isSubjectControl = False ; vtype = UUnit ; vvtype = vvInfinitive} ; + liftV : S.SVerb1 -> PrVerb = \v -> initPrVerb ** v ; + + initPrVerb : PrVerb = { + s = \\_ => [] ; + sc = subjCase ; + h = Back ; + p = [] ; + c1,c2 = noComplCase ; isSubjectControl = True ; vtype = defaultVType ; vvtype = vvInfinitive + } ; --- junk diff --git a/lib/src/experimental/PredInstanceSwe.gf b/lib/src/experimental/PredInstanceSwe.gf index a61036ab9..d06cb6701 100644 --- a/lib/src/experimental/PredInstanceSwe.gf +++ b/lib/src/experimental/PredInstanceSwe.gf @@ -21,6 +21,8 @@ oper active = CommonScand.Act ; passive = CommonScand.Pass ; + defaultVType = VAct ; + subjCase : NPCase = NPNom ; objCase : NPCase = NPAcc ; diff --git a/lib/src/experimental/PredInterface.gf b/lib/src/experimental/PredInterface.gf index 3ce489d5d..551b98db9 100644 --- a/lib/src/experimental/PredInterface.gf +++ b/lib/src/experimental/PredInterface.gf @@ -41,6 +41,8 @@ oper active : SVoice ; passive : SVoice ; + defaultVType : VType ; + subjCase : NPCase ; objCase : NPCase ; @@ -102,6 +104,16 @@ oper vvtype : VVType ; } ; + initPrVerb : PrVerb = { + s = \\_ => [] ; + p = [] ; + c1 = noComplCase ; + c2 = noComplCase ; + isSubjectControl = True ; + vtype = defaultVType ; + vvtype = vvInfinitive ; + } ; + PrVerbPhrase = { v : VAgr => Str * Str * Str ; -- would,have,slept inf : VVType => Str ; -- (not) ((to)(sleep|have slept) | (sleeping|having slept) @@ -117,6 +129,37 @@ oper ext : Str ; qforms : VAgr => Str * Str -- special Eng for introducing "do" in questions } ; + + initPrVerbPhrase : PrVerbPhrase = { + v : VAgr => Str * Str * Str = \\_ => <[],[],[]> ; + inf : VVType => Str = \\_ => [] ; + c1 : ComplCase = noComplCase ; + c2 : ComplCase = noComplCase ; + part : Str = [] ; -- (look) up + adj : Agr => Str = noObj ; + obj1 : (Agr => Str) * Agr = <\\_ => [], defaultAgr> ; -- agr for object control + obj2 : (Agr => Str) * Bool = <\\_ => [], True>; -- subject control = True + vvtype : VVType = vvInfinitive ; -- type of VP complement + 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 ** { + 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 ; + c1 = v.c1 ; + c2 = v.c2 ; + part = v.p ; + obj1 = \\a => reflPron a ; _ => \\_ => []}, defaultAgr> ; ---- not used, just default value + 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 = { v : Str * Str * Str ; @@ -129,6 +172,15 @@ oper qforms : Str * Str } ; + initPrClause : PrClause = { + 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 ** { foc : Str ; -- the focal position at the beginning: *who* does she love focType : FocusType ; --- if already filled, then use other place: who loves *who* @@ -170,19 +222,10 @@ oper not_Str : Polarity -> Str ; useCopula : {s : Str ; a : Anteriority} -> {s : Str ; t : STense} -> {s : Str ; p : Polarity} -> PrVerbPhrase = - \a,t,p -> { + \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 ; - c1 = noComplCase ; - c2 = noComplCase ; - part = [] ; - adj = \\_ => [] ; - obj1 = ; - obj2 = ; - vvtype = vvInfinitive ; adV = negAdV p ; - adv = [] ; - ext = [] ; qforms = \\agr => qformsCopula (a.s ++ t.s ++ p.s) t.t a.a p.p agr ; } ;