Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-20 22:29:16 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

adding exact-integer? and exact-integer-sqrt

Browse source
This commit is contained in:
Alex Shinn 2011-03-21 15:47:01 +09:00
parent 3e5c928548
commit 5cf04597c1
2 changed files with 10 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
eval.c
View file

@ -1088,7 +1088,7 @@ static sexp sexp_sqrt (sexp ctx sexp_api_params(self, n), sexp z) {
else else
return sexp_type_exception(ctx, self, SEXP_NUMBER, z); return sexp_type_exception(ctx, self, SEXP_NUMBER, z);
r = sqrt(d); r = sqrt(d);
if (sexp_fixnump(z) && ((r*r) == (double)sexp_unbox_fixnum(z))) if (sexp_fixnump(z) && (((sexp_uint_t)r*(sexp_uint_t)r)==sexp_unbox_fixnum(z)))
return sexp_make_fixnum(round(r)); return sexp_make_fixnum(round(r));
else else
return sexp_make_flonum(ctx, r); return sexp_make_flonum(ctx, r);

10
lib/init.scm
View file

@ -419,8 +419,16 @@
(define real? number?) (define real? number?)
(define (exact? x) (if (fixnum? x) #t (bignum? x))) (define (exact? x) (if (fixnum? x) #t (bignum? x)))
(define inexact? flonum?) (define inexact? flonum?)
(define (exact-integer? x) (if (fixnum? x) #t (bignum? x)))
(define (integer? x) (define (integer? x)
(if (fixnum? x) #t (if (bignum? x) #t (and (flonum? x) (= x (truncate x)))))) (if (exact-integer? x) #t (and (flonum? x) (= x (truncate x)))))
(define (exact-integer-sqrt x)
(let ((res (sqrt x)))
(if (exact? res)
(values res 0)
(let ((res (inexact->exact (truncate res))))
(values res (- x (* res res)))))))
(define (zero? x) (= x 0)) (define (zero? x) (= x 0))
(define (positive? x) (> x 0)) (define (positive? x) (> x 0))