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

The imaginary parts of inexact reals are ignored when doing complex

Browse Source 
addition or subtraction.
This commit is contained in:
Vincent St-Amour 2010-07-13 17:06:07 -04:00
parent 025af5b815
commit 748e9e47ad
9 changed files with 392 additions and 82 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
collects/tests/typed-scheme/optimizer/generic/inexact-complex-float-div.rkt Normal file
View File

@ -0,0 +1,7 @@
#lang typed/scheme #:optimize
(require racket/unsafe/ops)
(/ 1.0 2.0+4.0i)
(/ 1.0+2.0i 2.0)
(/ 1.0 2.0+4.0i 3.0+6.0i)
(/ 1.0+2.0i 2.0 3.0+6.0i)
(/ 1.0+2.0i 2.0+4.0i 3.0)

7
collects/tests/typed-scheme/optimizer/generic/inexact-complex-float-mul.rkt Normal file
View File

@ -0,0 +1,7 @@
#lang typed/scheme #:optimize
(require racket/unsafe/ops)
(* 1.0 2.0+4.0i)
(* 1.0+2.0i 2.0)
(* 1.0 2.0+4.0i 3.0+6.0i)
(* 1.0+2.0i 2.0 3.0+6.0i)
(* 1.0+2.0i 2.0+4.0i 3.0)

7
collects/tests/typed-scheme/optimizer/generic/inexact-complex-float-small.rkt Normal file
View File

@ -0,0 +1,7 @@
#lang typed/scheme #:optimize
(require racket/unsafe/ops)
(+ 1.0+2.0i 3.0)
(+ 1.0 2.0+4.0i)
(- 1.0+2.0i 3.0)
(- 1.0 2.0+4.0i)
(+ 1.0+2.0i (+ 1.0 2.0))

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

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

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

