[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. release_1-9-14-146-g2
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. release_1-9-14-146-g2519490 |
|
Date: |
Sun, 30 Jan 2011 22:09:14 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=2519490c50ae063ef27201c5403e80628fff9eeb
The branch, master has been updated
via 2519490c50ae063ef27201c5403e80628fff9eeb (commit)
from ff62c16828d41955455805dd1b427966944b7d27 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 2519490c50ae063ef27201c5403e80628fff9eeb
Author: Mark H Weaver <address@hidden>
Date: Sun Jan 30 09:52:51 2011 -0500
Improve extensibility of core numeric procedures
* libguile/numbers.c (scm_quotient, scm_remainder, scm_modulo,
scm_zero_p, scm_positive_p, scm_negative_p, scm_real_part,
scm_imag_part, scm_numerator, scm_denominator, scm_magnitude,
scm_angle, scm_exact_to_inexact): Change from SCM_GPROC to
SCM_PRIMITIVE_GENERIC. As a side effect, all of these procedures now
have documentation strings.
(scm_exact_p, scm_inexact_p, scm_odd_p, scm_even_p, scm_finite_p,
scm_inf_p, scm_nan_p, scm_expt, scm_inexact_to_exact, scm_log,
scm_log10, scm_exp, scm_sqrt): Change from SCM_DEFINE to
SCM_PRIMITIVE_GENERIC, and make sure the code allows these functions
to be extended in practice.
(scm_real_part, scm_imag_part, scm_numerator, scm_denominator,
scm_inexact_to_exact): Simplify type dispatch code.
(scm_sqrt): Rename formal argument from x to z, since complex numbers
are supported.
(scm_abs): Fix empty FUNC_NAME.
* libguile/numbers.h (scm_finite_p): Add missing prototype.
(scm_inf_p, scm_nan_p): Rename formal parameter from n to x, since
the domain is the real numbers.
* test-suite/tests/numbers.test: Test for documentation strings. Change
from `expect-fail' to `pass-if' for several of these, and add tests
for others. Also add other tests for `real-part' and `imag-part',
which previously had none.
-----------------------------------------------------------------------
Summary of changes:
libguile/numbers.c | 416 ++++++++++++++++++++---------------------
libguile/numbers.h | 5 +-
test-suite/tests/numbers.test | 69 +++++--
3 files changed, 257 insertions(+), 233 deletions(-)
diff --git a/libguile/numbers.c b/libguile/numbers.c
index 4515dc9..3a2244f 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -498,8 +498,8 @@ scm_i_fraction2double (SCM z)
SCM_FRACTION_DENOMINATOR (z)));
}
-SCM_DEFINE (scm_exact_p, "exact?", 1, 0, 0,
- (SCM x),
+SCM_PRIMITIVE_GENERIC (scm_exact_p, "exact?", 1, 0, 0,
+ (SCM x),
"Return @code{#t} if @var{x} is an exact number, @code{#f}\n"
"otherwise.")
#define FUNC_NAME s_scm_exact_p
@@ -509,12 +509,12 @@ SCM_DEFINE (scm_exact_p, "exact?", 1, 0, 0,
else if (SCM_NUMBERP (x))
return SCM_BOOL_T;
else
- SCM_WRONG_TYPE_ARG (1, x);
+ SCM_WTA_DISPATCH_1 (g_scm_exact_p, x, 1, s_scm_exact_p);
}
#undef FUNC_NAME
-SCM_DEFINE (scm_inexact_p, "inexact?", 1, 0, 0,
+SCM_PRIMITIVE_GENERIC (scm_inexact_p, "inexact?", 1, 0, 0,
(SCM x),
"Return @code{#t} if @var{x} is an inexact number, @code{#f}\n"
"else.")
@@ -525,12 +525,12 @@ SCM_DEFINE (scm_inexact_p, "inexact?", 1, 0, 0,
else if (SCM_NUMBERP (x))
return SCM_BOOL_F;
else
- SCM_WRONG_TYPE_ARG (1, x);
+ SCM_WTA_DISPATCH_1 (g_scm_inexact_p, x, 1, s_scm_inexact_p);
}
#undef FUNC_NAME
-SCM_DEFINE (scm_odd_p, "odd?", 1, 0, 0,
+SCM_PRIMITIVE_GENERIC (scm_odd_p, "odd?", 1, 0, 0,
(SCM n),
"Return @code{#t} if @var{n} is an odd number, @code{#f}\n"
"otherwise.")
@@ -547,25 +547,24 @@ SCM_DEFINE (scm_odd_p, "odd?", 1, 0, 0,
scm_remember_upto_here_1 (n);
return scm_from_bool (odd_p);
}
- else if (scm_is_true (scm_inf_p (n)))
- SCM_WRONG_TYPE_ARG (1, n);
else if (SCM_REALP (n))
{
- double rem = fabs (fmod (SCM_REAL_VALUE(n), 2.0));
- if (rem == 1.0)
- return SCM_BOOL_T;
- else if (rem == 0.0)
- return SCM_BOOL_F;
- else
- SCM_WRONG_TYPE_ARG (1, n);
+ double val = SCM_REAL_VALUE (n);
+ if (DOUBLE_IS_FINITE (val))
+ {
+ double rem = fabs (fmod (val, 2.0));
+ if (rem == 1.0)
+ return SCM_BOOL_T;
+ else if (rem == 0.0)
+ return SCM_BOOL_F;
+ }
}
- else
- SCM_WRONG_TYPE_ARG (1, n);
+ SCM_WTA_DISPATCH_1 (g_scm_odd_p, n, 1, s_scm_odd_p);
}
#undef FUNC_NAME
-SCM_DEFINE (scm_even_p, "even?", 1, 0, 0,
+SCM_PRIMITIVE_GENERIC (scm_even_p, "even?", 1, 0, 0,
(SCM n),
"Return @code{#t} if @var{n} is an even number, @code{#f}\n"
"otherwise.")
@@ -582,25 +581,24 @@ SCM_DEFINE (scm_even_p, "even?", 1, 0, 0,
scm_remember_upto_here_1 (n);
return scm_from_bool (even_p);
}
- else if (scm_is_true (scm_inf_p (n)))
- SCM_WRONG_TYPE_ARG (1, n);
else if (SCM_REALP (n))
{
- double rem = fabs (fmod (SCM_REAL_VALUE(n), 2.0));
- if (rem == 1.0)
- return SCM_BOOL_F;
- else if (rem == 0.0)
- return SCM_BOOL_T;
- else
- SCM_WRONG_TYPE_ARG (1, n);
+ double val = SCM_REAL_VALUE (n);
+ if (DOUBLE_IS_FINITE (val))
+ {
+ double rem = fabs (fmod (val, 2.0));
+ if (rem == 1.0)
+ return SCM_BOOL_F;
+ else if (rem == 0.0)
+ return SCM_BOOL_T;
+ }
}
- else
- SCM_WRONG_TYPE_ARG (1, n);
+ SCM_WTA_DISPATCH_1 (g_scm_even_p, n, 1, s_scm_even_p);
}
#undef FUNC_NAME
-SCM_DEFINE (scm_finite_p, "finite?", 1, 0, 0,
- (SCM x),
+SCM_PRIMITIVE_GENERIC (scm_finite_p, "finite?", 1, 0, 0,
+ (SCM x),
"Return @code{#t} if the real number @var{x} is neither\n"
"infinite nor a NaN, @code{#f} otherwise.")
#define FUNC_NAME s_scm_finite_p
@@ -610,14 +608,14 @@ SCM_DEFINE (scm_finite_p, "finite?", 1, 0, 0,
else if (scm_is_real (x))
return SCM_BOOL_T;
else
- SCM_WRONG_TYPE_ARG (1, x);
+ SCM_WTA_DISPATCH_1 (g_scm_finite_p, x, 1, s_scm_finite_p);
}
#undef FUNC_NAME
-SCM_DEFINE (scm_inf_p, "inf?", 1, 0, 0,
- (SCM x),
- "Return @code{#t} if the real number @var{x} is @samp{+inf.0} or\n"
- "@samp{-inf.0}. Otherwise return @code{#f}.")
+SCM_PRIMITIVE_GENERIC (scm_inf_p, "inf?", 1, 0, 0,
+ (SCM x),
+ "Return @code{#t} if the real number @var{x} is @samp{+inf.0} or\n"
+ "@samp{-inf.0}. Otherwise return @code{#f}.")
#define FUNC_NAME s_scm_inf_p
{
if (SCM_REALP (x))
@@ -625,12 +623,12 @@ SCM_DEFINE (scm_inf_p, "inf?", 1, 0, 0,
else if (scm_is_real (x))
return SCM_BOOL_F;
else
- SCM_WRONG_TYPE_ARG (1, x);
+ SCM_WTA_DISPATCH_1 (g_scm_inf_p, x, 1, s_scm_inf_p);
}
#undef FUNC_NAME
-SCM_DEFINE (scm_nan_p, "nan?", 1, 0, 0,
- (SCM x),
+SCM_PRIMITIVE_GENERIC (scm_nan_p, "nan?", 1, 0, 0,
+ (SCM x),
"Return @code{#t} if the real number @var{x} is a NaN,\n"
"or @code{#f} otherwise.")
#define FUNC_NAME s_scm_nan_p
@@ -640,7 +638,7 @@ SCM_DEFINE (scm_nan_p, "nan?", 1, 0, 0,
else if (scm_is_real (x))
return SCM_BOOL_F;
else
- SCM_WRONG_TYPE_ARG (1, x);
+ SCM_WTA_DISPATCH_1 (g_scm_nan_p, x, 1, s_scm_nan_p);
}
#undef FUNC_NAME
@@ -727,7 +725,7 @@ SCM_DEFINE (scm_nan, "nan", 0, 0, 0,
SCM_PRIMITIVE_GENERIC (scm_abs, "abs", 1, 0, 0,
(SCM x),
"Return the absolute value of @var{x}.")
-#define FUNC_NAME
+#define FUNC_NAME s_scm_abs
{
if (SCM_I_INUMP (x))
{
@@ -769,11 +767,10 @@ SCM_PRIMITIVE_GENERIC (scm_abs, "abs", 1, 0, 0,
#undef FUNC_NAME
-SCM_GPROC (s_quotient, "quotient", 2, 0, 0, scm_quotient, g_quotient);
-/* "Return the quotient of the numbers @var{x} and @var{y}."
- */
-SCM
-scm_quotient (SCM x, SCM y)
+SCM_PRIMITIVE_GENERIC (scm_quotient, "quotient", 2, 0, 0,
+ (SCM x, SCM y),
+ "Return the quotient of the numbers @var{x} and @var{y}.")
+#define FUNC_NAME s_scm_quotient
{
if (SCM_LIKELY (SCM_I_INUMP (x)))
{
@@ -782,7 +779,7 @@ scm_quotient (SCM x, SCM y)
{
scm_t_inum yy = SCM_I_INUM (y);
if (SCM_UNLIKELY (yy == 0))
- scm_num_overflow (s_quotient);
+ scm_num_overflow (s_scm_quotient);
else
{
scm_t_inum z = xx / yy;
@@ -806,7 +803,7 @@ scm_quotient (SCM x, SCM y)
return SCM_INUM0;
}
else
- SCM_WTA_DISPATCH_2 (g_quotient, x, y, SCM_ARG2, s_quotient);
+ SCM_WTA_DISPATCH_2 (g_scm_quotient, x, y, SCM_ARG2, s_scm_quotient);
}
else if (SCM_BIGP (x))
{
@@ -814,7 +811,7 @@ scm_quotient (SCM x, SCM y)
{
scm_t_inum yy = SCM_I_INUM (y);
if (SCM_UNLIKELY (yy == 0))
- scm_num_overflow (s_quotient);
+ scm_num_overflow (s_scm_quotient);
else if (SCM_UNLIKELY (yy == 1))
return x;
else
@@ -843,21 +840,21 @@ scm_quotient (SCM x, SCM y)
return scm_i_normbig (result);
}
else
- SCM_WTA_DISPATCH_2 (g_quotient, x, y, SCM_ARG2, s_quotient);
+ SCM_WTA_DISPATCH_2 (g_scm_quotient, x, y, SCM_ARG2, s_scm_quotient);
}
else
- SCM_WTA_DISPATCH_2 (g_quotient, x, y, SCM_ARG1, s_quotient);
+ SCM_WTA_DISPATCH_2 (g_scm_quotient, x, y, SCM_ARG1, s_scm_quotient);
}
+#undef FUNC_NAME
-SCM_GPROC (s_remainder, "remainder", 2, 0, 0, scm_remainder, g_remainder);
-/* "Return the remainder of the numbers @var{x} and @var{y}.\n"
- * "@lisp\n"
- * "(remainder 13 4) @result{} 1\n"
- * "(remainder -13 4) @result{} -1\n"
- * "@end lisp"
- */
-SCM
-scm_remainder (SCM x, SCM y)
+SCM_PRIMITIVE_GENERIC (scm_remainder, "remainder", 2, 0, 0,
+ (SCM x, SCM y),
+ "Return the remainder of the numbers @var{x} and @var{y}.\n"
+ "@lisp\n"
+ "(remainder 13 4) @result{} 1\n"
+ "(remainder -13 4) @result{} -1\n"
+ "@end lisp")
+#define FUNC_NAME s_scm_remainder
{
if (SCM_LIKELY (SCM_I_INUMP (x)))
{
@@ -865,7 +862,7 @@ scm_remainder (SCM x, SCM y)
{
scm_t_inum yy = SCM_I_INUM (y);
if (SCM_UNLIKELY (yy == 0))
- scm_num_overflow (s_remainder);
+ scm_num_overflow (s_scm_remainder);
else
{
/* C99 specifies that "%" is the remainder corresponding to a
@@ -889,7 +886,7 @@ scm_remainder (SCM x, SCM y)
return x;
}
else
- SCM_WTA_DISPATCH_2 (g_remainder, x, y, SCM_ARG2, s_remainder);
+ SCM_WTA_DISPATCH_2 (g_scm_remainder, x, y, SCM_ARG2, s_scm_remainder);
}
else if (SCM_BIGP (x))
{
@@ -897,7 +894,7 @@ scm_remainder (SCM x, SCM y)
{
scm_t_inum yy = SCM_I_INUM (y);
if (SCM_UNLIKELY (yy == 0))
- scm_num_overflow (s_remainder);
+ scm_num_overflow (s_scm_remainder);
else
{
SCM result = scm_i_mkbig ();
@@ -918,22 +915,22 @@ scm_remainder (SCM x, SCM y)
return scm_i_normbig (result);
}
else
- SCM_WTA_DISPATCH_2 (g_remainder, x, y, SCM_ARG2, s_remainder);
+ SCM_WTA_DISPATCH_2 (g_scm_remainder, x, y, SCM_ARG2, s_scm_remainder);
}
else
- SCM_WTA_DISPATCH_2 (g_remainder, x, y, SCM_ARG1, s_remainder);
+ SCM_WTA_DISPATCH_2 (g_scm_remainder, x, y, SCM_ARG1, s_scm_remainder);
}
+#undef FUNC_NAME
-SCM_GPROC (s_modulo, "modulo", 2, 0, 0, scm_modulo, g_modulo);
-/* "Return the modulo of the numbers @var{x} and @var{y}.\n"
- * "@lisp\n"
- * "(modulo 13 4) @result{} 1\n"
- * "(modulo -13 4) @result{} 3\n"
- * "@end lisp"
- */
-SCM
-scm_modulo (SCM x, SCM y)
+SCM_PRIMITIVE_GENERIC (scm_modulo, "modulo", 2, 0, 0,
+ (SCM x, SCM y),
+ "Return the modulo of the numbers @var{x} and @var{y}.\n"
+ "@lisp\n"
+ "(modulo 13 4) @result{} 1\n"
+ "(modulo -13 4) @result{} 3\n"
+ "@end lisp")
+#define FUNC_NAME s_scm_modulo
{
if (SCM_LIKELY (SCM_I_INUMP (x)))
{
@@ -942,7 +939,7 @@ scm_modulo (SCM x, SCM y)
{
scm_t_inum yy = SCM_I_INUM (y);
if (SCM_UNLIKELY (yy == 0))
- scm_num_overflow (s_modulo);
+ scm_num_overflow (s_scm_modulo);
else
{
/* C99 specifies that "%" is the remainder corresponding to a
@@ -1008,7 +1005,7 @@ scm_modulo (SCM x, SCM y)
}
}
else
- SCM_WTA_DISPATCH_2 (g_modulo, x, y, SCM_ARG2, s_modulo);
+ SCM_WTA_DISPATCH_2 (g_scm_modulo, x, y, SCM_ARG2, s_scm_modulo);
}
else if (SCM_BIGP (x))
{
@@ -1016,7 +1013,7 @@ scm_modulo (SCM x, SCM y)
{
scm_t_inum yy = SCM_I_INUM (y);
if (SCM_UNLIKELY (yy == 0))
- scm_num_overflow (s_modulo);
+ scm_num_overflow (s_scm_modulo);
else
{
SCM result = scm_i_mkbig ();
@@ -1049,11 +1046,12 @@ scm_modulo (SCM x, SCM y)
return scm_i_normbig (result);
}
else
- SCM_WTA_DISPATCH_2 (g_modulo, x, y, SCM_ARG2, s_modulo);
+ SCM_WTA_DISPATCH_2 (g_scm_modulo, x, y, SCM_ARG2, s_scm_modulo);
}
else
- SCM_WTA_DISPATCH_2 (g_modulo, x, y, SCM_ARG1, s_modulo);
+ SCM_WTA_DISPATCH_2 (g_scm_modulo, x, y, SCM_ARG1, s_scm_modulo);
}
+#undef FUNC_NAME
static SCM scm_i_inexact_euclidean_quotient (double x, double y);
static SCM scm_i_slow_exact_euclidean_quotient (SCM x, SCM y);
@@ -3036,8 +3034,9 @@ SCM_DEFINE (scm_integer_expt, "integer-expt", 2, 0, 0,
"Return @var{n} raised to the power @var{k}. @var{k} must be an\n"
"exact integer, @var{n} can be any number.\n"
"\n"
- "Negative @var{k} is supported, and results in @math{1/n^abs(k)}\n"
- "in the usual way. @address@hidden is 1, as usual, and that\n"
+ "Negative @var{k} is supported, and results in\n"
+ "@math{1/@var{n}^abs(@var{k})} in the usual way.\n"
+ "@address@hidden is 1, as usual, and that\n"
"includes @math{0^0} is 1.\n"
"\n"
"@lisp\n"
@@ -5020,12 +5019,11 @@ scm_geq_p (SCM x, SCM y)
#undef FUNC_NAME
-SCM_GPROC (s_zero_p, "zero?", 1, 0, 0, scm_zero_p, g_zero_p);
-/* "Return @code{#t} if @var{z} is an exact or inexact number equal to\n"
- * "zero."
- */
-SCM
-scm_zero_p (SCM z)
+SCM_PRIMITIVE_GENERIC (scm_zero_p, "zero?", 1, 0, 0,
+ (SCM z),
+ "Return @code{#t} if @var{z} is an exact or inexact number equal to\n"
+ "zero.")
+#define FUNC_NAME s_scm_zero_p
{
if (SCM_I_INUMP (z))
return scm_from_bool (scm_is_eq (z, SCM_INUM0));
@@ -5039,16 +5037,16 @@ scm_zero_p (SCM z)
else if (SCM_FRACTIONP (z))
return SCM_BOOL_F;
else
- SCM_WTA_DISPATCH_1 (g_zero_p, z, SCM_ARG1, s_zero_p);
+ SCM_WTA_DISPATCH_1 (g_scm_zero_p, z, SCM_ARG1, s_scm_zero_p);
}
+#undef FUNC_NAME
-SCM_GPROC (s_positive_p, "positive?", 1, 0, 0, scm_positive_p, g_positive_p);
-/* "Return @code{#t} if @var{x} is an exact or inexact number greater than\n"
- * "zero."
- */
-SCM
-scm_positive_p (SCM x)
+SCM_PRIMITIVE_GENERIC (scm_positive_p, "positive?", 1, 0, 0,
+ (SCM x),
+ "Return @code{#t} if @var{x} is an exact or inexact number greater
than\n"
+ "zero.")
+#define FUNC_NAME s_scm_positive_p
{
if (SCM_I_INUMP (x))
return scm_from_bool (SCM_I_INUM (x) > 0);
@@ -5063,16 +5061,16 @@ scm_positive_p (SCM x)
else if (SCM_FRACTIONP (x))
return scm_positive_p (SCM_FRACTION_NUMERATOR (x));
else
- SCM_WTA_DISPATCH_1 (g_positive_p, x, SCM_ARG1, s_positive_p);
+ SCM_WTA_DISPATCH_1 (g_scm_positive_p, x, SCM_ARG1, s_scm_positive_p);
}
+#undef FUNC_NAME
-SCM_GPROC (s_negative_p, "negative?", 1, 0, 0, scm_negative_p, g_negative_p);
-/* "Return @code{#t} if @var{x} is an exact or inexact number less than\n"
- * "zero."
- */
-SCM
-scm_negative_p (SCM x)
+SCM_PRIMITIVE_GENERIC (scm_negative_p, "negative?", 1, 0, 0,
+ (SCM x),
+ "Return @code{#t} if @var{x} is an exact or inexact number less than\n"
+ "zero.")
+#define FUNC_NAME s_scm_negative_p
{
if (SCM_I_INUMP (x))
return scm_from_bool (SCM_I_INUM (x) < 0);
@@ -5087,8 +5085,9 @@ scm_negative_p (SCM x)
else if (SCM_FRACTIONP (x))
return scm_negative_p (SCM_FRACTION_NUMERATOR (x));
else
- SCM_WTA_DISPATCH_1 (g_negative_p, x, SCM_ARG1, s_negative_p);
+ SCM_WTA_DISPATCH_1 (g_scm_negative_p, x, SCM_ARG1, s_scm_negative_p);
}
+#undef FUNC_NAME
/* scm_min and scm_max return an inexact when either argument is inexact, as
@@ -6677,9 +6676,9 @@ SCM_PRIMITIVE_GENERIC (scm_ceiling, "ceiling", 1, 0, 0,
Written by Jerry D. Hedden, (C) FSF.
See the file `COPYING' for terms applying to this program. */
-SCM_DEFINE (scm_expt, "expt", 2, 0, 0,
- (SCM x, SCM y),
- "Return @var{x} raised to the power of @var{y}.")
+SCM_PRIMITIVE_GENERIC (scm_expt, "expt", 2, 0, 0,
+ (SCM x, SCM y),
+ "Return @var{x} raised to the power of @var{y}.")
#define FUNC_NAME s_scm_expt
{
if (scm_is_integer (y))
@@ -6709,8 +6708,12 @@ SCM_DEFINE (scm_expt, "expt", 2, 0, 0,
{
return scm_from_double (pow (scm_to_double (x), scm_to_double (y)));
}
- else
+ else if (scm_is_complex (x) && scm_is_complex (y))
return scm_exp (scm_product (scm_log (x), y));
+ else if (scm_is_complex (x))
+ SCM_WTA_DISPATCH_2 (g_scm_expt, x, y, SCM_ARG2, s_scm_expt);
+ else
+ SCM_WTA_DISPATCH_2 (g_scm_expt, x, y, SCM_ARG1, s_scm_expt);
}
#undef FUNC_NAME
@@ -7036,90 +7039,76 @@ SCM_DEFINE (scm_make_polar, "make-polar", 2, 0, 0,
#undef FUNC_NAME
-SCM_GPROC (s_real_part, "real-part", 1, 0, 0, scm_real_part, g_real_part);
-/* "Return the real part of the number @var{z}."
- */
-SCM
-scm_real_part (SCM z)
+SCM_PRIMITIVE_GENERIC (scm_real_part, "real-part", 1, 0, 0,
+ (SCM z),
+ "Return the real part of the number @var{z}.")
+#define FUNC_NAME s_scm_real_part
{
- if (SCM_I_INUMP (z))
- return z;
- else if (SCM_BIGP (z))
- return z;
- else if (SCM_REALP (z))
- return z;
- else if (SCM_COMPLEXP (z))
+ if (SCM_COMPLEXP (z))
return scm_from_double (SCM_COMPLEX_REAL (z));
- else if (SCM_FRACTIONP (z))
+ else if (SCM_I_INUMP (z) || SCM_BIGP (z) || SCM_REALP (z) || SCM_FRACTIONP
(z))
return z;
else
- SCM_WTA_DISPATCH_1 (g_real_part, z, SCM_ARG1, s_real_part);
+ SCM_WTA_DISPATCH_1 (g_scm_real_part, z, SCM_ARG1, s_scm_real_part);
}
+#undef FUNC_NAME
-SCM_GPROC (s_imag_part, "imag-part", 1, 0, 0, scm_imag_part, g_imag_part);
-/* "Return the imaginary part of the number @var{z}."
- */
-SCM
-scm_imag_part (SCM z)
+SCM_PRIMITIVE_GENERIC (scm_imag_part, "imag-part", 1, 0, 0,
+ (SCM z),
+ "Return the imaginary part of the number @var{z}.")
+#define FUNC_NAME s_scm_imag_part
{
- if (SCM_I_INUMP (z))
- return SCM_INUM0;
- else if (SCM_BIGP (z))
- return SCM_INUM0;
+ if (SCM_COMPLEXP (z))
+ return scm_from_double (SCM_COMPLEX_IMAG (z));
else if (SCM_REALP (z))
return flo0;
- else if (SCM_COMPLEXP (z))
- return scm_from_double (SCM_COMPLEX_IMAG (z));
- else if (SCM_FRACTIONP (z))
+ else if (SCM_I_INUMP (z) || SCM_BIGP (z) || SCM_FRACTIONP (z))
return SCM_INUM0;
else
- SCM_WTA_DISPATCH_1 (g_imag_part, z, SCM_ARG1, s_imag_part);
+ SCM_WTA_DISPATCH_1 (g_scm_imag_part, z, SCM_ARG1, s_scm_imag_part);
}
+#undef FUNC_NAME
-SCM_GPROC (s_numerator, "numerator", 1, 0, 0, scm_numerator, g_numerator);
-/* "Return the numerator of the number @var{z}."
- */
-SCM
-scm_numerator (SCM z)
+SCM_PRIMITIVE_GENERIC (scm_numerator, "numerator", 1, 0, 0,
+ (SCM z),
+ "Return the numerator of the number @var{z}.")
+#define FUNC_NAME s_scm_numerator
{
- if (SCM_I_INUMP (z))
- return z;
- else if (SCM_BIGP (z))
+ if (SCM_I_INUMP (z) || SCM_BIGP (z))
return z;
else if (SCM_FRACTIONP (z))
return SCM_FRACTION_NUMERATOR (z);
else if (SCM_REALP (z))
return scm_exact_to_inexact (scm_numerator (scm_inexact_to_exact (z)));
else
- SCM_WTA_DISPATCH_1 (g_numerator, z, SCM_ARG1, s_numerator);
+ SCM_WTA_DISPATCH_1 (g_scm_numerator, z, SCM_ARG1, s_scm_numerator);
}
+#undef FUNC_NAME
-SCM_GPROC (s_denominator, "denominator", 1, 0, 0, scm_denominator,
g_denominator);
-/* "Return the denominator of the number @var{z}."
- */
-SCM
-scm_denominator (SCM z)
+SCM_PRIMITIVE_GENERIC (scm_denominator, "denominator", 1, 0, 0,
+ (SCM z),
+ "Return the denominator of the number @var{z}.")
+#define FUNC_NAME s_scm_denominator
{
- if (SCM_I_INUMP (z))
- return SCM_INUM1;
- else if (SCM_BIGP (z))
+ if (SCM_I_INUMP (z) || SCM_BIGP (z))
return SCM_INUM1;
else if (SCM_FRACTIONP (z))
return SCM_FRACTION_DENOMINATOR (z);
else if (SCM_REALP (z))
return scm_exact_to_inexact (scm_denominator (scm_inexact_to_exact (z)));
else
- SCM_WTA_DISPATCH_1 (g_denominator, z, SCM_ARG1, s_denominator);
+ SCM_WTA_DISPATCH_1 (g_scm_denominator, z, SCM_ARG1, s_scm_denominator);
}
+#undef FUNC_NAME
-SCM_GPROC (s_magnitude, "magnitude", 1, 0, 0, scm_magnitude, g_magnitude);
-/* "Return the magnitude of the number @var{z}. This is the same as\n"
- * "@code{abs} for real arguments, but also allows complex numbers."
- */
-SCM
-scm_magnitude (SCM z)
+
+SCM_PRIMITIVE_GENERIC (scm_magnitude, "magnitude", 1, 0, 0,
+ (SCM z),
+ "Return the magnitude of the number @var{z}. This is the same as\n"
+ "@code{abs} for real arguments, but also allows complex numbers.")
+#define FUNC_NAME s_scm_magnitude
{
if (SCM_I_INUMP (z))
{
@@ -7152,15 +7141,15 @@ scm_magnitude (SCM z)
SCM_FRACTION_DENOMINATOR (z));
}
else
- SCM_WTA_DISPATCH_1 (g_magnitude, z, SCM_ARG1, s_magnitude);
+ SCM_WTA_DISPATCH_1 (g_scm_magnitude, z, SCM_ARG1, s_scm_magnitude);
}
+#undef FUNC_NAME
-SCM_GPROC (s_angle, "angle", 1, 0, 0, scm_angle, g_angle);
-/* "Return the angle of the complex number @var{z}."
- */
-SCM
-scm_angle (SCM z)
+SCM_PRIMITIVE_GENERIC (scm_angle, "angle", 1, 0, 0,
+ (SCM z),
+ "Return the angle of the complex number @var{z}.")
+#define FUNC_NAME s_scm_angle
{
/* atan(0,-1) is pi and it'd be possible to have that as a constant like
flo0 to save allocating a new flonum with scm_from_double each time.
@@ -7198,15 +7187,15 @@ scm_angle (SCM z)
else return scm_from_double (atan2 (0.0, -1.0));
}
else
- SCM_WTA_DISPATCH_1 (g_angle, z, SCM_ARG1, s_angle);
+ SCM_WTA_DISPATCH_1 (g_scm_angle, z, SCM_ARG1, s_scm_angle);
}
+#undef FUNC_NAME
-SCM_GPROC (s_exact_to_inexact, "exact->inexact", 1, 0, 0,
scm_exact_to_inexact, g_exact_to_inexact);
-/* Convert the number @var{x} to its inexact representation.\n"
- */
-SCM
-scm_exact_to_inexact (SCM z)
+SCM_PRIMITIVE_GENERIC (scm_exact_to_inexact, "exact->inexact", 1, 0, 0,
+ (SCM z),
+ "Convert the number @var{z} to its inexact representation.\n")
+#define FUNC_NAME s_scm_exact_to_inexact
{
if (SCM_I_INUMP (z))
return scm_from_double ((double) SCM_I_INUM (z));
@@ -7217,22 +7206,21 @@ scm_exact_to_inexact (SCM z)
else if (SCM_INEXACTP (z))
return z;
else
- SCM_WTA_DISPATCH_1 (g_exact_to_inexact, z, 1, s_exact_to_inexact);
+ SCM_WTA_DISPATCH_1 (g_scm_exact_to_inexact, z, 1, s_scm_exact_to_inexact);
}
+#undef FUNC_NAME
-SCM_DEFINE (scm_inexact_to_exact, "inexact->exact", 1, 0, 0,
- (SCM z),
- "Return an exact number that is numerically closest to @var{z}.")
+SCM_PRIMITIVE_GENERIC (scm_inexact_to_exact, "inexact->exact", 1, 0, 0,
+ (SCM z),
+ "Return an exact number that is numerically closest to @var{z}.")
#define FUNC_NAME s_scm_inexact_to_exact
{
- if (SCM_I_INUMP (z))
- return z;
- else if (SCM_BIGP (z))
+ if (SCM_I_INUMP (z) || SCM_BIGP (z))
return z;
else if (SCM_REALP (z))
{
- if (isinf (SCM_REAL_VALUE (z)) || isnan (SCM_REAL_VALUE (z)))
+ if (!DOUBLE_IS_FINITE (SCM_REAL_VALUE (z)))
SCM_OUT_OF_RANGE (1, z);
else
{
@@ -7254,7 +7242,7 @@ SCM_DEFINE (scm_inexact_to_exact, "inexact->exact", 1, 0,
0,
else if (SCM_FRACTIONP (z))
return z;
else
- SCM_WRONG_TYPE_ARG (1, z);
+ SCM_WTA_DISPATCH_1 (g_scm_inexact_to_exact, z, 1, s_scm_inexact_to_exact);
}
#undef FUNC_NAME
@@ -7694,9 +7682,9 @@ scm_is_number (SCM z)
real-only case, and because we have to test SCM_COMPLEXP anyway so may as
well use it to go straight to the applicable C func. */
-SCM_DEFINE (scm_log, "log", 1, 0, 0,
- (SCM z),
- "Return the natural logarithm of @var{z}.")
+SCM_PRIMITIVE_GENERIC (scm_log, "log", 1, 0, 0,
+ (SCM z),
+ "Return the natural logarithm of @var{z}.")
#define FUNC_NAME s_scm_log
{
if (SCM_COMPLEXP (z))
@@ -7710,7 +7698,7 @@ SCM_DEFINE (scm_log, "log", 1, 0, 0,
atan2 (im, re));
#endif
}
- else
+ else if (SCM_NUMBERP (z))
{
/* ENHANCE-ME: When z is a bignum the logarithm will fit a double
although the value itself overflows. */
@@ -7721,13 +7709,15 @@ SCM_DEFINE (scm_log, "log", 1, 0, 0,
else
return scm_c_make_rectangular (l, M_PI);
}
+ else
+ SCM_WTA_DISPATCH_1 (g_scm_log, z, 1, s_scm_log);
}
#undef FUNC_NAME
-SCM_DEFINE (scm_log10, "log10", 1, 0, 0,
- (SCM z),
- "Return the base 10 logarithm of @var{z}.")
+SCM_PRIMITIVE_GENERIC (scm_log10, "log10", 1, 0, 0,
+ (SCM z),
+ "Return the base 10 logarithm of @var{z}.")
#define FUNC_NAME s_scm_log10
{
if (SCM_COMPLEXP (z))
@@ -7745,7 +7735,7 @@ SCM_DEFINE (scm_log10, "log10", 1, 0, 0,
M_LOG10E * atan2 (im, re));
#endif
}
- else
+ else if (SCM_NUMBERP (z))
{
/* ENHANCE-ME: When z is a bignum the logarithm will fit a double
although the value itself overflows. */
@@ -7756,14 +7746,16 @@ SCM_DEFINE (scm_log10, "log10", 1, 0, 0,
else
return scm_c_make_rectangular (l, M_LOG10E * M_PI);
}
+ else
+ SCM_WTA_DISPATCH_1 (g_scm_log10, z, 1, s_scm_log10);
}
#undef FUNC_NAME
-SCM_DEFINE (scm_exp, "exp", 1, 0, 0,
- (SCM z),
- "Return @math{e} to the power of @var{z}, where @math{e} is the\n"
- "base of natural logarithms (address@hidden).")
+SCM_PRIMITIVE_GENERIC (scm_exp, "exp", 1, 0, 0,
+ (SCM z),
+ "Return @math{e} to the power of @var{z}, where @math{e} is the\n"
+ "base of natural logarithms (address@hidden).")
#define FUNC_NAME s_scm_exp
{
if (SCM_COMPLEXP (z))
@@ -7775,51 +7767,55 @@ SCM_DEFINE (scm_exp, "exp", 1, 0, 0,
SCM_COMPLEX_IMAG (z));
#endif
}
- else
+ else if (SCM_NUMBERP (z))
{
/* When z is a negative bignum the conversion to double overflows,
giving -infinity, but that's ok, the exp is still 0.0. */
return scm_from_double (exp (scm_to_double (z)));
}
+ else
+ SCM_WTA_DISPATCH_1 (g_scm_exp, z, 1, s_scm_exp);
}
#undef FUNC_NAME
-SCM_DEFINE (scm_sqrt, "sqrt", 1, 0, 0,
- (SCM x),
- "Return the square root of @var{z}. Of the two possible roots\n"
- "(positive and negative), the one with the a positive real part\n"
- "is returned, or if that's zero then a positive imaginary part.\n"
- "Thus,\n"
- "\n"
- "@example\n"
- "(sqrt 9.0) @result{} 3.0\n"
- "(sqrt -9.0) @result{} 0.0+3.0i\n"
- "(sqrt 1.0+1.0i) @result{} 1.09868411346781+0.455089860562227i\n"
- "(sqrt -1.0-1.0i) @result{} 0.455089860562227-1.09868411346781i\n"
- "@end example")
+SCM_PRIMITIVE_GENERIC (scm_sqrt, "sqrt", 1, 0, 0,
+ (SCM z),
+ "Return the square root of @var{z}. Of the two possible roots\n"
+ "(positive and negative), the one with the a positive real part\n"
+ "is returned, or if that's zero then a positive imaginary part.\n"
+ "Thus,\n"
+ "\n"
+ "@example\n"
+ "(sqrt 9.0) @result{} 3.0\n"
+ "(sqrt -9.0) @result{} 0.0+3.0i\n"
+ "(sqrt 1.0+1.0i) @result{} 1.09868411346781+0.455089860562227i\n"
+ "(sqrt -1.0-1.0i) @result{} 0.455089860562227-1.09868411346781i\n"
+ "@end example")
#define FUNC_NAME s_scm_sqrt
{
- if (SCM_COMPLEXP (x))
+ if (SCM_COMPLEXP (z))
{
#if defined HAVE_COMPLEX_DOUBLE && defined HAVE_USABLE_CSQRT \
&& defined SCM_COMPLEX_VALUE
- return scm_from_complex_double (csqrt (SCM_COMPLEX_VALUE (x)));
+ return scm_from_complex_double (csqrt (SCM_COMPLEX_VALUE (z)));
#else
- double re = SCM_COMPLEX_REAL (x);
- double im = SCM_COMPLEX_IMAG (x);
+ double re = SCM_COMPLEX_REAL (z);
+ double im = SCM_COMPLEX_IMAG (z);
return scm_c_make_polar (sqrt (hypot (re, im)),
0.5 * atan2 (im, re));
#endif
}
- else
+ else if (SCM_NUMBERP (z))
{
- double xx = scm_to_double (x);
+ double xx = scm_to_double (z);
if (xx < 0)
return scm_c_make_rectangular (0.0, sqrt (-xx));
else
return scm_from_double (sqrt (xx));
}
+ else
+ SCM_WTA_DISPATCH_1 (g_scm_sqrt, z, 1, s_scm_sqrt);
}
#undef FUNC_NAME
diff --git a/libguile/numbers.h b/libguile/numbers.h
index 76d2972..2cf3fd7 100644
--- a/libguile/numbers.h
+++ b/libguile/numbers.h
@@ -169,8 +169,9 @@ typedef struct scm_t_complex
SCM_API SCM scm_exact_p (SCM x);
SCM_API SCM scm_odd_p (SCM n);
SCM_API SCM scm_even_p (SCM n);
-SCM_API SCM scm_inf_p (SCM n);
-SCM_API SCM scm_nan_p (SCM n);
+SCM_API SCM scm_finite_p (SCM x);
+SCM_API SCM scm_inf_p (SCM x);
+SCM_API SCM scm_nan_p (SCM x);
SCM_API SCM scm_inf (void);
SCM_API SCM scm_nan (void);
SCM_API SCM scm_abs (SCM x);
diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test
index 9cf9202..01bccda 100644
--- a/test-suite/tests/numbers.test
+++ b/test-suite/tests/numbers.test
@@ -281,8 +281,7 @@
;;;
(with-test-prefix "exp"
- (pass-if "documented?"
- (documented? exp))
+ (pass-if (documented? exp))
(pass-if-exception "no args" exception:wrong-num-args
(exp))
@@ -426,9 +425,7 @@
;;;
(with-test-prefix "quotient"
-
- (expect-fail "documented?"
- (documented? quotient))
+ (pass-if (documented? quotient))
(with-test-prefix "0 / n"
@@ -642,9 +639,7 @@
;;;
(with-test-prefix "remainder"
-
- (expect-fail "documented?"
- (documented? remainder))
+ (pass-if (documented? remainder))
(with-test-prefix "0 / n"
@@ -837,9 +832,7 @@
;;;
(with-test-prefix "modulo"
-
- (expect-fail "documented?"
- (documented? modulo))
+ (pass-if (documented? modulo))
(with-test-prefix "0 % n"
@@ -2354,7 +2347,7 @@
;;;
(with-test-prefix "zero?"
- (expect-fail (documented? zero?))
+ (pass-if (documented? zero?))
(pass-if (zero? 0))
(pass-if (not (zero? 7)))
(pass-if (not (zero? -7)))
@@ -2368,7 +2361,7 @@
;;;
(with-test-prefix "positive?"
- (expect-fail (documented? positive?))
+ (pass-if (documented? positive?))
(pass-if (positive? 1))
(pass-if (positive? (+ fixnum-max 1)))
(pass-if (positive? 1.3))
@@ -2382,7 +2375,7 @@
;;;
(with-test-prefix "negative?"
- (expect-fail (documented? negative?))
+ (pass-if (documented? negative?))
(pass-if (not (negative? 1)))
(pass-if (not (negative? (+ fixnum-max 1))))
(pass-if (not (negative? 1.3)))
@@ -3118,6 +3111,7 @@
;;;
(with-test-prefix "expt"
+ (pass-if (documented? expt))
(pass-if-exception "non-numeric base" exception:wrong-type-arg
(expt #t 0))
(pass-if (eqv? 1 (expt 0 0)))
@@ -3199,15 +3193,32 @@
;;; real-part
;;;
+(with-test-prefix "real-part"
+ (pass-if (documented? real-part))
+ (pass-if (eqv? 5.0 (real-part 5.0)))
+ (pass-if (eqv? 0.0 (real-part +5.0i)))
+ (pass-if (eqv? 5 (real-part 5)))
+ (pass-if (eqv? 1/5 (real-part 1/5)))
+ (pass-if (eqv? (1+ fixnum-max) (real-part (1+ fixnum-max)))))
+
;;;
;;; imag-part
;;;
+(with-test-prefix "imag-part"
+ (pass-if (documented? imag-part))
+ (pass-if (eqv? 0.0 (imag-part 5.0)))
+ (pass-if (eqv? 5.0 (imag-part +5.0i)))
+ (pass-if (eqv? 0 (imag-part 5)))
+ (pass-if (eqv? 0 (imag-part 1/5)))
+ (pass-if (eqv? 0 (imag-part (1+ fixnum-max)))))
+
;;;
;;; magnitude
;;;
(with-test-prefix "magnitude"
+ (pass-if (documented? magnitude))
(pass-if (= 0 (magnitude 0)))
(pass-if (= 1 (magnitude 1)))
(pass-if (= 1 (magnitude -1)))
@@ -3227,6 +3238,8 @@
(define (almost= x y)
(> 0.01 (magnitude (- x y))))
+ (pass-if (documented? angle))
+
(pass-if "inum +ve" (= 0 (angle 1)))
(pass-if "inum -ve" (almost= pi (angle -1)))
@@ -3241,7 +3254,8 @@
;;;
(with-test-prefix "inexact->exact"
-
+ (pass-if (documented? inexact->exact))
+
(pass-if-exception "+inf" exception:out-of-range
(inexact->exact +inf.0))
@@ -3263,6 +3277,7 @@
;;;
(with-test-prefix "integer-expt"
+ (pass-if (documented? integer-expt))
(pass-if-exception "non-numeric base" exception:wrong-type-arg
(integer-expt #t 0))
@@ -3294,6 +3309,7 @@
;;;
(with-test-prefix "integer-length"
+ (pass-if (documented? integer-length))
(with-test-prefix "-2^i, ...11100..00"
(do ((n -1 (ash n 1))
@@ -3321,8 +3337,7 @@
;;;
(with-test-prefix "log"
- (pass-if "documented?"
- (documented? log))
+ (pass-if (documented? log))
(pass-if-exception "no args" exception:wrong-num-args
(log))
@@ -3349,8 +3364,7 @@
;;;
(with-test-prefix "log10"
- (pass-if "documented?"
- (documented? log10))
+ (pass-if (documented? log10))
(pass-if-exception "no args" exception:wrong-num-args
(log10))
@@ -3377,6 +3391,8 @@
;;;
(with-test-prefix "logbit?"
+ (pass-if (documented? logbit?))
+
(pass-if (eq? #f (logbit? 0 0)))
(pass-if (eq? #f (logbit? 1 0)))
(pass-if (eq? #f (logbit? 31 0)))
@@ -3412,6 +3428,7 @@
;;;
(with-test-prefix "logcount"
+ (pass-if (documented? logcount))
(with-test-prefix "-2^i, meaning ...11100..00"
(do ((n -1 (ash n 1))
@@ -3439,6 +3456,8 @@
;;;
(with-test-prefix "logior"
+ (pass-if (documented? logior))
+
(pass-if (eqv? -1 (logior (ash -1 1) 1)))
;; check that bignum or bignum+inum args will reduce to an inum
@@ -3468,6 +3487,8 @@
;;;
(with-test-prefix "lognot"
+ (pass-if (documented? lognot))
+
(pass-if (= -1 (lognot 0)))
(pass-if (= 0 (lognot -1)))
(pass-if (= -2 (lognot 1)))
@@ -3483,8 +3504,7 @@
;;;
(with-test-prefix "sqrt"
- (pass-if "documented?"
- (documented? sqrt))
+ (pass-if (documented? sqrt))
(pass-if-exception "no args" exception:wrong-num-args
(sqrt))
@@ -3626,6 +3646,13 @@
test-numerators))
test-denominators))
+ (pass-if (documented? euclidean/))
+ (pass-if (documented? euclidean-quotient))
+ (pass-if (documented? euclidean-remainder))
+ (pass-if (documented? centered/))
+ (pass-if (documented? centered-quotient))
+ (pass-if (documented? centered-remainder))
+
(with-test-prefix "euclidean-quotient"
(do-tests-1 'euclidean-quotient
euclidean-quotient
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. release_1-9-14-146-g2519490,
Andy Wingo <=