summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorPaul Eggert <eggert@cs.ucla.edu>2018-07-24 15:58:46 -0700
committerPaul Eggert <eggert@cs.ucla.edu>2018-07-24 16:08:09 -0700
commit200195e824befa112459c0afbac7c94aea739573 (patch)
tree7799fc7738ba0b7cbfa2539c4c15c713c2419cd9 /src
parent0ed21b7b3e71303d7858192246012f4b26438ad8 (diff)
downloademacs-200195e824befa112459c0afbac7c94aea739573.tar.gz
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.
Diffstat (limited to 'src')
-rw-r--r--src/eval.c20
-rw-r--r--src/fns.c23
-rw-r--r--src/lisp.h2
3 files changed, 26 insertions, 19 deletions
diff --git a/src/eval.c b/src/eval.c
index 256ca8ffdc8..5964dd1867a 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 e7424c34718..5247140ead4 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 8ddd363d2dd..96de60e4670 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) \