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
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
|
module GSyntax where
import GF.GFCC.DataGFCC
import GF.GFCC.AbsGFCC
----------------------------------------------------
-- automatic translation from GF to Haskell
----------------------------------------------------
class Gf a where gf :: a -> Exp
class Fg a where fg :: Exp -> a
newtype GString = GString String deriving Show
instance Gf GString where
gf (GString s) = DTr [] (AS s) []
instance Fg GString where
fg t =
case t of
DTr [] (AS s) [] -> GString s
_ -> error ("no GString " ++ show t)
newtype GInt = GInt Integer deriving Show
instance Gf GInt where
gf (GInt s) = DTr [] (AI s) []
instance Fg GInt where
fg t =
case t of
DTr [] (AI s) [] -> GInt s
_ -> error ("no GInt " ++ show t)
newtype GFloat = GFloat Double deriving Show
instance Gf GFloat where
gf (GFloat s) = DTr [] (AF s) []
instance Fg GFloat where
fg t =
case t of
DTr [] (AF s) [] -> GFloat s
_ -> error ("no GFloat " ++ show t)
----------------------------------------------------
-- below this line machine-generated
----------------------------------------------------
data GA2 =
GDivisible
| GEqual
| GGreater
| GSmaller
deriving Show
data GAP =
GComplA2 GA2 GNP
| GConjAP GConj GAP GAP
| GEven
| GOdd
| GPrime
deriving Show
data GAnswer =
GNo
| GValue GNP
| GYes
deriving Show
data GCN =
GModCN GAP GCN
| GNumber
deriving Show
data GConj =
GAnd
| GOr
deriving Show
newtype GListPN = GListPN [GPN] deriving Show
data GNP =
GConjNP GConj GNP GNP
| GEvery GCN
| GMany GListPN
| GNone
| GSome GCN
| GUsePN GPN
deriving Show
data GPN =
GGCD GListPN
| GProduct GListPN
| GSum GListPN
| GUseInt GInt
deriving Show
data GQuestion =
GQuestS GS
| GWhatIs GPN
| GWhichAre GCN GAP
deriving Show
data GS = GPredAP GNP GAP
deriving Show
instance Gf GA2 where
gf GDivisible = DTr [] (AC (CId "Divisible")) []
gf GEqual = DTr [] (AC (CId "Equal")) []
gf GGreater = DTr [] (AC (CId "Greater")) []
gf GSmaller = DTr [] (AC (CId "Smaller")) []
instance Gf GAP where
gf (GComplA2 x1 x2) = DTr [] (AC (CId "ComplA2")) [gf x1, gf x2]
gf (GConjAP x1 x2 x3) = DTr [] (AC (CId "ConjAP")) [gf x1, gf x2, gf x3]
gf GEven = DTr [] (AC (CId "Even")) []
gf GOdd = DTr [] (AC (CId "Odd")) []
gf GPrime = DTr [] (AC (CId "Prime")) []
instance Gf GAnswer where
gf GNo = DTr [] (AC (CId "No")) []
gf (GValue x1) = DTr [] (AC (CId "Value")) [gf x1]
gf GYes = DTr [] (AC (CId "Yes")) []
instance Gf GCN where
gf (GModCN x1 x2) = DTr [] (AC (CId "ModCN")) [gf x1, gf x2]
gf GNumber = DTr [] (AC (CId "Number")) []
instance Gf GConj where
gf GAnd = DTr [] (AC (CId "And")) []
gf GOr = DTr [] (AC (CId "Or")) []
instance Gf GListPN where
gf (GListPN [x1,x2]) = DTr [] (AC (CId "BasePN")) [gf x1, gf x2]
gf (GListPN (x:xs)) = DTr [] (AC (CId "ConsPN")) [gf x, gf (GListPN xs)]
instance Gf GNP where
gf (GConjNP x1 x2 x3) = DTr [] (AC (CId "ConjNP")) [gf x1, gf x2, gf x3]
gf (GEvery x1) = DTr [] (AC (CId "Every")) [gf x1]
gf (GMany x1) = DTr [] (AC (CId "Many")) [gf x1]
gf GNone = DTr [] (AC (CId "None")) []
gf (GSome x1) = DTr [] (AC (CId "Some")) [gf x1]
gf (GUsePN x1) = DTr [] (AC (CId "UsePN")) [gf x1]
instance Gf GPN where
gf (GGCD x1) = DTr [] (AC (CId "GCD")) [gf x1]
gf (GProduct x1) = DTr [] (AC (CId "Product")) [gf x1]
gf (GSum x1) = DTr [] (AC (CId "Sum")) [gf x1]
gf (GUseInt x1) = DTr [] (AC (CId "UseInt")) [gf x1]
instance Gf GQuestion where
gf (GQuestS x1) = DTr [] (AC (CId "QuestS")) [gf x1]
gf (GWhatIs x1) = DTr [] (AC (CId "WhatIs")) [gf x1]
gf (GWhichAre x1 x2) = DTr [] (AC (CId "WhichAre")) [gf x1, gf x2]
instance Gf GS where gf (GPredAP x1 x2) = DTr [] (AC (CId "PredAP")) [gf x1, gf x2]
instance Fg GA2 where
fg t =
case t of
DTr [] (AC (CId "Divisible")) [] -> GDivisible
DTr [] (AC (CId "Equal")) [] -> GEqual
DTr [] (AC (CId "Greater")) [] -> GGreater
DTr [] (AC (CId "Smaller")) [] -> GSmaller
_ -> error ("no A2 " ++ show t)
instance Fg GAP where
fg t =
case t of
DTr [] (AC (CId "ComplA2")) [x1,x2] -> GComplA2 (fg x1) (fg x2)
DTr [] (AC (CId "ConjAP")) [x1,x2,x3] -> GConjAP (fg x1) (fg x2) (fg x3)
DTr [] (AC (CId "Even")) [] -> GEven
DTr [] (AC (CId "Odd")) [] -> GOdd
DTr [] (AC (CId "Prime")) [] -> GPrime
_ -> error ("no AP " ++ show t)
instance Fg GAnswer where
fg t =
case t of
DTr [] (AC (CId "No")) [] -> GNo
DTr [] (AC (CId "Value")) [x1] -> GValue (fg x1)
DTr [] (AC (CId "Yes")) [] -> GYes
_ -> error ("no Answer " ++ show t)
instance Fg GCN where
fg t =
case t of
DTr [] (AC (CId "ModCN")) [x1,x2] -> GModCN (fg x1) (fg x2)
DTr [] (AC (CId "Number")) [] -> GNumber
_ -> error ("no CN " ++ show t)
instance Fg GConj where
fg t =
case t of
DTr [] (AC (CId "And")) [] -> GAnd
DTr [] (AC (CId "Or")) [] -> GOr
_ -> error ("no Conj " ++ show t)
instance Fg GListPN where
fg t =
case t of
DTr [] (AC (CId "BasePN")) [x1,x2] -> GListPN [fg x1, fg x2]
DTr [] (AC (CId "ConsPN")) [x1,x2] -> let GListPN xs = fg x2 in GListPN (fg x1:xs)
_ -> error ("no ListPN " ++ show t)
instance Fg GNP where
fg t =
case t of
DTr [] (AC (CId "ConjNP")) [x1,x2,x3] -> GConjNP (fg x1) (fg x2) (fg x3)
DTr [] (AC (CId "Every")) [x1] -> GEvery (fg x1)
DTr [] (AC (CId "Many")) [x1] -> GMany (fg x1)
DTr [] (AC (CId "None")) [] -> GNone
DTr [] (AC (CId "Some")) [x1] -> GSome (fg x1)
DTr [] (AC (CId "UsePN")) [x1] -> GUsePN (fg x1)
_ -> error ("no NP " ++ show t)
instance Fg GPN where
fg t =
case t of
DTr [] (AC (CId "GCD")) [x1] -> GGCD (fg x1)
DTr [] (AC (CId "Product")) [x1] -> GProduct (fg x1)
DTr [] (AC (CId "Sum")) [x1] -> GSum (fg x1)
DTr [] (AC (CId "UseInt")) [x1] -> GUseInt (fg x1)
_ -> error ("no PN " ++ show t)
instance Fg GQuestion where
fg t =
case t of
DTr [] (AC (CId "QuestS")) [x1] -> GQuestS (fg x1)
DTr [] (AC (CId "WhatIs")) [x1] -> GWhatIs (fg x1)
DTr [] (AC (CId "WhichAre")) [x1,x2] -> GWhichAre (fg x1) (fg x2)
_ -> error ("no Question " ++ show t)
instance Fg GS where
fg t =
case t of
DTr [] (AC (CId "PredAP")) [x1,x2] -> GPredAP (fg x1) (fg x2)
_ -> error ("no S " ++ show t)
|
