From 3a525b9a121de971967b59ab3a684b5d104b53ed Mon Sep 17 00:00:00 2001 From: Carl Eastlund Date: Sat, 29 May 2010 14:49:50 -0400 Subject: [PATCH] Replaced unstable/hash with unstable/cce/hash. --- collects/tests/unstable/hash.rkt | 53 +++++ collects/typed-scheme/infer/constraints.rkt | 2 +- collects/typed-scheme/infer/dmap.rkt | 3 +- collects/unstable/cce/hash.ss | 136 ----------- collects/unstable/cce/reference/hash.scrbl | 223 ------------------- collects/unstable/cce/reference/manual.scrbl | 1 - collects/unstable/cce/test/test-hash.ss | 74 ------ collects/unstable/cce/test/test-main.ss | 2 - collects/unstable/hash.rkt | 82 ++++++- collects/unstable/scribblings/hash.scrbl | 191 ++++++++++++++-- 10 files changed, 295 insertions(+), 472 deletions(-) create mode 100644 collects/tests/unstable/hash.rkt delete mode 100644 collects/unstable/cce/hash.ss delete mode 100644 collects/unstable/cce/reference/hash.scrbl delete mode 100644 collects/unstable/cce/test/test-hash.ss diff --git a/collects/tests/unstable/hash.rkt b/collects/tests/unstable/hash.rkt new file mode 100644 index 0000000000..1501aaec56 --- /dev/null +++ b/collects/tests/unstable/hash.rkt @@ -0,0 +1,53 @@ +#lang racket + +(require rackunit rackunit/text-ui unstable/hash "helpers.rkt") + +(run-tests + (test-suite "hash.ss" + (test-suite "hash-equal?" + (test (check-true (hash-equal? #hash()))) + (test (check-false (hash-equal? #hasheq()))) + (test (check-false (hash-equal? #hasheqv())))) + (test-suite "hash-ref/check" + (test-ok (check-equal? (hash-ref/check #hash([1 . one] [2 . two]) 1) + 'one)) + (test-bad (hash-ref/check #hash([1 . one] [2 . two]) 3))) + (test-suite "hash-ref/identity" + (test-ok (check-equal? (hash-ref/identity #hash([1 . one] [2 . two]) 1) + 'one)) + (test-ok (check-equal? (hash-ref/identity #hash([1 . one] [2 . two]) 3) + 3))) + (test-suite "hash-ref/default" + (test-ok (check-equal? (hash-ref/default #hash([1 . one] [2 . two]) 1 '?) + 'one)) + (test-ok (check-equal? (hash-ref/default #hash([1 . one] [2 . two]) 3 '?) + '?))) + (test-suite "hash-ref/failure" + (test-ok (define x 7) + (define (f) (set! x (+ x 1)) x) + (check-equal? (hash-ref/failure #hash([1 . one] [2 . two]) 1 f) + 'one) + (check-equal? x 7) + (check-equal? (hash-ref/failure #hash([1 . one] [2 . two]) 3 f) + 8) + (check-equal? x 8))) + (test-suite "hash-has-key?" + (test-ok (check-equal? (hash-has-key? #hash([1 . one] [2 . two]) 1) #t)) + (test-ok (check-equal? (hash-has-key? #hash([1 . one] [2 . two]) 3) #f))) + (test-suite "hash-domain" + (test-ok (check-equal? (hash-domain #hash([1 . one] [2 . two])) '(1 2)))) + (test-suite "hash-range" + (test-ok (check-equal? (hash-range #hash([1 . one] [2 . two])) + '(one two)))) + (test-suite "hash-union" + (test-ok (hash-union #hash([1 . one] [2 . two]) + #hash([3 . three] [4 . four])) + #hash([4 . four] [3 . three] [1 . one] [2 . two]))) + (test-suite "hash-union!" + (test-ok (define h (make-hash)) + (hash-union! h #hash([1 . one] [2 . two])) + (hash-union! h #hash([3 . three] [4 . four])) + (check-equal? (hash-copy + #hash([1 . one] [2 . two] [3 . three] [4 . four])) + h))))) + diff --git a/collects/typed-scheme/infer/constraints.rkt b/collects/typed-scheme/infer/constraints.rkt index e87137c0d7..2626eb2f1e 100644 --- a/collects/typed-scheme/infer/constraints.rkt +++ b/collects/typed-scheme/infer/constraints.rkt @@ -75,7 +75,7 @@ [(map2 dmap2) (in-pairs maps2)]) (with-handlers ([exn:infer? (lambda (_) #f)]) (cons - (simple-hash-union map1 map2 (lambda (k v1 v2) (c-meet v1 v2))) + (hash-union map1 map2 #:combine c-meet) (dmap-meet dmap1 dmap2)))))]) (when (null? maps) (fail! maps1 maps2)) diff --git a/collects/typed-scheme/infer/dmap.rkt b/collects/typed-scheme/infer/dmap.rkt index 1735c49ca0..7e2e3b3934 100644 --- a/collects/typed-scheme/infer/dmap.rkt +++ b/collects/typed-scheme/infer/dmap.rkt @@ -62,5 +62,4 @@ (define (dmap-meet dm1 dm2) (make-dmap - (simple-hash-union (dmap-map dm1) (dmap-map dm2) - (lambda (k dc1 dc2) (dcon-meet dc1 dc2))))) + (hash-union (dmap-map dm1) (dmap-map dm2) #:combine dcon-meet))) diff --git a/collects/unstable/cce/hash.ss b/collects/unstable/cce/hash.ss deleted file mode 100644 index 48d215373d..0000000000 --- a/collects/unstable/cce/hash.ss +++ /dev/null @@ -1,136 +0,0 @@ -#lang scheme - -(require "define.ss" (for-syntax syntax/parse)) - -(define-if-unbound (hash-has-key? table key) - (let/ec return - (hash-ref table key (lambda () (return #f))) - #t)) - -(define-if-unbound (hash-equal? table) - (and (hash? table) - (not (hash-eq? table)) - (not (hash-eqv? table)))) - -(define (hash-ref/check table key) - (hash-ref table key)) - -(define (hash-ref/identity table key) - (hash-ref table key (lambda () key))) - -(define (hash-ref/default table key default) - (hash-ref table key (lambda () default))) - -(define (hash-ref/failure table key failure) - (hash-ref table key (lambda () (failure)))) - -(define (hash-domain table) - (for/list ([i (in-hash-keys table)]) i)) - -(define (hash-range table) - (for/list ([i (in-hash-values table)]) i)) - -(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)))) - -(define-syntaxes [ hash hash! ] - (let () - - (define-syntax-class key/value - #:attributes [key value] - (pattern [key:expr value:expr])) - - (define-splicing-syntax-class immutable-hash-type - #:attributes [constructor] - (pattern (~seq #:eqv) #:attr constructor #'make-immutable-hasheqv) - (pattern (~seq #:eq) #:attr constructor #'make-immutable-hasheq) - (pattern (~seq (~optional #:equal)) - #:attr constructor #'make-immutable-hash)) - - (define-splicing-syntax-class mutable-hash-type - #:attributes [constructor] - (pattern (~seq #:base constructor:expr)) - (pattern (~seq (~or (~once #:eqv) (~once #:weak)) ...) - #:attr constructor #'(make-weak-hasheqv)) - (pattern (~seq (~or (~once #:eq) (~once #:weak)) ...) - #:attr constructor #'(make-weak-hasheq)) - (pattern (~seq (~or (~optional #:equal) (~once #:weak)) ...) - #:attr constructor #'(make-weak-hash)) - (pattern (~seq #:eqv) #:attr constructor #'(make-hasheqv)) - (pattern (~seq #:eq) #:attr constructor #'(make-hasheq)) - (pattern (~seq (~optional #:equal)) #:attr constructor #'(make-hash))) - - (define (parse-hash stx) - (syntax-parse stx - [(_ (~seq type:immutable-hash-type) elem:key/value ...) - (syntax/loc stx - (type.constructor (list (cons elem.key elem.value) ...)))] - [(_ #:base h:expr elem:key/value ...) - (syntax/loc stx - (for/fold - ([table h]) - ([key (in-list (list elem.key ...))] - [value (in-list (list elem.value ...))]) - (hash-set table key value)))])) - - (define (parse-hash! stx) - (syntax-parse stx - [(_ (~seq type:mutable-hash-type) elem:key/value ...) - (syntax/loc stx - (let ([table type.constructor]) - (for ([key (in-list (list elem.key ...))] - [value (in-list (list elem.value ...))]) - (hash-set! table key value)) - table))])) - - (values parse-hash parse-hash!))) - -(provide hash hash! hash-has-key? hash-equal?) -(provide/contract - [hash-ref/identity (-> hash? any/c any/c)] - [hash-ref/default (-> hash? any/c any/c any/c)] - [hash-ref/failure (-> hash? any/c (-> any/c) any/c)] - [hash-ref/check - (->d ([table hash?] [key any/c]) () - #:pre-cond (hash-has-key? table key) - [_ any/c])] - [hash-domain (-> hash? list?)] - [hash-range (-> hash? list?)] - [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?)]) diff --git a/collects/unstable/cce/reference/hash.scrbl b/collects/unstable/cce/reference/hash.scrbl deleted file mode 100644 index cc150c314b..0000000000 --- a/collects/unstable/cce/reference/hash.scrbl +++ /dev/null @@ -1,223 +0,0 @@ -#lang scribble/doc -@(require scribble/manual - scribble/eval - "../scribble.ss" - "eval.ss") -@(require (for-label scheme unstable/cce/hash)) - -@title[#:style 'quiet #:tag "cce-hash"]{Hash Tables} - -@defmodule[unstable/cce/hash] - -This module provides tools for manipulating hash tables. - -@section{Hash Table Construction} - -@defform/subs[ -(hash immutable-hash-type [key-expr value-expr] ...) -[(immutable-hash-type code:blank #:eq #:eqv #:equal)] -]{ - -Produces an immutable hash table based on the given comparison, defaulting to -@scheme[#:equal], and mapping the result of each @scheme[key-expr] to the result -of each @scheme[value-expr]. - -@defexamples[ -#:eval (evaluator 'unstable/cce/hash) -(hash ['one 1] ['two 2]) -(hash #:eq ['one 1] ['two 2]) -(hash #:eqv ['one 1] ['two 2]) -(hash #:equal ['one 1] ['two 2]) -] - -} - -@defform/subs[ -(hash! mutable-hash-spec [key-expr value-expr] ...) -[(mutable-hash-spec (code:line mutable-hash-type mutable-hash-weak) - (code:line mutable-hash-weak mutable-hash-type)) - (mutable-hash-type code:blank #:eq #:eqv #:equal) - (mutable-hash-weak code:blank #:weak)] -]{ - -Produces a mutable hash table based on the given comparison and weakness -specification, defaulting to @scheme[#:equal] and not @scheme[#:weak], and -mapping the result of each @scheme[key-expr] to the result of each -@scheme[value-expr]. - -@defexamples[ -#:eval (evaluator 'unstable/cce/hash) -(hash! ['one 1] ['two 2]) -(hash! #:eq ['one 1] ['two 2]) -(hash! #:eqv #:weak ['one 1] ['two 2]) -(hash! #:weak #:equal ['one 1] ['two 2]) -] - -} - -@section{Hash Table Lookup} - -@defproc[(hash-ref/check [h hash?] [k (lambda (k) (hash-has-key? h k))]) - any/c]{ - -Looks up key @scheme[k] in hash table @scheme[h]. Raises a contract error if -@scheme[h] has no entry for @scheme[k]. Equivalent to @scheme[(hash-ref h k)], -except for the specific exception value raised. - -@defexamples[ -#:eval (evaluator 'unstable/cce/hash) -(hash-ref/check (make-immutable-hash '([1 . one] [2 . two] [3 . three])) 2) -] - -} - -@defproc[(hash-ref/identity [h hash?] [k any/c]) any/c]{ - -Looks up key @scheme[k] in hash table @scheme[h]. Returns @scheme[k] if -@scheme[h] has no entry for @scheme[k]. Equivalent to -@scheme[(hash-ref h k (lambda () k))]. - -@defexamples[ -#:eval (evaluator 'unstable/cce/hash) -(hash-ref/identity (make-immutable-hash '([1 . one] [2 . two] [3 . three])) 2) -(hash-ref/identity (make-immutable-hash '([1 . one] [2 . two] [3 . three])) 4) -] - -} - -@defproc[(hash-ref/default [h hash?] [k any/c] [v any/c]) any/c]{ - -Looks up key @scheme[k] in hash table @scheme[h]. Returns @scheme[v] if -@scheme[h] has no entry for @scheme[k]. Equivalent to -@scheme[(hash-ref h k (lambda () v))]. - -@defexamples[ -#:eval (evaluator 'unstable/cce/hash) -(hash-ref/default (make-immutable-hash '([1 . one] [2 . two] [3 . three])) 2 'other) -(hash-ref/default (make-immutable-hash '([1 . one] [2 . two] [3 . three])) 4 'other) -] - -} - -@defproc[(hash-ref/failure [h hash?] [k any/c] [f (-> any/c)]) any/c]{ - -Looks up key @scheme[k] in hash table @scheme[h]. Returns the result of -applying @scheme[f] (in tail position) if @scheme[h] has no entry for -@scheme[k]. Equivalent to @scheme[(hash-ref h k f)]. - -@defexamples[ -#:eval (evaluator 'unstable/cce/hash) -(hash-ref/failure (make-immutable-hash '([1 . one] [2 . two] [3 . three])) 2 gensym) -(hash-ref/failure (make-immutable-hash '([1 . one] [2 . two] [3 . three])) 4 gensym) -] - -} - -@section{Hash Table Accessors} - -@defproc[(hash-equal? [h hash?]) boolean?]{ - -Reports whether @scheme[h] maps keys according to @scheme[equal?]. - -@defexamples[ -#:eval (evaluator 'unstable/cce/hash) -(hash-equal? #hash()) -(hash-equal? #hasheq()) -(hash-equal? #hasheqv()) -] - -} - -@defproc[(hash-has-key? [h hash?] [k any/c]) boolean?]{ - -Reports whether @scheme[h] has an entry for @scheme[k]. This function is -re-exported from @schememodname[scheme/base]. In versions of PLT Scheme before -@scheme[hash-has-key?] was implemented, this module provides its own definition. - -@defexamples[ -#:eval (evaluator 'unstable/cce/hash) -(hash-has-key? (make-immutable-hash '([1 . one] [2 . two] [3 . three])) 2) -(hash-has-key? (make-immutable-hash '([1 . one] [2 . two] [3 . three])) 4) -] - -} - -@defproc[(hash-domain [h hash?]) list?]{ - -Produces the domain of a hash table as a list of keys. - -@defexamples[ -#:eval (evaluator 'unstable/cce/hash) -(hash-domain (make-immutable-hash '([1 . one] [2 . two] [3 . three]))) -] - -} - -@defproc[(hash-range [h hash?]) list?]{ - -Produces the range of a hash table as a list of values. - -@defexamples[ -#:eval (evaluator 'unstable/cce/hash) -(hash-range (make-immutable-hash '([1 . one] [2 . two] [3 . three]))) -] - -} - -@section{Hash Table Combinations} - -@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 @scheme[h0] with each hash table @scheme[h] by functional -update, adding each element of each @scheme[h] to @scheme[h0] in turn. For each -key @scheme[k] and value @scheme[v], if a mapping from @scheme[k] to some value -@scheme[v0] already exists, it is replaced with a mapping from @scheme[k] to -@scheme[(combine/key k v0 v)]. - -@defexamples[ -#:eval (evaluator 'unstable/cce/hash) -(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 @scheme[h0] with each hash table @scheme[h] by mutable -update, adding each element of each @scheme[h] to @scheme[h0] in turn. For each -key @scheme[k] and value @scheme[v], if a mapping from @scheme[k] to some value -@scheme[v0] already exists, it is replaced with a mapping from @scheme[k] to -@scheme[(combine/key k v0 v)]. - -@defexamples[ -#:eval (evaluator 'unstable/cce/hash) -(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 -] - -} diff --git a/collects/unstable/cce/reference/manual.scrbl b/collects/unstable/cce/reference/manual.scrbl index 152e84fb7b..acf4d82e94 100644 --- a/collects/unstable/cce/reference/manual.scrbl +++ b/collects/unstable/cce/reference/manual.scrbl @@ -14,7 +14,6 @@ @include-section["set.scrbl"] @include-section["dict.scrbl"] -@include-section["hash.scrbl"] @include-section["syntax.scrbl"] @include-section["define.scrbl"] diff --git a/collects/unstable/cce/test/test-hash.ss b/collects/unstable/cce/test/test-hash.ss deleted file mode 100644 index dedb240c8c..0000000000 --- a/collects/unstable/cce/test/test-hash.ss +++ /dev/null @@ -1,74 +0,0 @@ -#lang scheme - -(require "checks.ss" - "../hash.ss") - -(provide hash-suite) - -(define hash-suite - (test-suite "hash.ss" - (test-suite "hash" - (test (check-equal? (hash [1 'a] [2 'b]) - #hash([1 . a] [2 . b]))) - (test (check-equal? (hash #:eq [1 'a] [2 'b]) - #hasheq([1 . a] [2 . b]))) - (test (check-equal? (hash #:eqv [1 'a] [2 'b]) - #hasheqv([1 . a] [2 . b]))) - (test (check-equal? (hash #:equal [1 'a] [2 'b]) - #hash([1 . a] [2 . b])))) - (test-suite "hash!" - (test (check-equal? (hash! [1 'a] [2 'b]) - (hash-copy #hash([1 . a] [2 . b])))) - (test (check-equal? (hash! #:eq [1 'a] [2 'b]) - (hash-copy #hasheq([1 . a] [2 . b])))) - (test (check-equal? (hash! #:eqv #:weak [1 'a] [2 'b]) - (make-weak-hasheqv '([1 . a] [2 . b])))) - (test (check-equal? (hash! #:weak #:equal [1 'a] [2 'b]) - (make-weak-hash '([1 . a] [2 . b]))))) - (test-suite "hash-equal?" - (test (check-true (hash-equal? #hash()))) - (test (check-false (hash-equal? #hasheq()))) - (test (check-false (hash-equal? #hasheqv())))) - (test-suite "hash-ref/check" - (test-ok (check-equal? (hash-ref/check #hash([1 . one] [2 . two]) 1) - 'one)) - (test-bad (hash-ref/check #hash([1 . one] [2 . two]) 3))) - (test-suite "hash-ref/identity" - (test-ok (check-equal? (hash-ref/identity #hash([1 . one] [2 . two]) 1) - 'one)) - (test-ok (check-equal? (hash-ref/identity #hash([1 . one] [2 . two]) 3) - 3))) - (test-suite "hash-ref/default" - (test-ok (check-equal? (hash-ref/default #hash([1 . one] [2 . two]) 1 '?) - 'one)) - (test-ok (check-equal? (hash-ref/default #hash([1 . one] [2 . two]) 3 '?) - '?))) - (test-suite "hash-ref/failure" - (test-ok (define x 7) - (define (f) (set! x (+ x 1)) x) - (check-equal? (hash-ref/failure #hash([1 . one] [2 . two]) 1 f) - 'one) - (check-equal? x 7) - (check-equal? (hash-ref/failure #hash([1 . one] [2 . two]) 3 f) - 8) - (check-equal? x 8))) - (test-suite "hash-has-key?" - (test-ok (check-equal? (hash-has-key? #hash([1 . one] [2 . two]) 1) #t)) - (test-ok (check-equal? (hash-has-key? #hash([1 . one] [2 . two]) 3) #f))) - (test-suite "hash-domain" - (test-ok (check-equal? (hash-domain #hash([1 . one] [2 . two])) '(1 2)))) - (test-suite "hash-range" - (test-ok (check-equal? (hash-range #hash([1 . one] [2 . two])) - '(one two)))) - (test-suite "hash-union" - (test-ok (hash-union #hash([1 . one] [2 . two]) - #hash([3 . three] [4 . four])) - #hash([4 . four] [3 . three] [1 . one] [2 . two]))) - (test-suite "hash-union!" - (test-ok (define h (make-hash)) - (hash-union! h #hash([1 . one] [2 . two])) - (hash-union! h #hash([3 . three] [4 . four])) - (check-equal? (hash-copy - #hash([1 . one] [2 . two] [3 . three] [4 . four])) - h))))) - diff --git a/collects/unstable/cce/test/test-main.ss b/collects/unstable/cce/test/test-main.ss index 52592cdfe1..e3838537f1 100644 --- a/collects/unstable/cce/test/test-main.ss +++ b/collects/unstable/cce/test/test-main.ss @@ -6,7 +6,6 @@ "test-define.ss" "test-dict.ss" "test-exn.ss" - "test-hash.ss" "test-planet.ss" "test-port.ss" "test-regexp.ss" @@ -23,7 +22,6 @@ define-suite dict-suite exn-suite - hash-suite planet-suite port-suite regexp-suite diff --git a/collects/unstable/hash.rkt b/collects/unstable/hash.rkt index 82aa9506c0..04530f4845 100644 --- a/collects/unstable/hash.rkt +++ b/collects/unstable/hash.rkt @@ -1,13 +1,73 @@ -#lang racket/base +#lang racket -(provide simple-hash-union) +(require (for-syntax syntax/parse)) -;; map map (key val val -> val) -> map -(define (simple-hash-union h1 h2 f) - (for/fold ([h* h1]) - ([(k v2) h2]) - (let* ([v1 (hash-ref h1 k #f)] - [new-val (if v1 - (f k v1 v2) - v2)]) - (hash-set h* k new-val)))) +(define (hash-ref/check table key) + (hash-ref table key)) + +(define (hash-ref/identity table key) + (hash-ref table key (lambda () key))) + +(define (hash-ref/default table key default) + (hash-ref table key (lambda () default))) + +(define (hash-ref/failure table key failure) + (hash-ref table key (lambda () (failure)))) + +(define (hash-domain table) + (for/list ([i (in-hash-keys table)]) i)) + +(define (hash-range table) + (for/list ([i (in-hash-values table)]) i)) + +(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-ref/identity (-> hash? any/c any/c)] + [hash-ref/default (-> hash? any/c any/c any/c)] + [hash-ref/failure (-> hash? any/c (-> any/c) any/c)] + [hash-ref/check + (->d ([table hash?] [key any/c]) () + #:pre-cond (hash-has-key? table key) + [_ any/c])] + [hash-domain (-> hash? list?)] + [hash-range (-> hash? list?)] + [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?)]) diff --git a/collects/unstable/scribblings/hash.scrbl b/collects/unstable/scribblings/hash.scrbl index ae24750c79..c2c5da2d30 100644 --- a/collects/unstable/scribblings/hash.scrbl +++ b/collects/unstable/scribblings/hash.scrbl @@ -1,30 +1,177 @@ -#lang scribble/doc -@(require scribble/base - scribble/manual - scribble/eval - "utils.rkt" - (for-label unstable/hash - racket/contract - racket/base)) +#lang scribble/manual +@(require scribble/eval "utils.rkt" (for-label scheme unstable/hash)) -@(define the-eval (make-base-eval)) -@(the-eval '(require unstable/hash)) - -@title[#:tag "hash"]{Hash Tables} +@title{Hash Tables} @defmodule[unstable/hash] -@unstable[@author+email["Sam Tobin-Hochstadt" "samth@ccs.neu.edu"]] +@unstable[@author+email["Carl Eastlund" "cce@racket-lang.org"]] -@defproc[(simple-hash-union [t1 hash?] [t2 hash?] [combine (any/c any/c any/c . -> . any/c)]) hash?]{ -Produces the combination of @racket[t1] and @racket[t2]. If either -@racket[t1] or @racket[t2] has a value for key @racket[k], then the -result has the same value for @racket[k]. If both @racket[t1] and -@racket[t2] have a value for @racket[k], the result has the value -@racket[(combine k (hash-ref t1 k) (hash-ref t2 k))] for @racket[k]. +This module provides tools for manipulating hash tables. -@examples[#:eval the-eval -(simple-hash-union #hash((a . 5) (b . 0)) #hash((d . 12) (c . 1)) (lambda (k v1 v2) v1)) -(simple-hash-union #hash((a . 5) (b . 0)) #hash((a . 12) (c . 1)) (lambda (k v1 v2) v1)) +@section{Hash Table Lookup} + +@defproc[(hash-ref/check [h hash?] [k (lambda (k) (hash-has-key? h k))]) + any/c]{ + +Looks up key @scheme[k] in hash table @scheme[h]. Raises a contract error if +@scheme[h] has no entry for @scheme[k]. Equivalent to @scheme[(hash-ref h k)], +except for the specific exception value raised. + +@defexamples[ +#:eval (eval/require 'unstable/hash) +(hash-ref/check (make-immutable-hash '([1 . one] [2 . two] [3 . three])) 2) ] + +} + +@defproc[(hash-ref/identity [h hash?] [k any/c]) any/c]{ + +Looks up key @scheme[k] in hash table @scheme[h]. Returns @scheme[k] if +@scheme[h] has no entry for @scheme[k]. Equivalent to +@scheme[(hash-ref h k (lambda () k))]. + +@defexamples[ +#:eval (eval/require 'unstable/hash) +(hash-ref/identity (make-immutable-hash '([1 . one] [2 . two] [3 . three])) 2) +(hash-ref/identity (make-immutable-hash '([1 . one] [2 . two] [3 . three])) 4) +] + +} + +@defproc[(hash-ref/default [h hash?] [k any/c] [v any/c]) any/c]{ + +Looks up key @scheme[k] in hash table @scheme[h]. Returns @scheme[v] if +@scheme[h] has no entry for @scheme[k]. Equivalent to +@scheme[(hash-ref h k (lambda () v))]. + +@defexamples[ +#:eval (eval/require 'unstable/hash) +(hash-ref/default (make-immutable-hash '([1 . one] [2 . two] [3 . three])) 2 'other) +(hash-ref/default (make-immutable-hash '([1 . one] [2 . two] [3 . three])) 4 'other) +] + +} + +@defproc[(hash-ref/failure [h hash?] [k any/c] [f (-> any/c)]) any/c]{ + +Looks up key @scheme[k] in hash table @scheme[h]. Returns the result of +applying @scheme[f] (in tail position) if @scheme[h] has no entry for +@scheme[k]. Equivalent to @scheme[(hash-ref h k f)]. + +@defexamples[ +#:eval (eval/require 'unstable/hash) +(hash-ref/failure (make-immutable-hash '([1 . one] [2 . two] [3 . three])) 2 gensym) +(hash-ref/failure (make-immutable-hash '([1 . one] [2 . two] [3 . three])) 4 gensym) +] + +} + +@section{Hash Table Accessors} + +@defproc[(hash-equal? [h hash?]) boolean?]{ + +Reports whether @scheme[h] maps keys according to @scheme[equal?]. + +@defexamples[ +#:eval (eval/require 'unstable/hash) +(hash-equal? #hash()) +(hash-equal? #hasheq()) +(hash-equal? #hasheqv()) +] + +} + +@defproc[(hash-has-key? [h hash?] [k any/c]) boolean?]{ + +Reports whether @scheme[h] has an entry for @scheme[k]. This function is +re-exported from @schememodname[scheme/base]. In versions of PLT Scheme before +@scheme[hash-has-key?] was implemented, this module provides its own definition. + +@defexamples[ +#:eval (eval/require 'unstable/hash) +(hash-has-key? (make-immutable-hash '([1 . one] [2 . two] [3 . three])) 2) +(hash-has-key? (make-immutable-hash '([1 . one] [2 . two] [3 . three])) 4) +] + +} + +@defproc[(hash-domain [h hash?]) list?]{ + +Produces the domain of a hash table as a list of keys. + +@defexamples[ +#:eval (eval/require 'unstable/hash) +(hash-domain (make-immutable-hash '([1 . one] [2 . two] [3 . three]))) +] + +} + +@defproc[(hash-range [h hash?]) list?]{ + +Produces the range of a hash table as a list of values. + +@defexamples[ +#:eval (eval/require 'unstable/hash) +(hash-range (make-immutable-hash '([1 . one] [2 . two] [3 . three]))) +] + +} + +@section{Hash Table Combinations} + +@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 @scheme[h0] with each hash table @scheme[h] by functional +update, adding each element of each @scheme[h] to @scheme[h0] in turn. For each +key @scheme[k] and value @scheme[v], if a mapping from @scheme[k] to some value +@scheme[v0] already exists, it is replaced with a mapping from @scheme[k] to +@scheme[(combine/key k v0 v)]. + +@defexamples[ +#:eval (eval/require 'unstable/hash) +(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 @scheme[h0] with each hash table @scheme[h] by mutable +update, adding each element of each @scheme[h] to @scheme[h0] in turn. For each +key @scheme[k] and value @scheme[v], if a mapping from @scheme[k] to some value +@scheme[v0] already exists, it is replaced with a mapping from @scheme[k] to +@scheme[(combine/key k v0 v)]. + +@defexamples[ +#:eval (eval/require 'unstable/hash) +(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 +] + }