From dc7da0be90d6033d512f9772894179970af678e7 Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Mon, 24 Oct 2011 17:34:47 +0200
Subject: [PATCH] refactor tc7 and tc16 checks

* libguile/tags.h (SCM_HAS_TYP7, SCM_HAS_TYP7S, SCM_HAS_TYP16): New
  macros.

* libguile/bytevectors.h (SCM_BYTEVECTOR_P):
* libguile/control.h (SCM_PROMPT_P):
* libguile/filesys.h (SCM_DIRP):
* libguile/fluids.h (SCM_WITH_FLUIDS_P, SCM_FLUID_P)
  (SCM_I_DYNAMIC_STATE_P):
* libguile/foreign.h (SCM_POINTER_P):
* libguile/fports.h (SCM_FPORTP):
* libguile/frames.h (SCM_VM_FRAME_P):
* libguile/hashtab.h (SCM_HASHTABLE_P):
* libguile/inline.h (scm_get_byte_or_eof):
* libguile/numbers.h (SCM_REALP, SCM_BIGP, SCM_COMPLEXP, SCM_FRACTIONP):
* libguile/objcodes.h (SCM_OBJCODE_P):
* libguile/ports.h (SCM_OUTPUT_PORT_P):
* libguile/programs.h (SCM_PROGRAM_P):
* libguile/smob.h (SCM_SMOB_PREDICATE):
* libguile/srfi-14.h (SCM_CHARSETP):
* libguile/strings.c (IS_STRING):
* libguile/strports.h (SCM_STRPORTP):
* libguile/symbols.h (scm_is_symbol):
* libguile/variable.h (SCM_VARIABLEP):
* libguile/vectors.h (SCM_I_IS_VECTOR, SCM_I_IS_NONWEAK_VECTOR):
* libguile/vm-i-system.c (call, tail-call, mv-call)
* libguile/vm.h (SCM_VM_P, SCM_VM_CONT_P):
* libguile/weak-set.c (SCM_WEAK_SET_P):
* libguile/weak-table.c (SCM_WEAK_TABLE_P):
* libguile/weak-vector.h (SCM_I_WVECTP): Use them.
---
 libguile/bytevectors.h |  2 +-
 libguile/control.h     |  2 +-
 libguile/filesys.h     |  4 ++--
 libguile/fluids.h      |  8 ++++----
 libguile/foreign.h     |  3 +--
 libguile/fports.h      |  4 ++--
 libguile/frames.h      |  2 +-
 libguile/hashtab.h     |  2 +-
 libguile/inline.h      |  2 +-
 libguile/numbers.h     | 11 +++++------
 libguile/objcodes.h    |  2 +-
 libguile/ports.h       | 20 ++++++++------------
 libguile/programs.h    |  4 ++--
 libguile/smob.h        |  2 +-
 libguile/srfi-14.h     |  4 ++--
 libguile/strings.c     |  2 +-
 libguile/strports.h    |  5 ++---
 libguile/symbols.h     |  5 ++---
 libguile/tags.h        |  7 ++++++-
 libguile/variable.h    |  4 ++--
 libguile/vectors.h     |  4 ++--
 libguile/vm-i-system.c |  6 +++---
 libguile/vm.h          |  4 ++--
 libguile/weak-set.c    |  2 +-
 libguile/weak-table.c  |  2 +-
 libguile/weak-vector.h |  2 +-
 26 files changed, 56 insertions(+), 59 deletions(-)

diff --git a/libguile/bytevectors.h b/libguile/bytevectors.h
index f22a3dd86..a5eeaea0c 100644
--- a/libguile/bytevectors.h
+++ b/libguile/bytevectors.h
@@ -117,7 +117,7 @@ SCM_API SCM scm_utf32_to_string (SCM, SCM);
 /* Internal API.  */
 
 #define SCM_BYTEVECTOR_P(x)				\
-  (!SCM_IMP (x) && SCM_TYP7(x) == scm_tc7_bytevector)
+  (SCM_HAS_TYP7 (x, scm_tc7_bytevector))
 #define SCM_BYTEVECTOR_FLAGS(_bv)		\
   (SCM_CELL_TYPE (_bv) >> 7UL)
 #define SCM_SET_BYTEVECTOR_FLAGS(_bv, _f)				\
diff --git a/libguile/control.h b/libguile/control.h
index 2167ffa08..ebf255f72 100644
--- a/libguile/control.h
+++ b/libguile/control.h
@@ -22,7 +22,7 @@
 
 #define SCM_F_PROMPT_ESCAPE 0x1
 
