0.pre7.6:
[sbcl.git] / src / code / seq.lisp
index 98d616e..18e1d13 100644 (file)
       (setf (aref sequence index) new)
       (setq count (1- count)))))
 \f
-
-;;; REMOVEME: old POSITION/FIND stuff
-
-#|
-
-;;;; locater macros used by FIND and POSITION
-
-(eval-when (:compile-toplevel :execute)
-
-(sb!xc:defmacro vector-locater-macro (sequence body-form return-type)
-  `(let ((incrementer (if from-end -1 1))
-        (start (if from-end (1- (the fixnum end)) start))
-        (end (if from-end (1- (the fixnum start)) end)))
-     (declare (fixnum start end incrementer))
-     (do ((index start (+ index incrementer))
-         ,@(case return-type (:position nil) (:element '(current))))
-        ((= index end) ())
-       (declare (fixnum index))
-       ,@(case return-type
-          (:position nil)
-          (:element `((setf current (aref ,sequence index)))))
-       ,body-form)))
-
-(sb!xc:defmacro locater-test-not (item sequence seq-type return-type)
-  (let ((seq-ref (case return-type
-                  (:position
-                   (case seq-type
-                     (:vector `(aref ,sequence index))
-                     (:list `(pop ,sequence))))
-                  (:element 'current)))
-       (return (case return-type
-                 (:position 'index)
-                 (:element 'current))))
-    `(if test-not
-        (if (not (funcall test-not ,item (apply-key key ,seq-ref)))
-            (return ,return))
-        (if (funcall test ,item (apply-key key ,seq-ref))
-            (return ,return)))))
-
-(sb!xc:defmacro vector-locater (item sequence return-type)
-  `(vector-locater-macro ,sequence
-                        (locater-test-not ,item ,sequence :vector ,return-type)
-                        ,return-type))
-
-(sb!xc:defmacro locater-if-test (test sequence seq-type return-type sense)
-  (let ((seq-ref (case return-type
-                  (:position
-                   (case seq-type
-                     (:vector `(aref ,sequence index))
-                     (:list `(pop ,sequence))))
-                  (:element 'current)))
-       (return (case return-type
-                 (:position 'index)
-                 (:element 'current))))
-    (if sense
-       `(if (funcall ,test (apply-key key ,seq-ref))
-            (return ,return))
-       `(if (not (funcall ,test (apply-key key ,seq-ref)))
-            (return ,return)))))
-
-(sb!xc:defmacro vector-locater-if-macro (test sequence return-type sense)
-  `(vector-locater-macro ,sequence
-                        (locater-if-test ,test ,sequence :vector ,return-type ,sense)
-                        ,return-type))
-
-(sb!xc:defmacro vector-locater-if (test sequence return-type)
-  `(vector-locater-if-macro ,test ,sequence ,return-type t))
-
-(sb!xc:defmacro vector-locater-if-not (test sequence return-type)
-  `(vector-locater-if-macro ,test ,sequence ,return-type nil))
-
-(sb!xc:defmacro list-locater-macro (sequence body-form return-type)
-  `(if from-end
-       (do ((sequence (nthcdr (- (the fixnum (length sequence))
-                                (the fixnum end))
-                             (reverse (the list ,sequence))))
-           (index (1- (the fixnum end)) (1- index))
-           (terminus (1- (the fixnum start)))
-           ,@(case return-type (:position nil) (:element '(current))))
-          ((or (= index terminus) (null sequence)) ())
-        (declare (fixnum index terminus))
-        ,@(case return-type
-            (:position nil)
-            (:element `((setf current (pop ,sequence)))))
-        ,body-form)
-       (do ((sequence (nthcdr start ,sequence))
-           (index start (1+ index))
-           ,@(case return-type (:position nil) (:element '(current))))
-          ((or (= index (the fixnum end)) (null sequence)) ())
-        (declare (fixnum index))
-        ,@(case return-type
-            (:position nil)
-            (:element `((setf current (pop ,sequence)))))
-        ,body-form)))
-
-(sb!xc:defmacro list-locater (item sequence return-type)
-  `(list-locater-macro ,sequence
-                      (locater-test-not ,item ,sequence :list ,return-type)
-                      ,return-type))
-
-(sb!xc:defmacro list-locater-if-macro (test sequence return-type sense)
-  `(list-locater-macro ,sequence
-                      (locater-if-test ,test ,sequence :list ,return-type ,sense)
-                      ,return-type))
-
-(sb!xc:defmacro list-locater-if (test sequence return-type)
-  `(list-locater-if-macro ,test ,sequence ,return-type t))
-
-(sb!xc:defmacro list-locater-if-not (test sequence return-type)
-  `(list-locater-if-macro ,test ,sequence ,return-type nil))
-
-) ; EVAL-WHEN
-\f
-;;;; POSITION
-
-(eval-when (:compile-toplevel :execute)
-
-(sb!xc:defmacro vector-position (item sequence)
-  `(vector-locater ,item ,sequence :position))
-
-(sb!xc:defmacro list-position (item sequence)
-  `(list-locater ,item ,sequence :position))
-
-) ; EVAL-WHEN
-
-;;; POSITION 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 below).
-(defun position (item sequence &key from-end (test #'eql) test-not (start 0)
-                 end key)
-  #!+sb-doc
-  "Returns the zero-origin index of the first element in SEQUENCE
-   satisfying the test (default is EQL) with the given ITEM"
-  (seq-dispatch sequence
-    (list-position* item sequence from-end test test-not start end key)
-    (vector-position* item sequence from-end test test-not start end key)))
-
-;;; 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 list-position* (item sequence from-end test test-not start end key)
-  (declare (fixnum start))
-  (when (null end) (setf end (length sequence)))
-  (list-position item sequence))
-
-(defun vector-position* (item sequence from-end test test-not start end key)
-  (declare (fixnum start))
-  (when (null end) (setf end (length sequence)))
-  (vector-position item sequence))
-\f
-;;;; POSITION-IF
-
-(eval-when (:compile-toplevel :execute)
-
-(sb!xc:defmacro vector-position-if (test sequence)
-  `(vector-locater-if ,test ,sequence :position))
-
-(sb!xc:defmacro list-position-if (test sequence)
-  `(list-locater-if ,test ,sequence :position))
-
-) ; EVAL-WHEN
-
-(defun position-if (test sequence &key from-end (start 0) key end)
-  #!+sb-doc
-  "Returns the zero-origin index of the first element satisfying test(el)"
-  (declare (fixnum start))
-  (let ((end (or end (length sequence))))
-    (declare (type index end))
-    (seq-dispatch sequence
-                 (list-position-if test sequence)
-                 (vector-position-if test sequence))))
-\f
-;;;; POSITION-IF-NOT
-
-(eval-when (:compile-toplevel :execute)
-
-(sb!xc:defmacro vector-position-if-not (test sequence)
-  `(vector-locater-if-not ,test ,sequence :position))
-
-(sb!xc:defmacro list-position-if-not (test sequence)
-  `(list-locater-if-not ,test ,sequence :position))
-
-) ; EVAL-WHEN
-
-(defun position-if-not (test sequence &key from-end (start 0) key end)
-  #!+sb-doc
-  "Returns the zero-origin index of the first element not satisfying test(el)"
-  (declare (fixnum start))
-  (let ((end (or end (length sequence))))
-    (declare (type index end))
-    (seq-dispatch sequence
-                 (list-position-if-not test sequence)
-                 (vector-position-if-not test sequence))))
-\f
-;;;; FIND
-
-(eval-when (:compile-toplevel :execute)
-
-(sb!xc:defmacro vector-find (item sequence)
-  `(vector-locater ,item ,sequence :element))
-
-(sb!xc:defmacro list-find (item sequence)
-  `(list-locater ,item ,sequence :element))
-
-) ; EVAL-WHEN
-
-;;; Note: FIND 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 find (item sequence &key from-end (test #'eql) test-not (start 0)
-                 end key)
-  #!+sb-doc
-  "Returns the first element in SEQUENCE satisfying the test (default
-   is EQL) with the given ITEM"
-  (declare (fixnum start))
-  (seq-dispatch sequence
-    (list-find* item sequence from-end test test-not start end key)
-    (vector-find* item sequence from-end test test-not start end key)))
-
-;;; The support routines for FIND are used by compiler transforms, so we
-;;; worry about dealing with END being supplied or defaulting to NIL
-;;; at this level.
-
-(defun list-find* (item sequence from-end test test-not start end key)
-  (when (null end) (setf end (length sequence)))
-  (list-find item sequence))
-
-(defun vector-find* (item sequence from-end test test-not start end key)
-  (when (null end) (setf end (length sequence)))
-  (vector-find item sequence))
-\f
-;;;; FIND-IF and FIND-IF-NOT
-
-(eval-when (:compile-toplevel :execute)
-
-(sb!xc:defmacro vector-find-if (test sequence)
-  `(vector-locater-if ,test ,sequence :element))
-
-(sb!xc:defmacro list-find-if (test sequence)
-  `(list-locater-if ,test ,sequence :element))
-
-) ; EVAL-WHEN
-
-(defun find-if (test sequence &key from-end (start 0) end key)
-  #!+sb-doc
-  "Returns the zero-origin index of the first element satisfying the test."
-  (declare (fixnum start))
-  (let ((end (or end (length sequence))))
-    (declare (type index end))
-    (seq-dispatch sequence
-                 (list-find-if test sequence)
-                 (vector-find-if test sequence))))
-
-(eval-when (:compile-toplevel :execute)
-
-(sb!xc:defmacro vector-find-if-not (test sequence)
-  `(vector-locater-if-not ,test ,sequence :element))
-
-(sb!xc:defmacro list-find-if-not (test sequence)
-  `(list-locater-if-not ,test ,sequence :element))
-
-) ; EVAL-WHEN
-
-(defun find-if-not (test sequence &key from-end (start 0) end key)
-  #!+sb-doc
-  "Returns the zero-origin index of the first element not satisfying the test."
-  (declare (fixnum start))
-  (let ((end (or end (length sequence))))
-    (declare (type index end))
-    (seq-dispatch sequence
-                 (list-find-if-not test sequence)
-                 (vector-find-if-not test sequence))))
-|#
-\f
 ;;;; FIND, POSITION, and their -IF and -IF-NOT variants
 
 ;;; logic to unravel :TEST, :TEST-NOT, and :KEY options in FIND,