resource lib name changed

This commit is contained in:
aarne
2007-12-12 20:30:11 +00:00
parent f472bf266c
commit 4ea58bce2c
741 changed files with 0 additions and 0 deletions

View File

@@ -0,0 +1,40 @@
concrete AdjectiveFin of Adjective = CatFin ** open ResFin, Prelude in {
flags optimize=all_subs ; -- gfc size from 2864336 to 6786 - i.e. factor 422
lin
PositA a = {
s = \\_ => a.s ! Posit
} ;
ComparA a np = {
s = \\isMod,af => case isMod of {
True => np.s ! NPCase Part ++ a.s ! Compar ! af ; -- minua isompi
_ => a.s ! Compar ! af ++ "kuin" ++ np.s ! NPCase Nom -- isompi kuin minä
}
} ;
-- $SuperlA$ belongs to determiner syntax in $Noun$.
ComplA2 adj np = {
s = \\isMod,af =>
preOrPost isMod (appCompl True Pos adj.c2 np) (adj.s ! Posit ! af)
} ;
ReflA2 adj = {
s = \\isMod,af =>
preOrPost isMod
(appCompl True Pos adj.c2 (reflPron (agrP3 Sg))) (adj.s ! Posit ! af)
} ;
SentAP ap sc = {
s = \\b,a => ap.s ! b ! a ++ sc.s
} ;
AdAP ada ap = {
s = \\b,af => ada.s ++ ap.s ! b ! af
} ;
UseA2 a = a ;
}

View File

@@ -0,0 +1,21 @@
concrete AdverbFin of Adverb = CatFin ** open ResFin, Prelude in {
lin
PositAdvAdj a = {s = a.s ! Posit ! AAdv} ;
ComparAdvAdj cadv a np = {
s = cadv.s ++ a.s ! Posit ! AAdv ++ "kuin" ++ np.s ! NPCase Nom
} ;
ComparAdvAdjS cadv a s = {
s = cadv.s ++ a.s ! Posit ! AAdv ++ "kuin" ++ s.s
} ;
PrepNP prep np = {s = preOrPost prep.isPre prep.s (np.s ! prep.c)} ;
AdAdv = cc2 ;
SubjS = cc2 ;
AdvSC s = s ; --- this rule give stack overflow in ordinary parsing
AdnCAdv cadv = {s = cadv.s ++ "kuin"} ;
}

View File

@@ -0,0 +1,94 @@
concrete CatFin of Cat = CommonX ** open ResFin, Prelude in {
flags optimize=all_subs ;
lincat
-- Tensed/Untensed
S = {s : Str} ;
QS = {s : Str} ;
RS = {s : Agr => Str ; c : NPForm} ;
SlashS = {s : Str ; c2 : Compl} ;
-- Sentence
Cl = {s : ResFin.Tense => Anteriority => Polarity => SType => Str} ;
Slash = {s : ResFin.Tense => Anteriority => Polarity => Str ; c2 : Compl} ;
Imp = {s : Polarity => Number => Str} ;
-- Question
QCl = {s : ResFin.Tense => Anteriority => Polarity => Str} ;
IP = {s : NPForm => Str ; n : Number} ;
IComp = {s : Agr => Str} ;
IDet = {s : Case => Str ; n : Number} ;
-- Relative
RCl = {s : ResFin.Tense => Anteriority => Polarity => Agr => Str ; c : NPForm} ;
RP = {s : Number => NPForm => Str ; a : RAgr} ;
-- Verb
VP = ResFin.VP ;
Comp = {s : Agr => Str} ;
-- Adjective
-- The $Bool$ tells whether usage is modifying (as opposed to
-- predicative), e.g. "x on suurempi kuin y" vs. "y:tä suurempi luku".
AP = {s : Bool => AForm => Str} ;
-- Noun
-- The $Bool$ tells if a possessive suffix is attached, which affects the case.
CN = {s : NForm => Str} ;
Pron = {s : NPForm => Str ; a : Agr} ;
NP = {s : NPForm => Str ; a : Agr ; isPron : Bool} ;
Det = {
s1 : Case => Str ; -- minun kolme
s2 : Str ; -- -ni
n : Number ; -- Pl (agreement feature for verb)
isNum : Bool ; -- True (a numeral is present)
isPoss : Bool ; -- True (a possessive suffix is present)
isDef : Bool -- True (verb agrees in Pl, Nom is not Part)
} ;
QuantSg, QuantPl = {s1 : Case => Str ; s2 : Str ; isPoss, isDef : Bool} ;
Ord = {s : Number => Case => Str} ;
Predet = {s : Number => NPForm => Str} ;
Quant = {s1 : Number => Case => Str ; s2 : Str ; isPoss, isDef : Bool} ;
Num = {s : Number => Case => Str ; isNum : Bool} ;
-- Numeral
Numeral = {s : CardOrd => Str ; n : Number} ;
-- Structural
Conj = {s : Str ; n : Number} ;
DConj = {s1,s2 : Str ; n : Number} ;
Subj = {s : Str} ;
Prep = Compl ;
-- Open lexical classes, e.g. Lexicon
V, VS, VQ = Verb1 ; -- = {s : VForm => Str ; sc : Case} ;
V2, VA = Verb1 ** {c2 : Compl} ;
V2A = Verb1 ** {c2, c3 : Compl} ;
VV = Verb1 ; ---- infinitive form
V3 = Verb1 ** {c2, c3 : Compl} ;
A = {s : Degree => AForm => Str} ;
A2 = {s : Degree => AForm => Str ; c2 : Compl} ;
N = {s : NForm => Str} ;
N2 = {s : NForm => Str} ** {c2 : Compl} ;
N3 = {s : NForm => Str} ** {c2,c3 : Compl} ;
PN = {s : Case => Str} ;
oper Verb1 = {s : VForm => Str ; sc : NPForm} ;
}

View File

@@ -0,0 +1,43 @@
concrete ConjunctionFin of Conjunction =
CatFin ** open ResFin, Coordination, Prelude in {
flags optimize=all_subs ;
lin
ConjS = conjunctSS ;
DConjS = conjunctDistrSS ;
ConjAdv = conjunctSS ;
DConjAdv = conjunctDistrSS ;
ConjNP conj ss = conjunctTable NPForm conj ss ** {
a = {n = conjNumber conj.n ss.a.n ; p = ss.a.p} ;
isPron = False
} ;
DConjNP conj ss = conjunctDistrTable NPForm conj ss ** {
a = {n = conjNumber conj.n ss.a.n ; p = ss.a.p} ;
isPron = False
} ;
ConjAP conj ss = conjunctTable2 Bool AForm conj ss ;
DConjAP conj ss = conjunctDistrTable2 Bool AForm conj ss ;
-- These fun's are generated from the list cat's.
BaseS = twoSS ;
ConsS = consrSS comma ;
BaseAdv = twoSS ;
ConsAdv = consrSS comma ;
BaseNP x y = twoTable NPForm x y ** {a = conjAgr x.a y.a} ;
ConsNP xs x = consrTable NPForm comma xs x ** {a = conjAgr xs.a x.a} ;
BaseAP x y = twoTable2 Bool AForm x y ;
ConsAP xs x = consrTable2 Bool AForm comma xs x ;
lincat
[S] = {s1,s2 : Str} ;
[Adv] = {s1,s2 : Str} ;
[NP] = {s1,s2 : NPForm => Str ; a : Agr} ;
[AP] = {s1,s2 : Bool => AForm => Str} ;
}

View File

@@ -0,0 +1,74 @@
--# -path=.:abstract:common:prelude
concrete ExtraFin of ExtraFinAbs = CatFin **
open ResFin, MorphoFin, Coordination, Prelude, NounFin, StructuralFin in {
lin
GenNP np = {
s1 = \\_,_ => np.s ! NPCase Gen ;
s2 = [] ;
isNum = False ;
isPoss = False ;
isDef = True --- "Jussin kolme autoa ovat" ; thus "...on" is missing
} ;
lincat
VPI = {s : Str} ;
[VPI] = {s1,s2 : Str} ;
lin
BaseVPI = twoSS ;
ConsVPI = consrSS comma ;
MkVPI vp = {s = infVP (NPCase Nom) Pos (agrP3 Sg) vp} ;
ConjVPI = conjunctSS ;
ComplVPIVV vv vpi =
insertObj (\\_,_,_ => vpi.s) (predV vv) ;
AdvExistNP adv np =
mkClause (\_ -> adv.s) np.a (insertObj
(\\_,b,_ => np.s ! NPCase Nom) (predV (verbOlla ** {sc = NPCase Nom}))) ;
RelExistNP prep rp np = {
s = \\t,ant,bo,ag =>
let cl =
mkClause
(\_ -> appCompl True Pos prep (rp2np ag.n rp))
np.a
(insertObj
(\\_,b,_ => np.s ! NPCase Nom)
(predV (verbOlla ** {sc = NPCase Nom}))) ;
in
cl.s ! t ! ant ! bo ! SDecl ;
c = NPCase Nom
} ;
AdvPredNP adv v np =
mkClause (\_ -> adv.s) np.a (insertObj
(\\_,b,_ => np.s ! NPCase Nom) (predV v)) ;
i_implicPron = mkPronoun [] "minun" "minua" "minuna" "minuun" Sg P1 ;
whatPart_IP = {
s = table {
NPCase Nom | NPAcc => "mitä" ;
c => whatSg_IP.s ! c
} ;
n = Sg
} ;
PartCN cn =
let
acn = DetCN (DetSg (SgQuant IndefArt) NoOrd) cn
in {
s = table {
NPCase Nom | NPAcc => acn.s ! NPCase Part ;
c => acn.s ! c
} ;
a = acn.a ;
isPron = False
} ;
vai_Conj = {s = "vai" ; n = Sg} ;
}

View File

@@ -0,0 +1,19 @@
abstract ExtraFinAbs = Extra [
GenNP,VPI,ListVPI,BaseVPI,ConsVPI,MkVPI,ComplVPIVV,ConjVPI,
VV,VP,Conj,NP,Quant] ** {
fun
AdvExistNP : Adv -> NP -> Cl ; -- kuvassa olemme me
AdvPredNP : Adv -> V -> NP -> Cl ; -- kuvassa hymyilee Veikko
RelExistNP : Prep -> RP -> NP -> RCl ; -- jossa on jazzia
i_implicPron : Pron ; -- (minä), minut, ...
whatPart_IP : IP ;
PartCN : CN -> NP ; -- olutta
vai_Conj : Conj ; -- minä vai sinä? ("or" in question)
vai_Conj : Conj ;
}

View File

@@ -0,0 +1,6 @@
--# -path=.:../abstract:../common:prelude
concrete Finnish of FinnishAbs =
LangFin,
ExtraFin
** {} ;

View File

@@ -0,0 +1,4 @@
abstract FinnishAbs =
Lang,
ExtraFinAbs
** {} ;

View File

@@ -0,0 +1,21 @@
--# -path=.:../abstract:../common:prelude
concrete GrammarFin of Grammar =
NounFin,
VerbFin,
AdjectiveFin,
AdverbFin,
NumeralFin,
SentenceFin,
QuestionFin,
RelativeFin,
ConjunctionFin,
PhraseFin,
TextX,
IdiomFin,
StructuralFin
** {
flags startcat = Phr ; unlexer = finnish ; lexer = text ;
} ;

View File

@@ -0,0 +1,73 @@
concrete IdiomFin of Idiom = CatFin **
open MorphoFin, ParadigmsFin, Prelude in {
flags optimize=all_subs ;
lin
ExistNP np =
let
cas : Polarity -> NPForm = \p -> case p of {
Pos => NPCase Nom ; -- on olemassa luku
Neg => NPCase Part -- ei ole olemassa lukua
}
in
mkClause noSubj (agrP3 Sg) (insertObj
(\\_,b,_ => "olemassa" ++ np.s ! cas b) (predV olla)) ;
ExistIP ip =
let
cas : NPForm = NPCase Part ; --- dep on num, pol?
vp = insertObj (\\_,b,_ => "olemassa") (predV olla) ;
cl = mkClause (subjForm (ip ** {isPron = False ; a = agrP3 Sg}) cas) (agrP3 Sg) vp
in {
s = \\t,a,p => cl.s ! t ! a ! p ! SDecl
} ;
-- Notice the nominative in the cleft $NP$: "se on Matti josta Liisa pitää"
CleftNP np rs = mkClause (\_ -> "se") (agrP3 Sg)
(insertExtrapos (rs.s ! np.a)
(insertObj (\\_,_,_ => np.s ! NPCase Nom) (predV olla))) ;
-- This gives the almost forbidden "se on Porissa kun Matti asuu".
CleftAdv ad s = mkClause (\_ -> "se") (agrP3 Sg)
(insertExtrapos ("kun" ++ s.s)
(insertObj (\\_,_,_ => ad.s) (predV olla))) ;
ImpersCl vp = mkClause noSubj (agrP3 Sg) vp ;
GenericCl vp = mkClause noSubj (agrP3 Sg) {
s = \\_ => vp.s ! VIPass ;
s2 = vp.s2 ;
ext = vp.ext ;
sc = vp.sc
} ;
ProgrVP vp =
let
inf = (vp.s ! VIInf Inf3Iness ! Simul ! Pos ! agrP3 Sg).fin ;
on = predV olla
in {
s = on.s ;
s2 = \\b,p,a => inf ++ vp.s2 ! b ! p ! a ;
ext = vp.ext ;
sc = vp.sc
} ;
-- This gives "otetaan oluet" instead of "ottakaamme oluet".
-- The imperative is not available in a $VP$.
ImpPl1 vp =
let vps = vp.s ! VIPass ! Simul ! Pos ! {n = Pl ; p = P1}
in
{s = vps.fin ++ vps.inf ++
vp.s2 ! True ! Pos ! {n = Pl ; p = P1} ++ vp.ext
} ;
oper
olla = verbOlla ** {sc = NPCase Nom} ;
noSubj : Polarity -> Str = \_ -> [] ;
}

View File

@@ -0,0 +1,10 @@
--# -path=.:../abstract:../common:prelude
concrete LangFin of Lang =
GrammarFin,
LexiconFin
** {
flags startcat = Phr ; unlexer = text ; lexer = finnish ;
} ;

View File

