From 61b365f4be8b772d1b14ddb18ff74d775381a4be Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 18 May 2020 16:08:08 -0600 Subject: [PATCH] add `unsafe-X->immutable-X!` for vectors, strings, and byte strings Follows up on an idea by @gus-massa in #1219, because this will be useful to fix a problem with Racket CS I/O. --- pkgs/base/info.rkt | 2 +- .../scribblings/reference/unsafe.scrbl | 27 +++++++++ .../racket-test-core/tests/racket/unsafe.rktl | 21 +++++++ racket/src/cs/primitive/unsafe.ss | 3 + racket/src/cs/rumble.sls | 4 ++ racket/src/cs/rumble/unsafe.ss | 31 ++++++++++ racket/src/racket/src/schminc.h | 2 +- racket/src/racket/src/schvers.h | 2 +- racket/src/racket/src/vector.c | 58 +++++++++++++++++++ 9 files changed, 147 insertions(+), 3 deletions(-) diff --git a/pkgs/base/info.rkt b/pkgs/base/info.rkt index a93868fb8e..7c98ed3e43 100644 --- a/pkgs/base/info.rkt +++ b/pkgs/base/info.rkt @@ -12,7 +12,7 @@ (define collection 'multi) -(define version "7.7.0.5") +(define version "7.7.0.6") (define deps `("racket-lib" ["racket" #:version ,version])) diff --git a/pkgs/racket-doc/scribblings/reference/unsafe.scrbl b/pkgs/racket-doc/scribblings/reference/unsafe.scrbl index 4995cb23b2..4170e5268b 100644 --- a/pkgs/racket-doc/scribblings/reference/unsafe.scrbl +++ b/pkgs/racket-doc/scribblings/reference/unsafe.scrbl @@ -292,6 +292,16 @@ A vector's size can never be larger than a @tech{fixnum}, so even @history[#:changed "6.11.0.2" @elem{Added @racket[unsafe-vector*-cas!].}]} + +@defproc[(unsafe-vector*->immutable-vector! [v (and/c vector? (not/c impersonator?))]) (and/c vector? immutable?)]{ + +Similar to @racket[vector->immutable-vector], but potentially destroys +@racket[v] and reuses it space, so @racket[v] must not be used after +calling @racket[unsafe-vector*->immutable-vector!]. + +@history[#:added "7.7.0.6"]} + + @deftogether[( @defproc[(unsafe-string-length [str string?]) fixnum?] @defproc[(unsafe-string-ref [str string?] [k fixnum?]) @@ -305,6 +315,14 @@ only when the result will be a Latin-1 character. A string's size can never be larger than a @tech{fixnum} (so even @racket[string-length] always returns a fixnum).} +@defproc[(unsafe-string->immutable-string! [str string?]) (and/c string? immutable?)]{ + +Similar to @racket[string->immutable-string], but potentially destroys +@racket[str] and reuses it space, so @racket[str] must not be used +after calling @racket[unsafe-string->immutable-string!]. + +@history[#:added "7.7.0.6"]} + @deftogether[( @defproc[(unsafe-bytes-length [bstr bytes?]) fixnum?] @@ -327,6 +345,15 @@ fixnum). @history[#:changed "7.5.0.15" @elem{Added @racket[unsafe-bytes-copy!].}]} +@defproc[(unsafe-bytes->immutable-bytes! [bstr bytes?]) (and/c bytes? immutable?)]{ + +Similar to @racket[bytes->immutable-bytes], but potentially destroys +@racket[bstr] and reuses it space, so @racket[bstr] must not be used +after calling @racket[unsafe-bytes->immutable-bytes!]. + +@history[#:added "7.7.0.6"]} + + @deftogether[( @defproc[(unsafe-fxvector-length [v fxvector?]) fixnum?] @defproc[(unsafe-fxvector-ref [v fxvector?] [k fixnum?]) fixnum?] diff --git a/pkgs/racket-test-core/tests/racket/unsafe.rktl b/pkgs/racket-test-core/tests/racket/unsafe.rktl index 843df1530f..c07575b586 100644 --- a/pkgs/racket-test-core/tests/racket/unsafe.rktl +++ b/pkgs/racket-test-core/tests/racket/unsafe.rktl @@ -984,4 +984,25 @@ ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(let ([bstr (make-bytes 5 65)] + [str (make-string 5 #\x)] + [vec (make-vector 5 'x)]) + (let ([bstr (unsafe-bytes->immutable-bytes! bstr)] + [str (unsafe-string->immutable-string! str)] + [vec (unsafe-vector*->immutable-vector! vec)]) + (test #t immutable? bstr) + (test #t immutable? str) + (test #t immutable? vec) + (test #t equal? #"AAAAA" bstr) + (test #t equal? "xxxxx" str) + (test #t equal? '#(x x x x x) vec) + (test #t immutable? (unsafe-bytes->immutable-bytes! (make-bytes 0))) + (test #f immutable? (make-bytes 0)) + (test #t immutable? (unsafe-string->immutable-string! (make-string 0))) + (test #f immutable? (make-string 0)) + (test #t immutable? (unsafe-vector*->immutable-vector! (make-vector 0))) + (test #f immutable? (make-vector 0)))) + +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (report-errs) diff --git a/racket/src/cs/primitive/unsafe.ss b/racket/src/cs/primitive/unsafe.ss index cf72ba9dfb..60b933daea 100644 --- a/racket/src/cs/primitive/unsafe.ss +++ b/racket/src/cs/primitive/unsafe.ss @@ -13,6 +13,7 @@ [unsafe-bytes-ref (known-procedure/succeeds 4)] [unsafe-bytes-set! (known-procedure/succeeds 8)] [unsafe-bytes-copy! (known-procedure/succeeds 56)] + [unsafe-bytes->immutable-bytes! (known-procedure/succeeds 2)] [unsafe-call-in-os-thread (known-procedure 2)] [unsafe-call-with-composable-continuation/no-wind (known-procedure 4)] [unsafe-car (known-procedure/pure 2)] @@ -155,6 +156,7 @@ [unsafe-string-length (known-procedure/pure 2)] [unsafe-string-ref (known-procedure/succeeds 4)] [unsafe-string-set! (known-procedure/succeeds 8)] + [unsafe-string->immutable-string! (known-procedure/succeeds 2)] [unsafe-struct*-cas! (known-procedure 16)] [unsafe-struct*-ref (known-procedure/succeeds 4)] [unsafe-struct*-set! (known-procedure/succeeds 8)] @@ -170,6 +172,7 @@ [unsafe-vector*-length (known-procedure/pure 2)] [unsafe-vector*-ref (known-procedure/succeeds 4)] [unsafe-vector*-set! (known-procedure/succeeds 8)] + [unsafe-vector*->immutable-vector! (known-procedure/succeeds 2)] [unsafe-vector-length (known-procedure/pure 2)] [unsafe-vector-ref (known-procedure 4)] [unsafe-vector-set! (known-procedure 8)] diff --git a/racket/src/cs/rumble.sls b/racket/src/cs/rumble.sls index 3068c8d448..0e7bf81bf1 100644 --- a/racket/src/cs/rumble.sls +++ b/racket/src/cs/rumble.sls @@ -698,6 +698,10 @@ unsafe-f80vector-set! unsafe-f80vector-ref + unsafe-bytes->immutable-bytes! + unsafe-string->immutable-string! + unsafe-vector*->immutable-vector! + ;; --- not exported to Racket: --- make-pthread-parameter fork-pthread diff --git a/racket/src/cs/rumble/unsafe.ss b/racket/src/cs/rumble/unsafe.ss index cfbefbf713..742c800cf3 100644 --- a/racket/src/cs/rumble/unsafe.ss +++ b/racket/src/cs/rumble/unsafe.ss @@ -172,6 +172,37 @@ (define (unsafe-flimag-part c) (#3%imag-part c)) +(define-syntax (immutable-constant stx) + (syntax-case stx () + [(i-c v) + (datum->syntax + #'i-c + (list 'quote + (let ([v (#%syntax->datum #'v)]) + (cond + [(bytevector? v) (bytevector->immutable-bytevector v)] + [(string? v) (string->immutable-string v)] + [(#%vector? v) (#%vector->immutable-vector v)]))))])) + +(define (unsafe-bytes->immutable-bytes! s) + (cond + [(= (bytes-length s) 0) (immutable-constant #vu8())] + [else + (#%$bytevector-set-immutable! s) + s])) +(define (unsafe-string->immutable-string! s) + (cond + [(= (string-length s) 0) (immutable-constant "")] + [else + (#%$string-set-immutable! s) + s])) +(define (unsafe-vector*->immutable-vector! v) + (cond + [(= (vector-length v) 0) (immutable-constant #())] + [else + (#%$vector-set-immutable! v) + v])) + ;; The black hole object is an immediate in Chez Scheme, ;; so a use is compact and the optimize can recognize ;; comparsions to itself: diff --git a/racket/src/racket/src/schminc.h b/racket/src/racket/src/schminc.h index 74b47a1c37..e6af7d0e36 100644 --- a/racket/src/racket/src/schminc.h +++ b/racket/src/racket/src/schminc.h @@ -14,7 +14,7 @@ #define USE_COMPILED_STARTUP 1 -#define EXPECTED_PRIM_COUNT 1466 +#define EXPECTED_PRIM_COUNT 1469 #ifdef MZSCHEME_SOMETHING_OMITTED # undef USE_COMPILED_STARTUP diff --git a/racket/src/racket/src/schvers.h b/racket/src/racket/src/schvers.h index 3f13deb7bf..bebb82ed88 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 7 #define MZSCHEME_VERSION_Z 0 -#define MZSCHEME_VERSION_W 5 +#define MZSCHEME_VERSION_W 6 /* A level of indirection makes `#` work as needed: */ #define AS_a_STR_HELPER(x) #x diff --git a/racket/src/racket/src/vector.c b/racket/src/racket/src/vector.c index 712af9aee4..17bdb08cf7 100644 --- a/racket/src/racket/src/vector.c +++ b/racket/src/racket/src/vector.c @@ -67,6 +67,9 @@ static Scheme_Object *unsafe_bytes_len (int argc, Scheme_Object *argv[]); static Scheme_Object *unsafe_bytes_ref (int argc, Scheme_Object *argv[]); static Scheme_Object *unsafe_bytes_set (int argc, Scheme_Object *argv[]); static Scheme_Object *unsafe_bytes_copy_bang (int argc, Scheme_Object *argv[]); +static Scheme_Object *unsafe_bytes_immutable_bang (int argc, Scheme_Object *argv[]); +static Scheme_Object *unsafe_string_immutable_bang (int argc, Scheme_Object *argv[]); +static Scheme_Object *unsafe_vector_immutable_bang (int argc, Scheme_Object *argv[]); void scheme_init_vector (Scheme_Startup_Env *env) @@ -357,6 +360,24 @@ scheme_init_unsafe_vector (Scheme_Startup_Env *env) 3, 5), env); + scheme_addto_prim_instance("unsafe-bytes->immutable-bytes!", + scheme_make_prim_w_arity(unsafe_bytes_immutable_bang, + "unsafe-bytes->immutable-bytes!", + 1, 1), + env); + + scheme_addto_prim_instance("unsafe-string->immutable-string!", + scheme_make_prim_w_arity(unsafe_string_immutable_bang, + "unsafe-string->immutable-string!", + 1, 1), + env); + + scheme_addto_prim_instance("unsafe-vector*->immutable-vector!", + scheme_make_prim_w_arity(unsafe_vector_immutable_bang, + "unsafe-vector*->immutable-vector!", + 1, 1), + env); + scheme_addto_prim_instance("unsafe-impersonate-vector", scheme_make_prim_w_arity(unsafe_impersonate_vector, "unsafe-impersonate-vector", @@ -1365,3 +1386,40 @@ static Scheme_Object *unsafe_bytes_copy_bang (int argc, Scheme_Object *argv[]) return scheme_void; } + +static Scheme_Object *unsafe_bytes_immutable_bang (int argc, Scheme_Object *argv[]) +{ + Scheme_Object *o = argv[0]; + + if (!SCHEME_BYTE_STRINGP(o)) + scheme_wrong_contract("unsafe-bytes->immutable-bytes!", "bytes?", 0, argc, argv); + + SCHEME_SET_IMMUTABLE(o); + + return o; +} + +static Scheme_Object *unsafe_string_immutable_bang (int argc, Scheme_Object *argv[]) +{ + Scheme_Object *o = argv[0]; + + if (!SCHEME_CHAR_STRINGP(o)) + scheme_wrong_contract("unsafe-string->immutable-string!", "string?", 0, argc, argv); + + SCHEME_SET_IMMUTABLE(o); + + return o; +} + +static Scheme_Object *unsafe_vector_immutable_bang (int argc, Scheme_Object *argv[]) +{ + Scheme_Object *o = argv[0]; + + if (!SCHEME_VECTORP(o)) + scheme_wrong_contract("unsafe-vector*->immutable-vector!", "(and/c vector? (not/c impersonator?))", + 0, argc, argv); + + SCHEME_SET_IMMUTABLE(o); + + return o; +}