From 60959467cf68e3e7e7ec096c038e5e7aa42942cb Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Thu, 14 Feb 2013 17:19:58 -0500 Subject: [PATCH] Fix optimization of unary complex - and /. --- .../typed-racket/optimizer/tests/pr13468.rkt | 147 ++++++++++++++++++ .../tests/typed-racket/succeed/pr13468.rkt | 65 -------- .../typed-racket/optimizer/float-complex.rkt | 40 +++++ 3 files changed, 187 insertions(+), 65 deletions(-) create mode 100644 collects/tests/typed-racket/optimizer/tests/pr13468.rkt delete mode 100644 collects/tests/typed-racket/succeed/pr13468.rkt diff --git a/collects/tests/typed-racket/optimizer/tests/pr13468.rkt b/collects/tests/typed-racket/optimizer/tests/pr13468.rkt new file mode 100644 index 0000000000..67f0e2d6d9 --- /dev/null +++ b/collects/tests/typed-racket/optimizer/tests/pr13468.rkt @@ -0,0 +1,147 @@ +#; +( +TR opt: pr13468.rkt 86:13 6.0+2.3i -- unboxed literal +TR opt: pr13468.rkt 86:13 6.0+2.3i -- unboxed literal +TR opt: pr13468.rkt 86:5 (- (ann 6.0+2.3i Float-Complex)) -- unboxed unary float complex +TR opt: pr13468.rkt 87:13 6.0+2.3i -- unboxed literal +TR opt: pr13468.rkt 87:13 6.0+2.3i -- unboxed literal +TR opt: pr13468.rkt 87:5 (/ (ann 6.0+2.3i Float-Complex)) -- unboxed unary float complex +TR opt: pr13468.rkt 88:13 0.0+0.0i -- unboxed literal +TR opt: pr13468.rkt 88:42 1 -- float-arg-expr in complex ops +TR opt: pr13468.rkt 88:5 (/ (ann 0.0+0.0i Float-Complex) (ann 1 Number)) -- unboxed binary float complex +TR missed opt: pr13468.rkt 91:5 (expt (ann -5.0 Flonum) (ann 2.0 Flonum)) -- unexpected complex type +TR opt: pr13468.rkt 112:21 0.0 -- float-arg-expr in complex ops +TR opt: pr13468.rkt 112:5 (magnitude (ann 0.0 Flonum-Zero)) -- unboxed unary float complex +TR opt: pr13468.rkt 113:21 6.0 -- float-arg-expr in complex ops +TR opt: pr13468.rkt 113:5 (magnitude (ann 6.0 Positive-Flonum)) -- unboxed unary float complex +TR opt: pr13468.rkt 114:21 6.0 -- float-arg-expr in complex ops +TR opt: pr13468.rkt 114:5 (magnitude (ann 6.0 Nonnegative-Flonum)) -- unboxed unary float complex +TR opt: pr13468.rkt 115:21 -6.0 -- float-arg-expr in complex ops +TR opt: pr13468.rkt 115:5 (magnitude (ann -6.0 Nonpositive-Flonum)) -- unboxed unary float complex +TR opt: pr13468.rkt 116:21 -6.0 -- float-arg-expr in complex ops +TR opt: pr13468.rkt 116:5 (magnitude (ann -6.0 Negative-Flonum)) -- unboxed unary float complex +TR opt: pr13468.rkt 117:21 6.0 -- float-arg-expr in complex ops +TR opt: pr13468.rkt 117:5 (magnitude (ann 6.0 Flonum)) -- unboxed unary float complex +TR opt: pr13468.rkt 138:21 0.0 -- float-arg-expr in complex ops +TR opt: pr13468.rkt 138:5 (real-part (ann 0.0 Flonum-Zero)) -- unboxed unary float complex +TR opt: pr13468.rkt 139:21 6.0 -- float-arg-expr in complex ops +TR opt: pr13468.rkt 139:5 (real-part (ann 6.0 Positive-Flonum)) -- unboxed unary float complex +TR opt: pr13468.rkt 140:21 6.0 -- float-arg-expr in complex ops +TR opt: pr13468.rkt 140:5 (real-part (ann 6.0 Nonnegative-Flonum)) -- unboxed unary float complex +TR opt: pr13468.rkt 141:21 -6.0 -- float-arg-expr in complex ops +TR opt: pr13468.rkt 141:5 (real-part (ann -6.0 Nonpositive-Flonum)) -- unboxed unary float complex +TR opt: pr13468.rkt 142:21 -6.0 -- float-arg-expr in complex ops +TR opt: pr13468.rkt 142:5 (real-part (ann -6.0 Negative-Flonum)) -- unboxed unary float complex +TR opt: pr13468.rkt 143:21 6.0 -- float-arg-expr in complex ops +TR opt: pr13468.rkt 143:5 (real-part (ann 6.0 Flonum)) -- unboxed unary float complex +-6.0-2.3i +0.1453136352627755-0.05570356018406394i +0.0+0.0i +25.0 +0 +1 +6 +6 +6 +6 +6 +6 +6 +6 +6 +6 +6 +6 +0.0 +6.0 +6.0 +6.0 +6.0 +6.0 +0 +1 +6 +6 +6 +6 +-6 +-6 +6 +6 +6 +-6 +-6 +6 +0.0 +6.0 +6.0 +-6.0 +-6.0 +6.0 +0) + +#lang typed/racket + +;; Most bothersome missing cases: +(ann (- (ann 6.0+2.3i Float-Complex)) Float-Complex) +(ann (/ (ann 6.0+2.3i Float-Complex)) Float-Complex) +(ann (/ (ann 0.0+0.0i Float-Complex) (ann 1+0i Number)) Float-Complex) + +;; Would be nice to maintain flonum-ness here: +(ann (expt (ann -5.0 Flonum) (ann 2.0 Flonum)) (U Flonum Float-Complex)) + +;; In general, for real numbers, `magnitude' should have the same cases as `abs' + +(ann (magnitude (ann 0 Zero)) Zero) +(ann (magnitude (ann 1 One)) One) +(ann (magnitude (ann 6 Byte)) Byte) +(ann (magnitude (ann 6 Index)) Index) + +(ann (magnitude (ann 6 Positive-Fixnum)) Positive-Fixnum) +(ann (magnitude (ann 6 Nonnegative-Fixnum)) Nonnegative-Fixnum) +(ann (magnitude (ann -6 Nonpositive-Fixnum)) Nonnegative-Integer) +(ann (magnitude (ann -6 Negative-Fixnum)) Positive-Integer) +(ann (magnitude (ann 6 Fixnum)) Integer) + +(ann (magnitude (ann 6 Positive-Integer)) Positive-Integer) +(ann (magnitude (ann 6 Nonnegative-Integer)) Nonnegative-Integer) +(ann (magnitude (ann -6 Nonpositive-Integer)) Nonnegative-Integer) +(ann (magnitude (ann -6 Negative-Integer)) Positive-Integer) +(ann (magnitude (ann 6 Integer)) Integer) + +(ann (magnitude (ann 0.0 Flonum-Zero)) Flonum-Zero) +(ann (magnitude (ann 6.0 Positive-Flonum)) Positive-Flonum) +(ann (magnitude (ann 6.0 Nonnegative-Flonum)) Nonnegative-Flonum) +(ann (magnitude (ann -6.0 Nonpositive-Flonum)) Nonnegative-Flonum) +(ann (magnitude (ann -6.0 Negative-Flonum)) Positive-Flonum) +(ann (magnitude (ann 6.0 Flonum)) Flonum) + +;; In general, for real numbers, `real-part' should return the same type + +(ann (real-part (ann 0 Zero)) Zero) +(ann (real-part (ann 1 One)) One) +(ann (real-part (ann 6 Byte)) Byte) +(ann (real-part (ann 6 Index)) Index) + +(ann (real-part (ann 6 Positive-Fixnum)) Positive-Fixnum) +(ann (real-part (ann 6 Nonnegative-Fixnum)) Nonnegative-Fixnum) +(ann (real-part (ann -6 Nonpositive-Fixnum)) Nonpositive-Fixnum) +(ann (real-part (ann -6 Negative-Fixnum)) Negative-Fixnum) +(ann (real-part (ann 6 Fixnum)) Fixnum) + +(ann (real-part (ann 6 Positive-Integer)) Positive-Integer) +(ann (real-part (ann 6 Nonnegative-Integer)) Nonnegative-Integer) +(ann (real-part (ann -6 Nonpositive-Integer)) Nonpositive-Integer) +(ann (real-part (ann -6 Negative-Integer)) Negative-Integer) +(ann (real-part (ann 6 Integer)) Integer) + +(ann (real-part (ann 0.0 Flonum-Zero)) Flonum-Zero) +(ann (real-part (ann 6.0 Positive-Flonum)) Positive-Flonum) +(ann (real-part (ann 6.0 Nonnegative-Flonum)) Nonnegative-Flonum) +(ann (real-part (ann -6.0 Nonpositive-Flonum)) Nonpositive-Flonum) +(ann (real-part (ann -6.0 Negative-Flonum)) Negative-Flonum) +(ann (real-part (ann 6.0 Flonum)) Flonum) + +;; This one surprised me with the exactness of its return value, but it seems +;; to be true: +(ann (imag-part (ann 5.6 Real)) Zero) diff --git a/collects/tests/typed-racket/succeed/pr13468.rkt b/collects/tests/typed-racket/succeed/pr13468.rkt deleted file mode 100644 index 49176280c3..0000000000 --- a/collects/tests/typed-racket/succeed/pr13468.rkt +++ /dev/null @@ -1,65 +0,0 @@ -#lang typed/racket - -;; Most bothersome missing cases: -(ann (- (ann 6.0+2.3i Float-Complex)) Float-Complex) -(ann (/ (ann 6.0+2.3i Float-Complex)) Float-Complex) -(ann (/ (ann 0.0+0.0i Float-Complex) (ann 1+0i Number)) Float-Complex) - -;; Would be nice to maintain flonum-ness here: -(ann (expt (ann -5.0 Flonum) (ann 2.0 Flonum)) (U Flonum Float-Complex)) - -;; In general, for real numbers, `magnitude' should have the same cases as `abs' - -(ann (magnitude (ann 0 Zero)) Zero) -(ann (magnitude (ann 1 One)) One) -(ann (magnitude (ann 6 Byte)) Byte) -(ann (magnitude (ann 6 Index)) Index) - -(ann (magnitude (ann 6 Positive-Fixnum)) Positive-Fixnum) -(ann (magnitude (ann 6 Nonnegative-Fixnum)) Nonnegative-Fixnum) -(ann (magnitude (ann -6 Nonpositive-Fixnum)) Nonnegative-Integer) -(ann (magnitude (ann -6 Negative-Fixnum)) Positive-Integer) -(ann (magnitude (ann 6 Fixnum)) Integer) - -(ann (magnitude (ann 6 Positive-Integer)) Positive-Integer) -(ann (magnitude (ann 6 Nonnegative-Integer)) Nonnegative-Integer) -(ann (magnitude (ann -6 Nonpositive-Integer)) Nonnegative-Integer) -(ann (magnitude (ann -6 Negative-Integer)) Positive-Integer) -(ann (magnitude (ann 6 Integer)) Integer) - -(ann (magnitude (ann 0.0 Flonum-Zero)) Flonum-Zero) -(ann (magnitude (ann 6.0 Positive-Flonum)) Positive-Flonum) -(ann (magnitude (ann 6.0 Nonnegative-Flonum)) Nonnegative-Flonum) -(ann (magnitude (ann -6.0 Nonpositive-Flonum)) Nonnegative-Flonum) -(ann (magnitude (ann -6.0 Negative-Flonum)) Positive-Flonum) -(ann (magnitude (ann 6.0 Flonum)) Flonum) - -;; In general, for real numbers, `real-part' should return the same type - -(ann (real-part (ann 0 Zero)) Zero) -(ann (real-part (ann 1 One)) One) -(ann (real-part (ann 6 Byte)) Byte) -(ann (real-part (ann 6 Index)) Index) - -(ann (real-part (ann 6 Positive-Fixnum)) Positive-Fixnum) -(ann (real-part (ann 6 Nonnegative-Fixnum)) Nonnegative-Fixnum) -(ann (real-part (ann -6 Nonpositive-Fixnum)) Nonpositive-Fixnum) -(ann (real-part (ann -6 Negative-Fixnum)) Negative-Fixnum) -(ann (real-part (ann 6 Fixnum)) Fixnum) - -(ann (real-part (ann 6 Positive-Integer)) Positive-Integer) -(ann (real-part (ann 6 Nonnegative-Integer)) Nonnegative-Integer) -(ann (real-part (ann -6 Nonpositive-Integer)) Nonpositive-Integer) -(ann (real-part (ann -6 Negative-Integer)) Negative-Integer) -(ann (real-part (ann 6 Integer)) Integer) - -(ann (real-part (ann 0.0 Flonum-Zero)) Flonum-Zero) -(ann (real-part (ann 6.0 Positive-Flonum)) Positive-Flonum) -(ann (real-part (ann 6.0 Nonnegative-Flonum)) Nonnegative-Flonum) -(ann (real-part (ann -6.0 Nonpositive-Flonum)) Nonpositive-Flonum) -(ann (real-part (ann -6.0 Negative-Flonum)) Negative-Flonum) -(ann (real-part (ann 6.0 Flonum)) Flonum) - -;; This one surprised me with the exactness of its return value, but it seems -;; to be true: -(ann (imag-part (ann 5.6 Real)) Zero) diff --git a/collects/typed-racket/optimizer/float-complex.rkt b/collects/typed-racket/optimizer/float-complex.rkt index 425ed461a9..37c6ceb0fd 100644 --- a/collects/typed-racket/optimizer/float-complex.rkt +++ b/collects/typed-racket/optimizer/float-complex.rkt @@ -99,6 +99,18 @@ (list #`((real-binding) #,(skip-0s #'(c1.real-binding c2.real-binding cs.real-binding ...))) #`((imag-binding) #,(skip-0s #'(c1.imag-binding c2.imag-binding cs.imag-binding ...))))))))) + (pattern (#%plain-app (~and op (~literal -)) c1:unboxed-float-complex-opt-expr) ; unary - + #:when (subtypeof? this-syntax -FloatComplex) + #:with real-binding (unboxed-gensym "unboxed-real-") + #:with imag-binding (unboxed-gensym "unboxed-imag-") + #:with (bindings ...) + (begin (log-optimization "unboxed unary float complex" + complex-unboxing-opt-msg + this-syntax) + (add-disappeared-use #'op) + #`(c1.bindings ... + [(real-binding) (unsafe-fl- 0.0 #,(get-part-or-0.0 #'c1.real-binding))] + [(imag-binding) (unsafe-fl- 0.0 #,(get-part-or-0.0 #'c1.imag-binding))]))) (pattern (#%plain-app (~and op (~literal *)) c1:unboxed-float-complex-opt-expr @@ -225,6 +237,34 @@ (unsafe-fl+ (unsafe-fl* #,(car e1) #,(car e1)) (unsafe-fl* #,(car e2) #,(car e2)))) res)])))))))) + (pattern (#%plain-app (~and op (~literal /)) c1:unboxed-float-complex-opt-expr) ; unary / + #:when (subtypeof? this-syntax -FloatComplex) + #:with real-binding (unboxed-gensym "unboxed-real-") + #:with imag-binding (unboxed-gensym "unboxed-imag-") + #:with (bindings ...) + (begin (log-optimization "unboxed unary float complex" + complex-unboxing-opt-msg + this-syntax) + (add-disappeared-use #'op) + ;; (/ 1.0+0.0i c1) + ;; = (+ (/ (+ (* 1.0 c1.real) (* 0.0 c1.imag)) (+ c1.real^2 c1.imag^2)) + ;; (/ (- (* 0.0 c1.real) (* 1.0 c1.imag)) (+ c1.real^2 c1.imag^2))*i) + ;; = (+ (/ c1.real (+ c1.real^2 c1.imag^2)) + ;; (/ (- 0.0 c1.imag) (+ c1.real^2 c1.imag^2))*i) + (with-syntax ([denominator-binding (unboxed-gensym)]) + #`(c1.bindings ... + [(denominator-binding) + #,(cond [(not (syntax->datum #'c1.imag-binding)) ; only real part + #'(unsafe-fl* c1.real-binding c1.real-binding)] + [(not (syntax->datum #'c1.real-binding)) ; only imag part + #'(unsafe-fl* c1.imag-binding c1.imag-binding)] + [else ; both parts + #'(unsafe-fl+ (unsafe-fl* c1.real-binding c1.real-binding) + (unsafe-fl* c1.imag-binding c1.imag-binding))])] + [(real-binding) (unsafe-fl/ #,(get-part-or-0.0 #'c1.real-binding) + denominator-binding)] + [(imag-binding) (unsafe-fl/ (unsafe-fl- 0.0 #,(get-part-or-0.0 #'c1.imag-binding)) + denominator-binding)])))) (pattern (#%plain-app (~and op (~literal conjugate)) c:unboxed-float-complex-opt-expr) #:when (subtypeof? this-syntax -FloatComplex)