diff options
| author | aarne <aarne@cs.chalmers.se> | 2008-06-25 16:54:35 +0000 |
|---|---|---|
| committer | aarne <aarne@cs.chalmers.se> | 2008-06-25 16:54:35 +0000 |
| commit | e9e80fc389365e24d4300d7d5390c7d833a96c50 (patch) | |
| tree | f0b58473adaa670bd8fc52ada419d8cad470ee03 /old-examples/tutorial/embedded | |
| parent | b96b36f43de3e2f8b58d5f539daa6f6d47f25870 (diff) | |
changed names of resource-1.3; added a note on homepage on release
Diffstat (limited to 'old-examples/tutorial/embedded')
| -rw-r--r-- | old-examples/tutorial/embedded/LexMath.gf | 8 | ||||
| -rw-r--r-- | old-examples/tutorial/embedded/LexMathEng.gf | 8 | ||||
| -rw-r--r-- | old-examples/tutorial/embedded/LexMathFre.gf | 8 | ||||
| -rw-r--r-- | old-examples/tutorial/embedded/Makefile | 11 | ||||
| -rw-r--r-- | old-examples/tutorial/embedded/Math.gf | 14 | ||||
| -rw-r--r-- | old-examples/tutorial/embedded/MathEng.gf | 6 | ||||
| -rw-r--r-- | old-examples/tutorial/embedded/MathFre.gf | 6 | ||||
| -rw-r--r-- | old-examples/tutorial/embedded/MathI.gf | 23 | ||||
| -rw-r--r-- | old-examples/tutorial/embedded/TransferDef.hs | 26 | ||||
| -rw-r--r-- | old-examples/tutorial/embedded/TransferLoop.hs | 23 | ||||
| -rw-r--r-- | old-examples/tutorial/embedded/Translator.hs | 16 | ||||
| -rw-r--r-- | old-examples/tutorial/embedded/TranslatorLoop.hs | 23 | ||||
| -rw-r--r-- | old-examples/tutorial/embedded/haskell/GSyntax.hs | 100 | ||||
| -rw-r--r-- | old-examples/tutorial/embedded/haskell/Run.hs | 38 |
14 files changed, 310 insertions, 0 deletions
diff --git a/old-examples/tutorial/embedded/LexMath.gf b/old-examples/tutorial/embedded/LexMath.gf new file mode 100644 index 000000000..25bfe8846 --- /dev/null +++ b/old-examples/tutorial/embedded/LexMath.gf @@ -0,0 +1,8 @@ +interface LexMath = open Syntax in { + + oper + even_A : A ; + odd_A : A ; + prime_A : A ; + +} diff --git a/old-examples/tutorial/embedded/LexMathEng.gf b/old-examples/tutorial/embedded/LexMathEng.gf new file mode 100644 index 000000000..183fa520f --- /dev/null +++ b/old-examples/tutorial/embedded/LexMathEng.gf @@ -0,0 +1,8 @@ +instance LexMathEng of LexMath = open SyntaxEng, ParadigmsEng in { + + oper + even_A = mkA "even" ; + odd_A = mkA "odd" ; + prime_A = mkA "prime" ; + +} diff --git a/old-examples/tutorial/embedded/LexMathFre.gf b/old-examples/tutorial/embedded/LexMathFre.gf new file mode 100644 index 000000000..7407b410f --- /dev/null +++ b/old-examples/tutorial/embedded/LexMathFre.gf @@ -0,0 +1,8 @@ +instance LexMathFre of LexMath = open SyntaxFre, ParadigmsFre in { + + oper + even_A = mkA "pair" ; + odd_A = mkA "impair" ; + prime_A = mkA "premier" ; + +} diff --git a/old-examples/tutorial/embedded/Makefile b/old-examples/tutorial/embedded/Makefile new file mode 100644 index 000000000..119d5d0fe --- /dev/null +++ b/old-examples/tutorial/embedded/Makefile @@ -0,0 +1,11 @@ +all: + gfc --make -haskell MathEng.gf MathFre.gf + ghc --make -o ./math TransferLoop.hs + strip math + +clean: + rm -f *.gfo *.o *.hi + +distclean: + rm -f GSyntax.hs math Math.gfcc *.gfo *.o *.hi + diff --git a/old-examples/tutorial/embedded/Math.gf b/old-examples/tutorial/embedded/Math.gf new file mode 100644 index 000000000..95f5d5d1c --- /dev/null +++ b/old-examples/tutorial/embedded/Math.gf @@ -0,0 +1,14 @@ +abstract Math = { + + cat Answer ; Question ; Object ; + + fun + Even : Object -> Question ; + Odd : Object -> Question ; + Prime : Object -> Question ; + Number : Int -> Object ; + + Yes : Answer ; + No : Answer ; + +} diff --git a/old-examples/tutorial/embedded/MathEng.gf b/old-examples/tutorial/embedded/MathEng.gf new file mode 100644 index 000000000..ac332fef7 --- /dev/null +++ b/old-examples/tutorial/embedded/MathEng.gf @@ -0,0 +1,6 @@ +--# -path=.:present:prelude:mathematical + +concrete MathEng of Math = MathI with + (Syntax = SyntaxEng), + (Symbol = SymbolEng), + (LexMath = LexMathEng) ; diff --git a/old-examples/tutorial/embedded/MathFre.gf b/old-examples/tutorial/embedded/MathFre.gf new file mode 100644 index 000000000..456db8084 --- /dev/null +++ b/old-examples/tutorial/embedded/MathFre.gf @@ -0,0 +1,6 @@ +--# -path=.:present:prelude:mathematical + +concrete MathFre of Math = MathI with + (Syntax = SyntaxFre), + (Symbol = SymbolFre), + (LexMath = LexMathFre) ; diff --git a/old-examples/tutorial/embedded/MathI.gf b/old-examples/tutorial/embedded/MathI.gf new file mode 100644 index 000000000..aaac7b98f --- /dev/null +++ b/old-examples/tutorial/embedded/MathI.gf @@ -0,0 +1,23 @@ +incomplete concrete MathI of Math = + open Syntax, Symbol, LexMath in { + + flags startcat = Question ; lexer = textlit ; unlexer = text ; + + lincat + Answer = Text ; + Question = Text ; + Object = NP ; + + lin + Even = questAdj even_A ; + Odd = questAdj odd_A ; + Prime = questAdj prime_A ; + Number n = mkNP (IntPN n) ; + + Yes = mkText yes_Phr ; + No = mkText no_Phr ; + + oper + questAdj : A -> NP -> Text = \adj,x -> mkText (mkQS (mkCl x adj)) ; + +} diff --git a/old-examples/tutorial/embedded/TransferDef.hs b/old-examples/tutorial/embedded/TransferDef.hs new file mode 100644 index 000000000..8be39107d --- /dev/null +++ b/old-examples/tutorial/embedded/TransferDef.hs @@ -0,0 +1,26 @@ +module TransferDef where + +import GF.GFCC.API (Tree) +import GSyntax + +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 [] = [] diff --git a/old-examples/tutorial/embedded/TransferLoop.hs b/old-examples/tutorial/embedded/TransferLoop.hs new file mode 100644 index 000000000..708578156 --- /dev/null +++ b/old-examples/tutorial/embedded/TransferLoop.hs @@ -0,0 +1,23 @@ +module Main where + +import GF.GFCC.API +import TransferDef (transfer) + +main :: IO () +main = do + gr <- file2grammar "Math.gfcc" + 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) -> MultiGrammar -> String -> String +translate tr gr = unlines . map transLine . lines where + transLine s = case parseAllLang gr "Question" s of + (lg,t:_):_ -> linearize gr lg (tr t) + _ -> "NO PARSE" + diff --git a/old-examples/tutorial/embedded/Translator.hs b/old-examples/tutorial/embedded/Translator.hs new file mode 100644 index 000000000..c227420f6 --- /dev/null +++ b/old-examples/tutorial/embedded/Translator.hs @@ -0,0 +1,16 @@ +module Main where + +import GF.Embed.EmbedAPI +import System (getArgs) + +main :: IO () +main = do + file:_ <- getArgs + gr <- file2grammar file + interact (translate gr) + +translate :: MultiGrammar -> String -> String +translate gr = unlines . map transLine . lines where + transLine s = + let (lang,tree:_):_ = parseAllLang gr (startCat gr) s + in unlines [linearize gr lg tree | lg <- languages gr, lg /= lang] diff --git a/old-examples/tutorial/embedded/TranslatorLoop.hs b/old-examples/tutorial/embedded/TranslatorLoop.hs new file mode 100644 index 000000000..18b20146e --- /dev/null +++ b/old-examples/tutorial/embedded/TranslatorLoop.hs @@ -0,0 +1,23 @@ +module Main where + +import GF.Embed.EmbedAPI +import System (getArgs) + +main :: IO () +main = do + file:_ <- getArgs + gr <- file2grammar file + loop (translate gr) + +loop :: (String -> String) -> IO () +loop trans = do + s <- getLine + if s == "quit" then putStrLn "bye" else do + putStrLn $ trans s + loop trans + +translate :: MultiGrammar -> String -> String +translate gr = unlines . map transLine . lines where + transLine s = case parseAllLang gr (startCat gr) s of + (lg,t:_):_ -> unlines [linearize gr l t | l <- languages gr, l /= lg] + _ -> "NO PARSE" diff --git a/old-examples/tutorial/embedded/haskell/GSyntax.hs b/old-examples/tutorial/embedded/haskell/GSyntax.hs new file mode 100644 index 000000000..28469e7da --- /dev/null +++ b/old-examples/tutorial/embedded/haskell/GSyntax.hs @@ -0,0 +1,100 @@ +module GSyntax where + +import GF.Infra.Ident +import GF.Grammar.Grammar +import GF.Grammar.PrGrammar +import GF.Grammar.Macros +import GF.Data.Operations +---------------------------------------------------- +-- automatic translation from GF to Haskell +---------------------------------------------------- + +class Gf a where gf :: a -> Trm +class Fg a where fg :: Trm -> a + +newtype GString = GString String deriving Show + +instance Gf GString where + gf (GString s) = K s + +instance Fg GString where + fg t = + case termForm t of + Ok ([], K s ,[]) -> GString s + _ -> error ("no GString " ++ prt t) + +newtype GInt = GInt Integer deriving Show + +instance Gf GInt where + gf (GInt s) = EInt s + +instance Fg GInt where + fg t = + case termForm t of + Ok ([], EInt s ,[]) -> GInt s + _ -> error ("no GInt " ++ prt t) + +newtype GFloat = GFloat Double deriving Show + +instance Gf GFloat where + gf (GFloat s) = EFloat s + +instance Fg GFloat where + fg t = + case termForm t of + Ok ([], EFloat s ,[]) -> GFloat s + _ -> error ("no GFloat " ++ prt t) + +---------------------------------------------------- +-- below this line machine-generated +---------------------------------------------------- + +data GAnswer = + GYes + | GNo + deriving Show + +data GObject = GNumber GInt + deriving Show + +data GQuestion = + GPrime GObject + | GOdd GObject + | GEven GObject + deriving Show + + +instance Gf GAnswer where + gf GYes = appqc "Math" "Yes" [] + gf GNo = appqc "Math" "No" [] + +instance Gf GObject where gf (GNumber x1) = appqc "Math" "Number" [gf x1] + +instance Gf GQuestion where + gf (GPrime x1) = appqc "Math" "Prime" [gf x1] + gf (GOdd x1) = appqc "Math" "Odd" [gf x1] + gf (GEven x1) = appqc "Math" "Even" [gf x1] + + +instance Fg GAnswer where + fg t = + case termForm t of + Ok ([], Q (IC "Math") (IC "Yes"),[]) -> GYes + Ok ([], Q (IC "Math") (IC "No"),[]) -> GNo + _ -> error ("no Answer " ++ prt t) + +instance Fg GObject where + fg t = + case termForm t of + Ok ([], Q (IC "Math") (IC "Number"),[x1]) -> GNumber (fg x1) + _ -> error ("no Object " ++ prt t) + +instance Fg GQuestion where + fg t = + case termForm t of + Ok ([], Q (IC "Math") (IC "Prime"),[x1]) -> GPrime (fg x1) + Ok ([], Q (IC "Math") (IC "Odd"),[x1]) -> GOdd (fg x1) + Ok ([], Q (IC "Math") (IC "Even"),[x1]) -> GEven (fg x1) + _ -> error ("no Question " ++ prt t) + + diff --git a/old-examples/tutorial/embedded/haskell/Run.hs b/old-examples/tutorial/embedded/haskell/Run.hs new file mode 100644 index 000000000..c3fd87466 --- /dev/null +++ b/old-examples/tutorial/embedded/haskell/Run.hs @@ -0,0 +1,38 @@ +module Main where + +import GSyntax +import GF.Embed.EmbedAPI + +main :: IO () +main = do + gr <- file2grammar "math.gfcm" + loop gr + +loop :: MultiGrammar -> IO () +loop gr = do + s <- getLine + interpret gr s + loop gr + +interpret :: MultiGrammar -> String -> IO () +interpret gr s = do + let ltss = parseAllLang gr "Question" s + case ltss of + [] -> putStrLn "no parse" + (l,t:_):_ -> putStrLn $ linearize gr l $ gf $ answer $ fg t + +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 = (< 8) ---- |
