most of ExtendEng in place

src/abstract/Extend.gf

@@ -67,10 +67,13 @@ abstract Extend = Cat ** {
     FocusAdV : AdV -> S       -> Utt ;   -- never will I sleep
     FocusAP  : AP  -> NP      -> Utt ;   -- green was the tree
 
-  fun
+  -- participle constructions
-    ParticipleAP  : VP -> AP ;   -- (the man) looking at Mary
+    PresPartAP    : VP -> AP ;   -- (the man) looking at Mary
     EmbedPresPart : VP -> SC ;   -- looking at Mary (is fun)
     
+    PastPartAP      : VPSlash -> AP ;         -- lost (opportunity) ; (opportunity) lost in space
+    PastPartAgentAP : VPSlash -> NP -> AP ;   -- (opportunity) lost by the company
+   
 -- this is a generalization of Verb.PassV2 and should replace it in the future.
 
     PassVPSlash : VPSlash -> VP ; -- be forced to sleep
@@ -80,11 +83,6 @@ abstract Extend = Cat ** {
 
     PassAgentVPSlash : VPSlash -> NP -> VP ;  -- be begged by her to go
 
--- In many languages, the passives use past participles.
-
-    PastPartAP      : VPSlash -> AP ;         -- lost (opportunity) ; (opportunity) lost in space
-    PastPartAgentAP : VPSlash -> NP -> AP ;   -- (opportunity) lost by the company
-   
 -- publishing of the document
 
     NominalizeVPSlashNP : VPSlash -> NP -> NP ;
@@ -142,8 +140,8 @@ abstract Extend = Cat ** {
 
 --- from Extensions
 
-  ComplVV  : VV -> Ant -> Pol -> VP  -> VP ;         -- want not to have slept
+  ComplGenVV  : VV -> Ant -> Pol -> VP  -> VP ;         -- want not to have slept
-  SlashV2V : V2V -> Ant -> Pol -> VPS -> VPSlash ;   -- force (her) not to have slept
+  SlashV2V    : V2V -> Ant -> Pol -> VPS -> VPSlash ;   -- force (her) not to have slept
 
   CompoundN   : N -> N  -> N ;      -- control system / controls system / control-system
   CompoundAP  : N -> A  -> AP ;     -- language independent / language-independent
@@ -166,5 +164,11 @@ abstract Extend = Cat ** {
   CompQS      : QS -> Comp ;                  -- (the question is) who sleeps
   CompVP      : Ant -> Pol -> VP -> Comp ;    -- (she is) to go
 
+-- very language-specific things
+
+--Eng
+  UncontractedNeg : Pol ;      -- do not, etc, as opposed to don't
+  UttVPShort : VP -> Utt ;     -- have fun, as opposed to "to have fun"
+  ComplSlashPartLast : VPSlash -> NP -> VP ;
 
 }

src/common/ExtendFunctor.gf

@@ -1,9 +1,6 @@
-incomplete concrete ExtendFunctor of Extend = open Grammar in {
+incomplete concrete ExtendFunctor of Extend = Cat ** open Grammar in {
 
 lincat
-  VPS = Grammar.VP ;
-  [VPS] = Grammar.VP ;
-
   RNP = Grammar.NP ;
   RNPList = Grammar.ListNP ;
 
@@ -16,22 +13,22 @@ lin
   GenNP = variants {} ;     -- NP -> Quant ; -- this man's
   GenIP = variants {} ;     -- IP -> IQuant ; -- whose
   GenRP = variants {} ;     -- Num -> CN -> RP ; -- whose car
-  GenModNP = variants {} ;     -- Num -> NP -> CN -> NP ; -- this man's car(s)
+  GenModNP num np cn = DetCN (DetQuant DefArt num) (AdvCN cn (PrepNP possess_Prep np)) ;     -- this man's car(s) ; DEFAULT the car of this man
   GenModIP = variants {} ;     -- Num -> IP -> CN -> IP ; -- whose car(s)
-  CompBareCN = variants {} ;     -- CN -> Comp ; -- (est) professeur
+  CompBareCN cn = CompNP (CompCN cn) ; -- (est) professeur ; DEFAULT is a teacher
-  StrandQuestSlash = variants {} ;     -- IP -> ClSlash -> QCl ; -- whom does John live with
+  StrandQuestSlash = QuestSlash ; -- whom does John live with ; DEFAULT with whom does John live
-  StrandRelSlash = variants {} ;     -- RP -> ClSlash -> RCl ; -- that he lives in
+  StrandRelSlash = RelSlash ; -- that he lives in ; DEFAULT in which he lives
-  EmptyRelSlash = variants {} ;     -- ClSlash -> RCl ; -- he lives in
+  EmptyRelSlash = RelSlash IdRP ; -- he lives in ; DEFAULT in which he lives
-  MkVPS = variants {} ;     -- Temp -> Pol -> VP -> VPS ; -- to sleep / hasn't slept
+  MkVPS vp = variants {} ;     -- Temp -> Pol -> VP -> VPS ; -- to sleep / hasn't slept
   ConjVPS = variants {} ;     -- Conj -> [VPS] -> VPS ; -- has walked and won't sleep
   PredVPS = variants {} ;     -- NP -> VPS -> S ; -- she [has walked and won't sleep]
   ComplVPSVV = variants {} ;     -- VV -> VPS -> VP ; -- want to sleep and to walk
   PredVPSVV = variants {} ;     -- NP -> VV -> VPS -> VP ; -- she wants to sleep and to walk
-  ProDrop = variants {} ;     -- Pron -> Pron ; -- unstressed subject pronoun becomes []: "(io) sono stanco"
+  ProDrop pro = pro ;     -- am tired ; DEFAULT I am tired
   ICompAP = variants {} ;     -- AP -> IComp ; -- "how old"
   IAdvAdv = variants {} ;     -- Adv -> IAdv ; -- "how often"
-  CompIQuant = variants {} ;     -- IQuant -> IComp ; -- which (is it) [agreement to NP]
+  CompIQuant iquant = CompIP (IdetIP (IdetQuant iquant NumSg)) ;  -- which (is it) [agreement to NP] ; DEFAULT which [no agreement]
-  PrepCN = variants {} ;     -- Prep -> CN -> Adv ; -- by accident [Prep + CN without article]
+  PrepCN prep cn = PrepNP prep (MassNP cn) ;     -- Prep -> CN -> Adv ; -- by accident [Prep + CN without article] ; DEFAULT CN as mass term
   FocusObj = variants {} ;     -- NP -> SSlash -> Utt ; -- her I love
   FocusAdv = variants {} ;     -- Adv -> S -> Utt ; -- today I will sleep
   FocusAdV = variants {} ;     -- AdV -> S -> Utt ; -- never will I sleep

src/english/ExtendEng.gf

@@ -6,6 +6,7 @@ concrete ExtendEng of Extend =
     (Grammar = GrammarEng) **
 
   open
+    GrammarEng,
     ResEng,
     Coordination,
     Prelude,
@@ -24,6 +25,9 @@ concrete ExtendEng of Extend =
       a = RAg (agrP3 nu.n)
       } ;
       
+    GenModNP num np cn = DetCN (DetQuant (GenNP (lin NP np)) num) cn ;
+    GenModIP num ip cn = IdetCN (IdetQuant (GenIP (lin IP ip)) num) cn ;
+
     StrandQuestSlash ip slash = 
       {s = \\t,a,b,q => 
          (mkQuestion (ss (ip.s ! NPAcc)) slash).s ! t ! a ! b ! q ++ slash.c2
@@ -61,107 +65,86 @@ concrete ExtendEng of Extend =
 
 
   lincat
-    VPS   = {s : Agr => Str} ;
+    VPS   = {s : {s : Agr => Str} ; i : {s : VVType => Agr => Str}} ; --- finite and infinite forms separately
-    [VPS] = {s1,s2 : Agr => Str} ;
+    [VPS] = {s : {s1,s2 : Agr => Str} ; i : {s1,s2 : VVType => Agr => Str}} ;
 
   lin
-    BaseVPS = twoTable Agr ;
+    BaseVPS x y = {s = twoTable Agr x.s y.s ; i = twoTable2 VVType Agr x.i y.i} ;
-    ConsVPS = consrTable Agr comma ;
+    ConsVPS x xs = {s = consrTable Agr comma x.s xs.s ; i = consrTable2 VVType Agr comma x.i xs.i} ;
 
-    PredVPS np vpi = {s = np.s ! npNom ++ vpi.s ! np.a} ;
+    PredVPS np vps = {s = np.s ! npNom ++ vps.s.s ! np.a} ;
 
     MkVPS t p vp = {
-      s = \\a => 
+      s = {s = \\a => 
             let 
               verb = vp.s ! t.t ! t.a ! p.p ! oDir ! a ;
               verbf = verb.aux ++ verb.adv ++ verb.fin ++ verb.inf ;
             in t.s ++ p.s ++ vp.ad ! a ++ verbf ++ vp.p ++ vp.s2 ! a ++ vp.ext
+	   } ;
+      i = {s = table {
+            VVAux      => \\a => vp.ad ! a ++ vp.inf ++ vp.p ++ vp.s2 ! a;
+            VVInf      => \\a => "to" ++ vp.ad ! a ++ vp.inf ++ vp.p ++ vp.s2 ! a;
+            VVPresPart => \\a => vp.ad ! a ++ vp.prp ++ vp.p ++ vp.s2 ! a
+            }
+	  }
       } ;
 
-    ConjVPS = conjunctDistrTable Agr ;
+    ConjVPS c xs = {s = conjunctDistrTable Agr c xs.s ; i = conjunctDistrTable2 VVType Agr c xs.i} ;
+
+    ComplVPIVV vv vpi = 
+      insertObj (\\a => vpi.i.s ! vv.typ ! a) (predVV vv) ;
+
+-----
 
     ICompAP ap = {s = "how" ++ ap.s ! agrP3 Sg} ; ---- IComp should have agr!
 
     IAdvAdv adv = {s = "how" ++ adv.s} ;
 
-    PartVP vp = {
+    PresPartAP vp = {
       s = \\a => vp.ad ! a ++ vp.prp ++ vp.p ++ vp.s2 ! a ++ vp.ext ;
       isPre = vp.isSimple                 -- depends on whether there are complements
       } ;
 
     EmbedPresPart vp = {s = infVP VVPresPart vp Simul CPos (agrP3 Sg)} ; --- agr
 
-    UttVPShort vp = {s = infVP VVAux vp Simul CPos (agrP3 Sg)} ;
+   PastPartAP vp = { 
-
+      s = \\a => vp.ad ! a ++ vp.ptp ++ vp.p ++ vp.c2 ++ vp.s2 ! a ++ vp.ext ;
-  do_VV = {
+      isPre = vp.isSimple                 -- depends on whether there are complements
-    s = table {
-      VVF VInf => ["do"] ;
-      VVF VPres => "does" ;
-      VVF VPPart => ["done"] ; ----
-      VVF VPresPart => ["doing"] ;
-      VVF VPast => ["did"] ;      --# notpresent
-      VVPastNeg => ["didn't"] ;      --# notpresent
-      VVPresNeg => "doesn't"
       } ;
-    p = [] ;
+   PastPartAgentAP vp np = { 
-    typ = VVAux
+      s = \\a => vp.ad ! a ++ vp.ptp ++ vp.p ++ vp.c2 ++ vp.s2 ! a ++ "by" ++ np.s ! NPAcc ++ vp.ext ;
-    } ;
+      isPre = False
-
-   may_VV = lin VV {
-     s = table { 
-      VVF VInf => ["be allowed to"] ;
-      VVF VPres => "may" ;
-      VVF VPPart => ["been allowed to"] ;
-      VVF VPresPart => ["being allowed to"] ;
-      VVF VPast => "might" ; --# notpresent
-      VVPastNeg => "mightn't" ; --# notpresent
-      VVPresNeg => "may not"
       } ;
-    p = [] ;
-    typ = VVAux
-    } ;
 
-   shall_VV = lin VV {
+   GerundCN vp = {
-     s = table { 
+     s = \\n,c => vp.ad ! AgP3Sg Neutr ++ vp.prp ++
-      VVF VInf => ["be obliged to"] ; ---
+                  case <n,c> of {
-      VVF VPres => "shall" ;
+                    <Sg,Nom> => "" ;
-      VVF VPPart => ["been obliged to"] ;
+                    <Sg,Gen> => Predef.BIND ++ "'s" ;
-      VVF VPresPart => ["being obliged to"] ;
+                    <Pl,Nom> => Predef.BIND ++ "s" ;
-      VVF VPast => "should" ; --# notpresent
+                    <Pl,Gen> => Predef.BIND ++ "s'"
-      VVPastNeg => "shouldn't" ; --# notpresent
+                    } ++ 
-      VVPresNeg => "shan't" 
+                  vp.p ++ vp.s2 ! AgP3Sg Neutr ++ vp.ext ; 
-      } ;
+     g = Neutr
-    p = [] ;
+     } ;
-    typ = VVAux
-    } ;
 
-   ought_VV = lin VV {
+   GerundNP vp = 
-     s = table { 
+     let a = AgP3Sg Neutr ---- agr
-      VVF VInf => ["be obliged to"] ; ---
+     in 
-      VVF VPres => "ought to" ;
+     {s = \\_ => vp.ad ! a ++ vp.prp ++ vp.p ++ vp.s2 ! a ++ vp.ext ; a = a} ;
-      VVF VPPart => ["been obliged to"] ;
-      VVF VPresPart => ["being obliged to"] ;
-      VVF VPast => "ought to" ; --# notpresent
-      VVPastNeg => "oughtn't to" ; --# notpresent
-      VVPresNeg => "oughtn't to"  --- shan't
-      } ;
-    p = [] ;
-    typ = VVAux
-    } ;
 
-   used_VV = lin VV {
+   GerundAdv vp = 
-     s = table { 
+     let a = AgP3Sg Neutr
-      VVF VInf => Predef.nonExist ; ---
+     in 
-      VVF VPres => Predef.nonExist ;
+     {s = vp.ad ! a ++ vp.prp ++ vp.p ++ vp.s2 ! a ++ vp.ext} ;
-      VVF VPPart => ["used to"] ;
+
-      VVF VPresPart => ["being used to"] ;
+   WithoutVP vp = {s = "without" ++ (GerundAdv (lin VP vp)).s} ; 
-      VVF VPast => "used to" ; --# notpresent
+
-      VVPastNeg => "used not to" ; --# notpresent
+   InOrderToVP vp = {s = ("in order" | []) ++ infVP VVInf vp Simul CPos (AgP3Sg Neutr)} ;
-      VVPresNeg => Predef.nonExist 
+
-      } ;
+   PurposeVP vp = {s = infVP VVInf vp Simul CPos (agrP3 Sg)} ; --- agr
-    p = [] ;
+
-    typ = VVAux
+   ByVP vp = {s = "by" ++ (GerundAdv (lin VP vp)).s} ; 
-    } ;
 
 
    NominalizeVPSlashNP vpslash np = 
@@ -170,8 +153,6 @@ concrete ExtendEng of Extend =
      in 
      lin NP {s = \\_ => vp.ad ! a ++ vp.prp ++ vp.s2 ! a ; a = a} ;  
 
-lin
-  UncNeg = {s = [] ; p = CNeg False} ; 
 
   oper passVPSlash : VPSlash -> Str -> ResEng.VP = 
    \vps,ag -> 
@@ -191,8 +172,8 @@ lin
     } ;
 
   lin 
-    PassVPSlash vps = passVPSlash vps [] ;
+    PassVPSlash vps = passVPSlash (lin VPS vps) [] ;
-    PassAgentVPSlash vps np = passVPSlash vps ("by" ++ np.s ! NPAcc) ;
+    PassAgentVPSlash vps np = passVPSlash (lin VPS vps) ("by" ++ np.s ! NPAcc) ;
 
    --- AR 7/3/2013
    ComplSlashPartLast vps np = case vps.gapInMiddle of {
@@ -204,19 +185,19 @@ lin
       mkClause "there" (agrP3 (fromAgr np.a).n) 
         (insertObj (\\_ => np.s ! NPAcc) (predV (regV "exist"))) ;
 
-   PurposeVP vp = {s = infVP VVInf vp Simul CPos (agrP3 Sg)} ; --- agr
-
 
    ComplBareVS  v s = insertExtra s.s (predV v) ;
    SlashBareV2S v s = insertExtrac s.s (predVc v) ;
 
-   ContractedUseCl  t p cl = {
+  CompoundN noun cn = {
-      s = t.s ++ p.s ++ cl.s ! t.t ! t.a ! p.p ! ODir True
+    s = (\\n,c => noun.s ! Sg ! Nom ++ cn.s ! n ! c) ;
-      } ;
+    g = cn.g
+  } ;
   
-
+  CompoundAP noun adj = {
-
+    s = (\\_ => noun.s ! Sg ! Nom ++ adj.s ! AAdj Posit Nom) ;
-    CompoundCN a b = {s = \\n,c => a.s ! Sg ! Nom ++ b.s ! n ! c ; g = b.g} ;
+    isPre = True
+    } ;
 
     FrontExtPredVP np vp = {
       s = \\t,a,b,o => 
@@ -254,6 +235,10 @@ lin
         s = \\n,c => preOrPost ap.isPre (ap.s ! agrgP3 n cn.g) (cn.s ! n ! c) ;
         g = cn.g
         } ;
+    AdjAsNP ap = {
+      s = \\c => ap.s ! agrgP3 Sg nonhuman ; ---- genitive case?
+      a = agrgP3 Sg nonhuman
+      } ;
 
   lincat
     RNP     = {s : Agr => Str} ;
@@ -276,7 +261,17 @@ lin
     
 ---- TODO: RNPList construction
 
+    ComplGenVV v a p vp = insertObj (\\agr => a.s ++ p.s ++ 
+                                         infVP v.typ vp a.a p.p agr)
+                               (predVV v) ;
 
+    CompS s = {s = \\_ => "that" ++ s.s} ;
+    CompQS qs = {s = \\_ => qs.s ! QIndir} ;
+    CompVP ant p vp = {s = \\a => ant.s ++ p.s ++ 
+                                infVP VVInf vp ant.a p.p a} ;
 
+-- quite specific for English anyway
 
+    UncontractedNeg = {s = [] ; p = CNeg False} ; 
+    UttVPShort vp = {s = infVP VVAux vp Simul CPos (agrP3 Sg)} ;
 }