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

racket/sequence repairs

Browse Source 
including addition of `sequence-generate*'
This commit is contained in:
Matthew Flatt 2011-03-27 10:02:11 -06:00
parent d81ace1031
commit 84d8bb3726
4 changed files with 218 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
collects/racket/private/for.rkt
View File

@ -67,6 +67,7 @@
sequence?
sequence-generate
sequence-generate*
prop:sequence
define-sequence-syntax
@ -1068,6 +1069,11 @@
next))))))
(gen-stream init))]))
(define (no-more)
(raise (exn:fail:contract "sequence has no more values"
(current-continuation-marks))))
(define (sequence-generate g)
(unless (sequence? g)
(raise-type-error 'sequence-generate "sequence" g))
@ -1077,9 +1083,7 @@
(letrec ([more? #f]
[prep-val! #f]
[next #f])
(letrec ([no-more (lambda ()
(error "sequence has no more values"))]
[init-more?
(letrec ([init-more?
(lambda () (prep-val!) (more?))]
[init-next
(lambda () (prep-val!) (next))]
@ -1126,6 +1130,29 @@
(values sequence-more?
sequence-next)))))))
(define (sequence-generate* g)
(unless (sequence? g)
(raise-type-error 'sequence-generate* "sequence" g))
(let-values ([(pos->val pos-next init pos-cont? pre-cont? post-cont?)
(make-sequence #f g)])
(letrec ([next!
(lambda (pos)
(if (if pos-cont? (pos-cont? pos) #t)
(call-with-values
(lambda () (pos->val pos))
(lambda vals
(if (if pre-cont? (apply pre-cont? vals) #t)
(values vals
(lambda ()
(if (if post-cont?
(apply post-cont? pos vals)
#t)
(next! (pos-next pos))
(values #f no-more))))
(values #f no-more))))
(values #f no-more)))])
(next! init))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; core `for/fold' syntax

95
collects/racket/sequence.rkt
View File

