From 63a1f8902582caa4f7fc09448a67687e227b7d17 Mon Sep 17 00:00:00 2001
From: Eric Dobson <eric.n.dobson@gmail.com>
Date: Sun, 12 Jan 2014 12:42:43 -0800
Subject: [PATCH] Fix bindings of unboxed complex float functions.

Closes PR 12475.
Closes PR 14284.

original commit: c60b31f0d19ef2a37adb654b0e5fa9178ce62f4d
---
 .../typed-racket/optimizer/unboxed-let.rkt    | 23 ++++++++++-----
 .../typed-racket/optimizer/tests/pr12475.rkt  | 24 ++++++++++++++++
 .../typed-racket/optimizer/tests/pr14284.rkt  | 28 +++++++++++++++++++
 3 files changed, 68 insertions(+), 7 deletions(-)
 create mode 100644 pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/tests/pr12475.rkt
 create mode 100644 pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/tests/pr14284.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 4fc7c4d8..1575749a 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
@@ -267,19 +267,28 @@
     #:with (bindings ...)
     ;; add unboxed parameters to the unboxed vars table
     (let ((to-unbox (syntax->datum #'(fun.unboxed ...))))
-      (for ([index (in-list to-unbox)]
-            [real-part (in-syntax #'(real-params ...))]
-            [imag-part (in-syntax #'(imag-params ...))])
-        (add-unboxed-var! (list-ref (syntax->list #'params) index) real-part imag-part))
-      (define boxed
+      (define/with-syntax (unboxed ...)
+        (for/list ([param (in-syntax #'params)]
+                   [i (in-naturals)]
+                   #:when (memq i to-unbox))
+          param))
+      (define/with-syntax (boxed ...)
         (for/list ([param (in-syntax #'params)]
                    [i (in-naturals)]
                    #:unless (memq i to-unbox))
           param))
+      (for ([orig-param (in-syntax #'(unboxed ...))]
+            [real-part (in-syntax #'(real-params ...))]
+            [imag-part (in-syntax #'(imag-params ...))])
+        (add-unboxed-var! orig-param real-part imag-part))
+
       ;; real parts of unboxed parameters go first, then all
       ;; imag parts, then boxed occurrences of unboxed
       ;; parameters will be inserted when optimizing the body
+      ;; We add the original bindings so that dead code in the body,
+      ;; (which will not be optimized), will have correct bindings
       #`(((fun) (#%plain-lambda
-                  (real-params ... imag-params ... #,@(reverse boxed))
-                  body.opt ...))))))
+                  (real-params ... imag-params ... boxed ...)
+                  (let ([unboxed 'check-syntax-binding] ...)
+                    body.opt ...)))))))
 
diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/tests/pr12475.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/tests/pr12475.rkt
new file mode 100644
index 00000000..b596f705
--- /dev/null
+++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/tests/pr12475.rkt
@@ -0,0 +1,24 @@
+#;#;
+#<<END
+TR opt: pr12475.rkt 18:2 ((letrec-values (((for-loop) (lambda (so-far-init) (if (quote #t) (* so-far-init (quote 1.0)) so-far-init)))) for-loop) (quote 0.0+0.0i)) -- unboxed call site
+TR opt: pr12475.rkt 18:21 for-loop -- fun -> unboxed fun
+TR opt: pr12475.rkt 19:29 so-far-init -- unboxed var -> table
+TR opt: pr12475.rkt 21:26 (* so-far-init (quote 1.0)) -- unboxed binary float complex
+TR opt: pr12475.rkt 21:29 so-far-init -- leave var unboxed
+TR opt: pr12475.rkt 21:41 (quote 1.0) -- float-arg-expr in complex ops
+TR opt: pr12475.rkt 22:26 so-far-init -- dead else branch
+TR opt: pr12475.rkt 23:5 for-loop -- unboxed let loop
+TR opt: pr12475.rkt 24:3 (quote 0.0+0.0i) -- unboxed literal
+END
+""
+#lang typed/racket
+
+(: coefficients->poly (-> Float-Complex))
+(define (coefficients->poly)
+  ((letrec-values (((for-loop)
+                    (lambda (so-far-init)
+                      (if '#t
+                          (* so-far-init '1.0)
+                          so-far-init))))
+     for-loop)
+   '0.0+0.0i))
diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/tests/pr14284.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/tests/pr14284.rkt
new file mode 100644
index 00000000..29a1d5d3
--- /dev/null
+++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/tests/pr14284.rkt
@@ -0,0 +1,28 @@
+#;#;
+#<<END
+TR info: pr14284.rkt 26:26 displayln -- hidden parameter
+TR opt: pr14284.rkt 24:13 0.0+2.0i -- unboxed literal
+TR opt: pr14284.rkt 24:6 (+ 1.0 0.0+2.0i) -- unboxed binary float complex
+TR opt: pr14284.rkt 24:9 1.0 -- float-arg-expr in complex ops
+TR opt: pr14284.rkt 25:27 x -- unboxed var -> table
+TR opt: pr14284.rkt 25:4 optimizable -- fun -> unboxed fun
+TR opt: pr14284.rkt 27:25 (+ x y) -- unboxed binary float complex
+TR opt: pr14284.rkt 27:28 x -- leave var unboxed
+TR opt: pr14284.rkt 27:30 y -- unbox float-complex
+TR opt: pr14284.rkt 28:15 3.0+3.0i -- unboxed literal
+TR opt: pr14284.rkt 28:2 (optimizable 3.0+3.0i "a" "b") -- call to fun with unboxed args
+TR opt: pr14284.rkt 28:2 (optimizable 3.0+3.0i "a" "b") -- unboxed call site
+END
+#<<END
+a
+4.0+5.0i
+
+END
+#lang typed/racket
+
+(letrec:
+  ([y (+ 1.0 0.0+2.0i)]
+   [optimizable (lambda: ([x : Float-Complex] [a : String] [b : String])
+                         (displayln a)
+                         (+ x y))])
+  (optimizable 3.0+3.0i "a" "b"))