From 22069faebc7d9d55347942107e4a309d2df7fc75 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 17 Jun 2020 07:02:49 -0600 Subject: [PATCH] bc: fix compiler for `set!` as first subexpression of `begin0` An optimization relatively late in the BC bytecode compiler pipeline was wrong for `begin0`. The transformation and bug must be a very old, since it's intended to help the bytecode interpreter. Thanks to Sage for reporting and Alexis for initial debugging. --- pkgs/racket-test-core/tests/racket/syntax.rktl | 9 +++++++++ racket/src/racket/src/resolve.c | 8 +++++--- 2 files changed, 14 insertions(+), 3 deletions(-) diff --git a/pkgs/racket-test-core/tests/racket/syntax.rktl b/pkgs/racket-test-core/tests/racket/syntax.rktl index bbd5cbd0b0..6dcca5b6e7 100644 --- a/pkgs/racket-test-core/tests/racket/syntax.rktl +++ b/pkgs/racket-test-core/tests/racket/syntax.rktl @@ -2273,6 +2273,15 @@ (err/rt-test (write c (open-output-bytes)) exn:fail?)) +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Regression test to make sure `(set! ...)` on a local variable +;; in the first position of ` begin0` is not miscompiled + +(test (void) (let ([i 0]) + (λ () (begin0 + (set! i (add1 i)) + (+ i 1))))) + ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (report-errs) diff --git a/racket/src/racket/src/resolve.c b/racket/src/racket/src/resolve.c index b97b8a398e..b8446ccd38 100644 --- a/racket/src/racket/src/resolve.c +++ b/racket/src/racket/src/resolve.c @@ -506,13 +506,15 @@ static Scheme_Object *resolve_wcm(Scheme_Object *o, Resolve_Info *info) static Scheme_Object *look_for_letv_change(Scheme_Sequence *s) { - int i; + int i, start; /* Change (begin e1 ... (set!-for-let [x 10] (void)) e2 ...) to (begin e1 ... (set!-for-let [x 10] e2 ...)), which avoids an unneeded recursive call in the evaluator */ - for (i = 0; i < s->count - 1; i++) { + start = ((SCHEME_TYPE(s) == scheme_begin0_sequence_type) ? 1 : 0); + + for (i = start; i < s->count - 1; i++) { Scheme_Object *v; v = s->array[i]; if (SAME_TYPE(SCHEME_TYPE(v), scheme_let_value_type)) { @@ -570,7 +572,7 @@ static Scheme_Object *resolve_sequence(Scheme_Object *o, Resolve_Info *info) le = resolve_expr(s->array[i], info); s->array[i] = le; } - + return look_for_letv_change(s); }