more built-ins

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;
 };