Add COPY-TREE function + test

diff --git a/src/list.lisp b/src/list.lisp
index b59cfb2..37ab763 100644 (file)
--- a/src/list.lisp
+++ b/src/list.lisp
@@ -38,3 +38,10 @@
 (defun cddadr (x) (cdr (cdadr x)))
 (defun cdddar (x) (cdr (cddar x)))
 (defun cddddr (x) (cdr (cdddr x)))
+
+
+(defun copy-tree (tree)
+  (if (consp tree)
+    (cons (copy-tree (car tree))
+          (copy-tree (cdr tree)))
+    tree))

diff --git a/src/toplevel.lisp b/src/toplevel.lisp
index 64a0e87..8ccefba 100644 (file)
--- a/src/toplevel.lisp
+++ b/src/toplevel.lisp
@@ -55,7 +55,7 @@
           cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr caar cadddr caddr
           cadr car car case catch cdar cdddr cddr cdr cdr char
           char-code char= code-char cond cons consp constantly
-          copy-list decf declaim defconstant define-setf-expander
+          copy-list copy-tree decf declaim defconstant define-setf-expander
           define-symbol-macro defmacro defparameter defun defvar
           digit-char digit-char-p disassemble do do* documentation
           dolist dotimes ecase eq eql equal error eval every export expt

diff --git a/tests/list.lisp b/tests/list.lisp
new file mode 100644 (file)
index 0000000..ae986d8
--- /dev/null
+++ b/tests/list.lisp
@@ -0,0 +1,11 @@
+; Tests for list functions
+
+(test (let* ((foo '((1 2) (3 4)))
+             (bar (copy-tree foo)))
+        ;; (SETF (CAR (CAR FOO)) 0) doesn't work in the test for some reason,
+        ;; despite working fine in the REPL
+        (rplaca (car foo) 0)
+        ;; TODO: EQUAL doesn't compare lists correctly at the moment.
+        ;; Once it does the lists can be compared directly
+        (not (= (car (car foo))
+                (car (car bar))))))