From edd50a24a8b88ad792b4e3640d43b1ec74bee723 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Sun, 2 Nov 2014 19:44:57 -0700
Subject: [PATCH] optimizer: preserve implied properties from a `let` RHS

In an expression such as

 (let ([x (car y)])
   ....)

the information that `y` must be a pair didn't reach the body of the
`let` in most cases.
---
 .../racket-test/tests/racket/optimize.rktl    |  8 +++++++
 racket/src/racket/src/optimize.c              | 23 +++++++++++++++++--
 2 files changed, 29 insertions(+), 2 deletions(-)

diff --git a/pkgs/racket-pkgs/racket-test/tests/racket/optimize.rktl b/pkgs/racket-pkgs/racket-test/tests/racket/optimize.rktl
index cf23fd9e72..48b44a79a8 100644
--- a/pkgs/racket-pkgs/racket-test/tests/racket/optimize.rktl
+++ b/pkgs/racket-pkgs/racket-test/tests/racket/optimize.rktl
@@ -2357,6 +2357,14 @@
               (- (expt 2 31) 2))
            #f)
 
+;; Propagate type impliciations from RHS:
+(test-comp '(lambda (x)
+              (let ([y (car x)])
+                (list (cdr x) y (car x) y)))
+           '(lambda (x)
+             (let ([y (car x)])
+               (list (unsafe-cdr x) y (unsafe-car x) y))))
+
 ;; don't duplicate an operation by moving it into a lambda':
 (test-comp '(lambda (x)
               (let ([y (unsafe-flvector-length x)])
diff --git a/racket/src/racket/src/optimize.c b/racket/src/racket/src/optimize.c
index da98392550..17947492f3 100644
--- a/racket/src/racket/src/optimize.c
+++ b/racket/src/racket/src/optimize.c
@@ -115,6 +115,7 @@ static Scheme_Object *optimize_info_mutated_lookup(Optimize_Info *info, int pos,
 static void optimize_info_used_top(Optimize_Info *info);
 static Scheme_Object *optimize_get_predicate(int pos, Optimize_Info *info);
 static void add_type(Optimize_Info *info, int pos, Scheme_Object *pred);
+static void merge_types(Optimize_Info *src_info, Optimize_Info *info, int delta);
 
 static void optimize_mutated(Optimize_Info *info, int pos);
 static void optimize_produces_local_type(Optimize_Info *info, int pos, int ct);
@@ -3725,6 +3726,23 @@ static void add_type(Optimize_Info *info, int pos, Scheme_Object *pred)
   info->types = new_types;
 }
 
+static void merge_types(Optimize_Info *src_info, Optimize_Info *info, int delta)
+{
+  Scheme_Hash_Tree *types = src_info->types;
+  Scheme_Object *pos, *pred;
+  intptr_t i;
+
+  if (!types)
+    return;
+  
+  i = scheme_hash_tree_next(types, -1);
+  while (i != -1) {
+    scheme_hash_tree_index(types, i, &pos, &pred);
+    add_type(info, SCHEME_INT_VAL(pos)+delta, pred);
+    i = scheme_hash_tree_next(types, i);
+  }
+}
+
 static int relevant_predicate(Scheme_Object *pred)
 {
   /* Relevant predicates need to be disjoint for check_known2_pred()
@@ -5682,9 +5700,10 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i
 
   optimize_info_seq_done(rhs_info, &info_seq);
 
-  if (post_bind)
+  if (post_bind) {
     optimize_info_done(rhs_info, body_info);
-  else if (split_shift)
+    merge_types(rhs_info, body_info, head->count);
+  } else if (split_shift)
     optimize_info_done(rhs_info, body_info);
 
   body = scheme_optimize_expr(body, body_info, scheme_optimize_tail_context(context));