Re: To be a list or not

[Tom Tromey]

>>>>> "Stephen" == Stephen J Turnbull <address@hidden> writes:

Stephen> But please call it `true-list-p', which is the name of the
Stephen> similar XEmacs built-in.

Here's one stab at it.  This is basically lifted from safe-length.

I tested it with various inputs.

Is there an Emacs test suite?  I'd be happy to put tests there, if
there is one.

Tom

ChangeLog:
2007-12-29  Tom Tromey  <address@hidden>

        * lisp.h (Ftrue_list_p): Declare.
        * data.c (Ftrue_list_p): New function.
        (syms_of_data): Update.

Index: lisp.h
===================================================================
RCS file: /sources/emacs/emacs/src/lisp.h,v
retrieving revision 1.603
diff -u -r1.603 lisp.h
--- lisp.h      22 Nov 2007 01:01:26 -0000      1.603
+++ lisp.h      29 Dec 2007 23:10:43 -0000
@@ -2205,6 +2205,7 @@
 EXFUN (Fconsp, 1);
 EXFUN (Fatom, 1);
 EXFUN (Fnlistp, 1);
+EXFUN (Ftrue_list_p, 1);
 EXFUN (Fintegerp, 1);
 EXFUN (Fnatnump, 1);
 EXFUN (Fsymbolp, 1);
Index: data.c
===================================================================
RCS file: /sources/emacs/emacs/src/data.c,v
retrieving revision 1.287
diff -u -r1.287 data.c
--- data.c      22 Nov 2007 20:29:48 -0000      1.287
+++ data.c      29 Dec 2007 23:10:44 -0000
@@ -285,6 +285,28 @@
     return Qnil;
   return Qt;
 }
+
+DEFUN ("true-list-p", Ftrue_list_p, Strue_list_p, 1, 1, 0,
+       doc: /* Return t if OBJECT is an acyclic, nil-terminated list.  */)
+     (object)
+     Lisp_Object object;
+{
+  Lisp_Object tail, halftail;
+  int len = 0;
+
+  /* halftail is used to detect circular lists.  */
+  halftail = object;  
+  for (tail = object; CONSP (tail); tail = XCDR (tail))
+    {
+      if (EQ (tail, halftail) && len != 0)
+       return Qnil;
+      ++len;
+      if ((len & 1) == 0)
+       halftail = XCDR (halftail);
+    }
+
+  return tail == Qnil ? Qt : Qnil;
+}
 
 DEFUN ("symbolp", Fsymbolp, Ssymbolp, 1, 1, 0,
        doc: /* Return t if OBJECT is a symbol.  */)
@@ -3291,6 +3313,7 @@
   defsubr (&Stype_of);
   defsubr (&Slistp);
   defsubr (&Snlistp);
+  defsubr (&Strue_list_p);
   defsubr (&Sconsp);
   defsubr (&Satom);
   defsubr (&Sintegerp);