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

* Added flinteger? and fixed a bug in integer? when the argument is 

1.0.
This commit is contained in:
Abdulaziz Ghuloum 2007-09-10 20:47:17 -04:00
parent eeac68352a
commit a366a5f20f
5 changed files with 18 additions and 5 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.

6
src/ikarus.lists.ss
View File

@ -769,7 +769,11 @@
#t #t
(error who "length mismatch"))] (error who "length mismatch"))]
[else (error who "not a list")])] [else (error who "not a list")])]
[(f . ls*) (error who "vararg not supported yet in ~s" (length ls*))]))) [(f ls . ls*)
(unless (procedure? f)
(error who "~s is not a procedure" f))
(error who "vararg not yet supported")])))

14
src/ikarus.numerics.ss
View File

@ -9,13 +9,15 @@
(export $flonum->exact $flonum-signed-biased-exponent flonum-parts (export $flonum->exact $flonum-signed-biased-exponent flonum-parts
inexact->exact exact $flonum-rational? $flonum-integer? $flzero? inexact->exact exact $flonum-rational? $flonum-integer? $flzero?
$flnegative? flpositive? flabs fixnum->flonum $flnegative? flpositive? flabs fixnum->flonum
flsin flcos fltan flasin flacos flatan) flsin flcos fltan flasin flacos flatan
flinteger?)
(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 exact flpositive? flabs (except (ikarus) inexact->exact exact flpositive? flabs
fixnum->flonum flsin flcos fltan flasin flacos flatan)) fixnum->flonum flsin flcos fltan flasin flacos flatan
flinteger?))
(define (flonum-bytes f) (define (flonum-bytes f)
(unless (flonum? f) (unless (flonum? f)
@ -68,12 +70,18 @@
(fx= ($flonum-u8-ref x 3) 0) (fx= ($flonum-u8-ref x 3) 0)
(fx= ($flonum-u8-ref x 2) 0) (fx= ($flonum-u8-ref x 2) 0)
(fx= ($flonum-u8-ref x 1) 0))] (fx= ($flonum-u8-ref x 1) 0))]
[(fx<= be (fx+ 1075 -52)) ;;; too small to be an integer [(fx< be (fx+ 1075 -52)) ;;; too small to be an integer
#f] #f]
[else [else
(let ([v ($flonum->exact x)]) (let ([v ($flonum->exact x)])
(or (fixnum? v) (bignum? v)))]))) (or (fixnum? v) (bignum? v)))])))
(define (flinteger? x)
(if (flonum? x)
($flonum-integer? x)
(error 'flinteger? "~s is not a flonum" x)))
(define ($flzero? x) (define ($flzero? x)
(let ([be (fxlogand ($flonum-signed-biased-exponent x) (sub1 (fxsll 1 11)))]) (let ([be (fxlogand ($flonum-signed-biased-exponent x) (sub1 (fxsll 1 11)))])
(and (and

1
src/makefile.ss
View File

@ -502,6 +502,7 @@
[bignum? i] [bignum? i]
[ratnum? i] [ratnum? i]
[integer? i r] [integer? i r]
[flinteger? i]
[exact? i r] [exact? i r]
[inexact? i r] [inexact? i r]
[rational? i r] [rational? i r]

2
src/todo-r6rs.ss
View File

@ -335,7 +335,7 @@
[flnegative? S fl] [flnegative? S fl]
[flnumerator S fl] [flnumerator S fl]
[flodd? S fl] [flodd? S fl]
[flonum? S fl] [flonum? C fl]
[flpositive? S fl] [flpositive? S fl]
[flround C fl] [flround C fl]
[flsin C fl] [flsin C fl]