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

Add more hash-like operations to id-table

Browse Source 
The operations are ref!, set*, set*!, update, and
update!. Also bumps version number.
This commit is contained in:
Asumu Takikawa 2015-11-09 16:46:20 -05:00
parent c40229f756
commit 92fc1f41c8
6 changed files with 209 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/base/info.rkt
View File

@ -12,7 +12,7 @@
(define collection 'multi)
(define version "6.3.0.5")
(define version "6.3.0.6")
(define deps `("racket-lib"
["racket" #:version ,version]))

83
pkgs/racket-doc/syntax/scribblings/id-table.scrbl
View File

@ -118,6 +118,16 @@ the @racket[failure] argument is applied if it is a procedure, or
simply returned otherwise.
}
@defproc[(free-id-table-ref! [table mutable-free-id-table?]
[id identifier?]
[failure any/c])
any]{
Like @racket[hash-ref!].
@history[#:added "6.3.0.6"]
}
@defproc[(free-id-table-set! [table mutable-free-id-table?]
[id identifier?]
[v any/c])
@ -134,6 +144,26 @@ Like @racket[hash-set!].
Like @racket[hash-set].
}
@defproc[(free-id-table-set*! [table mutable-free-id-table?]
[id identifier?]
[v any/c] ...)
void?]{
Like @racket[hash-set*!].
@history[#:added "6.3.0.6"]
}
@defproc[(free-id-table-set* [table immutable-free-id-table?]
[id identifier?]
[v any/c] ...)
immutable-free-id-table?]{
Like @racket[hash-set*].
@history[#:added "6.3.0.6"]
}
@defproc[(free-id-table-remove! [table mutable-free-id-table?]
[id identifier?])
void?]{
@ -148,6 +178,30 @@ Like @racket[hash-remove!].
Like @racket[hash-remove].
}
@defproc[(free-id-table-update! [table mutable-free-id-table?]
[id identifier?]
[updater (any/c . -> . any/c)]
[failure any/c
(lambda () (raise (make-exn:fail .....)))])
void?]{
Like @racket[hash-update!].
@history[#:added "6.3.0.6"]
}
@defproc[(free-id-table-update [table immutable-free-id-table?]
[id identifier?]
[updater (any/c . -> . any/c)]
[failure any/c
(lambda () (raise (make-exn:fail .....)))])
immutable-free-id-table?]{
Like @racket[hash-update].
@history[#:added "6.3.0.6"]
}
@defproc[(free-id-table-map [table free-id-table?]
[proc (-> identifier? any/c any)])
list?]{
@ -254,6 +308,10 @@ etc) can be used on bound-identifier tables.
[failure any/c
(lambda () (raise (make-exn:fail .....)))])
any]
@defproc[(bound-id-table-ref! [table mutable-bound-id-table?]
[id identifier?]
[failure any/c])
any]
@defproc[(bound-id-table-set! [table mutable-bound-id-table?]
[id identifier?]
[v any/c])
@ -262,12 +320,32 @@ etc) can be used on bound-identifier tables.
[id identifier?]
[v any/c])
immutable-bound-id-table?]
@defproc[(bound-id-table-set*! [table mutable-bound-id-table?]
[id identifier?]
[v any/c] ...)
void?]
@defproc[(bound-id-table-set* [table immutable-bound-id-table?]
[id identifier?]
[v any/c] ...)
immutable-bound-id-table?]
@defproc[(bound-id-table-remove! [table mutable-bound-id-table?]
[id identifier?])
void?]
@defproc[(bound-id-table-remove [table immutable-bound-id-table?]
[id identifier?])
immutable-bound-id-table?]
@defproc[(bound-id-table-update! [table mutable-bound-id-table?]
[id identifier?]
[updater (any/c . -> . any/c)]
[failure any/c
(lambda () (raise (make-exn:fail .....)))])
void?]
@defproc[(bound-id-table-update [table immutable-bound-id-table?]
[id identifier?]
[updater (any/c . -> . any/c)]
[failure any/c
(lambda () (raise (make-exn:fail .....)))])
immutable-bound-id-table?]
@defproc[(bound-id-table-map [table bound-id-table?]
[proc (-> identifier? any/c any)])
list?]
@ -304,7 +382,10 @@ Like the procedures for free-identifier tables
for bound-identifier tables, which use @racket[bound-identifier=?] to
compare keys.
@history[#:changed "6.3.0.3" "Added bound-id-table-keys, bound-id-table-values, in-bound-id-table."]
@history[#:changed "6.3.0.3" "Added bound-id-table-keys, bound-id-table-values, in-bound-id-table."
#:changed "6.3.0.6"
@string-append{Added bound-id-table-ref!, bound-id-table-set*,
bound-id-table-set*!, bound-id-table-update!, and bound-id-table-update}]
}
@close-eval[id-table-eval]

35
pkgs/racket-test-core/tests/racket/id-table-test.rktl
View File

@ -389,6 +389,41 @@
(list (cons #'x 0) (cons #'x 1) (cons #'y 2))))
bound-identifier=?))
;; Tests for id-table-set*, set*!, update, update!, ref!
(let ()
(define table (make-bound-id-table))
(define table2 (make-immutable-bound-id-table))
(define x0 #'x)
(define x1 ((make-syntax-introducer) x0))
(define y0 #'y)
(define y1 ((make-syntax-introducer) y0))
(test 0 bound-id-table-ref! table x0 0)
(test 1 bound-id-table-ref! table x1 1)
(test 0 bound-id-table-ref table x0)
(test 1 bound-id-table-ref (bound-id-table-update table2 y0 add1 0) y0)
(test 1 bound-id-table-ref (bound-id-table-set* table2 y0 0 y1 1) y1)
(test (void) bound-id-table-set*! table y0 1 y1 5)
(test (void) bound-id-table-update! table y0 add1 0)
(test 2 bound-id-table-ref table y0))
(let ()
(define table (make-free-id-table))
(define table2 (make-immutable-free-id-table))
(define x0 #'x)
(define x1 #'x1)
(define y0 #'y)
(define y1 #'y1)
(test 0 free-id-table-ref! table x0 0)
(test 1 free-id-table-ref! table x1 1)
(test 0 free-id-table-ref table x0)
(test 1 free-id-table-ref (free-id-table-update table2 y0 add1 0) y0)
(test 1 free-id-table-ref (free-id-table-set* table2 y0 0 y1 1) y1)
(test (void) free-id-table-set*! table y0 1 y1 5)
(test (void) free-id-table-update! table y0 add1 0)
(test 2 free-id-table-ref table y0))
(define-syntax name-for-boundmap-test 'dummy)
(define-syntax alias-for-boundmap-test (make-rename-transformer #'name-for-boundmap-test))
(define table (make-free-id-table))

31
racket/collects/syntax/id-table.rkt
View File

@ -197,6 +197,8 @@
idtbl-set! idtbl-set
idtbl-remove! idtbl-remove
idtbl-set/constructor idtbl-remove/constructor
idtbl-set* idtbl-set*/constructor idtbl-set*! idtbl-ref!
idtbl-update idtbl-update/constructor idtbl-update!
idtbl-count
idtbl-iterate-first idtbl-iterate-next
idtbl-iterate-key idtbl-iterate-value
@ -232,6 +234,13 @@
(idtbl-set/constructor d id v immutable-idtbl))
(define (idtbl-remove d id)
(idtbl-remove/constructor d id immutable-idtbl))
(define (idtbl-set* d . rst)
(apply idtbl-set*/constructor d immutable-idtbl rst))
(define not-given (gensym 'not-given))
(define (idtbl-update d id updater [default not-given])
(if (eq? default not-given)
(idtbl-update/constructor d id updater immutable-idtbl)
(idtbl-update/constructor d id updater immutable-idtbl default)))
(define idtbl-immutable-methods
(vector-immutable idtbl-ref
#f
@ -279,6 +288,28 @@
(-> mutable-idtbl? identifier? void?)]
[idtbl-remove
(-> immutable-idtbl? identifier? immutable-idtbl?)]
[idtbl-set*
(->* [immutable-idtbl?]
#:rest (flat-rec-contract key-value-pairs
(or/c null
(cons/c identifier? (cons/c any/c key-value-pairs))))
immutable-idtbl?)]
[idtbl-set*!
(->* [mutable-idtbl?]
#:rest (flat-rec-contract key-value-pairs
(or/c null
(cons/c identifier? (cons/c any/c key-value-pairs))))
void?)]
[idtbl-ref!
(-> mutable-idtbl? identifier? any/c any)]
[idtbl-update
(->* [immutable-idtbl? identifier? (-> any/c any/c)]
[any/c]
immutable-idtbl?)]
[idtbl-update!
(->* [mutable-idtbl? identifier? (-> any/c any/c)]
[any/c]
void?)]
[idtbl-count
(-> idtbl? exact-nonnegative-integer?)]
[idtbl-iterate-first

58
racket/collects/syntax/private/id-table.rkt
View File

@ -136,6 +136,47 @@ The {key,value}-{in-out} functions should all return a chaperone of their argume
(hash-remove (id-table-hash d) sym))
phase)))
(define (id-table-set*! who d identifier->symbol identifier=? . rst)
(let loop ([rst rst])
(cond [(null? rst) (void)]
[else
(id-table-set!
who d
(car rst) (cadr rst)
identifier->symbol identifier=?)
(loop (cddr rst))])))
(define (id-table-set*/constructor who d constructor identifier->symbol identifier=? . rst)
(let loop ([d d] [rst rst])
(if (null? rst)
d
(loop (id-table-set/constructor
who d
(car rst) (cadr rst)
constructor identifier->symbol identifier=?)
(cddr rst)))))
(define missing (gensym 'missing))
(define (id-table-ref! who d id default identifier->symbol identifier=?)
(define entry (id-table-ref who d id missing identifier->symbol identifier=?))
(cond [(eq? entry missing)
(id-table-set! who d id default identifier->symbol identifier=?)
default]
[else entry]))
(define (id-table-update/constructor who d id updater default constructor identifier->symbol identifier=?)
(define entry
(id-table-ref who d id default identifier->symbol identifier=?))
(id-table-set/constructor
who d id
(updater entry)
constructor identifier->symbol identifier=?))
(define (id-table-update! who d id updater default identifier->symbol identifier=?)
(define entry
(id-table-ref who d id default identifier->symbol identifier=?))
(id-table-set! who d id (updater entry) identifier->symbol identifier=?))
(define (id-table-count d)
(for/sum ([(k v) (in-hash (id-table-hash d))])
(length v)))
@ -312,6 +353,8 @@ Notes (FIXME?):
idtbl-set! idtbl-set
idtbl-remove! idtbl-remove
idtbl-set/constructor idtbl-remove/constructor
idtbl-set* idtbl-set*/constructor idtbl-set*! idtbl-ref!
idtbl-update idtbl-update/constructor idtbl-update!
idtbl-count
idtbl-iterate-first idtbl-iterate-next
idtbl-iterate-key idtbl-iterate-value
@ -347,6 +390,16 @@ Notes (FIXME?):
(id-table-remove/constructor 'idtbl-remove d id constructor identifier->symbol identifier=?))
(define (idtbl-remove d id)
(idtbl-remove/constructor d id immutable-idtbl))
(define (idtbl-set*/constructor d constructor . rst)
(apply id-table-set*/constructor 'idtbl-set* d constructor identifier->symbol identifier=? rst))
(define (idtbl-set*! d . rst)
(apply id-table-set*! 'idtbl-set*! d identifier->symbol identifier=? rst))
(define (idtbl-ref! d id default)
(id-table-ref! 'idtbl-ref! d id default identifier->symbol identifier=?))
(define (idtbl-update/constructor d id updater constructor [default not-given])
(id-table-update/constructor 'idtbl-update d id updater default constructor identifier->symbol identifier=?))
(define (idtbl-update! d id updater [default not-given])
(id-table-update! 'idtbl-update! d id updater default identifier->symbol identifier=?))
(define (idtbl-count d)
(id-table-count d))
(define (idtbl-for-each d p)
@ -417,6 +470,9 @@ Notes (FIXME?):
idtbl-set
idtbl-remove!
idtbl-remove
idtbl-set*!
idtbl-ref!
idtbl-update!
idtbl-count
idtbl-iterate-first
idtbl-iterate-next
@ -430,7 +486,9 @@ Notes (FIXME?):
;; just for use/extension by syntax/id-table
idtbl-set/constructor
idtbl-set*/constructor
idtbl-remove/constructor
idtbl-update/constructor
idtbl-mutable-methods
mutable-idtbl
immutable-idtbl)))]))

4
racket/src/racket/src/schvers.h
View File

@ -13,12 +13,12 @@
consistently.)
*/
#define MZSCHEME_VERSION "6.3.0.5"
#define MZSCHEME_VERSION "6.3.0.6"
#define MZSCHEME_VERSION_X 6
#define MZSCHEME_VERSION_Y 3
#define MZSCHEME_VERSION_Z 0
#define MZSCHEME_VERSION_W 4
#define MZSCHEME_VERSION_W 6
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)