Tail recursive flatten in Common Lisp

flatten.cl

(defun flatten (lst &optional backtrack acc)
  (cond ((consp lst) (flatten (car lst) (cons (cdr lst) backtrack) acc))
        (lst         (flatten (car backtrack) (cdr backtrack) (cons lst acc)))
        (backtrack   (flatten (car backtrack) (cdr backtrack) acc))
        (t (nreverse acc))))

a direct translation of your code:

(defun flatten (lst &optional back acc)
  (loop
     (cond 
        ((consp lst) (setq back (cons (cdr lst) back)
                           lst (car lst)))
        (lst         (setq acc (cons lst acc)
                           lst (car back) 
                           back (cdr back)))
        (back        (setq lst (car back) 
                           back (cdr back)))
        (t     (return (nreverse acc))))))

after some more tweaking, here's one without the reversing in the end, although it does the reversing while working:

(defun flatten (lst &optional back acc)
  (loop
     (cond 
        ((consp lst) (setq back (cons (car lst) back)
                           lst (cdr lst)))
        (back
                  (if (consp (car back))  
                    (setq lst (cdar back)
                          back (cons (caar back) (cdr back)))
                    (setq acc (cons (car back) acc)
                          back (cdr back))))
        (t     (return acc)))))

PSETQ is much safer to use than SETQ though, no timing issues.