summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2011-10-24 17:34:47 +0200
committerAndy Wingo <wingo@pobox.com>2011-10-24 18:54:01 +0200
commitdc7da0be90d6033d512f9772894179970af678e7 (patch)
tree3731e84376e21ca1eba9c92df4cf0ffe38f392ad
parent62fdadb0a5f10ff34c7e19ac299aa89d950ffc69 (diff)
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.
-rw-r--r--libguile/bytevectors.h2
-rw-r--r--libguile/control.h2
-rw-r--r--libguile/filesys.h4
-rw-r--r--libguile/fluids.h8
-rw-r--r--libguile/foreign.h3
-rw-r--r--libguile/fports.h4
-rw-r--r--libguile/frames.h2
-rw-r--r--libguile/hashtab.h2
-rw-r--r--libguile/inline.h2
-rw-r--r--libguile/numbers.h11
-rw-r--r--libguile/objcodes.h2
-rw-r--r--libguile/ports.h20
-rw-r--r--libguile/programs.h4
-rw-r--r--libguile/smob.h2
-rw-r--r--libguile/srfi-14.h4
-rw-r--r--libguile/strings.c2
-rw-r--r--libguile/strports.h5
-rw-r--r--libguile/symbols.h5
-rw-r--r--libguile/tags.h7
-rw-r--r--libguile/variable.h4
-rw-r--r--libguile/vectors.h4
-rw-r--r--libguile/vm-i-system.c6
-rw-r--r--libguile/vm.h4
-rw-r--r--libguile/weak-set.c2
-rw-r--r--libguile/weak-table.c2
-rw-r--r--libguile/weak-vector.h2
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);