aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Makefile2
-rw-r--r--builtin.cpp73
-rw-r--r--builtin.h16
-rw-r--r--eval.cpp1
-rw-r--r--main.cpp2
-rw-r--r--model.cpp225
-rw-r--r--model.h6
-rw-r--r--parser.cpp2
-rw-r--r--robust_test.scm6
9 files changed, 204 insertions, 129 deletions
diff --git a/Makefile b/Makefile
index 07feba0..eddc4b8 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 -g -pg -DGMP_SUPPORT -Wall -Wextra -Wconversion
clean:
rm -f *.o
diff --git a/builtin.cpp b/builtin.cpp
index 27b3ee7..a5d8b15 100644
--- a/builtin.cpp
+++ b/builtin.cpp
@@ -30,15 +30,6 @@ static const int NUM_LVL_INT = 3;
if (args == empty_list) \
throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS)
-bool is_list(Pair *ptr) {
- if (ptr == empty_list) return true;
- EvalObj *nptr;
- for (;;)
- if ((nptr = ptr->cdr)->is_pair_obj())
- ptr = TO_PAIR(nptr);
- else break;
- return ptr->cdr == empty_list;
-}
string double_to_str(double val, bool force_sign = false) {
stringstream ss;
@@ -95,7 +86,7 @@ CompNumObj::CompNumObj(double _real, double _imag) :
CompNumObj *CompNumObj::from_string(string repr) {
// spos: the position of the last sign
// ipos: the position of i
- int spos = -1, ipos = -1;
+ long long spos = -1, ipos = -1;
size_t len = repr.length();
bool sign;
for (size_t i = 0; i < len; i++)
@@ -117,7 +108,7 @@ CompNumObj::CompNumObj(double _real, double _imag) :
if (spos > 0)
{
string real_str = repr.substr(0, spos);
- if (int_ptr = IntNumObj::from_string(real_str))
+ if ((int_ptr = IntNumObj::from_string(real_str)))
#ifndef GMP_SUPPORT
real = int_ptr->val;
#else
@@ -136,7 +127,7 @@ CompNumObj::CompNumObj(double _real, double _imag) :
if (ipos > spos + 1)
{
string imag_str = repr.substr(spos + 1, ipos - spos - 1);
- if (int_ptr = IntNumObj::from_string(imag_str))
+ if ((int_ptr = IntNumObj::from_string(imag_str)))
#ifndef GMP_SUPPORT
imag = int_ptr->val;
#else
@@ -854,7 +845,6 @@ Pair *SpecialOptEval::call(ArgList *args, Environment * &envt,
TO_PAIR(args->cdr)->cdr != empty_list)
throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
Pair *ret_addr = static_cast<RetAddr*>(*top_ptr)->addr;
- Pair *pc = static_cast<Pair*>(ret_addr->car);
if (state)
{
*top_ptr++ = TO_PAIR(args->cdr)->car;
@@ -872,6 +862,54 @@ ReprCons *SpecialOptEval::get_repr_cons() {
return new ReprStr("#<Builtin Macro: eval>");
}
+SpecialOptAnd::SpecialOptAnd() : SpecialOptObj("and") {}
+
+void SpecialOptAnd::prepare(Pair *pc) {
+ CHECK_COM(pc);
+ if (pc->cdr != empty_list)
+ {
+ pc->next = TO_PAIR(pc->cdr);
+ pc->next->next = NULL;
+ }
+}
+
+Pair *SpecialOptAnd::call(ArgList *args, Environment * &envt,
+ Continuation * &cont, FrameObj ** &top_ptr) {
+ Pair *ret_addr = static_cast<RetAddr*>(*top_ptr)->addr;
+ Pair *pc = static_cast<Pair*>(ret_addr->car);
+ if (args->cdr == empty_list)
+ {
+ *top_ptr++ = new BoolObj(true);
+ return ret_addr->next;
+ }
+ EvalObj *ret = TO_PAIR(args->cdr)->car;
+ if (ret->is_true())
+ {
+ if (pc->next->cdr == empty_list) // the last member
+ {
+ *top_ptr++ = ret;
+ return ret_addr->next;
+ }
+ else
+ {
+ top_ptr += 2;
+ pc->next = TO_PAIR(pc->next->cdr);
+ pc->next->next = NULL;
+ return pc->next;
+ }
+ }
+ else
+ {
+ *top_ptr++ = ret;
+ return ret_addr->next;
+ }
+ throw NormalError(INT_ERR);
+}
+
+ReprCons *SpecialOptAnd::get_repr_cons() {
+ return new ReprStr("#<Builtin Macro: and>");
+}
+
BUILTIN_PROC_DEF(make_pair) {
ARGS_EXACTLY_TWO;
return new Pair(args->car, TO_PAIR(args->cdr)->car);
@@ -893,9 +931,8 @@ BUILTIN_PROC_DEF(pair_cdr) {
return TO_PAIR(args->car)->cdr;
}
+
BUILTIN_PROC_DEF(make_list) {
- if (!is_list(args))
- throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
return args;
}
@@ -1227,7 +1264,7 @@ BUILTIN_PROC_DEF(is_eqv) {
ARGS_EXACTLY_TWO;
EvalObj *obj1 = args->car;
EvalObj *obj2 = TO_PAIR(args->cdr)->car;
- ClassType otype = obj1->get_otype();
+ int otype = obj1->get_otype();
if (otype != obj2->get_otype()) return new BoolObj(false);
if (otype & CLS_BOOL_OBJ)
@@ -1353,11 +1390,15 @@ do { \
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)
{
diff --git a/builtin.h b/builtin.h
index 3f6fa29..d4ad86f 100644
--- a/builtin.h
+++ b/builtin.h
@@ -8,7 +8,6 @@
using std::string;
const int EQUAL_QUEUE_SIZE = 262144;
-bool is_list(Pair *ptr);
/** @class InexactNumObj
* Inexact number implementation (using doubles)
@@ -234,6 +233,21 @@ class SpecialOptEval: public SpecialOptObj {
ReprCons *get_repr_cons();
};
+/** @class SpecialOptAnd
+ * The implementation of `and` operator
+ */
+class SpecialOptAnd: public SpecialOptObj {
+ private:
+ unsigned char state; /**< 0 for prepared, 1 for pre_called */
+ public:
+ SpecialOptAnd();
+ void prepare(Pair *pc);
+ Pair *call(ArgList *args, Environment * &envt,
+ Continuation * &cont, FrameObj ** &top_ptr);
+
+ ReprCons *get_repr_cons();
+};
+
#define BUILTIN_PROC_DEF(func)\
EvalObj *(func)(ArgList *args, const string &name)
diff --git a/eval.cpp b/eval.cpp
index fddd14d..63f5f96 100644
--- a/eval.cpp
+++ b/eval.cpp
@@ -21,6 +21,7 @@ void Evaluator::add_builtin_routines() {
ADD_ENTRY("set!", new SpecialOptSet());
ADD_ENTRY("quote", new SpecialOptQuote());
ADD_ENTRY("eval", new SpecialOptEval());
+ ADD_ENTRY("and", new SpecialOptAnd());
ADD_BUILTIN_PROC("+", num_add);
ADD_BUILTIN_PROC("-", num_sub);
diff --git a/main.cpp b/main.cpp
index db635e8..8f7683f 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 f5ed609..a00a765 100644
--- a/model.cpp
+++ b/model.cpp
@@ -109,65 +109,65 @@ Pair::Pair(EvalObj *_car, EvalObj *_cdr) :
EvalObj(CLS_PAIR_OBJ), car(_car), cdr(_cdr),
next(NULL) {}
-ReprCons *Pair::get_repr_cons() {
- return new PairReprCons(this, this);
-}
+ ReprCons *Pair::get_repr_cons() {
+ return new PairReprCons(this, this);
+ }
RetAddr::RetAddr(Pair *_addr) : FrameObj(CLS_RET_ADDR), addr(_addr) {}
ParseBracket::ParseBracket(unsigned char _btype) :
FrameObj(CLS_SIM_OBJ | CLS_PAR_BRA), btype(_btype) {}
-UnspecObj::UnspecObj() : EvalObj(CLS_SIM_OBJ) {}
+ UnspecObj::UnspecObj() : EvalObj(CLS_SIM_OBJ) {}
-ReprCons *UnspecObj::get_repr_cons() {
- return new ReprStr("#<Unspecified>");
-}
+ ReprCons *UnspecObj::get_repr_cons() {
+ return new ReprStr("#<Unspecified>");
+ }
SymObj::SymObj(const string &str) :
EvalObj(CLS_SIM_OBJ | CLS_SYM_OBJ), val(str) {}
-ReprCons *SymObj::get_repr_cons() {
- return new ReprStr(val);
-}
+ ReprCons *SymObj::get_repr_cons() {
+ return new ReprStr(val);
+ }
OptObj::OptObj() : EvalObj(CLS_SIM_OBJ | CLS_OPT_OBJ) {}
ProcObj::ProcObj(Pair *_body,
- Environment *_envt,
- EvalObj *_params) :
- OptObj(), body(_body), envt(_envt), params(_params) {}
-
-Pair *ProcObj::call(ArgList *args, Environment * &genvt,
- Continuation * &cont, FrameObj ** &top_ptr) {
- // Create a new continuation
- // static_cast see `call` invocation in eval.cpp
- Pair *ret_addr = static_cast<RetAddr*>(*top_ptr)->addr;
- Continuation *_cont = new Continuation(genvt, ret_addr, cont, body);
- // Create local env and recall the closure
- Environment *_envt = new Environment(envt);
- // static_cast<SymObj*> because the params is already checked
- EvalObj *ppar, *nptr;
- for (ppar = params;
- ppar->is_pair_obj();
- ppar = TO_PAIR(ppar)->cdr)
- {
- if ((nptr = args->cdr) != empty_list)
- args = TO_PAIR(nptr);
- else break;
- _envt->add_binding(static_cast<SymObj*>(TO_PAIR(ppar)->car), args->car);
- }
+ Environment *_envt,
+ EvalObj *_params) :
+ OptObj(), body(_body), params(_params), envt(_envt) {}
+
+ Pair *ProcObj::call(ArgList *args, Environment * &genvt,
+ Continuation * &cont, FrameObj ** &top_ptr) {
+ // Create a new continuation
+ // static_cast see `call` invocation in eval.cpp
+ Pair *ret_addr = static_cast<RetAddr*>(*top_ptr)->addr;
+ Continuation *_cont = new Continuation(genvt, ret_addr, cont, body);
+ // Create local env and recall the closure
+ Environment *_envt = new Environment(envt);
+ // static_cast<SymObj*> because the params is already checked
+ EvalObj *ppar, *nptr;
+ for (ppar = params;
+ ppar->is_pair_obj();
+ ppar = TO_PAIR(ppar)->cdr)
+ {
+ if ((nptr = args->cdr) != empty_list)
+ args = TO_PAIR(nptr);
+ else break;
+ _envt->add_binding(static_cast<SymObj*>(TO_PAIR(ppar)->car), args->car);
+ }
- if (ppar->is_sym_obj())
- _envt->add_binding(static_cast<SymObj*>(ppar), args->cdr); // (... . var_n)
- else if (args->cdr != empty_list || ppar != empty_list)
- throw TokenError("", RUN_ERR_WRONG_NUM_OF_ARGS);
+ if (ppar->is_sym_obj())
+ _envt->add_binding(static_cast<SymObj*>(ppar), args->cdr); // (... . var_n)
+ else if (args->cdr != empty_list || ppar != empty_list)
+ throw TokenError("", RUN_ERR_WRONG_NUM_OF_ARGS);
- genvt = _envt;
- cont = _cont;
- *top_ptr++ = new RetAddr(NULL); // Mark the entrance of a cont
- return body; // Move pc to the proc entry point
-}
+ genvt = _envt;
+ cont = _cont;
+ *top_ptr++ = new RetAddr(NULL); // Mark the entrance of a cont
+ return body; // Move pc to the proc entry point
+ }
ReprCons *ProcObj::get_repr_cons() {
return new ReprStr("#<Procedure>");
@@ -194,20 +194,20 @@ BoolObj *BoolObj::from_string(string repr) {
}
NumObj::NumObj(NumLvl _level, bool _exactness) :
- EvalObj(CLS_SIM_OBJ | CLS_NUM_OBJ), level(_level), exactness(_exactness) {}
+ EvalObj(CLS_SIM_OBJ | CLS_NUM_OBJ), exactness(_exactness), level(_level) {}
-bool NumObj::is_exact() { return exactness; }
+ bool NumObj::is_exact() { return exactness; }
-StrObj::StrObj(string _str) : EvalObj(CLS_SIM_OBJ | CLS_STR_OBJ), str(_str) {}
+ StrObj::StrObj(string _str) : EvalObj(CLS_SIM_OBJ | CLS_STR_OBJ), str(_str) {}
-ReprCons *StrObj::get_repr_cons() {
- return new ReprStr(str);
-}
+ ReprCons *StrObj::get_repr_cons() {
+ return new ReprStr(str);
+ }
CharObj::CharObj(char _ch) : EvalObj(CLS_SIM_OBJ | CLS_CHAR_OBJ), ch(_ch) {}
CharObj *CharObj::from_string(string repr) {
- int len = repr.length();
+ size_t len = repr.length();
if (len < 2) return NULL;
if (repr[0] != '#' || repr[1] != '\\') return NULL;
if (len == 3) return new CharObj(repr[2]);
@@ -231,7 +231,7 @@ EvalObj *VecObj::get_obj(int idx) {
return vec[idx];
}
-int VecObj::get_size() {
+size_t VecObj::get_size() {
return vec.end() - vec.begin();
}
@@ -257,13 +257,13 @@ StrObj *StrObj::from_string(string repr) {
BuiltinProcObj::BuiltinProcObj(BuiltinProc f, string _name) :
OptObj(), handler(f), name(_name) {}
-Pair *BuiltinProcObj::call(ArgList *args, Environment * &envt,
- Continuation * &cont, FrameObj ** &top_ptr) {
+ Pair *BuiltinProcObj::call(ArgList *args, Environment * &envt,
+ Continuation * &cont, FrameObj ** &top_ptr) {
- Pair *ret_addr = static_cast<RetAddr*>(*top_ptr)->addr;
- *top_ptr++ = handler(TO_PAIR(args->cdr), name);
- return ret_addr->next; // Move to the next instruction
-}
+ Pair *ret_addr = static_cast<RetAddr*>(*top_ptr)->addr;
+ *top_ptr++ = handler(TO_PAIR(args->cdr), name);
+ return ret_addr->next; // Move to the next instruction
+ }
ReprCons *BuiltinProcObj::get_repr_cons() {
return new ReprStr("#<Builtin Procedure: " + name + ">");
@@ -295,68 +295,79 @@ EvalObj *Environment::get_obj(EvalObj *obj) {
Continuation::Continuation(Environment *_envt, Pair *_pc,
Continuation *_prev_cont,
Pair *_proc_body) :
- envt(_envt), pc(_pc), prev_cont(_prev_cont),
+ prev_cont(_prev_cont), envt(_envt), pc(_pc),
proc_body(_proc_body) {}
-ReprCons::ReprCons(bool _done, EvalObj *_ori) : done(_done), ori(_ori) {}
-ReprStr::ReprStr(string _repr) : ReprCons(true) { repr = _repr; }
-EvalObj *ReprStr::next(const string &prev) {
- throw NormalError(INT_ERR);
-}
+ ReprCons::ReprCons(bool _done, EvalObj *_ori) : ori(_ori), done(_done) {}
+ ReprStr::ReprStr(string _repr) : ReprCons(true) { repr = _repr; }
+ EvalObj *ReprStr::next(const string &prev) {
+ throw NormalError(INT_ERR);
+ }
PairReprCons::PairReprCons(Pair *_ptr, EvalObj *_ori) :
- ReprCons(false, _ori), ptr(_ptr), state(0) {}
+ ReprCons(false, _ori), state(0), ptr(_ptr) {}
-EvalObj *PairReprCons::next(const string &prev) {
- repr += prev;
- EvalObj *res;
- if (state == 0)
- {
- state = 1;
- res = TO_PAIR(ptr)->car;
- if (res->is_pair_obj())
- repr += "(";
- return res;
- }
- else if (state == 1)
- {
- state = 2;
- if (TO_PAIR(ptr)->car->is_pair_obj())
- repr += ")";
- ptr = TO_PAIR(ptr)->cdr;
- if (ptr == empty_list)
+ EvalObj *PairReprCons::next(const string &prev) {
+ repr += prev;
+ EvalObj *res;
+ if (state == 0)
+ {
+ state = 1;
+ res = TO_PAIR(ptr)->car;
+ if (res->is_pair_obj())
+ repr += "(";
+ return res;
+ }
+ else if (state == 1)
+ {
+ state = 2;
+ if (TO_PAIR(ptr)->car->is_pair_obj())
+ repr += ")";
+ ptr = TO_PAIR(ptr)->cdr;
+ if (ptr == empty_list)
+ return NULL;
+ repr += " ";
+ if (ptr->is_simple_obj())
+ repr += ". ";
+ return ptr;
+ }
+ else
+ {
return NULL;
- repr += " ";
- if (ptr->is_simple_obj())
- repr += ". ";
- return ptr;
- }
- else
- {
- return NULL;
+ }
}
-}
VectReprCons::VectReprCons(VecObj *_ptr, EvalObj *_ori) :
ReprCons(false, _ori), ptr(_ptr), idx(0) { repr = "#("; }
-EvalObj *VectReprCons::next(const string &prev) {
- repr += prev;
+ EvalObj *VectReprCons::next(const string &prev) {
+ repr += prev;
- if (idx && ptr->get_obj(idx - 1)->is_pair_obj())
- repr += ")";
+ if (idx && ptr->get_obj(idx - 1)->is_pair_obj())
+ repr += ")";
- if (idx == ptr->get_size())
- {
- repr += ")";
- return NULL;
- }
- else
- {
- if (idx) repr += " ";
- EvalObj *res = ptr->get_obj(idx++);
- if (res->is_pair_obj())
- repr += "(";
- return res;
+ if (idx == ptr->get_size())
+ {
+ repr += ")";
+ return NULL;
+ }
+ else
+ {
+ if (idx) repr += " ";
+ EvalObj *res = ptr->get_obj(idx++);
+ if (res->is_pair_obj())
+ repr += "(";
+ return res;
+ }
}
-}
+
+bool is_list(Pair *ptr) {
+ if (ptr == empty_list) return true;
+ EvalObj *nptr;
+ for (;;)
+ if ((nptr = ptr->cdr)->is_pair_obj())
+ ptr = TO_PAIR(nptr);
+ else break;
+ return ptr->cdr == empty_list;
+}
+
diff --git a/model.h b/model.h
index a4c6a1f..88b29cb 100644
--- a/model.h
+++ b/model.h
@@ -181,7 +181,7 @@ class VecObj;
class VectReprCons : public ReprCons {
private:
VecObj *ptr;
- int idx;
+ size_t idx;
public:
VectReprCons(VecObj *ptr, EvalObj *ori);
EvalObj *next(const string &prev);
@@ -377,7 +377,7 @@ class VecObj: public EvalObj {
EvalObjVec vec;
/** Construct a vector object */
VecObj();
- int get_size();
+ size_t get_size();
EvalObj *get_obj(int idx);
/** Resize the vector */
void resize(int new_size);
@@ -434,4 +434,6 @@ class Continuation {
Pair *proc_body);
};
+bool is_list();
+
#endif
diff --git a/parser.cpp b/parser.cpp
index 97482d4..21db112 100644
--- a/parser.cpp
+++ b/parser.cpp
@@ -45,7 +45,7 @@ void Tokenizor::set_stream(FILE *_stream) {
void str_to_lower(string &str) {
size_t len = str.length();
- for (int i = 0; i < len; i++)
+ for (size_t i = 0; i < len; i++)
if ('A' <= str[i] && str[i] <= 'Z')
str[i] -= 'A' - 'a';
}
diff --git a/robust_test.scm b/robust_test.scm
index 9f5c798..0e989b8 100644
--- a/robust_test.scm
+++ b/robust_test.scm
@@ -166,3 +166,9 @@ t
(lambda () '(1 2 3))
(lambda () 1 2 3)
(lambda #() 1)
+
+(define src
+ '(define g (lambda (x) (if (= x 5) 0 ((lambda () (display x) (g (+ x 1))))))))
+src
+(eval src)
+(eval '(g 0))