restored subject case of ExtendFin.VPS following ExtraFin

src/finnish/ExtendFin.gf

@@ -14,6 +14,7 @@ concrete ExtendFin of Extend =
   open
     GrammarFin,
     ResFin,
+    StemFin,
     (S=StemFin),
     IdiomFin,
     Coordination,
@@ -43,21 +44,56 @@ oper
 
 
   lincat
-    VPS   = {s : Agr => Str } ;
+      VPS = {
-    [VPS] = {s1,s2 : Agr => Str } ;
+      s   : Agr  => Str ;
+      sc  : SubjCase ;  --- can be different for diff parts
+      h   : Harmony   --- can be different for diff parts
+      } ;
+
+    [VPS] = {
+      s1,s2 : Agr  => Str ;
+      sc    : SubjCase ;   --- take the first: minä osaan kutoa ja täytyy virkata
+      h     : Harmony    --- take the first: osaanko minä kutoa ja käyn koulua
+      } ;
+
     VPI   = {s : VVType => Agr => Str ; sc : SubjCase } ;     -- Agr needed for possessive suffix:
     [VPI] = {s1,s2 : VVType => Agr => Str ; sc : SubjCase } ; -- e.g. toivon nukkuva+ni
 
   lin
-    BaseVPS = twoTable Agr ;
+    MkVPS t p vp0 = let vp = vp2old_vp vp0 in
-    ConsVPS = consrTable Agr comma ;
+     { --  Temp -> Pol -> VP -> VPS ;
+      s = \\a =>
+        let
+	  agrfin = case vp.sc of {
+                     SCNom => <a,True> ;
+                     _ => <agrP3 Sg,False>      -- minun täytyy, minulla on
+                     } ;
+	  vps = vp.s ! VIFin t.t ! t.a ! p.p ! agrfin.p1
+        in
+        t.s ++ p.s ++
+        vps.fin ++ vps.inf ++
+        vp.s2 ! agrfin.p2 ! p.p ! a ++
+        vp.adv ! p.p ++
+        vp.ext ;
+      sc = vp.sc ;
+      h = vp.h
+      } ;
+      
+    BaseVPS x y = twoTable Agr x y ** {sc = x.sc ; h = x.h} ;
+    ConsVPS x y = consrTable Agr comma x y ** {sc = x.sc ; h = x.h} ;
+
+    ConjVPS conj ss = conjunctDistrTable Agr conj ss ** {
+      sc = ss.sc ; h = ss.h
+      } ;
+
+    PredVPS np vps = { -- NP -> VPS -> S ;
+      s = subjForm np vps.sc Pos ++ vps.s ! np.a
+      } ;
+
 
     BaseVPI = twoTable2 VVType Agr ;
     ConsVPI = consrTable2 VVType Agr comma ;
 
-    MkVPS t p vp = mkVPS t p (lin VP vp) ;
-    ConjVPS c xs = conjunctDistrTable Agr c xs  ;
-    PredVPS np vps = {s = np.s ! NPCase Nom ++ vps.s ! np.a} ;
 
 
     MkVPI vp = mkVPI vp ;
@@ -74,15 +110,15 @@ oper
 
   lincat
     -- Polarity needed to pick the right object case
-    VPS2   = {s : Agr => Str ; c2 : Compl ; p : Polarity } ;
+    VPS2   = {s : Agr => Str ; c2 : Compl ; p : Polarity ; sc : SubjCase ; h : Harmony} ;
-    [VPS2] = {s1,s2 : Agr => Str ; c2 : Compl ; p : Polarity } ;
+    [VPS2] = {s1,s2 : Agr => Str ; c2 : Compl ; p : Polarity ; sc : SubjCase ; h : Harmony} ;
     -- A version with
     VPI2   = {s : VVType => Agr => Str ; c2 : Compl ; sc : SubjCase } ;
     [VPI2] = {s1,s2 : VVType => Agr => Str ; c2 : Compl ; sc : SubjCase } ;
 
   lin
     -- : Temp -> Pol -> VPSlash -> VPS2 ;  -- has loved
-    MkVPS2 t p vpsl = mkVPS t p (lin VP vpsl) ** {c2 = vpsl.c2 ; p = p.p } ;
+    MkVPS2 t p vpsl = mkVPS t p (lin VP vpsl) ** {c2 = vpsl.c2 ; p = p.p} ;
 
     -- : VPSlash -> VPI2 ;                 -- to love
     MkVPI2 vpsl = mkVPI (lin VP vpsl) ** {c2 = vpsl.c2} ;
@@ -94,19 +130,21 @@ oper
     ConsVPI2 x xs = consrTable2 VVType Agr comma x xs ** {c2 = xs.c2} ;
 
 
-    ConjVPS2 c xs = conjunctDistrTable Agr c xs ** {c2 = xs.c2 ; p = xs.p } ;
+    ConjVPS2 c xs = conjunctDistrTable Agr c xs ** {c2 = xs.c2 ; p = xs.p ; sc = xs.sc ; h = xs.h} ;
     ConjVPI2 c xs = conjunctDistrTable2 VVType Agr c xs ** {c2 = xs.c2 ; p = xs.p ; sc = xs.sc } ;
 
 
                             -- appCompl : Bool -> Polarity -> Compl -> ResFin.NP -> Str
-    ComplVPS2 v np = { s = \\agr => v.s ! agr ++ appCompl True v.p v.c2 np } ;
+    ComplVPS2 v np = v ** { s = \\agr => v.s ! agr ++ appCompl True v.p v.c2 np } ;
 
                                               -- TODO: Version with variable polarity?
     ComplVPI2 v np = v ** { s = \\vt,a => v.s ! vt ! a ++ appCompl True Pos v.c2 np };
 
 oper
     mkVPS : Temp -> Pol -> VP -> VPS = \tem,pol,vp -> lin VPS {
-      s = \\agr => (UseCl tem pol (S.mkClause (\_ -> []) agr vp)).s } ;
+      s = \\agr => (UseCl tem pol (S.mkClause (\_ -> []) agr vp)).s ;
+      h = vp.s.h ; sc = vp.s.sc
+      } ;
 
     mkVPI : VP -> VPI = \vp -> lin VPI {
       s = \\vt,agr => S.infVP vp.s.sc Pos agr vp (vvtype2infform vt) ;