-#define SCM_PROMPT_P(x)		(!SCM_IMP (x) && SCM_TYP7(x) == scm_tc7_prompt)
+#define SCM_PROMPT_P(x)		(SCM_HAS_TYP7 (x, scm_tc7_prompt))
 #define SCM_PROMPT_FLAGS(x)	(SCM_CELL_WORD ((x), 0) >> 8)
 #define SCM_PROMPT_ESCAPE_P(x)	(SCM_PROMPT_FLAGS (x) & SCM_F_PROMPT_ESCAPE)
 #define SCM_PROMPT_TAG(x)	(SCM_CELL_OBJECT ((x), 1))
diff --git a/libguile/filesys.h b/libguile/filesys.h
index 967ce7450..c420992bd 100644
--- a/libguile/filesys.h
+++ b/libguile/filesys.h
@@ -3,7 +3,7 @@
 #ifndef SCM_FILESYS_H
 #define SCM_FILESYS_H
 
-/* Copyright (C) 1995,1997,1998,1999,2000,2001, 2006, 2008, 2009, 2010 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1997,1998,1999,2000,2001, 2006, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -31,7 +31,7 @@ SCM_API scm_t_bits scm_tc16_dir;
 
 #define SCM_DIR_FLAG_OPEN (1L << 0)
 
-#define SCM_DIRP(x) (!SCM_IMP (x) && (SCM_TYP16 (x) == scm_tc16_dir))
+#define SCM_DIRP(x) (SCM_HAS_TYP16 (x, scm_tc16_dir))
 #define SCM_DIR_OPEN_P(x) (SCM_SMOB_FLAGS (x) & SCM_DIR_FLAG_OPEN)
 
 
diff --git a/libguile/fluids.h b/libguile/fluids.h
index 66e398554..09de7366f 100644
--- a/libguile/fluids.h
+++ b/libguile/fluids.h
@@ -3,7 +3,7 @@
 #ifndef SCM_FLUIDS_H
 #define SCM_FLUIDS_H
 
-/* Copyright (C) 1996,2000,2001, 2006, 2008, 2009, 2010 Free Software Foundation, Inc.
+/* Copyright (C) 1996,2000,2001, 2006, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -32,7 +32,7 @@
    always in the same place for a given thread, in the dynamic-state vector.
  */
 
-#define SCM_WITH_FLUIDS_P(x) (!SCM_IMP (x) && SCM_TYP7(x) == scm_tc7_with_fluids)
+#define SCM_WITH_FLUIDS_P(x) (SCM_HAS_TYP7 (x, scm_tc7_with_fluids))
 #define SCM_WITH_FLUIDS_LEN(x) (SCM_CELL_WORD ((x), 0) >> 8)
 #define SCM_WITH_FLUIDS_NTH_FLUID(x,n) (SCM_CELL_OBJECT ((x), 1 + (n)*2))
 #define SCM_WITH_FLUIDS_NTH_VAL(x,n) (SCM_CELL_OBJECT ((x), 2 + (n)*2))
@@ -54,7 +54,7 @@
    grow.
  */
 
-#define SCM_FLUID_P(x)          (!SCM_IMP (x) && SCM_TYP7 (x) == scm_tc7_fluid)
+#define SCM_FLUID_P(x)          (SCM_HAS_TYP7 (x, scm_tc7_fluid))
 #ifdef BUILDING_LIBGUILE
 #define SCM_I_FLUID_NUM(x)        ((size_t)SCM_CELL_WORD_1(x))
 #endif
@@ -81,7 +81,7 @@ SCM_API SCM scm_with_fluid (SCM fluid, SCM val, SCM thunk);
 SCM_API void scm_dynwind_fluid (SCM fluid, SCM value);
 
 #ifdef BUILDING_LIBGUILE
-#define SCM_I_DYNAMIC_STATE_P(x) (!SCM_IMP (x) && SCM_TYP7 (x) == scm_tc7_dynamic_state)
+#define SCM_I_DYNAMIC_STATE_P(x) (SCM_HAS_TYP7 (x, scm_tc7_dynamic_state))
 #define SCM_I_DYNAMIC_STATE_FLUIDS(x)        SCM_PACK (SCM_CELL_WORD_1 (x))
 #endif
 
diff --git a/libguile/foreign.h b/libguile/foreign.h
index 6c6f37306..eac4ca048 100644
--- a/libguile/foreign.h
+++ b/libguile/foreign.h
@@ -49,8 +49,7 @@ typedef enum scm_t_foreign_type scm_t_foreign_type;
 
 typedef void (*scm_t_pointer_finalizer) (void *);
 
