diff --git a/lib/src/experimental/NDPredFunctor.gf b/lib/src/experimental/NDPredFunctor.gf index 521d9cff9..ba8828439 100644 --- a/lib/src/experimental/NDPredFunctor.gf +++ b/lib/src/experimental/NDPredFunctor.gf @@ -43,20 +43,12 @@ lincat linref PrVP_none, PrVP_np, PrVP_v, PrVP_s, PrVP_q, PrVP_a, PrVP_n, PrVP_np_np, PrVP_np_v, PrVP_np_s, PrVP_np_q, PrVP_np_a, PrVP_np_n - = \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_none, PrCl_np = \cl -> declCl cl ; - PrQCl_none, PrQCl_np = \qcl -> questCl qcl ; - 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 ; + = linrefPrVP ; + PrCl_none, PrCl_np = linrefPrCl ; + PrQCl_none, PrQCl_np = linrefPrQCl ; + PrAdv_none, PrAdv_np = linrefPrAdv ; +---- PrAP_none, PrAP_np = \ap -> ap.s ! defaultAgr ++ ap.obj1 ! defaultAgr ; +---- PrCN_none, PrCN_np = \cn -> cn.s ! Sg ++ cn.obj1 ! defaultAgr ; ---------------------------- --- linearization rules ---- diff --git a/lib/src/experimental/PredFin.gf b/lib/src/experimental/PredFin.gf index f7aa28a8e..453e4dce1 100644 --- a/lib/src/experimental/PredFin.gf +++ b/lib/src/experimental/PredFin.gf @@ -1,18 +1,16 @@ concrete PredFin of Pred = CatFin [Ant,NP,Utt,IP,IAdv,Conj] ** --- 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 + PredFunctor + - [StartVPC, ContVPC +---- ,AgentPassUseV, ComplVA, ComplVN, ComplVV,SlashV2A,SlashV2V,SlashV2N + ] + with (PredInterface = PredInstanceFin) ** { lin - StartVPC, ContVPC, AgentPassUseV, ComplVA, ComplVN, ComplVV,SlashV2A,SlashV2V,SlashV2N + 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 f3b3ec67c..31093bda4 100644 --- a/lib/src/experimental/PredFunctor.gf +++ b/lib/src/experimental/PredFunctor.gf @@ -35,8 +35,8 @@ lincat s1 : Str ; } ; - PrAdv = {s : Str ; isAdV : Bool ; c1 : ComplCase} ; - PrS = {s : Str} ; + PrAdv = PrAdverb ; + PrS = {s : Str} ; PrAP = { s : AAgr => Str ; @@ -53,20 +53,10 @@ lincat -- 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 qcl ; - PrAdv = \adv -> strComplCase adv.c1 ++ adv.s ; - PrAP = \ap -> ap.s ! defaultAgr ++ ap.obj1 ! defaultAgr ; - PrCN = \cn -> cn.s ! Sg ++ cn.obj1 ! defaultAgr ; + PrVP = linrefPrVP ; + PrCl = linrefPrCl ; + PrQCl = linrefPrQCl ; + PrAdv = linrefPrAdv ; ---------------------------- --- linearization rules ---- diff --git a/lib/src/experimental/PredInstanceFin.gf b/lib/src/experimental/PredInstanceFin.gf index 573284c94..7e91f0ba0 100644 --- a/lib/src/experimental/PredInstanceFin.gf +++ b/lib/src/experimental/PredInstanceFin.gf @@ -1,7 +1,8 @@ instance PredInstanceFin of PredInterface - [ NounPhrase, - PrVerb, initPrVerb + PrVerb, initPrVerb, + PrVerbPhrase, initPrVerbPhrase, initPrVerbPhraseV, useCopula ] = open ResFin, (P = ParadigmsFin), (S = StemFin), (X = ParamX), Prelude in { @@ -9,6 +10,7 @@ instance PredInstanceFin of oper NounPhrase = ResFin.NP ; + PrVerb = StemFin.SVerb1 ** { c1 : ComplCase ; c2 : ComplCase ; @@ -17,6 +19,66 @@ oper vvtype : VVType ; } ; + initPrVerb : PrVerb = { + s = \\_ => [] ; + sc = subjCase ; + h = Back ; + p = [] ; + c1,c2 = noComplCase ; isSubjectControl = True ; vtype = defaultVType ; vvtype = vvInfinitive + } ; + + PrVerbPhrase = { + v : S.SVerb1 ; + atp : {a : Anteriority ; t : STense ; p : Polarity ; as,ts,ps : Str} ; + vtype : VType ; + 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 + } ; + + initPrVerbPhrase : PrVerbPhrase = { + v : S.SVerb1 = initPrVerb ; + atp = {a = Simul ; t = Pres ; p = Pos ; as,ts,ps = []} ; + vtype = defaultVType ; + 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 : S.SVerb1 = v ; + atp = {a = a.a ; t = t.t ; p = p.p ; as = a.s ; ts = t.s ; ps = p.s} ; + vtype = v.vtype ; + 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 Fin + } ; + + useCopula : {s : Str ; a : Anteriority} -> {s : Str ; t : STense} -> {s : Str ; p : Polarity} -> PrVerbPhrase = + \a,t,p -> initPrVerbPhraseV a t p (liftV P.olla_V) ; + + --------------------- -- parameters ------- --------------------- @@ -26,8 +88,8 @@ oper Case = ResFin.Case ; NPCase = ResFin.NPForm ; VForm = S.SVForm ; - VVType = Unit ; ----ResFin.InfForm ; - VType = Unit ; ---- + VVType = ResFin.InfForm ; + VType = Voice ; ---- Gender = Unit ; ---- VAgr = Agr ; @@ -38,7 +100,7 @@ oper active = Act ; passive = Pass ; - defaultVType = UUnit ; + defaultVType = Act ; subjCase : NPCase = ResFin.NPCase Nom ; objCase : NPCase = NPAcc ; @@ -75,7 +137,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 = UUnit ; ---- vvInfinitive : VVType = Inf1 ; + vvInfinitive : VVType = Inf1 ; isRefl : PrVerb -> Bool = \_ -> False ; ---- @@ -87,16 +149,23 @@ oper oper reflPron : Agr -> Str = \a -> (ResFin.reflPron a).s ! NPAcc ; ---- case - infVP : VVType -> Agr -> PrVerbPhrase -> Str = \vt, a,vp -> - let - a2 = case vp.obj2.p2 of {True => a ; False => vp.obj1.p2} + infVP : VVType -> Agr -> PrVerbPhrase -> Str = \vt, a, pvp -> + let + ipol = pvp.atp.p ; + sc = pvp.v.sc ; + pol = Pos ; ---- + agr = a ; + vi = vt ; + vp0 : S.VP = { + s = pvp.v ; + s2 = \\b,p,agr => pvp.obj1.p1 ! agr ++ pvp.obj2.p1 ! agr ; + adv = \\_ => pvp.adV ++ pvp.adv ; + ext = pvp.ext ; + vptyp = {isNeg = False ; isPass = case pvp.vtype of {Pass => True ; _ => False}} ; + } in - vp.adV ++ vp.inf ! vt ++ - vp.adj ! a ++ vp.obj1.p1 ! a ++ vp.obj2.p1 ! a2 ++ vp.adv ++ vp.ext ; - - qformsV : Str -> STense -> Anteriority -> Polarity -> VAgr -> PrVerb -> Str * Str = - \sta,t,a,p,agr,v -> <[],[]> ; ----- not needed in Finnish - + S.infVPGen -- : Polarity -> NPForm -> Polarity -> Agr -> VP -> InfForm -> Str = + ipol sc pol agr vp0 vi ; 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 ; @@ -147,14 +216,6 @@ oper 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 qformsV : Str -> STense -> Anteriority -> Polarity -> VAgr -> PrVerb -> Str * Str = @@ -162,5 +223,4 @@ oper 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 551b98db9..e8945a3ee 100644 --- a/lib/src/experimental/PredInterface.gf +++ b/lib/src/experimental/PredInterface.gf @@ -186,6 +186,24 @@ oper focType : FocusType ; --- if already filled, then use other place: who loves *who* } ; + PrAdverb = {s : Str ; isAdV : Bool ; c1 : ComplCase} ; + + linrefPrVP : PrVerbPhrase -> Str = \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 ; + + linrefPrCl : PrClause -> Str = \cl -> declCl cl ; + linrefPrQCl : PrQuestionClause -> Str = \qcl -> questCl qcl ; + linrefPrAdv : PrAdverb -> Str = \adv -> strComplCase adv.c1 ++ adv.s ; +---- linrefPrAP = \ap -> ap.s ! defaultAgr ++ ap.obj1 ! defaultAgr ; +---- linrefPrCN = \cn -> cn.s ! Sg ++ cn.obj1 ! defaultAgr ; + + --------------------------- ---- concrete syntax opers ---------------------------