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

Add syntax class for unboxed functions.

Browse Source 
original commit: a56f2af6711e8aae9d458129936fbe5213a097d4
This commit is contained in:
Eric Dobson 2013-09-18 09:56:18 -07:00
parent 071e56bb44
commit c49290c3f3
3 changed files with 19 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/float-complex.rkt
View File

@ -394,11 +394,9 @@
#:with opt #`(let*-values (exp.bindings ...)
(unsafe-make-flrectangular exp.real-binding exp.imag-binding)))
(pattern (#%plain-app op:id args:expr ...)
#:do [(define unboxed-info (dict-ref unboxed-funs-table #'op #f))]
#:when unboxed-info
(pattern (#%plain-app op:unboxed-fun args:expr ...)
;no need to optimize op
#:with (~var || (float-complex-call-site-opt-expr unboxed-info #'op)) this-syntax
#:with (~var || (float-complex-call-site-opt-expr #'op.unboxed-info #'op)) this-syntax
#:do [(log-arity-raising-opt "call to fun with unboxed args")])
(pattern :float-complex-arith-opt-expr))

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

@ -33,10 +33,9 @@
loop-fun:id)) ; sole element of the body
args:expr ...)
#:with (~var operator (unboxed-let-opt-expr-internal #t)) #'let-e
#:with unboxed-info (dict-ref unboxed-funs-table #'loop-fun #f)
#:when (syntax->datum #'unboxed-info)
#:do [(log-optimization "unboxed let loop" arity-raising-opt-msg #'loop-fun)]
#:with (~var || (float-complex-call-site-opt-expr #'unboxed-info #'operator.opt)) this-syntax))
#:with loop-fun2:unboxed-fun #'loop-fun
#:do [(log-optimization "unboxed let loop" arity-raising-opt-msg #'loop-fun2)]
#:with (~var || (float-complex-call-site-opt-expr #'loop-fun2.unboxed-info #'operator.opt)) this-syntax))
;; does the bulk of the work
;; detects which let bindings can be unboxed, same for arguments of let-bound
@ -245,19 +244,15 @@
(define-syntax-class unboxed-fun-clause
#:commit
#:attributes (res)
(pattern ((id:id) (#%plain-lambda params body:opt-expr ...))
#:with unboxed-info (dict-ref unboxed-funs-table #'id #f)
#:when (syntax->datum #'unboxed-info)
;; partition of the arguments
#:with ((to-unbox ...) (boxed ...)) #'unboxed-info
(pattern ((fun:unboxed-fun) (#%plain-lambda params body:opt-expr ...))
#:with (real-params ...)
(stx-map (lambda (x) (generate-temporary "unboxed-real-")) #'(to-unbox ...))
(stx-map (lambda (x) (generate-temporary "unboxed-real-")) #'(fun.unboxed ...))
#:with (imag-params ...)
(stx-map (lambda (x) (generate-temporary "unboxed-imag-")) #'(to-unbox ...))
#:do [(log-optimization "fun -> unboxed fun" arity-raising-opt-msg #'id)]
(stx-map (lambda (x) (generate-temporary "unboxed-imag-")) #'(fun.unboxed ...))
#:do [(log-optimization "fun -> unboxed fun" arity-raising-opt-msg #'fun)]
#:with res
;; add unboxed parameters to the unboxed vars table
(let ((to-unbox (syntax->datum #'(to-unbox ...))))
(let ((to-unbox (syntax->datum #'(fun.unboxed ...))))
(let loop ((params (syntax->list #'params))
(i 0)
(real-parts (syntax->list #'(real-params ...)))
@ -267,7 +262,7 @@
;; real parts of unboxed parameters go first, then all
;; imag parts, then boxed occurrences of unboxed
;; parameters will be inserted when optimizing the body
#`((id) (#%plain-lambda
#`((fun) (#%plain-lambda
(real-params ... imag-params ... #,@(reverse boxed))
body.opt ...))]
[(memq i to-unbox)

9
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/unboxed-tables.rkt
View File

@ -5,8 +5,8 @@
(utils tc-utils))
(provide
unboxed-funs-table
add-unboxed-fun!
unboxed-fun
add-unboxed-var!
unboxed-var)
@ -39,3 +39,10 @@
(define (add-unboxed-fun! fun-name unboxed boxed)
(dict-set! unboxed-funs-table fun-name (list unboxed boxed)))
(define-syntax-class unboxed-fun
#:attributes ((unboxed 1) (boxed 1) unboxed-info)
(pattern op:id
#:with unboxed-info (dict-ref unboxed-funs-table #'op #f)
#:when (syntax->datum #'unboxed-info)
#:with ((unboxed ...) (boxed ...)) #'unboxed-info))