@@ -0,0 +1,386 @@
--# -path=.:prelude
concrete LexiconFin of Lexicon = CatFin ** open MorphoFin, ParadigmsFin in {
flags
optimize=values ;
lin
airplane_N = regN "lentokone" ;
answer_V2S = mkV2S (regV "vastata") (casePrep allative) ;
apartment_N = regN "asunto" ;
apple_N = nLukko "omena" ; --- omenia, not omenoita
art_N = regN "taide" ;
ask_V2Q = mkV2Q (regV "kysyä") (casePrep ablative) ;
baby_N = nLukko "vauva" ;
bad_A = mkADeg (nLukko "paha") "pahempi" "pahin" ;
bank_N = regN "pankki" ;
beautiful_A = mkADeg (regN "kaunis") "kauniimpi" "kaunein" ;
become_VA = mkVA (regV "tulla") (casePrep translative) ;
beer_N = regN "olut" ;
beg_V2V = mkV2V (reg2V "pyytää" "pyysi") (casePrep partitive) ;
big_A = mkADeg (sgpartN (nArpi "suuri") "suurta") "suurempi" "suurin" ;
bike_N = nLukko "polkupyörä" ; --- for correct vowel harmony
bird_N = nLukko "lintu" ;
black_A = mkADeg (nLukko "musta") "mustempi" "mustin" ;
blue_A = mkADeg (regN "sininen") "sinisempi" "sinisin" ;
boat_N = regN "vene" ;
book_N = nLukko "kirja" ;
boot_N = regN "saapas" ;
boss_N = nLukko "pomo" ;
boy_N = nKukko "poika" "pojan" "poikia" ;
bread_N = nLukko "leipä" ;
break_V2 = dirV2 (regV "rikkoa") ;
broad_A = mkADeg (regN "leveä") "leveämpi" "levein" ;
brother_N2 = genN2 (
mkN "veli" "veljen" "veljenä" "veljeä" "veljeen"
"veljinä" "veljissä" "veljien" "veljiä" "veljiin") ;
brown_A = mkADeg (regN "ruskea") "ruskeampi" "ruskein" ;
butter_N = reg3N "voi" "voin" "voita" ; ---- errors in Part
buy_V2 = dirV2 (regV "ostaa") ;
camera_N = nLukko "kamera" ;
cap_N = regN "lakki" ;
car_N = reg3N "auto" "auton" "autoja" ; -- regN: audon
carpet_N = nLukko "matto" ;
cat_N = nLukko "kissa" ;
ceiling_N = nLukko "katto" ;
chair_N = regN "tuoli" ;
cheese_N = nLukko "juusto" ;
child_N = mkN "lapsi" "lapsen" "lapsena" "lasta" "lapseen"
"lapsina" "lapsissa" "lasten" "lapsia" "lapsiin" ;
church_N = nLukko "kirkko" ;
city_N = regN "kaupunki" ;
clean_A = regA "puhdas" ;
clever_A = regA "viisas" ;
close_V2 = dirV2 (regV "sulkea") ;
coat_N = regN "takki" ;
cold_A = mkADeg (nLukko "kylmä") "kylmempi" "kylmin" ;
come_V = regV "tulla" ;
computer_N = regN "tietokone" ;
country_N = regN "maa" ;
cousin_N = nLukko "serkku" ;
cow_N = nLukko "lehmä" ;
die_V = regV "kuolla" ;
dirty_A = mkADeg (regN "likainen") "likaisempi" "likaisin" ;
distance_N3 = mkN3 (regN "etäisyys") (casePrep elative) (casePrep illative) ;
doctor_N = reg2N "tohtori" "tohtoreita" ;
dog_N = nLukko "koira" ;
door_N = nArpi "ovi" ;
drink_V2 = dirV2 (regV "juoda") ;
easy_A2V = mkA2V (mkA (nLukko "helppo")) (casePrep allative) ;
eat_V2 = dirV2 (regV "syödä") ;
empty_A = mkADeg (nLukko "tyhjä") "tyhjempi" "tyhjin" ;
enemy_N = regN "vihollinen" ;
factory_N = regN "tehdas" ;
father_N2 = genN2 (nLukko "isä") ;
fear_VS = mkVS (reg2V "pelätä" "pelkäsi") ;
find_V2 = dirV2 (reg2V "löytää" "löysi") ;
fish_N = nLukko "kala" ;
floor_N = reg2N "lattia" "lattioita" ;
forget_V2 = dirV2 (regV "unohtaa") ;
fridge_N = regN "jääkaappi" ;
friend_N = nLukko "ystävä" ;
fruit_N = nLukko "hedelmä" ;
fun_AV = mkAV (mkA (nLukko "hauska")) ;
garden_N = nKukko "puutarha" "puutarhan" "puutarhoja" ;
girl_N = nLukko "tyttö" ;
glove_N = regN "käsine" ;
gold_N = nLukko "kulta" ;
good_A = mkADeg (nLukko "hyvä") "parempi" "parhain" ; --- paras
go_V = regV "mennä" ;
green_A = mkADeg (regN "vihreä") "vihreämpi" "vihrein" ;
harbour_N = nKukko "satama" "sataman" "satamia" ;
hate_V2 = mkV2 (regV "vihata") cpartitive ;
hat_N = nLukko "hattu" ;
have_V2 = dirV2 (caseV adessive vOlla) ;
hear_V2 = dirV2 (regV "kuulla") ;
hill_N = nLukko "kukkula" ;
hope_VS = mkVS (regV "toivoa") ;
horse_N = regN "hevonen" ;
hot_A = mkADeg (nLukko "kuuma") "kuumempi" "kuumin" ;
house_N = nLukko "talo" ;
important_A = mkADeg (regN "tärkeä") "tärkeämpi" "tärkein" ;
industry_N = regN "teollisuus" ;
iron_N = nLukko "rauta" ;
king_N = regN "kuningas" ;
know_V2 = dirV2 (reg2V "tietää" "tiesi") ; --- tuntea; gives tietänyt
lake_N = nSylki "järvi" ;
lamp_N = nLukko "lamppu" ;
learn_V2 =
dirV2 (mk12V "oppia" "oppii" "opin" "oppivat" "oppikaa" "opitaan"
"oppi" "opin" "oppisi" "oppinut" "opittu" "opitun") ;
leather_N = nLukko "nahka" ; --- nahan
leave_V2 = dirV2 (regV "jättää") ;
like_V2 = caseV2 (regV "pitää") elative ;
listen_V2 = caseV2 (reg3V "kuunnella" "kuuntelen" "kuunteli") partitive ;
live_V = regV "elää" ;
long_A = mkADeg (nLukko "pitkä") "pitempi" "pisin" ;
lose_V2 = dirV2 (regV "hävitä") ; --- hukata
love_N = reg3N "rakkaus" "rakkauden" "rakkauksia" ;
love_V2 = caseV2 (regV "rakastaa") partitive ;
man_N = mkN "mies" "miehen" "miehenä" "miestä" "mieheen"
"miehinä" "miehissä" "miesten" "miehiä" "miehiin" ;
married_A2 =
mkA2 (mkA (nRae "avioitunut" "avioituneena")) (postPrep genitive "kanssa") ;
meat_N = nLukko "liha" ;
milk_N = nLukko "maito" ;
moon_N = regN "kuu" ;
mother_N2 = genN2 (regN "äiti") ;
mountain_N = nArpi "vuori" ;
music_N = regN "musiikki" ;
narrow_A = mkADeg (regN "kapea") "kapeampi" "kapein" ;
new_A = mkADeg (reg3N "uusi" "uuden" "uusia") "uudempi" "uusin" ;
newspaper_N = nSylki "sanomalehti" ; --- for correct vowel harmony
oil_N = nLukko "öljy" ;
old_A = mkADeg (nLukko "vanha") "vanhempi" "vanhin" ;
open_V2 = dirV2 (regV "avata") ;
paint_V2A = mkV2A (regV "maalata") accPrep (casePrep translative) ;
paper_N = reg2N "paperi" "papereita" ;
paris_PN = mkPN (regN "Pariisi") ;
peace_N = nLukko "rauha" ;
pen_N = nLukko "kynä" ;
planet_N = nLukko "planeetta" ;
plastic_N = regN "muovi" ;
play_V2 = mkV2 (regV "pelata") cpartitive ; --- leikkiä, soittaa
policeman_N = regN "poliisi" ;
priest_N = regN "pappi" ;
probable_AS = mkAS (mkA (nNainen "todennäköistä")) ; --- for vowel harmony
queen_N = regN "kuningatar" ;
radio_N = reg2N "radio" "radioita" ;
rain_V0 = mkV0 (reg2V "sataa" "satoi") ;
read_V2 = dirV2 (regV "lukea") ;
red_A = regA "punainen" ;
religion_N = nLukko "uskonto" ;
restaurant_N = nLukko "ravintola" ;
river_N = nArpi "joki" ;
rock_N = reg2N "kallio" "kallioita" ;
roof_N = nLukko "katto" ;
rubber_N = regN "kumi" ;
run_V = reg2V "juosta" "juoksi" ;
say_VS = mkVS (regV "sanoa") ;
school_N = nLukko "koulu" ;
science_N = regN "tiede" ;
sea_N = nMeri "meri" ;
seek_V2 = mkV2 (regV "etsiä") cpartitive ;
see_V2 = dirV2 (
mk12V "nähdä" "näkee" "näen" "näkevät" "nähkää" "nähdään"
"näki" "näin" "näkisi" "nähnyt" "nähty" "nähdyn") ;
sell_V3 = dirV3 (regV "myydä") allative ;
send_V3 = dirV3 (regV "lähettää") allative ;
sheep_N = regN "lammas" ;
ship_N = nLukko "laiva" ;
shirt_N = nLukko "paita" ;
shoe_N = nLukko "kenkä" ;
shop_N = nLukko "kauppa" ;
short_A = regA "lyhyt" ;
silver_N = regN "hopea" ;
sister_N = nLukko "sisko" ;
sleep_V = regV "nukkua" ;
small_A = mkADeg (reg2N "pieni" "pieniä") "pienempi" "pienin" ;
snake_N = regN "käärme" ;
sock_N = nLukko "sukka" ;
speak_V2 = mkV2 (regV "puhua") cpartitive ;
star_N = nSylki "tähti" ;
steel_N = regN "teräs" ;
stone_N = nSylki "kivi" ;
stove_N = reg3N "liesi" "lieden" "liesiä" ;
student_N = reg2N "opiskelija" "opiskelijoita" ;
stupid_A = regA "tyhmä" ;
sun_N = nLukko "aurinko" ;
switch8off_V2 = dirV2 (regV "sammuttaa") ; ---
switch8on_V2 = dirV2 (regV "sytyttää") ; ---
table_N = nLukko "pöytä" ;
talk_V3 = mkV3 (regV "puhua") (casePrep allative) (casePrep elative) ;
teacher_N = nLukko "opettaja" ;
teach_V2 = dirV2 (regV "opettaa") ;
television_N = reg2N "televisio" "televisioita" ;
thick_A = regA "paksu" ;
thin_A = regA "ohut" ;
train_N = nLukko "juna" ;
travel_V = regV "matkustaa" ;
tree_N = regN "puu" ;
---- trousers_N = regN "trousers" ;
ugly_A = mkADeg (nLukko "ruma") "rumempi" "rumin" ;
understand_V2 = dirV2 (reg3V "ymmärtää" "ymmärrän" "ymmärsi") ;
university_N = nLukko "yliopisto" ;
village_N = nLukko "kylä" ;
wait_V2 = caseV2 (regV "odottaa") partitive ;
walk_V = regV "kävellä" ;
warm_A = mkADeg
(mkN "lämmin" "lämpimän" "lämpimänä" "lämmintä" "lämpimään"
"lämpiminä" "lämpimissä" "lämpimien" "lämpimiä" "lämpimiin"
)
"lämpimämpi" "lämpimin" ;
war_N = nLukko "sota" ;
watch_V2 = mkV2 (regV "katsella") cpartitive ;
water_N = reg3N "vesi" "veden" "vesiä" ;
white_A = regA "valkoinen" ;
window_N = reg2N "ikkuna" "ikkunoita" ;
wine_N = regN "viini" ;
win_V2 = dirV2 (regV "voittaa") ;
woman_N = regN "nainen" ;
wonder_VQ = mkVQ (regV "ihmetellä") ;
wood_N = regN "puu" ;
write_V2 = dirV2 (regV "kirjoittaa") ;
yellow_A = regA "keltainen" ;
young_A = mkADeg (nArpi "nuori") "nuorempi" "nuorin" ;
do_V2 = dirV2 (
mk12V "tehdä" "tekee" "teen" "tekevät" "tehkää" "tehdään"
"teki" "tein" "tekisi" "tehnyt" "tehty" "tehdyn") ;
now_Adv = mkAdv "nyt" ;
already_Adv = mkAdv "jo" ;
song_N = nLukko "laulu" ;
add_V3 = dirV3 (regV "lisätä") illative ;
number_N = reg2N "numero" "numeroita" ;
put_V2 = dirV2 (regV "panna") ;
stop_V = regV "pysähtyä" ;
jump_V = regV "hypätä" ;
left_Ord = mkOrd (regN "vasen") ;
right_Ord = mkOrd (regN "oikea") ;
far_Adv = mkAdv "kaukana" ;
correct_A = regA "oikea" ;
dry_A = mkADeg (regN "kuiva") "kuivempi" "kuivin" ;
dull_A = mkADeg (regN "tylsä") "tylsempi" "tylsin" ;
full_A = mkADeg (reg3N "täysi" "täyden" "täysiä") "täydempi" "täysin" ;
heavy_A = regA "raskas" ;
near_A = regA "läheinen" ;
rotten_A = regA "mätä" ;
round_A = regA "pyöreä" ;
sharp_A = regA "terävä" ;
smooth_A = regA "sileä" ;
straight_A = mkADeg (regN "suora") "suorempi" "suorin" ;
wet_A = mkADeg (regN "märkä") "märempi" "märin" ;
wide_A = regA "leveä" ;
animal_N = reg3N "eläin" "eläimen" "eläimiä" ;
ashes_N = regN "tuhka" ;
back_N = regN "selkä" ;
bark_N = regN "kaarna" ;
belly_N = regN "vatsa" ;
blood_N = nMeri "veri" ;
bone_N = regN "luu" ;
breast_N = regN "rinta" ;
cloud_N = reg2N "pilvi" "pilviä" ;
day_N = regN "päivä" ;
dust_N = regN "pöly" ;
ear_N = regN "korva" ;
earth_N = regN "maa" ;
egg_N = regN "muna" ;
eye_N = regN "silmä" ;
fat_N = regN "rasva" ;
feather_N = reg3N "höyhen" "höyhenen" "höyheniä" ;
fingernail_N = reg3N "kynsi" "kynnen" "kynsiä" ;
fire_N = reg2N "tuli" "tulia" ;
flower_N = regN "kukka" ;
fog_N = regN "sumu" ;
foot_N = regN "jalka" ;
forest_N = regN "metsä" ;
grass_N = regN "ruoho" ;
guts_N = regN "sisälmys" ; --- suoli
hair_N = regN "hius" ;
hand_N = reg3N "käsi" "käden" "käsiä" ;
head_N = regN "pää" ;
heart_N = reg3N "sydän" "sydämen" "sydämiä" ;
horn_N = reg2N "sarvi" "sarvia" ;
husband_N = mkN "mies" "miehen" "miehenä" "miestä" "mieheen"
"miehinä" "miehissä" "miesten" "miehiä" "miehiin" ;
ice_N = regN "jää" ;
knee_N = reg2N "polvi" "polvia" ;
leaf_N = reg2N "lehti" "lehtiä" ;
leg_N = regN "jalka" ; --- sääri
liver_N = regN "maksa" ;
louse_N = regN "lude" ;
mouth_N = regN "suu" ;
name_N = reg2N "nimi" "nimiä" ;
neck_N = regN "niska" ;
night_N = regN "yö" ;
nose_N = regN "nenä" ;
person_N = regN "henkilö" ;
rain_N = regN "sade" ;
road_N = regN "tie" ;
root_N = reg2N "juuri" "juuria" ;
rope_N = reg3N "köysi" "köyden" "köysiä" ;
salt_N = regN "suola" ;
sand_N = regN "hiekka" ;
seed_N = regN "siemen" ;
skin_N = regN "nahka" ;
sky_N = reg3N "taivas" "taivaan" "taivaita" ;
smoke_N = regN "savu" ;
snow_N = sgpartN (nMeri "lumi") "lunta" ;
stick_N = regN "keppi" ;
tail_N = regN "häntä" ;
tongue_N = reg2N "kieli" "kieliä" ;
tooth_N = regN "hammas" ;
wife_N = regN "vaimo" ;
wind_N = reg2N "tuuli" "tuulia" ;
wing_N = reg2N "siipi" "siipiä" ;
worm_N = regN "mato" ;
year_N = reg3N "vuosi" "vuoden" "vuosia" ;
bite_V2 = dirV2 (regV "purra") ;
blow_V = regV "puhaltaa" ;
burn_V = regV "palaa" ;
count_V2 = dirV2 (regV "laskea") ;
cut_V2 = dirV2 (reg2V "leikata" "leikkasi") ;
dig_V = regV "kaivaa" ;
fall_V = reg3V "pudota" "putoan" "putosi" ;
fear_V2 = mkV2 (reg3V "pelätä" "pelkään" "pelkäsi") cpartitive ;
fight_V2 = mkV2 (regV "taistella") (postPrep partitive "vastaan") ;
float_V = regV "kellua" ;
flow_V = reg3V "virrata" "virtaan" "virtasi" ;
fly_V = regV "lentää" ;
freeze_V = regV "jäätyä" ;
give_V3 = dirdirV3 (reg3V "antaa" "annan" "antoi") ;
hit_V2 = mkV2 (regV "lyödä") cpartitive ;
hold_V2 = mkV2 (regV "pitää") cpartitive ;
hunt_V2 = mkV2 (regV "metsästää") cpartitive ;
kill_V2 = dirV2 (regV "tappaa") ;
laugh_V = reg3V "nauraa" "nauran" "nauroi" ;
lie_V = reg3V "maata" "makaan" "makasi" ;
play_V = regV "pelata" ;
pull_V2 = dirV2 (regV "vetää") ;
push_V2 = dirV2 (regV "työntää") ;
rub_V2 = mkV2 (regV "hieroa") cpartitive ;
scratch_V2 = mkV2 (regV "raapia") cpartitive ;
sew_V = regV "kylvää" ;
sing_V = regV "laulaa" ;
sit_V = regV "istua" ;
smell_V = reg2V "haistaa" "haistoi" ;
spit_V = regV "sylkeä" ;
split_V2 = dirV2 (reg2V "halkaista" "halkaisi") ;
squeeze_V2 = mkV2 (regV "puristaa") cpartitive ;
stab_V2 = mkV2 (regV "pistää") cpartitive ;
stand_V = mk12V "seistä" "seisoo" "seison" "seisovat" "seiskää" "seistään"
"seisoi" "seisoin" "seisoisi" "seissyt" "seisty" "seistyn" ; --- *seisoivät
suck_V2 = mkV2 (regV "imeä") cpartitive ;
swell_V = mk12V "turvota" "turpoaa" "turpoan" "turpoavat" "turvotkaa" "turvotaan"
"turposi" "turposin" "turpoaisi" "turvonnut" "turvottu" "turvotun" ;
swim_V = reg3V "uida" "uin" "ui" ;
think_V = reg3V "ajatella" "ajattelen" "ajatteli" ;
throw_V2 = dirV2 (regV "heittää") ;
tie_V2 = dirV2 (regV "sitoa") ;
turn_V = regV "kääntyä" ;
vomit_V = regV "oksentaa" ;
wash_V2 = dirV2 (regV "pestä") ;
wipe_V2 = dirV2 (regV "pyyhkiä") ;
breathe_V = regV "hengittää" ;
grammar_N = regN "kielioppi" ;
language_N = reg2N "kieli" "kieliä" ;
rule_N = regN "sääntö" ;
john_PN = regPN "Jussi" ;
question_N = regN "kysymys" ;
ready_A = regA "valmis" ;
reason_N = regN "syy" ;
today_Adv = mkAdv "tänään" ;
uncertain_A = regA "epävarma" ;
oper
mkOrd : N -> Ord ;
mkOrd x = {s = \\n,c => x.s ! NCase n c; lock_Ord = <> } ;
cpartitive = casePrep partitive ;
} ;

View File

