Raymond Toy pushed to branch issue-240-subsetp-with-hash-table at cmucl / cmucl Commits: 46f5352a by Raymond Toy at 2023-08-20T15:17:51-07:00 Always hash list2 and add tests Made a logic error; we can't hash the shorter of the two lists, at least not without a big change to the implementation. We always hash the second list now. Remove shorter-list-to-hashtable. Add tests for subsetp. - - - - - 2 changed files: - src/code/list.lisp - tests/sets.lisp Changes: ===================================== src/code/list.lisp ===================================== @@ -991,35 +991,6 @@ (defvar *allow-hashtable-for-set-functions* t) -(declaim (start-block shorter-list-to-hashtable subsetp)) - -(defun shorter-list-to-hashtable (list1 list2 key test test-not) - ;; Find the shorter list and return the length and the shorter list - (when test-not - (return-from shorter-list-to-hashtable nil)) - (let ((hash-test (let ((test-fn (if (and (symbolp test) - (fboundp test)) - (fdefinition test) - test))) - (cond ((eql test-fn #'eq) 'eq) - ((eql test-fn #'eql) 'eql) - ((eql test-fn #'equal) 'equal) - ((eql test-fn #'equalp) 'equalp))))) - (unless hash-test - (return-from shorter-list-to-hashtable nil)) - (multiple-value-bind (min-length shorter-list) - (do ((len 0 (1+ len)) - (lst1 list1 (cdr lst1)) - (lst2 list2 (cdr lst2))) - ((or (null lst1) (null lst2)) - (values len (if (null lst1) list1 list2)))) - (when (< min-length *min-list-length-for-hashtable*) - (return-from shorter-list-to-hashtable nil)) - (let ((hashtable (make-hash-table :test hash-test :size min-length))) - (dolist (item shorter-list) - (setf (gethash (apply-key key item) hashtable) item)) - (values hashtable shorter-list))))) - (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)) @@ -1029,28 +1000,21 @@ ;; 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. - (multiple-value-bind (hashtable shorter-list) - (when *allow-hashtable-for-set-functions* - (shorter-list-to-hashtable list1 list2 key test test-not)) + ;; this to true when 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 ((eq shorter-list list1) - (dolist (item list2) - (unless (nth-value 1 (gethash (apply-key key item) hashtable)) - (return-from subsetp nil)))) - ((eq shorter-list list2) - (dolist (item list1) - (unless (nth-value 1 (gethash (apply-key key item) hashtable)) - (return-from subsetp nil))))) + (dolist (item list1) + (unless (nth-value 1 (gethash (apply-key key item) hashtable)) + (return-from subsetp nil))) t) - ((null hashtable) + (t (dolist (item list1) (unless (with-set-keys (member (apply-key key item) list2)) (return-from subsetp nil))) T)))) -(declaim (end-block)) -  ;;; Functions that operate on association lists ===================================== tests/sets.lisp ===================================== @@ -172,3 +172,54 @@ '(3 4) :test 'eql :test-not 'eql))) + + +(define-test subsetp.hash-eq + (:tag :issues) + (let ((lisp::*min-list-length-for-hashtable* 2)) + (assert-true + (subsetp '(a b c a) '(a a d d c b) :test 'eq)) + (assert-true + (subsetp '(a b c a b c a b c) '(a a d d c b) :test 'eq)) + (assert-false + (subsetp '(a b c a z) '(a a d d c b) :test 'eq)) + (assert-false + (subsetp '(a b c a b cz) '(a a d d c b) :test 'eq)))) + +(define-test subsetp.hash-eql + (:tag :issues) + (let ((lisp::*min-list-length-for-hashtable* 2)) + (assert-true + (subsetp '(a b c a) '(a a d d c b) :test 'eql)) + (assert-false + (subsetp '(a b c a z) '(a a d d c b) :test 'eql)))) + +(define-test subsetp.hash-equal + (:tag :issues) + (let ((lisp::*min-list-length-for-hashtable* 2)) + (assert-true + (subsetp '("a" "b" "c" "a") '("a" "a" "d" "d" "c" "b") :test 'equal)) + (assert-false + (subsetp '("a" "b" "c" "a" "z") '("a" "a" "d" "d" "c" "b") :test 'equal)))) + +(define-test subsetp.hash-equalp + (:tag :issues) + (let ((lisp::*min-list-length-for-hashtable* 2)) + (assert-true + (subsetp '("a" "b" "C" "A") '("a" "a" "d" "d" "c" "b") :test 'equalp)) + (assert-false + (subsetp '("a" "b" "C" "A" "z") '("a" "a" "d" "d" "c" "b") :test 'equalp)))) + +(define-test subsetp.hash-eql-with-key + (:tag :issues) + (assert-true (subsetp '((1 "a") (2 "b") (3 "c")) + '((3 "c") (3 "c") (2 "b") (1 "a")) + :test 'eql + :key #'first))) + +(define-test subsetp.test-and-test-not + (assert-error 'simple-error + (subsetp '(1 2) + '(3 4) + :test 'eql + :test-not 'equal))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/46f5352ac1d9edc8f8c09981... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/46f5352ac1d9edc8f8c09981... You're receiving this email because of your account on gitlab.common-lisp.net.