[movitz-cvs] CVS update: movitz/losp/muerte/cons.lisp

[Frode Vatvedt Fjeld]

Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv19205

Modified Files:
	cons.lisp 
Log Message:
Wrote copy-tree and changed tree-equal.

Date: Sun Jun 12 23:27:03 2005
Author: ffjeld

Index: movitz/losp/muerte/cons.lisp
diff -u movitz/losp/muerte/cons.lisp:1.10 movitz/losp/muerte/cons.lisp:1.11
--- movitz/losp/muerte/cons.lisp:1.10	Thu May  5 00:47:02 2005
+++ movitz/losp/muerte/cons.lisp	Sun Jun 12 23:27:03 2005
@@ -9,7 +9,7 @@
 ;;;; Created at:    Fri Dec  8 15:25:45 2000
 ;;;; Distribution:  See the accompanying file COPYING.
 ;;;;                
-;;;; $Id: cons.lisp,v 1.10 2005/05/04 22:47:02 ffjeld Exp $
+;;;; $Id: cons.lisp,v 1.11 2005/06/12 21:27:03 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -255,3 +255,19 @@
     (:compile-form (:result-mode :eax) car)
     (:compile-form (:result-mode :ebx) cdr)
     (:call-local-pf fast-cons)))
+
+(defun copy-tree (tree)
+  (if (not (consp tree))
+      tree
+    (cons (copy-tree (car tree))
+	  (copy-tree (cdr tree)))))
+
+(defun tree-equal (tree-1 tree-2 &key test test-not)
+  (labels ((te (tree-1 tree-2 test)
+	     (if (not (consp tree-1))
+		 (funcall test tree-1 tree-2)
+	       (if (not (consp tree-2))
+		   nil
+		 (and (te (car tree-1) (car tree-2) test)
+		      (te (cdr tree-1) (cdr tree-2) test))))))
+    (te tree-1 tree-2 (or test (and test-not (complement test-not)) #'eql))))