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

allow more expression reordering, especially unsafe ops

Browse Source
This commit is contained in:
Matthew Flatt 2011-07-07 16:57:17 -06:00
parent 65b1a569a0
commit 0e95d49ddb
2 changed files with 81 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -830,6 +830,15 @@
(car (cdr (car x)))))
'(lambda (w z) w))
(test-comp '(lambda (w z)
(let ([x (list* w z)]
[y (list* z w)])
(error "bad")
(equal? x y)))
'(lambda (w z)
(error "bad")
(equal? (list* w z) (list* z w))))
(test-comp '(let ([x 1][y 2]) x)
'1)
(test-comp '(let ([x 1][y 2]) (+ y x))

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

@ -521,6 +521,74 @@ static int single_valued_noncm_expression(Scheme_Object *expr, int fuel)
return 0;
}
static int is_movable_prim(Scheme_Object *rator, int n)
{
if (rator && SCHEME_PRIMP(rator)) {
if (((Scheme_Prim_Proc_Header *)rator)->flags & SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL)
return 1;
}
if (SAME_OBJ(scheme_void_proc, rator)
|| SAME_OBJ(scheme_list_proc, rator)
|| (SAME_OBJ(scheme_cons_proc, rator) && (n == 2))
|| 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 0;
}
static int movable_expression(Scheme_Object *expr, Optimize_Info *info, int delta, int fuel)
/* An expression that can't necessarily be constant-folded,
but can be delayed because it has no side-effects (or is unsafe);
also not sensitive to being in tail position */
{
if (fuel < 0) return 0;
switch (SCHEME_TYPE(expr)) {
case scheme_local_type:
{
/* Ok if not mutable */
int pos = SCHEME_LOCAL_POS(expr);
if (pos + delta < 0)
return 1;
else if (!optimize_is_mutated(info, pos + delta))
return 1;
}
break;
case scheme_application_type:
if (is_movable_prim(((Scheme_App_Rec *)expr)->args[0], ((Scheme_App_Rec *)expr)->num_args)) {
int i;
for (i = ((Scheme_App_Rec *)expr)->num_args; i--; ) {
if (!movable_expression(((Scheme_App_Rec *)expr)->args[i+1], info, delta, fuel - 1))
return 0;
}
return 1;
}
break;
case scheme_application2_type:
if (is_movable_prim(((Scheme_App2_Rec *)expr)->rator, 1)) {
if (movable_expression(((Scheme_App2_Rec *)expr)->rand, info, delta, fuel - 1))
return 1;
}
break;
case scheme_application3_type:
if (is_movable_prim(((Scheme_App3_Rec *)expr)->rator, 2)) {
if (movable_expression(((Scheme_App3_Rec *)expr)->rand1, info, delta, fuel - 1)
&& movable_expression(((Scheme_App3_Rec *)expr)->rand2, info, delta, fuel - 1))
return 1;
}
break;
default:
if (SCHEME_TYPE(expr) > _scheme_compiled_values_types_)
return 1;
}
return 0;
}
int scheme_is_compiled_procedure(Scheme_Object *o, int can_be_closed, int can_be_liftable)
{
if (SAME_TYPE(SCHEME_TYPE(o), scheme_compiled_unclosed_procedure_type)) {
@ -4772,8 +4840,10 @@ Scheme_Object *scheme_optimize_expr(Scheme_Object *expr, Optimize_Info *info, in
if (val) {
if (SAME_TYPE(SCHEME_TYPE(val), scheme_once_used_type)) {
Scheme_Once_Used *o = (Scheme_Once_Used *)val;
if ((o->vclock == info->vclock)
&& single_valued_noncm_expression(o->expr, 5)) {
if (((o->vclock == info->vclock)
&& single_valued_noncm_expression(o->expr, 5))
|| ((o->vclock != info->vclock)
&& movable_expression(o->expr, info, o->delta, 5))) {
val = scheme_optimize_clone(1, o->expr, info, o->delta, 0);
if (val) {
info->size -= 1;