aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--TODO.rst6
-rw-r--r--builtin.cpp65
-rw-r--r--builtin.h29
-rw-r--r--eval.cpp2
-rw-r--r--model.cpp16
-rw-r--r--model.h20
6 files changed, 133 insertions, 5 deletions
diff --git a/TODO.rst b/TODO.rst
index 03277cc..b403d33 100644
--- a/TODO.rst
+++ b/TODO.rst
@@ -1,7 +1,5 @@
-- Several built-in support
-
- - delay
-
+- OPT:Special Opt Repr
+- OPT:Special Arg Checking
- Garbage Collection
- Testing
- Rounding support
diff --git a/builtin.cpp b/builtin.cpp
index bed26e5..eebde5e 100644
--- a/builtin.cpp
+++ b/builtin.cpp
@@ -1116,6 +1116,71 @@ ReprCons *SpecialOptApply::get_repr_cons() {
return new ReprStr("#<Builtin Macro: apply>");
}
+SpecialOptForce::SpecialOptForce() : SpecialOptObj("force") {}
+
+void SpecialOptForce::prepare(Pair *pc) {
+ state = 0;
+}
+
+Pair *SpecialOptForce::call(ArgList *args, Environment * &envt,
+ Continuation * &cont, FrameObj ** &top_ptr) {
+ if (args->cdr == empty_list ||
+ TO_PAIR(args->cdr)->cdr != empty_list)
+ throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
+ args = TO_PAIR(args->cdr);
+
+ Pair *ret_addr = static_cast<RetAddr*>(*top_ptr)->addr;
+ if (state)
+ {
+ EvalObj *mem = args->car;
+ prom->feed_mem(mem);
+ *top_ptr++ = mem;
+ return ret_addr->next; // Move to the next instruction
+ }
+ else
+ {
+ if (!args->car->is_prom_obj())
+ throw TokenError("a promise", RUN_ERR_WRONG_TYPE);
+ prom = static_cast<PromObj*>(args->car);
+ EvalObj *mem = prom->get_mem();
+ if (mem) // fetch from memorized result
+ {
+ *top_ptr++ = mem;
+ return ret_addr->next;
+ }
+ else // force
+ {
+ state = 1;
+ top_ptr += 2;
+ return prom->get_entry();
+ }
+ }
+}
+
+ReprCons *SpecialOptForce::get_repr_cons() {
+ return new ReprStr("#<Builtin Macro: force>");
+}
+
+SpecialOptDelay::SpecialOptDelay() : SpecialOptObj("delay") {}
+
+void SpecialOptDelay::prepare(Pair *pc) {
+ if (pc->cdr == empty_list ||
+ TO_PAIR(pc->cdr)->cdr != empty_list)
+ throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
+ pc->next = NULL;
+}
+
+Pair *SpecialOptDelay::call(ArgList *args, Environment * &envt,
+ Continuation * &cont, FrameObj ** &top_ptr) {
+ Pair *ret_addr = static_cast<RetAddr*>(*top_ptr)->addr;
+ Pair *pc = static_cast<Pair*>(ret_addr->car);
+ *top_ptr++ = new PromObj(TO_PAIR(pc->cdr)->car);
+ return ret_addr->next; // Move to the next instruction
+}
+
+ReprCons *SpecialOptDelay::get_repr_cons() {
+ return new ReprStr("#<Builtin Macro: delay>");
+}
BUILTIN_PROC_DEF(make_pair) {
diff --git a/builtin.h b/builtin.h
index 7a34315..332e882 100644
--- a/builtin.h
+++ b/builtin.h
@@ -284,6 +284,35 @@ class SpecialOptApply: public SpecialOptObj {
ReprCons *get_repr_cons();
};
+/** @class SpecialOptDelay
+ * The implementation of `delay` operator
+ */
+class SpecialOptDelay: public SpecialOptObj {
+ public:
+ SpecialOptDelay();
+ void prepare(Pair *pc);
+ Pair *call(ArgList *args, Environment * &envt,
+ Continuation * &cont, FrameObj ** &top_ptr);
+
+ ReprCons *get_repr_cons();
+};
+
+/** @class SpecialOptForce
+ * The implementation of `force` operator
+ */
+class SpecialOptForce: public SpecialOptObj {
+ private:
+ bool state;
+ PromObj* prom;
+ public:
+ SpecialOptForce();
+ void prepare(Pair *pc);
+ Pair *call(ArgList *args, Environment * &envt,
+ Continuation * &cont, FrameObj ** &top_ptr);
+
+ ReprCons *get_repr_cons();
+};
+
#define BUILTIN_PROC_DEF(func)\
diff --git a/eval.cpp b/eval.cpp
index 229d321..0b9150e 100644
--- a/eval.cpp
+++ b/eval.cpp
@@ -24,6 +24,8 @@ void Evaluator::add_builtin_routines() {
ADD_ENTRY("and", new SpecialOptAnd());
ADD_ENTRY("or", new SpecialOptOr());
ADD_ENTRY("apply", new SpecialOptApply());
+ ADD_ENTRY("delay", new SpecialOptDelay());
+ ADD_ENTRY("force", new SpecialOptForce());
ADD_BUILTIN_PROC("+", num_add);
ADD_BUILTIN_PROC("-", num_sub);
diff --git a/model.cpp b/model.cpp
index cf38b13..85d4e04 100644
--- a/model.cpp
+++ b/model.cpp
@@ -55,6 +55,10 @@ bool EvalObj::is_str_obj() {
return otype & CLS_STR_OBJ;
}
+bool EvalObj::is_prom_obj() {
+ return otype & CLS_PROM_OBJ;
+}
+
int EvalObj::get_otype() {
return otype;
}
@@ -385,6 +389,18 @@ VectReprCons::VectReprCons(VecObj *_ptr, EvalObj *_ori) :
}
}
+PromObj::PromObj(EvalObj *exp) :
+ EvalObj(CLS_SIM_OBJ | CLS_PROM_OBJ), entry(new Pair(exp, empty_list)), mem(NULL) {}
+
+Pair *PromObj::get_entry() { return entry; }
+
+ReprCons *PromObj::get_repr_cons() { return new ReprStr("#<Promise>"); }
+
+EvalObj *PromObj::get_mem() { return mem; }
+
+void PromObj::feed_mem(EvalObj *res) { mem = res; }
+
+
bool is_list(Pair *ptr) {
if (ptr == empty_list) return true;
EvalObj *nptr;
diff --git a/model.h b/model.h
index dbd54a5..58f45f4 100644
--- a/model.h
+++ b/model.h
@@ -27,6 +27,7 @@ const int CLS_SIM_OBJ = 1 << 0;
const int CLS_PAIR_OBJ = 1 << 1;
const int CLS_OPT_OBJ = 1 << 3;
+const int CLS_PROM_OBJ = 1 << 9;
const int CLS_SYM_OBJ = 1 << 2;
const int CLS_NUM_OBJ = 1 << 4;
@@ -108,7 +109,8 @@ class EvalObj : public FrameObj {
bool is_bool_obj();
/** Check if the object is a string */
bool is_str_obj();
- /** Check if the object is a operator */
+ /** Check if the object is a promise */
+ bool is_prom_obj();
int get_otype();
virtual void prepare(Pair *pc);
/** Any EvalObj has its external representation */
@@ -398,6 +400,22 @@ class VecObj: public EvalObj {
ReprCons *get_repr_cons();
};
+/**
+ * @class PromObj
+ * Promise support (partial)
+ */
+class PromObj: public EvalObj {
+ private:
+ Pair *entry;
+ EvalObj *mem;
+ public:
+ PromObj(EvalObj *exp);
+ Pair *get_entry();
+ EvalObj *get_mem();
+ void feed_mem(EvalObj *res);
+ ReprCons *get_repr_cons();
+};
+
typedef map<string, EvalObj*> Str2EvalObj;
/** @class Environment
* The environment of current evaluation, i.e. the local variable binding