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

[abaine at common-lisp.net]

Author: abaine
Date: Thu Aug  2 11:31:15 2007
New Revision: 102

Modified:
   trunk/funds/src/trees/avl.lisp
Log:
Added function stitch-avl-nodes to replace attach-avl.

Modified: trunk/funds/src/trees/avl.lisp
==============================================================================
--- trunk/funds/src/trees/avl.lisp	(original)
+++ trunk/funds/src/trees/avl.lisp	Thu Aug  2 11:31:15 2007
@@ -36,9 +36,9 @@
 (defun balance (inside root outside &key heavy-side)
   (let ((other-side (other-side heavy-side)))
     (if (balanced-p inside outside) 
-	(attach-avl root
-		    heavy-side outside
-		    other-side inside)
+	(stitch-avl-nodes :root root
+			  heavy-side outside
+			  other-side inside)
 	(rotate inside root
 		(if (heavier-p outside :side other-side)
 		    (rotate (tree-child outside :side heavy-side)
@@ -50,13 +50,20 @@
 
 (defun rotate (inside root outside &key side)
   (let* ((t1 (tree-child outside :side side))
-	 (new-inside (attach-avl root
-				 side inside
-				 (other-side side) t1))
+	 (new-inside (stitch-avl-nodes :root root
+				       side inside
+				       (other-side side) t1))
 	 (new-outside (tree-child outside :side (other-side side))))
-    (attach-avl outside
-		side new-inside
-		(other-side side) new-outside)))
+    (stitch-avl-nodes :root outside
+		      side new-inside
+		      (other-side side) new-outside)))
+
+(defun stitch-avl-nodes (&key root (key (bt-key root)) (value (bt-value root))
+		     left right)
+  (make-instance 'avl-tree
+		 :key key :value value
+		 :left left :right right
+		 :height (parent-height left right)))
 
 (defun attach-avl (root &key (right (make-avl-tree)) (left (make-avl-tree)))
   (make-avl-tree :key (bt-key root)