Non-vector 1D arrays print as #1()

[bpt/guile.git] / libguile / numbers.h

diff --git a/libguile/numbers.h b/libguile/numbers.h
index b4202f2..bba336b 100644 (file)
--- a/libguile/numbers.h
+++ b/libguile/numbers.h
@@ -49,19 +49,43 @@ typedef scm_t_int32 scm_t_wchar;
 #define SCM_MOST_POSITIVE_FIXNUM ((SCM_T_SIGNED_BITS_MAX-3)/4)
 #define SCM_MOST_NEGATIVE_FIXNUM (-SCM_MOST_POSITIVE_FIXNUM-1)
 
-/* SCM_SRS is signed right shift */
-#if (-1 == (((-1) << 2) + 2) >> 2)
-# define SCM_SRS(x, y) ((x) >> (y))
+/* SCM_SRS (X, Y) is signed right shift, defined as floor (X / 2^Y),
+   where Y must be non-negative and less than the width in bits of X.
+   It's common for >> to do this, but the C standards do not specify
+   what happens when X is negative.
+
+   NOTE: X must not perform side effects.  */
+#if (-1 >> 2 == -1) && (-4 >> 2 == -1) && (-5 >> 2 == -2) && (-8 >> 2 == -2)
+# define SCM_SRS(x, y)  ((x) >> (y))
 #else
-# define SCM_SRS(x, y) ((x) < 0 ? ~((~(x)) >> (y)) : ((x) >> (y)))
-#endif /* (-1 == (((-1) << 2) + 2) >> 2) */
+# define SCM_SRS(x, y)                                   \
+  ((x) < 0                                               \
+   ? -1 - (scm_t_signed_bits) (~(scm_t_bits)(x) >> (y))  \
+   : ((x) >> (y)))
+#endif
+
+
+/* The first implementation of SCM_I_INUM below depends on behavior that
+   is specified by GNU C but not by C standards, namely that when
+   casting to a signed integer of width N, the value is reduced modulo
+   2^N to be within range of the type.  The second implementation below
+   should be portable to all conforming C implementations, but may be
+   less efficient if the compiler is not sufficiently clever.
 
+   NOTE: X must not perform side effects.  */
+#ifdef __GNUC__
+# define SCM_I_INUM(x)  (SCM_SRS ((scm_t_signed_bits) SCM_UNPACK (x), 2))
+#else
+# define SCM_I_INUM(x)                                \
+  (SCM_UNPACK (x) > LONG_MAX                          \
+   ? -1 - (scm_t_signed_bits) (~SCM_UNPACK (x) >> 2)  \
+   : (scm_t_signed_bits) (SCM_UNPACK (x) >> 2))
+#endif
 
 #define SCM_I_INUMP(x) (2 & SCM_UNPACK (x))
 #define SCM_I_NINUMP(x) (!SCM_I_INUMP (x))
 #define SCM_I_MAKINUM(x) \
   (SCM_PACK ((((scm_t_bits) (x)) << 2) + scm_tc2_int))
-#define SCM_I_INUM(x)   (SCM_SRS ((scm_t_signed_bits) SCM_UNPACK (x), 2))
 
 /* SCM_FIXABLE is true if its long argument can be encoded in an SCM_INUM. */
 #define SCM_POSFIXABLE(n) ((n) <= SCM_MOST_POSITIVE_FIXNUM)
@@ -126,8 +150,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)
@@ -135,13 +159,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))
 
@@ -517,6 +540,34 @@ SCM_API SCM  scm_from_mpz (mpz_t rop);
 #endif
 #endif
 
+#if SCM_SIZEOF_INTPTR_T == 0
+/* No intptr_t; use size_t functions. */
+#define scm_to_intptr_t   scm_to_ssize_t
+#define scm_from_intptr_t scm_from_ssize_t
+#elif SCM_SIZEOF_INTPTR_T == 4
+#define scm_to_intptr_t   scm_to_int32
+#define scm_from_intptr_t scm_from_int32
+#elif SCM_SIZEOF_INTPTR_T == 8
+#define scm_to_intptr_t   scm_to_int64
+#define scm_from_intptr_t scm_from_int64
+#else
+#error sizeof(intptr_t) is not 4 or 8.
+#endif
+
+#if SCM_SIZEOF_UINTPTR_T == 0
+/* No uintptr_t; use size_t functions. */
+#define scm_to_uintptr_t   scm_to_size_t
+#define scm_from_uintptr_t scm_from_size_t
+#elif SCM_SIZEOF_UINTPTR_T == 4
+#define scm_to_uintptr_t   scm_to_uint32
+#define scm_from_uintptr_t scm_from_uint32
+#elif SCM_SIZEOF_UINTPTR_T == 8
+#define scm_to_uintptr_t   scm_to_uint64
+#define scm_from_uintptr_t scm_from_uint64
+#else
+#error sizeof(uintptr_t) is not 4 or 8.
+#endif
+
 /* conversion functions for double */
 
 SCM_API int scm_is_real (SCM val);