-#define SCM_POINTER_P(x)                                                \
-  (!SCM_IMP (x) && SCM_TYP7(x) == scm_tc7_pointer)
+#define SCM_POINTER_P(x) (SCM_HAS_TYP7 (x, scm_tc7_pointer))
 #define SCM_VALIDATE_POINTER(pos, x)		\
   SCM_MAKE_VALIDATE (pos, x, POINTER_P)
 #define SCM_POINTER_VALUE(x)			\
diff --git a/libguile/fports.h b/libguile/fports.h
index cbef0f8ec..32b6a5947 100644
--- a/libguile/fports.h
+++ b/libguile/fports.h
@@ -3,7 +3,7 @@
 #ifndef SCM_FPORTS_H
 #define SCM_FPORTS_H
 
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2006, 2008, 2009 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2006, 2008, 2009, 2011 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -39,7 +39,7 @@ SCM_API scm_t_bits scm_tc16_fport;
 #define SCM_FSTREAM(x) ((scm_t_fport *) SCM_STREAM (x))
 #define SCM_FPORT_FDES(x) (SCM_FSTREAM (x)->fdes)
 
-#define SCM_FPORTP(x) (!SCM_IMP (x) && (SCM_TYP16 (x) == scm_tc16_fport))
+#define SCM_FPORTP(x) (SCM_HAS_TYP16 (x, scm_tc16_fport))
 #define SCM_OPFPORTP(x) (SCM_FPORTP (x) && (SCM_CELL_WORD_0 (x) & SCM_OPN))
 #define SCM_OPINFPORTP(x) (SCM_OPFPORTP (x) && (SCM_CELL_WORD_0 (x) & SCM_RDNG))
 #define SCM_OPOUTFPORTP(x) (SCM_OPFPORTP (x) && (SCM_CELL_WORD_0 (x) & SCM_WRTNG))
diff --git a/libguile/frames.h b/libguile/frames.h
index 47244c7a3..7b9af76a2 100644
--- a/libguile/frames.h
+++ b/libguile/frames.h
@@ -96,7 +96,7 @@ struct scm_frame
   scm_t_ptrdiff offset;
 };
 
-#define SCM_VM_FRAME_P(x)	(SCM_NIMP (x) && SCM_TYP7 (x) == scm_tc7_frame)
+#define SCM_VM_FRAME_P(x)	(SCM_HAS_TYP7 (x, scm_tc7_frame))
 #define SCM_VM_FRAME_DATA(x)	((struct scm_frame*)SCM_CELL_WORD_1 (x))
 #define SCM_VM_FRAME_STACK_HOLDER(f)	SCM_VM_FRAME_DATA(f)->stack_holder
 #define SCM_VM_FRAME_FP(f)	SCM_VM_FRAME_DATA(f)->fp
diff --git a/libguile/hashtab.h b/libguile/hashtab.h
index fdd746c98..8eb685a0e 100644
--- a/libguile/hashtab.h
+++ b/libguile/hashtab.h
@@ -27,7 +27,7 @@
 
 
 
-#define SCM_HASHTABLE_P(x) (!SCM_IMP (x) && SCM_TYP7(x) == scm_tc7_hashtable)
+#define SCM_HASHTABLE_P(x) (SCM_HAS_TYP7 (x, scm_tc7_hashtable))
 #define SCM_VALIDATE_HASHTABLE(pos, arg) \
   SCM_MAKE_VALIDATE_MSG (pos, arg, HASHTABLE_P, "hash-table")
 #define SCM_HASHTABLE_VECTOR(h)  SCM_CELL_OBJECT_1 (h)
diff --git a/libguile/inline.h b/libguile/inline.h
index 6b1cf5e77..315240ed4 100644
--- a/libguile/inline.h
+++ b/libguile/inline.h
@@ -111,7 +111,7 @@ scm_is_pair (SCM x)
 SCM_INLINE_IMPLEMENTATION int
 scm_is_string (SCM x)
 {
-  return SCM_NIMP (x) && (SCM_TYP7 (x) == scm_tc7_string);
+  return SCM_HAS_TYP7 (x, scm_tc7_string);
 }
 
 /* Port I/O.  */
diff --git a/libguile/numbers.h b/libguile/numbers.h
index d3a344443..08b04cfd8 100644
--- a/libguile/numbers.h
+++ b/libguile/numbers.h
@@ -125,8 +125,8 @@ typedef scm_t_int32 scm_t_wchar;
 
 #define SCM_INEXACTP(x) \
   (!SCM_IMP (x) && (0xfeff & SCM_CELL_TYPE (x)) == scm_tc16_real)
