src/code/maphash.lisp

   1 ;;;; The implementations of MAPHASH and WITH-HASH-TABLE-ITERATOR,
   2 ;;;; which should remain roughly in sync.
   3
   4 ;;;; This software is part of the SBCL system. See the README file for
   5 ;;;; more information.
   6 ;;;;
   7 ;;;; This software is derived from the CMU CL system, which was
   8 ;;;; written at Carnegie Mellon University and released into the
   9 ;;;; public domain. The software is in the public domain and is
  10 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  11 ;;;; files for more information.
  12
  13 (in-package "SB!IMPL")
  14
  15 (define-compiler-macro maphash (&whole form function-designator hash-table
  16                                 &environment env)
  17   (when (sb!c:policy env (> space speed))
  18     (return-from maphash form))
  19   (with-unique-names (fun table size i kv-vector key value)
  20     `(let* ((,fun (%coerce-callable-to-fun ,function-designator))
  21             (,table ,hash-table)
  22             (,size (* 2 (length (hash-table-next-vector ,table)))))
  23        ;; Regarding this TRULY-THE: in the theoretical edge case of the largest
  24        ;; possible NEXT-VECTOR, it is not really true that the I+2 is an index.
  25        ;; However, for all intents and purposes, it is an INDEX because if not,
  26        ;; the table's vectors would consume literally all addressable memory.
  27        ;; And it can't overflow a fixnum even in theory, since ARRAY-DIMENSION-LIMIT
  28        ;; is smaller than most-positive-fixnum by enough to allow adding 2.
  29        ;; And it doesn't matter anyway - the compiler uses unsigned word
  30        ;; arithmetic here on account of (* 2 length) exceeding a fixnum.
  31        (do ((,i 3 (truly-the index (+ ,i 2))))
  32            ((>= ,i ,size))
  33         ;; We are running without locking or WITHOUT-GCING. For a weak
  34         ;; :VALUE hash table it's possible that the GC hit after KEY
  35         ;; was read and now the entry is gone. So check if either the
  36         ;; key or the value is empty.
  37          (let* ((,kv-vector (hash-table-table ,table))
  38                 (,value (aref ,kv-vector ,i)))
  39            (unless (eq ,value +empty-ht-slot+)
  40              (let ((,key
  41                     ;; I is bounded below by 3, and bounded above by INDEX max,
  42                     ;; so (1- I) isn't checked for being an INDEX, but would
  43                     ;; nonetheless be checked against the array bound despite
  44                     ;; being obviously valid; so we force elision of the test.
  45                     (locally (declare (optimize (sb!c::insert-array-bounds-checks 0)))
  46                       (aref ,kv-vector (1- ,i)))))
  47                (unless (eq ,key +empty-ht-slot+)
  48                  (funcall ,fun ,key ,value)))))))))
  49
  50 (defun maphash (function-designator hash-table)
  51   #!+sb-doc
  52   "For each entry in HASH-TABLE, call the designated two-argument function on
  53 the key and value of the entry. Return NIL.
  54
  55 Consequences are undefined if HASH-TABLE is mutated during the call to
  56 MAPHASH, except for changing or removing elements corresponding to the
  57 current key. The applies to all threads, not just the current one --
  58 even for synchronized hash-tables. If the table may be mutated by
  59 another thread during iteration, use eg. SB-EXT:WITH-LOCKED-HASH-TABLE
  60 to protect the MAPHASH call."
  61   (maphash function-designator hash-table)) ; via compiler-macro
  62
  63 (defmacro with-hash-table-iterator ((name hash-table) &body body)
  64   #!+sb-doc
  65   "WITH-HASH-TABLE-ITERATOR ((name hash-table) &body body)
  66
  67 Provides a method of manually looping over the elements of a hash-table. NAME
  68 is bound to a generator-macro that, within the scope of the invocation,
  69 returns one or three values. The first value tells whether any objects remain
  70 in the hash table. When the first value is non-NIL, the second and third
  71 values are the key and the value of the next object.
  72
  73 Consequences are undefined if HASH-TABLE is mutated during execution of BODY,
  74 except for changing or removing elements corresponding to the current key. The
  75 applies to all threads, not just the current one -- even for synchronized
  76 hash-tables. If the table may be mutated by another thread during iteration,
  77 use eg. SB-EXT:WITH-LOCKED-HASH-TABLE to protect the WITH-HASH-TABLE-ITERATOR
  78 for."
  79   (let ((function (make-symbol (concatenate 'string (symbol-name name) "-FUN"))))
  80     `(let ((,function
  81             (let* ((table ,hash-table)
  82                    (size (* 2 (length (hash-table-next-vector table))))
  83                    (index 3))
  84               (declare (fixnum index))
  85               (labels
  86                   ((,name ()
  87                      ;; (We grab the table again on each iteration just in
  88                      ;; case it was rehashed by a PUTHASH.)
  89                      (let ((kv-vector (hash-table-table table)))
  90                        (loop
  91                         (when (>= index size) (return nil))
  92                         (let ((i index))
  93                           (incf (truly-the index index) 2)
  94                           (let ((value (aref kv-vector i)))
  95                             (unless (eq value +empty-ht-slot+)
  96                               (let ((key
  97                                      (locally
  98                                       (declare (optimize (sb!c::insert-array-bounds-checks 0)))
  99                                       (aref kv-vector (1- i)))))
 100                                 (unless (eq key +empty-ht-slot+)
 101                                   (return (values t key value)))))))))))
 102                 #',name))))
 103        (macrolet ((,name () '(funcall ,function)))
 104          ,@body))))