# Suomi-malaga, suomen kielen muoto-opin kuvaus.
#
# Tekijänoikeus © 2006-2010 Hannu Väisänen (Etunimi.Sukunimi@joensuu.fi)
#
# Tämä ohjelma on vapaa; tätä ohjelmaa on sallittu levittää
# edelleen ja muuttaa GNU yleisen lisenssin (GPL lisenssin)
# ehtojen mukaan sellaisina kuin Free Software Foundation
# on ne julkaissut; joko Lisenssin version 2, tai (valinnan
# mukaan) minkä tahansa myöhemmän version mukaisesti.
#
# Tätä ohjelmaa levitetään siinä toivossa, että se olisi
# hyödyllinen, mutta ilman mitään takuuta; ilman edes
# hiljaista takuuta kaupallisesti hyväksyttävästä laadusta tai
# soveltuvuudesta tiettyyn tarkoitukseen. Katso GPL
# lisenssistä lisää yksityiskohtia.
#
# Tämän ohjelman mukana pitäisi tulla kopio GPL
# lisenssistä; jos näin ei ole, kirjoita osoitteeseen Free
# Software Foundation Inc., 51 Franklin Street, Fifth Floor,
# Boston, MA 02110-1301, USA.
#
# Tämän ohjeman linkittäminen staattisesti tai dynaamisesti
# muihin moduuleihin on ohjelmaan perustuvan teoksen
# tekemistä, joka on siis GPL lisenssin ehtojen alainen.
#
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; see the file COPYING.  If not, write to the
# Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
# 02110-1301, USA.
#
# Linking this program statically or dynamically with other modules is
# making a combined work based on this program.  Thus, the terms and
# conditions of the GNU General Public License cover the whole
# combination.


# $sanatietue1 Sanastosta (tiedostosta *.lex) luettu tietue.
# $lisä        Merkkijono, joka lisätään sanan alkuosaan ennen sijapäätteitä.
#              Esimerkiksi sanan valkoinen alkuosa on valkoi.
#              Tähän lisätään merkkijonot
#              nen    valkoi+nen
#              s      valkoi+s(ta), valkoi+s(ten), valkoi+s(ien), valkoi+s(ina).
#              se     valkoi+se(n), valkoi+se(na), jne, valkoi+se(t).
# $jatko       Sääntö, jolla sanan jäsennystä jatketaan.
# $tietue      Tietue, joka lisätään parametriin sanatietue1.
#
subrule taivutus ($sanatietue1, $lisä, $jatko, $tietue):
  assert (value_type ($jatko) = list);

#define $b := transmit ("AAA " + $sanatietue1.perusmuoto + " " + tavutus($sanatietue1.perusmuoto));
#if ($sanatietue1.luokka = lukusana) then
#  define $a := transmit (<$sanatietue1> + <$lisä> + <$jatko> + <$tietue>);
#end;

  define $a := taivutus2 ($sanatietue1, $lisä, $jatko, $tietue, $sanatietue1.alku);
  define $n := length ($a);

  foreach $i in $n:
    if ($a.$i.perusmuoto = "virkkaa") then
      define $h_äs := harri($a.$i.alku);
      if ($a.$i.äs /= $h_äs) then
        $a.$i :=+ [alkuperäinen_äs: $a.$i.äs];
        if (switch(malli) = voikko) then
          $a.$i.äs := $h_äs;
        else
          $a.$i.äs := aä;  # Virkettu tai virketty.
        end;
      end;
    end;
  end;

  assert (length($a) = 1);

#define $aaa := transmit ($sanatietue1.perusmuoto);

