From 645549b8a42844fc5a8042a4808c8ebf5050d7da Mon Sep 17 00:00:00 2001 From: Teddy Date: Sun, 4 Aug 2013 23:35:59 +0800 Subject: added support for `cons`, `car`, `cdr` --- builtin.cpp | 103 +++++++++++++++++++++++++++++++++++++++--------------------- builtin.h | 3 ++ consts.cpp | 3 +- consts.h | 3 +- eval.cpp | 5 ++- main.cpp | 2 +- model.cpp | 18 +++++++---- model.h | 9 ++++-- parser.cpp | 6 +++- 9 files changed, 103 insertions(+), 49 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(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(pc->cdr->car); + SymbolList *para_list = static_cast(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 - 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(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(pc->cdr->car); + Cons *plst = static_cast(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(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(*top_ptr)->addr; Cons *pc = static_cast(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(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("#"); } 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(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(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(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(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(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(ptr->car)->val; return new IntObj(res); } EvalObj *builtin_lt(ArgList *args) { return new BoolObj(dynamic_cast(args->car)->val < - dynamic_cast(args->cdr->car)->val); + dynamic_cast(TO_CONS(args->cdr)->car)->val); } EvalObj *builtin_gt(ArgList *args) { return new BoolObj(dynamic_cast(args->car)->val > - dynamic_cast(args->cdr->car)->val); + dynamic_cast(TO_CONS(args->cdr)->car)->val); } EvalObj *builtin_arithmetic_eq(ArgList *args) { return new BoolObj(dynamic_cast(args->car)->val == - dynamic_cast(args->cdr->car)->val); + dynamic_cast(TO_CONS(args->cdr)->car)->val); } EvalObj *builtin_display(ArgList *args) { diff --git a/builtin.h b/builtin.h index 92b2fe0..8d2a6a0 100644 --- a/builtin.h +++ b/builtin.h @@ -133,5 +133,8 @@ EvalObj *builtin_lt(ArgList *); EvalObj *builtin_gt(ArgList *); EvalObj *builtin_arithmetic_eq(ArgList *); EvalObj *builtin_display(ArgList *); +EvalObj *builtin_cons(ArgList *); +EvalObj *builtin_car(ArgList *); +EvalObj *builtin_cdr(ArgList *); #endif diff --git a/consts.cpp b/consts.cpp index c7058b0..ec3ed01 100644 --- a/consts.cpp +++ b/consts.cpp @@ -8,5 +8,6 @@ const char *SYN_ERR_MSG[] = { "Empty parameter list in (%s)", "Wrong number of arguments to procedure (%s)", "Illegal empty combination ()", - "Unexpected \")\"" + "Unexpected \")\"", + "Wrong type (expecting %s)" }; diff --git a/consts.h b/consts.h index 5e3f43d..5991317 100644 --- a/consts.h +++ b/consts.h @@ -9,7 +9,8 @@ enum ErrCode { SYN_ERR_EMPTY_PARA_LIST, RUN_ERR_WRONG_NUM_OF_ARGS, SYN_ERR_EMPTY_COMB, - READ_ERR_UNEXPECTED_RIGHT_BRACKET + READ_ERR_UNEXPECTED_RIGHT_BRACKET, + RUN_ERR_WRONG_TYPE }; extern const char *SYN_ERR_MSG[]; diff --git a/eval.cpp b/eval.cpp index efd1114..de06209 100644 --- a/eval.cpp +++ b/eval.cpp @@ -21,6 +21,9 @@ void Evaluator::add_builtin_routines() { ADD_ENTRY("<", new BuiltinProcObj(builtin_lt, "<")); ADD_ENTRY("=", new BuiltinProcObj(builtin_arithmetic_eq, "=")); ADD_ENTRY("display", new BuiltinProcObj(builtin_display, "display")); + ADD_ENTRY("cons", new BuiltinProcObj(builtin_cons, "cons")); + ADD_ENTRY("car", new BuiltinProcObj(builtin_car, "car")); + ADD_ENTRY("cdr", new BuiltinProcObj(builtin_cdr, "cdr")); ADD_ENTRY("if", new SpecialOptIf()); ADD_ENTRY("lambda", new SpecialOptLambda()); ADD_ENTRY("define", new SpecialOptDefine()); @@ -79,7 +82,7 @@ EvalObj *Evaluator::run_expr(Cons *prog) { RetAddr *ret_addr = static_cast(*top_ptr); if (!ret_addr->addr) { - Cons *nexp = cont->proc_body->cdr; + Cons *nexp = TO_CONS(cont->proc_body->cdr); cont->proc_body = nexp; if (nexp == empty_list) { diff --git a/main.cpp b/main.cpp index e8fe418..230d077 100644 --- a/main.cpp +++ b/main.cpp @@ -11,7 +11,7 @@ void tree_print(Cons *ptr) { if (!ptr || ptr == empty_list) return; ptr->_debug_print(); tree_print(dynamic_cast(ptr->car)); - tree_print(ptr->cdr); + tree_print(TO_CONS(ptr->cdr)); } #endif diff --git a/model.cpp b/model.cpp index 2132d1f..fab17d6 100644 --- a/model.cpp +++ b/model.cpp @@ -35,6 +35,10 @@ bool EvalObj::is_opt_obj() { return otype & CLS_OPT_OBJ; } +bool EvalObj::is_cons_obj() { + return otype & CLS_CONS_OBJ; +} + #ifdef DEBUG void EvalObj::_debug_print() { printf("mem: 0x%llX\n%s\n\n", (unsigned long long)this, @@ -46,11 +50,13 @@ bool EvalObj::is_true() { return true; } -Cons::Cons(EvalObj *_car, Cons *_cdr) : +Cons::Cons(EvalObj *_car, EvalObj *_cdr) : EvalObj(CLS_CONS_OBJ), car(_car), cdr(_cdr), skip(false), - next(cdr == empty_list ? NULL : cdr) {} + next(NULL) {} -string Cons::ext_repr() { return string("#"); } +string Cons::ext_repr() { + return "(" + car->ext_repr() + " . " + cdr->ext_repr() + ")"; +} #ifdef DEBUG string Cons::_debug_repr() { return ext_repr(); } @@ -106,9 +112,9 @@ Cons *ProcObj::call(ArgList *args, Environment * &genvt, Environment *_envt = new Environment(envt); // static_cast because the para_list is already checked Cons *ptr, *ppar; - for (ptr = args->cdr, ppar = para_list; + for (ptr = TO_CONS(args->cdr), ppar = para_list; ptr != empty_list && ppar != empty_list; - ptr = ptr->cdr, ppar = ppar->cdr) + ptr = TO_CONS(ptr->cdr), ppar = TO_CONS(ppar->cdr)) _envt->add_binding(static_cast(ppar->car), ptr->car); if (ptr != empty_list || ppar != empty_list) @@ -137,7 +143,7 @@ Cons *BuiltinProcObj::call(ArgList *args, Environment * &envt, Continuation * &cont, FrameObj ** &top_ptr) { Cons *ret_addr = static_cast(*top_ptr)->addr; - *top_ptr++ = handler(args->cdr); + *top_ptr++ = handler(TO_CONS(args->cdr)); return ret_addr->next; // Move to the next instruction } diff --git a/model.h b/model.h index ebae3d6..a98a475 100644 --- a/model.h +++ b/model.h @@ -19,6 +19,9 @@ static const int CLS_CONS_OBJ = 1 << 1; static const int CLS_SYM_OBJ = 1 << 2; static const int CLS_OPT_OBJ = 1 << 3; +#define TO_CONS(ptr) \ + (static_cast(ptr)) + /** @class FrameObj * Objects that can be held in the evaluation stack */ @@ -76,6 +79,8 @@ class EvalObj : public FrameObj { bool is_sym_obj(); /** Check if the object is an operator */ bool is_opt_obj(); + /** Check if the object is a Cons */ + bool is_cons_obj(); virtual void prepare(Cons *pc); /** Any EvalObj has its external representation */ virtual string ext_repr() = 0; @@ -94,11 +99,11 @@ class EvalObj : public FrameObj { class Cons : public EvalObj { public: EvalObj *car; /**< car (as in Scheme) */ - Cons *cdr; /**< cdr (as in Scheme) */ + EvalObj *cdr; /**< cdr (as in Scheme) */ bool skip; /**< Wether to skip the current branch */ Cons* next; /**< The next branch in effect */ - Cons(EvalObj *car, Cons *cdr); /**< Create a Cons (car . cdr) */ + Cons(EvalObj *car, EvalObj *cdr); /**< Create a Cons (car . cdr) */ #ifdef DEBUG void _debug_print(); string _debug_repr(); diff --git a/parser.cpp b/parser.cpp index 8de812f..f4de5a2 100644 --- a/parser.cpp +++ b/parser.cpp @@ -103,7 +103,11 @@ Cons *ASTGenerator::absorb(Tokenizor *tk) { { Cons *lst = empty_list; while (top_ptr >= parse_stack && *(--top_ptr)) - lst = new Cons(*top_ptr, lst); // Collect the list + { + Cons *_lst = new Cons(*top_ptr, lst); // Collect the list + _lst->next = lst == empty_list ? NULL : lst; + lst = _lst; + } if (top_ptr < parse_stack) throw NormalError(READ_ERR_UNEXPECTED_RIGHT_BRACKET); *top_ptr++ = lst; -- cgit v1.2.3-70-g09d2