ported (most of) the new structures to PredFin

lib/src/experimental/NDPredFin.gf

@@ -1,5 +1,5 @@
 concrete NDPredFin of Pred = 
-  CatFin [Ant,NP,Utt,IP,IAdv,Conj] ** 
+  CatFin [Ant,NP,Utt,IP,IAdv,IComp,Conj,RS,RP] ** 
     NDPredFunctor 
      with 
       (PredInterface = PredInstanceFin),

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 --
+-- overridden
-       ,UseCN --
+       ,UseV
-       ,UseAP --       
+       ,UseAP
-       ,QuestVP --
+       ,UseCN
-       ,PredVP --
+       ,QuestVP
-       ,ComplV2 --
+       ,PredVP
-       ,ReflVP2,ReflVP --
+       ,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 {} ;
+
 }

lib/src/experimental/PredInstanceFin.gf

@@ -29,6 +29,8 @@ oper
   PrVerbPhrase = {
     v   : Agr => {fin,inf : Str} ;
     inf : VVType => Str ;
+    imp : ImpType => Str ;
+    adj : Agr => 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
@@ -47,6 +49,8 @@ oper
   initPrVerbPhrase : PrVerbPhrase = {
     v : Agr => {fin,inf : Str} = \\_ => {fin,inf = []} ;
     inf : VVType => Str = \\vtt => [] ;
+    imp : ImpType => Str = \\_ => [] ;
+    adj : Agr => Str = \\_ => [] ;
     obj1 : Agr => Str = \\_ => [] ;
     obj2 : Agr => Str = \\_ => [] ;
     adv : Str = [] ;
@@ -70,7 +74,9 @@ 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 => infV (a.s ++ p.s) a.a p.p Act (lin PrV verb) vtt ;
+    inf : VVType => 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 = \\_ => [] ;
     obj2 : Agr => Str = \\_ => [] ;
     adv : Str = [] ;
@@ -93,6 +99,7 @@ oper
   PrClause = {
     subj : Str ;
     verb : {fin,inf : Str} ;
+    adj  : Str ;
     obj1 : Str ; 
     obj2 : Str ; 
     adv  : Str ;
@@ -104,6 +111,7 @@ oper
   initPrClause : PrClause = {
     subj : Str = [] ;
     verb : {fin,inf : Str} = {fin,inf = []} ;
+    adj  : Str = [] ; 
     obj1 : Str = [] ; 
     obj2 : Str = [] ; 
     adv  : Str = [] ;
@@ -149,8 +157,13 @@ oper
 
   noObj : Agr => Str = \\_ => [] ;
 
+  RPCase = NPCase ; 
+  subjRPCase : Agr -> RPCase = \a -> subjCase ;
+
   NAgr = Number ; 
   IPAgr = Number ; --- two separate fields in RGL
+  RPAgr = ResFin.RAgr ;
+  ICAgr = Agr ;
 
   defaultAgr : Agr = Ag Sg P3 ;
 
@@ -161,11 +174,18 @@ oper
 
   agr2nagr : Agr -> NAgr = \a -> case a of {Ag n _ => n ; AgPol => Sg} ; -- minä olen pomo / te olette pomoja / te olette pomo
 
+  agr2icagr : Agr -> ICAgr = \a -> a ;
+
 -- restoring full Agr
   ipagr2agr : IPAgr -> Agr = \a -> Ag a P3 ;
 
   ipagr2vagr : IPAgr -> VAgr = \n -> Ag n P3 ;
 
+  rpagr2agr : RPAgr -> Agr -> Agr = \ra,a -> case ra of {
+    RAg ag => ag ;
+    RNoAg => a
+    } ;
+
 --- this is only needed in VPC formation
   vagr2agr : VAgr -> Agr = \a -> a ;
 
@@ -199,17 +219,38 @@ oper
    in
    sa ++ ovps.fin ++ ovps.inf ;
 
+  tenseInfV : Str -> Anteriority -> Polarity -> SVoice -> PrVerb -> VVType -> Str = infV ;
+{-
+      \sa,a,pol,o,v,vt ->
+   let vt = Inf1 ; ----
+     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 ;
+-}
+
   infVP : VVType -> Agr -> PrVerbPhrase -> Str = \vvt,agr,vp ->
-    vp.inf ! vvt ++ vp.adV ++ vp.obj1 ! agr ++ vp.obj2 ! agr ++ vp.adv ++ vp.ext ;
+    vp.inf ! vvt ++ vp.adV ++ vp.adj ! agr ++ vp.obj1 ! agr ++ vp.obj2 ! agr ++ vp.adv ++ vp.ext ;
+
+  impVP : Number -> PrVerbPhrase -> Str = \n,vp ->
+    let agr = Ag n P2 in
+    vp.imp ! n ++ vp.adV ++ vp.adj ! agr ++ 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 ;
+    cl.subj ++ cl.verb.fin ++ cl.adV ++ cl.verb.inf ++ cl.adj ++ cl.obj1 ++ cl.obj2 ++ cl.adv ++ cl.ext ;
 
   declSubordCl : PrClause -> Str = declCl ;
   declInvCl    : PrClause -> Str = declCl ; ---
 
-  questCl      : PrQuestionClause -> Str = \cl -> 
+  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 ;
+    let 
+      ko = case cl.h of {Back => "ko" ; Front => "kö"} 
+    in
+    case cl.focType of { 
+      NoFoc => cl.verb.fin ++ Predef.BIND ++ ko ++ 
+               cl.subj ++ cl.adV ++ cl.verb.inf ++ cl.adj ++ cl.obj1 ++ cl.obj2 ++ cl.adv ++ cl.ext ;
+      _     => cl.foc ++ cl.verb.fin ++ 
+               cl.subj ++ cl.adV ++ cl.verb.inf ++ cl.adj ++ cl.obj1 ++ cl.obj2 ++ cl.adv ++ cl.ext
+      } ;
 
   questSubordCl : PrQuestionClause -> Str = questCl ;
 
@@ -228,17 +269,18 @@ oper
    in
    <sta ++ ovps.fin, ovps.inf, []> ;
 
-  tenseInfV : Str -> Anteriority -> Polarity -> SVoice -> PrVerb -> VVType -> Str = 
+  imperativeV : Str -> Polarity -> ImpType -> PrVerb -> Str = \s,p,it,v ->    
-      \sa,a,pol,o,v,vt ->
+    let 
-   let vt = Inf1 ; ----
+        ovps = (S.vp2old_vp (S.predV v)).s ! VIImper ! Simul ! p ! Ag it P2 ; 
-     ovps = (S.vp2old_vp (S.predV v)).s ! VIInf vt ! a ! pol ! defaultAgr ; -- VIForm => Anteriority => Polarity => Agr => {fin, inf : Str} ;
+    in
-   in
+    s ++ ovps.fin ++ ovps.inf ;
-   sa ++ ovps.fin ++ ovps.inf ;
 
   tenseCopula : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str * Str =
     \s,t,a,p,agr -> tenseV s t a p Act agr (liftV P.olla_V) ;
   tenseInfCopula : Str -> Anteriority -> Polarity -> VVType -> Str =
     \s,a,p,vt -> tenseInfV s a p Act (liftV P.olla_V) vt ;
+  tenseImpCopula : Str -> Polarity -> ImpType -> Str =
+    \s,p,it -> imperativeV s p it (liftV P.olla_V) ;
 
   noObj : Agr => Str = \\_ => [] ;
 

lib/src/experimental/RGLBaseFin.gf

@@ -9,7 +9,7 @@ concrete RGLBaseFin of RGLBase =
   AdverbFin,
   PhraseFin,
 ----  Sentence,
-----  Question,
+  QuestionFin - [QuestCl,QuestVP,QuestSlash,QuestIAdv,QuestIComp],
   RelativeFin - [RelCl,RelVP,RelSlash],
 ----  Idiom [NP, VP, Cl, Tense, ProgrVP, ExistNP, SelfAdvVP, SelfAdVVP, SelfNP], ---- why only these?