[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.0-170-g882c8
From: |
Mark H Weaver |
Subject: |
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.0-170-g882c896 |
Date: |
Sat, 09 Apr 2011 20:11:56 +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=882c89636a2a4afa26cff17c7cdbc1d8c1cb2745
The branch, stable-2.0 has been updated
via 882c89636a2a4afa26cff17c7cdbc1d8c1cb2745 (commit)
from b1e13fb530e0f80334862e440860c054b61dbdd0 (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 882c89636a2a4afa26cff17c7cdbc1d8c1cb2745
Author: Mark H Weaver <address@hidden>
Date: Wed Apr 6 15:09:42 2011 -0400
Fix the R6RS exact-integer-sqrt and import into core guile
* libguile/numbers.c (scm_exact_integer_sqrt): New C procedure to
compute exact integer square root and remainder.
(scm_i_exact_integer_sqrt): New Scheme procedure `exact-integer-sqrt'
from the R6RS, imported into core guile.
* libguile/numbers.h: Add prototypes.
* module/rnrs/base.scm: Remove broken stub implementation, which would
fail badly when applied to large integers.
* doc/ref/api-data.texi: Add documentation.
* doc/ref/r6rs.texi: Change documentation for `exact-integer-sqrt' to a
stub that xrefs the core docs, as is done for other operations
available in core.
* test-suite/tests/numbers.test: Add tests.
* NEWS: Add news entries.
-----------------------------------------------------------------------
Summary of changes:
NEWS | 15 +++++++++
doc/ref/api-data.texi | 12 +++++++
doc/ref/r6rs.texi | 6 +---
libguile/numbers.c | 64 +++++++++++++++++++++++++++++++++++++++++
libguile/numbers.h | 2 +
module/rnrs/base.scm | 3 --
test-suite/tests/numbers.test | 48 ++++++++++++++++++++++++++++++
7 files changed, 142 insertions(+), 8 deletions(-)
diff --git a/NEWS b/NEWS
index b53386a..206153a 100644
--- a/NEWS
+++ b/NEWS
@@ -5,6 +5,21 @@ See the end for copying conditions.
Please send Guile bug reports to address@hidden
+Changes in 2.0.1 (since 2.0.0):
+
+* New procedures (see the manual for details)
+
+** exact-integer-sqrt, imported into core from (rnrs base)
+
+* Bugs fixed
+
+** exact-integer-sqrt now handles large integers correctly
+
+exact-integer-sqrt now works correctly when applied to very large
+integers (too large to be precisely represented by a C double).
+It has also been imported into core from (rnrs base).
+
+
Changes in 2.0.0 (changes since the 1.8.x series):
* New modules (see the manual for details)
diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi
index 2b407ea..760039a 100644
--- a/doc/ref/api-data.texi
+++ b/doc/ref/api-data.texi
@@ -959,6 +959,18 @@ Return @var{n} raised to the integer exponent
@end lisp
@end deffn
address@hidden {Scheme Procedure} {} exact-integer-sqrt @var{k}
address@hidden {C Function} void scm_exact_integer_sqrt (SCM @var{k}, SCM
address@hidden, SCM address@hidden)
+Return two exact non-negative integers @var{s} and @var{r}
+such that @address@hidden = @var{s}^2 + @var{r}} and
address@hidden@var{s}^2 <= @var{k} < (@var{s} + 1)^2}.
+An error is raised if @var{k} is not an exact non-negative integer.
+
address@hidden
+(exact-integer-sqrt 10) @result{} 3 and 1
address@hidden lisp
address@hidden deftypefn
+
@node Comparison
@subsubsection Comparison Predicates
@rnindex zero?
diff --git a/doc/ref/r6rs.texi b/doc/ref/r6rs.texi
index 8f89286..bc569ed 100644
--- a/doc/ref/r6rs.texi
+++ b/doc/ref/r6rs.texi
@@ -379,6 +379,7 @@ grouped below by the existing manual sections to which they
correspond.
@deffnx {Scheme Procedure} even? n
@deffnx {Scheme Procedure} gcd x ...
@deffnx {Scheme Procedure} lcm x ...
address@hidden {Scheme Procedure} exact-integer-sqrt k
@xref{Integer Operations}, for documentation.
@end deffn
@@ -525,11 +526,6 @@ This is a consequence of the requirement that
@end lisp
@end deffn
address@hidden {Scheme Procedure} exact-integer-sqrt k
-This procedure returns two nonnegative integer objects @code{s} and
address@hidden such that k = s^2 + r and k < (s + 1)^2.
address@hidden deffn
-
@deffn {Scheme Procedure} real-valued? obj
@deffnx {Scheme Procedure} rational-valued? obj
@deffnx {Scheme Procedure} integer-valued? obj
diff --git a/libguile/numbers.c b/libguile/numbers.c
index b4f2242..7475381 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -9555,6 +9555,70 @@ SCM_PRIMITIVE_GENERIC (scm_exp, "exp", 1, 0, 0,
#undef FUNC_NAME
+SCM_DEFINE (scm_i_exact_integer_sqrt, "exact-integer-sqrt", 1, 0, 0,
+ (SCM k),
+ "Return two exact non-negative integers @var{s} and @var{r}\n"
+ "such that @address@hidden = @var{s}^2 + @var{r}} and\n"
+ "@address@hidden <= @var{k} < (@var{s} + 1)^2}.\n"
+ "An error is raised if @var{k} is not an exact non-negative
integer.\n"
+ "\n"
+ "@lisp\n"
+ "(exact-integer-sqrt 10) @result{} 3 and 1\n"
+ "@end lisp")
+#define FUNC_NAME s_scm_i_exact_integer_sqrt
+{
+ SCM s, r;
+
+ scm_exact_integer_sqrt (k, &s, &r);
+ return scm_values (scm_list_2 (s, r));
+}
+#undef FUNC_NAME
+
+void
+scm_exact_integer_sqrt (SCM k, SCM *sp, SCM *rp)
+{
+ if (SCM_LIKELY (SCM_I_INUMP (k)))
+ {
+ scm_t_inum kk = SCM_I_INUM (k);
+ scm_t_inum uu = kk;
+ scm_t_inum ss;
+
+ if (SCM_LIKELY (kk > 0))
+ {
+ do
+ {
+ ss = uu;
+ uu = (ss + kk/ss) / 2;
+ } while (uu < ss);
+ *sp = SCM_I_MAKINUM (ss);
+ *rp = SCM_I_MAKINUM (kk - ss*ss);
+ }
+ else if (SCM_LIKELY (kk == 0))
+ *sp = *rp = SCM_INUM0;
+ else
+ scm_wrong_type_arg_msg ("exact-integer-sqrt", SCM_ARG1, k,
+ "exact non-negative integer");
+ }
+ else if (SCM_LIKELY (SCM_BIGP (k)))
+ {
+ SCM s, r;
+
+ if (mpz_sgn (SCM_I_BIG_MPZ (k)) < 0)
+ scm_wrong_type_arg_msg ("exact-integer-sqrt", SCM_ARG1, k,
+ "exact non-negative integer");
+ s = scm_i_mkbig ();
+ r = scm_i_mkbig ();
+ mpz_sqrtrem (SCM_I_BIG_MPZ (s), SCM_I_BIG_MPZ (r), SCM_I_BIG_MPZ (k));
+ scm_remember_upto_here_1 (k);
+ *sp = scm_i_normbig (s);
+ *rp = scm_i_normbig (r);
+ }
+ else
+ scm_wrong_type_arg_msg ("exact-integer-sqrt", SCM_ARG1, k,
+ "exact non-negative integer");
+}
+
+
SCM_PRIMITIVE_GENERIC (scm_sqrt, "sqrt", 1, 0, 0,
(SCM z),
"Return the square root of @var{z}. Of the two possible roots\n"
diff --git a/libguile/numbers.h b/libguile/numbers.h
index ab96981..d985830 100644
--- a/libguile/numbers.h
+++ b/libguile/numbers.h
@@ -289,6 +289,7 @@ SCM_API SCM scm_log (SCM z);
SCM_API SCM scm_log10 (SCM z);
SCM_API SCM scm_exp (SCM z);
SCM_API SCM scm_sqrt (SCM z);
+SCM_API void scm_exact_integer_sqrt (SCM k, SCM *s, SCM *r);
SCM_INTERNAL SCM scm_i_min (SCM x, SCM y, SCM rest);
SCM_INTERNAL SCM scm_i_max (SCM x, SCM y, SCM rest);
@@ -296,6 +297,7 @@ SCM_INTERNAL SCM scm_i_sum (SCM x, SCM y, SCM rest);
SCM_INTERNAL SCM scm_i_difference (SCM x, SCM y, SCM rest);
SCM_INTERNAL SCM scm_i_product (SCM x, SCM y, SCM rest);
SCM_INTERNAL SCM scm_i_divide (SCM x, SCM y, SCM rest);
+SCM_INTERNAL SCM scm_i_exact_integer_sqrt (SCM k);
/* bignum internal functions */
SCM_INTERNAL SCM scm_i_mkbig (void);
diff --git a/module/rnrs/base.scm b/module/rnrs/base.scm
index 2f5a218..b9dddab 100644
--- a/module/rnrs/base.scm
+++ b/module/rnrs/base.scm
@@ -103,9 +103,6 @@
(let ((sym (car syms)))
(and (symbol? sym) (symbol=?-internal (cdr syms) sym)))))
- (define (exact-integer-sqrt x)
- (let* ((s (exact (floor (sqrt x)))) (e (- x (* s s)))) (values s e)))
-
(define (real-valued? x)
(and (complex? x)
(zero? (imag-part x))))
diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test
index d94b6a1..b1f3d8b 100644
--- a/test-suite/tests/numbers.test
+++ b/test-suite/tests/numbers.test
@@ -4547,6 +4547,54 @@
(lognot #x-100000000000000000000000000000000))))
;;;
+;;; exact-integer-sqrt
+;;;
+
+(with-test-prefix "exact-integer-sqrt"
+ (define (non-negative-exact-integer? k)
+ (and (integer? k) (exact? k) (>= k 0)))
+
+ (define (test k)
+ (pass-if k (let-values (((s r) (exact-integer-sqrt k)))
+ (and (non-negative-exact-integer? s)
+ (non-negative-exact-integer? r)
+ (= k (+ r (* s s)))
+ (< k (* (1+ s) (1+ s)))))))
+
+ (define (test-wrong-type-arg k)
+ (pass-if-exception k exception:wrong-type-arg
+ (let-values (((s r) (exact-integer-sqrt k)))
+ #t)))
+
+ (pass-if (documented? exact-integer-sqrt))
+
+ (pass-if-exception "no args" exception:wrong-num-args
+ (exact-integer-sqrt))
+ (pass-if-exception "two args" exception:wrong-num-args
+ (exact-integer-sqrt 123 456))
+
+ (test 0)
+ (test 1)
+ (test 9)
+ (test 10)
+ (test fixnum-max)
+ (test (1+ fixnum-max))
+ (test (* fixnum-max fixnum-max))
+ (test (+ 1 (* fixnum-max fixnum-max)))
+ (test (expt 10 100))
+ (test (+ 3 (expt 10 100)))
+
+ (test-wrong-type-arg -1)
+ (test-wrong-type-arg 1/9)
+ (test-wrong-type-arg fixnum-min)
+ (test-wrong-type-arg (1- fixnum-min))
+ (test-wrong-type-arg 1.0)
+ (test-wrong-type-arg 1.5)
+ (test-wrong-type-arg "foo")
+ (test-wrong-type-arg 'foo))
+
+
+;;;
;;; sqrt
;;;
hooks/post-receive
--
GNU Guile
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.0-170-g882c896,
Mark H Weaver <=