Slovak adj, det, numeral paradigms

src/slovak/ParadigmsSlo.gf

@@ -92,27 +92,31 @@ oper
 
   mkA = overload {
     mkA : Str -> A
-      = \s -> lin A (case s of {
+      = \s -> lin A (guessAdjForms s)
-        _ + "ý"  => mladyAdjForms s ;
-        _ + "í"  => jarniAdjForms s ;
-        _ + "ův" => otcuvAdjForms s ;
-        _ + "in" => matcinAdjForms s ;
-        _ => Predef.error ("no mkA for" ++ s)
-        }) ;
     } ;
 
-  mladyA : Str -> A
+  peknyA : Str -> A
-    = \s -> lin A (mladyAdjForms s) ;
+    = \s -> lin A (R.peknyA s) ;
-  jarniA : Str -> A
+  krasnyA : Str -> A
-    = \s -> lin A (jarniAdjForms s) ;
+    = \s -> lin A (R.krasnyA s) ;
-  otcuvA : Str -> A
+  cudziA : Str -> A
-    = \s -> lin A (otcuvAdjForms s) ;
+    = \s -> lin A (R.cudziA s) ;
-  matcinA : Str -> A
+  rydziA : Str -> A
-    = \s -> lin A (matcinAdjForms s) ;
+    = \s -> lin A (R.rydziA s) ;
+  otcovA : Str -> A
+    = \s -> lin A (R.otcovA s) ;
+
 
   mkA2 : A -> Prep -> A2
     = \a,p -> lin A2 (a ** {c = p}) ;
 
+-- the full definition of the adjective record is
+-- {
+--    msnom, fsnom, nsnom, msgen, fsgen, msdat, fsacc, msloc, msins, fsins,
+--    ampnom, pgen, pins : Str
+-- }
+--
+
 -------------------------
 -- Verbs
 

src/slovak/ResSlo.gf

@@ -35,59 +35,7 @@ oper
       "b" | "f" | "l" | "m" | "p" | "s" | "v" | "ľ" | "ĺ" | "ŕ" | "dz"
       ) ;
 
-  dropFleetingE : Str -> Str = \s -> case s of {
+  accentedVowel : pattern Str = #("á"|"é"|"í"|"ó"|"ú"|"ý") ;
-    x + "e" + c@("k"|"c"|"n") => x + c ;
-    x + "e" + "ň" => x + "n" ;
-    _ => s
-    } ;
-
-  shortenVowel : Str -> Str = \s -> case s of {
-    x + "á" + y => x + "a" + y ;
-    x + "é" + y => x + "e" + y ;
-    x + "í" + y => x + "i" + y ;
-    x + "ý" + y => x + "y" + y ;
-    x + "ó" + y => x + "o" + y ;
-    x + "ú" + y => x + "u" + y ;
-    x + "ů" + y => x + "o" + y ;
-    _ => s
-    } ;
-
-  addI : Str -> Str = \s -> case s of {
-    klu + "k"  => klu + "ci" ;
-    vra + "h"  => vra + "zi" ;
-    ce  + "ch" => ce  + "ši" ;
-    dokto + "r" => dokto + "ři" ;
-    pan => pan + "i"
-    } ;
-
-  addAdjI : Str -> Str = \s -> case s of {
-    angli + "ck"  => angli + "čtí" ;
-    ce    + "sk"  => ce    + "ští" ;
-    _ => init (addI s) + "í"
-    } ;
-
-  -- 3.4.10, in particular when also final 'a' is dropped
-  addE : Str -> Str = \s -> case s of {
-    re + "k"   => re + "ce" ;
-    pra + ("g"|"h") => pra + "ze" ;
-    stre + "ch" => stre  + "še" ;
-    sest + "r" => sest + "ře" ;
-    pan => pan + "ě"
-    } ;
-
-  addEch : Str -> Str = \s -> case s of {
-    klu + "k" => klu + "cich" ;
-    vra + ("h"|"g") => vra + "zich" ;
-    ce  + "ch" => ce + "šich" ;
-    pan => pan + "ech"
-    } ;
-
-  shortFemPlGen : Str -> Str = \s -> case s of {
-    ul  + "ice" => ul + "ic" ;
-    koleg + "yně" => koleg + "yň" ;
-    ruz + "e" => ruz + "í" ;
-    _ => Predef.error ("shortFemPlGen does not apply to" ++ s)
-    } ;
   
 ---------------
 -- Nouns
