suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Make new syntax class for all clauses.

Browse Source 
(cherry picked from commit 74ce1ea748)
This commit is contained in:
Eric Dobson 2013-09-28 10:46:44 -04:00 committed by Ryan Culpepper
parent d48f6b7b11
commit 6828b508ee
1 changed files with 17 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/unboxed-let.rkt
View File

@ -58,24 +58,16 @@
(define-syntax-class unboxed-let-clause? (define-syntax-class unboxed-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 ...))))
;; extract function bindings that have float-complex arguments
;; we may be able to pass arguments unboxed ;; Clauses that define functions that can be lifted
;; this covers loop variables
;; if the function escapes, we can't change its interface
;; Currently can only optimize terms that bind one value
(define-syntax-class unboxed-fun-clause? (define-syntax-class unboxed-fun-clause?
(pattern (~and ((_:non-escaping-function) . _) (pattern (~and ((_:non-escaping-function) . _)
_:unboxed-fun-definition))) _:unboxed-fun-definition)))
(define-syntax-class unboxed-clause? (define-syntax-class unboxed-clause?
#:attributes ([candidates 1] #:attributes (unboxed-let bindings)
[function-candidates 1]
[others 1]
bindings)
(pattern v:unboxed-let-clause? (pattern v:unboxed-let-clause?
#:with (candidates ...) #'(v) #:attr unboxed-let #t
#:with (function-candidates ...) #'()
#:with (others ...) #'()
#: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
@ -86,38 +78,35 @@
((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:unboxed-fun-clause?
#:with (candidates ...) #'() #:attr unboxed-let #f
#:with (function-candidates ...) #'(v)
#:with (others ...) #'()
#:attr bindings #:attr bindings
(delay (delay
(syntax-parse #'v (syntax-parse #'v
[c:unboxed-fun-clause [c:unboxed-fun-clause
#'(c.bindings ...)]))) #'(c.bindings ...)])))
(pattern v (pattern v
#:with (candidates ...) #'() #:attr unboxed-let #f
#:with (function-candidates ...) #'()
#:with (others ...) #'(v)
#:attr bindings #:attr bindings
(delay (delay
(syntax-parse #'v (syntax-parse #'v
[(vs rhs:opt-expr) [(vs rhs:opt-expr)
#'((vs rhs.opt))])))) #'((vs rhs.opt))]))))
] (define full-syntax this-syntax)
(define-syntax-class unboxed-clauses
#:attributes ([bindings 1])
(pattern (clauses:unboxed-clause? ...)
;; only log when we actually optimize
#:do [(when (member #t (attribute clauses.unboxed-let))
(log-optimization "unboxed let bindings" arity-raising-opt-msg full-syntax))]
#:with (bindings ...) (template ((?@ . clauses.bindings) ...))))]
;; 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
#:with opt #:with opt
(syntax-parse #'(clause ...) (syntax-parse #'(clause ...)
[(clause:unboxed-clause? ...) [clauses:unboxed-clauses
;; only log when we actually optimize
(unless (zero? (syntax-length #'(clause.candidates ... ...)))
(log-opt "unboxed let bindings" arity-raising-opt-msg))
(define/with-syntax ((new-binds ...) ...) #'(clause.bindings ...))
(quasisyntax/loc/origin (quasisyntax/loc/origin
this-syntax #'letk.kw this-syntax #'letk.kw
(letk.key ... (new-binds ... ...) body.opt ...))]))) (letk.key ... (clauses.bindings ...) body.opt ...))])))