From 9a94366c2cdce0bf56e039ef83fdf431ecf1fc8f Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Sun, 2 Nov 2014 19:15:07 -0700
Subject: [PATCH] optimizer: fix reordering problems

When a variable X is bound to an expression that implies properties of
other bindings, and if X is used only once and can be replaced by
its value expression, then further optimization of that expression must
not assume the properties that are established by evaluating the
expression.

Also, don't move expressions past unsafe operations, since the expression
might implicitly guard against unsafety.

Closes PR 14819
---
 .../racket-test/tests/racket/optimize.rktl    | 51 ++++++++++++++++---
 racket/src/racket/src/optimize.c              | 20 +++++++-
 2 files changed, 63 insertions(+), 8 deletions(-)

diff --git a/pkgs/racket-pkgs/racket-test/tests/racket/optimize.rktl b/pkgs/racket-pkgs/racket-test/tests/racket/optimize.rktl
index 7509b80340..17fa117072 100644
--- a/pkgs/racket-pkgs/racket-test/tests/racket/optimize.rktl
+++ b/pkgs/racket-pkgs/racket-test/tests/racket/optimize.rktl
@@ -1741,18 +1741,45 @@
     (test 2 values v)))
 
 (test-comp '(lambda (z)
-              ;; ok to reorder `(list z)` and `(list (z 2))`,
-              ;; which then allows more simplication:
-              (let-values ([(a b) (values (list z) (list (z 2)))])
-                (list a b)))
+             ;; Moving `(list z)` before `(list (z 2))`
+             ;; would reorder, which is not allowed, so check
+             ;; that the optimizer can keep track:
+             (let-values ([(a b) (values (list z) (list (z 2)))])
+               (list a b)))
            '(lambda (z)
               (list (list z) (list (z 2)))))
 (test-comp '(lambda (z)
               (let-values ([(a b) (values (list (z 2)) (list z))])
                 (list a b)))
            '(lambda (z)
-              (let ([p (list z)])
-                (list (list (z 2)) p))))
+             (list (list (z 2)) (list z))))
+
+#;
+(test-comp '(lambda (z)
+             ;; It's ok to reorder unsafe operations relative
+             ;; to each other:
+             (let ([x (unsafe-fx+ z z)]
+                   [y (unsafe-fx- z z)])
+               (- y x)))
+           '(lambda (z)
+             (- (unsafe-fx- z z) (unsafe-fx+ z z))))
+
+(test-comp '(lambda (z)
+             ;; It's not ok to move a safe operation past an
+             ;; unsafe one:
+             (let ([x (car z)])
+               (+ (unsafe-car z) x)))
+           '(lambda (z)
+             (+ (unsafe-car z) (car z)))
+           #f)
+
+(test-comp '(lambda (z)
+             ;; It's ok to move an unsafe operation past a
+             ;; safe one:
+             (let ([x (unsafe-car void)])
+               (+ (car z) x)))
+           '(lambda (z)
+             (+ (car z) (unsafe-car void))))
 
 (test-comp '(lambda (z)
               (let-values ([(x y)
@@ -4197,6 +4224,18 @@
 
 (test 1 dynamic-require ''module-with-cross-module-inlining 'n)
 
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Check that moving `(car x)` doesn't assume
+;; the pairness invariant established by `(car x)`.
+
+(define (f x)
+  (define (g x)
+    (let* ([z (random)]
+           [y (car x)])
+      (+ (random y) z)))
+  (g x))
+
+(err/rt-test (f 10))
 
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
diff --git a/racket/src/racket/src/optimize.c b/racket/src/racket/src/optimize.c
index 1d251c32df..dd29af3800 100644
--- a/racket/src/racket/src/optimize.c
+++ b/racket/src/racket/src/optimize.c
@@ -83,6 +83,7 @@ struct Optimize_Info
   Scheme_Object *context; /* for logging */
   Scheme_Logger *logger;
   Scheme_Hash_Tree *types; /* maps position (from this frame) to predicate */
+  int no_types;
 };
 
 typedef struct Optimize_Info_Sequence {
@@ -2159,7 +2160,7 @@ static Scheme_Object *check_app_let_rator(Scheme_Object *app, Scheme_Object *rat
 static int is_nonmutating_primitive(Scheme_Object *rator, int n)
 {
   if (SCHEME_PRIMP(rator)
-      && (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & (SCHEME_PRIM_IS_OMITABLE | SCHEME_PRIM_IS_UNSAFE_NONMUTATING))
+      && (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & (SCHEME_PRIM_IS_OMITABLE))
       && (n >= ((Scheme_Primitive_Proc *)rator)->mina)
       && (n <= ((Scheme_Primitive_Proc *)rator)->mu.maxa))
     return 1;
@@ -6844,10 +6845,22 @@ Scheme_Object *scheme_optimize_expr(Scheme_Object *expr, Optimize_Info *info, in
                                     0, 5)) {
             val = optimize_clone(1, o->expr, info, o->delta, 0);
             if (val) {
+              int save_fuel = info->inline_fuel, save_no_types = info->no_types;
+              int save_vclock, save_kclock;
               info->size -= 1;
               o->used = 1;
               info->inline_fuel = 0; /* no more inlining; o->expr was already optimized */
-              return scheme_optimize_expr(val, info, context);
+              info->no_types = 1; /* cannot used inferred types, in case `val' inferred them */
+              save_vclock = info->vclock; /* allowed to move => no change to clocks */
+              save_kclock = info->kclock;
+
+              val = scheme_optimize_expr(val, info, context);
+
+              info->inline_fuel = save_fuel;
+              info->no_types = save_no_types;
+              info->vclock = save_vclock;
+              info->kclock = save_kclock;
+              return val;
             }
           }
           /* Can't move expression, so lookup again to mark as used
@@ -7976,6 +7989,8 @@ Scheme_Object *optimize_get_predicate(int pos, Optimize_Info *info)
 {
   Scheme_Object *pred;
 
+  if (info->no_types) return NULL;
+
   while (info) {
     if (info->types) {
       pred = scheme_hash_tree_get(info->types, scheme_make_integer(pos));
@@ -8011,6 +8026,7 @@ static Optimize_Info *optimize_info_add_frame(Optimize_Info *info, int orig, int
   naya->init_kclock = info->kclock;
   naya->use_psize = info->use_psize;
   naya->logger = info->logger;
+  naya->no_types = info->no_types;
 
   return naya;
 }