diff --git a/lib/src/experimental/NDPredFin.gf b/lib/src/experimental/NDPredFin.gf index fc45404e4..3717dfb9a 100644 --- a/lib/src/experimental/NDPredFin.gf +++ b/lib/src/experimental/NDPredFin.gf @@ -1,5 +1,5 @@ concrete NDPredFin of Pred = - CatFin [Ant,NP,Utt,IP,IAdv,IComp,Conj,RS,RP] ** + CatFin [Ant,NP,Utt,IP,IAdv,IComp,Conj,Subj,RS,RP] ** NDPredFunctor with (PredInterface = PredInstanceFin), diff --git a/lib/src/experimental/PredFin.gf b/lib/src/experimental/PredFin.gf index 116ad169b..c538c1343 100644 --- a/lib/src/experimental/PredFin.gf +++ b/lib/src/experimental/PredFin.gf @@ -1,34 +1,42 @@ --# -path=.:../finnish/stemmed:../finnish:../common:alltenses concrete PredFin of Pred = - CatFin [Ant,NP,Utt,IP,IAdv,IComp,Conj,RP,RS] ** + CatFin [Ant,NP,Utt,IP,IAdv,IComp,Conj,Subj,RP,RS] ** PredFunctor - [ --- not yet - UseVPC,StartVPC,ContVPC - - ,PresPartAP - ,PastPartAP,AgentPastPartAP - ,PassUseV, AgentPassUseV - -- overridden - ,UseV + UseV ,UseAP ,UseNP ,UseCN ,QuestVP ,PredVP ,ComplV2 - ,ReflVP2,ReflVP - ,RelVP,RelSlash + ,ReflVP2 + ,ReflVP + ,RelVP + ,RelSlash ,QuestIComp + ,PassUseV + ,PresPartAP + ,PastPartAP + ,AgentPastPartAP + ,AgentPassUseV + ,UseVPC + ,StartVPC + ,ContVPC + ,ComplVV + ,SlashV2V ] with - (PredInterface = PredInstanceFin) ** open PredInstanceFin, ResFin in { + (PredInterface = PredInstanceFin) ** open PredInstanceFin, (S = StemFin), ResFin in { lin + ComplVV x vp vpo = addObj2VP vp (\\a => vpo.s ! VPIVV vp.vvtype ! a) ; + SlashV2V x vp vpo = addObj2VP vp (\\a => vpo.s ! VPIVV vp.vvtype ! a) ; + UseV x a t p verb = initPrVerbPhraseV a t p verb ; UseAP x a t p ap = useCopula a t p ** { @@ -130,19 +138,13 @@ lin a = defaultAgr } ; - UseVPC,StartVPC,ContVPC - - ,PresPartAP - ,PastPartAP,AgentPastPartAP - ,AgentPassUseV - = variants {} ; PassUseV x a t p verb = initPrVerbPhraseV a t p verb ** { v : Agr => {fin,inf : Str} = case verb.sc of { SCNom => \\agr => finV (a.s ++ t.s ++ p.s) t.t a.a p.p Pass agr (lin PrV verb) ; _ => \\_ => finV (a.s ++ t.s ++ p.s) t.t a.a p.p Pass defaultAgr (lin PrV verb) } ; - inf : VVType => Str = \\vtt => tenseInfV (a.s ++ p.s) a.a p.p Pass (lin PrV verb) vtt ; ---- still Act + inf : VPIType => Str = \\vtt => tenseInfV (a.s ++ p.s) a.a p.p Pass (lin PrV verb) vtt ; ---- still Act imp : ImpType => Str = \\it => imperativeV p.s p.p it (lin PrV verb) ; ---- still Act isPass : Bool = True ; c1 : Compl = noComplCase ; @@ -152,14 +154,90 @@ lin h = case a.a of {Anter => Back ; _ => verb.h} ; } ; ----- this will be fun! + AgentPassUseV x a t p verb np = initPrVerbPhraseV a t p verb ** { + sc = npform2subjcase verb.c1.c ; + obj1 = \\a => appSubjCase verb.sc np ; + } ; - ByVP, -- tekemällä - WhenVP, -- tehdessä - BeforeVP, -- ennen tekemistä - AfterVP, -- tehtyä - InOrderVP, -- tehdäkseen - WithoutVP -- tekemättä + 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 ; -- looking at her + c2 = v.c2 ; + obj1 = noObj ; + } ; + + AgentPastPartAP x v np = { + s = \\a => (S.sverb2verbSep v).s ! AgentPart (aForm a) ; + c1 = v.c1 ; + c2 = v.c2 ; + obj1 = \\_ => appComplCase agentCase np ; ---- addObj + } ; + + + StartVPC x c v w = { ---- some loss of quality seems inevitable + v = \\a => + let + vv = v.v ! a ; + wv = w.v ! a ; + vpa = vagr2agr a ; + in + vv.fin ++ v.adV ++ vv.inf ++ v.adj ! vpa ++ + v.obj1 ! vpa ++ v.obj2 ! vpa ++ v.adv ++ v.ext + ++ c.s2 ++ + wv.fin ++ w.adV ++ wv.inf ++ w.adj ! vpa ++ + w.obj1 ! vpa ++ w.obj2 ! vpa ++ w.adv ++ w.ext ; + inf = \\a,vt => + infVP vt a v ++ c.s2 ++ infVP vt a w ; + imp = \\i => + impVP i v ++ c.s2 ++ impVP i 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 + v = \\a => + let + vv = v.v ! a ; + wv = w.v ! a ; + vpa = vagr2agr a ; + in + vv.fin ++ v.adV ++ vv.inf ++ v.adj ! vpa ++ + v.obj1 ! vpa ++ v.obj2 ! vpa ++ v.adv ++ v.ext + ++ "," ++ + wv ; + inf = \\a,vt => + infVP vt a v ++ "," ++ w.inf ! a ! vt ; + imp = \\i => + impVP i v ++ "," ++ w.imp ! i ; + c1 = noComplCase ; ---- w.c1 ? --- the full story is to unify v and w... + c2 = noComplCase ; ---- w.c2 ? + s1 = w.s1 ; + } ; + + UseVPC x vpc = initPrVerbPhrase ** { ---- big loss of quality (overgeneration) seems inevitable + v = \\a => {fin = vpc.s1 ++ vpc.v ! a ; inf = []} ; + inf = \\vt => vpc.inf ! defaultAgr ! vt ; ---- agr + imp = vpc.imp ; + c1 = vpc.c1 ; + c2 = vpc.c2 ; + } ; + + + ByVP x vp vpi = vp ** {adv = vpi.s ! VPIInf3Adess ! defaultAgr} ; -- tekemällä + WhenVP x vp vpi = vp ** {adv = vpi.s ! VPIInf2Iness ! defaultAgr} ; -- tehdessä ---- agr + BeforeVP x vp vpi = vp ** {adv = "ennen" ++ vpi.s ! VPIInf4Part ! defaultAgr} ; -- ennen tekemistä + InOrderVP x vp vpi = vp ** {adv = vpi.s ! VPIInf1Long ! defaultAgr} ; -- tehdäkseen ---- agr + WithoutVP x vp vpi = vp ** {adv = vpi.s ! VPIInf3Abess ! defaultAgr} ; -- tekemättä + + AfterVP -- tehtyä = variants {} ; } diff --git a/lib/src/experimental/PredFunctor.gf b/lib/src/experimental/PredFunctor.gf index 3f676dd4e..4e333ba27 100644 --- a/lib/src/experimental/PredFunctor.gf +++ b/lib/src/experimental/PredFunctor.gf @@ -25,7 +25,7 @@ lincat VPC = { v : VAgr => Str ; - inf : Agr => VVType => Str ; + inf : Agr => PredInterface.VVType => Str ; imp : ImpType => Str ; c1 : ComplCase ; c2 : ComplCase ; diff --git a/lib/src/experimental/PredInstanceFin.gf b/lib/src/experimental/PredInstanceFin.gf index d9ce9538c..9d89e108d 100644 --- a/lib/src/experimental/PredInstanceFin.gf +++ b/lib/src/experimental/PredInstanceFin.gf @@ -16,7 +16,7 @@ oper PrVerb = StemFin.SVerb1 ** { c1 : ComplCase ; c2 : ComplCase ; - vvtype : VVType ; + vvtype : ResFin.VVType ; } ; initPrVerb : PrVerb = { @@ -24,12 +24,12 @@ oper sc = SCNom ; h = Back ; p = [] ; - c1,c2 = noComplCase ; isSubjectControl = True ; vtype = Act ; vvtype = vvInfinitive + c1,c2 = noComplCase ; isSubjectControl = True ; vtype = Act ; vvtype = VVInf ; } ; PrVerbPhrase = { v : Agr => {fin,inf : Str} ; - inf : VVType => Str ; + inf : VPIType => Str ; imp : ImpType => Str ; adj : Agr => Str ; obj1 : Agr => Str ; -- Bool => Polarity => Agr => Str ; -- talo/talon/taloa @@ -39,7 +39,7 @@ oper ext : Str ; isNeg : Bool ; -- True if some complement is negative isPass : Bool ; -- True if the verb is rendered in the passive - vvtype : VVType ; + vvtype : ResFin.VVType ; sc : SubjCase ; h : Harmony ; c1 : Compl ; @@ -49,7 +49,7 @@ oper initPrVerbPhrase : PrVerbPhrase = { v : Agr => {fin,inf : Str} = \\_ => {fin,inf = []} ; - inf : VVType => Str = \\vtt => [] ; + inf : VPIType => Str = \\vtt => [] ; imp : ImpType => Str = \\_ => [] ; adj : Agr => Str = \\_ => [] ; obj1 : Agr => Str = \\_ => [] ; @@ -61,7 +61,7 @@ oper isPass : Bool = False ; c1 : Compl = noComplCase ; c2 : Compl = noComplCase ; - vvtype = defaultVVType ; + vvtype = VVInf ; sc = SCNom ; h = Back ; qforms : VAgr => Str * Str = \\_ => <[],[]> -- special Eng for introducing "do" in questions @@ -75,7 +75,7 @@ oper SCNom => \\agr => finV (a.s ++ t.s ++ p.s) t.t a.a p.p Act agr (lin PrV verb) ; _ => \\_ => finV (a.s ++ t.s ++ p.s) t.t a.a p.p Act defaultAgr (lin PrV verb) } ; - inf : VVType => Str = \\vtt => tenseInfV (a.s ++ p.s) a.a p.p Act (lin PrV verb) vtt ; + inf : VPIType => Str = \\vtt => tenseInfV (a.s ++ p.s) a.a p.p Act (lin PrV verb) vtt ; imp : ImpType => Str = \\it => imperativeV p.s p.p it (lin PrV verb) ; adj : Agr => Str = \\_ => [] ; obj1 : Agr => Str = \\_ => [] ; @@ -131,7 +131,7 @@ oper Case = ResFin.Case ; NPCase = ResFin.NPForm ; VForm = S.SVForm ; - VVType = ResFin.VVType ; + VVType = VPIType ; VType = Voice ; ---- Gender = Unit ; ---- @@ -144,7 +144,7 @@ oper passive = Pass ; defaultVType = Act ; - defaultVVType = VVInf ; + defaultVVType = vvInfinitive ; subjCase : NPCase = ResFin.NPCase Nom ; objCase : NPCase = NPAcc ; @@ -190,13 +190,25 @@ oper --- this is only needed in VPC formation vagr2agr : VAgr -> Agr = \a -> a ; - 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 + vPastPart : PrVerb -> AAgr -> Str = \v,a -> (S.sverb2verbSep v).s ! PastPartPass (aForm a) ; + vPresPart : PrVerb -> AAgr -> Str = \v,a -> (S.sverb2verbSep v).s ! PresPartAct (aForm a) ; - vvInfinitive : VVType = VVInf ; +-- predicative adjective form + aForm : AAgr -> AForm = \a -> case a of { + Ag Pl _ => AN (NCase Pl Part) ; + _ => AN (NCase Sg Nom) + } ; +---- TODO: case system of PrAP + + vvInfinitive : VVType = VPIVV VVInf ; isRefl : PrVerb -> Bool = \_ -> False ; ---- +-- the forms outside VPIVV to be used in adverbials such as "tekemällä" +param + VPIType = VPIVV (ResFin.VVType) + | VPIInf3Adess | VPIInf3Abess | VPIInf2Iness | VPIInf1Long {- | VPIPastPartPassPart -} | VPIInf4Part ; + -- tekemällä, tekemättä, tehdessä, tehdäkseen, tehtyään, tekemistä ------------------ --- opers -------- @@ -213,11 +225,19 @@ oper in {fin = sta ++ ovps.fin ; inf = ovps.inf} ; - infV : Str -> Anteriority -> Polarity -> SVoice -> PrVerb -> VVType -> Str = + infV : Str -> Anteriority -> Polarity -> SVoice -> PrVerb -> VPIType -> Str = \sa,a,pol,o,v,vvt -> let - vt = vvtype2infform vvt ; - ovps = (S.vp2old_vp (S.predV v)).s ! VIInf vt ! a ! pol ! defaultAgr ; -- VIForm => Anteriority => Polarity => Agr => {fin, inf : Str} ; + vt = case vvt of { + VPIVV vi => VIInf (vvtype2infform vi) ; + VPIInf3Adess => VIInf Inf3Adess ; + VPIInf3Abess => VIInf Inf3Abess ; + VPIInf2Iness => VIInf Inf2Iness ; + VPIInf1Long => VIInf Inf1Long ; +---- VPIPastPartPassPart => PastPartPass (AN (NCase Sg Part)) ; + VPIInf4Part => VIInf Inf4Part + } ; + ovps = (S.vp2old_vp (S.predV v)).s ! vt ! a ! pol ! defaultAgr ; -- VIForm => Anteriority => Polarity => Agr => {fin, inf : Str} ; in sa ++ ovps.fin ++ ovps.inf ;