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

Optimized extracting parts of inexact complexes.

Browse Source
This commit is contained in:
Vincent St-Amour 2010-07-22 19:23:03 -04:00
parent 0493e6f762
commit 063b87697a
17 changed files with 242 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/tests/typed-scheme/optimizer/generic/inexact-complex-parts2.rkt Normal file
View File

@ -0,0 +1,8 @@
#lang typed/scheme #:optimize
(require racket/unsafe/ops)
(real-part (+ 1.0+2.0i 2.0+4.0i))
(unsafe-flreal-part (+ 1.0+2.0i 2.0+4.0i))
(imag-part (+ 1.0+2.0i 2.0+4.0i))
(unsafe-flimag-part (+ 1.0+2.0i 2.0+4.0i))

8
collects/tests/typed-scheme/optimizer/generic/inexact-complex-parts3.rkt Normal file
View File

@ -0,0 +1,8 @@
#lang typed/scheme #:optimize
(require racket/unsafe/ops)
(+ 1.0+2.0i (real-part (+ 2.0+4.0i 3.0+6.0i)))
(+ 1.0+2.0i (unsafe-flreal-part (+ 2.0+4.0i 3.0+6.0i)))
(+ 1.0+2.0i (imag-part (+ 2.0+4.0i 3.0+6.0i)))
(+ 1.0+2.0i (unsafe-flimag-part (+ 2.0+4.0i 3.0+6.0i)))

2
collects/tests/typed-scheme/optimizer/hand-optimized/inexact-complex-conjugate-top.rkt
View File