@@ -0,0 +1,900 @@
--# -path=.:../../prelude
--1 A Simple Finnish Resource Morphology
--
-- Aarne Ranta 2002 -- 2005
--
-- This resource morphology contains definitions needed in the resource
-- syntax. To build a lexicon, it is better to use $ParadigmsFin$, which
-- gives a higher-level access to this module.
resource MorphoFin = ResFin ** open Prelude in {
flags optimize=all ;
--- flags optimize=noexpand ;
--2 Nouns
--
oper
-- A user-friendly variant takes existing forms and infers the vowel harmony.
mkNoun : (_,_,_,_,_,_,_,_,_,_ : Str) -> CommonNoun =
\talo,talon,talona,taloa,taloon,taloina,taloissa,talojen,taloja,taloihin ->
nhn (mkSubst (ifTok Str (Predef.dp 1 talona) "a" "a" "ä")
talo (Predef.tk 1 talon) (Predef.tk 2 talona) taloa taloon
(Predef.tk 2 taloina) (Predef.tk 3 taloissa) talojen taloja taloihin) ;
-- Here some useful special cases; more are given in $ParadigmsFin.gf$.
--
sLukko : Str -> NounH = \lukko ->
let
o = last lukko ;
lukk = init lukko ;
a = getHarmony o ;
lukkoja = case o of {
"a" => lukk + if_then_Str (pbool2bool (Predef.occurs "ou" lukk)) "ia" "oja" ;
"ä" => lukk + "iä" ;
_ => lukko + "j" + a
}
in
sKukko lukko (weakGrade lukko + "n") lukkoja ;
-- The special case with no alternations.
sTalo : Str -> NounH = sLukko ;
sBaari : Str -> NounH = \baaria ->
let
baari = Predef.tk 1 baaria ;
baar = Predef.tk 1 baari ;
a = getHarmony (Predef.dp 1 baaria)
in
sKukko baari (weakGrade baari + "n") (baar + ("ej" + a)) ;
sKorpi : (_,_,_ : Str) -> NounH = \korpi,korven,korpena ->
let
a = Predef.dp 1 korpena ;
korpe = Predef.tk 2 korpena ;
korp = init korpi ;
korpea = case last korp of {
"r" | "l" | "n" => korp + "t" + a ;
_ => korpe + a
} ;
korve = Predef.tk 1 korven ;
korvi = Predef.tk 1 korve + "i" ;
korpien = case last korp of {
"r" | "l" | "n" => korp + "ten" ;
_ => korpi + "en"
} ;
in
mkSubst a
korpi
korve
korpe
korpea
(korpe + "en")
korpi
korvi
korpien
(korpi + a)
(korpi + "in") ;
sArpi : Str -> NounH = \arpi ->
sKorpi arpi (init (weakGrade arpi) + "en") (init arpi + "ena") ;
sSylki : Str -> NounH = \sylki ->
sKorpi sylki (init (weakGrade sylki) + "en") (init sylki + "enä") ;
sKoira : Str -> NounH = \koira ->
let a = getHarmony (last koira) in
sKukko koira (koira + "n") (init koira + "i" + a) ;
-- Loan words ending in consonants are actually similar to words like
-- "malli"/"mallin"/"malleja", with the exception that the "i" is not attached
-- to the singular nominative.
sLinux : Str -> NounH = \linuxia ->
let {
linux = Predef.tk 2 linuxia ;
a = getHarmony (Predef.dp 1 linuxia) ;
linuxi = linux + "i"
} in
mkSubst a
linux
linuxi
linuxi
(linuxi + a)
(linuxi + "in")
(linux + "ei")
(linux + "ei")
(linux + "ien")
(linux + "ej" + a)
(linux + "eihin") ;
-- Nouns of at least 3 syllables ending with "a" or "ä", like "peruna", "rytinä".
sPeruna : Str -> NounH = \peruna ->
let {
a = Predef.dp 1 peruna ;
perun = Predef.tk 1 peruna ;
perunoi = perun + (ifTok Str a "a" "o" "ö" + "i")
}
in
mkSubst a
peruna
peruna
peruna
(peruna + a)
(peruna + a + "n")
perunoi
perunoi
(perunoi + "den")
(perunoi + ("t" + a))
(perunoi + "hin") ;
sTohtori : Str -> NounH = \tohtoria ->
let
a = last tohtoria ;
tohtori = init tohtoria ;
tohtorei = init tohtori + "ei" ;
in
mkSubst a
tohtori
tohtori
tohtori
tohtoria
(tohtori + "in")
tohtorei
tohtorei
(tohtorei + "den")
(tohtorei + "t" + a)
(tohtorei + "hin") ;
sRadio : Str -> NounH = \radio ->
let
o = last radio ;
a = getHarmony o ;
radioi = radio + "i" ;
in
mkSubst a
radio
radio
radio
(radio + "t" + a)
(radio + o + "n")
radioi
radioi
(radioi + "den")
(radioi + "t" + a)
(radioi + "hin") ;
sSusi : (_,_,_ : Str) -> NounH = \susi,suden,sutena ->
let
a = Predef.dp 1 sutena ;
sude = Predef.tk 1 suden ;
sute = Predef.tk 2 sutena ;
sutt = Predef.tk 1 sute + "t"
in
mkSubst a
susi
sude
sute
(sutt + a)
(sute + "en")
susi
susi
(sutt + "en") --- var susi + "en" bad with suuri
(susi + a)
(susi + "in") ;
sPuu : Str -> NounH = \puu ->
let {
u = Predef.dp 1 puu ;
a = getHarmony u ;
pu = Predef.tk 1 puu ;
pui = pu + "i"
}
in
mkSubst a
puu
puu
puu
(puu + ("t" + a))
(puu + ("h" + u + "n"))
pui
pui
(pui + "den")
(pui + ("t" + a))
(pui + "hin") ;
sSuo : Str -> NounH = \suo ->
let {
o = Predef.dp 1 suo ;
a = getHarmony o ;
soi = Predef.tk 2 suo + (o + "i")
}
in
mkSubst a
suo
suo
suo
(suo + ("t" + a))
(suo + ("h" + o + "n"))
soi
soi
(soi + "den")
(soi + ("t" + a))
(soi + "hin") ;
-- Here in fact it is handy to use the partitive form as the only stem.
sNainen : Str -> NounH = \naista ->
let {
nainen = Predef.tk 3 naista + "nen" ;
nais = Predef.tk 2 naista ;
naise = nais + "e" ;
naisi = nais + "i" ;
a = Predef.dp 1 naista
}
in
mkSubst a
nainen
naise
naise
(nais + ("t" + a))
(nais + "een")
naisi
naisi
(nais + "ten")
(nais + ("i" + a))
(nais + "iin") ;
-- The following covers: "tilaus", "kaulin", "paimen", "laidun", "sammal",
-- "kyynel" (excep $Sg Iness$ for the last two?).
sTilaus : (_,_ : Str) -> NounH = \tilaus, tilauksena ->
let {
tilauks = Predef.tk 3 tilauksena ;
tilaukse = tilauks + "e" ;
tilauksi = tilauks + "i" ;
a = Predef.dp 1 tilauksena
}
in
mkSubst a
tilaus
tilaukse
tilaukse
(tilaus + ("t" + a))
(tilauks + "een")
tilauksi
tilauksi
(tilaus + "ten")
(tilauks + ("i" + a))
(tilauks + "iin") ;
-- Some words have the three grades ("rakkaus","rakkauden","rakkautena"), which
-- are however derivable from the stem.
sRakkaus : Str -> NounH = \rakkaus ->
let {
rakkau = Predef.tk 1 rakkaus ;
rakkaut = rakkau + "t" ;
rakkaute = rakkau + "te" ;
rakkaude = rakkau + "de" ;
rakkauksi = rakkau + "ksi" ;
u = Predef.dp 1 rakkau ;
a = ifTok Str u "u" "a" "ä"
}
in
mkSubst a
rakkaus
rakkaude
rakkaute
(rakkaut + ("t" + a))
(rakkaut + "een")
rakkauksi
rakkauksi
(rakkauksi + "en")
(rakkauksi + a)
(rakkauksi + "in") ;
-- The following covers nouns like "nauris" and adjectives like "kallis", "tyyris".
sNauris : (_ : Str) -> NounH = \naurista ->
let {
a = Predef.dp 1 naurista ;
nauris = Predef.tk 2 naurista ;
nauri = Predef.tk 3 naurista ;
i = Predef.dp 1 nauri ;
naurii = nauri + i ;
naurei = nauri + "i"
}
in
mkSubst a
nauris
naurii
naurii
(nauris + ("t" + a))
(naurii + "seen")
naurei
naurei
(naurei + "den")
(naurei + ("t" + a))
(naurei + "siin") ;
-- Words of the form "siitin", "avain", "höyhen" (w or wo grade alternation).
sLiitin : Str -> Str -> NounH = \liitin,liittimen ->
let
liittime = init liittimen ;
liitti = Predef.tk 2 liittime ;
m = last (init liittime) ;
liittimi = liitti + m + "i" ;
a = vowelHarmony liitin ;
in
mkSubst a
liitin
liittime
liittime
(liitin + "t" + a)
(liittime + "en")
(liittimi)
(liittimi)
(liittimi + "en")
(liittimi + a)
(liittimi + "in") ;
-- The following covers adjectives like "kapea", "leveä".
sKapea : (_ : Str) -> NounH = \kapea ->
let
a = last kapea ;
kape = init kapea ;
kapei = kape + "i"
in
mkSubst a
kapea
kapea
kapea
(kapea + a)
(kapea + a+"n")
kapei
kapei
(kapei + "den")
(kapei + ("t" + a))
(kapei + "siin") ;
-- The following two are used for adjective comparison.
sSuurempi : Str -> NounH = \suurempaa ->
let {
a = Predef.dp 1 suurempaa ;
suure = Predef.tk 4 suurempaa ;
suurempi = suure + "mpi" ;
suurempa = suure + ("mp" + a) ;
suuremm = suure + "mm"
}
in
mkSubst a
suurempi
(suuremm + a)
suurempa
(suurempa + a)
(suurempa + (a + "n"))
suurempi
(suuremm + "i")
(suurempi + "en")
(suurempi + a)
(suurempi + "in") ;
sSuurin : Str -> NounH = \suurinta ->
let {
a = Predef.dp 1 suurinta ;
suuri = Predef.tk 3 suurinta ;
suurin = suuri + "n" ;
suurimma = suuri + ("mm" + a) ;
suurimpa = suuri + ("mp" + a) ;
suurimpi = suuri + "mpi" ;
suurimmi = suuri + "mmi"
}
in
mkSubst a
suurin
suurimma
suurimpa
(suurin + ("t" + a))
(suurimpa + (a + "n"))
suurimpi
suurimmi
(suurimpi + "en")
(suurimpi + a)
(suurimpi + "in") ;
-- This auxiliary resolves vowel harmony from a given letter.
getHarmony : Str -> Str = \u -> case u of {
"a"|"o"|"u" => "a" ;
_ => "ä"
} ;
-- This function inspects the whole word.
vowelHarmony : Str -> Str = \liitin ->
if_then_Str (pbool2bool (Predef.occurs "aou" liitin)) "a" "ä" ;
-- The following function defines how grade alternation works if it is active.
-- In general, *whether there is* grade alternation must be given in the lexicon
-- (cf. "auto - auton" not "audon"; "vihje - vihjeen" not "vihkeen").
weakGrade : Str -> Str = \kukko ->
let
ku = Predef.tk 3 kukko ;
kko = Predef.dp 3 kukko ;
o = last kukko
in
case kko of {
"kk" + _ => ku + "k" + o ;
"pp" + _ => ku + "p" + o ;
"tt" + _ => ku + "t" + o ;
"nk" + _ => ku + "ng" + o ;
"nt" + _ => ku + "nn" + o ;
"mp" + _ => ku + "mm" + o ;
"rt" + _ => ku + "rr" + o ;
"lt" + _ => ku + "ll" + o ;
"lk" + ("i" | "e") => ku + "lj" + o ;
"rk" + ("i" | "e") => ku + "rj" + o ;
"lk" + _ => ku + "l" + o ;
"rk" + _ => ku + "r" + o ;
("hk" | "tk") + _ => kukko ; -- *tahko-tahon, *pitkä-pitkän
"s" + ("k" | "p" | "t") + _ => kukko ; -- *lasku-lasvun, *raspi-rasvin, *lastu-lasdun
x + "ku" => ku + x + "vu" ;
x + "k" + ("a" | "e" | "i" | "o" | "u" | "y" | "ä" | "ö") => ku + x + o ;
x + "p" + ("a" | "e" | "i" | "o" | "u" | "y" | "ä" | "ö") => ku + x + "v" + o ;
x + "t" + ("a" | "e" | "i" | "o" | "u" | "y" | "ä" | "ö") => ku + x + "d" + o ;
_ => kukko
} ;
--- This is only used to analyse nouns "rae", "hake", etc.
strongGrade : Str -> Str = \hake ->
let
ha = Predef.tk 2 hake ;
e = last hake ;
hak = init hake ;
hd = Predef.dp 2 hak
in
case hd of {
"ng" => ha + "k" ;
"nn" => ha + "t" ;
"mm" => ha + "p" ;
"rr" | "ll" => ha + "t" ;
"hj" | "lj" => ha + "k" ; -- pohje/lahje impossible
"hk" | "sk" | "sp" | "st" => hak ;
_ + "k" => ha + "kk" ;
_ + "p" => ha + "pp" ;
_ + "t" => ha + "tt" ;
_ + "d" => ha + "t" ;
_ + ("a" | "ä") => hak + "k" ; -- säe, tae
_ + "v" => ha + "p" ; -- rove/hyve impossible
_ => hak
} + e ;
--3 Proper names
--
-- Proper names are similar to common nouns in the singular.
ProperName = {s : Case => Str} ;
mkProperName : CommonNoun -> ProperName = \jussi ->
{s = \\c => jussi.s ! NCase Sg c} ;
-- An ending given to a symbol cannot really be decided
-- independently. The string $a$ gives the vowel harmony.
-- Only some South-West dialects have the generally valid
-- Illative form.
caseEnding : Str -> Case -> Str = \a,c -> case c of {
Nom => [] ;
Gen => "n" ;
Part => a ; ---
Transl => "ksi" ;
Ess => "n" + a ;
Iness => "ss" + a ;
Elat => "st" + a ;
Illat => "sse" ; ---
Adess => "ll" + a ;
Ablat => "lt" + a ;
Allat => "lle" ;
Abess => "tt" + a
} ;
symbProperName : Str -> ProperName = \x ->
{s = table {
Nom => x ;
c => glue x (":" + caseEnding "a" c)
}
} ;
--2 Pronouns
--
-- Here we define personal and relative pronouns.
mkPronoun : (_,_,_,_,_ : Str) -> Number -> Person ->
{s : NPForm => Str ; a : Agr} =
\mina, minun, minua, minuna, minuun, n, p ->
let {
minu = Predef.tk 2 minuna ;
a = Predef.dp 1 minuna
} in
{s = table {
NPCase Nom => mina ;
NPCase Gen => minun ;
NPCase Part => minua ;
NPCase Transl => minu + "ksi" ;
NPCase Ess => minuna ;
NPCase Iness => minu + ("ss" + a) ;
NPCase Elat => minu + ("st" + a) ;
NPCase Illat => minuun ;
NPCase Adess => minu + ("ll" + a) ;
NPCase Ablat => minu + ("lt" + a) ;
NPCase Allat => minu + "lle" ;
NPCase Abess => minu + ("tt" + a) ;
NPAcc => Predef.tk 1 minun + "t"
} ;
a = {n = n ; p = p}
} ;
mkDemPronoun : (_,_,_,_,_ : Str) -> Number ->
{s : NPForm => Str ; a : Agr} =
\tuo, tuon, tuota, tuona, tuohon, n ->
let pro = mkPronoun tuo tuon tuota tuona tuohon n P3
in {
s = table {
NPAcc => tuo ;
c => pro.s ! c
} ;
a = pro.a
} ;
-- Determiners
mkDet : Number -> CommonNoun -> {
s1 : Case => Str ; -- minun kolme
s2 : Str ; -- -ni
n : Number ; -- Pl (agreement feature for verb)
isNum : Bool ; -- True (a numeral is present)
isPoss : Bool ; -- True (a possessive suffix is present)
isDef : Bool -- True (verb agrees in Pl, Nom is not Part)
} = \n, noun -> {
s1 = \\c => noun.s ! NCase n c ;
s2 = [] ;
n = n ;
isNum, isPoss = False ;
isDef = True --- does this hold for all new dets?
} ;
mkQuant : CommonNoun -> {
s1 : Number => Case => Str ;
s2 : Str ;
isPoss, isDef : Bool
} = \noun -> {
s1 = \\n,c => noun.s ! NCase n c ;
s2 = [] ;
isPoss = False ;
isDef = True --- does this hold for all new dets?
} ;
-- The relative pronoun, "joka", is inflected in case and number,
-- like common nouns, but it does not take possessive suffixes.
-- The inflextion shows a surprising similarity with "suo".
oper
relPron : Number => Case => Str =
let {jo = nhn (sSuo "jo")} in
table {
Sg => table {
Nom => "joka" ;
Gen => "jonka" ;
c => jo.s ! NCase Sg c
} ;
Pl => table {
Nom => "jotka" ;
c => "j" + (jo.s ! NCase Pl c)
}
} ;
caseTable : Number -> CommonNoun -> Case => Str = \n,cn ->
\\c => cn.s ! NCase n c ;
--2 Adjectives
--
-- For the comparison of adjectives, three noun declensions
-- are needed in the worst case.
mkAdjective : (_,_,_ : Adj) -> Adjective = \hyva,parempi,paras ->
{s = table {
Posit => hyva.s ;
Compar => parempi.s ;
Superl => paras.s
}
} ;
-- However, it is usually enough to give the positive declension and
-- the characteristic forms of comparative and superlative.
regAdjective : CommonNoun -> Str -> Str -> Adjective = \kiva, kivempaa, kivinta ->
mkAdjective
(noun2adj kiva)
(noun2adjComp False (nhn (sSuurempi kivempaa)))
(noun2adjComp False (nhn (sSuurin kivinta))) ;
regVerbH : Str -> VerbH = \soutaa ->
let
taa = Predef.dp 3 soutaa ;
juo = Predef.tk 2 soutaa ;
souda = weakGrade (init soutaa) ;
soudan = juo + "en" ;
o = Predef.dp 1 juo ;
a = last soutaa ;
u = ifTok Str a "a" "u" "y" ;
joi = Predef.tk 2 juo + (o + "i")
in
case taa of {
"it" + _ => vHarkita soutaa ;
("st" | "nn" | "rr" | "ll") + _ =>
vJuosta soutaa soudan (juo + o+u+"t") (juo + "t"+u) ;
_ + ("aa" | "ää") => vOttaa soutaa (souda + "n") ;
("o" | "u" | "y" | "ö") + ("da" | "dä") => vJuoda soutaa joi ;
("ata" | "ätä") => vOsata soutaa ;
_ => vHukkua soutaa souda
} ;
reg2VerbH : (soutaa,souti : Str) -> VerbH = \soutaa,souti ->
let
soudan = weakGrade (init soutaa) + "n" ;
soudin = weakGrade souti + "n" ;
souden = init souti + "en" ;
juo = Predef.tk 2 soutaa ;
o = Predef.dp 1 juo ;
u = ifTok Str (last soutaa) "a" "u" "y" ;
taa = Predef.dp 3 soutaa ;
in
case taa of {
"taa" | "tää" => vHuoltaa soutaa soudan souti soudin ;
"ata" | "ätä" => vPalkata soutaa souti ;
"ota" | "ötä" => vPudota soutaa souti ;
"sta" | "stä" => vJuosta soutaa souden (juo + o+u+"t") (juo + "t"+u) ;
_ + ("da" | "dä") => vJuoda soutaa souti ;
_ => regVerbH soutaa
} ;
reg3VerbH : (_,_,_ : Str) -> VerbH = \soutaa,soudan,souti ->
let
taa = Predef.dp 3 soutaa ;
souda = init soudan ;
juo = Predef.tk 2 soutaa ;
o = last juo ;
a = last taa ;
u = ifTok Str a "a" "u" "y" ;
soudin = weakGrade (init souti) + "in" ;
in case taa of {
"lla" | "llä" => vJuosta soutaa soudan (juo + o+u+"t") (juo + "t"+u) ;
"taa" | "tää" => vHuoltaa soutaa soudan souti soudin ;
_ => reg2VerbH soutaa souti
} ;
-- For "harppoa", "hukkua", "löytyä", with grade alternation.
vHukkua : (_,_ : Str) -> VerbH = \hukkua,huku ->
let {
a = Predef.dp 1 hukkua ;
hukku = Predef.tk 1 hukkua ;
u = Predef.dp 1 huku ;
i = case u of {
"e" | "i" => [] ;
_ => u
} ;
y = case a of {
"a" => "u" ;
_ => "y"
} ;
hukkui = init hukku + i + "i" ;
hukui = init huku + i + "i" ;
} in
mkVerbH
hukkua
(hukku + u)
(huku + "n")
(hukku + "v" + a + "t")
(hukku + (("k" + a) + a))
(huku + ((("t" + a) + a) + "n"))
(hukkui)
(hukui + "n")
(hukkui + "si")
(hukku + "n" + y + "t")
(huku + "tt" + y)
(huku + "t" + y + "t") ;
-- For cases with or without alternation: "sanoa", "valua", "kysyä".
vSanoa : Str -> VerbH = \sanoa ->
vHukkua sanoa (Predef.tk 1 sanoa) ;
---- vHukkua sanoa (weakGrade (Predef.tk 1 sanoa)) ;
---- The gfr file becomes 6* bigger if this change is done
-- For "ottaa", "käyttää", "löytää", "huoltaa", "hiihtää", "siirtää".
vHuoltaa : (_,_,_,_ : Str) -> VerbH = \ottaa,otan,otti,otin ->
let {
a = Predef.dp 1 ottaa ;
aa = a + a ;
u = case a of {"a" => "u" ; _ => "y"} ;
ota = Predef.tk 1 otan ;
otta = Predef.tk 1 ottaa ;
ote = Predef.tk 1 ota + "e"
} in
mkVerbH
ottaa
ottaa
otan
(otta + "v" + a + "t")
(otta + "k" + aa)
(ote + "t" + aa + "n")
otti
otin
(otta + "isi")
(otta + "n" + u + "t")
(ote + "tt" + u)
(ote + "t" + u + "n") ;
-- For cases where grade alternation is not affected by the imperfect "i".
vOttaa : (_,_ : Str) -> VerbH = \ottaa,otan ->
let
i = "i" ; --- wrong rule if_then_Str (pbool2bool (Predef.occurs "ou" ottaa)) "i" "oi"
in
vHuoltaa ottaa otan (Predef.tk 2 ottaa + i) (Predef.tk 2 otan + i + "n") ;
-- For "poistaa", "ryystää".
vPoistaa : Str -> VerbH = \poistaa ->
vOttaa poistaa ((Predef.tk 1 poistaa + "n")) ;
-- For "osata", "lisätä"; grade alternation is unpredictable, as seen
-- from "pelätä-pelkäsi" vs. "palata-palasi"
vOsata : Str -> VerbH = \osata ->
vPalkata osata (Predef.tk 2 osata + "si") ;
vPalkata : Str -> Str -> VerbH = \palkata,palkkasi ->
let
a = Predef.dp 1 palkata ;
palka = Predef.tk 2 palkata ;
palkka = Predef.tk 2 palkkasi ;
u = case a of {"a" => "u" ; _ => "y"}
in
mkVerbH
palkata
(palkka + a)
(palkka + (a + "n"))
(palkka + (((a + "v") + a) + "t"))
(palka + ((("t" + "k") + a) + a))
(palkata + (a + "n"))
(palkka + "si")
(palkka + "sin")
(palkka + "isi")
(palka + "nn" + u + "t")
(palka + "tt" + u)
(palka + "t" + u + "n") ;
vPudota : Str -> Str -> VerbH = \pudota, putosi ->
let
a = Predef.dp 1 pudota ;
pudo = Predef.tk 2 pudota ;
puto = Predef.tk 2 putosi ;
putoa = puto + a ;
u = case a of {"a" => "u" ; _ => "y"}
in
mkVerbH
pudota
(putoa + a)
(putoa + "n")
(putoa + "v" + a + "t")
(pudo + "tk" + a + a)
(pudota + a + "n")
(puto + "si")
(puto + "sin")
(puto + a + "isi")
(pudo + "nn" + u + "t")
(pudo + "tt" + u)
(pudo + "t" + u + "n") ;
vHarkita : Str -> VerbH = \harkita ->
let
a = Predef.dp 1 harkita ;
harki = Predef.tk 2 harkita ;
harkitse = harki + "tse" ;
harkitsi = harki + "tsi" ;
u = case a of {"a" => "u" ; _ => "y"}
in
mkVerbH
harkita
(harkitse + "e")
(harkitse + "n")
(harkitse + "v" + a + "t")
(harki + "tk"+ a + a)
(harkita + a + "n")
(harkitsi)
(harkitsi + "n")
(harkitsi + "si")
(harki + "nn" + u + "t")
(harki + "tt" + u)
(harki + "t" + u + "n") ;
----- tulla,tulee,tulen,tulevat,tulkaa,tullaan,tuli,tulin,tulisi,tullut,tultu,tullun
-- For "juosta", "piestä", "nousta", "rangaista", "kävellä", "surra", "panna".
vJuosta : (_,_,_,_ : Str) -> VerbH = \juosta,juoksen,juossut,juostu ->
let
a = Predef.dp 1 juosta ;
t = last (init juosta) ;
juokse = Predef.tk 1 juoksen ;
juoksi = Predef.tk 2 juoksen + "i" ;
juos = Predef.tk 2 juosta ;
juostun = ifTok Str t "t" (juostu + "n") (init juossut + "n") ;
in
mkVerbH
juosta
(juokse + "e")
juoksen
(juokse + (("v" + a) + "t"))
(juos + (("k" + a) + a))
(juosta + (a + "n"))
juoksi
(juoksi + "n")
(juoksi + "si")
juossut
juostu
juostun ;
-- For "juoda", "syödä", "viedä", "naida", "saada".
vJuoda : (_,_ : Str) -> VerbH = \juoda, joi ->
let
a = Predef.dp 1 juoda ;
juo = Predef.tk 2 juoda ;
u = case a of {"a" => "u" ; _ => "y"}
in
mkVerbH
juoda
juo
(juo + "n")
(juo + (("v" + a) + "t"))
(juo + (("k" + a) + a))
(juoda + (a + "n"))
joi
(joi + "n")
(joi + "si")
(juo + "n" + u + "t")
(juo + "t" + u)
(juo + "d" + u + "n") ;
} ;

