[PATCH] assq-delete-all, rassq-delete-all: Avoid duplication of code

[PATCH] assq-delete-all, rassq-delete-all: Avoid duplication of code

[Tino Calancha]

Hello,

how about following patch?
It prevent some duplication of code in subr.el, and it adds
a new test.

Regards,
Tino

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
From 3597746c9c5ebcc7d7252fb9051475d52936ee20 Mon Sep 17 00:00:00 2001
From: Tino Calancha <tino.calancha@gmail.com>
Date: Mon, 28 Nov 2016 18:41:40 +0900
Subject: [PATCH] assq-delete-all, rassq-delete-all: Avoid duplication of code

* lisp/subr.el (assq-delete-all-1): New defun.
(assq-delete-all, rassq-delete-all): Use it.
* test/lisp/subr-tests.el (subr-test-assq-delete-all): New test.
---
 lisp/subr.el            | 35 +++++++++++++++--------------------
 test/lisp/subr-tests.el | 12 ++++++++++++
 2 files changed, 27 insertions(+), 20 deletions(-)

diff --git a/lisp/subr.el b/lisp/subr.el
index 5da5bf8..28f6f74 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -570,35 +570,30 @@ member-ignore-case
     (setq list (cdr list)))
   list)
 
+(defun assq-delete-all-1 (elt alist key)
+  (let ((op (if key #'car #'cdr)))
+    (while (and (consp (car alist))
+                (eq (funcall op (car alist)) elt))
+      (setq alist (cdr alist)))
+    (let ((tail alist))
+      (while (cdr tail)
+        (if (and (consp (cadr tail))
+                 (eq (funcall op (cadr tail)) elt))
+            (setcdr tail (cddr tail))
+          (setq tail (cdr tail)))))
+    alist))
+
 (defun assq-delete-all (key alist)
   "Delete from ALIST all elements whose car is `eq' to KEY.
 Return the modified alist.
 Elements of ALIST that are not conses are ignored."
-  (while (and (consp (car alist))
-	      (eq (car (car alist)) key))
-    (setq alist (cdr alist)))
-  (let ((tail alist) tail-cdr)
-    (while (setq tail-cdr (cdr tail))
-      (if (and (consp (car tail-cdr))
-	       (eq (car (car tail-cdr)) key))
-	  (setcdr tail (cdr tail-cdr))
-	(setq tail tail-cdr))))
-  alist)
+  (assq-delete-all-1 key alist 'key))
 
 (defun rassq-delete-all (value alist)
   "Delete from ALIST all elements whose cdr is `eq' to VALUE.
 Return the modified alist.
 Elements of ALIST that are not conses are ignored."
-  (while (and (consp (car alist))
-	      (eq (cdr (car alist)) value))
-    (setq alist (cdr alist)))
-  (let ((tail alist) tail-cdr)
-    (while (setq tail-cdr (cdr tail))
-      (if (and (consp (car tail-cdr))
-	       (eq (cdr (car tail-cdr)) value))
-	  (setcdr tail (cdr tail-cdr))
-	(setq tail tail-cdr))))
-  alist)
+  (assq-delete-all-1 value alist nil))
 
 (defun alist-get (key alist &optional default remove)
   "Return the value associated with KEY in ALIST, using `assq'.
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index ce21290..018c13b 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -224,5 +224,17 @@
               (error-message-string (should-error (version-to-list "beta22_8alpha3")))
               "Invalid version syntax: `beta22_8alpha3' (must start with a number)"))))
 
