From 74545737af472ae650d890d855f8f5c400d4b998 Mon Sep 17 00:00:00 2001 From: Taylor R Campbell Date: Fri, 30 Nov 2018 04:39:18 +0000 Subject: [PATCH] Use exact-integer-sqrt in sqrt for exact integers and rationals. --- src/runtime/arith.scm | 13 +++++++++++-- tests/runtime/test-arith.scm | 6 ++---- 2 files changed, 13 insertions(+), 6 deletions(-) diff --git a/src/runtime/arith.scm b/src/runtime/arith.scm index 0a50128cc..b47cd6fbf 100644 --- 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 7e29147da..559e023b5 100644 --- 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)) -- 2.25.1