From 7700b3d73640644eeaf034a49f420107e6861e2e Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Fri, 17 Jul 2015 15:21:24 -0500 Subject: [PATCH] Move contents of unstable/hash to racket/hash. --- .../scribblings/reference/hashes.scrbl | 68 +++++++++++++++++++ pkgs/racket-test-core/tests/racket/all.rktl | 1 + pkgs/racket-test-core/tests/racket/hash.rktl | 36 ++++++++++ racket/collects/racket/hash.rkt | 45 ++++++++++++ 4 files changed, 150 insertions(+) create mode 100644 pkgs/racket-test-core/tests/racket/hash.rktl create mode 100644 racket/collects/racket/hash.rkt diff --git a/pkgs/racket-doc/scribblings/reference/hashes.scrbl b/pkgs/racket-doc/scribblings/reference/hashes.scrbl index b7349cb1fb..9da8e089a1 100644 --- a/pkgs/racket-doc/scribblings/reference/hashes.scrbl +++ b/pkgs/racket-doc/scribblings/reference/hashes.scrbl @@ -496,3 +496,71 @@ inspectable structure fields. See also @racket[gen:equal+hash].} Like @racket[equal-hash-code], but computes a secondary value suitable for use in double hashing.} + +@;------------------------------------------------------------------------ +@section{Additional Hash Table Functions} + +@note-lib-only[racket/hash] + +@(define the-eval (make-base-eval)) +@(the-eval '(require racket/hash)) + +@defproc[(hash-union [h0 (and/c hash? hash-can-functional-set?)] + [h hash?] ... + [#:combine combine + (-> any/c any/c any/c) + (lambda _ (error 'hash-union ....))] + [#:combine/key combine/key + (-> any/c any/c any/c any/c) + (lambda (k a b) (combine a b))]) + (and/c hash? hash-can-functional-set?)]{ + +Computes the union of @racket[h0] with each hash table @racket[h] by functional +update, adding each element of each @racket[h] to @racket[h0] in turn. For each +key @racket[k] and value @racket[v], if a mapping from @racket[k] to some value +@racket[v0] already exists, it is replaced with a mapping from @racket[k] to +@racket[(combine/key k v0 v)]. + +@defexamples[ +#:eval the-eval +(hash-union (make-immutable-hash '([1 . one])) + (make-immutable-hash '([2 . two])) + (make-immutable-hash '([3 . three]))) +(hash-union (make-immutable-hash '([1 . (one uno)] [2 . (two dos)])) + (make-immutable-hash '([1 . (ein une)] [2 . (zwei deux)])) + #:combine/key (lambda (k v1 v2) (append v1 v2))) +] + +} + +@defproc[(hash-union! [h0 (and/c hash? hash-mutable?)] + [h hash?] ... + [#:combine combine + (-> any/c any/c any/c) + (lambda _ (error 'hash-union ....))] + [#:combine/key combine/key + (-> any/c any/c any/c any/c) + (lambda (k a b) (combine a b))]) + void?]{ + +Computes the union of @racket[h0] with each hash table @racket[h] by mutable +update, adding each element of each @racket[h] to @racket[h0] in turn. For each +key @racket[k] and value @racket[v], if a mapping from @racket[k] to some value +@racket[v0] already exists, it is replaced with a mapping from @racket[k] to +@racket[(combine/key k v0 v)]. + +@defexamples[ +#:eval the-eval +(define h (make-hash)) +h +(hash-union! h (make-immutable-hash '([1 . (one uno)] [2 . (two dos)]))) +h +(hash-union! h + (make-immutable-hash '([1 . (ein une)] [2 . (zwei deux)])) + #:combine/key (lambda (k v1 v2) (append v1 v2))) +h +] + +} + +@(close-eval the-eval) diff --git a/pkgs/racket-test-core/tests/racket/all.rktl b/pkgs/racket-test-core/tests/racket/all.rktl index a0ce6a64db..9822b25cfb 100644 --- a/pkgs/racket-test-core/tests/racket/all.rktl +++ b/pkgs/racket-test-core/tests/racket/all.rktl @@ -8,6 +8,7 @@ (load-in-sandbox "list.rktl") (load-in-sandbox "math.rktl") (load-in-sandbox "vector.rktl") +(load-in-sandbox "hash.rktl") (load-in-sandbox "function.rktl") (load-in-sandbox "dict.rktl") (load-in-sandbox "fixnum.rktl") diff --git a/pkgs/racket-test-core/tests/racket/hash.rktl b/pkgs/racket-test-core/tests/racket/hash.rktl new file mode 100644 index 0000000000..fff84814a3 --- /dev/null +++ b/pkgs/racket-test-core/tests/racket/hash.rktl @@ -0,0 +1,36 @@ + +(load-relative "loadtest.rktl") + +(Section 'hash) + +(require racket/hash) + +(test #hash([4 . four] [3 . three] [1 . one] [2 . two]) + hash-union #hash([1 . one] [2 . two]) #hash([3 . three] [4 . four])) +(test #hash([four . 4] [three . 3] [one . 1] [two . 2]) + hash-union #hash([one . 1] [two . 1]) #hash([three . 3] [four . 4] [two . 1]) + #:combine +) + +(let () + (define h (make-hash)) + (hash-union! h #hash([1 . one] [2 . two])) + (hash-union! h #hash([3 . three] [4 . four])) + (test #t + equal? + (hash-copy + #hash([1 . one] [2 . two] [3 . three] [4 . four])) + h)) +(let () + (define h (make-hash)) + (hash-union! h #hash([one . 1] [two . 1])) + (err/rt-test (hash-union! h #hash([three . 3] [four . 4] [two . 1])) exn:fail?)) +(let () + (define h (make-hash)) + (hash-union! h #hash([one . 1] [two . 1])) + (hash-union! h #hash([three . 3] [four . 4] [two . 1]) + #:combine/key (lambda (k x y) (+ x y))) + (test #t + equal? + (hash-copy + #hash([one . 1] [two . 2] [three . 3] [four . 4])) + h)) diff --git a/racket/collects/racket/hash.rkt b/racket/collects/racket/hash.rkt new file mode 100644 index 0000000000..961ec1b71b --- /dev/null +++ b/racket/collects/racket/hash.rkt @@ -0,0 +1,45 @@ +#lang racket/base +(require racket/contract/base) + +(define ((hash-duplicate-error name) key value1 value2) + (error name "duplicate values for key ~e: ~e and ~e" key value1 value2)) + +(define (hash-union + #:combine [combine #f] + #:combine/key [combine/key + (if combine + (lambda (k x y) (combine x y)) + (hash-duplicate-error 'hash-union))] + one . rest) + (for*/fold ([one one]) ([two (in-list rest)] [(k v) (in-hash two)]) + (hash-set one k (if (hash-has-key? one k) + (combine/key k (hash-ref one k) v) + v)))) + +(define (hash-union! + #:combine [combine #f] + #:combine/key [combine/key + (if combine + (lambda (k x y) (combine x y)) + (hash-duplicate-error 'hash-union))] + one . rest) + (for* ([two (in-list rest)] [(k v) (in-hash two)]) + (hash-set! one k (if (hash-has-key? one k) + (combine/key k (hash-ref one k) v) + v)))) + +(provide/contract + [hash-union (->* [(and/c hash? immutable?)] + [#:combine + (-> any/c any/c any/c) + #:combine/key + (-> any/c any/c any/c any/c)] + #:rest (listof hash?) + (and/c hash? immutable?))] + [hash-union! (->* [(and/c hash? (not/c immutable?))] + [#:combine + (-> any/c any/c any/c) + #:combine/key + (-> any/c any/c any/c any/c)] + #:rest (listof hash?) + void?)])