//Maybe try to use cpp stuff to get the output inside julia system (ccall,cgen and cgutils)
//-| TODO: after adding in the jlapi.c jl_is_<C_type> functions replace the strcmp!
SEXP jl_value_to_SEXP(jl_value_t *res) {
size_t i=0,nd,d;
SEXP resR;
SEXPTYPE aryTyR;
jl_value_t *tmp;
char *resTy, *aryTy, *aryTy2;
if(res!=NULL) { //=> get a result
resTy=(char*)jl_typeof_str(res);
//DANGEROUS?? printf("typeof=%s\n",jl_typeof_str(res));
if(strcmp(jl_typeof_str(res),"Int64")==0 || strcmp(jl_typeof_str(res),"Int32")==0)
//if(jl_is_long(res)) //does not work because of DLLEXPORT
{
//printf("elt=%d\n",jl_unbox_long(res));
PROTECT(resR=NEW_INTEGER(1));
INTEGER_POINTER(resR)[0]=jl_unbox_long(res);
UNPROTECT(1);
return resR;
}
else
if(strcmp(resTy,"Float64")==0)
//if(jl_is_float64(res))
{
PROTECT(resR=NEW_NUMERIC(1));
NUMERIC_POINTER(resR)[0]=jl_unbox_float64(res);
UNPROTECT(1);
return resR;
}
else
if(strcmp(resTy,"Float32")==0)
//if(jl_is_float64(res))
{
PROTECT(resR=NEW_NUMERIC(1));
NUMERIC_POINTER(resR)[0]=jl_unbox_float32(res);
UNPROTECT(1);
return resR;
}
else
if(strcmp(resTy,"Bool")==0)
//if(jl_is_bool(res))
{
PROTECT(resR=NEW_LOGICAL(1));
LOGICAL(resR)[0]=(jl_unbox_bool(res) ? TRUE : FALSE);
UNPROTECT(1);
return resR;
}
else
if(strcmp(resTy,"DataType")==0)
//if(jl_is_bool(res))
{
PROTECT(resR=NEW_CHARACTER(1));
CHARACTER_POINTER(resR)[0]=mkChar(jl_typename_str(res));
UNPROTECT(1);
return resR;
}
else
if(strcmp(resTy,"Nothing")==0)
//if(jl_is_bool(res))
{
return R_NilValue;
}
else
if(strcmp(resTy,"Complex")==0)
//if(jl_is_bool(res))
{
tmp=(jl_value_t*)jl_get_field(res, "re");
PROTECT(resR=NEW_COMPLEX(1));
if(strcmp(jl_typeof_str(tmp),"Float64")==0) {
COMPLEX(resR)[0].r=jl_unbox_float64(tmp);
COMPLEX(resR)[0].i=jl_unbox_float64(jl_get_field(res, "im"));
} else if(strcmp(jl_typeof_str(tmp),"Int64")==0) {
COMPLEX(resR)[0].r=jl_unbox_long(tmp);
COMPLEX(resR)[0].i=jl_unbox_long(jl_get_field(res, "im"));
}
UNPROTECT(1);
return resR;
}
else
if(strcmp(resTy,"Regex")==0)
//if(jl_is_bool(res))
{
// call=(jl_function_t*)jl_get_global(jl_base_module, jl_symbol("show"));
// printf("ici\n");
// if (call) tmp=jl_call1(call,res);
// else printf("call failed!\n");
// printf("ici\n");
// resR = jl_value_to_VALUE(jl_get_field(res, "pattern"));
// return resR;
}
else
if(strcmp(resTy,"ASCIIString")==0 || strcmp(resTy,"UTF8String")==0)
{
PROTECT(resR=NEW_CHARACTER(1));
CHARACTER_POINTER(resR)[0]=mkChar(jl_bytestring_ptr(res));
UNPROTECT(1);
return resR;
}
else
if(strcmp(jl_typeof_str(res),"Tuple")==0 )
//if(jl_is_array(res))
{
d=jl_nfields(res); //BEFORE 0.3: d=jl_tuple_len(res);
PROTECT(resR=allocVector(VECSXP,d));
for(i=0;i<d;i++) {
//BEFORE 0.3: SET_ELEMENT(resR,i,jl_value_to_SEXP(jl_tupleref(res,i)));
SET_ELEMENT(resR,i,jl_value_to_SEXP(jl_fieldref(res,i)));
}
UNPROTECT(1);
return resR;
}
if(strcmp(resTy,"Array")==0)
//if(jl_is_array(res))
{
nd = jl_array_rank(res);
//Rprintf("array_ndims=%d\n",(int)nd);
aryTy=(char*)jl_typename_str(jl_array_eltype(res));
aryTy2=(char*)jl_typeof_str(jl_array_eltype(res));
//Rprintf("type elt=%s,%s\n",aryTy,(char*)jl_typeof_str(jl_array_eltype(res)));
if(strcmp(aryTy2,"DataType")!=0) return R_NilValue;
if(strcmp(aryTy,"ASCIIString")==0 || strcmp(aryTy,"UTF8String")==0) aryTyR=STRSXP;
else if(strcmp(aryTy,"Int64")==0 || strcmp(aryTy,"Int32")==0) aryTyR=INTSXP;
else if(strcmp(aryTy,"Bool")==0) aryTyR=LGLSXP;
else if(strcmp(aryTy,"Complex")==0) aryTyR=CPLXSXP;
else if(strcmp(aryTy,"Float64")==0 || strcmp(aryTy,"Float32")==0) aryTyR=REALSXP;
else aryTyR=VECSXP;
if(nd==1) {//Vector
d = jl_array_size(res, 0);
//Rprintf("array_dim[1]=%d\n",(int)d);
PROTECT(resR=allocVector(aryTyR,d));
for(i=0;i<d;i++) {
switch(aryTyR) {
case STRSXP:
SET_STRING_ELT(resR,i,mkChar(jl_bytestring_ptr(jl_arrayref((jl_array_t *)res,i))));
break;
case INTSXP:
INTEGER(resR)[i]=jl_unbox_long(jl_arrayref((jl_array_t *)res,i));
break;
case LGLSXP:
LOGICAL(resR)[i]=(jl_unbox_bool(jl_arrayref((jl_array_t *)res,i)) ? TRUE : FALSE);
break;
case REALSXP:
REAL(resR)[i]=jl_unbox_float64(jl_arrayref((jl_array_t *)res,i));
break;
case CPLXSXP:
tmp=(jl_value_t*)jl_get_field(jl_arrayref((jl_array_t *)res,i), "re");
if(strcmp(jl_typeof_str(tmp),"Float64")==0) {
COMPLEX(resR)[i].r=jl_unbox_float64(tmp);
COMPLEX(resR)[i].i=jl_unbox_float64(jl_get_field(jl_arrayref((jl_array_t *)res,i), "im"));
} else if(strcmp(jl_typeof_str(tmp),"Int64")==0) {
COMPLEX(resR)[i].r=jl_unbox_long(tmp);
COMPLEX(resR)[i].i=jl_unbox_long(jl_get_field(jl_arrayref((jl_array_t *)res,i), "im"));
}
break;
case VECSXP:
SET_ELEMENT(resR,i,jl_value_to_SEXP(jl_arrayref((jl_array_t *)res,i)));
}
}
UNPROTECT(1);
return resR;
}
//TODO: multidim array ruby equivalent???? Is it necessary
}
return R_NilValue;
/*PROTECT(resR=NEW_CHARACTER(1));
CHARACTER_POINTER(resR)[0]=mkChar(jl_typeof_str(res));
// resR=rb_str_new2("__unconverted(");
// rb_str_cat2(resR, jl_typeof_str(res));
// rb_str_cat2(resR, ")__\n");
UNPROTECT(1);
//printf("%s\n",jl_bytestring_ptr(jl_eval_string("\"$(ans)\"")));
return resR;*/
}
//=> No result (command incomplete or syntax error)
// jlapi_print_stderr(); //If this happens but this is really not sure!
// resR=rb_str_new2("__incomplete");
// if(jl_exception_occurred()!=NULL) {
// rb_str_cat2(resR, "(");
// rb_str_cat2(resR,jl_typeof_str(jl_exception_occurred()));
// jl_value_t* err=jl_get_field(jl_exception_occurred(),"msg");
// if(err!=NULL) printf("%s: %s\n",jl_typeof_str(jl_exception_occurred()),jl_bytestring_ptr(err));
// jl_exception_clear();
// rb_str_cat2(resR, ")");
// }
// rb_str_cat2(resR, "__");
return R_NilValue;//resR;
}
// 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;
}
