bug#30202: 27.0.50; Code refactoring on assq-delete-all assoc-delete-all

bug#30202: 27.0.50; Code refactoring on assq-delete-all assoc-delete-all

[Tino Calancha]

X-Debbugs-CC: monnier@iro.umontreal.ca
Severity: wishlist

Hi Stefan,

yesterday was added (how about to announce it in NEWS file?)
the new function `assoc-delete-all', which is pretty much
the same as `assq-delete-all' with `equal' instead of `eq'.

How do you think below patch?
IIUC, the byte compiler will carry the substitution
(funcall function foo bar)
into
(function foo bar)

so that compile code won't suffer the funcall overhead, right?

* `rassq-delete-all' is also very similar, maybe it could also join the
refactoring.

--8<-----------------------------cut here---------------start------------->8---
commit 11e4408e9f35d4da1cf07effda63354dde44d9a6
Author: tino calancha <tino.calancha@gmail.com>
Date:   Mon Jan 22 13:57:37 2018 +0900

    Code refactoring
    
    * lisp/subr.el (alist-delete-all): New defun extracted from
    assq-delete-all.
    (assoc-delete-all, assq-delete-all): Use it.

diff --git a/lisp/subr.el b/lisp/subr.el
index 092850a44d..d8286c0937 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -705,35 +705,33 @@ member-ignore-case
     (setq list (cdr list)))
   list)
 
-(defun assoc-delete-all (key alist)
-  "Delete from ALIST all elements whose car is `equal' to KEY.
+(defun alist-delete-all (key alist function)
+  "Delete from ALIST all elements whose car is KEY.
+Keys are compared with FUNCTION.
 Return the modified alist.
 Elements of ALIST that are not conses are ignored."
   (while (and (consp (car alist))
-	      (equal (car (car alist)) key))
+	      (funcall function (caar alist) key))
     (setq alist (cdr alist)))
   (let ((tail alist) tail-cdr)
     (while (setq tail-cdr (cdr tail))
       (if (and (consp (car tail-cdr))
-	       (equal (car (car tail-cdr)) key))
+	       (funcall function (caar tail-cdr) key))
 	  (setcdr tail (cdr tail-cdr))
 	(setq tail tail-cdr))))
   alist)
 
