1;;;
2;;; srfi-141
3;;;
4
5(define-module srfi-141
6  (export ceiling/ ceiling-quotient ceiling-remainder
7          round/ round-quotient round-remainder
8          euclidean/ euclidean-quotient euclidean-remainder
9          balanced/ balanced-quotient balanced-remainder
10
11          ;; These are in core (R7RS)
12          floor/ floor-quotient floor-remainder
13          truncate/ truncate-quotient truncate-remainder))
14(select-module srfi-141)
15
16(define (ceiling/ n d)
17  (receive (q r) (quotient&remainder n d)
18    (if (>= n 0)
19      (if (and (> d 0) (not (zero? r)))
20        (values (+ q 1) (- r d))
21        (values q r))
22      (if (or (> d 0) (zero? r))
23        (values q r)
24        (values (+ q 1) (- r d))))))
25
26(define (ceiling-quotient n d)
27  (values-ref (ceiling/ n d) 0))
28
29(define (ceiling-remainder n d)
30  (values-ref (ceiling/ n d) 1))
31
32;; euclidean is same as R6RS div/mod, except checks for integers.
33
34(define (euclidean/ n d)
35  (check-arg integer? n)
36  (check-arg integer? d)
37  (div-and-mod n d))
38
39(define (euclidean-quotient n d)
40  (check-arg integer? n)
41  (check-arg integer? d)
42  (div n d))
43
44(define (euclidean-remainder n d)
45  (check-arg integer? n)
46  (check-arg integer? d)
47  (mod n d))
48
49;; balanced is same as R6RS div0/mod0, except checks for integers.
50
51(define (balanced/ n d)
52  (check-arg integer? n)
53  (check-arg integer? d)
54  (div0-and-mod0 n d))
55
56(define (balanced-quotient n d)
57  (check-arg integer? n)
58  (check-arg integer? d)
59  (div0 n d))
60
61(define (balanced-remainder n d)
62  (check-arg integer? n)
63  (check-arg integer? d)
64  (mod0 n d))
65
66;; round and balanced only differ when n/d exactly falls on the midpoint.
67;; in inexact case, we simply use 'round' for it's faster.  we do need
68;; zero divisor check for that.
69
70(define (%exact-round/ n d)
71  (receive (q r) (div0-and-mod0 n d)
72    (if (and (odd? q)
73             (even? d)
74             (= (* (abs r) 2) (abs d)))
75      (if (> d 0)
76        (values (- q 1) (- r))
77        (values (+ q 1) (- r)))
78      (values q r))))
79
80(define (round/ n d)
81  (check-arg integer? n)
82  (check-arg integer? d)
83  (when (zero? d) (error "Attempt to calculate a division by zero"))
84  (if (and (exact? n) (exact? d))
85    (%exact-round/ n d)
86    (let1 q (round (/ n d))
87      (values q (- n (* d q))))))
88
89(define (round-quotient n d)
90  (check-arg integer? n)
91  (check-arg integer? d)
92  (when (zero? d) (error "Attempt to calculate a division by zero"))
93  (if (and (exact? n) (exact? d))
94    (values-ref (%exact-round/ n d) 0)
95    (round (/ n d))))
96
97(define (round-remainder n d)
98  (check-arg integer? n)
99  (check-arg integer? d)
100  (when (zero? d) (error "Attempt to calculate a division by zero"))
101  (if (and (exact? n) (exact? d))
102    (values-ref (%exact-round/ n d) 1)
103    (- n (* d (round (/ n d))))))
104