mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-07-03 08:10:31 +02:00
(scm_is_rational): New.
(scm_i_short2big, scm_i_int2big, scm_i_uint2big, scm_i_size2big, scm_i_ptrdiff2big, scm_i_long_long2big, scm_i_ulong_long2big): Removed prototypes. (scm_make_real, scm_num2dbl, scm_float2num, scm_double2num): Discouraged by moving to discouraged.h and discouraged.c. Replaced all uses with scm_from_double. (scm_num2float, scm_num2double): Discouraged by moving prototype to discouraged.h and rewriting in terms of scm_to_double. Replaced all uses with scm_to_double. (scm_to_double): Do not implement in terms of scm_num2dbl, use explicit code. (scm_from_double): Do not implement in terms of scm_make_real, use explicit code.
This commit is contained in:
Marius Vollmer
parent
c165cd437c
commit
55f26379b3
4 changed files with 167 additions and 146 deletions
|
|
@ -52,6 +52,29 @@ DEFTO (long long, scm_num2long_long, scm_to_long_long);
|
|||
DEFTO (unsigned long long, scm_num2ulong_long, scm_to_ulong_long);
|
||||
#endif
|
||||
|
||||
SCM
|
||||
scm_make_real (double x)
|
||||
{
|
||||
return scm_from_double (x);
|
||||
}
|
||||
|
||||
double
|
||||
scm_num2dbl (SCM a, const char *why)
|
||||
{
|
||||
return scm_to_double (a);
|
||||
}
|
||||
|
||||
SCM
|
||||
scm_float2num (float n)
|
||||
{
|
||||
return scm_from_double ((double) n);
|
||||
}
|
||||
|
||||
SCM
|
||||
scm_double2num (double n)
|
||||
{
|
||||
return scm_from_double (n);
|
||||
}
|
||||
|
||||
void
|
||||
scm_i_init_discouraged (void)
|
||||
|
|
|
|||
|
|
@ -98,6 +98,19 @@ SCM_API unsigned long long scm_num2ulong_long (SCM num, unsigned long int pos,
|
|||
const char *s_caller);
|
||||
#endif
|
||||
|
||||
SCM_API SCM scm_make_real (double x);
|
||||
SCM_API double scm_num2dbl (SCM a, const char * why);
|
||||
SCM_API SCM scm_float2num (float n);
|
||||
SCM_API SCM scm_double2num (double n);
|
||||
|
||||
/* The next two are implemented in numbers.c since they use features
|
||||
only available there.
|
||||
*/
|
||||
SCM_API float scm_num2float (SCM num, unsigned long int pos,
|
||||
const char *s_caller);
|
||||
SCM_API double scm_num2double (SCM num, unsigned long int pos,
|
||||
const char *s_caller);
|
||||
|
||||
void scm_i_init_discouraged (void);
|
||||
|
||||
#endif /* SCM_ENABLE_DISCOURAGED == 1 */
|
||||
|
|
|
|||
|
|
@ -65,6 +65,8 @@
|
|||
|
||||
#include "libguile/eq.h"
|
||||
|
||||
#include "libguile/discouraged.h"
|
||||
|
||||
|
||||
|
||||
/*
|
||||
|
|
@ -444,9 +446,8 @@ static void scm_i_fraction_reduce (SCM z)
|
|||
double
|
||||
scm_i_fraction2double (SCM z)
|
||||
{
|
||||
return scm_num2dbl (scm_divide2real (SCM_FRACTION_NUMERATOR (z),
|
||||
SCM_FRACTION_DENOMINATOR (z)),
|
||||
"fraction2real");
|
||||
return scm_to_double (scm_divide2real (SCM_FRACTION_NUMERATOR (z),
|
||||
SCM_FRACTION_DENOMINATOR (z)));
|
||||
}
|
||||
|
||||
SCM_DEFINE (scm_exact_p, "exact?", 1, 0, 0,
|
||||
|
|
@ -635,7 +636,7 @@ SCM_DEFINE (scm_inf, "inf", 0, 0, 0,
|
|||
guile_ieee_init ();
|
||||
initialized = 1;
|
||||
}
|
||||
return scm_make_real (guile_Inf);
|
||||
return scm_from_double (guile_Inf);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
|
@ -650,7 +651,7 @@ SCM_DEFINE (scm_nan, "nan", 0, 0, 0,
|
|||
guile_ieee_init ();
|
||||
initialized = 1;
|
||||
}
|
||||
return scm_make_real (guile_NaN);
|
||||
return scm_from_double (guile_NaN);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
|
@ -683,7 +684,7 @@ SCM_PRIMITIVE_GENERIC (scm_abs, "abs", 1, 0, 0,
|
|||
/* note that if x is a NaN then xx<0 is false so we return x unchanged */
|
||||
double xx = SCM_REAL_VALUE (x);
|
||||
if (xx < 0.0)
|
||||
return scm_make_real (-xx);
|
||||
return scm_from_double (-xx);
|
||||
else
|
||||
return x;
|
||||
}
|
||||
|
|
@ -2703,7 +2704,7 @@ mem2ureal (const char* mem, size_t len, unsigned int *p_idx,
|
|||
floating point value so that we can change its sign.
|
||||
*/
|
||||
if (scm_is_eq (result, SCM_I_MAKINUM(0)) && *p_exactness == INEXACT)
|
||||
result = scm_make_real (0.0);
|
||||
result = scm_from_double (0.0);
|
||||
|
||||
return result;
|
||||
}
|
||||
|
|
@ -2972,21 +2973,11 @@ SCM_DEFINE (scm_string_to_number, "string->number", 1, 1, 0,
|
|||
/*** END strs->nums ***/
|
||||
|
||||
|
||||
SCM
|
||||
scm_make_real (double x)
|
||||
{
|
||||
SCM z = scm_double_cell (scm_tc16_real, 0, 0, 0);
|
||||
|
||||
SCM_REAL_VALUE (z) = x;
|
||||
return z;
|
||||
}
|
||||
|
||||
|
||||
SCM
|
||||
scm_make_complex (double x, double y)
|
||||
{
|
||||
if (y == 0.0)
|
||||
return scm_make_real (x);
|
||||
return scm_from_double (x);
|
||||
else
|
||||
{
|
||||
SCM z;
|
||||
|
|
@ -3607,7 +3598,7 @@ scm_max (SCM x, SCM y)
|
|||
{
|
||||
double z = xx;
|
||||
/* if y==NaN then ">" is false and we return NaN */
|
||||
return (z > SCM_REAL_VALUE (y)) ? scm_make_real (z) : y;
|
||||
return (z > SCM_REAL_VALUE (y)) ? scm_from_double (z) : y;
|
||||
}
|
||||
else if (SCM_FRACTIONP (y))
|
||||
{
|
||||
|
|
@ -3638,7 +3629,7 @@ scm_max (SCM x, SCM y)
|
|||
big_real:
|
||||
xx = scm_i_big2dbl (x);
|
||||
yy = SCM_REAL_VALUE (y);
|
||||
return (xx > yy ? scm_make_real (xx) : y);
|
||||
return (xx > yy ? scm_from_double (xx) : y);
|
||||
}
|
||||
else if (SCM_FRACTIONP (y))
|
||||
{
|
||||
|
|
@ -3653,7 +3644,7 @@ scm_max (SCM x, SCM y)
|
|||
{
|
||||
double z = SCM_I_INUM (y);
|
||||
/* if x==NaN then "<" is false and we return NaN */
|
||||
return (SCM_REAL_VALUE (x) < z) ? scm_make_real (z) : x;
|
||||
return (SCM_REAL_VALUE (x) < z) ? scm_from_double (z) : x;
|
||||
}
|
||||
else if (SCM_BIGP (y))
|
||||
{
|
||||
|
|
@ -3673,7 +3664,7 @@ scm_max (SCM x, SCM y)
|
|||
{
|
||||
double yy = scm_i_fraction2double (y);
|
||||
double xx = SCM_REAL_VALUE (x);
|
||||
return (xx < yy) ? scm_make_real (yy) : x;
|
||||
return (xx < yy) ? scm_from_double (yy) : x;
|
||||
}
|
||||
else
|
||||
SCM_WTA_DISPATCH_2 (g_max, x, y, SCM_ARGn, s_max);
|
||||
|
|
@ -3691,7 +3682,7 @@ scm_max (SCM x, SCM y)
|
|||
else if (SCM_REALP (y))
|
||||
{
|
||||
double xx = scm_i_fraction2double (x);
|
||||
return (xx < SCM_REAL_VALUE (y)) ? y : scm_make_real (xx);
|
||||
return (xx < SCM_REAL_VALUE (y)) ? y : scm_from_double (xx);
|
||||
}
|
||||
else if (SCM_FRACTIONP (y))
|
||||
{
|
||||
|
|
@ -3739,7 +3730,7 @@ scm_min (SCM x, SCM y)
|
|||
{
|
||||
double z = xx;
|
||||
/* if y==NaN then "<" is false and we return NaN */
|
||||
return (z < SCM_REAL_VALUE (y)) ? scm_make_real (z) : y;
|
||||
return (z < SCM_REAL_VALUE (y)) ? scm_from_double (z) : y;
|
||||
}
|
||||
else if (SCM_FRACTIONP (y))
|
||||
{
|
||||
|
|
@ -3770,7 +3761,7 @@ scm_min (SCM x, SCM y)
|
|||
big_real:
|
||||
xx = scm_i_big2dbl (x);
|
||||
yy = SCM_REAL_VALUE (y);
|
||||
return (xx < yy ? scm_make_real (xx) : y);
|
||||
return (xx < yy ? scm_from_double (xx) : y);
|
||||
}
|
||||
else if (SCM_FRACTIONP (y))
|
||||
{
|
||||
|
|
@ -3785,7 +3776,7 @@ scm_min (SCM x, SCM y)
|
|||
{
|
||||
double z = SCM_I_INUM (y);
|
||||
/* if x==NaN then "<" is false and we return NaN */
|
||||
return (z < SCM_REAL_VALUE (x)) ? scm_make_real (z) : x;
|
||||
return (z < SCM_REAL_VALUE (x)) ? scm_from_double (z) : x;
|
||||
}
|
||||
else if (SCM_BIGP (y))
|
||||
{
|
||||
|
|
@ -3805,7 +3796,7 @@ scm_min (SCM x, SCM y)
|
|||
{
|
||||
double yy = scm_i_fraction2double (y);
|
||||
double xx = SCM_REAL_VALUE (x);
|
||||
return (yy < xx) ? scm_make_real (yy) : x;
|
||||
return (yy < xx) ? scm_from_double (yy) : x;
|
||||
}
|
||||
else
|
||||
SCM_WTA_DISPATCH_2 (g_min, x, y, SCM_ARGn, s_min);
|
||||
|
|
@ -3823,7 +3814,7 @@ scm_min (SCM x, SCM y)
|
|||
else if (SCM_REALP (y))
|
||||
{
|
||||
double xx = scm_i_fraction2double (x);
|
||||
return (SCM_REAL_VALUE (y) < xx) ? y : scm_make_real (xx);
|
||||
return (SCM_REAL_VALUE (y) < xx) ? y : scm_from_double (xx);
|
||||
}
|
||||
else if (SCM_FRACTIONP (y))
|
||||
{
|
||||
|
|
@ -3868,7 +3859,7 @@ scm_sum (SCM x, SCM y)
|
|||
else if (SCM_REALP (y))
|
||||
{
|
||||
long int xx = SCM_I_INUM (x);
|
||||
return scm_make_real (xx + SCM_REAL_VALUE (y));
|
||||
return scm_from_double (xx + SCM_REAL_VALUE (y));
|
||||
}
|
||||
else if (SCM_COMPLEXP (y))
|
||||
{
|
||||
|
|
@ -3932,7 +3923,7 @@ scm_sum (SCM x, SCM y)
|
|||
{
|
||||
double result = mpz_get_d (SCM_I_BIG_MPZ (x)) + SCM_REAL_VALUE (y);
|
||||
scm_remember_upto_here_1 (x);
|
||||
return scm_make_real (result);
|
||||
return scm_from_double (result);
|
||||
}
|
||||
else if (SCM_COMPLEXP (y))
|
||||
{
|
||||
|
|
@ -3951,20 +3942,20 @@ scm_sum (SCM x, SCM y)
|
|||
else if (SCM_REALP (x))
|
||||
{
|
||||
if (SCM_I_INUMP (y))
|
||||
return scm_make_real (SCM_REAL_VALUE (x) + SCM_I_INUM (y));
|
||||
return scm_from_double (SCM_REAL_VALUE (x) + SCM_I_INUM (y));
|
||||
else if (SCM_BIGP (y))
|
||||
{
|
||||
double result = mpz_get_d (SCM_I_BIG_MPZ (y)) + SCM_REAL_VALUE (x);
|
||||
scm_remember_upto_here_1 (y);
|
||||
return scm_make_real (result);
|
||||
return scm_from_double (result);
|
||||
}
|
||||
else if (SCM_REALP (y))
|
||||
return scm_make_real (SCM_REAL_VALUE (x) + SCM_REAL_VALUE (y));
|
||||
return scm_from_double (SCM_REAL_VALUE (x) + SCM_REAL_VALUE (y));
|
||||
else if (SCM_COMPLEXP (y))
|
||||
return scm_make_complex (SCM_REAL_VALUE (x) + SCM_COMPLEX_REAL (y),
|
||||
SCM_COMPLEX_IMAG (y));
|
||||
else if (SCM_FRACTIONP (y))
|
||||
return scm_make_real (SCM_REAL_VALUE (x) + scm_i_fraction2double (y));
|
||||
return scm_from_double (SCM_REAL_VALUE (x) + scm_i_fraction2double (y));
|
||||
else
|
||||
SCM_WTA_DISPATCH_2 (g_sum, x, y, SCM_ARGn, s_sum);
|
||||
}
|
||||
|
|
@ -4003,7 +3994,7 @@ scm_sum (SCM x, SCM y)
|
|||
scm_product (y, SCM_FRACTION_DENOMINATOR (x))),
|
||||
SCM_FRACTION_DENOMINATOR (x));
|
||||
else if (SCM_REALP (y))
|
||||
return scm_make_real (SCM_REAL_VALUE (y) + scm_i_fraction2double (x));
|
||||
return scm_from_double (SCM_REAL_VALUE (y) + scm_i_fraction2double (x));
|
||||
else if (SCM_COMPLEXP (y))
|
||||
return scm_make_complex (SCM_COMPLEX_REAL (y) + scm_i_fraction2double (x),
|
||||
SCM_COMPLEX_IMAG (y));
|
||||
|
|
@ -4045,7 +4036,7 @@ scm_difference (SCM x, SCM y)
|
|||
/* FIXME: do we really need to normalize here? */
|
||||
return scm_i_normbig (scm_i_clonebig (x, 0));
|
||||
else if (SCM_REALP (x))
|
||||
return scm_make_real (-SCM_REAL_VALUE (x));
|
||||
return scm_from_double (-SCM_REAL_VALUE (x));
|
||||
else if (SCM_COMPLEXP (x))
|
||||
return scm_make_complex (-SCM_COMPLEX_REAL (x),
|
||||
-SCM_COMPLEX_IMAG (x));
|
||||
|
|
@ -4100,7 +4091,7 @@ scm_difference (SCM x, SCM y)
|
|||
else if (SCM_REALP (y))
|
||||
{
|
||||
long int xx = SCM_I_INUM (x);
|
||||
return scm_make_real (xx - SCM_REAL_VALUE (y));
|
||||
return scm_from_double (xx - SCM_REAL_VALUE (y));
|
||||
}
|
||||
else if (SCM_COMPLEXP (y))
|
||||
{
|
||||
|
|
@ -4165,7 +4156,7 @@ scm_difference (SCM x, SCM y)
|
|||
{
|
||||
double result = mpz_get_d (SCM_I_BIG_MPZ (x)) - SCM_REAL_VALUE (y);
|
||||
scm_remember_upto_here_1 (x);
|
||||
return scm_make_real (result);
|
||||
return scm_from_double (result);
|
||||
}
|
||||
else if (SCM_COMPLEXP (y))
|
||||
{
|
||||
|
|
@ -4183,20 +4174,20 @@ scm_difference (SCM x, SCM y)
|
|||
else if (SCM_REALP (x))
|
||||
{
|
||||
if (SCM_I_INUMP (y))
|
||||
return scm_make_real (SCM_REAL_VALUE (x) - SCM_I_INUM (y));
|
||||
return scm_from_double (SCM_REAL_VALUE (x) - SCM_I_INUM (y));
|
||||
else if (SCM_BIGP (y))
|
||||
{
|
||||
double result = SCM_REAL_VALUE (x) - mpz_get_d (SCM_I_BIG_MPZ (y));
|
||||
scm_remember_upto_here_1 (x);
|
||||
return scm_make_real (result);
|
||||
return scm_from_double (result);
|
||||
}
|
||||
else if (SCM_REALP (y))
|
||||
return scm_make_real (SCM_REAL_VALUE (x) - SCM_REAL_VALUE (y));
|
||||
return scm_from_double (SCM_REAL_VALUE (x) - SCM_REAL_VALUE (y));
|
||||
else if (SCM_COMPLEXP (y))
|
||||
return scm_make_complex (SCM_REAL_VALUE (x) - SCM_COMPLEX_REAL (y),
|
||||
-SCM_COMPLEX_IMAG (y));
|
||||
else if (SCM_FRACTIONP (y))
|
||||
return scm_make_real (SCM_REAL_VALUE (x) - scm_i_fraction2double (y));
|
||||
return scm_from_double (SCM_REAL_VALUE (x) - scm_i_fraction2double (y));
|
||||
else
|
||||
SCM_WTA_DISPATCH_2 (g_difference, x, y, SCM_ARGn, s_difference);
|
||||
}
|
||||
|
|
@ -4236,7 +4227,7 @@ scm_difference (SCM x, SCM y)
|
|||
scm_product(y, SCM_FRACTION_DENOMINATOR (x))),
|
||||
SCM_FRACTION_DENOMINATOR (x));
|
||||
else if (SCM_REALP (y))
|
||||
return scm_make_real (scm_i_fraction2double (x) - SCM_REAL_VALUE (y));
|
||||
return scm_from_double (scm_i_fraction2double (x) - SCM_REAL_VALUE (y));
|
||||
else if (SCM_COMPLEXP (y))
|
||||
return scm_make_complex (scm_i_fraction2double (x) - SCM_COMPLEX_REAL (y),
|
||||
-SCM_COMPLEX_IMAG (y));
|
||||
|
|
@ -4306,7 +4297,7 @@ scm_product (SCM x, SCM y)
|
|||
return result;
|
||||
}
|
||||
else if (SCM_REALP (y))
|
||||
return scm_make_real (xx * SCM_REAL_VALUE (y));
|
||||
return scm_from_double (xx * SCM_REAL_VALUE (y));
|
||||
else if (SCM_COMPLEXP (y))
|
||||
return scm_make_complex (xx * SCM_COMPLEX_REAL (y),
|
||||
xx * SCM_COMPLEX_IMAG (y));
|
||||
|
|
@ -4336,7 +4327,7 @@ scm_product (SCM x, SCM y)
|
|||
{
|
||||
double result = mpz_get_d (SCM_I_BIG_MPZ (x)) * SCM_REAL_VALUE (y);
|
||||
scm_remember_upto_here_1 (x);
|
||||
return scm_make_real (result);
|
||||
return scm_from_double (result);
|
||||
}
|
||||
else if (SCM_COMPLEXP (y))
|
||||
{
|
||||
|
|
@ -4354,20 +4345,20 @@ scm_product (SCM x, SCM y)
|
|||
else if (SCM_REALP (x))
|
||||
{
|
||||
if (SCM_I_INUMP (y))
|
||||
return scm_make_real (SCM_I_INUM (y) * SCM_REAL_VALUE (x));
|
||||
return scm_from_double (SCM_I_INUM (y) * SCM_REAL_VALUE (x));
|
||||
else if (SCM_BIGP (y))
|
||||
{
|
||||
double result = mpz_get_d (SCM_I_BIG_MPZ (y)) * SCM_REAL_VALUE (x);
|
||||
scm_remember_upto_here_1 (y);
|
||||
return scm_make_real (result);
|
||||
return scm_from_double (result);
|
||||
}
|
||||
else if (SCM_REALP (y))
|
||||
return scm_make_real (SCM_REAL_VALUE (x) * SCM_REAL_VALUE (y));
|
||||
return scm_from_double (SCM_REAL_VALUE (x) * SCM_REAL_VALUE (y));
|
||||
else if (SCM_COMPLEXP (y))
|
||||
return scm_make_complex (SCM_REAL_VALUE (x) * SCM_COMPLEX_REAL (y),
|
||||
SCM_REAL_VALUE (x) * SCM_COMPLEX_IMAG (y));
|
||||
else if (SCM_FRACTIONP (y))
|
||||
return scm_make_real (SCM_REAL_VALUE (x) * scm_i_fraction2double (y));
|
||||
return scm_from_double (SCM_REAL_VALUE (x) * scm_i_fraction2double (y));
|
||||
else
|
||||
SCM_WTA_DISPATCH_2 (g_product, x, y, SCM_ARGn, s_product);
|
||||
}
|
||||
|
|
@ -4411,7 +4402,7 @@ scm_product (SCM x, SCM y)
|
|||
return scm_make_ratio (scm_product (y, SCM_FRACTION_NUMERATOR (x)),
|
||||
SCM_FRACTION_DENOMINATOR (x));
|
||||
else if (SCM_REALP (y))
|
||||
return scm_make_real (scm_i_fraction2double (x) * SCM_REAL_VALUE (y));
|
||||
return scm_from_double (scm_i_fraction2double (x) * SCM_REAL_VALUE (y));
|
||||
else if (SCM_COMPLEXP (y))
|
||||
{
|
||||
double xx = scm_i_fraction2double (x);
|
||||
|
|
@ -4431,27 +4422,6 @@ scm_product (SCM x, SCM y)
|
|||
SCM_WTA_DISPATCH_2 (g_product, x, y, SCM_ARG1, s_product);
|
||||
}
|
||||
|
||||
double
|
||||
scm_num2dbl (SCM a, const char *why)
|
||||
#define FUNC_NAME why
|
||||
{
|
||||
if (SCM_I_INUMP (a))
|
||||
return (double) SCM_I_INUM (a);
|
||||
else if (SCM_BIGP (a))
|
||||
{
|
||||
double result = mpz_get_d (SCM_I_BIG_MPZ (a));
|
||||
scm_remember_upto_here_1 (a);
|
||||
return result;
|
||||
}
|
||||
else if (SCM_REALP (a))
|
||||
return (SCM_REAL_VALUE (a));
|
||||
else if (SCM_FRACTIONP (a))
|
||||
return scm_i_fraction2double (a);
|
||||
else
|
||||
SCM_WRONG_TYPE_ARG (SCM_ARGn, a);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
#if ((defined (HAVE_ISINF) && defined (HAVE_ISNAN)) \
|
||||
|| (defined (HAVE_FINITE) && defined (HAVE_ISNAN)))
|
||||
#define ALLOW_DIVIDE_BY_ZERO
|
||||
|
|
@ -4511,14 +4481,14 @@ scm_i_divide (SCM x, SCM y, int inexact)
|
|||
else
|
||||
{
|
||||
if (inexact)
|
||||
return scm_make_real (1.0 / (double) xx);
|
||||
return scm_from_double (1.0 / (double) xx);
|
||||
else return scm_make_ratio (SCM_I_MAKINUM(1), x);
|
||||
}
|
||||
}
|
||||
else if (SCM_BIGP (x))
|
||||
{
|
||||
if (inexact)
|
||||
return scm_make_real (1.0 / scm_i_big2dbl (x));
|
||||
return scm_from_double (1.0 / scm_i_big2dbl (x));
|
||||
else return scm_make_ratio (SCM_I_MAKINUM(1), x);
|
||||
}
|
||||
else if (SCM_REALP (x))
|
||||
|
|
@ -4529,7 +4499,7 @@ scm_i_divide (SCM x, SCM y, int inexact)
|
|||
scm_num_overflow (s_divide);
|
||||
else
|
||||
#endif
|
||||
return scm_make_real (1.0 / xx);
|
||||
return scm_from_double (1.0 / xx);
|
||||
}
|
||||
else if (SCM_COMPLEXP (x))
|
||||
{
|
||||
|
|
@ -4566,13 +4536,13 @@ scm_i_divide (SCM x, SCM y, int inexact)
|
|||
#ifndef ALLOW_DIVIDE_BY_EXACT_ZERO
|
||||
scm_num_overflow (s_divide);
|
||||
#else
|
||||
return scm_make_real ((double) xx / (double) yy);
|
||||
return scm_from_double ((double) xx / (double) yy);
|
||||
#endif
|
||||
}
|
||||
else if (xx % yy != 0)
|
||||
{
|
||||
if (inexact)
|
||||
return scm_make_real ((double) xx / (double) yy);
|
||||
return scm_from_double ((double) xx / (double) yy);
|
||||
else return scm_make_ratio (x, y);
|
||||
}
|
||||
else
|
||||
|
|
@ -4587,7 +4557,7 @@ scm_i_divide (SCM x, SCM y, int inexact)
|
|||
else if (SCM_BIGP (y))
|
||||
{
|
||||
if (inexact)
|
||||
return scm_make_real ((double) xx / scm_i_big2dbl (y));
|
||||
return scm_from_double ((double) xx / scm_i_big2dbl (y));
|
||||
else return scm_make_ratio (x, y);
|
||||
}
|
||||
else if (SCM_REALP (y))
|
||||
|
|
@ -4598,7 +4568,7 @@ scm_i_divide (SCM x, SCM y, int inexact)
|
|||
scm_num_overflow (s_divide);
|
||||
else
|
||||
#endif
|
||||
return scm_make_real ((double) xx / yy);
|
||||
return scm_from_double ((double) xx / yy);
|
||||
}
|
||||
else if (SCM_COMPLEXP (y))
|
||||
{
|
||||
|
|
@ -4670,7 +4640,7 @@ scm_i_divide (SCM x, SCM y, int inexact)
|
|||
else
|
||||
{
|
||||
if (inexact)
|
||||
return scm_make_real (scm_i_big2dbl (x) / (double) yy);
|
||||
return scm_from_double (scm_i_big2dbl (x) / (double) yy);
|
||||
else return scm_make_ratio (x, y);
|
||||
}
|
||||
}
|
||||
|
|
@ -4709,7 +4679,7 @@ scm_i_divide (SCM x, SCM y, int inexact)
|
|||
double dbx = mpz_get_d (SCM_I_BIG_MPZ (x));
|
||||
double dby = mpz_get_d (SCM_I_BIG_MPZ (y));
|
||||
scm_remember_upto_here_2 (x, y);
|
||||
return scm_make_real (dbx / dby);
|
||||
return scm_from_double (dbx / dby);
|
||||
}
|
||||
else return scm_make_ratio (x, y);
|
||||
}
|
||||
|
|
@ -4723,7 +4693,7 @@ scm_i_divide (SCM x, SCM y, int inexact)
|
|||
scm_num_overflow (s_divide);
|
||||
else
|
||||
#endif
|
||||
return scm_make_real (scm_i_big2dbl (x) / yy);
|
||||
return scm_from_double (scm_i_big2dbl (x) / yy);
|
||||
}
|
||||
else if (SCM_COMPLEXP (y))
|
||||
{
|
||||
|
|
@ -4747,13 +4717,13 @@ scm_i_divide (SCM x, SCM y, int inexact)
|
|||
scm_num_overflow (s_divide);
|
||||
else
|
||||
#endif
|
||||
return scm_make_real (rx / (double) yy);
|
||||
return scm_from_double (rx / (double) yy);
|
||||
}
|
||||
else if (SCM_BIGP (y))
|
||||
{
|
||||
double dby = mpz_get_d (SCM_I_BIG_MPZ (y));
|
||||
scm_remember_upto_here_1 (y);
|
||||
return scm_make_real (rx / dby);
|
||||
return scm_from_double (rx / dby);
|
||||
}
|
||||
else if (SCM_REALP (y))
|
||||
{
|
||||
|
|
@ -4763,7 +4733,7 @@ scm_i_divide (SCM x, SCM y, int inexact)
|
|||
scm_num_overflow (s_divide);
|
||||
else
|
||||
#endif
|
||||
return scm_make_real (rx / yy);
|
||||
return scm_from_double (rx / yy);
|
||||
}
|
||||
else if (SCM_COMPLEXP (y))
|
||||
{
|
||||
|
|
@ -4771,7 +4741,7 @@ scm_i_divide (SCM x, SCM y, int inexact)
|
|||
goto complex_div;
|
||||
}
|
||||
else if (SCM_FRACTIONP (y))
|
||||
return scm_make_real (rx / scm_i_fraction2double (y));
|
||||
return scm_from_double (rx / scm_i_fraction2double (y));
|
||||
else
|
||||
SCM_WTA_DISPATCH_2 (g_divide, x, y, SCM_ARGn, s_divide);
|
||||
}
|
||||
|
|
@ -4859,7 +4829,7 @@ scm_i_divide (SCM x, SCM y, int inexact)
|
|||
scm_num_overflow (s_divide);
|
||||
else
|
||||
#endif
|
||||
return scm_make_real (scm_i_fraction2double (x) / yy);
|
||||
return scm_from_double (scm_i_fraction2double (x) / yy);
|
||||
}
|
||||
else if (SCM_COMPLEXP (y))
|
||||
{
|
||||
|
|
@ -5017,7 +4987,7 @@ SCM_DEFINE (scm_round_number, "round", 1, 0, 0,
|
|||
if (SCM_I_INUMP (x) || SCM_BIGP (x))
|
||||
return x;
|
||||
else if (SCM_REALP (x))
|
||||
return scm_make_real (scm_round (SCM_REAL_VALUE (x)));
|
||||
return scm_from_double (scm_round (SCM_REAL_VALUE (x)));
|
||||
else
|
||||
{
|
||||
/* OPTIMIZE-ME: Fraction case could be done more efficiently by a
|
||||
|
|
@ -5043,7 +5013,7 @@ SCM_PRIMITIVE_GENERIC (scm_floor, "floor", 1, 0, 0,
|
|||
if (SCM_I_INUMP (x) || SCM_BIGP (x))
|
||||
return x;
|
||||
else if (SCM_REALP (x))
|
||||
return scm_make_real (floor (SCM_REAL_VALUE (x)));
|
||||
return scm_from_double (floor (SCM_REAL_VALUE (x)));
|
||||
else if (SCM_FRACTIONP (x))
|
||||
{
|
||||
SCM q = scm_quotient (SCM_FRACTION_NUMERATOR (x),
|
||||
|
|
@ -5074,7 +5044,7 @@ SCM_PRIMITIVE_GENERIC (scm_ceiling, "ceiling", 1, 0, 0,
|
|||
if (SCM_I_INUMP (x) || SCM_BIGP (x))
|
||||
return x;
|
||||
else if (SCM_REALP (x))
|
||||
return scm_make_real (ceil (SCM_REAL_VALUE (x)));
|
||||
return scm_from_double (ceil (SCM_REAL_VALUE (x)));
|
||||
else if (SCM_FRACTIONP (x))
|
||||
{
|
||||
SCM q = scm_quotient (SCM_FRACTION_NUMERATOR (x),
|
||||
|
|
@ -5182,7 +5152,7 @@ SCM_DEFINE (scm_sys_expt, "$expt", 2, 0, 0,
|
|||
{
|
||||
struct dpair xy;
|
||||
scm_two_doubles (x, y, FUNC_NAME, &xy);
|
||||
return scm_make_real (pow (xy.x, xy.y));
|
||||
return scm_from_double (pow (xy.x, xy.y));
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
|
@ -5198,7 +5168,7 @@ SCM_DEFINE (scm_sys_atan2, "$atan2", 2, 0, 0,
|
|||
{
|
||||
struct dpair xy;
|
||||
scm_two_doubles (x, y, FUNC_NAME, &xy);
|
||||
return scm_make_real (atan2 (xy.x, xy.y));
|
||||
return scm_from_double (atan2 (xy.x, xy.y));
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
|
@ -5249,7 +5219,7 @@ scm_real_part (SCM z)
|
|||
else if (SCM_REALP (z))
|
||||
return z;
|
||||
else if (SCM_COMPLEXP (z))
|
||||
return scm_make_real (SCM_COMPLEX_REAL (z));
|
||||
return scm_from_double (SCM_COMPLEX_REAL (z));
|
||||
else if (SCM_FRACTIONP (z))
|
||||
return z;
|
||||
else
|
||||
|
|
@ -5270,7 +5240,7 @@ scm_imag_part (SCM z)
|
|||
else if (SCM_REALP (z))
|
||||
return scm_flo0;
|
||||
else if (SCM_COMPLEXP (z))
|
||||
return scm_make_real (SCM_COMPLEX_IMAG (z));
|
||||
return scm_from_double (SCM_COMPLEX_IMAG (z));
|
||||
else if (SCM_FRACTIONP (z))
|
||||
return SCM_INUM0;
|
||||
else
|
||||
|
|
@ -5347,9 +5317,9 @@ scm_magnitude (SCM z)
|
|||
return z;
|
||||
}
|
||||
else if (SCM_REALP (z))
|
||||
return scm_make_real (fabs (SCM_REAL_VALUE (z)));
|
||||
return scm_from_double (fabs (SCM_REAL_VALUE (z)));
|
||||
else if (SCM_COMPLEXP (z))
|
||||
return scm_make_real (hypot (SCM_COMPLEX_REAL (z), SCM_COMPLEX_IMAG (z)));
|
||||
return scm_from_double (hypot (SCM_COMPLEX_REAL (z), SCM_COMPLEX_IMAG (z)));
|
||||
else if (SCM_FRACTIONP (z))
|
||||
{
|
||||
if (scm_is_false (scm_negative_p (SCM_FRACTION_NUMERATOR (z))))
|
||||
|
|
@ -5369,7 +5339,7 @@ SCM
|
|||
scm_angle (SCM z)
|
||||
{
|
||||
/* atan(0,-1) is pi and it'd be possible to have that as a constant like
|
||||
scm_flo0 to save allocating a new flonum with scm_make_real each time.
|
||||
scm_flo0 to save allocating a new flonum with scm_from_double each time.
|
||||
But if atan2 follows the floating point rounding mode, then the value
|
||||
is not a constant. Maybe it'd be close enough though. */
|
||||
if (SCM_I_INUMP (z))
|
||||
|
|
@ -5377,14 +5347,14 @@ scm_angle (SCM z)
|
|||
if (SCM_I_INUM (z) >= 0)
|
||||
return scm_flo0;
|
||||
else
|
||||
return scm_make_real (atan2 (0.0, -1.0));
|
||||
return scm_from_double (atan2 (0.0, -1.0));
|
||||
}
|
||||
else if (SCM_BIGP (z))
|
||||
{
|
||||
int sgn = mpz_sgn (SCM_I_BIG_MPZ (z));
|
||||
scm_remember_upto_here_1 (z);
|
||||
if (sgn < 0)
|
||||
return scm_make_real (atan2 (0.0, -1.0));
|
||||
return scm_from_double (atan2 (0.0, -1.0));
|
||||
else
|
||||
return scm_flo0;
|
||||
}
|
||||
|
|
@ -5393,15 +5363,15 @@ scm_angle (SCM z)
|
|||
if (SCM_REAL_VALUE (z) >= 0)
|
||||
return scm_flo0;
|
||||
else
|
||||
return scm_make_real (atan2 (0.0, -1.0));
|
||||
return scm_from_double (atan2 (0.0, -1.0));
|
||||
}
|
||||
else if (SCM_COMPLEXP (z))
|
||||
return scm_make_real (atan2 (SCM_COMPLEX_IMAG (z), SCM_COMPLEX_REAL (z)));
|
||||
return scm_from_double (atan2 (SCM_COMPLEX_IMAG (z), SCM_COMPLEX_REAL (z)));
|
||||
else if (SCM_FRACTIONP (z))
|
||||
{
|
||||
if (scm_is_false (scm_negative_p (SCM_FRACTION_NUMERATOR (z))))
|
||||
return scm_flo0;
|
||||
else return scm_make_real (atan2 (0.0, -1.0));
|
||||
else return scm_from_double (atan2 (0.0, -1.0));
|
||||
}
|
||||
else
|
||||
SCM_WTA_DISPATCH_1 (g_angle, z, SCM_ARG1, s_angle);
|
||||
|
|
@ -5415,11 +5385,11 @@ SCM
|
|||
scm_exact_to_inexact (SCM z)
|
||||
{
|
||||
if (SCM_I_INUMP (z))
|
||||
return scm_make_real ((double) SCM_I_INUM (z));
|
||||
return scm_from_double ((double) SCM_I_INUM (z));
|
||||
else if (SCM_BIGP (z))
|
||||
return scm_make_real (scm_i_big2dbl (z));
|
||||
return scm_from_double (scm_i_big2dbl (z));
|
||||
else if (SCM_FRACTIONP (z))
|
||||
return scm_make_real (scm_i_fraction2double (z));
|
||||
return scm_from_double (scm_i_fraction2double (z));
|
||||
else if (SCM_INEXACTP (z))
|
||||
return z;
|
||||
else
|
||||
|
|
@ -5530,16 +5500,6 @@ SCM_DEFINE (scm_rationalize, "rationalize", 2, 0, 0,
|
|||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
#define NUM2FLOAT scm_num2float
|
||||
#define FLOAT2NUM scm_float2num
|
||||
#define FTYPE float
|
||||
#include "libguile/num2float.i.c"
|
||||
|
||||
#define NUM2FLOAT scm_num2double
|
||||
#define FLOAT2NUM scm_double2num
|
||||
#define FTYPE double
|
||||
#include "libguile/num2float.i.c"
|
||||
|
||||
/* conversion functions */
|
||||
|
||||
int
|
||||
|
|
@ -5735,18 +5695,69 @@ scm_is_real (SCM val)
|
|||
return scm_is_true (scm_real_p (val));
|
||||
}
|
||||
|
||||
int
|
||||
scm_is_rational (SCM val)
|
||||
{
|
||||
return scm_is_true (scm_rational_p (val));
|
||||
}
|
||||
|
||||
double
|
||||
scm_to_double (SCM val)
|
||||
{
|
||||
return scm_num2dbl (val, NULL);
|
||||
if (SCM_I_INUMP (val))
|
||||
return SCM_I_INUM (val);
|
||||
else if (SCM_BIGP (val))
|
||||
return scm_i_big2dbl (val);
|
||||
else if (SCM_FRACTIONP (val))
|
||||
return scm_i_fraction2double (val);
|
||||
else if (SCM_REALP (val))
|
||||
return SCM_REAL_VALUE (val);
|
||||
else
|
||||
scm_wrong_type_arg (NULL, 0, val);
|
||||
}
|
||||
|
||||
SCM
|
||||
scm_from_double (double val)
|
||||
{
|
||||
return scm_make_real (val);
|
||||
SCM z = scm_double_cell (scm_tc16_real, 0, 0, 0);
|
||||
SCM_REAL_VALUE (z) = val;
|
||||
return z;
|
||||
}
|
||||
|
||||
#if SCM_ENABLE_DISCOURAGED == 1
|
||||
|
||||
float
|
||||
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))
|
||||
return res;
|
||||
else
|
||||
scm_out_of_range (NULL, num);
|
||||
}
|
||||
else
|
||||
return scm_to_double (num);
|
||||
}
|
||||
|
||||
double
|
||||
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))
|
||||
return res;
|
||||
else
|
||||
scm_out_of_range (NULL, num);
|
||||
}
|
||||
else
|
||||
return scm_to_double (num);
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
void
|
||||
scm_init_numbers ()
|
||||
{
|
||||
|
|
@ -5765,7 +5776,7 @@ scm_init_numbers ()
|
|||
|
||||
scm_add_feature ("complex");
|
||||
scm_add_feature ("inexact");
|
||||
scm_flo0 = scm_make_real (0.0);
|
||||
scm_flo0 = scm_from_double (0.0);
|
||||
|
||||
/* determine floating point precision */
|
||||
for (i=2; i <= SCM_MAX_DBL_RADIX; ++i)
|
||||
|
|
|
|||
|
|
@ -213,7 +213,6 @@ 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_i_mem2number (const char *mem, size_t len, unsigned int radix);
|
||||
SCM_API SCM scm_string_to_number (SCM str, SCM radix);
|
||||
SCM_API SCM scm_make_real (double x);
|
||||
SCM_API SCM scm_make_complex (double x, double y);
|
||||
SCM_API SCM scm_bigequal (SCM x, SCM y);
|
||||
SCM_API SCM scm_real_equalp (SCM x, SCM y);
|
||||
|
|
@ -235,7 +234,6 @@ SCM_API SCM scm_min (SCM x, SCM y);
|
|||
SCM_API SCM scm_sum (SCM x, SCM y);
|
||||
SCM_API SCM scm_difference (SCM x, SCM y);
|
||||
SCM_API SCM scm_product (SCM x, SCM y);
|
||||
SCM_API double scm_num2dbl (SCM a, const char * why);
|
||||
SCM_API SCM scm_divide (SCM x, SCM y);
|
||||
SCM_API SCM scm_floor (SCM x);
|
||||
SCM_API SCM scm_ceiling (SCM x);
|
||||
|
|
@ -258,14 +256,6 @@ SCM_API SCM scm_exact_to_inexact (SCM z);
|
|||
SCM_API SCM scm_inexact_to_exact (SCM z);
|
||||
SCM_API SCM scm_trunc (SCM x);
|
||||
|
||||
SCM_API SCM scm_float2num (float n);
|
||||
SCM_API SCM scm_double2num (double n);
|
||||
SCM_API float scm_num2float (SCM num, unsigned long int pos,
|
||||
const char *s_caller);
|
||||
SCM_API double scm_num2double (SCM num, unsigned long int pos,
|
||||
const char *s_caller);
|
||||
|
||||
|
||||
/* bignum internal functions */
|
||||
SCM_API SCM scm_i_mkbig (void);
|
||||
SCM_API SCM scm_i_normbig (SCM x);
|
||||
|
|
@ -273,20 +263,8 @@ 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_short2big (short n);
|
||||
SCM_API SCM scm_i_ushort2big (unsigned short n);
|
||||
SCM_API SCM scm_i_int2big (int n);
|
||||
SCM_API SCM scm_i_uint2big (unsigned int n);
|
||||
SCM_API SCM scm_i_long2big (long n);
|
||||
SCM_API SCM scm_i_ulong2big (unsigned long n);
|
||||
SCM_API SCM scm_i_size2big (size_t n);
|
||||
SCM_API SCM scm_i_ptrdiff2big (scm_t_ptrdiff n);
|
||||
|
||||
#if SCM_SIZEOF_LONG_LONG != 0
|
||||
SCM_API SCM scm_i_long_long2big (long long n);
|
||||
SCM_API SCM scm_i_ulong_long2big (unsigned long long n);
|
||||
#endif
|
||||
|
||||
|
||||
/* ratio functions */
|
||||
SCM_API SCM scm_make_ratio (SCM num, SCM den);
|
||||
|
|
@ -300,11 +278,6 @@ 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);
|
||||
|
||||
|
||||
#ifdef GUILE_DEBUG
|
||||
SCM_API SCM scm_sys_check_number_conversions (void);
|
||||
#endif
|
||||
|
||||
/* conversion functions for integers */
|
||||
|
||||
SCM_API int scm_is_integer (SCM val);
|
||||
|
|
@ -445,7 +418,7 @@ SCM_API SCM scm_from_uint64 (scm_t_uint64 x);
|
|||
#define scm_to_uintmax scm_to_uint64
|
||||
#define scm_from_uintmax scm_from_uint64
|
||||
#else
|
||||
#error sizeof(scm_t_intmax_t) is not 4 or 8.
|
||||
#error sizeof(scm_t_intmax) is not 4 or 8.
|
||||
#endif
|
||||
#endif
|
||||
|
||||
|
|
@ -480,6 +453,7 @@ SCM_API SCM scm_from_uint64 (scm_t_uint64 x);
|
|||
/* conversion functions for reals */
|
||||
|
||||
SCM_API int scm_is_real (SCM val);
|
||||
SCM_API int scm_is_rational (SCM val);
|
||||
SCM_API double scm_to_double (SCM val);
|
||||
SCM_API SCM scm_from_double (double val);
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue