From 64967702d0f58b1f2f2082feccb39a95e2ac4cb2 Mon Sep 17 00:00:00 2001 From: Teddy Date: Thu, 8 Aug 2013 22:36:49 +0800 Subject: support for equal? --- Makefile | 2 +- TODO.rst | 2 +- builtin.cpp | 101 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ builtin.h | 2 ++ eval.cpp | 5 ++- eval.h | 1 + main.cpp | 2 +- model.cpp | 2 +- model.h | 11 ++++--- parser.h | 2 +- 10 files changed, 117 insertions(+), 13 deletions(-) diff --git a/Makefile b/Makefile index 07feba0..790d71e 100644 --- a/Makefile +++ b/Makefile @@ -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 diff --git a/TODO.rst b/TODO.rst index 6ac8d4e..1a5df0e 100644 --- a/TODO.rst +++ b/TODO.rst @@ -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(a); + VecObj *vb = static_cast(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(a)->val != + static_cast(b)->val) + return new BoolObj(false); + } + else if (otype & CLS_SYM_OBJ) + { + if (static_cast(a)->val != + static_cast(b)->val) + return new BoolObj(false); + } + else if (otype & CLS_NUM_OBJ) + { + NumObj *num1 = static_cast(a); + NumObj *num2 = static_cast(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(a)->ch != + static_cast(b)->ch) + return new BoolObj(false); // (char=?) + } + else if (otype & CLS_STR_OBJ) + { + if (static_cast(a)->str != + static_cast(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()); diff --git a/builtin.h b/builtin.h index 2633ed8..3f6fa29 100644 --- a/builtin.h +++ b/builtin.h @@ -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); diff --git a/eval.cpp b/eval.cpp index 98d3d5a..2d03c0c 100644 --- a/eval.cpp +++ b/eval.cpp @@ -5,7 +5,6 @@ #include 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(*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(pc->car); // Go deeper to enter the call + envt->get_obj(pc->car)->prepare(pc); } } diff --git a/eval.h b/eval.h index 1c8d14f..bf4b801 100644 --- a/eval.h +++ b/eval.h @@ -2,6 +2,7 @@ #define EVAL_H #include "model.h" +const int EVAL_STACK_SIZE = 262144; /** @class Evaluator * A runtime platform of interpreting */ diff --git a/main.cpp b/main.cpp index db635e8..ba47a6a 100644 --- a/main.cpp +++ b/main.cpp @@ -6,7 +6,7 @@ #include int main() { - freopen("in.scm", "r", stdin); +// freopen("in.scm", "r", stdin); Tokenizor *tk = new Tokenizor(); ASTGenerator *ast = new ASTGenerator(); Evaluator *eval = new Evaluator(); diff --git a/model.cpp b/model.cpp index 4502577..3573339 100644 --- a/model.cpp +++ b/model.cpp @@ -50,7 +50,7 @@ bool EvalObj::is_bool_obj() { return otype & CLS_BOOL_OBJ; } -ClassType EvalObj::get_otype() { +int EvalObj::get_otype() { return otype; } diff --git a/model.h b/model.h index 062a61d..be4da2b 100644 --- a/model.h +++ b/model.h @@ -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(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 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(); diff --git a/parser.h b/parser.h index e44abbc..823c90e 100644 --- a/parser.h +++ b/parser.h @@ -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 -- cgit v1.2.3-70-g09d2