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

improve bytecode compiler test for converting a letrec to let

Browse Source 
- 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
1 changed files with 30 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
src/racket/src/syntax.c
View File

@ -2816,6 +2816,7 @@ static int is_liftable(Scheme_Object *o, int bind_count, int fuel, int as_rator)
int i; int i;
if (!is_liftable_prim(app->args[0])) if (!is_liftable_prim(app->args[0]))
return 0; return 0;
if (0) /* not resolved, yet */
if (bind_count >= 0) if (bind_count >= 0)
bind_count += app->num_args; bind_count += app->num_args;
for (i = app->num_args + 1; i--; ) { for (i = app->num_args + 1; i--; ) {
@ -2824,22 +2825,26 @@ static int is_liftable(Scheme_Object *o, int bind_count, int fuel, int as_rator)
} }
return 1; return 1;
} }
break;
case scheme_application2_type: case scheme_application2_type:
{ {
Scheme_App2_Rec *app = (Scheme_App2_Rec *)o; Scheme_App2_Rec *app = (Scheme_App2_Rec *)o;
if (!is_liftable_prim(app->rator)) if (!is_liftable_prim(app->rator))
return 0; return 0;
if (0) /* not resolved, yet */
if (bind_count >= 0) if (bind_count >= 0)
bind_count += 1; bind_count += 1;
if (is_liftable(app->rator, bind_count, fuel - 1, 1) if (is_liftable(app->rator, bind_count, fuel - 1, 1)
&& is_liftable(app->rand, bind_count, fuel - 1, 1)) && is_liftable(app->rand, bind_count, fuel - 1, 1))
return 1; return 1;
} }
break;
case scheme_application3_type: case scheme_application3_type:
{ {
Scheme_App3_Rec *app = (Scheme_App3_Rec *)o; Scheme_App3_Rec *app = (Scheme_App3_Rec *)o;
if (!is_liftable_prim(app->rator)) if (!is_liftable_prim(app->rator))
return 0; return 0;
if (0) /* not resolved, yet */
if (bind_count >= 0) if (bind_count >= 0)
bind_count += 2; bind_count += 2;
if (is_liftable(app->rator, bind_count, fuel - 1, 1) if (is_liftable(app->rator, bind_count, fuel - 1, 1)
@ -2847,6 +2852,25 @@ static int is_liftable(Scheme_Object *o, int bind_count, int fuel, int as_rator)
&& is_liftable(app->rand2, bind_count, fuel - 1, 1)) && is_liftable(app->rand2, bind_count, fuel - 1, 1))
return 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: default:
if (t > _scheme_compiled_values_types_) if (t > _scheme_compiled_values_types_)
return 1; return 1;