X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Flist.lisp;h=da6ca8e60a30b7c9c8b17894fe4dd9b973dc37f7;hb=cd1b14acf6f548b28b8a14e554d779f0473122ec;hp=39af79ec1333c0b1f5dd186a9e6b1ceabdd8a9fb;hpb=1db4f16ef02f5b4d699d78541edb19ad8f3defc8;p=sbcl.git

diff --git a/src/code/list.lisp b/src/code/list.lisp
index 39af79e..da6ca8e 100644
--- a/src/code/list.lisp
+++ b/src/code/list.lisp
@@ -445,8 +445,21 @@
   #!+sb-doc
   "Recursively copy trees of conses."
   (if (consp object)
-      (cons (copy-tree (car object)) (copy-tree (cdr object)))
+      (let ((result (list (if (consp (car object))
+                              (copy-tree (car object))
+                              (car object)))))
+        (loop for last-cons = result then new-cons
+              for cdr = (cdr object) then (cdr cdr)
+              for car = (if (consp cdr)
+                            (car cdr)
+                            (return (setf (cdr last-cons) cdr)))
+              for new-cons = (list (if (consp car)
+                                       (copy-tree car)
+                                       car))
+              do (setf (cdr last-cons) new-cons))
+        result)
       object))
+
 
 ;;;; more commonly-used list functions
 
@@ -879,7 +892,7 @@
   (declare (inline member))
   (when (and testp notp)
     (error ":TEST and :TEST-NOT were both supplied."))
-  ;; We have to possibilities here: for shortish lists we pick up the
+  ;; We have two possibilities here: for shortish lists we pick up the
   ;; shorter one as the result, and add the other one to it. For long
   ;; lists we use a hash-table when possible.
   (let ((n1 (length list1))
@@ -928,7 +941,7 @@
   (declare (inline member))
   (when (and testp notp)
     (error ":TEST and :TEST-NOT were both supplied."))
-  ;; We have to possibilities here: for shortish lists we pick up the
+  ;; We have two possibilities here: for shortish lists we pick up the
   ;; shorter one as the result, and add the other one to it. For long
   ;; lists we use a hash-table when possible.
   (let ((n1 (length list1))