1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
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)
|
