conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

* 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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
src/ikarus.boot
View File

Binary file not shown.

8
src/ikarus.compiler.ss
View File

@ -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?

37
src/ikarus.numerics.ss
View File

@ -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])
@ -381,12 +406,20 @@
(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

15
src/ikarus.predicates.ss
View File

@ -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])))

3
src/makefile.ss
View File

@ -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]