Merge lp:~mgiuca/mars/closure-templates into lp:mars

Proposed by Matt Giuca
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
Reviewer Review Type Date Requested Status
Matt Giuca Approve
Review via email: mp+60579@code.launchpad.net

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.

To post a comment you must log in.
lp:~mgiuca/mars/closure-templates updated
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).

Revision history for this message
Matt Giuca (mgiuca) :
review: Approve

Preview Diff

[H/L] Next/Prev Comment, [J/K] Next/Prev File, [N/P] Next/Prev Hunk
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),

Subscribers

People subscribed via source and target branches

to all changes: