Changeset 13931

Timestamp:

05/06/12 13:37:33 (11 years ago)

Author:

Mark Evenson

Message:

Fixes #196: STABLE-SORT is only stable for lists.

Somewhat kludgily fix the macrology submitted by Jorge Tavares to pass
all the newly failing ANSI tests introduced. The macrology of
MERGE-VECTORS-BODY and MERGE-SORT-BODY required that the sequences
were of type SIMPLE-VECTOR. But somehow, MERGE-SORT-BODY was not
working when asked to stable sort sequences of type BIT-VECTOR or
STRING, both of which are subtypes of VECTOR but not SIMPLE-VECTOR.

File:

• trunk/abcl/src/org/armedbear/lisp/sort.lisp (modified) (5 diffs)

trunk/abcl/src/org/armedbear/lisp/sort.lisp

@@ -52 +52 @@
 ;;; - the merge-vectors algorithm is inspired from the CCL base code 
 ;;;
+
+;;; http://trac.common-lisp.net/armedbear/ticket/196
+;;; TODO Restore the optimization for SIMPLE-VECTOR types by
+;;; conditionally using aref/svref instead of always using AREF
 
 (defmacro merge-vectors-body (type ref a start-a end-a b start-b end-b aux start-aux predicate &optional key)
@@ -96 +100 @@
          (if (funcall ,predicate ,k-b ,k-a)
        (progn 
-         (setf (svref ,aux ,i-aux) ,v-b
+;;         (setf (svref ,aux ,i-aux) ,v-b ;; FIXME Ticket #196
+         (setf (aref ,aux ,i-aux) ,v-b
          ,i-aux (+ ,i-aux 1)
          ,i-b (+ ,i-b 1))
@@ -105 +110 @@
                `(,k-b ,v-b))))
        (progn 
-         (setf (svref ,aux ,i-aux) ,v-a
+;;         (setf (svref ,aux ,i-aux) ,v-a ;; FIXME Ticket #196
+         (setf (aref ,aux ,i-aux) ,v-a
          ,i-aux (+ ,i-aux 1)
          ,i-a (+ ,i-a 1))
@@ -119 +125 @@
                `(,k-a ,v-a))))))))
       (loop
-        (setf (svref ,aux ,i-aux) ,v-a
+;;        (setf (svref ,aux ,i-aux) ,v-a ;; FIXME Ticket #196
+        (setf (aref ,aux ,i-aux) ,v-a
         ,i-a (+ ,i-a 1))
         (when (= ,i-a ,end-a) (return))
@@ -157 +164 @@
                 ,mid ,end ,aux ,start ,predicate)))))
    (let ((,maux (make-array ,mend)))
-     (declare (type simple-vector ,maux))
+;;     (declare (type simple-vector ,maux))
+     (declare (type vector ,maux))
      (,merge-sort-call ,msequence ,mstart ,mend ,mpredicate ,mkey ,maux nil))))))