X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Flist.lisp;h=5f38f7126e26bace475fecfc625c22a0490b9c48;hb=fb76e3acd8b8a53cdadaa65bce1d090d99e004a0;hp=e21535c921071300e9cc4f8242f37da27479f1a0;hpb=4898ef32c639b1c7f4ee13a5ba566ce6debd03e6;p=sbcl.git diff --git a/src/code/list.lisp b/src/code/list.lisp index e21535c..5f38f71 100644 --- a/src/code/list.lisp +++ b/src/code/list.lisp @@ -18,8 +18,8 @@ ;;;; -- WHN 20000127 (declaim (maybe-inline - tree-equal nth %setnth nthcdr last make-list append - nconc member member-if member-if-not tailp adjoin union + tree-equal nth %setnth nthcdr last last1 make-list append + nconc nconc2 member member-if member-if-not tailp adjoin union nunion intersection nintersection set-difference nset-difference set-exclusive-or nset-exclusive-or subsetp acons assoc assoc-if assoc-if-not rassoc rassoc-if rassoc-if-not subst subst-if @@ -230,18 +230,28 @@ (fast-nthcdr (mod n i) r-i)) (declare (type index i))))))) +(defun last1 (list) + #!+sb-doc + "Return the last cons (not the last element) of a list" + (let ((rest list) + (list list)) + (loop (unless (consp rest) (return list)) + (shiftf list rest (cdr rest))))) + (defun last (list &optional (n 1)) #!+sb-doc "Return the last N conses (not the last element!) of a list." - (if (typep n 'index) - (do ((checked-list list (cdr checked-list)) - (returned-list list) - (index 0 (1+ index))) - ((atom checked-list) returned-list) - (declare (type index index)) - (if (>= index n) - (pop returned-list))) - list)) + (if (eql n 1) + (last1 list) + (if (typep n 'index) + (do ((checked-list list (cdr checked-list)) + (returned-list list) + (index 0 (1+ index))) + ((atom checked-list) returned-list) + (declare (type index index)) + (if (>= index n) + (pop returned-list))) + list))) (defun list (&rest args) #!+sb-doc @@ -266,7 +276,7 @@ (declare (type index size)) (do ((count size (1- count)) (result '() (cons initial-element result))) - ((zerop count) result) + ((<= count 0) result) (declare (type index count)))) (defun append (&rest lists) @@ -400,6 +410,16 @@ (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)))))) + (defun nreconc (x y) #!+sb-doc "Return (NCONC (NREVERSE X) Y)."