@ -0,0 +1,91 @@
#lang typed/scheme #:optimize
(require racket/unsafe/ops)
(let* ((unboxed-gensym-1 1.0)
(unboxed-gensym-2 2.0+4.0i)
(unboxed-gensym-3 (unsafe-flreal-part unboxed-gensym-2))
(unboxed-gensym-4 (unsafe-flimag-part unboxed-gensym-2))
(unboxed-gensym-5 (unsafe-fl- (unsafe-fl* unboxed-gensym-1
unboxed-gensym-3)
(unsafe-fl* 0.0 unboxed-gensym-4)))
(unboxed-gensym-6 (unsafe-fl+ (unsafe-fl* 0.0 unboxed-gensym-3)
(unsafe-fl* unboxed-gensym-1
unboxed-gensym-4))))
(unsafe-make-flrectangular unboxed-gensym-5 unboxed-gensym-6))
(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)
(unboxed-gensym-5 (unsafe-fl- (unsafe-fl* unboxed-gensym-2
unboxed-gensym-4)
(unsafe-fl* unboxed-gensym-3 0.0)))
(unboxed-gensym-6 (unsafe-fl+ (unsafe-fl* unboxed-gensym-3
unboxed-gensym-4)
(unsafe-fl* unboxed-gensym-2
0.0))))
(unsafe-make-flrectangular unboxed-gensym-5 unboxed-gensym-6))
(let* ((unboxed-gensym-1 1.0)
(unboxed-gensym-2 2.0+4.0i)
(unboxed-gensym-3 (unsafe-flreal-part unboxed-gensym-2))
(unboxed-gensym-4 (unsafe-flimag-part unboxed-gensym-2))
(unboxed-gensym-5 3.0+6.0i)
(unboxed-gensym-6 (unsafe-flreal-part unboxed-gensym-5))
(unboxed-gensym-7 (unsafe-flimag-part unboxed-gensym-5))
(unboxed-gensym-10 (unsafe-fl- (unsafe-fl* unboxed-gensym-1
unboxed-gensym-3)
(unsafe-fl* 0.0 unboxed-gensym-4)))
(unboxed-gensym-11 (unsafe-fl+ (unsafe-fl* 0.0 unboxed-gensym-3)
(unsafe-fl* unboxed-gensym-1
unboxed-gensym-4)))
(unboxed-gensym-8 (unsafe-fl- (unsafe-fl* unboxed-gensym-10
unboxed-gensym-6)
(unsafe-fl* unboxed-gensym-11
unboxed-gensym-7)))
(unboxed-gensym-9 (unsafe-fl+ (unsafe-fl* unboxed-gensym-11
unboxed-gensym-6)
(unsafe-fl* unboxed-gensym-10
unboxed-gensym-7))))
(unsafe-make-flrectangular unboxed-gensym-8 unboxed-gensym-9))
(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)
(unboxed-gensym-5 3.0+6.0i)
(unboxed-gensym-6 (unsafe-flreal-part unboxed-gensym-5))
(unboxed-gensym-7 (unsafe-flimag-part unboxed-gensym-5))
(unboxed-gensym-10 (unsafe-fl- (unsafe-fl* unboxed-gensym-2
unboxed-gensym-4)
(unsafe-fl* unboxed-gensym-3 0.0)))
(unboxed-gensym-11 (unsafe-fl+ (unsafe-fl* unboxed-gensym-3
unboxed-gensym-4)
(unsafe-fl* unboxed-gensym-2 0.0)))
(unboxed-gensym-8 (unsafe-fl- (unsafe-fl* unboxed-gensym-10
unboxed-gensym-6)
(unsafe-fl* unboxed-gensym-11
unboxed-gensym-7)))
(unboxed-gensym-9 (unsafe-fl+ (unsafe-fl* unboxed-gensym-11
unboxed-gensym-6)
(unsafe-fl* unboxed-gensym-10
unboxed-gensym-7))))
(unsafe-make-flrectangular unboxed-gensym-8 unboxed-gensym-9))
(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)
(unboxed-gensym-10 (unsafe-fl- (unsafe-fl* unboxed-gensym-2
unboxed-gensym-5)
(unsafe-fl* unboxed-gensym-3
unboxed-gensym-6)))
(unboxed-gensym-11 (unsafe-fl+ (unsafe-fl* unboxed-gensym-3
unboxed-gensym-5)
(unsafe-fl* unboxed-gensym-2
unboxed-gensym-6)))
(unboxed-gensym-8 (unsafe-fl- (unsafe-fl* unboxed-gensym-10
unboxed-gensym-7)
(unsafe-fl* unboxed-gensym-11 0.0)))
(unboxed-gensym-9 (unsafe-fl+ (unsafe-fl* unboxed-gensym-11
unboxed-gensym-7)
(unsafe-fl* unboxed-gensym-10 0.0))))
(unsafe-make-flrectangular unboxed-gensym-8 unboxed-gensym-9))

32
collects/tests/typed-scheme/optimizer/hand-optimized/inexact-complex-float-small.rkt Normal file
View File

@ -0,0 +1,32 @@
#lang typed/scheme #:optimize
(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 3.0)
(unboxed-gensym-5 (unsafe-fl+ unboxed-gensym-2 unboxed-gensym-4))
(unboxed-gensym-6 unboxed-gensym-3))
(unsafe-make-flrectangular unboxed-gensym-5 unboxed-gensym-6))
(let* ((unboxed-gensym-1 1.0)
(unboxed-gensym-2 2.0+4.0i)
(unboxed-gensym-3 (unsafe-flreal-part unboxed-gensym-2))
(unboxed-gensym-4 (unsafe-flimag-part unboxed-gensym-2))
(unboxed-gensym-5 (unsafe-fl+ unboxed-gensym-1 unboxed-gensym-3))
(unboxed-gensym-6 unboxed-gensym-4))
(unsafe-make-flrectangular unboxed-gensym-5 unboxed-gensym-6))
(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 3.0)
(unboxed-gensym-5 (unsafe-fl- unboxed-gensym-2 unboxed-gensym-4))
(unboxed-gensym-6 unboxed-gensym-3))
(unsafe-make-flrectangular unboxed-gensym-5 unboxed-gensym-6))
(let* ((unboxed-gensym-1 1.0)
(unboxed-gensym-2 2.0+4.0i)
(unboxed-gensym-3 (unsafe-flreal-part unboxed-gensym-2))
(unboxed-gensym-4 (unsafe-flimag-part unboxed-gensym-2))
(unboxed-gensym-5 (unsafe-fl- unboxed-gensym-1 unboxed-gensym-3))
(unboxed-gensym-6 (unsafe-fl- 0.0 unboxed-gensym-4)))
(unsafe-make-flrectangular unboxed-gensym-5 unboxed-gensym-6))
(+ 1.0+2.0i (+ 1.0 2.0))

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

