ported (most of) the new structures to PredFin

lib/src/experimental/PredFin.gf

@@ -1,22 +1,27 @@
 --# -path=.:../finnish/stemmed:../finnish:../common:alltenses
 
 concrete PredFin of Pred = 
-  CatFin [Ant,NP,Utt,IP,IAdv,Conj] ** 
+  CatFin [Ant,NP,Utt,IP,IAdv,IComp,Conj,RP,RS] ** 
     PredFunctor 
      - [
+
+-- not yet
         UseVPC,StartVPC,ContVPC
 
        ,PresPartAP
        ,PastPartAP,AgentPastPartAP
        ,PassUseV, AgentPassUseV
 
-       ,UseV --
-       ,UseCN --
-       ,UseAP --       
-       ,QuestVP --
-       ,PredVP --
-       ,ComplV2 --
-       ,ReflVP2,ReflVP --
+-- overridden
+       ,UseV
+       ,UseAP
+       ,UseCN
+       ,QuestVP
+       ,PredVP
+       ,ComplV2
+       ,ReflVP2,ReflVP
+       ,RelVP,RelSlash
+       ,QuestIComp
      ]
 
 with 
@@ -25,6 +30,19 @@ with
 lin
   UseV x a t p verb = initPrVerbPhraseV a t p verb ;
 
+
+  UseAP x a t p ap = useCopula a t p ** {
+    c1  = ap.c1 ;
+    c2  = ap.c2 ;
+    adj = \\a => ap.s ! agr2aagr a ;
+    } ;
+
+  UseCN x a t p cn = useCopula a t p ** {
+    c1  = cn.c1 ;
+    c2  = cn.c2 ;
+    adj = \\a => cn.s ! agr2nagr a ;
+    } ;
+
   ComplV2 x vp np =  vp ** {
     obj1 = \\_ => appCompl True Pos vp.c1 np ;
     } ;
@@ -32,23 +50,12 @@ lin
   PredVP x np vp = vp ** {
     subj : Str = appSubjCase vp.sc np ;
     verb : {fin,inf : Str} = vp.v ! np.a ;
+    adj  : Str = vp.adj ! 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
     } ;
@@ -65,13 +72,59 @@ lin
     focType = FocSubj ;
     subj = [] ;
     verb : {fin,inf : Str} = vp.v ! ipa ;
+    adj  : Str = vp.adj ! ipa ;
     obj1 : Str = vp.obj1 ! ipa ;
     obj2 : Str = vp.obj2 ! ipa ; 
     c3 : Compl = noComplCase ;
     qforms = \\_ => <[],[]> ;
     } ;
 
+  QuestIComp a t p icomp np = 
+    let 
+      vagr = (agr2vagr np.a) 
+    in
+    initPrClause ** {
+      v    = tenseCopula (a.s ++ t.s ++ p.s) t.t a.a p.p vagr ;
+      subj = np.s ! subjCase ;
+      foc = icomp.s ! np.a ;
+      focType = FocObj ;
+      qforms = qformsCopula (a.s ++ t.s ++ p.s) t.t a.a p.p vagr ; 
+    } ;
 
+  RelVP rp vp = 
+    let 
+      cl : Agr -> PrClause = \a -> 
+        let 
+          rpa = rpagr2agr rp.a a ;
+          rnp = {s = rp.s ! (complNumAgr rpa) ; a = rpa ; isPron = False}
+        in
+        vp ** {
+          v    = applyVerb vp (agr2vagr rpa) ;
+          subj : Str = appSubjCase vp.sc rnp ;
+          verb : {fin,inf : Str} = vp.v ! rpa ;
+          adj  : Str = vp.adj ! rpa ;
+          obj1 : Str = vp.obj1 ! rpa ;
+          obj2 : Str = vp.obj2 ! rpa ; 
+          c3   : Compl = noComplCase ;
+        }
+    in {s = \\a => declCl (cl a) ; c = subjCase} ; ---- case
+
+  RelSlash rp cl = {
+      s = \\a => 
+            let 
+               rpa = rpagr2agr rp.a a ;
+               rnp = appCompl True Pos cl.c3 {s = rp.s ! (complNumAgr rpa) ; a = rpa ; isPron = False}
+            in 
+            rnp ++ declCl cl ; 
+      c = objCase ---- case
+      } ;
+
+  NomVPNP vpi = {
+    s = \\c => vpi.s ! vvInfinitive ! defaultAgr ;
+    isNeg = False ; ----
+    isPron = False ; ----
+    a = defaultAgr
+    } ;
 
         UseVPC,StartVPC,ContVPC
 
@@ -80,4 +133,14 @@ lin
        ,PassUseV, AgentPassUseV
            = variants {} ;
 
+---- this will be fun!
+
+  ByVP,       -- tekemällä
+  WhenVP,     -- tehdessä
+  BeforeVP,   -- ennen tekemistä
+  AfterVP,    -- tehtyä
+  InOrderVP,  -- tehdäkseen
+  WithoutVP   -- tekemättä
+           = variants {} ;
+
 }