Exemplo n.º 1
0
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;
}
Exemplo n.º 2
0
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;
}
Exemplo n.º 3
0
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;
}
Exemplo n.º 4
0
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;
}
Exemplo n.º 5
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;
}
Exemplo n.º 6
0
Arquivo: repl.c Projeto: julienr/julia
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;
        }
    }
Exemplo n.º 7
0
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;
}
Exemplo n.º 8
0
//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;
}
Exemplo n.º 9
0
// 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);
}
Exemplo n.º 10
0
Arquivo: repl.c Projeto: julienr/julia
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();
}
Exemplo n.º 11
0
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;
}
Exemplo n.º 12
0
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;
}
Exemplo n.º 13
0
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;
}
Exemplo n.º 14
0
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(&para, &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(&para, &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(&para, &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;
}
Exemplo n.º 15
0
//-|  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();
  }
}
Exemplo n.º 16
0
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;
}