static bool jl_is_PooledDataArray(jl_value_t *Var)
{
if (strcmp(jl_typeof_str(Var), "PooledDataArray") == 0 ||
strcmp(jl_typeof_str(Var), "PooledDataVector") == 0 ||
strcmp(jl_typeof_str(Var), "PooledDataMatrix") == 0)
return true;
else
return false;
}
static bool jl_is_DataFrame(jl_value_t *Var)
{
if (strcmp(jl_typeof_str(Var), "DataFrame") == 0)
return true;
else
return false;
}
static bool jl_is_NAtype(jl_value_t *Var)
{
if (strcmp(jl_typeof_str(Var), "NAtype") == 0)
return true;
else
return false;
}
int square(double a[],double b[])
{
// Init Julia
jl_init_with_image("/Users/fgans/julia/julia-4d1b751dda/lib/julia", "sys.ji");
JL_SET_STACK_BASE;
// Define Array Type for 1D Array
jl_value_t* array_type = jl_apply_array_type(jl_float64_type, 1);
// Connect C-Arrays to julia Arrays
jl_array_t *a_jl = jl_ptr_to_array_1d(array_type, a, 1, 0);
jl_array_t *b_jl = jl_ptr_to_array_1d(array_type, b, 1, 0);
// Load julia code
jl_eval_string("include(\"square.jl\")");
// Get function
jl_function_t *func = jl_get_function(jl_main_module, "square");
if (func==NULL) {
printf("Function not found!\n");
return -1;
}
// Apply function
jl_call2(func, (jl_value_t*)a_jl,(jl_value_t*)b_jl);
if (jl_exception_occurred()) printf("%s \n", jl_typeof_str(jl_exception_occurred()));
return 0;
}
std::vector<SqwBase::t_var> SqwJl::GetVars() const
{
std::vector<SqwBase::t_var> vecVars;
if(!m_bOk)
{
tl::log_err("Julia interpreter has not initialised, cannot get variables.");
return vecVars;
}
jl_function_t *pNames = jl_get_function(jl_base_module, "names");
jl_function_t *pGetField = jl_get_function(jl_base_module, "getfield");
jl_function_t *pPrint = jl_get_function(jl_base_module, "string");
if(!pNames || !pGetField || !pPrint)
{
tl::log_err("Required Julia functions not available.");
return vecVars;
}
jl_array_t* pArrNames = (jl_array_t*)jl_call1(pNames, (jl_value_t*)jl_main_module);
if(!pArrNames)
return vecVars;
std::size_t iSyms = jl_array_len(pArrNames);
for(std::size_t iSym=0; iSym<iSyms; ++iSym)
{
jl_sym_t* pSym = (jl_sym_t*)jl_array_ptr_ref(pArrNames, iSym);
if(!pSym) continue;
// name
std::string strName = jl_symbol_name(pSym);
if(strName.length() == 0) continue;
// type
jl_value_t* pFld = jl_call2(pGetField, (jl_value_t*)jl_main_module, (jl_value_t*)pSym);
if(!pFld) continue;
std::string strType = jl_typeof_str(pFld);
if(strType.length() == 0) continue;
if(strType[0] == '#' || strType == "Module") continue; // filter funcs and mods
// value
jl_value_t* pFldPr = jl_call1(pPrint, pFld);
if(!pFldPr) continue;
std::string strValue = jl_string_ptr(pFldPr);
SqwBase::t_var var;
std::get<0>(var) = std::move(strName);
std::get<1>(var) = std::move(strType);
std::get<2>(var) = std::move(strValue);
vecVars.push_back(var);
}
return vecVars;
}
SEXP jl_value_type(jl_value_t *res) {
char *resTy,*aryTy;
SEXP resR;
if(res!=NULL) { //=> get a result
resTy=(char*)jl_typeof_str(res);
PROTECT(resR=NEW_CHARACTER(1));
CHARACTER_POINTER(resR)[0]=mkChar(resTy);
UNPROTECT(1);
return resR;
} return R_NilValue;
}
//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;
}