@@ -490,14 +438,15 @@ oper
 
   AdjForms : Type = {
     msnom, fsnom, nsnom : Str ; 
-    msgen, fsgen : Str ;        -- nsgen = msgen, pacc = fsgen
+    msgen, fsgen : Str ;        -- nsgen = msgen
-    msdat, fsdat : Str ;        -- nsdat = msdat
+    msdat : Str ;               -- nsdat = msdat
     fsacc : Str ;               -- amsacc = msgen, imsacc = msnom, nsacc = nsnom
     msloc : Str ;               -- fsloc = fsdat, nsloc = msloc
     msins, fsins : Str ;        -- nsins = msins, pdat = msins
 
-    mpnom,fpnom : Str ;         -- impnom = fpnom, npnom = fsnom
+    ampnom : Str ;              -- *pnom = nsnom
-    pgen : Str ;                -- ploc = pgen
+    pgen : Str ;                --
+                                -- pdat = msins, ampacc = pgen, *pacc = nsnom, ploc = pgen
     pins : Str ;
     } ;
 
@@ -507,90 +456,130 @@ adjFormsAdjective : AdjForms -> Adjective = \afs -> {
   s = \\g,n,c => case <n,c,g> of {
 
     <Sg, Nom, Masc _>
-      | <Sg, Acc, Masc Inanim>   => afs.msnom ;
+      | <Sg, Acc, Masc Inanim>  => afs.msnom ;
-    <Sg, Nom, Fem>
+    <Sg, Nom, Fem>              => afs.fsnom ;
-      | <Pl, Nom|Acc, Neutr> => afs.fsnom ;
+    <Sg, Nom|Acc, Neutr>    
-    <Sg, Nom|Acc, Neutr>     => afs.nsnom ;
+      | <Pl, Nom|Acc, Masc Inanim|Fem|Neutr> => afs.nsnom ;
-
     <Sg, Gen, Masc _ | Neutr>
       | <Sg,Acc,Masc Anim>     => afs.msgen ;
-    <Sg, Gen, Fem>
+    <Sg, Gen|Dat|Loc, Fem>     => afs.fsgen ;
-      | <Pl,Acc,Masc _|Fem>    => afs.fsgen ;
-
     <Sg, Dat, Masc _|Neutr>    => afs.msdat ;
-    <Sg, Dat|Loc, Fem>         => afs.fsdat ;
 
     <Sg, Acc, Fem>             => afs.fsacc ;
-
     <Sg, Loc, Masc _|Neutr>    => afs.msloc ;
-
     <Sg, Ins, Masc _|Neutr>
       | <Pl,Dat,_>             => afs.msins ;
     <Sg, Ins, Fem>             => afs.fsins ;
 
-    <Pl, Nom, Masc Anim>       => afs.mpnom ;
+    <Pl, Nom, Masc Anim>       => afs.ampnom ;
-    <Pl, Nom, Masc Inanim|Fem> => afs.fpnom ;
+    <Pl, Gen|Loc,_> 
-
+      | <Pl, Acc, Masc Anim>   => afs.pgen ;
-    <Pl, Gen|Loc,_> => afs.pgen ;
     <Pl, Ins,_>     => afs.pins
     }
 
     } ;
 
--- hard declension
+  guessAdjForms : Str -> AdjForms
+    = \s -> case s of {
+        _ + "ý"  => peknyA s ;
+        _ + "y"  => krasnyA s ;
+        _ + "í"  => cudziA s ;
+        _ + "i"  => rydziA s ;
+        _ + "ov" => otcovA s ;
+        _ => Predef.error ("no mkA for" ++ s)
+        } ;
 
