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

fix over-eager bytecode transformation

Browse Source
This commit is contained in:
Matthew Flatt 2011-08-15 09:36:38 -06:00
parent 40197835c9
commit 8989e810fb
2 changed files with 34 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
collects/tests/racket/optimize.rktl
View File

@ -849,6 +849,17 @@
(error "bad") (error "bad")
(equal? (list* w z) (list* z w)))) (equal? (list* w z) (list* z w))))
;; Ok to move `box' past a side effect:
(test-comp '(let ([h (box 0.0)])
(list (printf "hi\n") h))
'(list (printf "hi\n") (box 0.0)))
;; Don't move `box' past a `lambda':
(test-comp '(let ([h (box 0.0)])
(lambda () h))
'(lambda () (box 0.0))
#f)
(test-comp '(let ([x 1][y 2]) x) (test-comp '(let ([x 1][y 2]) x)
'1) '1)
(test-comp '(let ([x 1][y 2]) (+ y x)) (test-comp '(let ([x 1][y 2]) (+ y x))

41
src/racket/src/optimize.c
View File

@ -118,6 +118,7 @@ typedef struct Scheme_Once_Used {
int used; int used;
int delta; int delta;
int cross_lambda;
Optimize_Info *info; Optimize_Info *info;
struct Scheme_Once_Used *next; struct Scheme_Once_Used *next;
@ -522,26 +523,29 @@ static int single_valued_noncm_expression(Scheme_Object *expr, int fuel)
return 0; return 0;
} }
static int is_movable_prim(Scheme_Object *rator, int n) static int is_movable_prim(Scheme_Object *rator, int n, int cross_lambda)
{ {
if (rator && SCHEME_PRIMP(rator)) { if (rator && SCHEME_PRIMP(rator)) {
if (((Scheme_Prim_Proc_Header *)rator)->flags & SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL) if (((Scheme_Prim_Proc_Header *)rator)->flags & SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL)
return 1; return 1;
} }
if (SAME_OBJ(scheme_void_proc, rator) if (SAME_OBJ(scheme_void_proc, rator))
|| SAME_OBJ(scheme_list_proc, rator) return 1;
|| (SAME_OBJ(scheme_cons_proc, rator) && (n == 2))
|| SAME_OBJ(scheme_list_star_proc, rator) if (!cross_lambda
|| SAME_OBJ(scheme_vector_proc, rator) && (SAME_OBJ(scheme_list_proc, rator)
|| SAME_OBJ(scheme_vector_immutable_proc, rator) || (SAME_OBJ(scheme_cons_proc, rator) && (n == 2))
|| (SAME_OBJ(scheme_box_proc, rator) && (n == 1))) || SAME_OBJ(scheme_list_star_proc, rator)
|| SAME_OBJ(scheme_vector_proc, rator)
|| SAME_OBJ(scheme_vector_immutable_proc, rator)
|| (SAME_OBJ(scheme_box_proc, rator) && (n == 1))))
return 1; return 1;
return 0; return 0;
} }
static int movable_expression(Scheme_Object *expr, Optimize_Info *info, int delta, int fuel) static int movable_expression(Scheme_Object *expr, Optimize_Info *info, int delta, int cross_lambda, int fuel)
/* An expression that can't necessarily be constant-folded, /* An expression that can't necessarily be constant-folded,
but can be delayed because it has no side-effects (or is unsafe); but can be delayed because it has no side-effects (or is unsafe);
also not sensitive to being in tail position */ also not sensitive to being in tail position */
@ -560,25 +564,25 @@ static int movable_expression(Scheme_Object *expr, Optimize_Info *info, int delt
} }
break; break;
case scheme_application_type: case scheme_application_type:
if (is_movable_prim(((Scheme_App_Rec *)expr)->args[0], ((Scheme_App_Rec *)expr)->num_args)) { if (is_movable_prim(((Scheme_App_Rec *)expr)->args[0], ((Scheme_App_Rec *)expr)->num_args, cross_lambda)) {
int i; int i;
for (i = ((Scheme_App_Rec *)expr)->num_args; i--; ) { for (i = ((Scheme_App_Rec *)expr)->num_args; i--; ) {
if (!movable_expression(((Scheme_App_Rec *)expr)->args[i+1], info, delta, fuel - 1)) if (!movable_expression(((Scheme_App_Rec *)expr)->args[i+1], info, delta, cross_lambda, fuel - 1))
return 0; return 0;
} }
return 1; return 1;
} }
break; break;
case scheme_application2_type: case scheme_application2_type:
if (is_movable_prim(((Scheme_App2_Rec *)expr)->rator, 1)) { if (is_movable_prim(((Scheme_App2_Rec *)expr)->rator, 1, cross_lambda)) {
if (movable_expression(((Scheme_App2_Rec *)expr)->rand, info, delta, fuel - 1)) if (movable_expression(((Scheme_App2_Rec *)expr)->rand, info, delta, cross_lambda, fuel - 1))
return 1; return 1;
} }
break; break;
case scheme_application3_type: case scheme_application3_type:
if (is_movable_prim(((Scheme_App3_Rec *)expr)->rator, 2)) { if (is_movable_prim(((Scheme_App3_Rec *)expr)->rator, 2, cross_lambda)) {
if (movable_expression(((Scheme_App3_Rec *)expr)->rand1, info, delta, fuel - 1) if (movable_expression(((Scheme_App3_Rec *)expr)->rand1, info, delta, cross_lambda, fuel - 1)
&& movable_expression(((Scheme_App3_Rec *)expr)->rand2, info, delta, fuel - 1)) && movable_expression(((Scheme_App3_Rec *)expr)->rand2, info, delta, cross_lambda, fuel - 1))
return 1; return 1;
} }
break; break;
@ -4902,7 +4906,7 @@ Scheme_Object *scheme_optimize_expr(Scheme_Object *expr, Optimize_Info *info, in
if (((o->vclock == info->vclock) if (((o->vclock == info->vclock)
&& single_valued_noncm_expression(o->expr, 5)) && single_valued_noncm_expression(o->expr, 5))
|| ((o->vclock != info->vclock) || ((o->vclock != info->vclock)
&& movable_expression(o->expr, info, o->delta, 5))) { && movable_expression(o->expr, info, o->delta, o->cross_lambda, 5))) {
val = scheme_optimize_clone(1, o->expr, info, o->delta, 0); val = scheme_optimize_clone(1, o->expr, info, o->delta, 0);
if (val) { if (val) {
info->size -= 1; info->size -= 1;
@ -5797,7 +5801,7 @@ static Scheme_Object *do_optimize_info_lookup(Optimize_Info *info, int pos, int
int disrupt_single_use, int *is_mutated, int just_test) int disrupt_single_use, int *is_mutated, int just_test)
{ {
Scheme_Object *p, *n; Scheme_Object *p, *n;
int delta = 0; int delta = 0, orig_j = j;
while (info) { while (info) {
if (info->flags & SCHEME_LAMBDA_FRAME) if (info->flags & SCHEME_LAMBDA_FRAME)
@ -5871,6 +5875,7 @@ static Scheme_Object *do_optimize_info_lookup(Optimize_Info *info, int pos, int
o->delta = delta; o->delta = delta;
o->info = info; o->info = info;
o->cross_lambda = (j != orig_j);
return (Scheme_Object *)o; return (Scheme_Object *)o;
} else if (SAME_TYPE(SCHEME_TYPE(n), scheme_local_type)) { } else if (SAME_TYPE(SCHEME_TYPE(n), scheme_local_type)) {
int pos; int pos;