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

/* classes: h_files */

#ifndef SCM_NUMBERS_H
#define SCM_NUMBERS_H

/* Copyright (C) 1995,1996,1998,2000,2001,2002,2003,2004 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 as published by the Free Software Foundation; either
 * version 2.1 of the License, or (at your option) any later version.
 *
 * This library is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 * Lesser General Public License for more details.
 *
 * You should have received a copy of the GNU Lesser General Public
 * License along with this library; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
 */

\f

#include "libguile/__scm.h"
#include "libguile/print.h"

#if SCM_HAVE_FLOATINGPOINT_H
# include <floatingpoint.h>
#endif

#if SCM_HAVE_IEEEFP_H
# include <ieeefp.h>
#endif

#if SCM_HAVE_NAN_H
# if defined (SCO)
#   define _IEEE 1
# endif
# include <nan.h>
# if defined (SCO)
#   undef _IEEE
# endif
#endif /* SCM_HAVE_NAN_H */

\f

/* Immediate Numbers, also known as fixnums
 *
 * Inums are exact integer data that fits within an SCM word.  */

/* SCM_T_SIGNED_MAX is                 (- (expt 2 n) 1),
 * SCM_MOST_POSITIVE_FIXNUM should be  (- (expt 2 (- n 2)) 1)
 * which is the same as                (/ (- (expt 2 n) 4) 4)
 */

#define SCM_I_FIXNUM_BIT         (SCM_LONG_BIT - 2)
#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))
#else
# define SCM_SRS(x, y) ((x) < 0 ? ~((~(x)) >> (y)) : ((x) >> (y)))
#endif /* (-1 == (((-1) << 2) + 2) >> 2) */


#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_signed_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)
#define SCM_NEGFIXABLE(n) ((n) >= SCM_MOST_NEGATIVE_FIXNUM)
#define SCM_FIXABLE(n) (SCM_POSFIXABLE (n) && SCM_NEGFIXABLE (n))


/* A name for 0. */
#define SCM_INUM0 (SCM_I_MAKINUM (0))

/* SCM_MAXEXP is the maximum double precision exponent
 * SCM_FLTMAX is less than or scm_equal the largest single precision float
 */

#if SCM_HAVE_STDC_HEADERS
# ifndef GO32
#  include <float.h>
#  ifdef __MINGW32__
#   define copysign _copysign
#   define isnan _isnan
#   define finite _finite
#  endif /* __MINGW32__ */
# endif /* ndef GO32 */
#endif /* def STDC_HEADERS */

#ifdef DBL_MAX_10_EXP
# define SCM_MAXEXP DBL_MAX_10_EXP
#else
# define SCM_MAXEXP 308		/* IEEE doubles */
#endif /* def DBL_MAX_10_EXP */

#ifdef FLT_MAX
# define SCM_FLTMAX FLT_MAX
#else
# define SCM_FLTMAX 1e+23
#endif /* def FLT_MAX */


/* SCM_INTBUFLEN is the maximum number of characters neccessary for the
 * printed or scm_string representation of an exact immediate.
 */
#define SCM_INTBUFLEN (5 + SCM_LONG_BIT)

\f

/* Numbers 
 */


/* Note that scm_tc16_real and scm_tc16_complex are given tc16-codes that only
 * differ in one bit: This way, checking if an object is an inexact number can
 * be done quickly (using the TYP16S macro).  */

/* Number subtype 1 to 3 (note the dependency on the predicates SCM_INEXACTP
 * and SCM_NUMP)  */
#define scm_tc16_big		(scm_tc7_number + 1 * 256L)
#define scm_tc16_real           (scm_tc7_number + 2 * 256L)
#define scm_tc16_complex        (scm_tc7_number + 3 * 256L)
#define scm_tc16_fraction       (scm_tc7_number + 4 * 256L)

#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_REAL_VALUE(x) (((scm_t_double *) SCM2PTR (x))->real)
#define SCM_COMPLEX_MEM(x) ((scm_t_complex *) SCM_CELL_WORD_1 (x))
#define SCM_COMPLEX_REAL(x) (SCM_COMPLEX_MEM (x)->real)
#define SCM_COMPLEX_IMAG(x) (SCM_COMPLEX_MEM (x)->imag)

/* 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_NUMBERP(x) (SCM_I_INUMP(x) || SCM_NUMP(x))
#define SCM_NUMP(x) (!SCM_IMP(x) \
  && (((0xfcff & SCM_CELL_TYPE (x)) == scm_tc7_number) \
      || ((0xfbff & SCM_CELL_TYPE (x)) == scm_tc7_number)))
/* 0xfcff (#b1100) for 0 free, 1 big, 2 real, 3 complex, then 0xfbff (#b1011) for 4 fraction */

#define SCM_FRACTIONP(x) (!SCM_IMP (x) && SCM_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))
#define SCM_FRACTION_SET_NUMERATOR(x, v) (SCM_SET_CELL_OBJECT_1 ((x), (v)))
#define SCM_FRACTION_SET_DENOMINATOR(x, v) (SCM_SET_CELL_OBJECT_2 ((x), (v)))

  /* I think the left half word is free in the type, so I'll use bit 17 */
#define SCM_FRACTION_REDUCED_BIT 0x10000
#define SCM_FRACTION_REDUCED_SET(x) (SCM_SET_CELL_TYPE((x), (SCM_CELL_TYPE (x) | SCM_FRACTION_REDUCED_BIT)))
#define SCM_FRACTION_REDUCED_CLEAR(x) (SCM_SET_CELL_TYPE((x), (SCM_CELL_TYPE (x) & ~SCM_FRACTION_REDUCED_BIT)))
#define SCM_FRACTION_REDUCED(x)     (0x10000 & SCM_CELL_TYPE (x))

\f

typedef struct scm_t_double
{
  SCM type;
  SCM pad;
  double real;
} scm_t_double;

typedef struct scm_t_complex
{
  double real;
  double imag;
} scm_t_complex;

\f

