mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-18 01:30:27 +02:00
Code Activity

Use Gnulib's isnan' and isinf' modules.

Browse source 
This updates Gnulib to v0.0-4219-g84cdd8b.

* m4/gnulib-cache.m4: Add `isinf' and `isnan'.

* configure.ac: Remove checks for `floatingpoint.h', `ieeefp.h', and
  `nan.h'.

* libguile/gen-scmconfig.c (main): Remove definitions of
  `SCM_HAVE_FLOATINGPOINT_H', `SCM_HAVE_IEEEFP_H', and
  `SCM_HAVE_NAN_H'.

* libguile/numbers.c (isnan)[SCO && !HAVE_ISNAN]: Remove.
  (isinf)[SCO && !HAVE_ISINF]: Remove.
  (xisinf, xisnan): Remove.  Change callers to use `isinf' and `isnan'.
  (guile_ieee_init): Remove the `defined HAVE_ISINF' and `define
  HAVE_ISNAN' conditions.

* libguile/numbers.h: Remove code conditional on
  `SCM_HAVE_FLOATINGPOINT_H', `SCM_HAVE_IEEEFP_H', or `SCM_HAVE_NAN_H'.
This commit is contained in:
Ludovic Courtès 2010-09-08 00:34:27 +02:00
parent 18f2d5aa4d
commit 2e65b52f8a
24 changed files with 2350 additions and 129 deletions
Download patch file Download diff file Expand all files Collapse all files

18
libguile/gen-scmconfig.c
View file

@ -185,24 +185,6 @@ main (int argc, char *argv[])
pf ("#define SCM_HAVE_SYS_SELECT_H 0 /* 0 or 1 */\n");
#endif
#ifdef HAVE_FLOATINGPOINT_H
pf ("#define SCM_HAVE_FLOATINGPOINT_H 1 /* 0 or 1 */\n");
#else
pf ("#define SCM_HAVE_FLOATINGPOINT_H 0 /* 0 or 1 */\n");
#endif
#ifdef HAVE_IEEEFP_H
pf ("#define SCM_HAVE_IEEEFP_H 1 /* 0 or 1 */\n");
#else
pf ("#define SCM_HAVE_IEEEFP_H 0 /* 0 or 1 */\n");
#endif
#ifdef HAVE_NAN_H
pf ("#define SCM_HAVE_NAN_H 1 /* 0 or 1 */\n");
#else
pf ("#define SCM_HAVE_NAN_H 0 /* 0 or 1 */\n");
#endif
#ifdef HAVE_WINSOCK2_H
pf ("#define SCM_HAVE_WINSOCK2_H 1 /* 0 or 1 */\n");
#else

118
libguile/numbers.c
View file

