git.haldean.org expel / 9023ed3
recover corrupted git repo, major progress on closure thing fucking god dammit virtualbox Haldean Brown 6 years ago
9 changed file(s) with 441 addition(s) and 8 deletion(s). Raw diff Collapse all Expand all
6666 c(xl_stream_rfilep(&sstdin, stdin));
6767
6868 parse_err = xl_parse(&ast, "(stdin)", &sstdin);
69 if (parse_err == OK)
70 parse_err = xl_resolve(ast, "(stdin)", &rctx);
71 printf("post-resolution\n");
6972 if (argc > 1 && strcmp(argv[1], "emit-ast") == 0)
7073 err = xl_ast_print(ast);
7174 c(parse_err);
7275 c(err);
73
74 c(xl_resolve(ast, "(stdin)", &rctx));
7576
7677 c(xl_compile_ast(&graphs, &n_graphs, ast, NULL));
7778
0 nobase_include_HEADERS = expel/bdagc.h expel/stream.h expel/timer.h expel/ast.h expel/const.h expel/assert.h expel/env.h expel/token.h expel/gen.h expel/natives.h expel/expel.h expel/dagc.h expel/uri.h expel/def-native.h expel/value.h expel/string.h expel/util.h expel/gc.h expel/compile.h expel/pointerset.h expel/schedule.h expel/parse.h expel/types.h expel/vector.h expel/resolve.h
0 nobase_include_HEADERS = expel/bdagc.h expel/stream.h expel/timer.h expel/ast.h expel/const.h expel/assert.h expel/env.h expel/token.h expel/gen.h expel/natives.h expel/expel.h expel/dagc.h expel/uri.h expel/def-native.h expel/value.h expel/string.h expel/util.h expel/gc.h expel/compile.h expel/pointerset.h expel/schedule.h expel/parse.h expel/types.h expel/vector.h expel/resolve.h expel/closure.h
11
22 expel/const.h: ../res/const.txt
33 $(AWK) -f ../res/compile-const.awk $< > $@
2222
2323 #include <stdbool.h>
2424
25 /* The maximum number of subexpressions any one expression can have. */
26 #define XL_MAX_SUBEXPRS 8
27
2528 enum expr_type
2629 {
2730 EXPR_APPLY = 1,
0 /*
1 * closure.h: closure transformation on ASTs
2 * Copyright (C) 2016, Haldean Brown
3 *
4 * This program is free software; you can redistribute it and/or modify
5 * it under the terms of the GNU General Public License as published by
6 * the Free Software Foundation; either version 2 of the License, or
7 * (at your option) any later version.
8 *
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 * GNU General Public License for more details.
13 *
14 * You should have received a copy of the GNU General Public License along
15 * with this program; if not, write to the Free Software Foundation, Inc.,
16 * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
17 */
18
19 #pragma once
20 #include "expel/ast.h"
21 #include "expel/expel.h"
22 #include "expel/resolve.h"
23
24 /* Takes an AST and transforms closures into partially-applied functions. This
25 * transformation is explained in-depth in the "Code generation" portion of the
26 * architecture document. */
27 no_ignore xl_error
28 xl_reduce_closures(
29 struct xl_resolve_context *ctx,
30 struct xl_ast *ast);
7070
7171 struct xl_resolve_scope *parent;
7272 enum xl_resolve_boundary_type boundary;
73
74 /* This thing is complicated. There's a long explanation in closure.c
75 * about what it means. Go read that. */
76 bool needs_closure_appl;
7377 };
7478
7579 enum xl_resolve_error_type
00 lib_LIBRARIES = libexpel.a
1 libexpel_a_SOURCES = store.c error.c uri.c gen.c timer.c eval.c load.c gc.c pointerset.c compile.c string.c schedule.c natives.c types.c print-ast.c value.c bdagc.c assert.c explain.c ast.c dagc.c parse.c util.c rt.c stream.c env.c token.l grammar.y uri-value.tree humanize-poly.tree vector.c resolve.c
1 libexpel_a_SOURCES = store.c error.c uri.c gen.c timer.c eval.c load.c gc.c pointerset.c compile.c string.c schedule.c natives.c types.c print-ast.c value.c bdagc.c assert.c explain.c ast.c dagc.c parse.c util.c rt.c stream.c env.c token.l grammar.y uri-value.tree humanize-poly.tree vector.c resolve.c closure.c
22 BUILT_SOURCES = grammar.h uri-value.h humanize-poly.h
33
44 libexpel_a_CFLAGS = -std=c11 -Werror -Wall -Wextra -fno-strict-aliasing -rdynamic -Wswitch-enum -fPIC
0 /*
1 * closure.c: closure transformation on ASTs
2 * Copyright (C) 2016, Haldean Brown
3 *
4 * This program is free software; you can redistribute it and/or modify
5 * it under the terms of the GNU General Public License as published by
6 * the Free Software Foundation; either version 2 of the License, or
7 * (at your option) any later version.
8 *
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 * GNU General Public License for more details.
13 *
14 * You should have received a copy of the GNU General Public License along
15 * with this program; if not, write to the Free Software Foundation, Inc.,
16 * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
17 */
18
19 #include <string.h>
20
21 #include "expel/assert.h"
22 #include "expel/ast.h"
23 #include "expel/closure.h"
24 #include "expel/resolve.h"
25
26 /* A brief digression into the algorithm at play here.
27 *
28 * The goal of the closure transformation is to turn closures into
29 * partially-applied functions to capture the closed-over data. This
30 * allows us to maintain simplicity at the VM layer, and doing it as a
31 * source transformation seems the easiest, so that's what we're doing
32 * here.
33 *
34 * By the time we get here, every name has been resolved in one way or
35 * another. The different resolution types are all listed out in
36 * resolve.h, but the one we're interested in here is RESOLVE_CLOSURE.
37 * The goal is, by the time we're done with it, the AST will have no
38 * names that are resolved to a closure.
39 *
40 * Here's the algorithm:
41 * 1. Find a "bottom" expression: this is an expression that is a
42 * name A that resolved to a closure. Let B be the bottom
43 * expression. (this happens in traverse_expr)
44 * 2. For every expression above the bottom expression, apply the
45 * first of the following applicable rules (this happens in
46 * apply_upward_transform):
47 * a. If the expression is a lambda expression and its
48 * arguments do not contain A, prepend A to its list of
49 * arguments and mark it as needing application (this state
50 * is stored in expr->scope->needs_closure_appl).
51 * b. If the expression is a lambda expression and its
52 * arguments contain A, this expression is the "top"
53 * expression: the expression at which A is defined. Goto 3.
54 * c. TODO: determine that a name is bound in a block object?
55 * d. For all other expressions, do nothing and recurse to its
56 * parent.
57 * 3. Let X by the top expression (this, as well as steps 4 and 5,
58 * happen in apply_downwards_transform).
59 * 4. Examine each subexpression of X. If a subexpression Y is
60 * marked as needing application, replace Y in X with an apply
61 * expression whose function is Y and whose argument is an
62 * atomic expression with name A and local resolution (this
63 * specific transformation happens in apply_closure).
64 * 5. For each subexpression Y of X, let X = Y and goto 3.
65 * 6. Change the resolution of B to local.
66 * 7. Repeat until there are no more names resolved to a closure.
67 */
68
69 no_ignore static xl_error
70 apply_closure(struct xl_ast_expr **lambda, char *resolving_name)
71 {
72 struct xl_ast_expr *apply;
73 struct xl_ast_expr *name;
74
75 (*lambda)->scope->needs_closure_appl = false;
76
77 /* damn this is a lot of work. */
78 name = calloc(1, sizeof(struct xl_ast_expr));
79 if (name == NULL)
80 return xl_raise(ERR_NO_MEMORY, "closure name alloc");
81 name->expr_type = EXPR_ATOM;
82
83 name->atom = calloc(1, sizeof(struct xl_ast_atom));
84 if (name->atom == NULL)
85 return xl_raise(ERR_NO_MEMORY, "closure name alloc");
86 name->atom->atom_type = ATOM_NAME;
87 name->atom->name_loc = calloc(1, sizeof(struct xl_resolve_name_loc));
88 if (name->atom->name_loc == NULL)
89 return xl_raise(ERR_NO_MEMORY, "closure name alloc");
90 name->atom->name_loc->type = RESOLVE_LOCAL;
91
92 name->atom->str = strdup(resolving_name);
93 if (name->atom->str == NULL)
94 return xl_raise(ERR_NO_MEMORY, "closure name alloc");
95
96 name->scope = (*lambda)->scope->parent;
97
98 apply = calloc(1, sizeof(struct xl_ast_expr));
99 if (apply == NULL)
100 return xl_raise(ERR_NO_MEMORY, "closure apply alloc");
101 apply->expr_type = EXPR_APPLY;
102
103 apply->scope = (*lambda)->scope->parent;
104
105 apply->apply.head = *lambda;
106 apply->apply.tail = name;
107
108 *lambda = apply;
109 return OK;
110 }
111
112 no_ignore static xl_error
113 apply_downwards_transform(
114 char *resolving_name,
115 struct xl_resolve_context *ctx,
116 struct xl_ast_expr *expr)
117 {
118 struct xl_ast *subast;
119 xl_error err;
120 size_t i;
121
122 #define check_closure_appl(subexpr) do { \
123 if (subexpr->scope->needs_closure_appl) \
124 { err = apply_closure(&subexpr, resolving_name); \
125 if (err != OK) return err; } \
126 err = apply_downwards_transform(resolving_name, ctx, subexpr); \
127 if (err != OK) return err; \
128 } while (0)
129
130 switch (expr->expr_type)
131 {
132 case EXPR_ATOM:
133 return OK;
134
135 case EXPR_APPLY:
136 check_closure_appl(expr->apply.head);
137 check_closure_appl(expr->apply.tail);
138 return OK;
139
140 case EXPR_LAMBDA:
141 check_closure_appl(expr->lambda.body);
142 return OK;
143
144 case EXPR_CONDITIONAL:
145 check_closure_appl(expr->condition.cond);
146 check_closure_appl(expr->condition.implied);
147 check_closure_appl(expr->condition.opposed);
148 return OK;
149
150 case EXPR_CONSTRUCTOR:
151 subast = expr->constructor.scope;
152 break;
153 case EXPR_BLOCK:
154 subast = expr->block;
155 break;
156 }
157
158 for (i = 0; i < subast->bindings.n; i++)
159 {
160 struct xl_ast_binding *bind;
161
162 bind = subast->bindings.elems[i];
163 err = apply_downwards_transform(
164 resolving_name, ctx, bind->expr);
165 if (err != OK)
166 return err;
167 }
168
169 if (subast->immediate != NULL)
170 {
171 check_closure_appl(subast->immediate);
172 }
173 return OK;
174 }
175
176 no_ignore static xl_error
177 apply_upwards_lambda_transform(
178 char **resolving_name_ref,
179 struct xl_resolve_context *ctx,
180 struct xl_ast_expr *expr)
181 {
182 char *resolving_name;
183 struct xl_ast_arg_list *args;
184 bool is_top;
185
186 resolving_name = *resolving_name_ref;
187
188 args = expr->lambda.args;
189 is_top = false;
190
191 while (args->name != NULL)
192 {
193 if (strcmp(args->name, resolving_name) == 0)
194 {
195 is_top = true;
196 break;
197 }
198 args = args->next;
199 }
200
201 if (is_top)
202 {
203 *resolving_name_ref = NULL;
204 return apply_downwards_transform(resolving_name, ctx, expr);
205 }
206
207 args = calloc(1, sizeof(struct xl_ast_arg_list));
208 args->name = strdup(resolving_name);
209 args->next = expr->lambda.args;
210
211 expr->lambda.args = args;
212 expr->scope->needs_closure_appl = true;
213 return OK;
214 }
215
216 no_ignore static xl_error
217 apply_upwards_transform(
218 char **resolving_name,
219 struct xl_resolve_context *ctx,
220 struct xl_ast_expr *expr)
221 {
222 switch (expr->expr_type)
223 {
224 case EXPR_LAMBDA:
225 return apply_upwards_lambda_transform(
226 resolving_name, ctx, expr);
227
228 case EXPR_BLOCK:
229 case EXPR_CONDITIONAL:
230 /* TODO: gotta do these. */
231 return OK;
232
233 case EXPR_APPLY:
234 case EXPR_ATOM:
235 case EXPR_CONSTRUCTOR:
236 /* nothing else needs any transformation on the way up. */
237 return OK;
238 }
239
240 __builtin_unreachable();
241 }
242
243 static inline bool
244 is_closure_ref(struct xl_ast_expr *expr)
245 {
246 if (expr->expr_type != EXPR_ATOM)
247 return false;
248 if (expr->atom->atom_type != ATOM_NAME)
249 return false;
250 return expr->atom->name_loc->type == RESOLVE_CLOSURE;
251 }
252
253 no_ignore static xl_error
254 traverse_ast(
255 char **resolving_name,
256 bool *changed,
257 struct xl_resolve_context *ctx,
258 struct xl_ast *ast);
259
260 no_ignore static xl_error
261 traverse_expr(
262 char **resolving_name,
263 bool *changed,
264 struct xl_resolve_context *ctx,
265 struct xl_ast_expr *expr)
266 {
267 struct xl_ast *subast;
268 struct xl_ast_expr *subexprs[XL_MAX_SUBEXPRS];
269 size_t i;
270 size_t n_subexprs;
271 xl_error err;
272
273 if (is_closure_ref(expr))
274 {
275 *resolving_name = expr->atom->str;
276 expr->atom->name_loc->type = RESOLVE_LOCAL;
277 *changed = true;
278 return OK;
279 }
280
281 err = xl_ast_subexprs(&subast, subexprs, &n_subexprs, expr);
282 if (err != OK)
283 return err;
284
285 if (subast != NULL)
286 {
287 err = traverse_ast(resolving_name, changed, ctx, subast);
288 if (err != OK)
289 return err;
290
291 if (*resolving_name != NULL)
292 {
293 err = apply_upwards_transform(
294 resolving_name, ctx, expr);
295 return err;
296 }
297 }
298
299 for (i = 0; i < n_subexprs; i++)
300 {
301 err = traverse_expr(resolving_name, changed, ctx, subexprs[i]);
302 if (err != OK)
303 return err;
304
305 if (*resolving_name != NULL)
306 {
307 err = apply_upwards_transform(
308 resolving_name, ctx, expr);
309 return err;
310 }
311 }
312 return OK;
313 }
314
315 no_ignore xl_error
316 traverse_ast(
317 char **resolving_name,
318 bool *changed,
319 struct xl_resolve_context *ctx,
320 struct xl_ast *ast)
321 {
322 size_t i;
323 xl_error err;
324
325 for (i = 0; i < ast->bindings.n; i++)
326 {
327 struct xl_ast_binding *bind;
328
329 bind = ast->bindings.elems[i];
330 err = traverse_expr(
331 resolving_name, changed, ctx, bind->expr);
332 if (err != OK)
333 return err;
334 }
335
336 if (ast->immediate != NULL)
337 {
338 err = traverse_expr(
339 resolving_name, changed, ctx, ast->immediate);
340 if (err != OK)
341 return err;
342 }
343
344 return OK;
345 }
346
347 no_ignore xl_error
348 xl_reduce_closures(
349 struct xl_resolve_context *ctx,
350 struct xl_ast *ast)
351 {
352 char *resolving_name;
353 bool changed;
354 xl_error err;
355
356 do
357 {
358 err = xl_ast_print(ast);
359 if (err != OK)
360 return err;
361
362 changed = false;
363 resolving_name = NULL;
364 err = traverse_ast(&resolving_name, &changed, ctx, ast);
365 if (err != OK)
366 return err;
367
368 xl_assert(resolving_name == NULL);
369 } while (changed);
370
371 return OK;
372 }
1717 */
1818
1919 #include "expel/ast.h"
20 #include "expel/resolve.h"
2021
2122 #include <inttypes.h>
2223 #include <stdio.h>
3536 no_ignore static xl_error
3637 _print_atom(struct xl_ast_atom *atom)
3738 {
39 if (atom->name_loc != 0)
40 {
41 switch (atom->name_loc->type)
42 {
43 case RESOLVE_LOCAL:
44 printf(".");
45 break;
46 case RESOLVE_GLOBAL:
47 printf("*");
48 break;
49 case RESOLVE_CLOSURE:
50 printf("%%");
51 break;
52 }
53 }
3854 switch (atom->atom_type)
3955 {
4056 case ATOM_INT:
2121 #include <string.h>
2222
2323 #include "expel/ast.h"
24 #include "expel/closure.h"
2425 #include "expel/env.h"
2526 #include "expel/natives.h"
2627 #include "expel/resolve.h"
5960 struct xl_resolve_scope *parent)
6061 {
6162 struct xl_ast *subast;
62 struct xl_ast_expr *subexprs[8];
63 struct xl_ast_expr *subexprs[XL_MAX_SUBEXPRS];
6364 size_t n_subexprs;
6465 size_t i;
6566 xl_error err;
176177 struct xl_ast_expr *expr)
177178 {
178179 struct xl_ast *subast;
179 struct xl_ast_expr *subexprs[8];
180 struct xl_ast_expr *subexprs[XL_MAX_SUBEXPRS];
180181 size_t n_subexprs;
181182 size_t i;
182183 xl_error err;
256257 struct xl_ast_arg_list *args;
257258 struct xl_resolve_name *name;
258259 struct xl_ast *subast;
259 struct xl_ast_expr *subexprs[8];
260 struct xl_ast_expr *subexprs[XL_MAX_SUBEXPRS];
260261 size_t n_subexprs;
261262 size_t i;
262263 xl_error err;
344345 size_t n_subexprs;
345346 enum xl_resolve_boundary_type highest_bdry;
346347 struct xl_ast *subast;
347 struct xl_ast_expr *subexprs[8];
348 struct xl_ast_expr *subexprs[XL_MAX_SUBEXPRS];
348349 struct xl_resolve_name_loc *name_loc;
349350 struct xl_resolve_scope *scope;
350351 struct xl_resolve_name *check_name;
544545 if (err != OK)
545546 return err;
546547
548 err = xl_reduce_closures(ctx, ast);
549 if (err != OK)
550 return err;
551
547552 if (ctx->errors.n != 0)
548553 {
549554 for (i = 0; i < ctx->errors.n; i++)