blob: ab55ba3ae24d7c5d0031efc49dc64e65c770b840 (
plain)
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
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
|
{-# OPTIONS_GHC -fglasgow-exts #-}
module Transfer.Syntax.Abs where
import Control.Monad (ap,MonadPlus,msum,mplus,mzero)
import Data.Monoid
-- Haskell module generated by the BNF converter
data Module_
type Module = Tree Module_
data Import_
type Import = Tree Import_
data Decl_
type Decl = Tree Decl_
data ConsDecl_
type ConsDecl = Tree ConsDecl_
data Pattern_
type Pattern = Tree Pattern_
data PListElem_
type PListElem = Tree PListElem_
data FieldPattern_
type FieldPattern = Tree FieldPattern_
data Exp_
type Exp = Tree Exp_
data LetDef_
type LetDef = Tree LetDef_
data Case_
type Case = Tree Case_
data Bind_
type Bind = Tree Bind_
data VarOrWild_
type VarOrWild = Tree VarOrWild_
data FieldType_
type FieldType = Tree FieldType_
data FieldValue_
type FieldValue = Tree FieldValue_
data Ident_
type Ident = Tree Ident_
data Tree :: * -> * where
Module :: [Import] -> [Decl] -> Tree Module_
Import :: Ident -> Tree Import_
DataDecl :: Ident -> Exp -> [ConsDecl] -> Tree Decl_
TypeDecl :: Ident -> Exp -> Tree Decl_
ValueDecl :: Ident -> [Pattern] -> Exp -> Tree Decl_
DeriveDecl :: Ident -> Ident -> Tree Decl_
ConsDecl :: Ident -> Exp -> Tree ConsDecl_
POr :: Pattern -> Pattern -> Tree Pattern_
PListCons :: Pattern -> Pattern -> Tree Pattern_
PConsTop :: Ident -> Pattern -> [Pattern] -> Tree Pattern_
PCons :: Ident -> [Pattern] -> Tree Pattern_
PRec :: [FieldPattern] -> Tree Pattern_
PList :: [PListElem] -> Tree Pattern_
PType :: Tree Pattern_
PStr :: String -> Tree Pattern_
PInt :: Integer -> Tree Pattern_
PVar :: Ident -> Tree Pattern_
PWild :: Tree Pattern_
PListElem :: Pattern -> Tree PListElem_
FieldPattern :: Ident -> Pattern -> Tree FieldPattern_
ELet :: [LetDef] -> Exp -> Tree Exp_
ECase :: Exp -> [Case] -> Tree Exp_
EIf :: Exp -> Exp -> Exp -> Tree Exp_
EDo :: [Bind] -> Exp -> Tree Exp_
EAbs :: VarOrWild -> Exp -> Tree Exp_
EPi :: VarOrWild -> Exp -> Exp -> Tree Exp_
EPiNoVar :: Exp -> Exp -> Tree Exp_
EBind :: Exp -> Exp -> Tree Exp_
EBindC :: Exp -> Exp -> Tree Exp_
EOr :: Exp -> Exp -> Tree Exp_
EAnd :: Exp -> Exp -> Tree Exp_
EEq :: Exp -> Exp -> Tree Exp_
ENe :: Exp -> Exp -> Tree Exp_
ELt :: Exp -> Exp -> Tree Exp_
ELe :: Exp -> Exp -> Tree Exp_
EGt :: Exp -> Exp -> Tree Exp_
EGe :: Exp -> Exp -> Tree Exp_
EListCons :: Exp -> Exp -> Tree Exp_
EAdd :: Exp -> Exp -> Tree Exp_
ESub :: Exp -> Exp -> Tree Exp_
EMul :: Exp -> Exp -> Tree Exp_
EDiv :: Exp -> Exp -> Tree Exp_
EMod :: Exp -> Exp -> Tree Exp_
ENeg :: Exp -> Tree Exp_
EApp :: Exp -> Exp -> Tree Exp_
EProj :: Exp -> Ident -> Tree Exp_
ERecType :: [FieldType] -> Tree Exp_
ERec :: [FieldValue] -> Tree Exp_
EList :: [Exp] -> Tree Exp_
EVar :: Ident -> Tree Exp_
EType :: Tree Exp_
EStr :: String -> Tree Exp_
EInteger :: Integer -> Tree Exp_
EDouble :: Double -> Tree Exp_
EMeta :: Tree Exp_
LetDef :: Ident -> Exp -> Exp -> Tree LetDef_
Case :: Pattern -> Exp -> Tree Case_
BindVar :: VarOrWild -> Exp -> Tree Bind_
BindNoVar :: Exp -> Tree Bind_
VVar :: Ident -> Tree VarOrWild_
VWild :: Tree VarOrWild_
FieldType :: Ident -> Exp -> Tree FieldType_
FieldValue :: Ident -> Exp -> Tree FieldValue_
Ident :: String -> Tree Ident_
composOp :: (forall a. Tree a -> Tree a) -> Tree c -> Tree c
composOp f = head . composOpM (\x -> [f x])
composOpM_ :: Monad m => (forall a. Tree a -> m ()) -> Tree c -> m ()
composOpM_ = composOpFold (return ()) (>>)
composOpMPlus :: MonadPlus m => (forall a. Tree a -> m b) -> Tree c -> m b
composOpMPlus = composOpFold mzero mplus
composOpMonoid :: Monoid m => (forall a. Tree a -> m) -> Tree c -> m
composOpMonoid = composOpFold mempty mappend
composOpM :: Monad m => (forall a. Tree a -> m (Tree a)) -> Tree c -> m (Tree c)
composOpM f t = case t of
Module imports decls -> return Module `ap` mapM f imports `ap` mapM f decls
Import i -> return Import `ap` f i
DataDecl i exp consdecls -> return DataDecl `ap` f i `ap` f exp `ap` mapM f consdecls
TypeDecl i exp -> return TypeDecl `ap` f i `ap` f exp
ValueDecl i patterns exp -> return ValueDecl `ap` f i `ap` mapM f patterns `ap` f exp
DeriveDecl i0 i1 -> return DeriveDecl `ap` f i0 `ap` f i1
ConsDecl i exp -> return ConsDecl `ap` f i `ap` f exp
POr pattern0 pattern1 -> return POr `ap` f pattern0 `ap` f pattern1
PListCons pattern0 pattern1 -> return PListCons `ap` f pattern0 `ap` f pattern1
PConsTop i pattern patterns -> return PConsTop `ap` f i `ap` f pattern `ap` mapM f patterns
PCons i patterns -> return PCons `ap` f i `ap` mapM f patterns
PRec fieldpatterns -> return PRec `ap` mapM f fieldpatterns
PList plistelems -> return PList `ap` mapM f plistelems
PVar i -> return PVar `ap` f i
PListElem pattern -> return PListElem `ap` f pattern
FieldPattern i pattern -> return FieldPattern `ap` f i `ap` f pattern
ELet letdefs exp -> return ELet `ap` mapM f letdefs `ap` f exp
ECase exp cases -> return ECase `ap` f exp `ap` mapM f cases
EIf exp0 exp1 exp2 -> return EIf `ap` f exp0 `ap` f exp1 `ap` f exp2
EDo binds exp -> return EDo `ap` mapM f binds `ap` f exp
EAbs varorwild exp -> return EAbs `ap` f varorwild `ap` f exp
EPi varorwild exp0 exp1 -> return EPi `ap` f varorwild `ap` f exp0 `ap` f exp1
EPiNoVar exp0 exp1 -> return EPiNoVar `ap` f exp0 `ap` f exp1
EBind exp0 exp1 -> return EBind `ap` f exp0 `ap` f exp1
EBindC exp0 exp1 -> return EBindC `ap` f exp0 `ap` f exp1
EOr exp0 exp1 -> return EOr `ap` f exp0 `ap` f exp1
EAnd exp0 exp1 -> return EAnd `ap` f exp0 `ap` f exp1
EEq exp0 exp1 -> return EEq `ap` f exp0 `ap` f exp1
ENe exp0 exp1 -> return ENe `ap` f exp0 `ap` f exp1
ELt exp0 exp1 -> return ELt `ap` f exp0 `ap` f exp1
ELe exp0 exp1 -> return ELe `ap` f exp0 `ap` f exp1
EGt exp0 exp1 -> return EGt `ap` f exp0 `ap` f exp1
EGe exp0 exp1 -> return EGe `ap` f exp0 `ap` f exp1
EListCons exp0 exp1 -> return EListCons `ap` f exp0 `ap` f exp1
EAdd exp0 exp1 -> return EAdd `ap` f exp0 `ap` f exp1
ESub exp0 exp1 -> return ESub `ap` f exp0 `ap` f exp1
EMul exp0 exp1 -> return EMul `ap` f exp0 `ap` f exp1
EDiv exp0 exp1 -> return EDiv `ap` f exp0 `ap` f exp1
EMod exp0 exp1 -> return EMod `ap` f exp0 `ap` f exp1
ENeg exp -> return ENeg `ap` f exp
EApp exp0 exp1 -> return EApp `ap` f exp0 `ap` f exp1
EProj exp i -> return EProj `ap` f exp `ap` f i
ERecType fieldtypes -> return ERecType `ap` mapM f fieldtypes
ERec fieldvalues -> return ERec `ap` mapM f fieldvalues
EList exps -> return EList `ap` mapM f exps
EVar i -> return EVar `ap` f i
LetDef i exp0 exp1 -> return LetDef `ap` f i `ap` f exp0 `ap` f exp1
Case pattern exp -> return Case `ap` f pattern `ap` f exp
BindVar varorwild exp -> return BindVar `ap` f varorwild `ap` f exp
BindNoVar exp -> return BindNoVar `ap` f exp
VVar i -> return VVar `ap` f i
FieldType i exp -> return FieldType `ap` f i `ap` f exp
FieldValue i exp -> return FieldValue `ap` f i `ap` f exp
_ -> return t
composOpFold :: b -> (b -> b -> b) -> (forall a. Tree a -> b) -> Tree c -> b
composOpFold zero combine f t = case t of
Module imports decls -> foldr combine zero (map f imports) `combine` foldr combine zero (map f decls)
Import i -> f i
DataDecl i exp consdecls -> f i `combine` f exp `combine` foldr combine zero (map f consdecls)
TypeDecl i exp -> f i `combine` f exp
ValueDecl i patterns exp -> f i `combine` foldr combine zero (map f patterns) `combine` f exp
DeriveDecl i0 i1 -> f i0 `combine` f i1
ConsDecl i exp -> f i `combine` f exp
POr pattern0 pattern1 -> f pattern0 `combine` f pattern1
PListCons pattern0 pattern1 -> f pattern0 `combine` f pattern1
PConsTop i pattern patterns -> f i `combine` f pattern `combine` foldr combine zero (map f patterns)
PCons i patterns -> f i `combine` foldr combine zero (map f patterns)
PRec fieldpatterns -> foldr combine zero (map f fieldpatterns)
PList plistelems -> foldr combine zero (map f plistelems)
PVar i -> f i
PListElem pattern -> f pattern
FieldPattern i pattern -> f i `combine` f pattern
ELet letdefs exp -> foldr combine zero (map f letdefs) `combine` f exp
ECase exp cases -> f exp `combine` foldr combine zero (map f cases)
EIf exp0 exp1 exp2 -> f exp0 `combine` f exp1 `combine` f exp2
EDo binds exp -> foldr combine zero (map f binds) `combine` f exp
EAbs varorwild exp -> f varorwild `combine` f exp
EPi varorwild exp0 exp1 -> f varorwild `combine` f exp0 `combine` f exp1
EPiNoVar exp0 exp1 -> f exp0 `combine` f exp1
EBind exp0 exp1 -> f exp0 `combine` f exp1
EBindC exp0 exp1 -> f exp0 `combine` f exp1
EOr exp0 exp1 -> f exp0 `combine` f exp1
EAnd exp0 exp1 -> f exp0 `combine` f exp1
EEq exp0 exp1 -> f exp0 `combine` f exp1
ENe exp0 exp1 -> f exp0 `combine` f exp1
ELt exp0 exp1 -> f exp0 `combine` f exp1
ELe exp0 exp1 -> f exp0 `combine` f exp1
EGt exp0 exp1 -> f exp0 `combine` f exp1
EGe exp0 exp1 -> f exp0 `combine` f exp1
EListCons exp0 exp1 -> f exp0 `combine` f exp1
EAdd exp0 exp1 -> f exp0 `combine` f exp1
ESub exp0 exp1 -> f exp0 `combine` f exp1
EMul exp0 exp1 -> f exp0 `combine` f exp1
EDiv exp0 exp1 -> f exp0 `combine` f exp1
EMod exp0 exp1 -> f exp0 `combine` f exp1
ENeg exp -> f exp
EApp exp0 exp1 -> f exp0 `combine` f exp1
EProj exp i -> f exp `combine` f i
ERecType fieldtypes -> foldr combine zero (map f fieldtypes)
ERec fieldvalues -> foldr combine zero (map f fieldvalues)
EList exps -> foldr combine zero (map f exps)
EVar i -> f i
LetDef i exp0 exp1 -> f i `combine` f exp0 `combine` f exp1
Case pattern exp -> f pattern `combine` f exp
BindVar varorwild exp -> f varorwild `combine` f exp
BindNoVar exp -> f exp
VVar i -> f i
FieldType i exp -> f i `combine` f exp
FieldValue i exp -> f i `combine` f exp
_ -> zero
instance Show (Tree c) where
showsPrec n t = case t of
Module imports decls -> opar n . showString "Module" . showChar ' ' . showsPrec 1 imports . showChar ' ' . showsPrec 1 decls . cpar n
Import i -> opar n . showString "Import" . showChar ' ' . showsPrec 1 i . cpar n
DataDecl i exp consdecls -> opar n . showString "DataDecl" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 exp . showChar ' ' . showsPrec 1 consdecls . cpar n
TypeDecl i exp -> opar n . showString "TypeDecl" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 exp . cpar n
ValueDecl i patterns exp -> opar n . showString "ValueDecl" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 patterns . showChar ' ' . showsPrec 1 exp . cpar n
DeriveDecl i0 i1 -> opar n . showString "DeriveDecl" . showChar ' ' . showsPrec 1 i0 . showChar ' ' . showsPrec 1 i1 . cpar n
ConsDecl i exp -> opar n . showString "ConsDecl" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 exp . cpar n
POr pattern0 pattern1 -> opar n . showString "POr" . showChar ' ' . showsPrec 1 pattern0 . showChar ' ' . showsPrec 1 pattern1 . cpar n
PListCons pattern0 pattern1 -> opar n . showString "PListCons" . showChar ' ' . showsPrec 1 pattern0 . showChar ' ' . showsPrec 1 pattern1 . cpar n
PConsTop i pattern patterns -> opar n . showString "PConsTop" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 pattern . showChar ' ' . showsPrec 1 patterns . cpar n
PCons i patterns -> opar n . showString "PCons" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 patterns . cpar n
PRec fieldpatterns -> opar n . showString "PRec" . showChar ' ' . showsPrec 1 fieldpatterns . cpar n
PList plistelems -> opar n . showString "PList" . showChar ' ' . showsPrec 1 plistelems . cpar n
PType -> showString "PType"
PStr str -> opar n . showString "PStr" . showChar ' ' . showsPrec 1 str . cpar n
PInt n -> opar n . showString "PInt" . showChar ' ' . showsPrec 1 n . cpar n
PVar i -> opar n . showString "PVar" . showChar ' ' . showsPrec 1 i . cpar n
PWild -> showString "PWild"
PListElem pattern -> opar n . showString "PListElem" . showChar ' ' . showsPrec 1 pattern . cpar n
FieldPattern i pattern -> opar n . showString "FieldPattern" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 pattern . cpar n
ELet letdefs exp -> opar n . showString "ELet" . showChar ' ' . showsPrec 1 letdefs . showChar ' ' . showsPrec 1 exp . cpar n
ECase exp cases -> opar n . showString "ECase" . showChar ' ' . showsPrec 1 exp . showChar ' ' . showsPrec 1 cases . cpar n
EIf exp0 exp1 exp2 -> opar n . showString "EIf" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . showChar ' ' . showsPrec 1 exp2 . cpar n
EDo binds exp -> opar n . showString "EDo" . showChar ' ' . showsPrec 1 binds . showChar ' ' . showsPrec 1 exp . cpar n
EAbs varorwild exp -> opar n . showString "EAbs" . showChar ' ' . showsPrec 1 varorwild . showChar ' ' . showsPrec 1 exp . cpar n
EPi varorwild exp0 exp1 -> opar n . showString "EPi" . showChar ' ' . showsPrec 1 varorwild . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
EPiNoVar exp0 exp1 -> opar n . showString "EPiNoVar" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
EBind exp0 exp1 -> opar n . showString "EBind" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
EBindC exp0 exp1 -> opar n . showString "EBindC" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
EOr exp0 exp1 -> opar n . showString "EOr" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
EAnd exp0 exp1 -> opar n . showString "EAnd" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
EEq exp0 exp1 -> opar n . showString "EEq" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
ENe exp0 exp1 -> opar n . showString "ENe" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
ELt exp0 exp1 -> opar n . showString "ELt" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
ELe exp0 exp1 -> opar n . showString "ELe" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
EGt exp0 exp1 -> opar n . showString "EGt" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
EGe exp0 exp1 -> opar n . showString "EGe" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
EListCons exp0 exp1 -> opar n . showString "EListCons" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
EAdd exp0 exp1 -> opar n . showString "EAdd" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
ESub exp0 exp1 -> opar n . showString "ESub" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
EMul exp0 exp1 -> opar n . showString "EMul" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
EDiv exp0 exp1 -> opar n . showString "EDiv" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
EMod exp0 exp1 -> opar n . showString "EMod" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
ENeg exp -> opar n . showString "ENeg" . showChar ' ' . showsPrec 1 exp . cpar n
EApp exp0 exp1 -> opar n . showString "EApp" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
EProj exp i -> opar n . showString "EProj" . showChar ' ' . showsPrec 1 exp . showChar ' ' . showsPrec 1 i . cpar n
ERecType fieldtypes -> opar n . showString "ERecType" . showChar ' ' . showsPrec 1 fieldtypes . cpar n
ERec fieldvalues -> opar n . showString "ERec" . showChar ' ' . showsPrec 1 fieldvalues . cpar n
EList exps -> opar n . showString "EList" . showChar ' ' . showsPrec 1 exps . cpar n
EVar i -> opar n . showString "EVar" . showChar ' ' . showsPrec 1 i . cpar n
EType -> showString "EType"
EStr str -> opar n . showString "EStr" . showChar ' ' . showsPrec 1 str . cpar n
EInteger n -> opar n . showString "EInteger" . showChar ' ' . showsPrec 1 n . cpar n
EDouble d -> opar n . showString "EDouble" . showChar ' ' . showsPrec 1 d . cpar n
EMeta -> showString "EMeta"
LetDef i exp0 exp1 -> opar n . showString "LetDef" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
Case pattern exp -> opar n . showString "Case" . showChar ' ' . showsPrec 1 pattern . showChar ' ' . showsPrec 1 exp . cpar n
BindVar varorwild exp -> opar n . showString "BindVar" . showChar ' ' . showsPrec 1 varorwild . showChar ' ' . showsPrec 1 exp . cpar n
BindNoVar exp -> opar n . showString "BindNoVar" . showChar ' ' . showsPrec 1 exp . cpar n
VVar i -> opar n . showString "VVar" . showChar ' ' . showsPrec 1 i . cpar n
VWild -> showString "VWild"
FieldType i exp -> opar n . showString "FieldType" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 exp . cpar n
FieldValue i exp -> opar n . showString "FieldValue" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 exp . cpar n
Ident str -> opar n . showString "Ident" . showChar ' ' . showsPrec 1 str . cpar n
where opar n = if n > 0 then showChar '(' else id
cpar n = if n > 0 then showChar ')' else id
instance Eq (Tree c) where (==) = johnMajorEq
johnMajorEq :: Tree a -> Tree b -> Bool
johnMajorEq (Module imports decls) (Module imports_ decls_) = imports == imports_ && decls == decls_
johnMajorEq (Import i) (Import i_) = i == i_
johnMajorEq (DataDecl i exp consdecls) (DataDecl i_ exp_ consdecls_) = i == i_ && exp == exp_ && consdecls == consdecls_
johnMajorEq (TypeDecl i exp) (TypeDecl i_ exp_) = i == i_ && exp == exp_
johnMajorEq (ValueDecl i patterns exp) (ValueDecl i_ patterns_ exp_) = i == i_ && patterns == patterns_ && exp == exp_
johnMajorEq (DeriveDecl i0 i1) (DeriveDecl i0_ i1_) = i0 == i0_ && i1 == i1_
johnMajorEq (ConsDecl i exp) (ConsDecl i_ exp_) = i == i_ && exp == exp_
johnMajorEq (POr pattern0 pattern1) (POr pattern0_ pattern1_) = pattern0 == pattern0_ && pattern1 == pattern1_
johnMajorEq (PListCons pattern0 pattern1) (PListCons pattern0_ pattern1_) = pattern0 == pattern0_ && pattern1 == pattern1_
johnMajorEq (PConsTop i pattern patterns) (PConsTop i_ pattern_ patterns_) = i == i_ && pattern == pattern_ && patterns == patterns_
johnMajorEq (PCons i patterns) (PCons i_ patterns_) = i == i_ && patterns == patterns_
johnMajorEq (PRec fieldpatterns) (PRec fieldpatterns_) = fieldpatterns == fieldpatterns_
johnMajorEq (PList plistelems) (PList plistelems_) = plistelems == plistelems_
johnMajorEq PType PType = True
johnMajorEq (PStr str) (PStr str_) = str == str_
johnMajorEq (PInt n) (PInt n_) = n == n_
johnMajorEq (PVar i) (PVar i_) = i == i_
johnMajorEq PWild PWild = True
johnMajorEq (PListElem pattern) (PListElem pattern_) = pattern == pattern_
johnMajorEq (FieldPattern i pattern) (FieldPattern i_ pattern_) = i == i_ && pattern == pattern_
johnMajorEq (ELet letdefs exp) (ELet letdefs_ exp_) = letdefs == letdefs_ && exp == exp_
johnMajorEq (ECase exp cases) (ECase exp_ cases_) = exp == exp_ && cases == cases_
johnMajorEq (EIf exp0 exp1 exp2) (EIf exp0_ exp1_ exp2_) = exp0 == exp0_ && exp1 == exp1_ && exp2 == exp2_
johnMajorEq (EDo binds exp) (EDo binds_ exp_) = binds == binds_ && exp == exp_
johnMajorEq (EAbs varorwild exp) (EAbs varorwild_ exp_) = varorwild == varorwild_ && exp == exp_
johnMajorEq (EPi varorwild exp0 exp1) (EPi varorwild_ exp0_ exp1_) = varorwild == varorwild_ && exp0 == exp0_ && exp1 == exp1_
johnMajorEq (EPiNoVar exp0 exp1) (EPiNoVar exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
johnMajorEq (EBind exp0 exp1) (EBind exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
johnMajorEq (EBindC exp0 exp1) (EBindC exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
johnMajorEq (EOr exp0 exp1) (EOr exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
johnMajorEq (EAnd exp0 exp1) (EAnd exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
johnMajorEq (EEq exp0 exp1) (EEq exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
johnMajorEq (ENe exp0 exp1) (ENe exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
johnMajorEq (ELt exp0 exp1) (ELt exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
johnMajorEq (ELe exp0 exp1) (ELe exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
johnMajorEq (EGt exp0 exp1) (EGt exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
johnMajorEq (EGe exp0 exp1) (EGe exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
johnMajorEq (EListCons exp0 exp1) (EListCons exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
johnMajorEq (EAdd exp0 exp1) (EAdd exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
johnMajorEq (ESub exp0 exp1) (ESub exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
johnMajorEq (EMul exp0 exp1) (EMul exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
johnMajorEq (EDiv exp0 exp1) (EDiv exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
johnMajorEq (EMod exp0 exp1) (EMod exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
johnMajorEq (ENeg exp) (ENeg exp_) = exp == exp_
johnMajorEq (EApp exp0 exp1) (EApp exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
johnMajorEq (EProj exp i) (EProj exp_ i_) = exp == exp_ && i == i_
johnMajorEq (ERecType fieldtypes) (ERecType fieldtypes_) = fieldtypes == fieldtypes_
johnMajorEq (ERec fieldvalues) (ERec fieldvalues_) = fieldvalues == fieldvalues_
johnMajorEq (EList exps) (EList exps_) = exps == exps_
johnMajorEq (EVar i) (EVar i_) = i == i_
johnMajorEq EType EType = True
johnMajorEq (EStr str) (EStr str_) = str == str_
johnMajorEq (EInteger n) (EInteger n_) = n == n_
johnMajorEq (EDouble d) (EDouble d_) = d == d_
johnMajorEq EMeta EMeta = True
johnMajorEq (LetDef i exp0 exp1) (LetDef i_ exp0_ exp1_) = i == i_ && exp0 == exp0_ && exp1 == exp1_
johnMajorEq (Case pattern exp) (Case pattern_ exp_) = pattern == pattern_ && exp == exp_
johnMajorEq (BindVar varorwild exp) (BindVar varorwild_ exp_) = varorwild == varorwild_ && exp == exp_
johnMajorEq (BindNoVar exp) (BindNoVar exp_) = exp == exp_
johnMajorEq (VVar i) (VVar i_) = i == i_
johnMajorEq VWild VWild = True
johnMajorEq (FieldType i exp) (FieldType i_ exp_) = i == i_ && exp == exp_
johnMajorEq (FieldValue i exp) (FieldValue i_ exp_) = i == i_ && exp == exp_
johnMajorEq (Ident str) (Ident str_) = str == str_
johnMajorEq _ _ = False
instance Ord (Tree c) where
compare x y = compare (index x) (index y) `mappend` compareSame x y
where
index (Module _ _) = 0
index (Import _) = 1
index (DataDecl _ _ _) = 2
index (TypeDecl _ _) = 3
index (ValueDecl _ _ _) = 4
index (DeriveDecl _ _) = 5
index (ConsDecl _ _) = 6
index (POr _ _) = 7
index (PListCons _ _) = 8
index (PConsTop _ _ _) = 9
index (PCons _ _) = 10
index (PRec _) = 11
index (PList _) = 12
index (PType ) = 13
index (PStr _) = 14
index (PInt _) = 15
index (PVar _) = 16
index (PWild ) = 17
index (PListElem _) = 18
index (FieldPattern _ _) = 19
index (ELet _ _) = 20
index (ECase _ _) = 21
index (EIf _ _ _) = 22
index (EDo _ _) = 23
index (EAbs _ _) = 24
index (EPi _ _ _) = 25
index (EPiNoVar _ _) = 26
index (EBind _ _) = 27
index (EBindC _ _) = 28
index (EOr _ _) = 29
index (EAnd _ _) = 30
index (EEq _ _) = 31
index (ENe _ _) = 32
index (ELt _ _) = 33
index (ELe _ _) = 34
index (EGt _ _) = 35
index (EGe _ _) = 36
index (EListCons _ _) = 37
index (EAdd _ _) = 38
index (ESub _ _) = 39
index (EMul _ _) = 40
index (EDiv _ _) = 41
index (EMod _ _) = 42
index (ENeg _) = 43
index (EApp _ _) = 44
index (EProj _ _) = 45
index (ERecType _) = 46
index (ERec _) = 47
index (EList _) = 48
index (EVar _) = 49
index (EType ) = 50
index (EStr _) = 51
index (EInteger _) = 52
index (EDouble _) = 53
index (EMeta ) = 54
index (LetDef _ _ _) = 55
index (Case _ _) = 56
index (BindVar _ _) = 57
index (BindNoVar _) = 58
index (VVar _) = 59
index (VWild ) = 60
index (FieldType _ _) = 61
index (FieldValue _ _) = 62
index (Ident _) = 63
compareSame (Module imports decls) (Module imports_ decls_) = mappend (compare imports imports_) (compare decls decls_)
compareSame (Import i) (Import i_) = compare i i_
compareSame (DataDecl i exp consdecls) (DataDecl i_ exp_ consdecls_) = mappend (compare i i_) (mappend (compare exp exp_) (compare consdecls consdecls_))
compareSame (TypeDecl i exp) (TypeDecl i_ exp_) = mappend (compare i i_) (compare exp exp_)
compareSame (ValueDecl i patterns exp) (ValueDecl i_ patterns_ exp_) = mappend (compare i i_) (mappend (compare patterns patterns_) (compare exp exp_))
compareSame (DeriveDecl i0 i1) (DeriveDecl i0_ i1_) = mappend (compare i0 i0_) (compare i1 i1_)
compareSame (ConsDecl i exp) (ConsDecl i_ exp_) = mappend (compare i i_) (compare exp exp_)
compareSame (POr pattern0 pattern1) (POr pattern0_ pattern1_) = mappend (compare pattern0 pattern0_) (compare pattern1 pattern1_)
compareSame (PListCons pattern0 pattern1) (PListCons pattern0_ pattern1_) = mappend (compare pattern0 pattern0_) (compare pattern1 pattern1_)
compareSame (PConsTop i pattern patterns) (PConsTop i_ pattern_ patterns_) = mappend (compare i i_) (mappend (compare pattern pattern_) (compare patterns patterns_))
compareSame (PCons i patterns) (PCons i_ patterns_) = mappend (compare i i_) (compare patterns patterns_)
compareSame (PRec fieldpatterns) (PRec fieldpatterns_) = compare fieldpatterns fieldpatterns_
compareSame (PList plistelems) (PList plistelems_) = compare plistelems plistelems_
compareSame PType PType = EQ
compareSame (PStr str) (PStr str_) = compare str str_
compareSame (PInt n) (PInt n_) = compare n n_
compareSame (PVar i) (PVar i_) = compare i i_
compareSame PWild PWild = EQ
compareSame (PListElem pattern) (PListElem pattern_) = compare pattern pattern_
compareSame (FieldPattern i pattern) (FieldPattern i_ pattern_) = mappend (compare i i_) (compare pattern pattern_)
compareSame (ELet letdefs exp) (ELet letdefs_ exp_) = mappend (compare letdefs letdefs_) (compare exp exp_)
compareSame (ECase exp cases) (ECase exp_ cases_) = mappend (compare exp exp_) (compare cases cases_)
compareSame (EIf exp0 exp1 exp2) (EIf exp0_ exp1_ exp2_) = mappend (compare exp0 exp0_) (mappend (compare exp1 exp1_) (compare exp2 exp2_))
compareSame (EDo binds exp) (EDo binds_ exp_) = mappend (compare binds binds_) (compare exp exp_)
compareSame (EAbs varorwild exp) (EAbs varorwild_ exp_) = mappend (compare varorwild varorwild_) (compare exp exp_)
compareSame (EPi varorwild exp0 exp1) (EPi varorwild_ exp0_ exp1_) = mappend (compare varorwild varorwild_) (mappend (compare exp0 exp0_) (compare exp1 exp1_))
compareSame (EPiNoVar exp0 exp1) (EPiNoVar exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
compareSame (EBind exp0 exp1) (EBind exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
compareSame (EBindC exp0 exp1) (EBindC exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
compareSame (EOr exp0 exp1) (EOr exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
compareSame (EAnd exp0 exp1) (EAnd exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
compareSame (EEq exp0 exp1) (EEq exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
compareSame (ENe exp0 exp1) (ENe exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
compareSame (ELt exp0 exp1) (ELt exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
compareSame (ELe exp0 exp1) (ELe exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
compareSame (EGt exp0 exp1) (EGt exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
compareSame (EGe exp0 exp1) (EGe exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
compareSame (EListCons exp0 exp1) (EListCons exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
compareSame (EAdd exp0 exp1) (EAdd exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
compareSame (ESub exp0 exp1) (ESub exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
compareSame (EMul exp0 exp1) (EMul exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
compareSame (EDiv exp0 exp1) (EDiv exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
compareSame (EMod exp0 exp1) (EMod exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
compareSame (ENeg exp) (ENeg exp_) = compare exp exp_
compareSame (EApp exp0 exp1) (EApp exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
compareSame (EProj exp i) (EProj exp_ i_) = mappend (compare exp exp_) (compare i i_)
compareSame (ERecType fieldtypes) (ERecType fieldtypes_) = compare fieldtypes fieldtypes_
compareSame (ERec fieldvalues) (ERec fieldvalues_) = compare fieldvalues fieldvalues_
compareSame (EList exps) (EList exps_) = compare exps exps_
compareSame (EVar i) (EVar i_) = compare i i_
compareSame EType EType = EQ
compareSame (EStr str) (EStr str_) = compare str str_
compareSame (EInteger n) (EInteger n_) = compare n n_
compareSame (EDouble d) (EDouble d_) = compare d d_
compareSame EMeta EMeta = EQ
compareSame (LetDef i exp0 exp1) (LetDef i_ exp0_ exp1_) = mappend (compare i i_) (mappend (compare exp0 exp0_) (compare exp1 exp1_))
compareSame (Case pattern exp) (Case pattern_ exp_) = mappend (compare pattern pattern_) (compare exp exp_)
compareSame (BindVar varorwild exp) (BindVar varorwild_ exp_) = mappend (compare varorwild varorwild_) (compare exp exp_)
compareSame (BindNoVar exp) (BindNoVar exp_) = compare exp exp_
compareSame (VVar i) (VVar i_) = compare i i_
compareSame VWild VWild = EQ
compareSame (FieldType i exp) (FieldType i_ exp_) = mappend (compare i i_) (compare exp exp_)
compareSame (FieldValue i exp) (FieldValue i_ exp_) = mappend (compare i i_) (compare exp exp_)
compareSame (Ident str) (Ident str_) = compare str str_
compareSame x y = error "BNFC error:" compareSame
|
