a stemmed version of DictEngFin and ParseFin - now works without trouble!

lib/src/finnish/DictEngFin.gf

@@ -39228,8 +39228,8 @@ lin
   put_V2 = mkV2 (mkV "panna") ;
   stop_V = mkV "pysähtyä" ;
   jump_V = mkV "hypätä" ;
-  left_Ord = mkOrd (mkN "vasen") ;
+----  left_Ord = mkOrd (mkN "vasen") ;
-  right_Ord = mkOrd (mkN "oikea") ;
+----  right_Ord = mkOrd (mkN "oikea") ;
   far_Adv = mkAdv "kaukana" ;
   correct_A = mkA "oikea" ;
   dry_A = mkA (mkN "kuiva") "kuivempi" "kuivin" ;
@@ -39369,8 +39369,8 @@ lin
     uncertain_A = mkA "epävarma" ;
 
  oper
-    mkOrd : N -> Ord ;
+----    mkOrd : N -> Ord ;
-    mkOrd x = {s = x.s ; lock_Ord = <> } ;
+----    mkOrd x = {s = x.s ; lock_Ord = <> } ;
     cpartitive = casePrep partitive ;
 
 

lib/src/finnish/VerbFin.gf

@@ -68,13 +68,13 @@ concrete VerbFin of Verb = CatFin ** open Prelude, ResFin in {
                 qp = v.qp ; p = v.p
                }
          ) ** {c2 = vp.c2} ; ---- correct ??
-
+{----
     SlashV2VNP v np vp = 
       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} ;
-
+----}
     AdvVP vp adv = insertAdv (\\_ => adv.s) vp ;
 
     AdVVP adv vp = insertAdv (\\_ => adv.s) vp ;

lib/src/finnish/stemmed/AllFin.gf

@@ -0,0 +1,6 @@
+--# -path=.:../abstract:../common:prelude
+
+concrete AllFin of AllFinAbs = 
+  LangFin - [SlashV2VNP,SlashVV, TFut], ---- to speed up linking; to remove spurious parses
+  ExtraFin - [ProDrop, ProDropPoss, S_OSV, S_VSO, S_ASV] -- to exclude spurious parses
+  ** {} ;

lib/src/finnish/stemmed/ExtraFin.gf

