aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--builtin.cpp154
-rw-r--r--main.cpp2
-rw-r--r--robust_test.scm136
3 files changed, 214 insertions, 78 deletions
diff --git a/builtin.cpp b/builtin.cpp
index e5eb988..394f417 100644
--- a/builtin.cpp
+++ b/builtin.cpp
@@ -22,7 +22,7 @@ static const int NUM_LVL_INT = 3;
throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS) \
#define ARGS_EXACTLY_ONE \
- if (args == empty_list || !args->cdr->is_cons_obj() ) \
+ if (args == empty_list || args->cdr != empty_list ) \
throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS)
#define ARGS_AT_LEAST_ONE \
@@ -30,6 +30,7 @@ static const int NUM_LVL_INT = 3;
throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS)
bool is_list(Cons *ptr) {
+ if (ptr == empty_list) return true;
EvalObj *nptr;
for (;;)
if ((nptr = ptr->cdr)->is_cons_obj())
@@ -530,7 +531,7 @@ do \
for (ptr = TO_CONS(p);;) \
{ \
if (!ptr->car->is_sym_obj()) \
- throw TokenError(ptr->car->ext_repr(), RUN_ERR_WRONG_NUM_OF_ARGS); \
+ throw TokenError(ptr->car->ext_repr(), RUN_ERR_WRONG_TYPE); \
if ((nptr = ptr->cdr)->is_cons_obj()) \
ptr = TO_CONS(nptr); \
else break; \
@@ -707,7 +708,7 @@ BUILTIN_PROC_DEF(make_pair) {
BUILTIN_PROC_DEF(pair_car) {
ARGS_EXACTLY_ONE;
if (!args->car->is_cons_obj())
- throw TokenError(name, RUN_ERR_WRONG_TYPE);
+ throw TokenError("pair", RUN_ERR_WRONG_TYPE);
return TO_CONS(args->car)->car;
}
@@ -715,7 +716,7 @@ BUILTIN_PROC_DEF(pair_car) {
BUILTIN_PROC_DEF(pair_cdr) {
ARGS_EXACTLY_ONE;
if (!args->car->is_cons_obj())
- throw TokenError(name, RUN_ERR_WRONG_TYPE);
+ throw TokenError("pair", RUN_ERR_WRONG_TYPE);
return TO_CONS(args->car)->cdr;
}
@@ -730,12 +731,11 @@ BUILTIN_PROC_DEF(num_add) {
ARGS_AT_LEAST_ONE;
NumObj *res = new IntNumObj(0), *opr; // the most accurate type
EvalObj *nptr;
- Cons *ptr;
- for (ptr = args;;)
+ for (;;)
{
- if (!ptr->car->is_num_obj()) // not a number
+ if (!args->car->is_num_obj()) // not a number
throw TokenError("a number", RUN_ERR_WRONG_TYPE);
- opr = static_cast<NumObj*>(ptr->car);
+ opr = static_cast<NumObj*>(args->car);
NumObj *_res = res;
if (_res->level < opr->level)
opr = _res->convert(opr);
@@ -743,11 +743,11 @@ BUILTIN_PROC_DEF(num_add) {
_res = opr->convert(_res);
res = _res->plus(opr);
- if ((nptr = ptr->cdr)->is_cons_obj())
- ptr = TO_CONS(nptr);
+ if ((nptr = args->cdr)->is_cons_obj())
+ args = TO_CONS(nptr);
else break;
}
- if (ptr->cdr != empty_list)
+ if (args->cdr != empty_list)
throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
return res;
}
@@ -758,13 +758,16 @@ BUILTIN_PROC_DEF(num_sub) {
throw TokenError("a number", RUN_ERR_WRONG_TYPE);
NumObj *res = static_cast<NumObj*>(args->car), *opr;
- EvalObj *nptr;
- Cons *ptr;
- for (ptr = TO_CONS(args->cdr);;)
+ EvalObj *nptr;
+ for (;;)
{
- if (!ptr->car->is_num_obj()) // not a number
+ if ((nptr = args->cdr)->is_cons_obj())
+ args = TO_CONS(nptr);
+ else break;
+
+ if (!args->car->is_num_obj()) // not a number
throw TokenError("a number", RUN_ERR_WRONG_TYPE);
- opr = static_cast<NumObj*>(ptr->car);
+ opr = static_cast<NumObj*>(args->car);
// upper type conversion
NumObj *_res = res;
if (_res->level < opr->level)
@@ -772,12 +775,8 @@ BUILTIN_PROC_DEF(num_sub) {
else
_res = opr->convert(_res);
res = _res->minus(opr);
-
- if ((nptr = ptr->cdr)->is_cons_obj())
- ptr = TO_CONS(nptr);
- else break;
}
- if (ptr->cdr != empty_list)
+ if (args->cdr != empty_list)
throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
return res;
}
@@ -786,12 +785,11 @@ BUILTIN_PROC_DEF(num_multi) {
ARGS_AT_LEAST_ONE;
NumObj *res = new IntNumObj(1), *opr; // the most accurate type
EvalObj *nptr;
- Cons *ptr;
- for (ptr = args;;)
+ for (;;)
{
- if (!ptr->car->is_num_obj()) // not a number
+ if (!args->car->is_num_obj()) // not a number
throw TokenError("a number", RUN_ERR_WRONG_TYPE);
- opr = static_cast<NumObj*>(ptr->car);
+ opr = static_cast<NumObj*>(args->car);
NumObj *_res = res;
if (_res->level < opr->level)
opr = _res->convert(opr);
@@ -799,11 +797,11 @@ BUILTIN_PROC_DEF(num_multi) {
_res = opr->convert(_res);
res = _res->multi(opr);
- if ((nptr = ptr->cdr)->is_cons_obj())
- ptr = TO_CONS(nptr);
+ if ((nptr = args->cdr)->is_cons_obj())
+ args = TO_CONS(nptr);
else break;
}
- if (ptr->cdr != empty_list)
+ if (args->cdr != empty_list)
throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
return res;
}
@@ -814,13 +812,16 @@ BUILTIN_PROC_DEF(num_div) {
throw TokenError("a number", RUN_ERR_WRONG_TYPE);
NumObj *res = static_cast<NumObj*>(args->car), *opr;
- EvalObj *nptr;
- Cons *ptr;
- for (ptr = TO_CONS(args->cdr);;)
+ EvalObj *nptr;
+ for (;;)
{
- if (!ptr->car->is_num_obj()) // not a number
+ if ((nptr = args->cdr)->is_cons_obj())
+ args = TO_CONS(nptr);
+ else break;
+
+ if (!args->car->is_num_obj()) // not a number
throw TokenError("a number", RUN_ERR_WRONG_TYPE);
- opr = static_cast<NumObj*>(ptr->car);
+ opr = static_cast<NumObj*>(args->car);
// upper type conversion
NumObj *_res = res;
if (_res->level < opr->level)
@@ -828,30 +829,30 @@ BUILTIN_PROC_DEF(num_div) {
else
_res = opr->convert(_res);
res = _res->div(opr);
-
- if ((nptr = ptr->cdr)->is_cons_obj())
- ptr = TO_CONS(nptr);
- else break;
}
- if (ptr->cdr != empty_list)
+ if (args->cdr != empty_list)
throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
return res;
}
BUILTIN_PROC_DEF(num_lt) {
- ARGS_AT_LEAST_ONE;
+ if (args == empty_list)
+ return new BoolObj(true);
+ // zero arguments
if (!args->car->is_num_obj())
throw TokenError("a number", RUN_ERR_WRONG_TYPE);
NumObj *last = static_cast<NumObj*>(args->car), *opr;
EvalObj *nptr;
- Cons *ptr;
- for (ptr = TO_CONS(args->cdr);; last = opr)
+ for (;; last = opr)
{
- if (!ptr->car->is_num_obj()) // not a number
+ if ((nptr = args->cdr)->is_cons_obj())
+ args = TO_CONS(nptr);
+ else break;
+ if (!args->car->is_num_obj()) // not a number
throw TokenError("a number", RUN_ERR_WRONG_TYPE);
- opr = static_cast<NumObj*>(ptr->car);
+ opr = static_cast<NumObj*>(args->car);
// upper type conversion
if (last->level < opr->level)
opr = last->convert(opr);
@@ -859,30 +860,30 @@ BUILTIN_PROC_DEF(num_lt) {
last = opr->convert(last);
if (!last->lt(opr))
return new BoolObj(false);
-
- if ((nptr = ptr->cdr)->is_cons_obj())
- ptr = TO_CONS(nptr);
- else break;
}
- if (ptr->cdr != empty_list)
+ if (args->cdr != empty_list)
throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
return new BoolObj(true);
}
BUILTIN_PROC_DEF(num_gt) {
- ARGS_AT_LEAST_ONE;
+ if (args == empty_list)
+ return new BoolObj(true);
+ // zero arguments
if (!args->car->is_num_obj())
throw TokenError("a number", RUN_ERR_WRONG_TYPE);
NumObj *last = static_cast<NumObj*>(args->car), *opr;
EvalObj *nptr;
- Cons *ptr;
- for (ptr = TO_CONS(args->cdr);; last = opr)
+ for (;; last = opr)
{
- if (!ptr->car->is_num_obj()) // not a number
+ if ((nptr = args->cdr)->is_cons_obj())
+ args = TO_CONS(nptr);
+ else break;
+ if (!args->car->is_num_obj()) // not a number
throw TokenError("a number", RUN_ERR_WRONG_TYPE);
- opr = static_cast<NumObj*>(ptr->car);
+ opr = static_cast<NumObj*>(args->car);
// upper type conversion
if (last->level < opr->level)
opr = last->convert(opr);
@@ -890,30 +891,30 @@ BUILTIN_PROC_DEF(num_gt) {
last = opr->convert(last);
if (!last->gt(opr))
return new BoolObj(false);
-
- if ((nptr = ptr->cdr)->is_cons_obj())
- ptr = TO_CONS(nptr);
- else break;
}
- if (ptr->cdr != empty_list)
+ if (args->cdr != empty_list)
throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
return new BoolObj(true);
}
BUILTIN_PROC_DEF(num_eq) {
- ARGS_AT_LEAST_ONE;
+ if (args == empty_list)
+ return new BoolObj(true);
+ // zero arguments
if (!args->car->is_num_obj())
throw TokenError("a number", RUN_ERR_WRONG_TYPE);
NumObj *last = static_cast<NumObj*>(args->car), *opr;
EvalObj *nptr;
- Cons *ptr;
- for (ptr = TO_CONS(args->cdr);; last = opr)
+ for (;; last = opr)
{
- if (!ptr->car->is_num_obj()) // not a number
+ if ((nptr = args->cdr)->is_cons_obj())
+ args = TO_CONS(nptr);
+ else break;
+ if (!args->car->is_num_obj()) // not a number
throw TokenError("a number", RUN_ERR_WRONG_TYPE);
- opr = static_cast<NumObj*>(ptr->car);
+ opr = static_cast<NumObj*>(args->car);
// upper type conversion
if (last->level < opr->level)
opr = last->convert(opr);
@@ -921,12 +922,8 @@ BUILTIN_PROC_DEF(num_eq) {
last = opr->convert(last);
if (!last->eq(opr))
return new BoolObj(false);
-
- if ((nptr = ptr->cdr)->is_cons_obj())
- ptr = TO_CONS(nptr);
- else break;
}
- if (ptr->cdr != empty_list)
+ if (args->cdr != empty_list)
throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
return new BoolObj(true);
}
@@ -949,7 +946,7 @@ BUILTIN_PROC_DEF(is_pair) {
BUILTIN_PROC_DEF(pair_set_car) {
ARGS_EXACTLY_TWO;
if (!args->car->is_cons_obj())
- throw TokenError(name, RUN_ERR_WRONG_TYPE);
+ throw TokenError("pair", RUN_ERR_WRONG_TYPE);
TO_CONS(args->car)->car = TO_CONS(args->cdr)->car;
return new UnspecObj();
}
@@ -957,7 +954,7 @@ BUILTIN_PROC_DEF(pair_set_car) {
BUILTIN_PROC_DEF(pair_set_cdr) {
ARGS_EXACTLY_TWO;
if (!args->car->is_cons_obj())
- throw TokenError(name, RUN_ERR_WRONG_TYPE);
+ throw TokenError("pair", RUN_ERR_WRONG_TYPE);
TO_CONS(args->car)->cdr = TO_CONS(args->cdr)->car;
return new UnspecObj();
}
@@ -969,17 +966,19 @@ BUILTIN_PROC_DEF(is_null) {
BUILTIN_PROC_DEF(is_list) {
ARGS_EXACTLY_ONE;
+ if (args->car == empty_list)
+ return new BoolObj(true);
if (!args->car->is_cons_obj())
return new BoolObj(false);
- for (Cons *ptr = TO_CONS(args->car); ptr != empty_list;)
+ args = TO_CONS(args->car);
+ EvalObj *nptr;
+ for (;;)
{
- EvalObj *cdr = ptr->cdr;
- if (!cdr->is_cons_obj())
- return new BoolObj(false);
- else
- ptr = TO_CONS(cdr);
+ if ((nptr = args->cdr)->is_cons_obj())
+ args = TO_CONS(nptr);
+ else break;
}
- return new BoolObj(true);
+ return new BoolObj(args->cdr == empty_list);
}
BUILTIN_PROC_DEF(num_exact) {
@@ -998,6 +997,7 @@ BUILTIN_PROC_DEF(num_inexact) {
BUILTIN_PROC_DEF(display) {
+ ARGS_EXACTLY_ONE;
printf("%s\n", args->car->ext_repr().c_str());
return new UnspecObj();
}
diff --git a/main.cpp b/main.cpp
index 68f6c33..2e4d294 100644
--- a/main.cpp
+++ b/main.cpp
@@ -17,7 +17,7 @@ void tree_print(Cons *ptr) {
#endif
int main() {
- //freopen("in", "r", stdin);
+// freopen("in.scm", "r", stdin);
Tokenizor *tk = new Tokenizor();
ASTGenerator *ast = new ASTGenerator();
Evaluator *eval = new Evaluator();
diff --git a/robust_test.scm b/robust_test.scm
new file mode 100644
index 0000000..08976a0
--- /dev/null
+++ b/robust_test.scm
@@ -0,0 +1,136 @@
+(+)
+(-)
+(*)
+(/)
+(+ 0)
+(- 0)
+(* 0)
+(/ 0)
+(<)
+(>)
+(=)
+(< 1)
+(> 1)
+(= 1)
+(+ 0 . 0)
+(+ . 0)
+(- 0 . 0)
+(- . 0)
+(< 0 . 0)
+(< . 0)
+
+(+ 0 'a)
+(- 0 'a)
+(* 0 'a)
+(/ 0 'a)
+(< #f)
+(> #f)
+(= #f)
+
+(exact?)
+(exact? 'a)
+(exact? 1 2)
+(exact? . 0)
+(exact? 0 . 0)
+
+(inexact?)
+(inexact? 'b)
+(inexact? 1 2)
+(inexact? . 0)
+(inexact? 0 . 0)
+
+(not)
+(not 1 2)
+(not 1)
+(not #f)
+(not '())
+(not . 0)
+(not 0 . 0)
+
+(boolean?)
+(boolean? 1 2)
+(boolean? 1)
+(boolean? #t)
+(boolean? . 0)
+(boolean? 0 . 0)
+
+(pair?)
+(pair? 1 2)
+(pair? '())
+(pair? (cons 1 2))
+(pair? '(3 . 4))
+(pair? 3)
+(pair? . 0)
+(pair? 0 . 0)
+
+(cons)
+(cons 1)
+(cons 1 2 3)
+(cons 'a '())
+(cons . 0)
+(cons 0 . 0)
+
+
+(define t (cons 'a '()))
+
+(car)
+(car 1)
+(car 1 2)
+(car '())
+(car t)
+(car . 0)
+(car 0 . 0)
+
+(cdr)
+(cdr 1)
+(cdr 1 2)
+(cdr '())
+(cdr t)
+(cdr . 0)
+(cdr 0 . 0)
+
+(set-car!)
+(set-car! 1)
+(set-car! 1 2)
+(set-car! t '())
+t
+(set-car! . 0)
+(set-car! 0 . 0)
+
+(set-cdr!)
+(set-cdr! 1)
+(set-cdr! 1 2)
+(set-cdr! t 'a)
+t
+(set-cdr! . 0)
+(set-cdr! 0 . 0)
+
+(null?)
+(null? 1 2)
+(null? 1)
+(null? '())
+(null? #f)
+(null? . 0)
+(null? 0 . 0)
+
+(list?)
+(list? 1 2)
+(list? '())
+(list? t)
+(set-cdr! t '())
+t
+(list? t)
+(list? . 0)
+(list? 0 . 0)
+
+(list)
+(list 1)
+(list 1 2)
+(list . 0)
+(list 0 . 0)
+
+(display)
+(display 1 2)
+(display . 0)
+(display 0 . 0)
+(display t)