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

optimizer: reorganize & generalize dropping of ignored operations

Browse Source 
The optimizer was willing to convert `(pair? (cons w (random)))` to
`(begin (random) #t)`, but not `(car (cons w (random)))` to
`(begin (random) w)` because the `(car (cons ....))` transformation
required simple ignored arguments. Put the treatment of ignored,
non-omittable arguments of a dropped operation in one place. Also,
recognize expressions within `begin` whose results will be ignored.
This commit is contained in:
Matthew Flatt 2014-06-19 11:37:48 +01:00
parent 2faed269f3
commit 23f6d1a651
4 changed files with 266 additions and 138 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
pkgs/racket-pkgs/racket-test/tests/racket/optimize.rktl
View File

@ -1209,6 +1209,26 @@
(unsafe-cdr w))) (unsafe-cdr w)))
#f) #f)
(test-comp '(lambda (w z) (box? (list (cons (random w) z))))
'(lambda (w z) (random w) #f))
(test-comp '(lambda (w)
(car (cons w (random))))
'(lambda (w)
(begin (random) w)))
(test-comp '(lambda (w)
(begin
(list (random) w)
17))
'(lambda (w)
(begin (random) 17)))
(test-comp '(lambda (w)
(begin0
17
(list (random) w)))
'(lambda (w)
(begin0 17 (random))))
;; Ok to move `box' past a side effect (that can't capture a ;; Ok to move `box' past a side effect (that can't capture a
;; resumable continuation): ;; resumable continuation):
(test-comp '(let ([h (box 0.0)]) (test-comp '(let ([h (box 0.0)])

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

@ -130,6 +130,12 @@ static Scheme_Object *optimize_clone(int dup_ok, Scheme_Object *obj, Optimize_In
static Scheme_Object *optimize_shift(Scheme_Object *obj, int delta, int after_depth); static Scheme_Object *optimize_shift(Scheme_Object *obj, int delta, int after_depth);
static int relevant_predicate(Scheme_Object *pred); static int relevant_predicate(Scheme_Object *pred);
static int single_valued_noncm_expression(Scheme_Object *expr, int fuel);
static Scheme_Object *optimize_ignored(Scheme_Object *e, Optimize_Info *info, int expected_vals, int maybe_omittable,
int fuel);
static int movable_expression(Scheme_Object *expr, Optimize_Info *info, int delta,
int cross_lambda, int cross_k,
int check_space, int fuel);
#define IS_COMPILED_PROC(vals_expr) (SAME_TYPE(SCHEME_TYPE(vals_expr), scheme_compiled_unclosed_procedure_type) \ #define IS_COMPILED_PROC(vals_expr) (SAME_TYPE(SCHEME_TYPE(vals_expr), scheme_compiled_unclosed_procedure_type) \
|| SAME_TYPE(SCHEME_TYPE(vals_expr), scheme_case_lambda_sequence_type)) || SAME_TYPE(SCHEME_TYPE(vals_expr), scheme_case_lambda_sequence_type))
@ -168,7 +174,7 @@ void scheme_init_optimize()
/* utils */ /* utils */
/*========================================================================*/ /*========================================================================*/
int scheme_is_functional_primitive(Scheme_Object *rator, int num_args, int expected_vals) int scheme_is_functional_nonfailing_primitive(Scheme_Object *rator, int num_args, int expected_vals)
/* return 2 => results are a constant when arguments are constants */ /* return 2 => results are a constant when arguments are constants */
{ {
if (SCHEME_PRIMP(rator) if (SCHEME_PRIMP(rator)
@ -388,7 +394,7 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved,
note_match(5, vals, warn_info); note_match(5, vals, warn_info);
} }
if (scheme_is_functional_primitive(app->args[0], app->num_args, vals) if (scheme_is_functional_nonfailing_primitive(app->args[0], app->num_args, vals)
|| scheme_is_struct_functional(app->args[0], app->num_args, opt_info, vals)) { || scheme_is_struct_functional(app->args[0], app->num_args, opt_info, vals)) {
int i; int i;
for (i = app->num_args; i--; ) { for (i = app->num_args; i--; ) {
@ -410,7 +416,7 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved,
if (vtype == scheme_application2_type) { if (vtype == scheme_application2_type) {
Scheme_App2_Rec *app = (Scheme_App2_Rec *)o; Scheme_App2_Rec *app = (Scheme_App2_Rec *)o;
if (scheme_is_functional_primitive(app->rator, 1, vals) if (scheme_is_functional_nonfailing_primitive(app->rator, 1, vals)
|| scheme_is_struct_functional(app->rator, 1, opt_info, vals)) { || scheme_is_struct_functional(app->rator, 1, opt_info, vals)) {
if (scheme_omittable_expr(app->rand, 1, fuel - 1, resolved, opt_info, warn_info, if (scheme_omittable_expr(app->rand, 1, fuel - 1, resolved, opt_info, warn_info,
deeper_than + (resolved ? 1 : 0), no_id)) deeper_than + (resolved ? 1 : 0), no_id))
@ -426,7 +432,7 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved,
if (vtype == scheme_application3_type) { if (vtype == scheme_application3_type) {
Scheme_App3_Rec *app = (Scheme_App3_Rec *)o; Scheme_App3_Rec *app = (Scheme_App3_Rec *)o;
if (scheme_is_functional_primitive(app->rator, 2, vals) if (scheme_is_functional_nonfailing_primitive(app->rator, 2, vals)
|| scheme_is_struct_functional(app->rator, 2, opt_info, vals)) { || scheme_is_struct_functional(app->rator, 2, opt_info, vals)) {
if (scheme_omittable_expr(app->rand1, 1, fuel - 1, resolved, opt_info, warn_info, if (scheme_omittable_expr(app->rand1, 1, fuel - 1, resolved, opt_info, warn_info,
deeper_than + (resolved ? 2 : 0), no_id) deeper_than + (resolved ? 2 : 0), no_id)
@ -471,6 +477,163 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved,
return 0; return 0;
} }
static Scheme_Object *ensure_single_value(Scheme_Object *e)
{
Scheme_App2_Rec *app2;
app2 = MALLOC_ONE_TAGGED(Scheme_App2_Rec);
app2->iso.so.type = scheme_application2_type;
app2->rator = scheme_values_func;
app2->rand = e;
SCHEME_APPN_FLAGS(app2) |= (APPN_FLAG_IMMED | APPN_FLAG_SFS_TAIL);
return (Scheme_Object *)app2;
}
static Scheme_Object *do_make_discarding_sequence(Scheme_Object *e1, Scheme_Object *e2, Optimize_Info *info,
int ignored, int rev)
/* Evaluate `e1` then `e2` (or opposite order if rev), and each must
produce a single value. The result of `e1` is ignored and the
result is `e2` --- except that `e2` is ignored, too, if
`ignored`. */
{
int e2_omit;
e2_omit = scheme_omittable_expr(e2, 1, 5, 0, info, NULL, -1, 0);
if (!e2_omit && !single_valued_noncm_expression(e2, 5))
e2 = ensure_single_value(e2);
if (scheme_omittable_expr(e1, 1, 5, 0, info, NULL, -1, 0))
return e2;
else if (single_valued_noncm_expression(e1, 5))
e1 = optimize_ignored(e1, info, 1, 0, 5);
else
e1 = ensure_single_value(optimize_ignored(e1, info, 1, 0, 5));
if (e2_omit && ignored)
return e1;
/* use `begin` instead of `begin0` if we can swap the order: */
if (rev && movable_expression(e2, info, 0, 0, 0, 0, 50))
rev = 0;
return scheme_make_sequence_compilation(scheme_make_pair((rev ? e2 : e1),
scheme_make_pair((rev ? e1 : e2), scheme_null)),
rev ? -1 : 1);
}
static Scheme_Object *make_discarding_sequence(Scheme_Object *e1, Scheme_Object *e2, Optimize_Info *info)
{
return do_make_discarding_sequence(e1, e2, info, 0, 0);
}
static Scheme_Object *make_discarding_reverse_sequence(Scheme_Object *e1, Scheme_Object *e2, Optimize_Info *info)
{
return do_make_discarding_sequence(e1, e2, info, 0, 1);
}
static Scheme_Object *make_discarding_app_sequence(Scheme_App_Rec *appr, int result_pos, Scheme_Object *result,
Optimize_Info *info)
/* Generalize do_make_discarding_sequence() to a sequence of argument
expressions, where `result_pos` is the position of the returned
argument. If `result_pos` is -1, then all argument results will be
ignored. If `result`, then it is used as the result after all
arguments are evaluated.*/
{
int i;
Scheme_Object *e, *l = scheme_null;
result_pos = result_pos + 1;
if (result)
l = scheme_make_pair(result, l);
for (i = appr->num_args; i; i--) {
e = appr->args[i];
if (scheme_omittable_expr(e, 1, 5, 0, info, NULL, -1, 0)) {
/* drop if not result pos */
} else if (single_valued_noncm_expression(e, 5)) {
if (i != result_pos) {
l = scheme_make_pair(optimize_ignored(e, info, 1, 0, 5), l);
}
} else if (i == result_pos) {
e = ensure_single_value(e);
} else if (i != result_pos) {
e = ensure_single_value(optimize_ignored(e, info, 1, 0, 5));
l = scheme_make_pair(e, l);
}
if (i == result_pos) {
if (SCHEME_NULLP(l)) {
l = scheme_make_pair(e, scheme_null);
} else {
l = scheme_make_sequence_compilation(scheme_make_pair(e, l), -1);
l = scheme_make_pair(l, scheme_null);
}
}
}
if (SCHEME_NULLP(l))
return scheme_void;
if (SCHEME_NULLP(SCHEME_CDR(l)))
return SCHEME_CAR(l);
return scheme_make_sequence_compilation(l, 1);
}
static Scheme_Object *optimize_ignored(Scheme_Object *e, Optimize_Info *info, int expected_vals, int maybe_omittable,
int fuel)
/* Simplify an expression whose result will be ignored. The
`expected_vals` is 1 or -1. If `maybe_omittable`, the result can be
NULL to dincate that it can be omitted. */
{
if (maybe_omittable) {
if (scheme_omittable_expr(e, expected_vals, 5, 0, info, NULL, -1, 0))
return NULL;
}
if (fuel) {
/* We could do a lot more here, but for now, we just avoid purely
functional, always successful operations --- especially allocating ones. */
switch (SCHEME_TYPE(e)) {
case scheme_application2_type:
{
Scheme_App2_Rec *app = (Scheme_App2_Rec *)e;
if (!SAME_TYPE(app->rator, scheme_values_func)) /* `values` is probably here to ensure a single result */
if (scheme_is_functional_nonfailing_primitive(app->rator, 1, expected_vals))
return do_make_discarding_sequence(app->rand, scheme_void, info, 1, 0);
}
break;
case scheme_application3_type:
{
Scheme_App3_Rec *app = (Scheme_App3_Rec *)e;
if (scheme_is_functional_nonfailing_primitive(app->rator, 2, expected_vals))
return do_make_discarding_sequence(app->rand1,
do_make_discarding_sequence(app->rand2,
scheme_void,
info,
1, 0),
info,
1, 0);
}
break;
case scheme_application_type:
{
Scheme_App_Rec *app = (Scheme_App_Rec *)e;
if (scheme_is_functional_nonfailing_primitive(app->args[0], app->num_args, expected_vals))
return make_discarding_app_sequence(app, -1, NULL, info);
}
break;
}
}
return e;
}
static int is_inspector_call(Scheme_Object *a) static int is_inspector_call(Scheme_Object *a)
{ {
if (SAME_TYPE(SCHEME_TYPE(a), scheme_application_type)) { if (SAME_TYPE(SCHEME_TYPE(a), scheme_application_type)) {
@ -2513,9 +2676,8 @@ static Scheme_Object *try_reduce_predicate(Scheme_Object *rator, Scheme_Object *
known predicates against the results of some known constructors, because known predicates against the results of some known constructors, because
it's especially nice to avoid the constructions. */ it's especially nice to avoid the constructions. */
{ {
int i, count, matches; int matches;
Scheme_Object *arg, *pred; Scheme_Object *pred;
Scheme_Sequence *s;
if (!SCHEME_PRIMP(arg_rator)) if (!SCHEME_PRIMP(arg_rator))
return NULL; return NULL;
@ -2535,51 +2697,16 @@ static Scheme_Object *try_reduce_predicate(Scheme_Object *rator, Scheme_Object *
matches = SAME_OBJ(rator, pred); matches = SAME_OBJ(rator, pred);
count = 0; if (arg_app2)
return make_discarding_sequence(arg_app2->rand, (matches ? scheme_true : scheme_false), info);
for (i = 0; i < argc; i++) { else if (arg_app3)
if (arg_app2) return make_discarding_sequence(arg_app3->rand1,
arg = arg_app2->rand; make_discarding_sequence(arg_app3->rand2,
else if (arg_app3) (matches ? scheme_true : scheme_false),
arg = (i ? arg_app3->rand2 : arg_app3->rand1); info),
else info);
arg = arg_app->args[i+1]; else
return make_discarding_app_sequence(arg_app, -1, (matches ? scheme_true : scheme_false), info);
if (!scheme_omittable_expr(arg, 1, -1, 0, info, info, -1, 0))
count++;
}
if (!count)
return (matches ? scheme_true : scheme_false);
s = scheme_malloc_sequence(count+1);
s->so.type = scheme_sequence_type;
s->count = count+1;
count = 0;
for (i = 0; i < argc; i++) {
if (arg_app2)
arg = arg_app2->rand;
else if (arg_app3)
arg = (i ? arg_app3->rand2 : arg_app3->rand1);
else
arg = arg_app->args[i+1];
if (!scheme_omittable_expr(arg, 1, -1, 0, info, info, -1, 0)) {
if (!single_valued_noncm_expression(arg, 5)) {
/* wrap with `values` create a single-value context */
arg = scheme_make_application(scheme_make_pair(scheme_values_func,
scheme_make_pair(arg, scheme_null)),
info);
}
s->array[count++] = arg;
}
}
s->array[count++] = (matches ? scheme_true : scheme_false);
return (Scheme_Object *)s;
} }
static Scheme_Object *optimize_application2(Scheme_Object *o, Optimize_Info *info, int context) static Scheme_Object *optimize_application2(Scheme_Object *o, Optimize_Info *info, int context)
@ -2729,14 +2856,10 @@ static Scheme_Object *finish_optimize_application2(Scheme_App2_Rec *app, Optimiz
if (SAME_OBJ(scheme_list_proc, app2->rator)) { if (SAME_OBJ(scheme_list_proc, app2->rator)) {
if (IS_NAMED_PRIM(app->rator, "car")) { if (IS_NAMED_PRIM(app->rator, "car")) {
/* (car (list X)) */ /* (car (list X)) */
if (scheme_omittable_expr(app2->rand, 1, 5, 0, info, NULL, -1, 0) alt = make_discarding_sequence(scheme_void, app2->rand, info);
|| single_valued_noncm_expression(app2->rand, 5)) {
alt = app2->rand;
}
} else if (IS_NAMED_PRIM(app->rator, "cdr")) { } else if (IS_NAMED_PRIM(app->rator, "cdr")) {
/* (cdr (list X)) */ /* (cdr (list X)) */
if (scheme_omittable_expr(app2->rand, 1, 5, 0, info, NULL, -1, 0)) alt = make_discarding_sequence(app2->rand, scheme_null, info);
alt = scheme_null;
} }
} }
if (!alt) if (!alt)
@ -2749,11 +2872,7 @@ static Scheme_Object *finish_optimize_application2(Scheme_App2_Rec *app, Optimiz
|| SAME_OBJ(scheme_list_proc, app3->rator) || SAME_OBJ(scheme_list_proc, app3->rator)
|| SAME_OBJ(scheme_list_star_proc, app3->rator)) { || SAME_OBJ(scheme_list_star_proc, app3->rator)) {
/* (car ({cons|list|list*} X Y)) */ /* (car ({cons|list|list*} X Y)) */
if ((scheme_omittable_expr(app3->rand1, 1, 5, 0, info, NULL, -1, 0) alt = make_discarding_reverse_sequence(app3->rand2, app3->rand1, info);
|| single_valued_noncm_expression(app3->rand1, 5))
&& scheme_omittable_expr(app3->rand2, 1, 5, 0, info, NULL, -1, 0)) {
alt = app3->rand1;
}
} }
} else if (IS_NAMED_PRIM(app->rator, "cdr")) { } else if (IS_NAMED_PRIM(app->rator, "cdr")) {
/* (cdr ({cons|list|list*} X Y)) */ /* (cdr ({cons|list|list*} X Y)) */
@ -2761,27 +2880,20 @@ static Scheme_Object *finish_optimize_application2(Scheme_App2_Rec *app, Optimiz
|| SAME_OBJ(scheme_unsafe_cons_list_proc, app3->rator) || SAME_OBJ(scheme_unsafe_cons_list_proc, app3->rator)
|| SAME_OBJ(scheme_list_proc, app3->rator) || SAME_OBJ(scheme_list_proc, app3->rator)
|| SAME_OBJ(scheme_list_star_proc, app3->rator)) { || SAME_OBJ(scheme_list_star_proc, app3->rator)) {
if ((scheme_omittable_expr(app3->rand2, 1, 5, 0, info, NULL, -1, 0) if (SAME_OBJ(scheme_list_proc, app3->rator)) {
|| single_valued_noncm_expression(app3->rand2, 5)) alt = scheme_make_application(scheme_make_pair(scheme_list_proc,
&& scheme_omittable_expr(app3->rand1, 1, 5, 0, info, NULL, -1, 0)) { scheme_make_pair(app3->rand2,
if (SAME_OBJ(scheme_list_proc, app3->rator)) { scheme_null)),
alt = scheme_make_application(scheme_make_pair(scheme_list_proc, info);
scheme_make_pair(app3->rand2, SCHEME_APPN_FLAGS(((Scheme_App_Rec *)alt)) |= (APPN_FLAG_IMMED | APPN_FLAG_SFS_TAIL);
scheme_null)), alt = make_discarding_sequence(app3->rand1, alt, info);
info); } else
SCHEME_APPN_FLAGS(((Scheme_App_Rec *)alt)) |= (APPN_FLAG_IMMED | APPN_FLAG_SFS_TAIL); alt = make_discarding_sequence(app3->rand1, app3->rand2, info);
} else
alt = app3->rand2;
}
} }
} else if (IS_NAMED_PRIM(app->rator, "cadr")) { } else if (IS_NAMED_PRIM(app->rator, "cadr")) {
if (SAME_OBJ(scheme_list_proc, app3->rator)) { if (SAME_OBJ(scheme_list_proc, app3->rator)) {
/* (cadr (list X Y)) */ /* (cadr (list X Y)) */
if ((scheme_omittable_expr(app3->rand2, 1, 5, 0, info, NULL, -1, 0) alt = make_discarding_sequence(app3->rand1, app3->rand2, info);
|| single_valued_noncm_expression(app3->rand2, 5))
&& scheme_omittable_expr(app3->rand1, 1, 5, 0, info, NULL, -1, 0)) {
alt = app3->rand2;
}
} }
} else } else
alt = try_reduce_predicate(app->rator, app3->rator, 2, NULL, app3, NULL, info); alt = try_reduce_predicate(app->rator, app3->rator, 2, NULL, app3, NULL, info);
@ -2793,32 +2905,22 @@ static Scheme_Object *finish_optimize_application2(Scheme_App2_Rec *app, Optimiz
&& (SAME_OBJ(scheme_list_proc, r) && (SAME_OBJ(scheme_list_proc, r)
|| SAME_OBJ(scheme_list_star_proc, r))) { || SAME_OBJ(scheme_list_star_proc, r))) {
/* (car ({list|list*} X Y ...)) */ /* (car ({list|list*} X Y ...)) */
if (scheme_omittable_expr(appr->args[1], 1, 5, 0, info, NULL, -1, 0) alt = make_discarding_app_sequence(appr, 0, NULL, info);
|| single_valued_noncm_expression(appr->args[1], 5)) {
int k;
for (k = appr->num_args; k > 1; k--) {
if (!scheme_omittable_expr(appr->args[k], 1, 5, 0, info, NULL, -1, 0))
break;
}
if (k <= 1)
alt = appr->args[1];
}
} }
} else if (IS_NAMED_PRIM(app->rator, "cdr")) { } else if (IS_NAMED_PRIM(app->rator, "cdr")) {
/* (cdr ({list|list*} X Y ...)) */ /* (cdr ({list|list*} X Y ...)) */
if ((appr->args > 0) if ((appr->args > 0)
&& (SAME_OBJ(scheme_list_proc, r) && (SAME_OBJ(scheme_list_proc, r)
|| SAME_OBJ(scheme_list_star_proc, r))) { || SAME_OBJ(scheme_list_star_proc, r))) {
if (scheme_omittable_expr(appr->args[1], 1, 5, 0, info, NULL, -1, 0)) { Scheme_Object *al = scheme_null;
Scheme_Object *al = scheme_null; int k;
int k; for (k = appr->num_args; k > 1; k--) {
for (k = appr->num_args; k > 1; k--) { al = scheme_make_pair(appr->args[k], al);
al = scheme_make_pair(appr->args[k], al);
}
al = scheme_make_pair(r, al);
alt = scheme_make_application(al, info);
SCHEME_APPN_FLAGS(((Scheme_App_Rec *)alt)) |= (APPN_FLAG_IMMED | APPN_FLAG_SFS_TAIL);
} }
al = scheme_make_pair(r, al);
alt = scheme_make_application(al, info);
SCHEME_APPN_FLAGS(((Scheme_App_Rec *)alt)) |= (APPN_FLAG_IMMED | APPN_FLAG_SFS_TAIL);
alt = make_discarding_sequence(appr->args[1], alt, info);
} }
} else } else
alt = try_reduce_predicate(app->rator, appr->args[0], appr->num_args, NULL, NULL, appr, info); alt = try_reduce_predicate(app->rator, appr->args[0], appr->num_args, NULL, NULL, appr, info);
@ -3036,27 +3138,28 @@ static Scheme_Object *finish_optimize_application3(Scheme_App3_Rec *app, Optimiz
return app->rand1; return app->rand1;
} else if (IS_NAMED_PRIM(app->rator, "unsafe-fx*")) { } else if (IS_NAMED_PRIM(app->rator, "unsafe-fx*")) {
if (z1 || z2) { if (z1 || z2) {
if ((z1 && z2) if (z1 && z2)
|| (!z1 && scheme_omittable_expr(app->rand1, 1, 20, 0, info, NULL, -1, 0))
|| (!z2 && scheme_omittable_expr(app->rand2, 1, 20, 0, info, NULL, -1, 0)))
return scheme_make_integer(0); return scheme_make_integer(0);
else if (z2)
return make_discarding_sequence(app->rand1, scheme_make_integer(0), info);
else
return make_discarding_sequence(app->rand2, scheme_make_integer(0), info);
} }
if (SAME_OBJ(app->rand1, scheme_make_integer(1))) if (SAME_OBJ(app->rand1, scheme_make_integer(1)))
return app->rand2; return app->rand2;
if (SAME_OBJ(app->rand2, scheme_make_integer(1))) if (SAME_OBJ(app->rand2, scheme_make_integer(1)))
return app->rand1; return app->rand1;
} else if (IS_NAMED_PRIM(app->rator, "unsafe-fxquotient")) { } else if (IS_NAMED_PRIM(app->rator, "unsafe-fxquotient")) {
if (z1 && scheme_omittable_expr(app->rand2, 1, 20, 0, info, NULL, -1, 0)) if (z1)
return scheme_make_integer(0); return make_discarding_sequence(app->rand2, scheme_make_integer(0), info);
if (SAME_OBJ(app->rand2, scheme_make_integer(1))) if (SAME_OBJ(app->rand2, scheme_make_integer(1)))
return app->rand1; return app->rand1;
} else if (IS_NAMED_PRIM(app->rator, "unsafe-fxremainder") } else if (IS_NAMED_PRIM(app->rator, "unsafe-fxremainder")
|| IS_NAMED_PRIM(app->rator, "unsafe-fxmodulo")) { || IS_NAMED_PRIM(app->rator, "unsafe-fxmodulo")) {
if (z1 && scheme_omittable_expr(app->rand2, 1, 20, 0, info, NULL, -1, 0)) if (z1)
return scheme_make_integer(0); return make_discarding_sequence(app->rand2, scheme_make_integer(0), info);
if (SAME_OBJ(app->rand2, scheme_make_integer(1)) if (SAME_OBJ(app->rand2, scheme_make_integer(1)))
&& scheme_omittable_expr(app->rand1, 1, 20, 0, info, NULL, -1, 0)) return make_discarding_sequence(app->rand1, scheme_make_integer(0), info);
return scheme_make_integer(0);
} }
z1 = (SCHEME_FLOATP(app->rand1) && (SCHEME_FLOAT_VAL(app->rand1) == 0.0)); z1 = (SCHEME_FLOATP(app->rand1) && (SCHEME_FLOAT_VAL(app->rand1) == 0.0));
@ -3240,10 +3343,11 @@ static Scheme_Object *optimize_sequence(Scheme_Object *o, Optimize_Info *info, i
preserves_marks = info->preserves_marks; preserves_marks = info->preserves_marks;
} }
/* Inlining and constant propagation can expose /* Inlining and constant propagation can expose omittable expressions. */
omittable expressions. */ if (i + 1 != count)
if ((i + 1 != count) le = optimize_ignored(le, info, -1, 1, 5);
&& scheme_omittable_expr(le, -1, -1, 0, info, NULL, -1, 0)) {
if (!le) {
drop++; drop++;
info->size = prev_size; info->size = prev_size;
s->array[i] = NULL; s->array[i] = NULL;
@ -3388,6 +3492,16 @@ static Scheme_Object *make_sequence_2(Scheme_Object *a, Scheme_Object *b)
return scheme_make_sequence_compilation(scheme_make_pair(a, scheme_make_pair(b, scheme_null)), 1); return scheme_make_sequence_compilation(scheme_make_pair(a, scheme_make_pair(b, scheme_null)), 1);
} }
static Scheme_Object *simplify_boolean(Scheme_Object *t, Optimize_Info *info)
{
if (expr_implies_predicate(t, info, 0, 5)) {
/* all predicates recognize non-#f things */
return make_discarding_sequence(t, scheme_true, info);
}
return t;
}
static Scheme_Object *optimize_branch(Scheme_Object *o, Optimize_Info *info, int context) static Scheme_Object *optimize_branch(Scheme_Object *o, Optimize_Info *info, int context)
{ {
Scheme_Branch_Rec *b; Scheme_Branch_Rec *b;
@ -3433,6 +3547,8 @@ static Scheme_Object *optimize_branch(Scheme_Object *o, Optimize_Info *info, int
break; break;
} }
t = simplify_boolean(t, info);
/* Try to lift out `let`s and `begin`s around a test: */ /* Try to lift out `let`s and `begin`s around a test: */
{ {
Scheme_Object *inside = NULL, *t2 = t; Scheme_Object *inside = NULL, *t2 = t;
@ -3479,20 +3595,12 @@ static Scheme_Object *optimize_branch(Scheme_Object *o, Optimize_Info *info, int
init_kclock = info->kclock; init_kclock = info->kclock;
if (SCHEME_TYPE(t) > _scheme_compiled_values_types_) { if (SCHEME_TYPE(t) > _scheme_compiled_values_types_) {
/* Branch is statically known */
info->size -= 1; info->size -= 1;
if (SCHEME_FALSEP(t)) if (SCHEME_FALSEP(t))
return scheme_optimize_expr(fb, info, scheme_optimize_tail_context(context)); return scheme_optimize_expr(fb, info, scheme_optimize_tail_context(context));
else else
return scheme_optimize_expr(tb, info, scheme_optimize_tail_context(context)); return scheme_optimize_expr(tb, info, scheme_optimize_tail_context(context));
} else if (expr_implies_predicate(t, info, 0, 5)) {
/* all predicates recognize non-#f things */
tb = scheme_optimize_expr(tb, info, scheme_optimize_tail_context(context));
if (scheme_omittable_expr(t, 1, -1, 0, info, info, -1, 0)) {
info->size -= 1; /* could be more precise for better for procedure size */
return tb;
} else {
return make_sequence_2(t, tb);
}
} }
old_types = info->types; old_types = info->types;
@ -3543,10 +3651,9 @@ static Scheme_Object *optimize_branch(Scheme_Object *o, Optimize_Info *info, int
} }
/* Try optimize: (if <omitable-expr> v v) => v */ /* Try optimize: (if <omitable-expr> v v) => v */
if (scheme_omittable_expr(t, 1, 20, 0, info, NULL, -1, 0) if (equivalent_exprs(tb, fb)) {
&& equivalent_exprs(tb, fb)) { info->size -= 1; /* could be more precise */
info->size -= 2; /* could be more precise */ return make_discarding_sequence(t, tb, info);
return tb;
} }
/* Convert: (if (if M N #f) M2 K) => (if M (if N M2 K) K) /* Convert: (if (if M N #f) M2 K) => (if M (if N M2 K) K)
@ -3605,9 +3712,8 @@ static Scheme_Object *optimize_wcm(Scheme_Object *o, Optimize_Info *info, int co
b = scheme_optimize_expr(wcm->body, info, scheme_optimize_tail_context(context)); b = scheme_optimize_expr(wcm->body, info, scheme_optimize_tail_context(context));
if (omittable_key(k, info) if (omittable_key(k, info)
&& scheme_omittable_expr(v, 1, 20, 0, info, info, -1, 0)
&& scheme_omittable_expr(b, -1, 20, 0, info, info, -1, 0)) && scheme_omittable_expr(b, -1, 20, 0, info, info, -1, 0))
return b; return make_discarding_sequence(v, b, info);
/* info->single_result is already set */ /* info->single_result is already set */
info->preserves_marks = 0; info->preserves_marks = 0;
@ -3942,9 +4048,11 @@ begin0_optimize(Scheme_Object *obj, Optimize_Info *info, int context)
if (!i) if (!i)
single_result = info->single_result; single_result = info->single_result;
/* Inlining and constant propagation can expose /* Inlining and constant propagation can expose omittable expressions: */
omittable expressions. */ if (i)
if (i && scheme_omittable_expr(le, -1, -1, 0, info, NULL, -1, 0)) { le = optimize_ignored(le, info, -1, 1, 5);
if (!le) {
drop++; drop++;
info->size = prev_size; info->size = prev_size;
s->array[i] = NULL; s->array[i] = NULL;

2
racket/src/racket/src/schpriv.h
View File

@ -3097,7 +3097,7 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved,
Optimize_Info *opt_info, Optimize_Info *warn_info, int deeper_than, int no_id); Optimize_Info *opt_info, Optimize_Info *warn_info, int deeper_than, int no_id);
int scheme_might_invoke_call_cc(Scheme_Object *value); int scheme_might_invoke_call_cc(Scheme_Object *value);
int scheme_is_liftable(Scheme_Object *o, int bind_count, int fuel, int as_rator, int or_escape); int scheme_is_liftable(Scheme_Object *o, int bind_count, int fuel, int as_rator, int or_escape);
int scheme_is_functional_primitive(Scheme_Object *rator, int num_args, int expected_vals); int scheme_is_functional_nonfailing_primitive(Scheme_Object *rator, int num_args, int expected_vals);
typedef struct { typedef struct {
int uses_super; int uses_super;

12
racket/src/racket/src/validate.c
View File

@ -1209,8 +1209,8 @@ static int validate_join_const(int result, int expected_results)
: 0)); : 0));
} }
static int is_functional_rator(Scheme_Object *rator, int num_args, int expected_results, static int is_functional_nonfailing_rator(Scheme_Object *rator, int num_args, int expected_results,
Scheme_Hash_Table **_st_ht) Scheme_Hash_Table **_st_ht)
{ {
if (_st_ht && *_st_ht && SAME_TYPE(SCHEME_TYPE(rator), scheme_toplevel_type)) { if (_st_ht && *_st_ht && SAME_TYPE(SCHEME_TYPE(rator), scheme_toplevel_type)) {
int flags = (SCHEME_TOPLEVEL_FLAGS(rator) & SCHEME_TOPLEVEL_FLAGS_MASK); int flags = (SCHEME_TOPLEVEL_FLAGS(rator) & SCHEME_TOPLEVEL_FLAGS_MASK);
@ -1232,7 +1232,7 @@ static int is_functional_rator(Scheme_Object *rator, int num_args, int expected_
} }
} }
return scheme_is_functional_primitive(rator, num_args, expected_results); return scheme_is_functional_nonfailing_primitive(rator, num_args, expected_results);
} }
#define CAN_RESET_STACK_SLOT 0 #define CAN_RESET_STACK_SLOT 0
@ -1539,7 +1539,7 @@ static int validate_expr(Mz_CPort *port, Scheme_Object *expr,
check_self_call_valid(app->args[0], port, vc, delta, stack); check_self_call_valid(app->args[0], port, vc, delta, stack);
if (result) { if (result) {
r = is_functional_rator(app->args[0], app->num_args, expected_results, _st_ht); r = is_functional_nonfailing_rator(app->args[0], app->num_args, expected_results, _st_ht);
result = validate_join(result, r); result = validate_join(result, r);
} }
} }
@ -1571,7 +1571,7 @@ static int validate_expr(Mz_CPort *port, Scheme_Object *expr,
check_self_call_valid(app->rator, port, vc, delta, stack); check_self_call_valid(app->rator, port, vc, delta, stack);
if (result) { if (result) {
r = is_functional_rator(app->rator, 1, expected_results, _st_ht); r = is_functional_nonfailing_rator(app->rator, 1, expected_results, _st_ht);
result = validate_join(result, r); result = validate_join(result, r);
} }
} }
@ -1609,7 +1609,7 @@ static int validate_expr(Mz_CPort *port, Scheme_Object *expr,
check_self_call_valid(app->rator, port, vc, delta, stack); check_self_call_valid(app->rator, port, vc, delta, stack);
if (result) { if (result) {
r = is_functional_rator(app->rator, 2, expected_results, _st_ht); r = is_functional_nonfailing_rator(app->rator, 2, expected_results, _st_ht);
result = validate_join(r, result); result = validate_join(r, result);
} }
} }