summaryrefslogtreecommitdiff
path: root/libguile/numbers.c
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/numbers.c')
-rw-r--r--libguile/numbers.c118
1 files changed, 33 insertions, 85 deletions
diff --git a/libguile/numbers.c b/libguile/numbers.c
index 6f04ea5f0..ddfa41a85 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -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);