-  mladyAdjForms : Str -> AdjForms = \mlady ->
+
-    let mlad = init mlady
+-- hard consonant + y
+
+  peknyA : Str -> AdjForms = \pekny ->
+    let pekn = init pekny
     in {
-      msnom                    = mlad + "ý" ;
+      msnom   = pekn + "ý" ;
-      fsnom                    = mlad + "á" ;
+      fsnom   = pekn + "á" ;
-      nsnom,fsgen,fsdat,fpnom  = mlad + "é" ;
+      nsnom   = pekn + "é" ;
-      msgen                    = mlad + "ého" ;
+      msgen   = pekn + "ého" ;
-      msdat                    = mlad + "ému" ;
+      fsgen   = pekn + "ej" ;
-      fsacc,fsins              = mlad + "ou" ;
+      msdat   = pekn + "ému" ;
-      msloc                    = mlad + "ém" ;
+      fsacc   = pekn + "ú" ;
-      msins,pdat               = mlad + "ým" ;
+      msloc   = pekn + "om" ;
-      mpnom                    = addAdjI mlad ;
+      msins   = pekn + "ým" ;
-      pgen                     = mlad + "ých" ;
+      fsins   = pekn + "ou" ;
-      pins                     = mlad + "ými" ;
+      ampnom  = pekn + "í" ;
+      pgen    = pekn + "ých" ;
+      pins    = pekn + "ými" ;
       } ;
 
--- soft declension
+-- if the penultimate has accent, e.g. krásny, the last accent disappears
+  krasnyA : Str -> AdjForms = \krasny ->
+    let
+      krasn = init krasny ;
+    in peknyA krasny ** {
+      msnom   = krasn + "y" ;
+      fsnom   = krasn + "a" ;
+      nsnom   = krasn + "e" ;
+      msgen   = krasn + "eho" ;
+      msdat   = krasn + "emu" ;
+      fsacc   = krasn + "u" ;
+      msins   = krasn + "ym" ;
+      ampnom  = krasn + "i" ;
+      pgen    = krasn + "ych" ;
+      pins    = krasn + "ymi" ;
+      } ;
 