View File

@@ -0,0 +1,168 @@
concrete NounFin of Noun = CatFin ** open ResFin, Prelude in {
flags optimize=all_subs ;
lin
-- The $Number$ is subtle: "nuo autot", "nuo kolme autoa" are both plural
-- for verb agreement, but the noun form is singular in the latter.
DetCN det cn =
let
n : Number = case det.isNum of {
True => Sg ;
_ => det.n
} ;
ncase : Case -> NForm = \c ->
case <n,c,det.isNum,det.isPoss, det.isDef> of {
<_, Nom, True,_,_> => NCase Sg Part ; -- kolme kytkintä(ni)
<_, _, True,False,_> => NCase Sg c ; -- kolmeksi kytkimeksi
<Pl,Nom, _,_,False> => NCase Pl Part ; -- kytkimiä
<_, Nom,_,True,_> => NPossNom n ; -- kytkime+ni on/ovat...
<_, Gen,_,True,_> => NPossNom n ; -- kytkime+ni vika
<_, Transl,_,True,_> => NPossTransl n ; -- kytkim(e|i)kse+ni
<_, Illat,_,True,_> => NPossIllat n ; -- kytkim(ee|ii)+ni
_ => NCase n c -- kytkin, kytkimen,...
}
in {
s = \\c => let k = npform2case n c in
det.s1 ! k ++ cn.s ! ncase k ++ det.s2 ;
a = agrP3 (case det.isDef of {
False => Sg ; -- autoja menee; kolme autoa menee
_ => det.n
}) ;
isPron = False
} ;
UsePN pn = {
s = \\c => pn.s ! npform2case Sg c ;
a = agrP3 Sg ;
isPron = False
} ;
UsePron p = p ** {isPron = True} ;
PredetNP pred np = {
s = \\c => pred.s ! np.a.n ! c ++ np.s ! c ;
a = np.a ;
isPron = np.isPron -- kaikki minun - ni
} ;
PPartNP np v2 = {
s = \\c => np.s ! c ++ v2.s ! PastPartPass (AN (NCase np.a.n Ess)) ;
a = np.a ;
isPron = np.isPron -- minun täällä - ni
} ;
AdvNP np adv = {
s = \\c => np.s ! c ++ adv.s ;
a = np.a ;
isPron = np.isPron -- minun täällä - ni
} ;
DetSg quant ord = {
s1 = \\c => quant.s1 ! c ++ ord.s ! Sg ! c ;
s2 = quant.s2 ;
n = Sg ;
isNum = False ;
isPoss = quant.isPoss ;
isDef = False -- doesn't matter with Sg
} ;
DetPl quant num ord = {
s1 = \\c => quant.s1 ! c ++ num.s ! Sg ! c ++ ord.s ! Pl ! c ;
s2 = quant.s2 ;
n = Pl ;
isNum = num.isNum ;
isPoss = quant.isPoss ;
isDef = quant.isDef
} ;
SgQuant quant = {
s1 = quant.s1 ! Sg ;
s2 = quant.s2 ;
isNum = quant.isNum ;
isPoss = quant.isPoss ;
isDef = quant.isDef -- doesn't matter with Sg
} ;
PlQuant quant = {
s1 = quant.s1 ! Pl ;
s2 = quant.s2 ;
isNum = quant.isNum ;
isPoss = quant.isPoss ;
isDef = quant.isDef
} ;
PossPron p = {
s1 = \\_,_ => p.s ! NPCase Gen ;
s2 = BIND ++ possSuffix p.a ;
isNum = False ;
isPoss = True ;
isDef = True --- "minun kolme autoani ovat" ; thus "...on" is missing
} ;
NoNum = {s = \\_,_ => [] ; isNum = False} ;
NoOrd = {s = \\_,_ => []} ;
NumInt n = {s = \\_,_ => n.s ; isNum = True} ;
OrdInt n = {s = \\_,_ => n.s ++ "."} ;
NumNumeral numeral = {s = \\n,c => numeral.s ! NCard (NCase n c) ; isNum = True} ;
OrdNumeral numeral = {s = \\n,c => numeral.s ! NOrd (NCase n c)} ;
AdNum adn num = {s = \\n,c => adn.s ++ num.s ! n ! c ; isNum = num.isNum} ;
OrdSuperl a = {s = \\n,c => a.s ! Superl ! AN (NCase n c)} ;
DefArt = {
s1 = \\_,_ => [] ;
s2 = [] ;
isNum,isPoss = False ;
isDef = True -- autot ovat
} ;
IndefArt = {
s1 = \\_,_ => [] ; -- Nom is Part in Pl: use isDef in DetCN
s2 = [] ;
isNum,isPoss,isDef = False -- autoja on
} ;
MassDet = {
s1 = \\_ => [] ; --- Nom is Part ?
s2 = [] ;
isNum,isPoss,isDef = False
} ;
UseN n = n ;
UseN2 n = n ;
UseN3 n = n ;
--- If a possessive suffix is added here it goes after the complements...
ComplN2 f x = {
s = \\nf => appCompl True Pos f.c2 x ++ f.s ! nf
} ;
ComplN3 f x = {
s = \\nf => appCompl True Pos f.c2 x ++ f.s ! nf ;
c2 = f.c3
} ;
AdjCN ap cn = {
s = \\nf => ap.s ! True ! AN (n2nform nf) ++ cn.s ! nf
} ;
RelCN cn rs = {s = \\nf => cn.s ! nf ++ rs.s ! agrP3 (numN nf)} ;
AdvCN cn ad = {s = \\nf => cn.s ! nf ++ ad.s} ;
SentCN cn sc = {s = \\nf=> cn.s ! nf ++ sc.s} ;
ApposCN cn np = {s = \\nf=> cn.s ! nf ++ np.s ! NPCase Nom} ; --- luvun x
oper
numN : NForm -> Number = \nf -> case nf of {
NCase n _ => n ;
_ => Sg ---
} ;
}

View File

@@ -0,0 +1,142 @@
concrete NumeralFin of Numeral = CatFin ** open Prelude, ParadigmsFin, MorphoFin in {
-- Notice: possessive forms are not used. They get wrong, since every
-- part is made to agree in them.
flags optimize = all_subs ;
lincat
Sub1000000 = {s : CardOrd => Str ; n : MorphoFin.Number} ;
Digit = {s : CardOrd => Str} ;
Sub10, Sub100, Sub1000 = {s : NumPlace => CardOrd => Str ; n : MorphoFin.Number} ;
lin
num x = x ;
n2 = co
(nhn (mkSubst "a" "kaksi" "kahde" "kahte" "kahta" "kahteen" "kaksi" "kaksi"
"kaksien" "kaksia" "kaksiin"))
(ordN "a" "kahdes") ; --- toinen
n3 = co
(nhn (mkSubst "a" "kolme" "kolme" "kolme" "kolmea" "kolmeen" "kolmi" "kolmi"
"kolmien" "kolmia" "kolmiin"))
(ordN "a" "kolmas") ;
n4 = co (regN "neljä") (ordN "ä" "neljäs") ;
n5 = co (reg3N "viisi" "viiden" "viisiä") (ordN "ä" "viides") ;
n6 = co (reg3N "kuusi" "kuuden" "kuusia") (ordN "a" "kuudes") ;
n7 = co
(nhn (mkSubst "ä" "seitsemän" "seitsemä" "seitsemä" "seitsemää"
"seitsemään" "seitsemi" "seitsemi" "seitsemien" "seitsemiä"
"seitsemiin"))
(ordN "ä" "seitsemäs") ;
n8 = co
(nhn (mkSubst "a" "kahdeksan" "kahdeksa" "kahdeksa" "kahdeksaa"
"kahdeksaan" "kahdeksi" "kahdeksi" "kahdeksien" "kahdeksia"
"kahdeksiin"))
(ordN "a" "kahdeksas") ;
n9 = co
(nhn (mkSubst "ä" "yhdeksän" "yhdeksä" "yhdeksä" "yhdeksää"
"yhdeksään" "yhdeksi" "yhdeksi" "yhdeksien" "yhdeksiä" "yhdeksiin"))
(ordN "ä" "yhdeksäs") ;
pot01 =
{s = table {
NumAttr => \\_ => [] ;
NumIndep => yksiN.s
} ;
n = Sg
} ;
pot0 d = {n = Pl ; s = \\_ => d.s} ;
pot110 =
{s = \\_ => kymmenenN.s ;
n = Pl
} ;
pot111 = {n = Pl ; s = \\_,c => yksiN.s ! c ++"toista"} ; ---- yhdes
pot1to19 d = {n = Pl ; s = \\_,c => d.s ! c ++"toista"} ;
pot0as1 n = n ;
pot1 d = {n = Pl ; s = \\_,c => d.s ! c ++ kymmentaN.s ! c} ;
pot1plus d e = {
n = Pl ;
s = \\_,c => d.s ! c ++ kymmentaN.s ! c ++ e.s ! NumIndep ! c
} ;
pot1as2 n = n ;
pot2 d = {n = Pl ; s = \\_,c => d.s ! NumAttr ! c ++ sataaN.s ! d.n ! c} ; ----
pot2plus d e = {
n = Pl ;
s = \\_,c => d.s ! NumAttr ! c ++ sataaN.s ! d.n ! c ++ e.s ! NumIndep ! c
} ;
pot2as3 n = {n = n.n ; s = n.s ! NumIndep} ;
pot3 d = {n = Pl ; s = \\c => d.s ! NumAttr ! c ++ tuhattaN.s ! d.n ! c} ; ----
pot3plus d e = {
n = Pl ;
s = \\c => d.s ! NumAttr ! c ++ tuhattaN.s ! d.n ! c ++ e.s ! NumIndep ! c
} ;
oper
co : (c,o : {s : NForm => Str}) -> {s : CardOrd => Str} = \c,o -> {
s = table {
NCard nf => c.s ! nf ;
NOrd nf => o.s ! nf
}
} ;
-- Too much trouble to infer vowel, cf. "kuudes" vs. "viides".
ordN : Str -> Str -> {s : NForm => Str} = \a,sadas ->
let
sada = init sadas
in
mkN
sadas (sada + "nnen") (sada + "nten" + a) (sada + "tt" + a) (sada + "nteen")
(sada + "nsin" + a) (sada + "nsiss" + a) (sada + "nsien")
(sada + "nsi" + a) (sada + "nsiin") ;
param
NumPlace = NumIndep | NumAttr ;
oper
yksiN = co
(nhn (mkSubst "ä" "yksi" "yhde" "yhte" "yhtä" "yhteen" "yksi" "yksi"
"yksien" "yksiä" "yksiin"))
(ordN "ä" "yhdes") ; ---- ensimmäinen
kymmenenN = co
(nhn (mkSubst "ä" "kymmenen" "kymmene" "kymmene" "kymmentä"
"kymmeneen" "kymmeni" "kymmeni" "kymmenien" "kymmeniä" "kymmeniin"))
(ordN "ä" "kymmenes") ;
sataN = co
(nhn (sLukko "sata"))
(ordN "a" "sadas") ;
tuhatN = co
(nhn (mkSubst "a" "tuhat" "tuhanne" "tuhante" "tuhatta" "tuhanteen"
"tuhansi" "tuhansi" "tuhansien" "tuhansia" "tuhansiin"))
(ordN "a" "tuhannes") ;
kymmentaN =
{s = table {
NCard (NCase Sg Nom) => "kymmentä" ;
k => kymmenenN.s ! k
}
} ;
sataaN : {s : MorphoFin.Number => CardOrd => Str} = {s = table {
Sg => sataN.s ;
Pl => table {
NCard (NCase Sg Nom) => "sataa" ;
k => sataN.s ! k
}
}
} ;
tuhattaN = {s = table {
Sg => tuhatN.s ;
Pl => table {
NCard (NCase Sg Nom) => "tuhatta" ;
k => tuhatN.s ! k
}
}
} ;
}

