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

Make unboxed optimizations not reorder expressions.

Browse Source 
original commit: 263e09884e8947a772ea02d02d0bf11122b549e2
This commit is contained in:
Eric Dobson 2013-09-18 23:45:06 -07:00
parent add9841c10
commit 7a4d74acfc
3 changed files with 78 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/float-complex.rkt
View File

@ -463,6 +463,20 @@
#'(unsafe-make-flrectangular real-binding imag-binding))))
(define-syntax-class possibly-unboxed
#:attributes ([bindings 1] [real-binding 1] [imag-binding 1] [boxed-binding 1])
(pattern (#t arg:unboxed-float-complex-opt-expr)
#:with (bindings ...) #'(arg.bindings ...)
#:with (real-binding ...) #'(arg.real-binding)
#:with (imag-binding ...) #'(arg.imag-binding)
#:with (boxed-binding ...) #'())
(pattern (#f arg:opt-expr)
#:with binding-name (generate-temporary 'boxed-binding)
#:with (bindings ...) #'(((binding-name) arg.opt))
#:with (real-binding ...) #'()
#:with (imag-binding ...) #'()
#:with (boxed-binding ...) #'(binding-name)))
;; takes as argument a structure describing which arguments will be unboxed
;; and the optimized version of the operator. operators are optimized elsewhere
;; to benefit from local information
@ -472,21 +486,17 @@
;; call site of a function with unboxed parameters
;; the calling convention is: real parts of unboxed, imag parts, boxed
(pattern (#%plain-app op:expr args:expr ...)
#:with ((to-unbox ...) (boxed ...)) unboxed-info
#:with (unboxed-args ...) unboxed-info
#:with opt
(let ((args (syntax->list #'(args ...)))
(unboxed (syntax->datum #'(to-unbox ...)))
(boxed (syntax->datum #'(boxed ...))))
(define (get-arg i) (list-ref args i))
(syntax-parse (map get-arg unboxed)
[(e:unboxed-float-complex-opt-expr ...)
(syntax-parse #'((unboxed-args args) ...)
[(e:possibly-unboxed ...)
(log-unboxing-opt "unboxed call site")
#`(let*-values (e.bindings ... ...)
(#%plain-app #,opt-operator
e.real-binding ...
e.imag-binding ...
#,@(map (lambda (i) ((optimize) (get-arg i)))
boxed)))])))) ; boxed params
e.real-binding ... ...
e.imag-binding ... ...
e.boxed-binding ... ...))])))
(define-syntax-class/specialize float-complex-arith-opt-expr (float-complex-arith-expr* #t))
(define-syntax-class/specialize float-complex-arith-expr (float-complex-arith-expr* #f))

18
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/unboxed-tables.rkt
View File

@ -38,15 +38,15 @@
(define unboxed-funs-table (make-free-id-table))
(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 unboxed-args))
(define-syntax-class unboxed-fun
#:attributes ((unboxed 1) (boxed 1) unboxed-info)
#:attributes ((unboxed 1) unboxed-info)
(pattern op:id
#:with unboxed-info (dict-ref unboxed-funs-table #'op #f)
#:when (syntax->datum #'unboxed-info)
#:with ((unboxed ...) (boxed ...)) #'unboxed-info))
#:do [(define unboxed-args (dict-ref unboxed-funs-table #'op #f))]
#:when unboxed-args
#:with ((unboxed ...) (boxed ...))
(list
(for/list ([i (in-naturals)] [unboxed? unboxed-args] #:when unboxed?) i)
(for/list ([i (in-naturals)] [unboxed? unboxed-args] #:unless unboxed?) i))
#:with (~and unboxed-info (unboxed-args ...)) unboxed-args))

48
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/tests/let-loop-effects.rkt Normal file
View File

@ -0,0 +1,48 @@
#;#;
#<<END
TR info: let-loop-effects.rkt 45:34 displayln -- hidden parameter
TR info: let-loop-effects.rkt 46:34 displayln -- hidden parameter
TR info: let-loop-effects.rkt 47:34 displayln -- hidden parameter
TR opt: let-loop-effects.rkt 40:0 (real-part (let: loop : Float-Complex ((x : Float-Complex 0.0+0.0i) (y : Integer 0) (z : Float-Complex 0.0+0.0i)) (if (zero? y) (+ 1.0+0.0i (loop (begin (displayln (quote x)) x) (begin (displayln (quote y)) (add1 y)) (begin (displayln (quote z)) z))) (+ x z)))) -- complex accessor elimination
TR opt: let-loop-effects.rkt 41:2 (let: loop : Float-Complex ((x : Float-Complex 0.0+0.0i) (y : Integer 0) (z : Float-Complex 0.0+0.0i)) (if (zero? y) (+ 1.0+0.0i (loop (begin (displayln (quote x)) x) (begin (displayln (quote y)) (add1 y)) (begin (displayln (quote z)) z))) (+ x z))) -- unbox float-complex
TR opt: let-loop-effects.rkt 41:2 (let: loop : Float-Complex ((x : Float-Complex 0.0+0.0i) (y : Integer 0) (z : Float-Complex 0.0+0.0i)) (if (zero? y) (+ 1.0+0.0i (loop (begin (displayln (quote x)) x) (begin (displayln (quote y)) (add1 y)) (begin (displayln (quote z)) z))) (+ x z))) -- unboxed call site
TR opt: let-loop-effects.rkt 41:31 x -- unboxed var -> table
TR opt: let-loop-effects.rkt 41:49 0.0+0.0i -- unboxed literal
TR opt: let-loop-effects.rkt 41:8 loop -- fun -> unboxed fun
TR opt: let-loop-effects.rkt 41:8 loop -- unboxed let loop
TR opt: let-loop-effects.rkt 43:31 z -- unboxed var -> table
TR opt: let-loop-effects.rkt 43:49 0.0+0.0i -- unboxed literal
TR opt: let-loop-effects.rkt 45:11 1.0+0.0i -- unboxed literal
TR opt: let-loop-effects.rkt 45:20 (loop (begin (displayln (quote x)) x) (begin (displayln (quote y)) (add1 y)) (begin (displayln (quote z)) z)) -- call to fun with unboxed args
TR opt: let-loop-effects.rkt 45:20 (loop (begin (displayln (quote x)) x) (begin (displayln (quote y)) (add1 y)) (begin (displayln (quote z)) z)) -- unbox float-complex
TR opt: let-loop-effects.rkt 45:20 (loop (begin (displayln (quote x)) x) (begin (displayln (quote y)) (add1 y)) (begin (displayln (quote z)) z)) -- unboxed call site
TR opt: let-loop-effects.rkt 45:26 (begin (displayln (quote x)) x) -- unbox float-complex
TR opt: let-loop-effects.rkt 45:48 x -- unboxed complex variable
TR opt: let-loop-effects.rkt 45:8 (+ 1.0+0.0i (loop (begin (displayln (quote x)) x) (begin (displayln (quote y)) (add1 y)) (begin (displayln (quote z)) z))) -- unboxed binary float complex
TR opt: let-loop-effects.rkt 46:48 (add1 y) -- fixnum add1
TR opt: let-loop-effects.rkt 47:26 (begin (displayln (quote z)) z) -- unbox float-complex
TR opt: let-loop-effects.rkt 47:48 z -- unboxed complex variable
TR opt: let-loop-effects.rkt 48:11 x -- leave var unboxed
TR opt: let-loop-effects.rkt 48:13 z -- leave var unboxed
TR opt: let-loop-effects.rkt 48:8 (+ x z) -- unboxed binary float complex
END
#<<END
x
y
z
1.0
END
#lang typed/racket
;; Ensure that loop unboxing doesn't change order of effects
(real-part
(let: loop : Float-Complex ((x : Float-Complex 0.0+0.0i)
(y : Integer 0)
(z : Float-Complex 0.0+0.0i))
(if (zero? y)
(+ 1.0+0.0i (loop (begin (displayln 'x) x)
(begin (displayln 'y) (add1 y))
(begin (displayln 'z) z)))
(+ x z))))