1. (defun flatten (x &optional y)
  2.   (declare (optimize (speed 3) (safety 0)))
  3.   (cond
  4.     ((null x)
  5.      (cond
  6.        ((null y) nil)
  7.        ((listp (car y))
  8.         (flatten (car y) (cdr y)))
  9.        (t (cons (car y) (flatten (cdr y))))))
  10.     ((listp (car x))
  11.      (flatten (car x) (if y (list (cdr x) y) (cdr x))))
  12.     (t (cons (car x) (flatten (cdr x) y)))))
  13.  
  14. (defun flatten-1 (l)
  15.   (declare (optimize (speed 3) (safety 0)))
  16.   (cond
  17.     ((null l) nil)
  18.     ((atom l) (list l))
  19.     (t (loop for a in l appending (flatten-1 a)))))
  20.  
  21. (defun flatten-2 (l)
  22.   (declare (optimize (speed 3) (safety 0)))
  23.   (when l
  24.     (if (atom l)
  25.     (list l)
  26.     (mapcan #'flatten-2 l))))
  27.  
  28. (defun flatten-3 (x)
  29.   (declare (optimize (speed 3) (safety 0)))
  30.   (do ((a x))
  31.       ((null a))
  32.     (if (consp (car a))
  33.         (do ((b (car a) (cdr b))
  34.              (c a)
  35.              (d (cdr a)))
  36.             ((null b)
  37.              (and (setf (cdr c) d) nil))
  38.           (setf (car c) (car b)
  39.                 (cdr c) (cdr b)
  40.                 c (or (cdr c) c)))
  41.         (setf a (cdr a)))) x)
  42.  
  43. (defun flatten-4 (l)
  44.   (declare (optimize (speed 3) (safety 0)))
  45.   (cond
  46.     ((null l) nil)
  47.     ((atom l) (list l))
  48.     (t (loop for a in l nconcing (flatten-4 a)))))
  49.  
  50. (defun flatten-5 (x &aux (res (list nil)))
  51.   (declare (optimize (speed 3) (safety 0)))
  52.   (do ((x x) (y nil) (r res))
  53.       (nil)
  54.     (cond
  55.       ((null x)
  56.        (cond
  57.          ((null y) (return-from flatten-5 (cdr res)))
  58.          ((listp (car y))
  59.           (setq x (car y) y (cdr y)))
  60.          (t (rplacd r (list (car y)))
  61.             (setq r (cdr r)
  62.                   x (cdr y)
  63.                   y nil))))
  64.       ((listp (car x))
  65.        (setq y (if y (list (cdr x) y) (cdr x))
  66.              x (car x)))
  67.       (t (rplacd r (list (car x)))
  68.          (setq r (cdr r)
  69.                x (cdr x))))))
  70.  
  71. (defun test-flatten (data)
  72.   (declare (optimize (speed 3) (safety 0)))
  73.   (let ((test (get-internal-real-time)))
  74.     (dotimes (i 1e6) (flatten data))
  75.     (print (- (get-internal-real-time) test))
  76.     (setf test (get-internal-real-time))
  77.     (dotimes (i 1e6) (flatten-1 data))
  78.     (print (- (get-internal-real-time) test))
  79.     (setf test (get-internal-real-time))
  80.     (dotimes (i 1e6) (flatten-2 data))
  81.     (print (- (get-internal-real-time) test))
  82.     (setf test (get-internal-real-time))
  83.     (dotimes (i 1e6)
  84.       (flatten-3 (copy-tree data)))
  85.     (print (- (get-internal-real-time) test))
  86.     (setf test (get-internal-real-time))
  87.     (dotimes (i 1e6) (flatten-4 data))
  88.     (print (- (get-internal-real-time) test))
  89.     (setf test (get-internal-real-time))
  90.     (dotimes (i 1e6) (flatten-5 data))
  91.     (print (- (get-internal-real-time) test))
  92.     (print "--------------------- finished")))
  93.  
  94. (let* ((data '(1 2 (3 4) (5 (6 (7 8) 9 a (10))) b (10.5 (1.6) (1.7)) 11))
  95.        (data-1 (do ((i 10 (1- i)) (x))
  96.            ((zerop i) (return x))
  97.          (setf x (append x data))))
  98.        (data-2 (do ((i 10 (1- i)) (x))
  99.            ((zerop i) (return x))
  100.          (setf x (append x data-1)))))
  101.   (format t "data: ~s~&data-1: ~s~& data-2: ~s~&"
  102.       data data-1 data-2)
  103.   (test-flatten data)
  104.   (test-flatten data-1)
  105.   (test-flatten data-2))
  106.  
  107. ;; 890
  108. ;; 2806
  109. ;; 4735
  110. ;; 686
  111. ;; 811
  112. ;; 414
  113. ;; --------------------- finished
  114. ;; 3729
  115. ;; 12915
  116. ;; 21658
  117. ;; 6584
  118. ;; 7269
  119. ;; 3391
  120. ;; --------------------- finished
  121. ;; 50071
  122. ;; 133508
  123. ;; 215169
  124. ;; 73918
  125. ;; 70899
  126. ;; 33164
  127. ;; --------------------- finished