#if ($sanatietue1.perusmuoto = "poliisi") then
#define $aa := transmit ($sanatietue1);
#define $ab := transmit ($lisä);
#define $ac := transmit ($jatko);
#define $ad := transmit ($tietue);
#define $ae := transmit ("=========");
#end;

  if (($sanatietue1.jatko * <kirjoittaa, kilvoitella> /= <>) and (substring ($lisä, 1L) /= "i")) then
    #
    # Kirjo(i)ttaa: i:llinen muoto nykysääntöjen mukainen.
    #
    $a.(1) :=+ [alku2: $sanatietue1.alku + "i" + $lisä];

  elseif (($sanatietue1.jatko * <ammottaa, ilotella> /= <>) and (substring ($lisä, 1L) = "i")) then
    #
    # Ammo(i)ttaa: i:tön muoto nykysääntöjen mukainen.
    #
    $a.(1) :=+ [alku2: $sanatietue1.alku + substring ($lisä, 2, 1R)];

  elseif (($sanatietue1.jatko * <symboli_di, symboli_fi, symboli_gi, symboli_li,
                                 symboli_mi, symboli_ni, symboli_ri, symboli_vi,
                                 telefoni_di, telefoni_fi, telefoni_gi, telefoni_li,
                                 telefoni_mi, telefoni_ni, telefoni_ri, telefoni_vi> /= <>)
          and (substring ($lisä, 1) = "o")) then
    #
    # Symbo(o)li: yksi ääntiö nykysääntöjen mukainen.
    #
    $a.(1) :=+ [alku2: $sanatietue1.alku + substring ($lisä, 2, 1R)];

  elseif ((nuolaista in $sanatietue1.jatko) and (substring ($lisä, 1L) /= "i")) then
    #
    # Nuola(i)sta: i:llinen muoto nykysääntöjen mukainen.
    #
    $a.(1) :=+ [alku2: $sanatietue1.alku + "i" + $lisä];

  elseif (($sanatietue1.jatko * <balladi, marinadi> /= <>)
          and ($sanatietue1.alku + $lisä matches ".*" : $alku, "a", "ad[ie]?" : $loppu)) then
    #
    # Balla(a)di: yksi ääntiö nykysääntöjen mukainen.
    #
    assert (length($a) = 1);
    $a.(1) :=+ [alku2: $alku + $loppu];

  elseif (($sanatietue1.jatko * <biografi> /= <>)
          and ($sanatietue1.alku + $lisä matches ".*" : $alku, "a", "af[ie]?" : $loppu)) then
    #
    # Biogra(a)fi: yksi ääntiö nykysääntöjen mukainen.
    #
    assert (length($a) = 1);
    $a.(1) :=+ [alku2: $alku + $loppu];

  elseif ($sanatietue1.jatko * <funktio, illuusio, obligaatio, resoluutio, traditio> /= <>) then
    #
    # Obliga(a)tio, obligatio(o)ni, obligatsio(o)ni.
    # Revolu(u)tio, revolutio(o)ni, revolutsio(o)ni.
    # Illu(u)sio,   illusio(o)ni.
    # Tradit(s)io,  traditsio(o)ni.
    # Funkt(s)io,   funktsio(o)ni; akt(s)io, aktsio(o)ni.
    #
    assert (length($a) = 1);
    $a.(1) :=+ [alku2: $sanatietue1.perusmuoto];

  elseif (($sanatietue1.jatko * <osoite> /= <>)
          and ($sanatietue1.alku + $lisä matches ".*o" : $alku, "(te|ttee?)" : $loppu)) then
    #
    # Oso(i)te: i:llinen muoto nykysääntöjen mukainen.
    #
    assert (length($a) = 1);
    $a.(1) :=+ [alku2: $alku + "i" + $loppu];

  elseif (($sanatietue1.jatko * <tiedote> /= <>)
          and ($sanatietue1.alku + $lisä matches ".*o" : $alku, "i", "(te|ttee?)" : $loppu)) then
    #
    # Tiedo(i)te: i:tön muoto nykysääntöjen mukainen.
    #
    assert (length($a) = 1);
    $a.(1) :=+ [alku2: $alku + $loppu];

  elseif ((aivoitus in $sanatietue1.jatko) and (substring ($lisä, 1L) /= "i")) then
    #
    # Aivo(i)tus: i:llinen muoto nykysääntöjen mukainen.
    #
    $a.(1) :=+ [alku2: $sanatietue1.alku + "i" + $lisä];

  elseif ((jaotus in $sanatietue1.jatko) and (substring ($lisä, 1L) = "i")) then
    #
    # Jao(i)tus: i:tön muoto nykysääntöjen mukainen.
    #
    $a.(1) :=+ [alku2: $sanatietue1.alku + substring ($lisä, 2, 1R)];

  elseif ((hevoinen in $sanatietue1.jatko) and (substring ($lisä, 1L) = "i")) then
    #
    # Hevo(i)nen: i:tön muoto nykysääntöjen mukainen.
    #
    $a.(1) :=+ [alku2: $sanatietue1.alku + substring ($lisä, 2, 1R)];

  elseif ((pistooli in $sanatietue1.jatko) and (substring ($lisä, 1L) /= "o")) then
    #
    # Pisto(o)li: kaksi o:ta nykysääntöjen mukainen.
    #
    $a.(1) :=+ [alku2: $sanatietue1.alku + "o" + $lisä];

  elseif ((poliisi in $sanatietue1.jatko) and (substring ($lisä, 1L) /= "i")) then
    #
    # Poli(i)si: kaksi i:tä nykysääntöjen mukainen.
    #
    $a.(1) :=+ [alku2: $sanatietue1.alku + "i" + $lisä];

  elseif ((kamari in $sanatietue1.jatko) and (substring ($lisä, 1L) = "m")) then
    #
    # Kam(m)ari: yksi m nykysääntöjen mukainen.
    #
    $a.(1) :=+ [alku2: $sanatietue1.alku + substring ($lisä, 2, 1R)];

  elseif ($sanatietue1.perusmuoto2 /= nil) then
    define $taulukko := <
       <"politikka",   <<"politika",   "politiika">,
                        <"politikka",  "politiikka">,
                        <"politikko",  "politiikko">,
                        <"politiko",   "poliitiko">>>,
       <"politikko",   <<"politikko",  "poliitikko">,
                        <"politiko",   "poliitiko">>>
    >;
    foreach $i in $taulukko:
