1
0
forked from GitHub/gf-core

started Finnish (Param, Morpho, Cat, Param appr. OK)

This commit is contained in:
aarne
2006-02-03 20:07:41 +00:00
parent 07b34ff780
commit 827f9ab643
18 changed files with 3123 additions and 0 deletions

View File

@@ -0,0 +1,38 @@
concrete AdjectiveFin of Adjective = CatFin ** open ResFin, Prelude in {
lin
PositA a = {
s = \\_ => a.s ! AAdj Posit ;
isPre = True
} ;
ComparA a np = {
s = \\_ => a.s ! AAdj Compar ++ "than" ++ np.s ! Nom ;
isPre = False
} ;
-- $SuperlA$ belongs to determiner syntax in $Noun$.
ComplA2 a np = {
s = \\_ => a.s ! AAdj Posit ++ a.c2 ++ np.s ! Acc ;
isPre = False
} ;
ReflA2 a = {
s = \\ag => a.s ! AAdj Posit ++ a.c2 ++ reflPron ! ag ;
isPre = False
} ;
SentAP ap sc = {
s = \\a => ap.s ! a ++ sc.s ;
isPre = False
} ;
AdAP ada ap = {
s = \\a => ada.s ++ ap.s ! a ;
isPre = ap.isPre
} ;
UseA2 a = a ;
}

View File

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

View File

@@ -0,0 +1,91 @@
concrete CatFin of Cat = TenseX ** open ResFin, Prelude in {
flags optimize=all_subs ;
lincat
-- Phrase
Text, Phr, Utt, Voc = {s : Str} ;
-- Tensed/Untensed
S = {s : Str} ;
QS = {s : Str} ;
RS = {s : Agr => Str} ;
-- Sentence
Cl = {s : Tense => Anteriority => Polarity => SType => Str} ;
Slash = {s : Tense => Anteriority => Polarity => Str ; c2 : Compl} ;
Imp = {s : Polarity => Number => Str} ;
-- Question
QCl = {s : Tense => Anteriority => Polarity => Str} ;
IP = {s : NPForm => Str ; n : Number} ;
IAdv = {s : Str} ;
IDet = {s : Case => Str ; n : Number} ;
-- Relative
RCl = {s : Tense => Anteriority => Polarity => Agr => Str} ;
RP = {s : Number => Case => Str ; a : RAgr} ;
-- Verb
VP = {
s : Tense => Anteriority => Polarity => Agr => {fin, inf : Str} ;
s2 : Agr => Str
} ;
Comp = {s : Agr => Str} ;
SC = {s : Str} ;
-- Adjective
AP = {s : Bool => AForm => Str} ;
-- Noun
CN = {s : Bool => Number => Case => Str} ;
Pron = {s : NPForm => Str ; a : Agr} ;
NP = {s : NPForm => Str ; a : Agr} ;
Det = {s : Case => Str ; n : Number ; isNum : Bool} ;
QuantSg, QuantPl = {s : Case => Str} ;
Predet, Quant, Ord = {s : Number => Case => Str} ;
Num = {s : Number => Case => Str ; isNum : Bool} ;
-- Adverb
Adv, AdV, AdA, AdS, AdN = {s : Str} ;
-- Numeral
Numeral = {s : CardOrd => Str ; n : Number} ;
-- Structural
Conj = {s : Str ; n : Number} ;
DConj = {s1,s2 : Str ; n : Number} ;
PConj = {s : Str} ;
CAdv = {s : Str} ;
Subj = {s : Str} ;
Prep = {s : Str} ;
-- Open lexical classes, e.g. Lexicon
V, VS, VQ, VA = Verb1 ; -- = {s : VForm => Str ; sc : Case} ;
V2, VV, V2A = Verb1 ** {c2 : Compl ; } ;
V3 = Verb1 ** {c2, c3 : Compl} ;
A = {s : Degree => AForm => Str} ;
A2 = {s : Degree => AForm => Str ; c2 : Str} ;
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,45 @@
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 Case conj ss ** {
a = {n = conjNumber conj.n ss.a.n ; p = ss.a.p}
} ;
DConjNP conj ss = conjunctDistrTable Case conj ss ** {
a = {n = conjNumber conj.n ss.a.n ; p = ss.a.p}
} ;
ConjAP conj ss = conjunctTable Agr conj ss ** {
isPre = ss.isPre
} ;
DConjAP conj ss = conjunctDistrTable Agr conj ss ** {
isPre = ss.isPre
} ;
-- These fun's are generated from the list cat's.
BaseS = twoSS ;
ConsS = consrSS comma ;
BaseAdv = twoSS ;
ConsAdv = consrSS comma ;
BaseNP x y = twoTable Case x y ** {a = conjAgr x.a y.a} ;
ConsNP xs x = consrTable Case comma xs x ** {a = conjAgr xs.a x.a} ;
BaseAP x y = twoTable Agr x y ** {isPre = andB x.isPre y.isPre} ;
ConsAP xs x = consrTable Agr comma xs x ** {isPre = andB xs.isPre x.isPre} ;
lincat
[S] = {s1,s2 : Str} ;
[Adv] = {s1,s2 : Str} ;
[NP] = {s1,s2 : Case => Str ; a : Agr} ;
[AP] = {s1,s2 : Agr => Str ; isPre : Bool} ;
}

