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

* exact->inexact is now implemnted. 

* +, -, and * now handles flonums by converting exact arguments to
  inexact if the other argument is a flonum.
This commit is contained in:
Abdulaziz Ghuloum 2007-01-20 19:26:17 -05:00
parent 96ad8a04a4
commit 783beb990b
8 changed files with 202 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
benchmarks/bench
View File

@ -380,7 +380,7 @@ henchman_exec ()
} }
# ----------------------------------------------------------------------------- # -----------------------------------------------------------------------------
# Definitions specific to Chez Scheme # Definitions specific to Ikarus Scheme
ikarus_comp () ikarus_comp ()
{ {

16
benchmarks/prefix/prefix-ikarus.scm
View File

@ -114,10 +114,10 @@
(syntax-rules () (syntax-rules ()
((FLOATvector x ...) (vector x ...)))) ((FLOATvector x ...) (vector x ...))))
;; (define-syntax FLOATmake-vector (define-syntax FLOATmake-vector
;; (syntax-rules () (syntax-rules ()
;; ((FLOATmake-vector n) (make-vector n 0.0)) ((FLOATmake-vector n) (make-vector n 0.0))
;; ((FLOATmake-vector n init) (make-vector n init)))) ((FLOATmake-vector n init) (make-vector n init))))
(define-syntax FLOATvector-ref (define-syntax FLOATvector-ref
(syntax-rules () (syntax-rules ()
@ -328,10 +328,10 @@
(syntax-rules () (syntax-rules ()
((FLOATvector x ...) (vector x ...)))) ((FLOATvector x ...) (vector x ...))))
;; (define-syntax FLOATmake-vector (define-syntax FLOATmake-vector
;; (syntax-rules () (syntax-rules ()
;; ((FLOATmake-vector n) (make-vector n 0.0)) ((FLOATmake-vector n) (make-vector n 0.0))
;; ((FLOATmake-vector n init) (make-vector n init)))) ((FLOATmake-vector n init) (make-vector n init))))
(define-syntax FLOATvector-ref (define-syntax FLOATvector-ref
(syntax-rules () (syntax-rules ()

110
benchmarks/results.Ikarus-Scheme-r6rs
View File

@ -1,6 +1,6 @@
**************************** ****************************
Benchmarking Ikarus-Scheme-r6rs on Sat Jan 20 16:21:46 EST 2007 under Darwin 10-231-80-30.dhcp-bl.indiana.edu 8.8.3 Darwin Kernel Version 8.8.3: Wed Oct 18 21:57:10 PDT 2006; root:xnu-792.15.4.obj~4/RELEASE_I386 i386 i386 Benchmarking Ikarus-Scheme-r6rs on Sat Jan 20 19:09:21 EST 2007 under Darwin 10-231-80-30.dhcp-bl.indiana.edu 8.8.3 Darwin Kernel Version 8.8.3: Wed Oct 18 21:57:10 PDT 2006; root:xnu-792.15.4.obj~4/RELEASE_I386 i386 i386
Testing boyer under Ikarus-Scheme-r6rs Testing boyer under Ikarus-Scheme-r6rs
Compiling... Compiling...
@ -11,7 +11,7 @@ Copyright (c) 2006-2007 Abdulaziz Ghuloum
> >
running stats for (run-bench name count ok? run): running stats for (run-bench name count ok? run):
17 collections 17 collections
1.019s real 1.010s user 0.007s sys 1.024s real 1.008s user 0.010s sys
72832056 bytes allocated 72832056 bytes allocated
Testing browse under Ikarus-Scheme-r6rs Testing browse under Ikarus-Scheme-r6rs
@ -23,7 +23,7 @@ Copyright (c) 2006-2007 Abdulaziz Ghuloum
> >
running stats for (run-bench name count ok? run): running stats for (run-bench name count ok? run):
151 collections 151 collections
2.551s real 2.519s user 0.031s sys 2.578s real 2.526s user 0.039s sys
633609656 bytes allocated 633609656 bytes allocated
Testing cpstak under Ikarus-Scheme-r6rs Testing cpstak under Ikarus-Scheme-r6rs
@ -35,7 +35,7 @@ Copyright (c) 2006-2007 Abdulaziz Ghuloum
> >
running stats for (run-bench name count ok? run): running stats for (run-bench name count ok? run):
243 collections 243 collections
2.575s real 2.528s user 0.042s sys 2.605s real 2.534s user 0.053s sys
1017728056 bytes allocated 1017728056 bytes allocated
Testing ctak under Ikarus-Scheme-r6rs Testing ctak under Ikarus-Scheme-r6rs
@ -47,7 +47,7 @@ Copyright (c) 2006-2007 Abdulaziz Ghuloum
> >
running stats for (run-bench name count ok? run): running stats for (run-bench name count ok? run):
127 collections 127 collections
1.329s real 1.109s user 0.219s sys 1.363s real 1.118s user 0.236s sys
534317320 bytes allocated 534317320 bytes allocated
Testing dderiv under Ikarus-Scheme-r6rs Testing dderiv under Ikarus-Scheme-r6rs
@ -59,7 +59,7 @@ Copyright (c) 2006-2007 Abdulaziz Ghuloum
> >
running stats for (run-bench name count ok? run): running stats for (run-bench name count ok? run):
248 collections 248 collections
1.488s real 1.469s user 0.013s sys 1.486s real 1.463s user 0.016s sys
1040000056 bytes allocated 1040000056 bytes allocated
Testing deriv under Ikarus-Scheme-r6rs Testing deriv under Ikarus-Scheme-r6rs
@ -71,7 +71,7 @@ Copyright (c) 2006-2007 Abdulaziz Ghuloum
> >
running stats for (run-bench name count ok? run): running stats for (run-bench name count ok? run):
187 collections 187 collections
0.991s real 0.979s user 0.012s sys 0.984s real 0.963s user 0.015s sys
784000056 bytes allocated 784000056 bytes allocated
Testing destruc under Ikarus-Scheme-r6rs Testing destruc under Ikarus-Scheme-r6rs
@ -83,7 +83,7 @@ Copyright (c) 2006-2007 Abdulaziz Ghuloum
> >
running stats for (run-bench name count ok? run): running stats for (run-bench name count ok? run):
61 collections 61 collections
3.282s real 3.258s user 0.017s sys 3.416s real 3.378s user 0.022s sys
257444056 bytes allocated 257444056 bytes allocated
Testing diviter under Ikarus-Scheme-r6rs Testing diviter under Ikarus-Scheme-r6rs
@ -95,7 +95,7 @@ Copyright (c) 2006-2007 Abdulaziz Ghuloum
> >
running stats for (run-bench name count ok? run): running stats for (run-bench name count ok? run):
191 collections 191 collections
1.948s real 1.935s user 0.012s sys 1.973s real 1.944s user 0.017s sys
800000056 bytes allocated 800000056 bytes allocated
Testing divrec under Ikarus-Scheme-r6rs Testing divrec under Ikarus-Scheme-r6rs
@ -107,7 +107,7 @@ Copyright (c) 2006-2007 Abdulaziz Ghuloum
> >
running stats for (run-bench name count ok? run): running stats for (run-bench name count ok? run):
191 collections 191 collections
1.975s real 1.962s user 0.012s sys 1.995s real 1.972s user 0.016s sys
800000056 bytes allocated 800000056 bytes allocated
Testing puzzle under Ikarus-Scheme-r6rs Testing puzzle under Ikarus-Scheme-r6rs
@ -119,7 +119,7 @@ Copyright (c) 2006-2007 Abdulaziz Ghuloum
> >
running stats for (run-bench name count ok? run): running stats for (run-bench name count ok? run):
17 collections 17 collections
4.370s real 4.357s user 0.011s sys 4.453s real 4.426s user 0.017s sys
70742488 bytes allocated 70742488 bytes allocated
Testing takl under Ikarus-Scheme-r6rs Testing takl under Ikarus-Scheme-r6rs
@ -131,7 +131,7 @@ Copyright (c) 2006-2007 Abdulaziz Ghuloum
> >
running stats for (run-bench name count ok? run): running stats for (run-bench name count ok? run):
no collections no collections
1.519s real 1.518s user 0.000s sys 1.524s real 1.519s user 0.002s sys
48 bytes allocated 48 bytes allocated
Testing triangl under Ikarus-Scheme-r6rs Testing triangl under Ikarus-Scheme-r6rs
@ -143,7 +143,7 @@ Copyright (c) 2006-2007 Abdulaziz Ghuloum
> >
running stats for (run-bench name count ok? run): running stats for (run-bench name count ok? run):
no collections no collections
5.333s real 5.332s user 0.001s sys 5.408s real 5.387s user 0.007s sys
930048 bytes allocated 930048 bytes allocated
Testing fft under Ikarus-Scheme-r6rs Testing fft under Ikarus-Scheme-r6rs
@ -152,7 +152,8 @@ Running...
Ikarus Scheme (Build 2007-01-20) Ikarus Scheme (Build 2007-01-20)
Copyright (c) 2006-2007 Abdulaziz Ghuloum Copyright (c) 2006-2007 Abdulaziz Ghuloum
> Error in tokenize: invalid number syntax: 6.. >
Error in top-level-value: / is unbound.
> >
Testing fib under Ikarus-Scheme-r6rs Testing fib under Ikarus-Scheme-r6rs
@ -164,7 +165,7 @@ Copyright (c) 2006-2007 Abdulaziz Ghuloum
> >
running stats for (run-bench name count ok? run): running stats for (run-bench name count ok? run):
no collections no collections
6.741s real 6.732s user 0.002s sys 7.563s real 7.531s user 0.010s sys
48 bytes allocated 48 bytes allocated
Testing fibfp under Ikarus-Scheme-r6rs Testing fibfp under Ikarus-Scheme-r6rs
@ -173,7 +174,8 @@ Running...
Ikarus Scheme (Build 2007-01-20) Ikarus Scheme (Build 2007-01-20)
Copyright (c) 2006-2007 Abdulaziz Ghuloum Copyright (c) 2006-2007 Abdulaziz Ghuloum
> Error in tokenize: invalid number syntax: 2.. >
Error in <: 35.0 is not a number.
> >
Testing mbrot under Ikarus-Scheme-r6rs Testing mbrot under Ikarus-Scheme-r6rs
@ -182,7 +184,8 @@ Running...
Ikarus Scheme (Build 2007-01-20) Ikarus Scheme (Build 2007-01-20)
Copyright (c) 2006-2007 Abdulaziz Ghuloum Copyright (c) 2006-2007 Abdulaziz Ghuloum
> Error in tokenize: invalid number syntax: 16.. >
Error in >: 0.4138 is not a number.
> >
Testing pnpoly under Ikarus-Scheme-r6rs Testing pnpoly under Ikarus-Scheme-r6rs
@ -191,7 +194,7 @@ Running...
Ikarus Scheme (Build 2007-01-20) Ikarus Scheme (Build 2007-01-20)
Copyright (c) 2006-2007 Abdulaziz Ghuloum Copyright (c) 2006-2007 Abdulaziz Ghuloum
> Error in tokenize: invalid number syntax: 0.. > Error in andmap: vararg not supported yet.
> >
Testing sum under Ikarus-Scheme-r6rs Testing sum under Ikarus-Scheme-r6rs
@ -203,7 +206,7 @@ Copyright (c) 2006-2007 Abdulaziz Ghuloum
> >
running stats for (run-bench name count ok? run): running stats for (run-bench name count ok? run):
no collections no collections
4.222s real 4.215s user 0.001s sys 6.137s real 6.116s user 0.008s sys
80048 bytes allocated 80048 bytes allocated
Testing sumfp under Ikarus-Scheme-r6rs Testing sumfp under Ikarus-Scheme-r6rs
@ -212,7 +215,8 @@ Running...
Ikarus Scheme (Build 2007-01-20) Ikarus Scheme (Build 2007-01-20)
Copyright (c) 2006-2007 Abdulaziz Ghuloum Copyright (c) 2006-2007 Abdulaziz Ghuloum
> Error in tokenize: invalid number syntax: 0.. >
Error in <: 10000.0 is not a number.
> >
Testing tak under Ikarus-Scheme-r6rs Testing tak under Ikarus-Scheme-r6rs
@ -224,7 +228,7 @@ Copyright (c) 2006-2007 Abdulaziz Ghuloum
> >
running stats for (run-bench name count ok? run): running stats for (run-bench name count ok? run):
no collections no collections
3.696s real 3.694s user 0.000s sys 3.974s real 3.960s user 0.005s sys
48 bytes allocated 48 bytes allocated
Testing ack under Ikarus-Scheme-r6rs Testing ack under Ikarus-Scheme-r6rs
@ -236,7 +240,7 @@ Copyright (c) 2006-2007 Abdulaziz Ghuloum
> >
running stats for (run-bench name count ok? run): running stats for (run-bench name count ok? run):
no collections no collections
0.522s real 0.522s user 0.000s sys 0.500s real 0.498s user 0.000s sys
48 bytes allocated 48 bytes allocated
Testing array1 under Ikarus-Scheme-r6rs Testing array1 under Ikarus-Scheme-r6rs
@ -248,7 +252,7 @@ Copyright (c) 2006-2007 Abdulaziz Ghuloum
> >
running stats for (run-bench name count ok? run): running stats for (run-bench name count ok? run):
40 collections 40 collections
2.071s real 2.035s user 0.035s sys 2.139s real 2.094s user 0.039s sys
160005672 bytes allocated 160005672 bytes allocated
Testing cat under Ikarus-Scheme-r6rs Testing cat under Ikarus-Scheme-r6rs
@ -260,7 +264,7 @@ Copyright (c) 2006-2007 Abdulaziz Ghuloum
> >
running stats for (run-bench name count ok? run): running stats for (run-bench name count ok? run):
no collections no collections
0.211s real 0.174s user 0.036s sys 0.220s real 0.175s user 0.043s sys
34520 bytes allocated 34520 bytes allocated
Testing string under Ikarus-Scheme-r6rs Testing string under Ikarus-Scheme-r6rs
@ -272,7 +276,7 @@ Copyright (c) 2006-2007 Abdulaziz Ghuloum
> >
running stats for (run-bench name count ok? run): running stats for (run-bench name count ok? run):
10 collections 10 collections
0.303s real 0.292s user 0.010s sys 0.303s real 0.291s user 0.011s sys
31464952 bytes allocated 31464952 bytes allocated
Testing sum1 under Ikarus-Scheme-r6rs Testing sum1 under Ikarus-Scheme-r6rs
@ -281,8 +285,9 @@ Running...
Ikarus Scheme (Build 2007-01-20) Ikarus Scheme (Build 2007-01-20)
Copyright (c) 2006-2007 Abdulaziz Ghuloum Copyright (c) 2006-2007 Abdulaziz Ghuloum
> Error in tokenize: invalid number syntax: 0..
> >
./bench: line 1400: 29584 Done printf "$REPLCOMMANDS" "$1"
29585 Segmentation fault | ikarus
Testing sumloop under Ikarus-Scheme-r6rs Testing sumloop under Ikarus-Scheme-r6rs
Compiling... Compiling...
@ -293,7 +298,7 @@ Copyright (c) 2006-2007 Abdulaziz Ghuloum
> >
running stats for (run-bench name count ok? run): running stats for (run-bench name count ok? run):
no collections no collections
5.562s real 5.560s user 0.001s sys 5.110s real 5.090s user 0.005s sys
64 bytes allocated 64 bytes allocated
Testing tail under Ikarus-Scheme-r6rs Testing tail under Ikarus-Scheme-r6rs
@ -305,7 +310,7 @@ Copyright (c) 2006-2007 Abdulaziz Ghuloum
> >
running stats for (run-bench name count ok? run): running stats for (run-bench name count ok? run):
18 collections 18 collections
0.578s real 0.499s user 0.078s sys 0.567s real 0.478s user 0.087s sys
77128368 bytes allocated 77128368 bytes allocated
Testing wc under Ikarus-Scheme-r6rs Testing wc under Ikarus-Scheme-r6rs
@ -317,7 +322,7 @@ Copyright (c) 2006-2007 Abdulaziz Ghuloum
> >
running stats for (run-bench name count ok? run): running stats for (run-bench name count ok? run):
no collections no collections
0.341s real 0.335s user 0.005s sys 0.350s real 0.344s user 0.005s sys
12960 bytes allocated 12960 bytes allocated
Testing conform under Ikarus-Scheme-r6rs Testing conform under Ikarus-Scheme-r6rs
@ -329,7 +334,7 @@ Copyright (c) 2006-2007 Abdulaziz Ghuloum
> >
running stats for (run-bench name count ok? run): running stats for (run-bench name count ok? run):
38 collections 38 collections
1.387s real 1.371s user 0.015s sys 1.370s real 1.352s user 0.017s sys
162415416 bytes allocated 162415416 bytes allocated
Testing dynamic under Ikarus-Scheme-r6rs Testing dynamic under Ikarus-Scheme-r6rs
@ -341,8 +346,8 @@ Copyright (c) 2006-2007 Abdulaziz Ghuloum
> >
running stats for (run-bench name count ok? run): running stats for (run-bench name count ok? run):
11 collections 11 collections
0.525s real 0.512s user 0.012s sys 0.618s real 0.604s user 0.013s sys
44168776 bytes allocated 44168760 bytes allocated
Testing earley under Ikarus-Scheme-r6rs Testing earley under Ikarus-Scheme-r6rs
Compiling... Compiling...
@ -361,8 +366,8 @@ Copyright (c) 2006-2007 Abdulaziz Ghuloum
> >
running stats for (run-bench name count ok? run): running stats for (run-bench name count ok? run):
79 collections 80 collections
1.440s real 1.301s user 0.138s sys 1.468s real 1.320s user 0.146s sys
334408904 bytes allocated 334408904 bytes allocated
Testing graphs under Ikarus-Scheme-r6rs Testing graphs under Ikarus-Scheme-r6rs
@ -374,7 +379,7 @@ Copyright (c) 2006-2007 Abdulaziz Ghuloum
> >
running stats for (run-bench name count ok? run): running stats for (run-bench name count ok? run):
189 collections 189 collections
2.294s real 2.248s user 0.045s sys 2.292s real 2.244s user 0.048s sys
790269656 bytes allocated 790269656 bytes allocated
Testing lattice under Ikarus-Scheme-r6rs Testing lattice under Ikarus-Scheme-r6rs
@ -386,7 +391,7 @@ Copyright (c) 2006-2007 Abdulaziz Ghuloum
> >
running stats for (run-bench name count ok? run): running stats for (run-bench name count ok? run):
91 collections 91 collections
1.633s real 1.609s user 0.023s sys 1.646s real 1.620s user 0.025s sys
381967088 bytes allocated 381967088 bytes allocated
Testing matrix under Ikarus-Scheme-r6rs Testing matrix under Ikarus-Scheme-r6rs
@ -428,7 +433,7 @@ Copyright (c) 2006-2007 Abdulaziz Ghuloum
> >
running stats for (run-bench name count ok? run): running stats for (run-bench name count ok? run):
65 collections 65 collections
3.347s real 3.335s user 0.012s sys 3.409s real 3.396s user 0.012s sys
274320056 bytes allocated 274320056 bytes allocated
Testing paraffins under Ikarus-Scheme-r6rs Testing paraffins under Ikarus-Scheme-r6rs
@ -440,7 +445,7 @@ Copyright (c) 2006-2007 Abdulaziz Ghuloum
> >
running stats for (run-bench name count ok? run): running stats for (run-bench name count ok? run):
198 collections 198 collections
1.447s real 1.194s user 0.252s sys 1.478s real 1.192s user 0.285s sys
831232056 bytes allocated 831232056 bytes allocated
Testing peval under Ikarus-Scheme-r6rs Testing peval under Ikarus-Scheme-r6rs
@ -452,7 +457,7 @@ Copyright (c) 2006-2007 Abdulaziz Ghuloum
> >
running stats for (run-bench name count ok? run): running stats for (run-bench name count ok? run):
36 collections 36 collections
1.028s real 1.016s user 0.012s sys 1.026s real 1.012s user 0.013s sys
151770008 bytes allocated 151770008 bytes allocated
Testing primes under Ikarus-Scheme-r6rs Testing primes under Ikarus-Scheme-r6rs
@ -471,7 +476,7 @@ Running...
Ikarus Scheme (Build 2007-01-20) Ikarus Scheme (Build 2007-01-20)
Copyright (c) 2006-2007 Abdulaziz Ghuloum Copyright (c) 2006-2007 Abdulaziz Ghuloum
> Error in tokenize: invalid number syntax: 4.. > Error in tokenize: invalid number syntax: 1e.
> >
Testing scheme under Ikarus-Scheme-r6rs Testing scheme under Ikarus-Scheme-r6rs
@ -501,8 +506,8 @@ Copyright (c) 2006-2007 Abdulaziz Ghuloum
> >
running stats for (run-bench name count ok? run): running stats for (run-bench name count ok? run):
9 collections 9 collections
2.424s real 0.504s user 0.991s sys 1.944s real 0.499s user 0.992s sys
36086008 bytes allocated 36085736 bytes allocated
Testing perm9 under Ikarus-Scheme-r6rs Testing perm9 under Ikarus-Scheme-r6rs
Compiling... Compiling...
@ -513,7 +518,7 @@ Copyright (c) 2006-2007 Abdulaziz Ghuloum
> >
running stats for (run-bench name count ok? run): running stats for (run-bench name count ok? run):
40 collections 40 collections
2.613s real 2.425s user 0.172s sys 2.512s real 2.314s user 0.197s sys
170498936 bytes allocated 170498936 bytes allocated
Testing nboyer under Ikarus-Scheme-r6rs Testing nboyer under Ikarus-Scheme-r6rs
@ -525,7 +530,7 @@ Copyright (c) 2006-2007 Abdulaziz Ghuloum
> >
running stats for (run-bench name count ok? run): running stats for (run-bench name count ok? run):
49 collections 49 collections
1.530s real 1.513s user 0.010s sys 1.562s real 1.551s user 0.009s sys
203661656 bytes allocated 203661656 bytes allocated
Testing sboyer under Ikarus-Scheme-r6rs Testing sboyer under Ikarus-Scheme-r6rs
@ -537,7 +542,7 @@ Copyright (c) 2006-2007 Abdulaziz Ghuloum
> >
running stats for (run-bench name count ok? run): running stats for (run-bench name count ok? run):
16 collections 16 collections
1.530s real 1.509s user 0.010s sys 1.590s real 1.580s user 0.008s sys
66159256 bytes allocated 66159256 bytes allocated
Testing gcbench under Ikarus-Scheme-r6rs Testing gcbench under Ikarus-Scheme-r6rs
@ -546,7 +551,16 @@ Running...
Ikarus Scheme (Build 2007-01-20) Ikarus Scheme (Build 2007-01-20)
Copyright (c) 2006-2007 Abdulaziz Ghuloum Copyright (c) 2006-2007 Abdulaziz Ghuloum
> Error in tokenize: invalid number syntax: 0.. > The garbage collector should touch about 32 megabytes of heap storage.
The use of more or less memory will skew the results.
Garbage Collector Test
Stretching memory with a binary tree of depth 18
Total memory available= ???????? bytes Free memory= ???????? bytes
GCBench: Main
Creating a long-lived binary tree of depth 16
Creating a long-lived array of 524284 inexact reals
Error in top-level-value: / is unbound.
> >
Testing parsing under Ikarus-Scheme-r6rs Testing parsing under Ikarus-Scheme-r6rs
@ -558,7 +572,7 @@ Copyright (c) 2006-2007 Abdulaziz Ghuloum
> >
running stats for (run-bench name count ok? run): running stats for (run-bench name count ok? run):
41 collections 41 collections
5.054s real 5.011s user 0.023s sys 4.876s real 4.859s user 0.017s sys
171456072 bytes allocated 171456072 bytes allocated
Testing gcold under Ikarus-Scheme-r6rs Testing gcold under Ikarus-Scheme-r6rs
@ -567,5 +581,5 @@ Running...
Ikarus Scheme (Build 2007-01-20) Ikarus Scheme (Build 2007-01-20)
Copyright (c) 2006-2007 Abdulaziz Ghuloum Copyright (c) 2006-2007 Abdulaziz Ghuloum
> Error in tokenize: invalid number syntax: 100.. > Error in top-level-value: gcold is unbound.
> >

BIN
bin/ikarus
View File

Binary file not shown.

BIN
src/ikarus.boot
View File

Binary file not shown.

75
src/libnumerics.ss
View File

@ -26,6 +26,17 @@
(lambda (x) (lambda (x)
(foreign-call "ikrt_isbignum" x))) (foreign-call "ikrt_isbignum" x)))
(define (fixnum->flonum x)
(foreign-call "ikrt_fixnum_to_flonum" x))
(define (bignum->flonum x)
(foreign-call "ikrt_bignum_to_flonum" x))
(define ($fl+ x y)
(foreign-call "ikrt_fl_plus" x y))
(define ($fl- x y)
(foreign-call "ikrt_fl_minus" x y))
(define ($fl* x y)
(foreign-call "ikrt_fl_times" x y))
(define binary+ (define binary+
(lambda (x y) (lambda (x y)
(cond (cond
@ -35,6 +46,8 @@
(foreign-call "ikrt_fxfxplus" x y)] (foreign-call "ikrt_fxfxplus" x y)]
[(bignum? y) [(bignum? y)
(foreign-call "ikrt_fxbnplus" x y)] (foreign-call "ikrt_fxbnplus" x y)]
[(flonum? y)
($fl+ (fixnum->flonum x) y)]
[else [else
(error '+ "~s is not a number" y)])] (error '+ "~s is not a number" y)])]
[(bignum? x) [(bignum? x)
@ -43,6 +56,18 @@
(foreign-call "ikrt_fxbnplus" y x)] (foreign-call "ikrt_fxbnplus" y x)]
[(bignum? y) [(bignum? y)
(foreign-call "ikrt_bnbnplus" x y)] (foreign-call "ikrt_bnbnplus" x y)]
[(flonum? y)
($fl+ (bignum->flonum x) y)]
[else
(error '+ "~s is not a number" y)])]
[(flonum? x)
(cond
[(fixnum? y)
($fl+ x (fixnum->flonum y))]
[(bignum? y)
($fl+ x (bignum->flonum y))]
[(flonum? y)
($fl+ x y)]
[else [else
(error '+ "~s is not a number" y)])] (error '+ "~s is not a number" y)])]
[else (error '+ "~s is not a number" x)]))) [else (error '+ "~s is not a number" x)])))
@ -77,6 +102,8 @@
(foreign-call "ikrt_fxfxminus" x y)] (foreign-call "ikrt_fxfxminus" x y)]
[(bignum? y) [(bignum? y)
(foreign-call "ikrt_fxbnminus" x y)] (foreign-call "ikrt_fxbnminus" x y)]
[(flonum? y)
($fl- (fixnum->flonum x) y)]
[else [else
(error '- "~s is not a number" y)])] (error '- "~s is not a number" y)])]
[(bignum? x) [(bignum? x)
@ -85,8 +112,20 @@
(foreign-call "ikrt_bnfxminus" x y)] (foreign-call "ikrt_bnfxminus" x y)]
[(bignum? y) [(bignum? y)
(foreign-call "ikrt_bnbnminus" x y)] (foreign-call "ikrt_bnbnminus" x y)]
[(flonum? y)
($fl- (bignum->flonum x) y)]
[else [else
(error '- "~s is not a number" y)])] (error '- "~s is not a number" y)])]
[(flonum? x)
(cond
[(fixnum? y)
($fl- x (fixnum->flonum y))]
[(bignum? y)
($fl- x (bignum->flonum y))]
[(flonum? y)
($fl- x y)]
[else
(error '- "~s is not a number" y)])]
[else (error '- "~s is not a number" x)]))) [else (error '- "~s is not a number" x)])))
(define binary* (define binary*
@ -98,6 +137,8 @@
(foreign-call "ikrt_fxfxmult" x y)] (foreign-call "ikrt_fxfxmult" x y)]
[(bignum? y) [(bignum? y)
(foreign-call "ikrt_fxbnmult" x y)] (foreign-call "ikrt_fxbnmult" x y)]
[(flonum? y)
($fl* (fixnum->flonum x) y)]
[else [else
(error '* "~s is not a number" y)])] (error '* "~s is not a number" y)])]
[(bignum? x) [(bignum? x)
@ -106,8 +147,20 @@
(foreign-call "ikrt_fxbnmult" y x)] (foreign-call "ikrt_fxbnmult" y x)]
[(bignum? y) [(bignum? y)
(foreign-call "ikrt_bnbnmult" x y)] (foreign-call "ikrt_bnbnmult" x y)]
[(flonum? y)
($fl* (bignum->flonum x) y)]
[else [else
(error '* "~s is not a number" y)])] (error '* "~s is not a number" y)])]
[(flonum? x)
(cond
[(fixnum? y)
($fl* x (fixnum->flonum y))]
[(bignum? y)
($fl* x (bignum->flonum y))]
[(flonum? y)
($fl* x y)]
[else
(error '* "~s is not a number" y)])]
[else (error '* "~s is not a number" x)]))) [else (error '* "~s is not a number" x)])))
(define + (define +
@ -212,7 +265,7 @@
x x
(error 'max "~s is not a number" x))])) (error 'max "~s is not a number" x))]))
(define min (define min
(case-lambda (case-lambda
[(x y) [(x y)
(cond (cond
@ -250,10 +303,18 @@
(define complex? (define complex?
(lambda (x) (number? x))) (lambda (x) (number? x)))
(define real? (define real?
(lambda (x) (number? x))) (lambda (x) (number? x)))
(define rational? (define rational?
(lambda (x) (number? x))) (lambda (x)
(cond
[(fixnum? x) #t]
[(bignum? x) #t]
[(flonum? x) #f]
[else (error 'rational? "~s is not a number" x)])))
(define integer? (define integer?
(lambda (x) (number? x))) (lambda (x) (number? x)))
@ -266,6 +327,15 @@
[else [else
(error 'exact? "~s is not a number" x)]))) (error 'exact? "~s is not a number" x)])))
(define exact->inexact
(lambda (x)
(cond
[(fixnum? x) (fixnum->flonum x)]
[(bignum? x) (bignum->flonum x)]
[else
(error 'exact->inexact
"~s is not an exact number" x)])))
(define inexact? (define inexact?
(lambda (x) (lambda (x)
(cond (cond
@ -545,4 +615,5 @@
(primitive-set! 'exact? exact?) (primitive-set! 'exact? exact?)
(primitive-set! 'inexact? inexact?) (primitive-set! 'inexact? inexact?)
(primitive-set! 'integer? integer?) (primitive-set! 'integer? integer?)
(primitive-set! 'exact->inexact exact->inexact)
) )

63
src/libtokenizer.ss
View File

@ -45,6 +45,8 @@
[(eof-object? c) n] [(eof-object? c) n]
[(digit? c) [(digit? c)
(tokenize-number (+ (* n 10) (char->num c)) p)] (tokenize-number (+ (* n 10) (char->num c)) p)]
[($char= c #\.)
(tokenize-flonum/with-digits n p)]
[(delimiter? c) [(delimiter? c)
(unread-char c p) (unread-char c p)
n] n]
@ -123,6 +125,46 @@
(let ([i ($char->fixnum c)]) (let ([i ($char->fixnum c)])
(unless (or (fx= i 10) (fx= i 13)) (unless (or (fx= i 10) (fx= i 13))
(skip-comment p))))))) (skip-comment p)))))))
(define (ls->flonum ls pos?)
(let ([str (if pos?
(list->string
(cons #\. (reverse ls)))
(list->string
(list* #\- #\. (reverse ls))))])
(string->flonum str)))
(define (tokenize-flonum ls pos? p)
(let ([c (read-char p)])
(cond
[(eof-object? c) (ls->flonum ls pos?)]
[(digit? c) (tokenize-flonum (cons c ls) pos? p)]
[(delimiter? c)
(unread-char c p)
(ls->flonum ls pos?)]
[else
(unread-char c p)
(error 'tokenize "invalid char ~a after flonum" c)])))
(define (tokenize-flonum/no-digits pos? p)
(let ([c (read-char p)])
(cond
[(eof-object? c)
(error 'tokenize "invalid eof")]
[(digit? c)
(tokenize-flonum (list c) pos? p)]
[else
(unread-char c p)
(error 'tokenize "invalid char ~a after decimal point" c)])))
(define (tokenize-flonum/with-digits n p)
(let ([c (read-char p)])
(cond
[(eof-object? c) (+ n (string->flonum "0.0"))]
[(digit? c)
(+ n (tokenize-flonum (list c) #t p))]
[(delimiter? c)
(unread-char c p)
(+ n (string->flonum "0.0"))]
[else
(unread-char c p)
(error 'tokenize "invalid char ~a after decimal point" c)])))
(define tokenize-plus (define tokenize-plus
(lambda (p) (lambda (p)
(let ([c (peek-char p)]) (let ([c (peek-char p)])
@ -132,6 +174,9 @@
[(digit? c) [(digit? c)
(read-char p) (read-char p)
(cons 'datum (tokenize-number (char->num c) p))] (cons 'datum (tokenize-number (char->num c) p))]
[($char= c #\.)
(read-char p)
(cons 'datum (tokenize-flonum/no-digits #t p))]
[else (error 'tokenize "invalid sequence +~a" c)])))) [else (error 'tokenize "invalid sequence +~a" c)]))))
(define tokenize-minus (define tokenize-minus
(lambda (p) (lambda (p)
@ -142,6 +187,9 @@
[(digit? c) [(digit? c)
(read-char p) (read-char p)
(cons 'datum (* -1 (tokenize-number (char->num c) p)))] (cons 'datum (* -1 (tokenize-number (char->num c) p)))]
[($char= c #\.)
(read-char p)
(cons 'datum (tokenize-flonum/no-digits #f p))]
[else (error 'tokenize "invalid sequence -~a" c)])))) [else (error 'tokenize "invalid sequence -~a" c)]))))
(define tokenize-dot (define tokenize-dot
(lambda (p) (lambda (p)
@ -158,13 +206,16 @@
[($char= c #\.) ; this is the third [($char= c #\.) ; this is the third
(let ([c (peek-char p)]) (let ([c (peek-char p)])
(cond (cond
[(eof-object? c) '(datum . ...)] [(eof-object? c) '(datum . ...)]
[(delimiter? c) '(datum . ...)] [(delimiter? c) '(datum . ...)]
[else [else
(error 'tokenize "invalid syntax ...~a" c)]))] (error 'tokenize "invalid syntax ...~a" c)]))]
[else [else
(unread-char c) (unread-char c p)
(error 'tokenize "invalid syntax ..~a" c)]))] (error 'tokenize "invalid syntax ..~a" c)]))]
[(digit? c)
(read-char p)
(cons 'datum (tokenize-flonum (list c) #t p))]
[else [else
(error 'tokenize "invalid syntax .~a" c)])))) (error 'tokenize "invalid syntax .~a" c)]))))
(define tokenize-char* (define tokenize-char*
@ -265,7 +316,7 @@
[($char= #\1 c) (read-binary (+ (* ac 2) 1) (cons c chars) p)] [($char= #\1 c) (read-binary (+ (* ac 2) 1) (cons c chars) p)]
[(delimiter? c) (unread-char c p) ac] [(delimiter? c) (unread-char c p) ac]
[else [else
(unread-char c) (unread-char c p)
(error 'tokenize "invalid syntax #b~a" (error 'tokenize "invalid syntax #b~a"
(list->string (reverse (cons c chars))))])))) (list->string (reverse (cons c chars))))]))))
(define tokenize-hash (define tokenize-hash

2
src/makefile.ss
View File

@ -91,7 +91,7 @@
even? odd? member char-whitespace? char-alphabetic? even? odd? member char-whitespace? char-alphabetic?
char-downcase max min complex? real? rational? char-downcase max min complex? real? rational?
exact? inexact? integer? exact? inexact? integer?
string->number string->number exact->inexact
flonum? flonum->string string->flonum flonum? flonum->string string->flonum
)) ))