From 5f436574f992b081d8e0602bbfe9bb485ab580fd Mon Sep 17 00:00:00 2001
From: Aarne Ranta <aarne@chalmers.se>
Date: Sat, 4 Apr 2020 10:29:57 +0200
Subject: [PATCH] more paradigms for Cze N and A

---
 src/czech/ParadigmsCze.gf | 137 ++++++++++++++++++++++++++++++++++----
 src/czech/ResCze.gf       |  23 ++++++-
 2 files changed, 143 insertions(+), 17 deletions(-)

diff --git a/src/czech/ParadigmsCze.gf b/src/czech/ParadigmsCze.gf
index e2372853..03fabf07 100644
--- a/src/czech/ParadigmsCze.gf
+++ b/src/czech/ParadigmsCze.gf
@@ -1,20 +1,117 @@
 resource ParadigmsCze = open CatCze, ResCze, Prelude in {
 
-oper
-  mkPrep : Str -> Case -> Prep
-    = \s,c -> lin Prep {s = s ; c = c ; hasPrep = True} ; ---- True if s /= ""
-    
-  mkConj : Str -> Conj
-    = \s -> lin Conj {s1 = [] ; s2 = s} ;
+----------------
+-- Parameters
 
-  mkA : Str -> A
-    = \s -> lin A (case s of {
-      _ + "ý"  => mladyAdjForms s ;
-      _ + "í"  => jarniAdjForms s ;
-      _ + "ův" => otcuvAdjForms s ;
-      _ + "in" => matcinAdjForms s ;
-      _ => Predef.error ("no mkA for" ++ s)
-      }) ;
+oper
+  singular : Number
+    = Sg ;
+  plural : Number
+    = Pl ;
+
+  mascAnimate : Gender
+    = Masc Anim ;
+  mascInanimate : Gender
+    = Masc Inanim ;
+  feminine : Gender
+    = Fem ;
+  neuter : Gender
+    = Neutr ;
+
+  nominative : Case
+    = Nom ;
+  genitive : Case
+    = Gen ;
+  dative : Case
+    = Dat ;
+  accusative : Case
+    = Acc ;
+  vocative : Case
+    = ResCze.Voc ;
+  locative : Case
+    = Loc ;
+  instrumental : Case
+    = Ins ;
+
+------------------------------
+-- Nouns
+
+oper
+  mkN = overload {
+    mkN : (nom : Str) -> N
+      = \nom -> lin N (guessNounForms nom) ;
+    mkN : (nom,gen : Str) -> Gender -> N
+      = \nom,gen,g -> lin N (declensionNounForms nom gen g) ;
+    } ;
+
+-- The following standard declensions can be used with good accuracy.
+-- However, they have some defaults that may have to be overwritten.
+-- This can be done easily by overriding those formes with record extension (**).
+-- The default extensions are shown in comments; if the default is correct, no extension is needed.
+
+  panN : Str -> N       -- default ** {pnom = +i}
+    = \s -> lin N (declPAN s) ;
+  predsedaN : Str -> N  -- default ** {sgen = +i}
+    = \s -> lin N (declPREDSEDA s) ;
+  hradN : Str -> N      -- default ** {sgen,sloc = +u}
+    = \s -> lin N (declHRAD s) ;
+  zenaN : Str -> N      -- default ** {pgen = zen}
+    = \s -> lin N (declZENA s) ;
+  mestoN : Str -> N     -- default ** {sloc = +u ; pgen = mest ; ploc = +ech}
+    = \s -> lin N (declMESTO s) ;
+  muzN : Str -> N
+    = \s -> lin N (declMUZ s) ;
+  soudceN : Str -> N    -- default ** {sdat,sloc = +i ; pnom = +i}  
+    = \s -> lin N (declSOUDCE s) ;
+  strojN : Str -> N
+    = \s -> lin N (declSTROJ s) ;
+  ruzeN : Str -> N
+    = \s -> lin N (declRUZE s) ;
+  pisenN : Str -> N
+    = \s -> lin N (declPISEN s) ;
+  kostN : Str -> N
+    = \s -> lin N (declKOST s) ;
+  kureN : Str -> N
+    = \s -> lin N (declKURE s) ;
+  moreN : Str -> N     -- default ** {pgen = +í}
+    = \s -> lin N (declMORE s) ;
+  staveniN : Str -> N
+    = \s -> lin N (declSTAVENI s) ;
+
+-- The full definition of the noun record is
+-- {
+--  snom,sgen,sdat,sacc,svoc,sloc,sins, pnom,pgen,pdat,pacc,ploc,pins : Str ;
+--  g : Gender
+-- }
+
+
+---------------------
+-- Adjectives
+
+-- Only positive forms so far ----
+
+  mkA = overload {
+    mkA : Str -> A
+      = \s -> lin A (case s of {
+        _ + "ý"  => mladyAdjForms s ;
+        _ + "í"  => jarniAdjForms s ;
+        _ + "ův" => otcuvAdjForms s ;
+        _ + "in" => matcinAdjForms s ;
+        _ => Predef.error ("no mkA for" ++ s)
+        }) ;
+    } ;
+
+  mladyA : Str -> A
+    = \s -> lin A (mladyAdjForms s) ;
+  jarniA : Str -> A
+    = \s -> lin A (jarniAdjForms s) ;
+  otcuvA : Str -> A
+    = \s -> lin A (otcuvAdjForms s) ;
+  matcinA : Str -> A
+    = \s -> lin A (matcinAdjForms s) ;
+
+-------------------------
+-- Verbs
 
   mkV2 = overload {
     mkV2 : VerbForms -> VerbForms ** {c : ComplementCase}
@@ -24,6 +121,18 @@ oper
     mkV2 : VerbForms -> ComplementCase -> VerbForms ** {c : ComplementCase}
       = \vf,c -> vf ** {c = c} ;
     } ;
+
+------------------------
+-- Adverbs, prepositions, conjunctions, ...
+
+  mkAdv : Str -> Adv
+    = \s -> lin Adv {s = s} ;
+
+  mkPrep : Str -> Case -> Prep
+    = \s,c -> lin Prep {s = s ; c = c ; hasPrep = True} ; ---- True if s /= ""
     
+  mkConj : Str -> Conj
+    = \s -> lin Conj {s1 = [] ; s2 = s} ;
+
 
 }
