mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-18 21:29:19 +02:00
60 lines
2.2 KiB
Scheme
60 lines
2.2 KiB
Scheme
;;;; division.scm -- portable R7RS (scheme division) implementation
|
|
;;
|
|
;; This code is written by Alex Shinn and placed in the
|
|
;; Public Domain. All warranties are disclaimed.
|
|
;;
|
|
;; This is basically the simplest possible implementation. Note the
|
|
;; code below assumes that either 1) exact ratios are supported and
|
|
;; are handled correctly by floor, ceiling and round, or 2) that
|
|
;; you're using a simple implementation with only fixnums and flonums.
|
|
;; In the intermediate case where you have bignums but no ratios there
|
|
;; will be a loss of precision for large values.
|
|
;;
|
|
;; We handle both cases by the use of the cond-expand form in
|
|
;; division.sld to conditionally define copy-exactness2. In case 1,
|
|
;; no adjustment is needed, whereas in case 2 we want to convert the
|
|
;; intermediate result back to exact if both inputs were exact.
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;; Floor, ceiling and round just compose their corresponding function
|
|
;; with division to determine the quotient, and compute the remainder
|
|
;; from that.
|
|
|
|
(define (ceiling-quotient n m)
|
|
(copy-exactness2 n m (ceiling (/ n m))))
|
|
(define (ceiling-remainder n m)
|
|
(- n (* m (ceiling-quotient n m))))
|
|
(define (ceiling/ n m)
|
|
(values (ceiling-quotient n m) (ceiling-remainder n m)))
|
|
|
|
(define (round-quotient n m)
|
|
(copy-exactness2 n m (round (/ n m))))
|
|
(define (round-remainder n m)
|
|
(- n (* m (round-quotient n m))))
|
|
(define (round/ n m)
|
|
(values (round-quotient n m) (round-remainder n m)))
|
|
|
|
;; Euclidean is defined as floor if the divisor is negative, and
|
|
;; ceiling otherwise.
|
|
|
|
(define (euclidean-quotient n m)
|
|
(if (> m 0) (floor-quotient n m) (ceiling-quotient n m)))
|
|
(define (euclidean-remainder n m)
|
|
(- n (* m (euclidean-quotient n m))))
|
|
(define (euclidean/ n m)
|
|
(values (euclidean-quotient n m) (euclidean-remainder n m)))
|
|
|
|
;; Balanced places the remainder in the half-open interval
|
|
;; [-m/2, m/2).
|
|
|
|
(define (balanced-remainder n m)
|
|
(let ((r (euclidean-remainder n m))
|
|
(m/2 (abs (/ m 2))))
|
|
(cond ((< r (- m/2)) (+ r (abs m)))
|
|
((>= r m/2) (- r (abs m)))
|
|
(else r))))
|
|
(define (balanced-quotient n m)
|
|
(quotient (- n (balanced-remainder n m)) m))
|
|
(define (balanced/ n m)
|
|
(values (balanced-quotient n m) (balanced-remainder n m)))
|