@ -105,26 +105,6 @@ static SCM flo0;
*/
#define FLOBUFLEN (40+2*(sizeof(double)/sizeof(char)*SCM_CHAR_BIT*3+9)/10)
#if defined (SCO)
#if ! defined (HAVE_ISNAN)
#define HAVE_ISNAN
static int
isnan (double x)
{
return (IsNANorINF (x) && NaN (x) && ! IsINF (x)) ? 1 : 0;
}
#endif
#if ! defined (HAVE_ISINF)
#define HAVE_ISINF
static int
isinf (double x)
{
return (IsNANorINF (x) && IsINF (x)) ? 1 : 0;
}
#endif
#endif
#if !defined (HAVE_ASINH)
static double asinh (double x) { return log (x + sqrt (x * x + 1)); }
@ -141,35 +121,11 @@ static double atanh (double x) { return 0.5 * log ((1 + x) / (1 - x)); }
mpz_cmp_d is supposed to do this itself. */
#if 1
#define xmpz_cmp_d(z, d) \
(xisinf (d) ? (d < 0.0 ? 1 : -1) : mpz_cmp_d (z, d))
(isinf (d) ? (d < 0.0 ? 1 : -1) : mpz_cmp_d (z, d))
#else
#define xmpz_cmp_d(z, d) mpz_cmp_d (z, d)
#endif
/* For reference, sparc solaris 7 has infinities (IEEE) but doesn't have
isinf. It does have finite and isnan though, hence the use of those.
fpclass would be a possibility on that system too. */
static int
xisinf (double x)
{
#if defined (HAVE_ISINF)
return isinf (x);
#elif defined (HAVE_FINITE) && defined (HAVE_ISNAN)
return (! (finite (x) || isnan (x)));
#else
return 0;
#endif
}
static int
xisnan (double x)
{
#if defined (HAVE_ISNAN)
return isnan (x);
#else
return 0;
#endif
}
#if defined (GUILE_I)
#if HAVE_COMPLEX_DOUBLE
@ -583,10 +539,10 @@ SCM_DEFINE (scm_inf_p, "inf?", 1, 0, 0,
#define FUNC_NAME s_scm_inf_p
{
if (SCM_REALP (x))
return scm_from_bool (xisinf (SCM_REAL_VALUE (x)));
return scm_from_bool (isinf (SCM_REAL_VALUE (x)));
else if (SCM_COMPLEXP (x))
return scm_from_bool (xisinf (SCM_COMPLEX_REAL (x))
|| xisinf (SCM_COMPLEX_IMAG (x)));
return scm_from_bool (isinf (SCM_COMPLEX_REAL (x))
|| isinf (SCM_COMPLEX_IMAG (x)));
else
return SCM_BOOL_F;
}
@ -599,10 +555,10 @@ SCM_DEFINE (scm_nan_p, "nan?", 1, 0, 0,
#define FUNC_NAME s_scm_nan_p
{
if (SCM_REALP (n))
return scm_from_bool (xisnan (SCM_REAL_VALUE (n)));
return scm_from_bool (isnan (SCM_REAL_VALUE (n)));
else if (SCM_COMPLEXP (n))
return scm_from_bool (xisnan (SCM_COMPLEX_REAL (n))
|| xisnan (SCM_COMPLEX_IMAG (n)));
return scm_from_bool (isnan (SCM_COMPLEX_REAL (n))
|| isnan (SCM_COMPLEX_IMAG (n)));
else
return SCM_BOOL_F;
}
@ -617,8 +573,6 @@ static double guile_NaN;
static void
guile_ieee_init (void)
{
#if defined (HAVE_ISINF) || defined (HAVE_FINITE)
/* Some version of gcc on some old version of Linux used to crash when
trying to make Inf and NaN. */
@ -645,10 +599,6 @@ guile_ieee_init (void)
}
#endif
#endif
#if defined (HAVE_ISNAN)
#ifdef NAN
/* C99 NAN, when available */
guile_NaN = NAN;
@ -661,8 +611,6 @@ guile_ieee_init (void)
#else
guile_NaN = guile_Inf / guile_Inf;
#endif
#endif
}
SCM_DEFINE (scm_inf, "inf", 0, 0, 0,
@ -2216,7 +2164,7 @@ idbl2str (double f, char *a, int radix)
goto zero; /*{a[0]='0'; a[1]='.'; a[2]='0'; return 3;} */
}
if (xisinf (f))
if (isinf (f))
{
if (f < 0)
strcpy (a, "-inf.0");
@ -2224,7 +2172,7 @@ idbl2str (double f, char *a, int radix)
strcpy (a, "+inf.0");
return ch+6;
}
else if (xisnan (f))
else if (isnan (f))
{
strcpy (a, "+nan.0");
return ch+6;
@ -2376,7 +2324,7 @@ icmplx2str (double real, double imag, char *str, int radix)
{
/* Don't output a '+' for negative numbers or for Inf and
NaN. They will provide their own sign. */
if (0 <= imag && !xisinf (imag) && !xisnan (imag))
if (0 <= imag && !isinf (imag) && !isnan (imag))
str[i++] = '+';
i += idbl2str (imag, &str[i], radix);
str[i++] = 'i';
@ -3409,7 +3357,7 @@ scm_num_eq_p (SCM x, SCM y)
else if (SCM_REALP (y))
{
int cmp;
if (xisnan (SCM_REAL_VALUE (y)))
if (isnan (SCM_REAL_VALUE (y)))
return SCM_BOOL_F;
cmp = xmpz_cmp_d (SCM_I_BIG_MPZ (x), SCM_REAL_VALUE (y));
scm_remember_upto_here_1 (x);
@ -3420,7 +3368,7 @@ scm_num_eq_p (SCM x, SCM y)
int cmp;
if (0.0 != SCM_COMPLEX_IMAG (y))
return SCM_BOOL_F;
if (xisnan (SCM_COMPLEX_REAL (y)))
if (isnan (SCM_COMPLEX_REAL (y)))
return SCM_BOOL_F;
cmp = xmpz_cmp_d (SCM_I_BIG_MPZ (x), SCM_COMPLEX_REAL (y));
scm_remember_upto_here_1 (x);
@ -3445,7 +3393,7 @@ scm_num_eq_p (SCM x, SCM y)
else if (SCM_BIGP (y))
{
int cmp;
if (xisnan (SCM_REAL_VALUE (x)))
if (isnan (SCM_REAL_VALUE (x)))
return SCM_BOOL_F;
cmp = xmpz_cmp_d (SCM_I_BIG_MPZ (y), SCM_REAL_VALUE (x));
scm_remember_upto_here_1 (y);
@ -3459,9 +3407,9 @@ scm_num_eq_p (SCM x, SCM y)
else if (SCM_FRACTIONP (y))
{
double xx = SCM_REAL_VALUE (x);
if (xisnan (xx))
if (isnan (xx))
return SCM_BOOL_F;
if (xisinf (xx))
if (isinf (xx))
return scm_from_bool (xx < 0.0);
x = scm_inexact_to_exact (x); /* with x as frac or int */
goto again;
@ -3479,7 +3427,7 @@ scm_num_eq_p (SCM x, SCM y)
int cmp;
if (0.0 != SCM_COMPLEX_IMAG (x))
return SCM_BOOL_F;
if (xisnan (SCM_COMPLEX_REAL (x)))
if (isnan (SCM_COMPLEX_REAL (x)))
return SCM_BOOL_F;
cmp = xmpz_cmp_d (SCM_I_BIG_MPZ (y), SCM_COMPLEX_REAL (x));
scm_remember_upto_here_1 (y);
@ -3497,9 +3445,9 @@ scm_num_eq_p (SCM x, SCM y)
if (SCM_COMPLEX_IMAG (x) != 0.0)
return SCM_BOOL_F;
xx = SCM_COMPLEX_REAL (x);
if (xisnan (xx))
if (isnan (xx))
return SCM_BOOL_F;
if (xisinf (xx))
if (isinf (xx))
return scm_from_bool (xx < 0.0);
x = scm_inexact_to_exact (x); /* with x as frac or int */
goto again;
@ -3516,9 +3464,9 @@ scm_num_eq_p (SCM x, SCM y)
else if (SCM_REALP (y))
{
double yy = SCM_REAL_VALUE (y);
if (xisnan (yy))
if (isnan (yy))
return SCM_BOOL_F;
if (xisinf (yy))
if (isinf (yy))
return scm_from_bool (0.0 < yy);
y = scm_inexact_to_exact (y); /* with y as frac or int */
goto again;
@ -3529,9 +3477,9 @@ scm_num_eq_p (SCM x, SCM y)
if (SCM_COMPLEX_IMAG (y) != 0.0)
return SCM_BOOL_F;
yy = SCM_COMPLEX_REAL (y);
if (xisnan (yy))
if (isnan (yy))
return SCM_BOOL_F;
if (xisinf (yy))
if (isinf (yy))
return scm_from_bool (0.0 < yy);
y = scm_inexact_to_exact (y); /* with y as frac or int */
goto again;
@ -3620,7 +3568,7 @@ scm_less_p (SCM x, SCM y)
else if (SCM_REALP (y))
{
int cmp;
if (xisnan (SCM_REAL_VALUE (y)))
if (isnan (SCM_REAL_VALUE (y)))
return SCM_BOOL_F;
cmp = xmpz_cmp_d (SCM_I_BIG_MPZ (x), SCM_REAL_VALUE (y));
scm_remember_upto_here_1 (x);
@ -3638,7 +3586,7 @@ scm_less_p (SCM x, SCM y)
else if (SCM_BIGP (y))
{
int cmp;
if (xisnan (SCM_REAL_VALUE (x)))
if (isnan (SCM_REAL_VALUE (x)))
return SCM_BOOL_F;
cmp = xmpz_cmp_d (SCM_I_BIG_MPZ (y), SCM_REAL_VALUE (x));
scm_remember_upto_here_1 (y);
@ -3649,9 +3597,9 @@ scm_less_p (SCM x, SCM y)
else if (SCM_FRACTIONP (y))
{
double xx = SCM_REAL_VALUE (x);
if (xisnan (xx))
if (isnan (xx))
return SCM_BOOL_F;
if (xisinf (xx))
if (isinf (xx))
return scm_from_bool (xx < 0.0);
x = scm_inexact_to_exact (x); /* with x as frac or int */
goto again;
@ -3671,9 +3619,9 @@ scm_less_p (SCM x, SCM y)
else if (SCM_REALP (y))
{
double yy = SCM_REAL_VALUE (y);
if (xisnan (yy))
if (isnan (yy))
return SCM_BOOL_F;
if (xisinf (yy))
if (isinf (yy))
return scm_from_bool (0.0 < yy);
y = scm_inexact_to_exact (y); /* with y as frac or int */
goto again;
@ -3988,7 +3936,7 @@ scm_max (SCM x, SCM y)
calling isnan is unavoidable, since it's the only way to know
which of x or y causes any compares to be false */
double xx = SCM_REAL_VALUE (x);
return (xisnan (xx) || xx > SCM_REAL_VALUE (y)) ? x : y;
return (isnan (xx) || xx > SCM_REAL_VALUE (y)) ? x : y;
}
else if (SCM_FRACTIONP (y))
{
@ -4134,7 +4082,7 @@ scm_min (SCM x, SCM y)
calling isnan is unavoidable, since it's the only way to know
which of x or y causes any compares to be false */
double xx = SCM_REAL_VALUE (x);
return (xisnan (xx) || xx < SCM_REAL_VALUE (y)) ? x : y;
return (isnan (xx) || xx < SCM_REAL_VALUE (y)) ? x : y;
}
else if (SCM_FRACTIONP (y))
{
@ -5994,7 +5942,7 @@ SCM_DEFINE (scm_inexact_to_exact, "inexact->exact", 1, 0, 0,
return z;
else if (SCM_REALP (z))
{
if (xisinf (SCM_REAL_VALUE (z)) || xisnan (SCM_REAL_VALUE (z)))
if (isinf (SCM_REAL_VALUE (z)) || isnan (SCM_REAL_VALUE (z)))
SCM_OUT_OF_RANGE (1, z);
else
{
@ -6362,7 +6310,7 @@ scm_num2float (SCM num, unsigned long int pos, const char *s_caller)
if (SCM_BIGP (num))
{
float res = mpz_get_d (SCM_I_BIG_MPZ (num));
if (!xisinf (res))
if (!isinf (res))
return res;
else
scm_out_of_range (NULL, num);
@ -6380,7 +6328,7 @@ scm_num2double (SCM num, unsigned long int pos, const char *s_caller)
if (SCM_BIGP (num))
{
double res = mpz_get_d (SCM_I_BIG_MPZ (num));
if (!xisinf (res))
if (!isinf (res))
return res;
else
scm_out_of_range (NULL, num);

18
libguile/numbers.h
View file

@ -33,24 +33,6 @@ typedef scm_t_int32 scm_t_wchar;
#define SCM_T_WCHAR_DEFINED
#endif /* SCM_T_WCHAR_DEFINED */
#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 */
/* Immediate Numbers, also known as fixnums