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
|
imports
{
import Patterns
import Data.Set(Set)
import qualified Data.Set as Set
import Data.Map(Map)
import qualified Data.Map as Map
}
TYPE Exprs = [Expr]
TYPE Decls = [Decl]
TYPE Chunks = [Chunk]
TYPE DataAlts = [DataAlt]
TYPE CaseAlts = [CaseAlt]
TYPE Types = [Type]
TYPE NamedTypes = [NamedType]
DATA Program | Program chunks : Chunks
ordered : Bool
DATA Chunk | Chunk name : String
comment : Decl
info : Decls
dataDef : Decls
cataFun : Decls
semDom : Decls
semWrapper : Decls
semFunctions : Decls
semNames : {[String]}
DATA Expr | Let decls : Decls
body : Expr
| Case expr : Expr
alts : CaseAlts
| Do stmts : Decls
body : Expr
| Lambda args : Exprs
body : Expr
| TupleExpr exprs : Exprs
| UnboxedTupleExpr exprs : Exprs
| App name : {String}
args : Exprs
| SimpleExpr txt : {String}
| TextExpr lns : {[String]}
| Trace txt : {String}
expr : Expr
| PragmaExpr onLeftSide : {Bool}
onNewLine : {Bool}
txt : {String}
expr : Expr
| LineExpr expr : Expr
| TypedExpr expr : Expr
tp : Type
| ResultExpr nt : String
expr : Expr
| InvokeExpr nt : String
expr : Expr
args : Exprs
| ResumeExpr nt : String
expr : Expr
left : Lhs
rhs : Expr
| SemFun nt : {String}
args : Exprs
body : Expr
DATA CaseAlt | CaseAlt left : Lhs
expr : Expr
DATA Decl | Decl left : Lhs
rhs : Expr
binds : {Set String} -- set of variable names bound by the left-hand side
uses : {Set String} -- set of variable names used by the right-hand side
| Bind left : Lhs
rhs : Expr
| BindLet left : Lhs
rhs : Expr
| Data name : {String}
params: {[String]}
alts : DataAlts
strict: Bool
derivings : {[String]}
| NewType name : {String}
params: {[String]}
con : {String}
tp : Type
| Type name : {String}
params: {[String]}
tp : Type
| TSig name : {String}
tp : Type
| Comment txt : {String}
| PragmaDecl txt : {String}
| Resume monadic : {Bool}
nt : String
left : Lhs
rhs : Expr
| EvalDecl nt : String
left : Lhs
rhs : Expr
DATA DataAlt | DataAlt name : {String}
args : Types
| Record name : {String}
args : NamedTypes
DATA NamedType | Named strict: {Bool}
name : {String}
tp : Type
DATA Type | Arr left : Type
right : Type
| CtxApp left : {[(String, [String])]}
right : Type
| QuantApp left : String
right : Type
| TypeApp func : Type
args : Types
| TupleType tps : Types
| UnboxedTupleType tps : Types
| List tp : Type
| SimpleType txt : {String}
| NontermType name : String
params : {[String]}
deforested : Bool
| TMaybe tp : Type
| TEither left : Type
right : Type
| TMap key : Type
value : Type
| TIntMap value : Type
| TSet tp : Type
| TIntSet
DATA Lhs | Pattern3 pat3 : Pattern
| Pattern3SM pat3 : Pattern
| TupleLhs comps : {[String]} -- \ [Lhs] appears to be more sensible
| UnboxedTupleLhs comps : {[String]} -- /
| Fun name : {String}
args : Exprs
| Unwrap name : {String} sub : Lhs
DERIVING Type : Show
{
-- 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
}
|
