suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Moved unstable/cce/dict to unstable/dict.

Browse Source
This commit is contained in:
Carl Eastlund 2010-05-29 21:37:33 -04:00
parent 86a3c3ed18
commit fb53d5d191
9 changed files with 136 additions and 143 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

107
collects/tests/unstable/dict.rkt Normal file
View File

@ -0,0 +1,107 @@
#lang racket
(require rackunit rackunit/text-ui unstable/dict "helpers.rkt")
(define (dict=? a b)
(and (subdict? a b)
(subdict? b a)))
(define (subdict? a b)
(for/and ([(k v) (in-dict a)])
(and (dict-has-key? b k)
(equal? (dict-ref b k) v))))
(define (check/dict a b) (check dict=? a b))
(run-tests
(test-suite "dict.ss"
(test-suite "Constructors"
(test-suite "empty-dict"
(test (check/dict (empty-dict) '()))
(test (check/dict (empty-dict #:mutable? #t) '()))
(test (check/dict (empty-dict #:weak? #t) '()))
(test (check/dict (empty-dict #:compare 'eqv) '())))
(test-suite "make-dict"
(test (check/dict (make-dict '([1 . a] [2 . b])) '([1 . a] [2 . b])))
(test (check/dict (make-dict '([1 . a] [2 . b]) #:mutable? #t)
'([1 . a] [2 . b])))
(test (check/dict (make-dict '([1 . a] [2 . b]) #:weak? #t)
'([1 . a] [2 . b])))
(test (check/dict (make-dict '([1 . a] [2 . b]) #:compare 'eqv)
'([1 . a] [2 . b]))))
(test-suite "custom-dict"
(test (let* ([table (custom-dict = add1 sub1 #:mutable? #t)])
(dict-set! table 1 'a)
(dict-set! table 2 'b)
(check/dict table '([1 . a] [2 . b]))))))
(test-suite "Lookup"
(test-suite "dict-ref!"
(test-ok (define d (make-hash))
(check-equal? (dict-ref! d 1 'one) 'one)
(check-equal? (dict-ref! d 1 'uno) 'one)
(check-equal? (dict-ref! d 2 (lambda () 'two)) 'two)
(check-equal? (dict-ref! d 2 (lambda () 'dos)) 'two))
(test-bad (dict-ref! '([1 . one] [2 . two]) 1 'uno)))
(test-suite "dict-ref/check"
(test-ok (check-equal? (dict-ref/check '([1 . one] [2 . two]) 1) 'one))
(test-bad (dict-ref/check '([1 . one] [2 . two]) 3)))
(test-suite "dict-ref/identity"
(test-ok (check-equal? (dict-ref/identity '([1 . one] [2 . two]) 1)
'one))
(test-ok (check-equal? (dict-ref/identity '([1 . one] [2 . two]) 3) 3)))
(test-suite "dict-ref/default"
(test-ok (check-equal? (dict-ref/default '([1 . one] [2 . two]) 1 '?)
'one))
(test-ok (check-equal? (dict-ref/default '([1 . one] [2 . two]) 3 '?)
'?)))
(test-suite "dict-ref/failure"
(test-ok (define x 7)
(define (f) (set! x (+ x 1)) x)
(check-equal? (dict-ref/failure '([1 . one] [2 . two]) 1 f)
'one)
(check-equal? x 7)
(check-equal? (dict-ref/failure '([1 . one] [2 . two]) 3 f) 8)
(check-equal? x 8))))
(test-suite "Accessors"
(test-suite "dict-empty?"
(test (check-true (dict-empty? '())))
(test (check-false (dict-empty? '([1 . a] [2 . b])))))
(test-suite "dict-has-key?"
(test-ok (check-equal? (dict-has-key? '([1 . one] [2 . two]) 1) #t))
(test-ok (check-equal? (dict-has-key? '([1 . one] [2 . two]) 3) #f)))
(test-suite "dict-domain"
(test-ok (check-equal? (dict-domain '([1 . one] [2 . two])) '(1 2))))
(test-suite "dict-range"
(test-ok (check-equal? (dict-range '([1 . one] [2 . two]))
'(one two)))))
(test-suite "Combination"
(test-suite "dict-union"
(test-ok (dict-union '([1 . one] [2 . two]) '([3 . three] [4 . four]))
'([4 . four] [3 . three] [1 . one] [2 . two])))
(test-suite "dict-union!"
(test-ok (define d (make-hash))
(dict-union! d '([1 . one] [2 . two]))
(dict-union! d '([3 . three] [4 . four]))
(check-equal?
(hash-copy #hash([1 . one] [2 . two] [3 . three] [4 . four]))
d))))
(test-suite "Property"
(test-suite "wrapped-dict-property"
(test
(let ()
(define (unwrap-table d) (table-dict d))
(define (wrap-table d) (make-table d))
(define (wrapped? d) (table? d))
(define-struct table [dict]
#:transparent
#:property prop:dict
(wrapped-dict-property
#:unwrap unwrap-table
#:wrap wrap-table
#:predicate wrapped?))
(check-true (dict? (make-table '([1 . a] [2 . b]))))
(check/dict (make-table '([1 . a] [2 . b])) '([1 . a] [2 . b]))
(check-equal? (dict-ref (make-table '([1 . a] [2 . b])) 1) 'a)
(let* ([s (dict-set (make-table '([1 . a] [2 . b])) 3 'c)])
(check-true (table? s))
(check/dict s '([1 . a] [2 . b] [3 . c])))))))))

2
collects/unstable/cce/drscheme.ss
View File

@ -2,7 +2,7 @@
(require drscheme/tool
string-constants
"dict.ss"
unstable/dict
(only-in test-engine/scheme-gui make-formatter)
(only-in test-engine/scheme-tests
scheme-test-data test-format test-execute)

1
collects/unstable/cce/reference/manual.scrbl
View File

@ -11,7 +11,6 @@
@table-of-contents[]
@include-section["set.scrbl"]
@include-section["dict.scrbl"]
@include-section["syntax.scrbl"]
@include-section["define.scrbl"]

2
collects/unstable/cce/set.ss
View File

@ -1,6 +1,6 @@
#lang scheme
(require "dict.ss")
(require unstable/dict)
;; A Set is either a Dict or a struct with the prop:set property.
;; A SetProperty is:

110
collects/unstable/cce/test/test-dict.ss
View File

@ -1,110 +0,0 @@
#lang scheme
(require "checks.ss"
"../dict.ss")
(provide dict-suite)
(define (dict=? a b)
(and (subdict? a b)
(subdict? b a)))
(define (subdict? a b)
(for/and ([(k v) (in-dict a)])
(and (dict-has-key? b k)
(equal? (dict-ref b k) v))))
(define (check/dict a b) (check dict=? a b))
(define dict-suite
(test-suite "dict.ss"
(test-suite "Constructors"
(test-suite "empty-dict"
(test (check/dict (empty-dict) '()))
(test (check/dict (empty-dict #:mutable? #t) '()))
(test (check/dict (empty-dict #:weak? #t) '()))
(test (check/dict (empty-dict #:compare 'eqv) '())))
(test-suite "make-dict"
(test (check/dict (make-dict '([1 . a] [2 . b])) '([1 . a] [2 . b])))
(test (check/dict (make-dict '([1 . a] [2 . b]) #:mutable? #t)
'([1 . a] [2 . b])))
(test (check/dict (make-dict '([1 . a] [2 . b]) #:weak? #t)
'([1 . a] [2 . b])))
(test (check/dict (make-dict '([1 . a] [2 . b]) #:compare 'eqv)
'([1 . a] [2 . b]))))
(test-suite "custom-dict"
(test (let* ([table (custom-dict = add1 sub1 #:mutable? #t)])
(dict-set! table 1 'a)
(dict-set! table 2 'b)
(check/dict table '([1 . a] [2 . b]))))))
(test-suite "Lookup"
(test-suite "dict-ref!"
(test-ok (define d (make-hash))
(check-equal? (dict-ref! d 1 'one) 'one)
(check-equal? (dict-ref! d 1 'uno) 'one)
(check-equal? (dict-ref! d 2 (lambda () 'two)) 'two)
(check-equal? (dict-ref! d 2 (lambda () 'dos)) 'two))
(test-bad (dict-ref! '([1 . one] [2 . two]) 1 'uno)))
(test-suite "dict-ref/check"
(test-ok (check-equal? (dict-ref/check '([1 . one] [2 . two]) 1) 'one))
(test-bad (dict-ref/check '([1 . one] [2 . two]) 3)))
(test-suite "dict-ref/identity"
(test-ok (check-equal? (dict-ref/identity '([1 . one] [2 . two]) 1)
'one))
(test-ok (check-equal? (dict-ref/identity '([1 . one] [2 . two]) 3) 3)))
(test-suite "dict-ref/default"
(test-ok (check-equal? (dict-ref/default '([1 . one] [2 . two]) 1 '?)
'one))
(test-ok (check-equal? (dict-ref/default '([1 . one] [2 . two]) 3 '?)
'?)))
(test-suite "dict-ref/failure"
(test-ok (define x 7)
(define (f) (set! x (+ x 1)) x)
(check-equal? (dict-ref/failure '([1 . one] [2 . two]) 1 f)
'one)
(check-equal? x 7)
(check-equal? (dict-ref/failure '([1 . one] [2 . two]) 3 f) 8)
(check-equal? x 8))))
(test-suite "Accessors"
(test-suite "dict-empty?"
(test (check-true (dict-empty? '())))
(test (check-false (dict-empty? '([1 . a] [2 . b])))))
(test-suite "dict-has-key?"
(test-ok (check-equal? (dict-has-key? '([1 . one] [2 . two]) 1) #t))
(test-ok (check-equal? (dict-has-key? '([1 . one] [2 . two]) 3) #f)))
(test-suite "dict-domain"
(test-ok (check-equal? (dict-domain '([1 . one] [2 . two])) '(1 2))))
(test-suite "dict-range"
(test-ok (check-equal? (dict-range '([1 . one] [2 . two]))
'(one two)))))
(test-suite "Combination"
(test-suite "dict-union"
(test-ok (dict-union '([1 . one] [2 . two]) '([3 . three] [4 . four]))
'([4 . four] [3 . three] [1 . one] [2 . two])))
(test-suite "dict-union!"
(test-ok (define d (make-hash))
(dict-union! d '([1 . one] [2 . two]))
(dict-union! d '([3 . three] [4 . four]))
(check-equal?
(hash-copy #hash([1 . one] [2 . two] [3 . three] [4 . four]))
d))))
(test-suite "Property"
(test-suite "wrapped-dict-property"
(test
(let ()
(define (unwrap-table d) (table-dict d))
(define (wrap-table d) (make-table d))
(define (wrapped? d) (table? d))
(define-struct table [dict]
#:transparent
#:property prop:dict
(wrapped-dict-property
#:unwrap unwrap-table
#:wrap wrap-table
#:predicate wrapped?))
(check-true (dict? (make-table '([1 . a] [2 . b]))))
(check/dict (make-table '([1 . a] [2 . b])) '([1 . a] [2 . b]))
(check-equal? (dict-ref (make-table '([1 . a] [2 . b])) 1) 'a)
(let* ([s (dict-set (make-table '([1 . a] [2 . b])) 3 'c)])
(check-true (table? s))
(check/dict s '([1 . a] [2 . b] [3 . c])))))))))

2
collects/unstable/cce/test/test-main.ss
View File

@ -3,7 +3,6 @@
(require "checks.ss"
"test-debug.ss"
"test-define.ss"
"test-dict.ss"
"test-planet.ss"
"test-require-provide.ss"
"test-scribble.ss"
@ -14,7 +13,6 @@
(test-suite "scheme.plt"
debug-suite
define-suite
dict-suite
planet-suite
require-provide-suite
scribble-suite

10
collects/unstable/cce/dict.ss → collects/unstable/dict.rkt
View File

@ -1,6 +1,6 @@
#lang scheme
#lang racket/base
(require unstable/contract "define.ss")
(require racket/dict racket/match racket/contract unstable/contract)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
@ -8,7 +8,7 @@
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-if-unbound dict-has-key?
(define dict-has-key?
(let ()
(with-contract
dict-has-key?
@ -19,7 +19,7 @@
#t)))
dict-has-key?))
(define-if-unbound dict-ref!
(define dict-ref!
(let ()
(with-contract
dict-ref!
@ -36,7 +36,7 @@
value)))))
dict-ref!))
(define-if-unbound (dict-empty? dict)
(define (dict-empty? dict)
(= (dict-count dict) 0))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

44
collects/unstable/cce/reference/dict.scrbl → collects/unstable/scribblings/dict.scrbl
View File

@ -1,13 +1,11 @@
#lang scribble/doc
@(require scribble/manual
scribble/eval
"../scribble.ss"
"eval.ss")
@(require (for-label scheme unstable/cce/dict))
#lang scribble/manual
@(require scribble/eval "utils.rkt" (for-label racket unstable/dict))
@title[#:style 'quiet #:tag "cce-dict"]{Dictionaries}
@title{Dictionaries}
@defmodule[unstable/cce/dict]
@defmodule[unstable/dict]
@unstable[@author+email["Carl Eastlund" "cce@racket-lang.org"]]
This module provides tools for manipulating dictionary values.
@ -22,7 +20,7 @@ Constructs an empty hash table based on the behavior specified by
@scheme[mutable?], @scheme[weak?], and @scheme[compare].
@defexamples[
#:eval (evaluator 'unstable/cce/dict)
#:eval (eval/require 'racket/dict 'unstable/dict)
(empty-dict)
(empty-dict #:mutable? #t)
(empty-dict #:weak? #t)
@ -41,7 +39,7 @@ Converts a given dictionary @scheme[d] to a hash table based on the behavior
specified by @scheme[mutable?], @scheme[weak?], and @scheme[compare].
@defexamples[
#:eval (evaluator 'unstable/cce/dict)
#:eval (eval/require 'racket/dict 'unstable/dict)
(make-dict '([1 . one] [2 . two]))
(make-dict '([1 . one] [2 . two]) #:mutable? #t)
(make-dict '([1 . one] [2 . two]) #:weak? #t)
@ -62,7 +60,7 @@ Given no hash functions, the dictionary defaults to a degenerate hash function
and is thus essentially equivalent to a list-based dictionary.
@defexamples[
#:eval (evaluator 'unstable/cce/dict)
#:eval (eval/require 'racket/dict 'unstable/dict)
(define table (custom-dict = add1 sub1 #:mutable? #t))
(dict-set! table 1 'one)
(dict-set! table 2 'two)
@ -85,7 +83,7 @@ for @scheme[k], updates @scheme[d] to map @scheme[k] to the result of
returns the new mapping.
@defexamples[
#:eval (evaluator 'unstable/cce/dict)
#:eval (eval/require 'racket/dict 'unstable/dict)
(define d (make-hash))
(dict-set! d 1 'one)
(dict-set! d 2 'two)
@ -108,7 +106,7 @@ Looks up key @scheme[k] in dictionary @scheme[d]. Raises a contract error if
except for the specific exception value raised.
@defexamples[
#:eval (evaluator 'unstable/cce/dict)
#:eval (eval/require 'racket/dict 'unstable/dict)
(dict-ref/check '([1 . one] [2 . two] [3 . three]) 2)
]
@ -121,7 +119,7 @@ Looks up key @scheme[k] in dictionary @scheme[d]. Returns @scheme[k] if
@scheme[(dict-ref d k (lambda () k))].
@defexamples[
#:eval (evaluator 'unstable/cce/dict)
#:eval (eval/require 'racket/dict 'unstable/dict)
(dict-ref/identity '([1 . one] [2 . two] [3 . three]) 2)
(dict-ref/identity '([1 . one] [2 . two] [3 . three]) 4)
]
@ -135,7 +133,7 @@ Looks up key @scheme[k] in dictionary @scheme[d]. Returns @scheme[v] if
@scheme[(dict-ref d k (lambda () v))].
@defexamples[
#:eval (evaluator 'unstable/cce/dict)
#:eval (eval/require 'racket/dict 'unstable/dict)
(dict-ref/default '([1 . one] [2 . two] [3 . three]) 2 'other)
(dict-ref/default '([1 . one] [2 . two] [3 . three]) 4 'other)
]
@ -149,7 +147,7 @@ applying @scheme[f] (in tail position) if @scheme[d] has no entry for
@scheme[k]. Equivalent to @scheme[(dict-ref d k f)].
@defexamples[
#:eval (evaluator 'unstable/cce/dict)
#:eval (eval/require 'racket/dict 'unstable/dict)
(dict-ref/failure '([1 . one] [2 . two] [3 . three]) 2 gensym)
(dict-ref/failure '([1 . one] [2 . two] [3 . three]) 4 gensym)
]
@ -163,7 +161,7 @@ applying @scheme[f] (in tail position) if @scheme[d] has no entry for
Reports whether @scheme[d] is empty (has no keys).
@defexamples[
#:eval (evaluator 'unstable/cce/dict)
#:eval (eval/require 'racket/dict 'unstable/dict)
(dict-empty? '())
(dict-empty? '([1 . one] [2 . two]))
]
@ -175,7 +173,7 @@ Reports whether @scheme[d] is empty (has no keys).
Reports whether @scheme[d] has an entry for @scheme[k].
@defexamples[
#:eval (evaluator 'unstable/cce/dict)
#:eval (eval/require 'racket/dict 'unstable/dict)
(dict-has-key? '([1 . one] [2 . two] [3 . three]) 2)
(dict-has-key? '([1 . one] [2 . two] [3 . three]) 4)
]
@ -187,7 +185,7 @@ Reports whether @scheme[d] has an entry for @scheme[k].
Produces the domain of a dictionary as a list of keys.
@defexamples[
#:eval (evaluator 'unstable/cce/dict)
#:eval (eval/require 'racket/dict 'unstable/dict)
(dict-domain '([1 . one] [2 . two] [3 . three]))
]
@ -198,7 +196,7 @@ Produces the domain of a dictionary as a list of keys.
Produces the range of a dictionary as a list of values.
@defexamples[
#:eval (evaluator 'unstable/cce/dict)
#:eval (eval/require 'racket/dict 'unstable/dict)
(dict-range '([1 . one] [2 . two] [3 . three]))
]
@ -223,7 +221,7 @@ key @scheme[k] and value @scheme[v], if a mapping from @scheme[k] to some value
@scheme[(combine/key k v0 v)].
@defexamples[
#:eval (evaluator 'unstable/cce/dict)
#:eval (eval/require 'racket/dict 'unstable/dict)
(dict-union '([1 . one]) '([2 . two]) '([3 . three]))
(dict-union '([1 . (one uno)] [2 . (two dos)])
'([1 . (ein une)] [2 . (zwei deux)])
@ -249,7 +247,7 @@ key @scheme[k] and value @scheme[v], if a mapping from @scheme[k] to some value
@scheme[(combine/key k v0 v)].
@defexamples[
#:eval (evaluator 'unstable/cce/dict)
#:eval (eval/require 'racket/dict 'unstable/dict)
(define d (make-hash))
d
(dict-union! d '([1 . (one uno)] [2 . (two dos)]))
@ -279,7 +277,7 @@ will extract a nested dictionary using @scheme[unwrap] and will produce a
wrapped dictionary during functional update using @scheme[wrap].
@defexamples[
#:eval (evaluator 'unstable/cce/dict)
#:eval (eval/require 'racket/dict 'unstable/dict)
(define-struct table [dict]
#:transparent
#:property prop:dict

1
collects/unstable/scribblings/unstable.scrbl
View File

@ -74,6 +74,7 @@ Keep documentation and tests up to date.
@include-section["bytes.scrbl"]
@include-section["class.scrbl"]
@include-section["contract.scrbl"]
@include-section["dict.scrbl"]
@include-section["dirs.scrbl"]
@include-section["exn.scrbl"]
@include-section["file.scrbl"]