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

  val repr: Format.formatter -> 'a typ -> unit

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


  let repr: type a. Format.formatter -> a sig_typ -> unit = fun formatter -> function
  | T1 t -> Format.fprintf formatter "(%a)" Data.repr t
  | T2 (t1, t2) -> Format.fprintf formatter "(%a,%a)" Data.repr t1 Data.repr t2
  | T3 (t1, t2, t3) -> Format.fprintf formatter "(%a,%a,%a)" Data.repr t1 Data.repr t2 Data.repr t3

  module ComparableSignature = struct

    type 'a t = string * 'a sig_typ

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

    (** Compare two signature *)
    let comp: type a b. string * a sig_typ -> string * b sig_typ -> (a, b) T.cmp = begin fun (namea, a) (nameb, 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

      if namea < nameb then
        T.Lt
      else if namea > nameb then
        T.Gt
      else match a, b with

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

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

      | 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)
          )
        )

      end


    let repr : type a. Format.formatter -> a t -> unit = begin fun formatter (str, typ) ->
      Format.fprintf formatter "%s:%a"
        str
        repr typ
    end

  end

  module Functions = Splay.Make(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

  let empty = Functions.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
    if Functions.member (name', signature) t then
      raise RegisteredFunction
    else
      Functions.add (name', signature) f 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 ->
    Functions.find ((String.uppercase_ascii name), signature) t
  end

  let repr = Functions.repr

end