fetching DictFin words by Paradigms functions

lib/src/finnish/Kotus.gf

@@ -2,6 +2,8 @@
 
 resource Kotus = open MorphoFin, Prelude in {
 
+-- interpretations of paradigms in KOTUS word list, used in DictFin.
+
 oper vowelHarmony = vowHarmony ;
 
 oper
@@ -292,10 +294,10 @@ oper
     = c56A ; ----
   c78A : Str -> VForms -- 1 tuikkaa
     = c56A ; ----
-  c99 : Str -> {s : Str} -- 5453 öykkärimäisesti
-    = \s -> {s = s} ;
+  c99 : Str -> Str -- 5453 öykkärimäisesti
+    = \s -> s ;
 
-  c101 : Str -> {s : Str} -- pronouns etc
+  c101 : Str -> Str -- pronouns etc
     = c99 ; -- dummy
 
 -- compound nouns, latter part inflected

lib/src/finnish/ParadigmsFin.gf

@@ -69,6 +69,11 @@ oper
   postGenPrep :         Str -> Prep ;  -- genitive postposition, e.g. "takana"
   casePrep    : Case ->        Prep ;  -- just case, e.g. adessive
 
+  NK : Type ;   -- Noun from DictFin (Kotus)
+  AK : Type ;   -- Adjective from DictFin (Kotus)
+  VK : Type ;   -- Verb from DictFin (Kotus)
+  AdvK : Type ; -- Adverb from DictFin (Kotus)
+
 --2 Nouns
 
 -- The worst case gives ten forms.
@@ -97,6 +102,7 @@ oper
     mkN : (olo,n,a,na,oon,jen,ja,ina,issa,ihin : Str) -> N ; -- worst case, 10 forms
     mkN : (pika : Str) -> (juna  : N) -> N ; -- compound with invariable prefix
     mkN : (oma : N)    -> (tunto : N) -> N ; -- compound with inflecting prefix
+    mkN : NK -> N ;  -- noun from DictFin (Kotus)
   } ;
 
 -- Nouns used as functions need a case, of which the default is
@@ -131,6 +137,7 @@ oper
     mkA : N -> A ;    -- any noun made into adjective
     mkA : N -> (kivempi,kivin : Str) -> A ; -- deviating comparison forms
     mkA : (hyva,prmpi,pras : N) -> (hyvin,pmmin,prhten : Str) -> A ; -- worst case adj
+    mkA : AK -> A ;  -- adjective from DictFin (Kotus)
   } ;
 
 -- Two-place adjectives need a case for the second argument.
@@ -152,6 +159,7 @@ oper
     mkV : (huutaa,huusi : Str) -> V ; -- deviating past 3sg
     mkV : (huutaa,huudan,huusi : Str) -> V ; -- also deviating pres. 1sg
     mkV : (huutaa,dan,taa,tavat,takaa,detaan,sin,si,sisi,tanut,dettu,tanee : Str) -> V ; -- worst-case verb
+    mkV : VK -> V ;  -- verb from DictFin (Kotus)
   } ;
 
 -- All the patterns above have $nominative$ as subject case.
@@ -253,6 +261,12 @@ oper
     \c -> {c = NPCase c ; s = [] ; isPre = True ; lock_Prep = <>} ;
   accPrep =  {c = NPAcc ; s = [] ; isPre = True ; lock_Prep = <>} ;
 
+  NK = {s : NForms ; lock_NK : {}} ;
+  AK = {s : NForms ; lock_AK : {}} ;
+  VK = {s : VForms ; lock_VK : {}} ;
+  AdvK = {s : Str ; lock_AdvK : {}} ;
+
+
   mkN = overload {
     mkN : (talo : Str) -> N = mk1N ;
     --  \s -> nForms2N (nForms1 s) ;
@@ -267,6 +281,7 @@ oper
         : Str) -> N = mk10N ;
     mkN : (sora : Str) -> (tie : N) -> N = mkStrN ;
     mkN : (oma,tunto : N) -> N = mkNN ;
