More reductions for (if t v v) and (eq? v v)

Reduce
(eq? v v) ==> #t
(if t v v) ==> (begin t v)
(if v v #f) ==> v
when v is a local or a top level variable.

Previously, the last two reductions were used only
with local variables.

Also, move the (if x #t #f) ==> (not x) reduction
after branch optimization.

pkgs/racket-test-core/tests/racket/optimize.rktl

@@ -1042,18 +1042,38 @@
 (test-comp '(lambda (x) (eq? 7 x))
            '(lambda (x) (eqv? 7 x)))
 
-(test-comp #t
+; car is a primitive, map is required from another module
-           '(eq? 7 7))
+(let ([test-equal?
-(test-comp #f
+       (lambda (e?)
-           '(eq? 9 6))
+         (test-comp #t
-(test-comp #t
+                    `(,e? 7 7))
-           '(eqv? 7 7))
+         (test-comp #f
-(test-comp #f
+                    `(,e? 9 6))
-           '(eqv? 9 6))
+         (test-comp #t
-(test-comp #t
+                    `(,e? (values 1 2) (values 1 2))
-           '(equal? 7 7))
+                    #f)
-(test-comp #f
+         (test-comp '(lambda (x) #t)
-           '(equal? 9 6))
+                    `(lambda (x) (,e? x x)))
+         (test-comp '(lambda (x) #t)
+                    `(lambda (x) (,e? car car)))
+         (test-comp '(lambda (x) (list map #t))
+                    `(lambda (x) (list map (,e? map map))))
+         (test-comp '(module ? racket/base
+                       (define x (if (zero? (random 2)) '() '(1)))
+                       #t)
+                    `(module ? racket/base
+                       (define x (if (zero? (random 2)) '() '(1)))
+                       (,e? x x)))
+         (test-comp '(letrec ([x #t]
+                              [y (random)])
+                       (list x x y y))
+                    `(letrec ([x (,e? y y)]
+                              [y (random)])
+                       (list x x y y))
+                    #f))])
+  (test-equal? eq?)
+  (test-equal? eqv?)
+  (test-equal? equal?))
 
 (test-comp '(let ([x 3]) x)
 	   '((lambda (x) x) 3))
@@ -1761,11 +1781,29 @@
 
 (test-comp '(lambda (x) (if x x #f))
            '(lambda (x) x))
+(test-comp '(lambda (x y) (set! x y) (if x x #f))
+           '(lambda (x y) (set! x y) x))
 (test-comp '(lambda (x) (if (cons 1 x) 78 78))
            '(lambda (x) 78))
+(test-comp '(lambda (x) (if (null? x) 78 78))
+           '(lambda (x) 78))
 (test-comp '(lambda (x) (if (values 1 2) 78 78))
            '(lambda (x) (values 1 2) 78)
            #f)
+(test-comp '(if (values 1 2) (values 1 2) #f)
+           '(values 1 2)
+           #f)
+; car is a primitive, map is required from another module
+(test-comp '(lambda (x) (if (null? x) car car))
+           '(lambda (x) car))
+(test-comp '(lambda (x) (if (null? x) map map))
+           '(lambda (x) map))
+(test-comp '(module ? racket/base
+              (define x (if (zero? (random 2)) '() '(1)))
+              (if (null? x) x x))
+           '(module ? racket/base
+              (define x (if (zero? (random 2)) '() '(1)))
+              x))
 (test-comp '(lambda (x) (if (null? x) x x))
            '(lambda (x) x))
 (test-comp '(lambda (x) (if (null? x) null x))
@@ -1884,21 +1922,45 @@
                     (if (let ([y (random)]) (pair? x)) 1 2)))
            '(lambda (x)
               (cons (car x)
-                    (begin (let ([y (random)]) (void (pair? x))) 1))))
+                    (let ([y (random)]) 1))))
 (test-comp '(lambda (x)
               (cons (car x)
                     (if (begin (random) (random) (pair? x)) 1 2)))
            '(lambda (x)
               (cons (car x)
                     (begin (random) (random) 1))))
+(test-comp '(lambda (x)
+              (cons (car x)
+                    (if (begin (random) (random) (box? x)) 1 2)))
+           '(lambda (x)
+              (cons (car x)
+                    (begin (random) (random) 2))))
 (test-comp '(lambda (x)
               (if (begin (random) (random) (cons x x)) 1 2))
            '(lambda (x)
               (begin (random) (random) 1)))
 (test-comp '(lambda (x)
-              (if (let ([n (random)]) (random n) (random n) (cons (car x) x)) 1 2))
+              (if (begin (random) (random) (not (cons x x))) 1 2))
            '(lambda (x)
-              (let ([n (random)]) (random n) (random n) (car x) (void) 1)))
+              (begin (random) (random) 2)))
+(test-comp '(lambda (x)
+              (if (let ([n (random 9)]) (random n) (random n) (cons (car x) x)) 1 2))
+           '(lambda (x)
+              (let ([n (random 9)]) (random n) (random n) (car x) 1)))
+(test-comp '(lambda (x)
+              (if (let ([n (random 9)]) (random n) (random n) (not (cons (car x) x))) 1 2))
+           '(lambda (x)
+              (let ([n (random 9)]) (random n) (random n) (car x) 2)))
+
+(test-comp '(lambda (x)
+              (if (let ([n (random 9)]) (random n) (random n) (cons (car x) x)) (cons x 1) (cons x 2)))
+           '(lambda (x)
+              (let ([n (random 9)]) (random n) (random n) (car x) (cons x 1))))
+(test-comp '(lambda (x)
+              (if (let ([n (random 9)]) (random n) (random n) (not (cons (car x) x))) (cons x 1) (cons x 2)))
+           '(lambda (x)
+              (let ([n (random 9)]) (random n) (random n) (car x) (cons x 2))))
+
 (test-comp '(lambda (x)
               (if (begin (random) (not (begin (random) x))) 1 2))
            '(lambda (x)

