emacs: src/fns.c comparison

comparison src/fns.c @ 90533:8a8e69664178

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

author	Miles Bader <miles@gnu.org>
date	Wed, 19 Jul 2006 00:42:56 +0000
parents	a8190f7e546e dd7e7d68e3b0
children	858cb33ae39d

comparison

equal deleted inserted replaced

-:e22cf6d2400c
+:8a8e69664178
 register Lisp_Object sequence;
 {
 register Lisp_Object val;
 register int i;
-retry:
 if (STRINGP (sequence))
 XSETFASTINT (val, SCHARS (sequence));
 else if (VECTORP (sequence))
 XSETFASTINT (val, XVECTOR (sequence)->size);
 else if (CHAR_TABLE_P (sequence))
 	  sequence = XCDR (sequence);
 	  ++i;
 	  QUIT;
 	}
-if (!NILP (sequence))
+CHECK_LIST_END (sequence, sequence);
-	wrong_type_argument (Qlistp, sequence);
 val = make_number (i);
 }
 else if (NILP (sequence))
 XSETFASTINT (val, 0);
 else
-{
+wrong_type_argument (Qsequencep, sequence);
-sequence = wrong_type_argument (Qsequencep, sequence);
-goto retry;
-}
 return val;
 }
 /* This does not check for quits.  That is safe since it must terminate.  */
 	     size_in_chars);
 return val;
 }
 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);
 }
 /* This structure holds information of an argument of `concat' that is
 a string and has text properties to be copied.  */
 last_tail = args[nargs];
 }
 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)))
-	{
+	wrong_type_argument (Qsequencep, this);
-	    args[argnum] = wrong_type_argument (Qsequencep, this);
-	}
 }
 /* Compute total length in chars of arguments in RESULT_LEN.
 If desired output is a string, also compute length in bytes
 in RESULT_LEN_BYTE, and determine in SOME_MULTIBYTE
 	  if (VECTORP (this))
 	    for (i = 0; i < len; i++)
 	      {
 		ch = XVECTOR (this)->contents[i];
-		if (! CHARACTERP (ch))
+		CHECK_CHARACTER (ch);
-		  wrong_type_argument (Qcharacterp, 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)))
 		  some_multibyte = 1;
 	      }
 	    wrong_type_argument (Qintegerp, Faref (this, make_number (0)));
 	  else if (CONSP (this))
 	    for (; CONSP (this); this = XCDR (this))
 	      {
 		ch = XCAR (this);
-		if (! CHARACTERP (ch))
+		CHECK_CHARACTER (ch);
-		  wrong_type_argument (Qcharacterp, 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)))
 		  some_multibyte = 1;
 	      }
 int size;
 int size_byte = 0;
 int from_char, to_char;
 int from_byte = 0, to_byte = 0;
-if (! (STRINGP (string) || VECTORP (string)))
+CHECK_VECTOR_OR_STRING (string);
-wrong_type_argument (Qarrayp, string);
 CHECK_NUMBER (from);
 if (STRINGP (string))
 {
 size = SCHARS (string);
 {
 Lisp_Object res;
 int size;
 int size_byte;
-if (! (STRINGP (string) || VECTORP (string)))
+CHECK_VECTOR_OR_STRING (string);
-wrong_type_argument (Qarrayp, string);
 if (STRINGP (string))
 {
 size = SCHARS (string);
 size_byte = SBYTES (string);
 CHECK_NUMBER (n);
 num = XINT (n);
 for (i = 0; i < num && !NILP (list); i++)
 {
 QUIT;
-if (! CONSP (list))
+CHECK_LIST_CONS (list, list);
-	wrong_type_argument (Qlistp, list);
 list = XCDR (list);
 }
 return list;
 }
 doc: /* Return element of SEQUENCE at index N.  */)
 (sequence, n)
 register Lisp_Object sequence, n;
 {
 CHECK_NUMBER (n);
-while (1)
+if (CONSP (sequence) || NILP (sequence))
-{
+return Fcar (Fnthcdr (n, sequence));
-if (CONSP (sequence) || NILP (sequence))
-	return Fcar (Fnthcdr (n, sequence));
+/* Faref signals a "not array" error, so check here.  */
-else if (STRINGP (sequence) || VECTORP (sequence)
+CHECK_ARRAY (sequence, Qsequencep);
-	       || BOOL_VECTOR_P (sequence) || CHAR_TABLE_P (sequence))
+return Faref (sequence, n);
-	return Faref (sequence, n);
-else
-	sequence = wrong_type_argument (Qsequencep, sequence);
-}
 }
 DEFUN ("member", Fmember, Smember, 2, 2, 0,
 doc: /* Return non-nil if ELT is an element of LIST.  Comparison done with `equal'.
 The value is actually the tail of LIST whose car is ELT.  */)
 {
 register Lisp_Object tail;
 for (tail = list; !NILP (tail); tail = XCDR (tail))
 {
 register Lisp_Object tem;
-if (! CONSP (tail))
+CHECK_LIST_CONS (tail, list);
-	wrong_type_argument (Qlistp, list);
 tem = XCAR (tail);
 if (! NILP (Fequal (elt, tem)))
 	return tail;
 QUIT;
 }
 list = XCDR (list);
 QUIT;
 }
