0.8.19.13:

[sbcl.git] / src / code / seq.lisp

diff --git a/src/code/seq.lisp b/src/code/seq.lisp
index b05450e..ccc89a7 100644 (file)
--- 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)))
                                    (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
          (t (let ((info (cdr (assoc arg *sequence-keyword-info*))))
               (cond (info
                      (destructuring-bind (default supplied-p adjuster type) info

@@ -1079,8 +1082,7 @@
                               ref)
   `(do ((index ,start (1+ index))
        (value ,initial-value))
                               ref)
   `(do ((index ,start (1+ index))
        (value ,initial-value))

-       ((= index (the fixnum ,end)) value)
-     (declare (fixnum index))
+       ((>= index ,end) value)

      (setq value (funcall ,function value
                          (apply-key ,key (,ref ,sequence index))))))
 
      (setq value (funcall ,function value
                          (apply-key ,key (,ref ,sequence index))))))
 

@@ -1094,8 +1096,7 @@
   `(do ((index (1- ,end) (1- index))
        (value ,initial-value)
        (terminus (1- ,start)))
   `(do ((index (1- ,end) (1- index))
        (value ,initial-value)
        (terminus (1- ,start)))

-       ((= index terminus) value)
-     (declare (fixnum index terminus))
+       ((<= index terminus) value)

      (setq value (funcall ,function
                          (apply-key ,key (,ref ,sequence index))
                          value))))
      (setq value (funcall ,function
                          (apply-key ,key (,ref ,sequence index))
                          value))))

@@ -1108,14 +1109,13 @@
                             initial-value
                             ivp)
   `(let ((sequence (nthcdr ,start ,sequence)))
                             initial-value
                             ivp)
   `(let ((sequence (nthcdr ,start ,sequence)))

-     (do ((count (if ,ivp ,start (1+ (the fixnum ,start)))
+     (do ((count (if ,ivp ,start (1+ ,start))

                 (1+ count))
          (sequence (if ,ivp sequence (cdr sequence))
                    (cdr sequence))
          (value (if ,ivp ,initial-value (apply-key ,key (car sequence)))
                 (funcall ,function value (apply-key ,key (car sequence)))))
                 (1+ count))
          (sequence (if ,ivp sequence (cdr sequence))
                    (cdr sequence))
          (value (if ,ivp ,initial-value (apply-key ,key (car sequence)))
                 (funcall ,function value (apply-key ,key (car sequence)))))

-        ((= count (the fixnum ,end)) value)
-       (declare (fixnum count)))))
+        ((>= count ,end) value))))

 
 (sb!xc:defmacro list-reduce-from-end (function
                                      sequence
 
 (sb!xc:defmacro list-reduce-from-end (function
                                      sequence

@@ -1124,17 +1124,15 @@
                                      end
                                      initial-value
                                      ivp)
                                      end
                                      initial-value
                                      ivp)

-  `(let ((sequence (nthcdr (- (the fixnum (length ,sequence))
-                             (the fixnum ,end))
+  `(let ((sequence (nthcdr (- (length ,sequence) ,end)

                           (reverse ,sequence))))
                           (reverse ,sequence))))

-     (do ((count (if ,ivp ,start (1+ (the fixnum ,start)))
+     (do ((count (if ,ivp ,start (1+ ,start))

                 (1+ count))
          (sequence (if ,ivp sequence (cdr sequence))
                    (cdr sequence))
          (value (if ,ivp ,initial-value (apply-key ,key (car sequence)))
                 (funcall ,function (apply-key ,key (car sequence)) value)))
                 (1+ count))
          (sequence (if ,ivp sequence (cdr sequence))
                    (cdr sequence))
          (value (if ,ivp ,initial-value (apply-key ,key (car sequence)))
                 (funcall ,function (apply-key ,key (car sequence)) value)))

-        ((= count (the fixnum ,end)) value)
-       (declare (fixnum count)))))
+        ((>= count ,end) value))))

 
 ) ; EVAL-WHEN
 
 
 ) ; EVAL-WHEN
 

