aboutsummaryrefslogtreecommitdiff
path: root/builtin.cpp
diff options
context:
space:
mode:
authorTeddy <ted.sybil@gmail.com>2013-08-08 00:11:39 +0800
committerTeddy <ted.sybil@gmail.com>2013-08-08 00:11:39 +0800
commit56a85b5111751f5947579b5ee5cc92bdebb799c4 (patch)
treea19eece360f73ad75a67a9b011061d3691f40115 /builtin.cpp
parent7ffab5bc462dafe0c48c3e1be0ae2112adf7a159 (diff)
added more list-specific procs
Diffstat (limited to 'builtin.cpp')
-rw-r--r--builtin.cpp72
1 files changed, 70 insertions, 2 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;