static intmax_t
module_extract_integer (emacs_env *env, emacs_value n)
{
MODULE_FUNCTION_BEGIN (0);
Lisp_Object l = value_to_lisp (n);
CHECK_NUMBER (l);
return XINT (l);
}
static LispObject ToDeg(LispObject args)
{
double r;
CHECK_NUMBER(args);
r = GET_NUMBER(args);
r = 180.0 / M_PI * r;
return MakeFloat(r);
}
static LispObject ToRad(LispObject args)
{
double r;
CHECK_NUMBER(args);
r = GET_NUMBER(args);
r = M_PI / 180.0 * r;
return MakeFloat(r);
}
static LispObject Abs(LispObject args)
{
CHECK_NUMBER(args);
if (FLOATP(args)) {
double r = fabs(LFLOAT(args)->value);
return MakeFloat(r);
}
if (INTEGERP(args)) {
int r = abs(LINTEGER(args));
return MakeInteger(r);
}
return Qnil;
}
VALUE rb_create_instance(VALUE rb_obj, ...)
{
VAR_DECLARATIONS
/* initialize ap for use with the va_arg and va_end macros */
va_start(ap, rb_obj);
switch (type(rb_obj)) {
CASE(bernoulli)
VALUE rb_p;
double p;
SET_KLASS(bernoulli);
rb_p = GET_NEXT_ARG(ap);
p = NUM2DBL(rb_p);
CHECK_NUMBER(p);
/* 0 < p < 1 */
CHECK_PROBABILITY_EXCL(p);
/* p parameter correct */
RANDVAR_INIT(bernoulli);
SET_PARAM(bernoulli, p);
CASE_END
CASE(beta)
VALUE rb_alpha, rb_beta;
double alpha, beta;
SET_KLASS(beta);
rb_alpha = GET_NEXT_ARG(ap);
rb_beta = GET_NEXT_ARG(ap);
alpha = NUM2DBL(rb_alpha);
beta = NUM2DBL(rb_beta);
CHECK_NUMBER(alpha);
CHECK_NUMBER(beta);
/* alpha > 0 */
CHECK_POSITIVE(alpha);
/* beta > 0 */
CHECK_POSITIVE(beta);
/* alpha and beta parameters correct */
RANDVAR_INIT(beta);
SET_PARAM(beta, alpha);
SET_PARAM(beta, beta);
CASE_END
CASE(binomial)
VALUE rb_n, rb_p;
long n;
double p;
SET_KLASS(binomial);
rb_n = GET_NEXT_ARG(ap);
rb_p = GET_NEXT_ARG(ap);
CHECK_RB_INTEGER(rb_n, "n");
n = NUM2LONG(rb_n);
p = NUM2DBL(rb_p);
CHECK_NUMBER(p);
/* n >= 0 */
CHECK_NON_NEGATIVE(n);
/* 0 <= p <= 1 */
CHECK_PROBABILITY(p);
/* n and p parameters correct */
RANDVAR_INIT(binomial);
SET_PARAM(binomial, n);
SET_PARAM(binomial, p);
CASE_END
CASE(chi_squared)
VALUE rb_k;
long k;
SET_KLASS(chi_squared);
rb_k = GET_NEXT_ARG(ap);
CHECK_RB_INTEGER(rb_k, "k");
k = NUM2LONG(rb_k);
/* k > 0 */
CHECK_POSITIVE(k);
/* k parameter correct */
RANDVAR_INIT(chi_squared);
SET_PARAM(chi_squared, k);
CASE_END
CASE(continuous_uniform)
VALUE rb_a, rb_b;
double a,b;
SET_KLASS(continuous_uniform);
rb_a = GET_NEXT_ARG(ap);
rb_b = GET_NEXT_ARG(ap);
a = NUM2DBL(rb_a);
b = NUM2DBL(rb_b);
CHECK_NUMBER(a);
CHECK_NUMBER(b);
/* a < b */
CHECK_LESS_THAN(a,b);
/* a and b parameters correct */
RANDVAR_INIT(continuous_uniform);
SET_PARAM(continuous_uniform, a);
SET_PARAM(continuous_uniform, b);
CASE_END
CASE(discrete_uniform)
VALUE rb_a, rb_b;
long a,b;
SET_KLASS(discrete_uniform);
rb_a = GET_NEXT_ARG(ap);
rb_b = GET_NEXT_ARG(ap);
CHECK_RB_INTEGER(rb_a, "a");
CHECK_RB_INTEGER(rb_b, "b");
a = NUM2LONG(rb_a);
b = NUM2LONG(rb_b);
/* a < b */
CHECK_LESS_THAN(a,b);
/* a and b parameters correct */
RANDVAR_INIT(discrete_uniform);
SET_PARAM(discrete_uniform, a);
SET_PARAM(discrete_uniform, b);
CASE_END
CASE(exponential)
VALUE rb_mean;
double mean;
SET_KLASS(exponential);
rb_mean = GET_NEXT_ARG(ap);
mean = NUM2DBL(rb_mean);
CHECK_NUMBER(mean);
/* mean > 0 */
CHECK_POSITIVE(mean);
/* mean parameter correct */
RANDVAR_INIT(exponential);
SET_PARAM(exponential, mean);
CASE_END
CASE(f)
VALUE rb_d1, rb_d2;
double d1, d2;
SET_KLASS(f);
rb_d1 = GET_NEXT_ARG(ap);
rb_d2 = GET_NEXT_ARG(ap);
d1 = NUM2DBL(rb_d1);
d2 = NUM2DBL(rb_d2);
CHECK_NUMBER(d1);
CHECK_NUMBER(d2);
/* d1 > 0 */
/* d2 > 0 */
CHECK_POSITIVE(d1);
CHECK_POSITIVE(d2);
/* d1, d2 parameters correct */
RANDVAR_INIT(f);
SET_PARAM(f, d1);
SET_PARAM(f, d2);
CASE_END
CASE(negative_binomial)
VALUE rb_r, rb_p;
long r;
double p;
SET_KLASS(negative_binomial);
rb_r = GET_NEXT_ARG(ap);
rb_p = GET_NEXT_ARG(ap);
CHECK_RB_INTEGER(rb_r, "r");
r = NUM2LONG(rb_r);
p = NUM2DBL(rb_p);
CHECK_NUMBER(p);
/* r > 0 */
CHECK_POSITIVE(r);
/* 0 < p < 0 */
CHECK_PROBABILITY_EXCL(p);
/* r and p parameters correct */
RANDVAR_INIT(negative_binomial);
SET_PARAM(negative_binomial, r);
SET_PARAM(negative_binomial, p);
CASE_END
CASE(normal)
VALUE rb_mu, rb_sigma;
double mu, sigma;
SET_KLASS(normal);
rb_mu = GET_NEXT_ARG(ap);
rb_sigma = GET_NEXT_ARG(ap);
mu = NUM2DBL(rb_mu);
sigma = NUM2DBL(rb_sigma);
CHECK_NUMBER(mu);
CHECK_NUMBER(sigma);
/* sigma > 0 */
CHECK_POSITIVE(sigma);
/* sigma parameter correct */
RANDVAR_INIT(normal);
SET_PARAM(normal, mu);
SET_PARAM(normal, sigma);
CASE_END
CASE(pareto)
VALUE rb_a, rb_m;
double a, m;
SET_KLASS(pareto);
rb_a = GET_NEXT_ARG(ap);
rb_m = GET_NEXT_ARG(ap);
a = NUM2DBL(rb_a);
m = NUM2DBL(rb_m);
CHECK_NUMBER(a);
CHECK_NUMBER(m);
/* a > 0 */
CHECK_POSITIVE(a);
/* m > 0 */
CHECK_POSITIVE(m);
/* a and m parameters correct */
RANDVAR_INIT(pareto);
SET_PARAM(pareto, a);
SET_PARAM(pareto, m);
CASE_END
CASE(poisson)
VALUE rb_mean;
double mean;
SET_KLASS(poisson);
rb_mean = GET_NEXT_ARG(ap);
mean = NUM2DBL(rb_mean);
CHECK_NUMBER(mean);
/* mean > 0 */
CHECK_POSITIVE(mean);
/* ensure no overflow */
if (mean > LONG_MAX - 0.05 * LONG_MAX)
rb_raise(rb_eArgError, "outcomes may overflow");
/* mean parameter correct */
RANDVAR_INIT(poisson);
SET_PARAM(poisson, mean);
CASE_END
CASE(rademacher)
SET_KLASS(rademacher);
RANDVAR_INIT(rademacher);
CASE_END
CASE(rayleigh)
VALUE rb_sigma;
double sigma;
SET_KLASS(rayleigh);
rb_sigma = GET_NEXT_ARG(ap);
sigma = NUM2DBL(rb_sigma);
CHECK_NUMBER(sigma);
/* sigma > 0 */
CHECK_POSITIVE(sigma);
RANDVAR_INIT(rayleigh);
SET_PARAM(rayleigh, sigma);
CASE_END
CASE(rectangular)
SET_KLASS(rectangular);
RANDVAR_INIT(rectangular);
CASE_END
default:
rb_rv = Qnil;
} /* switch */
va_end(ap);
return rb_rv;
}
void
luaL_tofield(struct lua_State *L, struct luaL_serializer *cfg, int index,
struct luaL_field *field)
{
if (index < 0)
index = lua_gettop(L) + index + 1;
double num;
double intpart;
size_t size;
#define CHECK_NUMBER(x) ({\
if (!isfinite(x) && !cfg->encode_invalid_numbers) { \
if (!cfg->encode_invalid_as_nil) \
luaL_error(L, "number must not be NaN or Inf"); \
field->type = MP_NIL; \
}})
switch (lua_type(L, index)) {
case LUA_TNUMBER:
num = lua_tonumber(L, index);
if (isfinite(num) && modf(num, &intpart) != 0.0) {
field->type = MP_DOUBLE;
field->dval = num;
} else if (num >= 0 && num <= UINT64_MAX) {
field->type = MP_UINT;
field->ival = (uint64_t) num;
} else if (num >= INT64_MIN && num <= INT64_MAX) {
field->type = MP_INT;
field->ival = (int64_t) num;
} else {
field->type = MP_DOUBLE;
field->dval = num;
CHECK_NUMBER(num);
}
return;
case LUA_TCDATA:
{
uint32_t ctypeid = 0;
void *cdata = luaL_checkcdata(L, index, &ctypeid);
int64_t ival;
switch (ctypeid) {
case CTID_BOOL:
field->type = MP_BOOL;
field->bval = *(bool*) cdata;
return;
case CTID_CCHAR:
case CTID_INT8:
ival = *(int8_t *) cdata;
field->type = (ival >= 0) ? MP_UINT : MP_INT;
field->ival = ival;
return;
case CTID_INT16:
ival = *(int16_t *) cdata;
field->type = (ival >= 0) ? MP_UINT : MP_INT;
field->ival = ival;
return;
case CTID_INT32:
ival = *(int32_t *) cdata;
field->type = (ival >= 0) ? MP_UINT : MP_INT;
field->ival = ival;
return;
case CTID_INT64:
ival = *(int64_t *) cdata;
field->type = (ival >= 0) ? MP_UINT : MP_INT;
field->ival = ival;
return;
case CTID_UINT8:
field->type = MP_UINT;
field->ival = *(uint8_t *) cdata;
return;
case CTID_UINT16:
field->type = MP_UINT;
field->ival = *(uint16_t *) cdata;
return;
case CTID_UINT32:
field->type = MP_UINT;
field->ival = *(uint32_t *) cdata;
return;
case CTID_UINT64:
field->type = MP_UINT;
field->ival = *(uint64_t *) cdata;
return;
case CTID_FLOAT:
field->type = MP_FLOAT;
field->fval = *(float *) cdata;
CHECK_NUMBER(field->fval);
return;
case CTID_DOUBLE:
field->type = MP_DOUBLE;
field->dval = *(double *) cdata;
CHECK_NUMBER(field->dval);
return;
case CTID_P_CVOID:
case CTID_P_VOID:
if (*(void **) cdata == NULL) {
field->type = MP_NIL;
return;
}
/* Fall through */
default:
field->type = MP_EXT;
return;
}
return;
}
case LUA_TBOOLEAN:
field->type = MP_BOOL;
field->bval = lua_toboolean(L, index);
return;
case LUA_TNIL:
field->type = MP_NIL;
return;
case LUA_TSTRING:
field->sval.data = lua_tolstring(L, index, &size);
field->sval.len = (uint32_t) size;
field->type = MP_STR;
return;
case LUA_TTABLE:
{
field->compact = false;
lua_field_inspect_table(L, cfg, index, field);
return;
}
case LUA_TLIGHTUSERDATA:
case LUA_TUSERDATA:
field->sval.data = NULL;
field->sval.len = 0;
if (lua_touserdata(L, index) == NULL) {
field->type = MP_NIL;
return;
}
/* Fall through */
default:
field->type = MP_EXT;
return;
}
#undef CHECK_NUMBER
}