diff --git a/src/czech/ResCze.gf b/src/czech/ResCze.gf
index c4879420..632b0baa 100644
--- a/src/czech/ResCze.gf
+++ b/src/czech/ResCze.gf
@@ -120,8 +120,9 @@ oper
 
   DeclensionType : Type = Str -> NounForms ;
   
-  declensionType : (nom,gen : Str) -> Gender -> DeclensionType
-    = \nom,gen,g -> case <g, nom, gen> of {
+  declensionNounForms : (nom,gen : Str) -> Gender -> NounForms
+    = \nom,gen,g ->
+    let decl : DeclensionType = case <g, nom, gen> of {
       <Masc Anim,   _ + #hardConsonant, _ + "a"> => declPAN ;
       <Masc Anim,   _ + "a"           , _ + "a"> => declPREDSEDA ;
       <Masc Inanim, _ + #hardConsonant, _ + "u"> => declHRAD ;
@@ -138,7 +139,23 @@ oper
       <Neutr,       _ + "e"           , _ + "e"> => declMORE ;
       <Neutr,       _ + "í"           , _ + "í"> => declSTAVENI ;
       _ => Predef.error ("cannot infer declension type for" ++ nom ++ gen)
-      } ;
+      }
+    in decl nom ;
+
+  guessNounForms : Str -> NounForms
+    = \s -> case s of {
+      _ + "ost"          => declKOST s ;
+      _ + "tel"          => declMUZ s ;
+      _ + #hardConsonant => declHRAD s ;
+      _ + #softConsonant => declSTROJ s ;
+      _ + "a"            => declZENA s ;
+      _ + "o"            => declMESTO s ;
+      _ + "ce"           => declSOUDCE s ;
+      _ + "e"            => declMORE s ;
+      _ + "í"            => declSTAVENI s ;
+      _ => Predef.error ("cannot guess declension type for" ++ s)
+      } ; 
+  
 
 -- source: https://en.wikipedia.org/wiki/Czech_declension