SCM_API SCM scm_exact_p (SCM x);
SCM_API SCM scm_odd_p (SCM n);
SCM_API SCM scm_even_p (SCM n);
SCM_API SCM scm_inf_p (SCM n);
SCM_API SCM scm_nan_p (SCM n);
SCM_API SCM scm_inf (void);
SCM_API SCM scm_nan (void);
SCM_API SCM scm_abs (SCM x);
SCM_API SCM scm_quotient (SCM x, SCM y);
SCM_API SCM scm_remainder (SCM x, SCM y);
SCM_API SCM scm_modulo (SCM x, SCM y);
SCM_API SCM scm_gcd (SCM x, SCM y);
SCM_API SCM scm_lcm (SCM n1, SCM n2);
SCM_API SCM scm_logand (SCM n1, SCM n2);
SCM_API SCM scm_logior (SCM n1, SCM n2);
SCM_API SCM scm_logxor (SCM n1, SCM n2);
SCM_API SCM scm_logtest (SCM n1, SCM n2);
SCM_API SCM scm_logbit_p (SCM n1, SCM n2);
SCM_API SCM scm_lognot (SCM n);
SCM_API SCM scm_modulo_expt (SCM n, SCM k, SCM m);
SCM_API SCM scm_integer_expt (SCM z1, SCM z2);
SCM_API SCM scm_ash (SCM n, SCM cnt);
SCM_API SCM scm_bit_extract (SCM n, SCM start, SCM end);
SCM_API SCM scm_logcount (SCM n);
SCM_API SCM scm_integer_length (SCM n);

SCM_API size_t scm_iint2str (long num, int rad, char *p);
SCM_API SCM scm_number_to_string (SCM x, SCM radix);
SCM_API int scm_print_real (SCM sexp, SCM port, scm_print_state *pstate);
SCM_API int scm_print_complex (SCM sexp, SCM port, scm_print_state *pstate);
SCM_API int scm_bigprint (SCM exp, SCM port, scm_print_state *pstate);
SCM_API SCM scm_i_mem2number (const char *mem, size_t len, unsigned int radix);
SCM_API SCM scm_string_to_number (SCM str, SCM radix);
SCM_API SCM scm_make_real (double x);
SCM_API SCM scm_make_complex (double x, double y);
SCM_API SCM scm_bigequal (SCM x, SCM y);
SCM_API SCM scm_real_equalp (SCM x, SCM y);
SCM_API SCM scm_complex_equalp (SCM x, SCM y);
SCM_API SCM scm_number_p (SCM x);
SCM_API SCM scm_real_p (SCM x);
SCM_API SCM scm_integer_p (SCM x);
SCM_API SCM scm_inexact_p (SCM x);
SCM_API SCM scm_num_eq_p (SCM x, SCM y);
SCM_API SCM scm_less_p (SCM x, SCM y);
SCM_API SCM scm_gr_p (SCM x, SCM y);
SCM_API SCM scm_leq_p (SCM x, SCM y);
SCM_API SCM scm_geq_p (SCM x, SCM y);
SCM_API SCM scm_zero_p (SCM z);
SCM_API SCM scm_positive_p (SCM x);
SCM_API SCM scm_negative_p (SCM x);
SCM_API SCM scm_max (SCM x, SCM y);
SCM_API SCM scm_min (SCM x, SCM y);
SCM_API SCM scm_sum (SCM x, SCM y);
SCM_API SCM scm_difference (SCM x, SCM y);
SCM_API SCM scm_product (SCM x, SCM y);
SCM_API double scm_num2dbl (SCM a, const char * why);
SCM_API SCM scm_divide (SCM x, SCM y);
SCM_API SCM scm_floor (SCM x);
SCM_API SCM scm_ceiling (SCM x);
SCM_API double scm_asinh (double x);
SCM_API double scm_acosh (double x);
SCM_API double scm_atanh (double x);
SCM_API double scm_truncate (double x);
SCM_API double scm_round (double x);
SCM_API SCM scm_truncate_number (SCM x);
SCM_API SCM scm_round_number (SCM x);
SCM_API SCM scm_sys_expt (SCM z1, SCM z2);
SCM_API SCM scm_sys_atan2 (SCM z1, SCM z2);
SCM_API SCM scm_make_rectangular (SCM z1, SCM z2);
SCM_API SCM scm_make_polar (SCM z1, SCM z2);
SCM_API SCM scm_real_part (SCM z);
SCM_API SCM scm_imag_part (SCM z);
SCM_API SCM scm_magnitude (SCM z);
SCM_API SCM scm_angle (SCM z);
SCM_API SCM scm_exact_to_inexact (SCM z);
SCM_API SCM scm_inexact_to_exact (SCM z);
SCM_API SCM scm_trunc (SCM x);

SCM_API SCM scm_float2num (float n);
SCM_API SCM scm_double2num (double n);
SCM_API float scm_num2float (SCM num, unsigned long int pos,
			     const char *s_caller);
SCM_API double scm_num2double (SCM num, unsigned long int pos,
			       const char *s_caller);


/* bignum internal functions */
SCM_API SCM scm_i_mkbig (void);
SCM_API SCM scm_i_normbig (SCM x);
SCM_API int scm_i_bigcmp (SCM a, SCM b);
SCM_API SCM scm_i_dbl2big (double d);
SCM_API SCM scm_i_dbl2num (double d);
SCM_API double scm_i_big2dbl (SCM b);
SCM_API SCM scm_i_short2big (short n);
SCM_API SCM scm_i_ushort2big (unsigned short n);
SCM_API SCM scm_i_int2big (int n);
SCM_API SCM scm_i_uint2big (unsigned int n);
SCM_API SCM scm_i_long2big (long n);
SCM_API SCM scm_i_ulong2big (unsigned long n);
SCM_API SCM scm_i_size2big (size_t n);
SCM_API SCM scm_i_ptrdiff2big (scm_t_ptrdiff n);

#if SCM_SIZEOF_LONG_LONG != 0
SCM_API SCM scm_i_long_long2big (long long n);
SCM_API SCM scm_i_ulong_long2big (unsigned long long n);
#endif


