From 2729f71c327f8ef4ddbb620dc486e7334ba40119 Mon Sep 17 00:00:00 2001 From: Teddy Date: Sat, 10 Aug 2013 23:42:42 +0800 Subject: more built-ins --- Makefile | 2 +- TODO.rst | 9 +++ builtin.cpp | 229 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++- builtin.h | 26 ++++++- eval.cpp | 11 +++ model.cpp | 4 ++ model.h | 9 ++- 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>=? + - 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 #include #include +#include #include 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(_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(_r)->real); } +NumObj *RealNumObj::abs() { + return new RealNumObj(fabs(real)); +} + bool RealNumObj::eq(NumObj *_r) { return real == static_cast(_r)->real; } @@ -299,6 +317,15 @@ bool RealNumObj::gt(NumObj *_r) { return real > static_cast(_r)->real; } +bool RealNumObj::le(NumObj *_r) { + return real <= static_cast(_r)->real; +} + +bool RealNumObj::ge(NumObj *_r) { + return real >= static_cast(_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(_r); +#ifndef GMP_SUPPORT + return A * D <= C * B; +#else + return val <= r->val; +#endif +} + +bool RatNumObj::ge(NumObj *_r) { + RatNumObj *r = static_cast(_r); +#ifndef GMP_SUPPORT + return A * D >= C * B; +#else + return val >= r->val; +#endif +} + + bool RatNumObj::eq(NumObj *_r) { RatNumObj *r = static_cast(_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(_r)->val); +} + +NumObj *IntNumObj::mod(NumObj *_r) { + const mpz_class &rval = static_cast(_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(_r)->val); +} + +NumObj *IntNumObj::gcd(NumObj *_r) { + mpz_t g; + mpz_gcd(g, val.get_mpz_t(), static_cast(_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(_r)->val.get_mpz_t()); + return new IntNumObj(mpz_class(l)); +} + bool IntNumObj::lt(NumObj *_r) { return val < static_cast(_r)->val; } @@ -531,6 +618,15 @@ bool IntNumObj::gt(NumObj *_r) { return val > static_cast(_r)->val; } +bool IntNumObj::le(NumObj *_r) { + return val <= static_cast(_r)->val; +} + +bool IntNumObj::ge(NumObj *_r) { + return val >= static_cast(_r)->val; +} + + bool IntNumObj::eq(NumObj *_r) { return val == static_cast(_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(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(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(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(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(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(args->car)->abs(); +} + +BUILTIN_PROC_DEF(num_mod) { + ARGS_EXACTLY_TWO; + NumObj* a = static_cast(args->car); + NumObj* b = static_cast(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(a)->mod(b); +} + +BUILTIN_PROC_DEF(num_rem) { + ARGS_EXACTLY_TWO; + NumObj* a = static_cast(args->car); + NumObj* b = static_cast(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(a)->rem(b); +} + +BUILTIN_PROC_DEF(num_quo) { + ARGS_EXACTLY_TWO; + NumObj* a = static_cast(args->car); + NumObj* b = static_cast(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(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(args->car)->level != NUM_LVL_INT) // not a number + throw TokenError("an integer", RUN_ERR_WRONG_TYPE); + + opr = static_cast(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(args->car)->level != NUM_LVL_INT) // not a number + throw TokenError("an integer", RUN_ERR_WRONG_TYPE); + + opr = static_cast(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; }; -- cgit v1.2.3-70-g09d2