Revision 87a946f563ccbfc7be362b2b2c5ed541e05ffaf0 authored by Tim Holy on 08 September 2021, 20:53:14 UTC, committed by GitHub on 08 September 2021, 20:53:14 UTC
1 parent 0ba40b1
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
// MSVC complains about "julia_flisp.boot.inc : error C4335: Mac file format
// detected: please convert the source file to either DOS or UNIX format"
#ifdef _MSC_VER
#pragma warning(disable:4335)
#endif
// head symbols for each expression type
jl_sym_t *call_sym; jl_sym_t *invoke_sym;
jl_sym_t *empty_sym; jl_sym_t *top_sym;
jl_sym_t *module_sym; jl_sym_t *slot_sym;
jl_sym_t *export_sym; jl_sym_t *import_sym;
jl_sym_t *toplevel_sym; jl_sym_t *quote_sym;
jl_sym_t *line_sym; jl_sym_t *incomplete_sym;
jl_sym_t *goto_sym; jl_sym_t *goto_ifnot_sym;
jl_sym_t *return_sym; jl_sym_t *lineinfo_sym;
jl_sym_t *lambda_sym; jl_sym_t *assign_sym;
jl_sym_t *globalref_sym; jl_sym_t *do_sym;
jl_sym_t *method_sym; jl_sym_t *core_sym;
jl_sym_t *enter_sym; jl_sym_t *leave_sym;
jl_sym_t *pop_exception_sym;
jl_sym_t *exc_sym; jl_sym_t *error_sym;
jl_sym_t *new_sym; jl_sym_t *using_sym;
jl_sym_t *splatnew_sym; jl_sym_t *block_sym;
jl_sym_t *new_opaque_closure_sym;
jl_sym_t *opaque_closure_method_sym;
jl_sym_t *const_sym; jl_sym_t *thunk_sym;
jl_sym_t *foreigncall_sym; jl_sym_t *as_sym;
jl_sym_t *global_sym; jl_sym_t *list_sym;
jl_sym_t *dot_sym; jl_sym_t *newvar_sym;
jl_sym_t *boundscheck_sym; jl_sym_t *inbounds_sym;
jl_sym_t *copyast_sym; jl_sym_t *cfunction_sym;
jl_sym_t *pure_sym; jl_sym_t *loopinfo_sym;
jl_sym_t *meta_sym; jl_sym_t *inert_sym;
jl_sym_t *polly_sym; jl_sym_t *unused_sym;
jl_sym_t *static_parameter_sym; jl_sym_t *inline_sym;
jl_sym_t *noinline_sym; jl_sym_t *generated_sym;
jl_sym_t *generated_only_sym; jl_sym_t *isdefined_sym;
jl_sym_t *propagate_inbounds_sym; jl_sym_t *specialize_sym;
jl_sym_t *aggressive_constprop_sym;
jl_sym_t *nospecialize_sym; jl_sym_t *macrocall_sym;
jl_sym_t *colon_sym; jl_sym_t *hygienicscope_sym;
jl_sym_t *throw_undef_if_not_sym; jl_sym_t *getfield_undefref_sym;
jl_sym_t *gc_preserve_begin_sym; jl_sym_t *gc_preserve_end_sym;
jl_sym_t *coverageeffect_sym; jl_sym_t *escape_sym;
jl_sym_t *aliasscope_sym; jl_sym_t *popaliasscope_sym;
jl_sym_t *optlevel_sym; jl_sym_t *thismodule_sym;
jl_sym_t *atom_sym; jl_sym_t *statement_sym; jl_sym_t *all_sym;
jl_sym_t *compile_sym; jl_sym_t *infer_sym;
jl_sym_t *atomic_sym;
jl_sym_t *not_atomic_sym;
jl_sym_t *unordered_sym;
jl_sym_t *monotonic_sym;
jl_sym_t *acquire_sym;
jl_sym_t *release_sym;
jl_sym_t *acquire_release_sym;
jl_sym_t *sequentially_consistent_sym;
static uint8_t flisp_system_image[] = {
#include <julia_flisp.boot.inc>
};
typedef struct _jl_ast_context_list_t {
struct _jl_ast_context_list_t *next;
struct _jl_ast_context_list_t **prev;
} jl_ast_context_list_t;
STATIC_INLINE void jl_ast_context_list_insert(jl_ast_context_list_t **head,
jl_ast_context_list_t *node) JL_NOTSAFEPOINT
{
jl_ast_context_list_t *next = *head;
if (next)
next->prev = &node->next;
node->next = next;
node->prev = head;
*head = node;
}
STATIC_INLINE void jl_ast_context_list_delete(jl_ast_context_list_t *node) JL_NOTSAFEPOINT
{
if (node->next)
node->next->prev = node->prev;
*node->prev = node->next;
}
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_ast_context_list_t list;
int ref;
jl_task_t *task; // the current owner (user) of this jl_ast_context_t
jl_module_t *module; // context module for `current-julia-module-counter`
} jl_ast_context_t;
static jl_ast_context_t jl_ast_main_ctx;
#ifdef __clang_analyzer__
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
#define jl_ast_context_list_item(node) \
container_of(node, jl_ast_context_t, list)
struct macroctx_stack {
jl_module_t *m;
struct macroctx_stack *parent;
};
#define JL_AST_PRESERVE_PUSH(ctx, old, inmodule) \
jl_module_t *(old) = ctx->module; \
ctx->module = (inmodule)
#define JL_AST_PRESERVE_POP(ctx, old) \
ctx->module = (old)
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_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)
{
return symbol(fl_ctx, jl_filename);
}
static value_t fl_julia_current_line(fl_context_t *fl_ctx, value_t *args, uint32_t nargs)
{
return fixnum(jl_lineno);
}
// 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_isa(v,(jl_value_t*)jl_number_type) || 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 value_t fl_julia_logmsg(fl_context_t *fl_ctx, value_t *args, uint32_t nargs)
{
int kwargs_len = (int)nargs - 6;
if (nargs < 6 || kwargs_len % 2 != 0) {
lerror(fl_ctx, fl_ctx->ArgError, "julia-logmsg: bad argument list - expected "
"level (symbol) group (symbol) id file line msg . kwargs");
}
value_t arg_level = args[0];
value_t arg_group = args[1];
value_t arg_id = args[2];
value_t arg_file = args[3];
value_t arg_line = args[4];
value_t arg_msg = args[5];
value_t *arg_kwargs = args + 6;
if (!isfixnum(arg_level) || !issymbol(arg_group) || !issymbol(arg_id) ||
!issymbol(arg_file) || !isfixnum(arg_line) || !fl_isstring(fl_ctx, arg_msg)) {
lerror(fl_ctx, fl_ctx->ArgError,
"julia-logmsg: Unexpected type in argument list");
}
// Abuse scm_to_julia here to convert arguments. This is meant for `Expr`s
// but should be good enough provided we're only passing simple numbers,
// symbols and strings.
jl_value_t *group=NULL, *id=NULL, *file=NULL, *line=NULL, *msg=NULL;
jl_array_t *kwargs=NULL;
JL_GC_PUSH6(&group, &id, &file, &line, &msg, &kwargs);
group = scm_to_julia(fl_ctx, arg_group, NULL);
id = scm_to_julia(fl_ctx, arg_id, NULL);
file = scm_to_julia(fl_ctx, arg_file, NULL);
line = scm_to_julia(fl_ctx, arg_line, NULL);
msg = scm_to_julia(fl_ctx, arg_msg, NULL);
kwargs = jl_alloc_vec_any(kwargs_len);
for (int i = 0; i < kwargs_len; ++i) {
jl_array_ptr_set(kwargs, i, scm_to_julia(fl_ctx, arg_kwargs[i], NULL));
}
jl_log(numval(arg_level), NULL, group, id, file, line, (jl_value_t*)kwargs, msg);
JL_GC_POP();
return fl_ctx->T;
}
static const builtinspec_t julia_flisp_ast_ext[] = {
{ "defined-julia-global", fl_defined_julia_global },
{ "current-julia-module-counter", fl_current_module_counter },
{ "julia-scalar?", fl_julia_scalar },
{ "julia-logmsg", fl_julia_logmsg },
{ "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 *ast_ctx) JL_NOTSAFEPOINT
{
fl_context_t *fl_ctx = &ast_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")));
jl_ast_context_t *ctx = jl_ast_ctx(fl_ctx);
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->task = NULL;
ctx->module = NULL;
set(symbol(fl_ctx, "*depwarn-opt*"), fixnum(jl_options.depwarn));
set(symbol(fl_ctx, "*scopewarn-opt*"), fixnum(jl_options.warn_scope));
}
// There should be no GC allocation while holding this lock
static jl_mutex_t flisp_lock;
static jl_ast_context_list_t *jl_ast_ctx_using = NULL;
static jl_ast_context_list_t *jl_ast_ctx_freed = NULL;
static jl_ast_context_t *jl_ast_ctx_enter(void) JL_GLOBALLY_ROOTED JL_NOTSAFEPOINT
{
jl_task_t *ct = jl_current_task;
JL_SIGATOMIC_BEGIN();
JL_LOCK_NOGC(&flisp_lock);
jl_ast_context_list_t *node;
jl_ast_context_t *ctx;
// First check if the current task is using one of the contexts
for (node = jl_ast_ctx_using;node;(node = node->next)) {
ctx = jl_ast_context_list_item(node);
if (ctx->task == ct) {
ctx->ref++;
JL_UNLOCK_NOGC(&flisp_lock);
return ctx;
}
}
// If not, grab one from the free list
if ((node = jl_ast_ctx_freed)) {
jl_ast_context_list_delete(node);
jl_ast_context_list_insert(&jl_ast_ctx_using, node);
ctx = jl_ast_context_list_item(node);
ctx->ref = 1;
ctx->task = ct;
ctx->module = NULL;
JL_UNLOCK_NOGC(&flisp_lock);
return ctx;
}
// Construct a new one if we can't find any
ctx = (jl_ast_context_t*)calloc(1, sizeof(jl_ast_context_t));
ctx->ref = 1;
ctx->task = ct;
node = &ctx->list;
jl_ast_context_list_insert(&jl_ast_ctx_using, node);
JL_UNLOCK_NOGC(&flisp_lock);
jl_init_ast_ctx(ctx);
return ctx;
}
static void jl_ast_ctx_leave(jl_ast_context_t *ctx)
{
JL_SIGATOMIC_END();
if (--ctx->ref)
return;
JL_LOCK_NOGC(&flisp_lock);
ctx->task = NULL;
jl_ast_context_list_t *node = &ctx->list;
jl_ast_context_list_delete(node);
jl_ast_context_list_insert(&jl_ast_ctx_freed, node);
JL_UNLOCK_NOGC(&flisp_lock);
}
void jl_init_flisp(void)
{
jl_task_t *ct = jl_current_task;
if (jl_ast_ctx_using || jl_ast_ctx_freed)
return;
jl_ast_main_ctx.ref = 1;
jl_ast_main_ctx.task = ct;
jl_ast_context_list_insert(&jl_ast_ctx_using, &jl_ast_main_ctx.list);
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)
{
empty_sym = jl_symbol("");
call_sym = jl_symbol("call");
invoke_sym = jl_symbol("invoke");
foreigncall_sym = jl_symbol("foreigncall");
cfunction_sym = jl_symbol("cfunction");
quote_sym = jl_symbol("quote");
inert_sym = jl_symbol("inert");
top_sym = jl_symbol("top");
core_sym = jl_symbol("core");
globalref_sym = jl_symbol("globalref");
line_sym = jl_symbol("line");
lineinfo_sym = jl_symbol("lineinfo");
incomplete_sym = jl_symbol("incomplete");
error_sym = jl_symbol("error");
goto_sym = jl_symbol("goto");
goto_ifnot_sym = jl_symbol("gotoifnot");
return_sym = jl_symbol("return");
lambda_sym = jl_symbol("lambda");
module_sym = jl_symbol("module");
export_sym = jl_symbol("export");
import_sym = jl_symbol("import");
using_sym = jl_symbol("using");
assign_sym = jl_symbol("=");
method_sym = jl_symbol("method");
exc_sym = jl_symbol("the_exception");
enter_sym = jl_symbol("enter");
leave_sym = jl_symbol("leave");
pop_exception_sym = jl_symbol("pop_exception");
new_sym = jl_symbol("new");
splatnew_sym = jl_symbol("splatnew");
new_opaque_closure_sym = jl_symbol("new_opaque_closure");
opaque_closure_method_sym = jl_symbol("opaque_closure_method");
const_sym = jl_symbol("const");
global_sym = jl_symbol("global");
thunk_sym = jl_symbol("thunk");
toplevel_sym = jl_symbol("toplevel");
dot_sym = jl_symbol(".");
as_sym = jl_symbol("as");
colon_sym = jl_symbol(":");
boundscheck_sym = jl_symbol("boundscheck");
inbounds_sym = jl_symbol("inbounds");
newvar_sym = jl_symbol("newvar");
copyast_sym = jl_symbol("copyast");
loopinfo_sym = jl_symbol("loopinfo");
pure_sym = jl_symbol("pure");
meta_sym = jl_symbol("meta");
list_sym = jl_symbol("list");
unused_sym = jl_symbol("#unused#");
slot_sym = jl_symbol("slot");
static_parameter_sym = jl_symbol("static_parameter");
inline_sym = jl_symbol("inline");
noinline_sym = jl_symbol("noinline");
polly_sym = jl_symbol("polly");
propagate_inbounds_sym = jl_symbol("propagate_inbounds");
aggressive_constprop_sym = jl_symbol("aggressive_constprop");
isdefined_sym = jl_symbol("isdefined");
nospecialize_sym = jl_symbol("nospecialize");
specialize_sym = jl_symbol("specialize");
optlevel_sym = jl_symbol("optlevel");
compile_sym = jl_symbol("compile");
infer_sym = jl_symbol("infer");
macrocall_sym = jl_symbol("macrocall");
escape_sym = jl_symbol("escape");
hygienicscope_sym = jl_symbol("hygienic-scope");
gc_preserve_begin_sym = jl_symbol("gc_preserve_begin");
gc_preserve_end_sym = jl_symbol("gc_preserve_end");
generated_sym = jl_symbol("generated");
generated_only_sym = jl_symbol("generated_only");
throw_undef_if_not_sym = jl_symbol("throw_undef_if_not");
getfield_undefref_sym = jl_symbol("##getfield##");
do_sym = jl_symbol("do");
coverageeffect_sym = jl_symbol("code_coverage_effect");
aliasscope_sym = jl_symbol("aliasscope");
popaliasscope_sym = jl_symbol("popaliasscope");
thismodule_sym = jl_symbol("thismodule");
block_sym = jl_symbol("block");
atom_sym = jl_symbol("atom");
statement_sym = jl_symbol("statement");
all_sym = jl_symbol("all");
atomic_sym = jl_symbol("atomic");
not_atomic_sym = jl_symbol("not_atomic");
unordered_sym = jl_symbol("unordered");
monotonic_sym = jl_symbol("monotonic");
acquire_sym = jl_symbol("acquire");
release_sym = jl_symbol("release");
acquire_release_sym = jl_symbol("acquire_release");
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_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);
}
JL_DLLEXPORT void fl_show_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, "show-profiles")));
jl_ast_ctx_leave(ctx);
}
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);
}
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);
}
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(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;
}
if (issymbol(hd))
sym = scmsym_to_julia(fl_ctx, hd);
else
sym = 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 == 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 == 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 == goto_sym) {
ex = scm_to_julia_(fl_ctx, car_(e), mod);
temp = jl_new_struct(jl_gotonode_type, ex);
}
else if (sym == 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 == newvar_sym) {
ex = scm_to_julia_(fl_ctx, car_(e), mod);
temp = jl_new_struct(jl_newvarnode_type, ex);
}
else if (sym == 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 == 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 == 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 == thismodule_sym) {
temp = (jl_value_t*)mod;
}
else if (iscons(e) && (sym == inert_sym || (sym == 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 == lambda_sym)
ex = (jl_value_t*)jl_new_code_info_from_ir((jl_expr_t*)ex);
JL_GC_POP();
if (sym == 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 != 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 == 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*)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*)goto_sym, jl_fieldref(v,0), check_valid);
if (jl_typeis(v, jl_quotenode_type))
return julia_to_list2(fl_ctx, (jl_value_t*)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*)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*)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*)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 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 != atom_sym && rule != statement_sym && rule != all_sym) {
jl_error("jl_fl_parse: unrecognized parse options");
}
if (offset != 0 && rule == all_sym) {
jl_error("Parse `all`: offset not supported");
}
jl_ast_context_t *ctx = jl_ast_ctx_enter();
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 == all_sym) {
value_t e = fl_applyn(fl_ctx, 2, symbol_value(symbol(fl_ctx, "jl-parse-all")),
fl_text, fl_filename);
fl_expr = e;
offset1 = e == fl_ctx->FL_EOF ? text_len : 0;
}
else {
value_t greedy = rule == statement_sym ? fl_ctx->T : fl_ctx->F;
value_t p = fl_applyn(fl_ctx, 4, symbol_value(symbol(fl_ctx, "jl-parse-one")),
fl_text, fl_filename, fixnum(offset), greedy);
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();
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_GC_PUSH1(&result);
JL_AST_PRESERVE_POP(ctx, old_roots);
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();
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, 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_PRESERVE_POP(ctx, old_roots);
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();
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();
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();
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();
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();
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 == 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 = world < jl_world_counter ? world : jl_world_counter;
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 == inert_sym ||
e->head == module_sym ||
//e->head == toplevel_sym || // TODO: enable this once julia-expand-macroscope is fixed / removed
e->head == meta_sym) {
return expr;
}
if (e->head == 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 == 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 == 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 == escape_sym)
result = jl_exprarg(result, 0);
else
wrap = (jl_value_t*)jl_exprn(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 == do_sym && jl_expr_nargs(e) == 2 && jl_is_expr(jl_exprarg(e, 0)) &&
((jl_expr_t*)jl_exprarg(e, 0))->head == 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(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 == 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_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_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_GC_PUSH1(&expr);
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();
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, 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_PRESERVE_POP(ctx, old_roots);
jl_ast_ctx_leave(ctx);
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 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, offset, options);
return result;
}
jl_value_t **args;
JL_GC_PUSHARGS(args, 5);
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(offset);
args[4] = options;
jl_task_t *ct = jl_current_task;
size_t last_age = ct->world_age;
ct->world_age = jl_world_counter;
jl_value_t *result = jl_apply(args, 5);
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)
{
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, 0, (jl_value_t*)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, offset,
(jl_value_t*)(greedy ? statement_sym : 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);
}
#ifdef __cplusplus
}
#endif
![swh spinner](/static/img/swh-spinner.gif)
Computing file changes ...