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.

6 files changed, 20 insertions, 36 deletions

diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 3bc4c438d6a..5c0b5e340bb 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -982,8 +982,7 @@
   ;; (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 b50961adac9..011965acb54 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -498,7 +498,7 @@ its argument list allows full Common Lisp conventions."
       ;; `&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 32bb367cdb3..cad21044f15 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -472,18 +472,6 @@ Errors during evaluation are caught and handled like nil."
 ;; 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 @@ Errors during evaluation are caught and handled like nil."
 (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 @@ Returns nil if they are."
                      (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 2f198e3eb71..1222abbf658 100644
--- a/lisp/format.el
+++ b/lisp/format.el
@@ -539,14 +539,6 @@ Compare using `equal'."
         (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 @@ either strings, or lists of the form (PARAMETER VALUE)."
       ;; 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 5d5faaa6fd0..a5449fe35e9 100644
--- a/lisp/org/ob-core.el
+++ b/lisp/org/ob-core.el
@@ -2310,10 +2310,9 @@ INFO may provide the values of these header arguments (in the
                        (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 ca184d8fc81..c1d90e3fb18 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -555,6 +555,12 @@ If N is omitted or nil, remove the last element."
   (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.