improve bytecode compiler test for converting a letrec to let

- specifically the test for whether the RHS of a binding can
 possibly capture and invoke a continuation
This commit is contained in:
Matthew Flatt 2010-08-25 15:54:47 -06:00
parent 7dc4d2e5a6
commit 8c16b825de

View File

@ -2816,37 +2816,61 @@ static int is_liftable(Scheme_Object *o, int bind_count, int fuel, int as_rator)
int i;
if (!is_liftable_prim(app->args[0]))
return 0;
if (bind_count >= 0)
bind_count += app->num_args;
if (0) /* not resolved, yet */
if (bind_count >= 0)
bind_count += app->num_args;
for (i = app->num_args + 1; i--; ) {
if (!is_liftable(app->args[i], bind_count, fuel - 1, 1))
return 0;
}
return 1;
}
break;
case scheme_application2_type:
{
Scheme_App2_Rec *app = (Scheme_App2_Rec *)o;
if (!is_liftable_prim(app->rator))
return 0;
if (bind_count >= 0)
bind_count += 1;
if (0) /* not resolved, yet */
if (bind_count >= 0)
bind_count += 1;
if (is_liftable(app->rator, bind_count, fuel - 1, 1)
&& is_liftable(app->rand, bind_count, fuel - 1, 1))
return 1;
}
break;
case scheme_application3_type:
{
Scheme_App3_Rec *app = (Scheme_App3_Rec *)o;
if (!is_liftable_prim(app->rator))
return 0;
if (bind_count >= 0)
bind_count += 2;
if (0) /* not resolved, yet */
if (bind_count >= 0)
bind_count += 2;
if (is_liftable(app->rator, bind_count, fuel - 1, 1)
&& is_liftable(app->rand1, bind_count, fuel - 1, 1)
&& is_liftable(app->rand2, bind_count, fuel - 1, 1))
return 1;
}
break;
case scheme_compiled_let_void_type:
{
Scheme_Let_Header *lh = (Scheme_Let_Header *)o;
int i;
int post_bind = !(SCHEME_LET_FLAGS(lh) & (SCHEME_LET_RECURSIVE | SCHEME_LET_STAR));
if (post_bind) {
o = lh->body;
for (i = lh->num_clauses; i--; ) {
if (!is_liftable(((Scheme_Compiled_Let_Value *)o)->value, bind_count, fuel - 1, as_rator))
return 0;
o = ((Scheme_Compiled_Let_Value *)o)->body;
}
if (is_liftable(o, bind_count + lh->count, fuel - 1, as_rator))
return 1;
}
break;
}
default:
if (t > _scheme_compiled_values_types_)
return 1;