From fbb55c63c4515bb57bbc946402c8ec3630079c72 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Thu, 29 Jul 2010 17:25:44 -0400
Subject: [PATCH] Extended use-site analysis to look through trivial
 rebindings, to support for loops.

original commit: 27f8279711ae93601c00d27c8041a017afdf592c
---
 .../optimizer/generic/unboxed-for.rkt         |  7 ++++++
 .../typed-scheme/optimizer/unboxed-let.rkt    | 24 +++++++++++++------
 2 files changed, 24 insertions(+), 7 deletions(-)
 create mode 100644 collects/tests/typed-scheme/optimizer/generic/unboxed-for.rkt

diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-for.rkt b/collects/tests/typed-scheme/optimizer/generic/unboxed-for.rkt
new file mode 100644
index 00000000..24e60d24
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/generic/unboxed-for.rkt
@@ -0,0 +1,7 @@
+#lang typed/scheme #:optimize
+
+(require racket/unsafe/ops)
+
+(for/fold: : Inexact-Complex ((sum : Inexact-Complex 0.0+0.0i))
+           ((i : Inexact-Complex '(1.0+2.0i 2.0+4.0i)))
+      (+ i sum))
diff --git a/collects/typed-scheme/optimizer/unboxed-let.rkt b/collects/typed-scheme/optimizer/unboxed-let.rkt
index 2b92412d..227055fc 100644
--- a/collects/typed-scheme/optimizer/unboxed-let.rkt
+++ b/collects/typed-scheme/optimizer/unboxed-let.rkt
@@ -163,6 +163,23 @@
       [exp:inexact-complex-arith-opt-expr
        (or (direct-child-of? v #'exp)
            (ormap rec (syntax->list #'exp)))]
+      ;; if the variable gets rebound to something else, we look for unboxing
+      ;; opportunities for the new variable too
+      ;; this case happens in the expansion of the for macros, so we care
+      [(l:let-like-keyword
+        ([ids e-rhs:expr] ...) e-body:expr ...)
+       #:with rebindings
+       (filter (lambda (x) x)
+               (map (syntax-parser
+                     [((id) rhs)
+                      #:when (and (identifier? #'rhs)
+                                  (free-identifier=? v #'rhs))
+                      #'id]
+                     [_ #f])
+                    (syntax->list #'((ids e-rhs) ...))))
+       (or (look-at #'(e-rhs ... e-body ...))
+           (ormap (lambda (x) (could-be-unboxed-in? x exp))
+                  (syntax->list #'rebindings)))]
       
       ;; recur down
       [((~and op (~or (~literal #%plain-lambda) (~literal define-values)))
@@ -170,13 +187,6 @@
        (look-at #'(e ...))]
       [(case-lambda [formals e:expr ...] ...)
        (look-at #'(e ... ...))]
-      [((~or (~literal let-values) (~literal letrec-values))
-        ([ids e-rhs:expr] ...) e-body:expr ...)
-       (look-at #'(e-rhs ... e-body ...))]
-      [(letrec-syntaxes+values stx-bindings
-                               ([(ids ...) e-rhs:expr] ...)
-                               e-body:expr ...)
-       (look-at #'(e-rhs ... e-body ...))]
       [(kw:identifier expr ...)
        #:when (ormap (lambda (k) (free-identifier=? k #'kw))
                      (list #'if #'begin #'begin0 #'set! #'#%plain-app #'#%app #'#%expression