aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorTeddy <ted.sybil@gmail.com>2013-08-10 23:42:42 +0800
committerTeddy <ted.sybil@gmail.com>2013-08-10 23:42:42 +0800
commit2729f71c327f8ef4ddbb620dc486e7334ba40119 (patch)
tree660ea8b5fe582cb2895cf66f1a10a536df33afbd
parent80e885a9847c9bce1be8cccafc85ea39cbc120e2 (diff)
more built-ins
-rw-r--r--Makefile2
-rw-r--r--TODO.rst9
-rw-r--r--builtin.cpp229
-rw-r--r--builtin.h26
-rw-r--r--eval.cpp11
-rw-r--r--model.cpp4
-rw-r--r--model.h9
7 files changed, 283 insertions, 7 deletions
diff --git a/Makefile b/Makefile
index ad43056..30116bf 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 -Wall -Wextra
+ g++ $< -c -g -pg -DGMP_SUPPORT -Wall
clean:
rm -f *.o
diff --git a/TODO.rst b/TODO.rst
index 99baab8..b05a8d4 100644
--- a/TODO.rst
+++ b/TODO.rst
@@ -1,4 +1,13 @@
+- Several built-in support
+ - or
+ - string=?
+ - string<?
+ - string>?
+ - string<=?
+ - string>=?
+
- Testing
+- Rounding support
- Garbage Collection?
- ext_repr optimization
- Add macro support
diff --git a/builtin.cpp b/builtin.cpp
index fbcbd84..39d083a 100644
--- a/builtin.cpp
+++ b/builtin.cpp
@@ -6,6 +6,7 @@
#include <sstream>
#include <cctype>
#include <cstdlib>
+#include <cmath>
#include <iomanip>
using std::stringstream;
@@ -213,14 +214,27 @@ NumObj *CompNumObj::div(NumObj *_r) {
(B * C - A * D) * f);
}
-bool CompNumObj::lt(NumObj *_r) {
+bool NumObj::lt(NumObj *_r) {
throw TokenError("a comparable number", RUN_ERR_WRONG_TYPE);
}
-bool CompNumObj::gt(NumObj *_r) {
+bool NumObj::gt(NumObj *_r) {
throw TokenError("a comparable number", RUN_ERR_WRONG_TYPE);
}
+bool NumObj::le(NumObj *_r) {
+ throw TokenError("a comparable number", RUN_ERR_WRONG_TYPE);
+}
+
+bool NumObj::ge(NumObj *_r) {
+ throw TokenError("a comparable number", RUN_ERR_WRONG_TYPE);
+}
+
+NumObj *NumObj::abs() {
+ throw TokenError("a real number", RUN_ERR_WRONG_TYPE);
+}
+
+
bool CompNumObj::eq(NumObj *_r) {
CompNumObj *r = static_cast<CompNumObj*>(_r);
return A == C && B == D; // TODO: more proper judgement
@@ -287,6 +301,10 @@ NumObj *RealNumObj::div(NumObj *_r) {
return new RealNumObj(real / static_cast<RealNumObj*>(_r)->real);
}
+NumObj *RealNumObj::abs() {
+ return new RealNumObj(fabs(real));
+}
+
bool RealNumObj::eq(NumObj *_r) {
return real == static_cast<RealNumObj*>(_r)->real;
}
@@ -299,6 +317,15 @@ bool RealNumObj::gt(NumObj *_r) {
return real > static_cast<RealNumObj*>(_r)->real;
}
+bool RealNumObj::le(NumObj *_r) {
+ return real <= static_cast<RealNumObj*>(_r)->real;
+}
+
+bool RealNumObj::ge(NumObj *_r) {
+ return real >= static_cast<RealNumObj*>(_r)->real;
+}
+
+
ReprCons *RealNumObj::get_repr_cons() {
return new ReprStr(double_to_str(real));
}
@@ -310,6 +337,7 @@ RatNumObj::RatNumObj(int _a, int _b) :
ExactNumObj(NUM_LVL_RAT), a(_a), b(_b) {
if (b == 0)
throw NormalError(RUN_ERR_NUMERIC_OVERFLOW);
+ if (b < 0) a = -a, b = -b;
int g = gcd(a, b);
a /= g;
b /= g;
@@ -444,6 +472,25 @@ bool RatNumObj::gt(NumObj *_r) {
#endif
}
+bool RatNumObj::le(NumObj *_r) {
+ RatNumObj *r = static_cast<RatNumObj*>(_r);
+#ifndef GMP_SUPPORT
+ return A * D <= C * B;
+#else
+ return val <= r->val;
+#endif
+}
+
+bool RatNumObj::ge(NumObj *_r) {
+ RatNumObj *r = static_cast<RatNumObj*>(_r);
+#ifndef GMP_SUPPORT
+ return A * D >= C * B;
+#else
+ return val >= r->val;
+#endif
+}
+
+
bool RatNumObj::eq(NumObj *_r) {
RatNumObj *r = static_cast<RatNumObj*>(_r);
#ifndef GMP_SUPPORT
@@ -453,6 +500,14 @@ bool RatNumObj::eq(NumObj *_r) {
#endif
}
+NumObj *RatNumObj::abs() {
+#ifndef GMP_SUPPORT
+ return new RatNumObj((a > 0 ? a : -a), b);
+#else
+ return new RatNumObj(std::abs(val));
+#endif
+}
+
ReprCons *RatNumObj::get_repr_cons() {
#ifndef GMP_SUPPORT
return new ReprStr(int_to_str(A) + "/" + int_to_str(B));
@@ -523,6 +578,38 @@ NumObj *IntNumObj::div(NumObj *_r) {
#endif
}
+NumObj *IntNumObj::abs() {
+ return new IntNumObj(std::abs(val));
+}
+
+NumObj *IntNumObj::rem(NumObj *_r) {
+ return new IntNumObj(val % static_cast<IntNumObj*>(_r)->val);
+}
+
+NumObj *IntNumObj::mod(NumObj *_r) {
+ const mpz_class &rval = static_cast<IntNumObj*>(_r)->val;
+ mpz_class ret = val % rval;
+ if (sgn(ret) != sgn(rval))
+ ret = ret + rval;
+ return new IntNumObj(ret);
+}
+
+NumObj *IntNumObj::quo(NumObj *_r) {
+ return new IntNumObj(val / static_cast<IntNumObj*>(_r)->val);
+}
+
+NumObj *IntNumObj::gcd(NumObj *_r) {
+ mpz_t g;
+ mpz_gcd(g, val.get_mpz_t(), static_cast<IntNumObj*>(_r)->val.get_mpz_t());
+ return new IntNumObj(mpz_class(g));
+}
+
+NumObj *IntNumObj::lcm(NumObj *_r) {
+ mpz_t l;
+ mpz_lcm(l, val.get_mpz_t(), static_cast<IntNumObj*>(_r)->val.get_mpz_t());
+ return new IntNumObj(mpz_class(l));
+}
+
bool IntNumObj::lt(NumObj *_r) {
return val < static_cast<IntNumObj*>(_r)->val;
}
@@ -531,6 +618,15 @@ bool IntNumObj::gt(NumObj *_r) {
return val > static_cast<IntNumObj*>(_r)->val;
}
+bool IntNumObj::le(NumObj *_r) {
+ return val <= static_cast<IntNumObj*>(_r)->val;
+}
+
+bool IntNumObj::ge(NumObj *_r) {
+ return val >= static_cast<IntNumObj*>(_r)->val;
+}
+
+
bool IntNumObj::eq(NumObj *_r) {
return val == static_cast<IntNumObj*>(_r)->val;
}
@@ -1046,6 +1142,57 @@ BUILTIN_PROC_DEF(num_div) {
return res;
}
+BUILTIN_PROC_DEF(num_le) {
+ if (args == empty_list)
+ return new BoolObj(true);
+ // zero arguments
+ if (!args->car->is_num_obj())
+ throw TokenError("a number", RUN_ERR_WRONG_TYPE);
+
+ NumObj *last = static_cast<NumObj*>(args->car), *opr;
+ args = TO_PAIR(args->cdr);
+ for (; args != empty_list; args = TO_PAIR(args->cdr), last = opr)
+ {
+ if (!args->car->is_num_obj()) // not a number
+ throw TokenError("a number", RUN_ERR_WRONG_TYPE);
+ opr = static_cast<NumObj*>(args->car);
+ // upper type conversion
+ if (last->level < opr->level)
+ opr = last->convert(opr);
+ else
+ last = opr->convert(last);
+ if (!last->le(opr))
+ return new BoolObj(false);
+ }
+ return new BoolObj(true);
+}
+
+BUILTIN_PROC_DEF(num_ge) {
+ if (args == empty_list)
+ return new BoolObj(true);
+ // zero arguments
+ if (!args->car->is_num_obj())
+ throw TokenError("a number", RUN_ERR_WRONG_TYPE);
+
+ NumObj *last = static_cast<NumObj*>(args->car), *opr;
+ args = TO_PAIR(args->cdr);
+ for (; args != empty_list; args = TO_PAIR(args->cdr), last = opr)
+ {
+ if (!args->car->is_num_obj()) // not a number
+ throw TokenError("a number", RUN_ERR_WRONG_TYPE);
+ opr = static_cast<NumObj*>(args->car);
+ // upper type conversion
+ if (last->level < opr->level)
+ opr = last->convert(opr);
+ else
+ last = opr->convert(last);
+ if (!last->ge(opr))
+ return new BoolObj(false);
+ }
+ return new BoolObj(true);
+}
+
+
BUILTIN_PROC_DEF(num_lt) {
if (args == empty_list)
return new BoolObj(true);
@@ -1481,6 +1628,84 @@ BUILTIN_PROC_DEF(is_integer) {
static_cast<NumObj*>(args->car)->level >= NUM_LVL_INT);
}
+BUILTIN_PROC_DEF(num_abs) {
+ ARGS_EXACTLY_ONE;
+ if (!args->car->is_num_obj())
+ throw TokenError("a number", RUN_ERR_WRONG_TYPE);
+ return static_cast<NumObj*>(args->car)->abs();
+}
+
+BUILTIN_PROC_DEF(num_mod) {
+ ARGS_EXACTLY_TWO;
+ NumObj* a = static_cast<NumObj*>(args->car);
+ NumObj* b = static_cast<NumObj*>(TO_PAIR(args->cdr)->car);
+ if (a->level != NUM_LVL_INT || b->level != NUM_LVL_INT)
+ throw TokenError("an integer", RUN_ERR_WRONG_TYPE);
+ return static_cast<IntNumObj*>(a)->mod(b);
+}
+
+BUILTIN_PROC_DEF(num_rem) {
+ ARGS_EXACTLY_TWO;
+ NumObj* a = static_cast<NumObj*>(args->car);
+ NumObj* b = static_cast<NumObj*>(TO_PAIR(args->cdr)->car);
+ if (a->level != NUM_LVL_INT || b->level != NUM_LVL_INT)
+ throw TokenError("an integer", RUN_ERR_WRONG_TYPE);
+ return static_cast<IntNumObj*>(a)->rem(b);
+}
+
+BUILTIN_PROC_DEF(num_quo) {
+ ARGS_EXACTLY_TWO;
+ NumObj* a = static_cast<NumObj*>(args->car);
+ NumObj* b = static_cast<NumObj*>(TO_PAIR(args->cdr)->car);
+ if (a->level != NUM_LVL_INT || b->level != NUM_LVL_INT)
+ throw TokenError("an integer", RUN_ERR_WRONG_TYPE);
+ return static_cast<IntNumObj*>(a)->quo(b);
+}
+
+BUILTIN_PROC_DEF(num_gcd) {
+// ARGS_AT_LEAST_ONE;
+ NumObj *res = new IntNumObj(0);
+ IntNumObj *opr;
+ for (;args != empty_list; args = TO_PAIR(args->cdr))
+ {
+ if (!args->car->is_num_obj()) // not a number
+ throw TokenError("a number", RUN_ERR_WRONG_TYPE);
+ if (static_cast<NumObj*>(args->car)->level != NUM_LVL_INT) // not a number
+ throw TokenError("an integer", RUN_ERR_WRONG_TYPE);
+
+ opr = static_cast<IntNumObj*>(args->car);
+ res = opr->gcd(res);
+ }
+ return res;
+}
+
+BUILTIN_PROC_DEF(num_lcm) {
+// ARGS_AT_LEAST_ONE;
+ NumObj *res = new IntNumObj(1);
+ IntNumObj *opr;
+ for (;args != empty_list; args = TO_PAIR(args->cdr))
+ {
+ if (!args->car->is_num_obj()) // not a number
+ throw TokenError("a number", RUN_ERR_WRONG_TYPE);
+ if (static_cast<NumObj*>(args->car)->level != NUM_LVL_INT) // not a number
+ throw TokenError("an integer", RUN_ERR_WRONG_TYPE);
+
+ opr = static_cast<IntNumObj*>(args->car);
+ res = opr->lcm(res);
+ }
+ return res;
+}
+
+BUILTIN_PROC_DEF(is_string) {
+ ARGS_AT_LEAST_ONE;
+ return new BoolObj(args->car->is_str_obj());
+}
+
+BUILTIN_PROC_DEF(is_symbol) {
+ ARGS_AT_LEAST_ONE;
+ return new BoolObj(args->car->is_sym_obj());
+}
+
BUILTIN_PROC_DEF(display) {
ARGS_EXACTLY_ONE;
diff --git a/builtin.h b/builtin.h
index d7721a8..3285db7 100644
--- a/builtin.h
+++ b/builtin.h
@@ -37,8 +37,6 @@ class CompNumObj: public InexactNumObj {
NumObj *sub(NumObj *r);
NumObj *mul(NumObj *r);
NumObj *div(NumObj *r);
- bool lt(NumObj *r);
- bool gt(NumObj *r);
bool eq(NumObj *r);
ReprCons *get_repr_cons();
};
@@ -62,8 +60,11 @@ class RealNumObj: public InexactNumObj {
NumObj *sub(NumObj *r);
NumObj *mul(NumObj *r);
NumObj *div(NumObj *r);
+ NumObj *abs();
bool lt(NumObj *r);
bool gt(NumObj *r);
+ bool le(NumObj *r);
+ bool ge(NumObj *r);
bool eq(NumObj *r);
ReprCons *get_repr_cons();
@@ -102,8 +103,11 @@ class RatNumObj: public ExactNumObj {
NumObj *sub(NumObj *r);
NumObj *mul(NumObj *r);
NumObj *div(NumObj *r);
+ NumObj *abs();
bool lt(NumObj *r);
bool gt(NumObj *r);
+ bool le(NumObj *r);
+ bool ge(NumObj *r);
bool eq(NumObj *r);
ReprCons *get_repr_cons();
};
@@ -135,8 +139,16 @@ class IntNumObj: public ExactNumObj {
NumObj *sub(NumObj *r);
NumObj *mul(NumObj *r);
NumObj *div(NumObj *r);
+ NumObj *abs();
+ NumObj *mod(NumObj *r);
+ NumObj *rem(NumObj *r);
+ NumObj *quo(NumObj *r);
+ NumObj *gcd(NumObj *r);
+ NumObj *lcm(NumObj *r);
bool lt(NumObj *r);
bool gt(NumObj *r);
+ bool le(NumObj *r);
+ bool ge(NumObj *r);
bool eq(NumObj *r);
ReprCons *get_repr_cons();
};
@@ -257,7 +269,9 @@ BUILTIN_PROC_DEF(num_mul);
BUILTIN_PROC_DEF(num_div);
BUILTIN_PROC_DEF(num_lt);
+BUILTIN_PROC_DEF(num_le);
BUILTIN_PROC_DEF(num_gt);
+BUILTIN_PROC_DEF(num_ge);
BUILTIN_PROC_DEF(num_eq);
BUILTIN_PROC_DEF(num_is_exact);
@@ -267,6 +281,12 @@ BUILTIN_PROC_DEF(is_complex);
BUILTIN_PROC_DEF(is_real);
BUILTIN_PROC_DEF(is_rational);
BUILTIN_PROC_DEF(is_integer);
+BUILTIN_PROC_DEF(num_abs);
+BUILTIN_PROC_DEF(num_mod);
+BUILTIN_PROC_DEF(num_rem);
+BUILTIN_PROC_DEF(num_quo);
+BUILTIN_PROC_DEF(num_gcd);
+BUILTIN_PROC_DEF(num_lcm);
BUILTIN_PROC_DEF(bool_not);
BUILTIN_PROC_DEF(is_boolean);
@@ -289,6 +309,8 @@ BUILTIN_PROC_DEF(is_eqv);
BUILTIN_PROC_DEF(is_equal);
BUILTIN_PROC_DEF(display);
+BUILTIN_PROC_DEF(is_string);
+BUILTIN_PROC_DEF(is_symbol);
#endif
diff --git a/eval.cpp b/eval.cpp
index 369a150..6e56eb4 100644
--- a/eval.cpp
+++ b/eval.cpp
@@ -29,7 +29,9 @@ void Evaluator::add_builtin_routines() {
ADD_BUILTIN_PROC("/", num_div);
ADD_BUILTIN_PROC("<", num_lt);
+ ADD_BUILTIN_PROC("<=", num_le);
ADD_BUILTIN_PROC(">", num_gt);
+ ADD_BUILTIN_PROC(">=", num_ge);
ADD_BUILTIN_PROC("=", num_eq);
ADD_BUILTIN_PROC("exact?", num_is_exact);
@@ -39,6 +41,13 @@ void Evaluator::add_builtin_routines() {
ADD_BUILTIN_PROC("real?", is_real);
ADD_BUILTIN_PROC("rational?", is_rational);
ADD_BUILTIN_PROC("integer?", is_integer);
+ ADD_BUILTIN_PROC("abs", num_abs);
+ ADD_BUILTIN_PROC("modulo", num_mod);
+ ADD_BUILTIN_PROC("remainder", num_rem);
+ ADD_BUILTIN_PROC("quotient", num_quo);
+ ADD_BUILTIN_PROC("gcd", num_gcd);
+ ADD_BUILTIN_PROC("lcm", num_lcm);
+
ADD_BUILTIN_PROC("not", bool_not);
ADD_BUILTIN_PROC("boolean?", is_boolean);
@@ -62,6 +71,8 @@ void Evaluator::add_builtin_routines() {
ADD_BUILTIN_PROC("equal?", is_equal);
ADD_BUILTIN_PROC("display", display);
+ ADD_BUILTIN_PROC("string?", is_string);
+ ADD_BUILTIN_PROC("symbol?", is_symbol);
}
Evaluator::Evaluator() {
diff --git a/model.cpp b/model.cpp
index bbb4d75..7434690 100644
--- a/model.cpp
+++ b/model.cpp
@@ -51,6 +51,10 @@ bool EvalObj::is_bool_obj() {
return otype & CLS_BOOL_OBJ;
}
+bool EvalObj::is_str_obj() {
+ return otype & CLS_STR_OBJ;
+}
+
int EvalObj::get_otype() {
return otype;
}
diff --git a/model.h b/model.h
index ddbe2ee..0b7ac19 100644
--- a/model.h
+++ b/model.h
@@ -106,6 +106,7 @@ class EvalObj : public FrameObj {
bool is_num_obj();
/** Check if the object is a boolean */
bool is_bool_obj();
+ bool is_str_obj();
int get_otype();
virtual void prepare(Pair *pc);
/** Any EvalObj has its external representation */
@@ -329,8 +330,12 @@ class NumObj: public EvalObj {
virtual NumObj *sub(NumObj *r) = 0;
virtual NumObj *mul(NumObj *r) = 0;
virtual NumObj *div(NumObj *r) = 0;
- virtual bool lt(NumObj *r) = 0;
- virtual bool gt(NumObj *r) = 0;
+ virtual NumObj *abs();
+
+ virtual bool lt(NumObj *r);
+ virtual bool gt(NumObj *r);
+ virtual bool le(NumObj *r);
+ virtual bool ge(NumObj *r);
virtual bool eq(NumObj *r) = 0;
};