#include "types.h"
#include "model.h"
#include "exc.h"
#include "consts.h"
#include "gc.h"
#include <cmath>
#include <cstdlib>
#include <sstream>
#include <iomanip>
const double EPS = 1e-16;
const int PREC = 16;
extern EmptyList *empty_list;
extern UnspecObj *unspec_obj;
Pair::Pair(EvalObj *_car, EvalObj *_cdr) :
Container(CLS_PAIR_OBJ), car(_car), cdr(_cdr), next(NULL) {
gc.attach(car);
gc.attach(cdr);
}
Pair::~Pair() {
gc.expose(car);
gc.expose(cdr);
}
void Pair::gc_decrement() {
GC_CYC_DEC(car);
GC_CYC_DEC(cdr);
}
void Pair::gc_trigger(EvalObj ** &tail) {
GC_CYC_TRIGGER(car);
GC_CYC_TRIGGER(cdr);
}
ReprCons *Pair::get_repr_cons() {
return new PairReprCons(this, this);
}
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(int otype) :
Container(otype | CLS_SIM_OBJ | CLS_OPT_OBJ, true) {}
void OptObj::gc_decrement() {}
void OptObj::gc_trigger(EvalObj ** &tail) {}
ProcObj::ProcObj(Pair *_body, Environment *_envt, EvalObj *_params) :
OptObj(CLS_CONTAINER), body(_body), params(_params), envt(_envt) {
gc.attach(body);
gc.attach(params);
gc.attach(envt);
}
ProcObj::~ProcObj() {
gc.expose(body);
gc.expose(params);
gc.expose(envt);
}
Pair *ProcObj::call(Pair *_args, Environment * &lenvt,
Continuation * &cont, EvalObj ** &top_ptr, Pair *pc) {
// Create a new continuation
Pair *ret_addr = cont->pc;
if (cont->state)
{
Pair *nexp = TO_PAIR(cont->state->cdr);
if (nexp == empty_list)
{
gc.expose(*top_ptr);
*top_ptr++ = gc.attach(TO_PAIR(_args->cdr)->car);
EXIT_CURRENT_EXEC(lenvt, cont, _args); // exit cont and envt
return ret_addr->next;
}
else
{
// tail recursion opt
if (nexp->cdr == empty_list && !nexp->car->is_simple_obj())
{
cont->tail = true;
cont->state = NULL;
top_ptr++; // revert the cont
}
else
{
gc.attach(static_cast<EvalObj*>(*(++top_ptr)));
cont->state = nexp;
top_ptr++;
}
gc.expose(_args);
return nexp;
}
}
else
{
gc.expose(lenvt);
lenvt = new Environment(envt);
gc.attach(lenvt);
EvalObj *ppar, *nptr;
Pair *args = _args;
for (ppar = params;
ppar->is_pair_obj();
ppar = TO_PAIR(ppar)->cdr)
{
if ((nptr = args->cdr) != empty_list)
args = TO_PAIR(nptr);