From e9c9d6ae30186e7b7041dbe78fb008c8a5453c34 Mon Sep 17 00:00:00 2001
From: Eric Dobson <eric.n.dobson@gmail.com>
Date: Sun, 10 Nov 2013 22:57:10 -0800
Subject: [PATCH] Improve comments and change name for unboxable-funs.

original commit: 2fd6a05d462ab7c927168693434c9e4580e6ddc8
---
 .../typed-racket/optimizer/unboxed-let.rkt    | 43 ++++++++++++-------
 .../tests/unboxed-let-constants-fail1.rkt     |  2 +-
 2 files changed, 29 insertions(+), 16 deletions(-)

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 256039d0..4fc7c4d8 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
@@ -48,23 +48,32 @@
   (pattern
    (letk:let-like-keyword ((~and clause (lhs rhs)) ...)
                           body:opt-expr ...)
-   #:do [(define-syntax-class non-escaping-function
+   #:do [;; Ids that do not escape
+         (define-syntax-class non-escaping-function-id
            (pattern fun-name:id
               #:when (not (or (escapes? #'fun-name #'(begin rhs ...) #f)
                               (escapes? #'fun-name #'(begin body ...) let-loop?)))))
-         ;; clauses of form ((v) rhs), currently only supports 1 lhs var
-         (define-syntax-class unboxed-let-clause?
+
+         ;; Syntax classes for detecting clauses which can be unboxed.
+         ;; This is split from actually unboxing so that variables defined in later clauses will be
+         ;; unboxed in expressions in earlier clauses.
+
+         ;; Clauses of form ((v) rhs), currently only supports 1 lhs var
+         (define-syntax-class unboxable-let-clause?
            (pattern ((id:id) rhs:float-complex-expr)
              #:when (could-be-unboxed-in? #'id #'(begin body ...))))
 
          ;; Clauses that define functions that can be lifted
-         (define-syntax-class unboxed-fun-clause?
-           (pattern (~and ((_:non-escaping-function) . _)
-                          _:unboxed-fun-definition)))
+         (define-syntax-class unboxable-fun-clause?
+           (pattern (~and ((_:non-escaping-function-id) body:expr)
+                          _:unboxable-fun-definition)))
 
-         (define-syntax-class unboxed-clause?
+         ;; Bindings are delayed so that all clauses are matched before optimizations happen.
+         ;; This ensures that unboxable variables defined in later clauses are detected before
+         ;; optimization starts.
+         (define-syntax-class unboxed-clause
             #:attributes (bindings)
-            (pattern v:unboxed-let-clause?
+            (pattern v:unboxable-let-clause?
               #:with (real-binding imag-binding) (binding-names)
               #:do [(add-unboxed-var! #'v.id #'real-binding #'imag-binding)]
               #:attr bindings
@@ -75,11 +84,11 @@
                      #'(c.bindings ...
                         ((real-binding) c.real-binding)
                         ((imag-binding) c.imag-binding))])))
-            (pattern v:unboxed-fun-clause?
+            (pattern v:unboxable-fun-clause?
               #:attr bindings
                 (delay
                   (syntax-parse #'v
-                    [c:unboxed-fun-clause
+                    [c:unbox-fun-clause
                      #'(c.bindings ...)])))
             (pattern v
               #:attr bindings
@@ -87,10 +96,9 @@
                   (syntax-parse #'v
                     [(vs rhs:opt-expr)
                      #'((vs rhs.opt))]))))
-
          (define-syntax-class unboxed-clauses
            #:attributes ([bindings 1])
-           (pattern (clauses:unboxed-clause? ...)
+           (pattern (clauses:unboxed-clause ...)
              #:with (bindings ...) (template ((?@ . clauses.bindings) ...))))]
 
    #:with opt
@@ -107,7 +115,12 @@
   (pattern v:id
     #:when (not (is-var-mutated? #'v))))
 
-(define-syntax-class unboxed-fun-definition
+;; A function definition is unboxable when the following are true:
+;; 1. Its binding is never mutated.
+;; 2. Its type has no keyword arguments or rest/drest arguments.
+;; 3. At least one of the arguments is of the type FloatComplex and used in a manner which benefits
+;; from unboxing.
+(define-syntax-class unboxable-fun-definition
   #:attributes ()
   #:literal-sets (kernel-literals)
   (pattern ((fun-name:constant-var) (~and fun (#%plain-lambda params body ...)))
@@ -118,7 +131,7 @@
                                                    (and drests #f)
                                                    (and kws '())))))
                doms]
-              [_ #f])) ]
+              [_ #f]))]
     #:when doms
     #:do [
        ;; at least 1 argument has to be of type float-complex
@@ -242,7 +255,7 @@
 ;; these arguments may be unboxed
 ;; the new function will have all the unboxed arguments first, then all the
 ;; boxed
-(define-syntax-class unboxed-fun-clause
+(define-syntax-class unbox-fun-clause
   #:commit
   #:attributes ([bindings 1])
   (pattern ((fun:unboxed-fun) (#%plain-lambda params body:opt-expr ...))
diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/tests/unboxed-let-constants-fail1.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/tests/unboxed-let-constants-fail1.rkt
index 2df49acc..f05a6383 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/tests/unboxed-let-constants-fail1.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/tests/unboxed-let-constants-fail1.rkt
@@ -16,7 +16,7 @@ END
 10.0
 
 END
-#lang typed/racket 
+#lang typed/racket
 
 
 (letrec-values (((x) 5.0+5.0i)