factored out linrefs to opers in PredInterface

lib/src/experimental/NDPredFunctor.gf

@@ -43,20 +43,12 @@ lincat
 linref
   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
-    = \vp  -> 
+    = linrefPrVP ;
-    let 
+  PrCl_none, PrCl_np  = linrefPrCl ;
-      agr  = defaultAgr ;
+  PrQCl_none, PrQCl_np = linrefPrQCl ;
-      vagr = agr2vagr agr ;
+  PrAdv_none, PrAdv_np = linrefPrAdv ;
-      verb = vp.v ! vagr ;
+----  PrAP_none, PrAP_np  = \ap  -> ap.s ! defaultAgr ++ ap.obj1 ! defaultAgr ;  
-    in
+----  PrCN_none, PrCN_np  = \cn  -> cn.s ! Sg ++ cn.obj1 ! defaultAgr ; 
-    verb.p1 ++ verb.p2 ++ vp.adV ++ verb.p3 ++ vp.part ++ 
-    vp.adj ! agr ++ vp.obj1.p1 ! agr ++ vp.obj2.p1 ! agr ++ vp.adv ++ vp.ext ;
- 
-  PrCl_none, PrCl_np  = \cl  -> declCl cl ;
-  PrQCl_none, PrQCl_np = \qcl -> questCl qcl ;
-  PrAdv_none, PrAdv_np = \adv -> strComplCase adv.c1 ++ adv.s ;
-  PrAP_none, PrAP_np  = \ap  -> ap.s ! defaultAgr ++ ap.obj1 ! defaultAgr ;  
-  PrCN_none, PrCN_np  = \cn  -> cn.s ! Sg ++ cn.obj1 ! defaultAgr ; 
   
 ----------------------------
 --- linearization rules ----

lib/src/experimental/PredFin.gf

@@ -1,18 +1,16 @@
 concrete PredFin of Pred = 
   CatFin [Ant,NP,Utt,IP,IAdv,Conj] ** 
---    PredFunctor [NP,Pol,Tense,Ant,Arg,  PPos, TPres, ASimul, aNone,
+    PredFunctor 
---                 PrV,PrVP,PrCl,PrS,UseV,PredVP,UseCl]
+     - [StartVPC, ContVPC 
--- - [StartVPC, ContVPC, ---- need generalization
+----        ,AgentPassUseV, ComplVA, ComplVN, ComplVV,SlashV2A,SlashV2V,SlashV2N
---                   AgentPassUseV,AgentPastPartAP]     ---- moreover slow
+       ]
-
+    with 
-    PredFunctor - 
-      [StartVPC, ContVPC, AgentPassUseV, ComplVA, ComplVN, ComplVV,SlashV2A,SlashV2V,SlashV2N]
-      with 
       (PredInterface = PredInstanceFin) 
 
   ** {
 
 lin 
-  StartVPC, ContVPC, AgentPassUseV, ComplVA, ComplVN, ComplVV,SlashV2A,SlashV2V,SlashV2N
+  StartVPC, ContVPC
+----  , AgentPassUseV, ComplVA, ComplVN, ComplVV,SlashV2A,SlashV2V,SlashV2N
     = variants {} ; ---- just to make it compile as instance of Pred
 } 

lib/src/experimental/PredFunctor.gf

@@ -35,8 +35,8 @@ lincat
     s1 : Str ;
     } ;
 
-  PrAdv   = {s : Str ; isAdV : Bool ; c1 : ComplCase} ;
+  PrAdv = PrAdverb ;
-  PrS     = {s : Str} ;
+  PrS   = {s : Str} ;
 
   PrAP = {
     s : AAgr => Str ; 
@@ -53,20 +53,10 @@ lincat
 -- reference linearizations for chunking
 
 linref
-  PrVP  = \vp  -> 
+  PrVP  = linrefPrVP ;
-    let 
+  PrCl  = linrefPrCl ;
-      agr  = defaultAgr ;
+  PrQCl = linrefPrQCl ;
-      vagr = agr2vagr agr ;
+  PrAdv = linrefPrAdv ;
-      verb = vp.v ! vagr ;
-    in
-    verb.p1 ++ verb.p2 ++ vp.adV ++ verb.p3 ++ vp.part ++ 
-    vp.adj ! agr ++ vp.obj1.p1 ! agr ++ vp.obj2.p1 ! agr ++ vp.adv ++ vp.ext ;
- 
-  PrCl  = \cl  -> declCl cl ;
-  PrQCl = \qcl -> questCl qcl ;
-  PrAdv = \adv -> strComplCase adv.c1 ++ adv.s ;
-  PrAP  = \ap  -> ap.s ! defaultAgr ++ ap.obj1 ! defaultAgr ;  
-  PrCN  = \cn  -> cn.s ! Sg ++ cn.obj1 ! defaultAgr ; 
   
 ----------------------------
 --- linearization rules ----

lib/src/experimental/PredInstanceFin.gf

@@ -1,7 +1,8 @@
 instance PredInstanceFin of 
   PredInterface - [
     NounPhrase,
-    PrVerb, initPrVerb
+    PrVerb, initPrVerb,
+    PrVerbPhrase, initPrVerbPhrase, initPrVerbPhraseV, useCopula
   ] = 
       open ResFin, (P = ParadigmsFin), (S = StemFin), (X = ParamX), Prelude in {
 
@@ -9,6 +10,7 @@ instance PredInstanceFin of
 
 oper
   NounPhrase = ResFin.NP ;
+
   PrVerb = StemFin.SVerb1 ** {
     c1 : ComplCase ; 
     c2 : ComplCase ;
@@ -17,6 +19,66 @@ oper
     vvtype : VVType ;
     } ; 
 
+  initPrVerb : PrVerb = {
+    s = \\_ => [] ;
+    sc = subjCase ;
+    h = Back ;
+    p = [] ; 
+    c1,c2 = noComplCase ; isSubjectControl = True ; vtype = defaultVType ; 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 
+    } ;
+
+  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 = [] ; 
+    adV : Str = [] ;
+    ext : Str = [] ;
+    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 = <case isRefl v of {True => \\a => reflPron a ; _ => \\_ => []}, defaultAgr> ; ---- not used, just default value
+    obj2 = <noObj, v.isSubjectControl> ;
+    vvtype = v.vvtype ;
+    adV = negAdV p ; --- just p.s in Fin
+    } ;
+
+  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) ;
+
+
 ---------------------
 -- parameters -------
 ---------------------
