1.0.16.8: NCONC with dx &rest lists
authorNikodemus Siivola <nikodemus@random-state.net>
Wed, 23 Apr 2008 18:21:13 +0000 (18:21 +0000)
committerNikodemus Siivola <nikodemus@random-state.net>
Wed, 23 Apr 2008 18:21:13 +0000 (18:21 +0000)
 * 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
src/code/list.lisp
version.lisp-expr

diff --git a/NEWS b/NEWS
index 98875f3..b3c2c6d 100644 (file)
--- 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
index 96911d1..5d32950 100644 (file)
@@ -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
 ;;; 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
index 0ef4772..b9ca84b 100644 (file)
@@ -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"