JL_DLLEXPORT jl_value_t *jl_backtrace_from_here(int returnsp)
{
jl_svec_t *tp = NULL;
jl_array_t *ip = NULL;
jl_array_t *sp = NULL;
JL_GC_PUSH3(&tp, &ip, &sp);
if (array_ptr_void_type == NULL) {
tp = jl_svec2(jl_voidpointer_type, jl_box_long(1));
array_ptr_void_type = jl_apply_type((jl_value_t*)jl_array_type, tp);
}
ip = jl_alloc_array_1d(array_ptr_void_type, 0);
sp = returnsp ? jl_alloc_array_1d(array_ptr_void_type, 0) : NULL;
const size_t maxincr = 1000;
bt_context_t context;
bt_cursor_t cursor;
memset(&context, 0, sizeof(context));
jl_unw_get(&context);
if (jl_unw_init(&cursor, &context)) {
size_t n = 0, offset = 0;
do {
jl_array_grow_end(ip, maxincr);
if (returnsp) jl_array_grow_end(sp, maxincr);
n = jl_unw_stepn(&cursor, (uintptr_t*)jl_array_data(ip) + offset,
returnsp ? (uintptr_t*)jl_array_data(sp) + offset : NULL, maxincr);
offset += maxincr;
} while (n > maxincr);
jl_array_del_end(ip, maxincr - n);
if (returnsp) jl_array_del_end(sp, maxincr - n);
}
jl_value_t *bt = returnsp ? (jl_value_t*)jl_svec2(ip, sp) : (jl_value_t*)ip;
JL_GC_POP();
return bt;
}
static inline void jl_intset(const jl_array_t *arr, size_t idx, size_t val)
{
jl_value_t *el = jl_tparam0(jl_typeof(arr));
if (el == (jl_value_t*)jl_uint8_type)
((uint8_t*)jl_array_data(arr))[idx] = val;
else if (el == (jl_value_t*)jl_uint16_type)
((uint16_t*)jl_array_data(arr))[idx] = val;
else if (el == (jl_value_t*)jl_uint32_type)
((uint32_t*)jl_array_data(arr))[idx] = val;
else
abort();
}
static inline size_t jl_intref(const jl_array_t *arr, size_t idx)
{
jl_value_t *el = jl_tparam0(jl_typeof(arr));
if (el == (jl_value_t*)jl_uint8_type)
return ((uint8_t*)jl_array_data(arr))[idx];
else if (el == (jl_value_t*)jl_uint16_type)
return ((uint16_t*)jl_array_data(arr))[idx];
else if (el == (jl_value_t*)jl_uint32_type)
return ((uint32_t*)jl_array_data(arr))[idx];
else
abort();
}
static jl_value_t *R_Julia_MD_NA_Factor(SEXP Var, const char *VarName)
{
SEXP levels = getAttrib(Var, R_LevelsSymbol);
if (levels == R_NilValue)
return jl_nothing;
//create string array for levels in julia
jl_array_t *ret1 = jl_alloc_array_1d(jl_apply_array_type(jl_ascii_string_type, 1), LENGTH(levels));
jl_value_t **retData1 = jl_array_data(ret1);
for (size_t i = 0; i < jl_array_len(ret1); i++)
if (!IS_ASCII(Var))
retData1[i] = jl_cstr_to_string(translateChar0(STRING_ELT(levels, i)));
else
retData1[i] = jl_cstr_to_string(CHAR(STRING_ELT(levels, i)));
if ((LENGTH(Var)) != 0)
{
switch (TYPEOF(Var))
{
case INTSXP:
{
jl_array_t *ret = jl_alloc_array_1d(jl_apply_array_type(jl_uint32_type, 1), LENGTH(Var));
JL_GC_PUSH(&ret, &ret1);
int *retData = (int *)jl_array_data(ret);
for (size_t i = 0; i < jl_array_len(ret); i++)
{
if (INTEGER(Var)[i] == NA_INTEGER)
{
//NA in poolarray is 0
retData[i] = 0;
}
else
{
retData[i] = INTEGER(Var)[i];
}
}
JL_GC_POP();
return TransArrayToPoolDataArray(ret, ret1, LENGTH(Var), VarName);
break;
}
default:
return (jl_value_t *) jl_nothing;
break;
}//case end
return (jl_value_t *) jl_nothing;
}//if length !=0
return (jl_value_t *) jl_nothing;
}
jl_value_t *jl_readuntil(ios_t *s, uint8_t delim)
{
jl_array_t *a;
// manually inlined common case
char *pd = (char*)memchr(s->buf+s->bpos, delim, s->size - s->bpos);
if (pd) {
size_t n = pd-(s->buf+s->bpos)+1;
a = jl_alloc_array_1d(jl_array_uint8_type, n);
memcpy(jl_array_data(a), s->buf+s->bpos, n);
s->bpos += n;
}
else {
a = jl_alloc_array_1d(jl_array_uint8_type, 80);
ios_t dest;
jl_ios_mem(&dest, 0);
ios_setbuf(&dest, a->data, 80, 0);
size_t n = ios_copyuntil(&dest, s, delim);
if (dest.buf != a->data) {
a = jl_takebuf_array(&dest);
}
else {
a->length = n;
a->nrows = n;
((char*)a->data)[n] = '\0';
}
}
JL_GC_PUSH(&a);
jl_struct_type_t* string_type = u8_isvalid(a->data, a->length) == 1 ? // ASCII
jl_ascii_string_type : jl_utf8_string_type;
jl_value_t *str = alloc_2w();
str->type = (jl_type_t*)string_type;
jl_fieldref(str,0) = (jl_value_t*)a;
JL_GC_POP();
return str;
}
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;
}
static int jl_typemap_intersection_array_visitor(struct jl_ordereddict_t *a, jl_value_t *ty, int tparam,
int offs, struct typemap_intersection_env *closure)
{
size_t i, l = jl_array_len(a->values);
union jl_typemap_t *data = (union jl_typemap_t*)jl_array_data(a->values);
for (i = 0; i < l; i++) {
union jl_typemap_t ml = data[i];
if (ml.unknown == jl_nothing)
continue;
jl_value_t *t;
if (jl_typeof(ml.unknown) == (jl_value_t*)jl_typemap_level_type) {
t = ml.node->key;
}
else {
t = jl_field_type(ml.leaf->sig, offs);
if (tparam)
t = jl_tparam0(t);
}
if (ty == (jl_value_t*)jl_any_type || // easy case: Any always matches
(tparam ? // need to compute `ty <: Type{t}`
(jl_is_uniontype(ty) || // punt on Union{...} right now
jl_typeof(t) == ty || // deal with kinds (e.g. ty == DataType && t == Type{t})
(jl_is_type_type(ty) && (jl_is_typevar(jl_tparam0(ty)) ?
jl_subtype(t, ((jl_tvar_t*)jl_tparam0(ty))->ub, 0) : // deal with ty == Type{<:T}
jl_subtype(t, jl_tparam0(ty), 0)))) // deal with ty == Type{T{#<:T}}
: jl_subtype(t, ty, 0))) // `t` is a leaftype, so intersection test becomes subtype
if (!jl_typemap_intersection_visitor(ml, offs+1, closure))
return 0;
}
return 1;
}
JL_DLLEXPORT jl_value_t *jl_array_to_string(jl_array_t *a)
{
size_t len = jl_array_len(a);
if (a->flags.how == 3 && a->offset == 0 && a->elsize == 1 &&
(jl_array_ndims(a) != 1 ||
((a->maxsize + sizeof(void*) + 1 <= GC_MAX_SZCLASS) == (len + sizeof(void*) + 1 <= GC_MAX_SZCLASS)))) {
jl_value_t *o = jl_array_data_owner(a);
if (jl_is_string(o)) {
a->flags.isshared = 1;
*(size_t*)o = len;
a->nrows = 0;
#ifdef STORE_ARRAY_LEN
a->length = 0;
#endif
a->maxsize = 0;
return o;
}
}
a->nrows = 0;
#ifdef STORE_ARRAY_LEN
a->length = 0;
#endif
a->maxsize = 0;
return jl_pchar_to_string((const char*)jl_array_data(a), len);
}
static void mtcache_rehash(jl_array_t **pa, jl_value_t *parent, int8_t tparam, int8_t offs)
{
size_t i, len = jl_array_len(*pa);
size_t newlen = next_power_of_two(len) * 2;
jl_value_t **d = (jl_value_t**)jl_array_data(*pa);
jl_array_t *n = jl_alloc_vec_any(newlen);
for (i = 1; i <= len; i++) {
union jl_typemap_t ml;
ml.unknown = d[i - 1];
if (ml.unknown != NULL && ml.unknown != jl_nothing) {
jl_value_t *t;
if (jl_typeof(ml.unknown) == (jl_value_t*)jl_typemap_level_type) {
t = ml.node->key;
}
else {
t = jl_field_type(ml.leaf->sig, offs);
if (tparam)
t = jl_tparam0(t);
}
uintptr_t uid = ((jl_datatype_t*)t)->uid;
size_t idx = uid & (newlen - 1);
if (((jl_value_t**)n->data)[idx] == NULL) {
((jl_value_t**)n->data)[idx] = ml.unknown;
}
else {
// hash collision: start over after doubling the size again
i = 0;
newlen *= 2;
n = jl_alloc_vec_any(newlen);
}
}
}
*pa = n;
jl_gc_wb(parent, n);
}
jl_value_t *jl_readuntil(ios_t *s, uint8_t delim)
{
jl_array_t *a;
// manually inlined common case
char *pd = (char*)memchr(s->buf+s->bpos, delim, s->size - s->bpos);
if (pd) {
size_t n = pd-(s->buf+s->bpos)+1;
a = jl_alloc_array_1d(jl_array_uint8_type, n);
memcpy(jl_array_data(a), s->buf+s->bpos, n);
s->bpos += n;
}
else {
a = jl_alloc_array_1d(jl_array_uint8_type, 80);
ios_t dest;
ios_mem(&dest, 0);
ios_setbuf(&dest, a->data, 80, 0);
size_t n = ios_copyuntil(&dest, s, delim);
if (dest.buf != a->data) {
a = jl_takebuf_array(&dest);
}
else {
#ifdef STORE_ARRAY_LEN
a->length = n;
#endif
a->nrows = n;
((char*)a->data)[n] = '\0';
}
}
return (jl_value_t*)a;
}
static int jl_typemap_intersection_array_visitor(struct jl_ordereddict_t *a, jl_value_t *ty, int tparam,
int offs, struct typemap_intersection_env *closure)
{
size_t i, l = jl_array_len(a->values);
union jl_typemap_t *data = (union jl_typemap_t*)jl_array_data(a->values);
for (i = 0; i < l; i++) {
union jl_typemap_t ml = data[i];
if (ml.unknown == jl_nothing)
continue;
jl_value_t *t;
if (jl_typeof(ml.unknown) == (jl_value_t*)jl_typemap_level_type) {
t = ml.node->key;
}
else {
t = jl_field_type(jl_unwrap_unionall((jl_value_t*)ml.leaf->sig), offs);
if (tparam)
t = jl_tparam0(t);
}
// `t` is a leaftype, so intersection test becomes subtype
if (ty == (jl_value_t*)jl_any_type || // easy case: Any always matches
(tparam
? (jl_typeof(t) == ty || jl_isa(t, ty)) // (Type{t} <: ty), where is_leaf_type(t) => isa(t, ty)
: (t == ty || jl_subtype(t, ty)))) {
if (!jl_typemap_intersection_visitor(ml, offs + 1, closure))
return 0;
}
}
return 1;
}
void juliaProblem::EucHessianEta(Variable *x, Vector *etax, Vector *exix) const
{
// x->Print("cpp hf x");//---
// etax->Print("cpp hf etax");//---
jl_value_t* array_type = jl_apply_array_type(jl_float64_type, 1);
double *xptr = x->ObtainWritePartialData();
jl_array_t *arrx = jl_ptr_to_array_1d(array_type, xptr, x->Getlength(), 0);
double *etaxptr = etax->ObtainWritePartialData();
jl_array_t *arretax = jl_ptr_to_array_1d(array_type, etaxptr, etax->Getlength(), 0);
jl_array_t *arrtmp = nullptr;
if(x->TempDataExist(("Tmp")))
{
const SharedSpace *Tmp = x->ObtainReadTempData("Tmp");
// Tmp->Print("cpp hf inTmp");//---
const double *tmpptr = Tmp->ObtainReadData();
arrtmp = jl_ptr_to_array_1d(array_type, const_cast<double *> (tmpptr), Tmp->Getlength(), 0);
} else
{
arrtmp = jl_ptr_to_array_1d(array_type, nullptr, 0, 0);
}
jl_value_t *retresult = jl_call3(jl_Hess, (jl_value_t *) arrx, (jl_value_t *) arrtmp, (jl_value_t *) arretax);
jl_array_t *jl_exix = (jl_array_t *) jl_get_nth_field(retresult, 0);
jl_array_t *outtmp = (jl_array_t *) jl_get_nth_field(retresult, 1);
if(jl_array_len(jl_exix) != etax->Getlength())
{
std::cout << "error: the size of the action of the Hessian is not correct!" << std::endl;
exit(EXIT_FAILURE);
}
integer exixlen = exix->Getlength();
double *exixptr = exix->ObtainWriteEntireData();
dcopy_(&exixlen, (double*)jl_array_data(jl_exix), &GLOBAL::IONE, exixptr, &GLOBAL::IONE);
// exix->Print("cpp hf exix:");//---
integer outtmplen = jl_array_len(outtmp);
if(outtmplen != 0)
{
SharedSpace *sharedouttmp = new SharedSpace(1, outtmplen);
double *outtmpptr = sharedouttmp->ObtainWriteEntireData();
dcopy_(&outtmplen, (double*)jl_array_data(outtmp), &GLOBAL::IONE, outtmpptr, &GLOBAL::IONE);
x->RemoveFromTempData("Tmp");
x->AddToTempData("Tmp", sharedouttmp);
}
};
void *td_jl_get_dataptr(void *v)
{
if (jl_is_array(v))
return jl_array_data(v);
if (jl_is_byte_string(v))
return jl_string_data(v);
return jl_data_ptr(v);
}
static union jl_typemap_t *mtcache_hash_bp(struct jl_ordereddict_t *pa, jl_value_t *ty,
int8_t tparam, int8_t offs, jl_value_t *parent)
{
if (jl_is_datatype(ty)) {
uintptr_t uid = ((jl_datatype_t*)ty)->uid;
if (!uid || is_kind(ty) || jl_has_typevars(ty))
// be careful not to put non-leaf types or DataType/TypeConstructor in the cache here,
// since they should have a lower priority and need to go into the sorted list
return NULL;
if (pa->values == (void*)jl_nothing) {
pa->indexes = jl_alloc_int_1d(0, INIT_CACHE_SIZE);
jl_gc_wb(parent, pa->indexes);
pa->values = jl_alloc_vec_any(0);
jl_gc_wb(parent, pa->values);
}
while (1) {
size_t slot = uid & (pa->indexes->nrows - 1);
size_t idx = jl_intref(pa->indexes, slot);
if (idx == 0) {
jl_array_ptr_1d_push(pa->values, jl_nothing);
idx = jl_array_len(pa->values);
if (idx > jl_max_int(pa->indexes))
mtcache_rehash(pa, jl_array_len(pa->indexes), parent, tparam, offs);
jl_intset(pa->indexes, slot, idx);
return &((union jl_typemap_t*)jl_array_data(pa->values))[idx - 1];
}
union jl_typemap_t *pml = &((union jl_typemap_t*)jl_array_data(pa->values))[idx - 1];
if (pml->unknown == jl_nothing)
return pml;
jl_value_t *t;
if (jl_typeof(pml->unknown) == (jl_value_t*)jl_typemap_level_type) {
t = pml->node->key;
}
else {
assert(jl_typeof(pml->unknown) == (jl_value_t*)jl_typemap_entry_type);
t = jl_field_type(pml->leaf->sig, offs);
if (tparam)
t = jl_tparam0(t);
}
if (t == ty)
return pml;
mtcache_rehash(pa, jl_array_len(pa->indexes) * 2, parent, tparam, offs);
}
}
return NULL;
}
int jl_array_isdefined(jl_value_t **args, int nargs)
{
assert(jl_is_array(args[0]));
jl_array_t *a = (jl_array_t*)args[0];
size_t i = array_nd_index(a, &args[1], nargs-1, "isdefined");
if (a->ptrarray)
return ((jl_value_t**)jl_array_data(a))[i] != NULL;
return 1;
}
static int jl_typemap_array_visitor(struct jl_ordereddict_t *a, jl_typemap_visitor_fptr fptr, void *closure)
{
size_t i, l = jl_array_len(a->values);
union jl_typemap_t *data = (union jl_typemap_t*)jl_array_data(a->values);
for(i=0; i < l; i++) {
if (!jl_typemap_visitor(data[i], fptr, closure))
return 0;
}
return 1;
}
//this function is for factor convert it maybe not safe
//because PooledDataArray.refs is Uint32 or bigger
//but in pratice it should be ok
static SEXP Julia_R_MD_INT(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);
int len = jl_array_len(Var);
if (len == 0) return ans;
if (jl_is_int32(val))
{
int32_t *p = (int32_t *) jl_array_data(Var);
jlint_to_r_md;
}
else if (jl_is_int64(val))
{
int64_t *p = (int64_t *) jl_array_data(Var);
jlint_to_r_md;
}
else if (jl_is_int8(val))
{
int8_t *p = (int8_t *) jl_array_data(Var);
jlint_to_r_md;
}
else if (jl_is_int16(val))
{
int16_t *p = (int16_t *) jl_array_data(Var);
jlint_to_r_md;
}
else if (jl_is_uint8(val))
{
uint8_t *p = (uint8_t *) jl_array_data(Var);
jlint_to_r_md;
}
else if (jl_is_uint16(val))
{
uint16_t *p = (uint16_t *) jl_array_data(Var);
jlint_to_r_md;
}
else if (jl_is_uint32(val))
{
uint32_t *p = (uint32_t *) jl_array_data(Var);
jlint_to_r_md;
}
else if (jl_is_uint64(val))
{
uint64_t *p = (uint64_t *) jl_array_data(Var);
jlint_to_r_md;
}
return ans;
}
JL_DLLEXPORT jl_value_t *jl_readuntil(ios_t *s, uint8_t delim, uint8_t str, uint8_t chomp)
{
jl_array_t *a;
// manually inlined common case
char *pd = (char*)memchr(s->buf + s->bpos, delim, (size_t)(s->size - s->bpos));
if (pd) {
size_t n = pd - (s->buf + s->bpos) + 1;
if (str) {
size_t nchomp = 0;
if (chomp) {
nchomp = ios_nchomp(s, n);
}
jl_value_t *str = jl_pchar_to_string(s->buf + s->bpos, n - nchomp);
s->bpos += n;
return str;
}
a = jl_alloc_array_1d(jl_array_uint8_type, n);
memcpy(jl_array_data(a), s->buf + s->bpos, n);
s->bpos += n;
}
else {
a = jl_alloc_array_1d(jl_array_uint8_type, 80);
ios_t dest;
ios_mem(&dest, 0);
ios_setbuf(&dest, (char*)a->data, 80, 0);
size_t n = ios_copyuntil(&dest, s, delim);
if (chomp && n > 0 && dest.buf[n - 1] == '\n') {
n--;
if (n > 0 && dest.buf[n - 1] == '\r') {
n--;
}
int truncret = ios_trunc(&dest, n); // it should always be possible to truncate dest
assert(truncret == 0);
(void)truncret; // ensure the variable is used to avoid warnings
}
if (dest.buf != a->data) {
a = jl_take_buffer(&dest);
}
else {
#ifdef STORE_ARRAY_LEN
a->length = n;
#endif
a->nrows = n;
((char*)a->data)[n] = '\0';
}
if (str) {
JL_GC_PUSH1(&a);
jl_value_t *st = jl_array_to_string(a);
JL_GC_POP();
return st;
}
}
return (jl_value_t*)a;
}
static int jl_typemap_array_visitor(jl_array_t *a, jl_typemap_visitor_fptr fptr, void *closure)
{
size_t i, l = jl_array_len(a);
jl_value_t **data = (jl_value_t**)jl_array_data(a);
for(i=0; i < l; i++) {
if (data[i] != NULL)
if (!jl_typemap_visitor(((union jl_typemap_t*)data)[i], fptr, closure))
return 0;
}
return 1;
}
ValueIfNotPtrArray<T> boxArray(const T* data, size_t size)
{
log("boxArray(const T*) - jl_alloc_array_1d and memcpy");
jl_datatype_t* dataType = TypeTraits<UnqualifiedType<T>>::dataType();
JULIACPP_ASSERT(dataType != nullptr, "Data type not supported.");
jl_value_t* arrayType = jl_apply_array_type(dataType, 1);
jl_array_t* array = jl_alloc_array_1d(arrayType, size);
std::memcpy(jl_array_data(array), data, sizeof(T) * size);
return (jl_value_t*)array;
}
ValueIfPtrArray<T> boxArray(const T* data, size_t size)
{
log("boxArray(const T*) - jl_alloc_array_1d and unbox per element");
jl_datatype_t* dataType = TypeTraits<UnqualifiedType<T>>::dataType();
JULIACPP_ASSERT(dataType != nullptr, "Data type not supported.");
jl_value_t* arrayType = jl_apply_array_type(dataType, 1);
jl_array_t* array = jl_alloc_array_1d(arrayType, size);
jl_value_t** arrayData = (jl_value_t**)jl_array_data(array);
for (size_t i = 0; i < size; i++)
{
arrayData[i] = box(data[i]);
}
return (jl_value_t*)array;
}
double juliaProblem::f(Variable *x) const
{
// x->Print("cpp f x");//---
jl_value_t* array_type = jl_apply_array_type(jl_float64_type, 1);
double *xptr = x->ObtainWritePartialData();
jl_array_t *arrx = jl_ptr_to_array_1d(array_type, xptr, x->Getlength(), 0);
jl_array_t *arrtmp = nullptr;
if(x->TempDataExist(("Tmp")))
{
const SharedSpace *Tmp = x->ObtainReadTempData("Tmp");
const double *tmpptr = Tmp->ObtainReadData();
arrtmp = jl_ptr_to_array_1d(array_type, const_cast<double *> (tmpptr), Tmp->Getlength(), 0);
} else
{
arrtmp = jl_ptr_to_array_1d(array_type, nullptr, 0, 0);
}
jl_value_t *retresult = jl_call2(jl_f, (jl_value_t *) arrx, (jl_value_t *) arrtmp);
jl_get_nth_field(retresult, 0);
jl_value_t *fx = jl_get_nth_field(retresult, 0);
jl_array_t *outtmp = (jl_array_t *) jl_get_nth_field(retresult, 1);
integer outtmplen = jl_array_len(outtmp);
SharedSpace *sharedouttmp = new SharedSpace(1, outtmplen);
double *outtmpptr = sharedouttmp->ObtainWriteEntireData();
dcopy_(&outtmplen, (double*)jl_array_data(outtmp), &GLOBAL::IONE, outtmpptr, &GLOBAL::IONE);
// sharedouttmp->Print("cpp f tmp:");//----
x->RemoveFromTempData("Tmp");
x->AddToTempData("Tmp", sharedouttmp);
if(jl_is_float64(fx))
{
double result = jl_unbox_float64(fx);
// std::cout << "cpp f fx:" << result << std::endl;//-----
return result;
}
std::cout << "Error: The objectve function must return a number of double precision!" << std::endl;
exit(EXIT_FAILURE);
};
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;
}
static union jl_typemap_t *mtcache_hash_bp(jl_array_t **pa, jl_value_t *ty,
int8_t tparam, int8_t offs, jl_value_t *parent)
{
if (jl_is_datatype(ty)) {
uintptr_t uid = ((jl_datatype_t*)ty)->uid;
if (!uid || is_kind(ty) || jl_has_typevars(ty))
// be careful not to put non-leaf types or DataType/TypeConstructor in the cache here,
// since they should have a lower priority and need to go into the sorted list
return NULL;
if (*pa == (void*)jl_nothing) {
*pa = jl_alloc_vec_any(INIT_CACHE_SIZE);
jl_gc_wb(parent, *pa);
}
while (1) {
union jl_typemap_t *pml = &((union jl_typemap_t*)jl_array_data(*pa))[uid & ((*pa)->nrows-1)];
union jl_typemap_t ml = *pml;
if (ml.unknown == NULL || ml.unknown == jl_nothing) {
pml->unknown = jl_nothing;
return pml;
}
jl_value_t *t;
if (jl_typeof(ml.unknown) == (jl_value_t*)jl_typemap_level_type) {
t = ml.node->key;
}
else {
t = jl_field_type(ml.leaf->sig, offs);
if (tparam)
t = jl_tparam0(t);
}
if (t == ty)
return pml;
mtcache_rehash(pa, parent, tparam, offs);
}
}
return NULL;
}
JL_DLLEXPORT void jl_method_init_properties(jl_method_t *m)
{
jl_lambda_info_t *li = m->lambda_template;
size_t j, n = jl_array_len((jl_array_t*)li->code);
jl_value_t **body = (jl_value_t**)jl_array_data((jl_array_t*)li->code);
for(j=0; j < n; j++) {
jl_value_t *st = body[j];
if (jl_is_expr(st) && ((jl_expr_t*)st)->head == line_sym) {
m->line = jl_unbox_long(jl_exprarg(st, 0));
m->file = (jl_sym_t*)jl_exprarg(st, 1);
body[j] = jl_nothing;
break;
}
}
int i;
uint8_t called=0;
for(i=1; i < li->nargs && i <= 8; i++) {
jl_value_t *ai = jl_array_ptr_ref(li->slotnames,i);
if (ai == (jl_value_t*)unused_sym) continue;
if (jl_array_uint8_ref(li->slotflags,i)&64)
called |= (1<<(i-1));
}
m->called = called;
}
static int jl_typemap_intersection_array_visitor(jl_array_t *a, jl_value_t *ty, int tparam,
int offs, struct typemap_intersection_env *closure)
{
size_t i, l = jl_array_len(a);
jl_value_t **data = (jl_value_t**)jl_array_data(a);
for (i = 0; i < l; i++) {
union jl_typemap_t ml = ((union jl_typemap_t*)data)[i];
if (ml.unknown != NULL && ml.unknown != jl_nothing) {
jl_value_t *t;
if (jl_typeof(ml.unknown) == (jl_value_t*)jl_typemap_level_type) {
t = ml.node->key;
}
else {
t = jl_field_type(ml.leaf->sig, offs);
if (tparam)
t = jl_tparam0(t);
}
// TODO: fast path: test key `t`
if (!jl_typemap_intersection_visitor(ml, offs+1, closure))
return 0;
}
}
return 1;
}
JL_DLLEXPORT int jl_array_isassigned(jl_array_t *a, size_t i)
{
if (a->flags.ptrarray)
return ((jl_value_t**)jl_array_data(a))[i] != NULL;
return 1;
}
static jl_value_t *eval(jl_value_t *e, jl_value_t **locals, size_t nl, size_t ngensym)
{
if (jl_is_symbol(e)) {
jl_value_t *v;
size_t i;
for(i=0; i < nl; i++) {
if (locals[i*2] == e) {
v = locals[i*2+1];
break;
}
}
if (i >= nl) {
v = jl_get_global(jl_current_module, (jl_sym_t*)e);
}
if (v == NULL) {
jl_undefined_var_error((jl_sym_t*)e);
}
return v;
}
if (jl_is_symbolnode(e)) {
return eval((jl_value_t*)jl_symbolnode_sym(e), locals, nl, ngensym);
}
if (jl_is_gensym(e)) {
ssize_t genid = ((jl_gensym_t*)e)->id;
if (genid >= ngensym || genid < 0)
jl_error("access to invalid GenSym location");
else
return locals[nl*2 + genid];
}
if (jl_is_quotenode(e)) {
return jl_fieldref(e,0);
}
if (jl_is_topnode(e)) {
jl_sym_t *s = (jl_sym_t*)jl_fieldref(e,0);
jl_value_t *v = jl_get_global(jl_base_relative_to(jl_current_module),s);
if (v == NULL)
jl_undefined_var_error(s);
return v;
}
if (!jl_is_expr(e)) {
if (jl_is_globalref(e)) {
jl_value_t *gfargs[2] = {(jl_value_t*)jl_globalref_mod(e), (jl_value_t*)jl_globalref_name(e)};
return jl_f_get_field(NULL, gfargs, 2);
}
if (jl_is_lambda_info(e)) {
jl_lambda_info_t *li = (jl_lambda_info_t*)e;
if (jl_boot_file_loaded && li->ast && jl_is_expr(li->ast)) {
li->ast = jl_compress_ast(li, li->ast);
jl_gc_wb(li, li->ast);
}
return (jl_value_t*)jl_new_closure(NULL, (jl_value_t*)jl_emptysvec, li);
}
if (jl_is_linenode(e)) {
jl_lineno = jl_linenode_line(e);
}
if (jl_is_newvarnode(e)) {
jl_value_t *var = jl_fieldref(e,0);
assert(!jl_is_gensym(var));
assert(jl_is_symbol(var));
for(size_t i=0; i < nl; i++) {
if (locals[i*2] == var) {
locals[i*2+1] = NULL;
break;
}
}
return (jl_value_t*)jl_nothing;
}
return e;
}
jl_expr_t *ex = (jl_expr_t*)e;
jl_value_t **args = (jl_value_t**)jl_array_data(ex->args);
size_t nargs = jl_array_len(ex->args);
if (ex->head == call_sym) {
if (jl_is_lambda_info(args[0])) {
// directly calling an inner function ("let")
jl_lambda_info_t *li = (jl_lambda_info_t*)args[0];
if (jl_is_expr(li->ast) && !jl_lam_vars_captured((jl_expr_t*)li->ast) &&
!jl_has_intrinsics((jl_expr_t*)li->ast, (jl_expr_t*)li->ast, jl_current_module)) {
size_t na = nargs-1;
if (na == 0)
return jl_interpret_toplevel_thunk(li);
jl_array_t *formals = jl_lam_args((jl_expr_t*)li->ast);
size_t nreq = jl_array_len(formals);
if (nreq==0 || !jl_is_rest_arg(jl_cellref(formals,nreq-1))) {
jl_value_t **ar;
JL_GC_PUSHARGS(ar, na*2);
for(int i=0; i < na; i++) {
ar[i*2+1] = eval(args[i+1], locals, nl, ngensym);
jl_gc_wb(ex->args, ar[i*2+1]);
}
if (na != nreq) {
jl_error("wrong number of arguments");
}
for(int i=0; i < na; i++) {
jl_value_t *v = jl_cellref(formals, i);
ar[i*2] = (jl_is_gensym(v)) ? v : (jl_value_t*)jl_decl_var(v);
}
jl_value_t *ret = jl_interpret_toplevel_thunk_with(li, ar, na);
JL_GC_POP();
return ret;
}
}
}
jl_function_t *f = (jl_function_t*)eval(args[0], locals, nl, ngensym);
if (jl_is_func(f))
return do_call(f, &args[1], nargs-1, NULL, locals, nl, ngensym);
else
return do_call(jl_module_call_func(jl_current_module), args, nargs, (jl_value_t*)f, locals, nl, ngensym);
}
else if (ex->head == assign_sym) {
jl_value_t *sym = args[0];
jl_value_t *rhs = eval(args[1], locals, nl, ngensym);
if (jl_is_gensym(sym)) {
ssize_t genid = ((jl_gensym_t*)sym)->id;
if (genid >= ngensym || genid < 0)
jl_error("assignment to invalid GenSym location");
locals[nl*2 + genid] = rhs;
return rhs;
}
if (jl_is_symbol(sym)) {
size_t i;
for (i=0; i < nl; i++) {
if (locals[i*2] == sym) {
locals[i*2+1] = rhs;
return rhs;
}
}
}
jl_module_t *m = jl_current_module;
if (jl_is_globalref(sym)) {
m = jl_globalref_mod(sym);
sym = (jl_value_t*)jl_globalref_name(sym);
}
assert(jl_is_symbol(sym));
JL_GC_PUSH1(&rhs);
jl_binding_t *b = jl_get_binding_wr(m, (jl_sym_t*)sym);
jl_checked_assignment(b, rhs);
JL_GC_POP();
return rhs;
}
else if (ex->head == new_sym) {
jl_value_t *thetype = eval(args[0], locals, nl, ngensym);
jl_value_t *v=NULL;
JL_GC_PUSH2(&thetype, &v);
assert(jl_is_structtype(thetype));
v = jl_new_struct_uninit((jl_datatype_t*)thetype);
for(size_t i=1; i < nargs; i++) {
jl_set_nth_field(v, i-1, eval(args[i], locals, nl, ngensym));
}
JL_GC_POP();
return v;
}
else if (ex->head == null_sym) {
return (jl_value_t*)jl_nothing;
}
else if (ex->head == body_sym) {
return eval_body(ex->args, locals, nl, ngensym, 0, 0);
}
else if (ex->head == exc_sym) {
return jl_exception_in_transit;
}
else if (ex->head == static_typeof_sym) {
return (jl_value_t*)jl_any_type;
}
else if (ex->head == method_sym) {
jl_sym_t *fname = (jl_sym_t*)args[0];
jl_value_t **bp=NULL;
jl_value_t *bp_owner=NULL;
jl_binding_t *b=NULL;
jl_value_t *gf=NULL;
int kw=0;
if (jl_is_expr(fname) || jl_is_globalref(fname)) {
if (jl_is_expr(fname) && ((jl_expr_t*)fname)->head == kw_sym) {
kw = 1;
fname = (jl_sym_t*)jl_exprarg(fname, 0);
}
gf = eval((jl_value_t*)fname, locals, nl, ngensym);
if (jl_is_expr(fname))
fname = (jl_sym_t*)jl_fieldref(jl_exprarg(fname, 2), 0);
bp = &gf;
assert(jl_is_symbol(fname));
}
else {
for (size_t i=0; i < nl; i++) {
if (locals[i*2] == (jl_value_t*)fname) {
bp = &locals[i*2+1];
break;
}
}
if (bp == NULL) {
b = jl_get_binding_for_method_def(jl_current_module, fname);
bp = &b->value;
bp_owner = (jl_value_t*)jl_current_module;
}
}
if (jl_expr_nargs(ex) == 1)
return jl_generic_function_def(fname, bp, bp_owner, b);
jl_value_t *atypes=NULL, *meth=NULL;
JL_GC_PUSH2(&atypes, &meth);
atypes = eval(args[1], locals, nl, ngensym);
if (jl_is_lambda_info(args[2])) {
jl_check_static_parameter_conflicts((jl_lambda_info_t*)args[2], (jl_svec_t*)jl_svecref(atypes,1), fname);
}
meth = eval(args[2], locals, nl, ngensym);
jl_method_def(fname, bp, bp_owner, b, (jl_svec_t*)atypes, (jl_function_t*)meth, args[3], NULL, kw);
JL_GC_POP();
return *bp;
}
else if (ex->head == copyast_sym) {
return jl_copy_ast(eval(args[0], locals, nl, ngensym));
}
else if (ex->head == const_sym) {
jl_value_t *sym = args[0];
assert(jl_is_symbol(sym));
for (size_t i=0; i < nl; i++) {
if (locals[i*2] == sym) {
return (jl_value_t*)jl_nothing;
}
}
jl_binding_t *b = jl_get_binding_wr(jl_current_module, (jl_sym_t*)sym);
jl_declare_constant(b);
return (jl_value_t*)jl_nothing;
}
else if (ex->head == global_sym) {
// create uninitialized mutable binding for "global x" decl
// TODO: handle type decls
for (size_t i=0; i < jl_array_len(ex->args); i++) {
assert(jl_is_symbol(args[i]));
jl_get_binding_wr(jl_current_module, (jl_sym_t*)args[i]);
}
return (jl_value_t*)jl_nothing;
}
else if (ex->head == abstracttype_sym) {
jl_value_t *name = args[0];
jl_value_t *para = eval(args[1], locals, nl, ngensym);
jl_value_t *super = NULL;
jl_value_t *temp = NULL;
jl_datatype_t *dt = NULL;
JL_GC_PUSH4(¶, &super, &temp, &dt);
assert(jl_is_svec(para));
assert(jl_is_symbol(name));
dt = jl_new_abstracttype(name, jl_any_type, (jl_svec_t*)para);
jl_binding_t *b = jl_get_binding_wr(jl_current_module, (jl_sym_t*)name);
temp = b->value;
check_can_assign_type(b);
b->value = (jl_value_t*)dt;
jl_gc_wb_binding(b, dt);
super = eval(args[2], locals, nl, ngensym);
jl_set_datatype_super(dt, super);
b->value = temp;
if (temp==NULL || !equiv_type(dt, (jl_datatype_t*)temp)) {
jl_checked_assignment(b, (jl_value_t*)dt);
}
JL_GC_POP();
return (jl_value_t*)jl_nothing;
}
else if (ex->head == bitstype_sym) {
jl_value_t *name = args[0];
jl_value_t *super = NULL, *para = NULL, *vnb = NULL, *temp = NULL;
jl_datatype_t *dt = NULL;
JL_GC_PUSH4(¶, &super, &temp, &dt);
assert(jl_is_symbol(name));
para = eval(args[1], locals, nl, ngensym);
assert(jl_is_svec(para));
vnb = eval(args[2], locals, nl, ngensym);
if (!jl_is_long(vnb))
jl_errorf("invalid declaration of bits type %s", ((jl_sym_t*)name)->name);
ssize_t nb = jl_unbox_long(vnb);
if (nb < 1 || nb>=(1<<23) || (nb&7) != 0)
jl_errorf("invalid number of bits in type %s",
((jl_sym_t*)name)->name);
dt = jl_new_bitstype(name, jl_any_type, (jl_svec_t*)para, nb);
jl_binding_t *b = jl_get_binding_wr(jl_current_module, (jl_sym_t*)name);
temp = b->value;
check_can_assign_type(b);
b->value = (jl_value_t*)dt;
jl_gc_wb_binding(b, dt);
super = eval(args[3], locals, nl, ngensym);
jl_set_datatype_super(dt, super);
b->value = temp;
if (temp==NULL || !equiv_type(dt, (jl_datatype_t*)temp)) {
jl_checked_assignment(b, (jl_value_t*)dt);
}
JL_GC_POP();
return (jl_value_t*)jl_nothing;
}
else if (ex->head == compositetype_sym) {
jl_value_t *name = args[0];
assert(jl_is_symbol(name));
jl_value_t *para = eval(args[1], locals, nl, ngensym);
assert(jl_is_svec(para));
jl_value_t *temp = NULL;
jl_value_t *super = NULL;
jl_datatype_t *dt = NULL;
JL_GC_PUSH4(¶, &super, &temp, &dt);
temp = eval(args[2], locals, nl, ngensym); // field names
dt = jl_new_datatype((jl_sym_t*)name, jl_any_type, (jl_svec_t*)para,
(jl_svec_t*)temp, NULL,
0, args[5]==jl_true ? 1 : 0, jl_unbox_long(args[6]));
jl_binding_t *b = jl_get_binding_wr(jl_current_module, (jl_sym_t*)name);
temp = b->value; // save old value
// temporarily assign so binding is available for field types
check_can_assign_type(b);
b->value = (jl_value_t*)dt;
jl_gc_wb_binding(b,dt);
JL_TRY {
// operations that can fail
inside_typedef = 1;
dt->types = (jl_svec_t*)eval(args[4], locals, nl, ngensym);
jl_gc_wb(dt, dt->types);
inside_typedef = 0;
for(size_t i=0; i < jl_svec_len(dt->types); i++) {
jl_value_t *elt = jl_svecref(dt->types, i);
if (!jl_is_type(elt) && !jl_is_typevar(elt))
jl_type_error_rt(dt->name->name->name, "type definition", (jl_value_t*)jl_type_type, elt);
}
super = eval(args[3], locals, nl, ngensym);
jl_set_datatype_super(dt, super);
}
JL_CATCH {
b->value = temp;
jl_rethrow();
}
for(size_t i=0; i < jl_svec_len(para); i++) {
((jl_tvar_t*)jl_svecref(para,i))->bound = 0;
}
jl_compute_field_offsets(dt);
if (para == (jl_value_t*)jl_emptysvec && jl_is_datatype_singleton(dt)) {
dt->instance = newstruct(dt);
jl_gc_wb(dt, dt->instance);
}
b->value = temp;
if (temp==NULL || !equiv_type(dt, (jl_datatype_t*)temp)) {
jl_checked_assignment(b, (jl_value_t*)dt);
}
else {
// TODO: remove all old ctors and set temp->name->ctor_factory = dt->name->ctor_factory
}
JL_GC_POP();
return (jl_value_t*)jl_nothing;
}
static jl_value_t *eval(jl_value_t *e, interpreter_state *s)
{
jl_ptls_t ptls = jl_get_ptls_states();
jl_code_info_t *src = s==NULL ? NULL : s->src;
if (jl_is_ssavalue(e)) {
ssize_t id = ((jl_ssavalue_t*)e)->id;
if (id >= jl_source_nssavalues(src) || id < 0 || s->locals == NULL)
jl_error("access to invalid SSAValue");
else
return s->locals[jl_source_nslots(src) + id];
}
if (jl_is_slot(e)) {
ssize_t n = jl_slot_number(e);
if (n > jl_source_nslots(src) || n < 1 || s->locals == NULL)
jl_error("access to invalid slot number");
jl_value_t *v = s->locals[n-1];
if (v == NULL)
jl_undefined_var_error((jl_sym_t*)jl_array_ptr_ref(src->slotnames, n - 1));
return v;
}
if (jl_is_globalref(e)) {
jl_sym_t *s = jl_globalref_name(e);
jl_value_t *v = jl_get_global(jl_globalref_mod(e), s);
if (v == NULL)
jl_undefined_var_error(s);
return v;
}
if (jl_is_quotenode(e))
return jl_fieldref(e,0);
jl_module_t *modu = (s == NULL ? ptls->current_module : s->module);
if (jl_is_symbol(e)) { // bare symbols appear in toplevel exprs not wrapped in `thunk`
jl_value_t *v = jl_get_global(modu, (jl_sym_t*)e);
if (v == NULL)
jl_undefined_var_error((jl_sym_t*)e);
return v;
}
if (!jl_is_expr(e))
return e;
jl_expr_t *ex = (jl_expr_t*)e;
jl_value_t **args = (jl_value_t**)jl_array_data(ex->args);
size_t nargs = jl_array_len(ex->args);
if (ex->head == call_sym) {
return do_call(args, nargs, s);
}
else if (ex->head == invoke_sym) {
return do_invoke(args, nargs, s);
}
else if (ex->head == new_sym) {
jl_value_t *thetype = eval(args[0], s);
jl_value_t *v=NULL;
JL_GC_PUSH2(&thetype, &v);
assert(jl_is_structtype(thetype));
v = jl_new_struct_uninit((jl_datatype_t*)thetype);
for(size_t i=1; i < nargs; i++) {
jl_set_nth_field(v, i-1, eval(args[i], s));
}
JL_GC_POP();
return v;
}
else if (ex->head == static_parameter_sym) {
ssize_t n = jl_unbox_long(args[0]);
assert(n > 0);
if (s->sparam_vals && n <= jl_svec_len(s->sparam_vals)) {
jl_value_t *sp = jl_svecref(s->sparam_vals, n - 1);
if (!jl_is_typevar(sp))
return sp;
}
// static parameter val unknown needs to be an error for ccall
jl_error("could not determine static parameter value");
}
else if (ex->head == inert_sym) {
return args[0];
}
else if (ex->head == copyast_sym) {
return jl_copy_ast(eval(args[0], s));
}
else if (ex->head == exc_sym) {
return ptls->exception_in_transit;
}
else if (ex->head == method_sym) {
jl_sym_t *fname = (jl_sym_t*)args[0];
if (jl_is_globalref(fname)) {
modu = jl_globalref_mod(fname);
fname = jl_globalref_name(fname);
}
assert(jl_expr_nargs(ex) != 1 || jl_is_symbol(fname));
if (jl_is_symbol(fname)) {
jl_value_t **bp=NULL;
jl_value_t *bp_owner=NULL;
jl_binding_t *b=NULL;
if (bp == NULL) {
b = jl_get_binding_for_method_def(modu, fname);
bp = &b->value;
bp_owner = (jl_value_t*)modu;
}
jl_value_t *gf = jl_generic_function_def(fname, bp, bp_owner, b);
if (jl_expr_nargs(ex) == 1)
return gf;
}
jl_value_t *atypes=NULL, *meth=NULL;
JL_GC_PUSH2(&atypes, &meth);
atypes = eval(args[1], s);
meth = eval(args[2], s);
jl_method_def((jl_svec_t*)atypes, (jl_code_info_t*)meth, args[3]);
JL_GC_POP();
return jl_nothing;
}
else if (ex->head == const_sym) {
jl_sym_t *sym = (jl_sym_t*)args[0];
if (jl_is_globalref(sym)) {
modu = jl_globalref_mod(sym);
sym = jl_globalref_name(sym);
}
assert(jl_is_symbol(sym));
jl_binding_t *b = jl_get_binding_wr(modu, sym);
jl_declare_constant(b);
return (jl_value_t*)jl_nothing;
}
else if (ex->head == global_sym) {
// create uninitialized mutable binding for "global x" decl
// TODO: handle type decls
size_t i, l = jl_array_len(ex->args);
for (i = 0; i < l; i++) {
jl_sym_t *gsym = (jl_sym_t*)args[i];
jl_module_t *gmodu = modu;
if (jl_is_globalref(gsym)) {
gmodu = jl_globalref_mod(gsym);
gsym = jl_globalref_name(gsym);
}
assert(jl_is_symbol(gsym));
jl_get_binding_wr(gmodu, gsym);
}
return (jl_value_t*)jl_nothing;
}
else if (ex->head == abstracttype_sym) {
if (inside_typedef)
jl_error("cannot eval a new abstract type definition while defining another type");
jl_value_t *name = args[0];
jl_value_t *para = eval(args[1], s);
jl_value_t *super = NULL;
jl_value_t *temp = NULL;
jl_datatype_t *dt = NULL;
JL_GC_PUSH4(¶, &super, &temp, &dt);
assert(jl_is_svec(para));
if (jl_is_globalref(name)) {
modu = jl_globalref_mod(name);
name = (jl_value_t*)jl_globalref_name(name);
}
assert(jl_is_symbol(name));
dt = jl_new_abstracttype(name, NULL, (jl_svec_t*)para);
jl_binding_t *b = jl_get_binding_wr(modu, (jl_sym_t*)name);
temp = b->value;
check_can_assign_type(b);
b->value = (jl_value_t*)dt;
jl_gc_wb_binding(b, dt);
JL_TRY {
inside_typedef = 1;
super = eval(args[2], s);
jl_set_datatype_super(dt, super);
jl_reinstantiate_inner_types(dt);
}
JL_CATCH {
jl_reset_instantiate_inner_types(dt);
b->value = temp;
jl_rethrow();
}
b->value = temp;
if (temp == NULL || !equiv_type(dt, (jl_datatype_t*)temp)) {
jl_checked_assignment(b, (jl_value_t*)dt);
}
JL_GC_POP();
return (jl_value_t*)jl_nothing;
}
else if (ex->head == bitstype_sym) {
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;
}
