diff options
author | Teddy <ted.sybil@gmail.com> | 2013-08-11 09:58:22 +0800 |
---|---|---|
committer | Teddy <ted.sybil@gmail.com> | 2013-08-11 09:58:22 +0800 |
commit | 05f893bbe7e8a839c26cc951fafb166c25d0a6ee (patch) | |
tree | 26ede7d65a8baf4038fd97c297bb9cb7b5a7b7be /builtin.cpp | |
parent | 2729f71c327f8ef4ddbb620dc486e7334ba40119 (diff) |
`apply` and `or` support
Diffstat (limited to 'builtin.cpp')
-rw-r--r-- | builtin.cpp | 141 |
1 files changed, 141 insertions, 0 deletions
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; |