Use exact-integer-sqrt in sqrt for exact integers and rationals.

diff --git a/src/runtime/arith.scm b/src/runtime/arith.scm
index 0a50128cc9037daa26c3f4074ff45f777c0f96a0..b47cd6fbffc8f39a24757694fa919db382992a68 100644 (file)
--- a/src/runtime/arith.scm
+++ b/src/runtime/arith.scm
@@ -1369,11 +1369,20 @@ USA.
        (let ((n (flo:round->exact guess)))
          (if (int:= x (int:* n n))
              n
-             guess))
+             (receive (s e) (exact-integer-sqrt x)
+               (if (int:zero? e)
+                   s
+                   guess))))
        (let ((q (flo:->rational guess)))
          (if (rat:= x (rat:square q))
              q
-             guess)))))
+             (receive (ns ne) (exact-integer-sqrt (rat:numerator x))
+               (if (int:zero? ne)
+                   (receive (ds de) (exact-integer-sqrt (rat:denominator x))
+                     (if (int:zero? de)
+                         (rat:/ ns ds)
+                         guess))
+                   guess)))))))
 
 (define (real:sqrt x)
   (if (flonum? x) (flo:sqrt x) (rat:sqrt x)))

diff --git a/tests/runtime/test-arith.scm b/tests/runtime/test-arith.scm
index 7e29147dac9af6cfd164692acc021d3db85158b2..559e023b555e871ff2f568f5ce17ecca481222b1 100644 (file)
--- a/tests/runtime/test-arith.scm
+++ b/tests/runtime/test-arith.scm
@@ -664,8 +664,7 @@ USA.
     (4. 2.)
     ;; Square root of perfect square x times 2i should be exactly x+xi.
     (,(make-rectangular 0 (* 2 (expt 2 -4000)))
-     ,(make-rectangular (expt 2 -2000) (expt 2 -2000))
-     ,expect-failure)
+     ,(make-rectangular (expt 2 -2000) (expt 2 -2000)))
     (,(make-rectangular 0. (* 2 flo:smallest-positive-subnormal))
      ,(make-rectangular (expt 2. (/ flo:subnormal-exponent-min 2))
                         (expt 2. (/ flo:subnormal-exponent-min 2))))
@@ -687,8 +686,7 @@ USA.
      ,expect-error)
     ;; Likewise, sqrt of perfect square x times -2i should be x-xi.
     (,(make-rectangular 0 (* -2 (expt 2 -4000)))
-     ,(make-rectangular (expt 2 -2000) (- (expt 2 -2000)))
-     ,expect-failure)
+     ,(make-rectangular (expt 2 -2000) (- (expt 2 -2000))))
     (,(make-rectangular 0. (- (* 2 flo:smallest-positive-subnormal)))
      ,(make-rectangular
        (expt 2. (/ flo:subnormal-exponent-min 2))