0.9.3.4:

   Speed up hashed remove-duplicate by properly sizing the hash table.
   Make an AVER in make-character-set-type run in O(n) instead
     of O(nlogn) time.

diff --git a/src/code/early-type.lisp b/src/code/early-type.lisp
index b338ad7..b1833ec 100644 (file)
--- a/src/code/early-type.lisp
+++ b/src/code/early-type.lisp
@@ -337,8 +337,13 @@
             (:copier nil))
   (pairs (missing-arg) :type list :read-only t))
 (defun make-character-set-type (&key pairs)
-  (aver (equal (mapcar #'car pairs)
-              (sort (mapcar #'car pairs) #'<)))
+  ; (aver (equal (mapcar #'car pairs)
+  ;              (sort (mapcar #'car pairs) #'<)))
+  ;; aver that the cars of the list elements are sorted into increasing order
+  (aver (or (null pairs)
+           (do ((p pairs (cdr p)))
+               ((null (cdr p)) t)
+             (when (> (caar p) (caadr p)) (return nil)))))
   (let ((pairs (let (result)
                 (do ((pairs pairs (cdr pairs)))
                     ((null pairs) (nreverse result))

diff --git a/src/code/seq.lisp b/src/code/seq.lisp
index a43e2f7..e88cb37 100644 (file)
--- a/src/code/seq.lisp
+++ b/src/code/seq.lisp
@@ -1549,6 +1549,7 @@
   (let* ((result (list ())) ; Put a marker on the beginning to splice with.
          (splice result)
          (current list)
+        (end (or end (length list)))
         (hash (and test
                    (not key)
                    (not test-not)
@@ -1556,37 +1557,43 @@
                        (eql test #'eq)
                        (eql test #'equal)
                        (eql test #'equalp))
-                   ; (> (if end (- end start) (- (length list) start)) 20)
-                   (make-hash-table :test test))))
+                   ; (> (- end start) 20)
+                   (make-hash-table :test test :size (- end start)))))
     (do ((index 0 (1+ index)))
         ((= index start))
       (declare (fixnum index))
-      ;; (if hash (setf (gethash (car current) hash) splice))
       (setq splice (cdr (rplacd splice (list (car current)))))
       (setq current (cdr current)))
-    (do ((index start (1+ index)))
-        ((or (and end (= index (the fixnum end)))
-             (atom current)))
-      (declare (fixnum index))
-      (cond
-       (hash
-       (let ((prev (gethash (car current) hash)))
-         (cond
-          ((not prev)
-           (setf (gethash (car current) hash) splice)
-           (setq splice (cdr (rplacd splice (list (car current))))))
-          (from-end nil)
-          (t
-           (let ((old (cdr prev)))
-             (let ((next (cdr old)))
-               (when next
+    (if hash
+       (do ((index start (1+ index)))
+           ((or (and end (= index (the fixnum end)))
+                (atom current)))
+         (declare (fixnum index))
+         ;; The hash table contains links from values that are
+         ;; already in result to the cons cell *preceding* theirs
+         ;; in the list.  That is, for each value v in the list,
+         ;; v and (cadr (gethash v hash)) are equal under TEST.
+         (let ((prev (gethash (car current) hash)))
+           (cond
+            ((not prev)
+             (setf (gethash (car current) hash) splice)
+             (setq splice (cdr (rplacd splice (list (car current))))))
+            ((not from-end)
+             (let* ((old (cdr prev))
+                    (next (cdr old)))
+               (if next
                  (let ((next-val (car next)))
                    ;; (assert (eq (gethash next-val hash) old))
                    (setf (cdr prev) next
                          (gethash next-val hash) prev
                          (gethash (car current) hash) splice
-                         splice (cdr (rplacd splice (list (car current)))))))))))))
-       (t
+                         splice (cdr (rplacd splice (list (car current))))))
+                 (setf (car old) (car current)))))))
+         (setq current (cdr current)))
+      (do ((index start (1+ index)))
+         ((or (and end (= index (the fixnum end)))
+              (atom current)))
+       (declare (fixnum index))
        (if (or (and from-end
                     (not (if test-not
                              (member (apply-key key (car current))
@@ -1610,8 +1617,8 @@
                                                  (apply-key key (car l))))
                                  (funcall test it (apply-key key (car l))))
                                (return t))))))
-           (setq splice (cdr (rplacd splice (list (car current))))))))
-      (setq current (cdr current)))
+           (setq splice (cdr (rplacd splice (list (car current))))))
+       (setq current (cdr current))))
     (do ()
         ((atom current))
       (setq splice (cdr (rplacd splice (list (car current)))))

diff --git a/version.lisp-expr b/version.lisp-expr
index 5ebaa57..4341743 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.9.3.3"
+"0.9.3.4"