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

Add *-keys, *-values, in-* functions for id-tables

Browse Source 
Bump version to 6.3.0.3 too
This commit is contained in:
Asumu Takikawa 2015-11-01 02:50:12 -05:00
parent 101fac5c1e
commit 14d25abd76
6 changed files with 139 additions and 6 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.2")
(define version "6.3.0.3")
(define deps `("racket-lib"
["racket" #:version ,version]))

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

@ -155,6 +155,30 @@ Like @racket[hash-remove].
Like @racket[hash-map].
}
@defproc[(free-id-table-keys [table free-id-table?])
(listof identifier?)]{
Like @racket[hash-keys].
@history[#:added "6.3.0.3"]
}
@defproc[(free-id-table-values [table free-id-table?])
(listof any/c)]{
Like @racket[hash-values].
@history[#:added "6.3.0.3"]
}
@defproc[(in-free-id-table [table free-id-table?])
sequence?]{
Like @racket[in-hash].
@history[#:added "6.3.0.3"]
}
@defproc[(free-id-table-for-each [table free-id-table?]
[proc (-> identifier? any/c any)])
void?]{
@ -247,6 +271,12 @@ etc) can be used on bound-identifier tables.
@defproc[(bound-id-table-map [table bound-id-table?]
[proc (-> identifier? any/c any)])
list?]
@defproc[(bound-id-table-keys [table bound-id-table?])
(listof identifier?)]
@defproc[(bound-id-table-values [table bound-id-table?])
(listof any/c)]
@defproc[(in-bound-id-table [table bound-id-table?])
sequence?]
@defproc[(bound-id-table-for-each [table bound-id-table?]
[proc (-> identifier? any/c any)])
void?]
@ -273,6 +303,8 @@ Like the procedures for free-identifier tables
(@racket[make-free-id-table], @racket[free-id-table-ref], etc), but
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."]
}
@close-eval[id-table-eval]

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

@ -26,6 +26,8 @@
(test 4 bound-id-table-count (make-immutable-bound-id-table alist))
(test 3 free-id-table-count (make-free-id-table alist))
(test 3 free-id-table-count (make-immutable-free-id-table alist))
(test 3 length (free-id-table-keys (make-immutable-free-id-table alist)))
(test 3 length (free-id-table-values (make-immutable-free-id-table alist)))
(let ()
;; Test in-dict, iteration methods for immutable id-tables
@ -34,10 +36,18 @@
(define d2 (for/fold ([d (make-immutable-bound-id-table)])
([(id v) (in-dict d1)])
(dict-set d id (add1 v))))
;; Test in-bound-id-table
(define d3 (for/fold ([d (make-immutable-bound-id-table)])
([(id v) (in-bound-id-table d1)])
(dict-set d id (add1 v))))
(test 2 bound-id-table-ref d2 a)
(test 3 bound-id-table-ref d2 b)
(test 4 bound-id-table-ref d2 b2)
(test 5 bound-id-table-ref d2 b3))
(test 5 bound-id-table-ref d2 b3)
(test 2 bound-id-table-ref d3 a)
(test 3 bound-id-table-ref d3 b)
(test 4 bound-id-table-ref d3 b2)
(test 5 bound-id-table-ref d3 b3))
(let ()
;; Test in-dict, iteration methods for mutable id-tables
@ -46,7 +56,13 @@
(test (+ 1 2 3 4) (lambda () (for/sum ([(id v) (in-dict d1)]) v)))
(for ([(id v) (in-dict d1)])
(bound-id-table-set! d1 id (add1 v)))
(test (+ 2 3 4 5) (lambda () (for/sum ([(id v) (in-dict d1)]) v)))))
(test (+ 2 3 4 5) (lambda () (for/sum ([(id v) (in-dict d1)]) v)))
;; Repeat test with in-bound-id-table
(define d2 (make-bound-id-table alist))
(test (+ 1 2 3 4) (lambda () (for/sum ([(id v) (in-bound-id-table d2)]) v)))
(for ([(id v) (in-bound-id-table d2)])
(bound-id-table-set! d2 id (add1 v)))
(test (+ 2 3 4 5) (lambda () (for/sum ([(id v) (in-bound-id-table d2)]) v)))))
(let ()
;; contains-same? : (listof x) (listof x) -> boolean
@ -91,6 +107,10 @@
contains-same?
(list 2 4)
(bound-id-table-map table (lambda (x y) y)))
(test #t
contains-same?
(list 2 4)
(bound-id-table-values table))
(test #t
contains-same?
(list 2 4)
@ -133,6 +153,10 @@
contains-same?
(list 2 4)
(free-id-table-map table (lambda (x y) y)))
(test #t
contains-same?
(list 2 4)
(free-id-table-values table))
(test #t
contains-same?
(list 2 4)
@ -181,6 +205,10 @@
contains-same?
(list 1 2 3 4)
(bound-id-table-map table (lambda (x y) y)))
(test #t
contains-same?
(list 1 2 3 4)
(bound-id-table-values table))
(test #t
contains-same?
(list 1 2 3 4)
@ -223,6 +251,10 @@
contains-same?
(list 2 4)
(free-id-table-map table (lambda (x y) y)))
(test #t
contains-same?
(list 2 4)
(free-id-table-values table))
(test #t
contains-same?
(list 2 4)
@ -334,6 +366,29 @@
))
;; Tests for id-table-keys
(let ()
;; contains-same-keys? : (listof id) (listof id) -> boolean
(define (contains-same-keys? l1 l2 id=?)
(and (andmap (lambda (x) (member x l2 id=?)) l1)
(andmap (lambda (x) (member x l1 id=?)) l2)
#t))
(test #t
contains-same-keys?
(list #'x #'y)
(free-id-table-keys
(make-immutable-free-id-table
(list (cons #'x 0) (cons #'x 1) (cons #'y 2))))
free-identifier=?)
(test #t
contains-same-keys?
(list #'x #'y)
(bound-id-table-keys
(make-immutable-bound-id-table
(list (cons #'x 0) (cons #'x 1) (cons #'y 2))))
bound-identifier=?))
(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))

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

@ -200,6 +200,7 @@
idtbl-count
idtbl-iterate-first idtbl-iterate-next
idtbl-iterate-key idtbl-iterate-value
idtbl-keys idtbl-values in-idtbl
idtbl-map idtbl-for-each
idtbl-mutable-methods idtbl-immutable-methods
idtbl/c))
@ -288,6 +289,12 @@
(-> idtbl? id-table-iter? identifier?)]
[idtbl-iterate-value
(-> idtbl? id-table-iter? any)]
[idtbl-keys
(-> idtbl? (listof identifier?))]
[idtbl-values
(-> idtbl? list?)]
[in-idtbl
(-> idtbl? sequence?)]
[idtbl-map
(-> idtbl? (-> identifier? any/c any) list?)]
[idtbl-for-each

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

@ -214,6 +214,35 @@ Notes (FIXME?):
;; ========
(define (id-table-keys who d)
(let do-keys ([pos (id-table-iterate-first d)])
(if (not pos)
null
(cons (id-table-iterate-key who d pos)
(do-keys (id-table-iterate-next who d pos))))))
(define (id-table-values who d identifier->symbol identifier=?)
(let do-values ([pos (id-table-iterate-first d)])
(if (not pos)
null
(cons (id-table-iterate-value who d pos identifier->symbol identifier=?)
(do-values (id-table-iterate-next who d pos))))))
(define (in-id-table who d identifier->symbol identifier=?)
(make-do-sequence
(λ ()
(values
(λ (pos)
(values
(id-table-iterate-key who d pos)
(id-table-iterate-value who d pos identifier->symbol identifier=?)))
(λ (pos) (id-table-iterate-next who d pos))
(id-table-iterate-first d)
values
#f #f))))
;; ========
(define (alist-set identifier=? phase l0 id v)
;; To minimize allocation
;; - add new pairs to front
@ -286,6 +315,7 @@ Notes (FIXME?):
idtbl-count
idtbl-iterate-first idtbl-iterate-next
idtbl-iterate-key idtbl-iterate-value
idtbl-keys idtbl-values in-idtbl
idtbl-map idtbl-for-each
idtbl-mutable-methods idtbl-immutable-methods))
#'(begin
@ -331,6 +361,12 @@ Notes (FIXME?):
(id-table-iterate-key 'idtbl-iterate-key d pos))
(define (idtbl-iterate-value d pos)
(id-table-iterate-value 'idtbl-iterate-value d pos identifier->symbol identifier=?))
(define (idtbl-keys d)
(id-table-keys 'idtbl-keys d))
(define (idtbl-values d)
(id-table-values 'idtbl-values d identifier->symbol identifier=?))
(define (in-idtbl d)
(in-id-table 'in-idtbl d identifier->symbol identifier=?))
(define idtbl-mutable-methods
(vector-immutable idtbl-ref
@ -388,6 +424,9 @@ Notes (FIXME?):
idtbl-iterate-value
idtbl-map
idtbl-for-each
idtbl-keys
idtbl-values
in-idtbl
;; just for use/extension by syntax/id-table
idtbl-set/constructor

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

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