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

Fixed a bug with functions with unboxed complex and non-complex args.

Browse Source
This commit is contained in:
Vincent St-Amour 2010-07-27 21:04:12 -04:00
parent 9d471df8b9
commit defe96a148
1 changed files with 16 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
collects/typed-scheme/optimizer/unboxed-let.rkt
View File

@ -223,18 +223,26 @@
(let loop ((params (syntax->list #'params)) (let loop ((params (syntax->list #'params))
(i 0) (i 0)
(real-parts (syntax->list #'(real-params ...))) (real-parts (syntax->list #'(real-params ...)))
(imag-parts (syntax->list #'(imag-params ...)))) (imag-parts (syntax->list #'(imag-params ...)))
(cond [(null? params)] ; done (boxed '()))
(cond [(null? params) ; done, create the new clause
;; real parts of unboxed parameters go first, then all imag
;; parts, then boxed occurrences of unboxed parameters will
;; be inserted when optimizing the body
#`((v) (#%plain-lambda
(real-params ... imag-params ... #,@(reverse boxed))
#,@(map (optimize) (syntax->list #'(body ...)))))]
[(memq i to-unbox) ; we unbox the current param, add to the table [(memq i to-unbox) ; we unbox the current param, add to the table
(dict-set! unboxed-vars-table (car params) (dict-set! unboxed-vars-table (car params)
(list (car real-parts) (car imag-parts))) (list (car real-parts) (car imag-parts)))
(loop (cdr params) (add1 i) (cdr real-parts) (cdr imag-parts))] (loop (cdr params) (add1 i)
(cdr real-parts) (cdr imag-parts)
boxed)]
[else ; that param stays boxed, keep going [else ; that param stays boxed, keep going
(loop (cdr params) (add1 i) real-parts imag-parts)]))) (loop (cdr params) (add1 i)
;; real parts of unboxed parameters go first, then all imag parts, then boxed real-parts imag-parts
;; occurrences of unboxed parameters will be inserted when optimizing the body (cons (car params) boxed))]))))))
#`((v) (#%plain-lambda (real-params ... imag-params ... boxed ...)
#,@(map (optimize) (syntax->list #'(body ...))))))))
(define-syntax-class opt-let-clause (define-syntax-class opt-let-clause
(pattern (vs rhs:expr) (pattern (vs rhs:expr)