View File

@@ -0,0 +1,20 @@
--# -path=.:../abstract:../common:prelude
concrete LangFin of Lang =
NounFin,
VerbFin,
AdjectiveFin,
AdverbFin,
NumeralFin,
SentenceFin,
QuestionFin,
RelativeFin,
ConjunctionFin,
PhraseFin,
StructuralFin,
LexiconFin
** {
flags startcat = Phr ;
} ;

View File

@@ -0,0 +1,248 @@
--# -path=.:prelude
concrete LexiconFin of Lexicon = CatFin ** open ParadigmsFin in {
flags
optimize=values ;
lin
airplane_N = regN "lentokone" ;
---- answer_V2S = mkV2S (caseV2 (regV "vastata") allative) ;
apartment_N = regN "asunto" ;
apple_N = nLukko "omena" ; --- omenia, not omenoita
art_N = regN "taide" ;
---- ask_V2Q = mkV2Q (caseV2 (regV "kysyä") 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") translative ;
beer_N = regN "olut" ;
---- beg_V2V = mkV2V (caseV2 (reg2V "pyytää" "pyysi") 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 = regADeg "puhdas" ;
clever_A = regADeg "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") elative illative ;
doctor_N = reg2N "tohtori" "tohtoreita" ;
dog_N = nLukko "koira" ;
door_N = nArpi "ovi" ;
drink_V2 = dirV2 (regV "juoda") ;
---- easy_A2V = mkA2V (mkA2 (mkA (nLukko "helppo")) (caseP 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 = dirV2 (regV "vihata") ;
hat_N = nLukko "hattu" ;
have_V2 = caseV2 (caseV adessive vOlla) nominative ;
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 (mkV "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")) (postpP 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 (dirV2 (regV "maalata")) translative ;
paper_N = reg2N "paperi" "papereita" ;
peace_N = nLukko "rauha" ;
pen_N = nLukko "kynä" ;
planet_N = nLukko "planeetta" ;
plastic_N = regN "muovi" ;
play_V2 = dirV2 (regV "pelata") ; --- 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_V = mkV0 (reg2V "sataa" "satoi") ;
read_V2 = dirV2 (regV "lukea") ;
red_A = regADeg "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 = dirV2 (regV "etsiä") ;
see_V2 = dirV2 (
mkV "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 = regADeg "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 = dirV2 (regV "puhua") ;
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 = regADeg "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") (caseP allative) (caseP elative) ;
teacher_N = nLukko "opettaja" ;
teach_V2 = dirV2 (regV "opettaa") ;
television_N = reg2N "televisio" "televisioita" ;
thick_A = regADeg "paksu" ;
thin_A = regADeg "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 = dirV2 (regV "katsella") ;
water_N = reg3N "vesi" "veden" "vesiä" ;
white_A = regADeg "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 = regADeg "keltainen" ;
young_A = mkADeg (nArpi "nuori") "nuorempi" "nuorin" ;
do_V2 = dirV2 (
mkV "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ä" ;
{-
here_Adv = mkAdv "täällä" ;
here7to_Adv = mkAdv "tänne" ;
here7from_Adv = mkAdv "täältä" ;
there_Adv = mkAdv "siellä" ; --- tuolla
there7to_Adv = mkAdv "sinne" ;
there7from_Adv = mkAdv "sieltä" ;
-}
} ;

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,71 @@
concrete NounFin of Noun = CatFin ** open ResFin, Prelude in {
flags optimize=all_subs ;
lin
DetCN det cn = {
s = \\c => det.s ++ cn.s ! det.n ! c ;
a = agrP3 det.n
} ;
UsePN pn = pn ** {a = agrP3 Sg} ;
UsePron p = p ;
PredetNP pred np = {
s = \\c => pred.s ++ np.s ! c ;
a = np.a
} ;
DetSg quant ord = {
s = quant.s ++ ord.s ;
n = Sg
} ;
DetPl quant num ord = {
s = quant.s ++ num.s ++ ord.s ;
n = Pl
} ;
SgQuant quant = {s = quant.s ! Sg} ;
PlQuant quant = {s = quant.s ! Pl} ;
PossPron p = {s = \\_ => p.s ! Gen} ;
NoNum, NoOrd = {s = []} ;
NumInt n = n ;
OrdInt n = {s = n.s ++ "th"} ; ---
NumNumeral numeral = {s = numeral.s ! NCard} ;
OrdNumeral numeral = {s = numeral.s ! NOrd} ;
AdNum adn num = {s = adn.s ++ num.s} ;
OrdSuperl a = {s = a.s ! AAdj Superl} ;
DefArt = {s = \\_ => artDef} ;
IndefArt = {
s = table {
Sg => artIndef ;
Pl => []
}
} ;
MassDet = {s = [] ; n = Sg} ;
UseN n = n ;
UseN2 n = n ;
UseN3 n = n ;
ComplN2 f x = {s = \\n,c => f.s ! n ! Nom ++ f.c2 ++ x.s ! c} ;
ComplN3 f x = {s = \\n,c => f.s ! n ! Nom ++ f.c2 ++ x.s ! c ; c2 = f.c3} ;
AdjCN ap cn = {
s = \\n,c => preOrPost ap.isPre (ap.s ! agrP3 n) (cn.s ! n ! c)
} ;
RelCN cn rs = {s = \\n,c => cn.s ! n ! c ++ rs.s ! {n = n ; p = P3}} ;
AdvCN cn ad = {s = \\n,c => cn.s ! n ! c ++ ad.s} ;
SentCN cn sc = {s = \\n,c => cn.s ! n ! c ++ sc.s} ;
}

View File

@@ -0,0 +1,44 @@
concrete NumeralFin of Numeral = CatFin ** open ResFin in {
lincat
Digit = {s : DForm => CardOrd => Str} ;
Sub10 = {s : DForm => CardOrd => Str ; n : Number} ;
Sub100 = {s : CardOrd => Str ; n : Number} ;
Sub1000 = {s : CardOrd => Str ; n : Number} ;
Sub1000000 = {s : CardOrd => Str ; n : Number} ;
lin num x = x ;
lin n2 = let two = mkNum "two" "twelve" "twenty" "second" in
{s = \\f,c => case <f,c> of {
<teen,NOrd> => "twelfth" ;
_ => two.s ! f ! c
}
} ;
lin n3 = mkNum "three" "thirteen" "thirty" "third" ;
lin n4 = mkNum "four" "fourteen" "forty" "fourth" ;
lin n5 = mkNum "five" "fifteen" "fifty" "fifth" ;
lin n6 = regNum "six" ;
lin n7 = regNum "seven" ;
lin n8 = mkNum "eight" "eighteen" "eighty" "eighth" ;
lin n9 = regNum "nine" ;
lin pot01 = mkNum "one" "eleven" "ten" "first" ** {n = Sg} ;
lin pot0 d = d ** {n = Pl} ;
lin pot110 = regCardOrd "ten" ** {n = Pl} ;
lin pot111 = regCardOrd "eleven" ** {n = Pl} ;
lin pot1to19 d = {s = d.s ! teen} ** {n = Pl} ;
lin pot0as1 n = {s = n.s ! unit} ** {n = n.n} ;
lin pot1 d = {s = d.s ! ten} ** {n = Pl} ;
lin pot1plus d e = {
s = \\c => d.s ! ten ! NCard ++ "-" ++ e.s ! unit ! c ; n = Pl} ;
lin pot1as2 n = n ;
lin pot2 d = {s = \\c => d.s ! unit ! NCard ++ mkCard c "hundred"} ** {n = Pl} ;
lin pot2plus d e = {
s = \\c => d.s ! unit ! NCard ++ "hundred" ++ "and" ++ e.s ! c ; n = Pl} ;
lin pot2as3 n = n ;
lin pot3 n = {
s = \\c => n.s ! NCard ++ mkCard c "thousand" ; n = Pl} ;
lin pot3plus n m = {
s = \\c => n.s ! NCard ++ "thousand" ++ m.s ! c ; n = Pl} ;
}

View File

@@ -0,0 +1,573 @@
--# -path=.:../abstract:../../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: we have a
-- separate module $IrregularFin$, which covers all irregularly inflected
-- words.
--
-- The following modules are presupposed:
resource ParadigmsFin = open
(Predef=Predef),
Prelude,
MorphoFin,
CatFin
in {
-- flags optimize=values ;
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 their definitions
-- in $TypesInf$.
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.
PPosition : Type ;
prepP : Case -> Str -> PPosition ;
postpP : Case -> Str -> PPosition ;
caseP : Case -> PPosition ;
accusative : PPosition ;
--2 Nouns
-- The worst case gives ten forms and the semantic gender.
-- In practice just a couple of forms are needed, to define the different
-- stems, vowel alternation, and vowel harmony.
oper
mkN : (talo, talon, talona, taloa, taloon,
taloina,taloissa,talojen,taloja,taloihin : Str) -> N ;
-- 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").
regN : (talo : Str) -> N ;
-- If $regN$ does not give the correct result, one can try and give
-- two or three forms as follows. Examples of the use of these
-- functions are given in $BasicFin$. Most notably, $reg2N$ is used
-- for nouns like "kivi - kiviä", which would otherwise become like
-- "rivi - rivejä". $regN3$ is used e.g. for
-- "sydän - sydämen - sydämiä", which would otherwise become
-- "sydän - sytämen".
reg2N : (savi,savia : Str) -> N ;
reg3N : (vesi,veden,vesiä : 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 ;
-- For convenience, we define 1-argument paradigms as producing the
-- nonhuman gender; the following function changes this:
humanN : N -> N ;
-- A special case are nouns with no alternations:
-- the vowel harmony is inferred from the last letter,
-- which must be one of "o", "u", "ö", "y".
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.
nComp : Str -> N -> N ;
-- Nouns used as functions need a case, of which by far the commonest is
-- the genitive.
mkN2 : N -> Case -> N2 ;
genN2 : N -> N2 ;
mkN3 : N -> Case -> Case -> N3 ;
-- Proper names can be formed by using declensions for nouns.
-- The plural forms are filtered away by the compiler.
mkPN : N -> PN ;
--2 Adjectives
-- Non-comparison one-place adjectives are just like nouns.
mkA : N -> A ;
-- Two-place adjectives need a case for the second argument.
mkA2 : A -> PPosition -> A2 ;
-- 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ä").
mkADeg : (kiva : N) -> (kivempaa,kivinta : Str) -> A ;
-- The regular adjectives are based on $regN$ in the positive.
regADeg : (punainen : Str) -> A ;
--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.
mkV : (tulla,tulee,tulen,tulevat,tulkaa,tullaan,
tuli,tulin,tulisi,tullut,tultu,tullun : Str) -> V ;
-- The following heuristics cover more and more verbs.
regV : (soutaa : Str) -> V ;
reg2V : (soutaa,souti : Str) -> V ;
reg3V : (soutaa,soudan,souti : Str) -> 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" and the negative auxiliary are special.
vOlla : V ;
vEi : V ;
-- Two-place verbs need a case, and can have a pre- or postposition.
mkV2 : V -> PPosition -> V2 ;
-- If the complement needs just a case, the following special function can be used.
caseV2 : V -> Case -> V2 ;
-- Verbs with a direct (accusative) object
-- are special, since their complement case is finally decided in syntax.
-- But this is taken care of by $ClauseFin$.
dirV2 : V -> V2 ;
--3 Three-place verbs
--
-- Three-place (ditransitive) verbs need two prepositions, of which
-- the first one or both can be absent.
mkV3 : V -> PPosition -> PPosition -> V3 ; -- speak, with, about
dirV3 : V -> Case -> V3 ; -- give,_,to
dirdirV3 : V -> V3 ; -- acc, allat
--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 -> Str -> V2S ;
mkVV : V -> VV ;
mkV2V : V -> Str -> Str -> V2V ;
mkVA : V -> VA ;
mkV2A : V -> Str -> V2A ;
mkVQ : V -> VQ ;
mkV2Q : V -> Str -> V2Q ;
mkAS : A -> AS ;
mkA2S : A -> Str -> A2S ;
mkAV : A -> AV ;
mkA2V : A -> Str -> A2V ;
-- Notice: categories $V2S, V2V, V2A, 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, V2A, 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 ;
PPosition : Type = {c : NPForm ; s3 : Str ; p : Bool} ;
prepP : Case -> Str -> PPosition =
\c,p -> {c = NPCase c ; s3 = p ; p = True} ;
postpP : Case -> Str -> PPosition =
\c,p -> {c = NPCase c ; s3 = p ; p = False} ;
caseP : Case -> PPosition =
\c -> {c = NPCase c ; s3 = [] ; p = True} ;
accusative = {c = NPAccNom ; s3 = [] ; p = True} ;
mkN = \a,b,c,d,e,f,g,h,i,j ->
mkNoun a b c d e f g h i j ** {lock_N = <>} ;
regN = \vesi ->
---- nhn (regNounH vesi) ** {lock_N = <>} ;
let
esi = Predef.dp 3 vesi ; -- analysis: suffixes
si = Predef.dp 2 esi ;
i = last si ;
s = init si ;
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)) ;
_ => case si of {
"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)) ;
_ => case i of {
"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 ->
---- nhn (reg2NounH 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) ;
<"i","ta"> | <"i","tä"> => nhn (sTohtori (savi + a)) ;
<"o","ta"> | <"ö","tä"> => nhn (sRadio savi) ;
<"a","ta"> | <"ä","tä"> => nhn (sPeruna savi) ;
<"a","ia"> | <"a","ja"> => nhn (sKukko savi savin savia) ;
_ => savit
}
** {lock_N = <>} ;
reg3N = \vesi,veden,vesiä ->
let
vesit = reg2N vesi vesiä ;
si = Predef.dp 2 vesi ;
i = last si ;
a = last vesiä ;
s = last (Predef.tk 2 vesiä)
in
case si of {
"us" | "ys" =>
ifTok CommonNoun (Predef.dp 3 veden) "den"
(nhn (sRakkaus vesi))
(nhn (sTilaus vesi (veden + a))) ;
"as" | "äs" => nhn (sRae vesi (veden + a)) ;
"li" | "ni" | "ri" => nhn (sSusi vesi veden (Predef.tk 1 vesi + ("en" + a))) ;
"si" => nhn (sSusi vesi veden (Predef.tk 2 vesi + ("ten" + a))) ;
"in" | "en" | "än" => nhn (sLiitin vesi veden) ;
_ => case i of {
"a" | "o" | "u" | "y" | "ä" | "ö" => nhn (sKukko vesi veden vesiä) ;
"i" => nhn (sKorpi vesi veden (init veden + "n" + a)) ;
_ => vesit
}
} ** {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") ;
nComp = \s,n -> {s = \\c => s ++ n.s ! c ; g = n.g ; lock_N = <>} ;
-- mkN2 = \n,c -> n2n n ** {c = NPCase c ; lock_N2 = <>} ;
-- mkN3 = \n,c,e -> n2n n ** {c = NPCase c ; c2 = NPCase e ; lock_N3 = <>} ;
-- genN2 = \n -> mkN2 n genitive ;
mkPN n = mkProperName n ** {lock_PN = <>} ;
---- mkA = \x -> noun2adj x ** {lock_A = <>} ;
---- mkA2 = \x,c -> x ** {s3 = c.s3 ; p = c.p ; c = c.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 = <>} ;
regADeg suuri =
let suur = regN suuri in
mkADeg
suur
(init (suur.s ! NCase Sg Gen) + "mpi")
(init (suur.s ! NCase Pl Ess)) ;
mkV 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 = <>} ;
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 = <>} ;
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 = <>} ;
vEi = verbEi ** {sc = NPCase Nom ; lock_V = <>} ;
vHuoltaa : (_,_,_,_ : Str) -> Verb = \ottaa,otan,otti,otin ->
v2v (MorphoFin.vHuoltaa ottaa otan otti otin) ** {sc = NPCase Nom ; lock_V = <>} ;
---- mkV2 = \v,c -> v ** {s3 = c.s3 ; p = c.p ; c = c.c ; lock_V2 = <>} ;
---- caseV2 = \v,c -> mkV2 v (caseP c) ;
---- dirV2 v = mkTransVerbDir v ** {lock_V2 = <>} ;
mkAdv : Str -> Adv = \s -> {s = s ; lock_Adv = <>} ;
{-
mkV3 v p q = v **
{s3 = p.s3 ; p = p.p ; c = p.c ; s5 = q.s3 ; p2 = q.p ; c2 = q.c ;
lock_V3 = <>} ;
dirV3 v p = mkV3 v accusative (caseP p) ;
dirdirV3 v = dirV3 v allative ;
mkVS v = v ** {lock_VS = <>} ;
mkVV v = v ** {c2 = "to" ; lock_VV = <>} ;
mkVQ v = v ** {lock_VQ = <>} ;
V0 : Type = V ;
V2S, V2V, V2Q, V2A : Type = V2 ;
AS, A2S, AV : Type = A ;
A2V : Type = A2 ;
mkV0 v = v ** {lock_V = <>} ;
mkV2S v p = mkV2 v p ** {lock_V2 = <>} ;
mkV2V v p t = mkV2 v p ** {s4 = t ; lock_V2 = <>} ;
mkVA v = v ** {lock_VA = <>} ;
mkV2A v p = mkV2 v p ** {lock_V2A = <>} ;
mkV2Q v p = mkV2 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 = <>} ;
-}
} ;

View File

@@ -0,0 +1,95 @@
--1 Finnish parameters
--
-- This module defines the parameter types specific to Finnish.
-- Some parameters, such as $Number$, are inherited from $ParamX$.
resource ParamFin = ParamX ** open Prelude in {
--2 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 | NPossGenPl | NPossTransl Number | NPossIllat Number ;
-- Agreement of $NP$ is a record. We'll add $Gender$ later.
oper
Agr = {n : Number ; p : Person} ;
--
--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 | NPAccNom | NPAccGen ;
--2 For $Verb$
-- A special form is needed for the negated plural imperative.
param
VForm =
Inf
| Presn Number Person
| Impf Number Person
| Condit Number Person
| Imper Number
| ImperP3 Number
| ImperP1Pl
| ImpNegPl
| Pass Bool
| PastPartAct AForm
| PastPartPass AForm
| 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 | NOrd ;
DForm = unit | teen | ten ;
--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
} ;
}

