aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--builtin.cpp26
-rw-r--r--consts.cpp4
-rw-r--r--consts.h4
-rw-r--r--eval.cpp2
-rw-r--r--model.cpp44
-rw-r--r--parser.cpp3
6 files changed, 63 insertions, 20 deletions
diff --git a/builtin.cpp b/builtin.cpp
index cec007e..7c5f3c7 100644
--- a/builtin.cpp
+++ b/builtin.cpp
@@ -1258,12 +1258,24 @@ BUILTIN_PROC_DEF(is_eqv) {
BUILTIN_PROC_DEF(is_equal) {
-#define INC1(x) (++(x) == t1 ? (x) = q1:0)
-#define INC2(x) (++(x) == t2 ? (x) = q2:0)
+//#define INC1(x) (++(x) == t1 ? (x) = q1:0)
+//#define INC2(x) (++(x) == t2 ? (x) = q2:0)
+#define INC1(x) (++(x))
+#define INC2(x) (++(x))
+#define CHK1 \
+do { \
+ if (r1 == q1 + EQUAL_QUEUE_SIZE) \
+ throw NormalError(RUN_ERR_QUEUE_OVERFLOW); \
+} while (0)
+
+#define CHK2 \
+do { \
+ if (r2 == q2 + EQUAL_QUEUE_SIZE) \
+ throw NormalError(RUN_ERR_QUEUE_OVERFLOW); \
+} while (0)
+
static EvalObj *q1[EQUAL_QUEUE_SIZE], *q2[EQUAL_QUEUE_SIZE];
- static EvalObj ** const t1 = q1 + EQUAL_QUEUE_SIZE;
- static EvalObj ** const t2 = q2 + EQUAL_QUEUE_SIZE;
ARGS_EXACTLY_TWO;
EvalObj **l1 = q1, **r1 = l1;
@@ -1285,13 +1297,17 @@ BUILTIN_PROC_DEF(is_equal) {
{
*r1 = TO_PAIR(a)->car;
INC1(r1);
+ CHK1;
*r1 = TO_PAIR(a)->cdr;
INC1(r1);
+ CHK1;
*r2 = TO_PAIR(b)->car;
INC2(r2);
+ CHK2;
*r2 = TO_PAIR(b)->cdr;
INC2(r2);
+ CHK2;
}
else if (otype & CLS_VECT_OBJ)
{
@@ -1305,6 +1321,7 @@ BUILTIN_PROC_DEF(is_equal) {
{
*r1 = TO_PAIR(a)->car;
INC1(r1);
+ CHK1;
}
for (EvalObjVec::iterator
@@ -1313,6 +1330,7 @@ BUILTIN_PROC_DEF(is_equal) {
{
*r2 = TO_PAIR(b)->car;
INC2(r2);
+ CHK2;
}
}
else if (otype & CLS_BOOL_OBJ)
diff --git a/consts.cpp b/consts.cpp
index ffa0b30..d0c767c 100644
--- a/consts.cpp
+++ b/consts.cpp
@@ -15,5 +15,7 @@ const char *ERR_MSG[] = {
"Unknown character name: %s",
"Improper pair structure",
"Improper vector structure",
- "Bad formal %s in expression"
+ "Bad formal %s in expression",
+ "Queue overflowed: the expected expansion is too long!",
+ "%s stack overflowed!"
};
diff --git a/consts.h b/consts.h
index f9e2425..4a7c900 100644
--- a/consts.h
+++ b/consts.h
@@ -16,7 +16,9 @@ enum ErrCode {
RUN_ERR_UNKNOWN_CHAR_NAME,
PAR_ERR_IMPROPER_PAIR,
PAR_ERR_IMPROPER_VECT,
- SYN_ERR_BAD_FORMAL
+ SYN_ERR_BAD_FORMAL,
+ RUN_ERR_QUEUE_OVERFLOW,
+ RUN_ERR_STACK_OVERFLOW
};
extern const char *ERR_MSG[];
diff --git a/eval.cpp b/eval.cpp
index 2d03c0c..aa4f729 100644
--- a/eval.cpp
+++ b/eval.cpp
@@ -93,6 +93,8 @@ EvalObj *Evaluator::run_expr(Pair *prog) {
while((*eval_stack)->is_ret_addr())
{
+ if (top_ptr == eval_stack + EVAL_STACK_SIZE)
+ throw TokenError("Evaluation", RUN_ERR_STACK_OVERFLOW);
for (; pc && pc->skip; pc = pc->next);
if (pc)
push(pc, top_ptr, envt);
diff --git a/model.cpp b/model.cpp
index 8599bd0..6c5e4a0 100644
--- a/model.cpp
+++ b/model.cpp
@@ -71,24 +71,29 @@ string EvalObj::ext_repr() {
{
if ((*(top_ptr - 1))->done)
{
- hash.erase((*--top_ptr)->ori);
- obj = (*(top_ptr - 1))->next((*top_ptr)->repr);
+ top_ptr -= 2;
+ obj = (*top_ptr)->next((*(top_ptr + 1))->repr);
if (obj)
{
- *top_ptr++ = obj->get_repr_cons();
- if (hash.count((*(top_ptr - 1))->ori))
- *(top_ptr - 1) = new ReprStr("#cyc#");
+ *(++top_ptr) = obj->get_repr_cons();
+ if (hash.count((*top_ptr)->ori))
+ *top_ptr = new ReprStr("#inf#");
}
else
- *(top_ptr - 1) = new ReprStr((*(top_ptr - 1))->repr);
+ {
+ hash.erase((*top_ptr)->ori);
+ *top_ptr = new ReprStr((*top_ptr)->repr);
+ }
}
else
{
- obj = (*(top_ptr - 1))->next("");
- *top_ptr++ = obj->get_repr_cons();
- if (hash.count((*(top_ptr - 1))->ori))
- *(top_ptr - 1) = new ReprStr("#cyc#");
+ top_ptr--;
+ obj = (*top_ptr)->next("");
+ *(++top_ptr) = obj->get_repr_cons();
+ if (hash.count((*top_ptr)->ori))
+ *top_ptr = new ReprStr("#inf#");
}
+ top_ptr++;
}
string &res = (*repr_stack)->repr;
if (this->is_pair_obj())
@@ -315,11 +320,11 @@ EvalObj *PairReprCons::next(const string &prev) {
if (TO_PAIR(ptr)->car->is_pair_obj())
repr += ")";
ptr = TO_PAIR(ptr)->cdr;
+ if (ptr == empty_list)
+ return NULL;
repr += " ";
if (ptr->is_simple_obj())
repr += ". ";
- if (ptr == empty_list)
- return NULL;
return ptr;
}
else
@@ -333,10 +338,21 @@ VectReprCons::VectReprCons(VecObj *_ptr, EvalObj *_ori) :
EvalObj *VectReprCons::next(const string &prev) {
repr += prev;
+
+ if (idx && ptr->get_obj(idx - 1)->is_pair_obj())
+ repr += ")";
+
if (idx == ptr->get_size())
{
- *repr.rbegin() = ')';
+ repr += ")";
return NULL;
}
- else return ptr->get_obj(idx++);
+ else
+ {
+ if (idx) repr += " ";
+ EvalObj *res = ptr->get_obj(idx++);
+ if (res->is_pair_obj())
+ repr += "(";
+ return res;
+ }
}
diff --git a/parser.cpp b/parser.cpp
index ff21b7b..97482d4 100644
--- a/parser.cpp
+++ b/parser.cpp
@@ -149,6 +149,9 @@ Pair *ASTGenerator::absorb(Tokenizor *tk) {
FrameObj **top_ptr = parse_stack;
for (;;)
{
+ if (top_ptr == parse_stack + PARSE_STACK_SIZE)
+ throw TokenError("Parser", RUN_ERR_STACK_OVERFLOW);
+
if (top_ptr - parse_stack > 1 &&
!IS_BRAKET(*(top_ptr - 1)) &&
IS_BRAKET(*(top_ptr - 2)))