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
|
-- UUAGC 0.9.56 (src-ag/Code.ag)
module Code where
{-# LINE 2 "src-ag/Code.ag" #-}
import Patterns
import Data.Set(Set)
import qualified Data.Set as Set
import Data.Map(Map)
import qualified Data.Map as Map
{-# LINE 13 "src-generated/Code.hs" #-}
{-# LINE 146 "src-ag/Code.ag" #-}
-- Unboxed tuples
-- unbox Whether unboxed tuples are wanted or not
-- inh The inherited attributes.
-- If there are none, no unboxing can take place,
-- because in that case the semantic function (a top-level identifier) would have an unboxed type.
-- Of course we can't have an unboxed 1-tuple
mkTupleExpr :: Bool -> Bool -> Exprs -> Expr
mkTupleExpr unbox' noInh exprs | not unbox' || noInh || length exprs == 1 = TupleExpr exprs
| otherwise = UnboxedTupleExpr exprs
mkTupleType :: Bool -> Bool -> Types -> Type
mkTupleType unbox' noInh tps | not unbox' || noInh || length tps == 1 = TupleType tps
| otherwise = UnboxedTupleType tps
mkTupleLhs :: Bool -> Bool -> [String] -> Lhs
mkTupleLhs unbox' noInh comps | not unbox' || noInh || length comps == 1 = TupleLhs comps
| otherwise = UnboxedTupleLhs comps
{-# LINE 31 "src-generated/Code.hs" #-}
-- CaseAlt -----------------------------------------------------
{-
alternatives:
alternative CaseAlt:
child left : Lhs
child expr : Expr
-}
data CaseAlt = CaseAlt (Lhs) (Expr)
-- CaseAlts ----------------------------------------------------
{-
alternatives:
alternative Cons:
child hd : CaseAlt
child tl : CaseAlts
alternative Nil:
-}
type CaseAlts = [CaseAlt]
-- Chunk -------------------------------------------------------
{-
alternatives:
alternative Chunk:
child name : {String}
child comment : Decl
child info : Decls
child dataDef : Decls
child cataFun : Decls
child semDom : Decls
child semWrapper : Decls
child semFunctions : Decls
child semNames : {[String]}
-}
data Chunk = Chunk (String) (Decl) (Decls) (Decls) (Decls) (Decls) (Decls) (Decls) (([String]))
-- Chunks ------------------------------------------------------
{-
alternatives:
alternative Cons:
child hd : Chunk
child tl : Chunks
alternative Nil:
-}
type Chunks = [Chunk]
-- DataAlt -----------------------------------------------------
{-
alternatives:
alternative DataAlt:
child name : {String}
child args : Types
alternative Record:
child name : {String}
child args : NamedTypes
-}
data DataAlt = DataAlt (String) (Types)
| Record (String) (NamedTypes)
-- DataAlts ----------------------------------------------------
{-
alternatives:
alternative Cons:
child hd : DataAlt
child tl : DataAlts
alternative Nil:
-}
type DataAlts = [DataAlt]
-- Decl --------------------------------------------------------
{-
alternatives:
alternative Decl:
child left : Lhs
child rhs : Expr
child binds : {Set String}
child uses : {Set String}
alternative Bind:
child left : Lhs
child rhs : Expr
alternative BindLet:
child left : Lhs
child rhs : Expr
alternative Data:
child name : {String}
child params : {[String]}
child alts : DataAlts
child strict : {Bool}
child derivings : {[String]}
alternative NewType:
child name : {String}
child params : {[String]}
child con : {String}
child tp : Type
alternative Type:
child name : {String}
child params : {[String]}
child tp : Type
alternative TSig:
child name : {String}
child tp : Type
alternative Comment:
child txt : {String}
alternative PragmaDecl:
child txt : {String}
alternative Resume:
child monadic : {Bool}
child nt : {String}
child left : Lhs
child rhs : Expr
alternative EvalDecl:
child nt : {String}
child left : Lhs
child rhs : Expr
-}
data Decl = Decl (Lhs) (Expr) ((Set String)) ((Set String))
| Bind (Lhs) (Expr)
| BindLet (Lhs) (Expr)
| Data (String) (([String])) (DataAlts) (Bool) (([String]))
| NewType (String) (([String])) (String) (Type)
| Type (String) (([String])) (Type)
| TSig (String) (Type)
| Comment (String)
| PragmaDecl (String)
| Resume (Bool) (String) (Lhs) (Expr)
| EvalDecl (String) (Lhs) (Expr)
-- Decls -------------------------------------------------------
{-
alternatives:
alternative Cons:
child hd : Decl
child tl : Decls
alternative Nil:
-}
type Decls = [Decl]
-- Expr --------------------------------------------------------
{-
alternatives:
alternative Let:
child decls : Decls
child body : Expr
alternative Case:
child expr : Expr
child alts : CaseAlts
alternative Do:
child stmts : Decls
child body : Expr
alternative Lambda:
child args : Exprs
child body : Expr
alternative TupleExpr:
child exprs : Exprs
alternative UnboxedTupleExpr:
child exprs : Exprs
alternative App:
child name : {String}
child args : Exprs
alternative SimpleExpr:
child txt : {String}
alternative TextExpr:
child lns : {[String]}
alternative Trace:
child txt : {String}
child expr : Expr
alternative PragmaExpr:
child onLeftSide : {Bool}
child onNewLine : {Bool}
child txt : {String}
child expr : Expr
alternative LineExpr:
child expr : Expr
alternative TypedExpr:
child expr : Expr
child tp : Type
alternative ResultExpr:
child nt : {String}
child expr : Expr
alternative InvokeExpr:
child nt : {String}
child expr : Expr
child args : Exprs
alternative ResumeExpr:
child nt : {String}
child expr : Expr
child left : Lhs
child rhs : Expr
alternative SemFun:
child nt : {String}
child args : Exprs
child body : Expr
-}
data Expr = Let (Decls) (Expr)
| Case (Expr) (CaseAlts)
| Do (Decls) (Expr)
| Lambda (Exprs) (Expr)
| TupleExpr (Exprs)
| UnboxedTupleExpr (Exprs)
| App (String) (Exprs)
| SimpleExpr (String)
| TextExpr (([String]))
| Trace (String) (Expr)
| PragmaExpr (Bool) (Bool) (String) (Expr)
| LineExpr (Expr)
| TypedExpr (Expr) (Type)
| ResultExpr (String) (Expr)
| InvokeExpr (String) (Expr) (Exprs)
| ResumeExpr (String) (Expr) (Lhs) (Expr)
| SemFun (String) (Exprs) (Expr)
-- Exprs -------------------------------------------------------
{-
alternatives:
alternative Cons:
child hd : Expr
child tl : Exprs
alternative Nil:
-}
type Exprs = [Expr]
-- Lhs ---------------------------------------------------------
{-
alternatives:
alternative Pattern3:
child pat3 : {Pattern}
alternative Pattern3SM:
child pat3 : {Pattern}
alternative TupleLhs:
child comps : {[String]}
alternative UnboxedTupleLhs:
child comps : {[String]}
alternative Fun:
child name : {String}
child args : Exprs
alternative Unwrap:
child name : {String}
child sub : Lhs
-}
data Lhs = Pattern3 (Pattern)
| Pattern3SM (Pattern)
| TupleLhs (([String]))
| UnboxedTupleLhs (([String]))
| Fun (String) (Exprs)
| Unwrap (String) (Lhs)
-- NamedType ---------------------------------------------------
{-
alternatives:
alternative Named:
child strict : {Bool}
child name : {String}
child tp : Type
-}
data NamedType = Named (Bool) (String) (Type)
-- NamedTypes --------------------------------------------------
{-
alternatives:
alternative Cons:
child hd : NamedType
child tl : NamedTypes
alternative Nil:
-}
type NamedTypes = [NamedType]
-- Program -----------------------------------------------------
{-
alternatives:
alternative Program:
child chunks : Chunks
child ordered : {Bool}
-}
data Program = Program (Chunks) (Bool)
-- Type --------------------------------------------------------
{-
alternatives:
alternative Arr:
child left : Type
child right : Type
alternative CtxApp:
child left : {[(String, [String])]}
child right : Type
alternative QuantApp:
child left : {String}
child right : Type
alternative TypeApp:
child func : Type
child args : Types
alternative TupleType:
child tps : Types
alternative UnboxedTupleType:
child tps : Types
alternative List:
child tp : Type
alternative SimpleType:
child txt : {String}
alternative NontermType:
child name : {String}
child params : {[String]}
child deforested : {Bool}
alternative TMaybe:
child tp : Type
alternative TEither:
child left : Type
child right : Type
alternative TMap:
child key : Type
child value : Type
alternative TIntMap:
child value : Type
alternative TSet:
child tp : Type
alternative TIntSet:
-}
data Type = Arr (Type) (Type)
| CtxApp (([(String, [String])])) (Type)
| QuantApp (String) (Type)
| TypeApp (Type) (Types)
| TupleType (Types)
| UnboxedTupleType (Types)
| List (Type)
| SimpleType (String)
| NontermType (String) (([String])) (Bool)
| TMaybe (Type)
| TEither (Type) (Type)
| TMap (Type) (Type)
| TIntMap (Type)
| TSet (Type)
| TIntSet
deriving ( Show)
-- Types -------------------------------------------------------
{-
alternatives:
alternative Cons:
child hd : Type
child tl : Types
alternative Nil:
-}
type Types = [Type]
|
