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

hash-update! and similar: minor performance reorg

Browse Source 
Reorganize the implementation of `hash-update!` and related fuctions
to help the bytecode compiler a little.
This commit is contained in:
Matthew Flatt 2018-03-19 10:42:09 -06:00
parent f138469464
commit b177a5c908
2 changed files with 1039 additions and 1053 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

90
racket/collects/racket/private/more-scheme.rkt
View File

@ -337,50 +337,52 @@
(printf "cpu time: ~s real time: ~s gc time: ~s\n" cpu user gc) (printf "cpu time: ~s real time: ~s gc time: ~s\n" cpu user gc)
(apply values v)))]))) (apply values v)))])))
(define-values (hash-update hash-update! hash-has-key? hash-ref!) (define not-there (gensym))
(let* ([not-there (gensym)]
[up (lambda (who mut? set ht key xform default) (define (do-hash-update who mut? set ht key xform default)
(unless (and (hash? ht) (unless (variable-reference-from-unsafe? (#%variable-reference))
(if mut? (unless (and (hash? ht)
(not (immutable? ht)) (if mut?
(immutable? ht))) (not (immutable? ht))
(raise-argument-error who (if mut? "(and/c hash? (not/c immutable?))" "(and/c hash? immutable?)") ht)) (immutable? ht)))
(unless (and (procedure? xform) (raise-argument-error who (if mut? "(and/c hash? (not/c immutable?))" "(and/c hash? immutable?)") ht))
(procedure-arity-includes? xform 1)) (unless (and (procedure? xform)
(raise-argument-error who "(any/c . -> . any/c)" xform)) (procedure-arity-includes? xform 1))
(let ([v (hash-ref ht key default)]) (raise-argument-error who "(any/c . -> . any/c)" xform)))
(if (eq? v not-there) (let ([v (hash-ref ht key default)])
(raise-mismatch-error who "no value found for key: " key) (if (eq? v not-there)
(set ht key (xform v)))))]) (raise-mismatch-error who "no value found for key: " key)
(let ([hash-update (set ht key (xform v)))))
(case-lambda
[(ht key xform default) (define hash-update
(up 'hash-update #f hash-set ht key xform default)] (case-lambda
[(ht key xform) [(ht key xform default)
(hash-update ht key xform not-there)])] (do-hash-update 'hash-update #f hash-set ht key xform default)]
[hash-update! [(ht key xform)
(case-lambda (hash-update ht key xform not-there)]))
[(ht key xform default)
(up 'hash-update! #t hash-set! ht key xform default)] (define hash-update!
[(ht key xform) (case-lambda
(hash-update! ht key xform not-there)])] [(ht key xform default)
[hash-has-key? (do-hash-update 'hash-update! #t hash-set! ht key xform default)]
(lambda (ht key) [(ht key xform)
(unless (hash? ht) (hash-update! ht key xform not-there)]))
(raise-argument-error 'hash-has-key? "hash?" 0 ht key))
(not (eq? not-there (hash-ref ht key not-there))))] (define (hash-has-key? ht key)
[hash-ref! (unless (hash? ht)
(lambda (ht key new) (raise-argument-error 'hash-has-key? "hash?" 0 ht key))
(unless (and (hash? ht) (not (eq? not-there (hash-ref ht key not-there))))
(not (immutable? ht)))
(raise-argument-error 'hash-ref! "(and/c hash? (not/c immutable?))" 0 ht key new)) (define (hash-ref! ht key new)
(let ([v (hash-ref ht key not-there)]) (unless (and (hash? ht)
(if (eq? not-there v) (not (immutable? ht)))
(let ([n (if (procedure? new) (new) new)]) (raise-argument-error 'hash-ref! "(and/c hash? (not/c immutable?))" 0 ht key new))
(hash-set! ht key n) (let ([v (hash-ref ht key not-there)])
n) (if (eq? not-there v)
v)))]) (let ([n (if (procedure? new) (new) new)])
(values hash-update hash-update! hash-has-key? hash-ref!)))) (hash-set! ht key n)
n)
v)))
(#%provide case old-case do (#%provide case old-case do
parameterize parameterize* current-parameterization call-with-parameterization parameterize parameterize* current-parameterization call-with-parameterization

2002
racket/src/racket/src/startup.inc
View File

File diff suppressed because it is too large Load Diff