predication Test: top-level grammar with Lexicon and Structural instead of the big Dictionary

lib/src/experimental/Pred.gf

@@ -22,31 +22,34 @@ fun
   PPos, PNeg : Pol ;
   ASimul, AAnter : Ant ;
 
-  UseV           : Ant -> Tense -> Pol -> (a : Arg) -> PrV a       -> PrVP a ;
+  UseV           : (a : Arg) -> Ant -> Tense -> Pol -> PrV a       -> PrVP a ;
-  PassUseV       : Ant -> Tense -> Pol -> (a : Arg) -> PrV (aNP a) -> PrVP a ;
+  PassUseV       : (a : Arg) -> Ant -> Tense -> Pol -> PrV (aNP a) -> PrVP a ;
-  AgentPassUseV  : Ant -> Tense -> Pol -> (a : Arg) -> PrV (aNP a) -> NP -> PrVP a ;
+  AgentPassUseV  : (a : Arg) -> Ant -> Tense -> Pol -> PrV (aNP a) -> NP -> PrVP a ;
-  
-  SlashV2   : (a : Arg) -> PrVP (aNP a)        -> NP    -> PrVP a ;         -- consuming first NP
-  SlashV3   : (a : Arg) -> PrVP (aNP (aNP a))  -> NP    -> PrVP (aNP a) ;   -- consuming second NP
-  ComplVS   : (a : Arg) -> PrVP aS             -> PrCl  a -> PrVP a ;
-  ComplVV   : (a : Arg) -> PrVP aV             -> PrVP  a -> PrVP a ;
-  ComplVQ   : (a : Arg) -> PrVP aQ             -> PrQCl a -> PrVP a ;
-  ComplVA   : (a : Arg) -> PrVP aA             -> PrAP  a -> PrVP a ;
-  ComplVN   : (a : Arg) -> PrVP aN             -> PrCN  a -> PrVP a ;
-  SlashV2S  : (a : Arg) -> PrVP (aNP aS)       -> PrCl a  -> PrVP (aNP a) ;   -- a:Arg gives slash propagation, SlashVS
-  SlashV2V  : (a : Arg) -> PrVP (aNP aV)       -> PrVP a  -> PrVP (aNP a) ;  
-  SlashV2A  : (a : Arg) -> PrVP (aNP aA)       -> PrAP a  -> PrVP (aNP a) ;      
-  SlashV2N  : (a : Arg) -> PrVP (aNP aN)       -> PrCN a  -> PrVP (aNP a) ;      
-  SlashV2Q  : (a : Arg) -> PrVP (aNP aA)       -> PrQCl a -> PrVP (aNP a) ;      
 
-  UseAP : Ant -> Tense -> Pol -> (a : Arg) -> PrAP a -> PrVP a ;
+  ComplV2   : (a : Arg) -> PrVP (aNP a)        -> NP      -> PrVP a ;         -- she loves him
+  ComplVS   : (a : Arg) -> PrVP aS             -> PrCl  a -> PrVP a ;         -- she says that I am here
+  ComplVV   : (a : Arg) -> PrVP aV             -> PrVP  a -> PrVP a ;         -- she wants to sleep
+  ComplVQ   : (a : Arg) -> PrVP aQ             -> PrQCl a -> PrVP a ;         -- she wonders who is here
+  ComplVA   : (a : Arg) -> PrVP aA             -> PrAP  a -> PrVP a ;         -- she becomes old
+  ComplVN   : (a : Arg) -> PrVP aN             -> PrCN  a -> PrVP a ;         -- she becomes a professor
+  SlashV3   : (a : Arg) -> PrVP (aNP (aNP a))  -> NP      -> PrVP (aNP a) ;   -- she shows X to him
+  SlashV2S  : (a : Arg) -> PrVP (aNP aS)       -> PrCl a  -> PrVP (aNP a) ;   -- she tells X that I am here
+  SlashV2V  : (a : Arg) -> PrVP (aNP aV)       -> PrVP a  -> PrVP (aNP a) ;   -- she forces X to sleep
+  SlashV2A  : (a : Arg) -> PrVP (aNP aA)       -> PrAP a  -> PrVP (aNP a) ;   -- she makes X crazy
+  SlashV2N  : (a : Arg) -> PrVP (aNP aN)       -> PrCN a  -> PrVP (aNP a) ;   -- she makes X a professor
+  SlashV2Q  : (a : Arg) -> PrVP (aNP aA)       -> PrQCl a -> PrVP (aNP a) ;   -- she asks X who is here
 
