relatives and imperatives in Pred Eng and Swe

lib/src/experimental/Pred.gf

@@ -1,4 +1,4 @@
-abstract Pred = Cat [Ant,NP,Utt,IP,IAdv,Conj,RS,Imp,IComp] ** {
+abstract Pred = Cat [Ant,NP,Utt,IP,IAdv,Conj,RS,RP] ** {
 
 cat
   Arg ;
@@ -78,8 +78,8 @@ fun
 
 -- imperatives
 
-  ImpVP    : PrVP aNone -> Imp ;
+  PrImpSg : PrVP aNone -> Utt ;
-  
+  PrImpPl : PrVP aNone -> Utt ;  
 
 -- participles as adjectives
 

lib/src/experimental/PredEng.gf

@@ -1,4 +1,4 @@
 concrete PredEng of Pred = 
-  CatEng [Ant,NP,Utt,IP,IAdv,Conj] ** 
+  CatEng [Ant,NP,Utt,IP,IAdv,Conj,RP,RS,Imp] ** 
     PredFunctor with 
       (PredInterface = PredInstanceEng) ;

lib/src/experimental/PredFunctor.gf

@@ -1,4 +1,4 @@
-incomplete concrete PredFunctor of Pred = Cat [Ant,NP,Utt,IP,IAdv,Conj] ** 
+incomplete concrete PredFunctor of Pred = Cat [Ant,NP,Utt,IP,IAdv,Conj,RP,RS] ** 
   open 
     PredInterface,
     ParamX,
@@ -221,6 +221,30 @@ lin
       } ;
 -}
 
+  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} ;
+
+  RelSlash rp cl = {
+    s = \\a => rp.s ! subjRPCase (rpagr2agr rp.a a) ++ declCl cl ; ---- rp case 
+    c = objCase
+    } ;
+
+  PrImpSg vp = {s = impVP Sg vp} ;
+  PrImpPl vp = {s = impVP Pl vp} ;
+
   UseCl  cl = {s = declCl cl} ;
   UseQCl cl = {s = questCl cl} ;
 

lib/src/experimental/PredInstanceEng.gf

@@ -15,6 +15,7 @@ oper
   
   VAgr = EVAgr ;
   VType = EVType ; 
+
 param  --- have to do this clumsy way because param P and oper P : PType don't unify
   EVAgr  = VASgP1 | VASgP3 | VAPl ;
   EVType = VTAct | VTRefl | VTAux ;
@@ -40,8 +41,12 @@ oper
 
   noObj : Agr => Str = \\_ => [] ;
 
+  RPCase = ResEng.RCase ; 
+  subjRPCase : Agr -> RPCase = \a -> RC (fromAgr a).g npNom ;
+
   NAgr = Number ;
   IPAgr = Number ;
+  RPAgr = ResEng.RAgr ;
 
   defaultAgr : Agr = AgP3Sg Neutr ;
 
@@ -72,6 +77,11 @@ oper
     Pl => VAPl
     } ;
 
+  rpagr2agr : RPAgr -> Agr -> Agr = \ra,a -> case ra of {
+    RAg ag => ag ;
+    RNoAg => a
+    } ;
+
 --- this is only needed in VPC formation
   vagr2agr : VAgr -> Agr = \a -> case a of {
     VASgP1 => AgP1 Sg ;
@@ -100,6 +110,13 @@ oper
       vp.adV ++ vp.inf ! vt ++ vp.part ++
       vp.adj ! a ++ vp.c1 ++ vp.obj1.p1 ! a ++ vp.c2 ++ vp.obj2.p1 ! a2 ++ vp.adv ++ vp.ext ;
 
+  impVP : Number -> PrVerbPhrase -> Str = \n,vp ->
+    let
+      a = AgP2 n
+    in 
+      vp.adV ++ vp.imp ! n ++ vp.part ++
+      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 -> 
     let 
@@ -221,6 +238,13 @@ oper
           }
      } ;
 
+  imperativeV : Str -> Polarity -> ImpType -> PrVerb -> Str = \s,p,it,v -> 
+    s ++ case p of {
+      Pos => v.s ! VInf ;
+      Neg => ("do not" | "don't") ++ v.s ! VInf
+      } ;
+
+
 ----- dangerous variants for PMCFG generation - keep apart as long as possible
   be_Aux : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str * Str = \sta,t,a,p,agr -> 
     be_AuxL sta t a p agr | be_AuxC sta t a p agr ; 

lib/src/experimental/PredInstanceSwe.gf

@@ -36,8 +36,12 @@ oper
 
   noObj : Agr => Str = \\_ => [] ;
 
+  RPCase = CommonScand.RCase ; 
+  subjRPCase : Agr -> RPCase = \a -> RNom ;
+
   NAgr = Number ; --- only Indef Nom forms are needed here
   IPAgr = Number ; ----{g : Gender ; n : Number} ; --- two separate fields in RGL
+  RPAgr = RAgr ;
 
   defaultAgr : Agr = {g = Utr ; n = Sg ; p = P3} ;
 
@@ -60,6 +64,11 @@ oper
 
   ipagr2vagr : IPAgr -> VAgr = \n -> UUnit ;
 
+  rpagr2agr : RPAgr -> Agr -> Agr = \ra,a -> case ra of {
+    RAg g n p => {g = g ; n = n ; p = p} ;
+    RNoAg => a
+    } ;
+
 --- this is only needed in VPC formation
   vagr2agr : VAgr -> Agr = \a -> defaultAgr ;
 
