3 files changed, 67 insertions, 0 deletions
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"
+