-  jarniAdjForms : Str -> AdjForms = \jarni ->
+-- soft consonant + i
-    {
+
-      msnom,fsnom,nsnom,
+  cudziA : Str -> AdjForms = \cudzi ->
-      fsgen,fsdat,fsacc,fsins,
+    let cudz = init cudzi
-      mpnom,fpnom              = jarni ;
+    in {
-      msgen                    = jarni + "ho" ;
+      msnom   = cudz + "í" ;
-      msdat                    = jarni + "mu" ;
+      fsnom   = cudz + "ia" ;
-      msloc,msins              = jarni + "m" ;
+      nsnom   = cudz + "ie" ;
-      pgen                     = jarni + "ch" ;
+      msgen   = cudz + "ieho" ;
-      pins                     = jarni + "mi" ;
+      fsgen   = cudz + "ej" ;
+      msdat   = cudz + "iemu" ;
+      fsacc   = cudz + "iu" ;
+      msloc   = cudz + "om" ;
+      msins   = cudz + "ím" ;
+      fsins   = cudz + "ou" ;
+      ampnom  = cudz + "í" ;
+      pgen    = cudz + "ích" ;
+      pins    = cudz + "ími" ;
+      } ;
+
+-- accented vowel + soft consonant + i
+  rydziA : Str -> AdjForms = \rydzi ->
+    let rydz = init rydzi
+    in peknyA rydzi ** {
+      msnom   = rydz + "i" ;
+      fsnom   = rydz + "a" ;
+      nsnom   = rydz + "e" ;
+      msgen   = rydz + "eho" ;
+      msdat   = rydz + "emu" ;
+      fsacc   = rydz + "u" ;
+      msins   = rydz + "im" ;
+      ampnom  = rydz + "i" ;
+      pgen    = rydz + "ich" ;
+      pins    = rydz + "imi" ;
       } ;
 
 -- masculine possession: the same endings as in feminine
 
-  otcuvAdjForms : Str -> AdjForms = \otcuv ->
+  otcovA : Str -> AdjForms = \otcov ->
-    let otcov = Predef.tk 2 otcuv + "ov"
-    in
-    matcinAdjForms otcov ** {msnom = otcuv} ;
-
--- feminine possession
-
-  matcinAdjForms : Str -> AdjForms = \matcin ->
      {
-      msnom                    = matcin ;
+      msnom   = otcov ;
-      fsnom,msgen              = matcin + "a" ;
+      fsnom   = otcov + "a" ;
-      nsnom                    = matcin + "o" ;
+      nsnom   = otcov + "o" ;
-      fsgen,fpnom              = matcin + "y" ;
+      msgen   = otcov + "ho" ;
-      msdat,fsacc              = matcin + "u" ;
+      fsgen   = otcov + "ej" ;
-      fsdat,msloc              = matcin + "ě" ;
+      msdat   = otcov + "mu" ;
-      msins                    = matcin + "ým" ;
+      fsacc   = otcov + "u" ;
-      fsins                    = matcin + "ou" ;
+      msloc   = otcov + "om" ;
-      mpnom                    = matcin + "i" ;
+      msins   = otcov + "ým" ;
-      pgen                     = matcin + "ých" ;
+      fsins   = otcov + "ou" ;
-      pins                     = matcin + "ými" ;
+      ampnom  = otcov + "i" ;
+      pgen    = otcov + "ých" ;
+      pins    = otcov + "ými" ;
       } ;
 
 ---------------------
@@ -685,52 +674,51 @@ adjFormsAdjective : AdjForms -> Adjective = \afs -> {
     {a = a ; cnom = []} **
     case a of {
       Ag _ Sg P1 => {
-        nom = "já" ;
+        nom = "ja" ;
-        gen,acc,pgen,pacc = "mne" ;
+        gen,acc,pgen,pacc = "mňa" ;
-        cgen,cacc = "mě" ;
+        cgen,cacc = "ma" ;
-        dat,pdat,loc = "mně" ;
+        dat,pdat,loc = "mne" ;
         cdat = "mi" ;
         ins,pins = "mnou"
         } ;
       Ag _ Sg P2 => {
         nom = "ty" ;
-        gen,acc,pgen,pacc = "tebe" ;
+        gen,acc,pgen,pacc = "teba" ;
-        cgen,cacc = "tě" ;
+        cgen,cacc = "ťa" ;
-        dat,pdat,loc = "tobě" ;
+        dat,pdat,loc = "tebe" ;
         cdat = "ti" ;
         ins,pins = "tebou"
         } ;
       Ag (Masc _) Sg P3 => {
         nom = "on" ;
-        gen,acc = "jeho" ;
+        gen,acc = "jeho" ;  ---- + other forms
         cgen,cacc = "ho" ;
-        pgen,pacc = "něho" ;
+        pgen,pacc = "neho" ; ---- + other forms
         dat = "jemu" ;
 	cdat = "mu" ;
-	pdat = "němu" ;
+	pdat = "nemu" ;
-	loc = "něm" ;
+	loc = "ňom" ;
-	ins = "jím" ;
+	ins,pins = "ním" ;
-	pins = "ním" ;
         } ;
       Ag Fem Sg P3 => {
         nom = "ona" ;
-        gen = "její" ;
+        gen,cgen,pgen,acc,cacc,pacc = "ju" ;
-        dat,acc,cgen,cacc,cdat,ins = "ji" ;
+        cdat = "jej" ;
-        pgen,pdat,pacc,loc,pins = "ní" ;
+	dat,pdat,loc = "nej" ;
+        ins,pins = "ní" ;
         } ;
       Ag Neutr Sg P3 => {
         nom = "ono" ;
         gen = "jeho" ;
         cgen,cacc = "ho" ;
-        pgen = "něho" ;
+        pgen = "neho" ;
         dat = "jemu" ;
 	acc = "je" ;
-        pacc = "ně" ;
+        pacc = "eň" ; ---- bind?
 	cdat = "mu" ;
-	pdat = "němu" ;
+	pdat = "nemu" ;
-	loc = "něm" ;
+	loc = "ňom" ;
-	ins = "jím" ;
+	ins,pins = "ním" ;
-	pins = "ním" ;
         } ;
       Ag _ Pl P1 => {
         nom = "my" ;
@@ -739,7 +727,7 @@ adjFormsAdjective : AdjForms -> Adjective = \afs -> {
           pgen,pacc,
 	  loc  = "nás" ;
         dat,cdat,pdat = "nám" ;
-	ins,pins = "námi" ;
+	ins,pins = "nami" ;
         } ;
       Ag _ Pl P2 => {
         nom = "vy" ;
@@ -748,23 +736,25 @@ adjFormsAdjective : AdjForms -> Adjective = \afs -> {
           pgen,pacc,
 	  loc  = "vás" ;
         dat,cdat,pdat = "vám" ;
-	ins,pins = "vámi" ;
+	ins,pins = "vami" ;
         } ;
-      Ag g Pl P3 => {
+      Ag (Masc Anim) Pl P3 => {
-        nom = case g of {
+        nom = "oni" ;
-	  Masc _ => "oni" ;
+	gen,cgen,acc,cacc = "ich" ;
-	  Fem => "ony" ;
+	pgen,pacc = "nich" ;
-	  Neutr => "ona"
+	dat,cdat = "im" ;
-	  } ;
-	gen,cgen = "jich" ;
-	pgen = "nich" ;
-	dat,cdat = "jim" ;
 	pdat = "nim" ;
-	acc,cacc = "je" ;
-	pacc = "ně" ;
 	loc = "nich" ;
-	ins = "jimi" ;
+	ins,pins = "nimi" ;
-	pins = "nimi" ;
+	} ;
+      Ag _ Pl P3 => {
+        nom = "ony" ;
+	gen,cgen,acc,cacc = "ich" ;
+	pgen,pacc = "ne" ;
+	dat,cdat = "im" ;
+	pdat = "nim" ;
+	loc = "nich" ;
+	ins,pins = "nimi" ;
 	}
 
       } ;
@@ -775,12 +765,12 @@ adjFormsAdjective : AdjForms -> Adjective = \afs -> {
 oper
   DemPronForms : Type = {
     msnom, fsnom, nsnom, 
-    msgen, fsgen,
+    msgen, fsgen, pgen,
     msdat, -- fsdat = fsgen unlike AdjForms
     fsacc,
     msloc,
     msins, fsins,
-    mpnom, fpnom, -- mpacc = fpacc = fpnom
+    ampnom, fpnom, -- mpacc = fpacc = fpnom
     pgen,
     pdat,  -- NOT msins like AdjForms
     pins : Str
@@ -804,34 +794,34 @@ oper
     size : NumSize
     } ;
 
-  mkDemPronForms : Str -> DemPronForms = \t -> {
+  mkDemPronForms : Str -> DemPronForms = \jedn -> {
-    msnom = t + "en" ;
+      msnom   = jedn + "y" ;
-    fsnom = t + "a" ;
+      fsnom   = jedn + "a" ;
-    nsnom = t + "o" ;
+      nsnom   = jedn + "o" ;
-    msgen = t + "oho" ;
+      msgen   = jedn + "ého" ;
-    fsgen = t + "é" ;
+      fsgen   = jedn + "ej" ;
-    msdat = t + "omu" ;
+      msdat   = jedn + "ému" ;
-    fsacc = t + "u" ;
+      fsacc   = jedn + "u" ;
-    msloc = t + "om" ;
+      msloc   = jedn + "om" ;
-    msins = t + "ím" ;
+      msins   = jedn + "ým" ;
-    fsins = t + "ou" ;
+      fsins   = jedn + "ou" ;
-    mpnom = t + "i" ;
+      ampnom  = jedn + "i" ;
-    fpnom = t + "y" ;
+      fpnom   = jedn + "é" ; ---- ?
-    pgen  = t + "ěch" ;
+      pgen    = jedn + "ých" ;
-    pdat  = t + "ěm" ;
+      pdat    = jedn + "ým" ;
-    pins  = t + "ěmi" ;
+      pins    = jedn + "ými" ;
     } ;
 
   invarDemPronForms : Str -> DemPronForms = \s -> {
     msnom, fsnom, nsnom, msgen, fsgen,
     msdat, fsacc, msloc, msins, fsins,
-    mpnom, fpnom, pgen, pdat, pins = s ;
+    ampnom, fpnom, pgen, pdat, pins = s ;
     } ;
 
 -- interrogatives
 
  kdoForms : Case => Str = table {
-   Nom => "kdo" ;
+   Nom => "kto" ;
    Gen | Acc => "koho" ;
    Dat => "komu" ;
    Loc => "kom" ;
@@ -839,10 +829,10 @@ oper
    } ;
 
  coForms : Case => Str = table {
-   Nom|Acc => "co" ;
+   Nom|Acc => "čo" ;
-   Gen => "čeho" ;
+   Gen => "čoho" ;
    Dat => "čemu" ;
-   Loc => "čem" ;
+   Loc => "čom" ;
    Ins => "čím"
    } ;
 
@@ -850,6 +840,7 @@ oper
 
   -- singular forms of demonstratives
   NumeralForms : Type = {
+ ----   amsnom,
     msnom, fsnom, nsnom,
     msgen, fsgen,
     msdat,
@@ -862,11 +853,14 @@ oper
     \nume,size ->
     let
       dem = nume **
-        {mpnom, fpnom, pgen, pdat, pins = nume.msnom} ; --- plural forms not used
+        {ampnom, fpnom, pgen, pdat, pins = nume.msnom} ; --- plural forms not used
       demAdj = dem ** {fsdat = dem.fsgen} ;
       adjAdj = adjFormsAdjective demAdj
     in {
-      s = \\g,c => adjAdj.s ! g ! Sg ! c ;
+      s = \\g,c => case <g,c> of {
+----         <Masc Anim, Nom> => nume.amsnom ;
+         _ => adjAdj.s ! g ! Sg ! c
+	 } ;
       size = size
       } ;
 
@@ -876,36 +870,43 @@ oper
   -- numbers 2,3,4 ---- to check if everything comes out right with the determiner type
   twoNumeral : Determiner =
     let forms = {
-      msnom = "dva" ; fsnom, nsnom, fsacc = "dvě" ;
+----    amsnom = "dvaja" ;
-      msgen, fsgen, msloc = "dvou" ;
+      msnom = "dva" ; fsnom, nsnom, fsacc = "dve" ; 
-      msdat, msins, fsins = "dvěma"
+      msgen, fsgen, msloc = "dvoch" ;
+      msdat = "dvom" ;
+      msins, fsins = "dvoma"
       }
     in numeralFormsDeterminer forms Num2_4 ;
 
   threeNumeral : Determiner =
     let forms = {
-      msnom, fsnom, nsnom, fsacc, msgen, fsgen = "tři" ;
+      ---- amsnom = "traja" ;
-      msdat = "třem" ;
+      msnom, fsnom, nsnom, fsacc = "tri" ; ---- amsacc = "troch"
-      msloc = "třech" ;
+      msgen, fsgen = "troch" ;
-      msins,fsins = "třemi" ;
+      msdat = "trom" ;
+      msloc = "troch" ;
+      msins,fsins = "tromi" ;
       }
     in numeralFormsDeterminer forms Num2_4 ;
 
   fourNumeral : Determiner =
-    let forms = {
+      let forms = {
-      msnom, fsnom, nsnom, fsacc = "čtyři" ;
+      ---- amsnom = "štiraja" ;
-      msgen, fsgen = "čtyř" ;
+      msnom, fsnom, nsnom, fsacc = "štiri" ; ---- amsacc = "štiroch"
-      msdat = "čtyřem" ;
+      msgen, fsgen = "štiroch" ;
-      msloc = "čtyřech" ;
+      msdat = "štirom" ;
-      msins,fsins = "čtyřmi" ;
+      msloc = "štiroch" ;
+      msins,fsins = "štiromi" ;
       }
     in numeralFormsDeterminer forms Num2_4 ;
 
   -- for the numbers 5 upwards
-  regNumeral : Str -> Str -> Determiner = \pet,peti ->
+  regNumeral : Str -> Str -> Determiner = \pät,piati ->
     let forms = {
-      msnom,fsnom,nsnom = pet ;
+      msnom,fsnom,nsnom, fsacc = pät ;
-      msgen, fsgen, msdat, fsacc, msloc, msins, fsins = peti
+      msgen, fsgen, msloc = piati + "ch" ;
+      msdat = piati + "m" ;
+      msins, fsins = piati + "mi" ;
       }
     in numeralFormsDeterminer forms Num5 ;