/* ratio functions */
SCM_API SCM scm_make_ratio (SCM num, SCM den);
SCM_API SCM scm_rationalize (SCM x, SCM err);
SCM_API SCM scm_numerator (SCM z);
SCM_API SCM scm_denominator (SCM z);
SCM_API SCM scm_rational_p (SCM z);

/* fraction internal functions */
SCM_API double scm_i_fraction2double (SCM z);
SCM_API SCM scm_i_fraction_equalp (SCM x, SCM y);
SCM_API int scm_i_print_fraction (SCM sexp, SCM port, scm_print_state *pstate);


#ifdef GUILE_DEBUG
SCM_API SCM scm_sys_check_number_conversions (void);
#endif

/* conversion functions for integers */

SCM_API int scm_is_integer (SCM val);
SCM_API int scm_is_signed_integer (SCM val,
				   scm_t_intmax min, scm_t_intmax max);
SCM_API int scm_is_unsigned_integer (SCM val,
				     scm_t_uintmax min, scm_t_uintmax max);

SCM_API SCM scm_from_signed_integer (scm_t_intmax val);
SCM_API SCM scm_from_unsigned_integer (scm_t_uintmax val);

SCM_API scm_t_intmax scm_to_signed_integer (SCM val,
					    scm_t_intmax min,
					    scm_t_intmax max);
SCM_API scm_t_uintmax scm_to_unsigned_integer (SCM val,
					       scm_t_uintmax min,
					       scm_t_uintmax max);

SCM_API scm_t_int8   scm_to_int8     (SCM x);
SCM_API SCM          scm_from_int8   (scm_t_int8 x);

SCM_API scm_t_uint8  scm_to_uint8    (SCM x);
SCM_API SCM          scm_from_uint8  (scm_t_uint8 x);

SCM_API scm_t_int16  scm_to_int16    (SCM x);
SCM_API SCM          scm_from_int16  (scm_t_int16 x);

SCM_API scm_t_uint16 scm_to_uint16   (SCM x);
SCM_API SCM          scm_from_uint16 (scm_t_uint16 x);

SCM_API scm_t_int32  scm_to_int32    (SCM x);
SCM_API SCM          scm_from_int32  (scm_t_int32 x);

SCM_API scm_t_uint32 scm_to_uint32   (SCM x);
SCM_API SCM          scm_from_uint32 (scm_t_uint32 x);

#if SCM_HAVE_T_INT64

SCM_API scm_t_int64  scm_to_int64    (SCM x);
SCM_API SCM          scm_from_int64  (scm_t_int64 x);

SCM_API scm_t_uint64 scm_to_uint64   (SCM x);
SCM_API SCM          scm_from_uint64 (scm_t_uint64 x);

#endif

/* The conversion functions for other types are aliased to the
   appropriate ones from above.  We pick the right one based on the
   size of the type.

   Not each and every possibility is covered by the code below, and
   while it is trivial to complete the tests, it might be better to
   just test for the 'sane' possibilities.  When one of the tests
   below fails, chances are good that some silent assumption somewhere
   else will also fail.
*/

#if SCM_SIZEOF_CHAR == 1
#define scm_to_schar   scm_to_int8
#define scm_from_schar scm_from_int8
#define scm_to_uchar   scm_to_uint8
#define scm_from_uchar scm_from_uint8
#if CHAR_MIN == 0
#define scm_to_char    scm_to_uint8
#define scm_from_char  scm_from_uint8
#else
#define scm_to_char    scm_to_int8
#define scm_from_char  scm_from_int8
#endif
#else
#error sizeof(char) is not 1.
#endif

#if SCM_SIZEOF_SHORT == 1
#define scm_to_short    scm_to_int8
#define scm_from_short  scm_from_int8
#define scm_to_ushort   scm_to_uint8
#define scm_from_ushort scm_from_uint8
#else
#if SCM_SIZEOF_SHORT == 2
#define scm_to_short    scm_to_int16
#define scm_from_short  scm_from_int16
#define scm_to_ushort   scm_to_uint16
#define scm_from_ushort scm_from_uint16
#else
#if SCM_SIZEOF_SHORT == 4
#define scm_to_short    scm_to_int32
#define scm_from_short  scm_from_int32
#define scm_to_ushort   scm_to_uint32
#define scm_from_ushort scm_from_uint32
#else
#error sizeof(short) is not 1, 2, or 4.
#endif
#endif
#endif

#if SCM_SIZEOF_INT == 4
#define scm_to_int    scm_to_int32
#define scm_from_int  scm_from_int32
#define scm_to_uint   scm_to_uint32
#define scm_from_uint scm_from_uint32
#else
#if SCM_SIZEOF_INT == 8
#define scm_to_int    scm_to_int64
#define scm_from_int  scm_from_int64
#define scm_to_uint   scm_to_uint64
#define scm_from_uint scm_from_uint64
#else
#error sizeof(int) is not 4 or 8.
#endif
#endif

#if SCM_SIZEOF_LONG == 4
#define scm_to_long    scm_to_int32
#define scm_from_long  scm_from_int32
#define scm_to_ulong   scm_to_uint32
#define scm_from_ulong scm_from_uint32
#else
#if SCM_SIZEOF_LONG == 8
#define scm_to_long    scm_to_int64
#define scm_from_long  scm_from_int64
#define scm_to_ulong   scm_to_uint64
#define scm_from_ulong scm_from_uint64
#else
#error sizeof(long) is not 4 or 8.
#endif
#endif

#if SCM_SIZEOF_INTMAX == 4
#define scm_to_intmax    scm_to_int32
#define scm_from_intmax  scm_from_int32
#define scm_to_uintmax   scm_to_uint32
#define scm_from_uintmax scm_from_uint32
#else
#if SCM_SIZEOF_INTMAX == 8
#define scm_to_intmax    scm_to_int64
#define scm_from_intmax  scm_from_int64
#define scm_to_uintmax   scm_to_uint64
#define scm_from_uintmax scm_from_uint64
#else
#error sizeof(scm_t_intmax_t) is not 4 or 8.
#endif
#endif

