diff --git a/pkgs/racket-test/tests/racket/contract/random-generate.rkt b/pkgs/racket-test/tests/racket/contract/random-generate.rkt index 7799eda374..2b1d98b077 100644 --- a/pkgs/racket-test/tests/racket/contract/random-generate.rkt +++ b/pkgs/racket-test/tests/racket/contract/random-generate.rkt @@ -3,6 +3,7 @@ (require racket/contract racket/contract/private/generate-base rackunit + racket/math (for-syntax racket/base)) ;; this is expected to never have a generator. @@ -41,6 +42,8 @@ (check-not-exn (λ () (test-contract-generation (listof number?)))) (check-not-exn (λ () (test-contract-generation (integer-in 0 100)))) +(check-not-exn (λ () (test-contract-generation exact-nonnegative-integer?))) +(check-not-exn (λ () (test-contract-generation natural?))) (check-not-exn (λ () (test-contract-generation (integer-in 0 (expt 2 1000))))) (check-not-exn (λ () (test-contract-generation (char-in #\a #\z)))) (check-not-exn (λ () (test-contract-generation #\a))) diff --git a/racket/collects/racket/contract/private/generate-base.rkt b/racket/collects/racket/contract/private/generate-base.rkt index e09c19e042..843837a730 100644 --- a/racket/collects/racket/contract/private/generate-base.rkt +++ b/racket/collects/racket/contract/private/generate-base.rkt @@ -1,5 +1,6 @@ #lang racket/base -(require "rand.rkt") +(require "rand.rkt" + "../../private/math-predicates.rkt") (provide contract-random-generate-fail @@ -71,6 +72,9 @@ exact-integer? exact-integer-gen + natural? + exact-nonnegative-integer-gen + exact-nonnegative-integer? exact-nonnegative-integer-gen diff --git a/racket/collects/racket/math.rkt b/racket/collects/racket/math.rkt index df28590218..0bf7b5ad7b 100644 --- a/racket/collects/racket/math.rkt +++ b/racket/collects/racket/math.rkt @@ -5,7 +5,8 @@ #lang racket/base (require "unsafe/ops.rkt" - "performance-hint.rkt") + "performance-hint.rkt" + "private/math-predicates.rkt") (provide pi pi.f nan? infinite? @@ -26,30 +27,6 @@ (begin-encourage-inline - ;; real predicates - (define (nan? x) - (unless (real? x) (raise-argument-error 'nan? "real?" x)) - (or (eqv? x +nan.0) (eqv? x +nan.f))) - - (define (infinite? x) - (unless (real? x) (raise-argument-error 'infinite? "real?" x)) - (or (= x +inf.0) (= x -inf.0))) - - (define (positive-integer? x) - (and (integer? x) (positive? x))) - - (define (negative-integer? x) - (and (integer? x) (negative? x))) - - (define (nonpositive-integer? x) - (and (integer? x) (not (positive? x)))) - - (define (nonnegative-integer? x) - (and (integer? x) (not (negative? x)))) - - (define (natural? x) - (exact-nonnegative-integer? x)) - ;; z^2 (define (sqr z) (unless (number? z) (raise-argument-error 'sqr "number?" z)) diff --git a/racket/collects/racket/private/math-predicates.rkt b/racket/collects/racket/private/math-predicates.rkt new file mode 100644 index 0000000000..c188157e14 --- /dev/null +++ b/racket/collects/racket/private/math-predicates.rkt @@ -0,0 +1,38 @@ +#lang racket/base +(require "performance-hint.rkt") +(provide nan? + infinite? + positive-integer? + negative-integer? + nonpositive-integer? + nonnegative-integer? + natural?) + +;; these are broken out from racket/math +;; so that racket/contract can depend on them + +(begin-encourage-inline + + ;; real predicates + (define (nan? x) + (unless (real? x) (raise-argument-error 'nan? "real?" x)) + (or (eqv? x +nan.0) (eqv? x +nan.f))) + + (define (infinite? x) + (unless (real? x) (raise-argument-error 'infinite? "real?" x)) + (or (= x +inf.0) (= x -inf.0))) + + (define (positive-integer? x) + (and (integer? x) (positive? x))) + + (define (negative-integer? x) + (and (integer? x) (negative? x))) + + (define (nonpositive-integer? x) + (and (integer? x) (not (positive? x)))) + + (define (nonnegative-integer? x) + (and (integer? x) (not (negative? x)))) + + (define (natural? x) + (exact-nonnegative-integer? x))) \ No newline at end of file