108 lines
3.5 KiB
Scheme
108 lines
3.5 KiB
Scheme
;; chapter 3: A Dictionary
|
|
|
|
;; --- dictionary --------------------------------------------------------------
|
|
|
|
(module dictionary mzscheme
|
|
(require (lib "contract.ss") (lib "etc.ss"))
|
|
|
|
;; a contract utility
|
|
(define-syntax =>
|
|
(syntax-rules ()
|
|
[(=> antecedent consequent) (if antecedent consequent #t)]))
|
|
|
|
|
|
;; implementation
|
|
(define-struct dictionary (l value? eq?))
|
|
;; the keys should probably be another parameter (exercise)
|
|
|
|
(define (initialize p eq) (make-dictionary '() p eq))
|
|
(define (put d k v)
|
|
(make-dictionary (cons (cons k v) (dictionary-l d))
|
|
(dictionary-value? d)
|
|
(dictionary-eq? d)))
|
|
(define (remove d k)
|
|
(make-dictionary
|
|
(let loop ([l (dictionary-l d)])
|
|
(cond
|
|
[(null? l) l]
|
|
[(eq? (caar l) k) (loop (cdr l))]
|
|
[else (cons (car l) (loop (cdr l)))]))
|
|
(dictionary-value? d)
|
|
(dictionary-eq? d)))
|
|
(define (count d) (length (dictionary-l d)))
|
|
(define (value-for d k) (cdr (assq k (dictionary-l d))))
|
|
(define (has? d k) (pair? (assq k (dictionary-l d))))
|
|
(define (not-has? d) (lambda (k) (not (has? d k))))
|
|
;; end of implementation
|
|
|
|
;; interface
|
|
(provide/contract
|
|
;; predicates
|
|
[dictionary? (-> any/c boolean?)]
|
|
;; basic queries
|
|
;; how many items are in the dictionary?
|
|
[count (-> dictionary? natural-number/c)]
|
|
;; does the dictionary define key k?
|
|
[has? (->pp ([d dictionary?][k symbol?])
|
|
#t ;; pre
|
|
boolean?
|
|
result
|
|
((zero? (count d)) . => . (not result)))]
|
|
;; what is the value of key k in this dictionary?
|
|
[value-for (->r ([d dictionary?]
|
|
[k (and/c symbol? (lambda (k) (has? d k)))])
|
|
(dictionary-value? d))]
|
|
;; initialization
|
|
;; post condition: for all k in symbol, (has? d k) is false.
|
|
[initialize (->r ([p contract?][eq (p p . -> . boolean?)])
|
|
(and/c dictionary? (compose zero? count)))]
|
|
;; commands
|
|
;; Mitchell and McKim say that put shouldn't consume Void (null ptr) for v.
|
|
;; We allow the client to specify a contract for all values via initialize.
|
|
;; We could do the same via a key? parameter (exercise).
|
|
;; add key k with value v to this dictionary
|
|
[put (->pp ([d dictionary?]
|
|
[k (and symbol? (not-has? d))]
|
|
[v (dictionary-value? d)])
|
|
#t
|
|
dictionary?
|
|
result
|
|
(and (has? result k)
|
|
(= (count d) (- (count result) 1))
|
|
([dictionary-eq? d] (value-for result k) v)))]
|
|
;; remove key k from this dictionary
|
|
[remove (->pp ([d dictionary?]
|
|
[k (and/c symbol? (lambda (k) (has? d k)))])
|
|
#t
|
|
(and/c dictionary? not-has?)
|
|
result
|
|
(= (count d) (+ (count result) 1)))])
|
|
;; end of interface
|
|
)
|
|
|
|
;; --- tests -------------------------------------------------------------------
|
|
|
|
(module test mzscheme
|
|
(require (planet "test.ss" ("schematics" "schemeunit.plt" 1 2))
|
|
(planet "text-ui.ss" ("schematics" "schemeunit.plt" 1 2)))
|
|
(require (lib "contract.ss"))
|
|
(require dictionary)
|
|
|
|
(define d
|
|
(put (put (put (initialize (flat-contract integer?) =) 'a 2) 'b 2) 'c 1))
|
|
|
|
(test/text-ui
|
|
(make-test-suite
|
|
"dictionaries"
|
|
(make-test-case
|
|
"value for"
|
|
(assert = (value-for d 'b) 2))
|
|
(make-test-case
|
|
"has?"
|
|
(assert-false (has? (remove d 'b) 'b)))
|
|
(make-test-case
|
|
"count"
|
|
(assert = 3 (count d))))))
|
|
|
|
(require test)
|