okasaki_functor_3_7.ml

(* Modules - the signature of functions and types with no 
   implementation whatsoever. Pure interfaces. *)
module type OrderedType = sig
  type t
  val compare : t -> t -> int
end

(* Note we don't specify any representation for the implementation of a 
   [heap]. Just the facts that define a heap - an ordered element, an 
   abstract type and a bunch of functions *)
module type Heap = sig
  module Elem : OrderedType
  type heap
  val empty : heap
  val is_empty : heap -> bool
  val insert : Elem.t -> heap -> heap
  val merge : heap -> heap -> heap
  val find_min : heap -> Elem.t
  val delete_min : heap -> heap
end


(* Exercise 3.7 : Functor that takes any implementation of [Heap] as input and returns a [Heap]
   that improves the running time of [find_min] to O(1) by explicitly storing 
   the minimum element separately from the rest of the heap. 
   
   This is an example of a functor used for auto-extension of another module, as mentioned 
   in the Functors chapter of Real World OCaml *)
module ExplicitMin (H : Heap) : Heap with module Elem = H.Elem = struct
  module Elem = H.Elem
  type heap = E | NE of Elem.t * H.heap

  let empty = E
  let is_empty = function
    | E -> true
    | _ -> false

  let insert x = function
    | E -> NE (x, H.insert x H.empty)
    | NE (y, h) ->
      if Elem.compare x y <= 0 then NE (x, H.insert x h)
      else NE (y, H.insert x h)

  let merge h1 h2 = match h1, h2 with
    | E, _ -> h2
    | _, E -> h1
    | NE (x, h1'), NE (y, h2') ->
      if Elem.compare x y <= 0 then NE (x, H.merge h1' h2')
      else NE (y, H.merge h1' h2')

  let find_min = function
    | E -> raise Not_found
    | NE (x, _) -> x  

  let delete_min = function
    | E -> raise Not_found
    | NE (_, h) -> 
      let h' = H.delete_min h in
        if H.is_empty h' then E else NE (H.find_min h', h')
end