fix optimizer bug

Fix a regression relative to v6.4 caused by a refactoring of the
compiler between v6.4 and v6.5. The refactoring lost information about
letrecs that are converted internally to let* when a mutable variable
is involved, and it ends up allocating a closure before the box of a
mutable variable that is referenced by the closure. Something like
`with-continuation-mark` is needed around the closure's `lambda` to
prevent other optimizations from hiding the bug.

Closes #1462

pkgs/racket-test-core/tests/racket/optimize.rktl

@@ -6240,6 +6240,27 @@
                 777)
  exn:fail:contract?)
 
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; The `let` and `with-continuation-mark` wrappers for `b`
+;; delay the optimizer's detection of the right-hand side as
+;; a closure enough that the resolve pass gets a `letrec`
+;; that is being reinterpreted as a `let*`. But make sure 
+;; that the location of `a` is allocated before the closure
+;; for `b`.
+
+(test (void)
+      'call
+      (let ([f (letrec ([a 0]
+                        [b (let ([t 0])
+                             (with-continuation-mark
+                                 'x
+                               'y
+                               (lambda () (set! a 1))))])
+                 (list b b))])
+        (set! f f)
+        ((car f))))
+
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (report-errs)

racket/src/racket/src/optimize.c

@@ -133,6 +133,7 @@ static Scheme_Object *do_expr_implies_predicate(Scheme_Object *expr, Optimize_In
                                                 Scheme_Hash_Tree *ignore_vars);
 static int produces_local_type(Scheme_Object *rator, int argc);
 static int optimize_any_uses(Optimize_Info *info, Scheme_IR_Let_Value *at_irlv, int n);
+static void optimize_uses_of_mutable_imply_early_alloc(Scheme_IR_Let_Value *at_irlv, int n);
 static void propagate_used_variables(Optimize_Info *info);
 static int env_uses_toplevel(Optimize_Info *frame);
 static Scheme_IR_Local *clone_variable(Scheme_IR_Local *var);
@@ -7628,6 +7629,7 @@ static Scheme_Object *optimize_lets(Scheme_Object *form, Optimize_Info *info, in
     /* We can simplify letrec to let* */
     SCHEME_LET_FLAGS(head) -= SCHEME_LET_RECURSIVE;
     is_rec = 0;
+    optimize_uses_of_mutable_imply_early_alloc((Scheme_IR_Let_Value *)head->body, head->num_clauses);
   }
 
   /* Optimized away all clauses? */
@@ -9371,6 +9373,40 @@ static int optimize_any_uses(Optimize_Info *info, Scheme_IR_Let_Value *at_irlv,
   return 0;
 }
 
+static void optimize_uses_of_mutable_imply_early_alloc(Scheme_IR_Let_Value *at_irlv, int n)
+{
+  int i, j;
+  Scheme_IR_Let_Value *irlv = at_irlv;
+
+  /* We we're reinterpreting a `letrec` as `let*`, and when it realy
+     must be `let*` instead of `let`, and when a mutable variable is
+     involved, then we need to tell the `resolve` pass that the
+     mutable varaiable's value must be boxed immediately, instead of
+     delaying to the body of the `let*`. */
+
+  while (n--) {
+    for (i = irlv->count; i--; ) {
+      if (irlv->vars[i]->mutated) {
+        int used = 0;
+        if (irlv->vars[i]->optimize_used)
+          used = 1;
+        else {
+          for (j = at_irlv->count; j--; ) {
+            if (at_irlv->vars[j]->optimize.transitive_uses) {
+              if (scheme_hash_get(at_irlv->vars[j]->optimize.transitive_uses,
+                                  (Scheme_Object *)irlv->vars[i]))
+                used = 1;
+            }
+          }
+        }
+        if (used)
+          irlv->vars[i]->must_allocate_immediately = 1;
+      }
+    }
+    irlv = (Scheme_IR_Let_Value *)irlv->body;
+  }
+}
+
 static void register_use(Scheme_IR_Local *var, Optimize_Info *info)
 {
   MZ_ASSERT(SCHEME_VAR(var)->mode == SCHEME_VAR_MODE_OPTIMIZE);

racket/src/racket/src/resolve.c

@@ -1501,7 +1501,8 @@ Scheme_Object *scheme_resolve_lets(Scheme_Object *form, Resolve_Info *info)
             if (!recbox && irlv->vars[j]->mutated) {
               GC_CAN_IGNORE Scheme_Object *pos;
               pos = scheme_make_integer(lv->position + j);
-              if (SCHEME_LET_FLAGS(head) & SCHEME_LET_RECURSIVE) {
+              if ((SCHEME_LET_FLAGS(head) & SCHEME_LET_RECURSIVE)
+                  || irlv->vars[j]->must_allocate_immediately) {
                 /* For let* or a let*-like letrec, we need to insert the boxes after each evaluation. */
                 Scheme_Object *boxenv;
 

racket/src/racket/src/schpriv.h

@@ -1538,6 +1538,10 @@ typedef struct Scheme_IR_Local
   unsigned int optimize_outside_binding : 1;
   /* Records an anlaysis during the resolve pass: */
   unsigned int resolve_omittable : 1;
+  /* Records whether the variable is mutated and used before
+     the body of its binding, so that itmust be allocated at latest
+     after it's RHS expression is evaluated: */
+  unsigned int must_allocate_immediately : 1;
   /* The type desired by use positions for unboxing purposes;
      set by the optimizer: */
   unsigned int arg_type : SCHEME_MAX_LOCAL_TYPE_BITS;