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

Adding immutable hash operations to ASL

Browse Source
This commit is contained in:
Jay McCarthy 2010-08-25 10:36:11 -06:00
parent 368d711ae2
commit 45a8854398
3 changed files with 142 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
collects/lang/private/advanced-funs.rkt
View File

@ -113,19 +113,36 @@
(case->
(-> (hash X Y))
((listof (list X Y)) -> (hash X Y)))
"to construct a hash table from an optional list of mappings that uses equal? for comparisions")
"to construct a mutable hash table from an optional list of mappings that uses equal? for comparisions")
((advanced-make-hasheq make-hasheq)
(case->
(-> (hash X Y))
((listof (list X Y)) -> (hash X Y)))
"to construct a hash table from an optional list of mappings that uses eq? for comparisions")
"to construct a mutable hash table from an optional list of mappings that uses eq? for comparisions")
((advanced-make-hasheqv make-hasheqv)
(case->
(-> (hash X Y))
((listof (list X Y)) -> (hash X Y)))
"to construct a hash table from an optional list of mappings that uses eqv? for comparisions")
"to construct a mutable hash table from an optional list of mappings that uses eqv? for comparisions")
((advanced-make-immutable-hash make-immutable-hash)
(case->
(-> (hash X Y))
((listof (list X Y)) -> (hash X Y)))
"to construct an immutable hash table from an optional list of mappings that uses equal? for comparisions")
((advanced-make-immutable-hasheq make-immutable-hasheq)
(case->
(-> (hash X Y))
((listof (list X Y)) -> (hash X Y)))
"to construct an immutable hash table from an optional list of mappings that uses eq? for comparisions")
((advanced-make-immutable-hasheqv make-immutable-hasheqv)
(case->
(-> (hash X Y))
((listof (list X Y)) -> (hash X Y)))
"to construct an immutable hash table from an optional list of mappings that uses eqv? for comparisions")
(hash-set! ((hash X Y) X Y -> void)
"to update a hash table with a new mapping")
"to update a mutable hash table with a new mapping")
(hash-set ((hash X Y) X Y -> (hash X Y))
"to construct an immutable hash table with one new mapping from an existing immutable hash table")
(hash-ref (case->
((hash X Y) X -> Y)
((hash X Y) X Y -> Y)
@ -134,16 +151,23 @@
(hash-ref! (case->
((hash X Y) X Y -> Y)
((hash X Y) X (-> Y) -> Y))
"to extract the value associated with a key from a hash table; if the key does not have an mapping, the third argument is used as the value (or used to compute the value) and is added to the hash table associated with the key")
"to extract the value associated with a key from a mutable hash table; if the key does not have an mapping, the third argument is used as the value (or used to compute the value) and is added to the hash table associated with the key")
(hash-update! (case->
((hash X Y) X (Y -> Y) -> void)
((hash X Y) X (Y -> Y) Y -> void)
((hash X Y) X (Y -> Y) (-> Y) -> void))
"to compose hash-ref and hash-set! to update an existing mapping; the third argument is used to compute the new mapping value; the fourth argument is used as the third argument to hash-ref")
(hash-update (case->
((hash X Y) X (Y -> Y) -> (hash X Y))
((hash X Y) X (Y -> Y) Y -> (hash X Y))
((hash X Y) X (Y -> Y) (-> Y) -> (hash X Y)))
"to compose hash-ref and hash-set to update an existing mapping; the third argument is used to compute the new mapping value; the fourth argument is used as the third argument to hash-ref")
(hash-has-key? ((hash X Y) X -> boolean)
"to determine if a key is associated with a value in a hash table")
(hash-remove! ((hash X Y) X -> void)
"to remove an mapping from a hash table")
"to remove an mapping from a mutable hash table")
(hash-remove ((hash X Y) X -> (hash X Y))
"to construct an immutable hash table with one less mapping than an existing immutable hash table")
(hash-map ((hash X Y) (X Y -> A) -> (listof A))
"to construct a new list by applying a function to each mapping of a hash table")
(hash-for-each ((hash X Y) (X Y -> any) -> void)

15
collects/lang/private/teachprims.rkt
View File

@ -357,6 +357,18 @@ namespace.
(lambda ([a empty])
(make-hasheqv (map (lambda (l) (cons (first l) (second l))) a))))
(define-teach advanced make-immutable-hash
(lambda ([a empty])
(make-immutable-hash (map (lambda (l) (cons (first l) (second l))) a))))
(define-teach advanced make-immutable-hasheq
(lambda ([a empty])
(make-immutable-hasheq (map (lambda (l) (cons (first l) (second l))) a))))
(define-teach advanced make-immutable-hasheqv
(lambda ([a empty])
(make-immutable-hasheqv (map (lambda (l) (cons (first l) (second l))) a))))
(provide
false?
beginner-not
@ -390,6 +402,9 @@ namespace.
advanced-make-hash
advanced-make-hasheq
advanced-make-hasheqv
advanced-make-immutable-hash
advanced-make-immutable-hasheq
advanced-make-immutable-hasheqv
cyclic-list?)
;; -----------------------------------------------------------------------------

97
collects/tests/racket/advanced.rktl
View File

