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

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

Browse Source 
original commit: 55b68c7585947c9c07d1be1b643d10dede983874
This commit is contained in:
Matthew Flatt 2019-01-17 09:05:51 -07:00
commit 84d1e19487
3 changed files with 50 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
mats/5_1.ms
View File

@ -36,6 +36,7 @@
(not (eqv? "hi there" (string-append "hi " "there")))
(not (eqv? (vector 1 2 (vector 3 4) 5) '#(1 2 #(3 4) 5)))
(eqv? +nan.0 +nan.0)
(eqv? +nan.0 (abs +nan.0))
(eqv? +inf.0 +inf.0)
(eqv? -inf.0 -inf.0)
(not (eqv? -inf.0 +inf.0))
@ -64,6 +65,7 @@
(equal? (vector 1 2 (vector 3 4) 5) '#(1 2 #(3 4) 5))
(not (equal? (vector 1 2 (vector 3 4) 5) '#(1 2 3 4 5)))
(equal? +nan.0 +nan.0)
(equal? +nan.0 (abs +nan.0))
(equal? +inf.0 +inf.0)
(equal? -inf.0 -inf.0)
(not (equal? -inf.0 +inf.0))

5
mats/hash.ms
View File

@ -2500,6 +2500,11 @@
k**))
(call-with-values (lambda () (#%$hashtable-veclen ht)) cons))
'(32 . 32))
(begin
(hashtable-set! h +nan.0 'nan)
#t)
(eq? 'nan (hashtable-ref h (abs +nan.0) #f))
)
(mat weak-eqv-hashtable

67
s/cpnanopass.ss
View File

@ -6030,6 +6030,17 @@
(define-inline 3 bytevector=?
[(e1 e2) (build-libcall #f src sexpr bytevector=? e1 e2)])
(let ()
(define eqvop-flonum
(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])))
(define eqok-help?
(lambda (obj)
(or (symbol? obj)
@ -6058,6 +6069,8 @@
(define eqvnever? (e*ok? eqvnever-help?))
(define-inline 2 eqv?
[(e1 e2) (or (eqvop-null-fptr e1 e2)
(eqvop-flonum e1 e2)
(eqvop-flonum e2 e1)
(if (or (eqok? e1) (eqok? e2)
(eqvnever? e1) (eqvnever? e2))
(build-eq? e1 e2)
@ -6743,15 +6756,18 @@
,(build-libcall #t src sexpr logtest e1 e2)))])
(define-inline 3 $flhash
[(e) (bind #t (e)
(%inline logand
,(%inline srl
,(constant-case ptr-bits
[(32) (%inline +
,(%mref ,e ,(constant flonum-data-disp))
,(%mref ,e ,(fx+ (constant flonum-data-disp) 4)))]
[(64) (%mref ,e ,(constant flonum-data-disp))])
(immediate 1))
(immediate ,(- (constant fixnum-factor)))))])
`(if ,(%inline fl= ,e ,e)
,(%inline logand
,(%inline srl
,(constant-case ptr-bits
[(32) (%inline +
,(%mref ,e ,(constant flonum-data-disp))
,(%mref ,e ,(fx+ (constant flonum-data-disp) 4)))]
[(64) (%mref ,e ,(constant flonum-data-disp))])
(immediate 1))
(immediate ,(- (constant fixnum-factor))))
;; +nan.0
(immediate ,(fix #xfa1e))))])
(let ()
(define build-flonum-extractor
(lambda (pos size e1)
@ -6781,21 +6797,24 @@
(define-inline 3 $fleqv?
[(e1 e2)
(constant-case ptr-bits
[(32) (build-and
(%inline eq?
,(%mref ,e1 ,(constant flonum-data-disp))
,(%mref ,e2 ,(constant flonum-data-disp)))
(%inline eq?
,(%mref ,e1 ,(fx+ (constant flonum-data-disp) 4))
,(%mref ,e2 ,(fx+ (constant flonum-data-disp) 4))))]
[(64) (%inline eq?
,(%mref ,e1 ,(constant flonum-data-disp))
,(%mref ,e2 ,(constant flonum-data-disp)))]
[else ($oops 'compiler-internal
"$fleqv doesn't handle ptr-bits = ~s"
(constant ptr-bits))])])
(bind #t (e1 e2)
`(if ,(%inline fl= ,e1 ,e1) ; check e1 no +nan.0
,(constant-case ptr-bits
[(32) (build-and
(%inline eq?
,(%mref ,e1 ,(constant flonum-data-disp))
,(%mref ,e2 ,(constant flonum-data-disp)))
(%inline eq?
,(%mref ,e1 ,(fx+ (constant flonum-data-disp) 4))
,(%mref ,e2 ,(fx+ (constant flonum-data-disp) 4))))]
[(64) (%inline eq?
,(%mref ,e1 ,(constant flonum-data-disp))
,(%mref ,e2 ,(constant flonum-data-disp)))]
[else ($oops 'compiler-internal
"$fleqv doesn't handle ptr-bits = ~s"
(constant ptr-bits))])
;; If e1 is +nan.0, see if e2 is +nan.0:
,(build-not (%inline fl= ,e2 ,e2))))])
(let ()
(define build-flop-1