number.c

Go to the documentation of this file.

//
// (c) 2008 why the lucky stiff, the freelance professor
// (c) 2013-2014 perel11.org
//
#include <stdio.h>
#include <stdlib.h>
#include <stdarg.h>
#include <math.h>
#include "potion.h"
#include "internal.h"

PN potion_double(Potion *P, double v) {
  vPN(Double) d = PN_ALLOC_N(PN_TNUMBER, struct PNDouble, 0);
  d->value = v;
  return (PN)d;
}

PN potion_strtod(Potion *P, char *str, int len) {
  char *ptr = str + len;
  return potion_double(P, strtod(str, &ptr));
}
PN potion_num_pow(Potion *P, PN cl, PN self, PN sup) {
  double x = PN_DBL(self), y = PN_DBL(sup);
  double z = pow(x, y);
  if (PN_IS_INT(self) && PN_IS_INT(sup) && fabs(z) < INT_MAX)
    return PN_NUM((int)z);
  return potion_double(P, z);
}
static PN potion_num_sqrt(Potion *P, PN cl, PN self) {
  return potion_double(P, sqrt(PN_DBL(self)));
}

#define PN_NUM_MATH(math_op) \
  DBG_CHECK_NUM(self); \
  DBG_CHECK_NUM(num); \
  if (PN_IS_INT(self) && PN_IS_INT(num)) \
    return PN_NUM(PN_INT(self) math_op PN_INT(num)); \
  return potion_double(P, PN_DBL(self) math_op PN_DBL(num));
#define PN_INT_MATH(math_op) \
  DBG_CHECK_INT(self); \
  DBG_CHECK_INT(num); \
  return PN_NUM(PN_INT(self) math_op PN_INT(num));
#define PN_DBL_MATH(math_op) \
  DBG_CHECK_NUM(self); \
  DBG_CHECK_NUM(num); \
  return potion_double(P, PN_DBL(self) math_op PN_DBL(num));

static PN potion_num_add(Potion *P, PN cl, PN self, PN num) {
  PN_NUM_MATH(+)
}

static PN potion_num_sub(Potion *P, PN cl, PN self, PN num) {
  PN_NUM_MATH(-)
}

static PN potion_num_mult(Potion *P, PN cl, PN self, PN num) {
  PN_NUM_MATH(*)
}

static PN potion_num_div(Potion *P, PN cl, PN self, PN num) {
  PN_NUM_MATH(/)
}

static PN potion_num_rem(Potion *P, PN cl, PN self, PN num) {
  if (PN_IS_INT(self) && PN_IS_INT(num))
    return PN_NUM(PN_INT(self) % PN_INT(num));
  double x = PN_DBL(self), y = PN_DBL(num);
  int z = (int)(x / y);
  return potion_double(P, x - (y * (double)z));
}

static PN potion_num_bitn(Potion *P, PN cl, PN self) {
  if (PN_IS_INT(self))
    return PN_NUM(~PN_INT(self));
  return (PN)potion_double(P, 0.0);
}

static PN potion_num_bitl(Potion *P, PN cl, PN self, PN num) {
  if (PN_IS_INT(self) && PN_IS_INT(num))
    return PN_NUM(PN_INT(self) << PN_INT(num));
  return (PN)potion_double(P, 0.0);
}

static PN potion_num_bitr(Potion *P, PN cl, PN self, PN num) {
  if (PN_IS_INT(self) && PN_IS_INT(num))
    return PN_NUM(PN_INT(self) >> PN_INT(num));
  return (PN)potion_double(P, 0.0);
}

static PN potion_int_add(Potion *P, PN cl, PN self, PN num) { PN_INT_MATH(+) }
static PN potion_int_sub(Potion *P, PN cl, PN self, PN num) { PN_INT_MATH(-) }
static PN potion_int_mult(Potion *P, PN cl, PN self, PN num) { PN_INT_MATH(*) }
static PN potion_int_div(Potion *P, PN cl, PN self, PN num) { PN_INT_MATH(/) }

static PN potion_int_rem(Potion *P, PN cl, PN self, PN num) { PN_INT_MATH(%) }

static PN potion_int_bitn(Potion *P, PN cl, PN self) {
  return PN_NUM(~PN_INT(self));
}

static PN potion_int_bitl(Potion *P, PN cl, PN self, PN num) {
  return PN_NUM(PN_INT(self) << PN_INT(num));
}

static PN potion_int_bitr(Potion *P, PN cl, PN self, PN num) {
  return PN_NUM(PN_INT(self) >> PN_INT(num));
}
PN potion_int_string(Potion *P, PN cl, PN self) {
  char ints[40];
  sprintf(ints, "%ld", PN_INT(self));
  return potion_str(P, ints);
}

static PN potion_num_number(Potion *P, PN cl, PN self) {
  return self;
}
static PN potion_num_double(Potion *P, PN cl, PN self) {
  if (PN_IS_INT(self))
    return potion_double(P, (double)PN_INT(self));
  else
    return self;
}
static PN potion_num_integer(Potion *P, PN cl, PN self) {
  if (PN_IS_INT(self))
    return self;
  else
    return PN_NUM(floor(((struct PNDouble *)self)->value));
}
static PN potion_dbl_add(Potion *P, PN cl, PN self, PN num) { PN_DBL_MATH(+) }
static PN potion_dbl_sub(Potion *P, PN cl, PN self, PN num) { PN_DBL_MATH(-) }
static PN potion_dbl_mult(Potion *P, PN cl, PN self, PN num) { PN_DBL_MATH(*) }
static PN potion_dbl_div(Potion *P, PN cl, PN self, PN num) { PN_DBL_MATH(/) }

PN potion_dbl_string(Potion *P, PN cl, PN self) {
  char ints[40];
  int len = sprintf(ints, "%.16f", ((struct PNDouble *)self)->value);
  while (len > 0 && ints[len - 1] == '0') len--;
  if (ints[len - 1] == '.') len++;
  ints[len] = '\0';
  return potion_str(P, ints);
}
PN potion_num_string(Potion *P, PN cl, PN self) {
  char ints[40];
  if (PN_IS_INT(self)) {
    sprintf(ints, "%ld", PN_INT(self));
  } else {
    int len = sprintf(ints, "%.16f", ((struct PNDouble *)self)->value);
    while (len > 0 && ints[len - 1] == '0') len--;
    if (ints[len - 1] == '.') len++;
    ints[len] = '\0';
  }
  return potion_str(P, ints);
}
static PN potion_int_times(Potion *P, PN cl, PN self, PN block) {
  long i, j = PN_INT(self);
  PN_CHECK_INT(self);
  //PN_CHECK_CLOSURE(block);
  if (PN_TYPE(block) != PN_TCLOSURE)
    potion_fatal("block argument for times is not a closure");
  for (i = 0; i < j; i++)
    PN_CLOSURE(block)->method(P, block, P->lobby, PN_NUM(i));
  return PN_NUM(i);
}
static PN potion_int_to(Potion *P, PN cl, PN self, PN end, PN block) {
  long i, s = 1, j = PN_INT(self), k = PN_INT(end);
  PN_CHECK_INT(self);
  PN_CHECK_INT(end);
  if (k < j) s = -1;
  if (PN_TYPE(block) != PN_TCLOSURE)
    potion_fatal("block argument for to is not a closure");
  for (i = j; i != k + s; i += s)
    PN_CLOSURE(block)->method(P, block, P->lobby, PN_NUM(i));
  return PN_NUM(labs(i - j));
}
static PN potion_int_step(Potion *P, PN cl, PN self, PN end, PN step, PN block) {
  long i, j = PN_INT(end), k = PN_INT(step);
  PN_CHECK_INT(self);
  PN_CHECK_INT(end);
  PN_CHECK_INT(step);
  if (PN_TYPE(block) != PN_TCLOSURE)
    potion_fatal("block argument for step is not a closure");
  for (i = PN_INT(self); i <= j; i += k) {
    PN_CLOSURE(block)->method(P, block, P->lobby, PN_NUM(i));
  }
  return PN_NUM(labs(i - j) / k);
}

static PN potion_int_chr(Potion *P, PN cl, PN self) {
  char c = PN_INT(self);
  DBG_CHECK_INT(self);
  return PN_STRN(&c, 1);
}
static PN potion_num_is_number(Potion *P, PN cl, PN self) {
  return (PN_IS_INT(self) || PN_IS_DBL(self)) ? PN_TRUE : PN_FALSE;
}
static PN potion_num_is_integer(Potion *P, PN cl, PN self) {
  return PN_IS_INT(self) ? PN_TRUE : PN_FALSE;
}
static PN potion_num_is_double(Potion *P, PN cl, PN self) {
  return PN_IS_DBL(self) ? PN_TRUE : PN_FALSE;
}
static PN potion_num_abs(Potion *P, PN cl, PN self) {
  DBG_CHECK_NUM(self);
  if (PN_IS_DBL(self)) {
    double d = PN_DBL(self);
    if (d < 0.0)
      return (PN) potion_double(P, -d);
    else
      return self;
  }
  return PN_NUM(labs(PN_INT(self)));
}
static PN potion_int_abs(Potion *P, PN cl, PN self) {
  PN_CHECK_INT(self);
  return PN_NUM(labs(PN_INT(self)));
}
static PN potion_dbl_abs(Potion *P, PN cl, PN self) {
  double d = PN_DBL(self);
  DBG_CHECK_NUM(self);
  if (d < 0.0)
    return (PN) potion_double(P, -d);
  else
    return self;
}
static PN potion_num_cmp(Potion *P, PN cl, PN self, PN n) {
  if (PN_IS_DBL(self)) {
    double d1 = ((struct PNDouble *)self)->value;
    double d2 = PN_DBL(potion_send(PN_number, n));
    return d1 < d2 ? PN_NUM(-1) : d1 == d2 ? PN_ZERO : PN_NUM(1);
  } else {
    long n1, n2;
    n1 = PN_INT(self);
    n2 = PN_IS_INT(n) ? PN_INT(n) : PN_INT(potion_send(PN_number, n));
    return n1 < n2 ? PN_NUM(-1) : n1 == n2 ? PN_ZERO : PN_NUM(1);
  }
}
static PN potion_dbl_cmp(Potion *P, PN cl, PN self, PN n) {
  double d1 = ((struct PNDouble *)self)->value;
  double d2 = PN_DBL(n);
  DBG_CHECK_DBL(self);
  PN_CHECK_NUM(n);
  return d1 < d2 ? PN_NUM(-1) : d1 == d2 ? PN_ZERO : PN_NUM(1);
}
static PN potion_int_cmp(Potion *P, PN cl, PN self, PN n) {
  long n1, n2;
  DBG_CHECK_INT(self);
  DBG_CHECK_INT(n);
  n1 = PN_INT(self);
  n2 = PN_INT(n);
  return n1 < n2 ? PN_NUM(-1) : n1 == n2 ? PN_ZERO : PN_NUM(1);
}

void potion_num_init(Potion *P) {
  PN num_vt = PN_VTABLE(PN_TNUMBER);
  PN dbl_vt = PN_VTABLE(PN_TDOUBLE);
  PN int_vt = PN_VTABLE(PN_TINTEGER);
  potion_method(num_vt, "+", potion_num_add, "value=N");
  potion_method(num_vt, "-", potion_num_sub, "value=N");
  potion_method(num_vt, "*", potion_num_mult, "value=N");
  potion_method(num_vt, "/", potion_num_div, "value=N");
  potion_method(num_vt, "%", potion_num_rem, "value=N");
  potion_method(num_vt, "~", potion_num_bitn, 0);
  potion_method(num_vt, "<<", potion_num_bitl, "value=N");
  potion_method(num_vt, ">>", potion_num_bitr, "value=N");
  potion_method(num_vt, "**", potion_num_pow, "value=N");
  potion_method(num_vt, "abs", potion_num_abs, 0);
  potion_method(num_vt, "sqrt", potion_num_sqrt, 0);
  potion_method(num_vt, "cmp", potion_num_cmp, "value=o");
  potion_method(num_vt, "chr", potion_int_chr, 0);
  potion_method(num_vt, "string", potion_num_string, 0);
  potion_method(num_vt, "number", potion_num_number, 0);
  potion_method(num_vt, "integer", potion_num_integer, 0);
  potion_method(num_vt, "double", potion_num_double, 0);
  potion_method(num_vt, "number?", potion_num_is_number, 0);
  potion_method(num_vt, "integer?", potion_num_is_integer, 0);
  potion_method(num_vt, "double?", potion_num_is_double, 0);
  potion_method(num_vt, "rand", potion_num_rand, 0);
  // optimized double-only methods, for both operands
  potion_method(dbl_vt, "string", potion_dbl_string, 0);
  potion_method(dbl_vt, "+", potion_dbl_add, "value=D");
  potion_method(dbl_vt, "-", potion_dbl_sub, "value=D");
  potion_method(dbl_vt, "*", potion_dbl_mult, "value=D");
  potion_method(dbl_vt, "/", potion_dbl_div, "value=D");
  potion_method(dbl_vt, "abs", potion_dbl_abs, 0);
  potion_method(dbl_vt, "cmp", potion_dbl_cmp, "value=D");
  //potion_method(dbl_vt, "rand", potion_dbl_rand, 0);
  // optimized integer-only methods, for both operands
  potion_method(int_vt, "+", potion_int_add, "value=I");
  potion_method(int_vt, "-", potion_int_sub, "value=I");
  potion_method(int_vt, "*", potion_int_mult, "value=I");
  potion_method(int_vt, "/", potion_int_div, "value=I");
  potion_method(int_vt, "%", potion_int_rem, "value=I");
  potion_method(int_vt, "<<", potion_int_bitl, "value=I");
  potion_method(int_vt, ">>", potion_int_bitr, "value=I");
  potion_method(int_vt, "~", potion_int_bitn, 0);
  potion_method(int_vt, "chr", potion_int_chr, 0);
  potion_method(int_vt, "abs", potion_int_abs, 0);
  potion_method(int_vt, "cmp", potion_int_cmp, "value=I");
  //potion_method(int_vt, "rand", potion_int_rand, 0);
  potion_method(num_vt, "step", potion_int_step, "end=N,step=N,block=&");
  potion_method(num_vt, "times", potion_int_times, "block=&");
  potion_method(num_vt, "to",   potion_int_to, "end=N,block=&");
}