Up

module Ctype

: sig
#
exception Unify of (Types.type_expr * Types.type_expr) list
#
exception Tags of Asttypes.label * Asttypes.label
#
exception Subtype of (Types.type_expr * Types.type_expr) list * (Types.type_expr * Types.type_expr) list
#
exception Cannot_expand
#
exception Cannot_apply
#
exception Recursive_abbrev
#
exception Unification_recursive_abbrev of (Types.type_expr * Types.type_expr) list
#
val init_def : int -> unit
#
val begin_def : unit -> unit
#
val end_def : unit -> unit
#
val begin_class_def : unit -> unit
#
val raise_nongen_level : unit -> unit
#
val reset_global_level : unit -> unit
#
val increase_global_level : unit -> int
#
val restore_global_level : int -> unit
#
val newty : Types.type_desc -> Types.type_expr
#
val newvar : ?name:string -> unit -> Types.type_expr
#
val newvar2 : ?name:string -> int -> Types.type_expr
#
val new_global_var : ?name:string -> unit -> Types.type_expr
#
val newobj : Types.type_expr -> Types.type_expr
#
val newconstr : Path.t -> Types.type_expr list -> Types.type_expr
#
val none : Types.type_expr
#
val repr : Types.type_expr -> Types.type_expr
#
val object_fields : Types.type_expr -> Types.type_expr
#
val flatten_fields : Types.type_expr -> (string * Types.field_kind * Types.type_expr) list * Types.type_expr
#
val associate_fields : (string * Types.field_kind * Types.type_expr) list -> (string * Types.field_kind * Types.type_expr) list -> (string * Types.field_kind * Types.type_expr * Types.field_kind * Types.type_expr) list * (string * Types.field_kind * Types.type_expr) list * (string * Types.field_kind * Types.type_expr) list
#
val opened_object : Types.type_expr -> bool
#
val close_object : Types.type_expr -> unit
#
val row_variable : Types.type_expr -> Types.type_expr
#
val set_object_name : Ident.t -> Types.type_expr -> Types.type_expr list -> Types.type_expr -> unit
#
val remove_object_name : Types.type_expr -> unit
#
val hide_private_methods : Types.type_expr -> unit
#
val find_cltype_for_path : Env.t -> Path.t -> Types.type_declaration * Types.type_expr
#
val lid_of_path : ?sharp:string -> Path.t -> Longident.t
#
val sort_row_fields : (Asttypes.label * Types.row_field) list -> (Asttypes.label * Types.row_field) list
#
val merge_row_fields : (Asttypes.label * Types.row_field) list -> (Asttypes.label * Types.row_field) list -> (Asttypes.label * Types.row_field) list * (Asttypes.label * Types.row_field) list * (Asttypes.label * Types.row_field * Types.row_field) list
#
val filter_row_fields : bool -> (Asttypes.label * Types.row_field) list -> (Asttypes.label * Types.row_field) list
#
val generalize : Types.type_expr -> unit
#
val iterative_generalization : int -> Types.type_expr list -> Types.type_expr list
#
val generalize_expansive : Env.t -> Types.type_expr -> unit
#
val generalize_global : Types.type_expr -> unit
#
val generalize_structure : Types.type_expr -> unit
#
val generalize_spine : Types.type_expr -> unit
#
val correct_levels : Types.type_expr -> Types.type_expr
#
val limited_generalize : Types.type_expr -> Types.type_expr -> unit
#
val instance : ?partial:bool -> Env.t -> Types.type_expr -> Types.type_expr
#
val instance_def : Types.type_expr -> Types.type_expr
#
val instance_list : Env.t -> Types.type_expr list -> Types.type_expr list
#
val instance_constructor : ?in_pattern:Env.t Pervasives.ref * int -> Types.constructor_description -> Types.type_expr list * Types.type_expr
#
val instance_parameterized_type : ?keep_names:bool -> Types.type_expr list -> Types.type_expr -> Types.type_expr list * Types.type_expr
#
val instance_parameterized_type_2 : Types.type_expr list -> Types.type_expr list -> Types.type_expr -> Types.type_expr list * Types.type_expr list * Types.type_expr
#
val instance_declaration : Types.type_declaration -> Types.type_declaration
#
val instance_class : Types.type_expr list -> Types.class_type -> Types.type_expr list * Types.class_type
#
val instance_poly : ?keep_names:bool -> bool -> Types.type_expr list -> Types.type_expr -> Types.type_expr list * Types.type_expr
#
val instance_label : bool -> Types.label_description -> Types.type_expr list * Types.type_expr * Types.type_expr
#
val apply : Env.t -> Types.type_expr list -> Types.type_expr -> Types.type_expr list -> Types.type_expr
#
val expand_head_once : Env.t -> Types.type_expr -> Types.type_expr
#
val expand_head : Env.t -> Types.type_expr -> Types.type_expr
#
val try_expand_once_opt : Env.t -> Types.type_expr -> Types.type_expr
#
val expand_head_opt : Env.t -> Types.type_expr -> Types.type_expr

The compiler's own version of expand_head necessary for type-based optimisations.

