[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-129-gb
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. release_1-9-14-129-gb5c4058 |
|
Date: |
Fri, 28 Jan 2011 13:45:50 +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=b5c40589ecb249b8a0989c9409c37743c1f26557
The branch, master has been updated
via b5c40589ecb249b8a0989c9409c37743c1f26557 (commit)
via 425d55f969c241d9ef5c1a5406dedb61692e1769 (commit)
via 10391e06e05a39c5f71510f0ecd1c9636298f93e (commit)
via a4955a04120a7e688f094697d4a2df4094818fbd (commit)
via 41df63cf16f80797e0071705d06e166fd2f62d49 (commit)
via 7112615f73bf79197832fd044dc7f7d9d94b5325 (commit)
via cff5fa3384a097839e4a7ae74307d55bab58e2ba (commit)
via 6d9bd642c1b4e7022a2507b19631642644e70f68 (commit)
via 6a07a0611852d8234880103453cf5a1eebc78f49 (commit)
via b56c252b52adc73bf154551e0cc3462548771ce3 (commit)
from 92a70bcf299632e5b19f86ab4629d4e24a09a7e1 (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 b5c40589ecb249b8a0989c9409c37743c1f26557
Author: Mark H Weaver <address@hidden>
Date: Wed Jan 26 05:21:03 2011 -0500
Fix bugs when negating SCM_MOST_POSITIVE_FIXNUM+1
* libguile/numbers.c (scm_difference, scm_product):
Fix bugs when negating SCM_MOST_POSITIVE_FIXNUM+1,
aka -SCM_MOST_NEGATIVE_FIXNUM. Previously, these cases
failed to normalize the result to a fixnum, causing
`=', `eqv?' and `equal?' to fail, e.g.:
(= most-negative-fixnum (- 0 (- most-negative-fixnum)))
(= most-negative-fixnum (* -1 (- most-negative-fixnum)))
(= most-negative-fixnum (* (- most-negative-fixnum) -1))
* test-suite/test/numbers.test: Add test cases to detect
bugs when negating SCM_MOST_POSITIVE_FIXNUM+1 and
SCM_MOST_NEGATIVE_FIXNUM by various methods.
commit 425d55f969c241d9ef5c1a5406dedb61692e1769
Author: Mark H Weaver <address@hidden>
Date: Fri Jan 28 13:51:37 2011 +0100
note inf? / nan? domain in NEWS
* NEWS: Add NEWS entry.
commit 10391e06e05a39c5f71510f0ecd1c9636298f93e
Author: Andy Wingo <address@hidden>
Date: Wed Jan 26 04:34:55 2011 -0500
domain of inf?, finite?, nan? is the real numbers
* libguile/numbers.c (scm_inf_p, scm_finite_p, scm_nan_p): The domain of
these functions is the real numbers. Error on other input.
* doc/ref/api-data.texi (Reals and Rationals): Update the documentation
accordingly.
* test-suite/tests/numbers.test ("finite?", "inf?"): Update tests.
commit a4955a04120a7e688f094697d4a2df4094818fbd
Author: Mark H Weaver <address@hidden>
Date: Wed Jan 26 02:50:03 2011 -0500
Remove useless code from do_divide
* libguile/numbers.c (do_divide): Remove code which handled a case
that never occurs: a zero bignum.
commit 41df63cf16f80797e0071705d06e166fd2f62d49
Author: Mark H Weaver <address@hidden>
Date: Wed Jan 26 09:36:05 2011 -0500
Optimize scm_exact_p by making use of SCM_INEXACTP
* libguile/numbers.c (scm_exact_p): Optimize by making use of the
SCM_INEXACTP macro.
(scm_inexact_p): Move it next to scm_exact_p, and add else's.
* test-suite/tests/numbers.test: Add test cases for `exact?'
and `inexact?' applied to infinities and NaNs.
commit 7112615f73bf79197832fd044dc7f7d9d94b5325
Author: Mark H Weaver <address@hidden>
Date: Wed Jan 26 09:34:02 2011 -0500
Implement `finite?' in core and fix R6RS `finite?' and `infinite?'
* libguile/numbers.c (scm_finite_p): Add new predicate `finite?' from
R6RS to guile core, which returns #t if and only if its argument is
neither infinite nor a NaN. Note that this is not the same as (not
(inf? x)) or (not (infinite? x)), since NaNs are neither finite nor
infinite.
* test-suite/tests/numbers.test: Add test cases for `finite?'.
* module/rnrs/base.scm: Import `inf?' as `infinite?' instead of
reimplementing it. Previously, the R6RS implementation of
`infinite?' did not detect non-real complex infinities, nor did it
throw exceptions for non-numbers. (Note that NaNs _are_ considered
numbers by scheme, despite their name).
Import `finite?' instead of reimplementing it. Previously, the R6RS
implementation of `finite?' returned #t for both NaNs and non-real
complex infinities, in violation of R6RS.
* NEWS: Add NEWS entries, and reorganize existing numerics-related
entries together under one subheading.
* doc/ref/api-data.texi (Real and Rational Numbers): Add docs for
`finite?' and scm_finite_p.
commit cff5fa3384a097839e4a7ae74307d55bab58e2ba
Author: Mark H Weaver <address@hidden>
Date: Tue Jan 25 18:58:47 2011 -0500
Add SCM_INUM1 to numbers.h, and make use of it and SCM_INUM0 in numbers.c
* libguile/numbers.h: Add SCM_INUM1, a name for the fixnum 1. This is
analogous to SCM_INUM0, a name for 0, which already existed.
* libguile/numbers.c: Change occurrences of SCM_I_MAKINUM (0) and
SCM_I_MAKINUM (1) to SCM_INUM0 and SCM_INUM1, respectively.
commit 6d9bd642c1b4e7022a2507b19631642644e70f68
Author: Mark H Weaver <address@hidden>
Date: Tue Jan 25 18:53:36 2011 -0500
Fix NEWS entry regarding changes to `expt' for zero base
NEWS: Fix NEWS entry regarding changes to `expt' when base is zero
commit 6a07a0611852d8234880103453cf5a1eebc78f49
Author: Mark H Weaver <address@hidden>
Date: Tue Jan 25 18:35:22 2011 -0500
Do not apply `inf?' or `nan?' to strings
* module/ice-9/format.scm (format): Test to make sure an argument is a
number before applying `inf?' and `nan?' to it. Formerly, format
would call `inf?' and `nan?' on arguments that might be either a
number or a string, although those predicates should ideally throw an
exception when applied to non-number objects.
commit b56c252b52adc73bf154551e0cc3462548771ce3
Author: Mark H Weaver <address@hidden>
Date: Tue Jan 25 18:29:47 2011 -0500
Fix incorrect FUNC_NAME for scm_current_processor_count
* libguile/posix.c (scm_current_processor_count):
Fix incorrect FUNC_NAME (was s_scm_total_processor_count)
-----------------------------------------------------------------------
Summary of changes:
NEWS | 48 +++++++--
doc/ref/api-data.texi | 16 ++-
libguile/numbers.c | 222 ++++++++++++++++++++++-------------------
libguile/numbers.h | 7 +-
libguile/posix.c | 4 +-
module/ice-9/format.scm | 14 ++-
module/rnrs/base.scm | 6 +-
test-suite/tests/numbers.test | 73 +++++++++++++-
8 files changed, 259 insertions(+), 131 deletions(-)
diff --git a/NEWS b/NEWS
index c2bb1c1..9938204 100644
--- a/NEWS
+++ b/NEWS
@@ -10,25 +10,55 @@ latest prerelease, and a full NEWS corresponding to 1.8 ->
2.0.
Changes in 1.9.15 (since the 1.9.14 prerelease):
-** Infinities are no longer integers.
+** Changes and bugfixes in numerics code
+
+*** Infinities are no longer integers.
Following the R6RS, infinities (+inf.0 and -inf.0) are no longer
considered to be integers.
+*** `expt' and `integer-expt' changes when the base is 0
+
+While `(expt 0 0)' is still 1, and `(expt 0 N)' for N > 0 is still
+zero, `(expt 0 N)' for N < 0 is now a NaN value, and likewise for
+integer-expt. This is more correct, and conforming to R6RS, but seems
+to be incompatible with R5RS, which would return 0 for all non-zero
+values of N.
+
+*** `inf?' and `nan?' now throw exceptions for non-reals
+
+The domain of `inf?' and `nan?' is the real numbers. Guile now signals
+an error when a non-real number or non-number is passed to these
+procedures. (Note that NaNs _are_ considered numbers by scheme, despite
+their name).
+
+*** New procedure: `finite?'
+
+Add scm_finite_p `finite?' from R6RS to guile core, which returns #t
+if and only if its argument is neither infinite nor a NaN. Note that
+this is not the same as (not (inf? x)) or (not (infinite? x)), since
+NaNs are neither finite nor infinite.
+
+*** R6RS base library changes
+
+**** `infinite?' changes
+
+`infinite?' now returns #t for non-real complex infinities, and throws
+exceptions for non-numbers. (Note that NaNs _are_ considered numbers
+by scheme, despite their name).
+
+**** `finite?' changes
+
+`finite?' now returns #f for NaNs and non-real complex infinities, and
+throws exceptions for non-numbers. (Note that NaNs _are_ considered
+numbers by scheme, despite their name).
+
** New reader option: `hungry-eol-escapes'
Guile's string syntax is more compatible with R6RS when the
`hungry-eol-escapes' option is enabled. See "String Syntax" in the
manual, for more information.
-** `expt' and `integer-expt' changes when the base is 0
-
-While `(expt 0 0)' is still 1, `(expt 0 N)' for N > 0 is now 0, and
-`(expt 0 N)' for N < 0 is now a NaN value, and likewise for
-integer-expt. This is more correct, and conforming to R6RS, but seems
-to be incompatible with R5RS, which would always return 0 for all values
-of N.
-
** And of course, the usual collection of bugfixes
Interested users should see the ChangeLog for more information.
diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi
index 4835f30..a0ab258 100755
--- a/doc/ref/api-data.texi
+++ b/doc/ref/api-data.texi
@@ -549,7 +549,8 @@ While @samp{+nan.0} is not @code{=} to itself, it is
@code{eqv?} to
itself.
To test for the special values, use the functions @code{inf?} and
address@hidden
address@hidden To test for numbers than are neither infinite nor a NaN,
+use @code{finite?}.
@deffn {Scheme Procedure} real? obj
@deffnx {C Function} scm_real_p (obj)
@@ -588,13 +589,20 @@ to use @code{inexact->exact} on the arguments.
@deffn {Scheme Procedure} inf? x
@deffnx {C Function} scm_inf_p (x)
-Return @code{#t} if @var{x} is either @samp{+inf.0} or @samp{-inf.0},
address@hidden otherwise.
+Return @code{#t} if the real number @var{x} is @samp{+inf.0} or
address@hidden Otherwise return @code{#f}.
@end deffn
@deffn {Scheme Procedure} nan? x
@deffnx {C Function} scm_nan_p (x)
-Return @code{#t} if @var{x} is @samp{+nan.0}, @code{#f} otherwise.
+Return @code{#t} if the real number @var{x} is @samp{+nan.0}, or
address@hidden otherwise.
address@hidden deffn
+
address@hidden {Scheme Procedure} finite? x
address@hidden {C Function} scm_finite_p (x)
+Return @code{#t} if the real number @var{x} is neither infinite nor a
+NaN, @code{#f} otherwise.
@end deffn
@deffn {Scheme Procedure} nan
diff --git a/libguile/numbers.c b/libguile/numbers.c
index 9c33d07..9998ab7 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -79,6 +79,10 @@
typedef scm_t_signed_bits scm_t_inum;
#define scm_from_inum(x) (scm_from_signed_integer (x))
+/* Tests to see if a C double is neither infinite nor a NaN.
+ TODO: if it's available, use C99's isfinite(x) instead */
+#define DOUBLE_IS_FINITE(x) (!isinf(x) && !isnan(x))
+
/*
@@ -403,7 +407,7 @@ scm_i_make_ratio (SCM numerator, SCM denominator)
{
if (scm_is_eq (denominator, SCM_INUM0))
scm_num_overflow ("make-ratio");
- if (scm_is_eq (denominator, SCM_I_MAKINUM(1)))
+ if (scm_is_eq (denominator, SCM_INUM1))
return numerator;
}
else
@@ -435,7 +439,7 @@ scm_i_make_ratio (SCM numerator, SCM denominator)
scm_t_inum y;
y = SCM_I_INUM (denominator);
if (x == y)
- return SCM_I_MAKINUM(1);
+ return SCM_INUM1;
if ((x % y) == 0)
return SCM_I_MAKINUM (x / y);
}
@@ -462,7 +466,7 @@ scm_i_make_ratio (SCM numerator, SCM denominator)
else
{
if (scm_is_eq (numerator, denominator))
- return SCM_I_MAKINUM(1);
+ return SCM_INUM1;
if (mpz_divisible_p (SCM_I_BIG_MPZ (numerator),
SCM_I_BIG_MPZ (denominator)))
return scm_divide(numerator, denominator);
@@ -473,7 +477,7 @@ scm_i_make_ratio (SCM numerator, SCM denominator)
*/
{
SCM divisor = scm_gcd (numerator, denominator);
- if (!(scm_is_eq (divisor, SCM_I_MAKINUM(1))))
+ if (!(scm_is_eq (divisor, SCM_INUM1)))
{
numerator = scm_divide (numerator, divisor);
denominator = scm_divide (denominator, divisor);
@@ -499,15 +503,28 @@ SCM_DEFINE (scm_exact_p, "exact?", 1, 0, 0,
"otherwise.")
#define FUNC_NAME s_scm_exact_p
{
- if (SCM_I_INUMP (x))
- return SCM_BOOL_T;
- if (SCM_BIGP (x))
+ if (SCM_INEXACTP (x))
+ return SCM_BOOL_F;
+ else if (SCM_NUMBERP (x))
return SCM_BOOL_T;
- if (SCM_FRACTIONP (x))
+ else
+ SCM_WRONG_TYPE_ARG (1, x);
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_inexact_p, "inexact?", 1, 0, 0,
+ (SCM x),
+ "Return @code{#t} if @var{x} is an inexact number, @code{#f}\n"
+ "else.")
+#define FUNC_NAME s_scm_inexact_p
+{
+ if (SCM_INEXACTP (x))
return SCM_BOOL_T;
- if (SCM_NUMBERP (x))
+ else if (SCM_NUMBERP (x))
return SCM_BOOL_F;
- SCM_WRONG_TYPE_ARG (1, x);
+ else
+ SCM_WRONG_TYPE_ARG (1, x);
}
#undef FUNC_NAME
@@ -581,35 +598,48 @@ SCM_DEFINE (scm_even_p, "even?", 1, 0, 0,
}
#undef FUNC_NAME
+SCM_DEFINE (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
+{
+ if (SCM_REALP (x))
+ return scm_from_bool (DOUBLE_IS_FINITE (SCM_REAL_VALUE (x)));
+ else if (scm_is_real (x))
+ return SCM_BOOL_T;
+ else
+ SCM_WRONG_TYPE_ARG (1, x);
+}
+#undef FUNC_NAME
+
SCM_DEFINE (scm_inf_p, "inf?", 1, 0, 0,
(SCM x),
- "Return @code{#t} if @var{x} is either @samp{+inf.0}\n"
- "or @samp{-inf.0}, @code{#f} otherwise.")
+ "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))
return scm_from_bool (isinf (SCM_REAL_VALUE (x)));
- else if (SCM_COMPLEXP (x))
- return scm_from_bool (isinf (SCM_COMPLEX_REAL (x))
- || isinf (SCM_COMPLEX_IMAG (x)));
- else
+ else if (scm_is_real (x))
return SCM_BOOL_F;
+ else
+ SCM_WRONG_TYPE_ARG (1, x);
}
#undef FUNC_NAME
SCM_DEFINE (scm_nan_p, "nan?", 1, 0, 0,
- (SCM n),
- "Return @code{#t} if @var{n} is a NaN, @code{#f}\n"
- "otherwise.")
+ (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
{
- if (SCM_REALP (n))
- return scm_from_bool (isnan (SCM_REAL_VALUE (n)));
- else if (SCM_COMPLEXP (n))
- return scm_from_bool (isnan (SCM_COMPLEX_REAL (n))
- || isnan (SCM_COMPLEX_IMAG (n)));
- else
+ if (SCM_REALP (x))
+ return scm_from_bool (isnan (SCM_REAL_VALUE (x)));
+ else if (scm_is_real (x))
return SCM_BOOL_F;
+ else
+ SCM_WRONG_TYPE_ARG (1, x);
}
#undef FUNC_NAME
@@ -772,7 +802,7 @@ scm_quotient (SCM x, SCM y)
return SCM_I_MAKINUM (-1);
}
else
- return SCM_I_MAKINUM (0);
+ return SCM_INUM0;
}
else
SCM_WTA_DISPATCH_2 (g_quotient, x, y, SCM_ARG2, s_quotient);
@@ -849,7 +879,7 @@ scm_remainder (SCM x, SCM y)
{
/* Special case: x == fixnum-min && y == abs (fixnum-min) */
scm_remember_upto_here_1 (y);
- return SCM_I_MAKINUM (0);
+ return SCM_INUM0;
}
else
return x;
@@ -1932,7 +1962,7 @@ SCM_DEFINE (scm_ash, "ash", 2, 0, 0,
{
bits_to_shift = -bits_to_shift;
if (bits_to_shift >= SCM_LONG_BIT)
- return (nn >= 0 ? SCM_I_MAKINUM (0) : SCM_I_MAKINUM(-1));
+ return (nn >= 0 ? SCM_INUM0 : SCM_I_MAKINUM(-1));
else
return SCM_I_MAKINUM (SCM_SRS (nn, bits_to_shift));
}
@@ -2694,7 +2724,7 @@ mem2decimal_from_point (SCM result, SCM mem,
scm_t_bits shift = 1;
scm_t_bits add = 0;
unsigned int digit_value;
- SCM big_shift = SCM_I_MAKINUM (1);
+ SCM big_shift = SCM_INUM1;
idx++;
while (idx != len)
@@ -2882,7 +2912,7 @@ mem2ureal (SCM mem, unsigned int *p_idx,
else if (!uc_is_property_decimal_digit ((scm_t_uint32) scm_i_string_ref
(mem, idx+1)))
return SCM_BOOL_F;
else
- result = mem2decimal_from_point (SCM_I_MAKINUM (0), mem,
+ result = mem2decimal_from_point (SCM_INUM0, mem,
p_idx, &x);
}
else
@@ -2933,7 +2963,7 @@ mem2ureal (SCM mem, unsigned int *p_idx,
/* When returning an inexact zero, make sure it is represented as a
floating point value so that we can change its sign.
*/
- if (scm_is_eq (result, SCM_I_MAKINUM(0)) && *p_exactness == INEXACT)
+ if (scm_is_eq (result, SCM_INUM0) && *p_exactness == INEXACT)
result = scm_from_double (0.0);
return result;
@@ -2984,7 +3014,7 @@ mem2complex (SCM mem, unsigned int idx,
if (idx != len)
return SCM_BOOL_F;
- return scm_make_rectangular (SCM_I_MAKINUM (0), SCM_I_MAKINUM (sign));
+ return scm_make_rectangular (SCM_INUM0, SCM_I_MAKINUM (sign));
}
else
return SCM_BOOL_F;
@@ -3008,7 +3038,7 @@ mem2complex (SCM mem, unsigned int idx,
return SCM_BOOL_F;
if (idx != len)
return SCM_BOOL_F;
- return scm_make_rectangular (SCM_I_MAKINUM (0), ureal);
+ return scm_make_rectangular (SCM_INUM0, ureal);
case '@':
/* polar input: <real>@<real>. */
@@ -3342,21 +3372,6 @@ SCM_DEFINE (scm_integer_p, "integer?", 1, 0, 0,
#undef FUNC_NAME
-SCM_DEFINE (scm_inexact_p, "inexact?", 1, 0, 0,
- (SCM x),
- "Return @code{#t} if @var{x} is an inexact number, @code{#f}\n"
- "else.")
-#define FUNC_NAME s_scm_inexact_p
-{
- if (SCM_INEXACTP (x))
- return SCM_BOOL_T;
- if (SCM_NUMBERP (x))
- return SCM_BOOL_F;
- SCM_WRONG_TYPE_ARG (1, x);
-}
-#undef FUNC_NAME
-
-
SCM scm_i_num_eq_p (SCM, SCM, SCM);
SCM_PRIMITIVE_GENERIC (scm_i_num_eq_p, "=", 0, 2, 1,
(SCM x, SCM y, SCM rest),
@@ -4398,7 +4413,7 @@ SCM_DEFINE (scm_oneplus, "1+", 1, 0, 0,
"Return @address@hidden")
#define FUNC_NAME s_scm_oneplus
{
- return scm_sum (x, SCM_I_MAKINUM (1));
+ return scm_sum (x, SCM_INUM1);
}
#undef FUNC_NAME
@@ -4473,7 +4488,11 @@ scm_difference (SCM x, SCM y)
scm_t_inum xx = SCM_I_INUM (x);
if (xx == 0)
- return scm_i_clonebig (y, 0);
+ {
+ /* Must scm_i_normbig here because -SCM_MOST_NEGATIVE_FIXNUM is a
+ bignum, but negating that gives a fixnum. */
+ return scm_i_normbig (scm_i_clonebig (y, 0));
+ }
else
{
int sgn_y = mpz_sgn (SCM_I_BIG_MPZ (y));
@@ -4658,7 +4677,7 @@ SCM_DEFINE (scm_oneminus, "1-", 1, 0, 0,
"Return @address@hidden")
#define FUNC_NAME s_scm_oneminus
{
- return scm_difference (x, SCM_I_MAKINUM (1));
+ return scm_difference (x, SCM_INUM1);
}
#undef FUNC_NAME
@@ -4705,6 +4724,17 @@ scm_product (SCM x, SCM y)
{
case 0: return x; break;
case 1: return y; break;
+ /*
+ * The following case (x = -1) is important for more than
+ * just optimization. It handles the case of negating
+ * (+ 1 most-positive-fixnum) aka (- most-negative-fixnum),
+ * which is a bignum that must be changed back into a fixnum.
+ * Failure to do so will cause the following to return #f:
+ * (= most-negative-fixnum (* -1 (- most-negative-fixnum)))
+ */
+ case -1:
+ return scm_difference(y, SCM_UNDEFINED);
+ break;
}
if (SCM_LIKELY (SCM_I_INUMP (y)))
@@ -4939,14 +4969,14 @@ do_divide (SCM x, SCM y, int inexact)
{
if (inexact)
return scm_from_double (1.0 / (double) xx);
- else return scm_i_make_ratio (SCM_I_MAKINUM(1), x);
+ else return scm_i_make_ratio (SCM_INUM1, x);
}
}
else if (SCM_BIGP (x))
{
if (inexact)
return scm_from_double (1.0 / scm_i_big2dbl (x));
- else return scm_i_make_ratio (SCM_I_MAKINUM(1), x);
+ else return scm_i_make_ratio (SCM_INUM1, x);
}
else if (SCM_REALP (x))
{
@@ -5104,47 +5134,33 @@ do_divide (SCM x, SCM y, int inexact)
}
else if (SCM_BIGP (y))
{
- int y_is_zero = (mpz_sgn (SCM_I_BIG_MPZ (y)) == 0);
- if (y_is_zero)
+ /* big_x / big_y */
+ if (inexact)
{
-#ifndef ALLOW_DIVIDE_BY_EXACT_ZERO
- scm_num_overflow (s_divide);
-#else
- int sgn = mpz_sgn (SCM_I_BIG_MPZ (x));
- scm_remember_upto_here_1 (x);
- return (sgn == 0) ? scm_nan () : scm_inf ();
-#endif
+ /* It's easily possible for the ratio x/y to fit a double
+ but one or both x and y be too big to fit a double,
+ hence the use of mpq_get_d rather than converting and
+ dividing. */
+ mpq_t q;
+ *mpq_numref(q) = *SCM_I_BIG_MPZ (x);
+ *mpq_denref(q) = *SCM_I_BIG_MPZ (y);
+ return scm_from_double (mpq_get_d (q));
}
else
{
- /* big_x / big_y */
- if (inexact)
- {
- /* It's easily possible for the ratio x/y to fit a double
- but one or both x and y be too big to fit a double,
- hence the use of mpq_get_d rather than converting and
- dividing. */
- mpq_t q;
- *mpq_numref(q) = *SCM_I_BIG_MPZ (x);
- *mpq_denref(q) = *SCM_I_BIG_MPZ (y);
- return scm_from_double (mpq_get_d (q));
- }
- else
- {
- int divisible_p = mpz_divisible_p (SCM_I_BIG_MPZ (x),
- SCM_I_BIG_MPZ (y));
- if (divisible_p)
- {
- SCM result = scm_i_mkbig ();
- mpz_divexact (SCM_I_BIG_MPZ (result),
- SCM_I_BIG_MPZ (x),
- SCM_I_BIG_MPZ (y));
- scm_remember_upto_here_2 (x, y);
- return scm_i_normbig (result);
- }
- else
- return scm_i_make_ratio (x, y);
- }
+ int divisible_p = mpz_divisible_p (SCM_I_BIG_MPZ (x),
+ SCM_I_BIG_MPZ (y));
+ if (divisible_p)
+ {
+ SCM result = scm_i_mkbig ();
+ mpz_divexact (SCM_I_BIG_MPZ (result),
+ SCM_I_BIG_MPZ (x),
+ SCM_I_BIG_MPZ (y));
+ scm_remember_upto_here_2 (x, y);
+ return scm_i_normbig (result);
+ }
+ else
+ return scm_i_make_ratio (x, y);
}
}
else if (SCM_REALP (y))
@@ -5410,7 +5426,7 @@ SCM_DEFINE (scm_round_number, "round", 1, 0, 0,
/* Adjust so that the rounding is towards even. */
if (scm_is_true (scm_num_eq_p (plus_half, result))
&& scm_is_true (scm_odd_p (result)))
- return scm_difference (result, SCM_I_MAKINUM (1));
+ return scm_difference (result, SCM_INUM1);
else
return result;
}
@@ -5440,7 +5456,7 @@ SCM_PRIMITIVE_GENERIC (scm_floor, "floor", 1, 0, 0,
/* For negative x, we need to return q-1 unless x is an
integer. But fractions are never integer, per our
assumptions. */
- return scm_difference (q, SCM_I_MAKINUM (1));
+ return scm_difference (q, SCM_INUM1);
}
}
else
@@ -5471,7 +5487,7 @@ SCM_PRIMITIVE_GENERIC (scm_ceiling, "ceiling", 1, 0, 0,
/* For positive x, we need to return q+1 unless x is an
integer. But fractions are never integer, per our
assumptions. */
- return scm_sum (q, SCM_I_MAKINUM (1));
+ return scm_sum (q, SCM_INUM1);
}
}
else
@@ -5743,7 +5759,7 @@ SCM_PRIMITIVE_GENERIC (scm_sys_asinh, "asinh", 1, 0, 0,
else if (scm_is_number (z))
return scm_log (scm_sum (z,
scm_sqrt (scm_sum (scm_product (z, z),
- SCM_I_MAKINUM (1)))));
+ SCM_INUM1))));
else
SCM_WTA_DISPATCH_1 (g_scm_sys_asinh, z, 1, s_scm_sys_asinh);
}
@@ -5759,7 +5775,7 @@ SCM_PRIMITIVE_GENERIC (scm_sys_acosh, "acosh", 1, 0, 0,
else if (scm_is_number (z))
return scm_log (scm_sum (z,
scm_sqrt (scm_difference (scm_product (z, z),
- SCM_I_MAKINUM (1)))));
+ SCM_INUM1))));
else
SCM_WTA_DISPATCH_1 (g_scm_sys_acosh, z, 1, s_scm_sys_acosh);
}
@@ -5773,8 +5789,8 @@ SCM_PRIMITIVE_GENERIC (scm_sys_atanh, "atanh", 1, 0, 0,
if (scm_is_real (z) && scm_to_double (z) >= -1.0 && scm_to_double (z) <= 1.0)
return scm_from_double (atanh (scm_to_double (z)));
else if (scm_is_number (z))
- return scm_divide (scm_log (scm_divide (scm_sum (SCM_I_MAKINUM (1), z),
- scm_difference (SCM_I_MAKINUM (1),
z))),
+ return scm_divide (scm_log (scm_divide (scm_sum (SCM_INUM1, z),
+ scm_difference (SCM_INUM1, z))),
SCM_I_MAKINUM (2));
else
SCM_WTA_DISPATCH_1 (g_scm_sys_atanh, z, 1, s_scm_sys_atanh);
@@ -5911,9 +5927,9 @@ SCM
scm_denominator (SCM z)
{
if (SCM_I_INUMP (z))
- return SCM_I_MAKINUM (1);
+ return SCM_INUM1;
else if (SCM_BIGP (z))
- return SCM_I_MAKINUM (1);
+ return SCM_INUM1;
else if (SCM_FRACTIONP (z))
return SCM_FRACTION_DENOMINATOR (z);
else if (SCM_REALP (z))
@@ -6093,9 +6109,9 @@ SCM_DEFINE (scm_rationalize, "rationalize", 2, 0, 0,
SCM ex = scm_inexact_to_exact (x);
SCM int_part = scm_floor (ex);
- SCM tt = SCM_I_MAKINUM (1);
- SCM a1 = SCM_I_MAKINUM (0), a2 = SCM_I_MAKINUM (1), a = SCM_I_MAKINUM
(0);
- SCM b1 = SCM_I_MAKINUM (1), b2 = SCM_I_MAKINUM (0), b = SCM_I_MAKINUM
(0);
+ SCM tt = SCM_INUM1;
+ SCM a1 = SCM_INUM0, a2 = SCM_INUM1, a = SCM_INUM0;
+ SCM b1 = SCM_INUM1, b2 = SCM_INUM0, b = SCM_INUM0;
SCM rx;
int i = 0;
@@ -6664,7 +6680,7 @@ scm_init_numbers ()
scm_dblprec[10-2] = (DBL_DIG > 20) ? 20 : DBL_DIG;
#endif
- exactly_one_half = scm_divide (SCM_I_MAKINUM (1), SCM_I_MAKINUM (2));
+ exactly_one_half = scm_divide (SCM_INUM1, SCM_I_MAKINUM (2));
#include "libguile/numbers.x"
}
diff --git a/libguile/numbers.h b/libguile/numbers.h
index a3701a6..740dc80 100644
--- a/libguile/numbers.h
+++ b/libguile/numbers.h
@@ -3,7 +3,7 @@
#ifndef SCM_NUMBERS_H
#define SCM_NUMBERS_H
-/* Copyright (C) 1995,1996,1998,2000,2001,2002,2003,2004,2005, 2006, 2008,
2009, 2010 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,2000,2001,2002,2003,2004,2005, 2006, 2008,
2009, 2010, 2011 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -68,8 +68,9 @@ typedef scm_t_int32 scm_t_wchar;
#define SCM_FIXABLE(n) (SCM_POSFIXABLE (n) && SCM_NEGFIXABLE (n))
-/* A name for 0. */
-#define SCM_INUM0 (SCM_I_MAKINUM (0))
+#define SCM_INUM0 (SCM_I_MAKINUM (0)) /* A name for 0 */
+#define SCM_INUM1 (SCM_I_MAKINUM (1)) /* A name for 1 */
+
/* SCM_MAXEXP is the maximum double precision exponent
* SCM_FLTMAX is less than or scm_equal the largest single precision float
diff --git a/libguile/posix.c b/libguile/posix.c
index 95beb6e..939e248 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2005,
2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2005,
2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -2015,7 +2015,7 @@ SCM_DEFINE (scm_current_processor_count,
"current-processor-count", 0, 0, 0,
"processors available to the current process. See\n"
"@code{setaffinity} and @code{getaffinity} for more\n"
"information.\n")
-#define FUNC_NAME s_scm_total_processor_count
+#define FUNC_NAME s_scm_current_processor_count
{
return scm_from_ulong (num_processors (NPROC_CURRENT));
}
diff --git a/module/ice-9/format.scm b/module/ice-9/format.scm
index 1681004..7cd0183 100644
--- a/module/ice-9/format.scm
+++ b/module/ice-9/format.scm
@@ -1,5 +1,5 @@
;;;; "format.scm" Common LISP text output formatter for SLIB
-;;; Copyright (C) 2010 Free Software Foundation, Inc.
+;;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
;;;
;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public
@@ -1079,7 +1079,8 @@
(padch (format:par pars l 4 format:space-ch #f)))
(cond
- ((or (inf? number) (nan? number))
+ ((and (number? number)
+ (or (inf? number) (nan? number)))
(format:out-inf-nan number width digits #f overch padch))
(digits
@@ -1140,7 +1141,8 @@
(expch (format:par pars l 6 #f #f)))
(cond
- ((or (inf? number) (nan? number))
+ ((and (number? number)
+ (or (inf? number) (nan? number)))
(format:out-inf-nan number width digits edigits overch padch))
(digits ; fixed precision
@@ -1231,7 +1233,8 @@
(overch (if (> l 4) (list-ref pars 4) #f))
(padch (if (> l 5) (list-ref pars 5) #f)))
(cond
- ((or (inf? number) (nan? number))
+ ((and (number? number)
+ (or (inf? number) (nan? number)))
;; FIXME: this isn't right.
(format:out-inf-nan number width digits edigits overch padch))
(else
@@ -1265,7 +1268,8 @@
(padch (format:par pars l 3 format:space-ch #f)))
(cond
- ((or (inf? number) (nan? number))
+ ((and (number? number)
+ (or (inf? number) (nan? number)))
(format:out-inf-nan number width digits #f #f padch))
(else
diff --git a/module/rnrs/base.scm b/module/rnrs/base.scm
index a6ae1b9..c7579c3 100644
--- a/module/rnrs/base.scm
+++ b/module/rnrs/base.scm
@@ -1,6 +1,6 @@
;;; base.scm --- The R6RS base library
-;; Copyright (C) 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
;;
;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
@@ -76,6 +76,7 @@
(import (rename (except (guile) error raise)
(quotient div)
(modulo mod)
+ (inf? infinite?)
(exact->inexact inexact)
(inexact->exact exact))
(srfi srfi-11))
@@ -98,9 +99,6 @@
(let ((sym (car syms)))
(and (symbol? sym) (symbol=?-internal (cdr syms) sym)))))
- (define (infinite? x) (or (eqv? x +inf.0) (eqv? x -inf.0)))
- (define (finite? x) (not (infinite? x)))
-
(define (exact-integer-sqrt x)
(let* ((s (exact (floor (sqrt x)))) (e (- x (* s s)))) (values s e)))
diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test
index 5ea4764..f53cb34 100644
--- a/test-suite/tests/numbers.test
+++ b/test-suite/tests/numbers.test
@@ -240,7 +240,11 @@
(eq? #f (exact? (sqrt (- (expt fixnum-max 2) 1)))))
(pass-if "sqrt ((fixnum-max+1)^2 - 1)"
- (eq? #f (exact? (sqrt (- (expt (+ fixnum-max 1) 2) 1)))))))
+ (eq? #f (exact? (sqrt (- (expt (+ fixnum-max 1) 2) 1)))))
+
+ (pass-if (not (exact? +inf.0)))
+ (pass-if (not (exact? -inf.0)))
+ (pass-if (not (exact? +nan.0)))))
;;;
;;; exp
@@ -305,6 +309,38 @@
(pass-if (even? (* 2 fixnum-min))))
;;;
+;;; finite?
+;;;
+
+(with-test-prefix "finite?"
+ (pass-if (documented? finite?))
+ (pass-if (not (finite? (inf))))
+ (pass-if (not (finite? +inf.0)))
+ (pass-if (not (finite? -inf.0)))
+ (pass-if-exception
+ "complex numbers not in doman of finite?"
+ exception:wrong-type-arg
+ (finite? +inf.0+1i))
+ (pass-if-exception
+ "complex numbers not in doman of finite? (2)"
+ exception:wrong-type-arg
+ (finite? +1+inf.0i))
+ (pass-if-exception
+ "complex numbers not in doman of finite? (3)"
+ exception:wrong-type-arg
+ (finite? +1+1i))
+ (pass-if (finite? 3+0i))
+ (pass-if (not (finite? (nan))))
+ (pass-if (not (finite? +nan.0)))
+ (pass-if (finite? 0))
+ (pass-if (finite? 0.0))
+ (pass-if (finite? -0.0))
+ (pass-if (finite? 42.0))
+ (pass-if (finite? 1/2))
+ (pass-if (finite? (+ fixnum-max 1)))
+ (pass-if (finite? (- fixnum-min 1))))
+
+;;;
;;; inf? and inf
;;;
@@ -314,6 +350,11 @@
;; FIXME: what are the expected behaviors?
;; (pass-if (inf? (/ 1.0 0.0))
;; (pass-if (inf? (/ 1 0.0))
+ (pass-if-exception
+ "complex numbers not in doman of inf?"
+ exception:wrong-type-arg
+ (inf? +1+inf.0i))
+ (pass-if (inf? +inf.0+0i))
(pass-if (not (inf? 0)))
(pass-if (not (inf? 42.0)))
(pass-if (not (inf? (+ fixnum-max 1))))
@@ -1533,6 +1574,9 @@
(pass-if (not (inexact? (- 1 fixnum-min))))
(pass-if (inexact? 1.3))
(pass-if (inexact? 3.1+4.2i))
+ (pass-if (inexact? +inf.0))
+ (pass-if (inexact? -inf.0))
+ (pass-if (inexact? +nan.0))
(pass-if-exception "char"
exception:wrong-type-arg
(not (inexact? #\a)))
@@ -2481,6 +2525,20 @@
(with-test-prefix/c&e "-"
+ (pass-if "double-negation of fixnum-min: ="
+ (= fixnum-min (- (- fixnum-min))))
+ (pass-if "double-negation of fixnum-min: eqv?"
+ (eqv? fixnum-min (- (- fixnum-min))))
+ (pass-if "double-negation of fixnum-min: equal?"
+ (equal? fixnum-min (- (- fixnum-min))))
+
+ (pass-if "binary double-negation of fixnum-min: ="
+ (= fixnum-min (- 0 (- 0 fixnum-min))))
+ (pass-if "binary double-negation of fixnum-min: eqv?"
+ (eqv? fixnum-min (- 0 (- 0 fixnum-min))))
+ (pass-if "binary double-negation of fixnum-min: equal?"
+ (equal? fixnum-min (- 0 (- 0 fixnum-min))))
+
(pass-if "-inum - +bignum"
(= #x-100000000000000000000000000000001
(- -1 #x100000000000000000000000000000000)))
@@ -2510,6 +2568,14 @@
(with-test-prefix "*"
+ (with-test-prefix "double-negation of fixnum-min"
+ (pass-if (= fixnum-min (* -1 (* -1 fixnum-min))))
+ (pass-if (eqv? fixnum-min (* -1 (* -1 fixnum-min))))
+ (pass-if (equal? fixnum-min (* -1 (* -1 fixnum-min))))
+ (pass-if (= fixnum-min (* (* fixnum-min -1) -1)))
+ (pass-if (eqv? fixnum-min (* (* fixnum-min -1) -1)))
+ (pass-if (equal? fixnum-min (* (* fixnum-min -1) -1))))
+
(with-test-prefix "inum * bignum"
(pass-if "0 * 2^256 = 0"
@@ -2563,6 +2629,11 @@
(with-test-prefix "/"
+ (with-test-prefix "double-negation of fixnum-min"
+ (pass-if (= fixnum-min (/ (/ fixnum-min -1) -1)))
+ (pass-if (eqv? fixnum-min (/ (/ fixnum-min -1) -1)))
+ (pass-if (equal? fixnum-min (/ (/ fixnum-min -1) -1))))
+
(pass-if "documented?"
(documented? /))
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. release_1-9-14-129-gb5c4058,
Andy Wingo <=