diff --git a/include/picrin/value.h b/include/picrin/value.h index cfc958cf..f9f7bfda 100644 --- a/include/picrin/value.h +++ b/include/picrin/value.h @@ -82,6 +82,7 @@ pic_value pic_float_value(double); #define pic_true_p(v) ((v).type == PIC_VTYPE_TRUE) #define pic_false_p(v) ((v).type == PIC_VTYPE_FALSE) #define pic_undef_p(v) ((v).type == PIC_VTYPE_UNDEF) +#define pic_float_p(v) ((v).type == PIC_VTYPE_FLOAT) #define pic_pair_p(v) (pic_type(v) == PIC_TT_PAIR) #endif diff --git a/src/number.c b/src/number.c index 084637d4..962a2c3f 100644 --- a/src/number.c +++ b/src/number.c @@ -2,6 +2,59 @@ #include "picrin.h" +static pic_value +pic_number_real_p(pic_state *pic) +{ + pic_value v; + + pic_get_args(pic, "o", &v); + + return pic_bool_value(pic_float_p(v)); +} + +static pic_value +pic_number_integer_p(pic_state *pic) +{ + pic_value v; + + pic_get_args(pic, "o", &v); + + if (pic_float_p(v)) { + double f = pic_float(v); + + if (f == round(f)) { + return pic_true_value(); + } + } + return pic_false_value(); +} + +static pic_value +pic_number_infinite_p(pic_state *pic) +{ + pic_value v; + + pic_get_args(pic, "o", &v); + + if (pic_float_p(v) && isinf(pic_float(v))) + return pic_true_value(); + else + return pic_false_value(); +} + +static pic_value +pic_number_nan_p(pic_state *pic) +{ + pic_value v; + + pic_get_args(pic, "o", &v); + + if (pic_float_p(v) && isnan(pic_float(v))) + return pic_true_value(); + else + return pic_false_value(); +} + static pic_value pic_number_lt(pic_state *pic) { @@ -17,13 +70,76 @@ pic_number_lt(pic_state *pic) } static pic_value -pic_number_sqrt(pic_state *pic) +pic_number_abs(pic_state *pic) { double f; pic_get_args(pic, "f", &f); - f = sqrt(f); - return pic_float_value(f); + return pic_float_value(fabs(f)); +} + +static pic_value +pic_number_floor(pic_state *pic) +{ + double f; + + pic_get_args(pic, "f", &f); + + return pic_float_value(floor(f)); +} + +static pic_value +pic_number_ceiling(pic_state *pic) +{ + double f; + + pic_get_args(pic, "f", &f); + + return pic_float_value(ceil(f)); +} + +static pic_value +pic_number_truncate(pic_state *pic) +{ + double f; + + pic_get_args(pic, "f", &f); + + return pic_float_value(trunc(f)); +} + +static pic_value +pic_number_round(pic_state *pic) +{ + double f; + + pic_get_args(pic, "f", &f); + + return pic_float_value(round(f)); +} + +static pic_value +pic_number_exp(pic_state *pic) +{ + double f; + + pic_get_args(pic, "f", &f); + return pic_float_value(exp(f)); +} + +static pic_value +pic_number_log(pic_state *pic) +{ + double f,g; + int argc; + + argc = pic_get_args(pic, "f|f", &f, &g); + if (argc == 1) { + return pic_float_value(log(f)); + } + else { + return pic_float_value(log(f) / log(g)); + } } static pic_value @@ -78,23 +194,87 @@ pic_number_asin(pic_state *pic) static pic_value pic_number_atan(pic_state *pic) +{ + double f,g; + int argc; + + argc = pic_get_args(pic, "f|g", &f, &g); + if (argc == 1) { + f = atan(f); + return pic_float_value(f); + } + else { + return pic_float_value(atan2(f,g)); + } +} + +static pic_value +pic_number_square(pic_state *pic) { double f; pic_get_args(pic, "f", &f); - f = atan(f); + + return pic_float_value(f * f); +} + +static pic_value +pic_number_sqrt(pic_state *pic) +{ + double f; + + pic_get_args(pic, "f", &f); + f = sqrt(f); return pic_float_value(f); } +static pic_value +pic_number_expt(pic_state *pic) +{ + double f,g; + + pic_get_args(pic, "ff", &f, &g); + return pic_float_value(pow(f,g)); +} + void pic_init_number(pic_state *pic) { + int ai = pic_gc_arena_preserve(pic); + + pic_defun(pic, "number?", pic_number_real_p); + pic_defun(pic, "complex?", pic_number_real_p); + pic_defun(pic, "real?", pic_number_real_p); + pic_defun(pic, "rational?", pic_number_integer_p); + pic_defun(pic, "integer?", pic_number_integer_p); + pic_gc_arena_restore(pic, ai); + + pic_defun(pic, "infinite?", pic_number_infinite_p); + pic_defun(pic, "nan?", pic_number_nan_p); + pic_gc_arena_restore(pic, ai); + pic_defun(pic, "<", pic_number_lt); - pic_defun(pic, "sqrt", pic_number_sqrt); + + pic_defun(pic, "abs", pic_number_abs); + + pic_defun(pic, "floor", pic_number_floor); + pic_defun(pic, "ceiling", pic_number_ceiling); + pic_defun(pic, "truncate", pic_number_truncate); + pic_defun(pic, "round", pic_number_round); + pic_gc_arena_restore(pic, ai); + + pic_defun(pic, "exp", pic_number_exp); + pic_defun(pic, "log", pic_number_log); pic_defun(pic, "sin", pic_number_sin); pic_defun(pic, "cos", pic_number_cos); pic_defun(pic, "tan", pic_number_tan); pic_defun(pic, "acos", pic_number_acos); pic_defun(pic, "asin", pic_number_asin); pic_defun(pic, "atan", pic_number_atan); + pic_gc_arena_restore(pic, ai); + + pic_defun(pic, "square", pic_number_square); + pic_defun(pic, "sqrt", pic_number_sqrt); + pic_defun(pic, "expt", pic_number_expt); + pic_gc_arena_restore(pic, ai); }