@@ -26,8 +88,8 @@ oper
   Case   = ResFin.Case ;
   NPCase = ResFin.NPForm ;
   VForm  = S.SVForm ;
-  VVType = Unit ; ----ResFin.InfForm ;
+  VVType = ResFin.InfForm ;
-  VType  = Unit ; ----
+  VType  = Voice ; ----
   Gender = Unit ; ----
 
   VAgr   = Agr ;
@@ -38,7 +100,7 @@ oper
   active = Act ;
   passive = Pass ;
 
-  defaultVType = UUnit ;
+  defaultVType = Act ;
 
   subjCase : NPCase = ResFin.NPCase Nom ;
   objCase  : NPCase = NPAcc ;
@@ -75,7 +137,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 = UUnit ; ----  vvInfinitive : VVType = Inf1 ;
+  vvInfinitive : VVType = Inf1 ;
 
   isRefl : PrVerb -> Bool = \_ -> False ; ----
 
@@ -87,16 +149,23 @@ oper
 oper 
   reflPron : Agr -> Str = \a -> (ResFin.reflPron a).s ! NPAcc ; ---- case
 
-  infVP : VVType -> Agr -> PrVerbPhrase -> Str = \vt, a,vp -> 
+  infVP : VVType -> Agr -> PrVerbPhrase -> Str = \vt, a, pvp -> 
-    let 
+    let
-      a2 = case vp.obj2.p2 of {True => a ; False => vp.obj1.p2} 
+      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}} ;
+        }
     in
-      vp.adV ++ vp.inf ! vt ++ 
+    S.infVPGen -- : Polarity -> NPForm -> Polarity -> Agr -> VP -> InfForm -> Str =
-      vp.adj ! a ++ vp.obj1.p1 ! a ++ vp.obj2.p1 ! a2 ++ vp.adv ++ vp.ext ;
+        ipol sc pol agr vp0 vi ;
-
-  qformsV : Str -> STense -> Anteriority -> Polarity -> VAgr -> PrVerb -> Str * Str = 
-    \sta,t,a,p,agr,v -> <[],[]> ; ----- not needed in Finnish
- 
 
   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 ;
@@ -147,14 +216,6 @@ oper
 
   liftV : S.SVerb1 -> PrVerb = \v -> initPrVerb ** v ;
 
-  initPrVerb : PrVerb = {
-    s = \\_ => [] ;
-    sc = subjCase ;
-    h = Back ;
-    p = [] ; 
-    c1,c2 = noComplCase ; isSubjectControl = True ; vtype = defaultVType ; vvtype = vvInfinitive
-    } ; 
-
 --- junk
 
   qformsV : Str -> STense -> Anteriority -> Polarity -> VAgr -> PrVerb -> Str * Str = 
@@ -162,5 +223,4 @@ oper
   qformsCopula : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str = 
     \sta,t,a,p,agr -> <[],[]> ;
 
-
 }

lib/src/experimental/PredInterface.gf

@@ -186,6 +186,24 @@ oper
     focType : FocusType ;         --- if already filled, then use other place: who loves *who*
     } ; 
 
+  PrAdverb = {s : Str ; isAdV : Bool ; c1 : ComplCase} ;
+
+  linrefPrVP : PrVerbPhrase -> Str = \vp  -> 
+    let 
+      agr  = defaultAgr ;
+      vagr = agr2vagr agr ;
+      verb = vp.v ! vagr ;
+    in
+    verb.p1 ++ verb.p2 ++ vp.adV ++ verb.p3 ++ vp.part ++ 
+    vp.adj ! agr ++ vp.obj1.p1 ! agr ++ vp.obj2.p1 ! agr ++ vp.adv ++ vp.ext ;
+ 
+  linrefPrCl : PrClause -> Str = \cl  -> declCl cl ;
+  linrefPrQCl : PrQuestionClause -> Str = \qcl -> questCl qcl ;
+  linrefPrAdv : PrAdverb -> Str = \adv -> strComplCase adv.c1 ++ adv.s ;
+----  linrefPrAP  = \ap  -> ap.s ! defaultAgr ++ ap.obj1 ! defaultAgr ;  
+----  linrefPrCN  = \cn  -> cn.s ! Sg ++ cn.obj1 ! defaultAgr ; 
+
+
 ---------------------------
 ---- concrete syntax opers
 ---------------------------