View File

@@ -0,0 +1,23 @@
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 ! QDir} ;
UttImpSg pol imp = {s = pol.s ++ imp.s ! pol.p ! Sg} ;
UttImpPl pol imp = {s = pol.s ++ imp.s ! pol.p ! Pl} ;
UttIP ip = {s = ip.s ! Nom} ; --- Acc also
UttIAdv iadv = iadv ;
UttNP np = {s = np.s ! Acc} ;
UttVP vp = {s = "to" ++ infVP vp (agrP3 Sg)} ;
UttAdv adv = adv ;
NoPConj = {s = []} ;
PConjConj conj = conj ;
NoVoc = {s = []} ;
VocNP np = {s = "," ++ np.s ! Nom} ;
}

View File

@@ -0,0 +1,54 @@
concrete QuestionFin of Question = CatFin ** open ResFin in {
flags optimize=all_subs ;
lin
QuestCl cl = {
s = \\t,a,p =>
let cls = cl.s ! t ! a ! p
in table {
QDir => cls ! OQuest ;
QIndir => "if" ++ cls ! ODir
} ---- "whether" in ExtFin
} ;
QuestVP qp vp =
let cl = mkClause (qp.s ! Nom) {n = qp.n ; p = P3} vp
in {s = \\t,a,b,_ => cl.s ! t ! a ! b ! ODir} ;
QuestSlash ip slash = {
s = \\t,a,p =>
let
cls = slash.s ! t ! a ! p ;
who = slash.c2 ++ ip.s ! Acc --- stranding in ExtFin
in table {
QDir => who ++ cls ! OQuest ;
QIndir => who ++ cls ! ODir
}
} ;
QuestIAdv iadv cl = {
s = \\t,a,p =>
let
cls = cl.s ! t ! a ! p ;
why = iadv.s
in table {
QDir => why ++ cls ! OQuest ;
QIndir => why ++ cls ! ODir
}
} ;
PrepIP p ip = {s = p.s ++ ip.s ! Nom} ;
AdvIP ip adv = {
s = \\c => ip.s ! c ++ adv.s ;
n = ip.n
} ;
IDetCN idet num ord cn = {
s = \\c => idet.s ++ num.s ++ ord.s ++ cn.s ! idet.n ! c ;
n = idet.n
} ;
}

