static Value _evalForeach (Procedure self) {
Exp exp = self->exp;
Exp pairs = exp->u.ternary->a;
Value collection = _EVAL(exp->u.ternary->b);
if (!collection) return NULL;
Value key = NULL, value = NULL;
if (pairs->type == COMMA_EXP) {
key = pairs->u.binary->a->u.value;
value = pairs->u.binary->b->u.value;
} else {
value = pairs->u.value;
}
Assoc assoc = Value_pairs(collection, exp->type == IN_EXP);
Assoc assocNode = assoc;
Value result = Value_new(at_Array, NULL);
int endIndex = 0;
while (self->active && (assocNode = assocNode->next)) {
self->active = 1;
_set(self, key, assocNode->key);
_set(self, value, assocNode->value);
Value_set(result, Value_number(endIndex++), _EVAL(exp->u.ternary->c));
}
Assoc_free(assoc);
free(self);
Value_set(result, at_TV_endIndex, Value_number(endIndex));
return result;
}
static inline void
expose_VM(STATE, VALUE lobby)
{
VALUE vm = Value_new(state, ObjectType);
Value_set(state, lobby, "VM", vm);
// VM.primitives map
DArray *prims = DArray_create(sizeof(VALUE), 10);
VALUE primitives = Map_new(state, prims);
Value_set(state, vm, "primitives", primitives);
// Object
DEFPRIM("to_s", Primitive_to_s);
DEFPRIM("prototype", Primitive_prototype);
DEFPRIM("or", Primitive_or);
DEFPRIM("equals", Primitive_equals);
DEFPRIM("is", Primitive_is);
DEFPRIM("print", Primitive_print);
DEFPRIM("puts", Primitive_puts);
DEFPRIM("require", Primitive_require);
DEFPRIM("clone", Primitive_clone);
// Vector
DEFPRIM("vector_[]", Primitive_Vector_at);
DEFPRIM("vector_push", Primitive_Vector_push);
DEFPRIM("vector_to_map", Primitive_Vector_to_map);
DEFPRIM("vector_each", Primitive_Vector_each);
DEFPRIM("vector_each_with_index", Primitive_Vector_each_with_index);
// Number
DEFPRIM("number_+", Primitive_Number_add);
DEFPRIM("number_-", Primitive_Number_sub);
DEFPRIM("number_*", Primitive_Number_mul);
DEFPRIM("number_/", Primitive_Number_div);
DEFPRIM("number_<", Primitive_Number_lt);
DEFPRIM("number_>", Primitive_Number_gt);
// String
DEFPRIM("string_+", Primitive_String_concat);
// Map
DEFPRIM("map_each", Primitive_Map_each);
// VM.types map
DArray *ts = DArray_create(sizeof(VALUE), 10);
VALUE types = Map_new(state, ts);
Value_set(state, vm, "types", types);
DEFVALUE("object", Object_bp);
DEFVALUE("number", Number_bp);
DEFVALUE("string", String_bp);
DEFVALUE("vector", Vector_bp);
DEFVALUE("map", Map_bp);
DEFVALUE("closure", Closure_bp);
}
static Value _evalWhile (Procedure self) {
Exp exp = self->exp;
Value cond = _EVAL(exp->u.binary->a);
Value result = Value_new(at_Array, NULL);
int endIndex = 0;
while (self->active && (exp->type == WHILE_EXP && cond || exp->type == UNTIL_EXP && !cond)) {
self->active = 1;
Value_set(result, Value_number(endIndex++), _EVAL(exp->u.binary->b));
cond = _EVAL(exp->u.binary->a);
}
free(self);
Value_set(result, at_TV_endIndex, Value_number(endIndex));
return result;
}
// ================================================================================================
// _evalTrue, _evalWhile, _evalForeach, _evalBreak, _evalSwitch
// ================================================================================================
static Value _evalTrue (Procedure self, Exp exp) {
Value result = NULL, key = NULL, value = NULL;
Exp iColon = NULL;
real endIndex = 0;
result = Value_new(at_True, NULL);
while (exp) {
TRAVERSEL_COMMA_EXP(exp, iColon);
if (!iColon) continue;
if (iColon->type == ASSIGN_EXP) {
result->meta = at_Function;
result->u.proc = Procedure_new(self, NULL, NULL, result, iColon->u.binary->b);
} else {
if (iColon->type != COLON_EXP && iColon->type != ACCESSOR_EXP) {
key = Value_number(endIndex++);
value = _EVAL(iColon);
} else {
key = _EVAL(iColon->u.binary->a);
value = (iColon->type == ACCESSOR_EXP
? Value_functionAccessor(self, iColon->u.binary->b)
: _EVAL(iColon->u.binary->b)
);
if (Value_is(key, at_Number)) {
endIndex = key->u.number + 1;
}
}
Value_set(result, key, value);
}
}
return result;
}
static Value _evalTo (Procedure self, ExpType type, Exp a, Exp b, Exp c) {
Value va = _EVAL(a), vb = _EVAL(b), vc = _EVAL(c);
if (!vc) { vc = Value_number(1); }
if (!(Value_is(va, at_Number) && Value_is(vb, at_Number) && Value_is(vc, at_Number))) {
yyerror("wrong to expression with NAN.");
return NULL;
}
Value result = Value_new(at_Array, NULL);
int endIndex = 0;
real i = va->u.number;
for (;i < vb->u.number || i == vb->u.number && type == TO_EXP; i += vc->u.number) {
Value_set(result, Value_number(endIndex++), Value_number(i));
}
Value_set(result, at_TV_endIndex, Value_number(endIndex));
return result;
}
static Value _evalAssign (Procedure self, Exp leftExp, Value rightValue) {
Value memberValue = NULL;
Value at = NULL;
if (!leftExp) {
yyerror("null left value in assign expression.");
return NULL;
};
if (leftExp->type == MEMBER_EXP || leftExp->type == AT_EXP || leftExp->type == ME_EXP) {
if (leftExp->type == MEMBER_EXP) {
at = _EVAL(leftExp->u.binary->a);
memberValue = _EVAL(leftExp->u.binary->b);
} else {
at = leftExp->type == AT_EXP ? self->at : self->me;
memberValue = _EVAL(leftExp->u.unary);
}
Value_set(at, memberValue, rightValue);
} else if (leftExp->type == IDENTIFIER_EXP) {
_set(self, leftExp->u.value, rightValue);
} else {
yyerror("wrong left value in assign expression.");
}
return rightValue;
}
VALUE VM_run(STATE)
{
Debugger_load_current_file(state);
int *ip = CURR_FRAME->fn->code;
while(1) {
switch(*ip) {
case NOOP:
break;
case SETLINE: { // debugging
ip++;
Debugger_setline(state, *ip);
break;
}
case PUSH: {
Debugger_evaluate(state);
ip++;
debugi("PUSH %i", *ip);
VALUE value = LITERAL(*ip);
Stack_push(STACK, value);
break;
}
case PUSHTRUE: {
Debugger_evaluate(state);
debugi("PUSHTRUE");
Stack_push(STACK, TrueObject);
break;
}
case PUSHFALSE: {
Debugger_evaluate(state);
debugi("PUSHFALSE");
Stack_push(STACK, FalseObject);
break;
}
case PUSHNIL: {
Debugger_evaluate(state);
debugi("PUSHNIL");
Stack_push(STACK, NilObject);
break;
}
case JMP: {
Debugger_evaluate(state);
ip++;
int jump = *ip;
debugi("JMP %i", jump);
while(jump--) ip++;
break;
}
case JIF: {
Debugger_evaluate(state);
ip++;
int jump = *ip;
debugi("JIF %i", jump);
VALUE value = Stack_pop(STACK);
if (value == FalseObject || value == NilObject) {
while(jump--) ip++;
}
break;
}
case JIT: {
Debugger_evaluate(state);
ip++;
int jump = *ip;
debugi("JIT %i", jump);
VALUE value = Stack_pop(STACK);
if (value != FalseObject && value != NilObject) {
while(jump--) ip++;
}
break;
}
case GOTO: {
Debugger_evaluate(state);
ip++;
int jump = *ip - 2;
debugi("GOTO %i", jump);
ip = CURR_FRAME->fn->code;
while(jump--) ip++;
break;
}
case GETSLOT: {
Debugger_evaluate(state);
ip++;
debugi("GETSLOT %i", *ip);
VALUE receiver = Stack_pop(STACK);
VALUE slot = LITERAL(*ip);
check(receiver->type != NilType, "Tried to get a slot from nil.");
check(slot->type == StringType, "Slot name must be a String.");
VALUE value = Value_get(receiver, VAL2STR(slot));
check(value, "Undefined slot %s on object type %i.", VAL2STR(slot), receiver->type);
Stack_push(STACK, value);
break;
}
case SETSLOT: {
Debugger_evaluate(state);
ip++;
debugi("SETSLOT %i", *ip);
VALUE value = Stack_pop(STACK);
VALUE receiver = Stack_pop(STACK);
VALUE slot = LITERAL(*ip);
check(receiver->type != NilType, "Tried to set a slot on nil.");
check(slot->type == StringType, "Slot name must be a String.");
Value_set(state, receiver, VAL2STR(slot), value);
Stack_push(STACK, value); // push the rhs back to the stack
break;
}
case DEFN: {
Debugger_evaluate(state);
ip++;
debugi("DEFN %i", *ip);
VALUE fn_name = LITERAL(*ip);
bstring state_fn = bfromcstr(VAL2STR(fn_name));
VALUE closure = Closure_new(state, STATE_FN(state_fn), CURR_FRAME);
bdestroy(state_fn);
Stack_push(STACK, closure);
break;
}
case MAKEVEC: {
Debugger_evaluate(state);
ip++;
debugi("MAKEVEC %i", *ip);
int count = *ip;
DArray *array = DArray_create(sizeof(VALUE), count || 1);
while(count--) {
VALUE elem = Stack_pop(STACK);
check(elem, "Stack underflow.");
GC_protect(elem);
DArray_push(array, elem);
}
VALUE vector = Vector_new(state, array);
Stack_push(STACK, vector);
Vector_each(vector, ^ void (VALUE element) {
GC_unprotect(element);
});
break;
}
case SEND: {
Debugger_evaluate(state);
ip++;
int op1 = *ip;
ip++;
int op2 = *ip;
debugi("SEND %i %i", op1, op2);
VALUE name = LITERAL(op1);
int argcount = op2;
DArray *locals = DArray_create(sizeof(VALUE), argcount+1);
while(argcount--) {
DArray_push(locals, Stack_pop(STACK));
}
VALUE receiver = Stack_pop(STACK);
// Special chicken-egg case. We cannot define "apply" as a native method
// on Closure, since that triggers the creation of a new closure ad
// infinitum, so we have to handle this special function here.
if(receiver->type == ClosureType &&
strcmp(VAL2STR(name), "apply") == 0) {
state->ret = ip; // save where we want to return
ip = Function_call(state, VAL2FN(receiver), CURR_FRAME->self, locals, VAL2STR(name));
break;
}
VALUE closure = Value_get(receiver, VAL2STR(name));
check(closure, "Undefined slot %s on object type %i.", VAL2STR(name), receiver->type);
if (closure->type != ClosureType && closure != NilObject) {
// GETSLOT
Stack_push(STACK, closure);
DArray_destroy(locals);
break;
}
#ifdef OPTIMIZE_SEND
if(op2 == 1 && strcmp(VAL2STR(name), "[]") == 0) { // getslot
VALUE key = (VALUE)DArray_at(locals, 0);
Stack_push(STACK, Value_get(receiver, VAL2STR(key)));
DArray_destroy(locals);
break;
}
if(op2 == 2 && strcmp(VAL2STR(name), "[]=") == 0) { // setslot
VALUE key = (VALUE)DArray_at(locals, 0);
VALUE value = (VALUE)DArray_at(locals, 1);
Value_set(receiver, VAL2STR(key), value);
Stack_push(STACK, value);
DArray_destroy(locals);
break;
}
#endif
state->ret = ip; // save where we want to return
ip = Function_call(state, VAL2FN(closure), receiver, locals, VAL2STR(name));
break;
}
case PUSHLOBBY: {
Debugger_evaluate(state);
debugi("PUSHLOBBY");
Stack_push(STACK, state->lobby);
break;
}
case PUSHSELF: {
Debugger_evaluate(state);
debugi("PUSHSELF");
Stack_push(STACK, CURR_FRAME->self);
break;
}
case PUSHLOCAL: {
Debugger_evaluate(state);
ip++;
Stack_push(STACK, LOCAL(*ip));
debugi("PUSHLOCAL %i", *ip);
break;
}
case PUSHLOCALDEPTH: {
Debugger_evaluate(state);
ip++;
int depth = *ip;
ip++;
Stack_push(STACK, DEEPLOCAL(depth, *ip));
debugi("PUSHLOCALDEPTH %i %i", depth, *ip);
break;
}
case SETLOCAL: {
Debugger_evaluate(state);
ip++;
debugi("SETLOCAL %i", *ip);
LOCALSET(*ip, Stack_peek(STACK));
break;
}
case SETLOCALDEPTH: {
Debugger_evaluate(state);
ip++;
int depth = *ip;
ip++;
debugi("SETLOCAL %i %i", depth, *ip);
DEEPLOCALSET(depth, *ip, Stack_peek(STACK));
break;
}
case POP: {
Debugger_evaluate(state);
ip++;
int count = *ip;
debugi("POP %i", count);
check(Stack_count(STACK) >= count, "Stack underflow.");
while(count--) Stack_pop(STACK);
break;
}
case RET: {
Debugger_evaluate(state);
debugi("RET");
CallFrame *old_frame = Stack_pop(FRAMES);
ip = old_frame->ret;
CallFrame_destroy(old_frame);
check(Stack_count(STACK) > 0, "Stack underflow.");
if (ip == NULL) return Stack_pop(STACK); // if there's nowhere to return, exit
break;
}
case DUMP: {
Debugger_evaluate(state);
debugi("DUMP");
Stack_print(state, STACK);
DArray *literals = CURR_FRAME->fn->literals;
printf("--LITERALS (%i)--\n", DArray_count(literals));
Value_print_all(state, literals);
DArray *locals = CURR_FRAME->locals;
printf("--LOCALS (%i)--\n", DArray_count(locals));
Value_print_all(state, locals);
break;
}
}