From 2e002dae2f9a3c64f147ca651751ed833806ad5e Mon Sep 17 00:00:00 2001
From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Wed, 23 Apr 2008 18:21:13 +0000
Subject: [PATCH] 1.0.16.8: NCONC with dx &rest lists

 * Remove MAYBE-INLINE declaration: with dx &rest list inlining NCONC doesn't
   yield any real benefits.

 * Also delete some dead code, and NCONC2 -- interestingly unlike with
   APPEND, a compiler-macro to NCONC2 seems to hurt more then it helps
   (not that it hurts in any real way).
---
 NEWS               |  2 ++
 src/code/list.lisp | 73 +++++++++++++++++++++++-------------------------------
 version.lisp-expr  |  2 +-
 3 files changed, 34 insertions(+), 43 deletions(-)

diff --git a/NEWS b/NEWS
index 98875f340..b3c2c6dfa 100644
--- a/NEWS
+++ b/NEWS
@@ -5,6 +5,8 @@ changes in sbcl-1.0.17 relative to 1.0.16:
   * optimization: APPEND is upto ~10% faster in normal SPEED policies.
   * optimization: two argument forms of LAST are upto ~10% faster
     in normal SPEED policies.
+  * optimization: NCONC no longer needs to heap cons its &REST list
+    in normal SPEED policies.
   * bug fix: LAST when always returned the whole list when given a bignum
     as the second argument.
   * bug fix: dynamic extent allocation of nested lists and vectors
diff --git a/src/code/list.lisp b/src/code/list.lisp
index 96911d1fb..5d3295092 100644
--- a/src/code/list.lisp
+++ b/src/code/list.lisp
@@ -19,7 +19,7 @@
 
 (declaim (maybe-inline
           tree-equal nth %setnth nthcdr make-list
-          nconc nconc2 member-if member-if-not tailp union
+          member-if member-if-not tailp union
           nunion intersection nintersection set-difference nset-difference
           set-exclusive-or nset-exclusive-or subsetp acons
           assoc-if assoc-if-not rassoc rassoc-if rassoc-if-not subst subst-if
@@ -467,47 +467,36 @@
 ;;; and it avoids running down the last argument to NCONC which allows
 ;;; the last argument to be circular.
 (defun nconc (&rest lists)
-  #!+sb-doc
-  "Concatenates the lists given as arguments (by changing them)"
-  (flet ((fail (object)
-           (error 'type-error
-                  :datum object
-                  :expected-type 'list)))
-    (do ((top lists (cdr top)))
-        ((null top) nil)
-      (let ((top-of-top (car top)))
-        (typecase top-of-top
-          (cons
-           (let* ((result top-of-top)
-                  (splice result))
-             (do ((elements (cdr top) (cdr elements)))
-                 ((endp elements))
-               (let ((ele (car elements)))
-                 (typecase ele
-                   (cons (rplacd (last splice) ele)
-                         (setf splice ele))
-                   (null (rplacd (last splice) nil))
-                   (atom (if (cdr elements)
-                             (fail ele)
-                             (rplacd (last splice) ele)))
-                   (t (fail ele)))))
-             (return result)))
-          (null)
-          (atom
-           (if (cdr top)
-               (fail top-of-top)
-               (return top-of-top)))
-          (t (fail top-of-top)))))))
-
-(defun nconc2 (x y)
-  (if (null x) y
-    (let ((z x)
-          (rest (cdr x)))
-      (loop
-       (unless (consp rest)
-         (rplacd z y)
-         (return x))
-       (shiftf z rest (cdr rest))))))
+   #!+sb-doc
+   "Concatenates the lists given as arguments (by changing them)"
+   (declare (dynamic-extent lists) (optimize speed))
+   (flet ((fail (object)
+            (error 'type-error
+                   :datum object
+                   :expected-type 'list)))
+     (do ((top lists (cdr top)))
+         ((null top) nil)
+       (let ((top-of-top (car top)))
+         (typecase top-of-top
+           (cons
+            (let* ((result top-of-top)
+                   (splice result))
+              (do ((elements (cdr top) (cdr elements)))
+                  ((endp elements))
+                (let ((ele (car elements)))
+                  (typecase ele
+                    (cons (rplacd (last splice) ele)
+                          (setf splice ele))
+                    (null (rplacd (last splice) nil))
+                    (atom (if (cdr elements)
+                              (fail ele)
+                              (rplacd (last splice) ele))))))
+              (return result)))
+           (null)
+           (atom
+            (if (cdr top)
+                (fail top-of-top)
+                (return top-of-top))))))))
 
 (defun nreconc (x y)
   #!+sb-doc
diff --git a/version.lisp-expr b/version.lisp-expr
index 0ef47727c..b9ca84beb 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.16.7"
+"1.0.16.8"
-- 
2.11.4.GIT