From 3fb69bc764885f2e6ef25134da747caa32b80f05 Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Tue, 6 Jul 2010 17:26:33 -0400 Subject: [PATCH] Generic inexact complex arithmetic operations are now replaced with the right combinations of unsafe float operations. --- .../optimizer/generic/inexact-complex-div.rkt | 3 ++ .../generic/inexact-complex-mult.rkt | 3 ++ .../optimizer/generic/inexact-complex.rkt | 4 ++ .../optimizer/generic/n-ary-float.rkt | 3 ++ .../generic/n-ary-inexact-complex.rkt | 3 ++ .../hand-optimized/inexact-complex-div.rkt | 23 ++++++++ .../hand-optimized/inexact-complex-mult.rkt | 23 ++++++++ .../hand-optimized/inexact-complex.rkt | 16 ++++++ .../optimizer/hand-optimized/n-ary-float.rkt | 3 ++ .../hand-optimized/n-ary-inexact-complex.rkt | 15 ++++++ collects/typed-scheme/private/optimize.rkt | 52 ++++++++++++++++++- 11 files changed, 146 insertions(+), 2 deletions(-) create mode 100644 collects/tests/typed-scheme/optimizer/generic/inexact-complex-div.rkt create mode 100644 collects/tests/typed-scheme/optimizer/generic/inexact-complex-mult.rkt create mode 100644 collects/tests/typed-scheme/optimizer/generic/inexact-complex.rkt create mode 100644 collects/tests/typed-scheme/optimizer/generic/n-ary-float.rkt create mode 100644 collects/tests/typed-scheme/optimizer/generic/n-ary-inexact-complex.rkt create mode 100644 collects/tests/typed-scheme/optimizer/hand-optimized/inexact-complex-div.rkt create mode 100644 collects/tests/typed-scheme/optimizer/hand-optimized/inexact-complex-mult.rkt create mode 100644 collects/tests/typed-scheme/optimizer/hand-optimized/inexact-complex.rkt create mode 100644 collects/tests/typed-scheme/optimizer/hand-optimized/n-ary-float.rkt create mode 100644 collects/tests/typed-scheme/optimizer/hand-optimized/n-ary-inexact-complex.rkt diff --git a/collects/tests/typed-scheme/optimizer/generic/inexact-complex-div.rkt b/collects/tests/typed-scheme/optimizer/generic/inexact-complex-div.rkt new file mode 100644 index 0000000000..dcdf6d5754 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/inexact-complex-div.rkt @@ -0,0 +1,3 @@ +(module inexact-complex-div typed/scheme #:optimize + (require racket/unsafe/ops) + (/ 1.0+2.0i 2.0+4.0i 3.0+6.0i)) diff --git a/collects/tests/typed-scheme/optimizer/generic/inexact-complex-mult.rkt b/collects/tests/typed-scheme/optimizer/generic/inexact-complex-mult.rkt new file mode 100644 index 0000000000..b47c9410bb --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/inexact-complex-mult.rkt @@ -0,0 +1,3 @@ +(module inexact-complex-mult typed/scheme #:optimize + (require racket/unsafe/ops) + (* 1.0+2.0i 2.0+4.0i 3.0+6.0i)) diff --git a/collects/tests/typed-scheme/optimizer/generic/inexact-complex.rkt b/collects/tests/typed-scheme/optimizer/generic/inexact-complex.rkt new file mode 100644 index 0000000000..f2e40d767a --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/inexact-complex.rkt @@ -0,0 +1,4 @@ +(module inexact-complex typed/scheme #:optimize + (require racket/unsafe/ops) + (+ 1.0+2.0i 2.0+4.0i) + (- 1.0+2.0i 2.0+4.0i)) diff --git a/collects/tests/typed-scheme/optimizer/generic/n-ary-float.rkt b/collects/tests/typed-scheme/optimizer/generic/n-ary-float.rkt new file mode 100644 index 0000000000..54b5958127 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/n-ary-float.rkt @@ -0,0 +1,3 @@ +(module n-ary-float typed/scheme #:optimize + (require racket/unsafe/ops) + (+ 1.0 2.0 3.0)) diff --git a/collects/tests/typed-scheme/optimizer/generic/n-ary-inexact-complex.rkt b/collects/tests/typed-scheme/optimizer/generic/n-ary-inexact-complex.rkt new file mode 100644 index 0000000000..77c5d033d5 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/n-ary-inexact-complex.rkt @@ -0,0 +1,3 @@ +(module n-ary-inexact-complex typed/scheme #:optimize + (require racket/unsafe/ops) + (+ 1.0+2.0i 2.0+4.0i 3.0+6.0i)) diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/inexact-complex-div.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/inexact-complex-div.rkt new file mode 100644 index 0000000000..c09a4cf26d --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/inexact-complex-div.rkt @@ -0,0 +1,23 @@ +(module inexact-complex-div typed/scheme #:optimize + (require racket/unsafe/ops) + (let ((t1 (let ((t1 1.0+2.0i) + (t2 2.0+4.0i)) + (let ((a (unsafe-flreal-part t1)) + (b (unsafe-flimag-part t1)) + (c (unsafe-flreal-part t2)) + (d (unsafe-flimag-part t2))) + (unsafe-make-flrectangular + (unsafe-fl/ (unsafe-fl+ (unsafe-fl* a c) (unsafe-fl* b d)) + (unsafe-fl+ (unsafe-fl* c c) (unsafe-fl* d d))) + (unsafe-fl/ (unsafe-fl- (unsafe-fl* b c) (unsafe-fl* a d)) + (unsafe-fl+ (unsafe-fl* c c) (unsafe-fl* d d))))))) + (t2 3.0+6.0i)) + (let ((a (unsafe-flreal-part t1)) + (b (unsafe-flimag-part t1)) + (c (unsafe-flreal-part t2)) + (d (unsafe-flimag-part t2))) + (unsafe-make-flrectangular + (unsafe-fl/ (unsafe-fl+ (unsafe-fl* a c) (unsafe-fl* b d)) + (unsafe-fl+ (unsafe-fl* c c) (unsafe-fl* d d))) + (unsafe-fl/ (unsafe-fl- (unsafe-fl* b c) (unsafe-fl* a d)) + (unsafe-fl+ (unsafe-fl* c c) (unsafe-fl* d d))))))) diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/inexact-complex-mult.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/inexact-complex-mult.rkt new file mode 100644 index 0000000000..70726ba8f1 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/inexact-complex-mult.rkt @@ -0,0 +1,23 @@ +(module inexact-complex-mult typed/scheme #:optimize + (require racket/unsafe/ops) + (let ((t1 (let ((t1 1.0+2.0i) + (t2 2.0+4.0i)) + (let ((a (unsafe-flreal-part t1)) + (b (unsafe-flimag-part t1)) + (c (unsafe-flreal-part t2)) + (d (unsafe-flimag-part t2))) + (unsafe-make-flrectangular + (unsafe-fl- (unsafe-fl* a c) + (unsafe-fl* b d)) + (unsafe-fl+ (unsafe-fl* b c) + (unsafe-fl* a d)))))) + (t2 3.0+6.0i)) + (let ((a (unsafe-flreal-part t1)) + (b (unsafe-flimag-part t1)) + (c (unsafe-flreal-part t2)) + (d (unsafe-flimag-part t2))) + (unsafe-make-flrectangular + (unsafe-fl- (unsafe-fl* a c) + (unsafe-fl* b d)) + (unsafe-fl+ (unsafe-fl* b c) + (unsafe-fl* a d)))))) diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/inexact-complex.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/inexact-complex.rkt new file mode 100644 index 0000000000..b68f81f9f1 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/inexact-complex.rkt @@ -0,0 +1,16 @@ +(module inexact-complex typed/scheme #:optimize + (require racket/unsafe/ops) + (let ((t1 1.0+2.0i) + (t2 2.0+4.0i)) + (unsafe-make-flrectangular + (unsafe-fl+ (unsafe-flreal-part t1) + (unsafe-flreal-part t2)) + (unsafe-fl+ (unsafe-flimag-part t1) + (unsafe-flimag-part t2)))) + (let ((t1 1.0+2.0i) + (t2 2.0+4.0i)) + (unsafe-make-flrectangular + (unsafe-fl- (unsafe-flreal-part t1) + (unsafe-flreal-part t2)) + (unsafe-fl- (unsafe-flimag-part t1) + (unsafe-flimag-part t2))))) diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/n-ary-float.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/n-ary-float.rkt new file mode 100644 index 0000000000..96ce4f115a --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/n-ary-float.rkt @@ -0,0 +1,3 @@ +(module n-ary-float typed/scheme #:optimize + (require racket/unsafe/ops) + (unsafe-fl+ (unsafe-fl+ 1.0 2.0) 3.0)) diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/n-ary-inexact-complex.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/n-ary-inexact-complex.rkt new file mode 100644 index 0000000000..536cdac454 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/n-ary-inexact-complex.rkt @@ -0,0 +1,15 @@ +(module n-ary-inexact-complex typed/scheme #:optimize + (require racket/unsafe/ops) + (let ((t1 (let ((t1 1.0+2.0i) + (t2 2.0+4.0i)) + (unsafe-make-flrectangular + (unsafe-fl+ (unsafe-flreal-part t1) + (unsafe-flreal-part t2)) + (unsafe-fl+ (unsafe-flimag-part t1) + (unsafe-flimag-part t2))))) + (t2 3.0+6.0i)) + (unsafe-make-flrectangular + (unsafe-fl+ (unsafe-flreal-part t1) + (unsafe-flreal-part t2)) + (unsafe-fl+ (unsafe-flimag-part t1) + (unsafe-flimag-part t2))))) diff --git a/collects/typed-scheme/private/optimize.rkt b/collects/typed-scheme/private/optimize.rkt index 0cd2c8ae8d..2a80da4eba 100644 --- a/collects/typed-scheme/private/optimize.rkt +++ b/collects/typed-scheme/private/optimize.rkt @@ -71,7 +71,8 @@ (define-syntax-class inexact-complex-unary-op (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 binary-inexact-complex-ops + (mk-float-tbl (list #'+ #'- #'* #'/))) (define-syntax-class fixnum-opt-expr (pattern e:opt-expr @@ -210,7 +211,54 @@ #:with opt (begin (log-optimization "unary inexact complex" #'op) #'(op.unsafe n.opt))) - + ;; it's faster to take apart a complex number and use unsafe operations on + ;; its parts than it is to use generic operations + (pattern (#%plain-app (~and (~var op (float-op binary-inexact-complex-ops)) (~or (~literal +) (~literal -))) + c1:inexact-complex-opt-expr c2:inexact-complex-opt-expr cs:inexact-complex-opt-expr ...) + #:with opt + (begin (log-optimization "binary inexact complex" #'op) + (for/fold ([o #'c1.opt]) + ([e (syntax->list #'(c2.opt cs.opt ...))]) + #`(let ((t1 #,o) + (t2 #,e)) + (unsafe-make-flrectangular + (op.unsafe (unsafe-flreal-part t1) + (unsafe-flreal-part t2)) + (op.unsafe (unsafe-flimag-part t1) + (unsafe-flimag-part t2))))))) + (pattern (#%plain-app (~and op (~literal *)) c1:inexact-complex-opt-expr c2:inexact-complex-opt-expr cs:inexact-complex-opt-expr ...) + #:with opt + (begin (log-optimization "binary inexact complex" #'op) + (for/fold ([o #'c1.opt]) + ([e (syntax->list #'(c2.opt cs.opt ...))]) + #`(let ((t1 #,o) + (t2 #,e)) + (let ((a (unsafe-flreal-part t1)) + (b (unsafe-flimag-part t1)) + (c (unsafe-flreal-part t2)) + (d (unsafe-flimag-part t2))) + (unsafe-make-flrectangular + (unsafe-fl- (unsafe-fl* a c) + (unsafe-fl* b d)) + (unsafe-fl+ (unsafe-fl* b c) + (unsafe-fl* a d)))))))) + (pattern (#%plain-app (~and op (~literal /)) c1:inexact-complex-opt-expr c2:inexact-complex-opt-expr cs:inexact-complex-opt-expr ...) + #:with opt + (begin (log-optimization "binary inexact complex" #'op) + (for/fold ([o #'c1.opt]) + ([e (syntax->list #'(c2.opt cs.opt ...))]) + #`(let ((t1 #,o) + (t2 #,e)) + (let ((a (unsafe-flreal-part t1)) + (b (unsafe-flimag-part t1)) + (c (unsafe-flreal-part t2)) + (d (unsafe-flimag-part t2))) + (unsafe-make-flrectangular + (unsafe-fl/ (unsafe-fl+ (unsafe-fl* a c) (unsafe-fl* b d)) + (unsafe-fl+ (unsafe-fl* c c) (unsafe-fl* d d))) + (unsafe-fl/ (unsafe-fl- (unsafe-fl* b c) (unsafe-fl* a d)) + (unsafe-fl+ (unsafe-fl* c c) (unsafe-fl* d d))))))))) + (pattern (#%plain-app (~and op (~literal exact->inexact)) n:fixnum-opt-expr) #:with opt (begin (log-optimization "fixnum to float" #'op)