* optimization: ADJOIN and PUSHNEW are upto ~70% faster in normal
SPEED policies.
* optimization: APPEND is upto ~10% faster in normal SPEED policies.
+ * optimization: two argument forms of LAST are upto ~10% faster
+ 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
could leak to otherwise accessible parts.
* bug fix: invalid optimization of heap-allocated alien variable
"%FUN-FUN"
"%FUN-NAME"
"%HYPOT" "%LDB" "%LOG" "%LOGB" "%LOG10"
+ "%LAST0"
+ "%LAST1"
+ "%LASTN/FIXNUM"
+ "%LASTN/BIGNUM"
"%LOG1P"
#!+long-float "%LONG-FLOAT"
"%MAKE-COMPLEX" "%MAKE-FUNCALLABLE-INSTANCE"
;;;; -- WHN 20000127
(declaim (maybe-inline
- tree-equal nth %setnth nthcdr last last1 make-list
+ tree-equal nth %setnth nthcdr make-list
nconc nconc2 member-if member-if-not tailp union
nunion intersection nintersection set-difference nset-difference
set-exclusive-or nset-exclusive-or subsetp acons
(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 (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)))
+;;; LAST
+;;;
+;;; Transforms in src/compiler/srctran.lisp pick the most specific
+;;; version possible. %LAST/BIGNUM is admittedly somewhat academic...
+(macrolet ((last0-macro ()
+ `(let ((rest list)
+ (list list))
+ (loop (unless (consp rest)
+ (return rest))
+ (shiftf list rest (cdr rest)))))
+ (last1-macro ()
+ `(let ((rest list)
+ (list list))
+ (loop (unless (consp rest)
+ (return list))
+ (shiftf list rest (cdr rest)))))
+ (lastn-macro (type)
+ `(let ((returned-list list)
+ (checked-list list)
+ (n (truly-the ,type n)))
+ (declare (,type n))
+ (tagbody
+ :scan
+ (pop checked-list)
+ (when (atom checked-list)
+ (go :done))
+ (if (zerop (truly-the ,type (decf n)))
+ (go :pop)
+ (go :scan))
+ :pop
+ (pop returned-list)
+ (pop checked-list)
+ (if (atom checked-list)
+ (go :done)
+ (go :pop))
+ :done)
+ returned-list)))
+
+ (defun %last0 (list)
+ (declare (optimize speed (sb!c::verify-arg-count 0)))
+ (last0-macro))
+
+ (defun %last1 (list)
+ (declare (optimize speed (sb!c::verify-arg-count 0)))
+ (last1-macro))
+
+ (defun %lastn/fixnum (list n)
+ (declare (optimize speed (sb!c::verify-arg-count 0))
+ (type (and unsigned-byte fixnum) n))
+ (case n
+ (1 (last1-macro))
+ (0 (last0-macro))
+ (t (lastn-macro fixnum))))
+
+ (defun %lastn/bignum (list n)
+ (declare (optimize speed (sb!c::verify-arg-count 0))
+ (type (and unsigned-byte bignum) n))
+ (lastn-macro unsigned-byte))
+
+ (defun last (list &optional (n 1))
+ #!+sb-doc
+ "Return the last N conses (not the last element!) of a list."
+ (case n
+ (1 (last1-macro))
+ (0 (last0-macro))
+ (t
+ (typecase n
+ (fixnum
+ (lastn-macro fixnum))
+ (bignum
+ (lastn-macro unsigned-byte)))))))
+
+(define-compiler-macro last (&whole form list &optional (n 1) &environment env)
+ (if (sb!xc:constantp n env)
+ (case (constant-form-value n env)
+ (0 `(%last0 ,list))
+ (1 `(%last1 ,list))
+ (t form))
+ form))
(defun list (&rest args)
#!+sb-doc
(defknown list-length (list) (or index null) (foldable unsafely-flushable))
(defknown nth (unsigned-byte list) t (foldable flushable))
(defknown nthcdr (unsigned-byte list) t (foldable unsafely-flushable))
+
(defknown last (list &optional unsigned-byte) t (foldable flushable))
-(defknown sb!impl::last1 (list) t (foldable flushable))
+(defknown %last0 (list) t (foldable flushable))
+(defknown %last1 (list) t (foldable flushable))
+(defknown %lastn/fixnum (list (and unsigned-byte fixnum)) t (foldable flushable))
+(defknown %lastn/bignum (list (and unsigned-byte bignum)) t (foldable flushable))
+
(defknown list (&rest t) list (movable flushable unsafe))
(defknown list* (t &rest t) t (movable flushable unsafe))
(defknown make-list (index &key (:initial-element t)) list
(define-source-transform nth (n l) `(car (nthcdr ,n ,l)))
-(define-source-transform last (x) `(sb!impl::last1 ,x))
+(deftransform last ((list &optional n) (t &optional t))
+ (let ((c (constant-lvar-p n)))
+ (cond ((or (not n)
+ (and c (eql 1 (lvar-value n))))
+ '(%last1 list))
+ ((and c (eql 0 (lvar-value n)))
+ '(%last0 list))
+ (t
+ (let ((type (lvar-type n)))
+ (cond ((csubtypep type (specifier-type 'fixnum))
+ '(%lastn/fixnum list n))
+ ((csubtypep type (specifier-type 'bignum))
+ '(%lastn/bignum list n))
+ (t
+ (give-up-ir1-transform "second argument type too vague"))))))))
+
(define-source-transform gethash (&rest args)
(case (length args)
(2 `(sb!impl::gethash3 ,@args nil))
(assert (null (butlast s (* 1440 most-positive-fixnum))))
(assert (null (nbutlast s (* 1440 most-positive-fixnum)))))
+(assert (eq :atom (last (list* 1 2 3 :atom) (eval 0))))
+(assert (eq :atom (last (list* 1 2 3 :atom) 0)))
+
;;; enforce lists in symbol-plist
(let ((s (gensym))
(l (list 1 3 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.6"
+"1.0.16.7"
projects / sbcl.git / commitdiff