ParadigmsFin.gf

--# -path=.:../abstract:../common:../../prelude

--1 Finnish Lexical Paradigms
--
-- Aarne Ranta 2003--2008
--
-- 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$.
--
-- The main difference with $MorphoFin.gf$ is that the types
-- referred to are compiled resource grammar types. We have moreover
-- had the design principle of always having existing forms, rather
-- than stems, as string arguments of the paradigms.
--
-- The structure of functions for each word class $C$ is the following:
-- there is a polymorphic constructor $mkC$, which takes one or
-- a few arguments. In Finnish, one argument is enough in 80-90% of
-- cases in average.

resource ParadigmsFin = Kotus ** open
  (Predef=Predef),
  Prelude,
  MorphoFin,
  CatFin, StemFin
  in {

  flags optimize=noexpand ;
    coding=utf8 ;

--2 Parameters
--
-- 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 $ResFin$.

oper
  Number   : Type ;

  singular : Number ;
  plural   : Number ;

  Case        : Type ;
  nominative  : Case ; -- e.g. "talo"
  genitive    : Case ; -- e.g. "talon"
  partitive   : Case ;  -- e.g. "taloa"
  essive      : Case ;  -- e.g. "talona"
  translative : Case ;  -- e.g. "taloksi"
  inessive    : Case ;  -- e.g. "talossa"
  elative     : Case ;  -- e.g. "talosta"
  illative    : Case ;  -- e.g. "taloon"
  adessive    : Case ;  -- e.g. "talolla"
  ablative    : Case ;  -- e.g. "talolta"
  allative    : Case ; -- e.g. "talolle"

  infFirst : InfForm ; -- e.g. "tehdä"
  infIness : InfForm ; -- e.g. "tekemässä"
  infElat  : InfForm ; -- e.g. "tekemästä"
  infIllat : InfForm ; -- e.g. "tekemään"
  infAdess : InfForm ; -- e.g. "tekemällä"
  infPart  : InfForm ; -- e.g. "tekemistä"
  infPresPart : InfForm ; -- e.g. "tekevän"
  infPresPartAgr : InfForm ; -- e.g. "tekevänsä"

-- The following type is used for defining *rection*, i.e. complements
-- of many-place verbs and adjective. A complement can be defined by
-- just a case, or a pre/postposition and a case.

  prePrep     : Case -> Str -> Prep ;  -- preposition, e.g. partitive "ilman"
  postPrep    : Case -> Str -> Prep ;  -- postposition, e.g. genitive "takana"
  postGenPrep :         Str -> Prep ;  -- genitive postposition, e.g. "takana"
  casePrep    : Case ->        Prep ;  -- just case, e.g. adessive

  mkPrep = overload {
    mkPrep : Case -> Prep  -- inessive
     = casePrep ;
    mkPrep : Str -> Prep   -- kanssa
     = postGenPrep ;
    mkPrep : Case -> Str -> Prep  -- genitive kanssa
     = postPrep ;
    mkPrep : Str -> Case -> Prep  -- ilman partitive
     = \s,c -> prePrep c s ;
    mkPrep : Str -> Case -> Str -> Prep  -- yhdessä genitive kanssa
     = \s,c,t -> lin Prep {c = NPCase c ; s = <s,t,\\_ => []>}
    } ;

  accusative : Prep
    = lin Prep {c = NPAcc ; s = <[],[],\\_ => []>} ;

  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.
-- In practice just a couple of forms are needed to define the different
-- stems, vowel alternation, and vowel harmony.

oper

-- The regular noun heuristic takes just one form (singular
-- nominative) and analyses it to pick the correct paradigm.
-- It does automatic grade alternation, and is hence not usable
-- for words like "auto" (whose genitive would become "audon").
--
-- If the one-argument paradigm does not give the correct result, one can try and give
-- two or three forms. Most notably, the two-argument variant is used
-- for nouns like "kivi - kiviä", which would otherwise become like
-- "rivi - rivejä". Three arguments are used e.g. for
-- "auto - auton - autoja", which would otherwise become
-- "auto - audon".

  mkN : overload {
    mkN : (kukko : Str) -> N ;  -- predictable nouns, covers 82%
    mkN : (savi,savia : Str) -> N ; -- different pl.part
    mkN : (vesi,veden,vesiä : Str) -> N ; -- also different sg.gen
    mkN : (vesi,veden,vesiä,vettä : Str) -> N ; -- also different sg.part
    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)
    mkN : V -> N ;   -- verbal noun: "tekeminen"
  } ;

-- Verban nouns of type "tekeminen"

    verbalN : V -> N   -- tekeminen
      = \v -> mkN (v.s ! (Inf Inf4Nom)) ;

-- Some nouns are regular except for the singular nominative (e.g. "mies").

    exceptNomN : N -> Str -> N ;

-- Some nouns have special, or variant, plural genitives (e.g. "valta" - "valtojen"|"valtain").

    exceptPlGenN : N -> Str -> N ;

-- Nouns where the parts are separate (should perhaps be treated as CN)

   separateN = overload {
     separateN : Str -> N -> N
      = \s,n -> mkN (s + "_") n ;
     separateN : N -> N -> N
      = \oma, asunto -> lin N {s = \\c => oma.s ! c + "_" + asunto.s ! c ; h = asunto.h} ;
      } ;

   compN : N -> N -> N = \valkuainen,aine -> aine ** {
     s = \\c => (StemFin.snoun2nounBind valkuainen).s ! NCompound + aine.s ! c
     } ;

   genCompN = overload {
     genCompN : N -> N -> N = genitiveCompoundN Sg ;
     genCompN : Number -> N -> N -> N = genitiveCompoundN
     } ;

   genitiveCompoundN : Number -> N -> N -> N = \n,veri,paine -> paine ** {
     s = \\c => (StemFin.snoun2nounBind veri).s ! NCase n Gen + paine.s ! c
     } ;

   foreignN : Str -> N ; -- foreign word without Finnish alternations, e.g. sake/saken/sakeja

-- Nouns used as functions need a case, of which the default is
-- the genitive.

  mkN2 : overload {
    mkN2 : N -> N2 ;        -- relational noun with genitive
    mkN2 : N -> Prep -> N2  -- relational noun another prep.
    } ;

  mkN3  : N -> Prep -> Prep -> N3 ; -- relation with two complements

-- Proper names can be formed by using declensions for nouns.
-- The plural forms are filtered away by the compiler.

  mkPN : overload {
    mkPN : Str -> PN ;  -- predictable noun made into name
    mkPN : N -> PN      -- any noun made into name
    } ;

-- A special function for foreign names: no grade alternation, no final aspiration.

  foreignPN : Str -> PN ; -- Dieppe-Dieppen

-- To inspect the number of an NP

  ifPluralNP : NP -> Bool  -- False if singular, True if plural
    = \np -> case np.a of {
      Ag Pl _ => True ;
      _ => False
      } ;