+    mkN : (sana : NK) -> N = \w -> nForms2N w.s ;
   } ;
 
   mk1A : Str -> A = \jalo -> aForms2A (nforms2aforms (nForms1 jalo)) ;
@@ -446,6 +461,8 @@ oper
     mkA : Str -> A  = mkA_1 ;
     mkA : N -> A = \n -> noun2adjDeg n ** {lock_A = <>} ;
     mkA : N -> (kivempaa,kivinta : Str) -> A = regAdjective ;
+    mkA : (sana : AK) -> A = \w -> noun2adjDeg (nForms2N w.s) ;
+
 --    mkA : (hyva,parempi,paras : N) -> (hyvin,paremmin,parhaiten : Str) -> A ;
   } ;
 
@@ -483,6 +500,7 @@ 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 = <>} ;
   } ;
 
   mk1V : Str -> V = \s -> 
@@ -566,7 +584,10 @@ oper
   caseV2 : V -> Case -> V2 = \v,c -> mk2V2 v (casePrep c) ; 
   dirV2 v = mk2V2 v accPrep ;
 
-  mkAdv : Str -> Adv = \s -> {s = s ; lock_Adv = <>} ;
+  mkAdv = overload { 
+    mkAdv : Str -> Adv = \s -> {s = s ; lock_Adv = <>} ;
+    mkAdv : AdvK -> Adv = \s -> {s = s.s ; lock_Adv = <>} ;
+    } ;
 
   mkV2 = overload {
     mkV2 : Str -> V2 = \s -> dirV2 (mk1V s) ;

lib/src/finnish/frequency/Freq.hs

@@ -1,11 +1,19 @@
-main = interact (unlines . map mkOne . lines)
+main = interact (unlines . concatMap (prEntry . mkOne) . lines)
+
+prEntry (f,c,w) = [
+   unwords [f, ":", c]
+
+  ]
 
 mkOne line = case words line of
-  _:_:_:w:c0:_ -> let c = cat c0 in unwords [mkId w ++ "_" ++ c, ":", c]
+  _:_:_:w:c0:_ -> let c = mkCat c0 in (mkFun w c, c, w, mkLin c)
   _ -> []
 
-cat c = case c of
-  "(adjektiivi)" -> "A"
+mkCat = fst . catlin
+mkLin = snd . catlin
+
+catlin c = case c of
+  "(adjektiivi)" -> "A", 
   "(adverbi)" -> "Adv"
   "(erisnimi)" -> "PN"
   "(interjektio)" -> "Interj"
@@ -18,6 +26,7 @@ cat c = case c of
   "(verbi)" -> "V"
   _ -> "Junk"
 
+mkFun w c = mkId w ++ "_" ++ c
 
 mkId = concatMap trim where
   trim c = case fromEnum c of

lib/src/finnish/kotus/Kotus.hs

@@ -113,8 +113,8 @@ mkRules e = do
 
 mkFun fun cat = unwords ["fun",fun,":",cat,";"]
 mkLin fun par w = case words par of
-  f@"compoundNK":p:v:_ -> unwords ["lin",fun,"=",f,v,"("++ p,quoted w ++")",";"]
-  _ -> unwords ["lin",fun,"=",par,quoted w,";"]
+  f@"compoundNK":p:v:_ -> unwords ["lin",fun,"=","{s","=",f,v,"("++ p,quoted w ++")}",";"]
+  _ -> unwords ["lin",fun,"=","{s","=",par,quoted w ++"}",";"]
 
 mkId = concatMap trim where
   trim c = case fromEnum c of

lib/src/finnish/kotus/prelDictFin

@@ -7,5 +7,5 @@ concrete DictFin of DictFinAbs = open MorphoFin, Kotus, Prelude in {
 
 flags coding = utf8 ;
 
-lincat NK = NForms ; AK = NForms ; VK = VForms ; AdvK = SS ;
+lincat NK = {s : NForms} ; AK = {s : NForms} ; VK = {s : VForms} ; AdvK = {s : Str} ;