diff --git a/src/runtime/haskell/LPGF.hs b/src/runtime/haskell/LPGF.hs index 34bb537cd..57e099fcd 100644 --- a/src/runtime/haskell/LPGF.hs +++ b/src/runtime/haskell/LPGF.hs @@ -148,7 +148,7 @@ lin2string l = case l of LFEmpty -> "" LFToken tok -> tok LFTuple [l] -> lin2string l - LFConcat l1 l2 -> unwords [lin2string l1, lin2string l2] + LFConcat l1 l2 -> unwords $ filter (not.null) [lin2string l1, lin2string l2] x -> printf "[%s]" (show x) (!!) :: (Show a) => [a] -> Int -> a diff --git a/testsuite/lpgf/Foods.treebank b/testsuite/lpgf/Foods.treebank index 8985961a5..9e5aee9a0 100644 --- a/testsuite/lpgf/Foods.treebank +++ b/testsuite/lpgf/Foods.treebank @@ -1,19 +1,30 @@ Foods: Pred (That Wine) Delicious FoodsBul: онова вино е превъзходно +FoodsChi: 那 瓶 酒 是 美 味 的 FoodsEng: that wine is delicious +FoodsHeb: היין ההוא טעים Foods: Pred (This Pizza) (Very Boring) FoodsBul: тази пица е много еднообразна +FoodsChi: 这 张 比 萨 饼 是 非 常 难 吃 的 FoodsEng: this pizza is very boring +FoodsHeb: הפיצה הזאת מאוד משעממת Foods: Pred (This Cheese) Fresh FoodsBul: това сирене е свежо +FoodsChi: 这 块 奶 酪 是 新 鲜 的 FoodsEng: this cheese is fresh +FoodsHeb: הגבינה הזאת טריה Foods: Pred (Those Fish) Warm FoodsBul: онези риби са горещи +FoodsChi: 那 几 条 鱼 是 温 热 的 FoodsEng: those fish are warm +FoodsHeb: הדגים ההם חמים Foods: Pred (That (Mod Boring (Mod Italian Pizza))) Expensive FoodsBul: онази еднообразна италианска пица е скъпа +FoodsChi: 那 张 又 难 吃 又 意 大 利 式 的 比 萨 饼 是 昂 贵 的 FoodsEng: that boring Italian pizza is expensive +FoodsHeb: הפיצה האיטלקית המשעממת ההיא יקרה + diff --git a/testsuite/lpgf/FoodsChi.gf b/testsuite/lpgf/FoodsChi.gf new file mode 100644 index 000000000..400457aa2 --- /dev/null +++ b/testsuite/lpgf/FoodsChi.gf @@ -0,0 +1,56 @@ +concrete FoodsChi of Foods = open Prelude in { +flags coding = utf8 ; +lincat + Comment, Item = Str; + Kind = knd ; + Quality = qual ; +lin + Pred = (\itm, ql -> + case ql.hasVery of { + True => itm ++ "是 非 常" ++ ql.s ++ ql.p ; + False => itm ++ "是" ++ ql.s ++ ql.p } ) ; + This kind = "这" ++ kind.c ++ kind.m ++ kind.s ; + That kind = "那" ++ kind.c ++ kind.m ++ kind.s ; + These kind = "这" ++ "几" ++ kind.c ++ kind.m ++ kind.s ; + Those kind = "那" ++ "几" ++ kind.c ++ kind.m ++ kind.s ; + Mod = modifier ; + + Wine = geKind "酒" "瓶" ; + Pizza = geKind "比 萨 饼" "张" ; + Cheese = geKind "奶 酪" "块"; + Fish = geKind "鱼" "条"; + + Very = (\q -> {s = q.s ; p = q.p ; hasVery = True}) ; + Fresh = longQuality "新 鲜" ; + Warm = longQuality "温 热" ; + Italian = longQuality "意 大 利 式" ; + Expensive = longQuality "昂 贵" ; + Delicious = longQuality "美 味" ; + -- this technically translates to "unpalatable" instead of boring + Boring = longQuality "难 吃" ; + +oper + -- lincat aliases + qual : Type = {s,p : Str ; hasVery : Bool} ; + knd : Type = {s,c,m : Str; hasMod : Bool} ; + + -- Constructor functions + mkKind : Str -> Str -> knd = \s,c -> + {s = s ; c = c; m = ""; hasMod = False} ; + geKind : Str -> Str -> knd = \s,cl -> + mkKind s (classifier cl) ; + longQuality : Str -> qual = \s -> + {s = s ; p = "的" ; hasVery = False} ; + modifier : qual -> knd -> knd = \q,k -> + { s = k.s ; c = k.c ; m = modJoin k.hasMod q k.m ; + hasMod = True } ; + + -- Helper functions + classifier : Str -> Str = \s -> + case s of {"" => "个" ; _ => s }; + modJoin : Bool -> qual -> Str -> Str = \bool, q,m -> + case bool of { + True => "又" ++ q.s ++ "又" ++ m ; + False => q.s ++ q.p } ; + +} diff --git a/testsuite/lpgf/FoodsHeb.gf b/testsuite/lpgf/FoodsHeb.gf new file mode 100644 index 000000000..b68b383be --- /dev/null +++ b/testsuite/lpgf/FoodsHeb.gf @@ -0,0 +1,107 @@ + +--(c) 2009 Dana Dannells +-- Licensed under LGPL + +concrete FoodsHeb of Foods = open Prelude in { + + flags coding=utf8 ; + + lincat + Comment = SS ; + Quality = {s: Number => Species => Gender => Str} ; + Kind = {s : Number => Species => Str ; g : Gender ; mod : Modified} ; + Item = {s : Str ; g : Gender ; n : Number ; sp : Species ; mod : Modified} ; + + + lin + Pred item quality = ss (item.s ++ quality.s ! item.n ! Indef ! item.g ) ; + This = det Sg Def "הזה" "הזאת"; + That = det Sg Def "ההוא" "ההיא" ; + These = det Pl Def "האלה" "האלה" ; + Those = det Pl Def "ההם" "ההן" ; + Mod quality kind = { + s = \\n,sp => kind.s ! n ! sp ++ quality.s ! n ! sp ! kind.g; + g = kind.g ; + mod = T + } ; + Wine = regNoun "יין" "יינות" Masc ; + Cheese = regNoun "גבינה" "גבינות" Fem ; + Fish = regNoun "דג" "דגים" Masc ; + Pizza = regNoun "פיצה" "פיצות" Fem ; + Very qual = {s = \\g,n,sp => "מאוד" ++ qual.s ! g ! n ! sp} ; + Fresh = regAdj "טרי" ; + Warm = regAdj "חם" ; + Italian = regAdj2 "איטלקי" ; + Expensive = regAdj "יקר" ; + Delicious = regAdj "טעים" ; + Boring = regAdj2 "משעמם"; + + param + Number = Sg | Pl ; + Gender = Masc | Fem ; + Species = Def | Indef ; + Modified = T | F ; + + oper + Noun : Type = {s : Number => Species => Str ; g : Gender ; mod : Modified } ; + Adj : Type = {s : Number => Species => Gender => Str} ; + + det : Number -> Species -> Str -> Str -> Noun -> + {s : Str ; g :Gender ; n : Number ; sp : Species ; mod : Modified} = + \n,sp,m,f,cn -> { + s = case cn.mod of { _ => cn.s ! n ! sp ++ case cn.g of {Masc => m ; Fem => f} }; + g = cn.g ; + n = n ; + sp = sp ; + mod = cn.mod + } ; + + noun : (gvina,hagvina,gvinot,hagvinot : Str) -> Gender -> Noun = + \gvina,hagvina,gvinot,hagvinot,g -> { + s = table { + Sg => table { + Indef => gvina ; + Def => hagvina + } ; + Pl => table { + Indef => gvinot ; + Def => hagvinot + } + } ; + g = g ; + mod = F + } ; + + regNoun : Str -> Str -> Gender -> Noun = + \gvina,gvinot, g -> + noun gvina (defH gvina) gvinot (defH gvinot) g ; + + defH : Str -> Str = \cn -> + case cn of {_ => "ה" + cn}; + + replaceLastLetter : Str -> Str = \c -> + case c of {"ף" => "פ" ; "ם" => "מ" ; "ן" => "נ" ; "ץ" => "צ" ; "ך" => "כ"; _ => c} ; + + adjective : (_,_,_,_ : Str) -> Adj = + \tov,tova,tovim,tovot -> { + s = table { + Sg => table { + Indef => table { Masc => tov ; Fem => tova } ; + Def => table { Masc => defH tov ; Fem => defH tova } + } ; + Pl => table { + Indef => table {Masc => tovim ; Fem => tovot } ; + Def => table { Masc => defH tovim ; Fem => defH tovot } + } + } + } ; + + regAdj : Str -> Adj = \tov -> + case tov of { to + c@? => + adjective tov (to + replaceLastLetter (c) + "ה" ) (to + replaceLastLetter (c) +"ים" ) (to + replaceLastLetter (c) + "ות" )}; + + regAdj2 : Str -> Adj = \italki -> + case italki of { italk+ c@? => + adjective italki (italk + replaceLastLetter (c) +"ת" ) (italk + replaceLastLetter (c)+ "ים" ) (italk + replaceLastLetter (c) + "ות" )}; + +} -- FoodsHeb diff --git a/testsuite/lpgf/mkTreebank.sh b/testsuite/lpgf/mkTreebank.sh index dc7ce5134..0f62230c0 100755 --- a/testsuite/lpgf/mkTreebank.sh +++ b/testsuite/lpgf/mkTreebank.sh @@ -4,7 +4,16 @@ if [ $# -lt 1 ]; then echo "Must specify trees file" exit 1 fi +TREES=$1 ABSNAME="${1%.*}" -echo "read_file -file=$1 -lines -tree | linearize -treebank | write_file -file=$ABSNAME.treebank" | gf --run $ABSNAME*.gf -echo "Wrote $ABSNAME.treebank" -echo "(you will have to add newlines separating the trees manually)" +TREEBANK="$ABSNAME.treebank" + +# echo "read_file -file=$TREES -lines -tree | linearize -treebank | write_file -file=$TREEBANK" | gf --run $ABSNAME*.gf + +: > $TREEBANK +while read tree; do + echo "linearize -treebank $tree | write_file -file=$TREEBANK -append" | gf --run --quiet $ABSNAME*.gf + echo "" >> $TREEBANK +done < $TREES + +echo "Wrote $TREEBANK"