View File

@@ -0,0 +1,637 @@
--# -path=.:../abstract:../common:../../prelude
--1 Finnish Lexical Paradigms
--
-- Aarne Ranta 2003--2005
--
-- This is an API to the user of the resource grammar
-- for adding lexical items. It gives functions for forming
-- expressions of open categories: nouns, adjectives, verbs.
--
-- Closed categories (determiners, pronouns, conjunctions) are
-- accessed through the resource syntax API, $Structural.gf$.
--
-- The main difference with $MorphoFin.gf$ is that the types
-- referred to are compiled resource grammar types. We have moreover
-- had the design principle of always having existing forms, rather
-- than stems, as string arguments of the paradigms.
--
-- The structure of functions for each word class $C$ is the following:
-- first we give a handful of patterns that aim to cover all
-- regular cases. Then we give a worst-case function $mkC$, which serves as an
-- escape to construct the most irregular words of type $C$.
-- However, this function should only seldom be needed.
resource ParadigmsFin = open
(Predef=Predef),
Prelude,
MorphoFin,
CatFin
in {
flags optimize=noexpand ;
--2 Parameters
--
-- To abstract over gender, number, and (some) case names,
-- we define the following identifiers. The application programmer
-- should always use these constants instead of the constructors
-- defined in $ResFin$.
oper
Number : Type ;
singular : Number ;
plural : Number ;
Case : Type ;
nominative : Case ;
genitive : Case ;
partitive : Case ;
translative : Case ;
inessive : Case ;
elative : Case ;
illative : Case ;
adessive : Case ;
ablative : Case ;
allative : Case ;
-- The following type is used for defining *rection*, i.e. complements
-- of many-place verbs and adjective. A complement can be defined by
-- just a case, or a pre/postposition and a case.
prePrep : Case -> Str -> Prep ; -- ilman, partitive
postPrep : Case -> Str -> Prep ; -- takana, genitive
postGenPrep : Str -> Prep ; -- takana
casePrep : Case -> Prep ; -- adessive
--2 Nouns
-- The worst case gives ten forms.
-- In practice just a couple of forms are needed to define the different
-- stems, vowel alternation, and vowel harmony.
oper
-- The regular noun heuristic takes just one form (singular
-- nominative) and analyses it to pick the correct paradigm.
-- It does automatic grade alternation, and is hence not usable
-- for words like "auto" (whose genitive would become "audon").
--
-- If the one-argument paradigm does not give the correct result, one can try and give
-- two or three forms. Most notably, the two-argument variant is used
-- for nouns like "kivi - kiviä", which would otherwise become like
-- "rivi - rivejä". Three arguments are used e.g. for
-- "sydän - sydämen - sydämiä", which would otherwise become
-- "sydän - sytämen".
mkN : overload {
mkN : (talo : Str) -> N ;
mkN : (savi,savia : Str) -> N ;
mkN : (vesi,veden,vesiä : Str) -> N ;
mkN : (olo,oln,olona,oloa,oloon,oloina,oloissa,olojen,oloja,oloihin : Str) -> N
} ;
-- Some nouns have an unexpected singular partitive, e.g. "meri", "lumi".
sgpartN : (meri : N) -> (merta : Str) -> N ;
nMeri : (meri : Str) -> N ;
-- The rest of the noun paradigms are mostly covered by the three
-- heuristics.
--
-- Nouns with partitive "a","ä" are a large group.
-- To determine for grade and vowel alternation, three forms are usually needed:
-- singular nominative and genitive, and plural partitive.
-- Examples: "talo", "kukko", "huippu", "koira", "kukka", "syylä", "särki"...
nKukko : (kukko,kukon,kukkoja : Str) -> N ;
-- A special case:
-- the vowel harmony is inferred from the last letter,
-- which must be one of "o", "u", "ö", "y". Regular weak-grade alternation
-- is performed.
nTalo : (talo : Str) -> N ;
-- Another special case are nouns where the last two consonants
-- undergo regular weak-grade alternation:
-- "kukko - kukon", "rutto - ruton", "hyppy - hypyn", "sampo - sammon",
-- "kunto - kunnon", "sisältö - sisällön", .
nLukko : (lukko : Str) -> N ;
-- "arpi - arven", "sappi - sapen", "kampi - kammen";"sylki - syljen"
nArpi : (arpi : Str) -> N ;
nSylki : (sylki : Str) -> N ;
-- Foreign words ending in consonants are actually similar to words like
-- "malli"-"mallin"-"malleja", with the exception that the "i" is not attached
-- to the singular nominative. Examples: "linux", "savett", "screen".
-- The singular partitive form is used to get the vowel harmony.
-- (N.B. more than 1-syllabic words ending in "n" would have variant
-- plural genitive and partitive forms, like
-- "sultanien", "sultaneiden", which are not covered.)
nLinux : (linuxia : Str) -> N ;
-- Nouns of at least 3 syllables ending with "a" or "ä", like "peruna", "tavara",
-- "rytinä".
nPeruna : (peruna : Str) -> N ;
-- The following paradigm covers both nouns ending in an aspirated "e", such as
-- "rae", "perhe", "savuke", and also many ones ending in a consonant
-- ("rengas", "kätkyt"). The singular nominative and essive are given.
nRae : (rae, rakeena : Str) -> N ;
-- The following covers nouns with partitive "ta","tä", such as
-- "susi", "vesi", "pieni". To get all stems and the vowel harmony, it takes
-- the singular nominative, genitive, and essive.
nSusi : (susi,suden,sutta : Str) -> N ;
-- Nouns ending with a long vowel, such as "puu", "pää", "pii", "leikkuu",
-- are inflected according to the following.
nPuu : (puu : Str) -> N ;
-- One-syllable diphthong nouns, such as "suo", "tie", "työ", are inflected by
-- the following.
nSuo : (suo : Str) -> N ;
-- Many adjectives but also nouns have the nominative ending "nen" which in other
-- cases becomes "s": "nainen", "ihminen", "keltainen".
-- To capture the vowel harmony, we use the partitive form as the argument.
nNainen : (naista : Str) -> N ;
-- The following covers some nouns ending with a consonant, e.g.
-- "tilaus", "kaulin", "paimen", "laidun".
nTilaus : (tilaus,tilauksena : Str) -> N ;
-- Special case:
nKulaus : (kulaus : Str) -> N ;
-- The following covers nouns like "nauris" and adjectives like "kallis", "tyyris".
-- The partitive form is taken to get the vowel harmony.
nNauris : (naurista : Str) -> N ;
-- Separately-written compound nouns, like "sambal oelek", "Urho Kekkonen",
-- have only their last part inflected.
compN : Str -> N -> N ;
-- Nouns used as functions need a case, of which the default is
-- the genitive.
mkN2 = overload {
mkN2 : N -> N2 = genN2 ;
mkN2 : N -> Prep -> N2 = mmkN2
} ;
mkN3 : N -> Prep -> Prep -> N3 ;
-- Proper names can be formed by using declensions for nouns.
-- The plural forms are filtered away by the compiler.
mkPN : overload {
mkPN : Str -> PN ;
mkPN : N -> PN
} ;
--2 Adjectives
-- Non-comparison one-place adjectives are just like nouns.
-- The regular adjectives are based on $regN$ in the positive.
-- Comparison adjectives have three forms.
-- The comparative and the superlative
-- are always inflected in the same way, so the nominative of them is actually
-- enough (except for the superlative "paras" of "hyvä").
mkA : overload {
mkA : Str -> A ;
mkA : N -> A ;
mkA : N -> (kivempaa,kivinta : Str) -> A
} ;
-- Two-place adjectives need a case for the second argument.
mkA2 : A -> Prep -> A2 ;
--2 Verbs
--
-- The grammar does not cover the potential mood and some nominal
-- forms. One way to see the coverage is to linearize a verb to
-- a table.
-- The worst case needs twelve forms, as shown in the following.
-- The following heuristics cover more and more verbs.
mkV : overload {
mkV : (soutaa : Str) -> V ;
mkV : (soutaa,souti : Str) -> V ;
mkV : (soutaa,soudan,souti : Str) -> V ;
mkV : (tulla,tulee,tulen,tulevat,tulkaa,tullaan,tuli,tulin,tulisi,tullut,tultu,tullun : Str) -> V ;
-- The subject case of verbs is by default nominative. This function can change it.
mkV : V -> Case -> V
} ;
-- The rest of the paradigms are special cases mostly covered by the heuristics.
-- A simple special case is the one with just one stem and without grade alternation.
vValua : (valua : Str) -> V ;
-- With two forms, the following function covers a variety of verbs, such as
-- "ottaa", "käyttää", "löytää", "huoltaa", "hiihtää", "siirtää".
vKattaa : (kattaa, katan : Str) -> V ;
-- When grade alternation is not present, just a one-form special case is needed
-- ("poistaa", "ryystää").
vOstaa : (ostaa : Str) -> V ;
-- The following covers
-- "juosta", "piestä", "nousta", "rangaista", "kävellä", "surra", "panna".
vNousta : (nousta, nousen : Str) -> V ;
-- This is for one-syllable diphthong verbs like "juoda", "syödä".
vTuoda : (tuoda : Str) -> V ;
-- All the patterns above have $nominative$ as subject case.
-- If another case is wanted, use the following.
caseV : Case -> V -> V ;
-- The verbs "be" is special.
vOlla : V ;
--3 Two-place verbs
--
-- Two-place verbs need an object case, and can have a pre- or postposition.
-- The default is direct (accusative) object. There is also a special case
-- with case only. The string-only argument case yields a regular verb with
-- accusative object.
mkV2 : overload {
mkV2 : Str -> V2 ;
mkV2 : V -> V2 ;
mkV2 : V -> Case -> V2 ;
mkV2 : V -> Prep -> V2 ;
} ;
--3 Three-place verbs
--
-- Three-place (ditransitive) verbs need two prepositions, of which
-- the first one or both can be absent.
mkV3 : V -> Prep -> Prep -> V3 ; -- puhua, allative, elative
dirV3 : V -> Case -> V3 ; -- siirtää, (accusative), illative
dirdirV3 : V -> V3 ; -- antaa, (accusative), (allative)
--3 Other complement patterns
--
-- Verbs and adjectives can take complements such as sentences,
-- questions, verb phrases, and adjectives.
mkV0 : V -> V0 ;
mkVS : V -> VS ;
mkV2S : V -> Prep -> V2S ;
mkVV : V -> VV ;
mkV2V : V -> Prep -> V2V ;
mkVA : V -> Prep -> VA ;
mkV2A : V -> Prep -> Prep -> V2A ;
mkVQ : V -> VQ ;
mkV2Q : V -> Prep -> V2Q ;
mkAS : A -> AS ;
mkA2S : A -> Prep -> A2S ;
mkAV : A -> AV ;
mkA2V : A -> Prep -> A2V ;
-- Notice: categories $V2S, V2V, V2Q$ are in v 1.0 treated
-- just as synonyms of $V2$, and the second argument is given
-- as an adverb. Likewise $AS, A2S, AV, A2V$ are just $A$.
-- $V0$ is just $V$.
V0, V2S, V2V, V2Q : Type ;
AS, A2S, AV, A2V : Type ;
--.
-- The definitions should not bother the user of the API. So they are
-- hidden from the document.
Case = MorphoFin.Case ;
Number = MorphoFin.Number ;
singular = Sg ;
plural = Pl ;
nominative = Nom ;
genitive = Gen ;
partitive = Part ;
translative = Transl ;
inessive = Iness ;
elative = Elat ;
illative = Illat ;
adessive = Adess ;
ablative = Ablat ;
allative = Allat ;
prePrep : Case -> Str -> Prep =
\c,p -> {c = NPCase c ; s = p ; isPre = True ; lock_Prep = <>} ;
postPrep : Case -> Str -> Prep =
\c,p -> {c = NPCase c ; s = p ; isPre = False ; lock_Prep = <>} ;
postGenPrep p = {
c = NPCase genitive ; s = p ; isPre = False ; lock_Prep = <>} ;
casePrep : Case -> Prep =
\c -> {c = NPCase c ; s = [] ; isPre = True ; lock_Prep = <>} ;
accPrep = {c = NPAcc ; s = [] ; isPre = True ; lock_Prep = <>} ;
mk10N= \a,b,c,d,e,f,g,h,i,j ->
mkNoun a b c d e f g h i j ** {lock_N = <>} ;
mkN = overload {
mkN : (talo : Str) -> N = regN ;
mkN : (savi,savia : Str) -> N = reg2N ;
mkN : (vesi,veden,vesiä : Str) -> N = reg3N ;
mkN : (talo, talon, talona, taloa, taloon,
taloina,taloissa,talojen,taloja,taloihin : Str) -> N = mk10N
} ;
regN = \vesi ->
let
esi = Predef.dp 3 vesi ; -- analysis: suffixes
a = if_then_Str (pbool2bool (Predef.occurs "aou" vesi)) "a" "ä" ;
ves = init vesi ; -- synthesis: prefixes
vet = strongGrade ves ;
ve = init ves ;
in nhn (
case esi of {
"uus" | "yys" => sRakkaus vesi ;
_ + "nen" => sNainen (Predef.tk 3 vesi + ("st" + a)) ;
_ + ("aa" | "ee" | "ii" | "oo" | "uu" | "yy" | "ää" | "öö") => sPuu vesi ;
_ + ("ie" | "uo" | "yö") => sSuo vesi ;
_ + ("ea" | "eä") =>
mkSubst
a
vesi (vesi) (vesi) (vesi + a) (vesi + a+"n")
(ves + "i") (ves + "i") (ves + "iden") (ves + "it"+a)
(ves + "isiin") ;
_ + "is" => sNauris (vesi + ("t" + a)) ;
_ + ("ut" | "yt") => sRae vesi (ves + ("en" + a)) ;
_ + ("as" | "äs") => sRae vesi (vet + (a + "n" + a)) ;
_ + ("ar" | "är") => sRae vesi (vet + ("ren" + a)) ;
_ + "n" => sLiitin vesi (vet + "men") ;
_ + "s" => sTilaus vesi (ves + ("ksen" + a)) ;
_ + "i" => sBaari (vesi + a) ;
_ + "e" => sRae vesi (strongGrade vesi + "en" + a) ;
_ + ("a" | "o" | "u" | "y" | "ä" | "ö") => sLukko vesi ;
_ => sLinux (vesi + "i" + a)
}
) ** {lock_N = <>} ;
reg2N : (savi,savia : Str) -> N = \savi,savia ->
let
savit = regN savi ;
ia = Predef.dp 2 savia ;
i = init ia ;
a = last ia ;
o = last savi ;
savin = weakGrade savi + "n" ;
in
case <o,ia> of {
<"i","ia"> => nhn (sArpi savi) ;
<"i","iä"> => nhn (sSylki savi) ;
<"o","ta"> | <"ö","tä"> => nhn (sRadio savi) ;
<"a","ta"> | <"ä","tä"> => nhn (sPeruna savi) ;
<"i","ta"> | <"i","tä"> => nhn (sTohtori (savi + a)) ; -- from 10 to 90 ms
-- <"a","ia"> | <"a","ja"> => nhn (sKukko savi savin savia) ; ---needless?
_ => savit
}
** {lock_N = <>} ;
reg3N = \vesi,veden,vesiä ->
let
si = Predef.dp 2 vesi ;
a = last vesiä
in
case si of {
"us" | "ys" =>
nhn (case Predef.dp 3 veden of {
"den" => sRakkaus vesi ;
_ => sTilaus vesi (veden + a)
}) ;
"as" | "äs" => nhn (sRae vesi (veden + a)) ;
"li" | "ni" | "ri" => nhn (sSusi vesi veden (init vesi + ("en" + a))) ;
"si" => nhn (sSusi vesi veden (Predef.tk 2 vesi + ("ten" + a))) ;
"in" | "en" | "än" => nhn (sLiitin vesi veden) ;
_ + ("a" | "o" | "u" | "y" | "ä" | "ö") => nhn (sKukko vesi veden vesiä) ;
_ {- + "i" -} => nhn (sKorpi vesi veden (init veden + "n" + a))
}
** {lock_N = <>} ;
nKukko = \a,b,c -> nhn (sKukko a b c) ** {lock_N = <>} ;
nLukko = \a -> nhn (sLukko a) ** {lock_N = <>} ;
nTalo = \a -> nhn (sTalo a) ** {lock_N = <>} ;
nArpi = \a -> nhn (sArpi a) ** {lock_N = <>} ;
nSylki = \a -> nhn (sSylki a) ** {lock_N = <>} ;
nLinux = \a -> nhn (sLinux a) ** {lock_N = <>} ;
nPeruna = \a -> nhn (sPeruna a) ** {lock_N = <>} ;
nRae = \a,b -> nhn (sRae a b) ** {lock_N = <>} ;
nSusi = \a,b,c -> nhn (sSusi a b c) ** {lock_N = <>} ;
nPuu = \a -> nhn (sPuu a) ** {lock_N = <>} ;
nSuo = \a -> nhn (sSuo a) ** {lock_N = <>} ;
nNainen = \a -> nhn (sNainen a) ** {lock_N = <>} ;
nTilaus = \a,b -> nhn (sTilaus a b) ** {lock_N = <>} ;
nKulaus = \a -> nTilaus a (init a + "ksen" + getHarmony (last
(init a))) ;
nNauris = \a -> nhn (sNauris a) ** {lock_N = <>} ;
sgpartN noun part = {
s = table {
NCase Sg Part => part ;
c => noun.s ! c
} ;
g = noun.g ;
lock_N = noun.lock_N
} ;
nMeri meri =
let a = vowelHarmony meri in
sgpartN (reg2N meri (meri + a)) (init meri + "ta") ;
compN = \s,n -> {s = \\c => s ++ n.s ! c ; g = n.g ; lock_N = <>} ;
makeNP : N -> Number -> CatFin.NP ;
makeNP noun num = {
s = \\c => noun.s ! NCase num (npform2case num c) ;
a = agrP3 num ;
isPron = False ;
lock_NP = <>
} ;
mkPN = overload {
mkPN : Str -> PN = regPN ;
mkPN : N -> PN = mmkPN
} ;
mkA = overload {
mkA : Str -> A = regA ;
mkA : N -> A = mk1A ;
mkA : N -> (kivempaa,kivinta : Str) -> A = mkADeg
} ;
mk1A = \x -> {s = \\_ => (noun2adj x).s ; lock_A = <>} ;
mkA2 = \x,c -> x ** {c2 = c ; lock_A2 = <>} ;
mkADeg x kivempi kivin =
let
a = last (x.s ! ((NCase Sg Part))) ; ---- gives "kivinta"
kivempaa = init kivempi + a + a ;
kivinta = kivin + "t" + a
in
regAdjective x kivempaa kivinta ** {lock_A = <>} ;
regA suuri =
let suur = regN suuri in
mkADeg
suur
(init (suur.s ! NCase Sg Gen) + "mpi")
(init (suur.s ! NCase Pl Ess)) ;
regADeg = regA ; -- for bw compat
mk12V a b c d e f g h i j k l = mkVerb a b c d e f g h i j k l **
{sc = NPCase Nom ; lock_V = <>} ;
mkV = overload {
mkV : (soutaa : Str) -> V = regV ;
mkV : (soutaa,souti : Str) -> V = reg2V ;
mkV : (soutaa,soudan,souti : Str) -> V = reg3V ;
mkV : (tulla,tulee,tulen,tulevat,tulkaa,tullaan,
tuli,tulin,tulisi,tullut,tultu,tullun : Str) -> V = mk12V ;
mkV : V -> Case -> V = subjcaseV
} ;
regV soutaa = v2v (regVerbH soutaa) ** {sc = NPCase Nom ; lock_V = <>} ;
reg2V : (soutaa,souti : Str) -> V = \soutaa,souti ->
v2v (reg2VerbH soutaa souti) ** {sc = NPCase Nom ; lock_V = <>} ;
reg3V soutaa soudan souti =
v2v (reg3VerbH soutaa soudan souti) ** {sc = NPCase Nom ; lock_V = <>} ;
subjcaseV v c = {s = v.s ; sc = NPCase c ; lock_V = v.lock_V} ;
vValua v = v2v (vSanoa v) ** {sc = NPCase Nom ; lock_V = <>} ;
vKattaa v u = v2v (vOttaa v u) ** {sc = NPCase Nom ; lock_V = <>} ;
vOstaa v = v2v (vPoistaa v) ** {sc = NPCase Nom ; lock_V = <>} ;
vNousta v u = v2v (vJuosta v u [] []) ** {sc = NPCase Nom ; lock_V = <>} ; -----
vTuoda v = v2v (vJuoda v []) ** {sc = NPCase Nom ; lock_V = <>} ; -----
caseV c v = {s = v.s ; sc = NPCase c ; lock_V = <>} ;
vOlla = verbOlla ** {sc = NPCase Nom ; lock_V = <>} ;
vHuoltaa : (_,_,_,_ : Str) -> Verb = \ottaa,otan,otti,otin ->
v2v (MorphoFin.vHuoltaa ottaa otan otti otin) ** {sc = NPCase Nom ; lock_V = <>} ;
mk2V2 = \v,c -> v ** {c2 = c ; lock_V2 = <>} ;
caseV2 = \v,c -> mk2V2 v (casePrep c) ;
dirV2 v = mk2V2 v accPrep ;
mkAdv : Str -> Adv = \s -> {s = s ; lock_Adv = <>} ;
mkV3 v p q = v ** {c2 = p ; c3 = q ; lock_V3 = <>} ;
dirV3 v p = mkV3 v accPrep (casePrep p) ;
dirdirV3 v = dirV3 v allative ;
mkVS v = v ** {lock_VS = <>} ;
mkVV v = v ** {lock_VV = <>} ;
mkVQ v = v ** {lock_VQ = <>} ;
V0 : Type = V ;
V2S, V2V, V2Q : Type = V2 ;
AS, A2S, AV : Type = A ;
A2V : Type = A2 ;
mkV0 v = v ** {lock_V = <>} ;
mkV2S v p = mk2V2 v p ** {lock_V2 = <>} ;
mkV2V v p = mk2V2 v p ** {lock_V2 = <>} ;
mkVA v p = v ** {c2 = p ; lock_VA = <>} ;
mkV2A v p q = v ** {c2 = p ; c3 = q ; lock_V2A = <>} ;
mkV2Q v p = mk2V2 v p ** {lock_V2 = <>} ;
mkAS v = v ** {lock_A = <>} ;
mkA2S v p = mkA2 v p ** {lock_A = <>} ;
mkAV v = v ** {lock_A = <>} ;
mkA2V v p = mkA2 v p ** {lock_A2 = <>} ;
--- old stuff
reg2N : (savi,savia : Str) -> N ;
reg3N : (vesi,veden,vesiä : Str) -> N ;
mk10N: (talo, talon, talona, taloa, taloon,
taloina,taloissa,talojen,taloja,taloihin : Str) -> N ;
regN : (talo : Str) -> N ;
mmkN2 : N -> Prep -> N2 = \n,c -> n ** {c2 = c ; lock_N2 = <>} ;
mkN3 = \n,c,e -> n ** {c2 = c ; c3 = e ; lock_N3 = <>} ;
genN2 = \n -> mmkN2 n (casePrep genitive) ;
regPN m = mmkPN (regN m) ;
mmkPN : N -> PN = \n -> mkProperName n ** {lock_PN = <>} ;
genN2 : N -> N2 ;
mk1A : N -> A ;
mkADeg : (kiva : N) -> (kivempaa,kivinta : Str) -> A ;
regA : (punainen : Str) -> A ;
mk12V : (tulla,tulee,tulen,tulevat,tulkaa,tullaan,
tuli,tulin,tulisi,tullut,tultu,tullun : Str) -> V ;
regV : (soutaa : Str) -> V ;
reg2V : (soutaa,souti : Str) -> V ;
reg3V : (soutaa,soudan,souti : Str) -> V ;
subjcaseV : V -> Case -> V ;
regPN : Str -> PN ;
mkV2 = overload {
mkV2 : Str -> V2 = \s -> dirV2 (regV s) ;
mkV2 : V -> V2 = dirV2 ;
mkV2 : V -> Case -> V2 = caseV2 ;
mkV2 : V -> Prep -> V2 = mk2V2 ;
} ;
dirV2 : V -> V2 ;
mk2V2 : V -> Prep -> V2 ;
caseV2 : V -> Case -> V2 ;
dirV2 : V -> V2 ;
} ;