-if (!CONSP (list) && !NILP (list))
+CHECK_LIST (list);
-list = wrong_type_argument (Qlistp, list);
 return list;
 }
 DEFUN ("assq", Fassq, Sassq, 2, 2, 0,
 doc: /* Return non-nil if KEY is `eq' to the car of an element of LIST.
 The value is actually the first element of LIST whose car is KEY.
 Elements of LIST that are not conses are ignored.  */)
 (key, list)
 Lisp_Object key, list;
 {
-Lisp_Object result;
 while (1)
 {
 if (!CONSP (list)
 	  || (CONSP (XCAR (list))
 	      && EQ (XCAR (XCAR (list)), key)))
 list = XCDR (list);
 QUIT;
 }
-if (CONSP (list))
+return CAR (list);
-result = XCAR (list);
-else if (NILP (list))
-result = Qnil;
-else
-result = wrong_type_argument (Qlistp, list);
-return result;
 }
 /* Like Fassq but never report an error and do not allow quits.
 Use only on lists known never to be circular.  */
 while (CONSP (list)
 	 && (!CONSP (XCAR (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,
 doc: /* Return non-nil if KEY is `equal' to the car of an element of LIST.
 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)
 {
 if (!CONSP (list)
 	  || (CONSP (XCAR (list))
 list = XCDR (list);
 QUIT;
 }
-if (CONSP (list))
+return CAR (list);
-result = XCAR (list);
-else if (NILP (list))
-result = Qnil;
-else
-result = wrong_type_argument (Qlistp, list);
-return result;
 }
 /* Like Fassoc but never report an error and do not allow quits.
 Use only on lists known never to be circular.  */
 The value is actually the first element of LIST whose cdr is KEY.  */)
 (key, list)
 register Lisp_Object key;
 Lisp_Object list;
 {
-Lisp_Object result;
 while (1)
 {
 if (!CONSP (list)
 	  || (CONSP (XCAR (list))
 	      && EQ (XCDR (XCAR (list)), key)))
 list = XCDR (list);
 QUIT;
 }
-if (NILP (list))
+return CAR (list);
-result = Qnil;
-else if (CONSP (list))
-result = XCAR (list);
-else
-result = wrong_type_argument (Qlistp, list);
-return result;
 }
 DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0,
 doc: /* Return non-nil if KEY is `equal' to the cdr of an element of LIST.
 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)
 {
 if (!CONSP (list)
 	  || (CONSP (XCAR (list))
 list = XCDR (list);
 QUIT;
 }
-if (CONSP (list))
+return CAR (list);
-result = XCAR (list);
-else if (NILP (list))
-result = Qnil;
-else
-result = wrong_type_argument (Qlistp, list);
-return result;
 }
 DEFUN ("delq", Fdelq, Sdelq, 2, 2, 0,
 doc: /* Delete by side effect any occurrences of ELT as a member of LIST.
 The modified LIST is returned.  Comparison is done with `eq'.
 tail = list;
 prev = Qnil;
 while (!NILP (tail))
 {
-if (! CONSP (tail))
+CHECK_LIST_CONS (tail, list);
-	wrong_type_argument (Qlistp, list);
 tem = XCAR (tail);
 if (EQ (elt, tem))
 	{
 	  if (NILP (prev))
 	    list = XCDR (tail);
 {
 Lisp_Object tail, prev;
 for (tail = seq, prev = Qnil; !NILP (tail); tail = XCDR (tail))
 	{
-	  if (!CONSP (tail))
+	  CHECK_LIST_CONS (tail, seq);
-	    wrong_type_argument (Qlistp, seq);
 	  if (!NILP (Fequal (elt, XCAR (tail))))
 	    {
 	      if (NILP (prev))
 		seq = XCDR (tail);
 prev = Qnil;
 tail = list;
 while (!NILP (tail))
 {
 QUIT;
-if (! CONSP (tail))
+CHECK_LIST_CONS (tail, list);
-	wrong_type_argument (Qlistp, list);
 next = XCDR (tail);
 Fsetcdr (tail, prev);
 prev = tail;
 tail = next;
 }
 for (new = Qnil; CONSP (list); list = XCDR (list))
 {
 QUIT;
 new = Fcons (XCAR (list), new);
 }
-if (!NILP (list))
+CHECK_LIST_END (list, list);
-wrong_type_argument (Qconsp, list);
 return new;
 }
 Lisp_Object merge ();
 	 (setup_coding_system).  Don't QUIT in that case.  */
 if (!interrupt_input_blocked)
 	QUIT;
 }
-if (!NILP (tail))
+CHECK_LIST_END (tail, prop);
-wrong_type_argument (Qlistp, prop);
 return Qnil;
 }
 #endif
 	return XCAR (XCDR (tail));
 QUIT;
 }
