suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

added in-sequences and in-cycle

Browse Source 
svn: r14424
This commit is contained in:
Eli Barzilay 2009-04-05 08:29:17 +00:00
parent 9af9210aa2
commit 06636c1813
3 changed files with 67 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
collects/scheme/private/for.ss
View File

@ -38,6 +38,8 @@
in-hash-values
in-hash-pairs
in-sequences
in-cycle
in-parallel
stop-before
stop-after
@ -604,11 +606,42 @@
;; ----------------------------------------
(define (in-parallel . sequences)
(define (append-sequences sequences cyclic?)
(define (seqs->m+g+r seqs)
(if (pair? seqs)
(let-values ([(more? get) (sequence-generate (car seqs))]
[(seqs) (cdr seqs)])
(if (more?) (list* more? get seqs) (seqs->m+g+r seqs)))
(and cyclic? (seqs->m+g+r sequences))))
(make-do-sequence
(lambda ()
;; place is (cur-more? cur-get rest-seqs ...) or #f
(values (lambda (m+g+r) ((cadr m+g+r)))
(lambda (m+g+r)
(if (and (pair? m+g+r) (not ((car m+g+r))))
(seqs->m+g+r (cddr m+g+r))
m+g+r))
(seqs->m+g+r sequences)
(lambda (p) p)
(lambda _ #t)
(lambda _ #t)))))
(define (check-sequences who sequences)
(for-each (lambda (g)
(unless (sequence? g)
(raise-type-error 'in-parallel "sequence" g)))
sequences)
(unless (sequence? g) (raise-type-error who "sequence" g)))
sequences))
(define (in-sequences sequence . sequences)
(let ([all (cons sequence sequences)])
(check-sequences 'in-sequences all)
(if (null? sequences) sequence (append-sequences all #f))))
(define (in-cycle sequence . sequences)
(let ([all (cons sequence sequences)])
(check-sequences 'in-cycle sequences)
(append-sequences all #t)))
(define (in-parallel . sequences)
(check-sequences 'in-parallel sequences)
(if (= 1 (length sequences))
(car sequences)
(make-do-sequence

12
collects/scribblings/reference/sequences.scrbl
View File

@ -176,10 +176,20 @@ where each element has two values: the value produced by @scheme[seq],
and a non-negative exact integer starting with @scheme[0]. The
elements of @scheme[seq] must be single-valued.}
@defproc[(in-sequences [seq sequence?] ...) sequence?]{Returns a
sequence that is made of all input sequences, one after the other. The
elements of each @scheme[seq] must all have the same number of
values.}
@defproc[(in-cycle [seq sequence?] ...) sequence?]{Similar to
@scheme[in-sequences], but the sequences are repeated in an infinite
cycle.}
@defproc[(in-parallel [seq sequence?] ...) sequence?]{Returns a
sequence where each element has as many values as the number of
supplied @scheme[seq]s; the values, in order, are the values of each
@scheme[seq]. The elements of each @scheme[seq] must be single-valued.}
@scheme[seq]. The elements of each @scheme[seq] must be
single-valued.}
@defproc[(stop-before [seq sequence?] [pred (any/c . -> . any)])
sequence?]{ Returns a sequence that contains the elements of

19
collects/tests/mzscheme/for.ss
View File

@ -129,6 +129,25 @@
(test-generator [(65 66 67)] (open-input-bytes #"ABC"))
(test-generator [(65 66 67)] (in-input-port-bytes (open-input-bytes #"ABC")))
(test-generator [(0 1 2 3 4 5)] (in-sequences (in-range 6)))
(test-generator [(0 1 2 3 4 5)] (in-sequences (in-range 4) '(4 5)))
(test-generator [(0 1 2 3 4 5)] (in-sequences (in-range 6) '()))
(test-generator [(0 1 2 3 4 5)] (in-sequences '() (in-range 4) '() '(4 5)))
(test-generator [(0 1 2 3 4 5)] (in-sequences (in-range 0 2) (in-range 2 4) (in-range 4 6)))
(test-generator [(0 1 2 3 4 5)] (in-sequences (in-range 0 2)
(in-sequences (in-range 2 4) (in-range 4 6))))
(test-generator [(0 1 2 3 #\a #\b #\c) (10 11 12 13 #\A #\B #\C)]
(in-sequences (in-parallel (in-range 0 4) (in-range 10 14))
(in-parallel "abc" "ABC")))
;; use in-parallel to get a finite number of items
(test-generator [(0 1 2 3 0 1 2 3) (0 1 2 3 4 5 6 7)]
(in-parallel (in-cycle (in-range 0 4)) (in-range 0 8)))
(test-generator [(0 1 2 3 4 5 6 7) (0 1 2 0 1 2 0 1)]
(in-parallel (in-range 0 8) (in-cycle (in-range 0 3))))
(test-generator [(0 1 2 3 2 1 0 1) (0 1 2 3 4 5 6 7)]
(in-parallel (in-cycle (in-range 0 4) (in-range 2 0 -1)) (in-range 0 8)))
(test-generator [(0 1 2) (a b c)] (in-parallel (in-range 3) (in-list '(a b c))))
(test-generator [(0 1 2) (a b c)] (in-parallel (in-range 10) (in-list '(a b c))))
(test-generator [(0 1 2) (a b c)] (in-parallel (in-range 3) (in-list '(a b c d))))