0.8.18.3:

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

diff --git a/src/code/seq.lisp b/src/code/seq.lisp
index 777ee4a..b05450e 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)
            (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)))
                    (t type)))
            (t type)))
         (type (specifier-type adjusted-type)))

@@ -472,6 +473,8 @@
                            (1- source-index)))
             ((= target-index (the fixnum (1- target-start))) target-sequence)
           (declare (fixnum target-index source-index))
                            (1- source-index)))
             ((= target-index (the fixnum (1- target-start))) target-sequence)
           (declare (fixnum target-index source-index))

+          ;; disable bounds checking
+          (declare (optimize (safety 0)))

           (setf (aref target-sequence target-index)
                 (aref source-sequence source-index))))
        (do ((target-index target-start (1+ target-index))
           (setf (aref target-sequence target-index)
                 (aref source-sequence source-index))))
        (do ((target-index target-start (1+ target-index))

@@ -480,6 +483,8 @@
                (= source-index (the fixnum source-end)))
            target-sequence)
         (declare (fixnum target-index source-index))
                (= source-index (the fixnum source-end)))
            target-sequence)
         (declare (fixnum target-index source-index))

+        ;; disable bounds checking
+        (declare (optimize (safety 0)))

         (setf (aref target-sequence target-index)
               (aref source-sequence source-index)))))
 
         (setf (aref target-sequence target-index)
               (aref source-sequence source-index)))))
 

@@ -564,6 +569,15 @@
   (when (null source-end) (setq source-end (length source-sequence)))
   (mumble-replace-from-mumble))
 
   (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
 (define-sequence-traverser replace
     (sequence1 sequence2 &key start1 end1 start2 end2)
   #!+sb-doc

@@ -1544,7 +1558,7 @@
       (declare (fixnum index))
       (setq splice (cdr (rplacd splice (list (car current)))))
       (setq current (cdr current)))
       (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))
        ((or (and end (= index (the fixnum end)))
             (atom current)))
       (declare (fixnum index))

@@ -2002,7 +2016,7 @@
                           (simple-base-string (frob2))
                           (t (vector*-frob sequence))))
                     (declare (type (or index null) p))
                           (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
   (defun %find-position (item sequence-arg from-end start end key test)
     (macrolet ((frob (sequence from-end)
                 `(%find-position item ,sequence