mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-09 13:09:33 -06:00
101 lines
2.3 KiB
Haskell
101 lines
2.3 KiB
Haskell
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)
|
|
|
|
|