* Added ratnum? to (ikarus).

* Modified some definitions of the numeric predicates to recognize 
  ratnums.
This commit is contained in:
Abdulaziz Ghuloum 2007-05-20 23:23:54 -04:00
parent 67765257cf
commit 23769d5b09
5 changed files with 53 additions and 12 deletions

Binary file not shown.

View File

@ -141,7 +141,7 @@
[$bignum-byte-set! 3 effect] [$bignum-byte-set! 3 effect]
;;; ratnums ;;; ratnums
[$make-ratnum 2 value] [$make-ratnum 2 value]
[$ratnum? 1 pred] [ratnum? 1 pred]
[$ratnum-n 1 value] [$ratnum-n 1 value]
[$ratnum-d 1 value] [$ratnum-d 1 value]
;;; symbols ;;; symbols
@ -1970,7 +1970,7 @@
[($symbol-string $symbol-unique-string) [($symbol-string $symbol-unique-string)
(andmap (check op symbol?) rand*)] (andmap (check op symbol?) rand*)]
[($constant-ref $set-constant! $intern $pcb-set! $pcb-ref $make-symbol [($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! $symbol-value $set-symbol-value! $set-symbol-function! $symbol-plist $set-symbol-plist!
$set-symbol-system-value! $set-symbol-system-value! $set-symbol-system-value! $set-symbol-system-value!
$set-symbol-unique-string! $set-symbol-unique-string!
@ -3260,7 +3260,7 @@
[(symbol?) [(symbol?)
(indirect-type-pred vector-mask vector-tag #f (indirect-type-pred vector-mask vector-tag #f
symbol-record-tag rand* Lt Lf ac)] symbol-record-tag rand* Lt Lf ac)]
[($ratnum?) [(ratnum?)
(indirect-type-pred vector-mask vector-tag #f (indirect-type-pred vector-mask vector-tag #f
ratnum-tag rand* Lt Lf ac)] ratnum-tag rand* Lt Lf ac)]
[(procedure?) (type-pred closure-mask closure-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!) $set-port-output-index! $set-port-output-size!)
(do-effect-prim op arg* (do-effect-prim op arg*
(cons (movl (int void-object) eax) ac))] (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? vector? bytevector? string? symbol?
procedure? null? not eof-object? $fx= $fx< $fx<= $fx> $fx>= eq? procedure? null? not eof-object? $fx= $fx< $fx<= $fx> $fx>= eq?
$char= $char< $char<= $char> $char>= $unbound-object? code? $char= $char< $char<= $char> $char>= $unbound-object? code?

View File

@ -27,17 +27,21 @@
(library (ikarus generic-arithmetic) (library (ikarus generic-arithmetic)
(export + - * zero? = < <= > >= add1 sub1 quotient remainder (export + - * / zero? = < <= > >= add1 sub1 quotient remainder
positive? expt positive? expt
quotient+remainder number->string string->number) quotient+remainder number->string string->number)
(import (import
(ikarus system $fx) (ikarus system $fx)
(ikarus system $ratnums)
(ikarus system $bignums)
(ikarus system $chars) (ikarus system $chars)
(ikarus system $strings) (ikarus system $strings)
(except (ikarus) + - * zero? = < <= > >= add1 sub1 quotient (except (ikarus) + - * / zero? = < <= > >= add1 sub1 quotient
remainder quotient+remainder number->string positive? remainder quotient+remainder number->string positive?
string->number expt)) string->number expt))
;(define (ratnum? c) #f)
(define (fixnum->flonum x) (define (fixnum->flonum x)
(foreign-call "ikrt_fixnum_to_flonum" x)) (foreign-call "ikrt_fixnum_to_flonum" x))
(define (bignum->flonum x) (define (bignum->flonum x)
@ -266,7 +270,28 @@
[(x y) (binary/ x y)] [(x y) (binary/ x y)]
[(x) [(x)
(cond (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)] [(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)])] [else (error '/ "unspported argument ~s" x)])]
[(x y z . rest) [(x y z . rest)
(let f ([a (binary/ x y)] [b z] [ls rest]) (let f ([a (binary/ x y)] [b z] [ls rest])
@ -381,12 +406,20 @@
(utf8-bytevector->string (utf8-bytevector->string
(foreign-call "ikrt_bignum_to_bytevector" x)))) (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 (define number->string
(lambda (x) (lambda (x)
(cond (cond
[(fixnum? x) (fixnum->string x)] [(fixnum? x) (fixnum->string x)]
[(bignum? x) (bignum->string x)] [(bignum? x) (bignum->string x)]
[(flonum? x) (flonum->string x)] [(flonum? x) (flonum->string x)]
[(ratnum? x) (ratnum->string x)]
[else (error 'number->string "~s is not a number" x)]))) [else (error 'number->string "~s is not a number" x)])))
(define modulo (define modulo

View File

@ -1,14 +1,14 @@
(library (ikarus predicates) (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? integer? exact? eof-object? bwp-object? immediate?
boolean? char? vector? bytevector? string? procedure? null? pair? boolean? char? vector? bytevector? string? procedure? null? pair?
symbol? code? not weak-pair? eq? eqv? equal?) symbol? code? not weak-pair? eq? eqv? equal?)
(import (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? rational? integer? exact? eof-object? bwp-object?
immediate? boolean? char? vector? bytevector? string? procedure? immediate? boolean? char? vector? bytevector? string? procedure?
null? pair? weak-pair? symbol? code? not eq? eqv? equal? null? pair? weak-pair? symbol? code? not eq? eqv? equal?
@ -18,13 +18,14 @@
(ikarus system $chars) (ikarus system $chars)
(ikarus system $strings) (ikarus system $strings)
(ikarus system $vectors) (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? bwp-object? immediate? boolean? char? vector? string?
bytevector? procedure? null? pair? symbol? code? eq? bytevector? procedure? null? pair? symbol? code? eq?
port? input-port? output-port?) port? input-port? output-port?)
(fixnum? sys:fixnum?) (fixnum? sys:fixnum?)
(flonum? sys:flonum?) (flonum? sys:flonum?)
(bignum? sys:bignum?) (bignum? sys:bignum?)
(ratnum? sys:ratnum?)
(eof-object? sys:eof-object?) (eof-object? sys:eof-object?)
(bwp-object? sys:bwp-object?) (bwp-object? sys:bwp-object?)
(immediate? sys:immediate?) (immediate? sys:immediate?)
@ -50,6 +51,9 @@
(define bignum? (define bignum?
(lambda (x) (sys:bignum? x))) (lambda (x) (sys:bignum? x)))
(define ratnum?
(lambda (x) (sys:ratnum? x)))
(define flonum? (define flonum?
(lambda (x) (sys:flonum? x))) (lambda (x) (sys:flonum? x)))
@ -57,7 +61,8 @@
(lambda (x) (lambda (x)
(or (sys:fixnum? x) (or (sys:fixnum? x)
(sys:bignum? x) (sys:bignum? x)
(sys:flonum? x)))) (sys:flonum? x)
(sys:ratnum? x))))
(define complex? (define complex?
(lambda (x) (number? x))) (lambda (x) (number? x)))
@ -70,6 +75,7 @@
(cond (cond
[(sys:fixnum? x) #t] [(sys:fixnum? x) #t]
[(sys:bignum? x) #t] [(sys:bignum? x) #t]
[(sys:ratnum? x) #t]
[(sys:flonum? x) #f] [(sys:flonum? x) #f]
[else (error 'rational? "~s is not a number" x)]))) [else (error 'rational? "~s is not a number" x)])))
@ -78,6 +84,7 @@
(cond (cond
[(sys:fixnum? x) #t] [(sys:fixnum? x) #t]
[(sys:bignum? x) #t] [(sys:bignum? x) #t]
[(sys:ratnum? x) #f]
[(sys:flonum? x) (error 'integer "dunno for ~s" x)] [(sys:flonum? x) (error 'integer "dunno for ~s" x)]
[else #f]))) [else #f])))

View File

@ -362,12 +362,14 @@
[>= i r] [>= i r]
[zero? i r] [zero? i r]
[* i r] [* i r]
[/ i r]
[+ i r] [+ i r]
[add1 i] [add1 i]
[sub1 i] [sub1 i]
[expt i] [expt i]
[number? i r] [number? i r]
[bignum? i] [bignum? i]
[ratnum? i]
[integer? i] [integer? i]
[flonum? i] [flonum? i]
[positive? i r] [positive? i r]
@ -550,7 +552,6 @@
[$make-ratnum $rat] [$make-ratnum $rat]
[$ratnum-n $rat] [$ratnum-n $rat]
[$ratnum-d $rat] [$ratnum-d $rat]
[$ratnum? $rat]
[$make-vector $vectors] [$make-vector $vectors]
[$vector-length $vectors] [$vector-length $vectors]