Re: Predicate for true lists

["Basil L. Contovounesios" <contovob@tcd.ie>]

[-- Attachment #1: Type: text/plain, Size: 323 bytes --]

"Basil L. Contovounesios" <contovob@tcd.ie> writes:

> I reattach the three patches, updated also for Paul's feedback in
> https://lists.gnu.org/archive/html/emacs-devel/2018-07/msg00149.html.

Sorry, I forgot to remove some now-redundant source comments in my last
patchset.  Here are the three patches again.

-- 
Basil


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Add-predicate-proper-list-p.patch --]
[-- Type: text/x-diff, Size: 12095 bytes --]

From 262766620df76ae19ddfe17cb03f03389ee63ada Mon Sep 17 00:00:00 2001
From: "Basil L. Contovounesios" <contovob@tcd.ie>
Date: Mon, 9 Jul 2018 22:36:25 +0300
Subject: [PATCH 1/3] Add predicate proper-list-p

For discussion, see emacs-devel thread starting at
https://lists.gnu.org/archive/html/emacs-devel/2018-04/msg00460.html.

* lisp/subr.el (proper-list-p): New function.
Implementation suggested by Paul Eggert <eggert@cs.ucla.edu> in
https://lists.gnu.org/archive/html/emacs-devel/2018-06/msg00138.html.
* doc/lispref/lists.texi (List Elements):
* etc/NEWS: Document proper-list-p.
* lisp/org/ob-core.el (org-babel-insert-result):
* lisp/emacs-lisp/byte-opt.el (byte-optimize-if):
* lisp/emacs-lisp/cl-macs.el (cl--make-usage-args): Use proper-list-p.
* lisp/emacs-lisp/ert.el (ert--proper-list-p): Remove.
Replaced by proper-list-p in lisp/subr.el.
(ert--explain-equal-rec): Use proper-list-length.
* lisp/format.el (format-proper-list-p): Remove.
Replaced by proper-list-p in lisp/subr.el.
(format-annotate-single-property-change): Use proper-list-p.
* test/lisp/emacs-lisp/ert-tests.el (ert-test-proper-list-p):
Move from here...
* test/lisp/subr-tests.el (subr-tests--proper-list-length):
...to here, mutatis mutandis.
---
 doc/lispref/lists.texi            | 16 ++++++++++++
 etc/NEWS                          |  5 ++++
 lisp/emacs-lisp/byte-opt.el       |  3 +--
 lisp/emacs-lisp/cl-macs.el        |  2 +-
 lisp/emacs-lisp/ert.el            | 28 ++++++---------------
 lisp/format.el                    | 12 ++-------
 lisp/org/ob-core.el               |  5 ++--
 lisp/subr.el                      |  6 +++++
 test/lisp/emacs-lisp/ert-tests.el | 42 -------------------------------
 test/lisp/subr-tests.el           | 18 +++++++++++++
 10 files changed, 59 insertions(+), 78 deletions(-)

diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi
index 761750eb20..57cefeac96 100644
--- a/doc/lispref/lists.texi
+++ b/doc/lispref/lists.texi
@@ -153,6 +153,22 @@ List-related Predicates
 @end example
 @end defun
 
