diff --git a/pkgs/racket-doc/scribblings/reference/numbers.scrbl b/pkgs/racket-doc/scribblings/reference/numbers.scrbl index 1ce1061240..0817ec2de8 100644 --- a/pkgs/racket-doc/scribblings/reference/numbers.scrbl +++ b/pkgs/racket-doc/scribblings/reference/numbers.scrbl @@ -842,13 +842,30 @@ both in binary and as integers. [rand-gen pseudo-random-generator? (current-pseudo-random-generator)]) exact-nonnegative-integer?] + [(random [min (integer-in 1 4294967087)] + [max (integer-in 1 4294967087)] + [rand-gen pseudo-random-generator? + (current-pseudo-random-generator)]) + exact-nonnegative-integer?] + [(random [seq sequence?] + [rand-gen pseudo-random-generator? + (current-pseudo-random-generator)]) + any/c] [(random [rand-gen pseudo-random-generator? (current-pseudo-random-generator)]) (and/c real? inexact? (>/c 0) (pseudo-random-generator + #(3620087466 1904163406 3177592043 1406334318 257151704 3090455638))]) + (test 3 random '(1 2 3 4 5)) + (test 10 random '#(7 6 8 9 10)) + (test #\e random "abcde")) (test #t = 0 0) (test #f = 0 (expt 2 32)) diff --git a/racket/collects/racket/private/for.rkt b/racket/collects/racket/private/for.rkt index c95664af1a..12851138ec 100644 --- a/racket/collects/racket/private/for.rkt +++ b/racket/collects/racket/private/for.rkt @@ -78,6 +78,9 @@ sequence-generate sequence-generate* prop:sequence + sequence-length + + -sequence-ref define-sequence-syntax make-do-sequence @@ -2029,4 +2032,29 @@ #true [(next-body l d init-dir use-dir?)])]]))) + (define-values (sequence-length) + (λ (s) + (unless (sequence? s) (raise-argument-error 'sequence-length "sequence?" s)) + (for/fold ([c 0]) ([i (in-values*-sequence s)]) + (add1 c)))) + + (define-values (-sequence-ref) + (λ (s i) + (unless (sequence? s) (raise-argument-error 'sequence-ref "sequence?" s)) + (unless (exact-nonnegative-integer? i) + (raise-argument-error 'sequence-ref "exact-nonnegative-integer?" i)) + (let-values ([(v) (for/fold ([c #f]) ([v (in-values*-sequence s)] + [j (in-range (add1 i))] + #:unless (j . < . i)) + (or v '(#f)))]) + (cond + [(not v) + (raise-arguments-error + 'sequence-ref + "sequence ended before index" + "index" i + "sequence" s)] + [(list? v) (apply values v)] + [else v])))) + ) diff --git a/racket/collects/racket/private/pre-base.rkt b/racket/collects/racket/private/pre-base.rkt index e695d4bf08..15986c49bc 100644 --- a/racket/collects/racket/private/pre-base.rkt +++ b/racket/collects/racket/private/pre-base.rkt @@ -97,6 +97,67 @@ (define-values (double-flonum?) ; for symmetry with single-flonum? (lambda (x) (flonum? x))) + (define-values (enforce-random-int-range) + (lambda (x) + (unless (and (exact-positive-integer? x) + (<= x 4294967087)) + (raise-argument-error 'random "(integer-in 1 4294967087)" x)))) + (define-values (enforce-greater) + (lambda (x y) + (unless (> y x) + (raise-argument-error + 'random + (string-append "integer greater than " (number->string x)) + y)))) + (define-values (-random) ; more featureful than #%kernel's `random` + (case-lambda + [() (random)] ; no args, random float + [(x) + ;; one arg, either random float with prng, or random integer, or random + ;; sequence element + (cond [(exact-positive-integer? x) + (enforce-random-int-range x) + (random x)] + [(pseudo-random-generator? x) + (random x)] + [(sequence? x) + (-sequence-ref x (random (sequence-length x)))] + [else + (raise-argument-error + 'random + "(or/c (integer-in 1 4294967087) sequence? pseudo-random-generator?)" + x)])] + [(x y) + ;; two args, either min and prng, or min and max, or sequence and prng + (cond [(exact-positive-integer? y) ; min and max case + (enforce-random-int-range x) + (enforce-random-int-range y) + (enforce-greater x y) + (+ x (random (- y x)))] + [(pseudo-random-generator? y) + (cond [(exact-positive-integer? x) ; int and prng case + (enforce-random-int-range x) + (random x y)] + [(sequence? x) ; sequence and prng case + (-sequence-ref x (random (sequence-length x) y))] + [else + (raise-argument-error + 'random + "(or/c (integer-in 1 4294967087) sequence?)" + x)])] + [else + (raise-argument-error + 'random + "(or/c (integer-in 1 4294967087) pseudo-random-generator?)" + y)])] + [(min max prng) ; three args: min, max, and prng + (enforce-random-int-range min) + (enforce-random-int-range max) + (enforce-greater min max) + (unless (pseudo-random-generator? prng) + (raise-argument-error 'random "pseudo-random-generator?" prng)) + (+ min (random (- max min) prng))])) + (define-values (new:collection-path) (let ([collection-path (new-lambda (collection #:fail [fail (lambda (s) @@ -184,7 +245,8 @@ chaperone-procedure impersonate-procedure chaperone-procedure* impersonate-procedure* assq assv assoc - prop:incomplete-arity prop:method-arity-error) + prop:incomplete-arity prop:method-arity-error + random) (all-from "reqprov.rkt") (all-from-except "for.rkt" define-in-vector-like @@ -207,4 +269,5 @@ define-struct/derived struct-field-index struct-copy - double-flonum?)) + double-flonum? + (rename -random random))) diff --git a/racket/collects/racket/private/sequence.rkt b/racket/collects/racket/private/sequence.rkt index 3c25917e3a..4c199d9251 100644 --- a/racket/collects/racket/private/sequence.rkt +++ b/racket/collects/racket/private/sequence.rkt @@ -9,7 +9,9 @@ sequence-ormap sequence-for-each sequence-fold - sequence-count) + sequence-count + sequence-length + (rename-out [-sequence-ref sequence-ref])) (define (sequence-andmap f s) (unless (procedure? f) (raise-argument-error 'sequence-andmap "procedure?" f)) diff --git a/racket/collects/racket/sequence.rkt b/racket/collects/racket/sequence.rkt index cd68cd305c..51d98f1996 100644 --- a/racket/collects/racket/sequence.rkt +++ b/racket/collects/racket/sequence.rkt @@ -39,29 +39,6 @@ (define (sequence->list s) (for/list ([v s]) v)) -(define (sequence-length s) - (unless (sequence? s) (raise-argument-error 'sequence-length "sequence?" s)) - (for/fold ([c 0]) ([i (in-values*-sequence s)]) - (add1 c))) - -(define (sequence-ref s i) - (unless (sequence? s) (raise-argument-error 'sequence-ref "sequence?" s)) - (unless (exact-nonnegative-integer? i) - (raise-argument-error 'sequence-ref "exact-nonnegative-integer?" i)) - (let ([v (for/fold ([c #f]) ([v (in-values*-sequence s)] - [j (in-range (add1 i))] - #:unless (j . < . i)) - (or v '(#f)))]) - (cond - [(not v) - (raise-arguments-error - 'sequence-ref - "sequence ended before index" - "index" i - "sequence" s)] - [(list? v) (apply values v)] - [else v]))) - (define (sequence-tail seq i) (unless (sequence? seq) (raise-argument-error 'sequence-tail "sequence?" seq)) (unless (exact-nonnegative-integer? i)