Пример #1
0
static value_t julia_to_list2(jl_value_t *a, jl_value_t *b)
{
    value_t sa = julia_to_scm(a);
    fl_gc_handle(&sa);
    value_t sb = julia_to_scm(b);
    value_t l = fl_list2(sa, sb);
    fl_free_gc_handles(1);
    return l;
}
Пример #2
0
// returns either an expression or a thunk
jl_value_t *jl_expand(jl_value_t *expr)
{
    int np = jl_gc_n_preserved_values();
    value_t arg = julia_to_scm(expr);
    value_t e = fl_applyn(1, symbol_value(symbol("jl-expand-to-thunk")), arg);
    jl_value_t *result = scm_to_julia(e,0);
    while (jl_gc_n_preserved_values() > np) {
        jl_gc_unpreserve();
    }
    return result;
}
Пример #3
0
DLLEXPORT jl_value_t *jl_macroexpand(jl_value_t *expr)
{
    int np = jl_gc_n_preserved_values();
    value_t arg = julia_to_scm(expr);
    value_t e = fl_applyn(1, symbol_value(symbol("jl-macroexpand")), arg);
    jl_value_t *result;
    result = scm_to_julia(e);
    while (jl_gc_n_preserved_values() > np) {
        jl_gc_unpreserve();
    }
    return result;
}
Пример #4
0
// returns either an expression or a thunk
jl_value_t *jl_call_scm_on_ast(const char *funcname, jl_value_t *expr, jl_module_t *inmodule)
{
    jl_ast_context_t *ctx = jl_ast_ctx_enter();
    fl_context_t *fl_ctx = &ctx->fl;
    JL_AST_PRESERVE_PUSH(ctx, old_roots, inmodule);
    value_t arg = julia_to_scm(fl_ctx, expr);
    value_t e = fl_applyn(fl_ctx, 1, symbol_value(symbol(fl_ctx, funcname)), arg);
    jl_value_t *result = scm_to_julia(fl_ctx, e, inmodule);
    JL_AST_PRESERVE_POP(ctx, old_roots);
    jl_ast_ctx_leave(ctx);
    return result;
}
Пример #5
0
value_t fl_invoke_julia_macro(fl_context_t *fl_ctx, value_t *args, uint32_t nargs)
{
    if (nargs < 1)
        argcount(fl_ctx, "invoke-julia-macro", nargs, 1);
    jl_lambda_info_t *mfunc = NULL;
    jl_value_t **margs;
    // Reserve one more slot for the result
    JL_GC_PUSHARGS(margs, nargs + 1);
    int i;
    for(i=1; i < nargs; i++) margs[i] = scm_to_julia(fl_ctx, args[i], 1);
    jl_value_t *result = NULL;

    JL_TRY {
        margs[0] = scm_to_julia(fl_ctx, args[0], 1);
        margs[0] = jl_toplevel_eval(margs[0]);
        mfunc = jl_method_lookup(jl_gf_mtable(margs[0]), margs, nargs, 1);
        if (mfunc == NULL) {
            JL_GC_POP();
            jl_method_error((jl_function_t*)margs[0], margs, nargs);
            // unreachable
        }
        margs[nargs] = result = jl_call_method_internal(mfunc, margs, nargs);
    }
    JL_CATCH {
        JL_GC_POP();
        value_t opaque = cvalue(fl_ctx, jl_ast_ctx(fl_ctx)->jvtype, sizeof(void*));
        *(jl_value_t**)cv_data((cvalue_t*)ptr(opaque)) = jl_exception_in_transit;
        return fl_list2(fl_ctx, jl_ast_ctx(fl_ctx)->error_sym, opaque);
    }
    // protect result from GC, otherwise it could be freed during future
    // macro expansions, since it will be referenced only from scheme and
    // not julia.
    // all calls to invoke-julia-macro happen under `jl_macroexpand`,
    // `jl_expand` or `jl_parse_eval_all` so the preserved array is rooted there.
    assert(result != NULL);
    jl_ast_preserve(fl_ctx, result);
    value_t scm = julia_to_scm(fl_ctx, result);
    fl_gc_handle(fl_ctx, &scm);
    value_t scmresult;
    jl_module_t *defmod = mfunc->def->module;
    if (defmod == NULL || defmod == jl_current_module) {
        scmresult = fl_cons(fl_ctx, scm, fl_ctx->F);
    }
    else {
        value_t opaque = cvalue(fl_ctx, jl_ast_ctx(fl_ctx)->jvtype, sizeof(void*));
        *(jl_value_t**)cv_data((cvalue_t*)ptr(opaque)) = (jl_value_t*)defmod;
        scmresult = fl_cons(fl_ctx, scm, opaque);
    }
    fl_free_gc_handles(fl_ctx, 1);

    JL_GC_POP();
    return scmresult;
}
Пример #6
0
static value_t array_to_list(jl_array_t *a)
{
    long i;
    value_t lst=FL_NIL, temp=FL_NIL;
    fl_gc_handle(&lst);
    fl_gc_handle(&temp);
    for(i=jl_array_len(a)-1; i >= 0; i--) {
        temp = julia_to_scm(jl_cellref(a,i));
        lst = fl_cons(temp, lst);
    }
    fl_free_gc_handles(2);
    return lst;
}
Пример #7
0
static value_t array_to_list(jl_array_t *a)
{
    if (jl_array_len(a) > 300000)
        jl_error("expression too large");
    value_t lst=FL_NIL, temp=FL_NIL;
    fl_gc_handle(&lst);
    fl_gc_handle(&temp);
    for(long i=jl_array_len(a)-1; i >= 0; i--) {
        temp = julia_to_scm(jl_cellref(a,i));
        lst = fl_cons(temp, lst);
    }
    fl_free_gc_handles(2);
    return lst;
}
Пример #8
0
value_t fl_invoke_julia_macro(value_t *args, uint32_t nargs)
{
    if (nargs < 1)
        argcount("invoke-julia-macro", nargs, 1);
    jl_function_t *f = NULL;
    jl_value_t **margs = alloca(nargs * sizeof(jl_value_t*));
    int i;
    for(i=0; i < nargs; i++) margs[i] = NULL;
    JL_GC_PUSHARGS(margs, nargs);
    for(i=1; i < nargs; i++) margs[i] = scm_to_julia(args[i]);
    jl_value_t *result;

    JL_TRY {
        jl_register_toplevel_eh();

        margs[0] = scm_to_julia(args[0]);
        f = (jl_function_t*)jl_toplevel_eval(margs[0]);
        result = jl_apply(f, &margs[1], nargs-1);
    }
    JL_CATCH {
        JL_GC_POP();
        value_t opaque = cvalue(jvtype, sizeof(void*));
        *(jl_value_t**)cv_data((cvalue_t*)ptr(opaque)) = jl_exception_in_transit;
        return fl_list2(symbol("error"), opaque);
    }
    // protect result from GC, otherwise it could be freed during future
    // macro expansions, since it will be referenced only from scheme and
    // not julia.
    // all calls to invoke-julia-macro happen under a single call to jl_expand,
    // so the preserved value stack is popped there.
    jl_gc_preserve(result);
    value_t scm = julia_to_scm(result);
    fl_gc_handle(&scm);
    value_t scmresult;
    jl_module_t *defmod = f->linfo->module;
    if (defmod == jl_current_module) {
        scmresult = fl_cons(scm, FL_F);
    }
    else {
        value_t opaque = cvalue(jvtype, sizeof(void*));
        *(jl_value_t**)cv_data((cvalue_t*)ptr(opaque)) = (jl_value_t*)defmod;
        scmresult = fl_cons(scm, opaque);
    }
    fl_free_gc_handles(1);

    JL_GC_POP();
    return scmresult;
}
Пример #9
0
static value_t julia_to_scm(jl_value_t *v)
{
    if (jl_is_symbol(v)) {
        return symbol(((jl_sym_t*)v)->name);
    }
    if (v == jl_true) {
        return FL_T;
    }
    if (v == jl_false) {
        return FL_F;
    }
    if (v == jl_nothing) {
        return fl_cons(symbol("null"), FL_NIL);
    }
    if (jl_is_expr(v)) {
        jl_expr_t *ex = (jl_expr_t*)v;
        value_t args = array_to_list(ex->args);
        fl_gc_handle(&args);
        value_t hd = julia_to_scm((jl_value_t*)ex->head);
        value_t scmv = fl_cons(hd, args);
        fl_free_gc_handles(1);
        return scmv;
    }
    if (jl_typeis(v, jl_linenumbernode_type)) {
        return julia_to_list2((jl_value_t*)line_sym, jl_fieldref(v,0));
    }
    if (jl_typeis(v, jl_labelnode_type)) {
        return julia_to_list2((jl_value_t*)label_sym, jl_fieldref(v,0));
    }
    if (jl_typeis(v, jl_gotonode_type)) {
        return julia_to_list2((jl_value_t*)goto_sym, jl_fieldref(v,0));
    }
    if (jl_typeis(v, jl_quotenode_type)) {
        return julia_to_list2((jl_value_t*)quote_sym, jl_fieldref(v,0));
    }
    if (jl_typeis(v, jl_newvarnode_type)) {
        return julia_to_list2((jl_value_t*)newvar_sym, jl_fieldref(v,0));
    }
    if (jl_typeis(v, jl_topnode_type)) {
        return julia_to_list2((jl_value_t*)top_sym, jl_fieldref(v,0));
    }
    if (jl_is_long(v) && fits_fixnum(jl_unbox_long(v))) {
        return fixnum(jl_unbox_long(v));
    }
    value_t opaque = cvalue(jvtype, sizeof(void*));
    *(jl_value_t**)cv_data((cvalue_t*)ptr(opaque)) = v;
    return opaque;
}
Пример #10
0
// returns either an expression or a thunk
jl_value_t *jl_expand(jl_value_t *expr)
{
    int np = jl_gc_n_preserved_values();
    value_t arg = julia_to_scm(expr);
    value_t e = fl_applyn(1, symbol_value(symbol("jl-expand-to-thunk")), arg);
    jl_value_t *result;
    if (e == FL_T || e == FL_F || e == FL_EOF) {
        result = NULL;
    }
    else {
        result = scm_to_julia(e);
    }
    while (jl_gc_n_preserved_values() > np) {
        jl_gc_unpreserve();
    }
    return result;
}
Пример #11
0
Файл: ast.c Проект: rpruim/julia
value_t fl_invoke_julia_macro(value_t *args, uint32_t nargs)
{
    if (nargs < 1)
        argcount("invoke-julia-macro", nargs, 1);
    (void)tosymbol(args[0], "invoke-julia-macro");
    jl_sym_t *name = jl_symbol(symbol_name(args[0]));
    jl_function_t *f = jl_get_expander(jl_current_module, name);
    if (f == NULL)
        return FL_F;
    jl_value_t **margs;
    int na = nargs-1;
    if (na > 0)
        margs = alloca(na * sizeof(jl_value_t*));
    else
        margs = NULL;
    int i;
    for(i=0; i < na; i++) margs[i] = NULL;
    JL_GC_PUSHARGS(margs, na);
    for(i=0; i < na; i++) margs[i] = scm_to_julia(args[i+1]);
    jl_value_t *result;

    JL_TRY {
        result = jl_apply(f, margs, na);
    }
    JL_CATCH {
        JL_GC_POP();
        jl_show(jl_exception_in_transit);
        ios_putc('\n', jl_current_output_stream());
        return fl_cons(symbol("error"), FL_NIL);
    }
    // protect result from GC, otherwise it could be freed during future
    // macro expansions, since it will be referenced only from scheme and
    // not julia.
    // all calls to invoke-julia-macro happen under a single call to jl_expand,
    // so the preserved value stack is popped there.
    jl_gc_preserve(result);
    value_t scm = julia_to_scm(result);
    JL_GC_POP();
    return scm;
}
Пример #12
0
// parse and eval a whole file, possibly reading from a string (`content`)
jl_value_t *jl_parse_eval_all(const char *fname,
                              const char *content, size_t contentlen,
                              jl_module_t *inmodule)
{
    jl_ptls_t ptls = jl_get_ptls_states();
    if (ptls->in_pure_callback)
        jl_error("cannot use include inside a generated function");
    jl_ast_context_t *ctx = jl_ast_ctx_enter();
    fl_context_t *fl_ctx = &ctx->fl;
    value_t f, ast, expression;
    size_t len = strlen(fname);
    f = cvalue_static_cstrn(fl_ctx, fname, len);
    fl_gc_handle(fl_ctx, &f);
    if (content != NULL) {
        JL_TIMING(PARSING);
        value_t t = cvalue_static_cstrn(fl_ctx, content, contentlen);
        fl_gc_handle(fl_ctx, &t);
        ast = fl_applyn(fl_ctx, 2, symbol_value(symbol(fl_ctx, "jl-parse-string-stream")), t, f);
        fl_free_gc_handles(fl_ctx, 1);
    }
    else {
        JL_TIMING(PARSING);
        assert(memchr(fname, 0, len) == NULL); // was checked already in jl_load
        ast = fl_applyn(fl_ctx, 1, symbol_value(symbol(fl_ctx, "jl-parse-file")), f);
    }
    fl_free_gc_handles(fl_ctx, 1);
    if (ast == fl_ctx->F) {
        jl_ast_ctx_leave(ctx);
        jl_errorf("could not open file %s", fname);
    }
    fl_gc_handle(fl_ctx, &ast);
    fl_gc_handle(fl_ctx, &expression);

    int last_lineno = jl_lineno;
    const char *last_filename = jl_filename;
    size_t last_age = jl_get_ptls_states()->world_age;
    jl_lineno = 0;
    jl_filename = fname;
    jl_module_t *old_module = ctx->module;
    ctx->module = inmodule;
    jl_value_t *form = NULL;
    jl_value_t *result = jl_nothing;
    int err = 0;
    JL_GC_PUSH2(&form, &result);
    JL_TRY {
        assert(iscons(ast) && car_(ast) == symbol(fl_ctx, "toplevel"));
        ast = cdr_(ast);
        while (iscons(ast)) {
            expression = car_(ast);
            {
                JL_TIMING(LOWERING);
                if (fl_ctx->T == fl_applyn(fl_ctx, 1, symbol_value(symbol(fl_ctx, "contains-macrocall")), expression)) {
                    form = scm_to_julia(fl_ctx, expression, inmodule);
                    form = jl_expand_macros(form, inmodule, NULL, 0);
                    expression = julia_to_scm(fl_ctx, form);
                }
                // expand non-final expressions in statement position (value unused)
                expression =
                    fl_applyn(fl_ctx, 1,
                              symbol_value(symbol(fl_ctx, iscons(cdr_(ast)) ? "jl-expand-to-thunk-stmt" : "jl-expand-to-thunk")),
                              expression);
            }
            jl_get_ptls_states()->world_age = jl_world_counter;
            form = scm_to_julia(fl_ctx, expression, inmodule);
            JL_SIGATOMIC_END();
            jl_get_ptls_states()->world_age = jl_world_counter;
            if (jl_is_linenode(form))
                jl_lineno = jl_linenode_line(form);
            else
                result = jl_toplevel_eval_flex(inmodule, form, 1, 1);
            JL_SIGATOMIC_BEGIN();
            ast = cdr_(ast);
        }
    }
    JL_CATCH {
        form = jl_pchar_to_string(fname, len);
        result = jl_box_long(jl_lineno);
        err = 1;
    }
    jl_get_ptls_states()->world_age = last_age;
    jl_lineno = last_lineno;
    jl_filename = last_filename;
    fl_free_gc_handles(fl_ctx, 2);
    ctx->module = old_module;
    jl_ast_ctx_leave(ctx);
    if (err) {
        if (jl_loaderror_type == NULL)
            jl_rethrow();
        else
            jl_rethrow_other(jl_new_struct(jl_loaderror_type, form, result,
                                           ptls->exception_in_transit));
    }
    JL_GC_POP();
    return result;
}