[funds-cvs] r93 - trunk/funds/src/trees/heap

[abaine at common-lisp.net]

Author: abaine
Date: Wed Jul 11 21:05:43 2007
New Revision: 93

Modified:
   trunk/funds/src/trees/heap/heap-insert.lisp
Log:
Factored out attach-heap method.

Modified: trunk/funds/src/trees/heap/heap-insert.lisp
==============================================================================
--- trunk/funds/src/trees/heap/heap-insert.lisp	(original)
+++ trunk/funds/src/trees/heap/heap-insert.lisp	Wed Jul 11 21:05:43 2007
@@ -31,19 +31,14 @@
 			  :order order))
 	 (h2 (tree-child heap :side other-side)))
     (if (funcall order (bt-key h1) (bt-key heap)) ; if we need to bubble up
-	(make-heap :priority (heap-priority h1)
-		   :value (bt-value h1)
-		   side (make-heap :priority (heap-priority heap)
-				       
-				   :value (bt-value heap)
+	(attach-heap h1
+		     side (attach-heap heap
 				   :left (bt-left h1)
 				   :right (bt-right h1))
-		   other-side h2)
-	(make-heap :priority (heap-priority heap)
-		   :value (bt-value heap)
-		   side h1
-		   other-side h2))))
-
+		     other-side h2)
+	(attach-heap heap
+		     side h1
+		     other-side h2))))
 
 (defun next-direction (heap)
   (path-direction (1+ (heap-weight heap))))
@@ -56,3 +51,9 @@
     (if (< (- n (expt 2 lg)) (expt 2 (1- lg)))
 	:left
 	:right)))
+
+(defun attach-heap (root &key left right)
+  (make-heap :priority (heap-priority root)
+	     :value (bt-value heap)
+	     :left left
+	     :right right))