Commit a4c90a8b authored by Raymond Toy's avatar Raymond Toy
Browse files

Fix up bad merge and disable hashtable only for subsetp

We mistakenly removed *allow-hashtable-for-set-functions* when merging
with master.  Put it all back.  However, modify it so we only disable
hashtables for subsetp because that's the only function (so far) that
is used in TYPE-INIT where hashtables aren't available yet.
parent d22817cb
Loading
Loading
Loading
Loading
Loading
+10 −2
Original line number Original line Diff line number Diff line
@@ -973,17 +973,25 @@
	      (rplacd splicex (cdr x)))
	      (rplacd splicex (cdr x)))
	  (setq splicex x)))))
	  (setq splicex x)))))


(defvar *allow-hashtable-for-set-functions* t)

(defun subsetp (list1 list2 &key key (test #'eql testp) (test-not nil notp))
(defun subsetp (list1 list2 &key key (test #'eql testp) (test-not nil notp))
  "Returns T if every element in list1 is also in list2."
  "Returns T if every element in list1 is also in list2."
  (declare (inline member))
  (declare (inline member))
  (when (and testp notp)
  (when (and testp notp)
    (error "Test and test-not both supplied."))
    (error "Test and test-not both supplied."))


  (let ((hashtable (list-to-hashtable list2 key test test-not)))
  ;; SUBSETP is used early in TYPE-INIT where hash tables aren't
  ;; available yet, so we can't use hashtables then.  LISPINIT will
  ;; take care to disable this for the kernel.core.  SAVE will set
  ;; this to true it's safe to use hash tables for SUBSETP.
  (let ((hashtable (when *allow-hashtable-for-set-functions*
                     (list-to-hashtable list2 key test test-not))))
    (cond (hashtable
    (cond (hashtable
	   (dolist (item list1)
	   (dolist (item list1)
	     (unless (nth-value 1 (gethash (apply-key key item) hashtable))
	     (unless (nth-value 1 (gethash (apply-key key item) hashtable))
	       (return-from subsetp nil))))
	       (return-from subsetp nil)))
           t)
	  ((null hashtable)
	  ((null hashtable)
	   (dolist (item list1)
	   (dolist (item list1)
	     (unless (with-set-keys (member (apply-key key item) list2))
	     (unless (with-set-keys (member (apply-key key item) list2))