#define $a1 := transmit (<"a1"> + <$i>);
      if ($sanatietue1.perusmuoto = $i.1) then
#define $b1 := transmit (<"b1"> + <$i>);
        foreach $j in $i.2:
          if ($sanatietue1.alku + $lisä = $j.1) then
#define $c1 := transmit (<"c1"> + <$j.1> + <$j.2>);
            $a.1 :=+ [alku2: $j.2];
          end;
        end;
      end;
    end;
  end;
  return $a;
end;


subrule taivutus2 ($sanatietue, $lisä, $jatko, $tietue, $alku):
  if ($tietue.luokka in @nimisana + <laatusana> and $tietue.sija = nil) then
    return ([alku: $alku + $lisä]
            + ($sanatietue - alku - jatko)
            + [jatko: $jatko]
            + $tietue + [sija: nimentö]);
  else
    if (value_type($lisä) = list) then
      define $result := <>;
      foreach $i in $lisä:
        $result :=+ <[alku: $alku + $i]
                     + ($sanatietue - alku - jatko)
                     + [jatko: $jatko]
                     + $tietue>;
      end;
      return $result;
    else
#      define $a := transmit($alku);
#      define $b := transmit($lisä);
      return <[alku: $alku + $lisä]
              + ($sanatietue - alku - jatko)
              + [jatko: $jatko]
              + $tietue>;
    end;
  end;
end;


subrule A ($tietue):
  if ($tietue.äs = a) then
    return "a";
  else
    return "ä";
  end;
end;


subrule AU ($tietue):
  if ($tietue.äs = a) then
    return "au";
  else
    return "äy";
  end;
end;


subrule O ($tietue):
  if ($tietue.äs = a) then
    return "o";
  else
    return "ö";
  end;
end;


subrule U ($tietue):
  if ($tietue.äs = a) then
    return "u";
  else
    return "y";
  end;
end;


subrule UA ($tietue):
  if ($tietue.äs = a) then
    return "ua";
  else
    return "yä";
  end;
end;


# $tietue    Sanatietue
# $taivutus  Sanan taivutus eri taivutusmuodoissa.
#
subrule taivutuskaava ($tietue, $taivutus):
#  define $a := transmit ($tietue);
#  define $b := transmit ($taivutus);
#  define $c := transmit ("<>");

  # Laitetaan johdin_ellA:n astevaihtelu kuntoon.
  # Esim. alittaa => alitella, alittelija.
  #
  if (($tietue.luokka = teonsana) and ($taivutus.johdin_ellA /= nil)) then
    define $ellA := ($taivutus.johdin_ellA.1).1;
    if ($ellA /= "") then
      define $johdin_ellA := "johdin_" + $ellA + "ellA";
      $taivutus :=- johdin_ellA;
      $taivutus :=+ [johdin_CellA($ella): <<"", <>>>]; 
    end;
  end;

  # Jos johdin_illA = "-", sanalla ei ole illA-johdinta.
  # On esim. salata => salailla, mutta ei saneerata => .
  #
  if (($tietue.luokka = teonsana) and ($taivutus.johdin_illA /= nil)) then
    define $illA := ($taivutus.johdin_illA.1).1;
    if ($illA = "-") then
      $taivutus :=- johdin_illA;
    end;
  end;

  # Poistetaan liput.
  #
  define $uusi_taivutus := [];
  define $käskytapa_y2 := <>;
  define $kestämän_tekijäpääte_y3 := <>;

  foreach $i in $taivutus:
#    define $e := transmit (<"I"> + <$i>);
    define $lista := <>;

    foreach $j in $taivutus.$i:
      define $lisä := $j.1;
      define $liput := $j.2;

#define $f := transmit (<$i> + <"§"> + <$j> + <"§§"> + <$lisä> + <"L="> + <$liput>);
      if ($i = käskytapa_y2) then
        $käskytapa_y2 :=+ <$j>;
      elseif (($i in <kestämän_tekijäpääte_y3>) and (_y3 in $liput)) then
        $kestämän_tekijäpääte_y3 :=+ <$j>;
      else
        $lista :=+ <$lisä>;
      end;
      $uusi_taivutus :=+ [$i: $lista];
    end;
  end;