View File

@@ -0,0 +1,24 @@
concrete PhraseFin of Phrase = CatFin ** open ResFin in {
lin
PhrUtt pconj utt voc = {s = pconj.s ++ utt.s ++ voc.s} ;
UttS s = s ;
UttQS qs = {s = qs.s} ;
UttImpSg pol imp = {s = pol.s ++ imp.s ! pol.p ! Sg} ;
UttImpPl pol imp = {s = pol.s ++ imp.s ! pol.p ! Pl} ;
UttImpPol pol imp = {s = pol.s ++ imp.s ! pol.p ! Pl} ;
UttIP ip = {s = ip.s ! NPCase Nom} ;
UttIAdv iadv = iadv ;
UttNP np = {s = np.s ! NPCase Nom} ;
UttVP vp = {s = infVP (NPCase Nom) Pos (agrP3 Sg) vp} ;
UttAdv adv = adv ;
NoPConj = {s = []} ;
PConjConj conj = conj ;
NoVoc = {s = []} ;
VocNP np = {s = "," ++ np.s ! NPCase Nom} ;
}

View File

@@ -0,0 +1,68 @@
concrete QuestionFin of Question = CatFin ** open ResFin, Prelude in {
flags optimize=all_subs ;
lin
QuestCl cl = {
s = \\t,a,p => cl.s ! t ! a ! p ! SQuest
} ;
QuestVP ip vp =
let
cl = mkClause (subjForm (ip ** {isPron = False ; a = agrP3 ip.n}) vp.sc) (agrP3 ip.n) vp
in {
s = \\t,a,p => cl.s ! t ! a ! p ! SDecl
} ;
QuestSlash ip slash = {
s = \\t,a,p =>
let
cls = slash.s ! t ! a ! p ;
who = appCompl True p slash.c2 (ip ** {a = agrP3 ip.n ; isPron = False})
in
who ++ cls
} ;
QuestIAdv iadv cl = {
s = \\t,a,p => iadv.s ++ cl.s ! t ! a ! p ! SDecl
} ;
QuestIComp icomp np = {
s = \\t,a,p =>
let
vp = predV (verbOlla ** {sc = NPCase Nom}) ;
cl = mkClause (subjForm np vp.sc) np.a vp ;
in
icomp.s ! np.a ++ cl.s ! t ! a ! p ! SDecl
} ;
PrepIP p ip = {s =
appCompl True Pos p (ip ** {a = agrP3 ip.n ; isPron = False})} ;
AdvIP ip adv = {
s = \\c => ip.s ! c ++ adv.s ;
n = ip.n
} ;
-- The computation of $ncase$ is a special case of that in $NounFin.DetCN$,
-- since we don't have possessive suffixes or definiteness.
--- It could still be nice to have a common oper...
IDetCN idet num ord cn = let n = idet.n in {
s = \\c =>
let
k = npform2case n c ;
ncase = case <k,num.isNum> of {
<Nom, True> => NCase Sg Part ; -- mitkä kolme kytkintä
<_, True> => NCase Sg k ; -- miksi kolmeksi kytkimeksi
_ => NCase n k -- mitkä kytkimet
}
in
idet.s ! k ++ num.s ! Sg ! k ++ ord.s ! n ! k ++ cn.s ! ncase ;
n = n
} ;
CompIAdv a = {s = \\_ => a.s} ;
}

View File

@@ -0,0 +1,50 @@
concrete RelativeFin of Relative = CatFin ** open Prelude, ResFin, MorphoFin in {
flags optimize=all_subs ;
lin
RelCl cl = {
s = \\t,a,p,_ => "siten" ++ "että" ++ cl.s ! t ! a ! p ! SDecl ;
---- sellainen
c = NPCase Nom
} ;
RelVP rp vp = {
s = \\t,ant,b,ag =>
let
agr = case rp.a of {
RNoAg => ag ;
RAg a => a
} ;
cl = mkClause
(subjForm {s = rp.s ! agr.n ;
a = agr ; isPron = False} vp.sc) agr vp
in
cl.s ! t ! ant ! b ! SDecl ;
c = NPCase Nom
} ;
RelSlash rp slash = {
s = \\t,a,p,ag =>
let
cls = slash.s ! t ! a ! p ;
who = appCompl True p slash.c2 (rp2np ag.n rp)
in
who ++ cls ;
c = slash.c2.c
} ;
FunRP p np rp = {
s = \\n,c => appCompl True Pos p (rp2np n rp) ++ np.s ! c ; --- is c OK?
a = RAg np.a
} ;
IdRP = {
s = \\n,c => relPron ! n ! npform2case n c ;
a = RNoAg
} ;
}

View File

