diff --git a/src/ikarus.boot b/src/ikarus.boot index 40f695c..2a12786 100644 Binary files a/src/ikarus.boot and b/src/ikarus.boot differ diff --git a/src/ikarus.compiler.ss b/src/ikarus.compiler.ss index bd2d93c..04bdd9e 100644 --- a/src/ikarus.compiler.ss +++ b/src/ikarus.compiler.ss @@ -141,7 +141,7 @@ [$bignum-byte-set! 3 effect] ;;; ratnums [$make-ratnum 2 value] - [$ratnum? 1 pred] + [ratnum? 1 pred] [$ratnum-n 1 value] [$ratnum-d 1 value] ;;; symbols @@ -1970,7 +1970,7 @@ [($symbol-string $symbol-unique-string) (andmap (check op symbol?) rand*)] [($constant-ref $set-constant! $intern $pcb-set! $pcb-ref $make-symbol - $make-ratnum $ratnum? $ratnum-n $ratnum-d + $make-ratnum ratnum? $ratnum-n $ratnum-d $symbol-value $set-symbol-value! $set-symbol-function! $symbol-plist $set-symbol-plist! $set-symbol-system-value! $set-symbol-system-value! $set-symbol-unique-string! @@ -3260,7 +3260,7 @@ [(symbol?) (indirect-type-pred vector-mask vector-tag #f symbol-record-tag rand* Lt Lf ac)] - [($ratnum?) + [(ratnum?) (indirect-type-pred vector-mask vector-tag #f ratnum-tag rand* Lt Lf ac)] [(procedure?) (type-pred closure-mask closure-tag rand* Lt Lf ac)] @@ -4131,7 +4131,7 @@ $set-port-output-index! $set-port-output-size!) (do-effect-prim op arg* (cons (movl (int void-object) eax) ac))] - [(fixnum? bignum? flonum? immediate? $fxzero? boolean? char? pair? + [(fixnum? bignum? flonum? ratnum? immediate? $fxzero? boolean? char? pair? vector? bytevector? string? symbol? procedure? null? not eof-object? $fx= $fx< $fx<= $fx> $fx>= eq? $char= $char< $char<= $char> $char>= $unbound-object? code? diff --git a/src/ikarus.numerics.ss b/src/ikarus.numerics.ss index 49bcc25..e339b2f 100644 --- a/src/ikarus.numerics.ss +++ b/src/ikarus.numerics.ss @@ -27,17 +27,21 @@ (library (ikarus generic-arithmetic) - (export + - * zero? = < <= > >= add1 sub1 quotient remainder + (export + - * / zero? = < <= > >= add1 sub1 quotient remainder positive? expt quotient+remainder number->string string->number) (import (ikarus system $fx) + (ikarus system $ratnums) + (ikarus system $bignums) (ikarus system $chars) (ikarus system $strings) - (except (ikarus) + - * zero? = < <= > >= add1 sub1 quotient + (except (ikarus) + - * / zero? = < <= > >= add1 sub1 quotient remainder quotient+remainder number->string positive? string->number expt)) + ;(define (ratnum? c) #f) + (define (fixnum->flonum x) (foreign-call "ikrt_fixnum_to_flonum" x)) (define (bignum->flonum x) @@ -266,7 +270,28 @@ [(x y) (binary/ x y)] [(x) (cond + [(fixnum? x) + (cond + [($fxzero? x) (error '/ "division by 0")] + [($fx> x 0) + (if ($fx= x 1) + 1 + ($make-ratnum 1 x))] + [else + (if ($fx= x -1) + -1 + ($make-ratnum -1 (- x)))])] + [(bignum? x) + (if ($bignum-positive? x) + ($make-ratnum 1 x) + ($make-ratnum -1 (- x)))] [(flonum? x) (foreign-call "ikrt_fl_invert" x)] + [(ratnum? x) + (let ([n ($ratnum-n x)] [d ($ratnum-d x)]) + (cond + [($fx= n 1) d] + [($fx= n -1) (- d)] + [else ($make-ratnum d n)]))] [else (error '/ "unspported argument ~s" x)])] [(x y z . rest) (let f ([a (binary/ x y)] [b z] [ls rest]) @@ -380,13 +405,21 @@ (lambda (x) (utf8-bytevector->string (foreign-call "ikrt_bignum_to_bytevector" x)))) - + + (define ratnum->string + (lambda (x) + (string-append + (number->string ($ratnum-n x)) + "/" + (number->string ($ratnum-d x))))) + (define number->string (lambda (x) (cond [(fixnum? x) (fixnum->string x)] [(bignum? x) (bignum->string x)] [(flonum? x) (flonum->string x)] + [(ratnum? x) (ratnum->string x)] [else (error 'number->string "~s is not a number" x)]))) (define modulo diff --git a/src/ikarus.predicates.ss b/src/ikarus.predicates.ss index d5b29a7..f2b3bd5 100644 --- a/src/ikarus.predicates.ss +++ b/src/ikarus.predicates.ss @@ -1,14 +1,14 @@ (library (ikarus predicates) - (export fixnum? flonum? bignum? number? complex? real? rational? + (export fixnum? flonum? bignum? ratnum? number? complex? real? rational? integer? exact? eof-object? bwp-object? immediate? boolean? char? vector? bytevector? string? procedure? null? pair? symbol? code? not weak-pair? eq? eqv? equal?) (import - (except (ikarus) fixnum? flonum? bignum? number? complex? real? + (except (ikarus) fixnum? flonum? bignum? ratnum? number? complex? real? rational? integer? exact? eof-object? bwp-object? immediate? boolean? char? vector? bytevector? string? procedure? null? pair? weak-pair? symbol? code? not eq? eqv? equal? @@ -18,13 +18,14 @@ (ikarus system $chars) (ikarus system $strings) (ikarus system $vectors) - (rename (only (ikarus) fixnum? flonum? bignum? eof-object? + (rename (only (ikarus) fixnum? flonum? bignum? ratnum? eof-object? bwp-object? immediate? boolean? char? vector? string? bytevector? procedure? null? pair? symbol? code? eq? port? input-port? output-port?) (fixnum? sys:fixnum?) (flonum? sys:flonum?) (bignum? sys:bignum?) + (ratnum? sys:ratnum?) (eof-object? sys:eof-object?) (bwp-object? sys:bwp-object?) (immediate? sys:immediate?) @@ -50,6 +51,9 @@ (define bignum? (lambda (x) (sys:bignum? x))) + (define ratnum? + (lambda (x) (sys:ratnum? x))) + (define flonum? (lambda (x) (sys:flonum? x))) @@ -57,7 +61,8 @@ (lambda (x) (or (sys:fixnum? x) (sys:bignum? x) - (sys:flonum? x)))) + (sys:flonum? x) + (sys:ratnum? x)))) (define complex? (lambda (x) (number? x))) @@ -70,6 +75,7 @@ (cond [(sys:fixnum? x) #t] [(sys:bignum? x) #t] + [(sys:ratnum? x) #t] [(sys:flonum? x) #f] [else (error 'rational? "~s is not a number" x)]))) @@ -78,6 +84,7 @@ (cond [(sys:fixnum? x) #t] [(sys:bignum? x) #t] + [(sys:ratnum? x) #f] [(sys:flonum? x) (error 'integer "dunno for ~s" x)] [else #f]))) diff --git a/src/makefile.ss b/src/makefile.ss index 6bdb47b..080cc80 100755 --- a/src/makefile.ss +++ b/src/makefile.ss @@ -362,12 +362,14 @@ [>= i r] [zero? i r] [* i r] + [/ i r] [+ i r] [add1 i] [sub1 i] [expt i] [number? i r] [bignum? i] + [ratnum? i] [integer? i] [flonum? i] [positive? i r] @@ -550,7 +552,6 @@ [$make-ratnum $rat] [$ratnum-n $rat] [$ratnum-d $rat] - [$ratnum? $rat] [$make-vector $vectors] [$vector-length $vectors]