This page is part of the web mail archives of SRFI 40 from before July 7th, 2015. The new archives for SRFI 40 contain all messages, not just those from before July 7th, 2015.
Although late in the process and a newcomer to this group, the
following may be of some interest:
After being bewildered by the complexity of the reference
unfold and stream-filter examples, especially in the context of
generalizing the patterns to arbitrary lazy data structures, I came
up with the following "proof of concept", which uses a CPS-style delay
and force and
* is free of leaks (caveat - only tested in MzScheme)
* correctly implements even streams
* vastly simplifies the correct implementation of
functions such as filter or unfold.
* makes it almost as easy to add new stream primitives
as it is to define new list functions.
* may be generalized quite easily to other lazy data
structures.
* seems quite efficient
The idea is adapted from a usenet message
by Stephen McCracken. The ease of programming in this style
almost seems to suggest that a CPS-like transformation is
the (?) natural way to express lazy structures in a strict
language.
For example, the definition of filter can be trivially adapted
from the corresponding definition for lists according to a regular
pattern (see below for full definitions):
(define (stream-filter p? s)
(codelay (lambda (k)
(stream-filter* p? s k))))
(define (stream-filter* p? s k)
(coforce s (lambda (s*)
(match s*
[() (k '())]
[(h . t) (if (p? h)
(k (cons h (stream-filter p? t)))
(stream-filter* p? t k))]))))
Here stream-filter takes an even stream and gives back an
even stream. It relies on stream-filter* that takes an even stream
and gives back an odd stream. The important point is that
stream-filter* may be regarded as effectively *tail-recursive*
(the second argument of coforce is a continuation) and this is what
prevents the space leak.
In addition, we don't have to wrap the constructors in the second
function in delays. It is, however, equivalent to the definitions
for even streams in the reference implementation via reductions of
the form (force (delay x)) -> x.
Unfold follows exactly the same pattern, and is trivial compared to
the reference implementation (the following is a somewhat less general
form):
;; unfold : (b -> (#f | (cons (a | 'drop) b)) b -> stream a
(define (unfold f seed)
(codelay (lambda (k)
(unfold* f seed k))))
(define (unfold* f seed k)
(cond [(f seed) => (lambda (res)
(match res
[() (k 'error)]
[(h . t) (if (eq? h 'drop)
(unfold* f t k)
(k (cons h (unfold f t))))]))]
[else (k '())]))
Once again, we are save froma space leak because unfold* may be regarded
as "effectively tail-recursive".
Just to fix the pattern, here is another example:
(define (drop-until p? s)
(codelay (lambda (k)
(drop-until* p? s k))))
(define (drop-until* p? s k)
(coforce s (lambda (s*)
(match s*
[() #f]
[(h . t) (if (p? h)
(k s*)
(drop-until* p? t k))]))))
Another example: Filter may be alternatively defined using unfold:
(define (stream-filter1 p? s)
(unfold (lambda (s)
(coforce s (lambda (s*)
(match s*
[() #f]
[(h . t) (if (p? h)
(cons h t)
(cons 'drop t))]))))
s))
Code and tests are below.
Best regards
Andre van Tonder
;=====================================================================
; Even CPS-style streams:
; 2003 - Andre van Tonder:
;
; ====================================================================
; CPS-style co-delay and co-force primitives:
(define-syntax codelay
(syntax-rules ()
[(codelay thunk-cps)
(let ([memo-pair (cons #f #f)])
(lambda (k*)
(if (car memo-pair)
(k* (cdr memo-pair))
(thunk-cps (make-memoizer memo-pair k*)))))]))
(define (make-memoizer memo-pair k)
(lambda (x)
(set-car! memo-pair #t)
(set-cdr! memo-pair x)
(k x)))
(define (coforce promise k) (promise k))
;=====================================================================
; Convenience macro for deconstructing lists:
(define-syntax match
(syntax-rules ()
[(match lst
[() exp1]
[(h . t) exp2])
(cond [(null? lst) exp1]
[(pair? lst) (let ([h (car lst)]
[t (cdr lst)])
exp2)]
[else 'match-error])]))
;=====================================================================
; stream-filter for even streams. Broken into two functions to take
; advantage of effective tail recursion.
(define (stream-filter p? s)
(codelay (lambda (k)
(stream-filter* p? s k))))
(define (stream-filter* p? s k)
(coforce s (lambda (s*)
(match s*
[() (k '())]
[(h . t) (if (p? h)
(k (cons h (stream-filter p? t)))
(stream-filter* p? t k))]))))
;=======================================================================
; Unfold follows the same pattern:
;; unfold : (b -> (#f | (cons (a | 'drop) b)) b -> stream a
(define (unfold f seed)
(codelay (lambda (k)
(unfold* f seed k))))
(define (unfold* f seed k)
(cond [(f seed) => (lambda (res)
(match res
[() (k 'error)]
[(h . t) (if (eq? h 'drop)
(unfold* f t k)
(k (cons h (unfold f t))))]))]
[else (k '())]))
;=======================================================================
; Alternative definition of filter using unfold:
(define (stream-filter1 p? s)
(unfold (lambda (s)
(coforce s (lambda (s*)
(match s*
[() #f]
[(h . t) (if (p? h)
(cons h t)
(cons 'drop t))]))))
s))
;=========================================================================
; Additional useful functions:
(define (integers-from n)
(codelay (lambda (k)
(k (cons n (integers-from (+ n 1)))))))
(define (stream-ref index s)
(coforce s (lambda (s*)
(match s*
[() (error 'stream-ref)]
[(h . t) (if (zero? index)
h
(stream-ref (- index 1) t))]))))
(define (drop-until p? s)
(codelay (lambda (k)
(drop-until* p? s k))))
(define (drop-until* p? s k)
(coforce s (lambda (s*)
(match s*
[() #f]
[(h . t) (if (p? h)
(k s*)
(drop-until* p? t k))]))))
;==========================================================================
;=========================================================================
; TESTS:
;---------------------------------------------------------------------------
----
; Test that even streams correctly implemented. If an off-by-one error
; exited, this would not terminate:
(stream-ref 0 (stream-filter
zero?
(integers-from 0)))
;==> 0
;-------------------------------------------------------------------------
; Test drop-until for space leak:
; This should give an infinite loop in constant space -
; MzScheme passes this:
;(stream-ref 0 (drop-until zero? (integers-from 1)))
;-------------------------------------------------------------------------
; Test filter for space leak:
; Use times3 with large enough number.
(define (times3 n)
(stream-ref 3 (stream-filter
(lambda (x) (zero? (modulo x n)))
(integers-from 0))))
(times3 7) ; ==> 21
;(times3 100000000) ; ==> should run in constant space
;--------------------------------------------------------------------------
; Test unfold for space leak (filter1 is defined i.t.o. unfold)
(define (times3* n)
(stream-ref 3 (stream-filter1
(lambda (x) (zero? (modulo x n)))
(integers-from 0))))
(times3* 7) ; ==> 21
(times3* 100000000) ; ==> should run in constant space
;---------------------------------------------------------------------------