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

Fix bug in optimizer with unboxed let constants.

Browse Source
This commit is contained in:
Eric Dobson 2013-09-19 22:02:26 -07:00
parent 7812a202f0
commit 676be5de06
2 changed files with 24 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -112,15 +112,9 @@
#:with (opt-candidates:unboxed-let-clause ...) #'(candidates ...) #:with (opt-candidates:unboxed-let-clause ...) #'(candidates ...)
#:with (opt-functions:unboxed-fun-clause ...) #'(function-candidates ...) #:with (opt-functions:unboxed-fun-clause ...) #'(function-candidates ...)
#:with (opt-others:opt-let-clause ...) #'(others ...) #:with (opt-others:opt-let-clause ...) #'(others ...)
#:do [(unless (zero? (syntax-length #'(opt-candidates.id ...)))
;; only log when we actually optimize ;; only log when we actually optimize
(log-opt "unboxed let bindings" arity-raising-opt-msg)) #:do [(unless (zero? (syntax-length #'(opt-candidates.id ...)))
;; add the unboxed bindings to the table, for them to be used by (log-opt "unboxed let bindings" arity-raising-opt-msg))]
;; further optimizations
(for ((v (in-syntax #'(opt-candidates.id ...)))
(r (in-syntax #'(opt-candidates.real-binding ...)))
(i (in-syntax #'(opt-candidates.imag-binding ...))))
(add-unboxed-var! v r i))]
;; in the case where no bindings are unboxed, we create a let ;; in the case where no bindings are unboxed, we create a let
;; that is equivalent to the original, but with all parts optimized ;; that is equivalent to the original, but with all parts optimized
#:with opt (quasisyntax/loc/origin #:with opt (quasisyntax/loc/origin
@ -228,7 +222,8 @@
(define-syntax-class unboxed-let-clause (define-syntax-class unboxed-let-clause
#:commit #:commit
#:attributes (id real-binding imag-binding (bindings 1)) #:attributes (id real-binding imag-binding (bindings 1))
(pattern ((id:id) :unboxed-float-complex-opt-expr))) (pattern ((id:id) :unboxed-float-complex-opt-expr)
#:do [(add-unboxed-var! #'id #'real-binding #'imag-binding)]))
;; let clause whose rhs is a function with some float complex arguments ;; let clause whose rhs is a function with some float complex arguments
;; these arguments may be unboxed ;; these arguments may be unboxed

20
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/tests/unboxed-let-constants.rkt Normal file
View File

@ -0,0 +1,20 @@
#;#;
#<<END
TR opt: unboxed-let-constants.rkt 18:0 (letrec-values (((x) 5.0+5.0i) ((z) x)) (real-part (+ x z))) -- unboxed let bindings
TR opt: unboxed-let-constants.rkt 18:21 5.0+5.0i -- unboxed literal
TR opt: unboxed-let-constants.rkt 19:21 x -- leave var unboxed
TR opt: unboxed-let-constants.rkt 20:13 (+ x z) -- unboxed binary float complex
TR opt: unboxed-let-constants.rkt 20:16 x -- leave var unboxed
TR opt: unboxed-let-constants.rkt 20:18 z -- leave var unboxed
TR opt: unboxed-let-constants.rkt 20:2 (real-part (+ x z)) -- complex accessor elimination
END
#<<END
10.0
END
#lang typed/racket
(letrec-values (((x) 5.0+5.0i)
((z) x))
(real-part (+ x z)))