some refactoring, and experiments with Fin which is still too big in pgf

lib/src/experimental/LiftFin.gf

@@ -3,32 +3,32 @@ concrete LiftFin of Lift =
   ,PredFin
 
               ** open ResFin, 
+                      StemFin,
                       PredInstanceFin, 
                       Prelude in {
 
 --flags literal=Symb ;
 
-{-
 oper
-  liftV = PredInstanceFin.liftV ;
+  vliftV : SVerb1 -> PrVerb = PredInstanceFin.liftV ;
 
 lin
-  LiftV  v = liftV v ;
+  LiftV  v = vliftV v ;
-  LiftV2 v = <liftV <v : Verb> : PrVerb> ** {c1 = v.c2.s} ;
+  LiftV2 v = vliftV v ** {c1 = v.c2} ;
-  LiftVS v = liftV v ;
+  LiftVS v = vliftV v ;
-  LiftVQ v = liftV v ;
+  LiftVQ v = vliftV v ;
-  LiftVA v = liftV v ; ---- c1?
+  LiftVA v = vliftV v ** {c1 = v.c2} ;
-  LiftVN v = liftV v ; ---- c1?
+  LiftVN v = vliftV v ** {c1 = v.c2} ;
-  LiftVV v = <liftV <v : Verb> : PrVerb> ** {c1 = v.c2.s} ;
+  LiftVV v = vliftV v ** {vvType = v.vi} ;
 
-  LiftV3  v = <liftV <v : Verb> : PrVerb> ** {c1 = v.c2.s ; c2 = v.c3.s} ;
+  LiftV3  v = vliftV v ** {c1 = v.c2 ; c2 = v.c3} ;
-
-  LiftV2S v = <liftV <v : Verb> : PrVerb> ** {c1 = v.c2.s} ;
-  LiftV2Q v = <liftV <v : Verb> : PrVerb> ** {c1 = v.c2.s} ;
-  LiftV2V v = <liftV <v : Verb> : PrVerb> ** {c1 = v.c2.s ; c2 = v.c3.s} ;
-  LiftV2A v = <liftV <v : Verb> : PrVerb> ** {c1 = v.c2.s} ;
-  LiftV2N v = <liftV <v : Verb> : PrVerb> ** {c1 = v.c2.s} ;
 
+  LiftV2S v = vliftV v ** {c1 = v.c2} ;
+  LiftV2Q v = vliftV v ** {c1 = v.c2} ;
+  LiftV2V v = vliftV v ** {c1 = v.c2 ; vvType = v.vi} ;
+  LiftV2A v = vliftV v ** {c1 = v.c2 ; c2 = v.c3} ;
+  LiftV2N v = vliftV v ** {c1 = v.c2 ; c2 = v.c3} ;
+{-
   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
 

lib/src/experimental/NDPredFunctor.gf

@@ -54,7 +54,7 @@ linref
  
   PrCl_none, PrCl_np  = \cl  -> declCl cl ;
   PrQCl_none, PrQCl_np = \qcl -> questCl qcl ;
-  PrAdv_none, PrAdv_np = \adv -> adv.c1 ++ adv.s ;
+  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 ; 
   

lib/src/experimental/PredFin.gf

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

lib/src/experimental/PredFunctor.gf

@@ -25,12 +25,14 @@ lincat
     v   : VAgr => Str ;
     inf : Agr => Str ; 
     c1  : ComplCase ; 
-    c2  : ComplCase
+    c2  : ComplCase ;
+    s1  : Str ; -- storing both in both-and
     } ;
 
   ClC = {
     s  : Str ;
     c3 : ComplCase ;
+    s1 : Str ;
     } ;
 
   PrAdv   = {s : Str ; isAdV : Bool ; c1 : ComplCase} ;
@@ -88,51 +90,20 @@ lin
   aNone, aS, aV, aA, aQ, aN = {s = []} ;
   aNP a = a ;
 
-  UseV x a t p v = {
+  UseV x a t p v = initPrVerbPhraseV a t p v ;
-    v   = \\agr => tenseV (a.s ++ t.s ++ p.s) t.t a.a p.p active agr v ;
-    inf = \\vt => tenseInfV a.s a.a p.p active v vt ;
-    c1  = v.c1 ;
-    c2  = v.c2 ;
-    part = v.p ;
-    adj = noObj ;
-    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 Eng
-    adv = [] ;
-    ext = [] ;
-    qforms = \\agr => qformsV (a.s ++ t.s ++ p.s) t.t a.a p.p agr v ;
-    } ;
 
-  PassUseV x a t p v = {
+  PassUseV x a t p v = initPrVerbPhraseV a t p v ** {
     v   = \\agr => tenseV (a.s ++ t.s ++ p.s) t.t a.a p.p passive agr v ;
     inf = \\vt => tenseInfV a.s a.a p.p passive v vt ;
-    c1  = v.c1 ;
-    c2  = v.c2 ;
-    part = v.p ;
-    adj = noObj ;
-    obj1 = <noObj, defaultAgr> ; ---- not used, just default value
     obj2 = <noObj, True> ; -- becomes subject control even if object control otherwise "*she was promised by us to love ourselves"
-    vvtype = v.vvtype ;
-    adV = negAdV p ;
-    adv = [] ;
-    ext = [] ;
     qforms = \\agr => qformsCopula (a.s ++ t.s ++ p.s) t.t a.a p.p agr ;
     } ;
 
-  AgentPassUseV x a t p v np = {
+  AgentPassUseV x a t p v np = initPrVerbPhraseV a t p v ** {
     v   = \\agr => tenseV (a.s ++ t.s ++ p.s) t.t a.a p.p passive agr v ;
     inf = \\vt => tenseInfV a.s a.a p.p passive v vt ;
-    c1  = v.c1 ;
+    obj2 = <noObj, True> ; -- becomes subject control even if object control otherwise "*she was promised by us to love ourselves"
-    c2  = v.c2 ;
-    part = v.p ;
-    adj = \\a => [] ;
-    obj1 = <noObj, defaultAgr> ; 
-    obj2 = <noObj, True> ;
-    vvtype = v.vvtype ;
-    adV = negAdV p ;
     adv = appComplCase agentCase np ;
-    ext = [] ;
     qforms = \\agr => qformsCopula (a.s ++ t.s ++ p.s) t.t a.a p.p agr ;
     } ;
 
@@ -312,6 +283,7 @@ lin
             infVP v.vvtype a v ++ c.s2 ++ infVP w.vvtype a 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
@@ -329,45 +301,32 @@ lin
             infVP v.vvtype a v ++ "," ++ w.inf ! a ;
     c1 = noComplCase ; ---- w.c1 ? --- the full story is to unify v and w...
     c2 = noComplCase ; ---- w.c2 ? 
+    s1 = w.s1 ;
     } ;
 
-  UseVPC x vpc = { ---- big loss of quality (overgeneration) seems inevitable
+  UseVPC x vpc = initPrVerbPhrase ** { ---- big loss of quality (overgeneration) seems inevitable
-    v   = \\a => <[], [], vpc.v ! a> ;
+    v   = \\a => <[], [], vpc.s1 ++ vpc.v ! a> ;
     inf = \\_ => vpc.inf ! defaultAgr ; ---- agreement
     c1  = vpc.c1 ;
     c2  = vpc.c2 ;
-    part = [] ;
-    adj = \\a => [] ;
-    obj1 = <noObj, defaultAgr> ;
-    obj2 = <noObj,True> ;
-    vvtype = vvInfinitive ; ----
-    adv,adV = [] ;
-    ext = [] ;
     qforms = \\a => <"do", vpc.inf ! defaultAgr> ; ---- do/does/did
     } ;
 
   StartClC x c a b = {
     s  = declCl a ++ c.s2 ++ declCl b ;
     c3 = b.c3 ; ---- 
+    s1 = c.s1 ;
     } ;
 
   ContClC x a b = {
     s  = declCl a ++ "," ++ b.s ;
     c3 = b.c3 ; ---- 
+    s1 = b.s1 ;
     } ;
 
-  UseClC x cl = {
+  UseClC x cl = initPrClause ** {
-    subj = [] ;
+    v    = <[],[], cl.s1 ++ cl.s> ; ----
-    v    = <[],[],cl.s> ; ----
-    inf  = [] ;
-    adj  = [] ;
-    obj1 = [] ;
-    obj2 = [] ;
-    adV  = [] ;
-    adv  = [] ;
-    ext  = [] ;
     c3   = cl.c3 ;
-    qforms = <[],[]> ; ---- qforms
     } ;
 
   ComplAdv x p np = {s = appComplCase p.c1 np ; isAdV = p.isAdV ; c1 = noComplCase} ;

lib/src/experimental/PredInstanceEng.gf

@@ -23,6 +23,8 @@ oper
   active : SVoice = Act ;
   passive : SVoice = Pass ;
 
+  defaultVType : VType = VTAct ;
+
   subjCase : NPCase = NCase Nom ;
   objCase  : NPCase = NPAcc ;
 

lib/src/experimental/PredInstanceFin.gf

@@ -1,5 +1,9 @@
-instance PredInstanceFin of PredInterface - [NounPhrase,PrVerb] = 
+instance PredInstanceFin of 
-  open ResFin, (P = ParadigmsFin), (S = StemFin), (X = ParamX), Prelude in {
+  PredInterface - [
+    NounPhrase,
+    PrVerb, initPrVerb
+  ] = 
+      open ResFin, (P = ParadigmsFin), (S = StemFin), (X = ParamX), Prelude in {
 
 -- overrides
 
@@ -22,7 +26,7 @@ oper
   Case   = ResFin.Case ;
   NPCase = ResFin.NPForm ;
   VForm  = S.SVForm ;
-  VVType = ResFin.InfForm ;
+  VVType = Unit ; ----ResFin.InfForm ;
   VType  = Unit ; ----
   Gender = Unit ; ----
 
@@ -34,6 +38,8 @@ oper
   active = Act ;
   passive = Pass ;
 
+  defaultVType = UUnit ;
+
   subjCase : NPCase = ResFin.NPCase Nom ;
   objCase  : NPCase = NPAcc ;
 
@@ -69,7 +75,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 = UUnit ; ----  vvInfinitive : VVType = Inf1 ;
 
   isRefl : PrVerb -> Bool = \_ -> False ; ----
 
@@ -117,7 +123,7 @@ oper
 
   tenseInfV : Str -> Anteriority -> Polarity -> SVoice -> PrVerb -> VVType -> Str = 
       \sa,a,pol,o,v,vt ->
-   let 
+   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 ;
@@ -139,8 +145,15 @@ oper
 
   not_Str : Polarity -> Str = \p -> case p of {Pos => [] ; Neg => "inte"} ;
 
-  liftV : S.SVerb1 -> PrVerb = \v -> 
+  liftV : S.SVerb1 -> PrVerb = \v -> initPrVerb ** v ;
-    v ** {c1,c2 = noComplCase ; isSubjectControl = False ; vtype = UUnit ; vvtype = vvInfinitive} ; 
+
+  initPrVerb : PrVerb = {
+    s = \\_ => [] ;
+    sc = subjCase ;
+    h = Back ;
+    p = [] ; 
+    c1,c2 = noComplCase ; isSubjectControl = True ; vtype = defaultVType ; vvtype = vvInfinitive
+    } ; 
 
 --- junk
 

lib/src/experimental/PredInstanceSwe.gf

@@ -21,6 +21,8 @@ oper
   active = CommonScand.Act ;
   passive = CommonScand.Pass ;
 
+  defaultVType = VAct ;
+
   subjCase : NPCase = NPNom ;
   objCase  : NPCase = NPAcc ;
 

lib/src/experimental/PredInterface.gf

@@ -41,6 +41,8 @@ oper
   active : SVoice ;
   passive : SVoice ;
 
+  defaultVType : VType ;
+
   subjCase : NPCase ;
   objCase  : NPCase ;
 
@@ -102,6 +104,16 @@ oper
     vvtype : VVType ;
     } ; 
 
+  initPrVerb : PrVerb = {
+    s = \\_ => [] ;
+    p = [] ;
+    c1 = noComplCase ;
+    c2 = noComplCase ;
+    isSubjectControl = True ;
+    vtype = defaultVType ;
+    vvtype = vvInfinitive ;
+    } ;
+
   PrVerbPhrase = {
     v : VAgr => Str * Str * Str ;  -- would,have,slept
     inf : VVType => Str ;          -- (not) ((to)(sleep|have slept) | (sleeping|having slept)
@@ -117,6 +129,37 @@ oper
     ext : Str ;
     qforms : VAgr => Str * Str     -- special Eng for introducing "do" in questions
     } ;
+
+  initPrVerbPhrase : PrVerbPhrase = {
+    v : VAgr => Str * Str * Str  = \\_ => <[],[],[]> ;
+    inf : VVType => Str = \\_ => [] ;
+    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   = \\agr => tenseV (a.s ++ t.s ++ p.s) t.t a.a p.p active agr v ;
+    inf = \\vt => tenseInfV a.s a.a p.p active v vt ;
+    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 Eng
+    qforms = \\agr => qformsV (a.s ++ t.s ++ p.s) t.t a.a p.p agr v ;
+    } ;
  
   PrClause = {
     v : Str * Str * Str ; 
@@ -129,6 +172,15 @@ oper
     qforms : Str * Str
     } ; 
 
+  initPrClause : PrClause = {
+    v : Str * Str * Str = <[],[],[]> ; 
+    adj,obj1,obj2 : Str = [] ; 
+    adv,adV,ext : Str = [] ; 
+    subj : Str = [] ; 
+    c3  : ComplCase = noComplCase ;              -- for a slashed adjunct, not belonging to the verb valency
+    qforms : Str * Str = <[],[]>
+    } ; 
+
   PrQuestionClause = PrClause ** {
     foc : Str ;                   -- the focal position at the beginning: *who* does she love
     focType : FocusType ;         --- if already filled, then use other place: who loves *who*
@@ -170,19 +222,10 @@ oper
   not_Str : Polarity -> Str ;
 
   useCopula : {s : Str ; a : Anteriority} -> {s : Str ; t : STense} -> {s : Str ; p : Polarity} -> PrVerbPhrase =
-    \a,t,p -> {
+    \a,t,p -> initPrVerbPhrase ** {
     v   = \\agr => tenseCopula (a.s ++ t.s ++ p.s) t.t a.a p.p agr ;
     inf = \\vt => tenseInfCopula a.s a.a p.p vt ;
-    c1 = noComplCase ;
-    c2 = noComplCase ;
-    part = [] ;
-    adj = \\_ => [] ;
-    obj1 = <noObj,defaultAgr> ;
-    obj2 = <noObj, True> ; 
-    vvtype = vvInfinitive ;
     adV = negAdV p ;
-    adv = [] ;
-    ext = [] ;
     qforms = \\agr => qformsCopula (a.s ++ t.s ++ p.s) t.t a.a p.p agr ;
     } ;