From ccf7ba85109fa3ceb7e6aa1916268180356d33f0 Mon Sep 17 00:00:00 2001
From: aarne <aarne@chalmers.se>
Date: Sun, 27 May 2012 19:36:04 +0000
Subject: [PATCH] VPS in Dut

---
 lib/src/dutch/ExtraDut.gf    | 72 ++++++++++++++++++++++++++++++++++++
 lib/src/dutch/ExtraDutAbs.gf |  2 +
 2 files changed, 74 insertions(+)

diff --git a/lib/src/dutch/ExtraDut.gf b/lib/src/dutch/ExtraDut.gf
index 9ddb2090c..579da2f47 100644
--- a/lib/src/dutch/ExtraDut.gf
+++ b/lib/src/dutch/ExtraDut.gf
@@ -41,4 +41,76 @@ lin
 
     IAdvAdv adv = {s = "hoe" ++ adv.s} ;
 
+  lincat
+    VPS   = {s : Order => Agr => Str} ;
+    [VPS] = {s1,s2 : Order => Agr => Str} ;
+
+  lin
+    BaseVPS = twoTable2 Order Agr ;
+    ConsVPS = consrTable2 Order Agr comma ;
+
+    PredVPS np vpi = 
+      let
+        subj = np.s ! NPNom ;
+        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 = {
+      s = \\o,agr =>
+        let
+          ord   = case o of {
+            Sub => True ;  -- glue prefix to verb
+            _ => False
+            } ;
+          subj = [] ;
+          t = tm.t ;
+          a = tm.a ;
+          b = p.p ;
+          vform = vForm t agr.g agr.n agr.p o ;
+          auxv = (auxVerb vp.s.aux).s ;
+          vperf = vp.s.s ! VPerf ;
+          verb : Str * Str = case <t,a> of {
+            <Fut|Cond,Simul>  => <zullen_V.s ! vform, vp.s.s ! VInf> ; --# notpresent
+            <Fut|Cond,Anter>  => <zullen_V.s ! vform, vperf ++ auxv ! VInf> ; --# notpresent
+            <_,       Anter>  => <auxv ! vform,       vperf> ; --# notpresent
+            <_,       Simul>  => <vp.s.s ! vform,     []>
+            } ;
+          fin   = verb.p1 ;
+          neg   = vp.a1 ! b ;
+          obj0  = vp.n0 ! agr ;
+          obj   = vp.n2 ! agr ;
+          compl = obj0 ++ neg ++ obj ++ vp.a2 ++ vp.s.prefix ;
+          inf   = 
+            case <vp.isAux, vp.inf.p2, a> of {                  --# notpresent
+              <True,True,Anter> => vp.s.s ! VInf ++ vp.inf.p1 ; --# notpresent
+              _ =>                                              --# notpresent
+                 vp.inf.p1 ++ verb.p2
+              }                                                 --# notpresent
+              ;
+          extra = vp.ext ;
+          inffin = 
+            case <a,vp.isAux> of {                              --# notpresent
+              <Anter,True> => fin ++ inf ; -- double inf   --# notpresent
+              _ =>                                              --# notpresent
+              inf ++ fin              --- or just auxiliary vp
+            }                                                   --# notpresent
+        in
+        tm.s ++ p.s ++
+        case o of {
+          Main => subj ++ fin ++ compl ++ inf ++ extra ;
+          Inv  => fin ++ subj ++ compl ++ inf ++ extra ;
+          Sub  => subj ++ compl ++ inffin ++ extra
+          }
+    } ;
+
+    ConjVPS = conjunctDistrTable2 Order Agr ;
+
 }
diff --git a/lib/src/dutch/ExtraDutAbs.gf b/lib/src/dutch/ExtraDutAbs.gf
index 547e80276..b7f94f673 100644
--- a/lib/src/dutch/ExtraDutAbs.gf
+++ b/lib/src/dutch/ExtraDutAbs.gf
@@ -1,5 +1,7 @@
 abstract ExtraDutAbs = Extra [
   VPI,ListVPI,BaseVPI,ConsVPI,MkVPI,ComplVPIVV,ConjVPI,
+  VPS,ListVPS,BaseVPS,ConsVPS,ConjVPS,MkVPS,PredVPS,
+  Temp,Pol,S,NP,
   VV,VP,Conj,IComp,ICompAP,IAdvAdv,Adv,AP,IAdv] ** 
 {
 --{