aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorTeddy <ted.sybil@gmail.com>2013-08-06 21:06:18 +0800
committerTeddy <ted.sybil@gmail.com>2013-08-06 21:06:18 +0800
commitdd6394d93dc21305e26232891daf5b19c226dd3a (patch)
tree93f6b5d0e85682b4f2b0d1f25e89cf77bafa45d5
parent3406f0a979e2465a993b20c2eb1033729c6a787c (diff)
dot sign support in literal mode
-rw-r--r--builtin.cpp150
-rw-r--r--consts.cpp4
-rw-r--r--consts.h4
-rw-r--r--eval.cpp2
-rw-r--r--model.cpp8
-rw-r--r--parser.cpp24
6 files changed, 107 insertions, 85 deletions
diff --git a/builtin.cpp b/builtin.cpp
index 9d25644..0bbd67e 100644
--- a/builtin.cpp
+++ b/builtin.cpp
@@ -69,53 +69,53 @@ InexactNumObj::InexactNumObj(NumLvl level) : NumObj(level, false) {}
CompNumObj::CompNumObj(double _real, double _imag) :
InexactNumObj(NUM_LVL_COMP), real(_real), imag(_imag) {}
-CompNumObj *CompNumObj::from_string(string repr) {
- // spos: the position of the last sign
- // ipos: the position of i
- int spos = -1, ipos = -1;
- size_t len = repr.length();
- bool sign;
- for (size_t i = 0; i < len; i++)
- if (repr[i] == '+' || repr[i] == '-')
- {
- spos = i;
- sign = repr[i] == '-';
- }
- else if (repr[i] == 'i' || repr[i] == 'I')
- ipos = i;
+ CompNumObj *CompNumObj::from_string(string repr) {
+ // spos: the position of the last sign
+ // ipos: the position of i
+ int spos = -1, ipos = -1;
+ size_t len = repr.length();
+ bool sign;
+ for (size_t i = 0; i < len; i++)
+ if (repr[i] == '+' || repr[i] == '-')
+ {
+ spos = i;
+ sign = repr[i] == '-';
+ }
+ else if (repr[i] == 'i' || repr[i] == 'I')
+ ipos = i;
- if (spos == -1 || ipos == -1 || !(spos < ipos))
- return NULL;
+ if (spos == -1 || ipos == -1 || !(spos < ipos))
+ return NULL;
- double real = 0, imag = 1;
- IntNumObj *int_ptr;
- RatNumObj *rat_ptr;
- RealNumObj *real_ptr;
- if (spos > 0)
- {
- string real_str = repr.substr(0, spos);
- if (int_ptr = IntNumObj::from_string(real_str))
- real = int_ptr->val;
- else if ((rat_ptr = RatNumObj::from_string(real_str)))
- real = rat_ptr->a / double(rat_ptr->b);
- else if ((real_ptr = RealNumObj::from_string(real_str)))
- real = real_ptr->real;
- else return NULL;
- }
- if (ipos > spos + 1)
- {
- string imag_str = repr.substr(spos + 1, ipos - spos - 1);
- if (int_ptr = IntNumObj::from_string(imag_str))
- imag = int_ptr->val;
- else if ((rat_ptr = RatNumObj::from_string(imag_str)))
- imag = rat_ptr->a / double(rat_ptr->b);
- else if ((real_ptr = RealNumObj::from_string(imag_str)))
- imag = real_ptr->real;
- else return NULL;
+ double real = 0, imag = 1;
+ IntNumObj *int_ptr;
+ RatNumObj *rat_ptr;
+ RealNumObj *real_ptr;
+ if (spos > 0)
+ {
+ string real_str = repr.substr(0, spos);
+ if (int_ptr = IntNumObj::from_string(real_str))
+ real = int_ptr->val;
+ else if ((rat_ptr = RatNumObj::from_string(real_str)))
+ real = rat_ptr->a / double(rat_ptr->b);
+ else if ((real_ptr = RealNumObj::from_string(real_str)))
+ real = real_ptr->real;
+ else return NULL;
+ }
+ if (ipos > spos + 1)
+ {
+ string imag_str = repr.substr(spos + 1, ipos - spos - 1);
+ if (int_ptr = IntNumObj::from_string(imag_str))
+ imag = int_ptr->val;
+ else if ((rat_ptr = RatNumObj::from_string(imag_str)))
+ imag = rat_ptr->a / double(rat_ptr->b);
+ else if ((real_ptr = RealNumObj::from_string(imag_str)))
+ imag = real_ptr->real;
+ else return NULL;
+ }
+ if (sign) imag = -imag;
+ return new CompNumObj(real, imag);
}
- if (sign) imag = -imag;
- return new CompNumObj(real, imag);
-}
CompNumObj *CompNumObj::convert(NumObj *obj) {
switch (obj->level)
@@ -127,9 +127,9 @@ CompNumObj *CompNumObj::convert(NumObj *obj) {
break;
case NUM_LVL_RAT :
{
- RatNumObj *rat = static_cast<RatNumObj*>(obj);
- return new CompNumObj(rat->a / double(rat->b), 0);
- break;
+ RatNumObj *rat = static_cast<RatNumObj*>(obj);
+ return new CompNumObj(rat->a / double(rat->b), 0);
+ break;
}
case NUM_LVL_INT :
return new CompNumObj(static_cast<IntNumObj*>(obj)->val, 0);
@@ -155,14 +155,14 @@ NumObj *CompNumObj::minus(NumObj *_r) {
NumObj *CompNumObj::multi(NumObj *_r) {
CompNumObj *r = static_cast<CompNumObj*>(_r);
return new CompNumObj(A * C - B * D,
- B * C + A * D);
+ B * C + A * D);
}
NumObj *CompNumObj::div(NumObj *_r) {
CompNumObj *r = static_cast<CompNumObj*>(_r);
double f = 1.0 / (C * C + D * D);
return new CompNumObj((A * C + B * D) * f,
- (B * C - A * D) * f);
+ (B * C - A * D) * f);
}
bool CompNumObj::lt(NumObj *_r) {
@@ -204,9 +204,9 @@ RealNumObj *RealNumObj::convert(NumObj *obj) {
return static_cast<RealNumObj*>(obj); break;
case NUM_LVL_RAT:
{
- RatNumObj *rat = static_cast<RatNumObj*>(obj);
- return new RealNumObj(rat->a / double(rat->b));
- break;
+ RatNumObj *rat = static_cast<RatNumObj*>(obj);
+ return new RealNumObj(rat->a / double(rat->b));
+ break;
}
case NUM_LVL_INT:
return new RealNumObj(static_cast<IntNumObj*>(obj)->val);
@@ -250,10 +250,10 @@ ExactNumObj::ExactNumObj(NumLvl level) : NumObj(level, true) {}
RatNumObj::RatNumObj(int _a, int _b) :
ExactNumObj(NUM_LVL_RAT), a(_a), b(_b) {
- int g = gcd(a, b);
- a /= g;
- b /= g;
-}
+ int g = gcd(a, b);
+ a /= g;
+ b /= g;
+ }
RatNumObj *RatNumObj::from_string(string repr) {
int a, b;
@@ -443,13 +443,13 @@ void SpecialOptIf::pre_call(ArgList *args, Cons *pc,
}
EvalObj *SpecialOptIf::post_call(ArgList *args, Cons *pc,
- Environment *envt) {
+ Environment *envt) {
// Value already evaluated, so just return it
return TO_CONS(args->cdr)->car;
}
Cons *SpecialOptIf::call(ArgList *args, Environment * &envt,
- Continuation * &cont, FrameObj ** &top_ptr) {
+ Continuation * &cont, FrameObj ** &top_ptr) {
Cons *ret_addr = static_cast<RetAddr*>(*top_ptr)->addr;
if (state)
{
@@ -472,7 +472,7 @@ SpecialOptLambda::SpecialOptLambda() : SpecialOptObj() {}
#define FILL_MARKS(pc, flag) \
for (Cons *ptr = TO_CONS(pc->cdr); \
ptr != empty_list; ptr = TO_CONS(ptr->cdr)) \
- ptr->skip = flag
+ptr->skip = flag
void SpecialOptLambda::prepare(Cons *pc) {
// Do not evaluate anything
@@ -480,7 +480,7 @@ void SpecialOptLambda::prepare(Cons *pc) {
}
Cons *SpecialOptLambda::call(ArgList *args, Environment * &envt,
- Continuation * &cont, FrameObj ** &top_ptr) {
+ Continuation * &cont, FrameObj ** &top_ptr) {
Cons *ret_addr = static_cast<RetAddr*>(*top_ptr)->addr;
Cons *pc = static_cast<Cons*>(ret_addr->car);
@@ -584,7 +584,7 @@ void SpecialOptSet::prepare(Cons *pc) {
}
Cons *SpecialOptSet::call(ArgList *args, Environment * &envt,
- Continuation * &cont, FrameObj ** &top_ptr) {
+ Continuation * &cont, FrameObj ** &top_ptr) {
Cons *ret_addr = static_cast<RetAddr*>(*top_ptr)->addr;
Cons *pc = static_cast<Cons*>(ret_addr->car);
EvalObj *first = TO_CONS(pc->cdr)->car;
@@ -612,7 +612,7 @@ void SpecialOptQuote::prepare(Cons *pc) {
}
Cons *SpecialOptQuote::call(ArgList *args, Environment * &envt,
- Continuation * &cont, FrameObj ** &top_ptr) {
+ Continuation * &cont, FrameObj ** &top_ptr) {
Cons *ret_addr = static_cast<RetAddr*>(*top_ptr)->addr;
Cons *pc = static_cast<Cons*>(ret_addr->car);
// revert
@@ -625,18 +625,18 @@ string SpecialOptQuote::ext_repr() { return string("#<Builtin Macro: quote>"); }
#define ARGS_EXACTLY_TWO \
if (args == empty_list || \
- args->cdr == empty_list || \
- TO_CONS(args->cdr)->cdr != empty_list) \
- throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS)
+ args->cdr == empty_list || \
+ TO_CONS(args->cdr)->cdr != empty_list) \
+throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS)
#define ARGS_EXACTLY_ONE \
if (args == empty_list || \
- args->cdr != empty_list) \
- throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS)
+ args->cdr != empty_list) \
+throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS)
#define ARGS_AT_LEAST_ONE \
if (args == empty_list) \
- throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS)
+throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS)
BUILTIN_PROC_DEF(make_pair) {
ARGS_EXACTLY_TWO;
@@ -645,7 +645,7 @@ BUILTIN_PROC_DEF(make_pair) {
BUILTIN_PROC_DEF(pair_car) {
ARGS_EXACTLY_ONE;
- if (args->car == empty_list || !args->car->is_cons_obj())
+ if (!args->car->is_cons_obj())
throw TokenError(name, RUN_ERR_WRONG_TYPE);
return TO_CONS(args->car)->car;
@@ -653,7 +653,7 @@ BUILTIN_PROC_DEF(pair_car) {
BUILTIN_PROC_DEF(pair_cdr) {
ARGS_EXACTLY_ONE;
- if (args->car == empty_list || !args->car->is_cons_obj())
+ if (!args->car->is_cons_obj())
throw TokenError(name, RUN_ERR_WRONG_TYPE);
return TO_CONS(args->car)->cdr;
@@ -749,7 +749,7 @@ BUILTIN_PROC_DEF(num_lt) {
ARGS_AT_LEAST_ONE;
if (!args->car->is_num_obj())
throw TokenError("a number", RUN_ERR_WRONG_TYPE);
-
+
NumObj *last = static_cast<NumObj*>(args->car), *opr;
for (Cons *ptr = TO_CONS(args->cdr);
@@ -773,7 +773,7 @@ BUILTIN_PROC_DEF(num_gt) {
ARGS_AT_LEAST_ONE;
if (!args->car->is_num_obj())
throw TokenError("a number", RUN_ERR_WRONG_TYPE);
-
+
NumObj *last = static_cast<NumObj*>(args->car), *opr;
for (Cons *ptr = TO_CONS(args->cdr);
@@ -797,7 +797,7 @@ BUILTIN_PROC_DEF(num_eq) {
ARGS_AT_LEAST_ONE;
if (!args->car->is_num_obj())
throw TokenError("a number", RUN_ERR_WRONG_TYPE);
-
+
NumObj *last = static_cast<NumObj*>(args->car), *opr;
for (Cons *ptr = TO_CONS(args->cdr);
@@ -834,7 +834,7 @@ BUILTIN_PROC_DEF(is_pair) {
BUILTIN_PROC_DEF(pair_set_car) {
ARGS_EXACTLY_TWO;
- if (args->car == empty_list || !args->car->is_cons_obj())
+ if (!args->car->is_cons_obj())
throw TokenError(name, RUN_ERR_WRONG_TYPE);
TO_CONS(args->car)->car = TO_CONS(args->cdr)->car;
return new UnspecObj();
@@ -842,7 +842,7 @@ BUILTIN_PROC_DEF(pair_set_car) {
BUILTIN_PROC_DEF(pair_set_cdr) {
ARGS_EXACTLY_TWO;
- if (args->car == empty_list || !args->car->is_cons_obj())
+ if (!args->car->is_cons_obj())
throw TokenError(name, RUN_ERR_WRONG_TYPE);
TO_CONS(args->car)->cdr = TO_CONS(args->cdr)->car;
return new UnspecObj();
diff --git a/consts.cpp b/consts.cpp
index db2a4d5..eb17eaa 100644
--- a/consts.cpp
+++ b/consts.cpp
@@ -12,5 +12,7 @@ const char *ERR_MSG[] = {
"Wrong type (expecting %s)",
"Internal Error !!! File a bug please!",
"Illegal character in escape sequence: #\\%s",
- "Unknown character name: %s"
+ "Unknown character name: %s",
+ "Improper pair structure",
+ "Improper vector structure"
};
diff --git a/consts.h b/consts.h
index 4bfd6b7..dc2c4f6 100644
--- a/consts.h
+++ b/consts.h
@@ -13,7 +13,9 @@ enum ErrCode {
RUN_ERR_WRONG_TYPE,
INT_ERR,
PAR_ERR_ILLEGAL_CHAR_IN_ESC,
- RUN_ERR_UNKNOWN_CHAR_NAME
+ RUN_ERR_UNKNOWN_CHAR_NAME,
+ PAR_ERR_IMPROPER_PAIR,
+ PAR_ERR_IMPROPER_VECT
};
extern const char *ERR_MSG[];
diff --git a/eval.cpp b/eval.cpp
index 6196e34..e6e6de1 100644
--- a/eval.cpp
+++ b/eval.cpp
@@ -38,7 +38,7 @@ void Evaluator::add_builtin_routines() {
ADD_BUILTIN_PROC("boolean?", is_boolean);
ADD_BUILTIN_PROC("pair?", is_pair);
- ADD_BUILTIN_PROC("pair", make_pair);
+ ADD_BUILTIN_PROC("cons", make_pair);
ADD_BUILTIN_PROC("car", pair_car);
ADD_BUILTIN_PROC("cdr", pair_cdr);
ADD_BUILTIN_PROC("set-car!", pair_set_car);
diff --git a/model.cpp b/model.cpp
index 287c20a..4cfdca0 100644
--- a/model.cpp
+++ b/model.cpp
@@ -40,9 +40,10 @@ bool EvalObj::is_opt_obj() {
}
bool EvalObj::is_cons_obj() {
- return otype & CLS_CONS_OBJ;
+ return this != empty_list && (otype & CLS_CONS_OBJ);
}
+
bool EvalObj::is_num_obj() {
return otype & CLS_NUM_OBJ;
}
@@ -227,7 +228,10 @@ string VecObj::ext_repr() {
string res = "#(";
for (EvalObjVec::iterator it = vec.begin(); it != vec.end(); it++)
res += (*it)->ext_repr() + " ";
- res[res.length() - 1] = ')';
+ if (vec.begin() == vec.end())
+ res += ')';
+ else
+ res[res.length() - 1] = ')';
return res;
}
diff --git a/parser.cpp b/parser.cpp
index 05806f1..56b3dd9 100644
--- a/parser.cpp
+++ b/parser.cpp
@@ -168,20 +168,34 @@ Cons *ASTGenerator::absorb(Tokenizor *tk) {
{
if (top_ptr == parse_stack)
throw NormalError(READ_ERR_UNEXPECTED_RIGHT_BRACKET);
- Cons *lst = empty_list;
+ EvalObj *lst = empty_list;
+ bool improper = false;
while (top_ptr >= parse_stack && !IS_BRAKET(*(--top_ptr)))
{
- Cons *_lst = new Cons(TO_EVAL(*top_ptr), lst); // Collect the list
- _lst->next = lst == empty_list ? NULL : lst;
- lst = _lst;
+ EvalObj *obj = TO_EVAL(*top_ptr);
+ if (obj->is_sym_obj() && static_cast<SymObj*>(obj)->val == ".")
+ {
+ improper = true;
+ if (lst == empty_list || TO_CONS(lst)->cdr != empty_list)
+ throw NormalError(PAR_ERR_IMPROPER_PAIR);
+ lst = TO_CONS(lst)->car;
+ }
+ else
+ {
+ Cons *_lst = new Cons(obj, lst); // Collect the list
+ _lst->next = lst->is_cons_obj() ? TO_CONS(lst) : NULL;
+ lst = _lst;
+ }
}
+
ParseBracket *bptr = TO_BRACKET(*top_ptr);
if (bptr->btype == 0)
*top_ptr++ = lst;
else if (bptr->btype == 1)
{
+ if (improper) throw NormalError(PAR_ERR_IMPROPER_VECT);
VecObj *vec = new VecObj();
- for (Cons *ptr = lst; ptr != empty_list; ptr = TO_CONS(ptr->cdr))
+ for (Cons *ptr = TO_CONS(lst); ptr != empty_list; ptr = TO_CONS(ptr->cdr))
vec->push_back(ptr->car);
*top_ptr++ = vec;
}