#
val full_expand : Env.t -> Types.type_expr -> Types.type_expr
#
val extract_concrete_typedecl : Env.t -> Types.type_expr -> Path.t * Path.t * Types.type_declaration
#
val enforce_constraints : Env.t -> Types.type_expr -> unit
#
val unify : Env.t -> Types.type_expr -> Types.type_expr -> unit
#
val unify_gadt : newtype_level:int -> Env.t Pervasives.ref -> Types.type_expr -> Types.type_expr -> unit
#
val unify_var : Env.t -> Types.type_expr -> Types.type_expr -> unit
#
val filter_arrow : Env.t -> Types.type_expr -> Asttypes.label -> Types.type_expr * Types.type_expr
#
val filter_method : Env.t -> string -> Asttypes.private_flag -> Types.type_expr -> Types.type_expr
#
val check_filter_method : Env.t -> string -> Asttypes.private_flag -> Types.type_expr -> unit
#
val occur_in : Env.t -> Types.type_expr -> Types.type_expr -> bool
#
val deep_occur : Types.type_expr -> Types.type_expr -> bool
#
val filter_self_method : Env.t -> string -> Asttypes.private_flag -> (Ident.t * Types.type_expr) Types.Meths.t Pervasives.ref -> Types.type_expr -> Ident.t * Types.type_expr
#
val moregeneral : Env.t -> bool -> Types.type_expr -> Types.type_expr -> bool
#
val rigidify : Types.type_expr -> Types.type_expr list
#
val all_distinct_vars : Env.t -> Types.type_expr list -> bool
#
val matches : Env.t -> Types.type_expr -> Types.type_expr -> bool
#
type class_match_failure =
# | CM_Virtual_class
# | CM_Parameter_arity_mismatch of int * int
# | CM_Type_parameter_mismatch of Env.t * (Types.type_expr * Types.type_expr) list
# | CM_Class_type_mismatch of Env.t * Types.class_type * Types.class_type
# | CM_Parameter_mismatch of Env.t * (Types.type_expr * Types.type_expr) list
# | CM_Val_type_mismatch of string * Env.t * (Types.type_expr * Types.type_expr) list
# | CM_Meth_type_mismatch of string * Env.t * (Types.type_expr * Types.type_expr) list
# | CM_Non_mutable_value of string
# | CM_Non_concrete_value of string
# | CM_Missing_value of string
# | CM_Missing_method of string
# | CM_Hide_public of string
# | CM_Hide_virtual of string * string
# | CM_Public_method of string
# | CM_Private_method of string
# | CM_Virtual_method of string
#
val match_class_types : ?trace:bool -> Env.t -> Types.class_type -> Types.class_type -> class_match_failure list
#
val equal : Env.t -> bool -> Types.type_expr list -> Types.type_expr list -> bool
#
val match_class_declarations : Env.t -> Types.type_expr list -> Types.class_type -> Types.type_expr list -> Types.class_type -> class_match_failure list
#
val enlarge_type : Env.t -> Types.type_expr -> Types.type_expr * bool
#
val subtype : Env.t -> Types.type_expr -> Types.type_expr -> unit -> unit
#
val nondep_type : Env.t -> Ident.t -> Types.type_expr -> Types.type_expr
#
val nondep_type_decl : Env.t -> Ident.t -> Ident.t -> bool -> Types.type_declaration -> Types.type_declaration
#
val nondep_extension_constructor : Env.t -> Ident.t -> Types.extension_constructor -> Types.extension_constructor
#
val nondep_class_declaration : Env.t -> Ident.t -> Types.class_declaration -> Types.class_declaration
#
val nondep_cltype_declaration : Env.t -> Ident.t -> Types.class_type_declaration -> Types.class_type_declaration
#
val cyclic_abbrev : Env.t -> Ident.t -> Types.type_expr -> bool
#
val is_contractive : Env.t -> Types.type_expr -> bool
#
val normalize_type : Env.t -> Types.type_expr -> unit
#
val closed_schema : Types.type_expr -> bool
#
val free_variables : ?env:Env.t -> Types.type_expr -> Types.type_expr list
#
val closed_type_decl : Types.type_declaration -> Types.type_expr option
#
val closed_extension_constructor : Types.extension_constructor -> Types.type_expr option
#
type closed_class_failure =
# | CC_Method of Types.type_expr * bool * string * Types.type_expr
# | CC_Value of Types.type_expr * bool * string * Types.type_expr
#
val closed_class : Types.type_expr list -> Types.class_signature -> closed_class_failure option
#
val unalias : Types.type_expr -> Types.type_expr
#
val signature_of_class_type : Types.class_type -> Types.class_signature
#
val self_type : Types.class_type -> Types.type_expr
#
val class_type_arity : Types.class_type -> int
#
val arity : Types.type_expr -> int
#
val collapse_conj_params : Env.t -> Types.type_expr list -> unit
#
val get_current_level : unit -> int
#
val wrap_trace_gadt_instances : Env.t -> ('a -> 'b) -> 'a -> 'b
#
val package_subtype : (Env.t -> Path.t -> Longident.t list -> Types.type_expr list -> Path.t -> Longident.t list -> Types.type_expr list -> bool) Pervasives.ref
end