- cmucl-cvs - mailman3.common-lisp.net

[Git][cmucl/cmucl] Pushed new branch issue-240-clean-up-hashtable-for-sets-impl
by Raymond Toy (＠rtoy) 27 Aug '23

27 Aug '23

Raymond Toy pushed new branch issue-240-clean-up-hashtable-for-sets-impl at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-240-clean-up-hashta… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-240-add-hashtable-set-exclusive-or] Add comments and fix docstring.
by Raymond Toy (＠rtoy) 27 Aug '23

27 Aug '23

Raymond Toy pushed to branch issue-240-add-hashtable-set-exclusive-or at cmucl / cmucl Commits: 8074203f by Raymond Toy at 2023-08-26T20:42:51-07:00 Add comments and fix docstring. The docstring says set-exclusive-or produces elements appearing exactly once in list1 and list2. But that's not right. The result has elements appearing in either list1 or list2 but not both. Use the text from the CLHS as the docstring. Add some comments to the code. - - - - - 1 changed file: - src/code/list.lisp Changes: ===================================== src/code/list.lisp ===================================== @@ -906,7 +906,7 @@ (defun set-exclusive-or (list1 list2 &key key (test #'eql testp) (test-not nil notp)) - "Return new list of elements appearing exactly once in LIST1 and LIST2." + "Return new list of elements appearing exactly one of LIST1 and LIST2." (declare (inline member)) (let ((result nil) (key (when key (coerce key 'function))) @@ -914,6 +914,8 @@ (test-not (if test-not (coerce test-not 'function) #'eql))) (declare (type (or function null) key) (type function test test-not)) + ;; Find the elements in list1 that do not appear in list2 and add + ;; them to the result. (let ((hashtable (list-to-hashtable list2 key test test-not))) (cond (hashtable @@ -924,6 +926,8 @@ (dolist (elt list1) (unless (with-set-keys (member (apply-key key elt) list2)) (setq result (cons elt result))))))) + ;; Now find the elements in list2 that do not appear in list1 and + ;; them to the result. (let ((hashtable (list-to-hashtable list1 key test test-not))) (cond (hashtable View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/8074203fd56e40c38130f31… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/8074203fd56e40c38130f31… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-240-add-hashtable-set-exclusive-or] Fix another typo
by Raymond Toy (＠rtoy) 27 Aug '23

27 Aug '23

Raymond Toy pushed to branch issue-240-add-hashtable-set-exclusive-or at cmucl / cmucl Commits: 56ecb8cf by Raymond Toy at 2023-08-26T20:33:49-07:00 Fix another typo Malformed flet is fixed now. Test runs correctly. - - - - - 1 changed file: - tests/sets.lisp Changes: ===================================== tests/sets.lisp ===================================== @@ -283,20 +283,20 @@ (define-test set-exclusive-or.1 (:tag :issues) (flet - ((test min-length) - ;; From CLHS - (let ((lisp::*min-list-length-for-hashtable* min-length)) - (assert-equal '("b" "A" "b" "a") - (set-exclusive-or '(1 "a" "b") - '(1 "A" "b"))) - (assert-equal '("A" "a") - (set-exclusive-or '(1 "a" "b") - '(1 "A" "b") - :test #'equal)) - (assert-equal nil - (set-exclusive-or '(1 "a" "b") - '(1 "A" "b") - :test #'equalp)))) + ((test (min-length) + ;; From CLHS + (let ((lisp::*min-list-length-for-hashtable* min-length)) + (assert-equal '("b" "A" "b" "a") + (set-exclusive-or '(1 "a" "b") + '(1 "A" "b"))) + (assert-equal '("A" "a") + (set-exclusive-or '(1 "a" "b") + '(1 "A" "b") + :test #'equal)) + (assert-equal nil + (set-exclusive-or '(1 "a" "b") + '(1 "A" "b") + :test #'equalp))))) ;; Test the list impl by making the min length large. Then test ;; the hashtable impl with a very short min length (test 100) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/56ecb8cfbfd96a722cc710e… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/56ecb8cfbfd96a722cc710e… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-240-add-hashtable-set-exclusive-or] Clean up error in set-exclusive-or test
by Raymond Toy (＠rtoy) 26 Aug '23

26 Aug '23

Raymond Toy pushed to branch issue-240-add-hashtable-set-exclusive-or at cmucl / cmucl Commits: 6a53d42c by Raymond Toy at 2023-08-26T16:25:01-07:00 Clean up error in set-exclusive-or test Somehow the test set-exclusive-or.1 had incorporated lots of other tests inside it. Remove the random junk. - - - - - 1 changed file: - tests/sets.lisp Changes: ===================================== tests/sets.lisp ===================================== @@ -230,238 +230,6 @@ (test 1))) -(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))) - -(define-test set-exclusive-or.1 - (:tag :issues) - ;; From CLHS - (assert-equal '("b" "A" "b" "a") - (set-exclusive-or '(1 "a" "b") - '(1 "A" "b"))) - ;; Tests for sets - -(defpackage :sets-tests - (:use :cl :lisp-unit)) - -(in-package "SETS-TESTS") - -(define-test set-diff.hash-eql - (:tag :issues) - ;; For set-difference to use hashtables by making the threshold - ;; small. - (let ((lisp::*min-list-length-for-hashtable* 2)) - (assert-equal '(2 2 1) - (set-difference '(1 2 2 3) '(3 4))) - (assert-equal '(2 2 1) - (set-difference '(1 2 2 3) '(3 4 5 6 7 8))) - (assert-equal '(2 2 1) - (set-difference '(1 2 2 3) '(3 4) - :test #'eql)) - (assert-equal '(2 2 1) - (set-difference '(1 2 2 3) '(3 4 5 6 7 8) - :test #'eql)))) - -(define-test set-diff.hash-eq - (:tag :issues) - (let ((lisp::*min-list-length-for-hashtable* 2)) - (assert-equal '(b b a) - (set-difference '(a b b c) '(c d e) :test 'eq)) - (assert-equal '(b b a) - (set-difference '(a b b c) '(c d e f g h) :test 'eq)) - (assert-equal '(b b a) - (set-difference '(a b b c) '(c d e) :test #'eq)) - (assert-equal '(b b a) - (set-difference '(a b b c) '(c d e f g h) :test #'eq)))) - -(define-test set-diff.hash-equal - (:tag :issues) - (let ((lisp::*min-list-length-for-hashtable* 2)) - (assert-equal '("b" "b" "a") - (set-difference '("a" "b" "b" "c") - '("c" "d" "e") - :test 'equal)) - (assert-equal '("b" "b" "a") - (set-difference '("a" "b" "b" "c") - '("c" "d" "e" "f" "g" "h") - :test 'equal)) - (assert-equal '("b" "b" "a") - (set-difference '("a" "b" "b" "c") - '("c" "d" "e") - :test #'equal)) - (assert-equal '("b" "b" "a") - (set-difference '("a" "b" "b" "c") - '("c" "d" "e" "f" "g" "h") - :test #'equal)))) - -(define-test set-diff.hash-equalp - (:tag :issues) - (let ((lisp::*min-list-length-for-hashtable* 2)) - (assert-equal '("b" "b" "a") - (set-difference '("a" "b" "b" "c") - '("C" "d" "e") - :test 'equalp)) - (assert-equal '("b" "b" "a") - (set-difference '("a" "b" "b" "C") - '("c" "D" "e" "f" "g" "h") - :test 'equalp)) - (assert-equal '("b" "b" "a") - (set-difference '("a" "b" "b" "c") - '("C" "d" "e") - :test #'equalp)) - (assert-equal '("b" "b" "a") - (set-difference '("a" "b" "b" "C") - '("c" "D" "e" "f" "g" "h") - :test #'equalp)))) - -;; Simple test that we handle a key correctly -(define-test set-diff.hash-eql-with-key - (let ((lisp::*min-list-length-for-hashtable* 2)) - (assert-equal '((3 "b") (2 "b")) - (set-difference '((1 "a") (2 "b") (3 "b")) - '((1 "a") (4 "c") (5 "d")) - :key #'first)))) - -(define-test set-diff.test-and-test-not - (assert-error 'simple-error - (set-difference '(1 2) - '(3 4) - :test 'eql - :test-not 'eql))) - - - -(define-test union.hash-eql - (:tag :issues) - ;; For union to use hashtables by making the threshold - ;; small. - (let ((lisp::*min-list-length-for-hashtable* 2)) - (assert-equal '(2 2 1 3 4) - (union '(1 2 2 3) '(3 4))) - (assert-equal '(2 2 1 3 4 5 6 7 8) - (union '(1 2 2 3) '(3 4 5 6 7 8))) - (assert-equal '(2 2 1 3 4) - (union '(1 2 2 3) '(3 4) - :test #'eql)) - (assert-equal '(2 2 1 3 4 5 6 7 8) - (union '(1 2 2 3) '(3 4 5 6 7 8) - :test #'eql)))) - -(define-test union.hash-eq - (:tag :issues) - (let ((lisp::*min-list-length-for-hashtable* 2)) - (assert-equal '(b b a c d e) - (union '(a b b c) '(c d e) :test 'eq)) - (assert-equal '(b b a c d e f g h) - (union '(a b b c) '(c d e f g h) :test 'eq)) - (assert-equal '(b b a c d e) - (union '(a b b c) '(c d e) :test #'eq)) - (assert-equal '(b b a c d e f g h) - (union '(a b b c) '(c d e f g h) :test #'eq)))) - -(define-test union.hash-equal - (:tag :issues) - (let ((lisp::*min-list-length-for-hashtable* 2)) - (assert-equal '("b" "b" "a" "c" "d" "e") - (union '("a" "b" "b" "c") - '("c" "d" "e") - :test 'equal)) - (assert-equal '("b" "b" "a" "c" "d" "e" "f" "g" "h") - (union '("a" "b" "b" "c") - '("c" "d" "e" "f" "g" "h") - :test 'equal)) - (assert-equal '("b" "b" "a" "c" "d" "e") - (union '("a" "b" "b" "c") - '("c" "d" "e") - :test #'equal)) - (assert-equal '("b" "b" "a" "c" "d" "e" "f" "g" "h") - (union '("a" "b" "b" "c") - '("c" "d" "e" "f" "g" "h") - :test #'equal)))) - -(define-test union.hash-equalp - (:tag :issues) - (let ((lisp::*min-list-length-for-hashtable* 2)) - (assert-equal '("b" "b" "a" "C" "d" "e") - (union '("a" "b" "b" "c") - '("C" "d" "e") - :test 'equalp)) - (assert-equal '("b" "b" "a" "c" "D" "e" "f" "g" "h") - (union '("a" "b" "b" "C") - '("c" "D" "e" "f" "g" "h") - :test 'equalp)) - (assert-equal '("b" "b" "a" "C" "d" "e") - (union '("a" "b" "b" "c") - '("C" "d" "e") - :test #'equalp)) - (assert-equal '("b" "b" "a" "c" "D" "e" "f" "g" "h") - (union '("a" "b" "b" "C") - '("c" "D" "e" "f" "g" "h") - :test #'equalp)))) - -;; Simple test that we handle a key correctly -(define-test union.hash-eql-with-key - (let ((lisp::*min-list-length-for-hashtable* 2)) - (assert-equal '((3 "b") (2 "b") (1 "a") (4 "c") (5 "d")) - (union '((1 "a") (2 "b") (3 "b")) - '((1 "a") (4 "c") (5 "d")) - :key #'first)))) - -(define-test union.test-and-test-not - (assert-error 'simple-error - (union '(1 2) - '(3 4) - :test 'eql - :test-not 'eql))) - - (define-test subsetp.hash-eq (:tag :issues) (let ((lisp::*min-list-length-for-hashtable* 2)) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/6a53d42ce2f1a6a8ea3b871… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/6a53d42ce2f1a6a8ea3b871… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-240-add-hashtable-set-exclusive-or] Fix typo.
by Raymond Toy (＠rtoy) 26 Aug '23

26 Aug '23

Raymond Toy pushed to branch issue-240-add-hashtable-set-exclusive-or at cmucl / cmucl Commits: c8f2c87d by Raymond Toy at 2023-08-25T20:12:46-07:00 Fix typo. Somehow a stray "g" got added to steve-splice. Remove it. - - - - - 1 changed file: - src/code/list.lisp Changes: ===================================== src/code/list.lisp ===================================== @@ -842,7 +842,7 @@ ;;; to the cdr, and "conses" the 1st elt of source to destination. ;;; (defmacro steve-splice (source destination) - `(let ((temp ,source))g + `(let ((temp ,source)) (setf ,source (cdr ,source) (cdr temp) ,destination ,destination temp))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/c8f2c87db5e3ab95e5371e5… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/c8f2c87db5e3ab95e5371e5… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-255-add-sacla-tests] 2 commits: Only ignore build-* in the top-level dir
by Raymond Toy (＠rtoy) 25 Aug '23

25 Aug '23

Raymond Toy pushed to branch issue-255-add-sacla-tests at cmucl / cmucl Commits: 083a78da by Raymond Toy at 2023-08-25T15:14:06-07:00 Only ignore build-* in the top-level dir - - - - - f1ff2d63 by Raymond Toy at 2023-08-25T15:14:45-07:00 Add script to convert sacla test to lisp-unit test. - - - - - 2 changed files: - .gitignore - + sacla/build-sacla-tests.lisp Changes: ===================================== .gitignore ===================================== @@ -12,7 +12,7 @@ *.x86f *~ /test-tmp -build-* +/build-* darwin-8bit-[234] darwin-[234] linux-8bit-[234] ===================================== sacla/build-sacla-tests.lisp ===================================== @@ -0,0 +1,41 @@ +(defun get-sacla-test-files () + (let ((test-files + ;; We only want files named "must-*.lisp", using a cmucl + ;; pathname extension. + (directory "lisp/tests/must-*.lisp"))) + test-files)) + +(defun process-one-file (file) + (let* ((base-name (pathname-name file)) + (output-file (make-pathname :name (pathname-name file) + :type (pathname-type file))) + (test-base-name (symbolicate "SACLA-" (string-upcase base-name))) + (*print-case* :downcase)) + (with-open-file (output output-file + :direction :output + :if-exists :supersede) + (format *trace-output* "load-truename ~S~%" *load-truename*) + (format *trace-output* "Reading ~S~%" file) + (format *trace-output* "Writing ~S~%" output-file) + (format output "(in-package #:sacla-lisp-unit)~%") + (with-open-file (input file) + (loop for count from 1 + for sexp = (read input nil) + while sexp + do (progn + (write `(define-test ,(symbolicate test-base-name (format nil ".~d" count)) + (:tag ,(intern (string test-base-name) :keyword)) + (assert-true ,sexp)) + :stream output + :circle t + :level nil + :length nil) + (terpri output)))) + (terpri output)))) + +(defun create-lisp-unit-sacla-tests () + (let ((test-files (get-sacla-test-files))) + ;; For each test file, convert the file to a lisp-unit test file + ;; by wrapping each sexp in a define-test form. + (dolist (file test-files) + (process-one-file file)))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/4c44b23fcd11b67a25314b… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/4c44b23fcd11b67a25314b… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-255-add-sacla-tests] Remove these files that were accidentally checked in
by Raymond Toy (＠rtoy) 25 Aug '23

25 Aug '23

Raymond Toy pushed to branch issue-255-add-sacla-tests at cmucl / cmucl Commits: 4c44b23f by Raymond Toy at 2023-08-25T15:10:11-07:00 Remove these files that were accidentally checked in - - - - - 1 changed file: - − sacla/must-array.lisp The diff was not included because it is too large. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/4c44b23fcd11b67a25314b9… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/4c44b23fcd11b67a25314b9… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-255-add-sacla-tests
by Raymond Toy (＠rtoy) 25 Aug '23

25 Aug '23

Raymond Toy pushed new branch issue-255-add-sacla-tests at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-255-add-sacla-tests You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-240-add-hashtable-set-exclusive-or] 3 commits: Address #240: Use hashtable for nset-diff, nunion, nintersection
by Raymond Toy (＠rtoy) 25 Aug '23

25 Aug '23

Raymond Toy pushed to branch issue-240-add-hashtable-set-exclusive-or at cmucl / cmucl Commits: 87e54e03 by Raymond Toy at 2023-08-25T14:15:52+00:00 Address #240: Use hashtable for nset-diff, nunion, nintersection - - - - - 4542d55e by Raymond Toy at 2023-08-25T14:16:04+00:00 Merge branch 'issue-240-add-hashtable-for-destructive-set-ops' into 'master' Address #240: Use hashtable for nset-diff, nunion, nintersection See merge request cmucl/cmucl!167 - - - - - d1bf9185 by Raymond Toy at 2023-08-25T08:34:43-07:00 Merge branch 'master' into issue-240-add-hashtable-set-exclusive-or - - - - - 2 changed files: - src/code/list.lisp - tests/sets.lisp Changes: ===================================== src/code/list.lisp ===================================== @@ -749,7 +749,9 @@ (defparameter *min-list-length-for-hashtable* 15) -(declaim (start-block list-to-hashtable union intersection set-difference)) +(declaim (start-block list-to-hashtable + union intersection set-difference + nunion nintersection nset-difference)) ;; Main code to process a set function. INIT-RES initializes the ;; value of RES, which holds the result of the set function. @@ -836,8 +838,6 @@ (process-set nil t)) -(declaim (end-block)) - ;;; Destination and source are setf-able and many-evaluable. Sets the source ;;; to the cdr, and "conses" the 1st elt of source to destination. ;;; @@ -847,19 +847,42 @@ (cdr temp) ,destination ,destination temp))) +;;; Main body for destructive set operations. INIT-RES initializes +;;; the result list. INVERT-P is T if the result of the TEST-FORM +;;; should be inverted. TEST-FORM is the form used for determining +;;; how to update the result. +(defmacro nprocess-set-body (init-res invert-p test-form) + `(let ((res ,init-res) + (list1 list1)) + (do () + ((endp list1)) + (if ,(if invert-p + `(not ,test-form) + test-form) + (steve-splice list1 res) + (setq list1 (cdr list1)))) + res)) + +;; Implementation of the destructive set operations. INIT-RES +;; initializes the value of the result list. INVERT-P indicates +;; whether to invert the test-form used to determine how the result +;; should be updated. +(defmacro nprocess-set (init-res invert-p) + `(let ((hashtable (list-to-hashtable list2 key test test-not))) + (if hashtable + (nprocess-set-body ,init-res ,invert-p + (nth-value 1 (gethash (apply-key key (car list1)) hashtable))) + (nprocess-set-body ,init-res ,invert-p + (with-set-keys (member (apply-key key (car list1)) list2)))))) + + (defun nunion (list1 list2 &key key (test #'eql testp) (test-not nil notp)) "Destructively returns the union list1 and list2." (declare (inline member)) (if (and testp notp) (error "Test and test-not both supplied.")) - (let ((res list2) - (list1 list1)) - (do () - ((endp list1)) - (if (not (with-set-keys (member (apply-key key (car list1)) list2))) - (steve-splice list1 res) - (setf list1 (cdr list1)))) - res)) + + (nprocess-set list2 t)) (defun nintersection (list1 list2 &key key (test #'eql testp) (test-not nil notp)) @@ -867,13 +890,8 @@ (declare (inline member)) (if (and testp notp) (error "Test and test-not both supplied.")) - (let ((res nil) - (list1 list1)) - (do () ((endp list1)) - (if (with-set-keys (member (apply-key key (car list1)) list2)) - (steve-splice list1 res) - (setq list1 (Cdr list1)))) - res)) + + (nprocess-set nil nil)) (defun nset-difference (list1 list2 &key key (test #'eql testp) (test-not nil notp)) @@ -881,14 +899,10 @@ (declare (inline member)) (if (and testp notp) (error "Test and test-not both supplied.")) - (let ((res nil) - (list1 list1)) - (do () ((endp list1)) - (if (not (with-set-keys (member (apply-key key (car list1)) list2))) - (steve-splice list1 res) - (setq list1 (cdr list1)))) - res)) + (nprocess-set nil t)) + +(declaim (end-block)) (defun set-exclusive-or (list1 list2 &key key (test #'eql testp) (test-not nil notp)) ===================================== tests/sets.lisp ===================================== @@ -88,8 +88,37 @@ :test 'eql :test-not 'eql))) - +(define-test nset-diff.1 + (:tag :issues) + ;; From CLHS + (flet + ((test1 (min-length-limit) + (let ((lisp::*min-list-length-for-hashtable* min-length-limit) + (lst1 (list "A" "b" "C" "d")) + (lst2 (list "a" "B" "C" "d"))) + (assert-equal '("b" "A") + (nset-difference lst1 lst2 :test 'equal)) + ;; This isn't specified by the CLHS, but it is what we do. + (assert-equal '("A") lst1)))) + (test1 100) + (test1 1))) + +(define-test nset-diff.key + (:tag :issues) + (flet + ((test (min-length-limit) + ;; From CLHS + (let ((lisp::*min-list-length-for-hashtable* min-length-limit) + (lst1 (list '("a" . "b") '("c" . "d") '("e" . "f"))) + (lst2 (list '("c" . "a") '("e" . "b") '("d" . "a")))) + (assert-equal '(("e" . "f") ("c" . "d")) + (nset-difference lst1 lst2 :test 'equal :key #'cdr)) + ;; This isn't specified by the CLHS, but it is what we do. + (assert-equal '(("a" . "b") ("c" . "d")) lst1)))) + (test 100) + (test 1))) + (define-test union.hash-eql (:tag :issues) ;; For union to use hashtables by making the threshold @@ -173,6 +202,33 @@ :test 'eql :test-not 'eql))) +(define-test nunion.1 + (:tag :issues) + (flet + ((test (min-list-length) + (let ((lisp::*min-list-length-for-hashtable* min-list-length) + (lst1 (list 1 2 '(1 2) "a" "b")) + (lst2 (list 2 3 '(2 3) "B" "C"))) + (assert-equal '("b" "a" (1 2) 1 2 3 (2 3) "B" "C") + (nunion lst1 lst2)) + (assert-equal '(1 2 3 (2 3) "B" "C") + lst1)))) + (test 100) + (test 1))) + +(define-test nintersection.1 + (:tag :issues) + (flet + ((test (min-list-length) + (let ((lisp::*min-list-length-for-hashtable* min-list-length) + (lst1 (list 1 1 2 3 4 'a 'b 'c "A" "B" "C" "d")) + (lst2 (list 1 4 5 'b 'c 'd "a" "B" "c" "D"))) + (assert-equal '(c b 4 1 1) + (nintersection lst1 lst2)) + (assert-equal '(1) lst1)))) + (test 100) + (test 1))) + (define-test subsetp.hash-eq (:tag :issues) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/fc0d7a8d541e5ccd95a4cc… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/fc0d7a8d541e5ccd95a4cc… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-240-add-hashtable-set-exclusive-or
by Raymond Toy (＠rtoy) 25 Aug '23

25 Aug '23

Raymond Toy pushed new branch issue-240-add-hashtable-set-exclusive-or at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-240-add-hashtable-s… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0