diff --git a/pkgs/base/info.rkt b/pkgs/base/info.rkt index 692c0a3701..b346d3b4b5 100644 --- a/pkgs/base/info.rkt +++ b/pkgs/base/info.rkt @@ -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])) diff --git a/pkgs/racket-doc/scribblings/reference/hashes.scrbl b/pkgs/racket-doc/scribblings/reference/hashes.scrbl index 086350ecf0..a5b8d419a1 100644 --- a/pkgs/racket-doc/scribblings/reference/hashes.scrbl +++ b/pkgs/racket-doc/scribblings/reference/hashes.scrbl @@ -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 diff --git a/pkgs/racket-test-core/tests/racket/basic.rktl b/pkgs/racket-test-core/tests/racket/basic.rktl index 0a4732761b..baaedf3969 100644 --- a/pkgs/racket-test-core/tests/racket/basic.rktl +++ b/pkgs/racket-test-core/tests/racket/basic.rktl @@ -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") diff --git a/pkgs/racket-test-core/tests/racket/read.rktl b/pkgs/racket-test-core/tests/racket/read.rktl index 4c18c4df28..304ebd8ae2 100644 --- a/pkgs/racket-test-core/tests/racket/read.rktl +++ b/pkgs/racket-test-core/tests/racket/read.rktl @@ -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) diff --git a/pkgs/zo-lib/compiler/zo-parse.rkt b/pkgs/zo-lib/compiler/zo-parse.rkt index eab21e82c9..7011e6b1b3 100644 --- a/pkgs/zo-lib/compiler/zo-parse.rkt +++ b/pkgs/zo-lib/compiler/zo-parse.rkt @@ -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)])) ;; ---------------------------------------- diff --git a/racket/collects/racket/pretty.rkt b/racket/collects/racket/pretty.rkt index 79b363facf..b80d7dafbc 100644 --- a/racket/collects/racket/pretty.rkt +++ b/racket/collects/racket/pretty.rkt @@ -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)) diff --git a/racket/src/cs/rumble/hash.ss b/racket/src/cs/rumble/hash.ss index 37de00e102..71b76b8ef5 100644 --- a/racket/src/cs/rumble/hash.ss +++ b/racket/src/cs/rumble/hash.ss @@ -59,15 +59,18 @@ (syntax-rules () [(_ vararg-ctor list-ctor empty-hash) (begin - (define (vararg-ctor . kvs) - (let loop ([kvs kvs] [h empty-hash]) - (cond [(null? kvs) h] - [else - (loop (cddr kvs) (intmap-set h (car kvs) (cadr 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)))]))])) (define list-ctor (case-lambda - [() (vararg-ctor)] + [() empty-hash] [(alist) (check 'list-ctor :test (and (list? alist) (andmap pair? alist)) diff --git a/racket/src/cs/rumble/intmap.ss b/racket/src/cs/rumble/intmap.ss index 1fdc11c766..ee8db0bd76 100644 --- a/racket/src/cs/rumble/intmap.ss +++ b/racket/src/cs/rumble/intmap.ss @@ -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 diff --git a/racket/src/racket/src/env.c b/racket/src/racket/src/env.c index ac70a9973b..c2b6d2573c 100644 --- a/racket/src/racket/src/env.c +++ b/racket/src/racket/src/env.c @@ -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(); diff --git a/racket/src/racket/src/hash.c b/racket/src/racket/src/hash.c index dc03fa6a40..1fc06614f0 100644 --- a/racket/src/racket/src/hash.c +++ b/racket/src/racket/src/hash.c @@ -4,6 +4,8 @@ #include #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))) { diff --git a/racket/src/racket/src/list.c b/racket/src/racket/src/list.c index 265bae00d6..6d0a252fc3 100644 --- a/racket/src/racket/src/list.c +++ b/racket/src/racket/src/list.c @@ -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); diff --git a/racket/src/racket/src/optimize.c b/racket/src/racket/src/optimize.c index a25554a16c..83cd57c5ff 100644 --- a/racket/src/racket/src/optimize.c +++ b/racket/src/racket/src/optimize.c @@ -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")))) { - return scheme_null; + 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) diff --git a/racket/src/racket/src/print.c b/racket/src/racket/src/print.c index b230508102..d07c5ea766 100644 --- a/racket/src/racket/src/print.c +++ b/racket/src/racket/src/print.c @@ -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 diff --git a/racket/src/racket/src/schemef.h b/racket/src/racket/src/schemef.h index d63edb8d24..1d2a33574e 100644 --- a/racket/src/racket/src/schemef.h +++ b/racket/src/racket/src/schemef.h @@ -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); diff --git a/racket/src/racket/src/schpriv.h b/racket/src/racket/src/schpriv.h index 9c380c9468..c6142cad41 100644 --- a/racket/src/racket/src/schpriv.h +++ b/racket/src/racket/src/schpriv.h @@ -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; diff --git a/racket/src/racket/src/schvers.h b/racket/src/racket/src/schvers.h index c15a6eb0f0..b898153ede 100644 --- a/racket/src/racket/src/schvers.h +++ b/racket/src/racket/src/schvers.h @@ -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)