Add for[*]/foldr[/derived] and reimplement for[*]/stream using it
`for/fold` is a left fold, which is normally what you want in a call-by-value language such as Racket, but it makes efficient lazy iteration difficult. This commit adds a new `for/foldr` iteration form (along with `for*/` and `/derived` variants) that provides a right fold operation that offers complete control over precisely how lazy the iteration ought to be. In simple microbenchmarks, reimplementing `for/stream` to use `for/foldr` instead of `for` plus a generator can be almost 40x faster on large streams.
This commit is contained in:
Alexis King
parent
11a25b3a54
commit
aab63ad31d
|
|
@ -367,6 +367,146 @@ syntactically, a @racket[for-clause] is closer to to the body).
|
|||
@history[#:changed "6.11.0.1" @elem{Added the @racket[#:result] form.}]
|
||||
}
|
||||
|
||||
@(define for/foldr-eval ((make-eval-factory '(racket/promise racket/sequence racket/stream))))
|
||||
@defform[(for/foldr ([accum-id init-expr] ... accum-option ...)
|
||||
(for-clause ...)
|
||||
body-or-break ... body)
|
||||
#:grammar ([accum-option (code:line #:result result-expr)
|
||||
#:delay
|
||||
(code:line #:delay-as delayed-id)
|
||||
(code:line #:delay-with delayer-id)])]{
|
||||
|
||||
Like @racket[for/fold], but analogous to @racket[foldr] rather than
|
||||
@racket[foldl]: the given sequences are still iterated in the same order, but
|
||||
the loop body is evaluated in reverse order. Evaluation of a @racket[for/foldr]
|
||||
expression uses space proportional to the number of iterations it performs, and
|
||||
all elements produced by the given sequences are retained until backwards
|
||||
evaluation of the loop body begins (assuming the element is, in fact,
|
||||
referenced in the body).
|
||||
|
||||
@(examples
|
||||
#:eval for/foldr-eval
|
||||
(define (in-printing seq)
|
||||
(sequence-map (lambda (v) (println v) v) seq))
|
||||
(eval:check (for/foldr ([acc '()])
|
||||
([v (in-printing (in-range 1 4))])
|
||||
(println v)
|
||||
(cons v acc))
|
||||
'(1 2 3)))
|
||||
|
||||
Furthermore, unlike @racket[for/fold], the @racket[accum-id]s are not bound
|
||||
within @racket[_guard-expr]s or @racket[_body-or-break] forms that appear before
|
||||
a @racket[_break-clause].
|
||||
|
||||
While the aforementioned limitations make @racket[for/foldr] less generally
|
||||
useful than @racket[for/fold], @racket[for/foldr] provides the additional
|
||||
capability to iterate lazily via the @racket[#:delay], @racket[#:delay-as], and
|
||||
@racket[#:delay-with] options, which can mitigate many of @racket[for/foldr]'s
|
||||
disadvantages. If at least one such option is specified, the loop body is given
|
||||
explicit control over when iteration continues: by default, each
|
||||
@racket[accum-id] is bound to a @tech{promise} that, when forced, produces the
|
||||
@racket[accum-id]'s current value.
|
||||
|
||||
In this mode, iteration does not continue until one such promise is forced,
|
||||
which triggers any additional iteration necessary to produce a value. If the
|
||||
loop body is lazy in its @racket[accum-id]s---that is, it returns a value
|
||||
without forcing any of them---then the loop (or any of its iterations) will
|
||||
produce a value before iteration has completely finished. If a reference to at
|
||||
least one such promise is retained, then forcing it will resume iteration from
|
||||
the point at which it was suspended, even if control has left the dynamic extent
|
||||
of the loop body.
|
||||
|
||||
@(examples
|
||||
#:eval for/foldr-eval
|
||||
(eval:check (for/foldr ([acc '()] #:delay)
|
||||
([v (in-range 1 4)])
|
||||
(printf "--> ~v\n" v)
|
||||
(begin0
|
||||
(cons v (force acc))
|
||||
(printf "<-- ~v\n" v)))
|
||||
'(1 2 3))
|
||||
(define resume
|
||||
(for/foldr ([acc '()] #:delay)
|
||||
([v (in-range 1 5)])
|
||||
(printf "--> ~v\n" v)
|
||||
(begin0
|
||||
(cond
|
||||
[(= v 1) (force acc)]
|
||||
[(= v 2) acc]
|
||||
[else (cons v (force acc))])
|
||||
(printf "<-- ~v\n" v))))
|
||||
(eval:check (force resume) '(3 4)))
|
||||
|
||||
This extra control over iteration order allows @racket[for/foldr] to both
|
||||
consume and construct infinite sequences, so long as it is at least sometimes
|
||||
lazy in its accumulators.
|
||||
|
||||
@margin-note/ref{
|
||||
See also @racket[for/stream] for a more convenient (albeit less flexible) way
|
||||
to lazily transform infinite sequences. (Internally, @racket[for/stream] is
|
||||
defined in terms of @racket[for/foldr].)}
|
||||
|
||||
@(examples
|
||||
#:eval for/foldr-eval
|
||||
(define squares (for/foldr ([s empty-stream] #:delay)
|
||||
([n (in-naturals)])
|
||||
(stream-cons (* n n) (force s))))
|
||||
(stream->list (stream-take squares 10)))
|
||||
|
||||
The suspension introduced by the @racket[#:delay] option does not ordinarily
|
||||
affect the loop's eventual return value, but if @racket[#:delay] and
|
||||
@racket[#:result] are combined, the @racket[accum-id]s will be delayed in the
|
||||
scope of the @racket[result-expr] in the same way they are delayed within the
|
||||
loop body. This can be used to introduce an additional layer of suspension
|
||||
around the evaluation of the entire loop, if desired.
|
||||
|
||||
@(examples
|
||||
#:eval for/foldr-eval
|
||||
(define evaluated-yet? #f)
|
||||
(for/foldr ([acc (set! evaluated-yet? #t)] #:delay) ()
|
||||
(force acc))
|
||||
(eval:check evaluated-yet? #t))
|
||||
@(examples
|
||||
#:eval for/foldr-eval
|
||||
#:label #f
|
||||
(define evaluated-yet? #f)
|
||||
(define start
|
||||
(for/foldr ([acc (set! evaluated-yet? #t)] #:delay #:result acc) ()
|
||||
(force acc)))
|
||||
(eval:check evaluated-yet? #f)
|
||||
(force start)
|
||||
(eval:check evaluated-yet? #t))
|
||||
|
||||
If the @racket[#:delay-as] option is provided, then @racket[delayed-id] is
|
||||
bound to an additional promise that returns the values of all @racket[accum-id]s
|
||||
at once. When multiple @racket[accum-id]s are provided, forcing this promise can
|
||||
be slightly more efficient than forcing the promises bound to the
|
||||
@racket[accum-id]s individually.
|
||||
|
||||
If the @racket[#:delay-with] option is provided, the given @racket[delayer-id]
|
||||
is used to suspend nested iterations (instead of the default, @racket[delay]).
|
||||
A form of the shape @racket[(delayer-id _recur-expr)] is constructed and placed
|
||||
in expression position, where @racket[_recur-expr] is an expression that, when
|
||||
evaluated, will perform the next iteration and return its result (or results).
|
||||
Sensible choices for @racket[delayer-id] include @racket[lazy],
|
||||
@racket[delay/sync], @racket[delay/thread], or any of the other promise
|
||||
constructors from @racketmodname[racket/promise], as well as @racket[thunk] from
|
||||
@racketmodname[racket/function]. However, beware that choices such as
|
||||
@racket[thunk] or @racket[delay/name] may evaluate their subexpression multiple
|
||||
times, which can lead to nonsensical results for sequences that have state, as
|
||||
the state will be shared between all evaluations of the @racket[_recur-expr].
|
||||
|
||||
If multiple @racket[accum-id]s are given, the @racket[#:delay-with] option is
|
||||
provided, and @racket[delayer-id] is not bound to one of @racket[delay],
|
||||
@racket[lazy], @racket[delay/strict], @racket[delay/sync],
|
||||
@racket[delay/thread], or @racket[delay/idle], the @racket[accum-id]s will not
|
||||
be bound at all, even within the loop body. Instead, the @racket[#:delay-as]
|
||||
option must be specified to access the accumulator values via
|
||||
@racket[delayed-id].
|
||||
|
||||
@history[#:added "7.3.0.3"]}
|
||||
@(close-eval for/foldr-eval)
|
||||
|
||||
@defform[(for* (for-clause ...) body-or-break ... body)]{
|
||||
Like @racket[for], but with an implicit @racket[#:when #t] between
|
||||
each pair of @racket[for-clauses], so that all sequence iterations are
|
||||
|
|
@ -394,6 +534,9 @@ nested.
|
|||
@defform[(for*/last (for-clause ...) body-or-break ... body)]
|
||||
@defform[(for*/fold ([accum-id init-expr] ... maybe-result) (for-clause ...)
|
||||
body-or-break ... body)]
|
||||
@defform[(for*/foldr ([accum-id init-expr] ... accum-option ...)
|
||||
(for-clause ...)
|
||||
body-or-break ... body)]
|
||||
)]{
|
||||
|
||||
Like @racket[for/list], etc., but with the implicit nesting of
|
||||
|
|
@ -403,7 +546,9 @@ Like @racket[for/list], etc., but with the implicit nesting of
|
|||
(for*/list ([i '(1 2)]
|
||||
[j "ab"])
|
||||
(list i j))
|
||||
]}
|
||||
]
|
||||
|
||||
@history[#:changed "7.3.0.3" @elem{Added the @racket[for*/foldr] form.}]}
|
||||
|
||||
@;------------------------------------------------------------------------
|
||||
@section{Deriving New Iteration Forms}
|
||||
|
|
@ -462,7 +607,6 @@ source for all syntax errors.
|
|||
]
|
||||
|
||||
@history[#:changed "6.11.0.1" @elem{Added the @racket[#:result] form.}]}
|
||||
}
|
||||
|
||||
@defform[(for*/fold/derived orig-datum
|
||||
([accum-id init-expr] ... maybe-result) (for-clause ...)
|
||||
|
|
@ -495,7 +639,21 @@ Like @racket[for*/fold], but the extra @racket[orig-datum] is used as the source
|
|||
]
|
||||
|
||||
@history[#:changed "6.11.0.1" @elem{Added the @racket[#:result] form.}]}
|
||||
}
|
||||
|
||||
@deftogether[(
|
||||
@defform[(for/foldr/derived orig-datum
|
||||
([accum-id init-expr] ... accum-option ...) (for-clause ...)
|
||||
body-or-break ... body)]
|
||||
@defform[(for*/foldr/derived orig-datum
|
||||
([accum-id init-expr] ... accum-option ...) (for-clause ...)
|
||||
body-or-break ... body)]
|
||||
)]{
|
||||
|
||||
Like @racket[for/foldr] and @racket[for*/foldr], but the extra
|
||||
@racket[orig-datum] is used as the source for all syntax errors as in
|
||||
@racket[for/fold/derived] and @racket[for*/fold/derived].
|
||||
|
||||
@history[#:added "7.3.0.3"]}
|
||||
|
||||
@defform[(define-sequence-syntax id
|
||||
expr-transform-expr
|
||||
|
|
|
|||
|
|
@ -944,6 +944,143 @@
|
|||
(check for/list values ormap)
|
||||
(check for/list values andmap))
|
||||
|
||||
;; ----------------------------------------
|
||||
;; `for/foldr`
|
||||
|
||||
(test '(0 1 2 3 4)
|
||||
'for/foldr-one-seq
|
||||
(for/foldr ([lst '()])
|
||||
([x (in-range 5)])
|
||||
(cons x lst)))
|
||||
(test '((0 5) (1 6) (2 7) (3 8) (4 9))
|
||||
'for/foldr-two-seqs
|
||||
(for/foldr ([lst '()])
|
||||
([x (in-range 5)]
|
||||
[y (in-range 5 10)])
|
||||
(cons (list x y) lst)))
|
||||
(test '((0 5 10) (1 6 11) (2 7 12) (3 8 13) (4 9 14))
|
||||
'for/foldr-three-seqs
|
||||
(for/foldr ([lst '()])
|
||||
([x (in-range 5)]
|
||||
[y (in-range 5 10)]
|
||||
[z (in-range 10 15)])
|
||||
(cons (list x y z) lst)))
|
||||
|
||||
(test '(0 1 2)
|
||||
'for*/foldr-one-seq
|
||||
(for*/foldr ([lst '()])
|
||||
([x (in-range 3)])
|
||||
(cons x lst)))
|
||||
(test '((0 0) (0 1) (0 2) (1 1) (1 2) (1 3) (2 2) (2 3) (2 4))
|
||||
'for*/foldr-two-seqs
|
||||
(for*/foldr ([lst '()])
|
||||
([x (in-range 3)]
|
||||
[y (in-range x (+ x 3))])
|
||||
(cons (list x y) lst)))
|
||||
|
||||
(test '((0 0) (0 1) (0 2) (2 2) (2 3) (2 4))
|
||||
'for/foldr-guard
|
||||
(for/foldr ([lst '()])
|
||||
([x (in-range 3)]
|
||||
#:unless (= x 1)
|
||||
[y (in-range x (+ x 3))])
|
||||
(cons (list x y) lst)))
|
||||
(test '((0 0) (0 1) (0 2) (1 1) (1 2) (1 3) (2 2))
|
||||
'for*/foldr-break
|
||||
(for*/foldr ([lst '()])
|
||||
([x (in-range 3)]
|
||||
[y (in-range x (+ x 3))]
|
||||
#:break (and (= x 2) (= y 3)))
|
||||
(cons (list x y) lst)))
|
||||
(test '((0 0) (0 1) (0 2) (1 1) (1 2) (1 3) (2 2) (2 3))
|
||||
'for*/foldr-final
|
||||
(for*/foldr ([lst '()])
|
||||
([x (in-range 3)]
|
||||
[y (in-range x (+ x 3))]
|
||||
#:final (and (= x 2) (= y 3)))
|
||||
(cons (list x y) lst)))
|
||||
|
||||
(test '(408 . 20400)
|
||||
'for/foldr-two-accs
|
||||
(for/foldr ([a 1] [b 1] #:result (cons a b))
|
||||
([n (in-range 5)])
|
||||
(values b (* a (+ b n)))))
|
||||
|
||||
(test #t 'for/foldr-delay-init
|
||||
(for/foldr ([acc (error "never gets here")] #:delay)
|
||||
([v (in-value #t)])
|
||||
v))
|
||||
|
||||
(test '(0 1 4 9 16)
|
||||
'for/foldr-stream-finite
|
||||
(stream->list
|
||||
(for/foldr ([s empty-stream] #:delay)
|
||||
([v (in-range 5)])
|
||||
(stream-cons (sqr v) (force s)))))
|
||||
(test '(0 1 4 9 16)
|
||||
'for/foldr-stream-infinite
|
||||
(stream->list
|
||||
(stream-take
|
||||
(for/foldr ([s (error "never gets here")] #:delay)
|
||||
([v (in-naturals)])
|
||||
(stream-cons (sqr v) (force s)))
|
||||
5)))
|
||||
|
||||
(test '(0 1 4 9 16)
|
||||
'for/foldr-stream-finite/thunk
|
||||
(stream->list
|
||||
(for/foldr ([s empty-stream] #:delay-with thunk)
|
||||
([v (in-range 5)])
|
||||
(stream-cons (sqr v) (s)))))
|
||||
(test '(0 1 4 9 16)
|
||||
'for/foldr-stream-infinite/thunk
|
||||
(stream->list
|
||||
(stream-take
|
||||
(for/foldr ([s (error "never gets here")] #:delay-with thunk)
|
||||
([v (in-naturals)])
|
||||
(stream-cons (sqr v) (s)))
|
||||
5)))
|
||||
|
||||
(test '(4 9 16 4 9 16 4 9 16 4)
|
||||
'for/foldr-stream-circular
|
||||
(letrec ([s (for/foldr ([s s] #:delay)
|
||||
([v (in-range 2 5)])
|
||||
(stream-cons (sqr v) (force s)))])
|
||||
(stream->list (stream-take s 10))))
|
||||
(test '(0 1 1 2 3 5 8 13 21 34)
|
||||
'for/foldr-stream-self-iter
|
||||
(letrec ([fibs (stream* 0 1 (for/foldr ([more (error "never gets here")] #:delay)
|
||||
([a (in-stream fibs)]
|
||||
[b (in-stream (stream-rest fibs))])
|
||||
(stream-cons (+ a b) (force more))))])
|
||||
(stream->list (stream-take fibs 10))))
|
||||
|
||||
(test '(0 -1 2 -3 0 1 -2 3 0 -1)
|
||||
'for/foldr-stream-twist
|
||||
(letrec-values ([(s1 s2) (for/foldr ([s1 s2] [s2 s1] #:delay)
|
||||
([n (in-range 4)])
|
||||
(values (stream-cons n (force s2))
|
||||
(stream-cons (- n) (force s1))))])
|
||||
(stream->list (stream-take s1 10))))
|
||||
(test '(0 -1 2 -3 0 1 -2 3 0 -1)
|
||||
'for/foldr-stream-twist/thunk
|
||||
(letrec-values ([(s1 s2)
|
||||
(for/foldr ([s1 s2] [s2 s1] #:delay-with thunk #:delay-as get-next)
|
||||
([n (in-range 4)])
|
||||
(define next (delay (get-next)))
|
||||
(values (stream-cons n (let-values ([(s1 s2) (force next)]) s2))
|
||||
(stream-cons (- n) (let-values ([(s1 s2) (force next)]) s1))))])
|
||||
(stream->list (stream-take s1 10))))
|
||||
|
||||
;; `#:delay` applies inside `#:result`
|
||||
(let ()
|
||||
(define evaluated? #f)
|
||||
(define result (for/foldr ([acc (set! evaluated? #t)] #:result acc #:delay) ()
|
||||
(force acc)))
|
||||
(test #f 'for/foldr-result-delay-1 evaluated?)
|
||||
(test (void) 'for/foldr-result-delay-2 (force result))
|
||||
(test #t 'for/foldr-result-delay-3 evaluated?))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
(report-errs)
|
||||
|
|
|
|||
|
|
@ -8,6 +8,7 @@
|
|||
"reverse.rkt"
|
||||
"sort.rkt"
|
||||
"performance-hint.rkt"
|
||||
"promise.rkt"
|
||||
'#%unsafe
|
||||
'#%flfxnum
|
||||
(for-syntax '#%kernel
|
||||
|
|
@ -19,6 +20,7 @@
|
|||
"stxcase-scheme.rkt"))
|
||||
|
||||
(#%provide for/fold for*/fold
|
||||
for/foldr for*/foldr
|
||||
for for*
|
||||
for/list for*/list
|
||||
for/vector for*/vector
|
||||
|
|
@ -34,6 +36,7 @@
|
|||
for/hasheqv for*/hasheqv
|
||||
|
||||
for/fold/derived for*/fold/derived
|
||||
for/foldr/derived for*/foldr/derived
|
||||
(for-syntax split-for-body)
|
||||
(for-syntax (rename expand-clause expand-for-clause))
|
||||
|
||||
|
|
@ -1431,9 +1434,33 @@
|
|||
[(_ x) x]
|
||||
[(_ x ...) (values x ...)]))
|
||||
|
||||
(define-syntax-rule (inner-recur/fold (fold-var ...) (let () expr ...) next-k)
|
||||
(let-values ([(fold-var ...) (let () expr ...)])
|
||||
(define-syntax-rule (inner-recur/fold (fold-var ...) [expr ...] next-k)
|
||||
(let-values ([(fold-var ...) (let-values () expr ...)])
|
||||
next-k))
|
||||
|
||||
(define-for-syntax ((make-inner-recur/foldr/strict fold-vars) stx)
|
||||
(syntax-case stx ()
|
||||
[(_ () [expr ...] next-k)
|
||||
#`(let-values ([#,(map syntax-local-introduce fold-vars) next-k])
|
||||
expr ...)]))
|
||||
|
||||
(define-for-syntax ((make-inner-recur/foldr/lazy fold-vars delayed-id delayer-id) stx)
|
||||
(syntax-case stx ()
|
||||
[(_ () [expr ...] next-k)
|
||||
(with-syntax ([(fold-var ...) (map syntax-local-introduce fold-vars)]
|
||||
[delayed-id (syntax-local-introduce delayed-id)]
|
||||
[delayer-id delayer-id])
|
||||
#`(let*-values
|
||||
([(delayed-id) (delayer-id #,(syntax-protect #'next-k))]
|
||||
#,@(cond
|
||||
[(= (length fold-vars) 1)
|
||||
#`([(fold-var ...) delayed-id])]
|
||||
[(delayer? (syntax-local-value #'delayer-id (lambda () #f)))
|
||||
#`([(fold-var) (delayer-id (let-values ([(fold-var ...) (force delayed-id)])
|
||||
fold-var))]
|
||||
...)]
|
||||
[else #'()]))
|
||||
expr ...))]))
|
||||
|
||||
(define-syntax (push-under-break stx)
|
||||
(syntax-case stx ()
|
||||
|
|
@ -1443,7 +1470,7 @@
|
|||
[(null? l)
|
||||
;; No #:break form
|
||||
(syntax-protect
|
||||
#'(inner-recur fold-vars (let-values () expr ...) (if final?-id break-k next-k)))]
|
||||
#'(inner-recur fold-vars [expr ...] (if final?-id break-k next-k)))]
|
||||
[(eq? '#:break (syntax-e (car l)))
|
||||
;; Found a #:break form
|
||||
(syntax-protect
|
||||
|
|
@ -1489,34 +1516,36 @@
|
|||
[inner-binding ...]
|
||||
pre-guard
|
||||
post-guard
|
||||
[loop-arg ...]) ...) (reverse (syntax->list #'binds))])
|
||||
[loop-arg ...]) ...)
|
||||
(reverse (syntax->list #'binds))])
|
||||
(syntax-protect
|
||||
(quasisyntax/loc #'orig-stx
|
||||
(let-values (outer-binding ... ...)
|
||||
outer-check ...
|
||||
#,(quasisyntax/loc #'orig-stx
|
||||
(let for-loop ([fold-var fold-init] ...
|
||||
loop-binding ... ...)
|
||||
loop-binding ... ...)
|
||||
(if (and pos-guard ...)
|
||||
(let-values (inner-binding ... ...)
|
||||
(if (and pre-guard ...)
|
||||
#,(if (syntax-e #'inner-recur)
|
||||
;; The general non-nested-loop approach:
|
||||
#'(let ([post-guard-var (lambda (fold-var ...) (and post-guard ...))])
|
||||
#'(let ()
|
||||
(define (next-k-proc fold-var ...)
|
||||
(if (and post-guard ...)
|
||||
(for-loop fold-var ... loop-arg ... ...)
|
||||
next-k))
|
||||
(for/foldX/derived [orig-stx inner-recur nested? #f ()]
|
||||
([fold-var fold-var] ...)
|
||||
(if (post-guard-var fold-var ...)
|
||||
(for-loop fold-var ... loop-arg ... ...)
|
||||
next-k)
|
||||
break-k final?-id
|
||||
rest expr1 . body))
|
||||
([fold-var fold-var] ...)
|
||||
(next-k-proc fold-var ...) break-k final?-id
|
||||
rest expr1 . body))
|
||||
;; The specialized nested-loop approach, which is
|
||||
;; slightly faster when it works:
|
||||
#'(let-values ([(fold-var ...)
|
||||
(for/foldX/derived [orig-stx inner-recur nested? #f ()]
|
||||
([fold-var fold-var] ...)
|
||||
next-k break-k final?-id
|
||||
rest expr1 . body)])
|
||||
([fold-var fold-var] ...)
|
||||
next-k break-k final?-id
|
||||
rest expr1 . body)])
|
||||
(if (and post-guard ... (not final?-id))
|
||||
(for-loop fold-var ... loop-arg ... ...)
|
||||
next-k)))
|
||||
|
|
@ -1572,12 +1601,9 @@
|
|||
[(_ [orig-stx inner-recur nested? #f binds] fold-bind next-k break-k final?-id ([id rhs] . rest) . body)
|
||||
(identifier? #'id)
|
||||
(syntax-protect
|
||||
#'(for/foldX/derived [orig-stx inner-recur nested? #f binds] fold-bind next-k break-k final?-id
|
||||
#'(for/foldX/derived [orig-stx inner-recur nested? #f binds]
|
||||
fold-bind next-k break-k final?-id
|
||||
([(id) rhs] . rest) . body))]
|
||||
;; If we get here in single-value mode, then it's a bad clause:
|
||||
[(_ [orig-stx inner-recur #f #f nested? #f binds] fold-bind next-k break-k final?-id (clause . rest) . body)
|
||||
(raise-syntax-error
|
||||
#f "bad sequence binding clause" #'orig-stx #'clause)]
|
||||
;; Expand one multi-value clause, and push it into the results to emit:
|
||||
[(frm [orig-stx inner-recur nested? #f binds] ([fold-var fold-init] ...) next-k break-k final?-id (clause . rest) . body)
|
||||
(with-syntax ([bind (expand-clause #'orig-stx #'clause)])
|
||||
|
|
@ -1593,7 +1619,7 @@
|
|||
[(_ [orig-stx . _] . _)
|
||||
(raise-syntax-error #f "bad syntax" #'orig-stx)]))
|
||||
|
||||
(define-syntax (for/foldX/derived/final stx)
|
||||
(define-syntax (for/fold/derived/final stx)
|
||||
(syntax-case stx ()
|
||||
[(_ [orig-stx nested?] fold-bind done-k (clause ...) expr ...)
|
||||
;; If there's a `#:break` or `#:final`, then we need to use the
|
||||
|
|
@ -1607,53 +1633,116 @@
|
|||
(syntax-protect
|
||||
#'(for/foldX/derived [orig-stx #f nested? #f ()] fold-bind done-k done-k #f . rest))]))
|
||||
|
||||
(define-syntax (for/fold/derived stx)
|
||||
(syntax-case stx ()
|
||||
[(_ orig-stx ([fold-var finid-init] ... #:result result-expr) . rest)
|
||||
(check-identifier-bindings #'orig-stx #'(fold-var ...) "accumulator" #t)
|
||||
(syntax-protect
|
||||
(syntax/loc #'orig-stx
|
||||
(let-values ([(fold-var ...) (for/foldX/derived/final [orig-stx #f]
|
||||
([fold-var finid-init] ...)
|
||||
(values* fold-var ...)
|
||||
. rest)])
|
||||
result-expr)))]
|
||||
[(_ orig-stx ([fold-var finid-init] ...) . rest)
|
||||
(check-identifier-bindings #'orig-stx #'(fold-var ...) "accumulator" #t)
|
||||
(syntax-protect
|
||||
(syntax/loc #'orig-stx
|
||||
(for/foldX/derived/final [orig-stx #f]
|
||||
([fold-var finid-init] ...)
|
||||
(values* fold-var ...)
|
||||
. rest)))]
|
||||
[(_ orig-stx (bindings ...) . rst)
|
||||
(raise-syntax-error #f "invalid accumulator binding clause(s)" #'orig-stx #'(bindings ...))]
|
||||
[(_ orig-stx . rst)
|
||||
(raise-syntax-error #f "bad syntax" #'orig-stx)]))
|
||||
(define-syntaxes (for/fold/derived for*/fold/derived for/foldr/derived for*/foldr/derived)
|
||||
(let ()
|
||||
(define (parse-bindings+options stx orig-stx right?)
|
||||
(let loop ([stx stx]
|
||||
[parsed-any-opts? #f]
|
||||
[bindings '()]
|
||||
[result-expr #f]
|
||||
[delay? #f]
|
||||
[delayed-id #f]
|
||||
[delayer-id #f])
|
||||
(syntax-case stx ()
|
||||
[()
|
||||
(let ([delay? (or delay? delayed-id delayer-id)])
|
||||
(values (reverse bindings)
|
||||
result-expr
|
||||
delay?
|
||||
(or delayed-id #'delayed)
|
||||
(or delayer-id #'delay)))]
|
||||
[([fold-var fold-init] . rest)
|
||||
(not parsed-any-opts?)
|
||||
(loop #'rest #f (cons #'[fold-var fold-init] bindings)
|
||||
result-expr delay? delayed-id delayer-id)]
|
||||
[(#:result expr . rest)
|
||||
(not (keyword? (syntax-e #'expr)))
|
||||
(if result-expr
|
||||
(raise-syntax-error #f "duplicate #:result option" orig-stx #'kw)
|
||||
(loop #'rest #t bindings #'expr delay? delayed-id delayer-id))]
|
||||
[(#:result . rest)
|
||||
(raise-syntax-error #f "expected expression for #:result option" orig-stx #'rest)]
|
||||
[(kw . rest)
|
||||
(and right? (eq? (syntax-e #'kw) '#:delay))
|
||||
(if delay?
|
||||
(raise-syntax-error #f "duplicate #:delay option" orig-stx #'kw)
|
||||
(loop #'rest #t bindings result-expr #t delayed-id delayer-id))]
|
||||
[(#:delay-as id . rest)
|
||||
(and right? (identifier? #'id))
|
||||
(if delayed-id
|
||||
(raise-syntax-error #f "duplicate #:delay-as option" orig-stx #'id)
|
||||
(loop #'rest #t bindings result-expr delay? #'id delayer-id))]
|
||||
[(#:delay-as . rest)
|
||||
right?
|
||||
(raise-syntax-error #f "expected identifier for #:delay-as option" orig-stx #'rest)]
|
||||
[(#:delay-with id . rest)
|
||||
(and right? (identifier? #'id))
|
||||
(if delayer-id
|
||||
(raise-syntax-error #f "duplicate #:delay-with option" orig-stx #'id)
|
||||
(loop #'rest #t bindings result-expr delay? delayed-id #'id))]
|
||||
[(#:delay-with . rest)
|
||||
right?
|
||||
(raise-syntax-error #f "expected identifier for #:delay-with option" orig-stx #'rest)]
|
||||
[_
|
||||
(raise-syntax-error #f
|
||||
(if parsed-any-opts?
|
||||
"invalid accumulator option(s)"
|
||||
"invalid accumulator binding clause(s)")
|
||||
orig-stx
|
||||
stx)])))
|
||||
|
||||
(define-syntax (for*/fold/derived stx)
|
||||
(syntax-case stx ()
|
||||
[(_ orig-stx ([fold-var finid-init] ... #:result result-expr) . rest)
|
||||
(check-identifier-bindings #'orig-stx #'(fold-var ...) "accumulator" #t)
|
||||
(syntax-protect
|
||||
(syntax/loc #'orig-stx
|
||||
(let-values ([(fold-var ...) (for/foldX/derived/final [orig-stx #t]
|
||||
([fold-var finid-init] ...)
|
||||
(values* fold-var ...)
|
||||
. rest)])
|
||||
result-expr)))]
|
||||
[(_ orig-stx ([fold-var finid-init] ...) . rest)
|
||||
(check-identifier-bindings #'orig-stx #'(fold-var ...) "accumulator" #t)
|
||||
(syntax-protect
|
||||
(syntax/loc #'orig-stx
|
||||
(for/foldX/derived/final [orig-stx #t]
|
||||
([fold-var finid-init] ...)
|
||||
(values* fold-var ...)
|
||||
. rest)))]
|
||||
[(_ orig-stx (bindings ...) . rst)
|
||||
(raise-syntax-error #f "invalid accumulator binding clause(s)" #'orig-stx #'(bindings ...))]
|
||||
[(_ orig-stx . rst)
|
||||
(raise-syntax-error #f "bad syntax" #'orig-stx)]))
|
||||
(define ((make for*? right?) stx)
|
||||
(syntax-case stx ()
|
||||
[(_ orig-stx bindings+options . rest)
|
||||
(let ()
|
||||
(define-values (bindings result-expr delay? delayed-id delayer-id)
|
||||
(parse-bindings+options #'bindings+options #'orig-stx right?))
|
||||
(with-syntax ([([fold-var fold-init] ...) bindings]
|
||||
[delayed-id delayed-id]
|
||||
[delayer-id delayer-id])
|
||||
(check-identifier-bindings #'orig-stx #`(fold-var ... delayed-id) "accumulator" (void))
|
||||
(syntax-protect
|
||||
(cond
|
||||
[right?
|
||||
(define loop-stx
|
||||
(quasisyntax/loc #'orig-stx
|
||||
(for/foldX/derived [orig-stx inner-recur/foldr #,for*? #f ()]
|
||||
()
|
||||
(done-k-proc)
|
||||
(done-k-proc)
|
||||
#f
|
||||
. rest)))
|
||||
(quasisyntax/loc #'orig-stx
|
||||
(let ()
|
||||
(define (done-k-proc) (#%expression (values* fold-init ...)))
|
||||
(define-syntax inner-recur/foldr
|
||||
#,(if delay?
|
||||
#'(make-inner-recur/foldr/lazy
|
||||
(list (quote-syntax fold-var) ...)
|
||||
(quote-syntax delayed-id)
|
||||
(quote-syntax delayer-id))
|
||||
#'(make-inner-recur/foldr/strict
|
||||
(list (quote-syntax fold-var) ...))))
|
||||
#,(if result-expr
|
||||
;; Make sure `fold-var`s in `result-expr` are also delayed, if relevant
|
||||
#`(inner-recur/foldr () [#,result-expr] #,loop-stx)
|
||||
loop-stx)))]
|
||||
[else
|
||||
(define loop-stx
|
||||
(quasisyntax/loc #'orig-stx
|
||||
(for/fold/derived/final [orig-stx #,for*?]
|
||||
([fold-var fold-init] ...)
|
||||
(values* fold-var ...)
|
||||
. rest)))
|
||||
(if result-expr
|
||||
(quasisyntax/loc #'orig-stx
|
||||
(let-values ([(fold-var ...) #,loop-stx])
|
||||
#,result-expr))
|
||||
loop-stx)]))))]
|
||||
[(_ orig-stx . rst)
|
||||
(raise-syntax-error #f "bad syntax" #'orig-stx)]))
|
||||
|
||||
(values (make #f #f) (make #t #f) (make #f #t) (make #t #t))))
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; derived `for' syntax
|
||||
|
|
@ -1738,14 +1827,17 @@
|
|||
(define-syntax-via-derived for for/fold/derived fold-bind wrap rhs-wrap combine)
|
||||
(define-syntax-via-derived for* for*/fold/derived fold-bind wrap rhs-wrap combine))]))
|
||||
|
||||
(define-syntax (for/fold stx)
|
||||
(syntax-case stx ()
|
||||
[(_ . rest) (syntax-protect
|
||||
(quasisyntax/loc stx (for/fold/derived #,stx . rest)))]))
|
||||
(define-syntax (for*/fold stx)
|
||||
(syntax-case stx ()
|
||||
[(_ . rest) (syntax-protect
|
||||
(quasisyntax/loc stx (for*/fold/derived #,stx . rest)))]))
|
||||
(define-syntaxes (for/fold for*/fold for/foldr for*/foldr)
|
||||
(let ()
|
||||
(define ((make f/f/d-id) stx)
|
||||
(syntax-case stx ()
|
||||
[(_ . rest)
|
||||
(syntax-protect (quasisyntax/loc stx
|
||||
(#,f/f/d-id #,stx . rest)))]))
|
||||
(values (make #'for/fold/derived)
|
||||
(make #'for*/fold/derived)
|
||||
(make #'for/foldr/derived)
|
||||
(make #'for*/foldr/derived))))
|
||||
|
||||
(define-for-variants (for for*)
|
||||
()
|
||||
|
|
|
|||
|
|
@ -3,15 +3,22 @@
|
|||
"more-scheme.rkt"
|
||||
"define.rkt"
|
||||
(rename "define-struct.rkt" define-struct define-struct*)
|
||||
(for-syntax '#%kernel "stxcase-scheme.rkt" "name.rkt")
|
||||
(for-syntax '#%kernel
|
||||
"small-scheme.rkt"
|
||||
"define.rkt"
|
||||
"struct.rkt"
|
||||
"stxcase-scheme.rkt"
|
||||
"name.rkt")
|
||||
'#%unsafe)
|
||||
(#%provide force promise? promise-forced? promise-running?
|
||||
(rename lazy* lazy)
|
||||
(rename delay* delay)
|
||||
;; provided to create extensions
|
||||
(struct promise ()) (protect pref pset!) prop:force reify-result
|
||||
promise-forcer
|
||||
promise-printer
|
||||
(struct running ()) (struct reraise ())
|
||||
(for-syntax make-delayer))
|
||||
(for-syntax delayer delayer?))
|
||||
|
||||
;; This module implements "lazy" (composable) promises and a `force'
|
||||
;; that is iterated through them.
|
||||
|
|
@ -197,59 +204,64 @@
|
|||
|
||||
;; template for all delay-like constructs
|
||||
;; (with simple keyword matching: keywords is an alist with default exprs)
|
||||
(define-for-syntax (make-delayer stx maker keywords)
|
||||
;; no `cond', `and', `or', `let', `define', etc here
|
||||
(letrec-values
|
||||
([(exprs+kwds)
|
||||
(lambda (stxs exprs kwds)
|
||||
(if (null? stxs)
|
||||
(values (reverse exprs) (reverse kwds))
|
||||
(if (not (keyword? (syntax-e (car stxs))))
|
||||
(exprs+kwds (cdr stxs) (cons (car stxs) exprs) kwds)
|
||||
(if (if (pair? (cdr stxs))
|
||||
(if (assq (syntax-e (car stxs)) keywords)
|
||||
(not (assq (syntax-e (car stxs)) kwds))
|
||||
#f)
|
||||
#f)
|
||||
(exprs+kwds (cddr stxs) exprs
|
||||
(cons (cons (syntax-e (car stxs)) (cadr stxs))
|
||||
kwds))
|
||||
(values #f #f)))))]
|
||||
[(stxs) (syntax->list stx)]
|
||||
[(exprs kwds) (exprs+kwds (if stxs (cdr stxs) '()) '() '())]
|
||||
[(kwd-args) (if kwds
|
||||
(map (lambda (k)
|
||||
(let-values ([(x) (assq (car k) kwds)])
|
||||
(if x (cdr x) (cdr k))))
|
||||
keywords)
|
||||
#f)]
|
||||
;; some strange bug with `syntax-local-expand-expression' makes this not
|
||||
;; work well with identifiers, so turn the name into a symbol to work
|
||||
;; around this for now
|
||||
[(name0) (syntax-local-infer-name stx)]
|
||||
[(name) (if (syntax? name0) (syntax-e name0) name0)]
|
||||
[(unwind-promise)
|
||||
(lambda (stx unwind-recur)
|
||||
(syntax-case stx ()
|
||||
[(#%plain-lambda () body) (unwind-recur #'body)]))])
|
||||
(syntax-case stx ()
|
||||
[_ (pair? exprs) ; throw a syntax error if anything is wrong
|
||||
(with-syntax ([(expr ...) exprs]
|
||||
[(kwd-arg ...) kwd-args])
|
||||
(with-syntax ([proc
|
||||
(stepper-syntax-property
|
||||
(syntax-property
|
||||
(syntax/loc stx (lambda () expr ...))
|
||||
'inferred-name name)
|
||||
'stepper-hint unwind-promise)]
|
||||
[make maker])
|
||||
(syntax/loc stx (make proc kwd-arg ...))))])))
|
||||
(begin-for-syntax
|
||||
(struct delayer (maker keywords)
|
||||
#:property prop:procedure
|
||||
(lambda (self stx)
|
||||
(define keywords (delayer-keywords self))
|
||||
|
||||
(define (parse-exprs+kwds stxs)
|
||||
(let loop ([stxs stxs]
|
||||
[exprs '()]
|
||||
[kwds '()])
|
||||
(syntax-case stxs ()
|
||||
[()
|
||||
(values (reverse exprs) (reverse kwds))]
|
||||
[(expr . rest)
|
||||
(not (keyword? (syntax-e #'expr)))
|
||||
(loop #'rest (cons #'expr exprs) kwds)]
|
||||
[(kw-stx expr . rest)
|
||||
(not (keyword? (syntax-e #'expr)))
|
||||
(let ([kw (syntax-e #'kw-stx)])
|
||||
(cond
|
||||
[(not (assq kw keywords))
|
||||
(raise-syntax-error #f "unrecognized option" stx #'kw-stx)]
|
||||
[(assq kw kwds)
|
||||
(raise-syntax-error #f "duplicate option" stx #'kw-stx)]
|
||||
[else
|
||||
(loop #'rest exprs (cons (cons kw #'expr) kwds))]))]
|
||||
[(kw-stx . rest)
|
||||
(raise-syntax-error #f "missing argument for option" stx #'kw-stx)]
|
||||
[_
|
||||
(raise-syntax-error #f "bad syntax" stx stxs)])))
|
||||
|
||||
(define (unwind-promise stx unwind-recur)
|
||||
(syntax-case stx ()
|
||||
[(#%plain-lambda () body) (unwind-recur #'body)]))
|
||||
|
||||
(syntax-case stx ()
|
||||
[(_ . exprs+kwds)
|
||||
(let ()
|
||||
(define-values (exprs kwds) (parse-exprs+kwds #'exprs+kwds))
|
||||
(with-syntax ([(expr ...) exprs]
|
||||
[(kwd-arg ...) (map (lambda (k)
|
||||
(cond
|
||||
[(assq (car k) kwds) => cdr]
|
||||
[else (cdr k)]))
|
||||
keywords)])
|
||||
(with-syntax ([proc
|
||||
(stepper-syntax-property
|
||||
(syntax-property
|
||||
(syntax/loc stx (lambda () expr ...))
|
||||
'inferred-name (syntax-local-infer-name stx))
|
||||
'stepper-hint unwind-promise)]
|
||||
[make (delayer-maker self)])
|
||||
(syntax-protect (syntax/loc stx (make proc kwd-arg ...))))))]))))
|
||||
|
||||
;; Creates a composable promise
|
||||
;; X = (force (lazy X)) = (force (lazy (lazy X))) = (force (lazy^n X))
|
||||
(#%provide (rename lazy* lazy))
|
||||
(define lazy make-composable-promise)
|
||||
(define-syntax (lazy* stx) (syntax-protect (make-delayer stx #'lazy '())))
|
||||
(define-syntax lazy* (delayer #'lazy '()))
|
||||
|
||||
;; Creates a (generic) promise that does not compose
|
||||
;; X = (force (delay X)) = (force (lazy (delay X)))
|
||||
|
|
@ -259,9 +271,8 @@
|
|||
;; sequence of `(lazy^n o delay)^m o lazy^k' requires m+1 `force's (for k>0)
|
||||
;; (This is not needed with a lazy language (see the above URL for details),
|
||||
;; but provided for regular delay/force uses.)
|
||||
(#%provide (rename delay* delay))
|
||||
(define delay make-promise)
|
||||
(define-syntax (delay* stx) (syntax-protect (make-delayer stx #'delay '())))
|
||||
(define-syntax delay* (delayer #'delay '()))
|
||||
|
||||
;; For simplicity and efficiency this code uses thunks in promise values for
|
||||
;; exceptions: this way, we don't need to tag exception values in some special
|
||||
|
|
|
|||
|
|
@ -1,26 +1,29 @@
|
|||
#lang racket/base
|
||||
(require "private/promise.rkt" (for-syntax racket/base))
|
||||
(provide delay lazy force promise? promise-forced? promise-running?)
|
||||
(provide delay lazy force promise? promise-forced? promise-running? promise/name?
|
||||
(rename-out [delay/name* delay/name]
|
||||
[delay/strict* delay/strict]
|
||||
[delay/sync* delay/sync]
|
||||
[delay/thread* delay/thread]
|
||||
[delay/idle* delay/idle]))
|
||||
|
||||
;; ----------------------------------------------------------------------------
|
||||
;; More delay-like values, with different ways of deferring computations
|
||||
|
||||
(define-struct (promise/name promise) ()
|
||||
#:property prop:force (λ(p) ((pref p))))
|
||||
(provide (rename-out [delay/name* delay/name]) promise/name?)
|
||||
(define delay/name make-promise/name)
|
||||
(define-syntax (delay/name* stx) (make-delayer stx #'delay/name '()))
|
||||
(define-syntax delay/name* (delayer #'delay/name '()))
|
||||
|
||||
;; mostly to implement srfi-45's `eager'
|
||||
(define-struct (promise/strict promise) ()
|
||||
#:property prop:force (λ(p) (reify-result (pref p)))) ; never a thunk
|
||||
(provide (rename-out [delay/strict* delay/strict]))
|
||||
(define (delay/strict thunk)
|
||||
;; could use `reify-result' here to capture exceptions too, or just create a
|
||||
;; promise and immediately force it, but no point since if there's an
|
||||
;; exception then the promise value is never used.
|
||||
(make-promise/strict (call-with-values thunk list)))
|
||||
(define-syntax (delay/strict* stx) (make-delayer stx #'delay/strict '()))
|
||||
(define-syntax delay/strict* (delayer #'delay/strict '()))
|
||||
|
||||
;; utility struct
|
||||
(define-struct (running-thread running) (thread))
|
||||
|
|
@ -82,13 +85,12 @@
|
|||
(λ(p) (define v (pref p))
|
||||
(wrap-evt (if (syncinfo? v) (syncinfo-done-evt v) always-evt) void)))
|
||||
|
||||
(provide (rename-out [delay/sync* delay/sync]))
|
||||
(define (delay/sync thunk)
|
||||
(define done-sema (make-semaphore 0))
|
||||
(make-promise/sync (make-syncinfo thunk
|
||||
(semaphore-peek-evt done-sema) done-sema
|
||||
(make-semaphore 1))))
|
||||
(define-syntax (delay/sync* stx) (make-delayer stx #'delay/sync '()))
|
||||
(define-syntax delay/sync* (delayer #'delay/sync '()))
|
||||
|
||||
;; threaded promises
|
||||
|
||||
|
|
@ -110,7 +112,6 @@
|
|||
(wrap-evt (if (running? v) (running-thread-thread v) always-evt)
|
||||
void)))
|
||||
|
||||
(provide (rename-out [delay/thread* delay/thread]))
|
||||
(define (delay/thread thunk group)
|
||||
(unless (or (not group)
|
||||
(thread-group? group))
|
||||
|
|
@ -135,8 +136,7 @@
|
|||
(semaphore-post initialized-sema)
|
||||
p)
|
||||
(define-syntax delay/thread*
|
||||
(let ([kwds (list (cons '#:group #'(make-thread-group)))])
|
||||
(λ(stx) (make-delayer stx #'delay/thread kwds))))
|
||||
(delayer #'delay/thread (list (cons '#:group #'(make-thread-group)))))
|
||||
|
||||
(define-struct (promise/idle promise/thread) ()
|
||||
#:property prop:force
|
||||
|
|
@ -152,7 +152,6 @@
|
|||
(pref p))
|
||||
v))))
|
||||
|
||||
(provide (rename-out [delay/idle* delay/idle]))
|
||||
(define (delay/idle thunk wait-for work-while tick use*)
|
||||
(unless (evt? wait-for)
|
||||
(raise-argument-error 'delay/idle "evt?" wait-for))
|
||||
|
|
@ -211,8 +210,7 @@
|
|||
(or (object-name thunk) 'idle-thread))))
|
||||
p)
|
||||
(define-syntax delay/idle*
|
||||
(let ([kwds (list (cons '#:wait-for #'(system-idle-evt))
|
||||
(cons '#:work-while #'(system-idle-evt))
|
||||
(cons '#:tick #'0.2)
|
||||
(cons '#:use #'0.12))])
|
||||
(λ(stx) (make-delayer stx #'delay/idle kwds))))
|
||||
(delayer #'delay/idle (list (cons '#:wait-for #'(system-idle-evt))
|
||||
(cons '#:work-while #'(system-idle-evt))
|
||||
(cons '#:tick #'0.2)
|
||||
(cons '#:use #'0.12))))
|
||||
|
|
|
|||
|
|
@ -4,6 +4,7 @@
|
|||
racket/generic
|
||||
racket/contract/base
|
||||
racket/contract/combinator
|
||||
racket/function
|
||||
racket/generator
|
||||
(rename-in "private/for.rkt"
|
||||
[stream-ref stream-get-generics])
|
||||
|
|
@ -335,17 +336,13 @@
|
|||
(define ((make-for/stream derived-stx) stx)
|
||||
(syntax-case stx ()
|
||||
[(_ clauses . body)
|
||||
(begin
|
||||
(when (null? (syntax->list #'body))
|
||||
(raise-syntax-error (syntax-e #'derived-stx)
|
||||
"missing body expression after sequence bindings"
|
||||
stx #'body))
|
||||
(with-syntax ([((pre-body ...) body*) (split-for-body stx #'body)])
|
||||
#`(sequence->stream
|
||||
(in-generator
|
||||
(#,derived-stx #,stx () clauses
|
||||
pre-body ...
|
||||
(yield (let () . body*))
|
||||
(values))))))]))
|
||||
(values (make-for/stream #'for/fold/derived)
|
||||
(make-for/stream #'for*/fold/derived))))
|
||||
(with-syntax ([((pre-body ...) (post-body ...)) (split-for-body stx #'body)])
|
||||
(quasisyntax/loc stx
|
||||
(#,derived-stx #,stx
|
||||
([get-rest empty-stream]
|
||||
#:delay-with thunk)
|
||||
clauses
|
||||
pre-body ...
|
||||
(stream-cons (let () post-body ...) (get-rest)))))]))
|
||||
(values (make-for/stream #'for/foldr/derived)
|
||||
(make-for/stream #'for*/foldr/derived))))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user