VPS,VPI in ExtendGer

src/german/ExtendGer.gf

@@ -2,7 +2,12 @@
 
 concrete ExtendGer of Extend =
   CatGer ** ExtendFunctor
-   - [InOrderToVP]
+   - [
+    InOrderToVP,
+    VPS, ListVPS, VPI, ListVPI,
+    MkVPS, BaseVPS, ConsVPS, ConjVPS, PredVPS, 
+    MkVPI, BaseVPI, ConsVPI, ConjVPI, ComplVPIVV
+    ]
   with
     (Grammar = GrammarGer) **
   open
@@ -12,8 +17,93 @@ concrete ExtendGer of Extend =
     Prelude,
     ParadigmsGer in {
 
+  lincat
+    VPI   = {s : Bool => Str} ;
+    [VPI] = {s1,s2 : Bool => Str} ;
+    VPS   = {s : Order => Agr => Str} ;
+    [VPS] = {s1,s2 : Order => Agr => Str} ;
+
 lin
 
   InOrderToVP vp = {s = "um" ++ useInfVP False vp} ;
 
+    BaseVPI = twoTable Bool ;
+    ConsVPI = consrTable Bool comma ;
+
+    MkVPI vp = {s = \\b => useInfVP b vp} ;
+    ConjVPI = conjunctDistrTable Bool ;
+
+    ComplVPIVV v vpi = 
+--        insertInf (vpi.s ! v.isAux) (
+      insertInf {s=(vpi.s ! v.isAux);isAux=v.isAux;ctrl=SubjC} ( -- HL ??
+            predVGen v.isAux v) ; ----
+
+    BaseVPS = twoTable2 Order Agr ;
+    ConsVPS = consrTable2 Order Agr comma ;
+
+    PredVPS np vpi = 
+      let
+        subj = np.s ! NPC Nom ++ bigNP np ;
+        agr  = np.a ;
+      in {
+        s = \\o => 
+          let verb = vpi.s ! o ! agr 
+          in case o of {
+            Main => subj ++ verb ;
+            Inv  => verb ++ subj ;   ---- älskar henne och sover jag
+            Sub  => subj ++ verb 
+            }
+        } ;
+
+    MkVPS tm p vp = 
+      let vps = useVP vp in {
+        s = \\o,agr => 
+         let 
+          ord   = case o of {
+            Sub => True ;  -- glue prefix to verb
+            _ => False
+            } ;
+          b = p.p ;
+          a = tm.a ;
+          t = tm.t ;
+          m = tm.m ;
+          subj  = [] ;
+          verb  = vps.s  ! ord ! agr ! VPFinite m t a ;
+          neg   = tm.s ++ p.s ++ vp.a1 ++ negation ! b ; -- HL 8/19 ++ vp.a1 ! b ;
+          -- obj1  = (vp.nn ! agr).p1 ;
+          -- obj   = (vp.nn ! agr).p2 ; 
+          -- compl = obj1 ++ neg ++ obj ++ vp.a2 ; -- from EG 15/5
+          obj1  = (vp.nn ! agr).p1 ++ (vp.nn ! agr).p2 ; -- refl ++ pronouns ++ nonpronouns
+          obj2  = (vp.nn ! agr).p3 ;                     -- pp-objects
+          obj3  = (vp.nn ! agr).p4 ++ vp.adj ++ vp.a2 ;  -- pred.AP|CN|Adv, via useComp HL 6/2019
+          compl = obj1 ++ neg ++ obj2 ++ obj3 ;
+          inf   = vp.inf.s ++ verb.inf ++ verb.inf2 ;
+          extra = vp.ext ;
+          infE : Str =                              -- HL 30/6/2019
+            case <t,a,vp.isAux> of {
+              <Fut|Cond,Simul,True> => inf ;                           --# notpresent
+              <Fut|Cond,Anter,True> -- Duden 318: kommen wollen haben => haben kommen wollen --# notpresent
+                => verb.inf2 ++ vp.inf.s ++ verb.inf ;                   --# notpresent
+              <_,Anter,True> => inf ;                                  --# notpresent
+              _ => verb.inf ++ verb.inf2 ++ vp.inf.s } ;
+          inffin : Str =
+            case <t,a,vp.isAux> of {
+	           <Fut|Cond,Anter,True>  -- ... wird|würde haben kommen wollen --# notpresent
+                     => verb.fin ++ verb.inf2 ++ vp.inf.s ++ verb.inf ;  --# notpresent
+	           <_,Anter,True>                                      --# notpresent
+                     => verb.fin ++ inf ;            -- double inf     --# notpresent
+                   _ => inf ++ verb.fin              --- or just auxiliary vp
+            } ;
+        in
+        case o of {
+	    Main => subj ++ verb.fin ++ compl ++ vp.infExt ++ infE ++ extra ;
+	    Inv  => verb.fin ++ subj ++ compl ++ vp.infExt ++ infE ++ extra ;
+	    Sub  => subj ++ compl ++ vp.infExt ++ inffin ++ extra
+          }
+    } ;
+
+    ConjVPS = conjunctDistrTable2 Order Agr ;
+    
+
+
 }