#if SCM_SIZEOF_LONG_LONG == 0
#else
#if SCM_SIZEOF_LONG_LONG == 8
#define scm_to_long_long    scm_to_int64
#define scm_from_long_long  scm_from_int64
#define scm_to_ulong_long   scm_to_uint64
#define scm_from_ulong_long scm_from_uint64
#else
#error sizeof(long long) is not 8.
#endif
#endif

#if SCM_SIZEOF_SIZE_T == 4
#define scm_to_ssize_t    scm_to_int32
#define scm_from_ssize_t  scm_from_int32
#define scm_to_size_t     scm_to_uint32
#define scm_from_size_t   scm_from_uint32
#else
#if SCM_SIZEOF_SIZE_T == 8
#define scm_to_ssize_t    scm_to_int64
#define scm_from_ssize_t  scm_from_int64
#define scm_to_size_t     scm_to_uint64
#define scm_from_size_t   scm_from_uint64
#else
#error sizeof(size_t) is not 4 or 8.
#endif
#endif

/* conversion functions for reals */

SCM_API int scm_is_real (SCM val);
SCM_API double scm_to_double (SCM val);
SCM_API SCM scm_from_double (double val);

SCM_API void scm_init_numbers (void);

#endif  /* SCM_NUMBERS_H */

/*
  Local Variables:
  c-file-style: "gnu"
  End:
*/
Commit	Line	Data
0f2d19dd JB	1	/* classes: h_files */
0f2d19dd JB	2
3c9a524f DH	3	#ifndef SCM_NUMBERS_H
3c9a524f DH	4	#define SCM_NUMBERS_H
dee01b01	5
32c91687	6	/* Copyright (C) 1995,1996,1998,2000,2001,2002,2003,2004 Free Software Foundation, Inc.
dee01b01	7	*
73be1d9e MV	8	* This library is free software; you can redistribute it and/or
	9	* modify it under the terms of the GNU Lesser General Public
	10	* License as published by the Free Software Foundation; either
	11	* version 2.1 of the License, or (at your option) any later version.
dee01b01	12	*
73be1d9e	13	* This library is distributed in the hope that it will be useful,
0f2d19dd	14	* but WITHOUT ANY WARRANTY; without even the implied warranty of
73be1d9e MV	15	* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
73be1d9e MV	16	* Lesser General Public License for more details.
dee01b01	17	*
73be1d9e MV	18	* You should have received a copy of the GNU Lesser General Public
	19	* License along with this library; if not, write to the Free Software
	20	* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
	21	*/
d3a6bc94	22
0f2d19dd JB	23	\f
0f2d19dd JB	24
b4309c3c	25	#include "libguile/__scm.h"
34f74fe1 MD	26	#include "libguile/print.h"
34f74fe1 MD	27
f0ad7455 RB	28	#if SCM_HAVE_FLOATINGPOINT_H
f0ad7455 RB	29	# include <floatingpoint.h>
232898d9 MV	30	#endif
232898d9 MV	31
f0ad7455 RB	32	#if SCM_HAVE_IEEEFP_H
f0ad7455 RB	33	# include <ieeefp.h>
232898d9 MV	34	#endif
232898d9 MV	35
f0ad7455 RB	36	#if SCM_HAVE_NAN_H
	37	# if defined (SCO)
	38	# define _IEEE 1
	39	# endif
	40	# include <nan.h>
	41	# if defined (SCO)
	42	# undef _IEEE
	43	# endif
	44	#endif /* SCM_HAVE_NAN_H */
232898d9	45
0f2d19dd JB	46	\f
0f2d19dd JB	47
14282d0f	48	/* Immediate Numbers, also known as fixnums
0f2d19dd	49	*
14282d0f	50	* Inums are exact integer data that fits within an SCM word. */
0f2d19dd	51
c0060c95 MV	52	/* SCM_T_SIGNED_MAX is (- (expt 2 n) 1),
	53	* SCM_MOST_POSITIVE_FIXNUM should be (- (expt 2 (- n 2)) 1)
	54	* which is the same as (/ (- (expt 2 n) 4) 4)
	55	*/
	56
004c0902	57	#define SCM_I_FIXNUM_BIT (SCM_LONG_BIT - 2)
c0060c95	58	#define SCM_MOST_POSITIVE_FIXNUM ((SCM_T_SIGNED_BITS_MAX-3)/4)
004c0902	59	#define SCM_MOST_NEGATIVE_FIXNUM (-SCM_MOST_POSITIVE_FIXNUM-1)
5c75b29f	60
56100716 DH	61	/* SCM_SRS is signed right shift */
56100716 DH	62	#if (-1 == (((-1) << 2) + 2) >> 2)
14282d0f	63	# define SCM_SRS(x, y) ((x) >> (y))
0f2d19dd	64	#else
14282d0f	65	# define SCM_SRS(x, y) ((x) < 0 ? ~((~(x)) >> (y)) : ((x) >> (y)))
56100716	66	#endif /* (-1 == (((-1) << 2) + 2) >> 2) */
0f2d19dd JB	67
0f2d19dd JB	68
3aa13a05 MV	69	#define SCM_I_INUMP(x) (2 & SCM_UNPACK (x))
3aa13a05 MV	70	#define SCM_I_NINUMP(x) (!SCM_I_INUMP (x))
5a572ca1	71	#define SCM_I_MAKINUM(x) \
5d7d39ff	72	(SCM_PACK ((((scm_t_signed_bits) (x)) << 2) + scm_tc2_int))
3aa13a05	73	#define SCM_I_INUM(x) (SCM_SRS ((scm_t_signed_bits) SCM_UNPACK (x), 2))
0f2d19dd	74
894a712b DH	75	/* SCM_FIXABLE is true if its long argument can be encoded in an SCM_INUM. */
	76	#define SCM_POSFIXABLE(n) ((n) <= SCM_MOST_POSITIVE_FIXNUM)
	77	#define SCM_NEGFIXABLE(n) ((n) >= SCM_MOST_NEGATIVE_FIXNUM)
