From 0e95d49ddbc2bcd489df653c183a90aa5cc59b66 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Thu, 7 Jul 2011 16:57:17 -0600
Subject: [PATCH] allow more expression reordering, especially unsafe ops

---
 collects/tests/racket/optimize.rktl |  9 ++++
 src/racket/src/optimize.c           | 74 ++++++++++++++++++++++++++++-
 2 files changed, 81 insertions(+), 2 deletions(-)

diff --git a/collects/tests/racket/optimize.rktl b/collects/tests/racket/optimize.rktl
index f893c33778..19786cf75e 100644
--- a/collects/tests/racket/optimize.rktl
+++ b/collects/tests/racket/optimize.rktl
@@ -830,6 +830,15 @@
                 (car (cdr (car x)))))
            '(lambda (w z) w))
 
+(test-comp '(lambda (w z)
+              (let ([x (list* w z)]
+                    [y (list* z w)])
+                (error "bad")
+                (equal? x y)))
+           '(lambda (w z)
+              (error "bad")
+              (equal? (list* w z) (list* z w))))
+
 (test-comp '(let ([x 1][y 2]) x)
 	   '1)
 (test-comp '(let ([x 1][y 2]) (+ y x))
diff --git a/src/racket/src/optimize.c b/src/racket/src/optimize.c
index cf52296c68..fc6cf5baeb 100644
--- a/src/racket/src/optimize.c
+++ b/src/racket/src/optimize.c
@@ -521,6 +521,74 @@ static int single_valued_noncm_expression(Scheme_Object *expr, int fuel)
  return 0;
 }
 
+static int is_movable_prim(Scheme_Object *rator, int n)
+{
+  if (rator && SCHEME_PRIMP(rator)) {
+    if (((Scheme_Prim_Proc_Header *)rator)->flags & SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL)
+      return 1;
+  }
+
+  if (SAME_OBJ(scheme_void_proc, rator)
+      || SAME_OBJ(scheme_list_proc, rator)
+      || (SAME_OBJ(scheme_cons_proc, rator) && (n == 2))
+      || SAME_OBJ(scheme_list_star_proc, rator)
+      || SAME_OBJ(scheme_vector_proc, rator)
+      || SAME_OBJ(scheme_vector_immutable_proc, rator)
+      || (SAME_OBJ(scheme_box_proc, rator) && (n == 1)))
+    return 1;
+
+  return 0;
+}
+
+static int movable_expression(Scheme_Object *expr, Optimize_Info *info, int delta, int fuel)
+/* An expression that can't necessarily be constant-folded,
+   but can be delayed because it has no side-effects (or is unsafe);
+   also not sensitive to being in tail position */
+{
+  if (fuel < 0) return 0;
+
+  switch (SCHEME_TYPE(expr)) {
+  case scheme_local_type:
+    {
+      /* Ok if not mutable */
+      int pos = SCHEME_LOCAL_POS(expr);
+      if (pos + delta < 0)
+        return 1;
+      else if (!optimize_is_mutated(info, pos + delta))
+        return 1;
+    }
+    break;
+  case scheme_application_type:
+    if (is_movable_prim(((Scheme_App_Rec *)expr)->args[0], ((Scheme_App_Rec *)expr)->num_args)) {
+      int i;
+      for (i = ((Scheme_App_Rec *)expr)->num_args; i--; ) {
+        if (!movable_expression(((Scheme_App_Rec *)expr)->args[i+1], info, delta, fuel - 1))
+          return 0;
+      }
+      return 1;
+    }
+    break;
+  case scheme_application2_type:
+    if (is_movable_prim(((Scheme_App2_Rec *)expr)->rator, 1)) {
+      if (movable_expression(((Scheme_App2_Rec *)expr)->rand, info, delta, fuel - 1))
+        return 1;
+    }
+    break;
+  case scheme_application3_type:
+    if (is_movable_prim(((Scheme_App3_Rec *)expr)->rator, 2)) {
+      if (movable_expression(((Scheme_App3_Rec *)expr)->rand1, info, delta, fuel - 1)
+          && movable_expression(((Scheme_App3_Rec *)expr)->rand2, info, delta, fuel - 1))
+        return 1;
+    }
+    break;
+  default:
+    if (SCHEME_TYPE(expr) > _scheme_compiled_values_types_)
+      return 1;
+  }
+
+  return 0;
+}
+
 int scheme_is_compiled_procedure(Scheme_Object *o, int can_be_closed, int can_be_liftable)
 {
   if (SAME_TYPE(SCHEME_TYPE(o), scheme_compiled_unclosed_procedure_type)) {
@@ -4772,8 +4840,10 @@ Scheme_Object *scheme_optimize_expr(Scheme_Object *expr, Optimize_Info *info, in
       if (val) {
         if (SAME_TYPE(SCHEME_TYPE(val), scheme_once_used_type)) {
           Scheme_Once_Used *o = (Scheme_Once_Used *)val;
-          if ((o->vclock == info->vclock)
-              && single_valued_noncm_expression(o->expr, 5)) {
+          if (((o->vclock == info->vclock)
+               && single_valued_noncm_expression(o->expr, 5))
+              || ((o->vclock != info->vclock)
+                  && movable_expression(o->expr, info, o->delta, 5))) {
             val = scheme_optimize_clone(1, o->expr, info, o->delta, 0);
             if (val) {
               info->size -= 1;