aboutsummaryrefslogtreecommitdiff
path: root/builtin.cpp
diff options
context:
space:
mode:
Diffstat (limited to 'builtin.cpp')
-rw-r--r--builtin.cpp182
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;
+}