-#define SCM_REALP(x) (!SCM_IMP (x) && SCM_TYP16 (x) == scm_tc16_real)
-#define SCM_COMPLEXP(x) (!SCM_IMP (x) && SCM_TYP16 (x) == scm_tc16_complex)
+#define SCM_REALP(x) (SCM_HAS_TYP16 (x, scm_tc16_real))
+#define SCM_COMPLEXP(x) (SCM_HAS_TYP16 (x, scm_tc16_complex))
 
 #define SCM_REAL_VALUE(x) (((scm_t_double *) SCM2PTR (x))->real)
 #define SCM_COMPLEX_REAL(x) (((scm_t_complex *) SCM2PTR (x))->real)
@@ -134,13 +134,12 @@ typedef scm_t_int32 scm_t_wchar;
 
 /* Each bignum is just an mpz_t stored in a double cell starting at word 1. */
 #define SCM_I_BIG_MPZ(x) (*((mpz_t *) (SCM_CELL_OBJECT_LOC((x),1))))
-#define SCM_BIGP(x) (!SCM_IMP (x) && SCM_TYP16 (x) == scm_tc16_big)
+#define SCM_BIGP(x) (SCM_HAS_TYP16 (x, scm_tc16_big))
 
 #define SCM_NUMBERP(x) (SCM_I_INUMP(x) || SCM_NUMP(x))
-#define SCM_NUMP(x) (!SCM_IMP(x) \
-		     && ((0x00ff & SCM_CELL_TYPE (x)) == scm_tc7_number))
+#define SCM_NUMP(x) (SCM_HAS_TYP7 (x, scm_tc7_number))
 
-#define SCM_FRACTIONP(x) (!SCM_IMP (x) && SCM_TYP16 (x) == scm_tc16_fraction)
+#define SCM_FRACTIONP(x) (SCM_HAS_TYP16 (x, scm_tc16_fraction))
 #define SCM_FRACTION_NUMERATOR(x) (SCM_CELL_OBJECT_1 (x))
 #define SCM_FRACTION_DENOMINATOR(x) (SCM_CELL_OBJECT_2 (x))
 
diff --git a/libguile/objcodes.h b/libguile/objcodes.h
index 2fc43d5ed..c075c5cb6 100644
--- a/libguile/objcodes.h
+++ b/libguile/objcodes.h
@@ -40,7 +40,7 @@ struct scm_objcode
 #define SCM_OBJCODE_TYPE_SLICE      (2)
 #define SCM_OBJCODE_TYPE_STATIC     (3)
 
-#define SCM_OBJCODE_P(x)	(SCM_NIMP (x) && SCM_TYP7 (x) == scm_tc7_objcode)
+#define SCM_OBJCODE_P(x)	(SCM_HAS_TYP7 (x, scm_tc7_objcode))
 #define SCM_OBJCODE_DATA(x)	((struct scm_objcode *) SCM_CELL_WORD_1 (x))
 #define SCM_VALIDATE_OBJCODE(p,x) SCM_MAKE_VALIDATE (p, x, OBJCODE_P)
 
diff --git a/libguile/ports.h b/libguile/ports.h
index f5c98abbc..f8bff355b 100644
--- a/libguile/ports.h
+++ b/libguile/ports.h
@@ -138,18 +138,14 @@ SCM_INTERNAL SCM scm_i_port_weak_set;
 #define SCM_BUF0	(8L<<16) /* Is it unbuffered? */
 #define SCM_BUFLINE     (64L<<16) /* Is it line-buffered? */
 
