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

Clean up unboxed function parsing loop.

Browse Source
This commit is contained in:
Eric Dobson 2013-09-18 21:00:36 -07:00
parent a56f2af671
commit d882abe47b
1 changed files with 20 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -86,32 +86,26 @@
(syntax-parse (cadr p) (syntax-parse (cadr p)
#:literal-sets (kernel-literals) #:literal-sets (kernel-literals)
[(#%plain-lambda params body ...) [(#%plain-lambda params body ...)
;; keep track of the param # of each param that can be (define-values (unboxed boxed)
;; unboxed (for/fold ([unboxed empty] [boxed empty])
(let loop ((unboxed '()) ([param (in-syntax #'params)]
(boxed '()) [dom doms]
(i 0) [i (in-naturals)])
(params (syntax->list #'params)) (cond
(doms doms)) [(and (equal? dom -FloatComplex)
(cond [(null? params) (could-be-unboxed-in?
;; done. can we unbox anything? param
(and (> (length unboxed) 0) #'(begin body ...)))
;; if so, add to the table of functions with ;; we can unbox
;; unboxed params, so we can modify its call (log-optimization "unboxed var -> table" arity-raising-opt-msg param)
;; sites, its body and its header (values (cons i unboxed) boxed)]
(add-unboxed-fun! fun-name unboxed boxed))] [else (values unboxed (cons i boxed))])))
[(and (equal? (car doms) -FloatComplex) ;; can we unbox anything?
(could-be-unboxed-in? (and (> (length unboxed) 0)
(car params) #'(begin body ...))) ;; if so, add to the table of functions with
;; we can unbox ;; unboxed params, so we can modify its call
(log-optimization "unboxed var -> table" ;; sites, its body and its header
arity-raising-opt-msg (add-unboxed-fun! fun-name unboxed boxed))]
(car params))
(loop (cons i unboxed) boxed
(add1 i) (cdr params) (cdr doms))]
[else ; can't unbox
(loop unboxed (cons i boxed)
(add1 i) (cdr params) (cdr doms))]))]
[_ #f])] [_ #f])]
[_ #f]))))) [_ #f])))))
rest))) rest)))