@@ -85,6 +94,14 @@ oper
       vp.adV ++ vp.inf ! UUnit ++ 
       vp.adj ! a ++ vp.c1 ++ vp.obj1.p1 ! a ++ vp.c2 ++ vp.obj2.p1 ! a2 ++ vp.adv ++ vp.ext ;
 
+  impVP : Number -> PrVerbPhrase -> Str = \n,vp ->
+    let
+      a = {g = Utr ; n = n ; p = P2}
+    in 
+      vp.imp ! n ++ vp.part ++  ---- AdV contains inte
+      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
  
@@ -131,6 +148,12 @@ oper
       Anter => hava_V.s ! VI (VInfin CommonScand.Act) ++ sa ++ v.s ! VI (VSupin o)    -- hon vill (ha) sovit ---- discont?
       } ;
 
+  imperativeV : Str -> Polarity -> ImpType -> PrVerb -> Str = \s,p,it,v -> 
+    s ++ case p of {
+      Pos => v.s ! VF (VImper CommonScand.Act) ;   ---- deponents
+      Neg => v.s ! VF (VImper CommonScand.Act) ++ inte_Str
+      } ;
+
   tenseCopula : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str * Str =
     \s,t,a,p,_ -> tenseV s t a p CommonScand.Act UUnit (liftV be_V) ;
   tenseInfCopula : Str -> Anteriority -> Polarity -> VVType -> Str =

lib/src/experimental/PredInterface.gf

@@ -13,6 +13,8 @@ oper
   STense : PType = X.Tense ;
   SVoice : PType ;
 
+  ImpType : PType = Number ;
+
 param
   Voice = Act | Pass ;  --- should be in ParamX
   Unit = UUnit ;        --- should be in Prelude
@@ -57,9 +59,13 @@ oper
 
   noObj : Agr => Str = \\_ => [] ;
 
+  RPCase : PType ;
+  subjRPCase : Agr -> RPCase ;
+
   NAgr : PType ;
   AAgr = Agr ;  -- because of reflexives: "happy with itself"
-  IPAgr : PType ;
+  IPAgr : PType ; -- agreement of IP
+  RPAgr : PType ; -- agreement of RP
 
   defaultAgr : Agr ;
 
@@ -72,6 +78,7 @@ oper
 -- restoring full Agr
   ipagr2agr  : IPAgr -> Agr ;
   ipagr2vagr : IPAgr -> VAgr ;
+  rpagr2agr  : RPAgr -> Agr -> Agr ; -- the agr can come from the RP itself or from above
 
 --- this is only needed in VPC formation
   vagr2agr : VAgr -> Agr ;
@@ -122,6 +129,7 @@ oper
   PrVerbPhrase = {
     v : VAgr => Str * Str * Str ;  -- would,have,slept
     inf : VVType => Str ;          -- (not) ((to)(sleep|have slept) | (sleeping|having slept)
+    imp : ImpType => Str ;
     c1 : ComplCase ; 
     c2 : ComplCase ; 
     part  : Str ;                  -- (look) up
@@ -138,6 +146,7 @@ oper
   initPrVerbPhrase : PrVerbPhrase = {
     v : VAgr => Str * Str * Str  = \\_ => <[],[],[]> ;
     inf : VVType => Str = \\_ => [] ;
+    imp : ImpType => Str = \\_ => [] ;
     c1 : ComplCase = noComplCase ; 
     c2 : ComplCase = noComplCase ; 
     part  : Str = [] ;                  -- (look) up
@@ -156,6 +165,7 @@ oper
   \a,t,p,v -> initPrVerbPhrase ** {
     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 ;
     c1  = v.c1 ;
     c2  = v.c2 ;
     part = v.p ;
@@ -218,10 +228,14 @@ oper
 
   infVP : VVType -> Agr -> PrVerbPhrase -> Str ;
 
+  impVP : Number -> PrVerbPhrase -> Str ;
+
   tenseV : Str -> STense -> Anteriority -> Polarity -> SVoice -> VAgr -> PrVerb -> Str * Str * Str ;
 
   tenseInfV : Str -> Anteriority -> Polarity -> SVoice -> PrVerb -> VVType -> Str ;
 
+  imperativeV : Str -> Polarity -> ImpType -> PrVerb -> Str ;
+
   tenseCopula : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str * Str ;
   tenseInfCopula : Str -> Anteriority -> Polarity -> VVType -> Str ;
 

lib/src/experimental/PredSwe.gf

@@ -1,4 +1,31 @@
 concrete PredSwe of Pred = 
-  CatSwe [Ant,NP,Utt,IP,IAdv,Conj] ** 
+  CatSwe [Ant,NP,Utt,IP,IAdv,Conj,RP,RS,Imp] ** 
-    PredFunctor with 
+    PredFunctor - [RelVP,RelSlash]  ---- incompatible arity: to be fixed in RGL
-      (PredInterface = PredInstanceSwe) ;
+    with 
+      (PredInterface = PredInstanceSwe) 
+
+** open ResSwe, CommonScand in {
+
+lin
+  RelVP rp vp = 
+    let 
+      cl : Agr -> RCase -> PrClause = \a,c -> 
+        let rpa = rpagr2agr rp.a a in
+        
+        vp ** {
+        v    = applyVerb vp (agr2vagr rpa) ;
+        subj = rp.s ! a.g ! a.n ! 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,c => declCl (cl a c) ; c = subjCase} ;
+
+  RelSlash rp cl = {
+    s = \\a,c => rp.s ! a.g ! a.n ! subjRPCase (rpagr2agr rp.a a) ++ declCl cl ; ---- rp case 
+    c = objCase
+    } ;
+
+}