#define $ä := transmit ($uusi_taivutus);
#define $ö := transmit ("LOPPU");

  $taivutus := $uusi_taivutus;

  if (($tietue.luokka in @nimisana + @teonsanasta_johdettu_nimisana + <laatusana, johdin_lAinen>)
      and ($taivutus.nimentö /= nil)) then
    if ($taivutus.tavuviiva = nil) then
      $taivutus :=+ [tavuviiva: $taivutus.nimentö];
    elseif ($taivutus.tavuviiva /= $taivutus.nimentö) then
      $taivutus :=+ [tavuviiva: $taivutus.tavuviiva + $taivutus.nimentö];
    end;
  end;

  if (not ($tietue.luokka in <nimisana, nimi_laatusana, johdin_Us> + @teonsanasta_johdettu_nimisana) or
     (leikkuu in $tietue.jatko)) then   # Ei leikkuu -> leikkuinen.
    $taivutus :=- johdin_inen;
  end;

  # Eräät johtimet eivät esiinny peräkkäin.
  #
  if ($tietue.luokka in <johdin_llinen>) then
    $taivutus :=- <johdin_inen, johdin_ittAin, johdin_lAinen, johdin_llinen, johdin_mAinen>;
  end;

  if ($tietue.luokka in <nimitapa_4>) then
    $taivutus :=- <johdin_inen, johdin_lAinen, johdin_mAinen>;
  end;

  if ($tietue.luokka in @johdin_mA) then
    $taivutus :=- <johdin_inen, johdin_lAinen>;
  end;

  if ($tietue.luokka in @johdin_jA) then
    if ($tietue.perusmuoto in <"jatar", "jätär">) then
      $taivutus :=- <johdin_inen, johdin_UUs>;   # Esim. taitelijattarinen ei ole sana.
    elseif ($tietue.perusmuoto in <"ja", "jä">) then
      $taivutus :=- johdin_UUs;    # Johtimet johdin_jA_* ja johdin_UUs on yhdistetty.
    end;
  end;

  # Ei kaikkia johdoksia kaikista nimisanoista (esim. aateli -> aatelinen).
  #
  if ($tietue.tiedot /= nil) then
    if (ei_inen in $tietue.tiedot) then
      $taivutus :=- johdin_inen;
    end;
    if (ei_lAinen in $tietue.tiedot) then
       $taivutus :=- johdin_lAinen;
    end;
    if (ei_mAinen in $tietue.tiedot) then
      $taivutus :=- johdin_mAinen;
    end;
  end;


  if ($tietue.luokka in <nimi_laatusana, laatusana> + @johdin_laatutapa) then
    $taivutus :=+ [johdin_nlainen: $taivutus.omanto_n];
  end;


  if ($tietue.luokka in @johdin_laatutapa) then
    $taivutus :=- <johdin_lAinen, johdin_mAinen, johdin_tOn>;
  elseif ($tietue.luokka in  @laatutapa_1 + @laatutapa_2) then
    $taivutus :=- <johdin_tOn, tavuviiva, yhdyssana> + @nimi_laatusanan_johdin;
  end;


  if (not ($tietue.luokka in
             <laatusana, nimi_laatusana, johdin_nlainen, johdin_inen, voittoaste, yliaste, lukusana>
             + @teonsanasta_johdettu_laatusana + @nimisanasta_johdettu_laatusana
             + @nimi_laatusanan_johdin
             + @laatutapa_1 + @laatutapa_2)) then
    $taivutus :=- <voittoaste, yliaste, kerronto_sti>;
  end;


  if ($tietue.luokka in <voittoaste, yliaste, lukusana>) then
    $taivutus :=- <voittoaste, yliaste>;
  end;


  if (not ($tietue.luokka in <laatusana, nimi_laatusana, johdin_nlainen, johdin_inen, voittoaste, yliaste>
                             + @teonsanasta_johdettu_laatusana
                             + @nimisanasta_johdettu_laatusana
                             + @nimi_laatusanan_johdin)) then
    $taivutus :=- <johdin_Us, johdin_UUs>;
  end;


  # Esim. sanan "vanhanmallisista" perusmuoto ei ole "vanhanmallisinen".
  #
  if ($tietue.luokka in <laatusana, nimi_laatusana>) and ($tietue.perusmuoto matches ".*inen") then
    $taivutus :=- <johdin_inen>;
  end;

  # Esim. puhua => puhuja => puhujainen ei käy.
  #
##  if ($tietue.luokka in @johdin_jA) then
##    $taivutus :=- <johdin_inen>;
##  end;


  if ($tietue.luokka = yliaste) then
    $taivutus :=- <nimisana, nimi_laatusana, laatusana, teonsana, etuliite>;
  end;

  # Yksitekijäiset teonsanat taipuvat vain yksikön ja monikon kolmannessa.
  #
  if ($tietue.luokka = teonsana and $tietue.perusmuoto in <"poutaantua", "sataa">) then
    $taivutus :=- <kestämän_tekijäpääte_y1, kestämän_tekijäpääte_y2,
                   kestämän_tekijäpääte_m1, kestämän_tekijäpääte_m2, 
                   kertoman_tekijäpääte_y1, kertoman_tekijäpääte_y2,
                   kertoman_tekijäpääte_m1, kertoman_tekijäpääte_m2>;
  end;


  define $lista := lajittele ($taivutus);

  define $t := <>;

  foreach $i in $lista:
    $t :=+ taivutus ($tietue, $i.1, $i.2, []);
  end;


  if ($käskytapa_y2 /= <>) then
    foreach $i in $käskytapa_y2:
      $t :=+ käskytapa_y2 ($tietue, $i.1);
    end;
  end;


  if ($kestämän_tekijäpääte_y3 /= <>) then
    foreach $i in $kestämän_tekijäpääte_y3:
