From 6a47ebde08ddbeafdea52236befcbfab025e6d9a Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Sun, 11 Nov 2012 17:07:34 +0900 Subject: [PATCH] Moving floor* and truncate* to (scheme base). --- lib/scheme/base.sld | 4 +++- lib/scheme/extras.scm | 15 +++++++++++++++ 2 files changed, 18 insertions(+), 1 deletion(-) diff --git a/lib/scheme/base.sld b/lib/scheme/base.sld index f84fc7f2..dcfbbd51 100644 --- a/lib/scheme/base.sld +++ b/lib/scheme/base.sld @@ -51,7 +51,9 @@ vector->list vector->string vector-copy vector-copy! vector-fill! vector-for-each vector-length 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" "extras.scm" "misc-macros.scm")) diff --git a/lib/scheme/extras.scm b/lib/scheme/extras.scm index 89f06b2e..c935ca52 100644 --- a/lib/scheme/extras.scm +++ b/lib/scheme/extras.scm @@ -39,6 +39,21 @@ (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. (define (rationalize x e) (define (sr x y return)