From d66ae479cc02e934437849155381166c6f1bfa1b Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Mon, 20 Jul 2015 01:12:37 +0900 Subject: [PATCH] move some math procedures to math nitro --- contrib/10.math/math.c | 161 +++++++++++++++++++++++++++++ contrib/10.math/nitro.mk | 3 + contrib/20.r7rs/scheme/base.scm | 1 + contrib/20.r7rs/scheme/inexact.scm | 3 +- extlib/benz/number.c | 159 ---------------------------- 5 files changed, 167 insertions(+), 160 deletions(-) create mode 100644 contrib/10.math/math.c create mode 100644 contrib/10.math/nitro.mk diff --git a/contrib/10.math/math.c b/contrib/10.math/math.c new file mode 100644 index 00000000..36a42184 --- /dev/null +++ b/contrib/10.math/math.c @@ -0,0 +1,161 @@ +#include "picrin.h" + +static pic_value +pic_number_finite_p(pic_state *pic) +{ + pic_value v; + + pic_get_args(pic, "o", &v); + + if (pic_int_p(v)) + return pic_true_value(); + if (pic_float_p(v) && ! (isinf(pic_float(v)) || isnan(pic_float(v)))) + return pic_true_value(); + else + 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_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 +pic_number_sin(pic_state *pic) +{ + double f; + + pic_get_args(pic, "f", &f); + f = sin(f); + return pic_float_value(f); +} + +static pic_value +pic_number_cos(pic_state *pic) +{ + double f; + + pic_get_args(pic, "f", &f); + f = cos(f); + return pic_float_value(f); +} + +static pic_value +pic_number_tan(pic_state *pic) +{ + double f; + + pic_get_args(pic, "f", &f); + f = tan(f); + return pic_float_value(f); +} + +static pic_value +pic_number_acos(pic_state *pic) +{ + double f; + + pic_get_args(pic, "f", &f); + f = acos(f); + return pic_float_value(f); +} + +static pic_value +pic_number_asin(pic_state *pic) +{ + double f; + + pic_get_args(pic, "f", &f); + f = asin(f); + return pic_float_value(f); +} + +static pic_value +pic_number_atan(pic_state *pic) +{ + double f,g; + int argc; + + argc = pic_get_args(pic, "f|f", &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_sqrt(pic_state *pic) +{ + double f; + + pic_get_args(pic, "f", &f); + + return pic_float_value(sqrt(f)); +} + +void +pic_init_math(pic_state *pic) +{ + pic_deflibrary (pic, "(picrin number)") { + pic_defun(pic, "finite?", pic_number_finite_p); + pic_defun(pic, "infinite?", pic_number_infinite_p); + pic_defun(pic, "nan?", pic_number_nan_p); + pic_defun(pic, "sqrt", pic_number_sqrt); + 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); + } +} diff --git a/contrib/10.math/nitro.mk b/contrib/10.math/nitro.mk new file mode 100644 index 00000000..452ce371 --- /dev/null +++ b/contrib/10.math/nitro.mk @@ -0,0 +1,3 @@ +CONTRIB_INITS += math + +CONTRIB_SRCS += contrib/10.math/math.c diff --git a/contrib/20.r7rs/scheme/base.scm b/contrib/20.r7rs/scheme/base.scm index fe476435..1de6831b 100644 --- a/contrib/20.r7rs/scheme/base.scm +++ b/contrib/20.r7rs/scheme/base.scm @@ -1,5 +1,6 @@ (define-library (scheme base) (import (picrin base) + (only (picrin number) sqrt) (picrin macro) (picrin string) (scheme file)) diff --git a/contrib/20.r7rs/scheme/inexact.scm b/contrib/20.r7rs/scheme/inexact.scm index 28c162dc..a9a84770 100644 --- a/contrib/20.r7rs/scheme/inexact.scm +++ b/contrib/20.r7rs/scheme/inexact.scm @@ -1,5 +1,6 @@ (define-library (scheme inexact) - (import (picrin base)) + (import (picrin base) + (picrin number)) (export acos asin diff --git a/extlib/benz/number.c b/extlib/benz/number.c index e0cd1181..3999a328 100644 --- a/extlib/benz/number.c +++ b/extlib/benz/number.c @@ -655,149 +655,6 @@ pic_number_string_to_number(pic_state *pic) #endif } -#if PIC_ENABLE_FLOAT -static pic_value -pic_number_finite_p(pic_state *pic) -{ - pic_value v; - - pic_get_args(pic, "o", &v); - - if (pic_int_p(v)) - return pic_true_value(); - if (pic_float_p(v) && ! (isinf(pic_float(v)) || isnan(pic_float(v)))) - return pic_true_value(); - else - 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_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 -pic_number_sin(pic_state *pic) -{ - double f; - - pic_get_args(pic, "f", &f); - f = sin(f); - return pic_float_value(f); -} - -static pic_value -pic_number_cos(pic_state *pic) -{ - double f; - - pic_get_args(pic, "f", &f); - f = cos(f); - return pic_float_value(f); -} - -static pic_value -pic_number_tan(pic_state *pic) -{ - double f; - - pic_get_args(pic, "f", &f); - f = tan(f); - return pic_float_value(f); -} - -static pic_value -pic_number_acos(pic_state *pic) -{ - double f; - - pic_get_args(pic, "f", &f); - f = acos(f); - return pic_float_value(f); -} - -static pic_value -pic_number_asin(pic_state *pic) -{ - double f; - - pic_get_args(pic, "f", &f); - f = asin(f); - return pic_float_value(f); -} - -static pic_value -pic_number_atan(pic_state *pic) -{ - double f,g; - int argc; - - argc = pic_get_args(pic, "f|f", &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_sqrt(pic_state *pic) -{ - double f; - - pic_get_args(pic, "f", &f); - - return pic_float_value(sqrt(f)); -} -#endif - void pic_init_number(pic_state *pic) { @@ -856,20 +713,4 @@ pic_init_number(pic_state *pic) pic_defun(pic, "number->string", pic_number_number_to_string); pic_defun(pic, "string->number", pic_number_string_to_number); pic_gc_arena_restore(pic, ai); - -#if PIC_ENABLE_FLOAT - pic_defun(pic, "finite?", pic_number_finite_p); - pic_defun(pic, "infinite?", pic_number_infinite_p); - pic_defun(pic, "nan?", pic_number_nan_p); - pic_defun(pic, "sqrt", pic_number_sqrt); - 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); -#endif }