@ -4,47 +4,42 @@
(unboxed-gensym-2 (unsafe-flreal-part unboxed-gensym-1)) (unboxed-gensym-2 (unsafe-flreal-part unboxed-gensym-1))
(unboxed-gensym-3 (unsafe-flimag-part unboxed-gensym-1)) (unboxed-gensym-3 (unsafe-flimag-part unboxed-gensym-1))
(unboxed-gensym-4 2.0) (unboxed-gensym-4 2.0)
(unboxed-gensym-5 0.0) (unboxed-gensym-5 3.0+6.0i)
(unboxed-gensym-6 3.0+6.0i) (unboxed-gensym-6 (unsafe-flreal-part unboxed-gensym-5))
(unboxed-gensym-7 (unsafe-flreal-part unboxed-gensym-6)) (unboxed-gensym-7 (unsafe-flimag-part unboxed-gensym-5))
(unboxed-gensym-8 (unsafe-flimag-part unboxed-gensym-6)) (unboxed-gensym-8 (unsafe-fl+ (unsafe-fl+ unboxed-gensym-2
(unboxed-gensym-9 (unsafe-fl+ (unsafe-fl+ unboxed-gensym-2
unboxed-gensym-4) unboxed-gensym-4)
unboxed-gensym-7)) unboxed-gensym-6))
(unboxed-gensym-10 (unsafe-fl+ (unsafe-fl+ unboxed-gensym-3 (unboxed-gensym-9 (unsafe-fl+ unboxed-gensym-3
unboxed-gensym-5) unboxed-gensym-7)))
unboxed-gensym-8))) (unsafe-make-flrectangular unboxed-gensym-8 unboxed-gensym-9))
(unsafe-make-flrectangular unboxed-gensym-9 unboxed-gensym-10))
(let* ((unboxed-gensym-1 1.0) (let* ((unboxed-gensym-1 1.0)
(unboxed-gensym-2 0.0) (unboxed-gensym-2 2.0+4.0i)
(unboxed-gensym-3 2.0+4.0i) (unboxed-gensym-3 (unsafe-flreal-part unboxed-gensym-2))
(unboxed-gensym-4 (unsafe-flreal-part unboxed-gensym-3)) (unboxed-gensym-4 (unsafe-flimag-part unboxed-gensym-2))
(unboxed-gensym-5 (unsafe-flimag-part unboxed-gensym-3)) (unboxed-gensym-5 3.0+6.0i)
(unboxed-gensym-6 3.0+6.0i) (unboxed-gensym-6 (unsafe-flreal-part unboxed-gensym-5))
(unboxed-gensym-7 (unsafe-flreal-part unboxed-gensym-6)) (unboxed-gensym-7 (unsafe-flimag-part unboxed-gensym-5))
(unboxed-gensym-8 (unsafe-flimag-part unboxed-gensym-6)) (unboxed-gensym-8 (unsafe-fl- (unsafe-fl- unboxed-gensym-1
(unboxed-gensym-9 (unsafe-fl- (unsafe-fl- unboxed-gensym-1 unboxed-gensym-3)
unboxed-gensym-6))
(unboxed-gensym-9 (unsafe-fl- (unsafe-fl- 0.0
unboxed-gensym-4) unboxed-gensym-4)
unboxed-gensym-7)) unboxed-gensym-7)))
(unboxed-gensym-10 (unsafe-fl- (unsafe-fl- unboxed-gensym-2 (unsafe-make-flrectangular unboxed-gensym-8 unboxed-gensym-9))
unboxed-gensym-5)
unboxed-gensym-8)))
(unsafe-make-flrectangular unboxed-gensym-9 unboxed-gensym-10))
(let* ((unboxed-gensym-1 1.0+2.0i) (let* ((unboxed-gensym-1 1.0+2.0i)
(unboxed-gensym-2 (unsafe-flreal-part unboxed-gensym-1)) (unboxed-gensym-2 (unsafe-flreal-part unboxed-gensym-1))
(unboxed-gensym-3 (unsafe-flimag-part unboxed-gensym-1)) (unboxed-gensym-3 (unsafe-flimag-part unboxed-gensym-1))
(unboxed-gensym-4 2.0) (unboxed-gensym-4 2.0)
(unboxed-gensym-5 0.0) (unboxed-gensym-5 3.0+6.0i)
(unboxed-gensym-6 3.0+6.0i) (unboxed-gensym-6 (unsafe-flreal-part unboxed-gensym-5))
(unboxed-gensym-7 (unsafe-flreal-part unboxed-gensym-6)) (unboxed-gensym-7 (unsafe-flimag-part unboxed-gensym-5))
(unboxed-gensym-8 (unsafe-flimag-part unboxed-gensym-6)) (unboxed-gensym-8 (unsafe-fl- (unsafe-fl- unboxed-gensym-2
(unboxed-gensym-9 (unsafe-fl- (unsafe-fl- unboxed-gensym-2
unboxed-gensym-4) unboxed-gensym-4)
unboxed-gensym-7)) unboxed-gensym-6))
(unboxed-gensym-10 (unsafe-fl- (unsafe-fl- unboxed-gensym-3 (unboxed-gensym-9 (unsafe-fl- unboxed-gensym-3
unboxed-gensym-5) unboxed-gensym-7)))
unboxed-gensym-8))) (unsafe-make-flrectangular unboxed-gensym-8 unboxed-gensym-9))
(unsafe-make-flrectangular unboxed-gensym-9 unboxed-gensym-10))
(let* ((unboxed-gensym-1 1.0+2.0i) (let* ((unboxed-gensym-1 1.0+2.0i)
(unboxed-gensym-2 (unsafe-flreal-part unboxed-gensym-1)) (unboxed-gensym-2 (unsafe-flreal-part unboxed-gensym-1))
(unboxed-gensym-3 (unsafe-flimag-part unboxed-gensym-1)) (unboxed-gensym-3 (unsafe-flimag-part unboxed-gensym-1))
@ -52,11 +47,9 @@
(unboxed-gensym-5 (unsafe-flreal-part unboxed-gensym-4)) (unboxed-gensym-5 (unsafe-flreal-part unboxed-gensym-4))
(unboxed-gensym-6 (unsafe-flimag-part unboxed-gensym-4)) (unboxed-gensym-6 (unsafe-flimag-part unboxed-gensym-4))
(unboxed-gensym-7 3.0) (unboxed-gensym-7 3.0)
(unboxed-gensym-8 0.0) (unboxed-gensym-8 (unsafe-fl- (unsafe-fl- unboxed-gensym-2
(unboxed-gensym-9 (unsafe-fl- (unsafe-fl- unboxed-gensym-2
unboxed-gensym-5) unboxed-gensym-5)
unboxed-gensym-7)) unboxed-gensym-7))
(unboxed-gensym-10 (unsafe-fl- (unsafe-fl- unboxed-gensym-3 (unboxed-gensym-9 (unsafe-fl- unboxed-gensym-3
unboxed-gensym-6) unboxed-gensym-6)))
unboxed-gensym-8))) (unsafe-make-flrectangular unboxed-gensym-8 unboxed-gensym-9))
(unsafe-make-flrectangular unboxed-gensym-9 unboxed-gensym-10))

