X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fseq.lisp;h=ccc89a741b3b569c783751a984cfba3eeae0d690;hb=b2ad48f269cd6b9403820588d65eac526e4e32fd;hp=5afbc7fe5e7205fa3607f5935de2c6ba0368aa59;hpb=b9259fb16c44cb32bc39e76e14741f8fa4d4dab6;p=sbcl.git

diff --git a/src/code/seq.lisp b/src/code/seq.lisp
index 5afbc7f..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
@@ -275,8 +278,9 @@
 	    (cons (cond
 		    ((eq (car type) 'string) `(vector character ,@(cdr type)))
 		    ((eq (car type) 'simple-string)
-		     `(simple-array character ,@(when (cdr type)
-						      (list (cdr type)))))
+		     `(simple-array character ,(if (cdr type)
+						   (cdr type)
+						   '(*))))
 		    (t type)))
 	    (t type)))
 	 (type (specifier-type adjusted-type)))
@@ -568,6 +572,15 @@
   (when (null source-end) (setq source-end (length source-sequence)))
   (mumble-replace-from-mumble))
 
+#!+sb-unicode
+(defun simple-character-string-replace-from-simple-character-string*
+    (target-sequence source-sequence
+     target-start target-end source-start source-end)
+  (declare (type (simple-array character (*)) target-sequence source-sequence))
+  (when (null target-end) (setq target-end (length target-sequence)))
+  (when (null source-end) (setq source-end (length source-sequence)))
+  (mumble-replace-from-mumble))
+
 (define-sequence-traverser replace
     (sequence1 sequence2 &key start1 end1 start2 end2)
   #!+sb-doc
@@ -1069,8 +1082,7 @@
 			       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))))))
 
@@ -1084,8 +1096,7 @@
   `(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))))
@@ -1098,14 +1109,13 @@
 			     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)))))
-	 ((= count (the fixnum ,end)) value)
-       (declare (fixnum count)))))
+	 ((>= count ,end) value))))
 
 (sb!xc:defmacro list-reduce-from-end (function
 				      sequence
@@ -1114,17 +1124,15 @@
 				      end
 				      initial-value
 				      ivp)
-  `(let ((sequence (nthcdr (- (the fixnum (length ,sequence))
-			      (the fixnum ,end))
+  `(let ((sequence (nthcdr (- (length ,sequence) ,end)
 			   (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)))
-	 ((= count (the fixnum ,end)) value)
-       (declare (fixnum count)))))
+	 ((>= count ,end) value))))
 
 ) ; EVAL-WHEN
 
@@ -1501,8 +1509,7 @@
 (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))
@@ -1517,8 +1524,7 @@
 (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))
@@ -1807,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))
@@ -1817,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 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 pred)
-	test-not
+        (test predicate)
+	(test-not nil)
 	old)
     (declare (type index length end))
     (subst-dispatch 'if-not)))
@@ -1851,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)
@@ -1899,11 +1902,11 @@
 ;;;; 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)))
     (declare (fixnum end))
@@ -1911,14 +1914,14 @@
 	(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)
@@ -1939,11 +1942,11 @@
       (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)))
     (declare (fixnum end))
@@ -1951,14 +1954,14 @@
 	(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)
@@ -2006,7 +2009,7 @@
 			   (simple-base-string (frob2))
 			   (t (vector*-frob sequence))))
 		     (declare (type (or index null) p))
-		     (values f (and p (the index (+ p offset))))))))))
+		     (values f (and p (the index (- p offset))))))))))
   (defun %find-position (item sequence-arg from-end start end key test)
     (macrolet ((frob (sequence from-end)
 		 `(%find-position item ,sequence
@@ -2094,7 +2097,8 @@
   #!+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
@@ -2109,7 +2113,8 @@
   #!+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