diff options
| -rw-r--r-- | builtin.cpp | 260 | ||||
| -rw-r--r-- | builtin.h | 38 | ||||
| -rw-r--r-- | eval.cpp | 7 | ||||
| -rw-r--r-- | model.cpp | 2 | ||||
| -rw-r--r-- | model.h | 5 |
5 files changed, 247 insertions, 65 deletions
diff --git a/builtin.cpp b/builtin.cpp index 6c58d96..26bbc9d 100644 --- a/builtin.cpp +++ b/builtin.cpp @@ -46,7 +46,7 @@ double str_to_double(string repr, bool &flag) { int gcd(int a, int b) { int t; while (b) t = b, b = a % b, a = t; - return a; + return abs(a); } @@ -115,33 +115,42 @@ CompNumObj *CompNumObj::convert(NumObj *obj) { #define D (r->imag) NumObj *CompNumObj::plus(NumObj *_r) { - CompNumObj *r = CompNumObj::convert(_r); + CompNumObj *r = static_cast<CompNumObj*>(_r); return new CompNumObj(A + C, B + D); } NumObj *CompNumObj::minus(NumObj *_r) { - CompNumObj *r = CompNumObj::convert(_r); + CompNumObj *r = static_cast<CompNumObj*>(_r); return new CompNumObj(A - C, B - D); } NumObj *CompNumObj::multi(NumObj *_r) { - CompNumObj *r = CompNumObj::convert(_r); + CompNumObj *r = static_cast<CompNumObj*>(_r); return new CompNumObj(A * C - B * D, B * C + A * D); } NumObj *CompNumObj::div(NumObj *_r) { - CompNumObj *r = CompNumObj::convert(_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); } -BoolObj *CompNumObj::eq(NumObj *_r) { - CompNumObj *r = CompNumObj::convert(_r); - return new BoolObj(A == C && B == D); // TODO: more proper judgement +bool CompNumObj::lt(NumObj *_r) { + throw TokenError("a comparable number", RUN_ERR_WRONG_TYPE); } +bool CompNumObj::gt(NumObj *_r) { + throw TokenError("a comparable 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 +} + + string CompNumObj::ext_repr() { return double_to_str(real) + double_to_str(imag, true) + "i"; } @@ -178,38 +187,38 @@ RealNumObj *RealNumObj::convert(NumObj *obj) { } NumObj *RealNumObj::plus(NumObj *_r) { - return new RealNumObj(real + RealNumObj::convert(_r)->real); + return new RealNumObj(real + static_cast<RealNumObj*>(_r)->real); } NumObj *RealNumObj::minus(NumObj *_r) { - return new RealNumObj(real - RealNumObj::convert(_r)->real); + return new RealNumObj(real - static_cast<RealNumObj*>(_r)->real); } NumObj *RealNumObj::multi(NumObj *_r) { - return new RealNumObj(real * RealNumObj::convert(_r)->real); + return new RealNumObj(real * static_cast<RealNumObj*>(_r)->real); } NumObj *RealNumObj::div(NumObj *_r) { - return new RealNumObj(real / RealNumObj::convert(_r)->real); + return new RealNumObj(real / static_cast<RealNumObj*>(_r)->real); } -BoolObj *RealNumObj::eq(NumObj *_r) { - return new BoolObj(real == RealNumObj::convert(_r)->real); +bool RealNumObj::eq(NumObj *_r) { + return real == static_cast<RealNumObj*>(_r)->real; } -BoolObj *RealNumObj::lt(NumObj *_r) { - return new BoolObj(real < RealNumObj::convert(_r)->real); +bool RealNumObj::lt(NumObj *_r) { + return real < static_cast<RealNumObj*>(_r)->real; } -BoolObj *RealNumObj::gt(NumObj *_r) { - return new BoolObj(real > RealNumObj::convert(_r)->real); +bool RealNumObj::gt(NumObj *_r) { + return real > static_cast<RealNumObj*>(_r)->real; } string RealNumObj::ext_repr() { return double_to_str(real); } -ExactNumObj::ExactNumObj(NumLvl level) : NumObj(level, false) {} +ExactNumObj::ExactNumObj(NumLvl level) : NumObj(level, true) {} RatNumObj::RatNumObj(int _a, int _b) : ExactNumObj(NUM_LVL_RAT), a(_a), b(_b) { @@ -242,7 +251,7 @@ RatNumObj *RatNumObj::convert(NumObj *obj) { #define D (r->b) NumObj *RatNumObj::plus(NumObj *_r) { - RatNumObj *r = RatNumObj::convert(_r); + RatNumObj *r = static_cast<RatNumObj*>(_r); int na = A * D + B * C, nb = B * D; int g = gcd(na, nb); na /= g; @@ -251,7 +260,7 @@ NumObj *RatNumObj::plus(NumObj *_r) { } NumObj *RatNumObj::minus(NumObj *_r) { - RatNumObj *r = RatNumObj::convert(_r); + RatNumObj *r = static_cast<RatNumObj*>(_r); int na = A * D - B * C, nb = B * D; int g = gcd(na, nb); na /= g; @@ -260,7 +269,7 @@ NumObj *RatNumObj::minus(NumObj *_r) { } NumObj *RatNumObj::multi(NumObj *_r) { - RatNumObj *r = RatNumObj::convert(_r); + RatNumObj *r = static_cast<RatNumObj*>(_r); int na = A * C, nb = B * D; int g = gcd(na, nb); na /= g; @@ -269,7 +278,7 @@ NumObj *RatNumObj::multi(NumObj *_r) { } NumObj *RatNumObj::div(NumObj *_r) { - RatNumObj *r = RatNumObj::convert(_r); + RatNumObj *r = static_cast<RatNumObj*>(_r); int na = A * D, nb = B * C; int g = gcd(na, nb); na /= g; @@ -277,19 +286,19 @@ NumObj *RatNumObj::div(NumObj *_r) { return new RatNumObj(na, nb); } -BoolObj *RatNumObj::lt(NumObj *_r) { - RatNumObj *r = RatNumObj::convert(_r); - return new BoolObj(A * D < C * B); +bool RatNumObj::lt(NumObj *_r) { + RatNumObj *r = static_cast<RatNumObj*>(_r); + return A * D < C * B; } -BoolObj *RatNumObj::gt(NumObj *_r) { - RatNumObj *r = RatNumObj::convert(_r); - return new BoolObj(A * D > C * B); +bool RatNumObj::gt(NumObj *_r) { + RatNumObj *r = static_cast<RatNumObj*>(_r); + return A * D > C * B; } -BoolObj *RatNumObj::eq(NumObj *_r) { - RatNumObj *r = RatNumObj::convert(_r); - return new BoolObj(A * D == C * B); +bool RatNumObj::eq(NumObj *_r) { + RatNumObj *r = static_cast<RatNumObj*>(_r); + return A * D == C * B; } string RatNumObj::ext_repr() { @@ -321,31 +330,31 @@ IntNumObj *IntNumObj::convert(NumObj *obj) { NumObj *IntNumObj::plus(NumObj *_r) { - return new IntNumObj(val + IntNumObj::convert(_r)->val); + return new IntNumObj(val + static_cast<IntNumObj*>(_r)->val); } NumObj *IntNumObj::minus(NumObj *_r) { - return new IntNumObj(val - IntNumObj::convert(_r)->val); + return new IntNumObj(val - static_cast<IntNumObj*>(_r)->val); } NumObj *IntNumObj::multi(NumObj *_r) { - return new IntNumObj(val * IntNumObj::convert(_r)->val); + return new IntNumObj(val * static_cast<IntNumObj*>(_r)->val); } NumObj *IntNumObj::div(NumObj *_r) { - return new IntNumObj(val / IntNumObj::convert(_r)->val); + return new IntNumObj(val / static_cast<IntNumObj*>(_r)->val); } -BoolObj *IntNumObj::lt(NumObj *_r) { - return new BoolObj(val < IntNumObj::convert(_r)->val); +bool IntNumObj::lt(NumObj *_r) { + return val < static_cast<IntNumObj*>(_r)->val; } -BoolObj *IntNumObj::gt(NumObj *_r) { - return new BoolObj(val > IntNumObj::convert(_r)->val); +bool IntNumObj::gt(NumObj *_r) { + return val > static_cast<IntNumObj*>(_r)->val; } -BoolObj *IntNumObj::eq(NumObj *_r) { - return new BoolObj(val == IntNumObj::convert(_r)->val); +bool IntNumObj::eq(NumObj *_r) { + return val == static_cast<IntNumObj*>(_r)->val; } string IntNumObj::ext_repr() { @@ -599,17 +608,174 @@ EvalObj *builtin_plus(ArgList *args) { for (Cons *ptr = args; ptr != empty_list; ptr = TO_CONS(ptr->cdr)) { if (!ptr->car->is_num_obj()) // not a number - throw TokenError(ptr->car->ext_repr(), RUN_ERR_WRONG_TYPE); + throw TokenError("a number", RUN_ERR_WRONG_TYPE); + opr = static_cast<NumObj*>(ptr->car); + NumObj *_res = res; + if (_res->level < opr->level) + opr = _res->convert(opr); + else + _res = opr->convert(_res); + res = _res->plus(opr); + } + return res; +} + +EvalObj *builtin_minus(ArgList *args) { + if (args == empty_list) + throw TokenError("-", RUN_ERR_WRONG_NUM_OF_ARGS); + if (!args->car->is_num_obj()) + throw TokenError("a number", RUN_ERR_WRONG_TYPE); + + NumObj *res = static_cast<NumObj*>(args->car), *opr; + for (Cons *ptr = TO_CONS(args->cdr); + ptr != empty_list; ptr = TO_CONS(ptr->cdr)) + { + if (!ptr->car->is_num_obj()) // not a number + throw TokenError("a number", RUN_ERR_WRONG_TYPE); + opr = static_cast<NumObj*>(ptr->car); + // upper type conversion + NumObj *_res = res; + if (_res->level < opr->level) + opr = _res->convert(opr); + else + _res = opr->convert(_res); + res = _res->minus(opr); + } + return res; +} + +EvalObj *builtin_multi(ArgList *args) { + NumObj *res = new IntNumObj(1), *opr; // the most accurate type + for (Cons *ptr = args; ptr != empty_list; ptr = TO_CONS(ptr->cdr)) + { + if (!ptr->car->is_num_obj()) // not a number + throw TokenError("a number", RUN_ERR_WRONG_TYPE); + opr = static_cast<NumObj*>(ptr->car); + NumObj *_res = res; + if (_res->level < opr->level) + opr = _res->convert(opr); + else + _res = opr->convert(_res); + res = _res->multi(opr); + } + return res; +} + +EvalObj *builtin_div(ArgList *args) { + if (args == empty_list) + throw TokenError("/", RUN_ERR_WRONG_NUM_OF_ARGS); + if (!args->car->is_num_obj()) + throw TokenError("a number", RUN_ERR_WRONG_TYPE); + + NumObj *res = static_cast<NumObj*>(args->car), *opr; + for (Cons *ptr = TO_CONS(args->cdr); + ptr != empty_list; ptr = TO_CONS(ptr->cdr)) + { + if (!ptr->car->is_num_obj()) // not a number + throw TokenError("a number", RUN_ERR_WRONG_TYPE); opr = static_cast<NumObj*>(ptr->car); - if (res->level < opr->level) - // upper type conversion - res = res->plus(opr); + // upper type conversion + NumObj *_res = res; + if (_res->level < opr->level) + opr = _res->convert(opr); else - res = opr->plus(res); + _res = opr->convert(_res); + res = _res->div(opr); } return res; } +EvalObj *builtin_lt(ArgList *args) { + if (args == empty_list) + throw TokenError("<", RUN_ERR_WRONG_NUM_OF_ARGS); + 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); + ptr != empty_list; ptr = TO_CONS(ptr->cdr), last = opr) + { + if (!ptr->car->is_num_obj()) // not a number + throw TokenError("a number", RUN_ERR_WRONG_TYPE); + opr = static_cast<NumObj*>(ptr->car); + // upper type conversion + if (last->level < opr->level) + opr = last->convert(opr); + else + last = opr->convert(last); + if (!last->lt(opr)) + return new BoolObj(false); + } + return new BoolObj(true); +} + +EvalObj *builtin_gt(ArgList *args) { + if (args == empty_list) + throw TokenError(">", RUN_ERR_WRONG_NUM_OF_ARGS); + 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); + ptr != empty_list; ptr = TO_CONS(ptr->cdr), last = opr) + { + if (!ptr->car->is_num_obj()) // not a number + throw TokenError("a number", RUN_ERR_WRONG_TYPE); + opr = static_cast<NumObj*>(ptr->car); + // upper type conversion + if (last->level < opr->level) + opr = last->convert(opr); + else + last = opr->convert(last); + if (!last->gt(opr)) + return new BoolObj(false); + } + return new BoolObj(true); +} + +EvalObj *builtin_arithmetic_eq(ArgList *args) { + if (args == empty_list) + throw TokenError("=", RUN_ERR_WRONG_NUM_OF_ARGS); + 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); + ptr != empty_list; ptr = TO_CONS(ptr->cdr), last = opr) + { + if (!ptr->car->is_num_obj()) // not a number + throw TokenError("a number", RUN_ERR_WRONG_TYPE); + opr = static_cast<NumObj*>(ptr->car); + // upper type conversion + if (last->level < opr->level) + opr = last->convert(opr); + else + last = opr->convert(last); + if (!last->eq(opr)) + return new BoolObj(false); + } + return new BoolObj(true); +} + + +EvalObj *builtin_exact(ArgList *args) { + if (args == empty_list || + args->cdr != empty_list) + throw TokenError("(in)exact?", RUN_ERR_WRONG_NUM_OF_ARGS); + if (!args->car->is_num_obj()) + throw TokenError("a number", RUN_ERR_WRONG_TYPE); + return new BoolObj(static_cast<NumObj*>(args->car)->is_exact()); +} + +EvalObj *builtin_inexact(ArgList *args) { + BoolObj *ret = static_cast<BoolObj*>(builtin_exact(args)); + ret->val = !ret->val; + return ret; +} + EvalObj *builtin_display(ArgList *args) { printf("%s\n", args->car->ext_repr().c_str()); @@ -30,13 +30,15 @@ class CompNumObj: public InexactNumObj { */ static CompNumObj *from_string(string repr); /** Convert to a complex number from other numeric types */ - static CompNumObj *convert(NumObj* obj); + CompNumObj *convert(NumObj* obj); NumObj *plus(NumObj *r); NumObj *minus(NumObj *r); NumObj *multi(NumObj *r); NumObj *div(NumObj *r); - BoolObj *eq(NumObj *r); + bool lt(NumObj *r); + bool gt(NumObj *r); + bool eq(NumObj *r); string ext_repr(); }; @@ -53,15 +55,15 @@ class RealNumObj: public InexactNumObj { */ static RealNumObj *from_string(string repr); /** Convert to a real number from other numeric types */ - static RealNumObj *convert(NumObj* obj); + RealNumObj *convert(NumObj* obj); NumObj *plus(NumObj *r); NumObj *minus(NumObj *r); NumObj *multi(NumObj *r); NumObj *div(NumObj *r); - BoolObj *lt(NumObj *r); - BoolObj *gt(NumObj *r); - BoolObj *eq(NumObj *r); + bool lt(NumObj *r); + bool gt(NumObj *r); + bool eq(NumObj *r); string ext_repr(); }; @@ -88,15 +90,15 @@ class RatNumObj: public ExactNumObj { */ static RatNumObj *from_string(string repr); /** Convert to a Rational number from other numeric types */ - static RatNumObj *convert(NumObj* obj); + RatNumObj *convert(NumObj* obj); NumObj *plus(NumObj *r); NumObj *minus(NumObj *r); NumObj *multi(NumObj *r); NumObj *div(NumObj *r); - BoolObj *lt(NumObj *r); - BoolObj *gt(NumObj *r); - BoolObj *eq(NumObj *r); + bool lt(NumObj *r); + bool gt(NumObj *r); + bool eq(NumObj *r); string ext_repr(); }; @@ -113,15 +115,15 @@ class IntNumObj: public ExactNumObj { */ static IntNumObj *from_string(string repr); /** Convert to a integer from other numeric types */ - static IntNumObj *convert(NumObj* obj); + IntNumObj *convert(NumObj* obj); NumObj *plus(NumObj *r); NumObj *minus(NumObj *r); NumObj *multi(NumObj *r); NumObj *div(NumObj *r); - BoolObj *lt(NumObj *r); - BoolObj *gt(NumObj *r); - BoolObj *eq(NumObj *r); + bool lt(NumObj *r); + bool gt(NumObj *r); + bool eq(NumObj *r); string ext_repr(); }; @@ -190,6 +192,14 @@ class SpecialOptSet: public SpecialOptObj { }; EvalObj *builtin_plus(ArgList *); +EvalObj *builtin_minus(ArgList *); +EvalObj *builtin_multi(ArgList *); +EvalObj *builtin_div(ArgList *); +EvalObj *builtin_exact(ArgList *); +EvalObj *builtin_inexact(ArgList *); +EvalObj *builtin_lt(ArgList *); +EvalObj *builtin_gt(ArgList *); +EvalObj *builtin_arithmetic_eq(ArgList *); EvalObj *builtin_display(ArgList *); EvalObj *builtin_cons(ArgList *); @@ -14,18 +14,19 @@ void Evaluator::add_builtin_routines() { envt->add_binding(new SymObj(name), rout) ADD_ENTRY("+", new BuiltinProcObj(builtin_plus, "+")); -/* ADD_ENTRY("-", new BuiltinProcObj(builtin_minus, "-")); - ADD_ENTRY("*", new BuiltinProcObj(builtin_times, "*")); + ADD_ENTRY("-", new BuiltinProcObj(builtin_minus, "-")); + ADD_ENTRY("*", new BuiltinProcObj(builtin_multi, "*")); ADD_ENTRY("/", new BuiltinProcObj(builtin_div, "/")); ADD_ENTRY(">", new BuiltinProcObj(builtin_gt, ">")); ADD_ENTRY("<", new BuiltinProcObj(builtin_lt, "<")); ADD_ENTRY("=", new BuiltinProcObj(builtin_arithmetic_eq, "=")); - */ ADD_ENTRY("display", new BuiltinProcObj(builtin_display, "display")); ADD_ENTRY("cons", new BuiltinProcObj(builtin_cons, "cons")); ADD_ENTRY("car", new BuiltinProcObj(builtin_car, "car")); ADD_ENTRY("cdr", new BuiltinProcObj(builtin_cdr, "cdr")); ADD_ENTRY("list", new BuiltinProcObj(builtin_list, "list")); + ADD_ENTRY("exact?", new BuiltinProcObj(builtin_exact, "exact?")); + ADD_ENTRY("inexact?", new BuiltinProcObj(builtin_inexact, "inexact?")); ADD_ENTRY("if", new SpecialOptIf()); ADD_ENTRY("lambda", new SpecialOptLambda()); ADD_ENTRY("define", new SpecialOptDefine()); @@ -159,6 +159,8 @@ string BoolObj::ext_repr() { return string(val ? "#t" : "#f"); } NumObj::NumObj(NumLvl _level, bool _exactness) : EvalObj(CLS_SIM_OBJ | CLS_NUM_OBJ), level(_level), exactness(_exactness) {} +bool NumObj::is_exact() { return exactness; } + BuiltinProcObj::BuiltinProcObj(BuiltinProc f, string _name) : OptObj(), handler(f), name(_name) {} @@ -280,11 +280,14 @@ class NumObj: public EvalObj { */ NumObj(NumLvl level, bool _exactness); bool is_exact(); + virtual NumObj *convert(NumObj *r) = 0; virtual NumObj *plus(NumObj *r) = 0; virtual NumObj *minus(NumObj *r) = 0; virtual NumObj *multi(NumObj *r) = 0; virtual NumObj *div(NumObj *r) = 0; - virtual BoolObj *eq(NumObj *r) = 0; + virtual bool lt(NumObj *r) = 0; + virtual bool gt(NumObj *r) = 0; + virtual bool eq(NumObj *r) = 0; }; typedef map<string, EvalObj*> Str2EvalObj; |