Merge branch 'GrammaticalFramework:master' into master

src/estonian/AdjectiveEst.gf

@@ -11,15 +11,15 @@ concrete AdjectiveEst of Adjective = CatEst ** open ResEst, Prelude in {
       } ;
     ComparA a np = {
       s = \\isMod,af => case isMod of {
-        True => np.s ! NPCase Elat ++ a.s ! Compar ! AN af ;        -- minust suurem
+        True => linNP (NPCase Elat) np ++ a.s ! Compar ! AN af ;        -- minust suurem
-        _    => a.s ! Compar ! AN af ++ "kui" ++ np.s ! NPCase Nom  -- suurem kui mina
+        _    => a.s ! Compar ! AN af ++ "kui" ++ linNP (NPCase Nom) np  -- suurem kui mina
         } ;
       infl = Regular ; --a.infl
       } ;
-      
+
     CAdvAP ad ap np = {
-      s = \\m,af => ad.s ++ ap.s ! m ! af ++ ad.p ++ np.s ! NPCase Nom ;
+      s = \\m,af => ad.s ++ ap.s ! m ! af ++ ad.p ++ linNP (NPCase Nom) np ;
-      infl = ap.infl 
+      infl = ap.infl
       } ;
     UseComparA a = {
       s = \\_,nf => a.s ! Compar ! AN nf ;
@@ -34,14 +34,14 @@ concrete AdjectiveEst of Adjective = CatEst ** open ResEst, Prelude in {
 
 
     ComplA2 adj np = {
-      s = \\isMod,af => 
+      s = \\isMod,af =>
           preOrPost isMod (appCompl True Pos adj.c2 np) (adj.s ! Posit ! AN af) ;
       infl = adj.infl
       } ;
 
     ReflA2 adj = {
-      s = \\isMod,af => 
+      s = \\isMod,af =>
-          preOrPost isMod 
+          preOrPost isMod
             (appCompl True Pos adj.c2 (reflPron (agrP3 Sg))) (adj.s ! Posit ! AN af) ;
       infl = adj.infl
       } ;

src/estonian/AdverbEst.gf

@@ -5,13 +5,13 @@ concrete AdverbEst of Adverb = CatEst ** open ResEst, Prelude in {
   lin
     PositAdvAdj a = {s = a.s ! Posit ! AAdv} ;
     ComparAdvAdj cadv a np = {
-      s = cadv.s ++ a.s ! Posit ! AAdv ++ cadv.p ++ np.s ! NPCase Nom
+      s = cadv.s ++ a.s ! Posit ! AAdv ++ cadv.p ++ linNP (NPCase Nom) np
       } ;
     ComparAdvAdjS cadv a s = {
       s = cadv.s ++ a.s ! Posit ! AAdv ++ cadv.p ++ s.s
       } ;
 
-    PrepNP prep np = {s = preOrPost prep.isPre prep.s (np.s ! prep.c)} ;
+    PrepNP prep np = {s = appCompl True Pos prep np} ;
 
     AdAdv = cc2 ;
 

src/estonian/AllEst.gf

@@ -1,6 +1,6 @@
 --# -path=.:../abstract:../common:../prelude:../api
 
-concrete AllEst of AllEstAbs = 
+concrete AllEst of AllEstAbs =
   LangEst, --  - [SlashV2VNP,SlashVV, TFut], ---- to speed up linking; to remove spurious parses
   ExtendEst -- - [ProDrop, ProDropPoss, S_OSV, S_VSO, S_ASV] -- to exclude spurious parses
   **

src/estonian/AllEstAbs.gf

@@ -1,4 +1,4 @@
-abstract AllEstAbs = 
+abstract AllEstAbs =
   Lang,
   ExtraEstAbs
   ** {} ;

src/estonian/CatEst.gf

@@ -20,43 +20,38 @@ concrete CatEst of Cat = CommonX ** open HjkEst, ResEst, Prelude in {
 -- Question
 
     QCl    = {s : ResEst.Tense => Anteriority => Polarity => Str} ;
-    IP     = {s : NPForm => Str ; n : Number} ;
+    IP     = ResEst.IPhrase ;
-    IComp  = {s : Agr => Str} ; 
+    IComp  = {s : Agr => Str} ;
     IDet   = {s : Case => Str ; n : Number ; isNum : Bool} ;
     IQuant = {s : Number => Case => Str} ;
 
 -- Relative
 
     RCl   = {s : ResEst.Tense => Anteriority => Polarity => Agr => Str ; c : NPForm} ;
-    RP    = {s : Number => NPForm => Str ; a : RAgr} ;
+    RP    = ResEst.RelPron ;
 
 -- Verb
 
     VP   = ResEst.VP ;
-    VPSlash = ResEst.VP ** {c2 : Compl} ; 
+    VPSlash = ResEst.VP ** {c2 : Compl} ;
-    Comp = {s : Agr => Str} ; 
+    Comp = {s : Agr => Str} ;
 
 -- Adjective
 
 -- The $Bool$ in s tells whether usage is modifying (as opposed to
 -- predicative), e.g. "x on suurem kui y" vs. "y:st suurem arv".
--- The $Infl$ in infl tells whether the adjective inflects as a 
+-- The $Infl$ in infl tells whether the adjective inflects as a
 -- modifier: e.g. "väsinud mehele" vs. "mees muutus väsinuks".
 
-    AP = {s : Bool => NForm => Str ; infl : Infl} ; 
+    AP = ResEst.APhrase ;
 
 -- Noun
 
-    CN   = {s : NForm => Str} ;
+    CN   = ResEst.CNoun ;
     Pron = {s : NPForm => Str ; a : Agr} ;
-    NP   = {s : NPForm => Str ; a : Agr ; isPron : Bool} ;
+    NP   = ResEst.NPhrase ;
-    Det  = {
+    DAP, Det = ResEst.Determiner ;
-      s : Case => Str ;       -- minun kolme
+
-      sp : Case => Str ;       -- se   (substantival form)
-      n : Number ;             -- Pl   (agreement feature for verb)
-      isNum : Bool ;           -- True (a numeral is present)
-      isDef : Bool             -- True (verb agrees in Pl, Nom is not Part) --I: actually, can we get rid of this? 
-      } ;
 ----    QuantSg, QuantPl = {s : Case => Str ;  isDef : Bool} ;
     Ord    = {s : NForm => Str} ;
     Predet = {s : Number => NPForm => Str} ;
@@ -74,26 +69,37 @@ concrete CatEst of Cat = CommonX ** open HjkEst, ResEst, Prelude in {
     Conj = {s1,s2 : Str ; n : Number} ;
 ----b    DConj = {s1,s2 : Str ; n : Number} ;
     Subj = {s : Str} ;
-    Prep = Compl ;
+    Prep = ResEst.Compl ;
 
 -- Open lexical classes, e.g. Lexicon
 
-    V, VS, VQ = Verb1 ; -- = {s : VForm => Str ; sc : Case} ;
+    V, VS, VQ = ResEst.Verb1 ; -- = {s : VForm => Str ; sc : Case} ;
-    V2, VA, V2Q, V2S = Verb1 ** {c2 : Compl} ;
+    V2, VA, V2Q, V2S = ResEst.Verb2 ;
-    V2A = Verb1 ** {c2, c3 : Compl} ;
+    V2A, V3 = ResEst.Verb3 ;
-    VV = Verb1 ** {vi : InfForm} ; ---- infinitive form
+    VV  = ResEst.Verb1 ** {vi : InfForms} ;
-    V2V = Verb1 ** {c2 : Compl ; vi : InfForm} ; ---- infinitive form
+    V2V = ResEst.Verb2 ** {vi : InfForms} ;
-    V3 = Verb1 ** {c2, c3 : Compl} ;
 
-    A  = Adjective ** {infl : Infl} ;
+    A  = ResEst.Adjective ** {infl : Infl} ;
-    A2 = A ** {c2 : Compl} ;
+    A2 = ResEst.Adjective ** {infl : Infl ; c2 : Compl} ;
 
-    N  = Noun  ;
+    N  = ResEst.Noun  ;
-    N2 = Noun ** {c2 : Compl ; isPre : Bool ; lock_N2 : {}} ;
+    N2 = ResEst.Noun ** {
-    N3 = Noun ** {c2,c3 : Compl ; isPre,isPre2 : Bool ; lock_N3 : {}} ;
+            postmod : Str ; -- postmod, because N2 can come from N3+complement via ComplN3
+            c2 : Compl ;
+            isPre : Bool} ;
+    N3 = ResEst.Noun ** {   -- no postmod, because N3 can only come from lexical funs
+            c2,c3 : Compl ;
+            isPre,isPre2 : Bool
+            } ;
     PN = {s : Case  => Str} ;
 
-oper Verb1 = Verb ** { sc : NPForm} ; --what is this for? --subject case, i.e. "ma näen kassi"/"mul on kass"
+  linref
+    VP = \vp -> linV vp.v ;
+    NP = linNP (NPCase Nom) ;
+    CN = linCN (NCase Sg Nom) ;
+    V,VS,VQ = linV ;
+    V2,VA,V2S,V2Q = linV2 ;
+
 
 
 }

src/estonian/ConjunctionEst.gf

@@ -9,11 +9,12 @@ concrete ConjunctionEst of Conjunction =
 
     ConjAdv = conjunctDistrSS ;
 
-    ConjCN = conjunctDistrTable NForm ;
+    ConjCN conj ss = conjunctDistrTable NForm conj ss ** ss ;
 
     ConjNP conj ss = conjunctDistrTable NPForm conj ss ** {
       a = conjAgr (Ag conj.n P3) ss.a ; -- P3 is the maximum
-      isPron = False
+      isPron = False ;
+      postmod = ss.postmod
       } ;
 
     ConjAP conj ss = conjunctDistrTableAdj conj ss ;
@@ -28,20 +29,20 @@ concrete ConjunctionEst of Conjunction =
     ConsS = consrSS comma ;
     BaseAdv = twoSS ;
     ConsAdv = consrSS comma ;
-    BaseCN = twoTable NForm ;
+    BaseCN x y = twoTable NForm (mergeCN x) y ** {postmod = y.postmod} ;
-    ConsCN = consrTable NForm comma ;
+    ConsCN x xs = consrTable NForm comma (mergeCN x) xs ** xs ;
-    BaseNP x y = twoTable NPForm x y ** {a = conjAgr x.a y.a} ;
+    BaseNP x y = twoTable NPForm (mergeNP x) y ** {a = conjAgr x.a y.a ; postmod = y.postmod} ;
-    ConsNP xs x = consrTable NPForm comma xs x ** {a = conjAgr xs.a x.a} ;
+    ConsNP x xs = consrTable NPForm comma (mergeNP x) xs ** {a = conjAgr xs.a x.a ; postmod = xs.postmod} ;
     BaseAP x y = twoTableAdj x y ;
-    ConsAP xs x = consrTableAdj comma x xs ;
+    ConsAP x xs = consrTableAdj comma x xs ;
     BaseRS x y = twoTable Agr x y ** {c = y.c} ;
-    ConsRS xs x = consrTable Agr comma xs x ** {c = xs.c} ;
+    ConsRS x xs = consrTable Agr comma x xs ** {c = xs.c} ;
 
   lincat
     [S] = {s1,s2 : Str} ;
     [Adv] = {s1,s2 : Str} ;
-    [CN] = {s1,s2 : NForm => Str} ;
+    [CN] = {s1,s2 : NForm => Str ; postmod : Str} ;
-    [NP] = {s1,s2 : NPForm => Str ; a : Agr} ;
+    [NP] = {s1,s2 : NPForm => Str ; a : Agr ; postmod : Str} ;
     [AP] = {s1,s2 : {s : Bool => NForm => Str ; infl : Infl }} ;
     [RS] = {s1,s2 : Agr => Str ; c : NPForm} ;
 
@@ -53,7 +54,7 @@ concrete ConjunctionEst of Conjunction =
       s2 = y
     } ;
 
-    consrTableAdj : Str -> [AP] -> {s : Bool => NForm => Str ; infl : Infl} -> [AP] = \c,xs,x ->
+    consrTableAdj : Str -> APhrase -> [AP] -> [AP] = \c,x,xs ->
       let
         ap1 = xs.s1 ;
         ap2 = xs.s2
@@ -74,7 +75,6 @@ concrete ConjunctionEst of Conjunction =
                   } ;
               infl = Regular } ;
        s2 = x ;
-       lock_ListAP = <>
       } ;
 
 
@@ -102,4 +102,7 @@ concrete ConjunctionEst of Conjunction =
               infl = Regular
              } ;
 
+    -- for CN and NP with discontinuous fields, put all stuff in s field
+    mergeNP : NPhrase -> NPhrase = \np -> np ** {s = \\c => linNP c np} ;
+    mergeCN : CNoun -> CNoun = \cn -> cn ** {s = \\nf => linCN nf cn} ;
 }

src/estonian/ConstructionEst.gf

@@ -1,6 +1,6 @@
 --# -path=alltenses:.:../abstract:../api:../common
 
-concrete ConstructionEst of Construction = CatEst ** 
+concrete ConstructionEst of Construction = CatEst **
   open SyntaxEst, SymbolicEst, ParadigmsEst, (L = LexiconEst), (E = ExtraEst), (R = ResEst), Prelude  in {
 flags coding=utf8 ;
 
@@ -12,7 +12,7 @@ lin
   ill_VP = mkVP (mkA "haige") ;
   ready_VP = mkVP (ParadigmsEst.mkA "valmis") ;
 
-  has_age_VP card = 
+  has_age_VP card =
     let n_years_AdA : AdA = lin AdA (mkUtt (lin NP (mkNP <lin Card card : Card> L.year_N)))
     in  mkVP (mkAP n_years_AdA L.old_A) ;
 
@@ -25,7 +25,7 @@ lin
 
 -- some more things
   weather_adjCl ap = mkCl (mkVP (lin AP ap)) ;
-   
+
   is_right_VP = mkVP have_V2 (lin NP (mkNP (ParadigmsEst.mkN "õigus"))) ;
   is_wrong_VP = mkVP (ParadigmsEst.mkV "eksima") ;
 
@@ -37,7 +37,7 @@ lin
 
   where_go_QCl np = mkQCl (lin IAdv (ss "kuhu")) (mkCl np (mkVP L.go_V)) ;
   where_come_from_QCl np =  mkQCl (lin IAdv (ss "kust")) (mkCl np (mkVP L.come_V)) ;
-  
+
   go_here_VP = mkVP (mkVP L.go_V) (mkAdv "siia") ;
   come_here_VP = mkVP (mkVP L.come_V) (mkAdv "siia") ;
   come_from_here_VP = mkVP (mkVP L.come_V) (mkAdv "sealt") ;
@@ -61,16 +61,16 @@ lin
 
   monthAdv m = SyntaxEst.mkAdv in_Prep (mkNP m) ;
   yearAdv y = SyntaxEst.mkAdv (prePrep nominative "aastal") y ;
-----  dayMonthAdv d m = ParadigmsEst.mkAdv (d.s ! R.NPCase R.Nom ++ BIND ++ "." ++ m.s ! R.NCase R.Sg R.Part) ;  
+----  dayMonthAdv d m = ParadigmsEst.mkAdv (d.s ! R.NPCase R.Nom ++ BIND ++ "." ++ m.s ! R.NCase R.Sg R.Part) ;
 ----  monthYearAdv m y = SyntaxEst.mkAdv in_Prep (mkNP (mkNP m) (SyntaxEst.mkAdv (casePrep nominative) y)) ;
-----  dayMonthYearAdv d m y = 
+----  dayMonthYearAdv d m y =
-----    lin Adv {s = d.s ! R.NPCase R.Nom ++ BIND ++ "." ++ m.s ! R.NCase R.Sg R.Part ++ y.s ! R.NPCase R.Nom} ;  
+----    lin Adv {s = d.s ! R.NPCase R.Nom ++ BIND ++ "." ++ m.s ! R.NCase R.Sg R.Part ++ y.s ! R.NPCase R.Nom} ;
 
   intYear = symb ;
   intMonthday = symb ;
 
 oper
-  pointWeekday : Weekday -> Str = \w -> (SyntaxEst.mkAdv (casePrep essive) (mkNP w.noun)).s ; 
+  pointWeekday : Weekday -> Str = \w -> (SyntaxEst.mkAdv (casePrep essive) (mkNP w.noun)).s ;
 
 lincat Language = N ;
 
@@ -86,11 +86,11 @@ lin
 
 oper mkLanguage : Str -> N = \s -> mkN (s ++ "keel") ;
 
-oper mkWeekday : Str -> Weekday = \d -> 
+oper mkWeekday : Str -> Weekday = \d ->
       lin Weekday {
-       noun = mkN d ; 
+       noun = mkN d ;
        habitual = ParadigmsEst.mkAdv (d + "iti") ; --kolmapäeviti
-      } ; 
+      } ;
 
 
 lin monday_Weekday = mkWeekday "esmaspäev" ;
@@ -101,9 +101,9 @@ lin friday_Weekday = mkWeekday "reede" ;
 lin saturday_Weekday = mkWeekday "laupäev" ;
 lin sunday_Weekday = mkWeekday "pühapäev" ;
 
-lin january_Month = mkN "jaanuar" ; 
+lin january_Month = mkN "jaanuar" ;
 lin february_Month = mkN "veebruar" ;
-lin march_Month = mkN "märts" ; 
+lin march_Month = mkN "märts" ;
 lin april_Month = mkN "aprill" ;
 lin may_Month = mkN "mai" ;
 lin june_Month = mkN "juuni" ;

src/estonian/DocumentationEst.gf

@@ -2,5 +2,5 @@
 
 -- documentation of Estonian in Estonian: the default introduced in LangEst
 
-concrete DocumentationEst of Documentation = CatEst ** 
+concrete DocumentationEst of Documentation = CatEst **
   DocumentationEstFunctor with (Terminology = TerminologyEst) ;

src/estonian/DocumentationEstEng.gf

@@ -2,5 +2,5 @@
 
 -- documentation of Estonian in English
 
-concrete DocumentationEstEng of Documentation = CatEst ** 
+concrete DocumentationEstEng of Documentation = CatEst **
   DocumentationEstFunctor with (Terminology = TerminologyEng) ;

src/estonian/DocumentationEstFunctor.gf

@@ -1,6 +1,6 @@
 --# -path=.:../abstract:../common
 
-incomplete concrete DocumentationEstFunctor of Documentation = CatEst ** open 
+incomplete concrete DocumentationEstFunctor of Documentation = CatEst ** open
   Terminology, -- the interface
   ResEst,
   ParadigmsEst,
@@ -23,25 +23,31 @@ lincat
 oper
   heading : N -> Str = \n -> (nounHeading n).s ;
 
+  caseplus2nf : N -> ResEst.Number -> CasePlus -> Str = \noun,num,cas ->
+    noun.s ! NCase num cas.c ++ cas.suf ;
+
+  caseplus2af : (AForm => Str) -> ResEst.Number -> CasePlus -> Str = \adj,num,cas ->
+    adj ! AN (NCase num cas.c) ++ cas.suf ;
+
 lin
   InflectionN, InflectionN2, InflectionN3 = \noun -> {
     t  = "s" ;
     s1 = heading1 (heading noun_Category) ;
-    s2 = inflNoun (\nf -> noun.s ! nf)
+    s2 = inflNoun (caseplus2nf noun)
     } ;
 
-  InflectionA, InflectionA2 = \adj -> 
+  InflectionA, InflectionA2 = \adj ->
     let posit  : (AForm => Str) = adj.s ! Posit ;
        	compar : (AForm => Str) = adj.s ! Compar ;
       	superl : (AForm => Str) = adj.s ! Superl ;
-     in 
+     in
     {   t  = "a" ;
         s1 = heading1 (heading adjective_Category) ;
-        s2 = inflNoun (\nf -> posit ! AN nf) ++ 
+        s2 = inflNoun (caseplus2af posit) ++
-             heading2 (heading comparative_Parameter) ++ 
+             heading2 (heading comparative_Parameter) ++
-             inflNoun (\nf -> compar ! AN nf) ++ 
+             inflNoun (caseplus2af compar) ++
-             heading2 (heading superlative_Parameter) ++ 
+             heading2 (heading superlative_Parameter) ++
-             inflNoun (\nf -> superl ! AN nf)
+             inflNoun (caseplus2af superl)
     } ;
 
   InflectionAdv, InflectionAdV, InflectionAdA, InflectionAdN = \adv -> {
@@ -58,91 +64,93 @@ lin
 
   InflectionV v = {
     t  = "v" ;
-    s1 = heading1 (heading verb_Category) ++  
+    s1 = heading1 (heading verb_Category) ++
          paragraph (verbExample (S.mkCl S.she_NP v)) ;
     s2 = inflVerb v
     } ;
 
   InflectionV2 v = {
     t  = "v" ;
-    s1 = heading1 (heading verb_Category) ++  
+    s1 = heading1 (heading verb_Category) ++
          paragraph (verbExample (S.mkCl S.she_NP v S.something_NP)) ;
     s2 = inflVerb v
     } ;
 
   InflectionV3 v = {
     t  = "v" ;
-    s1 = heading1 (heading verb_Category) ++  
+    s1 = heading1 (heading verb_Category) ++
          paragraph (verbExample (S.mkCl S.she_NP v S.something_NP S.something_NP)) ;
     s2 = inflVerb v
     } ;
 
   InflectionV2V v = {
     t  = "v" ;
-    s1 = heading1 (heading verb_Category) ++  
+    s1 = heading1 (heading verb_Category) ++
          paragraph (verbExample (S.mkCl S.she_NP v S.we_NP (S.mkVP (L.sleep_V)))) ;
     s2 = inflVerb v
     } ;
 
   InflectionV2S v = {
     t  = "v" ;
-    s1 = heading1 (heading verb_Category) ++  
+    s1 = heading1 (heading verb_Category) ++
          paragraph (verbExample (S.mkCl S.she_NP v S.we_NP (lin S (ss "...")))) ;
     s2 = inflVerb v
     } ;
 
   InflectionV2Q v = {
     t  = "v" ;
-    s1 = heading1 (heading verb_Category) ++  
+    s1 = heading1 (heading verb_Category) ++
          paragraph (verbExample (S.mkCl S.she_NP v S.we_NP (lin QS (ss "...")))) ;
     s2 = inflVerb v
     } ;
 
   InflectionV2A v = {
     t  = "v" ;
-    s1 = heading1 (heading verb_Category) ++  
+    s1 = heading1 (heading verb_Category) ++
          paragraph (verbExample (S.mkCl S.she_NP v S.we_NP L.beautiful_A)) ;
     s2 = inflVerb v
     } ;
 
   InflectionVV v = {
     t  = "v" ;
-    s1 = heading1 (heading verb_Category) ++  
+    s1 = heading1 (heading verb_Category) ++
          paragraph (verbExample (S.mkCl S.she_NP v (S.mkVP (L.sleep_V)))) ;
     s2 = inflVerb v
     } ;
 
   InflectionVS v = {
     t  = "v" ;
-    s1 = heading1 (heading verb_Category) ++  
+    s1 = heading1 (heading verb_Category) ++
          paragraph (verbExample (S.mkCl S.she_NP v (lin S (ss "...")))) ;
     s2 = inflVerb v
     } ;
 
   InflectionVQ v = {
     t  = "v" ;
-    s1 = heading1 (heading verb_Category) ++  
+    s1 = heading1 (heading verb_Category) ++
          paragraph (verbExample (S.mkCl S.she_NP v (lin QS (ss "...")))) ;
     s2 = inflVerb v
     } ;
 
   InflectionVA v = {
     t  = "v" ;
-    s1 = heading1 (heading verb_Category) ++  
+    s1 = heading1 (heading verb_Category) ++
          paragraph (verbExample (S.mkCl S.she_NP v L.beautiful_A)) ;
     s2 = inflVerb v
     } ;
 
-oper 
+oper
   verbExample : CatEst.Cl -> Str = \cl -> (S.mkUtt cl).s ;
 {-
 -} --# notpresent
   inflVerb : CatEst.V -> Str = \verb ->
-     let 
+     let
        --verb = sverb2verbSep verb0 ;
        vfin : ResEst.VForm -> Str = \f ->
          verb.s ! f ;
-         
+       vinf : ResEst.InfForms -> Str = \if ->
+         applyInfFormsV if verb.s ;
+
        nounNounHeading : Parameter -> Parameter -> Str = \n1,n2 ->
          (S.mkUtt (G.PossNP (S.mkCN n1) (S.mkNP n2))).s ;
      in
@@ -152,7 +160,7 @@ oper
              th (heading singular_Parameter) ++
              th (heading plural_Parameter)
              ++ th (heading passive_Parameter) --# notpresent
-            ) ++ 
+            ) ++
          tr (th "1.p"  ++ td (vfin (Presn Sg P1)) ++ td (vfin (Presn Pl P1))
              ++ intagAttr "td" "rowspan=3" (vfin (PassPresn True)) --# notpresent
             ) ++
@@ -167,13 +175,13 @@ oper
              th (heading singular_Parameter) ++
              th (heading plural_Parameter)
              ++ th (heading passive_Parameter) --# notpresent
-            ) ++ 
+            ) ++
          tr (th "1.p"  ++ td (vfin (Impf Sg P1)) ++ td (vfin (Impf Pl P1))
              ++ intagAttr "td" "rowspan=3" (vfin (PassImpf True))) ++
          tr (th "2.p"  ++ td (vfin (Impf Sg P2)) ++ td (vfin (Impf Pl P2))) ++
          tr (th "3.p"  ++ td (vfin (Impf Sg P3)) ++ td (vfin (Impf Pl P3))) ++
          tr (th (heading negative_Parameter) ++
-             td (vfin (PastPart Act)) ++ 
+             td (vfin (PastPart Act)) ++
              td (vfin (PastPart Pass)) ++
              td (vfin (PassImpf False)))
          ) ++
@@ -183,12 +191,12 @@ oper
              th (heading singular_Parameter) ++
              th (heading plural_Parameter)
              ++ th (heading passive_Parameter) --# notpresent
-            ) ++ 
+            ) ++
          tr (th "1.p"  ++ td (vfin (Condit Sg P1)) ++ td (vfin (Condit Pl P1))
              ++ intagAttr "td" "rowspan=3" "TODO pass condit (nt loetaks)" --# notpresent
             ) ++
          tr (th "2.p"  ++ td (vfin (Condit Sg P2)) ++ td (vfin (Condit Pl P2))) ++
-         tr (th "3.p"  ++ td (vfin (Condit Sg P3)) ++ td (vfin (Condit Pl P3))) 
+         tr (th "3.p"  ++ td (vfin (Condit Sg P3)) ++ td (vfin (Condit Pl P3)))
          ) ++
        heading3 (nounNounHeading present_Parameter quotative_Parameter) ++
        frameTable (
@@ -196,8 +204,8 @@ oper
              th (heading singular_Parameter) ++
              th (heading plural_Parameter)
              ++ th (heading passive_Parameter) --# notpresent
-            )  ++ 
+            )  ++
-         tr (th "isik."  ++ td (vfin (Quotative Act)) 
+         tr (th "isik."  ++ td (vfin (Quotative Act))
              ++ intagAttr "td" "rowspan=3" (vfin (Quotative Act)) --# notpresent
             ) ++
          tr (th "umbis."  ++ td (vfin (Quotative Pass)) ++ td (vfin (Quotative Pass))
@@ -208,61 +216,62 @@ oper
              th (heading singular_Parameter) ++
              th (heading plural_Parameter)
              ++ th (heading passive_Parameter) --# notpresent
-            ) ++ 
+            ) ++
          tr (th "1.p"  ++ td "" ++ td (vfin ImperP1Pl) ++
              intagAttr "td" "rowspan=3" (vfin ImperPass)) ++
          tr (th "2.p"  ++ td (vfin (Imper Sg)) ++ td (vfin (Imper Pl))) ++
-         tr (th "3.p"  ++ td (vfin (ImperP3))  ++ td (vfin ImperP3)) 
+         tr (th "3.p"  ++ td (vfin (ImperP3))  ++ td (vfin ImperP3))
          ) ++
        heading2 (nounPluralHeading nominal_form_ParameterType).s ++
        heading3 (heading infinitive_Parameter) ++
        frameTable (
          tr (intagAttr "th" "rowspan=2" "da" ++
-             th (heading nominative_Parameter) ++ td (vfin (Inf InfDa))) ++
+             th (heading nominative_Parameter) ++ td (vinf InfDa)) ++
-         tr (th (heading inessive_Parameter) ++ td (vfin (Inf InfDes)))  ++
+         tr (th (heading inessive_Parameter) ++ td (vinf InfDes))  ++
 
-         tr (intagAttr "th" "rowspan=5" "ma" ++         
+         tr (intagAttr "th" "rowspan=6" "ma" ++
-             th (heading illative_Parameter) ++ td (vfin (Inf InfMa))) ++
+             th (heading illative_Parameter) ++ td (vinf InfMa)) ++
-         tr (th (heading inessive_Parameter) ++ td (vfin (Inf InfMas))) ++
+         tr (th (heading inessive_Parameter) ++ td (vinf InfMas)) ++
-         tr (th (heading elative_Parameter)  ++ td (vfin (Inf InfMast))) ++
+         tr (th (heading elative_Parameter)  ++ td (vinf InfMast)) ++
-         tr (th (heading abessive_Parameter) ++ td (vfin (Inf InfMata))) ++ 
+         tr (th (heading abessive_Parameter) ++ td (vinf InfMata)) ++
-         tr (th (heading translative_Parameter) ++ td (vfin (Inf InfMaks)))
+         tr (th (heading abessive_Parameter) ++ td (vinf InfMaks)) ++
+         tr (th (heading translative_Parameter) ++ td (vinf InfMine))
 
-       ) ++ 
+       ) ++
        heading3 (heading participle_Parameter) ++
        frameTable (
-         tr (intagAttr "th" "rowspan=2" (heading present_Parameter) ++         
+         tr (intagAttr "th" "rowspan=2" (heading present_Parameter) ++
-             th (heading active_Parameter) ++ 
+             th (heading active_Parameter) ++
              td (vfin (PresPart Act))) ++
-         tr (th (heading passive_Parameter) ++ 
+         tr (th (heading passive_Parameter) ++
              td (vfin (PresPart Pass))) ++
 
-         tr (intagAttr "th" "rowspan=2" (heading perfect_Parameter) ++         
+         tr (intagAttr "th" "rowspan=2" (heading perfect_Parameter) ++
-             th (heading active_Parameter) ++ 
+             th (heading active_Parameter) ++
              td (vfin (PastPart Act ))) ++
 
-         tr (th (heading passive_Parameter) ++ 
+         tr (th (heading passive_Parameter) ++
              td (vfin (PastPart Pass )))
           ) ; --}
 
-  inflNoun : (NForm -> Str) -> Str = \nouns -> 
+  inflNoun : (Number -> CasePlus -> Str) -> Str = \nouns ->
-    frameTable ( 
+    frameTable (
-          tr (th ""          ++ th (heading singular_Parameter)            ++ th (heading plural_Parameter)   ) ++
+          tr (th ""          ++ th (heading singular_Parameter)               ++ th (heading plural_Parameter)) ++
-          tr (th (heading nominative_Parameter) ++ td (nouns (NCase Sg Nom)) ++ td (nouns (NCase Pl Nom))) ++
+          tr (th (heading nominative_Parameter)  ++ td (nouns Sg Nominative)  ++ td (nouns Pl Nominative)) ++
-          tr (th (heading genitive_Parameter) ++ td (nouns (NCase Sg Gen)) ++ td (nouns (NCase Pl Gen))) ++
+          tr (th (heading genitive_Parameter)    ++ td (nouns Sg Genitive)    ++ td (nouns Pl Genitive)) ++
-          tr (th (heading partitive_Parameter) ++ td (nouns (NCase Sg Part)) ++ td (nouns (NCase Pl Part))) ++
+          tr (th (heading partitive_Parameter)   ++ td (nouns Sg Partitive)   ++ td (nouns Pl Partitive)) ++
-          tr (th (heading translative_Parameter) ++ td (nouns (NCase Sg Transl)) ++ td (nouns (NCase Pl Transl))) ++
+          tr (th (heading translative_Parameter) ++ td (nouns Sg Translative) ++ td (nouns Pl Translative)) ++
-          tr (th (heading essive_Parameter) ++ td (nouns (NCase Sg Ess)) ++ td (nouns (NCase Pl Ess))) ++
+          tr (th (heading essive_Parameter)      ++ td (nouns Sg Essive)      ++ td (nouns Pl Essive)) ++
-          tr (th (heading inessive_Parameter) ++ td (nouns (NCase Sg Iness)) ++ td (nouns (NCase Pl Iness))) ++
+          tr (th (heading inessive_Parameter)    ++ td (nouns Sg Inessive)    ++ td (nouns Pl Inessive)) ++
-          tr (th (heading elative_Parameter) ++ td (nouns (NCase Sg Elat)) ++ td (nouns (NCase Pl Elat))) ++
+          tr (th (heading elative_Parameter)     ++ td (nouns Sg Elative)     ++ td (nouns Pl Elative)) ++
-          tr (th (heading illative_Parameter) ++ td (nouns (NCase Sg Illat)) ++ td (nouns (NCase Pl Illat))) ++
+          tr (th (heading illative_Parameter)    ++ td (nouns Sg Illative)    ++ td (nouns Pl Illative)) ++
-          tr (th (heading adessive_Parameter) ++ td (nouns (NCase Sg Adess)) ++ td (nouns (NCase Pl Adess))) ++
+          tr (th (heading adessive_Parameter)    ++ td (nouns Sg Adessive)    ++ td (nouns Pl Adessive)) ++
-          tr (th (heading ablative_Parameter) ++ td (nouns (NCase Sg Ablat)) ++ td (nouns (NCase Pl Ablat))) ++
+          tr (th (heading ablative_Parameter)    ++ td (nouns Sg Ablative)    ++ td (nouns Pl Ablative)) ++
-          tr (th (heading allative_Parameter) ++ td (nouns (NCase Sg Allat)) ++ td (nouns (NCase Pl Allat))) ++
+          tr (th (heading allative_Parameter)    ++ td (nouns Sg Allative)    ++ td (nouns Pl Allative)) ++
-          tr (th (heading abessive_Parameter) ++ td (nouns (NCase Sg Abess)) ++ td (nouns (NCase Pl Abess))) ++
+          tr (th (heading abessive_Parameter)    ++ td (nouns Sg Abessive)    ++ td (nouns Pl Abessive)) ++
-          tr (th (heading comitative_Parameter)  ++ td (nouns (NCase Sg Comit)) ++ td (nouns (NCase Pl Comit))) ++
+          tr (th (heading comitative_Parameter)  ++ td (nouns Sg Comitative)  ++ td (nouns Pl Comitative)) ++
-          tr (th (heading instructive_Parameter) ++ td (nouns (NCase Sg Termin)) ++ td (nouns (NCase Pl Termin))
+          tr (th (heading instructive_Parameter) ++ td (nouns Sg Terminative) ++ td (nouns Pl Terminative))
-          )) ;
+          ) ;
 
 lin
   NoDefinition   t     = {s=t.s};
@@ -274,6 +283,6 @@ lin
   MkTag i = ss (i.t) ;
 
 {- --# notpresent
--} 
+-}
 
 }

src/estonian/ExtendEst.gf

@@ -3,19 +3,29 @@
 concrete ExtendEst of Extend =
   CatEst ** ExtendFunctor -
   [
-    VPS, ListVPS, VPI, ListVPI, VPS2, ListVPS2, VPI2, ListVPI2, RNP, RNPList, 
+    -- Extensions of VP
-    AdAdV, AdjAsCN, AdjAsNP, ApposNP,
+    VPS, ListVPS, VPI, ListVPI, VPS2, ListVPS2, VPI2, ListVPI2,
-    BaseVPS, ConsVPS, BaseVPI, ConsVPI, BaseVPS2, ConsVPS2, BaseVPI2, ConsVPI2,
+    MkVPS, BaseVPS, ConsVPS, ConjVPS, PredVPS, QuestVPS, SQuestVPS, RelVPS,
-    MkVPS, ConjVPS, PredVPS, MkVPI, ConjVPI, ComplVPIVV,
+    MkVPI, BaseVPI, ConsVPI, ConjVPI, ComplVPIVV,
-    MkVPS2, ConjVPS2, ComplVPS2, MkVPI2, ConjVPI2, ComplVPI2,
+    MkVPS2, BaseVPS2, ConsVPS2, ConjVPS2, ComplVPS2, ReflVPS2,
-    Base_nr_RNP, Base_rn_RNP, Base_rr_RNP, ByVP, CompBareCN,
+    MkVPI2, BaseVPI2, ConsVPI2, ConjVPI2, ComplVPI2,
-    CompIQuant, CompQS, CompS, CompVP, ComplBareVS, ComplGenVV, ComplSlashPartLast, ComplVPSVV, CompoundAP,
+
-    CompoundN, ConjRNP, ConjVPS, ConsVPS, Cons_nr_RNP, Cons_rr_RNP, DetNPFem, EmbedPresPart, 
+    -- Reflexives
-    ExistsNP, FocusAP, FocusAdV, FocusAdv, FocusObj, FrontExtPredVP, GenIP, GenModIP, GenModNP, GenNP, GenRP,
+    RNP, RNPList, Base_nr_RNP, Base_rn_RNP, Base_rr_RNP, ConjRNP, Cons_nr_RNP, Cons_rr_RNP, PredetRNP, ReflRNP, ReflPoss, ReflPron,
-    GerundAdv, GerundCN, GerundNP, IAdvAdv, ICompAP, InOrderToVP, InvFrontExtPredVP, MkVPS, NominalizeVPSlashNP,
+
-    PassAgentVPSlash, PassVPSlash, PastPartAP, PastPartAgentAP, PositAdVAdj, PredVPS, PredVPSVV, PredetRNP, PrepCN,
+    -- Rest in alphabetical order
-    PresPartAP, PurposeVP, ReflPoss, ReflPron, ReflRNP, SlashBareV2S, SlashV2V, 
+    AdAdV, AdjAsCN, AdjAsNP, ApposNP, AdvIsNP, A2VPSlash, ByVP,
-    UncontractedNeg, UttAccIP, UttAccNP, UttAdV, UttDatIP, UttDatNP, UttVPShort, WithoutVP, BaseVPS2, ConsVPS2, ConjVPS2, ComplVPS2, MkVPS2
+    CardCNCard, CompBareCN, CompIQuant, CompQS, CompS, CompVP,
+      ComplBareVS, ComplGenVV, ComplSlashPartLast, ComplVPSVV, CompoundAP, CompoundN,
+    EmbedPresPart, EmbedSSlash, EmptyRelSlash, ExistsNP, ExistCN, ExistMassCN, ExistPluralCN,
+    FocusAP, FocusAdV, FocusAdv, FocusObj, FrontComplDirectVQ, FrontComplDirectVS,
+    GenIP, GenModIP, GenModNP, GenNP, GenRP, GerundAdv, GerundCN, GerundNP,
+    IAdvAdv, ICompAP, InOrderToVP, N2VPSlash, NominalizeVPSlashNP,
+    PassAgentVPSlash, PassVPSlash, PastPartAP, PastPartAgentAP, PositAdVAdj,
+      PredAPVP, PredIAdvVP, PredVPSVV, PresPartAP, PrepCN, ProDrop, ProgrVPSlash, PurposeVP,
+    SlashBareV2S, UttAccIP, UttAccNP, UttAdV, UttDatIP, UttDatNP, UttVPShort, WithoutVP
+
+
    ]
   with
     (Grammar = GrammarEst) **
@@ -24,6 +34,7 @@ concrete ExtendEst of Extend =
     GrammarEst,
     ResEst,
     (R=ResEst),
+    (X=ExtraEst),
     IdiomEst,
     Coordination,
     Prelude,
@@ -31,257 +42,382 @@ concrete ExtendEst of Extend =
     LexiconEst,
     ParadigmsEst in {
 
+---------------------------------
+-- VPS, VPI, VPS2 + list versions
+  lincat
+    VPS = X.VPS ;
+    [VPS] = X.ListVPS ;
+    VPI = X.VPI ;
+    [VPI] = X.ListVPI ;
+    VPS2 = X.VPS ** {c2 : Compl} ;
+    [VPS2] = X.ListVPS ** {c2 : Compl} ;
+    VPI2 = X.VPI ** {c2 : Compl} ;
+    [VPI2] = X.ListVPI ** {c2 : Compl}  ;
+
   lin
-  -- : NP -> Quant ;       -- this man's
+    MkVPS = X.MkVPS ;
-  GenNP np = {
+    BaseVPS = X.BaseVPS ;
-      s,sp = \\_,_ => np.s ! NPCase Gen ;
+    ConsVPS = X.ConsVPS ;
+    ConjVPS = X.ConjVPS ;
+
+    PredVPS = X.PredVPS ;
+    -- QuestVPS
+    -- SQuestVPS
+    -- RelVPS
+
+    MkVPI = X.MkVPI ;
+    BaseVPI = X.BaseVPI ;
+    ConsVPI = X.ConsVPI ;
+    ConjVPI = X.ConjVPI ;
+    ComplVPIVV = X.ComplVPIVV ;
+
+    MkVPS2 t p vps = MkVPS t p vps ** {c2 = vps.c2} ;
+--    BaseVPS2, ConsVPS2, ConjVPS2,
+
+    ComplVPS2 v np = lin VPS (v ** {
+      -- TODO: param to record whether it's pos or neg, so we get right form of np
+      s = \\agr => v.s ! agr ++ appCompl True Pos v.c2 np ;
+      }) ;
+
+--    ReflVPS2 v rnp =
+-- MkVPI2, BaseVPI2, ConsVPI2, ConjVPI2, ComplVPI2,
+
+---------------------------------
+-- RNP + all related funs
+
+  lincat
+    RNP     = {s : Agr => NPForm => Str} ;
+    RNPList = {s1,s2 : Agr => NPForm => Str} ;
+
+  oper
+    rnp2np : Agr -> RNP -> NPhrase = \agr,rnp -> emptyNP ** {
+      a = agr ;
+      s = rnp.s ! agr ;
+      isPron = False ; -- ??
+      } ;
+
+  lin
+    -- : VPSlash -> RNP -> VP ;   -- support my family and myself
+    ReflRNP vps rnp = insertObj (\\b,p,a => appCompl True Pos vps.c2 (rnp2np a rnp)) vps ;
+
+    -- : RNP
+    ReflPron = {s = \\agr,npf => (reflPron agr).s ! npf} ;
+
+    -- : Num -> CN -> RNP ;      -- my car(s)
+    ReflPoss num cn = {
+      s = \\a,npf => possPron ! a ++ num.s ! Sg ! Nom ++
+        case npf of {
+          NPCase c =>  cn.s ! NCase num.n c ;
+          NPAcc => cn.s ! NCase num.n Gen } ;
+      } ;
+
+    PredetRNP predet rnp = {
+      s = \\a,c => case a of {
+        Ag n p => predet.s ! n ! c ++ rnp.s ! a ! c ;
+        AgPol => predet.s ! Pl ! c ++ rnp.s ! a ! c }
+      } ;
+
+    ConjRNP conj rpns = conjunctDistrTable2 Agr NPForm conj rpns ;
+
+    Base_rr_RNP x y = twoTable2 Agr NPForm x y ;
+    Base_nr_RNP x y = twoTable2 Agr NPForm {s = \\a => x.s} y ;
+    Base_rn_RNP x y = twoTable2 Agr NPForm x {s = \\a => y.s} ;
+    Cons_rr_RNP x xs = consrTable2 Agr NPForm comma x xs ;
+    Cons_nr_RNP x xs = consrTable2 Agr NPForm comma {s = \\a => x.s} xs ;
+
+{-
+    -- : Pron -> Num -> CN -> RNP -> NP ; -- his abandonment of his wife and children
+    PossPronRNP pron num cn rnp =
+
+    -- : NP -> Prep -> RNP -> RNP ;   -- a dispute with his wife
+    AdvRAP adv rp =
+
+    -- : VP -> Prep -> RNP -> VP ;    -- lectured about her travels
+    AdvRNP adv rp =
+
+    -- : AP -> Prep -> RNP -> AP ;    -- adamant in his refusal
+    AdvRVP adv rp =
+ -}
+
+  oper
+    possPron : Agr => Str = table {
+      Ag Sg P1 => "minu" ;
+      Ag Sg P2 => "sinu" ;
+      Ag Sg P3 => "tema" ;
+      Ag Pl P1 => "meie" ;
+      Ag Pl P2 => "teie" ;
+      Ag Pl P3 => "nende" ;
+      AgPol => "teie"
+      } ;
+
+
+---------------------------------
+-- A - B
+  lin
+
+
+    AdAdV ad adv = AdAdv ad adv ;
+
+     -- : AP -> CN ;   -- a green one ; en grön (Swe)
+    AdjAsCN ap = emptyCN ** {s = ap.s ! True} ; -- True = attributive ; False = predicative
+
+    -- : AP -> NP
+    AdjAsNP ap = MassNP (AdjAsCN ap) ;
+
+    -- : NP -> NP -> NP
+    ApposNP np1 np2 = np2 ** {
+      s = \\nf => np1.s ! nf ++ np2.s ! nf ; -- comma or not?
+      } ;
+
+    -- : Adv -> NP -> Cl ;  -- here is the tree / here are the trees
+    AdvIsNP adv np = mkClause (\_ -> adv.s) (agrP3 Sg) (UseComp (CompNP np)) ;
+
+    -- : A2 -> VPSlash
+    A2VPSlash a2 = UseComp (CompAP (UseA2 a2)) ** {c2 = a2.c2} ;
+
+    -- : VP -> Adv ;
+    ByVP = GerundAdv ;
+
+---------------------------------
+-- C
+
+  lin
+
+   -- : VS -> S -> VP ;
+   ComplBareVS  v s = insertExtrapos s.s (predV v) ;
+
+   -- : N -> N -> N ;      -- control system / controls system / control-system
+   CompoundN noun cn = cn ** {
+     s = \\nf => noun.s ! NCase Sg Gen ++ BIND ++ cn.s ! nf
+     } ;
+
+   -- : N -> A  -> AP ;     -- language independent / language-independent
+   CompoundAP n a = PositA (a ** {s = \\d,af => n.s ! NCase Sg Nom ++ BIND ++ a.s ! d ! af}) ;
+
+   -- : VS -> Utt -> VP ;      -- say: "today"
+   ComplDirectVS vs utt = insertExtrapos (BIND ++ ":" ++ utt.s) (predV vs) ;
+
+   -- : VQ -> Utt -> VP ;      -- ask: "when"
+   ComplDirectVQ vq utt = insertExtrapos (BIND ++ ":" ++ utt.s) (predV vq) ;
+
+   -- : S -> Comp ;                   -- (the fact is) that she sleeps
+   CompS s = {s = \\_ => "et" ++ s.s} ;
+
+   -- : QS -> Comp ;                  -- (the question is) who sleeps
+   CompQS qs = {s = \\_ => qs.s } ;
+
+   -- : Ant -> Pol -> VP -> Comp ;    -- (she is) to go
+   CompVP ant pol vp = {s = \\a => infVPAnt ant.a (NPCase Nom) pol.p a vp InfDa } ;
+
+
+  -- ComplGenVV v a p vp = insertObj (\\agr => a.s ++ p.s ++ infVP v.typ vp a.a p.p agr)
+  --                                 (predVV v) ;
+
+  -- ComplSlashPartLast vps np = {} ;  --- AR 7/3/2013
+
+---------------------------------
+-- E - F
+
+  lin
+
+  -- : VP -> SC ;   -- looking at Mary (is fun) / filmide vaatamine (on tore) / ___ga abielus olemine,
+    EmbedPresPart vp = {s = infVP (NPCase Gen) Pos (agrP3 Sg) vp InfMine } ;
+
+    EmbedSSlash s = {s = s.s ++ s.c2.s} ;
+
+    -- : ClSlash -> RCl ;   -- he lives in
+    EmptyRelSlash cls = {
+      s = \\t,a,p,_ => cls.s ! t ! a ! p ++ cls.c2.s ;
+      c = NPCase Nom
+      } ;
+
+    -- : CN -> Cl ;  -- there is a car / there is no car ; there is beer / there is no beer ; there are
+    -- TODO: these all use the literal "exist" verb. Does Estonian have a construction for "there is"?
+    ExistCN, ExistMassCN = \cn -> ExistsNP (MassNP cn) ;
+    ExistPluralCN cn = ExistsNP (DetCN (DetQuant IndefArt NumPl) cn) ;
+
+    -- : NP -> Cl ;  -- there exists a number / there exist numbers
+    ExistsNP = IdiomEst.ExistNP ;
+
+    --  : AP  -> NP      -> Utt ;   -- green was the tree
+    FocusAP ap np =
+      let pred : VP = UseComp (CompNP np) ;
+          subj : NP = AdjAsNP ap ;
+          cl : Cl = PredVP subj pred ;
+       in UttS (UseCl (TTAnt TPres ASimul) PPos cl) ; -- use AdvIsNP for similar construction but that returns a Cl instead
+
+    -- : Ad[vV] -> S -> Utt -- today I will sleep
+    FocusAdV, FocusAdv = \adv,s -> cc2 adv s ;
+
+    --  : NP  -> SSlash  -> Utt ;   -- her I love
+    FocusObj np sslash = {s = appCompl True Pos sslash.c2 np ++ sslash.s} ;
+
+
+    -- : NP -> VS -> Utt -> Cl ;      -- "I am here", she said
+    FrontComplDirectVS np vs utt =
+      let cl : Cl = PredVP np (UseV vs) ;
+       in cl ** {s = \\t,a,p,o => utt.s ++ bindComma ++ cl.s ! t ! a ! p ! o} ;
+
+    -- : NP -> VQ -> Utt -> Cl ;      -- "where", she asked
+    FrontComplDirectVQ np vq utt =
+      let cl : Cl = PredVP np (UseV vq) ;
+       in cl ** {s = \\t,a,p,o => utt.s ++ bindComma ++ cl.s ! t ! a ! p ! o} ;
+
+
+---------------------------------
+-- G
+
+  lin
+    -- : NP -> Quant ;       -- this man's
+    GenNP np = {
+      s,sp = \\_,_ => linNP (NPCase Gen) np ;
       isNum  = False ;
       isDef  = True ;
-      isNeg = False 
+      isNeg = False
-  } ;
+      } ;
 
-  -- : IP -> IQuant ;      -- whose
+    -- : IP -> IQuant ;      -- whose
-  GenIP ip = { s = \\_,_ => ip.s ! NPCase Gen } ;
+    GenIP ip = {s = \\_,_ => linIP (NPCase Gen) ip} ;
 
-  -- : Num -> CN -> RP ;   -- whose car
+    -- : Num -> CN -> RP ;   -- whose car
-  GenRP num cn = {
+    GenRP num cn = {
-    s = \\n,c => let k = npform2case num.n c in relPron ! NCase n Gen ++ cn.s ! NCase num.n k ; 
+      s = \\n,c => let k = npform2case num.n c
-    a = RNoAg 
+                    in relPron ! NCase n Gen ++ cn.s ! NCase num.n k ;
-  } ;
+      a = RNoAg
+      } ;
 
 -- In case the first two are not available, the following applications should in any case be.
 
-  -- : Num -> NP -> CN -> NP ; -- this man's car(s)
+    -- : Num -> NP -> CN -> NP ; -- this man's car(s)
-  GenModNP num np cn = DetCN (DetQuant (GenNP (lin NP np)) num) cn ;
+    GenModNP num np cn = DetCN (DetQuant (GenNP (lin NP np)) num) cn ;
 
-  -- : Num -> IP -> CN -> IP ; -- whose car(s)    
+    -- : Num -> IP -> CN -> IP ; -- whose car(s)
-  GenModIP num ip cn = IdetCN (IdetQuant (GenIP (lin IP ip)) num) cn ;
+    GenModIP num ip cn = IdetCN (IdetQuant (GenIP (lin IP ip)) num) cn ;
 
-{-
+    -- : VP -> Adv
+    GerundAdv vp = {s = infVPdefault vp InfDes} ;
 
+    -- : VP -> CN    -- publishing of the document (can get a determiner)
+    GerundCN vp = emptyCN ** {s = \\nf => infVPdefault vp InfMine} ;
 
+    -- : VP -> NP    -- publishing the document (by nature definite)
+    GerundNP vp = MassNP (GerundCN vp) ;
 
-  lincat
+---------------------------------
-    VPS   = {s : Agr => Str} ;
+-- I - N
-    [VPS] = {s1,s2 : Agr => Str} ; 
-    VPI   = {s : VVType => Agr => Str} ;
-    [VPI] = {s1,s2 : VVType => Agr => Str} ;
-
-  lin
-    BaseVPS = twoTable Agr ;
-    ConsVPS = consrTable Agr comma ;
-    
-    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 ;
-    PredVPS np vps = {s = np.s ! npNom ++ vps.s ! np.a} ;
-
-    
-    MkVPI vp = mkVPI (lin VP vp) ;
-    ConjVPI c xs = conjunctDistrTable2 VVType Agr c xs ;
-    ComplVPIVV vv vpi = insertObj (\\a => vpi.s ! vv.typ ! a) (predVV vv) ;
-
-
--------- two-place verb conjunction
-
-  lincat
-    VPS2   = {s : Agr => Str ; c2 : Str} ; 
-    [VPS2] = {s1,s2 : Agr => Str ; c2 : Str} ; 
-    VPI2   = {s : VVType => Agr => Str ; c2 : Str} ;
-    [VPI2] = {s1,s2 : VVType => Agr => Str ; c2 : Str} ;
-
-  lin
-    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
-    ConsVPS2 x xs = consrTable Agr comma 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} ;
-    ConjVPI2 c xs = conjunctDistrTable2 VVType Agr c xs ** {c2 = xs.c2} ;
-
-
-    ComplVPS2 vps2 np = {} ;
-    ComplVPI2 vpi2 np = {} ;
-
-  oper 
-    mkVPS : Temp -> Pol -> VP -> VPS = \t,p,vp -> lin VPS {} ;
-      
-    mkVPI : VP -> VPI = \vp -> lin VPI {} ;
-
------
--}
-
-lin
-  -- : AP -> IComp ;   -- "how old"
-  ICompAP ap = icompAP "kui" ap ; 
-
-  -- : Adv -> IAdv ;   -- "how often"
-  IAdvAdv adv = { s = "kui" ++ adv.s } ;  
-
-  -- : VP -> AP ;   -- (the man) looking at Mary / filme vaatav (mees)
-  PresPartAP vp = {
-    s = \\_,_ => vp2adv vp True VIPresPart ;
-    infl = Invariable 
-  } ;
-
-{- TODO: need to change VP to get the following 3 functions to work properly:
-   1) Add "mine" form into VP (or switch to a BIND solution and just add a stem)
-   2) Change s2 in VP so that we can manipulate the complement to be in genitive!
-  -- : VP -> SC ;   -- looking at Mary (is fun) / filmide vaatamine (on tore)
-  EmbedPresPart vp = 
-    let vpGen = vp ; --** { s2 = \\_,_,_ => vp.s2 ! True ! Pos ! }
-      {s = vp2adv vp True VI } ; 
-
-   -- : VP -> CN    -- publishing of the document (can get a determiner)
-   GerundCN vp = {} ;
-
-   -- : VP -> NP    -- publishing the document (by nature definite)
-   GerundNP vp = {} ;
--}
-
-  -- : VPSlash -> AP ;    -- täna leitud 
-  PastPartAP vp = {
-    s = \\_,_ => vp2adv vp True (VIPass Past) ;
-    infl = Invariable } ;
-
-  -- : VPSlash -> NP -> AP    -- hobisukeldujate poolt leitud (süvaveepomm)
-  PastPartAgentAP vp np = { 
-    s = \\_,_ => np.s ! NPCase Gen ++ "poolt" 
-              ++ vp2adv vp True (VIPass Past) ; 
-    infl = Invariable } ;
-
-  -- : VP -> Adv
-  GerundAdv vp = 
-    { s = vp2adv vp True (VIInf InfDes) } ; 
-
-  WithoutVP vp = -- ilma raamatut nägemata
-    { s = "ilma" ++ vp2adv vp False (VIInf InfMata) } ;
-
-  InOrderToVP vp = -- et raamatut paremini näha
-    { s = "et" ++ vp2adv vp True (VIInf InfDa) } ;
- 
-  ByVP vp = 
-    { s = vp2adv vp True (VIInf InfDes) } ; 
-
-oper 
-  vp2adv : R.VP -> Bool -> VIForm -> Str = \vp,sentIsPos,vif ->
-    vp.s2 ! sentIsPos ! Pos ! agrP3 Sg   -- raamatut
-    ++ vp.adv                     -- paremini
-    ++ vp.p                       -- ära 
-    ++ (vp.s ! vif ! Simul ! Pos ! agrP3 Sg).fin -- tunda/tundes/tundmata/...
-    ++ vp.ext ;
-
-lin
-{-
-
-   NominalizeVPSlashNP vpslash np = {} ;  
-    PassVPSlash vps = passVPSlash (lin VPS vps) [] ;
-    PassAgentVPSlash vps np = passVPSlash (lin VPS vps) ("by" ++ np.s ! NPAcc) ;
-
-   --- AR 7/3/2013
-   ComplSlashPartLast vps np = {} ;
--}
-   -- : NP -> Cl ;  -- there exists a number / there exist numbers
-   ExistsNP = IdiomEst.ExistNP ;
-
-{-
-   ComplBareVS  v s = insertExtra s.s (predV v) ;
-   SlashBareV2S v s = insertExtrac s.s (predVc v) ;
--}
-
-  -- : N -> N  -> N ;      -- control system / controls system / control-system
-  CompoundN noun cn = lin N {
-    s = \\nf => noun.s ! NCase Sg Gen ++ BIND ++ cn.s ! nf 
-    } ;
-{-  
-  -- : N -> A  -> AP ;     -- language independent / language-independent
-  CompoundAP noun adj = {} ;
-
-  -- : VS -> Utt -> VP ;      -- say: "today"
-  ComplDirectVS vs utt = {} ;
-  -- : VQ -> Utt -> VP ;      -- ask: "when"
-  ComplDirectVQ vq utt = {} ;
-
-  -- : NP -> VS -> Utt -> Cl ;      -- "I am here", she said
-  FrontComplDirectVS np vs utt = {} ;
-  -- : NP -> VQ -> Utt -> Cl ;      -- "where", she asked
-  FrontComplDirectVQ np vq utt = {} ;
--}
-
-  -- : AP -> VP -> Cl ;   -- it is good to walk / on hea kõndida
-  PredAPVP ap vp = 
-    let heaOllaVP : VP = insertObj (\\_,_ => ap.s) vp ; -- puts AP into the s2 field
-        heaOllaComp : Comp = CompVP ASimul PPos heaOlla ; -- chooses InfDa, fixes word order
-        heaOlla : VP = UseComp heaOllaComp -- looks silly, but I want to reuse the abstract syntax funs :-P
-    in existClause noSubj (agrP3 Sg) heaOlla ; 
-
-oper
-testCl = PredAPVP (PositA good_A) (UseV walk_V) ;
 
   lin
 
-  -- : AP -> CN ;   -- a green one ; en grön (Swe)
+    -- : AP -> IComp ;   -- "how old"
-  AdjAsCN ap = { s = ap.s ! True } ; -- True = it's a modifier, not a predicate
+    ICompAP ap = icompAP "kui" ap ;
 
-  AdjAsNP ap = {
+    -- : Adv -> IAdv ;   -- "how often"
-    s = table { NPCase c => ap.s ! True ! NCase Sg c ;
+    IAdvAdv adv = { s = "kui" ++ adv.s } ;
-                NPAcc    => ap.s ! True ! NCase Sg Gen } ;
-    a = agrP3 Sg ;
-    isPron = False
-    } ;
-{-
-  lincat
-    RNP     = {s : Agr => Str} ;
-    RNPList = {s1,s2 : Agr => Str} ;
 
-  lin 
+    -- : VP -> Adv -- et raamatut paremini näha
-    ReflRNP vps rnp = insertObjPre (\\a => vps.c2 ++ rnp.s ! a) vps ;
+    InOrderToVP vp = {s = "et" ++ infVPdefault vp InfDa} ;
 
-    -- : RNP 
+    -- : N2 -> VPSlash
-    ReflPron = {s = reflPron} ;
+    N2VPSlash n2 = UseComp (CompCN (UseN2 n2)) ** {c2 = n2.c2} ;
 
-    ReflPoss num cn = {s = \\a => possPron ! a ++ num.s ! Nom ++ cn.s ! num.n ! Nom} ;
+    -- : VPSlash -> NP -> NP ; publishing of the document
-    PredetRNP predet rnp = {s = \\a => predet.s ++ rnp.s ! a} ;
+    -- NominalizeVPSlashNP vpslash np = {} ;
-
-    ConjRNP conj rpns = conjunctDistrTable Agr conj rpns ;
-
-    Base_rr_RNP x y = twoTable Agr x y ;
-    Base_nr_RNP x y = twoTable Agr {s = \\a => x.s ! NPAcc} y ;
-    Base_rn_RNP x y = twoTable Agr x {s = \\a => y.s ! NPAcc} ;
-    Cons_rr_RNP x xs = consrTable Agr comma x xs ;
-    Cons_nr_RNP x xs = consrTable Agr comma {s = \\a => x.s ! NPAcc} xs ;
-
-    
----- 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) ;
--}                               
-  -- : S -> Comp ;                   -- (the fact is) that she sleeps
-  CompS s = {s = \\_ => "et" ++ s.s} ;
-
-  -- : QS -> Comp ;                  -- (the question is) who sleeps
-  CompQS qs = {s = \\_ => qs.s } ;
-
-  -- : Ant -> Pol -> VP -> Comp ;    -- (she is) to go
-  CompVP ant pol vp = {s = \\a => infVPAnt ant.a (NPCase Nom) pol.p a vp InfDa } ;
-
--- English-specific
-  -- : Pol 
-  UncontractedNeg = { s = [] ; p = Neg } ; 
-
-  -- : VP -> Utt ;  -- There's no "short form", so just using InfMa instead of InfDa 
-  UttVPShort vp = {s = infVP (NPCase Nom) Pos (agrP3 Sg) vp InfMa} ;
-  --TODO: maybe InfMa should be default in PhraseEst and InfDa here?
 
 
+---------------------------------
+-- P
 
-}
+  lin
+
+    -- : VPSlash -> NP -> VP ;  -- be begged by her to go
+    PassAgentVPSlash vps np = let vp : VP = PassVPSlash vps in vp ** {
+      adv = vp.adv ++ appCompl True Pos by8agent_Prep np ;
+      } ;
+
+
+    -- : VPSlash -> VP ; -- be forced to sleep
+    PassVPSlash vps = vps ** {
+      s = \\vf => case vf of {
+                    VIFin t => vps.s ! VIPass t ;
+                    x => vps.s ! x } ;
+      sc = compl2subjcase vps.c2
+      } ;
+
+    -- : VPSlash -> AP ;    -- täna leitud
+    PastPartAP vp = {
+      s = \\_,_ => vp2adv vp True (VIPass Past) ;
+      infl = Invariable
+      } ;
+
+    -- : VP -> AP ;   -- (the man) looking at Mary / filme vaatav (mees)
+    PresPartAP vp = {
+      s = \\_,_ => vp2adv vp True VIPresPart ;
+      infl = Invariable
+      } ;
+
+    -- : VPSlash -> NP -> AP    -- hobisukeldujate poolt leitud (süvaveepomm)
+    PastPartAgentAP vp np = {
+      s = \\_,_ => appCompl True Pos by8agent_Prep np ++ vp2adv vp True (VIPass Past) ;
+      infl = Invariable
+      } ;
+
+    PositAdVAdj = PositAdvAdj ;
+
+    -- : AP -> VP -> Cl ;   -- it is good to walk / on hea kõndida
+    PredAPVP ap vp =
+      let heaOllaVP : VP = insertObj (\\_,_,_ => ap.s ! True ! NCase Sg Nom) vp ; -- puts AP into the s2 field
+          heaOllaComp : Comp = CompVP ASimul PPos heaOllaVP ; -- chooses InfDa, fixes word order
+          heaOlla : VP = UseComp heaOllaComp -- looks silly, but I want to reuse the abstract syntax funs :-P
+       in existClause noSubj (agrP3 Sg) heaOlla ;
+
+    -- : IAdv -> VP -> QCl ; -- how to walk?
+    PredIAdvVP iadv vp = {s = \\t,a,p => iadv.s ++ infVPdefault vp InfMa} ;
+
+    PrepCN prep cn = PrepNP prep (MassNP cn) ;
+
+    ProDrop pron = pron ** {s = \\_ => []} ;
+
+    ProgrVPSlash vps = ProgrVP vps ** vps ;
+
+    PurposeVP = InOrderToVP ; --- is there a difference?
+
+  oper
+    -- calling infVP with the "default arguments": NPCase Nom, Pos, agrP3 Sg
+    infVPdefault : VP -> InfForms -> Str = infVP (NPCase Nom) Pos (agrP3 Sg) ;
+
+    vp2adv : R.VP -> Bool -> VIForm -> Str = \vp,sentIsPos,vif ->
+      let vpforms : {fin,inf : Str} = case vif of {
+            VIInf if => applyInfFormsVP {stem=if ; suf="a"} vp ; --- this oper shouldn't be used if you want to use an InfForm but just trying to be robust here
+            _        => mkVPForms vp.v ! vif ! Simul ! Pos ! agrP3 Sg} ;
+       in  vp.s2 ! sentIsPos ! Pos ! agrP3 Sg  -- raamatut
+        ++ vp.adv                           -- paremini
+        ++ vp.p                             -- ära
+        ++ vpforms.fin -- tunda/tundes/tundmata/...
+        ++ vpforms.inf -- TODO is this necessary???
+        ++ vp.ext ;
+
+---------------------------------
+-- S - W
+
+  lin
+
+    -- SlashBareV2S v s = insertExtrapos s.s (predV v) ** v ;
+
+    UseDAP,
+      UseDAPFem,
+      UseDAPMasc = DetNP ;
+
+    UttAccIP ip = {s = linIP NPAcc ip} ;
+    UttAccNP np = {s = linNP NPAcc np} ;
+    UttAdV adv = adv ;
+    UttDatIP ip = {s = linIP (NPCase Part) ip} ; -- is partitive a reasonable translation?
+    UttDatNP np = {s = linNP (NPCase Part) np} ;
+
+    -- : VP -> Utt ;  -- There's no "short form", so just using InfDa instead of InfMa
+    UttVPShort vp = {s = infVPdefault vp InfDa} ;
+
+    -- : VP -> Adv ;  -- ilma raamatut nägemata
+    WithoutVP vp = {s = "ilma" ++ infVPdefault vp InfMata} ;
+
+
+}

src/estonian/ExtraEst.gf

@@ -1,53 +1,60 @@
-concrete ExtraEst of ExtraEstAbs = CatEst ** 
+concrete ExtraEst of ExtraEstAbs = CatEst **
-  open ResEst, MorphoEst, Coordination, Prelude, NounEst, StructuralEst, (R = ParamX) in {
+  open ResEst, MorphoEst, Coordination, Prelude, NounEst, StructuralEst, (R = ParamX), (P = ParadigmsEst) in {
   flags coding=utf8;
   lin
     GenNP np = {
-      s,sp = \\_,_ => np.s ! NPCase Gen ;
+      s,sp = \\_,_ => linNP (NPCase Gen) np ;
       isNum  = False ;
       isDef  = True ; --- "Jussin kolme autoa ovat" ; thus "...on" is missing
-      isNeg = False 
+      isNeg = False
      } ;
 
-    GenCN = caseCN Gen ;     -- soome mees
+    GenCN = caseCN Genitive ;     -- soome mees
-    ComitCN = caseCN Comit ; -- puudega mets
+    ComitCN = caseCN Comitative ; -- puudega mets
-    ElatCN  = caseCN Elat ;  -- puust laud
+    ElatCN  = caseCN Elative ;  -- puust laud
-    AbessCN = caseCN Abess ; -- autota pere
+    AbessCN = caseCN Abessive ; -- autota pere
-    TerminCN = caseCN Termin ; -- maani kleit
+    TerminCN = caseCN Terminative ; -- maani kleit
 
-    GenIP ip = {s = \\_,_ => ip.s ! NPCase Gen} ;
+    GenIP ip = {s = \\_,_ => linIP (NPCase Gen) ip} ;
 
     GenRP num cn = {
-      s = \\n,c => let k = npform2case num.n c in relPron ! NCase n Gen ++ cn.s ! NCase num.n k ; 
+      s = \\n,c => let k = npform2case num.n c in relPron ! NCase n Gen ++ cn.s ! NCase num.n k ;
-      a = RNoAg 
+      a = RNoAg
 ---      a = RAg (agrP3 num.n)
       } ;
-  oper 
+  oper
-    caseCN : Case -> NP -> CN -> CN = \c,np,cn ->
+    caseCN : CasePlus -> NP -> CN -> CN = \c,np,cn -> cn ** {
-      lin CN { s = \\nf => np.s ! NPCase c ++ cn.s ! nf } ;
+      s = \\nf => appCompl True Pos (P.casePrep c) np ++ cn.s ! nf
+      } ;
 
   lincat
-    VPI   = {s : InfForm => Str} ;
+    VPI   = {s : InfStem => Str} ;
-    [VPI] = {s1,s2 : InfForm => Str} ;
+    [VPI] = {s1,s2 : InfStem => Str} ;
     -- VPI   = {s : Str} ;
     -- [VPI] = {s1,s2 : Str} ;
   lin
-    BaseVPI = twoTable InfForm ;
+    BaseVPI = twoTable InfStem ;
-    ConsVPI = consrTable InfForm comma ;
+    ConsVPI = consrTable InfStem comma ;
+
+    MkVPI vp = {s = \\i => infVPIF (NPCase Nom) Pos (agrP3 Sg) vp i} ;
+    ConjVPI = conjunctDistrTable InfStem ;
+    ComplVPIVV vv vpi =
+      insertObj (\\_,_,_ => vpi.s ! vv.vi.stem) (predV vv) ;
+
+  oper
+    -- Version that uses InfStem
+    infVPIF : NPForm -> Polarity -> Agr -> VP -> InfStem -> Str = \sc,pol,agr,vp,if ->
+      infVPAnt Simul sc pol agr vp {stem=if ; suf="a"} ;
 
-    MkVPI vp = {s = \\i => infVP (NPCase Nom) Pos (agrP3 Sg) vp i} ;
-    ConjVPI = conjunctDistrTable InfForm ;
-    ComplVPIVV vv vpi = 
-      insertObj (\\_,_,_ => vpi.s ! vv.vi) (predV vv) ;
 
   lincat
     VPS = {
-      s   : Agr  => Str ; 
+      s   : Agr  => Str ;
       sc  : NPForm ;  --- can be different for diff parts
       } ;
 
     [VPS] = {
-      s1,s2 : Agr  => Str ; 
+      s1,s2 : Agr  => Str ;
       sc    : NPForm ;  --- take the first: minä osaan kutoa ja täytyy virkata
       } ;
 
@@ -60,7 +67,7 @@ concrete ExtraEst of ExtraEstAbs = CatEst **
       } ;
 
     MkVPS t p vp = { --  Temp -> Pol -> VP -> VPS ;
-      s = \\a => let vps = vp.s ! VIFin t.t ! t.a ! p.p ! a
+      s = \\a => let vps = mkVPForms vp.v ! VIFin t.t ! t.a ! p.p ! a
                  in
                  t.s ++ p.s ++
                  vps.fin ++ vps.inf ++
@@ -79,102 +86,101 @@ concrete ExtraEst of ExtraEstAbs = CatEst **
 
    PassAgentVPSlash vp np = vp ;
  {-
-      s = {s = vp.s.s ; h = vp.s.h ; p = vp.s.p ; sc = npform2subjcase vp.c2.c} ; 
+      s = {s = vp.s.s ; h = vp.s.h ; p = vp.s.p ; sc = npform2subjcase vp.c2.c} ;
-      s2 = \\b,p,a => np.s ! NPCase Nom ++ vp.s2 ! b ! p ! a ;
+      s2 = \\b,p,a => linNP (NPCase Nom) np ++ vp.s2 ! b ! p ! a ;
       adv = vp.adv ;
       ext = vp.ext ;
       vptyp = vp.vptyp ;
       } ; -}
 
-    AdvExistNP adv np = 
+    AdvExistNP adv np =
-      mkClause (\_ -> adv.s) np.a (insertObj 
+      mkClause (\_ -> adv.s) np.a (insertObj
-        (\\_,b,_ => np.s ! NPCase Nom) (predV (verbOlema ** {sc = NPCase Nom}))) ;
+        (\\_,b,_ => linNP (NPCase Nom) np) (predV (verbOlema ** {sc = NPCase Nom}))) ;
 
     RelExistNP prep rp np = {
-      s = \\t,ant,bo,ag => 
+      s = \\t,ant,bo,ag =>
-      let 
+      let
         n = complNumAgr ag ;
-        cl = mkClause 
+        cl = mkClause
           (\_ -> appCompl True Pos prep (rp2np n rp))
-          np.a 
+          np.a
-          (insertObj 
+          (insertObj
-            (\\_,b,_ => np.s ! NPCase Nom) 
+            (\\_,b,_ => linNP (NPCase Nom) np)
             (predV (verbOlema ** {sc = NPCase Nom}))) ;
-      in 
+      in
       cl.s ! t ! ant ! bo ! SDecl ;
       c = NPCase Nom
       } ;
 
     AdvPredNP  adv v np =
-      mkClause (\_ -> adv.s) np.a (insertObj 
+      mkClause (\_ -> adv.s) np.a (insertObj
-        (\\_,b,_ => np.s ! NPCase Nom) (predV v)) ;
+        (\\_,b,_ => linNP (NPCase Nom) np) (predV v)) ;
 
-    ICompExistNP adv np = 
+    ICompExistNP adv np =
-      let cl = mkClause (\_ -> adv.s ! np.a) np.a (insertObj 
+      let cl = mkClause (\_ -> adv.s ! np.a) np.a (insertObj
-        (\\_,b,_ => np.s ! NPCase Nom) (predV (verbOlema ** {sc = NPCase Nom}))) ;
+        (\\_,b,_ => linNP (NPCase Nom) np) (predV (verbOlema ** {sc = NPCase Nom}))) ;
       in  {
         s = \\t,a,p => cl.s ! t ! a ! p ! SDecl
       } ;
 
     IAdvPredNP iadv v np =
-      let cl = mkClause (\_ -> iadv.s) np.a (insertObj 
+      let cl = mkClause (\_ -> iadv.s) np.a (insertObj
-                 (\\_,b,_ => np.s ! v.sc) (predV v)) ;
+                 (\\_,b,_ => linNP v.sc np) (predV v)) ;
       in  {
         s = \\t,a,p => cl.s ! t ! a ! p ! SDecl
       } ;
 
 --    i_implicPron = mkPronoun [] "minun" "minua" "minuna" "minuun" Sg P1 ;
-    whatPart_IP = {
+    whatPart_IP = emptyIP ** {
       s = table {
-        NPCase Nom | NPAcc => "mitä" ;
+        NPCase Nom | NPAcc => "mida" ;
         c => whatSg_IP.s ! c
         } ;
       n = Sg
     } ;
 
-    PartCN cn = 
+    PartCN cn =
-      let 
+      let
         acn = DetCN (DetQuant IndefArt NumSg) cn
-      in {
+      in acn ** {
         s = table {
           NPCase Nom | NPAcc => acn.s ! NPCase ResEst.Part ;
           c => acn.s ! c
-          } ; 
+          } ;
-        a = acn.a ;
         isPron = False ; isNeg = False
         } ;
 
     --The reflexive possessive "oma"
     --for "ta näeb oma koera" instead of *"tema koera"
     OmaPoss = {s,sp = \\_,_ => "oma" ; isDef,isNeg,isNum = False} ;
-    
+
     ma_Pron = shortPronoun "ma" "mu" "mind" "minu" Sg P1 ;
     sa_Pron = shortPronoun "sa" "su" "sind" "sinu" Sg P2;
     ta_Pron = shortPronoun "ta" "ta" "teda" "tema" Sg P3 ;
-    me_Pron = 
+    me_Pron =
     {s = table {
         NPCase Nom => "me" ;
-        n => (we_Pron.s) ! n 
+        n => (we_Pron.s) ! n
         } ;
-     a = Ag Pl P1 } ; 
+     a = Ag Pl P1 } ;
 
-    te_Pron = 
+    te_Pron =
     {s = table {
         NPCase Nom => "te" ;
-        n => (youPl_Pron.s) ! n 
+        n => (youPl_Pron.s) ! n
         } ;
-     a = Ag Pl P2 } ; 
+     a = Ag Pl P2 } ;
 
     nad_Pron =
     {s = table {
         NPCase Nom => "nad" ;
-        n => (they_Pron.s) ! n 
+        n => (they_Pron.s) ! n
         } ;
-     a = Ag Pl P3 } ; 
+     a = Ag Pl P3 } ;
 
 ---- copied from VerbEst.CompAP, should be shared
     ICompAP ap = {
-      s = \\agr => 
+      s = \\agr =>
           let
             n = complNumAgr agr ;
             c = case n of {
@@ -187,68 +193,68 @@ concrete ExtraEst of ExtraEstAbs = CatEst **
     IAdvAdv adv = {s = "kui" ++ adv.s} ;
 
     ProDrop p = {
-      s = table {NPCase (Nom | Gen) => [] ; c => p.s ! c} ; 
+      s = table {NPCase (Nom | Gen) => [] ; c => p.s ! c} ;
           ---- drop Gen only works in adjectival position
       a = p.a
       } ;
 
-    -- : Pron -> Quant ;  
+    -- : Pron -> Quant ;
     ProDropPoss p = {
       s = \\_,_ => "oma" ;
       sp = \\_,_ => p.s ! NPCase Gen ;
       isNum = False ;
-      isDef = True ; 
+      isDef = True ;
       isNeg = False
       } ;
 
-  lincat 
+  lincat
     ClPlus, ClPlusObj, ClPlusAdv = ClausePlus ;
     Part = {s : Str} ;
 
-  lin 
+  lin
-    S_SVO part t p clp = 
+    S_SVO part t p clp =
-      let 
+      let
          cl = clp.s ! t.t ! t.a ! p.p ;
          pa = part.s ----
       in
-      {s = t.s ++ p.s ++ cl.subj ++ pa ++ cl.fin ++ cl.inf ++ cl.compl ++ cl.adv ++ cl.ext} ; 
+      {s = t.s ++ p.s ++ cl.subj ++ pa ++ cl.fin ++ cl.inf ++ cl.compl ++ cl.adv ++ cl.ext} ;
 
-    S_OSV part t p clp = 
+    S_OSV part t p clp =
-      let 
+      let
          cl = clp.s ! t.t ! t.a ! p.p ;
          pa = part.s ----
       in
-      {s = t.s ++ p.s ++ cl.compl ++ pa ++ cl.subj ++ cl.fin ++ cl.inf ++ cl.adv ++ cl.ext} ; 
+      {s = t.s ++ p.s ++ cl.compl ++ pa ++ cl.subj ++ cl.fin ++ cl.inf ++ cl.adv ++ cl.ext} ;
-    S_VSO part t p clp = 
+    S_VSO part t p clp =
-      let 
+      let
          cl = clp.s ! t.t ! t.a ! p.p ;
          pa = part.s
       in
-      {s = t.s ++ p.s ++ cl.fin ++ pa ++ cl.subj ++ cl.inf ++ cl.compl ++ cl.adv ++ cl.ext} ; 
+      {s = t.s ++ p.s ++ cl.fin ++ pa ++ cl.subj ++ cl.inf ++ cl.compl ++ cl.adv ++ cl.ext} ;
-    S_ASV part t p clp = 
+    S_ASV part t p clp =
-      let 
+      let
          cl = clp.s ! t.t ! t.a ! p.p ;
          pa = part.s
       in
-      {s = t.s ++ p.s ++ cl.adv ++ pa ++ cl.subj ++ cl.fin ++ cl.inf ++ cl.compl ++ cl.ext} ; 
+      {s = t.s ++ p.s ++ cl.adv ++ pa ++ cl.subj ++ cl.fin ++ cl.inf ++ cl.compl ++ cl.ext} ;
 
-    S_OVS part t p clp = 
+    S_OVS part t p clp =
-      let 
+      let
          cl = clp.s ! t.t ! t.a ! p.p ;
          pa = part.s ----
       in
-      {s = t.s ++ p.s ++ cl.compl ++ pa ++ cl.fin ++ cl.inf ++ cl.subj ++ cl.adv ++ cl.ext} ; 
+      {s = t.s ++ p.s ++ cl.compl ++ pa ++ cl.fin ++ cl.inf ++ cl.subj ++ cl.adv ++ cl.ext} ;
 
     PredClPlus np vp = mkClausePlus (subjForm np vp.sc) np.a vp ;
     PredClPlusFocSubj np vp = insertKinClausePlus 0 (mkClausePlus (subjForm np vp.sc) np.a vp) ;
     PredClPlusFocVerb np vp = insertKinClausePlus 1 (mkClausePlus (subjForm np vp.sc) np.a vp) ;
-    PredClPlusObj  np vps obj = 
+    PredClPlusObj  np vps obj =
       insertObjClausePlus 0 False (\\b => appCompl True b vps.c2 obj) (mkClausePlus (subjForm np vps.sc) np.a vps) ;
-    PredClPlusFocObj  np vps obj = 
+    PredClPlusFocObj  np vps obj =
       insertObjClausePlus 0 True (\\b => appCompl True b vps.c2 obj) (mkClausePlus (subjForm np vps.sc) np.a vps) ;
-    PredClPlusAdv  np vp  adv = 
+    PredClPlusAdv  np vp  adv =
       insertObjClausePlus 1 False (\\_ => adv.s) (mkClausePlus (subjForm np vp.sc) np.a vp) ;
-    PredClPlusFocAdv  np vp  adv = 
+    PredClPlusFocAdv  np vp  adv =
       insertObjClausePlus 1 True (\\_ => adv.s) (mkClausePlus (subjForm np vp.sc) np.a vp) ;
 
     ClPlusWithObj c = c ;
@@ -256,4 +262,4 @@ concrete ExtraEst of ExtraEstAbs = CatEst **
 
     gi_Part = ss "gi" | ss "ki" ;
 
-} 
+}

src/estonian/ExtraEstAbs.gf

@@ -33,7 +33,7 @@ abstract ExtraEstAbs = Extra [
     me_Pron : Pron ;
     te_Pron : Pron ;
     nad_Pron : Pron ;
-    
+
     OmaPoss : Quant ;                     -- Reflexive possessive "oma"
     ProDropPoss : Pron -> Quant ;         -- vaimoni --TODO Is this relevant in Estonian? Is the agreement of pronoun ever needed, or is it the same as oma?
 

src/estonian/GrammarEst.gf

@@ -1,6 +1,6 @@
-concrete GrammarEst of Grammar = 
+concrete GrammarEst of Grammar =
-  NounEst, 
+  NounEst,
-  VerbEst, 
+  VerbEst,
   AdjectiveEst,
   AdverbEst,
   NumeralEst,

src/estonian/IdiomEst.gf

@@ -1,20 +1,20 @@
-concrete IdiomEst of Idiom = CatEst ** 
+concrete IdiomEst of Idiom = CatEst **
   open MorphoEst, ParadigmsEst, Prelude in {
 
   flags optimize=all_subs ; coding=utf8;
 
   lin
-    ExistNP np = 
+    ExistNP np =
-      let 
+      let
         cas : Polarity -> NPForm = \p -> case p of {
           Pos => NPCase Nom ; -- on olemas lammas
           Neg => NPCase Part  -- ei ole olemas lammast
           } ;
-        vp = insertObj (\\_,b,_ => "olemas" ++ np.s ! cas b) (predV olla)
+        vp = insertObj (\\_,b,_ => "olemas" ++ linNP (cas b) np) (predV olla)
       in
       existClause noSubj (agrP3 Sg) vp ;
 
-    ExistIP ip = 
+    ExistIP ip =
       let
         cas : NPForm = NPCase Nom ; ---- also partitive in Extra
         vp = insertObj (\\_,b,_ => "olemas") (predV olla) ;
@@ -28,7 +28,7 @@ concrete IdiomEst of Idiom = CatEst **
 
     CleftNP np rs = mkClause (\_ -> "see") (agrP3 Sg)
       (insertExtrapos (rs.s ! np.a)
-        (insertObj (\\_,_,_ => np.s ! NPCase Nom) (predV olla))) ;
+        (insertObj (\\_,_,_ => linNP (NPCase Nom) np) (predV olla))) ;
 
 -- This gives the almost forbidden "se on Porissa kun Matti asuu".
 -- Est: "see on Toris, kus Mati elab" (?)
@@ -39,35 +39,20 @@ concrete IdiomEst of Idiom = CatEst **
 
     ImpersCl vp = mkClause noSubj (agrP3 Sg) vp ;
 
-    GenericCl vp = mkClause noSubj (agrP3 Sg) {
+    GenericCl vp = mkClause noSubj (agrP3 Sg) (passiveVP vp) ;
-      s = \\_ => vp.s ! VIPass Pres ;
-      s2 = vp.s2 ;
-      adv = vp.adv ;
-      p = vp.p ;
-      ext = vp.ext ;
-      sc = vp.sc ; 
-      } ;
 
-    ProgrVP vp = 
+    ProgrVP vp = vp ** {
-      let 
+      v = verbOlema ;
-        inf = (vp.s ! VIInf InfMas ! Simul ! Pos ! agrP3 Sg).fin ;
+      s2 = \\b,p,a => vp.s2 ! b ! p ! a ++ (applyInfFormsVP InfMas vp).fin  ;
-        on  = predV olla
+      } ;
-      in {
-        s = on.s ;
-        s2 = \\b,p,a => vp.s2 ! b ! p ! a ++ inf ;
-        adv = vp.adv ;
-        p = vp.p ;
-        ext = vp.ext ;
-        sc = vp.sc ; 
-        } ;
 
 -- This gives "otetaan oluet" instead of "ottakaamme oluet".
 -- The imperative is not available in a $VP$.
 
-  ImpPl1 vp = 
+  ImpPl1 vp =
-    let vps = vp.s ! VIPass Pres ! Simul ! Pos ! Ag Pl P1
+    let vps = mkVPForms vp.v ! VIPass Pres ! Simul ! Pos ! Ag Pl P1
     in
-    {s = vps.fin ++ vps.inf ++ 
+    {s = vps.fin ++ vps.inf ++
          vp.s2 ! True ! Pos ! Ag Pl P1 ++ vp.p ++ vp.ext
     } ;
 

src/estonian/LexiconEst.gf

@@ -1,6 +1,6 @@
 concrete LexiconEst of Lexicon = CatEst ** open MorphoEst, ParadigmsEst, Prelude in {
 
-flags 
+flags
   optimize=values ; coding=utf8;
 
 
@@ -65,7 +65,7 @@ lin
   -- Unfortunately, we cannot use a similar trick for the source (*Põltsamaast vs Põltsamaalt).
   distance_N3 = mkN3 (mkN "kaugus") celative (casePrep terminative) ;
   doctor_N = mkN "arst" ;
-  dog_N = mkN "koer" "koera" "koera" ;
+  dog_N = mkN "koer" "koera" "koera" "koerasse" "koerte" "koeri" ;
   door_N = mkN "uks" "ukse" "ust" "uksesse" "uste" "uksi" ;
   drink_V2 = mkV2 (mkV "jooma") cpartitive ;
   easy_A2V = mkA2 (mkA (mkN "lihtne" "lihtsa" "lihtsat" "lihtsasse" "lihtsate" "lihtsaid")) callative ;
@@ -216,7 +216,7 @@ lin
   yellow_A = mkA (mkN "kollane" "kollase" "kollast" "kollasesse" "kollaste" "kollaseid") ;
   young_A = mkA (mkN "noor" "noore" "noort") ;
 
-  do_V2 = mkV2 (mkV "tegema" "teha") ; 
+  do_V2 = mkV2 (mkV "tegema" "teha") ;
 
   now_Adv = mkAdv "nüüd" ;
   already_Adv = mkAdv "juba" ;
@@ -232,7 +232,7 @@ lin
   correct_A = mkA (mkN "õige" "õige" "õiget" "õigesse" "õigete" "õigeid") ;
   dry_A = mkA (mkN "kuiv" "kuiva" "kuiva") "kuivem" "kuiveim" ;
   dull_A = mkA "igav" ;
-  full_A = mkA (mkN "täis" "täie" "täit" "täide" "täied" "täite") "täiem" "täiim" Invariable ; -- 'täis' is one of the non-inflecting adjectives
+  full_A = mkA (mkN "täis" "täie" "täit" "täide" "täite" "täisi") "täiem" "täiim" Invariable ; -- 'täis' is one of the non-inflecting adjectives
   heavy_A = mkA "raske" ;
   near_A = mkA "lähedane" ;
   rotten_A = mkA "mäda" ;
@@ -366,7 +366,7 @@ lin
 
  oper
     mkOrd1 : N -> Ord ;
-    mkOrd1 x = {s = x.s ; lock_Ord = <> } ;
+    mkOrd1 x = lin Ord x ;
     cpartitive = casePrep partitive ;
     ctranslative = casePrep translative ;
     celative = casePrep elative ;

src/estonian/MakeStructuralEst.gf

@@ -1,11 +1,12 @@
 resource MakeStructuralEst = open CatEst, ParadigmsEst, MorphoEst, Prelude in {
 
-oper 
+oper
-  mkConj : Str -> Str -> ParadigmsEst.Number -> Conj = \x,y,n -> 
+  mkConj : Str -> Str -> ParadigmsEst.Number -> Conj = \x,y,n -> lin Conj {
-    {s1 = x ; s2 = y ; n = n ; lock_Conj = <>} ;
+    s1 = x ;
-  mkSubj : Str -> Subj = \x -> 
+    s2 = y ;
-    {s = x ; lock_Subj = <>} ;
+    n = n
-  mkIQuant : Str -> IQuant = \s ->
+    } ;
-    {s = \\n,c => s ; lock_IQuant = <>} ; ----
+  mkSubj : Str -> Subj = \x -> lin Subj {s = x} ;
+  mkIQuant : Str -> IQuant = \s -> lin IQuant {s = \\n,c => s} ;
 
 }

src/estonian/MorphoEst.gf

@@ -11,7 +11,7 @@ resource MorphoEst = ResEst ** open Prelude, Predef, HjkEst in {
   flags optimize=all ; coding=utf8;
 
   oper
-    
+
 ----------------------
 -- morph. paradigms --
 ----------------------
@@ -19,7 +19,7 @@ resource MorphoEst = ResEst ** open Prelude, Predef, HjkEst in {
   --Noun paradigms in HjkEst
 
   --Comparative adjectives
-  --(could just use hjk_type_IVb_audit "suurem" "a") 
+  --(could just use hjk_type_IVb_audit "suurem" "a")
   -- Comparative adjectives inflect in the same way
   -- TODO: confirm this
   dSuurempi : Str -> NForms = \suurem ->
@@ -47,17 +47,17 @@ resource MorphoEst = ResEst ** open Prelude, Predef, HjkEst in {
       saama
       (saa + "da")
       (saa + "b")
-      (saa + "dakse") 
+      (saa + "dakse")
       (saa + "ge") -- Imper Pl
       sai
-      (saa + "nud") 
+      (saa + "nud")
       (saa + "dud") ;
 
   -- TS 49
   -- no d/t in da, takse ; imperfect 3sg ends in s
   cKaima : (_ : Str) -> VForms = \kaima ->
     let
-      kai = Predef.tk 2 kaima ;      
+      kai = Predef.tk 2 kaima ;
     in vForms8
       kaima
       (kai + "a")
@@ -65,10 +65,10 @@ resource MorphoEst = ResEst ** open Prelude, Predef, HjkEst in {
       (kai + "akse")
       (kai + "ge")
       (kai + "s")
-      (kai + "nud") 
+      (kai + "nud")
       (kai + "dud") ;
 
-  -- TS 49 
+  -- TS 49
   -- vowel changes in da, takse, no d/t ; imperfect 3sg ends in i
   cJooma : (_ : Str) -> VForms = \jooma ->
     let
@@ -78,7 +78,7 @@ resource MorphoEst = ResEst ** open Prelude, Predef, HjkEst in {
       u = case o of {
         "o" => "u" ;
         "ö" => "ü" ;
-         _  => o 
+         _  => o
         } ;
       q = case o of {
         ("o"|"ö") => "õ" ;
@@ -91,9 +91,9 @@ resource MorphoEst = ResEst ** open Prelude, Predef, HjkEst in {
       juua
       (joo + "b")
       (juua + "kse")
-      (joo + "ge") 
+      (joo + "ge")
       j6i
-      (joo + "nud") 
+      (joo + "nud")
       (joo + "dud") ;
 
   -- TS 50-52 (elama, muutuma, kirjutama), 53 (tegelema) alt forms
@@ -105,10 +105,10 @@ resource MorphoEst = ResEst ** open Prelude, Predef, HjkEst in {
       elama
       (ela + "da")
       (ela + "b")
-      (ela + "takse") 
+      (ela + "takse")
       (ela + "ge") -- Imperative P1 Pl
-      (ela + "s")  -- Imperfect P3 Sg 
+      (ela + "s")  -- Imperfect P3 Sg
-      (ela + "nud") 
+      (ela + "nud")
       (ela + "tud") ;
 
   -- TS 53 (tegelema)
@@ -121,12 +121,12 @@ resource MorphoEst = ResEst ** open Prelude, Predef, HjkEst in {
       tegelema
       (tegel + "da")
       (tegele + "b")
-      (tegel + "dakse") 
+      (tegel + "dakse")
       (tegel + "ge") -- Imperative P1 Pl
-      (tegele + "s") -- Imperfect P3 Sg 
+      (tegele + "s") -- Imperfect P3 Sg
-      (tegel + "nud") 
+      (tegel + "nud")
-      (tegel + "dud") ; 	
+      (tegel + "dud") ;
-      
+
   -- TS 54 (tulema)
   -- consonant assimilation (l,r,n) in da, takse
   -- d in tud, g in ge
@@ -146,7 +146,7 @@ resource MorphoEst = ResEst ** open Prelude, Predef, HjkEst in {
         (tul + "i")
         (tul + "nud")
         (tul + "dud") ;
-  
+
   -- TS 55-56 (õppima, sündima)
   -- t in takse, tud ; consonant gradation on stem
   cLeppima : (_ : Str) -> VForms = \leppima ->
@@ -154,7 +154,7 @@ resource MorphoEst = ResEst ** open Prelude, Predef, HjkEst in {
       leppi = Predef.tk 2 leppima ;
       i = last leppi ;
       lepp = init leppi ;
-      lepi = (weaker lepp) + i 
+      lepi = (weaker lepp) + i
     in vForms8
       leppima
       (leppi + "da")
@@ -164,7 +164,7 @@ resource MorphoEst = ResEst ** open Prelude, Predef, HjkEst in {
       (leppi + "s")  -- Imperfect P3 Sg
       (leppi + "nud")
       (lepi + "tud") ;
-      
+
   -- TS 57 (lugema)
   -- Like 55-56 but irregular gradation patterns, that shouldn't be in HjkEst.weaker
   --including also marssima,valssima
@@ -184,7 +184,7 @@ resource MorphoEst = ResEst ** open Prelude, Predef, HjkEst in {
         _ + ("uge"|"ude")       => l + "oe" ;
 
         _ + #c + "ssi"          => (init lug) + e;
-        _ => (weaker lug) + e 
+        _ => (weaker lug) + e
       } ;
     in vForms8
       lugema
@@ -195,8 +195,8 @@ resource MorphoEst = ResEst ** open Prelude, Predef, HjkEst in {
       (luge + "s")  -- Imperfect P3 Sg
       (luge + "nud")
       (loe + "tud") ;
-      
+
-      
+
   -- TS 58 muutma, saatma,
   -- like laskma (TS 62, 64), but no reduplication of stem consonant (muutma~muuta, not *muutta)
   -- like andma (TS 63) but different takse (muudetakse vs. antakse)
@@ -213,8 +213,8 @@ resource MorphoEst = ResEst ** open Prelude, Predef, HjkEst in {
       (muut + "is")
       (muut + "nud")
       (muud + "etud") ; -- always e?
-  
+
-  -- TS 59-60 (petma~petetakse, jätma~jäetakse) 
+  -- TS 59-60 (petma~petetakse, jätma~jäetakse)
   -- takse given as second argument
     cPetma : (_,_ : Str) -> VForms = \petma,jaetakse ->
     let
@@ -251,8 +251,8 @@ resource MorphoEst = ResEst ** open Prelude, Predef, HjkEst in {
       (jatt + "is")
       (jat + "nud")
       (ko + "etud") ;
--}      
+-}
-      
+
   -- TS 61 (laulma)
   --vowel (a/e) given with the second argument
   --veenma,naerma
@@ -268,7 +268,7 @@ resource MorphoEst = ResEst ** open Prelude, Predef, HjkEst in {
       (kuul + "is")
       (kuul + "nud")
       (kuul + "dud") ;
-      
+
   -- TS 62 (tõusma), 64 (mõksma)
   -- vowel (a/e) given with the second argument
   -- doesn't give alt. forms joosta, joostes
@@ -283,9 +283,9 @@ resource MorphoEst = ResEst ** open Prelude, Predef, HjkEst in {
       (las + "takse")
       (las + "ke")
       (lask + "is")
-      (lask + "nud") 
+      (lask + "nud")
       (las + "tud") ;
-      
+
   -- TS 62 alt forms
   cJooksma : (_ : Str) -> VForms = \jooksma ->
     let
@@ -298,10 +298,10 @@ resource MorphoEst = ResEst ** open Prelude, Predef, HjkEst in {
       (joos + "takse")
       (joos + "ke")
       (jooks + "is")
-      (jooks + "nud") 
+      (jooks + "nud")
       (joos + "tud") ;
 
-  -- TS 63 (andma, murdma, hoidma) 
+  -- TS 63 (andma, murdma, hoidma)
   -- vowel given in second arg (andma~annab; tundma~tunneb)
   cAndma : (_,_ : Str) -> VForms = \andma,annab ->
     let
@@ -310,18 +310,18 @@ resource MorphoEst = ResEst ** open Prelude, Predef, HjkEst in {
       ann = weaker and ;        --murr,     hoi
       te = case (last ann) of { --to prevent teadma~teaab
          "a" => init ann ;
-         _   => ann 
+         _   => ann
       } ;
     in vForms8
       andma
       (and + "a")
-      annab 
+      annab
       (an + "takse")
       (and + "ke")
       (and + "is")
       (and + "nud")
       (an + "tud") ;
-      
+
   -- TS 65 (pesema)
   -- a consonant stem verb in disguise
   cPesema : (_ : Str) -> VForms = \pesema ->
@@ -356,9 +356,9 @@ resource MorphoEst = ResEst ** open Prelude, Predef, HjkEst in {
       (nag + "i")
       (nai + "nud")
       (nah + "tud") ;
-  
+
-  
+
-  -- TS 67-68 (hüppama, tõmbama) 
+  -- TS 67-68 (hüppama, tõmbama)
   -- strong stem in ma, b, s
   -- weak stem in da, takse, ge, nud, tud
   -- t in da, takse; k in ge
@@ -387,7 +387,7 @@ resource MorphoEst = ResEst ** open Prelude, Predef, HjkEst in {
       omb = Predef.tk 2 omble ;
       omm = case omb of {
         "mõt" => "mõe" ; --some "double weak" patterns; however weaker (weaker omb) makes the coverage worse
-         _    => weaker omb 
+         _    => weaker omb
       } ;
       ommel = omm + e + l ;
     in vForms8
@@ -416,23 +416,11 @@ resource MorphoEst = ResEst ** open Prelude, Predef, HjkEst in {
       (satu + "tud") ; -- PastPartPass
 
 
-
 -----------------
 -- auxiliaries --
 -----------------
 
 
-{- Noun internal opers moved to ResEst
-
-These used to be here:
-  NForms : Type = Predef.Ints 5 => Str ;
-  Noun : Type   = {s: NForm => Str } ;
-  nForms6  : (x1,_,_,_,_,x6 : Str) -> NForms ;
-  n2nforms : Noun -> NForms ;
-  nForms2N : NForms -> Noun ;
-
--}
-
 -- Adjective forms
 
     AForms : Type = {
@@ -445,22 +433,21 @@ These used to be here:
     aForms2A : AForms -> Adjective = \afs -> {
       s = table {
         Posit => table {
-          AN n => (nForms2N afs.posit).s ! n ; 
+          AN n => (nForms2N afs.posit).s ! n ;
           AAdv => afs.adv_posit
           } ;
         Compar => table {
-          AN n => (nForms2N afs.compar).s ! n ; 
+          AN n => (nForms2N afs.compar).s ! n ;
           AAdv => afs.adv_compar
           } ;
         Superl => table {
-          AN n => (nForms2N afs.superl).s ! n ; 
+          AN n => (nForms2N afs.superl).s ! n ;
           AAdv => afs.adv_superl
           }
         } ;
-      lock_A = <>
       } ;
 
-    nforms2aforms : NForms -> AForms = \nforms -> 
+    nforms2aforms : NForms -> AForms = \nforms ->
       let
         suure = init (nforms ! 1) ;
         suur = Predef.tk 4 (nforms ! 8) ;
@@ -473,21 +460,12 @@ These used to be here:
         adv_superl = suur + "immin" ;
       } ;
 
-{-  Verb internal opers moved to ResEst
-
-These used to be here:
-  VForms : Type = Predef.Ints 7 => Str ;
-  vForms8 : (x1,_,_,_,_,_,_,x8 : Str) -> VForms ; 
-  regVForms : (x1,_,_,x4 : Str) -> VForms ;
-  vforms2V : VForms -> Verb ;
--}
-
 
 -----------------------
 -- for Structural
 -----------------------
 
-caseTable : Number -> Noun -> Case => Str = \n,cn -> 
+caseTable : Number -> Noun -> Case => Str = \n,cn ->
   \\c => cn.s ! NCase n c ;
 
   mkDet : Number -> Noun -> {
@@ -505,35 +483,30 @@ caseTable : Number -> Noun -> Case => Str = \n,cn ->
 -- Here we define personal and relative pronouns.
 
   -- input forms: Nom, Gen, Part
-  -- Note that the Fin version required 5 input forms, the
+  -- NPAcc is same as Part for Pron, and same as Gen for other nominals.
-  -- Est pronouns thus seem to be much simpler.
+  -- ResEst.appCompl returns right case for various types of complements,
-  -- TODO: remove NPAcc?
+  -- incl. when pronouns get different treatment than nouns (like in PassV2).
-  -- I: keep NPAcc; see appCompl in ResEst, it takes care of finding a right case for various types of complements; incl. when pronouns get different treatment than nouns (PassVP).
   mkPronoun : (_,_,_ : Str) -> Number -> Person ->
-    {s : NPForm => Str ; a : Agr} = 
+    {s : NPForm => Str ; a : Agr} =
     \mina, minu, mind, n, p ->
     let {
       minu_short = ie_to_i minu
-    } in 
+    } in
     {s = table {
       NPCase Nom    => mina ;
       NPCase Gen    => minu ;
       NPCase Part   => mind ;
       NPCase Transl => minu + "ks" ;
-      NPCase Ess    => minu + "na" ;
       NPCase Iness  => minu_short + "s" ;
       NPCase Elat   => minu_short + "st" ;
       NPCase Illat  => minu_short + "sse" ;
       NPCase Adess  => minu_short + "l" ;
       NPCase Ablat  => minu_short + "lt" ;
       NPCase Allat  => minu_short + "le" ;
-      NPCase Abess  => minu + "ta" ;
-      NPCase Comit  => minu + "ga" ;
-      NPCase Termin => minu + "ni" ;
       NPAcc         => mind
       } ;
      a = Ag n p
-    } ; 
+    } ;
 
   -- meiesse/teiesse -> meisse/teisse
   ie_to_i : Str -> Str ;
@@ -543,77 +516,67 @@ caseTable : Number -> Noun -> Case => Str = \n,cn ->
 		_ => x
 	} ;
 
-  shortPronoun : (_,_,_,_ : Str) -> Number -> Person -> 
+  -- NB. This doesn't work correctly with stem+suffix based solution:
-    {s : NPForm => Str ; a : Agr} = 
+  -- Ess, Abess, Comit, Termin all use the long Gen stem.
+  -- Alternative 1: let Gen be long form, leaving only Nom and Part actually short
+  -- Alternative 2: leave Gen short, postprocess Ess, Abess, Comit, Termin in application
+  -- Alternative 3: include two Gen stems in NPForm
+  shortPronoun : (_,_,_,_ : Str) -> Number -> Person ->
+    {s : NPForm => Str ; a : Agr} =
       \ma, mu, mind, minu, n, p ->
     let shortMa = mkPronoun ma mu mind n p ;
         mulle : Str = case mu of {
-           "mu" => "mulle" ; 
+           "mu" => "mulle" ;
            "su" => "sulle" ;
-           _     => shortMa.s ! NPCase Allat 
+           _     => shortMa.s ! NPCase Allat
         } ;
 
      in shortMa ** { s = table {
+         NPCase Gen => minu ; -- this is Alternative 1, see comment above. Comment out for Alternative 2.
          NPCase Allat => mulle ;
          NPCase Transl => minu + "ks" ;
-         NPCase Ess    => minu + "na" ;
-         NPCase Abess  => minu + "ta" ;
-         NPCase Comit  => minu + "ga" ;
-         NPCase Termin => minu + "ni" ;
          x          => shortMa.s ! x } } ;
-   
-
 
 
 oper
 
-  relPron : NForm => Str = 
+  relPron : NForm => Str =
-    let mis = nForms2N (nForms6 "mis" "mille" "mida" "millesse" "mille" "mida") 
+    let mis = nForms2N (nForms6 "mis" "mille" "mida" "millesse" "mille" "mida")
-     in fixPlNom "mis" mis.s ; 
+     in fixPlNom "mis" mis.s ;
 
   kesPron : NForm => Str =
-    let kes = nForms2N (nForms6 "kes" "kelle" "keda" "kellesse" "kelle" "keda") 
+    let kes = nForms2N (nForms6 "kes" "kelle" "keda" "kellesse" "kelle" "keda")
      in fixPlNom "kes" kes.s ;
 
   ProperName = {s : Case => Str} ;
 
-  -- TODO: generate using mkPronoun
   pronSe : ProperName  = {
     s = table {
       Nom    => "see" ;
       Gen    => "selle" ;
       Part   => "seda" ;
       Transl => "selleks" ;
-      Ess    => "sellena" ;
       Iness  => "selles" ;
       Elat   => "sellest" ;
       Illat  => "sellesse" ;
       Adess  => "sellel" ;
       Ablat  => "sellelt" ;
-      Allat  => "sellele" ;
+      Allat  => "sellele"
-      Abess  => "selleta" ;
-      Comit  => "sellega" ;
-      Termin => "selleni"
       } ;
     } ;
 
-  -- TODO: generate using mkPronoun
   pronNe : ProperName  = {
     s = table {
       Nom    => "need" ;
       Gen    => "nende" ;
       Part   => "neid" ;
       Transl => "nendeks" ;
-      Ess    => "nendena" ;
       Iness  => "nendes" ;
       Elat   => "nendest" ;
       Illat  => "nendesse" ;
       Adess  => "nendel" ;
       Ablat  => "nendelt" ;
-      Allat  => "nendele" ;
+      Allat  => "nendele"
-      Abess  => "nendeta" ;
-      Comit  => "nendega" ;
-      Termin => "nendeni" 
       } ;
     } ;
 

src/estonian/NounEst.gf

@@ -7,30 +7,23 @@ concrete NounEst of Noun = CatEst ** open ResEst, HjkEst, MorphoEst, Prelude in
 -- The $Number$ is subtle: "nuo autot", "nuo kolme autoa" are both plural
 -- for verb agreement, but the noun form is singular in the latter.
 
-    DetCN det cn = 
+    DetCN det cn =
       let
         n : Number = case det.isNum of {
           True => Sg ;
           _ => det.n
           } ;
         ncase : NPForm -> Case * NForm = \c ->
-          let k = npform2case n c 
+          let k = npform2case n c
-          in 
+          in
           case <n, c, det.isNum, det.isDef> of {
             <_, NPAcc,      True,_>  => <Nom,NCase Sg Part> ; -- kolm kassi (as object)
             <_, NPCase Nom, True,_>  => <Nom,NCase Sg Part> ; -- kolm kassi (as subject)
-
-            --Only the last word gets case ending.
-            <_, NPCase Comit, _, _>  => <Gen,NCase n Comit> ;  -- kolme kassiga
-            <_, NPCase Abess, _, _>  => <Gen,NCase n Abess> ;  -- kolme kassita
-            <_, NPCase Ess,   _, _>  => <Gen,NCase n Ess> ;    -- kolme kassina
-            <_, NPCase Termin,_, _>  => <Gen,NCase n Termin> ; -- kolme kassini
-            
             <_, _, True,_>           => <k,  NCase Sg k> ;     -- kolmeks kassiks (all other cases)
             _                        => <k,  NCase n k>        -- kass, kassi, ... (det is not a number)
             }
-      in {
+      in cn ** {
-      s = \\c => let 
+      s = \\c => let
                    k = ncase c ;
                  in
                  det.s ! k.p1 ++ cn.s ! k.p2 ;
@@ -42,15 +35,15 @@ concrete NounEst of Noun = CatEst ** open ResEst, HjkEst, MorphoEst, Prelude in
       isPron = False
       } ;
 
-    DetNP det = 
+    DetNP det =
       let
         n : Number = case det.isNum of {
           True => Sg ;
           _ => det.n
           } ;
-      in {
+      in emptyNP ** {
         s = \\c => let k = npform2case n c in
-                 det.sp ! k ; 
+                 det.sp ! k ;
         a = agrP3 (case det.isDef of {
             False => Sg ;  -- autoja menee; kolme autoa menee
             _ => det.n
@@ -58,41 +51,28 @@ concrete NounEst of Noun = CatEst ** open ResEst, HjkEst, MorphoEst, Prelude in
         isPron = False
       } ;
 
-    UsePN pn = {
+    UsePN pn = emptyNP ** {
-      s = \\c => pn.s ! npform2case Sg c ; 
+      s = \\c => pn.s ! npform2case Sg c ;
       a = agrP3 Sg ;
       isPron = False
       } ;
-    UsePron p = p ** {isPron = True} ;
+    UsePron p = p ** {isPron = True ; postmod = []} ;
 
-    PredetNP pred np = {
+    PredetNP pred np = np ** {
       s = \\c => pred.s ! complNumAgr np.a ! c ++ np.s ! c ;
-      a = np.a ;
-      isPron = np.isPron  -- kaikki minun - ni
       } ;
 
     PPartNP np v2 =
-      let 
+      let
         num : Number     = complNumAgr np.a ;
         part : Str       = v2.s ! (PastPart Pass) ;
-        adj : NForms     = hjk_type_IVb_maakas part ; 
+      in np ** {postmod = np.postmod ++ part} ;
-        partGen : Str    = adj ! 1 ;
-	partEss : Str    = partGen + "na"
-      in {
-        s = \\c => np.s ! c ++ part ; --partEss ;
-        a = np.a ;
-        isPron = np.isPron  -- minun täällä - ni
-      } ;
 
-    AdvNP np adv = {
+    AdvNP np adv = np ** {postmod = np.postmod ++ adv.s} ;
-      s = \\c => np.s ! c ++ adv.s ;
-      a = np.a ;
-      isPron = np.isPron  -- minun täällä - ni
-      } ;
 
     DetQuantOrd quant num ord = {
-      s = \\c => quant.s ! num.n ! c ++ num.s ! Sg ! c ++ ord.s ! NCase num.n c ; 
+      s = \\c => quant.s ! num.n ! c ++ num.s ! Sg ! c ++ ord.s ! NCase num.n c ;
-      sp = \\c => quant.sp ! num.n ! c ++ num.s ! Sg ! c ++ ord.s ! NCase num.n c ; 
+      sp = \\c => quant.sp ! num.n ! c ++ num.s ! Sg ! c ++ ord.s ! NCase num.n c ;
       n = num.n ;
       isNum = num.isNum ;
       isDef = quant.isDef
@@ -106,13 +86,28 @@ concrete NounEst of Noun = CatEst ** open ResEst, HjkEst, MorphoEst, Prelude in
       isDef = quant.isDef
       } ;
 
+    DetDAP det = det ;
+
+    AdjDAP dap ap = dap ** {
+      s = \\c => dap.s ! c ++
+                   case ap.infl of {
+                     Regular => ap.s ! True ! NCase dap.n c ;
+                     _ => ap.s ! True ! NCase dap.n Nom  ---- participle
+                 } ;
+      sp = \\c => dap.sp ! c ++
+                   case ap.infl of {
+                     Regular => ap.s ! True ! NCase dap.n c ;
+                     _ => ap.s ! True ! NCase dap.n Nom  ---- participle
+                 } ;
+      } ;
+
     PossPron p = {
       s,sp = \\_,_ => p.s ! NPCase Gen ;
       isNum = False ;
       isDef = True  --- "minun kolme autoani ovat" ; thus "...on" is missing
       } ;
 
-    PossNP cn np = {s = \\nf => np.s ! NPCase Gen ++ cn.s ! nf };
+    PossNP cn np = np ** {s = \\nf => linNP (NPCase Gen) np ++ cn.s ! nf} ;
 
     NumSg = {s = \\_,_ => [] ; isNum = False ; n = Sg} ;
     NumPl = {s = \\_,_ => [] ; isNum = False ; n = Pl} ;
@@ -120,19 +115,19 @@ concrete NounEst of Noun = CatEst ** open ResEst, HjkEst, MorphoEst, Prelude in
     NumCard n = n ** {isNum = case n.n of {Sg => False ; _ => True}} ;  -- üks raamat/kaks raamatut
 
     NumDigits numeral = {
-      s = \\n,c => numeral.s ! NCard (NCase n c) ; 
+      s = \\n,c => numeral.s ! NCard (NCase n c) ;
-      n = numeral.n 
+      n = numeral.n
       } ;
     OrdDigits numeral = {s = \\nc => numeral.s ! NOrd nc} ;
 
     NumNumeral numeral = {
-      s = \\n,c => numeral.s ! NCard (NCase n c) ; 
+      s = \\n,c => numeral.s ! NCard (NCase n c) ;
       n = numeral.n
       } ;
     OrdNumeral numeral = {s = \\nc => numeral.s ! NOrd nc} ;
 
     AdNum adn num = {
-      s = \\n,c => adn.s ++ num.s ! n ! c ; 
+      s = \\n,c => adn.s ++ num.s ! n ! c ;
       n = num.n
       } ;
 
@@ -141,17 +136,17 @@ concrete NounEst of Noun = CatEst ** open ResEst, HjkEst, MorphoEst, Prelude in
     OrdSuperl a = {s = \\nc => "kõige" ++ a.s ! Compar ! AN nc} ;
 
     DefArt = {
-      s = \\_,_ => [] ; 
+      s = \\_,_ => [] ;
-      sp = table {Sg => pronSe.s ; Pl => pronNe.s} ; 
+      sp = table {Sg => pronSe.s ; Pl => pronNe.s} ;
       isNum = False ;
       isDef = True   -- autot ovat
       } ;
 
     IndefArt = {
       s = \\_,_ => [] ; --use isDef in DetCN
-      sp = \\n,c => 
+      sp = \\n,c =>
-         (nForms2N (nForms6 "üks" "ühe" "üht" "ühesse" "ühtede" 
+         (nForms2N (nForms6 "üks" "ühe" "üht" "ühesse" "ühtede"
-         "ühtesid")).s ! NCase n c ; 
+         "ühtesid")).s ! NCase n c ;
       isNum,isDef = False -- autoja on
       } ;
 
@@ -159,64 +154,65 @@ concrete NounEst of Noun = CatEst ** open ResEst, HjkEst, MorphoEst, Prelude in
       let
         n : Number = Sg ;
         ncase : Case -> NForm = \c -> NCase n c ;
-      in {
+      in cn ** {
         s = \\c => let k = npform2case n c in
-                cn.s ! ncase k ; 
+                cn.s ! ncase k ;
         a = agrP3 Sg ;
         isPron = False
       } ;
 
-    UseN n = n ;
+    UseN n = emptyCN ** {
+      s = n.s
+      } ;
 
     UseN2 n = n ;
 
-    Use2N3 f = lin N2 {
+    Use2N3 f = f ** {
-      s = f.s ;
+      postmod = []
-      c2 = f.c2 ;
-      isPre = f.isPre
       } ;
-    Use3N3 f = lin N2 {
+    Use3N3 f = f ** {
-      s = f.s ;
+      c2 = f.c3 ;
+      isPre = f.isPre2 ;
+      postmod = []
+      } ;
+
+    ComplN2 f x = let compl : Str = appCompl True Pos f.c2 x in {
+      s = \\nf => case f.isPre of {
+            True => f.s ! nf ;         -- N2 is pre, so compl goes into postmod
+            False => compl ++ f.s ! nf -- N2 isn't pre, compl goes in s before the N2
+            } ;
+      postmod = f.postmod ++ if_then_Str f.isPre compl []
+      } ;
+
+    -- N2 is subtype of CN, so we can reuse result of ComplN2 as a base for our CN.
+    -- The decision of noun-complement order is only done once, in ComplN2.
+    ComplN3 f x = let cn : CN = ComplN2 (Use2N3 f) x in cn ** {
       c2 = f.c3 ;
       isPre = f.isPre2
       } ;
 
-    ComplN2 f x = {
+    AdjCN ap cn = cn ** {
-      s = \\nf => preOrPost f.isPre (f.s ! nf) (appCompl True Pos f.c2 x)
+      s = \\nf =>
-      } ;
-
-
-    ComplN3 f x = lin N2 {
-      s = \\nf => preOrPost f.isPre (f.s ! nf) (appCompl True Pos f.c2 x) ;
-      c2 = f.c3 ;
-      isPre = f.isPre2
-      } ;
-
-
-    AdjCN ap cn = {
-      s = \\nf => 
         case ap.infl of {
-          (Invariable|Participle) => ap.s ! True ! (NCase Sg Nom) ++ cn.s ! nf ; --valmis kassile; väsinud kassile
+          Invariable|Participle => ap.s ! True ! NCase Sg Nom ++ cn.s ! nf ; --valmis kassile; väsinud kassile
-          Regular => case nf of { 
+          Regular => ap.s ! True ! nf ++ cn.s ! nf -- Ess,Abess,Comit,Termin will only get case ending after the CN, so suure kassiga, not *suurega kassiga
-              NCase num (Ess|Abess|Comit|Termin) => ap.s ! True ! (NCase num Gen) ++ cn.s ! nf ; --suure kassiga, not *suurega kassiga 
+          }
-              _ => ap.s ! True ! nf ++ cn.s ! nf
-              } 
-          } 
       } ;
 
-    RelCN cn rs = {s = \\nf => cn.s ! nf ++ rs.s ! agrP3 (numN nf)} ;
+    RelCN cn rs = cn ** { -- exception to postmod rule, because RS depends on Agr
+      s = \\nf => cn.s ! nf ++ rs.s ! agrP3 (numN nf)
+      } ;
 
-    RelNP np rs = {
+    RelNP np rs = np ** {
-      s = \\c => np.s ! c ++ "," ++ rs.s ! np.a ; 
+      postmod = np.postmod ++ "," ++ rs.s ! np.a ;
-      a = np.a ;  
       isPron = np.isPron ---- correct ?
       } ;
 
-    AdvCN cn ad = {s = \\nf => cn.s ! nf ++ ad.s} ;
+    AdvCN cn ad = cn ** {postmod = cn.postmod ++ ad.s} ;
 
-    SentCN cn sc = {s = \\nf=> cn.s ! nf ++ sc.s} ;
+    SentCN cn sc = cn ** {postmod = cn.postmod ++ sc.s} ;
 
-    ApposCN cn np = {s = \\nf=> cn.s ! nf ++ np.s ! NPCase Nom} ; --- luvun x
+    ApposCN cn np = cn ** {postmod = cn.postmod ++ linNP (NPCase Nom) np} ; --- luvun x
 
   oper
     numN : NForm -> Number = \nf -> case nf of {

src/estonian/ParadigmsEst.gf

@@ -2,12 +2,12 @@
 --
 -- Based on the Finnish Lexical Paradigms by Aarne Ranta 2003--2008
 --
--- This is an API to the user of the resource grammar 
+-- This is an API to the user of the resource grammar
 -- for adding lexical items. It gives functions for forming
 -- expressions of open categories: nouns, adjectives, verbs.
--- 
+--
 -- Closed categories (determiners, pronouns, conjunctions) are
--- accessed through the resource syntax API and $Structural.gf$. 
+-- accessed through the resource syntax API and $Structural.gf$.
 --
 -- The main difference with $MorphoEst.gf$ is that the types
 -- referred to are compiled resource grammar types. We have moreover
@@ -23,19 +23,20 @@
 -- @author Kaarel Kaljurand
 -- @version 2013-10-21
 
-resource ParadigmsEst = open 
+resource ParadigmsEst = open
-  (Predef=Predef), 
+  (Predef=Predef),
-  Prelude, 
+  Prelude,
   MorphoEst,
+  (ResEst=ResEst),
   HjkEst,
   CatEst
   in {
 
   flags optimize=noexpand ; coding=utf8;
 
---2 Parameters 
+--2 Parameters
 --
--- To abstract over gender, number, and (some) case names, 
+-- To abstract over gender, number, and (some) case names,
 -- we define the following identifiers. The application programmer
 -- should always use these constants instead of the constructors
 -- defined in $ResEst$.
@@ -62,6 +63,8 @@ oper
   abessive    : Case ; -- e.g. "karbita"
   comitative  : Case ; -- e.g. "karbiga"
 
+  InfForm : Type ;
+
   infDa : InfForm ; -- e.g. "lugeda"
   infDes : InfForm ; -- e.g. "lugedes"
   infMa : InfForm ; -- e.g. "lugema"
@@ -69,6 +72,7 @@ oper
   infMaks : InfForm ; -- e.g. "lugemaks"
   infMast : InfForm ;  -- e.g. "lugemast"
   infMata : InfForm ; -- e.g. "lugemata"
+  infMine : InfForm ; -- e.g. "lugemine"
 
 -- The following type is used for defining *rection*, i.e. complements
 -- of many-place verbs and adjective. A complement can be defined by
@@ -83,15 +87,15 @@ oper
 --2 Conjunctions, adverbs
 
 
-  mkAdv : Str -> Adv ; 
+  mkAdv : Str -> Adv ;
-  mkAdV : Str -> AdV ; 
+  mkAdV : Str -> AdV ;
-  mkAdN : Str -> AdN ; 
+  mkAdN : Str -> AdN ;
-  mkAdA : Str -> AdA ; 
+  mkAdA : Str -> AdA ;
 
   mkConj : overload {
     mkConj : Str -> Conj ; -- just one word, default number Sg: e.g. "ja"
     mkConj : Str -> Number -> Conj ; --just one word + number: e.g. "ja" Pl
-    mkConj : Str -> Str -> Conj ; --two words, default number: e.g. "nii" "kui" 
+    mkConj : Str -> Str -> Conj ; --two words, default number: e.g. "nii" "kui"
     mkConj : Str -> Str -> Number -> Conj ; --two words + number: e.g. "nii" "kui" Pl
   } ;
 
@@ -139,7 +143,7 @@ oper
 
 -- Non-comparison one-place adjectives are just like nouns.
 -- The regular adjectives are based on $regN$ in the positive.
--- Comparison adjectives have three forms. 
+-- Comparison adjectives have three forms.
 -- The comparative and the superlative
 -- are always inflected in the same way, so the nominative of them is actually
 -- enough (TODO: confirm).
@@ -154,9 +158,9 @@ oper
 -- Two-place adjectives need a case for the second argument.
 
   mkA2 : A -> Prep -> A2  -- e.g. "vihane" (postGenPrep "peale")
-    = \a,p -> a ** {c2 = p ; lock_A2 = <>};
+    = \a,p -> lin A2 (a ** {c2 = p}) ;
 
-  invA : Str -> A ; -- invariable adjectives, such as genitive attributes ; no agreement to head, no comparison forms. 
+  invA : Str -> A ; -- invariable adjectives, such as genitive attributes ; no agreement to head, no comparison forms.
 
 --2 Verbs
 --
@@ -237,8 +241,8 @@ oper
     mkV2V : V -> Prep -> V2V ;  -- e.g. "käskima" adessive
     mkV2V : Str -> V2V ;  -- e.g. "käskima" adessive
   } ;
-  mkV2Vf : V -> Prep -> InfForm -> V2V ; -- e.g. "keelama" partitive infMast 
+  mkV2Vf : V -> Prep -> InfForm -> V2V ; -- e.g. "keelama" partitive infMast
- 
+
   mkVA  : overload {
      mkVA : V -> Prep -> VA ; -- e.g. "muutuma" translative
      mkVA : Str       -> VA ; -- string, default case translative
@@ -248,21 +252,21 @@ oper
      mkV2A : V -> Prep -> Prep -> V2A ; -- e.g. "värvima" genitive translative
      mkV2A : Str               -> V2A ; -- string, default cases genitive and translative
   } ;
- 
+
   mkVQ  : overload {
-     mkVQ : V -> VQ ; 
+     mkVQ : V -> VQ ;
-     mkVQ : Str -> VQ ; 
+     mkVQ : Str -> VQ ;
   } ;
-  mkV2Q : V -> Prep -> V2Q ; -- e.g. "küsima" ablative 
+  mkV2Q : V -> Prep -> V2Q ; -- e.g. "küsima" ablative
 
   mkAS  : A -> AS ; --%
   mkA2S : A -> Prep -> A2S ; --%
   mkAV  : A -> AV ; --%
   mkA2V : A -> Prep -> A2V ; --%
 
--- Notice: categories $AS, A2S, AV, A2V$ are just $A$, 
+-- Notice: categories $AS, A2S, AV, A2V$ are just $A$,
 -- and the second argument is given
--- as an adverb. Likewise 
+-- as an adverb. Likewise
 -- $V0$ is just $V$.
 
   V0 : Type ; --%
@@ -272,48 +276,67 @@ oper
 -- The definitions should not bother the user of the API. So they are
 -- hidden from the document.
 
-  Case = MorphoEst.Case ;
+  Case = MorphoEst.CasePlus ;
   Number = MorphoEst.Number ;
 
   singular = Sg ;
   plural = Pl ;
 
-  nominative = Nom ;
+  nominative  = Nominative ;
-  genitive = Gen ;
+  genitive    = Genitive ;
-  partitive = Part ;
+  partitive   = Partitive ;
-  illative = Illat ;
+  illative    = Illative ;
-  inessive = Iness ;
+  inessive    = Inessive ;
-  elative = Elat ;
+  elative     = Elative ;
-  allative = Allat ;
+  allative    = Allative ;
-  adessive = Adess ;
+  adessive    = Adessive ;
-  ablative = Ablat ;
+  ablative    = Ablative ;
-  translative = Transl ;
+  translative = Translative ;
-  terminative = Termin ;
+  terminative = Terminative ;
-  essive  = Ess ;
+  essive      = Essive ;
-  abessive = Abess ;  
+  abessive    = Abessive ;
-  comitative = Comit ;
+  comitative  = Comitative ;
- 
+
+  -- IL 2022-04: after introducing stem+suffixes, 4 other cases have just genitive stems.
+  -- isActuallyGenitive is needed for those mkN2 and mkN3 instances that take a Prep as an argument,
+  -- and actual Gen gets isPre=True, and those with genitive stem+suffix should get False.
+  -- This is confusing and error-prone, consider restructuring/renaming things later.
+  isActuallyGenitive : MorphoEst.CasePlus -> Bool = \c -> case c of {
+    {c = MorphoEst.Gen ; suf = ""} => True ;
+    _ => False
+  } ;
+
+  -- combination of stem + suffix, e.g. infDes = {stem = InfD ; suf = "es"} ;
+  InfForm = ResEst.InfForms ;
   infDa = InfDa ; infMa = InfMa ; infMast = InfMast ;
-  infDes = InfDes ; infMas = InfMas ; infMaks = InfMaks ; infMata = InfMata ;
+  infDes = InfDes ; infMas = InfMas ; infMaks = InfMaks ; infMata = InfMata ; infMine = InfMine ;
 
-  prePrep  : Case -> Str -> Prep = 
+  mkPrep : (isPre : Bool) -> Case -> Str ->  Prep = \isPre,c,p -> lin Prep {
-    \c,p -> {c = NPCase c ; s = p ; isPre = True ; lock_Prep = <>} ;
+    c = casep2npformp c ;
-  postPrep : Case -> Str -> Prep =
+    s = p ;
-    \c,p -> {c = NPCase c ; s = p ; isPre = False ; lock_Prep = <>} ;
+    isPre = isPre
-  postGenPrep p = {
+    } ;
-    c = NPCase genitive ; s = p ; isPre = False ; lock_Prep = <>} ;
+  prePrep  : Case -> Str -> Prep = mkPrep True ;
-  casePrep : Case -> Prep =
+  postPrep : Case -> Str -> Prep = mkPrep False ;
-    \c -> {c = NPCase c ; s = [] ; isPre = True ; lock_Prep = <>} ;
+  postGenPrep : Str -> Prep = postPrep genitive ;
-  accPrep =  {c = NPAcc ; s = [] ; isPre = True ; lock_Prep = <>} ;
 
+  -- The Prep's isPre field is used in a special (hacky) way in mkN3 and mkN2.
+  -- Used to be able to match whether the Prep's case is Gen, but now several
+  -- Preps use the genitive stem, so we need to check if it's actually genitive.
+  casePrep : Case -> Prep = \c -> mkPrep (isActuallyGenitive c) c [] ;
 
-  mkAdv : Str -> Adv = \str -> {s = str ; lock_Adv = <>} ;
+  -- NPAcc is different, it's not formed from a Case(Plus)
-  mkAdV : Str -> AdV = \str -> {s = str ; lock_AdV = <>} ;
+  accPrep : Prep = lin Prep {
-  mkAdN : Str -> AdN = \str -> {s = str ; lock_AdN = <>} ;
+    c = case2npformp NPAcc ;
-  mkAdA : Str -> AdA = \str -> {s = str ; lock_AdA = <>} ;
+    s = [] ;
+    isPre = True
+    } ;
 
+  mkAdv : Str -> Adv = \str -> lin Adv (ss str) ;
+  mkAdV : Str -> AdV = \str -> lin AdV (ss str) ;
+  mkAdN : Str -> AdN = \str -> lin AdN (ss str) ;
+  mkAdA : Str -> AdA = \str -> lin AdA (ss str) ;
 
-  
   mkConj = overload {
     mkConj : Str -> Conj = \ja -> lin Conj ((sd2 "" ja) ** {n = Sg}) ;
     mkConj : Str -> Number -> Conj = \ja,num -> lin Conj ((sd2 "" ja) ** {n = num}) ;
@@ -321,7 +344,7 @@ oper
     mkConj : Str -> Str -> Number -> Conj = \nii,kui,num -> lin Conj ((sd2 nii kui) ** {n = num}) ;
   } ;
 
-  mkPConj s = ss s ** {lock_PConj = <>} ;
+  mkPConj s = lin PConj (ss s) ;
 
   mkN = overload {
     mkN : (nisu : Str) -> N = mk1N ;
@@ -335,43 +358,42 @@ oper
   } ;
 
   -- Adjective forms (incl. comp and sup) are derived from noun forms
-  mk1A : Str -> A = \suur -> 
+  mk1A : Str -> A = \suur ->
-    let aforms = aForms2A (nforms2aforms (hjk_type suur)) 
+    let aforms = aForms2A (nforms2aforms (hjk_type suur))
-    in  aforms ** {infl = Regular } ;
+     in lin A (aforms ** {infl = Regular}) ;
-      
-  mkNA : N -> A = \suur -> 
-    let aforms = aForms2A (nforms2aforms (n2nforms suur)) ; 
-    in  aforms ** {infl = Regular } ;
 
+  mkNA : N -> A = \suur ->
+    let aforms = aForms2A (nforms2aforms (n2nforms suur)) ;
+     in lin A (aforms ** {infl = Regular}) ;
 
-  mk1N : (link : Str) -> N = \s -> nForms2N (hjk_type s) ** {lock_N = <> } ;
+  mk1N : (link : Str) -> N = \s -> lin N (nForms2N (hjk_type s)) ;
 
   -- mk2N, mk3N, mk4N make sure that the user specified forms end up in the paradigm,
   -- even though the rest is wrong
-  mk2N : (link,lingi : Str) -> N = \link,lingi -> 
+  mk2N : (link,lingi : Str) -> N = \link,lingi ->
-    let nfs : NForms = (nForms2 link lingi) ; 
+    let nfs : NForms = (nForms2 link lingi) ;
         nfs_fixed : NForms = table {
                 0 => link ;
                 1 => lingi ;
                 2 => nfs ! 2 ;
                 3 => nfs ! 3 ;
                 4 => nfs ! 4 ;
-                5 => nfs ! 5 
+                5 => nfs ! 5
         } ;
-    in  nForms2N nfs_fixed ** {lock_N = <> } ;
+    in lin N (nForms2N nfs_fixed) ;
 
 
-  mk3N : (tukk,tuku,tukku : Str) -> N = \tukk,tuku,tukku -> 
+  mk3N : (tukk,tuku,tukku : Str) -> N = \tukk,tuku,tukku ->
-    let nfs : NForms = (nForms3 tukk tuku tukku) ; 
+    let nfs : NForms = (nForms3 tukk tuku tukku) ;
         nfs_fixed : NForms = table {
                 0 => tukk ;
                 1 => tuku ;
                 2 => tukku ;
                 3 => nfs ! 3 ;
                 4 => nfs ! 4 ;
-                5 => nfs ! 5  
+                5 => nfs ! 5
         } ;
-    in nForms2N nfs_fixed ** {lock_N = <> } ;
+    in lin N (nForms2N nfs_fixed) ;
 
 
   mk4N : (paat,paadi,paati,paate : Str) -> N = \paat,paadi,paati,paate ->
@@ -381,20 +403,20 @@ oper
                 1 => paadi ;
                 2 => paati ;
                 3 => nfs ! 3 ;
-                4 => nfs ! 4 ; 
+                4 => nfs ! 4 ;
                 5 => paate
         } ;
-    in nForms2N nfs_fixed ** {lock_N = <> } ;
+    in lin N (nForms2N nfs_fixed) ;
 
 
   mk6N : (oun,ouna,ouna,ounasse,ounte,ounu : Str) -> N =
-      \a,b,c,d,e,f -> nForms2N (nForms6 a b c d e f) ** {lock_N = <> } ;
+      \a,b,c,d,e,f -> lin N (nForms2N (nForms6 a b c d e f)) ;
 
-  mkStrN : Str -> N -> N = \sora,tie -> {
+  mkStrN : Str -> N -> N = \sora,tie -> tie ** {
-    s = \\c => sora + tie.s ! c ; lock_N = <>
+    s = \\c => sora + tie.s ! c
     } ;
-  mkNN : N -> N -> N = \oma,tunto -> {
+  mkNN : N -> N -> N = \oma,tunto -> tunto ** {
-    s = \\c => oma.s ! c + tunto.s ! c ; lock_N = <>
+    s = \\c => oma.s ! c + tunto.s ! c ;
     } ; ---- TODO: oma in possessive suffix forms
 
 
@@ -510,7 +532,7 @@ oper
       -- voolik/vooliku/voolikut
       <_ + #c, _ + #v, _ + #v + "t"> => hjk_type_IVb_audit tukk u ;
 
-      _ => nForms2 tukk tuku 
+      _ => nForms2 tukk tuku
     } ;
 
   nForms4 : (_,_,_,_ : Str) -> NForms = \paat,paadi,paati,paate ->
@@ -518,33 +540,33 @@ oper
      -- distinguish between joonis and segadus
       <_ +("ne"|"s"),  _+"se", _+"st", _+"seid"> => hjk_type_Va_otsene paat ;
       <_ +("ne"|"s"),  _+"se", _+"st", _+"si"> => hjk_type_Vb_oluline paat ;
-      
+
       <_ +"ne", _+"se", _+"set", _+"seid"> => nForms3 paat paadi paati ; -- -ne adjectives ('algne') are not like 'tõuge'
 
       --distinguish between kõne and aine
-      <_ +"e", _+"e", _+"et", _+"sid"> => hjk_type_III_ratsu paat ; 
+      <_ +"e", _+"e", _+"et", _+"sid"> => hjk_type_III_ratsu paat ;
       <_ +"e", _+"e", _+"et", _+"eid"> => hjk_type_VII_touge2 paat paadi ;
 
-      _  => nForms3 paat paadi paati 
+      _  => nForms3 paat paadi paati
       } ;
 
 {-
   --Version that uses pl gen instead of pl part
-  nForms4 : (_,_,_,_ : Str) -> NForms = \paat,paadi,paati,paatide -> 
+  nForms4 : (_,_,_,_ : Str) -> NForms = \paat,paadi,paati,paatide ->
     case <paat,paadi,paati,paatide> of {
      -- pl gen can't distinguish between joonis and segadus
     --  <_ +("ne"|"s"),  _+"se", _+"st", _+"seid"> => hjk_type_Va_otsene paat ;
     --  <_ +("ne"|"s"),  _+"se", _+"st", _+"si"> => hjk_type_Vb_oluline paat ;
-      
+
       --pl gen can distinguish between kõne and aine
       --plus side that any noun that is formed with 4-arg,
-      --the user given forms are inserted to the paradigm, 
+      --the user given forms are inserted to the paradigm,
       --and more forms are created from pl gen, none from pl part
-      <_ +"e", _+"e", _+"et", _+"de"> => hjk_type_III_ratsu paat ; 
+      <_ +"e", _+"e", _+"et", _+"de"> => hjk_type_III_ratsu paat ;
       <_ +"e", _+"e", _+"et", _+"te"> => hjk_type_VII_touge2 paat paadi ;
 
-      _  => nForms3 paat paadi paati 
+      _  => nForms3 paat paadi paati
-      } ;      
+      } ;
 -}
 
   mkN2 = overload {
@@ -552,57 +574,61 @@ oper
     mkN2 : N -> Prep -> N2 = mmkN2
     } ;
 
-  mmkN2 : N -> Prep -> N2 = \n,c -> n ** {c2 = c ; isPre = mkIsPre c ; lock_N2 = <>} ;
+  mmkN2 : N -> Prep -> N2 = \n,c -> lin N2 (n ** {
-  mkN3 = \n,c,e -> n ** {c2 = c ; c3 = e ; 
+    c2 = c ;
+    isPre = mkIsPre c ;
+    postmod = []
+    }) ;
+
+  mkN3 = \n,c,e -> lin N3 (n ** {
+    c2 = c ; c3 = e ;
     isPre = mkIsPre c  ; -- matka Londonist Pariisi
     isPre2 = mkIsPre e ;          -- Suomen voitto Ruotsista
-    lock_N3 = <>
+    }) ;
-    } ;
+
-  
+  mkIsPre : Prep -> Bool = \p -> case p.c.npf of {
-  mkIsPre : Prep -> Bool = \p -> case p.c of {
     NPCase Gen => notB p.isPre ;  -- Jussin veli (prep is <Gen,"",True>, isPre becomes False)
     _ => True                     -- syyte Jussia vastaan, puhe Jussin puolesta
     } ;
 
   mkPN = overload {
     mkPN : Str -> PN = mkPN_1 ;
-    mkPN : N -> PN = \s -> {s = \\c => s.s ! NCase Sg c ; lock_PN = <>} ;
+    mkPN : N -> PN = \s -> lin PN {s = \\c => s.s ! NCase Sg c} ;
     } ;
 
-  mkPN_1 : Str -> PN = \s -> {s = \\c => (mk1N s).s ! NCase Sg c ; lock_PN = <>} ;
+  mkPN_1 : Str -> PN = \s -> lin PN {s = \\c => (mk1N s).s ! NCase Sg c} ;
 
 -- adjectives
 
   mkA = overload {
     mkA : Str -> A  = mkA_1 ;
-    mkA : N -> A = \n -> noun2adjDeg n ** {infl = Regular ; lock_A = <>} ;
+    mkA : N -> A = \n -> noun2adjDeg n ** {infl = Regular} ;
     mkA : N -> (parem,parim : Str) -> A = regAdjective ;
-    mkA : N -> (infl : Infl) -> A = \n,infl -> noun2adjDeg n ** {infl = infl ; lock_A = <>} ;
+    mkA : N -> (infl : Infl) -> A = \n,infl -> noun2adjDeg n ** {infl = infl} ;
     -- TODO: temporary usage of regAdjective1
     mkA : N -> (valmim,valmeim : Str) -> (infl : Infl) -> A =
-		\n,c,s,infl -> (regAdjective1 n c s) ** {infl = infl ; lock_A = <>} ;
+		\n,c,s,infl -> (regAdjective1 n c s) ** {infl = infl} ;
   } ;
 
-  invA balti = {s = \\_,_ => balti ; infl = Invariable ; lock_A = <>} ;
+  invA balti = lin A {s = \\_,_ => balti ; infl = Invariable} ;
 
-  mkA_1 : Str -> A = \x -> noun2adjDeg (mk1N x) ** {infl = Regular  ; lock_A = <>} ;
+  mkA_1 : Str -> A = \x -> noun2adjDeg (mk1N x) ** {infl = Regular } ;
 
 -- auxiliaries
-  mkAdjective : (_,_,_ : Adj) -> A = \hea,parem,parim -> 
+  mkAdjective : (_,_,_ : Adj) -> A = \hea,parem,parim -> lin A ({
-    {s = table {
+    s = table {
       Posit  => hea.s ;
       Compar => parem.s ;
       Superl => parim.s
       } ;
      infl = Regular ;
-     lock_A = <>
+    }) ;
-    } ;
 
   -- Adjectives whose comparison forms are explicitly given.
   -- The inflection of these forms with the audit-rule always works.
   regAdjective : Noun -> Str -> Str -> A = \posit,compar,superl ->
-    mkAdjective 
+    mkAdjective
-      (noun2adj posit) 
+      (noun2adj posit)
       (noun2adjComp False (nForms2N (hjk_type_IVb_audit compar "a")))
       (noun2adjComp False (nForms2N (hjk_type_IVb_audit superl "a"))) ;
 
@@ -617,7 +643,7 @@ oper
   -- e.g. lai -> laiem -> laiim? / laieim?
   -- See also: http://www.eki.ee/books/ekk09/index.php?p=3&p1=4&id=208
   -- Rather use "kõige" + Comp instead of the superlative.
-  noun2adjDeg : Noun -> Adjective = \kaunis ->
+  noun2adjDeg : Noun -> A = \kaunis ->
     let
       kauni = (kaunis.s ! NCase Sg Gen) ;
       -- Convert the final 'i' to 'e' for the superlative
@@ -637,31 +663,17 @@ oper
     mkV : (aru : Str) -> (saama : V) -> V = mkPV ; -- particle verbs
   } ;
 
-  mk1V : Str -> V = \s -> 
+  vforms2v : ResEst.VForms -> CatEst.V = \vfs -> lin V (vforms2verb vfs ** {sc = NPCase Nom}) ;
-    let vfs = vforms2V (vForms1 s) in 
+  mk1V : Str -> V = \s -> vforms2v (vForms1 s) ;
-      vfs ** {sc = NPCase Nom ; lock_V = <>} ;
+  mk2V : (_,_ : Str) -> V = \x,y -> vforms2v (vForms2 x y) ;
-  mk2V : (_,_ : Str) -> V = \x,y -> 
+  mk3V : (_,_,_ : Str) -> V = \x,y,z -> vforms2v (vForms3 x y z) ;
-    let 
+  mk4V : (x1,_,_,x4 : Str) -> V = \a,b,c,d -> vforms2v (vForms4 a b c d) ;
-      vfs = vforms2V (vForms2 x y) 
+  mk8V : (x1,_,_,_,_,_,_,x8 : Str) -> V = \a,b,c,d,e,f,g,h -> vforms2v (vForms8 a b c d e f g h) ;
-    in vfs ** {sc = NPCase Nom ; lock_V = <>} ;
+  mkPV : (aru : Str) -> (saama : V) -> V = \aru,saama -> saama ** {p=aru} ;
-  mk3V : (_,_,_ : Str) -> V = \x,y,z -> 
+
-    let 
+
-      vfs = vforms2V (vForms3 x y z) 
+  -- This used to be the last case: _ => Predef.error (["expected infinitive, found"] ++ ottaa)
-    in vfs ** {sc = NPCase Nom ; lock_V = <>} ;
+  -- regexp example: ("" | ?) + ("a" | "e" | "i") + _ + "aa" =>
-  mk4V : (x1,_,_,x4 : Str) -> V = \a,b,c,d -> 
-    let 
-      vfs = vforms2V (vForms4 a b c d)
-    in vfs ** {sc = NPCase Nom ; lock_V = <>} ;
-  mk8V : (x1,_,_,_,_,_,_,x8 : Str) -> V = \a,b,c,d,e,f,g,h -> 
-    let
-      vfs = vforms2V (vForms8 a b c d e f g h)
-    in vfs ** {sc = NPCase Nom ; lock_V = <>} ;
-  mkPV : (aru : Str) -> (saama : V) -> V = \aru,saama ->
-    {s = saama.s ; p = aru ; sc = saama.sc ; lock_V = <> } ;
-     
-  	
-  -- This used to be the last case: _ => Predef.error (["expected infinitive, found"] ++ ottaa) 
-  -- regexp example: ("" | ?) + ("a" | "e" | "i") + _ + "aa" => 
   vForms1 : Str -> VForms = \lugema ->
     let
       luge = Predef.tk 2 lugema ;
@@ -672,7 +684,7 @@ oper
       -- Small class of CVVma
       ? + ("ä"|"õ"|"i") + "ima" =>
         cKaima lugema ;  --käima,viima,võima
-      ? + ("aa"|"ee"|"ää") + "ma" =>  
+      ? + ("aa"|"ee"|"ää") + "ma" =>
         cSaama lugema ;  -- saama,jääma,keema
       ? + ("oo"|"öö"|"üü") + "ma" =>
         cJooma lugema ;  --jooma,looma,lööma,müüma,pooma,sööma,tooma
@@ -680,30 +692,30 @@ oper
       -- TS 53
       _ + #c + #v + "elema" =>
         cTegelema lugema ; --not aelema
-      
+
       -- TS 54
       -- Small class, just list all members
       ("tule"|"sure"|"pane") + "ma" =>
         cTulema lugema ;
-        
+
       -- TS 55-57
       -- Consonant gradation
       -- Regular (55-56)'leppima' and irregular (57) 'lugema'
       -- For reliable results regarding consonant gradation, use mk3V
       _ + "ndima" =>
         cLeppima lugema ;
-      _ + #lmnr + ("k"|"p"|"t"|"b") + ("ima"|"uma") => 
+      _ + #lmnr + ("k"|"p"|"t"|"b") + ("ima"|"uma") =>
         cLeppima lugema ;
-      _ + ("sk"|"ps"|"ks"|"ts"|"pl") + ("ima") => --|"uma") => 
+      _ + ("sk"|"ps"|"ks"|"ts"|"pl") + ("ima") => --|"uma") =>
         cLeppima lugema ;
-      _ + ("hk"|"hm"|"hn"|"hr"|"ht") + ("ima") => --most *hCuma are TS 51 (muutuma) 
+      _ + ("hk"|"hm"|"hn"|"hr"|"ht") + ("ima") => --most *hCuma are TS 51 (muutuma)
         cLeppima lugema ;
       _ + #c + "ssima" => --weaker *ss = *ss; should be weaker Css = Cs
         cLugema lugema ;
-      _ + ("pp"|"kk"|"tt"|"ss"|"ff"|"nn"|"mm"|"ll"|"rr") + ("ima"|"uma") => 
+      _ + ("pp"|"kk"|"tt"|"ss"|"ff"|"nn"|"mm"|"ll"|"rr") + ("ima"|"uma") =>
         cLeppima lugema ;
-      
+
-      -- TS 59 (petma, tapma) 
+      -- TS 59 (petma, tapma)
       -- Use mk4V for TS 60 (jätma, võtma)
       ? + #v + ("tma"|"pma") =>
         cPetma lugema (luge + "etakse") ;
@@ -714,31 +726,31 @@ oper
      -- TS 61 (laulma,kuulma,naerma,möönma)
      -- Default vowel e for lma, a for (r|n)ma.
      -- Other vowel with mk3V.
-      _ + "lma" => 
+      _ + "lma" =>
-        cKuulma lugema (loe + "eb") ; 
+        cKuulma lugema (loe + "eb") ;
       _ + ("r"|"n") + "ma" =>
         cKuulma lugema (loe + "ab") ;
-     
+
       -- TS 63 (andma,hoidma)
       -- Other vowel than a (tundma~tunneb) with mk3V
       _ + "dma" =>
         cAndma lugema (loe + "ab") ;
-             
+
       -- TS 62, 64 (tõusma,mõskma), default vowel e
       -- 62 alt form (jooksma,joosta) with mk2V
       -- Other vowel than e with mk3V
-      _ + #c + "ma" => 
+      _ + #c + "ma" =>
         cLaskma lugema (loe + "eb") ;
-        
+
       -- TS 65 (pesema)
       #c + #v + "sema" =>
         cPesema lugema ;
-        
+
       -- TS 66 (nägema)
       -- Small class, just list all members
       ("nägema"|"tegema") =>
         cNagema lugema ;
-      
+
       -- TS 67-68 with mk2V
       -- no 100% way to distinguish from 50-52 that end in ama
 
@@ -754,7 +766,7 @@ oper
       -- Default case
       _ =>
         cElama lugema
-    } ;   
+    } ;
 
   vForms2 : (_,_ : Str) -> VForms = \petma,petta ->
     -- Arguments: ma infinitive, da infinitive
@@ -781,22 +793,22 @@ oper
     -- * Non-detectable gradation (sattuma~satub ; pettuma~pettub)
     -- * Non-default vowel in b for TS 58-64 (laulma~laulab)
     case <taguma,taguda,taob> of {
-    
+
       --to be sure about vowel in b
       <_ + "dma", _ + "da", _> => cAndma taguma taob ;
       <_, _ + #vv + #lmnr + "da", _> => cKuulma taguma taob ;
-      <_, _ + #c + "ta", _> => cLaskma taguma taob ; 
+      <_, _ + #c + "ta", _> => cLaskma taguma taob ;
 
       --irregular gradation
       <_, _, (""|#c) + #c + #v + #v + "b"> => cLugema taguma ; --57
 
       --to be sure about consonant gradation
       <_ + #c + "lema", _, _> => vForms2 taguma taguda ; --catch "-Clema" first
-      <_ + #v + "ma", _+"da", _> => cSattumaPettuma taguma taob ; 
+      <_ + #v + "ma", _+"da", _> => cSattumaPettuma taguma taob ;
 
-      <_,_,_> => vForms2 taguma taguda      
+      <_,_,_> => vForms2 taguma taguda
     } ;
-    
+
   vForms4 : (x1,_,_,x4 : Str) -> VForms = \jatma,jatta,jatab,jaetakse ->
     -- 4 forms needed to get full paradigm for regular verbs
     -- (source: http://www.eki.ee/books/ekk09/index.php?p=3&p1=5&id=227)
@@ -804,7 +816,7 @@ oper
     -- Filter out known irregularities and give rest to regVForms.
     -- Not trying to match TS 49 ; can't separate käima (49) from täima (50), or detect compounds like taaslooma.
     case <jatma,jatta,jatab,jaetakse> of {
-      <_,          _+("kka"|"ppa"|"tta"), 
+      <_,          _+("kka"|"ppa"|"tta"),
        _,          _+"takse"> => cPetma jatma jaetakse ;
       <_ + "dma",  _,
        _,          _+"takse"> => cAndma jatma jatab ;
@@ -813,15 +825,15 @@ oper
       <_, _ + "ha", _, _> => cNagema jatma ;
       <_ + #v + "sema", _ + "sta", _, _> => cPesema jatma ;
       <_,_,_,_> => regVForms jatma jatta jatab jaetakse
-    } ;    
+    } ;
-    
-  caseV c v = {s = v.s ; p = v.p; sc = NPCase c ; lock_V = <>} ;
 
-  vOlema = verbOlema ** {sc = NPCase Nom ; lock_V = <>} ;
+  caseV c v = v ** {sc = NPCase c.c} ;
-  vMinema = verbMinema ** {sc = NPCase Nom ; lock_V = <>} ;
 
-  mk2V2 : V -> Prep -> V2 = \v,c -> v ** {c2 = c ; lock_V2 = <>} ;
+  vOlema = lin V (verbOlema ** {sc = NPCase Nom}) ;
-  caseV2 : V -> Case -> V2 = \v,c -> mk2V2 v (casePrep c) ; 
+  vMinema = lin V (verbMinema ** {sc = NPCase Nom}) ;
+
+  mk2V2 : V -> Prep -> V2 = \v,c -> lin V2 (v ** {c2 = c}) ;
+  caseV2 : V -> Case -> V2 = \v,c -> mk2V2 v (casePrep c) ;
   dirV2 v = mk2V2 v accPrep ;
 
 
@@ -837,69 +849,69 @@ oper
   dirV2 : V -> V2 ;
 
   mkV3 = overload {
-    mkV3 : V -> Prep -> Prep -> V3 = \v,p,q -> v ** {c2 = p ; c3 = q ; lock_V3 = <>} ; 
+    mkV3 : V -> Prep -> Prep -> V3 = \v,p,q -> lin V3 (v ** {c2 = p ; c3 = q}) ;
-    mkV2 : V                 -> V3 = \v   -> v ** {c2 = accPrep ; 
+    mkV3 : V  -> V3 = \v -> lin V3 (v ** {c2 = accPrep ; c3 = casePrep allative}) ;
-							     c3 = (casePrep allative) ; 
+    mkV3 : Str -> V3 = \str ->
-							     lock_V3 = <>} ; 
+      let v : V = mkV str
-    mkV2 : Str               -> V3 = \str   -> (mkV str) ** {c2 = accPrep ; 
+      in lin V3 (v ** {c2 = accPrep ; c3 = casePrep allative})
-							     c3 = (casePrep allative) ; 
+    } ;
-							     lock_V3 = <>} ; 
-   } ;
   dirV3 v p = mkV3 v accPrep (casePrep p) ;
   dirdirV3 v = dirV3 v allative ;
 
   mkVS = overload {
-    mkVS : V -> VS   = \v -> v ** {lock_VS = <>} ;
+    mkVS : V -> VS   = \v -> lin VS v ;
-    mkVS : Str -> VS = \str -> (mkV str) ** {lock_VS = <>} ;
+    mkVS : Str -> VS = \str -> let v : V = mkV str in lin VS v ;
   } ;
   mkVV = overload {
     mkVV : V -> VV   = \v -> mkVVf v infDa ;
     mkVV : Str -> VV = \str -> mkVVf (mkV str) infDa ;
-  } ; 
+  } ;
-  mkVVf  v f = v ** {vi = f ; lock_VV = <>} ;
+  mkVVf  v f = lin VV (v ** {vi = f}) ;
   mkVQ = overload {
-    mkVQ : V   -> VQ = \v -> v ** {lock_VQ = <>} ;
+    mkVQ : V   -> VQ = \v -> lin VQ v ;
-    mkVQ : Str -> VQ = \str -> (mkV str) ** {lock_VQ = <>} ;
+    mkVQ : Str -> VQ = \str -> let v : V = mkV str in lin VQ v ;
   } ;
 
   V0 : Type = V ;
   AS, A2S, AV : Type = A ;
   A2V : Type = A2 ;
 
-  mkV0  v = v ** {lock_V = <>} ;
+  mkV0 v = v ;
   mkV2S = overload {
-    mkV2S : V -> Prep -> V2S   = \v,p -> (mk2V2 v p) ** {lock_V2S = <>} ;
+    mkV2S : V -> Prep -> V2S   = \v,p -> lin V2S (mk2V2 v p) ;
-    mkV2S : Str -> V2S = \str -> (mk2V2 (mkV str) (casePrep allative)) ** {lock_VS = <>} ;
+    mkV2S : Str -> V2S = \str ->
+      let v : V = mkV str
+      in lin V2S (mk2V2 v (casePrep allative))
   } ;
---  mkV2S v p = mk2V2 v p ** {lock_V2S = <>} ;
+
   mkV2V = overload {
     mkV2V : V -> Prep -> V2V = \v,p -> mkV2Vf v p infMa ;
     mkV2V : V         -> V2V = \v   -> mkV2Vf v (casePrep genitive) infMa ;
     mkV2V : Str       -> V2V = \str -> mkV2Vf (mkV str) (casePrep genitive) infMa ;
-  } ; 
+  } ;
-  mkV2Vf v p f = mk2V2 v p ** {vi = f ; lock_V2V = <>} ;
+  mkV2Vf v p f = lin V2V (mk2V2 v p ** {vi = f}) ;
 
   mkVA = overload {
-    mkVA : V -> Prep -> VA = \v,p -> v ** {c2 = p ; lock_VA = <>} ;
+    mkVA : V -> Prep -> VA = \v,p -> lin VA (v ** {c2 = p}) ;
-    mkVA : V         -> VA = \v   -> v ** {c2 = casePrep translative ; lock_VA = <>} ;
+    mkVA : V -> VA = \v -> lin VA (v ** {c2 = casePrep genitive}) ;
-    mkVA : Str       -> VA = \str -> (mkV str) ** {c2 = casePrep translative ; lock_VA = <>} ;
+    mkVA : Str -> VA = \str -> let v : V = mkV str in
+      lin VA (v ** {c2 = casePrep genitive}) ;
   } ;
 
-  mkV2A = overload { 
+  mkV2A = overload {
-    mkV2A : V -> Prep -> Prep -> V2A = \v,p,q -> v ** {c2 = p ; c3 = q ; lock_V2A = <>} ;
+    mkV2A : V -> Prep -> Prep -> V2A = \v,p,q ->
-    mkV2A : V                 -> V2A = \v     -> v ** {c2 = casePrep genitive ; 
+      lin V2A (v ** {c2 = p ; c3 = q}) ;
-							                           c3 = casePrep translative ; 
+    mkV2A : V -> V2A = \v ->
-                                                       lock_V2A = <>} ;
+      lin V2A (v ** {c2 = casePrep genitive ; c3 = casePrep translative}) ;
-    mkV2A : Str               -> V2A = \str -> (mkV str) ** {c2 = casePrep genitive ; 
+    mkV2A : Str -> V2A = \str -> let v : V = mkV str in
-							    c3 = casePrep translative ; 
+      lin V2A (v ** {c2 = casePrep genitive ; c3 = casePrep translative}) ;
-							    lock_V2A = <>} ;
   } ;
 
-  mkV2Q v p = mk2V2 v p ** {lock_V2Q = <>} ;
+  mkV2Q v p = lin V2Q (mk2V2 v p) ;
 
-  mkAS  v = v ** {lock_A = <>} ;
+  mkAS  a = a ;
-  mkA2S v p = mkA2 v p ** {lock_A = <>} ;
+  mkA2S a p = mkA2 a p ;
-  mkAV  v = v ** {lock_A = <>} ;
+  mkAV  a = a ;
-  mkA2V v p = mkA2 v p ** {lock_A2 = <>} ;
+  mkA2V a p = mkA2 a p ;
 
 } ;

src/estonian/PhraseEst.gf

@@ -9,12 +9,12 @@ concrete PhraseEst of Phrase = CatEst ** open ResEst, (P = Prelude) in {
     UttImpPl  pol imp = {s = pol.s ++ imp.s ! pol.p ! Ag Pl P2} ;
     UttImpPol pol imp = {s = pol.s ++ imp.s ! pol.p ! AgPol} ;
 
-    UttIP ip = {s = ip.s ! NPCase Nom} ;
+    UttIP ip = {s = linIP (NPCase Nom) ip} ;
     UttIAdv iadv = iadv ;
-    UttNP np = {s = np.s ! NPCase Nom} ;
+    UttNP np = {s = linNP (NPCase Nom) np} ;
-    UttVP vp = {s = infVP (NPCase Nom) Pos (agrP3 Sg) vp InfDa} ;
+    UttVP vp = {s = infVP (NPCase Nom) Pos (agrP3 Sg) vp InfMa} ;
     UttAdv adv = adv ;
-    UttCN np = {s = np.s ! NCase Sg Nom} ;
+    UttCN cn = {s = linCN (NCase Sg Nom) cn} ;
     UttAP np = {s = np.s ! P.False ! NCase Sg Nom} ;
     UttCard n = {s = n.s ! Sg ! Nom} ;
     UttInterj i = i ;
@@ -23,6 +23,6 @@ concrete PhraseEst of Phrase = CatEst ** open ResEst, (P = Prelude) in {
     PConjConj conj = {s = conj.s2} ;
 
     NoVoc = {s = []} ;
-    VocNP np = {s = "," ++ np.s ! NPCase Nom} ;
+    VocNP np = {s = "," ++ linNP (NPCase Nom) np} ;
 
 }

src/estonian/QuestionEst.gf

@@ -8,16 +8,16 @@ concrete QuestionEst of Question = CatEst ** open ResEst, Prelude in {
       s = \\t,a,p => cl.s ! t ! a ! p ! SQuest
       } ;
 
-    QuestVP ip vp = 
+    QuestVP ip vp =
-      let 
+      let
         cl = mkClause (subjForm (ip ** {isPron = False ; a = agrP3 ip.n}) vp.sc) (agrP3 ip.n) vp
       in {
         s = \\t,a,p => cl.s ! t ! a ! p ! SDecl
         } ;
 
     QuestSlash ip slash = {
-      s = \\t,a,p => 
+      s = \\t,a,p =>
-            let 
+            let
               cls = slash.s ! t ! a ! p ;
               who = appCompl True p slash.c2 (ip ** {a = agrP3 ip.n ; isPron = False})
             in
@@ -29,32 +29,31 @@ concrete QuestionEst of Question = CatEst ** open ResEst, Prelude in {
       } ;
 
     QuestIComp icomp np = {
-      s = \\t,a,p => 
+      s = \\t,a,p =>
-        let 
+        let
           vp = predV (verbOlema ** {sc = NPCase Nom}) ;
           cl = mkClause (subjForm np vp.sc) np.a vp ;
         in
         icomp.s ! np.a ++ cl.s ! t ! a ! p ! SDecl
       } ;
 
-    PrepIP p ip = {s = 
+    PrepIP p ip = {s =
       appCompl True Pos p (ip ** {a = agrP3 ip.n ; isPron = False})} ;
 
-    AdvIP ip adv = {
+    AdvIP ip adv = ip ** {
-      s = \\c => ip.s ! c ++ adv.s ;
+      postmod = ip.postmod ++ adv.s ;
-      n = ip.n
       } ;
 
 -- The computation of $ncase$ is a special case of that in $NounEst.DetCN$,
--- since we don't have possessive suffixes or definiteness. 
+-- since we don't have possessive suffixes or definiteness.
 --- It could still be nice to have a common oper...
 
-    IdetCN idet cn = let n = idet.n in {
+    IdetCN idet cn = let n = idet.n in emptyIP ** {
-      s = \\c => 
+      s = \\c =>
-        let 
+        let
           k     : Case = npform2case n c ;
           icase : Case = Nom ; --case k of {  --mis kassiga
-         --   (Ess|Abess|Comit|Termin) => Gen ; 
+         --   (Ess|Abess|Comit|Termin) => Gen ;
          --   _  => k
          -- } ;
           ncase : NForm = case <icase,idet.isNum> of {
@@ -63,33 +62,33 @@ concrete QuestionEst of Question = CatEst ** open ResEst, Prelude in {
             _            => NCase n  k      -- mitkä kytkimet
           }
         in
-        idet.s ! icase ++ cn.s ! ncase ; 
+        idet.s ! icase ++ cn.s ! ncase ;
       n = n
       } ;
 
-    IdetIP idet = let n = idet.n in {
+    IdetIP idet = let n = idet.n in emptyIP ** {
-      s = \\c => 
+      s = \\c =>
-        let 
+        let
           k = npform2case n c ;
         in
-        idet.s ! k ; 
+        idet.s ! k ;
       n = n
       } ;
 
-    IdetQuant idet num = 
+    IdetQuant idet num =
-      let 
+      let
         n = num.n ;
-        isn = num.isNum 
+        isn = num.isNum
       in {
-        s = \\k => 
+        s = \\k =>
-        let 
+        let
           ncase = case <k,isn> of {
             <Nom,  True> => NCase Sg Part ; -- mitkä kolme kytkintä
             <_,    True> => NCase Sg k ;    -- miksi kolmeksi kytkimeksi
             _            => NCase n  k      -- mitkä kytkimet
             }
         in
-        idet.s ! n ! k ++ num.s ! Sg ! k ; 
+        idet.s ! n ! k ++ num.s ! Sg ! k ;
       n = n ;
       isNum = isn
       } ;
@@ -97,6 +96,6 @@ concrete QuestionEst of Question = CatEst ** open ResEst, Prelude in {
     AdvIAdv i a = {s = i.s ++ a.s} ;
 
     CompIAdv a = {s = \\_ => a.s} ;
-    CompIP ip = {s = \\_ => ip.s ! NPCase Nom} ;
+    CompIP ip = {s = \\_ => linIP (NPCase Nom) ip} ;
 
 }

src/estonian/RelativeEst.gf

@@ -11,32 +11,34 @@ concrete RelativeEst of Relative = CatEst ** open Prelude, ResEst, MorphoEst in
       } ;
 
     RelVP rp vp = {
-      s = \\t,ant,b,ag => 
+      s = \\t,ant,b,ag =>
-        let 
+        let
           agr = case rp.a of {
             RNoAg => ag ;
             RAg a => a
             } ;
-          cl = mkClause 
+          cl = mkClause
-             (subjForm {s = rp.s ! (complNumAgr agr) ; 
+                  (subjForm
-                        a = agr ; isPron = False} vp.sc) agr vp
+                        (emptyNP ** {s = rp.s ! complNumAgr agr ; a = agr})
+                        vp.sc)
+                      agr vp
         in
         cl.s ! t ! ant ! b ! SDecl ;
       c = NPCase Nom
       } ;
 
     RelSlash rp slash = {
-      s = \\t,a,p,ag => 
+      s = \\t,a,p,ag =>
-            let 
+            let
               cls = slash.s ! t ! a ! p ;
               who = appCompl True p slash.c2 (rp2np (complNumAgr ag) rp)
             in
             who ++ cls ;
-      c = slash.c2.c
+      c = slash.c2.c.npf
       } ;
 
     FunRP p np rp = {
-      s = \\n,c => appCompl True Pos p (rp2np n rp) ++ np.s ! c ; --- is c OK?
+      s = \\n,c => appCompl True Pos p (rp2np n rp) ++ linNP c np ; --- is c OK?
       a = RAg np.a
       } ;
 

src/estonian/ResEst.gf

@@ -15,16 +15,35 @@ resource ResEst = ParamX ** open Prelude in {
 -- This is the $Case$ as needed for both nouns and $NP$s.
 
   param
-    Case = Nom | Gen | Part  
+    Case = Nom | Gen | Part | Transl
-         | Illat | Iness | Elat | Allat | Adess | Ablat 
+         | Illat | Iness | Elat | Allat | Adess | Ablat
-         | Transl | Ess | Termin | Abess | Comit;
+         ;
+    NForm = NCase Number Case ;
 
-    NForm = NCase Number Case ; 
+  oper
+    -- Reduce the Case parameter: many cases use the Genitive stem and just add suffix to it
+    CasePlus : Type = {
+      c : Case ;  -- e.g. Gen
+      suf : Str   -- e.g. "ga" for comitative
+      } ;
 
+      Nominative  = {c = Nom ;   suf = []} ;
+      Genitive    = {c = Gen ;   suf = []} ;
+      Partitive   = {c = Part ;   suf = []} ;
+      Illative    = {c = Illat ;  suf = []} ;
+      Inessive    = {c = Iness ;  suf = []} ;
+      Elative     = {c = Elat ;   suf = []} ;
+      Allative    = {c = Allat ;  suf = []} ;
+      Adessive    = {c = Adess ;  suf = []} ;
+      Ablative    = {c = Ablat ;  suf = []} ;
+      Translative = {c = Transl ; suf = []} ;
+      Terminative = {c = Gen ;    suf = BIND ++ "ni"} ;
+      Essive      = {c = Gen ;    suf = BIND ++ "na"} ;
+      Abessive    = {c = Gen ;    suf = BIND ++ "ta"} ;
+      Comitative  = {c = Gen ;    suf = BIND ++ "ga"} ;
 
+  param
 -- Agreement of $NP$ has number*person and the polite second ("te olette valmis").
-
-
     Agr = Ag Number Person | AgPol ;
 
   oper
@@ -38,8 +57,34 @@ resource ResEst = ParamX ** open Prelude in {
       } ;
 
   oper
-    NP = {s : NPForm => Str ; a : Agr ; isPron : Bool} ;
+    IPhrase : Type = {
+      s : NPForm => Str ; -- the noun phrase + premodifiers
+      postmod : Str ;     -- adverb, RS, etc. other postmods
+      n : Number
+    } ;
 
+    NPhrase : Type = {
+      s : NPForm => Str ; -- the noun phrase + premodifiers
+      postmod : Str ;     -- adverb, RS, etc. other postmods
+      a : Agr ;
+      isPron : Bool
+      } ;
+
+    emptyNP : NPhrase = {
+      s = \\_ => [] ;
+      postmod = [] ;
+      a = agrP3 Sg ;
+      isPron = False
+    } ;
+
+    emptyIP : IPhrase = {
+      s = \\_ => [] ;
+      postmod = [] ;
+      n = Sg ;
+    } ;
+
+    linNP : NPForm -> NPhrase -> Str = \npf,np -> np.s ! npf ++ np.postmod ;
+    linIP : NPForm -> IPhrase -> Str = \npf,ip -> ip.s ! npf ++ ip.postmod ;
 --
 --2 Adjectives
 --
@@ -52,20 +97,30 @@ param
   Infl = Regular | Participle | Invariable ;
 
 oper
-  Adjective : Type = {s : Degree => AForm => Str; lock_A : {}} ;
+  Adjective : Type = {s : Degree => AForm => Str} ;
+
+  APhrase : Type = {s : Bool => NForm => Str ; infl : Infl} ;
 
 --2 Noun phrases
 --
--- Two forms of *virtual accusative* are needed for nouns in singular, 
+-- Two forms of *virtual accusative* are needed for nouns in singular,
--- the nominative and the genitive one ("loen raamatu"/"loe raamat"). 
+-- the nominative and the genitive one ("loen raamatu"/"loe raamat").
--- For nouns in plural, only a nominative accusative exists in positive clauses. 
+-- For nouns in plural, only a nominative accusative exists in positive clauses.
 -- Pronouns use the partitive as their accusative form ("mind", "sind"), in both
 -- positive and negative, indicative and imperative clauses.
 
-param 
+param
   NPForm = NPCase Case | NPAcc ;
 
 oper
+  NPFormPlus : Type = {
+    npf : NPForm ;  -- e.g. NPCase Gen
+    suf : Str       -- e.g. "ga" for comitative
+    } ;
+
+  casep2npformp : CasePlus -> NPFormPlus = \cp -> cp ** {npf = NPCase cp.c} ;
+  case2npformp  : NPForm -> NPFormPlus   = \npf-> {npf = npf ; suf = []} ;
+
   npform2case : Number -> NPForm -> Case = \n,f ->
 
 --  type signature: workaround for gfc bug 9/11/2007
@@ -80,14 +135,14 @@ oper
 -- A special form is needed for the negated plural imperative.
 
 param
-  VForm = 
+  VForm =
-     Inf InfForm
+     Inf InfStem
    | Presn Number Person
    | Impf Number Person
    | Condit Number Person
    | ConditPass --loetagu
    | Imper Number
-   | ImperP3 
+   | ImperP3
    | ImperP1Pl
    | ImperPass
    | PassPresn Bool
@@ -98,21 +153,37 @@ param
    ;
 
   Voice = Act | Pass ;
-  
-  InfForm =
-     InfDa     -- lugeda
-   | InfDes    -- lugedes 
-   | InfMa     -- lugema  
-   | InfMas    -- lugemas
-   | InfMast   -- lugemast
-   | InfMata   -- lugemata
-   | InfMaks   -- lugemaks
-   ;
 
+  InfStem =
+     InfD -- luge+da/des, but can be irregular: tulla, tulles
+   | InfM -- lugema/mas/mast/maks/mata/mine
+   ;
+oper
+  InfForms : Type = {stem : InfStem ; suf : Str} ;
+
+  InfDa, InfDes, InfMa, InfMas, InfMast, InfMata, InfMaks, InfMine : InfForms ;
+  InfDa  = {stem = InfD ; suf = "a"} ;    -- lugeda
+  InfDes = {stem = InfD ; suf = "es"} ;   -- lugedes
+  InfMa = {stem = InfM ; suf = "a"} ;     -- lugema
+  InfMas = {stem = InfM ; suf = "as"} ;   -- lugemas
+  InfMast = {stem = InfM ; suf = "ast"} ; -- lugemast
+  InfMata = {stem = InfM ; suf = "ata"} ; -- lugemata
+  InfMaks = {stem = InfM ; suf = "aks"} ; -- lugemaks
+  InfMine = {stem = InfM ; suf = "ine"} ; -- lugemine
+
+  applyInfFormsVP : InfForms -> VP -> {fin,inf : Str} = \if,vp ->
+    let vpforms : VPForms = mkVPForms vp.v ;
+        stemOnly : {fin,inf : Str} = vpforms ! VIInf if.stem ! Simul ! Pos ! agrP3 Sg ;
+     in stemOnly ** {fin = glue stemOnly.fin if.suf} ; -- Despite the name, the infinite form is in the "fin" field, "inf" contains participle
+
+  applyInfFormsV  : InfForms -> (VForm => Str)  -> Str = \if,vf ->
+    glue (vf  ! Inf   if.stem) if.suf ;
+
+param
   SType = SDecl | SQuest | SInv ;
 
 --2 For $Relative$
- 
+
     RAgr = RNoAg | RAg Agr ;
 
 --2 For $Numeral$
@@ -122,23 +193,25 @@ param
 --2 Transformations between parameter types
 
   oper
-    agrP3 : Number -> Agr = \n -> 
+    agrP3 : Number -> Agr = \n ->
       Ag n P3 ;
 
     conjAgr : Agr -> Agr -> Agr = \a,b -> case <a,b> of {
       <Ag n p, Ag m q> => Ag (conjNumber n m) (conjPerson p q) ;
       <Ag n p, AgPol>  => Ag Pl (conjPerson p P2) ;
       <AgPol,  Ag n p> => Ag Pl (conjPerson p P2) ;
-      _ => b 
+      _ => b
       } ;
 
 ---
 
-  Compl : Type = {s : Str ; c : NPForm ; isPre : Bool} ;
+  Compl : Type = {s : Str ; c : NPFormPlus ; isPre : Bool} ;
 
-  appCompl : Bool -> Polarity -> Compl -> NP -> Str = \isFin,b,co,np ->
+  npfplus2compl : NPFormPlus -> Compl = \npf -> {s = [] ; c = npf ; isPre = False} ;
+
+  appCompl : Bool -> Polarity -> Compl -> NPhrase -> Str = \isFin,b,co,np ->
     let
-      c = case co.c of {
+      c = case co.c.npf of {
         NPAcc => case b of {
           Neg => NPCase Part ; -- ma ei näe raamatut/sind
           Pos => case isFin of {
@@ -149,20 +222,18 @@ param
                   }
                }
           } ;
-        _        => co.c
+        _        => co.c.npf
         } ;
-{-
+      nps = np.s ! c ++ co.c.suf ; -- complement's NPFormPlus may include suffix for the cases based on Gen stem, e.g. comitative "ga"
-      c = case <isFin, b, co.c, np.isPron> of {
-        <_,    Neg, NPAcc,_>      => NPCase Part ; -- en näe taloa/sinua
-        <_,    Pos, NPAcc,True>   => NPAcc ;       -- näen/täytyy sinut
-        <False,Pos, NPAcc,False>  => NPCase Nom ;  -- täytyy nähdä talo
-        <_,_,coc,_>               => coc
-        } ;
--}
-      nps = np.s ! c
     in
-    preOrPost co.isPre co.s nps ;
+    preOrPost co.isPre co.s nps ++ np.postmod ;
 
+  -- Used for passive; c2 of V2/VPSlash becomes sc of VP
+  compl2subjcase : Compl -> NPForm = \compl ->
+    case compl.c.npf of {
+      NPCase Gen => NPCase Nom ;  -- valisin koera -> koer valitakse
+      _          => compl.c.npf   -- rääkisin koerale -> koerale räägitakse
+    } ;
 -- For $Verb$.
 
   Verb : Type = {
@@ -170,67 +241,89 @@ param
     p : Str  -- particle verbs
     } ;
 
+  Verb1 : Type = Verb ** {sc : NPForm} ; --subject case, i.e. "ma näen kassi"/"mul on kass"
+  Verb2 : Type = Verb1 ** {c2 : Compl} ;
+  Verb3 : Type = Verb2 ** {c3 : Compl} ;
+
+  linV2, linV : Verb -> Str = \v -> applyInfFormsV InfMa v.s ++ v.p ;
+
 param
   VIForm =
-     VIFin  Tense  
+     VIFin  Tense
-   | VIInf  InfForm
+   | VIInf  InfStem
    | VIPass Tense
-   | VIPresPart 
+   | VIPresPart
-   | VIImper 
+   | VIImper
-   ;  
+   ;
 
 oper
   VP : Type = {
-    s   : VIForm => Anteriority => Polarity => Agr => {fin, inf : Str} ; 
+    v : Verb ;
     s2  : Bool => Polarity => Agr => Str ; -- raamat/raamatu/raamatut
     adv : Str ;
     p : Str ; --uninflecting component in multi-word verbs
     ext : Str ;
     sc  : NPForm ;
     } ;
-    
-  predV : (Verb ** {sc : NPForm}) -> VP = \verb -> {
-    s = \\vi,ant,b,agr0 => 
-      let
-        agr = verbAgr agr0 ;
-        verbs = verb.s ;
-        part  : Str = case vi of {
-          VIPass _ => verbs ! (PastPart Pass) ; 
-          _      => verbs ! (PastPart Act)
-        } ; 
-        
-        einegole : Str * Str * Str = case <vi,agr.n> of {
-          <VIFin Pres>  => <"ei", verbs ! Imper Sg,     "ole"> ;
-          <VIFin Fut>   => <"ei", verbs ! Imper Sg,     "ole"> ;
-          <VIFin Cond>  => <"ei", verbs ! Condit Sg P3, "oleks"> ;
-          <VIFin Past>  => <"ei", part,                 "olnud"> ;
-          <VIImper, Sg> => <"ära", verbs ! Imper Sg,   "ole"> ;
-          <VIImper, Pl> => <"ärge", verbs ! Imper Pl,  "olge"> ;
-          <VIPass Pres> => <"ei", verbs ! PassPresn False,  "ole"> ;
-          <VIPass Fut>  => <"ei", verbs ! PassPresn False,  "ole"> ; --# notpresent
-          <VIPass Cond> => <"ei", verbs ! ConditPass,  "oleks"> ; --# notpresent
-          <VIPass Past> => <"ei", verbs ! PassImpf False,  "olnud"> ; --# notpresent
-          <VIPresPart>  => <"ei", verbs ! PresPart Act, "olev"> ; --# notpresent
-          <VIInf i>     => <"ei", verbs ! Inf i, verbOlema.s ! Inf i> 
 
-        } ;
+  passiveVerb : Verb -> Verb = \verb -> verb ** {
-        
+    s = table {
-        ei  : Str = einegole.p1 ;
+      Presn _ _  => verb.s ! PassPresn True ;
-        neg : Str = einegole.p2 ;
+      Impf  _ _  => verb.s ! PassImpf True ;   --# notpresent
-        ole : Str = einegole.p3 ;
+      Condit _ _ => verb.s ! ConditPass ;  --# notpresent
-        
+      ImperP3    => verb.s ! ImperPass ;
-        olema : VForm => Str = verbOlema.s ;
+      Imper Sg   => verb.s ! PassPresn False ; -- weird hack, because the Imper Sg field is used for negative form; if VP undergoes PassV*, then its negation should also be in passive.
-        
+      PresPart _ => verb.s ! PresPart Pass ;
-        vf : Str -> Str -> {fin, inf : Str} = \x,y -> {fin = x ; inf = y} ;
+      PastPart _ => verb.s ! PastPart Pass ;
-        
+      x => verb.s ! x }
-        mkvf : VForm -> {fin, inf : Str} = \p -> case <ant,b> of {
+    } ;
-          <Simul,Pos> => vf (verbs ! p) [] ;
-          <Anter,Pos> => vf (olema ! p) part ; 
-          <Simul,Neg> => vf (ei ++ neg) [] ;
-          <Anter,Neg> => vf (ei ++ ole) part 
-        } ;
 
-        passPol = case b of {Pos => True ; Neg => False} ;
+  -- NB. only chooses passive verb forms, to get subject case need compl2subjcase, used in PassV2
+  passiveVP : VP -> VP = \vp -> vp ** {v = passiveVerb vp.v} ;
+
+  VPForms : Type = VIForm => Anteriority => Polarity => Agr => {fin, inf : Str} ;
+
+  mkVPForms : Verb -> VPForms = \verb -> \\vi,ant,b,agr0 =>
+    let
+      agr = verbAgr agr0 ;
+      verbs = verb.s ;
+      part  : Str = case vi of {
+        VIPass _ => verbs ! PastPart Pass ;
+        _      => verbs ! PastPart Act
+      } ;
+
+      einegole : Str * Str * Str = case <vi,agr.n> of {
+        <VIFin Pres>  => <"ei", verbs ! Imper Sg,     "ole"> ;
+        <VIFin Fut>   => <"ei", verbs ! Imper Sg,     "ole"> ;
+        <VIFin Cond>  => <"ei", verbs ! Condit Sg P3, "oleks"> ;
+        <VIFin Past>  => <"ei", part,                 "olnud"> ;
+        <VIImper, Sg> => <"ära", verbs ! Imper Sg,   "ole"> ;
+        <VIImper, Pl> => <"ärge", verbs ! Imper Pl,  "olge"> ;
+        <VIPass Pres> => <"ei", verbs ! PassPresn False,  "ole"> ;
+        <VIPass Fut>  => <"ei", verbs ! PassPresn False,  "ole"> ; --# notpresent
+        <VIPass Cond> => <"ei", verbs ! ConditPass,  "oleks"> ; --# notpresent
+        <VIPass Past> => <"ei", verbs ! PassImpf False,  "olnud"> ; --# notpresent
+        <VIPresPart>  => <"ei", verbs ! PresPart Act, "olev"> ; --# notpresent
+        <VIInf i>     => <"ei", verbs ! Inf i, verbOlema.s ! Inf i>
+
+      } ;
+
+      ei  : Str = einegole.p1 ;
+      neg : Str = einegole.p2 ;
+      ole : Str = einegole.p3 ;
+
+      olema : VForm => Str = verbOlema.s ;
+
+      vf : Str -> Str -> {fin, inf : Str} = \x,y -> {fin = x ; inf = y} ;
+
+      mkvf : VForm -> {fin, inf : Str} = \p -> case <ant,b> of {
+        <Simul,Pos> => vf (verbs ! p) [] ;
+        <Anter,Pos> => vf (olema ! p) part ;
+        <Simul,Neg> => vf (ei ++ neg) [] ;
+        <Anter,Neg> => vf (ei ++ ole) part
+      } ;
+
+      passPol = case b of {Pos => True ; Neg => False} ;
 
    in case vi of {
         VIFin Past  => mkvf (Impf agr.n agr.p) ; --# notpresent
@@ -246,23 +339,25 @@ oper
         VIInf i    => mkvf (Inf i)
         } ;
 
+  predV : Verb1 -> VP = \verb -> {
+    v = verb ; -- ignoring the subject case of Verb, it is stored in VP.sc later
     s2 = \\_,_,_ => [] ;
     adv = [] ;
     ext = [] ; --relative clause
     p = verb.p ; --particle verbs
-    sc = verb.sc 
+    sc = verb.sc
     } ;
 
-  insertObj : (Bool => Polarity => Agr => Str) -> VP -> VP = \obj,vp -> 
+  insertObj : (Bool => Polarity => Agr => Str) -> VP -> VP = \obj,vp ->
     vp ** { s2 = \\fin,b,a => vp.s2 ! fin ! b ! a ++ obj ! fin ! b ! a } ;
 
-  insertObjPre : (Bool => Polarity => Agr => Str) -> VP -> VP = \obj,vp -> 
+  insertObjPre : (Bool => Polarity => Agr => Str) -> VP -> VP = \obj,vp ->
     vp ** { s2 = \\fin,b,a => obj ! fin ! b ! a ++ vp.s2 ! fin ! b ! a  } ;
 
-  insertAdv : Str -> VP -> VP = \adv,vp -> 
+  insertAdv : Str -> VP -> VP = \adv,vp ->
     vp ** { adv = vp.adv ++ adv } ;
 
-  insertExtrapos : Str -> VP -> VP = \obj,vp -> 
+  insertExtrapos : Str -> VP -> VP = \obj,vp ->
     vp ** { ext = vp.ext ++ obj } ;
 
 -- For $Sentence$.
@@ -280,12 +375,12 @@ oper
   -- declarative sentence with the yes/no-queryword "kas".
   -- SQuest: "kas" + SDecl
   -- It would be also correct to use the Finnish structure, just without the ko-particle.
-  -- Inari: added a third SType, SInv. 
+  -- Inari: added a third SType, SInv.
   -- Not sure if SInv is needed, but keeping it for possible future use.
   -- There's need for an inverted word order with auxiliary verbs; infVP handles that. ComplVV calls infVP, which inverts the word order for the complement VP, and puts it into the resulting VP's `compl' field.
   -- SInv made by mkClause would be for cases where you just need to construct an inverted word order, and then call it from some other place; application grammar (TODO: api oper for SType) or ExtraEst.
-  mkClause : (Polarity -> Str) -> Agr -> VP -> Clause = \sub,agr,vp -> 
+  mkClause : (Polarity -> Str) -> Agr -> VP -> Clause = \sub,agr,vp ->
-   { s = \\t,a,b => 
+   { s = \\t,a,b =>
       let
         c = (mkClausePlus sub agr vp).s ! t ! a ! b ;
         --                 saan              sinust     aru    0
@@ -294,51 +389,51 @@ oper
         --                                [sind näha]  0      tahtnud
         --      täna     olen     ma        sinust     aru    saanud
         invCl = c.adv ++ c.fin ++ c.subj ++ c.compl ++ c.p ++ c.inf ++ c.ext
-      in 
+      in
          table {
            SDecl  => declCl ;
            SQuest => "kas" ++ declCl ;
-           SInv   => invCl 
+           SInv   => invCl
          }
       } ;
 
-  existClause : (Polarity -> Str) -> Agr -> VP -> Clause = \sub,agr,vp -> 
+  existClause : (Polarity -> Str) -> Agr -> VP -> Clause = \sub,agr,vp ->
-   { s = \\t,a,b => 
+   { s = \\t,a,b =>
       let
         c = (mkClausePlus sub agr vp).s ! t ! a ! b ;
         --       (mis)     on       olnud    olemas (lammas)
         declCl = c.subj ++ c.fin ++ c.inf ++ c.compl ;
-      in 
+      in
          table {
            SQuest => "kas" ++ declCl ;
-           _      => declCl 
+           _      => declCl
          }
     } ;
 
   mkClausePlus : (Polarity -> Str) -> Agr -> VP -> ClausePlus =
     \sub,agr,vp -> {
-      s = \\t,a,b => 
+      s = \\t,a,b =>
-        let 
+        let
           agrfin = case vp.sc of {
                     NPCase Nom => <agr,True> ;
                     _ => <agrP3 Sg,False>      -- minule meeldib, minul on
                     } ;
-          verb  = vp.s ! VIFin t ! a ! b ! agrfin.p1 ;
+          verb  = mkVPForms vp.v ! VIFin t ! a ! b ! agrfin.p1 ;
-        in {subj = sub b ; 
+        in {subj = sub b ;
-            fin  = verb.fin ; 
+            fin  = verb.fin ;
-            inf  = verb.inf ; 
+            inf  = verb.inf ;
             compl = vp.s2 ! agrfin.p2 ! b ! agr ;
             p = vp.p ;
-            adv  = vp.adv ; 
+            adv  = vp.adv ;
-            ext  = vp.ext ; 
+            ext  = vp.ext ;
             }
      } ;
 
 
-  insertKinClausePlus : Predef.Ints 1 -> ClausePlus -> ClausePlus = \p,cl -> { 
+  insertKinClausePlus : Predef.Ints 1 -> ClausePlus -> ClausePlus = \p,cl -> {
     s = \\t,a,b =>
-      let 
+      let
-         c = cl.s ! t ! a ! b   
+         c = cl.s ! t ! a ! b
       in
       case p of {
          0 => {subj = c.subj ++ gi ; fin = c.fin ; inf = c.inf ;  -- Jussikin nukkuu
@@ -348,43 +443,44 @@ oper
          }
     } ;
 
-  insertObjClausePlus : Predef.Ints 1 -> Bool -> (Polarity => Str) -> ClausePlus -> ClausePlus = 
+  insertObjClausePlus : Predef.Ints 1 -> Bool -> (Polarity => Str) -> ClausePlus -> ClausePlus =
-   \p,ifKin,obj,cl -> { 
+   \p,ifKin,obj,cl -> {
     s = \\t,a,b =>
-      let 
+      let
          c = cl.s ! t ! a ! b ;
          co = obj ! b ++ if_then_Str ifKin (kin b) [] ;
       in case p of {
-         0 => {subj = c.subj ; fin = c.fin ; inf = c.inf ; 
+         0 => {subj = c.subj ; fin = c.fin ; inf = c.inf ;
                compl = co ; p = c.p ; adv = c.compl ++ c.adv ; ext = c.ext ; h = c.h} ; -- Jussi juo maitoakin
-         1 => {subj = c.subj ; fin = c.fin ; inf = c.inf ; 
+         1 => {subj = c.subj ; fin = c.fin ; inf = c.inf ;
                compl = c.compl ; p = c.p ; adv = co ; ext = c.adv ++ c.ext ; h = c.h}   -- Jussi nukkuu nytkin
          }
      } ;
 
-  kin : Polarity -> Str  = 
+  kin : Polarity -> Str  =
     \p -> case p of {Pos => "gi" ; Neg => "gi"} ;
-  
+
-  --allomorph "ki", depends only on phonetic rules "üks+ki", "ühe+gi" 
+  --allomorph "ki", depends only on phonetic rules "üks+ki", "ühe+gi"
   --waiting for post construction in GF :P
   gi : Str = "gi" ;
 
 -- This is used for subjects of passives: therefore isFin in False.
 
-  subjForm : NP -> NPForm -> Polarity -> Str = \np,sc,b -> 
+  subjForm : NPhrase -> NPForm -> Polarity -> Str = \np,sc,b ->
-    appCompl False b {s = [] ; c = sc ; isPre = True} np ;
+    appCompl False b {s = [] ; c = case2npformp sc ; isPre = True} np ;
 
-  infVP : NPForm -> Polarity -> Agr -> VP -> InfForm -> Str = infVPAnt Simul ;
+  infVP : NPForm -> Polarity -> Agr -> VP -> InfForms -> Str = infVPAnt Simul ;
 
-  infVPAnt : Anteriority -> NPForm -> Polarity -> Agr -> VP -> InfForm -> Str =
+  infVPAnt : Anteriority -> NPForm -> Polarity -> Agr -> VP -> InfForms -> Str =
     \ant,sc,pol,agr,vp,vi ->
-        let 
+        let
-          fin = case sc of {     -- subject case
+          complCase = case sc of {     -- choosing case for the complement. sometimes this function is called so that sc is the VP's subject case, but other times it's some other form.
-            NPCase Nom => True ; -- mina tahan joosta
+            NPCase Nom => True ;
-            _ => False           -- minul peab auto olema
+            _ => False
             } ;
-          verb  = vp.s ! VIInf vi ! ant ! Pos ! agr ; -- no "ei"
+          verbStem = mkVPForms vp.v ! VIInf vi.stem ! ant ! Pos ! agr ; -- no "ei"
-          compl = vp.s2 ! fin ! pol ! agr ; -- but compl. case propagated
+          verb = verbStem ** {fin = glue verbStem.fin vi.suf} ;
+          compl = vp.s2 ! complCase ! pol ! agr ;                             -- but compl. case propagated
           adv = vp.adv
         in
         -- inverted word order; e.g.
@@ -393,12 +489,12 @@ oper
         --TODO adv placement?
         --TODO inf ++ fin or fin ++ inf? does it ever become a case here?
 
--- The definitions below were moved here from $MorphoEst$ so that  
+-- The definitions below were moved here from $MorphoEst$ so that
 -- auxiliary of predication can be defined.
 
-  verbOlema : Verb = 
+  verbOlema : Verb =
     let olema = mkVerb
-      "olema" "olla" "olen" "ollakse" 
+      "olema" "olla" "olen" "ollakse"
       "olge" "oli" "olnud" "oldud"
      in {s = table {
       Presn _ P3 => "on" ;
@@ -407,9 +503,9 @@ oper
       p = []
     } ;
 
-  verbMinema : Verb = 
+  verbMinema : Verb =
-    let minema = mkVerb 
+    let minema = mkVerb
-      "minema" "minna" "läheb" "minnakse" 
+      "minema" "minna" "läheb" "minnakse"
       "minge" "läks" "läinud" "mindud"
     in {s = table {
       Impf Sg P1 => "läksin" ;
@@ -422,20 +518,17 @@ oper
       } ;
       p = []
     } ;
-    
+
 
 --3 Verbs
 
   --Auxiliary for internal use
-  mkVerb : (x1,_,_,_,_,_,_,x8 : Str) -> Verb = 
+  mkVerb : (x1,_,_,_,_,_,_,x8 : Str) -> Verb =
-    \tulema,tulla,tuleb,tullakse,tulge,tuli,tulnud,tuldud -> 
+    \tulema,tulla,tuleb,tullakse,tulge,tuli,tulnud,tuldud ->
-    vforms2V (vForms8 
+    vforms2verb (vForms8 tulema tulla tuleb tullakse tulge tuli tulnud tuldud) ;
-     tulema tulla tuleb tullakse tulge tuli tulnud tuldud
-      ) ;
 
---below moved here from MorphoEst
     VForms : Type = Predef.Ints 7 => Str ;
-    
+
     vForms8 : (x1,_,_,_,_,_,_,x8 : Str) -> VForms =
       \tulema,tulla,tuleb,tullakse,tulge,tuli,tulnud,tuldud ->
       table {
@@ -449,40 +542,40 @@ oper
         7 => tuldud
       } ;
 
-    vforms2V : VForms -> Verb = \vh -> 
+    vforms2verb : VForms -> Verb = \vh ->
     let
-      tulema = vh ! 0 ; 
+      tulema = vh ! 0 ;
-      tulla = vh ! 1 ; 
+      tulla = vh ! 1 ;
-      tuleb = vh ! 2 ; 
+      tuleb = vh ! 2 ;
-      tullakse = vh ! 3 ; --juuakse; loetakse 
+      tullakse = vh ! 3 ; --juuakse; loetakse
-      tulge = vh ! 4 ;  --necessary for tulla, surra (otherwise *tulege, *surege) 
+      tulge = vh ! 4 ;  --necessary for tulla, surra (otherwise *tulege, *surege)
       tuli = vh ! 5 ; --necessary for jooma-juua-jõi
       tulnud = vh ! 6 ;
       tuldud = vh ! 7 ; --necessary for t/d in tuldi; loeti
-      
+
       tull_ = init tulla ; --juu(a); saad(a); tull(a);
       tulles = tull_ + "es" ; --juues; saades; tulles;
-      
+
       tule_ = init tuleb ;
-      
+
       lask_ = Predef.tk 2 tulema ;
       laulev = case (last lask_) of { --sooma~soov ; laulma~laulev
           ("a"|"e"|"i"|"o"|"u"|"õ"|"ä"|"ö"|"ü") => lask_ + "v" ;
           _ => lask_ + "ev" } ; --consonant stem in -ma, add e
-          
+
       --imperfect stem
       kaisi_ = case (Predef.dp 3 tuli) of {
           "sis"    => lask_ + "i" ; --tõusin, tõusis
           _ + "i"  => tuli ;        --jõin, jõi
           _        => lask_ + "si"  --käisin, käis; muutsin, muutis
-         }; 
+         };
-            
+
       tuld_ = Predef.tk 2 tuldud ; --d/t choice for tuldi etc.
       tulgu = (init tulge) + "u" ;
     in
     {s = table {
-      Inf InfDa => tulla ;
+      Inf InfD    => tull_ ;
-      Inf InfDes => tulles ;
+      Inf InfM    => init tulema ;
       Presn Sg P1 => tule_ + "n" ;
       Presn Sg P2 => tule_ + "d" ;
       Presn Sg P3 => tuleb ;
@@ -504,27 +597,22 @@ oper
       ConditPass   => tuld_ + "aks" ; --# notpresent
       Imper Sg  => tule_ ; -- tule / ära tule
       Imper Pl  => tulge ; -- tulge / ärge tulge
-      ImperP3   => tulgu ; -- tulgu (ta/nad) 
+      ImperP3   => tulgu ; -- tulgu (ta/nad)
       ImperP1Pl => tulge + "m" ; -- tulgem
       ImperPass => tuld_ + "agu" ; --tuldagu
       PassPresn True  => tullakse ;
       PassPresn False => tuld_ + "a" ; --da or ta
       PassImpf  True  => tuld_ + "i" ; --di or ti
-      PassImpf  False => tuldud ;  
+      PassImpf  False => tuldud ;
       Quotative Act  => lask_ + "vat" ;
       Quotative Pass => tuld_ + "avat" ; --d or t
       PresPart Act  => laulev ;
       PresPart Pass => tuld_ + "av" ; --d or t
       PastPart Act  => tulnud ;
-      PastPart Pass => tuldud ;
+      PastPart Pass => tuldud
-      Inf InfMa => tulema ;
-      Inf InfMas => tulema + "s" ;
-      Inf InfMast => tulema + "st" ;
-      Inf InfMata => tulema + "ta" ;
-      Inf InfMaks => tulema + "ks" 
       } ;
     sc = NPCase Nom ;
-    p = [] 
+    p = []
     } ;
 
   -- For regular verbs, paradigm from 4 base forms
@@ -541,12 +629,12 @@ oper
         "t" => "k" ;
         _   => "g"
       } ;
-      toit_ = case (last vestle_) of {  
+      toit_ = case (last vestle_) of {
         ("t"|"d") => vesteld_ ; --toit(ma)   -> toitke;
          _        => vestel_    --vestle(ma) -> vestelge
       } ;
-      laski_ = case (last vestle_) of { 
+      laski_ = case (last vestle_) of {
-        ("a"|"e"|"i"|"o"|"u"|"õ"|"ä"|"ö"|"ü") 
+        ("a"|"e"|"i"|"o"|"u"|"õ"|"ä"|"ö"|"ü")
             => vestle_ ;      --vestle(ma) -> vestles
          _  => vestle_ + "i"  --lask(ma)   -> laskis
       } ;
@@ -560,10 +648,10 @@ oper
         (laski_ + "s") --ma: kindla kõneviisi lihtmineviku pöörded;
         (toit_ + "nud") --da: isikulise tegumoe mineviku kesksõna
         (jaet_ + "ud"); --takse: ülejäänud umbisikulise tgm vormid
-        
+
 
   regVerb : (_,_,_,_ : Str) -> Verb = \kinkima,kinkida,kingib,kingitakse ->
-    vforms2V (regVForms kinkima kinkida kingib kingitakse) ;
+    vforms2verb (regVForms kinkima kinkida kingib kingitakse) ;
 
 
   noun2adj : Noun -> Adj = noun2adjComp True ;
@@ -574,8 +662,8 @@ oper
   -- parem -> paremini
   -- parim -> kõige paremini | parimalt?
   noun2adjComp : Bool -> Noun -> Adj = \isPos,tuore ->
-    let 
+    let
-      tuoreesti  = Predef.tk 1 (tuore.s ! NCase Sg Gen) + "sti" ; 
+      tuoreesti  = Predef.tk 1 (tuore.s ! NCase Sg Gen) + "sti" ;
       tuoreemmin = Predef.tk 2 (tuore.s ! NCase Sg Gen) + "in"
     in {s = table {
          AN f => tuore.s ! f ;
@@ -584,8 +672,16 @@ oper
          } ;
        } ;
 
-  Noun = {s : NForm => Str} ;
+  Noun : Type = {s : NForm => Str} ;
 
+  CNoun : Type = Noun ** {postmod : Str} ;
+
+  emptyCN : CNoun = {
+    s = \\nf => [] ;
+    postmod = []
+  } ;
+
+  linCN : NForm -> CNoun -> Str = \nf,cn -> cn.s ! nf ++ cn.postmod ;
 
 -- To form an adjective, it is usually enough to give a noun declension: the
 -- adverbial form is regular.
@@ -596,26 +692,26 @@ oper
   compAP = icompAP [] ;
 
   icompAP : Str -> {s : Bool => NForm => Str} -> {s : Agr => Str} = \kui,ap ->
-    { s = \\agr => 
+    { s = \\agr =>
-       let n = complNumAgr agr ; 
+       let n = complNumAgr agr ;
         in kui ++ ap.s ! False ! NCase n Nom } ;
-      
+
-  compCN : Noun -> {s : Agr => Str} = \cn -> 
+  compCN : Noun -> {s : Agr => Str} = \cn ->
-    { s = \\agr => 
+    { s = \\agr =>
-       let n = complNumAgr agr ; 
+       let n = complNumAgr agr ;
         in cn.s ! NCase n Nom } ;
 
 
--- Reflexive pronoun. 
+-- Reflexive pronoun.
 --- Possessive could be shared with the more general $NounFin.DetCN$.
 
-  reflPron : Agr -> NP = \agr -> 
+  reflPron : Agr -> NPhrase = \agr ->
-    let 
+    let
       ise = nForms2N (nForms6 "ise" "enda" "ennast" "endasse" "endi" "endid") ;
       n = case agr of {
         AgPol => Sg ;
         Ag n _ => n } ;
-     in {
+     in emptyNP ** {
       s = table {
         NPAcc => "ennast" ;
         NPCase c => fixPlNom "endid" ise.s ! NCase n c
@@ -632,7 +728,7 @@ oper
 
   NForms : Type = Predef.Ints 5 => Str ;
 
-  nForms6 : (x1,_,_,_,_,x6 : Str) -> NForms = 
+  nForms6 : (x1,_,_,_,_,x6 : Str) -> NForms =
       \jogi,joe,joge,joesse, -- sg nom, gen, part, ill
        jogede,jogesid -> table { -- pl gen, part,
       0 => jogi ;
@@ -640,7 +736,7 @@ oper
       2 => joge ;
       3 => joesse ;
       4 => jogede ;
-      5 => jogesid 
+      5 => jogesid
       } ;
 
   n2nforms : Noun -> NForms = \ukko -> table {
@@ -649,12 +745,12 @@ oper
     2 => ukko.s ! NCase Sg Part ;
     3 => ukko.s ! NCase Sg Illat ;
     4 => ukko.s ! NCase Pl Gen ;
-    5 => ukko.s ! NCase Pl Part 
+    5 => ukko.s ! NCase Pl Part
   } ;
 
     -- Converts 6 given strings (Nom, Gen, Part, Illat, Gen, Part) into Noun
     -- http://www.eki.ee/books/ekk09/index.php?p=3&p1=5&id=226
-    nForms2N : NForms -> Noun = \f -> 
+  nForms2N : NForms -> Noun = \f ->
       let
         jogi = f ! 0 ;
         joe = f ! 1 ;
@@ -662,44 +758,39 @@ oper
         joesse = f ! 3 ;
         jogede = f ! 4 ;
         jogesid = f ! 5 ;
-      in 
+      in
     {s = table {
       NCase Sg Nom    => jogi ;
       NCase Sg Gen    => joe ;
       NCase Sg Part   => joge ;
       NCase Sg Transl => joe + "ks" ;
-      NCase Sg Ess    => joe + "na" ;
       NCase Sg Iness  => joe + "s" ;
       NCase Sg Elat   => joe + "st" ;
       NCase Sg Illat  => joesse ;
       NCase Sg Adess  => joe + "l" ;
       NCase Sg Ablat  => joe + "lt" ;
       NCase Sg Allat  => joe + "le" ;
-      NCase Sg Abess  => joe + "ta" ;
-      NCase Sg Comit  => joe + "ga" ;
-      NCase Sg Termin => joe + "ni" ;
 
       NCase Pl Nom    => joe + "d" ;
       NCase Pl Gen    => jogede ;
       NCase Pl Part   => jogesid ;
       NCase Pl Transl => jogede + "ks" ;
-      NCase Pl Ess    => jogede + "na" ;
       NCase Pl Iness  => jogede + "s" ;
       NCase Pl Elat   => jogede + "st" ;
       NCase Pl Illat  => jogede + "sse" ;
       NCase Pl Adess  => jogede + "l" ;
       NCase Pl Ablat  => jogede + "lt" ;
-      NCase Pl Allat  => jogede + "le" ;
+      NCase Pl Allat  => jogede + "le"
-      NCase Pl Abess  => jogede + "ta" ;
-      NCase Pl Comit  => jogede + "ga" ;
-      NCase Pl Termin => jogede + "ni" 
 
-      } --;
+      }
---    lock_N = <>
     } ;
 
 oper
-  rp2np : Number -> {s : Number => NPForm => Str ; a : RAgr} -> NP = \n,rp -> {
+  -- Technically, we could also add a postmod field for RP,
+  -- because multiple applications of FunRP add multiple complements.
+  -- But I will only add it if I see a real-world sentence that uses multiple applications of FunRP.
+  RelPron : Type = {s : Number => NPForm => Str ; a : RAgr} ;
+  rp2np : Number -> RelPron -> NPhrase = \n,rp -> emptyNP ** {
     s = rp.s ! n ;
     a = agrP3 Sg ;  -- does not matter (--- at least in Slash)
     isPron = False  -- has no special accusative
@@ -707,7 +798,17 @@ oper
 
   etta_Conj : Str = "et" ;
 
-    heavyDet : PDet -> PDet ** {sp : Case => Str} = \d -> d ** {sp = d.s} ;
+  Determiner : Type = {
+    s : Case => Str ;       -- minun kolme
+    sp : Case => Str ;       -- se   (substantival form)
+    n : Number ;             -- Pl   (agreement feature for verb)
+    isNum : Bool ;           -- True (a numeral is present)
+    isDef : Bool             -- True (verb agrees in Pl, Nom is not Part) --I: actually, can we get rid of this?
+    } ;
+
+  IDeterminer : Type = {s : Case => Str ; n : Number ; isNum : Bool} ;
+
+    heavyDet : PDet -> Determiner = \d -> d ** {sp = d.s} ;
     PDet : Type = {
       s : Case => Str ;
       n : Number ;
@@ -715,9 +816,9 @@ oper
       isDef : Bool
       } ;
 
-    heavyQuant : PQuant -> PQuant ** {sp : Number => Case => Str} = \d -> 
+    heavyQuant : PQuant -> PQuant ** {sp : Number => Case => Str} = \d ->
-      d ** {sp = d.s} ; 
+      d ** {sp = d.s} ;
-    PQuant : Type =  
+    PQuant : Type =
-      {s : Number => Case => Str ; isDef : Bool} ; 
+      {s : Number => Case => Str ; isDef : Bool} ;
 
 }

src/estonian/SentenceEst.gf

@@ -9,17 +9,17 @@ concrete SentenceEst of Sentence = CatEst ** open Prelude, ResEst in {
     PredSCVP sc vp = mkClause (\_ -> sc.s) (agrP3 Sg) vp ;
 
     ImpVP vp = {
-      s = \\pol,agr => 
+      s = \\pol,agr =>
-        let 
+        let
-          verb  = vp.s ! VIImper ! Simul ! pol ! agr ;
+          verb  = mkVPForms vp.v ! VIImper ! Simul ! pol ! agr ;
           compl = vp.s2 ! False ! pol ! agr ++ vp.ext  --- False = like inf (osta auto)
         in --(ära)  loe         raamat(ut) läbi
-        verb.fin ++ verb.inf ++ compl   ++ vp.p ; 
+        verb.fin ++ verb.inf ++ compl   ++ vp.p ;
     } ;
 
 -- The object case is formed at the use site of $c2$, in $Relative$ and $Question$.
 
-    SlashVP np vp = { 
+    SlashVP np vp = {
       s = \\t,a,p => (mkClause (subjForm np vp.sc) np.a vp).s ! t ! a ! p ! SDecl ;
       c2 = vp.c2
       } ;
@@ -30,13 +30,13 @@ concrete SentenceEst of Sentence = CatEst ** open Prelude, ResEst in {
       } ;
 
     SlashPrep cl prep = {
-      s = \\t,a,p => cl.s ! t ! a ! p ! SDecl ; 
+      s = \\t,a,p => cl.s ! t ! a ! p ! SDecl ;
       c2 = prep
       } ;
 
-    SlashVS np vs slash = { 
+    SlashVS np vs slash = {
-      s = \\t,a,p => 
+      s = \\t,a,p =>
-        (mkClause (subjForm np vs.sc) np.a 
+        (mkClause (subjForm np vs.sc) np.a
           (insertExtrapos (etta_Conj ++ slash.s)
              (predV vs))
         ).s ! t ! a ! p ! SDecl ;

src/estonian/StructuralEst.gf

@@ -34,7 +34,7 @@ concrete StructuralEst of Structural = CatEst **
   either7or_DConj = sd2 "kas" "või" ** {n = Sg} ;
   everybody_NP = makeNP (mkN "igaüks") Sg ;
   every_Det = mkDet Sg (mkN "iga") ;
-  everything_NP = makeNP ((mkN "kõik") ** {lock_N = <>}) Sg ;
+  everything_NP = makeNP (mkN "kõik") Sg ;
   everywhere_Adv = ss "kõikjal" ;
   few_Det = mkDet Sg (mkN "mõni") ;
 ---  first_Ord = {s = \\n,c => (mkN "ensimmäinen").s ! NCase n c} ;
@@ -78,10 +78,8 @@ concrete StructuralEst of Structural = CatEst **
   quite_Adv = ss "üsna" ;
   she_Pron = mkPronoun "tema" "tema" "teda" Sg P3 ;
   so_AdA = ss "nii" ;
-  somebody_NP = {
+  somebody_NP = emptyNP ** {
     s = \\c => jokuPron ! Sg ! npform2case Sg c ;
-    a = agrP3 Sg ;
-    isPron = False
     } ;
   someSg_Det = heavyDet {
     s = jokuPron ! Sg ;
@@ -92,10 +90,8 @@ concrete StructuralEst of Structural = CatEst **
     isNum = False ; isDef = True ;
     n = Pl
     } ;
-  something_NP = {
+  something_NP = emptyNP ** {
     s = \\c => mikaInt ! Sg ! npform2case Sg c ;
-    a = agrP3 Sg ;
-    isPron = False
     } ;
   somewhere_Adv = ss "kuskil" ;
   that_Quant = heavyQuant {
@@ -133,11 +129,11 @@ concrete StructuralEst of Structural = CatEst **
   very_AdA = ss "väga" ;
   want_VV = mkVV (mkV "tahtma") ;
   we_Pron = mkPronoun "meie" "meie" "meid" Pl P1 ;
-  whatPl_IP = {
+  whatPl_IP = emptyIP ** {
     s = table {NPAcc => "mida" ; c => mikaInt ! Pl ! npform2case Pl c} ;
     n = Pl
     } ;
-  whatSg_IP = {
+  whatSg_IP = emptyIP ** {
     s = \\c => mikaInt ! Sg ! npform2case Sg c ;
     n = Sg
     } ;
@@ -145,11 +141,11 @@ concrete StructuralEst of Structural = CatEst **
   when_Subj = ss "kui" ;
   where_IAdv = ss "kus" ;
   which_IQuant = { s = mikaInt } ;
-  whoSg_IP = {
+  whoSg_IP = emptyIP ** {
     s = table {NPAcc => "keda" ; c => kukaInt ! Sg ! npform2case Sg c} ;
     n = Sg
     } ;
-  whoPl_IP = {
+  whoPl_IP = emptyIP ** {
     s = table {NPAcc => "keda" ; c => kukaInt ! Pl ! npform2case Pl c} ;
     n = Pl
     } ;
@@ -198,27 +194,21 @@ oper
         }
       } ;
 
-  --TODO does this work?
+  mikaInt : MorphoEst.Number => MorphoEst.Case => Str =
-  mikaInt : MorphoEst.Number => (MorphoEst.Case) => Str =
     let {
-      mi  = mkN "mille"
+      mi : N = mkN "mis" "mille" "mida" "millesse" "millede" "mida"
     } in
     table {
       Sg => table {
-        Nom => "mis" ;
-        Gen => "mille" ;
-        Part => "mida" ;
         c   => mi.s ! NCase Sg c
        } ;
       Pl => table {
         Nom => "mis" ;
-        Gen => "mille" ;
-        Part => "mida" ;
         c   => mi.s ! NCase Pl c
         }
       } ;
 
-  kukaInt : MorphoEst.Number => (MorphoEst.Case) => Str =
+  kukaInt : MorphoEst.Number => MorphoEst.Case => Str =
     let
       kuka = mkN "kes" "kelle" "keda" "kellesse"
                  "kellede" "keda" ;
@@ -256,12 +246,10 @@ oper
 
 
 oper
-  makeNP  : N -> MorphoEst.Number -> CatEst.NP ;
+  makeNP  : N -> MorphoEst.Number -> NPhrase ;
-  makeNP noun num = {
+  makeNP noun num = emptyNP ** {
     s = \\c => noun.s ! NCase num (npform2case num c) ;
     a = agrP3 num ;
-    isPron = False ;
-    lock_NP = <>
     } ;
 
 lin
@@ -273,16 +261,14 @@ lin
     } ;
 
   if_then_Conj = {s1 = "kui" ; s2 = "siis" ; n = Sg} ;
-  nobody_NP = {
+  nobody_NP = emptyNP ** {
     s = \\c => "mitte" ++ kukaanPron ! Sg ! npform2case Sg c ;
     a = agrP3 Sg ;
-    isPron = False
     } ;
 
-  nothing_NP = {
+  nothing_NP = emptyNP ** {
     s = \\c => "mitte" ++ mikaanPron ! Sg ! npform2case Sg c ;
     a = agrP3 Sg ;
-    isPron = False
     } ;
 
   at_least_AdN = ss "vähemalt" ;

src/estonian/SymbolEst.gf

@@ -8,20 +8,14 @@ lin
   FloatPN i  = {s = \\c => i.s} ; --- c
   NumPN i  = {s = \\c => i.s!Sg!Nom } ; --- c
 
-  CNIntNP cn i = {
+  CNIntNP cn i = let np : NP = NounEst.MassNP cn in np ** {
-    s = \\c => cn.s ! NCase Sg (npform2case Sg c) ++ i.s ;
+    postmod = np.postmod ++ i.s ;
-    a = agrP3 Sg ;
-    isPron = False
     } ;
-  CNSymbNP det cn xs = let detcn = NounEst.DetCN det cn in {
+  CNSymbNP det cn xs = let np : NP = NounEst.DetCN det cn in np ** {
-    s = \\c => detcn.s ! c ++ xs.s ;
+    postmod = np.postmod ++ xs.s ;
-    a = detcn.a ;
-    isPron = False
     } ;
-  CNNumNP cn i = {
+  CNNumNP cn i = let np : NP = NounEst.MassNP cn in np ** {
-    s = \\c => cn.s ! NCase Sg (npform2case Sg c) ++ i.s ! Sg ! Nom ;
+    postmod = np.postmod ++ i.s ! Sg ! Nom ;
-    a = agrP3 Sg ;
-    isPron = False
     } ;
 
   SymbS sy = sy ;
@@ -29,7 +23,7 @@ lin
   SymbNum n = {s = \\_,_ => n.s ; isNum = True ; n = Pl} ;
   SymbOrd n = {s = \\_ => glue n.s "."} ;
 
-lincat 
+lincat
 
   Symb, [Symb] = SS ;
 

src/estonian/TerminologyEst.gf

@@ -1,6 +1,6 @@
 --# -path=.:../abstract:../common
 
-concrete TerminologyEst of Terminology = CatEst ** open 
+concrete TerminologyEst of Terminology = CatEst ** open
   ResEst,
   ParadigmsEst,
   (G = GrammarEst),
@@ -17,9 +17,9 @@ lincat
   ParameterType = G.N ;
   Parameter = G.N ;
   Modifier = G.A ;
-  
+
   Heading = {s : Str} ;
-  
+
 
 lin
   noun_Category = mkN "käändsõna" ;
@@ -59,7 +59,7 @@ lin
 
   active_Parameter = mkN "isikuline tegumood" ;
   passive_Parameter = mkN "umbsikuline tegumood" ;
-  
+
   imperative_Parameter = mkN "käskiv kõneviis" "käskiva kõneviisi";
   indicative_Parameter = mkN "kindel kõneviis" "kindla kõneviisi";
   conjunctive_Parameter = mkN "konjunktiiv" ;
@@ -67,7 +67,7 @@ lin
 
   present_Parameter = mkN "olevik" ;
   past_Parameter = mkN "lihtminevik" ;
-  future_Parameter = mkN "futuur" ; ---- ??? 
+  future_Parameter = mkN "futuur" ; ---- ???
   conditional_Parameter = mkN "tingiv kõneviis" "tingiva kõneviisi";
   perfect_Parameter = mkN "täisminevik" ;
   quotative_Parameter = mkN "kaudne kõneviis" "kaudse kõneviisi";

src/estonian/VerbEst.gf

@@ -9,17 +9,17 @@ concrete VerbEst of Verb = CatEst ** open Prelude, ResEst in {
 
     SlashV2a v = predV v ** {c2 = v.c2} ;
 
-    Slash2V3 v np = 
+    Slash2V3 v np =
-      insertObj 
+      insertObj
         (\\fin,b,_ => appCompl fin b v.c2 np) (predV v) ** {c2 = v.c3} ;
-    Slash3V3 v np = 
+    Slash3V3 v np =
-      insertObj 
+      insertObj
         (\\fin,b,_ => appCompl fin b v.c3 np) (predV v) ** {c2 = v.c2} ;
 
-    ComplVV v vp = 
+    ComplVV v vp =
-      insertObj 
+      insertObj
-        (\\_,b,a => infVP v.sc b a vp v.vi) 
+        (\\_,b,a => infVP v.sc b a vp v.vi)
-        (predV {s = v.s ; 
+        (predV {s = v.s ;
                 p = v.p ;
                 sc = case vp.sc of {
                   NPCase Nom => v.sc ; -- minul tuleb kirjutada (VV 'tulema' determines the subject case)
@@ -30,47 +30,47 @@ concrete VerbEst of Verb = CatEst ** open Prelude, ResEst in {
 
     ComplVS v s  = insertExtrapos (etta_Conj ++ s.s) (predV v) ;
     ComplVQ v q  = insertExtrapos (          q.s) (predV v) ;
-    ComplVA v ap = 
+    ComplVA v ap =
-      insertObj 
+      insertObj
-        (\\_,b,agr => 
+        (\\_,b,agr =>
            let n = (complNumAgr agr) in
-           ap.s ! False ! (NCase n (npform2case n v.c2.c))) --- v.cs.s ignored
+           ap.s ! False ! (NCase n (npform2case n v.c2.c.npf))) --- v.cs.s ignored
         (predV v) ;
 
-    SlashV2S v s = 
+    SlashV2S v s =
       insertExtrapos (etta_Conj ++ s.s) (predV v) ** {c2 = v.c2} ;
-    SlashV2Q v q = 
+    SlashV2Q v q =
       insertExtrapos (q.s) (predV v) ** {c2 = v.c2} ;
-    SlashV2V v vp = 
+    SlashV2V v vp =
       insertObj (\\_,b,a => infVP v.sc b a vp v.vi) (predV v) ** {c2 = v.c2} ;
       ---- different infinitives
-    SlashV2A v ap = 
+    SlashV2A v ap =
-      insertObj 
+      insertObj
-        (\\fin,b,_ => 
+        (\\fin,b,_ =>
-          ap.s ! False ! (NCase Sg (npform2case Sg v.c3.c))) ----agr to obj
+          ap.s ! False ! (NCase Sg (npform2case Sg v.c3.c.npf))) ----agr to obj
         (predV v) ** {c2 = v.c2} ;
 
     ComplSlash vp np = insertObjPre (\\fin,b,_ => appCompl fin b vp.c2 np) vp ;
 
-    UseComp comp = 
+    UseComp comp =
       insertObj (\\_,_ => comp.s) (predV (verbOlema ** {sc = NPCase Nom})) ;
 
-    SlashVV v vp = 
+    SlashVV v vp =
-      insertObj 
+      insertObj
-        (\\_,b,a => infVP v.sc b a vp v.vi) 
+        (\\_,b,a => infVP v.sc b a vp v.vi)
-        (predV {s = v.s ; 
+        (predV {s = v.s ;
                 p = v.p ;
                 sc = case vp.sc of {
                   NPCase Nom => v.sc ;   -- minun täytyy pestä auto
                   c => c                 -- minulla täytyy olla auto
-                  } 
+                  }
                }
          ) ** {c2 = vp.c2} ; ---- correct ??
 
-    SlashV2VNP v np vp = 
+    SlashV2VNP v np vp =
-      insertObjPre 
+      insertObjPre
         (\\fin,b,a => appCompl True b v.c2 np ++ ---- fin -> stack overflow
-                      infVP v.sc b a vp v.vi) 
+                      infVP v.sc b a vp v.vi)
           (predV v) ** {c2 = vp.c2} ;
 
     AdvVP vp adv = insertAdv adv.s vp ;
@@ -79,27 +79,15 @@ concrete VerbEst of Verb = CatEst ** open Prelude, ResEst in {
 
     ReflVP v = insertObjPre (\\fin,b,agr => appCompl fin b v.c2 (reflPron agr)) v ;
 
-    PassV2 v = 
+    PassV2 v = let vp : VP = passiveVP (predV v) in vp ** {
-    let 
+      sc = compl2subjcase v.c2  -- koer valitakse ; koerale räägitakse
-      vp = predV v ;
-      subjCase = case v.c2.c of { --this is probably a reason to not get rid of NPAcc; TODO check
-        NPCase Gen => NPCase Nom ; --valisin koera -> koer valitakse
-        _          => v.c2.c       --rääkisin koerale -> koerale räägitakse
-      }
-    in {
-      s = \\_ => vp.s ! VIPass Pres ;
-      s2 = \\_,_,_ => [] ;
-      adv = [] ;
-      p = vp.p ;
-      ext = vp.ext ;
-      sc = subjCase  -- koer valitakse ; koerale räägitakse 
       } ;
 
 ----b    UseVS, UseVQ = \v -> v ** {c2 = {s = [] ; c = NPAcc ; isPre = True}} ;
 
-    CompAP = compAP ;       
+    CompAP = compAP ;
     CompCN = compCN ;
-    CompNP np = {s = \\_ => np.s ! NPCase Nom} ;
+    CompNP np = {s = \\_ => linNP (NPCase Nom) np} ;
     CompAdv a = {s = \\_ => a.s} ;
 
 }
@@ -108,17 +96,17 @@ concrete VerbEst of Verb = CatEst ** open Prelude, ResEst in {
 --2 The object case
 --
 -- The rules involved are ComplV2 and ComplVV above.
--- The work is done jointly in ResEst.infVP and appCompl. 
+-- The work is done jointly in ResEst.infVP and appCompl.
 -- Cases to test: l -table (to see negated forms)
 --```
 --   minun täytyy ostaa auto
---   PredVP (UsePron i_Pron) (ComplVV must_VV 
+--   PredVP (UsePron i_Pron) (ComplVV must_VV
 --     (ComplV2 buy_V2 (DetCN (DetSg (SgQuant DefArt) NoOrd) (UseN car_N))))
 --   minä tahdon ostaa auton
---   PredVP (UsePron i_Pron) (ComplVV want_VV 
+--   PredVP (UsePron i_Pron) (ComplVV want_VV
 --     (ComplV2 buy_V2 (DetCN (DetSg (SgQuant DefArt) NoOrd) (UseN car_N))))
 --   minulla täytyy olla auto
---   PredVP (UsePron i_Pron) (ComplVV must_VV 
+--   PredVP (UsePron i_Pron) (ComplVV must_VV
 --     (ComplV2 have_V2 (DetCN (DetSg (SgQuant DefArt) NoOrd) (UseN car_N))))
 --```
 -- Unfortunately, there is no nice way to say "I want to have a car".

src/estonian/unittest/comitative.gftest

@@ -0,0 +1,146 @@
+-- Comitative, Essive, Abessive and Terminative cases are not in the inflection table of nominal categories,
+-- instead they use the Genitive stem and add a suffix with BIND token.
+-- Here are tests for those cases.
+
+-- NB. Ignore any weirdness with the word "koos".
+-- That just happens to be the linearisation of with_Prep,
+-- we can as easily replace it with just the case -ga,
+-- or in an application, have two versions, one "koos …ga" and other just "…ga".
+-- But do point out any other unexpected weirdness/ungrammaticality!
+
+-- Comitative, case attaches to the noun
+
+Lang: PredVP (UsePron i_Pron) (AdvVP (UseV play_V) (PrepNP with_Prep (DetCN (DetQuant this_Quant NumSg) (UseN dog_N))))
+LangEng: I play with this dog
+LangEst: mina mängin koos selle koera &+ ga
+
+Lang: PredVP (UsePron we_Pron) (AdvVP (UseV play_V) (PrepNP with_Prep (DetCN (DetQuant this_Quant NumPl) (UseN dog_N))))
+LangEng: we play with these dogs
+LangEst: meie mängime koos nende koerade &+ ga
+
+-- Interrogative versions
+
+-- First, reason why the interrogative pronoun doesn't inflect is this http://www.eki.ee/books/ekk09/index.php?p=5&p1=3&id=452
+--   "Üldse ei ühildu: asesõnad mis (kui ta ei osuta omadusele, vaid on identifitseerivas funktsioonis) [..],
+--   nt 'Mis keelt te räägite?' "
+-- So because of that, it doesn't inflect in any position. Here is the eki example:
+
+Lang: QuestSlash (IdetCN (IdetQuant which_IQuant NumSg) (UseN language_N)) (SlashVP (UsePron youSg_Pron) (SlashV2a speak_V2))
+LangEng: which language do you speak
+LangEst: mis keelt sina räägid
+
+-- But should the interrogative inflect when PrepIP is applied? Or is "koos mis koeraga" still fine?
+
+Lang: QuestIAdv (PrepIP with_Prep (IdetCN (IdetQuant which_IQuant NumSg) (UseN dog_N))) (PredVP (UsePron youSg_Pron) (UseV play_V))
+LangEng: with which dog do you play
+LangEst: koos mis koera &+ ga sina mängid
+
+Lang: QuestIAdv (PrepIP with_Prep (IdetCN (IdetQuant which_IQuant NumPl) (UseN dog_N))) (PredVP (UsePron youPl_Pron) (UseV play_V))
+LangEng: with which dogs do you play
+LangEst: koos mis koerade &+ ga teie mängite
+
+-- Adding a number, does it affect the behaviour of
+-- a) suffix attachment? b) agreement of interrogative?
+
+Lang: PredVP (UsePron i_Pron) (AdvVP (UseV play_V) (PrepNP with_Prep (DetCN (DetQuant this_Quant (NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n3)))))))) (UseN dog_N))))
+LangEng: I play with these three dogs
+LangEst: mina mängin koos nende kolme koera &+ ga
+
+Lang: PredVP (UsePron i_Pron) (AdvVP (UseV play_V) (PrepNP with_Prep (DetCN (DetQuant this_Quant (NumCard (NumDigits (IDig D_3)))) (UseN dog_N))))
+LangEng: I play with these 3 dogs
+LangEst: mina mängin koos nende 3 koera &+ ga
+
+Lang: QuestIAdv (PrepIP with_Prep (IdetCN (IdetQuant which_IQuant (NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n3)))))))) (UseN dog_N))) (PredVP (UsePron youPol_Pron) (UseV play_V))
+LangEng: with which three dogs do you play
+-- Which one is best?
+-- 1) koos mis kolm koeraga teie mängite
+-- 2) koos mis kolme koeraga teie mängite
+-- 3) koos mille kolme koeraga teie mängite
+-- 4) All are ungrammatical (provide more grammatical translation that is still compositional, not paraphrase)
+
+Lang: QuestIAdv (PrepIP with_Prep (IdetCN (IdetQuant which_IQuant (NumCard (NumDigits (IDig D_3)))) (UseN dog_N))) (PredVP (UsePron youPl_Pron) (UseV play_V))
+LangEng: with which 3 dogs do you play
+-- Which one is best?
+-- 1) koos mis 3 koeraga teie mängite
+-- 2) koos mille 3 koeraga teie mängite
+-- 3) All are ungrammatical (provide more grammatical translation)
+
+------------------------------------------------------------------------------------------
+-- Now we skip the content word, and make the determiner (possibly with number) into NP/IP
+-- The relevant functions are DetNP : Det -> NP and IDetIP : IDet -> IP
+
+-- No number, case attaches to determiner/interrogative
+Lang: PredVP (UsePron i_Pron) (AdvVP (UseV play_V) (PrepNP with_Prep (DetNP (DetQuant this_Quant NumPl))))
+LangEng: I play with these
+LangEst: mina mängin koos nende &+ ga
+
+Lang: QuestIAdv (PrepIP with_Prep whoSg_IP) (PredVP (UsePron youSg_Pron) (UseV sing_V))
+LangEng: with whom do you sing
+LangEst: koos kelle &+ ga sina laulad
+
+Lang: QuestIAdv (PrepIP with_Prep whoPl_IP) (PredVP (UsePron youSg_Pron) (UseV sing_V))
+LangEng: with whom do you sing
+LangEst: koos kellede &+ ga sina laulad
+
+-- Adding a number to a determiner, does this affect the comitative suffix placement?
+-- Context of the sentence is an ellipsis, "I sing with these 3 (singers)"
+
+Lang: PredVP (UsePron i_Pron) (AdvVP (UseV sing_V) (PrepNP with_Prep (DetNP (DetQuant this_Quant (NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n3)))))))))))
+LangEng: I sing with these three
+-- Which one is better?
+-- 1) mina laulan koos nende kolmega
+-- 2) mina laulan koos nendega kolme
+
+Lang: PredVP (UsePron i_Pron) (AdvVP (UseV sing_V) (PrepNP with_Prep (DetNP (DetQuant this_Quant (NumCard (NumDigits (IDig D_3)))))))
+LangEng: I sing with these 3
+LangEst: mina laulan koos nende 3 &+ ga
+-- Which one is better?
+-- 1) mina laulan koos nende 3ga
+-- 2) mina laulan koos nendega 3
+
+-- Adding a number to an interrogative, how does suffix placement + agreement work now?
+
+Lang: QuestIAdv (PrepIP with_Prep (IdetIP (IdetQuant which_IQuant (NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n3)))))))))) (PredVP (UsePron youSg_Pron) (UseV sing_V))
+LangEng: with which three do you sing
+-- Which one is best?
+-- 1) koos millede kolmega sina laulad
+-- 2) koos mille kolmega sina laulad
+-- 3) koos mis kolmega sina laulad
+-- 4) koos millega kolme sina laulad
+-- 5) koos milledega kolme sina laulad
+-- 6) All are ungrammatical (provide more grammatical translation)
+
+Lang: QuestIAdv (PrepIP with_Prep (IdetIP (IdetQuant which_IQuant (NumCard (NumDigits (IDig D_3)))))) (PredVP (UsePron youSg_Pron) (UseV sing_V))
+LangEng: with which 3 do you sing
+-- Which one is best?
+-- 1) koos millede 3ga sina laulad
+-- 2) koos mille 3ga sina laulad
+-- 3) koos mis 3ga sina laulad
+-- 4) koos millega 3 sina laulad
+-- 5) koos milledega 3 sina laulad
+-- 6) All are ungrammatical (provide more grammatical translation)
+
+
+-- Adding premodifiers to the number, does that change anything?
+
+-- Weird sentence, but imagine like, you point to a group of people, "I sing with these at most three",
+-- like you are the soloist and want at most 3 backup singers, who are among a group you are pointing at.
+-- If there was no ellipsis, the phrase would just be "koos nende kuni kolme lauljatega"?
+Lang: PredVP (UsePron i_Pron) (AdvVP (UseV sing_V) (PrepNP with_Prep (DetNP (DetQuant this_Quant (NumCard (AdNum at_most_AdN (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n3))))))))))))
+LangEng: I sing with these at most three
+LangEst: mina laulan koos nende kuni kolme &+ ga
+-- Which one is better?
+-- 1) mina laulan koos nende kuni kolmega
+-- 2) mina laulan koos nendega kuni kolme
+
+Lang: QuestIAdv (PrepIP with_Prep (IdetIP (IdetQuant which_IQuant (NumCard (AdNum at_most_AdN (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n3))))))))))) (PredVP (UsePron youSg_Pron) (UseV sing_V))
+LangEng: with which at most three do you sing
+LangEst: koos millede kuni kolme &+ ga sina laulad
+-- Which one is best?
+-- 1) koos millede kuni kolmega sina laulad
+-- 2) koos mille kuni kolmega sina laulad
+-- 3) koos mis kuni kolmega sina laulad
+-- 4) koos millega kuni kolme sina laulad
+-- 5) koos milledega kuni kolme sina laulad
+-- 6) All are ungrammatical (provide more grammatical translation)
+

src/german/CatGer.gf

@@ -50,11 +50,13 @@ concrete CatGer of Cat =
 
 -- Noun
 
-    CN = {s : Adjf => Number => Case => Str ;
+    CN = {
-		  rc : Number => Str ; -- Frage , [rc die ich gestellt habe]
+      s : Adjf => Number => Case => Str ;
-		  ext : Str ; -- Frage , [sc wo sie schläft])
+      rc : Number => Str ; -- Frage , [rc die ich gestellt habe]
-		  adv : Str ; -- Frage [a von Max]
+      ext : Str ;          -- Frage , [sc wo sie schläft]
-		  g : Gender} ;
+      adv : Str ;          -- Haus    [adv auf dem Hügel]
+      g : Gender
+      } ;
     NP = ResGer.NP ; 
     Pron = {s : NPForm => Str ; a : Agr} ;
     Det, DAP = {s,sp : Gender => PCase => Str ; n : Number ; a : Adjf ; isDef : Bool} ;
@@ -86,10 +88,10 @@ concrete CatGer of Cat =
 
 -- Open lexical classes, e.g. Lexicon
 
-    V, VS, VQ = ResGer.Verb ; -- = {s : VForm => Str} ;
+    V, VA, VS, VQ = ResGer.Verb ; -- = {s : VForm => Str} ;
     VV = Verb ** {isAux : Bool} ;
-    V2, VA, V2A, V2S, V2Q = Verb ** {c2 : Preposition} ;
+    V2, V2A, V2S, V2Q = Verb ** {c2 : Preposition} ;
-    V2V = Verb ** {c2 : Preposition ; isAux : Bool ; ctrl : Control} ;
+    V2V = Verb ** {c2 : Preposition ; isAux : Bool ; objCtrl : Bool} ;
     V3 = Verb ** {c2, c3 : Preposition} ;
 
     A  = {s : Degree => AForm => Str} ;
@@ -113,7 +115,7 @@ concrete CatGer of Cat =
     ClSlash = \cls -> cls.s ! MIndic ! Pres ! Simul ! Pos ! Main ++ cls.c2.s ;
 
     VP = \vp -> useInfVP False vp ;
-    VPSlash = \vps -> useInfVP False vps ++ vps.c2.s ;
+    VPSlash = \vps -> useInfVP False vps ++ vps.c2.s ++ vps.ext;
 
 	AP = \ap -> ap.c.p1 ++ ap.s ! APred ++ ap.c.p2 ++ ap.ext ;
         A2 = \a2 -> a2.s ! Posit ! APred ++ a2.c2.s ;

src/german/ConstructionGer.gf

@@ -42,13 +42,13 @@ lin
   where_go_QCl np = mkQCl (lin IAdv (ss "wohin")) (mkCl np (mkVP L.go_V)) ;
   where_come_from_QCl np =  mkQCl (lin IAdv (ss "woher")) (mkCl np (mkVP L.come_V)) ;
   
-  go_here_VP = mkVP (mkVP L.go_V) (mkAdv "her") ;
+  go_here_VP = mkVP (mkVP L.go_V) (ParadigmsGer.mkAdv "her") ;
-  come_here_VP = mkVP (mkVP L.come_V) (mkAdv "her") ;
+  come_here_VP = mkVP (mkVP L.come_V) (ParadigmsGer.mkAdv "her") ;
-  come_from_here_VP = mkVP (mkVP L.come_V) (mkAdv "von hier") ;
+  come_from_here_VP = mkVP (mkVP L.come_V) (ParadigmsGer.mkAdv "von hier") ;
 
-  go_there_VP = mkVP (mkVP L.go_V) (mkAdv "hin") ;
+  go_there_VP = mkVP (mkVP L.go_V) (ParadigmsGer.mkAdv "hin") ;
-  come_there_VP = mkVP (mkVP L.come_V) (mkAdv "hin") ;
+  come_there_VP = mkVP (mkVP L.come_V) (ParadigmsGer.mkAdv "hin") ;
-  come_from_there_VP = mkVP (mkVP L.come_V) (mkAdv "von dort") ;
+  come_from_there_VP = mkVP (mkVP L.come_V) (ParadigmsGer.mkAdv "von dort") ;
 
 lincat
   Weekday = N ;

src/german/DocumentationGerFunctor.gf

@@ -147,8 +147,8 @@ lin
 
 lin
   NoDefinition   t     = {s=t.s};
-  MkDefinition   t d   = {s="<p><b>Definierung:</b>"++t.s++d.s++"</p>"};
+  MkDefinition   t d   = {s="<p><b>Definition:</b>"++t.s++d.s++"</p>"};
-  MkDefinitionEx t d e = {s="<p><b>Definierung:</b>"++t.s++d.s++"</p><p><b>Beispiel:</b>"++e.s++"</p>"};
+  MkDefinitionEx t d e = {s="<p><b>Definition:</b>"++t.s++d.s++"</p><p><b>Beispiel:</b>"++e.s++"</p>"};
 
   MkDocument d i e = ss (i.s1 ++ d.s ++ i.s2 ++ paragraph e.s) ;  -- explanation appended in a new paragraph
   MkTag i = ss i.t ;

src/german/ExtendGer.gf

@@ -35,9 +35,8 @@ lin
     ConjVPI = conjunctDistrTable Bool ;
 
     ComplVPIVV v vpi = 
---        insertInf (vpi.s ! v.isAux) (
+      insertInf {inpl = <\\_ => [], (vpi.s ! v.isAux)> ; extr = \\_ => []}  -- HL 3/22
-      insertInf {s=(vpi.s ! v.isAux);isAux=v.isAux;ctrl=SubjC} ( -- HL ??
+        (predVGen v.isAux v) ;
-            predVGen v.isAux v) ; ----
 
     BaseVPS = twoTable2 Order Agr ;
     ConsVPS = consrTable2 Order Agr comma ;
@@ -70,37 +69,46 @@ lin
           m = tm.m ;
           subj  = [] ;
           verb  = vps.s  ! ord ! agr ! VPFinite m t a ;
+          haben = verb.inf2 ;
           neg   = tm.s ++ p.s ++ vp.a1 ++ negation ! b ; -- HL 8/19 ++ vp.a1 ! b ;
           -- obj1  = (vp.nn ! agr).p1 ;
           -- obj   = (vp.nn ! agr).p2 ; 
           -- compl = obj1 ++ neg ++ obj ++ vp.a2 ; -- from EG 15/5
-          obj1  = (vp.nn ! agr).p1 ++ (vp.nn ! agr).p2 ; -- refl ++ pronouns ++ nonpronouns
+          obj1  = (vp.nn ! agr).p1 ++ (vp.nn ! agr).p2 ; -- refl ++ pronouns ++ light nps
-          obj2  = (vp.nn ! agr).p3 ;                     -- pp-objects
+          obj2  = (vp.nn ! agr).p3 ;                     -- pp-objects and heavy nps
           obj3  = (vp.nn ! agr).p4 ++ vp.adj ++ vp.a2 ;  -- pred.AP|CN|Adv, via useComp HL 6/2019
           compl = obj1 ++ neg ++ obj2 ++ obj3 ;
-          inf   = vp.inf.s ++ verb.inf ++ verb.inf2 ;
+          infObjs = (vp.inf.inpl.p1)!agr ;               -- adapted to new VP.inf, HL 3/2022
-          extra = vp.ext ;
+          infPred = vp.inf.inpl.p2 ;
-          infE : Str =                              -- HL 30/6/2019
+          infCompl : Str = case <t,a,vp.isAux> of {
-            case <t,a,vp.isAux> of {
+             <Fut|Cond,Anter,True> => [] ;                                --# notpresent
-              <Fut|Cond,Simul,True> => inf ;                           --# notpresent
+             _ => infObjs ++ infPred } ;
-              <Fut|Cond,Anter,True> -- Duden 318: kommen wollen haben => haben kommen wollen --# notpresent
+          pred : {inf, infComplfin : Str} = case <t,a,vp.isAux> of {
-                => verb.inf2 ++ vp.inf.s ++ verb.inf ;                   --# notpresent
+             <Fut|Cond,Anter,True>  =>                                    --# notpresent
-              <_,Anter,True> => inf ;                                  --# notpresent
+               {inf    = infObjs ++ haben ++ infPred ++ verb.inf ;        --# notpresent Duden 318
-              _ => verb.inf ++ verb.inf2 ++ vp.inf.s } ;
+                infComplfin = -- es ++ wird ++ haben ++ tun ++ wollen     --# notpresent
-          inffin : Str =
+                   infObjs ++ verb.fin ++ haben ++ infPred ++ verb.inf} ; --# notpresent
-            case <t,a,vp.isAux> of {
+             <_,Anter,True> =>                                            --# notpresent
-	           <Fut|Cond,Anter,True>  -- ... wird|würde haben kommen wollen --# notpresent
+               {inf    = verb.inf ++ haben ;                              --# notpresent
-                     => verb.fin ++ verb.inf2 ++ vp.inf.s ++ verb.inf ;  --# notpresent
+                infComplfin = -- es ++ wird/hat/hatte ++ tun ++ wollen    --# notpresent
-	           <_,Anter,True>                                      --# notpresent
+                   infObjs ++ verb.fin ++ infPred ++ verb.inf ++ haben} ; --# notpresent
-                     => verb.fin ++ inf ;            -- double inf     --# notpresent
+              <Pres,_,_> =>
-                   _ => inf ++ verb.fin              --- or just auxiliary vp
+               {inf    = verb.inf ++ haben ;
-            } ;
+                infComplfin = -- es zu tun ++ [] ++ [] ++ versucht
+                   infCompl ++ verb.inf ++ haben ++ verb.fin}
+                                                                         ; --# notpresent
+              _ =>                                                         --# notpresent
+               {inf    = verb.inf ++ haben ;                               --# notpresent
+                infComplfin = -- es zu tun ++ versucht ++ [] ++ hat        --# notpresent
+                              infCompl ++ verb.inf ++ haben ++ verb.fin}   --# notpresent
+              } ;
+           extra = vp.inf.extr!agr ++ vp.ext ;
         in
         case o of {
-	    Main => subj ++ verb.fin ++ compl ++ vp.infExt ++ infE ++ extra ;
+	  Main => subj ++ verb.fin ++ compl ++ infCompl ++ pred.inf ++ extra ;
-	    Inv  => verb.fin ++ subj ++ compl ++ vp.infExt ++ infE ++ extra ;
+	  Inv  => verb.fin ++ subj ++ compl ++ infCompl ++ pred.inf ++ extra ;
-	    Sub  => subj ++ compl ++ vp.infExt ++ inffin ++ extra
+	  Subj =>             subj ++ compl ++   pred.infComplfin   ++ extra
-          }
+        }
     } ;
 
     ConjVPS = conjunctDistrTable2 Order Agr ;

src/german/ExtraGer.gf

@@ -12,16 +12,9 @@ concrete ExtraGer of ExtraGerAbs = CatGer **
     MkVPI vp = {s = \\b => useInfVP b vp} ;
     ConjVPI = conjunctDistrTable Bool ;
 
-    ComplVPIVV v vpi = 
+    ComplVPIVV v vpi =
---        insertInf (vpi.s ! v.isAux) (
+      insertInf {inpl = <\\_ => [], (vpi.s ! v.isAux)> ; extr = \\_ => []}  -- HL 3/22
-      insertInf {s=(vpi.s ! v.isAux);isAux=v.isAux;ctrl=SubjC} ( -- HL ??
+        (predVGen v.isAux v) ;
-            predVGen v.isAux v) ; ----
-{-
-      insertExtrapos vpi.p3 (
-        insertInf vpi.p2 (
-          insertObj vpi.p1 (
-            predVGen v.isAux v))) ;
--}
 
     PPzuAdv cn = {s = case cn.g of {
       Masc | Neutr => "zum" ;
@@ -33,8 +26,8 @@ concrete ExtraGer of ExtraGerAbs = CatGer **
 
     moegen_VV = auxVV mögen_V ;
 
-    ICompAP ap = {s = \\_ => "wie" ++ ap.s ! APred ; 
+    ICompAP ap = {s = \\_ => "wie" ++ ap.s ! APred ;
-				  ext = ap.c.p1 ++ ap.c.p2 ++ ap.ext} ; 
+                  ext = ap.c.p1 ++ ap.c.p2 ++ ap.ext} ;
 
     CompIQuant iq = {s = table {Ag g n p => iq.s ! n ! g ! Nom} ; ext = ""} ;
 
@@ -43,8 +36,6 @@ concrete ExtraGer of ExtraGerAbs = CatGer **
     DetNPMasc det = {
       s = \\c => det.sp ! Masc ! c ; ---- genders
       a = agrP3 det.n ;
-      -- isPron = False ;
-      -- isLight = True ; 
       w = WLight ;
       ext, rc = []
       } ;
@@ -52,8 +43,6 @@ concrete ExtraGer of ExtraGerAbs = CatGer **
     DetNPFem det = {
       s = \\c => det.sp ! Fem ! c ; ---- genders
       a = agrP3 det.n ;
-      -- isPron = False ;
-      -- isLight = True ; 
       w = WLight ;
       ext, rc = []
       } ;
@@ -66,37 +55,40 @@ concrete ExtraGer of ExtraGerAbs = CatGer **
       } ;
 
     PassVPSlash vp = 
-		let c = case <vp.c2.c,vp.c2.isPrep> of {
+      let c = case <vp.c2.c,vp.c2.isPrep> of {
-               <NPC Acc,False> => NPC Nom ;
+            <NPC Acc,False> => NPC Nom ;
-               _ => vp.c2.c}
+            _ => vp.c2.c}
-			in insertObj (\\_ => (PastPartAP vp).s ! APred) (predV werdenPass) **
+      in insertObj (\\_ => (PastPartAP vp).s ! APred) (predV werdenPass) **
-				{subjc = vp.c2 ** {c= c}} ;
+          { c1 = vp.c2 ** {c = c}} ;
-		-- regulates passivised object: accusative objects -> nom; all others: same case
+    -- regulates passivised object: accusative objects -> nom; all others: same case
-		-- this also gives "mit dir wird gerechnet" ;
+    -- this also gives "mit dir wird gerechnet" ;
-		-- the alternative linearisation ("es wird mit dir gerechnet") is not implemented
+    -- the alternative linearisation ("es wird mit dir gerechnet") is not implemented
 
     PassAgentVPSlash vp np = ---- "von" here, "durch" in StructuralGer
       insertObj (\\_ => (PastPartAgentAP (lin VPSlash vp) (lin NP np)).s ! APred) (predV werdenPass) ;
 
     Pass3V3 v = -- HL 7/19
       let bekommenPass : Verb = P.habenV (P.irregV "bekommen" "bekommt" "bekam" "bekäme" "bekommen") 
-      in insertObj (\\_ => (v.s ! VPastPart APred)) (predV bekommenPass) ** { subjc = PrepNom ; c2 = v.c2 } ;      
+      in insertObj (\\_ => (v.s ! VPastPart APred)) (predV bekommenPass) **
+           { c1 = PrepNom ; c2 = v.c2 ; objCtrl = False } ;
 
-    PastPartAP vp = {
+    PastPartAP vp =
-      s = \\af => (vp.nn ! agrP3 Sg).p1 ++ (vp.nn ! agrP3 Sg).p2 ++ (vp.nn ! agrP3 Sg).p3 ++ vp.a2 ++ vp.inf.s ++ 
+      let a = agrP3 Sg in {
-                  vp.ext ++ vp.infExt ++ vp.s.s ! VPastPart af ;
+        s = \\af => (vp.nn ! a).p1 ++ (vp.nn ! a).p2 ++ (vp.nn ! a).p3 ++ vp.a2
-      isPre = True ;
+                    ++ vp.inf.inpl.p2 ++ (vp.inf.extr ! a) ++ vp.s.s ! VPastPart af ;
-      c = <[],[]> ;
+        isPre = True ;
-      ext = [] 
+        c = <[],[]> ;
+        ext = vp.ext
       } ;
 
-    PastPartAgentAP vp np = 
+    PastPartAgentAP vp np =
-    let agent = appPrepNP P.von_Prep np
+      let a = agrP3 Sg ;
-    in {
+          agent = appPrepNP P.von_Prep np
-      s = \\af => (vp.nn ! agrP3 Sg).p1 ++ (vp.nn ! agrP3 Sg).p2 ++ (vp.nn ! agrP3 Sg).p3 ++ vp.a2 ++ agent ++ 
+      in {
-                   vp.inf.s ++ 
+      s = \\af => (vp.nn ! a).p1 ++ (vp.nn ! a).p2 ++ (vp.nn ! a).p3
-                   vp.c2.s ++ --- junk if not TV
+                  ++ vp.a2 ++ agent ++ vp.inf.inpl.p2
-                   vp.ext ++ vp.infExt ++ vp.s.s ! VPastPart af ;
+                  ++ vp.c2.s                         -- junk if not TV
+                  ++ vp.ext ++ (vp.inf.extr ! a) ++ vp.s.s ! VPastPart af ;
       isPre = True ;
       c = <[],[]> ;
       ext = [] 
@@ -138,37 +130,46 @@ concrete ExtraGer of ExtraGerAbs = CatGer **
           m = tm.m ;
           subj  = [] ;
           verb  = vps.s  ! ord ! agr ! VPFinite m t a ;
+          haben = verb.inf2 ;
           neg   = tm.s ++ p.s ++ vp.a1 ++ negation ! b ; -- HL 8/19 ++ vp.a1 ! b ;
           -- obj1  = (vp.nn ! agr).p1 ;
           -- obj   = (vp.nn ! agr).p2 ; 
           -- compl = obj1 ++ neg ++ obj ++ vp.a2 ; -- from EG 15/5
-          obj1  = (vp.nn ! agr).p1 ++ (vp.nn ! agr).p2 ; -- refl ++ pronouns ++ nonpronouns
+          obj1  = (vp.nn ! agr).p1 ++ (vp.nn ! agr).p2 ; -- refl ++ pronouns ++ light nps
-          obj2  = (vp.nn ! agr).p3 ;                     -- pp-objects
+          obj2  = (vp.nn ! agr).p3 ;                     -- pp-objects and heavy nps
           obj3  = (vp.nn ! agr).p4 ++ vp.adj ++ vp.a2 ;  -- pred.AP|CN|Adv, via useComp HL 6/2019
           compl = obj1 ++ neg ++ obj2 ++ obj3 ;
-          inf   = vp.inf.s ++ verb.inf ++ verb.inf2 ;
+          infObjs = (vp.inf.inpl.p1)!agr ;               -- adapted to new VP.inf, HL 3/2022
-          extra = vp.ext ;
+          infPred = vp.inf.inpl.p2 ;
-          infE : Str =                              -- HL 30/6/2019
+          infCompl : Str = case <t,a,vp.isAux> of {
-            case <t,a,vp.isAux> of {
+              <Fut|Cond,Anter,True> => [] ;                               --# notpresent
-              <Fut|Cond,Simul,True> => inf ;                           --# notpresent
+              _ => infObjs ++ infPred } ;
-              <Fut|Cond,Anter,True> -- Duden 318: kommen wollen haben => haben kommen wollen --# notpresent
+          pred : {inf, infComplfin : Str} = case <t,a,vp.isAux> of {
-                => verb.inf2 ++ vp.inf.s ++ verb.inf ;                   --# notpresent
+             <Fut|Cond,Anter,True>  =>                                    --# notpresent
-              <_,Anter,True> => inf ;                                  --# notpresent
+               {inf    = infObjs ++ haben ++ infPred ++ verb.inf ;        --# notpresent Duden 318
-              _ => verb.inf ++ verb.inf2 ++ vp.inf.s } ;
+                infComplfin = -- es ++ wird ++ haben ++ tun ++ wollen     --# notpresent
-          inffin : Str =
+                   infObjs ++ verb.fin ++ haben ++ infPred ++ verb.inf} ; --# notpresent
-            case <t,a,vp.isAux> of {
+             <_,Anter,True> =>                                            --# notpresent
-	           <Fut|Cond,Anter,True>  -- ... wird|würde haben kommen wollen --# notpresent
+               {inf    = verb.inf ++ haben ;                              --# notpresent
-                     => verb.fin ++ verb.inf2 ++ vp.inf.s ++ verb.inf ;  --# notpresent
+                infComplfin = -- es ++ wird/hat/hatte ++ tun ++ wollen    --# notpresent
-	           <_,Anter,True>                                      --# notpresent
+                   infObjs ++ verb.fin ++ infPred ++ verb.inf ++ haben} ; --# notpresent
-                     => verb.fin ++ inf ;            -- double inf     --# notpresent
+              <Pres,_,_> =>
-                   _ => inf ++ verb.fin              --- or just auxiliary vp
+               {inf    = verb.inf ++ haben ;
-            } ;
+                infComplfin = -- es zu tun ++ [] ++ [] ++ versucht
+                   infCompl ++ verb.inf ++ haben ++ verb.fin}
+                                                                         ; --# notpresent
+              _ =>                                                         --# notpresent
+               {inf    = verb.inf ++ haben ;                               --# notpresent
+                infComplfin = -- es zu tun ++ versucht ++ [] ++ hat        --# notpresent
+                              infCompl ++ verb.inf ++ haben ++ verb.fin}   --# notpresent
+              } ;
+           extra = vp.inf.extr!agr ++ vp.ext ;
         in
         case o of {
-	    Main => subj ++ verb.fin ++ compl ++ vp.infExt ++ infE ++ extra ;
+	  Main => subj ++ verb.fin ++ compl ++ infCompl ++ pred.inf ++ extra ;
-	    Inv  => verb.fin ++ subj ++ compl ++ vp.infExt ++ infE ++ extra ;
+	  Inv  => verb.fin ++ subj ++ compl ++ infCompl ++ pred.inf ++ extra ;
-	    Sub  => subj ++ compl ++ vp.infExt ++ inffin ++ extra
+	  Subj =>             subj ++ compl ++   pred.infComplfin   ++ extra
-          }
+        }
     } ;
 
     ConjVPS = conjunctDistrTable2 Order Agr ;
@@ -182,67 +183,78 @@ concrete ExtraGer of ExtraGerAbs = CatGer **
 
     ReflPoss num cn = {s = \\a,c => num.s ! cn.g ! c ++ possPron a num.n cn.g c ++ cn.s ! adjfCase Strong c ! num.n ! c} ;
 
+    ReflPron = { s = ResGer.reflPron } ;  -- reflexively used personal pronoun, with special forms in P3 Sg
+
+    -- In P1,P2 we might use "selbst" to define a (stronger) reflexive pronoun instead: -- HL 3/2022
+    --   du kennst mich vs. ich kenne mich selbst
+    --   er kennt ihn   vs. er kennt sich (selbst)
+    --   sie kennen sich (selbst) =/= sie kennen einander
+    -- Likewise, instead of ReflPoss we might define a reflexive possessive pronoun:
+    --   du kennst meine Fehler vs. ich kenne meine eigenen Fehler
+    --   er|sie|es kennt seine|ihre Fehler  vs. er|sie|es kennt seine|ihre|seine eigenen Fehler
+  oper
+    reflPronSelf : Agr => Case => Str = \\a => \\c => reflPron ! a ! c ++ "selbst" ;
+
+    reflPossPron : Agr -> Number -> Gender -> Case -> Str =
+      let eigen = adjForms "eigen" "eigen" in
+         \a,n,g,c -> possPron a n g c ++ (eigen ! (AMod (gennum g n) c)) ;
+
 -- implementation of some of the relevant Foc rules from Extra
 
   lincat 
-	Foc = {s : Mood => ResGer.Tense => Anteriority => Polarity => Str} ;
+    Foc = {s : Mood => ResGer.Tense => Anteriority => Polarity => Str} ;
 	
   lin 
     FocObj np cl =
-		let n = appPrepNP cl.c2 np
+      let n = appPrepNP cl.c2 np in mkFoc n cl ;
-		in mkFoc n cl ; 
 
-	FocAdv adv cl = mkFoc adv.s cl ;
+    FocAdv adv cl = mkFoc adv.s cl ;
 
-	FocAP ap np =
+    FocAP ap np =
-		let adj = ap.s ! APred ;
+      let adj = ap.s ! APred ;
-		    vp = predV sein_V ** {ext = ap.c.p1 ++ ap.c.p2 ++ ap.ext}; 
+          vp = predV ResGer.sein_V ** {ext = ap.c.p1 ++ ap.c.p2 ++ ap.ext};
-				-- potentially not correct analysis for all examples
+               -- potentially not correct analysis for all examples
-				-- works for:
+               -- works for:
-				-- "treu ist sie ihm"
+               -- "treu ist sie ihm"
-				-- "froh ist sie dass er da ist"
+               -- "froh ist sie dass er da ist"
-				-- "stolz ist sie auf ihn"
+               -- "stolz ist sie auf ihn"
-		    subj = mkSubj np vp.subjc ;
+          subj = mkSubj np vp.c1 ;
-			cl = mkClause subj.p1 subj.p2 vp
+          cl = mkClause subj.p1 subj.p2 vp
-		in mkFoc adj cl ;
+      in mkFoc adj cl ;
 
-	UseFoc t p f = {s = t.s ++ p.s ++ f.s ! t.m ! t.t ! t.a ! p.p} ;
+    UseFoc t p f = {s = t.s ++ p.s ++ f.s ! t.m ! t.t ! t.a ! p.p} ;
 
 
 -- extra rules to get some of the "es" alternative linearisations
 
   lin
-	EsVV vv vp = predV vv ** {
+    EsVV vv vp =                             -- HL 3/2022
-		nn = \\a => let n = vp.nn ! a in <"es" ++ n.p1, n.p2, n.p3, n.p4, n.p5, n.p6> ;
+      let inf = mkInf False Simul Pos vp ;   -- False = force extraction
-		inf = vp.inf ** {s = vp.s.s ! (VInf True) ++ vp.inf.s} ;  -- ich genieße es zu versuchen zu gehen; alternative word order could be produced by vp.inf ++ vp.s.s... (zu gehen zu versuchen)
+          objs : Agr => Str * Str * Str * Str = \\a => <"es",[],[],[]> ;
-		a1 = vp.a1 ;
+          vps = predV vv ** { nn = objs }
-		a2 = vp.a2 ;
+      in insertExtrapos vp.ext (
-		ext = vp.ext ;
+           insertInf inf vps) ;
-		infExt = vp.infExt ;
+
-		adj = vp.adj } ;
+    EsV2A v2a ap s = predV v2a ** {
-		
+      nn = \\_ => <"es",[],[],[]> ;
-	EsV2A v2a ap s = predV v2a ** {
+      adj = ap.s ! APred ;
-		nn = \\_ => <"es",[],[],[],[],[]> ; 
+      ext = "," ++ conjThat ++ s.s ! Sub} ;
-		adj = ap.s ! APred ; 
-		ext = "," ++ "dass" ++ s.s ! Sub} ;
 
 -- "es wird gelacht"; generating formal sentences
 
   lincat
-	FClause = ResGer.VP ** {subj : ResGer.NP} ;
+    FClause = ResGer.VP ** {subj : ResGer.NP} ;
-
 
   lin
-	VPass v = 
+    VPass v =
-  		let vp = predV werdenPass ;
+      let vp = predV werdenPass
-		in vp ** {
+      in vp ** {subj = esSubj ;
-			subj = esSubj ; 
+		inf = vp.inf ** {s = v.s ! VPastPart APred } } ; -- construct the formal clause
-			inf = vp.inf ** {s = v.s ! VPastPart APred } } ; -- construct the formal clause
 
-	AdvFor adv fcl = fcl ** {a2 = adv.s} ;
+    AdvFor adv fcl = fcl ** {a2 = adv.s} ;
 	
 	FtoCl cl = 
-		let subj = mkSubj cl.subj cl.subjc 
+		let subj = mkSubj cl.subj cl.c1
 		in DisToCl subj.p1 subj.p2 cl ;
 
 
@@ -251,16 +263,14 @@ concrete ExtraGer of ExtraGerAbs = CatGer **
     mkFoc : Str -> Cl -> Foc = \focus, cl ->
 		lin Foc {s = \\m,t,a,p => focus ++ cl.s ! m ! t ! a ! p ! Inv} ;
 
-	esSubj : NP = lin NP {
+    esSubj : CatGer.NP = lin NP {
-		s = \\_ => "es" ; 
+      s = \\_ => "es" ;
-		rc, ext = [] ;
+      rc, ext = [] ;
-		a = Ag Neutr Sg P3 ;
+      a = Ag Neutr Sg P3 ;
-                -- isLight = True ; 
+      w = WPron
-		-- isPron = True
+    } ;
-                w = WPron
-          } ;
 
-	DisToCl : Str -> Agr -> FClause -> Clause = \subj,agr,vp ->  
+    DisToCl : Str -> Agr -> FClause -> Clause = \subj,agr,vp ->
 	  let vps = useVP vp in {
       s = \\m,t,a,b,o =>
         let
@@ -273,20 +283,23 @@ concrete ExtraGer of ExtraGerAbs = CatGer **
           obj1  = (vp.nn ! agr).p1 ;
           obj2  = (vp.nn ! agr).p2 ++ (vp.nn ! agr).p3 ;
           compl = obj1 ++ neg  ++ vp.adj ++ obj2 ++ vp.a2 ; -- adj added
-          inf   = vp.inf.s ++ verb.inf ; -- not used for linearisation of Main/Inv
+          inf = vp.inf.inpl.p2 ++ verb.inf ;  -- not used for linearisation of Main/Inv
+          infExt = vp.inf.extr ! agr ;
           extra = vp.ext ;
-          inffin : Str = 
+          inffin : Str =
             case <a,vp.isAux> of {                       
 	           <Anter,True> => verb.fin ++ inf ; -- double inf   --# notpresent
-             _            => inf ++ verb.fin              --- or just auxiliary vp
+                   _            => inf ++ verb.fin   --- or just auxiliary vp
             }                                            
         in
         case o of {
-	    Main => subj ++ verb.fin ++ compl ++ vp.infExt ++ verb.inf ++ extra ++ vp.inf.s ;
+	    Main => subj ++ verb.fin ++ compl ++ infExt ++ verb.inf ++ extra ++ vp.inf.inpl.p2 ;
-	    Inv  => verb.fin ++ compl ++ vp.infExt ++ verb.inf ++ extra ++ vp.inf.s ;
+	    Inv  => verb.fin ++ compl ++ infExt ++ verb.inf ++ extra ++ vp.inf.inpl.p2 ; -- vp.inf.s ;
-	    Sub  => compl ++ vp.infExt ++ inffin ++ extra }
+	    Sub  => compl ++ infExt ++ inffin ++ extra }
     		} ; 
 		
 		-- this function is not entirely satisfactory as largely 
 		-- though not entirely duplicating mkClause in ResGer
+
+
 } 

src/german/ExtraGerAbs.gf

@@ -4,13 +4,12 @@ abstract ExtraGerAbs = Extra [
   VPSlash, PassVPSlash, PassAgentVPSlash, CompIQuant, PastPartAP, PastPartAgentAP,
   Temp,Tense,Pol,S,NP,VV,VP,Conj,IAdv,IQuant,IComp,ICompAP,IAdvAdv,Adv,AP,
   Foc,FocObj,FocAdv,FocAP,UseFoc,
-  RNP,ReflRNP,ReflPoss
+  RNP,ReflRNP,ReflPoss,ReflPron
   ] ** {
   flags coding=utf8;
   
   cat
 	FClause ; -- formal clause 
-	
   fun
     PPzuAdv   : CN -> Adv ;  -- zum Lied, zur Flasche
     TImpfSubj : Tense ;      -- ich möchte...   --# notpresent
@@ -27,4 +26,5 @@ abstract ExtraGerAbs = Extra [
   	FtoCl : FClause -> Cl ;  -- embedding FClause within the RGL, to allow generation of S, Utt, etc.
 
      Pass3V3 : V3 -> VPSlash ; -- wir bekommen den Beweis erklärt
+
 }

src/german/IdiomGer.gf

@@ -59,7 +59,7 @@ concrete IdiomGer of Idiom = CatGer **
       } ;
 
     ImpP3 np vp = {
-      s = (mkClause ((mkSubj np vp.subjc).p1) np.a vp).s ! 
+      s = (mkClause ((mkSubj np vp.c1).p1) np.a vp).s !
                            MConjunct ! Pres ! Simul ! Pos ! Inv 
       } ;
 

src/german/ParadigmsGer.gf

@@ -607,17 +607,17 @@ mkV2 : overload {
 
   mkV2V = overload { -- default: object-control
     mkV2V : V -> V2V 
-      = \v -> dirV2 v ** {isAux = False ; ctrl = ObjC ; lock_V2V = <>} ;
+      = \v -> dirV2 v ** {isAux = False ; objCtrl = True ; lock_V2V = <>} ;  -- ermahne jmdn, sich zu waschen
     mkV2V : V -> Prep -> V2V 
-      = \v,p -> prepV2 v p ** {isAux = False ; ctrl = ObjC ; lock_V2V = <>} ;
+      = \v,p -> prepV2 v p ** {isAux = False ; objCtrl = True ; lock_V2V = <>} ;
     } ;
   auxV2V = overload {
     auxV2V : V -> V2V 
-      = \v -> dirV2 v ** {isAux = True ; ctrl = ObjC ; lock_V2V = <>} ;
+      = \v -> dirV2 v ** {isAux = True ; objCtrl = True ; lock_V2V = <>} ;  -- lasse jmdn sich waschen
     auxV2V : V -> Prep -> V2V 
-      = \v,p -> prepV2 v p ** {isAux = True ; ctrl = ObjC ; lock_V2V = <>} ;
+      = \v,p -> prepV2 v p ** {isAux = True ; objCtrl = True ; lock_V2V = <>} ;
     } ;
-  subjV2V v = v ** {ctrl = SubjC} ;
+  subjV2V v = v ** {objCtrl = False} ;
 
   mkV2A = overload {
     mkV2A : V -> V2A 

src/german/QuestionGer.gf

@@ -50,7 +50,7 @@ concrete QuestionGer of Question = CatGer ** open ResGer in {
       s = \\m,t,a,p => 
             let 
               vp  = predV sein_V ** {ext = icomp.ext};
-	      subj = mkSubj np vp.subjc ;
+	      subj = mkSubj np vp.c1 ;
               cls = (mkClause subj.p1 subj.p2 vp).s ! m ! t ! a ! p ;
               why = icomp.s ! np.a
             in table {

src/german/ResGer.gf

@@ -101,14 +101,14 @@ resource ResGer = ParamX ** open Prelude in {
 
 --2 For $Verb$
 
-  param VForm = 
+  param VForm =
      VInf Bool           -- True = with the particle "zu"
    | VFin Bool VFormFin  -- True = prefix glued to verb
    | VImper    Number    -- prefix never glued
    | VPresPart AForm     -- prefix always glued
    | VPastPart AForm ;
 
-  param VFormFin = 
+  param VFormFin =
      VPresInd  Number Person
    | VPresSubj Number Person
    | VImpfInd  Number Person --# notpresent
@@ -124,10 +124,6 @@ resource ResGer = ParamX ** open Prelude in {
 
   param VType = VAct | VRefl Case ;
 
--- Implicit subject of embedded vp equals subject resp. object of matrix verb v:V2V:
-
-  param Control = SubjC | ObjC | NoC ; -- NoC : verb without infinite vp-complement
-
 -- The order of a sentence depends on whether it is used as a main
 -- clause, inverted, or subordinate.
 
@@ -258,7 +254,7 @@ resource ResGer = ParamX ** open Prelude in {
      --	 adv : Str ; -- die Frage [a von Max]  -- HL: cannot be extracted
      a : Agr ;
      -- isLight : Bool ;  -- light NPs come before negation in simple clauses (expensive)
-     -- isPron : Bool } ; -- needed to put accPron before datPron
+     -- isPron : Bool  ; -- needed to put accPron before datPron
      w : Weight } ;
 
   mkN  : (x1,_,_,_,_,x6,x7 : Str) -> Gender -> Noun = 
@@ -546,22 +542,23 @@ resource ResGer = ParamX ** open Prelude in {
       } ;
 
    VP : Type = {
-      s  : Verb ;                         -- HL 6/2019: <refl|pron,NP,PP,AP|CN|Adv,ObjInf,EmbedInfs>
+      s  : Verb ;                         -- HL 6/2019: <refl|pron,NP,PP,AP|CN|Adv>
-      nn : Agr => Str * Str * Str * Str   --            <sich|ihr,deine Frau,an sie,gut,
+      nn : Agr => Str * Str * Str * Str ; --            <sich|ihr,deine Frau,an sie,gut>
-                      * Str * Str ;       -- splitInfExt: (rate) dir, dich zu bemühen mir zu helfen> 
+      a1 : Str ;              -- was: adV inserted before negation, unused?
-      a1 : Str ;              -- adv before negation, adV
+      a2 : Str ;              -- adverb
-      a2 : Str ;              -- heute = adv
+      adj : Str ;             -- adjectival complement of V(2)A, e.g. ich finde dich schön
-      adj : Str ;             -- adjectival complement ("ich finde dich schön")
+      isAux : Bool ;          -- is a double infinitive?, e.g. müssen:VV, lassen:V2V
-      isAux : Bool ;          -- is a double infinitive
+      ext : Str ;             -- sentential complement of V(2)S, V(2)Q, e.g. dass|ob sie kommt
-      inf : {s:Str ; isAux:Bool ; ctrl:Control} ; -- infinitival complement of VV or V2V
+      inf : {inpl: (Agr => Str)*Str ; -- infinitival complement of V(2)V       HL 3/2022
-      ext : Str ;             -- dass sie kommt
+             extr: (Agr => Str)} ;    -- e.g. ihn [] versuchen (lasse) [, ihr zu helfen]
-      infExt : Str ;	      -- infinitival complements of inf 
+      c1 : Preposition        -- case of subject
-                              -- e.g. ich hoffe [ihr zu helfen] zu versuchen 
-      subjc : Preposition     -- case of subject
      } ;
 
-  VPSlash = VP ** {c2 : Preposition ; 
+  VPSlash = VP ** {c2 : Preposition ; objCtrl : Bool} ;  -- HL 3/2019 objCtr added
-                   objCtrl : Bool } ; -- True = embedded reflexives agree with object 
+
+  -- objCtrl distinguishes object-control from subject-control verb v:V2V in VP.s:
+  -- if True, reflexives in vp.inf and vp.nn have to agree with c2-object (added
+  -- by ComplSlash), else with subject (added by mkClause).
 
   useVP : VP -> VPC = \vp ->
     let
@@ -604,11 +601,12 @@ resource ResGer = ParamX ** open Prelude in {
         Cond => vf True (wuerde a) vinf [] ;   --# notpresent
         Pres => vf b (vfin b m t a) [] []
         } ;
-      VPFinite m t Anter => case t of {                  --# notpresent
+      VPFinite m t Anter => case t of {
-        Pres | Past => vf True (hat m t a) vpart [] ;    --# notpresent
+        Past => vf True (hat m t a) vpart [] ;           --# notpresent
         Fut  => vf True (wird m a) vpart haben ;         --# notpresent
-        Cond => vf True (wuerde a) vpart haben           --# notpresent 
+        Cond => vf True (wuerde a) vpart haben ;         --# notpresent
-        } ;                                              --# notpresent
+        Pres => vf True (hat m t a) vpart []
+        } ;
       VPImperat False => vf False (verb.s ! VImper (numberAgr a)) [] [] ;
       VPImperat True  => vf False (verb.s ! VFin False (VPresSubj Pl P3)) [] [] ;
       VPInfinit Anter => vf True [] (vpart ++ haben) [] ;   --# notpresent
@@ -616,31 +614,23 @@ resource ResGer = ParamX ** open Prelude in {
       }
     } ;
 
-  predV : Verb -> VPSlash = predVGen False ;
+  predV : Verb -> VP = predVGen False ;
 
   predVc : Verb ** {c2 : Preposition} -> VPSlash = \v -> 
     predV v ** {c2 = v.c2 ; objCtrl = False} ;
 
-  predVGen : Bool -> Verb -> VPSlash = \isAux, verb -> {
+  predVGen : Bool -> Verb -> VP = \isAux, verb -> {
-    s = {
+    s = verb ;
-     s = verb.s ;
-     prefix = verb.prefix ;
-     particle = verb.particle ;
-     aux = verb.aux ;
-     vtype = verb.vtype
-     } ;
     a1,a2  : Str = [] ;
-    nn  : Agr => Str * Str * Str * Str * Str * Str = case verb.vtype of {
+    nn  : Agr => Str * Str * Str * Str = case verb.vtype of {
-      VAct => \\_ => <[],[],[],[],[],[]> ;
+      VAct => \\_ => <[],[],[],[]> ;
-      VRefl c => \\a => <reflPron ! a ! c,[],[],[],[],[]>
+      VRefl c => \\a => <reflPron ! a ! c,[],[],[]>
       } ;
     isAux = isAux ; ----
-    inf = {s=[]; isAux=True; ctrl=NoC} ; -- default infinitive complement 
+    -- default infinitival complement:
-    ext,infExt,adj : Str = [] ;          -- (isAux=True => no endcomma)
+    inf = {inpl = <\\_ => [], []>; extr = \\_ => []} ;
-    subjc = PrepNom ;
+    ext,adj : Str = [] ;
-    -- Dummy values for subtyping.
+    c1 = PrepNom
-    c2 = PrepNom ; 
-    objCtrl = False 
     } ;
 
   auxPerfect : Verb -> VForm => Str = \verb ->
@@ -702,100 +692,109 @@ resource ResGer = ParamX ** open Prelude in {
 
   -- IL 24/04/2018 Fixing the scope of reflexives
   objAgr : { a : Agr } -> VP -> VP = \obj,vp -> vp ** {
-    nn = \\a => vp.nn ! obj.a } ;  
+    nn = \\a => vp.nn ! obj.a ;
-  -- HL: if reflexive only: <vp.nn.p1 ! np.a, vp.nn.p1 ! a, ..>
+    inf = {inpl = <\\a => vp.inf.inpl.p1 ! obj.a, vp.inf.inpl.p2> ;  -- HL 3/2022
+           extr = \\a => vp.inf.extr ! obj.a} } ;                    -- HL 3/2022
 
 -- Extending a verb phrase with new constituents.
 
-  insertObj : (Agr => Str) -> VPSlash -> VPSlash = \obj,vp ->  -- obj:Comp A|Adv|CN
+  insertObj : (Agr => Str) -> VP -> VP = \obj,vp ->  -- obj:Comp A|Adv|CN
-    vp ** { nn = \\a => let vpnn = vp.nn ! a 
+    vp ** { nn = \\a => let vpnn = vp.nn ! a in
-              in  <vpnn.p1, vpnn.p2, vpnn.p3, obj ! a ++ vpnn.p4, vpnn.p5, vpnn.p6> } ;
+                        <vpnn.p1, vpnn.p2, vpnn.p3, obj ! a ++ vpnn.p4> } ;
 
   insertObjc : (Agr => Str) -> VPSlash -> VPSlash = \obj,vp ->
     insertObj obj vp ** {c2 = vp.c2 ; objCtrl = vp.objCtrl } ;
 
   insertObjNP : NP -> Preposition -> VPSlash -> VPSlash = \np,prep,vp ->
     let c = case prep.c of { NPC cc => cc ; _ => Nom } ;
-        obj : Agr => Str = \\_ => appPrepNP prep np ;
+        obj = appPrepNP prep np ;
     in vp ** {
-      nn = \\a =>                  -- HL 11/6/19: rough objNP order:                (p5,p6 = splitInfExt)
+      nn = \\a =>
-        let vpnn = vp.nn ! a in    -- vfin < accPron < refl < (gen|dat)Pron < nonPronNP < neg < prepNP < vinf|comp
+        let vpnn = vp.nn ! a in
-{- less expensive if isLight is removed from NPs:
+        -- HL 11/6/19: rough object NP order (expensive):
-       case <np.isPron,prep.isPrep,c> of {
+        -- vfin < accPron < refl < (gen|dat)Pron < lightNP < neg < heavyNP|PP < vinf|comp
-          -- (assuming v.c2=acc) nonPron: dat < acc|gen  (acc < gen not enforced)
+        case <prep.isPrep, np.w, c> of { -- 2 * 3 * 4 = 24 cases
-          <True, False,Acc> => -- <es|ihn sich,  np, pp, comp, _,_>
+          <True, _,_> =>       -- <prons, light, heavy++pp, compl>
-            <obj ! a ++ vpnn.p1, vpnn.p2, vpnn.p3, vpnn.p4, vpnn.p5, vpnn.p6> ; 
+            <vpnn.p1, vpnn.p2, vpnn.p3 ++ obj, vpnn.p4> ;
-          <True, False,_  > => -- <sich ihm,     np, pp, comp>
+          <False,WPron, Acc> => -- <ihn ++ sich, light, heavy, comp>
-            <vpnn.p1 ++ obj ! a, vpnn.p2, vpnn.p3, vpnn.p4, vpnn.p5, vpnn.p6> ; 
+            <obj ++ vpnn.p1, vpnn.p2, vpnn.p3, vpnn.p4> ;
-          <False,False,Dat> => -- <prons, dat ++ np, pp, comp>
-            <vpnn.p1, obj ! a ++ vpnn.p2, vpnn.p3, vpnn.p4, vpnn.p5, vpnn.p6> ; 
-          <False,False,_  > => -- <prons, np ++ gen|acc, pp, comp>
-            <vpnn.p1, vpnn.p2 ++ obj ! a, vpnn.p3, vpnn.p4, vpnn.p5, vpnn.p6> ;
-          <_,    True,_   > => -- <prons, np, pp++pp, compl>
-            <vpnn.p1, vpnn.p2, vpnn.p3 ++ obj ! a, vpnn.p4, vpnn.p5, vpnn.p6>
-        }
--}
--- expensive:  -- vfin < accPron < refl < (gen|dat)Pron < lightNP < neg < heavyNP|PP < vinf|comp
-        case <prep.isPrep, np.w, c> of { 
-          <True, _,_> =>       -- <prons, light, heavy++pp, compl,_,_>
-            <vpnn.p1, vpnn.p2, vpnn.p3 ++ obj ! a, vpnn.p4, vpnn.p5, vpnn.p6> ;
-          <False,WPron, Acc> => -- <ihn ++ sich, light, heavy, comp, _,_>
-            <obj ! a ++ vpnn.p1, vpnn.p2, vpnn.p3, vpnn.p4, vpnn.p5, vpnn.p6> ;
           <False,WPron, _  > => -- <sich ++ ihm|seiner, light, heavy, comp>
-            <vpnn.p1 ++ obj ! a, vpnn.p2, vpnn.p3, vpnn.p4, vpnn.p5, vpnn.p6> ; 
+            <vpnn.p1 ++ obj, vpnn.p2, vpnn.p3, vpnn.p4> ;
-          <False,WLight,Dat> => -- (assuming v.c2=acc) nonPron: dat < acc|gen  
+          <False,WLight,Dat> => -- (assuming v.c2=acc) nonPron: dat < acc|gen
                                 -- <prons, dat ++ np, heavy, comp>
-            <vpnn.p1, obj ! a ++ vpnn.p2, vpnn.p3, vpnn.p4, vpnn.p5, vpnn.p6> ;
+            <vpnn.p1, obj ++ vpnn.p2, vpnn.p3, vpnn.p4> ;
           <False,WHeavy,Dat> => -- <prons, light, dat ++ np, comp>
-            <vpnn.p1, vpnn.p2, obj ! a ++ vpnn.p3, vpnn.p4, vpnn.p5, vpnn.p6> ; 
+            <vpnn.p1, vpnn.p2, obj ++ vpnn.p3, vpnn.p4> ;
           <False,WLight,_  > => -- <prons, np ++ gen|acc, heavy, comp>
-            <vpnn.p1, vpnn.p2 ++ obj ! a, vpnn.p3, vpnn.p4, vpnn.p5, vpnn.p6> ; 
+            <vpnn.p1, vpnn.p2 ++ obj, vpnn.p3, vpnn.p4> ;
           <False,WHeavy,_  > => -- <prons, light, dat ++ np, comp>
-            <vpnn.p1, vpnn.p2, vpnn.p3 ++ obj ! a, vpnn.p4, vpnn.p5, vpnn.p6> } 
+            <vpnn.p1, vpnn.p2, vpnn.p3 ++ obj, vpnn.p4> }
     } ; -- the ordering of objects of v:V3 (and v:V4) is also determined by Slash?V3 (and Slash?V4)
 
   insertObjRefl : VPSlash -> VPSlash = \vp -> -- HL 6/2019, to order reflPron < neg < prep+reflPron
     let prep = vp.c2 ;
-        b = notB prep.isPrep ;
         c = case prep.c of { NPC cc => cc ; _ => Acc } ;
-        obj : Agr => Str = \\a => prep.s ++ reflPron ! a ! c ;
+        obj : Agr => Str = \\a => prep.s ++ reflPron ! a ! c ;  -- HL: to test ReflVP: reflPronSelf
     in vp ** {
       nn = \\a =>
         let vpnn = vp.nn ! a in
-        case b of {
+        case prep.isPrep of {
-          True  => <obj ! a ++ vpnn.p1, vpnn.p2, vpnn.p3, vpnn.p4, vpnn.p5, vpnn.p6> ;
+          False => <obj ! a ++ vpnn.p1, vpnn.p2, vpnn.p3, vpnn.p4> ;
-          False => <vpnn.p1, obj ! a ++ vpnn.p2, vpnn.p3, vpnn.p4, vpnn.p5, vpnn.p6> }
+          True  => <vpnn.p1, obj ! a ++ vpnn.p2, vpnn.p3, vpnn.p4> }
     } ;
 
-  insertAdV : Str -> VP -> VP = \adv,vp -> vp ** { -- not used in RGL, so VP.a1 can be skipped
+  insertAdV : Str -> VP -> VP = \adv,vp -> vp ** { -- not used in Ger, so VP.a1 can be skipped
     a1 = adv ++ vp.a1 } ;                          -- cf. AdvVP(Slash),AdVVP(Slash)
 
   insertAdv : Str -> VP -> VP = \adv,vp -> vp ** {
     a2 = vp.a2 ++ adv } ;
 
-  insertExtrapos : Str -> VPSlash -> VPSlash = \ext,vp -> vp ** {
+  insertExtrapos : Str -> VP -> VP = \ext,vp -> vp ** {
     ext = vp.ext ++ ext } ;
 
-  insertInfExt : Str -> VPSlash -> VPSlash = \infExt,vp -> vp ** {
+  -- HL 3/2022: to do nested infinitival objects in ComplVV, SlashVV, SlashV2V
-	infExt = vp.infExt ++ infExt } ;
+  -- embed <sich, helfen> into <ihn, lassen> = <ihn sich, helfen lassen>
+  embedInf : (Agr => Str) * Str -> (Agr => Str) * Str -> (Agr => Str) * Str =
+     \f,g -> <\\a => g.p1!a ++ f.p1!a, f.p2 ++ g.p2> ;
 
-  -- HL: to handle infExt in ComplVV and SlashVV, SlashV2V
+  -- Futur-II:  (ich werde) ihn dir ++ haben ++ helfen lassen
-  insertInfExtraObj : (Agr => Str) -> VPSlash -> VPSlash = \objs,vp -> vp ** { 
+  insertInf : {inpl:(Agr => Str)*Str ; extr:(Agr => Str)} -> VP -> VP =
-    nn = \\a => let vpnn = vp.nn ! a in
+  \inf,vp -> vp ** {inf = {inpl = embedInf inf.inpl vp.inf.inpl ;
-      <vpnn.p1, vpnn.p2, vpnn.p3, vpnn.p4, objs ! a ++ vpnn.p5, vpnn.p6> 
+                           extr = \\agr => vp.inf.extr!agr ++ inf.extr!agr}} ;
-    } ;
-  insertInfExtraInf : (Agr => Str) -> VPSlash -> VPSlash = \inf,vp -> vp ** { 
-    nn = \\a => let vpnn = vp.nn ! a in
-      <vpnn.p1, vpnn.p2, vpnn.p3, vpnn.p4, vpnn.p5, vpnn.p6 ++ inf ! a>   
-    } ;
 
-  insertInf : {s:Str;isAux:Bool;ctrl:Control} -> VPSlash -> VPSlash = \inf,vp -> vp ** {
+  glueInpl : (Agr => Str)*Str -> (Agr => Str) =
-    inf = {s = inf.s ++ vp.inf.s ; isAux = inf.isAux ; ctrl=inf.ctrl} } ;
+      \inplace -> \\agr => (inplace.p1!agr ++ inplace.p2) ;
 
-  insertAdj : Str -> Str * Str -> Str -> VPSlash -> VPSlash = \adj,c,ext,vp -> vp ** {
+  -- HL 3/22: extract infzu-complement, leave inf-complement in-place
+  mkInf : Bool -> Anteriority -> Polarity -> VP ->
+                {inpl : (Agr => Str) * Str ; extr : (Agr => Str)} =
+     \isAux,ant,pol,vp ->
+        let
+            vpi = infVP isAux ant pol vp ;
+            topInpl = <vpi.objs, vpi.pred> ;
+            emptyInpl : (Agr => Str) * Str = <\\_ => [], []> ;
+            comma = bindComma
+        in
+          case <isAux,vp.isAux> of {
+            <True,True> -- 1: {s=will, inpl=<(sich, waschen) können>, extr = []}
+                => {inpl = embedInf vpi.inpl topInpl ;
+                    extr = \\agr => vpi.extr!agr} ;
+            <True,False> -- 2: {s=will; inpl=<[], versuchen>, extr = sich zu waschen}
+                => {inpl = topInpl ;
+                    extr = \\agr => (glueInpl vpi.inpl)!agr ++ vpi.extr!agr} ;
+            <False,True> -- 3: {s=wagt; inpl=<[], []>, extr = (sich, waschen) zu wollen}
+                => {inpl = emptyInpl ;
+                    extr = let moved = embedInf vpi.inpl topInpl
+                           in \\agr => comma ++ (glueInpl moved)!agr ++ vpi.extr!agr} ;
+            <False,False> -- 4: {s=wagt, inpl=<[], []>, extr = zu versuchen, (sich zu waschen)}
+                => {inpl = emptyInpl ;
+                    extr = \\agr => comma ++ (glueInpl topInpl)!agr ++ vpi.extr!agr}
+        } ;
+
+  insertAdj : Str -> Str * Str -> Str -> VP -> VP = \adj,c,ext,vp -> vp ** {
     nn = \\a => 
       let vpnn = vp.nn ! a in <vpnn.p1, vpnn.p2 ++ c.p1, -- der Frau treu
-                               vpnn.p3, vpnn.p4, vpnn.p5, vpnn.p6> ;  
+                               vpnn.p3, vpnn.p4> ;
     adj = vp.adj ++ adj ++ c.p2 ;                        -- neugierig auf das Buch
     ext = vp.ext ++ ext} ;           
 
@@ -809,7 +808,8 @@ resource ResGer = ParamX ** open Prelude in {
     s : Mood => Tense => Anteriority => Polarity => Order => Str
     } ;
 
-  mkClause : Str -> Agr -> VP -> Clause = \subj,agr,vp ->  let vps = useVP vp in {
+  mkClause : Str -> Agr -> VP -> Clause = \subj,agr,vp ->
+    let vps = useVP vp in {
       s = \\m,t,a,b,o =>
         let
           ord   = case o of {
@@ -817,55 +817,39 @@ resource ResGer = ParamX ** open Prelude in {
             _ => False
             } ;
           verb  = vps.s  ! ord ! agr ! VPFinite m t a ;
+          haben = verb.inf2 ;
           neg = negation ! b ;
           obj1  = (vp.nn ! agr).p1 ++ (vp.nn ! agr).p2 ; -- refl ++ pronouns ++ light nps
           obj2  = (vp.nn ! agr).p3 ;                     -- pp-objects and heavy nps
           obj3  = (vp.nn ! agr).p4 ++ vp.adj ++ vp.a2 ;  -- pred.AP|CN|Adv, via useComp HL 6/2019
           compl = obj1 ++ neg ++ obj2 ++ obj3 ;
-          -- leave inf-complement of +auxV(2)V in place, 
+          infObjs = (vp.inf.inpl.p1)!agr ;
+          infPred = vp.inf.inpl.p2 ;
+          -- leave inf-complement of +auxV(2)V in place,
           -- extract infzu-complement of -auxV(2)V: (ComplVV, SlashV2V)
-          infExt : Str * Str = case vp.inf.isAux of 
+          infCompl : Str = case <t,a,vp.isAux> of {
-            { True => <(vp.nn!agr).p6,[]> ; _ => <[],(vp.nn!agr).p6> } ;
+            <Fut|Cond,Anter,True> => [] ;                                 --# notpresent
-          extra = infExt.p2 ++ vp.ext ;
+            _ => infObjs ++ infPred } ;
-          infCompls = -- () tun | ihn (es tun) lassen | ihm [es zu tun] versprechen 
+          pred : {inf, infComplfin : Str} = case <t,a,vp.isAux> of {
-            (vp.nn ! agr).p5 ++ infExt.p1 ++ vp.inf.s ; 
+             <Fut|Cond,Anter,True>  =>                                    --# notpresent
-          comma = case orB vp.isAux (case vp.inf.ctrl of { NoC => True ; _ => False }) of {
+               {inf    = infObjs ++ haben ++ infPred ++ verb.inf ;        --# notpresent Duden 318
-            True => [] ; _ => bindComma} ;
+                infComplfin = -- es ++ wird ++ haben ++ tun ++ wollen     --# notpresent
-          inf : Str =
+                   infObjs ++ verb.fin ++ haben ++ infPred ++ verb.inf} ; --# notpresent
-            case <t,a,vp.isAux> of {
+             <_,Anter,True> =>                                            --# notpresent
-              <Fut|Cond,Anter,True>  =>                 --# notpresent   
+               {inf    = verb.inf ++ haben ;                              --# notpresent
-                --     haben () tun wollen | 
+                infComplfin = -- es ++ wird/hat/hatte ++ tun ++ wollen    --# notpresent
-                -- ihn haben (es tun) lassen wollen () |
+                   infObjs ++ verb.fin ++ infPred ++ verb.inf ++ haben} ; --# notpresent
-                -- ihm haben () versprechen wollen (, es zu tun)  
+              _ =>
-                (vp.nn ! agr).p5 ++ verb.inf2 ++ infExt.p1 ++ vp.inf.s ++ verb.inf ; --# notpresent
+               {inf    = verb.inf ++ haben ;
-              <_,       Anter,True>  =>                 --# notpresent
+                infComplfin = -- es zu tun ++ versucht/[] +[]+ hat/versuchte
-                -- tun wollen [] | ihn (es tun) lassen wollen [] | 
+                   infCompl ++ verb.inf ++ haben ++ verb.fin}
-                -- ihm () versprechen wollen [] (, es zu tun)
+              } ;
-                infCompls ++ verb.inf ++ verb.inf2 ;    --# notpresent
+          extra = vp.inf.extr!agr ++ vp.ext ;
-              <Fut|Cond,Simul,True>  =>                 --# notpresent
-                infCompls ++ verb.inf ++ verb.inf2 ;    --# notpresent
-              <Fut|Cond,Anter,False> =>                 --# notpresent
-              -- gebeten haben , es zu tun () | gebeten haben , ihn (es tun) zu lassen
-                verb.inf ++ verb.inf2 ++ comma ++ infCompls ; --# notpresent 
-              _                      => verb.inf2 ++ verb.inf ++ comma ++ infCompls } ;
-          inffin : Str =
-            case <t,a,vp.isAux> of {
-	           <Fut|Cond,Anter,True>  -- ... wird|würde haben kommen wollen --# notpresent
-                     => (vp.nn ! agr).p5 ++ verb.fin                      --# notpresent
-                     ++ verb.inf2 ++ infExt.p1 ++ vp.inf.s ++ verb.inf ;  --# notpresent
-	           <Pres|Past,Anter,True>                                 --# notpresent
-                     => (vp.nn ! agr).p5 ++ infExt.p1 ++ verb.fin         --# notpresent
-                     ++ vp.inf.s ++ verb.inf ++ verb.inf2 ; -- double inf --# notpresent
-                   <_, _          ,True> 
-                     => infCompls ++ verb.inf ++ verb.inf2 ++ verb.fin ;  -- or just auxiliary vp
-                   <_, _          ,False>
-                     => verb.inf ++ verb.inf2 ++ verb.fin ++ comma ++ infCompls
-            } ;
         in
-        case o of { 
+        case o of {
-	  Main => subj ++ verb.fin ++ compl ++ inf ++ extra ;
+	  Main => subj ++ verb.fin ++ compl ++ infCompl ++ pred.inf ++ extra ;
-	  Inv  => verb.fin ++ subj ++ compl ++ inf ++ extra ;
+	  Inv  => verb.fin ++ subj ++ compl ++ infCompl ++ pred.inf ++ extra ;
-	  Sub  =>             subj ++ compl ++ inffin ++ extra
+	  Subj =>             subj ++ compl ++   pred.infComplfin   ++ extra
         }
     } ;
 
@@ -886,34 +870,60 @@ resource ResGer = ParamX ** open Prelude in {
   es wird nicht besser
 -}
 
-  infVP : Bool -> VP -> ((Agr => Str) * Str * Str * Str) = 
+  infVP = overload {
-    \isAux, vp -> let vps = useVP vp in
+     infVP : Bool -> VP -> ((Agr => Str) * Str * Str * Str)
+     = infVP_orig ; -- from gf-3.9,
+     infVP : Bool -> Anteriority -> Polarity -> VP
+           -> { objs:(Agr => Str) ; pred:Str; inpl:(Agr=>Str)*Str ; extr:(Agr=>Str) }
+     = infVP_ant ; -- admit infinitive in Anter anteriority and Neg polarity
+  } ;
+
+  infVP_orig : Bool -> VP -> ((Agr => Str) * Str * Str * Str) =
+    \isAux, vp -> let vps = useVP vp ;
+                      infExt = vp.inf.extr ! agrP3 Sg   -- HL 3/22
+    in
     <
      \\agr => (vp.nn ! agr).p1 ++ (vp.nn ! agr).p2 ++ (vp.nn ! agr).p3 ++ (vp.nn ! agr).p4 ++ vp.a2,
      vp.a1 ++ vp.adj ++ (vps.s ! (notB isAux) ! agrP3 Sg ! VPInfinit Simul).inf,  -- vp.a1 ! Pos
-     vp.inf.s,
+     vp.inf.inpl.p2, -- ! HL
-     vp.infExt ++ vp.ext
+     infExt ++ vp.ext
     > ;
 
-  useInfVP : Bool -> VP -> Str = \isAux,vp ->
+  infVP_ant : Bool -> Anteriority -> Polarity -> VP  -- HL 3/22
-    let vpi = infVP isAux vp in
+    -> { objs:(Agr => Str) ; pred:Str ; inpl:(Agr=>Str)*Str ; extr:(Agr=>Str) } =
-    vpi.p1 ! agrP3 Sg ++ vpi.p3 ++ vpi.p2 ++ vpi.p4 ;
+      \isAux, ant, pol, vp -> let vps = useVP vp in
+      {
+        objs = \\agr => (vp.nn ! agr).p1 ++ (vp.nn ! agr).p2 ++ negation ! pol ++ (vp.nn ! agr).p3
+          ++ vp.a2 ++ (vp.nn ! agr).p4 ;  -- objects + predicative A|CN|NP
+        pred = vp.a1 ++ vp.adj ++ (vps.s ! (notB isAux) ! agrP3 Sg ! VPInfinit ant).inf ;
+        -- inplace and extracted parts of vp.inf:
+        inpl = vp.inf.inpl ;
+        extr = vp.inf.extr
+      } ;
 
-  infzuVP : Bool -> Control -> Anteriority -> Polarity -> VP  -- HL 
+  infVPSlash : Bool -> Anteriority -> Polarity -> VPSlash  -- HL 3/22
-    -> { objs:(Agr => Str) ; pred:{s:Str;isAux:Bool;ctrl:Control} ; inf:Str ; ext:Str } =
+    -> { objs:(Agr => Str) ; pred:Str; inpl:(Agr=>Str)*Str ; extr:(Agr=>Str) } =
-      \isAux, ctrl, ant, pol, vp -> let vps = useVP vp in
+      \isAux, ant, pol, vp -> let vps = useVP vp in
       { objs = \\agr => (vp.nn ! agr).p1 ++ (vp.nn ! agr).p2 ++ negation ! pol ++ (vp.nn ! agr).p3
           ++ vp.a2 ++ (vp.nn ! agr).p4 ;  -- objects + predicative A|CN|NP
-        pred = { s = vp.a1 ++ vp.adj ++ (vps.s ! (notB isAux) ! agrP3 Sg ! VPInfinit ant).inf ;
+        pred = vp.inf.inpl.p2 ++ vp.a1 ++ vp.adj ++ (vps.s ! (notB isAux) ! agrP3 Sg ! VPInfinit ant).inf ;
-                 isAux = vp.isAux ; ctrl = ctrl } ;
+        -- inplace and extracted parts of vp.inf:
-        inf = vp.inf.s ;
+        inpl = <vp.inf.inpl.p1, []> ; -- move the predicate part to pred
-        ext = vp.ext
+        extr = vp.inf.extr
-      } ;
+      } ** {c2 = vp.c2 ; objCtrl = vp.objCtrl} ;
+
+  -- for CatGer.linref VP and Verb.embedVP:
+  useInfVP : Bool -> VP -> Str = \isAux,vp ->
+    -- let vpi = infVP isAux vp in
+    -- vpi.p1 ! agrP3 Sg ++ vpi.p3 ++ vpi.p2 ++ vpi.p4 ;
+    let vpi = infVP isAux Simul Pos vp ; -- HL 3/2022
+        agr : Agr = (Ag Masc Sg P3) ;
+        glue : (Agr => Str)*Str -> Str =  \i -> i.p1!agr ++ i.p2
+    in
+       glue (embedInf vpi.inpl <vpi.objs, vpi.pred>) ++ vpi.extr!agr ++ vp.ext ;
 
 -- The nominative case is not used as reflexive, but defined here
 -- so that we can reuse this in personal pronouns. 
--- The missing Sg "ihrer" shows that a dependence on gender would
--- be needed.
 
   reflPron : Agr => Case => Str = table {
     Ag _ Sg P1 => caselist "ich" "mich" "mir"  "meiner" ;
@@ -984,12 +994,10 @@ resource ResGer = ParamX ** open Prelude in {
     } ;
 
 -- Function that allows the construction of non-nominative subjects.
-  mkSubj : NP -> Preposition -> Str * Agr = \np, subjc -> 
+  mkSubj : NP -> Preposition -> Str * Agr = \np, prep ->
     let 
-      sub = subjc ;
+      agr = case prep.c of { NPC Nom => np.a ; _ => Ag Masc Sg P3 } ;
-      agr = case sub.c of { NPC Nom => np.a ; _ => Ag Masc Sg P3 } ;
+      subj = appPrepNP prep np
-      subj = appPrepNP sub np
     in <subj , agr> ;
 
 }
-

src/german/SentenceGer.gf

@@ -4,9 +4,9 @@ concrete SentenceGer of Sentence = CatGer ** open ResGer, Prelude in {
 
   lin
 
-	PredVP np vp = 
+    PredVP np vp =
-		let subj = mkSubj np vp.subjc 
+      let subj = mkSubj np vp.c1
-		in mkClause subj.p1 subj.p2 vp ;
+      in mkClause subj.p1 subj.p2 vp ;
 
 	{- applies verb's subject case to subject ;
 	   forces 3rd person sg agreement for any non-nom subjects -->
@@ -26,16 +26,16 @@ concrete SentenceGer of Sentence = CatGer ** open ResGer, Prelude in {
             } ;
           agr  = Ag Fem (numImp n) ps.p1 ; --- g does not matter
           verb = vps.s ! False ! agr ! VPImperat ps.p3 ;
-          inf  = vp.inf.s ++ verb.inf ;  -- HL .nn
+          inf  = vp.inf.inpl.p2 ++ verb.inf ;  -- HL .s/.inpl.p2
           obj  = (vp.nn ! agr).p2 ++ (vp.nn ! agr).p3 ++ (vp.nn ! agr).p4
         in
 --        verb.fin ++ ps.p2 ++ (vp.nn ! agr).p1 ++ vp.a1 ! pol ++ obj ++ vp.a2 ++ inf ++ vp.ext
         verb.fin ++ ps.p2 ++ (vp.nn ! agr).p1 ++ vp.a1 ++ negation ! pol ++ obj ++ vp.a2 ++ inf ++ vp.ext
     } ; 
 
-    SlashVP np vp = 
+    SlashVP np vp =
-		let subj = mkSubj np vp.subjc 
+      let subj = mkSubj np vp.c1 ;                       -- HL 3/2022: need a mkClSlash to prevent
-		in mkClause subj.p1 subj.p2 vp ** {c2 = vp.c2} ;
+      in mkClause subj.p1 subj.p2 vp ** { c2 = vp.c2 } ; -- reflexives in vp instantiated to np.a
 
     AdvSlash slash adv = {
       s  = \\m,t,a,b,o => slash.s ! m ! t ! a ! b ! o ++ adv.s ;

src/german/VerbGer.gf

@@ -15,37 +15,20 @@ concrete VerbGer of Verb = CatGer ** open Prelude, ResGer, Coordination in {
           insertInf vpi.p2 (
             insertObjc vpi.p1 vps))) ;
 -}  
-    -- HL 7/19
+
-    ComplVV v vp = -- will|wage (es ([]|zu) tun [] | ihn [es tun] ([]|zu) lassen
+    ComplVV v vp = -- HL 3/22: leave inf-complement in-place, extract infzu-complement
       let
-        vps = predVGen v.isAux v ;
+        vps = predVGen v.isAux v ; -- e.g. will.isAux=True | wagt.isAux=False
-        vpi = infzuVP v.isAux SubjC Simul Pos vp ;
+        inf = mkInf v.isAux Simul Pos vp
-        -- { objs: ihm ; pred: []/zu versprechen, objInf: sich/es zu tun }
-        -- (ich) vfin:werde (ihm ([]/zu) versprechen) vinf:(wollen/gewagt haben) (, es zu tun)
-        -- (ich) vfin:werde (ihn (es tun) lassen)/[]  vinf:(wollen/gewagt haben) []/(, ihn (es tun) zu lassen)
-        extInfzu = case <vp.isAux,vp.inf.isAux> of {<True,False> => (vp.nn!(Ag Masc Sg P3)).p6 ; _ => []} ;
-        comma = case vp.inf.ctrl of { NoC => [] ; _ => bindComma} ; -- es (zu) tun
-        embeddedInf : Agr => Str =
-          case <vp.isAux,vp.inf.isAux> of { -- vv + vp + [embeddedInf]
-            -- will [es lesen] können | will ihn [es lesen] lassen
-            <True,True>  => \\agr => (vp.nn!agr).p5 ++ (vp.nn!agr).p6 ++ vpi.inf ;
-            -- will ihn [euch (extInfzu) bitten] lassen
-            <True,False> => \\agr => (vp.nn!agr).p5 ++ vpi.inf ; -- ++ (vp.nn!agr).p6 => extInfzu
-            -- will es lesen [] | will ihn bitten [, es zu lesen] | will ihn bitten [, sie es lesen zu lassen]
-            <False,True>  => \\agr => comma ++ (vp.nn!agr).p5 ++ (vp.nn!agr).p6 ++ vpi.inf ;
-            -- will ihn bitten [, ihr zu helfen, es zu lesen]
-            <False,False> => \\agr => comma ++ (vp.nn!agr).p5 ++ vpi.inf ++ (vp.nn!agr).p6 }
       in
-      insertExtrapos (extInfzu ++ vpi.ext) ( -- vps.ext   <- vp's extracted embedded infzu + vp's object-sentence
+      insertExtrapos vp.ext (
-        insertInf vpi.pred (                 -- vps.inf   <- vp's infinite main verb
+        insertInf inf vps) ;
-          insertInfExtraObj vpi.objs (       -- vps.nn.p5 <- vp's object nps
-            insertInfExtraInf embeddedInf vps))) ;
 
     ComplVS v s = 
       insertExtrapos (comma ++ conjThat ++ s.s ! Sub) (predV v) ;
     ComplVQ v q = 
       insertExtrapos (comma ++ q.s ! QIndir) (predV v) ;
-    ComplVA v ap = insertAdj (v.c2.s ++ ap.s ! APred) ap.c ap.ext (predV v) ; -- changed
+    ComplVA v ap = insertAdj (ap.s ! APred) ap.c ap.ext (predV v) ;
 
     SlashV2a v = (predVc v) ; 
       
@@ -53,9 +36,9 @@ concrete VerbGer of Verb = CatGer ** open Prelude, ResGer, Coordination in {
     Slash3V3 v np = insertObjNP np v.c3 (predVc v) ; 
 
     SlashV2S v s = 
-      insertExtrapos (comma ++ conjThat ++ s.s ! Sub) (predVc v) ;
+      insertExtrapos (comma ++ conjThat ++ s.s ! Sub) (predV v) ** {c2 = v.c2; objCtrl = False} ;
     SlashV2Q v q = 
-      insertExtrapos (comma ++ q.s ! QIndir) (predVc v) ;
+      insertExtrapos (comma ++ q.s ! QIndir) (predV v) ** {c2 = v.c2; objCtrl = False} ;
 {-
     SlashV2V v vp = 
       let 
@@ -66,28 +49,26 @@ concrete VerbGer of Verb = CatGer ** open Prelude, ResGer, Coordination in {
         insertInfExt vpi.p3 (
           insertInf vpi.p2 (
             insertObjc vpi.p1 vps))) ;
+
 -}
-    SlashV2V v vp =   -- jmdn bitten, (\agr => sich!agr das Buch zu merken)  HL 7/19
+    SlashV2V v vp =  -- (jmdn) bitten, sich zu waschen | sich waschen lassen  HL 7/19
       let
-        vps = (predVGen v.isAux v) ** { c2 = v.c2 ; objCtrl = case v.ctrl of {ObjC => True ; _ => False}} ;
+        vps = predVGen v.isAux v ; -- e.g. verspricht|bittet.isAux=False | läßt.isAux=True
-        vpi = infzuVP v.isAux v.ctrl Simul Pos vp ;
+        inf = mkInf v.isAux Simul Pos vp
-        comma : Str = case <vp.isAux,vp.inf.ctrl> of { <True,_> | <_,NoC> => [] ; _ => bindComma} ;
-        embeddedInf : Agr => Str = case vp.inf.isAux of {
-          True  => \\agr => comma ++ (vp.nn!agr).p5 ++ (vp.nn!agr).p6 ++ vpi.inf ;  -- ihn es lesen (zu) lassen
-          False => \\agr => comma ++ (vp.nn!agr).p5 ++ vpi.inf ++ (vp.nn!agr).p6 }  -- ihn (zu) bitten , es zu lesen
       in
-      insertExtrapos vpi.ext (           -- vps.ext   <- vp's object-sentence ++ extractedInfzu?
+      insertExtrapos vp.ext (
-        insertInf vpi.pred (             -- vps.inf   <- vp's infinite main verb
+        insertInf inf vps) ** {c2 = v.c2 ; objCtrl = v.objCtrl} ;
-          insertInfExtraObj vpi.objs (   -- vps.nn.p5 <- vp's object nps
-            insertInfExtraInf embeddedInf vps))) ;
 
     SlashV2A v ap =
-      insertAdj (ap.s ! APred) ap.c ap.ext (predVc v) ;
+      insertAdj (ap.s ! APred) ap.c ap.ext (predV v) ** {c2 = v.c2; objCtrl = False} ;
 
     ComplSlash vps np =
-      let vp = insertObjNP np vps.c2 vps ;
+      -- IL 24/04/2018 force reflexive in the VPSlash to take the agreement of np.
-          -- IL 24/04/2018 force reflexive in the VPSlash to take the agreement of np.
+      -- HL 3/22 better before inserting np, using objCtrl
-      in case vps.objCtrl of { True => objAgr np vp ; _  => vp } ;
+      let vp = case vps.objCtrl of { True => objAgr np vps ; _  => vps }
+               ** { c2 = vps.c2 ; objCtrl = vps.objCtrl } ;
+      in insertObjNP np vps.c2 vp ;
+
 {-
     SlashVV v vp = 
       let
@@ -95,26 +76,34 @@ concrete VerbGer of Verb = CatGer ** open Prelude, ResGer, Coordination in {
         vps = predVGen v.isAux v ** {c2 = vp.c2 } ;
       in vps **
       insertExtrapos vpi.p3 (
-        insertInf {s=vpi.p2;isAux=vp.isAux;ctrl=SubjC} ( -- insertInf vpi.p2 (
+        insertInf vpi.p2 (
           insertObj vpi.p1 vps)) ;
 -}
-    SlashVV v vp = -- will|hoffe ((zu) lesen | ihr (zu) geben | (zu) bitten, es zu lesen) 
+
+    -- SlashVV v vps is like ComplVV v vp, but infinite vps should not be extracted
+    SlashVV v vp =                                                    --  HL 3/2022
       let
-        vps = (predVGen v.isAux v) ** { c2 = vp.c2 } ;
+        vps = predVGen v.isAux v ; -- e.g. will.isAux=True | wagt.isAux=False
-        vpi = infzuVP v.isAux SubjC Simul Pos vp ; -- (zu) (lesen | ihr geben | bitten, es zu lesen) 
+        vpi = infVPSlash v.isAux Simul Pos vp ;     -- differs from infVP !
-        comma : Str = case <vp.isAux,vp.inf.ctrl> of { <True,_> | <_,NoC> => [] ; _ => bindComma} ;
+        inf : {inpl: (Agr => Str) * Str ; extr : (Agr => Str)} =
-        embeddedInf : Agr => Str = case vp.inf.isAux of {
+          let
-          True  => \\agr => comma ++ (vp.nn!agr).p5 ++ (vp.nn!agr).p6 ++ vpi.inf ;  -- es lesen (zu) lassen
+            topInpl = <vpi.objs, vpi.pred> ;
-          False => \\agr => comma ++ (vp.nn!agr).p5 ++ vpi.inf ++ (vp.nn!agr).p6 }  -- (zu) bitten, es zu lesen
+            emptyInpl : (Agr => Str) * Str = <\\_ => [], []> ;
+          in
+          case <v.isAux,vp.isAux> of {
+            <False,True> -- wagt lesen zu wollen
+                => {inpl = emptyInpl ;
+                    extr = let moved = (embedInf vpi.inpl topInpl)
+                           in \\agr => (glueInpl moved)!agr ++ (vpi.extr!agr)} ;
+              _ => -- wagt zu lesen zu versuchen
+                   -- will lesen können | will zu lesen wagen
+                   {inpl = embedInf vpi.inpl topInpl ; extr = vpi.extr}
+            } ;
       in
-      insertExtrapos vpi.ext (           -- vps.ext   <- vp's object-sentence ++ extractedInfzu?
+      insertExtrapos vp.ext (
-        insertInf vpi.pred (             -- vps.inf   <- vp's infinite main verb
+        insertInf inf vps) ** {c2 = vp.c2 ; objCtrl = vp.objCtrl};
-          insertInfExtraObj vpi.objs (   -- vps.nn.p5 <- vp's object nps
-            insertInfExtraInf embeddedInf vps))) ;
 
--- {- HL 8/19: this slightly modified SlashV2VNP is expensive even with NP.w:Weight 
+{-  -- order of embedded objects wrong: 
-
-    -- order of embedded objects wrong: 
     -- Lang> p "the woman that you beg me to listen to" | l
     --   the woman that you beg me to listen to
     --   die Frau , der ihr mich zuzuhören bittet
@@ -123,19 +112,25 @@ concrete VerbGer of Verb = CatGer ** open Prelude, ResGer, Coordination in {
     SlashV2VNP v np vp =
       let 
         vpi = infVP v.isAux vp ;
-        vps = predVGen v.isAux v ** {c2 = vp.c2} ; -- objCtrl = ?
+        vps = predVGen v.isAux v ** {c2 = vp.c2} ;
       in vps **
       insertExtrapos vpi.p3 (
-        insertInf {s=vpi.p2;isAux=v.isAux;ctrl=v.ctrl} ( -- insertInf vpi.p2
+        insertInf vpi.p2 (
           insertObj vpi.p1 (
             insertObj (\\_ => appPrepNP v.c2 np) vps))) ;
 
-    -- HL: version with infzuVP in tests/german/TestLangGer.gf, too expensive
+-}
+   -- expensive: + SlashV2VNP 503.884.800 (2880,540), reaches memory limit with SlashVV
+   -- does not work for nested uses: the nn-levels are confused  HL 3/22
+
+   SlashV2VNP v np vp =   -- bitte ihn, zu kaufen | lasse ihn kaufen   HL 3/22
+      insertObjNP np v.c2 (ComplVV v vp ** {c2 = vp.c2 ; objCtrl = vp.objCtrl}) ;
+
 
     UseComp comp =
        insertExtrapos comp.ext (insertObj comp.s (predV sein_V)) ; -- agr not used
     -- adj slot not used here for e.g. "ich bin alt" but same behaviour as NPs?
-	-- "ich bin nicht alt" "ich bin nicht Doris" 
+	-- "ich bin nicht alt" "ich bin nicht Doris"
 
     UseCopula = predV sein_V ;
 
@@ -162,7 +157,10 @@ concrete VerbGer of Verb = CatGer ** open Prelude, ResGer, Coordination in {
     --   (\\k => usePrepC k (\c -> reflPron ! a ! c))) vp ;
     ReflVP vp = insertObjRefl vp ; -- HL, 19/06/2019
 
-    PassV2 v = insertObj (\\_ => v.s ! VPastPart APred) (predV werdenPass) ;
+    PassV2 v = -- acc object -> nom subject; all others: same PCase
+      let c = case <v.c2.c, v.c2.isPrep> of {
+            <NPC Acc, False> => NPC Nom ; _ => v.c2.c}
+      in insertObj (\\_ => v.s ! VPastPart APred) (predV werdenPass) ** { c1 = v.c2 ** {c = c} } ;
 
 {- HL: The construction VPSlashPrep : VP -> Prep -> VPSlash does not exist
    in German. In abstract/Verb.gf, the example

tests/german/TestLang.gf

@@ -1,7 +1,7 @@
 abstract TestLang = 
-  Grammar, 
+  Grammar - [SlashVP, RelSlash],
   TestLexiconGerAbs
---  , Construction
+  , Construction
   ** {    
   flags startcat=Phr ;
 
@@ -32,4 +32,12 @@ abstract TestLang =
     Pass2V3 : V3 -> NP -> VP ;  -- uns erklärt werden ; Eng give_V3[indir,dir]: we are given the book
 
     Pass2V4 : V4 -> NP -> VPSlash ; -- bei dir (für Gold) gekauft werden
+
+  cat
+    ClauseSlash ;
+
+  fun
+    RelSlash : RP -> ClauseSlash -> RCl ;
+    SlashVP : NP -> VPSlash -> ClauseSlash ;
+
   } ;

tests/german/TestLangEng.gf

@@ -4,7 +4,7 @@
 concrete TestLangEng of TestLang = 
   GrammarEng
   , TestLexiconEng
---  , ConstructionEng
+  , ConstructionEng
   ** open (R=ResEng), (P=ParadigmsEng), Prelude, (E=ExtendEng)
   in {
 

tests/german/TestLangGer.gf

@@ -2,9 +2,9 @@
 -- use the modified files in gf-rgl/src/german
 
 concrete TestLangGer of TestLang = 
-  GrammarGer - [PassV2] -- to improve these ,ComplVV,SlashVV,SlashV2V,SlashV2VNP
+  GrammarGer - [SlashVP, RelSlash]
-  , TestLexiconGer - [helfen_V2V, warnen_V2V, versprechen_dat_V2V, lassen_V2V]
+  , TestLexiconGer
---  , ConstructionGer -- needs SlashV2VNP of VerbGer
+  , ConstructionGer
   ** open ResGer,Prelude,(P=ParadigmsGer) in {
 
   flags startcat = Phr ; unlexer = text ; lexer = text ;
@@ -27,147 +27,222 @@ concrete TestLangGer of TestLang =
     ReflVPSlash v3 = -- reflexive use of v:V3, untested
       (insertObjRefl (predVc v3) ** {c2 = v3.c3}); 
 
-    PassV2 v = -- insertObj (\\_ => v.s ! VPastPart APred) (predV werdenPass) ;
+    PassV2Q v q =
-      let c = case <v.c2.c, v.c2.isPrep> of {
-            <NPC Acc, False> => NPC Nom ; _ => v.c2.c} -- acc object -> nom; all others: same PCase
-      in insertObjc (\\_ => v.s ! VPastPart APred) (predV werdenPass) ** { subjc = v.c2 ** {c = c} } ;
-
-    PassV2Q v q = 
       let c = case <v.c2.c, v.c2.isPrep> of {
             <NPC Acc, False> => NPC Nom ; _ => v.c2.c} ; -- acc;pcase object -> nom;pcase subject
-          vp = insertObjc (\\_ => v.s ! VPastPart APred) (predV werdenPass) 
+          vp = insertObj (\\_ => v.s ! VPastPart APred) (predV werdenPass)
-            ** { subjc = v.c2 ** {c = c} } 
+            ** { c1 = v.c2 ** {c = c} }
       in insertExtrapos (bindComma ++ q.s ! QIndir) vp ;
 
-    PassV2S v s = 
+    PassV2S v s =
       let c = case <v.c2.c, v.c2.isPrep> of {
             <NPC Acc, False> => NPC Nom ; _ => v.c2.c} ; -- acc;pcase object -> nom;pcase subject
-          vp = insertObjc (\\_ => v.s ! VPastPart APred) (predV werdenPass) 
+          vp = insertObj (\\_ => v.s ! VPastPart APred) (predV werdenPass)
-            ** { subjc = v.c2 ** {c = c} } 
+            ** { c1 = v.c2 ** {c = c} }
       in insertExtrapos (bindComma ++ conjThat ++ s.s ! Sub) vp ;
 
     PassV2V v vp = 
-      let c = case <v.c2.c, v.c2.isPrep> of {
+      let
+          inf = mkInf v.isAux Simul Pos vp ;             -- ok for v.isAux=False, v.c2.c=Acc
+          c = case <v.c2.c, v.c2.isPrep> of {            --        v.objCtrl=True   HL 3/22
             <NPC Acc, False> => NPC Nom ; _ => v.c2.c} ; -- acc;pcase object -> nom;pcase subject
-          vp2 = insertObjc (\\_ => v.s ! VPastPart APred) (predV werdenPass) 
+          vp2 = insertObj (\\_ => v.s ! VPastPart APred) (predV werdenPass)
-            ** { subjc = v.c2 ** {c = c} } 
+            ** { c1 = v.c2 ** {c = c} } ;
-      in insertExtrapos (bindComma ++ (useInfVP False vp)) vp2 ; -- misses subject agr for vp = ReflVP vps
+        in insertInf inf vp2 ;                           -- v=lassen needs in-place inf instead
-{-
+
     PassVPSlash vp = 
       let c = case <vp.c2.c,vp.c2.isPrep> of {
-            <NPC Acc, False> => NPC Nom ; _ => vp.c2.c}
+            <NPC Acc, False> => NPC Nom ; _ => vp.c2.c} ;
-      in insertObjc (\\_ => (PastPartAP vp).s ! APred) (predV werdenPass) 
+          ctrl = case vp.objCtrl of { True => False ; _ => True }  -- always False?
-      ** {ext = vp.ext ; subjc = vp.c2 ** {c = c}} ;
+      in -- insertObj (\\_ => (PastPartAP vp).s ! APred) (predV werdenPass ** {c1 = vp.c2 ** {c = c}})
-                -- regulates passivised object: accusative objects -> nom; all others: same case
+          insertObj (\\_ => vp.s.s ! (VPastPart APred))
-		-- this also gives "mit dir wird gerechnet" ;
+                      (predV werdenPass ** {nn = vp.nn ; c1 = vp.c2 ** {c = c}})
-		-- the alternative linearisation ("es wird mit dir gerechnet") is not implemented
+           ** {ext = vp.ext ; inf = vp.inf ; c2 =vp.c2 ; objCtrl = ctrl } ;  -- c2 ?
-       -- HL: does not work for vp = (Slash2V3 v np): uns wird den Beweis erklärt
+       -- Scharolta: passivised object: acc object -> nom subject; all others: same case/prep
-       --                       vp = (SlashV2V v2v reflVP): wir werden gebeten, uns zu fragen , ob S
+       -- HL: does not work for vp = (Slash2V3 v np): uns wird *den Beweis erklärt
+       -- 3/22 works for        vp = (SlashV2V v2v reflVP): wir werden gebeten, uns zu waschen
+
     PastPartAP vp = {
       s = \\af => (vp.nn ! agrP3 Sg).p1 ++ (vp.nn ! agrP3 Sg).p2 ++ 
         (vp.nn ! agrP3 Sg).p3 ++ (vp.nn ! agrP3 Sg).p4 ++ vp.adj ++ vp.a2 
-        ++ vp.inf.s ++ vp.infExt ++ vp.s.s ! VPastPart af ;
+        ++ vp.inf.inpl.p2 ++ vp.s.s ! VPastPart af ;
       isPre = True ;
       c = <[],[]> ;
       adj = [] ;
-      ext = vp.ext 
+      ext = (vp.inf.extr ! agrP3 Sg) ++ vp.ext  -- HL 5/4/2022
       } ;
--}
+
     Pass2V3 v np = -- HL 7/19: making the (active) direct object to the (passive) subject
-      let vps = insertObjc (\\_ => (v.s ! VPastPart APred)) (predV werdenPass)
+      let vps = insertObj (\\_ => (v.s ! VPastPart APred)) (predV werdenPass)
-            ** { subjc = PrepNom ; c2 = v.c3 }
+            ** { c1 = PrepNom ; c2 = v.c3 }
-      in insertObjNP np vps.c2 vps ;
+      in insertObjNP np vps.c2 (vps ** {objCtrl = False});
 
     Pass3V3 v np = -- HL 7/19: making the (active) indirect object to the (passive) subject
       let bekommen : Verb = P.habenV (P.irregV "bekommen" "bekommt" "bekam" "bekäme" "bekommen") ;
-          vps = insertObjc (\\_ => (v.s ! VPastPart APred)) (predV bekommen)
+          vps = insertObj (\\_ => (v.s ! VPastPart APred)) (predV bekommen)
-            ** { subjc = PrepNom ; c2 = v.c2 } 
+            ** { c1 = PrepNom ; c2 = v.c2 }
-      in insertObjNP np vps.c2 vps ;
+      in insertObjNP np vps.c2 (vps ** {objCtrl = False});
 {-      
     Pass2V4 v np = 
       let vps = -- : VPSlashSlash = 
             insertObj (\\_ => (v.s ! VPastPart APred)) (predV werdenPass)
-            ** { subjc = PrepNom ; c2 = v.c3 ; c3 = v.c4 } 
+            ** { c1 = PrepNom ; c2 = v.c3 ; c3 = v.c4 }
       in (insertObjNP np vps.c3 vps) ;
 
     -- Todo: Pass?V2S, Pass?V2Q, PassVS, PassVQ Pass?V2V
 -}
 
-    SlashV2Vneg v vp =   -- versprechen, (\agr => sich!agr es nicht zu merken) 
+    SlashV2Vneg v vp = -- HL 3/22
       let 
-        vps = (predVGen v.isAux v) ** { c2 = v.c2 } ; --; ctrl = v.ctrl } ;
+        vps = (predVGen v.isAux v) ;
-        vpi = infzuVP v.isAux v.ctrl Simul Neg vp ;
+        inf = mkInf v.isAux Simul Neg vp
-        comma = case orB vp.isAux (case vp.inf.ctrl of { NoC => True ; _ => False }) of {True => [] ; _ => bindComma} ;
+       in
-        embeddedInf : Agr => Str = case vp.inf.isAux of {
+        insertExtrapos vp.ext (
-          True  => \\agr => comma ++ (vp.nn!agr).p5 ++ (vp.nn!agr).p6 ++ vpi.inf ;  -- ihn es lesen (zu) lassen
+          insertInf inf vps) ** {c2 = v.c2 ; objCtrl = v.objCtrl} ;
-          False => \\agr => comma ++ (vp.nn!agr).p5 ++ vpi.inf ++ (vp.nn!agr).p6 }  -- ihn (zu) bitten , es zu lesen
-      in 
-      insertExtrapos vpi.ext (
-        insertInf vpi.pred (   
-          insertInfExtraObj vpi.objs (
-            insertInfExtraInf embeddedInf vps))) ;
-
-    lin -- with param Control in ../../src/german/ParadigmsGer.gf
-      helfen_V2V = P.mkV2V (P.irregV "helfen" "hilft" "half" "hälfe" "geholfen") P.datPrep ; 
-      warnen_V2V = P.mkV2V (P.regV "warnen") P.accPrep ;
-      versprechen_dat_V2V = 
-        P.subjV2V (P.mkV2V (P.irregV "versprechen" "verspricht" "versprach" "verspräche" "versprochen") P.datPrep) ;
-      lassen_V2V = P.auxV2V (P.irregV "lassen" "lasst" "ließ" "ließe" "gelassen") P.accPrep ;  -- lasse dich (*zu) arbeiten
 
 -- SlashV2VNP : V2V -> NP -> VPSlash -> VPSlash ; -- beg me to buy
 -- -- (the book) that (she (begged:V2V me:NP (to buy ()):VPSlash):VPSlash):ClSlash
 
--- very expensive:
+-- 3/22 expensive: |NP|=54, |Prep|=|18|, |V2|=180, |V2V|=720, |VP|=360, |VPSlash|=12.290 (!)
--- + SlashV2V 2332800 (6480,40)
+-- i -v -src TestLangGer.gf
--- + SlashV2VNP 2267481600 (4320,270) vs. (1080,90) in VerbGer, 305460 msec
+-- + ComplSlash     699840 (355680,532)
--- Languages: TestLangGer
+-- + SlashV2V       259200   (1440,20)
--- 623657 msec
+-- + SlashV2VNP  503884800  (77760,540)
-{- 
+-- 243273 msec
-    SlashV2VNP v np vp =  
+
-      let
-        vps = (predVGen v.isAux v) ** { c2 = vp.c2 } ; -- objCtrl = 
-        vpi = infzuVP v.isAux v.ctrl Simul Pos vp ;
-        -- comma = case <vp.isAux,vp.inf.ctrl> of { <True,_> => [] ; <_,NoC> => [] ; _ => bindComma} ;
-        embeddedInf : Agr => Str = 
-          \\agr => "[" ++ (vp.nn!agr).p5 ++ (vp.nn!agr).p6 ++ vpi.inf ++ "]";  
-        -- embeddedInf : Agr => Str = case vp.inf.isAux of {
-        --   True  => \\agr => comma ++ (vp.nn!agr).p5 ++ (vp.nn!agr).p6 ++ vpi.inf ;  -- ihn es lesen (zu) lassen
-        --   False => \\agr => comma ++ (vp.nn!agr).p5 ++ vpi.inf ++ (vp.nn!agr).p6 }  -- ihn (zu) bitten , es zu lesen
-      in
-      insertExtrapos vpi.ext (           -- vps.ext   <- vp's object-sentence ++ extractedInfzu?
-        insertInf vpi.pred (             -- vps.inf   <- vp's infinite main verb
-          insertInfExtraObj vpi.objs (   -- vps.nn.p5 <- vp's object nps
-            insertInfExtraInf embeddedInf (
-              insertObjNP np v.c2 vps )))) ;
--}
 {-
 TestLang> p "the book that we beg her to promise him to read" | l
 the book that we beg her to promise him to read
-das Buch , das wir sie bitten , ihn zu versprechen [ [ ] zu lesen ]
+das Buch , das wir sie bitten , ihm zu versprechen , zu lesen
 
 TestLang> p "the book that we beg her to beg him to read" | l
 the book that we beg her to beg him to read
-das Buch , das wir sie bitten , ihn zu bitten [ [ ] zu lesen ]
+das Buch , das wir sie bitten , ihn zu bitten , zu lesen
 
 TestLang: DetCN (DetQuant DefArt NumSg) (RelCN (UseN book_N) (UseRCl (TTAnt TPres ASimul) PPos (RelSlash IdRP (SlashVP (UsePron we_Pron) (SlashV2VNP versprechen_dat_V2V (UsePron she_Pron) (SlashV2a read_V2))))))
 TestLangEng: the book that we promise her to read
-TestLangGer: das Buch , dem wir ihr versprechen , zu lesen   Bug: dem => das
+TestLangGer: das Buch , das wir ihr versprechen , zu lesen
 
 TestLang> p "the book that we beg her to sell to him" | l
 the book that we beg her to sell to him
-das Buch , das wir ihm sie bitten , zu verkaufen
+das Buch , das wir sie bitten , ihm zu verkaufen
-=> das Buch , das wir sie bitten , ihm zu verkaufen
+
+p -lang=Ger "das Kind , auf das wir ihn bitten , zu warten ," | l
+the child that we beg him to wait for
+das Kind , auf das wir ihn bitten , zu warten
+
+pied piping:
 ~~> das Buch , das ihm zu verkaufen wir sie bitten
- ~~ das Buch , an das zu glauben wir sie bitten
+~~> das Kind , auf das zu warten wir ihn bitten
 
 Wrong in gf-3.9 as well:
 Lang> p "the woman that we beg him to listen to" | l
 the woman that we beg him to listen to
-die Frau , die wir ihn zuzuhören bitten  (Bug: die => der)
+die Frau , der wir ihn bitten , zuzuhören
 
 Lang> p "the book that we beg her to sell to him" | l
 the book that we beg her to sell to him
-das Buch , das wir ihn sie zu verkaufen bitten (Bug: ihn sie => sie ihm)
+das Buch, das wir sie bitten, ihm zu verkaufen
-=> das Buch, das wir sie bitten, ihm zu verkaufen
+
+Test reflexive resolution:
+
+gr -tr (PredVP (UsePron ?) (ComplSlash (SlashV2V lassen_V2V (ReflVP (SlashV2a wash_V2))) (UsePron ?))) | l
+
 -}
+
+--  Reimplementation of SlashVP: replace mkClause by mkClSlash to let reflexives agree
+--  with object in relative clauses, if objCtrl = true. To save memory, use
+--  ClauseSlash.s : ... => RelGenNum => Str instead of : ... => Agr => Str.
+-- + SlashVP 699840 gf: out of memory (requested 2097152 bytes) with Agr => Str
+-- + SlashVP 699840 (2880,160) with  RelGenNum => Str; |Agr| = 18, |RelGenNum| = 5.
+-- Todo: replace other uses of ClSlash by ClauseSlash
+
+  lincat
+    ClauseSlash = {
+      s : Mood => ResGer.Tense => Anteriority => Polarity => Order => RelGenNum => Str ;
+      c2 : Preposition
+      } ;
+
+  lin
+    SlashVP np vp =
+      let subj = mkSubj np vp.c1
+      in mkClSlash subj.p1 subj.p2 vp ** { c2 = vp.c2 } ;
+
+    RelSlash rp cls = lin RCl {
+      s = \\m,t,a,p,gn =>
+          appPrep cls.c2 (\\k => usePrepC k (\c -> rp.s ! gn ! c)) ++
+          cls.s ! m ! t ! a ! p ! Sub ! gn ;
+      c = (prepC cls.c2.c).c
+      } ;
+{-
+    QuestSlash ip slash = {
+      s = \\m,t,a,p => 
+            let 
+              cls = slash.s ! m ! t ! a ! p ;
+              who = appPrep slash.c2 (\\k => usePrepC k (\c -> ip.s ! c)) ;
+            in table {
+              QDir   => who ++ cls ! Inv ;
+              QIndir => who ++ cls ! Sub
+              }
+      } ;
+-}
+
+
+  oper
+    gnToAgr : RelGenNum -> Agr = \gn ->
+       case gn of {RGenNum (GSg g) => Ag g Sg P3 ;
+                   RGenNum GPl     => Ag Neutr Pl P3 ;
+                   RSentence       => Ag Neutr Sg P3} ;
+
+
+    mkClSlash : Str -> Agr -> ResGer.VPSlash -> ClauseSlash = \subj,agr,vp ->
+    let vps = useVP vp in lin ClauseSlash {
+      c2 = vp.c2 ;
+      s = \\m,t,a,b,o,gn =>
+        let
+          ord   = case o of {
+            Sub => True ;  -- glue prefix to verb
+            _ => False
+            } ;
+          verb  = vps.s  ! ord ! agr ! VPFinite m t a ;
+          haben = verb.inf2 ;
+          neg = negation ! b ;
+          ag : Agr = case vp.objCtrl of {True => gnToAgr gn ; _ => agr} ;
+          obj1  = (vp.nn ! ag).p1 ++ (vp.nn ! ag).p2 ; -- refl ++ pronouns ++ light nps
+          obj2  = (vp.nn ! ag).p3 ;                    -- pp-objects and heavy nps
+          obj3  = (vp.nn ! ag).p4 ++ vp.adj ++ vp.a2 ; -- pred.AP|CN|Adv, via useComp HL 6/2019
+          compl : Str = obj1 ++ obj2 ++ neg ++ obj3 ;
+          infObjs = (vp.inf.inpl.p1) ! ag ;
+          infPred = vp.inf.inpl.p2 ;
+          infCompl : Str = case <t,a,vp.isAux> of {
+                 <Fut|Cond,Anter,True> => [] ;  _ => infObjs ++ infPred } ;
+          pred : {inf, infComplfin : Str} = case <t,a,vp.isAux> of {
+             <Fut|Cond,Anter,True>  =>                                    --# notpresent
+               {inf    = infObjs ++ haben ++ infPred ++ verb.inf ;        --# notpresent Duden 318
+                infComplfin = -- es ++ wird ++ haben ++ tun ++ wollen     --# notpresent
+                   infObjs ++ verb.fin ++ haben ++ infPred ++ verb.inf} ; --# notpresent
+             <_,Anter,True> =>                                            --# notpresent
+               {inf    = verb.inf ++ haben ;                              --# notpresent
+                infComplfin = -- es ++ wird/hat/hatte ++ tun ++ wollen    --# notpresent
+                   infObjs ++ verb.fin ++ infPred ++ verb.inf ++ haben} ; --# notpresent
+              <Pres,_,_> =>
+               {inf    = verb.inf ++ haben ;
+                infComplfin = -- es zu tun ++ [] ++ [] ++ versucht
+                   infCompl ++ verb.inf ++ haben ++ verb.fin}
+                                                                         ; --# notpresent
+              _ =>                                                         --# notpresent
+               {inf    = verb.inf ++ haben ;                               --# notpresent
+                infComplfin = -- es zu tun ++ versucht ++ [] ++ hat        --# notpresent
+                              infCompl ++ verb.inf ++ haben ++ verb.fin}   --# notpresent
+              } ;
+          extra : Str = (vp.inf.extr) ! ag ++ vp.ext ;
+        in
+        case o of {
+	  Main => subj ++ verb.fin ++ compl ++ infCompl ++ pred.inf ++ extra ;
+	  Inv  => verb.fin ++ subj ++ compl ++ infCompl ++ pred.inf ++ extra ;
+	  Subj =>             subj ++ compl ++   pred.infComplfin   ++ extra
+        }
+    } ;
+
 }
+

tests/german/TestLexiconGer.gf

@@ -23,8 +23,8 @@ oper
          \v,p2,p3,p4 -> lin V4 (v ** { c2=p2 ; c3=p3 ; c4=p4 }) ;
   dirV4 : V -> Prep -> Prep -> V4 = \v,c,d -> mkV4 v accPrep c d ;
   -- control verbs
-  dirV2V : V -> V2V = \v -> mkV2V v ; 
+  dirV2V : V -> V2V = \v -> mkV2V v ; -- object control verb;
-
+                                      -- subjV2V v2v = subject-control verb
 lin
   aendern_rV = reflV (regV "ändern") accusative ;
   anstrengen_rV = reflV (prefixV "an" (regV "strengen")) accusative ;
@@ -37,29 +37,37 @@ lin
 
   erklaeren_dat_V3 = mkV3 (irregV "erklären" "erklärt" "erklärte" "erklärte" "erklärt") ;
   anklagen_gen_V3 = dirV3 (prefixV "an" (regV "klagen")) genPrep ;
-  erinnern_an_V3 = dirV3 (irregV "erinnern" "erinnert" "erinnerte" "erinnerte" "erinnert") (mkPrep "an" accusative) ; 
+  erinnern_an_V3 = dirV3 (irregV "erinnern" "erinnert" "erinnerte"
+                                 "erinnerte" "erinnert") (mkPrep "an" accusative) ;
   danken_dat_fuer_V3 = mkV3 (regV "danken") datPrep (mkPrep "für" accusative) ;
-  debattieren_mit_ueber_V3 = mkV3 (irregV "debattieren" "debattiert" "debattierte" "debattierte" "debattiert") mit_Prep (mkPrep "über" accusative) ;
+  debattieren_mit_ueber_V3 = mkV3 (irregV "debattieren" "debattiert" "debattierte"
+                                          "debattierte" "debattiert") mit_Prep (mkPrep "über" accusative) ;
   lehren_V3 = dirV3 (regV "lehren") accPrep ;
 
-  abschauen_bei_rV3 = reflV3 (prefixV "ab" (irregV "schauen" "schaut" "schaute" "schaute" "geschaut")) dative accPrep bei_Prep ;
+  abschauen_bei_rV3 = reflV3 (prefixV "ab" (irregV "schauen" "schaut"
+                                                   "schaute" "schaute" "geschaut")) dative accPrep bei_Prep ;
   leihen_von_rV3 = reflV3 (irregV "leihen" "leiht" "lieh" "liehe" "geliehen") dative accPrep von_Prep ;
 
-  entschuldigen_bei_fuer_rV3 = 
+  entschuldigen_bei_fuer_rV3 = reflV3 (irregV "entschuldigen" "entschuldigt" "entschuldigte"
-    reflV3 (irregV "entschuldigen" "entschuldigt" "entschuldigte" "entschuldigte" "entschuldigt") accusative bei_Prep fuer_Prep ;
+                                              "entschuldigte" "entschuldigt") accusative bei_Prep fuer_Prep ;
   raechen_am_fuer_rV3 = reflV3 (regV "rächen") accusative (mkPrep "an" dative) fuer_Prep ;
 
   kaufen_bei_fuer_V4 = dirV4 (regV "kaufen") bei_Prep fuer_Prep ;
   mieten_von_fuer_V4 = dirV4 (regV "mieten") von_Prep fuer_Prep ;
 
   neugierig_auf_A2 = mkA2 (mk3A "neugierig" "neugieriger" "neugierigste") (mkPrep "auf" accusative) ;
-
+  
+  -- verbs with infinitival object (non-modal):
   wagen_VV = mkVV (regV "wagen")  ;
   versuchen_VV = mkVV (irregV "versuchen" "versucht" "versuchte" "versuchte" "versucht") ;
 
+  -- object control verbs:
   helfen_V2V = mkV2V (irregV "helfen" "hilft" "half" "hälfe" "geholfen") datPrep ; 
   warnen_V2V = dirV2V (regV "warnen")  ;
---  versprechen_dat_V2V = subjV2V (mkV2V (irregV "versprechen" "verspricht" "versprach" "verspräche" "versprochen") datPrep) ;
+  lassen_V2V = auxV2V (irregV "lassen" "läßt" "ließ" "ließe" "gelassen") accPrep ;
-  lassen_V2V = auxV2V (irregV "lassen" "lasst" "ließ" "ließe" "gelassen") accPrep ;  -- lasse dich (*zu) arbeiten
+                                            -- lasse dich (*zu) arbeiten
+  -- subject control verb:
+  versprechen_dat_V2V = subjV2V (mkV2V (irregV "versprechen" "verspricht"
+                                               "versprach" "verspräche" "versprochen") datPrep) ;
 
 }

tests/german/infinitives.lin.out

@@ -53,7 +53,7 @@ TestLang: PredVP (UsePron i_Pron) (ComplSlash (SlashVV want_VV (SlashV2a read_V2
 TestLangGer: ich will das Buch lesen
 TestLangEng: I want to read the book
 TestLang: PredVP (UsePron i_Pron) (ComplSlash (SlashVV wagen_VV (SlashV2a read_V2)) (DetCN (DetQuant DefArt NumSg) (UseN book_N)))
-TestLangGer: ich wage das Buch , zu lesen -- wrong
+TestLangGer: ich wage das Buch zu lesen
 TestLangEng: I dare to read the book
 TestLang: PredVP (UsePron i_Pron) (ComplVV must_VV (ComplSlash (SlashV2a read_V2) (DetCN (DetQuant DefArt NumSg) (UseN book_N))))
 TestLangGer: ich muss das Buch lesen
@@ -68,22 +68,22 @@ TestLang: PredVP (UsePron i_Pron) (ComplSlash (SlashVV must_VV (SlashVV want_VV
 TestLangGer: ich muss das Buch lesen wollen
 TestLangEng: I must want to read the book
 TestLang: PredVP (UsePron i_Pron) (ComplSlash (SlashVV must_VV (SlashVV wagen_VV (SlashV2a read_V2))) (DetCN (DetQuant DefArt NumSg) (UseN book_N)))
-TestLangGer: ich muss das Buch wagen , zu lesen -- wrong
+TestLangGer: ich muss das Buch zu lesen wagen
 TestLangEng: I must dare to read the book
 TestLang: PredVP (UsePron i_Pron) (ComplSlash (SlashVV want_VV (SlashVV wagen_VV (SlashV2a read_V2))) (DetCN (DetQuant DefArt NumSg) (UseN book_N)))
-TestLangGer: ich will das Buch wagen , zu lesen -- wrong
+TestLangGer: ich will das Buch zu lesen wagen
 TestLangEng: I want to dare to read the book
 TestLang: PredVP (UsePron i_Pron) (ComplSlash (SlashVV wagen_VV (SlashVV want_VV (SlashV2a read_V2))) (DetCN (DetQuant DefArt NumSg) (UseN book_N)))
-TestLangGer: ich wage das Buch , lesen zu wollen -- wrong
+TestLangGer: ich wage das Buch lesen zu wollen
 TestLangEng: I dare to want to read the book
 TestLang: PredVP (UsePron i_Pron) (ComplVV must_VV (ComplSlash (SlashVV want_VV (SlashV2a read_V2)) (DetCN (DetQuant DefArt NumSg) (UseN book_N))))
 TestLangGer: ich muss das Buch lesen wollen
 TestLangEng: I must want to read the book
 TestLang: PredVP (UsePron i_Pron) (ComplVV must_VV (ComplSlash (SlashVV wagen_VV (SlashV2a read_V2)) (DetCN (DetQuant DefArt NumSg) (UseN book_N))))
-TestLangGer: ich muss das Buch wagen , zu lesen -- wrong
+TestLangGer: ich muss das Buch wagen zu lesen -- wrong
 TestLangEng: I must dare to read the book
 TestLang: PredVP (UsePron i_Pron) (ComplVV want_VV (ComplSlash (SlashVV wagen_VV (SlashV2a read_V2)) (DetCN (DetQuant DefArt NumSg) (UseN book_N))))
-TestLangGer: ich will das Buch wagen , zu lesen -- wrong
+TestLangGer: ich will das Buch wagen zu lesen -- wrong
 TestLangEng: I want to dare to read the book
 TestLang: PredVP (UsePron i_Pron) (ComplVV wagen_VV (ComplSlash (SlashVV want_VV (SlashV2a read_V2)) (DetCN (DetQuant DefArt NumSg) (UseN book_N))))
 TestLangGer: ich wage , das Buch lesen zu wollen
@@ -101,22 +101,22 @@ TestLang: PredVP (UsePron i_Pron) (ComplVV wagen_VV (ComplVV want_VV (ComplSlash
 TestLangGer: ich wage , das Buch lesen zu wollen
 TestLangEng: I dare to want to read the book
 TestLang: PredVP (UsePron i_Pron) (ComplVV must_VV (ComplSlash (SlashVV want_VV (SlashVV wagen_VV (SlashV2a read_V2))) (DetCN (DetQuant DefArt NumSg) (UseN book_N))))
-TestLangGer: ich muss das Buch wagen wollen , zu lesen -- wrong
+TestLangGer: ich muss das Buch zu lesen wagen wollen
 TestLangEng: I must want to dare to read the book
 TestLang: PredVP (UsePron i_Pron) (ComplVV must_VV (ComplVV want_VV (ComplSlash (SlashVV wagen_VV (SlashV2a read_V2)) (DetCN (DetQuant DefArt NumSg) (UseN book_N)))))
-TestLangGer: ich muss das Buch wagen wollen , zu lesen -- wrong
+TestLangGer: ich muss das Buch wagen wollen zu lesen -- wrong
 TestLangEng: I must want to dare to read the book
 TestLang: PredVP (UsePron i_Pron) (ComplVV must_VV (ComplVV want_VV (ComplVV wagen_VV (ComplSlash (SlashV2a read_V2) (DetCN (DetQuant DefArt NumSg) (UseN book_N))))))
 TestLangGer: ich muss wagen wollen , das Buch zu lesen
 TestLangEng: I must want to dare to read the book
 TestLang: PredVP (UsePron i_Pron) (ComplSlash (SlashVV must_VV (SlashVV wagen_VV (SlashVV want_VV (SlashV2a read_V2)))) (DetCN (DetQuant DefArt NumSg) (UseN book_N)))
-TestLangGer: ich muss das Buch wagen , lesen zu wollen -- wrong
+TestLangGer: ich muss das Buch wagen lesen zu wollen -- wrong
 TestLangEng: I must dare to want to read the book
 TestLang: PredVP (UsePron i_Pron) (ComplSlash (SlashVV must_VV (SlashVV want_VV (SlashVV wagen_VV (SlashV2a read_V2)))) (DetCN (DetQuant DefArt NumSg) (UseN book_N)))
-TestLangGer: ich muss das Buch wagen , zu lesen wollen -- wrong
+TestLangGer: ich muss das Buch zu lesen wagen wollen
 TestLangEng: I must want to dare to read the book
 TestLang: PredVP (UsePron i_Pron) (ComplVV must_VV (ComplSlash (SlashVV wagen_VV (SlashVV want_VV (SlashV2a read_V2))) (DetCN (DetQuant DefArt NumSg) (UseN book_N))))
-TestLangGer: ich muss das Buch wagen , lesen zu wollen -- wrong
+TestLangGer: ich muss das Buch wagen lesen zu wollen -- wrong
 TestLangEng: I must dare to want to read the book
 TestLang: PredVP (UsePron i_Pron) (ComplVV must_VV (ComplVV wagen_VV (ComplSlash (SlashVV want_VV (SlashV2a read_V2)) (DetCN (DetQuant DefArt NumSg) (UseN book_N)))))
 TestLangGer: ich muss wagen , das Buch lesen zu wollen
@@ -149,43 +149,43 @@ TestLang: PredVP (UsePron i_Pron) (ComplSlash (SlashV2V beg_V2V (ComplSlash (Sla
 TestLangGer: ich bitte ihn , ihm zu versprechen , das Buch zu lesen
 TestLangEng: I beg him to promise him to read the book
 TestLang: PredVP (UsePron i_Pron) (ComplSlash (SlashV2VNP lassen_V2V (UsePron he_Pron) (SlashV2a read_V2)) (DetCN (DetQuant DefArt NumSg) (UseN book_N)))
-TestLangGer: ich lasse das Buch ihn lesen -- wrong object order (3.9 SlashV2VNP)
+TestLangGer: ich lasse ihn das Buch lesen
 TestLangEng: I let him read the book
 TestLang: PredVP (UsePron i_Pron) (ComplSlash (SlashV2VNP beg_V2V (UsePron he_Pron) (SlashV2a read_V2)) (DetCN (DetQuant DefArt NumSg) (UseN book_N)))
-TestLangGer: ich bitte das Buch ihn , zu lesen -- wrong (SlashV2VNP)
+TestLangGer: ich bitte ihn das Buch , zu lesen -- wrong (SlashV2VNP)
 TestLangEng: I beg him to read the book
 TestLang: PredVP (UsePron i_Pron) (ComplSlash (SlashV2VNP versprechen_dat_V2V (UsePron he_Pron) (SlashV2a read_V2)) (DetCN (DetQuant DefArt NumSg) (UseN book_N)))
-TestLangGer: ich verspreche das Buch ihm , zu lesen -- wrong (SlashV2VNP)
+TestLangGer: ich verspreche ihm das Buch , zu lesen -- wrong (SlashV2VNP)
 TestLangEng: I promise him to read the book
 TestLang: PredVP (UsePron i_Pron) (ComplSlash (SlashV2VNP beg_V2V (DetNP (DetQuant DefArt NumPl)) (SlashV2VNP lassen_V2V (UsePron he_Pron) (SlashV2a read_V2))) (DetCN (DetQuant DefArt NumSg) (UseN book_N)))
-TestLangGer: ich bitte das Buch ihn die , zu lassen lesen -- wrong (SlahV2VNP) bitte die, ihn es lesen zu lassen
+TestLangGer: ich bitte die das Buch , ihn lesen zu lassen -- wrong (SlahV2VNP) 
 TestLangEng: I beg them to let him read the book
 TestLang: PredVP (UsePron i_Pron) (ComplSlash (SlashV2VNP beg_V2V (UsePron they_Pron) (SlashV2VNP lassen_V2V (UsePron he_Pron) (SlashV2a read_V2))) (DetCN (DetQuant DefArt NumSg) (UseN book_N)))
-TestLangGer: ich bitte das Buch ihn sie , zu lassen lesen -- wrong (SlashV2VNP)
+TestLangGer: ich bitte sie das Buch , ihn lesen zu lassen -- wrong (SlashV2VNP)
 TestLangEng: I beg them to let him read the book
 TestLang: PredVP (UsePron i_Pron) (ComplSlash (SlashV2V beg_V2V (ComplSlash (SlashV2VNP lassen_V2V (UsePron he_Pron) (SlashV2a read_V2)) (DetCN (DetQuant DefArt NumSg) (UseN book_N)))) (DetNP (DetQuant DefArt NumPl)))
-TestLangGer: ich bitte die , das Buch ihn lesen zu lassen -- wrong obj order
+TestLangGer: ich bitte die , ihn das Buch lesen zu lassen
 TestLangEng: I beg them to let him read the book
 TestLang: PredVP (UsePron i_Pron) (ComplSlash (SlashV2V beg_V2V (ComplSlash (SlashV2VNP lassen_V2V (UsePron he_Pron) (SlashV2a read_V2)) (DetCN (DetQuant DefArt NumSg) (UseN book_N)))) (UsePron they_Pron))
-TestLangGer: ich bitte sie , das Buch ihn lesen zu lassen -- wrong obj order
+TestLangGer: ich bitte sie , ihn das Buch lesen zu lassen
 TestLangEng: I beg them to let him read the book
 TestLang: PredVP (UsePron i_Pron) (ComplSlash (SlashV2VNP versprechen_dat_V2V (DetNP (DetQuant DefArt NumPl)) (SlashV2VNP beg_V2V (UsePron he_Pron) (SlashV2a read_V2))) (DetCN (DetQuant DefArt NumSg) (UseN book_N)))
-TestLangGer: ich verspreche das Buch ihn denen , zu bitten zu lesen -- wrong (SlashV2VNP gf-3.9))
+TestLangGer: ich verspreche denen das Buch , ihn zu bitten , zu lesen -- wrong (SlashV2VNP))
 TestLangEng: I promise them to beg him to read the book
 TestLang: PredVP (UsePron i_Pron) (ComplSlash (SlashV2VNP versprechen_dat_V2V (UsePron they_Pron) (SlashV2VNP beg_V2V (UsePron he_Pron) (SlashV2a read_V2))) (DetCN (DetQuant DefArt NumSg) (UseN book_N)))
-TestLangGer: ich verspreche das Buch ihn ihnen , zu bitten zu lesen -- wrong (SlashV2VNP)
+TestLangGer: ich verspreche ihnen das Buch , ihn zu bitten , zu lesen -- wrong (SlashV2VNP)
 TestLangEng: I promise them to beg him to read the book
 TestLang: PredVP (UsePron i_Pron) (ComplSlash (SlashV2V versprechen_dat_V2V (ComplSlash (SlashV2VNP beg_V2V (UsePron he_Pron) (SlashV2a read_V2)) (DetCN (DetQuant DefArt NumSg) (UseN book_N)))) (DetNP (DetQuant DefArt NumPl)))
-TestLangGer: ich verspreche denen , das Buch ihn zu bitten , zu lesen -- wrong obj order
+TestLangGer: ich verspreche denen , ihn das Buch zu bitten , zu lesen
 TestLangEng: I promise them to beg him to read the book
 TestLang: PredVP (UsePron i_Pron) (ComplSlash (SlashV2V versprechen_dat_V2V (ComplSlash (SlashV2VNP beg_V2V (UsePron he_Pron) (SlashV2a read_V2)) (DetCN (DetQuant DefArt NumSg) (UseN book_N)))) (UsePron they_Pron))
-TestLangGer: ich verspreche ihnen , das Buch ihn zu bitten , zu lesen -- wrong obj order
+TestLangGer: ich verspreche ihnen , ihn das Buch zu bitten , zu lesen -- wrong
 TestLangEng: I promise them to beg him to read the book
 TestLang: PredVP (UsePron i_Pron) (ComplSlash (SlashV2VNP beg_V2V (UsePron he_Pron) (SlashV2VNP versprechen_dat_V2V (UsePron he_Pron) (SlashV2a read_V2))) (DetCN (DetQuant DefArt NumSg) (UseN book_N)))
-TestLangGer: ich bitte das Buch ihm ihn , zu versprechen zu lesen -- wrong (SlashV2VNP)
+TestLangGer: ich bitte ihn das Buch , ihm zu versprechen , zu lesen -- wrong (SlashV2VNP)
 TestLangEng: I beg him to promise him to read the book
 TestLang: PredVP (UsePron i_Pron) (ComplSlash (SlashV2V beg_V2V (ComplSlash (SlashV2VNP versprechen_dat_V2V (UsePron he_Pron) (SlashV2a read_V2)) (DetCN (DetQuant DefArt NumSg) (UseN book_N)))) (UsePron he_Pron))
-TestLangGer: ich bitte ihn , das Buch ihm zu versprechen , zu lesen -- wrong (SlashV2VNP)
+TestLangGer: ich bitte ihn , ihm das Buch zu versprechen , zu lesen -- wrong (SlashV2VNP)
 TestLangEng: I beg him to promise him to read the book
 TestLang: PredVP (UsePron i_Pron) (ComplSlash (SlashV2V beg_V2V (ReflVP (SlashV2a love_V2))) (UsePron youSg_Pron))
 TestLangGer: ich bitte dich , dich zu lieben
@@ -200,7 +200,7 @@ TestLang: PredVP (UsePron i_Pron) (ComplSlash (SlashV2V versprechen_dat_V2V (Com
 TestLangGer: ich verspreche ihr , mich lieben zu wollen
 TestLangEng: I promise her to want to love herself -- wrong: myself
 TestLang: PredVP (UsePron i_Pron) (ComplVV want_VV (ComplSlash (SlashV2V beg_V2V (ComplSlash (SlashV2Vneg versprechen_dat_V2V (ReflVP (SlashV2a hate_V2))) (UsePron youSg_Pron))) (UsePron she_Pron)))
-TestLangGer: ich will sie bitten , dir zu versprechen , sich nicht zu hassen
+TestLangGer: ich will sie bitten , dir zu versprechen , sich nicht zu hassen   (uses SlashV2Vneg)
 TestLangEng: I want to beg her to promise you not to hate yourself -- wrong: herself
 TestLang: PredVP (UsePron i_Pron) (ComplSlash (SlashV2V versprechen_dat_V2V (ComplSlash (ReflVPSlash entschuldigen_bei_fuer_rV3) (UsePron it_Pron))) (UsePron she_Pron))
 TestLangGer: ich verspreche ihr , mich bei mir für es zu entschuldigen
@@ -209,7 +209,7 @@ TestLang: PredVP (UsePron i_Pron) (ComplSlash (SlashV2V versprechen_dat_V2V (Com
 TestLangGer: ich verspreche uns , es mir zu geben
 TestLangEng: I promise us to give it itself -- wrong: myself
 TestLang: PredVP (UsePron i_Pron) (ComplVV want_VV (ComplSlash (SlashV2V versprechen_dat_V2V (ComplSlash (SlashV2Vneg beg_V2V (ReflVP (SlashV2a hate_V2))) (UsePron youSg_Pron))) (UsePron she_Pron)))
-TestLangGer: ich will ihr versprechen , dich zu bitten , dich nicht zu hassen
+TestLangGer: ich will ihr versprechen , dich zu bitten , dich nicht zu hassen  -- SlashV2Vneg
 TestLangEng: I want to promise her to beg you to not hate yourself
 TestLang: PredVP (UsePron i_Pron) (ComplSlash (SlashV2V beg_V2V (ComplSlash (ReflVPSlash entschuldigen_bei_fuer_rV3) (UsePron it_Pron))) (UsePron youSg_Pron))
 TestLangGer: ich bitte dich , dich bei dir für es zu entschuldigen
@@ -227,7 +227,7 @@ TestLang: DetCN (DetQuant DefArt NumSg) (RelCN (UseN book_N) (UseRCl (TTAnt TPas
 TestLangGer: das Buch , das wir nicht lesen mussten
 TestLangEng: the book that we hadn't to read
 TestLang: DetCN (DetQuant DefArt NumSg) (RelCN (UseN book_N) (UseRCl (TTAnt TPast ASimul) PNeg (RelSlash IdRP (SlashVP (UsePron we_Pron) (SlashVV wagen_VV (SlashV2a read_V2))))))
-TestLangGer: das Buch , das wir nicht wagten , zu lesen
+TestLangGer: das Buch , das wir nicht zu lesen wagten
 TestLangEng: the book that we didn't dare to read
 TestLang: DetCN (DetQuant DefArt NumSg) (RelCN (UseN book_N) (UseRCl (TTAnt TPast ASimul) PNeg (RelSlash IdRP (SlashVP (UsePron we_Pron) (SlashVV wagen_VV (Slash3V3 erklaeren_dat_V3 (UsePron she_Pron)))))))
 TestLangGer: das Buch , das wir nicht wagten , ihr zu erklären

tests/german/vp-paradigm.gfs

@@ -1,7 +1,7 @@
 -- To create vp-paradigm.out, I used changes of 30/6/2019 (in git branch vp-paradigm):
--- i ../../src/german/LangGer.gf  
+i ../../src/german/LangGer.gf
 -- Use gf --run < vp-paradigm.gfs > vp-paradigm.tmp to compare with gf-rgl.  HL 3/7/2019
-i alltenses/LangGer.gfo
+-- i alltenses/LangGer.gfo
   
 -- verb phrases with modal verb
 l -lang=Ger -table (PredVP (UsePron he_Pron) (ComplVV want_VV (UseV sleep_V)))
@@ -19,3 +19,7 @@ l -table (PredVP (DetCN (DetQuant DefArt NumSg) (UseN book_N)) (PassV2 read_V2))
 l PhrUtt NoPConj (UttS (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePron i_Pron) (ComplSlash (Slash3V3 send_V3 (DetCN (DetQuant DefArt NumSg) (UseN woman_N))) (DetCN (DetQuant DefArt NumSg) (UseN book_N)))))) NoVoc
 
 l PhrUtt NoPConj (UttS (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePron i_Pron) (ComplSlash (Slash3V3 send_V3 (UsePron she_Pron)) (UsePron it_Pron))))) NoVoc
+
+-- relative clause from object np is not extracted behind vpart:
+l UseCl (TTAnt TPast AAnter) PNeg (PredVP (UsePron i_Pron) (ComplSlash (SlashV2a know_V2) (DetCN (DetQuant DefArt NumSg) (RelCN (UseN book_N) (UseRCl (TTAnt TPast AAnter) PPos (RelSlash IdRP (SlashVP (UsePron youPl_Pron) (SlashV2VNP beg_V2V (UsePron we_Pron) (AdvVPSlash (SlashV2a read_V2) today_Adv)))))))))
+