mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
Make divide functions return values via (SCM *) output arguments
* libguile/numbers.c (scm_euclidean_divide, scm_centered_divide): Change API to return two values via output arguments of type (SCM *), instead of packing into a values object. (scm_i_euclidean_divide, scm_i_centered_divide): New internal wrappers that call the above functions and pack the result into a values object. * libguile/numbers.h: Change prototypes to reflect new API. * doc/ref/api-data.h (Arithmetic): Update manual.
This commit is contained in:
Mark H Weaver
Andy Wingo
parent
a85c1f93f0
commit
5fbf680be9
3 changed files with 177 additions and 112 deletions
|
|
@ -1250,17 +1250,17 @@ respectively, but these functions take and return @code{double}
|
|||
values.
|
||||
@end deftypefn
|
||||
|
||||
@deffn {Scheme Procedure} euclidean/ x y
|
||||
@deffnx {Scheme Procedure} euclidean-quotient x y
|
||||
@deffnx {Scheme Procedure} euclidean-remainder x y
|
||||
@deffnx {C Function} scm_euclidean_divide (x y)
|
||||
@deffnx {C Function} scm_euclidean_quotient (x y)
|
||||
@deffnx {C Function} scm_euclidean_remainder (x y)
|
||||
@deftypefn {Scheme Procedure} {} euclidean/ @var{x} @var{y}
|
||||
@deftypefnx {Scheme Procedure} {} euclidean-quotient @var{x} @var{y}
|
||||
@deftypefnx {Scheme Procedure} {} euclidean-remainder @var{x} @var{y}
|
||||
@deftypefnx {C Function} void scm_euclidean_divide (SCM @var{x}, SCM @var{y}, SCM *@var{q}, SCM *@var{r})
|
||||
@deftypefnx {C Function} SCM scm_euclidean_quotient (SCM @var{x}, SCM @var{y})
|
||||
@deftypefnx {C Function} SCM scm_euclidean_remainder (SCM @var{x}, SCM @var{y})
|
||||
These procedures accept two real numbers @var{x} and @var{y}, where the
|
||||
divisor @var{y} must be non-zero. @code{euclidean-quotient} returns the
|
||||
integer @var{q} and @code{euclidean-remainder} returns the real number
|
||||
@var{r} such that @math{@var{x} = @var{q}*@var{y} + @var{r}} and
|
||||
@math{0 <= @var{r} < abs(@var{y})}. @code{euclidean/} returns both @var{q} and
|
||||
@math{0 <= @var{r} < |@var{y}|}. @code{euclidean/} returns both @var{q} and
|
||||
@var{r}, and is more efficient than computing each separately. Note
|
||||
that when @math{@var{y} > 0}, @code{euclidean-quotient} returns
|
||||
@math{floor(@var{x}/@var{y})}, otherwise it returns
|
||||
|
|
@ -1279,19 +1279,19 @@ Note that these operators are equivalent to the R6RS operators
|
|||
(euclidean/ -123.2 -63.5) @result{} 2.0 and 3.8
|
||||
(euclidean/ 16/3 -10/7) @result{} -3 and 22/21
|
||||
@end lisp
|
||||
@end deffn
|
||||
@end deftypefn
|
||||
|
||||
@deffn {Scheme Procedure} centered/ x y
|
||||
@deffnx {Scheme Procedure} centered-quotient x y
|
||||
@deffnx {Scheme Procedure} centered-remainder x y
|
||||
@deffnx {C Function} scm_centered_divide (x y)
|
||||
@deffnx {C Function} scm_centered_quotient (x y)
|
||||
@deffnx {C Function} scm_centered_remainder (x y)
|
||||
@deftypefn {Scheme Procedure} {} centered/ @var{x} @var{y}
|
||||
@deftypefnx {Scheme Procedure} {} centered-quotient @var{x} @var{y}
|
||||
@deftypefnx {Scheme Procedure} {} centered-remainder @var{x} @var{y}
|
||||
@deftypefnx {C Function} void scm_centered_divide (SCM @var{x}, SCM @var{y}, SCM *@var{q}, SCM *@var{r})
|
||||
@deftypefnx {C Function} SCM scm_centered_quotient (SCM @var{x}, SCM @var{y})
|
||||
@deftypefnx {C Function} SCM scm_centered_remainder (SCM @var{x}, SCM @var{y})
|
||||
These procedures accept two real numbers @var{x} and @var{y}, where the
|
||||
divisor @var{y} must be non-zero. @code{centered-quotient} returns the
|
||||
integer @var{q} and @code{centered-remainder} returns the real number
|
||||
@var{r} such that @math{@var{x} = @var{q}*@var{y} + @var{r}} and
|
||||
@math{-abs(@var{y}/2) <= @var{r} < abs(@var{y}/2)}. @code{centered/}
|
||||
@math{-|@var{y}/2| <= @var{r} < |@var{y}/2|}. @code{centered/}
|
||||
returns both @var{q} and @var{r}, and is more efficient than computing
|
||||
each separately.
|
||||
|
||||
|
|
@ -1300,7 +1300,8 @@ rounded to the nearest integer. When @math{@var{x}/@var{y}} lies
|
|||
exactly half-way between two integers, the tie is broken according to
|
||||
the sign of @var{y}. If @math{@var{y} > 0}, ties are rounded toward
|
||||
positive infinity, otherwise they are rounded toward negative infinity.
|
||||
This is a consequence of the requirement that @math{-abs(@var{y}/2) <= @var{r} < abs(@var{y}/2)}.
|
||||
This is a consequence of the requirement that
|
||||
@math{-|@var{y}/2| <= @var{r} < |@var{y}/2|}.
|
||||
|
||||
Note that these operators are equivalent to the R6RS operators
|
||||
@code{div0}, @code{mod0}, and @code{div0-and-mod0}.
|
||||
|
|
@ -1315,7 +1316,7 @@ Note that these operators are equivalent to the R6RS operators
|
|||
(centered/ -123.2 -63.5) @result{} 2.0 and 3.8
|
||||
(centered/ 16/3 -10/7) @result{} -4 and -8/21
|
||||
@end lisp
|
||||
@end deffn
|
||||
@end deftypefn
|
||||
|
||||
@node Scientific
|
||||
@subsubsection Scientific Functions
|
||||
|
|
|
|||
|
|
@ -1069,6 +1069,29 @@ SCM_PRIMITIVE_GENERIC (scm_modulo, "modulo", 2, 0, 0,
|
|||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
/* two_valued_wta_dispatch_2 is a version of SCM_WTA_DISPATCH_2 for
|
||||
two-valued functions. It is called from primitive generics that take
|
||||
two arguments and return two values, when the core procedure is
|
||||
unable to handle the given argument types. If there are GOOPS
|
||||
methods for this primitive generic, it dispatches to GOOPS and, if
|
||||
successful, expects two values to be returned, which are placed in
|
||||
*rp1 and *rp2. If there are no GOOPS methods, it throws a
|
||||
wrong-type-arg exception.
|
||||
|
||||
FIXME: This obviously belongs somewhere else, but until we decide on
|
||||
the right API, it is here as a static function, because it is needed
|
||||
by the *_divide functions below.
|
||||
*/
|
||||
static void
|
||||
two_valued_wta_dispatch_2 (SCM gf, SCM a1, SCM a2, int pos,
|
||||
const char *subr, SCM *rp1, SCM *rp2)
|
||||
{
|
||||
if (SCM_UNPACK (gf))
|
||||
scm_i_extract_values_2 (scm_call_generic_2 (gf, a1, a2), rp1, rp2);
|
||||
else
|
||||
scm_wrong_type_arg (subr, pos, (pos == SCM_ARG1) ? a1 : a2);
|
||||
}
|
||||
|
||||
static SCM scm_i_inexact_euclidean_quotient (double x, double y);
|
||||
static SCM scm_i_slow_exact_euclidean_quotient (SCM x, SCM y);
|
||||
|
||||
|
|
@ -1407,10 +1430,11 @@ scm_i_slow_exact_euclidean_remainder (SCM x, SCM y)
|
|||
}
|
||||
|
||||
|
||||
static SCM scm_i_inexact_euclidean_divide (double x, double y);
|
||||
static SCM scm_i_slow_exact_euclidean_divide (SCM x, SCM y);
|
||||
static void scm_i_inexact_euclidean_divide (double x, double y,
|
||||
SCM *qp, SCM *rp);
|
||||
static void scm_i_slow_exact_euclidean_divide (SCM x, SCM y, SCM *qp, SCM *rp);
|
||||
|
||||
SCM_PRIMITIVE_GENERIC (scm_euclidean_divide, "euclidean/", 2, 0, 0,
|
||||
SCM_PRIMITIVE_GENERIC (scm_i_euclidean_divide, "euclidean/", 2, 0, 0,
|
||||
(SCM x, SCM y),
|
||||
"Return the integer @var{q} and the real number @var{r}\n"
|
||||
"such that @math{@var{x} = @var{q}*@var{y} + @var{r}}\n"
|
||||
|
|
@ -1423,7 +1447,20 @@ SCM_PRIMITIVE_GENERIC (scm_euclidean_divide, "euclidean/", 2, 0, 0,
|
|||
"(euclidean/ -123.2 -63.5) @result{} 2.0 and 3.8\n"
|
||||
"(euclidean/ 16/3 -10/7) @result{} -3 and 22/21\n"
|
||||
"@end lisp")
|
||||
#define FUNC_NAME s_scm_euclidean_divide
|
||||
#define FUNC_NAME s_scm_i_euclidean_divide
|
||||
{
|
||||
SCM q, r;
|
||||
|
||||
scm_euclidean_divide(x, y, &q, &r);
|
||||
return scm_values (scm_list_2 (q, r));
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
#define s_scm_euclidean_divide s_scm_i_euclidean_divide
|
||||
#define g_scm_euclidean_divide g_scm_i_euclidean_divide
|
||||
|
||||
void
|
||||
scm_euclidean_divide (SCM x, SCM y, SCM *qp, SCM *rp)
|
||||
{
|
||||
if (SCM_LIKELY (SCM_I_INUMP (x)))
|
||||
{
|
||||
|
|
@ -1437,8 +1474,6 @@ SCM_PRIMITIVE_GENERIC (scm_euclidean_divide, "euclidean/", 2, 0, 0,
|
|||
{
|
||||
scm_t_inum qq = xx / yy;
|
||||
scm_t_inum rr = xx % yy;
|
||||
SCM q;
|
||||
|
||||
if (rr < 0)
|
||||
{
|
||||
if (yy > 0)
|
||||
|
|
@ -1447,23 +1482,27 @@ SCM_PRIMITIVE_GENERIC (scm_euclidean_divide, "euclidean/", 2, 0, 0,
|
|||
{ rr -= yy; qq++; }
|
||||
}
|
||||
if (SCM_LIKELY (SCM_FIXABLE (qq)))
|
||||
q = SCM_I_MAKINUM (qq);
|
||||
*qp = SCM_I_MAKINUM (qq);
|
||||
else
|
||||
q = scm_i_inum2big (qq);
|
||||
return scm_values (scm_list_2 (q, SCM_I_MAKINUM (rr)));
|
||||
*qp = scm_i_inum2big (qq);
|
||||
*rp = SCM_I_MAKINUM (rr);
|
||||
}
|
||||
return;
|
||||
}
|
||||
else if (SCM_BIGP (y))
|
||||
{
|
||||
if (xx >= 0)
|
||||
return scm_values (scm_list_2 (SCM_INUM0, x));
|
||||
{
|
||||
*qp = SCM_INUM0;
|
||||
*rp = x;
|
||||
}
|
||||
else if (mpz_sgn (SCM_I_BIG_MPZ (y)) > 0)
|
||||
{
|
||||
SCM r = scm_i_mkbig ();
|
||||
mpz_sub_ui (SCM_I_BIG_MPZ (r), SCM_I_BIG_MPZ (y), -xx);
|
||||
scm_remember_upto_here_1 (y);
|
||||
return scm_values
|
||||
(scm_list_2 (SCM_I_MAKINUM (-1), scm_i_normbig (r)));
|
||||
*qp = SCM_I_MAKINUM (-1);
|
||||
*rp = scm_i_normbig (r);
|
||||
}
|
||||
else
|
||||
{
|
||||
|
|
@ -1471,16 +1510,19 @@ SCM_PRIMITIVE_GENERIC (scm_euclidean_divide, "euclidean/", 2, 0, 0,
|
|||
mpz_add_ui (SCM_I_BIG_MPZ (r), SCM_I_BIG_MPZ (y), -xx);
|
||||
scm_remember_upto_here_1 (y);
|
||||
mpz_neg (SCM_I_BIG_MPZ (r), SCM_I_BIG_MPZ (r));
|
||||
return scm_values (scm_list_2 (SCM_INUM1, scm_i_normbig (r)));
|
||||
*qp = SCM_INUM1;
|
||||
*rp = scm_i_normbig (r);
|
||||
}
|
||||
return;
|
||||
}
|
||||
else if (SCM_REALP (y))
|
||||
return scm_i_inexact_euclidean_divide (xx, SCM_REAL_VALUE (y));
|
||||
return scm_i_inexact_euclidean_divide (xx, SCM_REAL_VALUE (y), qp, rp);
|
||||
else if (SCM_FRACTIONP (y))
|
||||
return scm_i_slow_exact_euclidean_divide (x, y);
|
||||
return scm_i_slow_exact_euclidean_divide (x, y, qp, rp);
|
||||
else
|
||||
SCM_WTA_DISPATCH_2 (g_scm_euclidean_divide, x, y, SCM_ARG2,
|
||||
s_scm_euclidean_divide);
|
||||
return two_valued_wta_dispatch_2
|
||||
(g_scm_euclidean_divide, x, y, SCM_ARG2,
|
||||
s_scm_euclidean_divide, qp, rp);
|
||||
}
|
||||
else if (SCM_BIGP (x))
|
||||
{
|
||||
|
|
@ -1503,9 +1545,10 @@ SCM_PRIMITIVE_GENERIC (scm_euclidean_divide, "euclidean/", 2, 0, 0,
|
|||
mpz_neg (SCM_I_BIG_MPZ (q), SCM_I_BIG_MPZ (q));
|
||||
}
|
||||
scm_remember_upto_here_1 (x);
|
||||
return scm_values (scm_list_2 (scm_i_normbig (q),
|
||||
SCM_I_MAKINUM (rr)));
|
||||
*qp = scm_i_normbig (q);
|
||||
*rp = SCM_I_MAKINUM (rr);
|
||||
}
|
||||
return;
|
||||
}
|
||||
else if (SCM_BIGP (y))
|
||||
{
|
||||
|
|
@ -1518,44 +1561,46 @@ SCM_PRIMITIVE_GENERIC (scm_euclidean_divide, "euclidean/", 2, 0, 0,
|
|||
mpz_cdiv_qr (SCM_I_BIG_MPZ (q), SCM_I_BIG_MPZ (r),
|
||||
SCM_I_BIG_MPZ (x), SCM_I_BIG_MPZ (y));
|
||||
scm_remember_upto_here_2 (x, y);
|
||||
return scm_values (scm_list_2 (scm_i_normbig (q),
|
||||
scm_i_normbig (r)));
|
||||
*qp = scm_i_normbig (q);
|
||||
*rp = scm_i_normbig (r);
|
||||
return;
|
||||
}
|
||||
else if (SCM_REALP (y))
|
||||
return scm_i_inexact_euclidean_divide
|
||||
(scm_i_big2dbl (x), SCM_REAL_VALUE (y));
|
||||
(scm_i_big2dbl (x), SCM_REAL_VALUE (y), qp, rp);
|
||||
else if (SCM_FRACTIONP (y))
|
||||
return scm_i_slow_exact_euclidean_divide (x, y);
|
||||
return scm_i_slow_exact_euclidean_divide (x, y, qp, rp);
|
||||
else
|
||||
SCM_WTA_DISPATCH_2 (g_scm_euclidean_divide, x, y, SCM_ARG2,
|
||||
s_scm_euclidean_divide);
|
||||
return two_valued_wta_dispatch_2
|
||||
(g_scm_euclidean_divide, x, y, SCM_ARG2,
|
||||
s_scm_euclidean_divide, qp, rp);
|
||||
}
|
||||
else if (SCM_REALP (x))
|
||||
{
|
||||
if (SCM_REALP (y) || SCM_I_INUMP (y) ||
|
||||
SCM_BIGP (y) || SCM_FRACTIONP (y))
|
||||
return scm_i_inexact_euclidean_divide
|
||||
(SCM_REAL_VALUE (x), scm_to_double (y));
|
||||
(SCM_REAL_VALUE (x), scm_to_double (y), qp, rp);
|
||||
else
|
||||
SCM_WTA_DISPATCH_2 (g_scm_euclidean_divide, x, y, SCM_ARG2,
|
||||
s_scm_euclidean_divide);
|
||||
return two_valued_wta_dispatch_2
|
||||
(g_scm_euclidean_divide, x, y, SCM_ARG2,
|
||||
s_scm_euclidean_divide, qp, rp);
|
||||
}
|
||||
else if (SCM_FRACTIONP (x))
|
||||
{
|
||||
if (SCM_REALP (y))
|
||||
return scm_i_inexact_euclidean_divide
|
||||
(scm_i_fraction2double (x), SCM_REAL_VALUE (y));
|
||||
(scm_i_fraction2double (x), SCM_REAL_VALUE (y), qp, rp);
|
||||
else
|
||||
return scm_i_slow_exact_euclidean_divide (x, y);
|
||||
return scm_i_slow_exact_euclidean_divide (x, y, qp, rp);
|
||||
}
|
||||
else
|
||||
SCM_WTA_DISPATCH_2 (g_scm_euclidean_divide, x, y, SCM_ARG1,
|
||||
s_scm_euclidean_divide);
|
||||
return two_valued_wta_dispatch_2 (g_scm_euclidean_divide, x, y, SCM_ARG1,
|
||||
s_scm_euclidean_divide, qp, rp);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
static SCM
|
||||
scm_i_inexact_euclidean_divide (double x, double y)
|
||||
static void
|
||||
scm_i_inexact_euclidean_divide (double x, double y, SCM *qp, SCM *rp)
|
||||
{
|
||||
double q, r;
|
||||
|
||||
|
|
@ -1568,32 +1613,32 @@ scm_i_inexact_euclidean_divide (double x, double y)
|
|||
else
|
||||
q = guile_NaN;
|
||||
r = x - q * y;
|
||||
return scm_values (scm_list_2 (scm_from_double (q),
|
||||
scm_from_double (r)));
|
||||
*qp = scm_from_double (q);
|
||||
*rp = scm_from_double (r);
|
||||
}
|
||||
|
||||
/* Compute exact euclidean quotient and remainder the slow way.
|
||||
We use this only if both arguments are exact,
|
||||
and at least one of them is a fraction */
|
||||
static SCM
|
||||
scm_i_slow_exact_euclidean_divide (SCM x, SCM y)
|
||||
static void
|
||||
scm_i_slow_exact_euclidean_divide (SCM x, SCM y, SCM *qp, SCM *rp)
|
||||
{
|
||||
SCM q, r;
|
||||
SCM q;
|
||||
|
||||
if (!(SCM_I_INUMP (x) || SCM_BIGP (x) || SCM_FRACTIONP (x)))
|
||||
SCM_WTA_DISPATCH_2 (g_scm_euclidean_divide, x, y, SCM_ARG1,
|
||||
s_scm_euclidean_divide);
|
||||
return two_valued_wta_dispatch_2 (g_scm_euclidean_divide, x, y, SCM_ARG1,
|
||||
s_scm_euclidean_divide, qp, rp);
|
||||
else if (!(SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y)))
|
||||
SCM_WTA_DISPATCH_2 (g_scm_euclidean_divide, x, y, SCM_ARG2,
|
||||
s_scm_euclidean_divide);
|
||||
return two_valued_wta_dispatch_2 (g_scm_euclidean_divide, x, y, SCM_ARG2,
|
||||
s_scm_euclidean_divide, qp, rp);
|
||||
else if (scm_is_true (scm_positive_p (y)))
|
||||
q = scm_floor (scm_divide (x, y));
|
||||
else if (scm_is_true (scm_negative_p (y)))
|
||||
q = scm_ceiling (scm_divide (x, y));
|
||||
else
|
||||
scm_num_overflow (s_scm_euclidean_divide);
|
||||
r = scm_difference (x, scm_product (q, y));
|
||||
return scm_values (scm_list_2 (q, r));
|
||||
*qp = q;
|
||||
*rp = scm_difference (x, scm_product (q, y));
|
||||
}
|
||||
|
||||
static SCM scm_i_inexact_centered_quotient (double x, double y);
|
||||
|
|
@ -2052,11 +2097,12 @@ scm_i_slow_exact_centered_remainder (SCM x, SCM y)
|
|||
}
|
||||
|
||||
|
||||
static SCM scm_i_inexact_centered_divide (double x, double y);
|
||||
static SCM scm_i_bigint_centered_divide (SCM x, SCM y);
|
||||
static SCM scm_i_slow_exact_centered_divide (SCM x, SCM y);
|
||||
static void scm_i_inexact_centered_divide (double x, double y,
|
||||
SCM *qp, SCM *rp);
|
||||
static void scm_i_bigint_centered_divide (SCM x, SCM y, SCM *qp, SCM *rp);
|
||||
static void scm_i_slow_exact_centered_divide (SCM x, SCM y, SCM *qp, SCM *rp);
|
||||
|
||||
SCM_PRIMITIVE_GENERIC (scm_centered_divide, "centered/", 2, 0, 0,
|
||||
SCM_PRIMITIVE_GENERIC (scm_i_centered_divide, "centered/", 2, 0, 0,
|
||||
(SCM x, SCM y),
|
||||
"Return the integer @var{q} and the real number @var{r}\n"
|
||||
"such that @math{@var{x} = @var{q}*@var{y} + @var{r}}\n"
|
||||
|
|
@ -2069,7 +2115,20 @@ SCM_PRIMITIVE_GENERIC (scm_centered_divide, "centered/", 2, 0, 0,
|
|||
"(centered/ -123.2 -63.5) @result{} 2.0 and 3.8\n"
|
||||
"(centered/ 16/3 -10/7) @result{} -4 and -8/21\n"
|
||||
"@end lisp")
|
||||
#define FUNC_NAME s_scm_centered_divide
|
||||
#define FUNC_NAME s_scm_i_centered_divide
|
||||
{
|
||||
SCM q, r;
|
||||
|
||||
scm_centered_divide(x, y, &q, &r);
|
||||
return scm_values (scm_list_2 (q, r));
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
#define s_scm_centered_divide s_scm_i_centered_divide
|
||||
#define g_scm_centered_divide g_scm_i_centered_divide
|
||||
|
||||
void
|
||||
scm_centered_divide (SCM x, SCM y, SCM *qp, SCM *rp)
|
||||
{
|
||||
if (SCM_LIKELY (SCM_I_INUMP (x)))
|
||||
{
|
||||
|
|
@ -2083,8 +2142,6 @@ SCM_PRIMITIVE_GENERIC (scm_centered_divide, "centered/", 2, 0, 0,
|
|||
{
|
||||
scm_t_inum qq = xx / yy;
|
||||
scm_t_inum rr = xx % yy;
|
||||
SCM q;
|
||||
|
||||
if (SCM_LIKELY (xx > 0))
|
||||
{
|
||||
if (SCM_LIKELY (yy > 0))
|
||||
|
|
@ -2112,25 +2169,27 @@ SCM_PRIMITIVE_GENERIC (scm_centered_divide, "centered/", 2, 0, 0,
|
|||
}
|
||||
}
|
||||
if (SCM_LIKELY (SCM_FIXABLE (qq)))
|
||||
q = SCM_I_MAKINUM (qq);
|
||||
*qp = SCM_I_MAKINUM (qq);
|
||||
else
|
||||
q = scm_i_inum2big (qq);
|
||||
return scm_values (scm_list_2 (q, SCM_I_MAKINUM (rr)));
|
||||
*qp = scm_i_inum2big (qq);
|
||||
*rp = SCM_I_MAKINUM (rr);
|
||||
}
|
||||
return;
|
||||
}
|
||||
else if (SCM_BIGP (y))
|
||||
{
|
||||
/* Pass a denormalized bignum version of x (even though it
|
||||
can fit in a fixnum) to scm_i_bigint_centered_divide */
|
||||
return scm_i_bigint_centered_divide (scm_i_long2big (xx), y);
|
||||
return scm_i_bigint_centered_divide (scm_i_long2big (xx), y, qp, rp);
|
||||
}
|
||||
else if (SCM_REALP (y))
|
||||
return scm_i_inexact_centered_divide (xx, SCM_REAL_VALUE (y));
|
||||
return scm_i_inexact_centered_divide (xx, SCM_REAL_VALUE (y), qp, rp);
|
||||
else if (SCM_FRACTIONP (y))
|
||||
return scm_i_slow_exact_centered_divide (x, y);
|
||||
return scm_i_slow_exact_centered_divide (x, y, qp, rp);
|
||||
else
|
||||
SCM_WTA_DISPATCH_2 (g_scm_centered_divide, x, y, SCM_ARG2,
|
||||
s_scm_centered_divide);
|
||||
return two_valued_wta_dispatch_2
|
||||
(g_scm_centered_divide, x, y, SCM_ARG2,
|
||||
s_scm_centered_divide, qp, rp);
|
||||
}
|
||||
else if (SCM_BIGP (x))
|
||||
{
|
||||
|
|
@ -2171,47 +2230,49 @@ SCM_PRIMITIVE_GENERIC (scm_centered_divide, "centered/", 2, 0, 0,
|
|||
rr -= yy;
|
||||
}
|
||||
}
|
||||
return scm_values (scm_list_2 (scm_i_normbig (q),
|
||||
SCM_I_MAKINUM (rr)));
|
||||
*qp = scm_i_normbig (q);
|
||||
*rp = SCM_I_MAKINUM (rr);
|
||||
}
|
||||
return;
|
||||
}
|
||||
else if (SCM_BIGP (y))
|
||||
return scm_i_bigint_centered_divide (x, y);
|
||||
return scm_i_bigint_centered_divide (x, y, qp, rp);
|
||||
else if (SCM_REALP (y))
|
||||
return scm_i_inexact_centered_divide
|
||||
(scm_i_big2dbl (x), SCM_REAL_VALUE (y));
|
||||
(scm_i_big2dbl (x), SCM_REAL_VALUE (y), qp, rp);
|
||||
else if (SCM_FRACTIONP (y))
|
||||
return scm_i_slow_exact_centered_divide (x, y);
|
||||
return scm_i_slow_exact_centered_divide (x, y, qp, rp);
|
||||
else
|
||||
SCM_WTA_DISPATCH_2 (g_scm_centered_divide, x, y, SCM_ARG2,
|
||||
s_scm_centered_divide);
|
||||
return two_valued_wta_dispatch_2
|
||||
(g_scm_centered_divide, x, y, SCM_ARG2,
|
||||
s_scm_centered_divide, qp, rp);
|
||||
}
|
||||
else if (SCM_REALP (x))
|
||||
{
|
||||
if (SCM_REALP (y) || SCM_I_INUMP (y) ||
|
||||
SCM_BIGP (y) || SCM_FRACTIONP (y))
|
||||
return scm_i_inexact_centered_divide
|
||||
(SCM_REAL_VALUE (x), scm_to_double (y));
|
||||
(SCM_REAL_VALUE (x), scm_to_double (y), qp, rp);
|
||||
else
|
||||
SCM_WTA_DISPATCH_2 (g_scm_centered_divide, x, y, SCM_ARG2,
|
||||
s_scm_centered_divide);
|
||||
return two_valued_wta_dispatch_2
|
||||
(g_scm_centered_divide, x, y, SCM_ARG2,
|
||||
s_scm_centered_divide, qp, rp);
|
||||
}
|
||||
else if (SCM_FRACTIONP (x))
|
||||
{
|
||||
if (SCM_REALP (y))
|
||||
return scm_i_inexact_centered_divide
|
||||
(scm_i_fraction2double (x), SCM_REAL_VALUE (y));
|
||||
(scm_i_fraction2double (x), SCM_REAL_VALUE (y), qp, rp);
|
||||
else
|
||||
return scm_i_slow_exact_centered_divide (x, y);
|
||||
return scm_i_slow_exact_centered_divide (x, y, qp, rp);
|
||||
}
|
||||
else
|
||||
SCM_WTA_DISPATCH_2 (g_scm_centered_divide, x, y, SCM_ARG1,
|
||||
s_scm_centered_divide);
|
||||
return two_valued_wta_dispatch_2 (g_scm_centered_divide, x, y, SCM_ARG1,
|
||||
s_scm_centered_divide, qp, rp);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
static SCM
|
||||
scm_i_inexact_centered_divide (double x, double y)
|
||||
static void
|
||||
scm_i_inexact_centered_divide (double x, double y, SCM *qp, SCM *rp)
|
||||
{
|
||||
double q, r;
|
||||
|
||||
|
|
@ -2224,14 +2285,14 @@ scm_i_inexact_centered_divide (double x, double y)
|
|||
else
|
||||
q = guile_NaN;
|
||||
r = x - q * y;
|
||||
return scm_values (scm_list_2 (scm_from_double (q),
|
||||
scm_from_double (r)));
|
||||
*qp = scm_from_double (q);
|
||||
*rp = scm_from_double (r);
|
||||
}
|
||||
|
||||
/* Assumes that both x and y are bigints, though
|
||||
x might be able to fit into a fixnum. */
|
||||
static SCM
|
||||
scm_i_bigint_centered_divide (SCM x, SCM y)
|
||||
static void
|
||||
scm_i_bigint_centered_divide (SCM x, SCM y, SCM *qp, SCM *rp)
|
||||
{
|
||||
SCM q, r, min_r;
|
||||
|
||||
|
|
@ -2276,24 +2337,24 @@ scm_i_bigint_centered_divide (SCM x, SCM y)
|
|||
}
|
||||
}
|
||||
scm_remember_upto_here_2 (x, y);
|
||||
return scm_values (scm_list_2 (scm_i_normbig (q),
|
||||
scm_i_normbig (r)));
|
||||
*qp = scm_i_normbig (q);
|
||||
*rp = scm_i_normbig (r);
|
||||
}
|
||||
|
||||
/* Compute exact centered quotient and remainder the slow way.
|
||||
We use this only if both arguments are exact,
|
||||
and at least one of them is a fraction */
|
||||
static SCM
|
||||
scm_i_slow_exact_centered_divide (SCM x, SCM y)
|
||||
static void
|
||||
scm_i_slow_exact_centered_divide (SCM x, SCM y, SCM *qp, SCM *rp)
|
||||
{
|
||||
SCM q, r;
|
||||
SCM q;
|
||||
|
||||
if (!(SCM_I_INUMP (x) || SCM_BIGP (x) || SCM_FRACTIONP (x)))
|
||||
SCM_WTA_DISPATCH_2 (g_scm_centered_divide, x, y, SCM_ARG1,
|
||||
s_scm_centered_divide);
|
||||
return two_valued_wta_dispatch_2 (g_scm_centered_divide, x, y, SCM_ARG1,
|
||||
s_scm_centered_divide, qp, rp);
|
||||
else if (!(SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y)))
|
||||
SCM_WTA_DISPATCH_2 (g_scm_centered_divide, x, y, SCM_ARG2,
|
||||
s_scm_centered_divide);
|
||||
return two_valued_wta_dispatch_2 (g_scm_centered_divide, x, y, SCM_ARG2,
|
||||
s_scm_centered_divide, qp, rp);
|
||||
else if (scm_is_true (scm_positive_p (y)))
|
||||
q = scm_floor (scm_sum (scm_divide (x, y),
|
||||
exactly_one_half));
|
||||
|
|
@ -2302,8 +2363,8 @@ scm_i_slow_exact_centered_divide (SCM x, SCM y)
|
|||
exactly_one_half));
|
||||
else
|
||||
scm_num_overflow (s_scm_centered_divide);
|
||||
r = scm_difference (x, scm_product (q, y));
|
||||
return scm_values (scm_list_2 (q, r));
|
||||
*qp = q;
|
||||
*rp = scm_difference (x, scm_product (q, y));
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -178,10 +178,10 @@ SCM_API SCM scm_abs (SCM x);
|
|||
SCM_API SCM scm_quotient (SCM x, SCM y);
|
||||
SCM_API SCM scm_remainder (SCM x, SCM y);
|
||||
SCM_API SCM scm_modulo (SCM x, SCM y);
|
||||
SCM_API SCM scm_euclidean_divide (SCM x, SCM y);
|
||||
SCM_API void scm_euclidean_divide (SCM x, SCM y, SCM *q, SCM *r);
|
||||
SCM_API SCM scm_euclidean_quotient (SCM x, SCM y);
|
||||
SCM_API SCM scm_euclidean_remainder (SCM x, SCM y);
|
||||
SCM_API SCM scm_centered_divide (SCM x, SCM y);
|
||||
SCM_API void scm_centered_divide (SCM x, SCM y, SCM *q, SCM *r);
|
||||
SCM_API SCM scm_centered_quotient (SCM x, SCM y);
|
||||
SCM_API SCM scm_centered_remainder (SCM x, SCM y);
|
||||
SCM_API SCM scm_gcd (SCM x, SCM y);
|
||||
|
|
@ -199,6 +199,9 @@ SCM_API SCM scm_bit_extract (SCM n, SCM start, SCM end);
|
|||
SCM_API SCM scm_logcount (SCM n);
|
||||
SCM_API SCM scm_integer_length (SCM n);
|
||||
|
||||
SCM_INTERNAL SCM scm_i_euclidean_divide (SCM x, SCM y);
|
||||
SCM_INTERNAL SCM scm_i_centered_divide (SCM x, SCM y);
|
||||
|
||||
SCM_INTERNAL SCM scm_i_gcd (SCM x, SCM y, SCM rest);
|
||||
SCM_INTERNAL SCM scm_i_lcm (SCM x, SCM y, SCM rest);
|
||||
SCM_INTERNAL SCM scm_i_logand (SCM x, SCM y, SCM rest);
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue