cp0: prefer dropping a binding to begin rotation

A follow-up to c081296, this commit adjusts the cp0 change to
prefer an existing case instead of the new one. This order still
passes the new test, it passes old ones with a small adjustment, and
it passes Racket tests that are similar to "cp0.ms" tests.

Meanwhile, c081296 should have noted the PR (#789) it squashes and
some author information that was lost in the squash:
Co-authored-by: R. Kent Dybvig <dyb@scheme.com>

mats/record.ms

@@ -9008,10 +9008,9 @@
                        (new q x)))))))
            (make-foo 3))))
     `(let ([ctr 0])
-       (letrec ([g0 (lambda (new) (lambda (q) (set! ctr (#2%+ 1 xtr)) (new q ctr)))])
+       (letrec ([g0 (lambda (new) (lambda (q) (new q (begin (set! ctr (#2%+ 1 xtr)) ctr))))])
          (#3%$value (#3%$make-record-constructor-descriptor ',record-type-descriptor?  #f g0 'define-record-type))
-         (set! ctr (#2%+ 1 xtr))
-         (#3%$record ',record-type-descriptor? 3 ctr))))
+         (#3%$record ',record-type-descriptor? 3 (begin (set! ctr (#2%+ 1 xtr)) ctr)))))
   (equivalent-expansion?
     (parameterize ([optimize-level 3] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
       (expand/optimize
@@ -9028,10 +9027,9 @@
                        (new q x)))))))
            (make-foo 3))))
     `(let ([ctr 0])
-       (letrec ([g0 (lambda (new) (lambda (q) (set! ctr (#3%+ 1 xtr)) (new q ctr)))])
+       (letrec ([g0 (lambda (new) (lambda (q) (new q (begin (set! ctr (#3%+ 1 xtr)) ctr))))])
          (#3%$value (#3%$make-record-constructor-descriptor ',record-type-descriptor?  #f g0 'define-record-type))
-         (set! ctr (#3%+ 1 xtr))
-         (#3%$record ',record-type-descriptor? 3 ctr))))
+         (#3%$record ',record-type-descriptor? 3 (begin (set! ctr (#3%+ 1 xtr)) ctr)))))
   (error? ; invalid uid
     (let ()
       (define useless
@@ -9051,6 +9049,44 @@
         (foo-x (make-foo 3.0 y))))
     #t)
   (equal? ($foo 17) 3.0)
+  ;; regression test that relies on preferring to drop a binding
+  ;; instead of rotating a `begin` out from the right-hand side
+  (equivalent-expansion?
+   (parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
+     (expand/optimize
+      '(lambda (instance)
+         (define-record-type instance-variable-reference
+           (fields inst kind))
+         (define (variable-reference-constant? v)
+           (eq? (instance-variable-reference-kind v) 'constant))
+         (lambda (x_1 y_2 f_3)
+           (begin
+             (set! x_1 5)
+             (let ([app_6 (variable-reference-constant?
+                           (letrec* ([z_4 (let ([z (lambda () z_4)]) z)])
+                             (begin
+                               (f_3 z_4)
+                               (make-instance-variable-reference
+                                instance
+                                'mutable))))])
+               (list #f #t app_6
+                     (variable-reference-constant?
+                      (letrec* ([z_5 (let ([z (lambda () z_5)]) x)])
+                        (begin
+                          (f_3 z_5)
+                          (make-instance-variable-reference
+                           instance
+                           'constant)))))))))))
+   '(lambda (instance)
+      (let ([rtd (#2%$make-record-type-descriptor #!base-rtd 'instance-variable-reference #f #f #f #f
+                                                  '#((immutable inst) (immutable kind)) 'define-record-type)])
+        (lambda (x_1 y_2 f_3)
+          (letrec ([z_4 (lambda () z_4)])
+            (f_3 z_4)
+            (let ([z_5 x])
+              (#3%$value
+               (begin (f_3 z_5) (#3%$record rtd instance 'constant)))
+              (#2%list #f #t #f #t)))))))
  )
 
 (mat cp0-rtd-inspection-optimizations

s/cp0.ss

@@ -1705,14 +1705,6 @@
                     ; (let ((x e)) x) => e
                     ; x is clearly not assigned, even if flags are polluted and say it is
                     (make-nontail (app-ctxt ctxt) (car rhs*))]
-                   [(and (= (length id*) 1)
-                         (= (length rhs*) 1)
-                         (nanopass-case (Lsrc Expr) (car rhs*)
-                           [(seq ,e1 ,e2)
-                            ; (let ((x (begin e1 e2))) e3) => (begin e1 (let ((x e2)) e3))
-                            ; this can expose (immutable-vector ...) in e2 to optimization
-                            `(seq ,e1 ,(build-let lambda-preinfo id* (list e2) body))]
-                           [else #f]))]
                    ; we drop the RHS of a let binding into the let body when the body expression is a call 
                    ; and we can do so without violating evaluation order of bindings wrt the let body:
                    ;  * for pure, singly referenced bindings, we drop them to the variable reference site
@@ -1807,6 +1799,14 @@
                              [(record-type ,rtd ,e)
                               (drop-let (list e) (lambda (e e*) (safe-assert (null? e*)) `(record-type ,rtd ,e)))]
                              [else #f])))]
+                   [(and (= (length id*) 1)
+                         (= (length rhs*) 1)
+                         (nanopass-case (Lsrc Expr) (car rhs*)
+                           [(seq ,e1 ,e2)
+                            ; (let ((x (begin e1 e2))) e3) => (begin e1 (let ((x e2)) e3))
+                            ; this can expose (immutable-vector ...) in e2 to optimization
+                            `(seq ,e1 ,(build-let lambda-preinfo id* (list e2) body))]
+                           [else #f]))]
                    [else (build-let lambda-preinfo id* rhs* body)]))))]))
 
     (define cp0-let