From b2ad48f269cd6b9403820588d65eac526e4e32fd Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Fri, 4 Feb 2005 11:38:28 +0000 Subject: [PATCH] 0.8.19.13: Repetitive code is the enemy of comprehension ... refactor %COERCE-CALLABLE-TO-FUN use in REDUCE and other sequence functions into DEFINE-SEQUENCE-TRAVERSER. --- NEWS | 2 ++ src/code/seq.lisp | 83 ++++++++++++++++++++++++----------------------------- version.lisp-expr | 2 +- 3 files changed, 40 insertions(+), 47 deletions(-) diff --git a/NEWS b/NEWS index d715043..be8ba6d 100644 --- a/NEWS +++ b/NEWS @@ -9,6 +9,8 @@ changes in sbcl-0.8.20 (0.9alpha.0?) relative to sbcl-0.8.19: * fixed bug: COUNT and EQUAL on bit vectors with lengths divisible by the wordsize no longer ignore the last word. (reported by Lutz Euler) + * optimization: sequence traversal functions use their freedom to + coerce function designators to functions. * fixed some bugs related to Unicode integration: ** portions of multibyte characters at the end of buffers for character-based file input are correctly transferred to the diff --git a/src/code/seq.lisp b/src/code/seq.lisp index e2afa66..ccc89a7 100644 --- a/src/code/seq.lisp +++ b/src/code/seq.lisp @@ -100,6 +100,9 @@ (list (length sequence2)) (vector (length sequence2))))) (new-declarations '(type index length2))) + ((function predicate) + (new-args arg) + (adjustments `(,arg (%coerce-callable-to-fun ,arg)))) (t (let ((info (cdr (assoc arg *sequence-keyword-info*)))) (cond (info (destructuring-bind (default supplied-p adjuster type) info @@ -1137,8 +1140,7 @@ (function sequence &key key from-end start end (initial-value nil ivp)) (declare (type index start)) (let ((start start) - (end (or end length)) - (function (%coerce-callable-to-fun function))) + (end (or end length))) (declare (type index start end)) (cond ((= end start) (if ivp initial-value (funcall function))) @@ -1311,8 +1313,7 @@ "Return a sequence formed by destructively removing the elements satisfying the specified PREDICATE from the given SEQUENCE." (declare (fixnum start)) - (let ((end (or end length)) - (predicate (%coerce-callable-to-fun predicate))) + (let ((end (or end length))) (declare (type index end)) (seq-dispatch sequence (if from-end @@ -1348,8 +1349,7 @@ "Return a sequence formed by destructively removing the elements not satisfying the specified PREDICATE from the given SEQUENCE." (declare (fixnum start)) - (let ((end (or end length)) - (predicate (%coerce-callable-to-fun predicate))) + (let ((end (or end length))) (declare (type index end)) (seq-dispatch sequence (if from-end @@ -1509,11 +1509,9 @@ (define-sequence-traverser remove-if (predicate sequence &key from-end start end count key) #!+sb-doc - "Return a copy of sequence with elements such that predicate(element) - is non-null removed" + "Return a copy of sequence with elements satisfying PREDICATE removed." (declare (fixnum start)) - (let ((end (or end length)) - (predicate (%coerce-callable-to-fun predicate))) + (let ((end (or end length))) (declare (type index end)) (seq-dispatch sequence (if from-end @@ -1526,11 +1524,9 @@ (define-sequence-traverser remove-if-not (predicate sequence &key from-end start end count key) #!+sb-doc - "Return a copy of sequence with elements such that predicate(element) - is null removed" + "Return a copy of sequence with elements not satisfying PREDICATE removed." (declare (fixnum start)) - (let ((end (or end length)) - (predicate (%coerce-callable-to-fun predicate))) + (let ((end (or end length))) (declare (type index end)) (seq-dispatch sequence (if from-end @@ -1817,8 +1813,7 @@ start count end key) #!+sb-doc "Return a sequence of the same kind as SEQUENCE with the same elements, - except that all elements equal to OLD are replaced with NEW. See manual - for details." + except that all elements equal to OLD are replaced with NEW." (declare (fixnum start)) (let ((end (or end length))) (declare (type index end)) @@ -1827,29 +1822,27 @@ ;;;; SUBSTITUTE-IF, SUBSTITUTE-IF-NOT (define-sequence-traverser substitute-if - (new pred sequence &key from-end start end count key) + (new predicate sequence &key from-end start end count key) #!+sb-doc "Return a sequence of the same kind as SEQUENCE with the same elements - except that all elements satisfying the PRED are replaced with NEW. See - manual for details." + except that all elements satisfying the PRED are replaced with NEW." (declare (fixnum start)) (let ((end (or end length)) - (test (%coerce-callable-to-fun pred)) - test-not + (test predicate) + (test-not nil) old) (declare (type index length end)) (subst-dispatch 'if))) (define-sequence-traverser substitute-if-not - (new pred sequence &key from-end start end count key) + (new predicate sequence &key from-end start end count key) #!+sb-doc "Return a sequence of the same kind as SEQUENCE with the same elements - except that all elements not satisfying the PRED are replaced with NEW. - See manual for details." + except that all elements not satisfying the PRED are replaced with NEW." (declare (fixnum start)) (let ((end (or end length)) - (test (%coerce-callable-to-fun pred)) - test-not + (test predicate) + (test-not nil) old) (declare (type index length end)) (subst-dispatch 'if-not))) @@ -1861,8 +1854,8 @@ end count key start) #!+sb-doc "Return a sequence of the same kind as SEQUENCE with the same elements - except that all elements equal to OLD are replaced with NEW. The SEQUENCE - may be destructively modified. See manual for details." + except that all elements equal to OLD are replaced with NEW. SEQUENCE + may be destructively modified." (declare (fixnum start)) (let ((end (or end length))) (if (listp sequence) @@ -1909,27 +1902,26 @@ ;;;; NSUBSTITUTE-IF, NSUBSTITUTE-IF-NOT (define-sequence-traverser nsubstitute-if - (new pred sequence &key from-end start end count key) + (new predicate sequence &key from-end start end count key) #!+sb-doc "Return a sequence of the same kind as SEQUENCE with the same elements - except that all elements satisfying the PRED are replaced with NEW. - SEQUENCE may be destructively modified. See manual for details." + except that all elements satisfying PREDICATE are replaced with NEW. + SEQUENCE may be destructively modified." (declare (fixnum start)) - (let ((end (or end length)) - (pred (%coerce-callable-to-fun pred))) + (let ((end (or end length))) (declare (fixnum end)) (if (listp sequence) (if from-end (let ((length (length sequence))) (nreverse (nlist-substitute-if* - new pred (nreverse (the list sequence)) + new predicate (nreverse (the list sequence)) (- length end) (- length start) count key))) - (nlist-substitute-if* new pred sequence + (nlist-substitute-if* new predicate sequence start end count key)) (if from-end - (nvector-substitute-if* new pred sequence -1 + (nvector-substitute-if* new predicate sequence -1 (1- end) (1- start) count key) - (nvector-substitute-if* new pred sequence 1 + (nvector-substitute-if* new predicate sequence 1 start end count key))))) (defun nlist-substitute-if* (new test sequence start end count key) @@ -1950,27 +1942,26 @@ (setq count (1- count))))) (define-sequence-traverser nsubstitute-if-not - (new pred sequence &key from-end start end count key) + (new predicate sequence &key from-end start end count key) #!+sb-doc "Return a sequence of the same kind as SEQUENCE with the same elements - except that all elements not satisfying the TEST are replaced with NEW. - SEQUENCE may be destructively modified. See manual for details." + except that all elements not satisfying PREDICATE are replaced with NEW. + SEQUENCE may be destructively modified." (declare (fixnum start)) - (let ((end (or end length)) - (pred (%coerce-callable-to-fun pred))) + (let ((end (or end length))) (declare (fixnum end)) (if (listp sequence) (if from-end (let ((length (length sequence))) (nreverse (nlist-substitute-if-not* - new pred (nreverse (the list sequence)) + new predicate (nreverse (the list sequence)) (- length end) (- length start) count key))) - (nlist-substitute-if-not* new pred sequence + (nlist-substitute-if-not* new predicate sequence start end count key)) (if from-end - (nvector-substitute-if-not* new pred sequence -1 + (nvector-substitute-if-not* new predicate sequence -1 (1- end) (1- start) count key) - (nvector-substitute-if-not* new pred sequence 1 + (nvector-substitute-if-not* new predicate sequence 1 start end count key))))) (defun nlist-substitute-if-not* (new test sequence start end count key) diff --git a/version.lisp-expr b/version.lisp-expr index 4100fba..a69dddc 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".) -"0.8.19.12" +"0.8.19.13" -- 1.7.10.4