From 9e3912d3906fa4213660cbf99255e7742b11c49b 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. original commit: 3fb69bc764885f2e6ef25134da747caa32b80f05 --- .../optimizer/generic/n-ary-float.rkt | 3 ++ collects/typed-scheme/private/optimize.rkt | 52 ++++++++++++++++++- 2 files changed, 53 insertions(+), 2 deletions(-) create mode 100644 collects/tests/typed-scheme/optimizer/generic/n-ary-float.rkt 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 00000000..54b59581 --- /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/typed-scheme/private/optimize.rkt b/collects/typed-scheme/private/optimize.rkt index 0cd2c8ae..2a80da4e 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)