diff --git a/collects/racket/private/for.rkt b/collects/racket/private/for.rkt index 6d61b18c32..72e429b278 100644 --- a/collects/racket/private/for.rkt +++ b/collects/racket/private/for.rkt @@ -278,10 +278,10 @@ (#,((syntax-local-certifier #f) #'make-sequence) '(id ...) rhs)]) (void) ([pos init]) - (pos-cont? pos) + (if pos-cont? (pos-cont? pos) #t) ([(id ...) (pos->vals pos)]) - (val-cont? id ...) - (all-cont? pos id ...) + (if val-cont? (val-cont? id ...) #t) + (if all-cont? (all-cont? pos id ...) #t) ((pos-next pos)))))))] [_ (raise-syntax-error #f @@ -392,13 +392,13 @@ (make-do-sequence (lambda () (:list-gen l)))) (define (:list-gen l) - (values car cdr l pair? void void)) + (values car cdr l pair? #f #f)) (define (in-mlist l) (make-do-sequence (lambda () (:mlist-gen l)))) (define (:mlist-gen l) - (values mcar mcdr l mpair? void void)) + (values mcar mcdr l mpair? #f #f)) (define (in-input-port-bytes p) (unless (input-port? p) @@ -406,9 +406,9 @@ (make-do-sequence (lambda () (:input-port-gen p)))) (define (:input-port-gen p) - (values read-byte values p void + (values read-byte values p #f (lambda (x) (not (eof-object? x))) - void)) + #f)) (define (in-input-port-chars p) (unless (input-port? p) @@ -478,8 +478,8 @@ (lambda (pos) (hash-iterate-next ht pos)) (hash-iterate-first ht) (lambda (pos) pos) ; #f position means stop - void - void)) + #f + #f)) ;; Vector-like sequences -------------------------------------------------- @@ -549,8 +549,8 @@ (if (> step 0) (lambda (i) (< i stop)) (lambda (i) (> i stop))) - void - void))])) + #f + #f))])) (define-for-syntax (make-in-vector-like in-vector-name type-name-str @@ -692,9 +692,9 @@ init pos-cont? (case-lambda - [(val) (and (pre-cont? val) + [(val) (and (if pre-cont? (pre-cont? val) #t) (not (pred val)))] - [vals (and (apply pre-cont? vals) + [vals (and (if pre-cont? (apply pre-cont? vals) #t) (not (apply pred vals)))]) post-cont?))))) @@ -712,9 +712,9 @@ pos-cont? pre-cont? (case-lambda - [(pos val) (and (post-cont? pos val) + [(pos val) (and (if post-cont? (post-cont? pos val) #t) (not (pred val)))] - [(pos . vals) (and (apply pos-cont? pos vals) + [(pos . vals) (and (if post-cont? (apply post-cont? pos vals) #t) (not (apply pred vals)))])))))) (define (in-indexed g) @@ -725,9 +725,12 @@ (values (lambda (pos) (values (pos->val (car pos)) (cdr pos))) (lambda (pos) (cons (pos-next (car pos)) (add1 (cdr pos)))) (cons init 0) - (lambda (pos) (pos-cont? (car pos))) - (lambda (val idx) (pre-cont? val)) - (lambda (pos val idx) (post-cont? pos val))))))) + (and pos-cont? + (lambda (pos) (pos-cont? (car pos)))) + (and pre-cont? + (lambda (val idx) (pre-cont? val))) + (and post-cont? + (lambda (pos val idx) (post-cont? pos val)))))))) (define (in-value v) (make-do-sequence (lambda () @@ -791,16 +794,22 @@ pos-nexts poses)) inits - (lambda (poses) (andmap (lambda (pos-cont? pos) (pos-cont? pos)) - pos-cont?s - poses)) - (lambda vals (andmap (lambda (pre-cont? val) (pre-cont? val)) - pre-cont?s - vals)) - (lambda (poses . vals) (andmap (lambda (post-cont? pos val) (post-cont? pos val)) - post-cont?s - poses - vals)))))))) + (and (ormap values pos-cont?s) + (lambda (poses) (andmap (lambda (pos-cont? pos) + (if pos-cont? (pos-cont? pos) #t)) + pos-cont?s + poses))) + (and (ormap values pre-cont?s) + (lambda vals (andmap (lambda (pre-cont? val) + (if pre-cont? (pre-cont? val) #t)) + pre-cont?s + vals))) + (and (ormap values post-cont?s) + (lambda (poses . vals) (andmap (lambda (post-cont? pos val) + (if post-cont? (post-cont? pos val) #t)) + post-cont?s + poses + vals))))))))) (define (in-producer producer stop . more) (make-do-sequence @@ -810,13 +819,13 @@ (lambda (_) (apply producer more))) void (void) - void + #f (if (procedure? stop) (if (equal? 1 (procedure-arity stop)) (lambda (x) (not (stop x))) (lambda xs (not (apply stop xs)))) (lambda (x) (not (eq? x stop)))) - void)))) + #f)))) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; running sequences outside of a loop: @@ -838,11 +847,11 @@ (lambda () (prep-val!) (next))] [init-prep-val! (lambda () - (if (pos-cont? pos) + (if (if pos-cont? (pos-cont? pos) #t) (call-with-values (lambda () (pos->val pos)) (lambda vals - (if (apply pre-cont? vals) + (if (if pre-cont? (apply pre-cont? vals) #t) (begin (set! more? (lambda () #t)) (set! next @@ -850,7 +859,9 @@ (let ([v vals]) (set! prep-val! (lambda () - (if (apply post-cont? pos vals) + (if (if post-cont? + (apply post-cont? pos vals) + #t) (begin (set! pos (pos-next pos)) (set! prep-val! init-prep-val!) diff --git a/collects/scribblings/reference/sequences.scrbl b/collects/scribblings/reference/sequences.scrbl index 263ee7dfde..62c728ce25 100644 --- a/collects/scribblings/reference/sequences.scrbl +++ b/collects/scribblings/reference/sequences.scrbl @@ -290,9 +290,9 @@ in the sequence. @defproc[(make-do-sequence [thunk (-> (values (any/c . -> . any) (any/c . -> . any/c) any/c - (any/c . -> . any/c) - (() () #:rest list? . ->* . any/c) - ((any/c) () #:rest list? . ->* . any/c)))]) + (or/c (any/c . -> . any/c) #f) + (or/c (() () #:rest list? . ->* . any/c) #f) + (or/c ((any/c) () #:rest list? . ->* . any/c) #f)))]) sequence?]{ Returns a sequence whose elements are generated by the procedures and initial value returned by the thunk. The sequence is defined in terms @@ -308,22 +308,33 @@ in the sequence. @item{The second result is a @scheme[_next-pos] procedure that takes the current position and returns the next position.} @item{The third result is the initial position.} - @item{The fourth result takes the current position and returns a + @item{The fourth result is a @racket[_continue-with-val?] function that + takes the current position and returns a true result if the sequence includes the value(s) for the current position, and false if the sequence should end instead of - including the value(s).} - @item{The fifth result is like the fourth result, but it takes the - current element value(s) instead of the current position.} - @item{The sixth result is like the fourth result, but it takes both + including the value(s). Alternatively, the fourth result can be + @racket[#f] to indicate that the sequence should always include the + current value(s).} + @item{The fifth result is a @racket[_continue-with-pos?] function that is + like the fourth result, but it takes the + current element value(s) instead of the current position. + Alternatively, the fifth result can be + @racket[#f] to indicate that the sequence should always include the + value(s) at the current position.} + @item{The sixth result is a @racket[_continue-after-pos+val?] procedure + that takes both the current position and the current element value(s) and - determines a sequence end after the current element is already - included in the sequence.}] + determines whether the sequence ends after the current element is already + included in the sequence. + Alternatively, the sixth result can be + @racket[#f] to indicate that the sequence can always continue + after the current value(s).}] Each of the procedures listed above is called only once per position. Among the last three procedures, as soon as one of the procedures returns @scheme[#f], the sequence ends, and none are called again. - Typically, one of the functions determines the end condition, and the - other two functions always return @scheme[#t].} + Typically, one of the functions determines the end condition, and + @scheme[#f] is used in place of the other two functions.} @defthing[prop:sequence struct-type-property?]{ diff --git a/collects/tests/racket/for.rktl b/collects/tests/racket/for.rktl index a61df81ccd..ca798fca09 100644 --- a/collects/tests/racket/for.rktl +++ b/collects/tests/racket/for.rktl @@ -98,6 +98,53 @@ (open-input-string "1 2 3\n4 5"))]) (list i j))) +(let ([five-seq + (lambda (pos pre post) + (test-sequence [(1 2 3 4 5)] + (make-do-sequence (lambda () + (values add1 + add1 + 0 + pos + pre + post)))))]) + (five-seq (lambda (pos) (pos . < . 5)) + #f + #f) + (five-seq #f + (lambda (val) (val . < . 6)) + #f) + (five-seq #f + #f + (lambda (pos val) (val . < . 5)))) + +(let ([fives-seq + (lambda (pos pre post) + (test-sequence [(1 2 3 4 5) ("0" "1" "2" "3" "4")] + (make-do-sequence (lambda () + (values (lambda (n) (values (add1 n) + (number->string n))) + add1 + 0 + pos + pre + post)))))]) + (fives-seq (lambda (pos) (pos . < . 5)) + #f + #f) + (fives-seq #f + (lambda (val1 val2) (val1 . < . 6)) + #f) + (fives-seq #f + (lambda (val1 val2) (not (string=? val2 "5"))) + #f) + (fives-seq #f + #f + (lambda (pos val1 val2) (val1 . < . 5))) + (fives-seq #f + #f + (lambda (pos val1 val2) (not (string=? val2 "4"))))) + ;; Basic sanity checks. (test '#(1 2 3 4) 'for/vector (for/vector ((i (in-range 4))) (+ i 1))) (test '#(1 2 3 4) 'for/vector-fast (for/vector #:length 4 ((i (in-range 4))) (+ i 1)))