bytecode optimizer improvement
Generalize splitting of `(let-values ([(x ...) (values e ...)]) ....)' to `(let ([x e] ...) ....)' for any `e', since it's always equivalent. Right? (The old requirements on the `e's seem to be needed only for `letrec-values' splitting and maybe mutable variables.)
This commit is contained in:
parent
a1e855a035
commit
3150b31eb7
|
@ -1570,6 +1570,41 @@
|
||||||
[b (unsafe-fx+ x x)])
|
[b (unsafe-fx+ x x)])
|
||||||
(list a b)))))
|
(list a b)))))
|
||||||
|
|
||||||
|
(test-comp `(module m racket/base
|
||||||
|
(define (f x)
|
||||||
|
(let-values ([(a b) (values x (+ x x))])
|
||||||
|
(list a b))))
|
||||||
|
`(module m racket/base
|
||||||
|
(define (f x)
|
||||||
|
(let ([a x]
|
||||||
|
[b (+ x x)])
|
||||||
|
(list a b)))))
|
||||||
|
|
||||||
|
(test-comp `(module m racket/base
|
||||||
|
(define (f x)
|
||||||
|
(let*-values ([(a b) (values x (+ x x))])
|
||||||
|
(list a b))))
|
||||||
|
`(module m racket/base
|
||||||
|
(define (f x)
|
||||||
|
(let* ([a x]
|
||||||
|
[b (+ x x)])
|
||||||
|
(list a b)))))
|
||||||
|
|
||||||
|
(test-comp `(module m racket/base
|
||||||
|
(define (f x)
|
||||||
|
(let*-values ([(a b) (values x (+ x x))])
|
||||||
|
(set! a 5)
|
||||||
|
(/ a b))))
|
||||||
|
`(module m racket/base
|
||||||
|
(define (f x)
|
||||||
|
;; Not equivalent if a continuation capture
|
||||||
|
;; during `+' somehow exposes the shared `a'?
|
||||||
|
(let* ([a x]
|
||||||
|
[b (+ x x)])
|
||||||
|
(set! a 5)
|
||||||
|
(/ a b))))
|
||||||
|
#f)
|
||||||
|
|
||||||
;; check omit & reorder possibilities for unsafe
|
;; check omit & reorder possibilities for unsafe
|
||||||
;; operations on mutable values:
|
;; operations on mutable values:
|
||||||
(let ()
|
(let ()
|
||||||
|
|
|
@ -3324,15 +3324,16 @@ Scheme_Object *scheme_make_noninline_proc(Scheme_Object *e)
|
||||||
return ni;
|
return ni;
|
||||||
}
|
}
|
||||||
|
|
||||||
static int is_values_apply(Scheme_Object *e)
|
static int is_values_apply(Scheme_Object *e, int n)
|
||||||
{
|
{
|
||||||
if (SAME_TYPE(SCHEME_TYPE(e), scheme_application_type)) {
|
if (SAME_TYPE(SCHEME_TYPE(e), scheme_application_type)) {
|
||||||
Scheme_App_Rec *app = (Scheme_App_Rec *)e;
|
Scheme_App_Rec *app = (Scheme_App_Rec *)e;
|
||||||
|
if (n != app->num_args) return 0;
|
||||||
return SAME_OBJ(scheme_values_func, app->args[0]);
|
return SAME_OBJ(scheme_values_func, app->args[0]);
|
||||||
} else if (SAME_TYPE(SCHEME_TYPE(e), scheme_application2_type)) {
|
} else if ((n == 1) && SAME_TYPE(SCHEME_TYPE(e), scheme_application2_type)) {
|
||||||
Scheme_App2_Rec *app = (Scheme_App2_Rec *)e;
|
Scheme_App2_Rec *app = (Scheme_App2_Rec *)e;
|
||||||
return SAME_OBJ(scheme_values_func, app->rator);
|
return SAME_OBJ(scheme_values_func, app->rator);
|
||||||
} else if (SAME_TYPE(SCHEME_TYPE(e), scheme_application3_type)) {
|
} else if ((n == 2) && SAME_TYPE(SCHEME_TYPE(e), scheme_application3_type)) {
|
||||||
Scheme_App3_Rec *app = (Scheme_App3_Rec *)e;
|
Scheme_App3_Rec *app = (Scheme_App3_Rec *)e;
|
||||||
return SAME_OBJ(scheme_values_func, app->rator);
|
return SAME_OBJ(scheme_values_func, app->rator);
|
||||||
}
|
}
|
||||||
|
@ -3340,6 +3341,18 @@ static int is_values_apply(Scheme_Object *e)
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static int no_mutable_bindings(Scheme_Compiled_Let_Value *pre_body)
|
||||||
|
{
|
||||||
|
int i;
|
||||||
|
|
||||||
|
for (i = pre_body->count; i--; ) {
|
||||||
|
if (pre_body->flags[i] & SCHEME_WAS_SET_BANGED)
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
static void unpack_values_application(Scheme_Object *e, Scheme_Compiled_Let_Value *naya,
|
static void unpack_values_application(Scheme_Object *e, Scheme_Compiled_Let_Value *naya,
|
||||||
int rev_bind_order)
|
int rev_bind_order)
|
||||||
{
|
{
|
||||||
|
@ -3847,12 +3860,13 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i
|
||||||
/* Change (let-values ([(id ...) (values e ...)]) body)
|
/* Change (let-values ([(id ...) (values e ...)]) body)
|
||||||
to (let-values ([id e] ...) body) for simple e. */
|
to (let-values ([id e] ...) body) for simple e. */
|
||||||
if ((pre_body->count != 1)
|
if ((pre_body->count != 1)
|
||||||
&& is_values_apply(value)
|
&& is_values_apply(value, pre_body->count)
|
||||||
&& scheme_omittable_expr(value, pre_body->count, -1, 0, info,
|
&& ((!is_rec && no_mutable_bindings(pre_body))
|
||||||
(is_rec
|
|| scheme_omittable_expr(value, pre_body->count, -1, 0, info,
|
||||||
? (pre_body->position + pre_body->count)
|
(is_rec
|
||||||
: -1),
|
? (pre_body->position + pre_body->count)
|
||||||
0)) {
|
: -1),
|
||||||
|
0))) {
|
||||||
if (!pre_body->count && !i) {
|
if (!pre_body->count && !i) {
|
||||||
/* We want to drop the clause entirely, but doing it
|
/* We want to drop the clause entirely, but doing it
|
||||||
here messes up the loop for letrec. So wait and
|
here messes up the loop for letrec. So wait and
|
||||||
|
|
Loading…
Reference in New Issue
Block a user