-  PredVP : (a : Arg) -> NP -> PrVP a -> PrCl a ;
+  UseAP     : (a : Arg) -> Ant -> Tense -> Pol -> PrAP a  -> PrVP a ;         -- she is married to X
+  UseAdv    : (a : Arg) -> Ant -> Tense -> Pol -> PrAdv a -> PrVP a ;         -- she is in X
+  UseCN     : (a : Arg) -> Ant -> Tense -> Pol -> PrCN a  -> PrVP a ;         -- she is a member of X
+  UseNP     :              Ant -> Tense -> Pol -> NP      -> PrVP aNone ;     -- she is the person
+
+  PredVP    : (a : Arg) -> NP -> PrVP a -> PrCl a ;
 
   SlashClNP : (a : Arg) -> PrCl (aNP a) -> NP -> PrCl a ;    -- slash consumption: hon tittar på + oss
 
-  ReflVP  : (a : Arg) -> PrVP (aNP a) -> PrVP a ;              -- refl on first position (direct object)
+  ReflVP    : (a : Arg) -> PrVP (aNP a) -> PrVP a ;              -- refl on first position (direct object)
-  ReflVP2 : (a : Arg) -> PrVP (aNP (aNP a)) -> PrVP (aNP a) ;  -- refl on second position (indirect object)
+  ReflVP2   : (a : Arg) -> PrVP (aNP (aNP a)) -> PrVP (aNP a) ;  -- refl on second position (indirect object)
 
   QuestVP    : (a : Arg) -> IP   -> PrVP a         -> PrQCl a ; 
   QuestSlash : (a : Arg) -> IP   -> PrQCl (aNP a)  -> PrQCl a ;
@@ -72,14 +75,14 @@ fun
 
 -- PrVP coordination
 
-  StartVPC : Conj -> (a : Arg) -> PrVP a -> PrVP a  -> VPC a ;
+  StartVPC : (a : Arg) -> Conj -> PrVP a -> PrVP a  -> VPC a ;
-  ContVPC  :         (a : Arg) -> PrVP a -> VPC a -> VPC a ;
+  ContVPC  : (a : Arg)         -> PrVP a -> VPC a   -> VPC a ;
   UseVPC   : (a : Arg) -> VPC a -> PrVP a ;
 
 -- clause coordination, including "she loves and we look at (her)"
-  StartClC : Conj -> (a : Arg) -> PrCl a -> PrCl a  -> ClC a ;
+  StartClC : (a : Arg) -> Conj   -> PrCl a -> PrCl a  -> ClC a ;
-  ContClC  :         (a : Arg) -> PrCl a -> ClC a -> ClC a ;
+  ContClC  : (a : Arg) -> PrCl a -> ClC a  -> ClC a ;
-  UseClC   : (a : Arg) -> ClC a -> PrCl a ;
+  UseClC   : (a : Arg) -> ClC a  -> PrCl a ;
 
   ComplAdv : (a : Arg) -> PrAdv (aNP a) -> NP -> PrAdv a ; -- typically: formation of preposition phrase
 

lib/src/experimental/PredFunctor.gf

@@ -61,7 +61,7 @@ linref
     vp.adj ! agr ++ vp.obj1.p1 ! agr ++ vp.obj2.p1 ! agr ++ vp.adv ++ vp.ext ;
  
   PrCl  = \cl  -> declCl cl ;