@@ -0,0 +1,575 @@
--# -path=.:../abstract:../common:../../prelude
--1 Finnish auxiliary operations.
-- This module contains operations that are needed to make the
-- resource syntax work. To define everything that is needed to
-- implement $Test$, it moreover contains regular lexical
-- patterns needed for $Lex$.
resource ResFin = ParamX ** open Prelude in {
flags optimize=all ;
--2 Parameters for $Noun$
-- This is the $Case$ as needed for both nouns and $NP$s.
param
Case = Nom | Gen | Part | Transl | Ess
| Iness | Elat | Illat | Adess | Ablat | Allat
| Abess ; -- Comit, Instruct in NForm
NForm = NCase Number Case
| NComit | NInstruct -- no number dist
| NPossNom Number | NPossGen Number --- number needed for syntax of AdjCN
| NPossTransl Number | NPossIllat Number ;
-- Agreement of $NP$ is a record. We'll add $Gender$ later.
oper
Agr = {n : Number ; p : Person} ;
NP = {s : NPForm => Str ; a : Agr ; isPron : Bool} ;
--
--2 Adjectives
--
-- The major division is between the comparison degrees. A degree fixed,
-- an adjective is like common nouns, except for the adverbial form.
param
AForm = AN NForm | AAdv ;
oper
Adjective : Type = {s : Degree => AForm => Str} ;
--2 Noun phrases
--
-- Two forms of *virtual accusative* are needed for nouns in singular,
-- the nominative and the genitive one ("ostan talon"/"osta talo").
-- For nouns in plural, only a nominative accusative exist. Pronouns
-- have a uniform, special accusative form ("minut", etc).
param
NPForm = NPCase Case | NPAcc ;
oper
npform2case : Number -> NPForm -> Case = \n,f ->
-- type signature: workaround for gfc bug 9/11/2007
case <<f,n> : NPForm * Number> of {
<NPCase c,_> => c ;
<NPAcc,Sg> => Gen ;-- appCompl does the job
<NPAcc,Pl> => Nom
} ;
n2nform : NForm -> NForm = \nf -> case nf of {
NPossNom n => NCase n Nom ; ----
NPossGen n => NCase n Gen ;
NPossTransl n => NCase n Transl ;
NPossIllat n => NCase n Illat ;
_ => nf
} ;
--2 For $Verb$
-- A special form is needed for the negated plural imperative.
param
VForm =
Inf InfForm
| Presn Number Person
| Impf Number Person --# notpresent
| Condit Number Person --# notpresent
| Imper Number
| ImperP3 Number
| ImperP1Pl
| ImpNegPl
| Pass Bool
| PastPartAct AForm
| PastPartPass AForm
;
InfForm =
Inf1
| Inf3Iness -- 5 forms acc. to Karlsson
| Inf3Elat
| Inf3Illat
| Inf3Adess
| Inf3Abess
;
SType = SDecl | SQuest ;
--2 For $Relative$
RAgr = RNoAg | RAg {n : Number ; p : Person} ;
--2 For $Numeral$
CardOrd = NCard NForm | NOrd NForm ;
--2 Transformations between parameter types
oper
agrP3 : Number -> Agr = \n ->
{n = n ; p = P3} ;
conjAgr : Agr -> Agr -> Agr = \a,b -> {
n = conjNumber a.n b.n ;
p = conjPerson a.p b.p
} ;
---
Compl : Type = {s : Str ; c : NPForm ; isPre : Bool} ;
appCompl : Bool -> Polarity -> Compl -> NP -> Str = \isFin,b,co,np ->
let
c = case <isFin, b, co.c, np.isPron,np.a.n> of {
<_, Neg, NPAcc,_,_> => NPCase Part ; -- en näe taloa/sinua
<_, Pos, NPAcc,True,_> => NPAcc ; -- näen/täytyy sinut
<True, Pos, NPAcc,False,Sg> => NPCase Gen ; -- näen talon
<False,Pos, NPAcc,_,_> => NPCase Nom ; -- täytyy talo/sinut; näen talot
<_,_,coc,_,_> => coc
} ;
nps = np.s ! c
in
preOrPost co.isPre co.s nps ;
-- For $Verb$.
Verb : Type = {
s : VForm => Str
} ;
param
VIForm =
VIFin Tense
| VIInf InfForm
| VIPass
| VIImper
;
oper
VP = {
s : VIForm => Anteriority => Polarity => Agr => {fin, inf : Str} ;
s2 : Bool => Polarity => Agr => Str ; -- talo/talon/taloa
ext : Str ;
sc : NPForm
} ;
predV : (Verb ** {sc : NPForm}) -> VP = \verb -> {
s = \\vi,ant,b,agr =>
let
verbs = verb.s ;
part : Str = case vi of {
VIPass => verbs ! PastPartPass (AN (NCase agr.n Nom)) ;
_ => verbs ! PastPartAct (AN (NCase agr.n Nom))
} ;
eiv : Str = case agr of {
{n = Sg ; p = P1} => "en" ;
{n = Sg ; p = P2} => "et" ;
{n = Sg ; p = P3} => "ei" ;
{n = Pl ; p = P1} => "emme" ;
{n = Pl ; p = P2} => "ette" ;
{n = Pl ; p = P3} => "eivät"
} ;
einegole : Str * Str * Str = case <vi,agr.n> of {
<VIFin Pres,_> => <eiv, verbs ! Imper Sg, "ole"> ;
<VIFin Fut,_> => <eiv, verbs ! Imper Sg, "ole"> ; --# notpresent
<VIFin Cond, _> => <eiv, verbs ! Condit Sg P3, "olisi"> ; --# notpresent
<VIFin Past, Sg> => <eiv, part, "ollut"> ; --# notpresent
<VIFin Past, Pl> => <eiv, part, "olleet"> ; --# notpresent
<VIImper, Sg> => <"älä", verbs ! Imper Sg, "ole"> ;
<VIImper, Pl> => <"älkää", verbs ! ImpNegPl, "olko"> ;
<VIPass, _> => <"ei", verbs ! Pass False, "ole"> ;
<VIInf i, _> => <"ei", verbs ! Inf i, "olla"> ----
} ;
ei : Str = einegole.p1 ;
neg : Str = einegole.p2 ;
ole : Str = einegole.p3 ;
olla : VForm => Str = verbOlla.s ;
vf : Str -> Str -> {fin, inf : Str} = \x,y ->
{fin = x ; inf = y} ;
mkvf : VForm -> {fin, inf : Str} = \p -> case <ant,b> of {
<Simul,Pos> => vf (verbs ! p) [] ;
<Anter,Pos> => vf (olla ! p) part ; --# notpresent
<Anter,Neg> => vf ei (ole ++ part) ; --# notpresent
<Simul,Neg> => vf ei neg
}
in
case vi of {
VIFin Past => mkvf (Impf agr.n agr.p) ; --# notpresent
VIFin Cond => mkvf (Condit agr.n agr.p) ; --# notpresent
VIFin Fut => mkvf (Presn agr.n agr.p) ; --# notpresent
VIFin Pres => mkvf (Presn agr.n agr.p) ;
VIImper => mkvf (Imper agr.n) ;
VIPass => mkvf (Pass True) ;
VIInf i => mkvf (Inf i)
} ;
s2 = \\_,_,_ => [] ;
ext = [] ;
sc = verb.sc
} ;
insertObj : (Bool => Polarity => Agr => Str) -> VP -> VP = \obj,vp -> {
s = vp.s ;
s2 = \\fin,b,a => vp.s2 ! fin ! b ! a ++ obj ! fin ! b ! a ;
ext = vp.ext ;
sc = vp.sc
} ;
insertExtrapos : Str -> VP -> VP = \obj,vp -> {
s = vp.s ;
s2 = vp.s2 ;
ext = vp.ext ++ obj ;
sc = vp.sc
} ;
-- For $Sentence$.
Clause : Type = {
s : Tense => Anteriority => Polarity => SType => Str
} ;
mkClause : (Polarity -> Str) -> Agr -> VP -> Clause =
\sub,agr,vp -> {
s = \\t,a,b,o =>
let
subj = sub b ;
agrfin = case vp.sc of {
NPCase Nom => <agr,True> ;
_ => <agrP3 Sg,False> -- minun täytyy, minulla on
} ;
verb = vp.s ! VIFin t ! a ! b ! agrfin.p1 ;
compl = vp.s2 ! agrfin.p2 ! b ! agr ++ vp.ext
in
case o of {
SDecl => subj ++ verb.fin ++ verb.inf ++ compl ;
SQuest => questPart verb.fin ++ subj ++ verb.inf ++ compl
}
} ;
-- This is used for subjects of passives: therefore isFin in False.
subjForm : NP -> NPForm -> Polarity -> Str = \np,sc,b ->
appCompl False b {s = [] ; c = sc ; isPre = True} np ;
questPart : Str -> Str = \on -> on ++ BIND ++ "ko" ; ----
infVP : NPForm -> Polarity -> Agr -> VP -> Str =
\sc,pol,agr,vp ->
let
fin = case sc of { -- subject case
NPCase Nom => True ; -- minä tahdon nähdä auton
_ => False -- minun täytyy nähdä auto
} ;
verb = vp.s ! VIInf Inf1 ! Simul ! Pos ! agr ; -- no "ei"
compl = vp.s2 ! fin ! pol ! agr ++ vp.ext -- but compl. case propagated
in
verb.fin ++ verb.inf ++ compl ;
-- The definitions below were moved here from $MorphoFin$ so that we the
-- auxiliary of predication can be defined.
verbOlla : Verb =
let olla = mkVerb
"olla" "on" "olen" "ovat" "olkaa" "ollaan"
"oli" "olin" "olisi" "ollut" "oltu" "ollun" ;
in {s = table {
Inf Inf3Iness => "olemassa" ;
Inf Inf3Elat => "olemasta" ;
Inf Inf3Illat => "olemaan" ;
Inf Inf3Adess => "olemalla" ;
Inf Inf3Abess => "olematta" ;
v => olla.s ! v
}
} ;
--3 Verbs
--
-- The present, past, conditional. and infinitive stems, acc. to Koskenniemi.
-- Unfortunately not enough (without complicated processes).
-- We moreover give grade alternation forms as arguments, since it does not
-- happen automatically.
--- A problem remains with the verb "seistä", where the infinitive
--- stem has vowel harmony "ä" but the others "a", thus "seisoivat" but "seiskää".
mkVerb : (_,_,_,_,_,_,_,_,_,_,_,_ : Str) -> Verb =
\tulla,tulee,tulen,tulevat,tulkaa,tullaan,tuli,tulin,tulisi,tullut,tultu,tullun ->
v2v (mkVerbH
tulla tulee tulen tulevat tulkaa tullaan tuli tulin tulisi tullut tultu tullun
) ;
v2v : VerbH -> Verb = \vh ->
let
tulla = vh.tulla ;
tulee = vh.tulee ;
tulen = vh.tulen ;
tulevat = vh.tulevat ;
tulkaa = vh.tulkaa ;
tullaan = vh.tullaan ;
tuli = vh.tuli ;
tulin = vh.tulin ;
tulisi = vh.tulisi ;
tullut = vh.tullut ;
tultu = vh.tultu ;
tultu = vh.tultu ;
tullun = vh.tullun ;
tuje = init tulen ;
tuji = init tulin ;
a = Predef.dp 1 tulkaa ;
tulko = Predef.tk 2 tulkaa + (ifTok Str a "a" "o" "ö") ;
o = last tulko ;
tulleena = Predef.tk 2 tullut + ("een" + a) ;
tulleen = (noun2adj (nhn (sRae tullut tulleena))).s ;
tullun = (noun2adj (nhn (sKukko tultu tullun (tultu + ("j"+a))))).s ;
tulema = Predef.tk 3 tulevat + "m" + a ;
---- tulema = tuje + "m" + a ;
vat = "v" + a + "t"
in
{s = table {
Inf Inf1 => tulla ;
Presn Sg P1 => tuje + "n" ;
Presn Sg P2 => tuje + "t" ;
Presn Sg P3 => tulee ;
Presn Pl P1 => tuje + "mme" ;
Presn Pl P2 => tuje + "tte" ;
Presn Pl P3 => tulevat ;
Impf Sg P1 => tuji + "n" ; --# notpresent
Impf Sg P2 => tuji + "t" ; --# notpresent
Impf Sg P3 => tuli ; --# notpresent
Impf Pl P1 => tuji + "mme" ; --# notpresent
Impf Pl P2 => tuji + "tte" ; --# notpresent
Impf Pl P3 => tuli + vat ; --# notpresent
Condit Sg P1 => tulisi + "n" ; --# notpresent
Condit Sg P2 => tulisi + "t" ; --# notpresent
Condit Sg P3 => tulisi ; --# notpresent
Condit Pl P1 => tulisi + "mme" ; --# notpresent
Condit Pl P2 => tulisi + "tte" ; --# notpresent
Condit Pl P3 => tulisi + vat ; --# notpresent
Imper Sg => tuje ;
Imper Pl => tulkaa ;
ImperP3 Sg => tulko + o + "n" ;
ImperP3 Pl => tulko + o + "t" ;
ImperP1Pl => tulkaa + "mme" ;
ImpNegPl => tulko ;
Pass True => tullaan ;
Pass False => Predef.tk 2 tullaan ;
PastPartAct n => tulleen ! n ;
PastPartPass n => tullun ! n ;
Inf Inf3Iness => tulema + "ss" + a ;
Inf Inf3Elat => tulema + "st" + a ;
Inf Inf3Illat => tulema + a + "n" ;
Inf Inf3Adess => tulema + "ll" + a ;
Inf Inf3Abess => tulema + "tt" + a
}
} ;
VerbH : Type = {
tulla,tulee,tulen,tulevat,tulkaa,tullaan,tuli,tulin,tulisi,tullut,tultu,tullun
: Str
} ;
mkVerbH : (_,_,_,_,_,_,_,_,_,_,_,_ : Str) -> VerbH =
\tulla,tulee,tulen,tulevat,tulkaa,tullaan,tuli,tulin,tulisi,tullut,tultu,tullun ->
{tulla = tulla ;
tulee = tulee ;
tulen = tulen ;
tulevat = tulevat ;
tulkaa = tulkaa ;
tullaan = tullaan ;
tuli = tuli ;
tulin = tulin ;
tulisi = tulisi ;
tullut = tullut ;
tultu = tultu ;
tullun = tullun
} ;
noun2adj : CommonNoun -> Adj = noun2adjComp True ;
noun2adjComp : Bool -> CommonNoun -> Adj = \isPos,tuore ->
let
tuoreesti = Predef.tk 1 (tuore.s ! NCase Sg Gen) + "sti" ;
tuoreemmin = Predef.tk 2 (tuore.s ! NCase Sg Gen) + "in"
in {s = table {
AN f => tuore.s ! f ;
AAdv => if_then_Str isPos tuoreesti tuoreemmin
}
} ;
CommonNoun = {s : NForm => Str} ;
-- To form an adjective, it is usually enough to give a noun declension: the
-- adverbial form is regular.
Adj : Type = {s : AForm => Str} ;
NounH : Type = {
a,vesi,vede,vete,vetta,veteen,vetii,vesii,vesien,vesia,vesiin : Str
} ;
-- worst-case macro
mkSubst : Str -> (_,_,_,_,_,_,_,_,_,_ : Str) -> NounH =
\a,vesi,vede,vete,vetta,veteen,vetii,vesii,vesien,vesia,vesiin ->
{a = a ;
vesi = vesi ;
vede = vede ;
vete = vete ;
vetta = vetta ;
veteen = veteen ;
vetii = vetii ;
vesii = vesii ;
vesien = vesien ;
vesia = vesia ;
vesiin = vesiin
} ;
nhn : NounH -> CommonNoun = \nh ->
let
a = nh.a ;
vesi = nh.vesi ;
vede = nh.vede ;
vete = nh.vete ;
vetta = nh.vetta ;
veteen = nh.veteen ;
vetii = nh.vetii ;
vesii = nh.vesii ;
vesien = nh.vesien ;
vesia = nh.vesia ;
vesiin = nh.vesiin
in
{s = table {
NCase Sg Nom => vesi ;
NCase Sg Gen => vede + "n" ;
NCase Sg Part => vetta ;
NCase Sg Transl => vede + "ksi" ;
NCase Sg Ess => vete + ("n" + a) ;
NCase Sg Iness => vede + ("ss" + a) ;
NCase Sg Elat => vede + ("st" + a) ;
NCase Sg Illat => veteen ;
NCase Sg Adess => vede + ("ll" + a) ;
NCase Sg Ablat => vede + ("lt" + a) ;
NCase Sg Allat => vede + "lle" ;
NCase Sg Abess => vede + ("tt" + a) ;
NCase Pl Nom => vede + "t" ;
NCase Pl Gen => vesien ;
NCase Pl Part => vesia ;
NCase Pl Transl => vesii + "ksi" ;
NCase Pl Ess => vetii + ("n" + a) ;
NCase Pl Iness => vesii + ("ss" + a) ;
NCase Pl Elat => vesii + ("st" + a) ;
NCase Pl Illat => vesiin ;
NCase Pl Adess => vesii + ("ll" + a) ;
NCase Pl Ablat => vesii + ("lt" + a) ;
NCase Pl Allat => vesii + "lle" ;
NCase Pl Abess => vesii + ("tt" + a) ;
NComit => vetii + "ne" ;
NInstruct => vesii + "n" ;
NPossNom _ => vete ;
NPossGen Sg => vete ;
NPossGen Pl => Predef.tk 1 vesien ;
NPossTransl Sg => vede + "kse" ;
NPossTransl Pl => vesii + "kse" ;
NPossIllat Sg => Predef.tk 1 veteen ;
NPossIllat Pl => Predef.tk 1 vesiin
}
} ;
-- Surpraisingly, making the test for the partitive, this not only covers
-- "rae", "perhe", "savuke", but also "rengas", "lyhyt" (except $Sg Illat$), etc.
sRae : (_,_ : Str) -> NounH = \rae,rakeena ->
let {
a = Predef.dp 1 rakeena ;
rakee = Predef.tk 2 rakeena ;
rakei = Predef.tk 1 rakee + "i" ;
raet = rae + (ifTok Str (Predef.dp 1 rae) "e" "t" [])
}
in
mkSubst a
rae
rakee
rakee
(raet + ("t" + a))
(rakee + "seen")
rakei
rakei
(rakei + "den")
(rakei + ("t" + a))
(rakei + "siin") ;
-- Nouns with partitive "a"/"ä" ;
-- to account for grade and vowel alternation, three forms are usually enough
-- Examples: "talo", "kukko", "huippu", "koira", "kukka", "syylä",...
sKukko : (_,_,_ : Str) -> NounH = \kukko,kukon,kukkoja ->
let {
o = Predef.dp 1 kukko ;
a = Predef.dp 1 kukkoja ;
kukkoj = Predef.tk 1 kukkoja ;
i = Predef.dp 1 kukkoj ;
ifi = ifTok Str i "i" ;
kukkoi = ifi kukkoj (Predef.tk 1 kukkoj) ;
e = Predef.dp 1 kukkoi ;
kukoi = Predef.tk 2 kukon + Predef.dp 1 kukkoi
}
in
mkSubst a
kukko
(Predef.tk 1 kukon)
kukko
(kukko + a)
(kukko + o + "n")
(kukkoi + ifi "" "i")
(kukoi + ifi "" "i")
(ifTok Str e "e" (Predef.tk 1 kukkoi + "ien") (kukkoi + ifi "en" "jen"))
kukkoja
(kukkoi + ifi "in" "ihin") ;
-- Reflexive pronoun.
--- Possessive could be shared with the more general $NounFin.DetCN$.
oper
reflPron : Agr -> NP = \agr ->
let
itse = (nhn (sKukko "itse" "itsen" "itsejä")).s ;
nsa = possSuffix agr
in {
s = table {
NPCase (Nom | Gen) | NPAcc => itse ! NPossNom Sg + nsa ;
NPCase Transl => itse ! NPossTransl Sg + nsa ;
NPCase Illat => itse ! NPossIllat Sg + nsa ;
NPCase c => itse ! NCase Sg c + nsa
} ;
a = agr ;
isPron = False -- no special acc form
} ;
possSuffix : Agr -> Str = \agr ->
table Agr ["ni" ; "si" ; "nsa" ; "mme" ; "nne" ; "nsa"] ! agr ;
oper
rp2np : Number -> {s : Number => NPForm => Str ; a : RAgr} -> NP = \n,rp -> {
s = rp.s ! n ;
a = agrP3 Sg ; -- does not matter (--- at least in Slash)
isPron = False -- has no special accusative
} ;
}

View File

