[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 <gmp.h>

#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 scm_t_intmax in
 * radix 2.  The buffer passed to scm_iint2str and scm_iuint2str must
 * be of this size, for example.
 */
#define SCM_INTBUFLEN (5 + SCM_CHAR_BIT*sizeof(scm_t_intmax))

\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 (scm_t_intmax num, int rad, char *p);
SCM_API size_t scm_iuint2str (scm_t_uintmax 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_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_complex_p (SCM x);
SCM_API SCM scm_real_p (SCM x);
SCM_API SCM scm_rational_p (SCM z);
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 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_c_truncate (double x);
SCM_API double scm_c_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);

/* 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_long2big (long n);
SCM_API SCM scm_i_ulong2big (unsigned long n);

/* ratio functions */
SCM_API SCM scm_rationalize (SCM x, SCM err);
SCM_API SCM scm_numerator (SCM z);
SCM_API SCM scm_denominator (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);

/* 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

SCM_API void scm_to_mpz (SCM x, mpz_t rop);
SCM_API SCM  scm_from_mpz (mpz_t rop);


/* 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) 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 double */

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

/* conversion functions for complex */

SCM_API int scm_is_complex (SCM val);
SCM_API SCM scm_c_make_rectangular (double re, double im);
SCM_API SCM scm_c_make_polar (double mag, double ang);
SCM_API double scm_c_real_part (SCM z);
SCM_API double scm_c_imag_part (SCM z);
SCM_API double scm_c_magnitude (SCM z);
SCM_API double scm_c_angle (SCM z);

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