#define $a1 := transmit ($tietue);
#define $a2 := transmit ($taivutus);
#define $a3 := transmit ($kestämän_tekijäpääte_y3);
#define $a4 := transmit ($i.1);
      $t :=+ tositavan_kestämä_y3 ($tietue, $i.1);
    end;
  end;

  return $t;
end;


subrule johdin_CellA ($text):
      if ($text = "d")  then return johdin_dellA;
  elseif ($text = "hd") then return johdin_hdellA;
  elseif ($text = "l")  then return johdin_lellA;
  elseif ($text = "n")  then return johdin_nellA;
  elseif ($text = "nn") then return johdin_nnellA;
  elseif ($text = "r")  then return johdin_rellA;
  elseif ($text = "t")  then return johdin_tellA;
  else
     error "johdin_CellA " + $text;
  end;
end;


# Yksikön kolmannen pääte on sulautunut sanan vartaloon:
#
# Minä saa+n  voi+n
# Sinä saa+t  voi+t
# Hän  saa+   voi+
#
# Vertaa puhu+n, puhu+t, puhu+u.
# 
subrule tositavan_kestämä_y3 ($tietue, $vahva_aste):
#define $a := transmit ($tietue);
#define $b := transmit ($vahva_aste);
  return taivutus ($tietue, $vahva_aste,
                   <liitesana, loppu>,
                   [tapaluokka: tositapa,
                    aikamuoto: kestämä,
                    tekijä: 3,
                    luku: yksikkö]);
end;



# Yksikön toisen käskytapa, jolla ei ole päätettä:
#
# puhua => puhu, sanoa => sano, tehdä => tee.
#
subrule käskytapa_y2 ($tietue, $heikko_aste):
    return taivutus ($tietue, $heikko_aste,
                     <liitesana, liitesana2, liitesana_s, loppu>,
                     [tapaluokka: käskytapa,
                      aikamuoto: kestämä,
                      tekijä: 2,
                      luku: yksikkö]);
end;



############################################################
#
# Muuta tietue parien listaksi. Parin eka alkiona on
# merkkijono ja toisena alkiona lista niistä tietueen
# kenttien nimistä, joiden arvona on sama merkkijono.
#
# Esimerkiksi:
#
# [a: "a",
#  b: <"a", "c">,
#  c: "b",
#  d: "a",
#  e: "b",
#  f: "b"]
#
#   ===>
#
# <<"a", <a, b, d>>,
#  <"b", <c, e, f>>,
#  <"c", <b>>

subrule lajittele ($tietue):
  #
  # [sijan_nimi: merkkijono] tai
  # [sijan_nimi: <merkkijono1, merkkijono2>]
  # Otetaan kaikki merkkijonot joukkoon $joukko.
  # Se on joukko, koska kukin alkio on siinä vain kerran.
  #
  define $joukko := <>;

#define $a := transmit ($tietue);

  foreach $i in $tietue:
    if (value_type($tietue.$i) = list) then
      $joukko :=+ $tietue.$i / $joukko;
    else
      if (not ($tietue.$i in $joukko)) then
        $joukko :=+ <$tietue.$i>;
      end;
    end;
  end;

#define $ö := transmit (<"ööö"> + <$joukko>);

  define $r := <>;

  foreach $i in $joukko:
    $r :=+ <<$i, etsi ($tietue, $i)>>;
  end;

  define $t := <>;

  foreach $i in $r:
    if (nimentö in $i.2) then
      $i.2 :=+ <liitesana, loppu>;
    end;
    $t :=+ <<$i.1, $i.2>>;
  end;
  return $t;
end;



# Etsi arvo joukosta.
# Jos ei löydy, palauta <>.
#
subrule etsi ($tietue, $arvo):
  define $t := <>;

#define $a := transmit (<"tietue"> + <$tietue>);
#define $b := transmit (<"arvo  "> + <$arvo>);

  foreach $i in $tietue:
    if (((value_type($tietue.$i) = list)  and ($arvo in $tietue.$i)) or
        ((value_type($tietue.$i) /= list) and ($tietue.$i = $arvo))) then
      $t :=+ <$i>;
    end;
  end;

  return $t;
end;



###########################################################################


# Teonsanat.


