suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix optimizer bug for inlining procedures under 'let' in rator position

Browse Source 
svn: r18622
This commit is contained in:
Matthew Flatt 2010-03-25 20:09:41 +00:00
parent 99ee6c468f
commit 72db535760
3 changed files with 98 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
collects/tests/mzscheme/optimize.ss
View File

@ -1148,6 +1148,42 @@
(err/rt-test (cwv-2-5-f (lambda () 1) (lambda (y z) (+ y 2))) exn:fail:contract:arity?)
(err/rt-test (cwv-2-5-f (lambda () (values 1 2 3)) (lambda (y z) (+ y 2))) exn:fail:contract:arity?)
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Inlining with higher-order functions:
(test 0 'ho1 (let ([x (random 1)])
((let ([fn (add1 (random 1))])
(lambda (c) c))
x)))
(test 0 'ho2 (let ([x (random 1)]
[id (lambda (c) c)])
((let ([fn (add1 (random 1))])
id)
x)))
(test 0 'ho3 (let ([proc (lambda (q)
(let ([fn (add1 (random 1))])
(lambda (c) c)))])
(let ([x (random 1)])
((proc 99) x))))
(test '(2 0) 'ho4 (let ([y (+ 2 (random 1))])
(let ([x (random 1)])
((let ([fn (add1 (random 1))])
(lambda (c) (list y c)))
x))))
(test '(2 0) 'ho5 (let ([y (+ 2 (random 1))])
(let ([x (random 1)]
[id (lambda (c) (list y c))])
((let ([fn (add1 (random 1))])
id)
x))))
(test '(2 0) 'ho6 (let ([y (+ 2 (random 1))])
(let ([proc (lambda (q)
(let ([fn (add1 (random 1))])
(lambda (c) (list y c))))])
(let ([x (random 1)])
((proc 98)
x)))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs)

97
src/mzscheme/src/eval.c
View File

@ -2436,19 +2436,18 @@ static Scheme_Object *apply_inlined(Scheme_Object *p, Scheme_Closure_Data *data,
{
Scheme_Let_Header *lh;
Scheme_Compiled_Let_Value *lv, *prev = NULL;
Scheme_Object *val;
int i, expected;
int *flags, flag;
expected = data->num_params;
if (!expected) {
info = scheme_optimize_info_add_frame(info, nested_count, nested_count, 0);
info = scheme_optimize_info_add_frame(info, 0, 0, 0);
info->inline_fuel >>= 1;
if (nested_count) info->vclock++;
p = scheme_optimize_expr(p, info, context);
info->next->single_result = info->single_result;
if (!nested_count)
info->next->preserves_marks = info->preserves_marks;
info->next->preserves_marks = info->preserves_marks;
scheme_optimize_info_done(info);
if (le_prev) {
@ -2472,7 +2471,7 @@ static Scheme_Object *apply_inlined(Scheme_Object *p, Scheme_Closure_Data *data,
if ((i == expected - 1)
&& (SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_HAS_REST)) {
int j;
Scheme_Object *l = scheme_null, *val;
Scheme_Object *l = scheme_null;
for (j = argc; j-- > i; ) {
if (app)
@ -2488,14 +2487,16 @@ static Scheme_Object *apply_inlined(Scheme_Object *p, Scheme_Closure_Data *data,
}
l = cons(scheme_list_proc, l);
val = make_application(l);
lv->value = val;
} else if (app)
lv->value = app->args[i + 1];
val = app->args[i + 1];
else if (app3)
lv->value = (i ? app3->rand2 : app3->rand1);
else if (app2)
lv->value = app2->rand;
val = (i ? app3->rand2 : app3->rand1);
else
val = app2->rand;
if (nested_count)
val = scheme_optimize_shift(val, nested_count, 0);
lv->value = val;
flag = scheme_closure_argument_flags(data, i);
flags = (int *)scheme_malloc_atomic(sizeof(int));
@ -2514,7 +2515,7 @@ static Scheme_Object *apply_inlined(Scheme_Object *p, Scheme_Closure_Data *data,
else
lh->body = p;
p = scheme_optimize_lets((Scheme_Object *)lh, info, 1 + nested_count, context);
p = scheme_optimize_lets((Scheme_Object *)lh, info, 1, context);
if (le_prev) {
*((Scheme_Object **)(((char *)le_prev) + prev_offset)) = p;
@ -2538,7 +2539,7 @@ Scheme_Object *optimize_for_inline(Optimize_Info *info, Scheme_Object *le, int a
int offset = 0, single_use = 0, psize = 0;
Scheme_Object *bad_app = NULL, *prev = NULL, *orig_le = le;
long prev_offset = 0;
int nested_count = 0;
int nested_count = 0, outside_nested = 0;
if (info->inline_fuel < 0)
return NULL;
@ -2568,9 +2569,10 @@ Scheme_Object *optimize_for_inline(Optimize_Info *info, Scheme_Object *le, int a
if (!optimized_rator && SAME_TYPE(SCHEME_TYPE(le), scheme_local_type)) {
/* Check for inlining: */
if (SCHEME_LOCAL_POS(le) >= nested_count)
if (SCHEME_LOCAL_POS(le) >= nested_count) {
le = scheme_optimize_info_lookup(info, SCHEME_LOCAL_POS(le) - nested_count, &offset, &single_use, 0, 0, &psize);
else
outside_nested = 1;
} else
info->has_nonleaf = 1;
}
@ -2587,6 +2589,7 @@ Scheme_Object *optimize_for_inline(Optimize_Info *info, Scheme_Object *le, int a
}
if (!le)
break;
outside_nested = 1;
} else
break;
}
@ -2616,16 +2619,25 @@ Scheme_Object *optimize_for_inline(Optimize_Info *info, Scheme_Object *le, int a
if ((sz >= 0) && (single_use || (sz <= threshold))) {
Optimize_Info *sub_info;
if (nested_count)
sub_info = scheme_optimize_info_add_frame(info, nested_count, nested_count, 0);
else
if (nested_count) {
sub_info = scheme_optimize_info_add_frame(info, nested_count, nested_count, nested_count);
sub_info->vclock++;
/* We could propagate bound values in sub_info , but relevant inlining
and propagatation has probably already happened when the rator was
optimized. */
} else
sub_info = info;
le = scheme_optimize_clone(0, data->code, sub_info, offset, data->num_params);
le = scheme_optimize_clone(0, data->code, sub_info,
offset + (outside_nested ? nested_count : 0),
data->num_params);
if (le) {
LOG_INLINE(fprintf(stderr, "Inline %d[%d]<=%d@%d %d %s\n", sz, is_leaf, threshold, info->inline_fuel,
single_use, data->name ? scheme_write_to_string(data->name, NULL) : "???"));
return apply_inlined(le, data, info, argc, app, app2, app3, context,
nested_count, orig_le, prev, prev_offset);
le = apply_inlined(le, data, sub_info, argc, app, app2, app3, context,
nested_count, orig_le, prev, prev_offset);
if (nested_count)
scheme_optimize_info_done(sub_info);
return le;
} else {
LOG_INLINE(fprintf(stderr, "No inline %s\n", data->name ? scheme_write_to_string(data->name, NULL) : "???"));
info->has_nonleaf = 1;
@ -2857,33 +2869,30 @@ static void reset_rator(Scheme_Object *app, Scheme_Object *a)
static Scheme_Object *check_app_let_rator(Scheme_Object *app, Scheme_Object *rator, Optimize_Info *info,
int argc, int context)
{
/* Convert ((let (....) E) arg ...) to (let (....) (E arg ...)), in case
the `let' is immediately apparent. We check for this pattern again
in optimize_for_inline() after optimizing a rator. */
if (SAME_TYPE(SCHEME_TYPE(rator), scheme_compiled_let_void_type)) {
Scheme_Let_Header *head = (Scheme_Let_Header *)rator;
Scheme_Compiled_Let_Value *clv = NULL;
int i;
if ((head->count == 1) && (head->num_clauses == 1)) {
Scheme_Object *body;
Scheme_Compiled_Let_Value *clv;
clv = (Scheme_Compiled_Let_Value *)head->body;
body = clv->body;
if (SAME_TYPE(SCHEME_TYPE(body), scheme_local_type)
&& (SCHEME_LOCAL_POS(body) == 0)
&& scheme_is_compiled_procedure(clv->value, 1, 1)) {
reset_rator(app, scheme_false);
app = scheme_optimize_shift(app, 1, 0);
reset_rator(app, scheme_make_local(scheme_local_type, 0, 0));
clv->body = app;
if (clv->flags[0] & SCHEME_WAS_APPLIED_EXCEPT_ONCE) {
clv->flags[0] -= SCHEME_WAS_APPLIED_EXCEPT_ONCE;
clv->flags[0] |= SCHEME_WAS_ONLY_APPLIED;
}
return scheme_optimize_expr(rator, info, context);
}
rator = head->body;
for (i = head->num_clauses; i--; ) {
clv = (Scheme_Compiled_Let_Value *)rator;
rator = clv->body;
}
reset_rator(app, scheme_false);
app = scheme_optimize_shift(app, head->count, 0);
reset_rator(app, rator);
if (clv)
clv->body = app;
else
head->body = app;
return scheme_optimize_expr((Scheme_Object *)head, info, context);
}
return NULL;

25
src/mzscheme/src/syntax.c
View File

@ -3098,15 +3098,9 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i
}
}
if (for_inline > 1) {
info->vclock++;
sub_info = scheme_optimize_info_add_frame(info, for_inline - 1, for_inline - 1, 0);
} else
sub_info = info;
body_info = scheme_optimize_info_add_frame(sub_info, head->count, head->count, 0);
body_info = scheme_optimize_info_add_frame(info, head->count, head->count, 0);
if (for_inline) {
rhs_info = scheme_optimize_info_add_frame(info, 0, head->count + (for_inline - 1), 0);
rhs_info = scheme_optimize_info_add_frame(info, 0, head->count, 0);
body_info->inline_fuel >>= 1;
} else
rhs_info = body_info;
@ -3562,7 +3556,6 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i
/* Optimized away all clauses? */
if (!head->num_clauses) {
scheme_optimize_info_done(body_info);
if (for_inline > 1) scheme_optimize_info_done(sub_info);
return head->body;
}
@ -3616,20 +3609,18 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i
value = scheme_optimize_clone(1, value, rhs_info, 0, 0);
if (value) {
info = scheme_optimize_info_add_frame(sub_info, extract_depth, 0, 0);
info->inline_fuel = 0;
value = scheme_optimize_expr(value, info, context);
sub_info->single_result = info->single_result;
sub_info->preserves_marks = info->preserves_marks;
scheme_optimize_info_done(info);
if (for_inline > 1) scheme_optimize_info_done(sub_info);
sub_info = scheme_optimize_info_add_frame(info, extract_depth, 0, 0);
sub_info->inline_fuel = 0;
value = scheme_optimize_expr(value, sub_info, context);
info->single_result = sub_info->single_result;
info->preserves_marks = sub_info->preserves_marks;
scheme_optimize_info_done(sub_info);
return value;
}
}
}
scheme_optimize_info_done(body_info);
if (for_inline > 1) scheme_optimize_info_done(sub_info);
return form;
}