aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Makefile2
-rw-r--r--builtin.cpp32
-rw-r--r--builtin.h22
-rw-r--r--eval.cpp6
-rw-r--r--types.cpp15
-rw-r--r--types.h7
6 files changed, 40 insertions, 44 deletions
diff --git a/Makefile b/Makefile
index 6b867c3..5232363 100644
--- a/Makefile
+++ b/Makefile
@@ -1,7 +1,7 @@
CXX = g++ -DGMP_SUPPORT
BUILD_DIR = build
-all: release
+all: debug
debug: CXX += -DGC_INFO -g -pg
gc_debug: CXX += -DGC_INFO -DGC_DEBUG -g -pg
release: CXX += -O2
diff --git a/builtin.cpp b/builtin.cpp
index 49519e8..f4440cb 100644
--- a/builtin.cpp
+++ b/builtin.cpp
@@ -41,7 +41,7 @@ void SpecialOptIf::prepare(Pair *pc) {
}
Pair *SpecialOptIf::call(Pair *args, Environment * &lenvt,
- Continuation * &cont, EvalObj ** &top_ptr) {
+ Continuation * &cont, EvalObj ** &top_ptr, Pair *pc) {
Pair *ret_addr = cont->pc;
if (cont->state)
{
@@ -55,7 +55,6 @@ Pair *SpecialOptIf::call(Pair *args, Environment * &lenvt,
}
else
{
- Pair *pc = TO_PAIR(ret_addr->car);
Pair *first = TO_PAIR(pc->cdr);
Pair *second = TO_PAIR(first->cdr);
Pair *third = TO_PAIR(second->cdr);
@@ -94,7 +93,7 @@ Pair *SpecialOptIf::call(Pair *args, Environment * &lenvt,
{
gc.attach(static_cast<EvalObj*>(*(++top_ptr)));
top_ptr++;
- cont->state = TO_PAIR(TO_PAIR(ret_addr->car)->cdr);
+ cont->state = TO_PAIR(pc->cdr);
cont->state->next = NULL;
gc.expose(args);
return cont->state;
@@ -149,10 +148,9 @@ void SpecialOptLambda::prepare(Pair *pc) {
}
Pair *SpecialOptLambda::call(Pair *args, Environment * &lenvt,
- Continuation * &cont, EvalObj ** &top_ptr) {
+ Continuation * &cont, EvalObj ** &top_ptr, Pair *pc) {
Pair *ret_addr = cont->pc;
- Pair *pc = static_cast<Pair*>(ret_addr->car);
if (pc->cdr == empty_list)
throw TokenError(name, SYN_ERR_EMPTY_PARA_LIST);
@@ -201,9 +199,8 @@ void SpecialOptDefine::prepare(Pair *pc) {
}
Pair *SpecialOptDefine::call(Pair *args, Environment * &lenvt,
- Continuation * &cont, EvalObj ** &top_ptr) {
+ Continuation * &cont, EvalObj ** &top_ptr, Pair *pc) {
Pair *ret_addr = cont->pc;
- Pair *pc = static_cast<Pair*>(ret_addr->car);
EvalObj *obj;
SymObj *id;
EvalObj *first = TO_PAIR(pc->cdr)->car;
@@ -277,9 +274,8 @@ void SpecialOptSet::prepare(Pair *pc) {
}
Pair *SpecialOptSet::call(Pair *args, Environment * &lenvt,
- Continuation * &cont, EvalObj ** &top_ptr) {
+ Continuation * &cont, EvalObj ** &top_ptr, Pair *pc) {
Pair *ret_addr = cont->pc;
- Pair *pc = static_cast<Pair*>(ret_addr->car);
EvalObj *first = TO_PAIR(pc->cdr)->car;
if (!cont->state)
@@ -314,9 +310,8 @@ void SpecialOptQuote::prepare(Pair *pc) {
}
Pair *SpecialOptQuote::call(Pair *args, Environment * &lenvt,
- Continuation * &cont, EvalObj ** &top_ptr) {
+ Continuation * &cont, EvalObj ** &top_ptr, Pair *pc) {
Pair *ret_addr = cont->pc;
- Pair *pc = static_cast<Pair*>(ret_addr->car);
gc.expose(*top_ptr);
*top_ptr++ = gc.attach(TO_PAIR(pc->cdr)->car);
EXIT_CURRENT_EXEC(lenvt, cont);
@@ -333,7 +328,7 @@ void SpecialOptEval::prepare(Pair *pc) {
}
Pair *SpecialOptEval::call(Pair *args, Environment * &lenvt,
- Continuation * &cont, EvalObj ** &top_ptr) {
+ Continuation * &cont, EvalObj ** &top_ptr, Pair *pc) {
Pair *ret_addr = cont->pc;
if (cont->state)
{
@@ -364,9 +359,8 @@ void SpecialOptAnd::prepare(Pair *pc) {
}
Pair *SpecialOptAnd::call(Pair *args, Environment * &lenvt,
- Continuation * &cont, EvalObj ** &top_ptr) {
+ Continuation * &cont, EvalObj ** &top_ptr, Pair *pc) {
Pair *ret_addr = cont->pc;
- Pair *pc = static_cast<Pair*>(ret_addr->car);
if (pc->cdr == empty_list)
{
gc.expose(*top_ptr);
@@ -423,9 +417,8 @@ void SpecialOptOr::prepare(Pair *pc) {
}
Pair *SpecialOptOr::call(Pair *args, Environment * &lenvt,
- Continuation * &cont, EvalObj ** &top_ptr) {
+ Continuation * &cont, EvalObj ** &top_ptr, Pair *pc) {
Pair *ret_addr = cont->pc;
- Pair *pc = static_cast<Pair*>(ret_addr->car);
if (pc->cdr == empty_list)
{
gc.expose(*top_ptr);
@@ -480,7 +473,7 @@ SpecialOptApply::SpecialOptApply() : SpecialOptObj("apply") {}
void SpecialOptApply::prepare(Pair *pc) {}
Pair *SpecialOptApply::call(Pair *_args, Environment * &lenvt,
- Continuation * &cont, EvalObj ** &top_ptr) {
+ Continuation * &cont, EvalObj ** &top_ptr, Pair *pc) {
Pair *args = _args;
top_ptr++; // Recover the return address
if (args->cdr == empty_list)
@@ -529,7 +522,7 @@ void SpecialOptForce::prepare(Pair *pc) {
}
Pair *SpecialOptForce::call(Pair *_args, Environment * &lenvt,
- Continuation * &cont, EvalObj ** &top_ptr) {
+ Continuation * &cont, EvalObj ** &top_ptr, Pair *pc) {
Pair *args = _args;
args = TO_PAIR(args->cdr);
Pair *ret_addr = cont->pc;
@@ -579,9 +572,8 @@ void SpecialOptDelay::prepare(Pair *pc) {
}
Pair *SpecialOptDelay::call(Pair *args, Environment * &lenvt,
- Continuation * &cont, EvalObj ** &top_ptr) {
+ Continuation * &cont, EvalObj ** &top_ptr, Pair *pc) {
Pair *ret_addr = cont->pc;
- Pair *pc = static_cast<Pair*>(ret_addr->car);
gc.expose(*top_ptr);
*top_ptr++ = gc.attach(new PromObj(TO_PAIR(pc->cdr)->car));
EXIT_CURRENT_EXEC(lenvt, cont);
diff --git a/builtin.h b/builtin.h
index 9b2a549..b9156ee 100644
--- a/builtin.h
+++ b/builtin.h
@@ -24,7 +24,7 @@ class SpecialOptIf: public SpecialOptObj {/*{{{*/
* <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, EvalObj ** &top_ptr);
+ Continuation * &cont, EvalObj ** &top_ptr, Pair *pc);
};/*}}}*/
/** @class SpecialOptLambda
@@ -38,7 +38,7 @@ class SpecialOptLambda: public SpecialOptObj {/*{{{*/
void prepare(Pair *pc);
/** Make up a ProcObj and push into the stack */
Pair *call(Pair *args, Environment * &envt,
- Continuation * &cont, EvalObj ** &top_ptr);
+ Continuation * &cont, EvalObj ** &top_ptr, Pair *pc);
};/*}}}*/
@@ -53,7 +53,7 @@ class SpecialOptDefine: public SpecialOptObj {/*{{{*/
void prepare(Pair *pc);
/** See `SpecialOptLambda` */
Pair *call(Pair *args, Environment * &envt,
- Continuation * &cont, EvalObj ** &top_ptr);
+ Continuation * &cont, EvalObj ** &top_ptr, Pair *pc);
};/*}}}*/
/** @class SpecialOptSet
@@ -67,7 +67,7 @@ class SpecialOptSet: public SpecialOptObj {/*{{{*/
void prepare(Pair *pc);
/** See `SpecialOptDefine */
Pair *call(Pair *args, Environment * &envt,
- Continuation * &cont, EvalObj ** &top_ptr);
+ Continuation * &cont, EvalObj ** &top_ptr, Pair *pc);
};/*}}}*/
/** @class SpecialOptLambda
@@ -81,7 +81,7 @@ class SpecialOptQuote: public SpecialOptObj {/*{{{*/
void prepare(Pair *pc);
/** Return the literal */
Pair *call(Pair *args, Environment * &envt,
- Continuation * &cont, EvalObj ** &top_ptr);
+ Continuation * &cont, EvalObj ** &top_ptr, Pair *pc);
};/*}}}*/
@@ -98,7 +98,7 @@ class SpecialOptEval: public SpecialOptObj {/*{{{*/
void prepare(Pair *pc);
/** Behaves like the one in `SpecialOptIf` */
Pair *call(Pair *args, Environment * &envt,
- Continuation * &cont, EvalObj ** &top_ptr);
+ Continuation * &cont, EvalObj ** &top_ptr, Pair *pc);
};/*}}}*/
@@ -113,7 +113,7 @@ class SpecialOptAnd: public SpecialOptObj {/*{{{*/
void prepare(Pair *pc);
/** Acts like `SpecialOptIf` */
Pair *call(Pair *args, Environment * &envt,
- Continuation * &cont, EvalObj ** &top_ptr);
+ Continuation * &cont, EvalObj ** &top_ptr, Pair *pc);
};/*}}}*/
@@ -128,7 +128,7 @@ class SpecialOptOr: public SpecialOptObj {/*{{{*/
void prepare(Pair *pc);
/** See `SpecialOptAnd` */
Pair *call(Pair *args, Environment * &envt,
- Continuation * &cont, EvalObj ** &top_ptr);
+ Continuation * &cont, EvalObj ** &top_ptr, Pair *pc);
};/*}}}*/
@@ -143,7 +143,7 @@ class SpecialOptApply: public SpecialOptObj {/*{{{*/
void prepare(Pair *pc);
/** Provoke the <proc> with args */
Pair *call(Pair *args, Environment * &envt,
- Continuation * &cont, EvalObj ** &top_ptr);
+ Continuation * &cont, EvalObj ** &top_ptr, Pair *pc);
};/*}}}*/
@@ -158,7 +158,7 @@ class SpecialOptDelay: public SpecialOptObj {/*{{{*/
void prepare(Pair *pc);
/** Make up a PromObj and push into the stack */
Pair *call(Pair *args, Environment * &envt,
- Continuation * &cont, EvalObj ** &top_ptr);
+ Continuation * &cont, EvalObj ** &top_ptr, Pair *pc);
};/*}}}*/
@@ -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, EvalObj ** &top_ptr);
+ Continuation * &cont, EvalObj ** &top_ptr, Pair *pc);
};/*}}}*/
diff --git a/eval.cpp b/eval.cpp
index 704b07b..45427e4 100644
--- a/eval.cpp
+++ b/eval.cpp
@@ -138,10 +138,11 @@ inline void push(Pair * &pc, EvalObj ** &top_ptr,
}
else cont->tail = false;
+
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
- pc = static_cast<Pair*>(pc->car); // Go deeper to enter the call
+ cont->prog = pc = TO_PAIR(pc->car); // Go deeper to enter the call
envt->get_obj(pc->car)->prepare(pc);
}
}
@@ -180,7 +181,8 @@ EvalObj *Evaluator::run_expr(Pair *prog) {
if ((args->car)->is_opt_obj())
{
OptObj *opt = static_cast<OptObj*>(args->car);
- pc = opt->call(args, envt, cont, top_ptr);
+// printf("%s\n", args->ext_repr().c_str());
+ pc = opt->call(args, envt, cont, top_ptr, cont->prog);
}
else
throw TokenError((args->car)->ext_repr(), SYN_ERR_CAN_NOT_APPLY);
diff --git a/types.cpp b/types.cpp
index 672fead..b00459a 100644
--- a/types.cpp
+++ b/types.cpp
@@ -77,7 +77,7 @@ ProcObj::~ProcObj() {
}
Pair *ProcObj::call(Pair *_args, Environment * &lenvt,
- Continuation * &cont, EvalObj ** &top_ptr) {
+ Continuation * &cont, EvalObj ** &top_ptr, Pair *pc) {
// Create a new continuation
// static_cast see `call` invocation in eval.cpp
Pair *ret_addr = cont->pc;
@@ -94,17 +94,18 @@ Pair *ProcObj::call(Pair *_args, Environment * &lenvt,
}
else
{
- if (!nexp->is_simple_obj() && nexp->cdr == empty_list) // tail recursion opt
+ if (nexp->cdr == empty_list && !nexp->car->is_simple_obj()) // tail recursion opt
{
- cont->tail = true;
- cont->state = NULL;
+ cont->tail = true;
+ cont->state = NULL;
+ top_ptr++; // revert the cont
}
else
{
gc.attach(static_cast<EvalObj*>(*(++top_ptr)));
cont->state = nexp;
+ top_ptr++;
}
- top_ptr++;
gc.expose(_args);
return nexp;
}
@@ -305,7 +306,7 @@ BuiltinProcObj::BuiltinProcObj(BuiltinProc f, string _name) :
OptObj(), handler(f), name(_name) {}
Pair *BuiltinProcObj::call(Pair *args, Environment * &lenvt,
- Continuation * &cont, EvalObj ** &top_ptr) {
+ Continuation * &cont, EvalObj ** &top_ptr, Pair *pc) {
Pair *ret_addr = cont->pc;
gc.expose(*top_ptr);
@@ -406,7 +407,7 @@ Environment *Environment::get_prev() {
}
Continuation::Continuation(Environment *_envt, Pair *_pc, Continuation *_prev_cont ) :
- Container(), prev_cont(_prev_cont), envt(_envt), pc(_pc), state(NULL), tail(false) {
+ Container(), prev_cont(_prev_cont), envt(_envt), pc(_pc), state(NULL), prog(NULL), tail(false) {
gc.attach(prev_cont);
gc.attach(envt);
}
diff --git a/types.h b/types.h
index 1c122a4..e90e7bb 100644
--- a/types.h
+++ b/types.h
@@ -150,7 +150,7 @@ class OptObj: public Container {/*{{{*/
* @return New value for pc register
*/
virtual Pair *call(Pair *args, Environment * &envt,
- Continuation * &cont, EvalObj ** &top_ptr) = 0;
+ Continuation * &cont, EvalObj ** &top_ptr, Pair *pc) = 0;
virtual void gc_decrement();
virtual void gc_trigger(EvalObj ** &tail, EvalObjSet &visited);
@@ -172,7 +172,7 @@ class ProcObj: public OptObj {/*{{{*/
ProcObj(Pair *body, Environment *envt, EvalObj *params);
~ProcObj();
Pair *call(Pair *args, Environment * &envt,
- Continuation * &cont, EvalObj ** &top_ptr);
+ Continuation * &cont, EvalObj ** &top_ptr, Pair *pc);
ReprCons *get_repr_cons();
void gc_decrement();
@@ -206,7 +206,7 @@ class BuiltinProcObj: public OptObj {/*{{{*/
*/
BuiltinProcObj(BuiltinProc proc, string name);
Pair *call(Pair *args, Environment * &envt,
- Continuation * &cont, EvalObj ** &top_ptr);
+ Continuation * &cont, EvalObj ** &top_ptr, Pair *pc);
ReprCons *get_repr_cons();
};/*}}}*/
@@ -385,6 +385,7 @@ class Continuation : public Container {/*{{{*/
Environment *envt; /**< The saved envt */
Pair *pc; /**< The saved pc */
Pair *state; /**< The state of this compound */
+ Pair *prog; /**< Pointing to ast */
bool tail; /**< If the proper tail opt is on */
/** Create a continuation */
Powered by cgit, Themed by Ted Yin.