racket/src/racket/src/optimize.c

@@ -154,6 +154,8 @@ static int single_valued_noncm_expression(Scheme_Object *expr, int fuel);
 static Scheme_Object *optimize_ignored(Scheme_Object *e, Optimize_Info *info,
                                        int expected_vals, int maybe_omittable,
                                        int fuel);
+static Scheme_Object *equivalent_exprs(Scheme_Object *a, Scheme_Object *b,
+                                       Optimize_Info *a_info, Optimize_Info *b_info, int context);
 static int movable_expression(Scheme_Object *expr, Optimize_Info *info,
                               int cross_lambda, int cross_k, int cross_s,
                               int check_space, int fuel);
@@ -682,6 +684,12 @@ static Scheme_Object *make_discarding_reverse_sequence(Scheme_Object *e1, Scheme
   return do_make_discarding_sequence(e1, e2, info, 0, 1);
 }
 
+static Scheme_Object *make_discarding_sequence_3(Scheme_Object *e1, Scheme_Object *e2, Scheme_Object *e3,
+                                                 Optimize_Info *info)
+{
+  return make_discarding_sequence(e1, make_discarding_sequence(e2, e3, info), info);
+}
+
 static Scheme_Object *make_discarding_app_sequence(Scheme_App_Rec *appr, int result_pos, Scheme_Object *result,
                                                    Optimize_Info *info)
 /* Generalize do_make_discarding_sequence() to a sequence of argument
@@ -3697,6 +3705,15 @@ static Scheme_Object *finish_optimize_application3(Scheme_App3_Rec *app, Optimiz
     }
   }
 
+  if ((SAME_OBJ(app->rator, scheme_equal_proc)
+       || SAME_OBJ(app->rator, scheme_eqv_proc)
+       || SAME_OBJ(app->rator, scheme_eq_proc))
+      && equivalent_exprs(app->rand1, app->rand2, NULL, NULL, 0)) {
+    info->preserves_marks = 1;
+    info->single_result = 1;
+    return make_discarding_sequence_3(app->rand1, app->rand2, scheme_true, info);
+  }
+
   /* Optimize `equal?' or `eqv?' test on certain types
      to `eq?'. This is especially helpful for the JIT. */
   if ((SAME_OBJ(app->rator, scheme_equal_proc)
@@ -3724,13 +3741,7 @@ static Scheme_Object *finish_optimize_application3(Scheme_App3_Rec *app, Optimiz
         if (!SAME_OBJ(pred1, pred2)) {
           info->preserves_marks = 1;
           info->single_result = 1;
-          return do_make_discarding_sequence(app->rand1,
+          return make_discarding_sequence_3(app->rand1, app->rand2, scheme_false, info);
-                                             do_make_discarding_sequence(app->rand2,
-                                                                         scheme_false,
-                                                                         info,
-                                                                         0, 0),
-                                             info,
-                                             0, 0);
         }
       }
     }
@@ -4181,12 +4192,23 @@ static Scheme_Object *collapse_local(Scheme_Object *var, Optimize_Info *info, in
   return NULL;
 }
 
+/* This function is used to reduce: 
+   (if <x> a b) => (begin <x> <result-a-or-b>)
+   (if a b #f) => a , and similar
+   (eq? a b) => (begin a b #t)
+   The function considers only values and variable references, so <a> and <b> don't have side effects.
+   But each reduction has a very different behavior for expressions with side effects. */
 static Scheme_Object *equivalent_exprs(Scheme_Object *a, Scheme_Object *b,
                                        Optimize_Info *a_info, Optimize_Info *b_info, int context)
 {
   if (SAME_OBJ(a, b))
     return a;
 
+  if (SAME_TYPE(SCHEME_TYPE(a), scheme_ir_toplevel_type)
+      && SAME_TYPE(SCHEME_TYPE(b), scheme_ir_toplevel_type)
+      && (SCHEME_TOPLEVEL_POS(a) == SCHEME_TOPLEVEL_POS(b)))
+    return a;
+
   if (b_info 
       && SAME_TYPE(SCHEME_TYPE(a), scheme_ir_local_type)
       && (SCHEME_TYPE(b) > _scheme_ir_values_types_)) {
@@ -4390,7 +4412,6 @@ static Scheme_Object *optimize_branch(Scheme_Object *o, Optimize_Info *info, int
   Optimize_Info *then_info, *else_info;
   Optimize_Info *then_info_init, *else_info_init;
   Optimize_Info_Sequence info_seq;
-  Scheme_Object *pred;
 
   b = (Scheme_Branch_Rec *)o;
 
@@ -4399,21 +4420,14 @@ static Scheme_Object *optimize_branch(Scheme_Object *o, Optimize_Info *info, int
   fb = b->fbranch;
 
   /* Convert (if <id> expr <id>) to (if <id> expr #f) */
-  if (SAME_TYPE(SCHEME_TYPE(t), scheme_ir_local_type)
+  if (equivalent_exprs(t, fb, NULL, NULL, 0)) {
-      && SAME_OBJ(t, fb)) {
     fb = scheme_false;
   }
   
-  if (context & OPT_CONTEXT_BOOLEAN) {
+  /* For test position, convert (if <id> <id> expr) to (if <id> #t expr) */
-    /* For test position, convert (if <id> <id> expr) to (if <id> #t expr) */
+  if ((context & OPT_CONTEXT_BOOLEAN)
-    if (SAME_TYPE(SCHEME_TYPE(t), scheme_ir_local_type)
+      && equivalent_exprs(t, tb, NULL, NULL, 0)) {
-        && SAME_OBJ(t, tb)) {
       tb = scheme_true;
-    }
-
-    /* Convert (if <expr> #t #f) to <expr> */
-    if (SAME_OBJ(tb, scheme_true) && SAME_OBJ(fb, scheme_false))
-      return scheme_optimize_expr(t, info, context);
   }
 
   optimize_info_seq_init(info, &info_seq);
@@ -4449,21 +4463,26 @@ static Scheme_Object *optimize_branch(Scheme_Object *o, Optimize_Info *info, int
         break;
     }
 
-    pred = expr_implies_predicate(t2, info, NULL, 5); 
+    if (!(SCHEME_TYPE(t2) > _scheme_ir_values_types_)) {
-    if (pred) {
+      /* (if (let (...) (cons x y)) a b) => (if (begin (let (...) (begin x y #<void>)) #t/#f) a b)
-      /* (if (let () (cons x y)) a b) => (if (begin (let () (begin x y #<void>)) #t/#f) a b) */
+         but don't expand (if (let (...) (begin x K)) a b) */
-      Scheme_Object *test_val = SAME_OBJ(pred, scheme_not_proc) ? scheme_false : scheme_true;
+      Scheme_Object *pred;
 
-      t2 = optimize_ignored(t2, info, 1, 0, 5);
+      pred = expr_implies_predicate(t2, info, NULL, 5); 
-      t = replace_tail_inside(t2, inside, t);
+      if (pred) {
+        Scheme_Object *test_val = SAME_OBJ(pred, scheme_not_proc) ? scheme_false : scheme_true;
 
-      t2 = test_val;
+        t2 = optimize_ignored(t2, info, 1, 0, 5);
-      if (scheme_omittable_expr(t, 1, 5, 0, info, NULL)) {
+        t = replace_tail_inside(t2, inside, t);
-        t = test_val;
+
-        inside = NULL;
+        t2 = test_val;
-      } else {       
+        if (scheme_omittable_expr(t, 1, 5, 0, info, NULL)) {
-        t = make_sequence_2(t, test_val);
+          t = test_val;
-        inside = t;
+          inside = NULL;
+        } else {
+          t = make_sequence_2(t, test_val);
+          inside = t;
+        }
       }
     }
 
@@ -4479,6 +4498,7 @@ static Scheme_Object *optimize_branch(Scheme_Object *o, Optimize_Info *info, int
       else
         xb = scheme_optimize_expr(tb, info, scheme_optimize_tail_context(context));
       
+      optimize_info_seq_done(info, &info_seq);
       return replace_tail_inside(xb, inside, t);
     }
   }
@@ -4563,25 +4583,31 @@ static Scheme_Object *optimize_branch(Scheme_Object *o, Optimize_Info *info, int
     return make_optimize_prim_application2(scheme_not_proc, t, info, context);
   }
 
-  /* Try optimize: (if <omitable-expr> v v) => v */
+  /* For test position, convert (if <expr> #t #f) to <expr> */
+  if ((context & OPT_CONTEXT_BOOLEAN)
+      && SAME_OBJ(tb, scheme_true) && SAME_OBJ(fb, scheme_false)) {
+      info->size -= 2;
+      return t;
+  }
+
+  /* Try optimize: (if <expr> v v) => (begin <expr> v) */
   {
     Scheme_Object *nb;
 
     nb = equivalent_exprs(tb, fb, then_info_init, else_info_init, context);
     if (nb) {
-      info->size -= 1; /* could be more precise */
+      info->size -= 1;
       return make_discarding_first_sequence(t, nb, info);
     }
   }
 
   /* Try optimize: (if x x #f) => x 
      This pattern is included in the previous reduction,
-     but this is still useful if x is mutable */
+     but this is still useful if x is mutable or a top level*/
-  if (SAME_TYPE(SCHEME_TYPE(t), scheme_ir_local_type)
+  if (SCHEME_FALSEP(fb)
-      && SAME_OBJ(t, tb)
+      && equivalent_exprs(t, tb, NULL, NULL, 0)) {
-      && SCHEME_FALSEP(fb)) {
+      info->size -= 2;
-    info->size -= 2;
+      return t;
-    return t;
   }
 
   /* Convert: (if (if M N #f) M2 K) => (if M (if N M2 K) K)