14282d0f	78	#define SCM_FIXABLE(n) (SCM_POSFIXABLE (n) && SCM_NEGFIXABLE (n))
894a712b DH	79
894a712b DH	80
56100716	81	/* A name for 0. */
5a572ca1	82	#define SCM_INUM0 (SCM_I_MAKINUM (0))
0f2d19dd	83
c0060c95	84	/* SCM_MAXEXP is the maximum double precision exponent
88eb6852 MD	85	* SCM_FLTMAX is less than or scm_equal the largest single precision float
	86	*/
	87
f0ad7455 RB	88	#if SCM_HAVE_STDC_HEADERS
f0ad7455 RB	89	# ifndef GO32
1e498fbd SJ	90	# include <float.h>
	91	# ifdef __MINGW32__
	92	# define copysign _copysign
	93	# define isnan _isnan
	94	# define finite _finite
	95	# endif /* __MINGW32__ */
f0ad7455	96	# endif /* ndef GO32 */
88eb6852	97	#endif /* def STDC_HEADERS */
f0ad7455	98
88eb6852	99	#ifdef DBL_MAX_10_EXP
f0ad7455	100	# define SCM_MAXEXP DBL_MAX_10_EXP
88eb6852	101	#else
f0ad7455	102	# define SCM_MAXEXP 308 /* IEEE doubles */
88eb6852	103	#endif /* def DBL_MAX_10_EXP */
f0ad7455	104
88eb6852	105	#ifdef FLT_MAX
f0ad7455	106	# define SCM_FLTMAX FLT_MAX
88eb6852	107	#else
f0ad7455	108	# define SCM_FLTMAX 1e+23
88eb6852 MD	109	#endif /* def FLT_MAX */
88eb6852 MD	110
0f2d19dd	111
0f2d19dd JB	112	/* SCM_INTBUFLEN is the maximum number of characters neccessary for the
	113	* printed or scm_string representation of an exact immediate.
	114	*/
c014a02e	115	#define SCM_INTBUFLEN (5 + SCM_LONG_BIT)
0f2d19dd JB	116
	117	\f
	118
	119	/* Numbers
	120	*/
	121
534c55a9 DH	122
	123	/* Note that scm_tc16_real and scm_tc16_complex are given tc16-codes that only
	124	* differ in one bit: This way, checking if an object is an inexact number can
	125	* be done quickly (using the TYP16S macro). */
	126
f03314f9 DH	127	/* Number subtype 1 to 3 (note the dependency on the predicates SCM_INEXACTP
f03314f9 DH	128	* and SCM_NUMP) */
534c55a9 DH	129	#define scm_tc16_big (scm_tc7_number + 1 * 256L)
	130	#define scm_tc16_real (scm_tc7_number + 2 * 256L)
	131	#define scm_tc16_complex (scm_tc7_number + 3 * 256L)
f92e85f7	132	#define scm_tc16_fraction (scm_tc7_number + 4 * 256L)
534c55a9	133
f03314f9 DH	134	#define SCM_INEXACTP(x) \
f03314f9 DH	135	(!SCM_IMP (x) && (0xfeff & SCM_CELL_TYPE (x)) == scm_tc16_real)
0d5e3480 DH	136	#define SCM_REALP(x) (!SCM_IMP (x) && SCM_TYP16 (x) == scm_tc16_real)
0d5e3480 DH	137	#define SCM_COMPLEXP(x) (!SCM_IMP (x) && SCM_TYP16 (x) == scm_tc16_complex)
88eb6852	138
92c2555f MV	139	#define SCM_REAL_VALUE(x) (((scm_t_double *) SCM2PTR (x))->real)
92c2555f MV	140	#define SCM_COMPLEX_MEM(x) ((scm_t_complex *) SCM_CELL_WORD_1 (x))
405aaef9 DH	141	#define SCM_COMPLEX_REAL(x) (SCM_COMPLEX_MEM (x)->real)
405aaef9 DH	142	#define SCM_COMPLEX_IMAG(x) (SCM_COMPLEX_MEM (x)->imag)
0f2d19dd	143
d3e7e88d	144	/* Each bignum is just an mpz_t stored in a double cell starting at word 1. */
fba8fdc0	145	#define SCM_I_BIG_MPZ(x) (((mpz_t ) (SCM_CELL_OBJECT_LOC((x),1))))
d3e7e88d	146	#define SCM_BIGP(x) (!SCM_IMP (x) && SCM_TYP16 (x) == scm_tc16_big)
0f2d19dd	147
3aa13a05	148	#define SCM_NUMBERP(x) (SCM_I_INUMP(x) \|\| SCM_NUMP(x))
d3e7e88d	149	#define SCM_NUMP(x) (!SCM_IMP(x) \
f92e85f7 MV	150	&& (((0xfcff & SCM_CELL_TYPE (x)) == scm_tc7_number) \
	151	\|\| ((0xfbff & SCM_CELL_TYPE (x)) == scm_tc7_number)))
	152	/* 0xfcff (#b1100) for 0 free, 1 big, 2 real, 3 complex, then 0xfbff (#b1011) for 4 fraction */
	153
	154	#define SCM_FRACTIONP(x) (!SCM_IMP (x) && SCM_TYP16 (x) == scm_tc16_fraction)
651f07f8 DH	155	#define SCM_FRACTION_NUMERATOR(x) (SCM_CELL_OBJECT_1 (x))
	156	#define SCM_FRACTION_DENOMINATOR(x) (SCM_CELL_OBJECT_2 (x))
	157	#define SCM_FRACTION_SET_NUMERATOR(x, v) (SCM_SET_CELL_OBJECT_1 ((x), (v)))
	158	#define SCM_FRACTION_SET_DENOMINATOR(x, v) (SCM_SET_CELL_OBJECT_2 ((x), (v)))
	159
