From 0daa2f270a06d8f3f54410b97d3f755a03ac0c1d Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Sat, 5 Jan 2013 23:45:30 +0900 Subject: [PATCH] Ensuring exact-integer-sqrt always returns positive remainders. Moving out of (chibi) into only (scheme base). --- lib/init-7.scm | 7 ------- lib/scheme/extras.scm | 10 ++++++++++ 2 files changed, 10 insertions(+), 7 deletions(-) diff --git a/lib/init-7.scm b/lib/init-7.scm index b2147437..bf8a7b19 100644 --- a/lib/init-7.scm +++ b/lib/init-7.scm @@ -1039,13 +1039,6 @@ (define (eqv? a b) (if (eq? a b) #t (and (number? a) (equal? a b)))) -(define (exact-integer-sqrt x) - (let ((res (sqrt x))) - (if (exact? res) - (values res 0) - (let ((res (inexact->exact (truncate res)))) - (values res (- x (* res res))))))) - (define (zero? x) (= x 0)) (define (positive? x) (> x 0)) (define (negative? x) (< x 0)) diff --git a/lib/scheme/extras.scm b/lib/scheme/extras.scm index 95f78025..d7f70393 100644 --- a/lib/scheme/extras.scm +++ b/lib/scheme/extras.scm @@ -54,6 +54,16 @@ (define (floor/ n m) (values (floor-quotient n m) (floor-remainder n m))) +(define (exact-integer-sqrt x) + (let ((res (sqrt x))) + (if (exact? res) + (values res 0) + (let lp ((res (inexact->exact (truncate res)))) + (let ((rem (- x (* res res)))) + (if (negative? rem) + (lp (- res 1)) + (values res rem))))))) + ;; Adapted from Bawden's algorithm. (define (rationalize x e) (define (sr x y return)