From 92fc1f41c83a149135575bbcbedd671f4cf2e3a5 Mon Sep 17 00:00:00 2001 From: Asumu Takikawa Date: Mon, 9 Nov 2015 16:46:20 -0500 Subject: [PATCH] Add more hash-like operations to id-table The operations are ref!, set*, set*!, update, and update!. Also bumps version number. --- pkgs/base/info.rkt | 2 +- .../syntax/scribblings/id-table.scrbl | 83 ++++++++++++++++++- .../tests/racket/id-table-test.rktl | 35 ++++++++ racket/collects/syntax/id-table.rkt | 31 +++++++ racket/collects/syntax/private/id-table.rkt | 58 +++++++++++++ racket/src/racket/src/schvers.h | 4 +- 6 files changed, 209 insertions(+), 4 deletions(-) diff --git a/pkgs/base/info.rkt b/pkgs/base/info.rkt index 3c80fdb375..4622d86004 100644 --- a/pkgs/base/info.rkt +++ b/pkgs/base/info.rkt @@ -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])) diff --git a/pkgs/racket-doc/syntax/scribblings/id-table.scrbl b/pkgs/racket-doc/syntax/scribblings/id-table.scrbl index 376954301e..3cea9b42f4 100644 --- a/pkgs/racket-doc/syntax/scribblings/id-table.scrbl +++ b/pkgs/racket-doc/syntax/scribblings/id-table.scrbl @@ -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] diff --git a/pkgs/racket-test-core/tests/racket/id-table-test.rktl b/pkgs/racket-test-core/tests/racket/id-table-test.rktl index 3ae9668228..d47d8622bd 100644 --- a/pkgs/racket-test-core/tests/racket/id-table-test.rktl +++ b/pkgs/racket-test-core/tests/racket/id-table-test.rktl @@ -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)) diff --git a/racket/collects/syntax/id-table.rkt b/racket/collects/syntax/id-table.rkt index f4b96fd79c..a9fb980bef 100644 --- a/racket/collects/syntax/id-table.rkt +++ b/racket/collects/syntax/id-table.rkt @@ -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 diff --git a/racket/collects/syntax/private/id-table.rkt b/racket/collects/syntax/private/id-table.rkt index e09c3646d1..b7c0ad745c 100644 --- a/racket/collects/syntax/private/id-table.rkt +++ b/racket/collects/syntax/private/id-table.rkt @@ -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)))])) diff --git a/racket/src/racket/src/schvers.h b/racket/src/racket/src/schvers.h index 8f27de7232..46c0cbf6a6 100644 --- a/racket/src/racket/src/schvers.h +++ b/racket/src/racket/src/schvers.h @@ -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)