Source

kamlostuff / btrees.ml

Full commit

(* pipelining *)
let ( |> ) x f = f x
let ( <| ) f x = f x
(* composition *)
let ( << ) f g x = f (g x)
let ( >> ) f g x = g (f x)
(* `right currying` *)
let flip f x y = f y x

module type SET =
sig
  type elem
  type set

  val empty : set
  val insert : elem -> set -> set
  val member : elem -> set -> bool
end


module type ORDERED =
sig
  type t

  val eq : t -> t -> bool
  val lt : t -> t -> bool
  val leq : t -> t -> bool
end


module UnbalancedSet = 
  functor (Element: ORDERED) ->
    struct 
      type elem = Element.t
      type tree = E | T of (tree * elem * tree)
      type set = tree
          
      let empty = E
        
      let rec insert x = function 
        | E -> T (E, x, E)
        | T (a, y, b) when (Element.lt x y) -> 
            T (insert x a, y, b)
        | T (a, y, b) when (Element.lt y x) ->
            T (a, y, insert x b)
        | s -> s
                        
      let rec member x = function 
        | E -> false
        | T (a, y, b) when (Element.lt x y) ->
            member x a
        | T (a, y, b) when (Element.lt y x) ->
            member x b
        | _ -> true
        
    end : SET