diff options
Diffstat (limited to 'libguile/numbers.c')
-rw-r--r-- | libguile/numbers.c | 239 |
1 files changed, 115 insertions, 124 deletions
diff --git a/libguile/numbers.c b/libguile/numbers.c index 13223f8cb..d1b463358 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -1,24 +1,24 @@ -/* Copyright (C) 1995-2016, 2018, 2019 Free Software Foundation, Inc. - * - * Portions Copyright 1990, 1991, 1992, 1993 by AT&T Bell Laboratories - * and Bellcore. See scm_divide. - * - * - * 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 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 - * 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 - */ +/* Copyright 1995-2016,2018-2019 + Free Software Foundation, Inc. + + Portions Copyright 1990-1993 by AT&T Bell Laboratories and Bellcore. + See scm_divide. + + This file is part of Guile. + + Guile 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 3 of the License, or + (at your option) any later version. + + Guile 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 Guile. If not, see + <https://www.gnu.org/licenses/>. */ /* General assumptions: @@ -42,35 +42,37 @@ */ #ifdef HAVE_CONFIG_H -# include <config.h> +# include <config.h> #endif -#include <verify.h> #include <assert.h> - #include <math.h> +#include <stdarg.h> #include <string.h> #include <unicase.h> #include <unictype.h> +#include <verify.h> #if HAVE_COMPLEX_H #include <complex.h> #endif -#include <stdarg.h> - -#include "libguile/_scm.h" -#include "libguile/feature.h" -#include "libguile/ports.h" -#include "libguile/smob.h" -#include "libguile/strings.h" -#include "libguile/bdw-gc.h" - -#include "libguile/validate.h" -#include "libguile/numbers.h" -#include "libguile/deprecation.h" - -#include "libguile/eq.h" +#include "bdw-gc.h" +#include "boolean.h" +#include "deprecation.h" +#include "eq.h" +#include "feature.h" +#include "finalizers.h" +#include "goops.h" +#include "gsubr.h" +#include "modules.h" +#include "pairs.h" +#include "ports.h" +#include "smob.h" +#include "strings.h" +#include "values.h" + +#include "numbers.h" /* values per glibc, if not already defined */ #ifndef M_LOG10E @@ -1510,7 +1512,7 @@ SCM_PRIMITIVE_GENERIC (scm_i_floor_divide, "floor/", 2, 0, 0, SCM q, r; scm_floor_divide(x, y, &q, &r); - return scm_values (scm_list_2 (q, r)); + return scm_values_2 (q, r); } #undef FUNC_NAME @@ -2048,7 +2050,7 @@ SCM_PRIMITIVE_GENERIC (scm_i_ceiling_divide, "ceiling/", 2, 0, 0, SCM q, r; scm_ceiling_divide(x, y, &q, &r); - return scm_values (scm_list_2 (q, r)); + return scm_values_2 (q, r); } #undef FUNC_NAME @@ -2539,7 +2541,7 @@ SCM_PRIMITIVE_GENERIC (scm_i_truncate_divide, "truncate/", 2, 0, 0, SCM q, r; scm_truncate_divide(x, y, &q, &r); - return scm_values (scm_list_2 (q, r)); + return scm_values_2 (q, r); } #undef FUNC_NAME @@ -3150,7 +3152,7 @@ SCM_PRIMITIVE_GENERIC (scm_i_centered_divide, "centered/", 2, 0, 0, SCM q, r; scm_centered_divide(x, y, &q, &r); - return scm_values (scm_list_2 (q, r)); + return scm_values_2 (q, r); } #undef FUNC_NAME @@ -3825,7 +3827,7 @@ SCM_PRIMITIVE_GENERIC (scm_i_round_divide, "round/", 2, 0, 0, SCM q, r; scm_round_divide(x, y, &q, &r); - return scm_values (scm_list_2 (q, r)); + return scm_values_2 (q, r); } #undef FUNC_NAME @@ -5165,6 +5167,8 @@ SCM_DEFINE (scm_round_ash, "round-ash", 2, 0, 0, #undef FUNC_NAME +#define MIN(A, B) ((A) <= (B) ? (A) : (B)) + SCM_DEFINE (scm_bit_extract, "bit-extract", 3, 0, 0, (SCM n, SCM start, SCM end), "Return the integer composed of the @var{start} (inclusive)\n" @@ -5193,7 +5197,7 @@ SCM_DEFINE (scm_bit_extract, "bit-extract", 3, 0, 0, /* When istart>=SCM_I_FIXNUM_BIT we can just limit the shift to SCM_I_FIXNUM_BIT-1 to get either 0 or -1 per the sign of "in". */ - in = SCM_SRS (in, min (istart, SCM_I_FIXNUM_BIT-1)); + in = SCM_SRS (in, MIN (istart, SCM_I_FIXNUM_BIT-1)); if (in < 0 && bits >= SCM_I_FIXNUM_BIT) { @@ -5208,7 +5212,7 @@ SCM_DEFINE (scm_bit_extract, "bit-extract", 3, 0, 0, } /* mask down to requisite bits */ - bits = min (bits, SCM_I_FIXNUM_BIT); + bits = MIN (bits, SCM_I_FIXNUM_BIT); return SCM_I_MAKINUM (in & ((1L << bits) - 1)); } else if (SCM_BIGP (n)) @@ -5601,12 +5605,12 @@ iflo2str (SCM flt, char *str, int radix) return i; } -/* convert a scm_t_intmax to a string (unterminated). returns the number of +/* convert a intmax_t to a string (unterminated). returns the number of characters in the result. rad is output base p is destination: worst case (base 2) is SCM_INTBUFLEN */ size_t -scm_iint2str (scm_t_intmax num, int rad, char *p) +scm_iint2str (intmax_t num, int rad, char *p) { if (num < 0) { @@ -5617,16 +5621,16 @@ scm_iint2str (scm_t_intmax num, int rad, char *p) return scm_iuint2str (num, rad, p); } -/* convert a scm_t_intmax to a string (unterminated). returns the number of +/* convert a intmax_t to a string (unterminated). returns the number of characters in the result. rad is output base p is destination: worst case (base 2) is SCM_INTBUFLEN */ size_t -scm_iuint2str (scm_t_uintmax num, int rad, char *p) +scm_iuint2str (uintmax_t num, int rad, char *p) { size_t j = 1; size_t i; - scm_t_uintmax n = num; + uintmax_t n = num; if (rad < 2 || rad > 36) scm_out_of_range ("scm_iuint2str", scm_from_int (rad)); @@ -5815,10 +5819,10 @@ enum t_exactness {NO_EXACTNESS, INEXACT, EXACT}; /* Caller is responsible for checking that the return value is in range for the given radix, which should be <= 36. */ static unsigned int -char_decimal_value (scm_t_uint32 c) +char_decimal_value (uint32_t c) { - if (c >= (scm_t_uint32) '0' && c <= (scm_t_uint32) '9') - return c - (scm_t_uint32) '0'; + if (c >= (uint32_t) '0' && c <= (uint32_t) '9') + return c - (uint32_t) '0'; else { /* uc_decimal_value returns -1 on error. When cast to an unsigned int, @@ -5831,8 +5835,8 @@ char_decimal_value (scm_t_uint32 c) if (d >= 10U) { c = uc_tolower (c); - if (c >= (scm_t_uint32) 'a') - d = c - (scm_t_uint32)'a' + 10U; + if (c >= (uint32_t) 'a') + d = c - (uint32_t)'a' + 10U; } return d; } @@ -5944,7 +5948,7 @@ mem2decimal_from_point (SCM result, SCM mem, while (idx != len) { scm_t_wchar c = scm_i_string_ref (mem, idx); - if (uc_is_property_decimal_digit ((scm_t_uint32) c)) + if (uc_is_property_decimal_digit ((uint32_t) c)) { if (x == INEXACT) return SCM_BOOL_F; @@ -6034,7 +6038,7 @@ mem2decimal_from_point (SCM result, SCM mem, else sign = 1; - if (!uc_is_property_decimal_digit ((scm_t_uint32) c)) + if (!uc_is_property_decimal_digit ((uint32_t) c)) return SCM_BOOL_F; idx++; @@ -6042,7 +6046,7 @@ mem2decimal_from_point (SCM result, SCM mem, while (idx != len) { scm_t_wchar c = scm_i_string_ref (mem, idx); - if (uc_is_property_decimal_digit ((scm_t_uint32) c)) + if (uc_is_property_decimal_digit ((uint32_t) c)) { idx++; if (exponent <= SCM_MAXEXP) @@ -6134,14 +6138,7 @@ mem2ureal (SCM mem, unsigned int *p_idx, idx += 4; if (!scm_is_eq (mem2uinteger (mem, &idx, 10, &implicit_x), SCM_INUM0)) - { -#if SCM_ENABLE_DEPRECATED == 1 - scm_c_issue_deprecation_warning - ("Non-zero suffixes to `+nan.' are deprecated. Use `+nan.0'."); -#else - return SCM_BOOL_F; -#endif - } + return SCM_BOOL_F; *p_idx = idx; return scm_nan (); @@ -6156,7 +6153,7 @@ mem2ureal (SCM mem, unsigned int *p_idx, return SCM_BOOL_F; else if (idx + 1 == len) return SCM_BOOL_F; - else if (!uc_is_property_decimal_digit ((scm_t_uint32) scm_i_string_ref (mem, idx+1))) + else if (!uc_is_property_decimal_digit ((uint32_t) scm_i_string_ref (mem, idx+1))) return SCM_BOOL_F; else result = mem2decimal_from_point (SCM_INUM0, mem, @@ -8069,7 +8066,7 @@ scm_product (SCM x, SCM y) { scm_t_inum yy = SCM_I_INUM (y); #if SCM_I_FIXNUM_BIT < 32 && SCM_HAVE_T_INT64 - scm_t_int64 kk = xx * (scm_t_int64) yy; + int64_t kk = xx * (int64_t) yy; if (SCM_FIXABLE (kk)) return SCM_I_MAKINUM (kk); #else @@ -9660,7 +9657,7 @@ scm_is_exact_integer (SCM val) } int -scm_is_signed_integer (SCM val, scm_t_intmax min, scm_t_intmax max) +scm_is_signed_integer (SCM val, intmax_t min, intmax_t max) { if (SCM_I_INUMP (val)) { @@ -9683,15 +9680,15 @@ scm_is_signed_integer (SCM val, scm_t_intmax min, scm_t_intmax max) } else { - scm_t_uintmax abs_n; - scm_t_intmax n; + uintmax_t abs_n; + intmax_t n; size_t count; if (mpz_sizeinbase (SCM_I_BIG_MPZ (val), 2) - > CHAR_BIT*sizeof (scm_t_uintmax)) + > CHAR_BIT*sizeof (uintmax_t)) return 0; - mpz_export (&abs_n, &count, 1, sizeof (scm_t_uintmax), 0, 0, + mpz_export (&abs_n, &count, 1, sizeof (uintmax_t), 0, 0, SCM_I_BIG_MPZ (val)); if (mpz_sgn (SCM_I_BIG_MPZ (val)) >= 0) @@ -9705,7 +9702,7 @@ scm_is_signed_integer (SCM val, scm_t_intmax min, scm_t_intmax max) { /* Carefully avoid signed integer overflow. */ if (min < 0 && abs_n - 1 <= -(min + 1)) - n = -1 - (scm_t_intmax)(abs_n - 1); + n = -1 - (intmax_t)(abs_n - 1); else return 0; } @@ -9718,12 +9715,12 @@ scm_is_signed_integer (SCM val, scm_t_intmax min, scm_t_intmax max) } int -scm_is_unsigned_integer (SCM val, scm_t_uintmax min, scm_t_uintmax max) +scm_is_unsigned_integer (SCM val, uintmax_t min, uintmax_t max) { if (SCM_I_INUMP (val)) { scm_t_signed_bits n = SCM_I_INUM (val); - return n >= 0 && ((scm_t_uintmax)n) >= min && ((scm_t_uintmax)n) <= max; + return n >= 0 && ((uintmax_t)n) >= min && ((uintmax_t)n) <= max; } else if (SCM_BIGP (val)) { @@ -9741,17 +9738,17 @@ scm_is_unsigned_integer (SCM val, scm_t_uintmax min, scm_t_uintmax max) } else { - scm_t_uintmax n; + uintmax_t n; size_t count; if (mpz_sgn (SCM_I_BIG_MPZ (val)) < 0) return 0; if (mpz_sizeinbase (SCM_I_BIG_MPZ (val), 2) - > CHAR_BIT*sizeof (scm_t_uintmax)) + > CHAR_BIT*sizeof (uintmax_t)) return 0; - mpz_export (&n, &count, 1, sizeof (scm_t_uintmax), 0, 0, + mpz_export (&n, &count, 1, sizeof (uintmax_t), 0, 0, SCM_I_BIG_MPZ (val)); return n >= min && n <= max; @@ -9771,93 +9768,93 @@ scm_i_range_error (SCM bad_val, SCM min, SCM max) scm_list_1 (bad_val)); } -#define TYPE scm_t_intmax +#define TYPE intmax_t #define TYPE_MIN min #define TYPE_MAX max #define SIZEOF_TYPE 0 -#define SCM_TO_TYPE_PROTO(arg) scm_to_signed_integer (arg, scm_t_intmax min, scm_t_intmax max) +#define SCM_TO_TYPE_PROTO(arg) scm_to_signed_integer (arg, intmax_t min, intmax_t max) #define SCM_FROM_TYPE_PROTO(arg) scm_from_signed_integer (arg) -#include "libguile/conv-integer.i.c" +#include "conv-integer.i.c" -#define TYPE scm_t_uintmax +#define TYPE uintmax_t #define TYPE_MIN min #define TYPE_MAX max #define SIZEOF_TYPE 0 -#define SCM_TO_TYPE_PROTO(arg) scm_to_unsigned_integer (arg, scm_t_uintmax min, scm_t_uintmax max) +#define SCM_TO_TYPE_PROTO(arg) scm_to_unsigned_integer (arg, uintmax_t min, uintmax_t max) #define SCM_FROM_TYPE_PROTO(arg) scm_from_unsigned_integer (arg) -#include "libguile/conv-uinteger.i.c" +#include "conv-uinteger.i.c" -#define TYPE scm_t_int8 -#define TYPE_MIN SCM_T_INT8_MIN -#define TYPE_MAX SCM_T_INT8_MAX +#define TYPE int8_t +#define TYPE_MIN INT8_MIN +#define TYPE_MAX INT8_MAX #define SIZEOF_TYPE 1 #define SCM_TO_TYPE_PROTO(arg) scm_to_int8 (arg) #define SCM_FROM_TYPE_PROTO(arg) scm_from_int8 (arg) -#include "libguile/conv-integer.i.c" +#include "conv-integer.i.c" -#define TYPE scm_t_uint8 +#define TYPE uint8_t #define TYPE_MIN 0 -#define TYPE_MAX SCM_T_UINT8_MAX +#define TYPE_MAX UINT8_MAX #define SIZEOF_TYPE 1 #define SCM_TO_TYPE_PROTO(arg) scm_to_uint8 (arg) #define SCM_FROM_TYPE_PROTO(arg) scm_from_uint8 (arg) -#include "libguile/conv-uinteger.i.c" +#include "conv-uinteger.i.c" -#define TYPE scm_t_int16 -#define TYPE_MIN SCM_T_INT16_MIN -#define TYPE_MAX SCM_T_INT16_MAX +#define TYPE int16_t +#define TYPE_MIN INT16_MIN +#define TYPE_MAX INT16_MAX #define SIZEOF_TYPE 2 #define SCM_TO_TYPE_PROTO(arg) scm_to_int16 (arg) #define SCM_FROM_TYPE_PROTO(arg) scm_from_int16 (arg) -#include "libguile/conv-integer.i.c" +#include "conv-integer.i.c" -#define TYPE scm_t_uint16 +#define TYPE uint16_t #define TYPE_MIN 0 -#define TYPE_MAX SCM_T_UINT16_MAX +#define TYPE_MAX UINT16_MAX #define SIZEOF_TYPE 2 #define SCM_TO_TYPE_PROTO(arg) scm_to_uint16 (arg) #define SCM_FROM_TYPE_PROTO(arg) scm_from_uint16 (arg) -#include "libguile/conv-uinteger.i.c" +#include "conv-uinteger.i.c" -#define TYPE scm_t_int32 -#define TYPE_MIN SCM_T_INT32_MIN -#define TYPE_MAX SCM_T_INT32_MAX +#define TYPE int32_t +#define TYPE_MIN INT32_MIN +#define TYPE_MAX INT32_MAX #define SIZEOF_TYPE 4 #define SCM_TO_TYPE_PROTO(arg) scm_to_int32 (arg) #define SCM_FROM_TYPE_PROTO(arg) scm_from_int32 (arg) -#include "libguile/conv-integer.i.c" +#include "conv-integer.i.c" -#define TYPE scm_t_uint32 +#define TYPE uint32_t #define TYPE_MIN 0 -#define TYPE_MAX SCM_T_UINT32_MAX +#define TYPE_MAX UINT32_MAX #define SIZEOF_TYPE 4 #define SCM_TO_TYPE_PROTO(arg) scm_to_uint32 (arg) #define SCM_FROM_TYPE_PROTO(arg) scm_from_uint32 (arg) -#include "libguile/conv-uinteger.i.c" +#include "conv-uinteger.i.c" #define TYPE scm_t_wchar -#define TYPE_MIN (scm_t_int32)-1 -#define TYPE_MAX (scm_t_int32)0x10ffff +#define TYPE_MIN (int32_t)-1 +#define TYPE_MAX (int32_t)0x10ffff #define SIZEOF_TYPE 4 #define SCM_TO_TYPE_PROTO(arg) scm_to_wchar (arg) #define SCM_FROM_TYPE_PROTO(arg) scm_from_wchar (arg) -#include "libguile/conv-integer.i.c" +#include "conv-integer.i.c" -#define TYPE scm_t_int64 -#define TYPE_MIN SCM_T_INT64_MIN -#define TYPE_MAX SCM_T_INT64_MAX +#define TYPE int64_t +#define TYPE_MIN INT64_MIN +#define TYPE_MAX INT64_MAX #define SIZEOF_TYPE 8 #define SCM_TO_TYPE_PROTO(arg) scm_to_int64 (arg) #define SCM_FROM_TYPE_PROTO(arg) scm_from_int64 (arg) -#include "libguile/conv-integer.i.c" +#include "conv-integer.i.c" -#define TYPE scm_t_uint64 +#define TYPE uint64_t #define TYPE_MIN 0 -#define TYPE_MAX SCM_T_UINT64_MAX +#define TYPE_MAX UINT64_MAX #define SIZEOF_TYPE 8 #define SCM_TO_TYPE_PROTO(arg) scm_to_uint64 (arg) #define SCM_FROM_TYPE_PROTO(arg) scm_from_uint64 (arg) -#include "libguile/conv-uinteger.i.c" +#include "conv-uinteger.i.c" void scm_to_mpz (SCM val, mpz_t rop) @@ -10146,7 +10143,7 @@ SCM_DEFINE (scm_i_exact_integer_sqrt, "exact-integer-sqrt", 1, 0, 0, SCM s, r; scm_exact_integer_sqrt (k, &s, &r); - return scm_values (scm_list_2 (s, r)); + return scm_values_2 (s, r); } #undef FUNC_NAME @@ -10427,11 +10424,5 @@ scm_init_numbers () DBL_MANT_DIG - 1); } -#include "libguile/numbers.x" +#include "numbers.x" } - -/* - Local Variables: - c-file-style: "gnu" - End: -*/ |