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

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

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

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)

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

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

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:

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

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

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