subrule muistua2 ($tietue, $alun_lisä, $vahva_aste, $heikko_aste):
  $tietue :=+ [lähtösana: $tietue.perusmuoto];
  $tietue.luokka := teonsana;
  $tietue.alku :=+ $alun_lisä;
  $tietue.perusmuoto := $tietue.alku + $vahva_aste + UA($tietue);
  return punoa ($tietue, $vahva_aste + U($tietue), $heikko_aste + U($tietue));
end;


subrule ammottua2 ($tietue):
  $tietue :=+ [lähtösana: $tietue.perusmuoto];
  $tietue :=+ [lähtöalku: $tietue.alku];
  $tietue.perusmuoto := $tietue.alku + "tt" + UA($tietue);
  return ammottua ($tietue, "tt"+U($tietue), "itt"+U($tietue), "t"+U($tietue), "it"+U($tietue));
end;


subrule kirjoittua2 ($tietue):
  $tietue :=+ [lähtösana: $tietue.perusmuoto];
  $tietue :=+ [lähtöalku: $tietue.alku];
  $tietue.perusmuoto := $tietue.alku + "itt" + UA($tietue);
  return kirjoittua ($tietue, "ittu", "ttu", "itu", "tu");
end;


subrule kihahtaa ($tietue):
  $tietue :=+ [lähtösana: $tietue.perusmuoto];
  $tietue.äs := ääntiösointu ($tietue);
  $tietue.alku :=+ A($tietue) + "h";
  $tietue.perusmuoto := $tietue.alku + "t" + A($tietue) + A($tietue);
  return alittaa ($tietue, "t"+A($tietue), "de", "d"+A($tietue), "d", "t", "d", "-");
end;


subrule kihauttaa ($tietue):
  $tietue :=+ [lähtösana: $tietue.perusmuoto];
  $tietue.äs := ääntiösointu ($tietue);
  $tietue.alku :=+ AU($tietue) + "t";
  $tietue.perusmuoto := $tietue.alku + "t" + A($tietue) + A($tietue);
  return alittaa ($tietue, "t"+A($tietue), "e", A($tietue), "", "t", "t", "-");
end;


subrule loitontaa ($tietue, $heikko_aste):
  $tietue :=+ [lähtösana: $tietue.perusmuoto];
  $tietue.alku :=+ $heikko_aste;
  $tietue.perusmuoto := $tietue.alku + "t"+A($tietue)+A($tietue);
  return pahentaa ($tietue, "t"+A($tietue), "ne", "n"+A($tietue), "s", "n", "t");
end;


subrule loitontua ($tietue, $heikko_aste):
  $tietue :=+ [lähtösana: $tietue.perusmuoto];
  $tietue.alku :=+ $heikko_aste;
  $tietue.perusmuoto := $tietue.alku + "t" + U($tietue)+A($tietue);
  return punoa ($tietue, "t"+U($tietue), "n"+U($tietue));
end;


subrule juonto ($tietue):
  $tietue :=+ [lähtösana: $tietue.perusmuoto];
  $tietue.luokka := nimisana;
  $tietue.äs := ääntiösointu ($tietue);
  $tietue.perusmuoto := $tietue.alku + "t"+O($tietue);
  return valo ($tietue, "t"+O($tietue), "n"+O($tietue));
end;


subrule pyörtö ($tietue):
  $tietue :=+ [lähtösana: $tietue.perusmuoto];
  $tietue.luokka := nimisana;
  $tietue.äs := ääntiösointu ($tietue);
  $tietue.perusmuoto := $tietue.alku + "t"+O($tietue);
  return valo ($tietue, "t"+O($tietue), "r"+O($tietue));
end;


subrule ääntiösointu ($tietue):
  if ($tietue.alku matches ".*" + @yäö + ".*") then
    return ä;
  else
    return a;
  end;
end;


subrule punottaa ($tietue, $heikko_aste):
  $tietue :=+ [lähtösana: $tietue.perusmuoto];
  $tietue.luokka := teonsana;
  $tietue.alku :=+ $heikko_aste;
  $tietue.perusmuoto := $tietue.alku + "t" + A($tietue) + A($tietue);
  return alittaa ($tietue, "t"+A($tietue), "e", A($tietue), "", "t", "t", "-")
         + muistua2 ($tietue, "", "t", "");
end;



subrule pahentua ($tietue, $vahva_aste, $heikko_aste):
  $tietue :=+ [lähtösana: $tietue.perusmuoto];
  $tietue.luokka := teonsana;
  $tietue.perusmuoto := $tietue.alku + $vahva_aste + UA($tietue);

  return punoa ($tietue, $vahva_aste+U($tietue), $heikko_aste+U($tietue));
end;


