aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorTeddy <[email protected]>2013-08-08 00:11:39 +0800
committerTeddy <[email protected]>2013-08-08 00:11:39 +0800
commit56a85b5111751f5947579b5ee5cc92bdebb799c4 (patch)
treea19eece360f73ad75a67a9b011061d3691f40115
parent7ffab5bc462dafe0c48c3e1be0ae2112adf7a159 (diff)
added more list-specific procs
-rw-r--r--builtin.cpp72
-rw-r--r--builtin.h8
-rw-r--r--eval.cpp9
-rw-r--r--robust_test.scm13
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;
diff --git a/builtin.h b/builtin.h
index be40b90..fe1c925 100644
--- a/builtin.h
+++ b/builtin.h
@@ -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
diff --git a/eval.cpp b/eval.cpp
index 85b9482..244ac9c 100644
--- a/eval.cpp
+++ b/eval.cpp
@@ -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)