diff --git a/pkgs/racket-test-core/tests/racket/number.rktl b/pkgs/racket-test-core/tests/racket/number.rktl index 1d7367b803..6487528682 100644 --- a/pkgs/racket-test-core/tests/racket/number.rktl +++ b/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) diff --git a/racket/src/bc/src/newrandom.inc b/racket/src/bc/src/newrandom.inc index 7ff9856d44..8e8d941df0 100644 --- a/racket/src/bc/src/newrandom.inc +++ b/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; \ diff --git a/racket/src/bc/src/numstr.c b/racket/src/bc/src/numstr.c index bf174e0df1..785b7bf11f 100644 --- a/racket/src/bc/src/numstr.c +++ b/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; diff --git a/racket/src/cs/chezpart.sls b/racket/src/cs/chezpart.sls index 2d65ca5910..fd16d4ba82 100644 --- a/racket/src/cs/chezpart.sls +++ b/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] diff --git a/racket/src/cs/rumble.sls b/racket/src/cs/rumble.sls index 1c0c326c2c..6826542ea5 100644 --- a/racket/src/cs/rumble.sls +++ b/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 diff --git a/racket/src/cs/rumble/random.ss b/racket/src/cs/rumble/random.ss index 8d234c6910..0ff62fbd41 100644 --- a/racket/src/cs/rumble/random.ss +++ b/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]))