Commit 27f80806 authored by Raymond Toy's avatar Raymond Toy
Browse files

Address #240: Speed up subsetp by using a hashtable

Like `set-difference`, but for `subsetp`.  We create a hashtable
for the second list to speed up `intersection`.
parent b100ecd4
Loading
Loading
Loading
Loading
Loading
+3 −0
Original line number Diff line number Diff line
@@ -347,6 +347,9 @@
  #+gengc (setf conditions::*handler-clusters* nil)
  (setq intl::*default-domain* "cmucl")
  (setq intl::*locale* "C")
  ;; During init, we can't use hashtables to speed up the set
  ;; functions.  In particular, subsetp is used in type-init.
  (setq lisp::*allow-hashtable-for-set-functions* nil)

  ;; Many top-level forms call INFO, (SETF INFO).
  (print-and-call c::globaldb-init)
+19 −4
Original line number Diff line number Diff line
@@ -749,9 +749,15 @@
(defparameter *min-list-length-for-hashtable*
  15)

(defparameter *allow-hashtable-for-set-functions*
  nil)

;; Convert a list to a hashtable.  The hashtable does not handle
;; duplicated values in the list.  Returns the hashtable.
(defun list-to-hashtable (list key test test-not)
  (unless *allow-hashtable-for-set-functions*
    (return-from list-to-hashtable nil))

  ;; Don't currently support test-not when converting a list to a hashtable
  (unless test-not
    (let ((hash-test (let ((test-fn (if (and (symbolp test)
@@ -976,10 +982,19 @@
(defun subsetp (list1 list2 &key key (test #'eql testp) (test-not nil notp))
  "Returns T if every element in list1 is also in list2."
  (declare (inline member))
  (dolist (elt list1)
    (unless (with-set-keys (member (apply-key key elt) list2))
  (when (and testp notp)
    (error "Test and test-not both supplied."))

  (let ((hashtable (list-to-hashtable list2 key test test-not)))
    (cond (hashtable
	   (dolist (item list1)
	     (unless (nth-value 1 (gethash (apply-key key item) hashtable))
	       (return-from subsetp nil))))
	  ((null hashtable)
	   (dolist (item list1)
	     (unless (with-set-keys (member (apply-key key item) list2))
	       (return-from subsetp nil)))
  T)
	   T))))



+2 −0
Original line number Diff line number Diff line
@@ -320,6 +320,8 @@
	     (intl::setlocale)
	     (ext::process-command-strings process-command-line)
	     (setf *editor-lisp-p* nil)
	     ;; Allow using hashtables to speed up the set functions
	     (setf lisp::*allow-hashtable-for-set-functions* t)
	     (macrolet ((find-switch (name)
			  `(find ,name *command-line-switches*
				 :key #'cmd-switch-name