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

optimizer: generalize moving expressions to single-value context

Browse Source 
Gemeralize Gustavo's change so that immediately-used right-hand sides
can be moved into any position that (like the binding context) enforces
single-valuedness --- for arbitrary right-hand expressions.
This commit is contained in:
Matthew Flatt 2014-07-10 15:12:45 +01:00
parent 25c05d66b6
commit a7a912eeab
3 changed files with 98 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1009,6 +1009,7 @@
(let ([x (cons w z)])
(car x)))
'(lambda (w z) w))
(test-comp '(lambda (w z)
(let ([x (cons w z)])
(cdr x)))
@ -1393,6 +1394,39 @@
(if r #t (something-else))))
'(lambda (x) (if (something) #t (something-else))))
(test-comp '(lambda (x) (let ([r (something)])
(r)))
'(lambda (x) ((something))))
(test-comp '(lambda (x) (let ([r (something)])
(r (something-else))))
'(lambda (x) ((something) (something-else))))
(test-comp '(lambda (x z) (let ([r (something)])
(z r)))
'(lambda (x z) (z (something))))
(test-comp '(lambda (x) (let ([r (something)])
(r (something-else) 1 2)))
'(lambda (x) ((something) (something-else) 1 2)))
(test-comp '(lambda (x z) (let ([r (something)])
(with-continuation-mark r z (something-else))))
'(lambda (x z) (with-continuation-mark (something) z (something-else))))
(test-comp '(lambda (x z) (let ([r (something)])
(with-continuation-mark z r (something-else))))
'(lambda (x z) (with-continuation-mark z (something) (something-else))))
(test-comp '(lambda (x z) (let ([r (something)])
(set! z r)))
'(lambda (x z) (set! z (something))))
(test-comp '(lambda (x z) (let ([r (something)])
(call-with-values (lambda () (z)) r)))
'(lambda (x z) (call-with-values (lambda () (z)) (something))))
;; Don't move closure allocation:
(test-comp '(lambda (z) (let ([r (lambda () z)])
(lambda () r)))
'(lambda (z) (lambda ()
(lambda () z)))
#f)
(test-comp '(if (let ([z (random)]) null) 1 2)
'(if (let ([z (random)]) #t) 1 2))
@ -3883,6 +3917,30 @@
(set! f f)
(err/rt-test (f #t)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Make sure compilation doesn't try to inline forever:
(module cfg-extract-test racket/base
(define (report-answer-all k)
(k (list (random 10))))
(lambda ()
(let loop ([success-k 0]
[fail-k 1]
[k 0])
(let ([new-got-k
(lambda (val stream depth tasks next-k)
(let ([next-k (lambda (x y tasks)
(loop (random)
1
(lambda (end tasks success-k fail-k)
(next-k success-k fail-k 8))))])
(report-answer-all (lambda (tasks)
(success-k 0 1 2 3 next-k)))))])
(k 5 5 new-got-k
(lambda (tasks)
(report-answer-all 8)))))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs)

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

@ -1155,6 +1155,9 @@ static int single_valued_noncm_expression(Scheme_Object *expr, int fuel)
&& single_valued_noncm_expression(b->fbranch, fuel - 1));
}
break;
case scheme_compiled_unclosed_procedure_type:
case scheme_case_lambda_sequence_type:
return 1;
default:
if (SCHEME_TYPE(expr) > _scheme_compiled_values_types_)
return 1;
@ -1286,6 +1289,11 @@ static int movable_expression(Scheme_Object *expr, Optimize_Info *info, int delt
return 1;
}
break;
case scheme_compiled_unclosed_procedure_type:
case scheme_case_lambda_sequence_type:
/* Can't move across lambda or continuation if not closed, since
that changes allocation of a closure. */
return !cross_lambda && !cross_k;
default:
if (SCHEME_TYPE(expr) > _scheme_compiled_values_types_)
return 1;
@ -2531,12 +2539,12 @@ static Scheme_Object *optimize_application(Scheme_Object *o, Optimize_Info *info
return le;
}
sub_context = 0;
sub_context = OPT_CONTEXT_SINGLED;
if (i > 0) {
int ty;
ty = wants_local_type_arguments(app->args[0], i - 1);
if (ty)
sub_context = (ty << OPT_CONTEXT_TYPE_SHIFT);
sub_context |= (ty << OPT_CONTEXT_TYPE_SHIFT);
}
optimize_info_seq_step(info, &info_seq);
@ -2804,7 +2812,7 @@ static Scheme_Object *optimize_application2(Scheme_Object *o, Optimize_Info *inf
{
Scheme_App2_Rec *app;
Scheme_Object *le;
int rator_flags = 0, sub_context = 0, ty;
int rator_flags = 0, sub_context, ty;
Optimize_Info_Sequence info_seq;
app = (Scheme_App2_Rec *)o;
@ -2818,7 +2826,9 @@ static Scheme_Object *optimize_application2(Scheme_Object *o, Optimize_Info *inf
optimize_info_seq_init(info, &info_seq);
le = scheme_optimize_expr(app->rator, info, 0);
sub_context = OPT_CONTEXT_SINGLED;
le = scheme_optimize_expr(app->rator, info, sub_context);
app->rator = le;
{
@ -2829,7 +2839,7 @@ static Scheme_Object *optimize_application2(Scheme_Object *o, Optimize_Info *inf
}
if (SAME_PTR(scheme_not_prim, app->rator)){
sub_context = OPT_CONTEXT_BOOLEAN;
sub_context |= OPT_CONTEXT_BOOLEAN;
} else {
ty = wants_local_type_arguments(app->rator, 0);
if (ty)
@ -3064,7 +3074,7 @@ static Scheme_Object *optimize_application3(Scheme_Object *o, Optimize_Info *inf
{
Scheme_App3_Rec *app;
Scheme_Object *le;
int rator_flags = 0, sub_context = 0, ty, flags;
int rator_flags = 0, sub_context, ty, flags;
Optimize_Info_Sequence info_seq;
app = (Scheme_App3_Rec *)o;
@ -3092,6 +3102,8 @@ static Scheme_Object *optimize_application3(Scheme_Object *o, Optimize_Info *inf
optimize_info_seq_init(info, &info_seq);
sub_context = OPT_CONTEXT_SINGLED;
le = scheme_optimize_expr(app->rator, info, sub_context);
app->rator = le;
@ -3642,7 +3654,7 @@ static Scheme_Object *optimize_branch(Scheme_Object *o, Optimize_Info *info, int
optimize_info_seq_init(info, &info_seq);
t = scheme_optimize_expr(t, info, OPT_CONTEXT_BOOLEAN);
t = scheme_optimize_expr(t, info, OPT_CONTEXT_BOOLEAN | OPT_CONTEXT_SINGLED);
/* Try optimize: (if (not x) y z) => (if x z y) */
while (1) {
@ -3838,11 +3850,11 @@ static Scheme_Object *optimize_wcm(Scheme_Object *o, Optimize_Info *info, int co
optimize_info_seq_init(info, &info_seq);
k = scheme_optimize_expr(wcm->key, info, 0);
k = scheme_optimize_expr(wcm->key, info, OPT_CONTEXT_SINGLED);
optimize_info_seq_step(info, &info_seq);
v = scheme_optimize_expr(wcm->val, info, 0);
v = scheme_optimize_expr(wcm->val, info, OPT_CONTEXT_SINGLED);
/* The presence of a key can be detected by other expressions,
to increment vclock to prevent expressions incorrectly
@ -3905,7 +3917,7 @@ set_optimize(Scheme_Object *data, Optimize_Info *info, int context)
var = sb->var;
val = sb->val;
val = scheme_optimize_expr(val, info, 0);
val = scheme_optimize_expr(val, info, OPT_CONTEXT_SINGLED);
info->preserves_marks = 1;
info->single_result = 1;
@ -4041,7 +4053,7 @@ apply_values_optimize(Scheme_Object *data, Optimize_Info *info, int context)
optimize_info_seq_init(info, &info_seq);
f = scheme_optimize_expr(f, info, 0);
f = scheme_optimize_expr(f, info, OPT_CONTEXT_SINGLED);
optimize_info_seq_step(info, &info_seq);
@ -5102,7 +5114,10 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i
if (!skip_opts) {
optimize_info_seq_step(rhs_info, &info_seq);
value = scheme_optimize_expr(pre_body->value, rhs_info, 0);
value = scheme_optimize_expr(pre_body->value, rhs_info,
((pre_body->count == 1)
? OPT_CONTEXT_SINGLED
: 0));
pre_body->value = value;
} else {
value = pre_body->value;
@ -5410,7 +5425,10 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i
rhs_info->use_psize = info->use_psize;
optimize_info_seq_step(rhs_info, &info_seq);
value = scheme_optimize_expr(self_value, rhs_info, 0);
value = scheme_optimize_expr(self_value, rhs_info,
((clv->count == 1)
? OPT_CONTEXT_SINGLED
: 0));
if (!OPT_DISCOURAGE_EARLY_INLINE)
--rhs_info->letrec_not_twice;
@ -6701,7 +6719,7 @@ Scheme_Object *scheme_optimize_expr(Scheme_Object *expr, Optimize_Info *info, in
if (SAME_TYPE(SCHEME_TYPE(val), scheme_once_used_type)) {
Scheme_Once_Used *o = (Scheme_Once_Used *)val;
if (((o->vclock == info->vclock)
&& ((context & OPT_CONTEXT_BOOLEAN)
&& ((context & OPT_CONTEXT_SINGLED)
|| single_valued_noncm_expression(o->expr, 5)))
|| movable_expression(o->expr, info, o->delta, o->cross_lambda,
o->kclock != info->kclock,
@ -6710,6 +6728,7 @@ Scheme_Object *scheme_optimize_expr(Scheme_Object *expr, Optimize_Info *info, in
if (val) {
info->size -= 1;
o->used = 1;
info->inline_fuel = 0; /* no more inlining; o->expr was already optimized */
return scheme_optimize_expr(val, info, context);
}
}

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

@ -2873,11 +2873,15 @@ Scheme_Object *scheme_letrec_check_expr(Scheme_Object *);
Scheme_Object *scheme_optimize_expr(Scheme_Object *, Optimize_Info *, int context);
Scheme_Object *scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, int context);
/* Context uses result as a boolean: */
#define OPT_CONTEXT_BOOLEAN 0x1
/* Context might duplicate the expression: */
#define OPT_CONTEXT_NO_SINGLE 0x2
#define OPT_CONTEXT_TYPE_SHIFT 3
#define OPT_CONTEXT_TYPE_MASK (SCHEME_MAX_LOCAL_TYPE_MASK << OPT_CONTEXT_TYPE_SHIFT)
#define OPT_CONTEXT_TYPE(oc) ((oc & OPT_CONTEXT_TYPE_MASK) >> OPT_CONTEXT_TYPE_SHIFT)
/* Context checks that result is a single value: */
#define OPT_CONTEXT_SINGLED 0x4
#define OPT_CONTEXT_TYPE_SHIFT 4
#define OPT_CONTEXT_TYPE_MASK (SCHEME_MAX_LOCAL_TYPE_MASK << OPT_CONTEXT_TYPE_SHIFT)
#define OPT_CONTEXT_TYPE(oc) ((oc & OPT_CONTEXT_TYPE_MASK) >> OPT_CONTEXT_TYPE_SHIFT)
#define scheme_optimize_result_context(c) (c & (~(OPT_CONTEXT_TYPE_MASK | OPT_CONTEXT_NO_SINGLE)))
#define scheme_optimize_tail_context(c) scheme_optimize_result_context(c)