-#define SCM_PORTP(x) (!SCM_IMP (x) && (SCM_TYP7 (x) == scm_tc7_port))
-#define SCM_OPPORTP(x) (!SCM_IMP(x) && (((0x7f | SCM_OPN) & SCM_CELL_WORD_0(x))==(scm_tc7_port | SCM_OPN)))
-#define SCM_OPINPORTP(x) (!SCM_IMP(x) && (((0x7f | SCM_OPN | SCM_RDNG) & SCM_CELL_WORD_0(x))==(scm_tc7_port | SCM_OPN | SCM_RDNG)))
-#define SCM_OPOUTPORTP(x) (!SCM_IMP(x) && (((0x7f | SCM_OPN | SCM_WRTNG) & SCM_CELL_WORD_0(x))==(scm_tc7_port | SCM_OPN | SCM_WRTNG)))
-#define SCM_INPUT_PORT_P(x) \
-  (!SCM_IMP(x) \
-   && (((0x7f | SCM_RDNG) & SCM_CELL_WORD_0(x)) == (scm_tc7_port | SCM_RDNG)))
-#define SCM_OUTPUT_PORT_P(x) \
-  (!SCM_IMP(x) \
-   && (((0x7f | SCM_WRTNG) & SCM_CELL_WORD_0(x))==(scm_tc7_port | SCM_WRTNG)))
-#define SCM_OPENP(x) (!SCM_IMP(x) && (SCM_OPN & SCM_CELL_WORD_0 (x)))
-#define SCM_CLOSEDP(x) (!SCM_OPENP(x))
+#define SCM_PORTP(x) (SCM_HAS_TYP7 (x, scm_tc7_port))
+#define SCM_OPPORTP(x) (SCM_PORTP (x) && (SCM_CELL_WORD_0 (x) & SCM_OPN))
+#define SCM_INPUT_PORT_P(x) (SCM_PORTP (x) && (SCM_CELL_WORD_0 (x) & SCM_RDNG))
+#define SCM_OUTPUT_PORT_P(x) (SCM_PORTP (x) && (SCM_CELL_WORD_0 (x) & SCM_WRTNG))
+#define SCM_OPINPORTP(x) (SCM_OPPORTP (x) && SCM_INPUT_PORT_P (x))
+#define SCM_OPOUTPORTP(x) (SCM_OPPORTP (x) && SCM_OUTPUT_PORT_P (x))
+#define SCM_OPENP(x) (SCM_OPPORTP (x))
+#define SCM_CLOSEDP(x) (!SCM_OPENP (x))
 #define SCM_CLR_PORT_OPEN_FLAG(p) \
   SCM_SET_CELL_WORD_0 ((p), SCM_CELL_WORD_0 (p) & ~SCM_OPN)
 
diff --git a/libguile/programs.h b/libguile/programs.h
index d0e788e51..d53fd8f84 100644
--- a/libguile/programs.h
+++ b/libguile/programs.h
@@ -1,4 +1,4 @@
-/* Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc.
+/* Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -32,7 +32,7 @@
 #define SCM_F_PROGRAM_IS_CONTINUATION 0x800
 #define SCM_F_PROGRAM_IS_PARTIAL_CONTINUATION 0x1000
 
-#define SCM_PROGRAM_P(x)	(!SCM_IMP (x) && SCM_TYP7(x) == scm_tc7_program)
+#define SCM_PROGRAM_P(x)	(SCM_HAS_TYP7 (x, scm_tc7_program))
 #define SCM_PROGRAM_OBJCODE(x)	(SCM_CELL_OBJECT_1 (x))
 #define SCM_PROGRAM_OBJTABLE(x)	(SCM_CELL_OBJECT_2 (x))
 #define SCM_PROGRAM_FREE_VARIABLES(x) (SCM_CELL_OBJECT_LOC (x, 3))
diff --git a/libguile/smob.h b/libguile/smob.h
index 1bcece68d..be404a8f7 100644
--- a/libguile/smob.h
+++ b/libguile/smob.h
@@ -50,7 +50,7 @@ typedef struct scm_smob_descriptor
 #define SCM_SMOBNUM(x)			(SCM_TC2SMOBNUM (SCM_CELL_TYPE (x)))
 /* SCM_SMOBNAME can be 0 if name is missing */
 #define SCM_SMOBNAME(smobnum)		(scm_smobs[smobnum].name)
-#define SCM_SMOB_PREDICATE(tag, obj)	SCM_TYP16_PREDICATE (tag, obj)
+#define SCM_SMOB_PREDICATE(tag, obj)	SCM_HAS_TYP16 (obj, tag)
 #define SCM_SMOB_DESCRIPTOR(x)		(scm_smobs[SCM_SMOBNUM (x)])
 #define SCM_SMOB_APPLICABLE_P(x)	(SCM_SMOB_DESCRIPTOR (x).apply)
 
