(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 (listp (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)
;; 353
;; 2056
;; 1230
;; 63
(let ((test (get-internal-real-time)))
(dotimes (i 1e6)
(flatten '(1 2 (3 4) (5 (6 (7 8) 9 a (10))) b (10.5 (1.6) (1.7)) 11)))
(print (- (get-internal-real-time) test))
(setf test (get-internal-real-time))
(dotimes (i 1e6)
(flatten-2 '(1 2 (3 4) (5 (6 (7 8) 9 a (10))) b (10.5 (1.6) (1.7)) 11)))
(print (- (get-internal-real-time) test))
(setf test (get-internal-real-time))
(dotimes (i 1e6)
(flatten-1 '(1 2 (3 4) (5 (6 (7 8) 9 a (10))) b (10.5 (1.6) (1.7)) 11)))
(print (- (get-internal-real-time) test))
(setf test (get-internal-real-time))
(dotimes (i 1e6)
(flatten-3 '(1 2 (3 4) (5 (6 (7 8) 9 a (10))) b (10.5 (1.6) (1.7)) 11)))
(print (- (get-internal-real-time) test)))