-- To force a number on NP

  forceNumberNP : Number -> NP -> NP  -- e.g. Yhdysvallat plural in form, singular in agreement
    = \n,np -> np ** {a = agrP3 n} ; --- also forces 3rd person

--2 Adjectives

-- Non-comparison one-place adjectives are just like nouns.
-- The regular adjectives are based on $regN$ in the positive.
-- 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 (except for the superlative "paras" of "hyvä").

  mkA : overload {
    mkA : Str -> A ;  -- regular noun made into adjective
    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)
  } ;

  invarA : Str -> A  -- invariant adjective, e.g. "kelpo"
    = \s -> lin A {s = \\_,_ => s ; h = Back ; p = [] ; hasPrefix = False} ; ----- stemming adds bogus endings

  compoundA : Str -> A -> A  -- prefix glued to adjective, e.g. "hevos"+"vetoinen"
    = \s,a -> lin A {s = \\d,c => s + a.s ! d ! c  ; h = a.h ; p = s + a.p ; hasPrefix = a.hasPrefix} ;

  prefixA : Str -> A -> A -- in modifying use, an uninflected glued prefix, e.g. "sähkö" for "sähköinen"
    = \pr,a -> a ** {
      p = pr ;
      hasPrefix = True
      } ;

-- Two-place adjectives need a case for the second argument.

  mkA2 = overload {
    mkA2 : Str -> A2  -- e.g. "vihainen" (jollekin)
      = \a -> let adj = mkA a ;
               in lin A2 (adj ** {c2 = casePrep allative}) ;
    mkA2 : Str -> Prep -> A2  -- e.g. "jaollinen" (mkPrep adessive)
    = \a,p ->  let adj = mkA a in lin A2 (adj ** {c2=p}) ;
    mkA2 : A -> Prep -> A2  -- e.g. "jaollinen" (mkPrep adessive)
    = \a,p -> lin A2 (a ** {c2 = p}) ;
    } ;


--2 Verbs
--
-- The grammar does not cover the potential mood and some nominal
-- forms. One way to see the coverage is to linearize a verb to
-- a table.
-- The worst case needs twelve forms, as shown in the following.

  mkV : overload {
    mkV : (huutaa : Str) -> V ;     -- predictable verbs, covers 90%
    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)
    mkV : V -> Str -> V ; -- hakata päälle (particle verb)
    mkV : Str -> V -> V ; -- laimin+lyödä (prefixed verb)
  } ;

-- All the patterns above have $nominative$ as subject case.
-- If another case is wanted, use the following.

  caseV : Case -> V -> V ;  -- deviating subj. case, e.g. genitive "täytyä"

-- The verbs "be" is special.

  vOlla : V ; -- the verb "be"

  olla_V : V
   = vOlla ;

--3 Two-place verbs
--
-- Two-place verbs need an object case, and can have a pre- or postposition.
-- The default is direct (accusative) object. There is also a special case
-- with case only. The string-only argument case yields a regular verb with
-- accusative object.

  mkV2 : overload {
    mkV2 : Str -> V2 ;  -- predictable direct transitive
    mkV2 : Str -> Case -> V2 ;  -- predictable with another case
    mkV2 : V -> V2 ;    -- direct transitive
    mkV2 : V -> Case -> V2 ; -- complement just case
    mkV2 : V -> Prep -> V2 ; -- complement pre/postposition
    mkV2 : VK -> V2 ;    -- direct transitive of Kotus verb
    } ;


--3 Three-place verbs
--
-- Three-place (ditransitive) verbs need two prepositions, of which
-- the first one or both can be absent.

  mkV3 = overload {
   mkV3 : Str -> V3
     = \s -> dirdirV3 (mkV s) ;
   mkV3 : V -> V3
     = \v -> dirdirV3 v ;
   mkV3 : V -> Prep -> Prep -> V3  -- e.g. puhua, allative, elative
     = \v,p,q -> v ** {c2 = p ; c3 = q ; lock_V3 = <>} ;
   } ;

  dirV3    : V -> Case -> V3 ;          -- siirtää, (accusative), illative
  dirdirV3 : V         -> V3 ;          -- antaa, (accusative), (allative)


--3 Other complement patterns
--
-- Verbs and adjectives can take complements such as sentences,
-- questions, verb phrases, and adjectives.

mkVV = overload {
  mkVV : Str -> VV   -- e.g. "yrittää" (puhua)
   = \s -> mkVVf (mkV s) infFirst ;
  mkVV : V -> VV     -- e.g. "alkaa" (puhua)
   = \v -> mkVVf v infFirst ;
  mkVV : Str -> InfForm -> VV  -- e.g. "ruveta" (puhumaan)
   = \s,i -> mkVVf (mkV s) i ;
  mkVV : V -> InfForm -> VV  -- e.g. "lakata" (puhumasta)
   = \v,i -> mkVVf v i ;
  } ;

mkVS = overload {
  mkVS : Str -> VS   -- e.g. "väittää"
   = \s -> lin VS (mk1V s) ;
  mkVS : V -> VS     -- e.g. "sanoa"
   = \v -> lin VS v ;
  } ;

  mkV2V = overload {
    mkV2V : Str -> V2V  -- reg verb, partitive + infIllat
     = \s -> mkV2Vf (mkV s) (casePrep partitive) infIllat ; ----
    mkV2V : V -> V2V    -- partitive + infillat
     = \v -> mkV2Vf v (casePrep partitive) infIllat ; ----
    mkV2V : V -> Prep -> V2V  -- e.g. "käskeä" genitive + infFiilat
     = \v,p -> mkV2Vf v p infIllat ;
    mkV2V  : V -> Prep -> InfForm -> V2V -- e.g. "kieltää" partitive infElat
     = \v,p,f -> mk2V2 v p ** {vi = infform2vvtype f ; lock_V2V = <>} ;
    mkV2V  : V -> Case -> InfForm -> V2V
     = \v,c,f -> mk2V2 v (casePrep c) ** {vi = infform2vvtype f ; lock_V2V = <>} ;
    } ;

  mkV0  : V -> V0 ; --%

  mkV2S : V -> Prep -> V2S ; -- e.g. "sanoa" allative
  mkVVf : V -> InfForm -> VV ; -- e.g. "ruveta" infIllat
  mkV2Vf : V -> Prep -> InfForm -> V2V ; -- e.g. "kieltää" partitive infElat
  mkVA  : V -> Prep -> VA ; -- e.g. "maistua" ablative
  mkV2A : V -> Prep -> Prep -> V2A ; -- e.g. "maalata" accusative translative
  mkVQ  : V -> VQ ;
  mkV2Q : V -> Prep -> V2Q ; -- e.g. "kysyä" ablative

  mkAS  : A -> AS ; --%
---  mkA2S : A -> Prep -> A2S ; --%
  mkAV  : A -> AV ; --%