View File

@@ -0,0 +1,34 @@
concrete RelativeFin of Relative = CatFin ** open ResFin in {
flags optimize=all_subs ;
lin
RelCl cl = {
s = \\t,a,p,_ => "such" ++ "that" ++ cl.s ! t ! a ! p ! ODir
} ;
RelVP rp vp = {
s = \\t,ant,b,ag =>
let
agr = case rp.a of {
RNoAg => ag ;
RAg a => a
} ;
cl = mkClause (rp.s ! Nom) agr vp
in
cl.s ! t ! ant ! b ! ODir
} ;
RelSlash rp slash = {
s = \\t,a,p,_ => slash.c2 ++ rp.s ! Acc ++ slash.s ! t ! a ! p ! ODir
} ;
FunRP p np rp = {
s = \\c => np.s ! c ++ p.s ++ rp.s ! Acc ;
a = RAg np.a
} ;
IdRP = mkIP "which" "which" "whose" Sg ** {a = RNoAg} ;
}

View File

@@ -0,0 +1,175 @@
--# -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 = ParamFin ** open Prelude in {
flags optimize=all ;
oper
Compl : Type = {s : Str ; c : NPForm} ;
-- For $Verb$.
Verb : Type = {
s : VForm => Str
} ;
VP : Type = {
s : Tense => Anteriority => Polarity => Agr => {fin, inf : Str} ;
s2 : Agr => Str
} ;
predV : Verb -> VP = \verb -> {
s = \\t,ant,b,agr => {fin = verb.s ! Presn agr.n agr.p ; inf = []} ;
s2 = \\_ => []
} ;
{-
let
inf = verb.s ! VInf ;
fin = presVerb verb agr ;
past = verb.s ! VPast ;
part = verb.s ! VPPart ;
vf : Str -> Str -> {fin, inf : Str} = \x,y ->
{fin = x ; inf = y} ;
in
case <t,ant,b,ord> of {
<Pres,Simul,Pos,ODir> => vf fin [] ;
<Pres,Simul,Pos,OQuest> => vf (does agr) inf ;
<Pres,Simul,Neg,_> => vf (doesnt agr) inf ;
<Pres,Anter,Pos,_> => vf (have agr) part ;
<Pres,Anter,Neg,_> => vf (havent agr) part ;
<Past,Simul,Pos,ODir> => vf past [] ;
<Past,Simul,Pos,OQuest> => vf "did" inf ;
<Past,Simul,Neg,_> => vf "didn't" inf ;
<Past,Anter,Pos,_> => vf "had" part ;
<Past,Anter,Neg,_> => vf "hadn't" part ;
<Fut, Simul,Pos,_> => vf "will" inf ;
<Fut, Simul,Neg,_> => vf "won't" inf ;
<Fut, Anter,Pos,_> => vf "will" ("have" ++ part) ;
<Fut, Anter,Neg,_> => vf "won't" ("have" ++ part) ;
<Cond,Simul,Pos,_> => vf "would" inf ;
<Cond,Simul,Neg,_> => vf "wouldn't" inf ;
<Cond,Anter,Pos,_> => vf "would" ("have" ++ part) ;
<Cond,Anter,Neg,_> => vf "wouldn't" ("have" ++ part)
} ;
s2 = \\a => if_then_Str verb.isRefl (reflPron ! a) []
} ;
insertObj : (Agr => Str) -> VP -> VP = \obj,vp -> {
s = vp.s ;
s2 = \\a => vp.s2 ! a ++ obj ! a
} ;
--- This is not functional.
insertAdV : Str -> VP -> VP = \adv,vp -> {
s = vp.s ;
s2 = vp.s2
} ;
presVerb : {s : VForm => Str} -> Agr -> Str = \verb ->
agrVerb (verb.s ! VPres) (verb.s ! VInf) ;
infVP : VP -> Agr -> Str = \vp,a ->
(vp.s ! Fut ! Simul ! Neg ! ODir ! a).inf ++ vp.s2 ! a ;
agrVerb : Str -> Str -> Agr -> Str = \has,have,agr ->
case agr of {
{n = Sg ; p = P3} => has ;
_ => have
} ;
have = agrVerb "has" "have" ;
havent = agrVerb "hasn't" "haven't" ;
does = agrVerb "does" "do" ;
doesnt = agrVerb "doesn't" "don't" ;
Aux = {pres,past : Polarity => Agr => Str ; inf,ppart : Str} ;
auxBe : Aux = {
pres = \\b,a => case <b,a> of {
<Pos,{n = Sg ; p = P1}> => "am" ;
<Neg,{n = Sg ; p = P1}> => ["am not"] ; --- am not I
_ => agrVerb (posneg b "is") (posneg b "are") a
} ;
past = \\b,a => case a of {
{n = Sg ; p = P1|P3} => (posneg b "was") ;
_ => (posneg b "were")
} ;
inf = "be" ;
ppart = "been"
} ;
posneg : Polarity -> Str -> Str = \p,s -> case p of {
Pos => s ;
Neg => s + "n't"
} ;
conjThat : Str = "that" ;
reflPron : Agr => Str = table {
{n = Sg ; p = P1} => "myself" ;
{n = Sg ; p = P2} => "yourself" ;
{n = Sg ; p = P3} => "itself" ; ----
{n = Pl ; p = P1} => "ourselves" ;
{n = Pl ; p = P2} => "yourselves" ;
{n = Pl ; p = P3} => "themselves"
} ;
-}
-- For $Sentence$.
Clause : Type = {
s : Tense => Anteriority => Polarity => SType => Str
} ;
{-
mkClause : Str -> Agr -> VP -> Clause =
\subj,agr,vp -> {
s = \\t,a,b,o =>
let
verb = vp.s ! t ! a ! b ! o ! agr ;
compl = vp.s2 ! agr
in
case o of {
ODir => subj ++ verb.fin ++ verb.inf ++ compl ;
OQuest => verb.fin ++ subj ++ verb.inf ++ compl
}
} ;
-- For $Numeral$.
mkNum : Str -> Str -> Str -> Str -> {s : DForm => CardOrd => Str} =
\two, twelve, twenty, second ->
{s = table {
unit => table {NCard => two ; NOrd => second} ;
teen => \\c => mkCard c twelve ;
ten => \\c => mkCard c twenty
}
} ;
regNum : Str -> {s : DForm => CardOrd => Str} =
\six -> mkNum six (six + "teen") (six + "ty") (regOrd six) ;
regCardOrd : Str -> {s : CardOrd => Str} = \ten ->
{s = table {NCard => ten ; NOrd => regOrd ten}} ;
mkCard : CardOrd -> Str -> Str = \c,ten ->
(regCardOrd ten).s ! c ;
regOrd : Str -> Str = \ten ->
case last ten of {
"y" => init ten + "ieth" ;
_ => ten + "th"
} ;
-}
}

