summaryrefslogtreecommitdiff
path: root/src/fns.c
diff options
context:
space:
mode:
authorMiles Bader <miles@gnu.org>2006-07-19 00:42:56 +0000
committerMiles Bader <miles@gnu.org>2006-07-19 00:42:56 +0000
commit63db3c1b3ffa669435b10aa362115ef664990ab2 (patch)
treea62f68b147d4265ce993136af897d4f348570594 /src/fns.c
parent2988d6b36d310ba98ea1fed570142f436804fc18 (diff)
parent83676aa2e399363120942ef5ea19f8af6b75e8e8 (diff)
downloademacs-63db3c1b3ffa669435b10aa362115ef664990ab2.tar.gz
Merge from emacs--devo--0
Patches applied: * emacs--devo--0 (patch 343-356) - Update from CVS - Update for ERC 5.1.3. - Merge from gnus--rel--5.10 * gnus--rel--5.10 (patch 113-115) - Merge from emacs--devo--0 - Update from CVS Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-90
Diffstat (limited to 'src/fns.c')
-rw-r--r--src/fns.c163
1 files changed, 44 insertions, 119 deletions
diff --git a/src/fns.c b/src/fns.c
index 3b4b3e5149b..4c1e5b79ae2 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -147,7 +147,6 @@ To get the number of bytes, use `string-bytes'. */)
register Lisp_Object val;
register int i;
- retry:
if (STRINGP (sequence))
XSETFASTINT (val, SCHARS (sequence));
else if (VECTORP (sequence))
@@ -174,18 +173,15 @@ To get the number of bytes, use `string-bytes'. */)
QUIT;
}
- if (!NILP (sequence))
- wrong_type_argument (Qlistp, sequence);
+ CHECK_LIST_END (sequence, sequence);
val = make_number (i);
}
else if (NILP (sequence))
XSETFASTINT (val, 0);
else
- {
- sequence = wrong_type_argument (Qsequencep, sequence);
- goto retry;
- }
+ wrong_type_argument (Qsequencep, sequence);
+
return val;
}
@@ -488,7 +484,8 @@ with the original. */)
}
if (!CONSP (arg) && !VECTORP (arg) && !STRINGP (arg))
- arg = wrong_type_argument (Qsequencep, arg);
+ wrong_type_argument (Qsequencep, arg);
+
return concat (1, &arg, CONSP (arg) ? Lisp_Cons : XTYPE (arg), 0);
}
@@ -540,15 +537,13 @@ concat (nargs, args, target_type, last_special)
else
last_tail = Qnil;
- /* Canonicalize each argument. */
+ /* Check each argument. */
for (argnum = 0; argnum < nargs; argnum++)
{
this = args[argnum];
if (!(CONSP (this) || NILP (this) || VECTORP (this) || STRINGP (this)
|| COMPILEDP (this) || BOOL_VECTOR_P (this)))
- {
- args[argnum] = wrong_type_argument (Qsequencep, this);
- }
+ wrong_type_argument (Qsequencep, this);
}
/* Compute total length in chars of arguments in RESULT_LEN.
@@ -575,8 +570,7 @@ concat (nargs, args, target_type, last_special)
for (i = 0; i < len; i++)
{
ch = XVECTOR (this)->contents[i];
- if (! CHARACTERP (ch))
- wrong_type_argument (Qcharacterp, ch);
+ CHECK_CHARACTER (ch);
this_len_byte = CHAR_BYTES (XINT (ch));
result_len_byte += this_len_byte;
if (! ASCII_CHAR_P (XINT (ch)) && ! CHAR_BYTE8_P (XINT (ch)))
@@ -588,8 +582,7 @@ concat (nargs, args, target_type, last_special)
for (; CONSP (this); this = XCDR (this))
{
ch = XCAR (this);
- if (! CHARACTERP (ch))
- wrong_type_argument (Qcharacterp, ch);
+ CHECK_CHARACTER (ch);
this_len_byte = CHAR_BYTES (XINT (ch));
result_len_byte += this_len_byte;
if (! ASCII_CHAR_P (XINT (ch)) && ! CHAR_BYTE8_P (XINT (ch)))
@@ -1171,9 +1164,7 @@ This function allows vectors as well as strings. */)
int from_char, to_char;
int from_byte = 0, to_byte = 0;
- if (! (STRINGP (string) || VECTORP (string)))
- wrong_type_argument (Qarrayp, string);
-
+ CHECK_VECTOR_OR_STRING (string);
CHECK_NUMBER (from);
if (STRINGP (string))
@@ -1297,8 +1288,7 @@ substring_both (string, from, from_byte, to, to_byte)
int size;
int size_byte;
- if (! (STRINGP (string) || VECTORP (string)))
- wrong_type_argument (Qarrayp, string);
+ CHECK_VECTOR_OR_STRING (string);
if (STRINGP (string))
{
@@ -1338,8 +1328,7 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0,
for (i = 0; i < num && !NILP (list); i++)
{
QUIT;
- if (! CONSP (list))
- wrong_type_argument (Qlistp, list);
+ CHECK_LIST_CONS (list, list);
list = XCDR (list);
}
return list;
@@ -1360,16 +1349,12 @@ DEFUN ("elt", Felt, Selt, 2, 2, 0,
register Lisp_Object sequence, n;
{
CHECK_NUMBER (n);
- while (1)
- {
- if (CONSP (sequence) || NILP (sequence))
- return Fcar (Fnthcdr (n, sequence));
- else if (STRINGP (sequence) || VECTORP (sequence)
- || BOOL_VECTOR_P (sequence) || CHAR_TABLE_P (sequence))
- return Faref (sequence, n);
- else
- sequence = wrong_type_argument (Qsequencep, sequence);
- }
+ if (CONSP (sequence) || NILP (sequence))
+ return Fcar (Fnthcdr (n, sequence));
+
+ /* Faref signals a "not array" error, so check here. */
+ CHECK_ARRAY (sequence, Qsequencep);
+ return Faref (sequence, n);
}
DEFUN ("member", Fmember, Smember, 2, 2, 0,
@@ -1383,8 +1368,7 @@ The value is actually the tail of LIST whose car is ELT. */)
for (tail = list; !NILP (tail); tail = XCDR (tail))
{
register Lisp_Object tem;
- if (! CONSP (tail))
- wrong_type_argument (Qlistp, list);
+ CHECK_LIST_CONS (tail, list);
tem = XCAR (tail);
if (! NILP (Fequal (elt, tem)))
return tail;
@@ -1417,9 +1401,7 @@ whose car is ELT. */)
QUIT;
}
- if (!CONSP (list) && !NILP (list))
- list = wrong_type_argument (Qlistp, list);
-
+ CHECK_LIST (list);
return list;
}
@@ -1430,8 +1412,6 @@ Elements of LIST that are not conses are ignored. */)
(key, list)
Lisp_Object key, list;
{
- Lisp_Object result;
-
while (1)
{
if (!CONSP (list)
@@ -1455,14 +1435,7 @@ Elements of LIST that are not conses are ignored. */)
QUIT;
}
- if (CONSP (list))
- result = XCAR (list);
- else if (NILP (list))
- result = Qnil;
- else
- result = wrong_type_argument (Qlistp, list);
-
- return result;
+ return CAR (list);
}
/* Like Fassq but never report an error and do not allow quits.
@@ -1477,7 +1450,7 @@ assq_no_quit (key, list)
|| !EQ (XCAR (XCAR (list)), key)))
list = XCDR (list);
- return CONSP (list) ? XCAR (list) : Qnil;
+ return CAR_SAFE (list);
}
DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0,
@@ -1486,7 +1459,7 @@ The value is actually the first element of LIST whose car equals KEY. */)
(key, list)
Lisp_Object key, list;
{
- Lisp_Object result, car;
+ Lisp_Object car;
while (1)
{
@@ -1514,14 +1487,7 @@ The value is actually the first element of LIST whose car equals KEY. */)
QUIT;
}
- if (CONSP (list))
- result = XCAR (list);
- else if (NILP (list))
- result = Qnil;
- else
- result = wrong_type_argument (Qlistp, list);
-
- return result;
+ return CAR (list);
}
/* Like Fassoc but never report an error and do not allow quits.
@@ -1547,8 +1513,6 @@ The value is actually the first element of LIST whose cdr is KEY. */)
register Lisp_Object key;
Lisp_Object list;
{
- Lisp_Object result;
-
while (1)
{
if (!CONSP (list)
@@ -1572,14 +1536,7 @@ The value is actually the first element of LIST whose cdr is KEY. */)
QUIT;
}
- if (NILP (list))
- result = Qnil;
- else if (CONSP (list))
- result = XCAR (list);
- else
- result = wrong_type_argument (Qlistp, list);
-
- return result;
+ return CAR (list);
}
DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0,
@@ -1588,7 +1545,7 @@ The value is actually the first element of LIST whose cdr equals KEY. */)
(key, list)
Lisp_Object key, list;
{
- Lisp_Object result, cdr;
+ Lisp_Object cdr;
while (1)
{
@@ -1616,14 +1573,7 @@ The value is actually the first element of LIST whose cdr equals KEY. */)
QUIT;
}
- if (CONSP (list))
- result = XCAR (list);
- else if (NILP (list))
- result = Qnil;
- else
- result = wrong_type_argument (Qlistp, list);
-
- return result;
+ return CAR (list);
}
DEFUN ("delq", Fdelq, Sdelq, 2, 2, 0,
@@ -1643,8 +1593,7 @@ to be sure of changing the value of `foo'. */)
prev = Qnil;
while (!NILP (tail))
{
- if (! CONSP (tail))
- wrong_type_argument (Qlistp, list);
+ CHECK_LIST_CONS (tail, list);
tem = XCAR (tail);
if (EQ (elt, tem))
{
@@ -1766,8 +1715,7 @@ to be sure of changing the value of `foo'. */)
for (tail = seq, prev = Qnil; !NILP (tail); tail = XCDR (tail))
{
- if (!CONSP (tail))
- wrong_type_argument (Qlistp, seq);
+ CHECK_LIST_CONS (tail, seq);
if (!NILP (Fequal (elt, XCAR (tail))))
{
@@ -1799,8 +1747,7 @@ Return the reversed list. */)
while (!NILP (tail))
{
QUIT;
- if (! CONSP (tail))
- wrong_type_argument (Qlistp, list);
+ CHECK_LIST_CONS (tail, list);
next = XCDR (tail);
Fsetcdr (tail, prev);
prev = tail;
@@ -1822,8 +1769,7 @@ See also the function `nreverse', which is used more often. */)
QUIT;
new = Fcons (XCAR (list), new);
}
- if (!NILP (list))
- wrong_type_argument (Qconsp, list);
+ CHECK_LIST_END (list, list);
return new;
}
@@ -1947,8 +1893,7 @@ one of the properties on the list. */)
QUIT;
}
- if (!NILP (tail))
- wrong_type_argument (Qlistp, prop);
+ CHECK_LIST_END (tail, prop);
return Qnil;
}
@@ -2064,8 +2009,7 @@ one of the properties on the list. */)
QUIT;
}
- if (!NILP (tail))
- wrong_type_argument (Qlistp, prop);
+ CHECK_LIST_END (tail, prop);
return Qnil;
}
@@ -2280,7 +2224,6 @@ ARRAY is a vector, string, char-table, or bool-vector. */)
Lisp_Object array, item;
{
register int size, index, charval;
- retry:
if (VECTORP (array))
{
register Lisp_Object *p = XVECTOR (array)->contents;
@@ -2344,10 +2287,7 @@ ARRAY is a vector, string, char-table, or bool-vector. */)
}
}
else
- {
- array = wrong_type_argument (Qarrayp, array);
- goto retry;
- }
+ wrong_type_argument (Qarrayp, array);
return array;
}
@@ -2405,8 +2345,7 @@ usage: (nconc &rest LISTS) */)
if (argnum + 1 == nargs) break;
- if (!CONSP (tem))
- tem = wrong_type_argument (Qlistp, tem);
+ CHECK_LIST_CONS (tem, tem);
while (CONSP (tem))
{
@@ -3923,10 +3862,7 @@ hashfn_user_defined (h, key)
args[1] = key;
hash = Ffuncall (2, args);
if (!INTEGERP (hash))
- Fsignal (Qerror,
- list2 (build_string ("Invalid hash code returned from \
-user-supplied hash function"),
- hash));
+ signal_error ("Invalid hash code returned from user-supplied hash function", hash);
return XUINT (hash);
}
@@ -4682,8 +4618,7 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */)
prop = Fget (test, Qhash_table_test);
if (!CONSP (prop) || !CONSP (XCDR (prop)))
- Fsignal (Qerror, list2 (build_string ("Invalid hash table test"),
- test));
+ signal_error ("Invalid hash table test", test);
user_test = XCAR (prop);
user_hash = XCAR (XCDR (prop));
}
@@ -4696,9 +4631,7 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */)
if (NILP (size))
size = make_number (DEFAULT_HASH_SIZE);
else if (!INTEGERP (size) || XINT (size) < 0)
- Fsignal (Qerror,
- list2 (build_string ("Invalid hash table size"),
- size));
+ signal_error ("Invalid hash table size", size);
/* Look for `:rehash-size SIZE'. */
i = get_key_arg (QCrehash_size, nargs, args, used);
@@ -4706,9 +4639,7 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */)
if (!NUMBERP (rehash_size)
|| (INTEGERP (rehash_size) && XINT (rehash_size) <= 0)
|| XFLOATINT (rehash_size) <= 1.0)
- Fsignal (Qerror,
- list2 (build_string ("Invalid hash table rehash size"),
- rehash_size));
+ signal_error ("Invalid hash table rehash size", rehash_size);
/* Look for `:rehash-threshold THRESHOLD'. */
i = get_key_arg (QCrehash_threshold, nargs, args, used);
@@ -4716,9 +4647,7 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */)
if (!FLOATP (rehash_threshold)
|| XFLOATINT (rehash_threshold) <= 0.0
|| XFLOATINT (rehash_threshold) > 1.0)
- Fsignal (Qerror,
- list2 (build_string ("Invalid hash table rehash threshold"),
- rehash_threshold));
+ signal_error ("Invalid hash table rehash threshold", rehash_threshold);
/* Look for `:weakness WEAK'. */
i = get_key_arg (QCweakness, nargs, args, used);
@@ -4730,14 +4659,12 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */)
&& !EQ (weak, Qvalue)
&& !EQ (weak, Qkey_or_value)
&& !EQ (weak, Qkey_and_value))
- Fsignal (Qerror, list2 (build_string ("Invalid hash table weakness"),
- weak));
+ signal_error ("Invalid hash table weakness", weak);
/* Now, all args should have been used up, or there's a problem. */
for (i = 0; i < nargs; ++i)
if (!used[i])
- Fsignal (Qerror,
- list2 (build_string ("Invalid argument list"), args[i]));
+ signal_error ("Invalid argument list", args[i]);
return make_hash_table (test, size, rehash_size, rehash_threshold, weak,
user_test, user_hash);
@@ -4987,8 +4914,7 @@ guesswork fails. Normally, an error is signaled in such case. */)
if (!NILP (noerror))
coding_system = Qraw_text;
else
- while (1)
- Fsignal (Qcoding_system_error, Fcons (coding_system, Qnil));
+ xsignal1 (Qcoding_system_error, coding_system);
}
if (STRING_MULTIBYTE (object))
@@ -5122,8 +5048,7 @@ guesswork fails. Normally, an error is signaled in such case. */)
if (!NILP (noerror))
coding_system = Qraw_text;
else
- while (1)
- Fsignal (Qcoding_system_error, Fcons (coding_system, Qnil));
+ xsignal1 (Qcoding_system_error, coding_system);
}
}