---  mkA2V : A -> Prep -> A2V ; --%

-- Notice: categories $AS, A2S, AV, A2V$ are just $A$,
-- and the second argument is given
-- as an adverb. Likewise
-- $V0$ is just $V$.

  V0 : Type ; --%
  AS, A2S, AV, A2V : Type ; --%

--2 Structural categories

  mkAdV : Str -> AdV
   = \s -> lin AdV (ss s) ;
  mkAdA : Str -> AdA
   = \s -> lin AdA (ss s) ;
  mkAdN : Str -> AdN
   = \s -> lin AdN (ss s) ;
  mkPConj : Str -> PConj
   = \s -> lin PConj (ss s) ;
  mkSubj : Str -> Subj
   = \s -> lin Subj (ss s) ;

  mkPredet : Str -> Predet  -- invariable Predet, such as "vain"
   = \s -> lin Predet {s = \\_,_ => s} ;

  mkConj = overload {
   mkConj : Str -> Conj
   = \y -> {s1 = [] ; s2 = y ; n = Pl ; lock_Conj = <>} ;
   mkConj : Str -> Str -> Conj
   = \x,y -> {s1 = x ; s2 = y ; n = Pl ; lock_Conj = <>} ;
   mkConj : Str -> Str -> Number -> Conj
   = \x,y,n -> {s1 = x ; s2 = y ; n = n ; lock_Conj = <>} ;
   } ;

  mkDet = overload {
    mkDet : Number -> N -> Det
    = \nu,noun -> lin Det (MorphoFin.mkDet nu (snoun2nounBind noun)) ;
    mkDet : (isNeg : Bool) -> Number -> N -> Det  -- use this with True to create a negative determiner
    = \isNeg,nu,noun -> lin Det (MorphoFin.mkDetPol isNeg nu (snoun2nounBind noun)) ;
    mkDet : (isNeg : Bool) -> Number -> N -> Case -> Det  -- paljon + False + partitive, ei yhtään + True + partitive
    = \isNeg,nu,noun,c -> case c of {
      Part => lin Det (MorphoFin.mkDetPol isNeg nu (snoun2nounBind noun)) ** {isNum = True} ; --- works like "kolme autoa"
      _ => lin Det (MorphoFin.mkDetPol isNeg nu (snoun2nounBind noun)) ---- are there other cases?
      } ;
    mkDet : Str -> Det -> Det -- add a string to a Det, e.g. "suunnilleen jokainen"
      = \s,det -> det ** {s1 = \\c => s ++ det.s1 ! c} ;
    } ;

  mkQuant = overload {
    mkQuant : N -> Quant =
      \noun -> heavyQuant {s1 = \\n,c => (snoun2nounBind noun).s ! NCase n c ; s2 = \\_ => [] ; isNum,isPoss,isNeg,isDef = False} ;
    mkQuant : N -> N -> Quant =
      \sg,pl -> heavyQuant {s1 = table {Sg => \\c => (snoun2nounBind pl).s ! NCase Sg c ; Pl => \\c => (snoun2nounBind pl).s ! NCase Pl c} ;
                            s2 = \\_ => [] ; isNum,isPoss,isNeg,isDef = False} ;
    } ;

  mkInterj : Str -> Interj
    = \s -> lin Interj {s = s} ;

--.
-- THE definitions should not bother the user of the API. So they are
-- hidden from the document.

  Case = MorphoFin.Case ;
  Number = MorphoFin.Number ;

  male = Male ;
  female = Female ;

  singular = Sg ;
  plural = Pl ;

  nominative = Nom ;
  genitive = Gen ;
  partitive = Part ;
  translative = Transl ;
  inessive = Iness ;
  essive  = Ess ;
  elative = Elat ;
  illative = Illat ;
  adessive = Adess ;
  ablative = Ablat ;
  allative = Allat ;

  infFirst = Inf1 ;
  infElat = Inf3Elat ; infIllat = Inf3Illat ;
  infIness = Inf3Iness ; infAdess = Inf3Adess ;
  infPart = Inf4Part ;
  infPresPart = InfPresPart ; infPresPartAgr = InfPresPartAgr ;

  prePrep  : Case -> Str -> Prep =
    \c,p -> lin Prep {c = NPCase c ; s = <tagFeature (tagPOS "ADP" p) "AdvType" "Pre", [],\\_ => []>} ; -- no possessive suffix

  postPrep : Case -> Str -> Prep =
    \c,p ->
       let
         h = guessHarmony p ;
         a2p : Agr => Str = case c of {
           Gen => \\a => p ++ possSuffixGen h a ;
           _ => \\a => p
           } ;
	 pt = tagFeature (tagPOS "ADP" p) "AdvType" "Post" ;
       in case p of {
         mukaa + "n" => lin Prep {c = NPCase c ; s = <[],pt, a2p>} ; ---- p --> mukaa
         _           => lin Prep {c = NPCase c ; s = <[],pt, a2p>}
         } ;

  postGenPrep = postPrep genitive ;

  casePrep : Case -> Prep =
    \c -> lin Prep {c = NPCase c ; s = <[],[],\\_ => []>} ;

  accPrep : Prep =
    lin Prep {c = NPAcc ; s = <[],[],\\_ => []>} ;

  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 -> nforms2snoun (nForms1 s) ;
    mkN : (talo,taloja : Str) -> N = mk2N ;
    --  \s,t -> nforms2snoun (nForms2 s t) ;
    mkN : (talo,talon,taloja : Str) -> N = mk3N ;
    --  \s,t,u -> nforms2snoun (nForms3 s t u) ;
    mkN : (talo,talon,taloja,taloa : Str) -> N = mk4N ;
    --  \s,t,u,v -> nforms2snoun (nForms4 s t u v) ;
    mkN :
      (talo,talon,taloa,talona,taloon,talojen,taloja,taloina,taloissa,taloihin
        : Str) -> N = mk10N ;
    mkN : (sora : Str) -> (tie : N) -> N = mkStrN ;
    mkN : (oma,tunto : N) -> N = mkNN ;
    mkN : (sana : NK) -> N = \w -> lin N (nforms2snoun w.s) ;
    mkN : V -> N = \w -> lin N (sverb2snoun w) ;
  } ;

    exceptNomN : N -> Str -> N = \noun,nom -> lin N (exceptNomSNoun noun nom) ;
    exceptPlGenN : N -> Str -> N = \noun,nom -> lin N (exceptPlGenSNoun noun nom) ;

