Fix handling of (set! var (let (var) ...)) and similar cases.

Was moving (set!) into the (%bind) form, and thus setting the wrong variable.
Now, if set! var is bound, will create a temporary for result of %bind first,
and set! original variable to temporary in the proper scope.

Also, normalize rules for nested (%bind)s:
* The (%bind) inside a (%lambda) is always flat.
   - This is a responsiblity of simplify-lambda, and any function which
     may change structure after simplification (e.g. promote-to-box).
* Any other (%bind) may be nested, unless otherwise noted.

compiler.ss

@@ -327,10 +327,16 @@
   (form-captures? form var #f #t))
 
 (define (simplify-set! form)
-  (let ([value-form (simplify-form (third form))])
+  (let ([variable (second form)]
+        [value-form (simplify-form (third form))])
     (if (and (pair? value-form) (eq? (first value-form) '%bind))
-        (simplify-form
+        (if (memq variable (second value-form))
-          `(let ,(second value-form)
+            (let ([tmp (gensym)])
+              `(%bind (,tmp)
+                 ; guaranteed not to cause unbounded recursion: tmp is unique
+                 ,(simplify-set! `(set! ,tmp ,value-form))
+                 (%set! ,variable ,tmp)))
+            `(%bind ,(second value-form)
                ,@(foldr (lambda (subform after)
                           (cond
                             [(pair? after) (cons subform after)]
@@ -338,12 +344,13 @@
                              ; Requires at least one value; ignores extras.
                              (if (null? (cdr subform))
                                  (error "Attempted to set variable to void in:" form)
-                               `((set! ,(second form) ,(second subform))))]
+                                 `((%set! ,variable ,(second subform))))]
-                          [(value-form? subform) `((set! ,(second form) ,subform))]
+                            [(value-form? subform)
+                             (list (simplify-set! `(set! ,variable ,subform)))]
                             [else (error "Attempted to set variable to void in:" form)]))
                         '()
                         (cddr value-form))))
-        `(%set! ,(second form) ,value-form))))
+        `(%set! ,variable ,value-form))))
 
 (define (simplify-primitive simple-op value-forms)
   (define (value->binding value-form)
@@ -379,7 +386,6 @@
   (define vars (map first bindings))
   (define (bound-var? var) (and (memq var vars) #t))
 
-  (flatten-binds
   ; If the value of any binding refers to one of the variable names being bound...
   (if (ormap (lambda (value) (ormap bound-var? (free-variables value)))
              (map second (filter has-value? bindings)))
@@ -400,7 +406,7 @@
        ,@(map (lambda (binding)
                 (simplify-set! `(set! ,@binding)))
               (filter has-value? bindings))
-         ,@(map simplify-form bodyexprs)))))
+       ,@(map simplify-form bodyexprs))))
 
 ; (let* ...)   ; eval exprs & bind variables serially
 ;    => (let ([var-0 expr-0])
@@ -489,9 +495,10 @@
     [else                  (let-values ([(req opt rst) (split-arglist (cdr arglist))])
                              (values (cons (car arglist) req) opt rst))]))
 
-(define (add-return ctx k form)
+(define (add-return ctx k nested-bind)
+  (define flat-bind (flatten-binds nested-bind))
   (define argv (gensym))
-  `(%bind (,@(second form) ,argv)
+  `(%bind (,@(second flat-bind) ,argv)
      ,@(foldr (lambda (subform after)
                 (cond
                   [(pair? after)
@@ -519,44 +526,42 @@
                    `(,subform
                      (%tail-call ,k %nil #f #f))]))
                '()
-               (cddr form))))
+               (cddr flat-bind))))
 
 (define (simplify-lambda form)
    (define arglist (car (cdr form)))
    (define bodyexprs (cdr (cdr form)))
 
    (define-values (requireds optionals rest) (split-arglist arglist))
-   (define argv-temp (gensym))
+   (define argv (gensym))
    (define ctx (gensym))
    (define k (gensym))
 
-   (define (add-req req inner) `(let ([,req (car ,argv-temp)])
+   (define (add-req req inner) `(let ([,req (car ,argv)])
-                                  (set! ,argv-temp (cdr ,argv-temp))
+                                  (set! ,argv (cdr ,argv))
                                   ,inner))
    (define (add-opt opt-list inner) `(let (,(car opt-list))
-                                       (if (pair? ,argv-temp)
+                                       (if (pair? ,argv)
                                            (begin
-                                             (set! ,(first opt-list) (car ,argv-temp))
+                                             (set! ,(first opt-list) (car ,argv))
-                                             (set! ,argv-temp (cdr ,argv-temp)))
+                                             (set! ,argv (cdr ,argv)))
                                            (set! ,(first opt-list) ,(second opt-list)))
                                        ,inner))
-   (define rest+bodyexprs (if rest `(let ([,rest ,argv-temp]) ,@bodyexprs)
+   (define rest+bodyexprs (if rest `(let ([,rest ,argv]) ,@bodyexprs)
                                    `(begin ,@bodyexprs)))
    (narrow-binds
      `(%lambda () ()
         ,((compose (lambda (bind) (transform-to-cps ctx bind))
-                   (lambda (bind) (add-return ctx k bind))
+                   (lambda (bind) (add-return ctx k bind)))
-                   flatten-binds)
+          (simplify-form
-          `(%bind (,ctx ,k)
+            `(let ([,argv %argv]
-             (%set! ,ctx %ctx)
+                   [,ctx  %ctx]
-             (%set! ,k %k)
+                   [,k    %k])
-             ,(simplify-form
-                `(let ([,argv-temp %argv])
                ,(foldr add-req
                        (foldr add-opt
                               rest+bodyexprs
                               optionals)
-                           requireds))))))))
+                       requireds)))))))
 
 (define (narrow-binds simple-lambda-form)
   (define bind (fourth simple-lambda-form))
@@ -705,7 +710,8 @@
 ;      (%set! k-argv (%cons k %nil))
 ;      (%tail-call l k-argv ctx k))
 
-(define (transform-to-cps ctx bind)
+(define (transform-to-cps ctx nested-bind)
+  (define flat-bind (flatten-binds nested-bind))
   (define (cps-prepend subform after)
     (cond
       ; (%set! v (%apply x y))
@@ -774,8 +780,8 @@
       ; discard any form without side-effects
       [else after]))
   (flatten-binds
-    `(%bind ,(second bind)
+    `(%bind ,(second flat-bind)
-       ,@(foldr cps-prepend '() (cddr bind)))))
+       ,@(foldr cps-prepend '() (cddr flat-bind)))))
 
 ; (fn-expr arg-expr...)
 ;    => (let ([fn-var fn-expr] arg-var... argv)