cleaning up Swedish morpho

This commit is contained in:
aarne
2006-01-25 17:17:42 +00:00
parent 9cb10ab12e
commit 75e6f51bbc
4 changed files with 208 additions and 318 deletions

View File

@@ -7,23 +7,23 @@ flags
lin
airplane_N = regN "flygplan" neutrum ;
answer_V2S = mkV2S (regV "svara") "till" ;
answer_V2S = mkV2S (regV "svarar") "till" ;
apartment_N = mk2N "lägenhet" "lägenheter" ;
apple_N = regN "äpple" neutrum ;
art_N = mk2N "konst" "konster" ;
ask_V2Q = mkV2Q (regV "fråga") [] ;
ask_V2Q = mkV2Q (regV "frågar") [] ;
baby_N = regN "bebis" utrum ;
bad_A = irregADeg "dålig" "sämre" "sämst";
bad_A = irregA "dålig" "sämre" "sämst";
bank_N = mk2N "bank" "banker" ;
beautiful_A = mk3ADeg "vacker" "vackert" "vackrast" ;
beautiful_A = mk3A "vacker" "vackert" "vackrast" ;
become_VA = mkVA (mkV "bli" "blir""bli" "blev" "blivit" "bliven") ;
beer_N = regN "öl" neutrum ;
beg_V2V = mkV2V (mkV "be" "ber""be" "blad" "bett" "bedd") [] "att" ;
big_A = irregADeg "stor" "större" "störst";
big_A = irregA "stor" "större" "störst";
bike_N = mk2N "cykel" "cyklar" ;
bird_N = mk2N "fågel" "fåglar" ;
black_A = mk2ADeg "svart" "svart" ;
blue_A = mk2ADeg "blå" "blått";
black_A = mk2A "svart" "svart" ;
blue_A = mk2A "blå" "blått";
boat_N = regN "båt" utrum ;
book_N = mkN "bok" "boken" "böcker" "böckerna" ;
boot_N = mk2N "stövel" "stövlar" ;
@@ -31,9 +31,9 @@ lin
boy_N = regN "pojke" utrum ;
bread_N = regN "bröd" neutrum ;
break_V2 = dirV2 (partV (mkV "slå" "slår" "slå" "slog" "slagit" "slagen") "sönder") ;
broad_A = mk2ADeg "bred" "brett" ;
broad_A = mk2A "bred" "brett" ;
brother_N2 = mkN2 ((mkN "bror" "brodern" "bröder" "bröderna")) "till" ;
brown_A = regADeg "brun" ;
brown_A = regA "brun" ;
butter_N = regN "smör" neutrum ;
buy_V2 = dirV2 (mk2V "köpa" "köpte") ;
camera_N = regN "kamera" utrum ;
@@ -47,11 +47,11 @@ lin
child_N = regN "barn" neutrum ;
church_N = regN "kyrka" utrum ;
city_N = mk2N "stad" "städer" ;
clean_A = regADeg "ren" ;
clever_A = regADeg "klok" ;
clean_A = regA "ren" ;
clever_A = regA "klok" ;
close_V2 = dirV2 (mk2V "stänga" "stängde") ;
coat_N = regN "rock" utrum ;
cold_A = regADeg "kall" ;
cold_A = regA "kall" ;
come_V = (mkV "komma" "kommer" "kom" "kom" "kommit" "kommen") ;
computer_N = mk2N "dator" "datorer" ;
country_N = mkN "land" "landet" "länder" "länderna" ;
@@ -59,18 +59,18 @@ lin
cow_N = mk2N "ko" "kor" ;
die_V = (mkV "dö" "dör" "dö" "dog" "dött" "dödd") ; ----
distance_N3 = mkN3 (mk2N "avstånd" "avstånd") "från" "till" ;
dirty_A = regADeg "smutsig" ;
dirty_A = regA "smutsig" ;
doctor_N = mk2N "läkare" "läkare" ;
dog_N = regN "hund" utrum ;
door_N = regN "dörr" utrum ;
drink_V2 = dirV2 (irregV "dricka" "drack" "druckit") ;
easy_A2V = mkA2V (mk2A "lätt" "lätt") "för" ;
eat_V2 = dirV2 (irregV "äta" "åt" "ätit") ;
empty_A = mkADeg "tom" "tomt" "tomma" "tomma" "tommare" "tommast" "tommaste" ;
empty_A = mkA "tom" "tomt" "tomma" "tomma" "tommare" "tommast" "tommaste" ;
enemy_N = regN "fiende" neutrum ;
factory_N = mk2N "fabrik" "fabriker" ;
father_N2 = mkN2 ((mkN "far" "fadern" "fäder" "fäderna")) "till" ;
fear_VS = mkVS (regV "frukta") ;
fear_VS = mkVS (regV "fruktar") ;
find_V2 = dirV2 (irregV "finna" "fann" "funnit") ;
fish_N = mk2N "fisk" "fiskar" ;
floor_N = regN "golv" neutrum ;
@@ -83,21 +83,21 @@ lin
girl_N = regN "flicka" utrum ;
glove_N = regN "handske" utrum ;
gold_N = regN "guld" neutrum ;
good_A = mkADeg "god" "gott" "goda" "goda" "bättre" "bäst" "bästa" ;
good_A = mkA "god" "gott" "goda" "goda" "bättre" "bäst" "bästa" ;
go_V = (mkV "gå" "går" "gå" "gick" "gått" "gången") ;
green_A = regADeg "grön" ;
green_A = regA "grön" ;
harbour_N = regN "hamn" utrum;
hate_V2 = dirV2 (regV "hata") ;
hate_V2 = dirV2 (regV "hatar") ;
hat_N = regN "hatt" utrum ;
have_V2 = dirV2 (mkV "ha" "har" "ha" "hade" "haft" "haft") ; ---- pp
hear_V2 = dirV2 (mkV "höra" "hör" "hör" "hörde" "hört" "hörd") ;
hill_N = regN "kulle" utrum ;
-- hope_VS = mkVS ((regV "önska")) ;
hope_VS = mkVS (depV (regV "hoppa")) ;
-- hope_VS = mkVS ((regV "önskar")) ;
hope_VS = mkVS (depV (regV "hoppar")) ;
horse_N = regN "häst" utrum ;
hot_A = regADeg "het" ;
hot_A = regA "het" ;
house_N = regN "hus" neutrum ;
important_A = regADeg "viktig" ;
important_A = regA "viktig" ;
industry_N = mk2N "industri" "industrier" ; ---- "ien" ??
iron_N = regN "järn" neutrum ;
king_N = (regN "kung" utrum) ;
@@ -106,11 +106,11 @@ lin
lamp_N = regN "lampa" utrum;
learn_V2 = dirV2 (reflV (mkV "lära" "lär" "lär" "lärde" "lärt" "lärd")) ;
leather_N = mkN "läder" "lädret" "läder" "lädren" ;
leave_V2 = dirV2 (regV "lämna") ;
leave_V2 = dirV2 (regV "lämnar") ;
like_V2 = mkV2 (mk2V "tycka" "tyckte") "om" ;
listen_V2 = mkV2 (regV "lyssna") "på" ;
listen_V2 = mkV2 (regV "lyssnar") "på" ;
live_V = (irregV "leva" "levde" "levt") ; ---- ?
long_A = irregADeg "lång" "längre" "längst" ;
long_A = irregA "lång" "längre" "längst" ;
lose_V2 = dirV2 (regV "förlora") ;
love_N = regN "kärlek" utrum ;
love_V2 = dirV2 (regV "älska") ;
@@ -122,12 +122,12 @@ lin
mother_N2 = mkN2 (mkN "mor" "modern" "mödrar" "mödrarna") "till" ;
mountain_N = regN "berg" neutrum ;
music_N = mk2N "musik" "musiker" ; ---- er ?
narrow_A = regADeg "smal" ;
new_A = mkADeg "ny" "nytt" "nya" "nya" "nyare" "nyast" "nyaste" ;
narrow_A = regA "smal" ;
new_A = mkA "ny" "nytt" "nya" "nya" "nyare" "nyast" "nyaste" ;
newspaper_N = regN "tidning" utrum ;
oil_N = regN "olja" utrum ;
old_A = mkADeg "gammal" "gammalt" "gamla" "gamla" "äldre" "äldst" "äldsta" ;
old_A = mkA "gammal" "gammalt" "gamla" "gamla" "äldre" "äldst" "äldsta" ;
open_V2 = dirV2 (regV "öppna") ;
paint_V2A = mkV2A (regV "måla") [] ;
paper_N = mkN "papper" "pappret" "papper" "pappren" ;
@@ -144,7 +144,7 @@ lin
radio_N = regN "radio" utrum ; ----
rain_V0 = mkV0 (regV "regna") ;
read_V2 = dirV2 (mk2V "läsa" "läste") ;
red_A = mk2ADeg "röd" "rött" ;
red_A = mk2A "röd" "rött" ;
religion_N = mk2N "religion" "religioner" ;
restaurant_N = mk2N "restaurang" "restauranger" ;
river_N = mkN "å" "ån" "åar" "åarna" ;
@@ -165,11 +165,11 @@ lin
shirt_N = regN "skjorta" utrum ;
shoe_N = regN "sko" utrum ;
shop_N = mk2N "affär" "affären" ;
short_A = regADeg "kort" ;
short_A = regA "kort" ;
silver_N = mkN "silver" "silvret" "silver" "silvren" ;
sister_N = mk2N "syster" "systrar" ;
sleep_V = (irregV "sova" "sov" "sovit") ;
small_A = mkADeg "liten" "litet" "lilla" "små" "mindre" "minst" "minsta" ;
small_A = mkA "liten" "litet" "lilla" "små" "mindre" "minst" "minsta" ;
snake_N = regN "orm" utrum ;
sock_N = regN "strumpa" utrum ;
speak_V2 = dirV2 (regV "tala") ;
@@ -178,7 +178,7 @@ lin
stone_N = regN "sten" utrum ;
stove_N = regN "spis" utrum ;
student_N = mk2N "student" "studenter" ;
stupid_A = mk3ADeg "dum" "dumt" "dumma" ;
stupid_A = mk3A "dum" "dumt" "dumma" ;
sun_N = regN "sol" utrum ;
switch8off_V2 = dirV2 (partV (irregV "stänga" "stängde" "stängt") "av") ;
switch8on_V2 = dirV2 (partV (irregV "slå" "slog" "slagit") "på") ;
@@ -187,23 +187,23 @@ lin
teacher_N = mk2N "lärare" "lärare" ;
teach_V2 = dirV2 (regV "undervisa") ;
television_N = mk2N "television" "televisioner" ;
thick_A = regADeg "tjock" ;
thin_A = mk2ADeg "tunn" "tunt" ;
thick_A = regA "tjock" ;
thin_A = mk2A "tunn" "tunt" ;
train_N = regN "tåg" neutrum ;
travel_V = mk2V "resa" "reste" ;
tree_N = regN "träd" neutrum ;
---- trousers_N = regN "trousers" ; ---- pl t !
ugly_A = regADeg "ful" ;
ugly_A = regA "ful" ;
understand_V2 = dirV2 (mkV "förstå" "förstår" "förstå" "förstod" "förstått" "förstådd") ;
university_N = regN "universitet" neutrum ;
village_N = mkN "by" "byn" "byar" "byarna" ;
wait_V2 = mkV2 (regV "vänta") "på" ;
walk_V = (mkV "gå" "går" "gå" "gick" "gått" "gången") ;
warm_A = regADeg "varm" ;
warm_A = regA "varm" ;
war_N = regN "krig" neutrum ;
watch_V2 = mkV2 (regV "titta") "på" ;
water_N = mkN "vatten" "vattnet" "vatten" "vattnen" ;
white_A = regADeg "vit" ;
white_A = regA "vit" ;
window_N = mkN "fönster" "fönstret" "fönster" "fönstren" ;
wine_N = mkN "vin" "vinet" "viner" "vinerna" ; ----
win_V2 = dirV2 (irregV "vinna" "vann" "vunnit") ;
@@ -211,8 +211,8 @@ lin
wonder_VQ = mkVQ (regV "undra") ;
wood_N = mkN "trä" "träet" "träen" "träena" ; ---- ?
write_V2 = dirV2 (irregV "skriva" "skrev" "skrivit") ;
yellow_A = regADeg "gul" ;
young_A = irregADeg "ung" "yngre" "yngst" ;
yellow_A = regA "gul" ;
young_A = irregA "ung" "yngre" "yngst" ;
do_V2 = dirV2 (mkV "göra" "gör" "gör" "gjorde" "gjort" "gjord") ;
now_Adv = mkAdv "nu" ;

