Abstracts randomized testing forms over the underlying PRG

collects/redex/private/rg.rkt

@@ -12,8 +12,14 @@
          (for-syntax "keyword-macros.ss")
          mrlib/tex-table)
 
-(define (exotic-choice? [random random]) (= 0 (random 5)))
-(define (use-lang-literal? [random random]) (= 0 (random 20)))
+(define redex-pseudo-random-generator
+  (make-parameter (current-pseudo-random-generator)))
+(define (generator-random . arg)
+  (parameterize ([current-pseudo-random-generator (redex-pseudo-random-generator)])
+    (apply random arg)))
+
+(define (exotic-choice? [random generator-random]) (= 0 (random 5)))
+(define (use-lang-literal? [random generator-random]) (= 0 (random 20)))
 
 (define default-check-attempts 1000)
 
@@ -21,11 +27,11 @@
 (define tex-chars-threshold 1500)
 (define chinese-chars-threshold 2500)
 
-(define (pick-var lang-lits attempt [random random])
+(define (pick-var lang-lits attempt [random generator-random])
   (let ([length (add1 (random-natural 4/5 random))])
     (string->symbol (random-string lang-lits length attempt random))))
 
-(define (pick-char attempt [random random])
+(define (pick-char attempt [random generator-random])
   (cond [(or (< attempt ascii-chars-threshold) (not (exotic-choice? random)))
          (let ([i (random (add1 (- (char->integer #\z) (char->integer #\a))))]
                [cap? (zero? (random 2))])
@@ -39,18 +45,18 @@
         [else
          (integer->char (+ #x4E00 (random (- #x9FCF #x4E00))))]))
 
-(define (random-string lang-lits length attempt [random random])
+(define (random-string lang-lits length attempt [random generator-random])
   (if (and (not (null? lang-lits)) (use-lang-literal? random))
       (pick-from-list lang-lits random)
       (list->string (build-list length (λ (_) (pick-char attempt random))))))
 
-(define (pick-any lang sexp [random random]) 
+(define (pick-any lang sexp [random generator-random]) 
   (if (and (> (dict-count (rg-lang-non-cross lang)) 0) (zero? (random 5)))
       (let ([nts (rg-lang-non-cross lang)])
         (values lang (pick-from-list (dict-map nts (λ (nt _) nt)) random)))
       (values sexp 'sexp)))
 
-(define (pick-string lang-lits attempt [random random])
+(define (pick-string lang-lits attempt [random generator-random])
   (random-string lang-lits (random-natural 1/5 random) attempt random))
 
 ;; next-non-terminal-decision selects a subset of a non-terminal's productions.
@@ -58,7 +64,8 @@
 ;; generator's test cases restrict the productions.
 (define pick-nts values)
 
-(define (pick-from-list l [random random]) (list-ref l (random (length l))))
+(define (pick-from-list l [random generator-random])
+  (list-ref l (random (length l))))
 
 ;; Chooses a random (exact) natural number from the "shifted" geometric distribution:
 ;;   P(random-natural = k) = p(1-p)^k
@@ -66,22 +73,22 @@
 ;; P(random-natural >= k) = (1-p)^(k+1)
 ;; E(random-natural) = (1-p)/p
 ;; Var(random-natural) = (1-p)/p^2
-(define (random-natural p [random random])
+(define (random-natural p [random generator-random])
   (sub1 (inexact->exact (ceiling (real-part (/ (log (random)) (log (- 1 p))))))))
 
 (define (negative? random)
   (zero? (random 2)))
 
-(define (random-integer p [random random])
+(define (random-integer p [random generator-random])
   (* (if (negative? random) -1 1) (random-natural p random)))
 
-(define (random-rational p [random random])
+(define (random-rational p [random generator-random])
   (/ (random-integer p random) (add1 (random-natural p random))))
 
-(define (random-real p [random random])
+(define (random-real p [random generator-random])
   (* (random) 2 (random-integer p random)))
 
-(define (random-complex p [random random])
+(define (random-complex p [random generator-random])
   (let ([randoms (list random-integer random-rational random-real)])
     (make-rectangular ((pick-from-list randoms random) p random) 
                       ((pick-from-list randoms random) p random))))
@@ -109,7 +116,7 @@
 (define attempt->size 
   (make-parameter default-attempt->size))
 
-(define (pick-number attempt #:top-threshold [top-threshold complex-threshold] [random random])
+(define (pick-number attempt #:top-threshold [top-threshold complex-threshold] [random generator-random])
   (let loop ([threshold 0] 
              [generator random-natural]
              [levels `((,integer-threshold . ,random-integer)
@@ -123,13 +130,13 @@
         (generator (expected-value->p ((attempt->size) (- attempt threshold))) random)
         (loop (caar levels) (cdar levels) (cdr levels)))))
 
-(define (pick-natural attempt [random random])
+(define (pick-natural attempt [random generator-random])
   (pick-number attempt #:top-threshold 0 random))
 
-(define (pick-integer attempt [random random])
+(define (pick-integer attempt [random generator-random])
   (pick-number attempt #:top-threshold integer-threshold random))
 
-(define (pick-real attempt [random random])
+(define (pick-real attempt [random generator-random])
   (pick-number attempt #:top-threshold real-threshold random))
 
 (define (pick-sequence-length attempt)
@@ -991,7 +998,8 @@
          generate-term
          check-reduction-relation
          check-metafunction
-         exn:fail:redex:generation-failure?)
+         exn:fail:redex:generation-failure?
+         redex-pseudo-random-generator)
 
 (provide (struct-out ellipsis) 
          (struct-out mismatch)

collects/redex/redex.scrbl

@@ -1454,7 +1454,12 @@ produces and consumes argument lists.}
   @racket[redex-check], etc. when those forms are unable to produce
   a term matching some pattern.
 }
-                                                            
+               
+@defparam[redex-pseudo-random-generator generator pseudo-random-generator?]{
+@racket[generate-term] and the randomized testing forms (e.g., @racket[redex-check])
+use the parameter @racket[generator] to construct random terms. The parameter's
+initial value is @racket[(current-pseudo-random-generator)].}
+
 @deftech{Debugging PLT Redex Programs}
 
 It is easy to write grammars and reduction rules that are

collects/redex/reduction-semantics.rkt

@@ -76,4 +76,5 @@
                   (-> bindings? symbol? any)
                   (-> bindings? symbol? (-> any) any))]
  [relation-coverage (parameter/c (listof coverage?))]
- [covered-cases (-> coverage? (listof (cons/c string? natural-number/c)))])
+ [covered-cases (-> coverage? (listof (cons/c string? natural-number/c)))]
+ [redex-pseudo-random-generator (parameter/c pseudo-random-generator?)])

collects/redex/tests/rg-test.rkt

@@ -1257,4 +1257,22 @@
    '(x ..._1 x ..._2 variable ..._2 variable ..._3 variable_1 ..._3 variable_1 ..._4)
    '((..._1 . ..._4) (..._2 . ..._4) (..._3 . ..._4))))
 
+;; redex-test-seed
+(let ([seed 0])
+  (define-language L)
+  (define (generate)
+    (generate-term L (number ...) 10000000 #:attempt-num 10000000))
+  (test (begin (random-seed seed) (generate))
+        (begin (random-seed seed) (generate)))
+  (let ([prg (make-pseudo-random-generator)])
+    (define (seed-effect-generate effect)
+      (begin
+        (parameterize ([current-pseudo-random-generator prg])
+          (random-seed seed))
+        (effect)
+        (parameterize ([redex-pseudo-random-generator prg])
+          (generate))))
+    (test (seed-effect-generate void)
+          (seed-effect-generate random))))
+
 (print-tests-passed 'rg-test.ss)