#include "builtin.h" #include using std::stringstream; extern EmptyList *empty_list; BoolObj::BoolObj(bool _val) : EvalObj(), val(_val) {} bool BoolObj::is_true() { return val; } string BoolObj::ext_repr() { return string(val ? "#t" : "#f"); } #ifdef DEBUG string BoolObj::_debug_repr() { return ext_repr(); } #endif IntObj::IntObj(int _val) : NumberObj(), val(_val) {} string IntObj::ext_repr() { stringstream ss; ss << val; return ss.str(); } #ifdef DEBUG string IntObj::_debug_repr() { return ext_repr(); } #endif FloatObj::FloatObj(double _val) : NumberObj(), val(_val) {} string FloatObj::ext_repr() { stringstream ss; ss << val; return ss.str(); } #ifdef DEBUG string FloatObj::_debug_repr() { return ext_repr(); } #endif SpecialOptIf::SpecialOptIf() : SpecialOptObj() {} void SpecialOptIf::prepare(Cons *pc) { state = 0; // Prepared pc = pc->cdr; pc->skip = false; pc->cdr->skip = true; if (pc->cdr->cdr != empty_list) pc->cdr->cdr->skip = true; } void SpecialOptIf::pre_call(ArgList *arg_list, Cons *pc, Environment *envt) { pc = dynamic_cast(pc->car); // Condition evaluated and the decision is made state = 1; if (arg_list->cdr->car->is_true()) { pc = pc->cdr; pc->skip = true; pc->cdr->skip = false; if (pc->cdr->cdr != empty_list) pc->cdr->cdr->skip = true; // Eval the former } else { pc = pc->cdr; pc->skip = true; pc->cdr->skip = true; if (pc->cdr->cdr != empty_list) pc->cdr->cdr->skip = false; //Eval the latter } } EvalObj *SpecialOptIf::post_call(ArgList *arg_list, Cons *pc, Environment *envt) { // Value already evaluated, so just return it return arg_list->cdr->car; } Cons *SpecialOptIf::call(ArgList *arg_list, Environment * &envt, Continuation * &cont, FrameObj ** &top_ptr) { Cons *ret_addr = dynamic_cast(*top_ptr); if (state) { *top_ptr = post_call(arg_list, ret_addr, envt); return ret_addr->next; // Move to the next instruction } else { pre_call(arg_list, ret_addr, envt); top_ptr++; // Undo pop and invoke again return dynamic_cast(ret_addr->car)->next; } } string SpecialOptIf::ext_repr() { return string("#"); } #ifdef DEBUG SpecialOptIf::_debug_repr() { return ext_repr(); } #endif SpecialOptLambda::SpecialOptLambda() : SpecialOptObj() {} #define FILL_MARKS(pc, flag) \ for (pc = pc->cdr; pc != empty_list; pc = pc->cdr) \ pc->skip = flag void SpecialOptLambda::prepare(Cons *pc) { //TODO check number of arguments // Do not evaluate anything FILL_MARKS(pc, true); } Cons *SpecialOptLambda::call(ArgList *arg_list, Environment * &envt, Continuation * &cont, FrameObj ** &top_ptr) { Cons *ret_addr = dynamic_cast(*top_ptr); Cons *pc = dynamic_cast(ret_addr->car); SymbolList *para_list = dynamic_cast(pc->cdr->car); // parameter list // Clear the flag to avoid side-effects (e.g. proc calling) FILL_MARKS(pc, false); // store a list of expressions inside ASTList *body = pc->cdr->cdr; // Truncate the expression list for (Cons *ptr = body; ptr != empty_list; ptr = ptr->cdr) ptr->next = NULL; // Make each expression a orphan *top_ptr = new ProcObj(body, envt, para_list); return ret_addr->next; // Move to the next instruction } string SpecialOptLambda::ext_repr() { return string("#"); } #ifdef DEBUG string SpecialOptLambda::_debug_repr() { return ext_repr(); } #endif SpecialOptDefine::SpecialOptDefine() : SpecialOptObj() {} void SpecialOptDefine::prepare(Cons *pc) { if (pc->cdr->car->is_simple_obj()) // Simple value assignment { pc->cdr->skip = true; // Skip the identifier pc->cdr->cdr->skip = false; } // Procedure definition else FILL_MARKS(pc, true); // Skip all parts } Cons *SpecialOptDefine::call(ArgList *arg_list, Environment * &envt, Continuation * &cont, FrameObj ** &top_ptr) { Cons *ret_addr = dynamic_cast(*top_ptr); Cons *pc = dynamic_cast(ret_addr->car); EvalObj *obj; SymObj *id; // TODO: check identifier if (pc->cdr->car->is_simple_obj()) { id = dynamic_cast(pc->cdr->car); obj = arg_list->cdr->car; } else { Cons *plst = dynamic_cast(pc->cdr->car); id = dynamic_cast(plst->car); ArgList *para_list = plst->cdr; // Clear the flag to avoid side-effects (e.g. proc calling) FILL_MARKS(pc, false); ASTList *body = pc->cdr->cdr; // Truncate the expression list for (Cons *ptr = body; ptr != empty_list; ptr = ptr->cdr) ptr->next = NULL; // Make each expression a orphan obj = new ProcObj(body, envt, para_list); } envt->add_binding(id, obj); *top_ptr = obj; return ret_addr->next; } void SpecialOptSet::prepare(Cons *pc) { // TODO: check number of arguments pc->cdr->skip = true; // Skip the identifier pc->cdr->cdr->skip = false; } Cons *SpecialOptSet::call(ArgList *arg_list, Environment * &envt, Continuation * &cont, FrameObj ** &top_ptr) { Cons *ret_addr = dynamic_cast(*top_ptr); Cons *pc = dynamic_cast(ret_addr->car); SymObj *id = dynamic_cast(pc->cdr->car); if (envt->has_obj(id)) envt->add_binding(id, arg_list->cdr->car); *top_ptr = new UnspecObj(); return ret_addr->next; }