aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorTeddy <ted.sybil@gmail.com>2013-08-11 22:25:22 +0800
committerTeddy <ted.sybil@gmail.com>2013-08-11 22:25:22 +0800
commit76977635e28e06192a486a9452e03bc7b8f612dc (patch)
treec8eaf0c22f1516bb88c2a21661a3bc2b8eadd2c6
parentab3a756ccb788487136d6982a7ddf6d4053ec133 (diff)
fixed severe bug in many special opts
-rw-r--r--Makefile2
-rw-r--r--builtin.cpp304
-rw-r--r--builtin.h5
-rw-r--r--consts.cpp3
-rw-r--r--consts.h3
-rw-r--r--eval.cpp22
-rw-r--r--model.cpp7
-rw-r--r--model.h14
-rw-r--r--types.cpp53
-rw-r--r--types.h19
10 files changed, 322 insertions, 110 deletions
diff --git a/Makefile b/Makefile
index 9b08a29..45795d8 100644
--- a/Makefile
+++ b/Makefile
@@ -2,7 +2,7 @@ main: main.o parser.o builtin.o model.o eval.o exc.o consts.o types.o
g++ -o main $^ -pg -lgmp
.cpp.o:
- g++ $< -c -g -pg -DGMP_SUPPORT -Wall
+ g++ $< -c -g -pg -DGMP_SUPPORT -Wall -O2
clean:
rm -f *.o
diff --git a/builtin.cpp b/builtin.cpp
index d79f11b..859d5e4 100644
--- a/builtin.cpp
+++ b/builtin.cpp
@@ -17,8 +17,7 @@ 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)
@@ -34,40 +33,56 @@ void SpecialOptIf::prepare(Pair *pc) {
third = TO_PAIR(second->cdr);
if (third->cdr != empty_list) IF_EXP_ERR;
}
- pc->next = first;
- first->next = NULL; // skip <consequence> and <alternative>
+ pc->next = NULL;
}
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
+ RetAddr *ret_info = static_cast<RetAddr*>(*top_ptr);
+ Pair *ret_addr = ret_info->addr;
+ if (ret_info->state)
{
- 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())
+ if (ret_info->state == empty_list)
{
- pc->next = second;
- second->next = NULL;
+ *top_ptr++ = TO_PAIR(args->cdr)->car;
+ return ret_addr->next; // Move to the next instruction
}
- else
+ else
{
- pc->next = third;
- third->next = NULL;
+ 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())
+ {
+ second->next = NULL;
+ // Undo pop and invoke again
+ top_ptr += 2;
+ ret_info->state = empty_list;
+ return second;
+ }
+ else if (third != empty_list)
+ {
+ third->next = NULL;
+ // Undo pop and invoke again
+ top_ptr += 2;
+ ret_info->state = empty_list;
+ return third;
+ }
+ else
+ {
+ *top_ptr++ = new UnspecObj();
+ return ret_addr->next;
+ }
}
- // Condition evaluated and the decision is made
- state = 1;
- // Undo pop and invoke again
+ }
+ else
+ {
top_ptr += 2;
- return pc->next;
+ ret_info->state = TO_PAIR(TO_PAIR(ret_addr->car)->cdr);
+ ret_info->state->next = NULL;
+ return ret_info->state;
}
throw NormalError(INT_ERR);
}
@@ -79,6 +94,20 @@ do \
throw TokenError("a symbol", RUN_ERR_WRONG_TYPE); \
} while (0)
+#define CHECK_NUMBER(ptr) \
+do \
+{ \
+ if (!(ptr)->is_num_obj()) \
+ throw TokenError("a number", RUN_ERR_WRONG_TYPE); \
+} while (0)
+
+#define CHECK_INT(ptr) \
+do \
+{ \
+ if ((ptr)->level != NUM_LVL_INT) \
+ throw TokenError("an integer", RUN_ERR_WRONG_TYPE); \
+} while (0)
+
#define CHECK_PARA_LIST(p) \
do \
{ \
@@ -149,21 +178,27 @@ void SpecialOptDefine::prepare(Pair *pc) {
second = TO_PAIR(first->cdr);
if (second->cdr != empty_list)
throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
- pc->next = second; // Skip the identifier
- second->next = NULL;
} // Procedure definition
- else pc->next = NULL; // Skip all parts
+ pc->next = NULL;
}
Pair *SpecialOptDefine::call(Pair *args, Environment * &envt,
Continuation * &cont, FrameObj ** &top_ptr) {
- Pair *ret_addr = static_cast<RetAddr*>(*top_ptr)->addr;
+ RetAddr* ret_info = static_cast<RetAddr*>(*top_ptr);
+ Pair *ret_addr = ret_info->addr;
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)
+ {
+ top_ptr += 2;
+ ret_info->state = TO_PAIR(TO_PAIR(pc->cdr)->cdr);
+ ret_info->state->next = NULL;
+ return ret_info->state;
+ }
if (!first->is_sym_obj())
throw TokenError(first->ext_repr(), SYN_ERR_NOT_AN_ID);
id = static_cast<SymObj*>(first);
@@ -216,16 +251,24 @@ void SpecialOptSet::prepare(Pair *pc) {
if (second->cdr != empty_list)
throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
- pc->next = second;
- second->next = NULL;
+ pc->next = NULL;
}
Pair *SpecialOptSet::call(Pair *args, Environment * &envt,
Continuation * &cont, FrameObj ** &top_ptr) {
- Pair *ret_addr = static_cast<RetAddr*>(*top_ptr)->addr;
+ RetAddr *ret_info = static_cast<RetAddr*>(*top_ptr);
+ Pair *ret_addr = ret_info->addr;
Pair *pc = static_cast<Pair*>(ret_addr->car);
EvalObj *first = TO_PAIR(pc->cdr)->car;
+ if (!ret_info->state)
+ {
+ top_ptr += 2;
+ ret_info->state = TO_PAIR(TO_PAIR(pc->cdr)->cdr);
+ ret_info->state->next = NULL;
+ return ret_info->state;
+ }
+
if (!first->is_sym_obj())
throw TokenError(first->ext_repr(), SYN_ERR_NOT_AN_ID);
@@ -255,25 +298,26 @@ Pair *SpecialOptQuote::call(Pair *args, Environment * &envt,
SpecialOptEval::SpecialOptEval() : SpecialOptObj("eval") {}
void SpecialOptEval::prepare(Pair *pc) {
- state = 0;
+ if (pc->cdr == empty_list ||
+ TO_PAIR(pc->cdr)->cdr != empty_list)
+ throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
}
Pair *SpecialOptEval::call(Pair *args, Environment * &envt,
Continuation * &cont, FrameObj ** &top_ptr) {
- if (args->cdr == empty_list ||
- TO_PAIR(args->cdr)->cdr != empty_list)
- throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
- Pair *ret_addr = static_cast<RetAddr*>(*top_ptr)->addr;
- if (state)
+ RetAddr *ret_info = static_cast<RetAddr*>(*top_ptr);
+ Pair *ret_addr = ret_info->addr;
+ if (ret_info->state)
{
*top_ptr++ = TO_PAIR(args->cdr)->car;
return ret_addr->next; // Move to the next instruction
}
else
{
- state = 1;
top_ptr += 2;
- return TO_PAIR(args->cdr);
+ ret_info->state = TO_PAIR(args->cdr);
+ ret_info->state->next = NULL;
+ return ret_info->state;
}
throw NormalError(INT_ERR);
}
@@ -281,26 +325,30 @@ Pair *SpecialOptEval::call(Pair *args, Environment * &envt,
SpecialOptAnd::SpecialOptAnd() : SpecialOptObj("and") {}
void SpecialOptAnd::prepare(Pair *pc) {
- if (pc->cdr != empty_list)
- {
- pc->next = TO_PAIR(pc->cdr);
- pc->next->next = NULL;
- }
+ pc->next = NULL;
}
Pair *SpecialOptAnd::call(Pair *args, Environment * &envt,
Continuation * &cont, FrameObj ** &top_ptr) {
- Pair *ret_addr = static_cast<RetAddr*>(*top_ptr)->addr;
+ RetAddr *ret_info = static_cast<RetAddr*>(*top_ptr);
+ Pair *ret_addr = ret_info->addr;
Pair *pc = static_cast<Pair*>(ret_addr->car);
- if (args->cdr == empty_list)
+ if (pc->cdr == empty_list)
{
*top_ptr++ = new BoolObj(true);
return ret_addr->next;
}
+ if (!ret_info->state)
+ {
+ top_ptr += 2;
+ ret_info->state = TO_PAIR(pc->cdr);
+ ret_info->state->next = NULL;
+ return ret_info->state;
+ }
EvalObj *ret = TO_PAIR(args->cdr)->car;
if (ret->is_true())
{
- if (pc->next->cdr == empty_list) // the last member
+ if (ret_info->state->cdr == empty_list) // the last member
{
*top_ptr++ = ret;
return ret_addr->next;
@@ -308,9 +356,9 @@ Pair *SpecialOptAnd::call(Pair *args, Environment * &envt,
else
{
top_ptr += 2;
- pc->next = TO_PAIR(pc->next->cdr);
- pc->next->next = NULL;
- return pc->next;
+ ret_info->state = TO_PAIR(ret_info->state->cdr);
+ ret_info->state->next = NULL;
+ return ret_info->state;
}
}
else
@@ -324,26 +372,30 @@ Pair *SpecialOptAnd::call(Pair *args, Environment * &envt,
SpecialOptOr::SpecialOptOr() : SpecialOptObj("or") {}
void SpecialOptOr::prepare(Pair *pc) {
- if (pc->cdr != empty_list)
- {
- pc->next = TO_PAIR(pc->cdr);
- pc->next->next = NULL;
- }
+ 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 *pc = static_cast<Pair*>(ret_addr->car);
- if (args->cdr == empty_list)
+ if (pc->cdr == empty_list)
{
*top_ptr++ = new BoolObj(false);
return ret_addr->next;
}
+ if (!ret_info->state)
+ {
+ top_ptr += 2;
+ ret_info->state = TO_PAIR(pc->cdr);
+ ret_info->state->next = NULL;
+ return ret_info->state;
+ }
EvalObj *ret = TO_PAIR(args->cdr)->car;
if (!ret->is_true())
{
- if (pc->next->cdr == empty_list) // the last member
+ if (ret_info->state->cdr == empty_list) // the last member
{
*top_ptr++ = ret;
return ret_addr->next;
@@ -351,9 +403,9 @@ Pair *SpecialOptOr::call(Pair *args, Environment * &envt,
else
{
top_ptr += 2;
- pc->next = TO_PAIR(pc->next->cdr);
- pc->next->next = NULL;
- return pc->next;
+ ret_info->state = TO_PAIR(ret_info->state->cdr);
+ ret_info->state->next = NULL;
+ return ret_info->state;
}
}
else
@@ -413,14 +465,14 @@ void SpecialOptForce::prepare(Pair *pc) {
if (pc->cdr == empty_list ||
TO_PAIR(pc->cdr)->cdr != empty_list)
throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
- state = 0;
}
Pair *SpecialOptForce::call(Pair *args, Environment * &envt,
Continuation * &cont, FrameObj ** &top_ptr) {
args = TO_PAIR(args->cdr);
- Pair *ret_addr = static_cast<RetAddr*>(*top_ptr)->addr;
- if (state)
+ RetAddr *ret_info = static_cast<RetAddr*>(*top_ptr);
+ Pair *ret_addr = ret_info->addr;
+ if (ret_info->state)
{
EvalObj *mem = args->car;
prom->feed_mem(mem);
@@ -440,9 +492,10 @@ Pair *SpecialOptForce::call(Pair *args, Environment * &envt,
}
else // force
{
- state = 1;
top_ptr += 2;
- return prom->get_entry();
+ ret_info->state = prom->get_entry();
+ ret_info->state->next = NULL;
+ return ret_info->state;
}
}
}
@@ -1093,35 +1146,40 @@ BUILTIN_PROC_DEF(is_integer) {
BUILTIN_PROC_DEF(num_abs) {
ARGS_EXACTLY_ONE;
- if (!args->car->is_num_obj())
- throw TokenError("a number", RUN_ERR_WRONG_TYPE);
+ CHECK_NUMBER(args->car);
return static_cast<NumObj*>(args->car)->abs();
}
BUILTIN_PROC_DEF(num_mod) {
ARGS_EXACTLY_TWO;
+ CHECK_NUMBER(args->car);
+ CHECK_NUMBER(TO_PAIR(args->cdr)->car);
NumObj* a = static_cast<NumObj*>(args->car);
NumObj* b = static_cast<NumObj*>(TO_PAIR(args->cdr)->car);
- if (a->level != NUM_LVL_INT || b->level != NUM_LVL_INT)
- throw TokenError("an integer", RUN_ERR_WRONG_TYPE);
+ CHECK_INT(a);
+ CHECK_INT(b);
return static_cast<IntNumObj*>(a)->mod(b);
}
BUILTIN_PROC_DEF(num_rem) {
ARGS_EXACTLY_TWO;
+ CHECK_NUMBER(args->car);
+ CHECK_NUMBER(TO_PAIR(args->cdr)->car);
NumObj* a = static_cast<NumObj*>(args->car);
NumObj* b = static_cast<NumObj*>(TO_PAIR(args->cdr)->car);
- if (a->level != NUM_LVL_INT || b->level != NUM_LVL_INT)
- throw TokenError("an integer", RUN_ERR_WRONG_TYPE);
+ CHECK_INT(a);
+ CHECK_INT(b);
return static_cast<IntNumObj*>(a)->rem(b);
}
BUILTIN_PROC_DEF(num_quo) {
ARGS_EXACTLY_TWO;
+ CHECK_NUMBER(args->car);
+ CHECK_NUMBER(TO_PAIR(args->cdr)->car);
NumObj* a = static_cast<NumObj*>(args->car);
NumObj* b = static_cast<NumObj*>(TO_PAIR(args->cdr)->car);
- if (a->level != NUM_LVL_INT || b->level != NUM_LVL_INT)
- throw TokenError("an integer", RUN_ERR_WRONG_TYPE);
+ CHECK_INT(a);
+ CHECK_INT(b);
return static_cast<IntNumObj*>(a)->quo(b);
}
@@ -1131,10 +1189,8 @@ BUILTIN_PROC_DEF(num_gcd) {
IntNumObj *opr;
for (;args != empty_list; args = TO_PAIR(args->cdr))
{
- if (!args->car->is_num_obj()) // not a number
- throw TokenError("a number", RUN_ERR_WRONG_TYPE);
- if (static_cast<NumObj*>(args->car)->level != NUM_LVL_INT) // not a number
- throw TokenError("an integer", RUN_ERR_WRONG_TYPE);
+ CHECK_NUMBER(args->car);
+ CHECK_INT(static_cast<NumObj*>(args->car));
opr = static_cast<IntNumObj*>(args->car);
res = opr->gcd(res);
@@ -1148,10 +1204,8 @@ BUILTIN_PROC_DEF(num_lcm) {
IntNumObj *opr;
for (;args != empty_list; args = TO_PAIR(args->cdr))
{
- if (!args->car->is_num_obj()) // not a number
- throw TokenError("a number", RUN_ERR_WRONG_TYPE);
- if (static_cast<NumObj*>(args->car)->level != NUM_LVL_INT) // not a number
- throw TokenError("an integer", RUN_ERR_WRONG_TYPE);
+ CHECK_NUMBER(args->car);
+ CHECK_INT(static_cast<NumObj*>(args->car));
opr = static_cast<IntNumObj*>(args->car);
res = opr->lcm(res);
@@ -1214,6 +1268,90 @@ BUILTIN_PROC_DEF(string_eq) {
return new BoolObj(static_cast<StrObj*>(obj1)->eq(static_cast<StrObj*>(obj2)));
}
+BUILTIN_PROC_DEF(make_vector) {
+ ARGS_AT_LEAST_ONE;
+ if (!args->car->is_num_obj())
+ throw TokenError("a number", RUN_ERR_WRONG_TYPE);
+ if (static_cast<NumObj*>(args->car)->level != NUM_LVL_INT)
+ throw TokenError("an integer", RUN_ERR_WRONG_TYPE);
+ ssize_t len = static_cast<IntNumObj*>(args->car)->get_i();
+ if (len < 0)
+ throw TokenError("a non-negative integer", RUN_ERR_WRONG_TYPE);
+
+ EvalObj *fill;
+
+ args = TO_PAIR(args->cdr);
+ if (args == empty_list)
+ fill = new UnspecObj();
+ else if (args->cdr == empty_list)
+ fill = args->car;
+ else
+ throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
+
+ VecObj *res = new VecObj();
+ res->resize(size_t(len));
+ res->fill(fill);
+ return res;
+}
+
+BUILTIN_PROC_DEF(vector_set) {
+ if (args == empty_list)
+ throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
+ if (!args->car->is_vect_obj())
+ throw TokenError("a vector", RUN_ERR_WRONG_TYPE);
+ VecObj *vect = static_cast<VecObj*>(args->car);
+
+ args = TO_PAIR(args->cdr);
+ if (args == empty_list)
+ throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
+ CHECK_NUMBER(args->car);
+ CHECK_INT(static_cast<NumObj*>(args->car));
+ ssize_t k = static_cast<IntNumObj*>(args->car)->get_i();
+ if (k < 0)
+ throw TokenError("a non-negative integer", RUN_ERR_WRONG_TYPE);
+
+ args = TO_PAIR(args->cdr);
+ if (args == empty_list)
+ throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
+ if (args->cdr != empty_list)
+ throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
+
+ vect->set(k, args->car);
+ return new UnspecObj();
+}
+
+BUILTIN_PROC_DEF(vector_ref) {
+ if (args == empty_list)
+ throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
+ if (!args->car->is_vect_obj())
+ throw TokenError("a vector", RUN_ERR_WRONG_TYPE);
+ VecObj *vect = static_cast<VecObj*>(args->car);
+
+ args = TO_PAIR(args->cdr);
+ if (args == empty_list)
+ throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
+ if (args->cdr != empty_list)
+ throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
+
+ CHECK_NUMBER(args->car);
+ CHECK_INT(static_cast<NumObj*>(args->car));
+ ssize_t k = static_cast<IntNumObj*>(args->car)->get_i();
+ if (k < 0)
+ throw TokenError("a non-negative integer", RUN_ERR_WRONG_TYPE);
+ return vect->get_obj(k);
+}
+
+BUILTIN_PROC_DEF(vector_length) {
+ if (args == empty_list)
+ throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
+ if (!args->car->is_vect_obj())
+ throw TokenError("a vector", RUN_ERR_WRONG_TYPE);
+ if (args->cdr != empty_list)
+ throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
+ VecObj *vect = static_cast<VecObj*>(args->car);
+ return new IntNumObj(vect->get_size());
+}
+
BUILTIN_PROC_DEF(display) {
ARGS_EXACTLY_ONE;
diff --git a/builtin.h b/builtin.h
index dce6fa3..1a2e7a8 100644
--- a/builtin.h
+++ b/builtin.h
@@ -240,4 +240,9 @@ BUILTIN_PROC_DEF(string_gt);
BUILTIN_PROC_DEF(string_ge);
BUILTIN_PROC_DEF(string_eq);
+BUILTIN_PROC_DEF(make_vector);
+BUILTIN_PROC_DEF(vector_set);
+BUILTIN_PROC_DEF(vector_ref);
+BUILTIN_PROC_DEF(vector_length);
+
#endif
diff --git a/consts.cpp b/consts.cpp
index 04705ed..a04d5c7 100644
--- a/consts.cpp
+++ b/consts.cpp
@@ -18,5 +18,6 @@ const char *ERR_MSG[] = {
"Bad formal %s in expression",
"Queue overflowed: the expected expansion is too long!",
"%s stack overflowed!",
- "Numeric overflow!"
+ "Numeric overflow!",
+ "Value out of range"
};
diff --git a/consts.h b/consts.h
index 7e5de8d..b24e951 100644
--- a/consts.h
+++ b/consts.h
@@ -19,7 +19,8 @@ enum ErrCode {
SYN_ERR_BAD_FORMAL,
RUN_ERR_QUEUE_OVERFLOW,
RUN_ERR_STACK_OVERFLOW,
- RUN_ERR_NUMERIC_OVERFLOW
+ RUN_ERR_NUMERIC_OVERFLOW,
+ RUN_ERR_VALUE_OUT_OF_RANGE
};
extern const char *ERR_MSG[];
diff --git a/eval.cpp b/eval.cpp
index 7b11600..2deb38c 100644
--- a/eval.cpp
+++ b/eval.cpp
@@ -82,6 +82,11 @@ void Evaluator::add_builtin_routines() {
ADD_BUILTIN_PROC("string>?", string_gt);
ADD_BUILTIN_PROC("string<=?", string_ge);
ADD_BUILTIN_PROC("string=?", string_eq);
+
+ ADD_BUILTIN_PROC("make-vector", make_vector);
+ ADD_BUILTIN_PROC("vector-set!", vector_set);
+ ADD_BUILTIN_PROC("vector-ref", vector_ref);
+ ADD_BUILTIN_PROC("vector-length", vector_length);
}
Evaluator::Evaluator() {
@@ -104,18 +109,22 @@ inline bool make_exec(Pair *ptr) {
}
inline void push(Pair * &pc, FrameObj ** &top_ptr, Environment *envt) {
+// if (pc->car == NULL)
+ // puts("oops");
if (pc->car->is_simple_obj()) // Not an opt invocation
{
*top_ptr = envt->get_obj(pc->car); // Objectify the symbol
top_ptr++;
pc = pc->next; // Move to the next instruction
+// if (pc == empty_list)
+// puts("oops");
}
else // Operational Invocation
{
if (pc->car == empty_list)
throw NormalError(SYN_ERR_EMPTY_COMB);
- *top_ptr++ = new RetAddr(pc); // Push the return address
+ *top_ptr++ = new RetAddr(pc, NULL); // Push the return address
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
@@ -124,6 +133,17 @@ 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;
Pair *pc = prog;
diff --git a/model.cpp b/model.cpp
index 53b5541..938deca 100644
--- a/model.cpp
+++ b/model.cpp
@@ -62,6 +62,10 @@ bool EvalObj::is_prom_obj() {
return otype & CLS_PROM_OBJ;
}
+bool EvalObj::is_vect_obj() {
+ return otype & CLS_VECT_OBJ;
+}
+
int EvalObj::get_otype() {
return otype;
}
@@ -125,3 +129,6 @@ string EvalObj::ext_repr() {
res = "(" + res + ")";
return res;
}
+
+RetAddr::RetAddr(Pair *_addr, Pair *_state) :
+ FrameObj(CLS_RET_ADDR), addr(_addr), state(_state) {}
diff --git a/model.h b/model.h
index 6f4dfd5..7fb9fc8 100644
--- a/model.h
+++ b/model.h
@@ -89,6 +89,8 @@ class EvalObj : public FrameObj {
bool is_str_obj();
/** Check if the object is a promise */
bool is_prom_obj();
+ /** Check if the object is a vector */
+ bool is_vect_obj();
int get_otype();
virtual void prepare(Pair *pc);
/** Any EvalObj has its external representation */
@@ -99,4 +101,16 @@ class EvalObj : public FrameObj {
virtual ReprCons *get_repr_cons() = 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
diff --git a/types.cpp b/types.cpp
index 64e3ce2..8611cc6 100644
--- a/types.cpp
+++ b/types.cpp
@@ -21,7 +21,6 @@ Pair::Pair(EvalObj *_car, EvalObj *_cdr) :
return new PairReprCons(this, this);
}
-RetAddr::RetAddr(Pair *_addr) : FrameObj(CLS_RET_ADDR), addr(_addr) {}
ParseBracket::ParseBracket(unsigned char _btype) :
FrameObj(CLS_SIM_OBJ | CLS_PAR_BRA), btype(_btype) {}
@@ -138,15 +137,21 @@ ReprCons *CharObj::get_repr_cons() {
VecObj::VecObj() : EvalObj(CLS_SIM_OBJ | CLS_VECT_OBJ) {}
-EvalObj *VecObj::get_obj(int idx) {
+EvalObj *VecObj::get_obj(size_t idx) {
return vec[idx];
}
+void VecObj::set(size_t idx, EvalObj *obj) {
+ if (idx >= get_size())
+ throw NormalError(RUN_ERR_VALUE_OUT_OF_RANGE);
+ vec[idx] = obj;
+}
+
size_t VecObj::get_size() {
return vec.end() - vec.begin();
}
-void VecObj::resize(int new_size) {
+void VecObj::resize(size_t new_size) {
vec.resize(new_size);
}
@@ -154,6 +159,12 @@ void VecObj::push_back(EvalObj *new_elem) {
vec.push_back(new_elem);
}
+void VecObj::fill(EvalObj *obj) {
+ for (EvalObjVec::iterator it = vec.begin();
+ it != vec.end(); it++)
+ *it = obj;
+}
+
ReprCons *VecObj::get_repr_cons() {
return new VectReprCons(this, this);
}
@@ -203,10 +214,27 @@ ReprCons *BuiltinProcObj::get_repr_cons() {
Environment::Environment(Environment *_prev_envt) : prev_envt(_prev_envt) {}
bool Environment::add_binding(SymObj *sym_obj, EvalObj *eval_obj, bool def) {
- bool has_key = binding.count(sym_obj->val);
- if (!def && !has_key) return false;
- binding[sym_obj->val] = eval_obj;
- return true;
+ bool found = false;
+ string name(sym_obj->val);
+ if (!def)
+ {
+ for (Environment *ptr = this; ptr; ptr = ptr->prev_envt)
+ {
+ bool has_key = ptr->binding.count(name);
+ if (has_key)
+ {
+ ptr->binding[name] = eval_obj;
+ found = true;
+ break;
+ }
+ }
+ return found;
+ }
+ else
+ {
+ binding[name] = eval_obj;
+ return true;
+ }
}
EvalObj *Environment::get_obj(EvalObj *obj) {
@@ -368,7 +396,7 @@ CompNumObj::CompNumObj(double _real, double _imag) :
// ipos: the position of i
long long spos = -1, ipos = -1;
size_t len = repr.length();
- bool sign;
+ bool sign = false;
for (size_t i = 0; i < len; i++)
if (repr[i] == '+' || repr[i] == '-')
{
@@ -855,11 +883,14 @@ NumObj *IntNumObj::abs() {
}
NumObj *IntNumObj::rem(NumObj *_r) {
- return new IntNumObj(val % static_cast<IntNumObj*>(_r)->val);
+ const mpz_class &rval(static_cast<IntNumObj*>(_r)->val);
+ if (rval == 0) throw NormalError(RUN_ERR_NUMERIC_OVERFLOW);
+ return new IntNumObj(val % rval);
}
NumObj *IntNumObj::mod(NumObj *_r) {
const mpz_class &rval = static_cast<IntNumObj*>(_r)->val;
+ if (rval == 0) throw NormalError(RUN_ERR_NUMERIC_OVERFLOW);
mpz_class ret = val % rval;
if (sgn(ret) != sgn(rval))
ret = ret + rval;
@@ -867,7 +898,9 @@ NumObj *IntNumObj::mod(NumObj *_r) {
}
NumObj *IntNumObj::quo(NumObj *_r) {
- return new IntNumObj(val / static_cast<IntNumObj*>(_r)->val);
+ const mpz_class &rval = static_cast<IntNumObj*>(_r)->val;
+ if (rval == 0) throw NormalError(RUN_ERR_NUMERIC_OVERFLOW);
+ return new IntNumObj(val / rval);
}
NumObj *IntNumObj::gcd(NumObj *_r) {
diff --git a/types.h b/types.h
index f0d8713..11776ab 100644
--- a/types.h
+++ b/types.h
@@ -60,17 +60,6 @@ class EmptyList: public Pair {/*{{{*/
ReprCons *get_repr_cons();
};/*}}}*/
-/** @class RetAddr
- * Tracking the caller's Pair pointer
- */
-class RetAddr : public FrameObj {/*{{{*/
- public:
- Pair* addr; /**< The return address */
- /** Constructs a return address object which refers to the node addr in
- * the AST */
- RetAddr(Pair *addr);
-};/*}}}*/
-
class ReprCons {/*{{{*/
public:
EvalObj *ori;
@@ -303,11 +292,15 @@ class VecObj: public EvalObj {/*{{{*/
/** Construct a vector object */
VecObj();
size_t get_size();
- EvalObj *get_obj(int idx);
+ EvalObj *get_obj(size_t idx);
/** Resize the vector */
- void resize(int new_size);
+ void resize(size_t new_size);
/** Add a new element to the rear */
void push_back(EvalObj *new_elem);
+ /** Fill the vector with obj */
+ void fill(EvalObj *obj);
+ /** Replace an existing element in the vector */
+ void set(size_t idx, EvalObj *obj);
ReprCons *get_repr_cons();
};/*}}}*/