View File

@@ -0,0 +1,46 @@
concrete SentenceFin of Sentence = CatFin ** open ResFin in {
flags optimize=all_subs ;
lin
PredVP np vp = mkClause (np.s ! Nom) np.a vp ;
PredSCVP sc vp = mkClause sc.s (agrP3 Sg) vp ;
ImpVP vp = {
s = \\pol,n =>
let
agr = {n = n ; p = P2} ;
verb = infVP vp agr ;
dont = case pol of {
Neg => "don't" ;
_ => []
}
in
dont ++ verb
} ;
SlashV2 np v2 =
mkClause (np.s ! Nom) np.a (predV v2) ** {c2 = v2.c2} ;
SlashVVV2 np vv v2 =
mkClause (np.s ! Nom) np.a (insertObj (\\_ => "to" ++ v2.s ! VInf) (predV vv)) **
{c2 = v2.c2} ;
AdvSlash slash adv = {
s = \\t,a,b,o => slash.s ! t ! a ! b ! o ++ adv.s ;
c2 = slash.c2
} ;
SlashPrep cl prep = cl ** {c2 = prep.s} ;
EmbedS s = {s = conjThat ++ s.s} ;
EmbedQS qs = {s = qs.s ! QIndir} ;
EmbedVP vp = {s = "to" ++ infVP vp (agrP3 Sg)} ; --- agr
UseCl t a p cl = {s = t.s ++ a.s ++ p.s ++ cl.s ! t.t ! a.a ! p.p ! ODir} ;
UseQCl t a p cl = {s = \\q => t.s ++ a.s ++ p.s ++ cl.s ! t.t ! a.a ! p.p ! q} ;
UseRCl t a p cl = {s = \\r => t.s ++ a.s ++ p.s ++ cl.s ! t.t ! a.a ! p.p ! r} ;
}

