PredFin and NDTransFin finally working

lib/src/experimental/LiftFin.gf

@@ -1,7 +1,6 @@
 concrete LiftFin of Lift =
    RGLBaseFin - [Pol,Tense]
   ,PredFin
-
               ** open ResFin, 
                       StemFin,
                       PredInstanceFin,
@@ -9,32 +8,31 @@ concrete LiftFin of Lift =
 
 --flags literal=Symb ;
 
-oper
-  vliftV : SVerb1 -> PrVerb = PredInstanceFin.liftV ;
-
 lin
-  LiftV  v = vliftV v ;
+  LiftV  v = liftV v ;
-  LiftV2 v = vliftV v ** {c1 = v.c2} ;
+  LiftV2 v = liftV v ** {c1 = v.c2} ;
-  LiftVS v = vliftV v ;
+  LiftVS v = liftV v ;
-  LiftVQ v = vliftV v ;
+  LiftVQ v = liftV v ;
-  LiftVA v = vliftV v ** {c1 = v.c2} ;
+  LiftVA v = liftV v ** {c1 = v.c2} ;
-  LiftVN v = vliftV v ** {c1 = v.c2} ;
+  LiftVN v = liftV v ** {c1 = v.c2} ;
-  LiftVV v = vliftV v ** {vvType = v.vi} ;
+  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} ;
+  LiftV2S v = liftV v ** {c1 = v.c2} ;
-  LiftV2Q v = vliftV v ** {c1 = v.c2} ;
+  LiftV2Q v = liftV v ** {c1 = v.c2} ;
-  LiftV2V v = vliftV v ** {c1 = v.c2 ; vvType = v.vi} ;
+  LiftV2V v = liftV v ** {c1 = v.c2 ; vvType = v.vi} ;
-  LiftV2A v = vliftV v ** {c1 = v.c2 ; c2 = v.c3} ;
+  LiftV2A v = liftV v ** {c1 = v.c2 ; c2 = v.c3} ;
-  LiftV2N v = vliftV 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} ;
 }
 

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   : (a : Arg) -> PrVP aV             -> PrVPI  a -> PrVP a ;        -- she wants to sleep
-  ComplVV_none : PrVP_v -> PrVP_none -> PrVP_none ;
+  ComplVV_none : PrVP_v -> PrVPI_none -> PrVP_none ;
-  ComplVV_np   : PrVP_v -> PrVP_np   -> PrVP_np ;
+  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  : (a : Arg) -> PrVP (aNP aV)       -> PrVPI a -> PrVP (aNP a) ;   -- she forces X to sleep
-  SlashV2V_none : PrVP_np_v -> PrVP_none -> PrVP_np ;
+  SlashV2V_none : PrVP_np_v -> PrVPI_none -> PrVP_np ;
-  SlashV2V_np   : PrVP_np_v -> PrVP_np -> PrVP_np_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 ;

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 ;

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

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
+        UseVPC,StartVPC,ContVPC
-       ]
-    with 
-      (PredInterface = PredInstanceFin) 
 
-  ** {
+       ,PresPartAP
+       ,PastPartAP,AgentPastPartAP
+       ,PassUseV, AgentPassUseV
+
+       ,UseV --
+       ,UseCN --
+       ,UseAP --       
+       ,QuestVP --
+       ,PredVP --
+       ,ComplV2 --
+       ,ReflVP2,ReflVP --
+     ]
+
+with 
+      (PredInterface = PredInstanceFin) ** open PredInstanceFin, ResFin in {
 
 lin
-  StartVPC, ContVPC
+  UseV x a t p verb = initPrVerbPhraseV a t p verb ;
-----  , AgentPassUseV, ComplVA, ComplVN, ComplVV,SlashV2A,SlashV2V,SlashV2N
+
-    = variants {} ; ---- just to make it compile as instance of Pred
+  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 {} ;
+
 }

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 ;

lib/src/experimental/PredInstanceFin.gf

