removed Eng-specific qforms from PredFunctor

lib/src/experimental/PredEng.gf

@@ -1,11 +1,93 @@
 concrete PredEng of Pred = 
   CatEng [Ant,NP,Utt,IP,IAdv,IComp,Conj,RP,RS] ** 
-    PredFunctor - [QuestIComp]  ---- IComp has no parameters in Eng
+    PredFunctor - [
+      -- for all these, special qforms added in Eng
+      PassUseV,
+      AgentPassUseV,
+      UseVPC,
+      PredVP,
+      QuestVP,
+      RelVP,
+
+      QuestIComp  ---- IComp has no parameters in Eng
+      ]  
   with 
       (PredInterface = PredInstanceEng) 
 
   ** open PredInstanceEng, (R = ResEng) in {
 
+-- overrides
+
+lin
+  PassUseV x a t p v = initPrVerbPhraseV a t p v ** {
+    v   = \\agr => tenseV (a.s ++ t.s ++ p.s) t.t a.a p.p passive agr v ;
+    inf = \\vt => tenseInfV a.s a.a p.p passive v vt ;
+    obj2 = <noObj, True> ; -- becomes subject control even if object control otherwise "*she was promised by us to love ourselves"
+    qforms = \\agr => qformsCopula (a.s ++ t.s ++ p.s) t.t a.a p.p agr ;
+    } ;
+
+  AgentPassUseV x a t p v np = initPrVerbPhraseV a t p v ** {
+    v   = \\agr => tenseV (a.s ++ t.s ++ p.s) t.t a.a p.p passive agr v ;
+    inf = \\vt => tenseInfV a.s a.a p.p passive v vt ;
+    obj2 = <noObj, True> ; -- becomes subject control even if object control otherwise "*she was promised by us to love ourselves"
+    adv = appComplCase agentCase np ;
+    qforms = \\agr => qformsCopula (a.s ++ t.s ++ p.s) t.t a.a p.p agr ;
+    } ;
+
+
+  PredVP x np vp = vp ** {
+    v    = applyVerb vp (agr2vagr np.a) ;
+    subj = appSubjCase np ;
+    adj  = vp.adj ! np.a ;
+    obj1 = vp.part ++ strComplCase vp.c1 ++ vp.obj1.p1 ! np.a ;  ---- apply complCase ---- place of part depends on obj
+    obj2 = strComplCase vp.c2 ++ vp.obj2.p1 ! (case vp.obj2.p2 of {True => np.a ; False => vp.obj1.p2}) ;   ---- apply complCase
+    c3   = vp.c1 ; -- in case there is any free slot left ---- could be c2 
+    qforms = qformsVP vp (agr2vagr np.a) ; 
+    } ;
+
+  QuestVP x ip vp = 
+   let 
+       ipa = ipagr2agr ip.n 
+   in {
+    v    = applyVerb vp (ipagr2vagr ip.n) ;
+    foc  = ip.s ! subjCase ;
+    focType = FocSubj ;
+    subj = [] ;
+    adj  = vp.adj ! ipa ;
+    obj1 = vp.part ++ strComplCase vp.c1 ++ vp.obj1.p1 ! ipa ; ---- appComplCase
+    obj2 = strComplCase vp.c2 ++ vp.obj2.p1 ! (case vp.obj2.p2 of {True => ipa ; False => vp.obj1.p2}) ; ---- appComplCase
+    c3   = noComplCase ;      -- for one more prep to build ClSlash ---- ever needed for QCl?
+    adv  = vp.adv ;
+    adV  = vp.adV ;
+    ext  = vp.ext ; 
+    qforms = qformsVP vp (ipagr2vagr ip.n) ;
+    } ;
+
+  RelVP rp vp = 
+    let 
+      cl : Agr -> PrClause = \a -> 
+        let rpa = rpagr2agr rp.a a in
+        
+        vp ** {
+        v    = applyVerb vp (agr2vagr rpa) ;
+        subj = rp.s ! subjRPCase a ;
+        adj  = vp.adj ! rpa ;
+        obj1 = vp.part ++ strComplCase vp.c1 ++ vp.obj1.p1 ! rpa ;  ---- apply complCase ---- place of part depends on obj
+        obj2 = strComplCase vp.c2 ++ vp.obj2.p1 ! (case vp.obj2.p2 of {True => rpa ; False => vp.obj1.p2}) ;   ---- apply complCase
+        c3   = noComplCase ;      -- for one more prep to build ClSlash 
+        qforms = qformsVP vp (agr2vagr rpa) ; 
+        }
+    in {s = \\a => declCl (cl a) ; c = subjCase} ;
+
+  UseVPC x vpc = initPrVerbPhrase ** { ---- big loss of quality (overgeneration) seems inevitable
+    v   = \\a => <[], [], vpc.s1 ++ vpc.v ! a> ;
+    inf = \\vt => vpc.inf ! defaultAgr ! vt ; ---- agr 
+    imp = vpc.imp ;
+    c1  = vpc.c1 ;
+    c2  = vpc.c2 ;
+    qforms = \\a => <"do", vpc.inf ! defaultAgr ! vvInfinitive> ; ---- do/does/did
+    } ;
+
 lin
   QuestIComp a t p icomp np = 
     let vagr = (agr2vagr np.a) in
@@ -17,12 +99,13 @@ lin
     qforms = qformsCopula (a.s ++ t.s ++ p.s) t.t a.a p.p vagr ; 
     } ;
 
