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

fixups for eqvnan and expt merges

Browse Source 
original commit: 95165bd192db6136583a7141587173900e2da0c9
This commit is contained in:
Matthew Flatt 2019-01-18 07:49:37 -07:00
parent b61298b139
commit b945bc9318
3 changed files with 33 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
mats/ieee.ms
View File

@ -379,8 +379,8 @@
(== (expt -inf.0 +1.0) -inf.0)
(== (expt +inf.0 +inf.0) +inf.0)
(== (expt +inf.0 -inf.0) +0.0)
(== (expt -inf.0 +inf.0) +inf.0)
(== (expt -inf.0 -inf.0) +0.0)
(== (expt -inf.0 +inf.0) +nan.0+nan.0i)
(== (expt -inf.0 -inf.0) +nan.0+nan.0i)
(== (expt +inf.0 +.5) +inf.0)
(== (expt (nan) +.5) (nan))
(== (expt +.5 (nan)) (nan))

14
mats/mat.ss
View File

@ -333,19 +333,7 @@
(and (fl~= (cfl-real-part x) (cfl-real-part y))
(fl~= (cfl-imag-part x) (cfl-imag-part y)))))
; from ieee.ms
(define ==
(lambda (x y)
(and (inexact? x)
(inexact? y)
(if (flonum? x)
(and (flonum? y)
(if (fl= x y)
(fl= (fl/ 1.0 x) (fl/ 1.0 y))
(and (not (fl= x x)) (not (fl= y y)))))
(and (not (flonum? y))
(== (real-part x) (real-part y))
(== (imag-part x) (imag-part y)))))))
(define == eqv?)
(define (nan) (/ 0.0 0.0)) ; keeps "pretty-equal?" happy
(define pi (* (asin 1.0) 2))

38
s/cpnanopass.ss
View File

@ -6034,13 +6034,35 @@
(lambda (e1 e2)
(nanopass-case (L7 Expr) e1
[(quote ,d) (and (flonum? d)
(bind #t (e2)
(build-and
(%type-check mask-flonum type-flonum ,e2)
(if ($nan? d)
(build-not (%inline fl= ,e2 ,e2))
(%inline fl= ,e2 ,e1)))))]
[else #f])))
(build-and
(%type-check mask-flonum type-flonum ,e2)
(if ($nan? d)
;; NaN: invert `fl=` on self
(bind #t (e2)
(build-not (%inline fl= ,e2 ,e2)))
;; Non-NaN: compare bits
(constant-case ptr-bits
[(32)
(bind #t (e2)
(let ([d0 (if (eq? (constant-case native-endianness) (native-endianness)) 0 4)])
(let ([word1 ($object-ref 'iptr d (fx+ (constant flonum-data-disp) d0))]
[word2 ($object-ref 'iptr d (fx+ (constant flonum-data-disp) (fx- 4 d0)))])
(build-and
(%inline eq?
,(%mref ,e2 ,(constant flonum-data-disp))
(immediate ,word1))
(%inline eq?
,(%mref ,e2 ,(fx+ (constant flonum-data-disp) 4))
(immediate ,word2))))))]
[(64)
(let ([word ($object-ref 'iptr d (constant flonum-data-disp))])
(%inline eq?
,(%mref ,e2 ,(constant flonum-data-disp))
(immediate ,word)))]
[else ($oops 'compiler-internal
"eqv doesn't handle ptr-bits = ~s"
(constant ptr-bits))]))))]
[else #f])))
(define eqok-help?
(lambda (obj)
(or (symbol? obj)
@ -6798,7 +6820,7 @@
(define-inline 3 $fleqv?
[(e1 e2)
(bind #t (e1 e2)
`(if ,(%inline fl= ,e1 ,e1) ; check e1 no +nan.0
`(if ,(%inline fl= ,e1 ,e1) ; check e1 not +nan.0
,(constant-case ptr-bits
[(32) (build-and
(%inline eq?