mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-09 04:59:31 -06:00
Generalise testsuite script to use treebank files, add FoodEng
This commit is contained in:
John J. Camilleri
@@ -153,5 +153,6 @@ lin2string :: LinFun -> String
|
||||
lin2string l = case l of
|
||||
LFEmpty -> ""
|
||||
LFToken tok -> tok
|
||||
LFTuple [l] -> lin2string l
|
||||
LFConcat l1 l2 -> unwords [lin2string l1, lin2string l2]
|
||||
x -> printf "[%s]" (show x)
|
||||
|
||||
15
testsuite/lpgf/Foods.gf
Normal file
15
testsuite/lpgf/Foods.gf
Normal file
@@ -0,0 +1,15 @@
|
||||
-- (c) 2009 Aarne Ranta under LGPL
|
||||
|
||||
abstract Foods = {
|
||||
flags startcat = Comment ;
|
||||
cat
|
||||
Comment ; Item ; Kind ; Quality ;
|
||||
fun
|
||||
Pred : Item -> Quality -> Comment ;
|
||||
This, That, These, Those : Kind -> Item ;
|
||||
Mod : Quality -> Kind -> Kind ;
|
||||
Wine, Cheese, Fish, Pizza : Kind ;
|
||||
Very : Quality -> Quality ;
|
||||
Fresh, Warm, Italian,
|
||||
Expensive, Delicious, Boring : Quality ;
|
||||
}
|
||||
29
testsuite/lpgf/Foods.trees
Normal file
29
testsuite/lpgf/Foods.trees
Normal file
@@ -0,0 +1,29 @@
|
||||
Foods: Pred (This Pizza) (Very Boring)
|
||||
FoodsEng: this pizza is very boring
|
||||
|
||||
Foods: Pred (That Pizza) Delicious
|
||||
FoodsEng: that pizza is delicious
|
||||
|
||||
Foods: Pred (That Wine) Boring
|
||||
FoodsEng: that wine is boring
|
||||
|
||||
Foods: Pred (This Cheese) Fresh
|
||||
FoodsEng: this cheese is fresh
|
||||
|
||||
Foods: Pred (Those Fish) Boring
|
||||
FoodsEng: those fish are boring
|
||||
|
||||
Foods: Pred (This Cheese) Warm
|
||||
FoodsEng: this cheese is warm
|
||||
|
||||
Foods: Pred (That (Mod Boring (Mod Italian Pizza))) Italian
|
||||
FoodsEng: that boring Italian pizza is Italian
|
||||
|
||||
Foods: Pred (Those Cheese) Expensive
|
||||
FoodsEng: those cheeses are expensive
|
||||
|
||||
Foods: Pred (Those Wine) Italian
|
||||
FoodsEng: those wines are Italian
|
||||
|
||||
Foods: Pred (This Wine) Boring
|
||||
FoodsEng: this wine is boring
|
||||
43
testsuite/lpgf/FoodsEng.gf
Normal file
43
testsuite/lpgf/FoodsEng.gf
Normal file
@@ -0,0 +1,43 @@
|
||||
-- (c) 2009 Aarne Ranta under LGPL
|
||||
|
||||
concrete FoodsEng of Foods = {
|
||||
flags language = en_US;
|
||||
lincat
|
||||
Comment, Quality = {s : Str} ;
|
||||
Kind = {s : Number => Str} ;
|
||||
Item = {s : Str ; n : Number} ;
|
||||
lin
|
||||
Pred item quality =
|
||||
{s = item.s ++ copula ! item.n ++ quality.s} ;
|
||||
This = det Sg "this" ;
|
||||
That = det Sg "that" ;
|
||||
These = det Pl "these" ;
|
||||
Those = det Pl "those" ;
|
||||
Mod quality kind =
|
||||
{s = \\n => quality.s ++ kind.s ! n} ;
|
||||
Wine = regNoun "wine" ;
|
||||
Cheese = regNoun "cheese" ;
|
||||
Fish = noun "fish" "fish" ;
|
||||
Pizza = regNoun "pizza" ;
|
||||
Very a = {s = "very" ++ a.s} ;
|
||||
Fresh = adj "fresh" ;
|
||||
Warm = adj "warm" ;
|
||||
Italian = adj "Italian" ;
|
||||
Expensive = adj "expensive" ;
|
||||
Delicious = adj "delicious" ;
|
||||
Boring = adj "boring" ;
|
||||
param
|
||||
Number = Sg | Pl ;
|
||||
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} =
|
||||
\car -> noun car (car + "s") ;
|
||||
adj : Str -> {s : Str} =
|
||||
\cold -> {s = cold} ;
|
||||
copula : Number => Str =
|
||||
table {Sg => "is" ; Pl => "are"} ;
|
||||
}
|
||||
72
testsuite/lpgf/Walking.hs
Normal file
72
testsuite/lpgf/Walking.hs
Normal file
@@ -0,0 +1,72 @@
|
||||
import LPGF
|
||||
import PGF (Tree, mkCId, mkApp)
|
||||
|
||||
import qualified Data.Map as Map
|
||||
|
||||
main = return ()
|
||||
|
||||
-- Pred John Walk
|
||||
tree1 :: Tree
|
||||
tree1 = mkApp (mkCId "Pred") [mkApp (mkCId "John") [], mkApp (mkCId "Walk") []]
|
||||
|
||||
-- Pred We Walk
|
||||
tree2 :: Tree
|
||||
tree2 = mkApp (mkCId "Pred") [mkApp (mkCId "We") [], mkApp (mkCId "Walk") []]
|
||||
|
||||
-- And (Pred John Walk) (Pred We Walk)
|
||||
tree3 :: Tree
|
||||
tree3 = mkApp (mkCId "And") [tree1, tree2]
|
||||
|
||||
-- Initial LPGF, Figures 6 & 7
|
||||
walking :: LPGF
|
||||
walking = LPGF {
|
||||
absname = mkCId "Walking",
|
||||
abstract = Abstr {
|
||||
-- cats = Map.fromList [
|
||||
-- (mkCId "S", ()),
|
||||
-- (mkCId "NP", ()),
|
||||
-- (mkCId "VP", ())
|
||||
-- ],
|
||||
-- funs = Map.fromList [
|
||||
-- (mkCId "And", Type [mkCId "S", mkCId "S"] (mkCId "S")),
|
||||
-- (mkCId "Pred", Type [mkCId "NP", mkCId "VP"] (mkCId "S")),
|
||||
-- (mkCId "John", Type [] (mkCId "NP")),
|
||||
-- (mkCId "We", Type [] (mkCId "NP")),
|
||||
-- (mkCId "Walk", Type [] (mkCId "VP"))
|
||||
-- ]
|
||||
},
|
||||
concretes = Map.fromList [
|
||||
(mkCId "WalkingEng", Concr {
|
||||
-- lincats = Map.fromList [
|
||||
-- (mkCId "S", LTStr),
|
||||
-- (mkCId "NP", LTProduct [LTStr, LTInt 2]),
|
||||
-- (mkCId "VP", LTProduct [LTStr, LTStr])
|
||||
-- ],
|
||||
lins = Map.fromList [
|
||||
(mkCId "And", mkConcat [LFArgument 1, LFToken "and", LFArgument 2]),
|
||||
-- (mkCId "Pred", mkConcat [LFProjection (LFArgument 1) (LFInt 1), LFProjection (LFArgument 2) (LFProjection (LFArgument 1) (LFInt 2))]),
|
||||
(mkCId "Pred", mkConcat [LFProjection (LFArgument 1) (LFInt 1), LFProjection (LFProjection (LFArgument 2) (LFInt 1)) (LFProjection (LFArgument 1) (LFInt 2))]),
|
||||
(mkCId "John", LFTuple [LFToken "John", LFInt 1]),
|
||||
(mkCId "We", LFTuple [LFToken "we", LFInt 2]),
|
||||
-- (mkCId "Walk", LFTuple [LFToken "walks", LFToken "walk"])
|
||||
(mkCId "Walk", LFTuple [LFTuple [LFToken "walks", LFToken "walk"]])
|
||||
]
|
||||
}),
|
||||
(mkCId "WalkingGer", Concr {
|
||||
-- lincats = Map.fromList [
|
||||
-- (mkCId "S", LTStr),
|
||||
-- (mkCId "NP", LTProduct [LTStr, LTInt 2, LTInt 3]),
|
||||
-- (mkCId "VP", LTProduct [LTProduct [LTStr, LTStr, LTStr], LTProduct [LTStr, LTStr, LTStr]])
|
||||
-- ],
|
||||
lins = Map.fromList [
|
||||
(mkCId "And", mkConcat [LFArgument 1, LFToken "und", LFArgument 2]),
|
||||
-- (mkCId "Pred", mkConcat [LFProjection (LFArgument 1) (LFInt 1), LFProjection (LFProjection (LFArgument 2) (LFProjection (LFArgument 1) (LFInt 2))) (LFProjection (LFArgument 1) (LFInt 3))]),
|
||||
(mkCId "Pred", mkConcat [LFProjection (LFArgument 1) (LFInt 1), LFProjection (LFProjection (LFProjection (LFArgument 2) (LFInt 1)) (LFProjection (LFArgument 1) (LFInt 2))) (LFProjection (LFArgument 1) (LFInt 3))]),
|
||||
(mkCId "John", LFTuple [LFToken "John", LFInt 1, LFInt 3]),
|
||||
(mkCId "We", LFTuple [LFToken "wir", LFInt 2, LFInt 1]),
|
||||
-- (mkCId "Walk", LFTuple [LFTuple [LFToken "gehe", LFToken "gehst", LFToken "geht"], LFTuple [LFToken "gehen", LFToken "geht", LFToken "gehen"]])
|
||||
(mkCId "Walk", LFTuple [LFTuple [LFTuple [LFToken "gehe", LFToken "gehst", LFToken "geht"], LFTuple [LFToken "gehen", LFToken "geht", LFToken "gehen"]]])
|
||||
]
|
||||
})
|
||||
]
|
||||
}
|
||||
11
testsuite/lpgf/Walking.trees
Normal file
11
testsuite/lpgf/Walking.trees
Normal file
@@ -0,0 +1,11 @@
|
||||
Walking: Pred John Walk
|
||||
WalkingEng: John walks
|
||||
WalkingGer: John geht
|
||||
|
||||
Walking: Pred We Walk
|
||||
WalkingEng: we walk
|
||||
WalkingGer: wir gehen
|
||||
|
||||
Walking: And (Pred John Walk) (Pred We Walk)
|
||||
WalkingEng: John walks and we walk
|
||||
WalkingGer: John geht und wir gehen
|
||||
@@ -1,90 +1,59 @@
|
||||
import LPGF
|
||||
import PGF (Tree, mkCId, mkApp, showLanguage, showExpr)
|
||||
import PGF (showLanguage, readExpr)
|
||||
import GF (compileToLPGF, writeLPGF)
|
||||
import GF.Support (noOptions)
|
||||
|
||||
import Control.Monad (forM_)
|
||||
import qualified Data.List as L
|
||||
import qualified Data.Map as Map
|
||||
import Text.Printf (printf)
|
||||
import System.Directory (listDirectory)
|
||||
import System.FilePath ((</>), (<.>), takeBaseName, takeExtension)
|
||||
|
||||
dir :: FilePath
|
||||
dir = "testsuite" </> "lpgf"
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
doGrammar "Walking"
|
||||
doGrammar "Foods"
|
||||
|
||||
doGrammar :: String -> IO ()
|
||||
doGrammar gname = do
|
||||
-- Collect concrete modules
|
||||
mods <- map (dir </>)
|
||||
. filter (\p -> gname `L.isPrefixOf` takeBaseName p && takeExtension p == ".gf")
|
||||
<$> listDirectory dir
|
||||
|
||||
-- Compile LPGF
|
||||
lpgf <- compileToLPGF noOptions ["testsuite/lpgf/WalkingEng.gf", "testsuite/lpgf/WalkingGer.gf"]
|
||||
lpgf <- compileToLPGF noOptions mods
|
||||
writeLPGF noOptions lpgf
|
||||
putStrLn ""
|
||||
|
||||
-- Read back from file
|
||||
lpgf <- readLPGF "Walking.lpgf"
|
||||
lpgf <- readLPGF $ gname ++ ".lpgf"
|
||||
|
||||
-- Do some linearization
|
||||
forM_ [tree1, tree2, tree3] $ \tree -> do
|
||||
putStrLn ""
|
||||
putStrLn (showExpr [] tree)
|
||||
forM_ (Map.toList (concretes lpgf)) $ \(lang,concr) ->
|
||||
printf "%s: %s\n" (showLanguage lang) (linearizeConcr concr tree)
|
||||
-- Read treebank
|
||||
gs <- groups . lines <$> readFile (dir </> gname <.> "trees")
|
||||
forM_ gs $ \grp -> do
|
||||
let ast = drop 2 $ dropWhile (/=':') $ head grp
|
||||
printf "%s: %s\n" gname ast
|
||||
let
|
||||
Just tree = readExpr ast
|
||||
-- Do some linearization
|
||||
langs =
|
||||
[ printf "%s: %s" (showLanguage lang) (linearizeConcr concr tree)
|
||||
| (lang,concr) <- Map.toList (concretes lpgf)
|
||||
]
|
||||
mapM_ putStrLn langs
|
||||
if langs == tail grp
|
||||
then putStrLn "✅\n"
|
||||
else do
|
||||
putStrLn "❌ expected:"
|
||||
mapM_ putStrLn (tail grp)
|
||||
putStrLn ""
|
||||
error "Test failed"
|
||||
|
||||
-- Pred John Walk
|
||||
tree1 :: Tree
|
||||
tree1 = mkApp (mkCId "Pred") [mkApp (mkCId "John") [], mkApp (mkCId "Walk") []]
|
||||
|
||||
-- Pred We Walk
|
||||
tree2 :: Tree
|
||||
tree2 = mkApp (mkCId "Pred") [mkApp (mkCId "We") [], mkApp (mkCId "Walk") []]
|
||||
|
||||
-- And (Pred John Walk) (Pred We Walk)
|
||||
tree3 :: Tree
|
||||
tree3 = mkApp (mkCId "And") [tree1, tree2]
|
||||
|
||||
-- Initial LPGF, Figures 6 & 7
|
||||
walking :: LPGF
|
||||
walking = LPGF {
|
||||
absname = mkCId "Walking",
|
||||
abstract = Abstr {
|
||||
-- cats = Map.fromList [
|
||||
-- (mkCId "S", ()),
|
||||
-- (mkCId "NP", ()),
|
||||
-- (mkCId "VP", ())
|
||||
-- ],
|
||||
-- funs = Map.fromList [
|
||||
-- (mkCId "And", Type [mkCId "S", mkCId "S"] (mkCId "S")),
|
||||
-- (mkCId "Pred", Type [mkCId "NP", mkCId "VP"] (mkCId "S")),
|
||||
-- (mkCId "John", Type [] (mkCId "NP")),
|
||||
-- (mkCId "We", Type [] (mkCId "NP")),
|
||||
-- (mkCId "Walk", Type [] (mkCId "VP"))
|
||||
-- ]
|
||||
},
|
||||
concretes = Map.fromList [
|
||||
(mkCId "WalkingEng", Concr {
|
||||
-- lincats = Map.fromList [
|
||||
-- (mkCId "S", LTStr),
|
||||
-- (mkCId "NP", LTProduct [LTStr, LTInt 2]),
|
||||
-- (mkCId "VP", LTProduct [LTStr, LTStr])
|
||||
-- ],
|
||||
lins = Map.fromList [
|
||||
(mkCId "And", mkConcat [LFArgument 1, LFToken "and", LFArgument 2]),
|
||||
-- (mkCId "Pred", mkConcat [LFProjection (LFArgument 1) (LFInt 1), LFProjection (LFArgument 2) (LFProjection (LFArgument 1) (LFInt 2))]),
|
||||
(mkCId "Pred", mkConcat [LFProjection (LFArgument 1) (LFInt 1), LFProjection (LFProjection (LFArgument 2) (LFInt 1)) (LFProjection (LFArgument 1) (LFInt 2))]),
|
||||
(mkCId "John", LFTuple [LFToken "John", LFInt 1]),
|
||||
(mkCId "We", LFTuple [LFToken "we", LFInt 2]),
|
||||
-- (mkCId "Walk", LFTuple [LFToken "walks", LFToken "walk"])
|
||||
(mkCId "Walk", LFTuple [LFTuple [LFToken "walks", LFToken "walk"]])
|
||||
]
|
||||
}),
|
||||
(mkCId "WalkingGer", Concr {
|
||||
-- lincats = Map.fromList [
|
||||
-- (mkCId "S", LTStr),
|
||||
-- (mkCId "NP", LTProduct [LTStr, LTInt 2, LTInt 3]),
|
||||
-- (mkCId "VP", LTProduct [LTProduct [LTStr, LTStr, LTStr], LTProduct [LTStr, LTStr, LTStr]])
|
||||
-- ],
|
||||
lins = Map.fromList [
|
||||
(mkCId "And", mkConcat [LFArgument 1, LFToken "und", LFArgument 2]),
|
||||
-- (mkCId "Pred", mkConcat [LFProjection (LFArgument 1) (LFInt 1), LFProjection (LFProjection (LFArgument 2) (LFProjection (LFArgument 1) (LFInt 2))) (LFProjection (LFArgument 1) (LFInt 3))]),
|
||||
(mkCId "Pred", mkConcat [LFProjection (LFArgument 1) (LFInt 1), LFProjection (LFProjection (LFProjection (LFArgument 2) (LFInt 1)) (LFProjection (LFArgument 1) (LFInt 2))) (LFProjection (LFArgument 1) (LFInt 3))]),
|
||||
(mkCId "John", LFTuple [LFToken "John", LFInt 1, LFInt 3]),
|
||||
(mkCId "We", LFTuple [LFToken "wir", LFInt 2, LFInt 1]),
|
||||
-- (mkCId "Walk", LFTuple [LFTuple [LFToken "gehe", LFToken "gehst", LFToken "geht"], LFTuple [LFToken "gehen", LFToken "geht", LFToken "gehen"]])
|
||||
(mkCId "Walk", LFTuple [LFTuple [LFTuple [LFToken "gehe", LFToken "gehst", LFToken "geht"], LFTuple [LFToken "gehen", LFToken "geht", LFToken "gehen"]]])
|
||||
]
|
||||
})
|
||||
]
|
||||
}
|
||||
groups :: [String] -> [[String]]
|
||||
groups [] = []
|
||||
groups ss = let (a,b) = break (=="") ss in a : groups (drop 1 b)
|
||||
|
||||
Reference in New Issue
Block a user