Status: | Merged | ||||||||
---|---|---|---|---|---|---|---|---|---|
Merged at revision: | 1262 | ||||||||
Proposed branch: | lp:~mgiuca/mars/atom | ||||||||
Merge into: | lp:mars | ||||||||
Diff against target: |
894 lines (+233/-144) 10 files modified
doc/dev/isa.rst (+16/-19) src/ast_cfg.m (+70/-45) src/cfg.m (+1/-1) src/interactive.m (+6/-1) src/interpret.m (+30/-19) src/ir.m (+19/-15) src/pretty.m (+14/-20) src/typedict.m (+34/-11) src/usedef.m (+14/-13) test/cases/compiler/ctorsym-unify.mar (+29/-0) |
||||||||
To merge this branch: | bzr merge lp:~mgiuca/mars/atom | ||||||||
Related bugs: |
|
Reviewer | Review Type | Date Requested | Status |
---|---|---|---|
Matt Giuca | Approve | ||
Review via email: mp+79226@code.launchpad.net |
Commit message
Description of the change
Added 'atoms' to instruction set, removed ld_intlit and ld_ctorsym, and changed code generator to generate atoms rather than instructions where possible.
Note that there may be a bug in typedict. See atom_type (it has an XXX). Whereas before, we would have loaded the ctorsym into a variable (which would have been given the correct local type), we are now pulling the type directly out of the global typedef, and ignoring its varset. Therefore, the varset of ctorsyms may be in the wrong namespace for local variables. Check this before merging.
- 1266. By Matt Giuca
-
Added test case ctorsym-unify for LP: #877111.
- 1267. By Matt Giuca
-
Test case ctorsym-unify: Added description, and a new test function that passes Nil as the only argument to a function.
- 1268. By Matt Giuca
-
typedict: XXX comment refers to bug LP: #877111.
- 1269. By Matt Giuca
-
typedict: Changed atom_type to thread a varset, so that it can augment the varset with ctorsym type variables.
Update code that uses it -- calls augment_globalref with the augmented varset.
Note: Currently atom_type doesn't actually update the varset. - 1270. By Matt Giuca
-
test case ctorsym-unify: cons now calls show on the two arguments, so that it requires the 'a' type dict.
This doesn't really change the test case, but it makes the output more clearly correct (since foo will pass the correct type dictionary). - 1271. By Matt Giuca
-
test case ctorsym: Added a new case, nil_id.
It currently passes, but when I tried to fix LP: #877111 it broke, so best to have it in here.
(reverse in the prelude broke; this is a simplified version of the same problem). - 1272. By Matt Giuca
-
typedict: augment_
instr_globalref s now uses the augmented varset from calling atom_type on a new_closure instruction (previously only did it for a call_global).
This doesn't have any effect now, but fixing atom_type to augment the varset properly would break on new_closure (see the nil_id case in the test file ctorsym-unify). - 1273. By Matt Giuca
-
typedict: atom_type now merges the ctorsym's varset into the local one and updates the type.
Now it performs type unification on a consistent namespace.
Fixes LP: #877111. - 1274. By Matt Giuca
-
interpret: Fix long lines.
Preview Diff
1 | === modified file 'doc/dev/isa.rst' |
2 | --- doc/dev/isa.rst 2011-05-11 08:14:46 +0000 |
3 | +++ doc/dev/isa.rst 2011-10-21 03:33:25 +0000 |
4 | @@ -111,25 +111,22 @@ |
5 | The basic instructions form the body of a basic block. Each block may have |
6 | zero or more basic instructions. |
7 | |
8 | +Many instructions accept an *atom*, which refers to one of the following: |
9 | + |
10 | +* A variable name, |
11 | +* An arbitrary-precision integer, or |
12 | +* A constant symbol (parameterless constructor). This MUST be the name of a |
13 | + constant symbol, not a constructor function. |
14 | + |
15 | :samp:`nop` |
16 | Does nothing. |
17 | |
18 | :samp:`mov {dest} {source}` |
19 | - Copies the value of variable `source` to `dest`. |
20 | - |
21 | -:samp:`ld_intlit {dest} {value}` |
22 | - Assigns the integer `value` to `dest`. `value` is an arbitrary-precision |
23 | - integer. |
24 | + Copies the value of atom `source` to variable `dest`. |
25 | |
26 | :samp:`ld_arraylit {dest} {sources}` |
27 | Creates a new array, with the values of the variables listed in `sources` |
28 | - as its elements, and assigns it to `dest`. `sources` is a list of |
29 | - variable names. |
30 | - |
31 | -:samp:`ld_ctorsym {dest} {ctor}` |
32 | - Loads the constant symbol constructor `ctor` to `dest`. This sets the |
33 | - variable to that constant value. `ctor` MUST be the name of a constant |
34 | - symbol, not a constructor function. |
35 | + as its elements, and assigns it to `dest`. `sources` is a list of atoms. |
36 | |
37 | :samp:`ld_cgc {dest} {cgc}` |
38 | Loads the value of a computable global constant `cgc` to `dest`. This may |
39 | @@ -160,7 +157,7 @@ |
40 | Destructively modifies a field of an object, by index of a given |
41 | constructor. Fields are indexed by parameters of the constructor used to |
42 | create the object (0 is the first parameter, etc). |
43 | - Copies the value of variable `value` to field number `index` of variable |
44 | + Copies the value of atom `value` to field number `index` of variable |
45 | `source`, mutating the object referenced by `source`. |
46 | `source` MUST be a variable of an algebraic data type. It MUST be |
47 | statically known to have been constructed with constructor `ctor`. This |
48 | @@ -175,7 +172,7 @@ |
49 | object (0 is the first parameter, etc). |
50 | Creates a new object with constructor `ctor`. Initialises all fields of |
51 | the new object with the values of the fields in `source`, except for field |
52 | - number `index`, which is initialised to the value of variable `value`. |
53 | + number `index`, which is initialised to the value of atom `value`. |
54 | Assigns the new object to `dest`. |
55 | `source` MUST be a variable of an algebraic data type. It MUST be |
56 | statically known to have been constructed with constructor `ctor`. This |
57 | @@ -189,7 +186,7 @@ |
58 | result to `dest`. Constructs a new function object with the parameters and |
59 | result of the closure template. |
60 | `func` MUST be the name of a closure template. |
61 | - `args` is a list of variables containing the arguments. It MUST contain |
62 | + `args` is a list of atoms containing the arguments. It MUST contain |
63 | the exact number of closure variables expected by `func`, and any |
64 | supplied arguments must be of correct types. |
65 | |
66 | @@ -203,7 +200,7 @@ |
67 | Calls a function from local variable `func`, supplying arguments `args` |
68 | and assigning the result to `dest`. |
69 | `func` MUST be a variable containing a function value. `args` is a list of |
70 | - variables containing the arguments. It MUST contain the exact number of |
71 | + atoms containing the arguments. It MUST contain the exact number of |
72 | arguments expected by `func`, of correct types. |
73 | The execution may cause side-effects or fail to return. |
74 | |
75 | @@ -211,7 +208,7 @@ |
76 | Calls constructor function `ctor`, supplying arguments `args` and |
77 | assigning the result to `dest`. |
78 | `ctor` MUST not be the name of a constant symbol. |
79 | - `args` is a list of variables containing the arguments. It MUST contain |
80 | + `args` is a list of atoms containing the arguments. It MUST contain |
81 | the exact number of arguments expected by `ctor`, of correct types. |
82 | |
83 | :samp:`call_global {dest} {func} {args}` |
84 | @@ -219,7 +216,7 @@ |
85 | result to `dest`. |
86 | `func` MUST not be the name of a computable global constant or |
87 | constructor. |
88 | - `args` is a list of variables containing the arguments. It MUST contain |
89 | + `args` is a list of atoms containing the arguments. It MUST contain |
90 | the exact number of arguments expected by `func`, of correct types. |
91 | The execution may cause side-effects or fail to return. |
92 | |
93 | @@ -252,7 +249,7 @@ |
94 | for the rather complicated algorithm that performs this translation. |
95 | |
96 | :samp:`cond_branch {if} {then} {else}` |
97 | - Conditional branch based on the value of the `if` variable, which MUST be |
98 | + Conditional branch based on the value of the `if` atom, which MUST be |
99 | an :type:`Int`. If `if` is not equal to 0, branches to the `then` block. |
100 | Otherwise, branches to the `else` block. |
101 | |
102 | |
103 | === modified file 'src/ast_cfg.m' |
104 | --- src/ast_cfg.m 2011-10-10 12:38:16 +0000 |
105 | +++ src/ast_cfg.m 2011-10-21 03:33:25 +0000 |
106 | @@ -51,19 +51,21 @@ |
107 | :- pred func_to_cfg(progtable::in, function::in, function::out, |
108 | list(function)::out) is det. |
109 | |
110 | -% expr_to_instrs(+PT, +Expr, -VarName, -Instrs, -Types, -SynthFuncs, |
111 | +% expr_to_instrs(+PT, +Expr, -Atom, -Instrs, -Types, -SynthFuncs, |
112 | % !ASTState). |
113 | -% Converts a single expression into a sequence of low-level instructions |
114 | -% which compute the expression and assign it to a variable (possibly a |
115 | -% new temporary variable name). Returns the assigned variable name in VarName. |
116 | +% Takes a single expression. If it is atomic (a variable name, int literal or |
117 | +% constructor symbol), returns it as an Atom. Otherwise, compiles the |
118 | +% expression into a sequence of low-level instructions which compute the |
119 | +% expression and assign it to a new temporary variable name). Returns the |
120 | +% assigned variable name in Atom. |
121 | % (May clobber the temporary variable namespace, as there is no block or |
122 | % subscript information given). Useful for stand-alone statements. |
123 | % Also produces map of types of all variables bound by the instructions. |
124 | -:- pred expr_to_instrs(progtable::in, varset::in, expr::in, varname::out, |
125 | +:- pred expr_to_instrs(progtable::in, varset::in, expr::in, atom::out, |
126 | list(instr)::out, map(varname, typeval)::out, list(function)::out, |
127 | ast_state::in, ast_state::out) is det. |
128 | |
129 | -% expr_to_instrs_post_ssa(+PT, +Varset, +BlockID, +Expr, -VarName, -Instrs, |
130 | +% expr_to_instrs_post_ssa(+PT, +Varset, +BlockID, +Expr, -Atom, -Instrs, |
131 | % -Types, -SynthFuncs, !BlockTempCount). |
132 | % Special version of expr_to_instrs, with some important restrictions: |
133 | % - Variables in the expr must already be in SSA form, will not be converted. |
134 | @@ -71,7 +73,7 @@ |
135 | % subscripts on the temporaries. BlockTempCount is the ID of the next |
136 | % available temporary in this block; it will be updated. |
137 | :- pred expr_to_instrs_post_ssa(progtable::in, varset::in, int::in, expr::in, |
138 | - varname::out, list(instr)::out, map(varname, typeval)::out, |
139 | + atom::out, list(instr)::out, map(varname, typeval)::out, |
140 | list(function)::out, int::in, int::out) is det. |
141 | |
142 | % basic_stmt_to_instrs(+PT, +BasicStmt, -Instrs, -Types, -SynthFuncs, |
143 | @@ -831,17 +833,17 @@ |
144 | pretty.string_pattern(P)). |
145 | pattern_type(pattern(_, yes(T))) = T. |
146 | |
147 | -% exprs_to_instrs(+PT, +BlockID, +Ctx, +Exprs, -VarNames, -Instrs, -Types, |
148 | +% exprs_to_instrs(+PT, +BlockID, +Ctx, +Exprs, -Atoms, -Instrs, -Types, |
149 | % !SubscriptMap). |
150 | :- pred exprs_to_instrs(progtable::in, varset::in, int::in, context::in, |
151 | - list(expr)::in, list(varname)::out, list(instr)::out, type_map::out, |
152 | + list(expr)::in, list(atom)::out, list(instr)::out, type_map::out, |
153 | subscript_map::in, subscript_map::out, |
154 | list(function)::in, list(function)::out) is det. |
155 | -exprs_to_instrs(PT, Varset, BlockID, Ctx, Es, VarNames, Instrs, Types, |
156 | +exprs_to_instrs(PT, Varset, BlockID, Ctx, Es, Atoms, Instrs, Types, |
157 | !SubscriptMap, !SynthFuncs) :- |
158 | - exprs_to_instrs_(PT, Varset, BlockID, Ctx, Es, Types, [], VarNamesRev, [], |
159 | + exprs_to_instrs_(PT, Varset, BlockID, Ctx, Es, Types, [], AtomsRev, [], |
160 | LLInstrsRev, !SubscriptMap, !SynthFuncs), |
161 | - list.reverse(VarNamesRev, VarNames), |
162 | + list.reverse(AtomsRev, Atoms), |
163 | list.reverse(LLInstrsRev, LLInstrs), |
164 | % "Condense" the list-of-lists into a flat list of instructions |
165 | list.condense(LLInstrs, Instrs). |
166 | @@ -851,37 +853,37 @@ |
167 | % Instrs is a list of lists (to be flattened). The outer list is reversed, the |
168 | % inner list is not -- this is to allow prepending. |
169 | :- pred exprs_to_instrs_(progtable::in, varset::in, int::in, context::in, |
170 | - list(expr)::in, type_map::out, list(varname)::in, list(varname)::out, |
171 | + list(expr)::in, type_map::out, list(atom)::in, list(atom)::out, |
172 | list(list(instr))::in, list(list(instr))::out, |
173 | subscript_map::in, subscript_map::out, |
174 | list(function)::in, list(function)::out) is det. |
175 | -exprs_to_instrs_(_PT, _Varset, _BlockID, _Ctx, [], map.init, !VarNames, |
176 | +exprs_to_instrs_(_PT, _Varset, _BlockID, _Ctx, [], map.init, !Atoms, |
177 | !Instrs, !SubscriptMap, !SynthFuncs). |
178 | -exprs_to_instrs_(PT, Varset, BlockID,Ctx,[E|Es],Types,!VarNames, !Instrs, |
179 | +exprs_to_instrs_(PT, Varset, BlockID,Ctx,[E|Es],Types,!Atoms, !Instrs, |
180 | !SubscriptMap, !SynthFuncs) :- |
181 | % Create a new variable name and generate instructions for each expr |
182 | - expr_to_instrs(PT, Varset, BlockID, Ctx, E, V, Is, Types0, !SubscriptMap, |
183 | + expr_to_instrs(PT, Varset, BlockID, Ctx, E, A, Is, Types0, !SubscriptMap, |
184 | !SynthFuncs), |
185 | - !:VarNames = [V | !.VarNames], |
186 | + !:Atoms = [A | !.Atoms], |
187 | !:Instrs = [Is | !.Instrs], % Do not flatten Is; keep as list of lists |
188 | - exprs_to_instrs_(PT, Varset, BlockID, Ctx, Es, Types1, !VarNames, !Instrs, |
189 | + exprs_to_instrs_(PT, Varset, BlockID, Ctx, Es, Types1, !Atoms, !Instrs, |
190 | !SubscriptMap, !SynthFuncs), |
191 | Types = type_map_union(Types0, Types1). |
192 | |
193 | -% expr_to_instrs(+BlockID, +Ctx, +Expr, -VarName, -Instrs, !SubscriptMap). |
194 | -% Converts a single expression into a sequence of low-level instructions |
195 | -% which compute the expression and assign it to a variable (possibly a |
196 | -% new temporary variable name). Returns the assigned variable name in VarName. |
197 | -:- pred expr_to_instrs(progtable::in, varset::in, int::in, context::in, |
198 | +% expr_to_instrs_var(+BlockID, +Ctx, +Expr, -VarName, -Instrs, !SubscriptMap). |
199 | +% Same as expr_to_instrs, but always produces a variable. (Atomic non-variable |
200 | +% expressions such as integer literals are converted into separate |
201 | +% instructions.) |
202 | +:- pred expr_to_instrs_var(progtable::in, varset::in, int::in, context::in, |
203 | expr::in, varname::out, list(instr)::out, type_map::out, |
204 | subscript_map::in, subscript_map::out, |
205 | list(function)::in, list(function)::out) is det. |
206 | -expr_to_instrs(PT, Varset, BlockID, Ctx, E, V, Is, Types, !SubscriptMap, |
207 | +expr_to_instrs_var(PT, Varset, BlockID, Ctx, E, V, Is, Types, !SubscriptMap, |
208 | !SynthFuncs) :- |
209 | ( E = expr(varref(Var), _) -> |
210 | % Special case -- expr_to_instrs_as will generate a mov. |
211 | % We can avoid this by not generating a temp var, and just returning |
212 | - % the variable name (with no instructions at all). |
213 | + % the variable name as an atom (with no instructions at all). |
214 | V = Var, |
215 | Is = [], |
216 | Types = map.init |
217 | @@ -891,6 +893,34 @@ |
218 | !SubscriptMap, !SynthFuncs) |
219 | ). |
220 | |
221 | +% expr_to_instrs(+BlockID, +Ctx, +Expr, -Atom, -Instrs, !SubscriptMap). |
222 | +% Converts a single expression into a sequence of low-level instructions |
223 | +% which compute the expression and assign it to a variable (possibly a |
224 | +% new temporary variable name). Returns the assigned variable name in VarName. |
225 | +:- pred expr_to_instrs(progtable::in, varset::in, int::in, context::in, |
226 | + expr::in, atom::out, list(instr)::out, type_map::out, |
227 | + subscript_map::in, subscript_map::out, |
228 | + list(function)::in, list(function)::out) is det. |
229 | +expr_to_instrs(PT, Varset, BlockID, Ctx, E, A, Is, Types, !SubscriptMap, |
230 | + !SynthFuncs) :- |
231 | + ( E = expr(intlit(Val), _) -> |
232 | + % Special case -- expr_to_instrs_var will generate a mov. |
233 | + % We can avoid this by just returning the int as an atom. |
234 | + A = intatom(Val), |
235 | + Is = [], |
236 | + Types = map.init |
237 | + ; E = expr(ctorref(Name), _), ir.ctor_is_cgc(PT, Name) -> |
238 | + % Special case -- expr_to_instrs_var will generate a mov. |
239 | + % We can avoid this by just returning the ctorsym as an atom. |
240 | + A = ctorsym(Name), |
241 | + Is = [], |
242 | + Types = map.init |
243 | + ; |
244 | + expr_to_instrs_var(PT, Varset, BlockID, Ctx, E, V, Is, Types, |
245 | + !SubscriptMap, !SynthFuncs), |
246 | + A = varname(V) |
247 | + ). |
248 | + |
249 | % XXX The *public* version of expr_to_instrs expects non-SSA variable names; |
250 | % it will convert them to SSA form. |
251 | % Conversely, the *private* version of expr_to_instrs expects |
252 | @@ -923,7 +953,7 @@ |
253 | expr_to_instrs_as(_PT, _Varset, _BlockID, Ctx, E@expr(intlit(Val),_), V, Is, |
254 | Types, !SubscriptMap, !SynthFuncs) :- |
255 | Types = expr_typemap(V, E), |
256 | - Is = [instr(ld_intlit(V, Val), Ctx)]. |
257 | + Is = [instr(mov(V, intatom(Val)), Ctx)]. |
258 | expr_to_instrs_as(PT, Varset, BlockID, Ctx, E@expr(arraylit(Elems0),_), V, Is, |
259 | Types, !SubscriptMap, !SynthFuncs) :- |
260 | Types0 = expr_typemap(V, E), |
261 | @@ -934,7 +964,7 @@ |
262 | expr_to_instrs_as(_PT, _Varset, _BlockID, Ctx, E@expr(varref(Var),_), V, Is, |
263 | Types, !SubscriptMap, !SynthFuncs) :- |
264 | Types = expr_typemap(V, E), |
265 | - Is = [instr(mov(V, Var), Ctx)]. |
266 | + Is = [instr(mov(V, varname(Var)), Ctx)]. |
267 | expr_to_instrs_as(PT, _Varset, _BlockID, Ctx, E@expr(globalref(Name),_), V, |
268 | Is, Types, !SubscriptMap, !SynthFuncs) :- |
269 | Types = expr_typemap(V, E), |
270 | @@ -952,8 +982,8 @@ |
271 | Types = expr_typemap(V, E), |
272 | % The instruction will depend upon the type of constructor |
273 | ( ir.ctor_is_cgc(PT, Name) -> |
274 | - % Algebraic constant. ld_ctorsym instruction. |
275 | - Is = [instr(ld_ctorsym(V, Name), Ctx)] |
276 | + % Algebraic constant. mov instruction, loading the ctorsym. |
277 | + Is = [instr(mov(V, ctorsym(Name)), Ctx)] |
278 | ; |
279 | % Constructor function. Generate synthetic closure template; no cvars. |
280 | parcall_ctor_closure_template(PT, Name, 0, CTName, !SynthFuncs), |
281 | @@ -1005,7 +1035,7 @@ |
282 | Is1 = [instr(call_ctor(V, CtorName, Args), Ctx)], |
283 | Is = Is0 ++ Is1 |
284 | ; |
285 | - expr_to_instrs(PT, Varset, BlockID, Ctx, Func0, Func, Is0, Types1, |
286 | + expr_to_instrs_var(PT, Varset, BlockID, Ctx, Func0, Func, Is0, Types1, |
287 | !SubscriptMap, !SynthFuncs), |
288 | exprs_to_instrs(PT, Varset, BlockID, Ctx, Args0, Args, Is1, Types2, |
289 | !SubscriptMap, !SynthFuncs), |
290 | @@ -1174,8 +1204,8 @@ |
291 | % Calculate the condition expression at the end of BBCurrent |
292 | apply_def_map_to_expr(DefMap, Ctx, Ctrl0, Ctrl), |
293 | BlockID = ref_id(BBCurrent, !.CFG), |
294 | - expr_to_instrs(PT, Varset, BlockID, Ctx, Ctrl, CtrlVar, CtrlInstrs, |
295 | - Types0, SubscriptMap0, SubscriptMap, !SynthFuncs), |
296 | + expr_to_instrs_var(PT, Varset, BlockID, Ctx, Ctrl, CtrlVar, CtrlInstrs, |
297 | + Types0, SubscriptMap0, SubscriptMap, !SynthFuncs), |
298 | cfg.append_instrs(BBCurrent, CtrlInstrs, !CFG), |
299 | % Convert all patterns to use SSA variables, and generate CFG code for the |
300 | % bodies of all case statements. The resulting Cases contains goto |
301 | @@ -1884,7 +1914,7 @@ |
302 | RetType = ObjType, |
303 | InstrBuilder = (func(Dst, Ctor, Idx) = |
304 | i_fieldreplace(Dst, svname("object"), Ctor, Idx, |
305 | - svname("value"))). |
306 | + varname(svname("value")))). |
307 | |
308 | % fieldfunc_set(Typedef, FieldName, FieldType) builds a field set function. |
309 | :- func fieldfunc_set(typedef, string, typeval) = function. |
310 | @@ -1897,7 +1927,7 @@ |
311 | RetType = ObjType, |
312 | InstrBuilder = (func(_Dst, Ctor, Idx) = |
313 | i_fieldset(svname("object"), Ctor, Idx, |
314 | - svname("value"))). |
315 | + varname(svname("value")))). |
316 | |
317 | % fieldfunc_(Typedef, FieldName, FuncName, Params, RetType, InstrBuilder, |
318 | % Obj, RetVar) |
319 | @@ -1958,7 +1988,7 @@ |
320 | list.map(func(B-_) = B, Preds), !CFG), |
321 | ( RetVar = yes(RetN) -> |
322 | % If RetVar, return the given variable name |
323 | - cfg.append_instr(Exit, instr(mov(retvname, RetN), |
324 | + cfg.append_instr(Exit, instr(mov(retvname, varname(RetN)), |
325 | Typedef^typedef_context), !CFG), |
326 | % The "Dst variables" should never have been assigned; don't put |
327 | % them in the localtable |
328 | @@ -2008,24 +2038,19 @@ |
329 | cfg.append_predecessor(Bl, Pred, !CFG), |
330 | Msg = string.format("%s instance has no field \"%s\"", |
331 | [s(Typedef^typedef_name), s(FieldName)]), |
332 | - list.map_foldl2((pred(Chr::in, V::out, ID::in, ID+1::out, C0::in, C::out) |
333 | - is det :- |
334 | - V = qvname(qvname(tempvname, cfg.ref_id(Bl, C0)), ID), |
335 | - I = instr(ld_intlit(V, integer(char.to_int(Chr))), Ctx), |
336 | - cfg.append_instr(Bl, I, C0, C) |
337 | - ), string.to_char_list(Msg), CharVars, 0, _, !CFG), |
338 | + CharAtoms = list.map(func(Chr) = intatom(integer(char.to_int(Chr))), |
339 | + string.to_char_list(Msg)), |
340 | % Call the 'error' built-in with this message as a Mars string |
341 | MsgVar = qvname(tempvname, cfg.ref_id(Bl, !.CFG)), |
342 | - MsgInstr = instr(ld_arraylit(MsgVar, CharVars), Ctx), |
343 | + MsgInstr = instr(ld_arraylit(MsgVar, CharAtoms), Ctx), |
344 | cfg.append_instr(Bl, MsgInstr, !CFG), |
345 | % Assign the result to a new variable |
346 | Dst = qvname(retvname, cfg.ref_id(Bl, !.CFG)), |
347 | - Instr = instr(call_global(Dst, "error", [MsgVar]), Ctx), |
348 | + Instr = instr(call_global(Dst, "error", [varname(MsgVar)]), Ctx), |
349 | cfg.append_instr(Bl, Instr, !CFG), |
350 | Term = branch(Exit, Ctx), |
351 | cfg.set_terminator(Bl, Term, !CFG), |
352 | - TypeMap = map(func(V) = V-types.const("Int"), CharVars) ++ |
353 | - [MsgVar-types.app(types.const("Array"), [types.const("Int")])]. |
354 | + TypeMap = [MsgVar-types.app(types.const("Array"), [types.const("Int")])]. |
355 | |
356 | % -------------------------------------------------------------------------- % |
357 | % Closure template generation |
358 | |
359 | === modified file 'src/cfg.m' |
360 | --- src/cfg.m 2011-10-08 06:55:14 +0000 |
361 | +++ src/cfg.m 2011-10-21 03:33:25 +0000 |
362 | @@ -51,7 +51,7 @@ |
363 | :- type bbref(S). |
364 | |
365 | % A phi is a phi statement in Static Single Assignment notation. |
366 | -% It maps a variable name V onto a mapping from bbrefs to varnames. |
367 | +% It maps a variable name V onto a mapping from bbrefs to atoms. |
368 | % The bbref is a predecessor block P, and the varname is V0. |
369 | % That is to say, "if you just came from block P, set V to the value of V0". |
370 | :- type phi(S) |
371 | |
372 | === modified file 'src/interactive.m' |
373 | --- src/interactive.m 2011-10-21 03:11:44 +0000 |
374 | +++ src/interactive.m 2011-10-21 03:33:25 +0000 |
375 | @@ -385,8 +385,13 @@ |
376 | yes(types.app(types.const("Array"), |
377 | [types.const("Int")]))), |
378 | ast_cfg.expr_to_instrs(!.State^st_progtable, !.State^st_localvarset, |
379 | - ShowExpr, VarName, Instrs0, Types_Raw, SynthFuncs, |
380 | + ShowExpr, Atom, Instrs0, Types_Raw, SynthFuncs, |
381 | !.State^st_aststate, NewASTState0), |
382 | + ( Atom = ir.varname(VarName_) -> |
383 | + VarName = VarName_ |
384 | + ; |
385 | + error("expr_to_instrs returned non-variable") |
386 | + ), |
387 | % Return the name of the temporary |
388 | Result = yes(VarName) |
389 | ; |
390 | |
391 | === modified file 'src/interpret.m' |
392 | --- src/interpret.m 2011-10-21 03:11:44 +0000 |
393 | +++ src/interpret.m 2011-10-21 03:33:25 +0000 |
394 | @@ -162,6 +162,21 @@ |
395 | ir.varname_string(VarName)) |
396 | ). |
397 | |
398 | +% atom_value(+Atom, -Value, !Env, !IO) |
399 | +% Converts an atom into a runtime value. |
400 | +% If the atom is a variable, searches the environment for that variable, and |
401 | +% aborts if it is not found. Similarly, ctor symbols abort if not found. |
402 | +% Unfortunately, requires a mutable environment and IO, due to the very |
403 | +% backwards way in which we construct constructor symbol terms. |
404 | +:- pred atom_value(atom::in, value::out, env::in, env::out, io::di, io::uo) |
405 | + is det. |
406 | +atom_value(varname(VarName), Value, !Env, !IO) :- |
407 | + local_search_det(!.Env, VarName, Value). |
408 | +atom_value(intatom(I), Value, !Env, !IO) :- |
409 | + Value = val_int(I). |
410 | +atom_value(ctorsym(Name), Value, !Env, !IO) :- |
411 | + read_ctor(Name, Value, !Env, !IO). |
412 | + |
413 | % global_search(Env, VarName, Value) |
414 | % Searches an environment for a global variable of the given name, and returns |
415 | % its value. |
416 | @@ -455,13 +470,14 @@ |
417 | Result = Result0 |
418 | ). |
419 | |
420 | -% read_var_into_vector(!Env, VectorRef, VarName, !IO). |
421 | -% Reads a local variable, and appends its value onto the end of the vector. |
422 | +% read_atom_into_vector(!Env, VectorRef, Atom, !IO). |
423 | +% Reads a local variable or atom, and appends its value onto the end of the |
424 | +% vector. |
425 | % Uses IO as the vector's store. |
426 | -:- pred read_var_into_vector(vectorref(value, io)::in, varname::in, |
427 | +:- pred read_atom_into_vector(vectorref(value, io)::in, atom::in, |
428 | env::in, env::out, io::di, io::uo) is det. |
429 | -read_var_into_vector(VectorRef, VarName, !Env, !IO) :- |
430 | - local_search_det(!.Env, VarName, Value), |
431 | +read_atom_into_vector(VectorRef, Atom, !Env, !IO) :- |
432 | + atom_value(Atom, Value, !Env, !IO), |
433 | vectorref.add(VectorRef, Value, !IO). |
434 | |
435 | % Insert a set of new functions into the runtime environment. |
436 | @@ -490,11 +506,11 @@ |
437 | io::di, io::uo) is det. |
438 | exec_instr_(nop, _Ctx, !Env, !IO). |
439 | exec_instr_(mov(Dst, Src), _Ctx, !Env, !IO) :- |
440 | - local_search_det(!.Env, Src, Result), |
441 | + atom_value(Src, Result, !Env, !IO), |
442 | env_assign_local(Dst, Result, !Env). |
443 | exec_instr_(i_fieldset(ValName, ICtor, Idx, SrcName), _Ctx, !Env, !IO) :- |
444 | local_search_det(!.Env, ValName, Val), |
445 | - local_search_det(!.Env, SrcName, Src), |
446 | + atom_value(SrcName, Src, !Env, !IO), |
447 | ( Val = val_term(Term) -> % Must match supplied Ctor name |
448 | store.get_mutvar(Term, marsterm(Ctor, Fields0), !IO), |
449 | field_check_ctor(ICtor, Ctor), % May abort |
450 | @@ -516,7 +532,7 @@ |
451 | exec_instr_(i_fieldreplace(Dst, ValName, ICtor, Idx, SrcName), _Ctx, |
452 | !Env, !IO) :- |
453 | local_search_det(!.Env, ValName, Val), |
454 | - local_search_det(!.Env, SrcName, Src), |
455 | + atom_value(SrcName, Src, !Env, !IO), |
456 | ( Val = val_term(Term0) -> % Must match supplied Ctor name |
457 | store.get_mutvar(Term0, marsterm(Ctor, Fields0), !IO), |
458 | field_check_ctor(ICtor, Ctor), % May abort |
459 | @@ -536,18 +552,13 @@ |
460 | store.new_mutvar(marsterm(Ctor, Fields), Term, !IO), |
461 | Result = val_term(Term), |
462 | env_assign_local(Dst, Result, !Env). |
463 | -exec_instr_(ld_intlit(Dst, I), _Ctx, !Env, !IO) :- |
464 | - env_assign_local(Dst, val_int(I), !Env). |
465 | exec_instr_(ld_arraylit(Dst, Elems), _Ctx, !Env, !IO) :- |
466 | % Create a new, empty vector of values |
467 | Capacity = good_vector_capacity(list.length(Elems)), |
468 | vectorref.init(Capacity, VectorRef, !IO), |
469 | % Evaluate each expression, populating the vector |
470 | - list.foldl2(read_var_into_vector(VectorRef), Elems, !Env, !IO), |
471 | + list.foldl2(read_atom_into_vector(VectorRef), Elems, !Env, !IO), |
472 | env_assign_local(Dst, val_array(VectorRef), !Env). |
473 | -exec_instr_(ld_ctorsym(Dst, Name), _Ctx, !Env, !IO) :- |
474 | - read_ctor(Name, Result, !Env, !IO), |
475 | - env_assign_local(Dst, Result, !Env). |
476 | exec_instr_(ld_cgc(Dst, Name), _Ctx, !Env, !IO) :- |
477 | read_cgc(Name, Result, !Env, !IO), |
478 | env_assign_local(Dst, Result, !Env). |
479 | @@ -569,28 +580,28 @@ |
480 | exec_instr_(new_closure(Dst, Func, Args), _Ctx, !Env, !IO) :- |
481 | % Evaluate Func and Arg (eagerly) |
482 | global_search_det(!.Env, Func, FuncVal), |
483 | - list.map(local_search_det(!.Env), Args, ArgVals), |
484 | + list.map_foldl2(atom_value, Args, ArgVals, !Env, !IO), |
485 | % Curry Args in Func, but do not evaluate |
486 | partial_apply_vals(FuncVal, ArgVals, Result), |
487 | env_assign_local(Dst, Result, !Env). |
488 | exec_instr_(call(Dst, Func, Args), _Ctx, !Env, !IO) :- |
489 | % Evaluate Func and Arg (eagerly) |
490 | local_search_det(!.Env, Func, FuncVal), |
491 | - list.map(local_search_det(!.Env), Args, ArgVals), |
492 | + list.map_foldl2(atom_value, Args, ArgVals, !Env, !IO), |
493 | % Apply Arg to Func |
494 | apply_vals(FuncVal, ArgVals, Result, !Env, !IO), |
495 | env_assign_local(Dst, Result, !Env). |
496 | exec_instr_(call_ctor(Dst, Ctor, Args), _Ctx, !Env, !IO) :- |
497 | % Evaluate Ctor and Arg (eagerly) |
498 | read_ctor(Ctor, CtorVal, !Env, !IO), |
499 | - list.map(local_search_det(!.Env), Args, ArgVals), |
500 | + list.map_foldl2(atom_value, Args, ArgVals, !Env, !IO), |
501 | % Apply Arg to Ctor |
502 | apply_vals(CtorVal, ArgVals, Result, !Env, !IO), |
503 | env_assign_local(Dst, Result, !Env). |
504 | exec_instr_(call_global(Dst, Func, Args), _Ctx, !Env, !IO) :- |
505 | % Evaluate Func and Arg (eagerly) |
506 | global_search_det(!.Env, Func, FuncVal), |
507 | - list.map(local_search_det(!.Env), Args, ArgVals), |
508 | + list.map_foldl2(atom_value, Args, ArgVals, !Env, !IO), |
509 | % Apply Arg to Func |
510 | apply_vals(FuncVal, ArgVals, Result, !Env, !IO), |
511 | env_assign_local(Dst, Result, !Env). |
512 | @@ -763,7 +774,7 @@ |
513 | exec_cases(CFG, BBRef, !Env, ControlVal, Cases, Default, !IO) |
514 | ; |
515 | Term = cond_branch(Cond, Then, Else, _), |
516 | - local_search_det(!.Env, Cond, CondVal), |
517 | + atom_value(Cond, CondVal, !Env, !IO), |
518 | ( CondVal = val_int(integer(0)) -> |
519 | % False |
520 | exec_block(CFG, BBRef, Else, !Env, !IO) |
521 | |
522 | === modified file 'src/ir.m' |
523 | --- src/ir.m 2011-10-10 12:38:16 +0000 |
524 | +++ src/ir.m 2011-10-21 03:33:25 +0000 |
525 | @@ -185,6 +185,15 @@ |
526 | % repeating until the condition is zero. |
527 | ; while(expr,stmt_block). |
528 | |
529 | +% atom: An atomic value which may be given as input to various instructions. |
530 | +:- type atom |
531 | + % A variable name |
532 | + ---> varname(varname) |
533 | + % An integer literal (note: arbitrary precision) |
534 | + ; intatom(integer) |
535 | + % A constructor symbol (parameterless constructor names only) |
536 | + ; ctorsym(string). |
537 | + |
538 | % instr: A low-level statement with no control flow, sub-statements or |
539 | % sub-expressions. Used by only the CFG program representation. |
540 | :- type instr |
541 | @@ -195,21 +204,16 @@ |
542 | :- type instr_ |
543 | % NOP instruction (equivalent of pass statement) |
544 | ---> nop |
545 | - % Copy instruction. Copies a value from one variable to another. |
546 | - ; mov(varname, varname) |
547 | + % Copy instruction. Copies a value from an atom to a variable. |
548 | + ; mov(varname, atom) |
549 | % Field update (destructive). (S, C, I, V) <=> S.I := V |
550 | % (See ld_field) |
551 | - ; i_fieldset(varname, string, int, varname) |
552 | + ; i_fieldset(varname, string, int, atom) |
553 | % Field replace (non-destructive). |
554 | % (R, S, C, I, V) <=> R := % S.I <- V (See ld_field) |
555 | - ; i_fieldreplace(varname, varname, string, int, varname) |
556 | - % Load an integer literal. (Note arbitrary precision). |
557 | - ; ld_intlit(varname, integer) |
558 | + ; i_fieldreplace(varname, varname, string, int, atom) |
559 | % Construct an array from a list of variables. |
560 | - ; ld_arraylit(varname, list(varname)) |
561 | - % Load a symbolic constant constructor into a variable. |
562 | - % String is the name of the ctor (must not take arguments). |
563 | - ; ld_ctorsym(varname, string) |
564 | + ; ld_arraylit(varname, list(atom)) |
565 | % Load the value of a computable global constant into a variable. |
566 | % String is the name of the CGC. Its body may be executed. |
567 | ; ld_cgc(varname, string) |
568 | @@ -219,15 +223,15 @@ |
569 | ; ld_field(varname, varname, string, int) |
570 | % Create closure from closure template. (Result, Function, Args). |
571 | % Function must be a global closure template (not a ctor or CGC). |
572 | - ; new_closure(varname, string, list(varname)) |
573 | + ; new_closure(varname, string, list(atom)) |
574 | % Local function call. (Result, Function, Args). |
575 | - ; call(varname, varname, list(varname)) |
576 | + ; call(varname, varname, list(atom)) |
577 | % Constructor function call. (Result, Ctor, Args). |
578 | % Ctor is the name of a constructor. |
579 | - ; call_ctor(varname, string, list(varname)) |
580 | + ; call_ctor(varname, string, list(atom)) |
581 | % Global function call. (Result, Function, Args). |
582 | % Function must be a global function (not a ctor or CGC). |
583 | - ; call_global(varname, string, list(varname)). |
584 | + ; call_global(varname, string, list(atom)). |
585 | |
586 | % terminator_instr: An instruction which may only appear at the end of a basic |
587 | % block in the CFG representation. These roughly are the equivalents of the |
588 | @@ -250,7 +254,7 @@ |
589 | % Conditional branch instruction. Expr must be of type Int. |
590 | % Evaluates Expr, then branches to the first basic block if it is |
591 | % nonzero, or the second basic block if it is zero. |
592 | - ; cond_branch(varname, bbref(S), bbref(S), context.context) |
593 | + ; cond_branch(atom, bbref(S), bbref(S), context.context) |
594 | % Unconditionally branches to the given basic block. |
595 | ; branch(bbref(S), context.context) |
596 | % "Null terminator". It is a semantic error if a block with a null |
597 | |
598 | === modified file 'src/pretty.m' |
599 | --- src/pretty.m 2011-10-09 08:12:06 +0000 |
600 | +++ src/pretty.m 2011-10-21 03:33:25 +0000 |
601 | @@ -358,6 +358,11 @@ |
602 | io.write_string(":\n", !IO), |
603 | foldl(print_stmt(Indent+1), Stmts, !IO). |
604 | |
605 | +:- func atom_string(atom) = string. |
606 | +atom_string(varname(VarName)) = ir.varname_string(VarName). |
607 | +atom_string(intatom(I)) = integer.to_string(I). |
608 | +atom_string(ctorsym(Name)) = Name. |
609 | + |
610 | :- pred print_instr(int::in, instr::in, io::di, io::uo) is det. |
611 | print_instr(Indent, Instr, !IO) :- |
612 | print_instr_(Indent, Instr ^ instr_instr, !IO), |
613 | @@ -371,35 +376,25 @@ |
614 | indent(Indent, !IO), |
615 | io.write_string(ir.varname_string(Dst), !IO), |
616 | io.write_string(" = ", !IO), |
617 | - io.write_string(ir.varname_string(Src), !IO). |
618 | + io.write_string(atom_string(Src), !IO). |
619 | print_instr_(Indent, i_fieldset(Target, Ctor, Idx, Expr), !IO) :- |
620 | indent(Indent, !IO), |
621 | io.write_string(fieldref_str(Target, Ctor, Idx), !IO), |
622 | io.write_string(" =! ", !IO), |
623 | - io.write_string(ir.varname_string(Expr), !IO). |
624 | + io.write_string(atom_string(Expr), !IO). |
625 | print_instr_(Indent, i_fieldreplace(Dst, Target, Ctor, Idx, Expr), !IO) :- |
626 | indent(Indent, !IO), |
627 | io.write_string(ir.varname_string(Dst), !IO), |
628 | io.write_string(" = ", !IO), |
629 | io.write_string(fieldref_str(Target, Ctor, Idx), !IO), |
630 | io.write_string(" := ", !IO), |
631 | - io.write_string(ir.varname_string(Expr), !IO). |
632 | -print_instr_(Indent, ld_intlit(Dst, I), !IO) :- |
633 | - indent(Indent, !IO), |
634 | - io.write_string(ir.varname_string(Dst), !IO), |
635 | - io.write_string(" = ", !IO), |
636 | - io.write_string(integer.to_string(I), !IO). |
637 | + io.write_string(atom_string(Expr), !IO). |
638 | print_instr_(Indent, ld_arraylit(Dst, Elems), !IO) :- |
639 | indent(Indent, !IO), |
640 | io.write_string(ir.varname_string(Dst), !IO), |
641 | io.write_string(" = ", !IO), |
642 | io.write_string("[" ++ string.join_list(", ", |
643 | - list.map(ir.varname_string, Elems)) ++ "]", !IO). |
644 | -print_instr_(Indent, ld_ctorsym(Dst, Name), !IO) :- |
645 | - indent(Indent, !IO), |
646 | - io.write_string(ir.varname_string(Dst), !IO), |
647 | - io.write_string(" = ", !IO), |
648 | - io.write_string(Name, !IO). |
649 | + list.map(atom_string, Elems)) ++ "]", !IO). |
650 | print_instr_(Indent, ld_cgc(Dst, Name), !IO) :- |
651 | indent(Indent, !IO), |
652 | io.write_string(ir.varname_string(Dst), !IO), |
653 | @@ -413,26 +408,25 @@ |
654 | indent(Indent, !IO), |
655 | io.write_string(ir.varname_string(Dst), !IO), |
656 | io.write_string(" = @", !IO), |
657 | - ArgsStr = string.join_list(", ", list.map(ir.varname_string, Args)), |
658 | + ArgsStr = string.join_list(", ", list.map(atom_string, Args)), |
659 | io.write_string(Func ++ "{" ++ ArgsStr ++ "}", !IO). |
660 | print_instr_(Indent, call(Dst, Func, Args), !IO) :- |
661 | indent(Indent, !IO), |
662 | io.write_string(ir.varname_string(Dst), !IO), |
663 | io.write_string(" = ", !IO), |
664 | - ArgsStr = string.join_list(", ", |
665 | - list.map(ir.varname_string, Args)), |
666 | + ArgsStr = string.join_list(", ", list.map(atom_string, Args)), |
667 | io.write_string(ir.varname_string(Func) ++ "(" ++ ArgsStr ++ ")", !IO). |
668 | print_instr_(Indent, call_ctor(Dst, Ctor, Args), !IO) :- |
669 | indent(Indent, !IO), |
670 | io.write_string(ir.varname_string(Dst), !IO), |
671 | io.write_string(" = ", !IO), |
672 | - ArgsStr = string.join_list(", ", list.map(ir.varname_string, Args)), |
673 | + ArgsStr = string.join_list(", ", list.map(atom_string, Args)), |
674 | io.write_string(Ctor ++ "(" ++ ArgsStr ++ ")", !IO). |
675 | print_instr_(Indent, call_global(Dst, Func, Args), !IO) :- |
676 | indent(Indent, !IO), |
677 | io.write_string(ir.varname_string(Dst), !IO), |
678 | io.write_string(" = @", !IO), |
679 | - ArgsStr = string.join_list(", ", list.map(ir.varname_string, Args)), |
680 | + ArgsStr = string.join_list(", ", list.map(atom_string, Args)), |
681 | io.write_string(Func ++ "(" ++ ArgsStr ++ ")", !IO). |
682 | |
683 | :- func fieldref_str(varname, string, int) = string. |
684 | @@ -461,7 +455,7 @@ |
685 | !IO) :- |
686 | indent(Indent, !IO), |
687 | io.write_string("if ", !IO), |
688 | - io.write_string(ir.varname_string(Cond), !IO), |
689 | + io.write_string(atom_string(Cond), !IO), |
690 | io.write_string(" goto ", !IO), |
691 | io.write_string(cfg.ref_name(ThenPart, CFG), !IO), |
692 | io.write_string(" else goto ", !IO), |
693 | |
694 | === modified file 'src/typedict.m' |
695 | --- src/typedict.m 2011-10-11 11:38:29 +0000 |
696 | +++ src/typedict.m 2011-10-21 03:33:25 +0000 |
697 | @@ -1224,7 +1224,9 @@ |
698 | ; Instr0 = new_closure(Dst, Name, Args) -> |
699 | ( tables.lookup_local(!.LT, Dst, DstType) -> |
700 | FuncType = DstType, |
701 | - ( map(tables.lookup_local(!.LT), Args, ArgTypes_) -> |
702 | + ( map_foldl(atom_type(PT, !.LT), Args, ArgTypes_, Varset, VSA) -> |
703 | + % See below |
704 | + VarsetAug = VSA, |
705 | ArgTypes = ArgTypes_, |
706 | ( DstType = types.app(types.functype, _) -> |
707 | true |
708 | @@ -1239,15 +1241,19 @@ |
709 | error("augment_instr_globalrefs: Not in LT: " ++ |
710 | ir.varname_string(Dst)) |
711 | ), |
712 | - augment_globalref(PT, PTAug, Varset, Rigids, TDVars, Name, FuncType, |
713 | - ArgTypes, TDExprs, !RequiredVars), |
714 | + augment_globalref(PT, PTAug, VarsetAug, Rigids, TDVars, Name, |
715 | + FuncType, ArgTypes, TDExprs, !RequiredVars), |
716 | % new_closure has the type dicts prepended to its argument list |
717 | generate_expr_code(PTAug, Varset, Rigids, BlockID, TDExprs, |
718 | TDArgs, PreInstrs, !LT, !BlockTempCount), |
719 | Instr = new_closure(Dst, Name, TDArgs ++ Args) |
720 | ; Instr0 = call_global(Dst, Name, Args) -> |
721 | ( tables.lookup_local(!.LT, Dst, DstType) -> |
722 | - ( map(tables.lookup_local(!.LT), Args, ArgTypes) -> |
723 | + ( map_foldl(atom_type(PT, !.LT), Args, ArgTypes, Varset, VSA) -> |
724 | + % atom_type may add new varset items due to ctorsyms. |
725 | + % augment_globalref must use this augmented varset. |
726 | + % (See LP: #877111) |
727 | + VarsetAug = VSA, |
728 | FuncType = types.app(types.functype, ArgTypes ++ [DstType]) |
729 | ; |
730 | error("augment_instr_globalrefs: Arg not in LT") |
731 | @@ -1256,8 +1262,8 @@ |
732 | error("augment_instr_globalrefs: Not in LT: " ++ |
733 | ir.varname_string(Dst)) |
734 | ), |
735 | - augment_globalref(PT, PTAug, Varset, Rigids, TDVars, Name, FuncType, |
736 | - [], TDExprs, !RequiredVars), |
737 | + augment_globalref(PT, PTAug, VarsetAug, Rigids, TDVars, Name, |
738 | + FuncType, [], TDExprs, !RequiredVars), |
739 | ( method_builtin(Name), TDExprs = [TDExpr] -> |
740 | % call to show or eq -- replace with field access |
741 | MethodExpr0 = expr(fieldref(TDExpr, Name), no), |
742 | @@ -1266,7 +1272,11 @@ |
743 | generate_expr_code(PTAug, Varset, Rigids, BlockID, [MethodExpr], |
744 | MethodVars, PreInstrs, !LT, !BlockTempCount), |
745 | ( MethodVars = [MethodVar] -> |
746 | - Instr = call(Dst, MethodVar, Args) |
747 | + ( MethodVar = varname(MethodVarName) -> |
748 | + Instr = call(Dst, MethodVarName, Args) |
749 | + ; |
750 | + error("augment_instr_globalrefs: call to non-var atom") |
751 | + ) |
752 | ; |
753 | error("augment_instr_globalrefs: generate_expr_code failed") |
754 | ) |
755 | @@ -1282,18 +1292,31 @@ |
756 | ), |
757 | Instrs = PreInstrs ++ [InitInstr^instr_instr := Instr]. |
758 | |
759 | +% Get the type of an atom. Fail if it cannot be found. |
760 | +:- pred atom_type(progtable::in, localtable::in, atom::in, typeval::out, |
761 | + varset::in, varset::out) is semidet. |
762 | +atom_type(_PT, LT, varname(VarName), Ty, !Varset) :- |
763 | + tables.lookup_local(LT, VarName, Ty). |
764 | +atom_type(_PT, _LT, intatom(_), types.const("Int"), !Varset). |
765 | +atom_type(PT, _LT, ctorsym(Name), Ty, !Varset) :- |
766 | + tables.lookup_ctor(PT, Name, Typedef, _), |
767 | + ir.ctor_type(Typedef, Name, CtorVarset, Ty0), |
768 | + % Add the varset of this ctor into the local varset namespace, and update |
769 | + % the type so is is in the local namespace. |
770 | + types.varset_mergeone(CtorVarset, !Varset, Ty0, Ty). |
771 | + |
772 | % generate_expr_code(+PT, +Varset, +Rigids, +BlockID, +Exprs, -VarNames, |
773 | % -Instrs, !LT, !BlockTempCount). |
774 | % Generate code for a sequence of expressions (using ast_cfg). Concatenate all |
775 | % the generated instructions together, update the localtable and temp count, |
776 | -% and produce a list of var names corresponding to the input expressions. |
777 | +% and produce a list of atoms corresponding to the input expressions. |
778 | :- pred generate_expr_code(progtable::in, varset::in, list(var)::in, int::in, |
779 | - list(expr)::in, list(varname)::out, list(instr)::out, |
780 | + list(expr)::in, list(atom)::out, list(instr)::out, |
781 | localtable::in, localtable::out, int::in, int::out) is det. |
782 | -generate_expr_code(PT, Varset, _Rigids, BlockID, Exprs, VarNames, Instrs, !LT, |
783 | +generate_expr_code(PT, Varset, _Rigids, BlockID, Exprs, Atoms, Instrs, !LT, |
784 | !BlockTempCount) :- |
785 | list_map4_foldl(ast_cfg.expr_to_instrs_post_ssa(PT, Varset, BlockID), |
786 | - Exprs, VarNames, InstrLists, TypeMaps, SynthFuncses, |
787 | + Exprs, Atoms, InstrLists, TypeMaps, SynthFuncses, |
788 | !BlockTempCount), |
789 | Instrs = list.condense(InstrLists), |
790 | ( list.condense(SynthFuncses) : list(function) = [] -> |
791 | |
792 | === modified file 'src/usedef.m' |
793 | --- src/usedef.m 2011-10-09 08:12:06 +0000 |
794 | +++ src/usedef.m 2011-10-21 03:33:25 +0000 |
795 | @@ -151,26 +151,27 @@ |
796 | Uses = uses_cond_uses(UsesSet), |
797 | Defs = uses_cond_uses(DefsSet). |
798 | |
799 | +:- func atoms_vars(list(atom)) = list(varname). |
800 | +atoms_vars(Atoms) = Vars :- |
801 | + list.filter_map(pred(varname(VarName)::in, VarName::out) is semidet, |
802 | + Atoms, Vars). |
803 | + |
804 | instr_use_def(Instr, Uses, Defs) :- |
805 | instr_use_def_(Instr ^ instr_instr, Uses, Defs). |
806 | :- pred instr_use_def_(instr_::in, set(varname)::out, set(varname)::out) |
807 | is det. |
808 | instr_use_def_(nop, set.init, set.init). |
809 | instr_use_def_(mov(Dst, Src), Uses, Defs) :- |
810 | - set.singleton_set(Uses, Src), |
811 | + Uses = set(atoms_vars([Src])), |
812 | set.singleton_set(Defs, Dst). |
813 | instr_use_def_(i_fieldset(Obj, _CtorIdxMap, _Msg, Var), Uses, set.init) :- |
814 | % Note: No defs, as the variable is being mutated, not assigned to. |
815 | - Uses = set([Obj, Var]). |
816 | + Uses = set([Obj | atoms_vars([Var])]). |
817 | instr_use_def_(i_fieldreplace(Dst, Obj, _CtorIdxMap, _Msg, Var), Uses, Defs):- |
818 | - Uses = set([Obj, Var]), |
819 | - set.singleton_set(Defs, Dst). |
820 | -instr_use_def_(ld_intlit(Dst, _I), set.init, Defs) :- |
821 | + Uses = set([Obj | atoms_vars([Var])]), |
822 | set.singleton_set(Defs, Dst). |
823 | instr_use_def_(ld_arraylit(Dst, Elems), Uses, Defs) :- |
824 | - Uses = set(Elems), |
825 | - set.singleton_set(Defs, Dst). |
826 | -instr_use_def_(ld_ctorsym(Dst, _Name), set.init, Defs) :- |
827 | + Uses = set(atoms_vars(Elems)), |
828 | set.singleton_set(Defs, Dst). |
829 | instr_use_def_(ld_cgc(Dst, _Name), set.init, Defs) :- |
830 | set.singleton_set(Defs, Dst). |
831 | @@ -178,16 +179,16 @@ |
832 | set.singleton_set(Uses, Obj), |
833 | set.singleton_set(Defs, Dst). |
834 | instr_use_def_(new_closure(Dst, _Func, Args), Uses, Defs) :- |
835 | - Uses = set(Args), |
836 | + Uses = set(atoms_vars(Args)), |
837 | set.singleton_set(Defs, Dst). |
838 | instr_use_def_(call(Dst, Func, Args), Uses, Defs) :- |
839 | - Uses = set([Func|Args]), |
840 | + Uses = set([Func | atoms_vars(Args)]), |
841 | set.singleton_set(Defs, Dst). |
842 | instr_use_def_(call_ctor(Dst, _Ctor, Args), Uses, Defs) :- |
843 | - Uses = set(Args), |
844 | + Uses = set(atoms_vars(Args)), |
845 | set.singleton_set(Defs, Dst). |
846 | instr_use_def_(call_global(Dst, _Func, Args), Uses, Defs) :- |
847 | - Uses = set(Args), |
848 | + Uses = set(atoms_vars(Args)), |
849 | set.singleton_set(Defs, Dst). |
850 | |
851 | instrs_use_def(Instrs, Uses, Defs) :- |
852 | @@ -199,7 +200,7 @@ |
853 | set.singleton_set(Uses0, Control), |
854 | Uses = uses_cond_uses(Uses0). |
855 | terminator_instr_use_def(cond_branch(Cond, _Then, _Else,_), Uses, map.init) :- |
856 | - set.singleton_set(Uses0, Cond), |
857 | + Uses0 = set(atoms_vars([Cond])), |
858 | Uses = uses_cond_uses(Uses0). |
859 | terminator_instr_use_def(branch(_Target,_), map.init, map.init). |
860 | terminator_instr_use_def(null_terminator(_), map.init, map.init). |
861 | |
862 | === added file 'test/cases/compiler/ctorsym-unify.mar' |
863 | --- test/cases/compiler/ctorsym-unify.mar 1970-01-01 00:00:00 +0000 |
864 | +++ test/cases/compiler/ctorsym-unify.mar 2011-10-21 03:33:25 +0000 |
865 | @@ -0,0 +1,29 @@ |
866 | +type List(a): |
867 | + Cons(head :: a, tail :: List(a)) |
868 | + Nil |
869 | + |
870 | +def cons(y :: a, xs :: List(a)) :: List(a): |
871 | + show(y) |
872 | + show(xs) |
873 | + return Cons(y, xs) |
874 | + |
875 | +def show_list(x :: List(a)) :: Array(Int): |
876 | + return show(x) |
877 | + |
878 | +def id(x :: a) :: a = x |
879 | + |
880 | +# Test that we can take the Nil constructor :: List(a) and pass it to a |
881 | +# function of local type (b, List(b)) -> List(b) without unification problems. |
882 | +# LP: #877111 |
883 | +def foo(one :: a, two :: b) :: List(b): |
884 | + return cons(two, Nil) |
885 | + |
886 | +# Test that we can curry Nil into id (this broke when we tried to fix the |
887 | +# above bug) |
888 | +def nil_id() :: () -> List(t): |
889 | + return id(Nil, ...) |
890 | + |
891 | +# Test that we can pass the typedict for Nil :: List(a) to another function |
892 | +# when passed directly as a constructor symbol atom. |
893 | +def bar(one :: a, two :: b) :: Array(Int): |
894 | + return show(Nil) |
Approved.