+@defun proper-list-p object
+This function returns the length of @var{object} if it is a proper
+list, @code{nil} otherwise (@pxref{Cons Cells}).  In addition to
+satisfying @code{listp}, a proper list is neither circular nor dotted.
+
+@example
+@group
+(proper-list-p '(a b c))
+    @result{} 3
+@end group
+@group
+(proper-list-p '(a b . c))
+    @result{} nil
+@end group
+@end example
+@end defun
 
 @node List Elements
 @section Accessing Elements of Lists
diff --git a/etc/NEWS b/etc/NEWS
index dae028be7b..1a1e0d8b70 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -703,6 +703,11 @@ manual for more details.
 \f
 * Lisp Changes in Emacs 27.1
 
++++
+** New function 'proper-list-p'.
+Given a proper list as argument, this predicate returns its length;
+otherwise, it returns nil.
+
 ** define-minor-mode automatically documents the meaning of ARG
 
 +++
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 3bc4c438d6..5c0b5e340b 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -982,8 +982,7 @@ byte-optimize-if
   ;; (if <test> <then> nil) ==> (if <test> <then>)
   (let ((clause (nth 1 form)))
     (cond ((and (eq (car-safe clause) 'progn)
-                ;; `clause' is a proper list.
-                (null (cdr (last clause))))
+                (proper-list-p clause))
            (if (null (cddr clause))
                ;; A trivial `progn'.
                (byte-optimize-if `(if ,(cadr clause) ,@(nthcdr 2 form)))
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index b50961adac..011965acb5 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -498,7 +498,7 @@ cl--make-usage-args
       ;; `&aux' args aren't arguments, so let's just drop them from the
       ;; usage info.
       (setq arglist (cl-subseq arglist 0 aux))))
-  (if (cdr-safe (last arglist))         ;Not a proper list.
+  (if (not (proper-list-p arglist))
       (let* ((last (last arglist))
              (tail (cdr last)))
         (unwind-protect
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index 32bb367cdb..cad21044f1 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -472,18 +472,6 @@ ert--should-error-handle-error
 ;; buffer.  Perhaps explanations should be reported through `ert-info'
 ;; rather than as part of the condition.
 
-(defun ert--proper-list-p (x)
-  "Return non-nil if X is a proper list, nil otherwise."
-  (cl-loop
-   for firstp = t then nil
-   for fast = x then (cddr fast)
-   for slow = x then (cdr slow) do
-   (when (null fast) (cl-return t))
-   (when (not (consp fast)) (cl-return nil))
-   (when (null (cdr fast)) (cl-return t))
-   (when (not (consp (cdr fast))) (cl-return nil))
-   (when (and (not firstp) (eq fast slow)) (cl-return nil))))
-
 (defun ert--explain-format-atom (x)
   "Format the atom X for `ert--explain-equal'."
   (pcase x
@@ -494,17 +482,17 @@ ert--explain-format-atom
 (defun ert--explain-equal-rec (a b)
   "Return a programmer-readable explanation of why A and B are not `equal'.
 Returns nil if they are."
-  (if (not (equal (type-of a) (type-of b)))
+  (if (not (eq (type-of a) (type-of b)))
       `(different-types ,a ,b)
     (pcase-exhaustive a
       ((pred consp)
-       (let ((a-proper-p (ert--proper-list-p a))
-             (b-proper-p (ert--proper-list-p b)))
-         (if (not (eql (not a-proper-p) (not b-proper-p)))
+       (let ((a-length (proper-list-p a))
+             (b-length (proper-list-p b)))
+         (if (not (eq (not a-length) (not b-length)))
              `(one-list-proper-one-improper ,a ,b)
-           (if a-proper-p
-               (if (not (equal (length a) (length b)))
-                   `(proper-lists-of-different-length ,(length a) ,(length b)
+           (if a-length
+               (if (/= a-length b-length)
+                   `(proper-lists-of-different-length ,a-length ,b-length
                                                       ,a ,b
                                                       first-mismatch-at
                                                       ,(cl-mismatch a b :test 'equal))
@@ -523,7 +511,7 @@ ert--explain-equal-rec
                      (cl-assert (equal a b) t)
                      nil))))))))
       ((pred arrayp)
-       (if (not (equal (length a) (length b)))
+       (if (/= (length a) (length b))
            `(arrays-of-different-length ,(length a) ,(length b)
                                         ,a ,b
                                         ,@(unless (char-table-p a)
diff --git a/lisp/format.el b/lisp/format.el
index 2f198e3eb7..1222abbf65 100644
--- a/lisp/format.el
+++ b/lisp/format.el
@@ -539,14 +539,6 @@ format-make-relatively-unique
 	(setq tail next)))
     (cons acopy bcopy)))
 
-(defun format-proper-list-p (list)
-  "Return t if LIST is a proper list.
-A proper list is a list ending with a nil cdr, not with an atom "
-  (when (listp list)
-    (while (consp list)
-      (setq list (cdr list)))
-    (null list)))
-
 (defun format-reorder (items order)
   "Arrange ITEMS to follow partial ORDER.
 Elements of ITEMS equal to elements of ORDER will be rearranged
@@ -1005,8 +997,8 @@ format-annotate-single-property-change
       ;; If either old or new is a list, have to treat both that way.
       (if (and (or (listp old) (listp new))
 	       (not (get prop 'format-list-atomic-p)))
-	  (if (or (not (format-proper-list-p old))
-		  (not (format-proper-list-p new)))
+          (if (not (and (proper-list-p old)
+                        (proper-list-p new)))
 	      (format-annotate-atomic-property-change prop-alist old new)
 	    (let* ((old (if (listp old) old (list old)))
 		   (new (if (listp new) new (list new)))
diff --git a/lisp/org/ob-core.el b/lisp/org/ob-core.el
index 5d5faaa6fd..a5449fe35e 100644
--- a/lisp/org/ob-core.el
+++ b/lisp/org/ob-core.el
@@ -2310,10 +2310,9 @@ org-babel-insert-result
 		       (lambda (r)
 			 ;; Non-nil when result R can be turned into
 			 ;; a table.
-			 (and (listp r)
-			      (null (cdr (last r)))
+                         (and (proper-list-p r)
 			      (cl-every
-			       (lambda (e) (or (atom e) (null (cdr (last e)))))
+                               (lambda (e) (or (atom e) (proper-list-p e)))
 			       result)))))
 		  ;; insert results based on type
 		  (cond
diff --git a/lisp/subr.el b/lisp/subr.el
index ca184d8fc8..c1d90e3fb1 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -555,6 +555,12 @@ zerop
   (declare (compiler-macro (lambda (_) `(= 0 ,number))))
   (= 0 number))
 
+(defun proper-list-p (object)
+  "Return OBJECT's length if it is a proper list, nil otherwise.
+A proper list is neither circular nor dotted (i.e., its last cdr
+is nil)."
+  (and (listp object) (ignore-errors (length object))))
+
 (defun delete-dups (list)
   "Destructively remove `equal' duplicates from LIST.
 Store the result in LIST and return it.  LIST must be a proper list.
diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el
index e92b434274..cb957bd9fd 100644
--- a/test/lisp/emacs-lisp/ert-tests.el
+++ b/test/lisp/emacs-lisp/ert-tests.el
@@ -496,48 +496,6 @@ ert-test--which-file
 
 
 ;;; Tests for utility functions.
-(ert-deftest ert-test-proper-list-p ()
-  (should (ert--proper-list-p '()))
-  (should (ert--proper-list-p '(1)))
-  (should (ert--proper-list-p '(1 2)))
-  (should (ert--proper-list-p '(1 2 3)))
-  (should (ert--proper-list-p '(1 2 3 4)))
-  (should (not (ert--proper-list-p 'a)))
-  (should (not (ert--proper-list-p '(1 . a))))
-  (should (not (ert--proper-list-p '(1 2 . a))))
-  (should (not (ert--proper-list-p '(1 2 3 . a))))
-  (should (not (ert--proper-list-p '(1 2 3 4 . a))))
-  (let ((a (list 1)))
-    (setf (cdr (last a)) a)
-    (should (not (ert--proper-list-p a))))
-  (let ((a (list 1 2)))
-    (setf (cdr (last a)) a)
-    (should (not (ert--proper-list-p a))))
-  (let ((a (list 1 2 3)))
-    (setf (cdr (last a)) a)
-    (should (not (ert--proper-list-p a))))
-  (let ((a (list 1 2 3 4)))
-    (setf (cdr (last a)) a)
-    (should (not (ert--proper-list-p a))))
-  (let ((a (list 1 2)))
-    (setf (cdr (last a)) (cdr a))
-    (should (not (ert--proper-list-p a))))
-  (let ((a (list 1 2 3)))
-    (setf (cdr (last a)) (cdr a))
-    (should (not (ert--proper-list-p a))))
-  (let ((a (list 1 2 3 4)))
-    (setf (cdr (last a)) (cdr a))
-    (should (not (ert--proper-list-p a))))
-  (let ((a (list 1 2 3)))
-    (setf (cdr (last a)) (cddr a))
-    (should (not (ert--proper-list-p a))))
-  (let ((a (list 1 2 3 4)))
-    (setf (cdr (last a)) (cddr a))
-    (should (not (ert--proper-list-p a))))
-  (let ((a (list 1 2 3 4)))
-    (setf (cdr (last a)) (cl-cdddr a))
-    (should (not (ert--proper-list-p a)))))
-
 (ert-deftest ert-test-parse-keys-and-body ()
   (should (equal (ert--parse-keys-and-body '(foo)) '(nil (foo))))
   (should (equal (ert--parse-keys-and-body '(:bar foo)) '((:bar foo) nil)))
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index 52b61d9fb9..86938d5dbe 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -306,6 +306,24 @@ subr-test--frames-1
   (should (eq (string-to-char (symbol-name (gensym))) ?g))
   (should (eq (string-to-char (symbol-name (gensym "X"))) ?X)))
 
+(ert-deftest subr-tests--proper-list-p ()
+  "Test `proper-list-p' behavior."
+  (dotimes (length 4)
+    ;; Proper and dotted lists.
+    (let ((list (make-list length 0)))
+      (should (= (proper-list-p list) length))
+      (should (not (proper-list-p (nconc list 0)))))
+    ;; Circular lists.
+    (dotimes (n (1+ length))
+      (let ((circle (make-list (1+ length) 0)))
+        (should (not (proper-list-p (nconc circle (nthcdr n circle))))))))
+  ;; Atoms.
+  (should (not (proper-list-p 0)))
+  (should (not (proper-list-p "")))
+  (should (not (proper-list-p [])))
+  (should (not (proper-list-p (make-bool-vector 0 nil))))
+  (should (not (proper-list-p (make-symbol "a")))))
+
 (ert-deftest subr-tests--assq-delete-all ()
   "Test `assq-delete-all' behavior."
   (cl-flet ((new-list-fn
-- 
2.18.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-Refer-to-proper-lists-instead-of-true-lists.patch --]
[-- Type: text/x-diff, Size: 3791 bytes --]

From cdeb4497a8539b9b2ab4542554af834d3d1a97a5 Mon Sep 17 00:00:00 2001
From: "Basil L. Contovounesios" <contovob@tcd.ie>
Date: Mon, 9 Jul 2018 16:25:12 +0300
Subject: [PATCH 2/3] Refer to "proper lists" instead of "true lists"

* doc/lispref/lists.texi (Cons Cells, Building Lists):
* doc/lispref/sequences.texi (Vector Functions): Use the more
popular term "proper", rather than "true", to qualify nil-terminated
lists.

For discussion, see the following emacs-devel subthreads:
https://lists.gnu.org/archive/html/emacs-devel/2018-06/msg00112.html
https://lists.gnu.org/archive/html/emacs-devel/2018-06/msg00138.html
---
 doc/lispref/lists.texi     | 21 ++++++++++++---------
 doc/lispref/sequences.texi |  2 +-
 2 files changed, 13 insertions(+), 10 deletions(-)

diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi
index 57cefeac96..b7bb3cf6be 100644
--- a/doc/lispref/lists.texi
+++ b/doc/lispref/lists.texi
@@ -50,16 +50,19 @@ Cons Cells
 slots have similar properties).  Hence, the @sc{cdr} slot of each cons
 cell in a list refers to the following cons cell.
 
+@cindex proper list
 @cindex true list
   Also by convention, the @sc{cdr} of the last cons cell in a list is
 @code{nil}.  We call such a @code{nil}-terminated structure a
-@dfn{true list}.  In Emacs Lisp, the symbol @code{nil} is both a
-symbol and a list with no elements.  For convenience, the symbol
-@code{nil} is considered to have @code{nil} as its @sc{cdr} (and also
-as its @sc{car}).
+@dfn{proper list}@footnote{It is sometimes also referred to as a
+@dfn{true list}, but we generally do not use this terminology in this
+manual.}.  In Emacs Lisp, the symbol @code{nil} is both a symbol and a
+list with no elements.  For convenience, the symbol @code{nil} is
+considered to have @code{nil} as its @sc{cdr} (and also as its
+@sc{car}).
 
-  Hence, the @sc{cdr} of a true list is always a true list.  The
-@sc{cdr} of a nonempty true list is a true list containing all the
+  Hence, the @sc{cdr} of a proper list is always a proper list.  The
+@sc{cdr} of a nonempty proper list is a proper list containing all the
 elements except the first.
 
 @cindex dotted list
@@ -71,10 +74,10 @@ Cons Cells
 @sc{cdr} could point to one of the previous cons cells in the list.
 We call that structure a @dfn{circular list}.
 
-  For some purposes, it does not matter whether a list is true,
+  For some purposes, it does not matter whether a list is proper,
 circular or dotted.  If a program doesn't look far enough down the
 list to see the @sc{cdr} of the final cons cell, it won't care.
-However, some functions that operate on lists demand true lists and
+However, some functions that operate on lists demand proper lists and
 signal errors if given a dotted list.  Most functions that try to find
 the end of a list enter infinite loops if given a circular list.
 
@@ -538,7 +541,7 @@ Building Lists
 is itself a list, then its elements become in effect elements of the
 result list.  If the final element is not a list, the result is a
 dotted list since its final @sc{cdr} is not @code{nil} as required
-in a true list.
+in a proper list (@pxref{Cons Cells}).
 @end defun
 
   Here is an example of using @code{append}:
diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi
index 777b1cbbff..62d3305fcf 100644
--- a/doc/lispref/sequences.texi
+++ b/doc/lispref/sequences.texi
@@ -1353,7 +1353,7 @@ Vector Functions
 @defun vconcat &rest sequences
 @cindex copying vectors
 This function returns a new vector containing all the elements of
-@var{sequences}.  The arguments @var{sequences} may be true lists,
+@var{sequences}.  The arguments @var{sequences} may be proper lists,
 vectors, strings or bool-vectors.  If no @var{sequences} are given,
 the empty vector is returned.
 
-- 
2.18.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0003-Rearrange-definition-of-zerop-in-subr.el.patch --]
[-- Type: text/x-diff, Size: 1419 bytes --]

From 6dfbd3acf2c842583289c544008ee67744b3e794 Mon Sep 17 00:00:00 2001
From: "Basil L. Contovounesios" <contovob@tcd.ie>
Date: Fri, 6 Jul 2018 00:56:45 +0300
Subject: [PATCH 3/3] ; Rearrange definition of zerop in subr.el

* lisp/subr.el (zerop): Move from under 'List functions' heading to
under 'Basic Lisp functions' heading.
---
 lisp/subr.el | 14 +++++++-------
 1 file changed, 7 insertions(+), 7 deletions(-)

diff --git a/lisp/subr.el b/lisp/subr.el
index c1d90e3fb1..10343e69db 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -359,6 +359,13 @@ apply-partially
   (lambda (&rest args2)
     (apply fun (append args args2))))
 
+(defun zerop (number)
+  "Return t if NUMBER is zero."
+  ;; Used to be in C, but it's pointless since (= 0 n) is faster anyway because
+  ;; = has a byte-code.
+  (declare (compiler-macro (lambda (_) `(= 0 ,number))))
+  (= 0 number))
+
 \f
 ;;;; List functions.
 
@@ -548,13 +555,6 @@ nbutlast
 	   (if (> n 0) (setcdr (nthcdr (- (1- m) n) list) nil))
 	   list))))
 
-(defun zerop (number)
-  "Return t if NUMBER is zero."
-  ;; Used to be in C, but it's pointless since (= 0 n) is faster anyway because
-  ;; = has a byte-code.
-  (declare (compiler-macro (lambda (_) `(= 0 ,number))))
-  (= 0 number))
-
 (defun proper-list-p (object)
   "Return OBJECT's length if it is a proper list, nil otherwise.
 A proper list is neither circular nor dotted (i.e., its last cdr
-- 
2.18.0