Merge pull request #367 from inariksit/new-VPS2-extend

(Extend) New constructions: N2/A2 -> VPSlash, Eng linearisation of QuestVPS

src/abstract/Extend.gf

@@ -69,6 +69,7 @@ abstract Extend = Cat ** {
     MkVPS2    : Temp -> Pol -> VPSlash -> VPS2 ;  -- has loved
     ConjVPS2  : Conj -> [VPS2] -> VPS2 ;          -- has loved and now hates
     ComplVPS2 : VPS2 -> NP -> VPS ;               -- has loved and now hates that person
+    ReflVPS2  : VPS2 -> RNP -> VPS ;              -- have loved and now hate myself and my car
 
     MkVPI2    : VPSlash -> VPI2 ;                 -- to love
     ConjVPI2  : Conj -> [VPI2] -> VPI2 ;          -- to love and hate
@@ -124,6 +125,11 @@ abstract Extend = Cat ** {
 
     ProgrVPSlash : VPSlash -> VPSlash;
 
+-- construct VPSlash from A2 and N2
+
+    A2VPSlash : A2 -> VPSlash ; -- is married to (that person)
+    N2VPSlash : N2 -> VPSlash ; -- is a mother of (that person)
+
 -- existential for mathematics
 
     ExistsNP : NP -> Cl ;  -- there exists a number / there exist numbers
@@ -134,7 +140,7 @@ abstract Extend = Cat ** {
     ExistMassCN   : CN -> Cl ;  -- there is beer / there is no beer
     ExistPluralCN : CN -> Cl ;  -- there are trees / there are no trees
 
--- generalisation of existential, with adverb as a parameter
+-- generalisation of existential, with adverb as an argument
     AdvIsNP : Adv -> NP -> Cl ;  -- here is the tree / here are the trees
     AdvIsNPAP : Adv -> NP -> AP -> Cl ; -- here are the instructions documented
 

src/common/ExtendFunctor.gf

@@ -32,6 +32,7 @@ lin
   MkVPS2 = variants {} ;     --     : Temp -> Pol -> VPSlash -> VPS2 ;  -- has loved
   ConjVPS2 = variants {} ;     --   : Conj -> [VPS2] -> VPS2 ;          -- has loved and now hates
   ComplVPS2 = variants {} ;     --  : VPS2 -> NP -> VPS ;               -- has loved and now hates that person
+  ReflVPS2 = variants {} ;      --  : VPS2 -> RNP -> VPS ;              -- have loved and now hate myself and my car
   MkVPI2 = variants {} ;     --     : Ant  -> Pol -> VPSlash -> VPI2 ;  -- to have loved
   ConjVPI2 = variants {} ;     --   : Conj -> [VPI2] -> VPI2 ;          -- to love and have hated
   ComplVPI2 = variants {} ;     --  : VPI2 -> NP -> VPI ;               -- to love and hate that person
@@ -51,6 +52,8 @@ lin
   PastPartAgentAP = variants {} ;     -- VPSlash -> NP -> AP ; -- (opportunity) lost by the company
   NominalizeVPSlashNP = variants {} ;     -- VPSlash -> NP -> NP ;
   ProgrVPSlash = variants {} ;            -- VPSlash -> VPSlash ;
+  A2VPSlash = variants {} ;           -- A2 -> VPSlash ;
+  N2VPSlash = variants {} ;           -- N2 -> VPSlash ;
   ExistsNP = ExistNP ;     -- NP -> Cl ; -- there exists a number / there exist numbers
   ExistCN cn = ExistNP (DetCN (DetQuant IndefArt NumSg) cn) ;
   ExistMassCN cn = ExistNP (MassNP cn) ;

src/english/ExtendEng.gf

@@ -5,18 +5,19 @@ concrete ExtendEng of Extend =
   [
     VPS, ListVPS, VPI, ListVPI, VPS2, ListVPS2, VPI2, ListVPI2, RNP, RNPList,
     AdAdV, AdjAsCN, AdjAsNP, ApposNP, AdvIsNP,
-    BaseVPS, ConsVPS, BaseVPI, ConsVPI, BaseVPS2, ConsVPS2, BaseVPI2, ConsVPI2,
+    MkVPS, BaseVPS, ConsVPS, ConjVPS, PredVPS, QuestVPS, SQuestVPS,
-    MkVPS, ConjVPS, PredVPS, MkVPI, ConjVPI, ComplVPIVV,
+    MkVPI, BaseVPI, ConsVPI, ConjVPI, ComplVPIVV,
-    MkVPS2, ConjVPS2, ComplVPS2, MkVPI2, ConjVPI2, ComplVPI2,
+    MkVPS2, BaseVPS2, ConsVPS2, ConjVPS2, ComplVPS2, ReflVPS2,
+    MkVPI2, BaseVPI2, ConsVPI2, ConjVPI2, ComplVPI2,
     Base_nr_RNP, Base_rn_RNP, Base_rr_RNP, ByVP, CompBareCN,
     CompIQuant, CompQS, CompS, CompVP, ComplBareVS, ComplGenVV, ComplSlashPartLast, ComplVPSVV, CompoundAP,
-    CompoundN, ConjRNP, ConjVPS, ConsVPS, Cons_nr_RNP, Cons_rr_RNP, DetNPMasc, DetNPFem, EmbedPresPart, EmptyRelSlash,
+    CompoundN, ConjRNP, Cons_nr_RNP, Cons_rr_RNP, DetNPMasc, DetNPFem, EmbedPresPart, EmptyRelSlash,
     ExistsNP, ExistCN, ExistMassCN, ExistPluralCN,
     FocusAP, FocusAdV, FocusAdv, FocusObj, GenIP, GenModIP, GenModNP, GenNP, GenRP,
-    GerundAdv, GerundCN, GerundNP, IAdvAdv, ICompAP, InOrderToVP, MkVPS, NominalizeVPSlashNP,
+    GerundAdv, GerundCN, GerundNP, IAdvAdv, ICompAP, InOrderToVP, NominalizeVPSlashNP,
-    PassAgentVPSlash, PassVPSlash, ProgrVPSlash, PastPartAP, PastPartAgentAP, PositAdVAdj, PredVPS, PredVPSVV, PredetRNP, PrepCN,
+    PassAgentVPSlash, PassVPSlash, ProgrVPSlash, PastPartAP, PastPartAgentAP, PositAdVAdj,  PredVPSVV, PredetRNP, PrepCN,
     EmbedSSlash, PredIAdvVP, PresPartAP, PurposeVP, ReflPoss, ReflPron, ReflRNP, SlashBareV2S, SlashV2V, StrandQuestSlash, StrandRelSlash,
-    UncontractedNeg, UttAccIP, UttAccNP, UttAdV, UttDatIP, UttDatNP, UttVPShort, WithoutVP, BaseVPS2, ConsVPS2, ConjVPS2, ComplVPS2, MkVPS2
+    UncontractedNeg, UttAccIP, UttAccNP, UttAdV, UttDatIP, UttDatNP, UttVPShort, WithoutVP, A2VPSlash, N2VPSlash
    ]
   with
     (Grammar = GrammarEng) **
@@ -69,21 +70,63 @@ concrete ExtendEng of Extend =
       } ;
 
   lincat
-    VPS   = {s : Agr => Str} ;
+    VPS   = {s : Order => Agr => {fin, inf : Str}} ;
-    [VPS] = {s1,s2 : Agr => Str} ;
+    [VPS] = {s1,s2 : Order => Agr => Str ; fin : Order => Agr => Str} ;
     VPI   = {s : VVType => Agr => Str} ;
     [VPI] = {s1,s2 : VVType => Agr => Str} ;
 
   lin
-    BaseVPS = twoTable Agr ;
+    BaseVPS x y =
-    ConsVPS = consrTable Agr comma ;
+      let baseX : OneFinVPS = baseVPS x ;
+          baseY : OneFinVPS = baseVPS y ;
+       in twoTable2 Order Agr baseX baseY ** {fin = baseX.fin} ;
 
+    ConsVPS x xs =
+      let baseX : OneFinVPS = baseVPS x ;
+       in consrTable2 Order Agr comma baseX xs ** {fin = baseX.fin} ; -- keep only the first fin
+  oper
+    {- IL 03/2021 for VPS conjunction: separate the first finite verb for questions
+           [do]:fin (you) [eat bread and sleep?]:inf
+           (you) [  ]:fin [eat bread and sleep]:inf
+       The fin field becomes empty for ODir, but no problem: order is just subj++fin++inf.
+       Weird results for CompNP/AP/…, but coordination of those already covered in RGL. -}
+    OneFinVPS : Type = {s : Order => Agr => Str ; fin : Order => Agr => Str} ;
+    baseVPS : VPS -> OneFinVPS = \vps -> {
+      s = \\o,a => let vp = vps.s ! o ! a in
+        case o of {
+          OQuest => vp.inf ;
+          ODir _ => vp.fin ++ vp.inf
+        } ;
+      fin = \\o,a => let vp = vps.s ! o ! a in
+        case o of {
+          OQuest => vp.fin ;
+          ODir _ => []
+        }
+      } ;
+
+  lin
     BaseVPI = twoTable2 VVType Agr ;
     ConsVPI = consrTable2 VVType Agr comma ;
 
     MkVPS t p vp = mkVPS (lin Temp t) (lin Pol p) (lin VP vp) ;
-    ConjVPS c xs = conjunctDistrTable Agr c xs ;
+    ConjVPS c xs = {
-    PredVPS np vps = {s = np.s ! npNom ++ vps.s ! np.a} ;
+      s = \\o,a => {
+        fin = xs.fin ! o ! a ;
+        inf = c.s1 ++ xs.s1 ! o ! a ++ c.s2 ++ xs.s2 ! o ! a}
+      } ;
+    PredVPS np vps = let vp = vps.s ! oDir ! np.a in {
+      s = np.s ! npNom ++ vp.fin ++ vp.inf
+      } ;
+    SQuestVPS np vps = let
+      vp = vps.s ! OQuest ! np.a ;
+      vpindir = vps.s ! oDir ! np.a in {
+      s = table {
+        QDir => vp.fin ++ np.s ! npNom ++ vp.inf ;
+        QIndir => "if" ++ np.s ! npNom ++ vpindir.fin ++ vpindir.inf}
+      } ;
+    QuestVPS ip vps = let vp = vps.s ! oDir ! toAgr ip.n P3 Neutr  in {
+      s = \\q => ip.s ! npNom ++ vp.fin ++ vp.inf
+      } ;
 
 
     MkVPI vp = mkVPI (lin VP vp) ;
@@ -94,8 +137,11 @@ concrete ExtendEng of Extend =
 -------- two-place verb conjunction
 
   lincat
-    VPS2   = {s : Agr => Str ; c2 : Str} ;
+    VPS2   = {s : Order => Agr => {fin,inf : Str} ; c2 : Str} ;
-    [VPS2] = {s1,s2 : Agr => Str ; c2 : Str} ;
+    [VPS2] = {
+      fin : Order => Agr => Str ;   -- Q: do         ; DIR:
+      s1,s2 : Order => Agr => Str ; -- Q: eat, drink ; DIR: eat, drink
+      c2 : Str} ;
     VPI2   = {s : VVType => Agr => Str ; c2 : Str} ;
     [VPI2] = {s1,s2 : VVType => Agr => Str ; c2 : Str} ;
 
@@ -103,33 +149,40 @@ concrete ExtendEng of Extend =
     MkVPS2 t p vpsl = mkVPS (lin Temp t) (lin Pol p) (lin VP vpsl) ** {c2 = vpsl.c2} ;
     MkVPI2 vpsl = mkVPI (lin VP vpsl) ** {c2 = vpsl.c2} ;
 
-    BaseVPS2 x y = twoTable Agr x y ** {c2 = y.c2} ; ---- just remembering the prep of the latter verb
+    BaseVPS2 x y = BaseVPS x y ** {c2 = y.c2} ; ---- just remembering the prep of the latter verb
-    ConsVPS2 x xs = consrTable Agr comma x xs ** {c2 = xs.c2} ;
+    ConsVPS2 x xs = ConsVPS x xs ** {c2 = xs.c2} ;
 
     BaseVPI2 x y = twoTable2 VVType Agr x y ** {c2 = y.c2} ; ---- just remembering the prep of the latter verb
     ConsVPI2 x xs = consrTable2 VVType Agr comma x xs ** {c2 = xs.c2} ;
 
 
-    ConjVPS2 c xs = conjunctDistrTable Agr c xs ** {c2 = xs.c2} ;
+    ConjVPS2 c xs = ConjVPS c xs ** {c2 = xs.c2} ;
     ConjVPI2 c xs = conjunctDistrTable2 VVType Agr c xs ** {c2 = xs.c2} ;
 
 
     ComplVPS2 vps2 np = {
-        s = \\a => vps2.s ! a ++ vps2.c2 ++ np.s ! NPAcc
+        s = \\o,a => let vps2s = vps2.s ! o ! a in
+            vps2s ** {inf = vps2s.inf ++ vps2.c2 ++ np.s ! NPAcc} -- keep fin, add object to inf
         } ;
     ComplVPI2 vpi2 np = {
         s = \\t,a => vpi2.s ! t ! a ++ vpi2.c2 ++  np.s ! NPAcc
         } ;
-
+    ReflVPS2 vps2 rnp = {
+        s = \\o,a => let vps2s = vps2.s ! o ! a in
+            vps2s ** {inf = vps2s.inf ++ vps2.c2 ++ rnp.s ! a}
+        } ;
   oper
     mkVPS : Temp -> Pol -> VP -> VPS = \t,p,vp -> lin VPS {
-      s = \\a =>
+      s = \\o,a =>
         let
-              verb = vp.s ! t.t ! t.a ! p.p ! oDir ! a ;
+          verb = vp.s ! t.t ! t.a ! p.p ! o ! a ; -- choice of Order determines aux or not
-              verbf = verb.aux ++ verb.adv ++ verb.fin ++ verb.inf ;
+          compl = vp.s2 ! a ++ vp.ext
-            in t.s ++ p.s ++ vp.ad ! a ++ verbf ++ vp.p ++ vp.s2 ! a ++ vp.ext
+        in {fin = verb.aux ;
+            inf = verb.adv ++ vp.ad ! a ++ verb.fin ++ verb.inf ++ vp.p ++ compl} ;
       } ;
 
+    linVPS : Agr -> {s : Order => Agr => {fin,inf : Str}} -> Str = \agr,vps -> let vpss = vps.s ! ODir True ! agr in vpss.fin ++ vpss.inf ;
+
     mkVPI : VP -> VPI = \vp -> lin VPI {
       s = table {
             VVAux      => \\a =>         vp.ad ! a ++ vp.inf ++ vp.p ++ vp.s2 ! a ;
@@ -138,6 +191,10 @@ concrete ExtendEng of Extend =
             }
       } ;
 
+linref
+  VPS = linVPS (agrP3 Sg) ;
+  VPS2 = \vps -> linVPS (agrP3 Sg) vps ++ vps.c2 ;
+
 -- Conjunction of copula complements
 
 lincat [Comp] = {s1,s2 : Agr => Str} ;
@@ -239,6 +296,19 @@ lin BaseImp = twoTable2 CPolarity ImpForm ;
     ProgrVPSlash vp = insertObjc (\\a => vp.ad ! a ++ vp.prp ++ vp.p ++ vp.s2 ! a)
       (predAux auxBe ** {c2 = vp.c2; gapInMiddle = vp.gapInMiddle; missingAdv = vp.missingAdv});
 
+    N2VPSlash n2 =
+      let prep : Prep = mkPrep n2.c2 ;
+          dummyVPS : VPSlash = SlashV2a (mkV2 (mkV "dummy") prep);
+      in dummyVPS **  -- has necessary fields for VPSlash, and c2 from the N2
+           UseComp (CompCN (UseN2 n2)) ; -- has all the right fields except for c2
+
+    A2VPSlash a2 =
+      let prep : Prep = mkPrep a2.c2 ;
+          dummyVPS : VPSlash = SlashV2a (mkV2 (mkV "dummy") prep) ;
+      in dummyVPS **  -- has necessary fields for VPSlash, and c2 from the A2
+           UseComp (CompAP (UseA2 a2)) ; -- has all the right fields except for c2
+
+
    --- AR 7/3/2013
    ComplSlashPartLast vps np = case vps.gapInMiddle of {
      _  => insertObjPartLast (\\_ => vps.c2 ++ np.s ! NPAcc) vps  ---
@@ -377,7 +447,4 @@ lin BaseImp = twoTable2 CPolarity ImpForm ;
     UncontractedNeg = {s = [] ; p = CNeg False} ;
     UttVPShort vp = {s = infVP VVAux vp False Simul CPos (agrP3 Sg)} ;
 
-
-
-
 }

src/swedish/ExtendSwe.gf

@@ -8,13 +8,14 @@ concrete ExtendSwe of Extend = CatSwe **
     PassVPSlash, PassAgentVPSlash, UttVPShort, ByVP, InOrderToVP,
     MkVPI, BaseVPI, ConsVPI, ConjVPI, ComplVPIVV,
     MkVPS, BaseVPS, ConsVPS, ConjVPS, PredVPS,
-    MkVPS2, ConjVPS2, ComplVPS2, MkVPI2, ConjVPI2, ComplVPI2,
+    MkVPS2, ConjVPS2, ComplVPS2, ReflVPS2, MkVPI2, ConjVPI2, ComplVPI2,
     ICompAP,ProDrop,EmbedSSlash,
     AdAdV, PositAdVAdj, GerundCN, GerundNP, GerundAdv, PresPartAP, PastPartAP, PastPartAgentAP,
     RNP, RNPList, ReflRNP, ReflPron, ReflPoss, PredetRNP, ConjRNP,
     Base_rr_RNP, Base_nr_RNP, Base_rn_RNP, Cons_rr_RNP, Cons_nr_RNP, ReflPossPron,
     CompoundN, CompoundAP, AdvIsNP,
-    UttAccNP
+    UttAccNP,
+    A2VPSlash, N2VPSlash
   ]
   with (Grammar = GrammarSwe)
     **
@@ -75,6 +76,40 @@ in {
           c2 = vp.c2
         } ;
 
+
+    N2VPSlash n2 =
+      let vp : CatSwe.VP = UseComp (CompCN (UseN2 n2)) ;
+          dummyVPS : VPSlash = SlashV2a (P.mkV2 "dummy") ;
+      in dummyVPS **  -- has necessary fields for VPSlash
+               vp **  -- has all the right fields except for c2
+              {c2 = n2.c2} ; -- has the right c2
+
+
+
+    A2VPSlash a2 =
+      let vp : CatSwe.VP = UseComp (CompAP (UseA2 a2)) ;
+          dummyVPS : VPSlash = SlashV2a (P.mkV2 "dummy") ;
+      in dummyVPS **  -- has necessary fields for VPSlash
+               vp **  -- has all the right fields except for c2
+              {c2 = a2.c2} ; -- has the right c2
+
+
+    N2VPSlash n2 =
+      let vp : CatSwe.VP = UseComp (CompCN (UseN2 n2)) ;
+          dummyVPS : VPSlash = SlashV2a (P.mkV2 "dummy") ;
+      in dummyVPS **  -- has necessary fields for VPSlash
+               vp **  -- has all the right fields except for c2
+              {c2 = n2.c2} ; -- has the right c2
+
+
+
+    A2VPSlash a2 =
+      let vp : CatSwe.VP = UseComp (CompAP (UseA2 a2)) ;
+          dummyVPS : VPSlash = SlashV2a (P.mkV2 "dummy") ;
+      in dummyVPS **  -- has necessary fields for VPSlash
+               vp **  -- has all the right fields except for c2
+              {c2 = a2.c2} ; -- has the right c2
+
   lin UttVPShort vp = {s = infVP vp (agrP3 Utr Sg)} ;
 
   lincat
@@ -156,6 +191,9 @@ in {
     ComplVPS2 vps2 np = {
         s = \\o,a => vps2.s !o ! a ++ vps2.c2.s ++ np.s ! NPAcc
         } ;
+    ReflVPS2 vps2 rnp = {
+        s = \\o,a => vps2.s ! o ! a ++ vps2.c2.s ++ rnp.s ! a
+        } ;
 
     ConjVPS2 c xs = conjunctDistrTable2 Order Agr c xs ** {c2 = xs.c2} ;