Import Upstream version 3a4upstream/3a4

1 files changed, 23 insertions, 14 deletions

diff --git a/root.scm b/root.scm
index 3cfdc19..7045e54 100644
--- a/root.scm
+++ b/root.scm
@@ -51,19 +51,28 @@
 ;;; School of Mathematics
 ;;; Japan Women's University
 ;@
-(define (integer-sqrt n)
-  (cond ((> n 24) (let* ((length/4 (quotient (- (integer-length n) 1) 4))
-			 (sqrt-top (integer-sqrt (ash n (* -2 length/4))))
-			 (init-value (ash sqrt-top length/4))
-			 (q (quotient n init-value))
-			 (iterated-value (quotient (+ init-value q) 2)))
-		    (if (odd? q) iterated-value
-			(let ((m (- iterated-value init-value)))
-			  (if (< (remainder n init-value) (* m m))
-			      (- iterated-value 1)
-			      iterated-value)))))
-	((> n 15) 4) ((> n 8) 3) ((> n 3) 2) ((> n 0) 1) ((> n -1) 0)
-	(else (slib:error 'integer-sqrt n))))
+(define integer-sqrt
+  (let ((table '#(0
+		  1 1 1
+		  2 2 2 2 2
+		  3 3 3 3 3 3 3
+		  4 4 4 4 4 4 4 4 4))
+	(square (lambda (x) (* x x))))
+    (lambda (n)
+      (define (isqrt n)
+	(if (> n 24)
+	    (let* ((len/4 (quotient (- (integer-length n) 1) 4))
+		   (top (isqrt (ash n (* -2 len/4))))
+		   (init (ash top len/4))
+		   (q (quotient n init))
+		   (iter (quotient (+ init q) 2)))
+	      (cond ((odd? q) iter)
+		    ((< (remainder n init) (square (- iter init))) (- iter 1))
+		    (else iter)))
+	    (vector-ref table n)))
+      (if (and (exact? n) (integer? n) (not (negative? n)))
+	  (isqrt n)
+	  (type-error 'integer-sqrt n)))))
 
 ;@
 (define (newton:find-root f df/dx x_0 prec)
@@ -174,7 +183,7 @@
   (letrec ((stop?
 	    (cond ((procedure? prec) prec)
 		  ((and (integer? prec) (negative? prec))
-		   (lambda (x0 x1 fmax count)
+		   (lambda (x0 f0 x1 f1 count)
 		     (>= count (- prec))))
 		  (else
 		   (lambda (x0 f0 x1 f1 count)