@@ -1511,8 +1509,7 @@
 (define-sequence-traverser remove-if
     (predicate sequence &key from-end start end count key)
   #!+sb-doc
 (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)))
     (declare (type index end))
   (declare (fixnum start))
   (let ((end (or end length)))
     (declare (type index end))

@@ -1527,8 +1524,7 @@
 (define-sequence-traverser remove-if-not
     (predicate sequence &key from-end start end count key)
   #!+sb-doc
 (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)))
     (declare (type index end))
   (declare (fixnum start))
   (let ((end (or end length)))
     (declare (type index end))

@@ -1817,8 +1813,7 @@
          start count end key)
   #!+sb-doc
   "Return a sequence of the same kind as SEQUENCE with the same elements,
          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))
   (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
 ;;;; 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
   #!+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))
   (declare (fixnum start))
   (let ((end (or end length))

-        (test pred)
-       test-not
+        (test predicate)
+       (test-not nil)

        old)
     (declare (type index length end))
     (subst-dispatch 'if)))
 
 (define-sequence-traverser substitute-if-not
        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
   #!+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))
   (declare (fixnum start))
   (let ((end (or end length))

-        (test pred)
-       test-not
+        (test predicate)
+       (test-not nil)

        old)
     (declare (type index length end))
     (subst-dispatch 'if-not)))
        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
          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)
   (declare (fixnum start))
   (let ((end (or end length)))
     (if (listp sequence)

@@ -1909,11 +1902,11 @@
 ;;;; NSUBSTITUTE-IF, NSUBSTITUTE-IF-NOT
 
 (define-sequence-traverser nsubstitute-if
 ;;;; 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
   #!+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)))
     (declare (fixnum end))
   (declare (fixnum start))
   (let ((end (or end length)))
     (declare (fixnum end))

@@ -1921,14 +1914,14 @@
        (if from-end
            (let ((length (length sequence)))
              (nreverse (nlist-substitute-if*
        (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)))
                         (- 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
                                  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)
                                    (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)
                                    start end count key)))))
 
 (defun nlist-substitute-if* (new test sequence start end count key)

@@ -1949,11 +1942,11 @@
       (setq count (1- count)))))
 
 (define-sequence-traverser nsubstitute-if-not
       (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
   #!+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)))
     (declare (fixnum end))
   (declare (fixnum start))
   (let ((end (or end length)))
     (declare (fixnum end))

@@ -1961,14 +1954,14 @@
        (if from-end
            (let ((length (length sequence)))
              (nreverse (nlist-substitute-if-not*
        (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)))
                         (- 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
                                      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)
                                        (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)
                                        start end count key)))))
 
 (defun nlist-substitute-if-not* (new test sequence start end count key)

@@ -2104,7 +2097,8 @@
   #!+sb-doc
   "Return the number of elements in SEQUENCE satisfying PRED(el)."
   (declare (fixnum start))
   #!+sb-doc
   "Return the number of elements in SEQUENCE satisfying PRED(el)."
   (declare (fixnum start))

-  (let ((end (or end length)))
+  (let ((end (or end length))
+       (pred (%coerce-callable-to-fun pred)))

     (declare (type index end))
     (seq-dispatch sequence
                  (if from-end
     (declare (type index end))
     (seq-dispatch sequence
                  (if from-end

@@ -2119,7 +2113,8 @@
   #!+sb-doc
   "Return the number of elements in SEQUENCE not satisfying TEST(el)."
   (declare (fixnum start))
   #!+sb-doc
   "Return the number of elements in SEQUENCE not satisfying TEST(el)."
   (declare (fixnum start))

-  (let ((end (or end length)))
+  (let ((end (or end length))
+       (pred (%coerce-callable-to-fun pred)))

     (declare (type index end))
     (seq-dispatch sequence
                  (if from-end
     (declare (type index end))
     (seq-dispatch sequence
                  (if from-end