static jl_value_t *expr_type(jl_value_t *e, jl_codectx_t *ctx)
{
if (jl_is_expr(e))
return ((jl_expr_t*)e)->etype;
if (jl_is_symbolnode(e))
return jl_symbolnode_type(e);
if (jl_is_quotenode(e))
return (jl_value_t*)jl_typeof(jl_fieldref(e,0));
if (jl_is_symbol(e))
return (jl_value_t*)jl_any_type;
if (jl_is_lambda_info(e))
return (jl_value_t*)jl_function_type;
if (jl_is_topnode(e)) {
jl_binding_t *b = jl_get_binding(ctx->module,
(jl_sym_t*)jl_fieldref(e,0));
if (!b || !b->value)
return jl_top_type;
if (b->constp)
e = b->value;
else
return (jl_value_t*)jl_any_type;
}
if (jl_is_getfieldnode(e))
return jl_getfieldnode_type(e);
if (jl_is_some_tag_type(e))
return (jl_value_t*)jl_wrap_Type(e);
return (jl_value_t*)jl_typeof(e);
}
JL_DLLEXPORT jl_value_t *jl_cglobal(jl_value_t *v, jl_value_t *ty)
{
JL_TYPECHK(cglobal, type, ty);
jl_value_t *rt =
v == (jl_value_t*)jl_void_type ? (jl_value_t*)jl_voidpointer_type : // a common case
(jl_value_t*)jl_apply_type_((jl_value_t*)jl_pointer_type, &ty, 1);
if (!jl_is_leaf_type(rt))
jl_error("cglobal: type argument not a leaftype");
if (jl_is_tuple(v) && jl_nfields(v) == 1)
v = jl_fieldref(v, 0);
if (jl_is_pointer(v))
return jl_reinterpret(rt, v);
char *f_lib = NULL;
if (jl_is_tuple(v) && jl_nfields(v) > 1) {
jl_value_t *t1 = jl_fieldref(v, 1);
v = jl_fieldref(v, 0);
if (jl_is_symbol(t1))
f_lib = jl_symbol_name((jl_sym_t*)t1);
else if (jl_is_string(t1))
f_lib = jl_string_data(t1);
else
JL_TYPECHK(cglobal, symbol, t1)
}
JL_DLLEXPORT jl_value_t *jl_cglobal(jl_value_t *v, jl_value_t *ty)
{
JL_TYPECHK(cglobal, type, ty);
JL_GC_PUSH1(&v);
jl_value_t *rt =
ty == (jl_value_t*)jl_void_type ? (jl_value_t*)jl_voidpointer_type : // a common case
(jl_value_t*)jl_apply_type1((jl_value_t*)jl_pointer_type, ty);
JL_GC_PROMISE_ROOTED(rt); // (JL_ALWAYS_LEAFTYPE)
if (!jl_is_concrete_type(rt))
jl_error("cglobal: type argument not concrete");
if (jl_is_tuple(v) && jl_nfields(v) == 1)
v = jl_fieldref(v, 0);
if (jl_is_pointer(v)) {
v = jl_bitcast(rt, v);
JL_GC_POP();
return v;
}
char *f_lib = NULL;
if (jl_is_tuple(v) && jl_nfields(v) > 1) {
jl_value_t *t1 = jl_fieldref_noalloc(v, 1);
v = jl_fieldref(v, 0);
if (jl_is_symbol(t1))
f_lib = jl_symbol_name((jl_sym_t*)t1);
else if (jl_is_string(t1))
f_lib = jl_string_data(t1);
else
JL_TYPECHK(cglobal, symbol, t1)
}
static jl_value_t *expr_type(jl_value_t *e, jl_codectx_t *ctx)
{
if (jl_is_expr(e))
return ((jl_expr_t*)e)->etype;
if (jl_is_symbolnode(e))
return jl_symbolnode_type(e);
if (jl_is_quotenode(e))
return (jl_value_t*)jl_typeof(jl_fieldref(e,0));
if (jl_is_lambda_info(e))
return (jl_value_t*)jl_function_type;
if (jl_is_getfieldnode(e)) {
jl_value_t *v = static_eval(e, ctx);
if (v == NULL)
return jl_getfieldnode_type(e);
e = v;
goto type_of_constant;
}
if (jl_is_topnode(e)) {
e = jl_fieldref(e,0);
jl_binding_t *b = jl_get_binding(topmod(ctx), (jl_sym_t*)e);
if (!b || !b->value)
return jl_top_type;
if (b->constp) {
e = b->value;
goto type_of_constant;
}
else {
return (jl_value_t*)jl_any_type;
}
}
if (jl_is_symbol(e)) {
if (jl_is_symbol(e)) {
if (is_global((jl_sym_t*)e, ctx)) {
// look for static parameter
for(size_t i=0; i < jl_tuple_len(ctx->sp); i+=2) {
assert(jl_is_symbol(jl_tupleref(ctx->sp, i)));
if (e == jl_tupleref(ctx->sp, i)) {
e = jl_tupleref(ctx->sp, i+1);
goto type_of_constant;
}
}
}
else {
return (jl_value_t*)jl_any_type;
}
}
jl_binding_t *b = jl_get_binding(ctx->module, (jl_sym_t*)e);
if (!b || !b->value)
return jl_top_type;
if (b->constp)
e = b->value;
else
return (jl_value_t*)jl_any_type;
}
type_of_constant:
if (jl_is_some_tag_type(e))
return (jl_value_t*)jl_wrap_Type(e);
return (jl_value_t*)jl_typeof(e);
}
static value_t julia_to_scm(jl_value_t *v)
{
if (jl_is_symbol(v)) {
return symbol(((jl_sym_t*)v)->name);
}
if (v == jl_true) {
return FL_T;
}
if (v == jl_false) {
return FL_F;
}
if (jl_is_expr(v)) {
jl_expr_t *ex = (jl_expr_t*)v;
value_t args = array_to_list(ex->args);
fl_gc_handle(&args);
value_t hd = julia_to_scm((jl_value_t*)ex->head);
value_t scmv = fl_cons(hd, args);
fl_free_gc_handles(1);
return scmv;
}
if (jl_typeis(v, jl_linenumbernode_type)) {
return fl_cons(julia_to_scm((jl_value_t*)line_sym),
fl_cons(julia_to_scm(jl_fieldref(v,0)),
FL_NIL));
}
if (jl_typeis(v, jl_labelnode_type)) {
return fl_cons(julia_to_scm((jl_value_t*)label_sym),
fl_cons(julia_to_scm(jl_fieldref(v,0)),
FL_NIL));
}
if (jl_typeis(v, jl_gotonode_type)) {
return fl_cons(julia_to_scm((jl_value_t*)goto_sym),
fl_cons(julia_to_scm(jl_fieldref(v,0)),
FL_NIL));
}
if (jl_typeis(v, jl_quotenode_type)) {
return fl_cons(julia_to_scm((jl_value_t*)quote_sym),
fl_cons(julia_to_scm(jl_fieldref(v,0)),
FL_NIL));
}
if (jl_typeis(v, jl_topnode_type)) {
return fl_cons(julia_to_scm((jl_value_t*)top_sym),
fl_cons(julia_to_scm(jl_fieldref(v,0)),
FL_NIL));
}
if (jl_is_long(v) && fits_fixnum(jl_unbox_long(v))) {
return fixnum(jl_unbox_long(v));
}
if (jl_typeis(v,jl_array_any_type)) {
return array_to_list((jl_array_t*)v);
}
value_t opaque = cvalue(jvtype, sizeof(void*));
*(jl_value_t**)cv_data((cvalue_t*)ptr(opaque)) = v;
return opaque;
}
static jl_value_t *jl_invoke_julia_macro(jl_array_t *args, jl_module_t *inmodule, jl_module_t **ctx)
{
jl_ptls_t ptls = jl_get_ptls_states();
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 = ptls->world_age;
size_t world = jl_world_counter;
ptls->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(jl_gf_mtable(margs[0]), margs, nargs, 1, world);
if (mfunc == NULL) {
jl_method_error((jl_function_t*)margs[0], margs, nargs, world);
// unreachable
}
*ctx = mfunc->def.method->module;
result = mfunc->invoke(mfunc, margs, nargs);
}
JL_CATCH {
if (jl_loaderror_type == NULL) {
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],
ptls->exception_in_transit));
}
}
ptls->world_age = last_age;
JL_GC_POP();
return result;
}
static value_t julia_to_scm_(fl_context_t *fl_ctx, jl_value_t *v)
{
if (jl_is_symbol(v))
return symbol(fl_ctx, jl_symbol_name((jl_sym_t*)v));
if (v == jl_true)
return jl_ast_ctx(fl_ctx)->true_sym;
if (v == jl_false)
return jl_ast_ctx(fl_ctx)->false_sym;
if (v == jl_nothing)
return fl_cons(fl_ctx, jl_ast_ctx(fl_ctx)->null_sym, fl_ctx->NIL);
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);
array_to_list(fl_ctx, ex->args, &args);
value_t hd = julia_to_scm_(fl_ctx, (jl_value_t*)ex->head);
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);
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) allocate for LabelNode, GotoNode
// but we don't need a GC root here because julia_to_list2
// shouldn't allocate in this case.
if (jl_typeis(v, jl_labelnode_type))
return julia_to_list2(fl_ctx, (jl_value_t*)label_sym, jl_fieldref(v,0));
if (jl_typeis(v, jl_linenumbernode_type))
return julia_to_list2(fl_ctx, (jl_value_t*)line_sym, jl_fieldref(v,0));
if (jl_typeis(v, jl_gotonode_type))
return julia_to_list2(fl_ctx, (jl_value_t*)goto_sym, jl_fieldref(v,0));
if (jl_typeis(v, jl_quotenode_type))
return julia_to_list2(fl_ctx, (jl_value_t*)inert_sym, jl_fieldref(v,0));
if (jl_typeis(v, jl_newvarnode_type))
return julia_to_list2(fl_ctx, (jl_value_t*)newvar_sym, jl_fieldref(v,0));
if (jl_is_long(v) && fits_fixnum(jl_unbox_long(v)))
return fixnum(jl_unbox_long(v));
if (jl_is_ssavalue(v))
jl_error("SSAValue objects should not occur in an AST");
if (jl_is_slot(v))
jl_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;
}
jl_value_t *jl_readuntil(ios_t *s, uint8_t delim)
{
jl_array_t *a;
// manually inlined common case
char *pd = (char*)memchr(s->buf+s->bpos, delim, s->size - s->bpos);
if (pd) {
size_t n = pd-(s->buf+s->bpos)+1;
a = jl_alloc_array_1d(jl_array_uint8_type, n);
memcpy(jl_array_data(a), s->buf+s->bpos, n);
s->bpos += n;
}
else {
a = jl_alloc_array_1d(jl_array_uint8_type, 80);
ios_t dest;
jl_ios_mem(&dest, 0);
ios_setbuf(&dest, a->data, 80, 0);
size_t n = ios_copyuntil(&dest, s, delim);
if (dest.buf != a->data) {
a = jl_takebuf_array(&dest);
}
else {
a->length = n;
a->nrows = n;
((char*)a->data)[n] = '\0';
}
}
JL_GC_PUSH(&a);
jl_struct_type_t* string_type = u8_isvalid(a->data, a->length) == 1 ? // ASCII
jl_ascii_string_type : jl_utf8_string_type;
jl_value_t *str = alloc_2w();
str->type = (jl_type_t*)string_type;
jl_fieldref(str,0) = (jl_value_t*)a;
JL_GC_POP();
return str;
}
size_t td_jl_get_length(void *v)
{
if (jl_is_array(v))
return jl_array_len(v);
if (jl_is_byte_string(v))
return jl_array_len(jl_fieldref(v,0));
return 1;
}
static int exec_program(void)
{
int err = 0;
again: ;
JL_TRY {
jl_register_toplevel_eh();
if (err) {
//jl_lisp_prompt();
//return 1;
jl_value_t *errs = jl_stderr_obj();
jl_value_t *e = jl_exception_in_transit;
if (errs != NULL) {
jl_show(jl_stderr_obj(), e);
}
else {
while (1) {
if (jl_typeof(e) == (jl_type_t*)jl_loaderror_type) {
e = jl_fieldref(e, 2);
// TODO: show file and line
}
else if (jl_typeof(e) == (jl_type_t*)jl_backtrace_type) {
e = jl_fieldref(e, 0);
}
else break;
}
if (jl_typeof(e) == (jl_type_t*)jl_errorexception_type) {
ios_printf(ios_stderr, "error during bootstrap: %s\n",
jl_string_data(jl_fieldref(e,0)));
}
else {
ios_printf(ios_stderr, "error during bootstrap\n");
}
}
ios_printf(ios_stderr, "\n");
JL_EH_POP();
return 1;
}
jl_load(program);
}
JL_CATCH {
err = 1;
goto again;
}
return 0;
}
static jl_value_t *expr_type(jl_value_t *e)
{
if (jl_is_expr(e))
return ((jl_expr_t*)e)->etype;
if (jl_is_symbolnode(e))
return jl_symbolnode_type(e);
if (jl_is_topnode(e))
return jl_fieldref(e,1);
if (jl_is_quotenode(e))
return (jl_value_t*)jl_typeof(jl_fieldref(e,0));
if (jl_is_symbol(e))
return (jl_value_t*)jl_any_type;
if (jl_is_lambda_info(e))
return (jl_value_t*)jl_any_func;
if (jl_is_some_tag_type(e))
return (jl_value_t*)jl_wrap_Type(e);
return (jl_value_t*)jl_typeof(e);
}
static int type_contains(jl_value_t *ty, jl_value_t *x)
{
if (ty == x) return 1;
if (jl_is_uniontype(ty))
return svec_contains((jl_svec_t*)jl_fieldref(ty,0), x);
if (jl_is_datatype(ty))
return svec_contains(((jl_datatype_t*)ty)->parameters, x);
return 0;
}
jl_array_t *jl_new_array(jl_value_t *atype, jl_value_t *dims)
{
size_t ndims = jl_nfields(dims);
size_t *adims = (size_t*)alloca(ndims*sizeof(size_t));
size_t i;
for(i=0; i < ndims; i++)
adims[i] = jl_unbox_long(jl_fieldref(dims,i));
return _new_array(atype, ndims, adims);
}
jl_value_t *jl_array_to_string(jl_array_t *a)
{
// TODO: check type of array?
jl_struct_type_t* string_type = u8_isvalid(a->data, a->length) == 1 ? // ASCII
jl_ascii_string_type : jl_utf8_string_type;
jl_value_t *s = alloc_2w();
s->type = (jl_type_t*)string_type;
jl_fieldref(s,0) = (jl_value_t*)a;
return s;
}
DLLEXPORT uptrint_t jl_object_id(jl_value_t *v)
{
if (jl_is_symbol(v))
return ((jl_sym_t*)v)->hash;
jl_value_t *tv = (jl_value_t*)jl_typeof(v);
if (jl_is_bits_type(tv)) {
size_t nb = jl_bitstype_nbits(tv)/8;
uptrint_t h = inthash((uptrint_t)tv);
switch (nb) {
case 1:
return int32hash(*(int8_t*)jl_bits_data(v) ^ h);
case 2:
return int32hash(*(int16_t*)jl_bits_data(v) ^ h);
case 4:
return int32hash(*(int32_t*)jl_bits_data(v) ^ h);
case 8:
return hash64(*(int64_t*)jl_bits_data(v) ^ h);
default:
#ifdef __LP64__
return h ^ memhash((char*)jl_bits_data(v), nb);
#else
return h ^ memhash32((char*)jl_bits_data(v), nb);
#endif
}
}
if (tv == (jl_value_t*)jl_union_kind) {
#ifdef __LP64__
return jl_object_id(jl_fieldref(v,0))^0xA5A5A5A5A5A5A5A5L;
#else
return jl_object_id(jl_fieldref(v,0))^0xA5A5A5A5;
#endif
}
if (jl_is_struct_type(tv))
return inthash((uptrint_t)v);
assert(jl_is_tuple(v));
uptrint_t h = 0;
size_t l = jl_tuple_len(v);
for(size_t i = 0; i < l; i++) {
uptrint_t u = jl_object_id(jl_tupleref(v,i));
h = bitmix(h, u);
}
return h;
}
static jl_value_t *eval_body(jl_array_t *stmts, jl_value_t **locals, size_t nl,
int start)
{
jl_savestate_t __ss;
jl_jmp_buf __handlr;
size_t i=start;
while (1) {
jl_value_t *stmt = jl_cellref(stmts,i);
if (jl_is_gotonode(stmt)) {
i = label_idx(jl_fieldref(stmt,0), stmts);
continue;
}
if (jl_is_expr(stmt)) {
jl_sym_t *head = ((jl_expr_t*)stmt)->head;
if (head == goto_ifnot_sym) {
jl_value_t *cond = eval(jl_exprarg(stmt,0), locals, nl);
if (cond == jl_false) {
i = label_idx(jl_exprarg(stmt,1), stmts);
continue;
}
else if (cond != jl_true) {
jl_type_error_rt("toplevel", "if",
(jl_value_t*)jl_bool_type, cond);
}
}
else if (head == return_sym) {
return eval(jl_exprarg(stmt,0), locals, nl);
}
else if (head == enter_sym) {
jl_enter_handler(&__ss, &__handlr);
if (!jl_setjmp(__handlr,1)) {
return eval_body(stmts, locals, nl, i+1);
}
else {
i = label_idx(jl_exprarg(stmt,0), stmts);
continue;
}
}
else if (head == leave_sym) {
int hand_n_leave = jl_unbox_long(jl_exprarg(stmt,0));
jl_pop_handler(hand_n_leave);
}
else {
eval(stmt, locals, nl);
}
}
else {
eval(stmt, locals, nl);
}
i++;
}
assert(0);
return NULL;
}
DLLEXPORT jl_value_t *jl_copy_ast(jl_value_t *expr)
{
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 = NULL;
JL_GC_PUSH2(&ne, &expr);
ne = jl_exprn(e->head, l);
if (l == 0) {
ne->args = jl_alloc_cell_1d(0);
}
else {
for(i=0; i < l; i++)
jl_exprarg(ne, i) = jl_copy_ast(jl_exprarg(e,i));
}
JL_GC_POP();
return (jl_value_t*)ne;
}
else if (jl_typeis(expr,jl_array_any_type)) {
jl_array_t *a = (jl_array_t*)expr;
size_t i, l = jl_array_len(a);
jl_array_t *na = NULL;
JL_GC_PUSH2(&na, &expr);
na = jl_alloc_cell_1d(l);
for(i=0; i < l; i++)
jl_cellset(na, i, jl_copy_ast(jl_cellref(a,i)));
JL_GC_POP();
return (jl_value_t*)na;
}
else if (jl_is_quotenode(expr)) {
if (jl_is_symbol(jl_fieldref(expr,0)))
return expr;
jl_value_t *q = NULL;
JL_GC_PUSH2(&q, &expr);
q = jl_copy_ast(jl_fieldref(expr,0));
jl_value_t *v = jl_new_struct(jl_quotenode_type, q);
JL_GC_POP();
return v;
}
return expr;
}
DLLEXPORT
jl_lambda_info_t *jl_new_lambda_info(jl_value_t *ast, jl_svec_t *sparams, jl_module_t *ctx)
{
jl_lambda_info_t *li =
(jl_lambda_info_t*)newobj((jl_value_t*)jl_lambda_info_type,
NWORDS(sizeof(jl_lambda_info_t)));
li->ast = ast;
li->file = null_sym;
li->line = 0;
if (ast != NULL && jl_is_expr(ast)) {
jl_value_t *body1 = skip_meta(jl_lam_body((jl_expr_t*)ast)->args);
if (jl_is_linenode(body1)) {
li->file = (jl_sym_t*)jl_fieldref(body1, 0);
li->line = jl_unbox_long(jl_fieldref(body1, 1));
}
}
li->module = ctx;
li->sparams = sparams;
li->tfunc = jl_nothing;
li->fptr = &jl_trampoline;
li->roots = NULL;
li->functionObject = NULL;
li->specFunctionObject = NULL;
li->cFunctionList = NULL;
li->functionID = 0;
li->specFunctionID = 0;
li->specTypes = NULL;
li->inferred = 0;
li->inInference = 0;
li->inCompile = 0;
li->unspecialized = NULL;
li->specializations = NULL;
li->name = anonymous_sym;
li->def = li;
li->capt = NULL;
return li;
}
int jl_egal(jl_value_t *a, jl_value_t *b)
{
if (a == b)
return 1;
jl_value_t *ta = (jl_value_t*)jl_typeof(a);
if (ta != (jl_value_t*)jl_typeof(b))
return 0;
if (jl_is_bits_type(ta)) {
size_t nb = jl_bitstype_nbits(ta)/8;
switch (nb) {
case 1:
return *(int8_t*)jl_bits_data(a) == *(int8_t*)jl_bits_data(b);
case 2:
return *(int16_t*)jl_bits_data(a) == *(int16_t*)jl_bits_data(b);
case 4:
return *(int32_t*)jl_bits_data(a) == *(int32_t*)jl_bits_data(b);
case 8:
return *(int64_t*)jl_bits_data(a) == *(int64_t*)jl_bits_data(b);
default:
return memcmp(jl_bits_data(a), jl_bits_data(b), nb)==0;
}
}
if (jl_is_tuple(a)) {
size_t l = jl_tuple_len(a);
if (l != jl_tuple_len(b))
return 0;
for(size_t i=0; i < l; i++) {
if (!jl_egal(jl_tupleref(a,i),jl_tupleref(b,i)))
return 0;
}
return 1;
}
if (ta == (jl_value_t*)jl_union_kind)
return jl_egal(jl_fieldref(a,0), jl_fieldref(b,0));
return 0;
}
static int has_intrinsics(jl_expr_t *e)
{
jl_value_t *e0 = jl_exprarg(e,0);
if (e->head == call_sym &&
((jl_is_symbol(e0) && is_intrinsic((jl_sym_t*)e0)) ||
(jl_is_topnode(e0) && is_intrinsic((jl_sym_t*)jl_fieldref(e0,0)))))
return 1;
int i;
for(i=0; i < e->args->length; i++) {
jl_value_t *a = jl_exprarg(e,i);
if (jl_is_expr(a) && has_intrinsics((jl_expr_t*)a))
return 1;
}
return 0;
}
static int type_contains(jl_value_t *ty, jl_value_t *x)
{
if (ty == x) return 1;
if (jl_is_tuple(ty)) {
size_t i, l=jl_tuple_len(ty);
for(i=0; i < l; i++) {
jl_value_t *e = jl_tupleref(ty,i);
if (e==x || type_contains(e, x))
return 1;
}
}
if (jl_is_uniontype(ty))
return type_contains(jl_fieldref(ty,0), x);
if (jl_is_datatype(ty))
return type_contains((jl_value_t*)((jl_datatype_t*)ty)->parameters, x);
return 0;
}
int jl_has_intrinsics(jl_expr_t *e, jl_module_t *m)
{
if (jl_array_len(e->args) == 0)
return 0;
if (e->head == static_typeof_sym) return 1;
jl_value_t *e0 = jl_exprarg(e,0);
if (e->head == call_sym &&
((jl_is_symbol(e0) && is_intrinsic(m,(jl_sym_t*)e0)) ||
(jl_is_topnode(e0) && is_intrinsic(jl_base_relative_to(m),(jl_sym_t*)jl_fieldref(e0,0)))))
return 1;
int i;
for(i=0; i < jl_array_len(e->args); i++) {
jl_value_t *a = jl_exprarg(e,i);
if (jl_is_expr(a) && jl_has_intrinsics((jl_expr_t*)a, m))
return 1;
}
return 0;
}
jl_value_t *jl_resolve_globals(jl_value_t *expr, jl_lambda_info_t *lam)
{
if (jl_is_symbol(expr)) {
if (lam->def->module == NULL)
return expr;
return jl_module_globalref(lam->def->module, (jl_sym_t*)expr);
}
else if (jl_is_expr(expr)) {
jl_expr_t *e = (jl_expr_t*)expr;
if (jl_is_toplevel_only_expr(expr) || e->head == const_sym || e->head == copyast_sym ||
e->head == global_sym || e->head == quote_sym || e->head == inert_sym ||
e->head == line_sym || e->head == meta_sym || e->head == inbounds_sym ||
e->head == boundscheck_sym || e->head == simdloop_sym) {
}
else {
if (e->head == call_sym && jl_expr_nargs(e) == 3 && jl_is_quotenode(jl_exprarg(e,2)) &&
lam->def->module != NULL) {
// replace getfield(module_expr, :sym) with GlobalRef
jl_value_t *s = jl_fieldref(jl_exprarg(e,2),0);
jl_value_t *fe = jl_exprarg(e,0);
if (jl_is_symbol(s) && jl_is_globalref(fe)) {
jl_value_t *f = jl_static_eval(fe, NULL, lam->def->module, lam, 0, 0);
if (f == jl_builtin_getfield) {
jl_value_t *me = jl_exprarg(e,1);
if (jl_is_globalref(me) ||
(jl_is_symbol(me) && jl_binding_resolved_p(lam->def->module, (jl_sym_t*)me))) {
jl_value_t *m = jl_static_eval(me, NULL, lam->def->module, lam, 0, 0);
if (m && jl_is_module(m))
return jl_module_globalref((jl_module_t*)m, (jl_sym_t*)s);
}
}
}
}
size_t i = 0;
if (e->head == method_sym || e->head == abstracttype_sym || e->head == compositetype_sym ||
e->head == bitstype_sym || e->head == module_sym)
i++;
for(; i < jl_array_len(e->args); i++) {
jl_exprargset(e, i, jl_resolve_globals(jl_exprarg(e,i), lam));
}
}
}
return expr;
}
//Maybe try to use cpp stuff to get the output inside julia system (ccall,cgen and cgutils)
//-| TODO: after adding in the jlapi.c jl_is_<C_type> functions replace the strcmp!
SEXP jl_value_to_SEXP(jl_value_t *res) {
size_t i=0,nd,d;
SEXP resR;
SEXPTYPE aryTyR;
jl_value_t *tmp;
char *resTy, *aryTy, *aryTy2;
if(res!=NULL) { //=> get a result
resTy=(char*)jl_typeof_str(res);
//DANGEROUS?? printf("typeof=%s\n",jl_typeof_str(res));
if(strcmp(jl_typeof_str(res),"Int64")==0 || strcmp(jl_typeof_str(res),"Int32")==0)
//if(jl_is_long(res)) //does not work because of DLLEXPORT
{
//printf("elt=%d\n",jl_unbox_long(res));
PROTECT(resR=NEW_INTEGER(1));
INTEGER_POINTER(resR)[0]=jl_unbox_long(res);
UNPROTECT(1);
return resR;
}
else
if(strcmp(resTy,"Float64")==0)
//if(jl_is_float64(res))
{
PROTECT(resR=NEW_NUMERIC(1));
NUMERIC_POINTER(resR)[0]=jl_unbox_float64(res);
UNPROTECT(1);
return resR;
}
else
if(strcmp(resTy,"Float32")==0)
//if(jl_is_float64(res))
{
PROTECT(resR=NEW_NUMERIC(1));
NUMERIC_POINTER(resR)[0]=jl_unbox_float32(res);
UNPROTECT(1);
return resR;
}
else
if(strcmp(resTy,"Bool")==0)
//if(jl_is_bool(res))
{
PROTECT(resR=NEW_LOGICAL(1));
LOGICAL(resR)[0]=(jl_unbox_bool(res) ? TRUE : FALSE);
UNPROTECT(1);
return resR;
}
else
if(strcmp(resTy,"DataType")==0)
//if(jl_is_bool(res))
{
PROTECT(resR=NEW_CHARACTER(1));
CHARACTER_POINTER(resR)[0]=mkChar(jl_typename_str(res));
UNPROTECT(1);
return resR;
}
else
if(strcmp(resTy,"Nothing")==0)
//if(jl_is_bool(res))
{
return R_NilValue;
}
else
if(strcmp(resTy,"Complex")==0)
//if(jl_is_bool(res))
{
tmp=(jl_value_t*)jl_get_field(res, "re");
PROTECT(resR=NEW_COMPLEX(1));
if(strcmp(jl_typeof_str(tmp),"Float64")==0) {
COMPLEX(resR)[0].r=jl_unbox_float64(tmp);
COMPLEX(resR)[0].i=jl_unbox_float64(jl_get_field(res, "im"));
} else if(strcmp(jl_typeof_str(tmp),"Int64")==0) {
COMPLEX(resR)[0].r=jl_unbox_long(tmp);
COMPLEX(resR)[0].i=jl_unbox_long(jl_get_field(res, "im"));
}
UNPROTECT(1);
return resR;
}
else
if(strcmp(resTy,"Regex")==0)
//if(jl_is_bool(res))
{
// call=(jl_function_t*)jl_get_global(jl_base_module, jl_symbol("show"));
// printf("ici\n");
// if (call) tmp=jl_call1(call,res);
// else printf("call failed!\n");
// printf("ici\n");
// resR = jl_value_to_VALUE(jl_get_field(res, "pattern"));
// return resR;
}
else
if(strcmp(resTy,"ASCIIString")==0 || strcmp(resTy,"UTF8String")==0)
{
PROTECT(resR=NEW_CHARACTER(1));
CHARACTER_POINTER(resR)[0]=mkChar(jl_bytestring_ptr(res));
UNPROTECT(1);
return resR;
}
else
if(strcmp(jl_typeof_str(res),"Tuple")==0 )
//if(jl_is_array(res))
{
d=jl_nfields(res); //BEFORE 0.3: d=jl_tuple_len(res);
PROTECT(resR=allocVector(VECSXP,d));
for(i=0;i<d;i++) {
//BEFORE 0.3: SET_ELEMENT(resR,i,jl_value_to_SEXP(jl_tupleref(res,i)));
SET_ELEMENT(resR,i,jl_value_to_SEXP(jl_fieldref(res,i)));
}
UNPROTECT(1);
return resR;
}
if(strcmp(resTy,"Array")==0)
//if(jl_is_array(res))
{
nd = jl_array_rank(res);
//Rprintf("array_ndims=%d\n",(int)nd);
aryTy=(char*)jl_typename_str(jl_array_eltype(res));
aryTy2=(char*)jl_typeof_str(jl_array_eltype(res));
//Rprintf("type elt=%s,%s\n",aryTy,(char*)jl_typeof_str(jl_array_eltype(res)));
if(strcmp(aryTy2,"DataType")!=0) return R_NilValue;
if(strcmp(aryTy,"ASCIIString")==0 || strcmp(aryTy,"UTF8String")==0) aryTyR=STRSXP;
else if(strcmp(aryTy,"Int64")==0 || strcmp(aryTy,"Int32")==0) aryTyR=INTSXP;
else if(strcmp(aryTy,"Bool")==0) aryTyR=LGLSXP;
else if(strcmp(aryTy,"Complex")==0) aryTyR=CPLXSXP;
else if(strcmp(aryTy,"Float64")==0 || strcmp(aryTy,"Float32")==0) aryTyR=REALSXP;
else aryTyR=VECSXP;
if(nd==1) {//Vector
d = jl_array_size(res, 0);
//Rprintf("array_dim[1]=%d\n",(int)d);
PROTECT(resR=allocVector(aryTyR,d));
for(i=0;i<d;i++) {
switch(aryTyR) {
case STRSXP:
SET_STRING_ELT(resR,i,mkChar(jl_bytestring_ptr(jl_arrayref((jl_array_t *)res,i))));
break;
case INTSXP:
INTEGER(resR)[i]=jl_unbox_long(jl_arrayref((jl_array_t *)res,i));
break;
case LGLSXP:
LOGICAL(resR)[i]=(jl_unbox_bool(jl_arrayref((jl_array_t *)res,i)) ? TRUE : FALSE);
break;
case REALSXP:
REAL(resR)[i]=jl_unbox_float64(jl_arrayref((jl_array_t *)res,i));
break;
case CPLXSXP:
tmp=(jl_value_t*)jl_get_field(jl_arrayref((jl_array_t *)res,i), "re");
if(strcmp(jl_typeof_str(tmp),"Float64")==0) {
COMPLEX(resR)[i].r=jl_unbox_float64(tmp);
COMPLEX(resR)[i].i=jl_unbox_float64(jl_get_field(jl_arrayref((jl_array_t *)res,i), "im"));
} else if(strcmp(jl_typeof_str(tmp),"Int64")==0) {
COMPLEX(resR)[i].r=jl_unbox_long(tmp);
COMPLEX(resR)[i].i=jl_unbox_long(jl_get_field(jl_arrayref((jl_array_t *)res,i), "im"));
}
break;
case VECSXP:
SET_ELEMENT(resR,i,jl_value_to_SEXP(jl_arrayref((jl_array_t *)res,i)));
}
}
UNPROTECT(1);
return resR;
}
//TODO: multidim array ruby equivalent???? Is it necessary
}
return R_NilValue;
/*PROTECT(resR=NEW_CHARACTER(1));
CHARACTER_POINTER(resR)[0]=mkChar(jl_typeof_str(res));
// resR=rb_str_new2("__unconverted(");
// rb_str_cat2(resR, jl_typeof_str(res));
// rb_str_cat2(resR, ")__\n");
UNPROTECT(1);
//printf("%s\n",jl_bytestring_ptr(jl_eval_string("\"$(ans)\"")));
return resR;*/
}
//=> No result (command incomplete or syntax error)
// jlapi_print_stderr(); //If this happens but this is really not sure!
// resR=rb_str_new2("__incomplete");
// if(jl_exception_occurred()!=NULL) {
// rb_str_cat2(resR, "(");
// rb_str_cat2(resR,jl_typeof_str(jl_exception_occurred()));
// jl_value_t* err=jl_get_field(jl_exception_occurred(),"msg");
// if(err!=NULL) printf("%s: %s\n",jl_typeof_str(jl_exception_occurred()),jl_bytestring_ptr(err));
// jl_exception_clear();
// rb_str_cat2(resR, ")");
// }
// rb_str_cat2(resR, "__");
return R_NilValue;//resR;
}
static jl_value_t *eval(jl_value_t *e, jl_value_t **locals, size_t nl, size_t ngensym)
{
if (jl_is_symbol(e)) {
jl_value_t *v;
size_t i;
for(i=0; i < nl; i++) {
if (locals[i*2] == e) {
v = locals[i*2+1];
break;
}
}
if (i >= nl) {
v = jl_get_global(jl_current_module, (jl_sym_t*)e);
}
if (v == NULL) {
jl_undefined_var_error((jl_sym_t*)e);
}
return v;
}
if (jl_is_symbolnode(e)) {
return eval((jl_value_t*)jl_symbolnode_sym(e), locals, nl, ngensym);
}
if (jl_is_gensym(e)) {
ssize_t genid = ((jl_gensym_t*)e)->id;
if (genid >= ngensym || genid < 0)
jl_error("access to invalid GenSym location");
else
return locals[nl*2 + genid];
}
if (jl_is_quotenode(e)) {
return jl_fieldref(e,0);
}
if (jl_is_topnode(e)) {
jl_sym_t *s = (jl_sym_t*)jl_fieldref(e,0);
jl_value_t *v = jl_get_global(jl_base_relative_to(jl_current_module),s);
if (v == NULL)
jl_undefined_var_error(s);
return v;
}
if (!jl_is_expr(e)) {
if (jl_is_globalref(e)) {
jl_value_t *gfargs[2] = {(jl_value_t*)jl_globalref_mod(e), (jl_value_t*)jl_globalref_name(e)};
return jl_f_get_field(NULL, gfargs, 2);
}
if (jl_is_lambda_info(e)) {
jl_lambda_info_t *li = (jl_lambda_info_t*)e;
if (jl_boot_file_loaded && li->ast && jl_is_expr(li->ast)) {
li->ast = jl_compress_ast(li, li->ast);
jl_gc_wb(li, li->ast);
}
return (jl_value_t*)jl_new_closure(NULL, (jl_value_t*)jl_emptysvec, li);
}
if (jl_is_linenode(e)) {
jl_lineno = jl_linenode_line(e);
}
if (jl_is_newvarnode(e)) {
jl_value_t *var = jl_fieldref(e,0);
assert(!jl_is_gensym(var));
assert(jl_is_symbol(var));
for(size_t i=0; i < nl; i++) {
if (locals[i*2] == var) {
locals[i*2+1] = NULL;
break;
}
}
return (jl_value_t*)jl_nothing;
}
return e;
}
jl_expr_t *ex = (jl_expr_t*)e;
jl_value_t **args = (jl_value_t**)jl_array_data(ex->args);
size_t nargs = jl_array_len(ex->args);
if (ex->head == call_sym) {
if (jl_is_lambda_info(args[0])) {
// directly calling an inner function ("let")
jl_lambda_info_t *li = (jl_lambda_info_t*)args[0];
if (jl_is_expr(li->ast) && !jl_lam_vars_captured((jl_expr_t*)li->ast) &&
!jl_has_intrinsics((jl_expr_t*)li->ast, (jl_expr_t*)li->ast, jl_current_module)) {
size_t na = nargs-1;
if (na == 0)
return jl_interpret_toplevel_thunk(li);
jl_array_t *formals = jl_lam_args((jl_expr_t*)li->ast);
size_t nreq = jl_array_len(formals);
if (nreq==0 || !jl_is_rest_arg(jl_cellref(formals,nreq-1))) {
jl_value_t **ar;
JL_GC_PUSHARGS(ar, na*2);
for(int i=0; i < na; i++) {
ar[i*2+1] = eval(args[i+1], locals, nl, ngensym);
jl_gc_wb(ex->args, ar[i*2+1]);
}
if (na != nreq) {
jl_error("wrong number of arguments");
}
for(int i=0; i < na; i++) {
jl_value_t *v = jl_cellref(formals, i);
ar[i*2] = (jl_is_gensym(v)) ? v : (jl_value_t*)jl_decl_var(v);
}
jl_value_t *ret = jl_interpret_toplevel_thunk_with(li, ar, na);
JL_GC_POP();
return ret;
}
}
}
jl_function_t *f = (jl_function_t*)eval(args[0], locals, nl, ngensym);
if (jl_is_func(f))
return do_call(f, &args[1], nargs-1, NULL, locals, nl, ngensym);
else
return do_call(jl_module_call_func(jl_current_module), args, nargs, (jl_value_t*)f, locals, nl, ngensym);
}
else if (ex->head == assign_sym) {
jl_value_t *sym = args[0];
jl_value_t *rhs = eval(args[1], locals, nl, ngensym);
if (jl_is_gensym(sym)) {
ssize_t genid = ((jl_gensym_t*)sym)->id;
if (genid >= ngensym || genid < 0)
jl_error("assignment to invalid GenSym location");
locals[nl*2 + genid] = rhs;
return rhs;
}
if (jl_is_symbol(sym)) {
size_t i;
for (i=0; i < nl; i++) {
if (locals[i*2] == sym) {
locals[i*2+1] = rhs;
return rhs;
}
}
}
jl_module_t *m = jl_current_module;
if (jl_is_globalref(sym)) {
m = jl_globalref_mod(sym);
sym = (jl_value_t*)jl_globalref_name(sym);
}
assert(jl_is_symbol(sym));
JL_GC_PUSH1(&rhs);
jl_binding_t *b = jl_get_binding_wr(m, (jl_sym_t*)sym);
jl_checked_assignment(b, rhs);
JL_GC_POP();
return rhs;
}
else if (ex->head == new_sym) {
jl_value_t *thetype = eval(args[0], locals, nl, ngensym);
jl_value_t *v=NULL;
JL_GC_PUSH2(&thetype, &v);
assert(jl_is_structtype(thetype));
v = jl_new_struct_uninit((jl_datatype_t*)thetype);
for(size_t i=1; i < nargs; i++) {
jl_set_nth_field(v, i-1, eval(args[i], locals, nl, ngensym));
}
JL_GC_POP();
return v;
}
else if (ex->head == null_sym) {
return (jl_value_t*)jl_nothing;
}
else if (ex->head == body_sym) {
return eval_body(ex->args, locals, nl, ngensym, 0, 0);
}
else if (ex->head == exc_sym) {
return jl_exception_in_transit;
}
else if (ex->head == static_typeof_sym) {
return (jl_value_t*)jl_any_type;
}
else if (ex->head == method_sym) {
jl_sym_t *fname = (jl_sym_t*)args[0];
jl_value_t **bp=NULL;
jl_value_t *bp_owner=NULL;
jl_binding_t *b=NULL;
jl_value_t *gf=NULL;
int kw=0;
if (jl_is_expr(fname) || jl_is_globalref(fname)) {
if (jl_is_expr(fname) && ((jl_expr_t*)fname)->head == kw_sym) {
kw = 1;
fname = (jl_sym_t*)jl_exprarg(fname, 0);
}
gf = eval((jl_value_t*)fname, locals, nl, ngensym);
if (jl_is_expr(fname))
fname = (jl_sym_t*)jl_fieldref(jl_exprarg(fname, 2), 0);
bp = &gf;
assert(jl_is_symbol(fname));
}
else {
for (size_t i=0; i < nl; i++) {
if (locals[i*2] == (jl_value_t*)fname) {
bp = &locals[i*2+1];
break;
}
}
if (bp == NULL) {
b = jl_get_binding_for_method_def(jl_current_module, fname);
bp = &b->value;
bp_owner = (jl_value_t*)jl_current_module;
}
}
if (jl_expr_nargs(ex) == 1)
return jl_generic_function_def(fname, bp, bp_owner, b);
jl_value_t *atypes=NULL, *meth=NULL;
JL_GC_PUSH2(&atypes, &meth);
atypes = eval(args[1], locals, nl, ngensym);
if (jl_is_lambda_info(args[2])) {
jl_check_static_parameter_conflicts((jl_lambda_info_t*)args[2], (jl_svec_t*)jl_svecref(atypes,1), fname);
}
meth = eval(args[2], locals, nl, ngensym);
jl_method_def(fname, bp, bp_owner, b, (jl_svec_t*)atypes, (jl_function_t*)meth, args[3], NULL, kw);
JL_GC_POP();
return *bp;
}
else if (ex->head == copyast_sym) {
return jl_copy_ast(eval(args[0], locals, nl, ngensym));
}
else if (ex->head == const_sym) {
jl_value_t *sym = args[0];
assert(jl_is_symbol(sym));
for (size_t i=0; i < nl; i++) {
if (locals[i*2] == sym) {
return (jl_value_t*)jl_nothing;
}
}
jl_binding_t *b = jl_get_binding_wr(jl_current_module, (jl_sym_t*)sym);
jl_declare_constant(b);
return (jl_value_t*)jl_nothing;
}
else if (ex->head == global_sym) {
// create uninitialized mutable binding for "global x" decl
// TODO: handle type decls
for (size_t i=0; i < jl_array_len(ex->args); i++) {
assert(jl_is_symbol(args[i]));
jl_get_binding_wr(jl_current_module, (jl_sym_t*)args[i]);
}
return (jl_value_t*)jl_nothing;
}
else if (ex->head == abstracttype_sym) {
jl_value_t *name = args[0];
jl_value_t *para = eval(args[1], locals, nl, ngensym);
jl_value_t *super = NULL;
jl_value_t *temp = NULL;
jl_datatype_t *dt = NULL;
JL_GC_PUSH4(¶, &super, &temp, &dt);
assert(jl_is_svec(para));
assert(jl_is_symbol(name));
dt = jl_new_abstracttype(name, jl_any_type, (jl_svec_t*)para);
jl_binding_t *b = jl_get_binding_wr(jl_current_module, (jl_sym_t*)name);
temp = b->value;
check_can_assign_type(b);
b->value = (jl_value_t*)dt;
jl_gc_wb_binding(b, dt);
super = eval(args[2], locals, nl, ngensym);
jl_set_datatype_super(dt, super);
b->value = temp;
if (temp==NULL || !equiv_type(dt, (jl_datatype_t*)temp)) {
jl_checked_assignment(b, (jl_value_t*)dt);
}
JL_GC_POP();
return (jl_value_t*)jl_nothing;
}
else if (ex->head == bitstype_sym) {
jl_value_t *name = args[0];
jl_value_t *super = NULL, *para = NULL, *vnb = NULL, *temp = NULL;
jl_datatype_t *dt = NULL;
JL_GC_PUSH4(¶, &super, &temp, &dt);
assert(jl_is_symbol(name));
para = eval(args[1], locals, nl, ngensym);
assert(jl_is_svec(para));
vnb = eval(args[2], locals, nl, ngensym);
if (!jl_is_long(vnb))
jl_errorf("invalid declaration of bits type %s", ((jl_sym_t*)name)->name);
ssize_t nb = jl_unbox_long(vnb);
if (nb < 1 || nb>=(1<<23) || (nb&7) != 0)
jl_errorf("invalid number of bits in type %s",
((jl_sym_t*)name)->name);
dt = jl_new_bitstype(name, jl_any_type, (jl_svec_t*)para, nb);
jl_binding_t *b = jl_get_binding_wr(jl_current_module, (jl_sym_t*)name);
temp = b->value;
check_can_assign_type(b);
b->value = (jl_value_t*)dt;
jl_gc_wb_binding(b, dt);
super = eval(args[3], locals, nl, ngensym);
jl_set_datatype_super(dt, super);
b->value = temp;
if (temp==NULL || !equiv_type(dt, (jl_datatype_t*)temp)) {
jl_checked_assignment(b, (jl_value_t*)dt);
}
JL_GC_POP();
return (jl_value_t*)jl_nothing;
}
else if (ex->head == compositetype_sym) {
jl_value_t *name = args[0];
assert(jl_is_symbol(name));
jl_value_t *para = eval(args[1], locals, nl, ngensym);
assert(jl_is_svec(para));
jl_value_t *temp = NULL;
jl_value_t *super = NULL;
jl_datatype_t *dt = NULL;
JL_GC_PUSH4(¶, &super, &temp, &dt);
temp = eval(args[2], locals, nl, ngensym); // field names
dt = jl_new_datatype((jl_sym_t*)name, jl_any_type, (jl_svec_t*)para,
(jl_svec_t*)temp, NULL,
0, args[5]==jl_true ? 1 : 0, jl_unbox_long(args[6]));
jl_binding_t *b = jl_get_binding_wr(jl_current_module, (jl_sym_t*)name);
temp = b->value; // save old value
// temporarily assign so binding is available for field types
check_can_assign_type(b);
b->value = (jl_value_t*)dt;
jl_gc_wb_binding(b,dt);
JL_TRY {
// operations that can fail
inside_typedef = 1;
dt->types = (jl_svec_t*)eval(args[4], locals, nl, ngensym);
jl_gc_wb(dt, dt->types);
inside_typedef = 0;
for(size_t i=0; i < jl_svec_len(dt->types); i++) {
jl_value_t *elt = jl_svecref(dt->types, i);
if (!jl_is_type(elt) && !jl_is_typevar(elt))
jl_type_error_rt(dt->name->name->name, "type definition", (jl_value_t*)jl_type_type, elt);
}
super = eval(args[3], locals, nl, ngensym);
jl_set_datatype_super(dt, super);
}
JL_CATCH {
b->value = temp;
jl_rethrow();
}
for(size_t i=0; i < jl_svec_len(para); i++) {
((jl_tvar_t*)jl_svecref(para,i))->bound = 0;
}
jl_compute_field_offsets(dt);
if (para == (jl_value_t*)jl_emptysvec && jl_is_datatype_singleton(dt)) {
dt->instance = newstruct(dt);
jl_gc_wb(dt, dt->instance);
}
b->value = temp;
if (temp==NULL || !equiv_type(dt, (jl_datatype_t*)temp)) {
jl_checked_assignment(b, (jl_value_t*)dt);
}
else {
// TODO: remove all old ctors and set temp->name->ctor_factory = dt->name->ctor_factory
}
JL_GC_POP();
return (jl_value_t*)jl_nothing;
}
// `v` might be pointing to a field inlined in a structure therefore
// `jl_typeof(v)` may not be the same with `vt` and only `vt` should be
// used to determine the type of the value.
// This is necessary to make sure that this function doesn't allocate any
// memory through the Julia GC
static size_t jl_static_show_x_(JL_STREAM *out, jl_value_t *v, jl_datatype_t *vt,
struct recur_list *depth)
{
size_t n = 0;
if ((uintptr_t)vt < 4096U) {
n += jl_printf(out, "<?#%p::%p>", (void*)v, (void*)vt);
}
else if ((uintptr_t)v < 4096U) {
n += jl_printf(out, "<?#%p::", (void*)v);
n += jl_static_show_x(out, (jl_value_t*)vt, depth);
n += jl_printf(out, ">");
}
else if (vt == jl_method_type) {
jl_method_t *m = (jl_method_t*)v;
n += jl_static_show_x(out, (jl_value_t*)m->module, depth);
n += jl_printf(out, ".%s(...)", jl_symbol_name(m->name));
}
else if (vt == jl_method_instance_type) {
jl_method_instance_t *li = (jl_method_instance_t*)v;
if (jl_is_method(li->def.method)) {
jl_method_t *m = li->def.method;
n += jl_static_show_x(out, (jl_value_t*)m->module, depth);
if (li->specTypes) {
n += jl_printf(out, ".");
n += jl_show_svec(out, ((jl_datatype_t*)jl_unwrap_unionall(li->specTypes))->parameters,
jl_symbol_name(m->name), "(", ")");
}
else {
n += jl_printf(out, ".%s(?)", jl_symbol_name(m->name));
}
}
else {
n += jl_static_show_x(out, (jl_value_t*)li->def.module, depth);
n += jl_printf(out, ".<toplevel thunk> -> ");
n += jl_static_show_x(out, li->inferred, depth);
}
}
else if (vt == jl_simplevector_type) {
n += jl_show_svec(out, (jl_svec_t*)v, "svec", "(", ")");
}
else if (vt == jl_datatype_type) {
jl_datatype_t *dv = (jl_datatype_t*)v;
jl_sym_t *globname = dv->name->mt != NULL ? dv->name->mt->name : NULL;
int globfunc = 0;
if (globname && !strchr(jl_symbol_name(globname), '#') &&
!strchr(jl_symbol_name(globname), '@') && dv->name->module &&
jl_binding_resolved_p(dv->name->module, globname)) {
jl_binding_t *b = jl_get_binding(dv->name->module, globname);
if (b && jl_typeof(b->value) == v)
globfunc = 1;
}
jl_sym_t *sym = globfunc ? globname : dv->name->name;
char *sn = jl_symbol_name(sym);
int hidden = !globfunc && strchr(sn, '#');
size_t i = 0;
int quote = 0;
if (hidden) {
n += jl_printf(out, "getfield(");
}
else if (globfunc) {
n += jl_printf(out, "typeof(");
}
if (dv->name->module != jl_core_module || !jl_module_exports_p(jl_core_module, sym)) {
n += jl_static_show_x(out, (jl_value_t*)dv->name->module, depth);
if (!hidden) {
n += jl_printf(out, ".");
if (globfunc && !jl_id_start_char(u8_nextchar(sn, &i))) {
n += jl_printf(out, ":(");
quote = 1;
}
}
}
if (hidden) {
n += jl_printf(out, ", Symbol(\"");
n += jl_printf(out, "%s", sn);
n += jl_printf(out, "\"))");
}
else {
n += jl_printf(out, "%s", sn);
if (globfunc) {
n += jl_printf(out, ")");
if (quote)
n += jl_printf(out, ")");
}
}
if (dv->parameters && (jl_value_t*)dv != dv->name->wrapper &&
(jl_has_free_typevars(v) ||
(jl_value_t*)dv != (jl_value_t*)jl_tuple_type)) {
size_t j, tlen = jl_nparams(dv);
if (tlen > 0) {
n += jl_printf(out, "{");
for (j = 0; j < tlen; j++) {
jl_value_t *p = jl_tparam(dv,j);
n += jl_static_show_x(out, p, depth);
if (j != tlen-1)
n += jl_printf(out, ", ");
}
n += jl_printf(out, "}");
}
else if (dv->name == jl_tuple_typename) {
n += jl_printf(out, "{}");
}
}
}
else if (vt == jl_intrinsic_type) {
int f = *(uint32_t*)jl_data_ptr(v);
n += jl_printf(out, "#<intrinsic #%d %s>", f, jl_intrinsic_name(f));
}
else if (vt == jl_int64_type) {
n += jl_printf(out, "%" PRId64, *(int64_t*)v);
}
else if (vt == jl_int32_type) {
n += jl_printf(out, "%" PRId32, *(int32_t*)v);
}
else if (vt == jl_int16_type) {
n += jl_printf(out, "%" PRId16, *(int16_t*)v);
}
else if (vt == jl_int8_type) {
n += jl_printf(out, "%" PRId8, *(int8_t*)v);
}
else if (vt == jl_uint64_type) {
n += jl_printf(out, "0x%016" PRIx64, *(uint64_t*)v);
}
else if (vt == jl_uint32_type) {
n += jl_printf(out, "0x%08" PRIx32, *(uint32_t*)v);
}
else if (vt == jl_uint16_type) {
n += jl_printf(out, "0x%04" PRIx16, *(uint16_t*)v);
}
else if (vt == jl_uint8_type) {
n += jl_printf(out, "0x%02" PRIx8, *(uint8_t*)v);
}
else if (jl_is_cpointer_type((jl_value_t*)vt)) {
#ifdef _P64
n += jl_printf(out, "0x%016" PRIx64, *(uint64_t*)v);
#else
n += jl_printf(out, "0x%08" PRIx32, *(uint32_t*)v);
#endif
}
else if (vt == jl_float32_type) {
n += jl_printf(out, "%gf", *(float*)v);
}
else if (vt == jl_float64_type) {
n += jl_printf(out, "%g", *(double*)v);
}
else if (vt == jl_bool_type) {
n += jl_printf(out, "%s", *(uint8_t*)v ? "true" : "false");
}
else if ((jl_value_t*)vt == jl_typeof(jl_nothing)) {
n += jl_printf(out, "nothing");
}
else if (vt == jl_string_type) {
n += jl_printf(out, "\"");
jl_uv_puts(out, jl_string_data(v), jl_string_len(v)); n += jl_string_len(v);
n += jl_printf(out, "\"");
}
else if (v == jl_bottom_type) {
n += jl_printf(out, "Union{}");
}
else if (vt == jl_uniontype_type) {
n += jl_printf(out, "Union{");
while (jl_is_uniontype(v)) {
// tail-recurse on b to flatten the printing of the Union structure in the common case
n += jl_static_show_x(out, ((jl_uniontype_t*)v)->a, depth);
n += jl_printf(out, ", ");
v = ((jl_uniontype_t*)v)->b;
}
n += jl_static_show_x(out, v, depth);
n += jl_printf(out, "}");
}
else if (vt == jl_unionall_type) {
jl_unionall_t *ua = (jl_unionall_t*)v;
n += jl_static_show_x(out, ua->body, depth);
n += jl_printf(out, " where ");
n += jl_static_show_x(out, (jl_value_t*)ua->var, depth->prev);
}
else if (vt == jl_tvar_type) {
// show type-var bounds only if they aren't going to be printed by UnionAll later
jl_tvar_t *var = (jl_tvar_t*)v;
struct recur_list *p;
int showbounds = 1;
for (p = depth; p != NULL; p = p->prev) {
if (jl_is_unionall(p->v) && ((jl_unionall_t*)p->v)->var == var) {
showbounds = 0;
break;
}
}
jl_value_t *lb = var->lb, *ub = var->ub;
if (showbounds && lb != jl_bottom_type) {
// show type-var lower bound if it is defined
int ua = jl_is_unionall(lb);
if (ua)
n += jl_printf(out, "(");
n += jl_static_show_x(out, lb, depth);
if (ua)
n += jl_printf(out, ")");
n += jl_printf(out, "<:");
}
n += jl_printf(out, "%s", jl_symbol_name(var->name));
if (showbounds && (ub != (jl_value_t*)jl_any_type || lb != jl_bottom_type)) {
// show type-var upper bound if it is defined, or if we showed the lower bound
int ua = jl_is_unionall(ub);
n += jl_printf(out, "<:");
if (ua)
n += jl_printf(out, "(");
n += jl_static_show_x(out, ub, depth);
if (ua)
n += jl_printf(out, ")");
}
}
else if (vt == jl_module_type) {
jl_module_t *m = (jl_module_t*)v;
if (m->parent != m && m->parent != jl_main_module) {
n += jl_static_show_x(out, (jl_value_t*)m->parent, depth);
n += jl_printf(out, ".");
}
n += jl_printf(out, "%s", jl_symbol_name(m->name));
}
else if (vt == jl_sym_type) {
char *sn = jl_symbol_name((jl_sym_t*)v);
int quoted = !jl_is_identifier(sn) && jl_operator_precedence(sn) == 0;
if (quoted)
n += jl_printf(out, "Symbol(\"");
else
n += jl_printf(out, ":");
n += jl_printf(out, "%s", sn);
if (quoted)
n += jl_printf(out, "\")");
}
else if (vt == jl_ssavalue_type) {
n += jl_printf(out, "SSAValue(%" PRIuPTR ")",
(uintptr_t)((jl_ssavalue_t*)v)->id);
}
else if (vt == jl_globalref_type) {
n += jl_static_show_x(out, (jl_value_t*)jl_globalref_mod(v), depth);
n += jl_printf(out, ".%s", jl_symbol_name(jl_globalref_name(v)));
}
else if (vt == jl_labelnode_type) {
n += jl_printf(out, "%" PRIuPTR ":", jl_labelnode_label(v));
}
else if (vt == jl_gotonode_type) {
n += jl_printf(out, "goto %" PRIuPTR, jl_gotonode_label(v));
}
else if (vt == jl_quotenode_type) {
jl_value_t *qv = *(jl_value_t**)v;
if (!jl_is_symbol(qv)) {
n += jl_printf(out, "quote ");
}
else {
n += jl_printf(out, ":(");
}
n += jl_static_show_x(out, qv, depth);
if (!jl_is_symbol(qv)) {
n += jl_printf(out, " end");
}
else {
n += jl_printf(out, ")");
}
}
else if (vt == jl_newvarnode_type) {
n += jl_printf(out, "<newvar ");
n += jl_static_show_x(out, *(jl_value_t**)v, depth);
n += jl_printf(out, ">");
}
else if (vt == jl_linenumbernode_type) {
n += jl_printf(out, "#= ");
n += jl_static_show_x(out, jl_linenode_file(v), depth);
n += jl_printf(out, ":%" PRIuPTR " =#", jl_linenode_line(v));
}
else if (vt == jl_expr_type) {
jl_expr_t *e = (jl_expr_t*)v;
if (e->head == assign_sym && jl_array_len(e->args) == 2) {
n += jl_static_show_x(out, jl_exprarg(e,0), depth);
n += jl_printf(out, " = ");
n += jl_static_show_x(out, jl_exprarg(e,1), depth);
}
else {
char sep = ' ';
if (e->head == body_sym)
sep = '\n';
n += jl_printf(out, "Expr(:%s", jl_symbol_name(e->head));
size_t i, len = jl_array_len(e->args);
for (i = 0; i < len; i++) {
n += jl_printf(out, ",%c", sep);
n += jl_static_show_x(out, jl_exprarg(e,i), depth);
}
n += jl_printf(out, ")::");
n += jl_static_show_x(out, e->etype, depth);
}
}
else if (jl_is_array_type(vt)) {
n += jl_static_show_x(out, (jl_value_t*)vt, depth);
n += jl_printf(out, "[");
size_t j, tlen = jl_array_len(v);
jl_array_t *av = (jl_array_t*)v;
jl_datatype_t *el_type = (jl_datatype_t*)jl_tparam0(vt);
int nlsep = 0;
if (av->flags.ptrarray) {
// print arrays with newlines, unless the elements are probably small
for (j = 0; j < tlen; j++) {
jl_value_t *p = jl_array_ptr_ref(av, j);
if (p != NULL && (uintptr_t)p >= 4096U) {
jl_value_t *p_ty = jl_typeof(p);
if ((uintptr_t)p_ty >= 4096U) {
if (!jl_isbits(p_ty)) {
nlsep = 1;
break;
}
}
}
}
}
if (nlsep && tlen > 1)
n += jl_printf(out, "\n ");
for (j = 0; j < tlen; j++) {
if (av->flags.ptrarray) {
n += jl_static_show_x(out, jl_array_ptr_ref(v, j), depth);
}
else {
char *ptr = ((char*)av->data) + j * av->elsize;
n += jl_static_show_x_(out, (jl_value_t*)ptr, el_type, depth);
}
if (j != tlen - 1)
n += jl_printf(out, nlsep ? ",\n " : ", ");
}
n += jl_printf(out, "]");
}
else if (vt == jl_loaderror_type) {
n += jl_printf(out, "LoadError(at ");
n += jl_static_show_x(out, *(jl_value_t**)v, depth);
// Access the field directly to avoid allocation
n += jl_printf(out, " line %" PRIdPTR, ((intptr_t*)v)[1]);
n += jl_printf(out, ": ");
n += jl_static_show_x(out, ((jl_value_t**)v)[2], depth);
n += jl_printf(out, ")");
}
else if (vt == jl_errorexception_type) {
n += jl_printf(out, "ErrorException(");
n += jl_static_show_x(out, *(jl_value_t**)v, depth);
n += jl_printf(out, ")");
}
else if (jl_is_datatype(vt)) {
int istuple = jl_is_tuple_type(vt);
if (!istuple)
n += jl_static_show_x(out, (jl_value_t*)vt, depth);
n += jl_printf(out, "(");
size_t nb = jl_datatype_size(vt);
size_t tlen = jl_datatype_nfields(vt);
if (nb > 0 && tlen == 0) {
uint8_t *data = (uint8_t*)v;
n += jl_printf(out, "0x");
for(int i = nb - 1; i >= 0; --i)
n += jl_printf(out, "%02" PRIx8, data[i]);
}
else {
size_t i = 0;
if (vt == jl_typemap_entry_type)
i = 1;
for (; i < tlen; i++) {
if (!istuple) {
n += jl_printf(out, "%s", jl_symbol_name(jl_field_name(vt, i)));
n += jl_printf(out, "=");
}
size_t offs = jl_field_offset(vt, i);
char *fld_ptr = (char*)v + offs;
if (jl_field_isptr(vt, i)) {
n += jl_static_show_x(out, *(jl_value_t**)fld_ptr, depth);
}
else {
jl_datatype_t *ft = (jl_datatype_t*)jl_field_type(vt, i);
if (jl_is_uniontype(ft)) {
uint8_t sel = ((uint8_t*)fld_ptr)[jl_field_size(vt, i) - 1];
ft = (jl_datatype_t*)jl_nth_union_component((jl_value_t*)ft, sel);
}
n += jl_static_show_x_(out, (jl_value_t*)fld_ptr, ft, depth);
}
if (istuple && tlen == 1)
n += jl_printf(out, ",");
else if (i != tlen - 1)
n += jl_printf(out, ", ");
}
if (vt == jl_typemap_entry_type) {
n += jl_printf(out, ", next=↩︎\n ");
n += jl_static_show_x(out, jl_fieldref(v, 0), depth);
}
}
n += jl_printf(out, ")");
}
else {
n += jl_printf(out, "<?#%p::", (void*)v);
n += jl_static_show_x(out, (jl_value_t*)vt, depth);
n += jl_printf(out, ">");
}
return n;
}
static jl_value_t *eval(jl_value_t *e, jl_value_t **locals, size_t nl)
{
if (jl_is_symbol(e)) {
jl_value_t *v;
size_t i;
for(i=0; i < nl; i++) {
if (locals[i*2] == e) {
v = locals[i*2+1];
break;
}
}
if (i >= nl) {
v = jl_get_global(jl_current_module, (jl_sym_t*)e);
}
if (v == NULL) {
jl_errorf("%s not defined", ((jl_sym_t*)e)->name);
}
return v;
}
if (jl_is_symbolnode(e)) {
return eval((jl_value_t*)jl_symbolnode_sym(e), locals, nl);
}
if (jl_is_quotenode(e)) {
return jl_fieldref(e,0);
}
if (jl_is_topnode(e)) {
jl_sym_t *s = (jl_sym_t*)jl_fieldref(e,0);
jl_value_t *v = jl_get_global(jl_base_relative_to(jl_current_module),s);
if (v == NULL)
jl_errorf("%s not defined", s->name);
return v;
}
if (!jl_is_expr(e)) {
if (jl_is_getfieldnode(e)) {
jl_value_t *v = eval(jl_getfieldnode_val(e), locals, nl);
jl_value_t *gfargs[2] = {v, (jl_value_t*)jl_getfieldnode_name(e)};
return jl_f_get_field(NULL, gfargs, 2);
}
if (jl_is_lambda_info(e)) {
return (jl_value_t*)jl_new_closure(NULL, (jl_value_t*)jl_null,
(jl_lambda_info_t*)e);
}
if (jl_is_linenode(e)) {
jl_lineno = jl_linenode_line(e);
}
return e;
}
jl_expr_t *ex = (jl_expr_t*)e;
jl_value_t **args = &jl_cellref(ex->args,0);
size_t nargs = jl_array_len(ex->args);
if (ex->head == call_sym || ex->head == call1_sym) {
jl_function_t *f = (jl_function_t*)eval(args[0], locals, nl);
if (!jl_is_func(f))
jl_type_error("apply", (jl_value_t*)jl_function_type,
(jl_value_t*)f);
return do_call(f, &args[1], nargs-1, locals, nl);
}
else if (ex->head == assign_sym) {
jl_value_t *sym = args[0];
size_t i;
for (i=0; i < nl; i++) {
if (locals[i*2] == sym) {
return (locals[i*2+1] = eval(args[1], locals, nl));
}
}
jl_binding_t *b = jl_get_binding_wr(jl_current_module, (jl_sym_t*)sym);
jl_value_t *rhs = eval(args[1], locals, nl);
jl_checked_assignment(b, rhs);
return rhs;
}
else if (ex->head == new_sym) {
jl_value_t *thetype = eval(args[0], locals, nl);
jl_value_t *v=NULL;
JL_GC_PUSH(&thetype, &v);
assert(jl_is_structtype(thetype));
v = jl_new_struct_uninit((jl_datatype_t*)thetype);
for(size_t i=1; i < nargs; i++) {
jl_set_nth_field(v, i-1, eval(args[i], locals, nl));
}
JL_GC_POP();
return v;
}
else if (ex->head == null_sym) {
return (jl_value_t*)jl_nothing;
}
else if (ex->head == body_sym) {
return eval_body(ex->args, locals, nl, 0);
}
else if (ex->head == exc_sym) {
return jl_exception_in_transit;
}
else if (ex->head == static_typeof_sym) {
return (jl_value_t*)jl_any_type;
}
else if (ex->head == method_sym) {
jl_sym_t *fname = (jl_sym_t*)args[0];
jl_value_t **bp=NULL;
jl_binding_t *b=NULL;
jl_value_t *gf=NULL;
int kw=0;
if (jl_is_expr(fname)) {
if (((jl_expr_t*)fname)->head == kw_sym) {
kw = 1;
fname = (jl_sym_t*)jl_exprarg(fname, 0);
}
gf = eval((jl_value_t*)fname, locals, nl);
assert(jl_is_function(gf));
assert(jl_is_gf(gf));
if (!kw) {
fname = (jl_sym_t*)jl_fieldref(jl_exprarg(fname, 2), 0);
bp = &gf;
}
else {
bp = (jl_value_t**)&((jl_methtable_t*)((jl_function_t*)gf)->env)->kwsorter;
}
assert(jl_is_symbol(fname));
}
else {
for (size_t i=0; i < nl; i++) {
if (locals[i*2] == (jl_value_t*)fname) {
bp = &locals[i*2+1];
break;
}
}
if (bp == NULL) {
b = jl_get_binding_for_method_def(jl_current_module, fname);
bp = &b->value;
}
}
jl_value_t *atypes=NULL, *meth=NULL, *tvars=NULL;
JL_GC_PUSH(&atypes, &meth, &tvars);
atypes = eval(args[1], locals, nl);
meth = eval(args[2], locals, nl);
tvars = eval(args[3], locals, nl);
jl_method_def(fname, bp, b, (jl_tuple_t*)atypes,
(jl_function_t*)meth, (jl_tuple_t*)tvars);
JL_GC_POP();
return *bp;
}
else if (ex->head == const_sym) {
jl_value_t *sym = args[0];
for (size_t i=0; i < nl; i++) {
if (locals[i*2] == sym) {
return (jl_value_t*)jl_nothing;
}
}
jl_binding_t *b = jl_get_binding_wr(jl_current_module, (jl_sym_t*)sym);
jl_declare_constant(b);
return (jl_value_t*)jl_nothing;
}
else if (ex->head == global_sym) {
// create uninitialized mutable binding for "global x" decl
// TODO: handle type decls
for (size_t i=0; i < jl_array_len(ex->args); i++) {
assert(jl_is_symbol(args[i]));
jl_get_binding_wr(jl_current_module, (jl_sym_t*)args[i]);
}
return (jl_value_t*)jl_nothing;
}
else if (ex->head == abstracttype_sym) {
jl_value_t *name = args[0];
jl_value_t *para = eval(args[1], locals, nl);
jl_value_t *super = NULL;
JL_GC_PUSH(¶, &super);
jl_datatype_t *dt =
jl_new_abstracttype(name, jl_any_type, (jl_tuple_t*)para);
jl_binding_t *b = jl_get_binding_wr(jl_current_module, (jl_sym_t*)name);
jl_checked_assignment(b, (jl_value_t*)dt);
super = eval(args[2], locals, nl);
jl_set_datatype_super(dt, super);
JL_GC_POP();
return (jl_value_t*)jl_nothing;
}
else if (ex->head == bitstype_sym) {
jl_value_t *name = args[0];
jl_value_t *super = NULL, *para = NULL, *vnb = NULL;
JL_GC_PUSH(¶, &super, &vnb);
para = eval(args[1], locals, nl);
vnb = eval(args[2], locals, nl);
if (!jl_is_long(vnb))
jl_errorf("invalid declaration of bits type %s", ((jl_sym_t*)name)->name);
int32_t nb = jl_unbox_long(vnb);
if (nb < 1 || nb>=(1<<23) || (nb&7) != 0)
jl_errorf("invalid number of bits in type %s",
((jl_sym_t*)name)->name);
jl_datatype_t *dt =
jl_new_bitstype(name, jl_any_type, (jl_tuple_t*)para, nb);
jl_binding_t *b = jl_get_binding_wr(jl_current_module, (jl_sym_t*)name);
jl_checked_assignment(b, (jl_value_t*)dt);
super = eval(args[3], locals, nl);
jl_set_datatype_super(dt, super);
JL_GC_POP();
return (jl_value_t*)jl_nothing;
}
else if (ex->head == compositetype_sym) {
void jl_add_constructors(jl_datatype_t *t);
jl_value_t *name = args[0];
jl_value_t *para = eval(args[1], locals, nl);
jl_value_t *fnames = NULL;
jl_value_t *super = NULL;
jl_datatype_t *dt = NULL;
JL_GC_PUSH(¶, &super, &fnames, &dt);
fnames = eval(args[2], locals, nl);
dt = jl_new_datatype((jl_sym_t*)name, jl_any_type, (jl_tuple_t*)para,
(jl_tuple_t*)fnames, NULL,
0, args[6]==jl_true ? 1 : 0);
dt->fptr = jl_f_ctor_trampoline;
dt->ctor_factory = eval(args[3], locals, nl);
jl_binding_t *b = jl_get_binding_wr(jl_current_module, (jl_sym_t*)name);
jl_checked_assignment(b, (jl_value_t*)dt);
inside_typedef = 1;
dt->types = (jl_tuple_t*)eval(args[5], locals, nl);
inside_typedef = 0;
jl_check_type_tuple(dt->types, dt->name->name, "type definition");
super = eval(args[4], locals, nl);
jl_set_datatype_super(dt, super);
jl_compute_field_offsets(dt);
jl_add_constructors(dt);
JL_GC_POP();
return (jl_value_t*)jl_nothing;
}
else if (ex->head == macro_sym) {
jl_sym_t *nm = (jl_sym_t*)args[0];
assert(jl_is_symbol(nm));
jl_function_t *f = (jl_function_t*)eval(args[1], locals, nl);
assert(jl_is_function(f));
if (jl_boot_file_loaded &&
f->linfo && f->linfo->ast && jl_is_expr(f->linfo->ast)) {
jl_lambda_info_t *li = f->linfo;
li->ast = jl_compress_ast(li, li->ast);
li->name = nm;
}
jl_set_global(jl_current_module, nm, (jl_value_t*)f);
return (jl_value_t*)jl_nothing;
}
else if (ex->head == line_sym) {
jl_lineno = jl_unbox_long(jl_exprarg(ex,0));
return (jl_value_t*)jl_nothing;
}
else if (ex->head == module_sym) {
return jl_eval_module_expr(ex);
}
else if (ex->head == error_sym || ex->head == jl_continue_sym) {
if (jl_is_byte_string(args[0]))
jl_errorf("syntax: %s", jl_string_data(args[0]));
jl_throw(args[0]);
}
jl_errorf("unsupported or misplaced expression %s", ex->head->name);
return (jl_value_t*)jl_nothing;
}
static int has_intrinsics(jl_expr_t *e)
{
if (e->args->length == 0)
return 0;
if (e->head == static_typeof_sym) return 1;
jl_value_t *e0 = jl_exprarg(e,0);
if (e->head == call_sym &&
((jl_is_symbol(e0) && is_intrinsic(jl_current_module,(jl_sym_t*)e0)) ||
(jl_is_topnode(e0) && is_intrinsic(jl_base_relative_to(jl_current_module),(jl_sym_t*)jl_fieldref(e0,0)))))
return 1;
int i;
for(i=0; i < e->args->length; i++) {
jl_value_t *a = jl_exprarg(e,i);
if (jl_is_expr(a) && has_intrinsics((jl_expr_t*)a))
return 1;
}
return 0;
}
static jl_value_t *eval(jl_value_t *e, interpreter_state *s)
{
jl_ptls_t ptls = jl_get_ptls_states();
jl_code_info_t *src = s==NULL ? NULL : s->src;
if (jl_is_ssavalue(e)) {
ssize_t id = ((jl_ssavalue_t*)e)->id;
if (id >= jl_source_nssavalues(src) || id < 0 || s->locals == NULL)
jl_error("access to invalid SSAValue");
else
return s->locals[jl_source_nslots(src) + id];
}
if (jl_is_slot(e)) {
ssize_t n = jl_slot_number(e);
if (n > jl_source_nslots(src) || n < 1 || s->locals == NULL)
jl_error("access to invalid slot number");
jl_value_t *v = s->locals[n-1];
if (v == NULL)
jl_undefined_var_error((jl_sym_t*)jl_array_ptr_ref(src->slotnames, n - 1));
return v;
}
if (jl_is_globalref(e)) {
jl_sym_t *s = jl_globalref_name(e);
jl_value_t *v = jl_get_global(jl_globalref_mod(e), s);
if (v == NULL)
jl_undefined_var_error(s);
return v;
}
if (jl_is_quotenode(e))
return jl_fieldref(e,0);
jl_module_t *modu = (s == NULL ? ptls->current_module : s->module);
if (jl_is_symbol(e)) { // bare symbols appear in toplevel exprs not wrapped in `thunk`
jl_value_t *v = jl_get_global(modu, (jl_sym_t*)e);
if (v == NULL)
jl_undefined_var_error((jl_sym_t*)e);
return v;
}
if (!jl_is_expr(e))
return e;
jl_expr_t *ex = (jl_expr_t*)e;
jl_value_t **args = (jl_value_t**)jl_array_data(ex->args);
size_t nargs = jl_array_len(ex->args);
if (ex->head == call_sym) {
return do_call(args, nargs, s);
}
else if (ex->head == invoke_sym) {
return do_invoke(args, nargs, s);
}
else if (ex->head == new_sym) {
jl_value_t *thetype = eval(args[0], s);
jl_value_t *v=NULL;
JL_GC_PUSH2(&thetype, &v);
assert(jl_is_structtype(thetype));
v = jl_new_struct_uninit((jl_datatype_t*)thetype);
for(size_t i=1; i < nargs; i++) {
jl_set_nth_field(v, i-1, eval(args[i], s));
}
JL_GC_POP();
return v;
}
else if (ex->head == static_parameter_sym) {
ssize_t n = jl_unbox_long(args[0]);
assert(n > 0);
if (s->sparam_vals && n <= jl_svec_len(s->sparam_vals)) {
jl_value_t *sp = jl_svecref(s->sparam_vals, n - 1);
if (!jl_is_typevar(sp))
return sp;
}
// static parameter val unknown needs to be an error for ccall
jl_error("could not determine static parameter value");
}
else if (ex->head == inert_sym) {
return args[0];
}
else if (ex->head == copyast_sym) {
return jl_copy_ast(eval(args[0], s));
}
else if (ex->head == exc_sym) {
return ptls->exception_in_transit;
}
else if (ex->head == method_sym) {
jl_sym_t *fname = (jl_sym_t*)args[0];
if (jl_is_globalref(fname)) {
modu = jl_globalref_mod(fname);
fname = jl_globalref_name(fname);
}
assert(jl_expr_nargs(ex) != 1 || jl_is_symbol(fname));
if (jl_is_symbol(fname)) {
jl_value_t **bp=NULL;
jl_value_t *bp_owner=NULL;
jl_binding_t *b=NULL;
if (bp == NULL) {
b = jl_get_binding_for_method_def(modu, fname);
bp = &b->value;
bp_owner = (jl_value_t*)modu;
}
jl_value_t *gf = jl_generic_function_def(fname, bp, bp_owner, b);
if (jl_expr_nargs(ex) == 1)
return gf;
}
jl_value_t *atypes=NULL, *meth=NULL;
JL_GC_PUSH2(&atypes, &meth);
atypes = eval(args[1], s);
meth = eval(args[2], s);
jl_method_def((jl_svec_t*)atypes, (jl_code_info_t*)meth, args[3]);
JL_GC_POP();
return jl_nothing;
}
else if (ex->head == const_sym) {
jl_sym_t *sym = (jl_sym_t*)args[0];
if (jl_is_globalref(sym)) {
modu = jl_globalref_mod(sym);
sym = jl_globalref_name(sym);
}
assert(jl_is_symbol(sym));
jl_binding_t *b = jl_get_binding_wr(modu, sym);
jl_declare_constant(b);
return (jl_value_t*)jl_nothing;
}
else if (ex->head == global_sym) {
// create uninitialized mutable binding for "global x" decl
// TODO: handle type decls
size_t i, l = jl_array_len(ex->args);
for (i = 0; i < l; i++) {
jl_sym_t *gsym = (jl_sym_t*)args[i];
jl_module_t *gmodu = modu;
if (jl_is_globalref(gsym)) {
gmodu = jl_globalref_mod(gsym);
gsym = jl_globalref_name(gsym);
}
assert(jl_is_symbol(gsym));
jl_get_binding_wr(gmodu, gsym);
}
return (jl_value_t*)jl_nothing;
}
else if (ex->head == abstracttype_sym) {
if (inside_typedef)
jl_error("cannot eval a new abstract type definition while defining another type");
jl_value_t *name = args[0];
jl_value_t *para = eval(args[1], s);
jl_value_t *super = NULL;
jl_value_t *temp = NULL;
jl_datatype_t *dt = NULL;
JL_GC_PUSH4(¶, &super, &temp, &dt);
assert(jl_is_svec(para));
if (jl_is_globalref(name)) {
modu = jl_globalref_mod(name);
name = (jl_value_t*)jl_globalref_name(name);
}
assert(jl_is_symbol(name));
dt = jl_new_abstracttype(name, NULL, (jl_svec_t*)para);
jl_binding_t *b = jl_get_binding_wr(modu, (jl_sym_t*)name);
temp = b->value;
check_can_assign_type(b);
b->value = (jl_value_t*)dt;
jl_gc_wb_binding(b, dt);
JL_TRY {
inside_typedef = 1;
super = eval(args[2], s);
jl_set_datatype_super(dt, super);
jl_reinstantiate_inner_types(dt);
}
JL_CATCH {
jl_reset_instantiate_inner_types(dt);
b->value = temp;
jl_rethrow();
}
b->value = temp;
if (temp == NULL || !equiv_type(dt, (jl_datatype_t*)temp)) {
jl_checked_assignment(b, (jl_value_t*)dt);
}
JL_GC_POP();
return (jl_value_t*)jl_nothing;
}
else if (ex->head == bitstype_sym) {
static jl_value_t *eval(jl_value_t *e, jl_value_t **locals, size_t nl)
{
if (jl_is_symbol(e)) {
jl_value_t *v;
size_t i;
for(i=0; i < nl; i++) {
if (locals[i*2] == e) {
v = locals[i*2+1];
break;
}
}
if (i >= nl) {
v = jl_get_global(jl_current_module, (jl_sym_t*)e);
}
if (v == NULL)
jl_errorf("%s not defined", ((jl_sym_t*)e)->name);
return v;
}
if (jl_is_symbolnode(e)) {
return eval((jl_value_t*)jl_symbolnode_sym(e), locals, nl);
}
if (jl_is_quotenode(e)) {
return jl_fieldref(e,0);
}
if (jl_is_topnode(e)) {
jl_value_t *v = jl_get_global(jl_current_module,
(jl_sym_t*)jl_fieldref(e,0));
if (v == NULL)
jl_errorf("%s not defined", ((jl_sym_t*)jl_fieldref(e,0))->name);
return v;
}
if (!jl_is_expr(e)) {
if (jl_is_lambda_info(e)) {
return jl_new_closure_internal((jl_lambda_info_t*)e,
(jl_value_t*)jl_null);
}
return e;
}
jl_expr_t *ex = (jl_expr_t*)e;
jl_value_t **args = &jl_cellref(ex->args,0);
if (ex->head == call_sym || ex->head == call1_sym) {
jl_function_t *f = (jl_function_t*)eval(args[0], locals, nl);
if (!jl_is_func(f))
jl_type_error("apply", (jl_value_t*)jl_function_type,
(jl_value_t*)f);
return do_call(f, &args[1], ex->args->length-1, locals, nl);
}
else if (ex->head == assign_sym) {
jl_value_t *sym = args[0];
size_t i;
for (i=0; i < nl; i++) {
if (locals[i*2] == sym) {
return (locals[i*2+1] = eval(args[1], locals, nl));
}
}
jl_binding_t *b = jl_get_binding_wr(jl_current_module, (jl_sym_t*)sym);
jl_value_t *rhs = eval(args[1], locals, nl);
jl_checked_assignment(b, rhs);
return rhs;
}
else if (ex->head == new_sym) {
jl_value_t *thetype = eval(args[0], locals, nl);
JL_GC_PUSH(&thetype);
assert(jl_is_struct_type(thetype));
jl_value_t *v = jl_new_struct_uninit((jl_struct_type_t*)thetype);
JL_GC_POP();
return v;
}
else if (ex->head == null_sym) {
return (jl_value_t*)jl_nothing;
}
else if (ex->head == body_sym) {
return eval_body(ex->args, locals, nl, 0);
}
else if (ex->head == exc_sym) {
return jl_exception_in_transit;
}
else if (ex->head == static_typeof_sym) {
return (jl_value_t*)jl_any_type;
}
else if (ex->head == method_sym) {
jl_sym_t *fname = (jl_sym_t*)args[0];
jl_value_t **bp=NULL;
jl_binding_t *b=NULL;
size_t i;
for (i=0; i < nl; i++) {
if (locals[i*2] == (jl_value_t*)fname) {
bp = &locals[i*2+1];
break;
}
}
if (bp == NULL) {
b = jl_get_binding_wr(jl_current_module, fname);
bp = &b->value;
}
jl_value_t *atypes=NULL, *meth=NULL;
JL_GC_PUSH(&atypes, &meth);
atypes = eval(args[1], locals, nl);
meth = eval(args[2], locals, nl);
jl_value_t *gf = jl_method_def(fname, bp, b, (jl_tuple_t*)atypes,
(jl_function_t*)meth);
JL_GC_POP();
return gf;
}
else if (ex->head == const_sym) {
jl_value_t *sym = args[0];
size_t i;
for (i=0; i < nl; i++) {
if (locals[i*2] == sym) {
return (jl_value_t*)jl_nothing;
}
}
jl_binding_t *b = jl_get_binding_wr(jl_current_module, (jl_sym_t*)sym);
jl_declare_constant(b);
return (jl_value_t*)jl_nothing;
}
else if (ex->head == error_sym) {
jl_errorf("syntax error: %s", jl_string_data(args[0]));
}
else if (ex->head == line_sym) {
return (jl_value_t*)jl_nothing;
}
else if (ex->head == multivalue_sym) {
return (jl_value_t*)jl_nothing;
}
jl_error("not supported");
return (jl_value_t*)jl_nothing;
}
