https://github.com/JuliaLang/julia
Tip revision: 1a8513cbb5166c3d096043de9d6e28e8e14ebb4d authored by Kristoffer Carlsson on 09 July 2022, 19:40:59 UTC
only locate packages in envs at or above in the load path where they were identified
only locate packages in envs at or above in the load path where they were identified
Tip revision: 1a8513c
ast.c
// This file is a part of Julia. License is MIT: https://julialang.org/license
/*
AST
components of the front-end, for obtaining and translating syntax trees
*/
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#ifdef _OS_WINDOWS_
#include <malloc.h>
#endif
#include "julia.h"
#include "julia_internal.h"
#include "flisp.h"
#include "julia_assert.h"
#ifdef __cplusplus
extern "C" {
#endif
// head symbols for each expression type
JL_DLLEXPORT jl_sym_t *jl_call_sym;
JL_DLLEXPORT jl_sym_t *jl_invoke_sym;
JL_DLLEXPORT jl_sym_t *jl_invoke_modify_sym;
JL_DLLEXPORT jl_sym_t *jl_empty_sym;
JL_DLLEXPORT jl_sym_t *jl_top_sym;
JL_DLLEXPORT jl_sym_t *jl_module_sym;
JL_DLLEXPORT jl_sym_t *jl_slot_sym;
JL_DLLEXPORT jl_sym_t *jl_export_sym;
JL_DLLEXPORT jl_sym_t *jl_import_sym;
JL_DLLEXPORT jl_sym_t *jl_toplevel_sym;
JL_DLLEXPORT jl_sym_t *jl_quote_sym;
JL_DLLEXPORT jl_sym_t *jl_line_sym;
JL_DLLEXPORT jl_sym_t *jl_incomplete_sym;
JL_DLLEXPORT jl_sym_t *jl_goto_sym;
JL_DLLEXPORT jl_sym_t *jl_goto_ifnot_sym;
JL_DLLEXPORT jl_sym_t *jl_return_sym;
JL_DLLEXPORT jl_sym_t *jl_lineinfo_sym;
JL_DLLEXPORT jl_sym_t *jl_lambda_sym;
JL_DLLEXPORT jl_sym_t *jl_assign_sym;
JL_DLLEXPORT jl_sym_t *jl_globalref_sym;
JL_DLLEXPORT jl_sym_t *jl_do_sym;
JL_DLLEXPORT jl_sym_t *jl_method_sym;
JL_DLLEXPORT jl_sym_t *jl_core_sym;
JL_DLLEXPORT jl_sym_t *jl_enter_sym;
JL_DLLEXPORT jl_sym_t *jl_leave_sym;
JL_DLLEXPORT jl_sym_t *jl_pop_exception_sym;
JL_DLLEXPORT jl_sym_t *jl_exc_sym;
JL_DLLEXPORT jl_sym_t *jl_error_sym;
JL_DLLEXPORT jl_sym_t *jl_new_sym;
JL_DLLEXPORT jl_sym_t *jl_using_sym;
JL_DLLEXPORT jl_sym_t *jl_splatnew_sym;
JL_DLLEXPORT jl_sym_t *jl_block_sym;
JL_DLLEXPORT jl_sym_t *jl_new_opaque_closure_sym;
JL_DLLEXPORT jl_sym_t *jl_opaque_closure_method_sym;
JL_DLLEXPORT jl_sym_t *jl_const_sym;
JL_DLLEXPORT jl_sym_t *jl_thunk_sym;
JL_DLLEXPORT jl_sym_t *jl_foreigncall_sym;
JL_DLLEXPORT jl_sym_t *jl_as_sym;
JL_DLLEXPORT jl_sym_t *jl_global_sym;
JL_DLLEXPORT jl_sym_t *jl_list_sym;
JL_DLLEXPORT jl_sym_t *jl_dot_sym;
JL_DLLEXPORT jl_sym_t *jl_newvar_sym;
JL_DLLEXPORT jl_sym_t *jl_boundscheck_sym;
JL_DLLEXPORT jl_sym_t *jl_inbounds_sym;
JL_DLLEXPORT jl_sym_t *jl_copyast_sym;
JL_DLLEXPORT jl_sym_t *jl_cfunction_sym;
JL_DLLEXPORT jl_sym_t *jl_pure_sym;
JL_DLLEXPORT jl_sym_t *jl_loopinfo_sym;
JL_DLLEXPORT jl_sym_t *jl_meta_sym;
JL_DLLEXPORT jl_sym_t *jl_inert_sym;
JL_DLLEXPORT jl_sym_t *jl_polly_sym;
JL_DLLEXPORT jl_sym_t *jl_unused_sym;
JL_DLLEXPORT jl_sym_t *jl_static_parameter_sym;
JL_DLLEXPORT jl_sym_t *jl_inline_sym;
JL_DLLEXPORT jl_sym_t *jl_noinline_sym;
JL_DLLEXPORT jl_sym_t *jl_generated_sym;
JL_DLLEXPORT jl_sym_t *jl_generated_only_sym;
JL_DLLEXPORT jl_sym_t *jl_isdefined_sym;
JL_DLLEXPORT jl_sym_t *jl_propagate_inbounds_sym;
JL_DLLEXPORT jl_sym_t *jl_specialize_sym;
JL_DLLEXPORT jl_sym_t *jl_aggressive_constprop_sym;
JL_DLLEXPORT jl_sym_t *jl_no_constprop_sym;
JL_DLLEXPORT jl_sym_t *jl_purity_sym;
JL_DLLEXPORT jl_sym_t *jl_nospecialize_sym;
JL_DLLEXPORT jl_sym_t *jl_macrocall_sym;
JL_DLLEXPORT jl_sym_t *jl_colon_sym;
JL_DLLEXPORT jl_sym_t *jl_hygienicscope_sym;
JL_DLLEXPORT jl_sym_t *jl_throw_undef_if_not_sym;
JL_DLLEXPORT jl_sym_t *jl_getfield_undefref_sym;
JL_DLLEXPORT jl_sym_t *jl_gc_preserve_begin_sym;
JL_DLLEXPORT jl_sym_t *jl_gc_preserve_end_sym;
JL_DLLEXPORT jl_sym_t *jl_coverageeffect_sym;
JL_DLLEXPORT jl_sym_t *jl_escape_sym;
JL_DLLEXPORT jl_sym_t *jl_aliasscope_sym;
JL_DLLEXPORT jl_sym_t *jl_popaliasscope_sym;
JL_DLLEXPORT jl_sym_t *jl_optlevel_sym;
JL_DLLEXPORT jl_sym_t *jl_thismodule_sym;
JL_DLLEXPORT jl_sym_t *jl_atom_sym;
JL_DLLEXPORT jl_sym_t *jl_statement_sym;
JL_DLLEXPORT jl_sym_t *jl_all_sym;
JL_DLLEXPORT jl_sym_t *jl_compile_sym;
JL_DLLEXPORT jl_sym_t *jl_force_compile_sym;
JL_DLLEXPORT jl_sym_t *jl_infer_sym;
JL_DLLEXPORT jl_sym_t *jl_max_methods_sym;
JL_DLLEXPORT jl_sym_t *jl_atomic_sym;
JL_DLLEXPORT jl_sym_t *jl_not_atomic_sym;
JL_DLLEXPORT jl_sym_t *jl_unordered_sym;
JL_DLLEXPORT jl_sym_t *jl_monotonic_sym;
JL_DLLEXPORT jl_sym_t *jl_acquire_sym;
JL_DLLEXPORT jl_sym_t *jl_release_sym;
JL_DLLEXPORT jl_sym_t *jl_acquire_release_sym;
JL_DLLEXPORT jl_sym_t *jl_sequentially_consistent_sym;
static const uint8_t flisp_system_image[] = {
#include <julia_flisp.boot.inc>
};
typedef struct _jl_ast_context_t {
fl_context_t fl;
fltype_t *jvtype;
value_t true_sym;
value_t false_sym;
value_t error_sym;
value_t null_sym;
value_t ssavalue_sym;
value_t slot_sym;
jl_module_t *module; // context module for `current-julia-module-counter`
struct _jl_ast_context_t *next; // invasive list pointer for getting free contexts
} jl_ast_context_t;
static jl_ast_context_t jl_ast_main_ctx;
#ifdef __clang_gcanalyzer__
jl_ast_context_t *jl_ast_ctx(fl_context_t *fl) JL_GLOBALLY_ROOTED JL_NOTSAFEPOINT;
#else
#define jl_ast_ctx(fl_ctx) container_of(fl_ctx, jl_ast_context_t, fl)
#endif
struct macroctx_stack {
jl_module_t *m;
struct macroctx_stack *parent;
};
static jl_value_t *scm_to_julia(fl_context_t *fl_ctx, value_t e, jl_module_t *mod);
static value_t julia_to_scm(fl_context_t *fl_ctx, jl_value_t *v);
static jl_value_t *jl_expand_macros(jl_value_t *expr, jl_module_t *inmodule, struct macroctx_stack *macroctx, int onelevel, size_t world, int throw_load_error);
static value_t fl_defined_julia_global(fl_context_t *fl_ctx, value_t *args, uint32_t nargs)
{
// tells whether a var is defined in and *by* the current module
argcount(fl_ctx, "defined-julia-global", nargs, 1);
(void)tosymbol(fl_ctx, args[0], "defined-julia-global");
jl_ast_context_t *ctx = jl_ast_ctx(fl_ctx);
jl_sym_t *var = jl_symbol(symbol_name(fl_ctx, args[0]));
jl_binding_t *b = jl_get_module_binding(ctx->module, var);
return (b != NULL && b->owner == ctx->module) ? fl_ctx->T : fl_ctx->F;
}
static value_t fl_current_module_counter(fl_context_t *fl_ctx, value_t *args, uint32_t nargs) JL_NOTSAFEPOINT
{
jl_ast_context_t *ctx = jl_ast_ctx(fl_ctx);
assert(ctx->module);
return fixnum(jl_module_next_counter(ctx->module));
}
static value_t fl_julia_current_file(fl_context_t *fl_ctx, value_t *args, uint32_t nargs) JL_NOTSAFEPOINT
{
return symbol(fl_ctx, jl_filename);
}
static value_t fl_julia_current_line(fl_context_t *fl_ctx, value_t *args, uint32_t nargs) JL_NOTSAFEPOINT
{
return fixnum(jl_lineno);
}
static int jl_is_number(jl_value_t *v)
{
jl_datatype_t *t = (jl_datatype_t*)jl_typeof(v);
for (; t->super != t; t = t->super)
if (t == jl_number_type)
return 1;
return 0;
}
// Check whether v is a scalar for purposes of inlining fused-broadcast
// arguments when lowering; should agree with broadcast.jl on what is a
// scalar. When in doubt, return false, since this is only an optimization.
static value_t fl_julia_scalar(fl_context_t *fl_ctx, value_t *args, uint32_t nargs)
{
argcount(fl_ctx, "julia-scalar?", nargs, 1);
if (fl_isnumber(fl_ctx, args[0]) || fl_isstring(fl_ctx, args[0]))
return fl_ctx->T;
else if (iscvalue(args[0]) && fl_ctx->jl_sym == cv_type((cvalue_t*)ptr(args[0]))) {
jl_value_t *v = *(jl_value_t**)cptr(args[0]);
if (jl_is_number(v) || jl_is_string(v))
return fl_ctx->T;
}
return fl_ctx->F;
}
static jl_value_t *scm_to_julia_(fl_context_t *fl_ctx, value_t e, jl_module_t *mod);
static const builtinspec_t julia_flisp_ast_ext[] = {
{ "defined-julia-global", fl_defined_julia_global }, // TODO: can we kill this safepoint
{ "current-julia-module-counter", fl_current_module_counter },
{ "julia-scalar?", fl_julia_scalar },
{ "julia-current-file", fl_julia_current_file },
{ "julia-current-line", fl_julia_current_line },
{ NULL, NULL }
};
static void jl_init_ast_ctx(jl_ast_context_t *ctx) JL_NOTSAFEPOINT
{
fl_context_t *fl_ctx = &ctx->fl;
fl_init(fl_ctx, 4*1024*1024);
if (fl_load_system_image_str(fl_ctx, (char*)flisp_system_image,
sizeof(flisp_system_image))) {
jl_error("fatal error loading system image");
}
fl_applyn(fl_ctx, 0, symbol_value(symbol(fl_ctx, "__init_globals")));
ctx->jvtype = define_opaque_type(fl_ctx->jl_sym, sizeof(void*), NULL, NULL);
assign_global_builtins(fl_ctx, julia_flisp_ast_ext);
ctx->true_sym = symbol(fl_ctx, "true");
ctx->false_sym = symbol(fl_ctx, "false");
ctx->error_sym = symbol(fl_ctx, "error");
ctx->null_sym = symbol(fl_ctx, "null");
ctx->ssavalue_sym = symbol(fl_ctx, "ssavalue");
ctx->slot_sym = symbol(fl_ctx, "slot");
ctx->module = NULL;
set(symbol(fl_ctx, "*scopewarn-opt*"), fixnum(jl_options.warn_scope));
}
// There should be no GC allocation while holding this lock
static uv_mutex_t flisp_lock;
static jl_ast_context_t *jl_ast_ctx_freed = NULL;
static jl_ast_context_t *jl_ast_ctx_enter(jl_module_t *m) JL_GLOBALLY_ROOTED JL_NOTSAFEPOINT
{
JL_SIGATOMIC_BEGIN();
uv_mutex_lock(&flisp_lock);
jl_ast_context_t *ctx = jl_ast_ctx_freed;
if (ctx != NULL) {
jl_ast_ctx_freed = ctx->next;
ctx->next = NULL;
}
uv_mutex_unlock(&flisp_lock);
if (ctx == NULL) {
// Construct a new one if we can't find any
ctx = (jl_ast_context_t*)calloc(1, sizeof(jl_ast_context_t));
jl_init_ast_ctx(ctx);
}
ctx->module = m;
return ctx;
}
static void jl_ast_ctx_leave(jl_ast_context_t *ctx)
{
uv_mutex_lock(&flisp_lock);
ctx->module = NULL;
ctx->next = jl_ast_ctx_freed;
jl_ast_ctx_freed = ctx;
uv_mutex_unlock(&flisp_lock);
JL_SIGATOMIC_END();
}
void jl_init_flisp(void)
{
if (jl_ast_ctx_freed)
return;
uv_mutex_init(&flisp_lock);
jl_init_ast_ctx(&jl_ast_main_ctx);
// To match the one in jl_ast_ctx_leave
JL_SIGATOMIC_BEGIN();
jl_ast_ctx_leave(&jl_ast_main_ctx);
}
void jl_init_common_symbols(void)
{
jl_empty_sym = jl_symbol("");
jl_call_sym = jl_symbol("call");
jl_invoke_sym = jl_symbol("invoke");
jl_invoke_modify_sym = jl_symbol("invoke_modify");
jl_foreigncall_sym = jl_symbol("foreigncall");
jl_cfunction_sym = jl_symbol("cfunction");
jl_quote_sym = jl_symbol("quote");
jl_inert_sym = jl_symbol("inert");
jl_top_sym = jl_symbol("top");
jl_core_sym = jl_symbol("core");
jl_globalref_sym = jl_symbol("globalref");
jl_line_sym = jl_symbol("line");
jl_lineinfo_sym = jl_symbol("lineinfo");
jl_incomplete_sym = jl_symbol("incomplete");
jl_error_sym = jl_symbol("error");
jl_goto_sym = jl_symbol("goto");
jl_goto_ifnot_sym = jl_symbol("gotoifnot");
jl_return_sym = jl_symbol("return");
jl_lambda_sym = jl_symbol("lambda");
jl_module_sym = jl_symbol("module");
jl_export_sym = jl_symbol("export");
jl_import_sym = jl_symbol("import");
jl_using_sym = jl_symbol("using");
jl_assign_sym = jl_symbol("=");
jl_method_sym = jl_symbol("method");
jl_exc_sym = jl_symbol("the_exception");
jl_enter_sym = jl_symbol("enter");
jl_leave_sym = jl_symbol("leave");
jl_pop_exception_sym = jl_symbol("pop_exception");
jl_new_sym = jl_symbol("new");
jl_splatnew_sym = jl_symbol("splatnew");
jl_new_opaque_closure_sym = jl_symbol("new_opaque_closure");
jl_opaque_closure_method_sym = jl_symbol("opaque_closure_method");
jl_const_sym = jl_symbol("const");
jl_global_sym = jl_symbol("global");
jl_thunk_sym = jl_symbol("thunk");
jl_toplevel_sym = jl_symbol("toplevel");
jl_dot_sym = jl_symbol(".");
jl_as_sym = jl_symbol("as");
jl_colon_sym = jl_symbol(":");
jl_boundscheck_sym = jl_symbol("boundscheck");
jl_inbounds_sym = jl_symbol("inbounds");
jl_newvar_sym = jl_symbol("newvar");
jl_copyast_sym = jl_symbol("copyast");
jl_loopinfo_sym = jl_symbol("loopinfo");
jl_pure_sym = jl_symbol("pure");
jl_meta_sym = jl_symbol("meta");
jl_list_sym = jl_symbol("list");
jl_unused_sym = jl_symbol("#unused#");
jl_slot_sym = jl_symbol("slot");
jl_static_parameter_sym = jl_symbol("static_parameter");
jl_inline_sym = jl_symbol("inline");
jl_noinline_sym = jl_symbol("noinline");
jl_polly_sym = jl_symbol("polly");
jl_propagate_inbounds_sym = jl_symbol("propagate_inbounds");
jl_aggressive_constprop_sym = jl_symbol("aggressive_constprop");
jl_no_constprop_sym = jl_symbol("no_constprop");
jl_purity_sym = jl_symbol("purity");
jl_isdefined_sym = jl_symbol("isdefined");
jl_nospecialize_sym = jl_symbol("nospecialize");
jl_specialize_sym = jl_symbol("specialize");
jl_optlevel_sym = jl_symbol("optlevel");
jl_compile_sym = jl_symbol("compile");
jl_force_compile_sym = jl_symbol("force_compile");
jl_infer_sym = jl_symbol("infer");
jl_max_methods_sym = jl_symbol("max_methods");
jl_macrocall_sym = jl_symbol("macrocall");
jl_escape_sym = jl_symbol("escape");
jl_hygienicscope_sym = jl_symbol("hygienic-scope");
jl_gc_preserve_begin_sym = jl_symbol("gc_preserve_begin");
jl_gc_preserve_end_sym = jl_symbol("gc_preserve_end");
jl_generated_sym = jl_symbol("generated");
jl_generated_only_sym = jl_symbol("generated_only");
jl_throw_undef_if_not_sym = jl_symbol("throw_undef_if_not");
jl_getfield_undefref_sym = jl_symbol("##getfield##");
jl_do_sym = jl_symbol("do");
jl_coverageeffect_sym = jl_symbol("code_coverage_effect");
jl_aliasscope_sym = jl_symbol("aliasscope");
jl_popaliasscope_sym = jl_symbol("popaliasscope");
jl_thismodule_sym = jl_symbol("thismodule");
jl_block_sym = jl_symbol("block");
jl_atom_sym = jl_symbol("atom");
jl_statement_sym = jl_symbol("statement");
jl_all_sym = jl_symbol("all");
jl_atomic_sym = jl_symbol("atomic");
jl_not_atomic_sym = jl_symbol("not_atomic");
jl_unordered_sym = jl_symbol("unordered");
jl_monotonic_sym = jl_symbol("monotonic");
jl_acquire_sym = jl_symbol("acquire");
jl_release_sym = jl_symbol("release");
jl_acquire_release_sym = jl_symbol("acquire_release");
jl_sequentially_consistent_sym = jl_symbol("sequentially_consistent");
}
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_flisp();
jl_ast_context_t *ctx = jl_ast_ctx_enter(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_ctx_leave(ctx);
}
JL_DLLEXPORT void fl_show_profile(void)
{
jl_ast_context_t *ctx = jl_ast_ctx_enter(NULL);
fl_context_t *fl_ctx = &ctx->fl;
fl_applyn(fl_ctx, 0, symbol_value(symbol(fl_ctx, "show-profiles")));
jl_ast_ctx_leave(ctx);
}
JL_DLLEXPORT void fl_clear_profile(void)
{
jl_ast_context_t *ctx = jl_ast_ctx_enter(NULL);
fl_context_t *fl_ctx = &ctx->fl;
fl_applyn(fl_ctx, 0, symbol_value(symbol(fl_ctx, "clear-profiles")));
jl_ast_ctx_leave(ctx);
}
JL_DLLEXPORT void fl_profile(const char *fname)
{
jl_ast_context_t *ctx = jl_ast_ctx_enter(NULL);
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);
}
static jl_sym_t *scmsym_to_julia(fl_context_t *fl_ctx, value_t s)
{
assert(issymbol(s));
if (fl_isgensym(fl_ctx, s)) {
char gsname[16];
char *n = uint2str(&gsname[1], sizeof(gsname)-1,
((gensym_t*)ptr(s))->id, 10);
*(--n) = '#';
return jl_symbol(n);
}
return jl_symbol(symbol_name(fl_ctx, s));
}
static jl_value_t *scm_to_julia(fl_context_t *fl_ctx, value_t e, jl_module_t *mod)
{
jl_value_t *v = NULL;
JL_GC_PUSH1(&v);
JL_TRY {
v = scm_to_julia_(fl_ctx, e, mod);
}
JL_CATCH {
// if expression cannot be converted, replace with error expr
jl_expr_t *ex = jl_exprn(jl_error_sym, 1);
v = (jl_value_t*)ex;
jl_array_ptr_set(ex->args, 0, jl_cstr_to_string("invalid AST"));
}
JL_GC_POP();
return v;
}
extern int64_t conv_to_int64(void *data, numerictype_t tag);
static jl_value_t *scm_to_julia_(fl_context_t *fl_ctx, value_t e, jl_module_t *mod)
{
if (fl_isnumber(fl_ctx, e)) {
int64_t i64;
if (isfixnum(e)) {
i64 = numval(e);
}
else {
assert(iscprim(e));
cprim_t *cp = (cprim_t*)ptr(e);
numerictype_t nt = cp_numtype(cp);
switch (nt) {
case T_DOUBLE:
return (jl_value_t*)jl_box_float64(*(double*)cp_data(cp));
case T_FLOAT:
return (jl_value_t*)jl_box_float32(*(float*)cp_data(cp));
case T_UINT8:
return (jl_value_t*)jl_box_uint8(*(uint8_t*)cp_data(cp));
case T_UINT16:
return (jl_value_t*)jl_box_uint16(*(uint16_t*)cp_data(cp));
case T_UINT32:
return (jl_value_t*)jl_box_uint32(*(uint32_t*)cp_data(cp));
case T_UINT64:
return (jl_value_t*)jl_box_uint64(*(uint64_t*)cp_data(cp));
default:
;
}
i64 = conv_to_int64(cp_data(cp), nt);
}
#ifdef _P64
return (jl_value_t*)jl_box_int64(i64);
#else
if (i64 > (int64_t)S32_MAX || i64 < (int64_t)S32_MIN)
return (jl_value_t*)jl_box_int64(i64);
else
return (jl_value_t*)jl_box_int32((int32_t)i64);
#endif
}
if (issymbol(e))
return (jl_value_t*)scmsym_to_julia(fl_ctx, e);
if (fl_isstring(fl_ctx, e))
return jl_pchar_to_string((char*)cvalue_data(e), cvalue_len(e));
if (iscons(e) || e == fl_ctx->NIL) {
value_t hd;
jl_sym_t *sym;
if (e == fl_ctx->NIL) {
hd = e;
}
else {
hd = car_(e);
if (hd == jl_ast_ctx(fl_ctx)->ssavalue_sym)
return jl_box_ssavalue(numval(car_(cdr_(e))));
else if (hd == jl_ast_ctx(fl_ctx)->slot_sym)
return jl_box_slotnumber(numval(car_(cdr_(e))));
else if (hd == jl_ast_ctx(fl_ctx)->null_sym && llength(e) == 1)
return jl_nothing;
else if (hd == jl_ast_ctx(fl_ctx)->true_sym && llength(e) == 1)
return jl_true;
else if (hd == jl_ast_ctx(fl_ctx)->false_sym && llength(e) == 1)
return jl_false;
else if (hd == fl_ctx->jl_char_sym && llength(e) == 2) {
value_t v = car_(cdr_(e));
if (!(iscprim(v) && cp_class((cprim_t*)ptr(v)) == fl_ctx->uint32type))
jl_error("malformed julia char");
uint32_t c = *(uint32_t*)cp_data((cprim_t*)ptr(v));
return jl_box_char(c);
}
}
if (issymbol(hd))
sym = scmsym_to_julia(fl_ctx, hd);
else
sym = jl_list_sym;
size_t n = llength(e)-1;
if (issymbol(hd))
e = cdr_(e);
else
n++;
// nodes with special representations
jl_value_t *ex = NULL, *temp = NULL;
if (sym == jl_line_sym && (n == 1 || n == 2)) {
jl_value_t *linenum = scm_to_julia_(fl_ctx, car_(e), mod);
jl_value_t *file = jl_nothing;
JL_GC_PUSH2(&linenum, &file);
if (n == 2)
file = scm_to_julia_(fl_ctx, car_(cdr_(e)), mod);
temp = jl_new_struct(jl_linenumbernode_type, linenum, file);
JL_GC_POP();
return temp;
}
else if (sym == jl_lineinfo_sym && n == 5) {
jl_value_t *modu=NULL, *name=NULL, *file=NULL, *linenum=NULL, *inlinedat=NULL;
JL_GC_PUSH5(&modu, &name, &file, &linenum, &inlinedat);
value_t lst = e;
modu = scm_to_julia_(fl_ctx, car_(lst), mod);
lst = cdr_(lst);
name = scm_to_julia_(fl_ctx, car_(lst), mod);
lst = cdr_(lst);
file = scm_to_julia_(fl_ctx, car_(lst), mod);
lst = cdr_(lst);
linenum = scm_to_julia_(fl_ctx, car_(lst), mod);
lst = cdr_(lst);
inlinedat = scm_to_julia_(fl_ctx, car_(lst), mod);
temp = jl_new_struct(jl_lineinfonode_type, modu, name, file, linenum, inlinedat);
JL_GC_POP();
return temp;
}
JL_GC_PUSH2(&ex, &temp);
if (sym == jl_goto_sym) {
ex = scm_to_julia_(fl_ctx, car_(e), mod);
temp = jl_new_struct(jl_gotonode_type, ex);
}
else if (sym == jl_goto_ifnot_sym) {
ex = scm_to_julia_(fl_ctx, car_(e), mod);
temp = scm_to_julia(fl_ctx, car_(cdr_(e)), mod);
temp = jl_new_struct(jl_gotoifnot_type, ex, temp);
}
else if (sym == jl_newvar_sym) {
ex = scm_to_julia_(fl_ctx, car_(e), mod);
temp = jl_new_struct(jl_newvarnode_type, ex);
}
else if (sym == jl_globalref_sym) {
ex = scm_to_julia_(fl_ctx, car_(e), mod);
temp = scm_to_julia_(fl_ctx, car_(cdr_(e)), mod);
assert(jl_is_module(ex));
assert(jl_is_symbol(temp));
temp = jl_module_globalref((jl_module_t*)ex, (jl_sym_t*)temp);
}
else if (sym == jl_top_sym) {
assert(mod && "top should not be generated by the parser");
ex = scm_to_julia_(fl_ctx, car_(e), mod);
assert(jl_is_symbol(ex));
temp = jl_module_globalref(jl_base_relative_to(mod), (jl_sym_t*)ex);
}
else if (sym == jl_core_sym) {
ex = scm_to_julia_(fl_ctx, car_(e), mod);
assert(jl_is_symbol(ex));
temp = jl_module_globalref(jl_core_module, (jl_sym_t*)ex);
}
else if (sym == jl_thismodule_sym) {
temp = (jl_value_t*)mod;
}
else if (iscons(e) && (sym == jl_inert_sym || (sym == jl_quote_sym && (!iscons(car_(e)))))) {
ex = scm_to_julia_(fl_ctx, car_(e), mod);
temp = jl_new_struct(jl_quotenode_type, ex);
}
if (temp) {
JL_GC_POP();
return temp;
}
ex = (jl_value_t*)jl_exprn(sym, n);
size_t i;
for (i = 0; i < n; i++) {
assert(iscons(e));
jl_array_ptr_set(((jl_expr_t*)ex)->args, i, scm_to_julia_(fl_ctx, car_(e), mod));
e = cdr_(e);
}
if (sym == jl_lambda_sym)
ex = (jl_value_t*)jl_new_code_info_from_ir((jl_expr_t*)ex);
JL_GC_POP();
if (sym == jl_list_sym)
return (jl_value_t*)((jl_expr_t*)ex)->args;
return (jl_value_t*)ex;
}
if (iscprim(e) && cp_class((cprim_t*)ptr(e)) == fl_ctx->wchartype) {
uint32_t c, u = *(uint32_t*)cp_data((cprim_t*)ptr(e));
if (u < 0x80) {
c = u << 24;
} else {
c = ((u << 0) & 0x0000003f) | ((u << 2) & 0x00003f00) |
((u << 4) & 0x003f0000) | ((u << 6) & 0x3f000000);
c = u < 0x00000800 ? (c << 16) | 0xc0800000 :
u < 0x00010000 ? (c << 8) | 0xe0808000 :
(c << 0) | 0xf0808080 ;
}
return jl_box_char(c);
}
if (iscvalue(e) && cv_class((cvalue_t*)ptr(e)) == jl_ast_ctx(fl_ctx)->jvtype) {
return *(jl_value_t**)cv_data((cvalue_t*)ptr(e));
}
jl_error("malformed tree");
}
static value_t julia_to_scm_(fl_context_t *fl_ctx, jl_value_t *v, int check_valid);
static value_t julia_to_scm(fl_context_t *fl_ctx, jl_value_t *v)
{
value_t temp;
// need try/catch to reset GC handle stack in case of error
FL_TRY_EXTERN(fl_ctx) {
temp = julia_to_scm_(fl_ctx, v, 1);
}
FL_CATCH_EXTERN(fl_ctx) {
temp = fl_ctx->lasterror;
}
return temp;
}
static void array_to_list(fl_context_t *fl_ctx, jl_array_t *a, value_t *pv, int check_valid)
{
value_t temp;
for(long i=jl_array_len(a)-1; i >= 0; i--) {
*pv = fl_cons(fl_ctx, fl_ctx->NIL, *pv);
temp = julia_to_scm_(fl_ctx, jl_array_ptr_ref(a,i), check_valid);
// note: must be separate statement
car_(*pv) = temp;
}
}
static value_t julia_to_list2(fl_context_t *fl_ctx, jl_value_t *a, jl_value_t *b, int check_valid)
{
value_t sa = julia_to_scm_(fl_ctx, a, check_valid);
fl_gc_handle(fl_ctx, &sa);
value_t sb = julia_to_scm_(fl_ctx, b, check_valid);
value_t l = fl_list2(fl_ctx, sa, sb);
fl_free_gc_handles(fl_ctx, 1);
return l;
}
static int julia_to_scm_noalloc1(fl_context_t *fl_ctx, jl_value_t *v, value_t *retval) JL_NOTSAFEPOINT
{
if (v == NULL)
lerror(fl_ctx, symbol(fl_ctx, "error"), "undefined reference in AST");
else if (jl_is_symbol(v))
*retval = symbol(fl_ctx, jl_symbol_name((jl_sym_t*)v));
else if (v == jl_true)
*retval = fl_cons(fl_ctx, jl_ast_ctx(fl_ctx)->true_sym, fl_ctx->NIL);
else if (v == jl_false)
*retval = fl_cons(fl_ctx, jl_ast_ctx(fl_ctx)->false_sym, fl_ctx->NIL);
else if (v == jl_nothing)
*retval = fl_cons(fl_ctx, jl_ast_ctx(fl_ctx)->null_sym, fl_ctx->NIL);
else
return 0;
return 1;
}
static value_t julia_to_scm_noalloc2(fl_context_t *fl_ctx, jl_value_t *v, int check_valid) JL_NOTSAFEPOINT
{
if (jl_is_long(v) && fits_fixnum(jl_unbox_long(v)))
return fixnum(jl_unbox_long(v));
if (check_valid) {
if (jl_is_ssavalue(v))
lerror(fl_ctx, symbol(fl_ctx, "error"), "SSAValue objects should not occur in an AST");
if (jl_is_slot(v))
lerror(fl_ctx, symbol(fl_ctx, "error"), "Slot objects should not occur in an AST");
}
value_t opaque = cvalue(fl_ctx, jl_ast_ctx(fl_ctx)->jvtype, sizeof(void*));
*(jl_value_t**)cv_data((cvalue_t*)ptr(opaque)) = v;
return opaque;
}
static value_t julia_to_scm_noalloc(fl_context_t *fl_ctx, jl_value_t *v, int check_valid) JL_NOTSAFEPOINT
{
value_t retval;
if (julia_to_scm_noalloc1(fl_ctx, v, &retval))
return retval;
assert(!jl_is_expr(v) &&
!jl_typeis(v, jl_linenumbernode_type) &&
!jl_typeis(v, jl_gotonode_type) &&
!jl_typeis(v, jl_quotenode_type) &&
!jl_typeis(v, jl_newvarnode_type) &&
!jl_typeis(v, jl_globalref_type));
return julia_to_scm_noalloc2(fl_ctx, v, check_valid);
}
static value_t julia_to_list2_noalloc(fl_context_t *fl_ctx, jl_value_t *a, jl_value_t *b, int check_valid) JL_NOTSAFEPOINT
{
value_t sa = julia_to_scm_noalloc(fl_ctx, a, check_valid);
fl_gc_handle(fl_ctx, &sa);
value_t sb = julia_to_scm_noalloc(fl_ctx, b, check_valid);
value_t l = fl_list2(fl_ctx, sa, sb);
fl_free_gc_handles(fl_ctx, 1);
return l;
}
static value_t julia_to_scm_(fl_context_t *fl_ctx, jl_value_t *v, int check_valid)
{
value_t retval;
if (julia_to_scm_noalloc1(fl_ctx, v, &retval))
return retval;
if (jl_is_expr(v)) {
jl_expr_t *ex = (jl_expr_t*)v;
value_t args = fl_ctx->NIL;
fl_gc_handle(fl_ctx, &args);
if (jl_expr_nargs(ex) > 520000 && ex->head != jl_block_sym)
lerror(fl_ctx, symbol(fl_ctx, "error"), "expression too large");
array_to_list(fl_ctx, ex->args, &args, check_valid);
value_t hd = julia_to_scm_(fl_ctx, (jl_value_t*)ex->head, check_valid);
if (ex->head == jl_lambda_sym && jl_expr_nargs(ex)>0 && jl_is_array(jl_exprarg(ex,0))) {
value_t llist = fl_ctx->NIL;
fl_gc_handle(fl_ctx, &llist);
array_to_list(fl_ctx, (jl_array_t*)jl_exprarg(ex,0), &llist, check_valid);
car_(args) = llist;
fl_free_gc_handles(fl_ctx, 1);
}
value_t scmv = fl_cons(fl_ctx, hd, args);
fl_free_gc_handles(fl_ctx, 1);
return scmv;
}
// GC Note: jl_fieldref(v, 0) allocates for GotoNode
// but we don't need a GC root here because julia_to_list2_noalloc
// shouldn't allocate in this case.
if (jl_typeis(v, jl_linenumbernode_type)) {
jl_value_t *file = jl_fieldref_noalloc(v,1);
jl_value_t *line = jl_fieldref(v,0);
value_t args = julia_to_list2_noalloc(fl_ctx, line, file, check_valid);
fl_gc_handle(fl_ctx, &args);
value_t hd = julia_to_scm_(fl_ctx, (jl_value_t*)jl_line_sym, check_valid);
value_t scmv = fl_cons(fl_ctx, hd, args);
fl_free_gc_handles(fl_ctx, 1);
return scmv;
}
if (jl_typeis(v, jl_gotonode_type))
return julia_to_list2_noalloc(fl_ctx, (jl_value_t*)jl_goto_sym, jl_fieldref(v,0), check_valid);
if (jl_typeis(v, jl_quotenode_type))
return julia_to_list2(fl_ctx, (jl_value_t*)jl_inert_sym, jl_fieldref_noalloc(v,0), 0);
if (jl_typeis(v, jl_newvarnode_type))
return julia_to_list2_noalloc(fl_ctx, (jl_value_t*)jl_newvar_sym, jl_fieldref(v,0), check_valid);
if (jl_typeis(v, jl_globalref_type)) {
jl_module_t *m = jl_globalref_mod(v);
jl_sym_t *sym = jl_globalref_name(v);
if (m == jl_core_module)
return julia_to_list2(fl_ctx, (jl_value_t*)jl_core_sym,
(jl_value_t*)sym, check_valid);
value_t args = julia_to_list2(fl_ctx, (jl_value_t*)m, (jl_value_t*)sym, check_valid);
fl_gc_handle(fl_ctx, &args);
value_t hd = julia_to_scm_(fl_ctx, (jl_value_t*)jl_globalref_sym, check_valid);
value_t scmv = fl_cons(fl_ctx, hd, args);
fl_free_gc_handles(fl_ctx, 1);
return scmv;
}
return julia_to_scm_noalloc2(fl_ctx, v, check_valid);
}
// Parse `text` starting at 0-based `offset` and attributing the content to
// `filename`. Return an svec of (parsed_expr, final_offset)
JL_DLLEXPORT jl_value_t *jl_fl_parse(const char *text, size_t text_len,
jl_value_t *filename, size_t lineno,
size_t offset, jl_value_t *options)
{
JL_TIMING(PARSING);
if (offset > text_len) {
jl_value_t *textstr = jl_pchar_to_string(text, text_len);
JL_GC_PUSH1(&textstr);
jl_bounds_error(textstr, jl_box_long(offset+1));
}
jl_sym_t *rule = (jl_sym_t*)options;
if (rule != jl_atom_sym && rule != jl_statement_sym && rule != jl_all_sym) {
jl_error("jl_fl_parse: unrecognized parse options");
}
if (offset != 0 && rule == jl_all_sym) {
jl_error("Parse `all`: offset not supported");
}
jl_ast_context_t *ctx = jl_ast_ctx_enter(NULL);
fl_context_t *fl_ctx = &ctx->fl;
value_t fl_text = cvalue_static_cstrn(fl_ctx, text, text_len);
fl_gc_handle(fl_ctx, &fl_text);
value_t fl_filename = cvalue_static_cstrn(fl_ctx, jl_string_data(filename),
jl_string_len(filename));
fl_gc_handle(fl_ctx, &fl_filename);
value_t fl_expr;
size_t offset1 = 0;
if (rule == jl_all_sym) {
value_t e = fl_applyn(fl_ctx, 3, symbol_value(symbol(fl_ctx, "jl-parse-all")),
fl_text, fl_filename, fixnum(lineno));
fl_expr = e;
offset1 = e == fl_ctx->FL_EOF ? text_len : 0;
}
else {
value_t greedy = rule == jl_statement_sym ? fl_ctx->T : fl_ctx->F;
value_t p = fl_applyn(fl_ctx, 5, symbol_value(symbol(fl_ctx, "jl-parse-one")),
fl_text, fl_filename, fixnum(offset), greedy, fixnum(lineno));
fl_expr = car_(p);
offset1 = tosize(fl_ctx, cdr_(p), "parse");
}
fl_free_gc_handles(fl_ctx, 2);
// Convert to julia values
jl_value_t *expr = NULL, *end_offset = NULL;
JL_GC_PUSH2(&expr, &end_offset);
expr = fl_expr == fl_ctx->FL_EOF ? jl_nothing : scm_to_julia(fl_ctx, fl_expr, NULL);
end_offset = jl_box_long(offset1);
jl_ast_ctx_leave(ctx);
jl_value_t *result = (jl_value_t*)jl_svec2(expr, end_offset);
JL_GC_POP();
return result;
}
// 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(inmodule);
fl_context_t *fl_ctx = &ctx->fl;
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_GC_PUSH1(&result);
jl_ast_ctx_leave(ctx);
JL_GC_POP();
return result;
}
static jl_value_t *jl_call_scm_on_ast_and_loc(const char *funcname, jl_value_t *expr,
jl_module_t *inmodule, const char *file, int line)
{
jl_ast_context_t *ctx = jl_ast_ctx_enter(inmodule);
fl_context_t *fl_ctx = &ctx->fl;
value_t arg = julia_to_scm(fl_ctx, expr);
value_t e = fl_applyn(fl_ctx, 3, symbol_value(symbol(fl_ctx, funcname)), arg,
symbol(fl_ctx, file), fixnum(line));
jl_value_t *result = scm_to_julia(fl_ctx, e, inmodule);
JL_GC_PUSH1(&result);
jl_ast_ctx_leave(ctx);
JL_GC_POP();
return result;
}
// syntax tree accessors
JL_DLLEXPORT jl_value_t *jl_copy_ast(jl_value_t *expr)
{
if (!expr)
return NULL;
if (jl_is_code_info(expr)) {
jl_code_info_t *new_ci = (jl_code_info_t *)expr;
jl_array_t *new_code = NULL;
JL_GC_PUSH2(&new_ci, &new_code);
new_ci = jl_copy_code_info(new_ci);
new_code = jl_array_copy(new_ci->code);
size_t clen = jl_array_len(new_code);
for (int i = 0; i < clen; ++i) {
jl_array_ptr_set(new_code, i, jl_copy_ast(
jl_array_ptr_ref(new_code, i)
));
}
new_ci->code = new_code;
jl_gc_wb(new_ci, new_code);
new_ci->slotnames = jl_array_copy(new_ci->slotnames);
jl_gc_wb(new_ci, new_ci->slotnames);
new_ci->slotflags = jl_array_copy(new_ci->slotflags);
jl_gc_wb(new_ci, new_ci->slotflags);
new_ci->codelocs = (jl_value_t*)jl_array_copy((jl_array_t*)new_ci->codelocs);
jl_gc_wb(new_ci, new_ci->codelocs);
new_ci->linetable = (jl_value_t*)jl_array_copy((jl_array_t*)new_ci->linetable);
jl_gc_wb(new_ci, new_ci->linetable);
new_ci->ssaflags = jl_array_copy(new_ci->ssaflags);
jl_gc_wb(new_ci, new_ci->ssaflags);
if (new_ci->edges != jl_nothing) {
new_ci->edges = (jl_value_t*)jl_array_copy((jl_array_t*)new_ci->edges);
jl_gc_wb(new_ci, new_ci->edges);
}
if (jl_is_array(new_ci->ssavaluetypes)) {
new_ci->ssavaluetypes = (jl_value_t*)jl_array_copy((jl_array_t*)new_ci->ssavaluetypes);
jl_gc_wb(new_ci, new_ci->ssavaluetypes);
}
JL_GC_POP();
return (jl_value_t*)new_ci;
}
if (jl_is_expr(expr)) {
jl_expr_t *e = (jl_expr_t*)expr;
size_t i, l = jl_array_len(e->args);
jl_expr_t *ne = jl_exprn(e->head, l);
JL_GC_PUSH2(&ne, &expr);
for (i = 0; i < l; i++) {
jl_value_t *a = jl_exprarg(e, i);
jl_exprargset(ne, i, jl_copy_ast(a));
}
JL_GC_POP();
return (jl_value_t*)ne;
}
if (jl_is_phinode(expr)) {
jl_array_t *edges = (jl_array_t*)jl_fieldref_noalloc(expr, 0);
jl_array_t *values = (jl_array_t*)jl_fieldref_noalloc(expr, 1);
JL_GC_PUSH2(&edges, &values);
edges = jl_array_copy(edges);
values = jl_array_copy(values);
jl_value_t *ret = jl_new_struct(jl_phinode_type, edges, values);
JL_GC_POP();
return ret;
}
if (jl_is_phicnode(expr)) {
jl_array_t *values = (jl_array_t*)jl_fieldref_noalloc(expr, 0);
JL_GC_PUSH1(&values);
values = jl_array_copy(values);
jl_value_t *ret = jl_new_struct(jl_phinode_type, values);
JL_GC_POP();
return ret;
}
return expr;
}
JL_DLLEXPORT int jl_is_operator(char *sym)
{
jl_ast_context_t *ctx = jl_ast_ctx_enter(NULL);
fl_context_t *fl_ctx = &ctx->fl;
int res = fl_applyn(fl_ctx, 1, symbol_value(symbol(fl_ctx, "operator?")), symbol(fl_ctx, sym)) == fl_ctx->T;
jl_ast_ctx_leave(ctx);
return res;
}
JL_DLLEXPORT int jl_is_unary_operator(char *sym)
{
jl_ast_context_t *ctx = jl_ast_ctx_enter(NULL);
fl_context_t *fl_ctx = &ctx->fl;
int res = fl_applyn(fl_ctx, 1, symbol_value(symbol(fl_ctx, "unary-op?")), symbol(fl_ctx, sym)) == fl_ctx->T;
jl_ast_ctx_leave(ctx);
return res;
}
JL_DLLEXPORT int jl_is_unary_and_binary_operator(char *sym)
{
jl_ast_context_t *ctx = jl_ast_ctx_enter(NULL);
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;
}
JL_DLLEXPORT int jl_is_syntactic_operator(char *sym)
{
jl_ast_context_t *ctx = jl_ast_ctx_enter(NULL);
fl_context_t *fl_ctx = &ctx->fl;
int res = fl_applyn(fl_ctx, 1, symbol_value(symbol(fl_ctx, "syntactic-op?")), symbol(fl_ctx, sym)) == fl_ctx->T;
jl_ast_ctx_leave(ctx);
return res;
}
JL_DLLEXPORT int jl_operator_precedence(char *sym)
{
jl_ast_context_t *ctx = jl_ast_ctx_enter(NULL);
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;
}
int jl_has_meta(jl_array_t *body, jl_sym_t *sym) JL_NOTSAFEPOINT
{
size_t i, l = jl_array_len(body);
for (i = 0; i < l; i++) {
jl_expr_t *stmt = (jl_expr_t*)jl_array_ptr_ref(body, i);
if (jl_is_expr((jl_value_t*)stmt) && stmt->head == jl_meta_sym) {
size_t i, l = jl_array_len(stmt->args);
for (i = 0; i < l; i++)
if (jl_array_ptr_ref(stmt->args, i) == (jl_value_t*)sym)
return 1;
}
}
return 0;
}
static jl_value_t *jl_invoke_julia_macro(jl_array_t *args, jl_module_t *inmodule, jl_module_t **ctx, size_t world, int throw_load_error)
{
jl_task_t *ct = jl_current_task;
JL_TIMING(MACRO_INVOCATION);
size_t nargs = jl_array_len(args) + 1;
JL_NARGSV("macrocall", 3); // macro name, location, and module
jl_value_t **margs;
JL_GC_PUSHARGS(margs, nargs);
int i;
margs[0] = jl_array_ptr_ref(args, 0);
// __source__ argument
jl_value_t *lno = jl_array_ptr_ref(args, 1);
margs[1] = lno;
if (!jl_typeis(lno, jl_linenumbernode_type)) {
margs[1] = jl_new_struct(jl_linenumbernode_type, jl_box_long(0), jl_nothing);
}
margs[2] = (jl_value_t*)inmodule;
for (i = 3; i < nargs; i++)
margs[i] = jl_array_ptr_ref(args, i - 1);
size_t last_age = ct->world_age;
ct->world_age = jl_atomic_load_acquire(&jl_world_counter);
if (ct->world_age > world)
ct->world_age = world;
jl_value_t *result;
JL_TRY {
margs[0] = jl_toplevel_eval(*ctx, margs[0]);
jl_method_instance_t *mfunc = jl_method_lookup(margs, nargs, world);
JL_GC_PROMISE_ROOTED(mfunc);
if (mfunc == NULL) {
jl_method_error(margs[0], &margs[1], nargs, world);
// unreachable
}
*ctx = mfunc->def.method->module;
result = jl_invoke(margs[0], &margs[1], nargs - 1, mfunc);
}
JL_CATCH {
if ((jl_loaderror_type == NULL) || !throw_load_error) {
jl_rethrow();
}
else {
jl_value_t *lno = margs[1];
jl_value_t *file = jl_fieldref(lno, 1);
if (jl_is_symbol(file))
margs[0] = jl_cstr_to_string(jl_symbol_name((jl_sym_t*)file));
else
margs[0] = jl_cstr_to_string("<macrocall>");
margs[1] = jl_fieldref(lno, 0); // extract and allocate line number
jl_rethrow_other(jl_new_struct(jl_loaderror_type, margs[0], margs[1],
jl_current_exception()));
}
}
ct->world_age = last_age;
JL_GC_POP();
return result;
}
static jl_value_t *jl_expand_macros(jl_value_t *expr, jl_module_t *inmodule, struct macroctx_stack *macroctx, int onelevel, size_t world, int throw_load_error)
{
if (!expr || !jl_is_expr(expr))
return expr;
jl_expr_t *e = (jl_expr_t*)expr;
if (e->head == jl_inert_sym ||
e->head == jl_module_sym ||
//e->head == jl_toplevel_sym || // TODO: enable this once julia-expand-macroscope is fixed / removed
e->head == jl_meta_sym) {
return expr;
}
if (e->head == jl_quote_sym && jl_expr_nargs(e) == 1) {
expr = jl_call_scm_on_ast("julia-bq-macro", jl_exprarg(e, 0), inmodule);
JL_GC_PUSH1(&expr);
expr = jl_expand_macros(expr, inmodule, macroctx, onelevel, world, throw_load_error);
JL_GC_POP();
return expr;
}
if (e->head == jl_hygienicscope_sym && jl_expr_nargs(e) == 2) {
struct macroctx_stack newctx;
newctx.m = (jl_module_t*)jl_exprarg(e, 1);
JL_TYPECHK(hygienic-scope, module, (jl_value_t*)newctx.m);
newctx.parent = macroctx;
jl_value_t *a = jl_exprarg(e, 0);
jl_value_t *a2 = jl_expand_macros(a, inmodule, &newctx, onelevel, world, throw_load_error);
if (a != a2)
jl_array_ptr_set(e->args, 0, a2);
return expr;
}
if (e->head == jl_macrocall_sym) {
struct macroctx_stack newctx;
newctx.m = macroctx ? macroctx->m : inmodule;
newctx.parent = macroctx;
jl_value_t *result = jl_invoke_julia_macro(e->args, inmodule, &newctx.m, world, throw_load_error);
jl_value_t *wrap = NULL;
JL_GC_PUSH3(&result, &wrap, &newctx.m);
// copy and wrap the result in `(hygienic-scope ,result ,newctx)
if (jl_is_expr(result) && ((jl_expr_t*)result)->head == jl_escape_sym)
result = jl_exprarg(result, 0);
else
wrap = (jl_value_t*)jl_exprn(jl_hygienicscope_sym, 2);
result = jl_copy_ast(result);
if (!onelevel)
result = jl_expand_macros(result, inmodule, wrap ? &newctx : macroctx, onelevel, world, throw_load_error);
if (wrap) {
jl_exprargset(wrap, 0, result);
jl_exprargset(wrap, 1, newctx.m);
result = wrap;
}
JL_GC_POP();
return result;
}
if (e->head == jl_do_sym && jl_expr_nargs(e) == 2 && jl_is_expr(jl_exprarg(e, 0)) &&
((jl_expr_t*)jl_exprarg(e, 0))->head == jl_macrocall_sym) {
jl_expr_t *mc = (jl_expr_t*)jl_exprarg(e, 0);
size_t nm = jl_expr_nargs(mc);
jl_expr_t *mc2 = jl_exprn(jl_macrocall_sym, nm+1);
JL_GC_PUSH1(&mc2);
jl_exprargset(mc2, 0, jl_exprarg(mc, 0)); // macro name
jl_exprargset(mc2, 1, jl_exprarg(mc, 1)); // location
jl_exprargset(mc2, 2, jl_exprarg(e, 1)); // function argument
size_t j;
for (j = 2; j < nm; j++) {
jl_exprargset(mc2, j+1, jl_exprarg(mc, j));
}
jl_value_t *ret = jl_expand_macros((jl_value_t*)mc2, inmodule, macroctx, onelevel, world, throw_load_error);
JL_GC_POP();
return ret;
}
if (e->head == jl_escape_sym && macroctx) {
macroctx = macroctx->parent;
}
size_t i;
for (i = 0; i < jl_array_len(e->args); i++) {
jl_value_t *a = jl_array_ptr_ref(e->args, i);
jl_value_t *a2 = jl_expand_macros(a, inmodule, macroctx, onelevel, world, throw_load_error);
if (a != a2)
jl_array_ptr_set(e->args, i, a2);
}
return expr;
}
JL_DLLEXPORT jl_value_t *jl_macroexpand(jl_value_t *expr, jl_module_t *inmodule)
{
JL_TIMING(LOWERING);
JL_GC_PUSH1(&expr);
expr = jl_copy_ast(expr);
expr = jl_expand_macros(expr, inmodule, NULL, 0, jl_atomic_load_acquire(&jl_world_counter), 0);
expr = jl_call_scm_on_ast("jl-expand-macroscope", expr, inmodule);
JL_GC_POP();
return expr;
}
JL_DLLEXPORT jl_value_t *jl_macroexpand1(jl_value_t *expr, jl_module_t *inmodule)
{
JL_TIMING(LOWERING);
JL_GC_PUSH1(&expr);
expr = jl_copy_ast(expr);
expr = jl_expand_macros(expr, inmodule, NULL, 1, jl_atomic_load_acquire(&jl_world_counter), 0);
expr = jl_call_scm_on_ast("jl-expand-macroscope", expr, inmodule);
JL_GC_POP();
return expr;
}
// Lower an expression tree into Julia's intermediate-representation.
JL_DLLEXPORT jl_value_t *jl_expand(jl_value_t *expr, jl_module_t *inmodule)
{
return jl_expand_with_loc(expr, inmodule, "none", 0);
}
// Lowering, with starting program location specified
JL_DLLEXPORT jl_value_t *jl_expand_with_loc(jl_value_t *expr, jl_module_t *inmodule,
const char *file, int line)
{
return jl_expand_in_world(expr, inmodule, file, line, ~(size_t)0);
}
// Lowering, with starting program location and worldage specified
JL_DLLEXPORT jl_value_t *jl_expand_in_world(jl_value_t *expr, jl_module_t *inmodule,
const char *file, int line, size_t world)
{
JL_TIMING(LOWERING);
JL_GC_PUSH1(&expr);
expr = jl_copy_ast(expr);
expr = jl_expand_macros(expr, inmodule, NULL, 0, world, 1);
expr = jl_call_scm_on_ast_and_loc("jl-expand-to-thunk", expr, inmodule, file, line);
JL_GC_POP();
return expr;
}
// Same as the above, but printing warnings when applicable
JL_DLLEXPORT jl_value_t *jl_expand_with_loc_warn(jl_value_t *expr, jl_module_t *inmodule,
const char *file, int line)
{
JL_TIMING(LOWERING);
jl_array_t *kwargs = NULL;
JL_GC_PUSH2(&expr, &kwargs);
expr = jl_copy_ast(expr);
expr = jl_expand_macros(expr, inmodule, NULL, 0, ~(size_t)0, 1);
jl_ast_context_t *ctx = jl_ast_ctx_enter(inmodule);
fl_context_t *fl_ctx = &ctx->fl;
value_t arg = julia_to_scm(fl_ctx, expr);
value_t e = fl_applyn(fl_ctx, 4, symbol_value(symbol(fl_ctx, "jl-expand-to-thunk-warn")), arg,
symbol(fl_ctx, file), fixnum(line), fl_ctx->F);
expr = scm_to_julia(fl_ctx, e, inmodule);
jl_ast_ctx_leave(ctx);
jl_sym_t *warn_sym = jl_symbol("warn");
if (jl_is_expr(expr) && ((jl_expr_t*)expr)->head == warn_sym) {
size_t nargs = jl_expr_nargs(expr);
for (int i = 0; i < nargs - 1; i++) {
jl_value_t *warning = jl_exprarg(expr, i);
size_t nargs = 0;
if (jl_is_expr(warning) && ((jl_expr_t*)warning)->head == warn_sym)
nargs = jl_expr_nargs(warning);
int kwargs_len = (int)nargs - 6;
if (nargs < 6 || kwargs_len % 2 != 0) {
jl_error("julia-logmsg: bad argument list - expected "
":warn level (symbol) group (symbol) id file line msg . kwargs");
}
jl_value_t *level = jl_exprarg(warning, 0);
jl_value_t *group = jl_exprarg(warning, 1);
jl_value_t *id = jl_exprarg(warning, 2);
jl_value_t *file = jl_exprarg(warning, 3);
jl_value_t *line = jl_exprarg(warning, 4);
jl_value_t *msg = jl_exprarg(warning, 5);
kwargs = jl_alloc_vec_any(kwargs_len);
for (int i = 0; i < kwargs_len; ++i) {
jl_array_ptr_set(kwargs, i, jl_exprarg(warning, i + 6));
}
JL_TYPECHK(logmsg, long, level);
jl_log(jl_unbox_long(level), NULL, group, id, file, line, (jl_value_t*)kwargs, msg);
}
expr = jl_exprarg(expr, nargs - 1);
}
JL_GC_POP();
return expr;
}
// expand in a context where the expression value is unused
JL_DLLEXPORT jl_value_t *jl_expand_stmt_with_loc(jl_value_t *expr, jl_module_t *inmodule,
const char *file, int line)
{
JL_TIMING(LOWERING);
JL_GC_PUSH1(&expr);
expr = jl_copy_ast(expr);
expr = jl_expand_macros(expr, inmodule, NULL, 0, ~(size_t)0, 1);
expr = jl_call_scm_on_ast_and_loc("jl-expand-to-thunk-stmt", expr, inmodule, file, line);
JL_GC_POP();
return expr;
}
JL_DLLEXPORT jl_value_t *jl_expand_stmt(jl_value_t *expr, jl_module_t *inmodule)
{
return jl_expand_stmt_with_loc(expr, inmodule, "none", 0);
}
//------------------------------------------------------------------------------
// Parsing API and utils for calling parser from runtime
// Internal C entry point to parser
// `text` is passed as a pointer to allow raw non-String buffers to be used
// without copying.
JL_DLLEXPORT jl_value_t *jl_parse(const char *text, size_t text_len, jl_value_t *filename,
size_t lineno, size_t offset, jl_value_t *options)
{
jl_value_t *core_parse = NULL;
if (jl_core_module) {
core_parse = jl_get_global(jl_core_module, jl_symbol("_parse"));
}
if (!core_parse || core_parse == jl_nothing) {
// In bootstrap, directly call the builtin parser.
jl_value_t *result = jl_fl_parse(text, text_len, filename, lineno, offset, options);
return result;
}
jl_value_t **args;
JL_GC_PUSHARGS(args, 6);
args[0] = core_parse;
args[1] = (jl_value_t*)jl_alloc_svec(2);
jl_svecset(args[1], 0, jl_box_uint8pointer((uint8_t*)text));
jl_svecset(args[1], 1, jl_box_long(text_len));
args[2] = filename;
args[3] = jl_box_ulong(lineno);
args[4] = jl_box_ulong(offset);
args[5] = options;
jl_task_t *ct = jl_current_task;
size_t last_age = ct->world_age;
ct->world_age = jl_atomic_load_acquire(&jl_world_counter);
jl_value_t *result = jl_apply(args, 6);
ct->world_age = last_age;
args[0] = result; // root during error checks below
JL_TYPECHK(parse, simplevector, result);
if (jl_svec_len(result) != 2)
jl_error("Result from parser should be `svec(a::Expr, b::Int)`");
JL_TYPECHK(parse, expr, jl_svecref(result, 0));
JL_TYPECHK(parse, long, jl_svecref(result, 1));
JL_GC_POP();
return result;
}
// parse an entire string as a file, reading multiple expressions
JL_DLLEXPORT jl_value_t *jl_parse_all(const char *text, size_t text_len,
const char *filename, size_t filename_len, size_t lineno)
{
jl_value_t *fname = jl_pchar_to_string(filename, filename_len);
JL_GC_PUSH1(&fname);
jl_value_t *p = jl_parse(text, text_len, fname, lineno, 0, (jl_value_t*)jl_all_sym);
JL_GC_POP();
return jl_svecref(p, 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 *text, size_t text_len,
int offset, int greedy)
{
jl_value_t *fname = jl_cstr_to_string("none");
JL_GC_PUSH1(&fname);
jl_value_t *result = jl_parse(text, text_len, fname, 1, offset,
(jl_value_t*)(greedy ? jl_statement_sym : jl_atom_sym));
JL_GC_POP();
return result;
}
// deprecated
JL_DLLEXPORT jl_value_t *jl_parse_input_line(const char *text, size_t text_len,
const char *filename, size_t filename_len)
{
return jl_parse_all(text, text_len, filename, filename_len, 1);
}
#ifdef __cplusplus
}
#endif