0.8.19.8:

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

diff --git a/src/code/seq.lisp b/src/code/seq.lisp
index d7d1f43..631e848 100644 (file)
--- a/src/code/seq.lisp
+++ b/src/code/seq.lisp
@@ -275,8 +275,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 +569,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 +1079,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 +1093,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 +1106,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 +1121,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
 
@@ -1132,7 +1137,8 @@
     (function sequence &key key from-end start end (initial-value nil ivp))
   (declare (type index start))
   (let ((start start)
-       (end (or end length)))
+       (end (or end length))
+        (function (%coerce-callable-to-fun function)))
     (declare (type index start end))
     (cond ((= end start)
           (if ivp initial-value (funcall function)))
@@ -1548,7 +1554,7 @@
       (declare (fixnum index))
       (setq splice (cdr (rplacd splice (list (car current)))))
       (setq current (cdr current)))
-    (do ((index 0 (1+ index)))
+    (do ((index start (1+ index)))
        ((or (and end (= index (the fixnum end)))
             (atom current)))
       (declare (fixnum index))
@@ -2006,7 +2012,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