stemming in Fin also for verbs now

lib/src/finnish/stemmed/ParadigmsFin.gf

@@ -302,7 +302,7 @@ oper
 ----  mk1A : Str -> A = \jalo -> aForms2A (nforms2aforms (nForms1 jalo)) ;
 ----  mkNA : N -> A = snoun2sadj ; 
 
-  mk1N : (talo : Str) -> N = \s -> nforms2snoun (nForms1 s) ;
+  mk1N : (talo : Str) -> N = \s -> lin N (nforms2snoun (nForms1 s)) ;
   mk2N : (talo,talon : Str) -> N = \s,t -> nforms2snoun (nForms2 s t) ;
   mk3N : (talo,talon,taloja : Str) -> N = \s,t,u -> nforms2snoun (nForms3 s t u) ;
   mk4N : (talo,talon,taloa,taloja : Str) -> N = \s,t,u,v -> 
@@ -537,21 +537,21 @@ oper
     mkV : (
       huutaa,huudan,huutaa,huutavat,huutakaa,huudetaan,
       huusin,huusi,huusisi,huutanut,huudettu,huutanee : Str) -> V = mk12V ;
-    mkV : (sana : VK) -> V = \w -> vforms2V w.s ** {sc = NPCase Nom ; lock_V = <> ; p = []} ;
+    mkV : (sana : VK) -> V = \w -> vforms2sverb w.s ** {sc = NPCase Nom ; lock_V = <> ; p = []} ;
-    mkV : V -> Str -> V = \w,p -> vforms2V w.s ** {sc = NPCase Nom ; lock_V = <> ; p = p} ;
+    mkV : V -> Str -> V = \w,p -> vforms2sverb w.s ** {sc = NPCase Nom ; lock_V = <> ; p = p} ;
   } ;
 
   mk1V : Str -> V = \s -> 
-    let vfs = vforms2V (vForms1 s) in 
+    let vfs = vforms2sverb (vForms1 s) in 
       vfs ** {sc = NPCase Nom ; lock_V = <> ; p = []} ;
   mk2V : (_,_ : Str) -> V = \x,y -> 
-    let vfs = vforms2V (vForms2 x y) in vfs ** {sc = NPCase Nom ; lock_V = <> ; p = []} ;
+    let vfs = vforms2sverb (vForms2 x y) in vfs ** {sc = NPCase Nom ; lock_V = <> ; p = []} ;
   mk3V : (huutaa,huudan,huusi : Str) -> V = \x,_,y -> mk2V x y ; ----
   mk12V : (
       huutaa,huudan,huutaa,huutavat,huutakaa,huudetaan,
       huusin,huusi,huusisi,huutanut,huudettu,huutanee : Str) -> V = 
      \a,b,c,d,e,f,g,h,i,j,k,l -> 
-        vforms2V (vForms12 a b c d e f g h i j k l) ** {sc = NPCase Nom ; lock_V = <> ; p = []} ;
+        vforms2sverb (vForms12 a b c d e f g h i j k l) ** {sc = NPCase Nom ; lock_V = <> ; p = []} ;
 
   vForms1 : Str -> VForms = \ottaa ->
     let
@@ -614,9 +614,11 @@ oper
 
 
 
-  caseV c v = {s = v.s ; sc = NPCase c ; qp = v.qp ; lock_V = <> ; p = v.p} ;
+  caseV c v = {s = v.s ; sc = NPCase c ; h = v.h ; lock_V = <> ; p = v.p} ;
 
-  vOlla = verbOlla ** {sc = NPCase Nom ; qp = True ; lock_V = <> ; p = []} ; ---- lieneekö
+  vOlla = {
+    s = table VForm ["olla";"ole";"on";"o";"olk";"olla";"oli";"oli";"olisi";"oll";"oltu";"ollu";"liene"] ;
+    sc = NPCase Nom ; h = Back ; lock_V = <> ; p = []} ; ---- lieneekö
 
   mk2V2 : V -> Prep -> V2 = \v,c -> v ** {c2 = c ; lock_V2 = <>} ;
   caseV2 : V -> Case -> V2 = \v,c -> mk2V2 v (casePrep c) ; 
