Пример #1
0
JL_DLLEXPORT void fl_profile(const char *fname)
{
    jl_ast_context_t *ctx = jl_ast_ctx_enter();
    fl_context_t *fl_ctx = &ctx->fl;
    fl_applyn(fl_ctx, 1, symbol_value(symbol(fl_ctx, "profile-e")), symbol(fl_ctx, fname));
    jl_ast_ctx_leave(ctx);
}
Пример #2
0
// this is for parsing one expression out of a string, keeping track of
// the current position.
JL_DLLEXPORT jl_value_t *jl_parse_string(const char *str, size_t len,
                                         int pos0, int greedy)
{
    JL_TIMING(PARSING);
    if (pos0 < 0 || pos0 > len) {
        jl_array_t *buf = jl_pchar_to_array(str, len);
        JL_GC_PUSH1(&buf);
        // jl_bounds_error roots the arguments.
        jl_bounds_error((jl_value_t*)buf, jl_box_long(pos0));
    }
    jl_ast_context_t *ctx = jl_ast_ctx_enter();
    fl_context_t *fl_ctx = &ctx->fl;
    value_t s = cvalue_static_cstrn(fl_ctx, str, len);
    value_t p = fl_applyn(fl_ctx, 3, symbol_value(symbol(fl_ctx, "jl-parse-one-string")),
                          s, fixnum(pos0), greedy?fl_ctx->T:fl_ctx->F);
    jl_value_t *expr=NULL, *pos1=NULL;
    JL_GC_PUSH2(&expr, &pos1);

    value_t e = car_(p);
    if (e == fl_ctx->FL_EOF)
        expr = jl_nothing;
    else
        expr = scm_to_julia(fl_ctx, e, NULL);

    pos1 = jl_box_long(tosize(fl_ctx, cdr_(p), "parse"));
    jl_ast_ctx_leave(ctx);
    jl_value_t *result = (jl_value_t*)jl_svec2(expr, pos1);
    JL_GC_POP();
    return result;
}
Пример #3
0
JL_DLLEXPORT void fl_clear_profile(void)
{
    jl_ast_context_t *ctx = jl_ast_ctx_enter();
    fl_context_t *fl_ctx = &ctx->fl;
    fl_applyn(fl_ctx, 0, symbol_value(symbol(fl_ctx, "clear-profiles")));
    jl_ast_ctx_leave(ctx);
}
Пример #4
0
JL_DLLEXPORT int jl_parse_depwarn(int warn)
{
    jl_ast_context_t *ctx = jl_ast_ctx_enter();
    int res = jl_parse_depwarn_(&ctx->fl, warn);
    jl_ast_ctx_leave(ctx);
    return res;
}
Пример #5
0
JL_DLLEXPORT int jl_operator_precedence(char *sym)
{
    jl_ast_context_t *ctx = jl_ast_ctx_enter();
    fl_context_t *fl_ctx = &ctx->fl;
    int res = numval(fl_applyn(fl_ctx, 1, symbol_value(symbol(fl_ctx, "operator-precedence")), symbol(fl_ctx, sym)));
    jl_ast_ctx_leave(ctx);
    return res;
}
Пример #6
0
JL_DLLEXPORT int jl_is_unary_and_binary_operator(char *sym)
{
    jl_ast_context_t *ctx = jl_ast_ctx_enter();
    fl_context_t *fl_ctx = &ctx->fl;
    int res = fl_applyn(fl_ctx, 1, symbol_value(symbol(fl_ctx, "unary-and-binary-op?")), symbol(fl_ctx, sym)) == fl_ctx->T;
    jl_ast_ctx_leave(ctx);
    return res;
}
Пример #7
0
// this is used to parse a line of repl input
JL_DLLEXPORT jl_value_t *jl_parse_input_line(const char *str, size_t len, const char *filename, size_t filename_len)
{
    jl_ast_context_t *ctx = jl_ast_ctx_enter();
    fl_context_t *fl_ctx = &ctx->fl;
    value_t s = cvalue_static_cstrn(fl_ctx, str, len);
    value_t files = cvalue_static_cstrn(fl_ctx, filename, filename_len);
    value_t e = fl_applyn(fl_ctx, 2, symbol_value(symbol(fl_ctx, "jl-parse-string")), s, files);
    jl_value_t *res = e == fl_ctx->FL_EOF ? jl_nothing : scm_to_julia(fl_ctx, e, 0);
    jl_ast_ctx_leave(ctx);
    return res;
}
Пример #8
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;
}
Пример #9
0
JL_DLLEXPORT void jl_lisp_prompt(void)
{
    // Make `--lisp` sigatomic in order to avoid triggering the sigint safepoint.
    // We don't have our signal handler registered in that case anyway...
    JL_SIGATOMIC_BEGIN();
    jl_init_frontend();
    jl_ast_context_t *ctx = jl_ast_ctx_enter();
    JL_AST_PRESERVE_PUSH(ctx, old_roots, jl_main_module);
    fl_context_t *fl_ctx = &ctx->fl;
    fl_applyn(fl_ctx, 1, symbol_value(symbol(fl_ctx, "__start")), fl_cons(fl_ctx, fl_ctx->NIL,fl_ctx->NIL));
    JL_AST_PRESERVE_POP(ctx, old_roots);
    jl_ast_ctx_leave(ctx);
}
Пример #10
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;
}
Пример #11
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)
{
    if (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;
    size_t len = strlen(fname);
    f = cvalue_static_cstrn(fl_ctx, fname, len);
    fl_gc_handle(fl_ctx, &f);
    if (content != NULL) {
        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 {
        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);

    int last_lineno = jl_lineno;
    const char *last_filename = jl_filename;
    jl_lineno = 0;
    jl_filename = fname;
    jl_array_t *roots = NULL;
    jl_array_t **old_roots = ctx->roots;
    ctx->roots = &roots;
    jl_value_t *form=NULL, *result=jl_nothing;
    int err = 0;
    JL_GC_PUSH3(&roots, &form, &result);
    JL_TRY {
        assert(iscons(ast) && car_(ast) == symbol(fl_ctx,"toplevel"));
        ast = cdr_(ast);
        while (iscons(ast)) {
            value_t expansion = fl_applyn(fl_ctx, 1, symbol_value(symbol(fl_ctx, "jl-expand-to-thunk")), car_(ast));
            form = scm_to_julia(fl_ctx, expansion, 0);
            jl_sym_t *head = NULL;
            if (jl_is_expr(form)) head = ((jl_expr_t*)form)->head;
            JL_SIGATOMIC_END();
            if (head == jl_incomplete_sym)
                jl_errorf("syntax: %s", jl_string_data(jl_exprarg(form,0)));
            else if (head == error_sym)
                jl_interpret_toplevel_expr(form);
            else if (head == line_sym)
                jl_lineno = jl_unbox_long(jl_exprarg(form,0));
            else if (jl_is_linenode(form))
                jl_lineno = jl_linenode_line(form);
            else
                result = jl_toplevel_eval_flex(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_lineno = last_lineno;
    jl_filename = last_filename;
    fl_free_gc_handles(fl_ctx, 1);
    ctx->roots = old_roots;
    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,
                                           jl_exception_in_transit));
    }
    JL_GC_POP();
    return result;
}