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