From 56a85b5111751f5947579b5ee5cc92bdebb799c4 Mon Sep 17 00:00:00 2001
From: Teddy <ted.sybil@gmail.com>
Date: Thu, 8 Aug 2013 00:11:39 +0800
Subject: added more list-specific procs

---
 builtin.cpp     | 72 +++++++++++++++++++++++++++++++++++++++++++++++++++++++--
 builtin.h       |  8 ++++---
 eval.cpp        |  9 ++++----
 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;
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)
-- 
cgit v1.2.3-70-g09d2