Variations on a theme

My friend Zyni wrote a comment to a thread on reddit with some variations on a list-flattening function. We’ve since spent some time thinking about things related to this, which is written up in a following article. Here is her comment so the following article can refer to it. Other than notes at the end the following text is Zyni’s, not mine.

The reddit comment by Zyni

First of all we all know that CL does not promise to optimize tail recursion: means that tail recursive program may generate recursive not iterative process. So recursive program in CL even if tail recursive is not safe on data of unknown size, assuming stack is limited.

But let us assume as good implementations do that tail recursion is optimized in implementation (no need for general tail calls here but is obvious nice thing if implementations do this). Certainly if we are deploying code in space we know what implementation we use and can check this.

So we look at this supposed wonder of code, which I rewrite slightly to use iterate macro which is simply Scheme’s named-let to be compatible with later examples:

(defun flatten (o)
  ;; original terrible one
  (iterate ftn ((x o) (accumulator '()))
    (typecase x
      (null accumulator)
      (cons (ftn (car x) (ftn (cdr x) accumulator)))
      (t (cons x accumulator)))))

This … is really bad program. It makes an essential mistake that it wishes to build result forwards but lists wish to be built backwards, so it must therefore recurse (not tail) on cdr of structure first. But most list-based structures have little weight in car but much in cdr, so this will fail even on list which is already flat: (flatten (make-list 100000 :initial-element 1)) will fail if your example fails.

Any person presenting this code as good example should be ashamed of self.

So first change: we accept that we must build lists backwards but we change program so that tail call is on cdr not car, and reverse result:

(defun flatten (o)
  ;; not TR but better on usual assumptions
  (nreverse
   (iterate ftn ((x o) (accumulator '()))
     (typecase x
       (null accumulator)
       (cons (ftn (cdr x) (ftn (car x) accumulator)))
       (t (cons x accumulator))))))

This function will be fine on assumption of structures which have most weight in their cdrs, which often is true.

Well, you say, ugly reverse. OK this is easy: we simply add in a collecting macro which allows construction of list forwards, implementation is obvious (tail pointer). Now we have done this we can also reorder calls to be more obvious (car call, not TR, is now first):

(defun flatten (o)
  ;; not TR, better on usual assumptions, no reverse
  (collecting
    (iterate ftn ((x o))
      (typecase x
        (cons
         (ftn (car x))
         (ftn (cdr x)))
        (null)
        (t (collect x))))))

This is still not fully TR, so will fail on structures which have much weight in car.

Well, of course, we can deal with this as well: we use explicit agenda to move stack onto heap and turn into pure tail recursive version. First one which builds list backwards in obvious way, therefore needs reverse again:

(defun flatten (o)
  ;; pure TR
  (iterate ftn ((agenda (list o))
                (accumulator '()))
    (if (null agenda)
        ;; can write own reverse as tail recursive of course if wish
        ;; to be pure of heart
        (nreverse accumulator)
      (destructuring-bind (this . more) agenda
        (typecase this
          (null
           (ftn more accumulator))
          (cons
           (ftn (list* (car this) (cdr this) more) accumulator))
          (t
           (ftn more (cons this accumulator))))))))

Assuming implementation optimizes tail recursion this will flatten completely arbitrary structure limited only by memory.

We can avoid this reversery of course:

(defun flatten (o)
  ;; pure TR, no reverse
  (collecting
    (iterate ftn ((agenda (list o)))
      (when (not (null agenda))
        (destructuring-bind (this . more) agenda
          (typecase this
            (null
             (ftn more))
            (cons
             (ftn (list* (car this) (cdr this) more)))
            (t
             (collect this)
             (ftn more))))))))

As before this is limited only by memory assuming implementation optimizes tail calls.

Well, I have written Lisp for only couple of years really (but have maths background). But even I can see that this idea of having to put scary label on recursive function is very bad. Instead people using such code should perhaps read it and understand it to see what its problems and advantages are. Radical idea, I know.

Finally idea that stack space is scarce may or may not be true. Example, if we rewrite original version in Racket (first Lisp I used before being lured to dark side):

(define (flatten o)
  (let ftn ([x o] [accumulator '()])
    (cond
      [(null? x) accumulator]
      [(cons? x) (ftn (car x) (ftn (cdr x) accumulator))]
      [else (cons x accumulator)])))

This will happily ‘flatten’ 100,000 element list and is only limited by memory available because Racket does not treat stack same way.

Finally here is variant of final version using looping macro which does applicative iteration: this is iterative, on any implementation:

(defun flatten (o)
  ;; Iterative
  (collecting
    (looping ((agenda (list o)))
      (when (null agenda)
        (return))
      (destructuring-bind (this . more) agenda
        (typecase this
          (null more)
          (cons (list* (car this) (cdr this) more))
          (t (collect this) more))))))

looping part of this turns into:

(let ((agenda (list o)))
  (block nil
    (tagbody
     #:start (setq agenda
                   (progn
                     (when (null agenda) (return))
                     (destructuring-bind (this . more) agenda
                       (typecase this
                         (null more)
                         (cons (list* (car this) (cdr this) more))
                         (t (collect this) more)))))
             (go #:start))))

which is iterative.

I think iterate one is nicer.

Notes from Tim

English is Zyni’s third language: she wanted me to fix up the above but I refused as I find the way she writes so charming.

Both of us would like to know how often flatten is actually used: everyone seems to be very keen on it, but we can’t think of any cases where we’ve ever wanted it or anything very much like it.

All of the macros referenced are ‘mine’ in a somewhat loose sense: They’re all published by me, and some of them are mine, some of them were mine but have been made much better by Zyni, some of them are really hers. There are generally comments in the code. Zyni refuses to have anything but a very minimal internet presence for reasons I used to think were absurd but no longer do: you can’t be too careful when your parents and by extension you might be on the wrong side of Putin.

Zyni is not her real name, obviously.