From: Stas Boukarev <stassats@gmail.com>
Date: Mon, 14 May 2012 01:12:45 +0000 (+0400)
Subject: Optimize copy-tree.
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=4b25bb8e20bf3c1419a11b7d4cfefa23e4f3279b;p=sbcl.git

Optimize copy-tree.

copy-tree used to always call itself, even on linear lists, which
caused stack exhaustion on long lists. Make it copy linear lists
linearly, and recur only when necessary. This also makes it somewhat
faster.
Fixes lp#98926.
---

diff --git a/NEWS b/NEWS
index 51b81fa..a4f9d84 100644
--- a/NEWS
+++ b/NEWS
@@ -64,6 +64,8 @@ changes relative to sbcl-1.0.56:
   * bug fix: compiler-internal interval arithmetic needed to be more
     conservative about open intervals when operated on by monotonic but not
     strictly-monotonic functions.  (lp#975528)
+  * bug fix: copy-tree caused stack exhaustion on long linear lists, and now
+    it's also slightly faster. (lp#998926)
   * documentation:
     ** improved docstrings: REPLACE (lp#965592)
 
diff --git a/src/code/list.lisp b/src/code/list.lisp
index d74cc1c..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