aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--builtin.cpp244
-rw-r--r--builtin.h44
-rw-r--r--eval.cpp73
-rw-r--r--gc.cpp9
-rw-r--r--gc.h2
-rw-r--r--model.cpp7
-rw-r--r--model.h27
-rw-r--r--test/q.scm17
-rw-r--r--types.cpp81
-rw-r--r--types.h27
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
}
diff --git a/builtin.h b/builtin.h
index 666b48e..468b74d 100644
--- a/builtin.h
+++ b/builtin.h
@@ -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);
};/*}}}*/
diff --git a/eval.cpp b/eval.cpp
index 0157f14..4f6575d 100644
--- a/eval.cpp
+++ b/eval.cpp
@@ -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));
}
diff --git a/gc.cpp b/gc.cpp
index ee3eb6f..14f7edd 100644
--- a/gc.cpp
+++ b/gc.cpp
@@ -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();
}
diff --git a/gc.h b/gc.h
index 124588b..452b0a0 100644
--- a/gc.h
+++ b/gc.h
@@ -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;
diff --git a/model.cpp b/model.cpp
index f802c60..64a3c96