mirror of
https://github.com/GrammaticalFramework/gf-rgl.git
synced 2026-10-02 15:13:39 -06:00
1468 lines
48 KiB
Plaintext
1468 lines
48 KiB
Plaintext
resource ResCze = ParamX ** open Prelude in {
|
|
|
|
-- AR March 2020
|
|
-- sources:
|
|
-- Wiki = https://en.wikipedia.org/wiki/Czech_declension, https://en.wikipedia.org/wiki/Czech_conjugation
|
|
-- CEG = J. Naughton, Czech: an Essential Grammar, Routledge 2005.
|
|
|
|
-- parameters
|
|
|
|
param
|
|
Animacy = Anim | Inanim ;
|
|
Gender = Masc Animacy | Fem | Neutr ;
|
|
|
|
Case = Nom | Gen | Dat | Acc | Voc | Loc | Ins ; -- traditional order
|
|
|
|
Agr = Ag Gender Number Person | AgPol Gender | AgQuant Gender ; -- polite singular: plural verb, singular predicate
|
|
|
|
oper
|
|
agrGender : Agr -> Gender = \a -> case a of {
|
|
Ag g _ _ => g ; AgPol g => g ; AgQuant g => g
|
|
} ;
|
|
|
|
agrNumber : Agr -> Number = \a -> case a of {
|
|
Ag _ n _ => n ; AgPol _ => Sg ; AgQuant _ => Pl
|
|
} ;
|
|
|
|
agrPerson : Agr -> Person = \a -> case a of {
|
|
Ag _ _ p => p ; _ => P3
|
|
} ;
|
|
|
|
|
|
-- phonology
|
|
hardConsonant : pattern Str = #("d"|"t"|"g"|"h"|"k"|"n"|"r") ;
|
|
softConsonant : pattern Str = #("ť"|"ď"|"j"|"ň"|"ř"|"š"|"c"|"č"|"ž") ;
|
|
neutralConsonant : pattern Str = #("b"|"f"|"l"|"m"|"p"|"s"|"v") ;
|
|
|
|
-- neutral consonants take the hard endings by default (hrad, pán), and so do
|
|
-- the foreign "z" and "x"; this is the class to test when choosing a paradigm
|
|
hardishConsonant : pattern Str =
|
|
#("d"|"t"|"g"|"h"|"k"|"n"|"r" | "b"|"f"|"l"|"m"|"p"|"s"|"v" | "z"|"x") ;
|
|
|
|
consonant : pattern Str =
|
|
#(
|
|
"d" | "t" | "g" | "h" | "k" | "n" | "r" |
|
|
"ť" | "ď" | "j" | "ň" | "ř" | "š" | "c" | "č" | "ž" |
|
|
"b" | "f" | "l" | "m" | "p" | "s" | "v"
|
|
) ;
|
|
|
|
dropFleetingE : Str -> Str = \s -> case s of {
|
|
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) + "í"
|
|
} ;
|
|
|
|
-- Before i/í/ě the vowel letter carries the dental's palatalization.
|
|
dentalStem : Str -> Str = \s -> case s of {
|
|
stem + "ň" => stem + "n" ; stem + "ť" => stem + "t" ;
|
|
stem + "ď" => stem + "d" ; _ => s
|
|
} ;
|
|
|
|
-- The žena ending is spelled i after a soft consonant, otherwise y.
|
|
addY : Str -> Str = \s -> case s of {
|
|
_ + #softConsonant => dentalStem s + "i" ; _ => s + "y"
|
|
} ;
|
|
|
|
-- 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" ;
|
|
stem + "l" => stem + "le" ;
|
|
stem + "z" => stem + "ze" ;
|
|
stem + "s" => stem + "se" ;
|
|
_ + ("ň"|"ť"|"ď") => dentalStem s + "ě" ;
|
|
_ + #softConsonant => s + "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 + "í" ;
|
|
_ => "" + s -- Predef.error ("shortFemPlGen does not apply to" ++ s)
|
|
} ;
|
|
|
|
---------------
|
|
-- Nouns
|
|
---------------
|
|
|
|
-- novel idea (for RGL): lexical items stored as records rather than tables
|
|
-- advantages:
|
|
-- - easier to make exceptions to paradigms (by ** {})
|
|
-- - easier to keep the number of forms minimal
|
|
-- - easier to see what is happening than with lots of anonymous arguments to mkN, mkA, mkV
|
|
|
|
-- so this is the lincat of N
|
|
|
|
NounForms : Type = {snom,sgen,sdat,sacc,svoc,sloc,sins, pnom,pgen,pdat,pacc,ploc,pins : Str ; g,gPl : Gender} ;
|
|
|
|
-- But traditional tables make agreement easier to handle in syntax
|
|
-- so this is the lincat of CN
|
|
|
|
Noun : Type = {s : Number => Case => Str ; g,gPl : Gender} ;
|
|
|
|
-- this is used in UseN
|
|
|
|
nounFormsNoun : NounForms -> Noun
|
|
= \forms -> {
|
|
s = table {
|
|
Sg => table {
|
|
Nom => forms.snom ;
|
|
Gen => forms.sgen ;
|
|
Dat => forms.sdat ;
|
|
Acc => forms.sacc ;
|
|
Voc => forms.svoc ;
|
|
Loc => forms.sloc ;
|
|
Ins => forms.sins
|
|
} ;
|
|
Pl => table {
|
|
Nom | Voc => forms.pnom ;
|
|
Gen => forms.pgen ;
|
|
Dat => forms.pdat ;
|
|
Acc => forms.pacc ;
|
|
Loc => forms.ploc ;
|
|
Ins => forms.pins
|
|
}
|
|
} ;
|
|
g = forms.g ; gPl = forms.gPl
|
|
} ;
|
|
|
|
-- terminology of CEG
|
|
DeclensionType : Type = Str -> NounForms ;
|
|
|
|
declensionNounForms : (nom,gen : Str) -> Gender -> NounForms
|
|
= \nom,gen,g ->
|
|
-- the oblique stem, for the paradigms that cannot derive it from the nominative
|
|
let stem : Str = Predef.tk 1 gen ;
|
|
decl : DeclensionType = case <g, nom, gen> of {
|
|
<Masc Anim, _ + "tel" , _ + "e"> => declMUZstem stem ;
|
|
<Masc Anim, _ + "ce" , _ + "e"> => declSOUDCE ;
|
|
<Masc Anim, _ + ("us"|"os") , _ + "a"> => declLATINUSA ;
|
|
<Masc Anim, _ + "a" , _ + "a"> => declPREDSEDA ;
|
|
<Masc Anim, _ + (#softConsonant|#hardishConsonant), _ + ("e"|"ě")> => declMUZstem stem ;
|
|
<Masc Anim, _ + #hardishConsonant, _ + "a"> => declPAN ;
|
|
<Masc Inanim, _ + ("us"|"os") , _ + "u"> => declLATINUS ;
|
|
<Masc Inanim, _ + "ý" , _ + "ého"> => declADJM ;
|
|
<Masc Inanim, _ + (#softConsonant|#hardishConsonant), _ + ("e"|"ě")> => declSTROJ ;
|
|
<Masc Inanim, _ + #hardishConsonant, _ + "u"> => declHRADstem stem ;
|
|
<Masc Inanim, _ + #hardishConsonant, _ + "a"> => declHRADAstem stem ;
|
|
<Fem, _ + "a" , _ + "y"> => declZENA ;
|
|
<Fem, _ + "á" , _ + "é"> => declADJF ;
|
|
<Fem, _ + ("e"|"ě") , _ + ("e"|"ě")> => declRUZE ;
|
|
<Fem, _ + (#softConsonant|#hardishConsonant), _ + "i"> => declKOST ; --- also many other "st" 3.6.3
|
|
<Fem, _ + (#softConsonant|#hardishConsonant), _ + ("e"|"ě")> => declPISEN ;
|
|
<Neutr, _ + "um" , _ + "a"> => declLATINUM ;
|
|
<Neutr, _ + "ma" , _ + ("matu"|"mata")> => declGREEKMA ;
|
|
<Neutr, _ + "o" , _ + "a"> => declMESTO ;
|
|
<Neutr, _ + "e" , _+"ete"> => declKURE ;
|
|
<Neutr, _ + "í" , _ + "í"> => declSTAVENI ;
|
|
<Neutr, _ + ("e"|"ě") , _ + ("e"|"ě")> => declMORE ;
|
|
<Masc Inanim, _ + ("é"|"i"|"y"|"e"), _ + ("é"|"i"|"y"|"e")> => declINVAR (Masc Inanim) ;
|
|
<Neutr, _ + ("é"|"i"|"y") , _ + ("é"|"i"|"y")> => declINVAR Neutr ;
|
|
_ => (\s -> declSTROJ ("" + s)) -- Predef.error ("cannot infer declension type for" ++ nom ++ gen)
|
|
}
|
|
in decl nom ;
|
|
|
|
-- the "smartest" one-argument mkN
|
|
|
|
guessNounForms : Str -> NounForms
|
|
= \s -> case s of {
|
|
_ + "ost" => declKOST s ;
|
|
_ + "tel" => declMUZ s ;
|
|
_ + "us" => declLATINUS s ;
|
|
_ + "um" => declLATINUM s ;
|
|
_ + #hardishConsonant => declHRAD s ;
|
|
_ + #softConsonant => declSTROJ s ;
|
|
_ + "a" => declZENA s ;
|
|
_ + "o" => declMESTO s ;
|
|
_ + "ce" => declSOUDCE s ;
|
|
_ + ("e"|"ě") => declMORE s ;
|
|
_ + "í" => declSTAVENI s ;
|
|
_ => declSTROJ ("" + s) -- Predef.error ("cannot guess declension type for" ++ s)
|
|
} ;
|
|
|
|
-- the traditional declensions, in both CEG and Wiki
|
|
-- they are also exported in ParadigmsCze with names panN etc
|
|
|
|
declPAN : DeclensionType = \pan -> --- plural nom ové|i|é can be changed with ** {pnom = ...} CEG 3.5.1
|
|
{
|
|
snom = pan ;
|
|
sgen,sacc = pan + "a" ;
|
|
sdat,sloc = pan + "ovi" ; --- pánu
|
|
svoc = shortenVowel pan + "e" ; --- "irregular shortening" 3.5.1
|
|
sins = pan + "em" ;
|
|
|
|
pnom = addI pan ; -- pani, kluk-kluci --- panové, host-hosté
|
|
pgen = pan + "ů" ;
|
|
pdat = pan + "ům" ;
|
|
pacc,pins = pan + "y" ;
|
|
ploc = addEch pan ;
|
|
g,gPl = Masc Anim
|
|
} ;
|
|
|
|
declPREDSEDA : DeclensionType = \predseda -> --- 3.5.4: sgen y/i
|
|
let predsed = init predseda
|
|
in
|
|
{
|
|
snom = predseda ;
|
|
sgen = predsed + "y" ; -- pacc,pins --- i
|
|
sdat,sloc = predsed + "ovi" ;
|
|
sacc = predsed + "u" ;
|
|
svoc = predsed + "o" ;
|
|
sins = predsed + "ou" ;
|
|
|
|
pnom = case predseda of {
|
|
tur + "ista" => tur + "isté" ;
|
|
_ => predsed + "ové"
|
|
} ;
|
|
pgen = predsed + "ů" ;
|
|
pdat = predsed + "ům" ;
|
|
pacc,pins = predsed + "y" ;
|
|
ploc = addEch predsed ;
|
|
g,gPl = Masc Anim
|
|
} ;
|
|
|
|
-- the oblique stem is a separate argument, because it cannot always be
|
|
-- derived from the nominative: uzel-uzlu but člen-členu
|
|
declHRADstem : Str -> DeclensionType = \hrd,hrad ->
|
|
{
|
|
snom,sacc = hrad ;
|
|
sgen,sdat = hrd + "u" ; --- Berlín-a
|
|
sloc = hrd + "u" ; --- addE hrad ; -- stůl-stole
|
|
svoc = hrd + "e" ;
|
|
sins = hrd + "em" ;
|
|
|
|
pnom,pacc,pins = hrd + "y" ;
|
|
pgen = hrd + "ů" ;
|
|
pdat = hrd + "ům" ;
|
|
ploc = addEch hrd ;
|
|
g,gPl = Masc Inanim
|
|
} ;
|
|
|
|
declHRAD : DeclensionType = \hrad -> --- 3.5.2: sloc u/ě/e extra arg, sport-u, hrad-ě ; sgen u/a
|
|
declHRADstem (dropFleetingE hrad) hrad ;
|
|
|
|
declZENA : DeclensionType = \zena -> --- 3.6.1 sge y/i ; pgen sometimes shortening
|
|
let zen = init zena
|
|
in
|
|
{
|
|
snom = zena ;
|
|
sgen = addY zen ;
|
|
sdat,sloc = addE zen ;
|
|
sacc = zen + "u" ;
|
|
svoc = shortenVowel zen + "o" ; ---- shorten ?
|
|
sins = zen + "ou" ;
|
|
|
|
pnom,pacc = addY zen ;
|
|
pgen = zen ; --- sometimes with vowel shortening
|
|
pdat = zen + "ám" ;
|
|
ploc = zen + "ách" ;
|
|
pins = zen + "ami" ;
|
|
g,gPl = Fem
|
|
} ;
|
|
|
|
declMESTO : DeclensionType = \mesto -> --- 3.7.1 sloc u/e ; pgen vowel shortening sometimes ; ploc variations
|
|
let mest = init mesto
|
|
in
|
|
{
|
|
snom,sacc,svoc = mesto ;
|
|
sgen = mest + "a" ;
|
|
sdat = mest + "u" ;
|
|
sloc = mest + "u" ; --- "ě"
|
|
sins = mest + "em" ;
|
|
|
|
pnom,pacc = mest + "a" ;
|
|
pgen = mest ; --- léta - let
|
|
pdat = mest + "ům" ;
|
|
ploc = mest + "ech" ; --- with variations
|
|
pins = mest + "y" ;
|
|
g,gPl = Neutr
|
|
} ;
|
|
|
|
-- Latin masculines in -us: the ending is dropped outside the nominative
|
|
-- (algoritmus - algoritmu), otherwise they follow hrad
|
|
declLATINUS : DeclensionType = \algoritmus ->
|
|
let algoritm = Predef.tk 2 algoritmus
|
|
in declHRAD algoritm ** {
|
|
snom, sacc = algoritmus ;
|
|
svoc = algoritm + "e"
|
|
} ;
|
|
|
|
declLATINUSA : DeclensionType = \genius ->
|
|
declLATINUS genius ** {g,gPl = Masc Anim} ;
|
|
|
|
-- Latin neuters in -um: the ending is dropped outside the nominative
|
|
-- (kontinuum - kontinua), otherwise they follow město
|
|
declLATINUM : DeclensionType = \kompaktum ->
|
|
let kompakt = Predef.tk 2 kompaktum
|
|
in declMESTO (kompakt + "o") ** {
|
|
snom, sacc, svoc = kompaktum
|
|
} ;
|
|
|
|
-- Greek neuters in -ma, with the stem extended by -t- (schéma - schématu)
|
|
declGREEKMA : DeclensionType = \schema ->
|
|
let schemat = schema + "t"
|
|
in {
|
|
snom,sacc,svoc = schema ;
|
|
sgen,sdat,sloc = schemat + "u" ;
|
|
sins = schemat + "em" ;
|
|
|
|
pnom,pacc = schemat + "a" ;
|
|
pgen = schemat ;
|
|
pdat = schemat + "ům" ;
|
|
ploc = schemat + "ech" ;
|
|
pins = schemat + "y" ;
|
|
g,gPl = Neutr
|
|
} ;
|
|
|
|
-- the hrad type with genitive -a instead of -u (les - lesa, zákon - zákona)
|
|
declHRADAstem : Str -> DeclensionType = \les_,les ->
|
|
declHRADstem les_ les ** {sgen = les_ + "a"} ;
|
|
|
|
declHRADA : DeclensionType = \les ->
|
|
declHRADAstem (dropFleetingE les) les ;
|
|
|
|
-- nouns that are adjectives in form: proměnná - proměnné, nultý - nultého
|
|
declADJF : DeclensionType = \promenna ->
|
|
let a = mladyAdjForms (init promenna + "ý")
|
|
in {
|
|
snom,svoc = a.fsnom ;
|
|
sgen = a.fsgen ;
|
|
sdat,sloc = a.fsdat ;
|
|
sacc = a.fsacc ;
|
|
sins = a.fsins ;
|
|
pnom,pacc = a.fpnom ;
|
|
pgen,ploc = a.pgen ;
|
|
pdat = a.msins ;
|
|
pins = a.pins ;
|
|
g,gPl = Fem
|
|
} ;
|
|
|
|
declADJM : DeclensionType = \nulty ->
|
|
let a = mladyAdjForms nulty
|
|
in {
|
|
snom,sacc,svoc = a.msnom ;
|
|
sgen = a.msgen ;
|
|
sdat = a.msdat ;
|
|
sloc = a.msloc ;
|
|
sins = a.msins ;
|
|
pnom,pacc = a.fpnom ;
|
|
pgen,ploc = a.pgen ;
|
|
pdat = a.msins ;
|
|
pins = a.pins ;
|
|
g,gPl = Masc Inanim
|
|
} ;
|
|
|
|
-- indeclinable loans: bombé, tamari, software
|
|
declINVAR : Gender -> DeclensionType = \g,s -> {
|
|
snom,sgen,sdat,sacc,svoc,sloc,sins = s ;
|
|
pnom,pgen,pdat,pacc,ploc,pins = s ;
|
|
g,gPl = g
|
|
} ;
|
|
|
|
declMUZ : DeclensionType = \muz_ -> --- 3.5.3 : sdat,sloc ; pnom
|
|
declMUZstem (dropFleetingE muz_) muz_ ;
|
|
|
|
declMUZstem : Str -> DeclensionType = \muz,muz_ ->
|
|
{
|
|
snom = muz_ ;
|
|
sgen,sacc = muz + "e" ; --- pacc
|
|
sdat,sloc = muz + "i" ; --- muzovi
|
|
svoc = case muz_ of {
|
|
chlap + "ec" => chlap + "če" ;
|
|
_ => muz + "i"
|
|
} ;
|
|
sins = muz + "em" ;
|
|
|
|
pnom = case muz_ of {
|
|
uci + "tel" => uci + "telé" ;
|
|
_ => muz + "i" --- muzové
|
|
} ;
|
|
pgen = muz + "ů" ;
|
|
pacc = muz + "e" ;
|
|
pdat = muz + "ům" ;
|
|
ploc = muz + "ích" ;
|
|
pins = muz + "i" ;
|
|
g,gPl = Masc Anim
|
|
} ;
|
|
|
|
declSOUDCE : DeclensionType = \soudce -> --- 3.5.3: sdat/sloc i,ovi ; pnom i/ové
|
|
let soudc = init soudce
|
|
in
|
|
{
|
|
snom,sgen,sacc,svoc = soudce ; ---- pacc
|
|
sdat,sloc = soudc + "i" ; --- soudcovi
|
|
sins = soudc + "em" ;
|
|
|
|
pnom = soudc + "i" ; --- soudcové
|
|
pgen = soudc + "ů" ;
|
|
pdat = soudc + "ům" ;
|
|
pacc = soudce ;
|
|
ploc = soudc + "ích" ;
|
|
pins = soudc + "i" ;
|
|
g,gPl = Masc Anim
|
|
} ;
|
|
|
|
declSTROJ : DeclensionType = \stroj ->
|
|
{
|
|
snom,sacc = stroj ;
|
|
sgen = stroj + "e" ; --- pnom,pacc
|
|
sdat,svoc,sloc = stroj + "i" ; --- pins ---- svoc shorten?
|
|
sins = stroj + "em" ;
|
|
|
|
pnom,pacc = stroj + "e" ;
|
|
pgen = stroj + "ů" ;
|
|
pdat = stroj + "ům" ;
|
|
ploc = stroj + "ích" ;
|
|
pins = stroj + "i" ;
|
|
g,gPl = Masc Inanim
|
|
} ;
|
|
|
|
declRUZE : DeclensionType = \ruze -> --- 3.6.2: pgen ulice-ulic, chvile-cvil
|
|
let ruz = init ruze
|
|
in
|
|
{
|
|
snom,sgen,svoc = ruze ; --- pnom,pacc
|
|
sdat,sacc,sloc = ruz + "i" ;
|
|
sins = ruz + "í" ;
|
|
|
|
pnom,pacc = ruze ;
|
|
pgen = shortFemPlGen ruze ;
|
|
pdat = ruz + "ím" ;
|
|
ploc = ruz + "ích" ;
|
|
pins = ruz + "emi" ;
|
|
g,gPl = Fem
|
|
} ;
|
|
|
|
declPISEN : DeclensionType = \pisen ->
|
|
let pisn = dentalStem (dropFleetingE pisen)
|
|
in
|
|
{
|
|
snom,sacc = pisen ;
|
|
sgen = pisn + "ě" ;
|
|
sdat,svoc,sloc = pisn + "i" ; -- not shortened
|
|
sins = pisn + "í" ;
|
|
|
|
pnom,pacc = pisn + "ě" ;
|
|
pgen = pisn + "í" ;
|
|
pdat = pisn + "ím" ;
|
|
ploc = pisn + "ích" ;
|
|
pins = pisn + "ěmi" ;
|
|
g,gPl = Fem
|
|
} ;
|
|
|
|
declKOST : DeclensionType = \kost ->
|
|
let stem = dentalStem kost
|
|
in
|
|
{
|
|
snom,sacc = kost ;
|
|
sgen,sdat,svoc,sloc = stem + "i" ; --- pnom,pacc
|
|
sins = stem + "í" ; --- pgen
|
|
|
|
pnom,pacc = stem + "i" ;
|
|
pgen = stem + "í" ;
|
|
pdat = stem + "em" ;
|
|
ploc = stem + "ech" ;
|
|
pins = kost + "mi" ;
|
|
g,gPl = Fem
|
|
} ;
|
|
|
|
declKURE : DeclensionType = \kure ->
|
|
let kur = init kure
|
|
in
|
|
{
|
|
snom,sacc,svoc = kure ;
|
|
sgen = kur + "ete" ;
|
|
sdat,sloc = kur + "eti" ;
|
|
sins = kur + "etem" ;
|
|
|
|
pnom,pacc = kur + "ata" ;
|
|
pgen = kur + "at" ;
|
|
pdat = kur + "atům" ;
|
|
ploc = kur + "atech" ;
|
|
pins = kur + "aty" ;
|
|
g,gPl = Neutr
|
|
} ;
|
|
|
|
declMORE : DeclensionType = \more -> --- 3.7.2 pgen zero sometimes
|
|
let mor = init more
|
|
in
|
|
{
|
|
snom,sgen,sacc,svoc = more ; --- pnom
|
|
sdat,sloc = mor + "i" ; --- pins
|
|
sins = mor + "em" ;
|
|
|
|
pnom,pacc = more ;
|
|
pgen = mor + "í" ; ---
|
|
pdat = mor + "ím" ;
|
|
ploc = mor + "ích" ;
|
|
pins = mor + "i" ;
|
|
g,gPl = Neutr
|
|
} ;
|
|
|
|
declSTAVENI : DeclensionType = \staveni ->
|
|
{
|
|
snom,sgen,sdat,sacc,svoc,sloc = staveni ;
|
|
sins = staveni + "m" ;
|
|
|
|
pnom,pgen,pacc = staveni ;
|
|
pdat = staveni + "m" ;
|
|
ploc = staveni + "ch" ;
|
|
pins = staveni + "mi" ;
|
|
g,gPl = Neutr
|
|
} ;
|
|
|
|
---------------------------
|
|
-- Adjectives
|
|
|
|
-- to be used for AP: 56 forms for each degree
|
|
Adjective : Type = {s : Gender => Number => Case => Str} ;
|
|
|
|
-- Long predicates agree with the counted noun; short predicates instead
|
|
-- use neuter singular with a quantified subject.
|
|
longPredicate : Adjective -> Agr => Str = \ap -> \\a => case a of {
|
|
Ag g n _ => ap.s ! g ! n ! Nom ;
|
|
AgPol g => ap.s ! g ! Sg ! Nom ;
|
|
AgQuant g => ap.s ! g ! Pl ! Gen
|
|
} ;
|
|
shortPredicate : Adjective -> Agr => Str = \ap -> \\a => case a of {
|
|
AgQuant _ => ap.s ! Neutr ! Sg ! Nom ;
|
|
_ => longPredicate ap ! a
|
|
} ;
|
|
|
|
-- to be used for A, in three degrees: 15 forms in each
|
|
DegreeForms : Type = AdjForms ** {compar,superl : AdjForms} ;
|
|
|
|
positiveAdj : AdjForms -> DegreeForms = \a -> a ** {
|
|
compar,superl = invarAdjForms nonExist
|
|
} ;
|
|
|
|
AdjForms : Type = {
|
|
msnom, fsnom, nsnom : Str ; -- svoc = snom
|
|
msgen, fsgen : Str ; -- nsgen = msgen, pacc = fsgen
|
|
msdat, fsdat : 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 ; -- pvoc = pnom, impnom = fpnom, npnom = fsnom
|
|
pgen : Str ; -- ploc = pgen
|
|
pins : Str ;
|
|
} ;
|
|
|
|
invarAdjForms : Str -> AdjForms = \s -> {
|
|
msnom, fsnom, nsnom, msgen, fsgen, msdat, fsdat, fsacc,
|
|
msloc, msins, fsins, mpnom, fpnom, pgen, pins = s ;
|
|
} ;
|
|
|
|
-- used in PositA but will also work in Compar and Superl by calling their record fields
|
|
|
|
adjFormsAdjective : AdjForms -> Adjective = \afs -> {
|
|
s = \\g,n,c => case <n,c,g> of {
|
|
|
|
<Sg, Nom|Voc, Masc _>
|
|
| <Sg, Acc, Masc Inanim> => afs.msnom ;
|
|
<Sg, Nom|Voc, Fem>
|
|
| <Pl, Nom|Acc|Voc, Neutr> => afs.fsnom ;
|
|
<Sg, Nom|Acc|Voc, Neutr> => afs.nsnom ;
|
|
|
|
<Sg, Gen, Masc _ | Neutr>
|
|
| <Sg,Acc,Masc Anim> => afs.msgen ;
|
|
<Sg, Gen, Fem>
|
|
| <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|Voc, Masc Anim> => afs.mpnom ;
|
|
<Pl, Nom|Voc, Masc Inanim|Fem> => afs.fpnom ;
|
|
|
|
<Pl, Gen|Loc,_> => afs.pgen ;
|
|
<Pl, Ins,_> => afs.pins
|
|
}
|
|
|
|
} ;
|
|
|
|
-- Regular comparison plus common lexical exceptions. Spelling cannot
|
|
-- determine semantic gradability or every stem alternation: callers can
|
|
-- supply a comparative or nonExist explicitly.
|
|
guessComparative : Str -> Str = \s -> case s of {
|
|
"dobrý" => "lepší" ; "špatný" | "zlý" => "horší" ;
|
|
"malý" => "menší" ; "velký" => "větší" ; "dlouhý" => "delší" ;
|
|
"mladý" => "mladší" ; "starý" => "starší" ;
|
|
"chudý" => "chudší" ; "tvrdý" => "tvrdší" ; "bledý" => "bledší" ;
|
|
"bílý" => "bělejší" ; "hnědý" => "hnědší" ; "hezký" => "hezčí" ;
|
|
stem + "cký" => stem + "čtější" ;
|
|
stem + "ský" => stem + "štější" ;
|
|
stem + ("ný" | "ní") => stem + "nější" ;
|
|
stem + "lý" => stem + "lejší" ;
|
|
stem + "rý" => stem + "řejší" ;
|
|
stem + "vý" => stem + "vější" ;
|
|
stem + "dý" => stem + "dější" ;
|
|
stem + "tý" => stem + "tější" ;
|
|
stem + "pý" => stem + "pější" ;
|
|
stem + "bý" => stem + "bější" ;
|
|
stem + "mý" => stem + "mější" ;
|
|
stem + "zí" => stem + "zejší" ;
|
|
stem + "ží" => stem + "žejší" ;
|
|
_ => nonExist
|
|
} ;
|
|
|
|
degreeAdjForms : Str -> Str -> DegreeForms = \p,c ->
|
|
(guessAdjForms p) ** {
|
|
compar = guessAdjForms c ; superl = guessAdjForms ("nej" + c)
|
|
} ;
|
|
|
|
guessAdjForms : Str -> AdjForms = \s -> case s of {
|
|
_ + "ý" => mladyAdjForms s ;
|
|
_ + "í" => jarniAdjForms s ;
|
|
_ + "ův" => otcuvAdjForms s ;
|
|
_ + "in" => matcinAdjForms s ;
|
|
_ => matcinAdjForms ("" + s) -- Predef.error ("no mkA for" ++ s)
|
|
} ;
|
|
|
|
-- hard declension
|
|
|
|
mladyAdjForms : Str -> AdjForms = \mlady ->
|
|
let mlad = init mlady
|
|
in {
|
|
msnom = mlad + "ý" ;
|
|
fsnom = mlad + "á" ;
|
|
nsnom,fsgen,fsdat,fpnom = mlad + "é" ;
|
|
msgen = mlad + "ého" ;
|
|
msdat = mlad + "ému" ;
|
|
fsacc,fsins = mlad + "ou" ;
|
|
msloc = mlad + "ém" ;
|
|
msins = mlad + "ým" ;
|
|
mpnom = addAdjI mlad ;
|
|
pgen = mlad + "ých" ;
|
|
pins = mlad + "ými" ;
|
|
} ;
|
|
|
|
-- soft declension
|
|
|
|
jarniAdjForms : Str -> AdjForms = \jarni ->
|
|
{
|
|
msnom,fsnom,nsnom,
|
|
fsgen,fsdat,fsacc,fsins,
|
|
mpnom,fpnom = jarni ;
|
|
msgen = jarni + "ho" ;
|
|
msdat = jarni + "mu" ;
|
|
msloc,msins = jarni + "m" ;
|
|
pgen = jarni + "ch" ;
|
|
pins = jarni + "mi" ;
|
|
} ;
|
|
|
|
-- masculine possession: the same endings as in feminine
|
|
|
|
otcuvAdjForms : Str -> AdjForms = \otcuv ->
|
|
let otcov = Predef.tk 2 otcuv + "ov"
|
|
in
|
|
matcinAdjForms otcov ** {msnom = otcuv} ;
|
|
|
|
-- feminine possession
|
|
|
|
matcinAdjForms : Str -> AdjForms = \matcin ->
|
|
{
|
|
msnom = matcin ;
|
|
fsnom,msgen = matcin + "a" ;
|
|
nsnom = matcin + "o" ;
|
|
fsgen,fpnom = matcin + "y" ;
|
|
msdat,fsacc = matcin + "u" ;
|
|
fsdat,msloc = matcin + "ě" ;
|
|
msins = matcin + "ým" ;
|
|
fsins = matcin + "ou" ;
|
|
mpnom = matcin + "i" ;
|
|
pgen = matcin + "ých" ;
|
|
pins = matcin + "ými" ;
|
|
} ;
|
|
|
|
---------------------
|
|
-- Verbs
|
|
|
|
-- Public input schema of ParadigmsCze.VerbPrincipalParts. Keep existing
|
|
-- record literals valid: derived forms belong in VerbForms; additional
|
|
-- principal parts need a new constructor or overload.
|
|
PositiveVerbForms : Type = {
|
|
inf,
|
|
impsg2, imppl1, imppl2,
|
|
pressg1, pressg2, pressg3,
|
|
prespl1, prespl2, prespl3,
|
|
pastpartsg, pastpartpl : Str
|
|
} ;
|
|
|
|
VerbForms : Type = PositiveVerbForms ** {
|
|
negpressg1,negpressg2,negpressg3,negprespl1,negprespl2,negprespl3,
|
|
negimpsg2,negimppl1,negimppl2,
|
|
pastpartfsg,pastpartnsg,pastpartfpl,pastpartnpl,refl : Str ; isRefl : Bool
|
|
} ;
|
|
|
|
-- Prefix at lexical construction time, so ordinary spelling also parses.
|
|
withNeg : PositiveVerbForms -> VerbForms = \v -> v ** {
|
|
refl = [] ; isRefl = False ;
|
|
negpressg1 = "ne" + v.pressg1 ; negpressg2 = "ne" + v.pressg2 ;
|
|
negpressg3 = "ne" + v.pressg3 ;
|
|
negprespl1 = "ne" + v.prespl1 ; negprespl2 = "ne" + v.prespl2 ;
|
|
negprespl3 = "ne" + v.prespl3 ;
|
|
negimpsg2 = "ne" + v.impsg2 ; negimppl1 = "ne" + v.imppl1 ; negimppl2 = "ne" + v.imppl2 ;
|
|
pastpartfsg = Predef.tk 1 v.pastpartsg + "la" ;
|
|
pastpartnsg = Predef.tk 1 v.pastpartsg + "lo" ;
|
|
pastpartfpl = Predef.tk 1 v.pastpartpl + "y" ;
|
|
pastpartnpl = Predef.tk 1 v.pastpartpl + "a"
|
|
} ;
|
|
|
|
-- Vocalization depends on the next realized token, not on the noun head.
|
|
-- These environments choose a neutral standard form; other clusters can
|
|
-- admit stylistic variants (https://prirucka.ujc.cas.cz/?id=770).
|
|
vPreposition : Str =
|
|
let continuation : Str -> Strs = \p -> strs {
|
|
p+"a"; p+"á"; p+"b"; p+"c"; p+"č"; p+"d"; p+"ď"; p+"e"; p+"é"; p+"ě";
|
|
p+"f"; p+"g"; p+"h"; p+"i"; p+"í"; p+"j"; p+"k"; p+"l"; p+"m"; p+"n";
|
|
p+"ň"; p+"o"; p+"ó"; p+"p"; p+"q"; p+"r"; p+"ř"; p+"s"; p+"š"; p+"t";
|
|
p+"ť"; p+"u"; p+"ú"; p+"ů"; p+"v"; p+"w"; p+"x"; p+"y"; p+"ý"; p+"z"; p+"ž"
|
|
} ;
|
|
longerMe : Strs = continuation "mě" ;
|
|
longerMeCapital : Strs = continuation "Mě"
|
|
in pre {
|
|
-- pre matches prefixes: apply the měst- default to derived words too,
|
|
-- then distinguish pronoun mě from longer words such as měna and měřítko.
|
|
"měst" | "Měst" => "ve" ;
|
|
longerMe => "v" ;
|
|
longerMeCapital => "v" ;
|
|
"mlýn" | "Mlýn" => "ve" ;
|
|
"v" | "V" | "f" | "F" | "mě" | "mně" | "mne" | "mz" | "dv" | "čt" | "tř" | "hř" => "ve" ;
|
|
"sb" | "sc" | "sd" | "sf" | "sh" | "sk" | "sl" | "sm" | "sn" | "sp" | "st" | "sv" |
|
|
"zb" | "zd" | "zh" | "zk" | "zl" | "zm" | "zn" | "zv" |
|
|
"šk" | "šp" | "št" | "šv" | "Šk" | "Šp" | "Št" | "Šv" | "žd" | "žl" | "žr" => "ve" ;
|
|
"Mě" | "Mně" | "Mne" | "Mz" | "Dv" | "Čt" | "Tř" | "Hř" | "Sb" | "Sc" | "Sd" | "Sf" | "Sh" | "Sk" | "Sl" | "Sm" | "Sn" | "Sp" | "St" | "Sv" | "Zb" | "Zd" | "Zh" | "Zk" | "Zl" | "Zm" | "Zn" | "Zv" | "Žd" | "Žl" | "Žr" => "ve" ;
|
|
_ => "v"
|
|
} ;
|
|
|
|
-- s/z share these common environments; v has a different profile.
|
|
-- These defaults do not enumerate every lexical/style variant.
|
|
szPreposition : Str -> Str -> Str = \bare,vocalized -> pre {
|
|
"s" | "z" | "š" | "ž" | "mn" | "mz" | "vš" | "vs" | "vz" | "vč" | "dv" | "čt" | "tř" | "ps" |
|
|
"S" | "Z" | "Š" | "Ž" | "Mn" | "Mz" | "Vš" | "Vs" | "Vz" | "Vč" | "Dv" | "Čt" | "Tř" | "Ps" => vocalized ;
|
|
_ => bare
|
|
} ;
|
|
|
|
sPreposition : Str = szPreposition "s" "se" ;
|
|
zPreposition : Str = szPreposition "z" "ze" ;
|
|
|
|
ComplementCase : Type = {s : Str ; c : Case ; hasPrep : Bool} ;
|
|
|
|
hasCliticComplement : ComplementCase -> Bool -> Bool = \p,hasClit ->
|
|
case <hasClit,p.hasPrep,p.c> of {
|
|
<True,False,Gen | Dat | Acc> => True ;
|
|
_ => False
|
|
} ;
|
|
|
|
-- Dative precedes genitive/accusative; otherwise retain argument order.
|
|
cliticBefore : Case -> Case -> Bool = \first,second -> case <first,second> of {
|
|
<Gen | Acc,Dat> => False ;
|
|
_ => True
|
|
} ;
|
|
|
|
-- Full complements: prepositions select n-forms, bare cases select j-forms.
|
|
-- Clitic eligibility and placement are handled separately by the caller.
|
|
fullComplement : ComplementCase -> (Case => Str) -> (Case => Str) -> Str =
|
|
\p,bare,prep -> p.s ++ case p.hasPrep of {
|
|
True => prep ! p.c ; False => bare ! p.c
|
|
} ;
|
|
|
|
verbAgr : VerbForms -> Agr -> Polarity -> Str
|
|
= \vf,a,b -> case a of {
|
|
Ag _ n p => case <n,p,b> of {
|
|
<Sg,P1,Pos> => vf.pressg1 ; <Sg,P1,Neg> => vf.negpressg1 ;
|
|
<Sg,P2,Pos> => vf.pressg2 ; <Sg,P2,Neg> => vf.negpressg2 ;
|
|
<Sg,P3,Pos> => vf.pressg3 ; <Sg,P3,Neg> => vf.negpressg3 ;
|
|
<Pl,P1,Pos> => vf.prespl1 ; <Pl,P1,Neg> => vf.negprespl1 ;
|
|
<Pl,P2,Pos> => vf.prespl2 ; <Pl,P2,Neg> => vf.negprespl2 ;
|
|
<Pl,P3,Pos> => vf.prespl3 ; <Pl,P3,Neg> => vf.negprespl3
|
|
} ;
|
|
AgPol _ => case b of {Pos => vf.prespl2 ; Neg => vf.negprespl2} ;
|
|
AgQuant _ => case b of {Pos => vf.pressg3 ; Neg => vf.negpressg3}
|
|
} ;
|
|
|
|
imperativeAgr : VerbForms -> Agr -> Polarity -> Str = \v,a,pos -> case <a,pos> of {
|
|
<Ag _ Sg _,Pos> => v.impsg2 ; <Ag _ Sg _,Neg> => v.negimpsg2 ;
|
|
<Ag _ Pl P1,Pos> => v.imppl1 ; <Ag _ Pl P1,Neg> => v.negimppl1 ;
|
|
<_,Pos> => v.imppl2 ; <_,Neg> => v.negimppl2
|
|
} ;
|
|
|
|
pastPartAgr : VerbForms -> Agr -> Polarity -> Str = \v,a,pos ->
|
|
let form = case a of {
|
|
Ag g n _ => case <g,n> of {
|
|
<Masc _,Sg> => v.pastpartsg ; <Fem,Sg> => v.pastpartfsg ;
|
|
<Neutr,Sg> => v.pastpartnsg ; <Masc Anim,Pl> => v.pastpartpl ;
|
|
<Neutr,Pl> => v.pastpartnpl ; <_,Pl> => v.pastpartfpl
|
|
} ;
|
|
AgPol g => case g of {
|
|
Masc _ => v.pastpartsg ; Fem => v.pastpartfsg ; Neutr => v.pastpartnsg
|
|
} ;
|
|
AgQuant _ => v.pastpartfpl
|
|
}
|
|
in case pos of {Pos => form ; Neg => "ne" ++ BIND ++ form} ;
|
|
|
|
pastAux : Agr -> Str = \a -> case a of {
|
|
Ag _ n p => case <n,p> of {
|
|
<Sg,P1> => "jsem" ;
|
|
<Sg,P2> => "jsi" ;
|
|
<Pl,P1> => "jsme" ;
|
|
<Pl,P2> => "jste" ;
|
|
_ => []
|
|
} ;
|
|
AgPol _ => "jste" ;
|
|
AgQuant _ => []
|
|
} ;
|
|
|
|
conditionalAux : Agr -> Str = \a -> case a of {
|
|
Ag _ n p => case <n,p> of {
|
|
<Sg,P1> => "bych" ; <Sg,P2> => "bys" ; <Pl,P1> => "bychom" ;
|
|
<Pl,P2> => "byste" ; _ => "by"
|
|
} ; AgPol _ => "byste" ; AgQuant _ => "by"
|
|
} ;
|
|
|
|
futureAux : Agr -> Polarity -> Str = \a,pos ->
|
|
let form = case a of {
|
|
Ag _ n p => case <n,p> of {
|
|
<Sg,P1> => "budu" ; <Sg,P2> => "budeš" ; <Sg,P3> => "bude" ;
|
|
<Pl,P1> => "budeme" ; <Pl,P2> => "budete" ; <Pl,P3> => "budou"
|
|
} ;
|
|
AgQuant _ => "bude" ; AgPol _ => "budete"
|
|
}
|
|
in case pos of {Pos => form ; Neg => "ne" ++ BIND ++ form} ;
|
|
|
|
tenseVerb : Tense -> VerbForms -> Agr -> Polarity -> Str = \t,v,a,pos -> case t of {
|
|
Pres => verbAgr v a pos ;
|
|
Past => pastPartAgr v a pos ;
|
|
Fut => futureAux a pos ++ v.inf ;
|
|
Cond => pastPartAgr v a pos
|
|
} ;
|
|
|
|
tenseClitic : Tense -> Agr -> Str = \t,a -> case t of {
|
|
Past => pastAux a ; Cond => conditionalAux a ; _ => []
|
|
} ;
|
|
|
|
Clause : Type = {
|
|
subj,clit,compl : Str ; verb : VerbForms ; a : Agr ;
|
|
isDrop,clitPresent : Bool ;
|
|
finite : Tense => Polarity => Str ; auxiliary : Tense => Str
|
|
} ;
|
|
|
|
mkClause : Str -> Str -> Str -> VerbForms -> Agr -> Bool -> Bool -> Clause =
|
|
\subj,clit,compl,verb,a,isDrop,clitPresent -> {
|
|
subj = subj ; clit = clit ; compl = compl ; verb = verb ; a = a ;
|
|
isDrop = isDrop ; clitPresent = clitPresent ;
|
|
finite = table {
|
|
Pres => \\p => verbAgr verb a p ;
|
|
Past => \\p => pastPartAgr verb a p ;
|
|
Fut => \\p => tenseVerb Fut verb a p ;
|
|
Cond => \\p => pastPartAgr verb a p
|
|
} ;
|
|
auxiliary = table {
|
|
Pres => [] ; Past => pastAux a ; Fut => [] ; Cond => conditionalAux a
|
|
}
|
|
} ;
|
|
|
|
-- s is the ordinary order; fronted places the clitics first, ready for
|
|
-- an external host. clit/body retain the pieces needed by further fronting.
|
|
-- Keep complete orders as well as pieces so markup can enclose a sentence
|
|
-- in either order without leaking the moved clitics outside its scope.
|
|
Sentence : Type = {s,fronted,clit,body : Str ; clitPresent : Bool} ;
|
|
sentence : Bool -> Str -> Str -> Str -> Sentence = \present,first,clit,rest -> {
|
|
s = first ++ clit ++ rest ; fronted = clit ++ first ++ rest ;
|
|
clit = clit ; body = first ++ rest ; clitPresent = present
|
|
} ;
|
|
frontSentence : Str -> Sentence -> Sentence = \first,s -> s ** {
|
|
s = first ++ s.fronted ; fronted = s.clit ++ first ++ s.body ;
|
|
body = first ++ s.body
|
|
} ;
|
|
prefixSentence : Str -> Sentence -> Sentence = \first,s -> s ** {
|
|
s = first ++ s.s ; fronted = s.clit ++ first ++ s.body ;
|
|
body = first ++ s.body
|
|
} ;
|
|
-- Appended clauses retain their own domains; only s's clitics can move.
|
|
appendSentence : Sentence -> Str -> Sentence = \s,last -> s ** {
|
|
s = s.s ++ last ; fronted = s.fronted ++ last ; body = s.body ++ last
|
|
} ;
|
|
|
|
copulaVerbForms : VerbForms = (withNeg {
|
|
inf = "být" ;
|
|
impsg2 = "buď" ; imppl1 = "buďme" ; imppl2 = "buďte" ;
|
|
pressg1 = "jsem" ;
|
|
pressg2 = "jsi" ;
|
|
pressg3 = "je" ;
|
|
prespl1 = "jsme" ;
|
|
prespl2 = "jste" ;
|
|
prespl3 = "jsou" ;
|
|
pastpartsg = "byl" ;
|
|
pastpartpl = "byli" ;
|
|
}) ** {negpressg3 = "není"} ;
|
|
|
|
haveVerbForms : VerbForms = withNeg {
|
|
inf = "mít" ;
|
|
impsg2 = "měj" ; imppl1 = "mějme" ; imppl2 = "mějte" ;
|
|
pressg1 = "mám" ;
|
|
pressg2 = "máš" ;
|
|
pressg3 = "má" ;
|
|
prespl1 = "máme" ;
|
|
prespl2 = "máte" ;
|
|
prespl3 = "mají" ;
|
|
pastpartsg = "měl" ;
|
|
pastpartpl = "měli" ;
|
|
} ;
|
|
|
|
-- just an example of a traditional paradigm
|
|
---- TODO other traditional paradigms
|
|
|
|
iii_kupovatVerbForms : Str -> VerbForms = \kupovat ->
|
|
let
|
|
kupo = Predef.tk 3 kupovat ;
|
|
kupu = Predef.tk 1 kupo + "u"
|
|
in
|
|
withNeg {
|
|
inf = kupovat ;
|
|
impsg2 = kupu + "j" ; imppl1 = kupu + "jme" ; imppl2 = kupu + "jte" ;
|
|
pressg1 = kupu + "ji" ; --- kupuju
|
|
pressg2 = kupu + "ješ" ;
|
|
pressg3 = kupu + "je" ;
|
|
prespl1 = kupu + "jeme" ;
|
|
prespl2 = kupu + "jete" ;
|
|
prespl3 = kupu + "jí" ; --- kupujou
|
|
pastpartsg = kupo + "val" ;
|
|
pastpartpl = kupo + "vali" ;
|
|
} ;
|
|
|
|
iii_krýtVerbForms : Str -> VerbForms = \krýt ->
|
|
let
|
|
kry = shortenVowel (Predef.tk 1 krýt) ;
|
|
in
|
|
withNeg {
|
|
inf = krýt ;
|
|
impsg2 = kry + "j" ; imppl1 = kry + "jme" ; imppl2 = kry + "jte" ;
|
|
pressg1 = kry + "ji" ;
|
|
pressg2 = kry + "ješ" ;
|
|
pressg3 = kry + "je" ;
|
|
prespl1 = kry + "jeme" ;
|
|
prespl2 = kry + "jete" ;
|
|
prespl3 = kry + "jí" ;
|
|
pastpartsg = kry + "l" ;
|
|
pastpartpl = kry + "li" ;
|
|
} ;
|
|
|
|
-- Productive defaults for lexicons that only provide an infinitive. Czech
|
|
-- has many stem alternations, so irregular verbs should still use the full
|
|
-- principal-parts constructor; these classes cover the regular majority.
|
|
atVerbForms : Str -> VerbForms = \inf ->
|
|
let stem = Predef.tk 2 inf in withNeg {
|
|
inf = inf ;
|
|
pressg1 = stem + "ám" ; pressg2 = stem + "áš" ; pressg3 = stem + "á" ;
|
|
prespl1 = stem + "áme" ; prespl2 = stem + "áte" ; prespl3 = stem + "ají" ;
|
|
pastpartsg = stem + "al" ; pastpartpl = stem + "ali" ;
|
|
impsg2 = stem + "ej" ; imppl1 = stem + "ejme" ; imppl2 = stem + "ejte"
|
|
} ;
|
|
|
|
itVerbForms : Str -> VerbForms = \inf ->
|
|
let stem = Predef.tk 2 inf in withNeg {
|
|
inf = inf ;
|
|
pressg1 = stem + "ím" ; pressg2 = stem + "íš" ; pressg3 = stem + "í" ;
|
|
prespl1 = stem + "íme" ; prespl2 = stem + "íte" ; prespl3 = stem + "í" ;
|
|
pastpartsg = stem + "il" ; pastpartpl = stem + "ili" ;
|
|
impsg2 = stem ; imppl1 = stem + "me" ; imppl2 = stem + "te"
|
|
} ;
|
|
|
|
etVerbForms : Str -> Str -> VerbForms = \inf,pastVowel ->
|
|
let stem = Predef.tk 2 inf in withNeg {
|
|
inf = inf ;
|
|
pressg1 = stem + "ím" ; pressg2 = stem + "íš" ; pressg3 = stem + "í" ;
|
|
prespl1 = stem + "íme" ; prespl2 = stem + "íte" ; prespl3 = stem + "í" ;
|
|
pastpartsg = stem + pastVowel + "l" ; pastpartpl = stem + pastVowel + "li" ;
|
|
impsg2 = stem ; imppl1 = stem + "me" ; imppl2 = stem + "te"
|
|
} ;
|
|
|
|
noutVerbForms : Str -> VerbForms = \inf ->
|
|
let stem = Predef.tk 4 inf in withNeg {
|
|
inf = inf ;
|
|
pressg1 = stem + "nu" ; pressg2 = stem + "neš" ; pressg3 = stem + "ne" ;
|
|
prespl1 = stem + "neme" ; prespl2 = stem + "nete" ; prespl3 = stem + "nou" ;
|
|
pastpartsg = stem + "nul" ; pastpartpl = stem + "nuli" ;
|
|
impsg2 = stem + "ni" ; imppl1 = stem + "něme" ; imppl2 = stem + "něte"
|
|
} ;
|
|
|
|
nestVerbForms : Str -> VerbForms = \inf ->
|
|
let prefix = Predef.tk 4 inf ; stem = prefix + "nes" in withNeg {
|
|
inf = inf ;
|
|
pressg1 = stem + "u" ; pressg2 = stem + "eš" ; pressg3 = stem + "e" ;
|
|
prespl1 = stem + "eme" ; prespl2 = stem + "ete" ; prespl3 = stem + "ou" ;
|
|
pastpartsg = stem + "l" ; pastpartpl = stem + "li" ;
|
|
impsg2 = stem ; imppl1 = stem + "me" ; imppl2 = stem + "te"
|
|
} ;
|
|
|
|
jistVerbForms : VerbForms = withNeg {
|
|
inf = "jíst" ;
|
|
pressg1 = "jím" ; pressg2 = "jíš" ; pressg3 = "jí" ;
|
|
prespl1 = "jíme" ; prespl2 = "jíte" ; prespl3 = "jedí" ;
|
|
pastpartsg = "jedl" ; pastpartpl = "jedli" ;
|
|
impsg2 = "jez" ; imppl1 = "jezme" ; imppl2 = "jezte"
|
|
} ;
|
|
|
|
guessVerbForms : Str -> VerbForms = \inf -> case inf of {
|
|
"být" => copulaVerbForms ;
|
|
"mít" => haveVerbForms ;
|
|
"jíst" => jistVerbForms ;
|
|
_ + "ovat" => iii_kupovatVerbForms inf ;
|
|
_ + ("ýt" | "ít") => iii_krýtVerbForms inf ;
|
|
_ + "nout" => noutVerbForms inf ;
|
|
_ + "nést" => nestVerbForms inf ;
|
|
_ + "at" => atVerbForms inf ;
|
|
_ + "it" => itVerbForms inf ;
|
|
_ + "ět" => etVerbForms inf "ě" ;
|
|
_ + "et" => etVerbForms inf "e" ;
|
|
_ => let stem = Predef.tk 1 inf in withNeg {
|
|
inf = inf ;
|
|
pressg1 = stem + "u" ; pressg2 = stem + "eš" ; pressg3 = stem + "e" ;
|
|
prespl1 = stem + "eme" ; prespl2 = stem + "ete" ; prespl3 = stem + "ou" ;
|
|
pastpartsg = stem + "l" ; pastpartpl = stem + "li" ;
|
|
impsg2 = stem ; imppl1 = stem + "me" ; imppl2 = stem + "te"
|
|
}
|
|
} ;
|
|
|
|
---------------------------
|
|
-- Pronouns
|
|
|
|
PronForms : Type = {
|
|
nom, cnom, -- cnom is the pro-drop subject
|
|
gen, cgen,pgen, -- bare, clitic, prepositional
|
|
acc, cacc,pacc,
|
|
dat, cdat,pdat,
|
|
loc,
|
|
ins,pins : Str ;
|
|
a : Agr ; isDrop : Bool
|
|
} ;
|
|
|
|
personalPron : Agr -> PronForms = \a ->
|
|
{a = a ; cnom = [] ; isDrop = False} **
|
|
case a of {
|
|
AgQuant _ => {nom,gen,cgen,pgen,acc,cacc,pacc,dat,cdat,pdat,loc,ins,pins = nonExist} ;
|
|
Ag _ Sg P1 => {
|
|
nom = "já" ;
|
|
gen,acc,pgen,pacc = "mne" ;
|
|
cgen,cacc = "mě" ;
|
|
dat,pdat,loc = "mně" ;
|
|
cdat = "mi" ;
|
|
ins,pins = "mnou"
|
|
} ;
|
|
Ag _ Sg P2 => {
|
|
nom = "ty" ;
|
|
gen,acc,pgen,pacc = "tebe" ;
|
|
cgen,cacc = "tě" ;
|
|
dat,pdat,loc = "tobě" ;
|
|
cdat = "ti" ;
|
|
ins,pins = "tebou"
|
|
} ;
|
|
Ag (Masc _) Sg P3 => {
|
|
nom = "on" ;
|
|
gen,acc = "jeho" ;
|
|
cgen,cacc = "ho" ;
|
|
pgen,pacc = "něho" ;
|
|
dat = "jemu" ;
|
|
cdat = "mu" ;
|
|
pdat = "němu" ;
|
|
loc = "něm" ;
|
|
ins = "jím" ;
|
|
pins = "ním" ;
|
|
} ;
|
|
Ag Fem Sg P3 => {
|
|
nom = "ona" ;
|
|
gen,dat,cgen,cdat,ins = "jí" ;
|
|
acc,cacc = "ji" ;
|
|
pacc = "ni" ;
|
|
pgen,pdat,loc,pins = "ní" ;
|
|
} ;
|
|
Ag Neutr Sg P3 => {
|
|
nom = "ono" ;
|
|
gen = "jeho" ;
|
|
cgen,cacc = "ho" ;
|
|
pgen = "něho" ;
|
|
dat = "jemu" ;
|
|
acc = "je" ;
|
|
pacc = "ně" ;
|
|
cdat = "mu" ;
|
|
pdat = "němu" ;
|
|
loc = "něm" ;
|
|
ins = "jím" ;
|
|
pins = "ním" ;
|
|
} ;
|
|
Ag _ Pl P1 => {
|
|
nom = "my" ;
|
|
gen,acc,
|
|
cgen,cacc,
|
|
pgen,pacc,
|
|
loc = "nás" ;
|
|
dat,cdat,pdat = "nám" ;
|
|
ins,pins = "námi" ;
|
|
} ;
|
|
Ag _ Pl P2 | AgPol _ => {
|
|
nom = "vy" ;
|
|
gen,acc,
|
|
cgen,cacc,
|
|
pgen,pacc,
|
|
loc = "vás" ;
|
|
dat,cdat,pdat = "vám" ;
|
|
ins,pins = "vámi" ;
|
|
} ;
|
|
Ag g Pl P3 => {
|
|
nom = case g of {
|
|
Masc Anim => "oni" ;
|
|
Masc Inanim => "ony" ;
|
|
Fem => "ony" ;
|
|
Neutr => "ona"
|
|
} ;
|
|
gen,cgen = "jich" ;
|
|
pgen = "nich" ;
|
|
dat,cdat = "jim" ;
|
|
pdat = "nim" ;
|
|
acc,cacc = "je" ;
|
|
pacc = "ně" ;
|
|
loc = "nich" ;
|
|
ins = "jimi" ;
|
|
pins = "nimi" ;
|
|
}
|
|
|
|
} ;
|
|
|
|
possessivePron : Agr -> DemPronForms = \a -> case a of {
|
|
Ag _ Sg P1 => mladyAdjForms "my" ** {msnom = "můj" ; pdat = "mým"} ; --- alts: moje, moji,...
|
|
Ag _ Sg P2 => mladyAdjForms "tvy" ** {msnom = "tvůj" ; pdat = "tvým"} ;
|
|
|
|
Ag _ Pl P1 => nasPossessiveForms "náš" "naš" ;
|
|
Ag _ Pl P2 | AgPol _ => nasPossessiveForms "váš" "vaš" ;
|
|
|
|
Ag Fem Sg P3 => jarniAdjForms "její" ** {pdat = "jejím"} ;
|
|
|
|
Ag (Masc _ | Neutr) Sg P3 => invarDemPronForms "jeho" ** {pdat = "jeho"} ;
|
|
Ag _ Pl P3 | AgQuant _ => invarDemPronForms "jejich" ** {pdat = "jejich"}
|
|
|
|
|
|
} ;
|
|
|
|
-- Náš/váš distinguish feminine accusative naši from oblique naší,
|
|
-- and singular instrumental naším from plural dative našim.
|
|
nasPossessiveForms : Str -> Str -> DemPronForms = \nas,nasStem -> {
|
|
msnom = nas ;
|
|
fsnom,nsnom,fpnom = nasStem + "e" ;
|
|
msgen = nasStem + "eho" ;
|
|
fsgen,fsins = nasStem + "í" ;
|
|
msdat = nasStem + "emu" ;
|
|
fsacc,mpnom = nasStem + "i" ;
|
|
msloc = nasStem + "em" ;
|
|
msins = nasStem + "ím" ;
|
|
pgen = nasStem + "ich" ;
|
|
pdat = nasStem + "im" ;
|
|
pins = nasStem + "imi"
|
|
} ;
|
|
|
|
reflPossessivePron : DemPronForms = mladyAdjForms "svy" ** {msnom = "svůj" ; pdat = "svým"} ;
|
|
|
|
mkPron : Agr -> PronForms ** {poss : DemPronForms} = \a ->
|
|
personalPron a ** {poss = possessivePron a} ;
|
|
|
|
--------------------------------
|
|
-- demonstrative pronouns, used for Quant and Det
|
|
|
|
oper
|
|
DemPronForms : Type = {
|
|
msnom, fsnom, nsnom,
|
|
msgen, fsgen,
|
|
msdat, -- fsdat = fsgen unlike AdjForms
|
|
fsacc,
|
|
msloc,
|
|
msins, fsins,
|
|
mpnom, fpnom, -- mpacc = fpacc = fpnom
|
|
pgen,
|
|
pdat, -- NOT msins like AdjForms
|
|
pins : Str
|
|
} ;
|
|
|
|
demPronFormsAdjective : DemPronForms -> Str -> Adjective =
|
|
\dem,s ->
|
|
let
|
|
demAdj = dem ** {fsdat = dem.fsgen} ;
|
|
adjAdj = adjFormsAdjective demAdj
|
|
in {
|
|
s = \\g,n,c => case <g,n,c> of {
|
|
<_,Pl,Dat> => dem.pdat ;
|
|
<Masc _ | Fem, Pl, Acc> => dem.fpnom ;
|
|
_ => adjAdj.s ! g ! n ! c
|
|
} + s
|
|
} ;
|
|
|
|
justDemPronFormsAdjective : DemPronForms -> Adjective =
|
|
\dem ->
|
|
let
|
|
demAdj = dem ** {fsdat = dem.fsgen} ;
|
|
adjAdj = adjFormsAdjective demAdj
|
|
in {
|
|
s = \\g,n,c => case <g,n,c> of {
|
|
<_,Pl,Dat> => dem.pdat ;
|
|
<Masc _ | Fem, Pl, Acc> => dem.fpnom ;
|
|
_ => adjAdj.s ! g ! n ! c
|
|
}
|
|
} ;
|
|
|
|
|
|
Determiner : Type = {
|
|
s : Gender => Case => Str ;
|
|
size : NumSize ; -- number and case of the counted noun
|
|
head : NumHead -- agreement of a quantifier preceding the numeral
|
|
} ;
|
|
|
|
mkDemPronForms : Str -> DemPronForms = \t -> {
|
|
msnom = t + "en" ;
|
|
fsnom = t + "a" ;
|
|
nsnom = t + "o" ;
|
|
msgen = t + "oho" ;
|
|
fsgen = t + "é" ;
|
|
msdat = t + "omu" ;
|
|
fsacc = t + "u" ;
|
|
msloc = t + "om" ;
|
|
msins = t + "ím" ;
|
|
fsins = t + "ou" ;
|
|
mpnom = t + "i" ;
|
|
fpnom = t + "y" ;
|
|
pgen = t + "ěch" ;
|
|
pdat = t + "ěm" ;
|
|
pins = t + "ěmi" ;
|
|
} ;
|
|
|
|
invarDemPronForms : Str -> DemPronForms = \s -> {
|
|
msnom, fsnom, nsnom, msgen, fsgen,
|
|
msdat, fsacc, msloc, msins, fsins,
|
|
mpnom, fpnom, pgen, pdat, pins = s ;
|
|
} ;
|
|
|
|
-- interrogatives
|
|
|
|
kdoForms : Case => Str = table {
|
|
Nom => "kdo" ;
|
|
Gen | Acc | Voc => "koho" ;
|
|
Dat => "komu" ;
|
|
Loc => "kom" ;
|
|
Ins => "kým"
|
|
} ;
|
|
|
|
coForms : Case => Str = table {
|
|
Nom|Acc|Voc => "co" ;
|
|
Gen => "čeho" ;
|
|
Dat => "čemu" ;
|
|
Loc => "čem" ;
|
|
Ins => "čím"
|
|
} ;
|
|
|
|
-- Numerals
|
|
|
|
-- singular forms of demonstratives
|
|
NumeralForms : Type = {
|
|
msnom, fsnom, nsnom,
|
|
msgen, fsgen,
|
|
msdat,
|
|
fsacc,
|
|
msloc,
|
|
msins, fsins : Str
|
|
} ;
|
|
|
|
numeralFormsDeterminer : NumeralForms -> NumSize -> Determiner =
|
|
\nume,size ->
|
|
let
|
|
dem = nume **
|
|
{mpnom, 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 ;
|
|
size = size ; head = CountedHead
|
|
} ;
|
|
|
|
-- example: number 1
|
|
oneNumeral : Determiner = numeralFormsDeterminer ((mkDemPronForms "jedn") ** {msnom = "jeden"}) Num1 ;
|
|
|
|
-- Unlike adjectives, 2--4 do not use the genitive for animate accusatives.
|
|
twoNumeral : Determiner = {
|
|
s = \\g,c => case c of {
|
|
Nom|Acc|Voc => case g of {Masc _ => "dva" ; _ => "dvě"} ;
|
|
Gen|Loc => "dvou" ; Dat|Ins => "dvěma"
|
|
} ; size = Num2_4 ; head = CountedHead
|
|
} ;
|
|
threeNumeral : Determiner = {
|
|
s = \\_,c => case c of {
|
|
Nom|Acc|Voc => "tři" ; Gen => "tří" ; Dat => "třem" ; Loc => "třech" ; Ins => "třemi"
|
|
} ; size = Num2_4 ; head = CountedHead
|
|
} ;
|
|
fourNumeral : Determiner = {
|
|
s = \\_,c => case c of {
|
|
Nom|Acc|Voc => "čtyři" ; Gen => "čtyř" ; Dat => "čtyřem" ; Loc => "čtyřech" ; Ins => "čtyřmi"
|
|
} ; size = Num2_4 ; head = CountedHead
|
|
} ;
|
|
|
|
-- for the numbers 5 upwards
|
|
regNumeral : Str -> Str -> Determiner = \pet,peti -> {
|
|
s = \\_,c => case c of {Nom | Acc | Voc => pet ; _ => peti} ;
|
|
size = Num5 ; head = CountedHead
|
|
} ;
|
|
|
|
invarDeterminer : Str -> NumSize -> Determiner = \sto,size ->
|
|
(regNumeral sto sto) ** {size = size} ;
|
|
|
|
invarNumeral : Str -> Determiner = \s -> invarDeterminer s Num5 ;
|
|
|
|
--------------------------------
|
|
-- combining nouns with numerals
|
|
|
|
param
|
|
NumSize = Num1 | Num2_4 | Num5 | NumScale ; -- CEG 6.1
|
|
-- A scale noun has its own agreement: tímto tisícem vs. těchto pěti tisíců.
|
|
-- Nested scales retain the outer head: tato dvě stě tisíc korun.
|
|
ScaleAgreement = QuantifiedScale | NominalScale ;
|
|
NumHead = CountedHead | ScaleHead Gender NumSize ScaleAgreement ;
|
|
|
|
oper
|
|
quantifierForm : Adjective -> Determiner -> Gender -> Case -> Str = \q,num,g,c ->
|
|
case num.head of {
|
|
CountedHead => q.s ! g ! numSizeNumber num.size ! countCase num.size c ;
|
|
ScaleHead sg size _ => q.s ! sg ! numSizeNumber size ! countCase size c
|
|
} ;
|
|
|
|
quantifyNumeral : Adjective -> Determiner -> Determiner = \q,num -> num ** {
|
|
s = \\g,c => quantifierForm q num g c ++ num.s ! g ! c
|
|
} ;
|
|
|
|
-- Predeterminers agree with the NP head, including a quantified head in
|
|
-- the genitive. This differs from clause agreement for e.g. tisíc korun.
|
|
numeralModAgr : Gender -> Determiner -> Agr = \g,num -> case num.head of {
|
|
CountedHead => numSizeAgr g num.size P3 ;
|
|
ScaleHead sg size _ => numSizeAgr sg size P3
|
|
} ;
|
|
|
|
predetForm : Adjective -> Agr -> Case -> Str = \pred,a,c -> case a of {
|
|
Ag g n _ => pred.s ! g ! n ! c ;
|
|
AgPol g => pred.s ! g ! Sg ! c ;
|
|
AgQuant g => pred.s ! g ! Pl ! countCase Num5 c
|
|
} ;
|
|
|
|
-- Keep the boundary for my všichni doma, also after AdvNP. Complete forms
|
|
-- retain a single markup wrapper; insertion can use separately marked pieces.
|
|
NPForms : Type = {
|
|
s,prep,before,prepBefore : Case => Str ;
|
|
after : Str
|
|
} ;
|
|
|
|
npForms : (Case => Str) -> (Case => Str) -> NPForms = \s,prep -> {
|
|
s,before = s ; prep,prepBefore = prep ; after = []
|
|
} ;
|
|
|
|
appendNPForms : NPForms -> Str -> NPForms = \np,adv -> np ** {
|
|
s = \\c => np.s ! c ++ adv ; prep = \\c => np.prep ! c ++ adv ;
|
|
after = np.after ++ adv
|
|
} ;
|
|
|
|
predetNPForms : Bool -> (Case => Str) -> NPForms -> NPForms = \post,pred,np ->
|
|
case post of {
|
|
True => np ** {
|
|
s = \\c => np.before ! c ++ pred ! c ++ np.after ;
|
|
prep = \\c => np.prepBefore ! c ++ pred ! c ++ np.after ;
|
|
before = \\c => np.before ! c ++ pred ! c ;
|
|
prepBefore = \\c => np.prepBefore ! c ++ pred ! c
|
|
} ;
|
|
False => np ** {
|
|
s = \\c => pred ! c ++ np.s ! c ;
|
|
prep = \\c => pred ! c ++ np.prep ! c ;
|
|
before = \\c => pred ! c ++ np.before ! c ;
|
|
prepBefore = \\c => pred ! c ++ np.prepBefore ! c
|
|
}
|
|
} ;
|
|
|
|
nounGender : Noun -> Number -> Gender = \cn,n -> case n of {
|
|
Sg => cn.g ; Pl => cn.gPl
|
|
} ;
|
|
|
|
countCase : NumSize -> Case -> Case = \n,c -> case <n,c> of {
|
|
<NumScale,_> | <Num5, Nom | Acc | Voc> => Gen ; _ => c
|
|
} ;
|
|
|
|
numSizeForm : (Number => Case => Str) -> NumSize -> Case -> Str
|
|
= \cns,n,c -> case n of {
|
|
Num1 => cns ! Sg ! c ;
|
|
NumScale => cns ! Pl ! Gen ;
|
|
Num2_4 => cns ! Pl ! c ;
|
|
Num5 => case c of {
|
|
Nom | Acc | Voc => cns ! Pl ! Gen ;
|
|
_ => cns ! Pl ! c
|
|
}
|
|
} ;
|
|
|
|
-- Clause agreement is independent of the counted noun's genitive case.
|
|
-- Millions/billions normally agree with their scale head; hundreds and
|
|
-- thousands use quantified agreement by default. Five million still has
|
|
-- a quantified head, while two million has a plural nominal head.
|
|
numeralAgr : Gender -> Determiner -> Person -> Agr = \g,num,p ->
|
|
case num.head of {
|
|
ScaleHead sg size NominalScale => numSizeAgr sg size p ;
|
|
_ => numSizeAgr g num.size p
|
|
} ;
|
|
|
|
numSizeAgr : Gender -> NumSize -> Person -> Agr
|
|
= \g,ns,p -> case ns of {
|
|
Num5 | NumScale => AgQuant g ; -- essential grammar 6.1.4
|
|
Num2_4 => Ag g Pl p ;
|
|
Num1 => Ag g Sg p
|
|
} ;
|
|
|
|
numSizeNumber : NumSize -> Number = \ns -> case ns of {
|
|
Num1 => Sg ;
|
|
_ => Pl ---- TO CHECK
|
|
} ;
|
|
}
|