Lazily flattening trees with a gopher

Show & Tell
1

One of the bits of Scheme code on Oleg Kiselyov's site
is an implementation of flatten that uses delay to lazily do its thing:

(define (flatten x)
  (define (does-flatten x)
    (if (not (pair? x)) x
        (cond
          ((null? (car x)) (does-flatten (cdr x)))
          ((not (pair? (car x)))
           (cons (car x) (delay (does-flatten (cdr x)))))
          (else
           (does-flatten
            (cons (caar x) (cons (cdar x) (cdr x))))))))
  (delay (does-flatten x)))

Because it's lazy, it can work with circular lists that would send an eager version into an infinite loop. The downside is that it requires more of a framework to convert to a regular list - his article includes alternatives to car, cdr, etc. that force their arguments, and a print function that uses them. For this sort of lazy construction, I prefer streams. It's still the same basic idea; the two are equivalent, it's just one is easier to work with because you can leverage the existing stream library functions.

(define (flatten x)
  (define (does-flatten x)
    (cond
      [(null? x) empty-stream]
      [(not (pair? x)) (stream x)]
      [(null? (car x)) (does-flatten (cdr x))]
      [(not (pair? (car x))) (stream-cons (car x) (does-flatten (cdr x)))]
      [else (does-flatten (cons (caar x) (cons (cdar x) (cdr x))))]))
  (stream-lazy (does-flatten x)))

(println (stream->list (flatten '((1 (2)) () (3 (4 (5 (6 7 8 ())))))))) ; '(1 2 3 4 5 6 7 8)

The other interesting bit about this is in how it finds the leaf values - using a technique known as a gopher (Invented by John McCarthy. Yes, that John McCarthy) to recursively pull the next leftmost non-pair value up to the head of the tree structure where it then gets added to the returned value. The key to that is the (cons (caar x) (cons (cdar x) (cdr x))) bit, which will turn a tree like ((a b) (c d)) into (a (b) (c d)) so that a will then be stream-consed by the recursive call to does-flatten. It then recurs with ((b) (c d)) and so on. The idea that it was okay to alter a data structure as you traverse it into a more convenient form instead of leaving it static was a real a-ha moment the first time I saw it.

And its final form, using pattern matching to destructure the tree instead of all those pair?s cars, caars, cdrs, etc.

(define (flatten x)
  (define/match (does-flatten x)
    [('()) empty-stream]
    [((not (cons _ _))) (stream x)]
    [((cons '() rest)) (does-flatten rest)]
    [((cons (and (not (cons _ _)) head) rest)) (stream-cons head (does-flatten rest))]
    [((cons (cons left right) rest)) (does-flatten (list* left right rest))])
  (stream-lazy (does-flatten x)))