From 260de85a6efbc692abaec64d6837a4dfa965cb78 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Thu, 29 Jul 2010 13:55:19 -0400
Subject: [PATCH] Make sure that let-bound functions don't escape through a rhs
 before we change their interface.

---
 .../generic/unboxed-let-functions8.rkt          |  7 +++++++
 .../hand-optimized/unboxed-let-functions8.rkt   | 17 +++++++++++++++++
 .../non-optimized/unboxed-let-functions8.rkt    |  7 +++++++
 collects/typed-scheme/optimizer/unboxed-let.rkt |  4 +++-
 4 files changed, 34 insertions(+), 1 deletion(-)
 create mode 100644 collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions8.rkt
 create mode 100644 collects/tests/typed-scheme/optimizer/hand-optimized/unboxed-let-functions8.rkt
 create mode 100644 collects/tests/typed-scheme/optimizer/non-optimized/unboxed-let-functions8.rkt

diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions8.rkt b/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions8.rkt
new file mode 100644
index 0000000000..124b4cbd37
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions8.rkt
@@ -0,0 +1,7 @@
+#lang typed/scheme #:optimize
+
+(require racket/unsafe/ops)
+
+(letrec: ((f : (Inexact-Complex -> Inexact-Complex) (lambda (x) (+ x 2.0+4.0i)))
+          (g : (Inexact-Complex -> Inexact-Complex) f)) ; f escapes! can't unbox it's args
+  (f 1.0+2.0i))
diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/unboxed-let-functions8.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/unboxed-let-functions8.rkt
new file mode 100644
index 0000000000..a165dc2810
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/hand-optimized/unboxed-let-functions8.rkt
@@ -0,0 +1,17 @@
+#lang racket
+
+(require racket/unsafe/ops)
+
+(letrec-values (((f) (lambda (x)
+                       (let*-values (((unboxed-gensym-1) x)
+                                     ((unboxed-gensym-2) (unsafe-flreal-part unboxed-gensym-1))
+                                     ((unboxed-gensym-3) (unsafe-flimag-part unboxed-gensym-1))
+                                     ((unboxed-gensym-4) 2.0+4.0i)
+                                     ((unboxed-gensym-5) (unsafe-flreal-part unboxed-gensym-4))
+                                     ((unboxed-gensym-6) (unsafe-flimag-part unboxed-gensym-4))
+                                     ((unboxed-gensym-7) (unsafe-fl+ unboxed-gensym-2 unboxed-gensym-5))
+                                     ((unboxed-gensym-8) (unsafe-fl+ unboxed-gensym-3 unboxed-gensym-6)))
+                         (unsafe-make-flrectangular unboxed-gensym-7 unboxed-gensym-8))))
+                ((g) f))
+               (f 1.0+2.0i))
+(void)
diff --git a/collects/tests/typed-scheme/optimizer/non-optimized/unboxed-let-functions8.rkt b/collects/tests/typed-scheme/optimizer/non-optimized/unboxed-let-functions8.rkt
new file mode 100644
index 0000000000..74976cd241
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/non-optimized/unboxed-let-functions8.rkt
@@ -0,0 +1,7 @@
+#lang typed/scheme
+
+(require racket/unsafe/ops)
+
+(letrec: ((f : (Inexact-Complex -> Inexact-Complex) (lambda (x) (+ x 2.0+4.0i)))
+          (g : (Inexact-Complex -> Inexact-Complex) f)) ; f escapes! can't unbox it's args
+  (f 1.0+2.0i))
diff --git a/collects/typed-scheme/optimizer/unboxed-let.rkt b/collects/typed-scheme/optimizer/unboxed-let.rkt
index cac5f06313..2b92412d77 100644
--- a/collects/typed-scheme/optimizer/unboxed-let.rkt
+++ b/collects/typed-scheme/optimizer/unboxed-let.rkt
@@ -46,7 +46,8 @@
 (define-syntax-class (unboxed-let-opt-expr-internal let-loop?)
   #:literal-sets (kernel-literals)
   (pattern (~and exp (letk:let-like-keyword
-                      (clause:expr ...) body:expr ...))
+                      ((~and clause (lhs rhs ...)) ...)
+                      body:expr ...))
            ;; we look for bindings of complexes that are not mutated and only
            ;; used in positions where we would unbox them
            ;; these are candidates for unboxing
@@ -74,6 +75,7 @@
                        (and
                         ;; if the function escapes, we can't change it's interface
                         (not (is-var-mutated? fun-name))
+                        (not (escapes? fun-name #'(begin rhs ... ...) #f))
                         (not (escapes? fun-name #'(begin body ...) let-loop?))
                         (match (type-of (cadr p)) ; rhs, we want a lambda
                           [(tc-result1: (Function: (list (arr: doms rngs