(sb!xc:defmacro make-sequence-like (sequence length)
#!+sb-doc
- "Returns a sequence of the same type as SEQUENCE and the given LENGTH."
+ "Return a sequence of the same type as SEQUENCE and the given LENGTH."
`(make-sequence-of-type (type-of ,sequence) ,length))
(sb!xc:defmacro type-specifier-atom (type)
- #!+sb-doc "Returns the broad class of which TYPE is a specific subclass."
+ #!+sb-doc "Return the broad class of which TYPE is a specific subclass."
`(if (atom ,type) ,type (car ,type)))
) ; EVAL-WHEN
:datum vector
:expected-type `(vector ,declared-length)
:format-control
- "Vector length (~D) doesn't match declared length (~D)."
+ "Vector length (~W) doesn't match declared length (~W)."
:format-arguments (list actual-length declared-length))))
vector)
(defun sequence-of-checked-length-given-type (sequence result-type)
;; This seems silly, is there something better?
'(integer (0) (0))))))
+(defun signal-end-too-large-error (sequence end)
+ (let* ((length (length sequence))
+ (max-end (and (not (minusp length) length))))
+ (error 'end-too-large-error
+ :datum end
+ :expected-type (if max-index
+ `(integer 0 ,max-end)
+ ;; This seems silly, is there something better?
+ '(integer (0) 0)))))
+
(defun make-sequence-of-type (type length)
- #!+sb-doc "Returns a sequence of the given TYPE and LENGTH."
+ #!+sb-doc "Return a sequence of the given TYPE and LENGTH."
(declare (fixnum length))
(case (type-specifier-atom type)
(list (make-list length))
(make-sequence-of-type (result-type-or-lose type) length))))
\f
(defun elt (sequence index)
- #!+sb-doc "Returns the element of SEQUENCE specified by INDEX."
+ #!+sb-doc "Return the element of SEQUENCE specified by INDEX."
(etypecase sequence
(list
(do ((count index (1- count))
\f
;;;; SUBSEQ
;;;;
-;;;; The support routines for SUBSEQ are used by compiler transforms, so we
-;;;; worry about dealing with END being supplied or defaulting to NIL
-;;;; at this level.
+;;;; The support routines for SUBSEQ are used by compiler transforms,
+;;;; so we worry about dealing with END being supplied or defaulting
+;;;; to NIL at this level.
(defun vector-subseq* (sequence start &optional end)
(declare (type vector sequence))
(declare (type fixnum start))
(declare (type (or null fixnum) end))
- (when (null end) (setf end (length sequence)))
+ (if (null end)
+ (setf end (length sequence))
+ (unless (<= end (length sequence))
+ (signal-index-too-large-error sequence end)))
(do ((old-index start (1+ old-index))
(new-index 0 (1+ new-index))
(copy (make-sequence-like sequence (- end start))))
((= old-index end) copy)
(declare (fixnum old-index new-index))
- (setf (aref copy new-index) (aref sequence old-index))))
+ (setf (aref copy new-index)
+ (aref sequence old-index))))
(defun list-subseq* (sequence start &optional end)
(declare (type list sequence))
(declare (fixnum index)))
()))))
-;;; SUBSEQ cannot default end to the length of sequence since it is not
-;;; an error to supply nil for its value. We must test for end being nil
-;;; in the body of the function, and this is actually done in the support
-;;; routines for other reasons (see above).
+;;; SUBSEQ cannot default END to the length of sequence since it is
+;;; not an error to supply NIL for its value. We must test for END
+;;; being NIL in the body of the function, and this is actually done
+;;; in the support routines for other reasons. (See above.)
(defun subseq (sequence start &optional end)
#!+sb-doc
- "Returns a copy of a subsequence of SEQUENCE starting with element number
+ "Return a copy of a subsequence of SEQUENCE starting with element number
START and continuing to the end of SEQUENCE or the optional END."
(seq-dispatch sequence
(list-subseq* sequence start end)
) ; EVAL-WHEN
(defun copy-seq (sequence)
- #!+sb-doc "Returns a copy of SEQUENCE which is EQUAL to SEQUENCE but not EQ."
+ #!+sb-doc "Return a copy of SEQUENCE which is EQUAL to SEQUENCE but not EQ."
(seq-dispatch sequence
(list-copy-seq* sequence)
(vector-copy-seq* sequence)))
(list-copy-seq sequence))
(defun vector-copy-seq* (sequence)
- (vector-copy-seq sequence (type-of sequence)))
+ (declare (type vector sequence))
+ (vector-copy-seq sequence
+ (typecase sequence
+ ;; Pick off the common cases so that we don't have to...
+ ((vector t) 'simple-vector)
+ (string 'simple-string)
+ (bit-vector 'simple-bit-vector)
+ ((vector single-float) '(simple-array single-float 1))
+ ((vector double-float) '(simple-array double-float 1))
+ ;; ...do a full call to TYPE-OF.
+ (t (type-of sequence)))))
\f
;;;; FILL
(defun reverse (sequence)
#!+sb-doc
- "Returns a new sequence containing the same elements but in reverse order."
+ "Return a new sequence containing the same elements but in reverse order."
(seq-dispatch sequence
(list-reverse* sequence)
(vector-reverse* sequence)))
(defun nreverse (sequence)
#!+sb-doc
- "Returns a sequence of the same elements in reverse order; the argument
+ "Return a sequence of the same elements in reverse order; the argument
is destroyed."
(seq-dispatch sequence
(list-nreverse* sequence)
;;; efficiency, but space efficiency..)
(defun concatenate (output-type-spec &rest sequences)
#!+sb-doc
- "Returns a new sequence of all the argument sequences concatenated together
+ "Return a new sequence of all the argument sequences concatenated together
which shares no structure with the original argument sequences of the
specified OUTPUT-TYPE-SPEC."
(case (type-specifier-atom output-type-spec)
(vector (dovector (,i sequence) ,@body))))))
(defun %map-to-list-arity-1 (fun sequence)
(let ((reversed-result nil)
- (really-fun (%coerce-callable-to-function fun)))
+ (really-fun (%coerce-callable-to-fun fun)))
(dosequence (element sequence)
(push (funcall really-fun element)
reversed-result))
(defun %map-to-simple-vector-arity-1 (fun sequence)
(let ((result (make-array (length sequence)))
(index 0)
- (really-fun (%coerce-callable-to-function fun)))
+ (really-fun (%coerce-callable-to-fun fun)))
(declare (type index index))
(dosequence (element sequence)
(setf (aref result index)
(incf index))
result))
(defun %map-for-effect-arity-1 (fun sequence)
- (let ((really-fun (%coerce-callable-to-function fun)))
+ (let ((really-fun (%coerce-callable-to-fun fun)))
(dosequence (element sequence)
(funcall really-fun element)))
nil))
;;; length of the output sequence matches any length specified
;;; in RESULT-TYPE.
(defun %map (result-type function first-sequence &rest more-sequences)
- (let ((really-function (%coerce-callable-to-function function)))
+ (let ((really-fun (%coerce-callable-to-fun function)))
;; Handle one-argument MAP NIL specially, using ETYPECASE to turn
;; it into something which can be DEFTRANSFORMed away. (It's
;; fairly important to handle this case efficiently, since
;; there's no consing overhead to dwarf our inefficiency.)
(if (and (null more-sequences)
(null result-type))
- (%map-for-effect-arity-1 really-function first-sequence)
+ (%map-for-effect-arity-1 really-fun first-sequence)
;; Otherwise, use the industrial-strength full-generality
;; approach, consing O(N-ARGS) temporary storage (which can have
;; DYNAMIC-EXTENT), then using O(N-ARGS * RESULT-LENGTH) time.
(let ((sequences (cons first-sequence more-sequences)))
(case (type-specifier-atom result-type)
- ((nil) (%map-for-effect really-function sequences))
- (list (%map-to-list really-function sequences))
+ ((nil) (%map-for-effect really-fun sequences))
+ (list (%map-to-list really-fun sequences))
((simple-vector simple-string vector string array simple-array
bit-vector simple-bit-vector base-string simple-base-string)
- (%map-to-vector result-type really-function sequences))
+ (%map-to-vector result-type really-fun sequences))
(t
(apply #'map
(result-type-or-lose result-type t)
- really-function
+ really-fun
sequences)))))))
(defun map (result-type function first-sequence &rest more-sequences)
(when fp-result
(setf (fill-pointer result-sequence) len))
- (let ((really-fun (%coerce-callable-to-function function)))
+ (let ((really-fun (%coerce-callable-to-fun function)))
(dotimes (index len)
(setf (elt result-sequence index)
(apply really-fun
- (mapcar #'(lambda (seq) (elt seq index))
+ (mapcar (lambda (seq) (elt seq index))
sequences))))))
result-sequence)
\f
;; obviously correct solution is to make Python smart
;; enough that we can use an inline function instead
;; of a compiler macro (as above). -- WHN 20000410
+ ;;
+ ;; FIXME: The DEFINE-COMPILER-MACRO here can be
+ ;; important for performance, and it'd be good to have
+ ;; it be visible throughout the compilation of all the
+ ;; target SBCL code. That could be done by defining
+ ;; SB-XC:DEFINE-COMPILER-MACRO and using it here,
+ ;; moving this DEFQUANTIFIER stuff (and perhaps other
+ ;; inline definitions in seq.lisp as well) into a new
+ ;; seq.lisp, and moving remaining target-only stuff
+ ;; from the old seq.lisp into target-seq.lisp.
(define-compiler-macro ,name (pred first-seq &rest more-seqs)
(let ((elements (make-gensym-list (1+ (length more-seqs))))
(blockname (gensym "BLOCK")))
(defun delete (item sequence &key from-end (test #'eql) test-not (start 0)
end count key)
#!+sb-doc
- "Returns a sequence formed by destructively removing the specified Item from
- the given Sequence."
+ "Return a sequence formed by destructively removing the specified ITEM from
+ the given SEQUENCE."
(declare (fixnum start))
(let* ((length (length sequence))
(end (or end length))
(defun delete-if (predicate sequence &key from-end (start 0) key end count)
#!+sb-doc
- "Returns a sequence formed by destructively removing the elements satisfying
- the specified Predicate from the given Sequence."
+ "Return a sequence formed by destructively removing the elements satisfying
+ the specified PREDICATE from the given SEQUENCE."
(declare (fixnum start))
(let* ((length (length sequence))
(end (or end length))
(defun delete-if-not (predicate sequence &key from-end (start 0) end key count)
#!+sb-doc
- "Returns a sequence formed by destructively removing the elements not
- satisfying the specified Predicate from the given Sequence."
+ "Return a sequence formed by destructively removing the elements not
+ satisfying the specified PREDICATE from the given SEQUENCE."
(declare (fixnum start))
(let* ((length (length sequence))
(end (or end length))
(defun remove (item sequence &key from-end (test #'eql) test-not (start 0)
end count key)
#!+sb-doc
- "Returns a copy of SEQUENCE with elements satisfying the test (default is
+ "Return a copy of SEQUENCE with elements satisfying the test (default is
EQL) with ITEM removed."
(declare (fixnum start))
(let* ((length (length sequence))
(defun remove-if (predicate sequence &key from-end (start 0) end count key)
#!+sb-doc
- "Returns a copy of sequence with elements such that predicate(element)
- is non-null are removed"
+ "Return a copy of sequence with elements such that predicate(element)
+ is non-null removed"
(declare (fixnum start))
(let* ((length (length sequence))
(end (or end length))
(defun remove-if-not (predicate sequence &key from-end (start 0) end count key)
#!+sb-doc
- "Returns a copy of sequence with elements such that predicate(element)
- is null are removed"
+ "Return a copy of sequence with elements such that predicate(element)
+ is null removed"
(declare (fixnum start))
(let* ((length (length sequence))
(end (or end length))
(defun substitute (new old sequence &key from-end (test #'eql) test-not
(start 0) count end key)
#!+sb-doc
- "Returns 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
+ "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."
(declare (fixnum start))
(let* ((length (length sequence))
(defun substitute-if (new test sequence &key from-end (start 0) end count key)
#!+sb-doc
- "Returns a sequence of the same kind as Sequence with the same elements
- except that all elements satisfying the Test are replaced with New. See
+ "Return a sequence of the same kind as SEQUENCE with the same elements
+ except that all elements satisfying the TEST are replaced with NEW. See
manual for details."
(declare (fixnum start))
(let* ((length (length sequence))
(defun substitute-if-not (new test sequence &key from-end (start 0)
end count key)
#!+sb-doc
- "Returns a sequence of the same kind as Sequence with the same elements
- except that all elements not satisfying the Test are replaced with New.
+ "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.
See manual for details."
(declare (fixnum start))
(let* ((length (length sequence))
(defun nsubstitute (new old sequence &key from-end (test #'eql) test-not
end count key (start 0))
#!+sb-doc
- "Returns 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 destroyed. See manual for details."
+ "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."
(declare (fixnum start))
(let ((end (or end (length sequence)))
(count (or count most-positive-fixnum)))
(defun nsubstitute-if (new test sequence &key from-end (start 0) end count key)
#!+sb-doc
- "Returns a sequence of the same kind as Sequence with the same elements
- except that all elements satisfying the Test are replaced with New. The
- Sequence may be destroyed. See manual for details."
+ "Return a sequence of the same kind as SEQUENCE with the same elements
+ except that all elements satisfying the TEST are replaced with NEW.
+ SEQUENCE may be destructively modified. See manual for details."
(declare (fixnum start))
(let ((end (or end (length sequence)))
(count (or count most-positive-fixnum)))
(defun nsubstitute-if-not (new test sequence &key from-end (start 0)
end count key)
#!+sb-doc
- "Returns a sequence of the same kind as Sequence with the same elements
- except that all elements not satisfying the Test are replaced with New.
- The Sequence may be destroyed. See manual for details."
+ "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."
(declare (fixnum start))
(let ((end (or end (length sequence)))
(count (or count most-positive-fixnum)))
(defun effective-find-position-test (test test-not)
(cond ((and test test-not)
(error "can't specify both :TEST and :TEST-NOT"))
- (test (%coerce-callable-to-function test))
+ (test (%coerce-callable-to-fun test))
(test-not
;; (Without DYNAMIC-EXTENT, this is potentially horribly
;; inefficient, but since the TEST-NOT option is deprecated
;; anyway, we don't care.)
- (complement (%coerce-callable-to-function test-not)))
+ (complement (%coerce-callable-to-fun test-not)))
(t #'eql)))
(defun effective-find-position-key (key)
(if key
- (%coerce-callable-to-function key)
+ (%coerce-callable-to-fun key)
#'identity))
;;; shared guts of out-of-line FIND, POSITION, FIND-IF, and POSITION-IF
(vector*-frob (sequence)
`(%find-position-if-vector-macro predicate ,sequence
from-end start end key)))
+ (frobs)))
+ (defun %find-position-if-not (predicate sequence-arg from-end start end key)
+ (macrolet ((frob (sequence from-end)
+ `(%find-position-if-not predicate ,sequence
+ ,from-end start end key))
+ (vector*-frob (sequence)
+ `(%find-position-if-not-vector-macro predicate ,sequence
+ from-end start end key)))
(frobs))))
;;; the user interface to FIND and POSITION: Get all our ducks in a
&key from-end (start 0) end key)
(nth-value
,values-index
- (%find-position-if (%coerce-callable-to-function predicate)
+ (%find-position-if (%coerce-callable-to-fun predicate)
sequence
from-end
start
(def-find-position-if find-if 0)
(def-find-position-if position-if 1))
-;;; the deprecated functions FIND-IF-NOT and POSITION-IF-NOT. We don't
-;;; bother to worry about optimizing them.
+;;; the deprecated functions FIND-IF-NOT and POSITION-IF-NOT. We
+;;; didn't bother to worry about optimizing them, except note that on
+;;; Sat, Oct 06, 2001 at 04:22:38PM +0100, Christophe Rhodes wrote on
+;;; sbcl-devel
+;;;
+;;; My understanding is that while the :test-not argument is
+;;; deprecated in favour of :test (complement #'foo) because of
+;;; semantic difficulties (what happens if both :test and :test-not
+;;; are supplied, etc) the -if-not variants, while officially
+;;; deprecated, would be undeprecated were X3J13 actually to produce
+;;; a revised standard, as there are perfectly legitimate idiomatic
+;;; reasons for allowing the -if-not versions equal status,
+;;; particularly remove-if-not (== filter).
+;;;
+;;; This is only an informal understanding, I grant you, but
+;;; perhaps it's worth optimizing the -if-not versions in the same
+;;; way as the others?
+;;;
+;;; That sounds reasonable, so if someone wants to submit patches to
+;;; make the -IF-NOT functions compile as efficiently as the
+;;; corresponding -IF variants do, go for it. -- WHN 2001-10-06)
;;;
;;; FIXME: Remove uses of these deprecated functions (and of :TEST-NOT
;;; too) within the implementation of SBCL.
+(declaim (inline find-if-not position-if-not))
(macrolet ((def-find-position-if-not (fun-name values-index)
`(defun ,fun-name (predicate sequence
&key from-end (start 0) end key)
(nth-value
,values-index
- (%find-position-if (complement (%coerce-callable-to-function
- predicate))
- sequence
- from-end
- start
- end
- (effective-find-position-key key))))))
+ (%find-position-if-not (%coerce-callable-to-fun predicate)
+ sequence
+ from-end
+ start
+ end
+ (effective-find-position-key key))))))
+
(def-find-position-if-not find-if-not 0)
(def-find-position-if-not position-if-not 1))
\f
(defun count (item sequence &key from-end (test #'eql) test-not (start 0)
end key)
#!+sb-doc
- "Returns the number of elements in SEQUENCE satisfying a test with ITEM,
+ "Return the number of elements in SEQUENCE satisfying a test with ITEM,
which defaults to EQL."
(declare (ignore from-end) (fixnum start))
(let ((end (or end (length sequence))))
(defun count-if (test sequence &key from-end (start 0) end key)
#!+sb-doc
- "Returns the number of elements in SEQUENCE satisfying TEST(el)."
+ "Return the number of elements in SEQUENCE satisfying TEST(el)."
(declare (ignore from-end) (fixnum start))
(let ((end (or end (length sequence))))
(declare (type index end))
(defun count-if-not (test sequence &key from-end (start 0) end key)
#!+sb-doc
- "Returns the number of elements in SEQUENCE not satisfying TEST(el)."
+ "Return the number of elements in SEQUENCE not satisfying TEST(el)."
(declare (ignore from-end) (fixnum start))
(let ((end (or end (length sequence))))
(declare (type index end))
projects / sbcl.git / blobdiff