fixed some tutorial grammars and updated embedded section (JavaScript and web TODO)

This commit is contained in:
aarne
2008-11-11 09:21:59 +00:00
parent ca59050abc
commit db18350b1e
9 changed files with 163 additions and 100 deletions

View File

@@ -0,0 +1,4 @@
all:
gfc --make --output-format=haskell QueryEng.gf
ghc --make -o ./math TransferLoop.hs
strip math

View File

@@ -0,0 +1,17 @@
abstract Query = {
flags startcat=Question ;
cat
Answer ; Question ; Object ;
fun
Even : Object -> Question ;
Odd : Object -> Question ;
Prime : Object -> Question ;
Number : Int -> Object ;
Yes : Answer ;
No : Answer ;
}

View File

@@ -0,0 +1,15 @@
concrete QueryEng of Query = {
lincat
Answer, Question, Object = Str ;
lin
Even x = "is" ++ x ++ "even" ;
Odd x = "is" ++ x ++ "odd" ;
Prime x = "is" ++ x ++ "prime" ;
Number n = n.s ;
Yes = "yes" ;
No = "no" ;
}

View File

@@ -0,0 +1,26 @@
module TransferDef where
import PGF (Tree)
import Query -- generated from GF
transfer :: Tree -> Tree
transfer = gf . answer . fg
answer :: GQuestion -> GAnswer
answer p = case p of
GOdd x -> test odd x
GEven x -> test even x
GPrime x -> test prime x
value :: GObject -> Int
value e = case e of
GNumber (GInt i) -> fromInteger i
test :: (Int -> Bool) -> GObject -> GAnswer
test f x = if f (value x) then GYes else GNo
prime :: Int -> Bool
prime x = elem x primes where
primes = sieve [2 .. x]
sieve (p:xs) = p : sieve [ n | n <- xs, n `mod` p > 0 ]
sieve [] = []

View File

@@ -0,0 +1,21 @@
module Main where
import PGF
import TransferDef (transfer)
main :: IO ()
main = do
gr <- readPGF "Query.pgf"
loop (translate transfer gr)
loop :: (String -> String) -> IO ()
loop trans = do
s <- getLine
if s == "quit" then putStrLn "bye" else do
putStrLn $ trans s
loop trans
translate :: (Tree -> Tree) -> PGF -> String -> String
translate tr gr s = case parseAllLang gr (startCat gr) s of
(lg,t:_):_ -> linearize gr lg (tr t)
_ -> "NO PARSE"

View File

@@ -0,0 +1,5 @@
--# -path=.:../foods:present
concrete FoodsSwe of Foods = FoodsI with
(Syntax = SyntaxSwe),
(LexFoods = LexFoodsSwe) ;

View File

@@ -1,6 +1,6 @@
--# -path=.:../foods:present:prelude
instance LexFoodsIta of LexFoods = open SyntaxIta, ParadigmsIta in {
instance LexFoodsIta of LexFoods = open SyntaxIta, ParadigmsIta, BeschIta in {
oper
wine_N = mkN "vino" ;
pizza_N = mkN "pizza" ;
@@ -12,4 +12,9 @@ instance LexFoodsIta of LexFoods = open SyntaxIta, ParadigmsIta in {
expensive_A = mkA "caro" ;
delicious_A = mkA "delizioso" ;
boring_A = mkA "noioso" ;
drink_V2 = mkV2 (verboV (bere_27 "bere")) ;
eat_V2 = mkV2 (mkV "mangiare") ;
pay_V2 = mkV2 (mkV "pagare") ;
gentleman_N = mkN "signore" ;
lady_N = mkN "signora" ;
}

View File

@@ -0,0 +1,20 @@
instance LexFoodsSwe of LexFoods = open SyntaxSwe, ParadigmsSwe, IrregSwe in {
oper
wine_N = mkN "vin" "vinet" "viner" "vinerna" ;
pizza_N = mkN "pizza" ;
cheese_N = mkN "ost" ;
fish_N = mkN "fisk" ;
fresh_A = mkA "färsk" ;
warm_A = mkA "varm" ;
italian_A = mkA "italiensk" ;
expensive_A = mkA "dyr" ;
delicious_A = mkA "läcker" "läckert" "läckra" "läckrare" "läckrast" ;
boring_A = mkA "tråkig" ;
eat_V2 = mkV2 (mkV "äta" "åt" "ätit") ;
drink_V2 = mkV2 (mkV "dricka" "drack" "druckit") ;
pay_V2 = mkV2 "betala" ;
lady_N = mkN "dam" "damer" ;
gentleman_N = mkN "herr" ;
}