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)

Much simpler leak-free implementation possible? Andre van Tonder 14 Aug 2003 22:38 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

;---------------------------------------------------------------------------