Skip to content

Commit

Permalink
Simplify and test the implementation of ordered dictionaries.
Browse files Browse the repository at this point in the history
  • Loading branch information
emina committed Jan 4, 2018
1 parent 5dd866a commit 9a2a73e
Show file tree
Hide file tree
Showing 4 changed files with 104 additions and 103 deletions.
148 changes: 49 additions & 99 deletions rosette/base/util/ord-dict.rkt
Original file line number Diff line number Diff line change
@@ -1,101 +1,51 @@
#lang racket

(provide ord-dict? [rename-out (make-ordered-dictionary ord-dict)
(make-immutable-ordered-dictionary immutable-ord-dict)]
last-key last-value
first-key first-value
dict-take dict-drop)

(define (last-key dict)
(last (ord-dict-order dict)))

(define (last-value dict)
(ord-dict-ref dict (last-key dict)))

(define (first-key dict)
(first (ord-dict-order dict)))

(define (first-value dict)
(ord-dict-ref dict (first-key dict)))

(define (dict-take dict pos)
(sub-dict dict (take (order dict) pos)))

(define (dict-drop dict pos)
(sub-dict dict (drop (order dict) pos)))

(define (sub-dict dict sub-order)
(let ([tbl (table dict)])
(ord-dict (for/hash ([key sub-order]) (values key (dict-ref tbl key)))
sub-order)))

(define ord-dict-ref
(case-lambda [(dict key) (dict-ref (table dict) key)]
[(dict key failure-result) (dict-ref (table dict) key failure-result)]))

(define (ord-dict-set! dict key value)
(unless (dict-has-key? (table dict) key)
(set-order! dict (append (order dict) (list key))))
(dict-set! (table dict) key value))

(define (ord-dict-remove! dict key)
(when (dict-has-key? (table dict) key)
(set-order! dict (remove key (order dict)))
(dict-remove! (table dict) key)))

(define (ord-dict-count dict) (dict-count (table dict)))

(define (ord-dict-iterate-first dict)
(and (not (null? (order dict)))
(order dict)))

(define (ord-dict-iterate-next dict pos)
(and (not (null? pos))
(not (null? (cdr pos)))
(cdr pos)))

(define (ord-dict-iterate-key dict pos) (car pos))

(define (ord-dict-iterate-value dict pos)
(dict-ref (table dict) (car pos)))

