From ce1ef7caa7705a13a24f2beca9090b1ebe4f43d5 Mon Sep 17 00:00:00 2001
From: Eric Dobson <eric.n.dobson@gmail.com>
Date: Thu, 19 Sep 2013 22:02:26 -0700
Subject: [PATCH] Fix bug in optimizer with unboxed let constants.

original commit: 676be5de066b561d33f0b4cb40fe6537eda59d02
---
 .../typed-racket/optimizer/unboxed-let.rkt    | 13 ++++--------
 .../optimizer/tests/unboxed-let-constants.rkt | 20 +++++++++++++++++++
 2 files changed, 24 insertions(+), 9 deletions(-)
 create mode 100644 pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/tests/unboxed-let-constants.rkt

diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/unboxed-let.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/unboxed-let.rkt
index 956ba781..a3e881d0 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/unboxed-let.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/unboxed-let.rkt
@@ -112,15 +112,9 @@
    #:with (opt-candidates:unboxed-let-clause ...) #'(candidates ...)
    #:with (opt-functions:unboxed-fun-clause ...) #'(function-candidates ...)
    #:with (opt-others:opt-let-clause ...) #'(others ...)
+   ;; only log when we actually optimize
    #:do [(unless (zero? (syntax-length #'(opt-candidates.id ...)))
-           ;; only log when we actually optimize
-           (log-opt "unboxed let bindings" arity-raising-opt-msg))
-         ;; add the unboxed bindings to the table, for them to be used by
-         ;; further optimizations
-         (for ((v (in-syntax #'(opt-candidates.id ...)))
-               (r (in-syntax #'(opt-candidates.real-binding ...)))
-               (i (in-syntax #'(opt-candidates.imag-binding ...))))
-           (add-unboxed-var! v r i))]
+           (log-opt "unboxed let bindings" arity-raising-opt-msg))]
    ;; in the case where no bindings are unboxed, we create a let
    ;; that is equivalent to the original, but with all parts optimized
    #:with opt (quasisyntax/loc/origin
@@ -228,7 +222,8 @@
 (define-syntax-class unboxed-let-clause
   #:commit
   #:attributes (id real-binding imag-binding (bindings 1))
-  (pattern ((id:id) :unboxed-float-complex-opt-expr)))
+  (pattern ((id:id) :unboxed-float-complex-opt-expr)
+    #:do [(add-unboxed-var! #'id #'real-binding #'imag-binding)]))
 
 ;; let clause whose rhs is a function with some float complex arguments
 ;; these arguments may be unboxed
diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/tests/unboxed-let-constants.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/tests/unboxed-let-constants.rkt
new file mode 100644
index 00000000..c6a18cfa
--- /dev/null
+++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/tests/unboxed-let-constants.rkt
@@ -0,0 +1,20 @@
+#;#;
+#<<END
+TR opt: unboxed-let-constants.rkt 18:0 (letrec-values (((x) 5.0+5.0i) ((z) x)) (real-part (+ x z))) -- unboxed let bindings
+TR opt: unboxed-let-constants.rkt 18:21 5.0+5.0i -- unboxed literal
+TR opt: unboxed-let-constants.rkt 19:21 x -- leave var unboxed
+TR opt: unboxed-let-constants.rkt 20:13 (+ x z) -- unboxed binary float complex
+TR opt: unboxed-let-constants.rkt 20:16 x -- leave var unboxed
+TR opt: unboxed-let-constants.rkt 20:18 z -- leave var unboxed
+TR opt: unboxed-let-constants.rkt 20:2 (real-part (+ x z)) -- complex accessor elimination
+END
+#<<END
+10.0
+
+END
+#lang typed/racket
+
+
+(letrec-values (((x) 5.0+5.0i)
+                ((z) x))
+  (real-part (+ x z)))