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

Merge branch 'expt' of github.com:mflatt/ChezScheme

Browse Source 
original commit: f634e2e45f60f60071c83769edce17541e5e6705
This commit is contained in:
Matthew Flatt 2019-01-18 05:59:56 -07:00
commit b61298b139
4 changed files with 132 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

91
mats/5_3.ms
View File

@ -1694,6 +1694,7 @@
(eqv? (/ 1 -1/2) -2)
(fl~= (/ 1.0 2) 0.5)
(fl~= (/ 1 2.0) 0.5)
(eqv? (/ 0 2.0) 0)
(eqv? (/ 3/5 2/5) 3/2)
(eqv? (/ -3/5 2/5) -3/2)
(eqv? (/ 3/5 -2/5) -3/2)
@ -1706,11 +1707,13 @@
(eqv? (/ 2 3 4) 1/6)
(eqv? (/ 2 3 4 5) 1/30)
(eqv? (/ 2/3 3/4 4/5 5/6) 4/3)
(eqv? (/ 0 2/3) 0)
(cfl~= (/ -5.0+10.0i 1.0+2.0i) 3.0+4.0i)
(cfl~= (/ -6.0-8.0i -2.0) 3.0+4.0i)
(cfl~= (/ 26.0 3.0-2.0i) 6.0+4.0i)
(cfl~= (/ -8.0+6.0i +2.0i) 3.0+4.0i)
(cfl~= (/ +26.0i 3.0+2.0i) 4.0+6.0i)
(eqv? (/ 0 3.0+2.0i) 0)
(let ([v '#(100 32.23 22/33 44-79i 2.9+8.7i)])
(let f ([i 0])
(or (= i (vector-length v))
@ -1730,9 +1733,20 @@
(let ([x (/ 9 50000000000)])
(and (eqv? (numerator x) 9)
(eqv? (denominator x) 50000000000)))
(== (/ 3.5 0) +inf.0)
(== (/ -3.5 0) -inf.0)
(== (/ 0.0 0) (nan))
(error? (/ 3.5 0))
(error? (/ -3.5 0))
(error? (/ 0.0 0))
(eqv? (/ 3.5 0.0) +inf.0)
(eqv? (/ -3.5 0.0) -inf.0)
(== (/ 0.0 0.0) +nan.0)
(eqv? (/ 0 0.0) 0)
(eqv? (/ 0 +inf.0) 0)
(eqv? (/ 0 -inf.0) 0)
(eqv? (/ 0 +nan.0) 0)
(eqv? (/ 0 2+3i) 0)
(eqv? (/ 0 2/3) 0)
(eqv? (/ 0 2.0+3.0i) 0)
(eqv? (/ 0 +nan.0+nan.0i) 0)
(test-cp0-expansion eqv? '(/ 1 2) 1/2)
(test-cp0-expansion eqv? '(/ 1 -2) -1/2)
(test-cp0-expansion eqv? '(/ 1/2 -2) -1/4)
@ -1756,9 +1770,9 @@
(test-cp0-expansion cfl~= '(/ 26.0 3.0-2.0i) 6.0+4.0i)
(test-cp0-expansion cfl~= '(/ -8.0+6.0i +2.0i) 3.0+4.0i)
(test-cp0-expansion cfl~= '(/ +26.0i 3.0+2.0i) 4.0+6.0i)
(test-cp0-expansion == '(/ 3.5 0) +inf.0)
(test-cp0-expansion == '(/ -3.5 0) -inf.0)
(test-cp0-expansion == '(/ 0.0 0) (nan))
(test-cp0-expansion == '(/ 3.5 0.0) +inf.0)
(test-cp0-expansion == '(/ -3.5 0.0) -inf.0)
(test-cp0-expansion == '(/ 0.0 0.0) (nan))
)
(mat nan?
@ -2146,6 +2160,8 @@
(fl= (round 2.5) 2.0)
(fl= (round 0.5000000000000000) 0.0)
(fl= (round 0.5000000000000001) 1.0)
(eqv? (round 0.0) 0.0)
(eqv? (round -0.0) -0.0)
)
(mat abs
@ -2354,11 +2370,42 @@
(eqv? (expt 10.0 -20) 1e-20)
(eqv? (expt 2 10) 1024)
(eqv? (expt 0 0) 1)
(eqv? (expt 1.0 0) 1)
(eqv? (expt +nan.0 0) 1)
(eqv? (expt +inf.0 0) 1)
(eqv? (expt -inf.0 0) 1)
(eqv? (expt 2+3i 0) 1)
(eqv? (expt 2.0+3.0i 0) 1)
(eqv? (expt 2/3 0) 1)
(eqv? (expt 1 2) 1)
(eqv? (expt 1 2.0) 1)
(eqv? (expt 1 +inf.0) 1)
(eqv? (expt 1 -inf.0) 1)
(eqv? (expt 1 +nan.0) 1)
(eqv? (expt 1 2+3i) 1)
(eqv? (expt 1 2.0+3.0i) 1)
(eqv? (expt 1 -2.0+3.0i) 1)
(eqv? (expt 1 2/3) 1)
(eqv? (expt 1 -2/3) 1)
(eqv? (expt 0 2) 0)
(eqv? (expt 0 2.0) 0)
(== (expt 0 +nan.0) +nan.0)
(eqv? (expt 0 +inf.0) 0)
(eqv? (expt 0 2.0+3.0i) 0)
(error? (expt 0 -1))
(error? (expt 0 -1.0))
(error? (expt 0 -2.0+3.0i))
(error? (expt 0 0.0+3.0i))
(error? (expt 0 -0.0+3.0i))
(error? (expt 0 +nan.0+3.0i))
(error? (expt 0 0+3i))
(error? (expt 0 -1/2))
(eqv? (expt 0 0.0) 1.0)
(eqv? (expt 0 -0.0) 1.0)
(eqv? (expt 100 0) 1)
(eqv? (expt 2 -10) 1/1024)
(eqv? (expt -1/2 5) -1/32)
(fl~= (expt 9 1/2) 3.0)
(eqv? (expt 9 1/2) 3)
(fl~= (expt 3.0 3) 27.0)
(~= (expt -0.5 2) .25)
(~= (expt -0.5 -2) 4.0)
@ -2366,10 +2413,31 @@
(fl= (expt 0.0 2.0) 0.0)
(fl= (expt 0.0 0.0) 1.0)
(fl= (expt 2.0 0.0) 1.0)
(eqv? (expt 1 0.0) 1)
(fl= (expt -1 0.0) 1.0)
(fl= (expt -1.0 0.0) 1.0)
(fl= (expt 2/3 0.0) 1.0)
(fl= (expt -2/3 0.0) 1.0)
(fl= (expt +inf.0 0.0) 1.0)
(fl= (expt -inf.0 0.0) 1.0)
(fl= (expt +nan.0 0.0) 1.0)
(fl= (expt 1.0 1) 1.0)
(fl= (expt 1.0 -1) 1.0)
(fl= (expt 1.0 3.0) 1.0)
(fl= (expt 1.0 -3.0) 1.0)
(fl= (expt 1.0 +inf.0) 1.0)
(fl= (expt 1.0 -inf.0) 1.0)
(fl= (expt 1.0 +nan.0) 1.0)
(eqv? (expt 0.0 3) 0.0)
(eqv? (expt 0.0 3.0) 0.0)
(eqv? (expt 0.0 2/3) 0.0)
(eqv? (expt 0.0 -3) +inf.0)
(eqv? (expt 0.0 -3.0) +inf.0)
(eqv? (expt 0.0 -2/3) +inf.0)
(eqv? (expt -2/3 -3) -27/8)
(fl= (expt 10.0 -1000) 0.0)
(fl= (expt .1 1000) 0.0)
(cfl~= (expt -1 1/2) +1.0i)
(eqv? (expt -1 1/2) +1i)
(cfl~= (expt 2.4-.3i 3.0) (* 2.4-.3i 2.4-.3i 2.4-.3i))
(cfl~= (expt 2.4-.3i 3) (* 2.4-.3i 2.4-.3i 2.4-.3i))
(cfl~= (expt 7.7-11.11i -2.0) (* (/ 1.0 7.7-11.11i) (/ 1.0 7.7-11.11i)))
@ -2582,6 +2650,13 @@
(fl= (angle 3.0@2.0) 2.0))
(let ([z 24.3-200.2i]) (cfl~= z (make-polar (magnitude z) (angle z))))
(= (angle 3+1i) (angle 3.0+1.0i))
(eqv? (angle 7.0) 0)
(fl~= (angle -7.0) pi)
(eqv? (angle 7/3) 0)
(fl~= (angle -7/3) pi)
(eqv? (angle +inf.0) 0)
(fl~= (angle -inf.0) pi)
(== (angle +nan.0) +nan.0)
)
(mat sqrt

54
s/5_3.ss
View File

@ -632,7 +632,7 @@
(define exact-inexact/
(lambda (x y)
(cond
[(fixnum? x) (fl/ (fixnum->flonum x) y)]
[(fixnum? x) (if (fx= x 0) 0 (fl/ (fixnum->flonum x) y))]
[(floatable? x) (fl/ (inexact x) y)]
[(or (fl= y 0.0) (exceptional-flonum? y))
(if (< x 0) (fl/ -1.0 y) (fl/ y))]
@ -641,7 +641,7 @@
(define inexact-exact/
(lambda (x y)
(cond
[(fixnum? y) (fl/ x (fixnum->flonum y))]
[(fixnum? y) (if (eq? y 0) (domain-error '/ y) (fl/ x (fixnum->flonum y)))]
[(floatable? y) (fl/ x (inexact y))]
[(or (fl= x 0.0) (exceptional-flonum? x)) (if (< y 0) (fl- x) x)]
[else (inexact (/ (exact x) y))])))
@ -1266,7 +1266,10 @@
(set! angle
(lambda (z)
(type-case z
[(flonum?) (if (negated-flonum? z) pi 0.0)]
[(flonum?) (cond
[($nan? z) +nan.0]
[(negated-flonum? z) pi]
[else 0])]
[($inexactnum?) (cflangle z)]
[(fixnum? bignum? ratnum?)
(cond
@ -1475,28 +1478,47 @@
[(flonum?)
(type-case x
[(flonum?)
(if (and (fl< x 0.0) (not ($flinteger-or-inf? y)))
(if (and (fl< x 0.0) (not ($flinteger? y)))
(exp (* y (log x)))
($flexpt x y))]
[($inexactnum? $exactnum?) (exp (* y (log x)))]
[(fixnum? bignum? ratnum?)
(if (floatable? x)
(expt (inexact x) y)
(exp (* y (log x))))]
(cond
[(eq? x 0)
(cond
[(fl< y 0.0) ($impoops 'expt "undefined for values ~s and ~s" x y)]
[(fl= y 0.0) 1.0]
[($nan? y) +nan.0]
[else 0])]
[(eq? x 1) 1]
[else
(if (floatable? x)
(expt (inexact x) y)
(exp (* y (log x))))])]
[else (nonnumber-error 'expt x)])]
[($inexactnum?)
(if (or (eq? x 0) (and (flonum? x) (= x 0.0)))
0.0
(begin
(unless (number? x) (nonnumber-error 'expt x))
(exp (* y (log x)))))]
(cond
[(eq? x 0)
(let ([r ($inexactnum-real-part y)])
(cond
[(fl> r 0.0) 0]
[else
($impoops 'expt "undefined for values ~s and ~s" x y)]))]
[(eq? x 1) 1]
[(and (flonum? x) (fl= x 0.0) (not (negated-flonum? ($inexactnum-real-part y))))
0.0]
[else
(unless (number? x) (nonnumber-error 'expt x))
(exp (* y (log x)))])]
[(ratnum? $exactnum?)
(unless (number? x) (nonnumber-error 'expt x))
(cond
[(eqv? y 1/2) (sqrt x)]
[(eq? x 0)
(if (> (real-part y) 0)
0
($impoops 'expt "undefined for values ~s and ~s" x y))]
[(eq? x 1) 1]
[(floatable? y) (expt x (inexact y))]
[else (exp (* y (log x)))])]
[else (nonnumber-error 'expt y)])))
@ -2215,9 +2237,11 @@
(type-case x
[(fixnum? bignum? ratnum? flonum?)
;; a / c+di => c(a/(cc+dd)) + (-d(a/cc+dd))i
(let ([c (real-part y)] [d (imag-part y)])
(let ([t (/ x (+ (* c c) (* d d)))])
(make-rectangular (* c t) (- (* d t)))))]
(if (eq? x 0)
0
(let ([c (real-part y)] [d (imag-part y)])
(let ([t (/ x (+ (* c c) (* d d)))])
(make-rectangular (* c t) (- (* d t))))))]
[($exactnum? $inexactnum?)
;; a+bi / c+di => (ac+bd)/(cc+dd) + ((bc-ad)/(cc+dd))i
(let ([a (real-part x)] [b (imag-part x)]

2
s/cp0.ss
View File

@ -2699,7 +2699,7 @@
[else #f])])
(and xval
yval
(or (not (eq? xval 0)) (not (fixnum? yval)) (fx>= yval 0))
(not (and (eq? xval 0) (negative? (real-part yval))))
(begin
(residualize-seq '() (list x y) ctxt)
`(quote ,(expt xval yval)))))])

16
s/library.ss
View File

@ -624,13 +624,15 @@
[(ieee)
(define threshold+ #i#x10000000000000)
(define threshold- #i#x-10000000000000)])
(if (fl>= x 0.0)
(if (fl< x threshold+)
(fl- (fl+ x threshold+) threshold+)
x)
(if (fl> x threshold-)
(fl- (fl+ x threshold-) threshold-)
x)))
(if (fl= x 0.0)
x ; don't change sign
(if (fl>= x 0.0)
(if (fl< x threshold+)
(fl- (fl+ x threshold+) threshold+)
x)
(if (fl> x threshold-)
(fl- (fl+ x threshold-) threshold-)
x))))
;;; The generic comparison entries assume the fixnum case is inlined.