diff --git a/libguile/srfi-14.h b/libguile/srfi-14.h
index 4b1a4b298..dc9718d70 100644
--- a/libguile/srfi-14.h
+++ b/libguile/srfi-14.h
@@ -3,7 +3,7 @@
 
 /* srfi-14.c --- SRFI-14 procedures for Guile
  *
- * 	Copyright (C) 2001, 2004, 2006, 2008 Free Software Foundation, Inc.
+ * 	Copyright (C) 2001, 2004, 2006, 2008, 2011 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -45,7 +45,7 @@ typedef struct
 #define SCM_CHARSET_GET(cs,idx)                                 \
   scm_i_charset_get((scm_t_char_set *)SCM_SMOB_DATA(cs),idx)
 
-#define SCM_CHARSETP(x) (!SCM_IMP (x) && (SCM_TYP16 (x) == scm_tc16_charset))
+#define SCM_CHARSETP(x) (SCM_HAS_TYP16 (x, scm_tc16_charset))
 
 /* Smob type code for character sets.  */
 SCM_API int scm_tc16_charset;
diff --git a/libguile/strings.c b/libguile/strings.c
index 2de003514..d3c8e155c 100644
--- a/libguile/strings.c
+++ b/libguile/strings.c
@@ -240,7 +240,7 @@ scm_i_pthread_mutex_t stringbuf_write_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
 #define SET_STRING_STRINGBUF(str,buf) (SCM_SET_CELL_OBJECT_1(str,buf))
 #define SET_STRING_START(str,start) (SCM_SET_CELL_WORD_2(str,start))
 
-#define IS_STRING(str)        (SCM_NIMP(str) && SCM_TYP7(str) == STRING_TAG)
+#define IS_STRING(str)        (SCM_HAS_TYP7 (str, STRING_TAG))
 
 /* Read-only strings.
  */
diff --git a/libguile/strports.h b/libguile/strports.h
index 3a9c3ec01..b4bafdfc0 100644
--- a/libguile/strports.h
+++ b/libguile/strports.h
@@ -3,7 +3,7 @@
 #ifndef SCM_STRPORTS_H
 #define SCM_STRPORTS_H
 
-/* Copyright (C) 1995,1996,2000,2001,2002, 2006, 2008, 2010 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,2000,2001,2002, 2006, 2008, 2010, 2011 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -28,8 +28,7 @@
 
 
 
-#define SCM_STRPORTP(x)      (!SCM_IMP (x) && \
-                              (SCM_TYP16 (x) == scm_tc16_strport))
+#define SCM_STRPORTP(x)      (SCM_HAS_TYP16 (x, scm_tc16_strport))
 #define SCM_OPSTRPORTP(x)    (SCM_STRPORTP (x) && \
                               (SCM_CELL_WORD_0 (x) & SCM_OPN))
 #define SCM_OPINSTRPORTP(x)  (SCM_OPSTRPORTP (x) && \
diff --git a/libguile/symbols.h b/libguile/symbols.h
index 6106f9ef1..94d300306 100644
--- a/libguile/symbols.h
+++ b/libguile/symbols.h
@@ -3,7 +3,7 @@
 #ifndef SCM_SYMBOLS_H
 #define SCM_SYMBOLS_H
 
-/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003, 2004, 2006, 2008, 2010 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003, 2004, 2006, 2008, 2010, 2011 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -26,8 +26,7 @@
 #include "libguile/__scm.h"
 
 
-#define scm_is_symbol(x)            (!SCM_IMP (x) \
-                                     && (SCM_TYP7 (x) == scm_tc7_symbol))
+#define scm_is_symbol(x)            (SCM_HAS_TYP7 (x, scm_tc7_symbol))
 #define scm_i_symbol_hash(x)        ((unsigned long) SCM_CELL_WORD_2 (x))
 #define scm_i_symbol_is_interned(x) \
   (!(SCM_CELL_WORD_0 (x) & SCM_I_F_SYMBOL_UNINTERNED))
diff --git a/libguile/tags.h b/libguile/tags.h
index c0ab34c66..f6d2f8d78 100644
--- a/libguile/tags.h
+++ b/libguile/tags.h
@@ -390,6 +390,10 @@ typedef union SCM { struct { scm_t_bits n; } n; } SCM;
 #define SCM_ITAG7(x) 		(127 & SCM_UNPACK (x))
 #define SCM_TYP7(x) 		(0x7f &        SCM_CELL_TYPE (x))
 #define SCM_TYP7S(x) 		((0x7f & ~2) & SCM_CELL_TYPE (x))
+#define SCM_HAS_HEAP_TYPE(x, type, tag)                         \
+  (SCM_NIMP (x) && type (x) == (tag))
+#define SCM_HAS_TYP7(x, tag)    (SCM_HAS_HEAP_TYPE (x, SCM_TYP7, tag))
+#define SCM_HAS_TYP7S(x, tag)   (SCM_HAS_HEAP_TYPE (x, SCM_TYP7S, tag))
 
 #define scm_tc7_symbol		5
 #define scm_tc7_variable        7
@@ -440,7 +444,8 @@ typedef union SCM { struct { scm_t_bits n; } n; } SCM;
 
 /* Definitions for tc16: */
 #define SCM_TYP16(x) 		(0xffff & SCM_CELL_TYPE (x))
