├── .gitignore ├── LICENSE ├── README.md ├── data ├── hamt.rkt └── hamt │ ├── array.rkt │ ├── fast.rkt │ ├── hamt.scrbl │ ├── info.rkt │ ├── popcount.rkt │ └── syntax.rkt ├── info.rkt └── tests └── data └── hamt ├── hamt.rkt └── perf.rkt /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | .DS_Store 3 | compiled/ 4 | doc/ 5 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2013 97jaz 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy of 6 | this software and associated documentation files (the "Software"), to deal in 7 | the Software without restriction, including without limitation the rights to 8 | use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of 9 | the Software, and to permit persons to whom the Software is furnished to do so, 10 | subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS 17 | FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR 18 | COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER 19 | IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN 20 | CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Immutable Hash Array Mapped Tries for Racket 2 | 3 | *Note:* Racket's built-in immutable `hash` is now implemented as a HAMT, so I recommend you use that instead. 4 | 5 | [Read the documentation](https://docs.racket-lang.org/hamt/index.html) 6 | -------------------------------------------------------------------------------- /data/hamt.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/contract/base 4 | "hamt/fast.rkt" 5 | "hamt/syntax.rkt") 6 | 7 | (provide for/hamt for*/hamt 8 | for/hamteqv for*/hamteqv 9 | for/hamteq for*/hamteq) 10 | 11 | (provide/contract 12 | [hamt (() #:rest (listof any/c) . ->* . (and/c hamt? hamt-equal?))] 13 | [hamteqv (() #:rest (listof any/c) . ->* . (and/c hamt? hamt-eqv?))] 14 | [hamteq (() #:rest (listof any/c) . ->* . (and/c hamt? hamt-eq?))] 15 | [make-hamt (() ((listof (cons/c any/c any/c))) . ->* . (and/c hamt? hamt-equal?))] 16 | [make-hamteqv (() ((listof (cons/c any/c any/c))) . ->* . (and/c hamt? hamt-eqv?))] 17 | [make-hamteq (() ((listof (cons/c any/c any/c))) . ->* . (and/c hamt? hamt-eq?))] 18 | [hamt? (any/c . -> . boolean?)] 19 | [hamt-equal? (hamt? . -> . boolean?)] 20 | [hamt-eqv? (hamt? . -> . boolean?)] 21 | [hamt-eq? (hamt? . -> . boolean?)] 22 | [hamt-count (hamt? . -> . exact-nonnegative-integer?)] 23 | [hamt-empty? (hamt? . -> . boolean?)] 24 | [hamt-has-key? (hamt? any/c . -> . boolean?)] 25 | [hamt-has-value? ((hamt? any/c) ((any/c any/c . -> . boolean?)) . ->* . boolean?)] 26 | [hamt-ref ((hamt? any/c) (any/c) . ->* . any/c)] 27 | [hamt-set (hamt? any/c any/c . -> . hamt?)] 28 | [hamt-set* ((hamt?) #:rest (listof any/c) . ->* . hamt?)] 29 | [hamt-remove (hamt? any/c . -> . hamt?)] 30 | [hamt-map (hamt? (any/c any/c . -> . any/c) . -> . (listof any/c))] 31 | [hamt-for-each (hamt? (any/c any/c . -> . any/c) . -> . void?)] 32 | [hamt->list (hamt? . -> . (listof (cons/c any/c any/c)))] 33 | [hamt-keys (hamt? . -> . (listof any/c))] 34 | [hamt-values (hamt? . -> . (listof any/c))]) 35 | -------------------------------------------------------------------------------- /data/hamt/array.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (provide array-length 4 | array-ref 5 | array 6 | array-replace 7 | array-insert 8 | array-remove) 9 | 10 | (require racket/performance-hint) 11 | 12 | (require racket/require 13 | (for-syntax racket/base) 14 | (filtered-in 15 | (λ (name) (regexp-replace #rx"unsafe-" name "")) 16 | racket/unsafe/ops)) 17 | 18 | (begin-encourage-inline 19 | (define array-length vector-length) 20 | (define array-ref vector*-ref) 21 | (define array vector) 22 | 23 | (define (array-replace arr idx val) 24 | (define len (vector-length arr)) 25 | (define new (make-vector len)) 26 | 27 | (let loop ([i 0]) 28 | (cond [(fx= i idx) 29 | (vector*-set! new i val) 30 | (loop (fx+ i 1))] 31 | [(fx< i len) 32 | (vector*-set! new i (vector*-ref arr i)) 33 | (loop (fx+ i 1))] 34 | [else 35 | new]))) 36 | 37 | (define (array-insert arr idx val) 38 | (define new (make-vector (fx+ (vector-length arr) 1))) 39 | (vector-copy! new 0 arr 0 idx) 40 | (vector*-set! new idx val) 41 | (vector-copy! new (fx+ idx 1) arr idx) 42 | new) 43 | 44 | (define (array-remove arr idx) 45 | (define new (make-vector (fx- (vector-length arr) 1))) 46 | (vector-copy! new 0 arr 0 idx) 47 | (vector-copy! new idx arr (fx+ idx 1)) 48 | new)) -------------------------------------------------------------------------------- /data/hamt/fast.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/match 4 | racket/generator 5 | racket/dict 6 | racket/stream 7 | (prefix-in c: data/collection) 8 | "popcount.rkt" 9 | "array.rkt") 10 | 11 | (require racket/require 12 | racket/performance-hint 13 | (for-syntax racket/base) 14 | (filtered-in 15 | (λ (name) (regexp-replace #rx"unsafe-" name "")) 16 | racket/unsafe/ops)) 17 | 18 | (provide hamt 19 | make-hamt 20 | hamteqv 21 | make-hamteqv 22 | hamteq 23 | make-hamteq 24 | hamt? 25 | hamt-equal? 26 | hamt-eqv? 27 | hamt-eq? 28 | hamt-count 29 | hamt-empty? 30 | hamt-has-key? 31 | hamt-has-value? 32 | hamt-ref 33 | hamt-set 34 | hamt-set* 35 | hamt-remove 36 | hamt-map 37 | hamt-keys 38 | hamt-values 39 | hamt->list 40 | hamt-for-each) 41 | 42 | 43 | ;; node types 44 | (struct entry (key value) #:transparent) 45 | (struct bnode (array bitmap) #:transparent) 46 | (struct cnode (array hashcode) #:transparent) 47 | 48 | ;; iterator position 49 | (struct hamt-position (hamt entry generator)) 50 | 51 | ;; eta-expanded because the struct def needs to be below 52 | (define (hamt? x) (HAMT? x)) 53 | 54 | (define (hamt-equal? x) (eq? (HAMT-name x) 'hamt)) 55 | (define (hamt-eqv? x) (eq? (HAMT-name x) 'hamteqv)) 56 | (define (hamt-eq? x) (eq? (HAMT-name x) 'hamteq)) 57 | 58 | (define (hamt-count h) (HAMT-count h)) 59 | 60 | (define-syntax-rule (define-hamt-constructors vararg-constructor list-constructor key= key#) 61 | (begin 62 | (define (vararg-constructor . kvs) 63 | (let loop ([kvs kvs] [h (HAMT 'vararg-constructor *empty-bnode* 0 key= key#)]) 64 | (match kvs 65 | [(list-rest k v kvs) (loop kvs (hamt-set h k v))] 66 | [(list) h] 67 | [(list k) (raise (exn:fail:contract 68 | (odd-kvlist-message 'vararg-constructor k) 69 | (current-continuation-marks)))]))) 70 | 71 | (define (list-constructor [assocs '()]) 72 | (for/fold ([h (vararg-constructor)]) ([pair (in-list assocs)]) 73 | (hamt-set h (car pair) (cdr pair)))))) 74 | 75 | (define-hamt-constructors hamt make-hamt equal? equal-hash-code) 76 | (define-hamt-constructors hamteqv make-hamteqv eqv? eqv-hash-code) 77 | (define-hamt-constructors hamteq make-hamteq eq? eq-hash-code) 78 | 79 | 80 | (define (hamt-empty? h) 81 | (fx= (hamt-count h) 0)) 82 | 83 | (define (hamt-ref h key [default (λ () 84 | (raise 85 | (exn:fail:contract 86 | (format "hamt-ref: no value found for key\n\tkey : ~s" key) 87 | (current-continuation-marks))))]) 88 | (match h 89 | [(HAMT _ root _ key= key#) 90 | (node-ref root key (key# key) key= 0 default)])) 91 | 92 | (define (hamt-has-key? h key) 93 | (not (nothing? (hamt-ref h key *nothing*)))) 94 | 95 | (define (hamt-has-value? h value [equal? equal?]) 96 | (for/first ([v (in-dict-values h)] 97 | #:when (equal? v value)) 98 | #t)) 99 | 100 | (define (hamt-set h key val) 101 | (match h 102 | [(HAMT name root count key= key#) 103 | (define-values (node added?) (node-set root key val (key# key) key= key# 0)) 104 | 105 | (cond [(eq? node root) h] 106 | [else (let ([new-count (if added? (fx+ count 1) count)]) 107 | (HAMT name node new-count key= key#))])])) 108 | 109 | (define (hamt-set* h . kvs) 110 | (let loop ([kvs kvs] [h h]) 111 | (match kvs 112 | [(list-rest k v kvs) (loop kvs (hamt-set h k v))] 113 | [(list) h] 114 | [(list k) (raise (exn:fail:contract 115 | (odd-kvlist-message 'hamt-set* k) 116 | (current-continuation-marks)))]))) 117 | 118 | 119 | (define (hamt-remove h key) 120 | (match h 121 | [(HAMT name root count key= key#) 122 | (define node (node-remove root key (key# key) key= 0)) 123 | 124 | (cond [(eq? node root) h] 125 | [else (HAMT name node (fx- count 1) key= key#)])])) 126 | 127 | (define (hamt-map h proc) 128 | (hamt-fold h '() (λ (k v acc) (cons (proc k v) acc)))) 129 | 130 | (define (hamt-keys h) 131 | (hamt-fold h '() (λ (k _ acc) (cons k acc)))) 132 | 133 | (define (hamt-values h) 134 | (hamt-fold h '() (λ (_ v acc) (cons v acc)))) 135 | 136 | (define (hamt->list h) 137 | (hamt-fold h '() (λ (k v acc) (cons (cons k v) acc)))) 138 | 139 | (define (hamt-for-each h proc) 140 | (hamt-fold h (void) (λ (k v _) (void (proc k v))))) 141 | 142 | (define (hamt-fold h id proc) 143 | (node-fold (HAMT-root h) id proc)) 144 | 145 | (define (hamt-iterate-first h) 146 | (if (zero? (hamt-count h)) 147 | #f 148 | (let* ([g (generate-hamt-position h)] 149 | [x (g)]) 150 | (and x (hamt-position h x g))))) 151 | 152 | (define (hamt-iterate-next h pos) 153 | (match pos 154 | [(hamt-position h0 _ g) 155 | (cond [(eq? h h0) 156 | (let ([x (g)]) 157 | (and x (hamt-position h x g)))] 158 | [else 159 | (raise (exn:fail:contract "invalid position" (current-continuation-marks)))])])) 160 | 161 | (define (hamt-iterate-key h pos) 162 | (match pos 163 | [(hamt-position h0 (entry k _) _) 164 | (cond [(eq? h h0) 165 | k] 166 | [else 167 | (raise (exn:fail:contract "invalid position" (current-continuation-marks)))])])) 168 | 169 | (define (hamt-iterate-value h pos) 170 | (match pos 171 | [(hamt-position h0 (entry _ v) _) 172 | (cond [(eq? h h0) 173 | v] 174 | [else 175 | (raise (exn:fail:contract "invalid position" (current-continuation-marks)))])])) 176 | 177 | (define (hamt-write h port mode) 178 | (define recur (case mode 179 | [(#t) write] 180 | [(#f) display] 181 | [else (λ (p port) (print p port mode))])) 182 | (write-string "#<" port) 183 | (write-string (symbol->string (HAMT-name h)) port) 184 | (recur (hamt->list h) port) 185 | (write-string ">" port)) 186 | 187 | (struct HAMT (name root count key= key#) 188 | #:transparent 189 | #:methods gen:dict 190 | [(define dict-ref hamt-ref) 191 | (define dict-set hamt-set) 192 | (define dict-remove hamt-remove) 193 | (define dict-count hamt-count) 194 | (define dict-iterate-first hamt-iterate-first) 195 | (define dict-iterate-next hamt-iterate-next) 196 | (define dict-iterate-key hamt-iterate-key) 197 | (define dict-iterate-value hamt-iterate-value)] 198 | #:methods gen:custom-write 199 | [(define write-proc hamt-write)] 200 | #:methods c:gen:collection 201 | [(define (conj coll item) (hamt-set coll (car item) (cdr item)))] 202 | #:methods c:gen:countable 203 | [(define length hamt-count) 204 | (define (known-finite? x) #t)] 205 | #:methods c:gen:sequence 206 | [(define empty? hamt-empty?) 207 | (define (first seq) (stream-first (sequence->stream (in-dict seq)))) 208 | (define (rest seq) (stream-rest (sequence->stream (in-dict seq)))) 209 | (define (reverse seq) (c:reverse (sequence->stream (in-dict seq))))]) 210 | 211 | (define (node-ref node key keyhash key= shift default) 212 | (cond [(bnode? node) (bnode-ref node key keyhash key= shift default)] 213 | [(cnode? node) (cnode-ref node key keyhash key= shift default)] 214 | [else (error "[BUG] node-ref: unknown node type")])) 215 | 216 | (define (node-set node key val keyhash key= key# shift) 217 | (cond [(bnode? node) (bnode-set node key val keyhash key= key# shift)] 218 | [(cnode? node) (cnode-set node key val keyhash key= key# shift)] 219 | [else (error "[BUG] node-set: unknown node type")])) 220 | 221 | (define (node-remove node key keyhash key= shift) 222 | (cond [(bnode? node) (bnode-remove node key keyhash key= shift)] 223 | [(cnode? node) (cnode-remove node key keyhash key= shift)] 224 | [else (error "[BUG] node-remove: unknown node type")])) 225 | 226 | (define (node-fold n acc proc) 227 | (match n 228 | [(bnode arr _) (array-fold arr acc proc)] 229 | [(cnode arr _) (array-fold arr acc proc)] 230 | [else (error "[BUG] node-fold: unknown node type")])) 231 | 232 | (define (array-fold arr acc proc) 233 | (for*/fold ([acc acc]) ([i (in-range (array-length arr))] 234 | [x (in-value (array-ref arr i))]) 235 | (if (entry? x) 236 | (proc (entry-key x) (entry-value x) acc) 237 | (node-fold x acc proc)))) 238 | 239 | (define (bnode-ref node key keyhash key= shift default) 240 | (match (bnode-array-ref node keyhash shift) 241 | [(entry k v) (cond [(key= key k) v] 242 | [else (return default)])] 243 | [#f (return default)] 244 | [child (node-ref child key keyhash key= (down shift) default)])) 245 | 246 | (define (cnode-ref node key keyhash key= shift default) 247 | (match (cnode-array-ref node key keyhash key=) 248 | [(entry _ v) v] 249 | [_ (return default)])) 250 | 251 | (define (bnode-set node key val keyhash key= key# shift) 252 | (match node 253 | [(bnode arr bitmap) 254 | (define bit (bnode-bit keyhash shift)) 255 | (define idx (bnode-idx bitmap bit)) 256 | 257 | (cond [(bit-set? bitmap bit) 258 | (match (array-ref arr idx) 259 | [(entry k v) 260 | (cond [(key= key k) 261 | (values (bnode (array-replace arr idx (entry key val)) 262 | bitmap) 263 | #f)] 264 | 265 | [else 266 | (define child (make-node k v key val keyhash key= key# (down shift))) 267 | (values (bnode (array-replace arr idx child) bitmap) 268 | #t)])] 269 | 270 | [child 271 | (define-values (new-child added?) (node-set child key val keyhash key= key# (down shift))) 272 | (values (bnode (array-replace arr idx new-child) bitmap) 273 | added?)])] 274 | 275 | [else 276 | (values (bnode (array-insert arr idx (entry key val)) (bitwise-ior bitmap bit)) 277 | #t)])])) 278 | 279 | (define (cnode-set node key val keyhash key= key# shift) 280 | (match node 281 | [(cnode arr hashcode) 282 | (cond [(= hashcode keyhash) 283 | (define idx (cnode-index arr key key=)) 284 | 285 | (cond [idx (values (cnode (array-replace arr idx (entry key val)) hashcode) 286 | #f)] 287 | [else (values (cnode (array-insert arr (array-length arr) (entry key val)) hashcode) 288 | #t)])] 289 | [else 290 | (let*-values ([(new) (bnode (array node) (bnode-bit hashcode shift))] 291 | [(new added?) (node-set new key val keyhash key= key# shift)]) 292 | (values new added?))])])) 293 | 294 | (define (bnode-remove node key keyhash key= shift) 295 | (match node 296 | [(bnode arr bitmap) 297 | (define bit (bnode-bit keyhash shift)) 298 | (define idx (bnode-idx bitmap bit)) 299 | 300 | (cond [(bit-set? bitmap bit) 301 | (match (array-ref arr idx) 302 | [(entry k _) 303 | (cond [(key= key k) 304 | (define new-arr (array-remove arr idx)) 305 | 306 | (cond [(contract-node? new-arr idx shift) 307 | (array-ref new-arr 0)] 308 | [else 309 | (bnode new-arr (fxxor bitmap bit))])] 310 | [else 311 | node])] 312 | [child 313 | (define new-child (node-remove child key keyhash key= (down shift))) 314 | 315 | (cond [(eq? child new-child) 316 | node] 317 | [else 318 | (bnode (array-replace arr idx new-child) bitmap)])])] 319 | [else 320 | node])])) 321 | 322 | (define (cnode-remove node key keyhash key= shift) 323 | (match node 324 | [(cnode arr hashcode) 325 | (cond [(= hashcode keyhash) 326 | (define idx (cnode-index arr key key=)) 327 | 328 | (cond [idx 329 | (define new-arr (array-remove arr idx)) 330 | 331 | (cond [(contract-node? new-arr idx shift) 332 | (array-ref new-arr 0)] 333 | [else 334 | (cnode new-arr hashcode)])] 335 | [else 336 | node])] 337 | [else 338 | node])])) 339 | 340 | (define (cnode-array-ref node key keyhash key=) 341 | (match node 342 | [(cnode arr hashcode) 343 | (and (= hashcode keyhash) 344 | (let ([i (cnode-index arr key key=)]) 345 | (and i (array-ref arr i))))])) 346 | 347 | (define (cnode-index arr key key=) 348 | (for*/first ([i (in-range (array-length arr))] 349 | [e (in-value (array-ref arr i))] 350 | #:when (key= key (entry-key e))) 351 | i)) 352 | 353 | (define (make-node k1 v1 k2 v2 k2hash key= key# shift) 354 | (define k1hash (key# k1)) 355 | 356 | (cond [(= k1hash k2hash) 357 | (cnode (array (entry k1 v1) (entry k2 v2)) k1hash)] 358 | [else 359 | (let*-values ([(n _) (node-set *empty-bnode* k1 v1 k1hash key= key# shift)] 360 | [(n _) (node-set n k2 v2 k2hash key= key# shift)]) 361 | n)])) 362 | 363 | (define (contract-node? arr idx shift) 364 | (and (fx= (array-length arr) 1) 365 | (fx> shift 0) 366 | (entry? (array-ref arr 0)))) 367 | 368 | (define (generate-hamt-position h) 369 | (generator () (hamt-fold h #f (λ (k v _) (yield (entry k v)) #f)))) 370 | 371 | (define (odd-kvlist-message name key) 372 | (format (string-append "~a: key does not have a value " 373 | "(i.e., an odd number of arguments were provided)\n" 374 | "\tkey: ~s") 375 | name 376 | key)) 377 | 378 | (begin-encourage-inline 379 | 380 | (define (bnode-array-ref node keyhash shift) 381 | (match node 382 | [(bnode arr bitmap) 383 | (define bit (bnode-bit keyhash shift)) 384 | 385 | (cond [(bit-set? bitmap bit) 386 | (define idx (bnode-idx bitmap bit)) 387 | 388 | (array-ref arr idx)] 389 | [else 390 | #f])])) 391 | 392 | (define (bnode-bit keyhash shift) 393 | (fxlshift 1 394 | (fxand (fxrshift keyhash shift) #x0f))) 395 | 396 | (define (bnode-idx bitmap bit) 397 | (popcount32 (fxand bitmap (fx- bit 1)))) 398 | 399 | (define (bit-set? bitmap bit) 400 | (not (fx= 0 (fxand bitmap bit)))) 401 | 402 | (define (down shift) 403 | (fx+ shift 4)) 404 | 405 | (define (return default) 406 | (if (procedure? default) 407 | (default) 408 | default)) 409 | 410 | (define (nothing? x) (eq? x *nothing*))) 411 | 412 | (define *nothing* (list '*nothing*)) 413 | (define *empty-bnode* (bnode (array) 0)) 414 | -------------------------------------------------------------------------------- /data/hamt/hamt.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label racket/base 4 | racket/contract 5 | racket/dict 6 | data/hamt 7 | (only-in data/collection 8 | gen:sequence 9 | gen:countable 10 | gen:collection))) 11 | 12 | @title{Immutable Hash Array Mapped Tries} 13 | @author{@(author+email "Jon Zeppieri" "zeppieri@gmail.com")} 14 | 15 | @(define (mutable-key-caveat) 16 | @elemref['(caveat "hamt-mutable-keys")]{caveat concerning mutable keys}) 17 | 18 | @(define (see-also-mutable-key-caveat) 19 | @t{See also the @mutable-key-caveat[] above.}) 20 | 21 | 22 | @defmodule[data/hamt] 23 | 24 | This package defines @deftech{immutable hash array mapped tries} (or @deftech{HAMT}s, for short). 25 | A @tech{HAMT} is a @tech[#:doc '(lib "scribblings/reference/reference.scrbl")]{dictionary}, and its 26 | interface mimics that of an immutable @tech[#:doc '(lib "scribblings/reference/reference.scrbl")]{hash table}. 27 | (Since this package was first released, Racket's own immutable hashes have been re-implemented as HAMTs, in C.) 28 | 29 | In addition to the functions documented here, the @tech{HAMT}s provided by this module implement the 30 | @racket[gen:dict], @racket[gen:collection], @racket[gen:sequence], and @racket[gen:sequence] generic interfaces. 31 | 32 | Hash array mapped tries are described in @cite["Bagwell2000"]. 33 | 34 | @elemtag['(caveat "hamt-mutable-keys")]{@bold{Caveat concerning mutable 35 | keys:}} If a key in an @racket[equal?]-based @tech{HAMT} is mutated 36 | (e.g., a key string is modified with @racket[string-set!]), then the 37 | @tech{HAMT}'s behavior for insertion, lookup, and remove operations 38 | becomes unpredictable. 39 | 40 | 41 | 42 | @defproc[(hamt? [v any/c]) boolean?]{ 43 | Returns @racket[#t] if @racket[v] is a @tech{HAMT}, @racket[#f] otherwise. 44 | } 45 | 46 | @deftogether[( 47 | @defproc[(hamt-equal? [hamt hamt?]) boolean?] 48 | @defproc[(hamt-eqv? [hamt hamt?]) boolean?] 49 | @defproc[(hamt-eq? [hamt hamt?]) boolean?] 50 | )]{ 51 | @racket[hamt-equal?] returns @racket[#t] if the given @tech{HAMT}'s keys are compared with @racket[equal?], @racket[#f] otherwise. 52 | @racket[hamt-eqv?] returns @racket[#t] if the given @tech{HAMT}'s keys are compared with @racket[eqv?], @racket[#f] otherwise. 53 | @racket[hamt-eq?] returns @racket[#t] if the given @tech{HAMT}'s keys are compared with @racket[eq?], @racket[#f] otherwise. 54 | } 55 | 56 | @deftogether[( 57 | @defproc[(hamt [key any/c] [val any/c] ... ...) (and/c hamt? hamt-equal?)] 58 | @defproc[(hamteqv [key any/c] [val any/c] ... ...) (and/c hamt? hamt-eqv?)] 59 | @defproc[(hamteq [key any/c] [val any/c] ... ...) (and/c hamt? hamt-eq?)] 60 | )]{ 61 | Creates a @tech{HAMT} with each @racket[key] mapped to the following @racket[val]. 62 | Each @racket[key] must have a @racket[val], so the total number of arguments must be even. 63 | 64 | The @racket[hamt] procedure creates a @tech{HAMT} where keys are compared with @racket[equal?], 65 | @racket[hamteqv] creates a @tech{HAMT} where keys are compared with @racket[eqv?], and 66 | @racket[hamteq] creates a @tech{HAMT} where keys are compared with @racket[eq?]. 67 | 68 | The @racket[key] to @racket[val] mappings are added to the table in the order they appear in 69 | the argument list, so later mappings can hide earlier ones if the @racket[key]s are equal. 70 | } 71 | 72 | @deftogether[( 73 | @defproc[(make-hamt [assocs (listof pair?) null]) (and/c hamt? hamt-equal?)] 74 | @defproc[(make-hamteqv [assocs (listof pair?) null]) (and/c hamt? hamt-eqv?)] 75 | @defproc[(make-hamteq [assocs (listof pair?) null]) (and/c hamt? hamt-eq?)] 76 | )]{ 77 | Creates a @tech{HAMT} that is initialized with the contents of @racket[assocs]. In each element of 78 | @racket[assocs], the @racket[car] is a key, and the @racket[cdr] is the corresponding value. The mappings 79 | are added to the table in the order they appear in the argument list, so later mappings can hide earlier 80 | ones if the @racket[key]s are equal. 81 | 82 | @racket[make-hamt] creates a @tech{HAMT} where the keys are compared with @racket[equal?], 83 | @racket[make-hamteqv] creates a @tech{HAMT} where the keys are compared with @racket[eqv?], and 84 | @racket[make-hamteq] creates a @tech{HAMT} where the keys are compared with @racket[eq?]. 85 | } 86 | 87 | @defproc[(hamt-set [hamt hamt?] [key any/c] [v any/c]) hamt?]{ 88 | Functionally extends @racket[hamt] by mapping @racket[key] to @racket[v], overwriting any existing mapping 89 | for @racket[key], and returning the extended @tech{HAMT}. 90 | 91 | @see-also-mutable-key-caveat[] 92 | } 93 | 94 | @defproc[(hamt-set* [hamt hamt?] [key any/c] [v any/c] ... ...) hamt?]{ 95 | Functionally extends @racket[hamt] by mapping each @racket[key] to the following @racket[v], overwriting 96 | any existing mapping for each @racket[key], and returning the extended @tech{HAMT}. Mappings are added to 97 | the table in the order they appear in the argument list, so later mappings can hide earlier ones if the 98 | @racket[key]s are equal. 99 | } 100 | 101 | @defproc[(hamt-ref [hamt hamt?] 102 | [key any/c] 103 | [failure-result any/c (λ () 104 | (raise (exn:fail:contract ....)))]) 105 | any/c]{ 106 | Returns the value for @racket[key] in @racket[hamt]. If no value is found for @racket[key], then 107 | @racket[failure-result] determines the result: 108 | 109 | @itemize[ 110 | 111 | @item{If @racket[failure-result] is a procedure, it is called 112 | (through a tail call) with no arguments to produce the result.} 113 | 114 | @item{Otherwise, @racket[failure-result] is returned as the result.} 115 | 116 | ] 117 | 118 | @see-also-mutable-key-caveat[] 119 | } 120 | 121 | @defproc[(hamt-has-key? [hamt hamt?] [key any/c]) boolean?]{ 122 | Returns @racket[#t] if @racket[hamt] contains a value for the given @racket[key], @racket[#f] otherwise. 123 | } 124 | 125 | @defproc[(hamt-has-value? [hamt hamt?] [value any/c] [equal? (-> any/c any/c boolean?) equal?]) boolean?]{ 126 | Returns @racket[#t] if @racket[hamt] contains the given @racket[value], @racket[#f] otherwise. (This 127 | function is O(n) in the size of @racket[hamt].) 128 | } 129 | 130 | 131 | @defproc[(hamt-remove [hamt hamt?] [key any/c]) hamt?]{ 132 | Functionally removes any existing mapping for @racket[key] in @racket[hamt], returning the fresh @tech{HAMT}. 133 | 134 | @see-also-mutable-key-caveat[] 135 | } 136 | 137 | @defproc[(hamt-count [hamt hamt?]) exact-nonnegative-integer?]{ 138 | Returns the number of keys mapped by @racket[hamt]. 139 | } 140 | 141 | @defproc[(hamt-empty? [hamt hamt?]) boolean?]{ 142 | Returns @racket[#t] just in case @racket[(zero? (hamt-count hamt))] is @racket[#t], @racket[#f] otherwise. 143 | } 144 | 145 | @defproc[(hamt-map [hamt hamt?] [proc (any/c any/c . -> . any/c)]) (listof any/c)]{ 146 | Applies the procedure @racket[proc] to each element of @racket[hamt] in an unspecified order, 147 | accumulating the results into a list. The procedure @racket[proc] is called each time with a 148 | key and its value. 149 | } 150 | 151 | @defproc[(hamt-for-each [hamt hamt?] [proc (any/c any/c . -> . any/c)]) void?]{ 152 | Applies the procedure @racket[proc] to each element of @racket[hamt] (for the side-effects of 153 | @racket[proc]) in an unspecified order. The procedure @racket[proc] is called each time with a 154 | key and its value. 155 | } 156 | 157 | @defproc[(hamt->list [hamt hamt?]) (listof (cons/c any/c any/c))]{ 158 | Returns a list of the key--value pairs of @racket[hamt] in an unspecified order. 159 | } 160 | 161 | @defproc[(hamt-keys [hamt hamt?]) (listof any/c)]{ 162 | Returns a list of the keys in @racket[hamt] in an unspecified order. 163 | } 164 | 165 | @defproc[(hamt-values [hamt hamt?]) (listof any/c)]{ 166 | Returns a list of the values in @racket[hamt] in an unspecified order. 167 | } 168 | 169 | @defform*[((for/hamt (for-clause ...) body-or-break ... body) 170 | (for*/hamt (for-clause ...) body-or-break ... body) 171 | (for/hamteqv (for-clause ...) body-or-break ... body) 172 | (for*/hamteqv (for-clause ...) body-or-break ... body) 173 | (for/hamteq (for-clause ...) body-or-break ... body) 174 | (for*/hamteq (for-clause ...) body-or-break ... body))]{ 175 | Like @racket[for/hash] and its variants, except that it produces a @racket[hamt], 176 | @racket[hamteqv], or @racket[hamteq]. 177 | } 178 | 179 | @section{Performance} 180 | 181 | @defmodule[data/hamt/fast] 182 | 183 | This package provides exactly the same interface as @racket[data/hamt], but the procedures that it 184 | exports are not wrapped in contracts. Therefore, passing unexpected kinds of data to these procedures will 185 | likely result in error messages that aren't especially helpful. On the other hand, they will run much 186 | faster than than their counterparts with contracts. 187 | 188 | Because @racket[data/hamt] provides essentially the same functionality as Racket's built-in @racket[hash] 189 | data type, there would be no point in using the former unless it provided some advantage over the latter. 190 | With contracts on, a @racket[hamt] is usually slower than a @racket[hash], but with contracts off, it is 191 | usually faster. (You can validate this claim using the @racket[perf.rkt] script included in the @racket[test] 192 | directory of this package.) Therefore, I recommend using @racket[data/hamt/fast] for production use. 193 | 194 | A @racket[hamt] is a tree with a branching factor of 16, so, while Racket's built-in @racket[hash] data type 195 | provides @math{O(log_2 N)} access and update, a @racket[hamt] provides the same operations at @math{O(log_16 N)}. 196 | That said, @racket[hash] has lower constant-time overhead, and it's implemented in C. My tests indicate that 197 | @racket[hash] tends to have slightly better access performance, and @racket[hamt] tends to be slightly faster 198 | at insertion and removal. (Rather perplexingly, @racket[hash] seems to perform best on all operations when given 199 | sequential fixnums as keys.) You should do your own performance testing before concluding what kind of immutable 200 | dictionary to use in your program. 201 | 202 | 203 | 204 | 205 | 206 | @bibliography[ 207 | @bib-entry[#:key "Bagwell2000" 208 | #:title "Ideal Hash Trees" 209 | #:author "Phil Bagwell" 210 | #:location "(Report). Infoscience Department, École Polytechnique Fédérale de Lausanne" 211 | #:date "2000" 212 | #:url "http://lampwww.epfl.ch/papers/idealhashtrees.pdf"] 213 | ] 214 | -------------------------------------------------------------------------------- /data/hamt/info.rkt: -------------------------------------------------------------------------------- 1 | #lang setup/infotab 2 | (define name "Immutable Hash Array Mapped Tries") 3 | (define scribblings '(("hamt.scrbl" () ("Data Structures")))) 4 | -------------------------------------------------------------------------------- /data/hamt/popcount.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/require 4 | (for-syntax racket/base) 5 | (filtered-in 6 | (λ (name) (regexp-replace #rx"unsafe-" name "")) 7 | racket/unsafe/ops)) 8 | 9 | (require (only-in rnrs/arithmetic/bitwise-6 bitwise-bit-count) 10 | racket/performance-hint) 11 | 12 | (provide popcount32) 13 | 14 | (define-inline (popcount32 n) 15 | (fx+ (vector*-ref wordbits (fxand n #xffff)) 16 | (vector*-ref wordbits (fxrshift n 16)))) 17 | 18 | (define wordbits 19 | (for/vector ([i (in-range 65536)]) 20 | (bitwise-bit-count i))) 21 | 22 | -------------------------------------------------------------------------------- /data/hamt/syntax.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require "fast.rkt" 4 | (for-syntax racket/base)) 5 | 6 | (provide (all-defined-out)) 7 | 8 | (define-syntax (for/hamt stx) 9 | (syntax-case stx () 10 | [(_ clauses . defs+exprs) 11 | (with-syntax ([original stx]) 12 | #'(for/fold/derived original ([h (hamt)]) clauses 13 | (define-values (k v) (let () . defs+exprs)) 14 | (hamt-set h k v)))])) 15 | 16 | (define-syntax (for*/hamt stx) 17 | (syntax-case stx () 18 | [(_ clauses . defs+exprs) 19 | (with-syntax ([original stx]) 20 | #'(for*/fold/derived original ([h (hamt)]) clauses 21 | (define-values (k v) (let () . defs+exprs)) 22 | (hamt-set h k v)))])) 23 | 24 | (define-syntax (for/hamteqv stx) 25 | (syntax-case stx () 26 | [(_ clauses . defs+exprs) 27 | (with-syntax ([original stx]) 28 | #'(for/fold/derived original ([h (hamteqv)]) clauses 29 | (define-values (k v) (let () . defs+exprs)) 30 | (hamt-set h k v)))])) 31 | 32 | (define-syntax (for*/hamteqv stx) 33 | (syntax-case stx () 34 | [(_ clauses . defs+exprs) 35 | (with-syntax ([original stx]) 36 | #'(for*/fold/derived original ([h (hamteqv)]) clauses 37 | (define-values (k v) (let () . defs+exprs)) 38 | (hamt-set h k v)))])) 39 | 40 | (define-syntax (for/hamteq stx) 41 | (syntax-case stx () 42 | [(_ clauses . defs+exprs) 43 | (with-syntax ([original stx]) 44 | #'(for/fold/derived original ([h (hamteq)]) clauses 45 | (define-values (k v) (let () . defs+exprs)) 46 | (hamt-set h k v)))])) 47 | 48 | (define-syntax (for*/hamteq stx) 49 | (syntax-case stx () 50 | [(_ clauses . defs+exprs) 51 | (with-syntax ([original stx]) 52 | #'(for*/fold/derived original ([h (hamteq)]) clauses 53 | (define-values (k v) (let () . defs+exprs)) 54 | (hamt-set h k v)))])) 55 | -------------------------------------------------------------------------------- /info.rkt: -------------------------------------------------------------------------------- 1 | #lang setup/infotab 2 | (define version "0.2") 3 | (define collection 'multi) 4 | (define deps '("base" "r6rs-lib" "collections-lib")) 5 | (define build-deps '("racket-doc" "rackunit-lib" "scribble-lib" "collections-lib")) 6 | -------------------------------------------------------------------------------- /tests/data/hamt/hamt.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/match 4 | rackunit 5 | data/hamt) 6 | 7 | ;; hamt[eqv, eq] constructor and predicates 8 | (let ([h (hamt)]) 9 | (check-true (hamt? h)) 10 | (check-true (hamt-equal? h))) 11 | (let ([h (hamteqv)]) 12 | (check-true (hamt? h)) 13 | (check-true (hamt-eqv? h))) 14 | (let ([h (hamteq)]) 15 | (check-true (hamt? h)) 16 | (check-true (hamt-eq? h))) 17 | 18 | (check-true (hamt? (hamt 1 2))) 19 | (check-true (hamt? (hamt 'foo "foo" 20 | 'bar "bar" 21 | 'baz "baz"))) 22 | (check-exn exn:fail:contract? (λ () (hamt 1))) 23 | (check-exn exn:fail:contract? (λ () (hamt 1 2 3 4 5))) 24 | 25 | ;; make-hamt[eqv, eq] constructor 26 | (check-true (hamt? (make-hamt))) 27 | (check-true (hamt? (make-hamteqv))) 28 | (check-true (hamt? (make-hamteq))) 29 | (check-true (hamt? (make-hamt '((foo . "foo") (bar . "bar") (baz . "baz"))))) 30 | (check-exn exn:fail:contract? (λ () (make-hamt 1 2))) 31 | 32 | ;; hamt? (positive cases are checked all over these tests) 33 | (check-false (hamt? #t)) 34 | (check-false (hamt? '(foo bar))) 35 | 36 | ;; hamt-count 37 | (define (hamt-of-size n) 38 | (for/fold ([h (hamteq)]) ([i (in-range n)]) 39 | (hamt-set h i (number->string i)))) 40 | 41 | (check-eqv? (hamt-count (hamt-of-size 0)) 0) 42 | (check-eqv? (hamt-count (hamt-of-size 1)) 1) 43 | (check-eqv? (hamt-count (hamt-of-size 2)) 2) 44 | (check-eqv? (hamt-count (hamt-of-size 10)) 10) 45 | (check-eqv? (hamt-count (hamt-of-size 100)) 100) 46 | 47 | ;; hamt-empty? 48 | (check-true (hamt-empty? (hamt-of-size 0))) 49 | (check-false (hamt-empty? (hamt-of-size 1))) 50 | 51 | ;; hamt-has-key? 52 | (define string-key "foo") 53 | (define bignum-key 999999999999999999999999999999999) 54 | (define symbol-key 'foo) 55 | 56 | (define args (list string-key "string" 57 | bignum-key "bignum" 58 | symbol-key "symbol")) 59 | 60 | (let ([h (apply hamt args)]) 61 | (check-true (hamt-has-key? h (string-copy string-key))) 62 | (check-true (hamt-has-key? h (string->number (number->string bignum-key)))) 63 | (check-true (hamt-has-key? h symbol-key)) 64 | (check-false (hamt-has-key? h 'something-else))) 65 | 66 | (let ([h (apply hamteqv args)]) 67 | (check-true (hamt-has-key? h string-key)) 68 | (check-false (hamt-has-key? h (string-copy string-key))) 69 | (check-true (hamt-has-key? h (string->number (number->string bignum-key)))) 70 | (check-true (hamt-has-key? h symbol-key)) 71 | (check-false (hamt-has-key? h 'something-else))) 72 | 73 | (let ([h (apply hamteq args)]) 74 | (check-true (hamt-has-key? h string-key)) 75 | (check-false (hamt-has-key? h (string-copy string-key))) 76 | (check-true (hamt-has-key? h bignum-key)) 77 | (check-false (hamt-has-key? h (string->number (number->string bignum-key)))) 78 | (check-true (hamt-has-key? h symbol-key)) 79 | (check-false (hamt-has-key? h 'something-else))) 80 | 81 | ;; hamt-has-value? 82 | (let ([h (hamt 0 0 1 '1 2 #\2 3 "3")]) 83 | (check-true (hamt-has-value? h 0)) 84 | (check-true (hamt-has-value? h '1)) 85 | (check-true (hamt-has-value? h #\2)) 86 | (check-true (hamt-has-value? h "3")) 87 | 88 | (check-false (hamt-has-value? h "hello")) 89 | (check-true (hamt-has-value? h (number->string 3) equal?)) 90 | (check-false (hamt-has-value? h (number->string 3) eq?))) 91 | 92 | ;; hamt-ref 93 | (let ([h (hamt-of-size 32)]) 94 | (check-equal? (hamt-ref h 0) "0") 95 | (check-equal? (hamt-ref h 7) "7") 96 | (check-equal? (hamt-ref h 31) "31") 97 | (check-exn exn:fail:contract? (λ () (hamt-ref h 'foo))) 98 | (check-false (hamt-ref h 'foo #f)) 99 | (check-equal? '(*foo*) (hamt-ref h "blah" '(*foo*)))) 100 | 101 | ;; hamt-set 102 | (let* ([h0 (hamt)] 103 | [h1a (hamt-set h0 'foo "foo")] 104 | [h1b (hamt-set h0 'foo "not-foo")] 105 | [h2 (hamt-set h1a 'bar "bar")]) 106 | (check-true (hamt-empty? h0)) 107 | (check-eqv? (hamt-count h1a) 1) 108 | (check-eqv? (hamt-count h1b) 1) 109 | (check-eqv? (hamt-count h2) 2) 110 | 111 | (check-false (hamt-ref h0 'foo #f)) 112 | (check-equal? (hamt-ref h1a 'foo) "foo") 113 | (check-equal? (hamt-ref h1b 'foo) "not-foo") 114 | (check-equal? (hamt-ref h2 'foo) "foo") 115 | (check-equal? (hamt-ref h2 'bar) "bar")) 116 | 117 | ;; hamt-set* 118 | (let ([h (hamt-set* (hamt) 'foo "foo" 'bar "bar")]) 119 | (check-equal? (hamt-ref h 'foo) "foo") 120 | (check-equal? (hamt-ref h 'bar) "bar") 121 | (check-false (hamt-ref h 'baz #f))) 122 | 123 | (check-exn exn:fail:contract? (λ () (hamt-set* (hamt) 'foo))) 124 | 125 | ;; hamt-remove 126 | (let* ([h3 (hamt 'foo "foo" 127 | 'bar "bar" 128 | 'baz "baz")] 129 | [h2 (hamt-remove h3 'bar)] 130 | [h1 (hamt-remove h2 'foo)] 131 | [h0 (hamt-remove h1 'baz)]) 132 | (check-eqv? (hamt-count h3) 3) 133 | (check-eqv? (hamt-count h2) 2) 134 | (check-eqv? (hamt-count h1) 1) 135 | (check-eqv? (hamt-count h0) 0) 136 | (check-false (hamt-has-key? h2 'bar)) 137 | (check-false (hamt-has-key? h1 'foo))) 138 | 139 | ;; hamt-map 140 | (define foobarbaz '((foo . "foo") (bar . "bar") (baz . "baz"))) 141 | (define fbb-hamt (make-hamt foobarbaz)) 142 | 143 | (check-equal? (sort (hamt-map fbb-hamt 144 | (λ (k v) (string-upcase v))) 145 | stringlist 155 | (check-equal? (sort (hamt->list fbb-hamt) 156 | stringstring) 164 | '(bar baz foo)) 165 | 166 | ;; hamt-values 167 | (check-equal? (sort (hamt-values fbb-hamt) stringstring 10 | (map integer->char 11 | (for/list ([i (in-range 1 (add1 (random 20)))]) 12 | (random 256))))) 13 | 14 | 15 | (define N 500000) 16 | 17 | 18 | (define (gc) 19 | (collect-garbage) 20 | (collect-garbage) 21 | (collect-garbage)) 22 | 23 | (define-syntax-rule (run keys kons set ref remove) 24 | (begin 25 | (printf "\n") 26 | (printf " - ~a\n" 'kons) 27 | (printf " -- insertion\n") (gc) 28 | (let ([h (time (for/fold ([h (kons)]) ([k (in-list keys)]) (set h k #t)))]) 29 | (printf " -- lookup\n") (gc) 30 | (time (for ([k (in-list keys)]) (ref h k))) 31 | (printf " -- removal\n") (gc) 32 | (void (time (for/fold ([h h]) ([k (in-list keys)]) (remove h k))))))) 33 | 34 | (printf "1. random string keys [equal?]\n") 35 | (let ([keys (for/list ([i N]) (random-key))]) 36 | (run keys hash hash-set hash-ref hash-remove) 37 | (run keys hamt hamt-set hamt-ref hamt-remove) 38 | (run keys f:hamt f:hamt-set f:hamt-ref f:hamt-remove)) 39 | 40 | (printf "\n2. sequential integer keys [eqv?]\n") 41 | (let ([keys (for/list ([i (in-range N)]) i)]) 42 | (run keys hasheqv hash-set hash-ref hash-remove) 43 | (run keys hamteqv hamt-set hamt-ref hamt-remove) 44 | (run keys f:hamteqv f:hamt-set f:hamt-ref f:hamt-remove)) 45 | 46 | (printf "\n3. random integer keys [eqv?]\n") 47 | (let ([keys (for/list ([i (in-range N)]) (random 1000000000))]) 48 | (run keys hasheqv hash-set hash-ref hash-remove) 49 | (run keys hamteqv hamt-set hamt-ref hamt-remove) 50 | (run keys f:hamteqv f:hamt-set f:hamt-ref f:hamt-remove)) 51 | 52 | (printf "\n4. random symbol keys [eq?]\n") 53 | (let ([keys (for/list ([i (in-range N)]) (string->symbol (random-key)))]) 54 | (run keys hasheq hash-set hash-ref hash-remove) 55 | (run keys hamteq hamt-set hamt-ref hamt-remove) 56 | (run keys f:hamteq f:hamt-set f:hamt-ref f:hamt-remove)) 57 | --------------------------------------------------------------------------------