View File

@@ -0,0 +1,106 @@
concrete StructuralFin of Structural = CatFin **
open MorphoFin, Prelude in {
flags optimize=all ;
lin
above_Prep = ss "above" ;
after_Prep = ss "after" ;
all_Predet = ss "all" ;
almost_AdA, almost_AdN = ss "almost" ;
although_Subj = ss "although" ;
always_AdV = ss "always" ;
and_Conj = ss "and" ** {n = Pl} ;
because_Subj = ss "because" ;
before_Prep = ss "before" ;
behind_Prep = ss "behind" ;
between_Prep = ss "between" ;
both7and_DConj = sd2 "both" "and" ** {n = Pl} ;
but_PConj = ss "but" ;
by8agent_Prep = ss "by" ;
by8means_Prep = ss "by" ;
can8know_VV = verbPart (mkVerbIrreg "know" "knew" "known") "how"** {c2 = "to"} ;---
can_VV = verbGen "manage" ** {c2 = "to"} ; ---
during_Prep = ss "during" ;
either7or_DConj = sd2 "either" "or" ** {n = Sg} ;
everybody_NP = regNP "everybody" Sg ;
every_Det = mkDeterminer Sg "every" ;
everything_NP = regNP "everything" Sg ;
everywhere_Adv = ss "everywhere" ;
first_Ord = ss "first" ;
from_Prep = ss "from" ;
he_Pron = mkNP "he" "him" "his" Sg P3 ;
here_Adv = ss "here" ;
here7to_Adv = ss ["to here"] ;
here7from_Adv = ss ["from here"] ;
how_IAdv = ss "how" ;
how8many_IDet = mkDeterminer Pl ["how many"] ;
if_Subj = ss "if" ;
in8front_Prep = ss ["in front of"] ;
i_Pron = mkNP "I" "me" "my" Sg P1 ;
in_Prep = ss "in" ;
it_Pron = mkNP "it" "it" "its" Sg P3 ;
less_CAdv = ss "less" ;
many_Det = mkDeterminer Pl "many" ;
more_CAdv = ss "more" ;
most_Predet = ss "most" ;
much_Det = mkDeterminer Sg "much" ;
must_VV = mkVerb4 "have" "has" "had" "had" ** {c2 = "to"} ; ---
no_Phr = ss "no" ;
on_Prep = ss "on" ;
one_Quant = mkDeterminer Sg "one" ;
only_Predet = ss "only" ;
or_Conj = ss "or" ** {n = Sg} ;
otherwise_PConj = ss "otherwise" ;
part_Prep = ss "of" ;
please_Voc = ss "please" ;
possess_Prep = ss "of" ;
quite_Adv = ss "quite" ;
she_Pron = mkNP "she" "her" "her" Sg P3 ;
so_AdA = ss "so" ;
somebody_NP = regNP "somebody" Sg ;
someSg_Det = mkDeterminer Sg "some" ;
somePl_Det = mkDeterminer Pl "some" ;
something_NP = regNP "something" Sg ;
somewhere_Adv = ss "somewhere" ;
that_Quant = mkQuant "that" "those" ;
that_NP = regNP "that" Sg ;
there_Adv = ss "there" ;
there7to_Adv = ss "there" ;
there7from_Adv = ss ["from there"] ;
therefore_PConj = ss "therefore" ;
they_Pron = mkNP "they" "them" "their" Pl P3 ;
this_Quant = mkQuant "this" "these" ;
this_NP = regNP "this" Sg ;
those_NP = regNP "those" Pl ;
through_Prep = ss "through" ;
too_AdA = ss "too" ;
to_Prep = ss "to" ;
under_Prep = ss "under" ;
very_AdA = ss "very" ;
want_VV = verbGen "want" ** {c2 = "to"} ;
we_Pron = mkNP "we" "us" "our" Pl P1 ;
whatPl_IP = mkIP "what" "what" "what's" Sg ;
whatSg_IP = mkIP "what" "what" "what's" Sg ;
when_IAdv = ss "when" ;
when_Subj = ss "when" ;
where_IAdv = ss "where" ;
whichPl_IDet = mkDeterminer Pl ["which"] ;
whichSg_IDet = mkDeterminer Sg ["which"] ;
whoSg_IP = mkIP "who" "whom" "whose" Sg ;
whoPl_IP = mkIP "who" "whom" "whose" Pl ;
why_IAdv = ss "why" ;
without_Prep = ss "without" ;
with_Prep = ss "with" ;
yes_Phr = ss "yes" ;
youSg_Pron = mkNP "you" "you" "your" Sg P2 ;
youPl_Pron = mkNP "you" "you" "your" Pl P2 ;
youPol_Pron = mkNP "you" "you" "your" Sg P2 ;
oper
mkQuant : Str -> Str -> {s : Number => Str} = \x,y -> {
s = table Number [x ; y]
} ;
}