-#define SCM_TYP16_PREDICATE(tag, x) (!SCM_IMP (x) && SCM_TYP16 (x) == (tag))
+#define SCM_HAS_TYP16(x, tag)   (SCM_HAS_HEAP_TYPE (x, SCM_TYP16, tag))
+#define SCM_TYP16_PREDICATE(tag, x) (SCM_HAS_TYP16 (x, tag))
 
 
 
diff --git a/libguile/variable.h b/libguile/variable.h
index 20daf853f..c024c8519 100644
--- a/libguile/variable.h
+++ b/libguile/variable.h
@@ -3,7 +3,7 @@
 #ifndef SCM_VARIABLE_H
 #define SCM_VARIABLE_H
 
-/* Copyright (C) 1995,1996,2000,2001, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,2000,2001, 2006, 2008, 2011 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -30,7 +30,7 @@
 
 /* Variables 
  */
-#define SCM_VARIABLEP(X)      (!SCM_IMP (X) && SCM_TYP7(X) == scm_tc7_variable)
+#define SCM_VARIABLEP(X)      (SCM_HAS_TYP7 (X, scm_tc7_variable))
 #define SCM_VARIABLE_REF(V)   SCM_CELL_OBJECT_1 (V)
 #define SCM_VARIABLE_SET(V, X) SCM_SET_CELL_OBJECT_1 (V, X)
 #define SCM_VARIABLE_LOC(V)   (SCM_CELL_OBJECT_LOC ((V), 1))
diff --git a/libguile/vectors.h b/libguile/vectors.h
index fd69a1c4c..4fe72b0a4 100644
--- a/libguile/vectors.h
+++ b/libguile/vectors.h
@@ -63,8 +63,8 @@ SCM_API SCM *scm_vector_writable_elements (SCM vec,
 
 /* Internals */
 
-#define SCM_I_IS_VECTOR(x)     (!SCM_IMP(x) && (SCM_TYP7S(x)==scm_tc7_vector))
-#define SCM_I_IS_NONWEAK_VECTOR(x) (!SCM_IMP(x) && (SCM_TYP7(x)==scm_tc7_vector))
+#define SCM_I_IS_VECTOR(x)     (SCM_HAS_TYP7S (x, scm_tc7_vector))
+#define SCM_I_IS_NONWEAK_VECTOR(x) (SCM_HAS_TYP7 (x, scm_tc7_vector))
 #define SCM_I_VECTOR_ELTS(x)   ((const SCM *) SCM_I_VECTOR_WELTS (x))
 #define SCM_I_VECTOR_WELTS(x)  (SCM_CELL_OBJECT_LOC (x, 1))
 #define SCM_I_VECTOR_LENGTH(x) (((size_t) SCM_CELL_WORD_0 (x)) >> 8)
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index 1b4136f3f..fc4e8bdfe 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -787,7 +787,7 @@ VM_DEFINE_INSTRUCTION (53, call, "call", 1, -1, 1)
           sp[-nargs] = SCM_STRUCT_PROCEDURE (program);
           goto vm_call;
         }
