diff options
-rw-r--r-- | TODO.rst | 1 | ||||
-rw-r--r-- | builtin.cpp | 157 | ||||
-rw-r--r-- | builtin.h | 2 | ||||
-rw-r--r-- | consts.cpp | 3 | ||||
-rw-r--r-- | consts.h | 3 | ||||
-rw-r--r-- | eval.cpp | 2 | ||||
-rw-r--r-- | main.cpp | 7 | ||||
-rw-r--r-- | model.cpp | 16 | ||||
-rw-r--r-- | model.h | 4 | ||||
-rw-r--r-- | parser.cpp | 6 |
10 files changed, 139 insertions, 62 deletions
@@ -1,3 +1,2 @@ - GMP -- Pair literal parsing - Add macro support diff --git a/builtin.cpp b/builtin.cpp index 0bbd67e..65c1109 100644 --- a/builtin.cpp +++ b/builtin.cpp @@ -16,6 +16,27 @@ static const int NUM_LVL_REAL = 1; static const int NUM_LVL_RAT = 2; static const int NUM_LVL_INT = 3; +#define ARGS_EXACTLY_TWO \ + if (args == empty_list || !args->cdr->is_cons_obj() || \ + TO_CONS(args->cdr)->cdr != empty_list) \ + throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS) \ + +#define ARGS_EXACTLY_ONE \ + if (args == empty_list || !args->cdr->is_cons_obj() ) \ + throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS) + +#define ARGS_AT_LEAST_ONE \ + if (args == empty_list) \ + throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS) + +bool is_list(Cons *ptr) { + EvalObj *nptr; + for (;;) + if ((nptr = ptr->cdr)->is_cons_obj()) + ptr = TO_CONS(nptr); + else break; + return ptr->cdr == empty_list; +} string double_to_str(double val, bool force_sign = false) { stringstream ss; @@ -397,23 +418,37 @@ string IntNumObj::ext_repr() { return int_to_str(val); } -SpecialOptIf::SpecialOptIf() : SpecialOptObj() {} +SpecialOptIf::SpecialOptIf() : SpecialOptObj("if") {} void SpecialOptIf::prepare(Cons *pc) { +#define IF_EXP_ERR \ + throw TokenError("if", RUN_ERR_WRONG_NUM_OF_ARGS) state = 0; // Prepared - pc = TO_CONS(pc->cdr); + if (pc->cdr->is_cons_obj()) + pc = TO_CONS(pc->cdr); + else + IF_EXP_ERR; if (pc == empty_list) - throw TokenError("if", SYN_ERR_MISS_OR_EXTRA_EXP); + IF_EXP_ERR; + pc->skip = false; - pc = TO_CONS(pc->cdr); + if (pc->cdr->is_cons_obj()) + pc = TO_CONS(pc->cdr); + else + IF_EXP_ERR; if (pc == empty_list) - throw TokenError("if", SYN_ERR_MISS_OR_EXTRA_EXP); + IF_EXP_ERR; pc->skip = true; if (pc->cdr != empty_list) - TO_CONS(pc->cdr)->skip = true; + { + if (pc->cdr->is_cons_obj()) + TO_CONS(pc->cdr)->skip = true; + else + IF_EXP_ERR; + } } void SpecialOptIf::pre_call(ArgList *args, Cons *pc, @@ -468,11 +503,43 @@ Cons *SpecialOptIf::call(ArgList *args, Environment * &envt, string SpecialOptIf::ext_repr() { return string("#<Builtin Macro: if>"); } -SpecialOptLambda::SpecialOptLambda() : SpecialOptObj() {} -#define FILL_MARKS(pc, flag) \ - for (Cons *ptr = TO_CONS(pc->cdr); \ - ptr != empty_list; ptr = TO_CONS(ptr->cdr)) \ -ptr->skip = flag +SpecialOptLambda::SpecialOptLambda() : SpecialOptObj("lambda") {} +#define FILL_MARKS(pc, flag) \ +do \ +{ \ + EvalObj *nptr; \ + Cons *ptr; \ + for (ptr = TO_CONS(pc->cdr);;) \ + { \ + ptr->skip = flag; \ + if ((nptr = ptr->cdr)->is_cons_obj()) \ + ptr = TO_CONS(nptr); \ + else break; \ + } \ + if (ptr->cdr != empty_list) \ + throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS); \ +} \ +while (0) + +#define CHECK_PARA_LIST(p) \ +do \ +{ \ + if (p == empty_list) break; \ + EvalObj *nptr; \ + Cons *ptr; \ + for (ptr = TO_CONS(p);;) \ + { \ + if (!ptr->car->is_sym_obj()) \ + throw TokenError(ptr->car->ext_repr(), RUN_ERR_WRONG_NUM_OF_ARGS); \ + if ((nptr = ptr->cdr)->is_cons_obj()) \ + ptr = TO_CONS(nptr); \ + else break; \ + } \ + if (ptr->cdr != empty_list) \ + throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS); \ +} \ +while (0) + void SpecialOptLambda::prepare(Cons *pc) { // Do not evaluate anything @@ -486,16 +553,20 @@ Cons *SpecialOptLambda::call(ArgList *args, Environment * &envt, Cons *pc = static_cast<Cons*>(ret_addr->car); if (pc->cdr == empty_list) - throw TokenError("lambda", SYN_ERR_EMPTY_PARA_LIST); + throw TokenError(name, SYN_ERR_EMPTY_PARA_LIST); if (TO_CONS(pc->cdr)->cdr == empty_list) - throw TokenError("lambda", SYN_ERR_MISS_OR_EXTRA_EXP); + throw TokenError(name, SYN_ERR_MISS_OR_EXTRA_EXP); - SymbolList *para_list = static_cast<SymbolList*>(TO_CONS(pc->cdr)->car); - // Clear the flag to avoid side-effects (e.g. proc calling) + // Clear the flag to avoid side-effects (e.g. proc calling) FILL_MARKS(pc, false); + + pc = TO_CONS(pc->cdr); + CHECK_PARA_LIST(pc->car); + SymbolList *para_list = static_cast<SymbolList*>(pc->car); // store a list of expressions inside <body> - ASTList *body = TO_CONS(TO_CONS(pc->cdr)->cdr); // Truncate the expression list + + ASTList *body = TO_CONS(pc->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 @@ -505,17 +576,17 @@ Cons *SpecialOptLambda::call(ArgList *args, Environment * &envt, string SpecialOptLambda::ext_repr() { return string("#<Builtin Macro: lambda>"); } -SpecialOptDefine::SpecialOptDefine() : SpecialOptObj() {} +SpecialOptDefine::SpecialOptDefine() : SpecialOptObj("define") {} void SpecialOptDefine::prepare(Cons *pc) { - if (pc->cdr == empty_list) - throw TokenError("define", SYN_ERR_MISS_OR_EXTRA_EXP); + if (!pc->cdr->is_cons_obj()) + throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS); - if (TO_CONS(pc->cdr)->car->is_simple_obj()) // Simple value assignment + pc = TO_CONS(pc->cdr); + if (pc->car->is_simple_obj()) // Simple value assignment { - pc = TO_CONS(pc->cdr); - if (pc->cdr == empty_list) - throw TokenError("define", SYN_ERR_MISS_OR_EXTRA_EXP); + if (!pc->cdr->is_cons_obj()) + throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS); pc->skip = true; // Skip the identifier TO_CONS(pc->cdr)->skip = false; } // Procedure definition @@ -533,19 +604,20 @@ Cons *SpecialOptDefine::call(ArgList *args, Environment * &envt, { if (!first->is_sym_obj()) throw TokenError(first->ext_repr(), SYN_ERR_NOT_AN_ID); - + ARGS_EXACTLY_TWO; id = static_cast<SymObj*>(first); obj = TO_CONS(args->cdr)->car; } else { // static_cast because of is_simple_obj() is false - Cons *plst = static_cast<Cons*>(TO_CONS(pc->cdr)->car); + Cons *plst = static_cast<Cons*>(first); if (plst == empty_list) - throw TokenError("if", SYN_ERR_EMPTY_PARA_LIST); + throw TokenError(name, SYN_ERR_EMPTY_PARA_LIST); if (!plst->car->is_sym_obj()) throw TokenError(first->ext_repr(), SYN_ERR_NOT_AN_ID); + CHECK_PARA_LIST(plst->cdr); id = static_cast<SymObj*>(plst->car); ArgList *para_list = TO_CONS(plst->cdr); @@ -555,7 +627,7 @@ Cons *SpecialOptDefine::call(ArgList *args, Environment * &envt, 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); + throw TokenError(name, SYN_ERR_MISS_OR_EXTRA_EXP); for (Cons *ptr = body; ptr != empty_list; ptr = TO_CONS(ptr->cdr)) ptr->next = NULL; // Make each expression a orphan @@ -570,15 +642,17 @@ Cons *SpecialOptDefine::call(ArgList *args, Environment * &envt, string SpecialOptDefine::ext_repr() { return string("#<Builtin Macro: define>"); } void SpecialOptSet::prepare(Cons *pc) { + if (!pc->cdr->is_cons_obj()) + throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS); + pc = TO_CONS(pc->cdr); - if (pc == empty_list) - throw TokenError("set!", SYN_ERR_MISS_OR_EXTRA_EXP); pc->skip = true; // Skip the identifier + if (!pc->cdr->is_cons_obj()) + throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS); + pc = TO_CONS(pc->cdr); - if (pc == empty_list) - throw TokenError("set!", SYN_ERR_MISS_OR_EXTRA_EXP); pc->skip = false; } @@ -591,6 +665,7 @@ Cons *SpecialOptSet::call(ArgList *args, Environment * &envt, if (!first->is_sym_obj()) throw TokenError(first->ext_repr(), SYN_ERR_NOT_AN_ID); + ARGS_EXACTLY_TWO; SymObj *id = static_cast<SymObj*>(first); @@ -600,11 +675,11 @@ Cons *SpecialOptSet::call(ArgList *args, Environment * &envt, return ret_addr->next; } -SpecialOptSet::SpecialOptSet() {} +SpecialOptSet::SpecialOptSet() : SpecialOptObj("set!") {} string SpecialOptSet::ext_repr() { return string("#<Builtin Macro: set!>"); } -SpecialOptQuote::SpecialOptQuote() {} +SpecialOptQuote::SpecialOptQuote() : SpecialOptObj("quote") {} void SpecialOptQuote::prepare(Cons *pc) { // Do not evaluate anything @@ -623,20 +698,6 @@ Cons *SpecialOptQuote::call(ArgList *args, Environment * &envt, string SpecialOptQuote::ext_repr() { return string("#<Builtin Macro: quote>"); } -#define ARGS_EXACTLY_TWO \ - if (args == empty_list || \ - args->cdr == empty_list || \ - TO_CONS(args->cdr)->cdr != empty_list) \ -throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS) - -#define ARGS_EXACTLY_ONE \ - if (args == empty_list || \ - args->cdr != empty_list) \ -throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS) - -#define ARGS_AT_LEAST_ONE \ - if (args == empty_list) \ -throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS) BUILTIN_PROC_DEF(make_pair) { ARGS_EXACTLY_TWO; @@ -660,6 +721,8 @@ BUILTIN_PROC_DEF(pair_cdr) { } BUILTIN_PROC_DEF(make_list) { + if (!is_list(args)) + throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS); return args; } @@ -6,7 +6,7 @@ using std::string; - +bool is_list(Cons *ptr); /** @class InexactNumObj * Inexact number implementation (using doubles) @@ -14,5 +14,6 @@ const char *ERR_MSG[] = { "Illegal character in escape sequence: #\\%s", "Unknown character name: %s", "Improper pair structure", - "Improper vector structure" + "Improper vector structure", + "Bad formal %s in expression" }; @@ -15,7 +15,8 @@ enum ErrCode { PAR_ERR_ILLEGAL_CHAR_IN_ESC, RUN_ERR_UNKNOWN_CHAR_NAME, PAR_ERR_IMPROPER_PAIR, - PAR_ERR_IMPROPER_VECT + PAR_ERR_IMPROPER_VECT, + SYN_ERR_BAD_FORMAL }; extern const char *ERR_MSG[]; @@ -71,6 +71,8 @@ void push(Cons * &pc, FrameObj ** &top_ptr, Environment *envt) { throw NormalError(SYN_ERR_EMPTY_COMB); *top_ptr++ = new RetAddr(pc); // Push the return address + if (!is_list(TO_CONS(pc->car))) + throw TokenError(pc->car->ext_repr(), RUN_ERR_WRONG_NUM_OF_ARGS); // static_cast because of is_simple_obj() is false pc = static_cast<Cons*>(pc->car); // Go deeper to enter the call } @@ -8,10 +8,11 @@ #ifdef DEBUG extern Cons *empty_list; void tree_print(Cons *ptr) { - if (!ptr || ptr == empty_list) return; ptr->_debug_print(); - tree_print(dynamic_cast<Cons*>(ptr->car)); - tree_print(TO_CONS(ptr->cdr)); + if (ptr->car->is_cons_obj()) + tree_print(TO_CONS(ptr->car)); + if (ptr->cdr->is_cons_obj()) + tree_print(TO_CONS(ptr->cdr)); } #endif @@ -146,12 +146,18 @@ Cons *ProcObj::call(ArgList *args, Environment * &genvt, Environment *_envt = new Environment(envt); // static_cast<SymObj*> because the para_list is already checked Cons *ptr, *ppar; - for (ptr = TO_CONS(args->cdr), ppar = para_list; - ptr != empty_list && ppar != empty_list; - ptr = TO_CONS(ptr->cdr), ppar = TO_CONS(ppar->cdr)) + EvalObj *nptr; + for (ptr = TO_CONS(args->cdr), ppar = para_list; + ppar != empty_list; + ppar = TO_CONS(ppar->cdr)) + { _envt->add_binding(static_cast<SymObj*>(ppar->car), ptr->car); + if ((nptr = ptr->cdr)->is_cons_obj()) + ptr = TO_CONS(nptr); + else break; + } - if (ptr != empty_list || ppar != empty_list) + if (ptr->cdr != empty_list || ppar->cdr != empty_list) throw TokenError("", RUN_ERR_WRONG_NUM_OF_ARGS); genvt = _envt; @@ -166,7 +172,7 @@ string ProcObj::ext_repr() { return string("#<Procedure>"); } string ProcObj::_debug_repr() { return ext_repr(); } #endif -SpecialOptObj::SpecialOptObj() : OptObj() {} +SpecialOptObj::SpecialOptObj(string _name) : OptObj(), name(_name) {} BoolObj::BoolObj(bool _val) : EvalObj(CLS_SIM_OBJ | CLS_BOOL_OBJ), val(_val) {} @@ -246,8 +246,10 @@ class ProcObj: public OptObj { * Special builtin syntax (`if`, `define`, `lambda`, etc.) */ class SpecialOptObj: public OptObj { + protected: + string name; public: - SpecialOptObj(); + SpecialOptObj(string name); }; typedef EvalObj* (*BuiltinProc)(ArgList *, const string &); @@ -175,9 +175,11 @@ Cons *ASTGenerator::absorb(Tokenizor *tk) { EvalObj *obj = TO_EVAL(*top_ptr); if (obj->is_sym_obj() && static_cast<SymObj*>(obj)->val == ".") { - improper = true; - if (lst == empty_list || TO_CONS(lst)->cdr != empty_list) + if (improper || + lst == empty_list || + TO_CONS(lst)->cdr != empty_list) throw NormalError(PAR_ERR_IMPROPER_PAIR); + improper = true; lst = TO_CONS(lst)->car; } else |