the cube of lisp booleans (#f nil () #t)

* Renumbers the IFLAG constants.

 * Adds several macros related to boolean type tests, null tests, and
   boolean-truth testing (including lisp-style boolean-truth tests).

 * Adds compile-time checks to verify the necessary IFLAG numbering
   properties needed for the checks to work properly.

 * Changes some existing code to use the new optimized macros, without
   changing the semantics of the code at all (except that scm_is_bool
   is changed from a function to a macro).

I added the following macros, whose names explicitly state how %nil
should be handled.  See the comments in the patch for more information
about these.

  scm_is_false_assume_not_lisp_nil  scm_is_true_assume_not_lisp_nil
  scm_is_false_and_not_lisp_nil     scm_is_true_or_lisp_nil
  scm_is_false_or_lisp_nil          scm_is_true_and_not_lisp_nil

  scm_is_lisp_false                 scm_is_lisp_true

  scm_is_null_assume_not_lisp_nil
  scm_is_null_and_not_lisp_nil
  scm_is_null_or_lisp_nil

  scm_is_bool_and_not_lisp_nil
  scm_is_bool_or_lisp_nil

The following already-existing macros are defined as aliases, such
that their semantics is unchanged (although scm_is_bool used to be a
function and is now a macro).

  scm_is_null   -->  scm_is_null_and_not_lisp_nil
  scm_is_false  -->  scm_is_false_and_not_lisp_nil
  scm_is_true   -->  scm_is_true_or_lisp_nil
  scm_is_bool   -->  scm_is_bool_and_not_lisp_nil

(I still believe that these should be changed to versions that handle
 %nil properly, but await approval on that point, so these patches do
 not make those changes)

Also, if the preprocessor macro SCM_ENABLE_ELISP is not true (this
macro already existed and was used in lang.h), all overheads
associated with %nil handling are eliminated from the above macros.

* libguile/tags.h (SCM_BOOL_F, SCM_BOOL_T, SCM_UNSPECIFIED)
  (SCM_UNDEFINED, SCM_UNBOUND, SCM_ELISP_NIL): Renumber, so that a
  number of important distinctions (false versus true, end-of-list, etc)
  can be made by masking a single bit. Also define a number of
  build-time tests to assert that this condition holds.

* libguile/boolean.h (scm_is_false_and_not_nil, scm_is_true_or_nil)
  (scm_is_false_assume_not_nil, scm_is_true_assume_not_nil):
  (scm_is_false_or_nil, scm_is_true_and_not_nil)
  (scm_is_bool_or_nil, scm_is_bool_and_not_nil): New exciting macros to
  test certain boolean/end-of-list properties.
  (scm_is_false, scm_is_true): Use a restrictive definition, where only
  SCM_BOOL_F is false. Should probably change in the future.
  (scm_is_bool): Incompatible change: changed to be a macro. Was a
  function before. Probably should allow nil as a boolean, but that will
  be for a later patch.
  (scm_is_lisp_false, scm_is_lisp_true): New macros, implementing the
  standard Lisp boolean predicates, where '() is actually false.

* libguile/eval.i.c (CEVAL): Fix a number of false-or-nil and similar
  tests to use the new macros.

* libguile/lang.h (SCM_NULL_OR_NIL_P): Use scm_is_null_or_nil.

* libguile/pairs.c: Add a compile-time check that null and nil differ by
  only one bit.

* libguile/pairs.h (scm_is_null_and_not_nil, scm_is_null_assume_not_nil)
  (scm_is_null_or_nil): New exciting macros!
  (scm_is_null): Just be scm_is_null_and_not_nil, for now.

* libguile/print.c: Adapt to the reordering, and print suitably nasty
  things for the not-to-be-used values.

libguile/boolean.c

@@ -1,4 +1,4 @@
-/*	Copyright (C) 1995, 1996, 2000, 2001, 2006, 2008 Free Software Foundation, Inc.
+/*	Copyright (C) 1995, 1996, 2000, 2001, 2006, 2008, 2009 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
@@ -29,15 +29,37 @@
 #include "libguile/lang.h"
 #include "libguile/tags.h"
 
+#include "verify.h"
+
 
 
+/*
+ * These compile-time tests verify the properties needed for the
+ * efficient test macros defined in boolean.h, which are defined in
+ * terms of the SCM_MATCHES_BITS_IN_COMMON macro.
+ *
+ * See the comments preceeding the definitions of SCM_BOOL_F and
+ * SCM_MATCHES_BITS_IN_COMMON in tags.h for more information.
+ */
+verify (SCM_VALUES_DIFFER_IN_EXACTLY_ONE_BIT_POSITION		\
+		(SCM_BOOL_F, SCM_BOOL_T));
+verify (SCM_VALUES_DIFFER_IN_EXACTLY_ONE_BIT_POSITION		\
+		(SCM_ELISP_NIL, SCM_BOOL_F));
+verify (SCM_VALUES_DIFFER_IN_EXACTLY_ONE_BIT_POSITION		\
+		(SCM_ELISP_NIL, SCM_EOL));
+verify (SCM_VALUES_DIFFER_IN_EXACTLY_TWO_BIT_POSITIONS		\
+		(SCM_ELISP_NIL, SCM_BOOL_F, SCM_BOOL_T,		\
+		 SCM_XXX_ANOTHER_BOOLEAN_DONT_USE));
+verify (SCM_VALUES_DIFFER_IN_EXACTLY_TWO_BIT_POSITIONS		\
+		(SCM_ELISP_NIL, SCM_BOOL_F, SCM_EOL,		\
+		 SCM_XXX_ANOTHER_LISP_FALSE_DONT_USE));
 
 SCM_DEFINE (scm_not, "not", 1, 0, 0, 
             (SCM x),
             "Return @code{#t} iff @var{x} is @code{#f}, else return @code{#f}.")
 #define FUNC_NAME s_scm_not
 {
-  return scm_from_bool (scm_is_false (x) || SCM_NILP (x));
+  return scm_from_bool (scm_is_false_or_nil (x));
 }
 #undef FUNC_NAME
 
@@ -47,19 +69,14 @@ SCM_DEFINE (scm_boolean_p, "boolean?", 1, 0, 0,
             "Return @code{#t} iff @var{obj} is either @code{#t} or @code{#f}.")
 #define FUNC_NAME s_scm_boolean_p
 {
-  return scm_from_bool (scm_is_bool (obj) || SCM_NILP (obj));
+  return scm_from_bool (scm_is_bool_or_nil (obj));
 }
 #undef FUNC_NAME
 
-int
-scm_is_bool (SCM x)
-{
-  return scm_is_eq (x, SCM_BOOL_F) || scm_is_eq (x, SCM_BOOL_T);
-}
-
 int
 scm_to_bool (SCM x)
 {
+  /* XXX Should this first test use scm_is_false_or_nil instead? */
   if (scm_is_eq (x, SCM_BOOL_F))
     return 0;
   else if (scm_is_eq (x, SCM_BOOL_T))

libguile/boolean.h

@@ -3,7 +3,7 @@
 #ifndef SCM_BOOLEAN_H
 #define SCM_BOOLEAN_H
 
-/* Copyright (C) 1995,1996,2000, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,2000, 2006, 2008, 2009 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,16 +31,97 @@
  *
  */ 
 
+/*
+ * Use these macros if it's important (for correctness)
+ * that %nil MUST be considered true
+ */
+#define scm_is_false_and_not_nil(x)     (scm_is_eq ((x), SCM_BOOL_F))
+#define scm_is_true_or_nil(x)          (!scm_is_eq ((x), SCM_BOOL_F))
 
-#define scm_is_false(x) scm_is_eq ((x), SCM_BOOL_F)
+/*
-#define scm_is_true(x)  !scm_is_false (x)
+ * Use these macros if %nil will never be tested,
+ * for increased efficiency.
+ */
+#define scm_is_false_assume_not_nil(x)  (scm_is_eq ((x), SCM_BOOL_F))
+#define scm_is_true_assume_not_nil(x)  (!scm_is_eq ((x), SCM_BOOL_F))
+
+/*
+ * See the comments preceeding the definitions of SCM_BOOL_F and
+ * SCM_MATCHES_BITS_IN_COMMON in tags.h for more information on
+ * how the following macro works.
+ */
+#if SCM_ENABLE_ELISP
+# define scm_is_false_or_nil(x)    \
+  (SCM_MATCHES_BITS_IN_COMMON ((x), SCM_ELISP_NIL, SCM_BOOL_F))
+#else
+# define scm_is_false_or_nil(x)    (scm_is_false_assume_not_nil (x))
+#endif
+#define scm_is_true_and_not_nil(x) (!scm_is_false_or_nil (x))
+
+/* XXX Should these macros treat %nil as false by default? */
+#define scm_is_false(x)  (scm_is_false_and_not_nil (x))
+#define scm_is_true(x)   (!scm_is_false (x))
+
+/*
+ * Since we know SCM_BOOL_F and SCM_BOOL_T differ by exactly one bit,
+ * and that SCM_BOOL_F and SCM_ELISP_NIL differ by exactly one bit,
+ * and that they of course can't be the same bit (or else SCM_BOOL_T
+ * and SCM_ELISP_NIL be would equal), it follows that SCM_BOOL_T and
+ * SCM_ELISP_NIL differ by exactly two bits, and these are the bits
+ * which will be ignored by SCM_MATCHES_BITS_IN_COMMON below.
+ *
+ * See the comments preceeding the definitions of SCM_BOOL_F and
+ * SCM_MATCHES_BITS_IN_COMMON in tags.h for more information.
+ *
+ * If SCM_ENABLE_ELISP is true, then scm_is_bool_or_nil(x)
+ * returns 1 if and only if x is one of the following: SCM_BOOL_F,
+ * SCM_BOOL_T, SCM_ELISP_NIL, or SCM_XXX_ANOTHER_BOOLEAN_DONT_USE.
+ * Otherwise, it returns 0.
+ */
+#if SCM_ENABLE_ELISP
+# define scm_is_bool_or_nil(x)  \
+  (SCM_MATCHES_BITS_IN_COMMON ((x), SCM_BOOL_T, SCM_ELISP_NIL))
+#else
+# define scm_is_bool_or_nil(x)  (scm_is_bool_and_not_nil (x))
+#endif
+
+#define scm_is_bool_and_not_nil(x)  \
+  (SCM_MATCHES_BITS_IN_COMMON ((x), SCM_BOOL_F, SCM_BOOL_T))
+
+/* XXX Should scm_is_bool treat %nil as a boolean? */
+#define scm_is_bool(x)   (scm_is_bool_and_not_nil (x))
 
-SCM_API int scm_is_bool (SCM x);
 #define scm_from_bool(x) ((x) ? SCM_BOOL_T : SCM_BOOL_F)
 SCM_API int scm_to_bool (SCM x);
 
 
 
+/*
+ * The following macros efficiently implement boolean truth testing as
+ * expected by most lisps, which treat '() aka SCM_EOL as false.
+ *
+ * Since we know SCM_ELISP_NIL and SCM_BOOL_F differ by exactly one
+ * bit, and that SCM_ELISP_NIL and SCM_EOL differ by exactly one bit,
+ * and that they of course can't be the same bit (or else SCM_BOOL_F
+ * and SCM_EOL be would equal), it follows that SCM_BOOL_F and SCM_EOL
+ * differ by exactly two bits, and these are the bits which will be
+ * ignored by SCM_MATCHES_BITS_IN_COMMON below.
+ *
+ * See the comments preceeding the definitions of SCM_BOOL_F and
+ * SCM_MATCHES_BITS_IN_COMMON in tags.h for more information.
+ *
+ * scm_is_lisp_false(x) returns 1 if and only if x is one of the
+ * following: SCM_BOOL_F, SCM_ELISP_NIL, SCM_EOL or
+ * SCM_XXX_ANOTHER_LISP_FALSE_DONT_USE.  Otherwise, it returns 0.
+ */
+#if SCM_ENABLE_ELISP
+# define scm_is_lisp_false(x)  \
+  (SCM_MATCHES_BITS_IN_COMMON ((x), SCM_BOOL_F, SCM_EOL))
+# define scm_is_lisp_true(x)   (!scm_is_lisp_false(x))
+#endif
+
+
+
 SCM_API SCM scm_not (SCM x);
 SCM_API SCM scm_boolean_p (SCM obj);
 

libguile/eval.i.c

@@ -304,7 +304,7 @@ dispatch:
           while (!scm_is_null (SCM_CDR (x)))
             {
               SCM test_result = EVALCAR (x, env);
-              if (scm_is_false (test_result) || SCM_NILP (test_result))
+              if (scm_is_false_or_nil (test_result))
                 RETURN (SCM_BOOL_F);
               else
                 x = SCM_CDR (x);
@@ -442,8 +442,7 @@ dispatch:
 		      xx = SCM_CDR (clause);
 		      proc = EVALCAR (xx, env);
 		      guard_result = SCM_APPLY (proc, arg1, SCM_EOL);
-		      if (scm_is_true (guard_result)
+		      if (scm_is_true_and_not_nil (guard_result))
-			  && !SCM_NILP (guard_result))
 			{
 			  proc = SCM_CDDR (xx);
 			  proc = EVALCAR (proc, env);
@@ -451,7 +450,7 @@ dispatch:
 			  goto apply_proc;
 			}
 		    }
-                  else if (scm_is_true (arg1) && !SCM_NILP (arg1))
+                  else if (scm_is_true_and_not_nil (arg1))
                     {
                       x = SCM_CDR (clause);
                       if (scm_is_null (x))
@@ -498,7 +497,7 @@ dispatch:
 
             SCM test_result = EVALCAR (test_form, env);
 
-            while (scm_is_false (test_result) || SCM_NILP (test_result))
+            while (scm_is_false_or_nil (test_result))
               {
                 {
                   /* Evaluate body forms.  */
@@ -552,7 +551,7 @@ dispatch:
           {
             SCM test_result = EVALCAR (x, env);
             x = SCM_CDR (x);  /* then expression */
-            if (scm_is_false (test_result) || SCM_NILP (test_result))
+            if (scm_is_false_or_nil (test_result))
               {
                 x = SCM_CDR (x);  /* else expression */
                 if (scm_is_null (x))
@@ -623,7 +622,7 @@ dispatch:
           while (!scm_is_null (SCM_CDR (x)))
             {
               SCM val = EVALCAR (x, env);
-              if (scm_is_true (val) && !SCM_NILP (val))
+              if (scm_is_true_and_not_nil (val))
                 RETURN (val);
               else
                 x = SCM_CDR (x);

libguile/lang.h

@@ -3,7 +3,7 @@
 #ifndef SCM_LANG_H
 #define SCM_LANG_H
 
-/* Copyright (C) 1998, 2004, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1998, 2004, 2006, 2008, 2009 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_INTERNAL void scm_init_lang (void);
 
 #endif /* ! SCM_ENABLE_ELISP */
 
-#define SCM_NULL_OR_NIL_P(x) (scm_is_null (x) || SCM_NILP (x))
+#define SCM_NULL_OR_NIL_P(x) (scm_is_null_or_nil (x))
 
 #endif  /* SCM_LANG_H */
 

libguile/pairs.c

@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,2000,2001, 2004, 2005, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,2000,2001, 2004, 2005, 2006, 2008, 2009 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
@@ -27,11 +27,25 @@
 
 #include "libguile/pairs.h"
 
+#include "verify.h"
+
 
 
 /* {Pairs}
  */
 
+/*
+ * This compile-time test verifies the properties needed for the
+ * efficient test macro scm_is_null_or_nil defined in pairs.h,
+ * which is defined in terms of the SCM_MATCHES_BITS_IN_COMMON macro.
+ *
+ * See the comments preceeding the definitions of SCM_BOOL_F and
+ * SCM_MATCHES_BITS_IN_COMMON in tags.h for more information.
+ */
+verify (SCM_VALUES_DIFFER_IN_EXACTLY_ONE_BIT_POSITION		\
+		 (SCM_ELISP_NIL, SCM_EOL));
+
+
 #if (SCM_DEBUG_PAIR_ACCESSES == 1)
 
 #include "libguile/ports.h"

libguile/pairs.h

@@ -3,7 +3,7 @@
 #ifndef SCM_PAIRS_H
 #define SCM_PAIRS_H
 
-/* Copyright (C) 1995,1996,2000,2001, 2004, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,2000,2001, 2004, 2006, 2008, 2009 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
@@ -34,7 +34,32 @@
 # define SCM_VALIDATE_PAIR(cell, expr) (expr)
 #endif
 
-#define scm_is_null(x)          (scm_is_eq ((x), SCM_EOL))
+/*
+ * Use scm_is_null_and_not_nil if it's important (for correctness)
+ * that %nil must NOT be considered null.
+ */
+#define scm_is_null_and_not_nil(x)     (scm_is_eq ((x), SCM_EOL))
+
+/*
+ * Use scm_is_null_assume_not_nil if %nil will never be tested,
+ * for increased efficiency.
+ */
+#define scm_is_null_assume_not_nil(x)  (scm_is_eq ((x), SCM_EOL))
+
+/*
+ * See the comments preceeding the definitions of SCM_BOOL_F and
+ * SCM_MATCHES_BITS_IN_COMMON in tags.h for more information on
+ * how the following macro works.
+ */
+#if SCM_ENABLE_ELISP
+# define scm_is_null_or_nil(x)  \
+  (SCM_MATCHES_BITS_IN_COMMON ((x), SCM_ELISP_NIL, SCM_EOL))
+#else
+# define scm_is_null_or_nil(x)  (scm_is_null_assume_not_nil (x))
+#endif
+
+/* XXX Should scm_is_null treat %nil as null by default? */
+#define scm_is_null(x)		(scm_is_null_and_not_nil(x))
 
 #define SCM_CAR(x)		(SCM_VALIDATE_PAIR (x, SCM_CELL_OBJECT_0 (x)))
 #define SCM_CDR(x)		(SCM_VALIDATE_PAIR (x, SCM_CELL_OBJECT_1 (x)))

libguile/print.c

@@ -63,18 +63,17 @@
 static const char *iflagnames[] =
 {
   "#f",
+  "#nil",  /* Elisp nil value. Should print from elisp as symbol `nil'. */
+  "#<XXX UNUSED LISP FALSE -- DO NOT USE -- SHOULD NEVER BE SEEN XXX>",
+  "()",
   "#t",
+  "#<XXX UNUSED BOOLEAN -- DO NOT USE -- SHOULD NEVER BE SEEN XXX>",
+  "#<unspecified>",
   "#<undefined>",
   "#<eof>",
-  "()",
-  "#<unspecified>",
 
   /* Unbound slot marker for GOOPS.  For internal use in GOOPS only.  */
   "#<unbound>",
-
-  /* Elisp nil value.  This is its Scheme name; whenever it's printed in
-   * Elisp, it should appear as the symbol `nil'.  */
-  "#nil"
 };
 
 SCM_SYMBOL (sym_reader, "reader");

libguile/tags.h

@@ -506,12 +506,54 @@ enum scm_tc8_tags
 #define SCM_MAKIFLAG(n)  SCM_MAKE_ITAG8 ((n), scm_tc8_flag)
 #define SCM_IFLAGNUM(n)  (SCM_ITAG8_DATA (n))
 
+/*
+ * IMPORTANT NOTE regarding IFLAG numbering!!!
+ *
+ * Several macros depend upon careful IFLAG numbering of SCM_BOOL_F,
+ * SCM_BOOL_T, SCM_ELISP_NIL, SCM_EOL, and the two SCM_XXX_*_DONT_USE
+ * constants.  In particular:
+ *
+ * - SCM_BOOL_F and SCM_BOOL_T must differ in exactly one bit position.
+ *   (used to implement scm_is_bool_and_not_nil, aka scm_is_bool)
+ *
+ * - SCM_ELISP_NIL and SCM_BOOL_F must differ in exactly one bit position.
+ *   (used to implement scm_is_false_or_nil and
+ *    scm_is_true_and_not_nil)
+ *
+ * - SCM_ELISP_NIL and SCM_EOL must differ in exactly one bit position.
+ *   (used to implement scm_is_null_or_nil)
+ *
+ * - SCM_ELISP_NIL, SCM_BOOL_F, SCM_EOL, SCM_XXX_ANOTHER_LISP_FALSE_DONT_USE
+ *   must all be equal except for two bit positions.
+ *   (used to implement scm_is_lisp_false)
+ *
+ * - SCM_ELISP_NIL, SCM_BOOL_F, SCM_BOOL_T, SCM_XXX_ANOTHER_BOOLEAN_DONT_USE
+ *   must all be equal except for two bit positions.
+ *   (used to implement scm_is_bool_or_nil)
+ *
+ * These properties allow the aforementioned macros to be implemented
+ * by bitwise ANDing with a mask and then comparing with a constant,
+ * using as a common basis the macro SCM_MATCHES_BITS_IN_COMMON,
+ * defined below.  The properties are checked at compile-time using
+ * `verify' macros near the top of boolean.c and pairs.c.
+ */
 #define SCM_BOOL_F		SCM_MAKIFLAG (0)
-#define SCM_BOOL_T 		SCM_MAKIFLAG (1)
+#define SCM_ELISP_NIL		SCM_MAKIFLAG (1)
-#define SCM_UNDEFINED	 	SCM_MAKIFLAG (2)
+
-#define SCM_EOF_VAL 		SCM_MAKIFLAG (3)
+#ifdef BUILDING_LIBGUILE
-#define SCM_EOL			SCM_MAKIFLAG (4)
+#define SCM_XXX_ANOTHER_LISP_FALSE_DONT_USE	SCM_MAKIFLAG (2)
-#define SCM_UNSPECIFIED		SCM_MAKIFLAG (5)
+#endif
+
+#define SCM_EOL			SCM_MAKIFLAG (3)
+#define SCM_BOOL_T 		SCM_MAKIFLAG (4)
+
+#ifdef BUILDING_LIBGUILE
+#define SCM_XXX_ANOTHER_BOOLEAN_DONT_USE	SCM_MAKIFLAG (5)
+#endif
+
+#define SCM_UNSPECIFIED		SCM_MAKIFLAG (6)
+#define SCM_UNDEFINED	 	SCM_MAKIFLAG (7)
+#define SCM_EOF_VAL 		SCM_MAKIFLAG (8)
 
 /* When a variable is unbound this is marked by the SCM_UNDEFINED
  * value.  The following is an unbound value which can be handled on
@@ -521,14 +563,52 @@ enum scm_tc8_tags
  * the code which handles this value in C so that SCM_UNDEFINED can be
  * used instead.  It is not ideal to let this kind of unique and
  * strange values loose on the Scheme level.  */
-#define SCM_UNBOUND		SCM_MAKIFLAG (6)
+#define SCM_UNBOUND		SCM_MAKIFLAG (9)
-
-/* The Elisp nil value.  */
-#define SCM_ELISP_NIL		SCM_MAKIFLAG (7)
-
 
 #define SCM_UNBNDP(x)		(scm_is_eq ((x), SCM_UNDEFINED))
 
+/*
+ * SCM_MATCHES_BITS_IN_COMMON(x,a,b) returns 1 if and only if x
+ * matches both a and b in every bit position where a and b are equal;
+ * otherwise it returns 0.  Bit positions where a and b differ are
+ * ignored.
+ *
+ * This is used to efficiently compare against two values which differ
+ * in exactly one bit position, or against four values which differ in
+ * exactly two bit positions.  It is the basis for the following
+ * macros:
+ *
+ *   scm_is_null_or_nil,
+ *   scm_is_false_or_nil,
+ *   scm_is_true_and_not_nil,
+ *   scm_is_lisp_false,
+ *   scm_is_lisp_true,
+ *   scm_is_bool_and_not_nil (aka scm_is_bool)
+ *   scm_is_bool_or_nil.
+ */
+#define SCM_MATCHES_BITS_IN_COMMON(x,a,b)				\
+  ((SCM_UNPACK(x) & ~(SCM_UNPACK(a) ^ SCM_UNPACK(b))) ==		\
+   (SCM_UNPACK(a) & SCM_UNPACK(b)))
+
+/*
+ * These macros are used for compile-time verification that the
+ * constants have the properties needed for the above macro to work
+ * properly.
+ */
+#ifdef BUILDING_LIBGUILE
+#define SCM_WITH_LEAST_SIGNIFICANT_1_BIT_CLEARED(x)  ((x) & ((x)-1))
+#define SCM_HAS_EXACTLY_ONE_BIT_SET(x)					\
+  ((x) != 0 && SCM_WITH_LEAST_SIGNIFICANT_1_BIT_CLEARED (x) == 0)
+#define SCM_HAS_EXACTLY_TWO_BITS_SET(x)					\
+  (SCM_HAS_EXACTLY_ONE_BIT_SET (SCM_WITH_LEAST_SIGNIFICANT_1_BIT_CLEARED (x)))
+
+#define SCM_VALUES_DIFFER_IN_EXACTLY_ONE_BIT_POSITION(a,b)		\
+  (SCM_HAS_EXACTLY_ONE_BIT_SET (SCM_UNPACK(a) ^ SCM_UNPACK(b)))
+#define SCM_VALUES_DIFFER_IN_EXACTLY_TWO_BIT_POSITIONS(a,b,c,d)		\
+  (SCM_HAS_EXACTLY_TWO_BITS_SET ((SCM_UNPACK(a) ^ SCM_UNPACK(b)) |	\
+                                 (SCM_UNPACK(b) ^ SCM_UNPACK(c)) |	\
+                                 (SCM_UNPACK(c) ^ SCM_UNPACK(d))))
+#endif /* BUILDING_LIBGUILE */
 
 
 /* Evaluator byte codes ('immediate symbols').  These constants are used only