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

improve eqv? code generation

Browse Source 
original commit: bcc117f228c984a267031e25e068df3210137f4e
This commit is contained in:
Matthew Flatt 2019-01-11 21:35:04 -07:00
parent 03a33fb4fc
commit 1f150fdbce
1 changed files with 19 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
s/cpnanopass.ss
View File

@ -2882,7 +2882,21 @@
(%inline eq? ,e1 ,e2))) (%inline eq? ,e1 ,e2)))
(define build-eqv? (define build-eqv?
(lambda (src sexpr e1 e2) (lambda (src sexpr e1 e2)
(build-libcall #f src sexpr eqv? e1 e2))) (bind #t (e1 e2)
(build-simple-or
(build-eq? e1 e2)
(build-and
;; checking just one argument is good enough for typical
;; uses, where `eqv?` almost always receives two fixnums
;; or two characters; checking both arguments appears to
;; by counter-productive by introducing too many branches
(build-simple-or
(%type-check mask-flonum type-flonum ,e1)
(build-and
(%type-check mask-typed-object type-typed-object ,e1)
(%type-check mask-other-number type-other-number
,(%mref ,e1 ,(constant bignum-type-disp)))))
(build-libcall #f src sexpr eqv? e1 e2))))))
(define make-build-eqv? (define make-build-eqv?
(lambda (src sexpr) (lambda (src sexpr)
(lambda (e1 e2) (lambda (e1 e2)
@ -5698,6 +5712,7 @@
($unbound-object? obj) ($unbound-object? obj)
(eqv? obj '#vfx())))) (eqv? obj '#vfx()))))
(define eqvok-help? number?) (define eqvok-help? number?)
(define eqvnever-help? (lambda (obj) (not (number? obj))))
(define e*ok? (define e*ok?
(lambda (e*ok-help?) (lambda (e*ok-help?)
(lambda (e) (lambda (e)
@ -5706,9 +5721,11 @@
[else #f])))) [else #f]))))
(define eqok? (e*ok? eqok-help?)) (define eqok? (e*ok? eqok-help?))
(define eqvok? (e*ok? eqvok-help?)) (define eqvok? (e*ok? eqvok-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)
(if (or (eqok? e1) (eqok? e2)) (if (or (eqok? e1) (eqok? e2)
(eqvnever? e1) (eqvnever? e2))
(build-eq? e1 e2) (build-eq? e1 e2)
(build-eqv? src sexpr e1 e2)))]) (build-eqv? src sexpr e1 e2)))])
(let () (let ()