From oleg-at-pobox.com Mon Oct 20 14:24:16 1997
Date: Mon, 20 Oct 1997 13:24:14 -0600
From: oleg-at-pobox.com
Subject: Flattening a (cyclic) list by a lazy virus
Newsgroups: comp.lang.scheme
Message-Id: <877371550.4494@dejanews.com>
Keywords: promise, lazy evaluation, recursive data structure, Scheme
Summary: lazy evaluation and lazy recursion in flattening a (cyclic) list
X-Article-Creation-Date: Mon Oct 20 18:19:12 1997 GMT
X-Http-User-Agent: Mozilla/3.0 (Macintosh; I; 68K)
Status: RO

[This is a courtesy copy of an article posted to Usenet via Deja News]

Here's another take on a list flattening problem that has been discussed
at some length on this newsgroup. The problem was, given a list that may
contain embedded lists, return the list of all atomic elements regardless
of their nesting depth.

The following function solves the problem in, hmm, less traditional way.
The function accesses each atomic element of the original list exactly
once. Furthermore, neither of the atomic elements are cloned, duplicated
or even moved in memory. The flattener returns a promise, which when
forced, returns a pair of a current atomic element and a promise to give
more... Note that the function is tail-recursive _and_ tail-infective. It
works like a virus, inserting itself into a newly made "cell"...

(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)))

Some Scheme implementations provide for automatic forcing of car, cdr,
etc. arguments (as R4RS permits). The following definitions would be
unnecessary then. Alas, not in Gambit 2.5: it only touches, but does not
force ...
(define (fcar x) (car (force x)))
(define (fcdr x) (cdr (force x)))
(define (fnull? x) (null? (force x)))

(define (print-l x)
  (display " (")
  (cond
    ((fnull? x) (display ") "))
    (else
      (display (fcar x))
      (do ((x (fcdr x) (fcdr x))) ((fnull? x) (display ") "))
        (display #\space)
        (display (fcar x))))))

Here's the example how the flattener works:

(print-l (flatten '((1 (2)) () (3 (4 (5 (6 7 8 ())))))))
	(1 2 3 4 5 6 7 8)

The present flattener can even deal with the data structures no one sane
function is expected to handle. I mean, cyclic lists:
(define (cyclic-list . x)
  (if (null? x) x
    (do ((head x) (tail x (cdr tail)))
        ((null? (cdr tail)) (set-cdr! tail head) head))))

	; Print at most n elements from the list x
	; We don't want to use display or other list function
	; to handle an _infinite_ data structure...
(define (print-n n x)
  (do ((i 0 (++ i)) (x x (fcdr x)))
      ((or (>= i n) (fnull? x)) (newline))
      (cout i ": " (fcar x) nl)))

Let's see how it works...
> (define t5 (cyclic-list '() 1 '(2 (3)) 4 '((5 ()))))
> (print-n 20 t5)
0: ()
1: 1
2: (2 (3))
3: 4
4: ((5 ()))
5: ()
6: 1
7: (2 (3))
8: 4
9: ((5 ()))
10: ()
11: 1
12: (2 (3))
13: 4
14: ((5 ()))
15: ()
16: 1
17: (2 (3))
18: 4
19: ((5 ()))

Appears quite cyclic to me.

> (print-n 20 (flatten t5))
0: 1
1: 2
2: 3
3: 4
4: 5
5: 1
6: 2
7: 3
8: 4
9: 5
10: 1
11: 2
12: 3
13: 4
14: 5
15: 1
16: 2
17: 3
18: 4
19: 5

Looks like it works...