subrule murto ($tietue):
  $tietue :=+ [lähtösana: $tietue.perusmuoto];
  $tietue.luokka := nimisana;
  $tietue.äs := a;
  $tietue.perusmuoto := $tietue.alku + "t"+O($tietue);
  return valo ($tietue, "t"+O($tietue), "r"+O($tietue));
end;


# Unixin tr komento.
#
# Esim. tr ($s, "abc", "def") korvaa merkkijonossa olevat
# a:t d:illä, b:t e:illä ja c:t f:illä.
#
#subrule tr ($s, $u, $v):
#  assert (length($u) greater_equal length($v));
#  define $p := "";
#  foreach $i in length ($s):
#    define $korvattu := no;
#    foreach $j in length ($u):
#      define $c1 := substring ($s, $i);
#      define $c2 := substring ($u, $j);
#      if ((capital ($c1) = capital ($c2)) and ($c1 = $c2)) then
#        $p :=+ substring ($v, $j);
#        $korvattu := yes;
#        break;
#      end;
#    end;
#    if ($korvattu = no) then
#      $p :=+ substring ($s, $i);
#    end;
##define $foo := transmit ($p);
#  end;
#  return $p;
#end;


# Jaetaan sana tavuihin. Esim.
# tavutus("valkoinen") => "val-koi-nen".
#
# Algoritmi: Facta-tietosanakirja (1970), osa 9, palsta 50.
#
# "(1) kaksi peräkkäistä vokaalikirjainta kuuluvat samaan tavuun
# jos ja vain jos ne ääntyvät pitkänä vokaalina tai diftongina.
#
# (2) jos konsonanttia seuraa vokaali, ne kuuluvat samaan tavuun,
# muutoin konsonantti kuuluu edellisen kirjaimen tavuun (kuitenkin
# vierasperäisen sanan kaikki alkukonsonantit kuuluvat samaan tavuun)."

# Kahden ääntiön yhdistelmät, jotka voivat olla tavussa.
#
define @ä0 := <"ei", "ai", "äi", "ui", "yi", "oi", "öi">;
define @ä1 := <"au", "äy", "ou", "öy", "iu", "iy", "eu", "ey", "uo", "yö", "ie"> + @ä0;
define @ä2 := <"aa", "ee", "ii", "oo", "uu", "yy", "ää", "öö">;

define @ääntiö2 := @ä1 + @ä2;


