[Emacs-diffs] master 200195e: Move proper-list-p to C

[Paul Eggert]

branch: master
commit 200195e824befa112459c0afbac7c94aea739573
Author: Paul Eggert <address@hidden>
Commit: Paul Eggert <address@hidden>

    Move proper-list-p to C
    
    Since C code can use it and it’s simple, we might as well use C.
    * lisp/subr.el (proper-list-p): Move to C code.
    * src/eval.c (signal_error): Simplify by using Fproper_list_p.
    * src/fns.c (Fproper_list_p): New function, moved here from Lisp.
    
    Simplify signal_error
    * src/eval.c (signal_error): Simplify by using FOR_EACH_TAIL_SAFE.
---
 lisp/subr.el |  6 ------
 src/eval.c   | 20 ++------------------
 src/fns.c    | 23 +++++++++++++++++++++++
 src/lisp.h   |  2 +-
 4 files changed, 26 insertions(+), 25 deletions(-)

diff --git a/lisp/subr.el b/lisp/subr.el
index 10343e6..6b30371 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -555,12 +555,6 @@ If N is omitted or nil, remove the last element."
           (if (> n 0) (setcdr (nthcdr (- (1- m) n) list) nil))
           list))))
 
-(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/src/eval.c b/src/eval.c
index 256ca8f..5964dd1 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1732,28 +1732,12 @@ xsignal3 (Lisp_Object error_symbol, Lisp_Object arg1, 
Lisp_Object arg2, Lisp_Obj
 }
 
 /* Signal `error' with message S, and additional arg ARG.
-   If ARG is not a genuine list, make it a one-element list.  */
+   If ARG is not a proper list, make it a one-element list.  */
 
 void
 signal_error (const char *s, Lisp_Object arg)
 {
-  Lisp_Object tortoise, hare;
-
-  hare = tortoise = arg;
-  while (CONSP (hare))
-    {
-      hare = XCDR (hare);
-      if (!CONSP (hare))
-       break;
-
-      hare = XCDR (hare);
-      tortoise = XCDR (tortoise);
-
-      if (EQ (hare, tortoise))
-       break;
-    }
-
-  if (!NILP (hare))
+  if (NILP (Fproper_list_p (arg)))
     arg = list1 (arg);
 
   xsignal (Qerror, Fcons (build_string (s), arg));
diff --git a/src/fns.c b/src/fns.c
index e7424c3..5247140 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -144,6 +144,28 @@ which is at least the number of distinct elements.  */)
   return make_fixnum_or_float (len);
 }
 
+DEFUN ("proper-list-p", Fproper_list_p, Sproper_list_p, 1, 1, 0,
+       doc: /* 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).  */
+       attributes: const)
+  (Lisp_Object object)
+{
+  intptr_t len = 0;
+  Lisp_Object last_tail = object;
+  Lisp_Object tail = object;
+  FOR_EACH_TAIL_SAFE (tail)
+    {
+      len++;
+      rarely_quit (len);
+      last_tail = XCDR (tail);
+    }
+  if (!NILP (last_tail))
+    return Qnil;
+  if (MOST_POSITIVE_FIXNUM < len)
+    xsignal0 (Qoverflow_error);
+  return make_number (len);
+}
+
 DEFUN ("string-bytes", Fstring_bytes, Sstring_bytes, 1, 1, 0,
        doc: /* Return the number of bytes in STRING.
 If STRING is multibyte, this may be greater than the length of STRING.  */)
@@ -5295,6 +5317,7 @@ this variable.  */);
   defsubr (&Srandom);
   defsubr (&Slength);
   defsubr (&Ssafe_length);
+  defsubr (&Sproper_list_p);
   defsubr (&Sstring_bytes);
   defsubr (&Sstring_distance);
   defsubr (&Sstring_equal);
diff --git a/src/lisp.h b/src/lisp.h
index 8ddd363d2..96de60e 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4699,7 +4699,7 @@ enum
 #define FOR_EACH_TAIL(tail) \
   FOR_EACH_TAIL_INTERNAL (tail, circular_list (tail), true)
 
-/* Like FOR_EACH_TAIL (LIST), except do not signal or quit.
+/* Like FOR_EACH_TAIL (TAIL), except do not signal or quit.
    If the loop exits due to a cycle, TAIL’s value is undefined.  */
 
 #define FOR_EACH_TAIL_SAFE(tail) \