@ -242,10 +242,23 @@
(list (hash-has-key? ht 'a)
(begin (hash-remove! ht 'a)
(hash-has-key? ht 'a)))))
(htdp-err/rt-test
(local [(define ht (make-hash (list (list 'a 1))))]
(list (hash-has-key? ht 'a)
(begin (hash-remove ht 'a)
(hash-has-key? ht 'a)))))
(htdp-test 2 'hash-set!
(local [(define ht (make-hash (list (list 'a 1))))]
(begin (hash-set! ht 'a 2)
(hash-ref ht 'a))))
(htdp-err/rt-test
(local [(define ht (make-hash (list (list 'a 1))))]
(begin (hash-set ht 'a 2)
(hash-ref ht 'a))))
(htdp-err/rt-test
(local [(define ht (make-hash (list (list 'a 1))))]
(begin (hash-update ht 'a add1)
(hash-ref ht 'a))))
(htdp-test 2 'hash-update!
(local [(define ht (make-hash (list (list 'a 1))))]
(begin (hash-update! ht 'a add1)
@ -291,6 +304,90 @@
(htdp-test #t 'hash-eqv?
(hash-eqv? (make-hasheqv (list (list 'a 1)))))
;; immutable tests
(htdp-test 1 'hash-copy
(local [(define ht (make-immutable-hash (list (list 'a 1))))
(define htp (hash-copy ht))]
(hash-ref htp 'a)))
(htdp-test 1 'hash-count (hash-count (make-immutable-hash (list (list 'a 1)))))
(htdp-test 42 'hash-for-each
(local [(define x 0)
(define (f k v) (set! x 42))]
(begin (hash-for-each (make-immutable-hash (list (list 1 2))) f)
x)))
(htdp-test #t 'hash-has-key? (hash-has-key? (make-immutable-hash (list (list 1 2))) 1))
(htdp-test #f 'hash-has-key? (hash-has-key? (make-immutable-hash (list (list 1 2))) 2))
(htdp-test (list #f #f) 'hash-map
(hash-map (make-immutable-hash (list (list 1 #t) (list 2 #t)))
(lambda (k v) (not v))))
(htdp-test 1 'hash-ref (hash-ref (make-immutable-hash (list (list 'a 1))) 'a))
(htdp-test 2 'hash-ref (hash-ref (make-immutable-hash (list (list 'a 1))) 'b 2))
(htdp-test 2 'hash-ref (hash-ref (make-immutable-hash (list (list 'a 1))) 'b (lambda () 2)))
(htdp-err/rt-test
(local [(define ht (make-immutable-hash (list (list 'a 1))))]
(hash-ref! ht 'a 2)))
(htdp-err/rt-test
(local [(define ht (make-immutable-hash (list (list 'a 1))))]
(list (hash-has-key? ht 'a)
(begin (hash-remove! ht 'a)
(hash-has-key? ht 'a)))))
(htdp-test (list #t #f) 'hash-remove
(local [(define ht (make-immutable-hash (list (list 'a 1))))]
(list (hash-has-key? ht 'a)
(hash-has-key? (hash-remove ht 'a) 'a))))
(htdp-err/rt-test
(local [(define ht (make-immutable-hash (list (list 'a 1))))]
(begin (hash-set! ht 'a 2)
(hash-ref ht 'a))))
(htdp-test 2 'hash-set
(local [(define ht (make-immutable-hash (list (list 'a 1))))]
(hash-ref (hash-set ht 'a 2) 'a)))
(htdp-err/rt-test
(local [(define ht (make-immutable-hash (list (list 'a 1))))]
(begin (hash-update! ht 'a add1)
(hash-ref ht 'a))))
(htdp-test 2 'hash-update
(local [(define ht (make-immutable-hash (list (list 'a 1))))]
(hash-ref (hash-update ht 'a add1) 'a)))
(htdp-test 2 'hash-update
(local [(define ht (make-immutable-hash (list (list 'a 1))))]
(hash-ref (hash-update ht 'b add1 1) 'b)))
(htdp-test 2 'hash-update
(local [(define ht (make-immutable-hash (list (list 'a 1))))]
(hash-ref (hash-update ht 'b add1 (lambda () 1)) 'b)))
(htdp-test #t 'hash?
(hash? (make-immutable-hash)))
(htdp-test #t 'hash?
(hash? (make-immutable-hasheq)))
(htdp-test #t 'hash?
(hash? (make-immutable-hasheqv)))
(htdp-test #t 'hash?
(hash? (make-immutable-hash (list (list 'a 1)))))
(htdp-test #t 'hash?
(hash? (make-immutable-hasheq (list (list 'a 1)))))
(htdp-test #t 'hash?
(hash? (make-immutable-hasheqv (list (list 'a 1)))))
(htdp-test #f 'hash?
(hash? 1))
(htdp-test #t 'hash-equal?
(hash-equal? (make-immutable-hash (list (list 'a 1)))))
(htdp-test #f 'hash-equal?
(hash-equal? (make-immutable-hasheq (list (list 'a 1)))))
(htdp-test #f 'hash-equal?
(hash-equal? (make-immutable-hasheqv (list (list 'a 1)))))
(htdp-test #f 'hash-eq?
(hash-eq? (make-immutable-hash (list (list 'a 1)))))
(htdp-test #t 'hash-eq?
(hash-eq? (make-immutable-hasheq (list (list 'a 1)))))
(htdp-test #f 'hash-eq?
(hash-eq? (make-immutable-hasheqv (list (list 'a 1)))))
(htdp-test #f 'hash-eqv?
(hash-eqv? (make-immutable-hash (list (list 'a 1)))))
(htdp-test #f 'hash-eqv?
(hash-eqv? (make-immutable-hasheq (list (list 'a 1)))))
(htdp-test #t 'hash-eqv?
(hash-eqv? (make-immutable-hasheqv (list (list 'a 1)))))
;; Check set...! error message:
(htdp-top (define-struct a1 (b)))
(htdp-err/rt-test (set-a1-b! 1 2) #rx"set-a1-b!")