From 05bc37fe57e834253f433d0854172b1c6ba18a2f Mon Sep 17 00:00:00 2001 From: Abdulaziz Ghuloum Date: Thu, 29 Nov 2007 20:04:28 -0500 Subject: [PATCH] Fixed div-and-mod --- scheme/ikarus.numerics.ss | 59 +++++++++++++++++-------- scheme/last-revision | 2 +- scheme/run-tests.ss | 3 +- scheme/tests/div-and-mod.ss | 87 +++++++++++++++++++++++++++++++++++++ 4 files changed, 130 insertions(+), 21 deletions(-) create mode 100644 scheme/tests/div-and-mod.ss diff --git a/scheme/ikarus.numerics.ss b/scheme/ikarus.numerics.ss index b987190..cad5716 100644 --- a/scheme/ikarus.numerics.ss +++ b/scheme/ikarus.numerics.ss @@ -2728,27 +2728,48 @@ (except (ikarus) div mod div-and-mod div0 mod0 div0-and-mod0)) - (define (div-and-mod x y) + (define (div-and-mod n m) (define who 'div-and-mod) - (unless (integer? x) - (error who "not an integer" x)) - (unless (and (integer? y) (not (= y 0))) - (error who "not an integer" y)) - (if (>= x 0) - (quotient+remainder x y) - (if (> y 0) - (let-values ([(q r) (quotient+remainder (- x y) y)]) - (values q (+ r y))) - (let-values ([(q r) (quotient+remainder (+ x y) y)]) - (values q (- r y)))))) + (unless (integer? n) + (error who "not an integer" n)) + (unless (and (integer? m) (not (= m 0))) + (error who "not an integer" m)) + (let ([d0 (quotient n m)]) + (let ([m0 (- n (* d0 m))]) + (if (>= m0 0) + (values d0 m0) + (if (>= m 0) + (values (- d0 1) (+ m0 m)) + (values (+ d0 1) (- m0 m))))))) + + (define (div n m) + (define who 'div) + (unless (integer? n) + (error who "not an integer" n)) + (unless (and (integer? m) (not (= m 0))) + (error who "not an integer" m)) + (let ([d0 (quotient n m)]) + (let ([m0 (- n (* d0 m))]) + (if (>= m0 0) + d0 + (if (>= m 0) + (- d0 1) + (+ d0 1)))))) - (define (div x y) - (let-values ([(n m) (div-and-mod x y)]) - n)) - - (define (mod x y) - (let-values ([(n m) (div-and-mod x y)]) - m)) + (define (mod n m) + (define who 'mod) + (unless (integer? n) + (error who "not an integer" n)) + (unless (and (integer? m) (not (= m 0))) + (error who "not an integer" m)) + (let ([d0 (quotient n m)]) + (let ([m0 (- n (* d0 m))]) + (if (>= m0 0) + m0 + (if (>= m 0) + (+ m0 m) + (- m0 m)))))) + (define (div0-and-mod0 x y) (define who 'div0-and-mod0) diff --git a/scheme/last-revision b/scheme/last-revision index e29bf83..fdab865 100644 --- a/scheme/last-revision +++ b/scheme/last-revision @@ -1 +1 @@ -1143 +1144 diff --git a/scheme/run-tests.ss b/scheme/run-tests.ss index cf43d5e..00f73d8 100755 --- a/scheme/run-tests.ss +++ b/scheme/run-tests.ss @@ -25,6 +25,7 @@ ;(tests numbers) (tests bignums) (tests fixnums) + (tests div-and-mod) (tests fxcarry) (tests bignum-to-flonum) (tests string-to-number) @@ -55,7 +56,7 @@ (test-exact-integer-sqrt) (test-bignum-to-flonum) (test-string-to-number) -;(test-div-and-mod) +(test-div-and-mod) (test-bignums) (test-fxcarry) (test-lists) diff --git a/scheme/tests/div-and-mod.ss b/scheme/tests/div-and-mod.ss new file mode 100644 index 0000000..be9ecbf --- /dev/null +++ b/scheme/tests/div-and-mod.ss @@ -0,0 +1,87 @@ + +(library (tests div-and-mod) + (export test-div-and-mod test-div0-and-mod0) + (import (ikarus)) + + (define (test-div-and-mod) + (define (test x1 x2) + (let-values ([(d m) (div-and-mod x1 x2)]) + (printf "(div-and-mod ~s ~s) = ~s ~s\n" x1 x2 d m) + (assert (= d (div x1 x2))) + (assert (= m (mod x1 x2))) + (assert (<= 0 m)) + (assert (< m (abs x2))) + (assert (= x1 (+ (* d x2) m))))) + + (test +17 +3) + (test +17 -3) + (test -17 +3) + (test -17 -3) + (test +16 +3) + (test +16 -3) + (test -16 +3) + (test -16 -3) + (test +15 +3) + (test +15 -3) + (test -15 +3) + (test -15 -3) + (test +10 +4) + (test +10 -4) + (test -10 +4) + (test -10 -4)) + + + (define (test-div0-and-mod0) + (define (test x1 x2) + (let-values ([(d m) (div0-and-mod0 x1 x2)]) + (printf "(div0-and-mod0 ~s ~s) = ~s ~s\n" x1 x2 d m) + (assert (= d (div0 x1 x2))) + (assert (= m (mod0 x1 x2))) + (assert (<= (- (abs (/ x2 2))) m)) + (assert (< m (abs (/ x2 2)))) + (assert (= x1 (+ (* d x2) m))))) + (test +17 +3) + (test +17 -3) + (test -17 +3) + (test -17 -3) + (test +16 +3) + (test +16 -3) + (test -16 +3) + (test -16 -3) + (test +15 +3) + (test +15 -3) + (test -15 +3) + (test -15 -3) + (test +10 +4) + (test +10 -4) + (test -10 +4) + (test -10 -4) + + (test (least-fixnum) +1) + (test (least-fixnum) -1) ;; overflows + (test (greatest-fixnum) +1) + (test (greatest-fixnum) -1) + (test (least-fixnum) +2) + (test (least-fixnum) -2) + (test (greatest-fixnum) +2) + (test (greatest-fixnum) -2) + + (test 0 (least-fixnum)) + (test 0 (greatest-fixnum)) + (test +1 (least-fixnum)) + (test +1 (greatest-fixnum)) + (test -1 (least-fixnum)) + (test -1 (greatest-fixnum)) + (test +2 (least-fixnum)) + (test +2 (greatest-fixnum)) + (test -2 (least-fixnum)) + (test -2 (greatest-fixnum)) + + (test (least-fixnum) (least-fixnum)) + (test (greatest-fixnum) (least-fixnum)) + (test (least-fixnum) (greatest-fixnum)) + (test (greatest-fixnum) (greatest-fixnum))) + + + ) +