corrected and improved call-with-values optimization

svn: r4182
This commit is contained in:
Matthew Flatt 2006-08-29 07:08:37 +00:00
parent a450214c08
commit a6e4dfa639
2 changed files with 22 additions and 9 deletions

View File

@ -2332,7 +2332,7 @@ Scheme_Object *scheme_optimize_apply_values(Scheme_Object *f, Scheme_Object *e,
if (f_is_proc && (e_single_result > 0)) { if (f_is_proc && (e_single_result > 0)) {
/* Just make it an application (N M): */ /* Just make it an application (N M): */
Scheme_App2_Rec *app2; Scheme_App2_Rec *app2;
Scheme_Object *cloned; Scheme_Object *cloned, *f_cloned;
app2 = MALLOC_ONE_TAGGED(Scheme_App2_Rec); app2 = MALLOC_ONE_TAGGED(Scheme_App2_Rec);
app2->iso.so.type = scheme_application2_type; app2->iso.so.type = scheme_application2_type;
@ -2343,16 +2343,26 @@ Scheme_Object *scheme_optimize_apply_values(Scheme_Object *f, Scheme_Object *e,
If we can shift-clone it, then it will be back in the right If we can shift-clone it, then it will be back in the right
coordinates. */ coordinates. */
cloned = NULL; /* scheme_optimize_clone(1, e, info, 0, 0); */ cloned = scheme_optimize_clone(1, e, info, 0, 0);
if (cloned) { if (cloned) {
app2->rator = f_is_proc; if (SAME_TYPE(SCHEME_TYPE(f_is_proc), scheme_compiled_unclosed_procedure_type))
app2->rand = cloned; f_cloned = scheme_optimize_clone(1, f_is_proc, info, 0, 0);
return optimize_application2((Scheme_Object *)app2, info); else {
} else { /* Otherwise, no clone is needed; in the case of a lexical
app2->rator = f; variable, we already reversed it. */
app2->rand = e; f_cloned = f_is_proc;
return (Scheme_Object *)app2; }
if (f_cloned) {
app2->rator = f_cloned;
app2->rand = cloned;
return optimize_application2((Scheme_Object *)app2, info);
}
} }
app2->rator = f;
app2->rand = e;
return (Scheme_Object *)app2;
} }
return scheme_make_syntax_compiled(APPVALS_EXPD, cons(f, e)); return scheme_make_syntax_compiled(APPVALS_EXPD, cons(f, e));

View File

@ -2659,6 +2659,9 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline)
Scheme_Type lhs; Scheme_Type lhs;
lhs = SCHEME_TYPE(clv->value); lhs = SCHEME_TYPE(clv->value);
if ((lhs == scheme_compiled_unclosed_procedure_type) if ((lhs == scheme_compiled_unclosed_procedure_type)
|| (lhs == scheme_local_type)
|| (lhs == scheme_compiled_toplevel_type)
|| (lhs == scheme_compiled_quote_syntax_type)
|| (lhs > _scheme_compiled_values_types_)) { || (lhs > _scheme_compiled_values_types_)) {
if (for_inline) { if (for_inline) {
/* Just drop the inline-introduced let */ /* Just drop the inline-introduced let */