From 205c7e1d9972645cdbdc2dcc85b0a235f337503e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Sun, 12 Nov 2023 00:52:18 +0000 Subject: [PATCH] WIP: optimize cl-nset-difference --- lisp/emacs-lisp/bytecomp.el | 2 +- lisp/emacs-lisp/cl-seq.el | 58 ++++++++++++++++++++++++++-- test/lisp/emacs-lisp/cl-lib-tests.el | 45 ++++++++++++++++++++- 3 files changed, 100 insertions(+), 5 deletions(-) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index cc68db73c9f..e1a11ff9ba3 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -3601,7 +3601,7 @@ byte-compile-form (cl-nsubst 3) (cl-nsubst-if 3) (cl-nsubst-if-not 3) (cl-nsubstitute 3) (cl-nsubstitute-if 3) (cl-nsubstitute-if-not 3) (cl-nsublis 2) - (cl-nunion 1 2) (cl-nintersection 1 2) (cl-nset-difference 1 2) + (cl-nunion 1 2) (cl-nintersection 1 2) (cl-nset-difference 1) (cl-nset-exclusive-or 1 2) (cl-nreconc 1) (cl-sort 1) (cl-stable-sort 1) (cl-merge 2 3) diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el index 74ca74db679..55c9926d916 100644 --- a/lisp/emacs-lisp/cl-seq.el +++ b/lisp/emacs-lisp/cl-seq.el @@ -961,16 +961,68 @@ cl-set-difference (pop cl-list1)) (nreverse cl-res))))) +(defmacro cl--list-member-with-keys (e l key test test-not) + "Checks if E is in L with standard CL KEY, TEST and TEST-NOT. +Anaphoric macro! requires cl-test, cl-test-not and cl-key to be bound" + `(let ((e ,e) (l ,l) (key ,key) (test ,test) (test-not ,test-not)) + (cond (test-not + (cond (key + (setq e (funcall key e)) + (catch 'done + (while l + (unless (funcall test-not e (funcall key (car l))) + (throw 'done t)) + (setq l (cdr l))))) + (t + (catch 'done + (while l + (unless (funcall test-not e (car l)) + (throw 'done t)) + (setq l (cdr l))))))) + (test + (cond (key + (setq e (funcall key e)) + (catch 'done + (while l + (when (funcall test e (funcall key (car l))) + (throw 'done t)) + (setq l (cdr l))))) + (t + (catch 'done + (while l + (when (funcall test e (car l)) + (throw 'done t)) + (setq l (cdr l))))))) + (key + (setq e (funcall key e)) + (catch 'done + (while l + (when (eq e (funcall key (car l))) + (throw 'done t)) + (setq l (cdr l))))) + (t (memql e l))))) + ;;;###autoload -(defun cl-nset-difference (cl-list1 cl-list2 &rest cl-keys) +(defun cl-nset-difference (list1 list2 &rest cl-keys) "Combine LIST1 and LIST2 using a set-difference operation. The resulting list contains all items that appear in LIST1 but not LIST2. This is a destructive function; it reuses the storage of LIST1 and LIST2 whenever possible. \nKeywords supported: :test :test-not :key \n(fn LIST1 LIST2 [KEYWORD VALUE]...)" - (if (or (null cl-list1) (null cl-list2)) cl-list1 - (apply 'cl-set-difference cl-list1 cl-list2 cl-keys))) + (if (or (null list1) (null list2)) list1 + (cl--parsing-keywords (:key :test :test-not) () + (let ((res nil)) + (while (consp list1) + (if ;; (if (or cl-keys (numberp (car list1))) + ;; (apply 'cl-member (cl--check-key (car list1)) + ;; list2 cl-keys) + ;; (memq (car list1) list2)) + (cl--list-member-with-keys (car list1) + list2 cl-key cl-test cl-test-not) + (setf list1 (cdr list1)) + (cl-shiftf list1 (cdr list1) res list1))) + res)))) ;;;###autoload (defun cl-set-exclusive-or (cl-list1 cl-list2 &rest cl-keys) diff --git a/test/lisp/emacs-lisp/cl-lib-tests.el b/test/lisp/emacs-lisp/cl-lib-tests.el index 0995e71db4e..2a55d982c42 100644 --- a/test/lisp/emacs-lisp/cl-lib-tests.el +++ b/test/lisp/emacs-lisp/cl-lib-tests.el @@ -558,5 +558,48 @@ cl-constantly (should (equal (mapcar (cl-constantly 3) '(a b c d)) '(3 3 3 3)))) - +(ert-deftest cl-set-difference () + ;; our set-difference preserves order, though it is not required to + ;; by cl standards, better keep that invariant + (should (equal (cl-set-difference '(1 2 3 4) '(3 4 5 6)) + '(1 2)))) + +(ert-deftest cl-nset-difference () + ;; our nset-difference doesn't + (let* ((l1 (list 1 2 3 4)) (l2 '(3 4 5 6)) + (diff (cl-nset-difference l1 l2))) + (should (memq 1 diff)) + (should (memq 2 diff)) + (should (= (length diff) 2)) + (should (equal l2 '(3 4 5 6)))) + (let* ((l1 (list '(a . 1) '(b . 2) '(c . 3) '(d . 4))) + (l2 (list '(c . 3) '(d . 4) '(e . 5) '(f . 6))) + (diff (cl-nset-difference l1 l2 :key #'car))) + (should (member '(a . 1) diff)) + (should (member '(b . 2) diff)) + (should (= (length diff) 2))) + (let* ((l1 (list '("a" . 1) '("b" . 2) '("c" . 3) '("d" . 4))) + (l2 (list '("c" . 3) '("d" . 4) '("e" . 5) '("f" . 6))) + (diff (cl-nset-difference l1 l2 :key #'car :test #'string=))) + (should (member '("a" . 1) diff)) + (should (member '("b" . 2) diff)) + (should (= (length diff) 2)))) + + +(when nil + (let ((l2 '(4 5 6 7))) + (benchmark-run 100000 + (let ((l (list 1 2 3 4 8 9 10 11 12 13 14))) + (cl-set-difference l l2))));; (0.480944603 8 0.3380962310000015) + + (let ((l2 '(4 5 6 7))) + (benchmark-run 100000 + (let ((l (list 1 2 3 4 8 9 10 11 12 13 14))) + (cl-nset-difference l l2))));; (0.31953939800000003 5 0.21426147399999707) + + (let ((l2 '(4 5 6 7))) + (benchmark-run 100000 + (let ((l (list 1 2 3 4 8 9 10 11 12 13 14))) + (seq-difference l l2)))) ;; (2.3330953689999996 41 1.8175730390000027) + ) ;;; cl-lib-tests.el ends here -- 2.39.2