+-- not in functor anyway
+
   NomVPNP vpi = {
     s = \\c => vpi.s ! R.VVPresPart ! defaultAgr ;
     a = defaultAgr
     } ;
 
-
   ByVP x vp vpi = vp ** {adv = "by" ++ vpi.s ! R.VVPresPart ! defaultAgr} ; ---- agr
   WhenVP x vp vpi = vp ** {adv = "when" ++ vpi.s ! R.VVPresPart ! defaultAgr} ; ---- agr
   BeforeVP x vp vpi = vp ** {adv = "before" ++ vpi.s ! R.VVPresPart ! defaultAgr} ; ---- agr

lib/src/experimental/PredFunctor.gf

@@ -89,7 +89,6 @@ lin
     v   = \\agr => tenseV (a.s ++ t.s ++ p.s) t.t a.a p.p passive agr v ;
     inf = \\vt => tenseInfV a.s a.a p.p passive v vt ;
     obj2 = <noObj, True> ; -- becomes subject control even if object control otherwise "*she was promised by us to love ourselves"
-    qforms = \\agr => qformsCopula (a.s ++ t.s ++ p.s) t.t a.a p.p agr ;
     } ;
 
   AgentPassUseV x a t p v np = initPrVerbPhraseV a t p v ** {
@@ -97,7 +96,6 @@ lin
     inf = \\vt => tenseInfV a.s a.a p.p passive v vt ;
     obj2 = <noObj, True> ; -- becomes subject control even if object control otherwise "*she was promised by us to love ourselves"
     adv = appComplCase agentCase np ;
-    qforms = \\agr => qformsCopula (a.s ++ t.s ++ p.s) t.t a.a p.p agr ;
     } ;
 
   UseAP x a t p ap = useCopula a t p ** {
@@ -170,7 +168,6 @@ lin
     obj1 = vp.part ++ strComplCase vp.c1 ++ vp.obj1.p1 ! np.a ;  ---- apply complCase ---- place of part depends on obj
     obj2 = strComplCase vp.c2 ++ vp.obj2.p1 ! (case vp.obj2.p2 of {True => np.a ; False => vp.obj1.p2}) ;   ---- apply complCase
     c3   = vp.c1 ; -- in case there is any free slot left ---- could be c2 
-    qforms = qformsVP vp (agr2vagr np.a) ; 
     } ;
 
   SlashClNP x cl np = cl ** {  -- Cl ::= Cl/NP NP 
@@ -197,7 +194,6 @@ lin
     adv  = vp.adv ;
     adV  = vp.adV ;
     ext  = vp.ext ; 
-    qforms = qformsVP vp (ipagr2vagr ip.n) ;
     } ;
 
   QuestSlash x ip cl = 
@@ -234,7 +230,6 @@ lin
     adV = negAdV p ;
     foc = icomp.s ! agr2icagr np.a ; 
     focType = FocObj ;
-    qforms = qformsCopula (a.s ++ t.s ++ p.s) t.t a.a p.p vagr ; 
     } ;
 
   RelVP rp vp = 
@@ -249,7 +244,6 @@ lin
         obj1 = vp.part ++ strComplCase vp.c1 ++ vp.obj1.p1 ! rpa ;  ---- apply complCase ---- place of part depends on obj
         obj2 = strComplCase vp.c2 ++ vp.obj2.p1 ! (case vp.obj2.p2 of {True => rpa ; False => vp.obj1.p2}) ;   ---- apply complCase
         c3   = noComplCase ;      -- for one more prep to build ClSlash 
-        qforms = qformsVP vp (agr2vagr rpa) ; 
         }
     in {s = \\a => declCl (cl a) ; c = subjCase} ;
 