----  mk1A : Str -> A = \jalo -> aForms2A (nforms2aforms (nForms1 jalo)) ;
----  mkNA : N -> A = snoun2sadj ;

  mk1N : (talo : Str) -> N = \s -> lin N (nforms2snoun (nForms1 s)) ;

  -- Best results for 2-argument smart paradigm come with Pl Part as second argument.
  -- But we allow Sg Gen + Pl Nom as well, since they could be common mistakes.
  -- For other numbers and cases as the 2nd argument, see mk2Nsg{Gen,Par,Ill} (hidden from API).
  mk2N : (talo,taloja : Str) -> N = \s,t -> case t of {
    sydame + "n" => mk2NsgGen s t ;            -- Sg Gen
    sydame + "t" => mk2NsgGen s (sydame+"n") ; -- Pl Nom
    _ => lin N (nforms2snoun (nForms2 s t))    -- Default: Pl Par
  } ;

  -- When we have access to the some other form than plural partitive, e.g. from some dump of lemmatised nouns
  mk2NsgGen : (talo,talon : Str) -> N =
    \sgnom,sggen -> lin N (nforms2snoun (nForms2sgGen sgnom sggen)) ;
  mk2NplGen : (talo,talojen : Str) -> N =
    \sgnom,plgen -> lin N (nforms2snoun (nForms2plGen sgnom plgen)) ;
  mk2NsgPar : (talo,taloa : Str) -> N =
    \sgnom,sgpar -> lin N (nforms2snoun (nForms2sgPar sgnom sgpar)) ;
  mk2NsgIll : (talo,taloon : Str) -> N =
    \sgnom,sgill -> lin N (nforms2snoun (nForms2sgIll sgnom sgill)) ;


  mk3N : (talo,talon,taloja : Str) -> N = \s,t,u -> lin N (nforms2snoun (nForms3 s t u)) ;
  mk4N : (talo,talon,taloa,taloja : Str) -> N = \s,t,u,v ->
      lin N (nforms2snoun (nForms4 s t u v)) ;
  mk10N :
      (talo,talon,taloa,talona,taloon,talojen,taloja,taloina,taloissa,taloihin
        : Str) -> N = \a,b,c,d,e,f,g,h,i,j ->
        lin N (nforms2snoun (nForms10 a b c d e f g h i j)) ;

  mkSeparateN : Str -> N -> N = \unissa,kulkija -> {
    s = \\c => unissa ++ kulkija.s ! c ;
    h = kulkija.h ;
    lock_N = <>
    } ;
  mkStrN : Str -> N -> N = \sora,tie -> {
    s = \\c => sora + tie.s ! c ;
    h = tie.h ;
    lock_N = <>
    } ;
  mkNN : N -> N -> N = \oma,tunto -> {
    s = \\c => oma.s ! c + tunto.s ! c ;
    h = tunto.h ;
    lock_N = <>
    } ; ---- TODO: oma in possessive suffix forms

  nForms1 : Str -> NForms = \ukko ->
    let
      ukk = init ukko ;
      uko = weakGrade ukko ;
      ukon = uko + "n" ;
      o = case last ukko of {"ä" => "ö" ; "a" => "o"} ; -- only used then
      renka = strongGrade (init ukko) ;
      rake = strongGrade ukko ;
    in
    case ukko of {
      _ + "nen" => dNainen ukko ;
      _ + ("aa" | "ee" | "ii" | "oo" | "uu" | "yy" |"ää"|"öö") => dPuu ukko ;
      _ + ("ai" | "ei" | "oi" | "ui" | "yi" | "äi" | "öi") => dPuu ukko ;
      _ + ("ie" | "uo" | "yö") => dSuo ukko ;
      _ + ("ea" | "eä") => dKorkea ukko ;
      _ + "is" => dKaunis ukko ;
      _ + ("ai" | "ui" | "äi") + "n" => dLiitin ukko (ukk + "men") ;
      _ + ("i" | "u") + "n" => dLiitin ukko (renka + "men") ;
      _ + ("ton" | "tön") => dOnneton ukko ;
      _ + "e" => dRae ukko (rake + "en") ;
      _ + ("ut" | "yt") => dOttanut ukko ;
      _ + ("as" | "äs") => dRae ukko (renka + last renka + "n") ;
      _ + ("uus" | "yys" | "eus" | "eys") => dLujuus ukko ;
      _ + "s" => dJalas ukko ;

-- {- heuristics for 3-syllable nouns ending a/ä
      _ + ("a" | "e" | "i" | "o" | "u" | "y" | "ä" | "ö") + ? +
          _ + "i" + ? + a@("a" | "ä") =>
          dSilakka ukko (ukko + "n") (ukk + o + "it" + a) ;  -- pesijä
      _ + ("a" | "e" | "i" | "o" | "u" | "y" | "ä" | "ö") + ? + _ +
          ("a" | "e" | "o" | "u" | "y" | "ä" | "ö") +
          ("l" | "r" | "n") + a@("a" | "ä") =>
          dSilakka ukko (ukko + "n") (ukk + o + "it" + a) ;  -- sarana, omena
      _ + ("a" | "e" | "i" | "o" | "u" | "y" | "ä" | "ö") + ? + _ +
          ("a" | "e" | "i" | "o" | "u" | "y" | "ä" | "ö") +
          ("n" | "k" | "s") + "k" + a@("a" | "ä") =>
          dSilakka ukko (uko + "n") (init uko + o + "it" + a) ;  -- silakka
      _ + ("a" | "e" | "i" | "o" | "u" | "y" | "ä" | "ö") + ? + _ +
          ("a" | "e" | "i" | "o" | "u" | "y" | "ä" | "ö") +
          ("n" | "t" | "s") + "t" + a@("a" | "ä") =>
          dSilakka ukko (uko + "n") (ukk + o + "j" + a) ;  -- yhdyntä (but not isäntä)
      _ + ("a" | "e" | "i" | "o" | "u") + ? + _ +
          ("a" | "e" | "o" | "u") + ? + "a" =>
          dSilakka ukko (ukko + "n") (ukk + "ia") ;  -- asema, johtaja
-- -}
      _ + "i" +o@("o"|"ö") => dSilakka ukko (ukko+"n") (ukko+"it"+getHarmony o);
      _ + "i" + "a" => dSilakka ukko (ukko + "n") (ukk + "oita") ;
      _ + "i" + "ä" => dSilakka ukko (ukko + "n") (ukk + "öitä") ;
      _ + ("a" | "o" | "u" | "y" | "ä" | "ö") => dUkko ukko ukon ;
      _ + "i" => dPaatti ukko ukon ;
      _ + ("ar" | "är") => dPiennar ukko (renka + "ren") ;
      _ + "e" + ("l" | "n") => dPiennar ukko (ukko + "en") ;
      _ => dUnix ukko
    } ;


    nForms2 : (_,_ : Str) -> NForms = \ukko,ukkoja ->
      let
        ukot = nForms1 ukko ;
        ukon = weakGrade ukko + "n" ;
      in
      case <ukko,ukkoja> of {
        <_, _ + ":" + ? + ("a" | "ä")> => dSDP ukko ;
        <_ + "ea", _ + "oita"> =>
          dSilakka ukko ukon ukkoja ;  -- idea, but not korkea
        <_ + ("aa" | "ee" | "ii" | "oo" | "uu" | "yy" | "ää" | "öö" |
              "ie" | "uo" | "yö" | "ea" | "eä" |
              "ia" | "iä" | "io" | "iö"), _ + ("a" | "ä")> =>
          nForms1 ukko ; --- to protect --- how to get "dioja"?
        <_ + ("a" | "ä" | "o" | "ö"), _ + ("a" | "ä")> =>
          dSilakka ukko ukon ukkoja ;
        <arp + "i", _ + "i" + ("a" | "ä")> =>
          dArpi ukko (init (weakGrade ukko) + "en") ;
        <_ + "i", _ + ("eita" | "eitä")> =>
          dTohtori ukko ;
        <_ + ("ut" | "yt"),_ + ("uita" | "yitä")>  => dRae ukko (init ukko + "en") ;
        <_ + "e", nuk + ("eja" | "ejä")> =>
          dNukke ukko ukon ;
        <_ + "s", _ + "ksi" + ?> => dJalas ukko ;
        <_ + ("l" | "n" | "r" | "s"), _ + ("eja" | "ejä")> => dUnix ukko ;
        <_, _ + ("a" | "ä")> => ukot ;
        _ =>
          Predef.error
           (["last argument should end in a/ä, not"] ++ ukkoja)
      } ;

    nForms3 : (_,_,_ : Str) -> NForms = \ukko,ukon,ukkoja ->
      let
        ukk = init ukko ;
        ukot = nForms2 ukko ukkoja ;
      in
      case <ukko,ukon,ukkoja> of {
        <muk + "i", muk_ + "in",
         muk__ + "ej" + ("a"|"ä")> -- don't match voi - voin - voita
           => dPaatti ukko ukon ;  -- 1-arg paradigm forces consonant gradation
        <_, _ + ":n"> => dSDP ukko ;
        <_ + ("aa" | "ee" | "ii" | "oo" | "uu" | "yy" | "ää" | "öö" |
              "ie" | "uo" | "yö" | "ea" | "eä" |
              "ia" | "iä" | "io" | "iö" | "ja" | "jä"), _ + "n"> =>
           ukot ; --- to protect
        <_ + ("a" | "o" | "u" | "y" | "ä" | "ö"), _ + "n"> =>
          dSilakka ukko ukon ukkoja ;  -- auto,auton
        <_ + "mpi", _ + ("emman" | "emmän")> => dSuurempi ukko ;
        <_ + "in", _ + ("imman" | "immän")> => dSuurin ukko ;
        <lämm + "in", lämpi + ("man"|"män")> => dLämmin ukko ukon ;
        <terv + "e", terv2 + "een"> => -- was nonlinear
          dRae ukko ukon ;
        <taiv + ("as" | "äs"), taiv2 + ("aan" | "ään")> =>  -- was nonlinear
          dRae ukko ukon ;
        <nukk + "e", nuk + "een"> => dRae ukko ukon ;
        <arp + "i", arv + "en"> => dArpi ukko ukon ;
        <_ + ("us" | "ys"), _ + "den"> => dLujuus ukko ;
        <laid + ("u"|"a"|"ä") + "n", laitu + "men">
          => dLiitin ukko ukon ; -- laidun,hapan,sydän not caught in previous
        <_, _ + "n"> => ukot ;
        _ =>
          Predef.error (["second argument should end in n, not"] ++ ukon)
       } ;

    nForms4 : (_,_,_,_ : Str) -> NForms = \ukko,ukon,ukkoja,ukkoa ->
      let
        ukot = nForms3 ukko ukon ukkoja ;
      in
      case <ukko,ukon,ukkoja,ukkoa> of {
        <_,_ + "n", _ + ("a" | "ä"), _ + ("a" | "ä")> =>
          table {
            2 => ukkoa ;
            n => ukot ! n
          } ;
        _ =>
          Predef.error
            (["last arguments should end in n, a/ä, and a/ä, not"] ++
            ukon ++ ukkoja ++ ukkoa)
      } ;

