clean up extended in-vector, in-string, and in-bytes
svn: r11124
This commit is contained in:
Matthew Flatt
parent
e2cfa7d9a9
commit
d0419345d8
|
|
@ -1,5 +1,5 @@
|
|||
(module errortrace-key mzscheme
|
||||
(define errortrace-key (gensym 'key))
|
||||
(module errortrace-key '#%kernel
|
||||
(define-values (errortrace-key) (gensym 'key))
|
||||
|
||||
(provide errortrace-key))
|
||||
(#%provide errortrace-key))
|
||||
|
||||
|
|
|
|||
|
|
@ -326,9 +326,9 @@
|
|||
(cond
|
||||
[(do-sequence? v) ((do-sequence-ref v 0))]
|
||||
[(list? v) (:list-gen v)]
|
||||
[(vector? v) (:vector-gen v)]
|
||||
[(string? v) (:string-gen v)]
|
||||
[(bytes? v) (:bytes-gen v)]
|
||||
[(vector? v) (:vector-gen v 0 (vector-length v) 1)]
|
||||
[(string? v) (:string-gen v 0 (string-length v) 1)]
|
||||
[(bytes? v) (:bytes-gen v 0 (bytes-length v) 1)]
|
||||
[(input-port? v) (:input-port-gen v)]
|
||||
[(hash? v) (:hash-key+val-gen v)]
|
||||
[(:sequence? v) (make-sequence who ((:sequence-ref v) v))]
|
||||
|
|
@ -385,25 +385,33 @@
|
|||
(define (:list-gen l)
|
||||
(values car cdr l pair? (lambda (x) #t) (lambda (p x) #t)))
|
||||
|
||||
|
||||
(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))
|
||||
(unless (and (exact-integer? step) (not (zero? step)))
|
||||
(raise-type-error who "exact non-zero integer" step))
|
||||
(when (and (< start stop) (< step 0))
|
||||
(raise-mismatch-error who (format "start: ~a less than stop: ~a but given negative step: "
|
||||
start stop)
|
||||
step))
|
||||
(when (and (< stop start) (> step 0))
|
||||
(raise-mismatch-error who (format "start: ~a more than stop: ~a but given positive step: "
|
||||
start stop)
|
||||
step)))
|
||||
|
||||
(define in-vector
|
||||
(case-lambda
|
||||
[(v) (in-vector v 0 (vector-length v) 1)]
|
||||
[(v start) (in-vector v start (vector-length v) 1)]
|
||||
[(v) (in-vector v 0 #f 1)]
|
||||
[(v start) (in-vector v start #f 1)]
|
||||
[(v start stop) (in-vector v start stop 1)]
|
||||
[(v start stop step)
|
||||
(unless (vector? v) (raise-type-error 'in-vector "vector" v))
|
||||
(when (and (< start stop) (< step 0))
|
||||
(raise-mismatch-error 'in-vector "start is less than stop but step is negative" (list start stop step)))
|
||||
(when (and (< stop start) (> step 0))
|
||||
(raise-mismatch-error 'in-vector "stop is less than start but step is positive" (list start stop step)))
|
||||
(when (zero? step)
|
||||
(raise-mismatch-error 'in-vector "step is zero" step))
|
||||
(make-do-sequence (lambda () (:vector-gen v start stop step)))]))
|
||||
(let ([stop (or stop (vector-length v))])
|
||||
(check-ranges 'in-vector start stop step)
|
||||
(make-do-sequence (lambda () (:vector-gen v start stop step))))]))
|
||||
|
||||
(define :vector-gen
|
||||
(case-lambda
|
||||
[(v) (:vector-gen v 0 (vector-length v) 1)]
|
||||
[(v start stop step)
|
||||
(define (:vector-gen v start stop step)
|
||||
(values
|
||||
;; pos->element
|
||||
(lambda (i) (vector-ref v i))
|
||||
|
|
@ -417,35 +425,47 @@
|
|||
(lambda (i) (< i stop))
|
||||
(lambda (i) (> i stop)))
|
||||
(lambda (x) #t)
|
||||
(lambda (x y) #t))]))
|
||||
(lambda (x y) #t)))
|
||||
|
||||
(define (in-string l)
|
||||
(define in-string
|
||||
(case-lambda
|
||||
[(l) (in-string l 0 #f 1)]
|
||||
[(l start) (in-string l start #f 1)]
|
||||
[(l start stop) (in-string l start stop 1)]
|
||||
[(l start stop step)
|
||||
(unless (string? l) (raise-type-error 'in-string "string" l))
|
||||
(make-do-sequence (lambda () (:string-gen l))))
|
||||
(let ([stop (or stop (string-length l))])
|
||||
(check-ranges 'in-string start stop step)
|
||||
(make-do-sequence (lambda () (:string-gen l start stop step))))]))
|
||||
|
||||
(define (:string-gen v)
|
||||
(let ([len (string-length v)])
|
||||
(define (:string-gen v start stop step)
|
||||
(values (lambda (i)
|
||||
(string-ref v i))
|
||||
add1
|
||||
0
|
||||
(lambda (i) (< i len))
|
||||
(if (= step 1) add1 (lambda (x) (+ x step)))
|
||||
start
|
||||
(lambda (i) (< i stop))
|
||||
(lambda (x) #t)
|
||||
(lambda (x y) #t))))
|
||||
(lambda (x y) #t)))
|
||||
|
||||
(define (in-bytes l)
|
||||
(define in-bytes
|
||||
(case-lambda
|
||||
[(l) (in-bytes l 0 #f 1)]
|
||||
[(l start) (in-bytes l start #f 1)]
|
||||
[(l start stop) (in-bytes l start stop 1)]
|
||||
[(l start stop step)
|
||||
(unless (bytes? l) (raise-type-error 'in-bytes "bytes" l))
|
||||
(make-do-sequence (lambda () (:bytes-gen l))))
|
||||
(let ([stop (or stop (bytes-length l))])
|
||||
(check-ranges 'in-bytes start stop step)
|
||||
(make-do-sequence (lambda () (:bytes-gen l start stop step))))]))
|
||||
|
||||
(define (:bytes-gen v)
|
||||
(let ([len (bytes-length v)])
|
||||
(define (:bytes-gen v start stop step)
|
||||
(values (lambda (i)
|
||||
(bytes-ref v i))
|
||||
add1
|
||||
0
|
||||
(lambda (i) (< i len))
|
||||
(if (= step 1) add1 (lambda (x) (+ x step)))
|
||||
start
|
||||
(lambda (i) (< i stop))
|
||||
(lambda (x) #t)
|
||||
(lambda (x y) #t))))
|
||||
(lambda (x y) #t)))
|
||||
|
||||
(define (in-input-port-bytes l)
|
||||
(unless (input-port? l) (raise-type-error 'in-input-port-bytes "input-port" l))
|
||||
|
|
@ -1031,21 +1051,21 @@
|
|||
;; Prevent multiple evaluation
|
||||
([(v* stop*) (let ([vec vec-expr]
|
||||
[stop* stop])
|
||||
(if stop*
|
||||
(values vec stop*)
|
||||
(values vec (vector-length vec))))]
|
||||
(if (and (not stop*) (vector? vec))
|
||||
(values vec (vector-length vec))
|
||||
(values vec stop*)))]
|
||||
[(start*) start]
|
||||
[(step*) step])
|
||||
;; Outer check
|
||||
(when (or (zero? step*)
|
||||
(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)))
|
||||
(if (vector? v*)
|
||||
(and (> start* stop*) (> step* 0)))
|
||||
;; Let in-vector report the error
|
||||
(in-vector v* start* stop* step*)
|
||||
(raise-type-error in-vector
|
||||
"start, stop, and step incompatible"
|
||||
(list start* stop* step*))))
|
||||
(in-vector v* start* stop* step*))
|
||||
;; Loop bindings
|
||||
([idx start*])
|
||||
;; Pos guard
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@
|
|||
@(define-syntax speed
|
||||
(syntax-rules ()
|
||||
[(_ id what)
|
||||
@t{A @scheme[id] application can provide better performance for
|
||||
@t{An @scheme[id] application can provide better performance for
|
||||
@elem[what]
|
||||
iteration when it appears directly in a @scheme[for] clause.}]))
|
||||
|
||||
|
|
@ -79,25 +79,59 @@ element. @speed[in-naturals "integer"]}
|
|||
Returns a sequence equivalent to @scheme[lst].
|
||||
@speed[in-list "list"]}
|
||||
|
||||
@defproc[(in-vector [vec vector?] [start number?] [stop number?] [step number?]) sequence?]{
|
||||
Returns a sequence equivalent to @scheme[vec]. The optional
|
||||
arguments @scheme[start], @scheme[stop], and @scheme[step]
|
||||
are as for @scheme[in-range]. The single-argument case
|
||||
@scheme[(in-vector vec)] is equivalent to @scheme[(in-vector 0
|
||||
(vector-length vec) 1)]. The first number in the sequence is
|
||||
@scheme[start], and each successive element is generated by
|
||||
adding @scheme[step] to the previous element. The sequence
|
||||
stops before an element that would be greater or equal to
|
||||
@scheme[end] if @scheme[step] is non-negative, or less or
|
||||
@defproc[(in-vector [vec vector?]
|
||||
[start exact-nonnegative-integer? 0]
|
||||
[stop (or/c exact-nonnegative-integer? false/c) #f]
|
||||
[step (and/c exact-integer? (not/c zero?)) 1])
|
||||
sequence?]{
|
||||
|
||||
Returns a sequence equivalent to @scheme[vec] when no optional
|
||||
arguments are supplied.
|
||||
|
||||
The optional arguments @scheme[start], @scheme[stop], and
|
||||
@scheme[step] are analogous to @scheme[in-range], except that a
|
||||
@scheme[#f] value for @scheme[stop] is equivalent to
|
||||
@scheme[(vector-length vec)]. That is, the first element in the
|
||||
sequence is @scheme[(vector-ref vec start)], and each successive
|
||||
element is generated by adding @scheme[step] to index of the previous
|
||||
element. The sequence stops before an index that would be greater or
|
||||
equal to @scheme[end] if @scheme[step] is non-negative, or less or
|
||||
equal to @scheme[end] if @scheme[step] is negative.
|
||||
|
||||
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.
|
||||
|
||||
@speed[in-vector "vector"]}
|
||||
|
||||
@defproc[(in-string [str string?]) sequence?]{
|
||||
Returns a sequence equivalent to @scheme[str].
|
||||
@defproc[(in-string [str string?]
|
||||
[start exact-nonnegative-integer? 0]
|
||||
[stop (or/c exact-nonnegative-integer? false/c) #f]
|
||||
[step (and/c exact-integer? (not/c zero?)) 1])
|
||||
sequence?]{
|
||||
Returns a sequence equivalent to @scheme[str] when no optional
|
||||
arguments are supplied.
|
||||
|
||||
The optional arguments @scheme[start], @scheme[stop], and
|
||||
@scheme[step] are as in @scheme[in-vector].
|
||||
|
||||
@speed[in-string "string"]}
|
||||
|
||||
@defproc[(in-bytes [bstr bytes?]) sequence?]{
|
||||
Returns a sequence equivalent to @scheme[bstr].
|
||||
@defproc[(in-bytes [bstr bytes?]
|
||||
[start exact-nonnegative-integer? 0]
|
||||
[stop (or/c exact-nonnegative-integer? false/c) #f]
|
||||
[step (and/c exact-integer? (not/c zero?)) 1])
|
||||
sequence?]{
|
||||
Returns a sequence equivalent to @scheme[bstr] when no optional
|
||||
arguments are supplied.
|
||||
|
||||
The optional arguments @scheme[start], @scheme[stop], and
|
||||
@scheme[step] are as in @scheme[in-vector].
|
||||
|
||||
@speed[in-bytes "byte string"]}
|
||||
|
||||
@defproc[(in-input-port-bytes [in input-port?]) sequence?]{
|
||||
|
|
|
|||
|
|
@ -113,8 +113,18 @@
|
|||
(test-generator [(h f d)] (in-vector #(a b c d e f g h) 7 2 -2))
|
||||
(test-generator [(#\a #\b #\c)] "abc")
|
||||
(test-generator [(#\a #\b #\c)] (in-string "abc"))
|
||||
(test-generator [(#\a #\b #\c)] (in-string "zzabc" 2))
|
||||
(test-generator [(#\a #\b #\c)] (in-string "zzabc" 2 #f))
|
||||
(test-generator [(#\a #\b #\c)] (in-string "zzabcqq" 2 5))
|
||||
(test-generator [(#\a #\b #\c)] (in-string "zzaxbyc" 2 #f 2))
|
||||
(test-generator [(#\a #\b #\c)] (in-string "zzaxbycy" 2 #f 2))
|
||||
(test-generator [(65 66 67)] #"ABC")
|
||||
(test-generator [(65 66 67)] (in-bytes #"ABC"))
|
||||
(test-generator [(65 66 67)] (in-bytes #"ZZABC" 2))
|
||||
(test-generator [(65 66 67)] (in-bytes #"ZZABC" 2 #f))
|
||||
(test-generator [(65 66 67)] (in-bytes #"ZZABCQQ" 2 5))
|
||||
(test-generator [(65 66 67)] (in-bytes #"ZZAXBYC" 2 #f 2))
|
||||
(test-generator [(65 66 67)] (in-bytes #"ZZAXBYCY" 2 #f 2))
|
||||
(test-generator [(#\a #\b #\c)] (in-input-port-chars (open-input-string "abc")))
|
||||
(test-generator [(65 66 67)] (open-input-bytes #"ABC"))
|
||||
(test-generator [(65 66 67)] (in-input-port-bytes (open-input-bytes #"ABC")))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user