f92e85f7 MV	160	/* I think the left half word is free in the type, so I'll use bit 17 */
	161	#define SCM_FRACTION_REDUCED_BIT 0x10000
	162	#define SCM_FRACTION_REDUCED_SET(x) (SCM_SET_CELL_TYPE((x), (SCM_CELL_TYPE (x) \| SCM_FRACTION_REDUCED_BIT)))
	163	#define SCM_FRACTION_REDUCED_CLEAR(x) (SCM_SET_CELL_TYPE((x), (SCM_CELL_TYPE (x) & ~SCM_FRACTION_REDUCED_BIT)))
	164	#define SCM_FRACTION_REDUCED(x) (0x10000 & SCM_CELL_TYPE (x))
88eb6852	165
0f2d19dd JB	166	\f
0f2d19dd JB	167
92c2555f	168	typedef struct scm_t_double
0f2d19dd JB	169	{
0f2d19dd JB	170	SCM type;
88eb6852 MD	171	SCM pad;
88eb6852 MD	172	double real;
92c2555f	173	} scm_t_double;
0f2d19dd	174
92c2555f	175	typedef struct scm_t_complex
0f2d19dd	176	{
88eb6852 MD	177	double real;
88eb6852 MD	178	double imag;
92c2555f	179	} scm_t_complex;
0f2d19dd	180
0f2d19dd	181	\f
0f2d19dd	182
33b001fd MV	183	SCM_API SCM scm_exact_p (SCM x);
	184	SCM_API SCM scm_odd_p (SCM n);
	185	SCM_API SCM scm_even_p (SCM n);
232898d9 MV	186	SCM_API SCM scm_inf_p (SCM n);
	187	SCM_API SCM scm_nan_p (SCM n);
	188	SCM_API SCM scm_inf (void);
	189	SCM_API SCM scm_nan (void);
33b001fd MV	190	SCM_API SCM scm_abs (SCM x);
	191	SCM_API SCM scm_quotient (SCM x, SCM y);
	192	SCM_API SCM scm_remainder (SCM x, SCM y);
	193	SCM_API SCM scm_modulo (SCM x, SCM y);
	194	SCM_API SCM scm_gcd (SCM x, SCM y);
	195	SCM_API SCM scm_lcm (SCM n1, SCM n2);
	196	SCM_API SCM scm_logand (SCM n1, SCM n2);
	197	SCM_API SCM scm_logior (SCM n1, SCM n2);
	198	SCM_API SCM scm_logxor (SCM n1, SCM n2);
	199	SCM_API SCM scm_logtest (SCM n1, SCM n2);
	200	SCM_API SCM scm_logbit_p (SCM n1, SCM n2);
	201	SCM_API SCM scm_lognot (SCM n);
d885e204	202	SCM_API SCM scm_modulo_expt (SCM n, SCM k, SCM m);
33b001fd MV	203	SCM_API SCM scm_integer_expt (SCM z1, SCM z2);
	204	SCM_API SCM scm_ash (SCM n, SCM cnt);
	205	SCM_API SCM scm_bit_extract (SCM n, SCM start, SCM end);
	206	SCM_API SCM scm_logcount (SCM n);
	207	SCM_API SCM scm_integer_length (SCM n);
1be6b49c	208
33b001fd MV	209	SCM_API size_t scm_iint2str (long num, int rad, char *p);
	210	SCM_API SCM scm_number_to_string (SCM x, SCM radix);
	211	SCM_API int scm_print_real (SCM sexp, SCM port, scm_print_state *pstate);
	212	SCM_API int scm_print_complex (SCM sexp, SCM port, scm_print_state *pstate);
	213	SCM_API int scm_bigprint (SCM exp, SCM port, scm_print_state *pstate);
	214	SCM_API SCM scm_i_mem2number (const char *mem, size_t len, unsigned int radix);
	215	SCM_API SCM scm_string_to_number (SCM str, SCM radix);
	216	SCM_API SCM scm_make_real (double x);
	217	SCM_API SCM scm_make_complex (double x, double y);
	218	SCM_API SCM scm_bigequal (SCM x, SCM y);
	219	SCM_API SCM scm_real_equalp (SCM x, SCM y);
	220	SCM_API SCM scm_complex_equalp (SCM x, SCM y);
	221	SCM_API SCM scm_number_p (SCM x);
	222	SCM_API SCM scm_real_p (SCM x);
	223	SCM_API SCM scm_integer_p (SCM x);
	224	SCM_API SCM scm_inexact_p (SCM x);
	225	SCM_API SCM scm_num_eq_p (SCM x, SCM y);
	226	SCM_API SCM scm_less_p (SCM x, SCM y);
	227	SCM_API SCM scm_gr_p (SCM x, SCM y);
	228	SCM_API SCM scm_leq_p (SCM x, SCM y);
	229	SCM_API SCM scm_geq_p (SCM x, SCM y);
	230	SCM_API SCM scm_zero_p (SCM z);
	231	SCM_API SCM scm_positive_p (SCM x);
	232	SCM_API SCM scm_negative_p (SCM x);
	233	SCM_API SCM scm_max (SCM x, SCM y);
	234	SCM_API SCM scm_min (SCM x, SCM y);
	235	SCM_API SCM scm_sum (SCM x, SCM y);
	236	SCM_API SCM scm_difference (SCM x, SCM y);
	237	SCM_API SCM scm_product (SCM x, SCM y);
	238	SCM_API double scm_num2dbl (SCM a, const char * why);
	239	SCM_API SCM scm_divide (SCM x, SCM y);
f92e85f7 MV	240	SCM_API SCM scm_floor (SCM x);
f92e85f7 MV	241	SCM_API SCM scm_ceiling (SCM x);
33b001fd MV	242	SCM_API double scm_asinh (double x);
	243	SCM_API double scm_acosh (double x);
	244	SCM_API double scm_atanh (double x);
	245	SCM_API double scm_truncate (double x);
	246	SCM_API double scm_round (double x);
