From 51afd6d74d06925d622f3a9f3ff278f562dd24b0 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Tue, 5 Mar 2013 11:05:12 +0100
Subject: [PATCH] imperative heaps on top of splay trees

---
 heap.ml  | 55 ++++++++++++++++++++++---------------------------------
 heap.mli |  4 ++++
 2 files changed, 26 insertions(+), 33 deletions(-)

diff --git a/heap.ml b/heap.ml
index 01830aec..61b267ae 100644
--- a/heap.ml
+++ b/heap.ml
@@ -25,54 +25,43 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 (** {1 Imperative priority queue} *)
 
-type 'a t = {
-  tree: 'a tree;
-  lt: 'a -> 'a -> bool;
-} (** A heap containing values of type 'a *)
-and 'a tree =
-  | Empty
-  | Node of int * 'a tree * 'a * 'a tree
-  (** The complete binary tree (int is max depth) *)
+type 'a t = ('a, unit) SplayTree.t ref
+  (** The heap is a reference to a splay tree *)
 
 (** Create an empty heap *)
-let empty ~lt =
-  { tree = Empty;
-    lt;
-  }
+let empty ~cmp =
+  ref (SplayTree.empty ~cmp)
 
 (** Insert a value in the heap *)
 let insert heap x =
-  let rec insert tree x =
-    match tree with
-    | Empty -> Node (1, Empty, x, Empty)
-    | Node (d, l, y, r) -> failwith "TODO"
-  in
-  { heap with tree = insert heap.tree x }
+  heap := SplayTree.insert !heap x ()
 
 (** Check whether the heap is empty *)
 let is_empty heap =
-  match heap.tree with
-  | Empty -> true
-  | _ -> false
+  SplayTree.is_empty !heap
 
 (** Access the minimal value of the heap, or raises Empty *)
-let min heap =
-  match heap.tree with
-  | Node (_, _, x, _) -> x
-  | Empty -> raise (Invalid_argument "Heap.min on empty heap")
+let min (heap : 'a t) : 'a =
+  let elt, _ = SplayTree.min !heap in
+  elt
 
 (** Discard the minimal element *)
-let junk heap = failwith "TODO: Heap.junk"
+let junk heap =
+  let _, (), tree' = SplayTree.delete_min !heap in
+  heap := tree'
 
 (** Remove and return the mininal value (or raise Invalid_argument) *)
 let pop heap =
+  let elt, (), tree' = SplayTree.delete_min !heap in
+  heap := tree';
+  elt
 
 (** Iterate on the elements, in an unspecified order *)
 let iter heap k =
-  let rec iter tree = match tree with
-  | Empty -> ()
-  | Node (_, l, x, r) ->
-    iter l;
-    k x;
-    iter r
-  in iter heap.tree
+  SplayTree.iter !heap (fun elt _ -> k elt)
+
+let to_seq heap =
+  Sequence.from_iter (fun k -> iter heap k)
+
+let of_seq heap seq =
+  Sequence.iter (fun elt -> insert heap elt) seq
diff --git a/heap.mli b/heap.mli
index c34c4a4a..b0f3d609 100644
--- a/heap.mli
+++ b/heap.mli
@@ -48,3 +48,7 @@ val pop : 'a t -> 'a
 
 val iter : 'a t -> ('a -> unit) -> unit
   (** Iterate on the elements, in an unspecified order *)
+
+val to_seq : 'a t -> 'a Sequence.t
+
+val of_seq : 'a t -> 'a Sequence.t -> unit