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

drop support for rational literal

This commit is contained in:
Yuichi Nishiwaki 2014-08-08 15:07:21 +09:00
parent 6b7b90fb28
commit a023db8054
2 changed files with 9 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
src/read.c
View File

@ -241,7 +241,6 @@ read_number(pic_state *pic, struct pic_port *port, int c)
{ {
char buf[256]; char buf[256];
size_t i; size_t i;
long n;
i = read_uinteger(pic, port, c, buf); i = read_uinteger(pic, port, c, buf);
@ -253,16 +252,6 @@ read_number(pic_state *pic, struct pic_port *port, int c)
buf[i] = '\0'; buf[i] = '\0';
return pic_float_value(atof(buf)); return pic_float_value(atof(buf));
case '/':
n = atoi(buf);
next(port);
read_uinteger(pic, port, next(port), buf);
if (n == n / atoi(buf) * atoi(buf)) {
return pic_int_value(n / atoi(buf)); /* exact */
} else {
return pic_float_value(n / (double)atoi(buf));
}
default: default:
return pic_int_value(atoi(buf)); return pic_int_value(atoi(buf));
} }

18
t/r7rs-tests.scm
View File

@ -631,11 +631,11 @@
;; (test #t (real? #e1e10)) ;; (test #t (real? #e1e10))
(test #t (real? +inf.0)) (test #t (real? +inf.0))
;; (test #f (rational? -inf.0)) ;; (test #f (rational? -inf.0))
(test #t (rational? 6/10)) ;; (test #t (rational? 6/10))
(test #t (rational? 6/3)) ;; (test #t (rational? 6/3))
;; (test #t (integer? 3+0i)) ;; (test #t (integer? 3+0i))
(test #t (integer? 3.0)) (test #t (integer? 3.0))
(test #t (integer? 8/4)) ;; (test #t (integer? 8/4))
(test #f (exact? 3.0)) (test #f (exact? 3.0))
;; (test #t (exact? #e3.0)) ;; (test #t (exact? #e3.0))
@ -643,7 +643,7 @@
(test #t (exact-integer? 32)) (test #t (exact-integer? 32))
(test #f (exact-integer? 32.0)) (test #f (exact-integer? 32.0))
(test #f (exact-integer? 32/5)) ;; (test #f (exact-integer? 32/5))
(test #t (finite? 3)) (test #t (finite? 3))
(test #f (finite? +inf.0)) (test #f (finite? +inf.0))
@ -757,8 +757,8 @@
(test -1 (- 3 4)) (test -1 (- 3 4))
(test -6 (- 3 4 5)) (test -6 (- 3 4 5))
(test -3 (- 3)) (test -3 (- 3))
(test 3/20 (/ 3 4 5)) ;; (test 3/20 (/ 3 4 5))
(test 1/3 (/ 3)) ;; (test 1/3 (/ 3))
(test 7 (abs -7)) (test 7 (abs -7))
(test 7 (abs 7)) (test 7 (abs 7))
@ -811,7 +811,7 @@
(test 3.0 (truncate 3.5)) (test 3.0 (truncate 3.5))
(test 4.0 (round 3.5)) (test 4.0 (round 3.5))
(test 4 (exact (round 7/2))) ;; (test 4 (exact (round 7/2)))
(test 7 (round 7)) (test 7 (round 7))
;; (test 1/3 (rationalize (exact .3) 1/10)) ;; (test 1/3 (rationalize (exact .3) 1/10))
@ -2126,9 +2126,9 @@
;; ;; Exact ratios ;; ;; Exact ratios
;; (test-numeric-syntax "1/2" (/ 1 2)) ;; (test-numeric-syntax "1/2" (/ 1 2))
;; (test-numeric-syntax "#e1/2" (/ 1 2) "1/2") ;; (test-numeric-syntax "#e1/2" (/ 1 2) "1/2")
(test-numeric-syntax "10/2" 5 "5") ;; (test-numeric-syntax "10/2" 5 "5")
;; (test-numeric-syntax "-1/2" (- (/ 1 2))) ;; (test-numeric-syntax "-1/2" (- (/ 1 2)))
(test-numeric-syntax "0/10" 0 "0") ;; (test-numeric-syntax "0/10" 0 "0")
;; (test-numeric-syntax "#e0/10" 0 "0") ;; (test-numeric-syntax "#e0/10" 0 "0")
;; (test-numeric-syntax "#i3/2" (/ 3.0 2.0) "1.5") ;; (test-numeric-syntax "#i3/2" (/ 3.0 2.0) "1.5")
;; ;; Exact complex ;; ;; Exact complex