X-Git-Url: http://git.hcoop.net/bpt/guile.git/blobdiff_plain/e2bf3b19f666260d2e666a8686fee0ef553b87fb..8cb0d6d7fa9aaac316c29a64c541336b51b6f93d:/libguile/numbers.h?ds=sidebyside diff --git a/libguile/numbers.h b/libguile/numbers.h index 2c2fdcf07..b929b7a4a 100644 --- a/libguile/numbers.h +++ b/libguile/numbers.h @@ -3,21 +3,23 @@ #ifndef SCM_NUMBERS_H #define SCM_NUMBERS_H -/* Copyright (C) 1995,1996,1998,2000,2001,2002,2003,2004,2005, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,2000,2001,2002,2003,2004,2005, 2006, + * 2008, 2009, 2010, 2011, 2013, 2014 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. + * modify it under the terms of the GNU Lesser General Public License + * as published by the Free Software Foundation; either version 3 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 + * 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA + * 02110-1301 USA */ @@ -27,23 +29,10 @@ #include "libguile/__scm.h" #include "libguile/print.h" -#if SCM_HAVE_FLOATINGPOINT_H -# include -#endif - -#if SCM_HAVE_IEEEFP_H -# include -#endif - -#if SCM_HAVE_NAN_H -# if defined (SCO) -# define _IEEE 1 -# endif -# include -# if defined (SCO) -# undef _IEEE -# endif -#endif /* SCM_HAVE_NAN_H */ +#ifndef SCM_T_WCHAR_DEFINED +typedef scm_t_int32 scm_t_wchar; +#define SCM_T_WCHAR_DEFINED +#endif /* SCM_T_WCHAR_DEFINED */ @@ -60,19 +49,43 @@ #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_signed_bits) (x)) << 2) + scm_tc2_int)) -#define SCM_I_INUM(x) (SCM_SRS ((scm_t_signed_bits) SCM_UNPACK (x), 2)) + (SCM_PACK ((((scm_t_bits) (x)) << 2) + scm_tc2_int)) /* SCM_FIXABLE is true if its long argument can be encoded in an SCM_INUM. */ #define SCM_POSFIXABLE(n) ((n) <= SCM_MOST_POSITIVE_FIXNUM) @@ -80,8 +93,9 @@ #define SCM_FIXABLE(n) (SCM_POSFIXABLE (n) && SCM_NEGFIXABLE (n)) -/* A name for 0. */ -#define SCM_INUM0 (SCM_I_MAKINUM (0)) +#define SCM_INUM0 (SCM_I_MAKINUM (0)) /* A name for 0 */ +#define SCM_INUM1 (SCM_I_MAKINUM (1)) /* A name for 1 */ + /* SCM_MAXEXP is the maximum double precision exponent * SCM_FLTMAX is less than or scm_equal the largest single precision float @@ -140,9 +154,8 @@ #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) +#define SCM_COMPLEX_REAL(x) (((scm_t_complex *) SCM2PTR (x))->real) +#define SCM_COMPLEX_IMAG(x) (((scm_t_complex *) SCM2PTR (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)))) @@ -150,9 +163,7 @@ #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 */ + && ((0x00ff & SCM_CELL_TYPE (x)) == scm_tc7_number)) #define SCM_FRACTIONP(x) (!SCM_IMP (x) && SCM_TYP16 (x) == scm_tc16_fraction) #define SCM_FRACTION_NUMERATOR(x) (SCM_CELL_OBJECT_1 (x)) @@ -169,23 +180,46 @@ typedef struct scm_t_double typedef struct scm_t_complex { + SCM type; + SCM pad; double real; double imag; } scm_t_complex; + SCM_API SCM scm_exact_p (SCM x); +SCM_API int scm_is_exact (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_finite_p (SCM x); +SCM_API SCM scm_inf_p (SCM x); +SCM_API SCM scm_nan_p (SCM x); 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 void scm_euclidean_divide (SCM x, SCM y, SCM *q, SCM *r); +SCM_API SCM scm_euclidean_quotient (SCM x, SCM y); +SCM_API SCM scm_euclidean_remainder (SCM x, SCM y); +SCM_API void scm_floor_divide (SCM x, SCM y, SCM *q, SCM *r); +SCM_API SCM scm_floor_quotient (SCM x, SCM y); +SCM_API SCM scm_floor_remainder (SCM x, SCM y); +SCM_API void scm_ceiling_divide (SCM x, SCM y, SCM *q, SCM *r); +SCM_API SCM scm_ceiling_quotient (SCM x, SCM y); +SCM_API SCM scm_ceiling_remainder (SCM x, SCM y); +SCM_API void scm_truncate_divide (SCM x, SCM y, SCM *q, SCM *r); +SCM_API SCM scm_truncate_quotient (SCM x, SCM y); +SCM_API SCM scm_truncate_remainder (SCM x, SCM y); +SCM_API void scm_centered_divide (SCM x, SCM y, SCM *q, SCM *r); +SCM_API SCM scm_centered_quotient (SCM x, SCM y); +SCM_API SCM scm_centered_remainder (SCM x, SCM y); +SCM_API void scm_round_divide (SCM x, SCM y, SCM *q, SCM *r); +SCM_API SCM scm_round_quotient (SCM x, SCM y); +SCM_API SCM scm_round_remainder (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); @@ -196,11 +230,25 @@ 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_ash (SCM n, SCM count); +SCM_API SCM scm_round_ash (SCM n, SCM count); 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_INTERNAL SCM scm_i_euclidean_divide (SCM x, SCM y); +SCM_INTERNAL SCM scm_i_floor_divide (SCM x, SCM y); +SCM_INTERNAL SCM scm_i_ceiling_divide (SCM x, SCM y); +SCM_INTERNAL SCM scm_i_truncate_divide (SCM x, SCM y); +SCM_INTERNAL SCM scm_i_centered_divide (SCM x, SCM y); +SCM_INTERNAL SCM scm_i_round_divide (SCM x, SCM y); + +SCM_INTERNAL SCM scm_i_gcd (SCM x, SCM y, SCM rest); +SCM_INTERNAL SCM scm_i_lcm (SCM x, SCM y, SCM rest); +SCM_INTERNAL SCM scm_i_logand (SCM x, SCM y, SCM rest); +SCM_INTERNAL SCM scm_i_logior (SCM x, SCM y, SCM rest); +SCM_INTERNAL SCM scm_i_logxor (SCM x, SCM y, SCM rest); + 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); @@ -209,6 +257,7 @@ 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_c_locale_stringn_to_number (const char *mem, size_t len, unsigned int radix); +SCM_INTERNAL SCM scm_i_string_to_number (SCM str, 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); @@ -218,7 +267,9 @@ 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_exact_integer_p (SCM x); SCM_API SCM scm_inexact_p (SCM x); +SCM_API int scm_is_inexact (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); @@ -237,15 +288,23 @@ 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_expt (SCM z1, SCM z2); +SCM_API SCM scm_sin (SCM z); +SCM_API SCM scm_cos (SCM z); +SCM_API SCM scm_tan (SCM z); +SCM_API SCM scm_sinh (SCM z); +SCM_API SCM scm_cosh (SCM z); +SCM_API SCM scm_tanh (SCM z); +SCM_API SCM scm_asin (SCM z); +SCM_API SCM scm_acos (SCM z); +SCM_API SCM scm_atan (SCM x, SCM y); +SCM_API SCM scm_sys_asinh (SCM z); +SCM_API SCM scm_sys_acosh (SCM z); +SCM_API SCM scm_sys_atanh (SCM z); 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); @@ -259,17 +318,26 @@ SCM_API SCM scm_log (SCM z); SCM_API SCM scm_log10 (SCM z); SCM_API SCM scm_exp (SCM z); SCM_API SCM scm_sqrt (SCM z); +SCM_API void scm_exact_integer_sqrt (SCM k, SCM *s, SCM *r); + +SCM_INTERNAL SCM scm_i_min (SCM x, SCM y, SCM rest); +SCM_INTERNAL SCM scm_i_max (SCM x, SCM y, SCM rest); +SCM_INTERNAL SCM scm_i_sum (SCM x, SCM y, SCM rest); +SCM_INTERNAL SCM scm_i_difference (SCM x, SCM y, SCM rest); +SCM_INTERNAL SCM scm_i_product (SCM x, SCM y, SCM rest); +SCM_INTERNAL SCM scm_i_divide (SCM x, SCM y, SCM rest); +SCM_INTERNAL SCM scm_i_exact_integer_sqrt (SCM k); /* 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); -SCM_API SCM scm_i_clonebig (SCM src_big, int same_sign_p); +SCM_INTERNAL SCM scm_i_mkbig (void); +SCM_API /* FIXME: not internal */ SCM scm_i_normbig (SCM x); +SCM_INTERNAL int scm_i_bigcmp (SCM a, SCM b); +SCM_INTERNAL SCM scm_i_dbl2big (double d); +SCM_INTERNAL SCM scm_i_dbl2num (double d); +SCM_API /* FIXME: not internal */ double scm_i_big2dbl (SCM b); +SCM_API /* FIXME: not internal */ SCM scm_i_long2big (long n); +SCM_API /* FIXME: not internal */ SCM scm_i_ulong2big (unsigned long n); +SCM_API /* FIXME: not internal */ SCM scm_i_clonebig (SCM src_big, int same_sign_p); /* ratio functions */ SCM_API SCM scm_rationalize (SCM x, SCM err); @@ -277,17 +345,18 @@ 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); +SCM_INTERNAL double scm_i_fraction2double (SCM z); +SCM_INTERNAL SCM scm_i_fraction_equalp (SCM x, SCM y); +SCM_INTERNAL int scm_i_print_fraction (SCM sexp, SCM port, scm_print_state *pstate); /* general internal functions */ -SCM_API void scm_i_print_double (double val, SCM port); -SCM_API void scm_i_print_complex (double real, double imag, SCM port); +SCM_INTERNAL void scm_i_print_double (double val, SCM port); +SCM_INTERNAL void scm_i_print_complex (double real, double imag, SCM port); /* conversion functions for integers */ SCM_API int scm_is_integer (SCM val); +SCM_API int scm_is_exact_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, @@ -321,7 +390,8 @@ 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_wchar scm_to_wchar (SCM x); +SCM_API SCM scm_from_wchar (scm_t_wchar x); SCM_API scm_t_int64 scm_to_int64 (SCM x); SCM_API SCM scm_from_int64 (scm_t_int64 x); @@ -329,8 +399,6 @@ 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); @@ -461,6 +529,18 @@ SCM_API SCM scm_from_mpz (mpz_t rop); #endif #endif +#if SCM_SIZEOF_SCM_T_PTRDIFF == 4 +#define scm_to_ptrdiff_t scm_to_int32 +#define scm_from_ptrdiff_t scm_from_int32 +#else +#if SCM_SIZEOF_SCM_T_PTRDIFF == 8 +#define scm_to_ptrdiff_t scm_to_int64 +#define scm_from_ptrdiff_t scm_from_int64 +#else +#error sizeof(scm_t_ptrdiff) is not 4 or 8. +#endif +#endif + /* conversion functions for double */ SCM_API int scm_is_real (SCM val); @@ -480,7 +560,10 @@ SCM_API double scm_c_angle (SCM z); SCM_API int scm_is_number (SCM val); -SCM_API void scm_init_numbers (void); +/* If nonzero, tell gmp to use GC_malloc for its allocations. */ +SCM_API int scm_install_gmp_memory_functions; + +SCM_INTERNAL void scm_init_numbers (void); #endif /* SCM_NUMBERS_H */