diff options
| -rw-r--r-- | builtin.cpp | 244 | ||||
| -rw-r--r-- | builtin.h | 44 | ||||
| -rw-r--r-- | eval.cpp | 73 | ||||
| -rw-r--r-- | gc.cpp | 9 | ||||
| -rw-r--r-- | gc.h | 2 | ||||
| -rw-r--r-- | model.cpp | 7 | ||||
| -rw-r--r-- | model.h | 27 | ||||
| -rw-r--r-- | test/q.scm | 17 | ||||
| -rw-r--r-- | types.cpp | 81 | ||||
| -rw-r--r-- | types.h | 27 |
10 files changed, 259 insertions, 272 deletions
diff --git a/builtin.cpp b/builtin.cpp index 4116501..3440ab5 100644 --- a/builtin.cpp +++ b/builtin.cpp @@ -14,7 +14,10 @@ using std::stringstream; extern EmptyList *empty_list; extern UnspecObj *unspec_obj; -SpecialOptIf::SpecialOptIf() : SpecialOptObj("if") {} + + +SpecialOptIf::SpecialOptIf(Environment *envt) : + SpecialOptObj(envt, "if") {} void SpecialOptIf::prepare(Pair *pc) { #define IF_EXP_ERR \ @@ -38,16 +41,16 @@ void SpecialOptIf::prepare(Pair *pc) { pc->next = NULL; } -Pair *SpecialOptIf::call(Pair *args, Environment * &envt, - Continuation * &cont, FrameObj ** &top_ptr) { - RetAddr *ret_info = static_cast<RetAddr*>(*top_ptr); - Pair *ret_addr = ret_info->addr; - if (ret_info->state) +Pair *SpecialOptIf::call(Pair *args, Environment * &lenvt, + Continuation * &cont, EvalObj ** &top_ptr) { + Pair *ret_addr = cont->pc; + if (cont->state) { - if (ret_info->state == empty_list) + if (cont->state == empty_list) { - delete *top_ptr; + gc.expose(*top_ptr); *top_ptr++ = gc.attach(TO_PAIR(args->cdr)->car); + EXIT_CURRENT_CONT(lenvt, cont); gc.expose(args); return ret_addr->next; // Move to the next instruction } @@ -64,7 +67,7 @@ Pair *SpecialOptIf::call(Pair *args, Environment * &envt, // Undo pop and invoke again gc.attach(static_cast<EvalObj*>(*(++top_ptr))); top_ptr++; - ret_info->state = empty_list; + cont->state = empty_list; gc.expose(args); return second; } @@ -74,14 +77,15 @@ Pair *SpecialOptIf::call(Pair *args, Environment * &envt, // Undo pop and invoke again gc.attach(static_cast<EvalObj*>(*(++top_ptr))); top_ptr++; - ret_info->state = empty_list; + cont->state = empty_list; gc.expose(args); return third; } else { - delete *top_ptr; + gc.expose(*top_ptr); *top_ptr++ = gc.attach(unspec_obj); + EXIT_CURRENT_CONT(lenvt, cont); gc.expose(args); return ret_addr->next; } @@ -91,10 +95,10 @@ Pair *SpecialOptIf::call(Pair *args, Environment * &envt, { gc.attach(static_cast<EvalObj*>(*(++top_ptr))); top_ptr++; - ret_info->state = TO_PAIR(TO_PAIR(ret_addr->car)->cdr); - ret_info->state->next = NULL; + cont->state = TO_PAIR(TO_PAIR(ret_addr->car)->cdr); + cont->state->next = NULL; gc.expose(args); - return ret_info->state; + return cont->state; } throw NormalError(INT_ERR); } @@ -138,17 +142,18 @@ do \ } \ while (0) -SpecialOptLambda::SpecialOptLambda() : SpecialOptObj("lambda") {} +SpecialOptLambda::SpecialOptLambda(Environment *envt) : + SpecialOptObj(envt, "lambda") {} void SpecialOptLambda::prepare(Pair *pc) { // Do not evaluate anything pc->next = NULL; } -Pair *SpecialOptLambda::call(Pair *args, Environment * &envt, - Continuation * &cont, FrameObj ** &top_ptr) { +Pair *SpecialOptLambda::call(Pair *args, Environment * &lenvt, + Continuation * &cont, EvalObj ** &top_ptr) { - Pair *ret_addr = static_cast<RetAddr*>(*top_ptr)->addr; + Pair *ret_addr = cont->pc; Pair *pc = static_cast<Pair*>(ret_addr->car); if (pc->cdr == empty_list) @@ -171,13 +176,15 @@ Pair *SpecialOptLambda::call(Pair *args, Environment * &envt, for (Pair *ptr = body; ptr != empty_list; ptr = TO_PAIR(ptr->cdr)) ptr->next = NULL; // Make each expression isolated - delete *top_ptr; - *top_ptr++ = gc.attach(new ProcObj(body, envt, params)); + gc.expose(*top_ptr); + *top_ptr++ = gc.attach(new ProcObj(body, lenvt, params)); + EXIT_CURRENT_CONT(lenvt, cont); gc.expose(args); return ret_addr->next; // Move to the next instruction } -SpecialOptDefine::SpecialOptDefine() : SpecialOptObj("define") {} +SpecialOptDefine::SpecialOptDefine(Environment *envt) : + SpecialOptObj(envt, "define") {} void SpecialOptDefine::prepare(Pair *pc) { Pair *first, *second; @@ -196,24 +203,23 @@ void SpecialOptDefine::prepare(Pair *pc) { pc->next = NULL; } -Pair *SpecialOptDefine::call(Pair *args, Environment * &envt, - Continuation * &cont, FrameObj ** &top_ptr) { - RetAddr* ret_info = static_cast<RetAddr*>(*top_ptr); - Pair *ret_addr = ret_info->addr; +Pair *SpecialOptDefine::call(Pair *args, Environment * &lenvt, + Continuation * &cont, EvalObj ** &top_ptr) { + Pair *ret_addr = cont->pc; Pair *pc = static_cast<Pair*>(ret_addr->car); EvalObj *obj; SymObj *id; EvalObj *first = TO_PAIR(pc->cdr)->car; if (first->is_simple_obj()) { - if (!ret_info->state) + if (!cont->state) { gc.attach(static_cast<EvalObj*>(*(++top_ptr))); top_ptr++; - ret_info->state = TO_PAIR(TO_PAIR(pc->cdr)->cdr); - ret_info->state->next = NULL; + cont->state = TO_PAIR(TO_PAIR(pc->cdr)->cdr); + cont->state->next = NULL; gc.expose(args); - return ret_info->state; + return cont->state; } if (!first->is_sym_obj()) throw TokenError(first->ext_repr(), SYN_ERR_NOT_AN_ID); @@ -245,16 +251,18 @@ Pair *SpecialOptDefine::call(Pair *args, Environment * &envt, for (Pair *ptr = body; ptr != empty_list; ptr = TO_PAIR(ptr->cdr)) ptr->next = NULL; // Make each expression a orphan - obj = new ProcObj(body, envt, params); + obj = new ProcObj(body, lenvt, params); } - envt->add_binding(id, obj); - delete *top_ptr; + lenvt->add_binding(id, obj); + gc.expose(*top_ptr); *top_ptr++ = gc.attach(unspec_obj); + EXIT_CURRENT_CONT(lenvt, cont); gc.expose(args); return ret_addr->next; } -SpecialOptSet::SpecialOptSet() : SpecialOptObj("set!") {} +SpecialOptSet::SpecialOptSet(Environment *envt) : + SpecialOptObj(envt, "set!") {} void SpecialOptSet::prepare(Pair *pc) { Pair *first, *second; @@ -272,21 +280,20 @@ void SpecialOptSet::prepare(Pair *pc) { pc->next = NULL; } -Pair *SpecialOptSet::call(Pair *args, Environment * &envt, - Continuation * &cont, FrameObj ** &top_ptr) { - RetAddr *ret_info = static_cast<RetAddr*>(*top_ptr); - Pair *ret_addr = ret_info->addr; +Pair *SpecialOptSet::call(Pair *args, Environment * &lenvt, + Continuation * &cont, EvalObj ** &top_ptr) { + Pair *ret_addr = cont->pc; Pair *pc = static_cast<Pair*>(ret_addr->car); EvalObj *first = TO_PAIR(pc->cdr)->car; - if (!ret_info->state) + if (!cont->state) { gc.attach(static_cast<EvalObj*>(*(++top_ptr))); top_ptr++; - ret_info->state = TO_PAIR(TO_PAIR(pc->cdr)->cdr); - ret_info->state->next = NULL; + cont->state = TO_PAIR(TO_PAIR(pc->cdr)->cdr); + cont->state->next = NULL; gc.expose(args); - return ret_info->state; + return cont->state; } if (!first->is_sym_obj()) @@ -294,32 +301,36 @@ Pair *SpecialOptSet::call(Pair *args, Environment * &envt, SymObj *id = static_cast<SymObj*>(first); - bool flag = envt->add_binding(id, TO_PAIR(args->cdr)->car, false); + bool flag = lenvt->add_binding(id, TO_PAIR(args->cdr)->car, false); if (!flag) throw TokenError(id->ext_repr(), RUN_ERR_UNBOUND_VAR); - delete *top_ptr; + gc.expose(*top_ptr); *top_ptr++ = gc.attach(unspec_obj); + EXIT_CURRENT_CONT(lenvt, cont); gc.expose(args); return ret_addr->next; } -SpecialOptQuote::SpecialOptQuote() : SpecialOptObj("quote") {} +SpecialOptQuote::SpecialOptQuote(Environment *envt) : + SpecialOptObj(envt, "quote") {} void SpecialOptQuote::prepare(Pair *pc) { // Do not evaluate anything pc->next = NULL; } -Pair *SpecialOptQuote::call(Pair *args, Environment * &envt, - Continuation * &cont, FrameObj ** &top_ptr) { - Pair *ret_addr = static_cast<RetAddr*>(*top_ptr)->addr; +Pair *SpecialOptQuote::call(Pair *args, Environment * &lenvt, + Continuation * &cont, EvalObj ** &top_ptr) { + Pair *ret_addr = cont->pc; Pair *pc = static_cast<Pair*>(ret_addr->car); - delete *top_ptr; + gc.expose(*top_ptr); *top_ptr++ = gc.attach(TO_PAIR(pc->cdr)->car); + EXIT_CURRENT_CONT(lenvt, cont); gc.expose(args); return ret_addr->next; } -SpecialOptEval::SpecialOptEval() : SpecialOptObj("eval") {} +SpecialOptEval::SpecialOptEval(Environment *envt) : + SpecialOptObj(envt, "eval") {} void SpecialOptEval::prepare(Pair *pc) { if (pc->cdr == empty_list || @@ -327,15 +338,15 @@ void SpecialOptEval::prepare(Pair *pc) { throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS); } -Pair *SpecialOptEval::call(Pair *args, Environment * &envt, - Continuation * &cont, FrameObj ** &top_ptr) { - RetAddr *ret_info = static_cast<RetAddr*>(*top_ptr); - Pair *ret_addr = ret_info->addr; - if (ret_info->state) +Pair *SpecialOptEval::call(Pair *args, Environment * &lenvt, + Continuation * &cont, EvalObj ** &top_ptr) { + Pair *ret_addr = cont->pc; + if (cont->state) { - gc.expose(ret_info->state); // Exec done - delete *top_ptr; + gc.expose(cont->state); // Exec done + gc.expose(*top_ptr); *top_ptr++ = gc.attach(TO_PAIR(args->cdr)->car); + EXIT_CURRENT_CONT(lenvt, cont); gc.expose(args); return ret_addr->next; // Move to the next instruction } @@ -343,49 +354,51 @@ Pair *SpecialOptEval::call(Pair *args, Environment * &envt, { gc.attach(static_cast<EvalObj*>(*(++top_ptr))); top_ptr++; - ret_info->state = TO_PAIR(args->cdr); - gc.attach(ret_info->state); // Or it will be released - ret_info->state->next = NULL; + cont->state = TO_PAIR(args->cdr); + gc.attach(cont->state); // Or it will be released + cont->state->next = NULL; gc.expose(args); - return ret_info->state; + return cont->state; } throw NormalError(INT_ERR); } -SpecialOptAnd::SpecialOptAnd() : SpecialOptObj("and") {} +SpecialOptAnd::SpecialOptAnd(Environment *envt) : + SpecialOptObj(envt, "and") {} void SpecialOptAnd::prepare(Pair *pc) { pc->next = NULL; } -Pair *SpecialOptAnd::call(Pair *args, Environment * &envt, - Continuation * &cont, FrameObj ** &top_ptr) { - RetAddr *ret_info = static_cast<RetAddr*>(*top_ptr); - Pair *ret_addr = ret_info->addr; +Pair *SpecialOptAnd::call(Pair *args, Environment * &lenvt, + Continuation * &cont, EvalObj ** &top_ptr) { + Pair *ret_addr = cont->pc; Pair *pc = static_cast<Pair*>(ret_addr->car); if (pc->cdr == empty_list) { - delete *top_ptr; + gc.expose(*top_ptr); *top_ptr++ = gc.attach(new BoolObj(true)); + EXIT_CURRENT_CONT(lenvt, cont); gc.expose(args); return ret_addr->next; } - if (!ret_info->state) + if (!cont->state) { gc.attach(static_cast<EvalObj*>(*(++top_ptr))); top_ptr++; - ret_info->state = TO_PAIR(pc->cdr); - ret_info->state->next = NULL; + cont->state = TO_PAIR(pc->cdr); + cont->state->next = NULL; gc.expose(args); - return ret_info->state; + return cont->state; } EvalObj *ret = TO_PAIR(args->cdr)->car; if (ret->is_true()) { - if (ret_info->state->cdr == empty_list) // the last member + if (cont->state->cdr == empty_list) // the last member { - delete *top_ptr; + gc.expose(*top_ptr); *top_ptr++ = gc.attach(ret); + EXIT_CURRENT_CONT(lenvt, cont); gc.expose(args); return ret_addr->next; } @@ -393,56 +406,59 @@ Pair *SpecialOptAnd::call(Pair *args, Environment * &envt, { gc.attach(static_cast<EvalObj*>(*(++top_ptr))); top_ptr++; - ret_info->state = TO_PAIR(ret_info->state->cdr); - ret_info->state->next = NULL; + cont->state = TO_PAIR(cont->state->cdr); + cont->state->next = NULL; gc.expose(args); - return ret_info->state; + return cont->state; } } else { - delete *top_ptr; + gc.expose(*top_ptr); *top_ptr++ = gc.attach(ret); + EXIT_CURRENT_CONT(lenvt, cont); gc.expose(args); return ret_addr->next; } throw NormalError(INT_ERR); } -SpecialOptOr::SpecialOptOr() : SpecialOptObj("or") {} +SpecialOptOr::SpecialOptOr(Environment *envt) : + SpecialOptObj(envt, "or") {} void SpecialOptOr::prepare(Pair *pc) { pc->next = NULL; } -Pair *SpecialOptOr::call(Pair *args, Environment * &envt, - Continuation * &cont, FrameObj ** &top_ptr) { - RetAddr *ret_info = static_cast<RetAddr*>(*top_ptr); - Pair *ret_addr = static_cast<RetAddr*>(*top_ptr)->addr; +Pair *SpecialOptOr::call(Pair *args, Environment * &lenvt, + Continuation * &cont, EvalObj ** &top_ptr) { + Pair *ret_addr = cont->pc; Pair *pc = static_cast<Pair*>(ret_addr->car); if (pc->cdr == empty_list) { - delete *top_ptr; + gc.expose(*top_ptr); *top_ptr++ = gc.attach(new BoolObj(false)); + EXIT_CURRENT_CONT(lenvt, cont); gc.expose(args); return ret_addr->next; } - if (!ret_info->state) + if (!cont->state) { gc.attach(static_cast<EvalObj*>(*(++top_ptr))); top_ptr++; - ret_info->state = TO_PAIR(pc->cdr); - ret_info->state->next = NULL; + cont->state = TO_PAIR(pc->cdr); + cont->state->next = NULL; gc.expose(args); - return ret_info->state; + return cont->state; } EvalObj *ret = TO_PAIR(args->cdr)->car; if (!ret->is_true()) { - if (ret_info->state->cdr == empty_list) // the last member + if (cont->state->cdr == empty_list) // the last member { - delete *top_ptr; + gc.expose(*top_ptr); *top_ptr++ = gc.attach(ret); + EXIT_CURRENT_CONT(lenvt, cont); gc.expose(args); return ret_addr->next; } @@ -450,28 +466,30 @@ Pair *SpecialOptOr::call(Pair *args, Environment * &envt, { gc.attach(static_cast<EvalObj*>(*(++top_ptr))); top_ptr++; - ret_info->state = TO_PAIR(ret_info->state->cdr); - ret_info->state->next = NULL; + cont->state = TO_PAIR(cont->state->cdr); + cont->state->next = NULL; gc.expose(args); - return ret_info->state; + return cont->state; } } else { - delete *top_ptr; + gc.expose(*top_ptr); *top_ptr++ = gc.attach(ret); + EXIT_CURRENT_CONT(lenvt, cont); gc.expose(args); return ret_addr->next; } throw NormalError(INT_ERR); } -SpecialOptApply::SpecialOptApply() : SpecialOptObj("apply") {} +SpecialOptApply::SpecialOptApply(Environment *envt) : + SpecialOptObj(envt, "apply") {} void SpecialOptApply::prepare(Pair *pc) {} -Pair *SpecialOptApply::call(Pair *_args, Environment * &envt, - Continuation * &cont, FrameObj ** &top_ptr) { +Pair *SpecialOptApply::call(Pair *_args, Environment * &lenvt, + Continuation * &cont, EvalObj ** &top_ptr) { Pair *args = _args; top_ptr++; // Recover the return address if (args->cdr == empty_list) @@ -511,7 +529,8 @@ Pair *SpecialOptApply::call(Pair *_args, Environment * &envt, return NULL; } -SpecialOptForce::SpecialOptForce() : SpecialOptObj("force") {} +SpecialOptForce::SpecialOptForce(Environment *envt) : + SpecialOptObj(envt, "force") {} void SpecialOptForce::prepare(Pair *pc) { if (pc->cdr == empty_list || @@ -519,18 +538,18 @@ void SpecialOptForce::prepare(Pair *pc) { throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS); } -Pair *SpecialOptForce::call(Pair *_args, Environment * &envt, - Continuation * &cont, FrameObj ** &top_ptr) { +Pair *SpecialOptForce::call(Pair *_args, Environment * &lenvt, + Continuation * &cont, EvalObj ** &top_ptr) { Pair *args = _args; args = TO_PAIR(args->cdr); - RetAddr *ret_info = static_cast<RetAddr*>(*top_ptr); - Pair *ret_addr = ret_info->addr; - if (ret_info->state) + Pair *ret_addr = cont->pc; + if (cont->state) { EvalObj *mem = args->car; prom->feed_mem(mem); - delete *top_ptr; + gc.expose(*top_ptr); *top_ptr++ = gc.attach(mem); + EXIT_CURRENT_CONT(lenvt, cont); gc.expose(_args); return ret_addr->next; // Move to the next instruction } @@ -542,8 +561,9 @@ Pair *SpecialOptForce::call(Pair *_args, Environment * &envt, EvalObj *mem = prom->get_mem(); if (mem) // fetch from memorized result { - delete *top_ptr; + gc.expose(*top_ptr); *top_ptr++ = gc.attach(mem); + EXIT_CURRENT_CONT(lenvt, cont); gc.expose(_args); return ret_addr->next; } @@ -551,15 +571,16 @@ Pair *SpecialOptForce::call(Pair *_args, Environment * &envt, { gc.attach(static_cast<EvalObj*>(*(++top_ptr))); top_ptr++; - ret_info->state = prom->get_entry(); - ret_info->state->next = NULL; + cont->state = prom->get_entry(); + cont->state->next = NULL; gc.expose(_args); - return ret_info->state; + return cont->state; } } } -SpecialOptDelay::SpecialOptDelay() : SpecialOptObj("delay") {} +SpecialOptDelay::SpecialOptDelay(Environment *envt) : + SpecialOptObj(envt, "delay") {} void SpecialOptDelay::prepare(Pair *pc) { if (pc->cdr == empty_list || @@ -568,12 +589,13 @@ void SpecialOptDelay::prepare(Pair *pc) { pc->next = NULL; } -Pair *SpecialOptDelay::call(Pair *args, Environment * &envt, - Continuation * &cont, FrameObj ** &top_ptr) { - Pair *ret_addr = static_cast<RetAddr*>(*top_ptr)->addr; +Pair *SpecialOptDelay::call(Pair *args, Environment * &lenvt, + Continuation * &cont, EvalObj ** &top_ptr) { + Pair *ret_addr = cont->pc; Pair *pc = static_cast<Pair*>(ret_addr->car); - delete *top_ptr; + gc.expose(*top_ptr); *top_ptr++ = gc.attach(new PromObj(TO_PAIR(pc->cdr)->car)); + EXIT_CURRENT_CONT(lenvt, cont); gc.expose(args); return ret_addr->next; // Move to the next instruction } @@ -17,14 +17,14 @@ class SpecialOptIf: public SpecialOptObj {/*{{{*/ unsigned char state; /**< 0 for prepared, 1 for pre_called */ public: /** Construct a `if` operator */ - SpecialOptIf(); + SpecialOptIf(Environment *envt); /** Prevent <condition> and <consequence> from being evaluated */ void prepare(Pair *pc); /** When it's invoked at the first time, it will determined which of * <condition> and <consequence> should be evaluated. Then when it's * invoked again, it will tell the system the corresponding result.*/ Pair *call(Pair *args, Environment * &envt, - Continuation * &cont, FrameObj ** &top_ptr); + Continuation * &cont, EvalObj ** &top_ptr); };/*}}}*/ /** @class SpecialOptLambda @@ -33,12 +33,12 @@ class SpecialOptIf: public SpecialOptObj {/*{{{*/ class SpecialOptLambda: public SpecialOptObj {/*{{{*/ public: /** Construct a `lambda` operator */ - SpecialOptLambda(); + SpecialOptLambda(Environment *envt); /** Prevent all parts of the expression being evaluated */ void prepare(Pair *pc); /** Make up a ProcObj and push into the stack */ Pair *call(Pair *args, Environment * &envt, - Continuation * &cont, FrameObj ** &top_ptr); + Continuation * &cont, EvalObj ** &top_ptr); };/*}}}*/ @@ -48,12 +48,12 @@ class SpecialOptLambda: public SpecialOptObj {/*{{{*/ class SpecialOptDefine: public SpecialOptObj {/*{{{*/ public: /** Construct a `define` operator */ - SpecialOptDefine(); + SpecialOptDefine(Environment *envt); /** Prevent some parts from being evaluated */ void prepare(Pair *pc); /** See `SpecialOptLambda` */ Pair *call(Pair *args, Environment * &envt, - Continuation * &cont, FrameObj ** &top_ptr); + Continuation * &cont, EvalObj ** &top_ptr); };/*}}}*/ /** @class SpecialOptSet @@ -62,12 +62,12 @@ class SpecialOptDefine: public SpecialOptObj {/*{{{*/ class SpecialOptSet: public SpecialOptObj {/*{{{*/ public: /** Construct a `set!` operator */ - SpecialOptSet(); + SpecialOptSet(Environment *envt); /** See `SpecialOptDefine */ void prepare(Pair *pc); /** See `SpecialOptDefine */ Pair *call(Pair *args, Environment * &envt, - Continuation * &cont, FrameObj ** &top_ptr); + Continuation * &cont, EvalObj ** &top_ptr); };/*}}}*/ /** @class SpecialOptLambda @@ -76,12 +76,12 @@ class SpecialOptSet: public SpecialOptObj {/*{{{*/ class SpecialOptQuote: public SpecialOptObj {/*{{{*/ public: /** Construct a `quote` operator */ - SpecialOptQuote(); + SpecialOptQuote(Environment *envt); /** Prevent the literal part from being evaluated */ void prepare(Pair *pc); /** Return the literal */ Pair *call(Pair *args, Environment * &envt, - Continuation * &cont, FrameObj ** &top_ptr); + Continuation * &cont, EvalObj ** &top_ptr); };/*}}}*/ @@ -93,12 +93,12 @@ class SpecialOptEval: public SpecialOptObj {/*{{{*/ unsigned char state; /**< 0 for prepared, 1 for pre_called */ public: /** Construct an `eval` operator */ - SpecialOptEval(); + SpecialOptEval(Environment *envt); /** Set state to 0 */ void prepare(Pair *pc); /** Behaves like the one in `SpecialOptIf` */ Pair *call(Pair *args, Environment * &envt, - Continuation * &cont, FrameObj ** &top_ptr); + Continuation * &cont, EvalObj ** &top_ptr); };/*}}}*/ @@ -108,12 +108,12 @@ class SpecialOptEval: public SpecialOptObj {/*{{{*/ class SpecialOptAnd: public SpecialOptObj {/*{{{*/ public: /** Construct an `and` operator */ - SpecialOptAnd(); + SpecialOptAnd(Environment *envt); /** Prevent all parts from being evaluated */ void prepare(Pair *pc); /** Acts like `SpecialOptIf` */ Pair *call(Pair *args, Environment * &envt, - Continuation * &cont, FrameObj ** &top_ptr); + Continuation * &cont, EvalObj ** &top_ptr); };/*}}}*/ @@ -123,12 +123,12 @@ class SpecialOptAnd: public SpecialOptObj {/*{{{*/ class SpecialOptOr: public SpecialOptObj {/*{{{*/ public: /** Construct an `or` operator */ - SpecialOptOr(); + SpecialOptOr(Environment *envt); /** See `SpecialOptAnd` */ void prepare(Pair *pc); /** See `SpecialOptAnd` */ Pair *call(Pair *args, Environment * &envt, - Continuation * &cont, FrameObj ** &top_ptr); + Continuation * &cont, EvalObj ** &top_ptr); };/*}}}*/ @@ -138,12 +138,12 @@ class SpecialOptOr: public SpecialOptObj {/*{{{*/ class SpecialOptApply: public SpecialOptObj {/*{{{*/ public: /** Construct an `apply` operator */ - SpecialOptApply(); + SpecialOptApply(Environment *envt); /** Do nothing */ void prepare(Pair *pc); /** Provoke the <proc> with args */ Pair *call(Pair *args, Environment * &envt, - Continuation * &cont, FrameObj ** &top_ptr); + Continuation * &cont, EvalObj ** &top_ptr); };/*}}}*/ @@ -153,12 +153,12 @@ class SpecialOptApply: public SpecialOptObj {/*{{{*/ class SpecialOptDelay: public SpecialOptObj {/*{{{*/ public: /** Construct a `delay` operator */ - SpecialOptDelay(); + SpecialOptDelay(Environment *envt); /** Do nothing */ void prepare(Pair *pc); /** Make up a PromObj and push into the stack */ Pair *call(Pair *args, Environment * &envt, - Continuation * &cont, FrameObj ** &top_ptr); + Continuation * &cont, EvalObj ** &top_ptr); };/*}}}*/ @@ -171,7 +171,7 @@ class SpecialOptForce: public SpecialOptObj {/*{{{*/ PromObj* prom; public: /** Construct a `force` operator */ - SpecialOptForce(); + SpecialOptForce(Environment *envt); /** Set the state to 0 */ void prepare(Pair *pc); /** Force the evaluation of a promise. If the promise has not been @@ -179,7 +179,7 @@ class SpecialOptForce: public SpecialOptObj {/*{{{*/ * while if it has already been evaluated, just push the result into * the stack */ Pair *call(Pair *args, Environment * &envt, - Continuation * &cont, FrameObj ** &top_ptr); + Continuation * &cont, EvalObj ** &top_ptr); };/*}}}*/ @@ -6,7 +6,7 @@ #include <cstdio> extern Pair *empty_list; -FrameObj *eval_stack[EVAL_STACK_SIZE]; +EvalObj *eval_stack[EVAL_STACK_SIZE]; void Evaluator::add_builtin_routines() { @@ -14,19 +14,19 @@ void Evaluator::add_builtin_routines() { envt->add_binding(new SymObj(name), rout) #define ADD_BUILTIN_PROC(name, rout) \ - ADD_ENTRY(name, new BuiltinProcObj(rout, name)) - - ADD_ENTRY("if", new SpecialOptIf()); - ADD_ENTRY("lambda", new SpecialOptLambda()); - ADD_ENTRY("define", new SpecialOptDefine()); - ADD_ENTRY("set!", new SpecialOptSet()); - ADD_ENTRY("quote", new SpecialOptQuote()); - ADD_ENTRY("eval", new SpecialOptEval()); - ADD_ENTRY("and", new SpecialOptAnd()); - ADD_ENTRY("or", new SpecialOptOr()); - ADD_ENTRY("apply", new SpecialOptApply()); - ADD_ENTRY("delay", new SpecialOptDelay()); - ADD_ENTRY("force", new SpecialOptForce()); + ADD_ENTRY(name, new BuiltinProcObj(envt, rout, name)) + + ADD_ENTRY("if", new SpecialOptIf(envt)); + ADD_ENTRY("lambda", new SpecialOptLambda(envt)); + ADD_ENTRY("define", new SpecialOptDefine(envt)); + ADD_ENTRY("set!", new SpecialOptSet(envt)); + ADD_ENTRY("quote", new SpecialOptQuote(envt)); + ADD_ENTRY("eval", new SpecialOptEval(envt)); + ADD_ENTRY("and", new SpecialOptAnd(envt)); + ADD_ENTRY("or", new SpecialOptOr(envt)); + ADD_ENTRY("apply", new SpecialOptApply(envt)); + ADD_ENTRY("delay", new SpecialOptDelay(envt)); + ADD_ENTRY("force", new SpecialOptForce(envt)); ADD_BUILTIN_PROC("+", num_add); ADD_BUILTIN_PROC("-", num_sub); @@ -113,7 +113,7 @@ inline bool make_exec(Pair *ptr) { return ptr->cdr == empty_list; } -inline void push(Pair * &pc, FrameObj ** &top_ptr, Environment *envt) { +inline void push(Pair * &pc, EvalObj ** &top_ptr, Environment * &envt, Continuation * &cont) { // if (pc->car == NULL) // puts("oops"); if (pc->car->is_simple_obj()) // Not an opt invocation @@ -128,7 +128,13 @@ inline void push(Pair * &pc, FrameObj ** &top_ptr, Environment *envt) { if (pc->car == empty_list) throw NormalError(SYN_ERR_EMPTY_COMB); - *top_ptr++ = new RetAddr(pc, NULL); // Push the return address + gc.expose(cont); + cont = new Continuation(envt, pc, cont); + gc.attach(cont); + + *top_ptr++ = gc.attach(cont); + + if (!make_exec(TO_PAIR(pc->car))) throw TokenError(pc->car->ext_repr(), RUN_ERR_WRONG_NUM_OF_ARGS); // static_cast because of is_simple_obj() is false @@ -137,56 +143,47 @@ inline void push(Pair * &pc, FrameObj ** &top_ptr, Environment *envt) { } } -void print_stack(FrameObj **top) { - for (FrameObj **i = eval_stack; i < top; i++) - { - if ((*i)->is_ret_addr()) - puts("<return addr>"); - else - printf("%s\n", static_cast<EvalObj*>(*i)->ext_repr().c_str()); - } - puts(""); -} - EvalObj *Evaluator::run_expr(Pair *prog) { - FrameObj **top_ptr = eval_stack; + EvalObj **top_ptr = eval_stack; Pair *pc = prog; Continuation *cont = NULL; #ifdef GC_DEBUG fprintf(stderr, "Start the evaluation...\n"); #endif // envt is this->envt - push(pc, top_ptr, envt); + push(pc, top_ptr, envt, cont); gc.attach(prog); - while((*eval_stack)->is_ret_addr()) + while (cont) { if (top_ptr == eval_stack + EVAL_STACK_SIZE) throw TokenError("Evaluation", RUN_ERR_STACK_OVERFLOW); if (pc) - push(pc, top_ptr, envt); + push(pc, top_ptr, envt, cont); else { Pair *args = empty_list; - while (!(*(--top_ptr))->is_ret_addr()) + while (*(--top_ptr) != cont) { EvalObj* obj = static_cast<EvalObj*>(*top_ptr); gc.expose(obj); args = new Pair(obj, args); } + //gc.expose(*top_ptr); //< static_cast because the while condition -// RetAddr *ret_addr = static_cast<RetAddr*>(*top_ptr); gc.attach(args); - EvalObj *opt = args->car; - if (opt->is_opt_obj()) - pc = static_cast<OptObj*>(opt)-> - call(args, envt, cont, top_ptr); + if ((args->car)->is_opt_obj()) + { + OptObj *opt = static_cast<OptObj*>(args->car); + pc = opt->call(args, envt, cont, top_ptr); + } else - throw TokenError(opt->ext_repr(), SYN_ERR_CAN_NOT_APPLY); + throw TokenError((args->car)->ext_repr(), SYN_ERR_CAN_NOT_APPLY); gc.collect(); } } gc.expose(prog); + gc.expose(cont); // static_cast because the previous while condition return static_cast<EvalObj*>(*(eval_stack)); } @@ -92,10 +92,9 @@ void GarbageCollector::force() { #endif #ifdef GC_DEBUG -/* for (EvalObj2Int::iterator it = mapping.begin(); + for (EvalObj2Int::iterator it = mapping.begin(); it != mapping.end(); it++) fprintf(stderr, "%llx => %s\n", (ull)it->first, it->first->ext_repr().c_str()); - */ #endif } @@ -114,8 +113,7 @@ EvalObj *GarbageCollector::attach(EvalObj *ptr) { } void GarbageCollector::cycle_resolve() { - if (mapping.size() < resolve_threshold) - return; + if (mapping.size() < resolve_threshold) return; EvalObjSet visited; Container **clptr = cyc_list; for (EvalObj2Int::iterator it = mapping.begin(); @@ -155,8 +153,7 @@ void GarbageCollector::cycle_resolve() { void GarbageCollector::collect() { force(); - if (mapping.size() < resolve_threshold) - return; + if (mapping.size() < resolve_threshold) return; cycle_resolve(); force(); } @@ -5,7 +5,7 @@ #include <map> const int GC_QUEUE_SIZE = 262144; -const size_t GC_CYC_THRESHOLD = GC_QUEUE_SIZE >> 2; +const size_t GC_CYC_THRESHOLD = GC_QUEUE_SIZE >> 1; typedef std::map<EvalObj*, size_t> EvalObj2Int; typedef std::set<EvalObj*> EvalObjSet; @@ -17,10 +17,6 @@ EmptyList::EmptyList() : Pair(NULL, NULL) {} ReprCons *EmptyList::get_repr_cons() { return new ReprStr("()"); } -bool FrameObj::is_ret_addr() { - return ftype & CLS_RET_ADDR; -} - bool FrameObj::is_parse_bracket() { return ftype & CLS_PAR_BRA; } @@ -134,8 +130,5 @@ string EvalObj::ext_repr() { return res; } -RetAddr::RetAddr(Pair *_addr, Pair *_state) : - FrameObj(CLS_RET_ADDR), addr(_addr), state(_state) {} - Container::Container(int otype, bool override) : EvalObj(otype | (override ? 0 : CLS_CONTAINER)) {} @@ -21,6 +21,16 @@ const int CLS_CONTAINER = 1 << 20; #define TO_PAIR(ptr) \ (static_cast<Pair*>(ptr)) +#define EXIT_CURRENT_CONT(lenvt, cont) \ + do { \ + gc.expose(lenvt); \ + lenvt = cont->envt; \ + gc.attach(lenvt); \ + gc.expose(cont); \ + cont = cont->prev_cont; \ + gc.attach(cont); \ + } while (0) + /** @class FrameObj * Objects that can be held in the evaluation stack */ @@ -40,11 +50,6 @@ class FrameObj { FrameObj(FrameType ftype); virtual ~FrameObj() {} /** - * Tell whether the object is a return address, according to ftype - * @return true for yes - */ - bool is_ret_addr(); - /** * Tell whether the object is a bracket, according to ftype * @return true for yes */ @@ -114,16 +119,4 @@ class Container: public EvalObj { virtual void gc_trigger(EvalObj ** &tail, EvalObjSet &visited) = 0; }; -/** @class RetAddr - * Tracking the caller's Pair pointer - */ -class RetAddr : public FrameObj {/*{{{*/ - public: - Pair* addr; /**< The return address */ - Pair* state; - /** Constructs a return address object which refers to the node addr in - * the AST */ - RetAddr(Pair *addr, Pair *state = NULL); -};/*}}}*/ - #endif @@ -68,12 +68,11 @@ (display (queen 8)) -;(define shl '()) -;(define shr '()) -;(define empty-bits '()) -;(define res '()) -;(define queen '()) -;(set-gc-resolve-threshold! 0) ; force cycle resolve -;(display "\n") -;(display (gc-status)) -; +(define shl '()) +(define shr '()) +(define empty-bits '()) +(define res '()) +(define queen '()) +(set-gc-resolve-threshold! 0) ; force cycle resolve +(display "\n") +(display (gc-status)) @@ -57,13 +57,14 @@ SymObj::SymObj(const string &str) : return new ReprStr(val); } -OptObj::OptObj(int otype) : Container(otype | CLS_SIM_OBJ | CLS_OPT_OBJ, true) {} +OptObj::OptObj(Environment *_envt, int otype) : + Container(otype | CLS_SIM_OBJ | CLS_OPT_OBJ, true), envt(_envt) {} void OptObj::gc_decrement() {} void OptObj::gc_trigger(EvalObj ** &tail, EvalObjSet &visited) {} ProcObj::ProcObj(Pair *_body, Environment *_envt, EvalObj *_params) : - OptObj(CLS_CONTAINER), body(_body), params(_params), envt(_envt) { + OptObj(_envt, CLS_CONTAINER), body(_body), params(_params) { gc.attach(body); gc.attach(params); gc.attach(envt); @@ -75,27 +76,19 @@ ProcObj::~ProcObj() { gc.expose(envt); } -Pair *ProcObj::call(Pair *_args, Environment * &genvt, - Continuation * &cont, FrameObj ** &top_ptr) { +Pair *ProcObj::call(Pair *_args, Environment * &lenvt, + Continuation * &cont, EvalObj ** &top_ptr) { // Create a new continuation // static_cast see `call` invocation in eval.cpp - RetAddr *ret_info = static_cast<RetAddr*>(*top_ptr); - Pair *ret_addr = ret_info->addr; - if (ret_info->state) + Pair *ret_addr = cont->pc; + if (cont->state) { - Pair *nexp = TO_PAIR(ret_info->state->cdr); + Pair *nexp = TO_PAIR(cont->state->cdr); if (nexp == empty_list) { - delete *top_ptr; + gc.expose(*top_ptr); *top_ptr++ = gc.attach(TO_PAIR(_args->cdr)->car); - - gc.expose(genvt); - genvt = cont->envt; - gc.attach(genvt); - - gc.expose(cont); - cont = cont->prev_cont; - gc.attach(cont); + EXIT_CURRENT_CONT(lenvt, cont); gc.expose(_args); return ret_addr->next; } @@ -103,17 +96,17 @@ Pair *ProcObj::call(Pair *_args, Environment * &genvt, { gc.attach(static_cast<EvalObj*>(*(++top_ptr))); top_ptr++; - ret_info->state = nexp; + cont->state = nexp; gc.expose(_args); - return ret_info->state; + return cont->state; } } else { - 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 + gc.expose(lenvt); + lenvt = new Environment(envt); + gc.attach(lenvt); + EvalObj *ppar, *nptr; Pair *args = _args; for (ppar = params; @@ -123,29 +116,19 @@ Pair *ProcObj::call(Pair *_args, Environment * &genvt, if ((nptr = args->cdr) != empty_list) args = TO_PAIR(nptr); else break; - _envt->add_binding(static_cast<SymObj*>(TO_PAIR(ppar)->car), args->car); + lenvt->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) + lenvt->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); - gc.expose(genvt); - genvt = _envt; - gc.attach(genvt); - - gc.expose(cont); - cont = _cont; - gc.attach(cont); - gc.attach(static_cast<EvalObj*>(*(++top_ptr))); top_ptr++; - ret_info->state = body; -// delete *top_ptr; // release ret addr -// *top_ptr++ = new RetAddr(NULL); // Mark the entrance of a cont + cont->state = body; gc.expose(_args); - return ret_info->state; // Move pc to the proc entry point + return cont->state; // Move pc to the proc entry point } } @@ -165,7 +148,7 @@ ReprCons *ProcObj::get_repr_cons() { return new ReprStr("#<Procedure>"); } -SpecialOptObj::SpecialOptObj(string _name) : OptObj(), name(_name) {} +SpecialOptObj::SpecialOptObj(Environment *envt, string _name) : OptObj(envt), name(_name) {} ReprCons *SpecialOptObj::get_repr_cons() { return new ReprStr("#<Built-in Opt: " + name + ">"); } @@ -310,15 +293,16 @@ bool StrObj::eq(StrObj *r) { return str == r->str; } -BuiltinProcObj::BuiltinProcObj(BuiltinProc f, string _name) : - OptObj(), handler(f), name(_name) {} +BuiltinProcObj::BuiltinProcObj(Environment *envt, BuiltinProc f, string _name) : + OptObj(envt), handler(f), name(_name) {} - Pair *BuiltinProcObj::call(Pair *args, Environment * &envt, - Continuation * &cont, FrameObj ** &top_ptr) { + Pair *BuiltinProcObj::call(Pair *args, Environment * &lenvt, + Continuation * &cont, EvalObj ** &top_ptr) { - Pair *ret_addr = static_cast<RetAddr*>(*top_ptr)->addr; - delete *top_ptr; + Pair *ret_addr = cont->pc; + gc.expose(*top_ptr); *top_ptr++ = gc.attach(handler(TO_PAIR(args->cdr), name)); + EXIT_CURRENT_CONT(lenvt, cont); gc.expose(args); return ret_addr->next; // Move to the next instruction } @@ -409,9 +393,12 @@ EvalObj *Environment::get_obj(EvalObj *obj) { throw TokenError(name, RUN_ERR_UNBOUND_VAR); } -Continuation::Continuation(Environment *_envt, Pair *_pc, - Continuation *_prev_cont, Pair *_proc_body) : - Container(), prev_cont(_prev_cont), envt(_envt), pc(_pc), proc_body(_proc_body) { +Environment *Environment::get_prev() { + return prev_envt; +} + +Continuation::Continuation(Environment *_envt, Pair *_pc, Continuation *_prev_cont ) : + Container(), prev_cont(_prev_cont), envt(_envt), pc(_pc), state(NULL) { gc.attach(prev_cont); gc.attach(envt); } @@ -139,7 +139,11 @@ class Continuation; */ class OptObj: public Container {/*{{{*/ public: - OptObj(int otype = 0); + /** Pointer to the environment */ + Environment *envt; + + OptObj(Environment *envt, int otype = 0); + /** * The function is called when an operation is needed. * @param args The argument list (the first one is the opt itself) @@ -149,7 +153,7 @@ class OptObj: public Container {/*{{{*/ * @return New value for pc register */ virtual Pair *call(Pair *args, Environment * &envt, - Continuation * &cont, FrameObj ** &top_ptr) = 0; + Continuation * &cont, EvalObj ** &top_ptr) = 0; virtual void gc_decrement(); virtual void gc_trigger(EvalObj ** &tail, EvalObjSet &visited); @@ -164,14 +168,12 @@ class ProcObj: public OptObj {/*{{{*/ Pair *body; /** The arguments: <list> | var1 ... | var1 var2 ... . varn */ EvalObj *params; - /** Pointer to the environment */ - Environment *envt; /** Conctructs a ProcObj */ ProcObj(Pair *body, Environment *envt, EvalObj *params); ~ProcObj(); Pair *call(Pair *args, Environment * &envt, - Continuation * &cont, FrameObj ** &top_ptr); + Continuation * &cont, EvalObj ** &top_ptr); ReprCons *get_repr_cons(); void gc_decrement(); @@ -185,7 +187,7 @@ class SpecialOptObj: public OptObj {/*{{{*/ protected: string name; public: - SpecialOptObj(string name); + SpecialOptObj(Environment *envt, string name); ReprCons *get_repr_cons(); };/*}}}*/ @@ -203,9 +205,9 @@ class BuiltinProcObj: public OptObj {/*{{{*/ * @param proc the actual handler * @param name the name of this built-in procedure */ - BuiltinProcObj(BuiltinProc proc, string name); + BuiltinProcObj(Environment *envt, BuiltinProc proc, string name); Pair *call(Pair *args, Environment * &envt, - Continuation * &cont, FrameObj ** &top_ptr); + Continuation * &cont, EvalObj ** &top_ptr); ReprCons *get_repr_cons(); };/*}}}*/ @@ -366,6 +368,7 @@ class Environment : public Container{/*{{{*/ * */ EvalObj *get_obj(EvalObj *obj); ReprCons *get_repr_cons(); + Environment *get_prev(); void gc_decrement(); void gc_trigger(EvalObj ** &tail, EvalObjSet &visited); @@ -382,14 +385,10 @@ class Continuation : public Container {/*{{{*/ Continuation *prev_cont; Environment *envt; /**< The saved envt */ Pair *pc; /**< The saved pc */ - /** Pointing to the current expression that is being evaluated. - * When its value goes to empty_list, the call is accomplished. - */ - Pair *proc_body; + Pair *state; /**< The state of this compound */ /** Create a continuation */ - Continuation(Environment *envt, Pair *pc, Continuation *prev_cont, - Pair *proc_body); + Continuation(Environment *envt, Pair *pc, Continuation *prev_cont); ~Continuation(); ReprCons *get_repr_cons(); |