Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-16 17:27:33 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Extend exact-integer-sqrt to support bignums

Browse source
This commit is contained in:
Justin Ethier 2017-02-21 15:50:14 +00:00
parent 53ed84b765
commit a45621a8de
1 changed files with 10 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
scheme/base.sld
View file

@ -1070,13 +1070,22 @@
(define-c bignum? (define-c bignum?
"(void *data, int argc, closure _, object k, object obj)" "(void *data, int argc, closure _, object k, object obj)"
" return_closcall1(data, k, Cyc_is_bignum(obj)); ") " return_closcall1(data, k, Cyc_is_bignum(obj)); ")
(define-c bignum-sqrt
"(void *data, int argc, closure _, object k, object obj)"
" alloc_bignum(data, bn);
if (MP_OKAY != mp_sqrt(&(bignum_value(obj)), &bignum_value(bn))) {
Cyc_rt_raise2(data, \"Error computing sqrt\", obj);
}
return_closcall1(data, k, bn); ")
;; from mosh ;; from mosh
(define (exact-integer-sqrt k) (define (exact-integer-sqrt k)
(unless (and (exact? k) (unless (and (exact? k)
(integer? k) (integer? k)
(not (negative? k))) (not (negative? k)))
(error "exact non-negative integer required" k)) (error "exact non-negative integer required" k))
(let* ((s (exact (truncate (sqrt k)))) (let* ((s (if (bignum? k)
(bignum-sqrt k)
(exact (truncate (sqrt k)))))
(r (- k (* s s)))) (r (- k (* s s))))
(values s r))) (values s r)))
(define-c sqrt (define-c sqrt