| ... |
... |
@@ -997,22 +997,55 @@ |
|
997
|
997
|
(when (and testp notp)
|
|
998
|
998
|
(error "Test and test-not both supplied."))
|
|
999
|
999
|
|
|
1000
|
|
- ;; SUBSETP is used early in TYPE-INIT where hash tables aren't
|
|
1001
|
|
- ;; available yet, so we can't use hashtables then. LISPINIT will
|
|
1002
|
|
- ;; take care to disable this for the kernel.core. SAVE will set
|
|
1003
|
|
- ;; this to true it's safe to use hash tables for SUBSETP.
|
|
1004
|
|
- (let ((hashtable (when *allow-hashtable-for-set-functions*
|
|
1005
|
|
- (list-to-hashtable list2 key test test-not))))
|
|
1006
|
|
- (cond (hashtable
|
|
1007
|
|
- (dolist (item list1)
|
|
1008
|
|
- (unless (nth-value 1 (gethash (apply-key key item) hashtable))
|
|
1009
|
|
- (return-from subsetp nil)))
|
|
1010
|
|
- t)
|
|
1011
|
|
- ((null hashtable)
|
|
1012
|
|
- (dolist (item list1)
|
|
1013
|
|
- (unless (with-set-keys (member (apply-key key item) list2))
|
|
1014
|
|
- (return-from subsetp nil)))
|
|
1015
|
|
- T))))
|
|
|
1000
|
+ (flet ((lists-to-hashtable ()
|
|
|
1001
|
+ ;; Find the shorter list and return the length and the shorter list
|
|
|
1002
|
+ (when test-not
|
|
|
1003
|
+ (return-from lists-to-hashtable nil))
|
|
|
1004
|
+ (let ((hash-test (let ((test-fn (if (and (symbolp test)
|
|
|
1005
|
+ (fboundp test))
|
|
|
1006
|
+ (fdefinition test)
|
|
|
1007
|
+ test)))
|
|
|
1008
|
+ (cond ((eql test-fn #'eq) 'eq)
|
|
|
1009
|
+ ((eql test-fn #'eql) 'eql)
|
|
|
1010
|
+ ((eql test-fn #'equal) 'equal)
|
|
|
1011
|
+ ((eql test-fn #'equalp) 'equalp)))))
|
|
|
1012
|
+ (unless hash-test
|
|
|
1013
|
+ (return-from lists-to-hashtable nil))
|
|
|
1014
|
+ (multiple-value-bind (min-length shorter-list)
|
|
|
1015
|
+ (do ((len 0 (1+ len))
|
|
|
1016
|
+ (lst1 list1 (cdr lst1))
|
|
|
1017
|
+ (lst2 list2 (cdr lst2)))
|
|
|
1018
|
+ ((or (null lst1) (null lst2))
|
|
|
1019
|
+ (values len (if (null lst1) list1 list2))))
|
|
|
1020
|
+ (when (< min-length *min-list-length-for-hashtable*)
|
|
|
1021
|
+ (return-from lists-to-hashtable nil))
|
|
|
1022
|
+ (let ((hashtable (make-hash-table :test hash-test :size min-length)))
|
|
|
1023
|
+ (dolist (item shorter-list)
|
|
|
1024
|
+ (setf (gethash (apply-key key item) hashtable) item))
|
|
|
1025
|
+ (values hashtable shorter-list))))))
|
|
|
1026
|
+
|
|
|
1027
|
+ ;; SUBSETP is used early in TYPE-INIT where hash tables aren't
|
|
|
1028
|
+ ;; available yet, so we can't use hashtables then. LISPINIT will
|
|
|
1029
|
+ ;; take care to disable this for the kernel.core. SAVE will set
|
|
|
1030
|
+ ;; this to true it's safe to use hash tables for SUBSETP.
|
|
|
1031
|
+ (multiple-value-bind (hashtable shorter-list)
|
|
|
1032
|
+ (when *allow-hashtable-for-set-functions*
|
|
|
1033
|
+ (lists-to-hashtable))
|
|
|
1034
|
+ (cond (hashtable
|
|
|
1035
|
+ (cond ((eq shorter-list list1)
|
|
|
1036
|
+ (dolist (item list2)
|
|
|
1037
|
+ (unless (nth-value 1 (gethash (apply-key key item) hashtable))
|
|
|
1038
|
+ (return-from subsetp nil))))
|
|
|
1039
|
+ ((eq shorter-list list2)
|
|
|
1040
|
+ (dolist (item list1)
|
|
|
1041
|
+ (unless (nth-value 1 (gethash (apply-key key item) hashtable))
|
|
|
1042
|
+ (return-from subsetp nil)))))
|
|
|
1043
|
+ t)
|
|
|
1044
|
+ ((null hashtable)
|
|
|
1045
|
+ (dolist (item list1)
|
|
|
1046
|
+ (unless (with-set-keys (member (apply-key key item) list2))
|
|
|
1047
|
+ (return-from subsetp nil)))
|
|
|
1048
|
+ T)))))
|
|
1016
|
1049
|
|
|
1017
|
1050
|
|
|
1018
|
1051
|
|