diff options
| -rw-r--r-- | Makefile | 2 | ||||
| -rw-r--r-- | TODO.rst | 2 | ||||
| -rw-r--r-- | builtin.cpp | 101 | ||||
| -rw-r--r-- | builtin.h | 2 | ||||
| -rw-r--r-- | eval.cpp | 5 | ||||
| -rw-r--r-- | eval.h | 1 | ||||
| -rw-r--r-- | main.cpp | 2 | ||||
| -rw-r--r-- | model.cpp | 2 | ||||
| -rw-r--r-- | model.h | 11 | ||||
| -rw-r--r-- | parser.h | 2 |
10 files changed, 117 insertions, 13 deletions
@@ -2,7 +2,7 @@ main: main.o parser.o builtin.o model.o eval.o exc.o consts.o g++ -o main $^ -pg -lgmp .cpp.o: - g++ $< -c -g -pg -DGMP_SUPPORT + g++ $< -c -O2 -g -pg -DGMP_SUPPORT clean: rm -f *.o @@ -1,4 +1,4 @@ -- non-recursive ext_repr implementation - non-recursive equal? predicate +- ext_repr optimization - Garbage Collection? - Add macro support diff --git a/builtin.cpp b/builtin.cpp index adf069d..72efb37 100644 --- a/builtin.cpp +++ b/builtin.cpp @@ -1256,6 +1256,107 @@ BUILTIN_PROC_DEF(is_eqv) { return new BoolObj(obj1 == obj2); } + +BUILTIN_PROC_DEF(is_equal) { + +#define INC1(x) (++(x) == t1 ? (x) = q1:0) +#define INC2(x) (++(x) == t2 ? (x) = q2: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; + EvalObj **l2 = q2, **r2 = l2; + + *r1++ = args->car; + *r2++ = TO_PAIR(args->cdr)->car; + + EvalObj *a, *b; + for (; l1 != r1; INC1(l1), INC2(l2)) + { + // Different types + int otype = (a = *l1)->get_otype(); + if (otype != (b = *l2)->get_otype()) + return new BoolObj(false); + if (a == empty_list) + continue; + if (otype & CLS_CONS_OBJ) + { + *r1 = TO_PAIR(a)->car; + INC1(r1); + *r1 = TO_PAIR(a)->cdr; + INC1(r1); + + *r2 = TO_PAIR(b)->car; + INC2(r2); + *r2 = TO_PAIR(b)->cdr; + INC2(r2); + } + else if (otype & CLS_VECT_OBJ) + { + VecObj *va = static_cast<VecObj*>(a); + VecObj *vb = static_cast<VecObj*>(b); + if (va->get_size() != vb->get_size()) + return new BoolObj(false); + for (EvalObjVec::iterator + it = va->vec.begin(); + it != va->vec.end(); it++) + { + *r1 = TO_PAIR(a)->car; + INC1(r1); + } + + for (EvalObjVec::iterator + it = vb->vec.begin(); + it != vb->vec.end(); it++) + { + *r2 = TO_PAIR(b)->car; + INC2(r2); + } + } + else if (otype & CLS_BOOL_OBJ) + { + if (static_cast<BoolObj*>(a)->val != + static_cast<BoolObj*>(b)->val) + return new BoolObj(false); + } + else if (otype & CLS_SYM_OBJ) + { + if (static_cast<SymObj*>(a)->val != + static_cast<SymObj*>(b)->val) + return new BoolObj(false); + } + else if (otype & CLS_NUM_OBJ) + { + NumObj *num1 = static_cast<NumObj*>(a); + NumObj *num2 = static_cast<NumObj*>(b); + if (num1->is_exact() != num2->is_exact()) + return new BoolObj(false); + if (num1->level < num2->level) + if (!num1->eq(num1->convert(num2))) + return new BoolObj(false); + else + if (!num2->eq(num2->convert(num1))) + return new BoolObj(false); + } + else if (otype & CLS_CHAR_OBJ) + { + if (static_cast<CharObj*>(a)->ch != + static_cast<CharObj*>(b)->ch) + return new BoolObj(false); // (char=?) + } + else if (otype & CLS_STR_OBJ) + { + if (static_cast<StrObj*>(a)->str != + static_cast<StrObj*>(b)->str) + return new BoolObj(false); // (string=?) + } + } + return new BoolObj(true); +} + BUILTIN_PROC_DEF(display) { ARGS_EXACTLY_ONE; printf("%s\n", args->car->ext_repr().c_str()); @@ -7,6 +7,7 @@ using std::string; +const int EQUAL_QUEUE_SIZE = 262144; bool is_list(Pair *ptr); /** @class InexactNumObj @@ -266,6 +267,7 @@ BUILTIN_PROC_DEF(reverse); BUILTIN_PROC_DEF(list_tail); BUILTIN_PROC_DEF(is_eqv); +BUILTIN_PROC_DEF(is_equal); BUILTIN_PROC_DEF(display); @@ -5,7 +5,6 @@ #include <cstdio> extern Pair *empty_list; -const int EVAL_STACK_SIZE = 65536; FrameObj *eval_stack[EVAL_STACK_SIZE]; void Evaluator::add_builtin_routines() { @@ -54,6 +53,7 @@ void Evaluator::add_builtin_routines() { ADD_BUILTIN_PROC("eqv?", is_eqv); ADD_BUILTIN_PROC("eq?", is_eqv); + ADD_BUILTIN_PROC("equal?", is_equal); ADD_BUILTIN_PROC("display", display); } @@ -67,8 +67,6 @@ void push(Pair * &pc, FrameObj ** &top_ptr, Environment *envt) { if (pc->car->is_simple_obj()) // Not an opt invocation { *top_ptr = envt->get_obj(pc->car); // Objectify the symbol - // static_cast because of is_simple_obj() is true - static_cast<EvalObj*>(*top_ptr)->prepare(pc); top_ptr++; pc = pc->next; // Move to the next instruction } @@ -82,6 +80,7 @@ void push(Pair * &pc, FrameObj ** &top_ptr, Environment *envt) { throw TokenError(pc->car->ext_repr(), RUN_ERR_WRONG_NUM_OF_ARGS); // static_cast because of is_simple_obj() is false pc = static_cast<Pair*>(pc->car); // Go deeper to enter the call + envt->get_obj(pc->car)->prepare(pc); } } @@ -2,6 +2,7 @@ #define EVAL_H #include "model.h" +const int EVAL_STACK_SIZE = 262144; /** @class Evaluator * A runtime platform of interpreting */ @@ -6,7 +6,7 @@ #include <cstdio> int main() { - freopen("in.scm", "r", stdin); +// freopen("in.scm", "r", stdin); Tokenizor *tk = new Tokenizor(); ASTGenerator *ast = new ASTGenerator(); Evaluator *eval = new Evaluator(); @@ -50,7 +50,7 @@ bool EvalObj::is_bool_obj() { return otype & CLS_BOOL_OBJ; } -ClassType EvalObj::get_otype() { +int EvalObj::get_otype() { return otype; } @@ -23,15 +23,17 @@ const int CLS_REPR_STR = 1 << 4; const int CLS_SIM_OBJ = 1 << 0; const int CLS_CONS_OBJ = 1 << 1; -const int CLS_SYM_OBJ = 1 << 2; + const int CLS_OPT_OBJ = 1 << 3; + +const int CLS_SYM_OBJ = 1 << 2; const int CLS_NUM_OBJ = 1 << 4; const int CLS_BOOL_OBJ = 1 << 5; const int CLS_CHAR_OBJ = 1 << 6; const int CLS_STR_OBJ = 1 << 7; const int CLS_VECT_OBJ = 1 << 8; -const int REPR_STACK_SIZE = 65536; +const int REPR_STACK_SIZE = 262144; #define TO_PAIR(ptr) \ (static_cast<Pair*>(ptr)) @@ -102,7 +104,7 @@ class EvalObj : public FrameObj { bool is_num_obj(); /** Check if the object is a boolean */ bool is_bool_obj(); - ClassType get_otype(); + int get_otype(); virtual void prepare(Pair *pc); /** Any EvalObj has its external representation */ string ext_repr(); @@ -366,9 +368,8 @@ typedef vector<EvalObj*> EvalObjVec; * Vector support (currently a wrapper of STL vector) */ class VecObj: public EvalObj { - private: - EvalObjVec vec; public: + EvalObjVec vec; /** Construct a vector object */ VecObj(); int get_size(); @@ -7,7 +7,7 @@ using std::string; const int TOKEN_BUFF_SIZE = 65536; -const int PARSE_STACK_SIZE = 65536; +const int PARSE_STACK_SIZE = 262144; /** @class Tokenizor * Break down the input string stream into tokens |