From 61000a454e58df6ad65f0dd6755639953151f863 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 16 Dec 2019 18:14:16 -0700 Subject: [PATCH] cs: cooperate with immutable strings for symbols in Chez Scheme Take advantage of new guarantees/support for immutable strings within a Chez Scheme symbol representation. Consistent use of immutable strings at the boundary avoids potential non-determinism. --- pkgs/base/info.rkt | 2 +- racket/src/cs/compile-file.ss | 2 +- racket/src/cs/linklet/write.ss | 17 +++++++++++++---- racket/src/cs/rumble/symbol.ss | 18 +++++++++++------- racket/src/racket/src/read.c | 11 ----------- racket/src/racket/src/schvers.h | 2 +- 6 files changed, 27 insertions(+), 25 deletions(-) diff --git a/pkgs/base/info.rkt b/pkgs/base/info.rkt index bd59847a90..c7dfa7366c 100644 --- a/pkgs/base/info.rkt +++ b/pkgs/base/info.rkt @@ -12,7 +12,7 @@ (define collection 'multi) -(define version "7.5.0.12") +(define version "7.5.0.13") (define deps `("racket-lib" ["racket" #:version ,version])) diff --git a/racket/src/cs/compile-file.ss b/racket/src/cs/compile-file.ss index 5c5a62475f..1d06077117 100644 --- a/racket/src/cs/compile-file.ss +++ b/racket/src/cs/compile-file.ss @@ -2,7 +2,7 @@ ;; Check to make we're using a build of Chez Scheme ;; that has all the features we need. (define-values (need-maj need-min need-sub need-dev) - (values 9 5 3 7)) + (values 9 5 3 8)) (unless (guard (x [else #f]) (eval 'scheme-fork-version-number)) (error 'compile-file diff --git a/racket/src/cs/linklet/write.ss b/racket/src/cs/linklet/write.ss index 659d4559b1..d101c7089c 100644 --- a/racket/src/cs/linklet/write.ss +++ b/racket/src/cs/linklet/write.ss @@ -46,10 +46,19 @@ ;; Before fasl conversion, change 'cross or 'faslable-unsafe to 'faslable (define (adjust-cross-perparation l) - (let ([p (linklet-preparation l)]) - (if (or (pair? p) (eq? p 'faslable-unsafe)) - (set-linklet-preparation l 'faslable) - l))) + (adjust-linklet-compress + (let ([p (linklet-preparation l)]) + (if (or (pair? p) (eq? p 'faslable-unsafe)) + (set-linklet-preparation l 'faslable) + l)))) + +(define (adjust-linklet-compress l) + (if (or compress-code? + (bytevector-uncompressed-fasl? (linklet-code l))) + l + (set-linklet-code l + (bytevector-uncompress (linklet-code l)) + (linklet-preparation l)))) (define (check-fasl-preparation l) (case (linklet-preparation l) diff --git a/racket/src/cs/rumble/symbol.ss b/racket/src/cs/rumble/symbol.ss index 009cd9cba0..ec28f606ba 100644 --- a/racket/src/cs/rumble/symbol.ss +++ b/racket/src/cs/rumble/symbol.ss @@ -16,7 +16,9 @@ (let loop () (let ([c (#%unbox gensym-counter)]) (if (#%box-cas! gensym-counter c (add1 c)) - (string-append s (number->string c)) + (let ([a (string-append s (number->string c))]) + (#%$string-set-immutable! a) + a) (loop))))) (define/who (symbol-interned? s) @@ -24,14 +26,14 @@ (not (or (gensym? s) (uninterned-symbol? s)))) -(define unreadable-unique-name "gr8mwsuasnvzbl9jjo6e9b-") +(define unreadable-unique-name "unreadable:") (define unreadable-unique-name-length (string-length unreadable-unique-name)) (define/who (symbol-unreadable? s) (check who symbol? s) (and (gensym? s) (let ([u (gensym->unique-string s)] - [str (symbol->string s)]) + [str (#%symbol->string s)]) (let ([len (string-length str)]) (and (fx= (string-length u) (fx+ unreadable-unique-name-length len)) @@ -52,16 +54,18 @@ (define/who (string->unreadable-symbol str) (check who string? str) - (#%gensym (string->immutable-string str) - (string-append unreadable-unique-name str))) + (#%gensym str + (let ([a (string-append unreadable-unique-name str)]) + (#%$string-set-immutable! a) + a))) (define/who symbolstring a) - (symbol->string b))] + (stringstring a) + (#%symbol->string b))] [(a . as) (check who symbol? a) (let loop ([a a] [as as] [r #t]) diff --git a/racket/src/racket/src/read.c b/racket/src/racket/src/read.c index 8915e7f478..b71a30167e 100644 --- a/racket/src/racket/src/read.c +++ b/racket/src/racket/src/read.c @@ -56,9 +56,6 @@ ROSYM static Scheme_Object *syntax_symbol; ROSYM static Scheme_Object *unsyntax_symbol; ROSYM static Scheme_Object *unsyntax_splicing_symbol; ROSYM static Scheme_Object *quasisyntax_symbol; -ROSYM static Scheme_Object *hash_code_symbol; -ROSYM static Scheme_Object *pre_symbol; -ROSYM static Scheme_Object *post_symbol; /* local function prototypes */ static Scheme_Object *read_case_sensitive(int, Scheme_Object *[]); @@ -185,10 +182,6 @@ void scheme_init_read(Scheme_Startup_Env *env) REGISTER_SO(unsyntax_splicing_symbol); REGISTER_SO(quasisyntax_symbol); - REGISTER_SO(hash_code_symbol); - REGISTER_SO(pre_symbol); - REGISTER_SO(post_symbol); - quote_symbol = scheme_intern_symbol("quote"); quasiquote_symbol = scheme_intern_symbol("quasiquote"); unquote_symbol = scheme_intern_symbol("unquote"); @@ -198,10 +191,6 @@ void scheme_init_read(Scheme_Startup_Env *env) unsyntax_splicing_symbol = scheme_intern_symbol("unsyntax-splicing"); quasisyntax_symbol = scheme_intern_symbol("quasisyntax"); - hash_code_symbol = scheme_intern_symbol("hash-code"); - pre_symbol = scheme_intern_symbol("pre"); - post_symbol = scheme_intern_symbol("post"); - /* initialize cpt_branch */ { int i; diff --git a/racket/src/racket/src/schvers.h b/racket/src/racket/src/schvers.h index 978868c72e..86a895ed1f 100644 --- a/racket/src/racket/src/schvers.h +++ b/racket/src/racket/src/schvers.h @@ -16,7 +16,7 @@ #define MZSCHEME_VERSION_X 7 #define MZSCHEME_VERSION_Y 5 #define MZSCHEME_VERSION_Z 0 -#define MZSCHEME_VERSION_W 12 +#define MZSCHEME_VERSION_W 13 /* A level of indirection makes `#` work as needed: */ #define AS_a_STR_HELPER(x) #x