@ -1,4 +1,4 @@
#lang typed/scheme #:optimize
#lang typed/scheme
(require racket/unsafe/ops)
(let* ((unboxed-gensym-1 1.0+2.0i)
(unboxed-gensym-2 (unsafe-flreal-part unboxed-gensym-1))

2
collects/tests/typed-scheme/optimizer/hand-optimized/inexact-complex-conjugate.rkt
View File

@ -1,4 +1,4 @@
#lang typed/scheme #:optimize
#lang typed/scheme
(require racket/unsafe/ops)
(let* ((unboxed-gensym-1 1.0+2.0i)
(unboxed-gensym-2 (unsafe-flreal-part unboxed-gensym-1))

2
collects/tests/typed-scheme/optimizer/hand-optimized/inexact-complex-div.rkt
View File

@ -1,4 +1,4 @@
(module inexact-complex-div typed/scheme #:optimize
(module inexact-complex-div typed/scheme
(require racket/unsafe/ops)
(let* ((unboxed-gensym-1 1.0+2.0i)
(unboxed-gensym-2 (unsafe-flreal-part unboxed-gensym-1))

2
collects/tests/typed-scheme/optimizer/hand-optimized/inexact-complex-fixnum.rkt
View File

@ -1,4 +1,4 @@
#lang typed/scheme #:optimize
#lang typed/scheme
(require racket/unsafe/ops)
(let* ((unboxed-gensym-1 (unsafe-fx->fl 2))
(unboxed-gensym-2 1.0+2.0i)

6
collects/tests/typed-scheme/optimizer/hand-optimized/inexact-complex-float-div.rkt
View File

@ -1,8 +1,8 @@
#lang typed/scheme #:optimize
#lang typed/scheme
(require racket/unsafe/ops)
(map (lambda: ((x : Inexact-Complex))
(string-append (real->decimal-string (real-part x) 10)
(real->decimal-string (imag-part x) 10)))
(string-append (real->decimal-string (unsafe-flreal-part x) 10)
(real->decimal-string (unsafe-flimag-part x) 10)))
(list
(let* ((unboxed-gensym-1 1.0)
(unboxed-gensym-2 2.0+4.0i)

2
collects/tests/typed-scheme/optimizer/hand-optimized/inexact-complex-float-mul.rkt
View File

@ -1,4 +1,4 @@
#lang typed/scheme #:optimize
#lang typed/scheme
(require racket/unsafe/ops)
(let* ((unboxed-gensym-1 1.0)
(unboxed-gensym-2 2.0+4.0i)

2
collects/tests/typed-scheme/optimizer/hand-optimized/inexact-complex-i.rkt
View File

@ -1,4 +1,4 @@
#lang typed/scheme #:optimize
#lang typed/scheme
(require racket/unsafe/ops)
(let* ((unboxed-gensym-1 1.0+2.0i)
(unboxed-gensym-2 (unsafe-flreal-part unboxed-gensym-1))

2
collects/tests/typed-scheme/optimizer/hand-optimized/inexact-complex-integer.rkt
View File

@ -1,4 +1,4 @@
#lang typed/scheme #:optimize
#lang typed/scheme
(require racket/unsafe/ops racket/flonum)
(let* ((unboxed-gensym-1 (->fl (expt 2 100)))
(unboxed-gensym-2 1.0+2.0i)

2
collects/tests/typed-scheme/optimizer/hand-optimized/inexact-complex-mult.rkt
View File

@ -1,4 +1,4 @@
(module inexact-complex-mult typed/scheme #:optimize
(module inexact-complex-mult typed/scheme
(require racket/unsafe/ops)
(let* ((unboxed-gensym-1 1.0+2.0i)
(unboxed-gensym-2 (unsafe-flreal-part unboxed-gensym-1))

40
collects/tests/typed-scheme/optimizer/hand-optimized/inexact-complex-parts2.rkt Normal file
View File

@ -0,0 +1,40 @@
#lang typed/scheme
(require racket/unsafe/ops)
(let* ((unboxed-gensym-1 1.0+2.0i)
(unboxed-gensym-2 (unsafe-flreal-part unboxed-gensym-1))
(unboxed-gensym-3 (unsafe-flimag-part unboxed-gensym-1))
(unboxed-gensym-4 2.0+4.0i)
(unboxed-gensym-5 (unsafe-flreal-part unboxed-gensym-4))
(unboxed-gensym-6 (unsafe-flimag-part unboxed-gensym-4))
(unboxed-gensym-7 (unsafe-fl+ unboxed-gensym-2 unboxed-gensym-5))
(unboxed-gensym-8 (unsafe-fl+ unboxed-gensym-3 unboxed-gensym-6)))
unboxed-gensym-7)
(let* ((unboxed-gensym-1 1.0+2.0i)
(unboxed-gensym-2 (unsafe-flreal-part unboxed-gensym-1))
(unboxed-gensym-3 (unsafe-flimag-part unboxed-gensym-1))
(unboxed-gensym-4 2.0+4.0i)
(unboxed-gensym-5 (unsafe-flreal-part unboxed-gensym-4))
(unboxed-gensym-6 (unsafe-flimag-part unboxed-gensym-4))
(unboxed-gensym-7 (unsafe-fl+ unboxed-gensym-2 unboxed-gensym-5))
(unboxed-gensym-8 (unsafe-fl+ unboxed-gensym-3 unboxed-gensym-6)))
unboxed-gensym-7)
(let* ((unboxed-gensym-1 1.0+2.0i)
(unboxed-gensym-2 (unsafe-flreal-part unboxed-gensym-1))
(unboxed-gensym-3 (unsafe-flimag-part unboxed-gensym-1))
(unboxed-gensym-4 2.0+4.0i)
(unboxed-gensym-5 (unsafe-flreal-part unboxed-gensym-4))
(unboxed-gensym-6 (unsafe-flimag-part unboxed-gensym-4))
(unboxed-gensym-7 (unsafe-fl+ unboxed-gensym-2 unboxed-gensym-5))
(unboxed-gensym-8 (unsafe-fl+ unboxed-gensym-3 unboxed-gensym-6)))
unboxed-gensym-8)
(let* ((unboxed-gensym-1 1.0+2.0i)
(unboxed-gensym-2 (unsafe-flreal-part unboxed-gensym-1))
(unboxed-gensym-3 (unsafe-flimag-part unboxed-gensym-1))
(unboxed-gensym-4 2.0+4.0i)
(unboxed-gensym-5 (unsafe-flreal-part unboxed-gensym-4))
(unboxed-gensym-6 (unsafe-flimag-part unboxed-gensym-4))
(unboxed-gensym-7 (unsafe-fl+ unboxed-gensym-2 unboxed-gensym-5))
(unboxed-gensym-8 (unsafe-fl+ unboxed-gensym-3 unboxed-gensym-6)))
unboxed-gensym-8)

60
collects/tests/typed-scheme/optimizer/hand-optimized/inexact-complex-parts3.rkt Normal file
View File

@ -0,0 +1,60 @@
#lang typed/scheme
(require racket/unsafe/ops)
(let* ((unboxed-gensym-1 1.0+2.0i)
(unboxed-gensym-2 (unsafe-flreal-part unboxed-gensym-1))
(unboxed-gensym-3 (unsafe-flimag-part unboxed-gensym-1))
(unboxed-gensym-4 2.0+4.0i)
(unboxed-gensym-5 (unsafe-flreal-part unboxed-gensym-4))
(unboxed-gensym-6 (unsafe-flimag-part unboxed-gensym-4))
(unboxed-gensym-7 3.0+6.0i)
(unboxed-gensym-8 (unsafe-flreal-part unboxed-gensym-7))
(unboxed-gensym-9 (unsafe-flimag-part unboxed-gensym-7))
(unboxed-gensym-10 (unsafe-fl+ unboxed-gensym-5 unboxed-gensym-8))
(unboxed-gensym-11 (unsafe-fl+ unboxed-gensym-6 unboxed-gensym-9))
(unboxed-gensym-12 (unsafe-fl+ unboxed-gensym-2 unboxed-gensym-10))
(unboxed-gensym-13 unboxed-gensym-3))
(unsafe-make-flrectangular unboxed-gensym-12 unboxed-gensym-13))
(let* ((unboxed-gensym-1 1.0+2.0i)
(unboxed-gensym-2 (unsafe-flreal-part unboxed-gensym-1))
(unboxed-gensym-3 (unsafe-flimag-part unboxed-gensym-1))
(unboxed-gensym-4 2.0+4.0i)
(unboxed-gensym-5 (unsafe-flreal-part unboxed-gensym-4))
(unboxed-gensym-6 (unsafe-flimag-part unboxed-gensym-4))
(unboxed-gensym-7 3.0+6.0i)
(unboxed-gensym-8 (unsafe-flreal-part unboxed-gensym-7))
(unboxed-gensym-9 (unsafe-flimag-part unboxed-gensym-7))
(unboxed-gensym-10 (unsafe-fl+ unboxed-gensym-5 unboxed-gensym-8))
(unboxed-gensym-11 (unsafe-fl+ unboxed-gensym-6 unboxed-gensym-9))
(unboxed-gensym-12 (unsafe-fl+ unboxed-gensym-2 unboxed-gensym-10))
(unboxed-gensym-13 unboxed-gensym-3))
(unsafe-make-flrectangular unboxed-gensym-12 unboxed-gensym-13))
(let* ((unboxed-gensym-1 1.0+2.0i)
(unboxed-gensym-2 (unsafe-flreal-part unboxed-gensym-1))
(unboxed-gensym-3 (unsafe-flimag-part unboxed-gensym-1))
(unboxed-gensym-4 2.0+4.0i)
(unboxed-gensym-5 (unsafe-flreal-part unboxed-gensym-4))
(unboxed-gensym-6 (unsafe-flimag-part unboxed-gensym-4))
(unboxed-gensym-7 3.0+6.0i)
(unboxed-gensym-8 (unsafe-flreal-part unboxed-gensym-7))
(unboxed-gensym-9 (unsafe-flimag-part unboxed-gensym-7))
(unboxed-gensym-10 (unsafe-fl+ unboxed-gensym-5 unboxed-gensym-8))
(unboxed-gensym-11 (unsafe-fl+ unboxed-gensym-6 unboxed-gensym-9))
(unboxed-gensym-12 (unsafe-fl+ unboxed-gensym-2 unboxed-gensym-11))
(unboxed-gensym-13 unboxed-gensym-3))
(unsafe-make-flrectangular unboxed-gensym-12 unboxed-gensym-13))
(let* ((unboxed-gensym-1 1.0+2.0i)
(unboxed-gensym-2 (unsafe-flreal-part unboxed-gensym-1))
(unboxed-gensym-3 (unsafe-flimag-part unboxed-gensym-1))
(unboxed-gensym-4 2.0+4.0i)
(unboxed-gensym-5 (unsafe-flreal-part unboxed-gensym-4))
(unboxed-gensym-6 (unsafe-flimag-part unboxed-gensym-4))
(unboxed-gensym-7 3.0+6.0i)
(unboxed-gensym-8 (unsafe-flreal-part unboxed-gensym-7))
(unboxed-gensym-9 (unsafe-flimag-part unboxed-gensym-7))
(unboxed-gensym-10 (unsafe-fl+ unboxed-gensym-5 unboxed-gensym-8))
(unboxed-gensym-11 (unsafe-fl+ unboxed-gensym-6 unboxed-gensym-9))
(unboxed-gensym-12 (unsafe-fl+ unboxed-gensym-2 unboxed-gensym-11))
(unboxed-gensym-13 unboxed-gensym-3))
(unsafe-make-flrectangular unboxed-gensym-12 unboxed-gensym-13))

2
collects/tests/typed-scheme/optimizer/hand-optimized/inexact-complex-sin.rkt
View File

@ -1,4 +1,4 @@
#lang typed/scheme #:optimize
#lang typed/scheme
(require racket/unsafe/ops)
((lambda: ((t : Integer))
(let* ((unboxed-gensym-1 (exact->inexact (sin (* t 6.28))))

8
collects/tests/typed-scheme/optimizer/non-optimized/inexact-complex-parts2.rkt Normal file
View File

@ -0,0 +1,8 @@
#lang typed/scheme
(require racket/unsafe/ops)
(real-part (+ 1.0+2.0i 2.0+4.0i))
(unsafe-flreal-part (+ 1.0+2.0i 2.0+4.0i))
(imag-part (+ 1.0+2.0i 2.0+4.0i))
(unsafe-flimag-part (+ 1.0+2.0i 2.0+4.0i))

8
collects/tests/typed-scheme/optimizer/non-optimized/inexact-complex-parts3.rkt Normal file
View File

@ -0,0 +1,8 @@
#lang typed/scheme
(require racket/unsafe/ops)
(+ 1.0+2.0i (real-part (+ 2.0+4.0i 3.0+6.0i)))
(+ 1.0+2.0i (unsafe-flreal-part (+ 2.0+4.0i 3.0+6.0i)))
(+ 1.0+2.0i (imag-part (+ 2.0+4.0i 3.0+6.0i)))
(+ 1.0+2.0i (unsafe-flimag-part (+ 2.0+4.0i 3.0+6.0i)))

107
collects/typed-scheme/optimizer/inexact-complex.rkt
View File

@ -14,6 +14,7 @@
;; we keep the real and imaginary parts unboxed as long as we stay within
;; complex operations
(define-syntax-class unboxed-inexact-complex-opt-expr
(pattern (#%plain-app (~and op (~literal +))
c1:unboxed-inexact-complex-opt-expr
c2:unboxed-inexact-complex-opt-expr
@ -23,20 +24,21 @@
#:with (bindings ...)
(begin (log-optimization "unboxed binary inexact complex" #'op)
#`(#,@(append (syntax->list #'(c1.bindings ... c2.bindings ... cs.bindings ... ...))
(list #`(real-part #,(for/fold ((o #'c1.real-part))
((e (syntax->list #'(c2.real-part cs.real-part ...))))
#`(unsafe-fl+ #,o #,e)))
;; we can skip the imaginary parts of reals (#f)
#`(imag-part
#,(let ((l (filter syntax->datum
(syntax->list #'(c1.imag-part c2.imag-part cs.imag-part ...)))))
(let ()
;; we can skip the real parts of imaginaries (#f) and vice versa
(define (skip-0s l)
(let ((l (filter syntax->datum (syntax->list l))))
(case (length l)
((0) #'0.0)
((1) (car l))
(else
(for/fold ((o (car l)))
((e (cdr l)))
#`(unsafe-fl+ #,o #,e)))))))))))
#`(unsafe-fl+ #,o #,e))))))
(list
#`(real-part #,(skip-0s #'(c1.real-part c2.real-part cs.real-part ...)))
#`(imag-part #,(skip-0s #'(c1.imag-part c2.imag-part cs.imag-part ...)))))))))
(pattern (#%plain-app (~and op (~literal -))
c1:unboxed-inexact-complex-opt-expr
c2:unboxed-inexact-complex-opt-expr
@ -46,13 +48,11 @@
#:with (bindings ...)
(begin (log-optimization "unboxed binary inexact complex" #'op)
#`(#,@(append (syntax->list #'(c1.bindings ... c2.bindings ... cs.bindings ... ...))
(list #`(real-part #,(for/fold ((o #'c1.real-part))
((e (syntax->list #'(c2.real-part cs.real-part ...))))
#`(unsafe-fl- #,o #,e)))
;; unlike addition, we simply can't skip imaginary parts of reals
#`(imag-part
#,(let* ((l1 (map (lambda (x) (if (syntax->datum x) x #'0.0))
(syntax->list #'(c1.imag-part c2.imag-part cs.imag-part ...))))
(let ()
;; unlike addition, we simply can't skip real parts of imaginaries
(define (skip-0s l)
(let* ((l1 (map (lambda (x) (if (syntax->datum x) x #'0.0))
(syntax->list l)))
;; but we can skip all but the first 0
(l2 (filter (lambda (x) (not (equal? (syntax->datum x) 0.0)))
(cdr l1))))
@ -61,7 +61,11 @@
(else
(for/fold ((o (car l1)))
((e l2))
#`(unsafe-fl- #,o #,e)))))))))))
#`(unsafe-fl- #,o #,e))))))
(list
#`(real-part #,(skip-0s #'(c1.real-part c2.real-part cs.real-part ...)))
#`(imag-part #,(skip-0s #'(c1.imag-part c2.imag-part cs.imag-part ...)))))))))
(pattern (#%plain-app (~and op (~literal *))
c1:unboxed-inexact-complex-opt-expr
c2:unboxed-inexact-complex-opt-expr
@ -73,12 +77,14 @@
#`(c1.bindings ... c2.bindings ... cs.bindings ... ...
;; we want to bind the intermediate results to reuse them
;; the final results are bound to real-part and imag-part
#,@(let ((l (map (lambda (x) (if (syntax->datum x) x #'0.0))
#,@(let ((lr (map (lambda (x) (if (syntax->datum x) x #'0.0))
(syntax->list #'(c1.real-part c2.real-part cs.real-part ...))))
(li (map (lambda (x) (if (syntax->datum x) x #'0.0))
(syntax->list #'(c1.imag-part c2.imag-part cs.imag-part ...)))))
(let loop ([o1 #'c1.real-part]
[o2 (car l)]
[e1 (syntax->list #'(c2.real-part cs.real-part ...))]
[e2 (cdr l)]
(let loop ([o1 (car lr)]
[o2 (car li)]
[e1 (cdr lr)]
[e2 (cdr li)]
[rs (append (map (lambda (x) (unboxed-gensym))
(syntax->list #'(cs.real-part ...)))
(list #'real-part))]
@ -107,13 +113,15 @@
#`(unsafe-fl- (unsafe-fl* #,o1 #,(car e1))
(unsafe-fl* #,o2 #,(car e2))))))
res)))))))))
(pattern (#%plain-app (~and op (~literal /))
c1:unboxed-inexact-complex-opt-expr
c2:unboxed-inexact-complex-opt-expr
cs:unboxed-inexact-complex-opt-expr ...)
#:with real-part (unboxed-gensym)
#:with imag-part (unboxed-gensym)
#:with reals (syntax->list #'(c1.real-part c2.real-part cs.real-part ...))
#:with reals (map (lambda (x) (if (syntax->datum x) x #'0.0))
(syntax->list #'(c1.real-part c2.real-part cs.real-part ...)))
#:with imags (map (lambda (x) (if (syntax->datum x) x #'0.0))
(syntax->list #'(c1.imag-part c2.imag-part cs.imag-part ...)))
#:with (bindings ...)
@ -175,6 +183,7 @@
(unsafe-fl+ (unsafe-fl* #,(car e1) #,(car e1))
(unsafe-fl* #,(car e2) #,(car e2))))
res)]))))))))
(pattern (#%plain-app (~and op (~literal conjugate)) c:unboxed-inexact-complex-opt-expr)
#:with real-part #'c.real-part
#:with imag-part (unboxed-gensym)
@ -182,6 +191,32 @@
(begin (log-optimization "unboxed unary inexact complex" #'op)
#`(#,@(append (syntax->list #'(c.bindings ...))
(list #'(imag-part (unsafe-fl- 0.0 c.imag-part)))))))
(pattern (#%plain-app (~and op (~or (~literal real-part) (~literal unsafe-flreal-part)))
c:unboxed-inexact-complex-opt-expr)
#:with real-part #'c.real-part
#:with imag-part #f
#:with (bindings ...)
(begin (log-optimization "unboxed unary inexact complex" #'op)
#'(c.bindings ...)))
(pattern (#%plain-app (~and op (~or (~literal imag-part) (~literal unsafe-flimag-part)))
c:unboxed-inexact-complex-opt-expr)
#:with real-part #'c.imag-part
#:with imag-part #f
#:with (bindings ...)
(begin (log-optimization "unboxed unary inexact complex" #'op)
#'(c.bindings ...)))
;; if we see a variable that's already unboxed, use the unboxed bindings
(pattern v:id
#:with unboxed-real-part (syntax-property #'v 'unboxed-real-part)
#:with unboxed-imag-part (syntax-property #'v 'unboxed-imag-part)
#:when (and (syntax-e #'unboxed-real-part) (syntax-e #'unboxed-imag-part))
#:with real-part #'unboxed-real-part
#:with imag-part #'unboxed-imag-part
#:with (bindings ...) #'())
;; else, do the unboxing here
(pattern e:expr
#:when (isoftype? #'e -InexactComplex)
#:with e* (unboxed-gensym)
@ -223,7 +258,7 @@
(pattern (~or (~literal real-part) (~literal flreal-part)) #:with unsafe #'unsafe-flreal-part)
(pattern (~or (~literal imag-part) (~literal flimag-part)) #:with unsafe #'unsafe-flimag-part))
(define-syntax-class inexact-complex-binary-op
(define-syntax-class inexact-complex-op
(pattern (~or (~literal +) (~literal -) (~literal *) (~literal /) (~literal conjugate))))
(define-syntax-class inexact-complex-expr
@ -232,13 +267,37 @@
#:with opt ((optimize) #'e)))
(define-syntax-class inexact-complex-opt-expr
;; we can optimize taking the real of imag part of an unboxed complex
;; hopefully, the compiler can eliminate unused bindings for the other part if it's not used
(pattern (#%plain-app (~and op (~or (~literal real-part) (~literal unsafe-flreal-part)
(~literal imag-part) (~literal unsafe-flimag-part)))
c:inexact-complex-expr)
#:with c*:inexact-complex-arith-opt-expr #'c
#:with opt
(begin (log-optimization "unboxed inexact complex" #'op)
(reset-unboxed-gensym)
#`(let* (c*.bindings ...)
#,(if (or (free-identifier=? #'op #'real-part)
(free-identifier=? #'op #'unsafe-flreal-part))
#'c*.real-part
#'c*.imag-part))))
(pattern (#%plain-app op:inexact-complex-unary-op n:inexact-complex-expr)
#:with opt
(begin (log-optimization "unary inexact complex" #'op)
#'(op.unsafe n.opt)))
(pattern (~and exp (#%plain-app op:inexact-complex-binary-op e:expr ...))
(pattern e:inexact-complex-arith-opt-expr
#:with opt
#'e.opt))
(define-syntax-class inexact-complex-arith-opt-expr
(pattern (~and exp (#%plain-app op:inexact-complex-op e:expr ...))
#:when (isoftype? #'exp -InexactComplex)
#:with exp*:unboxed-inexact-complex-opt-expr #'exp
#:with real-part #'exp*.real-part
#:with imag-part #'exp*.imag-part
#:with (bindings ...) #'(exp*.bindings ...)
#:with opt
(begin (log-optimization "unboxed inexact complex" #'exp)
(reset-unboxed-gensym)