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

Added exact, inexact

This commit is contained in:
Abdulaziz Ghuloum 2007-08-28 18:15:27 -04:00
parent bbe077cd5f
commit efb59a4f46
5 changed files with 33 additions and 10 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.

29
src/ikarus.numerics.ss
View File

@ -7,13 +7,13 @@
(library (ikarus flonums) (library (ikarus flonums)
(export $flonum->exact $flonum-signed-biased-exponent flonum-parts (export $flonum->exact $flonum-signed-biased-exponent flonum-parts
inexact->exact $flonum-rational? $flonum-integer? $flzero? inexact->exact exact $flonum-rational? $flonum-integer? $flzero?
$flnegative? flpositive? flabs) $flnegative? flpositive? flabs)
(import (import
(ikarus system $bytevectors) (ikarus system $bytevectors)
(except (ikarus system $flonums) $flonum-signed-biased-exponent (except (ikarus system $flonums) $flonum-signed-biased-exponent
$flonum-rational? $flonum-integer?) $flonum-rational? $flonum-integer?)
(except (ikarus) inexact->exact flpositive? flabs)) (except (ikarus) inexact->exact exact flpositive? flabs))
(define (flonum-bytes f) (define (flonum-bytes f)
(unless (flonum? f) (unless (flonum? f)
@ -109,6 +109,16 @@
[else [else
(error 'inexact->exact "~s is not an inexact number" x)])) (error 'inexact->exact "~s is not an inexact number" x)]))
(define (exact x)
(cond
[(flonum? x)
(or ($flonum->exact x)
(error 'exact "~s has no real value" x))]
[(or (fixnum? x) (ratnum? x) (bignum? x)) x]
[else
(error 'exact "~s is not an inexact number" x)]))
(define (flpositive? x) (define (flpositive? x)
(if (flonum? x) (if (flonum? x)
($fl> x 0.0) ($fl> x 0.0)
@ -130,7 +140,7 @@
positive? negative? expt gcd lcm numerator denominator exact-integer-sqrt positive? negative? expt gcd lcm numerator denominator exact-integer-sqrt
quotient+remainder number->string string->number min max quotient+remainder number->string string->number min max
abs abs
exact->inexact floor ceiling round log fl=? fl<? fl<=? fl>? exact->inexact inexact floor ceiling round log fl=? fl<? fl<=? fl>?
fl>=? fl+ fl- fl* fl/ flsqrt flmin flzero? flnegative? fl>=? fl+ fl- fl* fl/ flsqrt flmin flzero? flnegative?
sin cos atan sqrt sin cos atan sqrt
flround flmax) flround flmax)
@ -146,7 +156,7 @@
remainder modulo even? odd? quotient+remainder number->string remainder modulo even? odd? quotient+remainder number->string
positive? negative? positive? negative?
string->number expt gcd lcm numerator denominator string->number expt gcd lcm numerator denominator
exact->inexact floor ceiling round log exact->inexact inexact floor ceiling round log
exact-integer-sqrt min max abs exact-integer-sqrt min max abs
fl=? fl<? fl<=? fl>? fl>=? fl+ fl- fl* fl/ flsqrt flmin fl=? fl<? fl<=? fl>? fl>=? fl+ fl- fl* fl/ flsqrt flmin
flzero? flnegative? flzero? flnegative?
@ -944,6 +954,17 @@
(error 'exact->inexact (error 'exact->inexact
"~s is not an exact number" x)]))) "~s is not an exact number" x)])))
(define inexact
(lambda (x)
(cond
[(fixnum? x) ($fixnum->flonum x)]
[(bignum? x) (bignum->flonum x)]
[(ratnum? x)
(binary/ (exact->inexact ($ratnum-n x)) ($ratnum-d x))]
[(flonum? x) x]
[else
(error 'inexact "~s is not a number" x)])))
(define inexact? (define inexact?
(lambda (x) (lambda (x)
(cond (cond

2
src/ikarus.reader.ss
View File

@ -613,7 +613,7 @@
(tokenize-decimal-no-digits p (cons c ls) exact?)] (tokenize-decimal-no-digits p (cons c ls) exact?)]
[else (num-error "invalid sequence" (cons c ls))]))) [else (num-error "invalid sequence" (cons c ls))])))
(define (num-error str ls) (define (num-error str ls)
(error "invalid numeric sequence ~a" (error 'read "invalid numeric sequence ~a"
(list->string (reverse ls)))) (list->string (reverse ls))))
(define (tokenize-hashnum p n) (define (tokenize-hashnum p n)
(let ([c (read-char p)]) (let ([c (read-char p)])

2
src/makefile.ss
View File

@ -466,6 +466,8 @@
[exact-integer-sqrt i r] [exact-integer-sqrt i r]
[exact->inexact i r] [exact->inexact i r]
[inexact->exact i r] [inexact->exact i r]
[exact i r]
[inexact i r]
[symbol? i r symbols] [symbol? i r symbols]
[symbol=? i r symbols] [symbol=? i r symbols]
[gensym? i symbols] [gensym? i symbols]

10
src/todo-r6rs.ss
View File

@ -142,7 +142,7 @@
[eqv? C ba] [eqv? C ba]
[error S ba] [error S ba]
[even? C ba] [even? C ba]
[exact S ba] [exact C ba]
[exact-integer-sqrt C ba] [exact-integer-sqrt C ba]
[exact? C ba] [exact? C ba]
[exp S ba] [exp S ba]
@ -152,7 +152,7 @@
[for-each S ba] [for-each S ba]
[gcd C ba] [gcd C ba]
[imag-part D ba] [imag-part D ba]
[inexact S ba] [inexact C ba]
[inexact? S ba] [inexact? S ba]
[infinite? S ba] [infinite? S ba]
[integer->char C ba] [integer->char C ba]
@ -178,7 +178,7 @@
[mod S ba] [mod S ba]
[mod0 S ba] [mod0 S ba]
[nan? S ba] [nan? S ba]
[negative? S ba] [negative? C ba]
[not C ba] [not C ba]
[null? C ba] [null? C ba]
[number->string C ba] [number->string C ba]
@ -528,9 +528,9 @@
[exit C pr] [exit C pr]
[delay D r5] [delay D r5]
[exact->inexact D r5] [exact->inexact C r5]
[force D r5] [force D r5]
[inexact->exact D r5] [inexact->exact C r5]
[modulo D r5] [modulo D r5]
[remainder D r5] [remainder D r5]
[null-environment D r5] [null-environment D r5]