diff options
Diffstat (limited to 'builtin.cpp')
-rw-r--r-- | builtin.cpp | 182 |
1 files changed, 182 insertions, 0 deletions
diff --git a/builtin.cpp b/builtin.cpp new file mode 100644 index 0000000..232f873 --- /dev/null +++ b/builtin.cpp @@ -0,0 +1,182 @@ +#include "builtin.h" +#include <sstream> + +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<Cons*>(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<Cons*>(*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<Cons*>(ret_addr->car)->next; + } +} + +string SpecialOptIf::ext_repr() { return string("#<Builtin Macro: if>"); } +#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<Cons*>(*top_ptr); + Cons *pc = dynamic_cast<Cons*>(ret_addr->car); + SymbolList *para_list = dynamic_cast<SymbolList*>(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 <body> + 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("#<Builtin Macro: lambda>"); } +#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<Cons*>(*top_ptr); + Cons *pc = dynamic_cast<Cons*>(ret_addr->car); + EvalObj *obj; + SymObj *id; + // TODO: check identifier + if (pc->cdr->car->is_simple_obj()) + { + id = dynamic_cast<SymObj*>(pc->cdr->car); + obj = arg_list->cdr->car; + } + else + { + Cons *plst = dynamic_cast<Cons*>(pc->cdr->car); + id = dynamic_cast<SymObj*>(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<Cons*>(*top_ptr); + Cons *pc = dynamic_cast<Cons*>(ret_addr->car); + SymObj *id = dynamic_cast<SymObj*>(pc->cdr->car); + if (envt->has_obj(id)) + envt->add_binding(id, arg_list->cdr->car); + *top_ptr = new UnspecObj(); + return ret_addr->next; +} |