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

Reimplement racket/dict using generics.

Browse Source
This commit is contained in:
Asumu Takikawa 2012-05-08 21:32:54 -04:00
parent e3b7640528
commit e4a3001af6
2 changed files with 112 additions and 101 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
collects/racket/dict.rkt
View File

@ -217,7 +217,8 @@
(->i ([d dict?])
[_r (d) (listof (cons/c (dict-key-contract d) (dict-value-contract d)))])])
(provide prop:dict
(provide dict
prop:dict
make-custom-hash
make-immutable-custom-hash

210
collects/racket/private/dict.rkt
View File

@ -1,5 +1,19 @@
#lang racket/base
(require (for-syntax racket/base))
(require generics
(for-syntax racket/base))
(define-generics (dict prop:dict dict? dict-def-table)
(dict-ref dict key [default])
(dict-set! dict key val)
(dict-set dict key val)
(dict-remove! dict key)
(dict-remove dict key)
(dict-count dict)
(dict-iterate-first dict)
(dict-iterate-next dict pos)
(dict-iterate-key dict pos)
(dict-iterate-value dict pos))
(define (dict-property-guard v info)
(check-dict-vector 'prop:dict "dictionary property" v)
@ -90,9 +104,6 @@
(apply format fmt args)
(current-continuation-marks))))
(define-values (prop:dict dict-struct? dict-struct-ref)
(make-struct-type-property 'dict dict-property-guard))
(define (get-dict-ref v)
(vector-ref v 0))
(define (get-dict-set! v)
@ -117,46 +128,46 @@
(define (assoc? v)
(and (list? v) (andmap pair? v)))
(define (dict? v)
(define (d:dict? v)
(or (hash? v)
(vector? v)
(assoc? v)
(dict-struct? v)))
(dict? v)))
(define (dict-mutable? d)
(if (dict? d)
(if (d:dict? d)
(or (and (or (hash? d)
(vector? d))
(not (immutable? d)))
(and (dict-struct? d)
(get-dict-set! (dict-struct-ref d))
(and (dict? d)
(hash-ref (dict-def-table d) 'dict-set! #f)
#t))
(raise-type-error 'dict-mutable? "dict" d)))
(define (dict-can-remove-keys? d)
(if (dict? d)
(if (d:dict? d)
(or (hash? d)
(assoc? d)
(and (dict-struct? d)
(or (get-dict-remove! (dict-struct-ref d))
(get-dict-remove (dict-struct-ref d)))
(and (dict? d)
(or (hash-ref (dict-def-table d) 'dict-remove! #f)
(hash-ref (dict-def-table d) 'dict-remove #f))
#t))
(raise-type-error 'dict-can-remove-keys? "dict" d)))
(define (dict-can-functional-set? d)
(if (dict? d)
(if (d:dict? d)
(or (and (hash? d) (immutable? d))
(assoc? d)
(and (dict-struct? d)
(get-dict-set (dict-struct-ref d))
(and (dict? d)
(hash-ref (dict-def-table d) 'dict-set #f)
#t))
(raise-type-error 'dict-can-functional-set? "dict" d)))
(define (dict-has-key? d k)
(define not-there (gensym))
(not (eq? not-there (dict-ref d k not-there))))
(not (eq? not-there (d:dict-ref d k not-there))))
(define dict-ref
(define d:dict-ref
(case-lambda
[(d key)
(cond
@ -170,8 +181,7 @@
(format "no value for key: ~e in: "
key)
d)))]
[(dict-struct? d)
((get-dict-ref (dict-struct-ref d)) d key)]
[(dict? d) (dict-ref d key)]
[else
(raise-type-error 'dict-ref "dict" 0 d key)])]
[(d key default)
@ -190,30 +200,30 @@
(if (procedure? default)
(default)
default)))]
[(dict-struct? d)
((get-dict-ref (dict-struct-ref d)) d key default)]
[(dict? d)
(dict-ref d key default)]
[else
(raise-type-error 'dict-ref "dict" 0 d key default)])]))
(define (dict-ref! d key new)
(define not-there (gensym))
(define v (dict-ref d key not-there))
(define v (d:dict-ref d key not-there))
(if (eq? not-there v)
(let ([n (if (procedure? new) (new) new)])
(dict-set! d key n)
(d:dict-set! d key n)
n)
v))
(define (dict-set! d key val)
(define (d:dict-set! d key val)
(cond
[(hash? d) (hash-set! d key val)]
[(vector? d) (vector-set! d key val)]
[(assoc? d)
(raise-type-error 'dict-set! "mutable dict" 0 d key val)]
[(dict-struct? d)
(let ([s! (get-dict-set! (dict-struct-ref d))])
[(dict? d)
(let ([s! (hash-ref (dict-def-table d) 'dict-set! #f)])
(if s!
(s! d key val)
(dict-set! d key val)
(raise-type-error 'dict-set! "mutable dict" 0 d key val)))]
[else
(raise-type-error 'dict-set! "dict" 0 d key val)]))
@ -223,10 +233,10 @@
(error 'dict-set*! "expected an even number of association elements, but received an odd number: ~e" pairs))
(let loop ([pairs pairs])
(unless (null? pairs)
(dict-set! d (car pairs) (cadr pairs))
(d:dict-set! d (car pairs) (cadr pairs))
(loop (cddr pairs)))))
(define (dict-set d key val)
(define (d:dict-set d key val)
(cond
[(hash? d) (hash-set d key val)]
[(vector? d)
@ -240,10 +250,10 @@
(if (equal? (car a) key)
(cons (cons key val) (cdr xd))
(cons a (loop (cdr xd)))))]))]
[(dict-struct? d)
(let ([s (get-dict-set (dict-struct-ref d))])
[(dict? d)
(let ([s (hash-ref (dict-def-table d) 'dict-set #f)])
(if s
(s d key val)
(dict-set d key val)
(raise-type-error 'dict-set "functional-update dict" 0 d key val)))]
[else
(raise-type-error 'dict-set "dict" 0 d key val)]))
@ -255,39 +265,39 @@
[pairs pairs])
(if (null? pairs)
d
(loop (dict-set d (car pairs) (cadr pairs))
(loop (d:dict-set d (car pairs) (cadr pairs))
(cddr pairs)))))
(define dict-update!
(case-lambda
[(d key xform)
(dict-set! d key (xform (dict-ref d key)))]
(d:dict-set! d key (xform (d:dict-ref d key)))]
[(d key xform default)
(dict-set! d key (xform (dict-ref d key default)))]))
(d:dict-set! d key (xform (d:dict-ref d key default)))]))
(define dict-update
(case-lambda
[(d key xform)
(dict-set d key (xform (dict-ref d key)))]
(d:dict-set d key (xform (d:dict-ref d key)))]
[(d key xform default)
(dict-set d key (xform (dict-ref d key default)))]))
(d:dict-set d key (xform (d:dict-ref d key default)))]))
(define (dict-remove! d key)
(define (d:dict-remove! d key)
(cond
[(hash? d) (hash-remove! d key)]
[(vector? d)
(raise-type-error 'dict-remove! "dict with removeable keys" 0 d key)]
[(assoc? d)
(raise-type-error 'dict-remove! "mutable dict" 0 d key)]
[(dict-struct? d)
(let ([r! (get-dict-remove! (dict-struct-ref d))])
[(dict? d)
(let ([r! (hash-ref (dict-def-table d) 'dict-remove! #f)])
(if r!
(r! d key)
(dict-remove! d key)
(raise-type-error 'dict-remove! "mutable dict with removable keys" 0 d key)))]
[else
(raise-type-error 'dict-remove! "dict" 0 d key)]))
(define (dict-remove d key)
(define (d:dict-remove d key)
(cond
[(hash? d) (hash-remove d key)]
[(vector? d)
@ -301,37 +311,37 @@
(if (equal? (car a) key)
(cdr xd)
(cons a (loop (cdr xd)))))]))]
[(dict-struct? d)
(let ([s (get-dict-remove (dict-struct-ref d))])
[(dict? d)
(let ([s (hash-ref (dict-def-table d) 'dict-remove #f)])
(if s
(s d key)
(dict-remove d key)
(raise-type-error 'dict-remove "dict with functionally removeable keys" 0 d key)))]
[else
(raise-type-error 'dict-remove "dict" 0 d key)]))
(define (dict-count d)
(define (d:dict-count d)
(cond
[(hash? d) (hash-count d)]
[(vector? d) (vector-length d)]
[(assoc? d) (length d)]
[(dict-struct? d) ((get-dict-count (dict-struct-ref d)) d)]
[(dict? d) (dict-count d)]
[else
(raise-type-error 'dict-count "dict" d)]))
(struct assoc-iter (head pos))
(define (dict-iterate-first d)
(define (d:dict-iterate-first d)
(cond
[(hash? d) (hash-iterate-first d)]
[(vector? d) (if (zero? (vector-length d))
#f
0)]
[(assoc? d) (if (null? d) #f (assoc-iter d d))]
[(dict-struct? d) ((get-dict-iterate-first (dict-struct-ref d)) d)]
[(dict? d) (dict-iterate-first d)]
[else
(raise-type-error 'dict-iterate-first "dict" d)]))
(define (dict-iterate-next d i)
(define (d:dict-iterate-next d i)
(cond
[(hash? d) (hash-iterate-next d i)]
[(vector? d) (let ([len (vector-length d)])
@ -353,7 +363,7 @@
(if (null? pos)
#f
(assoc-iter d pos)))]
[(dict-struct? d) ((get-dict-iterate-next (dict-struct-ref d)) d i)]
[(dict? d) (dict-iterate-next d i)]
[(assoc? d)
(raise-mismatch-error
'dict-iterate-next
@ -362,12 +372,12 @@
[else
(raise-type-error 'dict-iterate-next "dict" d)]))
(define (dict-iterate-key d i)
(define (d:dict-iterate-key d i)
(cond
[(hash? d) (hash-iterate-key d i)]
[(vector? d) i]
[(and (assoc-iter? i) (eq? d (assoc-iter-head i))) (caar (assoc-iter-pos i))]
[(dict-struct? d) ((get-dict-iterate-key (dict-struct-ref d)) d i)]
[(dict? d) (dict-iterate-key d i)]
[(assoc? d)
(raise-mismatch-error
'dict-iterate-key
@ -376,12 +386,12 @@
[else
(raise-type-error 'dict-iterate-key "dict" d)]))
(define (dict-iterate-value d i)
(define (d:dict-iterate-value d i)
(cond
[(hash? d) (hash-iterate-value d i)]
[(vector? d) (vector-ref d i)]
[(and (assoc-iter? i) (eq? d (assoc-iter-head i))) (cdar (assoc-iter-pos i))]
[(dict-struct? d) ((get-dict-iterate-value (dict-struct-ref d)) d i)]
[(dict? d) (dict-iterate-value d i)]
[(assoc? d)
(raise-mismatch-error
'dict-iterate-value
@ -398,35 +408,35 @@
#'[(key-id val-id)
(:do-in ([(d) dict-expr])
(void)
([i (dict-iterate-first d)])
([i (d:dict-iterate-first d)])
i
([key-id (dict-iterate-key d i)]
[val-id (dict-iterate-value d i)])
([key-id (d:dict-iterate-key d i)]
[val-id (d:dict-iterate-value d i)])
#t
#t
((dict-iterate-next d i)))]]
((d:dict-iterate-next d i)))]]
[_ #f])))
(define (in-dict d)
(make-dict-sequence
d
(lambda (i)
(values (dict-iterate-key d i)
(dict-iterate-value d i)))
(values (d:dict-iterate-key d i)
(d:dict-iterate-value d i)))
(lambda (k v) #t)
(lambda (i k v) #t)))
(define (in-dict-keys d)
(make-dict-sequence
d
(lambda (i) (dict-iterate-key d i))
(lambda (i) (d:dict-iterate-key d i))
(lambda (k) #t)
(lambda (i k) #t)))
(define (in-dict-values d)
(make-dict-sequence
d
(lambda (i) (dict-iterate-value d i))
(lambda (i) (d:dict-iterate-value d i))
(lambda (v) #t)
(lambda (i v) #t)))
@ -434,8 +444,8 @@
(make-dict-sequence
d
(lambda (i)
(cons (dict-iterate-key d i)
(dict-iterate-value d i)))
(cons (d:dict-iterate-key d i)
(d:dict-iterate-value d i)))
(lambda (p) #t)
(lambda (i p) #t)))
@ -443,8 +453,8 @@
(make-do-sequence
(lambda ()
(values get
(lambda (i) (dict-iterate-next d i))
(dict-iterate-first d)
(lambda (i) (d:dict-iterate-next d i))
(d:dict-iterate-first d)
(lambda (i) i)
val-true
val+pos-true))))
@ -525,16 +535,15 @@
(struct custom-hash (table make-box)
#:property prop:dict
(vector custom-hash-ref
custom-hash-set!
#f
custom-hash-remove!
#f
custom-hash-count
custom-hash-iterate-first
custom-hash-iterate-next
custom-hash-iterate-key
custom-hash-iterate-value)
(define-methods dict
(define dict-ref custom-hash-ref)
(define dict-set! custom-hash-set!)
(define dict-remove! custom-hash-remove!)
(define dict-count custom-hash-count)
(define dict-iterate-first custom-hash-iterate-first)
(define dict-iterate-next custom-hash-iterate-next)
(define dict-iterate-key custom-hash-iterate-key)
(define dict-iterate-value custom-hash-iterate-value))
#:property prop:equal+hash
(list (lambda (a b recur)
(and (recur (custom-hash-make-box a)
@ -546,16 +555,15 @@
(struct immutable-custom-hash custom-hash ()
#:property prop:dict
(vector custom-hash-ref
#f
custom-hash-set
#f
custom-hash-remove
custom-hash-count
custom-hash-iterate-first
custom-hash-iterate-next
custom-hash-iterate-key
custom-hash-iterate-value))
(define-methods dict
(define dict-ref custom-hash-ref)
(define dict-set custom-hash-set)
(define dict-remove custom-hash-remove)
(define dict-count custom-hash-count)
(define dict-iterate-first custom-hash-iterate-first)
(define dict-iterate-next custom-hash-iterate-next)
(define dict-iterate-key custom-hash-iterate-key)
(define dict-iterate-value custom-hash-iterate-value)))
(define-values (create-custom-hash
create-immutable-custom-hash
@ -605,27 +613,29 @@
;; --------------------
(provide prop:dict
dict?
(provide dict
prop:dict
(rename-out
[d:dict? dict?]
[d:dict-ref dict-ref]
[d:dict-set! dict-set!]
[d:dict-set dict-set]
[d:dict-remove! dict-remove!]
[d:dict-remove dict-remove]
[d:dict-count dict-count]
[d:dict-iterate-first dict-iterate-first]
[d:dict-iterate-next dict-iterate-next]
[d:dict-iterate-key dict-iterate-key]
[d:dict-iterate-value dict-iterate-value])
dict-mutable?
dict-can-remove-keys?
dict-can-functional-set?
dict-has-key?
dict-ref
dict-ref!
dict-set!
dict-set
dict-set*!
dict-set*
dict-update!
dict-update
dict-remove!
dict-remove
dict-count
dict-iterate-first
dict-iterate-next
dict-iterate-key
dict-iterate-value
dict-map
dict-for-each
dict-keys