diff options
-rw-r--r-- | builtin.cpp | 72 | ||||
-rw-r--r-- | builtin.h | 8 | ||||
-rw-r--r-- | eval.cpp | 9 | ||||
-rw-r--r-- | robust_test.scm | 13 |
4 files changed, 93 insertions, 9 deletions
diff --git a/builtin.cpp b/builtin.cpp index 5593509..b3ba376 100644 --- a/builtin.cpp +++ b/builtin.cpp @@ -1082,20 +1082,88 @@ BUILTIN_PROC_DEF(is_list) { return new BoolObj(args->cdr == empty_list); } -BUILTIN_PROC_DEF(num_exact) { +BUILTIN_PROC_DEF(num_is_exact) { ARGS_EXACTLY_ONE; if (!args->car->is_num_obj()) throw TokenError("a number", RUN_ERR_WRONG_TYPE); return new BoolObj(static_cast<NumObj*>(args->car)->is_exact()); } -BUILTIN_PROC_DEF(num_inexact) { +BUILTIN_PROC_DEF(num_is_inexact) { ARGS_EXACTLY_ONE; if (!args->car->is_num_obj()) throw TokenError("a number", RUN_ERR_WRONG_TYPE); return new BoolObj(!static_cast<NumObj*>(args->car)->is_exact()); } +BUILTIN_PROC_DEF(length) { + ARGS_EXACTLY_ONE; + if (args->car == empty_list) + return new IntNumObj(mpz_class(0)); + if (!args->car->is_cons_obj()) + throw TokenError("a list", RUN_ERR_WRONG_TYPE); + int num = 0; + EvalObj *nptr; + for (args = TO_CONS(args->car);;) + { + num++; + if ((nptr = args->cdr)->is_cons_obj()) + args = TO_CONS(nptr); + else + break; + } + if (args->cdr != empty_list) + throw TokenError("a list", RUN_ERR_WRONG_TYPE); + return new IntNumObj(mpz_class(num)); +} + +Cons *copy_list(Cons *src, EvalObj * &tail) { + if (src == empty_list) + throw NormalError(INT_ERR); + EvalObj* nptr; + Cons head(NULL, NULL); + tail = &head; + for (; src != empty_list;) + { + TO_CONS(tail)->cdr = new Cons(*src); + tail = TO_CONS(TO_CONS(tail)->cdr); + if ((nptr = src->cdr)->is_cons_obj()) + src = TO_CONS(nptr); + else break; + } + return TO_CONS(head.cdr); +} + +BUILTIN_PROC_DEF(append) { + EvalObj *tail = empty_list, *head = tail; + for (; args != empty_list; args = TO_CONS(args->cdr)) + { + if (tail == empty_list) + { + head = args->car; + if (head->is_cons_obj()) + head = copy_list(TO_CONS(head), tail); + else tail = head; + } + else + { + if (tail->is_cons_obj()) + { + Cons *prev = TO_CONS(tail); + if (prev->cdr != empty_list) + throw TokenError("empty list", RUN_ERR_WRONG_TYPE); + if (args->car->is_cons_obj()) + prev->cdr = copy_list(TO_CONS(args->car), tail); + else + prev->cdr = args->car; + } + else + throw TokenError("a pair", RUN_ERR_WRONG_TYPE); + } + } + return head; +} + BUILTIN_PROC_DEF(display) { ARGS_EXACTLY_ONE; @@ -243,8 +243,8 @@ BUILTIN_PROC_DEF(num_lt); BUILTIN_PROC_DEF(num_gt); BUILTIN_PROC_DEF(num_eq); -BUILTIN_PROC_DEF(num_exact); -BUILTIN_PROC_DEF(num_inexact); +BUILTIN_PROC_DEF(num_is_exact); +BUILTIN_PROC_DEF(num_is_inexact); BUILTIN_PROC_DEF(bool_not); BUILTIN_PROC_DEF(is_boolean); @@ -257,9 +257,11 @@ BUILTIN_PROC_DEF(pair_set_car); BUILTIN_PROC_DEF(pair_set_cdr); BUILTIN_PROC_DEF(is_null); BUILTIN_PROC_DEF(is_list); +BUILTIN_PROC_DEF(make_list); +BUILTIN_PROC_DEF(length); +BUILTIN_PROC_DEF(append); BUILTIN_PROC_DEF(display); -BUILTIN_PROC_DEF(make_list); #endif @@ -32,8 +32,8 @@ void Evaluator::add_builtin_routines() { ADD_BUILTIN_PROC(">", num_gt); ADD_BUILTIN_PROC("=", num_eq); - ADD_BUILTIN_PROC("exact?", num_exact); - ADD_BUILTIN_PROC("inexact?", num_inexact); + ADD_BUILTIN_PROC("exact?", num_is_exact); + ADD_BUILTIN_PROC("inexact?", num_is_inexact); ADD_BUILTIN_PROC("not", bool_not); ADD_BUILTIN_PROC("boolean?", is_boolean); @@ -46,10 +46,11 @@ void Evaluator::add_builtin_routines() { ADD_BUILTIN_PROC("set-cdr!", pair_set_cdr); ADD_BUILTIN_PROC("null?", is_null); ADD_BUILTIN_PROC("list?", is_list); - - ADD_BUILTIN_PROC("display", display); ADD_BUILTIN_PROC("list", make_list); + ADD_BUILTIN_PROC("length", length); + ADD_BUILTIN_PROC("append", append); + ADD_BUILTIN_PROC("display", display); } Evaluator::Evaluator() { diff --git a/robust_test.scm b/robust_test.scm index 08976a0..637d9cd 100644 --- a/robust_test.scm +++ b/robust_test.scm @@ -129,6 +129,19 @@ t (list . 0) (list 0 . 0) +(length) +(length 1 2) +(length '( 1 . 2)) +(length '()) +(length '( 1 2 3 )) + +(append) +(append '()) +(append '(1 2) 3) +(append '(1 2) '(3 4) 5) +(append '(1 2) 3 '(1)) +(append '() '() '() '(1 2) 3) + (display) (display 1 2) (display . 0) |