(CHECK_TYPE): New macro for generic type checking.

(CAR_SAFE, CDR_SAFE): New macros.
(ARRAYP, CHECK_ARRAY): New macros.
(CHECK_VECTOR_OR_STRING, CHECK_SUBR): New macros.
(CHECK_WINDOW_CONFIGURATION): New macro.
(CHECK_LIST_CONS, CHECK_LIST_END): New checks for list traversal.
(CHECK_STRING_OR_BUFFER, CHECK_HASH_TABLE, CHECK_LIST)
(CHECK_STRING, CHECK_STRING_CAR, CHECK_CONS, CHECK_SYMBOL)
(CHECK_CHAR_TABLE, CHECK_VECTOR, CHECK_VECTOR_OR_CHAR_TABLE)
(CHECK_BUFFER, CHECK_WINDOW, CHECK_LIVE_WINDOW, CHECK_PROCESS)
(CHECK_NUMBER, CHECK_NATNUM, CHECK_MARKER, CHECK_OVERLAY)
(CHECK_NUMBER_COERCE_MARKER, CHECK_FLOAT, CHECK_NUMBER_OR_FLOAT)
(CHECK_NUMBER_OR_FLOAT_COERCE_MARKER): Use CHECK_TYPE.

diff --git a/src/lisp.h b/src/lisp.h
index d6c4a1b..e276ac0 100644 (file)
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -591,6 +591,12 @@ extern size_t pure_size;
 #define STRING_COPYIN(string, index, new, count) \
     bcopy (new, XSTRING (string)->data + index, count)
 
+/* Type checking.  */
+
+#define CHECK_TYPE(ok, Qxxxp, x) \
+  do { if (!(ok)) wrong_type_argument (Qxxxp, (x)); } while (0)
+
+
 \f
 /* See the macros in intervals.h.  */
 
@@ -598,8 +604,8 @@ typedef struct interval *INTERVAL;
 
 /* Complain if object is not string or buffer type */
 #define CHECK_STRING_OR_BUFFER(x) \
-  { if (!STRINGP ((x)) && !BUFFERP ((x))) \
-      x = wrong_type_argument (Qbuffer_or_string_p, (x)); }
+  CHECK_TYPE (STRINGP (x) || BUFFERP (x), Qbuffer_or_string_p, x)
+
 \f
 /* In a cons, the markbit of the car is the gc mark bit */
 
@@ -668,6 +674,13 @@ struct Lisp_Cons
   : NILP ((c)) ? Qnil                          \
   : wrong_type_argument (Qlistp, (c)))
 
+/* Take the car or cdr of something whose type is not known.  */
+#define CAR_SAFE(c)                            \
+  (CONSP ((c)) ? XCAR ((c)) : Qnil)
+
+#define CDR_SAFE(c)                            \
+  (CONSP ((c)) ? XCDR ((c)) : Qnil)
+
 /* Nonzero if STR is a multibyte string.  */
 #define STRING_MULTIBYTE(STR)  \
   (XSTRING (STR)->size_byte >= 0)
@@ -1053,13 +1066,8 @@ struct Lisp_Hash_Table
 #define HASH_TABLE_P(OBJ)  PSEUDOVECTORP (OBJ, PVEC_HASH_TABLE)
 #define GC_HASH_TABLE_P(x) GC_PSEUDOVECTORP (x, PVEC_HASH_TABLE)
 
-#define CHECK_HASH_TABLE(x)                                    \
-     do                                                                \
-       {                                                       \
-        if (!HASH_TABLE_P ((x)))                               \
-          x = wrong_type_argument (Qhash_table_p, (x));        \
-       }                                                       \
-     while (0)
+#define CHECK_HASH_TABLE(x) \
+  CHECK_TYPE (HASH_TABLE_P (x), Qhash_table_p, x)
 
 /* Value is the key part of entry IDX in hash table H.  */
 
