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? "hi there" (string-append "hi " "there")))
(not (eqv? (vector 1 2 (vector 3 4) 5) '#(1 2 #(3 4) 5))) (not (eqv? (vector 1 2 (vector 3 4) 5) '#(1 2 #(3 4) 5)))
(eqv? +nan.0 +nan.0) (eqv? +nan.0 +nan.0)
(eqv? +nan.0 (abs +nan.0))
(eqv? +inf.0 +inf.0) (eqv? +inf.0 +inf.0)
(eqv? -inf.0 -inf.0) (eqv? -inf.0 -inf.0)
(not (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)) (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))) (not (equal? (vector 1 2 (vector 3 4) 5) '#(1 2 3 4 5)))
(equal? +nan.0 +nan.0) (equal? +nan.0 +nan.0)
(equal? +nan.0 (abs +nan.0))
(equal? +inf.0 +inf.0) (equal? +inf.0 +inf.0)
(equal? -inf.0 -inf.0) (equal? -inf.0 -inf.0)
(not (equal? -inf.0 +inf.0)) (not (equal? -inf.0 +inf.0))

5
mats/hash.ms
View File

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

67
s/cpnanopass.ss
View File

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