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

More refactoring.

Browse Source
This commit is contained in:
Eric Dobson 2013-09-18 21:25:04 -07:00
parent d882abe47b
commit c162a83c69
1 changed files with 15 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -247,28 +247,21 @@
#:with res #:with res
;; add unboxed parameters to the unboxed vars table ;; add unboxed parameters to the unboxed vars table
(let ((to-unbox (syntax->datum #'(fun.unboxed ...)))) (let ((to-unbox (syntax->datum #'(fun.unboxed ...))))
(let loop ((params (syntax->list #'params)) (for ([index (in-list to-unbox)]
(i 0) [real-part (in-syntax #'(real-params ...))]
(real-parts (syntax->list #'(real-params ...))) [imag-part (in-syntax #'(imag-params ...))])
(imag-parts (syntax->list #'(imag-params ...))) (add-unboxed-var! (list-ref (syntax->list #'params) index) real-part imag-part))
(boxed '())) (define boxed
(cond [(null? params) ; done, create the new clause (for/list ([param (in-syntax #'params)]
;; real parts of unboxed parameters go first, then all [i (in-naturals)]
;; imag parts, then boxed occurrences of unboxed #:unless (memq i to-unbox))
;; parameters will be inserted when optimizing the body param))
#`((fun) (#%plain-lambda ;; real parts of unboxed parameters go first, then all
(real-params ... imag-params ... #,@(reverse boxed)) ;; imag parts, then boxed occurrences of unboxed
body.opt ...))] ;; parameters will be inserted when optimizing the body
[(memq i to-unbox) #`((fun) (#%plain-lambda
;; we unbox the current param, add to the table (real-params ... imag-params ... #,@(reverse boxed))
(add-unboxed-var! (car params) (car real-parts) (car imag-parts)) body.opt ...)))))
(loop (cdr params) (add1 i)
(cdr real-parts) (cdr imag-parts)
boxed)]
[else ; that param stays boxed, keep going
(loop (cdr params) (add1 i)
real-parts imag-parts
(cons (car params) boxed))])))))
(define-syntax-class opt-let-clause (define-syntax-class opt-let-clause
#:commit #:commit