vector->pseudo-random-generator[!]: accept impersonated vectors

pkgs/racket-test-core/tests/racket/number.rktl

@@ -2726,12 +2726,27 @@
 (err/rt-test (vector->pseudo-random-generator #()))
 (err/rt-test (vector->pseudo-random-generator #(0 0 0 1 2 3)))
 ;; Known state should produce known values:
-(parameterize ([current-pseudo-random-generator
-                (vector->pseudo-random-generator
-                 #(3620087466 1904163406 3177592043 1406334318 257151704 3090455638))])
-  (test 5353 random 10000)
-  (test 8571 random 10000)
-  (test 9729 random 10000))
+(let* ([check-known
+        (lambda (vector->pseudo-random-generator wrap)
+          (parameterize ([current-pseudo-random-generator
+                          (vector->pseudo-random-generator
+                           (wrap #(3620087466 1904163406 3177592043 1406334318 257151704 3090455638)))])
+            (test 5353 random 10000)
+            (test 8571 random 10000)
+            (test 9729 random 10000)))]
+       [hits 0]
+       [chaperone-it (lambda (vec) (chaperone-vector vec
+                                                     (lambda (vec i v) (set! hits (add1 hits)) v)
+                                                     (lambda (vec i v) (error "should not mutate"))))]
+       [make (lambda (vec)
+               (define p (vector->pseudo-random-generator '#(1 2 3 4 5 6)))
+               (vector->pseudo-random-generator! p vec)
+               p)])
+  (check-known vector->pseudo-random-generator values)
+  (check-known vector->pseudo-random-generator chaperone-it)
+  (check-known make values)
+  (check-known make chaperone-it)
+  (test 12 values hits))
 (parameterize ([current-pseudo-random-generator
                 (vector->pseudo-random-generator
                  #(3620087466 1904163406 3177592043 1406334318 257151704 3090455638))])
@@ -2751,6 +2766,7 @@
                               (apply append (for/list ([i 10000])
                                               (random-sample (range 10) 100)))))))
 
+
 (parameterize ([current-pseudo-random-generator (make-pseudo-random-generator)])
   (random-seed 2)
   (test '#(1062645402 3593208522 3838676319 2291995347 179540564 3081399108)

racket/src/bc/src/newrandom.inc

@@ -85,7 +85,7 @@ static Scheme_Object *pack_rand_state(Scheme_Object *vec, Scheme_Random_State *s
 #define REF(r, i, top) \
   { \
     uintptr_t l; \
-    if (!scheme_get_unsigned_int_val(SCHEME_VEC_ELS(vec)[i],  &l)) \
+    if (!scheme_get_unsigned_int_val(scheme_chaperone_vector_ref(vec, i),  &l)) \
       return NULL; \
     if (l > top - 1) \
       return NULL; \

racket/src/bc/src/numstr.c

@@ -2923,7 +2923,7 @@ double scheme_double_random(Scheme_Object *rand_state)
 static Scheme_Object *
 do_pack(const char *name, int argc, Scheme_Object *argv[], int set, int check)
 {
-  Scheme_Object *s;
+  Scheme_Object *s, *vec;
   GC_CAN_IGNORE Scheme_Random_State rs;
 
   if (set) {
@@ -2933,7 +2933,11 @@ do_pack(const char *name, int argc, Scheme_Object *argv[], int set, int check)
     }
   }
 
-  if (SCHEME_VECTORP(argv[set]) && (SCHEME_VEC_SIZE(argv[set]) == 6))
+  vec = argv[set];
+  if (SCHEME_NP_CHAPERONEP(vec))
+    vec = SCHEME_CHAPERONE_VAL(vec);
+
+  if (SCHEME_VECTORP(vec) && (SCHEME_VEC_SIZE(vec) == 6))
     s = pack_rand_state(argv[set], ((set || check) ? &rs : NULL));
   else
     s = NULL;

racket/src/cs/chezpart.sls

@@ -47,7 +47,9 @@
                            bitwise-not
                            fllog flatan
                            fxquotient
-                           make-flvector flvector-copy)
+                           make-flvector flvector-copy
+                           vector->pseudo-random-generator
+                           vector->pseudo-random-generator!)
                    [make-parameter chez:make-parameter]
                    [date-second chez:date-second]
                    [date-minute chez:date-minute]

racket/src/cs/rumble.sls

@@ -432,6 +432,8 @@
           random-seed
           current-pseudo-random-generator
           pseudo-random-generator-vector?
+          vector->pseudo-random-generator
+          vector->pseudo-random-generator!
 
           mpair?
           mcons

racket/src/cs/rumble/random.ss

@@ -353,3 +353,25 @@
          (in-range? 5 4294944442)
          (or (nonzero? 0) (nonzero? 1) (nonzero? 2))
          (or (nonzero? 3) (nonzero? 4) (nonzero? 5)))))
+
+(define (vector->pseudo-random-generator v)
+  (#%vector->pseudo-random-generator (unwrap-pseudo-random-generator-vector v)))
+
+(define (vector->pseudo-random-generator! s v)
+  (#%vector->pseudo-random-generator! s (if (pseudo-random-generator? s)
+                                            (unwrap-pseudo-random-generator-vector v)
+                                            v)))
+
+;; convert a vector for chaperoned form:
+(define (unwrap-pseudo-random-generator-vector v)
+  (cond
+    [(and (not (#%vector? v))
+          (vector? v)
+          (= 6 (vector-length v)))
+     (vector (vector-ref v 0)
+             (vector-ref v 1)
+             (vector-ref v 2)
+             (vector-ref v 3)
+             (vector-ref v 4)
+             (vector-ref v 5))]
+    [else v]))