SEXP jr_dict(jl_value_t *tt)
{
SEXP ans = R_NilValue;
SEXP rnames;
jl_function_t *str = jl_get_function(jl_base_module, "string");
jl_function_t *getindex = jl_get_function(jl_base_module, "getindex");
jl_array_t *keys = (jl_array_t *) jl_call1(
jl_get_function(jl_base_module, "collect"),
jl_call1(jl_get_function(jl_base_module, "keys"), tt)
);
size_t m = jl_array_len(keys);
PROTECT(rnames = Rf_allocVector(STRSXP, m));
PROTECT(ans = Rf_allocVector(VECSXP, m));
jl_value_t *key, *value;
for(size_t i=0; i<m; i++)
{
key = jl_arrayref(keys, i);
value = jl_call2(getindex, tt, key);
SET_VECTOR_ELT(ans, i, jr_cast(value));
key = jl_call1(str, key);
SET_STRING_ELT(rnames, i, Rf_mkChar(jl_string_data(key)));
}
Rf_setAttrib(ans, R_NamesSymbol, rnames);
UNPROTECT(2);
return ans;
}
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;
}
SqwJl::SqwJl(const char* pcFile) : m_pmtx(std::make_shared<std::mutex>())
{
std::string strFile = pcFile;
std::string strDir = tl::get_dir(strFile);
const bool bSetScriptCWD = 1;
// init interpreter
static bool bInited = 0;
if(!bInited)
{
jl_init(0);
std::string strJl = jl_ver_string();
tl::log_debug("Initialised Julia interpreter version ", strJl, ".");
bInited = 1;
}
// include module
jl_function_t *pInc = jl_get_function(jl_base_module, "include");
jl_value_t *pMod = jl_cstr_to_string(pcFile);
jl_call1(pInc, pMod);
// working dir
if(bSetScriptCWD)
{
jl_function_t *pCwd = jl_get_function(jl_base_module, "cd");
jl_value_t *pDir = jl_cstr_to_string(strDir.c_str());
jl_call1(pCwd, pDir);
}
// import takin functions
m_pInit = jl_get_function(jl_main_module, "TakinInit");
m_pSqw = jl_get_function(jl_main_module, "TakinSqw");
if(!m_pSqw)
{
m_bOk = 0;
tl::log_err("Julia script has no TakinSqw function.");
return;
}
else
{
m_bOk = 1;
}
if(m_pInit)
jl_call0((jl_function_t*)m_pInit);
else
tl::log_warn("Julia script has no TakinInit function.");
}
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;
}
SEXP jr_data_array(jl_value_t *tt) {
SEXP ans = R_NilValue;
jl_function_t *func = jl_get_function(jl_base_module, "getindex");
jl_value_t *u = jl_get_nth_field(tt, 0);
jl_value_t *v = jl_get_nth_field(tt, 1);
JL_GC_PUSH2(&u, &v);
size_t len = jl_array_len(u);
ans = jr_array(u);
int ty = TYPEOF(ans);
for(size_t i=0; i<len; i++){
if (jl_unbox_bool(jl_call2(func, v, jl_box_long(i+1)))){
switch(ty) {
case LGLSXP:
LOGICAL(ans)[i] = NA_LOGICAL;
break;
case INTSXP:
INTEGER(ans)[i] = NA_INTEGER;
break;
case REALSXP:
REAL(ans)[i] = NA_REAL;
break;
case STRSXP:
SET_STRING_ELT(ans, i, NA_STRING);
break;
default:
LOGICAL(ans)[i] = NA_LOGICAL;
}
}
}
JL_GC_POP();
return ans;
}
JuliaFunction::JuliaFunction(const std::string& name, const std::string& module_name)
{
jl_module_t* mod = module_name.empty() ? jl_current_module : (jl_module_t*)jl_get_global(jl_current_module, jl_symbol(module_name.c_str()));
if(mod == nullptr)
{
throw std::runtime_error("Could not find module " + module_name + " when looking up function " + module_name);
}
m_function = jl_get_function(mod, name.c_str());
if(m_function == nullptr)
{
throw std::runtime_error("Could not find function " + name);
}
}
CXX_WRAP_EXPORT jl_function_t* julia_function(const std::string& name, const std::string& module_name)
{
jl_module_t* mod = module_name.empty() ? jl_current_module : (jl_module_t*)jl_get_global(jl_current_module, jl_symbol(module_name.c_str()));
if(mod == nullptr)
{
throw std::runtime_error("Could not find module " + module_name + " when looking up function " + module_name);
}
jl_function_t* f = jl_get_function(mod, name.c_str());
if(f == nullptr)
{
throw std::runtime_error("Could not find function " + name);
}
return f;
}
void td_jl_invoke1(td_val_t *out, char *fname, td_val_t *arg)
{
jl_function_t *f = jl_get_function(jl_base_module, fname);
jl_value_t *v = jl_call1(f, from_td_val(arg));
to_td_val(out, v);
}
void td_jl_invoke0(td_val_t *out, char *fname)
{
jl_function_t *f = jl_get_function(jl_base_module, fname);
jl_value_t *v = jl_call0(f);
to_td_val(out, v);
}
int main()
{
jl_init(NULL);
{
// Simple running Julia code
jl_eval_string("println(sqrt(2.0))");
}
{
// Accessing the return value
jl_value_t *ret = jl_eval_string("sqrt(2.0)");
if (jl_is_float64(ret)) {
double retDouble = jl_unbox_float64(ret);
printf("sqrt(2.0) in C: %e\n", retDouble);
}
}
{
// Same as above but with function handle (more flexible)
jl_function_t *func = jl_get_function(jl_base_module, "sqrt");
jl_value_t* argument = jl_box_float64(2.0);
jl_value_t* ret = jl_call1(func, argument);
if (jl_is_float64(ret)) {
double retDouble = jl_unbox_float64(ret);
printf("sqrt(2.0) in C: %e\n", retDouble);
}
}
{
// 1D arrays
jl_value_t* array_type = jl_apply_array_type( jl_float64_type, 1 );
jl_array_t* x = jl_alloc_array_1d(array_type , 10);
JL_GC_PUSH1(&x);
double* xData = jl_array_data(x);
size_t i;
for(i=0; i<jl_array_len(x); i++)
xData[i] = i;
jl_function_t *func = jl_get_function(jl_base_module, "reverse!");
jl_call1(func, (jl_value_t*) x);
printf("x = [");
for(i=0; i<jl_array_len(x); i++)
printf("%e ", xData[i]);
printf("]\n");
JL_GC_POP();
}
{
// define julia function and call it
jl_eval_string("my_func(x) = 2*x");
jl_function_t *func = jl_get_function(jl_current_module, "my_func");
jl_value_t* arg = jl_box_float64(5.0);
double ret = jl_unbox_float64(jl_call1(func, arg));
printf("my_func(5.0) = %f\n", ret);
}
{
// call c function
jl_eval_string("println( ccall( :my_c_sqrt, Float64, (Float64,), 2.0 ) )");
}
{
// check for exceptions
jl_eval_string("this_function_does_not_exist()");
if (jl_exception_occurred()) {
jl_show(jl_stderr_obj(), jl_exception_occurred());
jl_printf(jl_stderr_stream(), "\n");
}
}
jl_atexit_hook();
return 0;
}
SEXP jr_range(jl_value_t *tt) {
SEXP ans = R_NilValue;
jl_value_t *ret = jl_call1(jl_get_function(jl_base_module, "vcat"), tt);
ans = jr_array(ret);
return ans;
}
