added hash-ref! and hash-has-key?

svn: r14423

collects/scheme/private/more-scheme.ss

@@ -360,7 +360,7 @@
   (define-log log-info info)
   (define-log log-debug debug)
 
-  (define-values (hash-update hash-update!)
+  (define-values (hash-update hash-update! hash-has-key? hash-ref!)
     (let* ([not-there (gensym)]
            [up (lambda (who mut? set ht key xform default)
                  (unless (and (hash? ht)
@@ -385,8 +385,19 @@
               [(ht key xform default)
                (up 'hash-update! #t hash-set! ht key xform default)]
               [(ht key xform)
-               (hash-update! ht key xform not-there)])])
-        (values hash-update hash-update!))))
+               (hash-update! ht key xform not-there)])]
+            [hash-has-key?
+             (lambda (ht key)
+               (not (eq? not-there (hash-ref ht key not-there))))]
+            [hash-ref!
+             (lambda (ht key new)
+               (let ([v (hash-ref ht key not-there)])
+                 (if (eq? not-there v)
+                   (let ([n (if (procedure? new) (new) new)])
+                     (hash-set! ht key n)
+                     n)
+                   v)))])
+        (values hash-update hash-update! hash-has-key? hash-ref!))))
 
   (#%provide case old-case do
              parameterize parameterize* current-parameterization call-with-parameterization
@@ -395,4 +406,4 @@
              set!-values
              let/cc fluid-let time
              log-fatal log-error log-warning log-info log-debug
-             hash-update hash-update!))
+             hash-ref! hash-has-key? hash-update hash-update!))

collects/scribblings/reference/hashes.scrbl

@@ -181,7 +181,6 @@ returning the extended hash table.
 
 @see-also-mutable-key-caveat[]}
 
-
 @defproc[(hash-ref [hash hash?]
                    [key any/c]
                    [failure-result any/c (lambda () 
@@ -203,6 +202,23 @@ result:
 
 @see-also-caveats[]}
 
+@defproc[(hash-ref! [hash hash?] [key any/c] [to-set any/c])
+         any]{
+
+Returns the value for @scheme[key] in @scheme[hash].  If no value is
+found for @scheme[key], then @scheme[to-set] determines the result as
+in @scheme[hash-ref] (i.e., it is either a thunk that computes a value
+or a plain value), and this result is stored in @scheme[hash] for the
+@scheme[key].  (Note that is @scheme[to-set] is a thunk, it is not
+invoked in tail position.)}
+
+
+@defproc[(hash-has-key? [hash hash?] [key any/c])
+         any]{
+
+Returns a true value if @scheme[hash] contains the given
+@scheme[key].}
+
 
 @defproc[(hash-update! [hash (and/c hash? (not/c immutable?))]
                        [key any/c]

collects/tests/mzscheme/basic.ss

@@ -1920,7 +1920,7 @@
 
 (define (hash-tests make-hash make-hasheq make-hasheqv
                     make-weak-hash make-weak-hasheq make-weak-hasheqv
-                    hash-ref hash-set! hash-update!
+                    hash-ref hash-set! hash-ref! hash-update! hash-has-key?
                     hash-remove! hash-count
                     hash-map hash-for-each
                     hash-iterate-first hash-iterate-next
@@ -1942,6 +1942,14 @@
       (test #t eq? (equal-hash-code l) (equal-hash-code (list 1 2 3)))
       (hash-set! h1 l 'ok)
       (test 'ok hash-ref h1 l)
+      (test #t hash-has-key? h1 l)
+      (test #f hash-has-key? h1 (cdr l))
+      (when hash-ref!
+        (test 'ok hash-ref! h1 l 'blah)
+        (test 'blah hash-ref! h1 (cdr l) 'blah)
+        (test #t hash-has-key? h1 (cdr l))
+        (test 'blah hash-ref h1 (cdr l))
+        (hash-remove! h1 (cdr l)))
       (hash-update! h1 l (curry cons 'more))
       (test '(more . ok) hash-ref h1 l)
       (hash-update! h1 l cdr)
@@ -2086,7 +2094,7 @@
 
 (hash-tests make-hash make-hasheq make-hasheqv
             make-weak-hash make-weak-hasheq make-weak-hasheqv
-            hash-ref hash-set! hash-update!
+            hash-ref hash-set! hash-ref! hash-update! hash-has-key?
             hash-remove! hash-count
             hash-map hash-for-each
             hash-iterate-first hash-iterate-next
@@ -2101,9 +2109,11 @@
               #f #f #f
               (ub-wrap hash-ref)
               (lambda (ht k v) (set-box! ht (hash-set (unbox ht) k v)))
-              (case-lambda 
+              #f
+              (case-lambda
                [(ht k u) (set-box! ht (hash-update (unbox ht) k u))]
                [(ht k u def) (set-box! ht (hash-update (unbox ht) k u def))])
+              (ub-wrap hash-has-key?)
               (lambda (ht k) (set-box! ht (hash-remove (unbox ht) k)))
               (ub-wrap hash-count)
               (ub-wrap hash-map)