| ... |
... |
@@ -991,6 +991,35 @@ |
|
991
|
991
|
|
|
992
|
992
|
(defvar *allow-hashtable-for-set-functions* t)
|
|
993
|
993
|
|
|
|
994
|
+(declaim (start-block shorter-list-to-hashtable subsetp))
|
|
|
995
|
+
|
|
|
996
|
+(defun shorter-list-to-hashtable (list1 list2 key test test-not)
|
|
|
997
|
+ ;; Find the shorter list and return the length and the shorter list
|
|
|
998
|
+ (when test-not
|
|
|
999
|
+ (return-from shorter-list-to-hashtable nil))
|
|
|
1000
|
+ (let ((hash-test (let ((test-fn (if (and (symbolp test)
|
|
|
1001
|
+ (fboundp test))
|
|
|
1002
|
+ (fdefinition test)
|
|
|
1003
|
+ test)))
|
|
|
1004
|
+ (cond ((eql test-fn #'eq) 'eq)
|
|
|
1005
|
+ ((eql test-fn #'eql) 'eql)
|
|
|
1006
|
+ ((eql test-fn #'equal) 'equal)
|
|
|
1007
|
+ ((eql test-fn #'equalp) 'equalp)))))
|
|
|
1008
|
+ (unless hash-test
|
|
|
1009
|
+ (return-from shorter-list-to-hashtable nil))
|
|
|
1010
|
+ (multiple-value-bind (min-length shorter-list)
|
|
|
1011
|
+ (do ((len 0 (1+ len))
|
|
|
1012
|
+ (lst1 list1 (cdr lst1))
|
|
|
1013
|
+ (lst2 list2 (cdr lst2)))
|
|
|
1014
|
+ ((or (null lst1) (null lst2))
|
|
|
1015
|
+ (values len (if (null lst1) list1 list2))))
|
|
|
1016
|
+ (when (< min-length *min-list-length-for-hashtable*)
|
|
|
1017
|
+ (return-from shorter-list-to-hashtable nil))
|
|
|
1018
|
+ (let ((hashtable (make-hash-table :test hash-test :size min-length)))
|
|
|
1019
|
+ (dolist (item shorter-list)
|
|
|
1020
|
+ (setf (gethash (apply-key key item) hashtable) item))
|
|
|
1021
|
+ (values hashtable shorter-list)))))
|
|
|
1022
|
+
|
|
994
|
1023
|
(defun subsetp (list1 list2 &key key (test #'eql testp) (test-not nil notp))
|
|
995
|
1024
|
"Returns T if every element in list1 is also in list2."
|
|
996
|
1025
|
(declare (inline member))
|
| ... |
... |
@@ -1001,20 +1030,31 @@ |
|
1001
|
1030
|
;; available yet, so we can't use hashtables then. LISPINIT will
|
|
1002
|
1031
|
;; take care to disable this for the kernel.core. SAVE will set
|
|
1003
|
1032
|
;; this to true when it's safe to use hash tables for SUBSETP.
|
|
1004
|
|
- (let ((hashtable
|
|
1005
|
|
- (when *allow-hashtable-for-set-functions*
|
|
1006
|
|
- (list-to-hashtable list2 key test test-not))))
|
|
|
1033
|
+ (multiple-value-bind (hashtable shorter-list)
|
|
|
1034
|
+ (when *allow-hashtable-for-set-functions*
|
|
|
1035
|
+ (shorter-list-to-hashtable list1 list2 key test test-not))
|
|
1007
|
1036
|
(cond (hashtable
|
|
1008
|
|
- (dolist (item list1)
|
|
1009
|
|
- (unless (nth-value 1 (gethash (apply-key key item) hashtable))
|
|
1010
|
|
- (return-from subsetp nil)))
|
|
1011
|
|
- t)
|
|
|
1037
|
+ (cond ((eq shorter-list list1)
|
|
|
1038
|
+ ;; Remove any item from list2 from the hashtable containing list1.
|
|
|
1039
|
+ (dolist (item list2)
|
|
|
1040
|
+ (remhash (apply-key key item) hashtable))
|
|
|
1041
|
+ ;; If the hash table is now empty, then every
|
|
|
1042
|
+ ;; element in list1 appeared in list2, so list1 is a
|
|
|
1043
|
+ ;; subset of list2.
|
|
|
1044
|
+ (zerop (hash-table-count hashtable)))
|
|
|
1045
|
+ ((eq shorter-list list2)
|
|
|
1046
|
+ (dolist (item list1)
|
|
|
1047
|
+ (unless (nth-value 1 (gethash (apply-key key item) hashtable))
|
|
|
1048
|
+ (return-from subsetp nil)))
|
|
|
1049
|
+ t)))
|
|
1012
|
1050
|
(t
|
|
1013
|
1051
|
(dolist (item list1)
|
|
1014
|
1052
|
(unless (with-set-keys (member (apply-key key item) list2))
|
|
1015
|
1053
|
(return-from subsetp nil)))
|
|
1016
|
1054
|
T))))
|
|
1017
|
1055
|
|
|
|
1056
|
+(declaim (end-block))
|
|
|
1057
|
+
|
|
1018
|
1058
|
|
|
1019
|
1059
|
;;; Functions that operate on association lists
|
|
1020
|
1060
|
|