@@ -0,0 +1,83 @@
concrete SentenceFin of Sentence = CatFin ** open Prelude, ResFin in {
flags optimize=all_subs ;
lin
PredVP np vp = mkClause (subjForm np vp.sc) np.a vp ;
PredSCVP sc vp = mkClause (\_ -> sc.s) (agrP3 Sg) vp ;
ImpVP vp = {
s = \\pol,n =>
let
agr = {n = n ; p = P2} ;
verb = vp.s ! VIImper ! Simul ! pol ! agr ;
compl = vp.s2 ! False ! pol ! agr ++ vp.ext --- False = like inf (osta auto)
in
verb.fin ++ verb.inf ++ compl ;
} ;
-- The object case is formed at the use site of $c2$, in $Relative$ and $Question$.
SlashV2 np v2 = {
s = \\t,a,p => (mkClause (subjForm np v2.sc) np.a (predV v2)).s ! t ! a ! p ! SDecl ;
c2 = v2.c2
} ;
SlashVVV2 np vv v2 =
let
sc = case v2.sc of {
NPCase Nom => vv.sc ; -- joka minun täytyy pestä
c => c -- joka minulla täytyy olla
}
in
{s = \\t,ag,p =>
(mkClause
(subjForm np sc) np.a
(insertObj
(\\_,b,a => infVP vv.sc b a (predV v2))
(predV vv)
)
).s ! t ! ag ! p ! SDecl ;
c2 = v2.c2
} ;
AdvSlash slash adv = {
s = \\t,a,b => slash.s ! t ! a ! b ++ adv.s ;
c2 = slash.c2
} ;
SlashPrep cl prep = {
s = \\t,a,p => cl.s ! t ! a ! p ! SDecl ;
c2 = prep
} ;
SlashVS np vs slash = {
s = \\t,a,p =>
(mkClause (subjForm np vs.sc) np.a
(insertExtrapos ("että" ++ slash.s)
(predV vs))
).s ! t ! a ! p ! SDecl ;
c2 = slash.c2
} ;
EmbedS s = {s = "että" ++ s.s} ;
EmbedQS qs = {s = qs.s} ;
EmbedVP vp = {s = infVP (NPCase Nom) Pos (agrP3 Sg) vp} ; --- case,pol,agr
UseCl t a p cl = {s = t.s ++ a.s ++ p.s ++ cl.s ! t.t ! a.a ! p.p ! SDecl} ;
UseQCl t a p cl = {s = t.s ++ a.s ++ p.s ++ cl.s ! t.t ! a.a ! p.p} ;
UseRCl t a p cl = {
s = \\r => t.s ++ a.s ++ p.s ++ cl.s ! t.t ! a.a ! p.p ! r ;
c = cl.c
} ;
UseSlash t a p cl = {
s = t.s ++ a.s ++ p.s ++ cl.s ! t.t ! a.a ! p.p ;
c2 = cl.c2
} ;
AdvS a s = {s = a.s ++ s.s} ;
}

View File

@@ -0,0 +1,307 @@
concrete StructuralFin of Structural = CatFin **
open MorphoFin, ParadigmsFin, Prelude in {
flags optimize=all ;
lin
above_Prep = postGenPrep "yläpuolella" ;
after_Prep = postGenPrep "jälkeen" ;
all_Predet = {s = \\n,c =>
let
kaiket = caseTable n (nhn (sKorpi "kaikki" "kaiken" "kaikkena"))
in
case npform2case n c of {
Nom => "kaikki" ;
k => kaiket ! k
}
} ;
almost_AdA, almost_AdN = ss "melkein" ;
although_Subj = ss "vaikka" ;
always_AdV = ss "aina" ;
and_Conj = ss "ja" ** {n = Pl} ;
because_Subj = ss "koska" ;
before_Prep = prePrep partitive "ennen" ;
behind_Prep = postGenPrep "takana" ;
between_Prep = postGenPrep "välissä" ;
both7and_DConj = sd2 "sekä" "että" ** {n = Pl} ;
but_PConj = ss "mutta" ;
by8agent_Prep = postGenPrep "toimesta" ;
by8means_Prep = casePrep adessive ;
can8know_VV = reg2V "osata" "osasi" ;
can_VV = reg2V "voida" "voi" ;
during_Prep = postGenPrep "aikana" ;
either7or_DConj = sd2 "joko" "tai" ** {n = Sg} ;
everybody_NP = makeNP (regN "jokainen") Sg ;
every_Det = mkDet Sg (regN "jokainen") ;
everything_NP = makeNP ((nhn (sKorpi "kaikki" "kaiken" "kaikkena")) **
{lock_N = <>}) Sg ;
everywhere_Adv = ss "kaikkialla" ;
few_Det = mkDet Sg (regN "harva") ;
first_Ord = {s = \\n,c => (regN "ensimmäinen").s ! NCase n c} ;
for_Prep = casePrep allative ;
from_Prep = casePrep elative ;
he_Pron = mkPronoun "hän" "hänen" "häntä" "hänenä" "häneen" Sg P3 ;
here_Adv = ss "täällä" ;
here7to_Adv = ss "tänne" ;
here7from_Adv = ss "täältä" ;
how_IAdv = ss "miten" ;
how8many_IDet =
{s = \\c => "kuinka" ++ (reg2N "moni" "monia").s ! NCase Sg c ; n = Sg} ;
if_Subj = ss "jos" ;
in8front_Prep = postGenPrep "edessä" ;
i_Pron = mkPronoun "minä" "minun" "minua" "minuna" "minuun" Sg P1 ;
in_Prep = casePrep inessive ;
it_Pron = {
s = \\c => pronSe.s ! npform2case Sg c ;
a = agrP3 Sg ;
isPron = False
} ;
less_CAdv = ss "vähemmän" ;
many_Det = mkDet Sg (reg2N "moni" "monia") ;
more_CAdv = ss "enemmän" ;
most_Predet = {s = \\n,c => (nhn (sSuurin "useinta")).s ! NCase n (npform2case n c)} ;
much_Det = mkDet Sg {s = \\_ => "paljon"} ;
must_VV = subjcaseV (regV "täytyä") genitive ;
no_Phr = ss "ei" ;
on_Prep = casePrep adessive ;
one_Quant = mkDet Sg
(nhn (mkSubst "ä" "yksi" "yhde" "yhte" "yhtä" "yhteen" "yksi" "yksi"
"yksien" "yksiä" "yksiin")) ;
only_Predet = {s = \\_,_ => "vain"} ;
or_Conj = ss "tai" ** {n = Sg} ;
otherwise_PConj = ss "muuten" ;
part_Prep = casePrep partitive ;
please_Voc = ss ["ole hyvä"] ; --- number
possess_Prep = casePrep genitive ;
quite_Adv = ss "melko" ;
she_Pron = mkPronoun "hän" "hänen" "häntä" "hänenä" "häneen" Sg P3 ;
so_AdA = ss "niin" ;
somebody_NP = {
s = \\c => jokuPron ! Sg ! npform2case Sg c ;
a = agrP3 Sg ;
isPron = False
} ;
someSg_Det = {
s1 = jokuPron ! Sg ;
s2 = [] ;
isNum,isPoss = False ; isDef = True ; n = Sg
} ;
somePl_Det = {
s1 = jokuPron ! Pl ;
s2 = [] ; isNum,isPoss = False ; isDef = True ;
n = Pl
} ;
something_NP = {
s = \\c => jokinPron ! Sg ! npform2case Sg c ;
a = agrP3 Sg ;
isPron = False
} ;
somewhere_Adv = ss "jossain" ;
that_Quant = {
s1 = table (MorphoFin.Number) [
table (MorphoFin.Case) {
c => (mkPronoun "tuo" "tuon" "tuota" "tuona" "tuohon" Sg P3).s ! NPCase c
} ;
table (MorphoFin.Case) {
c => (mkPronoun "nuo" "noiden" "noita" "noina" "noihin" Sg P3).s ! NPCase c
}
] ;
s2 = [] ; isNum,isPoss = False ; isDef = True ;
} ;
that_NP =
mkDemPronoun "tuo" "tuon" "tuota" "tuona" "tuohon" Sg **
{isPron = False} ;
there_Adv = ss "siellä" ; --- tuolla
there7to_Adv = ss "sinne" ;
there7from_Adv = ss "sieltä" ;
therefore_PConj = ss "siksi" ;
these_NP =
mkDemPronoun "nämä" "näiden" "näitä" "näinä" "näihin" Pl **
{isPron = False} ;
they_Pron = mkPronoun "he" "heidän" "heitä" "heinä" "heihin" Pl P3 ; --- ne
this_Quant = {
s1 = table (MorphoFin.Number) [
table (MorphoFin.Case) {
c => (mkPronoun "tämä" "tämän" "tätä" "tänä" "tähän" Sg P3).s ! NPCase c
} ;
table (MorphoFin.Case) {
c => (mkPronoun "nämä" "näiden" "näitä" "näinä" "näihin" Sg P3).s ! NPCase c
}
] ;
s2 = [] ; isNum,isPoss = False ; isDef = True ;
} ;
this_NP =
mkDemPronoun "tämä" "tämän" "tätä" "tänä" "tähän" Sg **
{isPron = False} ;
those_NP =
mkDemPronoun "nuo" "noiden" "noita" "noina" "noihin" Pl **
{isPron = False} ;
through_Prep = postGenPrep "kautta" ;
too_AdA = ss "liian" ;
to_Prep = casePrep illative ; --- allative
under_Prep = postGenPrep "alla" ;
very_AdA = ss "erittäin" ;
want_VV = regV "tahtoa" ;
we_Pron = mkPronoun "me" "meidän" "meitä" "meinä" "meihin" Pl P1 ;
whatPl_IP = {
s = table {NPAcc => "mitkä" ; c => mikaInt ! Pl ! npform2case Pl c} ;
n = Pl
} ;
whatSg_IP = {
s = \\c => mikaInt ! Sg ! npform2case Sg c ;
n = Sg
} ;
when_IAdv = ss "milloin" ;
when_Subj = ss "kun" ;
where_IAdv = ss "missä" ;
whichPl_IDet = {
s = mikaInt ! Pl ;
n = Pl
} ;
whichSg_IDet = {
s = mikaInt ! Sg ;
n = Sg
} ;
whoSg_IP = {
s = table {NPAcc => "kenet" ; c => kukaInt ! Sg ! npform2case Sg c} ;
n = Sg
} ;
whoPl_IP = {
s = table {NPAcc => "ketkä" ; c => kukaInt ! Pl ! npform2case Pl c} ;
n = Pl
} ;
why_IAdv = ss "miksi" ;
without_Prep = prePrep partitive "ilman" ;
with_Prep = postGenPrep "kanssa" ;
yes_Phr = ss "kyllä" ;
youSg_Pron = mkPronoun "sinä" "sinun" "sinua" "sinuna" "sinuun" Sg P2 ;
youPl_Pron = mkPronoun "te" "teidän" "teitä" "teinä" "teihin" Pl P2 ;
youPol_Pron = mkPronoun "te" "teidän" "teitä" "teinä" "teihin" Pl P2 ; --- Sg
oper
jokuPron : MorphoFin.Number => (MorphoFin.Case) => Str =
let
ku = nhn (sPuu "ku") ;
kui = nhn (sPuu "kuu")
in
table {
Sg => table {
Nom => "joku" ;
Gen => "jonkun" ;
c => relPron ! Sg ! c + ku.s ! NCase Sg c
} ;
Pl => table {
Nom => "jotkut" ;
c => relPron ! Pl ! c + kui.s ! NCase Pl c
}
} ;
jokinPron : MorphoFin.Number => (MorphoFin.Case) => Str =
table {
Sg => table {
Nom => "jokin" ;
Gen => "jonkin" ;
c => relPron ! Sg ! c + "kin"
} ;
Pl => table {
Nom => "jotkin" ;
c => relPron ! Pl ! c + "kin"
}
} ;
mikaInt : MorphoFin.Number => (MorphoFin.Case) => Str =
let {
mi = nhn (sSuo "mi")
} in
table {
Sg => table {
Nom => "mikä" ;
Gen => "minkä" ;
c => mi.s ! NCase Sg c
} ;
Pl => table {
Nom => "mitkä" ;
Gen => "mittenkä" ;
c => mi.s ! NCase Sg c
}
} ;
kukaInt : MorphoFin.Number => (MorphoFin.Case) => Str =
let {
ku = nhn (sRae "kuka" "kenenä") ;
ket = nhn (sRae "kuka" "keinä")} in
table {
Sg => table {
Nom => "kuka" ;
Part => "ketä" ;
Illat => "keneen" ;
c => ku.s ! NCase Sg c
} ;
Pl => table {
Nom => "ketkä" ;
Illat => "keihin" ;
c => ket.s ! NCase Pl c
}
} ;
mikaanPron : MorphoFin.Number => (MorphoFin.Case) => Str = \\n,c =>
case <n,c> of {
<Sg,Nom> => "mikään" ;
<_,Part> => "mitään" ;
<Sg,Gen> => "minkään" ;
<Pl,Nom> => "mitkään" ;
<Pl,Gen> => "mittenkään" ;
<_,Ess> => "minään" ;
<_,Iness> => "missään" ;
<_,Elat> => "mistään" ;
<_,Adess> => "millään" ;
<_,Ablat> => "miltään" ;
_ => mikaInt ! n ! c + "kään"
} ;
kukaanPron : MorphoFin.Number => (MorphoFin.Case) => Str =
table {
Sg => table {
Nom => "kukaan" ;
Part => "ketään" ;
Ess => "kenään" ;
Iness => "kessään" ;
Elat => "kestään" ;
Illat => "kehenkään" ;
Adess => "kellään" ;
Ablat => "keltään" ;
c => kukaInt ! Sg ! c + "kään"
} ;
Pl => table {
Nom => "ketkään" ;
Part => "keitään" ;
Ess => "keinään" ;
Iness => "keissään" ;
Elat => "keistään" ;
Adess => "keillään" ;
Ablat => "keiltään" ;
c => kukaInt ! Pl ! c + "kään"
}
} ;
pronSe : ProperName = {
s = table {
Nom => "se" ;
Gen => "sen" ;
Part => "sitä" ;
Transl => "siksi" ;
Ess => "sinä" ;
Iness => "siinä" ;
Elat => "siitä" ;
Illat => "siihen" ;
Adess => "sillä" ;
Ablat => "siltä" ;
Allat => "sille" ;
Abess => "sittä"
} ;
} ;
}

View File

@@ -0,0 +1,92 @@
--1 Verb Phrases in Finnish
concrete VerbFin of Verb = CatFin ** open Prelude, ResFin in {
flags optimize=all_subs ;
lin
UseV = predV ;
ComplV2 v np = insertObj (\\fin,b,_ => appCompl fin b v.c2 np) (predV v) ;
ComplV3 v np np2 =
insertObj
(\\fin,b,_ => appCompl fin b v.c2 np ++ appCompl fin b v.c3 np2) (predV v) ;
ComplVV v vp =
insertObj
(\\_,b,a => infVP v.sc b a vp)
(predV {s = v.s ;
sc = case vp.sc of {
NPCase Nom => v.sc ; -- minun täytyy pestä auto
c => c -- minulla täytyy olla auto
}
}
) ;
ComplVS v s = insertExtrapos ("että" ++ s.s) (predV v) ;
ComplVQ v q = insertExtrapos ( q.s) (predV v) ;
ComplVA v ap =
insertObj
(\\_,b,agr =>
ap.s ! False ! AN (NCase agr.n (npform2case agr.n v.c2.c))) --- v.cs.s ignored
(predV v) ;
ComplV2A v np ap =
insertObj
(\\fin,b,_ => appCompl fin b v.c2 np ++
ap.s ! False ! AN (NCase np.a.n (npform2case np.a.n v.c3.c))) --agr to obj
(predV v) ;
UseComp comp =
insertObj (\\_,_ => comp.s) (predV (verbOlla ** {sc = NPCase Nom})) ;
AdvVP vp adv = insertObj (\\_,_,_ => adv.s) vp ;
AdVVP adv vp = insertObj (\\_,_,_ => adv.s) vp ;
ReflV2 v = insertObj (\\fin,b,agr => appCompl fin b v.c2 (reflPron agr)) (predV v) ;
PassV2 v = let vp = predV v in {
s = \\_ => vp.s ! VIPass ;
s2 = \\_,_,_ => [] ;
ext = [] ;
sc = v.c2.c -- minut valitaan ; minua rakastetaan ; minulle kuiskataan
} ; ---- talon valitaan: should be marked like inf.
UseVS, UseVQ = \v -> v ** {c2 = {s = [] ; c = NPAcc ; isPre = True}} ;
CompAP ap = {
s = \\agr =>
let
n = agr.n ;
c = case agr.n of {
Sg => Nom ; -- minä olen iso
Pl => Part -- me olemme isoja
} --- definiteness of NP ?
in ap.s ! False ! AN (NCase agr.n c)
} ;
CompNP np = {s = \\_ => np.s ! NPCase Nom} ;
CompAdv a = {s = \\_ => a.s} ;
}
--2 The object case
--
-- The rules involved are ComplV2 and ComplVV above.
-- The work is done jointly in ResFin.infVP and appCompl.
-- Cases to test: l -table (to see negated forms)
--```
-- minun täytyy ostaa auto
-- PredVP (UsePron i_Pron) (ComplVV must_VV
-- (ComplV2 buy_V2 (DetCN (DetSg (SgQuant DefArt) NoOrd) (UseN car_N))))
-- minä tahdon ostaa auton
-- PredVP (UsePron i_Pron) (ComplVV want_VV
-- (ComplV2 buy_V2 (DetCN (DetSg (SgQuant DefArt) NoOrd) (UseN car_N))))
-- minulla täytyy olla auto
-- PredVP (UsePron i_Pron) (ComplVV must_VV
-- (ComplV2 have_V2 (DetCN (DetSg (SgQuant DefArt) NoOrd) (UseN car_N))))
--```
-- Unfortunately, there is no nice way to say "I want to have a car".
-- (Other than the paraphrases "I want a car" or "I want to own a car".)