tagged/LangFin.gf now compiles but conversion to tags is not yet complete

lib/src/finnish/tagged/LangFin.gf

@@ -0,0 +1,12 @@
+--# -path=.:..:../../abstract:../../common:../../api
+
+concrete LangFin of Lang = 
+  GrammarFin, 
+  LexiconFin
+  , ConstructionFin
+  , DocumentationFin --# notpresent
+  ** {
+
+flags startcat = Phr ; unlexer = text ; lexer = finnish ;
+
+} ;

lib/src/finnish/tagged/StemFin.gf

@@ -5,15 +5,20 @@ resource StemFin = open TagFin, MorphoFin, Prelude in {
 flags coding = utf8 ;
 
 oper
-  SNForm : Type = Predef.Ints 0 ;
+  SNForm : Type = Predef.Ints 0 ; --- not really needed
-  SNoun : Type = {s : SNForm => Str ; h : Harmony } ;
+  SNoun  : Type = {s : SNForm => Str ; h : Harmony} ; --- Harmony needed only for API compatibility
 
-  nforms2snoun : NForms -> SNoun = \nfs -> {s = nfs ; h = Back} ;
+  mkSNoun : Str -> SNoun = \s -> {s = \\_ => s ; h = Back} ; --- Harmony not used
+
+  nforms2snoun : NForms -> SNoun = \nfs -> mkSNoun (nfs ! 0) ;
 
     snoun2nounBind : SNoun -> Noun = snoun2noun True ;
     snoun2nounSep  : SNoun -> Noun = snoun2noun False ;
 
-    snoun2noun : Bool -> SNoun -> Noun = \b,sn -> {s = \\nf => sn.s ! 0++ mkTag "N" + tagNForm nf ; h = Back} ;
+    snoun2noun : Bool -> SNoun -> Noun = \b,sn -> {
+      s = \\nf => tagWord (nounTag ++ tagNForm nf) (sn.s ! 0) ;
+      h = sn.h --- not used
+      } ;
 
 
 
@@ -35,78 +40,54 @@ oper
 
   snoun2spn : SNoun -> SPN = \n -> {s = \\c => n.s ! 0 ++ tagCase c} ;
 
-  exceptNomSNoun : SNoun -> Str -> SNoun = \noun,nom -> {
+  exceptNomSNoun : SNoun -> Str -> SNoun = \noun,nom -> mkSNoun nom ;
-      s = \\_ => nom ;
-      h = noun.h 
-      } ;
 
 
 
 -- Adjectives --- could be made more compact by pressing comparison forms down to a few
 
 oper
-  SAForm : Type = AForm ;
+  SAForm : Type = SNForm ;
-
+  SAdj : Type = SNoun ;
-oper
-  SAdj = {s : SAForm => Str ; h : Harmony} ;
 
   snoun2sadj : SNoun -> SAdj = snoun2sadjComp True ;
 
-  snoun2sadjComp : Bool -> SNoun -> SAdj = \isPos,tuore ->
+  snoun2sadjComp : Bool -> SNoun -> SAdj = \_,tuore -> tuore ;
-    let 
-      tuoree = init (tuore.s ! 0) ;
-      tuoreesti  = tuoree + "sti" ; 
-      tuoreemmin =  init tuoree ;
-    in {s = table {
-         AN f => tuoree ;
-         AAdv => if_then_Str isPos tuoreesti tuoreemmin
-         } ;
-        h = Back
-       } ;
 
-   sAN : SNForm -> SAForm = \n -> AN (NCase Sg Nom) ;  ---- without eta exp gives internal error 6/8/2013
+   sAN : SNForm -> SAForm = \n -> n ;
-   sAAdv : SAForm = AAdv ;
+   sAAdv : SAForm = 0 ;
-   sANGen : (SAForm => Str) -> Str = \a -> a ! AN (NCase Sg Gen) ;
+   sANGen : (SAForm => Str) -> Str = \a -> a ! 0 ;
 
     mkAdj : (hyva,parempi,paras : SNoun) -> (hyvin,paremmin,parhaiten : Str) -> {s : Degree => SAForm => Str ; h : Harmony} = \h,p,ps,hn,pn,ph -> {
-      s = table {
+      s = \\degr,aform => tagWord (adjectiveTag ++ tagDegree degr) (h.s ! 0) ;  ---- where is AForm added?
-        Posit => table {
+      h = h.h  --- not needed
-           AN nf => h.s ! 0 ++ tagNForm nf ;
-           AAdv  => hn
-           } ; 
-        Compar => table {
-           AN nf => p.s ! 0 ++ tagNForm nf ;
-           AAdv  => pn
-           } ; 
-        Superl => table {
-           AN nf => ps.s ! 0 ++ tagNForm nf ;
-           AAdv  => ph
-           }
-        } ;
-      h = Back  ---- TODO: just get rid of h ?
       } ;
 
-  snoun2compar : SNoun -> Str = \n -> n.s ! 0 + "Comp" ; ---- TODO
+---- where are these needed?
-  snoun2superl : SNoun -> Str = \n -> n.s ! 0 + "Superl" ; ---- TODO
+  snoun2compar : SNoun -> Str = \n -> n.s ! 0 ++ "?Comp" ; ---- TODO
+  snoun2superl : SNoun -> Str = \n -> n.s ! 0 ++ "?Superl" ; ---- TODO
 
 -- verbs
 
 oper
-  SVForm : Type = VForm ;
+  SVForm : Type = SNForm ;
-  SVerb : Type = {s : SVForm => Str ; h : Harmony} ;
+  SVerb : Type = SNoun ;
 
-  ollaSVerbForms : SVForm => Str = verbOlla.s ;
+  mkSVerb = mkSNoun ;
+
+  ollaSVerbForms : SVForm => Str = \\_ => "olla" ;
 
   -- used in Cat
-  SVerb1 = {s : SVForm => Str ; sc : SubjCase ; h : Harmony ; p : Str} ;
+  SVerb1 = SVerb ** {sc : SubjCase ; p : Str} ;
 
   sverb2verbBind : SVerb -> Verb = sverb2verb True ;
   sverb2verbSep  : SVerb -> Verb = sverb2verb False ;
 
-  vforms2sverb : VForms -> SVerb = \v -> 
+  vforms2sverb : VForms -> SVerb = \v -> mkSVerb (v ! 0) ;
-    {s = (vforms2V v).s ; h = case (last (v ! 0)) of {"a" => Back ; _ => Front}} ;
 
-  sverb2verb : Bool -> SVerb -> Verb = \b,sverb -> {s = sverb.s} ;
+  sverb2verb : Bool -> SVerb -> Verb = \b,sverb -> {
+    s = \\vf => tagWord (verbTag ++ tagVForm vf) (sverb.s ! 0)
+    } ;
 
   predSV : SVerb1 -> VP = \sv ->
     predV sv ; 
@@ -114,8 +95,9 @@ oper
 
 -- word formation functions
 
+
   sverb2snoun : SVerb1 -> SNoun = \v ->    -- syöminen
-    let tekem = Predef.tk 4 (v.s ! Inf Inf3Iness) in 
+    let tekem = Predef.tk 4 ((sverb2verb True v).s ! Inf Inf3Iness) in 
     nforms2snoun (dNainen (tekem + "inen")) ;
 
 {-
@@ -181,11 +163,11 @@ oper
 
   defaultVPTyp = {isNeg = False ; isPass = False} ;
     
-  HVerb : Type = Verb ** {sc : SubjCase ; h : Harmony ; p : Str} ;
+  HVerb : Type = SVerb1 ;
  
   predV : HVerb -> VP = \verb -> {
-    s = verb ;
+    s   = verb ;
-    s2 = \\_,_,_ => [] ;
+    s2  = \\_,_,_ => [] ;
     adv = \\_ => verb.p ; -- the particle of the verb
     ext = [] ;
     vptyp = defaultVPTyp ;
@@ -203,7 +185,7 @@ oper
 
   vp2old_vp : VP -> old_VP = \vp -> 
     let 
-     verb = vp.s ; 
+     verb = vp.s ** sverb2verb True vp.s ; 
      sverb :  VIForm => Anteriority => Polarity => Agr => {fin, inf : Str} = \\vi,ant,b,agr0 => 
       let
         agr = verbAgr agr0 ;
@@ -396,7 +378,7 @@ oper
             } ;
           verb = case ipol of {
             Pos => <vp.s ! VIInf vi ! Simul ! Pos ! agr, []> ; -- nähdä/näkemään
-            Neg => <(vp2old_vp (predV (verbOlla ** {sc = SCNom ; h = Back ; p = []}))).s ! VIInf vi ! Simul ! Pos ! agr,
+            Neg => <(vp2old_vp (predV vpVerbOlla)).s ! VIInf vi ! Simul ! Pos ! agr,
                     (vp.s ! VIInf Inf3Abess ! Simul ! Pos ! agr).fin> -- olla/olemaan näkemättä
             } ;
           vph = vp.h ;
@@ -410,6 +392,6 @@ oper
 
   infVP : SubjCase -> Polarity -> Agr -> VP -> InfForm -> Str = infVPGen Pos ;
 
-  vpVerbOlla : HVerb = verbOlla ** {sc = SCNom ; h = Back ; p = []} ;
+  vpVerbOlla : HVerb = {s = \\_ => "olla" ; sc = SCNom ; h = Back ; p = []} ;
 
 }

lib/src/finnish/tagged/TagFin.gf

@@ -3,20 +3,94 @@ resource TagFin = open ResFin, Prelude in {
 oper
   Tag : Type = Str ;
 
-  mkTag : Str -> Tag = \t -> "+" + t ;
+  tagWord : Tag -> Str -> Str = \tag,lemma -> "[" ++ lemma ++ tag ++ "]" ;
 
+  mkTag = overload {
+    mkTag : Str -> Tag = \t -> "+" + t ;
+    mkTag : Str -> Str -> Tag = \t,v -> t ++ "=" + v ;
+    } ;
+    
   tagNForm : NForm -> Str = \nf -> case nf of {
-    NCase n c => tagNumber n + tagCase c ; 
+    NCase n c     => tagNumber n  ++ tagCase c ; 
-    NComit => tagNumber Pl + mkTag "Com" ;
+    NComit        => tagNumber Pl ++ mkTag "Com" ;
-    NInstruct => tagNumber Pl + mkTag "Ins" ; 
+    NInstruct     => tagNumber Pl ++ mkTag "Ins" ; 
-    NPossNom n => tagNumber n + tagCase Nom ;
+    NPossNom n    => tagNumber n  ++ tagCase Nom ;
-    NPossGen n => tagNumber n + tagCase Gen ;
+    NPossGen n    => tagNumber n  ++ tagCase Gen ;
-    NPossTransl n => tagNumber n + tagCase Transl ;
+    NPossTransl n => tagNumber n  ++ tagCase Transl ;
-    NPossIllat n => tagNumber n + tagCase Illat ;
+    NPossIllat n  => tagNumber n  ++ tagCase Illat ;
-    NCompound => mkTag "Comp"
+    NCompound     => mkTag "Comp"
     } ;
 
-  tagCase : Case -> Str = \c -> case c of {
+  tagAForm : AForm -> Str = \af -> case af of {
+    AN nf => tagNForm nf ;
+    AAdv => mkTag "Adv"
+    } ;
+
+  tagVForm : VForm -> Str = \vf -> case vf of {
+    Inf    infform  => tagInfForm infform ;
+    Presn  num pers => activeTag ++ presentTag ++ tagNumber num ++ tagPerson pers ;
+    Impf   num pers => activeTag ++ imperfectTag ++ tagNumber num ++ tagPerson pers ;
+    Condit num pers => activeTag ++ conditionalTag ++ tagNumber num ++ tagPerson pers ;
+    Potent num pers => activeTag ++ potentialTag  ++ tagNumber num ++ tagPerson pers ;
+    PotentNeg       => activeTag ++ potentialTag  ++ negativeTag ;
+    Imper  num      => activeTag ++ imperativeTag ++ tagNumber num ++ tagPerson P2 ;
+    ImperP3 num     => activeTag ++ imperativeTag ++ tagNumber num ++ tagPerson P3 ;
+    ImperP1Pl       => activeTag ++ imperativeTag ++ tagNumber Pl  ++ tagPerson P1 ;
+    ImpNegPl        => activeTag ++ imperativeTag ++ negativeTag ++ tagNumber Pl ;
+    PassPresn bool  => passiveTag ++ presentTag ++ tagBool bool ;
+    PassImpf  bool  => passiveTag ++ presentTag ++ tagBool bool ;
+    PassCondit bool => passiveTag ++ imperfectTag ++ tagBool bool ;
+    PassPotent bool => passiveTag ++ potentialTag ++ tagBool bool ;
+    PassImper bool  => passiveTag ++ imperativeTag ++ tagBool bool ;
+    PastPartAct af  => participleTag ++ activeTag ++ pastTag ++ tagAForm af ;
+    PastPartPass af => participleTag ++ activeTag ++ pastTag ++ tagAForm af ;
+    PresPartAct af  => participleTag ++ activeTag ++ presentTag ++ tagAForm af ;
+    PresPartPass af => participleTag ++ activeTag ++ presentTag ++ tagAForm af ;
+    AgentPart af    => participleTag ++ agentTag  ++ tagAForm af
+    } ;
+
+  tagInfForm : InfForm -> Str = \vf -> case vf of {
+    Inf1           => infinitiveTag ;
+    Inf1Long       => infinitiveTag ;
+    Inf2Iness      => infinitiveTag ;
+    Inf2Instr      => infinitiveTag ;
+    Inf2InessPass  => infinitiveTag ;
+    Inf3Iness      => infinitiveTag ;
+    Inf3Elat       => infinitiveTag ;
+    Inf3Illat      => infinitiveTag ;
+    Inf3Adess      => infinitiveTag ;
+    Inf3Abess      => infinitiveTag ;
+    Inf3Instr      => infinitiveTag ;
+    Inf3InstrPass  => infinitiveTag ;
+    Inf4Nom        => infinitiveTag ;
+    Inf4Part       => infinitiveTag ;
+    Inf5           => infinitiveTag ;
+    InfPresPart    => infinitiveTag ;
+    InfPresPartAgr => infinitiveTag 
+    } ;
+
+
+  nounTag = mkTag "N" ;
+  adjectiveTag = mkTag "A" ;
+  verbTag = mkTag "V" ;
+
+  activeTag = mkTag "Act" ;
+  passiveTag = mkTag "Pass" ;
+  
+  imperativeTag = mkTag "Imp" ;
+  participleTag = mkTag "Part" ;
+  agentTag = mkTag "Agent" ;
+  infinitiveTag = mkTag "Inf" ;
+  
+  negativeTag = mkTag "Neg" ;
+  
+  presentTag = mkTag "Pres" ;
+  imperfectTag = mkTag "Impf" ;
+  conditionalTag = mkTag "Cond" ;
+  potentialTag = mkTag "Pot" ;
+  pastTag = mkTag "Past" ; -- for participles
+
+  tagCase : Case -> Tag = \c -> case c of {
     Nom => mkTag "Nom" ;
     Gen => mkTag "Gen" ;
     Part => mkTag "Par" ;
@@ -30,8 +104,27 @@ oper
     Allat => mkTag "All" ;
     Abess => mkTag "Abe" 
     } ;
-  tagNumber : Number -> Str = \n -> case n of {
+    
+  tagNumber : Number -> Tag = \n -> case n of {
     Sg => mkTag "Sg" ;
     Pl => mkTag "Pl"
     } ;
+    
+  tagDegree : Degree -> Tag = \n -> case n of {
+    Posit  => mkTag "Pos" ;
+    Compar => mkTag "Com" ;
+    Superl => mkTag "Sup"
+    } ;
+
+  tagPerson : Person -> Tag = \p -> case p of {
+    P1 => mkTag "Person1" ;
+    P2 => mkTag "Person2" ;
+    P3 => mkTag "Person3"
+    } ;
+
+  tagBool : Bool -> Tag = \b -> case b of {
+    True => "Pos" ;
+    False => "Neg"
+    } ;
+
 }