[funds-cvs] r80 - trunk/funds/src/trees

[abaine at common-lisp.net]

Author: abaine
Date: Tue Jul 10 23:18:01 2007
New Revision: 80

Modified:
   trunk/funds/src/trees/tree-insert.lisp
Log:
Greatly simplified tree-insert.

Modified: trunk/funds/src/trees/tree-insert.lisp
==============================================================================
--- trunk/funds/src/trees/tree-insert.lisp	(original)
+++ trunk/funds/src/trees/tree-insert.lisp	Tue Jul 10 23:18:01 2007
@@ -38,31 +38,34 @@
 
 (defmethod tree-insert ((tree binary-tree) key value 
 			&key (test #'eql) (order #'<))
-  (cond ((funcall test key (bt-key tree)) 
-	 (make-instance 'binary-tree
-			:key key
-			:value value
-			:left (bt-left tree)
-			:right (bt-right tree)))
-	((funcall order key (bt-key tree)) 
-	 (insert tree key value
-		      :test test :order order :side :left))
-	(t (insert tree key value
-			 :test test :order order :side :right))))
+  (if (funcall test key (bt-key tree)) 
+      (make-instance 'binary-tree
+		     :key key
+		     :value value
+		     :left (bt-left tree)
+		     :right (bt-right tree))
+      (let* ((side (if (funcall order key (bt-key tree))
+		       :left
+		       :right))
+	     (other-side (other-side side)))
+	(attach-bt tree 
+		   side (tree-insert (tree-child tree :side side) key value
+				     :test test
+				     :order order)
+		   other-side (tree-child tree :side other-side)))))
 
-(defmethod insert ((tree binary-tree) key value &key test order side)
-  (make-instance 'binary-tree
-		 :key (bt-key tree)
-		 :value (bt-value tree)
-		 side (tree-insert (tree-child tree :side side)
-				   key value
-				   :test test
-				   :order order)
-		 (other-side side) (tree-child tree :side (other-side side))))
-
-(defmethod insert ((tree avl-tree) key value &key test order side)
-  (declare (ignore test order))
-  (let* ((temp (call-next-method)) ; the temp object will be a bt, not an avl tree.
-	 (outside (tree-child temp :side side))
-	 (inside (tree-child temp :side (other-side side))))
-    (balance inside temp outside :heavy-side side)))
+(defmethod tree-insert ((tree avl-tree) key value
+			&key (test #'eql) (order #'<))
+  (if (funcall test key (bt-key tree))
+      (make-avl-tree :key key
+		     :value value
+		     :left (bt-left tree)
+		     :right (bt-right tree))
+      (let* ((temp (call-next-method))
+	     (side (if (funcall order key (bt-key tree))
+		       :left
+		       :right))
+	     (outside (tree-child temp :side side))
+	     (inside (tree-child temp :side (other-side side))))
+	(balance inside temp outside :heavy-side side))))
+