Merge pull request mighty-gerbils#588 from fare-patches/misc

std/misc/hash: add hash-ref/default

doc/reference/misc.md

@@ -1622,6 +1622,15 @@ length: 3
 ```
 :::
 
+### hash-ref/default
+``` scheme
+(hash-ensure-ref table key default) -> value
+```
+
+Checks whether the given *key* is present in the *table*.
+If it is, return the associated value.
+If it is not, call the *default* thunk and return its value.
+
 ### hash-ensure-ref
 ``` scheme
 (hash-ensure-ref table key default) -> value

src/std/misc/hash-test.ss

@@ -17,6 +17,12 @@
     (test-case "hash->list/sort"
       (check (hash->list/sort (hash (3 "c") (1 "a") (5 "e") (4 "d") (2 "b")) <)
              => '((1 . "a") (2 . "b") (3 . "c") (4 . "d") (5 . "e"))))
+    (test-case "hash-ref/default"
+      (def h (hash (a 1) (b 2)))
+      (check (hash-ref/default h 'a error) => 1)
+      (check (hash-ref/default h 'b error) => 2)
+      (check (hash-ref/default h 'c (lambda () 3)) => 3)
+      (check (hash-ref/default h 'c (lambda () 5)) => 5))
     (test-case "hash-ensure-ref"
       (def h (hash (a 1) (b 2)))
       (check (hash-ensure-ref h 'a error) => 1)

src/std/misc/hash.ss

@@ -4,6 +4,7 @@
 
 (export
   hash-empty?
+  hash-ref/default
   hash-ensure-ref
   invert-hash
   invert-hash/fold
@@ -36,17 +37,20 @@
 
 ;; type (Table V K) ;; hash-tables mapping key K to values V (note that V comes before K)
 
-;; Lookup a table for a
-;; If the key is missing, compute a default value, and put it in the table.
+;; Lookup a table. If the key is missing, compute and return a default value.
 ;; : V <- (Table V K) K (V <-)
-(def (hash-ensure-ref table key default)
+(def (hash-ref/default table key default)
   (let ((val (hash-ref table key %none)))
     (if (eq? val %none)
-      (let ((value (default)))
-        (hash-put! table key value)
-        value)
+      (default)
       val)))
 
+;; Lookup a table. If the key is missing, compute a default value *and* put it in the table.
+;; : V <- (Table V K) K (V <-)
+(def (hash-ensure-ref table key default)
+  (hash-ref/default
+   table key (cut let (value (default)) (hash-put! table key value) value)))
+
 ;; Given a hash-table to (a new equal? hash-table by default,
 ;; but e.g. an eqv? or eq? hash-table could be given instead), invert the hash-table from
 ;; by storing in the hash-table a map from vector value back to map key.