Merge lp:~mgiuca/mars/closure-templates into lp:mars
- closure-templates
- Merge into trunk
Status: | Merged |
---|---|
Merged at revision: | 1224 |
Proposed branch: | lp:~mgiuca/mars/closure-templates |
Merge into: | lp:mars |
Diff against target: |
2405 lines (+795/-388) 16 files modified
doc/dev/isa.rst (+16/-42) misc/mars-asm.vim (+1/-1) src/ast_cfg.m (+436/-143) src/builtins.m (+32/-24) src/callgraph.m (+1/-1) src/executor.m (+6/-0) src/interactive.m (+16/-3) src/interpret.m (+43/-46) src/ir.m (+21/-10) src/parsem.m (+2/-1) src/pretty.m (+17/-22) src/tables.m (+7/-0) src/typecheck.m (+27/-1) src/typedict.m (+155/-85) src/usedef.m (+3/-9) src/util.m (+12/-0) |
To merge this branch: | bzr merge lp:~mgiuca/mars/closure-templates |
Related bugs: |
Reviewer | Review Type | Date Requested | Status |
---|---|---|---|
Matt Giuca | Approve | ||
Review via email:
|
Commit message
Description of the change
Removed parcall, parcall_ctor and parcall_global instructions. Replaced with new closure template functions and the new_closure instruction.
The code generator (ast_cfg) is now much more powerful, and transforms each instance of partial application into a synthetic function. The resulting code is much easier to deal with in backend implementations. Completely addresses bug #744760.
- 1263. By Matt Giuca
-
interpret: Changed show behaviour for functions; no longer prints the function name and displays 'closure' instead of 'curried'.
This reflects the new semantics of function objects. Any lifted function object will now have a meaningless name, so it doesn't make sense to show it.
Also, closures are no longer necessarily curried, since we could introduce lambda expressions.
Sadly, this means we can no longer see the name of a function object at runtime, or distinguish between built-ins, constructors, thunks etc (since they are all wrapped in closure templates).
![](/+icing/build/overlay/assets/skins/sam/images/close.gif)
Matt Giuca (mgiuca) : | # |
Preview Diff
1 | === modified file 'doc/dev/isa.rst' |
2 | --- doc/dev/isa.rst 2011-05-11 04:53:53 +0000 |
3 | +++ doc/dev/isa.rst 2011-05-11 05:12:31 +0000 |
4 | @@ -183,6 +183,22 @@ |
5 | |
6 | See the notes for ``ld_field``. |
7 | |
8 | +:samp:`new_closure {dest} {func} {args}` |
9 | + Creates a new closure object from a closure template function `func`. |
10 | + Curries arguments `args` into the template's closure vars, assigning the |
11 | + result to `dest`. Constructs a new function object with the parameters and |
12 | + result of the closure template. |
13 | + `func` MUST be the name of a closure template. |
14 | + `args` is a list of variables containing the arguments. It MUST contain |
15 | + the exact number of closure variables expected by `func`, and any |
16 | + supplied arguments must be of correct types. |
17 | + |
18 | + Ordinary functions cannot be converted into first-class function objects; |
19 | + to accomplish this, a closure template with no closure variables must be |
20 | + created, and loaded with ``new_closure`` and no `args`. |
21 | + Therefore, backends SHOULD optimise for the special case where `args` is |
22 | + empty, to avoid constructing a new closure object where possible. |
23 | + |
24 | :samp:`call {dest} {func} {args}` |
25 | Calls a function from local variable `func`, supplying arguments `args` |
26 | and assigning the result to `dest`. |
27 | @@ -191,17 +207,6 @@ |
28 | arguments expected by `func`, of correct types. |
29 | The execution may cause side-effects or fail to return. |
30 | |
31 | -:samp:`parcall {dest} {func} {args}` |
32 | - Partial function application of local variable `func`. Curries arguments |
33 | - `args` into the function, assigning the result to `dest`. |
34 | - Constructs a new function object which expects any remaining arguments |
35 | - which were not supplied in `args`, and calls `func` with the curried |
36 | - arguments, followed by the remaining arguments. |
37 | - `func` MUST be a variable containing a function value. `args` is a list of |
38 | - variables containing the arguments. It MUST contain no more than the |
39 | - number of arguments expected by `func`, and any supplied arguments must be |
40 | - of correct types. |
41 | - |
42 | :samp:`call_ctor {dest} {ctor} {args}` |
43 | Calls constructor function `ctor`, supplying arguments `args` and |
44 | assigning the result to `dest`. |
45 | @@ -209,21 +214,6 @@ |
46 | `args` is a list of variables containing the arguments. It MUST contain |
47 | the exact number of arguments expected by `ctor`, of correct types. |
48 | |
49 | -:samp:`parcall_ctor {dest} {ctor} {args}` |
50 | - Partial function application of global function `ctor`. Curries arguments |
51 | - `args` into the constructor function, assigning the result to `dest`. |
52 | - Constructs a new function object which expects any remaining arguments |
53 | - which were not supplied in `args`, and calls `ctor` with the curried |
54 | - arguments, followed by the remaining arguments. |
55 | - `ctor` MUST not be the name of a constant symbol. |
56 | - `args` is a list of variables containing the arguments. It MUST contain no |
57 | - more than the number of arguments expected by `ctor`, and any supplied |
58 | - arguments must be of correct types. |
59 | - |
60 | - When `args` is empty, this instruction simply loads a constructor function |
61 | - into a local variable. Backends SHOULD optimise for this special case, to |
62 | - avoid constructing a new closure object where possible. |
63 | - |
64 | :samp:`call_global {dest} {func} {args}` |
65 | Calls global function `func`, supplying arguments `args` and assigning the |
66 | result to `dest`. |
67 | @@ -233,22 +223,6 @@ |
68 | the exact number of arguments expected by `func`, of correct types. |
69 | The execution may cause side-effects or fail to return. |
70 | |
71 | -:samp:`parcall_global {dest} {func} {args}` |
72 | - Partial function application of global function `func`. Curries arguments |
73 | - `args` into the function, assigning the result to `dest`. |
74 | - Constructs a new function object which expects any remaining arguments |
75 | - which were not supplied in `args`, and calls `func` with the curried |
76 | - arguments, followed by the remaining arguments. |
77 | - `func` MUST not be the name of a computable global constant or |
78 | - constructor. |
79 | - `args` is a list of variables containing the arguments. It MUST contain no |
80 | - more than the number of arguments expected by `func`, and any supplied |
81 | - arguments must be of correct types. |
82 | - |
83 | - When `args` is empty, this instruction simply loads a global function into |
84 | - a local variable. Backends SHOULD optimise for this special case, to avoid |
85 | - constructing a new closure object where possible. |
86 | - |
87 | .. |
88 | |
89 | Terminator instructions |
90 | |
91 | === modified file 'misc/mars-asm.vim' |
92 | --- misc/mars-asm.vim 2011-05-06 09:00:09 +0000 |
93 | +++ misc/mars-asm.vim 2011-05-11 05:12:31 +0000 |
94 | @@ -45,7 +45,7 @@ |
95 | |
96 | syn keyword marsStatement return pass goto |
97 | syn keyword marsStatement def nextgroup=marsFunction skipwhite |
98 | -syn match marsFunction "[a-z_:][a-zA-Z0-9_:]*" contained |
99 | +syn match marsFunction "[a-z_:][a-zA-Z0-9_:;]*" contained |
100 | syn keyword marsTypedef type nextgroup=marsTypeName skipwhite |
101 | syn match marsTypeName "[A-Z_:][a-zA-Z0-9_:]*" contained |
102 | syn keyword marsStatement var nextgroup=marsDecl skipwhite |
103 | |
104 | === modified file 'src/ast_cfg.m' |
105 | --- src/ast_cfg.m 2011-04-20 03:38:39 +0000 |
106 | +++ src/ast_cfg.m 2011-05-11 05:12:31 +0000 |
107 | @@ -48,9 +48,11 @@ |
108 | % - There exists a viable code path which does not return a value. |
109 | % - There is an attempt to read from a variable which may not have been |
110 | % assigned on some or all code paths. |
111 | -:- pred func_to_cfg(progtable::in, function::in, function::out) is det. |
112 | +:- pred func_to_cfg(progtable::in, function::in, function::out, |
113 | + list(function)::out) is det. |
114 | |
115 | -% expr_to_instrs(+PT, +Expr, -VarName, -Instrs, -Types, !ASTState). |
116 | +% expr_to_instrs(+PT, +Expr, -VarName, -Instrs, -Types, -SynthFuncs, |
117 | +% !ASTState). |
118 | % Converts a single expression into a sequence of low-level instructions |
119 | % which compute the expression and assign it to a variable (possibly a |
120 | % new temporary variable name). Returns the assigned variable name in VarName. |
121 | @@ -58,11 +60,11 @@ |
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 | - list(instr)::out, map(varname, typeval)::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 | -% -Types, !BlockTempCount). |
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 | % The caller must supply the BlockID and BlockTempCount, for generating unique |
135 | @@ -70,9 +72,10 @@ |
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 | - int::in, int::out) is det. |
140 | + list(function)::out, int::in, int::out) is det. |
141 | |
142 | -% basic_stmt_to_instrs(+PT, +BasicStmt, -Instrs, -Types, !ASTState). |
143 | +% basic_stmt_to_instrs(+PT, +BasicStmt, -Instrs, -Types, -SynthFuncs, |
144 | +% !ASTState). |
145 | % Converts a single basic statement into a sequence of low-level instructions |
146 | % which do the same thing. This will potentially assign many temporary |
147 | % variables. |
148 | @@ -80,7 +83,7 @@ |
149 | % subscript information given). Useful for stand-alone statements. |
150 | % Also produces map of types of all variables bound by the instructions. |
151 | :- pred basic_stmt_to_instrs(progtable::in, varset::in, basic_stmt::in, |
152 | - list(instr)::out, map(varname, typeval)::out, |
153 | + list(instr)::out, map(varname, typeval)::out, list(function)::out, |
154 | ast_state::in, ast_state::out) is det. |
155 | |
156 | % Given a typedef, produces a list of CFG functions, three for each named |
157 | @@ -111,6 +114,10 @@ |
158 | % BlockID is the ID of the current block. |
159 | :- func var_to_ssa(ast_state, int, varname) = varname. |
160 | |
161 | +% Remove any functions with duplicate names, favouring those earlier in the |
162 | +% list. Useful for dealing with lists of synthetic functions. |
163 | +:- func remove_dup_funcs(list(function)) = list(function). |
164 | + |
165 | % -------------------------------------------------------------------------- % |
166 | % -------------------------------------------------------------------------- % |
167 | |
168 | @@ -129,6 +136,8 @@ |
169 | :- import_module bool. |
170 | :- import_module require. |
171 | :- import_module char. |
172 | +:- import_module unit. |
173 | +:- use_module term. |
174 | |
175 | :- import_module cfg. |
176 | :- import_module typecheck. |
177 | @@ -137,14 +146,18 @@ |
178 | :- import_module pretty. |
179 | |
180 | prog_to_cfg(PT, program(Nodes0), program(Nodes)) :- |
181 | - prog_nodes_to_cfg(PT, Nodes0, Nodes). |
182 | + prog_nodes_to_cfg(PT, Nodes0, Nodes1, [], SynthFuncs0), |
183 | + % Insert the synthetic functions into the program |
184 | + SynthFuncs = list.reverse(remove_dup_funcs(SynthFuncs0)), |
185 | + Nodes = Nodes1 ++ map(func(F) = pfunction(F), SynthFuncs). |
186 | |
187 | :- pred prog_nodes_to_cfg(progtable::in, |
188 | - list(program_node)::in, list(program_node)::out) is det. |
189 | -prog_nodes_to_cfg(_, [], []). |
190 | -prog_nodes_to_cfg(PT, [Node0|Nodes0], NewNodes ++ Nodes) :- |
191 | + list(program_node)::in, list(program_node)::out, |
192 | + list(function)::in, list(function)::out) is det. |
193 | +prog_nodes_to_cfg(_, [], [], !SynthFuncs). |
194 | +prog_nodes_to_cfg(PT, [Node0|Nodes0], NewNodes ++ Nodes, !SynthFuncs) :- |
195 | ( Node0 = pfunction(Func0) -> |
196 | - func_to_cfg(PT, Func0, Func), |
197 | + func_to_cfg(PT, Func0, Func, !SynthFuncs), |
198 | NewNodes = [pfunction(Func)] |
199 | ; Node0 = ptypedef(Typedef) -> |
200 | % Generate 3 functions for each named field |
201 | @@ -157,7 +170,7 @@ |
202 | ; |
203 | NewNodes = [Node0] |
204 | ), |
205 | - prog_nodes_to_cfg(PT, Nodes0, Nodes). |
206 | + prog_nodes_to_cfg(PT, Nodes0, Nodes, !SynthFuncs). |
207 | |
208 | :- pred new_def_map(def_map::out) is det. |
209 | new_def_map(Map) :- |
210 | @@ -195,23 +208,31 @@ |
211 | :- func type_map_union_list(list(type_map)) = type_map. |
212 | type_map_union_list(Ts) = foldl(type_map_union, Ts, map.init). |
213 | |
214 | -func_to_cfg(PT, !Func) :- |
215 | - % Create a new defmap with all of the params. |
216 | +func_to_cfg(PT, !Func, SynthFuncs) :- |
217 | + func_to_cfg(PT, !Func, [], SynthFuncs). |
218 | + |
219 | +:- pred func_to_cfg(progtable::in, function::in, function::out, |
220 | + list(function)::in, list(function)::out) is det. |
221 | +func_to_cfg(PT, !Func, !SynthFuncs) :- |
222 | + % Create a new defmap with all of the closure vars and params. |
223 | new_def_map(DefMap0), |
224 | - Params = !.Func ^ func_params, |
225 | - ( |
226 | - % No parameters |
227 | - Params = no, |
228 | - ParamList = [], |
229 | - DefMap = DefMap0, |
230 | - Types = map.init |
231 | - ; |
232 | - Params = yes(ParamList), |
233 | - foldl(def_map_insert_param, ParamList, DefMap0, DefMap), |
234 | - Types = map.from_assoc_list(map(func({N,T}) = svname(N)-T, ParamList)) |
235 | - ), |
236 | + MaybeCVars = !.Func ^ func_cvars, |
237 | + ( |
238 | + MaybeCVars = no, CVars = [] |
239 | + ; |
240 | + MaybeCVars = yes(CVars) |
241 | + ), |
242 | + MaybeParams = !.Func ^ func_params, |
243 | + ( |
244 | + MaybeParams = no, Params = [] |
245 | + ; |
246 | + MaybeParams = yes(Params) |
247 | + ), |
248 | + ParamList = CVars ++ Params, |
249 | + foldl(def_map_insert_param, ParamList, DefMap0, DefMap), |
250 | + Types = map.from_assoc_list(map(func({N,T}) = svname(N)-T, ParamList)), |
251 | func_body_to_cfg(PT, DefMap, !.Func^func_varset, ParamList, Types, |
252 | - !.Func ^ func_context, !.Func ^ func_body, CFGBody), |
253 | + !.Func ^ func_context, !.Func ^ func_body, CFGBody, !SynthFuncs), |
254 | !:Func = !.Func ^ func_body := CFGBody. |
255 | |
256 | % Note: def_map argument should have all of the function's parameters already |
257 | @@ -219,17 +240,19 @@ |
258 | % function's parameters' types. |
259 | :- pred func_body_to_cfg(progtable::in, def_map::in, varset::in, |
260 | list({string, _})::in, type_map::in, context::in, |
261 | - func_body::in, func_body::out) is det. |
262 | + func_body::in, func_body::out, list(function)::in, list(function)::out) |
263 | + is det. |
264 | func_body_to_cfg(_PT, _DefMap, _Varset, _Params, _Types, _Ctx, |
265 | - B@func_builtin, B). |
266 | + B@func_builtin, B, !SynthFuncs). |
267 | func_body_to_cfg(_PT, _DefMap, _Vset, _Params, _Types, _Ctx, |
268 | - B@func_body_cfg(_,_), B). |
269 | + B@func_body_cfg(_,_), B, !SynthFuncs). |
270 | func_body_to_cfg(PT, DefMap0, Varset, Params, Types0, Ctx, |
271 | - func_body_ast(Decls0,Stmts), NewFuncBody):- |
272 | + func_body_ast(Decls0,Stmts), NewFuncBody, !SynthFuncs):- |
273 | NewFuncBody = 'new func_body_cfg'(LT, CFG), |
274 | % Insert all of the function's locals into the defmap, unbound |
275 | foldl(def_map_insert_local, Decls0, DefMap0, DefMap), |
276 | - ast_to_cfg(PT, Varset, DefMap, Ctx, Stmts, Types0, Types_Raw, CFG), |
277 | + ast_to_cfg(PT, Varset, DefMap, Ctx, Stmts, Types0, Types_Raw, CFG, |
278 | + !SynthFuncs), |
279 | % Dereference all the types |
280 | map.map_values_only(types.deref(Varset), Types_Raw, Types), |
281 | % Get the full list of locals, in "variable ID order" |
282 | @@ -243,9 +266,9 @@ |
283 | % control flow graph, translating the code. |
284 | % This also performs error checking (see func_to_cfg). |
285 | :- some [S] pred ast_to_cfg(progtable::in, varset::in, def_map::in, |
286 | - context::in, stmt_block::in, type_map::in, type_map::out, cfg(S)::out) |
287 | - is det. |
288 | -ast_to_cfg(PT, Varset, DefMap, Ctx, Stmts, !Types, CFG) :- |
289 | + context::in, stmt_block::in, type_map::in, type_map::out, cfg(S)::out, |
290 | + list(function)::in, list(function)::out) is det. |
291 | +ast_to_cfg(PT, Varset, DefMap, Ctx, Stmts, !Types, CFG, !SynthFuncs) :- |
292 | some [!CFG] |
293 | ( |
294 | % Need to create the entry block and exit block so that |
295 | @@ -255,7 +278,7 @@ |
296 | Entry = cfg.get_entry(!.CFG), |
297 | Exit = cfg.get_exit(!.CFG), |
298 | stmt_block_to_cfg(PT, Varset, Stmts, Entry, Exit, DefMap, NewTypes, |
299 | - map.init,AfterPredMap, map.init, ExitPredMap, !CFG), |
300 | + map.init,AfterPredMap, map.init, ExitPredMap, !CFG, !SynthFuncs), |
301 | !:Types = type_map_union(!.Types, NewTypes), |
302 | % The union of AfterPredMap and ExitPredMap contains information about |
303 | % all predecessors to Exit. Use this to compute phi instructions for |
304 | @@ -652,35 +675,36 @@ |
305 | :- pred stmt_block_to_cfg(progtable::in, varset::in, stmt_block::in, |
306 | bbref(S)::in, bbref(S)::in, def_map::in, type_map::out, |
307 | pred_map(S)::in, pred_map(S)::out, pred_map(S)::in, pred_map(S)::out, |
308 | - cfg(S)::in, cfg(S)::out) is det. |
309 | + cfg(S)::in, cfg(S)::out, list(function)::in, list(function)::out) is det. |
310 | stmt_block_to_cfg(PT, Varset, Stmts, BBCurrent, BBAfter, DefMap, Types, |
311 | - !AfterPredMap, !ExitPredMap, !CFG) :- |
312 | + !AfterPredMap, !ExitPredMap, !CFG, !SynthFuncs) :- |
313 | map.init(SubscriptMap), |
314 | stmt_block_to_cfg(PT, Varset, Stmts, BBCurrent, BBAfter, SubscriptMap, |
315 | - DefMap, Types, !AfterPredMap, !ExitPredMap, !CFG). |
316 | + DefMap, Types, !AfterPredMap, !ExitPredMap, !CFG, !SynthFuncs). |
317 | |
318 | :- pred stmt_block_to_cfg(progtable::in, varset::in, stmt_block::in, |
319 | bbref(S)::in, bbref(S)::in, subscript_map::in, def_map::in, type_map::out, |
320 | pred_map(S)::in, pred_map(S)::out, |
321 | - pred_map(S)::in, pred_map(S)::out, cfg(S)::in, cfg(S)::out) is det. |
322 | + pred_map(S)::in, pred_map(S)::out, cfg(S)::in, cfg(S)::out, |
323 | + list(function)::in, list(function)::out) is det. |
324 | stmt_block_to_cfg(_PT, _Varset, [], BBCurrent, BBAfter, _SubscriptMap, |
325 | - DefMap, map.init, !AfterPredMap, !ExitPredMap, !CFG) :- |
326 | + DefMap, map.init, !AfterPredMap, !ExitPredMap, !CFG, !SynthFuncs) :- |
327 | % Special case for empty block - just branch to BBAfter. |
328 | add_to_pred_map(BBCurrent, DefMap, BBAfter, !AfterPredMap, !CFG), |
329 | cfg.set_terminator(BBCurrent, branch(BBAfter, blank_context), !CFG). |
330 | stmt_block_to_cfg(PT, Varset, [S], BBCurrent, BBAfter, SubscriptMap, DefMap, |
331 | - Types, !AfterPredMap, !ExitPredMap, !CFG) :- |
332 | + Types, !AfterPredMap, !ExitPredMap, !CFG, !SynthFuncs) :- |
333 | % Base-case for the last statement in a block - compile statement into |
334 | % BBCurrent, but end up by branching to BBAfter. |
335 | stmt_to_cfg_last(PT, Varset, S, BBCurrent, BBAfter, SubscriptMap, DefMap, |
336 | - Types, !AfterPredMap, !ExitPredMap, !CFG). |
337 | + Types, !AfterPredMap, !ExitPredMap, !CFG, !SynthFuncs). |
338 | stmt_block_to_cfg(PT, Varset, [S|Ss@[_|_]], BBCurrent, BBAfter, SubscriptMap0, |
339 | - DefMap0, Types, !AfterPredMap, !ExitPredMap, !CFG) :- |
340 | + DefMap0, Types, !AfterPredMap, !ExitPredMap, !CFG, !SynthFuncs) :- |
341 | % Compile a single statement into BBCurrent. BBContinue is the block to |
342 | % compile subsequent statements into (may be equal to BBCurrent). |
343 | stmt_to_cfg(PT, Varset, S, BBCurrent, BBContinue, Terminated, Types0, |
344 | SubscriptMap0, SubscriptMap, DefMap0, DefMap, !ExitPredMap, |
345 | - !CFG), |
346 | + !CFG, !SynthFuncs), |
347 | % Compile subsequent statements into BBContinue, if not terminated. |
348 | % If Terminated is 'yes', the rest of this block is inaccessible, so DO |
349 | % NOT generate code for it. This doesn't just save time -- it is NECESSARY |
350 | @@ -693,7 +717,7 @@ |
351 | ; |
352 | Terminated = no, |
353 | stmt_block_to_cfg(PT, Varset, Ss, BBContinue, BBAfter, SubscriptMap, |
354 | - DefMap, Types1, !AfterPredMap, !ExitPredMap, !CFG), |
355 | + DefMap, Types1, !AfterPredMap, !ExitPredMap, !CFG, !SynthFuncs), |
356 | Types = type_map_union(Types0, Types1) |
357 | ). |
358 | |
359 | @@ -718,18 +742,19 @@ |
360 | :- pred stmt_to_cfg(progtable::in, varset::in, stmt::in, |
361 | bbref(S)::in, bbref(S)::out, bool::out, type_map::out, |
362 | subscript_map::in, subscript_map::out, def_map::in, def_map::out, |
363 | - pred_map(S)::in, pred_map(S)::out, cfg(S)::in, cfg(S)::out) is det. |
364 | + pred_map(S)::in, pred_map(S)::out, cfg(S)::in, cfg(S)::out, |
365 | + list(function)::in, list(function)::out) is det. |
366 | stmt_to_cfg(PT, Varset, basic_stmt(S,Ctx), !BBRef, no, Types, !SubscriptMap, |
367 | - !DefMap, !ExitPredMap, !CFG) :- |
368 | + !DefMap, !ExitPredMap, !CFG, !SynthFuncs) :- |
369 | basic_stmt_to_cfg(PT, Varset, S, Ctx, !.BBRef, Types, !SubscriptMap, |
370 | - !DefMap, !CFG). |
371 | + !DefMap, !CFG, !SynthFuncs). |
372 | stmt_to_cfg(PT, Varset, compound_stmt(S,Ctx), BBCurrent, BBAfter, Terminated, |
373 | - Types, !SubscriptMap, !DefMap, !ExitPredMap, !CFG) :- |
374 | + Types, !SubscriptMap, !DefMap, !ExitPredMap, !CFG, !SynthFuncs) :- |
375 | % Generate a target block for the compound statement to branch to |
376 | cfg.new_basic_block(BBAfter, !CFG), |
377 | compound_stmt_to_cfg(PT, Varset, S, Ctx, BBCurrent, BBAfter, |
378 | !.SubscriptMap, !.DefMap, Types, map.init, AfterPredMap, !ExitPredMap, |
379 | - !CFG), |
380 | + !CFG, !SynthFuncs), |
381 | % AfterPredMap contains information about all predecessors to BBAfter. |
382 | % Use this to compute phi instructions for BBAfter and update DefMap. |
383 | AfterID = ref_id(BBAfter, !.CFG), |
384 | @@ -759,18 +784,20 @@ |
385 | :- pred stmt_to_cfg_last(progtable::in, varset::in, stmt::in, bbref(S)::in, |
386 | bbref(S)::in, subscript_map::in, def_map::in, type_map::out, |
387 | pred_map(S)::in, pred_map(S)::out, pred_map(S)::in, pred_map(S)::out, |
388 | - cfg(S)::in, cfg(S)::out) is det. |
389 | + cfg(S)::in, cfg(S)::out, list(function)::in, list(function)::out) is det. |
390 | stmt_to_cfg_last(PT, Varset, basic_stmt(S,Ctx), BBCurrent, BBAfter, |
391 | - SubscriptMap, DefMap, Types, !AfterPredMap, !ExitPredMap, !CFG) :- |
392 | + SubscriptMap, DefMap, Types, !AfterPredMap, !ExitPredMap, !CFG, |
393 | + !SynthFuncs) :- |
394 | basic_stmt_to_cfg(PT, Varset, S, Ctx, BBCurrent, Types, SubscriptMap, _, |
395 | - DefMap, NewDefMap, !CFG), |
396 | + DefMap, NewDefMap, !CFG, !SynthFuncs), |
397 | % Branch to the provided BBAfter |
398 | add_to_pred_map(BBCurrent, NewDefMap, BBAfter, !AfterPredMap, !CFG), |
399 | cfg.set_terminator(BBCurrent, branch(BBAfter, Ctx), !CFG). |
400 | stmt_to_cfg_last(PT, Varset, compound_stmt(S,Ctx), BBCurrent, BBAfter, |
401 | - SubscriptMap, DefMap, Types, !AfterPredMap, !ExitPredMap, !CFG) :- |
402 | + SubscriptMap, DefMap, Types, !AfterPredMap, !ExitPredMap, !CFG, |
403 | + !SynthFuncs) :- |
404 | compound_stmt_to_cfg(PT, Varset, S, Ctx, BBCurrent, BBAfter, SubscriptMap, |
405 | - DefMap, Types, !AfterPredMap, !ExitPredMap, !CFG). |
406 | + DefMap, Types, !AfterPredMap, !ExitPredMap, !CFG, !SynthFuncs). |
407 | |
408 | %%% LOW-LEVEL STATEMENT-COMPILATION PREDICATES %%% |
409 | % Either of the above two statement compilation predicates may call either of |
410 | @@ -796,11 +823,12 @@ |
411 | % !SubscriptMap). |
412 | :- pred exprs_to_instrs(progtable::in, varset::in, int::in, context::in, |
413 | list(expr)::in, list(varname)::out, list(instr)::out, type_map::out, |
414 | - subscript_map::in, subscript_map::out) is det. |
415 | + subscript_map::in, subscript_map::out, |
416 | + list(function)::in, list(function)::out) is det. |
417 | exprs_to_instrs(PT, Varset, BlockID, Ctx, Es, VarNames, Instrs, Types, |
418 | - !SubscriptMap) :- |
419 | + !SubscriptMap, !SynthFuncs) :- |
420 | exprs_to_instrs_(PT, Varset, BlockID, Ctx, Es, Types, [], VarNamesRev, [], |
421 | - LLInstrsRev, !SubscriptMap), |
422 | + LLInstrsRev, !SubscriptMap, !SynthFuncs), |
423 | list.reverse(VarNamesRev, VarNames), |
424 | list.reverse(LLInstrsRev, LLInstrs), |
425 | % "Condense" the list-of-lists into a flat list of instructions |
426 | @@ -813,17 +841,19 @@ |
427 | :- pred exprs_to_instrs_(progtable::in, varset::in, int::in, context::in, |
428 | list(expr)::in, type_map::out, list(varname)::in, list(varname)::out, |
429 | list(list(instr))::in, list(list(instr))::out, |
430 | - subscript_map::in, subscript_map::out) is det. |
431 | + subscript_map::in, subscript_map::out, |
432 | + list(function)::in, list(function)::out) is det. |
433 | exprs_to_instrs_(_PT, _Varset, _BlockID, _Ctx, [], map.init, !VarNames, |
434 | - !Instrs, !SubscriptMap). |
435 | + !Instrs, !SubscriptMap, !SynthFuncs). |
436 | exprs_to_instrs_(PT, Varset, BlockID,Ctx,[E|Es],Types,!VarNames, !Instrs, |
437 | - !SubscriptMap) :- |
438 | + !SubscriptMap, !SynthFuncs) :- |
439 | % Create a new variable name and generate instructions for each expr |
440 | - expr_to_instrs(PT, Varset, BlockID, Ctx, E, V, Is, Types0, !SubscriptMap), |
441 | + expr_to_instrs(PT, Varset, BlockID, Ctx, E, V, Is, Types0, !SubscriptMap, |
442 | + !SynthFuncs), |
443 | !:VarNames = [V | !.VarNames], |
444 | !:Instrs = [Is | !.Instrs], % Do not flatten Is; keep as list of lists |
445 | exprs_to_instrs_(PT, Varset, BlockID, Ctx, Es, Types1, !VarNames, !Instrs, |
446 | - !SubscriptMap), |
447 | + !SubscriptMap, !SynthFuncs), |
448 | Types = type_map_union(Types0, Types1). |
449 | |
450 | % expr_to_instrs(+BlockID, +Ctx, +Expr, -VarName, -Instrs, !SubscriptMap). |
451 | @@ -832,8 +862,10 @@ |
452 | % new temporary variable name). Returns the assigned variable name in VarName. |
453 | :- pred expr_to_instrs(progtable::in, varset::in, int::in, context::in, |
454 | expr::in, varname::out, list(instr)::out, type_map::out, |
455 | - subscript_map::in, subscript_map::out) is det. |
456 | -expr_to_instrs(PT, Varset, BlockID, Ctx, E, V, Is, Types, !SubscriptMap) :- |
457 | + subscript_map::in, subscript_map::out, |
458 | + list(function)::in, list(function)::out) is det. |
459 | +expr_to_instrs(PT, Varset, BlockID, Ctx, E, V, Is, Types, !SubscriptMap, |
460 | + !SynthFuncs) :- |
461 | ( E = expr(varref(Var), _) -> |
462 | % Special case -- expr_to_instrs_as will generate a mov. |
463 | % We can avoid this by not generating a temp var, and just returning |
464 | @@ -844,7 +876,7 @@ |
465 | ; |
466 | new_temp_variable(BlockID, V, !SubscriptMap), |
467 | expr_to_instrs_as(PT, Varset, BlockID, Ctx, E, V, Is, Types, |
468 | - !SubscriptMap) |
469 | + !SubscriptMap, !SynthFuncs) |
470 | ). |
471 | |
472 | % XXX The *public* version of expr_to_instrs expects non-SSA variable names; |
473 | @@ -852,87 +884,93 @@ |
474 | % Conversely, the *private* version of expr_to_instrs expects |
475 | % already-converted SSA variables. |
476 | % This disparity should probably be resolved. |
477 | -expr_to_instrs(PT, Varset, E0, V, Is, Ts, ast_state(SM0,DM), ast_state(SM,DM)) |
478 | - :- |
479 | +expr_to_instrs(PT, Varset, E0, V, Is, Ts, SynthFuncs, |
480 | + ast_state(SM0,DM), ast_state(SM,DM)) :- |
481 | Ctx = context.blank_context, |
482 | apply_def_map_to_expr(DM, Ctx, E0, E), |
483 | - expr_to_instrs(PT, Varset, 0, Ctx, E, V, Is, Ts, SM0, SM). |
484 | + expr_to_instrs(PT, Varset, 0, Ctx, E, V, Is, Ts, SM0, SM, [], SynthFuncs). |
485 | |
486 | -expr_to_instrs_post_ssa(PT, Varset, BlockID, E, V, Is, Ts, !BlockTempCount) :- |
487 | +expr_to_instrs_post_ssa(PT, Varset, BlockID, E, V, Is, Ts, SynthFuncs, |
488 | + !BlockTempCount) :- |
489 | Ctx = context.blank_context, |
490 | % Don't need defmap; it already is in SSA form |
491 | % Create submap -- we only need the temporary variable subscript |
492 | SM0 = map.from_assoc_list([tempvname - !.BlockTempCount]), |
493 | - expr_to_instrs(PT, Varset, BlockID, Ctx, E, V, Is, Ts, SM0, SM), |
494 | + expr_to_instrs(PT, Varset, BlockID, Ctx, E, V, Is, Ts, SM0, SM, [], |
495 | + SynthFuncs), |
496 | !:BlockTempCount = map.lookup(SM, tempvname). |
497 | |
498 | % expr_to_instrs_as(+PT, +BlockID, +Ctx, +Expr, +VarName, -Instrs, -Types, |
499 | -% !SubscriptMap). |
500 | +% !SubscriptMap, !SynthFuncs). |
501 | % Like expr_to_instrs, but it assigns to a specific VarName as given. |
502 | % (This is less efficient as it may generate a mov instruction). |
503 | :- pred expr_to_instrs_as(progtable::in, varset::in, int::in, context::in, |
504 | expr::in, varname::in, list(instr)::out, type_map::out, |
505 | - subscript_map::in, subscript_map::out) is det. |
506 | + subscript_map::in, subscript_map::out, |
507 | + list(function)::in, list(function)::out) is det. |
508 | expr_to_instrs_as(_PT, _Varset, _BlockID, Ctx, E@expr(intlit(Val),_), V, Is, |
509 | - Types, !SubscriptMap) :- |
510 | + Types, !SubscriptMap, !SynthFuncs) :- |
511 | Types = expr_typemap(V, E), |
512 | Is = [instr(ld_intlit(V, Val), Ctx)]. |
513 | expr_to_instrs_as(PT, Varset, BlockID, Ctx, E@expr(arraylit(Elems0),_), V, Is, |
514 | - Types, !SubscriptMap) :- |
515 | + Types, !SubscriptMap, !SynthFuncs) :- |
516 | Types0 = expr_typemap(V, E), |
517 | exprs_to_instrs(PT, Varset, BlockID, Ctx, Elems0, Elems, Is0, Types1, |
518 | - !SubscriptMap), |
519 | + !SubscriptMap, !SynthFuncs), |
520 | Types = type_map_union(Types0, Types1), |
521 | Is = Is0 ++ [instr(ld_arraylit(V, Elems), Ctx)]. |
522 | expr_to_instrs_as(_PT, _Varset, _BlockID, Ctx, E@expr(varref(Var),_), V, Is, |
523 | - Types, !SubscriptMap) :- |
524 | + Types, !SubscriptMap, !SynthFuncs) :- |
525 | Types = expr_typemap(V, E), |
526 | Is = [instr(mov(V, Var), Ctx)]. |
527 | expr_to_instrs_as(PT, _Varset, _BlockID, Ctx, E@expr(globalref(Name),_), V, |
528 | - Is, Types, !SubscriptMap) :- |
529 | + Is, Types, !SubscriptMap, !SynthFuncs) :- |
530 | Types = expr_typemap(V, E), |
531 | % The instruction will depend upon the type of variable |
532 | ( ir.global_is_cgc(PT, Name) -> |
533 | % Computable global constant. ld_cgc instruction. |
534 | Is = [instr(ld_cgc(V, Name), Ctx)] |
535 | ; |
536 | - % Global function. parcall_global instruction, with no arguments. |
537 | - Is = [instr(parcall_global(V, Name, []), Ctx)] |
538 | + % Global function. Generate a synthetic closure template; no cvars. |
539 | + parcall_global_closure_template(PT, Name, 0, CTName, !SynthFuncs), |
540 | + Is = [instr(new_closure(V, CTName, []), Ctx)] |
541 | ). |
542 | expr_to_instrs_as(PT, _Varset, _BlockID, Ctx, E@expr(ctorref(Name),_), V, Is, |
543 | - Types, !SubscriptMap) :- |
544 | + Types, !SubscriptMap, !SynthFuncs) :- |
545 | Types = expr_typemap(V, E), |
546 | % The instruction will depend upon the type of constructor |
547 | ( ir.ctor_is_cgc(PT, Name) -> |
548 | % Algebraic constant. ld_ctorsym instruction. |
549 | Is = [instr(ld_ctorsym(V, Name), Ctx)] |
550 | ; |
551 | - % Constructor function. parcall_ctor instruction, with no arguments. |
552 | - Is = [instr(parcall_ctor(V, Name, []), Ctx)] |
553 | + % Constructor function. Generate synthetic closure template; no cvars. |
554 | + parcall_ctor_closure_template(PT, Name, 0, CTName, !SynthFuncs), |
555 | + Is = [instr(new_closure(V, CTName, []), Ctx)] |
556 | ). |
557 | expr_to_instrs_as(PT, Varset, BlockID, Ctx, E@expr(fieldref(Obj0, Field),_), |
558 | - V, Is, Types, !SubscriptMap) :- |
559 | + V, Is, Types, !SubscriptMap, !SynthFuncs) :- |
560 | Types0 = expr_typemap(V, E), |
561 | expr_to_instrs(PT, Varset, BlockID, Ctx, Obj0, Obj, Is0, Types1, |
562 | - !SubscriptMap), |
563 | + !SubscriptMap, !SynthFuncs), |
564 | Types = type_map_union(Types0, Types1), |
565 | % All fields have a special function generated to handle this; call it |
566 | FuncName = ir.fieldfunc_name_ref(expr_typedef(PT, Varset, Obj0), Field), |
567 | Is = Is0 ++ [instr(call_global(V, FuncName, [Obj]), Ctx)]. |
568 | expr_to_instrs_as(PT, Varset, BlockID, Ctx, |
569 | - E@expr(fieldreplace(Obj0, Field, Val0),_), V, Is, Types, !SubscriptMap) :- |
570 | + E@expr(fieldreplace(Obj0, Field, Val0),_), V, Is, Types, !SubscriptMap, |
571 | + !SynthFuncs) :- |
572 | Types0 = expr_typemap(V, E), |
573 | expr_to_instrs(PT, Varset, BlockID, Ctx, Obj0, Obj, Is0, Types1, |
574 | - !SubscriptMap), |
575 | + !SubscriptMap, !SynthFuncs), |
576 | expr_to_instrs(PT, Varset, BlockID, Ctx, Val0, Val, Is1, Types2, |
577 | - !SubscriptMap), |
578 | + !SubscriptMap, !SynthFuncs), |
579 | Types = type_map_union(Types0, type_map_union(Types1, Types2)), |
580 | % All fields have a special function generated to handle this; call it |
581 | FuncName = ir.fieldfunc_name_replace(expr_typedef(PT,Varset,Obj0), Field), |
582 | Is2 = [instr(call_global(V, FuncName, [Obj, Val]), Ctx)], |
583 | Is = Is0 ++ Is1 ++ Is2. |
584 | expr_to_instrs_as(PT, Varset, BlockID, Ctx, E@expr(app(Func0, Args0),_), V, |
585 | - Is, Types, !SubscriptMap) :- |
586 | + Is, Types, !SubscriptMap, !SynthFuncs) :- |
587 | Types0 = expr_typemap(V, E), |
588 | ( |
589 | Func0 = expr(globalref(FuncName), _), |
590 | @@ -940,7 +978,7 @@ |
591 | -> |
592 | % Special case -- call to a global function name |
593 | exprs_to_instrs(PT, Varset, BlockID, Ctx, Args0, Args, Is0, Types1, |
594 | - !SubscriptMap), |
595 | + !SubscriptMap, !SynthFuncs), |
596 | Types = type_map_union(Types0, Types1), |
597 | Is1 = [instr(call_global(V, FuncName, Args), Ctx)], |
598 | Is = Is0 ++ Is1 |
599 | @@ -950,21 +988,21 @@ |
600 | -> |
601 | % Special case -- call to a constructor function |
602 | exprs_to_instrs(PT, Varset, BlockID, Ctx, Args0, Args, Is0, Types1, |
603 | - !SubscriptMap), |
604 | + !SubscriptMap, !SynthFuncs), |
605 | Types = type_map_union(Types0, Types1), |
606 | Is1 = [instr(call_ctor(V, CtorName, Args), Ctx)], |
607 | Is = Is0 ++ Is1 |
608 | ; |
609 | expr_to_instrs(PT, Varset, BlockID, Ctx, Func0, Func, Is0, Types1, |
610 | - !SubscriptMap), |
611 | + !SubscriptMap, !SynthFuncs), |
612 | exprs_to_instrs(PT, Varset, BlockID, Ctx, Args0, Args, Is1, Types2, |
613 | - !SubscriptMap), |
614 | + !SubscriptMap, !SynthFuncs), |
615 | Types = type_map_union(Types0, type_map_union(Types1, Types2)), |
616 | Is2 = [instr(call(V, Func, Args), Ctx)], |
617 | Is = Is0 ++ Is1 ++ Is2 |
618 | ). |
619 | expr_to_instrs_as(PT, Varset, BlockID, Ctx, E@expr(parapp(Func0, Args0),_), V, |
620 | - Is, Types, !SubscriptMap) :- |
621 | + Is, Types, !SubscriptMap, !SynthFuncs) :- |
622 | Types0 = expr_typemap(V, E), |
623 | ( |
624 | Func0 = expr(globalref(FuncName), _), |
625 | @@ -972,9 +1010,12 @@ |
626 | -> |
627 | % Special case -- parcall to a global function name |
628 | exprs_to_instrs(PT, Varset, BlockID, Ctx, Args0, Args, Is0, Types1, |
629 | - !SubscriptMap), |
630 | + !SubscriptMap, !SynthFuncs), |
631 | Types = type_map_union(Types0, Types1), |
632 | - Is1 = [instr(parcall_global(V, FuncName, Args), Ctx)], |
633 | + % Generate a synthetic closure template |
634 | + parcall_global_closure_template(PT, FuncName, length(Args), CTName, |
635 | + !SynthFuncs), |
636 | + Is1 = [instr(new_closure(V, CTName, Args), Ctx)], |
637 | Is = Is0 ++ Is1 |
638 | ; |
639 | Func0 = expr(ctorref(CtorName), _), |
640 | @@ -982,17 +1023,28 @@ |
641 | -> |
642 | % Special case -- parcall to a constructor function |
643 | exprs_to_instrs(PT, Varset, BlockID, Ctx, Args0, Args, Is0, Types1, |
644 | - !SubscriptMap), |
645 | + !SubscriptMap, !SynthFuncs), |
646 | Types = type_map_union(Types0, Types1), |
647 | - Is1 = [instr(parcall_ctor(V, CtorName, Args), Ctx)], |
648 | + % Generate a synthetic closure template |
649 | + parcall_ctor_closure_template(PT, CtorName, length(Args), CTName, |
650 | + !SynthFuncs), |
651 | + Is1 = [instr(new_closure(V, CTName, Args), Ctx)], |
652 | Is = Is0 ++ Is1 |
653 | ; |
654 | expr_to_instrs(PT, Varset, BlockID, Ctx, Func0, Func, Is0, Types1, |
655 | - !SubscriptMap), |
656 | + !SubscriptMap, !SynthFuncs), |
657 | exprs_to_instrs(PT, Varset, BlockID, Ctx, Args0, Args, Is1, Types2, |
658 | - !SubscriptMap), |
659 | + !SubscriptMap, !SynthFuncs), |
660 | Types = type_map_union(Types0, type_map_union(Types1, Types2)), |
661 | - Is2 = [instr(parcall(V, Func, Args), Ctx)], |
662 | + % Generate a synthetic closure template |
663 | + ( Func0^expr_type = yes(FuncType_) -> |
664 | + FuncType = FuncType_ |
665 | + ; |
666 | + error("expr_to_instrs_as: Parcall target has no type") |
667 | + ), |
668 | + parcall_closure_template(PT, FuncType, length(Args), CTName, |
669 | + !SynthFuncs), |
670 | + Is2 = [instr(new_closure(V, CTName, [Func|Args]), Ctx)], |
671 | Is = Is0 ++ Is1 ++ Is2 |
672 | ). |
673 | |
674 | @@ -1014,10 +1066,10 @@ |
675 | error("expr_typedef: Expr type was not user-defined") |
676 | ). |
677 | |
678 | -basic_stmt_to_instrs(PT, Varset, BasicStmt, Instrs, Types, |
679 | +basic_stmt_to_instrs(PT, Varset, BasicStmt, Instrs, Types, SynthFuncs, |
680 | ast_state(SM0,DM0), ast_state(SM,DM)) :- |
681 | basic_stmt_to_instrs(PT, Varset, 0, BasicStmt, context.blank_context, |
682 | - Types, Instrs, SM0, SM, DM0, DM). |
683 | + Types, Instrs, SM0, SM, DM0, DM, [], SynthFuncs). |
684 | |
685 | % basic_stmt_to_instrs(+PT, +BlockID, +BasicStmt, +Ctx, -Types, -Instrs, |
686 | % !SubscriptMap). |
687 | @@ -1027,23 +1079,24 @@ |
688 | % newly-defined variables. |
689 | :- pred basic_stmt_to_instrs(progtable::in, varset::in, int::in, |
690 | basic_stmt::in, context::in, type_map::out, list(instr)::out, |
691 | - subscript_map::in, subscript_map::out, def_map::in, def_map::out) is det. |
692 | + subscript_map::in, subscript_map::out, def_map::in, def_map::out, |
693 | + list(function)::in, list(function)::out) is det. |
694 | basic_stmt_to_instrs(_PT, _Varset, _BlockID, pass, _Ctx, map.init, [], |
695 | - !SubscriptMap, !DefMap). |
696 | + !SubscriptMap, !DefMap, !SynthFuncs). |
697 | basic_stmt_to_instrs(PT, Varset, BlockID, assign(V0, E0), Ctx, Types, Is, |
698 | - !SubscriptMap, !DefMap) :- |
699 | + !SubscriptMap, !DefMap, !SynthFuncs) :- |
700 | apply_def_map_to_expr(!.DefMap, Ctx, E0, E), |
701 | new_ssa_variable(BlockID, V0, V, !SubscriptMap, !DefMap), |
702 | expr_to_instrs_as(PT, Varset, BlockID, Ctx, E, V, Is, Types, |
703 | - !SubscriptMap). |
704 | + !SubscriptMap, !SynthFuncs). |
705 | basic_stmt_to_instrs(PT, Varset, BlockID, fieldset(Obj0, Field, Val0), Ctx, |
706 | - Types, Is, !SubscriptMap, !DefMap) :- |
707 | + Types, Is, !SubscriptMap, !DefMap, !SynthFuncs) :- |
708 | apply_def_map_to_expr(!.DefMap, Ctx, Obj0, Obj1), |
709 | apply_def_map_to_expr(!.DefMap, Ctx, Val0, Val1), |
710 | expr_to_instrs(PT, Varset, BlockID, Ctx, Obj1, Obj, Is0, Types0, |
711 | - !SubscriptMap), |
712 | + !SubscriptMap, !SynthFuncs), |
713 | expr_to_instrs(PT, Varset, BlockID, Ctx, Val1, Val, Is1, Types1, |
714 | - !SubscriptMap), |
715 | + !SubscriptMap, !SynthFuncs), |
716 | % All fields have a special function generated to handle this; call it |
717 | % Note: the '/set' functions return the object; ignore the result |
718 | new_temp_variable(BlockID, V, !SubscriptMap), |
719 | @@ -1053,10 +1106,11 @@ |
720 | Is2 = [instr(call_global(V, FuncName, [Obj, Val]), Ctx)], |
721 | Is = Is0 ++ Is1 ++ Is2. |
722 | basic_stmt_to_instrs(PT, Varset, BlockID, eval(E0), Ctx, Types, Is, |
723 | - !SubscriptMap, !DefMap) :- |
724 | + !SubscriptMap, !DefMap, !SynthFuncs) :- |
725 | apply_def_map_to_expr(!.DefMap, Ctx, E0, E), |
726 | % The variable _T is assigned to, then thrown away. |
727 | - expr_to_instrs(PT, Varset, BlockID, Ctx, E, _T, Is, Types, !SubscriptMap). |
728 | + expr_to_instrs(PT, Varset, BlockID, Ctx, E, _T, Is, Types, !SubscriptMap, |
729 | + !SynthFuncs). |
730 | |
731 | % basic_stmt_to_cfg(+PT, +Varset, +BasicStmt, +Ctx, +BBCurrent, -Types, |
732 | % !SubscriptMap, !DefMap, !CFG). |
733 | @@ -1066,12 +1120,12 @@ |
734 | :- pred basic_stmt_to_cfg(progtable::in, varset::in, basic_stmt::in, |
735 | context::in, bbref(S)::in, type_map::out, |
736 | subscript_map::in, subscript_map::out, def_map::in, def_map::out, |
737 | - cfg(S)::in, cfg(S)::out) is det. |
738 | + cfg(S)::in, cfg(S)::out, list(function)::in, list(function)::out) is det. |
739 | basic_stmt_to_cfg(PT, Varset, Stmt, Ctx, BBCurrent, Types, !SubscriptMap, |
740 | - !DefMap, !CFG) :- |
741 | + !DefMap, !CFG, !SynthFuncs) :- |
742 | BlockID = ref_id(BBCurrent, !.CFG), |
743 | basic_stmt_to_instrs(PT, Varset, BlockID, Stmt, Ctx, Types, Instrs, |
744 | - !SubscriptMap, !DefMap), |
745 | + !SubscriptMap, !DefMap, !SynthFuncs), |
746 | cfg.append_instrs(BBCurrent, Instrs, !CFG). |
747 | |
748 | % compound_stmt_to_cfg(+CompoundStmt, +Varset, +Ctx, +BBCurrent, +BBAfter, |
749 | @@ -1090,30 +1144,33 @@ |
750 | :- pred compound_stmt_to_cfg(progtable::in, varset::in, compound_stmt::in, |
751 | context::in, bbref(S)::in, bbref(S)::in, subscript_map::in, def_map::in, |
752 | type_map::out, pred_map(S)::in, pred_map(S)::out, |
753 | - pred_map(S)::in, pred_map(S)::out, cfg(S)::in, cfg(S)::out) is det. |
754 | + pred_map(S)::in, pred_map(S)::out, cfg(S)::in, cfg(S)::out, |
755 | + list(function)::in, list(function)::out) is det. |
756 | compound_stmt_to_cfg(PT, Varset, return(Expr), Ctx, BBCurrent, _BBAfter, |
757 | - SubscriptMap, DefMap0, Types, !AfterPredMap, !ExitPredMap, !CFG) :- |
758 | + SubscriptMap, DefMap0, Types, !AfterPredMap, !ExitPredMap, !CFG, |
759 | + !SynthFuncs) :- |
760 | % Return is expressed in CFG as $RET = expr, followed by a branch to the |
761 | % exit block. |
762 | basic_stmt_to_cfg(PT, Varset, assign(retvname, Expr), Ctx, BBCurrent, |
763 | - Types, SubscriptMap, _, DefMap0, DefMap, !CFG), |
764 | + Types, SubscriptMap, _, DefMap0, DefMap, !CFG, !SynthFuncs), |
765 | ExitBlock = cfg.get_exit(!.CFG), |
766 | add_to_pred_map(BBCurrent, DefMap, ExitBlock, !ExitPredMap, !CFG), |
767 | cfg.set_terminator(BBCurrent, branch(ExitBlock, Ctx), !CFG). |
768 | compound_stmt_to_cfg(PT, Varset, switch(Ctrl0, Cases0), Ctx, BBCurrent, |
769 | - BBAfter, SubscriptMap0, DefMap, Types, !AfterPredMap, !ExitPredMap, !CFG) |
770 | - :- |
771 | + BBAfter, SubscriptMap0, DefMap, Types, !AfterPredMap, !ExitPredMap, !CFG, |
772 | + !SynthFuncs) :- |
773 | % Calculate the condition expression at the end of BBCurrent |
774 | apply_def_map_to_expr(DefMap, Ctx, Ctrl0, Ctrl), |
775 | BlockID = ref_id(BBCurrent, !.CFG), |
776 | expr_to_instrs(PT, Varset, BlockID, Ctx, Ctrl, CtrlVar, CtrlInstrs, |
777 | - Types0, SubscriptMap0, SubscriptMap), |
778 | + Types0, SubscriptMap0, SubscriptMap, !SynthFuncs), |
779 | cfg.append_instrs(BBCurrent, CtrlInstrs, !CFG), |
780 | % Convert all patterns to use SSA variables, and generate CFG code for the |
781 | % bodies of all case statements. The resulting Cases contains goto |
782 | % statements for each generated block. |
783 | - list.map_foldl3(case_stmt_to_jmp(PT, Varset, BBAfter, DefMap), |
784 | - Cases0, CasesTypes, !AfterPredMap, !ExitPredMap, !CFG), |
785 | + list.map_foldl4(case_stmt_to_jmp(PT, Varset, BBAfter, DefMap), |
786 | + Cases0, CasesTypes, !AfterPredMap, !ExitPredMap, !CFG, |
787 | + !SynthFuncs), |
788 | Cases = map(fst, CasesTypes), |
789 | % Now begin switch factoring transformation |
790 | % Convert each case statement to a matcher (flatten the patterns) |
791 | @@ -1125,18 +1182,18 @@ |
792 | map.foldl(generate_case_block_phis, PhiTable, !CFG). |
793 | compound_stmt_to_cfg(PT, Varset, if_then_else(Cond0,ThenPart,ElsePart), Ctx, |
794 | BBCurrent, BBAfter, SubscriptMap, DefMap, Types, !AfterPredMap, |
795 | - !ExitPredMap, !CFG) :- |
796 | + !ExitPredMap, !CFG, !SynthFuncs) :- |
797 | % Calculate the condition expression at the end of BBCurrent |
798 | apply_def_map_to_expr(DefMap, Ctx, Cond0, Cond), |
799 | BlockID = ref_id(BBCurrent, !.CFG), |
800 | expr_to_instrs(PT, Varset, BlockID, Ctx, Cond, CondVar, CondInstrs, |
801 | - Types0, SubscriptMap, _), |
802 | + Types0, SubscriptMap, _, !SynthFuncs), |
803 | cfg.append_instrs(BBCurrent, CondInstrs, !CFG), |
804 | % Create a new basic block for the "then" part. |
805 | cfg.new_basic_block(ThenEnter, !CFG), |
806 | cfg.append_predecessor(ThenEnter, BBCurrent, !CFG), |
807 | stmt_block_to_cfg(PT, Varset, ThenPart, ThenEnter, BBAfter, DefMap, |
808 | - Types1, !AfterPredMap, !ExitPredMap, !CFG), |
809 | + Types1, !AfterPredMap, !ExitPredMap, !CFG, !SynthFuncs), |
810 | ( list.is_empty(ElsePart) -> |
811 | % Branch straight to the "after" block if the condition fails |
812 | add_to_pred_map(BBCurrent, DefMap, BBAfter, !AfterPredMap, !CFG), |
813 | @@ -1148,7 +1205,7 @@ |
814 | cfg.new_basic_block(ElseEnter, !CFG), |
815 | cfg.append_predecessor(ElseEnter, BBCurrent, !CFG), |
816 | stmt_block_to_cfg(PT, Varset, ElsePart, ElseEnter, BBAfter, DefMap, |
817 | - Types2, !AfterPredMap, !ExitPredMap, !CFG), |
818 | + Types2, !AfterPredMap, !ExitPredMap, !CFG, !SynthFuncs), |
819 | % Have the current block terminate by branching into the then/else |
820 | % blocks |
821 | cfg.set_terminator(BBCurrent, |
822 | @@ -1156,7 +1213,8 @@ |
823 | Types = type_map_union(Types0, type_map_union(Types1, Types2)) |
824 | ). |
825 | compound_stmt_to_cfg(PT, Varset, while(Cond0, Body), Ctx, BBCurrent, BBAfter, |
826 | - SubscriptMap, DefMap, Types, !AfterPredMap, !ExitPredMap, !CFG) :- |
827 | + SubscriptMap, DefMap, Types, !AfterPredMap, !ExitPredMap, !CFG, |
828 | + !SynthFuncs) :- |
829 | % Create a new basic block for the condition and body |
830 | cfg.new_basic_block(CondBlock, !CFG), |
831 | cfg.new_basic_block(BodyEnter, !CFG), |
832 | @@ -1176,7 +1234,7 @@ |
833 | % Do the whole fixpoint. Updates CFG by setting CondBlock's phis, and |
834 | % compiling Body. |
835 | while_fixpoint(PT, Varset, CondBlock, BodyEnter, Body, CondBlockPredMap, |
836 | - Types0, !ExitPredMap, DefMap, CondBlockDefMap, !CFG), |
837 | + Types0, !ExitPredMap, DefMap, CondBlockDefMap, !CFG, !SynthFuncs), |
838 | |
839 | % CondBlock branches to BodyBlock or BBAfter, based on the condition |
840 | % Note: Use append_predecessor (not add_to_pred_map) because CondBlock is |
841 | @@ -1189,7 +1247,7 @@ |
842 | apply_def_map_to_expr(CondBlockDefMap, Ctx, Cond0, Cond), |
843 | BlockID = ref_id(CondBlock, !.CFG), |
844 | expr_to_instrs(PT, Varset, BlockID, Ctx, Cond, CondVar, CondInstrs, |
845 | - Types1, SubscriptMap, _), |
846 | + Types1, SubscriptMap, _, !SynthFuncs), |
847 | Types = type_map_union(Types0, Types1), |
848 | cfg.append_instrs(CondBlock, CondInstrs, !CFG), |
849 | cfg.set_terminator(CondBlock, cond_branch(CondVar,BodyEnter,BBAfter,Ctx), |
850 | @@ -1205,23 +1263,25 @@ |
851 | :- pred while_fixpoint(progtable::in, varset::in, bbref(S)::in, bbref(S)::in, |
852 | stmt_block::in, pred_map(S)::in, type_map::out, |
853 | pred_map(S)::in, pred_map(S)::out, |
854 | - def_map::in, def_map::out, cfg(S)::in, cfg(S)::out) is det. |
855 | + def_map::in, def_map::out, cfg(S)::in, cfg(S)::out, |
856 | + list(function)::in, list(function)::out) is det. |
857 | while_fixpoint(PT, Varset, CondBlock, BodyEnter, Body, CondPredMap, Types, |
858 | - !ExitPredMap, !DefMap, !CFG) :- |
859 | + !ExitPredMap, !DefMap, !CFG, !SynthFuncs) :- |
860 | % First iteration, assume there are no phis |
861 | while_fixpoint_(PT, Varset, CondBlock, BodyEnter, Body, CondPredMap, [], |
862 | - Types, !ExitPredMap, !DefMap, !CFG). |
863 | + Types, !ExitPredMap, !DefMap, !CFG, !SynthFuncs). |
864 | |
865 | :- pred while_fixpoint_(progtable::in, varset::in, bbref(S)::in, bbref(S)::in, |
866 | stmt_block::in, pred_map(S)::in, list(phi(S))::in, type_map::out, |
867 | pred_map(S)::in, pred_map(S)::out, |
868 | - def_map::in, def_map::out, cfg(S)::in, cfg(S)::out) is det. |
869 | + def_map::in, def_map::out, cfg(S)::in, cfg(S)::out, |
870 | + list(function)::in, list(function)::out) is det. |
871 | while_fixpoint_(PT, Varset, CondBlock, BodyEnter, Body, CondPredMap0, Phis0, |
872 | - Types, !ExitPredMap, !CondDefMap, !CFG) :- |
873 | + Types, !ExitPredMap, !CondDefMap, !CFG, !SynthFuncs) :- |
874 | % Compute CondPredMap (after another iteration of the body) |
875 | stmt_block_to_cfg(PT, Varset, Body, BodyEnter, CondBlock, !.CondDefMap, |
876 | Types0, CondPredMap0, CondPredMap, !ExitPredMap, !.CFG, |
877 | - PotentialFinalCFG), |
878 | + PotentialFinalCFG, !SynthFuncs), |
879 | % Now we can compute the phis for the cond block |
880 | CondBlockID = ref_id(CondBlock, !.CFG), |
881 | reconcile_def_maps(CondBlockID, CondPredMap, Phis, _, CondDefMap1), |
882 | @@ -1235,7 +1295,8 @@ |
883 | ; |
884 | % Now iterate till fixpoint |
885 | while_fixpoint_(PT, Varset, CondBlock, BodyEnter, Body, CondPredMap, |
886 | - Phis, Types, !ExitPredMap, CondDefMap1, !:CondDefMap, !CFG) |
887 | + Phis, Types, !ExitPredMap, CondDefMap1, !:CondDefMap, !CFG, |
888 | + !SynthFuncs) |
889 | ). |
890 | |
891 | % Intermediate representation of a case statement -- still contains recursive |
892 | @@ -1705,11 +1766,12 @@ |
893 | :- pred case_stmt_to_jmp(progtable::in, varset::in, |
894 | bbref(S)::in, def_map::in, case_stmt::in, |
895 | pair(jmp_case_stmt(S), type_map)::out, pred_map(S)::in, pred_map(S)::out, |
896 | - pred_map(S)::in, pred_map(S)::out, cfg(S)::in, cfg(S)::out) is det. |
897 | + pred_map(S)::in, pred_map(S)::out, cfg(S)::in, cfg(S)::out, |
898 | + list(function)::in, list(function)::out) is det. |
899 | case_stmt_to_jmp(PT, Varset, BBAfter, DefMap, |
900 | case_stmt(Pattern0, Stmts, Ctx), |
901 | jmp_case_stmt(Pattern, BBFirst, Ctx) - Types, !AfterPredMap, !ExitPredMap, |
902 | - !CFG) :- |
903 | + !CFG, !SynthFuncs) :- |
904 | % New basic block for the body of the case statement |
905 | cfg.new_basic_block(BBFirst, !CFG), |
906 | % Traverse the pattern and uniquely label each newly-introduced |
907 | @@ -1723,7 +1785,8 @@ |
908 | % Generate the code for the body of the case statement, using the new |
909 | % subscript map (which includes the newly-bound variables) |
910 | stmt_block_to_cfg(PT,Varset, Stmts, BBFirst, BBAfter, SubscriptMap, |
911 | - InnerScopeDefMap, Types1, !AfterPredMap, !ExitPredMap, !CFG), |
912 | + InnerScopeDefMap, Types1, !AfterPredMap, !ExitPredMap, !CFG, |
913 | + !SynthFuncs), |
914 | |
915 | Types = type_map_union(Types0, Types1). |
916 | |
917 | @@ -1895,7 +1958,8 @@ |
918 | [retvname-RetType|map(func(N-T) = svname(N)-T, Params) ++ LT_Dst]), |
919 | Body = 'new func_body_cfg'(LT, CFG), |
920 | Ctx = Typedef^typedef_context, |
921 | - Func = function(FuncName, Params_, RetType, Varset, [],Rigids, Body, Ctx). |
922 | + Func = function(FuncName, no, Params_, RetType, Varset, [],Rigids, Body, |
923 | + Ctx). |
924 | |
925 | :- pred fieldfunc_block( |
926 | func(varname, string, int) = instr_::in, typedef::in, bbref(S)::in, |
927 | @@ -1939,3 +2003,232 @@ |
928 | cfg.set_terminator(Bl, Term, !CFG), |
929 | TypeMap = map(func(V) = V-types.const("Int"), CharVars) ++ |
930 | [MsgVar-types.app(types.const("Array"), [types.const("Int")])]. |
931 | + |
932 | +% -------------------------------------------------------------------------- % |
933 | +% Closure template generation |
934 | +% -------------------------------------------------------------------------- % |
935 | + |
936 | +% parcall_global_closure_template(PT, Target, N) |
937 | +% Builds a closure template which takes N cvars, and any remaining |
938 | +% required parameters, and calls Target. |
939 | +:- pred parcall_global_closure_template(tables.progtable::in, string::in, |
940 | + int::in, string::out, list(function)::in, list(function)::out). |
941 | +parcall_global_closure_template(PT, Target, N, Name, !SynthFuncs) :- |
942 | + ( tables.lookup_function(PT, Target, Callee_) -> |
943 | + Callee = Callee_ |
944 | + ; |
945 | + error("parcall_global_closure_template: Not found: " ++ Target) |
946 | + ), |
947 | + ( |
948 | + Callee^func_params = yes(CalleeParams) |
949 | + ; |
950 | + Callee^func_params = no, |
951 | + error("parcall_global_closure_template: Parcall to CGC") |
952 | + ), |
953 | + ( |
954 | + Callee^func_cvars = yes(_), |
955 | + error("parcall_global_closure_template: Parcall to closure template") |
956 | + ; |
957 | + Callee^func_cvars = no |
958 | + ), |
959 | + ir.function_type(Callee, _, CalleeType), |
960 | + RetType = Callee^func_ret_type, |
961 | + Varset = Callee^func_varset, |
962 | + Rigids = Callee^func_rigids, |
963 | + |
964 | + build_closure_template(PT, globalref(Target), Target, CalleeParams, |
965 | + CalleeType, RetType, Varset, Rigids, N, Name, !SynthFuncs). |
966 | + |
967 | +% parcall_ctor_closure_template(PT, Target, N) |
968 | +% Builds a closure template which takes N cvars, and any remaining |
969 | +% required parameters, and calls Target, which is a global constructor. |
970 | +:- pred parcall_ctor_closure_template(tables.progtable::in, string::in, |
971 | + int::in, string::out, list(function)::in, list(function)::out). |
972 | +parcall_ctor_closure_template(PT, Target, N, Name, !SynthFuncs) :- |
973 | + ( tables.lookup_ctor(PT, Target, Typedef_, Ctor_) -> |
974 | + Typedef = Typedef_, Ctor = Ctor_ |
975 | + ; |
976 | + error("parcall_ctor_closure_template: Not found: " ++ Target) |
977 | + ), |
978 | + ( |
979 | + Ctor^ctor_args = yes(CalleeMaybeParams) |
980 | + ; |
981 | + Ctor^ctor_args = no, |
982 | + error("parcall_ctor_closure_template: Parcall to ctor constant") |
983 | + ), |
984 | + % Give a name to each unnamed argument |
985 | + list.map_foldl((pred(MaybeName-Ty::in, {Nm,Ty}::out, I::in, I+1::out) |
986 | + is det :- |
987 | + ( |
988 | + MaybeName = yes(Nm) |
989 | + ; |
990 | + MaybeName = no, |
991 | + % Use the colon to ensure no overlap with the named |
992 | + % parameters |
993 | + Nm = "p:" ++ string(I) |
994 | + )), CalleeMaybeParams, CalleeParams, 1, _), |
995 | + ( ir.ctor_type(Typedef, Target, _, CalleeType_) -> |
996 | + CalleeType = CalleeType_ |
997 | + ; |
998 | + error("parcall_ctor_closure_template: Ctor not found in own typedef") |
999 | + ), |
1000 | + typedef_type(Typedef, RetType), |
1001 | + Varset = Typedef^typedef_varset, |
1002 | + Rigids = varset.vars(Varset), |
1003 | + |
1004 | + build_closure_template(PT, ctorref(Target), Target, CalleeParams, |
1005 | + CalleeType, RetType, Varset, Rigids, N, Name, !SynthFuncs). |
1006 | + |
1007 | +% Common code for building closure templates |
1008 | +:- pred build_closure_template(tables.progtable::in, expr_::in, string::in, |
1009 | + list({string, typeval})::in, typeval::in, typeval::in, varset::in, |
1010 | + list(term.var)::in, int::in, string::out, |
1011 | + list(function)::in, list(function)::out). |
1012 | +build_closure_template(PT, Target, TargetName, CalleeParams, CalleeType, |
1013 | + RetType, Varset, Rigids, N, Name, !SynthFuncs) :- |
1014 | + CTemp0 = function(Name, CVars, Params, RetType, Varset, TDVars, Rigids, |
1015 | + Body, Ctx), |
1016 | + ( N > 0 -> |
1017 | + Name = "ct:" ++ TargetName ++ ":" ++ string(N) |
1018 | + ; |
1019 | + % Special name, with no number on the end |
1020 | + % (represents a simple function lifter; conceptually not currying) |
1021 | + Name = "ct:" ++ TargetName |
1022 | + ), |
1023 | + % Split func_params into N CVars and remaining Params |
1024 | + ( list.split_list(N, CalleeParams, YesCVars, YesParams) -> |
1025 | + CVars = yes(YesCVars), |
1026 | + Params = yes(YesParams) |
1027 | + ; |
1028 | + error("build_closure_template: N > number of params") |
1029 | + ), |
1030 | + TDVars = [], % Populated later (by typedict) |
1031 | + Ctx = context.blank_context, |
1032 | + |
1033 | + % Build the body: |
1034 | + % return Callee(*CalleeParams) |
1035 | + ArgNames = map(func({Nm,Ty}) = expr(varref(svname(Nm)), yes(Ty)), |
1036 | + CalleeParams), |
1037 | + RetExpr = expr(app(expr(Target,yes(CalleeType)), ArgNames), yes(RetType)), |
1038 | + Body = func_body_ast([], [compound_stmt(return(RetExpr), Ctx)]), |
1039 | + |
1040 | + % Compile it into CFG form |
1041 | + % Note: InnerSynthFuncs should be empty, but if there are any we handle it |
1042 | + func_to_cfg(PT, CTemp0, CTemp, InnerSynthFuncs), |
1043 | + !:SynthFuncs = [CTemp|InnerSynthFuncs ++ !.SynthFuncs]. |
1044 | + |
1045 | +% parcall_closure_template(PT, TargetType, N) |
1046 | +% Builds a closure template which takes a function F of type TargetType (a |
1047 | +% function type), and N cvars of the types of the first N arguments to |
1048 | +% TargetType and any remaining required parameters, and calls F. |
1049 | +% Used for partial application to lifted functions. |
1050 | +:- pred parcall_closure_template(tables.progtable::in, typeval::in, |
1051 | + int::in, string::out, list(function)::in, list(function)::out). |
1052 | +parcall_closure_template(PT, TargetType, N, Name, !SynthFuncs) :- |
1053 | + CTemp0 = function(Name, CVars, Params, RetType, Varset, TDVars, Rigids, |
1054 | + Body, Ctx), |
1055 | + Name = "ct:ty:" ++ type_to_identifier(TargetType) ++ ":" ++ string(N), |
1056 | + ( |
1057 | + TargetType = types.app(types.functype, ArgRetTypes), |
1058 | + list.split_last(ArgRetTypes, ArgTypes_, RetType_) |
1059 | + -> |
1060 | + ArgTypes = ArgTypes_, RetType = RetType_ |
1061 | + ; |
1062 | + error("parcall_closure_template: Parcall to non-function type") |
1063 | + ), |
1064 | + % Give a name to each argument |
1065 | + list.map_foldl(pred(Ty::in, {"p_" ++ string(I), Ty}::out, I::in, I+1::out) |
1066 | + is det, ArgTypes, ArgNameTypes, 1, _), |
1067 | + TargetName = "f", |
1068 | + TargetNameType = {"f", TargetType}, |
1069 | + % Split ArgTypes into N CVars and remaining Params |
1070 | + ( list.split_list(N, ArgNameTypes, YesCVars, YesParams) -> |
1071 | + % Prepend the first cvar, which is the function object itself |
1072 | + CVars = yes([TargetNameType|YesCVars]), |
1073 | + Params = yes(YesParams) |
1074 | + ; |
1075 | + error("parcall_closure_template: N > number of params") |
1076 | + ), |
1077 | + % The varset can be empty (no variables are named or bound) |
1078 | + Varset = varset.init, |
1079 | + TDVars = [], |
1080 | + % All type variables in TargetType are rigids in this closure template |
1081 | + Rigids = types.vars(TargetType), |
1082 | + Ctx = context.blank_context, |
1083 | + |
1084 | + % Build the body: |
1085 | + % return f(*ArgNames) |
1086 | + ArgNames = map(func({Nm,Ty}) = expr(varref(svname(Nm)), yes(Ty)), |
1087 | + ArgNameTypes), |
1088 | + RetExpr = expr(app(expr(varref(svname(TargetName)), yes(TargetType)), |
1089 | + ArgNames), |
1090 | + yes(RetType)), |
1091 | + Body = func_body_ast([], [compound_stmt(return(RetExpr), Ctx)]), |
1092 | + |
1093 | + % Compile it into CFG form |
1094 | + % Note: InnerSynthFuncs should be empty, but if there are any we handle it |
1095 | + func_to_cfg(PT, CTemp0, CTemp, InnerSynthFuncs), |
1096 | + !:SynthFuncs = [CTemp|InnerSynthFuncs ++ !.SynthFuncs]. |
1097 | + |
1098 | +% Convert a Mars type to a string which uniquely identifies that type and is a |
1099 | +% valid Mars identifier (beginning with a lowercase letter, and allowed to |
1100 | +% contain semicolons). |
1101 | +% Used for generating closure template names. |
1102 | +% Note that this does not use a varset; any type variables are expected to be |
1103 | +% unbound and their names will be normalised. |
1104 | +:- func type_to_identifier(typeval) = string. |
1105 | +type_to_identifier(Type) = Name :- |
1106 | + % We use an unfriendly syntax to ensure that the result is an unambiguous |
1107 | + % identifier. We assume that all constant type names have a fixed arity, |
1108 | + % except for function arrow types. |
1109 | + % Constant types are prefixed with c and suffixed with ;. |
1110 | + % The function arrow type (->) consist of an f followed by the arity of |
1111 | + % the type (note: this is one more than the arity of the function; a |
1112 | + % function that takes 2 arguments has type arity 3). |
1113 | + % Functions not used in applications are just written as f. |
1114 | + % Type variables consist of a v followed by a non-negative integer |
1115 | + % identifying the variable. |
1116 | + % Type application concatenates all arguments, then the type function |
1117 | + % (reverse-polish notation). |
1118 | + % Examples: |
1119 | + % Mars Type Encoded type name |
1120 | + % Int cInt; |
1121 | + % -> f (function arrow type, non-application) |
1122 | + % -> :: (*, *, *) -> * f3 (function of 2 arguments) |
1123 | + % c v2 (third available type variable) |
1124 | + % Array(Int) cInt;cArray; |
1125 | + % a -> b v0v1f2 |
1126 | + % (a, List(a)) -> List(a) v0v0cList;v0cList;f3 |
1127 | + ( Type = types.const(TyName) -> |
1128 | + Name = "c" ++ TyName ++ ";" |
1129 | + ; Type = types.functype -> |
1130 | + Name = "f" |
1131 | + ; Type = types.variable(Var) -> |
1132 | + Name = "v" ++ string(term.var_id(Var):int) |
1133 | + ; Type = types.app(Fun, Args) -> |
1134 | + ( Fun = types.functype -> |
1135 | + % Special case for function used in application |
1136 | + FunName = "f" ++ string(length(Args):int) |
1137 | + ; |
1138 | + FunName = type_to_identifier(Fun) |
1139 | + ), |
1140 | + ArgNames = map(type_to_identifier, Args), |
1141 | + Name = string.append_list(ArgNames) ++ FunName |
1142 | + ; |
1143 | + error("ast_cfg.type_to_identifier: Invalid type") |
1144 | + ). |
1145 | + |
1146 | +remove_dup_funcs(Funcs) = FilteredFuncs :- |
1147 | + list.map_foldl((pred(F::in, MayF::out, Seen0::in, Seen::out) is det :- |
1148 | + ( map.insert(Seen0, F^func_name, unit, Seen_) -> |
1149 | + % First occurence of the function name -- keep |
1150 | + Seen = Seen_, |
1151 | + MayF = yes(F) |
1152 | + ; |
1153 | + % Already seen -- drop this occurence |
1154 | + Seen = Seen0, |
1155 | + MayF = no |
1156 | + ) |
1157 | + ), Funcs, MaybeFuncs, map.init, _), |
1158 | + list.filter_map(pred(yes(F)::in, F::out) is semidet, |
1159 | + MaybeFuncs, FilteredFuncs). |
1160 | |
1161 | === modified file 'src/builtins.m' |
1162 | --- src/builtins.m 2011-02-16 06:00:19 +0000 |
1163 | +++ src/builtins.m 2011-05-11 05:12:31 +0000 |
1164 | @@ -107,7 +107,8 @@ |
1165 | % Comparison % |
1166 | |
1167 | :- func func_eq = function. |
1168 | -func_eq = function("eq", yes([{"x", types.variable(A)}, |
1169 | +func_eq = function("eq", no, |
1170 | + yes([{"x", types.variable(A)}, |
1171 | {"y", types.variable(A)}]), |
1172 | types.const("Int"), |
1173 | Varset, [A], [A], |
1174 | @@ -116,7 +117,7 @@ |
1175 | varset.new_named_var(varset.init, "a", A, Varset). |
1176 | |
1177 | :- func func_impure_is = function. |
1178 | -func_impure_is = function("__impure_is", |
1179 | +func_impure_is = function("__impure_is", no, |
1180 | yes([{"x", types.variable(A)}, |
1181 | {"y", types.variable(A)}]), |
1182 | types.const("Int"), |
1183 | @@ -126,7 +127,8 @@ |
1184 | varset.new_named_var(varset.init, "a", A, Varset). |
1185 | |
1186 | :- func func_cmp = function. |
1187 | -func_cmp = function("cmp", yes([{"x", types.const("Int")}, |
1188 | +func_cmp = function("cmp", no, |
1189 | + yes([{"x", types.const("Int")}, |
1190 | {"y", types.const("Int")}]), |
1191 | types.const("Int"), |
1192 | varset.init, [], [], |
1193 | @@ -136,7 +138,8 @@ |
1194 | % Arithmetic % |
1195 | |
1196 | :- func func_add = function. |
1197 | -func_add = function("add", yes([{"x", types.const("Int")}, |
1198 | +func_add = function("add", no, |
1199 | + yes([{"x", types.const("Int")}, |
1200 | {"y", types.const("Int")}]), |
1201 | types.const("Int"), |
1202 | varset.init, [], [], |
1203 | @@ -144,7 +147,8 @@ |
1204 | ctx). |
1205 | |
1206 | :- func func_sub = function. |
1207 | -func_sub = function("sub", yes([{"x", types.const("Int")}, |
1208 | +func_sub = function("sub", no, |
1209 | + yes([{"x", types.const("Int")}, |
1210 | {"y", types.const("Int")}]), |
1211 | types.const("Int"), |
1212 | varset.init, [], [], |
1213 | @@ -152,7 +156,8 @@ |
1214 | ctx). |
1215 | |
1216 | :- func func_mul = function. |
1217 | -func_mul = function("mul", yes([{"x", types.const("Int")}, |
1218 | +func_mul = function("mul", no, |
1219 | + yes([{"x", types.const("Int")}, |
1220 | {"y", types.const("Int")}]), |
1221 | types.const("Int"), |
1222 | varset.init, [], [], |
1223 | @@ -160,7 +165,8 @@ |
1224 | ctx). |
1225 | |
1226 | :- func func_div = function. |
1227 | -func_div = function("div", yes([{"x", types.const("Int")}, |
1228 | +func_div = function("div", no, |
1229 | + yes([{"x", types.const("Int")}, |
1230 | {"y", types.const("Int")}]), |
1231 | types.const("Int"), |
1232 | varset.init, [], [], |
1233 | @@ -168,7 +174,8 @@ |
1234 | ctx). |
1235 | |
1236 | :- func func_mod = function. |
1237 | -func_mod = function("mod", yes([{"x", types.const("Int")}, |
1238 | +func_mod = function("mod", no, |
1239 | + yes([{"x", types.const("Int")}, |
1240 | {"y", types.const("Int")}]), |
1241 | types.const("Int"), |
1242 | varset.init, [], [], |
1243 | @@ -178,7 +185,7 @@ |
1244 | % Array % |
1245 | |
1246 | :- func func_array = function. |
1247 | -func_array = function("array", |
1248 | +func_array = function("array", no, |
1249 | yes([{"length", types.const("Int")}, |
1250 | {"default", types.variable(A)}]), |
1251 | types.app(types.const("Array"), |
1252 | @@ -189,7 +196,7 @@ |
1253 | varset.new_named_var(varset.init, "a", A, Varset). |
1254 | |
1255 | :- func func_array_ref = function. |
1256 | -func_array_ref = function("array_ref", |
1257 | +func_array_ref = function("array_ref", no, |
1258 | yes([{"array", types.app(types.const("Array"), |
1259 | [types.variable(A)])}, |
1260 | {"index", types.const("Int")}]), |
1261 | @@ -200,7 +207,7 @@ |
1262 | varset.new_named_var(varset.init, "a", A, Varset). |
1263 | |
1264 | :- func func_impure_array_set = function. |
1265 | -func_impure_array_set = function("__impure_array_set", |
1266 | +func_impure_array_set = function("__impure_array_set", no, |
1267 | yes([{"array", types.app(types.const("Array"), |
1268 | [types.variable(A)])}, |
1269 | {"index", types.const("Int")}, |
1270 | @@ -213,7 +220,7 @@ |
1271 | varset.new_named_var(varset.init, "a", A, Varset). |
1272 | |
1273 | :- func func_array_replace = function. |
1274 | -func_array_replace = function("array_replace", |
1275 | +func_array_replace = function("array_replace", no, |
1276 | yes([{"array", types.app(types.const("Array"), |
1277 | [types.variable(A)])}, |
1278 | {"index", types.const("Int")}, |
1279 | @@ -226,7 +233,7 @@ |
1280 | varset.new_named_var(varset.init, "a", A, Varset). |
1281 | |
1282 | :- func func_array_length = function. |
1283 | -func_array_length = function("array_length", |
1284 | +func_array_length = function("array_length", no, |
1285 | yes([{"array", types.app(types.const("Array"), |
1286 | [types.variable(A)])}]), |
1287 | types.const("Int"), |
1288 | @@ -236,7 +243,7 @@ |
1289 | varset.new_named_var(varset.init, "a", A, Varset). |
1290 | |
1291 | :- func func_impure_array_append = function. |
1292 | -func_impure_array_append = function("__impure_array_append", |
1293 | +func_impure_array_append = function("__impure_array_append", no, |
1294 | yes([{"array", types.app(types.const("Array"), |
1295 | [types.variable(A)])}, |
1296 | {"value", types.variable(A)}]), |
1297 | @@ -248,7 +255,7 @@ |
1298 | varset.new_named_var(varset.init, "a", A, Varset). |
1299 | |
1300 | :- func func_impure_array_extend = function. |
1301 | -func_impure_array_extend = function("__impure_array_extend", |
1302 | +func_impure_array_extend = function("__impure_array_extend", no, |
1303 | yes([{"array", types.app(types.const("Array"), |
1304 | [types.variable(A)])}, |
1305 | {"values", types.app( |
1306 | @@ -262,7 +269,7 @@ |
1307 | varset.new_named_var(varset.init, "a", A, Varset). |
1308 | |
1309 | :- func func_array_add = function. |
1310 | -func_array_add = function("array_add", |
1311 | +func_array_add = function("array_add", no, |
1312 | yes([{"array", types.app(types.const("Array"), |
1313 | [types.variable(A)])}, |
1314 | {"value", types.variable(A)}]), |
1315 | @@ -273,7 +280,7 @@ |
1316 | varset.new_named_var(varset.init, "a", A, Varset). |
1317 | |
1318 | :- func func_array_concat = function. |
1319 | -func_array_concat = function("array_concat", |
1320 | +func_array_concat = function("array_concat", no, |
1321 | yes([{"array1", types.app(types.const("Array"), |
1322 | [types.variable(A)])}, |
1323 | {"array2", types.app( |
1324 | @@ -286,7 +293,7 @@ |
1325 | varset.new_named_var(varset.init, "a", A, Varset). |
1326 | |
1327 | :- func func_impure_array_delete = function. |
1328 | -func_impure_array_delete = function("__impure_array_delete", |
1329 | +func_impure_array_delete = function("__impure_array_delete", no, |
1330 | yes([{"array", types.app(types.const("Array"), |
1331 | [types.variable(A)])}, |
1332 | {"index", types.const("Int")}]), |
1333 | @@ -298,7 +305,7 @@ |
1334 | varset.new_named_var(varset.init, "a", A, Varset). |
1335 | |
1336 | :- func func_array_remove = function. |
1337 | -func_array_remove = function("array_remove", |
1338 | +func_array_remove = function("array_remove", no, |
1339 | yes([{"array", types.app(types.const("Array"), |
1340 | [types.variable(A)])}, |
1341 | {"index", types.const("Int")}]), |
1342 | @@ -312,7 +319,7 @@ |
1343 | % IO % |
1344 | |
1345 | :- func func_put_char = function. |
1346 | -func_put_char = function("put_char", |
1347 | +func_put_char = function("put_char", no, |
1348 | yes([{"c", types.const("Int")}]), |
1349 | types.const("Int"), |
1350 | varset.init, [], [], |
1351 | @@ -320,7 +327,7 @@ |
1352 | ctx). |
1353 | |
1354 | :- func func_get_char = function. |
1355 | -func_get_char = function("get_char", |
1356 | +func_get_char = function("get_char", no, |
1357 | yes([]), |
1358 | types.const("Int"), |
1359 | varset.init, [], [], |
1360 | @@ -328,7 +335,7 @@ |
1361 | ctx). |
1362 | |
1363 | :- func func_get_env = function. |
1364 | -func_get_env = function("get_env", |
1365 | +func_get_env = function("get_env", no, |
1366 | yes([{"name", types.app(types.const("Array"), |
1367 | [types.const("Int")])}]), |
1368 | types.app(types.const("Array"), |
1369 | @@ -340,7 +347,8 @@ |
1370 | % Miscellaneous % |
1371 | |
1372 | :- func func_show = function. |
1373 | -func_show = function("show", yes([{"x", types.variable(A)}]), |
1374 | +func_show = function("show", no, |
1375 | + yes([{"x", types.variable(A)}]), |
1376 | types.app(types.const("Array"), |
1377 | [types.const("Int")]), |
1378 | Varset, [A], [A], |
1379 | @@ -349,7 +357,7 @@ |
1380 | varset.new_named_var(varset.init, "a", A, Varset). |
1381 | |
1382 | :- func func_error = function. |
1383 | -func_error = function("error", |
1384 | +func_error = function("error", no, |
1385 | yes([{"msg", types.app(types.const("Array"), |
1386 | [types.const("Int")])}]), |
1387 | types.variable(A), |
1388 | |
1389 | === modified file 'src/callgraph.m' |
1390 | --- src/callgraph.m 2011-04-19 08:42:16 +0000 |
1391 | +++ src/callgraph.m 2011-05-11 05:12:31 +0000 |
1392 | @@ -224,8 +224,8 @@ |
1393 | |
1394 | :- pred instr_callee(instr_::in, string::out) is semidet. |
1395 | instr_callee(ld_cgc(_, Callee), Callee). |
1396 | +instr_callee(new_closure(_, Callee, _), Callee). |
1397 | instr_callee(call_global(_, Callee, _), Callee). |
1398 | -instr_callee(parcall_global(_, Callee, _), Callee). |
1399 | |
1400 | % -------------------------------------------------------------------------- % |
1401 | % Strongly connected components / topological sorting |
1402 | |
1403 | === modified file 'src/executor.m' |
1404 | --- src/executor.m 2011-01-31 09:01:36 +0000 |
1405 | +++ src/executor.m 2011-05-11 05:12:31 +0000 |
1406 | @@ -65,6 +65,11 @@ |
1407 | pred is_thunk(progtable::in, E::in, string::in, bool::out, io::di, io::uo) |
1408 | is det, |
1409 | |
1410 | + % Insert a new function into the runtime environment. |
1411 | + % Behaviour is undefined if the function already exists. |
1412 | + pred add_function(progtable::in, function::in, E::in, E::out, |
1413 | + io::di, io::uo) is det, |
1414 | + |
1415 | % Executes an instruction, updating the executor environment as a result. |
1416 | % Also threads IO, because computations (in Mars) may modify state or have |
1417 | % other side-effects. |
1418 | @@ -132,6 +137,7 @@ |
1419 | var_string(univ_executor_value(Env), Varname, Str, !IO), |
1420 | var_int(E, Varname, Int, !IO) :- var_int(E, Varname, Int, !IO), |
1421 | is_thunk(PT, E, Varname, Bool, !IO) :- is_thunk(PT, E, Varname, Bool,!IO), |
1422 | + add_function(PT, F, !E, !IO) :- add_function(PT, F, !E, !IO), |
1423 | exec_instr(PT, LT, Instr, E0, univ_executor(E), !IO) :- |
1424 | exec_instr(PT, LT, Instr, univ_executor_value(E0), E, !IO) |
1425 | ]. |
1426 | |
1427 | === modified file 'src/interactive.m' |
1428 | --- src/interactive.m 2011-02-17 07:50:58 +0000 |
1429 | +++ src/interactive.m 2011-05-11 05:12:31 +0000 |
1430 | @@ -384,17 +384,30 @@ |
1431 | yes(types.app(types.const("Array"), |
1432 | [types.const("Int")]))), |
1433 | ast_cfg.expr_to_instrs(!.State^st_progtable, !.State^st_localvarset, |
1434 | - ShowExpr, VarName, Instrs0, Types_Raw, !.State^st_aststate, |
1435 | - NewASTState0), |
1436 | + ShowExpr, VarName, Instrs0, Types_Raw, SynthFuncs0, |
1437 | + !.State^st_aststate, NewASTState0), |
1438 | % Return the name of the temporary |
1439 | Result = yes(VarName) |
1440 | ; |
1441 | % Convert the statement into executable (low-level) instructions |
1442 | ast_cfg.basic_stmt_to_instrs(!.State^st_progtable, |
1443 | - !.State^st_localvarset, Stmt, Instrs0, Types_Raw, |
1444 | + !.State^st_localvarset, Stmt, Instrs0, Types_Raw, SynthFuncs0, |
1445 | !.State^st_aststate, NewASTState0), |
1446 | Result = no |
1447 | ), |
1448 | + % Load the SynthFuncs into the program tables and executor environment |
1449 | + list.filter((pred(F::in) is semidet :- |
1450 | + \+ tables.lookup_function(!.State^st_progtable, F^func_name, _) |
1451 | + ), SynthFuncs0, SynthFuncs), |
1452 | + list.foldl(tables.update_progtable_function, |
1453 | + ast_cfg.remove_dup_funcs(SynthFuncs), !.State^st_progtable, PT), |
1454 | + list.foldl(tables.update_progtable_function, |
1455 | + ast_cfg.remove_dup_funcs(SynthFuncs), !.State^st_progtable_aug,PTAug), |
1456 | + list.foldl2(executor.add_function(PT), SynthFuncs, |
1457 | + !.State^st_env, NewEnv1, !IO), |
1458 | + !State^st_progtable := PT, |
1459 | + !State^st_progtable_aug := PTAug, |
1460 | + !State^st_env := NewEnv1, |
1461 | % Dereference all the types |
1462 | map.map_values_only(types.deref(!.State^st_localvarset), Types_Raw,Types), |
1463 | % State^st_localtable has already been updated after typechecking. |
1464 | |
1465 | === modified file 'src/interpret.m' |
1466 | --- src/interpret.m 2011-04-20 03:34:02 +0000 |
1467 | +++ src/interpret.m 2011-05-11 05:12:31 +0000 |
1468 | @@ -78,6 +78,7 @@ |
1469 | pred(var_string/5) is interpret.var_string, |
1470 | pred(var_int/5) is interpret.var_int, |
1471 | pred(is_thunk/6) is interpret.is_thunk, |
1472 | + pred(add_function/6) is interpret.add_function, |
1473 | pred(exec_instr/7) is interpret.exec_instr |
1474 | ]. |
1475 | |
1476 | @@ -298,39 +299,37 @@ |
1477 | % Converts a function to its string representation for debugging purposes |
1478 | % (inside angle brackets, for the output of 'show'). |
1479 | :- func show_func(runtime_func) = string. |
1480 | -show_func(Func) = "<" ++ IsCurried ++ WhatIs ++ More ++ ">" :- |
1481 | +show_func(Func) = "<" ++ IsClosure ++ WhatIs ++ ">" :- |
1482 | Func = runtime_func(Args, IsThunk, FuncData), |
1483 | ( IsThunk = yes -> |
1484 | ( |
1485 | - FuncData = func_user(_, F), |
1486 | - WhatIs = "thunk " ++ F ^ func_name |
1487 | - ; |
1488 | - FuncData = func_ctor(Name, _), |
1489 | - WhatIs = "constructor thunk " ++ Name |
1490 | - ; |
1491 | - FuncData = func_builtin(Name, _), |
1492 | - WhatIs = "built-in thunk " ++ Name |
1493 | + FuncData = func_user(_, _), |
1494 | + WhatIs = "thunk" |
1495 | + ; |
1496 | + FuncData = func_ctor(_, _), |
1497 | + WhatIs = "constructor thunk" |
1498 | + ; |
1499 | + FuncData = func_builtin(_, _), |
1500 | + WhatIs = "built-in thunk" |
1501 | ) |
1502 | ; |
1503 | ( |
1504 | - FuncData = func_user(_, F), |
1505 | - WhatIs = "function " ++ F ^ func_name |
1506 | - ; |
1507 | - FuncData = func_ctor(Name, _), |
1508 | - WhatIs = "constructor function " ++ Name |
1509 | - ; |
1510 | - FuncData = func_builtin(Name, _), |
1511 | - WhatIs = "built-in function " ++ Name |
1512 | + FuncData = func_user(_, _), |
1513 | + WhatIs = "function" |
1514 | + ; |
1515 | + FuncData = func_ctor(_, _), |
1516 | + WhatIs = "constructor function" |
1517 | + ; |
1518 | + FuncData = func_builtin(_, _), |
1519 | + WhatIs = "built-in function" |
1520 | ) |
1521 | ), |
1522 | ( |
1523 | Args = [], |
1524 | - IsCurried = "", |
1525 | - More = "" |
1526 | + IsClosure = "" |
1527 | ; |
1528 | Args = [_|_], |
1529 | - IsCurried = "curried ", |
1530 | - More = "(...)" |
1531 | + IsClosure = "closure " |
1532 | ). |
1533 | |
1534 | % Get the value of a local string variable from the environment. |
1535 | @@ -465,6 +464,13 @@ |
1536 | local_search_det(!.Env, VarName, Value), |
1537 | vectorref.add(VectorRef, Value, !IO). |
1538 | |
1539 | +% Insert a new function into the runtime environment. |
1540 | +:- pred add_function(progtable::in, function::in, env::in, env::out, |
1541 | + io::di, io::uo) is det. |
1542 | +add_function(PT, Func, !Env, !IO) :- |
1543 | + func_globalmap(PT, Func^func_name, Func, !.Env^prog_globals, NewGlobals), |
1544 | + !Env^prog_globals := NewGlobals. |
1545 | + |
1546 | % Executes an instruction, updating the environment as a result. |
1547 | % Also threads IO, because computations (in Mars) may modify state or have |
1548 | % other side-effects. |
1549 | @@ -556,6 +562,13 @@ |
1550 | error("Interpreter Error: Field reference to something not an ADT") |
1551 | ), |
1552 | env_assign_local(Dst, Result, !Env). |
1553 | +exec_instr_(new_closure(Dst, Func, Args), _Ctx, !Env, !IO) :- |
1554 | + % Evaluate Func and Arg (eagerly) |
1555 | + global_search_det(!.Env, Func, FuncVal), |
1556 | + list.map(local_search_det(!.Env), Args, ArgVals), |
1557 | + % Curry Args in Func, but do not evaluate |
1558 | + partial_apply_vals(FuncVal, ArgVals, Result), |
1559 | + env_assign_local(Dst, Result, !Env). |
1560 | exec_instr_(call(Dst, Func, Args), _Ctx, !Env, !IO) :- |
1561 | % Evaluate Func and Arg (eagerly) |
1562 | local_search_det(!.Env, Func, FuncVal), |
1563 | @@ -563,13 +576,6 @@ |
1564 | % Apply Arg to Func |
1565 | apply_vals(FuncVal, ArgVals, Result, !Env, !IO), |
1566 | env_assign_local(Dst, Result, !Env). |
1567 | -exec_instr_(parcall(Dst, Func, Args), _Ctx, !Env, !IO) :- |
1568 | - % Evaluate Func and Arg (eagerly) |
1569 | - local_search_det(!.Env, Func, FuncVal), |
1570 | - list.map(local_search_det(!.Env), Args, ArgVals), |
1571 | - % Curry Args in Func, but do not evaluate |
1572 | - partial_apply_vals(FuncVal, ArgVals, Result), |
1573 | - env_assign_local(Dst, Result, !Env). |
1574 | exec_instr_(call_ctor(Dst, Ctor, Args), _Ctx, !Env, !IO) :- |
1575 | % Evaluate Ctor and Arg (eagerly) |
1576 | read_ctor(Ctor, CtorVal, !Env, !IO), |
1577 | @@ -577,13 +583,6 @@ |
1578 | % Apply Arg to Ctor |
1579 | apply_vals(CtorVal, ArgVals, Result, !Env, !IO), |
1580 | env_assign_local(Dst, Result, !Env). |
1581 | -exec_instr_(parcall_ctor(Dst, Ctor, Args), _Ctx, !Env, !IO) :- |
1582 | - % Evaluate Ctor and Arg (eagerly) |
1583 | - read_ctor(Ctor, CtorVal, !Env, !IO), |
1584 | - list.map(local_search_det(!.Env), Args, ArgVals), |
1585 | - % Curry Args in Ctor, but do not evaluate |
1586 | - partial_apply_vals(CtorVal, ArgVals, Result), |
1587 | - env_assign_local(Dst, Result, !Env). |
1588 | exec_instr_(call_global(Dst, Func, Args), _Ctx, !Env, !IO) :- |
1589 | % Evaluate Func and Arg (eagerly) |
1590 | global_search_det(!.Env, Func, FuncVal), |
1591 | @@ -591,13 +590,6 @@ |
1592 | % Apply Arg to Func |
1593 | apply_vals(FuncVal, ArgVals, Result, !Env, !IO), |
1594 | env_assign_local(Dst, Result, !Env). |
1595 | -exec_instr_(parcall_global(Dst, Func, Args), _Ctx, !Env, !IO) :- |
1596 | - % Evaluate Func and Arg (eagerly) |
1597 | - global_search_det(!.Env, Func, FuncVal), |
1598 | - list.map(local_search_det(!.Env), Args, ArgVals), |
1599 | - % Curry Args in Func, but do not evaluate |
1600 | - partial_apply_vals(FuncVal, ArgVals, Result), |
1601 | - env_assign_local(Dst, Result, !Env). |
1602 | |
1603 | % field_check_ctor(Ctor, ObjCtor) checks whether two constructor names |
1604 | % (presumably one from an instruction and one from an object) match. |
1605 | @@ -643,14 +635,19 @@ |
1606 | Body = Func ^ func_body, |
1607 | ( Body = func_body_cfg(_Decls, CFG) -> |
1608 | % Create a new local varmap, with the arguments |
1609 | + CVars = Func ^ func_cvars, |
1610 | + ( |
1611 | + CVars = no, YesCVars = [] |
1612 | + ; |
1613 | + CVars = yes(YesCVars) |
1614 | + ), |
1615 | Params = Func ^ func_params, |
1616 | ( |
1617 | - Params = no, |
1618 | - InitVarMap = varmap_init |
1619 | + Params = no, YesParams = [] |
1620 | ; |
1621 | - Params = yes(YesParams), |
1622 | - bind_args(YesParams, Args, varmap_init, InitVarMap) |
1623 | + Params = yes(YesParams) |
1624 | ), |
1625 | + bind_args(YesCVars ++ YesParams, Args, varmap_init, InitVarMap), |
1626 | % Backup locals and initialise a new local table |
1627 | LocalsBackup = !.Env ^ prog_locals, |
1628 | !Env ^ prog_locals := InitVarMap, |
1629 | |
1630 | === modified file 'src/ir.m' |
1631 | --- src/ir.m 2011-04-20 03:34:02 +0000 |
1632 | +++ src/ir.m 2011-05-11 05:12:31 +0000 |
1633 | @@ -217,22 +217,17 @@ |
1634 | % (R, S, C, I) <=> R := S.I |
1635 | % Undefined behaviour S was not built by constructor C. |
1636 | ; ld_field(varname, varname, string, int) |
1637 | + % Create closure from closure template. (Result, Function, Args). |
1638 | + % Function must be a global closure template (not a ctor or CGC). |
1639 | + ; new_closure(varname, string, list(varname)) |
1640 | % Local function call. (Result, Function, Args). |
1641 | ; call(varname, varname, list(varname)) |
1642 | - % Partial local function application. (Result, Function, Args). |
1643 | - ; parcall(varname, varname, list(varname)) |
1644 | % Constructor function call. (Result, Ctor, Args). |
1645 | % Ctor is the name of a constructor. |
1646 | ; call_ctor(varname, string, list(varname)) |
1647 | - % Partial constructor function application. (Result, Ctor, Args). |
1648 | - % Ctor is the name of a constructor. |
1649 | - ; parcall_ctor(varname, string, list(varname)) |
1650 | % Global function call. (Result, Function, Args). |
1651 | % Function must be a global function (not a ctor or CGC). |
1652 | - ; call_global(varname, string, list(varname)) |
1653 | - % Partial global function application. (Result, Function, Args). |
1654 | - % Function must be a global function (not a ctor or CGC). |
1655 | - ; parcall_global(varname, string, list(varname)). |
1656 | + ; call_global(varname, string, list(varname)). |
1657 | |
1658 | % terminator_instr: An instruction which may only appear at the end of a basic |
1659 | % block in the CFG representation. These roughly are the equivalents of the |
1660 | @@ -297,10 +292,13 @@ |
1661 | % Integer literal. Matches exactly this value. |
1662 | ; case_intlit(integer). |
1663 | |
1664 | -% Top-level definition of a function or computable global constant (CGC). |
1665 | +% Top-level definition of a function, computable global constant (CGC) or |
1666 | +% closure template (CT). |
1667 | :- type function |
1668 | ---> function( |
1669 | func_name :: string, |
1670 | + % The closure variables; 'no' unless this is a CT. |
1671 | + func_cvars :: maybe(list({string, typeval})), |
1672 | % The function parameters, or 'no' for a CGC. |
1673 | % Note: yes([]) is a 0-argument function, while no is a CGC. |
1674 | func_params :: maybe(list({string, typeval})), |
1675 | @@ -427,6 +425,12 @@ |
1676 | % names are used - but then, the Python backend does that anyway). |
1677 | :- func varname_to_string_dodgy(varname) = string. |
1678 | |
1679 | +% global_is_ct(PT, Varname) succeeds if Varname names a global variable which |
1680 | +% is a closure template (function with closure variables). Fails if it is |
1681 | +% a regular function or a CGC. |
1682 | +% Aborts if Varname does not name a global variable at all. |
1683 | +:- pred global_is_ct(tables.progtable::in, string::in) is semidet. |
1684 | + |
1685 | % global_is_cgc(PT, Varname) succeeds if Varname names a global variable which |
1686 | % is a computable global constant (function without arguments). Fails if it is |
1687 | % a regular function. |
1688 | @@ -624,6 +628,13 @@ |
1689 | varname_to_string_dodgy(qvname(BaseName, Qual)) = |
1690 | varname_to_string_dodgy(BaseName) ++ "_" ++ string.from_int(Qual). |
1691 | |
1692 | +global_is_ct(PT, Varname) :- |
1693 | + ( tables.lookup_function(PT, Varname, Func) -> |
1694 | + Func ^ func_cvars = yes(_) % Can fail |
1695 | + ; |
1696 | + error(string.format("ir.global_is_ct: %s not a global",[s(Varname)])) |
1697 | + ). |
1698 | + |
1699 | global_is_cgc(PT, Varname) :- |
1700 | ( tables.lookup_function(PT, Varname, Func) -> |
1701 | Func ^ func_params = no % Can fail |
1702 | |
1703 | === modified file 'src/parsem.m' |
1704 | --- src/parsem.m 2011-02-16 06:00:19 +0000 |
1705 | +++ src/parsem.m 2011-05-11 05:12:31 +0000 |
1706 | @@ -398,7 +398,8 @@ |
1707 | % Consumes a single function. |
1708 | :- pred function(function::out, tokenparser::in, tokenparser::out) is semidet. |
1709 | function( |
1710 | - function(FuncName, Params, RetType, Varset, [],Rigids, Body, Context)) --> |
1711 | + function(FuncName, no, Params, RetType, Varset, [], Rigids, Body, |
1712 | + Context)) --> |
1713 | some [!Varset, !VarNames] ( |
1714 | {varset.init(!:Varset)}, |
1715 | {map.init(!:VarNames)}, |
1716 | |
1717 | === modified file 'src/pretty.m' |
1718 | --- src/pretty.m 2011-05-11 04:08:48 +0000 |
1719 | +++ src/pretty.m 2011-05-11 05:12:31 +0000 |
1720 | @@ -412,6 +412,13 @@ |
1721 | indent(Indent, !IO), |
1722 | io.format("%s = %s", [s(ir.varname_to_string_noescape(Dst)), |
1723 | s(fieldref_str(Obj, Ctor, Idx))], !IO). |
1724 | +print_instr_(Indent, new_closure(Dst, Func, Args), !IO) :- |
1725 | + indent(Indent, !IO), |
1726 | + io.write_string(ir.varname_to_string_noescape(Dst), !IO), |
1727 | + io.write_string(" = @", !IO), |
1728 | + ArgsStr = string.join_list(", ", |
1729 | + list.map(ir.varname_to_string_noescape, Args)), |
1730 | + io.write_string(Func ++ "{" ++ ArgsStr ++ "}", !IO). |
1731 | print_instr_(Indent, call(Dst, Func, Args), !IO) :- |
1732 | indent(Indent, !IO), |
1733 | io.write_string(ir.varname_to_string_noescape(Dst), !IO), |
1734 | @@ -420,14 +427,6 @@ |
1735 | list.map(ir.varname_to_string_noescape, Args)), |
1736 | io.write_string( |
1737 | ir.varname_to_string_noescape(Func) ++ "(" ++ ArgsStr ++ ")", !IO). |
1738 | -print_instr_(Indent, parcall(Dst, Func, Args), !IO) :- |
1739 | - indent(Indent, !IO), |
1740 | - io.write_string(ir.varname_to_string_noescape(Dst), !IO), |
1741 | - io.write_string(" = ", !IO), |
1742 | - ArgsStr = string.join_list(", ", |
1743 | - list.map(ir.varname_to_string_noescape, Args) ++ ["..."]), |
1744 | - io.write_string( |
1745 | - ir.varname_to_string_noescape(Func) ++ "(" ++ ArgsStr ++ ")", !IO). |
1746 | print_instr_(Indent, call_ctor(Dst, Ctor, Args), !IO) :- |
1747 | indent(Indent, !IO), |
1748 | io.write_string(ir.varname_to_string_noescape(Dst), !IO), |
1749 | @@ -435,13 +434,6 @@ |
1750 | ArgsStr = string.join_list(", ", |
1751 | list.map(ir.varname_to_string_noescape, Args)), |
1752 | io.write_string(Ctor ++ "(" ++ ArgsStr ++ ")", !IO). |
1753 | -print_instr_(Indent, parcall_ctor(Dst, Ctor, Args), !IO) :- |
1754 | - indent(Indent, !IO), |
1755 | - io.write_string(ir.varname_to_string_noescape(Dst), !IO), |
1756 | - io.write_string(" = ", !IO), |
1757 | - ArgsStr = string.join_list(", ", |
1758 | - list.map(ir.varname_to_string_noescape, Args) ++ ["..."]), |
1759 | - io.write_string(Ctor ++ "(" ++ ArgsStr ++ ")", !IO). |
1760 | print_instr_(Indent, call_global(Dst, Func, Args), !IO) :- |
1761 | indent(Indent, !IO), |
1762 | io.write_string(ir.varname_to_string_noescape(Dst), !IO), |
1763 | @@ -449,13 +441,6 @@ |
1764 | ArgsStr = string.join_list(", ", |
1765 | list.map(ir.varname_to_string_noescape, Args)), |
1766 | io.write_string(Func ++ "(" ++ ArgsStr ++ ")", !IO). |
1767 | -print_instr_(Indent, parcall_global(Dst, Func, Args), !IO) :- |
1768 | - indent(Indent, !IO), |
1769 | - io.write_string(ir.varname_to_string_noescape(Dst), !IO), |
1770 | - io.write_string(" = @", !IO), |
1771 | - ArgsStr = string.join_list(", ", |
1772 | - list.map(ir.varname_to_string_noescape, Args) ++ ["..."]), |
1773 | - io.write_string(Func ++ "(" ++ ArgsStr ++ ")", !IO). |
1774 | |
1775 | :- func fieldref_str(varname, string, int) = string. |
1776 | fieldref_str(Obj, Ctor, Idx) = string.format("%s.[%s: %d]", |
1777 | @@ -542,6 +527,16 @@ |
1778 | print_function_head(Func, !IO) :- |
1779 | io.write_string(Func^func_name, !IO), |
1780 | ( |
1781 | + Func^func_cvars = no |
1782 | + ; |
1783 | + Func^func_cvars = yes(CVars), |
1784 | + io.write_string("{", !IO), |
1785 | + io.write_string(string.join_list(", ", |
1786 | + list.map(string_param(Func^func_varset), CVars)), |
1787 | + !IO), |
1788 | + io.write_string("}", !IO) |
1789 | + ), |
1790 | + ( |
1791 | Func^func_params = no |
1792 | ; |
1793 | Func^func_params = yes(Params), |
1794 | |
1795 | === modified file 'src/tables.m' |
1796 | --- src/tables.m 2011-02-14 12:48:18 +0000 |
1797 | +++ src/tables.m 2011-05-11 05:12:31 +0000 |
1798 | @@ -338,6 +338,13 @@ |
1799 | |
1800 | build_localtable(Func, !Table) :- |
1801 | ( |
1802 | + Func^func_cvars = no |
1803 | + ; |
1804 | + Func^func_cvars = yes(CVars), |
1805 | + list.foldl(add_to_localtable_string(Func, "closure-var"), CVars, |
1806 | + !Table) |
1807 | + ), |
1808 | + ( |
1809 | Func^func_params = no |
1810 | ; |
1811 | Func^func_params = yes(Params), |
1812 | |
1813 | === modified file 'src/typecheck.m' |
1814 | --- src/typecheck.m 2011-01-19 07:44:29 +0000 |
1815 | +++ src/typecheck.m 2011-05-11 05:12:31 +0000 |
1816 | @@ -227,6 +227,12 @@ |
1817 | VarName = svname(UnqualVarName), |
1818 | tables.lookup_function(PT, UnqualVarName, Func) |
1819 | -> |
1820 | + ( ir.global_is_ct(PT, UnqualVarName) -> |
1821 | + context.throw_error("Reference to closure template: " |
1822 | + ++ UnqualVarName, Ctx) |
1823 | + ; |
1824 | + true |
1825 | + ), |
1826 | % Found in global function table - get its type and varset |
1827 | function_type(Func, FuncVarset, Type0), |
1828 | % Augment our own varset with this function's varset and |
1829 | @@ -238,6 +244,12 @@ |
1830 | ). |
1831 | expr_type_(Ctx, PT, _LT, !Varset, _Rigids, E@globalref(VarName), E, Type) :- |
1832 | ( tables.lookup_function(PT, VarName, Func) -> |
1833 | + ( ir.global_is_ct(PT, VarName) -> |
1834 | + context.throw_error("Reference to closure template: " ++ VarName, |
1835 | + Ctx) |
1836 | + ; |
1837 | + true |
1838 | + ), |
1839 | % Found in global function table - get its type and varset |
1840 | function_type(Func, FuncVarset, Type0), |
1841 | % Augment our own varset with this function's varset and |
1842 | @@ -713,6 +725,13 @@ |
1843 | Ctx = !.Func^func_context, |
1844 | % Type/kind check the params and ret type - must all be of kind * |
1845 | ( |
1846 | + !.Func^func_cvars = no |
1847 | + ; |
1848 | + !.Func^func_cvars = yes(CVars), |
1849 | + check_types_star(Ctx, PT, !.Func^func_varset, |
1850 | + list.map(func({_,B})=B, CVars)) |
1851 | + ), |
1852 | + ( |
1853 | !.Func^func_params = no |
1854 | ; |
1855 | !.Func^func_params = yes(Params), |
1856 | @@ -795,13 +814,20 @@ |
1857 | !.Func^func_body = func_body_ast(Decls0, Stmts), |
1858 | Varset0 = !.Func^func_varset, |
1859 | ( |
1860 | + !.Func^func_cvars = no, |
1861 | + CVars = [] |
1862 | + ; |
1863 | + !.Func^func_cvars = yes(FuncCVars), |
1864 | + CVars = map(func({N,_}) = svname(N), FuncCVars) |
1865 | + ), |
1866 | + ( |
1867 | !.Func^func_params = no, |
1868 | Params = [] |
1869 | ; |
1870 | !.Func^func_params = yes(FuncParams), |
1871 | Params = map(func({N,_}) = svname(N), FuncParams) |
1872 | ), |
1873 | - DeclsSet = set(assoc_list.keys(Decls0) ++ Params), |
1874 | + DeclsSet = set(assoc_list.keys(Decls0) ++ CVars ++ Params), |
1875 | % Get the set of all variables bound in the function's body |
1876 | BoundVars0 = remove_dups(boundvars_stmts(Stmts)), |
1877 | % ... which are not already explicitly declared |
1878 | |
1879 | === modified file 'src/typedict.m' |
1880 | --- src/typedict.m 2011-04-19 08:42:16 +0000 |
1881 | +++ src/typedict.m 2011-05-11 05:12:31 +0000 |
1882 | @@ -163,12 +163,42 @@ |
1883 | Arities = set(ArityList) |
1884 | ). |
1885 | |
1886 | -:- func to_cfg(progtable, function) = function. |
1887 | -to_cfg(PT, FuncAST) = FuncCFG :- |
1888 | +% Updates PTAug, adding any new synthetic functions. |
1889 | +:- pred to_cfg(progtable::in, function::in, function::out, |
1890 | + progtable::in, progtable::out, list(function)::in, list(function)::out) |
1891 | + is det. |
1892 | +to_cfg(PT, FuncAST, FuncCFG, !PTAug, !SynthFuncs) :- |
1893 | + to_cfg(PT, _, FuncAST, FuncCFG, !PTAug, !SynthFuncs). |
1894 | +% Also updates PT; this can be ignored long-term, but augment_cfg() requires |
1895 | +% the PT to have the synthfuncs. |
1896 | +:- pred to_cfg(progtable::in, progtable::out, function::in, function::out, |
1897 | + progtable::in, progtable::out, list(function)::in, list(function)::out) |
1898 | + is det. |
1899 | +to_cfg(!PT, FuncAST, FuncCFG, !PTAug, !SynthFuncs) :- |
1900 | + typecheck.add_implicit_decls(FuncAST, FuncAST_Decls), |
1901 | + tables.build_localtable(FuncAST_Decls, LT), |
1902 | + typecheck.check_function(!.PT, LT, FuncAST_Decls, FuncAST_Checked), |
1903 | + ast_cfg.func_to_cfg(!.PT, FuncAST_Checked, FuncCFG, SynthFuncs), |
1904 | + list.foldl(update_progtable_function, SynthFuncs, !PT), |
1905 | + list.foldl(update_progtable_function, SynthFuncs, !PTAug), |
1906 | + !:SynthFuncs = SynthFuncs ++ !.SynthFuncs. |
1907 | + |
1908 | +% Same as to_cfg, but augment function and all synth funcs |
1909 | +% Updates PTAug, adding any new synthetic functions. |
1910 | +:- pred augment_cfg(progtable::in, function::in, function::out, |
1911 | + progtable::in, progtable::out, list(function)::in, list(function)::out) |
1912 | + is det. |
1913 | +augment_cfg(PT, FuncAST, FuncCFGAug, !PTAug, !SynthFuncs) :- |
1914 | typecheck.add_implicit_decls(FuncAST, FuncAST_Decls), |
1915 | tables.build_localtable(FuncAST_Decls, LT), |
1916 | typecheck.check_function(PT, LT, FuncAST_Decls, FuncAST_Checked), |
1917 | - ast_cfg.func_to_cfg(PT, FuncAST_Checked, FuncCFG). |
1918 | + ast_cfg.func_to_cfg(PT, FuncAST_Checked, FuncCFG, SynthFuncs0), |
1919 | + % Augment the new synthetic functions |
1920 | + SynthFuncs1 = list.map(augment(PT, !.PTAug), SynthFuncs0), |
1921 | + list.foldl(update_progtable_function, SynthFuncs0, PT, PTWithSynth), |
1922 | + list.foldl(update_progtable_function, SynthFuncs1, !PTAug), |
1923 | + !:SynthFuncs = SynthFuncs1 ++ !.SynthFuncs, |
1924 | + FuncCFGAug = augment(PTWithSynth, !.PTAug, FuncCFG). |
1925 | |
1926 | :- func augment(progtable, progtable, function) = function. |
1927 | augment(PT, PTAug, Func0) = Func :- |
1928 | @@ -179,10 +209,6 @@ |
1929 | % Should never happen: |
1930 | require(set.empty(ReqVars), "augment: Rigid missing from TDVars"). |
1931 | |
1932 | -% augment_cfg: Apply AST->CFG then augment. |
1933 | -:- func augment_cfg(progtable, progtable, function) = function. |
1934 | -augment_cfg(PT, PTAug, Func) = augment(PT, PTAug, to_cfg(PT, Func)). |
1935 | - |
1936 | % Generate the standard boilerplate code for type-dictionary-augmented |
1937 | % programs. Return it as a list of new program nodes. |
1938 | % The argument is the set of all function arities in the program (each of |
1939 | @@ -240,29 +266,32 @@ |
1940 | error("generate_boilerplate: :Dict not in progtable") |
1941 | ), |
1942 | % CFGise, augment and re-add user-defined functions, CGCs and dicts |
1943 | - some [!PTAug] ( |
1944 | + some [!PTAug, !SynthFuncs] ( |
1945 | !:PTAug = !.PT, |
1946 | + !:SynthFuncs = [], |
1947 | foldl(update_progtable_function, FieldFuncs, !PTAug), |
1948 | - DictInt = augment_cfg(!.PT, !.PTAug, dict_int), |
1949 | + augment_cfg(!.PT, dict_int, DictInt, !PTAug, !SynthFuncs), |
1950 | update_progtable_function(DictInt, !PTAug), |
1951 | - ShowArray = augment_cfg(!.PT, !.PTAug, show_array), |
1952 | + augment_cfg(!.PT, show_array, ShowArray, !PTAug, !SynthFuncs), |
1953 | update_progtable_function(ShowArray, !PTAug), |
1954 | - EqArray = augment_cfg(!.PT, !.PTAug, eq_array), |
1955 | + augment_cfg(!.PT, eq_array, EqArray, !PTAug, !SynthFuncs), |
1956 | update_progtable_function(EqArray, !PTAug), |
1957 | - DictArray = augment_cfg(!.PT, !.PTAug, dict_array), |
1958 | + augment_cfg(!.PT, dict_array, DictArray, !PTAug, !SynthFuncs), |
1959 | update_progtable_function(DictArray, !PTAug), |
1960 | - EqFunc = to_cfg(!.PT, eq_func), |
1961 | + to_cfg(!.PT, eq_func, EqFunc, !PTAug, !SynthFuncs), |
1962 | update_progtable_function(EqFunc, !PTAug), |
1963 | PT_DF = !.PT, |
1964 | - DictFuncsA = list.map(to_cfg(PT_DF), DictFuncs), |
1965 | + list.map_foldl2(to_cfg(PT_DF), DictFuncs, DictFuncsA, !PTAug, |
1966 | + !SynthFuncs), |
1967 | list.foldl(update_progtable_function, DictFuncsA, !PTAug), |
1968 | - ShowFree = to_cfg(!.PT, show_free), |
1969 | + to_cfg(!.PT, show_free, ShowFree, !PTAug, !SynthFuncs), |
1970 | update_progtable_function(ShowFree, !PTAug), |
1971 | - EqFree = to_cfg(!.PT, eq_free), |
1972 | + to_cfg(!.PT, eq_free, EqFree, !PTAug, !SynthFuncs), |
1973 | update_progtable_function(EqFree, !PTAug), |
1974 | - DictFree = to_cfg(!.PT, dict_free), |
1975 | + to_cfg(!.PT, dict_free, DictFree, !PTAug, !SynthFuncs), |
1976 | update_progtable_function(DictFree, !PTAug), |
1977 | - PTAug = !.PTAug |
1978 | + PTAug = !.PTAug, |
1979 | + SynthFuncs = list.reverse(!.SynthFuncs) |
1980 | ), |
1981 | |
1982 | % Now store the user-defined types and functions in the program |
1983 | @@ -280,7 +309,8 @@ |
1984 | pfunction(ShowFree), |
1985 | pfunction(EqFree), |
1986 | pfunction(DictFree) |
1987 | - ]. |
1988 | + % Add the synthetic functions to the program |
1989 | + ] ++ list.map(func(F) = pfunction(F), SynthFuncs). |
1990 | |
1991 | :- func ctx = context.context. |
1992 | ctx = context("typedict", 1, 1, stack.init). |
1993 | @@ -289,7 +319,7 @@ |
1994 | |
1995 | % def builtin show_int :: Int -> Array(Int) |
1996 | :- func show_int = function. |
1997 | -show_int = function("show:Int", |
1998 | +show_int = function("show:Int", no, |
1999 | yes([{"x", types.const("Int")}]), |
2000 | types.app(types.const("Array"), |
2001 | [types.const("Int")]), |
2002 | @@ -299,7 +329,7 @@ |
2003 | |
2004 | % def builtin eq_int :: (Int, Int) -> Int |
2005 | :- func eq_int = function. |
2006 | -eq_int = function("eq:Int", |
2007 | +eq_int = function("eq:Int", no, |
2008 | yes([{"x", types.const("Int")}, |
2009 | {"y", types.const("Int")}]), |
2010 | types.const("Int"), |
2011 | @@ -309,7 +339,7 @@ |
2012 | |
2013 | % def builtin show_func :: (a) -> Array(Int) |
2014 | :- func show_func = function. |
2015 | -show_func = function("show:func", |
2016 | +show_func = function("show:func", no, |
2017 | yes([{"x", types.variable(A)}]), |
2018 | types.app(types.const("Array"), |
2019 | [types.const("Int")]), |
2020 | @@ -357,7 +387,7 @@ |
2021 | |
2022 | % def dict:Int :: :Dict(Int) = :Dict(show:Int, eq:Int) |
2023 | :- func dict_int = function. |
2024 | -dict_int = function("dict:Int", |
2025 | +dict_int = function("dict:Int", no, |
2026 | no, |
2027 | types.app(types.const(":Dict"), |
2028 | [types.const("Int")]), |
2029 | @@ -385,7 +415,7 @@ |
2030 | % res = array_concat(res, "]") |
2031 | % return res |
2032 | :- func show_array = function. |
2033 | -show_array = function("show:Array", |
2034 | +show_array = function("show:Array", no, |
2035 | yes([{"x", types.app(types.const("Array"), |
2036 | [types.variable(A)])}]), |
2037 | types.app(types.const("Array"), |
2038 | @@ -469,7 +499,7 @@ |
2039 | % i = add(i, 1) |
2040 | % return 1 |
2041 | :- func eq_array = function. |
2042 | -eq_array = function("eq:Array", |
2043 | +eq_array = function("eq:Array", no, |
2044 | yes([{"x", types.app(types.const("Array"), |
2045 | [types.variable(A)])}, |
2046 | {"y", types.app(types.const("Array"), |
2047 | @@ -529,7 +559,7 @@ |
2048 | % def dict:Array :: :Dict(Array(a)): |
2049 | % return :Dict(show_Array, eq_Array) |
2050 | :- func dict_array = function. |
2051 | -dict_array = function("dict:Array", |
2052 | +dict_array = function("dict:Array", no, |
2053 | no, |
2054 | types.app(types.const(":Dict"), |
2055 | [types.app(types.const("Array"), |
2056 | @@ -548,7 +578,7 @@ |
2057 | % def eq:func(x :: a, y :: a) :: Int: |
2058 | % return error("Functions cannot be compared for equality") |
2059 | :- func eq_func = function. |
2060 | -eq_func = function("eq:func", |
2061 | +eq_func = function("eq:func", no, |
2062 | yes([{"x", types.variable(A)}, |
2063 | {"y", types.variable(A)}]), |
2064 | types.const("Int"), |
2065 | @@ -568,7 +598,7 @@ |
2066 | % :: :Dict((a, ..., y) -> z): |
2067 | % return :Dict(show:func, eq:func) |
2068 | :- func dict_func(int) = function. |
2069 | -dict_func(Arity) = function("dict:func:" ++ string(Arity), |
2070 | +dict_func(Arity) = function("dict:func:" ++ string(Arity), no, |
2071 | yes(list.map_corresponding( |
2072 | func(N, V) = {"dict:t_" ++ string(N), |
2073 | types.app(types.const(":Dict"), [types.variable(V)])}, |
2074 | @@ -594,7 +624,7 @@ |
2075 | % def show:free(x :: a) :: Array(Int): |
2076 | % return error("eq:free") |
2077 | :- func show_free = function. |
2078 | -show_free = function("show:free", |
2079 | +show_free = function("show:free", no, |
2080 | yes([{"x", types.variable(A)}]), |
2081 | types.app(types.const("Array"), [types.const("Int")]), |
2082 | Varset, [], [A], |
2083 | @@ -610,7 +640,7 @@ |
2084 | % def eq:free(x :: a, y :: a) :: Int: |
2085 | % return error("eq:free") |
2086 | :- func eq_free = function. |
2087 | -eq_free = function("eq:free", |
2088 | +eq_free = function("eq:free", no, |
2089 | yes([{"x", types.variable(A)}, |
2090 | {"y", types.variable(A)}]), |
2091 | types.const("Int"), |
2092 | @@ -627,7 +657,7 @@ |
2093 | % def dict:free :: :Dict(a): |
2094 | % return :Dict(show:free, eq:free) |
2095 | :- func dict_free = function. |
2096 | -dict_free = function("dict:free", |
2097 | +dict_free = function("dict:free", no, |
2098 | no, |
2099 | types.app(types.const(":Dict"), |
2100 | [types.variable(A)]), |
2101 | @@ -693,10 +723,17 @@ |
2102 | ), |
2103 | % Now generate the augmented versions. We do not insert them into |
2104 | % the PT (since we are generating an unaugmented PT). |
2105 | - ShowA = augment_cfg(PT, PTAug, Show), |
2106 | - EqA = augment_cfg(PT, PTAug, Eq), |
2107 | - DictA = augment_cfg(PT, PTAug, Dict), |
2108 | - ShowEqDict = [pfunction(ShowA), pfunction(EqA), pfunction(DictA)]. |
2109 | + some [!SynthFuncs, !PTAug] ( |
2110 | + !:SynthFuncs = [], |
2111 | + !:PTAug = PTAug, |
2112 | + augment_cfg(PT, Show, ShowA, !PTAug, !SynthFuncs), |
2113 | + augment_cfg(PT, Eq, EqA, !PTAug, !SynthFuncs), |
2114 | + augment_cfg(PT, Dict, DictA, !PTAug, !SynthFuncs), |
2115 | + _ = !.PTAug, % Not needed |
2116 | + SynthFuncNodes = map(func(F) = pfunction(F), !.SynthFuncs) |
2117 | + ), |
2118 | + ShowEqDict = [pfunction(ShowA), pfunction(EqA), pfunction(DictA)] |
2119 | + ++ SynthFuncNodes. |
2120 | |
2121 | % Field names as used in our patterns in user-defined type functions |
2122 | % String is an optional prefix (use "" for nothing). |
2123 | @@ -737,7 +774,7 @@ |
2124 | % case CtorN(f_CtorN_0, f_CtorN_1, ..., f_CtorN_n): |
2125 | % ... |
2126 | :- func generate_user_show(typedef) = function. |
2127 | -generate_user_show(Typedef) = function("show:" ++ Typedef^typedef_name, |
2128 | +generate_user_show(Typedef) = function("show:" ++ Typedef^typedef_name, no, |
2129 | yes([{"x", ObjType}]), |
2130 | types.app(types.const("Array"), |
2131 | [types.const("Int")]), |
2132 | @@ -822,7 +859,7 @@ |
2133 | % ... |
2134 | % return 1 |
2135 | :- func generate_user_eq(typedef) = function. |
2136 | -generate_user_eq(Typedef) = function("eq:" ++ Typedef^typedef_name, |
2137 | +generate_user_eq(Typedef) = function("eq:" ++ Typedef^typedef_name, no, |
2138 | yes([{"x", ObjType}, {"y", ObjType}]), |
2139 | types.const("Int"), |
2140 | Varset, [], varset.vars(Varset), |
2141 | @@ -869,7 +906,7 @@ |
2142 | ). |
2143 | |
2144 | :- func generate_user_dict(typedef) = function. |
2145 | -generate_user_dict(Typedef) = function("dict:" ++ Typedef^typedef_name, |
2146 | +generate_user_dict(Typedef) = function("dict:" ++ Typedef^typedef_name, no, |
2147 | no, |
2148 | types.app(types.const(":Dict"), [ObjType]), |
2149 | Varset, [], varset.vars(Varset), |
2150 | @@ -1003,7 +1040,16 @@ |
2151 | Name = "dict:" ++ varset.lookup_name(Varset, Var, "t_"), |
2152 | Type = types.app(types.const(":Dict"), [types.variable(Var)]) |
2153 | ), TypeVars), |
2154 | - !Func^func_params := yes(TDArgs ++ Params), |
2155 | + ( |
2156 | + !.Func^func_cvars = yes(CVars), |
2157 | + % Closure template. Prepend TDArgs to closure variables. |
2158 | + !Func^func_cvars := yes(TDArgs ++ CVars) |
2159 | + ; |
2160 | + !.Func^func_cvars = no, |
2161 | + % Not a closure template (CGC or function). |
2162 | + % Prepend TDArgs to regular parameters. |
2163 | + !Func^func_params := yes(TDArgs ++ Params) |
2164 | + ), |
2165 | % Update the local table. Importantly, we need to insert these |
2166 | % variables starting from index 1 in the LT (the first argument). |
2167 | ( !.Func^func_body = func_body_cfg(LT0, Body) -> |
2168 | @@ -1083,7 +1129,7 @@ |
2169 | ( Instr0 = ld_cgc(Dst, Name) -> |
2170 | ( tables.lookup_local(!.LT, Dst, DstType) -> |
2171 | augment_globalref(PT, PTAug, Varset, Rigids, TDVars, Name, |
2172 | - DstType, TDExprs, !RequiredVars) |
2173 | + DstType, [], TDExprs, !RequiredVars) |
2174 | ; |
2175 | error("augment_instr_globalrefs: Not in LT: " ++ |
2176 | ir.varname_to_string_noescape(Dst)) |
2177 | @@ -1098,6 +1144,30 @@ |
2178 | TDArgs, PreInstrs, !LT, !BlockTempCount), |
2179 | Instr = call_global(Dst, Name, TDArgs) |
2180 | ) |
2181 | + ; Instr0 = new_closure(Dst, Name, Args) -> |
2182 | + ( tables.lookup_local(!.LT, Dst, DstType) -> |
2183 | + FuncType = DstType, |
2184 | + ( map(tables.lookup_local(!.LT), Args, ArgTypes_) -> |
2185 | + ArgTypes = ArgTypes_, |
2186 | + ( DstType = types.app(types.functype, _) -> |
2187 | + true |
2188 | + ; |
2189 | + error("augment_instr_globalrefs: New-closure to " |
2190 | + ++ "non-function") |
2191 | + ) |
2192 | + ; |
2193 | + error("augment_instr_globalrefs: Arg not in LT") |
2194 | + ) |
2195 | + ; |
2196 | + error("augment_instr_globalrefs: Not in LT: " ++ |
2197 | + ir.varname_to_string_noescape(Dst)) |
2198 | + ), |
2199 | + augment_globalref(PT, PTAug, Varset, Rigids, TDVars, Name, FuncType, |
2200 | + ArgTypes, TDExprs, !RequiredVars), |
2201 | + % new_closure has the type dicts prepended to its argument list |
2202 | + generate_expr_code(PTAug, Varset, Rigids, BlockID, TDExprs, |
2203 | + TDArgs, PreInstrs, !LT, !BlockTempCount), |
2204 | + Instr = new_closure(Dst, Name, TDArgs ++ Args) |
2205 | ; Instr0 = call_global(Dst, Name, Args) -> |
2206 | ( tables.lookup_local(!.LT, Dst, DstType) -> |
2207 | ( map(tables.lookup_local(!.LT), Args, ArgTypes) -> |
2208 | @@ -1110,9 +1180,9 @@ |
2209 | ir.varname_to_string_noescape(Dst)) |
2210 | ), |
2211 | augment_globalref(PT, PTAug, Varset, Rigids, TDVars, Name, FuncType, |
2212 | - TDExprs, !RequiredVars), |
2213 | + [], TDExprs, !RequiredVars), |
2214 | ( method_builtin(Name), TDExprs = [TDExpr] -> |
2215 | - % ld_func of show or eq -- replace with field access |
2216 | + % call to show or eq -- replace with field access |
2217 | MethodExpr0 = expr(fieldref(TDExpr, Name), no), |
2218 | typecheck.expr_type(blank_context, PTAug, !.LT, Rigids, |
2219 | MethodExpr0, MethodExpr, Varset, _), |
2220 | @@ -1129,41 +1199,6 @@ |
2221 | TDArgs, PreInstrs, !LT, !BlockTempCount), |
2222 | Instr = call_global(Dst, Name, TDArgs ++ Args) |
2223 | ) |
2224 | - ; Instr0 = parcall_global(Dst, Name, Args) -> |
2225 | - ( tables.lookup_local(!.LT, Dst, DstType) -> |
2226 | - ( map(tables.lookup_local(!.LT), Args, ArgTypes) -> |
2227 | - ( DstType = types.app(types.functype, RemTypes) -> |
2228 | - FuncType = types.app(types.functype, ArgTypes ++ RemTypes) |
2229 | - ; |
2230 | - error("augment_instr_globalrefs: Parcall to non-function") |
2231 | - ) |
2232 | - ; |
2233 | - error("augment_instr_globalrefs: Arg not in LT") |
2234 | - ) |
2235 | - ; |
2236 | - error("augment_instr_globalrefs: Not in LT: " ++ |
2237 | - ir.varname_to_string_noescape(Dst)) |
2238 | - ), |
2239 | - augment_globalref(PT, PTAug, Varset, Rigids, TDVars, Name, FuncType, |
2240 | - TDExprs, !RequiredVars), |
2241 | - ( method_builtin(Name), TDExprs = [TDExpr] -> |
2242 | - % ld_func of show or eq -- replace with field access |
2243 | - MethodExpr0 = expr(fieldref(TDExpr, Name), no), |
2244 | - typecheck.expr_type(blank_context, PTAug, !.LT, Rigids, |
2245 | - MethodExpr0, MethodExpr, Varset, _), |
2246 | - generate_expr_code(PTAug, Varset, Rigids, BlockID, [MethodExpr], |
2247 | - MethodVars, PreInstrs, !LT, !BlockTempCount), |
2248 | - ( MethodVars = [MethodVar] -> |
2249 | - Instr = parcall(Dst, MethodVar, Args) |
2250 | - ; |
2251 | - error("augment_instr_globalrefs: generate_expr_code failed") |
2252 | - ) |
2253 | - ; |
2254 | - % parcall_global has the type dicts prepended to its argument list |
2255 | - generate_expr_code(PTAug, Varset, Rigids, BlockID, TDExprs, |
2256 | - TDArgs, PreInstrs, !LT, !BlockTempCount), |
2257 | - Instr = parcall_global(Dst, Name, TDArgs ++ Args) |
2258 | - ) |
2259 | ; |
2260 | PreInstrs = [], |
2261 | Instr = Instr0 |
2262 | @@ -1180,24 +1215,31 @@ |
2263 | localtable::in, localtable::out, int::in, int::out) is det. |
2264 | generate_expr_code(PT, Varset, _Rigids, BlockID, Exprs, VarNames, Instrs, !LT, |
2265 | !BlockTempCount) :- |
2266 | - list_map3_foldl(ast_cfg.expr_to_instrs_post_ssa(PT, Varset, BlockID), |
2267 | - Exprs, VarNames, InstrLists, TypeMaps, !BlockTempCount), |
2268 | + list_map4_foldl(ast_cfg.expr_to_instrs_post_ssa(PT, Varset, BlockID), |
2269 | + Exprs, VarNames, InstrLists, TypeMaps, SynthFuncses, |
2270 | + !BlockTempCount), |
2271 | Instrs = list.condense(InstrLists), |
2272 | + ( list.condense(SynthFuncses) : list(function) = [] -> |
2273 | + true |
2274 | + ; |
2275 | + % These references should not include any partial application |
2276 | + error("generate_expr_code: Synthetic functions were created") |
2277 | + ), |
2278 | list.foldl(map.foldl(tables.update_localtable), TypeMaps, !LT). |
2279 | |
2280 | -% augment_globalref(PT, PTAug, Rigids, Name, Type, TDArgs). |
2281 | +% augment_globalref(PT, PTAug, Rigids, Name, Type, CVTypes, TDArgs). |
2282 | % Returns the list of type dictionary actual parameter names to augment onto |
2283 | % the front of a reference to the global variable called Name. |
2284 | % Rigids are the rigid type variables of the caller (which may not be |
2285 | % unified). |
2286 | % Type is the "actual" type of the global -- that is, the type of the global |
2287 | % with all variables replaced with monomorphic variables local to the caller. |
2288 | +% CVTypes is similar, but for the types of the actual CVars. |
2289 | :- pred augment_globalref(progtable::in, progtable::in, varset::in, |
2290 | - list(var)::in, list(var)::in, string::in, typeval::in, list(expr)::out, |
2291 | - set(var)::in, set(var)::out) |
2292 | - is det. |
2293 | + list(var)::in, list(var)::in, string::in, typeval::in, list(typeval)::in, |
2294 | + list(expr)::out, set(var)::in, set(var)::out) is det. |
2295 | augment_globalref(PT, PTAug, ActualVarset, ActualRigids, ActualTDVars, Name, |
2296 | - ActualType, TDArgs, !RequiredVars) :- |
2297 | + ActualType0, ActualCVTypes, TDArgs, !RequiredVars) :- |
2298 | ( tables.lookup_function(PT, Name, Func_) -> |
2299 | Func = Func_ |
2300 | ; |
2301 | @@ -1210,13 +1252,41 @@ |
2302 | ), |
2303 | % Found in global function table - get its type and varset |
2304 | function_type(Func, FormalVarset, FormalType0), |
2305 | + % If this is a CT, pretend it isn't by prepending the actual/formal CT |
2306 | + % types onto the actual/formal function types. |
2307 | + ( |
2308 | + Func^func_cvars = yes(FormalCVars), |
2309 | + FormalCVTypes = map(func({_,T}) = T, FormalCVars), |
2310 | + ( FormalType0 = types.app(types.functype, FArgTypes) -> |
2311 | + FormalType1 = types.app(types.functype, |
2312 | + FormalCVTypes ++ FArgTypes) |
2313 | + ; |
2314 | + error("augment_globalref: CT, but formal type not a function") |
2315 | + ), |
2316 | + ( ActualType0 = types.app(types.functype, AArgTypes) -> |
2317 | + ActualType = types.app(types.functype, |
2318 | + ActualCVTypes ++ AArgTypes) |
2319 | + ; |
2320 | + error("augment_globalref: CT, but actual type not a function") |
2321 | + ) |
2322 | + ; |
2323 | + Func^func_cvars = no, |
2324 | + ( |
2325 | + ActualCVTypes = [], |
2326 | + FormalType1 = FormalType0, |
2327 | + ActualType = ActualType0 |
2328 | + ; |
2329 | + ActualCVTypes = [_|_], |
2330 | + error("augment_globalref: ActualCVTypes supplied for non-CT") |
2331 | + ) |
2332 | + ), |
2333 | % The list of variables we need to supply type dicts for |
2334 | FormalRigids0 = Func^func_rigids, |
2335 | % Augment our actual (local) varset with this function's (formal) |
2336 | % varset and translate the function's type to refer to the combined |
2337 | % varset. Also translate the rigids to the combined varset. |
2338 | types.varset_mergeone_rename(FormalVarset, ActualVarset, Varset0, |
2339 | - FormalType0, FormalType, FormalRigids0, FormalRigids), |
2340 | + FormalType1, FormalType, FormalRigids0, FormalRigids), |
2341 | % Translate the function's TDVars (expected type dicts) to the |
2342 | % combined varset |
2343 | TDVars = list.map(map.lookup( |
2344 | |
2345 | === modified file 'src/usedef.m' |
2346 | --- src/usedef.m 2011-04-20 03:34:02 +0000 |
2347 | +++ src/usedef.m 2011-05-11 05:12:31 +0000 |
2348 | @@ -179,24 +179,18 @@ |
2349 | instr_use_def_(ld_field(Dst, Obj, _CtorIdxMap, _Msg), Uses, Defs) :- |
2350 | set.singleton_set(Uses, Obj), |
2351 | set.singleton_set(Defs, Dst). |
2352 | +instr_use_def_(new_closure(Dst, _Func, Args), Uses, Defs) :- |
2353 | + Uses = set(Args), |
2354 | + set.singleton_set(Defs, Dst). |
2355 | instr_use_def_(call(Dst, Func, Args), Uses, Defs) :- |
2356 | Uses = set([Func|Args]), |
2357 | set.singleton_set(Defs, Dst). |
2358 | -instr_use_def_(parcall(Dst, Func, Args), Uses, Defs) :- |
2359 | - Uses = set([Func|Args]), |
2360 | - set.singleton_set(Defs, Dst). |
2361 | instr_use_def_(call_ctor(Dst, _Ctor, Args), Uses, Defs) :- |
2362 | Uses = set(Args), |
2363 | set.singleton_set(Defs, Dst). |
2364 | -instr_use_def_(parcall_ctor(Dst, _Ctor, Args), Uses, Defs) :- |
2365 | - Uses = set(Args), |
2366 | - set.singleton_set(Defs, Dst). |
2367 | instr_use_def_(call_global(Dst, _Func, Args), Uses, Defs) :- |
2368 | Uses = set(Args), |
2369 | set.singleton_set(Defs, Dst). |
2370 | -instr_use_def_(parcall_global(Dst, _Func, Args), Uses, Defs) :- |
2371 | - Uses = set(Args), |
2372 | - set.singleton_set(Defs, Dst). |
2373 | |
2374 | instrs_use_def(Instrs, Uses, Defs) :- |
2375 | % Process each instruction, and compute the sets of uses and defs |
2376 | |
2377 | === modified file 'src/util.m' |
2378 | --- src/util.m 2011-02-11 02:41:54 +0000 |
2379 | +++ src/util.m 2011-05-11 05:12:31 +0000 |
2380 | @@ -78,6 +78,12 @@ |
2381 | out, in, out) is det. |
2382 | % Add more modes as required. |
2383 | |
2384 | +:- pred list_map4_foldl(pred(L, M, N, O, P, A, A), list(L), list(M), list(N), |
2385 | + list(O), list(P), A, A). |
2386 | +:- mode list_map4_foldl(pred(in, out, out, out, out, in, out) is det, in, out, |
2387 | + out, out, out, in, out) is det. |
2388 | +% Add more modes as required. |
2389 | + |
2390 | :- pred list_map_foldr(pred(L, M, A, A), list(L), list(M), A, A). |
2391 | :- mode list_map_foldr(pred(in, out, in, out) is det, in, out, in, out) |
2392 | is det. |
2393 | @@ -389,6 +395,12 @@ |
2394 | P(H0, H1, H2, H3, !A), |
2395 | list_map3_foldl(P, T0, T1, T2, T3, !A). |
2396 | |
2397 | +list_map4_foldl(_, [], [], [], [], [], !A). |
2398 | +list_map4_foldl(P, [H0 | T0], [H1 | T1], [H2 | T2], [H3 | T3], [H4 | T4], !A) |
2399 | + :- |
2400 | + P(H0, H1, H2, H3, H4, !A), |
2401 | + list_map4_foldl(P, T0, T1, T2, T3, T4, !A). |
2402 | + |
2403 | list_map_foldr(_, [], [], !A). |
2404 | list_map_foldr(P, [H0 | T0], [H | T], !A) :- |
2405 | list_map_foldr(P, T0, T, !A), |