View File

@@ -0,0 +1,37 @@
concrete VerbFin of Verb = CatFin ** open ResFin in {
flags optimize=all_subs ;
lin
UseV = predV ;
ComplV2 v np = insertObj (\\_ => v.c2 ++ np.s ! Acc) (predV v) ;
ComplV3 v np np2 =
insertObj (\\_ => v.c2 ++ np.s ! Acc ++ v.c3 ++ np2.s ! Acc) (predV v) ;
ComplVV v vp = insertObj (\\a => v.c2 ++ infVP vp a) (predV v) ;
ComplVS v s = insertObj (\\_ => conjThat ++ s.s) (predV v) ;
ComplVQ v q = insertObj (\\_ => q.s ! QIndir) (predV v) ;
ComplVA v ap = insertObj (ap.s) (predV v) ;
ComplV2A v np ap =
insertObj (\\_ => v.c2 ++ np.s ! Acc ++ ap.s ! np.a) (predV v) ;
UseComp comp = insertObj comp.s (predAux auxBe) ;
AdvVP vp adv = insertObj (\\_ => adv.s) vp ;
--- This rule destroys parsing...
---- AdVVP adv vp = insertAdV adv.s vp ;
ReflV2 v = insertObj (\\a => v.c2 ++ reflPron ! a) (predV v) ;
PassV2 v = insertObj (\\_ => v.s ! VPPart) (predAux auxBe) ;
UseVS, UseVQ = \vv -> {s = vv.s ; c2 = [] ; isRefl = vv.isRefl} ; -- no "to"
CompAP ap = ap ;
CompNP np = {s = \\_ => np.s ! Acc} ;
CompAdv a = {s = \\_ => a.s} ;
}