diff options
Diffstat (limited to 'hash-map.csc')
| -rw-r--r-- | hash-map.csc | 74 |
1 files changed, 41 insertions, 33 deletions
diff --git a/hash-map.csc b/hash-map.csc index 2c95b36..01d4158 100644 --- a/hash-map.csc +++ b/hash-map.csc @@ -1,23 +1,24 @@ (define-library (csc hash-map) (export - alist->hash-map + alist->map hash-bytevector - hash-map->alist - hash-map-foreach - hash-map-insert - hash-map-lookup - hash-map? - make-hash-map) + map->alist + for-each + insert + lookup + map? + key-not-found-error? + make-map) (import (scheme base) (only (csc format) sprintf)) (begin (define-record-type <key-hash> - (make-key-hash hash k) + (make-key-hash k hash) key-hash? - (hash key-hash-hash) - (k key-hash-value)) + (k key-hash-value) + (hash key-hash-hash)) (define (key-hash<? k1 k2 key<?) @@ -161,42 +162,48 @@ (else m)))) - (define (insert m k v key<?) + (define (insert-node m k v key<?) (cond ((null? m) (make-node 'red k v '() '())) ((key-hash<? k (node-key m) key<?) (rebalance-left (make-node (node-color m) (node-key m) (node-value m) - (insert (node-left m) k v key<?) + (insert-node (node-left m) k v key<?) (node-right m)))) ((key-hash=? k (node-key m)) (make-node (node-color m) k v (node-left m) (node-right m))) (else (rebalance-right (make-node (node-color m) (node-key m) (node-value m) (node-left m) - (insert (node-right m) k v key<?)))))) + (insert-node (node-right m) k v key<?)))))) (define-record-type <hash-map> (construct-hash-map hash key<? root) hash-map? - (hash hash-map-hash) + (hash hash-map-raw-hash) (key<? hash-map-key<?) (root hash-map-root)) - (define (make-hash-map hash key<?) + (define (make-map hash key<?) (construct-hash-map hash key<? '())) - (define (hash-map-insert m k v) - (let* ((shuffle - (lambda (hash) - (truncate-remainder - (* #x9e3779b97f4a7c55 hash) - #x10000000000000000))) - (res (insert (hash-map-root m) (make-key-hash (shuffle ((hash-map-hash m) k)) k) v (hash-map-key<? m)))) + (define (shuffle n) + (truncate-remainder + (* #x9e3779b97f4a7c55 n) + #x10000000000000000)) + + + (define (hash-map-hash m) + (lambda (k) + (shuffle ((hash-map-raw-hash m) k)))) + + + (define (insert m k v) + (let ((res (insert-node (hash-map-root m) (make-key-hash k ((hash-map-hash m) k)) v (hash-map-key<? m)))) (construct-hash-map - (hash-map-hash m) + (hash-map-raw-hash m) (hash-map-key<? m) (make-node 'black (node-key res) (node-value res) (node-left res) (node-right res))))) @@ -206,17 +213,18 @@ key-not-found-error?) - (define (hash-map-lookup m k) - (letrec ((lookup + (define (lookup m k) + (letrec ((k* (make-key-hash k ((hash-map-hash m) k))) + (lookup (lambda (n) (cond ((null? n) (raise (make-key-not-found-error))) - ((key-hash<? k (node-key n) (hash-map-key<? m)) (lookup (node-left n))) - ((key-hash=? k (node-key n)) (node-value n)) + ((key-hash<? k* (node-key n) (hash-map-key<? m)) (lookup (node-left n))) + ((key-hash=? k* (node-key n)) (node-value n)) (else (lookup (node-right n))))))) (lookup (hash-map-root m)))) - (define (hash-map-foreach f m) + (define (for-each f m) (letrec ((node-foreach (lambda (n) (unless (null? n) @@ -226,21 +234,21 @@ (node-foreach (hash-map-root m)))) - (define (hash-map->alist m) + (define (map->alist m) (let ((alist '())) - (hash-map-foreach + (for-each (lambda (k v) (set! alist (cons (cons k v) alist))) m) alist)) - (define (alist->hash-map hash key<? alist) + (define (alist->map hash key<? alist) (let loop ((alist alist) - (m (make-hash-map hash key<?))) + (m (make-map hash key<?))) (if (null? alist) m - (loop (cdr alist) (hash-map-insert m (caar alist) (cdar alist)))))) + (loop (cdr alist) (insert m (caar alist) (cdar alist)))))) (define (hash-bytevector b) |
