forked from GitHub/gf-core
math with gfcc
This commit is contained in:
18
examples/tutorial/embedded/Makefile_gfcc
Normal file
18
examples/tutorial/embedded/Makefile_gfcc
Normal file
@@ -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
|
||||
|
||||
26
examples/tutorial/embedded/TransferDefGFCC.hs
Normal file
26
examples/tutorial/embedded/TransferDefGFCC.hs
Normal file
@@ -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 [] = []
|
||||
23
examples/tutorial/embedded/TransferLoopGFCC.hs
Normal file
23
examples/tutorial/embedded/TransferLoopGFCC.hs
Normal file
@@ -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"
|
||||
|
||||
Reference in New Issue
Block a user