(**************************************************************************)


(*                                                                        *)
(*                              Cubicle                                   *)
(*                                                                        *)
(*                       Copyright (C) 2011-2014                          *)
(*                                                                        *)
(*                  Sylvain Conchon and Alain Mebsout                     *)
(*                       Universite Paris-Sud 11                          *)
(*                                                                        *)
(*                                                                        *)
(*  This file is distributed under the terms of the Apache Software       *)
(*  License version 2.0                                                   *)
(*                                                                        *)


(**************************************************************************)



exception EmptyHeap

module type OrderType = sig
  type t

  val compare : t -> t -> int
end

module type S = sig
  type t
  type elem 
    
  val empty : t
  val pop : t -> elem * t
  val add : t -> elem list -> t
  val elements : t -> elem list
  val length : t -> int
end


module Make ( X : OrderType ) = struct

  type elem = X.t
  type t = Empty | Node of elem * t * t

  let empty = Empty

  let rec fusion t1 t2 = 
    match t1, t2 with
      | _ , Empty -> t1
      | Empty , _ -> t2
      | Node (m1, g1, d1), Node (m2, g2, d2) ->
          if X.compare m1 m2 <= 0 then Node (m1, d1, fusion g1 t2)
          else Node (m2, d2, fusion g2 t1)
            
  let pop = function
    | Empty -> raise EmptyHeap
    | Node(m, g, d) -> m, fusion g d
        
  let add h l = 
    List.fold_left (fun h x -> fusion (Node(x, Empty, Empty)) h ) h l
    
  let elements h = 
    let rec elements_aux acc = function
      | Empty -> acc
      | Node (m1 ,g1 ,d1) -> elements_aux (m1 :: acc) (fusion g1 d1)
    in
    elements_aux [] h

  let length h =
    let rec length_aux acc = function
      | Empty -> acc
      | Node (_ ,g ,d) -> length_aux (length_aux (acc + 1) g) d
    in
    length_aux 0 h

end