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

rewrite exact-integer-sqrt in c

This commit is contained in:
Yuichi Nishiwaki 2014-07-22 09:07:25 +09:00
parent 3caf070043
commit b1ae2c24e5
2 changed files with 14 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
piclib/prelude.scm
View File

@ -589,18 +589,6 @@
s s
(fold f (f (car xs) s) (cdr xs)))) (fold f (f (car xs) s) (cdr xs))))
;;; 6.2. Numbers
; (import (only (scheme inexact) sqrt))
(import (scheme inexact))
(define (exact-integer-sqrt k)
(let ((n (exact (floor (sqrt k)))))
(values n (- k (square n)))))
(export floor/ truncate/
exact-integer-sqrt)
;;; 6.3 Booleans ;;; 6.3 Booleans
(define (boolean=? . objs) (define (boolean=? . objs)

14
src/number.c
View File

@ -661,6 +661,19 @@ pic_number_atan(pic_state *pic)
} }
} }
static pic_value
pic_number_exact_integer_sqrt(pic_state *pic)
{
int k, n, m;
pic_get_args(pic, "i", &k);
n = sqrt(k);
m = k - n * n;
return pic_values2(pic, pic_int_value(n), pic_int_value(m));
}
static pic_value static pic_value
pic_number_square(pic_state *pic) pic_number_square(pic_state *pic)
{ {
@ -840,6 +853,7 @@ pic_init_number(pic_state *pic)
pic_defun(pic, "round", pic_number_round); pic_defun(pic, "round", pic_number_round);
pic_gc_arena_restore(pic, ai); pic_gc_arena_restore(pic, ai);
pic_defun(pic, "exact-integer-sqrt", pic_number_exact_integer_sqrt);
pic_defun(pic, "square", pic_number_square); pic_defun(pic, "square", pic_number_square);
pic_defun(pic, "expt", pic_number_expt); pic_defun(pic, "expt", pic_number_expt);
pic_gc_arena_restore(pic, ai); pic_gc_arena_restore(pic, ai);