module T = Tools
module type DATA_SIG = sig

  type 'a typ

  type 'a returnType

  val compare_typ: 'a typ -> 'b typ -> ('a, 'b) T.cmp

end

(** We cannot update an existing function. Any [registerX] function will raise
 [RegisteredFunction] if a function with the same signature already exists in
the catalog. *)
exception RegisteredFunction

(** Catalog for all functions *)
module Make(Data:DATA_SIG) = struct

  (** This is the way the function is store in the map.
       We just the return type, and the function itself. *)
  type _ t_function =
    | Fn1: 'b Data.returnType * ('a -> 'b) -> 'a t_function
    | Fn2: 'c Data.returnType * ('a -> 'b -> 'c) -> ('a * 'b) t_function
    | Fn3: 'd Data.returnType * ('a -> 'b -> 'c -> 'd) -> ('a * 'b * 'c) t_function

  (** This is the key for storing functions in the map. *)
  type _ sig_typ =
    | T1: 'a Data.typ -> 'a t_function sig_typ
    | T2: 'a Data.typ * 'b Data.typ -> ('a * 'b) t_function sig_typ
    | T3: 'a Data.typ * 'b Data.typ * 'c Data.typ -> ('a * 'b * 'c) t_function sig_typ

  module ComparableSignature = struct

    type 'a t = 'a sig_typ

    (* Type for pure equality *)
    type (_, _) eq = Eq : ('a, 'a) eq

    (** Compare two signature *)
    let eq: type a b. a sig_typ -> b sig_typ -> (a, b) T.cmp = begin fun a b ->

      let cmp: type c d. c Data.typ -> d Data.typ -> ((c, d) eq -> (a, b) T.cmp) -> (a, b) T.cmp =
      begin fun a b f -> match Data.compare_typ a b with
        | T.Eq -> f Eq
        | T.Lt -> T.Lt
        | T.Gt -> T.Gt
      end in

      match a, b with

      | T1(a), T1(b) -> cmp a b (fun Eq -> T.Eq)

      | T2(a, b), T2(c, d) ->
        cmp a c (fun Eq ->
          cmp b d (fun Eq -> T.Eq)
        )

      | T3(a, b, c), T3(d, e, f) ->
        cmp a d (fun Eq ->
          cmp b e (fun Eq ->
            cmp c f (fun Eq -> T.Eq)
          )
        )

      | x, y -> if (T.Ex x) > (T.Ex y) then T.Gt else T.Lt
      end

  end

  module Catalog = Map.Make(String)
  module Functions = Tools.Map(ComparableSignature)


  (* This is the map which contains all the registered functions.
     Each name is binded with another map with contains the function for each
     signature.
   *)
  type t = Functions.t Catalog.t

  let empty = Catalog.empty

  (**
     Register a function in the catalog. If the function is already defined,
     raise an exception.
   *)
  let register t name signature f = begin

    let name' = String.uppercase_ascii name in
    let map = begin match Catalog.find name' t with
    | exception Not_found ->
        Functions.singleton signature f
    | x ->
        (* We prevent any update to already registered function *)
        if (Functions.mem signature x) then
          raise RegisteredFunction
        else
          Functions.add signature f x
    end in

    Catalog.add name' map t
  end

  (** Look in the catalog for a function with the given name and signature *)
  let find_function:
  type a. t -> string -> a t_function sig_typ -> a t_function =
  begin fun t name signature ->
    Catalog.find (String.uppercase_ascii name) t
    |> Functions.find signature
  end

end