X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Flist.lisp;h=274d2f3c1bcc52bc3ac3a80ef98755081bbabcec;hb=a2bb848e0037e127287781e99528bc4e93ccc2fb;hp=368d0980966ce73f2caba6d6ff83d625243aee80;hpb=f0a14f3e363b6d0cf1c30635f3d732b7bc0b15a4;p=jscl.git

diff --git a/src/list.lisp b/src/list.lisp
index 368d098..274d2f3 100644
--- a/src/list.lisp
+++ b/src/list.lisp
@@ -202,11 +202,8 @@
   (when (< size 0)
     (error "Size must be non-negative"))
   (let ((newlist))
-    (do ((i 0))
-        ((= i size))
-      (push initial-element newlist)
-      (incf i))
-    newlist))
+    (dotimes (i size newlist)
+      (push initial-element newlist))))
 
 (defun map1 (func list)
   (with-collect
@@ -259,27 +256,28 @@
 
 (defun butlast (x &optional (n 1))
   "Returns x, less the n last elements in the list."
+  (nbutlast (copy-list x) n))
+
+(defun nbutlast (x &optional (n 1))
+  "Destructively returns x, less the n last elements in the list."
   (cond
-      ;; trivial optimizations
-    ((not x) x)
+    ((not (and (integerp n) (>= n 0)))
+     ;; TODO: turn this error into a type error, per CLHS spec.
+     (error "n must be a non-negative integer"))
+    ;; trivial optimizations
     ((zerop n) x)
-
-    ;; Base case
-    ((= n 1)
-     (and (consp (cdr x))
-          (cons (car x)
-                (butlast (cdr x) n))))
-    ;; O(n * (length x)) butlast for n > 1.
     (t
-     (let ((temp x))
-       (do
-        ((iter 0))
-        ;; quit when we reach the top or we ran out
-        ((or (= iter n)
-             (not temp)))
-         (setf temp (butlast temp 1))
-         (incf iter))
-       temp))))
+     ;; O(n) walk of the linked list, trimming out the link where appropriate
+     (let* ((head x)
+            (trailing (nthcdr n x)))
+       ;; If there are enough conses
+       (when (consp trailing)
+         (while (consp (cdr trailing))
+           (setq head (cdr head))
+           (setq trailing (cdr trailing)))
+         ;; snip
+         (rplacd head nil)
+         x)))))
 
 (defun member (x list &key key (test #'eql testp) (test-not #'eql test-not-p))
   (while list