(struct ord-dict (table [order #:mutable])
#:property prop:dict
(vector ord-dict-ref
ord-dict-set! #f
ord-dict-remove! #f
ord-dict-count
ord-dict-iterate-first ord-dict-iterate-next
ord-dict-iterate-key ord-dict-iterate-value)
#:property prop:custom-write
(lambda (self port mode)
(let ([order (order self)]
[table (table self)])
(fprintf port "ordered-dict~s" (map (lambda (key) (cons key (dict-ref table key))) order)))))

(struct immutable-ord-dict ord-dict ()
#:property prop:dict
(vector ord-dict-ref
#f #f
#f #f
ord-dict-count
ord-dict-iterate-first ord-dict-iterate-next
ord-dict-iterate-key ord-dict-iterate-value))

(define table ord-dict-table)
(define order ord-dict-order)
(define set-order! set-ord-dict-order!)

(define (make-ordered-dictionary [assocs null])
(ord-dict (make-hash assocs) (map car assocs)))

(define (make-immutable-ordered-dictionary dict)
(if (immutable-ord-dict? dict)
dict
(let ([dict-hash (for/hash ([(key value) (in-dict dict)]) (values key value))])
(if (ord-dict? dict)
(immutable-ord-dict dict-hash (order dict))
(immutable-ord-dict dict-hash (for/list ([key (in-dict-keys dict)]) key))))))



(provide odict? (rename-out [make-odict odict]))

(struct odict (tbl [ord #:mutable] eq)
#:methods gen:dict
[(define (dict-ref dict key [default (lambda () (error "key not found" key))])
(hash-ref (odict-tbl dict) key default))

(define (dict-set! dict key val)
(match-define (odict tbl ord _) dict)
(unless (hash-has-key? tbl key)
(set-odict-ord! dict (cons key ord)))
(hash-set! tbl key val))

(define (dict-remove! dict key)
(match-define (odict tbl ord eq) dict)
(when (hash-has-key? tbl key)
(hash-remove! tbl key)
(set-odict-ord! dict (remove key ord eq))))

(define (dict-iterate-first dict)
(match-define (odict _ ord _) dict)
(and (not (null? ord)) ord))

(define (dict-iterate-next dict pos)
(and (> (length pos) 1) (cdr pos)))

(define (dict-iterate-key dict pos)
(car pos))

(define (dict-iterate-value dict pos)
(hash-ref (odict-tbl dict) (car pos)))

(define (dict-count dict)
(hash-count (odict-tbl dict)))

(define (dict-has-key dict key)
(hash-has-key? (odict-tbl dict) key))
])

(define (make-odict [assocs null] [is-equal? equal?])
(define make-table
(match is-equal?
[(== equal?) make-hash]
[(== eq?) make-hasheq]
[(== eqv?) make-hasheqv]
[_ (error 'odict "expected equal?, eq?, or eqv? equivalence predicate, given ~a" is-equal?)]))
(odict (make-table assocs) (map car assocs) is-equal?))


2 changes: 1 addition & 1 deletion sdsl/websynth/dom.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -46,7 +46,7 @@
(first (filter element? (read-html-as-xml (get-pure-port (string->url ustr)))))))

(define (tags dom)
(define seen (ord-dict))
(define seen (odict))
(let loop ([dom dom])
(when (DOMNode? dom)
(dict-set! seen (DOMNode-tagname dom) #t)
Expand Down
6 changes: 3 additions & 3 deletions test/all-rosette-tests.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,7 @@

(error-print-width 4)

(run-all-tests
(run-all-tests
"base/effects.rkt"
"base/type.rkt"
"base/term.rkt"
Expand All @@ -21,15 +21,15 @@
"base/vector.rkt"
"base/generics.rkt"
"base/forall.rkt"
"base/ord-dict.rkt"
"query/solve.rkt"
"query/verify.rkt"
"query/synthesize.rkt"
"query/debug.rkt"
"query/solve+.rkt"
"query/optimize.rkt"
"query/synthax.rkt"
"query/push-pop.rkt"
)
"query/push-pop.rkt")

#|
(require rosette)
Expand Down
51 changes: 51 additions & 0 deletions test/base/ord-dict.rkt
Original file line number Diff line number Diff line change
@@ -0,0 +1,51 @@
#lang racket

(require rackunit rackunit/text-ui rosette/lib/roseunit
rosette/base/util/ord-dict)


(define (check-dict d eq k0 k1 k2)
(check-equal? (dict-count d) 0)
(dict-set! d k0 'a)
(check-equal? (dict-count d) 1)
(check-true (dict-has-key? d k0))
(check-false (dict-has-key? d k1))
(check-exn exn:fail? (thunk (dict-ref d k1)))
(dict-set! d k1 'b)
(dict-set! d k2 'c)
(check-equal? (dict-count d) 3)
(check-equal? (dict-iterate-first d) (list k2 k1 k0))
(check-equal? (dict-iterate-next d (dict-iterate-first d)) (list k1 k0))
(check-equal? (dict-iterate-next d (dict-iterate-next d (dict-iterate-first d))) (list k0))
(check-equal? (dict-iterate-next d (dict-iterate-next d (dict-iterate-next d (dict-iterate-first d)))) #f)
(check-equal? (dict-iterate-key d (list k2 k1 k0)) k2)
(check-equal? (dict-iterate-value d (list k2 k1 k0)) 'c)
(check-equal? (dict-iterate-key d (list k1 k0)) k1)
(check-equal? (dict-iterate-value d (list k1 k0)) 'b)
(check-equal? (dict-iterate-key d (list k0)) k0)
(check-equal? (dict-iterate-value d (list k0)) 'a)
(check-exn exn:fail? (thunk (dict-iterate-key d '())))
(dict-remove! d k1)
(check-equal? (dict->list d) `((,k2 . c) (,k0 . a)))
(dict-remove! d k1)
(check-equal? (dict->list d) `((,k2 . c) (,k0 . a)))
(dict-set! d k1 'b)
(check-equal? (dict->list d) `((,k1 . b) (,k2 . c) (,k0 . a)))
(dict-set! d k2 'd)
(check-equal? (dict->list d) `((,k1 . b) (,k2 . d) (,k0 . a)))
)

(define tests-dict-equal?
(test-suite+
"Tests for equal? ordered dictionaries in ord-dict.rkt"
(check-dict (odict) equal? 1 2 3)))

(define tests-dict-eq?
(test-suite+
"Tests for eq? ordered dictionaries in ord-dict.rkt"
(check-dict (odict null eq?) eq?
(vector 0) (vector 0) (vector 0))))


(time (run-tests tests-dict-equal?))
(time (run-tests tests-dict-eq?))

0 comments on commit 9a2a73e

Please sign in to comment.