Replaced unstable/hash with unstable/cce/hash.
This commit is contained in:
Carl Eastlund
parent
286319d723
commit
3a525b9a12
53
collects/tests/unstable/hash.rkt
Normal file
53
collects/tests/unstable/hash.rkt
Normal file
|
|
@ -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)))))
|
||||
|
||||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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?)])
|
||||
|
|
@ -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
|
||||
]
|
||||
|
||||
}
|
||||
|
|
@ -14,7 +14,6 @@
|
|||
|
||||
@include-section["set.scrbl"]
|
||||
@include-section["dict.scrbl"]
|
||||
@include-section["hash.scrbl"]
|
||||
|
||||
@include-section["syntax.scrbl"]
|
||||
@include-section["define.scrbl"]
|
||||
|
|
|
|||
|
|
@ -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)))))
|
||||
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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?)])
|
||||
|
|
|
|||
|
|
@ -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
|
||||
]
|
||||
|
||||
}
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user