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