summaryrefslogtreecommitdiff
path: root/libguile/numbers.c
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/numbers.c')
-rw-r--r--libguile/numbers.c239
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:
-*/