From dfc64053b7d8e5542354a6d47030625d716f5faa Mon Sep 17 00:00:00 2001
From: Gustavo Massaccesi <gustavo@oma.org.ar>
Date: Sun, 28 Jun 2015 14:57:54 -0300
Subject: [PATCH] Infer type from comparisons in test positions

In (if (eq? x <pred?-expr>) <tbranch> <fbranch>) infer that the type of
x is pred? in the tbranch.

Also, reduce (eq? x y) => #f when the types are different.
---
 .../tests/racket/optimize.rktl                | 12 ++++++
 racket/src/racket/src/optimize.c              | 40 +++++++++++++++++++
 2 files changed, 52 insertions(+)

diff --git a/pkgs/racket-test-core/tests/racket/optimize.rktl b/pkgs/racket-test-core/tests/racket/optimize.rktl
index b16f3a719d..d97f39ab45 100644
--- a/pkgs/racket-test-core/tests/racket/optimize.rktl
+++ b/pkgs/racket-test-core/tests/racket/optimize.rktl
@@ -1485,6 +1485,11 @@
               (let ([y (random)])
                 (begin0 y (set! y 5)))))
 
+(test-comp '(lambda (x y) (car x) (unbox y) #f)
+           '(lambda (x y) (car x) (unbox y) (eq? x y)))
+(test-comp '(lambda (x) (car x) #f)
+           '(lambda (x) (car x) (eq? x (box 0))))
+
 (test-comp '(lambda (w) (car w) (mcar w))
            '(lambda (w) (car w) (mcar w) (random)))
 (test-comp '(lambda (w) (car w w))
@@ -1762,6 +1767,13 @@
 (test-comp '(lambda (x) (if (null? x) 1 0) null)
            '(lambda (x) (if (null? x) 1 0) x)
            #f)
+(test-comp '(lambda (x) (if (eq? x '(0)) #t 0))
+           '(lambda (x) (if (eq? x '(0)) (pair? x) 0)))
+(test-comp '(lambda (x) (if (eq? x (list 0)) #t 0))
+           '(lambda (x) (if (eq? x (list 0)) (pair? x) 0)))
+(test-comp '(lambda (x y) (car y) (if (eq? x y) #t 0))
+           '(lambda (x y) (car y) (if (eq? x y) (pair? x) 0)))
+
 
 (test-comp '(lambda (x) (let ([r (something)])
                           (r)))
diff --git a/racket/src/racket/src/optimize.c b/racket/src/racket/src/optimize.c
index 9a93f43d7a..ce015643af 100644
--- a/racket/src/racket/src/optimize.c
+++ b/racket/src/racket/src/optimize.c
@@ -3553,6 +3553,21 @@ static Scheme_Object *finish_optimize_application3(Scheme_App3_Rec *app, Optimiz
     }
   }
 
+  if (SAME_OBJ(app->rator, scheme_eq_prim)) {
+    Scheme_Object *pred1, *pred2;
+    pred1 = expr_implies_predicate(app->rand1, info, 0, 5);
+    if (pred1) {
+      pred2 = expr_implies_predicate(app->rand2, info, 0, 5);
+      if (pred2) {
+        if (!SAME_OBJ(pred1, pred2)) {
+          info->preserves_marks = 1;
+          info->single_result = 1;
+          return scheme_false;
+        }
+      }
+    }
+  }
+
   info->preserves_marks = !!(rator_flags & CLOS_PRESERVES_MARKS);
   info->single_result = !!(rator_flags & CLOS_SINGLE_RESULT);
   if (rator_flags & CLOS_RESULT_TENTATIVE) {
@@ -4041,6 +4056,31 @@ static void add_types(Scheme_Object *t, Optimize_Info *info, int fuel)
          operations to unsafe operations. */
       add_type(info, SCHEME_LOCAL_POS(app->rand), app->rator);
     }
+
+  } else if (SAME_TYPE(SCHEME_TYPE(t), scheme_application3_type)) {
+    Scheme_App3_Rec *app = (Scheme_App3_Rec *)t;
+    Scheme_Object *pred1, *pred2;
+    if (SAME_OBJ(app->rator, scheme_eq_prim)) {
+      if (SAME_TYPE(SCHEME_TYPE(app->rand1), scheme_local_type)
+          && !optimize_is_mutated(info, SCHEME_LOCAL_POS(app->rand1))) {
+        pred1 = optimize_get_predicate(SCHEME_LOCAL_POS(app->rand1), info);
+        if (!pred1) {
+          pred2 = expr_implies_predicate(app->rand2, info, 0, 5);
+          if (pred2)
+            add_type(info, SCHEME_LOCAL_POS(app->rand1), pred2);
+        }
+      }
+      if (SAME_TYPE(SCHEME_TYPE(app->rand2), scheme_local_type)
+          && !optimize_is_mutated(info, SCHEME_LOCAL_POS(app->rand2))) {
+        pred2 = optimize_get_predicate(SCHEME_LOCAL_POS(app->rand2), info);
+        if (!pred2) {
+          pred1 = expr_implies_predicate(app->rand1, info, 0, 5);
+          if (pred1)
+            add_type(info, SCHEME_LOCAL_POS(app->rand2), pred1);
+        }
+      }
+    }
+
   } else if (SAME_TYPE(SCHEME_TYPE(t), scheme_branch_type)) {
     Scheme_Branch_Rec *b = (Scheme_Branch_Rec *)t;
     if (SCHEME_FALSEP(b->fbranch)) {