189 lines
8.7 KiB
Plaintext
189 lines
8.7 KiB
Plaintext
;;;; (map-remove m k) — the operation a Map has been missing.
|
|
;;;;
|
|
;;;; Removal is the one map operation that can break the *other* ones: a
|
|
;;;; lookup stops at the first group of slots holding an empty one, so a slot
|
|
;;;; emptied in the middle of a probe sequence hides every entry placed past
|
|
;;;; it, and the entries it hides are found by no test that only removes and
|
|
;;;; asks about what it removed. So the rows below are mostly about the
|
|
;;;; survivors.
|
|
;;;;
|
|
;;;; A removed slot is marked deleted, and emptied outright only where no probe
|
|
;;;; can have passed through it. A version that emptied every removed slot
|
|
;;;; passes row 1 and fails row 3; a version whose deleted slots were never
|
|
;;;; swept grows without end under row 7.
|
|
(defstruct Cell [x i32 y i32])
|
|
|
|
;; Row 7's allocator and its count of refusals. Globals, because a handler
|
|
;; cannot see the locals of the function that established it.
|
|
(defonce churn-alloc Allocator)
|
|
(defonce churn-refusals i64)
|
|
;; Row 7's reference: a global array rather than a Vec, because a Vec would
|
|
;; take its block from the same process heap the budget is counting.
|
|
(defonce churn-ref [512 i64])
|
|
|
|
(defn main [] i32
|
|
;; (1) The value comes back, the length drops, and the key is gone. An
|
|
;; absent key is None and changes nothing — the same answer get gives, since
|
|
;; a key that was not there is an answer and not a failure.
|
|
(let [m (map-new i32 i64)]
|
|
(put m 1 100)
|
|
(put m 2 200)
|
|
(match (map-remove m 1)
|
|
(Some v) (do (print v) (println "")) ; 100
|
|
None (println "missing"))
|
|
(print (length m)) (println "") ; 1
|
|
(print (has-key m 1)) (println "") ; false
|
|
(match (map-remove m 1) (Some v) (do (print v) (println "")) None (println "gone"))
|
|
(println (length m)) ; gone, then 1
|
|
(free m))
|
|
|
|
;; (2) Removing every entry empties the map, and it is usable afterwards:
|
|
;; the block is still there and the slots are empty rather than poisoned.
|
|
(let [m (map-new i32 i32)]
|
|
(dotimes [i 64] (put m i i))
|
|
(dotimes [i 64] (map-remove m i))
|
|
(print (length m)) (println "") ; 0
|
|
(put m 7 77)
|
|
(match (get m 7) (Some v) (do (print v) (println "")) None (println "?")) ; 77
|
|
(print (length m)) (println "") ; 1
|
|
(free m))
|
|
|
|
;; (3) The survivors, which is the row that matters. 2000 entries is eight
|
|
;; grows, so the runs are long and interleaved; removing the even keys and
|
|
;; then asking after every odd one is asking whether any probe sequence was
|
|
;; cut.
|
|
(let [m (map-new i32 i64)]
|
|
(dotimes [i 2000] (put m i (* (i64 i) 3)))
|
|
(let [taken 0]
|
|
(dotimes [i 2000]
|
|
(if (= 0 (% i 2))
|
|
(match (map-remove m i)
|
|
(Some v) (if (= v (* (i64 i) 3)) (set taken (+ taken 1)))
|
|
None (set taken taken))))
|
|
(print taken) (println "")) ; 1000
|
|
(print (length m)) (println "") ; 1000
|
|
(let [lost 0 ghosts 0]
|
|
(dotimes [i 2000]
|
|
(match (get m i)
|
|
(Some v) (if (or (= 0 (% i 2)) (not (= v (* (i64 i) 3))))
|
|
(set ghosts (+ ghosts 1)))
|
|
None (if (not (= 0 (% i 2))) (set lost (+ lost 1)))))
|
|
(print lost) (println "") ; 0
|
|
(print ghosts) (println "")) ; 0
|
|
;; Re-inserting what was taken out puts the length back, through no grow:
|
|
;; the block still has the room the removals freed up.
|
|
(dotimes [i 2000] (if (= 0 (% i 2)) (put m i (* (i64 i) 3))))
|
|
(print (length m)) (println "") ; 2000
|
|
(free m))
|
|
|
|
;; (4) A struct key and a string key, so the emitted hash/equality pair is
|
|
;; on the removal path too and not only on get's.
|
|
(let [g (map-new Cell i32)]
|
|
(dotimes [i 20] (dotimes [j 20] (put g (Cell {.x i .y j}) (+ (* i 100) j))))
|
|
(match (map-remove g (Cell {.x 7 .y 9}))
|
|
(Some v) (do (print v) (println "")) ; 709
|
|
None (println "?"))
|
|
(print (has-key g (Cell {.x 7 .y 9}))) (println "") ; false
|
|
(print (has-key g (Cell {.x 7 .y 10}))) (println "") ; true
|
|
(print (length g)) (println "") ; 399
|
|
(free g))
|
|
|
|
(let [s (map-new str i32)]
|
|
(put s "alpha" 1)
|
|
(put s "beta" 2)
|
|
(match (map-remove s "alpha")
|
|
(Some v) (do (print v) (println "")) ; 1
|
|
None (println "?"))
|
|
(print (has-key s "beta")) (println "") ; true
|
|
(print (length s)) (println "") ; 1
|
|
(free s))
|
|
|
|
;; (5) Iteration after removals answers exactly the survivors.
|
|
(let [m (map-new i32 i32)]
|
|
(dotimes [i 100] (put m i i))
|
|
(dotimes [i 100] (if (= 0 (% i 3)) (map-remove m i)))
|
|
(let [cur (i64 0) k 0 v 0 seen 0 sum 0]
|
|
(while (map-next m (addr cur) (addr k) (addr v))
|
|
(set seen (+ seen 1))
|
|
(if (not (= k v)) (set sum (+ sum 1))))
|
|
(print seen) (println "") ; 66
|
|
(print sum) (println "")) ; 0
|
|
(print (length m)) (println "") ; 66
|
|
(free m))
|
|
|
|
;; (6) An arena, which refuses can-free. Removal asks the allocator for
|
|
;; nothing and hands it back nothing — a key and a value live inside the one
|
|
;; block the map allocated — so it means here exactly what it means on the
|
|
;; heap, and the region is released whole as always.
|
|
(let [ar (arena-new 1048576)]
|
|
(with-allocator ar
|
|
(let [t (map-new i32 i32)]
|
|
(dotimes [i 300] (put t i (* i 2)))
|
|
(dotimes [i 300] (if (= 0 (% i 2)) (map-remove t i)))
|
|
(print (length t)) (println "") ; 150
|
|
(match (get t 299) (Some v) (do (print v) (println "")) None (println "?")) ; 598
|
|
(print (has-key t 298)) (println ""))) ; false
|
|
(free-all ar)
|
|
(arena-destroy ar))
|
|
|
|
;; (7) Churn at a steady size, checked against a plain array. Keys are drawn
|
|
;; from 512 and the map holds about two thirds of them, so removals leave
|
|
;; deleted slots that inserts must reuse and rebuilds must sweep. Every get is
|
|
;; checked against the array, and at the end so is the length and a full walk.
|
|
;;
|
|
;; The process heap is given a budget of 20000 bytes, with nothing else of
|
|
;; this program's live on it. An i32 key and an i64
|
|
;; value make a 16-byte slot, so the 512-slot block is 8768 bytes and a
|
|
;; rebuild at that size holds two of them, 17536; a grow to 1024 slots holds
|
|
;; 8768 and 17472 at once and goes over. The entries never need more than 512
|
|
;; slots, so a refusal means deleted slots were used up and the table doubled
|
|
;; instead of sweeping them — which is what a version that never swept them
|
|
;; does. The handler lets it through, counts it, and the count is printed.
|
|
(set churn-alloc (heap-allocator))
|
|
(set-alloc-budget churn-alloc 20000)
|
|
(handler-bind
|
|
[(StorageExhausted [c]
|
|
(set churn-refusals (+ churn-refusals 1))
|
|
(set-alloc-budget churn-alloc (* 2 (alloc-budget churn-alloc)))
|
|
(invoke-restart 'retry))]
|
|
(let [m (map-new i32 i64 churn-alloc)
|
|
x (u64 12345)
|
|
bad 0
|
|
live 0]
|
|
(dotimes [i 512] (set (at churn-ref i) (i64 -1)))
|
|
(dotimes [step 200000]
|
|
(set x (+ (* x (u64 6364136223846793005)) (u64 1442695040888963407)))
|
|
(let [k (i32 (% (>> x 33) (u64 512)))
|
|
op (i32 (% (>> x 20) (u64 4)))]
|
|
(if (< op 2)
|
|
(do (if (< (at churn-ref k) 0) (set live (+ live 1)))
|
|
(put m k (i64 step))
|
|
(set (at churn-ref k) (i64 step)))
|
|
(if (= op 2)
|
|
(match (map-remove m k)
|
|
(Some v) (do (if (not (= v (at churn-ref k))) (set bad (+ bad 1)))
|
|
(set (at churn-ref k) (i64 -1))
|
|
(set live (- live 1)))
|
|
None (if (>= (at churn-ref k) 0) (set bad (+ bad 1))))
|
|
(match (get m k)
|
|
(Some v) (if (not (= v (at churn-ref k))) (set bad (+ bad 1)))
|
|
None (if (>= (at churn-ref k) 0) (set bad (+ bad 1))))))))
|
|
(print bad) (println "") ; 0
|
|
(print (= (length m) (i64 live))) (println "") ; true
|
|
(let [cur (i64 0) k 0 v (i64 0) seen 0]
|
|
(while (map-next m (addr cur) (addr k) (addr v))
|
|
(set seen (+ seen 1))
|
|
(if (not (= v (at churn-ref k))) (set bad (+ bad 1))))
|
|
(print (= seen live)) (println "") ; true
|
|
(print bad) (println "")) ; 0
|
|
;; Removing while walking visits every survivor once: nothing moves.
|
|
(let [cur (i64 0) k 0 v (i64 0) seen 0]
|
|
(while (map-next m (addr cur) (addr k) (addr v))
|
|
(set seen (+ seen 1))
|
|
(map-remove m k))
|
|
(print (= seen live)) (println "") ; true
|
|
(print (length m)) (println "")) ; 0
|
|
(free m)))
|
|
(print churn-refusals) (println "") ; 0
|
|
0)
|