From 25dc89a2387dbd18becaf258da015359c2ca85ee Mon Sep 17 00:00:00 2001
From: Gustavo Massaccesi <gustavo@oma.org.ar>
Date: Sat, 3 Dec 2016 18:39:19 -0300
Subject: [PATCH] more reductions in ignored expressions

extend optimize_ignore to go inside expressions with
begin, begin0 and let.

Also, try to reuse begin's in the first argument of
make_discarding_sequence.
---
 .../tests/racket/optimize.rktl                | 11 +++
 racket/src/racket/src/optimize.c              | 73 ++++++++++++++++++-
 2 files changed, 80 insertions(+), 4 deletions(-)

diff --git a/pkgs/racket-test-core/tests/racket/optimize.rktl b/pkgs/racket-test-core/tests/racket/optimize.rktl
index 9c0f94d396..69d18db58d 100644
--- a/pkgs/racket-test-core/tests/racket/optimize.rktl
+++ b/pkgs/racket-test-core/tests/racket/optimize.rktl
@@ -1349,6 +1349,17 @@
 (test-comp '(lambda (v) (unsafe-unbox* (box v)))
            '(lambda (v) v))
 
+(test-comp '(lambda () (car (cons (random 2) (random 3))))
+           '(lambda () (begin0 (random 2) (random 3))))
+(test-comp '(lambda () (car (cons (random 2) (begin (random 3) (lambda (x) x)))))
+           '(lambda () (begin0 (random 2) (random 3))))
+(test-comp '(lambda () (cdr (cons (random 2) (random 3))))
+           '(lambda () (begin (random 2) (random 3))))
+(test-comp '(lambda () (cdr (cons (begin (random 2) (lambda (x) x)) (random 3))))
+           '(lambda () (begin (random 2) (random 3))))
+(test-comp '(lambda () (cdr (cons (begin (random 1) (random 2) (lambda (x) x)) (random 3))))
+           '(lambda () (begin (random 1) (random 2) (random 3))))
+
 (test-comp '(lambda (w z) (pair? (list)))
            '(lambda (w z) #f))
 (test-comp '(lambda (w z) (null? (list)))
diff --git a/racket/src/racket/src/optimize.c b/racket/src/racket/src/optimize.c
index ae827e2cc0..521bae73c7 100644
--- a/racket/src/racket/src/optimize.c
+++ b/racket/src/racket/src/optimize.c
@@ -121,6 +121,8 @@ static int lambda_body_size_plus_info(Scheme_Lambda *lam, int check_assign,
                                       Optimize_Info *info, int *is_leaf);
 static int lambda_has_top_level(Scheme_Lambda *lam);
 
+static Scheme_Object *make_sequence_2(Scheme_Object *a, Scheme_Object *b);
+
 static int wants_local_type_arguments(Scheme_Object *rator, int argpos);
 
 static void add_types_for_f_branch(Scheme_Object *t, Optimize_Info *info, int fuel);
@@ -716,6 +718,15 @@ static Scheme_Object *do_make_discarding_sequence(Scheme_Object *e1, Scheme_Obje
   if (rev && movable_expression(e2, info, 0, 1, 1, 0, 50))
     rev = 0;
 
+  if (!rev && SAME_TYPE(SCHEME_TYPE(e1), scheme_sequence_type)) {
+    Scheme_Sequence *seq = (Scheme_Sequence *)e1;
+
+    if (SCHEME_TYPE(seq->array[seq->count - 1]) > _scheme_ir_values_types_) {
+      seq->array[seq->count - 1] = e2;
+      return e1;
+    }
+  }
+
   return scheme_make_sequence_compilation(scheme_make_pair((rev ? e2 : e1),
                                                            scheme_make_pair((rev ? e1 : e2), scheme_null)),
                                           rev ? -1 : 1,
@@ -789,10 +800,8 @@ static Scheme_Object *optimize_ignored(Scheme_Object *e, Optimize_Info *info,
    `expected_vals` is 1 or -1. If `maybe_omittable`, the result can be
    NULL to indicate that it can be omitted. */
 {
-  if (maybe_omittable) {
-    if (scheme_omittable_expr(e, expected_vals, 5, 0, info, NULL))
-      return NULL;
-  }
+  if (scheme_omittable_expr(e, expected_vals, 5, 0, info, NULL))
+    return maybe_omittable? NULL : scheme_false;
 
   if (fuel) {
     /* We could do a lot more here, but for now, we just avoid purely
@@ -865,6 +874,62 @@ static Scheme_Object *optimize_ignored(Scheme_Object *e, Optimize_Info *info,
         }
       }
       break;
+    case scheme_sequence_type:
+      {
+        Scheme_Sequence *seq = (Scheme_Sequence *)e;
+        Scheme_Object *last;
+        
+        last = optimize_ignored(seq->array[seq->count - 1], info, expected_vals, 1, fuel - 1);
+        
+        if (last) {
+          seq->array[seq->count - 1] = last;
+          return (Scheme_Object*)seq;
+        } else if (seq->count == 2
+                   && (expected_vals == -1
+                       || single_valued_noncm_expression(seq->array[0], 5))) {
+          return seq->array[0];
+        } else {
+          seq->array[seq->count - 1] = scheme_false;
+          return (Scheme_Object*)seq;
+        }
+      }
+    case scheme_begin0_sequence_type:
+      {
+        Scheme_Sequence *seq = (Scheme_Sequence *)e;
+        Scheme_Object *first;
+        
+        first = optimize_ignored(seq->array[0], info, expected_vals, 1, fuel - 1);
+        
+        if (first) {
+          seq->array[0] = first;
+          return (Scheme_Object*)seq;
+        } else if (seq->count == 2
+                   && (expected_vals == -1
+                       || single_valued_noncm_expression(seq->array[1], 5))) {
+          return seq->array[1];
+        } else {
+          seq->array[0] = scheme_false;
+          return (Scheme_Object*)seq;
+        }
+      }
+      break;
+    case scheme_ir_let_header_type:
+      {
+        Scheme_IR_Let_Header *head = (Scheme_IR_Let_Header *)e;
+        Scheme_IR_Let_Value *lv;
+        Scheme_Object *body;
+        int i;
+
+        body = head->body;
+        for (i = head->num_clauses; i--; ) {
+          lv = (Scheme_IR_Let_Value *)body;
+          body = lv->body;
+        }
+        body = optimize_ignored(body, info, expected_vals, 0, fuel - 1);
+        lv->body = body;
+        return (Scheme_Object*)head;
+      }
+      break;
     }
   }