clean up extended in-vector, in-string, and in-bytes

svn: r11124

collects/errortrace/errortrace-key.ss

@@ -1,5 +1,5 @@
-(module errortrace-key mzscheme
+(module errortrace-key '#%kernel
-  (define errortrace-key (gensym 'key))
+  (define-values (errortrace-key) (gensym 'key))
   
-  (provide errortrace-key))
+  (#%provide errortrace-key))
 

collects/scheme/private/for.ss

@@ -326,9 +326,9 @@
     (cond
       [(do-sequence? v) ((do-sequence-ref v 0))]
       [(list? v) (:list-gen v)]
-      [(vector? v) (:vector-gen v)]
+      [(vector? v) (:vector-gen v 0 (vector-length v) 1)]
-      [(string? v) (:string-gen v)]
+      [(string? v) (:string-gen v 0 (string-length v) 1)]
-      [(bytes? v) (:bytes-gen v)]
+      [(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) (in-vector v 0 #f 1)]
-     [(v start) (in-vector v start (vector-length v) 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))
+      (let ([stop (or stop (vector-length v))])
-        (raise-mismatch-error 'in-vector "start is less than stop but step is negative" (list start stop step)))
+        (check-ranges 'in-vector start stop step)
-      (when (and (< stop start) (> step 0))
+        (make-do-sequence (lambda () (:vector-gen v start stop step))))]))
-        (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)))]))
 
-  (define :vector-gen
+  (define (:vector-gen v start stop step)
-    (case-lambda 
-      [(v) (:vector-gen v 0 (vector-length v) 1)]
-      [(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)
+  (define (:string-gen v start stop step)
-    (let ([len (string-length v)])
     (values (lambda (i)
               (string-ref v i))
-              add1
+            (if (= step 1) add1 (lambda (x) (+ x step)))
-              0
+            start
-              (lambda (i) (< i len))
+            (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)
+  (define (:bytes-gen v start stop step)
-    (let ([len (bytes-length v)])
     (values (lambda (i)
               (bytes-ref v i))
-              add1
+            (if (= step 1) add1 (lambda (x) (+ x step)))
-              0
+            start
-              (lambda (i) (< i len))
+            (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*
+                               (if (and (not stop*) (vector? vec))
-                                   (values vec stop*)
+                                   (values vec (vector-length 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)))
+                          (and (> start* stop*) (> step* 0)))
-                  (if (vector? v*)
                   ;; Let in-vector report the error
-                      (in-vector v* start* stop* step*)
+                  (in-vector v* start* stop* step*))
-                      (raise-type-error in-vector
-                                        "start, stop, and step incompatible"
-                                        (list start* stop* step*))))
                 ;; Loop bindings
                 ([idx start*])
                 ;; Pos guard

collects/scribblings/reference/sequences.scrbl

@@ -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?]{
+@defproc[(in-vector [vec vector?]
-Returns a sequence equivalent to @scheme[vec].  The optional
+                    [start exact-nonnegative-integer? 0] 
-arguments @scheme[start], @scheme[stop], and @scheme[step]
+                    [stop (or/c exact-nonnegative-integer? false/c) #f] 
-are as for @scheme[in-range]. The single-argument case
+                    [step (and/c exact-integer? (not/c zero?)) 1]) 
-@scheme[(in-vector vec)] is equivalent to @scheme[(in-vector 0
+         sequence?]{
-(vector-length vec) 1)].  The first number in the sequence is
+
-@scheme[start], and each successive element is generated by
+Returns a sequence equivalent to @scheme[vec] when no optional
-adding @scheme[step] to the previous element. The sequence
+arguments are supplied.
-stops before an element that would be greater or equal to
+
-@scheme[end] if @scheme[step] is non-negative, or less or
+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?]{
+@defproc[(in-string [str string?]
-Returns a sequence equivalent to @scheme[str].
+                    [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?]{
+@defproc[(in-bytes [bstr bytes?]
-Returns a sequence equivalent to @scheme[bstr].
+                   [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?]{

collects/tests/mzscheme/for.ss

@@ -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")))