#subrule tavutus ($sana):
##  if ($sana = nil) then
##    return nil;
##  end;
#
##define $ab := transmit ($sana);
#
#  define $n := length ($sana);
#  define $i := 1;
#  define $s := "";
#
##define $ab := transmit ("X " + $sana);
#
#  if ($n less_equal 2) then
#    return $sana;
#  end;
#
#
#  # Jos sanassa on joku merkeistä -':.
#  # tavutetaan sanan molemmat puoliskot erikseen.
#  #
#  if ($sana matches ("[^\\-':\\.]+" : $alku, "[\\-':\\.]", ".*" : $loppu)) then
##define $a := transmit ("[" + $alku + "] [" + $loppu + "]");
#    return (tavutus ($alku) + "-" + tavutus ($loppu));
#  end;
#
#
#  # Kerakkeet sanan alussa.
#  #
#  repeat
#    while (($i less $n) and
#           (substring($sana,$i) matches @kerake) and
#           (substring($sana,$i+1) matches @kerake));
#    $s :=+ substring($sana,$i);
##    define $a2 := transmit (<"V " + $s> + <$i> + <$n>);
#    $i:=+ 1;
#  end;
#
##define $aw := transmit (<"W " + $s> + <$i> + <$n>);
#
#  if ($i = $n) then
#    return $sana;  # Lyhenne, jossa on vain kerakkeita.
#  end;
#
#  repeat
#    if (substring ($sana, $i, $i+1) matches (@ääntiö, @ääntiö)) then
##define $a0 := transmit (<"A " + $s> + <$i> + <$n> + <substring ($sana, $i, $i+1)>);
#      if (($i + 2 less_equal $n) and (substring ($sana, $i+1, $i+2) in @ä2)) then
#        # Re-aa-li.
##define $a2 := transmit (<"B " + $s> + <$i> + <$n>);
#        $s :=+ substring ($sana, $i) + "-" + substring ($sana, $i+1, $i+2);
##define $a3 := transmit (<"C " + $s> + <$i> + <$n>);
#        $i :=+ 3;
#      elseif (substring ($sana, $i, $i+1) in @ääntiö2) then
#        $s :=+ substring ($sana, $i, $i+1);
##define $a1 := transmit (<"a " + $s> + <$i> + <$n>);
#        $i :=+ 2;
#      else
#        $s :=+ substring ($sana, $i) + "-" + substring ($sana, $i+1);
##define $a1 := transmit (<"b " + $s> + <$i> + <$n>);
#        $i :=+ 2;
#      end;
#    elseif (substring ($sana, $i, $i+1) matches (@kerake, @ääntiö)) then
#      if ((length ($s) greater 0) and
#          (substring ($s, 1R) /= "-") and
#          (not vain_kerakkeita ($s))) then  # Stres-si.
#        $s :=+ "-";
#      end;
#      $s :=+ substring ($sana, $i);
##define $a1 := transmit (<"c " + $s> + <$i> + <$n> + <substring ($sana, $i)>);
#      $i :=+ 1;
#    elseif (substring ($sana, $i, $i+1) matches (@kerake, @kerake)) then
##define $aa := transmit (<"D " + $s> + <$i> + <$n> + <substring ($sana, $i, $i+1)>);
#      if ($i+1 = $n) then # Sanan lopussa on kaksi keraketta.
#        $s :=+ substring ($sana, $i, $i+1);
##define $a1 := transmit (<"1 " + $s> + <$i> + <$n> + <substring ($sana, $i, $i+1)>);
#        $i :=+ 2;
#      elseif (substring ($sana, $i+2) matches @ääntiö) then
#        $s :=+ substring ($sana, $i) + "-";
##define $a1 := transmit (<"f " + $s> + <$i> + <$n> + <substring ($sana, $i+2)>);
#        $i :=+ 1;
#      else
#        $s :=+ substring ($sana, $i);
##define $a1 := transmit (<"g " + $s> + <$i> + <$n>);
#        $i :=+ 1;
#      end;
#    elseif (substring ($sana, $i) matches @ääntiö) then
##define $a1 := transmit (<"H " + $s> + <$i> + <$n> + <substring ($sana, $i, $i+1)>);
#      if (($i greater 2) and (substring ($sana, $i-2, $i-1) in @ääntiö2)) then
#        $s :=+ "-" + substring ($sana, $i);
#      else
##define $a1 := transmit (<"H " + $s> + <$i> + <$n> + <substring ($sana, $i, $i+1)>);
#        $s :=+ substring ($sana, $i);
#      end;
##define $a2 := transmit (<"h " + $s> + <$i> + <$n> + <substring ($sana, $i, $i+1)>);
##       $s :=+ substring ($sana, $i);
#       $i :=+ 1;
#    end;
#    if ($i = $n) then
#      if ((substring ($s, 1R) matches @ääntiö) and
#          (substring ($sana, $i) matches @ääntiö)) then
#        if (substring ($s, 1R) + substring ($sana, $i) in @ääntiö2) then
#          $s :=+ substring ($sana, $i);
#        else
#          $s :=+ "-" + substring ($sana, $i);
#        end;
#      else
#        $s :=+ substring ($sana, $i);
#      end;
##define $a1 := transmit (<"i " + $s> + <$i> + <$n>);
#      $i :=+ 1;
#    end;
##define $a1 := transmit (<"ö " + $s> + <$i> + <$n>);
#    if ($i greater_equal $n) then
#      return $s;
#    end;
#  while (yes);
#  end;
#end;


# Palautetaan yes, jos sanassa on vain kerakkeita.
#
#subrule vain_kerakkeita ($sana):
#  foreach $i in length ($sana):
#    if (substring ($sana, $i) matches @ääntiö) then
#      return no;
#    end;
#  end;
#  return yes;
#end;


# Lasketaan tavujen määrä sanassa.
#
#subrule tavujen_määrä ($sana):
#  if ($sana = nil) then
#    return 0;
#  end;
#
#  define $n := 1;
#  define $s := tavutus ($sana);
#
#  foreach $i in length ($s):
#    if (substring ($s, $i) = "-") then
#      $n :=+ 1;
#    end;
#  end;
#  return $n;
#end;


# Harri Pitkäsen vokaalisointualgoritmi.
# VOWEL_BACK = "a", VOWEL_FRONT = "ä", VOWEL_BOTH == "aä"
#
subrule harri ($w):
  define $last_back := max3 (rfind($w,"a"), rfind($w,"o"), rfind($w,"u"));

  define $last_ord_front := max(rfind($w,"ä"), rfind($w,"ö"));

  define $last_y := rfind($w,"y");

  if ($last_back = 0 and max($last_ord_front,$last_y) greater 0) then
    return ä;
  end;

  if (max3($last_back,$last_ord_front,$last_y) = 0) then
    return ä;
  end;

  if ($last_y less max($last_back,$last_ord_front)) then
    if ($last_back greater $last_ord_front) then
      return a;
    else
      return ä;
    end;
  end;
  return aä;
end;


subrule rfind ($s, $c):
  define $i := length ($s);

  repeat
    if (substring ($s, $i, $i) = $c) then
      return $i;
    end;
    $i :=- 1;
  while ($i greater 0);
  end;
  return 0;
end;


subrule max ($a, $b):
  if ($a greater $b) then
    return $a;
  else
    return $b;
  end;
end;


subrule max3 ($a, $b, $c):
  return max ($a, max ($b, $c));
end;
