module Name_of = struct
  let typename_of_int =
    let module M =
      Typename.Make0 (struct
        type t = int

        let name = "int"
      end)
    in
    M.typename_of_t
  ;;

  let typename_of_int32 =
    let module M =
      Typename.Make0 (struct
        type t = int32

        let name = "int32"
      end)
    in
    M.typename_of_t
  ;;

  let typename_of_int64 =
    let module M =
      Typename.Make0 (struct
        type t = int64

        let name = "int64"
      end)
    in
    M.typename_of_t
  ;;

  let typename_of_nativeint =
    let module M =
      Typename.Make0 (struct
        type t = nativeint

        let name = "nativeint"
      end)
    in
    M.typename_of_t
  ;;

  let typename_of_char =
    let module M =
      Typename.Make0 (struct
        type t = char

        let name = "char"
      end)
    in
    M.typename_of_t
  ;;

  let typename_of_float =
    let module M =
      Typename.Make0 (struct
        type t = float

        let name = "float"
      end)
    in
    M.typename_of_t
  ;;

  let typename_of_string =
    let module M =
      Typename.Make0 (struct
        type t = string

        let name = "string"
      end)
    in
    M.typename_of_t
  ;;

  let typename_of_bytes =
    let module M =
      Typename.Make0 (struct
        type t = bytes

        let name = "bytes"
      end)
    in
    M.typename_of_t
  ;;

  let typename_of_bool =
    let module M =
      Typename.Make0 (struct
        type t = bool

        let name = "bool"
      end)
    in
    M.typename_of_t
  ;;

  let typename_of_unit =
    let module M =
      Typename.Make0 (struct
        type t = unit

        let name = "unit"
      end)
    in
    M.typename_of_t
  ;;

  module M_option = Typename.Make1 (struct
      type 'a t = 'a option

      let name = "option"
    end)

  let typename_of_option = M_option.typename_of_t

  module M_list = Typename.Make1 (struct
      type 'a t = 'a list

      let name = "list"
    end)

  let typename_of_list = M_list.typename_of_t

  module M_array = Typename.Make1 (struct
      type 'a t = 'a array

      let name = "array"
    end)

  let typename_of_array = M_array.typename_of_t

  module M_lazy_t = Typename.Make1 (struct
      type 'a t = 'a lazy_t

      let name = "lazy_t"
    end)

  let typename_of_lazy_t = M_lazy_t.typename_of_t

  module M_ref = Typename.Make1 (struct
      type 'a t = 'a ref

      let name = "ref"
    end)

  let typename_of_ref = M_ref.typename_of_t

  module M_function = Typename.Make2 (struct
      type ('a, 'b) t = 'a -> 'b

      let name = "function"
    end)

  let typename_of_function = M_function.typename_of_t

  type tuple0 = unit

  module M_tuple0 = Typename.Make0 (struct
      type t = tuple0

      let name = "tuple0"
    end)

  let typename_of_tuple0 = M_tuple0.typename_of_t

  module M_tuple2 = Typename.Make2 (struct
      type ('a, 'b) t = 'a * 'b

      let name = "tuple2"
    end)

  let typename_of_tuple2 = M_tuple2.typename_of_t

  module M_tuple3 = Typename.Make3 (struct
      type ('a, 'b, 'c) t = 'a * 'b * 'c

      let name = "tuple3"
    end)

  let typename_of_tuple3 = M_tuple3.typename_of_t

  module M_tuple4 = Typename.Make4 (struct
      type ('a, 'b, 'c, 'd) t = 'a * 'b * 'c * 'd

      let name = "tuple4"
    end)

  let typename_of_tuple4 = M_tuple4.typename_of_t

  module M_tuple5 = Typename.Make5 (struct
      type ('a, 'b, 'c, 'd, 'e) t = 'a * 'b * 'c * 'd * 'e

      let name = "tuple5"
    end)

  let typename_of_tuple5 = M_tuple5.typename_of_t
end

module rec Typerep : sig
  type _ t =
    | Int : int t
    | Int32 : int32 t
    | Int64 : int64 t
    | Nativeint : nativeint t
    | Char : char t
    | Float : float t
    | String : string t
    | Bytes : bytes t
    | Bool : bool t
    | Unit : unit t
    | Option : 'a t -> 'a option t
    | List : 'a t -> 'a list t
    | Array : 'a t -> 'a array t
    | Lazy : 'a t -> 'a lazy_t t
    | Ref : 'a t -> 'a ref t
    | Function : ('dom t * 'rng t) -> ('dom -> 'rng) t
    | Tuple : 'a Typerep.Tuple.t -> 'a t
    | Record : 'a Typerep.Record.t -> 'a t
    | Variant : 'a Typerep.Variant.t -> 'a t
    | Named : ('a Typerep.Named.t * 'a t lazy_t option) -> 'a t

  type packed = T : 'a t -> packed

  module Named : sig
    module type T0 = sig
      type named
      type t

      val typename_of_named : named Typename.t
      val typename_of_t : t Typename.t
      val witness : (t, named) Type_equal.t
    end

    module type T1 = sig
      type 'a named
      type a

      val a : a Typerep.t

      type t

      val typename_of_named : 'a Typename.t -> 'a named Typename.t
      val typename_of_t : t Typename.t
      val witness : (t, a named) Type_equal.t
    end

    module type T2 = sig
      type ('a, 'b) named
      type a

      val a : a Typerep.t

      type b

      val b : b Typerep.t

      type t

      val typename_of_named : 'a Typename.t -> 'b Typename.t -> ('a, 'b) named Typename.t
      val typename_of_t : t Typename.t
      val witness : (t, (a, b) named) Type_equal.t
    end

    module type T3 = sig
      type ('a, 'b, 'c) named
      type a

      val a : a Typerep.t

      type b

      val b : b Typerep.t

      type c

      val c : c Typerep.t

      type t

      val typename_of_named
        :  'a Typename.t
        -> 'b Typename.t
        -> 'c Typename.t
        -> ('a, 'b, 'c) named Typename.t

      val typename_of_t : t Typename.t
      val witness : (t, (a, b, c) named) Type_equal.t
    end

    module type T4 = sig
      type ('a, 'b, 'c, 'd) named
      type a

      val a : a Typerep.t

      type b

      val b : b Typerep.t

      type c

      val c : c Typerep.t

      type d

      val d : d Typerep.t

      type t

      val typename_of_named
        :  'a Typename.t
        -> 'b Typename.t
        -> 'c Typename.t
        -> 'd Typename.t
        -> ('a, 'b, 'c, 'd) named Typename.t

      val typename_of_t : t Typename.t
      val witness : (t, (a, b, c, d) named) Type_equal.t
    end

    module type T5 = sig
      type ('a, 'b, 'c, 'd, 'e) named
      type a

      val a : a Typerep.t

      type b

      val b : b Typerep.t

      type c

      val c : c Typerep.t

      type d

      val d : d Typerep.t

      type e

      val e : e Typerep.t

      type t

      val typename_of_named
        :  'a Typename.t
        -> 'b Typename.t
        -> 'c Typename.t
        -> 'd Typename.t
        -> 'e Typename.t
        -> ('a, 'b, 'c, 'd, 'e) named Typename.t

      val typename_of_t : t Typename.t
      val witness : (t, (a, b, c, d, e) named) Type_equal.t
    end

    (* there the module is necessary because we need to deal with a type [t] with
       parameters whose kind is not representable as a type variable: ['a 't], even with
       a gadt. *)
    type 'a t =
      | T0 of (module T0 with type t = 'a)
      | T1 of (module T1 with type t = 'a)
      | T2 of (module T2 with type t = 'a)
      | T3 of (module T3 with type t = 'a)
      | T4 of (module T4 with type t = 'a)
      | T5 of (module T5 with type t = 'a)

    val arity : _ t -> int
    val typename_of_t : 'a t -> 'a Typename.t
    val name : _ t -> string
  end

  module Tuple : sig
    (* these constructors could be plunged at toplevel of Typerep.t, however it is less
       verbose that way *)
    type _ t =
      | T2 : ('a Typerep.t * 'b Typerep.t) -> ('a * 'b) t
      | T3 : ('a Typerep.t * 'b Typerep.t * 'c Typerep.t) -> ('a * 'b * 'c) t
      | T4 :
          ('a Typerep.t * 'b Typerep.t * 'c Typerep.t * 'd Typerep.t)
          -> ('a * 'b * 'c * 'd) t
      | T5 :
          ('a Typerep.t * 'b Typerep.t * 'c Typerep.t * 'd Typerep.t * 'e Typerep.t)
          -> ('a * 'b * 'c * 'd * 'e) t

    val arity : _ t -> int
    val typename_of_t : 'a t -> 'a Typename.t
  end

  include Variant_and_record_intf.S with type 'a t := 'a Typerep.t

  val same : _ t -> _ t -> bool
  val same_witness : 'a t -> 'b t -> ('a, 'b) Type_equal.t option
  val same_witness_exn : 'a t -> 'b t -> ('a, 'b) Type_equal.t
  val typename_of_t : 'a t -> 'a Typename.t
  val head : 'a t -> 'a t
end = struct
  type _ t =
    | Int : int t
    | Int32 : int32 t
    | Int64 : int64 t
    | Nativeint : nativeint t
    | Char : char t
    | Float : float t
    | String : string t
    | Bytes : bytes t
    | Bool : bool t
    | Unit : unit t
    | Option : 'a t -> 'a option t
    | List : 'a t -> 'a list t
    | Array : 'a t -> 'a array t
    | Lazy : 'a t -> 'a lazy_t t
    | Ref : 'a t -> 'a ref t
    | Function : ('dom t * 'rng t) -> ('dom -> 'rng) t
    | Tuple : 'a Typerep.Tuple.t -> 'a t
    | Record : 'a Typerep.Record.t -> 'a t
    | Variant : 'a Typerep.Variant.t -> 'a t
    | Named : ('a Typerep.Named.t * 'a t lazy_t option) -> 'a t

  type packed = T : 'a t -> packed

  module Named = struct
    module type T0 = sig
      type named
      type t

      val typename_of_named : named Typename.t
      val typename_of_t : t Typename.t
      val witness : (t, named) Type_equal.t
    end

    module type T1 = sig
      type 'a named
      type a

      val a : a Typerep.t

      type t

      val typename_of_named : 'a Typename.t -> 'a named Typename.t
      val typename_of_t : t Typename.t
      val witness : (t, a named) Type_equal.t
    end

    module type T2 = sig
      type ('a, 'b) named
      type a

      val a : a Typerep.t

      type b

      val b : b Typerep.t

      type t

      val typename_of_named : 'a Typename.t -> 'b Typename.t -> ('a, 'b) named Typename.t
      val typename_of_t : t Typename.t
      val witness : (t, (a, b) named) Type_equal.t
    end

    module type T3 = sig
      type ('a, 'b, 'c) named
      type a

      val a : a Typerep.t

      type b

      val b : b Typerep.t

      type c

      val c : c Typerep.t

      type t

      val typename_of_named
        :  'a Typename.t
        -> 'b Typename.t
        -> 'c Typename.t
        -> ('a, 'b, 'c) named Typename.t

      val typename_of_t : t Typename.t
      val witness : (t, (a, b, c) named) Type_equal.t
    end

    module type T4 = sig
      type ('a, 'b, 'c, 'd) named
      type a

      val a : a Typerep.t

      type b

      val b : b Typerep.t

      type c

      val c : c Typerep.t

      type d

      val d : d Typerep.t

      type t

      val typename_of_named
        :  'a Typename.t
        -> 'b Typename.t
        -> 'c Typename.t
        -> 'd Typename.t
        -> ('a, 'b, 'c, 'd) named Typename.t

      val typename_of_t : t Typename.t
      val witness : (t, (a, b, c, d) named) Type_equal.t
    end

    module type T5 = sig
      type ('a, 'b, 'c, 'd, 'e) named
      type a

      val a : a Typerep.t

      type b

      val b : b Typerep.t

      type c

      val c : c Typerep.t

      type d

      val d : d Typerep.t

      type e

      val e : e Typerep.t

      type t

      val typename_of_named
        :  'a Typename.t
        -> 'b Typename.t
        -> 'c Typename.t
        -> 'd Typename.t
        -> 'e Typename.t
        -> ('a, 'b, 'c, 'd, 'e) named Typename.t

      val typename_of_t : t Typename.t
      val witness : (t, (a, b, c, d, e) named) Type_equal.t
    end

    (* there the module is necessary because we need to deal with a type [t] with
       parameters whose kind is not representable as a type variable: ['a 't], even with
       a gadt. *)
    type 'a t =
      | T0 of (module T0 with type t = 'a)
      | T1 of (module T1 with type t = 'a)
      | T2 of (module T2 with type t = 'a)
      | T3 of (module T3 with type t = 'a)
      | T4 of (module T4 with type t = 'a)
      | T5 of (module T5 with type t = 'a)

    let arity = function
      | T0 _ -> 0
      | T1 _ -> 1
      | T2 _ -> 2
      | T3 _ -> 3
      | T4 _ -> 4
      | T5 _ -> 5
    ;;

    let typename_of_t (type a) = function
      | T0 rep ->
        let module T = (val rep : T0 with type t = a) in
        T.typename_of_t
      | T1 rep ->
        let module T = (val rep : T1 with type t = a) in
        T.typename_of_t
      | T2 rep ->
        let module T = (val rep : T2 with type t = a) in
        T.typename_of_t
      | T3 rep ->
        let module T = (val rep : T3 with type t = a) in
        T.typename_of_t
      | T4 rep ->
        let module T = (val rep : T4 with type t = a) in
        T.typename_of_t
      | T5 rep ->
        let module T = (val rep : T5 with type t = a) in
        T.typename_of_t
    ;;

    let name rep = Typename.Uid.name (Typename.uid (typename_of_t rep))
  end

  module Tuple = struct
    (* these constructors could be plunged at toplevel of Typerep.t, however it is less
       verbose this way *)
    type _ t =
      | T2 : ('a Typerep.t * 'b Typerep.t) -> ('a * 'b) t
      | T3 : ('a Typerep.t * 'b Typerep.t * 'c Typerep.t) -> ('a * 'b * 'c) t
      | T4 :
          ('a Typerep.t * 'b Typerep.t * 'c Typerep.t * 'd Typerep.t)
          -> ('a * 'b * 'c * 'd) t
      | T5 :
          ('a Typerep.t * 'b Typerep.t * 'c Typerep.t * 'd Typerep.t * 'e Typerep.t)
          -> ('a * 'b * 'c * 'd * 'e) t

    let arity : type a. a t -> int = function
      | Typerep.Tuple.T2 _ -> 2
      | Typerep.Tuple.T3 _ -> 3
      | Typerep.Tuple.T4 _ -> 4
      | Typerep.Tuple.T5 _ -> 5
    ;;

    let typename_of_t : type a. a t -> a Typename.t = function
      | T2 (a, b) ->
        Name_of.typename_of_tuple2 (Typerep.typename_of_t a) (Typerep.typename_of_t b)
      | T3 (a, b, c) ->
        Name_of.typename_of_tuple3
          (Typerep.typename_of_t a)
          (Typerep.typename_of_t b)
          (Typerep.typename_of_t c)
      | T4 (a, b, c, d) ->
        Name_of.typename_of_tuple4
          (Typerep.typename_of_t a)
          (Typerep.typename_of_t b)
          (Typerep.typename_of_t c)
          (Typerep.typename_of_t d)
      | T5 (a, b, c, d, e) ->
        Name_of.typename_of_tuple5
          (Typerep.typename_of_t a)
          (Typerep.typename_of_t b)
          (Typerep.typename_of_t c)
          (Typerep.typename_of_t d)
          (Typerep.typename_of_t e)
    ;;
  end

  include Variant_and_record_intf.M (struct
      type 'a rep = 'a t
      type 'a t = 'a rep
    end)

  let rec typename_of_t : type a. a t -> a Typename.t = function
    | Int -> Name_of.typename_of_int
    | Int32 -> Name_of.typename_of_int32
    | Int64 -> Name_of.typename_of_int64
    | Nativeint -> Name_of.typename_of_nativeint
    | Char -> Name_of.typename_of_char
    | Float -> Name_of.typename_of_float
    | String -> Name_of.typename_of_string
    | Bytes -> Name_of.typename_of_bytes
    | Bool -> Name_of.typename_of_bool
    | Unit -> Name_of.typename_of_unit
    | Option rep -> Name_of.typename_of_option (typename_of_t rep)
    | List rep -> Name_of.typename_of_list (typename_of_t rep)
    | Array rep -> Name_of.typename_of_array (typename_of_t rep)
    | Lazy rep -> Name_of.typename_of_lazy_t (typename_of_t rep)
    | Ref rep -> Name_of.typename_of_ref (typename_of_t rep)
    | Function (dom, rng) ->
      Name_of.typename_of_function (typename_of_t dom) (typename_of_t rng)
    | Tuple rep -> Typerep.Tuple.typename_of_t rep
    | Record rep -> Typerep.Record.typename_of_t rep
    | Variant rep -> Typerep.Variant.typename_of_t rep
    | Named (name, _) -> Named.typename_of_t name
  ;;

  let rec same_witness : type a b. a t -> b t -> (a, b) Type_equal.t option =
    fun t1 t2 ->
      let module E = Type_equal in
      match t1, t2 with
      | Named (name1, r1), Named (name2, r2) ->
        (match
           Typename.same_witness (Named.typename_of_t name1) (Named.typename_of_t name2)
         with
         | Some E.T as x -> x
         | None ->
           (match r1, r2 with
            | Some (lazy t1), Some (lazy t2) -> same_witness t1 t2
            | Some (lazy t1), None -> same_witness t1 t2
            | None, Some (lazy t2) -> same_witness t1 t2
            | None, None -> None))
      | Named (_, r1), t2 ->
        (match r1 with
         | Some (lazy t1) -> same_witness t1 t2
         | None -> None)
      | t1, Named (_, r2) ->
        (match r2 with
         | Some (lazy t2) -> same_witness t1 t2
         | None -> None)
      | Int, Int -> Some E.T
      | Int32, Int32 -> Some E.T
      | Int64, Int64 -> Some E.T
      | Nativeint, Nativeint -> Some E.T
      | Char, Char -> Some E.T
      | Float, Float -> Some E.T
      | String, String -> Some E.T
      | Bytes, Bytes -> Some E.T
      | Bool, Bool -> Some E.T
      | Unit, Unit -> Some E.T
      | Option r1, Option r2 ->
        (match same_witness r1 r2 with
         | None as x -> x
         | Some E.T as x -> x)
      | List r1, List r2 ->
        (match same_witness r1 r2 with
         | None as x -> x
         | Some E.T as x -> x)
      | Array r1, Array r2 ->
        (match same_witness r1 r2 with
         | None as x -> x
         | Some E.T as x -> x)
      | Lazy r1, Lazy r2 ->
        (match same_witness r1 r2 with
         | None as x -> x
         | Some E.T as x -> x)
      | Ref r1, Ref r2 ->
        (match same_witness r1 r2 with
         | None as x -> x
         | Some E.T as x -> x)
      | Function (dom1, rng1), Function (dom2, rng2) ->
        (match same_witness dom1 dom2, same_witness rng1 rng2 with
         | Some E.T, Some E.T -> Some E.T
         | None, _ | _, None -> None)
      | Tuple t1, Tuple t2 ->
        let module T = Typerep.Tuple in
        (match t1, t2 with
         | T.T2 (a1, b1), T.T2 (a2, b2) ->
           (match same_witness a1 a2, same_witness b1 b2 with
            | Some E.T, Some E.T -> Some E.T
            | None, _ | _, None -> None)
         | T.T3 (a1, b1, c1), T.T3 (a2, b2, c2) ->
           (match same_witness a1 a2, same_witness b1 b2, same_witness c1 c2 with
            | Some E.T, Some E.T, Some E.T -> Some E.T
            | None, _, _ | _, None, _ | _, _, None -> None)
         | T.T4 (a1, b1, c1, d1), T.T4 (a2, b2, c2, d2) ->
           (match
              same_witness a1 a2, same_witness b1 b2, same_witness c1 c2, same_witness d1 d2
            with
            | Some E.T, Some E.T, Some E.T, Some E.T -> Some E.T
            | None, _, _, _ | _, None, _, _ | _, _, None, _ | _, _, _, None -> None)
         | T.T5 (a1, b1, c1, d1, e1), T.T5 (a2, b2, c2, d2, e2) ->
           (match
              ( same_witness a1 a2
              , same_witness b1 b2
              , same_witness c1 c2
              , same_witness d1 d2
              , same_witness e1 e2 )
            with
            | Some E.T, Some E.T, Some E.T, Some E.T, Some E.T -> Some E.T
            | None, _, _, _, _
            | _, None, _, _, _
            | _, _, None, _, _
            | _, _, _, None, _
            | _, _, _, _, None -> None)
         | T.T2 _, _ -> None
         | T.T3 _, _ -> None
         | T.T4 _, _ -> None
         | T.T5 _, _ -> None)
      | Record r1, Record r2 ->
        Typename.same_witness
          (Typerep.Record.typename_of_t r1)
          (Typerep.Record.typename_of_t r2)
      | Variant r1, Variant r2 ->
        Typename.same_witness
          (Typerep.Variant.typename_of_t r1)
          (Typerep.Variant.typename_of_t r2)
      | Int, _ -> None
      | Int32, _ -> None
      | Int64, _ -> None
      | Nativeint, _ -> None
      | Char, _ -> None
      | Float, _ -> None
      | String, _ -> None
      | Bytes, _ -> None
      | Bool, _ -> None
      | Unit, _ -> None
      | Option _, _ -> None
      | List _, _ -> None
      | Array _, _ -> None
      | Lazy _, _ -> None
      | Ref _, _ -> None
      | Function _, _ -> None
      | Tuple _, _ -> None
      | Record _, _ -> None
      | Variant _, _ -> None
  ;;

  let same a b = same_witness a b <> None

  let same_witness_exn a b =
    match same_witness a b with
    | Some proof -> proof
    | None -> assert false
  ;;

  let rec head = function
    | Typerep.Named (_, Some (lazy t)) -> head t
    | t -> t
  ;;
end

let typerep_of_int = Typerep.Int
let typerep_of_int32 = Typerep.Int32
let typerep_of_int64 = Typerep.Int64
let typerep_of_nativeint = Typerep.Nativeint
let typerep_of_char = Typerep.Char
let typerep_of_float = Typerep.Float
let typerep_of_string = Typerep.String
let typerep_of_bytes = Typerep.Bytes
let typerep_of_bool = Typerep.Bool
let typerep_of_unit = Typerep.Unit
let typerep_of_option rep = Typerep.Option rep
let typerep_of_list rep = Typerep.List rep
let typerep_of_array rep = Typerep.Array rep
let typerep_of_lazy_t rep = Typerep.Lazy rep
let typerep_of_ref rep = Typerep.Ref rep
let typerep_of_function dom rng = Typerep.Function (dom, rng)
let typerep_of_tuple0 = Typerep.Unit
let typerep_of_tuple2 a b = Typerep.Tuple (Typerep.Tuple.T2 (a, b))
let typerep_of_tuple3 a b c = Typerep.Tuple (Typerep.Tuple.T3 (a, b, c))
let typerep_of_tuple4 a b c d = Typerep.Tuple (Typerep.Tuple.T4 (a, b, c, d))
let typerep_of_tuple5 a b c d e = Typerep.Tuple (Typerep.Tuple.T5 (a, b, c, d, e))

include Name_of

let value_tuple0 = ()

let typerep_of_int63, typename_of_int63 =
  let typerep_and_typename_of_int63_repr
    : type a b. (a, b) Base.Int63.Private.Repr.t -> a Typerep.t * a Typename.t
    = function
      | Base.Int63.Private.Repr.Int -> typerep_of_int, typename_of_int
      | Base.Int63.Private.Repr.Int64 -> typerep_of_int64, typename_of_int64
  in
  typerep_and_typename_of_int63_repr Base.Int63.Private.repr
;;
