aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorTeddy <ted.sybil@gmail.com>2013-08-11 09:58:22 +0800
committerTeddy <ted.sybil@gmail.com>2013-08-11 09:58:22 +0800
commit05f893bbe7e8a839c26cc951fafb166c25d0a6ee (patch)
tree26ede7d65a8baf4038fd97c297bb9cb7b5a7b7be
parent2729f71c327f8ef4ddbb620dc486e7334ba40119 (diff)
`apply` and `or` support
-rw-r--r--TODO.rst10
-rw-r--r--builtin.cpp141
-rw-r--r--builtin.h35
-rw-r--r--eval.cpp7
-rw-r--r--model.cpp20
-rw-r--r--model.h7
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();
};