JL_DLLEXPORT jl_module_t *jl_new_main_module(void)
{
jl_ptls_t ptls = jl_get_ptls_states();
if (jl_generating_output() && jl_options.incremental)
jl_error("cannot call workspace() in incremental compile mode");
// switch to a new top-level module
if (ptls->current_module != jl_main_module &&
ptls->current_module != NULL && jl_main_module != NULL)
jl_error("Main can only be replaced from the top level");
jl_module_t *old_main = jl_main_module;
jl_main_module = jl_new_module(jl_symbol("Main"));
jl_main_module->parent = jl_main_module;
if (old_main) { // don't block continued loading of incremental caches
jl_main_module->primary_world = old_main->primary_world;
jl_main_module->build_id = old_main->build_id;
jl_main_module->uuid = old_main->uuid;
}
ptls->current_module = jl_main_module;
jl_core_module->parent = jl_main_module;
jl_set_const(jl_main_module, jl_symbol("Core"),
(jl_value_t*)jl_core_module);
jl_set_global(jl_core_module, jl_symbol("Main"),
(jl_value_t*)jl_main_module);
ptls->current_task->current_module = jl_main_module;
return old_main;
}
static SEXP Julia_R_MD_NA_DataFrame(jl_value_t *Var)
{
SEXP ans, names, rownames;
char evalcmd[evalsize];
int i;
const char *dfname = "DataFrameName0tmp";
jl_set_global(jl_main_module, jl_symbol(dfname), (jl_value_t *)Var);
//Get Frame cols
snprintf(evalcmd, evalsize, "size(%s,2)", dfname);
jl_value_t *cols = jl_eval_string(evalcmd);
int collen = jl_unbox_long(cols);
jl_value_t *eachcolvector;
jl_value_t *coltype;
//Create VECSXP
//Create SEXP for Each Column and assign
PROTECT(ans = allocVector(VECSXP, collen));
for (i = 0; i < collen; i++)
{
snprintf(evalcmd, evalsize, "%s[%d]", dfname, i + 1);
eachcolvector = jl_eval_string(evalcmd);
snprintf(evalcmd, evalsize, "isa(%s[%d],PooledDataArray)", dfname, i + 1);
coltype = jl_eval_string(evalcmd);
if (jl_unbox_bool(coltype))
SET_VECTOR_ELT(ans, i, Julia_R_MD_NA_Factor(eachcolvector));
else
SET_VECTOR_ELT(ans, i, Julia_R_MD_NA(eachcolvector));
}
//set names attribute
snprintf(evalcmd, evalsize, "names(%s)", dfname);
jl_value_t *ret = jl_eval_string(evalcmd);
jl_value_t *onesymbol;
if (jl_is_array(ret))
{
PROTECT(names = allocVector(STRSXP, collen));
for (i = 0; i < jl_array_len(ret); i++)
{
onesymbol = jl_arrayref((jl_array_t *)ret, i);
if (jl_is_symbol(onesymbol))
SET_STRING_ELT(names, i, mkChar(((jl_sym_t *)onesymbol)->name));
}
setAttrib(ans, R_NamesSymbol, names);
UNPROTECT(1);
}
//set row names
snprintf(evalcmd, evalsize, "size(%s,1)", dfname);
jl_value_t *rows = jl_eval_string(evalcmd);
int rowlen = jl_unbox_long(rows);
PROTECT(rownames = allocVector(INTSXP, rowlen));
for (i = 0; i < rowlen; i++)
INTEGER(rownames)[i] = i + 1;
setAttrib(ans, R_RowNamesSymbol, rownames);
UNPROTECT(1);
//set class as data frame
setAttrib(ans, R_ClassSymbol, mkString("data.frame"));
//SET_OBJECT(ans, 1) ;
UNPROTECT(1);
return ans;
}
jl_module_t *jl_new_main_module(void)
{
if (jl_generating_output() && jl_options.incremental)
jl_error("cannot call workspace() in incremental compile mode");
// switch to a new top-level module
if (jl_current_module != jl_main_module && jl_current_module != NULL)
jl_error("Main can only be replaced from the top level");
jl_module_t *old_main = jl_main_module;
jl_main_module = jl_new_module(jl_symbol("Main"));
jl_main_module->parent = jl_main_module;
if (old_main) // don't block continued loading of incremental caches
jl_main_module->uuid = old_main->uuid;
jl_current_module = jl_main_module;
jl_core_module->parent = jl_main_module;
jl_set_const(jl_main_module, jl_symbol("Core"),
(jl_value_t*)jl_core_module);
jl_set_global(jl_core_module, jl_symbol("Main"),
(jl_value_t*)jl_main_module);
jl_current_task->current_module = jl_main_module;
jl_module_import(jl_main_module, jl_core_module, jl_symbol("eval"));
return old_main;
}
int true_main(int argc, char *argv[])
{
if (lisp_prompt) {
jl_lisp_prompt();
return 0;
}
jl_array_t *args = jl_alloc_cell_1d(argc);
jl_set_global(jl_current_module, jl_symbol("ARGS"), (jl_value_t*)args);
int i;
for (i=0; i < argc; i++) {
jl_arrayset(args, i, (jl_value_t*)jl_cstr_to_string(argv[i]));
}
jl_set_const(jl_current_module, jl_symbol("JULIA_HOME"),
jl_cstr_to_string(julia_home));
// run program if specified, otherwise enter REPL
if (program) {
return exec_program();
}
init_repl_environment();
jl_function_t *start_client =
(jl_function_t*)jl_get_global(jl_base_module, jl_symbol("_start"));
if (start_client) {
jl_apply(start_client, NULL, 0);
return 0;
}
// client event loop not available; use fallback blocking version
int iserr = 0;
again:
;
JL_TRY {
if (iserr) {
jl_show(jl_exception_in_transit);
ios_printf(ios_stdout, "\n\n");
iserr = 0;
}
while (1) {
char *input = read_expr("julia> ");
if (!input || ios_eof(ios_stdin)) {
ios_printf(ios_stdout, "\n");
break;
}
jl_value_t *ast = jl_parse_input_line(input);
jl_value_t *value = jl_toplevel_eval(ast);
jl_show(value);
ios_printf(ios_stdout, "\n\n");
}
}
JL_CATCH {
iserr = 1;
goto again;
}
return 0;
}
//first pass creat array then convert it to DataArray
//second pass assign NA to element
static jl_value_t *TransArrayToDataArray(jl_array_t *mArray, jl_array_t *mboolArray, const char *VarName)
{
char evalcmd[evalsize];
jl_set_global(jl_main_module, jl_symbol("TransVarName"), (jl_value_t *)mArray);
jl_set_global(jl_main_module, jl_symbol("TransVarNamebool"), (jl_value_t *)mboolArray);
snprintf(evalcmd, evalsize, "%s=DataArray(TransVarName,TransVarNamebool)", VarName);
jl_value_t *ret = jl_eval_string(evalcmd);
if (jl_exception_occurred())
{
jl_show(jl_stderr_obj(), jl_exception_occurred());
Rprintf("\n");
jl_exception_clear();
return (jl_value_t *) jl_nothing;
}
return ret;
}
int true_main(int argc, char *argv[])
{
if (lisp_prompt) {
jl_lisp_prompt();
return 0;
}
jl_array_t *args = jl_alloc_cell_1d(argc);
jl_set_global(jl_system_module, jl_symbol("ARGS"), (jl_value_t*)args);
int i;
for (i=0; i < argc; i++) {
jl_arrayset(args, i, (jl_value_t*)jl_cstr_to_string(argv[i]));
}
jl_set_const(jl_system_module, jl_symbol("JULIA_HOME"),
jl_cstr_to_string(julia_home));
// run program if specified, otherwise enter REPL
if (program) {
return exec_program();
}
init_repl_environment();
have_color = detect_color();
char *prompt = have_color ? jl_prompt_color : jl_prompt_plain;
prompt_length = strlen(jl_prompt_plain);
prompt_string = prompt;
jl_function_t *start_client =
(jl_function_t*)
jl_get_global(jl_system_module, jl_symbol("_start"));
if (start_client == NULL) {
repl_print_prompt();
// client event loop not available; use fallback blocking version
int iserr = 0;
again:
;
JL_TRY {
if (iserr) {
if (have_color) {
ios_printf(ios_stdout, jl_color_normal);
}
jl_show(jl_exception_in_transit);
ios_printf(ios_stdout, "\n\n");
iserr = 0;
}
while (1) {
read_expr(prompt);
}
}
JL_CATCH {
iserr = 1;
goto again;
}
}
int true_main(int argc, char *argv[])
{
if (jl_base_module != NULL) {
jl_array_t *args = jl_alloc_cell_1d(argc);
jl_set_global(jl_base_module, jl_symbol("ARGS"), (jl_value_t*)args);
int i;
for (i=0; i < argc; i++) {
jl_arrayset(args, (jl_value_t*)jl_cstr_to_string(argv[i]), i);
}
}
// run program if specified, otherwise enter REPL
if (program) {
int ret = exec_program();
uv_tty_reset_mode();
return ret;
}
jl_function_t *start_client =
(jl_function_t*)jl_get_global(jl_base_module, jl_symbol("_start"));
//uv_read_start(jl_stdin_tty,jl_alloc_read_buffer,&read_buffer);
if (start_client) {
jl_apply(start_client, NULL, 0);
//rl_cleanup_after_signal();
return 0;
}
// client event loop not available; use fallback blocking version
//install_read_event_handler(&echoBack);
int iserr = 0;
again:
;
JL_TRY {
if (iserr) {
//jl_show(jl_exception_in_transit);# What if the error was in show?
jl_printf(JL_STDERR, "\n\n");
iserr = 0;
}
uv_run(jl_global_event_loop(),UV_RUN_DEFAULT);
}
JL_CATCH {
iserr = 1;
JL_PUTS("error during run:\n",JL_STDERR);
jl_show(jl_stderr_obj(),jl_exception_in_transit);
JL_PUTS("\n",JL_STDOUT);
goto again;
}
uv_tty_reset_mode();
return iserr;
}
//basically factor in R is 1-dim INTSXP and contain levels
static jl_value_t *TransArrayToPoolDataArray(jl_array_t *mArray, jl_array_t *mpoolArray, size_t len, const char *VarName)
{
char evalcmd[evalsize];
jl_set_global(jl_main_module, jl_symbol("varpools"), (jl_value_t *)mpoolArray);
jl_set_global(jl_main_module, jl_symbol("varrefs"), (jl_value_t *)mArray);
snprintf(evalcmd, evalsize, "%s=PooledDataArray(ASCIIString,Uint32,%d)", VarName, len);
jl_eval_string(evalcmd);
snprintf(evalcmd, evalsize, "%s.pool=%s", VarName, "varpools");
jl_eval_string(evalcmd);
snprintf(evalcmd, evalsize, "%s.refs=%s", VarName, "varrefs");
jl_eval_string(evalcmd);
jl_value_t *ret = jl_eval_string((char *)VarName);
if (jl_exception_occurred())
{
jl_show(jl_stderr_obj(), jl_exception_occurred());
Rprintf("\n");
jl_exception_clear();
return (jl_value_t *) jl_nothing;
}
return ret;
}
// create a new top-level module
void jl_init_main_module(void)
{
if (jl_main_module != NULL)
jl_error("Main module already initialized.");
jl_main_module = jl_new_module(jl_symbol("Main"));
jl_main_module->parent = jl_main_module;
jl_core_module->parent = jl_main_module;
jl_set_const(jl_main_module, jl_symbol("Core"),
(jl_value_t*)jl_core_module);
jl_set_global(jl_core_module, jl_symbol("Main"),
(jl_value_t*)jl_main_module);
}
DLLEXPORT void jl_eval_user_input(jl_value_t *ast, int show_value)
{
if (jl_have_event_loop) {
// with multi.j loaded the command line input callback can return
// before the command finishes running, so we have to
// disable rl to prevent the prompt from reappearing too soon.
repl_callback_disable();
}
JL_GC_PUSH(&ast);
assert(ast != NULL);
int iserr = 0;
again:
;
JL_TRY {
jl_register_toplevel_eh();
if (have_color) {
ios_printf(ios_stdout, jl_color_normal);
}
if (iserr) {
jl_show(jl_exception_in_transit);
ios_printf(ios_stdout, "\n");
JL_EH_POP();
break; // leave JL_TRY
}
jl_value_t *value = jl_toplevel_eval(ast);
jl_set_global(jl_system_module, jl_symbol("ans"), value);
if (value != (jl_value_t*)jl_nothing && show_value) {
if (have_color) {
ios_printf(ios_stdout, jl_answer_color());
}
repl_show_value(value);
ios_printf(ios_stdout, "\n");
}
}
JL_CATCH {
iserr = 1;
goto again;
}
ios_printf(ios_stdout, "\n");
JL_GC_POP();
repl_callback_enable();
}
jl_module_t *jl_new_main_module(void)
{
// switch to a new top-level module
if (jl_current_module != jl_main_module && jl_current_module != NULL)
jl_error("Main can only be replaced from the top level");
jl_module_t *old_main = jl_main_module;
jl_main_module = jl_new_module(jl_symbol("Main"));
jl_main_module->parent = jl_main_module;
jl_current_module = jl_main_module;
jl_core_module->parent = jl_main_module;
jl_set_const(jl_main_module, jl_symbol("Core"),
(jl_value_t*)jl_core_module);
jl_set_global(jl_core_module, jl_symbol("Main"),
(jl_value_t*)jl_main_module);
jl_current_task->current_module = jl_main_module;
return old_main;
}
static SEXP Julia_R_MD_NA_Factor(jl_value_t *Var)
{
SEXP ans = R_NilValue;
char *strData = "Varname0tmp.refs";
char *strlevels = "VarPools=Array(ASCIIString,length(Varname0tmp.pool))\r\n"
"for i in 1:length(Varname0tmp.pool)\r\n"
"VarPools[i]=string(Varname0tmp.pool[i])\r\n"
"end\r\n"
"VarPools\r\n";
jl_set_global(jl_main_module, jl_symbol("Varname0tmp"), (jl_value_t *)Var);
jl_value_t *retData = jl_eval_string(strData);
jl_value_t *retlevels = jl_eval_string(strlevels);
//first get refs data,dims=n
//caution this convert to int32 SEXP,it should be ok in reality,
//but if have a lot factor may be cause int32 overrun.
ans = Julia_R_MD_INT(retData);
PROTECT(ans);
//second setAttrib R levels and class
SEXP levels = Julia_R_MD(retlevels);
setAttrib(ans, R_LevelsSymbol, levels);
setAttrib(ans, R_ClassSymbol, mkString("factor"));
UNPROTECT(1);
return ans;
}
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 jl_value_t *eval(jl_value_t *e, jl_value_t **locals, size_t nl)
{
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_errorf("%s not defined", ((jl_sym_t*)e)->name);
}
return v;
}
if (jl_is_symbolnode(e)) {
return eval((jl_value_t*)jl_symbolnode_sym(e), locals, nl);
}
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_errorf("%s not defined", s->name);
return v;
}
if (!jl_is_expr(e)) {
if (jl_is_getfieldnode(e)) {
jl_value_t *v = eval(jl_getfieldnode_val(e), locals, nl);
jl_value_t *gfargs[2] = {v, (jl_value_t*)jl_getfieldnode_name(e)};
return jl_f_get_field(NULL, gfargs, 2);
}
if (jl_is_lambda_info(e)) {
return (jl_value_t*)jl_new_closure(NULL, (jl_value_t*)jl_null,
(jl_lambda_info_t*)e);
}
if (jl_is_linenode(e)) {
jl_lineno = jl_linenode_line(e);
}
return e;
}
jl_expr_t *ex = (jl_expr_t*)e;
jl_value_t **args = &jl_cellref(ex->args,0);
size_t nargs = jl_array_len(ex->args);
if (ex->head == call_sym || ex->head == call1_sym) {
jl_function_t *f = (jl_function_t*)eval(args[0], locals, nl);
if (!jl_is_func(f))
jl_type_error("apply", (jl_value_t*)jl_function_type,
(jl_value_t*)f);
return do_call(f, &args[1], nargs-1, locals, nl);
}
else if (ex->head == assign_sym) {
jl_value_t *sym = args[0];
size_t i;
for (i=0; i < nl; i++) {
if (locals[i*2] == sym) {
return (locals[i*2+1] = eval(args[1], locals, nl));
}
}
jl_binding_t *b = jl_get_binding_wr(jl_current_module, (jl_sym_t*)sym);
jl_value_t *rhs = eval(args[1], locals, nl);
jl_checked_assignment(b, rhs);
return rhs;
}
else if (ex->head == new_sym) {
jl_value_t *thetype = eval(args[0], locals, nl);
jl_value_t *v=NULL;
JL_GC_PUSH(&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));
}
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, 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_binding_t *b=NULL;
jl_value_t *gf=NULL;
int kw=0;
if (jl_is_expr(fname)) {
if (((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);
assert(jl_is_function(gf));
assert(jl_is_gf(gf));
if (!kw) {
fname = (jl_sym_t*)jl_fieldref(jl_exprarg(fname, 2), 0);
bp = &gf;
}
else {
bp = (jl_value_t**)&((jl_methtable_t*)((jl_function_t*)gf)->env)->kwsorter;
}
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;
}
}
jl_value_t *atypes=NULL, *meth=NULL, *tvars=NULL;
JL_GC_PUSH(&atypes, &meth, &tvars);
atypes = eval(args[1], locals, nl);
meth = eval(args[2], locals, nl);
tvars = eval(args[3], locals, nl);
jl_method_def(fname, bp, b, (jl_tuple_t*)atypes,
(jl_function_t*)meth, (jl_tuple_t*)tvars);
JL_GC_POP();
return *bp;
}
else if (ex->head == const_sym) {
jl_value_t *sym = args[0];
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);
jl_value_t *super = NULL;
JL_GC_PUSH(¶, &super);
jl_datatype_t *dt =
jl_new_abstracttype(name, jl_any_type, (jl_tuple_t*)para);
jl_binding_t *b = jl_get_binding_wr(jl_current_module, (jl_sym_t*)name);
jl_checked_assignment(b, (jl_value_t*)dt);
super = eval(args[2], locals, nl);
jl_set_datatype_super(dt, super);
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;
JL_GC_PUSH(¶, &super, &vnb);
para = eval(args[1], locals, nl);
vnb = eval(args[2], locals, nl);
if (!jl_is_long(vnb))
jl_errorf("invalid declaration of bits type %s", ((jl_sym_t*)name)->name);
int32_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);
jl_datatype_t *dt =
jl_new_bitstype(name, jl_any_type, (jl_tuple_t*)para, nb);
jl_binding_t *b = jl_get_binding_wr(jl_current_module, (jl_sym_t*)name);
jl_checked_assignment(b, (jl_value_t*)dt);
super = eval(args[3], locals, nl);
jl_set_datatype_super(dt, super);
JL_GC_POP();
return (jl_value_t*)jl_nothing;
}
else if (ex->head == compositetype_sym) {
void jl_add_constructors(jl_datatype_t *t);
jl_value_t *name = args[0];
jl_value_t *para = eval(args[1], locals, nl);
jl_value_t *fnames = NULL;
jl_value_t *super = NULL;
jl_datatype_t *dt = NULL;
JL_GC_PUSH(¶, &super, &fnames, &dt);
fnames = eval(args[2], locals, nl);
dt = jl_new_datatype((jl_sym_t*)name, jl_any_type, (jl_tuple_t*)para,
(jl_tuple_t*)fnames, NULL,
0, args[6]==jl_true ? 1 : 0);
dt->fptr = jl_f_ctor_trampoline;
dt->ctor_factory = eval(args[3], locals, nl);
jl_binding_t *b = jl_get_binding_wr(jl_current_module, (jl_sym_t*)name);
jl_checked_assignment(b, (jl_value_t*)dt);
inside_typedef = 1;
dt->types = (jl_tuple_t*)eval(args[5], locals, nl);
inside_typedef = 0;
jl_check_type_tuple(dt->types, dt->name->name, "type definition");
super = eval(args[4], locals, nl);
jl_set_datatype_super(dt, super);
jl_compute_field_offsets(dt);
jl_add_constructors(dt);
JL_GC_POP();
return (jl_value_t*)jl_nothing;
}
else if (ex->head == macro_sym) {
jl_sym_t *nm = (jl_sym_t*)args[0];
assert(jl_is_symbol(nm));
jl_function_t *f = (jl_function_t*)eval(args[1], locals, nl);
assert(jl_is_function(f));
if (jl_boot_file_loaded &&
f->linfo && f->linfo->ast && jl_is_expr(f->linfo->ast)) {
jl_lambda_info_t *li = f->linfo;
li->ast = jl_compress_ast(li, li->ast);
li->name = nm;
}
jl_set_global(jl_current_module, nm, (jl_value_t*)f);
return (jl_value_t*)jl_nothing;
}
else if (ex->head == line_sym) {
jl_lineno = jl_unbox_long(jl_exprarg(ex,0));
return (jl_value_t*)jl_nothing;
}
else if (ex->head == module_sym) {
return jl_eval_module_expr(ex);
}
else if (ex->head == error_sym || ex->head == jl_continue_sym) {
if (jl_is_byte_string(args[0]))
jl_errorf("syntax: %s", jl_string_data(args[0]));
jl_throw(args[0]);
}
jl_errorf("unsupported or misplaced expression %s", ex->head->name);
return (jl_value_t*)jl_nothing;
}
//-| mode=="rcqls" is for rcqls development, mode="tty" is for initialization of STDOUT, STDERR with C API)
//-| other value of mode mean standard jlapi.c
DLLEXPORT void jlapi_init(char *julia_home_dir, char* mode) {
libsupport_init();
char *image_file = jl_locate_sysimg(julia_home_dir);
printf("image-file=%s\n",image_file);
julia_init(image_file);
jlapi_mode=mode;
jl_set_const(jl_core_module, jl_symbol("JULIA_HOME"),
jl_cstr_to_string(julia_home));
jl_module_export(jl_core_module, jl_symbol("JULIA_HOME"));
//-| This avoid LD_PRELOAD on linux since shared objects not exported
//-| Maybe fix this in a better way with options compilation.
char julia_api_libname[512];
#if defined(_OS_WINDOWS_)
const char *shlib_ext=".dll";
const char *sep="\\";
#elif defined(__APPLE__)
const char *shlib_ext=".dylib";
const char *sep="/";
#else
const char *shlib_ext=".so";
const char *sep="/";
#endif
snprintf(julia_api_libname, sizeof(julia_api_libname), "%s%s%s%s%s%s",
julia_home_dir, sep,"julia",sep,"libjulia-api",shlib_ext);
load_library_permanently(julia_api_libname);
if(strcmp(mode,"rcqls")<=0) { // cqls, rcqls
//-| Called first to fix the DL_LOAD_PATH needed to (dl)open library (libpcre for example)
//-| Replacement of Base.init_load_path()
//-| Update 01/08/2013: No need to set DL_LOAD_PATH, just push
//-| jl_set_global(jl_base_module,jl_symbol("DL_LOAD_PATH"),jl_eval_string("ByteString[join([JULIA_HOME,\"..\",\"lib\",\"julia\"],Base.path_separator)]"));
jl_eval_string("Base.push!(DL_LOAD_PATH,join([JULIA_HOME,\"..\",\"lib\",\"julia\"],Base.path_separator))");
//-| DL_LOAD_PATH is a global constant already defined before and then not overloaded by julia
//-| Only LOAD_PATH would be initialized (needs libpcre because of abspath)!
jl_eval_string("vers = \"v$(VERSION.major).$(VERSION.minor)\"");
jl_set_global(jl_base_module,jl_symbol("LOAD_PATH"),jl_eval_string("ByteString[abspath(JULIA_HOME,\"..\",\"local\",\"share\",\"julia\",\"site\",vers),abspath(JULIA_HOME,\"..\",\"share\",\"julia\",\"site\",vers)]"));
} else jl_eval_string("Base.init_load_path()");
if(strcmp(mode,"tty")==0) {
jl_eval_string("Base.reinit_stdio()");
jl_set_global(jl_base_module,jl_symbol("STDIN"),jl_eval_string("Base.init_stdio(ccall(:jl_stdin_stream ,Ptr{Void},()),0)"));
//-| 2 next lines fails even it is if no more necessary
//-| Update 27/07/13: no more crash but stuck when print.
jl_set_global(jl_base_module,jl_symbol("STDOUT"),jl_eval_string("Base.init_stdio(ccall(:jl_stdout_stream,Ptr{Void},()),1)"));
jl_set_global(jl_base_module,jl_symbol("STDERR"),jl_eval_string("Base.init_stdio(ccall(:jl_stderr_stream,Ptr{Void},()),2)"));
} else if(strcmp(mode,"rcqls")<=0) { //cqls, rcqls
jl_eval_string("Base.reinit_stdio()");
//-| STDIN, STDOUT and STDERR not properly loaded
//-| I prefer redirection of STDOUT and STDERR in IOBuffer (maybe STDIN ???)
jl_set_global(jl_base_module,jl_symbol("STDIN"),jl_eval_string("Base.init_stdio(ccall(:jl_stdin_stream ,Ptr{Void},()),0)"));
//jl_set_global(jl_base_module,jl_symbol("STDIN"),jl_eval_string("IOBuffer()"));
jl_set_global(jl_base_module,jl_symbol("STDOUT"),jl_eval_string("IOBuffer()"));
jl_set_global(jl_base_module,jl_symbol("STDERR"),jl_eval_string("IOBuffer()"));
} else jl_eval_string("Base.reinit_stdio()");
jl_eval_string("Base.fdwatcher_reinit()");
jl_eval_string("Base.Random.librandom_init()");
jl_eval_string("Base.check_blas()");
jl_eval_string("LinAlg.init()");
jl_eval_string("Sys.init()");
jl_eval_string("Base.init_sched()");
jl_eval_string("Base.init_head_sched()");
jl_eval_string("Base.try_include(abspath(ENV[\"HOME\"],\".juliarc.jl\"))");
if(strcmp(mode,"rcqls")==0) {
jl_eval_string("println(\"Julia initialized!\")");
jlapi_print_stdout();
}
}
static jl_value_t *R_Julia_MD(SEXP Var, const char *VarName)
{
if ((LENGTH(Var)) != 0)
{
jl_tuple_t *dims = RDims_JuliaTuple(Var);
switch (TYPEOF( Var))
{
case LGLSXP:
{
jl_array_t *ret = CreateArray(jl_bool_type, jl_tuple_len(dims), dims);
JL_GC_PUSH1(&ret);
char *retData = (char *)jl_array_data(ret);
for (size_t i = 0; i < jl_array_len(ret); i++)
retData[i] = LOGICAL(Var)[i];
jl_set_global(jl_main_module, jl_symbol(VarName), (jl_value_t *)ret);
return (jl_value_t *) ret;
JL_GC_POP();
break;
};
case INTSXP:
{
jl_array_t *ret = CreateArray(jl_int32_type, jl_tuple_len(dims), dims);
JL_GC_PUSH1(&ret);
int *retData = (int *)jl_array_data(ret);
for (size_t i = 0; i < jl_array_len(ret); i++)
retData[i] = INTEGER(Var)[i];
jl_set_global(jl_main_module, jl_symbol(VarName), (jl_value_t *)ret);
return (jl_value_t *) ret;
JL_GC_POP();
break;
}
case REALSXP:
{
jl_array_t *ret = CreateArray(jl_float64_type, jl_tuple_len(dims), dims);
JL_GC_PUSH1(&ret);
double *retData = (double *)jl_array_data(ret);
for (size_t i = 0; i < jl_array_len(ret); i++)
retData[i] = REAL(Var)[i];
jl_set_global(jl_main_module, jl_symbol(VarName), (jl_value_t *)ret);
JL_GC_POP();
return (jl_value_t *) ret;
break;
}
case STRSXP:
{
jl_array_t *ret;
if (!IS_ASCII(Var))
ret = CreateArray(jl_utf8_string_type, jl_tuple_len(dims), dims);
else
ret = CreateArray(jl_ascii_string_type, jl_tuple_len(dims), dims);
JL_GC_PUSH1(&ret);
jl_value_t **retData = jl_array_data(ret);
for (size_t i = 0; i < jl_array_len(ret); i++)
if (!IS_ASCII(Var))
retData[i] = jl_cstr_to_string(translateChar0(STRING_ELT(Var, i)));
else
retData[i] = jl_cstr_to_string(CHAR(STRING_ELT(Var, i)));
jl_set_global(jl_main_module, jl_symbol(VarName), (jl_value_t *)ret);
JL_GC_POP();
return (jl_value_t *) ret;
break;
}
case VECSXP:
{
char eltcmd[eltsize];
jl_tuple_t *ret = jl_alloc_tuple(length(Var));
JL_GC_PUSH1(&ret);
for (int i = 0; i < length(Var); i++)
{
snprintf(eltcmd, eltsize, "%selement%d", VarName, i);
jl_tupleset(ret, i, R_Julia_MD(VECTOR_ELT(Var, i), eltcmd));
}
jl_set_global(jl_main_module, jl_symbol(VarName), (jl_value_t *)ret);
JL_GC_POP();
return (jl_value_t *) ret;
}
default:
{
return (jl_value_t *) jl_nothing;
}
break;
}
return (jl_value_t *) jl_nothing;
}
return (jl_value_t *) jl_nothing;
}