+(ert-deftest subr-test-assq-delete-all ()
+  "Tests for `assq-delete-all' and `rassq-delete-all'."
+  (let ((alist '((foo . 1) (bar . 1) (baz . 1) (foo . 2))))
+    (should (equal '((bar . 1) (baz . 1))
+                   (assq-delete-all 'foo (copy-tree alist))))
+    (should (equal '((foo . 2)) (rassq-delete-all 1 (copy-tree alist))))
+    (should (equal alist (assq-delete-all 'qux (copy-tree alist))))
+    (should (equal alist (rassq-delete-all 9 (copy-tree alist))))
+    (should (equal alist
+                   (assq-delete-all (make-symbol "foo") (copy-tree alist))))
+    (should (equal alist (rassq-delete-all 1.0 (copy-tree alist))))))
+
 (provide 'subr-tests)
 ;;; subr-tests.el ends here
-- 
2.10.2

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
In GNU Emacs 26.0.50.1 (x86_64-pc-linux-gnu, GTK+ Version 3.22.3)
 of 2016-11-28
Repository revision: d020ff3eab01f9683485b35c0fc8b17708e9a6d1

RE: [PATCH] assq-delete-all, rassq-delete-all: Avoid duplication of code

[Herring, Davis]

> +(defun assq-delete-all-1 (elt alist key)
> +  (let ((op (if key #'car #'cdr)))

I would just pass `op' instead.  It makes the callers clearer, and also avoids the confusion of "use the key, not the value?" vs. "this is the key" for the variable `key'.

Davis

Re: [PATCH] assq-delete-all, rassq-delete-all: Avoid duplication of code

[Tino Calancha]

"Herring, Davis" <herring@lanl.gov> writes:

>> +(defun assq-delete-all-1 (elt alist key)
>> +  (let ((op (if key #'car #'cdr)))
>
> I would just pass `op' instead.  It makes the callers clearer, and
> also avoids the confusion of "use the key, not the value?" vs. "this
> is the key" for the variable `key'.

Thank you Davis, that's a good point!
I have updated the patch with your suggestion:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
From f797643263c9d429a08b0e97b8149644c3f5907b Mon Sep 17 00:00:00 2001
From: Tino Calancha <tino.calancha@gmail.com>
Date: Mon, 28 Nov 2016 23:28:22 +0900
Subject: [PATCH] assq-delete-all, rassq-delete-all: Avoid duplication of code

See discussion in:
https://lists.gnu.org/archive/html/emacs-devel/2016-11/msg00592.html
* lisp/subr.el (assq-delete-all-1): New defun.
(assq-delete-all, rassq-delete-all): Use it.
* test/lisp/subr-tests.el (subr-test-assq-delete-all): New test.
---
 lisp/subr.el            | 34 ++++++++++++++--------------------
 test/lisp/subr-tests.el | 12 ++++++++++++
 2 files changed, 26 insertions(+), 20 deletions(-)

diff --git a/lisp/subr.el b/lisp/subr.el
index 5da5bf8..8a72853 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -570,35 +570,29 @@ member-ignore-case
     (setq list (cdr list)))
   list)
 
+(defun assq-delete-all-1 (elt alist op)
+  (while (and (consp (car alist))
+              (eq (funcall op (car alist)) elt))
+    (setq alist (cdr alist)))
+  (let ((tail alist))
+    (while (cdr tail)
+      (if (and (consp (cadr tail))
+               (eq (funcall op (cadr tail)) elt))
+          (setcdr tail (cddr tail))
+        (setq tail (cdr tail))))
+    alist))
+
 (defun assq-delete-all (key alist)
   "Delete from ALIST all elements whose car is `eq' to KEY.
 Return the modified alist.
 Elements of ALIST that are not conses are ignored."
-  (while (and (consp (car alist))
-	      (eq (car (car alist)) key))
-    (setq alist (cdr alist)))
-  (let ((tail alist) tail-cdr)
-    (while (setq tail-cdr (cdr tail))
-      (if (and (consp (car tail-cdr))
-	       (eq (car (car tail-cdr)) key))
-	  (setcdr tail (cdr tail-cdr))
-	(setq tail tail-cdr))))
-  alist)
+  (assq-delete-all-1 key alist #'car))
 
 (defun rassq-delete-all (value alist)
   "Delete from ALIST all elements whose cdr is `eq' to VALUE.
 Return the modified alist.
 Elements of ALIST that are not conses are ignored."
-  (while (and (consp (car alist))
-	      (eq (cdr (car alist)) value))
-    (setq alist (cdr alist)))
-  (let ((tail alist) tail-cdr)
-    (while (setq tail-cdr (cdr tail))
-      (if (and (consp (car tail-cdr))
-	       (eq (cdr (car tail-cdr)) value))
-	  (setcdr tail (cdr tail-cdr))
-	(setq tail tail-cdr))))
-  alist)
+  (assq-delete-all-1 value alist #'cdr))
 
 (defun alist-get (key alist &optional default remove)
   "Return the value associated with KEY in ALIST, using `assq'.
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index ce21290..018c13b 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -224,5 +224,17 @@
               (error-message-string (should-error (version-to-list "beta22_8alpha3")))
               "Invalid version syntax: `beta22_8alpha3' (must start with a number)"))))
 
+(ert-deftest subr-test-assq-delete-all ()
+  "Tests for `assq-delete-all' and `rassq-delete-all'."
+  (let ((alist '((foo . 1) (bar . 1) (baz . 1) (foo . 2))))
+    (should (equal '((bar . 1) (baz . 1))
+                   (assq-delete-all 'foo (copy-tree alist))))
+    (should (equal '((foo . 2)) (rassq-delete-all 1 (copy-tree alist))))
+    (should (equal alist (assq-delete-all 'qux (copy-tree alist))))
+    (should (equal alist (rassq-delete-all 9 (copy-tree alist))))
+    (should (equal alist
+                   (assq-delete-all (make-symbol "foo") (copy-tree alist))))
+    (should (equal alist (rassq-delete-all 1.0 (copy-tree alist))))))
+
 (provide 'subr-tests)
 ;;; subr-tests.el ends here
-- 
2.10.2

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
In GNU Emacs 26.0.50.1 (x86_64-pc-linux-gnu, GTK+ Version 3.22.4)
 of 2016-11-28
Repository revision: d020ff3eab01f9683485b35c0fc8b17708e9a6d1

Re: [PATCH] assq-delete-all, rassq-delete-all: Avoid duplication of code

[Eli Zaretskii]

> From: Tino Calancha <tino.calancha@gmail.com>
> Date: Mon, 28 Nov 2016 18:52:36 +0900
> Cc: tino.calancha@gmail.com
> 
> how about following patch?
> It prevent some duplication of code in subr.el, and it adds
> a new test.

What about the overhead of a function call?  These functions are
likely to be invoked in loops.

Should we make the common part a defsubst?

Re: [PATCH] assq-delete-all, rassq-delete-all: Avoid duplication of code

[Clément Pit--Claudel]

[-- Attachment #1.1: Type: text/plain, Size: 581 bytes --]

On 2016-11-28 12:24, Eli Zaretskii wrote:
>> From: Tino Calancha <tino.calancha@gmail.com>
>> Date: Mon, 28 Nov 2016 18:52:36 +0900
>> Cc: tino.calancha@gmail.com
>>
>> how about following patch?
>> It prevent some duplication of code in subr.el, and it adds
>> a new test.
> 
> What about the overhead of a function call?  These functions are
> likely to be invoked in loops.
> 
> Should we make the common part a defsubst?

Would defsubst be enough? I think you'd want a defmacro.  Otherwise, you'll still pay for all the funcalls to #'car and #'cdr, won't you?


[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 819 bytes --]

Re: [PATCH] assq-delete-all, rassq-delete-all: Avoid duplication of code

[Tino Calancha]

Clément Pit--Claudel <clement.pit@gmail.com> writes:

> On 2016-11-28 12:24, Eli Zaretskii wrote:
>>> From: Tino Calancha <tino.calancha@gmail.com>
>>> Date: Mon, 28 Nov 2016 18:52:36 +0900
>>> Cc: tino.calancha@gmail.com
>>>
>>> how about following patch?
>>> It prevent some duplication of code in subr.el, and it adds
>>> a new test.
>> 
>> What about the overhead of a function call?  These functions are
>> likely to be invoked in loops.
>> 
>> Should we make the common part a defsubst?
>
> Would defsubst be enough? I think you'd want a defmacro.  Otherwise,
> you'll still pay for all the funcalls to #'car and #'cdr, won't you?

Following patch makes `assq-delete-all-1' a macro:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
From 310fc091f1adbf7781e7069b313c03bb31e735a8 Mon Sep 17 00:00:00 2001
From: Tino Calancha <tino.calancha@gmail.com>
Date: Tue, 29 Nov 2016 17:15:30 +0900
Subject: [PATCH] assq-delete-all, rassq-delete-all: Avoid duplication of code

See discussion in:
https://lists.gnu.org/archive/html/emacs-devel/2016-11/msg00592.html
* lisp/subr.el (assq-delete-all-1): New macro.
(assq-delete-all, rassq-delete-all): Use it.
* test/lisp/subr-tests.el (subr-test-assq-delete-all): New test.
---
 lisp/subr.el            | 39 +++++++++++++++++++--------------------
 test/lisp/subr-tests.el | 12 ++++++++++++
 2 files changed, 31 insertions(+), 20 deletions(-)

diff --git a/lisp/subr.el b/lisp/subr.el
index 5da5bf8..69827be 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -570,35 +570,34 @@ member-ignore-case
     (setq list (cdr list)))
   list)
 
+(defmacro assq-delete-all-1 (elt alist rassq)
+  (let ((lst (make-symbol "alist"))
+        (tail (make-symbol "tail"))
+        (entry (make-symbol "entry")))
+    `(let ((,lst ,alist)
+           (,tail ,alist))
+       (while (and (consp (car ,lst))
+                   (eq ,(if rassq `(cdar ,lst) `(caar ,lst)) ,elt))
+         (setq ,lst (cdr ,lst)))
+       (while (cdr ,tail)
+         (let ((,entry (cdr ,tail)))
+           (if (and (consp (car ,entry))
+                    (eq ,(if rassq `(cdar ,entry) `(caar ,entry)) ,elt))
+               (setcdr ,tail (cdr ,entry))
+             (setq ,tail ,entry))))
+       ,lst)))
+
 (defun assq-delete-all (key alist)
   "Delete from ALIST all elements whose car is `eq' to KEY.
 Return the modified alist.
 Elements of ALIST that are not conses are ignored."
-  (while (and (consp (car alist))
-	      (eq (car (car alist)) key))
-    (setq alist (cdr alist)))
-  (let ((tail alist) tail-cdr)
-    (while (setq tail-cdr (cdr tail))
-      (if (and (consp (car tail-cdr))
-	       (eq (car (car tail-cdr)) key))
-	  (setcdr tail (cdr tail-cdr))
-	(setq tail tail-cdr))))
-  alist)
+  (assq-delete-all-1 key alist nil))
 
 (defun rassq-delete-all (value alist)
   "Delete from ALIST all elements whose cdr is `eq' to VALUE.
 Return the modified alist.
 Elements of ALIST that are not conses are ignored."
-  (while (and (consp (car alist))
-	      (eq (cdr (car alist)) value))
-    (setq alist (cdr alist)))
-  (let ((tail alist) tail-cdr)
-    (while (setq tail-cdr (cdr tail))
-      (if (and (consp (car tail-cdr))
-	       (eq (cdr (car tail-cdr)) value))
-	  (setcdr tail (cdr tail-cdr))
-	(setq tail tail-cdr))))
-  alist)
+  (assq-delete-all-1 value alist 'rassq))
 
 (defun alist-get (key alist &optional default remove)
   "Return the value associated with KEY in ALIST, using `assq'.
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index ce21290..018c13b 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -224,5 +224,17 @@
               (error-message-string (should-error (version-to-list "beta22_8alpha3")))
               "Invalid version syntax: `beta22_8alpha3' (must start with a number)"))))
 
+(ert-deftest subr-test-assq-delete-all ()
+  "Tests for `assq-delete-all' and `rassq-delete-all'."
+  (let ((alist '((foo . 1) (bar . 1) (baz . 1) (foo . 2))))
+    (should (equal '((bar . 1) (baz . 1))
+                   (assq-delete-all 'foo (copy-tree alist))))
+    (should (equal '((foo . 2)) (rassq-delete-all 1 (copy-tree alist))))
+    (should (equal alist (assq-delete-all 'qux (copy-tree alist))))
+    (should (equal alist (rassq-delete-all 9 (copy-tree alist))))
+    (should (equal alist
+                   (assq-delete-all (make-symbol "foo") (copy-tree alist))))
+    (should (equal alist (rassq-delete-all 1.0 (copy-tree alist))))))
+
 (provide 'subr-tests)
 ;;; subr-tests.el ends here
-- 
2.10.2

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
In GNU Emacs 26.0.50.1 (x86_64-pc-linux-gnu, GTK+ Version 3.22.4)
 of 2016-11-28
Repository revision: 2c8a7e50d24daf19ea7d86f1cfeaa98a41c56085