--- this is used by a mkN instance hidden from the API. Like nForms2, but the second argument is actually singular genitive
  nForms2sgGen : (sydan,sydamen : Str) -> NForms = \sydan,sydamen ->
    let
      regSydan : NForms = nForms1 sydan ;
      regSydamen : Str = regSydan ! 1 ; -- SgGen from NForms constructed of only SgNom
    in
    case (pbool2bool (Predef.eqStr sydamen regSydamen)) of {
      True => regSydan ; -- singular genitive was as predicted by 1-arg paradigm
      _  => case <sydan,sydamen> of {
              <_ + "s",         _ + "ksen"> => dJalas sydan ;
              <_ + "s",         _ + "den"> => dLujuus sydan ;
              <_ + "s",         _ + "hen"> => d42 sydan ;
              <_ + ("as"|"äs"), _ + ("aan"|"ään")> => dRae sydan sydamen ;
              <_ + "n",         _ + "men"> => dLiitin sydan sydamen ;
              <_ + "in",        _ + ("imman"|"immän")> => dSuurin sydan ;
              <_ + "in",        _ + ("man"|"män")> => dLämmin sydan sydamen ;
              <_ + "i",         _ + "en"> => dArpi sydan sydamen ;
              <_ + "mpi",       _ + ("emman" | "emmän")> => dSuurempi sydan ;
              <_ + "e",         _ + "een"> => dRae sydan sydamen ;
              <_ + "e",         _ + "en"> => dNukke sydan sydamen ;
              <_ + "ut",        _ + "een"> => dOttanut sydan ;  -- kuollut, kuolleen
              <_ + "ut",        _ + "en"> => dRae sydan sydamen ; -- olut, oluen
              <_,               _ + ":n"> => dSDP sydan ;
              <_ + #consonant,  _ + #consonant + "in"> => dUnix sydan ;
              _ => table { -- TODO: see what cases still fail and if SgGen helps
                1 => sydamen ;
                x => regSydan ! x }
           }
      } ;

  -- like nForms2, but 2nd argument is Pl Genitive
  nForms2plGen : (sydan,sydanten : Str) -> NForms = \sydan,sydanten ->
    table {
      5 => sydanten ; -- insert the given Sg Par form in the table
      n => guessedSydan ! n} -- otherwise, use the guessed forms
    where {
      a : Str = case guessHarmony sydan of {
        Back => "a" ; Front => "ä" } ;
      sydamia : Str = case <sydan,sydanten> of {
        <_ + "n",    syda + "nten">   => syda + "mi" + a ;
        <_ + "r",    sisa + "rten">   => sisa + "ri" + a ;
        <_ + "l",    omme + "lten">   => strongGrade omme + "li" + a ; -- very ad hoc
        <lap + "si", la + "sten">     => lap + "si" + a ; -- veit + si + ä
        <_ + "i",    pien + "ten">    => pien + "i" + a ;
        <_ + "nen",  nai + "sten">    => nai + "si" + a ;
        <_ + "s",    vastau + "sten"> => vastau + "ksi" + a ;
        <_ + "mpi",  vanhe + "mpien"> => vanhe + "mpi" + a ;
        <_ + "i",    rist + "ien">    => rist + "ej" + a ; -- no way to distinguish between ovi and risti here; choosing risti because it's more common
        <_, kalleuks + "ien">         => kalleuks + "i" + a ;
        <_, valtioi + ("den"|"tten")> => valtioi + "t" + a ;
        <_, palvelu + "jen">          => palvelu + "j" + a ;
        _ => Predef.error ("nForms2plGen: Expected Pl Gen, got" ++ sydanten) } ;
      guessedSydan : NForms = nForms2 sydan sydamia ;
    } ;

  -- like nForms2, but 2nd argument is Sg Partitive
  nForms2sgPar : (sydan,sydanta : Str) -> NForms = \sydan,sydanta ->
    table {
      2 => sydanta ; -- insert the given Sg Par form in the table
      n => guessedSydan ! n} -- otherwise, use the guessed forms
    where {
      -- a couple of guesses for genitive
      oven : Str = init sydan + "en" ;            --  ov|i|  -> |en|
      kynnen : Str = init (init sydan) + "nen" ;  -- kyn|si| -> |nen|
      r : Str = case last sydan of {"n" => "m" ; x => x} ; -- gen stem consonant for piennar, liitin
      pientaren : Str = strongGrade (init sydan) + r + "en" ;

      -- then we form a full paradigm with a genitive guessed from the SgNom+SgPar
      guessedSydan : NForms = case <sydan,sydanta> of {
        <_ + "i", _ + ("ea"|"eä")> => dArpi sydan oven ;
        <_ + "e", _ + ("ea"|"eä")> => dNukke sydan (sydan + "n") ;
        <_ + "nsi", _ + "ntt" + ("a"|"ä")> => dArpi sydan kynnen ;
        <_ + ("psi"|"tsi"), _ + ("sta"|"stä")> => dArpi sydan oven ; -- laps|i|->|en|,  veits|i|->|en|
        <_ + "i", _ + ("nta"|"ntä")> => dArpi sydan oven ;
        <_ + "r", _ + ("rta"|"rtä")> => dPiennar sydan pientaren ;
        <_ + ("on"|"ön"), _ + ("nta"|"ntä")> => dOnneton sydan ;
        <_ + "in", _ + ("nta"|"ntä")> => dLiitin sydan pientaren ; -- can't distinguish between dLämmin or dLiitin from Sg Par only
        <_ + "s", ("sta"|"stä")> => dJalas sydan ;
        <_ + ("us"|"ys"), ("tta"|"ttä")> => dLujuus sydan ; -- can't distinguish between dLujuus and dKaunis from Sg Par only
        <_ + "s"        , ("tta"|"ttä")> => dKaunis sydan ;
        <_ + "t"        , ("tta"|"ttä")> => dRae sydan oven ; -- olu|t| -> |en| — can't distinguish between kuollut and olut
        <_ + #consonant, _ + #consonant + ("ia"|"iä")> => dUnix sydan ;
        <_, _ + ":" + ("ta"|"tä"|"aa"|"ää")> => dSDP sydan ;
        _ => nForms1 sydan }
      } ;

  -- like nForms2, but 2nd argument is Sg Illative
  nForms2sgIll : (sydan,sydameen : Str) -> NForms = \sydan,sydameen ->
    table {
      4 => sydameen ; -- insert the given Sg Ill form in the table
      n => guessedSydan ! n} -- otherwise, use the guessed forms
    where {
      -- a couple of guesses for genitive
      oven : Str = init (init sydameen) + "n" ; -- keep grade from Ill: ove|en| -> ove|n| ; liittime|en| -> liittime|n|
      käden : Str = weakGrade (init (init sydameen)) + "n" ; -- weaken grade from Ill: kä|tee|n  -> kä|de|n
      rakeen : Str = strongGrade sydan + "en" ;              -- strong grade from Nom: ra||e -> ra|k|e+en

      guessedSydan : NForms = case <sydan,sydameen> of {
        <_ + ("aa"|"ää"|"uu"|"yy"|"oo"|"öö"),
                   _ + "seen"> => dPaluu sydan ;
        <_ + "si", _ + "teen"> => dArpi sydan käden ; -- käsi, kynsi
        <_ + "i",  _ + "een"> => dArpi sydan oven ; -- ovi, lapsi, virsi
        <_ + "e",  _ + "eeseen"> => dRae sydan rakeen ; -- hame, rae
        <_ + "e",  _ + "een"> => dNukke sydan käden ; -- nukke
        <_ + "t",  _ + "eeseen"> => dOttanut sydan ; -- kuollut
        <_ + "t",  _ + "een"> => dRae sydan oven ; -- olut
        <_ + "n",  _ + "meen"> => dLiitin sydan oven ;
        <_ + "n",  _ + ("maan"|"mään")> => dOnneton sydan ;
        <_ + "s",  _ + "kseen"> => dJalas sydan ; -- Sg Ill can distinguish between jalas, lujuus, kahdeksas, kaunis and mies
        <_ + "s",  _ + "nteen"> => d45 sydan ;
        <_ + "s",  _ + "teen"> => dLujuus sydan ;
        <_ + "s",  _ + "heen"> => d42 sydan ;
        <_ + "mpi", _ + ("mpaan"|"mpään")> => dSuurempi sydan ;
        <_ + #consonant, _ + #consonant + "iin"> => dUnix sydan ;
        <_, _ + ":" + ("han"|"hen"|"hin"|"hon"|"hun"|"hyn"|"hän"|"hön"|"aan"|"ään")> => dSDP sydan ;

        _ => nForms1 sydan }
    } ;


  --- this is a paradigm hidden from the API. It should not be used without caution
  invarN : Str -> N = \s -> <lin N {s = \\_ => s ; h = Back} : N> ;

  mkN2 = overload {
    mkN2 : N -> N2 = \n -> mmkN2 n (casePrep genitive) ;
    mkN2 : N -> Prep -> N2 = mmkN2
    } ;

  mmkN2 : N -> Prep -> N2 = \n,c -> n ** {c2 = c ; isPre = mkIsPre c ; lock_N2 = <> ; postmod = \\_ => []} ;
  mkN3 = \n,c,e -> n ** {c2 = c ; c3 = e ;
    isPre = mkIsPre c  ; -- matka Lontoosta Pariisiin
    isPre2 = mkIsPre e ;          -- Suomen voitto Ruotsista
    lock_N3 = <>
    } ;

  mkIsPre : Prep -> Bool = \p -> case p.c of {
    NPCase Gen => case p.s.p2 of {
      "" => False ;      -- Jussin veli
      _  => True         -- puhe Jussin puolesta
      } ;
    _ => True            -- syyte Jussia vastaan ; puhe Jussille
    } ;

  mkPN = overload {
    mkPN : Str -> PN = mkPN_1 ;
    mkPN : N -> PN = \s -> lin PN (snoun2spn s) ;
    } ;

  mkPN_1 : Str -> PN = \s -> lin PN (snoun2spn (mk1N s)) ;

  foreignPN : Str -> PN = \s -> mkPN (foreignN s) ;
  foreignN : Str -> N = \s -> (lin N (nforms2snoun (noun s))) where {
    noun : Str -> NForms = \s -> case s of {
      _ + "i" => dPaatti s (s + "n") ;
      _ + "e" => dNukke s (s + "n") ;
      _ + ("a" | "o" | "u" | "y" | "ä" | "ö" | "ü") => dUkko s (s + "n") ;
      _ => dUnix s
      }
    } ;

  mkLN = overload {
    mkLN : Str -> LN = \s -> lin LN (snoun2spn (mk1N s) ** {n = Sg ; extCase = False}) ;
    mkLN : Str -> Number -> LN = \s,n -> lin LN (snoun2spnGen (mk1N s) n ** {n = n ;
             extCase = case n of {Pl => True ; Sg => False}}) ; -- default case for Sg is In, for Pl is On
    mkLN : N -> LN = \noun -> lin LN (snoun2spn noun ** {n = Sg ; extCase = False}) ;
    mkLN : N -> Number -> LN = \noun,n -> lin LN (snoun2spnGen noun n ** {n = n ;
             extCase = case n of {Pl => True ; Sg => False}}) ;
    mkLN : Str -> Number -> Bool -> LN = \s,n,c -> lin LN (snoun2spnGen (mk1N s) n ** {n = n ; extCase = c}) ;
    mkLN : N -> Number -> Bool -> LN = \noun,n,c -> lin LN (snoun2spnGen noun n ** {n = n ; extCase = c}) ;
  } ;

  mkGN = overload {
    mkGN : Str -> GN = \s -> lin GN (snoun2spn (mk1N s) ** {g = Male}) ;
    mkGN : Str -> Sex -> GN = \s,g -> lin GN (snoun2spn (mk1N s) ** {g = g}) ;
    mkGN : N -> GN = \noun -> lin GN (snoun2spn noun ** {g = Male}) ;
    mkGN : N -> Sex -> GN = \noun,g -> lin GN (snoun2spn noun ** {g = g}) ;
  } ;

  mkSN = overload {
    mkSN : Str -> SN = \s -> let spn = snoun2spn (mk1N s) in lin SN {s = \\_=>spn; pl=spn} ;
    mkSN : Str -> Str -> Str -> SN
         = \male,female,pl -> lin SN {
               s = table {Male  =>snoun2spn (mk1N male);
                          Female=>snoun2spn (mk1N female)};
               pl= snoun2spn (mk1N pl)
           } ;
    mkSN : N -> SN = \noun -> let spn = snoun2spn noun in lin SN {s = \\_=>spn; pl=spn} ;
    mkSN : N -> N -> N -> SN
         = \male,female,pl -> lin SN {
               s = table {Male  =>snoun2spn male;
                          Female=>snoun2spn female};
               pl= snoun2spn pl
           } ;
  } ;

