From fc65b10e0f689a51f2f856b43abfb6d266889a9b Mon Sep 17 00:00:00 2001 From: aarne Date: Sun, 6 Jan 2008 21:05:56 +0000 Subject: [PATCH] dictionary experiment with Finnish verbs --- examples/uusisuomi/Declensions.gf | 2 +- examples/uusisuomi/Makefile | 5 +- examples/uusisuomi/MkLex.hs | 2 +- examples/uusisuomi/Verbal.gf | 8 +- examples/uusisuomi/correct-VDictionary.txt | 100 +++++++++++++++++++++ src/GF/Grammar/Compute.hs | 56 ++++++++---- 6 files changed, 149 insertions(+), 24 deletions(-) create mode 100644 examples/uusisuomi/correct-VDictionary.txt diff --git a/examples/uusisuomi/Declensions.gf b/examples/uusisuomi/Declensions.gf index c9971af50..92e8c368d 100644 --- a/examples/uusisuomi/Declensions.gf +++ b/examples/uusisuomi/Declensions.gf @@ -466,7 +466,7 @@ resource Declensions = ResFin ** open MorphoFin,CatFin,Prelude in { "mm" + e => "mp" + e ; "rr" + e => "rt" + e ; "ll" + a => "lt" + a ; - h@("h" | "l") + "j" + e => h + "k" + e ; -- pohje/lahje impossible + h@("h" | "l") + "je" + e => h + "ke" ; -- pohje/lahje impossible ("tk" | "hk" | "sk" | "sp" | "st") + _ => nke ; -- viuhke,kuiske a + k@("k"|"p"|"t") + e@("e"|"a"|"ä"|"u"|"i"|"o"|"ö") => a + k + k + e ; a + "d" + e@("e"|"a"|"ä"|"u"|"i"|"o"|"ö") => a + "t" + e ; diff --git a/examples/uusisuomi/Makefile b/examples/uusisuomi/Makefile index 43899cbc1..5b0d3133e 100644 --- a/examples/uusisuomi/Makefile +++ b/examples/uusisuomi/Makefile @@ -4,8 +4,9 @@ CAT=N all: nouns verbs: - export CAT=V ; export LEX=VNSSK ; make -e tests - export CAT=V ; export LEX=VOmat ; make -e tests +# export CAT=V ; export LEX=VNSSK ; make -e tests +# export CAT=V ; export LEX=VOmat ; make -e tests + export CAT=V ; export LEX=VDictionary ; make -e tests cat all-diff-V* >all-differences-V cat all-differences-V diff --git a/examples/uusisuomi/MkLex.hs b/examples/uusisuomi/MkLex.hs index faf980d75..9d6525aee 100644 --- a/examples/uusisuomi/MkLex.hs +++ b/examples/uusisuomi/MkLex.hs @@ -57,7 +57,7 @@ mkLex "V" _ line = case words line of num:sana:_:_:_:_:_:_:sanan:_ -> do let nimi = "n" ++ init num ++ "_" ++ sana putStrLn $ "lin " ++ nimi ++ - "_V = mk2V <\"" ++ sana ++ "\", \"" ++ sanan ++ "\"> ;" + "_V = mkV \"" ++ sana ++ "\" \"" ++ sanan ++ "\" ;" _ -> return () mkLex "N" 2 line = case words line of diff --git a/examples/uusisuomi/Verbal.gf b/examples/uusisuomi/Verbal.gf index cdf61f88e..5cf4b11d6 100644 --- a/examples/uusisuomi/Verbal.gf +++ b/examples/uusisuomi/Verbal.gf @@ -9,7 +9,7 @@ resource Verbal = ResFin ** mkV = overload { mkV : (huutaa : Str) -> V = mk1V ; - mkV : (huutaa,huusi : Str) -> V = \s,t -> mk2V ; + mkV : (huutaa,huusi : Str) -> V = mk2V ; } ; showV : V -> Utt = \v -> ss ( @@ -27,8 +27,7 @@ resource Verbal = ResFin ** ) ** {lock_Utt = <>} ; mk1V : Str -> V = \s -> vforms2V (vForms1 s) ; - mk2V : (_ : Str * Str) -> V = \st -> - vforms2V (vForms2 st.p1 st.p2) ; + mk2V : (_,_ : Str) -> V = \s,t -> vforms2V (vForms2 s t) ; vForms1 : Str -> VForms = \ottaa -> let @@ -45,6 +44,9 @@ resource Verbal = ResFin ** cHukkua ottaa (ota + "n") ; _ + ("l" | "n" | "r") + ("taa" | "tää") => cOttaa ottaa (ota + "n") (ots + "in") (ots + "i") ; + ("" | C_) + ("a" | "e" | "i" | "o" | "u") + C_ + _ + + ("a" | "e" | "i" | "o" | "u") + _ + "aa" => + cOttaa ottaa (ota + "n") (ot + "in") (ott + "i") ; ("" | C_) + ("a" | "e" | "i") + _ + "aa" => cOttaa ottaa (ota + "n") (ot + "oin") (ott + "oi") ; _ + ("aa" | "ää") => diff --git a/examples/uusisuomi/correct-VDictionary.txt b/examples/uusisuomi/correct-VDictionary.txt new file mode 100644 index 000000000..1a6da14bf --- /dev/null +++ b/examples/uusisuomi/correct-VDictionary.txt @@ -0,0 +1,100 @@ +aikoa aion aikoo aikovat aikokaa aiotaan aioin aikoi aikoisi aikonut aiottu + +alentaa alennan alentaa alentavat alentakaa alennetaan alensin alensi alentaisi alentanut alennettu + +ansioitua ansioidun ansioituu ansioituvat ansioitukaa ansioidutaan ansioiduin ansioitui ansioituisi ansioitunut ansioiduttu + +arvostaa arvostan arvostaa arvostavat arvostakaa arvostetaan arvostin arvosti arvostaisi arvostanut arvostettu + +avustaa avustan avustaa avustavat avustakaa avustetaan avustin avusti avustaisi avustanut avustettu + +dominoida dominoin dominoi dominoivat dominoikaa dominoidaan dominoin dominoi dominoisi dominoinut dominoitu + +elämöidä elämöin elämöi elämöivät elämöikää elämöidään elämöin elämöi elämöisi elämöinyt elämöity + +epäilyttää epäilytän epäilyttää epäilyttävät epäilyttäkää epäilytetään epäilytin epäilytti epäilyttäisi epäilyttänyt epäilytetty + +esitellä esittelen esittelee esittelevät esitelkää esitellään esittelin esitteli esittelisi esitellyt esitelty + +fakturoida fakturoin fakturoi fakturoivat fakturoikaa fakturoidaan fakturoin fakturoi fakturoisi fakturoinut fakturoitu + +halata halaan halaa halaavat halatkaa halataan halasin halasi halaisi halannut halattu + +harjata harjaan harjaa harjaavat harjatkaa harjataan harjasin harjasi harjaisi harjannut harjattu + +hengittää hengitän hengittää hengittävät hengittäkää hengitetään hengitin hengitti hengittäisi hengittänyt hengitetty + +hihittää hihitän hihittää hihittävät hihittäkää hihitetään hihitin hihitti hihittäisi hihittänyt hihitetty + +hullutella hulluttelen hulluttelee hulluttelevat hullutelkaa hullutellaan hulluttelin hullutteli hulluttelisi hullutellut hulluteltu + +huuhtoutua huuhtoudun huuhtoutuu huuhtoutuvat huuhtoutukaa huuhtoudutaan huuhtouduin huuhtoutui huuhtoutuisi huuhtoutunut huuhtouduttu + +häpäistä häpäisen häpäisee häpäisevät häpäiskää häpäistään häpäisin häpäisi häpäisisi häpäissyt häpäisty + +ikävystyttää ikävystytän ikävystyttää ikävystyttävät ikävystyttäkää ikävystytetään ikävystytin ikävystytti ikävystyttäisi ikävystyttänyt ikävystytetty + +isännöidä isännöin isännöi isännöivät isännöikää isännöidään isännöin isännöi isännöisi isännöinyt isännöity + +jatkua jatkun jatkuu jatkuvat jatkukaa jatkutaan jatkuin jatkui jatkuisi jatkunut jatkuttu + +jupista jupisen jupisee jupisevat jupiskaa jupistaan jupisin jupisi jupisisi jupissut jupistu + +jätättää jätätän jätättää jätättävät jätättäkää jätätetään jätätin jätätti jätättäisi jätättänyt jätätetty + +kalastaa kalastan kalastaa kalastavat kalastakaa kalastetaan kalastin kalasti kalastaisi kalastanut kalastettu + +kansoittaa kansoitan kansoittaa kansoittavat kansoittakaa kansoitetaan kansoitin kansoitti kansoittaisi kansoittanut kansoitettu + +kaulia kaulin kaulii kaulivat kaulikaa kaulitaan kaulin kauli kaulisi kaulinut kaulittu + +kellua kellun kelluu kelluvat kellukaa kellutaan kelluin kellui kelluisi kellunut kelluttu + +kierittää kieritän kierittää kierittävät kierittäkää kieritetään kieritin kieritti kierittäisi kierittänyt kieritetty + +kipinöidä kipinöin kipinöi kipinöivät kipinöikää kipinöidään kipinöin kipinöi kipinöisi kipinöinyt kipinöity + +kokkaroitua kokkaroidun kokkaroituu kokkaroituvat kokkaroitukaa kokkaroidutaan kokkaroiduin kokkaroitui kokkaroituisi kokkaroitunut kokkaroiduttu + +korjauttaa korjautan korjauttaa korjauttavat korjauttakaa korjautetaan korjautin korjautti korjauttaisi korjauttanut korjautettu + +kukistaa kukistan kukistaa kukistavat kukistakaa kukistetaan kukistin kukisti kukistaisi kukistanut kukistettu + +kuntouttaa kuntoutan kuntouttaa kuntouttavat kuntouttakaa kuntoutetaan kuntoutin kuntoutti kuntouttaisi kuntouttanut kuntoutettu + +kyllästyttää kyllästytän kyllästyttää kyllästyttävät kyllästyttäkää kyllästytetään kyllästytin kyllästytti kyllästyttäisi kyllästyttänyt kyllästytetty + +käskeä käsken käskee käskevät käskekää käsketään käskin käski käskisi käskenyt käsketty + +lainata lainaan lainaa lainaavat lainatkaa lainataan lainasin lainasi lainaisi lainannut lainattu + +laskostaa laskostan laskostaa laskostavat laskostakaa laskostetaan laskostin laskosti laskostaisi laskostanut laskostettu + +lihoa lihon lihoo lihovat lihokaa lihotaan lihoin lihoi lihoisi lihonut lihottu + +liuottaa liuotan liuottaa liuottavat liuottakaa liuotetaan liuotin liuotti liuottaisi liuottanut liuotettu + +luotsata luotsaan luotsaa luotsaavat luotsatkaa luotsataan luotsasin luotsasi luotsaisi luotsannut luotsattu + +läpäistä läpäisen läpäisee läpäisevät läpäiskää läpäistään läpäisin läpäisi läpäisisi läpäissyt läpäisty + +maksoittaa maksoitan maksoittaa maksoittavat maksoittakaa maksoitetaan maksoitin maksoitti maksoittaisi maksoittanut maksoitettu + +menestyä menestyn menestyy menestyvät menestykää menestytään menestyin menestyi menestyisi menestynyt menestytty + +mitätöidä mitätöin mitätöi mitätöivät mitätöikää mitätöidään mitätöin mitätöi mitätöisi mitätöinyt mitätöity + +muokata muokkaan muokkaa muokkaavat muokatkaa muokataan muokkasin muokkasi muokkaisi muokannut muokattu + +naamioida naamioin naamioi naamioivat naamioikaa naamioidaan naamioin naamioi naamioisi naamioinut naamioitu + +niiskuttaa niiskutan niiskuttaa niiskuttavat niiskuttakaa niiskutetaan niiskutin niiskutti niiskuttaisi niiskuttanut niiskutettu + +nähdä näen näkee näkevät nähkää nähdään näin näki näkisi nähnyt nähty + +ohjata ohjaan ohjaa ohjaavat ohjatkaa ohjataan ohjasin ohjasi ohjaisi ohjannut ohjattu + +opiskella opiskelen opiskelee opiskelevat opiskelkaa opiskellaan opiskelin opiskeli opiskelisi opiskellut opiskeltu + +paaduttaa paadutan paaduttaa paaduttavat paaduttakaa paadutetaan paadutin paadutti paaduttaisi paaduttanut paadutettu + diff --git a/src/GF/Grammar/Compute.hs b/src/GF/Grammar/Compute.hs index f75a092b1..e43cb5b8c 100644 --- a/src/GF/Grammar/Compute.hs +++ b/src/GF/Grammar/Compute.hs @@ -76,26 +76,27 @@ computeTermOpt rec gr = comp where return $ Prod x a' b' -- beta-convert - App f a -> do - f' <- comp g f - a' <- comp g a - case (f',a') of - (Abs x b, FV as) -> - mapM (\c -> comp (ext x c g) b) as >>= return . variants - (_, FV as) -> mapM (\c -> comp g (App f' c)) as >>= return . variants - (FV fs, _) -> mapM (\c -> comp g (App c a')) fs >>= return . variants - (Abs x b,_) -> comp (ext x a' g) b + App f a -> case appForm t of + (h,as) | length as > 1 -> do + h' <- comp g h + as' <- mapM (comp g) as + case h' of - (QC _ _,_) -> returnC $ App f' a' + c@(QC _ _) -> do + return $ mkApp c as' + Q (IC "Predef") f -> do + (t',b) <- appPredefined (mkApp h' as') + if b then return t' else comp g t' - (Alias _ _ d, _) -> comp g (App d a') + Abs _ _ -> do + let (xs,b) = termFormCnc h' + let g' = (zip xs as') ++ g + let as2 = drop (length xs) as' + b' <- comp g' b + if null as2 then return b' else comp g (mkApp b' as2) - (S (T i cs) e,_) -> prawitz g i (flip App a') cs e - (S (V i cs) e,_) -> prawitzV g i (flip App a') cs e - - _ -> do - (t',b) <- appPredefined (App f' a') - if b then return t' else comp g t' + _ -> compApp g (mkApp h' as') + _ -> compApp g t P t l | isLockLabel l -> return $ R [] ---- a workaround 18/2/2005: take this away and find the reason @@ -319,6 +320,27 @@ computeTermOpt rec gr = comp where where + compApp g (App f a) = do + f' <- comp g f + a' <- comp g a + case (f',a') of + (Abs x b, FV as) -> + mapM (\c -> comp (ext x c g) b) as >>= return . variants + (_, FV as) -> mapM (\c -> comp g (App f' c)) as >>= return . variants + (FV fs, _) -> mapM (\c -> comp g (App c a')) fs >>= return . variants + (Abs x b,_) -> comp (ext x a' g) b + + (QC _ _,_) -> returnC $ App f' a' + + (Alias _ _ d, _) -> comp g (App d a') + + (S (T i cs) e,_) -> prawitz g i (flip App a') cs e + (S (V i cs) e,_) -> prawitzV g i (flip App a') cs e + + _ -> do + (t',b) <- appPredefined (App f' a') + if b then return t' else comp g t' + look p c | rec = lookupResDef gr p c >>= comp [] | otherwise = lookupResDef gr p c