`apply` and `or` support

6 files changed, 211 insertions, 9 deletions

diff --git a/TODO.rst b/TODO.rst
index b05a8d4..03277cc 100644
--- a/TODO.rst
+++ b/TODO.rst
@@ -1,13 +1,9 @@
 - Several built-in support
-  - or
-  - string=?
-  - string<?
-  - string>?
-  - string<=?
-  - string>=?
 
+  - delay
+
+- Garbage Collection
 - Testing
 - Rounding support
-- Garbage Collection?
 - ext_repr optimization 
 - Add macro support
diff --git a/builtin.cpp b/builtin.cpp
index 39d083a..bed26e5 100644
--- a/builtin.cpp
+++ b/builtin.cpp
@@ -1022,6 +1022,102 @@ ReprCons *SpecialOptAnd::get_repr_cons() {
     return new ReprStr("#<Builtin Macro: and>");
 }
 
+SpecialOptOr::SpecialOptOr() : SpecialOptObj("or") {}
+
+void SpecialOptOr::prepare(Pair *pc) {
+    CHECK_COM(pc);
+    if (pc->cdr != empty_list)
+    {
+        pc->next = TO_PAIR(pc->cdr);
+        pc->next->next = NULL;
+    }
+}
+
+Pair *SpecialOptOr::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);
+    if (args->cdr == empty_list)
+    {
+        *top_ptr++ = new BoolObj(false);
+        return ret_addr->next;
+    }
+    EvalObj *ret = TO_PAIR(args->cdr)->car;
+    if (!ret->is_true())
+    {
+        if (pc->next->cdr == empty_list) // the last member
+        {
+            *top_ptr++ = ret;
+            return ret_addr->next;
+        }
+        else
+        {
+            top_ptr += 2;
+            pc->next = TO_PAIR(pc->next->cdr);
+            pc->next->next = NULL;
+            return pc->next;
+        }
+    }
+    else
+    {
+        *top_ptr++ = ret;
+        return ret_addr->next;
+    }
+    throw NormalError(INT_ERR);
+}
+
+ReprCons *SpecialOptOr::get_repr_cons() {
+    return new ReprStr("#<Builtin Macro: or>");
+}
+
+SpecialOptApply::SpecialOptApply() : SpecialOptObj("apply") {}
+
+void SpecialOptApply::prepare(Pair *pc) {}
+
+Pair *SpecialOptApply::call(ArgList *args, Environment * &envt,
+        Continuation * &cont, FrameObj ** &top_ptr) {
+    top_ptr++;          // Recover the return address
+    if (args->cdr == empty_list)
+        throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
+
+    args = TO_PAIR(args->cdr);
+    if (!args->car->is_opt_obj())
+        throw TokenError("an operator", RUN_ERR_WRONG_TYPE);
+
+    *top_ptr++ = args->car;
+    args = TO_PAIR(args->cdr);
+    if (args == empty_list)
+        throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
+
+    for (; args->cdr != empty_list; args = TO_PAIR(args->cdr))
+        *top_ptr++ = args->car;
+
+    if (args->car != empty_list)
+    {
+        if (!args->car->is_pair_obj())
+            throw TokenError("a list", RUN_ERR_WRONG_TYPE);
+
+        args = TO_PAIR(args->car);
+        EvalObj *nptr;
+        for (;;)
+        {
+            *top_ptr++ = args->car;
+            if ((nptr = args->cdr)->is_pair_obj())
+                args = TO_PAIR(nptr);
+            else break;
+        }
+        if (args->cdr != empty_list)
+            throw TokenError("a list", RUN_ERR_WRONG_TYPE);
+    }
+    return NULL; // force the invocation
+}
+
+ReprCons *SpecialOptApply::get_repr_cons() {
+    return new ReprStr("#<Builtin Macro: apply>");
+}
+
+
+
 BUILTIN_PROC_DEF(make_pair) {
     ARGS_EXACTLY_TWO;
     return new Pair(args->car, TO_PAIR(args->cdr)->car);
@@ -1706,6 +1802,51 @@ BUILTIN_PROC_DEF(is_symbol) {
     return new BoolObj(args->car->is_sym_obj());
 }
 
+BUILTIN_PROC_DEF(string_lt) {
+    ARGS_EXACTLY_TWO;
+    EvalObj *obj1 = args->car;
+    EvalObj *obj2 = TO_PAIR(args->cdr)->car;
+    if (!obj1->is_str_obj() || !obj2->is_str_obj())
+        throw TokenError("a string", RUN_ERR_WRONG_TYPE);
+    return new BoolObj(static_cast<StrObj*>(obj1)->lt(static_cast<StrObj*>(obj2)));
+}
+
+BUILTIN_PROC_DEF(string_le) {
+    ARGS_EXACTLY_TWO;
+    EvalObj *obj1 = args->car;
+    EvalObj *obj2 = TO_PAIR(args->cdr)->car;
+    if (!obj1->is_str_obj() || !obj2->is_str_obj())
+        throw TokenError("a string", RUN_ERR_WRONG_TYPE);
+    return new BoolObj(static_cast<StrObj*>(obj1)->le(static_cast<StrObj*>(obj2)));
+}
+
+BUILTIN_PROC_DEF(string_gt) {
+    ARGS_EXACTLY_TWO;
+    EvalObj *obj1 = args->car;
+    EvalObj *obj2 = TO_PAIR(args->cdr)->car;
+    if (!obj1->is_str_obj() || !obj2->is_str_obj())
+        throw TokenError("a string", RUN_ERR_WRONG_TYPE);
+    return new BoolObj(static_cast<StrObj*>(obj1)->lt(static_cast<StrObj*>(obj2)));
+}
+
+BUILTIN_PROC_DEF(string_ge) {
+    ARGS_EXACTLY_TWO;
+    EvalObj *obj1 = args->car;
+    EvalObj *obj2 = TO_PAIR(args->cdr)->car;
+    if (!obj1->is_str_obj() || !obj2->is_str_obj())
+        throw TokenError("a string", RUN_ERR_WRONG_TYPE);
+    return new BoolObj(static_cast<StrObj*>(obj1)->le(static_cast<StrObj*>(obj2)));
+}
+
+BUILTIN_PROC_DEF(string_eq) {
+    ARGS_EXACTLY_TWO;
+    EvalObj *obj1 = args->car;
+    EvalObj *obj2 = TO_PAIR(args->cdr)->car;
+    if (!obj1->is_str_obj() || !obj2->is_str_obj())
+        throw TokenError("a string", RUN_ERR_WRONG_TYPE);
+    return new BoolObj(static_cast<StrObj*>(obj1)->eq(static_cast<StrObj*>(obj2)));
+}
+
 
 BUILTIN_PROC_DEF(display) {
     ARGS_EXACTLY_ONE;
diff --git a/builtin.h b/builtin.h
index 3285db7..7a34315 100644
--- a/builtin.h
+++ b/builtin.h
@@ -249,8 +249,6 @@ class SpecialOptEval: public SpecialOptObj {
  * The implementation of `and` operator
  */
 class SpecialOptAnd: public SpecialOptObj {
-    private:
-        unsigned char state; /**< 0 for prepared, 1 for pre_called */
     public:
         SpecialOptAnd();
         void prepare(Pair *pc);
@@ -260,6 +258,34 @@ class SpecialOptAnd: public SpecialOptObj {
         ReprCons *get_repr_cons();
 };
 
+/** @class SpecialOptOr
+ * The implementation of `and` operator
+ */
+class SpecialOptOr: public SpecialOptObj {
+    public:
+        SpecialOptOr();
+        void prepare(Pair *pc);
+        Pair *call(ArgList *args, Environment * &envt,
+                    Continuation * &cont, FrameObj ** &top_ptr);
+
+        ReprCons *get_repr_cons();
+};
+
+/** @class SpecialOptApply
+ * The implementation of `apply` operator
+ */
+class SpecialOptApply: public SpecialOptObj {
+    public:
+        SpecialOptApply();
+        void prepare(Pair *pc);
+        Pair *call(ArgList *args, Environment * &envt,
+                    Continuation * &cont, FrameObj ** &top_ptr);
+
+        ReprCons *get_repr_cons();
+};
+
+
+
 #define BUILTIN_PROC_DEF(func)\
     EvalObj *(func)(ArgList *args, const string &name)
 
@@ -311,6 +337,11 @@ BUILTIN_PROC_DEF(is_equal);
 BUILTIN_PROC_DEF(display);
 BUILTIN_PROC_DEF(is_string);
 BUILTIN_PROC_DEF(is_symbol);
+BUILTIN_PROC_DEF(string_lt);
+BUILTIN_PROC_DEF(string_le);
+BUILTIN_PROC_DEF(string_gt);
+BUILTIN_PROC_DEF(string_ge);
+BUILTIN_PROC_DEF(string_eq);
 
 
 #endif
diff --git a/eval.cpp b/eval.cpp
index 6e56eb4..229d321 100644
--- a/eval.cpp
+++ b/eval.cpp
@@ -22,6 +22,8 @@ void Evaluator::add_builtin_routines() {
     ADD_ENTRY("quote", new SpecialOptQuote());
     ADD_ENTRY("eval", new SpecialOptEval());
     ADD_ENTRY("and", new SpecialOptAnd());
+    ADD_ENTRY("or", new SpecialOptOr());
+    ADD_ENTRY("apply", new SpecialOptApply());
 
     ADD_BUILTIN_PROC("+", num_add);
     ADD_BUILTIN_PROC("-", num_sub);
@@ -73,6 +75,11 @@ void Evaluator::add_builtin_routines() {
     ADD_BUILTIN_PROC("display", display);
     ADD_BUILTIN_PROC("string?", is_string);
     ADD_BUILTIN_PROC("symbol?", is_symbol);
+    ADD_BUILTIN_PROC("string<?", string_lt);
+    ADD_BUILTIN_PROC("string<=?", string_le);
+    ADD_BUILTIN_PROC("string>?", string_gt);
+    ADD_BUILTIN_PROC("string<=?", string_ge);
+    ADD_BUILTIN_PROC("string=?", string_eq);
 }
 
 Evaluator::Evaluator() {
diff --git a/model.cpp b/model.cpp
index 7434690..cf38b13 100644
--- a/model.cpp
+++ b/model.cpp
@@ -258,6 +258,26 @@ StrObj *StrObj::from_string(string repr) {
     return NULL;
 }
 
+bool StrObj::lt(StrObj *r) {
+    return str < r->str;
+}
+
+bool StrObj::gt(StrObj *r) {
+    return str > r->str;
+}
+
+bool StrObj::le(StrObj *r) {
+    return str <= r->str;
+}
+
+bool StrObj::ge(StrObj *r) {
+    return str >= r->str;
+}
+
+bool StrObj::eq(StrObj *r) {
+    return str == r->str;
+}
+
 BuiltinProcObj::BuiltinProcObj(BuiltinProc f, string _name) :
     OptObj(), handler(f), name(_name) {}
 
diff --git a/model.h b/model.h
index 0b7ac19..dbd54a5 100644
--- a/model.h
+++ b/model.h
@@ -106,7 +106,9 @@ class EvalObj : public FrameObj {
         bool is_num_obj();
         /** Check if the object is a boolean */
         bool is_bool_obj();
+        /** Check if the object is a string */
         bool is_str_obj();
+        /** Check if the object is a operator */
         int get_otype();
         virtual void prepare(Pair *pc);
         /** Any EvalObj has its external representation */
@@ -352,6 +354,11 @@ class StrObj: public EvalObj {
          * @return NULL if failed
          */
         static StrObj *from_string(string repr);
+        bool lt(StrObj *r);
+        bool gt(StrObj *r);
+        bool le(StrObj *r);
+        bool ge(StrObj *r);
+        bool eq(StrObj *r);
         ReprCons *get_repr_cons();
 };