move some math procedures to math nitro

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);
+  }
+}

contrib/10.math/nitro.mk

@@ -0,0 +1,3 @@
+CONTRIB_INITS += math
+
+CONTRIB_SRCS += contrib/10.math/math.c

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))

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

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
 }