Remove dead code after errors

For example, reduce (begin x (error 'e) y) ==> (begin x (error 'e)) and
(f (error 'e) y ) ==> (begin f (error 'e)).

Also, reduce (if (error 'e) x y) ==> (error 'e) and propagate the type information
and clocks when only one branch produce an error.
This commit is contained in:
Gustavo Massaccesi 2014-12-13 18:28:13 -03:00 committed by Matthew Flatt
parent 92615049aa
commit 17665d33a2
2 changed files with 479 additions and 90 deletions

View File

@ -2722,6 +2722,7 @@
;; operations on mutable values:
(let ()
(define (check-omit-ok expr [yes? #t])
(displayln (list expr 1 '!))
;; can omit:
(test-comp `(module m racket/base
(require racket/unsafe/ops)
@ -2733,6 +2734,7 @@
,expr
(f x)))
yes?)
(displayln (list expr 2 '!))
;; cannot reorder:
(test-comp `(module m racket/base
(require racket/unsafe/ops)
@ -2745,7 +2747,9 @@
(define (f x)
(vector-ref x x)
(f x ,expr)))
#f))
#f)
(displayln (list expr 3 '!))
)
(map check-omit-ok
'((unsafe-vector-ref x x)
(unsafe-vector*-ref x x)
@ -3017,7 +3021,180 @@
#t
(letrec ([z (lambda () z)]) (f z) #f)
(letrec ([z (lambda () z)]) (f z) #t))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check remotion of dead code after error
(test-comp '(lambda () (random) (error 'error))
'(lambda () (random) (error 'error) 5))
(test-comp '(lambda () (random) (error 'error))
'(lambda () (random) (error 'error) (random) 5))
(test-comp '(lambda () (error 'error))
'(lambda () 5 (error 'error) 5))
(test-comp '(lambda (f) (f) (f) (error 'error))
'(lambda (f) (f) (f) (error 'error) (f)))
(test-comp '(lambda (f) (begin0 (f) (random) (error 'error)))
'(lambda (f) (begin0 (f) (random) (error 'error) (random) (f))))
(test-comp '(lambda (f) (error 'error))
'(lambda (f) (begin0 (error 'error) (random) (f))))
(test-comp '(lambda (f) (error 'error))
'(lambda (f) (begin0 7 (error 'error) (random) (f))))
(test-comp '(lambda (n)
(let ([p (begin (error 'error) (fl+ n n))])
(if (flonum? p)
(fl+ p p)
'bad)))
'(lambda (n)
(let ([p (begin (error 'error) (fl- n n))])
(if (flonum? p)
(fl+ p p)
'bad))))
(test-comp '(lambda () (if (error 'error) 1 2))
'(lambda () (if (error 'error) 1 2) 5))
(test-comp '(lambda () (error 'error))
'(lambda () (if (error 'error) 1 2) 5))
(test-comp '(lambda (x) (if x (error 'error) 0) 3)
'(lambda (x) (if x (error 'error) 0) 4)
#f)
(test-comp '(lambda (x) (if x 0 (error 'error)) 3)
'(lambda (x) (if x 0 (error 'error)) 4)
#f)
(test-comp '(lambda (x) (if x (error 'error 1) (error 'error 2)))
'(lambda (x) (if x (error 'error 1) (error 'error 2)) 5))
(test-comp '(lambda (x) (if x (error 'error) (car x)) (unsafe-car x))
'(lambda (x) (if x (error 'error) (car x)) (car x)))
(test-comp '(lambda (x) (if x (car x) (error 'error)) (unsafe-car x))
'(lambda (x) (if x (car x) (error 'error)) (car x)))
(test-comp '(lambda (x) (if x (begin (car x) (error 'error)) 0) (unsafe-car x))
'(lambda (x) (if x (begin (car x) (error 'error)) 0) (car x))
#f)
(test-comp '(lambda (x) (if x 0 (begin (car x) (error 'error))) (unsafe-car x))
'(lambda (x) (if x 0 (begin (car x) (error 'error))) (car x))
#f)
(test-comp '(lambda (x) (if (car x) (error 'error) 0) (unsafe-car x))
'(lambda (x) (if (car x) (error 'error) 0) (car x)))
(test-comp '(lambda (x) (if (car x) 0 (error 'error)) (unsafe-car x))
'(lambda (x) (if (car x) 0 (error 'error)) (car x)))
(test-comp '(lambda (f) (error 'error))
'(lambda (f) (with-continuation-mark (error 'error) 'v (f))))
(test-comp '(lambda (f) (values (f)) (error 'error))
'(lambda (f) (with-continuation-mark (f) (error 'error) (f))))
(test-comp '(lambda (f x) (f x x) (set! x 3) (error 'error))
'(lambda (f x) (f x x) (set! x 3) (set! x (error 'error)) 5))
(test-comp '(lambda (f x) (error 'error))
'(lambda (f x) (set! x (error 'error)) 5))
(test-comp '(lambda (f) (let ([x (random)]) (f x x) (set! x 3) (error 'error)))
'(lambda (f) (let ([x (random)]) (f x x) (set! x 3) (set! x (error 'error)) 5)))
(test-comp '(lambda (f) (let ([x (random)]) (error 'error)))
'(lambda (f) (let ([x (random)]) (set! x (error 'error)) 5)))
#;(test-comp '(lambda (f) (error 'error))
'(lambda (f) (call-with-values (error 'error) (f))))
#;(test-comp '(lambda (g) (g) (error 'error))
'(lambda (g) (call-with-values (g) (error 'error))))
(test-comp '(lambda () (error 'error))
'(lambda () ((error 'error) 0) 5))
(test-comp '(lambda () (error 'error))
'(lambda () (car (error 'error)) 5))
(test-comp '(lambda () (error 'error))
'(lambda () (not (error 'error)) 5))
(test-comp '(lambda (f) (values (f)) (error 'error))
'(lambda (f) ((f) (error 'error)) 5))
(test-comp '(lambda () (error 'error))
'(lambda () ((error 'error) 0 1) 5))
(test-comp '(lambda () (error 'error))
'(lambda () (cons (error 'error) 1) 5))
(test-comp '(lambda () (error 'error))
'(lambda () (cons 0 (error 'error)) 5))
(test-comp '(lambda (f) (f) (error 'error))
'(lambda (f) (f) (cons (error 'error) (f)) 5))
(test-comp '(lambda (f) (values (f)) (error 'error))
'(lambda (f) (cons (f) (error 'error)) 5))
(test-comp '(lambda (f) (values (f)) (error 'error))
'(lambda (f) ((f) (error 'error) (f)) 5))
(test-comp '(lambda (f g) (values (f)) (values (g)) (error 'error))
'(lambda (f g) ((f) (g) (error 'error)) 5))
(test-comp '(lambda (f) (error 'error))
'(lambda (f) ((error 'error) (f) (f) (f)) 5))
(test-comp '(lambda (f) (values (f)) (error 'error))
'(lambda (f) ((f) (error 'error) (f) (f)) 5))
(test-comp '(lambda (f) (values (f)) (values (f)) (error 'error))
'(lambda (f) ((f) (f) (error 'error) (f)) 5))
(test-comp '(lambda (f) (values (f)) (values (f)) (values (f)) (error 'error))
'(lambda (f) ((f) (f) (f) (error 'error)) 5))
(test-comp '(lambda (f) (let ([x (error 'error)]) #f))
'(lambda (f) (let ([x (error 'error)]) (f x x)) 5))
(test-comp '(lambda (f) (let ([x (error 'error)] [y #f]) #f))
'(lambda (f) (let ([x (error 'error)] [y (random)]) (f x x y y)) 5))
(test-comp '(lambda (f) (let ([x (random)] [y (random)]) (f x x y y) (error 'error)))
'(lambda (f) (let ([x (random)] [y (random)]) (f x x y y) (error 'error)) 5))
(test-comp '(lambda (f) (let-values ([(x) (error 'error)] [(y) #f] [(z) #f] ) #f))
'(lambda (f) (let-values ([(x) (error 'error)] [(y z) (f)]) (f x x y y z z)) 5))
(test-comp '(lambda (f) (let-values ([(x) (error 'error)] [(y) #f] [(z) #f]) #f))
'(lambda (f) (let-values ([(x y) (values (error 'error) (random))] [(z) (f)]) (f x x y y z z)) 5))
(test-comp '(lambda (f) (let-values ([(x) (begin (random) (error 'error))] [(y) #f] [(z) #f]) #f))
'(lambda (f) (let-values ([(x y) (values (random) (error 'error))] [(z) (f)]) (f x x y y z z)) 5))
;alternative reduction:
#;(test-comp '(lambda (f) (let-values ([(x) (random)] [(y) (error 'error)] [(z) #f]) #f))
'(lambda (f) (let-values ([(x y) (values (random) (error 'error))] [(z) (f)]) (f x x y y z z)) 5))
(test-comp '(lambda (f) (letrec ([x (lambda() y)] [y (lambda () x)]) (f x y) (error 'error)))
'(lambda (f) (letrec ([x (lambda() y)] [y (lambda () x)]) (f x y) (error 'error)) 5))
(test-comp '(lambda (f) (letrec ([x (lambda() y)] [y (lambda () x)] [z (error 'error)]) #f))
'(lambda (f) (letrec ([x (lambda() y)] [y (lambda () x)] [z (error 'error)]) (f x y z)) 5))
(test-comp '(lambda (f) (letrec ([x (lambda() y)] [z (error 'error)] [y #f]) #f))
'(lambda (f) (letrec ([x (lambda() y)] [z (error 'error)] [y (lambda () x)]) (f x y z)) 5))
(test-comp '(lambda (f) (letrec ([z (error 'error)] [x #f] [y #f]) #f))
'(lambda (f) (letrec ([z (error 'error)] [x (lambda() y)] [y (lambda () x)]) (f x y z)) 5))
(test-comp `(module m racket/base
(define x 5)
(set! x 3)
(error 'error))
`(module m racket/base
(define x 5)
(set! x 3)
(set! x (error 'error))))
(test-comp `(module m racket/base
(module bad racket/base
(error 'error))
(random)
5)
`(module m racket/base
(module bad racket/base
(error 'error))
(random))
#f)
#;(test-comp `(module m racket/base
f
(error 'error))
`(module m racket/base
f
(error 'error)
(define f 5))
#f)
(test-comp `(module m racket/base
(define f 5)
(error 'error))
`(module m racket/base
(define f 5)
(error 'error)
(set! f 0))
#f)
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check splitting of definitions
(test-comp `(module m racket/base

View File

@ -71,6 +71,9 @@ struct Optimize_Info
/* Set by expression optimization: */
int single_result, preserves_marks; /* negative means "tentative", due to fixpoint in progress */
int escapes; /* flag to signal that the expression allways escapes. When escapes is 1, it's assumed
that single_result and preserves_marks are also 1, and that it's not necesary to
use optimize_ignored before including the expression. */
char **stat_dists; /* (pos, depth) => used? */
int *sd_depths;
@ -2209,6 +2212,15 @@ static int is_nonsaving_primitive(Scheme_Object *rator, int n)
return 0;
}
static int is_allways_escaping_primitive(Scheme_Object *rator)
{
if (SCHEME_PRIMP(rator)
&& (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & SCHEME_PRIM_ALWAYS_ESCAPES)) {
return 1;
}
return 0;
}
#define IS_NAMED_PRIM(p, nm) (!strcmp(((Scheme_Primitive_Proc *)p)->name, nm))
static int wants_local_type_arguments(Scheme_Object *rator, int argpos)
@ -2570,10 +2582,12 @@ static Scheme_Object *optimize_application(Scheme_Object *o, Optimize_Info *info
/* Check for (apply ... (list ...)) early: */
le = direct_apply((Scheme_Object *)app, app->args[0], app->args[app->num_args], info);
if (le) return scheme_optimize_expr(le, info, context);
if (le)
return scheme_optimize_expr(le, info, context);
le = check_app_let_rator(o, app->args[0], info, app->num_args, context);
if (le) return le;
if (le)
return le;
n = app->num_args + 1;
@ -2583,7 +2597,7 @@ static Scheme_Object *optimize_application(Scheme_Object *o, Optimize_Info *info
if (!i) {
le = optimize_for_inline(info, app->args[i], n - 1, app, NULL, NULL, &rator_flags, context, 0);
if (le)
return le;
return le;
}
sub_context = OPT_CONTEXT_SINGLED;
@ -2597,6 +2611,25 @@ static Scheme_Object *optimize_application(Scheme_Object *o, Optimize_Info *info
optimize_info_seq_step(info, &info_seq);
le = scheme_optimize_expr(app->args[i], info, sub_context);
app->args[i] = le;
if (info->escapes) {
int j;
Scheme_Object *e, *l;
optimize_info_seq_done(info, &info_seq);
l = scheme_make_pair(app->args[i], scheme_null);
for (j = i - 1; j >= 0; j--) {
e = app->args[j];
e = optimize_ignored(e, info, 0, 1, 1, 5);
if (e) {
if (!single_valued_noncm_expression(e, 5))
e = ensure_single_value(e);
l = scheme_make_pair(e, l);
}
}
return scheme_make_sequence_compilation(l, 1);
}
if (!i) {
/* Maybe found "((lambda" after optimizing; try again */
@ -2672,6 +2705,10 @@ static Scheme_Object *finish_optimize_any_application(Scheme_Object *app, Scheme
if (SAME_OBJ(rator, scheme_void_proc))
return make_discarding_sequence(app, scheme_void, info, 0);
if (is_allways_escaping_primitive(rator)) {
info->escapes = 1;
}
return app;
}
@ -2895,7 +2932,8 @@ static Scheme_Object *optimize_application2(Scheme_Object *o, Optimize_Info *inf
app = (Scheme_App2_Rec *)o;
le = check_app_let_rator(o, app->rator, info, 1, context);
if (le) return le;
if (le)
return le;
le = optimize_for_inline(info, app->rator, 1, NULL, app, NULL, &rator_flags, context, 0);
if (le)
@ -2907,6 +2945,10 @@ static Scheme_Object *optimize_application2(Scheme_Object *o, Optimize_Info *inf
le = scheme_optimize_expr(app->rator, info, sub_context);
app->rator = le;
if (info->escapes) {
optimize_info_seq_done(info, &info_seq);
return app->rator;
}
{
/* Maybe found "((lambda" after optimizing; try again */
@ -2927,8 +2969,11 @@ static Scheme_Object *optimize_application2(Scheme_Object *o, Optimize_Info *inf
le = scheme_optimize_expr(app->rand, info, sub_context);
app->rand = le;
optimize_info_seq_done(info, &info_seq);
if (info->escapes) {
info->size += 1;
return make_discarding_first_sequence(app->rator, app->rand, info, 0);
}
return finish_optimize_application2(app, info, context, rator_flags);
}
@ -3203,10 +3248,12 @@ static Scheme_Object *optimize_application3(Scheme_Object *o, Optimize_Info *inf
/* Check for (apply ... (list ...)) early: */
le = direct_apply((Scheme_Object *)app, app->rator, app->rand2, info);
if (le) return scheme_optimize_expr(le, info, context);
if (le)
return scheme_optimize_expr(le, info, context);
le = check_app_let_rator(o, app->rator, info, 2, context);
if (le) return le;
if (le)
return le;
le = optimize_for_inline(info, app->rator, 2, NULL, NULL, app, &rator_flags, context, 0);
if (le)
@ -3218,6 +3265,10 @@ static Scheme_Object *optimize_application3(Scheme_Object *o, Optimize_Info *inf
le = scheme_optimize_expr(app->rator, info, sub_context);
app->rator = le;
if (info->escapes) {
optimize_info_seq_done(info, &info_seq);
return app->rator;
}
{
/* Maybe found "((lambda" after optimizing; try again */
@ -3236,6 +3287,10 @@ static Scheme_Object *optimize_application3(Scheme_Object *o, Optimize_Info *inf
le = scheme_optimize_expr(app->rand1, info, sub_context);
app->rand1 = le;
if (info->escapes) {
info->size += 1;
return make_discarding_first_sequence(app->rator, app->rand1, info, 0);
}
/* 2nd arg */
@ -3249,8 +3304,14 @@ static Scheme_Object *optimize_application3(Scheme_Object *o, Optimize_Info *inf
le = scheme_optimize_expr(app->rand2, info, sub_context);
app->rand2 = le;
optimize_info_seq_done(info, &info_seq);
if (info->escapes) {
info->size += 1;
return make_discarding_first_sequence(app->rator,
make_discarding_first_sequence(app->rand1, app->rand2,
info, 0),
info, 0);
}
/* Check for (apply ... (list ...)) after some optimizations: */
le = direct_apply((Scheme_Object *)app, app->rator, app->rand2, info);
@ -3606,7 +3667,7 @@ static Scheme_Object *optimize_sequence(Scheme_Object *o, Optimize_Info *info, i
Optimize_Info_Sequence info_seq;
optimize_info_seq_init(info, &info_seq);
count = s->count;
for (i = 0; i < count; i++) {
prev_size = info->size;
@ -3616,21 +3677,35 @@ static Scheme_Object *optimize_sequence(Scheme_Object *o, Optimize_Info *info, i
((i + 1 == count)
? scheme_optimize_tail_context(context)
: 0));
if (i == s->count - 1) {
if (i + 1 == count) {
single_result = info->single_result;
preserves_marks = info->preserves_marks;
}
/* Inlining and constant propagation can expose omittable expressions. */
if (i + 1 != count)
le = optimize_ignored(le, info, 0, -1, 1, 5);
if (!le) {
drop++;
info->size = prev_size;
s->array[i] = NULL;
} else {
s->array[i] = le;
} else {
if (!info->escapes) {
/* Inlining and constant propagation can expose omittable expressions. */
le = optimize_ignored(le, info, 0, -1, 1, 5);
if (!le) {
drop++;
info->size = prev_size;
s->array[i] = NULL;
} else {
s->array[i] = le;
}
} else {
int j;
single_result = info->single_result;
preserves_marks = info->preserves_marks;
/* Move to last position in case the begin form is droped */
s->array[count - 1] = le;
for (j = i; j < count - 1; j++) {
drop++;
s->array[j] = NULL;
}
break;
}
}
}
@ -3784,13 +3859,26 @@ static void add_types(Scheme_Object *t, Optimize_Info *info, int fuel)
}
}
static int or_tentative(int x, int y)
{
if (x && y) {
if ((x < 0) || (y < 0))
return -1;
else
return 1;
} else {
return 0;
}
}
static Scheme_Object *optimize_branch(Scheme_Object *o, Optimize_Info *info, int context)
{
Scheme_Branch_Rec *b;
Scheme_Object *t, *tb, *fb;
Scheme_Hash_Tree *old_types;
int preserves_marks = 1, single_result = 1, init_vclock, init_kclock, init_sclock;
int same_then_vclock, then_kclock, then_sclock;
Scheme_Hash_Tree *init_types, *then_types;
int init_vclock, init_kclock, init_sclock;
int then_escapes, then_preserves_marks, then_single_result;
int then_vclock, then_kclock, then_sclock;
Optimize_Info_Sequence info_seq;
b = (Scheme_Branch_Rec *)o;
@ -3823,6 +3911,11 @@ static Scheme_Object *optimize_branch(Scheme_Object *o, Optimize_Info *info, int
t = scheme_optimize_expr(t, info, OPT_CONTEXT_BOOLEAN | OPT_CONTEXT_SINGLED);
if (info->escapes) {
optimize_info_seq_done(info, &info_seq);
return t;
}
/* Try to lift out `let`s and `begin`s around a test: */
{
Scheme_Object *inside = NULL, *t2 = t;
@ -3893,29 +3986,25 @@ static Scheme_Object *optimize_branch(Scheme_Object *o, Optimize_Info *info, int
optimize_info_seq_step(info, &info_seq);
info->vclock += 1; /* model branch as clock increment */
init_vclock = info->vclock;
init_kclock = info->kclock;
init_sclock = info->sclock;
init_types = info->types;
old_types = info->types;
add_types(t, info, 5);
tb = scheme_optimize_expr(tb, info, scheme_optimize_tail_context(context));
if (!info->preserves_marks)
preserves_marks = 0;
else if (info->preserves_marks < 0)
preserves_marks = -1;
if (!info->single_result)
single_result = 0;
else if (info->single_result < 0)
single_result = -1;
same_then_vclock = (init_vclock == info->vclock);
info->types = old_types;
then_types = info->types;
then_preserves_marks = info->preserves_marks;
then_single_result = info->single_result;
then_escapes = info->escapes;
then_vclock = info->vclock;
then_kclock = info->kclock;
then_sclock = info->sclock;
info->types = init_types;
info->vclock = init_vclock;
info->kclock = init_kclock;
info->sclock = init_sclock;
@ -3924,31 +4013,42 @@ static Scheme_Object *optimize_branch(Scheme_Object *o, Optimize_Info *info, int
fb = scheme_optimize_expr(fb, info, scheme_optimize_tail_context(context));
if (!info->preserves_marks)
preserves_marks = 0;
else if (preserves_marks && (info->preserves_marks < 0))
preserves_marks = -1;
if (!info->single_result)
single_result = 0;
else if (single_result && (info->single_result < 0))
single_result = -1;
if (info->escapes && then_escapes) {
/* both branches escaped */
info->preserves_marks = 1;
info->single_result = 1;
info->kclock = init_kclock;
info->types = init_types; /* not sure if this is necesary */
if (then_kclock > info->kclock)
} else if (info->escapes) {
info->preserves_marks = then_preserves_marks;
info->single_result = then_single_result;
info->kclock = then_kclock;
info->types = then_types;
info->escapes = 0;
} else if (then_escapes) {
info->escapes = 0;
} else {
then_preserves_marks = or_tentative(then_preserves_marks, info->preserves_marks);
info->preserves_marks = then_preserves_marks;
then_single_result = or_tentative(then_single_result, info->single_result);
info->single_result = then_single_result;
if (then_kclock > info->kclock)
info->kclock = then_kclock;
info->types = init_types; /* could try to take an intersection here ... */
}
if (then_sclock > info->sclock)
info->sclock = then_sclock;
info->types = old_types; /* could try to take an intersection here ... */
if (same_then_vclock && (init_vclock == info->vclock)) {
if ((init_vclock == then_vclock) && (init_vclock == info->vclock)) {
/* we can rewind the vclock to just after the test, because the
`if` as a whole has no effect */
info->vclock--;
}
info->preserves_marks = preserves_marks;
info->single_result = single_result;
optimize_info_seq_done(info, &info_seq);
/* Try optimize: (if x x #f) => x */
@ -4023,10 +4123,21 @@ static Scheme_Object *optimize_wcm(Scheme_Object *o, Optimize_Info *info, int co
k = scheme_optimize_expr(wcm->key, info, OPT_CONTEXT_SINGLED);
if (info->escapes) {
optimize_info_seq_done(info, &info_seq);
return k;
}
optimize_info_seq_step(info, &info_seq);
v = scheme_optimize_expr(wcm->val, info, OPT_CONTEXT_SINGLED);
if (info->escapes) {
optimize_info_seq_done(info, &info_seq);
info->size += 1;
return make_discarding_first_sequence(k, v, info, 0);
}
/* The presence of a key can be detected by other expressions,
to increment vclock to prevent expressions incorrectly
moving under the mark: */
@ -4090,6 +4201,9 @@ set_optimize(Scheme_Object *data, Optimize_Info *info, int context)
val = scheme_optimize_expr(val, info, OPT_CONTEXT_SINGLED);
if (info->escapes)
return val;
info->preserves_marks = 1;
info->single_result = 1;
@ -4226,12 +4340,21 @@ apply_values_optimize(Scheme_Object *data, Optimize_Info *info, int context)
f = scheme_optimize_expr(f, info, OPT_CONTEXT_SINGLED);
if (info->escapes) {
optimize_info_seq_done(info, &info_seq);
return f;
}
optimize_info_seq_step(info, &info_seq);
e = scheme_optimize_expr(e, info, 0);
optimize_info_seq_done(info, &info_seq);
if (info->escapes) {
info->size += 1;
return make_discarding_first_sequence(f, e, info, 0);
}
info->size += 1;
info->vclock += 1;
info->kclock += 1;
@ -4398,23 +4521,70 @@ begin0_optimize(Scheme_Object *obj, Optimize_Info *info, int context)
preserves_marks = info->preserves_marks;
kclock = info->kclock;
sclock = info->sclock;
s->array[0] = le;
} else {
/* Inlining and constant propagation can expose omittable expressions: */
le = optimize_ignored(le, info, 0, -1, 1, 5);
if (!le) {
drop++;
info->size = prev_size;
s->array[i] = NULL;
} else {
s->array[i] = le;
}
}
/* Inlining and constant propagation can expose omittable expressions: */
if (i)
le = optimize_ignored(le, info, 0, -1, 1, 5);
if (!le) {
drop++;
info->size = prev_size;
s->array[i] = NULL;
} else {
s->array[i] = le;
if (info->escapes) {
int j;
single_result = info->single_result;
preserves_marks = info->preserves_marks;
for (j = i + 1; j < count; j++) {
drop++;
s->array[j] = NULL;
}
break;
}
}
optimize_info_seq_done(info, &info_seq);
if (info->escapes) {
/* In case of an error, optimize (begin0 ... <error> ...) => (begin ... <error>) */
Scheme_Sequence *s2;
int j = 0;
info->single_result = 1;
info->preserves_marks = 1;
if (i != 0) {
/* We will ignore the first expresion too */
le = optimize_ignored(s->array[0], info, 0, -1, 1, 5);
if (!le) {
drop++;
info->size = prev_size;
s->array[0] = NULL;
} else {
s->array[0] = le;
}
}
if ((count - drop) == 1) {
/* If it's only one expression we can drop the begin0 */
return s->array[i];
}
s2 = scheme_malloc_sequence(count - drop);
s2->so.type = scheme_sequence_type;
s2->count = count - drop;
for (i = 0; i < count; i++) {
if (s->array[i]) {
s2->array[j++] = s->array[i];
}
}
return (Scheme_Object *)s2;
}
info->preserves_marks = 1;
info->single_result = single_result;
@ -4454,7 +4624,8 @@ begin0_optimize(Scheme_Object *obj, Optimize_Info *info, int context)
s2->array[j++] = s->array[i];
}
}
s2->array[j++] = expr;
if (!info->escapes)
s2->array[j++] = expr;
expr = (Scheme_Object *)s2;
}
@ -5044,7 +5215,7 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i
Scheme_Object *body, *value, *ready_pairs = NULL, *rp_last = NULL, *ready_pairs_start;
Scheme_Once_Used *first_once_used = NULL, *last_once_used = NULL, *once_used;
int i, j, pos, is_rec, not_simply_let_star = 0, undiscourage, split_shift, skip_opts = 0;
int did_set_value, checked_once, skip_depth, unused_clauses;
int did_set_value, checked_once, skip_depth, unused_clauses, found_escapes;
int remove_last_one = 0, inline_fuel, rev_bind_order;
int post_bind = !(SCHEME_LET_FLAGS(head) & (SCHEME_LET_RECURSIVE | SCHEME_LET_STAR));
@ -5107,15 +5278,15 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i
&& (((Scheme_Local *)clv->body)->position == 0)) {
if (worth_lifting(clv->value)) {
if (post_bind) {
/* Just drop the let */
return scheme_optimize_expr(clv->value, info, context);
/* Just drop the let */
return scheme_optimize_expr(clv->value, info, context);
} else {
info = optimize_info_add_frame(info, 1, 0, 0);
body = scheme_optimize_expr(clv->value, info, context);
info = optimize_info_add_frame(info, 1, 0, 0);
body = scheme_optimize_expr(clv->value, info, context);
info->next->single_result = info->single_result;
info->next->preserves_marks = info->preserves_marks;
optimize_info_done(info, NULL);
return body;
optimize_info_done(info, NULL);
return body;
}
}
}
@ -5299,6 +5470,7 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i
retry_start = NULL;
ready_pairs_start = NULL;
did_set_value = 0;
found_escapes = 0;
for (i = head->num_clauses; i--; ) {
pre_body = (Scheme_Compiled_Let_Value *)body;
pos = pre_body->position;
@ -5331,12 +5503,24 @@ 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,
((pre_body->count == 1)
? OPT_CONTEXT_SINGLED
: 0));
pre_body->value = value;
if (!found_escapes) {
optimize_info_seq_step(rhs_info, &info_seq);
value = scheme_optimize_expr(pre_body->value, rhs_info,
((pre_body->count == 1)
? OPT_CONTEXT_SINGLED
: 0));
pre_body->value = value;
if (rhs_info->escapes)
found_escapes = 1;
} else {
optimize_info_seq_step(rhs_info, &info_seq);
value = scheme_false;
pre_body->value = value;
body_info->single_result = 1;
body_info->preserves_marks = 1;
body_info->escapes = 1;
body_info->size++;
}
} else {
value = pre_body->value;
--skip_opts;
@ -5366,7 +5550,8 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i
!rev_bind_order, so checks are needed to make sure that's ok. */
skip_depth = (is_rec ? (pre_body->position + pre_body->count) : 0);
if ((pre_body->count != 1)
&& is_values_apply(value, pre_body->count, rhs_info, skip_depth, 1)
&& (found_escapes
|| (is_values_apply(value, pre_body->count, rhs_info, skip_depth, 1)
&& ((!is_rec && no_mutable_bindings(pre_body)
&& (rev_bind_order
/* When !rev_bind_order, the transformation reorders the arguments
@ -5378,7 +5563,7 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i
an identifier in a way that could expose reordering: */
|| scheme_omittable_expr(value, pre_body->count, -1, 0, rhs_info, info,
skip_depth, 0,
rev_bind_order ? ID_OMIT : NO_MUTABLE_ID_OMIT))) {
rev_bind_order ? ID_OMIT : NO_MUTABLE_ID_OMIT))))) {
if (!pre_body->count && !i) {
/* We want to drop the clause entirely, but doing it
here messes up the loop for letrec. So wait and
@ -5421,7 +5606,20 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i
}
naya = (Scheme_Compiled_Let_Value *)rest;
unpack_values_application(value, naya, rev_bind_order, rhs_info, NULL);
if (!found_escapes) {
unpack_values_application(value, naya, rev_bind_order, rhs_info, NULL);
} else {
Scheme_Compiled_Let_Value *naya2 = naya;
int i;
for (i = 0; i < pre_body->count; i++) {
if (!i)
naya2->value = value;
else
naya2->value = scheme_false;
naya2 = (Scheme_Compiled_Let_Value *)naya2->body;
}
}
if (prev_body)
prev_body->body = (Scheme_Object *)naya;
else
@ -5430,7 +5628,7 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i
i += (pre_body->count - 1);
if (pre_body->count) {
/* We're backing up. Since the RHSs have been optimized
already, don re-optimize. */
already, don't re-optimize. */
skip_opts = pre_body->count - 1;
pre_body = naya;
body = (Scheme_Object *)naya;
@ -5513,7 +5711,7 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i
cnt = ((pre_body->flags[0] & SCHEME_USE_COUNT_MASK) >> SCHEME_USE_COUNT_SHIFT);
optimize_propagate(body_info, pos, value, cnt == 1);
did_set_value = 1;
did_set_value = 1;
checked_once = 1;
} else if (value && !is_rec) {
int cnt, ct;
@ -5589,8 +5787,8 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i
Scheme_Object *prop_later = NULL;
if (did_set_value) {
/* Next RHS ends a reorderable sequence.
Re-optimize from retry_start to pre_body, inclusive.
/* Next RHS ends a reorderable sequence.
Re-optimize from retry_start to pre_body, inclusive.
For procedures, assume CLOS_SINGLE_RESULT and CLOS_PRESERVES_MARKS for all,
but then assume not for all if any turn out not (i.e., approximate fix point). */
int flags;
@ -5609,17 +5807,17 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i
/* Re-optimize loop: */
clv = retry_start;
cl = clones;
while (1) {
value = clv->value;
while (1) {
value = clv->value;
if (cl) {
cl_first = SCHEME_CAR(cl);
if (!cl_first)
cl = SCHEME_CDR(cl);
} else
cl_first = NULL;
if (cl_first && SAME_OBJ(value, SCHEME_CAR(cl_first))) {
if (cl_first && SAME_OBJ(value, SCHEME_CAR(cl_first))) {
/* Try optimization. */
Scheme_Object *self_value;
Scheme_Object *self_value;
int sz;
char use_psize;
@ -5631,7 +5829,7 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i
}
cl = SCHEME_CDR(cl);
self_value = SCHEME_CDR(cl_first);
self_value = SCHEME_CDR(cl_first);
/* Drop old size, and remove old inline fuel: */
sz = compiled_proc_body_size(value, 0);
@ -5754,7 +5952,15 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i
} else if (split_shift)
optimize_info_done(rhs_info, body_info);
body = scheme_optimize_expr(body, body_info, scheme_optimize_tail_context(context));
if (!found_escapes) {
body = scheme_optimize_expr(body, body_info, scheme_optimize_tail_context(context));
} else {
body = scheme_false;
body_info->single_result = 1;
body_info->preserves_marks = 1;
body_info->escapes = 1;
body_info->size++;
}
if (head->num_clauses)
pre_body->body = body;
else
@ -6021,6 +6227,7 @@ optimize_closure_compilation(Scheme_Object *_data, Optimize_Info *info, int cont
info->vclock = init_vclock;
info->kclock = init_kclock;
info->sclock = init_sclock;
info->escapes = 0;
info->size++;
@ -6884,6 +7091,8 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
optimize_info_seq_done(info, &info_seq);
info->escapes = 0;
return data;
}
@ -6929,6 +7138,7 @@ Scheme_Object *scheme_optimize_expr(Scheme_Object *expr, Optimize_Info *info, in
info->preserves_marks = 1;
info->single_result = 1;
info->escapes = 0;
switch (type) {
case scheme_local_type:
@ -8140,6 +8350,7 @@ static Optimize_Info *optimize_info_add_frame(Optimize_Info *info, int orig, int
naya->vclock = info->vclock;
naya->kclock = info->kclock;
naya->sclock = info->sclock;
naya->escapes = info->escapes;
naya->init_kclock = info->kclock;
naya->use_psize = info->use_psize;
naya->logger = info->logger;
@ -8174,6 +8385,7 @@ static void optimize_info_done(Optimize_Info *info, Optimize_Info *parent)
parent->vclock = info->vclock;
parent->kclock = info->kclock;
parent->sclock = info->sclock;
parent->escapes = info->escapes;
parent->psize += info->psize;
parent->shift_fuel = info->shift_fuel;
if (info->has_nonleaf)