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

add hash-iterate-pair and hash-iterate-key+value

Browse Source 
- cuts in-hash and in-hash-pairs iteration time in half
- refactor hash_table_index
- add tests
- bump version

closes #1224
This commit is contained in:
Stephen Chang 2016-01-26 10:12:52 -05:00
parent 7563f5a812
commit e8d34dd156
11 changed files with 1192 additions and 1041 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.4.0.4")
(define version "6.4.0.5")
(define deps `("racket-lib"
["racket" #:version ,version]))

20
pkgs/racket-doc/scribblings/reference/hashes.scrbl
View File

@ -485,6 +485,26 @@ Returns the value for the element in @racket[hash] at index
@racket[pos]. If @racket[pos] is not a valid index for
@racket[hash], the @exnraise[exn:fail:contract].}
@defproc[(hash-iterate-pair [hash hash?]
[pos exact-nonnegative-integer?])
(cons any any)]{
Returns a pair containing the key and value for the element
in @racket[hash] at index
@racket[pos]. If @racket[pos] is not a valid index for
@racket[hash], the @exnraise[exn:fail:contract].}
@history[#:added "6.4.0.5"]
@defproc[(hash-iterate-key+value [hash hash?]
[pos exact-nonnegative-integer?])
(values any any)]{
Returns the key and value for the element in @racket[hash] at index
@racket[pos]. If @racket[pos] is not a valid index for
@racket[hash], the @exnraise[exn:fail:contract].}
@history[#:added "6.4.0.5"]
@defproc[(hash-copy [hash hash?])
(and/c hash? (not/c immutable?))]{

88
pkgs/racket-test-core/tests/racket/hash.rktl
View File

@ -34,3 +34,91 @@
(hash-copy
#hash([one . 1] [two . 2] [three . 3] [four . 4]))
h))
(let ()
(define lst1 (build-list 10 values))
(define lst2 (build-list 10 add1))
(define ht/immut (make-immutable-hash (map cons lst1 lst2)))
(define ht/mut (make-hash (map cons lst1 lst2)))
(define ht/weak (make-weak-hash (map cons lst1 lst2)))
(define ht/immut/seq (in-hash ht/immut))
(define ht/mut/seq (in-hash ht/mut))
(define ht/weak/seq (in-hash ht/weak))
(define ht/immut-pair/seq (in-hash-pairs ht/immut))
(define ht/mut-pair/seq (in-hash-pairs ht/mut))
(define ht/weak-pair/seq (in-hash-pairs ht/weak))
(define ht/immut-keys/seq (in-hash-keys ht/immut))
(define ht/mut-keys/seq (in-hash-keys ht/mut))
(define ht/weak-keys/seq (in-hash-keys ht/weak))
(define ht/immut-vals/seq (in-hash-values ht/immut))
(define ht/mut-vals/seq (in-hash-values ht/mut))
(define ht/weak-vals/seq (in-hash-values ht/weak))
(test #t
=
(for/sum ([(k v) (in-hash ht/immut)]) (+ k v))
(for/sum ([(k v) (in-hash ht/mut)]) (+ k v))
(for/sum ([(k v) (in-hash ht/weak)]) (+ k v))
(for/sum ([(k v) ht/immut/seq]) (+ k v))
(for/sum ([(k v) ht/mut/seq]) (+ k v))
(for/sum ([(k v) ht/weak/seq]) (+ k v))
(for/sum ([k+v (in-hash-pairs ht/immut)]) (+ (car k+v) (cdr k+v)))
(for/sum ([k+v (in-hash-pairs ht/mut)]) (+ (car k+v) (cdr k+v)))
(for/sum ([k+v (in-hash-pairs ht/weak)]) (+ (car k+v) (cdr k+v)))
(for/sum ([k+v ht/immut-pair/seq]) (+ (car k+v) (cdr k+v)))
(for/sum ([k+v ht/mut-pair/seq]) (+ (car k+v) (cdr k+v)))
(for/sum ([k+v ht/weak-pair/seq]) (+ (car k+v) (cdr k+v)))
(+ (for/sum ([k (in-hash-keys ht/immut)]) k)
(for/sum ([v (in-hash-values ht/immut)]) v))
(+ (for/sum ([k (in-hash-keys ht/mut)]) k)
(for/sum ([v (in-hash-values ht/mut)]) v))
(+ (for/sum ([k (in-hash-keys ht/weak)]) k)
(for/sum ([v (in-hash-values ht/weak)]) v))
(+ (for/sum ([k ht/immut-keys/seq]) k)
(for/sum ([v ht/immut-vals/seq]) v))
(+ (for/sum ([k ht/mut-keys/seq]) k)
(for/sum ([v ht/mut-vals/seq]) v))
(+ (for/sum ([k ht/weak-keys/seq]) k)
(for/sum ([v ht/weak-vals/seq]) v)))
(test #t
=
(for/sum ([(k v) (in-hash ht/immut)]) k)
(for/sum ([(k v) (in-hash ht/mut)]) k)
(for/sum ([(k v) (in-hash ht/weak)]) k)
(for/sum ([(k v) ht/immut/seq]) k)
(for/sum ([(k v) ht/mut/seq]) k)
(for/sum ([(k v) ht/weak/seq]) k)
(for/sum ([k+v (in-hash-pairs ht/immut)]) (car k+v))
(for/sum ([k+v (in-hash-pairs ht/mut)]) (car k+v))
(for/sum ([k+v (in-hash-pairs ht/weak)]) (car k+v))
(for/sum ([k+v ht/immut-pair/seq]) (car k+v))
(for/sum ([k+v ht/mut-pair/seq]) (car k+v))
(for/sum ([k+v ht/weak-pair/seq]) (car k+v))
(for/sum ([k (in-hash-keys ht/immut)]) k)
(for/sum ([k (in-hash-keys ht/mut)]) k)
(for/sum ([k (in-hash-keys ht/weak)]) k)
(for/sum ([k ht/immut-keys/seq]) k)
(for/sum ([k ht/mut-keys/seq]) k)
(for/sum ([k ht/weak-keys/seq]) k))
(test #t
=
(for/sum ([(k v) (in-hash ht/immut)]) v)
(for/sum ([(k v) (in-hash ht/mut)]) v)
(for/sum ([(k v) (in-hash ht/weak)]) v)
(for/sum ([(k v) ht/immut/seq]) v)
(for/sum ([(k v) ht/mut/seq]) v)
(for/sum ([(k v) ht/weak/seq]) v)
(for/sum ([k+v (in-hash-pairs ht/immut)]) (cdr k+v))
(for/sum ([k+v (in-hash-pairs ht/mut)]) (cdr k+v))
(for/sum ([k+v (in-hash-pairs ht/weak)]) (cdr k+v))
(for/sum ([k+v ht/immut-pair/seq]) (cdr k+v))
(for/sum ([k+v ht/mut-pair/seq]) (cdr k+v))
(for/sum ([k+v ht/weak-pair/seq]) (cdr k+v))
(for/sum ([v (in-hash-values ht/immut)]) v)
(for/sum ([v (in-hash-values ht/mut)]) v)
(for/sum ([v (in-hash-values ht/weak)]) v)
(for/sum ([v ht/immut-vals/seq]) v)
(for/sum ([v ht/mut-vals/seq]) v)
(for/sum ([v ht/weak-vals/seq]) v)))

2
pkgs/racket-test-core/tests/racket/testing.rktl
View File

@ -23,7 +23,7 @@
The test form has these two shapes:
(test <expected> <procdure> <argument1> <argument2> ...)
(test <expected> <procedure> <argument1> <argument2> ...)
(test <expected> <symbolic-name> <expression>)

16
racket/collects/racket/private/for.rkt
View File

@ -660,10 +660,7 @@
(unless (hash? ht) (raise-argument-error 'in-hash "hash?" ht))
(make-do-sequence (lambda () (:hash-key+val-gen ht))))
(define (:hash-key+val-gen ht)
(:hash-gen ht (lambda (ht pos)
(values (hash-iterate-key ht pos)
(hash-iterate-value ht pos)))))
(define (:hash-key+val-gen ht) (:hash-gen ht hash-iterate-key+value))
(define-sequence-syntax *in-hash
(lambda () #'in-hash)
@ -682,8 +679,7 @@
;; pos check
i
;; inner bindings
([(k v) (values (hash-iterate-key ht i)
(hash-iterate-value ht i))])
([(k v) (hash-iterate-key+value ht i)])
;; pre guard
#t
;; post guard
@ -754,10 +750,7 @@
(define (in-hash-pairs ht)
(unless (hash? ht) (raise-argument-error 'in-hash-values "hash?" ht))
(make-do-sequence (lambda ()
(:hash-gen ht (lambda (ht pos)
(cons (hash-iterate-key ht pos)
(hash-iterate-value ht pos)))))))
(make-do-sequence (lambda () (:hash-gen ht hash-iterate-pair))))
(define-sequence-syntax *in-hash-pairs
(lambda () #'in-hash-pairs)
@ -776,8 +769,7 @@
;; pos check
i
;; inner bindings
([(id) (cons (hash-iterate-key ht i)
(hash-iterate-value ht i))])
([(id) (hash-iterate-pair ht i)])
;; pre guard
#t
;; post guard

1886
racket/src/racket/src/cstartup.inc
View File

File diff suppressed because it is too large Load Diff

34
racket/src/racket/src/hash.c
View File

@ -657,6 +657,20 @@ void scheme_reset_hash_table(Scheme_Hash_Table *table, int *history)
table->mcount = 0;
}
int scheme_hash_table_index(Scheme_Hash_Table *hash, mzlonglong pos, Scheme_Object **_key, Scheme_Object **_val)
{
if (pos < hash->size) {
if (hash->vals[pos]) {
*_key = hash->keys[pos];
if (_val)
*_val = hash->vals[pos];
return 1;
}
}
return 0;
}
/*========================================================================*/
/* old-style hash table, with buckets */
/*========================================================================*/
@ -1103,6 +1117,26 @@ Scheme_Bucket_Table *scheme_clone_bucket_table(Scheme_Bucket_Table *bt)
return table;
}
int scheme_bucket_table_index(Scheme_Bucket_Table *hash, mzlonglong pos, Scheme_Object **_key, Scheme_Object **_val)
{
Scheme_Bucket *bucket;
if (pos < hash->size) {
bucket = hash->buckets[pos];
if (bucket && bucket->val && bucket->key) {
if (hash->weak)
*_key = (Scheme_Object *)HT_EXTRACT_WEAK(bucket->key);
else
*_key = (Scheme_Object *)bucket->key;
if (_val)
*_val = (Scheme_Object *)bucket->val;
return 1;
}
}
return 0;
}
/*========================================================================*/
/* precise GC hashing */
/*========================================================================*/

177
racket/src/racket/src/list.c
View File

@ -131,8 +131,10 @@ static Scheme_Object *hash_table_map(int argc, Scheme_Object *argv[]);
static Scheme_Object *hash_table_for_each(int argc, Scheme_Object *argv[]);
Scheme_Object *scheme_hash_table_iterate_start(int argc, Scheme_Object *argv[]);
Scheme_Object *scheme_hash_table_iterate_next(int argc, Scheme_Object *argv[]);
Scheme_Object *scheme_hash_table_iterate_value(int argc, Scheme_Object *argv[]);
Scheme_Object *scheme_hash_table_iterate_key(int argc, Scheme_Object *argv[]);
Scheme_Object *scheme_hash_table_iterate_value(int argc, Scheme_Object *argv[]);
Scheme_Object *scheme_hash_table_iterate_pair(int argc, Scheme_Object *argv[]);
Scheme_Object *scheme_hash_table_iterate_key_value(int argc, Scheme_Object *argv[]);
static Scheme_Object *eq_hash_code(int argc, Scheme_Object *argv[]);
static Scheme_Object *equal_hash_code(int argc, Scheme_Object *argv[]);
static Scheme_Object *equal_hash2_code(int argc, Scheme_Object *argv[]);
@ -632,6 +634,16 @@ scheme_init_list (Scheme_Env *env)
"hash-iterate-key",
2, 2),
env);
scheme_add_global_constant("hash-iterate-pair",
scheme_make_immed_prim(scheme_hash_table_iterate_pair,
"hash-iterate-pair",
2, 2),
env);
scheme_add_global_constant("hash-iterate-key+value",
scheme_make_prim_w_arity2(scheme_hash_table_iterate_key_value,
"hash-iterate-key+value",
2, 2, 2, 2),
env);
scheme_add_global_constant("chaperone-hash",
scheme_make_prim_w_arity(chaperone_hash,
@ -2824,18 +2836,14 @@ Scheme_Object *scheme_hash_table_iterate_next(int argc, Scheme_Object *argv[])
return NULL;
}
static Scheme_Object *hash_table_index(const char *name, int argc, Scheme_Object *argv[], int get_val)
static Scheme_Object *hash_table_index(const char *name, int argc, Scheme_Object *argv[], Scheme_Object **_k, Scheme_Object **_v)
{
Scheme_Object *p = argv[1], *obj, *chaperone, *key;
Scheme_Object *p = argv[1], *obj = argv[0];
mzlonglong pos;
intptr_t sz;
int res;
obj = argv[0];
if (SCHEME_NP_CHAPERONEP(obj)) {
chaperone = obj;
obj = SCHEME_CHAPERONE_VAL(chaperone);
} else
chaperone = NULL;
if (SCHEME_NP_CHAPERONEP(obj))
obj = SCHEME_CHAPERONE_VAL(obj);
if (!scheme_get_long_long_val(p, &pos))
pos = HASH_POS_TOO_BIG;
@ -2843,79 +2851,18 @@ static Scheme_Object *hash_table_index(const char *name, int argc, Scheme_Object
pos = HASH_POS_TOO_BIG;
if (SCHEME_HASHTP(obj)) {
Scheme_Hash_Table *hash;
hash = (Scheme_Hash_Table *)obj;
sz = hash->size;
if (pos < sz) {
if (hash->vals[pos]) {
if (chaperone) {
if (get_val) {
key = chaperone_hash_key(name, chaperone, hash->keys[pos]);
obj = scheme_chaperone_hash_get(chaperone, key);
if (!obj)
no_post_key("hash-iterate-value", key, 0);
return obj;
} else
return chaperone_hash_key(name, chaperone, hash->keys[pos]);
} else if (get_val)
return hash->vals[pos];
else
return hash->keys[pos];
}
}
res = scheme_hash_table_index((Scheme_Hash_Table *)obj, pos, _k, _v);
} else if (SCHEME_HASHTRP(obj)) {
Scheme_Object *v, *k;
if (scheme_hash_tree_index((Scheme_Hash_Tree *)obj, pos, &k, &v)) {
if (chaperone) {
if (get_val) {
key = chaperone_hash_key(name, chaperone, k);
obj = scheme_chaperone_hash_get(chaperone, key);
if (!obj)
no_post_key("hash-iterate-value", key, 1);
return obj;
} else
return chaperone_hash_key(name, chaperone, k);
} else
return (get_val ? v : k);
}
res = scheme_hash_tree_index((Scheme_Hash_Tree *)obj, pos, _k, _v);
} else if (SCHEME_BUCKTP(obj)) {
Scheme_Bucket_Table *hash;
Scheme_Bucket *bucket;
hash = (Scheme_Bucket_Table *)obj;
sz = hash->size;
if (pos < sz) {
bucket = hash->buckets[pos];
if (bucket && bucket->val && bucket->key) {
if (get_val && !chaperone)
return (Scheme_Object *)bucket->val;
else {
if (hash->weak)
obj = (Scheme_Object *)HT_EXTRACT_WEAK(bucket->key);
else
obj = (Scheme_Object *)bucket->key;
if (chaperone) {
if (get_val) {
key = chaperone_hash_key(name, chaperone, obj);
obj = scheme_chaperone_hash_get(chaperone, key);
if (!obj)
no_post_key("hash-iterate-value", key, 0);
return obj;
} else
return chaperone_hash_key(name, chaperone, obj);
} else
return obj;
}
}
}
res = scheme_bucket_table_index((Scheme_Bucket_Table *)obj, pos, _k, _v);
} else {
scheme_wrong_contract(name, "hash?", 0, argc, argv);
return NULL;
return 0;
}
if (res) return 1;
if ((SCHEME_INTP(p)
&& (SCHEME_INT_VAL(p) >= 0))
|| (SCHEME_BIGNUMP(p)
@ -2923,21 +2870,89 @@ static Scheme_Object *hash_table_index(const char *name, int argc, Scheme_Object
scheme_contract_error(name, "no element at index",
"index", 1, p,
NULL);
return NULL;
return 0;
}
scheme_wrong_contract(name, "exact-nonnegative-integer?", 1, argc, argv);
return 0;
}
Scheme_Object *scheme_hash_table_iterate_key(int argc, Scheme_Object *argv[])
{
const char *name = "hash-iterate-key";
Scheme_Object *key;
if (hash_table_index(name, argc, argv, &key, NULL)) {
Scheme_Object *obj = argv[0];
if (SCHEME_NP_CHAPERONEP(obj))
return chaperone_hash_key(name, obj, key);
else
return key;
}
return NULL;
}
Scheme_Object *scheme_hash_table_iterate_value(int argc, Scheme_Object *argv[])
{
return hash_table_index("hash-iterate-value", argc, argv, 1);
const char *name = "hash-iterate-value";
Scheme_Object *key, *val;
if (hash_table_index(name, argc, argv, &key, &val)) {
Scheme_Object *obj = argv[0];
if (SCHEME_NP_CHAPERONEP(obj)) {
Scheme_Object *chap_key, *chap_val;
chap_key = chaperone_hash_key(name, obj, key);
chap_val = scheme_chaperone_hash_get(obj, chap_key);
if (!chap_val)
no_post_key(name, chap_key, SCHEME_HASHTRP(SCHEME_CHAPERONE_VAL(obj)));
return chap_val;
}
else
return val;
}
return NULL;
}
Scheme_Object *scheme_hash_table_iterate_key(int argc, Scheme_Object *argv[])
Scheme_Object *scheme_hash_table_iterate_pair(int argc, Scheme_Object *argv[])
{
return hash_table_index("hash-iterate-key", argc, argv, 0);
const char *name = "hash-iterate-pair";
Scheme_Object *key, *val;
if (hash_table_index(name, argc, argv, &key, &val)) {
Scheme_Object *obj = argv[0];
if (SCHEME_NP_CHAPERONEP(obj)) {
Scheme_Object *chap_key, *chap_val;
chap_key = chaperone_hash_key(name, obj, key);
chap_val = scheme_chaperone_hash_get(obj, chap_key);
if (!chap_val)
no_post_key(name, chap_key, SCHEME_HASHTRP(SCHEME_CHAPERONE_VAL(obj)));
return scheme_make_pair(chap_key, chap_val);
}
else
return scheme_make_pair(key, val);
}
return NULL;
}
Scheme_Object *scheme_hash_table_iterate_key_value(int argc, Scheme_Object *argv[])
{
const char *name = "hash-iterate-key+value";
Scheme_Object *key, *val;
if (hash_table_index(name, argc, argv, &key, &val)) {
Scheme_Object *res[2], *obj = argv[0];
if (SCHEME_NP_CHAPERONEP(obj)) {
Scheme_Object *chap_key, *chap_val;
chap_key = chaperone_hash_key(name, obj, key);
chap_val = scheme_chaperone_hash_get(obj, chap_key);
if (!chap_val)
no_post_key(name, chap_key, SCHEME_HASHTRP(SCHEME_CHAPERONE_VAL(obj)));
res[0] = chap_key;
res[1] = chap_val;
}
else {
res[0] = key;
res[1] = val;
}
return scheme_values(2, res);
}
return NULL;
}
static Scheme_Object *do_chaperone_hash(const char *name, int is_impersonator, int argc, Scheme_Object **argv)

2
racket/src/racket/src/schemef.h
View File

@ -496,6 +496,7 @@ MZ_EXTERN Scheme_Bucket *scheme_bucket_from_table(Scheme_Bucket_Table *table, co
MZ_EXTERN int scheme_bucket_table_equal(Scheme_Bucket_Table *t1, Scheme_Bucket_Table *t2);
MZ_EXTERN Scheme_Bucket_Table *scheme_clone_bucket_table(Scheme_Bucket_Table *bt);
MZ_EXTERN void scheme_clear_bucket_table(Scheme_Bucket_Table *bt);
XFORM_NONGCING MZ_EXTERN int scheme_bucket_table_index(Scheme_Bucket_Table *hash, mzlonglong pos, Scheme_Object **_key, Scheme_Object **_val);
MZ_EXTERN Scheme_Hash_Table *scheme_make_hash_table(int type);
MZ_EXTERN Scheme_Hash_Table *scheme_make_hash_table_equal();
@ -510,6 +511,7 @@ MZ_EXTERN int scheme_is_hash_table_equal(Scheme_Object *o);
MZ_EXTERN int scheme_is_hash_table_eqv(Scheme_Object *o);
MZ_EXTERN Scheme_Hash_Table *scheme_clone_hash_table(Scheme_Hash_Table *ht);
MZ_EXTERN void scheme_clear_hash_table(Scheme_Hash_Table *ht);
XFORM_NONGCING MZ_EXTERN int scheme_hash_table_index(Scheme_Hash_Table *hash, mzlonglong pos, Scheme_Object **_key, Scheme_Object **_val);
MZ_EXTERN Scheme_Hash_Tree *scheme_make_hash_tree(int kind);
MZ_EXTERN Scheme_Hash_Tree *scheme_make_hash_tree_set(int kind);

2
racket/src/racket/src/schminc.h
View File

@ -14,7 +14,7 @@
#define USE_COMPILED_STARTUP 1
#define EXPECTED_PRIM_COUNT 1142
#define EXPECTED_PRIM_COUNT 1144
#define EXPECTED_UNSAFE_COUNT 108
#define EXPECTED_FLFXNUM_COUNT 69
#define EXPECTED_EXTFL_COUNT 45

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

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