From 3150b31eb72393b821d005ddfee644dc2a7a1d0d Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Thu, 16 Aug 2012 15:47:20 -0600
Subject: [PATCH] bytecode optimizer improvement

Generalize splitting of `(let-values ([(x ...) (values e ...)]) ....)'
to `(let ([x e] ...) ....)' for any `e', since it's always equivalent.
Right?

(The old requirements on the `e's seem to be needed only for
`letrec-values' splitting and maybe mutable variables.)
---
 collects/tests/racket/optimize.rktl | 35 +++++++++++++++++++++++++++++
 src/racket/src/optimize.c           | 32 ++++++++++++++++++--------
 2 files changed, 58 insertions(+), 9 deletions(-)

diff --git a/collects/tests/racket/optimize.rktl b/collects/tests/racket/optimize.rktl
index 2c09c6c342..2d3bb4e332 100644
--- a/collects/tests/racket/optimize.rktl
+++ b/collects/tests/racket/optimize.rktl
@@ -1570,6 +1570,41 @@
                       [b (unsafe-fx+ x x)])
                   (list a b)))))
 
+(test-comp `(module m racket/base
+              (define (f x)
+                (let-values ([(a b) (values x (+ x x))])
+                  (list a b))))
+           `(module m racket/base
+              (define (f x)
+                (let ([a x]
+                      [b (+ x x)])
+                  (list a b)))))
+
+(test-comp `(module m racket/base
+              (define (f x)
+                (let*-values ([(a b) (values x (+ x x))])
+                  (list a b))))
+           `(module m racket/base
+              (define (f x)
+                (let* ([a x]
+                       [b (+ x x)])
+                  (list a b)))))
+
+(test-comp `(module m racket/base
+              (define (f x)
+                (let*-values ([(a b) (values x (+ x x))])
+                  (set! a 5)
+                  (/ a b))))
+           `(module m racket/base
+              (define (f x)
+                ;; Not equivalent if a continuation capture
+                ;; during `+' somehow exposes the shared `a'?
+                (let* ([a x]
+                       [b (+ x x)])
+                  (set! a 5)
+                  (/ a b))))
+           #f)
+
 ;; check omit & reorder possibilities for unsafe
 ;; operations on mutable values:
 (let ()
diff --git a/src/racket/src/optimize.c b/src/racket/src/optimize.c
index 5f0a9c8470..3b80cbd7fe 100644
--- a/src/racket/src/optimize.c
+++ b/src/racket/src/optimize.c
@@ -3324,15 +3324,16 @@ Scheme_Object *scheme_make_noninline_proc(Scheme_Object *e)
   return ni;
 }
 
-static int is_values_apply(Scheme_Object *e)
+static int is_values_apply(Scheme_Object *e, int n)
 {
   if (SAME_TYPE(SCHEME_TYPE(e), scheme_application_type)) {
     Scheme_App_Rec *app = (Scheme_App_Rec *)e;
+    if (n != app->num_args) return 0;
     return SAME_OBJ(scheme_values_func, app->args[0]);
-  } else if (SAME_TYPE(SCHEME_TYPE(e), scheme_application2_type)) {
+  } else if ((n == 1) && SAME_TYPE(SCHEME_TYPE(e), scheme_application2_type)) {
     Scheme_App2_Rec *app = (Scheme_App2_Rec *)e;
     return SAME_OBJ(scheme_values_func, app->rator);
-  } else if (SAME_TYPE(SCHEME_TYPE(e), scheme_application3_type)) {
+  } else if ((n == 2) && SAME_TYPE(SCHEME_TYPE(e), scheme_application3_type)) {
     Scheme_App3_Rec *app = (Scheme_App3_Rec *)e;
     return SAME_OBJ(scheme_values_func, app->rator);
   }
@@ -3340,6 +3341,18 @@ static int is_values_apply(Scheme_Object *e)
   return 0;
 }
 
+static int no_mutable_bindings(Scheme_Compiled_Let_Value *pre_body)
+{
+  int i;
+
+  for (i = pre_body->count; i--; ) {
+    if (pre_body->flags[i]  & SCHEME_WAS_SET_BANGED)
+      return 0;
+  }
+
+  return 1;
+}
+
 static void unpack_values_application(Scheme_Object *e, Scheme_Compiled_Let_Value *naya,
                                       int rev_bind_order)
 {
@@ -3847,12 +3860,13 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i
     /* Change (let-values ([(id ...) (values e ...)]) body)
        to (let-values ([id e] ...) body) for simple e. */
     if ((pre_body->count != 1)
-        && is_values_apply(value)
-        && scheme_omittable_expr(value, pre_body->count, -1, 0, info,
-                                 (is_rec
-                                  ? (pre_body->position + pre_body->count)
-                                  : -1),
-                                 0)) {
+        && is_values_apply(value, pre_body->count)
+        && ((!is_rec && no_mutable_bindings(pre_body))
+            || scheme_omittable_expr(value, pre_body->count, -1, 0, info,
+                                     (is_rec
+                                      ? (pre_body->position + pre_body->count)
+                                      : -1),
+                                     0))) {
       if (!pre_body->count && !i) {
         /* We want to drop the clause entirely, but doing it
            here messes up the loop for letrec. So wait and