diff options
author | Karoly Lorentey <lorentey@elte.hu> | 2006-07-14 05:56:32 +0000 |
---|---|---|
committer | Karoly Lorentey <lorentey@elte.hu> | 2006-07-14 05:56:32 +0000 |
commit | 99715bbc447eb633e45ffa23b87284771ce3ac74 (patch) | |
tree | 3a8a53dfe3dbdd9f8e36965e9f043eae522d3c0e /src/data.c | |
parent | 556b89447234f15d1784a23dadbfe429464463a8 (diff) | |
parent | 763bb2d43615bc3ae816422f965d76d5e1ae4bdd (diff) | |
download | emacs-99715bbc447eb633e45ffa23b87284771ce3ac74.tar.gz emacs-99715bbc447eb633e45ffa23b87284771ce3ac74.tar.bz2 emacs-99715bbc447eb633e45ffa23b87284771ce3ac74.zip |
Merged from emacs@sv.gnu.org.
Patches applied:
* emacs@sv.gnu.org/emacs--devo--0--patch-331
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-332
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-333
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-334
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-335
Add note about "link" button-class to etc/TODO
* emacs@sv.gnu.org/emacs--devo--0--patch-336
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-337
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-338
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-339
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-340
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-341
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-342
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-343
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-344
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-345
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-346
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-347
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-348
Update for ERC 5.1.3.
* emacs@sv.gnu.org/emacs--devo--0--patch-349
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-350
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/gnus--rel--5.10--patch-111
Update from CVS: texi/gnus.texi (Summary Buffer Lines): Fix typo.
* emacs@sv.gnu.org/gnus--rel--5.10--patch-112
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-113
Merge from emacs--devo--0
* emacs@sv.gnu.org/gnus--rel--5.10--patch-114
Update from CVS
git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-572
Diffstat (limited to 'src/data.c')
-rw-r--r-- | src/data.c | 88 |
1 files changed, 28 insertions, 60 deletions
diff --git a/src/data.c b/src/data.c index fdad80b2727..8cca837028d 100644 --- a/src/data.c +++ b/src/data.c @@ -114,18 +114,13 @@ Lisp_Object wrong_type_argument (predicate, value) register Lisp_Object predicate, value; { - register Lisp_Object tem; - do - { - /* If VALUE is not even a valid Lisp object, abort here - where we can get a backtrace showing where it came from. */ - if ((unsigned int) XGCTYPE (value) >= Lisp_Type_Limit) - abort (); + /* If VALUE is not even a valid Lisp object, abort here + where we can get a backtrace showing where it came from. */ + if ((unsigned int) XGCTYPE (value) >= Lisp_Type_Limit) + abort (); + + Fsignal (Qwrong_type_argument, list2 (predicate, value)); - value = Fsignal (Qwrong_type_argument, Fcons (predicate, Fcons (value, Qnil))); - tem = call1 (predicate, value); - } - while (NILP (tem)); /* This function is marked as NO_RETURN, gcc would warn if it has a return statement or if falls off the function. Other compilers warn if no return statement is present. */ @@ -395,8 +390,7 @@ DEFUN ("arrayp", Farrayp, Sarrayp, 1, 1, 0, (object) Lisp_Object object; { - if (VECTORP (object) || STRINGP (object) - || CHAR_TABLE_P (object) || BOOL_VECTOR_P (object)) + if (ARRAYP (object)) return Qt; return Qnil; } @@ -406,8 +400,7 @@ DEFUN ("sequencep", Fsequencep, Ssequencep, 1, 1, 0, (object) register Lisp_Object object; { - if (CONSP (object) || NILP (object) || VECTORP (object) || STRINGP (object) - || CHAR_TABLE_P (object) || BOOL_VECTOR_P (object)) + if (CONSP (object) || NILP (object) || ARRAYP (object)) return Qt; return Qnil; } @@ -537,15 +530,7 @@ Lisp concepts such as car, cdr, cons cell and list. */) (list) register Lisp_Object list; { - while (1) - { - if (CONSP (list)) - return XCAR (list); - else if (EQ (list, Qnil)) - return Qnil; - else - list = wrong_type_argument (Qlistp, list); - } + return CAR (list); } DEFUN ("car-safe", Fcar_safe, Scar_safe, 1, 1, 0, @@ -553,10 +538,7 @@ DEFUN ("car-safe", Fcar_safe, Scar_safe, 1, 1, 0, (object) Lisp_Object object; { - if (CONSP (object)) - return XCAR (object); - else - return Qnil; + return CAR_SAFE (object); } DEFUN ("cdr", Fcdr, Scdr, 1, 1, 0, @@ -568,15 +550,7 @@ Lisp concepts such as cdr, car, cons cell and list. */) (list) register Lisp_Object list; { - while (1) - { - if (CONSP (list)) - return XCDR (list); - else if (EQ (list, Qnil)) - return Qnil; - else - list = wrong_type_argument (Qlistp, list); - } + return CDR (list); } DEFUN ("cdr-safe", Fcdr_safe, Scdr_safe, 1, 1, 0, @@ -584,10 +558,7 @@ DEFUN ("cdr-safe", Fcdr_safe, Scdr_safe, 1, 1, 0, (object) Lisp_Object object; { - if (CONSP (object)) - return XCDR (object); - else - return Qnil; + return CDR_SAFE (object); } DEFUN ("setcar", Fsetcar, Ssetcar, 2, 2, 0, @@ -595,9 +566,7 @@ DEFUN ("setcar", Fsetcar, Ssetcar, 2, 2, 0, (cell, newcar) register Lisp_Object cell, newcar; { - if (!CONSP (cell)) - cell = wrong_type_argument (Qconsp, cell); - + CHECK_CONS (cell); CHECK_IMPURE (cell); XSETCAR (cell, newcar); return newcar; @@ -608,9 +577,7 @@ DEFUN ("setcdr", Fsetcdr, Ssetcdr, 2, 2, 0, (cell, newcdr) register Lisp_Object cell, newcdr; { - if (!CONSP (cell)) - cell = wrong_type_argument (Qconsp, cell); - + CHECK_CONS (cell); CHECK_IMPURE (cell); XSETCDR (cell, newcdr); return newcdr; @@ -765,8 +732,7 @@ function with `&rest' args, or `unevalled' for a special form. */) Lisp_Object subr; { short minargs, maxargs; - if (!SUBRP (subr)) - wrong_type_argument (Qsubrp, subr); + CHECK_SUBR (subr); minargs = XSUBR (subr)->min_args; maxargs = XSUBR (subr)->max_args; if (maxargs == MANY) @@ -784,8 +750,7 @@ SUBR must be a built-in function. */) Lisp_Object subr; { const char *name; - if (!SUBRP (subr)) - wrong_type_argument (Qsubrp, subr); + CHECK_SUBR (subr); name = XSUBR (subr)->symbol_name; return make_string (name, strlen (name)); } @@ -2005,13 +1970,18 @@ function chain of symbols. */) { Lisp_Object result; - result = indirect_function (object); + /* Optimize for no indirection. */ + result = object; + if (SYMBOLP (result) && !EQ (result, Qunbound) + && (result = XSYMBOL (result)->function, SYMBOLP (result))) + result = indirect_function (result); + if (!EQ (result, Qunbound)) + return result; - if (EQ (result, Qunbound)) - return (NILP (noerror) - ? Fsignal (Qvoid_function, Fcons (object, Qnil)) - : Qnil); - return result; + if (NILP (noerror)) + Fsignal (Qvoid_function, Fcons (object, Qnil)); + + return Qnil; } /* Extract and set vector and string elements */ @@ -2173,9 +2143,7 @@ bool-vector. IDX starts at 0. */) CHECK_NUMBER (idx); idxval = XINT (idx); - if (!VECTORP (array) && !STRINGP (array) && !BOOL_VECTOR_P (array) - && ! CHAR_TABLE_P (array)) - array = wrong_type_argument (Qarrayp, array); + CHECK_ARRAY (array, Qarrayp); CHECK_IMPURE (array); if (VECTORP (array)) |