diff options
Diffstat (limited to 'builtin.cpp')
-rw-r--r-- | builtin.cpp | 103 |
1 files changed, 67 insertions, 36 deletions
diff --git a/builtin.cpp b/builtin.cpp index 374f3f2..f1b518f 100644 --- a/builtin.cpp +++ b/builtin.cpp @@ -47,50 +47,50 @@ SpecialOptIf::SpecialOptIf() : SpecialOptObj() {} void SpecialOptIf::prepare(Cons *pc) { state = 0; // Prepared - pc = pc->cdr; + pc = TO_CONS(pc->cdr); if (pc == empty_list) throw TokenError("if", SYN_ERR_MISS_OR_EXTRA_EXP); pc->skip = false; - pc = pc->cdr; + pc = TO_CONS(pc->cdr); if (pc == empty_list) throw TokenError("if", SYN_ERR_MISS_OR_EXTRA_EXP); pc->skip = true; if (pc->cdr != empty_list) - pc->cdr->skip = true; + TO_CONS(pc->cdr)->skip = true; } void SpecialOptIf::pre_call(ArgList *args, Cons *pc, Environment *envt) { // static_cast because it's a call invocation - pc = static_cast<Cons*>(pc->car)->cdr; + pc = TO_CONS(TO_CONS(pc->car)->cdr); // Condition evaluated and the decision is made state = 1; - if (args->cdr->car->is_true()) + if (TO_CONS(args->cdr)->car->is_true()) { pc->skip = true; - pc = pc->cdr; + pc = TO_CONS(pc->cdr); pc->skip = false; if (pc->cdr != empty_list) - pc->cdr->skip = true; // Eval the former + TO_CONS(pc->cdr)->skip = true; // Eval the former } else { pc->skip = true; - pc = pc->cdr; - pc->cdr->skip = true; + pc = TO_CONS(pc->cdr); + TO_CONS(pc->cdr)->skip = true; if (pc->cdr != empty_list) - pc->cdr->skip = false; //Eval the latter + TO_CONS(pc->cdr)->skip = false; //Eval the latter } } EvalObj *SpecialOptIf::post_call(ArgList *args, Cons *pc, Environment *envt) { // Value already evaluated, so just return it - return args->cdr->car; + return TO_CONS(args->cdr)->car; } Cons *SpecialOptIf::call(ArgList *args, Environment * &envt, @@ -119,7 +119,8 @@ string SpecialOptIf::_debug_repr() { return ext_repr(); } SpecialOptLambda::SpecialOptLambda() : SpecialOptObj() {} #define FILL_MARKS(pc, flag) \ - for (Cons *ptr = pc->cdr; ptr != empty_list; ptr = ptr->cdr) \ + for (Cons *ptr = TO_CONS(pc->cdr); \ + ptr != empty_list; ptr = TO_CONS(ptr->cdr)) \ ptr->skip = flag void SpecialOptLambda::prepare(Cons *pc) { @@ -136,16 +137,16 @@ Cons *SpecialOptLambda::call(ArgList *args, Environment * &envt, if (pc->cdr == empty_list) throw TokenError("lambda", SYN_ERR_EMPTY_PARA_LIST); - if (pc->cdr->cdr == empty_list) + if (TO_CONS(pc->cdr)->cdr == empty_list) throw TokenError("lambda", SYN_ERR_MISS_OR_EXTRA_EXP); - SymbolList *para_list = static_cast<SymbolList*>(pc->cdr->car); + SymbolList *para_list = static_cast<SymbolList*>(TO_CONS(pc->cdr)->car); // Clear the flag to avoid side-effects (e.g. proc calling) FILL_MARKS(pc, false); // store a list of expressions inside <body> - ASTList *body = pc->cdr->cdr; // Truncate the expression list - for (Cons *ptr = body; ptr != empty_list; ptr = ptr->cdr) + ASTList *body = TO_CONS(TO_CONS(pc->cdr)->cdr); // Truncate the expression list + for (Cons *ptr = body; ptr != empty_list; ptr = TO_CONS(ptr->cdr)) ptr->next = NULL; // Make each expression an orphan *top_ptr++ = new ProcObj(body, envt, para_list); @@ -164,13 +165,13 @@ void SpecialOptDefine::prepare(Cons *pc) { if (pc->cdr == empty_list) throw TokenError("define", SYN_ERR_MISS_OR_EXTRA_EXP); - if (pc->cdr->car->is_simple_obj()) // Simple value assignment + if (TO_CONS(pc->cdr)->car->is_simple_obj()) // Simple value assignment { - pc = pc->cdr; + pc = TO_CONS(pc->cdr); if (pc->cdr == empty_list) throw TokenError("define", SYN_ERR_MISS_OR_EXTRA_EXP); pc->skip = true; // Skip the identifier - pc->cdr->skip = false; + TO_CONS(pc->cdr)->skip = false; } // Procedure definition else FILL_MARKS(pc, true); // Skip all parts } @@ -182,19 +183,19 @@ Cons *SpecialOptDefine::call(ArgList *args, Environment * &envt, EvalObj *obj; SymObj *id; // TODO: check identifier - EvalObj *first = pc->cdr->car; + EvalObj *first = TO_CONS(pc->cdr)->car; if (first->is_simple_obj()) { if (!first->is_sym_obj()) throw TokenError(first->ext_repr(), SYN_ERR_NOT_AN_ID); id = static_cast<SymObj*>(first); - obj = args->cdr->car; + obj = TO_CONS(args->cdr)->car; } else { // static_cast because of is_simple_obj() is false - Cons *plst = static_cast<Cons*>(pc->cdr->car); + Cons *plst = static_cast<Cons*>(TO_CONS(pc->cdr)->car); if (plst == empty_list) throw TokenError("if", SYN_ERR_EMPTY_PARA_LIST); @@ -202,16 +203,16 @@ Cons *SpecialOptDefine::call(ArgList *args, Environment * &envt, throw TokenError(first->ext_repr(), SYN_ERR_NOT_AN_ID); id = static_cast<SymObj*>(plst->car); - ArgList *para_list = plst->cdr; + ArgList *para_list = TO_CONS(plst->cdr); // Clear the flag to avoid side-effects (e.g. proc calling) FILL_MARKS(pc, false); - ASTList *body = pc->cdr->cdr; // Truncate the expression list + ASTList *body = TO_CONS(TO_CONS(pc->cdr)->cdr); // Truncate the expression list if (body == empty_list) throw TokenError("define", SYN_ERR_MISS_OR_EXTRA_EXP); - for (Cons *ptr = body; ptr != empty_list; ptr = ptr->cdr) + for (Cons *ptr = body; ptr != empty_list; ptr = TO_CONS(ptr->cdr)) ptr->next = NULL; // Make each expression a orphan obj = new ProcObj(body, envt, para_list); @@ -228,13 +229,13 @@ string SpecialOptDefine::_debug_repr() { return ext_repr(); } #endif void SpecialOptSet::prepare(Cons *pc) { - pc = pc->cdr; + pc = TO_CONS(pc->cdr); if (pc == empty_list) throw TokenError("set!", SYN_ERR_MISS_OR_EXTRA_EXP); pc->skip = true; // Skip the identifier - pc = pc->cdr; + pc = TO_CONS(pc->cdr); if (pc == empty_list) throw TokenError("set!", SYN_ERR_MISS_OR_EXTRA_EXP); @@ -245,14 +246,14 @@ Cons *SpecialOptSet::call(ArgList *args, Environment * &envt, Continuation * &cont, FrameObj ** &top_ptr) { Cons *ret_addr = static_cast<RetAddr*>(*top_ptr)->addr; Cons *pc = static_cast<Cons*>(ret_addr->car); - EvalObj *first = pc->cdr->car; + EvalObj *first = TO_CONS(pc->cdr)->car; if (!first->is_sym_obj()) throw TokenError(first->ext_repr(), SYN_ERR_NOT_AN_ID); SymObj *id = static_cast<SymObj*>(first); - bool flag = envt->add_binding(id, args->cdr->car, false); + bool flag = envt->add_binding(id, TO_CONS(args->cdr)->car, false); if (!flag) throw TokenError(id->ext_repr(), RUN_ERR_UNBOUND_VAR); *top_ptr++ = new UnspecObj(); return ret_addr->next; @@ -266,10 +267,39 @@ string SpecialOptSet::ext_repr() { return string("#<Builtin Macro: set!>"); } string SpecialOptSet::_debug_repr() { return ext_repr(); } #endif +EvalObj *builtin_cons(ArgList *args) { + if (args == empty_list || + args->cdr == empty_list || + TO_CONS(args->cdr)->cdr != empty_list) + throw TokenError("cons", RUN_ERR_WRONG_NUM_OF_ARGS); + + return new Cons(args->car, TO_CONS(args->cdr)->car); +} + +EvalObj *builtin_car(ArgList *args) { + if (args == empty_list || + args->cdr != empty_list) + throw TokenError("car", RUN_ERR_WRONG_NUM_OF_ARGS); + if (!args->car->is_cons_obj()) + throw TokenError("pair", RUN_ERR_WRONG_TYPE); + + return TO_CONS(args->car)->car; +} + +EvalObj *builtin_cdr(ArgList *args) { + if (args == empty_list || + args->cdr != empty_list) + throw TokenError("cdr", RUN_ERR_WRONG_NUM_OF_ARGS); + if (!args->car->is_cons_obj()) + throw TokenError("pair", RUN_ERR_WRONG_TYPE); + + return TO_CONS(args->car)->cdr; +} + EvalObj *builtin_plus(ArgList *args) { // TODO: type conversion and proper arithmetic int res = 0; - for (Cons *ptr = args; ptr != empty_list; ptr = ptr->cdr) + for (Cons *ptr = args; ptr != empty_list; ptr = TO_CONS(ptr->cdr)) res += dynamic_cast<IntObj*>(ptr->car)->val; return new IntObj(res); } @@ -277,7 +307,8 @@ EvalObj *builtin_plus(ArgList *args) { EvalObj *builtin_minus(ArgList *args) { // TODO: type conversion and proper arithmetic int res = dynamic_cast<IntObj*>(args->car)->val; - for (Cons *ptr = args->cdr; ptr != empty_list; ptr = ptr->cdr) + for (Cons *ptr = TO_CONS(args->cdr); + ptr != empty_list; ptr = TO_CONS(ptr->cdr)) res -= dynamic_cast<IntObj*>(ptr->car)->val; return new IntObj(res); } @@ -285,7 +316,7 @@ EvalObj *builtin_minus(ArgList *args) { EvalObj *builtin_times(ArgList *args) { // TODO: type conversion and proper arithmetic int res = 1; - for (Cons *ptr = args; ptr != empty_list; ptr = ptr->cdr) + for (Cons *ptr = args; ptr != empty_list; ptr = TO_CONS(ptr->cdr)) res *= dynamic_cast<IntObj*>(ptr->car)->val; return new IntObj(res); } @@ -293,24 +324,24 @@ EvalObj *builtin_times(ArgList *args) { EvalObj *builtin_div(ArgList *args) { // TODO: type conversion and proper arithmetic int res = dynamic_cast<IntObj*>(args->car)->val; - for (Cons *ptr = args->cdr; ptr != empty_list; ptr = ptr->cdr) + for (Cons *ptr = TO_CONS(args->cdr); ptr != empty_list; ptr = TO_CONS(ptr->cdr)) res /= dynamic_cast<IntObj*>(ptr->car)->val; return new IntObj(res); } EvalObj *builtin_lt(ArgList *args) { return new BoolObj(dynamic_cast<IntObj*>(args->car)->val < - dynamic_cast<IntObj*>(args->cdr->car)->val); + dynamic_cast<IntObj*>(TO_CONS(args->cdr)->car)->val); } EvalObj *builtin_gt(ArgList *args) { return new BoolObj(dynamic_cast<IntObj*>(args->car)->val > - dynamic_cast<IntObj*>(args->cdr->car)->val); + dynamic_cast<IntObj*>(TO_CONS(args->cdr)->car)->val); } EvalObj *builtin_arithmetic_eq(ArgList *args) { return new BoolObj(dynamic_cast<IntObj*>(args->car)->val == - dynamic_cast<IntObj*>(args->cdr->car)->val); + dynamic_cast<IntObj*>(TO_CONS(args->cdr)->car)->val); } EvalObj *builtin_display(ArgList *args) { |