@@ -0,0 +1,226 @@
+--# -path=.:abstract:common:prelude
+
+concrete ExtraFin of ExtraFinAbs = CatFin ** 
+  open ResFin, MorphoFin, Coordination, Prelude, NounFin, StructuralFin, StemFin, (R = ParamX) in {
+
+  lin
+    GenNP np = {
+      s1,sp = \\_,_ => np.s ! NPCase Gen ;
+      s2 = \\_ => [] ;
+      isNum  = False ;
+      isPoss = False ;
+      isDef  = True ; --- "Jussin kolme autoa ovat" ; thus "...on" is missing
+      isNeg = False 
+     } ;
+
+    GenIP ip = {s = \\_,_ => ip.s ! NPCase Gen} ;
+
+    GenCN n1 n2 = {s = \\nf => n1.s ! NPCase Gen ++ n2.s ! nf ;
+                   h = n2.h } ;
+
+  lincat
+    VPI   = {s : Str} ;
+    [VPI] = {s1,s2 : Str} ;
+  lin
+    BaseVPI = twoSS ;
+    ConsVPI = consrSS comma ;
+
+    MkVPI vp = {s = infVP (NPCase Nom) Pos (agrP3 Sg) vp Inf1} ;
+    ConjVPI = conjunctDistrSS ;
+    ComplVPIVV vv vpi = 
+      insertObj (\\_,_,_ => vpi.s) (predSV vv) ;
+
+  lincat
+    VPS = {
+      s   : Agr  => Str ; 
+      sc  : NPForm ;  --- can be different for diff parts
+      qp  : Bool -- True = back vowel --- can be different for diff parts
+      } ;
+
+    [VPS] = {
+      s1,s2 : Agr  => Str ; 
+      sc    : NPForm ;  --- take the first: minä osaan kutoa ja täytyy virkata
+      qp    : Bool      --- take the first: osaanko minä kutoa ja käyn koulua
+      } ;
+
+  lin
+    BaseVPS x y = twoTable Agr x y ** {sc = x.sc ; qp = x.qp} ;
+    ConsVPS x y = consrTable Agr comma x y ** {sc = x.sc ; qp = x.qp} ;
+
+    ConjVPS conj ss = conjunctDistrTable Agr conj ss ** {
+      sc = ss.sc ; qp = ss.qp
+      } ;
+
+    MkVPS t p vp = { --  Temp -> Pol -> VP -> VPS ;
+      s = \\a => let vps = vp.s ! VIFin t.t ! t.a ! p.p ! a
+                 in
+                 t.s ++ p.s ++
+                 vps.fin ++ vps.inf ++
+                 vp.s2 ! True ! p.p ! a ++
+                 vp.adv ! p.p ++
+                 vp.ext ;
+      sc = vp.sc ;
+      qp = vp.qp
+      } ;
+
+    PredVPS np vps = { -- NP -> VPS -> S ;
+      s = subjForm np vps.sc Pos ++ vps.s ! np.a
+      } ;
+
+    AdvExistNP adv np = 
+      mkClause (\_ -> adv.s) np.a (insertObj 
+        (\\_,b,_ => np.s ! NPCase Nom) (predV (verbOlla ** {sc = NPCase Nom ; qp = True ; p = []}))) ;
+
+    RelExistNP prep rp np = {
+      s = \\t,ant,bo,ag => 
+      let 
+        n = complNumAgr ag ;
+        cl = mkClause 
+          (\_ -> appCompl True Pos prep (rp2np n rp))
+          np.a 
+          (insertObj 
+            (\\_,b,_ => np.s ! NPCase Nom) 
+            (predV (verbOlla ** {sc = NPCase Nom ; qp = True ; p = []}))) ;
+      in 
+      cl.s ! t ! ant ! bo ! SDecl ;
+      c = NPCase Nom
+      } ;
+
+    AdvPredNP  adv v np =
+      mkClause (\_ -> adv.s) np.a (insertObj 
+        (\\_,b,_ => subjForm np v.sc b) (predSV v)) ;
+
+    ICompExistNP adv np = 
+      let cl = mkClause (\_ -> adv.s ! np.a) np.a (insertObj 
+        (\\_,b,_ => np.s ! NPCase Nom) (predV (verbOlla ** {sc = NPCase Nom ; qp = True ; p = []}))) ;
+      in  {
+        s = \\t,a,p => cl.s ! t ! a ! p ! SDecl
+      } ;
+
+    IAdvPredNP iadv v np =
+      let cl = mkClause (\_ -> iadv.s) np.a (insertObj 
+                 (\\_,b,_ => np.s ! v.sc) (predSV v)) ;
+      in  {
+        s = \\t,a,p => cl.s ! t ! a ! p ! SDecl
+      } ;
+
+--    i_implicPron = mkPronoun [] "minun" "minua" "minuna" "minuun" Sg P1 ;
+    whatPart_IP = {
+      s = table {
+        NPCase Nom | NPAcc => "mitä" ;
+        c => whatSg_IP.s ! c
+        } ;
+      n = Sg
+    } ;
+
+    PartCN cn = 
+      let 
+        acn = DetCN (DetQuant IndefArt NumSg) cn
+      in {
+        s = table {
+          NPCase Nom | NPAcc => acn.s ! NPCase ResFin.Part ;
+          c => acn.s ! c
+          } ; 
+        a = acn.a ;
+        isPron = False ; isNeg = False
+        } ;
+
+    vai_Conj = {s1 = [] ; s2 = "vai" ; n = Sg} ;
+
+    CompPartAP ap = {
+      s = \\agr => ap.s ! False ! NCase (complNumAgr agr) ResFin.Part
+      } ;
+
+---- copied from VerbFin.CompAP, should be shared
+    ICompAP ap = {
+      s = \\agr => 
+          let
+            n = complNumAgr agr ;
+            c = case n of {
+              Sg => Nom ;  -- minä olen iso ; te olette iso
+              Pl => ResFin.Part   -- me olemme isoja ; te olette isoja
+              }            --- definiteness of NP ?
+          in "kuinka" ++ ap.s ! False ! (NCase n c)
+      } ;
+
+    IAdvAdv adv = {s = "kuinka" ++ adv.s} ;
+
+    ProDrop p = {
+      s = table {NPCase (Nom) => [] ; c => p.s ! c} ; 
+          ---- drop Gen only works in adjectival position: "autoni", but not in "ø täytyy mennä"
+      a = p.a
+      } ;
+
+    ProDropPoss p = {
+      s1 = \\_,_ => [] ;
+      sp = \\_,_ => p.s ! NPCase Gen ;
+      s2 = table {Front => BIND ++ possSuffixFront p.a ;
+                  Back  => BIND ++ possSuffix p.a } ;
+      isNum = False ;
+      isPoss = True ;
+      isDef = True ;  --- "minun kolme autoani ovat" ; thus "...on" is missing
+      isNeg = False
+      } ;
+
+  lincat 
+    ClPlus, ClPlusObj, ClPlusAdv = ClausePlus ;
+    Part = {s : Bool => Str} ;
+
+  lin 
+    S_SVO part t p clp = 
+      let 
+         cl = clp.s ! t.t ! t.a ! p.p ;
+         pa = part.s ! True ----
+      in
+      {s = t.s ++ p.s ++ cl.subj ++ pa ++ cl.fin ++ cl.inf ++ cl.compl ++ cl.adv ++ cl.ext} ; 
+    S_OSV part t p clp = 
+      let 
+         cl = clp.s ! t.t ! t.a ! p.p ;
+         pa = part.s ! True ----
+      in
+      {s = t.s ++ p.s ++ cl.compl ++ pa ++ cl.subj ++ cl.fin ++ cl.inf ++ cl.adv ++ cl.ext} ; 
+    S_VSO part t p clp = 
+      let 
+         cl = clp.s ! t.t ! t.a ! p.p ;
+         pa = part.s ! cl.qp
+      in
+      {s = t.s ++ p.s ++ cl.fin ++ pa ++ cl.subj ++ cl.inf ++ cl.compl ++ cl.adv ++ cl.ext} ; 
+    S_ASV part t p clp = 
+      let 
+         cl = clp.s ! t.t ! t.a ! p.p ;
+         pa = part.s ! cl.qp
+      in
+      {s = t.s ++ p.s ++ cl.adv ++ pa ++ cl.subj ++ cl.fin ++ cl.inf ++ cl.compl ++ cl.ext} ; 
+
+    S_OVS part t p clp = 
+      let 
+         cl = clp.s ! t.t ! t.a ! p.p ;
+         pa = part.s ! True ----
+      in
+      {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 = 
+      insertObjClausePlus 0 False (\\b => appCompl True b vps.c2 obj) (mkClausePlus (subjForm np vps.sc) np.a vps) ;
+    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 = 
+      insertObjClausePlus 1 False (\\_ => adv.s) (mkClausePlus (subjForm np vp.sc) np.a vp) ;
+    PredClPlusFocAdv  np vp  adv = 
+      insertObjClausePlus 1 True (\\_ => adv.s) (mkClausePlus (subjForm np vp.sc) np.a vp) ;
+
+    ClPlusWithObj c = c ;
+    ClPlusWithAdv c = c ;
+
+  noPart     = {s = \\_ => []} ;
+  han_Part   = mkPart "han" "hän" ;
+  pa_Part    = mkPart "pa" "pä" ;
+  pas_Part   = mkPart "pas" "päs" ;
+  ko_Part    = mkPart "ko" "kö" ;
+  kos_Part   = mkPart "kos" "kös" ;
+  kohan_Part = mkPart "kohan" "köhän" ;
+  pahan_Part = mkPart "pahan" "pähän" ;
+
+} 

lib/src/finnish/stemmed/ParadigmsFin.gf

@@ -481,7 +481,7 @@ oper
     mkA : Str -> A  = mkA_1 ;
     mkA : N -> A = \n -> noun2adjDeg n ** {lock_A = <>} ;
     mkA : N -> (kivempaa,kivinta : Str) -> A = \n -> regAdjective n ;
-    mkA : (sana : AK) -> A = \w -> noun2adjDeg (nForms2N w.s) ;
+    mkA : (sana : AK) -> A = \w -> noun2adjDeg (nforms2snoun w.s) ;
 
     mkA : (hyva,parempi,paras : N) -> (hyvin,paremmin,parhaiten : Str) -> A = \h,p,ps,hn,pn,ph -> lin A {
       s = table {

lib/src/finnish/stemmed/ParseFin.gf

@@ -0,0 +1,123 @@
+--# -path=.:..:../../abstract:../../common:../../english:../kotus
+
+concrete ParseFin of ParseEngAbs = 
+  TenseX, ---- - [Pol, PNeg, PPos],
+  CatFin,
+  NounFin - [PPartNP],
+  AdjectiveFin,
+  NumeralFin,
+  SymbolFin [PN, Symb, MkSymb, SymbPN],
+  ConjunctionFin,
+  VerbFin - [SlashV2V, PassV2, UseCopula],
+  AdverbFin,
+  PhraseFin,
+  SentenceFin,
+  RelativeFin,
+  IdiomFin [NP, VP, Tense, Cl, ProgrVP, ExistNP]
+  , ExtraFin [NP, Quant, VPSlash, VP, Tense, GenNP, PassVPSlash, Voc,
+      Temp, Tense, Pol, Conj, VPS, ListVPS, S, MkVPS, BaseVPS, ConsVPS, ConjVPS, PredVPS,
+      VPI, VPIForm, VPIInf, VPIPresPart, ListVPI, VV, MkVPI, BaseVPI, ConsVPI, ConjVPI, ComplVPIVV]
+ , DictEngFin 
+** 
+open MorphoFin, ResFin, ParadigmsFin, SyntaxFin, StemFin, Prelude in {
+
+flags literal=Symb ; coding = utf8 ;
+
+lin
+  myself_NP = mkNP (mkPronoun "itse" "itsen" "itseä" "itsenä" "itseen" Sg P1) ;
+  yourselfSg_NP = mkNP (mkPronoun "itse" "itsen" "itseä" "itsenä" "itseen" Sg P2) ;
+  himself_NP = mkNP (mkPronoun "itse" "itsen" "itseä" "itsenä" "itseen" Sg P3) ;
+  herself_NP = mkNP (mkPronoun "itse" "itsen" "itseä" "itsenä" "itseen" Sg P3) ;
+  itself_NP = mkNP (mkPronoun "itse" "itsen" "itseä" "itsenä" "itseen" Sg P3) ;
+  ourself_NP = mkNP (mkPronoun "itse" "itsen" "itseä" "itsenä" "itseen" Pl P1) ;
+  yourselfPl_NP = mkNP (mkPronoun "itse" "itsen" "itseä" "itsenä" "itseen" Pl P2) ;
+  themself_NP = mkNP (mkPronoun "itse" "itsen" "itseä" "itsenä" "itseen" Pl P3) ;
+  themselves_NP = mkNP (mkPronoun "itse" "itsen" "itseä" "itsenä" "itseen" Pl P3) ;
+
+
+  CompoundCN num noun cn = {
+    s = \\nf => num.s ! Sg ! Nom ++ noun.s ! 0 ++ BIND ++ cn.s ! nf ;
+    h = cn.h
+    } ;
+
+  PassVPSlash = passVPSlash ;
+
+oper  
+  passVPSlash : VPSlash -> VP = \vp -> lin VP {
+      s = \\_ => vp.s ! VIPass ;
+      s2 = vp.s2 ;
+      adv = vp.adv ;
+      ext = vp.ext ;
+      qp = vp.qp ;
+      isNeg = vp.isNeg ;
+      sc = vp.c2.c
+      } ; 
+
+lin
+  DashCN noun1 noun2 = {
+    s = \\nf => noun1.s ! 0 ++ BIND ++ noun2.s ! nf ;
+    h = noun2.h
+    } ;
+
+  PastPartAP v = {s = \\_,nf => (sverb2verbSep v).s ! PastPartPass (AN nf)} ;
+
+  PredVPosv np vp = mkCl np vp ; ----
+
+  -- Ant -> Pol -> VPSlash -> RS ; --- here replaced by a relative clause 
+  PastPartRS ant pol vps = mkRS ant pol (mkRCl which_RP (passVPSlash (lin VPSlash vps))) ;
+
+  ApposNP np1 np2 = {
+      s = \\c => np1.s ! c ++ "," ++ np2.s ! c ;
+      a = np1.a ;
+      isPron = np1.isPron ; isNeg = np1.isNeg
+      } ;
+
+
+{-
+  GerundN v = { -- parsing
+    s = \\n,c => v.s ! VPresPart ;
+    g = Neutr
+  } ;
+  
+  GerundAP v = {  -- beckoning
+    s = \\agr => v.s ! VPresPart ;
+    isPre = True
+  } ;
+
+  PastPartAP v = {   -- broken
+    s = \\agr => v.s ! VPPart ;
+    isPre = True
+  } ;
+
+  OrdCompar a = {s = \\c => a.s ! AAdj Compar c } ;  -- higher
+
+  PositAdVAdj a = {s = a.s ! AAdv} ;  -- really
+
+  UseQuantPN q pn = {s = \\c => q.s ! False ! Sg ++ pn.s ! npcase2case c ; a = agrgP3 Sg pn.g} ;  -- this London
+
+  SlashV2V v p vp = insertObjc (\\a => p.s ++ case p.p of {CPos => ""; _ => "not"} ++  -- force not to sleep
+                                       v.c3 ++ 
+                                       infVP v.typ vp a)
+                               (predVc v) ;
+
+  ComplPredVP np vp = { -- ?
+      s = \\t,a,b,o => 
+        let 
+          verb  = vp.s ! t ! a ! b ! o ! np.a ;
+          compl = vp.s2 ! np.a
+        in
+        case o of {
+          ODir => compl ++ "," ++ np.s ! npNom ++ verb.aux ++ verb.adv ++ vp.ad ++ verb.fin ++ verb.inf ;
+          OQuest => verb.aux ++ compl ++ "," ++ np.s ! npNom ++ verb.adv ++ vp.ad ++ verb.fin ++ verb.inf 
+          }
+    } ;
+
+  CompS s = {s = \\_ => "that" ++ s.s} ;  -- S -> Comp
+  CompVP vp = {s = \\a => infVP VVInf vp a} ; -- VP -> Comp
+-}
+
+  that_RP = which_RP ;
+  no_RP = which_RP ;
+
+
+}

lib/src/finnish/stemmed/StemFin.gf

@@ -278,4 +278,27 @@ oper
       False => glue x y 
       } ;
 
+-- for Symbol
+
+  defaultStemEnding : SNForm -> Str = \c -> case c of {
+      0 => "" ;
+      1 => "" ;
+      2 => "a" ;
+      3 => "na" ;
+      4 => "ii" ;
+      5 => "ie" ;
+      6 => "ia" ;
+      7 => "i" ;
+      8 => "i" ;
+      9 => "ihi"
+      } ; 
+  bindIfS : SNForm -> Str = \c -> case c of {
+    0|1 => [] ;
+    _ => BIND
+    } ;
+  bindColonIfS : SNForm -> Str = \c -> case c of {
+    0|1 => [] ;
+    _ => BIND ++ ":" ++ BIND
+    } ;
+
 }

lib/src/finnish/stemmed/SymbolFin.gf

@@ -0,0 +1,44 @@
+--# -path=.:../abstract:../common
+
+concrete SymbolFin of Symbol = CatFin ** open Prelude, NounFin, ResFin, MorphoFin, StemFin in {
+
+lin
+  SymbPN i = {s = \\c => i.s ++ bindIfS c ++ defaultStemEnding c ; h = Back} ; --- c
+  IntPN i  = {s = \\c => i.s ++ bindColonIfS c ++ defaultStemEnding c ; h = Back} ; --- c
+  FloatPN i  = {s = \\c => i.s ++ bindColonIfS c ++ defaultStemEnding c ; h = Back} ; --- c
+  NumPN i  = {s = \\c => i.s!Sg!Nom  ; h = Back} ; --- c
+
+  CNIntNP cn i = {
+    s = \\c => cn.s ! NCase Sg (npform2case Sg c) ++ i.s ;
+    a = agrP3 Sg ;
+    isPron = False ; isNeg = False
+    } ;
+  CNSymbNP det cn xs = let detcn = NounFin.DetCN det cn in {
+    s = \\c => detcn.s ! c ++ xs.s ;
+    a = detcn.a ;
+    isPron = False ; isNeg = False
+    } ;
+  CNNumNP cn i = {
+    s = \\c => cn.s ! NCase Sg (npform2case Sg c) ++ i.s ! Sg ! Nom ;
+    a = agrP3 Sg ;
+    isPron = False ; isNeg = False
+    } ;
+
+  SymbS sy = sy ;
+
+  SymbNum n = {s = \\_,_ => n.s ; isNum = True ; n = Pl} ;
+  SymbOrd n = {s = \\_ => n.s ++ "."} ;
+
+lincat 
+
+  Symb, [Symb] = SS ;
+
+lin
+
+  MkSymb s = s ;
+
+  BaseSymb = infixSS "ja" ;
+  ConsSymb = infixSS "," ;
+
+}
+