diff --git a/src/runtime/haskell/LPGF.hs b/src/runtime/haskell/LPGF.hs index b7c170cdb..667b0d621 100644 --- a/src/runtime/haskell/LPGF.hs +++ b/src/runtime/haskell/LPGF.hs @@ -131,7 +131,8 @@ linearizeConcreteText concr expr = lin2string $ lin (expr2tree expr) Fun f as -> case Map.lookup f (lins concr) of Just t -> eval (map lin as) t - _ -> error $ printf "Lookup failed for function: %s" (showCId f) + -- _ -> error $ printf "Lookup failed for function: %s" (showCId f) + _ -> LFToken $ T.pack $ printf "[%s]" (showCId f) x -> error $ printf "Cannot lin: %s" (prTree x) -- | Evaluation context is a sequence of terms diff --git a/testsuite/lpgf/Foods.treebank b/testsuite/lpgf/Foods.treebank index 395aad0e3..95af23fda 100644 --- a/testsuite/lpgf/Foods.treebank +++ b/testsuite/lpgf/Foods.treebank @@ -1,45 +1,75 @@ Foods: Pred (That Wine) Delicious +FoodsAfr: daardie wyn is heerlik +FoodsAmh: ያ ወይን ጣፋጭ ነው:: FoodsBul: онова вино е превъзходно +FoodsCat: aquell vi és deliciós FoodsChi: 那 瓶 酒 是 美 味 的 +FoodsCze: tamto víno je vynikající +FoodsDut: die wijn is lekker FoodsEng: that wine is delicious FoodsFin: tuo viini on herkullinen FoodsFre: ce vin est délicieux +FoodsGer: jener Wein ist köstlich FoodsHeb: היין ההוא טעים FoodsSwe: det där vinet är läckert Foods: Pred (This Pizza) (Very Boring) +FoodsAfr: hierdie pizza is baie vervelig +FoodsAmh: ይህ [Pizza] በጣም አስቀያሚ ነው:: FoodsBul: тази пица е много еднообразна +FoodsCat: aquesta pizza és molt aburrida FoodsChi: 这 张 比 萨 饼 是 非 常 难 吃 的 +FoodsCze: tato pizza je velmi nudná +FoodsDut: deze pizza is erg saai FoodsEng: this pizza is very boring FoodsFin: tämä pizza on erittäin tylsä FoodsFre: cette pizza est très ennuyeuse +FoodsGer: diese Pizza ist sehr langweilig FoodsHeb: הפיצה הזאת מאוד משעממת FoodsSwe: den här pizzan är mycket tråkig Foods: Pred (This Cheese) Fresh +FoodsAfr: hierdie kaas is vars +FoodsAmh: ይህ አይብ አዲስ ነው:: FoodsBul: това сирене е свежо +FoodsCat: aquest formatge és fresc FoodsChi: 这 块 奶 酪 是 新 鲜 的 +FoodsCze: tento sýr je čerstvý +FoodsDut: deze kaas is vers FoodsEng: this cheese is fresh FoodsFin: tämä juusto on tuore FoodsFre: ce fromage est frais +FoodsGer: dieser Käse ist frisch FoodsHeb: הגבינה הזאת טריה FoodsSwe: den här osten är färsk Foods: Pred (Those Fish) Warm +FoodsAfr: daardie visse is warm +FoodsAmh: [Those] ትኩስ ነው:: FoodsBul: онези риби са горещи +FoodsCat: aquells peixos són calents FoodsChi: 那 几 条 鱼 是 温 热 的 +FoodsCze: tamty ryby jsou teplé +FoodsDut: die vissen zijn warm FoodsEng: those fish are warm FoodsFin: nuo kalat ovat lämpimiä FoodsFre: ces poissons sont chauds +FoodsGer: jene Fische sind warm FoodsHeb: הדגים ההם חמים FoodsSwe: de där fiskarna är varma Foods: Pred (That (Mod Boring (Mod Italian Pizza))) Expensive +FoodsAfr: daardie vervelige Italiaanse pizza is duur +FoodsAmh: ያ አስቀያሚ የጥልያን [Pizza] ውድ ነው:: FoodsBul: онази еднообразна италианска пица е скъпа +FoodsCat: aquella pizza italiana aburrida és cara FoodsChi: 那 张 又 难 吃 又 意 大 利 式 的 比 萨 饼 是 昂 贵 的 +FoodsCze: tamta nudná italská pizza je drahá +FoodsDut: die saaie Italiaanse pizza is duur FoodsEng: that boring Italian pizza is expensive FoodsFin: tuo tylsä italialainen pizza on kallis FoodsFre: cette pizza italienne ennuyeuse est chère +FoodsGer: jene langweilige italienische Pizza ist teuer FoodsHeb: הפיצה האיטלקית המשעממת ההיא יקרה FoodsSwe: den där tråkiga italienska pizzan är dyr diff --git a/testsuite/lpgf/FoodsAfr.gf b/testsuite/lpgf/FoodsAfr.gf new file mode 100644 index 000000000..a9c4eec77 --- /dev/null +++ b/testsuite/lpgf/FoodsAfr.gf @@ -0,0 +1,77 @@ +-- (c) 2009 Laurette Pretorius Sr & Jr and Ansu Berg under LGPL +--# -coding=latin1 + +concrete FoodsAfr of Foods = open Prelude, Predef in{ + lincat + Comment = {s: Str} ; + Kind = {s: Number => Str} ; + Item = {s: Str ; n: Number} ; + Quality = {s: AdjAP => Str} ; + + lin + Pred item quality = {s = item.s ++ "is" ++ (quality.s ! Predic)}; + This kind = {s = "hierdie" ++ (kind.s ! Sg); n = Sg}; + That kind = {s = "daardie" ++ (kind.s ! Sg); n = Sg}; + These kind = {s = "hierdie" ++ (kind.s ! Pl); n = Pl}; + Those kind = {s = "daardie" ++ (kind.s ! Pl); n = Pl}; + Mod quality kind = {s = table{n => (quality.s ! Attr) ++ (kind.s!n)}}; + + Wine = declNoun_e "wyn"; + Cheese = declNoun_aa "kaas"; + Fish = declNoun_ss "vis"; + Pizza = declNoun_s "pizza"; + + Very quality = veryAdj quality; + + Fresh = regAdj "vars"; + Warm = regAdj "warm"; + Italian = smartAdj_e "Italiaans"; + Expensive = regAdj "duur"; + Delicious = smartAdj_e "heerlik"; + Boring = smartAdj_e "vervelig"; + + param + AdjAP = Attr | Predic ; + Number = Sg | Pl ; + + oper + --Noun operations (wyn, kaas, vis, pizza) + + declNoun_aa: Str -> {s: Number => Str} = \x -> + let v = tk 2 x + in + {s = table{Sg => x ; Pl => v + (last x) +"e"}}; + + declNoun_e: Str -> {s: Number => Str} = \x -> {s = table{Sg => x ; Pl => x + "e"}} ; + declNoun_s: Str -> {s: Number => Str} = \x -> {s = table{Sg => x ; Pl => x + "s"}} ; + + declNoun_ss: Str -> {s: Number => Str} = \x -> {s = table{Sg => x ; Pl => x + (last x) + "e"}} ; + + + --Adjective operations + + mkAdj : Str -> Str -> {s: AdjAP => Str} = \x,y -> {s = table{Attr => x; Predic => y}}; + + declAdj_e : Str -> {s : AdjAP=> Str} = \x -> mkAdj (x + "e") x; + declAdj_g : Str -> {s : AdjAP=> Str} = \w -> + let v = init w + in mkAdj (v + "") w ; + + declAdj_oog : Str -> {s : AdjAP=> Str} = \w -> + let v = init w + in + let i = init v + in mkAdj (i + "") w ; + + regAdj : Str -> {s : AdjAP=> Str} = \x -> mkAdj x x; + + veryAdj : {s: AdjAP => Str} -> {s : AdjAP=> Str} = \x -> {s = table{a => "baie" ++ (x.s!a)}}; + + + smartAdj_e : Str -> {s : AdjAP=> Str} = \a -> case a of + { + _ + "oog" => declAdj_oog a ; + _ + ("e" | "ie" | "o" | "oe") + "g" => declAdj_g a ; + _ => declAdj_e a + }; +} diff --git a/testsuite/lpgf/FoodsAmh.gf b/testsuite/lpgf/FoodsAmh.gf new file mode 100644 index 000000000..e8915d86f --- /dev/null +++ b/testsuite/lpgf/FoodsAmh.gf @@ -0,0 +1,21 @@ +concrete FoodsAmh of Foods ={ + flags coding = utf8; + lincat + Comment,Item,Kind,Quality = Str; + lin + Pred item quality = item ++ quality++ "ነው::" ; + This kind = "ይህ" ++ kind; + That kind = "ያ" ++ kind; + Mod quality kind = quality ++ kind; + Wine = "ወይን"; + Cheese = "አይብ"; + Fish = "ዓሳ"; + Very quality = "በጣም" ++ quality; + Fresh = "አዲስ"; + Warm = "ትኩስ"; + Italian = "የጥልያን"; + Expensive = "ውድ"; + Delicious = "ጣፋጭ"; + Boring = "አስቀያሚ"; + +} \ No newline at end of file diff --git a/testsuite/lpgf/FoodsCat.gf b/testsuite/lpgf/FoodsCat.gf new file mode 100644 index 000000000..35e4efba6 --- /dev/null +++ b/testsuite/lpgf/FoodsCat.gf @@ -0,0 +1,6 @@ + +-- (c) 2009 Jordi Saludes under LGPL + +concrete FoodsCat of Foods = FoodsI with + (Syntax = SyntaxCat), + (LexFoods = LexFoodsCat) ; diff --git a/testsuite/lpgf/FoodsCze.gf b/testsuite/lpgf/FoodsCze.gf new file mode 100644 index 000000000..3fec68141 --- /dev/null +++ b/testsuite/lpgf/FoodsCze.gf @@ -0,0 +1,35 @@ +-- (c) 2011 Katerina Bohmova under LGPL + +concrete FoodsCze of Foods = open ResCze in { + flags + coding = utf8 ; + lincat + Comment = {s : Str} ; + Quality = Adjective ; + Kind = Noun ; + Item = NounPhrase ; + lin + Pred item quality = + {s = item.s ++ copula ! item.n ++ + quality.s ! item.g ! item.n} ; + This = det Sg "tento" "tato" "toto" ; + That = det Sg "tamten" "tamta" "tamto" ; + These = det Pl "tyto" "tyto" "tato" ; + Those = det Pl "tamty" "tamty" "tamta" ; + Mod quality kind = { + s = \\n => quality.s ! kind.g ! n ++ kind.s ! n ; + g = kind.g + } ; + Wine = noun "víno" "vína" Neutr ; + Cheese = noun "sýr" "sýry" Masc ; + Fish = noun "ryba" "ryby" Fem ; + Pizza = noun "pizza" "pizzy" Fem ; + Very qual = {s = \\g,n => "velmi" ++ qual.s ! g ! n} ; + Fresh = regAdj "čerstv" ; + Warm = regAdj "tepl" ; + Italian = regAdj "italsk" ; + Expensive = regAdj "drah" ; + Delicious = regnfAdj "vynikající" ; + Boring = regAdj "nudn" ; +} + diff --git a/testsuite/lpgf/FoodsDut.gf b/testsuite/lpgf/FoodsDut.gf new file mode 100644 index 000000000..d4855e5c6 --- /dev/null +++ b/testsuite/lpgf/FoodsDut.gf @@ -0,0 +1,58 @@ +-- (c) 2009 Femke Johansson under LGPL + +concrete FoodsDut of Foods = { + + lincat + Comment = {s : Str}; + Quality = {s : AForm => Str}; + Kind = { s : Number => Str}; + Item = {s : Str ; n : Number}; + + lin + Pred item quality = + {s = item.s ++ copula ! item.n ++ quality.s ! APred}; + This = det Sg "deze"; + These = det Pl "deze"; + That = det Sg "die"; + Those = det Pl "die"; + + Mod quality kind = + {s = \\n => quality.s ! AAttr ++ kind.s ! n}; + Wine = regNoun "wijn"; + Cheese = noun "kaas" "kazen"; + Fish = noun "vis" "vissen"; + Pizza = noun "pizza" "pizza's"; + + Very a = {s = \\f => "erg" ++ a.s ! f}; + + Fresh = regadj "vers"; + Warm = regadj "warm"; + Italian = regadj "Italiaans"; + Expensive = adj "duur" "dure"; + Delicious = regadj "lekker"; + Boring = regadj "saai"; + + param + Number = Sg | Pl; + AForm = APred | AAttr; + + oper + det : Number -> Str -> + {s : Number => Str} -> {s : Str ; n: Number} = + \n,det,noun -> {s = det ++ noun.s ! n ; n=n}; + + noun : Str -> Str -> {s : Number => Str} = + \man,men -> {s = table {Sg => man; Pl => men}}; + + regNoun : Str -> {s : Number => Str} = + \wijn -> noun wijn (wijn + "en"); + + regadj : Str -> {s : AForm => Str} = + \koud -> adj koud (koud+"e"); + + adj : Str -> Str -> {s : AForm => Str} = + \duur, dure -> {s = table {APred => duur; AAttr => dure}}; + + copula : Number => Str = + table {Sg => "is" ; Pl => "zijn"}; +} diff --git a/testsuite/lpgf/FoodsGer.gf b/testsuite/lpgf/FoodsGer.gf new file mode 100644 index 000000000..df3a371de --- /dev/null +++ b/testsuite/lpgf/FoodsGer.gf @@ -0,0 +1,6 @@ + +-- (c) 2009 Aarne Ranta under LGPL + +concrete FoodsGer of Foods = FoodsI with + (Syntax = SyntaxGer), + (LexFoods = LexFoodsGer) ; diff --git a/testsuite/lpgf/LexFoodsCat.gf b/testsuite/lpgf/LexFoodsCat.gf new file mode 100644 index 000000000..624fc98c8 --- /dev/null +++ b/testsuite/lpgf/LexFoodsCat.gf @@ -0,0 +1,18 @@ +-- (c) 2009 Jordi Saludes under LGPL + +instance LexFoodsCat of LexFoods = + open SyntaxCat, ParadigmsCat, (M = MorphoCat) in { + flags + coding = utf8 ; + oper + wine_N = mkN "vi" "vins" M.Masc ; + pizza_N = mkN "pizza" ; + cheese_N = mkN "formatge" ; + fish_N = mkN "peix" "peixos" M.Masc; + fresh_A = mkA "fresc" "fresca" "frescos" "fresques" "frescament"; + warm_A = mkA "calent" ; + italian_A = mkA "italià" "italiana" "italians" "italianes" "italianament" ; + expensive_A = mkA "car" ; + delicious_A = mkA "deliciós" "deliciosa" "deliciosos" "delicioses" "deliciosament"; + boring_A = mkA "aburrit" "aburrida" "aburrits" "aburrides" "aburridament" ; +} diff --git a/testsuite/lpgf/LexFoodsGer.gf b/testsuite/lpgf/LexFoodsGer.gf new file mode 100644 index 000000000..5df504d8c --- /dev/null +++ b/testsuite/lpgf/LexFoodsGer.gf @@ -0,0 +1,17 @@ +-- (c) 2009 Aarne Ranta under LGPL +--# -coding=latin1 + +instance LexFoodsGer of LexFoods = + open SyntaxGer, ParadigmsGer in { + oper + wine_N = mkN "Wein" ; + pizza_N = mkN "Pizza" "Pizzen" feminine ; + cheese_N = mkN "Kse" "Kse" masculine ; + fish_N = mkN "Fisch" ; + fresh_A = mkA "frisch" ; + warm_A = mkA "warm" "wrmer" "wrmste" ; + italian_A = mkA "italienisch" ; + expensive_A = mkA "teuer" ; + delicious_A = mkA "kstlich" ; + boring_A = mkA "langweilig" ; +} diff --git a/testsuite/lpgf/ResCze.gf b/testsuite/lpgf/ResCze.gf new file mode 100644 index 000000000..56b4aa6ee --- /dev/null +++ b/testsuite/lpgf/ResCze.gf @@ -0,0 +1,46 @@ +-- (c) 2011 Katerina Bohmova under LGPL + +resource ResCze = open Prelude in { + flags + coding = utf8 ; + param + Number = Sg | Pl ; + Gender = Masc | Fem | Neutr; + oper + NounPhrase : Type = + {s : Str ; g : Gender ; n : Number} ; + Noun : Type = {s : Number => Str ; g : Gender} ; + Adjective : Type = {s : Gender => Number => Str} ; + + det : Number -> Str -> Str -> Str -> Noun -> NounPhrase = + \n,m,f,ne,cn -> { + s = table {Masc => m ; Fem => f; Neutr => ne} ! cn.g ++ + cn.s ! n ; + g = cn.g ; + n = n + } ; + noun : Str -> Str -> Gender -> Noun = + \muz,muzi,g -> { + s = table {Sg => muz ; Pl => muzi} ; + g = g + } ; + adjective : (msg,fsg,nsg,mpl,fpl,npl : Str) -> Adjective = + \msg,fsg,nsg,mpl,fpl,npl -> { + s = table { + Masc => table {Sg => msg ; Pl => mpl} ; + Fem => table {Sg => fsg ; Pl => fpl} ; + Neutr => table {Sg => nsg ; Pl => npl} + } + } ; + regAdj : Str -> Adjective = + \mlad -> + adjective (mlad+"ý") (mlad+"á") (mlad+"é") + (mlad+"é") (mlad+"é") (mlad+"á") ; + regnfAdj : Str -> Adjective = + \vynikajici -> + adjective vynikajici vynikajici vynikajici + vynikajici vynikajici vynikajici; + copula : Number => Str = + table {Sg => "je" ; Pl => "jsou"} ; +} +