picrin/contrib/10.math/math.c

#include "picrin.h"
#include "picrin/extra.h"

#include <math.h>

static pic_value
pic_number_floor2(pic_state *pic)
{
  int i, j;
  bool e1, e2;

  pic_get_args(pic, "II", &i, &e1, &j, &e2);

  if (e1 && e2) {
    int k;

    k = (i < 0 && j < 0) || (0 <= i && 0 <= j)
      ? i / j
      : (i / j) - 1;

    return pic_values(pic, 2, pic_int_value(pic, k), pic_int_value(pic, i - k * j));
  } else {
    double q, r;

    q = floor((double)i/j);
    r = i - j * q;
    return pic_values(pic, 2, pic_float_value(pic, q), pic_float_value(pic, r));
  }
}

static pic_value
pic_number_trunc2(pic_state *pic)
{
  int i, j;
  bool e1, e2;

  pic_get_args(pic, "II", &i, &e1, &j, &e2);

  if (e1 && e2) {
    return pic_values(pic, 2, pic_int_value(pic, i/j), pic_int_value(pic, i - (i/j) * j));
  } else {
    double q, r;

    q = trunc((double)i/j);
    r = i - j * q;

    return pic_values(pic, 2, pic_float_value(pic, q), pic_float_value(pic, r));
  }
}

static pic_value
pic_number_floor(pic_state *pic)
{
  double f;
  bool e;

  pic_get_args(pic, "F", &f, &e);

  if (e) {
    return pic_int_value(pic, (int)f);
  } else {
    return pic_float_value(pic, floor(f));
  }
}

static pic_value
pic_number_ceil(pic_state *pic)
{
  double f;
  bool e;

  pic_get_args(pic, "F", &f, &e);

  if (e) {
    return pic_int_value(pic, (int)f);
  } else {
    return pic_float_value(pic, ceil(f));
  }
}

static pic_value
pic_number_trunc(pic_state *pic)
{
  double f;
  bool e;

  pic_get_args(pic, "F", &f, &e);

  if (e) {
    return pic_int_value(pic, (int)f);
  } else {
    return pic_float_value(pic, trunc(f));
  }
}

static pic_value
pic_number_round(pic_state *pic)
{
  double f;
  bool e;

  pic_get_args(pic, "F", &f, &e);

  if (e) {
    return pic_int_value(pic, (int)f);
  } else {
    return pic_float_value(pic, round(f));
  }
}

static pic_value
pic_number_finite_p(pic_state *pic)
{
  pic_value v;

  pic_get_args(pic, "o", &v);

  if (pic_int_p(pic, v))
    return pic_true_value(pic);
  if (pic_float_p(pic, v) && ! (isinf(pic_float(pic, v)) || isnan(pic_float(pic, v))))
    return pic_true_value(pic);
  else
    return pic_false_value(pic);
}

static pic_value
pic_number_infinite_p(pic_state *pic)
{
  pic_value v;

  pic_get_args(pic, "o", &v);

  if (pic_float_p(pic, v) && isinf(pic_float(pic, v)))
    return pic_true_value(pic);
  else
    return pic_false_value(pic);
}

static pic_value
pic_number_nan_p(pic_state *pic)
{
  pic_value v;

  pic_get_args(pic, "o", &v);

  if (pic_float_p(pic, v) && isnan(pic_float(pic, v)))
    return pic_true_value(pic);
  else
    return pic_false_value(pic);
}

static pic_value
pic_number_exp(pic_state *pic)
{
  double f;

  pic_get_args(pic, "f", &f);
  return pic_float_value(pic, 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(pic, log(f));
  }
  else {
    return pic_float_value(pic, 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(pic, 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(pic, 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(pic, 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(pic, 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(pic, 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(pic, f);
  }
  else {
    return pic_float_value(pic, atan2(f,g));
  }
}

static pic_value
pic_number_sqrt(pic_state *pic)
{
  double f;

  pic_get_args(pic, "f", &f);

  return pic_float_value(pic, 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(pic, f < 0 ? -f : f);
  }
  else {
    return pic_float_value(pic, 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(pic, (int)h);
    }
  }
  return pic_float_value(pic, h);
}

void
pic_init_math(pic_state *pic)
{
  pic_deflibrary(pic, "picrin.math");
  pic_in_library(pic, "picrin.math");
  pic_export(pic, 20,
             "floor/", "truncate/", "floor", "ceiling", "truncate", "round",
             "finite?", "infinite?", "nan?",
             "sqrt", "exp", "log", "sin", "cos", "tan",
             "acos", "asin", "atan", "abs", "expt");

  pic_defun(pic, "picrin.math:floor/", pic_number_floor2);
  pic_defun(pic, "picrin.math:truncate/", pic_number_trunc2);
  pic_defun(pic, "picrin.math:floor", pic_number_floor);
  pic_defun(pic, "picrin.math:ceiling", pic_number_ceil);
  pic_defun(pic, "picrin.math:truncate", pic_number_trunc);
  pic_defun(pic, "picrin.math:round", pic_number_round);

  pic_defun(pic, "picrin.math:finite?", pic_number_finite_p);
  pic_defun(pic, "picrin.math:infinite?", pic_number_infinite_p);
  pic_defun(pic, "picrin.math:nan?", pic_number_nan_p);
  pic_defun(pic, "picrin.math:sqrt", pic_number_sqrt);
  pic_defun(pic, "picrin.math:exp", pic_number_exp);
  pic_defun(pic, "picrin.math:log", pic_number_log);
  pic_defun(pic, "picrin.math:sin", pic_number_sin);
  pic_defun(pic, "picrin.math:cos", pic_number_cos);
  pic_defun(pic, "picrin.math:tan", pic_number_tan);
  pic_defun(pic, "picrin.math:acos", pic_number_acos);
  pic_defun(pic, "picrin.math:asin", pic_number_asin);
  pic_defun(pic, "picrin.math:atan", pic_number_atan);
  pic_defun(pic, "picrin.math:abs", pic_number_abs);
  pic_defun(pic, "picrin.math:expt", pic_number_expt);
}