@@ -1524,41 +1532,57 @@ typedef unsigned char UCHAR;
 /* Test for image (image . spec)  */
 #define IMAGEP(x) (CONSP (x) && EQ (XCAR (x), Qimage))
 
+/* Array types.  */
+
+#define ARRAYP(x) \
+  (VECTORP (x) || STRINGP (x) || CHAR_TABLE_P (x) || BOOL_VECTOR_P (x))
 \f
 #define GC_EQ(x, y) EQ (x, y)
 
 #define CHECK_LIST(x) \
-  do { if (!CONSP ((x)) && !NILP (x)) x = wrong_type_argument (Qlistp, (x)); } while (0)
+  CHECK_TYPE (CONSP (x) || NILP (x), Qlistp, x)
+
+#define CHECK_LIST_CONS(x, y) \
+  CHECK_TYPE (CONSP (x), Qlistp, y)
+
+#define CHECK_LIST_END(x, y) \
+  CHECK_TYPE (NILP (x), Qlistp, y)
 
 #define CHECK_STRING(x) \
-  do { if (!STRINGP ((x))) x = wrong_type_argument (Qstringp, (x)); } while (0)
+  CHECK_TYPE (STRINGP (x), Qstringp, x)
 
 #define CHECK_STRING_CAR(x) \
-  do { if (!STRINGP (XCAR (x))) XSETCAR (x, wrong_type_argument (Qstringp, XCAR (x))); } while (0)
+  CHECK_TYPE (STRINGP (XCAR (x)), Qstringp, XCAR (x))
 
 #define CHECK_CONS(x) \
-  do { if (!CONSP ((x))) x = wrong_type_argument (Qconsp, (x)); } while (0)
+  CHECK_TYPE (CONSP (x), Qconsp, x)
 
 #define CHECK_SYMBOL(x) \
-  do { if (!SYMBOLP ((x))) x = wrong_type_argument (Qsymbolp, (x)); } while (0)
+  CHECK_TYPE (SYMBOLP (x), Qsymbolp, x)
 
 #define CHECK_CHAR_TABLE(x) \
-  do { if (!CHAR_TABLE_P ((x)))        \
-        x = wrong_type_argument (Qchar_table_p, (x)); } while (0)
+  CHECK_TYPE (CHAR_TABLE_P (x), Qchar_table_p, x)
 
 #define CHECK_VECTOR(x) \
-  do { if (!VECTORP ((x))) x = wrong_type_argument (Qvectorp, (x)); } while (0)
+  CHECK_TYPE (VECTORP (x), Qvectorp, x)
 
-#define CHECK_VECTOR_OR_CHAR_TABLE(x)                          \
-  do { if (!VECTORP ((x)) && !CHAR_TABLE_P ((x)))                      \
-        x = wrong_type_argument (Qvector_or_char_table_p, (x));        \
-     } while (0)
+#define CHECK_VECTOR_OR_STRING(x) \
+  CHECK_TYPE (VECTORP (x) || STRINGP (x), Qarrayp, x)
+
+#define CHECK_ARRAY(x, Qxxxp)                                                  \
+  CHECK_TYPE (ARRAYP (x), Qxxxp, x)
+
+#define CHECK_VECTOR_OR_CHAR_TABLE(x) \
+  CHECK_TYPE (VECTORP (x) || CHAR_TABLE_P (x), Qvector_or_char_table_p, x)
 
 #define CHECK_BUFFER(x) \
-  do { if (!BUFFERP ((x))) x = wrong_type_argument (Qbufferp, (x)); } while (0)
+  CHECK_TYPE (BUFFERP (x), Qbufferp, x)
 
 #define CHECK_WINDOW(x) \