@@ -2,7 +2,8 @@ instance PredInstanceFin of
   PredInterface - [
     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 ;                
+    v   : Agr => {fin,inf : Str} ;
-    atp : {a : Anteriority ; t : STense ; p : Polarity ; as,ts,ps : Str} ;
+    inf : VVType => Str ;
-    vtype : VType ;
+    obj1 : Agr => Str ;             -- Bool => Polarity => Agr => Str ; -- talo/talon/taloa
-    c1 : ComplCase ; 
+    obj2 : Agr => Str ;             -- Bool => Polarity => Agr => Str ; -- talo/talon/taloa
-    c2 : ComplCase ; 
+    adv : Str ;                     -- Polarity => Str ;        -- ainakin/ainakaan
-    part  : Str ;                  -- (look) up
+    adV : Str ;                     -- Polarity => Str ;        -- ainakin/ainakaan
-    adj   : Agr => Str ; 
+    ext : Str ;
-    obj1  : (Agr => Str) * Agr ;   -- agr for object control
+    isNeg : Bool ;  -- True if some complement is negative
-    obj2  : (Agr => Str) * Bool ;  -- subject control = True 
+    isPass : Bool ; -- True if the verb is rendered in the passive
-    vvtype : VVType ;              -- type of VP complement
+    vvtype : VVType ;
-    adv : Str ; 
+    sc : SubjCase ;
-    adV : Str ;
+    h  : Harmony ;
-    ext : Str 
+    c1 : Compl ;
+    c2 : Compl ;
+    qforms : VAgr => Str * Str ;
     } ;
 
   initPrVerbPhrase : PrVerbPhrase = {
-    v : S.SVerb1 = initPrVerb ;
+    v : Agr => {fin,inf : Str} = \\_ => {fin,inf = []} ;
-    atp = {a = Simul ; t = Pres ; p = Pos ; as,ts,ps = []} ;
+    inf : VVType => Str = \\vtt => [] ;
-    vtype = defaultVType ;
+    obj1 : Agr => Str = \\_ => [] ;
-    c1 : ComplCase = noComplCase ; 
+    obj2 : Agr => Str = \\_ => [] ;
-    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 = [] ;
+    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 ** {
+  \a,t,p,verb -> 
-    v   : S.SVerb1 = v ;
+  initPrVerbPhrase ** {
-    atp = {a = a.a ; t = t.t ; p = p.p ; as = a.s ; ts = t.s ; ps = p.s} ;
+    v : Agr => {fin,inf : Str} = case verb.sc of {
-    vtype = v.vtype ;
+       SCNom => \\agr => finV (a.s ++ t.s ++ p.s) t.t a.a p.p Act agr        (lin PrV verb) ;
-    c1  = v.c1 ;
+       _     => \\_   => finV (a.s ++ t.s ++ p.s) t.t a.a p.p Act defaultAgr (lin PrV verb)
-    c2  = v.c2 ;
+       } ;
-    part = v.p ;
+    inf : VVType => Str = \\vtt => infV (a.s ++ p.s) a.a p.p Act (lin PrV verb) vtt ;
-    obj1 = <case isRefl v of {True => \\a => reflPron a ; _ => \\_ => []}, defaultAgr> ; ---- not used, just default value
+    obj1 : Agr => Str = \\_ => [] ;
-    obj2 = <noObj, v.isSubjectControl> ;
+    obj2 : Agr => Str = \\_ => [] ;
-    vvtype = v.vvtype ;
+    adv : Str = [] ;
-    adV = negAdV p ; --- just p.s in Fin
+    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 -> 
+  finV : Str -> STense -> Anteriority -> Polarity -> SVoice -> Agr -> PrVerb -> {fin,inf : Str} =
+       \sta,t,a,pol,o,agr,v -> 
     let 
-      ipol = pvp.atp.p ;
+      ovps = (S.vp2old_vp (S.predV v)).s ! VIFin t ! a ! pol ! agr ; -- VIForm => Anteriority => Polarity => Agr => {fin, inf : Str} ;
-      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
-    S.infVPGen -- : Polarity -> NPForm -> Polarity -> Agr -> VP -> InfForm -> Str =
+    {fin = sta ++ ovps.fin ; inf = ovps.inf} ;
-        ipol sc pol agr vp0 vi ;
 
-  declCl       : PrClause -> Str = \cl -> cl.subj ++ cl.v.p1 ++ cl.adV ++ cl.v.p2 ++ restCl cl ;
+  infV : Str -> Anteriority -> Polarity -> SVoice -> PrVerb -> VVType -> Str = 
-  declSubordCl : PrClause -> Str = \cl -> cl.subj ++ cl.adV ++ cl.v.p1 ++ (cl.v.p2 | []) ++ restCl cl ;
+      \sa,a,pol,o,v,vvt ->
-  declInvCl    : PrClause -> Str = \cl -> cl.v.p1 ++ cl.subj ++ cl.adV ++ cl.v.p2 ++ restCl cl ;
+   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 -> <[],[]> ;
+
+
 }

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