forked from emina/rosette
-
Notifications
You must be signed in to change notification settings - Fork 0
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Simplify and test the implementation of ordered dictionaries.
- Loading branch information
Showing
4 changed files
with
104 additions
and
103 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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?)) | ||
|
||
|
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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?)) |