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

optimizer: boolean conversion on app of predicate-matching primitives

Browse Source
This commit is contained in:
Matthew Flatt 2014-06-19 13:40:50 +01:00
parent 50ef3a8295
commit 780a825d34
2 changed files with 59 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1229,6 +1229,14 @@
'(lambda (w)
(begin0 17 (random))))
(test-comp '(lambda (w) (not (list w)))
'(lambda (w) #f))
(test-comp '(lambda (a b)
(not (if a b (list 1 2))))
'(lambda (a b)
(not (if a b #t))))
;; Ok to move `box' past a side effect (that can't capture a
;; resumable continuation):
(test-comp '(let ([h (box 0.0)])

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

@ -2232,6 +2232,35 @@ int scheme_expr_produces_local_type(Scheme_Object *expr)
return expr_produces_local_type(expr, 10);
}
static Scheme_Object *rator_implies_predicate(Scheme_Object *rator, int argc)
{
if (SCHEME_PRIMP(rator)) {
if ((argc == 2)
&& (SAME_OBJ(rator, scheme_cons_proc)
|| SAME_OBJ(rator, scheme_unsafe_cons_list_proc)))
return scheme_pair_p_proc;
else if ((argc == 2) && SAME_OBJ(rator, scheme_mcons_proc))
return scheme_mpair_p_proc;
else if (SAME_OBJ(rator, scheme_list_proc)) {
if (argc >= 1)
return scheme_pair_p_proc;
else
return scheme_null_p_proc;
} else if (SAME_OBJ(rator, scheme_list_star_proc)) {
if (argc > 2)
return scheme_pair_p_proc;
} else if (SAME_OBJ(rator, scheme_vector_proc)
|| SAME_OBJ(rator, scheme_vector_immutable_proc))
return scheme_vector_p_proc;
else if ((argc == 1)
&& (SAME_OBJ(rator, scheme_box_proc)
|| SAME_OBJ(rator, scheme_box_immutable_proc)))
return scheme_box_p_proc;
}
return NULL;
}
static Scheme_Object *expr_implies_predicate(Scheme_Object *expr, Optimize_Info *info, int delta, int fuel)
{
Scheme_Object *rator = NULL;
@ -2319,29 +2348,8 @@ static Scheme_Object *expr_implies_predicate(Scheme_Object *expr, Optimize_Info
break;
}
if (rator) {
if ((argc == 2)
&& (SAME_OBJ(rator, scheme_cons_proc)
|| SAME_OBJ(rator, scheme_unsafe_cons_list_proc)))
return scheme_pair_p_proc;
else if ((argc == 2) && SAME_OBJ(rator, scheme_mcons_proc))
return scheme_mpair_p_proc;
else if (SAME_OBJ(rator, scheme_list_proc)) {
if (argc >= 1)
return scheme_pair_p_proc;
else
return scheme_null_p_proc;
} else if (SAME_OBJ(rator, scheme_list_star_proc)) {
if (argc > 2)
return scheme_pair_p_proc;
} else if (SAME_OBJ(rator, scheme_vector_proc)
|| SAME_OBJ(rator, scheme_vector_immutable_proc))
return scheme_vector_p_proc;
else if ((argc == 1)
&& (SAME_OBJ(rator, scheme_box_proc)
|| SAME_OBJ(rator, scheme_box_immutable_proc)))
return scheme_box_p_proc;
}
if (rator)
return rator_implies_predicate(rator, argc);
return NULL;
}
@ -2531,6 +2539,16 @@ static int appn_flags(Scheme_Object *rator, Optimize_Info *info)
return 0;
}
static Scheme_Object *finish_optimize_any_application(Scheme_Object *app, Scheme_Object *rator, int argc,
Optimize_Info *info, int context)
{
if (context & OPT_CONTEXT_BOOLEAN)
if (rator_implies_predicate(rator, argc))
return make_discarding_sequence(app, scheme_true, info);
return app;
}
static Scheme_Object *finish_optimize_application(Scheme_App_Rec *app, Optimize_Info *info, int context, int rator_flags)
{
Scheme_Object *le;
@ -2568,7 +2586,8 @@ static Scheme_Object *finish_optimize_application(Scheme_App_Rec *app, Optimize_
flags = appn_flags(app->args[0], info);
SCHEME_APPN_FLAGS(app) |= flags;
return (Scheme_Object *)app;
return finish_optimize_any_application((Scheme_Object *)app, app->args[0], app->num_args,
info, context);
}
static Scheme_Object *lookup_constant_proc(Optimize_Info *info, Scheme_Object *rand)
@ -2958,7 +2977,8 @@ static Scheme_Object *finish_optimize_application2(Scheme_App2_Rec *app, Optimiz
flags = appn_flags(app->rator, info);
SCHEME_APPN_FLAGS(app) |= flags;
return (Scheme_Object *)app;
return finish_optimize_any_application((Scheme_Object *)app, app->rator, 1,
info, context);
}
static Scheme_Object *optimize_application3(Scheme_Object *o, Optimize_Info *info, int context)
@ -3234,7 +3254,8 @@ static Scheme_Object *finish_optimize_application3(Scheme_App3_Rec *app, Optimiz
register_local_argument_types(NULL, NULL, app, info);
return (Scheme_Object *)app;
return finish_optimize_any_application((Scheme_Object *)app, app->rator, 2,
info, context);
}
Scheme_Object *scheme_optimize_apply_values(Scheme_Object *f, Scheme_Object *e,
@ -3496,16 +3517,6 @@ 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);
}
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)
{
Scheme_Branch_Rec *b;
@ -3551,7 +3562,10 @@ static Scheme_Object *optimize_branch(Scheme_Object *o, Optimize_Info *info, int
break;
}
t = simplify_boolean(t, info);
if (expr_implies_predicate(t, info, 0, 5)) {
/* all predicates recognize non-#f things */
t = make_discarding_sequence(t, scheme_true, info);
}
/* Try to lift out `let`s and `begin`s around a test: */
{