From e9d1e5d8ec631a10386cd727ed427bf2240350e6 Mon Sep 17 00:00:00 2001 From: Strigoides Date: Sat, 27 Apr 2013 07:28:10 +1200 Subject: [PATCH] Add COPY-TREE function + test --- src/list.lisp | 7 +++++++ src/toplevel.lisp | 2 +- tests/list.lisp | 11 +++++++++++ 3 files changed, 19 insertions(+), 1 deletion(-) create mode 100644 tests/list.lisp diff --git a/src/list.lisp b/src/list.lisp index b59cfb2..37ab763 100644 --- 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 --- 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 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)))))) -- 1.7.10.4