@ -58,18 +58,32 @@
(raise-type-error 'sequence-tail "nonnegative exact integer" i))
(cond
[(zero? i) seq]
[else (let loop ([s (sequence->stream seq)] [n i])
(cond
[(zero? n) (in-stream s)]
[(stream-empty? s)
(raise-mismatch-error
'sequence-ref
(format "sequence ended before ~e element~a: "
i
(if (= i 1) "" "s"))
seq)]
[else (loop (stream-rest s)
(sub1 n))]))]))
[(stream? seq) (stream-tail seq i)]
[else
(make-do-sequence
(lambda ()
(let loop ([next (lambda () (sequence-generate* seq))] [n i])
(cond
[(zero? n)
(let-values ([(vals next) (next)])
(values (lambda (v+n) (apply values (car v+n)))
(lambda (v+n)
(let-values ([(vals next) ((cdr v+n))])
(cons vals next)))
(cons vals next)
car
#f
#f))]
[else
(let-values ([(vals next) (next)])
(if vals
(loop next (sub1 n))
(raise-mismatch-error
'sequence-ref
(format "sequence ended before ~e element~a: "
i
(if (= i 1) "" "s"))
seq)))]))))]))
(define (sequence-append . l)
(if (null? l)
@ -79,21 +93,66 @@
(apply in-sequences l))))
(define (sequence-map f s)
(unless (procedure? f)
(raise-type-error 'sequence-map "expects a procedure as the first argument, given ~e" f))
(unless (procedure? f) (raise-type-error 'sequence-map "procedure" f))
(unless (sequence? s) (raise-type-error 'sequence-map "sequence" s))
(if (stream? s)
(stream-map f s)
(in-stream (stream-map f (sequence->stream s)))))
(make-do-sequence
(lambda ()
(let-values ([(vals next) (sequence-generate* s)])
(values (lambda (v+n) (apply f (car v+n)))
(lambda (v+n)
(let-values ([(vals next) ((cdr v+n))])
(cons vals next)))
(cons vals next)
car
#f
#f))))))
(define (sequence-filter f s)
(unless (procedure? f) (raise-type-error 'sequence-filter "procedure" f))
(unless (sequence? s) (raise-type-error 'sequence-filter "sequence" s))
(if (stream? s)
(stream-filter f s)
(in-stream (stream-filter f (sequence->stream s)))))
(make-do-sequence
(lambda ()
(let loop ([next (lambda () (sequence-generate* s))])
(let-values ([(vals next) (next)])
(if (apply f vals)
(values (lambda (v+n) (apply values (car v+n)))
(lambda (v+n)
(let loop ([next (cdr v+n)])
(let-values ([(vals next) (next)])
(if (or (not vals)
(apply f vals))
(cons vals next)
(loop next)))))
(cons vals next)
car
#f
#f)
(loop next))))))))
(define (sequence-add-between s e)
(unless (sequence? s) (raise-type-error 'sequence-ad-between "sequence" s))
(unless (sequence? s) (raise-type-error 'sequence-add-between "sequence" s))
(if (stream? s)
(stream-add-between s e)
(in-stream (stream-add-between (sequence->stream s) e))))
(make-do-sequence
(lambda ()
(let-values ([(vals next) (sequence-generate* s)])
(values (lambda (v+n) (let ([vals (car v+n)])
(if (eq? vals #t)
e
(apply values vals))))
(lambda (v+n)
(if (eq? (car v+n) #t)
(cdr v+n)
(let-values ([(vals next) ((cdr v+n))])
(if vals
(cons #t (cons vals next))
(cons #f next)))))
(cons vals next)
car
#f
#f))))))

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

@ -63,11 +63,17 @@ thunk that returns procedures to implement a sequence, and the
type to implement its implicit conversion to a sequence.
For most sequence types, extracting elements from a sequence has no
side-effect on the original sequence value; for example, extracting the
sequence of elements from a list does not change the list. For other
sequence types, each extraction implies a side effect; for example,
extracting the sequence of bytes from a port causes the bytes to be read
from the port.
side-effect on the original sequence value; for example, extracting
the sequence of elements from a list does not change the list. For
other sequence types, each extraction implies a side effect; for
example, extracting the sequence of bytes from a port causes the bytes
to be read from the port. A sequence's state may either span all uses
of the sequence, as for a port, or it may be confined to each distinct
time that a sequence is @deftech{initiate}d by a @racket[for] form,
@racket[sequence->stream], @racket[sequence-generate], or
@racket[sequence-generate*]. Concretely, the thunk passed to
@racket[make-do-sequence] is called to @tech{initiate} the sequence
each time the sequence is used.
Individual elements of a sequence typically correspond to single values,
but an element may also correspond to multiple values. For example, a
@ -322,7 +328,8 @@ in the sequence.
(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
initial value returned by the thunk, which is called to @tech{initiate}
the sequence. The initiated sequence is defined in terms
of a @defterm{position}, which is initialized to the third result of
the thunk, and the @defterm{element}, which may consist of multiple
values.
@ -335,14 +342,14 @@ 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 is a @racket[_continue-with-val?] function that
@item{The fourth result is a @racket[_continue-with-pos?] 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). 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
@item{The fifth result is a @racket[_continue-with-val?] 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
@ -394,7 +401,8 @@ in the sequence.
@defproc[(sequence->stream [seq sequence?]) stream?]{
Coverts a sequence to a @tech{stream}, which supports the
@racket[stream-first] and @racket[stream-rest] operations. The
@racket[stream-first] and @racket[stream-rest] operations. Creation
of the stream eagerly @tech{initiates} the sequence, but the
stream lazily draws elements from the sequence, caching each element
so that @racket[stream-first] produces the same result each time
is applied to a stream.
@ -406,12 +414,25 @@ in the sequence.
@defproc[(sequence-generate [seq sequence?])
(values (-> boolean?) (-> any))]{
Returns two thunks to extract elements from the sequence. The first
@tech{Initiates} a sequence and returns two thunks to extract elements
from the sequence. The first
returns @scheme[#t] if more values are available for the sequence.
The second returns the next element (which may be multiple values)
from the sequence; if no more elements are available, the
@exnraise[exn:fail:contract].}
@defproc[(sequence-generate* [seq sequence?])
(values (or/c list? #f)
(-> (values (or/c list? #f) procedure?)))]{
Like @racket[sequence-generate*], but avoids state (aside from any
inherent in the sequence) by returning a list of values the sequence's
first element---or @racket[#f] if the sequence is empty---and a thunk
to continue with the sequence; the result of the thunk is the same
as the result of @racket[sequence-generate*], but for the second
element of the sequence, and so on. If the thunk is called when the
element result is @racket[#f] (indicating no further values in the sequence),
the @exnraise[exn:fail:contract].}
@; ----------------------------------------------------------------------
@subsection[#:tag "more-sequences"]{Sequence Combinations}
@ -441,9 +462,11 @@ in the sequence.
Returns a sequence equivalent to @scheme[s], except that the first
@scheme[i] elements are omitted.
In case extracting elements from @racket[s] involves a side effect,
they will not be extracted until the first element is extracted from
the resulting sequence.}
In case @tech[#:key "initiate"]{initiating} @racket[s] involves a
side effect, the sequence @racket[s] is not @tech{initiate}d
until the resulting sequence is @tech{initiate}d, at which point the
first @racket[i] elements are extracted from
the sequence.}
@defproc[(sequence-append [s sequence?] ...)
sequence?]{

75
collects/tests/racket/sequence.rktl
View File

@ -172,4 +172,79 @@
(test #t stream? (sequence-filter odd? (in-range 3)))
(test #f stream? (sequence-filter odd? (vector 1 2 3)))
;; ----------------------------------------
;; Check interaction of sequence operations and side-effecting streams:
(let ([s (open-input-string "012345")])
(test #\0 peek-char s)
(let ([t (sequence-tail s 3)])
(test #\0 peek-char s)
(test (char->integer #\3) 'tail (for/first ([c t]) c))))
(let ([s (open-input-string "012345")])
(test #\0 peek-char s)
(let ([t (sequence-map add1 s)])
(test #\0 peek-char s)
(test (list (char->integer #\1)
(char->integer #\2)
(char->integer #\3))
'map
(for/list ([c t]
[n (in-range 3)])
c))
;; #\3 was read, but loop ended by `in-range'
(test #\4 peek-char s)))
(let ([s (open-input-string "012345")])
(let ([t (sequence-tail s 6)])
(test '() 'tail (for/list ([i t]) i))))
(let ([s (open-input-string "01234567")])
(test #\0 peek-char s)
(let ([t (sequence-filter even? s)])
(test #\0 peek-char s)
(test (list (char->integer #\0)
(char->integer #\2)
(char->integer #\4))
'map
(for/list ([c t]
[n (in-range 3)])
c))
;; #\6 was read, but loop ended by `in-range'
(test #\7 peek-char s)))
(let ([s (open-input-string "0123")])
(test #\0 peek-char s)
(let ([t (sequence-add-between s #f)])
(test #\0 peek-char s)
(test (list (char->integer #\0)
#f
(char->integer #\1)
#f
(char->integer #\2)
#f
(char->integer #\3))
'map
(for/list ([c t]
[n (in-range 30)])
c))
(test eof peek-char s)))
(let ([s (open-input-string "012345")])
(test #\0 peek-char s)
(let ([t (sequence-add-between s #f)])
(test #\0 peek-char s)
(test (list (char->integer #\0)
#f
(char->integer #\1))
'map
(for/list ([c t]
[n (in-range 3)])
c))
;; #\2 was read, but loop ended by `in-range'
(test #\3 peek-char s)))
;; ----------------------------------------
(report-errs)