Module Errortrace

type position =
  1. | First
  2. | Second
val swap_position : position -> position
val print_pos : Format.formatter -> position -> unit
type expanded_type = {
  1. ty : Types.type_expr;
  2. expanded : Types.type_expr;
}
val trivial_expansion : Types.type_expr -> expanded_type
type !'a diff = {
  1. got : 'a;
  2. expected : 'a;
}
val map_diff : ('a -> 'b) -> 'a diff -> 'b diff
type !'a escape_kind =
  1. | Constructor of Path.t
  2. | Univ of Types.type_expr
  3. | Self
  4. | Module_type of Path.t
  5. | Equation of 'a
  6. | Constraint
type !'a escape = {
  1. kind : 'a escape_kind;
  2. context : Types.type_expr option;
}
val map_escape : ('a -> 'b) -> 'a escape -> 'b escape
val explain : 'a list -> (prev:'a option -> 'a -> 'b option) -> 'b option
type unification = private
  1. | Unification
type comparison = private
  1. | Comparison
type fixed_row_case =
  1. | Cannot_be_closed
  2. | Cannot_add_tags of string list
type !'variety variant =
  1. | Incompatible_types_for : string -> 'a variant
  2. | No_tags : position * (Asttypes.label * Types.row_field) list -> 'b variant
  3. | No_intersection : unification variant
  4. | Fixed_row : position * fixed_row_case * Types.fixed_explanation -> unification variant
  5. | Presence_not_guaranteed_for : position * string -> comparison variant
  6. | Openness : position -> comparison variant
type !'variety obj =
  1. | Missing_field : position * string -> 'a obj
  2. | Abstract_row : position -> 'b obj
  3. | Self_cannot_be_closed : unification obj
type (!'a5, !'variety1) elt =
  1. | Diff : 'a diff -> ('a, 'b) elt
  2. | Variant : 'variety variant -> ('a0, 'variety) elt
  3. | Obj : 'variety0 obj -> ('a1, 'variety0) elt
  4. | Escape : 'a2 escape -> ('a2, 'c) elt
  5. | Incompatible_fields : {
    1. name : string;
    2. diff : Types.type_expr diff;
    } -> ('a3, 'd) elt
  6. | Rec_occur : Types.type_expr * Types.type_expr -> ('a4, 'e) elt
type (!'a, !'variety) t = ('a, 'variety) elt list
type !'variety trace = (Types.type_expr, 'variety) t
type !'variety error = (expanded_type, 'variety) t
val map : ('a -> 'b) -> ('a, 'variety) t -> ('b, 'variety) t
val incompatible_fields : name:string -> got:Types.type_expr -> expected:Types.type_expr -> (Types.type_expr, 'a) elt
val swap_trace : ('a, 'variety) t -> ('a, 'variety) t
type unification_error = private {
  1. trace : unification error;
}
type equality_error = private {
  1. trace : comparison error;
  2. subst : (Types.type_expr * Types.type_expr) list;
}
type moregen_error = private {
  1. trace : comparison error;
}
val unification_error : trace:unification error -> unification_error
val equality_error : trace:comparison error -> subst:(Types.type_expr * Types.type_expr) list -> equality_error
val moregen_error : trace:comparison error -> moregen_error
type comparison_error =
  1. | Equality_error of equality_error
  2. | Moregen_error of moregen_error
val swap_unification_error : unification_error -> unification_error
module Subtype : sig ... end