;; 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 "Return a sequence of the given TYPE and LENGTH."
(declare (fixnum length))
\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
"Return a copy of a subsequence of SEQUENCE starting with element number
(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
(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
(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.
-;;;
-;;; (Except note that on Sat, Oct 06, 2001 at 04:22:38PM +0100,
-;;; Christophe Rhodes wrote on sbcl-devel
+;;; 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
;;;
;;; 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-fun
- 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