diff --git a/collects/tests/racket/optimize.rktl b/collects/tests/racket/optimize.rktl index cb4db4eac8..bf2e847d66 100644 --- a/collects/tests/racket/optimize.rktl +++ b/collects/tests/racket/optimize.rktl @@ -860,6 +860,39 @@ '(lambda () (box 0.0)) #f) +;; Make sure that a mutable top-level isn't copy-propagated +;; across another effect: +(test-comp '(module m racket/base + (define x 10) + (define (f y) + (let ([old x]) + (set! x y) + (set! x old)))) + '(module m racket/base + (define x 10) + (define (f y) + (let ([old x]) + (set! x y) + (set! x x)))) + #f) + +;; Do copy-propagate a reference to a mutable top-level +;; across non-effects: +(test-comp '(module m racket/base + (define x 10) + (define (f y) + (let ([old x]) + (list (cons y y) + (set! x old))))) + '(module m racket/base + (define x 10) + (define (f y) + (begin + x ; compiler might not determine that `x' is definitely defined + (list (cons y y) + (set! x x))))) + #f) + (test-comp '(let ([x 1][y 2]) x) '1) (test-comp '(let ([x 1][y 2]) (+ y x)) diff --git a/src/racket/src/optimize.c b/src/racket/src/optimize.c index 511df50a46..28094ffb70 100644 --- a/src/racket/src/optimize.c +++ b/src/racket/src/optimize.c @@ -488,7 +488,7 @@ static int single_valued_noncm_expression(Scheme_Object *expr, int fuel) Scheme_Object *rator = NULL; switch (SCHEME_TYPE(expr)) { - case scheme_toplevel_type: + case scheme_compiled_toplevel_type: return 1; case scheme_application_type: rator = ((Scheme_App_Rec *)expr)->args[0]; @@ -2718,12 +2718,12 @@ set_optimize(Scheme_Object *data, Optimize_Info *info, int context) delta = optimize_info_get_shift(info, pos); if (delta) var = scheme_make_local(scheme_local_type, pos + delta, 0); - - info->vclock++; } else { optimize_info_used_top(info); } + info->vclock++; + sb->var = var; sb->val = val; @@ -3156,7 +3156,7 @@ int scheme_compiled_propagate_ok(Scheme_Object *value, Optimize_Info *info) if (SAME_TYPE(SCHEME_TYPE(value), scheme_compiled_toplevel_type)) { - if (SCHEME_TOPLEVEL_FLAGS(value) >= SCHEME_TOPLEVEL_FIXED) + if ((SCHEME_TOPLEVEL_FLAGS(value) & SCHEME_TOPLEVEL_FLAGS_MASK) >= SCHEME_TOPLEVEL_FIXED) return 1; if (info->top_level_consts) { int pos;