//helper fxn to eval <bindings><body> returns value of <body>
Node *
Let::eval_body(Node * p, Environment * env) {
if(p == NULL || p->isNull())
{
Node * list = new Cons(new Nil(), new Nil());
return list;
}else
{
Node * arg, * exp, * rest;
arg = p->getCar()->getCar();
exp = p->getCar()->getCdr()->getCar();
rest = p->getCdr();
if(arg->isSymbol())
{ //define var in local scope
env->define(arg,exp->eval(env));
return eval_body(rest, env);
}else if (arg->isPair())//found exp to be evaluated, exp->eval(env)
{
return arg->eval(env);
}else if(arg == NULL || arg->isNull())
{
return new Nil();
}
}
}
jl_value_t *jl_interpret_toplevel_thunk_with(jl_lambda_info_t *lam,
jl_value_t **loc, size_t nl)
{
jl_expr_t *ast = (jl_expr_t*)lam->ast;
jl_array_t *stmts = jl_lam_body(ast)->args;
jl_array_t *l = jl_lam_locals(ast);
size_t llength = jl_array_len(l);
jl_value_t **names = &((jl_value_t**)l->data)[0];
nl += llength;
jl_value_t **locals;
JL_GC_PUSHARGS(locals, nl*2);
jl_value_t *r = (jl_value_t*)jl_null;
size_t i=0;
for(i=0; i < llength; i++) {
locals[i*2] = names[i];
locals[i*2+1] = NULL;
}
for(; i < nl; i++) {
locals[i*2] = loc[(i-llength)*2];
locals[i*2+1] = loc[(i-llength)*2+1];
}
r = eval_body(stmts, locals, nl, 0);
JL_GC_POP();
return r;
}
//LAB #2
Node *
Let::eval(Node * p, Environment * env) {
Node * args, * exp;
Environment * local = new Environment(env);
args = p->getCdr()->getCar();
exp = p->getCdr()->getCdr()->getCar();
args = eval_body(args, local);
return exp->eval(local);
}
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;
}
object_t *let (object_t * lst)
{
DOC ("Create variable bindings in a new scope, and eval "
"body in that scope.");
/* verify structure */
if (!LISTP (CAR (lst)))
THROW (c_sym ("bad-let-form"), UPREF (lst));
object_t *vlist = CAR (lst);
while (vlist != NIL)
{
object_t *p = CAR (vlist);
if (!LISTP (p))
THROW (c_sym ("bad-let-form"), UPREF (lst));
if (!SYMBOLP (CAR (p)))
THROW (c_sym ("bad-let-form"), UPREF (lst));
vlist = CDR (vlist);
}
object_t *p;
p = vlist = CAR (lst);
int cnt = 0;
while (p != NIL)
{
object_t *pair = CAR (p);
object_t *e = eval (CAR (CDR (pair)));
if (e == err_symbol)
{
/* Undo scoping */
p = vlist;
while (cnt)
{
sympop (CAR (CAR (p)));
p = CDR (p);
cnt--;
}
return err_symbol;
}
sympush (CAR (pair), e);
obj_destroy (e);
p = CDR (p);
cnt++;
}
object_t *r = eval_body (CDR (lst));
p = vlist;
while (p != NIL)
{
object_t *pair = CAR (p);
sympop (CAR (pair));
p = CDR (p);
}
return r;
}
object_t *lisp_if (object_t * lst)
{
DOC ("If conditional special form.");
REQM (lst, 2, wrong_number_of_arguments);
object_t *r = eval (CAR (lst));
CHECK (r);
if (r != NIL)
{
obj_destroy (r);
return eval (CAR (CDR (lst)));
}
return eval_body (CDR (CDR (lst)));
}
object_t *lisp_while (object_t * lst)
{
DOC ("Continually evaluate body until first argument evals nil.");
REQM (lst, 1, c_sym ("while"));
object_t *r = NIL, *cond = CAR (lst), *body = CDR (lst);
object_t *condr;
while ((condr = eval (cond)) != NIL)
{
obj_destroy (r);
obj_destroy (condr);
CHECK (condr);
r = eval_body (body);
}
return r;
}
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;
}
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 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;
}
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_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);
}
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;
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(jl_current_module, fname);
if (b == NULL) {
// if no existing binding for this, make a new one
b = jl_get_binding_wr(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 jl_nothing;
}
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 < ex->args->length; 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_tag_type_t *tt=jl_new_tagtype(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*)tt);
super = eval(args[2], locals, nl);
jl_set_tag_type_super(tt, 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_bits_type_t *bt = jl_new_bits_type(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*)bt);
super = eval(args[3], locals, nl);
jl_set_tag_type_super((jl_tag_type_t*)bt, super);
JL_GC_POP();
return (jl_value_t*)jl_nothing;
}
else if (ex->head == compositetype_sym) {
void jl_add_constructors(jl_struct_type_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_struct_type_t *st = NULL;
JL_GC_PUSH(¶, &super, &fnames, &st);
fnames = eval(args[2], locals, nl);
st = jl_new_struct_type((jl_sym_t*)name, jl_any_type, (jl_tuple_t*)para,
(jl_tuple_t*)fnames, NULL);
st->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*)st);
st->types = (jl_tuple_t*)eval(args[5], locals, nl);
jl_check_type_tuple(st->types, st->name->name, "type definition");
super = eval(args[4], locals, nl);
jl_set_tag_type_super((jl_tag_type_t*)st, super);
jl_compute_struct_offsets(st);
jl_add_constructors(st);
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_expander(jl_current_module, nm, f);
return (jl_value_t*)jl_nothing;
}
else if (ex->head == error_sym || ex->head == jl_continue_sym) {
if (jl_is_byte_string(args[0]))
jl_errorf("syntax error: %s", jl_string_data(args[0]));
jl_raise(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_errorf("unsupported or misplaced expression %s", ex->head->name);
return (jl_value_t*)jl_nothing;
}
jl_value_t *jl_toplevel_eval_body(jl_array_t *stmts)
{
return eval_body(stmts, NULL, 0, 0, 1);
}