f92e85f7 MV	247	SCM_API SCM scm_truncate_number (SCM x);
f92e85f7 MV	248	SCM_API SCM scm_round_number (SCM x);
33b001fd MV	249	SCM_API SCM scm_sys_expt (SCM z1, SCM z2);
	250	SCM_API SCM scm_sys_atan2 (SCM z1, SCM z2);
	251	SCM_API SCM scm_make_rectangular (SCM z1, SCM z2);
	252	SCM_API SCM scm_make_polar (SCM z1, SCM z2);
	253	SCM_API SCM scm_real_part (SCM z);
	254	SCM_API SCM scm_imag_part (SCM z);
	255	SCM_API SCM scm_magnitude (SCM z);
	256	SCM_API SCM scm_angle (SCM z);
	257	SCM_API SCM scm_exact_to_inexact (SCM z);
	258	SCM_API SCM scm_inexact_to_exact (SCM z);
	259	SCM_API SCM scm_trunc (SCM x);
33b001fd	260
33b001fd MV	261	SCM_API SCM scm_float2num (float n);
	262	SCM_API SCM scm_double2num (double n);
	263	SCM_API float scm_num2float (SCM num, unsigned long int pos,
	264	const char *s_caller);
	265	SCM_API double scm_num2double (SCM num, unsigned long int pos,
	266	const char *s_caller);
581ded70	267
d3e7e88d RB	268
	269	/* bignum internal functions */
	270	SCM_API SCM scm_i_mkbig (void);
	271	SCM_API SCM scm_i_normbig (SCM x);
	272	SCM_API int scm_i_bigcmp (SCM a, SCM b);
	273	SCM_API SCM scm_i_dbl2big (double d);
f92e85f7	274	SCM_API SCM scm_i_dbl2num (double d);
d3e7e88d RB	275	SCM_API double scm_i_big2dbl (SCM b);
	276	SCM_API SCM scm_i_short2big (short n);
	277	SCM_API SCM scm_i_ushort2big (unsigned short n);
	278	SCM_API SCM scm_i_int2big (int n);
	279	SCM_API SCM scm_i_uint2big (unsigned int n);
	280	SCM_API SCM scm_i_long2big (long n);
	281	SCM_API SCM scm_i_ulong2big (unsigned long n);
	282	SCM_API SCM scm_i_size2big (size_t n);
	283	SCM_API SCM scm_i_ptrdiff2big (scm_t_ptrdiff n);
	284
	285	#if SCM_SIZEOF_LONG_LONG != 0
	286	SCM_API SCM scm_i_long_long2big (long long n);
	287	SCM_API SCM scm_i_ulong_long2big (unsigned long long n);
	288	#endif
	289
	290
f92e85f7 MV	291	/* ratio functions */
	292	SCM_API SCM scm_make_ratio (SCM num, SCM den);
	293	SCM_API SCM scm_rationalize (SCM x, SCM err);
	294	SCM_API SCM scm_numerator (SCM z);
	295	SCM_API SCM scm_denominator (SCM z);
	296	SCM_API SCM scm_rational_p (SCM z);
	297
	298	/* fraction internal functions */
	299	SCM_API double scm_i_fraction2double (SCM z);
	300	SCM_API SCM scm_i_fraction_equalp (SCM x, SCM y);
	301	SCM_API int scm_i_print_fraction (SCM sexp, SCM port, scm_print_state *pstate);
	302
d3e7e88d	303
b4e15479 SJ	304	#ifdef GUILE_DEBUG
	305	SCM_API SCM scm_sys_check_number_conversions (void);
	306	#endif
	307
d1b5b400	308	/* conversion functions for integers */
73e4de09 MV	309
	310	SCM_API int scm_is_integer (SCM val);
	311	SCM_API int scm_is_signed_integer (SCM val,
	312	scm_t_intmax min, scm_t_intmax max);
	313	SCM_API int scm_is_unsigned_integer (SCM val,
	314	scm_t_uintmax min, scm_t_uintmax max);
	315
	316	SCM_API SCM scm_from_signed_integer (scm_t_intmax val);
	317	SCM_API SCM scm_from_unsigned_integer (scm_t_uintmax val);
	318
	319	SCM_API scm_t_intmax scm_to_signed_integer (SCM val,
	320	scm_t_intmax min,
	321	scm_t_intmax max);
	322	SCM_API scm_t_uintmax scm_to_unsigned_integer (SCM val,
	323	scm_t_uintmax min,
	324	scm_t_uintmax max);
	325
bfd7932e MV	326	SCM_API scm_t_int8 scm_to_int8 (SCM x);
	327	SCM_API SCM scm_from_int8 (scm_t_int8 x);
	328
	329	SCM_API scm_t_uint8 scm_to_uint8 (SCM x);
	330	SCM_API SCM scm_from_uint8 (scm_t_uint8 x);
	331
	332	SCM_API scm_t_int16 scm_to_int16 (SCM x);
	333	SCM_API SCM scm_from_int16 (scm_t_int16 x);
	334
	335	SCM_API scm_t_uint16 scm_to_uint16 (SCM x);
	336	SCM_API SCM scm_from_uint16 (scm_t_uint16 x);
	337
	338	SCM_API scm_t_int32 scm_to_int32 (SCM x);
	339	SCM_API SCM scm_from_int32 (scm_t_int32 x);
	340
	341	SCM_API scm_t_uint32 scm_to_uint32 (SCM x);
	342	SCM_API SCM scm_from_uint32 (scm_t_uint32 x);
	343
	344	#if SCM_HAVE_T_INT64
	345
	346	SCM_API scm_t_int64 scm_to_int64 (SCM x);
	347	SCM_API SCM scm_from_int64 (scm_t_int64 x);
	348
	349	SCM_API scm_t_uint64 scm_to_uint64 (SCM x);
	350	SCM_API SCM scm_from_uint64 (scm_t_uint64 x);
	351
	352	#endif
	353
