diff --git a/examples/tutorial/embedded/Makefile_gfcc b/examples/tutorial/embedded/Makefile_gfcc new file mode 100644 index 000000000..257128e60 --- /dev/null +++ b/examples/tutorial/embedded/Makefile_gfcc @@ -0,0 +1,18 @@ +all: gf hs run + +gf: + echo "pm -printer=gfcc | wf math.gfcc" | gf MathEng.gf MathFre.gf + +hs: gf + echo "pg -printer=gfcc_haskell | wf GSyntax.hs" | gf MathEng.gf MathFre.gf + +run: hs + ghc --make -o ./mathc TransferLoopGFCC.hs + strip mathc + +clean: + rm -f *.gfc *.gfr *.o *.hi + +distclean: + rm -f GSyntax.hs math math.gfcc *.gfc *.gfr *.o *.hi + diff --git a/examples/tutorial/embedded/TransferDefGFCC.hs b/examples/tutorial/embedded/TransferDefGFCC.hs new file mode 100644 index 000000000..ab3342f56 --- /dev/null +++ b/examples/tutorial/embedded/TransferDefGFCC.hs @@ -0,0 +1,26 @@ +module TransferDefGFCC where + +import GF.Canon.GFCC.GFCCAPI (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/examples/tutorial/embedded/TransferLoopGFCC.hs b/examples/tutorial/embedded/TransferLoopGFCC.hs new file mode 100644 index 000000000..8cda059ad --- /dev/null +++ b/examples/tutorial/embedded/TransferLoopGFCC.hs @@ -0,0 +1,23 @@ +module Main where + +import GF.Canon.GFCC.GFCCAPI +import TransferDefGFCC (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" +