From dd6394d93dc21305e26232891daf5b19c226dd3a Mon Sep 17 00:00:00 2001 From: Teddy Date: Tue, 6 Aug 2013 21:06:18 +0800 Subject: dot sign support in literal mode --- builtin.cpp | 150 ++++++++++++++++++++++++++++++------------------------------ consts.cpp | 4 +- consts.h | 4 +- eval.cpp | 2 +- model.cpp | 8 +++- parser.cpp | 24 ++++++++-- 6 files changed, 107 insertions(+), 85 deletions(-) diff --git a/builtin.cpp b/builtin.cpp index 9d25644..0bbd67e 100644 --- a/builtin.cpp +++ b/builtin.cpp @@ -69,53 +69,53 @@ InexactNumObj::InexactNumObj(NumLvl level) : NumObj(level, false) {} CompNumObj::CompNumObj(double _real, double _imag) : InexactNumObj(NUM_LVL_COMP), real(_real), imag(_imag) {} -CompNumObj *CompNumObj::from_string(string repr) { - // spos: the position of the last sign - // ipos: the position of i - int spos = -1, ipos = -1; - size_t len = repr.length(); - bool sign; - for (size_t i = 0; i < len; i++) - if (repr[i] == '+' || repr[i] == '-') - { - spos = i; - sign = repr[i] == '-'; - } - else if (repr[i] == 'i' || repr[i] == 'I') - ipos = i; + CompNumObj *CompNumObj::from_string(string repr) { + // spos: the position of the last sign + // ipos: the position of i + int spos = -1, ipos = -1; + size_t len = repr.length(); + bool sign; + for (size_t i = 0; i < len; i++) + if (repr[i] == '+' || repr[i] == '-') + { + spos = i; + sign = repr[i] == '-'; + } + else if (repr[i] == 'i' || repr[i] == 'I') + ipos = i; - if (spos == -1 || ipos == -1 || !(spos < ipos)) - return NULL; + if (spos == -1 || ipos == -1 || !(spos < ipos)) + return NULL; - double real = 0, imag = 1; - IntNumObj *int_ptr; - RatNumObj *rat_ptr; - RealNumObj *real_ptr; - if (spos > 0) - { - string real_str = repr.substr(0, spos); - if (int_ptr = IntNumObj::from_string(real_str)) - real = int_ptr->val; - else if ((rat_ptr = RatNumObj::from_string(real_str))) - real = rat_ptr->a / double(rat_ptr->b); - else if ((real_ptr = RealNumObj::from_string(real_str))) - real = real_ptr->real; - else return NULL; - } - if (ipos > spos + 1) - { - string imag_str = repr.substr(spos + 1, ipos - spos - 1); - if (int_ptr = IntNumObj::from_string(imag_str)) - imag = int_ptr->val; - else if ((rat_ptr = RatNumObj::from_string(imag_str))) - imag = rat_ptr->a / double(rat_ptr->b); - else if ((real_ptr = RealNumObj::from_string(imag_str))) - imag = real_ptr->real; - else return NULL; + double real = 0, imag = 1; + IntNumObj *int_ptr; + RatNumObj *rat_ptr; + RealNumObj *real_ptr; + if (spos > 0) + { + string real_str = repr.substr(0, spos); + if (int_ptr = IntNumObj::from_string(real_str)) + real = int_ptr->val; + else if ((rat_ptr = RatNumObj::from_string(real_str))) + real = rat_ptr->a / double(rat_ptr->b); + else if ((real_ptr = RealNumObj::from_string(real_str))) + real = real_ptr->real; + else return NULL; + } + if (ipos > spos + 1) + { + string imag_str = repr.substr(spos + 1, ipos - spos - 1); + if (int_ptr = IntNumObj::from_string(imag_str)) + imag = int_ptr->val; + else if ((rat_ptr = RatNumObj::from_string(imag_str))) + imag = rat_ptr->a / double(rat_ptr->b); + else if ((real_ptr = RealNumObj::from_string(imag_str))) + imag = real_ptr->real; + else return NULL; + } + if (sign) imag = -imag; + return new CompNumObj(real, imag); } - if (sign) imag = -imag; - return new CompNumObj(real, imag); -} CompNumObj *CompNumObj::convert(NumObj *obj) { switch (obj->level) @@ -127,9 +127,9 @@ CompNumObj *CompNumObj::convert(NumObj *obj) { break; case NUM_LVL_RAT : { - RatNumObj *rat = static_cast(obj); - return new CompNumObj(rat->a / double(rat->b), 0); - break; + RatNumObj *rat = static_cast(obj); + return new CompNumObj(rat->a / double(rat->b), 0); + break; } case NUM_LVL_INT : return new CompNumObj(static_cast(obj)->val, 0); @@ -155,14 +155,14 @@ NumObj *CompNumObj::minus(NumObj *_r) { NumObj *CompNumObj::multi(NumObj *_r) { CompNumObj *r = static_cast(_r); return new CompNumObj(A * C - B * D, - B * C + A * D); + B * C + A * D); } NumObj *CompNumObj::div(NumObj *_r) { CompNumObj *r = static_cast(_r); double f = 1.0 / (C * C + D * D); return new CompNumObj((A * C + B * D) * f, - (B * C - A * D) * f); + (B * C - A * D) * f); } bool CompNumObj::lt(NumObj *_r) { @@ -204,9 +204,9 @@ RealNumObj *RealNumObj::convert(NumObj *obj) { return static_cast(obj); break; case NUM_LVL_RAT: { - RatNumObj *rat = static_cast(obj); - return new RealNumObj(rat->a / double(rat->b)); - break; + RatNumObj *rat = static_cast(obj); + return new RealNumObj(rat->a / double(rat->b)); + break; } case NUM_LVL_INT: return new RealNumObj(static_cast(obj)->val); @@ -250,10 +250,10 @@ ExactNumObj::ExactNumObj(NumLvl level) : NumObj(level, true) {} RatNumObj::RatNumObj(int _a, int _b) : ExactNumObj(NUM_LVL_RAT), a(_a), b(_b) { - int g = gcd(a, b); - a /= g; - b /= g; -} + int g = gcd(a, b); + a /= g; + b /= g; + } RatNumObj *RatNumObj::from_string(string repr) { int a, b; @@ -443,13 +443,13 @@ void SpecialOptIf::pre_call(ArgList *args, Cons *pc, } EvalObj *SpecialOptIf::post_call(ArgList *args, Cons *pc, - Environment *envt) { + Environment *envt) { // Value already evaluated, so just return it return TO_CONS(args->cdr)->car; } Cons *SpecialOptIf::call(ArgList *args, Environment * &envt, - Continuation * &cont, FrameObj ** &top_ptr) { + Continuation * &cont, FrameObj ** &top_ptr) { Cons *ret_addr = static_cast(*top_ptr)->addr; if (state) { @@ -472,7 +472,7 @@ 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 +ptr->skip = flag void SpecialOptLambda::prepare(Cons *pc) { // Do not evaluate anything @@ -480,7 +480,7 @@ void SpecialOptLambda::prepare(Cons *pc) { } Cons *SpecialOptLambda::call(ArgList *args, Environment * &envt, - Continuation * &cont, FrameObj ** &top_ptr) { + Continuation * &cont, FrameObj ** &top_ptr) { Cons *ret_addr = static_cast(*top_ptr)->addr; Cons *pc = static_cast(ret_addr->car); @@ -584,7 +584,7 @@ void SpecialOptSet::prepare(Cons *pc) { } Cons *SpecialOptSet::call(ArgList *args, Environment * &envt, - Continuation * &cont, FrameObj ** &top_ptr) { + Continuation * &cont, FrameObj ** &top_ptr) { Cons *ret_addr = static_cast(*top_ptr)->addr; Cons *pc = static_cast(ret_addr->car); EvalObj *first = TO_CONS(pc->cdr)->car; @@ -612,7 +612,7 @@ void SpecialOptQuote::prepare(Cons *pc) { } Cons *SpecialOptQuote::call(ArgList *args, Environment * &envt, - Continuation * &cont, FrameObj ** &top_ptr) { + Continuation * &cont, FrameObj ** &top_ptr) { Cons *ret_addr = static_cast(*top_ptr)->addr; Cons *pc = static_cast(ret_addr->car); // revert @@ -625,18 +625,18 @@ string SpecialOptQuote::ext_repr() { return string("#"); } #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) + 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) + 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) +throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS) BUILTIN_PROC_DEF(make_pair) { ARGS_EXACTLY_TWO; @@ -645,7 +645,7 @@ BUILTIN_PROC_DEF(make_pair) { BUILTIN_PROC_DEF(pair_car) { ARGS_EXACTLY_ONE; - if (args->car == empty_list || !args->car->is_cons_obj()) + if (!args->car->is_cons_obj()) throw TokenError(name, RUN_ERR_WRONG_TYPE); return TO_CONS(args->car)->car; @@ -653,7 +653,7 @@ BUILTIN_PROC_DEF(pair_car) { BUILTIN_PROC_DEF(pair_cdr) { ARGS_EXACTLY_ONE; - if (args->car == empty_list || !args->car->is_cons_obj()) + if (!args->car->is_cons_obj()) throw TokenError(name, RUN_ERR_WRONG_TYPE); return TO_CONS(args->car)->cdr; @@ -749,7 +749,7 @@ BUILTIN_PROC_DEF(num_lt) { ARGS_AT_LEAST_ONE; if (!args->car->is_num_obj()) throw TokenError("a number", RUN_ERR_WRONG_TYPE); - + NumObj *last = static_cast(args->car), *opr; for (Cons *ptr = TO_CONS(args->cdr); @@ -773,7 +773,7 @@ BUILTIN_PROC_DEF(num_gt) { ARGS_AT_LEAST_ONE; if (!args->car->is_num_obj()) throw TokenError("a number", RUN_ERR_WRONG_TYPE); - + NumObj *last = static_cast(args->car), *opr; for (Cons *ptr = TO_CONS(args->cdr); @@ -797,7 +797,7 @@ BUILTIN_PROC_DEF(num_eq) { ARGS_AT_LEAST_ONE; if (!args->car->is_num_obj()) throw TokenError("a number", RUN_ERR_WRONG_TYPE); - + NumObj *last = static_cast(args->car), *opr; for (Cons *ptr = TO_CONS(args->cdr); @@ -834,7 +834,7 @@ BUILTIN_PROC_DEF(is_pair) { BUILTIN_PROC_DEF(pair_set_car) { ARGS_EXACTLY_TWO; - if (args->car == empty_list || !args->car->is_cons_obj()) + if (!args->car->is_cons_obj()) throw TokenError(name, RUN_ERR_WRONG_TYPE); TO_CONS(args->car)->car = TO_CONS(args->cdr)->car; return new UnspecObj(); @@ -842,7 +842,7 @@ BUILTIN_PROC_DEF(pair_set_car) { BUILTIN_PROC_DEF(pair_set_cdr) { ARGS_EXACTLY_TWO; - if (args->car == empty_list || !args->car->is_cons_obj()) + if (!args->car->is_cons_obj()) throw TokenError(name, RUN_ERR_WRONG_TYPE); TO_CONS(args->car)->cdr = TO_CONS(args->cdr)->car; return new UnspecObj(); diff --git a/consts.cpp b/consts.cpp index db2a4d5..eb17eaa 100644 --- a/consts.cpp +++ b/consts.cpp @@ -12,5 +12,7 @@ const char *ERR_MSG[] = { "Wrong type (expecting %s)", "Internal Error !!! File a bug please!", "Illegal character in escape sequence: #\\%s", - "Unknown character name: %s" + "Unknown character name: %s", + "Improper pair structure", + "Improper vector structure" }; diff --git a/consts.h b/consts.h index 4bfd6b7..dc2c4f6 100644 --- a/consts.h +++ b/consts.h @@ -13,7 +13,9 @@ enum ErrCode { RUN_ERR_WRONG_TYPE, INT_ERR, PAR_ERR_ILLEGAL_CHAR_IN_ESC, - RUN_ERR_UNKNOWN_CHAR_NAME + RUN_ERR_UNKNOWN_CHAR_NAME, + PAR_ERR_IMPROPER_PAIR, + PAR_ERR_IMPROPER_VECT }; extern const char *ERR_MSG[]; diff --git a/eval.cpp b/eval.cpp index 6196e34..e6e6de1 100644 --- a/eval.cpp +++ b/eval.cpp @@ -38,7 +38,7 @@ void Evaluator::add_builtin_routines() { ADD_BUILTIN_PROC("boolean?", is_boolean); ADD_BUILTIN_PROC("pair?", is_pair); - ADD_BUILTIN_PROC("pair", make_pair); + ADD_BUILTIN_PROC("cons", make_pair); ADD_BUILTIN_PROC("car", pair_car); ADD_BUILTIN_PROC("cdr", pair_cdr); ADD_BUILTIN_PROC("set-car!", pair_set_car); diff --git a/model.cpp b/model.cpp index 287c20a..4cfdca0 100644 --- a/model.cpp +++ b/model.cpp @@ -40,9 +40,10 @@ bool EvalObj::is_opt_obj() { } bool EvalObj::is_cons_obj() { - return otype & CLS_CONS_OBJ; + return this != empty_list && (otype & CLS_CONS_OBJ); } + bool EvalObj::is_num_obj() { return otype & CLS_NUM_OBJ; } @@ -227,7 +228,10 @@ string VecObj::ext_repr() { string res = "#("; for (EvalObjVec::iterator it = vec.begin(); it != vec.end(); it++) res += (*it)->ext_repr() + " "; - res[res.length() - 1] = ')'; + if (vec.begin() == vec.end()) + res += ')'; + else + res[res.length() - 1] = ')'; return res; } diff --git a/parser.cpp b/parser.cpp index 05806f1..56b3dd9 100644 --- a/parser.cpp +++ b/parser.cpp @@ -168,20 +168,34 @@ Cons *ASTGenerator::absorb(Tokenizor *tk) { { if (top_ptr == parse_stack) throw NormalError(READ_ERR_UNEXPECTED_RIGHT_BRACKET); - Cons *lst = empty_list; + EvalObj *lst = empty_list; + bool improper = false; while (top_ptr >= parse_stack && !IS_BRAKET(*(--top_ptr))) { - Cons *_lst = new Cons(TO_EVAL(*top_ptr), lst); // Collect the list - _lst->next = lst == empty_list ? NULL : lst; - lst = _lst; + EvalObj *obj = TO_EVAL(*top_ptr); + if (obj->is_sym_obj() && static_cast(obj)->val == ".") + { + improper = true; + if (lst == empty_list || TO_CONS(lst)->cdr != empty_list) + throw NormalError(PAR_ERR_IMPROPER_PAIR); + lst = TO_CONS(lst)->car; + } + else + { + Cons *_lst = new Cons(obj, lst); // Collect the list + _lst->next = lst->is_cons_obj() ? TO_CONS(lst) : NULL; + lst = _lst; + } } + ParseBracket *bptr = TO_BRACKET(*top_ptr); if (bptr->btype == 0) *top_ptr++ = lst; else if (bptr->btype == 1) { + if (improper) throw NormalError(PAR_ERR_IMPROPER_VECT); VecObj *vec = new VecObj(); - for (Cons *ptr = lst; ptr != empty_list; ptr = TO_CONS(ptr->cdr)) + for (Cons *ptr = TO_CONS(lst); ptr != empty_list; ptr = TO_CONS(ptr->cdr)) vec->push_back(ptr->car); *top_ptr++ = vec; } -- cgit v1.2.3-70-g09d2