-- adjectives

  mkA = overload {
    mkA : Str -> A  = mkA_1 ;
    mkA : N -> A = \n -> noun2adjDeg n ** {lock_A = <>} ;
    mkA : N -> (kivempi,kivin : Str) -> A = \n -> regAdjective n ;
    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 (mkAdj h p ps hn pn ph ** {p=[]; hasPrefix=False}) ;
    mkA : V -> A = presActA ;
    } ;

  -- Adjectives that are not really adjectives are given in WordNet like "sähkö-"
  -- We can at least make them into prefixA to make slightly better linearisation.
  mkA_1 : Str -> A = \x ->
    case x of {
      prefix + "-"
        => let regA : A = noun2adjDeg (mk1N prefix) ;
            in prefixA prefix regA ;
      _ => noun2adjDeg (mk1N x)
    } ;

-- auxiliaries
  mkAdjective : (_,_,_ : SAdj) -> A = \hyva,parempi,paras -> lin A
    {s = table {
      Posit  => hyva.s ;
      Compar => parempi.s ;
      Superl => paras.s
      } ;
     h = hyva.h ;  ---- different for parempi, paras
     p = [] ;
     hasPrefix = False
    } ;
  regAdjective : SNoun -> Str -> Str -> A = \kiva, kivempi, kivin ->
    mkAdjective
      (snoun2sadj kiva)
      (snoun2sadjComp False (nforms2snoun (dSuurempi kivempi)))
      (snoun2sadjComp False (nforms2snoun (dSuurin kivin))) ;
  noun2adjDeg : SNoun -> A = \suuri ->
    regAdjective
      suuri
      (snoun2compar suuri)
      (snoun2superl suuri) ;


  presActA : SVerb -> A = \tulla ->
    let tuleva : NForm => Str = \\nf => (sverb2verb True tulla).s ! PresPartAct (AN nf) ;
     in noun2adjDeg { s = tuleva ; h = tulla.h } ;

  presPassA : SVerb -> A = \mennä ->
    let mentävä : NForm => Str = \\nf => (sverb2verb True mennä).s ! PresPartPass (AN nf) ;
     in noun2adjDeg { s = mentävä ; h = mennä.h } ;

  pastActA : SVerb -> A = \syntyä ->
    let syntynyt : NForm => Str = \\nf => (sverb2verb True syntyä).s ! PastPartAct (AN nf) ;
     in noun2adjDeg  { s = syntynyt ; h = syntyä.h } ;

  pastPassA : SVerb -> A = \sulkea ->
    let suljettu : NForm => Str = \\nf => (sverb2verb True sulkea).s ! PastPartPass (AN nf) ;
     in noun2adjDeg  { s = suljettu ; h = sulkea.h } ;

