static int _array_array_binary_op(lua_State *L, ArrayBinaryOperation op)
{
const Array *A = lunum_checkarray1(L, 1);
const Array *B = lunum_checkarray1(L, 2);
/* check size and dimensions */
if (A->ndims != B->ndims) {
return luaL_error(L, "arrays have different dimensions");
}
for (int d=0; d<A->ndims; ++d) {
if (A->shape[d] != B->shape[d]) {
return luaL_error(L, "arrays shapes do not agree");
}
}
const ArrayType T = (A->dtype >= B->dtype) ? A->dtype : B->dtype;
Array C = array_new_zeros(A->size, T);
array_resize_t(&C, A->shape, A->ndims);
lunum_pusharray1(L, &C);
array_array_binary_op(L, A, B, &C, op);
return 1;
}
int luaC_array__call(lua_State *L)
{
struct Array *A = lunum_checkarray1(L, 1);
int nind = lua_gettop(L) - 1;
if (nind != A->ndims) {
luaL_error(L, "wrong number of indices (%d) for array of dimension %d",
nind, A->ndims);
return 0;
}
const int Nd = A->ndims;
int *stride = (int*) malloc(A->ndims * sizeof(int));
stride[Nd-1] = 1;
for (int d=Nd-2; d>=0; --d) {
stride[d] = stride[d+1] * A->shape[d+1];
}
int m = 0;
for (int d=0; d<A->ndims; ++d) {
int i = lua_tointeger(L, d+2);
m += i*stride[d];
}
_push_value(L, A->dtype, (char*)A->data + m*array_sizeof(A->dtype));
free(stride);
return 1;
}
void _unary_func(lua_State *L, double(*f)(double), Complex(*g)(Complex), int cast)
{
if (lua_isnumber(L, 1)) {
const double x = lua_tonumber(L, 1);
lua_pushnumber(L, f(x));
}
else if (lunum_hasmetatable(L, 1, "complex")) {
if (g == NULL) {
return luaL_error(L, "complex operation not supported");
}
const Complex z = lunum_checkcomplex(L, 1);
lunum_pushcomplex(L, g(z));
}
else if (lunum_hasmetatable(L, 1, "array")) {
Array *A = (Array*) lunum_checkarray1(L, 1);
if (cast == 0) {
Array B = array_new_copy(A, A->dtype);
switch (B.dtype) {
case ARRAY_TYPE_BOOL : EXPR_EVALF(Bool , B.size, B.data); break;
case ARRAY_TYPE_CHAR : EXPR_EVALF(char , B.size, B.data); break;
case ARRAY_TYPE_SHORT : EXPR_EVALF(short , B.size, B.data); break;
case ARRAY_TYPE_INT : EXPR_EVALF(int , B.size, B.data); break;
case ARRAY_TYPE_LONG : EXPR_EVALF(long , B.size, B.data); break;
case ARRAY_TYPE_SIZE_T : EXPR_EVALF(size_t , B.size, B.data); break;
case ARRAY_TYPE_FLOAT : EXPR_EVALF(float , B.size, B.data); break;
case ARRAY_TYPE_DOUBLE : EXPR_EVALF(double , B.size, B.data); break;
case ARRAY_TYPE_COMPLEX : EXPR_EVALG(Complex, B.size, B.data); break;
}
lunum_pusharray1(L, &B);
}
int luaC_h5_write_array(lua_State *L)
{
const char *dsetnm = luaL_checkstring(L, 1);
struct Array *A = lunum_checkarray1(L, 2);
int i;
if (PresentFile < 0) {
luaL_error(L, "no open file");
return 0;
}
if (A->dtype != ARRAY_TYPE_DOUBLE) {
luaL_error(L, "[hdf5] only double arrays can be written");
}
int ndims = A->ndims;
hsize_t *sizes = (hsize_t*) malloc(ndims*sizeof(hsize_t));
for (i=0; i<ndims; ++i) {
sizes[i] = A->shape[i];
}
hid_t fspc = H5Screate_simple(ndims, sizes, H5P_DEFAULT);
hid_t dset = H5Dcreate(PresentFile, dsetnm, H5T_NATIVE_DOUBLE, fspc,
H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT);
H5Dwrite(dset, H5T_NATIVE_DOUBLE, fspc, fspc, H5P_DEFAULT, A->data);
H5Dclose(dset);
H5Sclose(fspc);
free(sizes);
return 0;
}
void _pusharray_wshape(lua_State *L, double *A, const int *shape, int Nd)
{
int ntot=1;
for (int i=0; i<Nd; ++i) ntot *= shape[i];
lunum_pusharray2(L, A, ARRAY_TYPE_DOUBLE, ntot);
struct Array *B = lunum_checkarray1(L, -1);
array_resize(B, shape, Nd);
}
static int luaC_lunum_slice(lua_State *L)
{
// The first part of this function extracts a slice of the array 'A' according
// to the convention start:stop:skip. The result is a contiguous array 'B'
// having the same number of dimensions as 'A'.
// ---------------------------------------------------------------------------
size_t Nd0_t, Nd1_t, Nd2_t, Nd3_t;
const Array *A = lunum_checkarray1(L, 1); // the array to resize
size_t *start = (size_t*) lunum_checkarray2(L, 2, ARRAY_TYPE_SIZE_T, &Nd0_t);
size_t *stop = (size_t*) lunum_checkarray2(L, 3, ARRAY_TYPE_SIZE_T, &Nd1_t);
size_t *skip = (size_t*) lunum_checkarray2(L, 4, ARRAY_TYPE_SIZE_T, &Nd2_t);
size_t *squeeze = (size_t*) lunum_checkarray2(L, 5, ARRAY_TYPE_SIZE_T, &Nd3_t);
int Nd0 = (int)Nd0_t, Nd1 = (int)Nd1_t, Nd2 = (int)Nd2_t, Nd3 = (int)Nd3_t;
if (Nd0 != A->ndims || Nd1 != A->ndims || Nd2 != A->ndims || Nd3 != A->ndims) {
return luaL_error(L, "slice has wrong number of dimensions for array");
}
for (int d=0; d<A->ndims; ++d) {
if (start[d] < 0 || stop[d] > A->shape[d]) {
return luaL_error(L, "slice not within array extent");
}
}
Array B = array_new_from_slice(A, start, stop, skip, Nd0);
// The rest of this function deals with squeezing out the size-1 dimensions of
// 'B' which are marked by the 'squeeze' array.
// ---------------------------------------------------------------------------
size_t Nd_new = 0;
for (int d=0; d<Nd0; ++d) Nd_new += !squeeze[d];
// In case we're left with a 0-dimensional (scalar) slice
if (Nd_new == 0) {
_push_value(L, B.dtype, B.data);
return 1;
}
// In case there are any dims to squeeze out
else if (Nd_new != Nd0) {
size_t *shape_new = (size_t*) malloc(Nd_new * sizeof(size_t));
for (int d=0,e=0; d<Nd0; ++d) {
if (B.shape[d] > 1 || !squeeze[d]) {
shape_new[e] = B.shape[d];
++e;
}
}
array_resize_t(&B, shape_new, Nd_new);
free(shape_new);
}
lunum_pusharray1(L, &B);
return 1;
}
void *lunum_checkarray2(lua_State *L, int pos, enum ArrayType T, int *N)
{
if (lunum_upcast(L, pos, T, 1)) {
lua_replace(L, pos);
}
struct Array *A = lunum_checkarray1(L, pos);
if (N != NULL) *N = A->size;
return A->data;
}
int _array_binary_op1(lua_State *L, enum ArrayOperation op)
{
if (!lunum_hasmetatable(L, 1, "array")) {
struct Array *B = lunum_checkarray1(L, 2);
lunum_upcast(L, 1, B->dtype, B->size);
lua_replace(L, 1);
struct Array *A = lunum_checkarray1(L, 1);
array_resize(A, B->shape, B->ndims);
}
if (!lunum_hasmetatable(L, 2, "array")) {
struct Array *A = lunum_checkarray1(L, 1);
lunum_upcast(L, 2, A->dtype, A->size);
lua_replace(L, 2);
struct Array *B = lunum_checkarray1(L, 2);
array_resize(B, A->shape, A->ndims);
}
return _array_binary_op2(L, op);
}
int luaC_array__newindex(lua_State *L)
{
struct Array *A = lunum_checkarray1(L, 1);
const int m = _get_index(L, A);
const enum ArrayType T = A->dtype;
void *val = lunum_tovalue(L, T);
memcpy((char*)A->data + array_sizeof(T)*m, val, array_sizeof(T));
free(val);
return 0;
}
static int luaC_lunum_transpose(lua_State *L)
{
const Array *A = lunum_checkarray1(L, 1); // the array to transpose
/* copy transposed shape and size to B */
Array B = array_new_zeros(A->size, A->dtype);
array_resize_t(&B, A->shape, A->ndims);
array_transpose(A, &B);
lunum_pusharray1(L, &B);
return 1;
}
int luaC_array__index(lua_State *L)
{
struct Array *A = lunum_checkarray1(L, 1);
// Figure out what is the format of the input index. If it's a number or a
// table of numbers, then pass it along to _get_index. If it's a table of
// tables or numbers, then assume it's a slice. If it's an array of bools,
// then use it as a mask.
// ---------------------------------------------------------------------------
if (lunum_hasmetatable(L, 2, "array")) {
struct Array *M = lunum_checkarray1(L, 2);
if (M->dtype != ARRAY_TYPE_BOOL) {
luaL_error(L, "index array must be of type bool");
}
struct Array B = array_new_from_mask(A, M);
lunum_pusharray1(L, &B);
return 1;
}
else if (lua_type(L, 2) == LUA_TTABLE || lua_type(L, 2) == LUA_TSTRING) {
lua_getglobal(L, "lunum");
lua_getfield(L, -1, "__build_slice");
lua_remove(L, -2);
lua_pushvalue(L, 1);
lua_pushvalue(L, 2);
lua_call(L, 2, 1);
return 1;
}
const int m = _get_index(L, A);
_push_value(L, A->dtype, (char*)A->data + array_sizeof(A->dtype)*m);
return 1;
}
static int _array_binary_op(lua_State *L, ArrayBinaryOperation op)
{
if ((lua_istable(L, 1) || lunum_hasmetatable(L, 1, "array")) && (lua_istable(L, 2) || lunum_hasmetatable(L, 2, "array"))) {
/* both args are tables or arrays, upcast to arrays if not already */
if (!lunum_hasmetatable(L, 1, "array")) {
Array *B = lunum_checkarray1(L, 2);
lunum_upcast(L, 1, B->dtype, B->size);
lua_replace(L, 1);
Array *A = lunum_checkarray1(L, 1);
array_resize_t(A, B->shape, B->ndims);
}
if (!lunum_hasmetatable(L, 2, "array")) {
Array *A = lunum_checkarray1(L, 1);
lunum_upcast(L, 2, A->dtype, A->size);
lua_replace(L, 2);
Array *B = lunum_checkarray1(L, 2);
array_resize_t(B, A->shape, A->ndims);
}
return _array_array_binary_op(L, op);
} else {
/* one arg is not a table(array) */
return _array_number_binary_op(L, op, lunum_hasmetatable(L, 1, "array"));
}
}
static int _array_unary_op(lua_State *L, ArrayUnaryOperation op)
{
Array *A = lunum_checkarray1(L, 1);
const size_t N = A->size;
ArrayType T = A->dtype;
Array B = array_new_zeros(N, T);
array_resize_t(&B, A->shape, A->ndims);
lunum_pusharray1(L, &B);
array_unary_op(L, A, &B, op);
return 1;
}
int _array_binary_op2(lua_State *L, enum ArrayOperation op)
{
struct Array *A = lunum_checkarray1(L, 1);
struct Array *B = lunum_checkarray1(L, 2);
if (A->ndims != B->ndims) {
luaL_error(L, "arrays have different dimensions");
}
for (int d=0; d<A->ndims; ++d) {
if (A->shape[d] != B->shape[d]) {
luaL_error(L, "arrays shapes do not agree");
}
}
const int N = A->size;
enum ArrayType T = (A->dtype >= B->dtype) ? A->dtype : B->dtype;
struct Array A_ = (A->dtype == T) ? *A : array_new_copy(A, T);
struct Array B_ = (B->dtype == T) ? *B : array_new_copy(B, T);
struct Array C = array_new_zeros(N, T);
array_resize(&C, A->shape, A->ndims);
lunum_pusharray1(L, &C);
array_binary_op(&A_, &B_, &C, op);
luaL_getmetatable(L, "array");
lua_setmetatable(L, -2);
if (A->dtype != T) array_del(&A_);
if (B->dtype != T) array_del(&B_);
return 1;
}
static int luaC_array__index(lua_State *L)
{
Array *A = lunum_checkarray1(L, 1);
// Figure out what is the format of the input index. If it's a number or a
// table of numbers, then pass it along to _get_index. If it's an array of bools,
// then use it as a mask.
// ---------------------------------------------------------------------------
if (lunum_hasmetatable(L, 2, "array")) {
Array *M = lunum_checkarray1(L, 2);
if (M->dtype != ARRAY_TYPE_BOOL) {
return luaL_error(L, "index array must be of type bool");
}
Array B = array_new_from_mask(A, M);
lunum_pusharray1(L, &B);
return 1;
}
/* try to index into array */
int success;
const size_t m = _get_index(L, A, &success);
if (success) {
_push_value(L, A->dtype, (char*)A->data + array_sizeof(A->dtype)*m);
return 1;
}
/* check metatable */
lua_getmetatable(L, 1);
lua_pushvalue(L, 2);
if (lua_gettable(L, -2) != LUA_TNIL) {
return 1;
}
return 0;
}
int luaC_array_astype(lua_State *L)
{
struct Array *A = lunum_checkarray1(L, 1);
enum ArrayType T;
if (lua_type(L, 2) == LUA_TSTRING) {
T = array_typeflag(lua_tostring(L, 2)[0]);
}
else {
T = (enum ArrayType) luaL_checkinteger(L, 2);
}
struct Array B = array_new_copy(A, T);
lunum_pusharray1(L, &B);
return 1;
}
static int luaC_lunum_resize(lua_State *L)
{
size_t Nd_t;
Array *A = lunum_checkarray1(L, 1); // the array to resize
size_t *N = (size_t*) lunum_checkarray2(L, 2, ARRAY_TYPE_SIZE_T, &Nd_t);
int Nd = (int)Nd_t;
size_t ntot = 1;
for (int d=0; d<Nd; ++d) ntot *= N[d];
if (A->size != ntot) {
return luaL_error(L, "new and old total sizes do not agree");
}
array_resize_t(A, N, Nd);
return 0;
}
int luaC_lunum_resize(lua_State *L)
{
int Nd;
struct Array *A = lunum_checkarray1(L, 1); // the array to resize
int *N = (int*) lunum_checkarray2(L, 2, ARRAY_TYPE_INT, &Nd);
int ntot = 1;
for (int d=0; d<Nd; ++d) ntot *= N[d];
if (A->size != ntot) {
luaL_error(L, "new and old total sizes do not agree");
return 0;
}
array_resize(A, N, Nd);
return 0;
}
int luaC_array_tofile(lua_State *L)
// -----------------------------------------------------------------------------
// Writes the array 'A' as binary data to the file named 'fname'.
// -----------------------------------------------------------------------------
{
struct Array *A = lunum_checkarray1(L, 1);
const char *fname = luaL_checkstring(L, 2);
FILE *output = fopen(fname, "wb");
if (output == NULL) {
luaL_error(L, "could not create file %s", fname);
}
fwrite(A->data, A->size, array_sizeof(A->dtype), output);
fclose(output);
return 0;
}
static int luaC_array__newindex(lua_State *L)
{
Array *A = lunum_checkarray1(L, 1);
int success;
const size_t m = _get_index(L, A, &success);
if (success) {
const ArrayType T = A->dtype;
ArrayAllNum val;
lunum_tovalue(L, T, &val);
memcpy((char*)A->data + array_sizeof(T)*m, &val, array_sizeof(T));
}
return 0;
}
static int luaC_array__preserve(lua_State *L)
{
Array *A = lunum_checkarray1(L, 1);
lua_getglobal(L, "lunum");
lua_getfield(L, -1, "array");
lunum_astable(L, 1);
lua_pushinteger(L, A->dtype);
lua_createtable(L, A->ndims, 0);
for (int d = 0; d < A->ndims; d++) {
lua_pushinteger(L, A->shape[d]);
lua_seti(L, -2, d+1);
}
return 4;
}
int luaC_array_shape(lua_State *L)
// -----------------------------------------------------------------------------
// If there is no argument, return the shape as a table. If the string 'array'
// is given, return it as an array.
// -----------------------------------------------------------------------------
{
struct Array *A = lunum_checkarray1(L, 1);
lunum_pusharray2(L, A->shape, ARRAY_TYPE_INT, A->ndims);
if (lua_isstring(L, 2)) {
if (strcmp(lua_tostring(L, 2), "array") == 0) {
return 1;
}
}
lunum_astable(L, 2);
lua_replace(L, -2);
return 1;
}
int luaC_array_dtype(lua_State *L)
// -----------------------------------------------------------------------------
// If there is no argument, return a string description of the data type. If
// the string 'enum' is given as the first argument, then return the enumated
// value of the Array's type.
// -----------------------------------------------------------------------------
{
struct Array *A = lunum_checkarray1(L, 1);
if (lua_isstring(L, 2)) {
if (strcmp(lua_tostring(L, 2), "enum") == 0) {
lua_pushnumber(L, A->dtype);
return 1;
}
}
lua_pushstring(L, array_typename(A->dtype));
return 1;
}
static int luaC_array__tostring(lua_State *L)
{
Array *A = lunum_checkarray1(L, 1);
lua_pushstring(L, " [ ");
size_t nstr = 1;
for (size_t n=0; n<A->size; ++n) {
char s[64];
switch (A->dtype) {
case ARRAY_TYPE_BOOL : sprintf(s, "%s" , ((Bool*)A->data)[n]?"true":"false"); break;
case ARRAY_TYPE_CHAR : sprintf(s, "%d" , ((char *)A->data)[n]); break;
case ARRAY_TYPE_SHORT : sprintf(s, "%d" , ((short *)A->data)[n]); break;
case ARRAY_TYPE_INT : sprintf(s, "%d" , ((int *)A->data)[n]); break;
case ARRAY_TYPE_LONG : sprintf(s, "%ld", ((long *)A->data)[n]); break;
case ARRAY_TYPE_SIZE_T : sprintf(s, "%lu", ((size_t *)A->data)[n]); break;
case ARRAY_TYPE_FLOAT : sprintf(s, "%g" , ((float *)A->data)[n]); break;
case ARRAY_TYPE_DOUBLE : sprintf(s, "%g" , ((double *)A->data)[n]); break;
case ARRAY_TYPE_COMPLEX : sprintf(s, "%g%s%gj",
creal(((Complex*)A->data)[n]),
cimag(((Complex*)A->data)[n]) >= 0.0 ? "+" : "-",
fabs(cimag(((Complex*)A->data)[n]))); break;
}
if (n == A->size-1) {
lua_pushfstring(L, "%s", s);
}
else {
lua_pushfstring(L, "%s, ", s);
}
if ((n+1) % 10 == 0 && n != 0 && n != A->size-1) {
lua_pushstring(L, "\n "); ++nstr;
}
}
lua_pushstring(L, " ]"); ++nstr;
lua_concat(L, A->size + nstr);
return 1;
}
static int luaC_array__call(lua_State *L)
{
Array *A = lunum_checkarray1(L, 1);
/* slicing done here to split concerns between indexing and slicing */
if (lua_type(L, 2) == LUA_TTABLE || lua_type(L, 2) == LUA_TSTRING) {
/* make slice */
lua_getglobal(L, "lunum");
lua_getfield(L, -1, "__build_slice");
lua_insert(L, 1);
lua_settop(L, 3);
lua_call(L, 2, 1);
return 1;
}
/* index */
const int nind = lua_gettop(L) - 1;
if (nind != A->ndims) {
return luaL_error(L, "wrong number of indices (%d) for array of dimension %d",
nind, A->ndims);
return 0;
}
int isnum;
size_t m = 0;
for (int d=0; d < nind; ++d) {
const size_t i = lua_tointegerx(L, d+2, &isnum);
if (i >= A->shape[d]) {
return luaL_error(L, "array indexed out of bounds (%d) on dimension %d of size %d",
i, d, A->shape[d]);
} else if (!isnum) {
return luaL_error(L, "non-integer index encountered");
}
m = m * A->shape[d] + i;
}
_push_value(L, A->dtype, (char*)A->data + m*array_sizeof(A->dtype));
return 1;
}
void lunum_astable(lua_State *L, int pos)
{
struct Array *A = lunum_checkarray1(L, pos);
const void *a = A->data;
lua_newtable(L);
for (int i=0; i<A->size; ++i) {
lua_pushnumber(L, i+1);
switch (A->dtype) {
case ARRAY_TYPE_BOOL : lua_pushboolean (L, ((Bool *)a)[i]); break;
case ARRAY_TYPE_CHAR : lua_pushnumber (L, ((char *)a)[i]); break;
case ARRAY_TYPE_SHORT : lua_pushnumber (L, ((short *)a)[i]); break;
case ARRAY_TYPE_INT : lua_pushnumber (L, ((int *)a)[i]); break;
case ARRAY_TYPE_LONG : lua_pushnumber (L, ((long *)a)[i]); break;
case ARRAY_TYPE_FLOAT : lua_pushnumber (L, ((float *)a)[i]); break;
case ARRAY_TYPE_DOUBLE : lua_pushnumber (L, ((double *)a)[i]); break;
case ARRAY_TYPE_COMPLEX : lunum_pushcomplex(L, ((Complex *)a)[i]); break;
}
lua_settable(L, -3);
}
}
static int luaC_lunum_loadtxt(lua_State *L)
// -----------------------------------------------------------------------------
// Opens the text file 'fname' for reading, and parses the data
// line-by-line. It is assumed that the data is all floating point, and that
// only a space is used as a separator. If there are multiple columns then a 2d
// array is created. All rows must have the same number of entries, otherwise an
// error is generated.
// -----------------------------------------------------------------------------
{
const char *fname = luaL_checkstring(L, 1);
FILE *input = fopen(fname, "r");
if (input == NULL) {
return luaL_error(L, "no such file %s", fname);
}
size_t nline = 0;
size_t ncols = 0;
size_t ntot = 0;
double *data = NULL;
char line[2048];
while (fgets(line, sizeof(line), input)) {
if (strlen(line) == 1) {
continue;
}
size_t nvals = 0;
double *vals = NULL;
char *word = strtok(line, " \n");
while (word) {
vals = (double*) realloc(vals, ++nvals*sizeof(double));
vals[nvals-1] = atof(word);
word = strtok(NULL, " \n");
}
if (ncols == 0) ncols = nvals;
if (ncols != nvals) {
return luaL_error(L, "wrong number of data on line %d of %s", nline, fname);
}
data = (double*) realloc(data, (ntot+=nvals)*sizeof(double));
memcpy(data+ntot-nvals, vals, nvals*sizeof(double));
free(vals);
++nline;
}
fclose(input);
lunum_pusharray2(L, data, ARRAY_TYPE_DOUBLE, ntot);
Array *A = lunum_checkarray1(L, -1);
size_t shape[2] = { nline, ncols };
array_resize_t(A, shape, ncols == 1 ? 1 : 2);
free(data);
return 1;
}
static int _array_number_binary_op(lua_State *L, ArrayBinaryOperation op, Bool array_first)
{
const Array *A = array_first ? lunum_checkarray1(L, 1) : lunum_checkarray1(L, 2);
ArrayType T = A->dtype;
int num_pos = array_first ? 2 : 1;
union {
Bool b;
char c;
short s;
int i;
long l;
size_t t;
float f;
double d;
Complex z;
lua_Integer li;
lua_Number ln;
} num;
/* to force integer conversion if possible */
int isnum;
if (lua_isboolean(L, num_pos)) {
num.i = lua_toboolean(L, num_pos);
/* number can't have a higher type, upgrade to type T */
switch (T) {
case ARRAY_TYPE_BOOL : num.b = (Bool)num.i; break;
case ARRAY_TYPE_CHAR : num.c = (char)num.i; break;
case ARRAY_TYPE_SHORT : num.s = (short)num.i; break;
case ARRAY_TYPE_INT : num.i = (int)num.i; break;
case ARRAY_TYPE_LONG : num.l = (long)num.i; break;
case ARRAY_TYPE_SIZE_T : num.t = (size_t)num.i; break;
case ARRAY_TYPE_FLOAT : num.f = (float)num.i; break;
case ARRAY_TYPE_DOUBLE : num.d = (double)num.i; break;
case ARRAY_TYPE_COMPLEX : num.z = (Complex)num.i; break;
}
}
else if (num.li = lua_tointegerx(L, num_pos, &isnum), isnum) {
/* already assigned above */
if (T >= ARRAY_TYPE_LONG) {
/* A has higher type */
} else {
/* number has higher type */
T = ARRAY_TYPE_LONG;
}
/* upgrade to type T */
switch (T) {
case ARRAY_TYPE_BOOL : num.b = (Bool)num.li; break;
case ARRAY_TYPE_CHAR : num.c = (char)num.li; break;
case ARRAY_TYPE_SHORT : num.s = (short)num.li; break;
case ARRAY_TYPE_INT : num.i = (int)num.li; break;
case ARRAY_TYPE_LONG : num.l = (long)num.li; break;
case ARRAY_TYPE_SIZE_T : num.t = (size_t)num.li; break;
case ARRAY_TYPE_FLOAT : num.f = (float)num.li; break;
case ARRAY_TYPE_DOUBLE : num.d = (double)num.li; break;
case ARRAY_TYPE_COMPLEX : num.z = (Complex)num.li; break;
}
}
else if (num.ln = lua_tonumberx(L, num_pos, &isnum), isnum) {
/* already assigned above */
if (T >= ARRAY_TYPE_DOUBLE) {
/* A has higher type */
} else {
/* number has higher type */
T = ARRAY_TYPE_DOUBLE;
}
/* upgrade to type T */
switch (T) {
case ARRAY_TYPE_BOOL : num.b = (Bool)num.ln; break;
case ARRAY_TYPE_CHAR : num.c = (char)num.ln; break;
case ARRAY_TYPE_SHORT : num.s = (short)num.ln; break;
case ARRAY_TYPE_INT : num.i = (int)num.ln; break;
case ARRAY_TYPE_LONG : num.l = (long)num.ln; break;
case ARRAY_TYPE_SIZE_T : num.t = (size_t)num.ln; break;
case ARRAY_TYPE_FLOAT : num.f = (float)num.ln; break;
case ARRAY_TYPE_DOUBLE : num.d = (double)num.ln; break;
case ARRAY_TYPE_COMPLEX : num.z = (Complex)num.ln; break;
}
}
else if (lunum_hasmetatable(L, num_pos, "complex")) {
/* number complex */
num.z = *((Complex*) lua_touserdata(L, num_pos));
T = ARRAY_TYPE_COMPLEX;
} else {
return luaL_error(L, "Invalid argument in Array binary op");
}
Array C = array_new_zeros(A->size, T);
array_resize_t(&C, A->shape, A->ndims);
lunum_pusharray1(L, &C);
array_number_binary_op(L, A, (void *)&num, &C, op, array_first);
return 1;
}
int luaC_array_size(lua_State *L)
{
struct Array *A = lunum_checkarray1(L, 1);
lua_pushnumber(L, A->size);
return 1;
}
int lunum_upcast(lua_State *L, int pos, enum ArrayType T, int N)
// -----------------------------------------------------------------------------
// If the object at position 'pos' is already an array of dtype 'T', then push
// nothing and return 0. If the dtype is not 'T', then return 1 and push a copy
// of that array with dtype 'T' onto the stack. If it is a table, then push an
// array of dtype 'T' having the length of the table. If it is a number or
// complex, then push an array of dtype float or complex respectively having
// length 'N'.
// -----------------------------------------------------------------------------
{
if (array_typename(T) == NULL) {
luaL_error(L, "invalid array type");
}
// Deal with lunum.array
// ---------------------------------------------------------------------------
if (lunum_hasmetatable(L, pos, "array")) {
struct Array *A = lunum_checkarray1(L, pos);
if (A->dtype == T) {
return 0;
}
else {
struct Array A_ = array_new_copy(A, T);
lunum_pusharray1(L, &A_);
return 1;
}
}
// Deal with Lua table
// ---------------------------------------------------------------------------
else if (lua_istable(L, pos)) {
struct Array A = array_new_zeros(lua_rawlen(L, pos), T);
for (int i=0; i<A.size; ++i) {
lua_pushnumber(L, i+1);
lua_gettable(L, pos);
void *val = lunum_tovalue(L, T);
memcpy((char*)A.data + array_sizeof(T)*i, val, array_sizeof(T));
free(val);
lua_pop(L, 1);
}
lunum_pusharray1(L, &A);
return 1;
}
// Deal with Lua bool
// ---------------------------------------------------------------------------
else if (lua_isboolean(L, pos)) {
const Bool x = lua_toboolean(L, pos);
struct Array A = array_new_zeros(N, ARRAY_TYPE_BOOL);
array_assign_from_scalar(&A, &x);
lunum_pusharray1(L, &A);
return 1;
}
// Deal with Lua numbers
// ---------------------------------------------------------------------------
else if (lua_isnumber(L, pos)) {
const double x = lua_tonumber(L, pos);
struct Array A = array_new_zeros(N, ARRAY_TYPE_DOUBLE);
array_assign_from_scalar(&A, &x);
struct Array B = array_new_copy(&A, T);
array_del(&A);
lunum_pusharray1(L, &B);
return 1;
}
// Deal with lunum.complex
// ---------------------------------------------------------------------------
else if (lunum_hasmetatable(L, pos, "complex")) {
const Complex z = *((Complex*) lua_touserdata(L, pos));
struct Array A = array_new_zeros(N, ARRAY_TYPE_COMPLEX);
array_assign_from_scalar(&A, &z);
lunum_pusharray1(L, &A);
return 1;
}
// Throw an error
// ---------------------------------------------------------------------------
else {
luaL_error(L, "cannot cast to array from object of dtype %s\n",
lua_typename(L, lua_type(L, pos)));
return 0;
}
}
