diff --git a/collects/racket/fixnum.rkt b/collects/racket/fixnum.rkt index 11c23b3704..c04acf2e3b 100644 --- a/collects/racket/fixnum.rkt +++ b/collects/racket/fixnum.rkt @@ -1,7 +1,9 @@ #lang scheme/base + (require '#%flfxnum "private/vector-wraps.rkt" - "unsafe/ops.rkt") + "unsafe/ops.rkt" + (for-syntax racket/base)) (provide fx->fl fl->fx fxabs diff --git a/collects/racket/flonum.rkt b/collects/racket/flonum.rkt index fef4fa7a3b..a2386c828e 100644 --- a/collects/racket/flonum.rkt +++ b/collects/racket/flonum.rkt @@ -1,7 +1,9 @@ #lang racket/base + (require '#%flfxnum "private/vector-wraps.rkt" - "unsafe/ops.rkt") + "unsafe/ops.rkt" + (for-syntax racket/base)) (provide fl+ fl- fl* fl/ flabs flsqrt flexp fllog diff --git a/collects/racket/private/for.rkt b/collects/racket/private/for.rkt index 467b86af8f..ab74205a50 100644 --- a/collects/racket/private/for.rkt +++ b/collects/racket/private/for.rkt @@ -64,7 +64,10 @@ define-in-vector-like define-:vector-like-gen - (for-syntax make-in-vector-like)) + (for-syntax make-in-vector-like) + + normalise-inputs ;; Only exported to get around certificate problem + ) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; sequence transformers: @@ -480,10 +483,16 @@ ;; Vector-like sequences -------------------------------------------------- - ;; (: check-ranges (Symbol Natural Natural Integer -> Void)) - (define (check-ranges who start stop step) - (unless (exact-nonnegative-integer? start) (raise-type-error who "exact non-negative integer" start)) - (unless (exact-nonnegative-integer? stop) (raise-type-error who "exact non-negative integer or #f" stop)) + ;; (: check-ranges (Symbol Natural Integer Integer Natural -> Void)) + ;; + ;; As no object can have more slots than can be indexed by + ;; the largest fixnum, after running these checks start, + ;; stop, and step are guaranteed to be fixnums. + (define (check-ranges who start stop step len) + (unless (and (exact-nonnegative-integer? start) (< start len)) + (raise-type-error who (format "exact non-negative integer in [0,~a)" len) start)) + (unless (and (integer? stop) (<= -1 stop) (<= stop len)) + (raise-type-error who (format "exact integer in [-1,~a] or #f" len) stop)) (unless (and (exact-integer? step) (not (zero? step))) (raise-type-error who "exact non-zero integer" step)) (when (and (< start stop) (< step 0)) @@ -495,6 +504,20 @@ start stop) step))) + ;; (: normalise-inputs (A) (Symbol String (Any -> Boolean) (A -> Natural) Any Any Any Any -> (values Fixnum Fixnum Fixnum))) + ;; + ;; Checks all inputs are valid for an in-vector sequence, + ;; and if so returns the vector, start, stop, and + ;; step. Start, stop, and step are guaranteed to be Fixnum + (define (normalise-inputs who type-name vector? unsafe-vector-length + vec start stop step) + (unless (vector? vec) + (raise-type-error who type-name vec)) + (let* ([len (unsafe-vector-length vec)] + [stop* (if stop stop len)]) + (check-ranges who start stop* step len) + (values vec start stop* step))) + (define-syntax define-in-vector-like (syntax-rules () [(define-in-vector-like in-vector-name @@ -505,9 +528,9 @@ [(v start) (in-vector-name v start #f 1)] [(v start stop) (in-vector-name v start stop 1)] [(v start stop step) - (unless (vector?-id v) (raise-type-error (quote in-vector-name) type-name-str v)) - (let ([stop (or stop (vector-length-id v))]) - (check-ranges (quote in-vector-name) start stop step) + (let-values (([v start stop step] + (normalise-inputs in-vector-name type-name-str vector?-id vector-length-id + v start stop step))) (make-do-sequence (lambda () (:vector-gen-id v start stop step))))]))])) (define-syntax define-:vector-like-gen @@ -529,12 +552,16 @@ void void))])) - (define-for-syntax (make-in-vector-like vector?-id + (define-for-syntax (make-in-vector-like in-vector-name + type-name-str + vector?-id unsafe-vector-length-id in-vector-id unsafe-vector-ref-id) (define (in-vector-like stx) - (with-syntax ([vector? vector?-id] + (with-syntax ([in-vector-name in-vector-name] + [type-name type-name-str] + [vector? vector?-id] [in-vector in-vector-id] [unsafe-vector-length unsafe-vector-length-id] [unsafe-vector-ref unsafe-vector-ref-id]) @@ -572,24 +599,12 @@ #`[(id) (:do-in ;; Outer bindings - ;; Prevent multiple evaluation - ([(v* stop*) (let ([vec vec-expr] - [stop* stop]) - (if (and (not stop*) (vector? vec)) - (values vec (unsafe-vector-length vec)) - (values vec stop*)))] - [(start*) start] - [(step*) step]) - ;; Outer check - (when (or (not (vector? v*)) - (not (exact-integer? start*)) - (not (exact-integer? stop*)) - (not (exact-integer? step*)) - (zero? step*) - (and (< start* stop*) (< step* 0)) - (and (> start* stop*) (> step* 0))) - ;; Let in-vector report the error - (in-vector v* start* stop* step*)) + ;; start*, stop*, and step* are guaranteed to be exact integers + ([(v* start* stop* step*) + (normalise-inputs (quote in-vector-name) type-name + vector? unsafe-vector-length vec-expr start stop step)]) + ;; Outer check is done by normalise-inputs + #t ;; Loop bindings ([idx start*]) ;; Pos guard @@ -623,7 +638,9 @@ (define-sequence-syntax *in-vector (lambda () #'in-vector) - (make-in-vector-like #'vector? + (make-in-vector-like 'in-vector + "vector" + #'vector? #'unsafe-vector-length #'in-vector #'unsafe-vector-ref)) @@ -636,7 +653,9 @@ (define-sequence-syntax *in-string (lambda () #'in-string) - (make-in-vector-like #'string? + (make-in-vector-like 'in-string + "string" + #'string? #'string-length #'in-string #'string-ref)) @@ -649,7 +668,9 @@ (define-sequence-syntax *in-bytes (lambda () #'in-bytes) - (make-in-vector-like #'bytes? + (make-in-vector-like 'in-bytes + "bytes" + #'bytes? #'bytes-length #'in-bytes #'bytes-ref)) diff --git a/collects/racket/private/vector-wraps.rkt b/collects/racket/private/vector-wraps.rkt index 5ad461aeb1..4e92627b59 100644 --- a/collects/racket/private/vector-wraps.rkt +++ b/collects/racket/private/vector-wraps.rkt @@ -1,4 +1,5 @@ #lang racket/base + (require '#%flfxnum (for-syntax racket/base)) @@ -22,7 +23,9 @@ (define-sequence-syntax in-fXvector (lambda () #'in-fXvector*) - (make-in-vector-like #'fXvector? + (make-in-vector-like 'in-fXvector + fXvector-str + #'fXvector? #'unsafe-fXvector-length #'in-fXvector* #'unsafe-fXvector-ref)) diff --git a/collects/racket/vector.rkt b/collects/racket/vector.rkt index 0262688cd6..be83c92ab3 100644 --- a/collects/racket/vector.rkt +++ b/collects/racket/vector.rkt @@ -208,7 +208,9 @@ (let ([init-min-var (f (unsafe-vector-ref xs 0))]) (unless (real? init-min-var) (raise-type-error name "procedure that returns real numbers" f)) - (let-values ([(min* min-var*) + (if (unsafe-fx= (unsafe-vector-length xs) 1) + (unsafe-vector-ref xs 0) + (let-values ([(min* min-var*) (for/fold ([min (unsafe-vector-ref xs 0)] [min-var init-min-var]) ([e (in-vector xs 1)]) @@ -219,7 +221,7 @@ (cond [(cmp new-min min-var) (values e new-min)] [else (values min min-var)])))]) - min*))) + min*)))) (define (vector-argmin f xs) (mk-min < 'vector-argmin f xs)) (define (vector-argmax f xs) (mk-min > 'vector-argmax f xs)) diff --git a/collects/scribblings/reference/fixnums.scrbl b/collects/scribblings/reference/fixnums.scrbl index 4cd8ec5391..f0aa3e81df 100644 --- a/collects/scribblings/reference/fixnums.scrbl +++ b/collects/scribblings/reference/fixnums.scrbl @@ -157,29 +157,14 @@ elements of @racket[vec] from @racket[start] (inclusive) to @defproc[(in-fxvector [vec fxvector?] [start exact-nonnegative-integer? 0] - [stop (or/c exact-nonnegative-integer? #f) #f] + [stop (or/c exact-integer? #f) #f] [step (and/c exact-integer? (not/c zero?)) 1]) sequence?]{ Returns a sequence equivalent to @racket[vec] when no optional arguments are supplied. The optional arguments @racket[start], @racket[stop], and - @racket[step] are analogous to @racket[in-range], except that a - @racket[#f] value for @racket[stop] is equivalent to - @racket[(vector-length vec)]. That is, the first element in the - sequence is @racket[(vector-ref vec start)], and each successive - element is generated by adding @racket[step] to index of the previous - element. The sequence stops before an index that would be greater or - equal to @racket[end] if @racket[step] is non-negative, or less or - equal to @racket[end] if @racket[step] is negative. - - If @racket[start] is less than @racket[stop] and @racket[step] is - negative, then the @exnraise[exn:fail:contract:mismatch]. Similarly, - if @racket[start] is more than @racket[stop] and @racket[step] is - positive, then the @exnraise[exn:fail:contract:mismatch]. The - @racket[start] and @racket[stop] values are @emph{not} checked against - the size of @racket[vec], so access can fail when an element is - demanded from the sequence. + @racket[step] are as in @racket[in-vector]. An @racket[in-fxvector] application can provide better performance for @tech{fxvector} iteration when it appears directly in a @racket[for] clause. diff --git a/collects/scribblings/reference/flonums.scrbl b/collects/scribblings/reference/flonums.scrbl index 62a7ee1c37..2b11a7dce1 100644 --- a/collects/scribblings/reference/flonums.scrbl +++ b/collects/scribblings/reference/flonums.scrbl @@ -174,31 +174,16 @@ elements of @racket[vec] from @racket[start] (inclusive) to @defproc[(in-flvector [vec flvector?] [start exact-nonnegative-integer? 0] - [stop (or/c exact-nonnegative-integer? #f) #f] + [stop (or/c exact-integer? #f) #f] [step (and/c exact-integer? (not/c zero?)) 1]) sequence?]{ Returns a sequence equivalent to @racket[vec] when no optional arguments are supplied. The optional arguments @racket[start], @racket[stop], and - @racket[step] are analogous to @racket[in-range], except that a - @racket[#f] value for @racket[stop] is equivalent to - @racket[(vector-length vec)]. That is, the first element in the - sequence is @racket[(vector-ref vec start)], and each successive - element is generated by adding @racket[step] to index of the previous - element. The sequence stops before an index that would be greater or - equal to @racket[end] if @racket[step] is non-negative, or less or - equal to @racket[end] if @racket[step] is negative. + @racket[step] are as in @racket[in-vector]. - If @racket[start] is less than @racket[stop] and @racket[step] is - negative, then the @exnraise[exn:fail:contract:mismatch]. Similarly, - if @racket[start] is more than @racket[stop] and @racket[step] is - positive, then the @exnraise[exn:fail:contract:mismatch]. The - @racket[start] and @racket[stop] values are @emph{not} checked against - the size of @racket[vec], so access can fail when an element is - demanded from the sequence. - - An @racket[in-flvector] application can provide better + A @racket[in-flvector] application can provide better performance for @tech{flvector} iteration when it appears directly in a @racket[for] clause. } diff --git a/collects/scribblings/reference/sequences.scrbl b/collects/scribblings/reference/sequences.scrbl index ea3e75844e..741ba35db1 100644 --- a/collects/scribblings/reference/sequences.scrbl +++ b/collects/scribblings/reference/sequences.scrbl @@ -96,7 +96,7 @@ in the sequence. @defproc[(in-vector [vec vector?] [start exact-nonnegative-integer? 0] - [stop (or/c exact-nonnegative-integer? #f) #f] + [stop (or/c exact-integer? #f) #f] [step (and/c exact-integer? (not/c zero?)) 1]) sequence?]{ Returns a sequence equivalent to @scheme[vec] when no optional @@ -114,19 +114,18 @@ in the sequence. equal to @scheme[end] if @scheme[step] is non-negative, or less or equal to @scheme[end] if @scheme[step] is negative. + If @racket[start] is not a valid index, or @racket[stop] + is not in [-1, @racket[(vector-length vec)]] then the @exnraise[exn:fail:contract]. If @scheme[start] is less than @scheme[stop] and @scheme[step] is negative, then the @exnraise[exn:fail:contract:mismatch]. Similarly, if @scheme[start] is more than @scheme[stop] and @scheme[step] is - positive, then the @exnraise[exn:fail:contract:mismatch]. The - @scheme[start] and @scheme[stop] values are @emph{not} checked against - the size of @scheme[vec], so access can fail when an element is - demanded from the sequence. + positive, then the @exnraise[exn:fail:contract:mismatch]. @speed[in-vector "vector"]} @defproc[(in-string [str string?] [start exact-nonnegative-integer? 0] - [stop (or/c exact-nonnegative-integer? #f) #f] + [stop (or/c exact-integer? #f) #f] [step (and/c exact-integer? (not/c zero?)) 1]) sequence?]{ Returns a sequence equivalent to @scheme[str] when no optional @@ -141,7 +140,7 @@ in the sequence. @defproc[(in-bytes [bstr bytes?] [start exact-nonnegative-integer? 0] - [stop (or/c exact-nonnegative-integer? #f) #f] + [stop (or/c exact-integer? #f) #f] [step (and/c exact-integer? (not/c zero?)) 1]) sequence?]{ Returns a sequence equivalent to @scheme[bstr] when no optional diff --git a/collects/tests/racket/for.rktl b/collects/tests/racket/for.rktl index 031f5c2ab2..6228df7bd4 100644 --- a/collects/tests/racket/for.rktl +++ b/collects/tests/racket/for.rktl @@ -24,6 +24,10 @@ (test-generator [(h f d)] (in-vector #(a b c d e f g h) 7 1 -2)) (test-generator [(b d f)] (in-vector #(a b c d e f g h) 1 6 2)) (test-generator [(h f d)] (in-vector #(a b c d e f g h) 7 2 -2)) +(test-generator [(c b a)] (in-vector #(a b c) 2 -1 -1)) +;; Test indices out of bounds +(err/rt-test (for/list ([x (in-vector #(a b c d) 0 6 2)]) x) exn:fail:contract?) +(err/rt-test (for/list ([x (in-vector #(a b c d) 6 0 -2)]) x) exn:fail:contract?) (test-generator [(#\a #\b #\c)] "abc") (test-generator [(#\a #\u3bb #\c)] "a\u03BBc") (test-generator [(#\a #\b #\c)] (in-string "abc"))