@@ -632,7 +634,7 @@ oper
     mkV2 : V -> V2 = dirV2 ;
     mkV2 : V -> Case -> V2 = caseV2 ;
     mkV2 : V -> Prep -> V2 = mk2V2 ;
-    mkV2 : VK -> V2 = \w -> dirV2 (vforms2V w.s ** {sc = NPCase Nom ; lock_V = <> ; p = []}) ;
+    mkV2 : VK -> V2 = \w -> dirV2 (vforms2sverb w.s ** {sc = NPCase Nom ; lock_V = <> ; p = []}) ;
     } ;
 
   mk2V2 : V -> Prep -> V2 ;

lib/src/finnish/stemmed/SentenceFin.gf

@@ -0,0 +1,67 @@
+concrete SentenceFin of Sentence = CatFin ** open Prelude, ResFin, StemFin in {
+
+  flags optimize=all_subs ;
+
+  lin
+
+    PredVP np vp = mkClausePol (orB np.isNeg vp.isNeg) (subjForm np vp.sc) np.a vp ;
+
+    PredSCVP sc vp = mkClause (\_ -> sc.s) (agrP3 Sg) vp ;
+
+    ImpVP vp = {
+      s = \\pol,agr => 
+        let 
+          verb  = vp.s ! VIImper ! Simul ! pol ! agr ;
+          compl = vp.s2 ! False ! pol ! agr ++ vp.ext  --- False = like inf (osta auto)
+        in
+        verb.fin ++ verb.inf ++ compl ;
+    } ;
+
+-- The object case is formed at the use site of $c2$, in $Relative$ and $Question$.
+
+    SlashVP np vp = { 
+      s = \\t,a,p => (mkClause (subjForm np vp.sc) np.a vp).s ! t ! a ! p ! SDecl ;
+      c2 = vp.c2
+      } ;
+
+    AdvSlash slash adv = {
+      s  = \\t,a,b => slash.s ! t ! a ! b ++ adv.s ;
+      c2 = slash.c2
+      } ;
+
+    SlashPrep cl prep = {
+      s = \\t,a,p => cl.s ! t ! a ! p ! SDecl ; 
+      c2 = prep
+      } ;
+
+    SlashVS np vs slash = { 
+      s = \\t,a,p => 
+        (mkClause (subjForm np vs.sc) np.a 
+          (insertExtrapos ("että" ++ slash.s) 
+             (predSV vs))
+        ).s ! t ! a ! p ! SDecl ;
+      c2 = slash.c2
+      } ;
+
+
+    EmbedS  s  = {s = etta_Conj ++ s.s} ;
+    EmbedQS qs = {s = qs.s} ;
+    EmbedVP vp = {s = infVP (NPCase Nom) Pos (agrP3 Sg) vp Inf1} ; --- case,pol,agr,infform
+
+    UseCl  t p cl = {s = t.s ++ p.s ++ cl.s ! t.t ! t.a ! p.p ! SDecl} ;
+    UseQCl t p cl = {s = t.s ++ p.s ++ cl.s ! t.t ! t.a ! p.p} ;
+    UseRCl t p cl = {
+      s = \\r => t.s ++ p.s ++ cl.s ! t.t ! t.a ! p.p ! r ;
+      c = cl.c
+      } ;
+    UseSlash t p cl = {
+      s = t.s ++ p.s ++ cl.s ! t.t ! t.a ! p.p ;
+      c2 = cl.c2
+    } ;
+
+    AdvS a s = {s = a.s ++ s.s} ;
+    ExtAdvS a s = {s = a.s ++ "," ++ s.s} ;
+
+    RelS s r = {s = s.s ++ "," ++ r.s ! agrP3 Sg} ; ---- mikä
+
+}

lib/src/finnish/stemmed/StemFin.gf

@@ -126,4 +126,156 @@ oper
        } ;
 
 
