diff options
author | Miles Bader <miles@gnu.org> | 2006-07-19 00:42:56 +0000 |
---|---|---|
committer | Miles Bader <miles@gnu.org> | 2006-07-19 00:42:56 +0000 |
commit | 63db3c1b3ffa669435b10aa362115ef664990ab2 (patch) | |
tree | a62f68b147d4265ce993136af897d4f348570594 /src/fns.c | |
parent | 2988d6b36d310ba98ea1fed570142f436804fc18 (diff) | |
parent | 83676aa2e399363120942ef5ea19f8af6b75e8e8 (diff) | |
download | emacs-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.c | 163 |
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); } } |