diff options
Diffstat (limited to 'old-examples/tutorial/embedded/haskell/GSyntax.hs')
| -rw-r--r-- | old-examples/tutorial/embedded/haskell/GSyntax.hs | 100 |
1 files changed, 0 insertions, 100 deletions
diff --git a/old-examples/tutorial/embedded/haskell/GSyntax.hs b/old-examples/tutorial/embedded/haskell/GSyntax.hs deleted file mode 100644 index 28469e7da..000000000 --- a/old-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) - - |