+-- verbs
+
+oper
+  SVForm : Type = Predef.Ints 12 ;
+  SVerb : Type = {s : SVForm => Str ; h : Harmony} ;
+
+  -- used in Cat
+  SVerb1 = {s : SVForm => Str ; sc : NPForm ; h : Harmony ; p : Str} ;
+
+  sverb2verbBind : SVerb -> Verb = sverb2verb True ;
+  sverb2verbSep  : SVerb -> Verb = sverb2verb False ;
+
+  vforms2sverb : VForms -> SVerb = \vf -> {
+    s = table {
+      0  =>             (vf ! 0) ;  -- tulla
+      1  => Predef.tk 1 (vf ! 1) ;  -- tule(n)
+      2  =>             (vf ! 2) ;  -- tulee
+      3  => Predef.tk 3 (vf ! 3) ;  -- tule(vat)
+      4  => Predef.tk 2 (vf ! 4) ;  -- tulk(aa)
+      5  => Predef.tk 2 (vf ! 5) ;  -- tulla(an)
+      6  => Predef.tk 1 (vf ! 6) ;  -- tuli(n)
+      7  =>             (vf ! 7) ;  -- tuli
+      8  =>             (vf ! 8) ;  -- tulisi
+      9  => Predef.tk 2 (vf ! 9) ;  -- tull(ut)
+      10 =>             (vf ! 10) ; -- tultu
+      11 => weakGrade   (vf ! 10) ; -- tullu(n)
+      12 => Predef.tk 1 (vf ! 11)   -- tulle(e)
+      } ;
+    h = aHarmony (last (vf ! 0)) ;
+    } ;
+
+  sverb2verb : Bool -> SVerb -> Verb = \b,sverb -> 
+    let
+      plus = plusIf b ;
+      vh   = sverb.s ;
+
+      tulla   = vh ! 0 ; 
+      tule_   = vh ! 1 ;    -- tule(n) 
+      tulee   = vh ! 2 ; 
+      tule__  = vh ! 3 ;    -- tule(vat)
+      tulk_   = vh ! 4 ;    -- tulk(aa) 
+      tulla_  = vh ! 5 ;    -- tulla(an) 
+      tuli_   = vh ! 6 ;    -- tuli(n)
+      tuli    = vh ! 7 ;
+      tulisi  = vh ! 8 ;
+      tull_   = vh ! 9 ;    -- tull(ut)
+      tultu   = vh ! 10 ;
+      tullu__ = vh ! 11 ;   -- tullu(n)
+      tulle_  = vh ! 12 ;   -- tulle(e)
+
+      a = harmonyA sverb.h ;
+      o = harmonyV "o" "ö" sverb.h ;
+      u = harmonyV "u" "y" sverb.h ;
+
+      tulko   = plus tulk_ o ;
+      tulkoo  = plus tulko o ;
+      tullee  = plus tull_ "ee" ;
+      tulle   = plus tull_ "e" ;
+      tullu_  = plus tull_ u ;
+      tullut  = plus tullu_ "t" ;
+      tullun  = plus tullu_ "n" ; 
+
+      tullutN : Noun = snoun2noun b {
+        s = table SNForm [
+          tullut ;
+          tullee ;
+          plus tullut ("t" + a) ;
+          plus tullee ("n" + a) ;
+          plus tullee "see" ;
+          plus tulle "ide" ;
+          plus tulle ("it" + a) ;
+          plus tulle "i" ;
+          plus tulle "i" ;
+          plus tulle "isii"
+        ] ;
+        h = sverb.h
+        } ;
+
+      tultuN  : Noun = snoun2noun b {
+        s = table SNForm [
+          tultu ;
+          tullu__ ;
+          plus tultu a ;
+          plus tultu ("n" + a) ;
+          plus tultu u ;
+          plus tultu "je" ;
+          plus tultu ("j" + a) ;
+          plus tultu "i" ;
+          plus tullu__ "i" ;
+          plus tultu "ihi"
+        ] ;
+        h = sverb.h
+        } ;
+
+
+      tulema  = plus tule__ ("m" + a) ;
+      vat     = "v" + a + "t"
+    in
+    {s = table {
+      Inf Inf1 => tulla ;
+      Presn Sg P1  => plus tule_ "n" ;
+      Presn Sg P2  => plus tule_ "t" ;
+      Presn Sg P3  => tulee ;
+      Presn Pl P1  => plus tule_ "mme" ;
+      Presn Pl P2  => plus tule_ "tte" ;
+      Presn Pl P3  => plus tule__ vat ;
+      Impf Sg P1   => plus tuli_ "n" ;    --# notpresent
+      Impf Sg P2   => plus tuli_ "t" ;    --# notpresent
+      Impf Sg P3   => tuli ;              --# notpresent
+      Impf Pl P1   => plus tuli_ "mme" ;  --# notpresent
+      Impf Pl P2   => plus tuli_ "tte" ;  --# notpresent
+      Impf Pl P3   => plus tuli vat ;     --# notpresent
+      Condit Sg P1 => plus tulisi "n" ;   --# notpresent
+      Condit Sg P2 => plus tulisi "t" ;   --# notpresent
+      Condit Sg P3 => tulisi ;            --# notpresent
+      Condit Pl P1 => plus tulisi "mme" ; --# notpresent
+      Condit Pl P2 => plus tulisi "tte" ; --# notpresent
+      Condit Pl P3 => plus tulisi vat ;   --# notpresent
+      Imper Sg     => tule_ ;
+      Imper Pl     => plus tulk_ (a + a) ;
+      ImperP3 Sg   => plus tulkoo "n" ;
+      ImperP3 Pl   => plus tulkoo "t" ;
+      ImperP1Pl    => plus tulk_ (a + a + "mme") ;
+      ImpNegPl     => tulko ;
+      Pass True    => plus tulla_ (a + "n") ;
+      Pass False   => tulla_ ;
+      PastPartAct (AN n)  => tullutN.s ! n ;
+      PastPartAct AAdv    => plus tullee "sti" ;
+      PastPartPass (AN n) => tultuN.s ! n ;
+      PastPartPass AAdv   => plus tullu__ "sti" ;
+      Inf Inf3Iness => plus tulema ("ss" + a) ;
+      Inf Inf3Elat  => plus tulema ("st" + a) ;
+      Inf Inf3Illat => plus tulema (a + "n") ;
+      Inf Inf3Adess => plus tulema ("ll" + a) ;
+      Inf Inf3Abess => plus tulema ("tt" + a) 
+      } ;
+    sc = NPCase Nom ;
+    lock_V = <>
+    } ;
+
+  predSV : SVerb1 -> VP = \sv ->
+    predV (sverb2verbSep sv ** {p = sv.p ; sc = sv.sc ; qp = case sv.h of {Back => True ; Front => False}}) ;
+--    (Verb ** {sc : NPForm ; qp : Bool ; p : Str}) -> VP = \verb -> {
+
+
+-- auxiliary
+
+    plusIf : Bool -> Str -> Str -> Str = \b,x,y -> case b of {
+      True  => x + y ;
+      False => glue x y 
+      } ;
+
 }

