diff options
| -rw-r--r-- | Makefile | 2 | ||||
| -rw-r--r-- | builtin.cpp | 73 | ||||
| -rw-r--r-- | builtin.h | 16 | ||||
| -rw-r--r-- | eval.cpp | 1 | ||||
| -rw-r--r-- | main.cpp | 2 | ||||
| -rw-r--r-- | model.cpp | 225 | ||||
| -rw-r--r-- | model.h | 6 | ||||
| -rw-r--r-- | parser.cpp | 2 | ||||
| -rw-r--r-- | robust_test.scm | 6 |
9 files changed, 204 insertions, 129 deletions
@@ -2,7 +2,7 @@ main: main.o parser.o builtin.o model.o eval.o exc.o consts.o g++ -o main $^ -pg -lgmp .cpp.o: - g++ $< -c -g -pg -DGMP_SUPPORT + g++ $< -c -g -pg -DGMP_SUPPORT -Wall -Wextra -Wconversion clean: rm -f *.o diff --git a/builtin.cpp b/builtin.cpp index 27b3ee7..a5d8b15 100644 --- a/builtin.cpp +++ b/builtin.cpp @@ -30,15 +30,6 @@ static const int NUM_LVL_INT = 3; if (args == empty_list) \ throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS) -bool is_list(Pair *ptr) { - if (ptr == empty_list) return true; - EvalObj *nptr; - for (;;) - if ((nptr = ptr->cdr)->is_pair_obj()) - ptr = TO_PAIR(nptr); - else break; - return ptr->cdr == empty_list; -} string double_to_str(double val, bool force_sign = false) { stringstream ss; @@ -95,7 +86,7 @@ CompNumObj::CompNumObj(double _real, double _imag) : CompNumObj *CompNumObj::from_string(string repr) { // spos: the position of the last sign // ipos: the position of i - int spos = -1, ipos = -1; + long long spos = -1, ipos = -1; size_t len = repr.length(); bool sign; for (size_t i = 0; i < len; i++) @@ -117,7 +108,7 @@ CompNumObj::CompNumObj(double _real, double _imag) : if (spos > 0) { string real_str = repr.substr(0, spos); - if (int_ptr = IntNumObj::from_string(real_str)) + if ((int_ptr = IntNumObj::from_string(real_str))) #ifndef GMP_SUPPORT real = int_ptr->val; #else @@ -136,7 +127,7 @@ CompNumObj::CompNumObj(double _real, double _imag) : if (ipos > spos + 1) { string imag_str = repr.substr(spos + 1, ipos - spos - 1); - if (int_ptr = IntNumObj::from_string(imag_str)) + if ((int_ptr = IntNumObj::from_string(imag_str))) #ifndef GMP_SUPPORT imag = int_ptr->val; #else @@ -854,7 +845,6 @@ Pair *SpecialOptEval::call(ArgList *args, Environment * &envt, TO_PAIR(args->cdr)->cdr != empty_list) throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS); Pair *ret_addr = static_cast<RetAddr*>(*top_ptr)->addr; - Pair *pc = static_cast<Pair*>(ret_addr->car); if (state) { *top_ptr++ = TO_PAIR(args->cdr)->car; @@ -872,6 +862,54 @@ ReprCons *SpecialOptEval::get_repr_cons() { return new ReprStr("#<Builtin Macro: eval>"); } +SpecialOptAnd::SpecialOptAnd() : SpecialOptObj("and") {} + +void SpecialOptAnd::prepare(Pair *pc) { + CHECK_COM(pc); + if (pc->cdr != empty_list) + { + pc->next = TO_PAIR(pc->cdr); + pc->next->next = NULL; + } +} + +Pair *SpecialOptAnd::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(true); + 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 *SpecialOptAnd::get_repr_cons() { + return new ReprStr("#<Builtin Macro: and>"); +} + BUILTIN_PROC_DEF(make_pair) { ARGS_EXACTLY_TWO; return new Pair(args->car, TO_PAIR(args->cdr)->car); @@ -893,9 +931,8 @@ BUILTIN_PROC_DEF(pair_cdr) { return TO_PAIR(args->car)->cdr; } + BUILTIN_PROC_DEF(make_list) { - if (!is_list(args)) - throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS); return args; } @@ -1227,7 +1264,7 @@ BUILTIN_PROC_DEF(is_eqv) { ARGS_EXACTLY_TWO; EvalObj *obj1 = args->car; EvalObj *obj2 = TO_PAIR(args->cdr)->car; - ClassType otype = obj1->get_otype(); + int otype = obj1->get_otype(); if (otype != obj2->get_otype()) return new BoolObj(false); if (otype & CLS_BOOL_OBJ) @@ -1353,11 +1390,15 @@ do { \ if (num1->is_exact() != num2->is_exact()) return new BoolObj(false); if (num1->level < num2->level) + { if (!num1->eq(num1->convert(num2))) return new BoolObj(false); + } else + { if (!num2->eq(num2->convert(num1))) return new BoolObj(false); + } } else if (otype & CLS_CHAR_OBJ) { @@ -8,7 +8,6 @@ using std::string; const int EQUAL_QUEUE_SIZE = 262144; -bool is_list(Pair *ptr); /** @class InexactNumObj * Inexact number implementation (using doubles) @@ -234,6 +233,21 @@ class SpecialOptEval: public SpecialOptObj { ReprCons *get_repr_cons(); }; +/** @class SpecialOptAnd + * The implementation of `and` operator + */ +class SpecialOptAnd: public SpecialOptObj { + private: + unsigned char state; /**< 0 for prepared, 1 for pre_called */ + public: + SpecialOptAnd(); + void prepare(Pair *pc); + Pair *call(ArgList *args, Environment * &envt, + Continuation * &cont, FrameObj ** &top_ptr); + + ReprCons *get_repr_cons(); +}; + #define BUILTIN_PROC_DEF(func)\ EvalObj *(func)(ArgList *args, const string &name) @@ -21,6 +21,7 @@ void Evaluator::add_builtin_routines() { ADD_ENTRY("set!", new SpecialOptSet()); ADD_ENTRY("quote", new SpecialOptQuote()); ADD_ENTRY("eval", new SpecialOptEval()); + ADD_ENTRY("and", new SpecialOptAnd()); ADD_BUILTIN_PROC("+", num_add); ADD_BUILTIN_PROC("-", num_sub); @@ -6,7 +6,7 @@ #include <cstdio> int main() { - freopen("in.scm", "r", stdin); + //freopen("in.scm", "r", stdin); Tokenizor *tk = new Tokenizor(); ASTGenerator *ast = new ASTGenerator(); Evaluator *eval = new Evaluator(); @@ -109,65 +109,65 @@ Pair::Pair(EvalObj *_car, EvalObj *_cdr) : EvalObj(CLS_PAIR_OBJ), car(_car), cdr(_cdr), next(NULL) {} -ReprCons *Pair::get_repr_cons() { - return new PairReprCons(this, this); -} + ReprCons *Pair::get_repr_cons() { + return new PairReprCons(this, this); + } RetAddr::RetAddr(Pair *_addr) : FrameObj(CLS_RET_ADDR), addr(_addr) {} ParseBracket::ParseBracket(unsigned char _btype) : FrameObj(CLS_SIM_OBJ | CLS_PAR_BRA), btype(_btype) {} -UnspecObj::UnspecObj() : EvalObj(CLS_SIM_OBJ) {} + UnspecObj::UnspecObj() : EvalObj(CLS_SIM_OBJ) {} -ReprCons *UnspecObj::get_repr_cons() { - return new ReprStr("#<Unspecified>"); -} + ReprCons *UnspecObj::get_repr_cons() { + return new ReprStr("#<Unspecified>"); + } SymObj::SymObj(const string &str) : EvalObj(CLS_SIM_OBJ | CLS_SYM_OBJ), val(str) {} -ReprCons *SymObj::get_repr_cons() { - return new ReprStr(val); -} + ReprCons *SymObj::get_repr_cons() { + return new ReprStr(val); + } OptObj::OptObj() : EvalObj(CLS_SIM_OBJ | CLS_OPT_OBJ) {} ProcObj::ProcObj(Pair *_body, - Environment *_envt, - EvalObj *_params) : - OptObj(), body(_body), envt(_envt), params(_params) {} - -Pair *ProcObj::call(ArgList *args, Environment * &genvt, - Continuation * &cont, FrameObj ** &top_ptr) { - // Create a new continuation - // static_cast see `call` invocation in eval.cpp - Pair *ret_addr = static_cast<RetAddr*>(*top_ptr)->addr; - Continuation *_cont = new Continuation(genvt, ret_addr, cont, body); - // Create local env and recall the closure - Environment *_envt = new Environment(envt); - // static_cast<SymObj*> because the params is already checked - EvalObj *ppar, *nptr; - for (ppar = params; - ppar->is_pair_obj(); - ppar = TO_PAIR(ppar)->cdr) - { - if ((nptr = args->cdr) != empty_list) - args = TO_PAIR(nptr); - else break; - _envt->add_binding(static_cast<SymObj*>(TO_PAIR(ppar)->car), args->car); - } + Environment *_envt, + EvalObj *_params) : + OptObj(), body(_body), params(_params), envt(_envt) {} + + Pair *ProcObj::call(ArgList *args, Environment * &genvt, + Continuation * &cont, FrameObj ** &top_ptr) { + // Create a new continuation + // static_cast see `call` invocation in eval.cpp + Pair *ret_addr = static_cast<RetAddr*>(*top_ptr)->addr; + Continuation *_cont = new Continuation(genvt, ret_addr, cont, body); + // Create local env and recall the closure + Environment *_envt = new Environment(envt); + // static_cast<SymObj*> because the params is already checked + EvalObj *ppar, *nptr; + for (ppar = params; + ppar->is_pair_obj(); + ppar = TO_PAIR(ppar)->cdr) + { + if ((nptr = args->cdr) != empty_list) + args = TO_PAIR(nptr); + else break; + _envt->add_binding(static_cast<SymObj*>(TO_PAIR(ppar)->car), args->car); + } - if (ppar->is_sym_obj()) - _envt->add_binding(static_cast<SymObj*>(ppar), args->cdr); // (... . var_n) - else if (args->cdr != empty_list || ppar != empty_list) - throw TokenError("", RUN_ERR_WRONG_NUM_OF_ARGS); + if (ppar->is_sym_obj()) + _envt->add_binding(static_cast<SymObj*>(ppar), args->cdr); // (... . var_n) + else if (args->cdr != empty_list || ppar != empty_list) + throw TokenError("", RUN_ERR_WRONG_NUM_OF_ARGS); - genvt = _envt; - cont = _cont; - *top_ptr++ = new RetAddr(NULL); // Mark the entrance of a cont - return body; // Move pc to the proc entry point -} + genvt = _envt; + cont = _cont; + *top_ptr++ = new RetAddr(NULL); // Mark the entrance of a cont + return body; // Move pc to the proc entry point + } ReprCons *ProcObj::get_repr_cons() { return new ReprStr("#<Procedure>"); @@ -194,20 +194,20 @@ BoolObj *BoolObj::from_string(string repr) { } NumObj::NumObj(NumLvl _level, bool _exactness) : - EvalObj(CLS_SIM_OBJ | CLS_NUM_OBJ), level(_level), exactness(_exactness) {} + EvalObj(CLS_SIM_OBJ | CLS_NUM_OBJ), exactness(_exactness), level(_level) {} -bool NumObj::is_exact() { return exactness; } + bool NumObj::is_exact() { return exactness; } -StrObj::StrObj(string _str) : EvalObj(CLS_SIM_OBJ | CLS_STR_OBJ), str(_str) {} + StrObj::StrObj(string _str) : EvalObj(CLS_SIM_OBJ | CLS_STR_OBJ), str(_str) {} -ReprCons *StrObj::get_repr_cons() { - return new ReprStr(str); -} + ReprCons *StrObj::get_repr_cons() { + return new ReprStr(str); + } CharObj::CharObj(char _ch) : EvalObj(CLS_SIM_OBJ | CLS_CHAR_OBJ), ch(_ch) {} CharObj *CharObj::from_string(string repr) { - int len = repr.length(); + size_t len = repr.length(); if (len < 2) return NULL; if (repr[0] != '#' || repr[1] != '\\') return NULL; if (len == 3) return new CharObj(repr[2]); @@ -231,7 +231,7 @@ EvalObj *VecObj::get_obj(int idx) { return vec[idx]; } -int VecObj::get_size() { +size_t VecObj::get_size() { return vec.end() - vec.begin(); } @@ -257,13 +257,13 @@ StrObj *StrObj::from_string(string repr) { BuiltinProcObj::BuiltinProcObj(BuiltinProc f, string _name) : OptObj(), handler(f), name(_name) {} -Pair *BuiltinProcObj::call(ArgList *args, Environment * &envt, - Continuation * &cont, FrameObj ** &top_ptr) { + Pair *BuiltinProcObj::call(ArgList *args, Environment * &envt, + Continuation * &cont, FrameObj ** &top_ptr) { - Pair *ret_addr = static_cast<RetAddr*>(*top_ptr)->addr; - *top_ptr++ = handler(TO_PAIR(args->cdr), name); - return ret_addr->next; // Move to the next instruction -} + Pair *ret_addr = static_cast<RetAddr*>(*top_ptr)->addr; + *top_ptr++ = handler(TO_PAIR(args->cdr), name); + return ret_addr->next; // Move to the next instruction + } ReprCons *BuiltinProcObj::get_repr_cons() { return new ReprStr("#<Builtin Procedure: " + name + ">"); @@ -295,68 +295,79 @@ EvalObj *Environment::get_obj(EvalObj *obj) { Continuation::Continuation(Environment *_envt, Pair *_pc, Continuation *_prev_cont, Pair *_proc_body) : - envt(_envt), pc(_pc), prev_cont(_prev_cont), + prev_cont(_prev_cont), envt(_envt), pc(_pc), proc_body(_proc_body) {} -ReprCons::ReprCons(bool _done, EvalObj *_ori) : done(_done), ori(_ori) {} -ReprStr::ReprStr(string _repr) : ReprCons(true) { repr = _repr; } -EvalObj *ReprStr::next(const string &prev) { - throw NormalError(INT_ERR); -} + ReprCons::ReprCons(bool _done, EvalObj *_ori) : ori(_ori), done(_done) {} + ReprStr::ReprStr(string _repr) : ReprCons(true) { repr = _repr; } + EvalObj *ReprStr::next(const string &prev) { + throw NormalError(INT_ERR); + } PairReprCons::PairReprCons(Pair *_ptr, EvalObj *_ori) : - ReprCons(false, _ori), ptr(_ptr), state(0) {} + ReprCons(false, _ori), state(0), ptr(_ptr) {} -EvalObj *PairReprCons::next(const string &prev) { - repr += prev; - EvalObj *res; - if (state == 0) - { - state = 1; - res = TO_PAIR(ptr)->car; - if (res->is_pair_obj()) - repr += "("; - return res; - } - else if (state == 1) - { - state = 2; - if (TO_PAIR(ptr)->car->is_pair_obj()) - repr += ")"; - ptr = TO_PAIR(ptr)->cdr; - if (ptr == empty_list) + EvalObj *PairReprCons::next(const string &prev) { + repr += prev; + EvalObj *res; + if (state == 0) + { + state = 1; + res = TO_PAIR(ptr)->car; + if (res->is_pair_obj()) + repr += "("; + return res; + } + else if (state == 1) + { + state = 2; + if (TO_PAIR(ptr)->car->is_pair_obj()) + repr += ")"; + ptr = TO_PAIR(ptr)->cdr; + if (ptr == empty_list) + return NULL; + repr += " "; + if (ptr->is_simple_obj()) + repr += ". "; + return ptr; + } + else + { return NULL; - repr += " "; - if (ptr->is_simple_obj()) - repr += ". "; - return ptr; - } - else - { - return NULL; + } } -} VectReprCons::VectReprCons(VecObj *_ptr, EvalObj *_ori) : ReprCons(false, _ori), ptr(_ptr), idx(0) { repr = "#("; } -EvalObj *VectReprCons::next(const string &prev) { - repr += prev; + EvalObj *VectReprCons::next(const string &prev) { + repr += prev; - if (idx && ptr->get_obj(idx - 1)->is_pair_obj()) - repr += ")"; + if (idx && ptr->get_obj(idx - 1)->is_pair_obj()) + repr += ")"; - if (idx == ptr->get_size()) - { - repr += ")"; - return NULL; - } - else - { - if (idx) repr += " "; - EvalObj *res = ptr->get_obj(idx++); - if (res->is_pair_obj()) - repr += "("; - return res; + if (idx == ptr->get_size()) + { + repr += ")"; + return NULL; + } + else + { + if (idx) repr += " "; + EvalObj *res = ptr->get_obj(idx++); + if (res->is_pair_obj()) + repr += "("; + return res; + } } -} + +bool is_list(Pair *ptr) { + if (ptr == empty_list) return true; + EvalObj *nptr; + for (;;) + if ((nptr = ptr->cdr)->is_pair_obj()) + ptr = TO_PAIR(nptr); + else break; + return ptr->cdr == empty_list; +} + @@ -181,7 +181,7 @@ class VecObj; class VectReprCons : public ReprCons { private: VecObj *ptr; - int idx; + size_t idx; public: VectReprCons(VecObj *ptr, EvalObj *ori); EvalObj *next(const string &prev); @@ -377,7 +377,7 @@ class VecObj: public EvalObj { EvalObjVec vec; /** Construct a vector object */ VecObj(); - int get_size(); + size_t get_size(); EvalObj *get_obj(int idx); /** Resize the vector */ void resize(int new_size); @@ -434,4 +434,6 @@ class Continuation { Pair *proc_body); }; +bool is_list(); + #endif @@ -45,7 +45,7 @@ void Tokenizor::set_stream(FILE *_stream) { void str_to_lower(string &str) { size_t len = str.length(); - for (int i = 0; i < len; i++) + for (size_t i = 0; i < len; i++) if ('A' <= str[i] && str[i] <= 'Z') str[i] -= 'A' - 'a'; } diff --git a/robust_test.scm b/robust_test.scm index 9f5c798..0e989b8 100644 --- a/robust_test.scm +++ b/robust_test.scm @@ -166,3 +166,9 @@ t (lambda () '(1 2 3)) (lambda () 1 2 3) (lambda #() 1) + +(define src + '(define g (lambda (x) (if (= x 5) 0 ((lambda () (display x) (g (+ x 1)))))))) +src +(eval src) +(eval '(g 0)) |