-- verbs

  mkV = overload {
    mkV : (huutaa : Str) -> V = mk1V ;
    mkV : (huutaa,huusi : Str) -> V = mk2V ;
    mkV : (huutaa,huudan,huusi : Str) -> V = mk3V ;
    mkV : (
      huutaa,huudan,huutaa,huutavat,huutakaa,huudetaan,
      huusin,huusi,huusisi,huutanut,huudettu,huutanee : Str) -> V = mk12V ;
    mkV : (sana : VK) -> V = \w -> vforms2sverb w.s ** {sc = SCNom ; lock_V = <> ; p = []} ;
    mkV : V -> Str -> V = \w,p -> {s = w.s ; sc = w.sc ; lock_V = <> ; h = w.h ; p = p} ;
    mkV : Str -> V -> V = \s,v -> {s = \\f => s + v.s ! f ; sc = v.sc ; lock_V = <> ; h = v.h ; p = v.p} ;
  } ;

  mk1V : Str -> V = \s ->
    let vfs = vforms2sverb (vForms1 s) in
      vfs ** {sc = SCNom ; lock_V = <> ; p = []} ;
  mk2V : (_,_ : Str) -> V = \x,y ->
    let vfs = vforms2sverb (vForms2 x y) in vfs ** {sc = SCNom ; 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 ->
        vforms2sverb (vForms12 a b c d e f g h i j k l) ** {sc = SCNom ; lock_V = <> ; p = []} ;

  vForms1 : Str -> VForms = \ottaa ->
    let
      a = last ottaa ;
      otta = init ottaa ;
      ott  = init otta ;
      ots  = init ott + "s" ;
      ota  = weakGrade otta ;
      otin = init (strongGrade (init ott)) + "elin" ;
      ot   = init ota ;
    in
    case ottaa of {
      _ + ("e" | "i" | "o" | "u" | "y" | "ö") + ("a" | "ä") =>
        cHukkua ottaa (ota + "n") ;
      _ + ("l" | "n" | "r") + ("taa" | "tää") =>
        cOttaa ottaa (ota + "n") (ots + "in") (ots + "i") ;
      ("" | ?) + ("a" | "e" | "i" | "o" | "u") + ? + _ +
        ("a" | "e" | "i" | "o" | "u") + _ + "aa" =>
        cOttaa ottaa (ota + "n") (ot + "in") (ott + "i") ;
      ("" | ?) + ("a" | "e" | "i") + _ + "aa" =>
        cOttaa ottaa (ota + "n") (ot + "oin") (ott + "oi") ;
      _ + ("aa" | "ää") =>
        cOttaa ottaa (ota + "n") (ot + "in") (ott + "i") ;
      _ + ("ella" | "ellä") =>
        cKuunnella ottaa otin ;
      _ + ("osta" | "östä") =>
        cJuosta ottaa (init ott + "ksen") ;
      _ + ("st" | "nn" | "ll" | "rr") + ("a" | "ä") =>
        cJuosta ottaa (ott + "en") ;
      _ + ("ita" | "itä") =>
        cHarkita ottaa ;
      _ + ("eta" | "etä" | "ota" | "ata" | "uta" | "ytä" | "ätä" | "ötä") =>
        cPudota ottaa (strongGrade ott + "si") ;
      _ + ("da" | "dä") =>
        cJuoda ottaa ;
      _ => Predef.error (["expected infinitive, found"] ++ ottaa)
    } ;

  vForms2 : (_,_ : Str) -> VForms = \huutaa,huusi ->
    let
      huuda = weakGrade (init huutaa) ;
      huusin = weakGrade huusi + "n" ;
      autoin = weakGrade (init huusi) + "in" ;
    in
    case <huutaa,huusi> of {
      <_ + ("taa" | "tää"), _ + ("oi" | "öi")> =>
        cOttaa huutaa (huuda + "n") autoin huusi ;
      <_ + ("aa" | "ää"), _ + "i"> =>
        cOttaa huutaa (huuda + "n") huusin huusi ;
      <_ + ("eta" | "etä"), _ + "eni"> =>
        cValjeta huutaa huusi ;
      <_ + ("sta" | "stä"), _ + "si"> =>
        vForms1 huutaa ; -- pestä, halkaista
      <_ + ("ta" | "tä"), _ + "si"> =>
        cPudota huutaa huusi ;
      <_ + ("lla" | "llä"), _ + "li"> =>
        cKuunnella huutaa huusin ;
      _ => vForms1 huutaa
      } ;



  caseV c v = {s = v.s ; sc = npform2subjcase (NPCase c) ; h = v.h ; lock_V = <> ; p = v.p} ;

  vOlla = {
    s = ollaSVerbForms ;
    sc = SCNom ; 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) ;
  dirV2 v = mk2V2 v accPrep ;

  mkAdv = overload {
    mkAdv : Str -> Adv = \s -> {s = tagPOS "ADV" s ; lock_Adv = <>} ;
    mkAdv : AdvK -> Adv = \s -> {s = tagPOS "ADV" s.s ; lock_Adv = <>} ;
    } ;

  mkV2 = overload {
    mkV2 : Str -> V2 = \s -> dirV2 (mk1V s) ;
    mkV2 : Str -> Case -> V2 = \s -> caseV2 (mk1V s) ;
    mkV2 : V -> V2 = dirV2 ;
    mkV2 : V -> Case -> V2 = caseV2 ;
    mkV2 : V -> Prep -> V2 = mk2V2 ;
    mkV2 : VK -> V2 = \w -> dirV2 (vforms2sverb w.s ** {sc = SCNom ; lock_V = <> ; p = []}) ;
    } ;

  mk2V2 : V -> Prep -> V2 ;
  caseV2 : V -> Case -> V2 ;
  dirV2 : V -> V2 ;

  dirV3 v p = v ** {c2 = accPrep ; c3 = casePrep p ; lock_V3 = <>} ;
  dirdirV3 v = dirV3 v allative ;


  mkVVf  v f = v ** {vi = infform2vvtype f ; lock_VV = <>} ;
  mkVQ  v = v ** {lock_VQ = <>} ;

  V0 : Type = V ;
  AS, A2S, AV : Type = A ;
  A2V : Type = A2 ;

  mkV0  v = v ** {lock_V = <>} ;
  mkV2Sbare : V -> V2S = \v -> mkV2S v (casePrep allative) ; ----

  mkV2S v p = mk2V2 v p ** {lock_V2S = <>} ;
  mkV2Vbare : V -> V2V = \v -> mkV2Vf v (casePrep partitive) infIllat ; ----
--  mkV2V v p = mkV2Vf v p infIllat ;
  mkV2Vf v p f = mk2V2 v p ** {vi = infform2vvtype f ; lock_V2V = <>} ;

  mkVAbare : V -> VA = \v -> mkVA v (casePrep partitive) ; ----
  mkVA  v p = v ** {c2 = p ; lock_VA = <>} ;
  mkV2Abare : V -> V2A = \v -> mkV2A v (casePrep partitive) (casePrep translative) ;
  mkV2A v p q = v ** {c2 = p ; c3 = q ; lock_V2A = <>} ;
  mkV2Qbare : V -> V2Q = \v -> mkV2Q v (casePrep ablative) ; ----
  mkV2Q v p = mk2V2 v p ** {lock_V2Q = <>} ;

  mkAS  v = v ** {lock_A = <>} ;
---  mkA2S v p = mkA2 <v : A> p ** {lock_A = <>} ;
  mkAV  v = v ** {lock_A = <>} ;
---  mkA2V v p = mkA2 <v : A> p ** {lock_A2 = <>} ;

  mkMU : Str -> MU = \s -> lin MU {s=s; isPre=False} ;

} ;