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 /examples/tutorial/embedded/haskell | |
| parent | b96b36f43de3e2f8b58d5f539daa6f6d47f25870 (diff) | |
changed names of resource-1.3; added a note on homepage on release
Diffstat (limited to 'examples/tutorial/embedded/haskell')
| -rw-r--r-- | examples/tutorial/embedded/haskell/GSyntax.hs | 100 | ||||
| -rw-r--r-- | examples/tutorial/embedded/haskell/Run.hs | 38 |
2 files changed, 0 insertions, 138 deletions
diff --git a/examples/tutorial/embedded/haskell/GSyntax.hs b/examples/tutorial/embedded/haskell/GSyntax.hs deleted file mode 100644 index 28469e7da..000000000 --- a/examples/tutorial/embedded/haskell/GSyntax.hs +++ /dev/null @@ -1,100 +0,0 @@ -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/examples/tutorial/embedded/haskell/Run.hs b/examples/tutorial/embedded/haskell/Run.hs deleted file mode 100644 index c3fd87466..000000000 --- a/examples/tutorial/embedded/haskell/Run.hs +++ /dev/null @@ -1,38 +0,0 @@ -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) ---- |
