Improve comments and change name for unboxable-funs.

(cherry picked from commit 2fd6a05d46)
This commit is contained in:
Eric Dobson 2013-11-10 22:57:10 -08:00 committed by Ryan Culpepper
parent 96accbd554
commit 1e792fbd6d
2 changed files with 29 additions and 16 deletions

View File

@ -48,23 +48,32 @@
(pattern (pattern
(letk:let-like-keyword ((~and clause (lhs rhs)) ...) (letk:let-like-keyword ((~and clause (lhs rhs)) ...)
body:opt-expr ...) 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 (pattern fun-name:id
#:when (not (or (escapes? #'fun-name #'(begin rhs ...) #f) #:when (not (or (escapes? #'fun-name #'(begin rhs ...) #f)
(escapes? #'fun-name #'(begin body ...) let-loop?))))) (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) (pattern ((id:id) rhs:float-complex-expr)
#:when (could-be-unboxed-in? #'id #'(begin body ...)))) #:when (could-be-unboxed-in? #'id #'(begin body ...))))
;; Clauses that define functions that can be lifted ;; Clauses that define functions that can be lifted
(define-syntax-class unboxed-fun-clause? (define-syntax-class unboxable-fun-clause?
(pattern (~and ((_:non-escaping-function) . _) (pattern (~and ((_:non-escaping-function-id) body:expr)
_:unboxed-fun-definition))) _: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) #:attributes (bindings)
(pattern v:unboxed-let-clause? (pattern v:unboxable-let-clause?
#:with (real-binding imag-binding) (binding-names) #:with (real-binding imag-binding) (binding-names)
#:do [(add-unboxed-var! #'v.id #'real-binding #'imag-binding)] #:do [(add-unboxed-var! #'v.id #'real-binding #'imag-binding)]
#:attr bindings #:attr bindings
@ -75,11 +84,11 @@
#'(c.bindings ... #'(c.bindings ...
((real-binding) c.real-binding) ((real-binding) c.real-binding)
((imag-binding) c.imag-binding))]))) ((imag-binding) c.imag-binding))])))
(pattern v:unboxed-fun-clause? (pattern v:unboxable-fun-clause?
#:attr bindings #:attr bindings
(delay (delay
(syntax-parse #'v (syntax-parse #'v
[c:unboxed-fun-clause [c:unbox-fun-clause
#'(c.bindings ...)]))) #'(c.bindings ...)])))
(pattern v (pattern v
#:attr bindings #:attr bindings
@ -87,10 +96,9 @@
(syntax-parse #'v (syntax-parse #'v
[(vs rhs:opt-expr) [(vs rhs:opt-expr)
#'((vs rhs.opt))])))) #'((vs rhs.opt))]))))
(define-syntax-class unboxed-clauses (define-syntax-class unboxed-clauses
#:attributes ([bindings 1]) #:attributes ([bindings 1])
(pattern (clauses:unboxed-clause? ...) (pattern (clauses:unboxed-clause ...)
#:with (bindings ...) (template ((?@ . clauses.bindings) ...))))] #:with (bindings ...) (template ((?@ . clauses.bindings) ...))))]
#:with opt #:with opt
@ -107,7 +115,12 @@
(pattern v:id (pattern v:id
#:when (not (is-var-mutated? #'v)))) #: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 () #:attributes ()
#:literal-sets (kernel-literals) #:literal-sets (kernel-literals)
(pattern ((fun-name:constant-var) (~and fun (#%plain-lambda params body ...))) (pattern ((fun-name:constant-var) (~and fun (#%plain-lambda params body ...)))
@ -118,7 +131,7 @@
(and drests #f) (and drests #f)
(and kws '()))))) (and kws '())))))
doms] doms]
[_ #f])) ] [_ #f]))]
#:when doms #:when doms
#:do [ #:do [
;; at least 1 argument has to be of type float-complex ;; at least 1 argument has to be of type float-complex
@ -242,7 +255,7 @@
;; these arguments may be unboxed ;; these arguments may be unboxed
;; the new function will have all the unboxed arguments first, then all the ;; the new function will have all the unboxed arguments first, then all the
;; boxed ;; boxed
(define-syntax-class unboxed-fun-clause (define-syntax-class unbox-fun-clause
#:commit #:commit
#:attributes ([bindings 1]) #:attributes ([bindings 1])
(pattern ((fun:unboxed-fun) (#%plain-lambda params body:opt-expr ...)) (pattern ((fun:unboxed-fun) (#%plain-lambda params body:opt-expr ...))

View File

@ -16,7 +16,7 @@ END
10.0 10.0
END END
#lang typed/racket #lang typed/racket
(letrec-values (((x) 5.0+5.0i) (letrec-values (((x) 5.0+5.0i)