The seventh L-99 problem, MY-FLATTEN, highlights the richness of Common Lisp’s operators on conses.

In Common Lisp, a structure of conses can represent either: a) a list, where the car of each cons points to the element, and the cdr points to the next cons or a terminating atom; or b) a tree, where the car and cdr, both, can point to subtrees of conses or to atoms, the leaves of the tree.

MY-FLATTEN is defined not for trees but for lists, possibly with nested lists as elements. MY-FLATTEN must observe the separate list structures of the list and any nested lists: the first cons of a nested list is not part of the structure of the parent list.

To illustrate, compare the expected behaviour of MY-FLATTEN with a function LEAVES that traverses a tree, collecting the terminal atoms:

(defun leaves (tree)
  (labels ((recur (tree list)
             (if (consp tree)
                 (recur (car tree) (recur (cdr tree) list))
                 (cons tree list))))
    (recur tree '())))

(leaves '(a (b (c . d) nil e) nil . f))
=> (A B C D NIL E NIL NIL F)

(my-flatten '(a (b (c . d) nil e) nil . f))
=> (A B C D NIL E NIL F)

(leaves 'a)
=> A

(my-flatten 'a) ; TYPE-ERROR

When the list literal above is interpreted as a tree, the terminal NILs are revealed; they aren’t by MY-FLATTEN.

Note, in the above example, that MY-FLATTEN is assumed to accept proper or dotted lists and nested lists, and that the resulting “flattened” list will not be dotted in any case.

MY-FLATTEN, then, should work as follows:

(my-flatten 42) ; TYPE-ERROR
(my-flatten '()) => '()
(my-flatten '(a b c d e)) => (A B C D E)
(my-flatten '(a b c d nil e nil)) => (A B C D NIL E NIL)
(my-flatten '(a b c d . e)) => (A B C D E)
(my-flatten '((a) b c d e)) => (A B C D E)
(my-flatten '(a (b) c d e)) => (A B C D E)
(my-flatten '(a b (c) d e)) => (A B C D E)
(my-flatten '(a b c (d) e)) => (A B C D E)
(my-flatten '(a b c d (e))) => (A B C D E)
(my-flatten '(a b (c) d . e)) => (A B C D E)
(my-flatten '(a b c (d) . e)) => (A B C D E)
(my-flatten '(a b c (d . e))) => (A B C D E)
(my-flatten '(a (b (c d) e))) => (A B C D E)
(my-flatten '(a (b (c d) . e))) => (A B C D E)
(my-flatten '(a (b (c . d) e))) => (A B C D E)
(my-flatten '(a (b (c . d) nil e) nil)) => (A B C D NIL E NIL)

Compared to LEAVES, the definition of MY-FLATTEN is complicated by handling nested list structures and dotted lists.

The following skeleton identifies the cases for traversing a proper or dotted list structure and letting REST blame MY-FLATTEN if the argument, list, is not a list (FIRST and REST are used instead of CAR and CDR to emphasise the traversal of lists rather than trees):

(defun my-flatten (list)
  (labels ((recur (list new-list)
             (cond ((consp (rest list))
                    ;; follow list structure
                    ... list ... new-list ...)

                   ((not (null (rest list)))
                    ;; last cons of dotted list
                    ... list ... new-list ...)

                   ((consp list)
                    ;; last cons of proper list
                    ... list ... new-list ...)

                   (t
                    ;; terminating NIL of proper list
                    new-list))))
    (nreverse (recur list '()))))

In each of the first three cases, before proceeding, MY-FLATTEN must flatten a nested list if one exists:

(defun my-flatten (list)
  (labels ((recur (list new-list)
             (cond ((consp (rest list))
                    (if (consp (first list))
                        ;; flatten nested list, then follow list
                        ;; structure
                        ... list ... new-list ...
                        ;; follow list structure
                        ... list ... new-list ...))

                   ((not (null (rest list)))
                    (if (consp (first list))
                        ;; flatten nested list, then last cons of
                        ;; dotted list
                        ... list ... new-list ...
                        ;; last cons of dotted list
                        ... list ... new-list ...))

                   ((consp list)
                    (if (consp (first list))
                        ;; flatten nested list, then last cons of
                        ;; proper list
                        ... list ... new-list ...
                        ;; last cons of proper list
                        ... list ... new-list ...))

                   (t
                    new-list))))
    (nreverse (recur list '()))))

Finally, then:

(defun my-flatten (list)
  (labels ((recur (list new-list)
             (cond ((consp (rest list))
                    (if (consp (first list))
                        (recur (rest list)
                               (recur (first list) new-list))
                        (recur (rest list)
                               (cons (first list) new-list))))
                   ((not (null (rest list)))
                    (if (consp (first list))
                        (cons (rest list)
                              (recur (first list) new-list))
                        (cons (rest list)
                              (cons (first list) new-list))))
                   ((consp list)
                    (if (consp (first list))
                        (recur (first list) new-list)
                        (cons (first list) new-list)))
                   (t
                    new-list))))
    (nreverse (recur list '()))))

MY-FLATTEN should exhibit time and space complexities, both, of O(n^m), where “n” is the length of a list, top level or nested, and “m” is the depth of nesting. The run times (non-GC) and consed bytes of the following rough benchmarks suggest as much:

(defun benchmark (function data count)
  (let ((result))
    (cl-user::gc :all t)
    (time (dotimes (i count) (setf result (funcall function data))))))

CL-USER> (compile 'my-flatten)
=> MY-FLATTEN

CL-USER> (dolist (n '(100 1000 10000))
           (benchmark #'my-flatten (loop for i below n collect i) 1000))
Evaluation took:
  0.002 seconds of real time
  0.001000 seconds of total run time (0.001000 user, 0.000000 system)
  50.00% CPU
  3,252,278 processor cycles
  798,720 bytes consed

Evaluation took:
  0.013 seconds of real time
  0.012998 seconds of total run time (0.012998 user, 0.000000 system)
  100.00% CPU
  25,410,202 processor cycles
  7,999,488 bytes consed

Evaluation took:
  0.164 seconds of real time
  0.164975 seconds of total run time (0.160976 user, 0.003999 system)
  [ Run times consist of 0.030 seconds GC time, and 0.135 seconds non-GC time. ]
  100.61% CPU
  327,087,555 processor cycles
  80,010,016 bytes consed

=> NIL

CL-USER> (progn
          (benchmark #'my-flatten
                     (loop for i below 100 collect i)
                     1000)
          (benchmark #'my-flatten
                     (loop for i below 100 collect
                           (loop for j below 100 collect j))
                     1000)
          (benchmark #'my-flatten
                     (loop for i below 100 collect
                           (loop for j below 100 collect
                                 (loop for k below 100 collect k)))
                     1000))
Evaluation took:
  0.002 seconds of real time
  0.001999 seconds of total run time (0.001999 user, 0.000000 system)
  100.00% CPU
  3,193,193 processor cycles
  798,720 bytes consed

Evaluation took:
  0.163 seconds of real time
  0.164975 seconds of total run time (0.152977 user, 0.011998 system)
  [ Run times consist of 0.031 seconds GC time, and 0.134 seconds non-GC time. ]
  101.23% CPU
  326,155,035 processor cycles
  80,006,376 bytes consed

Evaluation took:
  74.040 seconds of real time
  74.008748 seconds of total run time (66.343914 user, 7.664834 system)
  [ Run times consist of 58.111 seconds GC time, and 15.898 seconds non-GC time. ]
  99.96% CPU
  147,707,388,885 processor cycles
  8,000,104,416 bytes consed

=> NIL

Rewriting MY-FLATTEN using tail recursive calls would not reduce the order of growth in space required to construct the resulting list; the list must be built regardless. Doing so, however, would, in most Common Lisp implementations, prevent exhaustion of the call stack.

The L-99 solution is simpler than MY-FLATTEN, but it doesn’t solve the same problem: it fails on dotted lists and discards elements that are NIL.

Pascal J. Bourguignon provides four alternative solutions. Of the three recursive implementations only that with the worst performance works on dotted lists. The iterative one, referred to here as PJB-FLATTEN-3, avoids stack exhaustion and works on dotted lists. However, the behaviour of PJB-FLATTEN-3 belies its intent.

While the source and comment for PJB-FLATTEN-3 name its parameter “tree”, it certainly doesn’t collect the leaves of a Common Lisp tree:

CL-USER> (PB-FLATTEN-3 'NIL)
=> NIL ; Expected (NIL)

CL-USER> (PB-FLATTEN-3 '(A B C D E))
=> (A B C D E) ; Expected (A B C D E NIL)

CL-USER> (PB-FLATTEN-3 '(A (B (C . D) NIL E) NIL))
=> (A B C D E) ; Expected (A B C D NIL E NIL NIL NIL)