#include <cstdio>
#include <cctype>
#include <cstdlib>
#include "consts.h"
#include "builtin.h"
#include "model.h"
#include "exc.h"
#include "types.h"
using std::stringstream;
extern EmptyList *empty_list;
SpecialOptIf::SpecialOptIf() : SpecialOptObj("if") {}
void SpecialOptIf::prepare(Pair *pc) {
#define IF_EXP_ERR \
throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS)
state = 0; // Prepared
Pair *first, *second, *third;
if (pc->cdr == empty_list)
IF_EXP_ERR;
first = TO_PAIR(pc->cdr);
if (first->cdr == empty_list)
IF_EXP_ERR;
second = TO_PAIR(first->cdr);
if (second->cdr != empty_list)
{
third = TO_PAIR(second->cdr);
if (third->cdr != empty_list) IF_EXP_ERR;
}
pc->next = first;
first->next = NULL; // skip <consequence> and <alternative>
}
Pair *SpecialOptIf::call(Pair *args, Environment * &envt,
Continuation * &cont, FrameObj ** &top_ptr) {
Pair *ret_addr = static_cast<RetAddr*>(*top_ptr)->addr;
if (state)
{
*top_ptr++ = TO_PAIR(args->cdr)->car;
return ret_addr->next; // Move to the next instruction
}
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);
if (TO_PAIR(args->cdr)->car->is_true())
{
pc->next = second;
second->next = NULL;
}
else
{
pc->next = third;
third->next = NULL;
}
// Condition evaluated and the decision is made
state = 1;
// Undo pop and invoke again
top_ptr += 2;
return pc->next;
}
}
#define CHECK_SYMBOL(ptr) \
do \
{ \
if (!(ptr)->is_sym_obj()) \
throw TokenError("a symbol", RUN_ERR_WRONG_TYPE); \
} while (0)
#define CHECK_PARA_LIST(p) \
do \
{ \
if (p == empty_list) break; \
EvalObj *nptr; \
Pair *ptr; \
for (ptr = TO_PAIR(p);;) \
{ \
CHECK_SYMBOL(ptr->car); \
if ((nptr = ptr->cdr)->is_pair_obj()) \
ptr = TO_PAIR(nptr); \
else break; \
} \
if (ptr->cdr != empty_list) \
CHECK_SYMBOL(ptr->cdr); \
} \
while (0)
SpecialOptLambda::SpecialOptLambda() : SpecialOptObj("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 *ret_addr = static_cast<RetAddr*>(*top_ptr)->addr;
Pair *pc = static_cast<Pair*>(ret_addr->car);
if (pc->cdr == empty_list)
throw TokenError(name, SYN_ERR_EMPTY_PARA_LIST);
Pair *first = TO_PAIR(pc->cdr);
EvalObj *params = first->car;
// store a list of expressions inside <body>
Pair *body = TO_PAIR(first->