(defun flatten (x &optional y)
  (declare (optimize (speed 3) (safety 0)))
  (cond
    ((null x)
     (cond
       ((null y) nil)
       ((listp (car y))
        (flatten (car y) (cdr y)))
       (t (cons (car y) (flatten (cdr y))))))
    ((listp (car x))
     (flatten (car x) (if y (list (cdr x) y) (cdr x))))
    (t (cons (car x) (flatten (cdr x) y)))))

(defun flatten-1 (l)
  (declare (optimize (speed 3) (safety 0)))
  (cond
    ((null l) nil)
    ((atom l) (list l))
    (t (loop for a in l appending (flatten-1 a)))))

(defun flatten-2 (l)
  (declare (optimize (speed 3) (safety 0)))
  (when l
    (if (atom l)
	(list l)
	(mapcan #'flatten-2 l))))

(defun flatten-3 (x)
  (declare (optimize (speed 3) (safety 0)))
  (do ((a x))
      ((null a))
    (if (consp (car a))
        (do ((b (car a) (cdr b))
             (c a)
             (d (cdr a)))
            ((null b)
             (and (setf (cdr c) d) nil))
          (setf (car c) (car b)
                (cdr c) (cdr b)
                c (or (cdr c) c)))
        (setf a (cdr a)))) x)

(defun flatten-4 (l)
  (declare (optimize (speed 3) (safety 0)))
  (cond
    ((null l) nil)
    ((atom l) (list l))
    (t (loop for a in l nconcing (flatten-4 a)))))

(defun flatten-5 (x &aux (res (list nil)))
  (declare (optimize (speed 3) (safety 0)))
  (do ((x x) (y nil) (r res))
      (nil)
    (cond
      ((null x)
       (cond
         ((null y) (return-from flatten-5 (cdr res)))
         ((listp (car y))
          (setq x (car y) y (cdr y)))
         (t (rplacd r (list (car y)))
            (setq r (cdr r)
                  x (cdr y)
                  y nil))))
      ((listp (car x))
       (setq y (if y (list (cdr x) y) (cdr x))
             x (car x)))
      (t (rplacd r (list (car x)))
         (setq r (cdr r)
               x (cdr x))))))

(defun test-flatten (data)
  (declare (optimize (speed 3) (safety 0)))
  (let ((test (get-internal-real-time)))
    (dotimes (i 1e6) (flatten data))
    (print (- (get-internal-real-time) test))
    (setf test (get-internal-real-time))
    (dotimes (i 1e6) (flatten-1 data))
    (print (- (get-internal-real-time) test))
    (setf test (get-internal-real-time))
    (dotimes (i 1e6) (flatten-2 data))
    (print (- (get-internal-real-time) test))
    (setf test (get-internal-real-time))
    (dotimes (i 1e6)
      (flatten-3 (copy-tree data)))
    (print (- (get-internal-real-time) test))
    (setf test (get-internal-real-time))
    (dotimes (i 1e6) (flatten-4 data))
    (print (- (get-internal-real-time) test))
    (setf test (get-internal-real-time))
    (dotimes (i 1e6) (flatten-5 data))
    (print (- (get-internal-real-time) test))
    (print "--------------------- finished")))

(let* ((data '(1 2 (3 4) (5 (6 (7 8) 9 a (10))) b (10.5 (1.6) (1.7)) 11))
       (data-1 (do ((i 10 (1- i)) (x))
		   ((zerop i) (return x))
		 (setf x (append x data))))
       (data-2 (do ((i 10 (1- i)) (x))
		   ((zerop i) (return x))
		 (setf x (append x data-1)))))
  (format t "data: ~s~&data-1: ~s~& data-2: ~s~&"
	  data data-1 data-2)
  (test-flatten data)
  (test-flatten data-1)
  (test-flatten data-2))

;; 890 
;; 2806 
;; 4735 
;; 686 
;; 811 
;; 414 
;; --------------------- finished
;; 3729 
;; 12915 
;; 21658 
;; 6584 
;; 7269 
;; 3391 
;; --------------------- finished
;; 50071 
;; 133508 
;; 215169 
;; 73918 
;; 70899 
;; 33164 
;; --------------------- finished