lib/src/finnish/stemmed/VerbFin.gf

@@ -1,54 +1,54 @@
 --1 Verb Phrases in Finnish
 
-concrete VerbFin of Verb = CatFin ** open Prelude, ResFin in {
+concrete VerbFin of Verb = CatFin ** open Prelude, ResFin, StemFin in {
 
   flags optimize=all_subs ;
 
   lin
-    UseV = predV ;
+    UseV = predSV ;
 
-    SlashV2a v = predV v ** {c2 = v.c2} ;
+    SlashV2a v = predSV v ** {c2 = v.c2} ;
 
     Slash2V3 v np = 
       insertObj 
-        (\\fin,b,_ => appCompl fin b v.c2 np) (predV v) ** {c2 = v.c3} ;
+        (\\fin,b,_ => appCompl fin b v.c2 np) (predSV v) ** {c2 = v.c3} ;
     Slash3V3 v np = 
       insertObj 
-        (\\fin,b,_ => appCompl fin b v.c3 np) (predV v) ** {c2 = v.c2} ;
+        (\\fin,b,_ => appCompl fin b v.c3 np) (predSV v) ** {c2 = v.c2} ;
 
     ComplVV v vp = 
       insertObj 
         (\\_,b,a => infVP v.sc b a vp v.vi) 
-        (predV {s = v.s ; 
+        (predSV {s = v.s ; 
                 sc = case vp.sc of {
                   NPCase Nom => v.sc ;   -- minun täytyy pestä auto
                   c => c                 -- minulla täytyy olla auto
                   } ;
-                qp = v.qp ; p = v.p
+                h = v.h ; p = v.p
                }
          ) ;
 
-    ComplVS v s  = insertExtrapos (etta_Conj ++ s.s) (predV v) ;
+    ComplVS v s  = insertExtrapos (etta_Conj ++ s.s) (predSV v) ;
-    ComplVQ v q  = insertExtrapos (          q.s) (predV v) ;
+    ComplVQ v q  = insertExtrapos (          q.s) (predSV v) ;
     ComplVA v ap = 
       insertObj 
         (\\_,b,agr => 
            let n = (complNumAgr agr) in
            ap.s ! False ! (NCase n (npform2case n v.c2.c))) --- v.cs.s ignored
-        (predV v) ;
+        (predSV v) ;
 
     SlashV2S v s = 
-      insertExtrapos (etta_Conj ++ s.s) (predV v) ** {c2 = v.c2} ;
+      insertExtrapos (etta_Conj ++ s.s) (predSV v) ** {c2 = v.c2} ;
     SlashV2Q v q = 
-      insertExtrapos (q.s) (predV v) ** {c2 = v.c2} ;
+      insertExtrapos (q.s) (predSV v) ** {c2 = v.c2} ;
     SlashV2V v vp = 
-      insertObj (\\_,b,a => infVP v.sc b a vp v.vi) (predV v) ** {c2 = v.c2} ;
+      insertObj (\\_,b,a => infVP v.sc b a vp v.vi) (predSV v) ** {c2 = v.c2} ;
       ---- different infinitives
     SlashV2A v ap = 
       insertObj 
         (\\fin,b,_ => 
           ap.s ! False ! (NCase Sg (npform2case Sg v.c3.c))) ----agr to obj
-        (predV v) ** {c2 = v.c2} ;
+        (predSV v) ** {c2 = v.c2} ;
 
     ComplSlash vp np = insertObjPre np.isNeg (\\fin,b,_ => appCompl fin b vp.c2 np) vp ;
 
@@ -60,12 +60,12 @@ concrete VerbFin of Verb = CatFin ** open Prelude, ResFin in {
     SlashVV v vp = 
       insertObj 
         (\\_,b,a => infVP v.sc b a vp v.vi) 
-        (predV {s = v.s ; 
+        (predSV {s = v.s ; 
                 sc = case vp.sc of {
                   NPCase Nom => v.sc ;   -- minun täytyy pestä auto
                   c => c                 -- minulla täytyy olla auto
                   } ;
-                qp = v.qp ; p = v.p
+                h = v.h ; p = v.p
                }
          ) ** {c2 = vp.c2} ; ---- correct ??
 {---- 153543936 (210912,312)
@@ -73,7 +73,7 @@ concrete VerbFin of Verb = CatFin ** open Prelude, ResFin in {
       insertObjPre np.isNeg
         (\\fin,b,a => appCompl True b v.c2 np ++ ---- fin -> stack overflow
                       infVP v.sc b a vp v.vi) 
-          (predV v) ** {c2 = vp.c2} ;
+          (predSV v) ** {c2 = vp.c2} ;
 ----}
 
     AdvVP vp adv = insertAdv (\\_ => adv.s) vp ;
@@ -86,12 +86,12 @@ concrete VerbFin of Verb = CatFin ** open Prelude, ResFin in {
 
     ReflVP v = insertObjPre False (\\fin,b,agr => appCompl fin b v.c2 (reflPron agr)) v ;
 
-    PassV2 v = let vp = predV v in {
+    PassV2 v = let vp = predSV v in {
       s = \\_ => vp.s ! VIPass ;
       s2 = \\_,_,_ => [] ;
       adv = \\_ => [] ;
       ext = [] ;
-      qp = v.qp ;
+      qp = vp.qp ;
       isNeg = False ;
       sc = v.c2.c  -- minut valitaan ; minua rakastetaan ; minulle kuiskataan 
       } ;          ---- talon valitaan: should be marked like inf.