DLLEXPORT void jl_cell_1d_push2(jl_array_t *a, jl_value_t *b, jl_value_t *c)
{
assert(jl_typeis(a, jl_array_any_type));
jl_array_grow_end(a, 2);
jl_cellset(a, jl_array_dim(a,0)-2, b);
jl_cellset(a, jl_array_dim(a,0)-1, c);
}
int jl_array_isdefined(jl_value_t **args0, int nargs)
{
assert(jl_is_array(args0[0]));
jl_array_t *a = (jl_array_t*)args0[0];
jl_value_t **args = &args0[1];
size_t nidxs = nargs-1;
size_t i=0;
size_t k, stride=1;
size_t nd = jl_array_ndims(a);
for(k=0; k < nidxs; k++) {
if (!jl_is_long(args[k]))
jl_type_error("isdefined", (jl_value_t*)jl_long_type, args[k]);
size_t ii = jl_unbox_long(args[k])-1;
i += ii * stride;
size_t d = k>=nd ? 1 : jl_array_dim(a, k);
if (k < nidxs-1 && ii >= d)
return 0;
stride *= d;
}
for(; k < nd; k++)
stride *= jl_array_dim(a, k);
if (i >= stride)
return 0;
if (a->ptrarray)
return ((jl_value_t**)jl_array_data(a))[i] != NULL;
return 1;
}
JL_DLLEXPORT size_t jl_array_len_(jl_array_t *a)
{
size_t l = 1;
for(size_t i=0; i < jl_array_ndims(a); i++)
l *= jl_array_dim(a, i);
return l;
}
static size_t array_nd_index(jl_array_t *a, jl_value_t **args, size_t nidxs,
const char *fname)
{
size_t i=0;
size_t k, stride=1;
size_t nd = jl_array_ndims(a);
for(k=0; k < nidxs; k++) {
if (!jl_is_long(args[k]))
jl_type_error(fname, (jl_value_t*)jl_long_type, args[k]);
size_t ii = jl_unbox_long(args[k])-1;
i += ii * stride;
size_t d = k>=nd ? 1 : jl_array_dim(a, k);
if (k < nidxs-1 && ii >= d)
jl_bounds_error_v((jl_value_t*)a, args, nidxs);
stride *= d;
}
for(; k < nd; k++)
stride *= jl_array_dim(a, k);
if (i >= stride)
jl_bounds_error_v((jl_value_t*)a, args, nidxs);
return i;
}
int jl_array_isdefined(jl_value_t **args0, int nargs)
{
assert(jl_is_array(args0[0]));
jl_value_t **depwarn_args;
JL_GC_PUSHARGS(depwarn_args, 3);
depwarn_args[0] = jl_get_global(jl_base_module, jl_symbol("depwarn"));
depwarn_args[1] = jl_cstr_to_string("isdefined(a::Array, i::Int) is deprecated, use isassigned(a, i) instead");
depwarn_args[2] = (jl_value_t*) jl_symbol("isdefined");
jl_apply(depwarn_args, 3);
JL_GC_POP();
jl_array_t *a = (jl_array_t*)args0[0];
jl_value_t **args = &args0[1];
size_t nidxs = nargs-1;
size_t i=0;
size_t k, stride=1;
size_t nd = jl_array_ndims(a);
for(k=0; k < nidxs; k++) {
if (!jl_is_long(args[k]))
jl_type_error("isdefined", (jl_value_t*)jl_long_type, args[k]);
size_t ii = jl_unbox_long(args[k])-1;
i += ii * stride;
size_t d = k>=nd ? 1 : jl_array_dim(a, k);
if (k < nidxs-1 && ii >= d)
return 0;
stride *= d;
}
for(; k < nd; k++)
stride *= jl_array_dim(a, k);
if (i >= stride)
return 0;
if (a->flags.ptrarray)
return ((jl_value_t**)jl_array_data(a))[i] != NULL;
return 1;
}
JL_DLLEXPORT size_t jl_array_size(jl_value_t *a, int d)
{
return jl_array_dim(a, d);
}
static void jl_serialize_value_(ios_t *s, jl_value_t *v)
{
if (v == NULL) {
write_uint8(s, Null_tag);
return;
}
void **bp = ptrhash_bp(&ser_tag, v);
if (*bp != HT_NOTFOUND) {
write_as_tag(s, (uint8_t)(ptrint_t)*bp);
return;
}
if (tree_literal_values) {
// compressing tree
if (!is_ast_node(v)) {
writetag(s, (jl_value_t*)LiteralVal_tag);
write_uint16(s, literal_val_id(v));
return;
}
}
else {
bp = ptrhash_bp(&backref_table, v);
if (*bp != HT_NOTFOUND) {
write_uint8(s, BackRef_tag);
write_int32(s, (ptrint_t)*bp);
return;
}
ptrhash_put(&backref_table, v, (void*)(ptrint_t)ios_pos(s));
}
size_t i;
if (jl_is_tuple(v)) {
size_t l = ((jl_tuple_t*)v)->length;
if (l <= 255) {
writetag(s, jl_tuple_type);
write_uint8(s, (uint8_t)l);
}
else {
writetag(s, (jl_value_t*)LongTuple_tag);
write_int32(s, l);
}
for(i=0; i < l; i++) {
jl_serialize_value(s, jl_tupleref(v, i));
}
}
else if (jl_is_symbol(v)) {
size_t l = strlen(((jl_sym_t*)v)->name);
if (l <= 255) {
writetag(s, jl_symbol_type);
write_uint8(s, (uint8_t)l);
}
else {
writetag(s, (jl_value_t*)LongSymbol_tag);
write_int32(s, l);
}
ios_write(s, ((jl_sym_t*)v)->name, l);
}
else if (jl_is_array(v)) {
jl_array_t *ar = (jl_array_t*)v;
writetag(s, (jl_value_t*)jl_array_type);
jl_serialize_value(s, ar->type);
jl_value_t *elty = jl_tparam0(ar->type);
for (i=0; i < ar->ndims; i++)
jl_serialize_value(s, jl_box_long(jl_array_dim(ar,i)));
if (jl_is_bits_type(elty)) {
size_t tot = ar->length * ar->elsize;
ios_write(s, ar->data, tot);
}
else {
for(i=0; i < ar->length; i++) {
jl_serialize_value(s, jl_cellref(v, i));
}
}
}
else if (jl_is_expr(v)) {
jl_expr_t *e = (jl_expr_t*)v;
size_t l = e->args->length;
if (l <= 255) {
writetag(s, jl_expr_type);
write_uint8(s, (uint8_t)l);
}
else {
writetag(s, (jl_value_t*)LongExpr_tag);
write_int32(s, l);
}
jl_serialize_value(s, e->head);
jl_serialize_value(s, e->etype);
for(i=0; i < l; i++) {
jl_serialize_value(s, jl_exprarg(e, i));
}
}
else if (jl_is_some_tag_type(v)) {
jl_serialize_tag_type(s, v);
}
else if (jl_is_typevar(v)) {
writetag(s, jl_tvar_type);
jl_serialize_value(s, ((jl_tvar_t*)v)->name);
jl_serialize_value(s, ((jl_tvar_t*)v)->lb);
jl_serialize_value(s, ((jl_tvar_t*)v)->ub);
write_int8(s, ((jl_tvar_t*)v)->bound);
}
else if (jl_is_function(v)) {
writetag(s, jl_func_kind);
jl_serialize_value(s, v->type);
jl_function_t *f = (jl_function_t*)v;
jl_serialize_value(s, (jl_value_t*)f->linfo);
jl_serialize_value(s, f->env);
if (f->linfo && f->linfo->ast &&
(jl_is_expr(f->linfo->ast) || jl_is_tuple(f->linfo->ast)) &&
f->fptr != &jl_trampoline) {
write_int32(s, 0);
}
else {
jl_serialize_fptr(s, f->fptr);
}
}
else if (jl_is_lambda_info(v)) {
writetag(s, jl_lambda_info_type);
jl_lambda_info_t *li = (jl_lambda_info_t*)v;
jl_serialize_value(s, li->ast);
jl_serialize_value(s, (jl_value_t*)li->sparams);
// don't save cached type info for code in the Base module, because
// it might reference types in the old System module.
if (li->module == jl_base_module)
jl_serialize_value(s, (jl_value_t*)jl_null);
else
jl_serialize_value(s, (jl_value_t*)li->tfunc);
jl_serialize_value(s, (jl_value_t*)li->name);
jl_serialize_value(s, (jl_value_t*)li->specTypes);
jl_serialize_value(s, (jl_value_t*)li->specializations);
jl_serialize_value(s, (jl_value_t*)li->inferred);
jl_serialize_value(s, (jl_value_t*)li->file);
jl_serialize_value(s, (jl_value_t*)li->line);
jl_serialize_value(s, (jl_value_t*)li->module);
}
else if (jl_typeis(v, jl_module_type)) {
jl_serialize_module(s, (jl_module_t*)v);
}
else if (jl_typeis(v, jl_methtable_type)) {
writetag(s, jl_methtable_type);
jl_methtable_t *mt = (jl_methtable_t*)v;
jl_serialize_methlist(s, mt->defs);
jl_serialize_methlist(s, mt->cache);
jl_serialize_value(s, mt->cache_1arg);
write_int32(s, mt->max_args);
}
else if (jl_typeis(v, jl_task_type)) {
jl_error("Task cannot be serialized");
}
else {
jl_value_t *t = (jl_value_t*)jl_typeof(v);
if (jl_is_bits_type(t)) {
void *data = jl_bits_data(v);
if (t == (jl_value_t*)jl_int64_type &&
*(int64_t*)data >= S32_MIN && *(int64_t*)data <= S32_MAX) {
writetag(s, (jl_value_t*)SmallInt64_tag);
write_int32(s, (int32_t)*(int64_t*)data);
}
else {
int nb = ((jl_bits_type_t*)t)->nbits;
writetag(s, jl_bits_kind);
jl_serialize_value(s, t);
ios_write(s, data, nb/8);
}
}
else if (jl_is_struct_type(t)) {
writetag(s, jl_struct_kind);
jl_serialize_value(s, t);
size_t nf = ((jl_struct_type_t*)t)->names->length;
size_t i;
for(i=0; i < nf; i++) {
jl_value_t *fld = ((jl_value_t**)v)[i+1];
jl_serialize_value(s, fld);
}
if (t == jl_idtable_type) {
jl_cell_1d_push(idtable_list, v);
}
}
else {
assert(0);
}
}
}
static SEXP Julia_R_MD_NA(jl_value_t *Var)
{
SEXP ans = R_NilValue;
char *strData = "Varname0tmp.data";
char *strNA = "bitunpack(Varname0tmp.na)";
jl_set_global(jl_main_module, jl_symbol("Varname0tmp"), (jl_value_t *)Var);
jl_value_t *retData = jl_eval_string(strData);
jl_value_t *retNA = jl_eval_string(strNA);
jl_value_t *val;
if (((jl_array_t *)retData)->ptrarray)
val = jl_cellref(retData, 0);
else
val = jl_arrayref((jl_array_t *)retData, 0);
int len = jl_array_len(retData);
if (len == 0)
return ans;
int ndims = jl_array_ndims(retData);
SEXP dims;
PROTECT(dims = allocVector(INTSXP, ndims));
for (size_t i = 0; i < ndims; i++)
INTEGER(dims)[i] = jl_array_dim(retData, i);
UNPROTECT(1);
//bool array
char *pNA = (char *) jl_array_data(retNA);
if (jl_is_bool(val))
{
char *p = (char *) jl_array_data(retData);
PROTECT(ans = allocArray(LGLSXP, dims));
for (size_t i = 0; i < len; i++)
if (pNA[i])
LOGICAL(ans)[i] = NA_LOGICAL;
else
LOGICAL(ans)[i] = p[i];
UNPROTECT(1);
}
else if (jl_is_int32(val))
{
int32_t *p = (int32_t *) jl_array_data(retData);
jlint_to_r_na;
}
//int64
else if (jl_is_int64(val))
{
int64_t *p = (int64_t *) jl_array_data(retData);
jlbiggerint_to_r_na;
}
//more integer type
else if (jl_is_int8(val))
{
int8_t *p = (int8_t *) jl_array_data(retData);
jlint_to_r_na;
}
else if (jl_is_int16(val))
{
int16_t *p = (int16_t *) jl_array_data(retData);
jlint_to_r_na;
}
else if (jl_is_uint8(val))
{
uint8_t *p = (uint8_t *) jl_array_data(retData);
jlint_to_r_na;
}
else if (jl_is_uint16(val))
{
uint16_t *p = (uint16_t *) jl_array_data(retData);
jlint_to_r_na;
}
else if (jl_is_uint32(val))
{
uint32_t *p = (uint32_t *) jl_array_data(retData);
jlbiggerint_to_r_na;
}
else if (jl_is_uint64(val))
{
uint64_t *p = (uint64_t *) jl_array_data(retData);
jlbiggerint_to_r_na;
}
//double
else if (jl_is_float64(val))
{
double *p = (double *) jl_array_data(retData);
jlfloat_to_r_na;
}
else if (jl_is_float32(val))
{
float *p = (float *) jl_array_data(retData);
jlfloat_to_r_na;
}
//convert string array to STRSXP
else if (jl_is_utf8_string(val))
{
PROTECT(ans = allocArray(STRSXP, dims));
for (size_t i = 0; i < len; i++)
if (pNA[i])
SET_STRING_ELT(ans, i, NA_STRING);
else
SET_STRING_ELT(ans, i, mkCharCE(jl_string_data(jl_cellref(retData, i)), CE_UTF8));
UNPROTECT(1);
}
else if (jl_is_ascii_string(val))
{
PROTECT(ans = allocArray(STRSXP, dims));
for (size_t i = 0; i < len; i++)
if (pNA[i])
SET_STRING_ELT(ans, i, NA_STRING);
else
SET_STRING_ELT(ans, i, mkChar(jl_string_data(jl_cellref(retData, i))));
UNPROTECT(1);
}
return ans;
}
static SEXP Julia_R_MD(jl_value_t *Var)
{
SEXP ans = R_NilValue;
jl_value_t *val;
if (((jl_array_t *)Var)->ptrarray)
val = jl_cellref(Var, 0);
else
val = jl_arrayref((jl_array_t *)Var, 0);
//get Julia dims and set R array Dims
int len = jl_array_len(Var);
if (len == 0)
return ans;
int ndims = jl_array_ndims(Var);
SEXP dims;
PROTECT(dims = allocVector(INTSXP, ndims));
for (size_t i = 0; i < ndims; i++)
{
INTEGER(dims)[i] = jl_array_dim(Var, i);
}
UNPROTECT(1);
if (jl_is_bool(val))
{
char *p = (char *) jl_array_data(Var);
PROTECT(ans = allocArray(LGLSXP, dims));
for (size_t i = 0; i < len; i++)
LOGICAL(ans)[i] = p[i];
UNPROTECT(1);
}
else if (jl_is_int32(val))
{
int32_t *p = (int32_t *) jl_array_data(Var);
jlint_to_r;
}
//int64
else if (jl_is_int64(val))
{
int64_t *p = (int64_t *) jl_array_data(Var);
jlbiggerint_to_r;
}
//more integer type
else if (jl_is_int8(val))
{
int8_t *p = (int8_t *) jl_array_data(Var);
jlint_to_r;
}
else if (jl_is_int16(val))
{
int16_t *p = (int16_t *) jl_array_data(Var);
jlint_to_r;
}
else if (jl_is_uint8(val))
{
uint8_t *p = (uint8_t *) jl_array_data(Var);
jlint_to_r;
}
else if (jl_is_uint16(val))
{
uint16_t *p = (uint16_t *) jl_array_data(Var);
jlint_to_r;
}
else if (jl_is_uint32(val))
{
uint32_t *p = (uint32_t *) jl_array_data(Var);
jlbiggerint_to_r;
}
else if (jl_is_uint64(val))
{
uint64_t *p = (uint64_t *) jl_array_data(Var);
jlbiggerint_to_r;
}
//double
else if (jl_is_float64(val))
{
double *p = (double *) jl_array_data(Var);
jlfloat_to_r;
}
else if (jl_is_float32(val))
{
float *p = (float *) jl_array_data(Var);
jlfloat_to_r;
}
//convert string array to STRSXP ,but not sure it is corret?
else if (jl_is_utf8_string(val))
{
PROTECT(ans = allocArray(STRSXP, dims));
for (size_t i = 0; i < len; i++)
SET_STRING_ELT(ans, i, mkCharCE(jl_string_data(jl_cellref(Var, i)), CE_UTF8));
UNPROTECT(1);
}
else if (jl_is_ascii_string(val))
{
PROTECT(ans = allocArray(STRSXP, dims));
for (size_t i = 0; i < len; i++)
SET_STRING_ELT(ans, i, mkChar(jl_string_data(jl_cellref(Var, i))));
UNPROTECT(1);
}
return ans;
}
DLLEXPORT void jl_cell_1d_push(jl_array_t *a, jl_value_t *item)
{
assert(jl_typeis(a, jl_array_any_type));
jl_array_grow_end(a, 1);
jl_cellset(a, jl_array_dim(a,0)-1, item);
}
// adapted from https://github.com/armgong/RJulia/blob/master/src/R_Julia.c
SEXP jr_array(jl_value_t *tt)
{
SEXP ans = R_NilValue;
//get Julia dims and set R array Dims
int len = jl_array_len(tt);
if (len == 0)
return ans;
jl_datatype_t *ty = jl_array_eltype(tt);
int ndims = jl_array_ndims(tt);
SEXP dims;
PROTECT(dims = Rf_allocVector(INTSXP, ndims));
for (size_t i = 0; i < ndims; i++)
INTEGER(dims)[i] = jl_array_dim(tt, i);
UNPROTECT(1);
// again, float64, int32 and int64 are most common
if (ty == jl_float64_type)
{
double *p = (double *) jl_array_data(tt);
PROTECT(ans = Rf_allocArray(REALSXP, dims));
for (size_t i = 0; i < len; i++) REAL(ans)[i] = p[i];
UNPROTECT(1);;
}
else if (ty == jl_int32_type)
{
int32_t *p = (int32_t *) jl_array_data(tt);
PROTECT(ans = Rf_allocArray(INTSXP, dims));
for (size_t i = 0; i < len; i++) INTEGER(ans)[i] = p[i];
UNPROTECT(1);
}
else if (ty == jl_int64_type)
{
int is_int32 = 1;
int64_t *p = (int64_t *) jl_array_data(tt);
for (size_t i=0;i<len;i++)
{
if (p[i]>INT32_MAX || p[i]<INT32_MIN)
{
is_int32 = 0;
break;
}
}
if (is_int32)
{
PROTECT(ans = Rf_allocArray(INTSXP, dims));
for (size_t i = 0; i < len; i++) INTEGER(ans)[i] = p[i];
UNPROTECT(1);
}
else
{
PROTECT(ans = Rf_allocArray(REALSXP, dims));
for (size_t i = 0; i < len; i++) REAL(ans)[i] = p[i];
UNPROTECT(1);
}
}
else if (ty == jl_bool_type)
{
bool *p = (bool *) jl_array_data(tt);
PROTECT(ans = Rf_allocArray(LGLSXP, dims));
for (size_t i = 0; i < len; i++)
LOGICAL(ans)[i] = p[i];
UNPROTECT(1);
}
else if (ty == jl_int8_type)
{
int8_t *p = (int8_t *) jl_array_data(tt);
PROTECT(ans = Rf_allocArray(INTSXP, dims));
for (size_t i = 0; i < len; i++) INTEGER(ans)[i] = p[i];
UNPROTECT(1);
}
else if (ty == jl_uint8_type)
{
uint8_t *p = (uint8_t *) jl_array_data(tt);
PROTECT(ans = Rf_allocArray(INTSXP, dims));
for (size_t i = 0; i < len; i++) INTEGER(ans)[i] = p[i];
UNPROTECT(1);
}
else if (ty == jl_int16_type)
{
int16_t *p = (int16_t *) jl_array_data(tt);
PROTECT(ans = Rf_allocArray(INTSXP, dims));
for (size_t i = 0; i < len; i++) INTEGER(ans)[i] = p[i];
UNPROTECT(1);
}
else if (ty == jl_uint16_type)
{
uint16_t *p = (uint16_t *) jl_array_data(tt);
PROTECT(ans = Rf_allocArray(INTSXP, dims));
for (size_t i = 0; i < len; i++) INTEGER(ans)[i] = p[i];
UNPROTECT(1);
}
else if (ty == jl_uint32_type)
{
int is_int32 = 1;
uint32_t *p = (uint32_t *) jl_array_data(tt);
for (size_t i=0;i<len;i++)
{
if (p[i]>INT32_MAX || p[i]<INT32_MIN)
{
is_int32 = 0;
break;
}
}
if (is_int32)
{
PROTECT(ans = Rf_allocArray(INTSXP, dims));
for (size_t i = 0; i < len; i++) INTEGER(ans)[i] = p[i];
UNPROTECT(1);
}
else
{
PROTECT(ans = Rf_allocArray(REALSXP, dims));
for (size_t i = 0; i < len; i++) REAL(ans)[i] = p[i];
UNPROTECT(1);
}
}
else if (ty == jl_uint64_type)
{
int is_int32 = 1;
uint64_t *p = (uint64_t *) jl_array_data(tt);
for (size_t i=0;i<len;i++)
{
if (p[i]>INT32_MAX || p[i]<INT32_MIN)
{
is_int32 = 0;
break;
}
}
if (is_int32)
{
PROTECT(ans = Rf_allocArray(INTSXP, dims));
for (size_t i = 0; i < len; i++) INTEGER(ans)[i] = p[i];
UNPROTECT(1);
}
else
{
PROTECT(ans = Rf_allocArray(REALSXP, dims));
for (size_t i = 0; i < len; i++) REAL(ans)[i] = p[i];
UNPROTECT(1);
}
}
//double
else if (ty == jl_float32_type)
{
float *p = (float *) jl_array_data(tt);
PROTECT(ans = Rf_allocArray(REALSXP, dims));
for (size_t i = 0; i < len; i++) REAL(ans)[i] = p[i];
UNPROTECT(1);;
}
//utf8 string
else if (ty == jl_utf8_string_type)
{
PROTECT(ans = Rf_allocArray(STRSXP, dims));
for (size_t i = 0; i < len; i++)
SET_STRING_ELT(ans, i, Rf_mkCharCE(jl_string_data(jl_cellref(tt, i)), CE_UTF8));
UNPROTECT(1);
}
else if (ty == jl_ascii_string_type)
{
PROTECT(ans = Rf_allocArray(STRSXP, dims));
for (size_t i = 0; i < len; i++)
SET_STRING_ELT(ans, i, Rf_mkChar(jl_string_data(jl_cellref(tt, i))));
UNPROTECT(1);
}
return ans;
}
DLLEXPORT long jl_array_size(jl_value_t *a, int d)
{
return jl_array_dim(a, d);
}