+(defun assoc-delete-all (key alist)
+  "Delete from ALIST all elements whose car is `equal' to KEY.
+Return the modified alist.
+Elements of ALIST that are not conses are ignored."
+  (alist-delete-all key alist #'equal))
+
 (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)
+  (alist-delete-all key alist #'eq))
 
 (defun rassq-delete-all (value alist)
   "Delete from ALIST all elements whose cdr is `eq' to VALUE.

--8<-----------------------------cut here---------------end--------------->8---


In GNU Emacs 27.0.50 (build 13, x86_64-pc-linux-gnu, GTK+ Version 3.22.11)
 of 2018-01-22 built on calancha-pc
Repository revision: 9fd9d4cf63d96ba9748b9e89137575e386191c82

bug#30202: 27.0.50; Code refactoring on assq-delete-all assoc-delete-all

[Stefan Monnier]

> yesterday was added (how about to announce it in NEWS file?)
> the new function `assoc-delete-all', which is pretty much
> the same as `assq-delete-all' with `equal' instead of `eq'.
> How do you think below patch?

How 'bout defining

(defun assoc-delete-all (key alist &optional test)
  (unless test (setq test #'equal))
  ...)


> IIUC, the byte compiler will carry the substitution
> (funcall function foo bar)
> into
> (function foo bar)
> so that compile code won't suffer the funcall overhead, right?

IIRC both forms result in the same bytecode except that the longer form
will not benefit from inlining and/or the use of specialized bytecodes
(e.g. when `foo` is `equal`).


        Stefan

bug#30202: 27.0.50; Code refactoring on assq-delete-all assoc-delete-all

[Tino Calancha]

On Mon, 22 Jan 2018, Stefan Monnier wrote:

>> yesterday was added (how about to announce it in NEWS file?)
>> the new function `assoc-delete-all', which is pretty much
>> the same as `assq-delete-all' with `equal' instead of `eq'.
>> How do you think below patch?
>
> How 'bout defining
>
> (defun assoc-delete-all (key alist &optional test)
>  (unless test (setq test #'equal))
>  ...)
Yes, I prefer this way.  Thank you.
Updated patch below.

>> IIUC, the byte compiler will carry the substitution
>> (funcall function foo bar)
>> into
>> (function foo bar)
>> so that compile code won't suffer the funcall overhead, right?
>
> IIRC both forms result in the same bytecode except that the longer form
> will not benefit from inlining and/or the use of specialized bytecodes
> (e.g. when `foo` is `equal`).
Here I tend to prefer to avoid the duplication of the similar code; in
case that the gain of performance result critical, and considering
that the functions are very short, then it might be OK repeat ourselves.

--8<-----------------------------cut here---------------start------------->8---
commit 9ecce395b1f2def081187d3e430d0cb82af8ba01
Author: tino calancha <tino.calancha@gmail.com>
Date:   Mon Jan 22 23:53:27 2018 +0900

     Code refactoring

     * lisp/subr.el (assoc-delete-all): Add optional arg TEST.
     (assq-delete-all): Use assoc-delete-all.

diff --git a/lisp/subr.el b/lisp/subr.el
index 092850a44d..e7a0ffc5be 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -705,17 +705,19 @@ member-ignore-case
      (setq list (cdr list)))
    list)

-(defun assoc-delete-all (key alist)
-  "Delete from ALIST all elements whose car is `equal' to KEY.
+(defun assoc-delete-all (key alist &optional test)
+  "Delete from ALIST all elements whose car is KEY.
+Compare keys with TEST.  Defaults to `equal'.
  Return the modified alist.
  Elements of ALIST that are not conses are ignored."
+  (unless test (setq test #'equal))
    (while (and (consp (car alist))
-	      (equal (car (car alist)) key))
+	      (funcall test (caar alist) key))
      (setq alist (cdr alist)))
    (let ((tail alist) tail-cdr)
      (while (setq tail-cdr (cdr tail))
        (if (and (consp (car tail-cdr))
-	       (equal (car (car tail-cdr)) key))
+	       (funcall test (caar tail-cdr) key))
  	  (setcdr tail (cdr tail-cdr))
  	(setq tail tail-cdr))))
    alist)
@@ -724,16 +726,7 @@ assq-delete-all
    "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)
+  (assoc-delete-all key alist #'eq))

  (defun rassq-delete-all (value alist)
    "Delete from ALIST all elements whose cdr is `eq' to VALUE.
--8<-----------------------------cut here---------------end--------------->8---

bug#30202: 27.0.50; Code refactoring on assq-delete-all assoc-delete-all

[Eli Zaretskii]

> From: Tino Calancha <tino.calancha@gmail.com>
> Date: Mon, 22 Jan 2018 14:24:38 +0900
> Cc: monnier@iro.umontreal.ca
> 
> yesterday was added (how about to announce it in NEWS file?)

Please just add a NEWS entry if you find a missing one.  Bonus points
for documenting new functions in the respective manual(s).

Thanks.

bug#30202: 27.0.50; Code refactoring on assq-delete-all assoc-delete-all

[Tino Calancha]

On Mon, 22 Jan 2018, Eli Zaretskii wrote:

>> From: Tino Calancha <tino.calancha@gmail.com>
>> Date: Mon, 22 Jan 2018 14:24:38 +0900
>> Cc: monnier@iro.umontreal.ca
>>
>> yesterday was added (how about to announce it in NEWS file?)
>
> Please just add a NEWS entry if you find a missing one.  Bonus points
> for documenting new functions in the respective manual(s).
Thanks for the suggestion.
Updated the patch with the NEWS entry and manual doc.

--8<-----------------------------cut here---------------start------------->8---
commit a80eda38ac4abefbbfd05719cb8ecd4ad9a85d68
Author: tino calancha <tino.calancha@gmail.com>
Date:   Tue Jan 23 08:52:48 2018 +0900

     Code refactoring

     * lisp/subr.el (assoc-delete-all): Add optional arg TEST.
     (assq-delete-all): Use assoc-delete-all.
     * doc/lispref/lists.texi (Association Lists): Document
     assoc-delete-all in the manual.
     ; * etc/NEWS: Add entry for assoc-delete-all

diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi
index 3e2dd13c70..37b8172502 100644
--- a/doc/lispref/lists.texi
+++ b/doc/lispref/lists.texi
@@ -1733,6 +1733,13 @@ Association Lists
  @end example
  @end defun

+@defun assoc-delete-all key alist &optional test
+This function is like @code{assq-delete-all} except that accepts
+an optional argument @var{test} to compare the keys in @var{alist}.
+@var{test} defaults to @code{equal}.  As @code{assq-delete-all},
+this function often modifies the original list structure of @var{alist}.
+@end defun
+
  @defun rassq-delete-all value alist
  This function deletes from @var{alist} all the elements whose @sc{cdr}
  is @code{eq} to @var{value}.  It returns the shortened alist, and
diff --git a/etc/NEWS b/etc/NEWS
index d30f0b087c..c491777781 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -204,6 +204,9 @@ as new-style, bind the new variable 'force-new-style-backquotes' to t.

  * Lisp Changes in Emacs 27.1

++++
+** New function assoc-delete-all.
+
  ** 'print-quoted' now defaults to t, so if you want to see
  (quote x) instead of 'x you will have to bind it to nil where applicable.

diff --git a/lisp/subr.el b/lisp/subr.el
index 092850a44d..e7a0ffc5be 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -705,17 +705,19 @@ member-ignore-case
      (setq list (cdr list)))
    list)

-(defun assoc-delete-all (key alist)
-  "Delete from ALIST all elements whose car is `equal' to KEY.
+(defun assoc-delete-all (key alist &optional test)
+  "Delete from ALIST all elements whose car is KEY.
+Compare keys with TEST.  Defaults to `equal'.
  Return the modified alist.
  Elements of ALIST that are not conses are ignored."
+  (unless test (setq test #'equal))
    (while (and (consp (car alist))
-	      (equal (car (car alist)) key))
+	      (funcall test (caar alist) key))
      (setq alist (cdr alist)))
    (let ((tail alist) tail-cdr)
      (while (setq tail-cdr (cdr tail))
        (if (and (consp (car tail-cdr))
-	       (equal (car (car tail-cdr)) key))
+	       (funcall test (caar tail-cdr) key))
  	  (setcdr tail (cdr tail-cdr))
  	(setq tail tail-cdr))))
    alist)
@@ -724,16 +726,7 @@ assq-delete-all
    "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)
+  (assoc-delete-all key alist #'eq))

  (defun rassq-delete-all (value alist)
    "Delete from ALIST all elements whose cdr is `eq' to VALUE.
--8<-----------------------------cut here---------------end--------------->8---

bug#30202: 27.0.50; Code refactoring on assq-delete-all assoc-delete-all

[Eli Zaretskii]

> From: Tino Calancha <tino.calancha@gmail.com>
> Date: Tue, 23 Jan 2018 09:02:12 +0900 (JST)
> cc: Tino Calancha <tino.calancha@gmail.com>, 30202@debbugs.gnu.org, 
>     monnier@iro.umontreal.ca
> 
> Updated the patch with the NEWS entry and manual doc.

Thanks, a few nits below.

> +@defun assoc-delete-all key alist &optional test
> +This function is like @code{assq-delete-all} except that accepts
                                                ^^^^^^^^^^^^^^^^^^^
"... except that it accepts"

> +an optional argument @var{test} to compare the keys in @var{alist}.

To make it even more clear, I would say

  except that it accepts an optional argument @var{test}, a predicate
  function to compare the keys in @var{alist}.

> +@var{test} defaults to @code{equal}.

An even more minor nit: try to avoid starting a sentence with @var.
In an Info manual, @var produces UPPER CASE, which looks OK at the
beginning of a sentence; but in the printed manual, @var produces a
lower-case word in slant typeface, which makes the sentence begin with
a lower-case letter.  So it is better to either say

  If omitted or @code{nil}, @var{test} defaults to ...

or even make it part of the previous sentence:

  ... a predicate function to compare the keys in @var{alist};
  @var{test} defaults to @code{equal}.

Or maybe even toss the reference to TEST:

  ... a predicate function to compare the keys in @var{alist}; if
  omitted, it defaults to @code{equal}.

(And yes, I know that our manuals are full of sentences starting with
@var; something to improve on, I guess.)

Thanks!

bug#30202: 27.0.50; Code refactoring on assq-delete-all assoc-delete-all

[Tino Calancha]

On Tue, 23 Jan 2018, Eli Zaretskii wrote:

> An even more minor nit: try to avoid starting a sentence with @var.
> In an Info manual, @var produces UPPER CASE, which looks OK at the
> beginning of a sentence; but in the printed manual, @var produces a
> lower-case word in slant typeface, which makes the sentence begin with
> a lower-case letter.
Excellent! Thank you!
Indeed I found very ugly when I wrote such sentence starting with @{var}; 
I couldn't find an alternative way to say what I wanted to say.  You
summarized the point nicely.

Updated the patch (below).
I will push it by Sunday (4 days from now) if there is no more
activity in thi thread.

--8<-----------------------------cut here---------------start------------->8---
commit 55b82da7a7d0c1e016ef73ef46a7579fd9369cbf
Author: tino calancha <tino.calancha@gmail.com>
Date:   Wed Jan 24 12:03:14 2018 +0900

     Code refactoring

     * lisp/subr.el (assoc-delete-all): Add optional arg TEST.
     (assq-delete-all): Use assoc-delete-all.
     * doc/lispref/lists.texi (Association Lists): Document
     assoc-delete-all in the manual.
     ; * etc/NEWS: Add entry for assoc-delete-all

diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi
index 3e2dd13c70..761750eb20 100644
--- a/doc/lispref/lists.texi
+++ b/doc/lispref/lists.texi
@@ -1733,6 +1733,14 @@ Association Lists
  @end example
  @end defun

+@defun assoc-delete-all key alist &optional test
+This function is like @code{assq-delete-all} except that it accepts
+an optional argument @var{test}, a predicate function to compare the
+keys in @var{alist}. If omitted or @code{nil}, @var{test} defaults to
+@code{equal}.  As @code{assq-delete-all}, this function often modifies
+the original list structure of @var{alist}.
+@end defun
+
  @defun rassq-delete-all value alist
  This function deletes from @var{alist} all the elements whose @sc{cdr}
  is @code{eq} to @var{value}.  It returns the shortened alist, and
diff --git a/etc/NEWS b/etc/NEWS
index d30f0b087c..c491777781 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -204,6 +204,9 @@ as new-style, bind the new variable 'force-new-style-backquotes' to t.

  * Lisp Changes in Emacs 27.1

++++
+** New function assoc-delete-all.
+
  ** 'print-quoted' now defaults to t, so if you want to see
  (quote x) instead of 'x you will have to bind it to nil where applicable.

diff --git a/lisp/subr.el b/lisp/subr.el
index 092850a44d..e7a0ffc5be 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -705,17 +705,19 @@ member-ignore-case
      (setq list (cdr list)))
    list)

-(defun assoc-delete-all (key alist)
-  "Delete from ALIST all elements whose car is `equal' to KEY.
+(defun assoc-delete-all (key alist &optional test)
+  "Delete from ALIST all elements whose car is KEY.
+Compare keys with TEST.  Defaults to `equal'.
  Return the modified alist.
  Elements of ALIST that are not conses are ignored."
+  (unless test (setq test #'equal))
    (while (and (consp (car alist))
-	      (equal (car (car alist)) key))
+	      (funcall test (caar alist) key))
      (setq alist (cdr alist)))
    (let ((tail alist) tail-cdr)
      (while (setq tail-cdr (cdr tail))
        (if (and (consp (car tail-cdr))
-	       (equal (car (car tail-cdr)) key))
+	       (funcall test (caar tail-cdr) key))
  	  (setcdr tail (cdr tail-cdr))
  	(setq tail tail-cdr))))
    alist)
@@ -724,16 +726,7 @@ assq-delete-all
    "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)
+  (assoc-delete-all key alist #'eq))

  (defun rassq-delete-all (value alist)
    "Delete from ALIST all elements whose cdr is `eq' to VALUE.
--8<-----------------------------cut here---------------end--------------->8---

bug#30202: 27.0.50; Code refactoring on assq-delete-all assoc-delete-all

[Tino Calancha]

Tino Calancha <tino.calancha@gmail.com> writes:

> Updated the patch (below).
> I will push it by Sunday (4 days from now) if there is no more
> activity in this thread.
Commited into master branch,
'Code refactoring assoc-delete-all assq-delete-all'
(9824885fabea53f8c4461d038f4c1edad1b8f591)