-      else if (SCM_NIMP (program) && SCM_TYP7 (program) == scm_tc7_smob
+      else if (SCM_HAS_TYP7 (program, scm_tc7_smob)
                && SCM_SMOB_APPLICABLE_P (program))
         {
           SYNC_REGISTER ();
@@ -835,7 +835,7 @@ VM_DEFINE_INSTRUCTION (54, tail_call, "tail-call", 1, -1, 1)
           sp[-nargs] = SCM_STRUCT_PROCEDURE (program);
           goto vm_tail_call;
         }
-      else if (SCM_NIMP (program) && SCM_TYP7 (program) == scm_tc7_smob
+      else if (SCM_HAS_TYP7 (program, scm_tc7_smob)
                && SCM_SMOB_APPLICABLE_P (program))
         {
           SYNC_REGISTER ();
@@ -1096,7 +1096,7 @@ VM_DEFINE_INSTRUCTION (62, mv_call, "mv-call", 4, -1, 1)
           sp[-nargs] = SCM_STRUCT_PROCEDURE (program);
           goto vm_mv_call;
         }
-      else if (SCM_NIMP (program) && SCM_TYP7 (program) == scm_tc7_smob
+      else if (SCM_HAS_TYP7 (program, scm_tc7_smob)
                && SCM_SMOB_APPLICABLE_P (program))
         {
           SYNC_REGISTER ();
diff --git a/libguile/vm.h b/libguile/vm.h
index d354a53c0..2479ee4a4 100644
--- a/libguile/vm.h
+++ b/libguile/vm.h
@@ -55,7 +55,7 @@ struct scm_vm {
 
 SCM_API SCM scm_the_vm_fluid;
 
-#define SCM_VM_P(x)		(SCM_NIMP (x) && SCM_TYP7 (x) == scm_tc7_vm)
+#define SCM_VM_P(x)		(SCM_HAS_TYP7 (x, scm_tc7_vm))
 #define SCM_VM_DATA(vm)		((struct scm_vm *) SCM_CELL_WORD_1 (vm))
 #define SCM_VALIDATE_VM(pos,x)	SCM_MAKE_VALIDATE (pos, x, VM_P)
 
@@ -96,7 +96,7 @@ struct scm_vm_cont {
   scm_t_uint32 flags;
 };
 
-#define SCM_VM_CONT_P(OBJ)	(SCM_NIMP (OBJ) && SCM_TYP7 (OBJ) == scm_tc7_vm_cont)
+#define SCM_VM_CONT_P(OBJ)	(SCM_HAS_TYP7 (OBJ, scm_tc7_vm_cont))
 #define SCM_VM_CONT_DATA(CONT)	((struct scm_vm_cont *) SCM_CELL_WORD_1 (CONT))
 #define SCM_VM_CONT_PARTIAL_P(CONT) (SCM_VM_CONT_DATA (CONT)->flags & SCM_F_VM_CONT_PARTIAL)
 #define SCM_VM_CONT_REWINDABLE_P(CONT) (SCM_VM_CONT_DATA (CONT)->flags & SCM_F_VM_CONT_REWINDABLE)
diff --git a/libguile/weak-set.c b/libguile/weak-set.c
index 7f7717e0a..ace240ce0 100644
--- a/libguile/weak-set.c
+++ b/libguile/weak-set.c
@@ -136,7 +136,7 @@ typedef struct {
 } scm_t_weak_set;
 
 
-#define SCM_WEAK_SET_P(x) (!SCM_IMP (x) && SCM_TYP7(x) == scm_tc7_weak_set)
+#define SCM_WEAK_SET_P(x) (SCM_HAS_TYP7 (x, scm_tc7_weak_set))
 #define SCM_VALIDATE_WEAK_SET(pos, arg) \
   SCM_MAKE_VALIDATE_MSG (pos, arg, WEAK_SET_P, "weak-set")
 #define SCM_WEAK_SET(x) ((scm_t_weak_set *) SCM_CELL_WORD_1 (x))
diff --git a/libguile/weak-table.c b/libguile/weak-table.c
index 160eca2cf..9770d63b2 100644
--- a/libguile/weak-table.c
+++ b/libguile/weak-table.c
@@ -191,7 +191,7 @@ typedef struct {
 } scm_t_weak_table;
 
 
-#define SCM_WEAK_TABLE_P(x) (!SCM_IMP (x) && SCM_TYP7(x) == scm_tc7_weak_table)
+#define SCM_WEAK_TABLE_P(x) (SCM_HAS_TYP7 (x, scm_tc7_weak_table))
 #define SCM_VALIDATE_WEAK_TABLE(pos, arg) \
   SCM_MAKE_VALIDATE_MSG (pos, arg, WEAK_TABLE_P, "weak-table")
 #define SCM_WEAK_TABLE(x) ((scm_t_weak_table *) SCM_CELL_WORD_1 (x))
diff --git a/libguile/weak-vector.h b/libguile/weak-vector.h
index 80bb41497..1fd7cb5ec 100644
--- a/libguile/weak-vector.h
+++ b/libguile/weak-vector.h
@@ -28,7 +28,7 @@
 
 /* Weak vectors.  */
 
-#define SCM_I_WVECTP(x) (!SCM_IMP (x) && SCM_TYP7 (x) == scm_tc7_wvect)
+#define SCM_I_WVECTP(x) (SCM_HAS_TYP7 (x, scm_tc7_wvect))
 
 SCM_API SCM scm_make_weak_vector (SCM k, SCM fill);
 SCM_API SCM scm_weak_vector (SCM l);
-- 
2.20.1