Moving floor* and truncate* to (scheme base).

This commit is contained in:
Alex Shinn 2012-11-11 17:07:34 +09:00
parent a03147a0d3
commit 6a47ebde08
2 changed files with 18 additions and 1 deletions

View file

@ -51,7 +51,9 @@
vector->list vector->string vector->list vector->string
vector-copy vector-copy! vector-fill! vector-for-each vector-length vector-copy vector-copy! vector-fill! vector-for-each vector-length
vector-map vector-ref vector-set! vector? when with-exception-handler vector-map vector-ref vector-set! vector? when with-exception-handler
write-bytevector write-char write-string write-u8 zero?) write-bytevector write-char write-string write-u8 zero?
truncate-quotient truncate-remainder truncate/
floor-quotient floor-remainder floor/)
(include "define-values.scm" (include "define-values.scm"
"extras.scm" "extras.scm"
"misc-macros.scm")) "misc-macros.scm"))

View file

@ -39,6 +39,21 @@
(define call/cc call-with-current-continuation) (define call/cc call-with-current-continuation)
(define truncate-quotient quotient)
(define truncate-remainder remainder)
(define (truncate/ n m)
(values (truncate-quotient n m) (truncate-remainder n m)))
(define (floor-quotient n m)
(let ((res (floor (/ n m))))
(if (and (exact? n) (exact? m))
(inexact->exact res)
res)))
(define (floor-remainder n m)
(- n (* m (floor-quotient n m))))
(define (floor/ n m)
(values (floor-quotient n m) (floor-remainder n m)))
;; Adapted from Bawden's algorithm. ;; Adapted from Bawden's algorithm.
(define (rationalize x e) (define (rationalize x e)
(define (sr x y return) (define (sr x y return)