missing Pred functions in Fin

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),

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
+       ,ReflVP2
-       ,RelVP,RelSlash
+       ,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ä
+  PresPartAP x v = {            
-  WhenVP,     -- tehdessä
+    s = \\a => vPresPart v a ;
-  BeforeVP,   -- ennen tekemistä
+    c1 = v.c1 ;                    -- looking at her
-  AfterVP,    -- tehtyä
+    c2 = v.c2 ;
-  InOrderVP,  -- tehdäkseen
+    obj1 = noObj ;
-  WithoutVP   -- tekemättä
+    } ;
+
+  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 {} ;
 
 }

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 ;

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
+  vPastPart : PrVerb -> AAgr -> Str = \v,a -> (S.sverb2verbSep v).s ! PastPartPass (aForm a) ;
-  vPresPart : PrVerb -> AAgr -> Str = \v,a -> (S.sverb2verbSep v).s ! PresPartAct (AN (NCase Sg Part)) ; ---- case
+  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 ; 
+     vt = case vvt of {
-     ovps = (S.vp2old_vp (S.predV v)).s ! VIInf vt ! a ! pol ! defaultAgr ; -- VIForm => Anteriority => Polarity => Agr => {fin, inf : Str} ;
+       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 ;