-  do { if (!WINDOWP ((x))) x = wrong_type_argument (Qwindowp, (x)); } while (0)
+  CHECK_TYPE (WINDOWP (x), Qwindowp, x)
+
+#define CHECK_WINDOW_CONFIGURATION(x) \
+  CHECK_TYPE (WINDOW_CONFIGURATIONP (x), Qwindow_configuration_p, x)
 
 /* This macro rejects windows on the interior of the window tree as
    "dead", which is what we want; this is an argument-checking macro, and
@@ -1567,46 +1591,42 @@ typedef unsigned char UCHAR;
    A window of any sort, leaf or interior, is dead iff the buffer,
    vchild, and hchild members are all nil.  */
 
-#define CHECK_LIVE_WINDOW(x)                           \
-  do {                                                 \
-    if (!WINDOWP ((x))                                 \
-       || NILP (XWINDOW ((x))->buffer))                \
-      x = wrong_type_argument (Qwindow_live_p, (x));   \
-  } while (0)
+#define CHECK_LIVE_WINDOW(x) \
+  CHECK_TYPE (WINDOWP (x) && !NILP (XWINDOW (x)->buffer), Qwindow_live_p, x)
 
 #define CHECK_PROCESS(x) \
-  do { if (!PROCESSP ((x))) x = wrong_type_argument (Qprocessp, (x)); } while (0)
+  CHECK_TYPE (PROCESSP (x), Qprocessp, x)
+
+#define CHECK_SUBR(x) \
+  CHECK_TYPE (SUBRP (x), Qsubrp, x)
 
 #define CHECK_NUMBER(x) \
-  do { if (!INTEGERP ((x))) x = wrong_type_argument (Qintegerp, (x)); } while (0)
+  CHECK_TYPE (INTEGERP (x), Qintegerp, x)
 
 #define CHECK_NATNUM(x) \
-  do { if (!NATNUMP (x)) x = wrong_type_argument (Qwholenump, (x)); } while (0)
+  CHECK_TYPE (NATNUMP (x), Qwholenump, x)
 
 #define CHECK_MARKER(x) \
-  do { if (!MARKERP ((x))) x = wrong_type_argument (Qmarkerp, (x)); } while (0)
+  CHECK_TYPE (MARKERP (x), Qmarkerp, x)
 
 #define CHECK_NUMBER_COERCE_MARKER(x) \
   do { if (MARKERP ((x))) XSETFASTINT (x, marker_position (x)); \
-    else if (!INTEGERP ((x))) x = wrong_type_argument (Qinteger_or_marker_p, (x)); } while (0)
+    else CHECK_TYPE (INTEGERP (x), Qinteger_or_marker_p, x); } while (0)
 
 #define XFLOATINT(n) extract_float((n))
 
 #define CHECK_FLOAT(x)         \
-  do { if (!FLOATP (x))                        \
-    x = wrong_type_argument (Qfloatp, (x)); } while (0)
+  CHECK_TYPE (FLOATP (x), Qfloatp, x)
 
 #define CHECK_NUMBER_OR_FLOAT(x)       \
-  do { if (!FLOATP (x) && !INTEGERP (x))       \
-    x = wrong_type_argument (Qnumberp, (x)); } while (0)
+  CHECK_TYPE (FLOATP (x) || INTEGERP (x), Qnumberp, x)
 
 #define CHECK_NUMBER_OR_FLOAT_COERCE_MARKER(x) \
   do { if (MARKERP (x)) XSETFASTINT (x, marker_position (x));  \
-  else if (!INTEGERP (x) && !FLOATP (x))               \
-    x = wrong_type_argument (Qnumber_or_marker_p, (x)); } while (0)
+    else CHECK_TYPE (INTEGERP (x) || FLOATP (x), Qnumber_or_marker_p, x); } while (0)
 
 #define CHECK_OVERLAY(x) \
-  do { if (!OVERLAYP ((x))) x = wrong_type_argument (Qoverlayp, (x));} while (0)
+  CHECK_TYPE (OVERLAYP (x), Qoverlayp, x)
 
 /* Since we can't assign directly to the CAR or CDR fields of a cons
    cell, use these when checking that those fields contain numbers.  */