aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorTeddy <ted.sybil@gmail.com>2013-08-07 00:56:37 +0800
committerTeddy <ted.sybil@gmail.com>2013-08-07 00:56:37 +0800
commitcecd643ab2de3e4dbd69e76c58b928ab2aa2a80f (patch)
tree773d94e7a4309b32d61ee724b8dfd82e2e460221
parentdd6394d93dc21305e26232891daf5b19c226dd3a (diff)
list checking fix
-rw-r--r--TODO.rst1
-rw-r--r--builtin.cpp157
-rw-r--r--builtin.h2
-rw-r--r--consts.cpp3
-rw-r--r--consts.h3
-rw-r--r--eval.cpp2
-rw-r--r--main.cpp7
-rw-r--r--model.cpp16
-rw-r--r--model.h4
-rw-r--r--parser.cpp6
10 files changed, 139 insertions, 62 deletions
diff --git a/TODO.rst b/TODO.rst
index 26daef7..b90ca50 100644
--- a/TODO.rst
+++ b/TODO.rst
@@ -1,3 +1,2 @@
- GMP
-- Pair literal parsing
- Add macro support
diff --git a/builtin.cpp b/builtin.cpp
index 0bbd67e..65c1109 100644
--- a/builtin.cpp
+++ b/builtin.cpp
@@ -16,6 +16,27 @@ static const int NUM_LVL_REAL = 1;
static const int NUM_LVL_RAT = 2;
static const int NUM_LVL_INT = 3;
+#define ARGS_EXACTLY_TWO \
+ if (args == empty_list || !args->cdr->is_cons_obj() || \
+ TO_CONS(args->cdr)->cdr != empty_list) \
+ throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS) \
+
+#define ARGS_EXACTLY_ONE \
+ if (args == empty_list || !args->cdr->is_cons_obj() ) \
+ throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS)
+
+#define ARGS_AT_LEAST_ONE \
+ if (args == empty_list) \
+ throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS)
+
+bool is_list(Cons *ptr) {
+ EvalObj *nptr;
+ for (;;)
+ if ((nptr = ptr->cdr)->is_cons_obj())
+ ptr = TO_CONS(nptr);
+ else break;
+ return ptr->cdr == empty_list;
+}
string double_to_str(double val, bool force_sign = false) {
stringstream ss;
@@ -397,23 +418,37 @@ string IntNumObj::ext_repr() {
return int_to_str(val);
}
-SpecialOptIf::SpecialOptIf() : SpecialOptObj() {}
+SpecialOptIf::SpecialOptIf() : SpecialOptObj("if") {}
void SpecialOptIf::prepare(Cons *pc) {
+#define IF_EXP_ERR \
+ throw TokenError("if", RUN_ERR_WRONG_NUM_OF_ARGS)
state = 0; // Prepared
- pc = TO_CONS(pc->cdr);
+ if (pc->cdr->is_cons_obj())
+ pc = TO_CONS(pc->cdr);
+ else
+ IF_EXP_ERR;
if (pc == empty_list)
- throw TokenError("if", SYN_ERR_MISS_OR_EXTRA_EXP);
+ IF_EXP_ERR;
+
pc->skip = false;
- pc = TO_CONS(pc->cdr);
+ if (pc->cdr->is_cons_obj())
+ pc = TO_CONS(pc->cdr);
+ else
+ IF_EXP_ERR;
if (pc == empty_list)
- throw TokenError("if", SYN_ERR_MISS_OR_EXTRA_EXP);
+ IF_EXP_ERR;
pc->skip = true;
if (pc->cdr != empty_list)
- TO_CONS(pc->cdr)->skip = true;
+ {
+ if (pc->cdr->is_cons_obj())
+ TO_CONS(pc->cdr)->skip = true;
+ else
+ IF_EXP_ERR;
+ }
}
void SpecialOptIf::pre_call(ArgList *args, Cons *pc,
@@ -468,11 +503,43 @@ Cons *SpecialOptIf::call(ArgList *args, Environment * &envt,
string SpecialOptIf::ext_repr() { return string("#<Builtin Macro: if>"); }
-SpecialOptLambda::SpecialOptLambda() : SpecialOptObj() {}
-#define FILL_MARKS(pc, flag) \
- for (Cons *ptr = TO_CONS(pc->cdr); \
- ptr != empty_list; ptr = TO_CONS(ptr->cdr)) \
-ptr->skip = flag
+SpecialOptLambda::SpecialOptLambda() : SpecialOptObj("lambda") {}
+#define FILL_MARKS(pc, flag) \
+do \
+{ \
+ EvalObj *nptr; \
+ Cons *ptr; \
+ for (ptr = TO_CONS(pc->cdr);;) \
+ { \
+ ptr->skip = flag; \
+ if ((nptr = ptr->cdr)->is_cons_obj()) \
+ ptr = TO_CONS(nptr); \
+ else break; \
+ } \
+ if (ptr->cdr != empty_list) \
+ throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS); \
+} \
+while (0)
+
+#define CHECK_PARA_LIST(p) \
+do \
+{ \
+ if (p == empty_list) break; \
+ EvalObj *nptr; \
+ Cons *ptr; \
+ for (ptr = TO_CONS(p);;) \
+ { \
+ if (!ptr->car->is_sym_obj()) \
+ throw TokenError(ptr->car->ext_repr(), RUN_ERR_WRONG_NUM_OF_ARGS); \
+ if ((nptr = ptr->cdr)->is_cons_obj()) \
+ ptr = TO_CONS(nptr); \
+ else break; \
+ } \
+ if (ptr->cdr != empty_list) \
+ throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS); \
+} \
+while (0)
+
void SpecialOptLambda::prepare(Cons *pc) {
// Do not evaluate anything
@@ -486,16 +553,20 @@ Cons *SpecialOptLambda::call(ArgList *args, Environment * &envt,
Cons *pc = static_cast<Cons*>(ret_addr->car);
if (pc->cdr == empty_list)
- throw TokenError("lambda", SYN_ERR_EMPTY_PARA_LIST);
+ throw TokenError(name, SYN_ERR_EMPTY_PARA_LIST);
if (TO_CONS(pc->cdr)->cdr == empty_list)
- throw TokenError("lambda", SYN_ERR_MISS_OR_EXTRA_EXP);
+ throw TokenError(name, SYN_ERR_MISS_OR_EXTRA_EXP);
- SymbolList *para_list = static_cast<SymbolList*>(TO_CONS(pc->cdr)->car);
- // Clear the flag to avoid side-effects (e.g. proc calling)
+ // Clear the flag to avoid side-effects (e.g. proc calling)
FILL_MARKS(pc, false);
+
+ pc = TO_CONS(pc->cdr);
+ CHECK_PARA_LIST(pc->car);
+ SymbolList *para_list = static_cast<SymbolList*>(pc->car);
// store a list of expressions inside <body>
- ASTList *body = TO_CONS(TO_CONS(pc->cdr)->cdr); // Truncate the expression list
+
+ ASTList *body = TO_CONS(pc->cdr); // Truncate the expression list
for (Cons *ptr = body; ptr != empty_list; ptr = TO_CONS(ptr->cdr))
ptr->next = NULL; // Make each expression an orphan
@@ -505,17 +576,17 @@ Cons *SpecialOptLambda::call(ArgList *args, Environment * &envt,
string SpecialOptLambda::ext_repr() { return string("#<Builtin Macro: lambda>"); }
-SpecialOptDefine::SpecialOptDefine() : SpecialOptObj() {}
+SpecialOptDefine::SpecialOptDefine() : SpecialOptObj("define") {}
void SpecialOptDefine::prepare(Cons *pc) {
- if (pc->cdr == empty_list)
- throw TokenError("define", SYN_ERR_MISS_OR_EXTRA_EXP);
+ if (!pc->cdr->is_cons_obj())
+ throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
- if (TO_CONS(pc->cdr)->car->is_simple_obj()) // Simple value assignment
+ pc = TO_CONS(pc->cdr);
+ if (pc->car->is_simple_obj()) // Simple value assignment
{
- pc = TO_CONS(pc->cdr);
- if (pc->cdr == empty_list)
- throw TokenError("define", SYN_ERR_MISS_OR_EXTRA_EXP);
+ if (!pc->cdr->is_cons_obj())
+ throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
pc->skip = true; // Skip the identifier
TO_CONS(pc->cdr)->skip = false;
} // Procedure definition
@@ -533,19 +604,20 @@ Cons *SpecialOptDefine::call(ArgList *args, Environment * &envt,
{
if (!first->is_sym_obj())
throw TokenError(first->ext_repr(), SYN_ERR_NOT_AN_ID);
-
+ ARGS_EXACTLY_TWO;
id = static_cast<SymObj*>(first);
obj = TO_CONS(args->cdr)->car;
}
else
{
// static_cast because of is_simple_obj() is false
- Cons *plst = static_cast<Cons*>(TO_CONS(pc->cdr)->car);
+ Cons *plst = static_cast<Cons*>(first);
if (plst == empty_list)
- throw TokenError("if", SYN_ERR_EMPTY_PARA_LIST);
+ throw TokenError(name, SYN_ERR_EMPTY_PARA_LIST);
if (!plst->car->is_sym_obj())
throw TokenError(first->ext_repr(), SYN_ERR_NOT_AN_ID);
+ CHECK_PARA_LIST(plst->cdr);
id = static_cast<SymObj*>(plst->car);
ArgList *para_list = TO_CONS(plst->cdr);
@@ -555,7 +627,7 @@ Cons *SpecialOptDefine::call(ArgList *args, Environment * &envt,
ASTList *body = TO_CONS(TO_CONS(pc->cdr)->cdr); // Truncate the expression list
if (body == empty_list)
- throw TokenError("define", SYN_ERR_MISS_OR_EXTRA_EXP);
+ throw TokenError(name, SYN_ERR_MISS_OR_EXTRA_EXP);
for (Cons *ptr = body; ptr != empty_list; ptr = TO_CONS(ptr->cdr))
ptr->next = NULL; // Make each expression a orphan
@@ -570,15 +642,17 @@ Cons *SpecialOptDefine::call(ArgList *args, Environment * &envt,
string SpecialOptDefine::ext_repr() { return string("#<Builtin Macro: define>"); }
void SpecialOptSet::prepare(Cons *pc) {
+ if (!pc->cdr->is_cons_obj())
+ throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
+
pc = TO_CONS(pc->cdr);
- if (pc == empty_list)
- throw TokenError("set!", SYN_ERR_MISS_OR_EXTRA_EXP);
pc->skip = true; // Skip the identifier
+ if (!pc->cdr->is_cons_obj())
+ throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
+
pc = TO_CONS(pc->cdr);
- if (pc == empty_list)
- throw TokenError("set!", SYN_ERR_MISS_OR_EXTRA_EXP);
pc->skip = false;
}
@@ -591,6 +665,7 @@ Cons *SpecialOptSet::call(ArgList *args, Environment * &envt,
if (!first->is_sym_obj())
throw TokenError(first->ext_repr(), SYN_ERR_NOT_AN_ID);
+ ARGS_EXACTLY_TWO;
SymObj *id = static_cast<SymObj*>(first);
@@ -600,11 +675,11 @@ Cons *SpecialOptSet::call(ArgList *args, Environment * &envt,
return ret_addr->next;
}
-SpecialOptSet::SpecialOptSet() {}
+SpecialOptSet::SpecialOptSet() : SpecialOptObj("set!") {}
string SpecialOptSet::ext_repr() { return string("#<Builtin Macro: set!>"); }
-SpecialOptQuote::SpecialOptQuote() {}
+SpecialOptQuote::SpecialOptQuote() : SpecialOptObj("quote") {}
void SpecialOptQuote::prepare(Cons *pc) {
// Do not evaluate anything
@@ -623,20 +698,6 @@ Cons *SpecialOptQuote::call(ArgList *args, Environment * &envt,
string SpecialOptQuote::ext_repr() { return string("#<Builtin Macro: quote>"); }
-#define ARGS_EXACTLY_TWO \
- if (args == empty_list || \
- args->cdr == empty_list || \
- TO_CONS(args->cdr)->cdr != empty_list) \
-throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS)
-
-#define ARGS_EXACTLY_ONE \
- if (args == empty_list || \
- args->cdr != empty_list) \
-throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS)
-
-#define ARGS_AT_LEAST_ONE \
- if (args == empty_list) \
-throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS)
BUILTIN_PROC_DEF(make_pair) {
ARGS_EXACTLY_TWO;
@@ -660,6 +721,8 @@ BUILTIN_PROC_DEF(pair_cdr) {
}
BUILTIN_PROC_DEF(make_list) {
+ if (!is_list(args))
+ throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
return args;
}
diff --git a/builtin.h b/builtin.h
index c1a38bd..a01c93e 100644
--- a/builtin.h
+++ b/builtin.h
@@ -6,7 +6,7 @@
using std::string;
-
+bool is_list(Cons *ptr);
/** @class InexactNumObj
* Inexact number implementation (using doubles)
diff --git a/consts.cpp b/consts.cpp
index eb17eaa..ffa0b30 100644
--- a/consts.cpp
+++ b/consts.cpp
@@ -14,5 +14,6 @@ const char *ERR_MSG[] = {
"Illegal character in escape sequence: #\\%s",
"Unknown character name: %s",
"Improper pair structure",
- "Improper vector structure"
+ "Improper vector structure",
+ "Bad formal %s in expression"
};
diff --git a/consts.h b/consts.h
index dc2c4f6..f9e2425 100644
--- a/consts.h
+++ b/consts.h
@@ -15,7 +15,8 @@ enum ErrCode {
PAR_ERR_ILLEGAL_CHAR_IN_ESC,
RUN_ERR_UNKNOWN_CHAR_NAME,
PAR_ERR_IMPROPER_PAIR,
- PAR_ERR_IMPROPER_VECT
+ PAR_ERR_IMPROPER_VECT,
+ SYN_ERR_BAD_FORMAL
};
extern const char *ERR_MSG[];
diff --git a/eval.cpp b/eval.cpp
index e6e6de1..de43fe8 100644
--- a/eval.cpp
+++ b/eval.cpp
@@ -71,6 +71,8 @@ void push(Cons * &pc, FrameObj ** &top_ptr, Environment *envt) {
throw NormalError(SYN_ERR_EMPTY_COMB);
*top_ptr++ = new RetAddr(pc); // Push the return address
+ if (!is_list(TO_CONS(pc->car)))
+ throw TokenError(pc->car->ext_repr(), RUN_ERR_WRONG_NUM_OF_ARGS);
// static_cast because of is_simple_obj() is false
pc = static_cast<Cons*>(pc->car); // Go deeper to enter the call
}
diff --git a/main.cpp b/main.cpp
index eae0597..68f6c33 100644
--- a/main.cpp
+++ b/main.cpp
@@ -8,10 +8,11 @@
#ifdef DEBUG
extern Cons *empty_list;
void tree_print(Cons *ptr) {
- if (!ptr || ptr == empty_list) return;
ptr->_debug_print();
- tree_print(dynamic_cast<Cons*>(ptr->car));
- tree_print(TO_CONS(ptr->cdr));
+ if (ptr->car->is_cons_obj())
+ tree_print(TO_CONS(ptr->car));
+ if (ptr->cdr->is_cons_obj())
+ tree_print(TO_CONS(ptr->cdr));
}
#endif
diff --git a/model.cpp b/model.cpp
index 4cfdca0..67db5fe 100644
--- a/model.cpp
+++ b/model.cpp
@@ -146,12 +146,18 @@ Cons *ProcObj::call(ArgList *args, Environment * &genvt,
Environment *_envt = new Environment(envt);
// static_cast<SymObj*> because the para_list is already checked
Cons *ptr, *ppar;
- for (ptr = TO_CONS(args->cdr), ppar = para_list;
- ptr != empty_list && ppar != empty_list;
- ptr = TO_CONS(ptr->cdr), ppar = TO_CONS(ppar->cdr))
+ EvalObj *nptr;
+ for (ptr = TO_CONS(args->cdr), ppar = para_list;
+ ppar != empty_list;
+ ppar = TO_CONS(ppar->cdr))
+ {
_envt->add_binding(static_cast<SymObj*>(ppar->car), ptr->car);
+ if ((nptr = ptr->cdr)->is_cons_obj())
+ ptr = TO_CONS(nptr);
+ else break;
+ }
- if (ptr != empty_list || ppar != empty_list)
+ if (ptr->cdr != empty_list || ppar->cdr != empty_list)
throw TokenError("", RUN_ERR_WRONG_NUM_OF_ARGS);
genvt = _envt;
@@ -166,7 +172,7 @@ string ProcObj::ext_repr() { return string("#<Procedure>"); }
string ProcObj::_debug_repr() { return ext_repr(); }
#endif
-SpecialOptObj::SpecialOptObj() : OptObj() {}
+SpecialOptObj::SpecialOptObj(string _name) : OptObj(), name(_name) {}
BoolObj::BoolObj(bool _val) : EvalObj(CLS_SIM_OBJ | CLS_BOOL_OBJ), val(_val) {}
diff --git a/model.h b/model.h
index 8a8fc61..5a4800c 100644
--- a/model.h
+++ b/model.h
@@ -246,8 +246,10 @@ class ProcObj: public OptObj {
* Special builtin syntax (`if`, `define`, `lambda`, etc.)
*/
class SpecialOptObj: public OptObj {
+ protected:
+ string name;
public:
- SpecialOptObj();
+ SpecialOptObj(string name);
};
typedef EvalObj* (*BuiltinProc)(ArgList *, const string &);
diff --git a/parser.cpp b/parser.cpp
index 56b3dd9..f667933 100644
--- a/parser.cpp
+++ b/parser.cpp
@@ -175,9 +175,11 @@ Cons *ASTGenerator::absorb(Tokenizor *tk) {
EvalObj *obj = TO_EVAL(*top_ptr);
if (obj->is_sym_obj() && static_cast<SymObj*>(obj)->val == ".")
{
- improper = true;
- if (lst == empty_list || TO_CONS(lst)->cdr != empty_list)
+ if (improper ||
+ lst == empty_list ||
+ TO_CONS(lst)->cdr != empty_list)
throw NormalError(PAR_ERR_IMPROPER_PAIR);
+ improper = true;
lst = TO_CONS(lst)->car;
}
else