From 389a20795a5bb6db25341b899e7ec58e6eb5a0d1 Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Fri, 2 Jul 2010 20:57:09 -0400 Subject: [PATCH] Added support for make-flrectangular, flreal-part, flimag-part and their unsafe counterparts to Typed Scheme and its optimizer. --- .../generic/inexact-complex-parts.rkt | 5 ++++ .../generic/invalid-inexact-complex-parts.rkt | 2 ++ .../generic/invalid-make-flrectangular.rkt | 2 ++ .../optimizer/generic/make-flrectangular.rkt | 4 +++ .../hand-optimized/inexact-complex-parts.rkt | 5 ++++ .../invalid-inexact-complex-parts.rkt | 2 ++ .../invalid-make-flrectangular.rkt | 2 ++ .../hand-optimized/make-flrectangular.rkt | 4 +++ .../typed-scheme/private/base-env-numeric.rkt | 6 ++++ collects/typed-scheme/private/optimize.rkt | 28 +++++++++++++++++-- 10 files changed, 57 insertions(+), 3 deletions(-) create mode 100644 collects/tests/typed-scheme/optimizer/generic/inexact-complex-parts.rkt create mode 100644 collects/tests/typed-scheme/optimizer/generic/invalid-inexact-complex-parts.rkt create mode 100644 collects/tests/typed-scheme/optimizer/generic/invalid-make-flrectangular.rkt create mode 100644 collects/tests/typed-scheme/optimizer/generic/make-flrectangular.rkt create mode 100644 collects/tests/typed-scheme/optimizer/hand-optimized/inexact-complex-parts.rkt create mode 100644 collects/tests/typed-scheme/optimizer/hand-optimized/invalid-inexact-complex-parts.rkt create mode 100644 collects/tests/typed-scheme/optimizer/hand-optimized/invalid-make-flrectangular.rkt create mode 100644 collects/tests/typed-scheme/optimizer/hand-optimized/make-flrectangular.rkt diff --git a/collects/tests/typed-scheme/optimizer/generic/inexact-complex-parts.rkt b/collects/tests/typed-scheme/optimizer/generic/inexact-complex-parts.rkt new file mode 100644 index 0000000000..b07f7efafe --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/inexact-complex-parts.rkt @@ -0,0 +1,5 @@ +(module inexact-complex-parts typed/scheme #:optimize + (require racket/unsafe/ops) + (real-part 1.0+2.0i) + (imag-part 1+2.0i) + (real-part 1.0+2i)) diff --git a/collects/tests/typed-scheme/optimizer/generic/invalid-inexact-complex-parts.rkt b/collects/tests/typed-scheme/optimizer/generic/invalid-inexact-complex-parts.rkt new file mode 100644 index 0000000000..b0a2ab9d83 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/invalid-inexact-complex-parts.rkt @@ -0,0 +1,2 @@ +(module invalid-inexact-complex-parts.rkt typed/scheme #:optimize + (real-part 1+2i)) diff --git a/collects/tests/typed-scheme/optimizer/generic/invalid-make-flrectangular.rkt b/collects/tests/typed-scheme/optimizer/generic/invalid-make-flrectangular.rkt new file mode 100644 index 0000000000..ce1661517c --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/invalid-make-flrectangular.rkt @@ -0,0 +1,2 @@ +(module invalid-make-flrectangular typed/scheme #:optimize + (make-rectangular 1 2)) diff --git a/collects/tests/typed-scheme/optimizer/generic/make-flrectangular.rkt b/collects/tests/typed-scheme/optimizer/generic/make-flrectangular.rkt new file mode 100644 index 0000000000..b9250d0ea6 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/make-flrectangular.rkt @@ -0,0 +1,4 @@ +(module make-flrectangular typed/scheme #:optimize + (require racket/unsafe/ops racket/flonum) + (make-rectangular 1.0 2.2) + (make-flrectangular 1.0 2.2)) diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/inexact-complex-parts.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/inexact-complex-parts.rkt new file mode 100644 index 0000000000..23e8c42545 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/inexact-complex-parts.rkt @@ -0,0 +1,5 @@ +(module inexact-complex-parts typed/scheme #:optimize + (require racket/unsafe/ops) + (unsafe-flreal-part 1.0+2.0i) + (unsafe-flimag-part 1+2.0i) + (unsafe-flreal-part 1.0+2i)) diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/invalid-inexact-complex-parts.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/invalid-inexact-complex-parts.rkt new file mode 100644 index 0000000000..6099201f0b --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/invalid-inexact-complex-parts.rkt @@ -0,0 +1,2 @@ +(module invalid-inexact-complex-parts.rkt typed/scheme + (real-part 1+2i)) diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/invalid-make-flrectangular.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/invalid-make-flrectangular.rkt new file mode 100644 index 0000000000..5288f6f88b --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/invalid-make-flrectangular.rkt @@ -0,0 +1,2 @@ +(module invalid-make-flrectangular typed/scheme + (make-rectangular 1 2)) diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/make-flrectangular.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/make-flrectangular.rkt new file mode 100644 index 0000000000..0f82412f91 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/make-flrectangular.rkt @@ -0,0 +1,4 @@ +(module make-flrectangular typed/scheme #:optimize + (require racket/unsafe/ops racket/flonum) + (unsafe-make-flrectangular 1.0 2.2) + (unsafe-make-flrectangular 1.0 2.2)) diff --git a/collects/typed-scheme/private/base-env-numeric.rkt b/collects/typed-scheme/private/base-env-numeric.rkt index e42c0b77ae..fe546c3853 100644 --- a/collects/typed-scheme/private/base-env-numeric.rkt +++ b/collects/typed-scheme/private/base-env-numeric.rkt @@ -468,6 +468,9 @@ [unsafe-flexp fl-rounder] [unsafe-flsqrt fl-rounder] [unsafe-fx->fl (cl->* (-Nat . -> . -NonnegativeFlonum) (-Integer . -> . -Flonum))] +[unsafe-make-flrectangular (-Flonum -Flonum . -> . -InexactComplex)] +[unsafe-flreal-part (-InexactComplex . -> . -Flonum)] +[unsafe-flimag-part (-InexactComplex . -> . -Flonum)] [unsafe-fx+ fx+-type] [unsafe-fx- fx-intop] @@ -545,6 +548,9 @@ [flexp fl-unop] [flsqrt fl-unop] [->fl (-Integer . -> . -Flonum)] +[make-flrectangular (-Flonum -Flonum . -> . -InexactComplex)] +[flreal-part (-InexactComplex . -> . -Flonum)] +[flimag-part (-InexactComplex . -> . -Flonum)] ;; safe flvector ops diff --git a/collects/typed-scheme/private/optimize.rkt b/collects/typed-scheme/private/optimize.rkt index 269e42a92e..670cd8ae1b 100644 --- a/collects/typed-scheme/private/optimize.rkt +++ b/collects/typed-scheme/private/optimize.rkt @@ -44,7 +44,13 @@ (define binary-float-ops (mk-float-tbl (list #'+ #'- #'* #'/ #'min #'max))) (define binary-float-comps - (mk-float-tbl (list #'= #'<= #'< #'> #'>=))) + (dict-set + (dict-set + (mk-float-tbl (list #'= #'<= #'< #'> #'>=)) + ;; not a comparison, but takes 2 floats and does not return a float, + ;; unlike binary-float-ops + #'make-rectangular #'unsafe-make-flrectangular) + #'make-flrectangular #'unsafe-make-flrectangular)) (define unary-float-ops (mk-float-tbl (list #'abs #'sin #'cos #'tan #'asin #'acos #'atan #'log #'exp #'sqrt #'round #'floor #'ceiling #'truncate))) @@ -54,6 +60,18 @@ #:when (dict-ref tbl #'i #f) #:with unsafe (dict-ref tbl #'i))) +(define-syntax-class inexact-complex-opt-expr + (pattern e:opt-expr + ;; can't work on inexact reals, which are a subtype of inexact + ;; complexes, so this has to be equality + #:when (match (type-of #'e) + [(tc-result1: (== -InexactComplex type-equal?)) #t] [_ #f]) + #:with opt #'e.opt)) + +(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-syntax-class fixnum-opt-expr (pattern e:opt-expr @@ -171,8 +189,6 @@ (begin (log-optimization "binary float" #'op) (n-ary->binary #'op.unsafe #'f1.opt #'f2.opt #'(fs.opt ...)))) (pattern (~and res (#%plain-app (~var op (float-op binary-float-comps)) f1:float-opt-expr f2:float-opt-expr fs:float-opt-expr ...)) - #:when (match (type-of #'res) - [(tc-result1: (== -Boolean type-equal?)) #t] [_ #f]) #:with opt (begin (log-optimization "binary float comp" #'op) (n-ary->binary #'op.unsafe #'f1.opt #'f2.opt #'(fs.opt ...)))) @@ -189,6 +205,12 @@ #:with opt (begin (log-optimization "binary nonzero fixnum" #'op) #'(op.unsafe n1.opt n2.opt))) + + (pattern (#%plain-app op:inexact-complex-unary-op n:inexact-complex-opt-expr) + #:with opt + (begin (log-optimization "unary inexact complex" #'op) + #'(op.unsafe n.opt))) + (pattern (#%plain-app (~and op (~literal exact->inexact)) n:fixnum-opt-expr) #:with opt (begin (log-optimization "fixnum to float" #'op)