diff --git a/src/ikarus.boot b/src/ikarus.boot index 26ad1ba..0393e24 100644 Binary files a/src/ikarus.boot and b/src/ikarus.boot differ diff --git a/src/ikarus.numerics.ss b/src/ikarus.numerics.ss index 6118f74..1f75887 100644 --- a/src/ikarus.numerics.ss +++ b/src/ikarus.numerics.ss @@ -2371,3 +2371,57 @@ (go x eps)] [else (error who "~s is not a number" eps)])] [else (error who "~s is not a number" x)]))) + + +(library (ikarus r6rs-fu div/mod) + (export div mod div-and-mod div0 mod0 div0-and-mod0) + (import + (except (ikarus) + div mod div-and-mod div0 mod0 div0-and-mod0)) + + (define (div-and-mod x y) + (define who 'div-and-mod) + (unless (integer? x) + (error who "~s is not an integer" x)) + (unless (and (integer? y) (not (= y 0))) + (error who "~s is not an integer" y)) + (if (> x 0) + (quotient+remainder x y) + (if (> y 0) + (let-values ([(q r) (quotient+remainder (- x y) y)]) + (values q (+ r y))) + (let-values ([(q r) (quotient+remainder (+ x y) y)]) + (values q (- r y)))))) + + (define (div x y) + (let-values ([(n m) (div-and-mod x y)]) + n)) + + (define (mod x y) + (let-values ([(n m) (div-and-mod x y)]) + m)) + + (define (div0-and-mod0 x y) + (define who 'div0-and-mod0) + (unless (integer? x) + (error who "~s is not an integer" x)) + (unless (and (integer? y) (not (= y 0))) + (error who "~s is not an integer" y)) + (let-values ([(d m) (div-and-mod x y)]) + (if (> y 0) + (if (< m (/ y 2)) + (values d m) + (values (+ d 1) (- m y))) + (if (> m (/ y -2)) + (values (- d 1) (+ m y)) + (values d m))))) + + (define (div0 x y) + (let-values ([(n m) (div0-and-mod0 x y)]) + n)) + + (define (mod0 x y) + (let-values ([(n m) (div0-and-mod0 x y)]) + m))) + + diff --git a/src/makefile.ss b/src/makefile.ss index cfeb222..565ad9d 100755 --- a/src/makefile.ss +++ b/src/makefile.ss @@ -530,6 +530,12 @@ [modulo i r] [remainder i r] [quotient+remainder i r] + [div i] + [mod i] + [div-and-mod i] + [div0 i] + [mod0 i] + [div0-and-mod0 i] [number->string i r] [string->number i r] [flonum->string i] diff --git a/src/run-tests.ss b/src/run-tests.ss index 59e59c3..06639db 100755 --- a/src/run-tests.ss +++ b/src/run-tests.ss @@ -4,6 +4,7 @@ (tests reader) (tests bytevectors) (tests strings) + (tests numbers) (tests bignum-to-flonum) (tests string-to-number)) @@ -26,4 +27,5 @@ (test-exact-integer-sqrt) (test-bignum-to-flonum) (test-string-to-number) +(test-div-and-mod) (printf "Happy Happy Joy Joy\n") diff --git a/src/todo-r6rs.ss b/src/todo-r6rs.ss index d9d473b..ffc1685 100755 --- a/src/todo-r6rs.ss +++ b/src/todo-r6rs.ss @@ -134,10 +134,12 @@ [cons C ba se] [cos C ba se] [denominator C ba se] - [div S ba] - [div-and-mod S ba] - [div0 S ba] - [div0-and-mod0 S ba] + [div C ba] + [mod C ba] + [div-and-mod C ba] + [div0 C ba] + [mod0 C ba] + [div0-and-mod0 C ba] [dynamic-wind C ba se] [eq? C ba se] [equal? S ba se] @@ -177,8 +179,6 @@ [map C ba se] [max C ba se] [min C ba se] - [mod S ba] - [mod0 S ba] [nan? S ba] [negative? C ba se] [not C ba se]