@@ -347,7 +341,7 @@ lin
     imp = vpc.imp ;
     c1  = vpc.c1 ;
     c2  = vpc.c2 ;
-    qforms = \\a => <"do", vpc.inf ! defaultAgr ! vvInfinitive> ; ---- do/does/did
+
     } ;
 
   StartClC x c a b = {

lib/src/experimental/PredInstanceEng.gf

@@ -1,4 +1,50 @@
-instance PredInstanceEng of PredInterface = open ResEng, (X = ParamX), Prelude in {
+instance PredInstanceEng of PredInterface - [
+   PrVerbPhrase, PrClause,
+   initPrVerbPhrase, initPrVerbPhraseV, initPrClause, 
+   useCopula, questCl, linrefPrQCl
+   ] = 
+
+  open ResEng, (X = ParamX), Prelude in {
+
+----- overrides ----------------
+
+oper
+
+  PrVerbPhrase = BasePrVerbPhrase ** {qforms : VAgr => Str * Str} ;
+  PrClause = BasePrClause ** {qforms : Str * Str} ;
+
+  initPrVerbPhrase : PrVerbPhrase = initBasePrVerbPhrase ** {
+    qforms = \\agr => <[],[]> ;
+    } ;
+
+  initPrVerbPhraseV : 
+       {s : Str ; a : Anteriority} -> {s : Str ; t : STense} -> {s : Str ; p : Polarity} -> PrVerb -> PrVerbPhrase = 
+  \a,t,p,v -> initBasePrVerbPhraseV a t p v ** {
+    qforms = \\agr => qformsV (a.s ++ t.s ++ p.s) t.t a.a p.p agr v
+    } ;
+ 
+
+  initPrClause : PrClause = initBasePrClause ** {
+    qforms = <[],[]> ;
+    } ; 
+
+  useCopula : {s : Str ; a : Anteriority} -> {s : Str ; t : STense} -> {s : Str ; p : Polarity} -> 
+                 PrVerbPhrase =
+    \a,t,p -> initPrVerbPhrase ** {
+    v   = \\agr => tenseCopula (a.s ++ t.s ++ p.s) t.t a.a p.p agr ;
+    inf = \\vt => tenseInfCopula a.s a.a p.p vt ;
+    imp = \\n => tenseImpCopula p.s p.p n ;
+    adV = negAdV p ;
+    qforms = \\agr => qformsCopula (a.s ++ t.s ++ p.s) t.t a.a p.p agr ;
+    } ;
+
+  questCl : PrQuestionClause -> Str = \cl -> case cl.focType of {
+    NoFoc   => cl.foc ++ cl.qforms.p1 ++ cl.subj ++ cl.adV ++ cl.qforms.p2 ++ restCl cl ;  -- does she sleep
+    FocObj  => cl.foc ++ cl.qforms.p1 ++ cl.subj ++ cl.adV ++ cl.qforms.p2 ++ restCl cl ;  -- who does she love
+    FocSubj => cl.foc ++ cl.v.p1      ++ cl.subj ++ cl.adV ++ cl.v.p2      ++ restCl cl    -- who loves her
+    } ;
+
+  linrefPrQCl : PrQuestionClause -> Str = \qcl -> questCl qcl ;
 
 ---------------------
 -- parameters -------
@@ -292,12 +338,6 @@ oper
   declSubordCl : PrClause -> Str = declCl ;
   declInvCl    : PrClause -> Str = declCl ;
 
-  questCl : PrQuestionClause -> Str = \cl -> case cl.focType of {
-    NoFoc   => cl.foc ++ cl.qforms.p1 ++ cl.subj ++ cl.adV ++ cl.qforms.p2 ++ restCl cl ;  -- does she sleep
-    FocObj  => cl.foc ++ cl.qforms.p1 ++ cl.subj ++ cl.adV ++ cl.qforms.p2 ++ restCl cl ;  -- who does she love
-    FocSubj => cl.foc ++ cl.v.p1      ++ cl.subj ++ cl.adV ++ cl.v.p2      ++ restCl cl    -- who loves her
-    } ;
-
   questSubordCl : PrQuestionClause -> Str = \cl -> 
     let 
       rest = cl.subj ++ cl.adV ++ cl.v.p1 ++ cl.v.p2 ++ restCl cl 
@@ -307,6 +347,15 @@ oper
       FocSubj =>         cl.foc ++ rest    -- who loves her
       } ;
 
+
+--- only needed in Eng because of do questions
+  qformsV : Str -> STense -> Anteriority -> Polarity -> VAgr -> PrVerb -> Str * Str ;
+  qformsCopula : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str ;
+
+  qformsVP : PrVerbPhrase -> VAgr -> Str * Str 
+   = \vp,vagr -> vp.qforms ! vagr ;
+
+
   that_Compl : Str = "that" | [] ;
 
   -- this part is usually the same in all reconfigurations

lib/src/experimental/PredInstanceSwe.gf

@@ -105,10 +105,6 @@ oper
       vp.adj ! a ++ vp.c1 ++ vp.obj1.p1 ! a ++ vp.c2 ++ vp.obj2.p1 ! a ++ vp.adv ++ vp.ext ;
 
 
-  qformsV : Str -> STense -> Anteriority -> Polarity -> VAgr -> PrVerb -> Str * Str = 
-    \sta,t,a,p,agr,v -> <[],[]> ; ----- not needed in Swedish
- 
-
   declCl       : PrClause -> Str = \cl -> cl.subj ++ cl.v.p1 ++ cl.adV ++ cl.v.p2 ++ restCl cl ;
   declSubordCl : PrClause -> Str = \cl -> cl.subj ++ cl.adV ++ cl.v.p1 ++ (cl.v.p2 | []) ++ restCl cl ;
   declInvCl    : PrClause -> Str = \cl -> cl.v.p1 ++ cl.subj ++ cl.adV ++ cl.v.p2 ++ restCl cl ;
@@ -185,12 +181,6 @@ oper
   liftV : Verb -> PrVerb = \v ->
     {s = v.s ; p = v.part ; c1,c2 = [] ; isSubjectControl = True ; vtype = v.vtype ; vvtype = vvInfinitive} ; ---- vvtype
 
---- junk
-
-  qformsV : Str -> STense -> Anteriority -> Polarity -> VAgr -> PrVerb -> Str * Str = 
-    \sta,t,a,p,agr,v -> <[],[]> ;
-  qformsCopula : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str = 
-    \sta,t,a,p,agr -> <[],[]> ;
 
 
 }

lib/src/experimental/PredInterface.gf

@@ -99,19 +99,24 @@ oper
   applyVerb : PrVerbPhrase -> VAgr -> Str * Str * Str 
     = \vp,a -> vp.v ! a ;
 
---- only needed in Eng because of do questions
-  qformsV : Str -> STense -> Anteriority -> Polarity -> VAgr -> PrVerb -> Str * Str ;
-  qformsCopula : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str ;
-
-  qformsVP : PrVerbPhrase -> VAgr -> Str * Str 
-   = \vp,vagr -> vp.qforms ! vagr ;
-
 -------------------------------
 --- type synonyms
 -------------------------------
 
 oper
-  PrVerb = {
+  PrVerb = BasePrVerb ;
+  PrVerbPhrase = BasePrVerbPhrase ;
+  PrClause = BasePrClause ;
+  PrQuestionClause = BasePrQuestionClause ;
+
+  initPrVerb = initBasePrVerb ;
+  initPrVerbPhrase = initBasePrVerbPhrase ;
+  initPrVerbPhraseV = initBasePrVerbPhraseV ;
+  initPrClause = initBasePrClause ;
+
+
+
+  BasePrVerb = {
     s  : VForm => Str ;
     p  : Str ;                 -- verb particle             
     c1 : ComplCase ; 
@@ -121,7 +126,7 @@ oper
     vvtype : VVType ;
     } ; 
 
-  initPrVerb : PrVerb = {
+  initBasePrVerb : BasePrVerb = {
     s = \\_ => [] ;
     p = [] ;
     c1 = noComplCase ;
@@ -131,7 +136,7 @@ oper
     vvtype = vvInfinitive ;
     } ;
 
-  PrVerbPhrase = {
+  BasePrVerbPhrase = {
     v : VAgr => Str * Str * Str ;  -- would,have,slept
     inf : VVType => Str ;          -- (not) ((to)(sleep|have slept) | (sleeping|having slept)
     imp : ImpType => Str ;
@@ -145,10 +150,9 @@ oper
     adv : Str ; 
     adV : Str ;
     ext : Str ;
-    qforms : VAgr => Str * Str     -- special Eng for introducing "do" in questions
     } ;
 
-  initPrVerbPhrase : PrVerbPhrase = {
+  initBasePrVerbPhrase : BasePrVerbPhrase = {
     v : VAgr => Str * Str * Str  = \\_ => <[],[],[]> ;
     inf : VVType => Str = \\_ => [] ;
     imp : ImpType => Str = \\_ => [] ;
@@ -162,12 +166,11 @@ oper
     adv : Str = [] ; 
     adV : Str = [] ;
     ext : Str = [] ;
-    qforms : VAgr => Str * Str = \\_ => <[],[]>    -- special Eng for introducing "do" in questions
     } ;
 
-  initPrVerbPhraseV : 
+  initBasePrVerbPhraseV : 
-       {s : Str ; a : Anteriority} -> {s : Str ; t : STense} -> {s : Str ; p : Polarity} -> PrVerb -> PrVerbPhrase = 
+       {s : Str ; a : Anteriority} -> {s : Str ; t : STense} -> {s : Str ; p : Polarity} -> PrVerb -> BasePrVerbPhrase = 
-  \a,t,p,v -> initPrVerbPhrase ** {
+  \a,t,p,v -> initBasePrVerbPhrase ** {
     v   = \\agr => tenseV (a.s ++ t.s ++ p.s) t.t a.a p.p active agr v ;
     inf = \\vt => tenseInfV a.s a.a p.p active v vt ;
     imp = \\it => imperativeV p.s p.p it v ;
@@ -178,10 +181,9 @@ oper
     obj2 = <noObj, v.isSubjectControl> ;
     vvtype = v.vvtype ;
     adV = negAdV p ; --- just p.s in Eng
-    qforms = \\agr => qformsV (a.s ++ t.s ++ p.s) t.t a.a p.p agr v ;
     } ;
  
-  PrClause = {
+  BasePrClause = {
     v : Str * Str * Str ; 
     adj,obj1,obj2 : Str ; 
     adv : Str ; 
@@ -189,25 +191,34 @@ oper
     ext : Str ; 
     subj : Str ; 
     c3  : ComplCase ;              -- for a slashed adjunct, not belonging to the verb valency
-    qforms : Str * Str
     } ; 
 
-  initPrClause : PrClause = {
+  initBasePrClause : BasePrClause = {
     v : Str * Str * Str = <[],[],[]> ; 
     adj,obj1,obj2 : Str = [] ; 
     adv,adV,ext : Str = [] ; 
     subj : Str = [] ; 
     c3  : ComplCase = noComplCase ;              -- for a slashed adjunct, not belonging to the verb valency
-    qforms : Str * Str = <[],[]>
     } ; 
 
-  PrQuestionClause = PrClause ** {
+  BasePrQuestionClause = PrClause ** {
     foc : Str ;                   -- the focal position at the beginning: *who* does she love
     focType : FocusType ;         --- if already filled, then use other place: who loves *who*
     } ; 
 
   PrAdverb = {s : Str ; isAdV : Bool ; c1 : ComplCase} ;
 
+
+  useCopula : {s : Str ; a : Anteriority} -> {s : Str ; t : STense} -> {s : Str ; p : Polarity} -> 
+                 PrVerbPhrase =
+    \a,t,p -> initPrVerbPhrase ** {
+    v   = \\agr => tenseCopula (a.s ++ t.s ++ p.s) t.t a.a p.p agr ;
+    inf = \\vt => tenseInfCopula a.s a.a p.p vt ;
+    imp = \\n => tenseImpCopula p.s p.p n ;
+    adV = negAdV p ;
+    } ;
+
+
   linrefPrVP : PrVerbPhrase -> Str = \vp  -> 
     let 
       agr  = defaultAgr ;
@@ -264,13 +275,4 @@ oper
 
   not_Str : Polarity -> Str ;
 
-  useCopula : {s : Str ; a : Anteriority} -> {s : Str ; t : STense} -> {s : Str ; p : Polarity} -> PrVerbPhrase =
-    \a,t,p -> initPrVerbPhrase ** {
-    v   = \\agr => tenseCopula (a.s ++ t.s ++ p.s) t.t a.a p.p agr ;
-    inf = \\vt => tenseInfCopula a.s a.a p.p vt ;
-    imp = \\n => tenseImpCopula p.s p.p n ;
-    adV = negAdV p ;
-    qforms = \\agr => qformsCopula (a.s ++ t.s ++ p.s) t.t a.a p.p agr ;
-    } ;
-
 }

lib/src/experimental/PredSwe.gf

@@ -19,7 +19,6 @@ lin
         obj1 = vp.part ++ strComplCase vp.c1 ++ vp.obj1.p1 ! rpa ;  ---- apply complCase ---- place of part depends on obj
         obj2 = strComplCase vp.c2 ++ vp.obj2.p1 ! (case vp.obj2.p2 of {True => rpa ; False => vp.obj1.p2}) ;   ---- apply complCase
         c3   = noComplCase ;      -- for one more prep to build ClSlash 
-        qforms = qformsVP vp (agr2vagr rpa) ; 
         }
     in {s = \\a,c => declCl (cl a c) ; c = subjCase} ;