aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Makefile2
-rw-r--r--TODO.rst2
-rw-r--r--builtin.cpp101
-rw-r--r--builtin.h2
-rw-r--r--eval.cpp5
-rw-r--r--eval.h1
-rw-r--r--main.cpp2
-rw-r--r--model.cpp2
-rw-r--r--model.h11
-rw-r--r--parser.h2
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<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());
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 <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);
}
}
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 <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();
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<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();
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