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

Fixed a bug when doing (/ 1 1 1 ...).

This commit is contained in:
Abdulaziz Ghuloum 2008-06-28 13:02:05 -07:00
parent 2c8cb7dda2
commit 66464cc348
2 changed files with 4 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
scheme/ikarus.numerics.ss
View File

@ -1287,10 +1287,10 @@
[else ($make-ratnum d n)]))] [else ($make-ratnum d n)]))]
[(compnum? x) (binary/ 1 x)] [(compnum? x) (binary/ 1 x)]
[else (die '/ "not a number" x)])] [else (die '/ "not a number" x)])]
[(x y z . rest) [(x y z . ls)
(let f ([a (binary/ x y)] [b z] [ls rest]) (let f ([a (binary/ x y)] [b z] [ls ls])
(cond (cond
[(null? rest) (binary/ a b)] [(null? ls) (binary/ a b)]
[else (f (binary/ a b) (car ls) (cdr ls))]))])) [else (f (binary/ a b) (car ls) (cdr ls))]))]))

2
scheme/makefile.ss
View File

@ -25,7 +25,7 @@
current-primitive-locations current-primitive-locations
compile-core-expr-to-port)) compile-core-expr-to-port))
(import (ikarus.compiler)) ; just for fun (import (ikarus.compiler)) ; just for fun
(optimize-level 2) (optimize-level 1)
(pretty-width 160) (pretty-width 160)
((pretty-format 'fix) ((pretty-format 'letrec))) ((pretty-format 'fix) ((pretty-format 'letrec)))