aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--builtin.cpp39
-rw-r--r--builtin.h13
-rw-r--r--eval.cpp1
-rw-r--r--main.cpp6
-rw-r--r--model.cpp34
-rw-r--r--model.h52
-rw-r--r--parser.cpp107
7 files changed, 204 insertions, 48 deletions
diff --git a/builtin.cpp b/builtin.cpp
index de8bd12..a0b3830 100644
--- a/builtin.cpp
+++ b/builtin.cpp
@@ -34,7 +34,7 @@ double str_to_double(string repr, bool &flag) {
const char *nptr = repr.c_str();
char *endptr;
double val = strtod(nptr, &endptr);
- if (endptr != nptr + repr.length())
+ if (endptr == nptr || endptr != nptr + repr.length())
{
flag = false;
return 0;
@@ -47,7 +47,7 @@ int str_to_int(string repr, bool &flag) {
const char *nptr = repr.c_str();
char *endptr;
int val = strtol(nptr, &endptr, 10);
- if (endptr != nptr + repr.length())
+ if (endptr == nptr || endptr != nptr + repr.length())
{
flag = false;
return 0;
@@ -72,10 +72,10 @@ 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,
- len = repr.length();
+ int spos = -1, ipos = -1;
+ size_t len = repr.length();
bool sign;
- for (int i = 0; i < len; i++)
+ for (size_t i = 0; i < len; i++)
if (repr[i] == '+' || repr[i] == '-')
{
spos = i;
@@ -257,8 +257,9 @@ RatNumObj::RatNumObj(int _a, int _b) :
RatNumObj *RatNumObj::from_string(string repr) {
int a, b;
- int len = repr.length(), pos = -1;
- for (int i = 0; i < len; i++)
+ size_t len = repr.length();
+ int pos = -1;
+ for (size_t i = 0; i < len; i++)
if (repr[i] == '/') { pos = i; break; }
bool flag;
a = str_to_int(repr.substr(0, pos), flag);
@@ -344,7 +345,7 @@ IntNumObj::IntNumObj(int _val) : ExactNumObj(NUM_LVL_INT), val(_val) {}
IntNumObj *IntNumObj::from_string(string repr) {
int val = 0;
- for (int i = 0; i < repr.length(); i++)
+ for (size_t i = 0; i < repr.length(); i++)
{
if (!('0' <= repr[i] && repr[i] <= '9'))
return NULL;
@@ -474,7 +475,6 @@ SpecialOptLambda::SpecialOptLambda() : SpecialOptObj() {}
ptr->skip = flag
void SpecialOptLambda::prepare(Cons *pc) {
- //TODO check number of arguments
// Do not evaluate anything
FILL_MARKS(pc, true);
}
@@ -528,7 +528,6 @@ Cons *SpecialOptDefine::call(ArgList *args, Environment * &envt,
Cons *pc = static_cast<Cons*>(ret_addr->car);
EvalObj *obj;
SymObj *id;
- // TODO: check identifier
EvalObj *first = TO_CONS(pc->cdr)->car;
if (first->is_simple_obj())
{
@@ -605,6 +604,26 @@ SpecialOptSet::SpecialOptSet() {}
string SpecialOptSet::ext_repr() { return string("#<Builtin Macro: set!>"); }
+SpecialOptQuote::SpecialOptQuote() {}
+
+void SpecialOptQuote::prepare(Cons *pc) {
+ // Do not evaluate anything
+ FILL_MARKS(pc, true);
+}
+
+Cons *SpecialOptQuote::call(ArgList *args, Environment * &envt,
+ Continuation * &cont, FrameObj ** &top_ptr) {
+ Cons *ret_addr = static_cast<RetAddr*>(*top_ptr)->addr;
+ Cons *pc = static_cast<Cons*>(ret_addr->car);
+ // revert
+ FILL_MARKS(pc, false);
+ *top_ptr++ = TO_CONS(pc->cdr)->car;
+ return ret_addr->next;
+}
+
+string SpecialOptQuote::ext_repr() { return string("#<Builtin Macro: quote>"); }
+
+
EvalObj *builtin_cons(ArgList *args) {
if (args == empty_list ||
args->cdr == empty_list ||
diff --git a/builtin.h b/builtin.h
index 322e82e..8ef026e 100644
--- a/builtin.h
+++ b/builtin.h
@@ -191,6 +191,19 @@ class SpecialOptSet: public SpecialOptObj {
string ext_repr();
};
+/** @class SpecialOptLambda
+ * The implementation of `lambda` operator
+ */
+class SpecialOptQuote: public SpecialOptObj {
+ public:
+ SpecialOptQuote();
+ void prepare(Cons *pc);
+ Cons *call(ArgList *args, Environment * &envt,
+ Continuation * &cont, FrameObj ** &top_ptr);
+
+ string ext_repr();
+};
+
EvalObj *builtin_plus(ArgList *);
EvalObj *builtin_minus(ArgList *);
EvalObj *builtin_multi(ArgList *);
diff --git a/eval.cpp b/eval.cpp
index 47cdc66..add754f 100644
--- a/eval.cpp
+++ b/eval.cpp
@@ -31,6 +31,7 @@ void Evaluator::add_builtin_routines() {
ADD_ENTRY("lambda", new SpecialOptLambda());
ADD_ENTRY("define", new SpecialOptDefine());
ADD_ENTRY("set!", new SpecialOptSet());
+ ADD_ENTRY("quote", new SpecialOptQuote());
}
Evaluator::Evaluator() {
diff --git a/main.cpp b/main.cpp
index 230d077..eae0597 100644
--- a/main.cpp
+++ b/main.cpp
@@ -21,6 +21,7 @@ int main() {
ASTGenerator *ast = new ASTGenerator();
Evaluator *eval = new Evaluator();
+ int rcnt = 0;
while (1)
{
printf("Sonsi> ");
@@ -29,11 +30,12 @@ int main() {
Cons *tree = ast->absorb(tk);
if (!tree) break;
//tree_print(tree);
- printf("%s\n", eval->run_expr(tree)->ext_repr().c_str());
+ fprintf(stderr, "Ret> $%d = %s\n", rcnt++,
+ eval->run_expr(tree)->ext_repr().c_str());
}
catch (GeneralError &e)
{
- printf("An error occured: %s\n", e.get_msg().c_str());
+ fprintf(stderr, "An error occured: %s\n", e.get_msg().c_str());
}
}
}
diff --git a/model.cpp b/model.cpp
index 4f0e1c5..bb5b855 100644
--- a/model.cpp
+++ b/model.cpp
@@ -19,6 +19,10 @@ bool FrameObj::is_ret_addr() {
return ftype & CLS_RET_ADDR;
}
+bool FrameObj::is_parse_bracket() {
+ return ftype & CLS_PAR_BRA;
+}
+
EvalObj::EvalObj(ClassType _otype) : FrameObj(CLS_EVAL_OBJ), otype(_otype) {}
void EvalObj::prepare(Cons *pc) {}
@@ -94,6 +98,15 @@ RetAddr::RetAddr(Cons *_addr) : FrameObj(CLS_RET_ADDR), addr(_addr) {}
string RetAddr::_debug_repr() { return string("#<Return Address>"); }
#endif
+ParseBracket::ParseBracket(unsigned char _btype) :
+ FrameObj(CLS_SIM_OBJ | CLS_PAR_BRA), btype(_btype) {}
+
+#ifdef DEBUG
+string ParseBracket::_debug_repr() {
+ return string("#<Bracket>");
+}
+#endif
+
UnspecObj::UnspecObj() : EvalObj(CLS_SIM_OBJ) {}
string UnspecObj::ext_repr() { return string("#<Unspecified>"); }
@@ -165,8 +178,27 @@ StrObj::StrObj(string _str) : EvalObj(CLS_SIM_OBJ), str(_str) {}
string StrObj::ext_repr() { return str; }
+VecObj::VecObj() : EvalObj(CLS_SIM_OBJ) {}
+
+void VecObj::resize(int new_size) {
+ vec.resize(new_size);
+}
+
+void VecObj::push_back(EvalObj *new_elem) {
+ vec.push_back(new_elem);
+}
+
+string VecObj::ext_repr() {
+ string res = "#(";
+ for (EvalObjVec::iterator it = vec.begin(); it != vec.end(); it++)
+ res += (*it)->ext_repr() + " ";
+ res[res.length() - 1] = ')';
+ return res;
+}
+
+
StrObj *StrObj::from_string(string repr) {
- int len = repr.length();
+ size_t len = repr.length();
if (repr[0] == '\"' && repr[len - 1] == '\"')
return new StrObj(repr.substr(1, len - 2));
return NULL;
diff --git a/model.h b/model.h
index f883032..4dcdc59 100644
--- a/model.h
+++ b/model.h
@@ -4,23 +4,26 @@
#include <string>
#include <list>
#include <map>
+#include <vector>
using std::list;
using std::string;
using std::map;
+using std::vector;
// the range of unsigned char is enough for these types
typedef unsigned char ClassType;
typedef unsigned char NumLvl;
-static const int CLS_RET_ADDR = 1 << 0;
-static const int CLS_EVAL_OBJ = 1 << 1;
+const int CLS_RET_ADDR = 1 << 0;
+const int CLS_EVAL_OBJ = 1 << 1;
+const int CLS_PAR_BRA = 1 << 2;
-static const int CLS_SIM_OBJ = 1 << 0;
-static const int CLS_CONS_OBJ = 1 << 1;
-static const int CLS_SYM_OBJ = 1 << 2;
-static const int CLS_OPT_OBJ = 1 << 3;
-static const int CLS_NUM_OBJ = 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_NUM_OBJ = 1 << 4;
#define TO_CONS(ptr) \
@@ -49,6 +52,12 @@ class FrameObj {
* @return true for yes
*/
bool is_ret_addr();
+ /**
+ * Tell whether the object is a bracket, according to ftype
+ * @return true for yes
+ */
+ bool is_parse_bracket();
+
#ifdef DEBUG
virtual string _debug_repr() = 0;
#endif
@@ -144,6 +153,18 @@ class RetAddr : public FrameObj {
#endif
};
+/** @class ParseBracket
+ * To indiate a left bracket when parsing, used in the parse_stack
+ */
+class ParseBracket : public FrameObj {
+ public:
+ unsigned char btype; /**< The type of the bracket */
+ /** Construct a ParseBracket object */
+ ParseBracket(unsigned char btype);
+#ifdef DEBUG
+ string _debug_repr();
+#endif
+};
/** @class UnspecObj
* The "unspecified" value returned by some builtin procedures
@@ -310,6 +331,23 @@ class StrObj: public EvalObj {
string ext_repr();
};
+typedef vector<EvalObj*> EvalObjVec;
+/**
+ * @class VecObj
+ * Vector support (currently a wrapper of STL vector)
+ */
+class VecObj: public EvalObj {
+ private:
+ EvalObjVec vec;
+ public:
+ /** Construct a vector object */
+ VecObj();
+ /** Resize the vector */
+ void resize(int new_size);
+ /** Add a new element to the rear */
+ void push_back(EvalObj *new_elem);
+ string ext_repr();
+};
typedef map<string, EvalObj*> Str2EvalObj;
/** @class Environment
diff --git a/parser.cpp b/parser.cpp
index b670f36..cd9eacb 100644
--- a/parser.cpp
+++ b/parser.cpp
@@ -9,7 +9,7 @@
using std::stringstream;
static char buff[TOKEN_BUFF_SIZE];
-static EvalObj *parse_stack[PARSE_STACK_SIZE];
+static FrameObj *parse_stack[PARSE_STACK_SIZE];
extern Cons *empty_list;
Tokenizor::Tokenizor() : stream(stdin), buff_ptr(buff), escaping(false) {}
@@ -29,8 +29,11 @@ void Tokenizor::set_stream(FILE *_stream) {
((ch) == ' ' || (ch) == '\t' || IS_NEWLINE(ch))
#define IS_COMMENT(ch) \
((ch) == ';')
+#define IS_LITERAL(ch) \
+ ((ch) == '\'')
#define IS_DELIMITER(ch) \
- (IS_BRACKET(ch) || IS_SPACE(ch) || IS_COMMENT(ch) || IS_QUOTE(ch))
+ (IS_BRACKET(ch) || IS_SPACE(ch) || \
+ IS_COMMENT(ch) || IS_QUOTE(ch))
#define POP \
do { \
@@ -38,6 +41,7 @@ void Tokenizor::set_stream(FILE *_stream) {
ret = string(buff); \
buff_ptr = buff; \
} while (0)
+#define TOP (*(buff_ptr - 1))
bool Tokenizor::get_token(string &ret) {
char ch;
@@ -63,26 +67,35 @@ bool Tokenizor::get_token(string &ret) {
else
{
bool in_quote = buff_ptr != buff && IS_QUOTE(*buff);
- if (buff_ptr != buff &&
- (IS_BRACKET(*buff) ||
- IS_DELIMITER(ch)))
-
+ if (buff_ptr != buff)
{
- if (IS_COMMENT(*buff))
- {
- if (IS_NEWLINE(ch)) buff_ptr = buff;
- else buff_ptr = buff + 1;
- }
- else if (!in_quote)
+ if (buff_ptr - buff == 1 && IS_LITERAL(TOP))
{
POP;
flag = true;
}
- else if (IS_QUOTE(ch))
+ else if ((IS_BRACKET(TOP) || IS_DELIMITER(ch)))
{
- *buff_ptr++ = '\"';
- POP;
- return true; // discard current slash
+ if (IS_COMMENT(*buff))
+ {
+ if (IS_NEWLINE(ch)) buff_ptr = buff;
+ else buff_ptr = buff + 1;
+ }
+ else if (!in_quote) // not in a double-quote
+ {
+ if (!(buff_ptr - buff == 1 && ch == '(' && TOP == '#'))
+ {
+ POP;
+ flag = true;
+ }
+ }
+ else if (IS_QUOTE(ch))
+ {
+ // in a double-quote which is being enclosed
+ *buff_ptr++ = '\"';
+ POP;
+ return true; // prevent duplicate quote sign
+ }
}
}
if (in_quote || !IS_SPACE(ch))
@@ -109,31 +122,69 @@ EvalObj *ASTGenerator::to_obj(const string &str) {
if ((res = RealNumObj::from_string(str))) return res;
if ((res = CompNumObj::from_string(str))) return res;
if ((res = StrObj::from_string(str))) return res;
- return new SymObj(str);
+ return new SymObj(str); // otherwise we assume it a symbol
}
+
+#define TO_EVAL(ptr) \
+ (static_cast<EvalObj*>(ptr))
+#define TO_BRACKET(ptr) \
+ (static_cast<ParseBracket*>(ptr))
+#define IS_BRAKET(ptr) \
+ ((ptr)->is_parse_bracket())
+
Cons *ASTGenerator::absorb(Tokenizor *tk) {
- EvalObj **top_ptr = parse_stack;
+ FrameObj **top_ptr = parse_stack;
for (;;)
{
- if (top_ptr > parse_stack && *parse_stack)
- return new Cons(*(top_ptr - 1), empty_list);
+ if (top_ptr - parse_stack > 1 &&
+ !IS_BRAKET(*(top_ptr - 1)) &&
+ IS_BRAKET(*(top_ptr - 2)))
+ {
+ ParseBracket *bptr = TO_BRACKET(*(top_ptr - 2));
+ if (bptr->btype == 2)
+ {
+ top_ptr -= 2;
+ Cons *lst_cdr = new Cons(TO_EVAL(*(top_ptr + 1)), empty_list);
+ Cons *lst = new Cons(new SymObj("quote"), lst_cdr);
+ lst->next = lst_cdr;
+ lst_cdr->next = NULL;
+ *top_ptr++ = lst;
+ }
+ }
+
+ if (top_ptr > parse_stack && !IS_BRAKET(*parse_stack))
+ return new Cons(TO_EVAL(*(top_ptr - 1)), empty_list);
string token;
if (!tk->get_token(token)) return NULL;
- if (token == "(")
- *top_ptr++ = NULL; // Make the beginning of a new level
+ if (token == "(") // a list
+ *top_ptr++ = new ParseBracket(0);
+ else if (token == "#(") // a vector
+ *top_ptr++ = new ParseBracket(1);
+ else if (token == "\'") // syntatic sugar for quote
+ *top_ptr++ = new ParseBracket(2);
else if (token == ")")
{
+ if (top_ptr == parse_stack)
+ throw NormalError(READ_ERR_UNEXPECTED_RIGHT_BRACKET);
Cons *lst = empty_list;
- while (top_ptr >= parse_stack && *(--top_ptr))
+ while (top_ptr >= parse_stack && !IS_BRAKET(*(--top_ptr)))
{
- Cons *_lst = new Cons(*top_ptr, lst); // Collect the list
+ Cons *_lst = new Cons(TO_EVAL(*top_ptr), lst); // Collect the list
_lst->next = lst == empty_list ? NULL : lst;
lst = _lst;
}
- if (top_ptr < parse_stack)
- throw NormalError(READ_ERR_UNEXPECTED_RIGHT_BRACKET);
- *top_ptr++ = lst;
+ ParseBracket *bptr = TO_BRACKET(*top_ptr);
+ if (bptr->btype == 0)
+ *top_ptr++ = lst;
+ else if (bptr->btype == 1)
+ {
+ VecObj *vec = new VecObj();
+ for (Cons *ptr = lst; ptr != empty_list; ptr = TO_CONS(ptr->cdr))
+ vec->push_back(ptr->car);
+ *top_ptr++ = vec;
+ }
}
- else *top_ptr++ = ASTGenerator::to_obj(token);
+ else
+ *top_ptr++ = ASTGenerator::to_obj(token);
}
}