diff --git a/lib/src/experimental/LiftFin.gf b/lib/src/experimental/LiftFin.gf index 90c137e21..5631e49b4 100644 --- a/lib/src/experimental/LiftFin.gf +++ b/lib/src/experimental/LiftFin.gf @@ -1,40 +1,38 @@ concrete LiftFin of Lift = RGLBaseFin - [Pol,Tense] ,PredFin - ** open ResFin, StemFin, - PredInstanceFin, + PredInstanceFin, Prelude in { --flags literal=Symb ; -oper - vliftV : SVerb1 -> PrVerb = PredInstanceFin.liftV ; - lin - 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} ; + LiftV v = liftV v ; + LiftV2 v = liftV v ** {c1 = v.c2} ; + LiftVS v = liftV v ; + LiftVQ v = liftV v ; + LiftVA v = liftV v ** {c1 = v.c2} ; + LiftVN v = liftV v ** {c1 = v.c2} ; + LiftVV v = liftV v ** {vvType = v.vi} ; - LiftV3 v = vliftV v ** {c1 = v.c2 ; c2 = v.c3} ; + LiftV3 v = liftV 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} ; + LiftV2S v = liftV v ** {c1 = v.c2} ; + LiftV2Q v = liftV v ** {c1 = v.c2} ; + LiftV2V v = liftV v ** {c1 = v.c2 ; vvType = v.vi} ; + LiftV2A v = liftV v ** {c1 = v.c2 ; c2 = v.c3} ; + LiftV2N v = liftV v ** {c1 = v.c2 ; c2 = v.c3} ; + + LiftAP ap = {s = \\a => ap.s ! False ! NCase (complNumAgr a) Nom ; c1,c2 = noComplCase ; obj1 = \\_ => []} ; --- Part in Pl +---- LiftA2 ap = {s = \\a => ap.s ! AF (APosit (agr2aformpos a)) Nom ; c1 = ap.c2.s ; c2 = noComplCase ; obj1 = \\_ => []} ; --- isPre + + LiftCN cn = {s = \\n => cn.s ! NCase n Nom ; c1,c2 = noComplCase ; obj1 = \\_ => []} ; +---- LiftN2 cn = {s = \\n => cn.s ! n ! specDet DIndef ! Nom ; c1 = cn.c2.s ; c2 = [] ; obj1 = \\_ => []} ; + + LiftA2,LiftN2,AppAPCN = variants {} ; ---- for functor use {- - 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 - - LiftCN cn = {s = \\n => cn.s ! n ! DIndef ! Nom ; c1,c2 = [] ; obj1 = \\_ => []} ; - LiftN2 cn = {s = \\n => cn.s ! n ! specDet DIndef ! Nom ; c1 = cn.c2.s ; c2 = [] ; obj1 = \\_ => []} ; - AppAPCN ap cn = {s = \\n,d,c => let @@ -50,11 +48,9 @@ lin g = cn.g ; isMod = True } ; - - LiftAdv a = a ** {isAdV = False ; c1 = []} ; - LiftAdV a = a ** {isAdV = True ; c1 = []} ; - LiftPrep p = {s = [] ; isAdV = False ; c1 = p.s} ; -} - + LiftAdv a = a ** {isAdV = False ; c1 = noComplCase} ; + LiftAdV a = a ** {isAdV = True ; c1 = noComplCase} ; + LiftPrep p = {s = [] ; isAdV = False ; c1 = p} ; } diff --git a/lib/src/experimental/NDPred.gf b/lib/src/experimental/NDPred.gf index 29c80db80..26ed70552 100644 --- a/lib/src/experimental/NDPred.gf +++ b/lib/src/experimental/NDPred.gf @@ -11,6 +11,10 @@ cat 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 ; +--< PrVPI Arg ; -- infinitive VP + PrVPI_none ; + PrVPI_np ; + --< VPC Arg ; -- conjunction of VP VPC_none ; VPC_np ; @@ -92,9 +96,9 @@ fun ComplVS_none : PrVP_s -> PrCl_none -> PrVP_none ; ComplVS_np : PrVP_s -> PrCl_np -> PrVP_np ; ---< ComplVV : (a : Arg) -> PrVP aV -> PrVP a -> PrVP a ; -- she wants to sleep - ComplVV_none : PrVP_v -> PrVP_none -> PrVP_none ; - ComplVV_np : PrVP_v -> PrVP_np -> PrVP_np ; +--< ComplVV : (a : Arg) -> PrVP aV -> PrVPI a -> PrVP a ; -- she wants to sleep + ComplVV_none : PrVP_v -> PrVPI_none -> PrVP_none ; + ComplVV_np : PrVP_v -> PrVPI_np -> PrVP_np ; --< ComplVQ : (a : Arg) -> PrVP aQ -> PrQCl a -> PrVP a ; -- she wonders who is here ComplVQ_none : PrVP_q -> PrQCl_none -> PrVP_none ; @@ -111,9 +115,9 @@ fun --< SlashV2S : (a : Arg) -> PrVP (aNP aS) -> PrCl a -> PrVP (aNP a) ; -- she tells X that I am here SlashV2S_none : PrVP_np_s -> PrCl_none -> PrVP_np ; ---< SlashV2V : (a : Arg) -> PrVP (aNP aV) -> PrVP a -> PrVP (aNP a) ; -- she forces X to sleep - SlashV2V_none : PrVP_np_v -> PrVP_none -> PrVP_np ; - SlashV2V_np : PrVP_np_v -> PrVP_np -> PrVP_np_np ; +--< SlashV2V : (a : Arg) -> PrVP (aNP aV) -> PrVPI a -> PrVP (aNP a) ; -- she forces X to sleep + SlashV2V_none : PrVP_np_v -> PrVPI_none -> PrVP_np ; + SlashV2V_np : PrVP_np_v -> PrVPI_np -> PrVP_np_np ; --< SlashV2A : (a : Arg) -> PrVP (aNP aA) -> PrAP a -> PrVP (aNP a) ; -- she makes X crazy SlashV2A_none : PrVP_np_a -> PrAP_none -> PrVP_np ; @@ -139,6 +143,10 @@ fun --< UseNP : Ant -> Tense -> Pol -> NP -> PrVP aNone ; -- she is the person UseNP_none : Ant -> Tense -> Pol -> NP -> PrVP_none ; +--< InfVP : (a : Arg) -> PrVP a -> PrVPI a ; + InfVP_none : PrVP_none -> PrVPI_none ; + InfVP_np : PrVP_np -> PrVPI_np ; + --< PredVP : (a : Arg) -> NP -> PrVP a -> PrCl a ; PredVP_none : NP -> PrVP_none -> PrCl_none ; PredVP_np : NP -> PrVP_np -> PrCl_np ; diff --git a/lib/src/experimental/NDPredFunctor.gf b/lib/src/experimental/NDPredFunctor.gf index ba8828439..8fce2b9c1 100644 --- a/lib/src/experimental/NDPredFunctor.gf +++ b/lib/src/experimental/NDPredFunctor.gf @@ -21,6 +21,8 @@ lincat 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 = Pred.PrVP ; + PrVPI_none, PrVPI_np = Pred.PrVPI ; + PrCl_none, PrCl_np = Pred.PrCl ; PrQCl_none, PrQCl_np = Pred.PrQCl ; @@ -114,6 +116,8 @@ lin ReflVP2_np = Pred.ReflVP2 Pred.aNone ; + InfVP_none, InfVP_np + = Pred.InfVP Pred.aNone ; PredVP_none, PredVP_np = Pred.PredVP Pred.aNone ; diff --git a/lib/src/experimental/Pred.gf b/lib/src/experimental/Pred.gf index 5b64c8a2b..6c915160a 100644 --- a/lib/src/experimental/Pred.gf +++ b/lib/src/experimental/Pred.gf @@ -4,6 +4,7 @@ cat Arg ; PrV Arg ; PrVP Arg ; + PrVPI Arg ; VPC Arg ; -- conjunction of VP Tense ; Pol ; @@ -28,17 +29,19 @@ fun ComplV2 : (a : Arg) -> PrVP (aNP a) -> NP -> PrVP a ; -- she loves him ComplVS : (a : Arg) -> PrVP aS -> PrCl a -> PrVP a ; -- she says that I am here - ComplVV : (a : Arg) -> PrVP aV -> PrVP a -> PrVP a ; -- she wants to sleep + ComplVV : (a : Arg) -> PrVP aV -> PrVPI a -> PrVP a ; -- she wants to sleep ComplVQ : (a : Arg) -> PrVP aQ -> PrQCl a -> PrVP a ; -- she wonders who is here ComplVA : (a : Arg) -> PrVP aA -> PrAP a -> PrVP a ; -- she becomes old ComplVN : (a : Arg) -> PrVP aN -> PrCN a -> PrVP a ; -- she becomes a professor SlashV3 : (a : Arg) -> PrVP (aNP (aNP a)) -> NP -> PrVP (aNP a) ; -- she shows X to him SlashV2S : (a : Arg) -> PrVP (aNP aS) -> PrCl a -> PrVP (aNP a) ; -- she tells X that I am here - SlashV2V : (a : Arg) -> PrVP (aNP aV) -> PrVP a -> PrVP (aNP a) ; -- she forces X to sleep + SlashV2V : (a : Arg) -> PrVP (aNP aV) -> PrVPI a -> PrVP (aNP a) ; -- she forces X to sleep SlashV2A : (a : Arg) -> PrVP (aNP aA) -> PrAP a -> PrVP (aNP a) ; -- she makes X crazy SlashV2N : (a : Arg) -> PrVP (aNP aN) -> PrCN a -> PrVP (aNP a) ; -- she makes X a professor SlashV2Q : (a : Arg) -> PrVP (aNP aA) -> PrQCl a -> PrVP (aNP a) ; -- she asks X who is here + InfVP : (a : Arg) -> PrVP a -> PrVPI a ; -- to love X + UseAP : (a : Arg) -> Ant -> Tense -> Pol -> PrAP a -> PrVP a ; -- she is married to X UseAdv : (a : Arg) -> Ant -> Tense -> Pol -> PrAdv a -> PrVP a ; -- she is in X UseCN : (a : Arg) -> Ant -> Tense -> Pol -> PrCN a -> PrVP a ; -- she is a member of X diff --git a/lib/src/experimental/PredFin.gf b/lib/src/experimental/PredFin.gf index 453e4dce1..8bb8fe9d9 100644 --- a/lib/src/experimental/PredFin.gf +++ b/lib/src/experimental/PredFin.gf @@ -1,16 +1,83 @@ +--# -path=.:../finnish/stemmed:../finnish:../common:alltenses + concrete PredFin of Pred = CatFin [Ant,NP,Utt,IP,IAdv,Conj] ** PredFunctor - - [StartVPC, ContVPC ----- ,AgentPassUseV, ComplVA, ComplVN, ComplVV,SlashV2A,SlashV2V,SlashV2N - ] - with - (PredInterface = PredInstanceFin) + - [ + UseVPC,StartVPC,ContVPC - ** { + ,PresPartAP + ,PastPartAP,AgentPastPartAP + ,PassUseV, AgentPassUseV -lin - StartVPC, ContVPC ----- , AgentPassUseV, ComplVA, ComplVN, ComplVV,SlashV2A,SlashV2V,SlashV2N - = variants {} ; ---- just to make it compile as instance of Pred -} + ,UseV -- + ,UseCN -- + ,UseAP -- + ,QuestVP -- + ,PredVP -- + ,ComplV2 -- + ,ReflVP2,ReflVP -- + ] + +with + (PredInterface = PredInstanceFin) ** open PredInstanceFin, ResFin in { + +lin + UseV x a t p verb = initPrVerbPhraseV a t p verb ; + + ComplV2 x vp np = vp ** { + obj1 = \\_ => appCompl True Pos vp.c1 np ; + } ; + + PredVP x np vp = vp ** { + subj : Str = appSubjCase vp.sc np ; + verb : {fin,inf : Str} = vp.v ! np.a ; + obj1 : Str = vp.obj1 ! np.a ; + obj2 : Str = vp.obj2 ! np.a ; + c3 : Compl = noComplCase ; + } ; + + UseAP x a t p ap = useCopula a t p ** { + c1 = ap.c1 ; + c2 = ap.c2 ; + obj1 = \\a => ap.s ! agr2aagr a ; + } ; + + UseCN x a t p cn = useCopula a t p ** { + c1 = cn.c1 ; + c2 = cn.c2 ; + obj1 = \\a => cn.s ! agr2nagr a ; + } ; + + ReflVP x vp = vp ** { + obj1 = \\a => (reflPron a).s ! vp.c1.c ; ---- prep + } ; + + ReflVP2 x vp = vp ** { + obj2 = \\a => (reflPron a).s ! vp.c2.c ; ---- prep + } ; + + QuestVP x ip vp = + let + ipa = ipagr2agr ip.n + in vp ** { + foc = ip.s ! subjCase ; ---- appSubjCase ip + focType = FocSubj ; + subj = [] ; + verb : {fin,inf : Str} = vp.v ! ipa ; + obj1 : Str = vp.obj1 ! ipa ; + obj2 : Str = vp.obj2 ! ipa ; + c3 : Compl = noComplCase ; + qforms = \\_ => <[],[]> ; + } ; + + + + UseVPC,StartVPC,ContVPC + + ,PresPartAP + ,PastPartAP,AgentPastPartAP + ,PassUseV, AgentPassUseV + = variants {} ; + +} diff --git a/lib/src/experimental/PredFunctor.gf b/lib/src/experimental/PredFunctor.gf index 31093bda4..f8aa163fb 100644 --- a/lib/src/experimental/PredFunctor.gf +++ b/lib/src/experimental/PredFunctor.gf @@ -21,6 +21,8 @@ lincat PrQCl = PrQuestionClause ; + PrVPI = {s : PredInterface.VVType => Agr => Str} ; + VPC = { v : VAgr => Str ; inf : Agr => Str ; @@ -128,7 +130,7 @@ lin ComplVQ x vp qcl = addExtVP vp (questSubordCl qcl) ; ---- question form - ComplVV x vp vpo = addObj2VP vp (\\a => infVP vp.vvtype a vpo) ; + ComplVV x vp vpo = addObj2VP vp (\\a => vpo.s ! vp.vvtype ! a) ; ComplVA x vp ap = addObj2VP vp (\\a => ap.s ! agr2aagr a ++ ap.obj1 ! a) ; ---- adjForm @@ -140,7 +142,7 @@ lin SlashV2Q x vp cl = addExtVP vp (questSubordCl cl) ; ---- question form - SlashV2V x vp vpo = addObj2VP vp (\\a => infVP vp.vvtype a (lin VP vpo)) ; + SlashV2V x vp vpo = addObj2VP vp (\\a => vpo.s ! vp.vvtype ! a) ; SlashV2A x vp ap = addObj2VP vp (\\a => ap.s ! agr2aagr a ++ ap.obj1 ! a) ; ---- adjForm @@ -154,14 +156,16 @@ lin obj2 = <\\a => reflPron a, vp.obj2.p2> ; --- subj/obj control doesn't matter any more } ; + InfVP x vp = {s = \\vvt,a => infVP vvt a vp} ; + PredVP x np vp = vp ** { - v = vp.v ! agr2vagr np.a ; + v = applyVerb vp (agr2vagr np.a) ; subj = np.s ! subjCase ; 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 = noComplCase ; -- for one more prep to build ClSlash - qforms = vp.qforms ! agr2vagr np.a ; + qforms = qformsVP vp (agr2vagr np.a) ; } ; SlashClNP x cl np = cl ** { -- Cl ::= Cl/NP NP @@ -177,7 +181,7 @@ lin let ipa = ipagr2agr ip.n in { - v = vp.v ! ipagr2vagr ip.n ; + v = applyVerb vp (ipagr2vagr ip.n) ; foc = ip.s ! subjCase ; -- who (loves her) focType = FocSubj ; subj = [] ; @@ -188,10 +192,9 @@ lin adv = vp.adv ; adV = vp.adV ; ext = vp.ext ; - qforms = vp.qforms ! ipagr2vagr ip.n ; + qforms = qformsVP vp (ipagr2vagr ip.n) ; } ; - QuestSlash x ip cl = let prep = cl.c3 ; diff --git a/lib/src/experimental/PredInstanceFin.gf b/lib/src/experimental/PredInstanceFin.gf index 7e91f0ba0..4efc1ef4d 100644 --- a/lib/src/experimental/PredInstanceFin.gf +++ b/lib/src/experimental/PredInstanceFin.gf @@ -1,8 +1,9 @@ instance PredInstanceFin of PredInterface - [ - NounPhrase, + NounPhrase, PrVerb, initPrVerb, - PrVerbPhrase, initPrVerbPhrase, initPrVerbPhraseV, useCopula + PrVerbPhrase, initPrVerbPhrase, initPrVerbPhraseV, useCopula, linrefPrVP, qformsVP, applyVerb, addObj2VP, + PrClause, initPrClause ] = open ResFin, (P = ParadigmsFin), (S = StemFin), (X = ParamX), Prelude in { @@ -14,70 +15,103 @@ oper PrVerb = StemFin.SVerb1 ** { c1 : ComplCase ; c2 : ComplCase ; - isSubjectControl : Bool ; - vtype : VType ; vvtype : VVType ; } ; initPrVerb : PrVerb = { s = \\_ => [] ; - sc = subjCase ; + sc = SCNom ; h = Back ; p = [] ; - c1,c2 = noComplCase ; isSubjectControl = True ; vtype = defaultVType ; vvtype = vvInfinitive + c1,c2 = noComplCase ; isSubjectControl = True ; vtype = Act ; 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 + v : Agr => {fin,inf : Str} ; + inf : VVType => Str ; + obj1 : Agr => Str ; -- Bool => Polarity => Agr => Str ; -- talo/talon/taloa + obj2 : Agr => Str ; -- Bool => Polarity => Agr => Str ; -- talo/talon/taloa + adv : Str ; -- Polarity => Str ; -- ainakin/ainakaan + adV : Str ; -- Polarity => Str ; -- ainakin/ainakaan + ext : Str ; + isNeg : Bool ; -- True if some complement is negative + isPass : Bool ; -- True if the verb is rendered in the passive + vvtype : VVType ; + sc : SubjCase ; + h : Harmony ; + c1 : Compl ; + c2 : Compl ; + qforms : VAgr => Str * 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 = [] ; + v : Agr => {fin,inf : Str} = \\_ => {fin,inf = []} ; + inf : VVType => Str = \\vtt => [] ; + obj1 : Agr => Str = \\_ => [] ; + obj2 : Agr => Str = \\_ => [] ; + adv : Str = [] ; adV : Str = [] ; ext : Str = [] ; + isNeg : Bool = True ; + isPass : Bool = False ; + c1 : Compl = noComplCase ; + c2 : Compl = noComplCase ; + vvtype = defaultVVType ; + sc = SCNom ; + h = Back ; 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 + \a,t,p,verb -> + initPrVerbPhrase ** { + v : Agr => {fin,inf : Str} = case verb.sc of { + 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 => infV (a.s ++ p.s) a.a p.p Act (lin PrV verb) vtt ; + obj1 : Agr => Str = \\_ => [] ; + obj2 : Agr => Str = \\_ => [] ; + adv : Str = [] ; + adV : Str = [] ; + ext : Str = [] ; + isNeg : Bool = True ; + isPass : Bool = False ; + c1 : Compl = verb.c1 ; + c2 : Compl = verb.c2 ; + vvtype = verb.vvtype ; + sc = verb.sc ; + h = case a.a of {Anter => Back ; _ => verb.h} ; } ; 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) ; + linrefPrVP : PrVerbPhrase -> Str = \_ -> "verbphrase" ; ---- + + PrClause = { + subj : Str ; + verb : {fin,inf : Str} ; + obj1 : Str ; + obj2 : Str ; + adv : Str ; + adV : Str ; + ext : Str ; + h : Harmony ; + c3 : Compl ; + } ; + initPrClause : PrClause = { + subj : Str = [] ; + verb : {fin,inf : Str} = {fin,inf = []} ; + obj1 : Str = [] ; + obj2 : Str = [] ; + adv : Str = [] ; + adV : Str = [] ; + ext : Str = [] ; + h : Harmony = Back ; + c3 : Compl = noComplCase ; + } ; --------------------- -- parameters ------- @@ -88,7 +122,7 @@ oper Case = ResFin.Case ; NPCase = ResFin.NPForm ; VForm = S.SVForm ; - VVType = ResFin.InfForm ; + VVType = ResFin.VVType ; VType = Voice ; ---- Gender = Unit ; ---- @@ -101,13 +135,14 @@ oper passive = Pass ; defaultVType = Act ; + defaultVVType = VVInf ; subjCase : NPCase = ResFin.NPCase Nom ; objCase : NPCase = NPAcc ; ComplCase = ResFin.Compl ; -- preposition agentCase : ComplCase = P.postGenPrep "toimesta" ; - strComplCase : ComplCase -> Str = \c -> c.s ! False ; + strComplCase : ComplCase -> Str = \c -> c.s.p1 ++ c.s.p2 ; appComplCase : ComplCase -> NounPhrase -> Str = \p,np -> appCompl True Pos p np ; noComplCase : ComplCase = P.postGenPrep [] ; ---- @@ -137,7 +172,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 = VVInf ; isRefl : PrVerb -> Bool = \_ -> False ; ---- @@ -149,36 +184,39 @@ oper oper reflPron : Agr -> Str = \a -> (ResFin.reflPron a).s ! NPAcc ; ---- case - 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}} ; - } + finV : Str -> STense -> Anteriority -> Polarity -> SVoice -> Agr -> PrVerb -> {fin,inf : Str} = + \sta,t,a,pol,o,agr,v -> + let + ovps = (S.vp2old_vp (S.predV v)).s ! VIFin t ! a ! pol ! agr ; -- VIForm => Anteriority => Polarity => Agr => {fin, inf : Str} ; in - S.infVPGen -- : Polarity -> NPForm -> Polarity -> Agr -> VP -> InfForm -> Str = - ipol sc pol agr vp0 vi ; + {fin = sta ++ ovps.fin ; inf = ovps.inf} ; - 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 ; + infV : Str -> Anteriority -> Polarity -> SVoice -> PrVerb -> VVType -> Str = + \sa,a,pol,o,v,vvt -> + let + vt = Inf1 ; ----vvtype2inform vvt + 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 ; - questCl : PrQuestionClause -> Str = \cl -> cl.foc ++ cl.v.p1 ++ cl.subj ++ cl.adV ++ cl.v.p2 ++ restCl cl ; + infVP : VVType -> Agr -> PrVerbPhrase -> Str = \vvt,agr,vp -> + vp.inf ! vvt ++ vp.adV ++ vp.obj1 ! agr ++ vp.obj2 ! agr ++ vp.adv ++ vp.ext ; + + declCl : PrClause -> Str = \cl -> + cl.subj ++ cl.verb.fin ++ cl.adV ++ cl.verb.inf ++ cl.obj1 ++ cl.obj2 ++ cl.adv ++ cl.ext ; + + declSubordCl : PrClause -> Str = declCl ; + declInvCl : PrClause -> Str = declCl ; --- + + questCl : PrQuestionClause -> Str = \cl -> + cl.verb.fin ++ Predef.BIND ++ "ko" ++ cl.subj ++ cl.adV ++ cl.verb.inf ++ cl.obj1 ++ cl.obj2 ++ cl.adv ++ cl.ext ; questSubordCl : PrQuestionClause -> Str = questCl ; that_Compl : Str = "että" ; -- 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.s ! False ; ---- c3 +--- restCl : PrClause -> Str = \cl -> cl.v.p3 ++ cl.adj ++ cl.obj1 ++ cl.obj2 ++ cl.adv ++ cl.ext ++ cl.c3.s.p1 ++ cl.c3.s.p2 ; ---- c3 negAdV : {s : Str ; p : Polarity} -> Str = \p -> p.s ; @@ -204,8 +242,11 @@ oper noObj : Agr => Str = \\_ => [] ; + applyVerb : PrVerbPhrase -> VAgr -> {inf,fin : Str} + = \vp,agr -> vp.v ! agr ; + addObj2VP : PrVerbPhrase -> (Agr => Str) -> PrVerbPhrase = \vp,obj -> vp ** { - obj2 = <\\a => vp.obj2.p1 ! a ++ obj ! a, vp.obj2.p2> ; + obj2 = \\a => vp.obj2 ! a ++ obj ! a ; } ; addExtVP : PrVerbPhrase -> Str -> PrVerbPhrase = \vp,ext -> vp ** { @@ -223,4 +264,8 @@ oper qformsCopula : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str = \sta,t,a,p,agr -> <[],[]> ; + qformsVP : PrVerbPhrase -> VAgr -> Str * Str + = \vp,vagr -> <[],[]> ; + + } \ No newline at end of file diff --git a/lib/src/experimental/PredInterface.gf b/lib/src/experimental/PredInterface.gf index e8945a3ee..e0977622c 100644 --- a/lib/src/experimental/PredInterface.gf +++ b/lib/src/experimental/PredInterface.gf @@ -84,10 +84,15 @@ oper isRefl : PrVerb -> Bool ; + 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