2
collects/typed-scheme/optimizer/float.rkt
View File

@ -7,7 +7,7 @@
(types abbrev type-table utils subtype) (types abbrev type-table utils subtype)
(optimizer utils fixnum)) (optimizer utils fixnum))
(provide float-opt-expr float-op mk-float-tbl) (provide float-opt-expr)
(define (mk-float-tbl generic) (define (mk-float-tbl generic)

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

@ -4,7 +4,7 @@
"../utils/utils.rkt" "../utils/utils.rkt"
(for-template scheme/base scheme/math scheme/flonum scheme/unsafe/ops) (for-template scheme/base scheme/math scheme/flonum scheme/unsafe/ops)
(types abbrev type-table utils subtype) (types abbrev type-table utils subtype)
(optimizer utils float)) (optimizer utils))
(provide inexact-complex-opt-expr) (provide inexact-complex-opt-expr)
@ -14,7 +14,7 @@
;; we keep the real and imaginary parts unboxed as long as we stay within ;; we keep the real and imaginary parts unboxed as long as we stay within
;; complex operations ;; complex operations
(define-syntax-class unboxed-inexact-complex-opt-expr (define-syntax-class unboxed-inexact-complex-opt-expr
(pattern (#%plain-app (~and (~var op (float-op binary-inexact-complex-ops)) (~or (~literal +) (~literal -))) (pattern (#%plain-app (~and op (~literal +))
c1:unboxed-inexact-complex-opt-expr c1:unboxed-inexact-complex-opt-expr
c2:unboxed-inexact-complex-opt-expr c2:unboxed-inexact-complex-opt-expr
cs:unboxed-inexact-complex-opt-expr ...) cs:unboxed-inexact-complex-opt-expr ...)
@ -25,10 +25,43 @@
#`(#,@(append (syntax->list #'(c1.bindings ... c2.bindings ... cs.bindings ... ...)) #`(#,@(append (syntax->list #'(c1.bindings ... c2.bindings ... cs.bindings ... ...))
(list #`(real-part #,(for/fold ((o #'c1.real-part)) (list #`(real-part #,(for/fold ((o #'c1.real-part))
((e (syntax->list #'(c2.real-part cs.real-part ...)))) ((e (syntax->list #'(c2.real-part cs.real-part ...))))
#`(op.unsafe #,o #,e))) #`(unsafe-fl+ #,o #,e)))
#`(imag-part #,(for/fold ((o #'c1.imag-part)) ;; we can skip the imaginary parts of reals (#f)
((e (syntax->list #'(c2.imag-part cs.imag-part ...)))) #`(imag-part
#`(op.unsafe #,o #,e)))))))) #,(let ((l (filter syntax->datum
(syntax->list #'(c1.imag-part c2.imag-part cs.imag-part ...)))))
(case (length l)
((0) #'0.0)
((1) (car l))
(else
(for/fold ((o (car l)))
((e (cdr l)))
#`(unsafe-fl+ #,o #,e)))))))))))
(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 (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 ...))))
;; but we can skip all but the first 0
(l2 (filter (lambda (x) (not (equal? (syntax->datum x) 0.0)))
(cdr l1))))
(case (length l2)
((0) (car l1))
(else
(for/fold ((o (car l1)))
((e l2))
#`(unsafe-fl- #,o #,e)))))))))))
(pattern (#%plain-app (~and op (~literal *)) (pattern (#%plain-app (~and op (~literal *))
c1:unboxed-inexact-complex-opt-expr c1:unboxed-inexact-complex-opt-expr
c2:unboxed-inexact-complex-opt-expr c2:unboxed-inexact-complex-opt-expr
@ -40,48 +73,55 @@
#`(c1.bindings ... c2.bindings ... cs.bindings ... ... #`(c1.bindings ... c2.bindings ... cs.bindings ... ...
;; we want to bind the intermediate results to reuse them ;; we want to bind the intermediate results to reuse them
;; the final results are bound to real-part and imag-part ;; the final results are bound to real-part and imag-part
#,@(let loop ([o1 #'c1.real-part] ;; we currently don't skip imaginary parts of reals
[o2 #'c1.imag-part] #,@(let ((l (map (lambda (x) (if (syntax->datum x) x #'0.0))
[e1 (syntax->list #'(c2.real-part cs.real-part ...))] (syntax->list #'(c1.imag-part c2.imag-part cs.imag-part ...)))))
[e2 (syntax->list #'(c2.imag-part cs.imag-part ...))] (let loop ([o1 #'c1.real-part]
[rs (append (map (lambda (x) (unboxed-gensym)) [o2 (car l)]
(syntax->list #'(cs.real-part ...))) [e1 (syntax->list #'(c2.real-part cs.real-part ...))]
(list #'real-part))] [e2 (cdr l)]
[is (append (map (lambda (x) (unboxed-gensym)) [rs (append (map (lambda (x) (unboxed-gensym))
(syntax->list #'(cs.imag-part ...))) (syntax->list #'(cs.real-part ...)))
(list #'imag-part))] (list #'real-part))]
[res '()]) [is (append (map (lambda (x) (unboxed-gensym))
(if (null? e1) (syntax->list #'(cs.imag-part ...)))
(reverse res) (list #'imag-part))]
(loop (car rs) (car is) (cdr e1) (cdr e2) (cdr rs) (cdr is) [res '()])
;; complex multiplication, imag part, then real part (reverse) (if (null? e1)
(list* #`(#,(car is) (reverse res)
(unsafe-fl+ (unsafe-fl* #,o2 #,(car e1)) (loop (car rs) (car is) (cdr e1) (cdr e2) (cdr rs) (cdr is)
(unsafe-fl* #,o1 #,(car e2)))) ;; complex multiplication, imag part, then real part (reverse)
#`(#,(car rs) (list* #`(#,(car is)
(unsafe-fl- (unsafe-fl* #,o1 #,(car e1)) (unsafe-fl+ (unsafe-fl* #,o2 #,(car e1))
(unsafe-fl* #,o2 #,(car e2)))) (unsafe-fl* #,o1 #,(car e2))))
res))))))) #`(#,(car rs)
(unsafe-fl- (unsafe-fl* #,o1 #,(car e1))
(unsafe-fl* #,o2 #,(car e2))))
res))))))))
(pattern (#%plain-app (~and op (~literal /)) (pattern (#%plain-app (~and op (~literal /))
c1:unboxed-inexact-complex-opt-expr c1:unboxed-inexact-complex-opt-expr
c2:unboxed-inexact-complex-opt-expr c2:unboxed-inexact-complex-opt-expr
cs:unboxed-inexact-complex-opt-expr ...) cs:unboxed-inexact-complex-opt-expr ...)
#:with real-part (unboxed-gensym) #:with real-part (unboxed-gensym)
#:with imag-part (unboxed-gensym) #:with imag-part (unboxed-gensym)
#:with reals (syntax->list #'(c1.real-part c2.real-part cs.real-part ...))
;; we currently don't skip imaginary parts of reals
#:with imags (map (lambda (x) (if (syntax->datum x) x #'0.0))
(syntax->list #'(c1.imag-part c2.imag-part cs.imag-part ...)))
#:with (denominators ...) #:with (denominators ...)
(for/list (for/list
([e1 (syntax->list #'(c2.real-part cs.real-part ...))] ([e1 (cdr (syntax->list #'reals))]
[e2 (syntax->list #'(c2.imag-part cs.imag-part ...))]) [e2 (cdr (syntax->list #'imags))])
#`(#,(unboxed-gensym) (unsafe-fl+ (unsafe-fl* #,e1 #,e1) (unsafe-fl* #,e2 #,e2)))) #`(#,(unboxed-gensym) (unsafe-fl+ (unsafe-fl* #,e1 #,e1) (unsafe-fl* #,e2 #,e2))))
#:with (bindings ...) #:with (bindings ...)
(begin (log-optimization "unboxed binary inexact complex" #'op) (begin (log-optimization "unboxed binary inexact complex" #'op)
#`(c1.bindings ... c2.bindings ... cs.bindings ... ... denominators ... #`(c1.bindings ... c2.bindings ... cs.bindings ... ... denominators ...
;; we want to bind the intermediate results to reuse them ;; we want to bind the intermediate results to reuse them
;; the final results are bound to real-part and imag-part ;; the final results are bound to real-part and imag-part
#,@(let loop ([o1 #'c1.real-part] #,@(let loop ([o1 (car (syntax->list #'reals))]
[o2 #'c1.imag-part] [o2 (car (syntax->list #'imags))]
[e1 (syntax->list #'(c2.real-part cs.real-part ...))] [e1 (cdr (syntax->list #'reals))]
[e2 (syntax->list #'(c2.imag-part cs.imag-part ...))] [e2 (cdr (syntax->list #'imags))]
[d (map (lambda (x) (car (syntax-e x))) [d (map (lambda (x) (car (syntax-e x)))
(syntax->list #'(denominators ...)))] (syntax->list #'(denominators ...)))]
[rs (append (map (lambda (x) (unboxed-gensym)) [rs (append (map (lambda (x) (unboxed-gensym))
@ -115,10 +155,9 @@
;; special handling of inexact reals ;; special handling of inexact reals
#:when (subtypeof? #'e -Flonum) #:when (subtypeof? #'e -Flonum)
#:with real-part (unboxed-gensym) #:with real-part (unboxed-gensym)
#:with imag-part (unboxed-gensym) #:with imag-part #f
#:with (bindings ...) #:with (bindings ...)
#`((real-part #,((optimize) #'e)) #`((real-part #,((optimize) #'e))))
(imag-part 0.0)))
(pattern e:expr (pattern e:expr
;; can't work on inexact reals, which are a subtype of inexact ;; can't work on inexact reals, which are a subtype of inexact
;; complexes, so this has to be equality ;; complexes, so this has to be equality
@ -134,8 +173,9 @@
(define-syntax-class inexact-complex-unary-op (define-syntax-class inexact-complex-unary-op
(pattern (~or (~literal real-part) (~literal flreal-part)) #:with unsafe #'unsafe-flreal-part) (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)) (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 inexact-complex-binary-op
(pattern (~or (~literal +) (~literal -) (~literal *) (~literal /) (~literal conjugate))))
(define-syntax-class inexact-complex-expr (define-syntax-class inexact-complex-expr
(pattern e:expr (pattern e:expr
@ -147,9 +187,7 @@
#:with opt #:with opt
(begin (log-optimization "unary inexact complex" #'op) (begin (log-optimization "unary inexact complex" #'op)
#'(op.unsafe n.opt))) #'(op.unsafe n.opt)))
(pattern (~and exp (#%plain-app (~or (~var op (float-op binary-inexact-complex-ops)) (pattern (~and exp (#%plain-app op:inexact-complex-binary-op e:inexact-complex-expr ...))
(~and op (~literal conjugate)))
e:inexact-complex-expr ...))
#:when (isoftype? #'exp -InexactComplex) #:when (isoftype? #'exp -InexactComplex)
#:with exp*:unboxed-inexact-complex-opt-expr #'exp #:with exp*:unboxed-inexact-complex-opt-expr #'exp
#:with opt #:with opt