`delay` and `force` support is added

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