From 557df1e8a17c2f4d9f97752cb8476805e79f0073 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Wed, 23 Apr 2008 17:40:38 +0000 Subject: [PATCH] 1.0.16.7: slightly faster LAST * Remove MAYBE-INLINE declaration and separate into out-of-line %LAST0, %LAST1, %LASTN/FIXNUM, and (rather academically) %LASTN/BIGNUM. * Add a DEFTRANSFORM to optimize to the most specific version possible. --- NEWS | 4 ++ package-data-list.lisp-expr | 4 ++ src/code/list.lisp | 103 +++++++++++++++++++++++++++++++++---------- src/compiler/fndb.lisp | 7 ++- src/compiler/srctran.lisp | 17 ++++++- tests/list.pure.lisp | 3 ++ version.lisp-expr | 2 +- 7 files changed, 114 insertions(+), 26 deletions(-) diff --git a/NEWS b/NEWS index 14c803e..98875f3 100644 --- a/NEWS +++ b/NEWS @@ -3,6 +3,10 @@ changes in sbcl-1.0.17 relative to 1.0.16: * 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 diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index f8da734..405580f 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -1193,6 +1193,10 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "%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" diff --git a/src/code/list.lisp b/src/code/list.lisp index 1e2c8a4..96911d1 100644 --- a/src/code/list.lisp +++ b/src/code/list.lisp @@ -18,7 +18,7 @@ ;;;; -- 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 @@ -230,28 +230,85 @@ (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 diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp index e5c72f5..4aeeba2 100644 --- a/src/compiler/fndb.lisp +++ b/src/compiler/fndb.lisp @@ -678,8 +678,13 @@ (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 diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp index 4309045..2675ea1 100644 --- a/src/compiler/srctran.lisp +++ b/src/compiler/srctran.lisp @@ -142,7 +142,22 @@ (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)) diff --git a/tests/list.pure.lisp b/tests/list.pure.lisp index 97f6eb7..b018b3e 100644 --- a/tests/list.pure.lisp +++ b/tests/list.pure.lisp @@ -130,6 +130,9 @@ (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))) diff --git a/version.lisp-expr b/version.lisp-expr index 23d9e5a..0ef4772 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.6" +"1.0.16.7" -- 1.7.10.4