move abs and expt

This commit is contained in:
Yuichi Nishiwaki 2015-07-20 01:24:35 +09:00
parent 6551506160
commit 57e4942ae2
3 changed files with 37 additions and 69 deletions

View File

@ -246,13 +246,45 @@ pic_number_sqrt(pic_state *pic)
return pic_float_value(sqrt(f)); return pic_float_value(sqrt(f));
} }
static pic_value
pic_number_abs(pic_state *pic)
{
double f;
bool e;
pic_get_args(pic, "F", &f, &e);
if (e) {
return pic_int_value(f < 0 ? -f : f);
}
else {
return pic_float_value(fabs(f));
}
}
static pic_value
pic_number_expt(pic_state *pic)
{
double f, g, h;
bool e1, e2;
pic_get_args(pic, "FF", &f, &e1, &g, &e2);
h = pow(f, g);
if (e1 && e2) {
if (h <= INT_MAX) {
return pic_int_value((int)h);
}
}
return pic_float_value(h);
}
void void
pic_init_math(pic_state *pic) pic_init_math(pic_state *pic)
{ {
pic_deflibrary (pic, "(picrin math)") { pic_deflibrary (pic, "(picrin math)") {
pic_defun(pic, "floor/", pic_number_floor2); pic_defun(pic, "floor/", pic_number_floor2);
pic_defun(pic, "truncate/", pic_number_trunc2); pic_defun(pic, "truncate/", pic_number_trunc2);
pic_defun(pic, "floor", pic_number_floor); pic_defun(pic, "floor", pic_number_floor);
pic_defun(pic, "ceiling", pic_number_ceil); pic_defun(pic, "ceiling", pic_number_ceil);
pic_defun(pic, "truncate", pic_number_trunc); pic_defun(pic, "truncate", pic_number_trunc);
@ -270,5 +302,7 @@ pic_init_math(pic_state *pic)
pic_defun(pic, "acos", pic_number_acos); pic_defun(pic, "acos", pic_number_acos);
pic_defun(pic, "asin", pic_number_asin); pic_defun(pic, "asin", pic_number_asin);
pic_defun(pic, "atan", pic_number_atan); pic_defun(pic, "atan", pic_number_atan);
pic_defun(pic, "abs", pic_number_abs);
pic_defun(pic, "expt", pic_number_expt);
} }
} }

View File

@ -1,6 +1,8 @@
(define-library (scheme base) (define-library (scheme base)
(import (picrin base) (import (picrin base)
(only (picrin math) (only (picrin math)
abs
expt
floor/ floor/
truncate/ truncate/
floor floor

View File

@ -347,70 +347,6 @@ DEFINE_ARITH_INV_OP2(-, sub, 0)
DEFINE_ARITH_INV_OP2(/, div, 1) DEFINE_ARITH_INV_OP2(/, div, 1)
#endif #endif
static pic_value
pic_number_abs(pic_state *pic)
{
#if PIC_ENABLE_FLOAT
double f;
bool e;
pic_get_args(pic, "F", &f, &e);
if (e) {
return pic_int_value(f < 0 ? -f : f);
}
else {
return pic_float_value(fabs(f));
}
#else
int i;
pic_get_args(pic, "i", &i);
return pic_int_value(i < 0 ? -i : i);
#endif
}
static pic_value
pic_number_expt(pic_state *pic)
{
#if PIC_ENABLE_FLOAT
double f, g, h;
bool e1, e2;
pic_get_args(pic, "FF", &f, &e1, &g, &e2);
h = pow(f, g);
if (e1 && e2) {
if (h <= INT_MAX) {
return pic_int_value((int)h);
}
}
return pic_float_value(h);
#else
int x, y, i, e = 1, r = 1, s = 0;
pic_get_args(pic, "ii", &x, &y);
if (y < 0) {
s = 1;
y = -y;
}
e = x;
for (i = 0; y; ++i) {
if ((y & 1) != 0) {
r *= e;
}
e *= e;
y >>= 1;
}
if (s != 0) {
r = 1 / r;
}
return pic_int_value(r);
#endif
}
static pic_value static pic_value
pic_number_number_to_string(pic_state *pic) pic_number_number_to_string(pic_state *pic)
{ {
@ -555,10 +491,6 @@ pic_init_number(pic_state *pic)
pic_defun(pic, "/", pic_number_div); pic_defun(pic, "/", pic_number_div);
pic_gc_arena_restore(pic, ai); pic_gc_arena_restore(pic, ai);
pic_defun(pic, "abs", pic_number_abs);
pic_defun(pic, "expt", pic_number_expt);
pic_gc_arena_restore(pic, ai);
pic_defun(pic, "number->string", pic_number_number_to_string); pic_defun(pic, "number->string", pic_number_number_to_string);
pic_defun(pic, "string->number", pic_number_string_to_number); pic_defun(pic, "string->number", pic_number_string_to_number);
pic_gc_arena_restore(pic, ai); pic_gc_arena_restore(pic, ai);