diff 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
line wrap: on
line diff
--- a/src/fns.c	Fri Jul 14 02:25:53 2006 +0000
+++ b/src/fns.c	Wed Jul 19 00:42:56 2006 +0000
@@ -147,7 +147,6 @@
   register Lisp_Object val;
   register int i;
 
- retry:
   if (STRINGP (sequence))
     XSETFASTINT (val, SCHARS (sequence));
   else if (VECTORP (sequence))
@@ -174,18 +173,15 @@
 	  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 @@
     }
 
   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 @@
   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 @@
 	    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 @@
 	    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 @@
   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 @@
   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 @@
   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 @@
      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 @@
   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 @@
       QUIT;
     }
 
-  if (!CONSP (list) && !NILP (list))
-    list = wrong_type_argument (Qlistp, list);
-
+  CHECK_LIST (list);
   return list;
 }
 
@@ -1430,8 +1412,6 @@
      (key, list)
      Lisp_Object key, list;
 {
-  Lisp_Object result;
-
   while (1)
     {
       if (!CONSP (list)
@@ -1455,14 +1435,7 @@
       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 @@
 	     || !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 @@
      (key, list)
      Lisp_Object key, list;
 {
-  Lisp_Object result, car;
+  Lisp_Object car;
 
   while (1)
     {
@@ -1514,14 +1487,7 @@
       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 @@
      register Lisp_Object key;
      Lisp_Object list;
 {
-  Lisp_Object result;
-
   while (1)
     {
       if (!CONSP (list)
@@ -1572,14 +1536,7 @@
       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 @@
      (key, list)
      Lisp_Object key, list;
 {
-  Lisp_Object result, cdr;
+  Lisp_Object cdr;
 
   while (1)
     {
@@ -1616,14 +1573,7 @@
       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 @@
   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 @@
 
       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 @@
   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 @@
       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 @@
 	QUIT;
     }
 
-  if (!NILP (tail))
-    wrong_type_argument (Qlistp, prop);
+  CHECK_LIST_END (tail, prop);
 
   return Qnil;
 }
@@ -2064,8 +2009,7 @@
       QUIT;
     }
 
-  if (!NILP (tail))
-    wrong_type_argument (Qlistp, prop);
+  CHECK_LIST_END (tail, prop);
 
   return Qnil;
 }
@@ -2280,7 +2224,6 @@
      Lisp_Object array, item;
 {
   register int size, index, charval;
- retry:
   if (VECTORP (array))
     {
       register Lisp_Object *p = XVECTOR (array)->contents;
@@ -2344,10 +2287,7 @@
 	}
     }
   else
-    {
-      array = wrong_type_argument (Qarrayp, array);
-      goto retry;
-    }
+    wrong_type_argument (Qarrayp, array);
   return array;
 }
 
@@ -2405,8 +2345,7 @@
 
       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 @@
   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 @@
 
       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 @@
   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 @@
   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 @@
   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 @@
       && !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 @@
 	  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 @@
 	      if (!NILP (noerror))
 		coding_system = Qraw_text;
 	      else
-		while (1)
-		  Fsignal (Qcoding_system_error, Fcons (coding_system, Qnil));
+		xsignal1 (Qcoding_system_error, coding_system);
 	    }
 	}