Fix some errors with in-vector and derived forms:
- Range checking was inconsistent between the sequence and macro forms - The macro form could crash due to unsafe vector refs Fixes involved refactoring the range checks so they are shared between both versions, and changing the contract slightly so start and stop are checked before the sequence runs. This allows unsafe vector refs and earlier error notifications at the cost making some valid programs (e.g. those using some condition to stop a comprehension hitting an invalid index) now be invalid. Only crazy people would rely on the old behaviour, so it isn't a problem in practice.
This commit is contained in:
Noel Welsh
parent
7ec0731cda
commit
cfa7b727f4
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -208,6 +208,8 @@
|
|||
(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))
|
||||
(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])
|
||||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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"))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user