aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorPaul Eggert2018-07-24 15:58:46 -0700
committerPaul Eggert2018-07-24 16:08:09 -0700
commit200195e824befa112459c0afbac7c94aea739573 (patch)
tree7799fc7738ba0b7cbfa2539c4c15c713c2419cd9 /src
parent0ed21b7b3e71303d7858192246012f4b26438ad8 (diff)
downloademacs-200195e824befa112459c0afbac7c94aea739573.tar.gz
emacs-200195e824befa112459c0afbac7c94aea739573.zip
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
1732} 1732}
1733 1733
1734/* Signal `error' with message S, and additional arg ARG. 1734/* Signal `error' with message S, and additional arg ARG.
1735 If ARG is not a genuine list, make it a one-element list. */ 1735 If ARG is not a proper list, make it a one-element list. */
1736 1736
1737void 1737void
1738signal_error (const char *s, Lisp_Object arg) 1738signal_error (const char *s, Lisp_Object arg)
1739{ 1739{
1740 Lisp_Object tortoise, hare; 1740 if (NILP (Fproper_list_p (arg)))
1741
1742 hare = tortoise = arg;
1743 while (CONSP (hare))
1744 {
1745 hare = XCDR (hare);
1746 if (!CONSP (hare))
1747 break;
1748
1749 hare = XCDR (hare);
1750 tortoise = XCDR (tortoise);
1751
1752 if (EQ (hare, tortoise))
1753 break;
1754 }
1755
1756 if (!NILP (hare))
1757 arg = list1 (arg); 1741 arg = list1 (arg);
1758 1742
1759 xsignal (Qerror, Fcons (build_string (s), arg)); 1743 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. */)
144 return make_fixnum_or_float (len); 144 return make_fixnum_or_float (len);
145} 145}
146 146
147DEFUN ("proper-list-p", Fproper_list_p, Sproper_list_p, 1, 1, 0,
148 doc: /* Return OBJECT's length if it is a proper list, nil otherwise.
149A proper list is neither circular nor dotted (i.e., its last cdr is nil). */
150 attributes: const)
151 (Lisp_Object object)
152{
153 intptr_t len = 0;
154 Lisp_Object last_tail = object;
155 Lisp_Object tail = object;
156 FOR_EACH_TAIL_SAFE (tail)
157 {
158 len++;
159 rarely_quit (len);
160 last_tail = XCDR (tail);
161 }
162 if (!NILP (last_tail))
163 return Qnil;
164 if (MOST_POSITIVE_FIXNUM < len)
165 xsignal0 (Qoverflow_error);
166 return make_number (len);
167}
168
147DEFUN ("string-bytes", Fstring_bytes, Sstring_bytes, 1, 1, 0, 169DEFUN ("string-bytes", Fstring_bytes, Sstring_bytes, 1, 1, 0,
148 doc: /* Return the number of bytes in STRING. 170 doc: /* Return the number of bytes in STRING.
149If STRING is multibyte, this may be greater than the length of STRING. */) 171If STRING is multibyte, this may be greater than the length of STRING. */)
@@ -5295,6 +5317,7 @@ this variable. */);
5295 defsubr (&Srandom); 5317 defsubr (&Srandom);
5296 defsubr (&Slength); 5318 defsubr (&Slength);
5297 defsubr (&Ssafe_length); 5319 defsubr (&Ssafe_length);
5320 defsubr (&Sproper_list_p);
5298 defsubr (&Sstring_bytes); 5321 defsubr (&Sstring_bytes);
5299 defsubr (&Sstring_distance); 5322 defsubr (&Sstring_distance);
5300 defsubr (&Sstring_equal); 5323 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
4699#define FOR_EACH_TAIL(tail) \ 4699#define FOR_EACH_TAIL(tail) \
4700 FOR_EACH_TAIL_INTERNAL (tail, circular_list (tail), true) 4700 FOR_EACH_TAIL_INTERNAL (tail, circular_list (tail), true)
4701 4701
4702/* Like FOR_EACH_TAIL (LIST), except do not signal or quit. 4702/* Like FOR_EACH_TAIL (TAIL), except do not signal or quit.
4703 If the loop exits due to a cycle, TAIL’s value is undefined. */ 4703 If the loop exits due to a cycle, TAIL’s value is undefined. */
4704 4704
4705#define FOR_EACH_TAIL_SAFE(tail) \ 4705#define FOR_EACH_TAIL_SAFE(tail) \