aboutsummaryrefslogtreecommitdiff
path: root/builtin.cpp
diff options
context:
space:
mode:
Diffstat (limited to 'builtin.cpp')
-rw-r--r--builtin.cpp154
1 files changed, 77 insertions, 77 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();
}
Powered by cgit, Themed by Ted Yin.