From 05bc37fe57e834253f433d0854172b1c6ba18a2f Mon Sep 17 00:00:00 2001
From: Abdulaziz Ghuloum <aghuloum@cs.indiana.edu>
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)))
+  
+
+  )
+