Up

module Types

: sig
#
type type_expr = {
# mutable desc
: type_desc;
# mutable level
: int;
# mutable id
: int;
}
#
type type_desc =
# | Tvar of string option
# | Ttuple of type_expr list
# | Tconstr of Path.t * type_expr list * abbrev_memo Pervasives.ref
# | Tobject of type_expr * (Path.t * type_expr list) option Pervasives.ref
# | Tfield of string * field_kind * type_expr * type_expr
# | Tnil
# | Tsubst of type_expr
# | Tvariant of row_desc
# | Tunivar of string option
# | Tpoly of type_expr * type_expr list
# | Tpackage of Path.t * Longident.t list * type_expr list
#
type row_desc = {
# row_fields
: (Asttypes.label * row_field) list;
# row_more
: type_expr;
# row_bound
: unit;
# row_closed
: bool;
# row_fixed
: bool;
# row_name
: (Path.t * type_expr list) option;
}
#
type row_field =
# | Rpresent of type_expr option
# | Reither of bool * type_expr list * bool * row_field option Pervasives.ref
# | Rabsent
#
type abbrev_memo =
# | Mnil
#
type field_kind =
# | Fvar of field_kind option Pervasives.ref
# | Fpresent
# | Fabsent
#
type commutable =
# | Cok
# | Cunknown
#
module TypeOps : sig
#
type t = type_expr
#
val compare : t -> t -> int
#
val equal : t -> t -> bool
#
val hash : t -> int
end
#
module Meths : Map.S with type key = string
#
module Vars : Map.S with type key = string
#
type value_description = {
# val_type
: type_expr;
# val_kind
: value_kind;
# val_loc
: Location.t;
# val_attributes
: Parsetree.attributes;
}
#
type value_kind =
# | Val_reg
# | Val_prim of Primitive.description
# | Val_ivar of Asttypes.mutable_flag * string
# | Val_anc of (string * Ident.t) list * string
# | Val_unbound
#
type constructor_description = {
# cstr_name
: string;
# cstr_res
: type_expr;
# cstr_existentials
: type_expr list;
# cstr_args
: type_expr list;
# cstr_arity
: int;
# cstr_tag
: constructor_tag;
# cstr_consts
: int;
# cstr_nonconsts
: int;
# cstr_normal
: int;
# cstr_generalized
: bool;
# cstr_private
: Asttypes.private_flag;
# cstr_loc
: Location.t;
# cstr_attributes
: Parsetree.attributes;
}
#
type constructor_tag =
# | Cstr_constant of int
# | Cstr_block of int
# | Cstr_extension of Path.t * bool
#
type label_description = {
# lbl_name
: string;
# lbl_res
: type_expr;
# lbl_arg
: type_expr;
# lbl_mut
: Asttypes.mutable_flag;
# lbl_pos
: int;
# lbl_all
: label_description array;
# lbl_repres
: record_representation;
# lbl_private
: Asttypes.private_flag;
# lbl_loc
: Location.t;
# lbl_attributes
: Parsetree.attributes;
}
#
type record_representation =
# | Record_regular
# | Record_float
#
module Variance : sig
#
type t
#
type f =
# | May_pos
# | May_neg
# | May_weak
# | Inj
# | Pos
# | Neg
# | Inv
#
val null : t
#
val full : t
#
val covariant : t
#
val may_inv : t
#
val union : t -> t -> t
#
val inter : t -> t -> t
#
val subset : t -> t -> bool
#
val set : f -> bool -> t -> t
#
val mem : f -> t -> bool
#
val conjugate : t -> t
#
val get_upper : t -> bool * bool
#
val get_lower : t -> bool * bool * bool * bool
end
#
type type_declaration = {
# type_params
: type_expr list;
# type_arity
: int;
# type_kind
: type_kind;
# type_private
: Asttypes.private_flag;
# type_manifest
: type_expr option;
# type_variance
: Variance.t list;
# type_newtype_level
: (int * int) option;
# type_loc
: Location.t;
# type_attributes
: Parsetree.attributes;
}
#
type type_kind =
# | Type_abstract
# | Type_record of label_declaration list * record_representation
# | Type_variant of constructor_declaration list
# | Type_open
#
type label_declaration = {
# ld_id
: Ident.t;
# ld_mutable
: Asttypes.mutable_flag;
# ld_type
: type_expr;
# ld_loc
: Location.t;
# ld_attributes
: Parsetree.attributes;
}
#
type constructor_declaration = {
# cd_id
: Ident.t;
# cd_args
: type_expr list;
# cd_res
: type_expr option;
# cd_loc
: Location.t;
# cd_attributes
: Parsetree.attributes;
}
#
type extension_constructor = {
# ext_type_path
: Path.t;
# ext_type_params
: type_expr list;
# ext_args
: type_expr list;
# ext_ret_type
: type_expr option;
# ext_private
: Asttypes.private_flag;
# ext_loc
: Location.t;
# ext_attributes
: Parsetree.attributes;
}
#
type type_transparence =
# | Type_public
# | Type_new
# | Type_private
#
module Concr : Set.S with type elt = string
#
type class_type =
# | Cty_constr of Path.t * type_expr list * class_type
# | Cty_signature of class_signature
# | Cty_arrow of Asttypes.label * type_expr * class_type
#
type class_signature = {
# csig_self
: type_expr;
# csig_vars
: (Asttypes.mutable_flag * Asttypes.virtual_flag * type_expr) Vars.t;
# csig_concr
: Concr.t;
# csig_inher
: (Path.t * type_expr list) list;
}
#
type class_declaration = {
# cty_params
: type_expr list;
# mutable cty_type
: class_type;
# cty_path
: Path.t;
# cty_new
: type_expr option;
# cty_variance
: Variance.t list;
# cty_loc
: Location.t;
# cty_attributes
: Parsetree.attributes;
}
#
type class_type_declaration = {
# clty_params
: type_expr list;
# clty_type
: class_type;
# clty_path
: Path.t;
# clty_variance
: Variance.t list;
# clty_loc
: Location.t;
# clty_attributes
: Parsetree.attributes;
}
#
type module_type =
# | Mty_ident of Path.t
# | Mty_signature of signature
# | Mty_functor of Ident.t * module_type option * module_type
# | Mty_alias of Path.t
#
type signature = signature_item list
#
type signature_item =
# | Sig_value of Ident.t * value_description
# | Sig_type of Ident.t * type_declaration * rec_status
# | Sig_typext of Ident.t * extension_constructor * ext_status
# | Sig_module of Ident.t * module_declaration * rec_status
# | Sig_modtype of Ident.t * modtype_declaration
# | Sig_class of Ident.t * class_declaration * rec_status
# | Sig_class_type of Ident.t * class_type_declaration * rec_status
#
type module_declaration = {
# md_type
: module_type;
# md_attributes
: Parsetree.attributes;
# md_loc
: Location.t;
}
#
type modtype_declaration = {
# mtd_type
: module_type option;
# mtd_attributes
: Parsetree.attributes;
# mtd_loc
: Location.t;
}
#
type rec_status =
# | Trec_not
# | Trec_first
# | Trec_next
#
type ext_status =
# | Text_first
# | Text_next
# | Text_exception
end