Change api of add unboxed-fun..

This commit is contained in:
Eric Dobson 2013-09-18 22:25:52 -07:00
parent 98c573557e
commit ced8879881
2 changed files with 11 additions and 8 deletions

View File

@ -86,9 +86,8 @@
(syntax-parse (cadr p) (syntax-parse (cadr p)
#:literal-sets (kernel-literals) #:literal-sets (kernel-literals)
[(#%plain-lambda params body ...) [(#%plain-lambda params body ...)
(define-values (unboxed boxed) (define unboxed-args
(for/fold ([unboxed empty] [boxed empty]) (for/list ([param (in-syntax #'params)]
([param (in-syntax #'params)]
[dom doms] [dom doms]
[i (in-naturals)]) [i (in-naturals)])
(cond (cond
@ -98,14 +97,14 @@
#'(begin body ...))) #'(begin body ...)))
;; we can unbox ;; we can unbox
(log-optimization "unboxed var -> table" arity-raising-opt-msg param) (log-optimization "unboxed var -> table" arity-raising-opt-msg param)
(values (cons i unboxed) boxed)] #t]
[else (values unboxed (cons i boxed))]))) [else #f])))
;; can we unbox anything? ;; can we unbox anything?
(and (> (length unboxed) 0) (and (member #t unboxed-args)
;; if so, add to the table of functions with ;; if so, add to the table of functions with
;; unboxed params, so we can modify its call ;; unboxed params, so we can modify its call
;; sites, its body and its header ;; sites, its body and its header
(add-unboxed-fun! fun-name unboxed boxed))] (add-unboxed-fun! fun-name unboxed-args))]
[_ #f])] [_ #f])]
[_ #f]))))) [_ #f])))))
rest))) rest)))

View File

@ -37,7 +37,11 @@
;; params first, then all imaginary parts, then all boxed arguments ;; params first, then all imaginary parts, then all boxed arguments
(define unboxed-funs-table (make-free-id-table)) (define unboxed-funs-table (make-free-id-table))
(define (add-unboxed-fun! fun-name unboxed boxed) (define (add-unboxed-fun! fun-name unboxed-args)
(define unboxed
(for/list ([i (in-naturals)] [unboxed? unboxed-args] #:when unboxed?) i))
(define boxed
(for/list ([i (in-naturals)] [unboxed? unboxed-args] #:unless unboxed?) i))
(dict-set! unboxed-funs-table fun-name (list unboxed boxed))) (dict-set! unboxed-funs-table fun-name (list unboxed boxed)))
(define-syntax-class unboxed-fun (define-syntax-class unboxed-fun