-----  PrQCl = \qcl -> questCl (lin PrQCl qcl) ;
+  PrQCl = \qcl -> questCl qcl ;
   PrAdv = \adv -> adv.c1 ++ adv.s ;
   PrAP  = \ap  -> ap.s ! defaultAgr ++ ap.obj1 ! defaultAgr ;  
   PrCN  = \cn  -> cn.s ! Sg ++ cn.obj1 ! defaultAgr ; 
@@ -88,7 +88,7 @@ lin
   aNone, aS, aV, aA, aQ, aN = {s = []} ;
   aNP a = a ;
 
-  UseV a t p _ v = {
+  UseV x a t p v = {
     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 ;
     c1  = v.c1 ;
@@ -104,7 +104,7 @@ lin
     qforms = \\agr => qformsV (a.s ++ t.s ++ p.s) t.t a.a p.p agr v ;
     } ;
 
-  PassUseV a t p _ v = {
+  PassUseV x 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 ;
     c1  = v.c1 ;
@@ -120,7 +120,7 @@ lin
     qforms = \\agr => qformsCopula (a.s ++ t.s ++ p.s) t.t a.a p.p agr ;
     } ;
 
-  AgentPassUseV a t p _ v np = {
+  AgentPassUseV x a t p v np = {
     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 ;
     c1  = v.c1 ;
@@ -136,29 +136,34 @@ lin
     qforms = \\agr => qformsCopula (a.s ++ t.s ++ p.s) t.t a.a p.p agr ;
     } ;
 
-  UseAP a t p _ ap = {
+  UseAP x a t p ap = useCopula a t p ** {
-    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 ;
     c1  = ap.c1 ;
     c2  = ap.c2 ;
-    part = [] ;
     adj = \\a => ap.s ! agr2aagr a ;
     obj1 = <ap.obj1, defaultAgr> ;
-    obj2 = <noObj, True> ; --- there are no A3's
-    vvtype = vvInfinitive ;  ---- should come from AP: "eager to please" - "good at dancing"
-    adV = negAdV p ;
-    adv = [] ;
-    ext = [] ;
-    qforms = \\agr => qformsCopula (a.s ++ t.s ++ p.s) t.t a.a p.p agr ;
     } ;
 
-  SlashV2 x vp np = vp ** {
+  UseCN x a t p cn = useCopula a t p ** {
+    c1  = cn.c1 ;
+    c2  = cn.c2 ;
+    adj = \\a => cn.s ! agr2nagr a ;
+    obj1 = <cn.obj1, defaultAgr> ;
+    } ;
+
+  UseAdv x a t p adv = useCopula a t p ** {
+    c1  = adv.c1 ;
+    adj = \\a => adv.s ;
+    } ;
+
+  UseNP a t p np = useCopula a t p ** {
+    adj = \\a => np.s ! subjCase ;
+    } ;
+
+  ComplV2 x vp np = vp ** {
     obj1 = <\\a => np.s ! objCase, np.a>  -- np.a for object control 
     } ;
 
-  SlashV3 x vp np = addObj2VP vp (\\a => np.s ! objCase) ; -- control is preserved 
+  ComplVS x vp cl = addExtVP vp (that_Compl ++ declSubordCl cl) ; ---- sentence form
-
-  ComplVS x vp cl = addExtVP vp (that_Compl ++ declSubordCl (lin Cl cl)) ; ---- sentence form
 
   ComplVQ x vp qcl = addExtVP vp (questSubordCl qcl) ; ---- question form
 
@@ -168,9 +173,11 @@ lin
 
   ComplVN x vp cn = addObj2VP vp (\\a => cn.s ! agr2nagr a ++ cn.obj1 ! a) ; ---- cnForm
 
-  SlashV2S x vp cl = addExtVP vp (that_Compl ++ declSubordCl (lin Cl cl)) ; ---- sentence form
+  SlashV3 x vp np = addObj2VP vp (\\a => np.s ! objCase) ; -- control is preserved 
 
-  SlashV2Q x vp cl = addExtVP vp (questSubordCl (lin QCl cl)) ; ---- question form
+  SlashV2S x vp cl = addExtVP vp (that_Compl ++ declSubordCl cl) ; ---- sentence form
+
+  SlashV2Q x vp cl = addExtVP vp (questSubordCl cl) ; ---- question form
 
   SlashV2V x vp vpo = addObj2VP vp (\\a => infVP vp.vvtype a (lin VP vpo)) ;
 
@@ -253,7 +260,7 @@ lin
   UseCl  cl = {s = declCl cl} ;
   UseQCl cl = {s = questCl cl} ;
 
-----  UseAdvCl adv cl = {s = adv.s ++ declInvCl cl} ;
+  UseAdvCl adv cl = {s = adv.s ++ declInvCl cl} ;
 
   UttS s = s ;
 
@@ -289,7 +296,7 @@ lin
     obj1 = \\_ => appComplCase agentCase np ; ---- addObj
     } ;
 
-  StartVPC c x v w = {  ---- some loss of quality seems inevitable
+  StartVPC x c v w = {  ---- some loss of quality seems inevitable
     v = \\a => 
           let 
             vv = v.v ! a ; 
@@ -322,7 +329,7 @@ lin
     qforms = \\a => <"do", vpc.inf ! defaultAgr> ; ---- do/does/did
     } ;
 
-  StartClC c x a b = {
+  StartClC x c a b = {
     s  = declCl (lin Cl a) ++ c.s2 ++ declCl (lin Cl b) ;
     c3 = b.c3 ; ---- 
     } ;

lib/src/experimental/PredInstanceSwe.gf

@@ -134,7 +134,7 @@ oper
     \s,a,p,vt -> tenseInfV s a p CommonScand.Act (liftV be_V) vt ;
 
   hava_V : Verb = P.mkV "ha" "har" "ha" "hade" "haft" "havd" ; -- havd not used
-  be_V : Verb = P.mkV "vara" "är" "var" "varit" "varen" "varna" ;
+  be_V : Verb = P.mkV "vara" "är" "var" "var" "varit" "varen" ; -- varen not used
   skola_V : Verb = P.mkV "skola" "ska" "ska" "skulle" "skolat" "skolad" ; ---- not used but ska and skulle
 
   noObj : Agr => Str = \\_ => [] ;

lib/src/experimental/PredInterface.gf

@@ -169,4 +169,21 @@ oper
 
   not_Str : Polarity -> Str ;
 
+  useCopula : {s : Str ; a : Anteriority} -> {s : Str ; t : STense} -> {s : Str ; p : Polarity} -> PrVerbPhrase =
+    \a,t,p -> {
+    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 ;
+    c1 = [] ;
+    c2 = [] ;
+    part = [] ;
+    adj = \\_ => [] ;
+    obj1 = <noObj,defaultAgr> ;
+    obj2 = <noObj, True> ; 
+    vvtype = vvInfinitive ;
+    adV = negAdV p ;
+    adv = [] ;
+    ext = [] ;
+    qforms = \\agr => qformsCopula (a.s ++ t.s ++ p.s) t.t a.a p.p agr ;
+    } ;
+
 }

lib/src/experimental/Test.gf

@@ -0,0 +1,39 @@
+--# -path=.:../translator
+
+abstract Test =
+   RGLBase - [Pol,Tense,MkSymb]
+  ,Pred
+  ,Lexicon - [Pol,Tense]
+  ,Structural - [Pol,Tense]
+
+              ** {
+flags
+  startcat=Phr;
+--  heuristic_search_factor=0.60;
+--  meta_prob=1.0e-5;
+--  meta_token_prob=1.1965149246222233e-9;
+
+fun
+  LiftV  : V  -> PrV aNone ;
+  LiftV2 : V2 -> PrV (aNP aNone) ;
+  LiftVS : VS -> PrV aS ;
+  LiftVQ : VQ -> PrV aQ ;
+  LiftVV : VV -> PrV aV ;
+  LiftVA : VA -> PrV aA ;
+  LiftVN : VA -> PrV aN ; ----
+
+  LiftV3  : V3  -> PrV (aNP (aNP aNone)) ;
+  LiftV2S : V2S -> PrV (aNP aS) ;
+  LiftV2Q : V2Q -> PrV (aNP aQ) ;
+  LiftV2V : V2V -> PrV (aNP aV) ;
+  LiftV2A : V2A -> PrV (aNP aA) ;
+  LiftV2N : V2A -> PrV (aNP aN) ; ----
+
+  LiftAP  : AP  -> PrAP aNone ;
+  LiftCN  : CN  -> PrCN aNone ;
+
+  LiftAdv  : Adv  -> PrAdv aNone ;
+  LiftAdV  : AdV  -> PrAdv aNone ;
+  LiftPrep : Prep -> PrAdv (aNP aNone) ;
+
+}

lib/src/experimental/TestEng.gf

@@ -0,0 +1,39 @@
+concrete TestEng of Test =
+   RGLBaseEng - [Pol,Tense,MkSymb]
+  ,PredEng
+  ,LexiconEng - [Pol,Tense]
+  ,StructuralEng - [Pol,Tense]
+
+              ** open ResEng, PredInstanceEng, Prelude, (Pr = PredEng) in {
+
+--flags literal=Symb ;
+
+oper
+  liftV : ResEng.Verb -> Pr.PrV = \v -> lin PrV {s = v.s ; p = v.p ; c1,c2 = [] ; isSubjectControl = False ; vtype = VTAct ; vvtype = VVInf} ;
+
+lin
+  LiftV  v = liftV v ;
+  LiftV2 v = liftV v ** {c1 = v.c2} ;
+  LiftVS v = liftV v ;
+  LiftVQ v = liftV v ;
+  LiftVA v = liftV v ; ---- c1?
+  LiftVN v = liftV v ; ---- c1?
+  LiftVV v = {s = \\f => v.s ! VVF f ; p = v.p ; c1,c2 = [] ; isSubjectControl = False ; vtype = VTAct ; vvtype = VVInf} ; ---- c1? ---- VVF
+
+  LiftV3  v = liftV v ** {c1 = v.c2 ; c2 = v.c3} ;
+  LiftV2S v = liftV v ** {c1 = v.c2} ;
+  LiftV2Q v = liftV v ** {c1 = v.c2} ;
+  LiftV2V v = liftV v ** {c1 = v.c2 ; c2 = v.c3 ; isSubjectControl = False ; vvtype = v.typ} ; ---- subj control should be defined in V2V
+  LiftV2A v = liftV v ** {c1 = v.c2} ;
+  LiftV2N v = liftV v ** {c1 = v.c2} ;
+
+
+  LiftAP ap = ap ** {c1,c2 = [] ; obj1 = \\_ => []} ;  --- isPre
+  LiftCN cn = {s = \\n => cn.s ! n ! Nom ; c1,c2 = [] ; obj1 = \\_ => []} ; 
+
+  LiftAdv  a = a ** {isAdV = False ; c1 = []} ;
+  LiftAdV  a = a ** {isAdV = True ; c1 = []} ;
+  LiftPrep p = {s = [] ; isAdV = False ; c1 = p.s} ;
+
+
+}

lib/src/experimental/TestSwe.gf

@@ -0,0 +1,41 @@
+--# -path=.:../translator
+
+concrete TestSwe of Test =
+   RGLBaseSwe - [Pol,Tense,MkSymb]
+  ,PredSwe
+  ,LexiconSwe - [Pol,Tense]
+  ,StructuralSwe - [Pol,Tense]
+
+              ** open CommonScand, ResSwe, PredInstanceSwe, Prelude in {
+
+--flags literal=Symb ;
+
+oper
+  liftV = PredInstanceSwe.liftV ;
+
+lin
+  LiftV  v = liftV v ;
+  LiftV2 v = <liftV <v : Verb> : PrVerb> ** {c1 = v.c2.s} ;
+  LiftVS v = liftV v ;
+  LiftVQ v = liftV v ;
+  LiftVA v = liftV v ; ---- c1?
+  LiftVN v = liftV v ; ---- c1?
+  LiftVV v = <liftV <v : Verb> : PrVerb> ** {c1 = v.c2.s} ;
+
+  LiftV3  v = <liftV <v : Verb> : PrVerb> ** {c1 = v.c2.s ; c2 = v.c3.s} ;
+
+  LiftV2S v = <liftV <v : Verb> : PrVerb> ** {c1 = v.c2.s} ;
+  LiftV2Q v = <liftV <v : Verb> : PrVerb> ** {c1 = v.c2.s} ;
+  LiftV2V v = <liftV <v : Verb> : PrVerb> ** {c1 = v.c2.s ; c2 = v.c3.s} ;
+  LiftV2A v = <liftV <v : Verb> : PrVerb> ** {c1 = v.c2.s} ;
+  LiftV2N v = <liftV <v : Verb> : PrVerb> ** {c1 = v.c2.s} ;
+
+  LiftAP ap = {s = \\a => ap.s ! agr2aformpos a ; c1,c2 = [] ; obj1 = \\_ => []} ;  --- isPre
+  LiftCN cn = {s = \\n => cn.s ! n ! DIndef ! Nom ; c1,c2 = [] ; obj1 = \\_ => []} ; 
+
+  LiftAdv  a = a ** {isAdV = False ; c1 = []} ;
+  LiftAdV  a = a ** {isAdV = True ; c1 = []} ;
+  LiftPrep p = {s = [] ; isAdV = False ; c1 = p.s} ;
+
+}
+

lib/src/experimental/TransSwe.gf

@@ -5,7 +5,7 @@ concrete TransSwe of Trans =
   ,PredSwe
   ,DictionarySwe - [Pol,Tense]
 
-              ** open ResSwe, PredInstanceSwe, Prelude in {
+              ** open CommonScand, ResSwe, PredInstanceSwe, Prelude in {
 
 flags 
   literal=Symb ;
@@ -23,21 +23,19 @@ lin
   LiftVV v = <liftV <v : Verb> : PrVerb> ** {c1 = v.c2.s} ;
 
   LiftV3  v = <liftV <v : Verb> : PrVerb> ** {c1 = v.c2.s ; c2 = v.c3.s} ;
-{-
-  LiftV2S v = liftV v ** {c1 = v.c2} ;
-  LiftV2Q v = liftV v ** {c1 = v.c2} ;
-  LiftV2V v = liftV v ** {c1 = v.c2 ; c2 = v.c3 ; isSubjectControl = False ; vvtype = v.typ} ; ---- subj control should be defined in V2V
-  LiftV2A v = liftV v ** {c1 = v.c2} ;
-  LiftV2N v = liftV v ** {c1 = v.c2} ;
--}
 
-----  LiftAP ap = ap ** {c1,c2 = [] ; obj1 = \\_ => []} ;  --- isPre
+  LiftV2S v = <liftV <v : Verb> : PrVerb> ** {c1 = v.c2.s} ;
-----  LiftCN cn = {s = \\n => cn.s ! n ! Nom ; c1,c2 = [] ; obj1 = \\_ => []} ; 
+  LiftV2Q v = <liftV <v : Verb> : PrVerb> ** {c1 = v.c2.s} ;
+  LiftV2V v = <liftV <v : Verb> : PrVerb> ** {c1 = v.c2.s ; c2 = v.c3.s} ;
+  LiftV2A v = <liftV <v : Verb> : PrVerb> ** {c1 = v.c2.s} ;
+  LiftV2N v = <liftV <v : Verb> : PrVerb> ** {c1 = v.c2.s} ;
+
+  LiftAP ap = {s = \\a => ap.s ! agr2aformpos a ; c1,c2 = [] ; obj1 = \\_ => []} ;  --- isPre
+  LiftCN cn = {s = \\n => cn.s ! n ! DIndef ! Nom ; c1,c2 = [] ; obj1 = \\_ => []} ; 
 
   LiftAdv  a = a ** {isAdV = False ; c1 = []} ;
   LiftAdV  a = a ** {isAdV = True ; c1 = []} ;
   LiftPrep p = {s = [] ; isAdV = False ; c1 = p.s} ;
 
-
 }