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

[abaine at common-lisp.net]

Author: abaine
Date: Thu Aug  2 15:41:49 2007
New Revision: 112

Modified:
   trunk/funds/src/trees/tree-insert.lisp
Log:
Got rid of avl specializer
for tree-insert and instead made generic stitch-tree that balances tree as it is created.

Modified: trunk/funds/src/trees/tree-insert.lisp
==============================================================================
--- trunk/funds/src/trees/tree-insert.lisp	(original)
+++ trunk/funds/src/trees/tree-insert.lisp	Thu Aug  2 15:41:49 2007
@@ -36,31 +36,25 @@
   (stitch-avl-tree :key key
 		   :value value))
 
-(defmethod tree-insert ((tree binary-tree) key value 
-			&key (test #'eql) (order #'<))
+(defmethod tree-insert ((tree binary-tree) key value &key (test #'eql) (order #'<))
   (if (funcall test key (bt-key tree)) 
-      (make-instance 'binary-tree
-		     :key key
-		     :value value
-		     :left (bt-left tree)
-		     :right (bt-right tree))
+      (stitch-tree tree :key key :value value :left (bt-left tree) :right (bt-right tree))
       (let* ((side (side-to-insert tree key :order order))
 	     (other-side (other-side side)))
-	(attach-bt tree 
-		   side (tree-insert (tree-child tree :side side) key value
+	(stitch-tree tree 
+		     side (tree-insert (tree-child tree :side side) key value
 				     :test test
 				     :order order)
-		   other-side (tree-child tree :side other-side)))))
+		     other-side (tree-child tree :side other-side)))))
 
-(defmethod tree-insert ((tree avl-tree) key value
-			&key (test #'eql) (order #'<))
-  (if (funcall test key (bt-key tree))
-      (stitch-avl-tree :key key
-		       :value value
-		       :left (bt-left tree)
-		       :right (bt-right tree))
-      (let* ((temp (call-next-method))
-	     (side (side-to-insert tree key :order order))
-	     (outside (tree-child temp :side side))
-	     (inside (tree-child temp :side (other-side side))))
-	(balance inside temp outside :heavy-side side))))
+(defmethod stitch-tree ((tree binary-tree) 
+			&key (key (bt-key tree)) (value (bt-value tree)) left right)
+  (make-instance 'binary-tree
+		 :key key
+		 :value value
+		 :left left
+		 :right right))
+
+(defmethod stitch-tree ((tree avl-tree) 
+			&key (key (bt-key tree)) (value (bt-value tree)) left right)
+  (balance key value left right))