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

make empty immutable hash tables unique

Browse Source 
For example, `#hasheq()` is `eq?` to `(hasheq)` and `(hash-remove
(hasheq 'x 2) 'x)`. Making empty hash table unique avoids some
potential and actual inconsistencies between traditional Racket and
Racket CS, such as in machine-independent bytecode.
This commit is contained in:
Matthew Flatt 2019-03-12 10:19:34 -06:00
parent 6e958b627f
commit df8501d8f0
16 changed files with 116 additions and 32 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 "7.2.0.8")
(define version "7.2.0.9")
(define deps `("racket-lib"
["racket" #:version ,version]))

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

@ -55,7 +55,12 @@ keys and values. See also @racket[in-hash], @racket[in-hash-keys],
Two hash tables cannot be @racket[equal?] unless they use the same
key-comparison procedure (@racket[equal?], @racket[eqv?], or
@racket[eq?]), both hold keys strongly or weakly, and have the same
mutability.
mutability. Empty immutable hash tables are @racket[eq?] when they
are @racket[equal?].
@history[#:changed "7.2.0.9" @elem{Made empty immutable hash tables
@racket[eq?] when they are
@racket[equal?].}]
@elemtag['(caveat "concurrency")]{@bold{Caveats concerning concurrent
modification:}} A mutable hash table can be manipulated with

10
pkgs/racket-test-core/tests/racket/basic.rktl
View File

@ -376,6 +376,16 @@
(test #f immutable? (make-weak-hasheq))
(test #f immutable? (make-weak-hash))
(test #t eq? (hash) #hash())
(test #t eq? (hasheq) #hasheq())
(test #t eq? (hasheqv) #hasheqv())
(test #t eq? (make-immutable-hash) #hash())
(test #t eq? (make-immutable-hasheq) #hasheq())
(test #t eq? (make-immutable-hasheqv) #hasheqv())
(test #t eq? (hash) (hash-remove (hash 3 4) 3))
(test #t eq? (hasheq) (hash-remove (hasheq 3 4) 3))
(test #t eq? (hasheqv) (hash-remove (hasheqv 3 4) 3))
(test #t symbol? 'foo)
(test #t symbol? (car '(a b)))
(test #f symbol? "bar")

4
pkgs/racket-test-core/tests/racket/read.rktl
View File

@ -426,6 +426,10 @@
(err/rt-test (readstr "#0=#hash(#0#)") exn:fail:read?)
(err/rt-test (readstr "#hash([1 . 2))") exn:fail:read?)
(test #t eq? (readstr "#hash()") (hash))
(test #t eq? (readstr "#hasheq()") (hasheq))
(test #t eq? (readstr "#hasheqv()") (hasheqv))
(define (test-ht t size eq? key val)
(test #t hash? t)
(test eq? hash-eq? t)

2
pkgs/zo-lib/compiler/zo-parse.rkt
View File

@ -208,7 +208,7 @@
[(22) 'case-lambda-sequence-type]
[(23) 'inline-variant-type]
[(25) 'linklet-type]
[(89) 'prefix-type]
[(88) 'prefix-type]
[else (error 'int->type "unknown type: ~e" i)]))
;; ----------------------------------------

14
racket/collects/racket/pretty.rkt
View File

@ -482,7 +482,10 @@
(and (custom-write? obj)
(not (struct-type? obj)))
(and (struct? obj) print-struct?)
(and (hash? obj) print-hash-table?))
(and (hash? obj)
(not (and (zero? (hash-count obj))
(immutable? obj)))
print-hash-table?))
(or (hash-ref table obj #f)
(begin
(hash-set! table obj #t)
@ -525,7 +528,10 @@
(and (custom-write? obj)
(not (struct-type? obj)))
(and (struct? obj) print-struct?)
(and (hash? obj) print-hash-table?))
(and (hash? obj)
(not (and (zero? (hash-count obj))
(immutable? obj)))
print-hash-table?))
;; A little confusing: use #t for not-found
(let ([p (hash-ref table obj #t)])
(when (not (mark? p))
@ -634,7 +640,9 @@
(not (prefab-struct-key obj)))
(escapes! obj))]
[(hash? obj)
(is-compound! obj)
(unless (and (zero? (hash-count obj))
(immutable? obj))
(is-compound! obj))
(and (for/fold ([esc? #f]) ([(k v) (in-hash obj)])
(or (orf (loop v)
(loop k))

13
racket/src/cs/rumble/hash.ss
View File

@ -59,15 +59,18 @@
(syntax-rules ()
[(_ vararg-ctor list-ctor empty-hash)
(begin
(define (vararg-ctor . kvs)
(define vararg-ctor
(case-lambda
[() empty-hash]
[kvs
(let loop ([kvs kvs] [h empty-hash])
(cond [(null? kvs) h]
[else
(loop (cddr kvs) (intmap-set h (car kvs) (cadr kvs)))])))
(cond
[(null? kvs) h]
[else (loop (cddr kvs) (intmap-set h (car kvs) (cadr kvs)))]))]))
(define list-ctor
(case-lambda
[() (vararg-ctor)]
[() empty-hash]
[(alist)
(check 'list-ctor
:test (and (list? alist) (andmap pair? alist))

10
racket/src/cs/rumble/intmap.ss
View File

@ -140,9 +140,13 @@
(define (intmap-remove t key)
(let ([et (intmap-eqtype t)])
(make-intmap
et
($intmap-remove et (intmap-root t) (hash-code et key) key))))
(let ([r ($intmap-remove et (intmap-root t) (hash-code et key) key)])
(if r
(make-intmap et r)
(case et
[(eq) empty-hasheq]
[(equal) empty-hash]
[else empty-hasheqv])))))
(define ($intmap-remove et t h key)
(cond

1
racket/src/racket/src/env.c
View File

@ -156,6 +156,7 @@ Scheme_Env *scheme_basic_env()
scheme_init_finalization();
scheme_init_hash_tree();
scheme_init_portable_case();
scheme_init_compenv();
scheme_init_letrec_check();

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

@ -4,6 +4,8 @@
#include <math.h>
#include "../gc2/gc2_obj.h"
READ_ONLY static Scheme_Hash_Tree *empty_hash_tree[3];
THREAD_LOCAL_DECL(intptr_t scheme_hash_request_count);
THREAD_LOCAL_DECL(intptr_t scheme_hash_iteration_count);
@ -3169,7 +3171,23 @@ static Scheme_Hash_Tree *make_hash_tree(int eql_kind, int popcount)
Scheme_Hash_Tree *scheme_make_hash_tree(int eql_kind)
{
return make_hash_tree(eql_kind, 0);
return empty_hash_tree[eql_kind];
}
void scheme_init_hash_tree(void)
{
Scheme_Hash_Tree *t;
REGISTER_SO(empty_hash_tree);
t = make_hash_tree(0, 0);
empty_hash_tree[0] = t;
t = make_hash_tree(1, 0);
empty_hash_tree[1] = t;
t = make_hash_tree(2, 0);
empty_hash_tree[2] = t;
}
Scheme_Hash_Tree *scheme_make_hash_tree_of_type(Scheme_Type stype)
@ -3187,15 +3205,14 @@ Scheme_Hash_Tree *scheme_make_hash_tree_placeholder(int eql_kind)
the cycle (since we don't know in advance how large the top record
needs to be) */
{
Scheme_Hash_Tree *ht, *sub;
Scheme_Hash_Tree *ht;
ht = make_hash_tree(eql_kind, 1);
ht->iso.so.type = scheme_hash_tree_indirection_type;
ht->count = 0;
ht->bitmap = 1;
sub = make_hash_tree(eql_kind, 0);
ht->els[0] = (Scheme_Object *)sub;
ht->els[0] = (Scheme_Object *)empty_hash_tree[eql_kind];
return ht;
}
@ -3368,13 +3385,14 @@ Scheme_Hash_Tree *scheme_hash_tree_set_w_key_wraps(Scheme_Hash_Tree *tree, Schem
/* replace */
tree = resolve_placeholder(tree);
if (!val) {
int kind = SCHEME_HASHTR_KIND(tree);
tree = hamt_remove(tree, h, 0);
if (!tree) {
tree = hamt_alloc(kind, 0);
tree->iso.so.type = stype;
SCHEME_HASHTR_FLAGS(tree) = kind;
return tree;
if (stype == scheme_eq_hash_tree_type)
return empty_hash_tree[0];
else if (stype == scheme_hash_tree_type)
return empty_hash_tree[1];
else
return empty_hash_tree[2];
} else
return tree;
} else if (SAME_OBJ(val, mzHAMT_VAL(in_tree, pos))) {

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

@ -14,10 +14,14 @@ READ_ONLY Scheme_Object *scheme_list_p_proc;
READ_ONLY Scheme_Object *scheme_list_proc;
READ_ONLY Scheme_Object *scheme_list_star_proc;
READ_ONLY Scheme_Object *scheme_list_pair_p_proc;
READ_ONLY Scheme_Object *scheme_append_proc;
READ_ONLY Scheme_Object *scheme_box_proc;
READ_ONLY Scheme_Object *scheme_box_immutable_proc;
READ_ONLY Scheme_Object *scheme_box_p_proc;
READ_ONLY Scheme_Object *scheme_hash_ref_proc;
READ_ONLY Scheme_Object *scheme_hash_proc;
READ_ONLY Scheme_Object *scheme_hasheq_proc;
READ_ONLY Scheme_Object *scheme_hasheqv_proc;
READ_ONLY Scheme_Object *scheme_unsafe_cons_list_proc;
READ_ONLY Scheme_Object *scheme_unsafe_car_proc;
READ_ONLY Scheme_Object *scheme_unsafe_cdr_proc;
@ -317,7 +321,9 @@ scheme_init_list (Scheme_Startup_Env *env)
| SCHEME_PRIM_AD_HOC_OPT);
scheme_addto_prim_instance("length", p, env);
REGISTER_SO(scheme_append_proc);
p = scheme_make_immed_prim(append_prim, "append", 0, -1);
scheme_append_proc = p;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_AD_HOC_OPT);
scheme_addto_prim_instance ("append", p, env);
@ -565,15 +571,21 @@ scheme_init_list (Scheme_Startup_Env *env)
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_OMITABLE_ALLOCATION);
scheme_addto_prim_instance("make-immutable-hasheqv", p, env);
REGISTER_SO(scheme_hash_proc);
p = scheme_make_immed_prim(direct_hash, "hash", 0, -1);
scheme_hash_proc = p;
/* not SCHEME_PRIM_IS_OMITABLE_ALLOCATION, because `equal?`-hashing functions are called */
scheme_addto_prim_instance("hash", p, env);
REGISTER_SO(scheme_hasheq_proc);
p = scheme_make_immed_prim(direct_hasheq, "hasheq", 0, -1);
scheme_hasheq_proc = p;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_OMITABLE_ALLOCATION);
scheme_addto_prim_instance("hasheq", p, env);
REGISTER_SO(scheme_hasheqv_proc);
p = scheme_make_immed_prim(direct_hasheqv, "hasheqv", 0, -1);
scheme_hasheqv_proc = p;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_OMITABLE_ALLOCATION);
scheme_addto_prim_instance("hasheqv", p, env);

14
racket/src/racket/src/optimize.c
View File

@ -2256,6 +2256,7 @@ int scheme_ir_duplicate_ok(Scheme_Object *fb, int cross_linklet)
|| SCHEME_EOFP(fb)
|| SCHEME_INTP(fb)
|| SCHEME_NULLP(fb)
|| (SCHEME_HASHTRP(fb) && !((Scheme_Hash_Tree *)fb)->count)
|| (!cross_linklet && SAME_TYPE(SCHEME_TYPE(fb), scheme_ir_toplevel_type))
|| (!cross_linklet && SAME_TYPE(SCHEME_TYPE(fb), scheme_ir_local_type))
|| SCHEME_PRIMP(fb)
@ -4131,10 +4132,17 @@ static Scheme_Object *finish_optimize_application(Scheme_App_Rec *app, Optimize_
return le;
}
if (!app->num_args
&& (SAME_OBJ(rator, scheme_list_proc)
|| (SCHEME_PRIMP(rator) && IS_NAMED_PRIM(rator, "append")))) {
if (!app->num_args && SCHEME_PRIMP(rator)) {
if (SAME_OBJ(rator, scheme_list_proc))
return scheme_null;
if (SAME_OBJ(rator, scheme_append_proc))
return scheme_null;
if (SAME_OBJ(rator, scheme_hasheq_proc))
return (Scheme_Object *)scheme_make_hash_tree(0);
if (SAME_OBJ(rator, scheme_hash_proc))
return (Scheme_Object *)scheme_make_hash_tree(1);
if (SAME_OBJ(rator, scheme_hasheqv_proc))
return (Scheme_Object *)scheme_make_hash_tree(2);
}
if (SCHEME_PRIMP(rator)

8
racket/src/racket/src/print.c
View File

@ -142,6 +142,12 @@ static Scheme_Object *srcloc_path_to_string(Scheme_Object *p);
#define SCHEME_CHAPERONE_HASHTPx(obj) (SCHEME_HASHTPx(obj) \
|| (SCHEME_NP_CHAPERONEP(obj) && SCHEME_HASHTP(SCHEME_CHAPERONE_VAL(obj))))
#define SCHEME_CHAPERONE_NONEMPTY_HASHTRP(obj) (SCHEME_CHAPERONEP(obj) \
? (SCHEME_HASHTRP(SCHEME_CHAPERONE_VAL(obj)) \
&& ((Scheme_Hash_Tree *)SCHEME_CHAPERONE_VAL(obj))->count) \
: (SCHEME_HASHTRP(obj) \
&& ((Scheme_Hash_Tree *)(obj))->count))
#define HAS_SUBSTRUCT(obj, qk) \
(SCHEME_PAIRP(obj) \
|| SCHEME_MUTABLE_PAIRP(obj) \
@ -154,7 +160,7 @@ static Scheme_Object *srcloc_path_to_string(Scheme_Object *p);
&& PRINTABLE_STRUCT(obj, pp), 0)) \
|| (qk(SCHEME_CHAPERONE_STRUCTP(obj) && scheme_is_writable_struct(obj), 0)) \
|| (qk(pp->print_struct, 1) && SCHEME_CHAPERONE_STRUCTP(obj) && SCHEME_PREFABP(obj)) \
|| (qk(pp->print_hash_table, 1) && (SCHEME_CHAPERONE_HASHTPx(obj) || SCHEME_CHAPERONE_HASHTRP(obj))))
|| (qk(pp->print_hash_table, 1) && (SCHEME_CHAPERONE_HASHTPx(obj) || SCHEME_CHAPERONE_NONEMPTY_HASHTRP(obj))))
#define ssQUICK(x, isbox) x
#define ssQUICKp(x, isbox) (pp ? x : isbox)
#define ssALLp(x, isbox) isbox

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

@ -479,7 +479,7 @@ MZ_EXTERN void scheme_clear_hash_table(Scheme_Hash_Table *ht);
XFORM_NONGCING_NONALIASING MZ_EXTERN int scheme_hash_table_index(Scheme_Hash_Table *hash, mzlonglong pos, Scheme_Object **_key, Scheme_Object **_val);
XFORM_NONGCING MZ_EXTERN Scheme_Object *scheme_hash_table_next(Scheme_Hash_Table *hash, mzlonglong start);
MZ_EXTERN Scheme_Hash_Tree *scheme_make_hash_tree(int kind);
XFORM_NONGCING MZ_EXTERN Scheme_Hash_Tree *scheme_make_hash_tree(int kind);
MZ_EXTERN Scheme_Hash_Tree *scheme_hash_tree_set(Scheme_Hash_Tree *tree, Scheme_Object *key, Scheme_Object *val);
MZ_EXTERN Scheme_Object *scheme_hash_tree_get(Scheme_Hash_Tree *tree, Scheme_Object *key);
XFORM_NONGCING MZ_EXTERN Scheme_Object *scheme_eq_hash_tree_get(Scheme_Hash_Tree *tree, Scheme_Object *key);

5
racket/src/racket/src/schpriv.h
View File

@ -326,6 +326,7 @@ void scheme_init_struct_wait();
void scheme_init_list(Scheme_Startup_Env *env);
void scheme_init_unsafe_list(Scheme_Startup_Env *env);
void scheme_init_unsafe_hash(Scheme_Startup_Env *env);
void scheme_init_hash_tree(void);
void scheme_init_stx(Scheme_Startup_Env *env);
void scheme_init_module(Scheme_Startup_Env *env);
void scheme_init_module_path_table(void);
@ -545,6 +546,7 @@ extern Scheme_Object *scheme_list_p_proc;
extern Scheme_Object *scheme_list_proc;
extern Scheme_Object *scheme_list_star_proc;
extern Scheme_Object *scheme_list_pair_p_proc;
extern Scheme_Object *scheme_append_proc;
extern Scheme_Object *scheme_vector_proc;
extern Scheme_Object *scheme_vector_p_proc;
extern Scheme_Object *scheme_vector_length_proc;
@ -565,6 +567,9 @@ extern Scheme_Object *scheme_unsafe_struct_ref_proc;
extern Scheme_Object *scheme_unsafe_struct_star_ref_proc;
extern Scheme_Object *scheme_unsafe_struct_set_proc;
extern Scheme_Object *scheme_unsafe_struct_star_set_proc;
extern Scheme_Object *scheme_hash_proc;
extern Scheme_Object *scheme_hasheq_proc;
extern Scheme_Object *scheme_hasheqv_proc;
extern Scheme_Object *scheme_hash_ref_proc;
extern Scheme_Object *scheme_box_p_proc;
extern Scheme_Object *scheme_box_proc;

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

@ -13,12 +13,12 @@
consistently.)
*/
#define MZSCHEME_VERSION "7.2.0.8"
#define MZSCHEME_VERSION "7.2.0.9"
#define MZSCHEME_VERSION_X 7
#define MZSCHEME_VERSION_Y 2
#define MZSCHEME_VERSION_Z 0
#define MZSCHEME_VERSION_W 8
#define MZSCHEME_VERSION_W 9
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)