d1b5b400 MV	354	/* The conversion functions for other types are aliased to the
	355	appropriate ones from above. We pick the right one based on the
	356	size of the type.
	357
	358	Not each and every possibility is covered by the code below, and
	359	while it is trivial to complete the tests, it might be better to
	360	just test for the 'sane' possibilities. When one of the tests
	361	below fails, chances are good that some silent assumption somewhere
	362	else will also fail.
	363	*/
	364
	365	#if SCM_SIZEOF_CHAR == 1
	366	#define scm_to_schar scm_to_int8
	367	#define scm_from_schar scm_from_int8
	368	#define scm_to_uchar scm_to_uint8
	369	#define scm_from_uchar scm_from_uint8
73e4de09	370	#if CHAR_MIN == 0
d1b5b400 MV	371	#define scm_to_char scm_to_uint8
d1b5b400 MV	372	#define scm_from_char scm_from_uint8
73e4de09	373	#else
d1b5b400 MV	374	#define scm_to_char scm_to_int8
d1b5b400 MV	375	#define scm_from_char scm_from_int8
73e4de09	376	#endif
d1b5b400 MV	377	#else
d1b5b400 MV	378	#error sizeof(char) is not 1.
22008a78 MV	379	#endif
22008a78 MV	380
d1b5b400 MV	381	#if SCM_SIZEOF_SHORT == 1
	382	#define scm_to_short scm_to_int8
	383	#define scm_from_short scm_from_int8
	384	#define scm_to_ushort scm_to_uint8
	385	#define scm_from_ushort scm_from_uint8
	386	#else
	387	#if SCM_SIZEOF_SHORT == 2
	388	#define scm_to_short scm_to_int16
	389	#define scm_from_short scm_from_int16
	390	#define scm_to_ushort scm_to_uint16
	391	#define scm_from_ushort scm_from_uint16
	392	#else
	393	#if SCM_SIZEOF_SHORT == 4
	394	#define scm_to_short scm_to_int32
	395	#define scm_from_short scm_from_int32
	396	#define scm_to_ushort scm_to_uint32
	397	#define scm_from_ushort scm_from_uint32
73e4de09	398	#else
d1b5b400 MV	399	#error sizeof(short) is not 1, 2, or 4.
	400	#endif
	401	#endif
73e4de09 MV	402	#endif
73e4de09 MV	403
d1b5b400 MV	404	#if SCM_SIZEOF_INT == 4
	405	#define scm_to_int scm_to_int32
	406	#define scm_from_int scm_from_int32
	407	#define scm_to_uint scm_to_uint32
	408	#define scm_from_uint scm_from_uint32
	409	#else
	410	#if SCM_SIZEOF_INT == 8
	411	#define scm_to_int scm_to_int64
	412	#define scm_from_int scm_from_int64
	413	#define scm_to_uint scm_to_uint64
	414	#define scm_from_uint scm_from_uint64
	415	#else
	416	#error sizeof(int) is not 4 or 8.
	417	#endif
	418	#endif
73e4de09	419
d1b5b400 MV	420	#if SCM_SIZEOF_LONG == 4
	421	#define scm_to_long scm_to_int32
	422	#define scm_from_long scm_from_int32
	423	#define scm_to_ulong scm_to_uint32
	424	#define scm_from_ulong scm_from_uint32
	425	#else
	426	#if SCM_SIZEOF_LONG == 8
	427	#define scm_to_long scm_to_int64
	428	#define scm_from_long scm_from_int64
	429	#define scm_to_ulong scm_to_uint64
	430	#define scm_from_ulong scm_from_uint64
	431	#else
	432	#error sizeof(long) is not 4 or 8.
	433	#endif
	434	#endif
73e4de09	435
d1b5b400 MV	436	#if SCM_SIZEOF_INTMAX == 4
	437	#define scm_to_intmax scm_to_int32
	438	#define scm_from_intmax scm_from_int32
	439	#define scm_to_uintmax scm_to_uint32
	440	#define scm_from_uintmax scm_from_uint32
	441	#else
	442	#if SCM_SIZEOF_INTMAX == 8
	443	#define scm_to_intmax scm_to_int64
	444	#define scm_from_intmax scm_from_int64
	445	#define scm_to_uintmax scm_to_uint64
	446	#define scm_from_uintmax scm_from_uint64
	447	#else
	448	#error sizeof(scm_t_intmax_t) is not 4 or 8.
	449	#endif
	450	#endif
73e4de09	451
d1b5b400 MV	452	#if SCM_SIZEOF_LONG_LONG == 0
	453	#else
	454	#if SCM_SIZEOF_LONG_LONG == 8
	455	#define scm_to_long_long scm_to_int64
	456	#define scm_from_long_long scm_from_int64
	457	#define scm_to_ulong_long scm_to_uint64
	458	#define scm_from_ulong_long scm_from_uint64
	459	#else
	460	#error sizeof(long long) is not 8.
	461	#endif
	462	#endif
73e4de09	463
d1b5b400 MV	464	#if SCM_SIZEOF_SIZE_T == 4
	465	#define scm_to_ssize_t scm_to_int32
	466	#define scm_from_ssize_t scm_from_int32
	467	#define scm_to_size_t scm_to_uint32
	468	#define scm_from_size_t scm_from_uint32
	469	#else
	470	#if SCM_SIZEOF_SIZE_T == 8
	471	#define scm_to_ssize_t scm_to_int64
	472	#define scm_from_ssize_t scm_from_int64
	473	#define scm_to_size_t scm_to_uint64
	474	#define scm_from_size_t scm_from_uint64
	475	#else
	476	#error sizeof(size_t) is not 4 or 8.
	477	#endif
22008a78 MV	478	#endif
22008a78 MV	479
d1b5b400	480	/* conversion functions for reals */
22008a78	481
73e4de09 MV	482	SCM_API int scm_is_real (SCM val);
	483	SCM_API double scm_to_double (SCM val);
	484	SCM_API SCM scm_from_double (double val);
	485
33b001fd	486	SCM_API void scm_init_numbers (void);
0f2d19dd	487
3c9a524f	488	#endif /* SCM_NUMBERS_H */
89e00824 ML	489
	490	/*
	491	Local Variables:
	492	c-file-style: "gnu"
	493	End:
	494	*/