diff options
Diffstat (limited to 'model.cpp')
| -rw-r--r-- | model.cpp | 297 |
1 files changed, 7 insertions, 290 deletions
@@ -1,14 +1,17 @@ #include <cstdio> + #include "model.h" #include "exc.h" #include "consts.h" +#include "types.h" -static ReprCons *repr_stack[REPR_STACK_SIZE]; -EvalObjAddrHash hash; +const int REPR_STACK_SIZE = 262144; +extern EmptyList *empty_list; -FrameObj::FrameObj(ClassType _ftype) : ftype(_ftype) {} +static EvalObjAddrHash hash; +static ReprCons *repr_stack[REPR_STACK_SIZE]; -EmptyList *empty_list = new EmptyList(); +FrameObj::FrameObj(FrameType _ftype) : ftype(_ftype) {} EmptyList::EmptyList() : Pair(NULL, NULL) {} @@ -123,292 +126,6 @@ string EvalObj::ext_repr() { return res; } -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); - } - -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) {} - - 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); - } - -OptObj::OptObj() : EvalObj(CLS_SIM_OBJ | CLS_OPT_OBJ) {} - -ProcObj::ProcObj(Pair *_body, - 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); - - 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>"); -} - -SpecialOptObj::SpecialOptObj(string _name) : OptObj(), name(_name) {} - -BoolObj::BoolObj(bool _val) : EvalObj(CLS_SIM_OBJ | CLS_BOOL_OBJ), val(_val) {} - -bool BoolObj::is_true() { return val; } - -ReprCons *BoolObj::get_repr_cons() { - return new ReprStr(val ? "#t" : "#f"); -} - -BoolObj *BoolObj::from_string(string repr) { - if (repr.length() != 2 || repr[0] != '#') - return NULL; - if (repr[1] == 't') - return new BoolObj(true); - else if (repr[1] == 'f') - return new BoolObj(false); - return NULL; -} - -NumObj::NumObj(NumLvl _level, bool _exactness) : - EvalObj(CLS_SIM_OBJ | CLS_NUM_OBJ), exactness(_exactness), level(_level) {} - - bool NumObj::is_exact() { return exactness; } - - StrObj::StrObj(string _str) : EvalObj(CLS_SIM_OBJ | CLS_STR_OBJ), str(_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) { - 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]); - string char_name = repr.substr(2, len - 2); - if (char_name == "newline") return new CharObj('\n'); - if (char_name == "space") return new CharObj(' '); - throw TokenError(char_name, RUN_ERR_UNKNOWN_CHAR_NAME); -} - -ReprCons *CharObj::get_repr_cons() { - string val = ""; - if (ch == ' ') val = "space"; - else if (ch == '\n') val = "newline"; - else val += ch; - return new ReprStr("#\\" + val); -} - -VecObj::VecObj() : EvalObj(CLS_SIM_OBJ | CLS_VECT_OBJ) {} - -EvalObj *VecObj::get_obj(int idx) { - return vec[idx]; -} - -size_t VecObj::get_size() { - return vec.end() - vec.begin(); -} - -void VecObj::resize(int new_size) { - vec.resize(new_size); -} - -void VecObj::push_back(EvalObj *new_elem) { - vec.push_back(new_elem); -} - -ReprCons *VecObj::get_repr_cons() { - return new VectReprCons(this, this); -} - -StrObj *StrObj::from_string(string repr) { - size_t len = repr.length(); - if (repr[0] == '\"' && repr[len - 1] == '\"') - return new StrObj(repr.substr(1, len - 2)); - return NULL; -} - -bool StrObj::lt(StrObj *r) { - return str < r->str; -} - -bool StrObj::gt(StrObj *r) { - return str > r->str; -} - -bool StrObj::le(StrObj *r) { - return str <= r->str; -} - -bool StrObj::ge(StrObj *r) { - return str >= r->str; -} - -bool StrObj::eq(StrObj *r) { - return str == r->str; -} - -BuiltinProcObj::BuiltinProcObj(BuiltinProc f, string _name) : - OptObj(), handler(f), name(_name) {} - - 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 - } - -ReprCons *BuiltinProcObj::get_repr_cons() { - return new ReprStr("#<Builtin Procedure: " + name + ">"); -} - -Environment::Environment(Environment *_prev_envt) : prev_envt(_prev_envt) {} - -bool Environment::add_binding(SymObj *sym_obj, EvalObj *eval_obj, bool def) { - bool has_key = binding.count(sym_obj->val); - if (!def && !has_key) return false; - binding[sym_obj->val] = eval_obj; - return true; -} - -EvalObj *Environment::get_obj(EvalObj *obj) { - if (!obj->is_sym_obj()) return obj; - SymObj *sym_obj = static_cast<SymObj*>(obj); - - string name(sym_obj->val); - for (Environment *ptr = this; ptr; ptr = ptr->prev_envt) - { - bool has_key = ptr->binding.count(name); - if (has_key) return ptr->binding[name]; - } - // Object not found - throw TokenError(name, RUN_ERR_UNBOUND_VAR); -} - -Continuation::Continuation(Environment *_envt, Pair *_pc, - Continuation *_prev_cont, - Pair *_proc_body) : - prev_cont(_prev_cont), envt(_envt), pc(_pc), - proc_body(_proc_body) {} - - 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), 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) - 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; - - 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; - } - } - -PromObj::PromObj(EvalObj *exp) : - EvalObj(CLS_SIM_OBJ | CLS_PROM_OBJ), entry(new Pair(exp, empty_list)), mem(NULL) {} - -Pair *PromObj::get_entry() { return entry; } - -ReprCons *PromObj::get_repr_cons() { return new ReprStr("#<Promise>"); } - -EvalObj *PromObj::get_mem() { return mem; } - -void PromObj::feed_mem(EvalObj *res) { mem = res; } bool make_exec(Pair *ptr) { |