View File

@@ -10,197 +10,32 @@
resource MorphoSwe = CommonScand, ResSwe ** open Prelude, (Predef=Predef) in {
-- Nouns
oper
mkNoun : (x1,_,_,x4 : Str) -> Noun =
\apa,apan,apor,aporna -> {
s = nounForms apa apan apor aporna ;
g = case last apan of {
"n" => Utr ;
_ => Neutr
}
} ;
-- School declensions.
decl1Noun : Str -> Noun = \apa ->
let ap = init apa in
mkNoun apa (apa + "n") (ap + "or") (ap + "orna") ;
decl2Noun : Str -> Noun = \bil ->
case last bil of {
"e" => let pojk = init bil in
mkNoun bil (bil + "n") (pojk + "ar") (pojk + "arna") ;
"o" | "u" | "y" => mkNoun bil (bil + "n") (bil + "ar") (bil + "arna") ;
_ => mkNoun bil (bil + "en") (bil + "ar") (bil + "arna")
} ;
decl3Noun : Str -> Noun = \sak ->
case last sak of {
"e" => mkNoun sak (sak + "n") (sak +"r") (sak + "rna") ;
"y" | "å" | "é" => mkNoun sak (sak + "n") (sak +"er") (sak + "erna") ;
_ => mkNoun sak (sak + "en") (sak + "er") (sak + "erna")
} ;
decl4Noun : Str -> Noun = \rike ->
mkNoun rike (rike + "t") (rike + "n") (rike + "na") ;
decl5Noun : Str -> Noun = \lik ->
mkNoun lik (lik + "et") lik (lik + "en") ;
-- Adjectives
adjIrreg : (x1,_,_,x4 : Str) -> Adjective ;
adjIrreg god gott battre bast =
mkAdjective god gott (god + "a") (god + "a") battre bast (bast + "a") ;
-- Often it is possible to derive the $Pos Sg Neutr$ form even if the
-- comparison forms are irregular.
adjIrreg3 : (x1,_,x3 : Str) -> Adjective ;
adjIrreg3 ung yngre yngst = adjIrreg ung (ung + "t") yngre yngst ;
-- Some adjectives must be given $Pos Sg Utr$ $Pos Sg Neutr$, and $Pos Pl$,
-- e.g. those ending with unstressed "en".
adjAlmostReg : (x1,_,x3: Str) -> Adjective ;
adjAlmostReg ljummen ljummet ljumma =
mkAdjective ljummen ljummet ljumma ljumma
(ljumma + "re") (ljumma + "st") (ljumma + "ste") ;
adjReg : Str -> Adjective = \fin ->
adjAlmostReg fin (fin + "t") (fin + "a") ;
adj2Reg : Str -> Str -> Adjective = \vid,vitt ->
adjAlmostReg vid vitt (vid + "a") ;
-- Verbs
-- A friendly form of $ResScand.mkVerb$, using the heuristic
-- $ptPretForms$ to infer two forms.
-- Heuristic to infer all participle forms from one.
mkVerb6 : (x1,_,_,_,_,x6 : Str) -> Verb =
\finna,finner,finn,fann,funnit,funnen ->
let
funn = ptPretForms funnen ;
funnet = funn ! Strong SgNeutr ! Nom ;
funna = funn ! Strong Plg ! Nom
in
mkVerb finna finner finn fann funnit funnen funnet funna **
{vtype=VAct} ;
oper
ptPretAll : Str -> Str * Str = \funnen ->
case funnen of {
vun +"nen" => <vun +"net", vun + "na"> ;
bjud + "en" => <bjud + "et", bjud + "na"> ;
se + "dd" => <se + "tt", se +"dda"> ;
tal + "ad" => <tal + "at", tal +"ade"> ;
kaen + "d" => <kaen + "t", kaen + "da"> ;
lekt => <lekt, lekt + "a">
} ;
ptPretForms : Str -> AFormPos => Case => Str = \funnen -> \\a,c =>
let
funn = Predef.tk 2 funnen ;
en = Predef.dp 2 funnen ;
funne = init funnen ;
n = last funnen ;
m = case last funn of {
"n" => [] ;
_ => "n"
} ;
funna = case en of {
"en" => case a of {
(Strong (SgUtr)) => funn + "en" ;
(Strong (SgNeutr)) => funn + "et" ;
-- (Weak (AxSg Masc)) => funn + m + "e" ;
_ => funn + m + "a"
} ;
"dd" => case a of {
(Strong (SgUtr)) => funn + "dd" ;
(Strong (SgNeutr)) => funn + "tt" ;
-- (Weak (AxSg Masc)) => funn + "dde" ;
_ => funn + "dda"
} ;
"ad" => case a of {
(Strong (SgUtr)) => funn + "ad" ;
(Strong (SgNeutr)) => funn + "at" ;
_ => funn + "ade"
} ;
_ => case n of {
"d" => case a of {
(Strong (SgUtr)) => funne + "d" ;
(Strong (SgNeutr)) => funne + "t" ;
-- (Weak (AxSg Masc)) => funne + "de" ;
_ => funne + "da"
} ;
_ => case a of {
(Strong (SgUtr)) => funne + "t" ;
(Strong (SgNeutr)) => funne + "t" ;
-- (Weak (AxSg Masc)) => funne + "te" ;
_ => funne + "ta"
}
}
}
in
mkCase c funna ;
-- This is a general way to form irregular verbs.
irregVerb : (_,_,_ : Str) -> Verb = \sälja, sålde, sålt ->
let
a = last sälja ;
sälj = case a of {
"a" => init sälja ;
_ => sälja
} ;
er = case a of {
"a" => "er" ;
_ => "r"
} ;
såld = case Predef.dp 2 sålt of {
"it" => Predef.tk 2 sålt + "en" ;
"tt" => Predef.tk 2 sålt + "dd" ;
_ => init sålt + "d"
}
in
mkVerb6 sälja (sälj + er) sälj sålde sålt såld ;
regVerb : (_,_ : Str) -> Verb = \tala,talade ->
let
ade = Predef.dp 3 talade ;
de = Predef.dp 2 ade ;
tal = init tala ;
ta = init tal ;
forms = case ade of {
"ade" => conj1 tala ;
"dde" => case last tala of {
"a" => mkVerb6 tala (tal + "er") tal (ta +"tte") (ta +"tt") (ta +"dd") ;
_ => conj3 tala
} ;
"tte" => mkVerb6 tala (tal + "er") tal (ta +"tte") (ta +"tt") (ta +"tt") ;
"nde" => mkVerb6 tala (tal + "er") tal (tal +"e") (ta +"t") tal ;
"rde" => mkVerb6 tala tal tal (tal +"de") (tal +"t") (tal +"d") ;
_ => case de of {
"te" => conj2 tala ;
_ => conj2d tala
}
}
in forms ** {s1 = []} ;
-- school conjugations
conj1 : Str -> Verb = \tala ->
mkVerb6 tala (tala + "r") tala (tala +"de") (tala +"t") (tala +"d") ;
conj2 : Str -> Verb = \leka ->
let lek = init leka in
mkVerb6 leka (lek + "er") lek (lek +"te") (lek +"t") (lek +"t") ;
conj2d : Str -> Verb = \gräva ->
let gräv = init gräva in
mkVerb6 gräva (gräv + "er") gräv (gräv +"de") (gräv +"t") (gräv +"d") ;
conj3 : Str -> Verb = \bo ->
mkVerb6 bo (bo + "r") bo (bo +"dde") (bo +"tt") (bo +"dd") ;
-- for $Structural$
funfun = ptPretAll funnen
in
mkCase c (case a of {
(Strong (SgUtr)) => funnen ;
(Strong (SgNeutr)) => funfun.p1 ;
_ => funfun.p2
}
) ;
-- For $Numeral$.

View File

@@ -129,45 +129,31 @@ oper
--2 Adjectives
-- Non-comparison one-place adjectives need for forms:
-- Adjectives may need as many as seven forms.
mkA : (galen,galet,galna : Str) -> A ;
mkA : (liten, litet, lilla, sma, mindre, minst, minsta : Str) -> A ;
-- For regular adjectives, the other forms are derived.
-- The regular pattern works for many adjectives, e.g. those ending
-- with "ig".
regA : Str -> A ;
-- In practice, two forms are enough.
-- Just the comparison forms can be irregular.
irregA : (tung,tyngre,tyngst : Str) -> A ;
-- Sometimes just the positive forms are irregular.
mk3A : (galen,galet,galna : Str) -> A ;
mk2A : (bred,brett : Str) -> A ;
mk2A : (bred,brett : Str) -> A ;
--3 Two-place adjectives
--
-- Two-place adjectives need a preposition for their second argument.
mkA2 : A -> Preposition -> A2 ;
-- Comparison adjectives may need as many as seven forms.
ADeg : Type ;
mkADeg : (liten, litet, lilla, sma, mindre, minst, minsta : Str) -> ADeg ;
-- The regular pattern works for many adjectives, e.g. those ending
-- with "ig".
regADeg : Str -> ADeg ;
-- Just the comparison forms can be irregular.
irregADeg : (tung,tyngre,tyngst : Str) -> ADeg ;
-- Sometimes just the positive forms are irregular.
mk3ADeg : (galen,galet,galna : Str) -> ADeg ;
mk2ADeg : (bred,brett : Str) -> ADeg ;
--2 Adverbs
@@ -290,7 +276,14 @@ oper
nominative = Nom ;
genitive = Gen ;
mkN x y z u = mkNoun x y z u ** {lock_N = <>} ;
mkN = \apa,apan,apor,aporna -> {
s = nounForms apa apan apor aporna ;
g = case last apan of {
"n" => Utr ;
_ => Neutr
}
} ** {lock_N = <>} ;
regN bil g = case g of {
Utr => case last bil of {
"a" => decl1Noun bil ;
@@ -303,45 +296,50 @@ oper
} ** {lock_N = <>} ;
mk2N bil bilar =
let
l = last bil ;
b = Predef.tk 2 bil ;
ar = Predef.dp 2 bilar ;
bile = Predef.tk 2 bilar
in
case ar of {
"or" => case l of {
"a" => decl1Noun bil ;
"r" => decl5Noun bil ;
"o" => mkNoun bil (bil + "n") bilar (bilar + "na") ;
_ => mkNoun bil (bil + "en") bilar (bilar + "na")
} ;
"ar" => ifTok Noun bil bilar
(decl5Noun bil)
(ifTok Noun bile bil
(decl2Noun bil)
(case l of {
"e" => decl2Noun bil ; -- pojke-pojkar
_ => mkNoun bil (bile + "en") bilar (bilar + "na") -- mun-munnar
}
)
) ;
"er" => case l of {
"e" => mkNoun bil (bil + "n") (bil +"r") (bil + "rna") ;
"y" | "å" | "é" => decl3Noun bil ;
_ => mkNoun bil (bil + "en") bilar (bilar + "na")
ifTok N bil bilar (decl5Noun bil) (
case Predef.dp 2 bilar of {
"or" => case bil of {
_ + "a" => decl1Noun bil ; -- apa, apor
_ + "o" => mkN bil (bil + "n") bilar (bilar + "na") ; -- ko,kor
_ => mkN bil (bil + "en") bilar (bilar + "na") -- ros,rosor
} ;
"ar" => decl2Noun bil ;
"er" => decl3Noun bil ; --
"en" => decl4Noun bil ; -- rike, riken
_ => mkN bil (bil + "et") bilar (bilar + "n") -- centrum, centra
}) ;
-- School declensions.
decl1Noun : Str -> N = \apa ->
let ap = init apa in
mkN apa (apa + "n") (ap + "or") (ap + "orna") ;
decl2Noun : Str -> N = \bil ->
let
bb : Str * Str = case bil of {
pojk + "e" => <pojk + "ar", bil + "n"> ;
nyck + "e" + l@("l" | "r" | "n") => <nyck + l + "ar",bil + "n"> ;
_ => <bil + "ar", bil + "en">
} ;
in mkN bil bb.p2 bb.p1 (bb.p1 + "na") ;
decl3Noun : Str -> N = \sak ->
case last sak of {
"e" => mkN sak (sak + "n") (sak +"r") (sak + "rna") ;
"y" | "å" | "é" | "y" => mkN sak (sak + "n") (sak +"er") (sak + "erna") ;
_ => mkN sak (sak + "en") (sak + "er") (sak + "erna")
} ;
"en" => ifTok Noun bil bilar (decl5Noun bil) (decl4Noun bil) ; -- ben-ben
_ => ifTok Noun bil bilar (
case Predef.dp 3 bil of {
"are" => let kikar = init bil in
mkNoun bil (kikar + "en") bil (kikar + "na") ;
_ => decl5Noun bil
}
)
(decl5Noun bil) --- rest case with lots of garbage
} ** {lock_N = <>} ;
decl4Noun : Str -> N = \rike ->
mkN rike (rike + "t") (rike + "n") (rike + "na") ;
decl5Noun : Str -> N = \lik ->
case Predef.dp 3 lik of {
"are" => mkN lik (lik + "n") lik (init lik + "na") ; -- kikare
_ => mkN lik (lik + "et") lik (lik + "en")
} ;
mkN2 = \n,p -> n ** {lock_N2 = <> ; c2 = p} ;
regN2 n g = mkN2 (regN n g) (mkPreposition "av") ;
@@ -353,32 +351,89 @@ oper
{s = table {NPPoss _ => y ; _ => x} ; a = agrP3 g n ; p = P3 ;
lock_NP = <>} ;
mkA a b c = (adjAlmostReg a b c) ** {lock_A = <>} ;
mk2A a b = (adj2Reg a b) ** {lock_A = <>} ;
regA a = (adjReg a) ** {lock_A = <>} ;
mkA a b c d e f g = mkAdjective a b c d e f g ** {lock_A = <>} ;
regA fin = mk3A fin (fin + "t") (fin + "a") ** {lock_A = <>} ;
irregA ung yngre yngst =
mkA ung (ung + "t") (ung + "a") (ung + "a") yngre yngst (yngst+"a") ;
mk3A ljummen ljummet ljumma =
mkAdjective
ljummen ljummet ljumma ljumma
(ljumma + "re") (ljumma + "st") (ljumma + "ste") ** {lock_A = <>} ;
mk2A vid vitt = mk3A vid vitt (vid + "a") ;
mkA2 a p = a ** {c2 = p ; lock_A2 = <>} ;
ADeg = A ;
mkADeg a b c d e f g = mkAdjective a b c d e f g ** {lock_A = <>} ;
regADeg a = adjReg a ** {lock_A = <>} ;
irregADeg a b c = adjIrreg3 a b c ** {lock_A = <>} ;
mk3ADeg a b c = adjAlmostReg a b c ** {lock_A = <>} ;
mk2ADeg a b = adj2Reg a b ** {lock_A = <>} ;
mkAdv x = ss x ** {lock_Adv = <>} ;
mkAdV x = ss x ** {lock_AdV = <>} ;
mkAdA x = ss x ** {lock_AdA = <>} ;
mkPreposition p = p ;
mkV a b c d e f = mkVerb6 a b c d e f ** {lock_V = <>} ;
mkV = \finna,finner,finn,fann,funnit,funnen ->
let
funn = ptPretForms funnen ;
funnet = funn ! Strong SgNeutr ! Nom ;
funna = funn ! Strong Plg ! Nom
in
mkVerb finna finner finn fann funnit funnen funnet funna **
{vtype=VAct ; lock_V = <>} ;
regV a = mk2V a (a + de) where {de = case last a of {"a" => "de" ; _ => "dde"}} ;
mk2V a b = regVerb a b ** {lock_V = <>} ;
regV leker = case leker of {
lek + "a" => conj1 leker ; --- bw compat
lek + "ar" => conj1 (lek + "a") ;
lek + "er" => conj2 (lek + "a") ;
bo + "r" => conj3 bo
} ;
irregV x y z = irregVerb x y z
mk2V leka lekte = case <leka,lekte> of {
<_, _ + "ade"> => conj1 leka ;
<_ + "a", _> => conj2 leka ;
_ => conj3 leka
} ;
-- school conjugations
conj1 : Str -> V = \tala ->
mkV tala (tala + "r") tala (tala +"de") (tala +"t") (tala +"d") ;
conj2 : Str -> V = \leka ->
let lek = init leka in
case last lek of {
"l" | "m" | "n" | "v" | "g" =>
mkV leka (lek + "er") lek (lek +"de") (lek +"t") (lek +"d") ;
"r" =>
mkV leka lek lek (lek +"de") (lek +"t") (lek +"d") ;
_ => case leka of {
_ + "nd" =>
mkV leka (lek + "er") lek (lek +"e") (init lek +"t") lek ;
_ =>
mkV leka (lek + "er") lek (lek +"te") (lek +"t") (lek +"t")
}
} ;
conj3 : Str -> V = \bo ->
mkV bo (bo + "r") bo (bo +"dde") (bo +"tt") (bo +"dd") ;
irregV = \sälja, sålde, sålt ->
let
a = last sälja ;
sälj = case a of {
"a" => init sälja ;
_ => sälja
} ;
er = case a of {
"a" => "er" ;
_ => "r"
} ;
såld = case Predef.dp 2 sålt of {
"it" => Predef.tk 2 sålt + "en" ;
"tt" => Predef.tk 2 sålt + "dd" ;
_ => init sålt + "d"
}
in
mkV sälja (sälj + er) sälj sålde sålt såld
** {s1 = [] ; lock_V = <>} ;
partV v p = {s = \\f => v.s ! f ++ p ; vtype = v.vtype ; lock_V = <>} ;

View File

@@ -1,5 +1,5 @@
concrete StructuralSwe of Structural = CatSwe **
open MorphoSwe, Prelude in {
open MorphoSwe, ParadigmsSwe, Prelude in {
flags optimize=all ;
@@ -20,7 +20,7 @@ concrete StructuralSwe of Structural = CatSwe **
but_PConj = ss "men" ;
by8means_Prep = ss "med" ;
can8know_VV, can_VV =
mkVerb6 "kunna" "kan" "kunn" "kunde" "kunnat" "kunnen" **
mkV "kunna" "kan" "kunn" "kunde" "kunnat" "kunnen" **
{c2 = [] ; lock_VV = <>} ;
during_Prep = ss "under" ;
either7or_DConj = sd2 "antingen" "eller" ** {n = Sg} ;
@@ -30,7 +30,7 @@ concrete StructuralSwe of Structural = CatSwe **
everywhere_Adv = ss "överallt" ;
first_Ord = {s = "första" ; isDet = True} ;
from_Prep = ss "från" ;
he_Pron = mkNP "han" "honom" "hans" "hans" "hans" SgUtr P3 ;
he_Pron = MorphoSwe.mkNP "han" "honom" "hans" "hans" "hans" SgUtr P3 ;
here_Adv = ss "här" ;
here7to_Adv = ss "hit" ;
here7from_Adv = ss "härifrån" ;
@@ -38,16 +38,16 @@ concrete StructuralSwe of Structural = CatSwe **
how8many_IDet = {s = \\_ => ["hur många"] ; n = Pl ; det = DDef Indef} ;
if_Subj = ss "om" ;
in8front_Prep = ss "framför" ;
i_Pron = mkNP "jag" "mig" "min" "mitt" "mina" SgUtr P1 ;
i_Pron = MorphoSwe.mkNP "jag" "mig" "min" "mitt" "mina" SgUtr P1 ;
in_Prep = ss "i" ;
it_Pron = regNP "det" "dess" SgNeutr ;
it_Pron = MorphoSwe.regNP "det" "dess" SgNeutr ;
less_CAdv = ss "mindre" ;
many_Det = {s = \\_,_ => "många" ; n = Pl ; det = DDef Indef} ;
more_CAdv = ss "mer" ;
most_Predet = {s = gennumForms ["den mesta"] ["det mesta"] ["de flesta"]} ;
much_Det = {s = \\_,_ => "mycket" ; n = Pl ; det = DDef Indef} ;
must_VV =
mkVerb6 "få" "måste" "få" "fick" "måst" "måst" ** {c2 = [] ; lock_VV = <>} ;
mkV "få" "måste" "få" "fick" "måst" "måst" ** {c2 = [] ; lock_VV = <>} ;
no_Phr = ss ["Nej"] ;
on_Prep = ss "på" ;
one_Quant = {s = \\_ => genderForms ["en"] ["ett"] ; n = Sg ; det = DIndef} ;
@@ -58,7 +58,7 @@ concrete StructuralSwe of Structural = CatSwe **
please_Voc = ss "tack" ; ---
possess_Prep = ss "av" ;
quite_Adv = ss "ganska" ;
she_Pron = mkNP "hon" "henne" "hennes" "hennes" "hennes" SgUtr P3 ;
she_Pron = MorphoSwe.mkNP "hon" "henne" "hennes" "hennes" "hennes" SgUtr P3 ;
so_AdA = ss "så" ;
someSg_Det = {s = \\_ => genderForms "någon" "något" ; n = Sg ; det = DIndef} ;
somePl_Det = {s = \\_,_ => "några" ; n = Pl ; det = DIndef} ;
@@ -74,7 +74,7 @@ concrete StructuralSwe of Structural = CatSwe **
therefore_PConj = ss "därför" ;
these_NP = regNP ["de här"] ["det härs"] Plg ;
these_Quant = {s = \\_,_ => ["de här"] ; n = Pl ; det = DDef Def} ;
they_Pron = mkNP "de" "dem" "deras" "deras" "deras" Plg P1 ;
they_Pron = MorphoSwe.mkNP "de" "dem" "deras" "deras" "deras" Plg P1 ;
this_Quant =
{s = \\_ => genderForms ["den här"] ["det här"] ; n = Sg ; det = DDef Def} ;
this_NP = regNP ["det här"] ["det härs"] SgNeutr ;
@@ -86,9 +86,9 @@ concrete StructuralSwe of Structural = CatSwe **
under_Prep = ss "under" ;
very_AdA = ss "mycket" ;
want_VV =
mkVerb6 "vilja" "vill" "vilj" "ville" "velat" "velad" **
mkV "vilja" "vill" "vilj" "ville" "velat" "velad" **
{c2 = [] ; lock_VV = <>} ;
we_Pron = mkNP "vi" "oss" "vår" "vårt" "våra" Plg P1 ;
we_Pron = MorphoSwe.mkNP "vi" "oss" "vår" "vårt" "våra" Plg P1 ;
whatSg_IP = {s = \\_ => "vad" ; gn = SgUtr} ; ---- infl
whatPl_IP = {s = \\_ => "vad" ; gn = Plg} ; ---- infl
when_IAdv = ss "när" ;
@@ -102,14 +102,14 @@ concrete StructuralSwe of Structural = CatSwe **
without_Prep = ss "utan" ;
with_Prep = ss "med" ;
yes_Phr = ss ["ja"] ;
youSg_Pron = mkNP "du" "dig" "din" "ditt" "dina" SgUtr P2 ;
youPl_Pron = mkNP "ni" "er" "er" "ert" "era" Plg P2 ;
youPol_Pron = mkNP "ni" "er" "er" "ert" "era" SgUtr P2 ; --- wrong in refl
youSg_Pron = MorphoSwe.mkNP "du" "dig" "din" "ditt" "dina" SgUtr P2 ;
youPl_Pron = MorphoSwe.mkNP "ni" "er" "er" "ert" "era" Plg P2 ;
youPol_Pron = MorphoSwe.mkNP "ni" "er" "er" "ert" "era" SgUtr P2 ; --- wrong in refl
-- Auxiliaries that are used repeatedly.
oper
vem = mkNP "vem" "vem" "vems" "vems" "vems" SgUtr P3 ;
vem = MorphoSwe.mkNP "vem" "vem" "vems" "vems" "vems" SgUtr P3 ;
}