Much simpler leak-free implementation possible? Andre van Tonder (14 Aug 2003 22:38 UTC)
|
Re: Much simpler leak-free implementation possible?
Andre van Tonder
(16 Aug 2003 14:07 UTC)
|
Re: Much simpler leak-free implementation possible?
Phil Bewig
(18 Aug 2003 14:53 UTC)
|
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 ;---------------------------------------------------------------------------