diff options
| -rw-r--r-- | builtin.cpp | 151 | ||||
| -rw-r--r-- | main.cpp | 5 | ||||
| -rw-r--r-- | test/q.scm | 18 | ||||
| -rw-r--r-- | types.cpp | 23 | ||||
| -rw-r--r-- | types.h | 6 |
5 files changed, 128 insertions, 75 deletions
diff --git a/builtin.cpp b/builtin.cpp index 2cd738a..4116501 100644 --- a/builtin.cpp +++ b/builtin.cpp @@ -113,10 +113,10 @@ do \ throw TokenError("a number", RUN_ERR_WRONG_TYPE); \ } while (0) -#define CHECK_INT(ptr) \ +#define CHECK_EXACT(ptr) \ do \ { \ - if ((ptr)->level != NUM_LVL_INT) \ + if (!(static_cast<NumObj*>(ptr))->is_exact()) \ throw TokenError("an integer", RUN_ERR_WRONG_TYPE); \ } while (0) @@ -1031,18 +1031,23 @@ BUILTIN_PROC_DEF(length) { Pair *copy_list(Pair *src, EvalObj * &tail) { if (src == empty_list) + { + puts("oops"); throw NormalError(INT_ERR); + } EvalObj* nptr; Pair head(NULL, NULL); tail = &head; for (;;) { - TO_PAIR(tail)->cdr = new Pair(*src); + gc.attach(TO_PAIR(tail)->cdr = new Pair(*src)); tail = TO_PAIR(TO_PAIR(tail)->cdr); + gc.attach(TO_PAIR(tail)->car); if ((nptr = src->cdr)->is_pair_obj()) src = TO_PAIR(nptr); else break; } + gc.attach(TO_PAIR(tail)->cdr); return TO_PAIR(head.cdr); } @@ -1065,9 +1070,9 @@ BUILTIN_PROC_DEF(append) { if (prev->cdr != empty_list) throw TokenError("empty list", RUN_ERR_WRONG_TYPE); if (args->car->is_pair_obj()) - prev->cdr = copy_list(TO_PAIR(args->car), tail); + gc.attach(prev->cdr = copy_list(TO_PAIR(args->car), tail)); else - prev->cdr = args->car; + gc.attach(prev->cdr = args->car); } else throw TokenError("a pair", RUN_ERR_WRONG_TYPE); @@ -1091,10 +1096,11 @@ BUILTIN_PROC_DEF(reverse) { BUILTIN_PROC_DEF(list_tail) { ARGS_EXACTLY_TWO; EvalObj *sec = TO_PAIR(args->cdr)->car; - if (!sec->is_num_obj() || - static_cast<NumObj*>(sec)->level != NUM_LVL_INT) - throw TokenError("an exact integer", RUN_ERR_WRONG_TYPE); - int i, k = static_cast<IntNumObj*>(sec)->get_i(); + CHECK_NUMBER(sec); + CHECK_EXACT(sec); + IntNumObj *val = static_cast<ExactNumObj*>(sec)->to_int(); + int i, k = val->get_i(); + delete val; if (k < 0) throw TokenError("a non-negative integer", RUN_ERR_WRONG_TYPE); EvalObj *ptr; @@ -1311,41 +1317,56 @@ BUILTIN_PROC_DEF(num_abs) { BUILTIN_PROC_DEF(num_mod) { ARGS_EXACTLY_TWO; - CHECK_NUMBER(args->car); - CHECK_NUMBER(TO_PAIR(args->cdr)->car); - NumObj* a = static_cast<NumObj*>(args->car); - NumObj* b = static_cast<NumObj*>(TO_PAIR(args->cdr)->car); - CHECK_INT(a); - CHECK_INT(b); - NumObj* res = a->clone(); - static_cast<IntNumObj*>(res)->mod(b); - return res; + EvalObj *first = args->car, *second = TO_PAIR(args->cdr)->car; + CHECK_NUMBER(first); + CHECK_NUMBER(second); + + CHECK_EXACT(first); + CHECK_EXACT(second); + + IntNumObj *a = static_cast<ExactNumObj*>(first)->to_int(); + IntNumObj *b = static_cast<ExactNumObj*>(second)->to_int(); + + a->mod(b); + + delete b; + return a; } -BUILTIN_PROC_DEF(num_rem) { +BUILTIN_PROC_DEF(num_quo) { ARGS_EXACTLY_TWO; - CHECK_NUMBER(args->car); - CHECK_NUMBER(TO_PAIR(args->cdr)->car); - NumObj* a = static_cast<NumObj*>(args->car); - NumObj* b = static_cast<NumObj*>(TO_PAIR(args->cdr)->car); - CHECK_INT(a); - CHECK_INT(b); - NumObj* res = a->clone(); - static_cast<IntNumObj*>(res)->rem(b); - return res; + EvalObj *first = args->car, *second = TO_PAIR(args->cdr)->car; + CHECK_NUMBER(first); + CHECK_NUMBER(second); + + CHECK_EXACT(first); + CHECK_EXACT(second); + + IntNumObj *a = static_cast<ExactNumObj*>(first)->to_int(); + IntNumObj *b = static_cast<ExactNumObj*>(second)->to_int(); + + a->div(b); + + delete b; + return a; } -BUILTIN_PROC_DEF(num_quo) { +BUILTIN_PROC_DEF(num_rem) { ARGS_EXACTLY_TWO; - CHECK_NUMBER(args->car); - CHECK_NUMBER(TO_PAIR(args->cdr)->car); - NumObj* a = static_cast<NumObj*>(args->car); - NumObj* b = static_cast<NumObj*>(TO_PAIR(args->cdr)->car); - CHECK_INT(a); - CHECK_INT(b); - NumObj* res = a->clone(); - static_cast<IntNumObj*>(res)->div(b); - return res; + EvalObj *first = args->car, *second = TO_PAIR(args->cdr)->car; + CHECK_NUMBER(first); + CHECK_NUMBER(second); + + CHECK_EXACT(first); + CHECK_EXACT(second); + + IntNumObj *a = static_cast<ExactNumObj*>(first)->to_int(); + IntNumObj *b = static_cast<ExactNumObj*>(second)->to_int(); + + a->rem(b); + + delete b; + return a; } BUILTIN_PROC_DEF(num_gcd) { @@ -1354,11 +1375,13 @@ BUILTIN_PROC_DEF(num_gcd) { IntNumObj *opr; for (;args != empty_list; args = TO_PAIR(args->cdr)) { - CHECK_NUMBER(args->car); - CHECK_INT(static_cast<NumObj*>(args->car)); + EvalObj *obj = args->car; + CHECK_NUMBER(obj); + CHECK_EXACT(obj); - opr = static_cast<IntNumObj*>(args->car); + opr = static_cast<ExactNumObj*>(obj)->to_int(); res->gcd(opr); + delete opr; } return res; } @@ -1369,11 +1392,13 @@ BUILTIN_PROC_DEF(num_lcm) { IntNumObj *opr; for (;args != empty_list; args = TO_PAIR(args->cdr)) { - CHECK_NUMBER(args->car); - CHECK_INT(static_cast<NumObj*>(args->car)); + EvalObj *obj = args->car; + CHECK_NUMBER(obj); + CHECK_EXACT(obj); - opr = static_cast<IntNumObj*>(args->car); + opr = static_cast<ExactNumObj*>(obj)->to_int(); res->lcm(opr); + delete opr; } return res; } @@ -1435,11 +1460,12 @@ BUILTIN_PROC_DEF(string_eq) { BUILTIN_PROC_DEF(make_vector) { ARGS_AT_LEAST_ONE; - if (!args->car->is_num_obj()) - throw TokenError("a number", RUN_ERR_WRONG_TYPE); - if (static_cast<NumObj*>(args->car)->level != NUM_LVL_INT) - throw TokenError("an integer", RUN_ERR_WRONG_TYPE); - ssize_t len = static_cast<IntNumObj*>(args->car)->get_i(); + EvalObj *first = args->car; + CHECK_NUMBER(first); + CHECK_EXACT(first); + IntNumObj *val = static_cast<ExactNumObj*>(first)->to_int(); + ssize_t len = val->get_i(); + delete val; if (len < 0) throw TokenError("a non-negative integer", RUN_ERR_WRONG_TYPE); @@ -1467,9 +1493,12 @@ BUILTIN_PROC_DEF(vector_set) { args = TO_PAIR(args->cdr); if (args == empty_list) throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS); - CHECK_NUMBER(args->car); - CHECK_INT(static_cast<NumObj*>(args->car)); - ssize_t k = static_cast<IntNumObj*>(args->car)->get_i(); + EvalObj *second = args->car; + CHECK_NUMBER(second); + CHECK_EXACT(second); + IntNumObj *val = static_cast<ExactNumObj*>(second)->to_int(); + ssize_t k = val->get_i(); + delete val; if (k < 0) throw TokenError("a non-negative integer", RUN_ERR_WRONG_TYPE); @@ -1496,9 +1525,12 @@ BUILTIN_PROC_DEF(vector_ref) { if (args->cdr != empty_list) throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS); - CHECK_NUMBER(args->car); - CHECK_INT(static_cast<NumObj*>(args->car)); - ssize_t k = static_cast<IntNumObj*>(args->car)->get_i(); + EvalObj *second = args->car; + CHECK_NUMBER(second); + CHECK_EXACT(second); + IntNumObj *val = static_cast<ExactNumObj*>(second)->to_int(); + ssize_t k = val->get_i(); + delete val; if (k < 0) throw TokenError("a non-negative integer", RUN_ERR_WRONG_TYPE); return vect->get(k); @@ -1523,9 +1555,12 @@ BUILTIN_PROC_DEF(gc_status) { BUILTIN_PROC_DEF(set_gc_resolve_threshold) { ARGS_EXACTLY_ONE; - CHECK_NUMBER(args->car); - CHECK_INT(static_cast<NumObj*>(args->car)); - ssize_t s = static_cast<IntNumObj*>(args->car)->get_i(); + EvalObj *first = args->car; + CHECK_NUMBER(first); + CHECK_EXACT(first); + IntNumObj *val = static_cast<ExactNumObj*>(first)->to_int(); + ssize_t s = val->get_i(); + delete val; if (s < 0) throw TokenError("a non-negative integer", RUN_ERR_WRONG_TYPE); gc.set_resolve_threshold(size_t(s)); @@ -21,18 +21,19 @@ void load_file(const char *fname) { exit(0); } tk.set_stream(f); + Pair *tree; while (1) { try { - Pair *tree = ast.absorb(&tk); + tree = ast.absorb(&tk); if (!tree) break; EvalObj *ret = eval.run_expr(tree); gc.expose(ret); } catch (GeneralError &e) { - fprintf(stderr, "An error occured: %s\n", e.get_msg().c_str()); + fprintf(stderr, "An error occured near [%s]: %s\n", tree->ext_repr().c_str(), e.get_msg().c_str()); } gc.force(); gc.cycle_resolve(); @@ -68,12 +68,12 @@ (display (queen 8)) -(define shl '()) -(define shr '()) -(define empty-bits '()) -(define res '()) -(define queen '()) -(set-gc-resolve-threshold! 0) ; force cycle resolve -(display "\n") -(display (gc-status)) - +;(define shl '()) +;(define shr '()) +;(define empty-bits '()) +;(define res '()) +;(define queen '()) +;(set-gc-resolve-threshold! 0) ; force cycle resolve +;(display "\n") +;(display (gc-status)) +; @@ -404,6 +404,7 @@ ReprCons *Continuation::get_repr_cons() { ReprCons::ReprCons(bool _done, EvalObj *_ori) : ori(_ori), done(_done) {} ReprStr::ReprStr(string _repr) : ReprCons(true) { repr = _repr; } EvalObj *ReprStr::next(const string &prev) { + fprintf(stderr, "Oops in ReprStr::next\n"); throw NormalError(INT_ERR); } @@ -995,6 +996,12 @@ void RatNumObj::abs() { #endif } +IntNumObj *RatNumObj::to_int() { + if (val.get_den() != 1) + throw TokenError("an integer", RUN_ERR_WRONG_TYPE); + return new IntNumObj(val.get_num()); +} + ReprCons *RatNumObj::get_repr_cons() { #ifndef GMP_SUPPORT return new ReprStr(int_to_str(A) + "/" + int_to_str(B)); @@ -1088,15 +1095,15 @@ void IntNumObj::div(NumObj *_r) { } void IntNumObj::gcd(NumObj *_r) { - mpz_t g; - mpz_gcd(g, val.get_mpz_t(), static_cast<IntNumObj*>(_r)->val.get_mpz_t()); - val = mpz_class(g); + mpz_gcd(val.get_mpz_t(), + val.get_mpz_t(), + static_cast<IntNumObj*>(_r)->val.get_mpz_t()); } void IntNumObj::lcm(NumObj *_r) { - mpz_t l; - mpz_lcm(l, val.get_mpz_t(), static_cast<IntNumObj*>(_r)->val.get_mpz_t()); - val = mpz_class(l); + mpz_lcm(val.get_mpz_t(), + val.get_mpz_t(), + static_cast<IntNumObj*>(_r)->val.get_mpz_t()); } bool IntNumObj::lt(NumObj *_r) { @@ -1120,6 +1127,10 @@ bool IntNumObj::eq(NumObj *_r) { return val == static_cast<IntNumObj*>(_r)->val; } +IntNumObj* IntNumObj::to_int() { + return new IntNumObj(val); +} + ReprCons *IntNumObj::get_repr_cons() { #ifndef GMP_SUPPORT return new ReprStr(int_to_str(val)); @@ -461,12 +461,14 @@ class RealNumObj: public InexactNumObj {/*{{{*/ };/*}}}*/ +class IntNumObj; /** @class ExactNumObj * Exact number implementation (using gmp) */ class ExactNumObj: public NumObj {/*{{{*/ public: ExactNumObj(NumLvl level); + virtual IntNumObj *to_int() = 0; };/*}}}*/ /** @class RatNumObj @@ -482,6 +484,7 @@ class RatNumObj: public ExactNumObj {/*{{{*/ mpq_class val; RatNumObj(mpq_class val); RatNumObj(const RatNumObj &ori); + IntNumObj *to_int(); #endif NumObj *clone() const; /** Try to construct an RatNumObj object @@ -501,6 +504,7 @@ class RatNumObj: public ExactNumObj {/*{{{*/ bool le(NumObj *r); bool ge(NumObj *r); bool eq(NumObj *r); + ReprCons *get_repr_cons(); };/*}}}*/ @@ -520,6 +524,7 @@ class IntNumObj: public ExactNumObj {/*{{{*/ IntNumObj(mpz_class val); int get_i(); /** Copy constructor */ + IntNumObj *to_int(); IntNumObj(const IntNumObj &ori); #endif NumObj *clone() const; @@ -546,6 +551,7 @@ class IntNumObj: public ExactNumObj {/*{{{*/ bool le(NumObj *r); bool ge(NumObj *r); bool eq(NumObj *r); + ReprCons *get_repr_cons(); };/*}}}*/ |