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

add unsafe-X->immutable-X! for vectors, strings, and byte strings

Browse Source 
Follows up on an idea by @gus-massa in #1219, because this will be
useful to fix a problem with Racket CS I/O.
This commit is contained in:
Matthew Flatt 2020-05-18 16:08:08 -06:00
parent 0f4a947bab
commit 61b365f4be
9 changed files with 147 additions and 3 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.7.0.5")
(define version "7.7.0.6")
(define deps `("racket-lib"
["racket" #:version ,version]))

27
pkgs/racket-doc/scribblings/reference/unsafe.scrbl
View File

@ -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?]

21
pkgs/racket-test-core/tests/racket/unsafe.rktl
View File

@ -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)

3
racket/src/cs/primitive/unsafe.ss
View File

@ -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)]

4
racket/src/cs/rumble.sls
View File

@ -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

31
racket/src/cs/rumble/unsafe.ss
View File

@ -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:

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

@ -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

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

@ -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

58
racket/src/racket/src/vector.c
View File

@ -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;
}