mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-21 18:59:32 -06:00
changed names of resource-1.3; added a note on homepage on release
This commit is contained in:
100
old-examples/tutorial/embedded/haskell/GSyntax.hs
Normal file
100
old-examples/tutorial/embedded/haskell/GSyntax.hs
Normal file
@@ -0,0 +1,100 @@
|
||||
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)
|
||||
|
||||
|
||||
Reference in New Issue
Block a user