aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--builtin.cpp104
-rw-r--r--builtin.h17
2 files changed, 50 insertions, 71 deletions
diff --git a/builtin.cpp b/builtin.cpp
index 7f6fe26..0481024 100644
--- a/builtin.cpp
+++ b/builtin.cpp
@@ -1,39 +1,36 @@
-#include <cstdio>
-#include <cctype>
-#include <cstdlib>
-
#include "consts.h"
#include "builtin.h"
-#include "model.h"
#include "exc.h"
-#include "types.h"
#include "gc.h"
+#include <cstdio>
+#include <cctype>
+#include <cstdlib>
+
using std::stringstream;
extern EmptyList *empty_list;
extern UnspecObj *unspec_obj;
+#define EXC_WRONG_ARG_NUM \
+ throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS)
+
SpecialOptIf::SpecialOptIf() : SpecialOptObj("if") {}
void SpecialOptIf::prepare(Pair *pc) {
-#define IF_EXP_ERR \
- throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS)
Pair *first, *second, *third;
- if (pc->cdr == empty_list)
- IF_EXP_ERR;
+ if (pc->cdr == empty_list) EXC_WRONG_ARG_NUM;
first = TO_PAIR(pc->cdr);
- if (first->cdr == empty_list)
- IF_EXP_ERR;
+ if (first->cdr == empty_list) EXC_WRONG_ARG_NUM;
second = TO_PAIR(first->cdr);
if (second->cdr != empty_list)
{
third = TO_PAIR(second->cdr);
- if (third->cdr != empty_list) IF_EXP_ERR;
+ if (third->cdr != empty_list) EXC_WRONG_ARG_NUM;
}
pc->next = NULL;
}
@@ -197,17 +194,14 @@ SpecialOptDefine::SpecialOptDefine() : SpecialOptObj("define") {}
void SpecialOptDefine::prepare(Pair *pc) {
Pair *first, *second;
- if (pc->cdr == empty_list)
- throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
+ if (pc->cdr == empty_list) EXC_WRONG_ARG_NUM;
first = TO_PAIR(pc->cdr);
if (first->car->is_simple_obj()) // Simple value assignment
{
- if (first->cdr == empty_list)
- throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
+ if (first->cdr == empty_list) EXC_WRONG_ARG_NUM;
second = TO_PAIR(first->cdr);
- if (second->cdr != empty_list)
- throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
+ if (second->cdr != empty_list) EXC_WRONG_ARG_NUM;
} // Procedure definition
pc->next = NULL;
}
@@ -272,16 +266,13 @@ SpecialOptSet::SpecialOptSet() : SpecialOptObj("set!") {}
void SpecialOptSet::prepare(Pair *pc) {
Pair *first, *second;
- if (pc->cdr == empty_list)
- throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
+ if (pc->cdr == empty_list) EXC_WRONG_ARG_NUM;
first = TO_PAIR(pc->cdr);
- if (first->cdr == empty_list)
- throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
+ if (first->cdr == empty_list) EXC_WRONG_ARG_NUM;
second = TO_PAIR(first->cdr);
- if (second->cdr != empty_list)
- throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
+ if (second->cdr != empty_list) EXC_WRONG_ARG_NUM;
pc->next = NULL;
}
@@ -335,7 +326,7 @@ SpecialOptEval::SpecialOptEval() : SpecialOptObj("eval") {}
void SpecialOptEval::prepare(Pair *pc) {
if (pc->cdr == empty_list ||
TO_PAIR(pc->cdr)->cdr != empty_list)
- throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
+ EXC_WRONG_ARG_NUM;
}
Pair *SpecialOptEval::call(Pair *args, Environment * &lenvt,
@@ -524,8 +515,7 @@ Pair *SpecialOptApply::call(Pair *_args, Environment * &lenvt,
Continuation * &cont, EvalObj ** &top_ptr, Pair *pc) {
Pair *args = _args;
top_ptr++; // Recover the return address
- if (args->cdr == empty_list)
- throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
+ if (args->cdr == empty_list) EXC_WRONG_ARG_NUM;
args = TO_PAIR(args->cdr);
if (!args->car->is_opt_obj())
@@ -533,8 +523,7 @@ Pair *SpecialOptApply::call(Pair *_args, Environment * &lenvt,
*top_ptr++ = gc.attach(args->car); // Push the operator into the stack
args = TO_PAIR(args->cdr); // Examine arguments
- if (args == empty_list)
- throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
+ if (args == empty_list) EXC_WRONG_ARG_NUM;
for (; args->cdr != empty_list; args = TO_PAIR(args->cdr))
*top_ptr++ = gc.attach(args->car); // Add leading arguments: arg_1 ...
@@ -566,7 +555,7 @@ SpecialOptForce::SpecialOptForce() : SpecialOptObj("force") {}
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);
+ EXC_WRONG_ARG_NUM;
}
Pair *SpecialOptForce::call(Pair *_args, Environment * &lenvt,
@@ -614,7 +603,7 @@ SpecialOptDelay::SpecialOptDelay() : SpecialOptObj("delay") {}
void SpecialOptDelay::prepare(Pair *pc) {
if (pc->cdr == empty_list ||
TO_PAIR(pc->cdr)->cdr != empty_list)
- throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
+ EXC_WRONG_ARG_NUM;
pc->next = NULL;
}
@@ -627,26 +616,23 @@ Pair *SpecialOptDelay::call(Pair *args, Environment * &lenvt,
return ret_addr->next; // Move to the next instruction
}
-/*************************************************************************/
-
/* The following lines are the implementation of various simple built-in
* procedures. Some library procdures are implemented here for the sake of
* efficiency. */
#define ARGS_EXACTLY_TWO \
if (args == empty_list || \
- args->cdr == empty_list || \
- TO_PAIR(args->cdr)->cdr != empty_list) \
- throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS)
+ args->cdr == empty_list || \
+ TO_PAIR(args->cdr)->cdr != empty_list) \
+ EXC_WRONG_ARG_NUM
#define ARGS_EXACTLY_ONE \
if (args == empty_list || \
- args->cdr != empty_list ) \
- throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS)
+ args->cdr != empty_list ) \
+ EXC_WRONG_ARG_NUM
#define ARGS_AT_LEAST_ONE \
- if (args == empty_list) \
- throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS)
+ if (args == empty_list) EXC_WRONG_ARG_NUM
BUILTIN_PROC_DEF(make_pair) {
ARGS_EXACTLY_TWO;
@@ -1526,22 +1512,22 @@ BUILTIN_PROC_DEF(make_vector) {
else if (args->cdr == empty_list)
fill = args->car;
else
- throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
+ EXC_WRONG_ARG_NUM;
VecObj *res = new VecObj(size_t(len), fill);
return res;
}
BUILTIN_PROC_DEF(vector_set) {
- if (args == empty_list)
- throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
+ if (args == empty_list) EXC_WRONG_ARG_NUM;
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 == empty_list) EXC_WRONG_ARG_NUM;
+
EvalObj *second = args->car;
CHECK_NUMBER(second);
CHECK_EXACT(second);
@@ -1552,27 +1538,23 @@ BUILTIN_PROC_DEF(vector_set) {
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);
+ if (args == empty_list) EXC_WRONG_ARG_NUM;
+ if (args->cdr != empty_list) EXC_WRONG_ARG_NUM;
vect->set(k, args->car);
return unspec_obj;
}
BUILTIN_PROC_DEF(vector_ref) {
- if (args == empty_list)
- throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
+ if (args == empty_list) EXC_WRONG_ARG_NUM;
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);
+ if (args == empty_list) EXC_WRONG_ARG_NUM;
+ if (args->cdr != empty_list) EXC_WRONG_ARG_NUM;
EvalObj *second = args->car;
CHECK_NUMBER(second);
@@ -1586,19 +1568,17 @@ BUILTIN_PROC_DEF(vector_ref) {
}
BUILTIN_PROC_DEF(vector_length) {
- if (args == empty_list)
- throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
+ if (args == empty_list) EXC_WRONG_ARG_NUM;
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);
+ if (args->cdr != empty_list) EXC_WRONG_ARG_NUM;
+
VecObj *vect = static_cast<VecObj*>(args->car);
return new IntNumObj(vect->get_size());
}
BUILTIN_PROC_DEF(gc_status) {
- if (args != empty_list)
- throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
+ if (args != empty_list) EXC_WRONG_ARG_NUM;
return new IntNumObj(gc.get_remaining());
}
diff --git a/builtin.h b/builtin.h
index b9156ee..e6beb4a 100644
--- a/builtin.h
+++ b/builtin.h
@@ -3,6 +3,7 @@
#include "model.h"
#include "types.h"
+
#include <string>
using std::string;
@@ -13,8 +14,6 @@ const int EQUAL_QUEUE_SIZE = 262144;
* The implementation of `if` operator
*/
class SpecialOptIf: public SpecialOptObj {/*{{{*/
- private:
- unsigned char state; /**< 0 for prepared, 1 for pre_called */
public:
/** Construct a `if` operator */
SpecialOptIf();
@@ -89,12 +88,10 @@ class SpecialOptQuote: public SpecialOptObj {/*{{{*/
* The implementation of `eval` operator
*/
class SpecialOptEval: public SpecialOptObj {/*{{{*/
- private:
- unsigned char state; /**< 0 for prepared, 1 for pre_called */
public:
/** Construct an `eval` operator */
SpecialOptEval();
- /** Set state to 0 */
+ /** Nothing special */
void prepare(Pair *pc);
/** Behaves like the one in `SpecialOptIf` */
Pair *call(Pair *args, Environment * &envt,
@@ -139,7 +136,7 @@ class SpecialOptApply: public SpecialOptObj {/*{{{*/
public:
/** Construct an `apply` operator */
SpecialOptApply();
- /** Do nothing */
+ /** Nothing special */
void prepare(Pair *pc);
/** Provoke the <proc> with args */
Pair *call(Pair *args, Environment * &envt,
@@ -154,7 +151,7 @@ class SpecialOptDelay: public SpecialOptObj {/*{{{*/
public:
/** Construct a `delay` operator */
SpecialOptDelay();
- /** Do nothing */
+ /** Nothing special */
void prepare(Pair *pc);
/** Make up a PromObj and push into the stack */
Pair *call(Pair *args, Environment * &envt,
@@ -167,12 +164,10 @@ class SpecialOptDelay: public SpecialOptObj {/*{{{*/
*/
class SpecialOptForce: public SpecialOptObj {/*{{{*/
private:
- unsigned char state;
PromObj* prom;
public:
/** Construct a `force` operator */
SpecialOptForce();
- /** Set the state to 0 */
void prepare(Pair *pc);
/** Force the evaluation of a promise. If the promise has not been
* evaluated yet, then evaluate and feed the result to its memory,
@@ -183,6 +178,10 @@ class SpecialOptForce: public SpecialOptObj {/*{{{*/
};/*}}}*/
+/* The following lines are the implementation of various simple built-in
+ * procedures. Some library procdures are implemented here for the sake of
+ * efficiency. */
+
#define BUILTIN_PROC_DEF(func)\
EvalObj *(func)(Pair *args, const string &name)