-if (!NILP (tail))
+CHECK_LIST_END (tail, prop);
-wrong_type_argument (Qlistp, prop);
 return Qnil;
 }
 DEFUN ("lax-plist-put", Flax_plist_put, Slax_plist_put, 3, 3, 0,
 ARRAY is a vector, string, char-table, or bool-vector.  */)
 (array, item)
 Lisp_Object array, item;
 {
 register int size, index, charval;
-retry:
 if (VECTORP (array))
 {
 register Lisp_Object *p = XVECTOR (array)->contents;
 size = XVECTOR (array)->size;
 for (index = 0; index < size; index++)
 	    charval &= (1 << (XBOOL_VECTOR (array)->size % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
 	  p[index] = charval;
 	}
 }
 else
-{
+wrong_type_argument (Qarrayp, array);
-array = wrong_type_argument (Qarrayp, array);
-goto retry;
-}
 return array;
 }
 DEFUN ("clear-string", Fclear_string, Sclear_string,
 1, 1, 0,
 if (NILP (val))
 	val = tem;
 if (argnum + 1 == nargs) break;
-if (!CONSP (tem))
+CHECK_LIST_CONS (tem, tem);
-	tem = wrong_type_argument (Qlistp, tem);
 while (CONSP (tem))
 	{
 	  tail = tem;
 	  tem = XCDR (tail);
 args[0] = h->user_hash_function;
 args[1] = key;
 hash = Ffuncall (2, args);
 if (!INTEGERP (hash))
-Fsignal (Qerror,
+signal_error ("Invalid hash code returned from user-supplied hash function", hash);
-	     list2 (build_string ("Invalid hash code returned from \
-user-supplied hash function"),
-		    hash));
 return XUINT (hash);
 }
 /* Create and initialize a new hash table.
 /* See if it is a user-defined test.  */
 Lisp_Object prop;
 prop = Fget (test, Qhash_table_test);
 if (!CONSP (prop) || !CONSP (XCDR (prop)))
-	Fsignal (Qerror, list2 (build_string ("Invalid hash table test"),
+	signal_error ("Invalid hash table test", test);
-				test));
 user_test = XCAR (prop);
 user_hash = XCAR (XCDR (prop));
 }
 else
 user_test = user_hash = Qnil;
 i = get_key_arg (QCsize, nargs, args, used);
 size = i < 0 ? Qnil : args[i];
 if (NILP (size))
 size = make_number (DEFAULT_HASH_SIZE);
 else if (!INTEGERP (size) || XINT (size) < 0)
-Fsignal (Qerror,
+signal_error ("Invalid hash table size", size);
-	     list2 (build_string ("Invalid hash table size"),
-		    size));
 /* Look for `:rehash-size SIZE'.  */
 i = get_key_arg (QCrehash_size, nargs, args, used);
 rehash_size = i < 0 ? make_float (DEFAULT_REHASH_SIZE) : args[i];
 if (!NUMBERP (rehash_size)
 || (INTEGERP (rehash_size) && XINT (rehash_size) <= 0)
 || XFLOATINT (rehash_size) <= 1.0)
-Fsignal (Qerror,
+signal_error ("Invalid hash table rehash size", rehash_size);
-	     list2 (build_string ("Invalid hash table rehash size"),
-		    rehash_size));
 /* Look for `:rehash-threshold THRESHOLD'.  */
 i = get_key_arg (QCrehash_threshold, nargs, args, used);
 rehash_threshold = i < 0 ? make_float (DEFAULT_REHASH_THRESHOLD) : args[i];
 if (!FLOATP (rehash_threshold)
 || XFLOATINT (rehash_threshold) <= 0.0
 || XFLOATINT (rehash_threshold) > 1.0)
-Fsignal (Qerror,
+signal_error ("Invalid hash table rehash threshold", rehash_threshold);
-	     list2 (build_string ("Invalid hash table rehash threshold"),
-		    rehash_threshold));
 /* Look for `:weakness WEAK'.  */
 i = get_key_arg (QCweakness, nargs, args, used);
 weak = i < 0 ? Qnil : args[i];
 if (EQ (weak, Qt))
 if (!NILP (weak)
 && !EQ (weak, Qkey)
 && !EQ (weak, Qvalue)
 && !EQ (weak, Qkey_or_value)
 && !EQ (weak, Qkey_and_value))
-Fsignal (Qerror, list2 (build_string ("Invalid hash table weakness"),
+signal_error ("Invalid hash table weakness", weak);
-			    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,
+signal_error ("Invalid argument list", args[i]);
-	       list2 (build_string ("Invalid argument list"), args[i]));
 return make_hash_table (test, size, rehash_size, rehash_threshold, weak,
 			  user_test, user_hash);
 }
 	  /* Invalid coding system.  */
 	  if (!NILP (noerror))
 	    coding_system = Qraw_text;
 	  else
-	    while (1)
+	    xsignal1 (Qcoding_system_error, coding_system);
-	      Fsignal (Qcoding_system_error, Fcons (coding_system, Qnil));
 	}
 if (STRING_MULTIBYTE (object))
 	object = code_convert_string (object, coding_system, Qnil, 1, 0, 1);
 	      /* Invalid coding system.  */
 	      if (!NILP (noerror))
 		coding_system = Qraw_text;
 	      else
-		while (1)
+		xsignal1 (Qcoding_system_error, coding_system);
-		  Fsignal (Qcoding_system_error, Fcons (coding_system, Qnil));
 	    }
 	}
 object = make_buffer_string (b, e, 0);
 if (prev != current_buffer)

Mercurial > emacs

comparison src/fns.c @ 90533:8a8e69664178