Up

module Parsetree

: sig

Abstract syntax tree produced by parsing

Extension points

#
type attribute = string Asttypes.loc * payload
#
type extension = string Asttypes.loc * payload
#
type attributes = attribute list
#
type payload =
# | PStr of structure
# | PTyp of core_type
# | PPat of pattern * expression option

Core language

#
type core_type = {
# ptyp_desc
: core_type_desc;
# ptyp_loc
: Location.t;
# ptyp_attributes
: attributes;
}
#
type core_type_desc =
# | Ptyp_any
# | Ptyp_var of string
# | Ptyp_arrow of Asttypes.label * core_type * core_type
# | Ptyp_tuple of core_type list
# | Ptyp_constr of Longident.t Asttypes.loc * core_type list
# | Ptyp_object of (string * attributes * core_type) list * Asttypes.closed_flag
# | Ptyp_class of Longident.t Asttypes.loc * core_type list
# | Ptyp_alias of core_type * string
# | Ptyp_variant of row_field list * Asttypes.closed_flag * Asttypes.label list option
# | Ptyp_poly of string list * core_type
# | Ptyp_package of package_type
# | Ptyp_extension of extension
#
type package_type = Longident.t Asttypes.loc * (Longident.t Asttypes.loc * core_type) list
#
type row_field =
# | Rtag of Asttypes.label * attributes * bool * core_type list
# | Rinherit of core_type
#
type pattern = {
# ppat_desc
: pattern_desc;
# ppat_loc
: Location.t;
# ppat_attributes
: attributes;
}
#
type pattern_desc =
# | Ppat_any
# | Ppat_var of string Asttypes.loc
# | Ppat_alias of pattern * string Asttypes.loc
# | Ppat_constant of Asttypes.constant
# | Ppat_interval of Asttypes.constant * Asttypes.constant
# | Ppat_tuple of pattern list
# | Ppat_construct of Longident.t Asttypes.loc * pattern option
# | Ppat_variant of Asttypes.label * pattern option
# | Ppat_record of (Longident.t Asttypes.loc * pattern) list * Asttypes.closed_flag
# | Ppat_array of pattern list
# | Ppat_or of pattern * pattern
# | Ppat_constraint of pattern * core_type
# | Ppat_type of Longident.t Asttypes.loc
# | Ppat_lazy of pattern
# | Ppat_unpack of string Asttypes.loc
# | Ppat_exception of pattern
# | Ppat_extension of extension
#
type expression = {
# pexp_desc
: expression_desc;
# pexp_loc
: Location.t;
# pexp_attributes
: attributes;
}
#
type expression_desc =
# | Pexp_ident of Longident.t Asttypes.loc
# | Pexp_constant of Asttypes.constant
# | Pexp_let of Asttypes.rec_flag * value_binding list * expression
# | Pexp_function of case list
# | Pexp_fun of Asttypes.label * expression option * pattern * expression
# | Pexp_apply of expression * (Asttypes.label * expression) list
# | Pexp_match of expression * case list
# | Pexp_try of expression * case list
# | Pexp_tuple of expression list
# | Pexp_construct of Longident.t Asttypes.loc * expression option
# | Pexp_variant of Asttypes.label * expression option
# | Pexp_record of (Longident.t Asttypes.loc * expression) list * expression option
# | Pexp_field of expression * Longident.t Asttypes.loc
# | Pexp_setfield of expression * Longident.t Asttypes.loc * expression
# | Pexp_array of expression list
# | Pexp_ifthenelse of expression * expression * expression option
# | Pexp_sequence of expression * expression
# | Pexp_while of expression * expression
# | Pexp_constraint of expression * core_type
# | Pexp_coerce of expression * core_type option * core_type
# | Pexp_send of expression * string
# | Pexp_new of Longident.t Asttypes.loc
# | Pexp_setinstvar of string Asttypes.loc * expression
# | Pexp_override of (string Asttypes.loc * expression) list
# | Pexp_letmodule of string Asttypes.loc * module_expr * expression
# | Pexp_assert of expression
# | Pexp_lazy of expression
# | Pexp_poly of expression * core_type option
# | Pexp_object of class_structure
# | Pexp_newtype of string * expression
# | Pexp_pack of module_expr
# | Pexp_extension of extension
#
type case = {
# pc_lhs
: pattern;
# pc_guard
: expression option;
# pc_rhs
: expression;
}
#
type value_description = {
# pval_name
: string Asttypes.loc;
# pval_type
: core_type;
# pval_prim
: string list;
# pval_attributes
: attributes;
# pval_loc
: Location.t;
}
#
type type_declaration = {
# ptype_name
: string Asttypes.loc;
# ptype_params
: (core_type * Asttypes.variance) list;
# ptype_cstrs
: (core_type * core_type * Location.t) list;
# ptype_kind
: type_kind;
# ptype_private
: Asttypes.private_flag;
# ptype_manifest
: core_type option;
# ptype_attributes
: attributes;
# ptype_loc
: Location.t;
}
#
type type_kind =
# | Ptype_abstract
# | Ptype_variant of constructor_declaration list
# | Ptype_record of label_declaration list
# | Ptype_open
#
type label_declaration = {
# pld_name
: string Asttypes.loc;
# pld_mutable
: Asttypes.mutable_flag;
# pld_type
: core_type;
# pld_loc
: Location.t;
# pld_attributes
: attributes;
}
#
type constructor_declaration = {
# pcd_name
: string Asttypes.loc;
# pcd_args
: core_type list;
# pcd_res
: core_type option;
# pcd_loc
: Location.t;
# pcd_attributes
: attributes;
}
#
type type_extension = {
# ptyext_path
: Longident.t Asttypes.loc;
# ptyext_params
: (core_type * Asttypes.variance) list;
# ptyext_constructors
: extension_constructor list;
# ptyext_private
: Asttypes.private_flag;
# ptyext_attributes
: attributes;
}
#
type extension_constructor = {
# pext_name
: string Asttypes.loc;
# pext_kind
: extension_constructor_kind;
# pext_loc
: Location.t;
# pext_attributes
: attributes;
}
#
type extension_constructor_kind =
# | Pext_decl of core_type list * core_type option
# | Pext_rebind of Longident.t Asttypes.loc

Class language

#
type class_type = {
# pcty_desc
: class_type_desc;
# pcty_loc
: Location.t;
# pcty_attributes
: attributes;
}
#
type class_type_desc =
# | Pcty_constr of Longident.t Asttypes.loc * core_type list
# | Pcty_signature of class_signature
# | Pcty_arrow of Asttypes.label * core_type * class_type
# | Pcty_extension of extension
#
type class_signature = {
# pcsig_self
: core_type;
# pcsig_fields
: class_type_field list;
}
#
type class_type_field = {
# pctf_desc
: class_type_field_desc;
# pctf_loc
: Location.t;
# pctf_attributes
: attributes;
}
#
type class_type_field_desc =
# | Pctf_inherit of class_type
# | Pctf_val of (string * Asttypes.mutable_flag * Asttypes.virtual_flag * core_type)
# | Pctf_method of (string * Asttypes.private_flag * Asttypes.virtual_flag * core_type)
# | Pctf_constraint of (core_type * core_type)
# | Pctf_attribute of attribute
# | Pctf_extension of extension
#
type 'a class_infos = {
# pci_virt
: Asttypes.virtual_flag;
# pci_params
: (core_type * Asttypes.variance) list;
# pci_name
: string Asttypes.loc;
# pci_expr
: 'a;
# pci_loc
: Location.t;
# pci_attributes
: attributes;
}
#
type class_description = class_type class_infos
#
type class_type_declaration = class_type class_infos
#
type class_expr = {
# pcl_desc
: class_expr_desc;
# pcl_loc
: Location.t;
# pcl_attributes
: attributes;
}
#
type class_expr_desc =
# | Pcl_constr of Longident.t Asttypes.loc * core_type list
# | Pcl_structure of class_structure
# | Pcl_fun of Asttypes.label * expression option * pattern * class_expr
# | Pcl_apply of class_expr * (Asttypes.label * expression) list
# | Pcl_let of Asttypes.rec_flag * value_binding list * class_expr
# | Pcl_constraint of class_expr * class_type
# | Pcl_extension of extension
#
type class_structure = {
# pcstr_self
: pattern;
# pcstr_fields
: class_field list;
}
#
type class_field = {
# pcf_desc
: class_field_desc;
# pcf_loc
: Location.t;
# pcf_attributes
: attributes;
}
#
type class_field_desc =
# | Pcf_inherit of Asttypes.override_flag * class_expr * string option
# | Pcf_val of (string Asttypes.loc * Asttypes.mutable_flag * class_field_kind)
# | Pcf_method of (string Asttypes.loc * Asttypes.private_flag * class_field_kind)
# | Pcf_constraint of (core_type * core_type)
# | Pcf_initializer of expression
# | Pcf_attribute of attribute
# | Pcf_extension of extension
#
type class_field_kind =
# | Cfk_virtual of core_type
# | Cfk_concrete of Asttypes.override_flag * expression
#
type class_declaration = class_expr class_infos

Module language

#
type module_type = {
# pmty_desc
: module_type_desc;
# pmty_loc
: Location.t;
# pmty_attributes
: attributes;
}
#
type module_type_desc =
# | Pmty_ident of Longident.t Asttypes.loc
# | Pmty_signature of signature
# | Pmty_functor of string Asttypes.loc * module_type option * module_type
# | Pmty_with of module_type * with_constraint list
# | Pmty_typeof of module_expr
# | Pmty_extension of extension
# | Pmty_alias of Longident.t Asttypes.loc
#
type signature = signature_item list
#
type signature_item = {
# psig_desc
: signature_item_desc;
# psig_loc
: Location.t;
}
#
type signature_item_desc =
# | Psig_value of value_description
# | Psig_type of type_declaration list
# | Psig_typext of type_extension
# | Psig_exception of extension_constructor
# | Psig_module of module_declaration
# | Psig_recmodule of module_declaration list
# | Psig_modtype of module_type_declaration
# | Psig_open of open_description
# | Psig_include of include_description
# | Psig_class of class_description list
# | Psig_class_type of class_type_declaration list
# | Psig_attribute of attribute
# | Psig_extension of extension * attributes
#
type module_declaration = {
# pmd_name
: string Asttypes.loc;
# pmd_type
: module_type;
# pmd_attributes
: attributes;
# pmd_loc
: Location.t;
}
#
type module_type_declaration = {
# pmtd_name
: string Asttypes.loc;
# pmtd_type
: module_type option;
# pmtd_attributes
: attributes;
# pmtd_loc
: Location.t;
}
#
type open_description = {
# popen_lid
: Longident.t Asttypes.loc;
# popen_override
: Asttypes.override_flag;
# popen_loc
: Location.t;
# popen_attributes
: attributes;
}
#
type 'a include_infos = {
# pincl_mod
: 'a;
# pincl_loc
: Location.t;
# pincl_attributes
: attributes;
}
#
type include_description = module_type include_infos
#
type include_declaration = module_expr include_infos
#
type with_constraint =
# | Pwith_module of Longident.t Asttypes.loc * Longident.t Asttypes.loc
# | Pwith_typesubst of type_declaration
# | Pwith_modsubst of string Asttypes.loc * Longident.t Asttypes.loc
#
type module_expr = {
# pmod_desc
: module_expr_desc;
# pmod_loc
: Location.t;
# pmod_attributes
: attributes;
}
#
type module_expr_desc =
# | Pmod_ident of Longident.t Asttypes.loc
# | Pmod_structure of structure
# | Pmod_functor of string Asttypes.loc * module_type option * module_expr
# | Pmod_apply of module_expr * module_expr
# | Pmod_constraint of module_expr * module_type
# | Pmod_unpack of expression
# | Pmod_extension of extension
#
type structure = structure_item list
#
type structure_item = {
# pstr_desc
: structure_item_desc;
# pstr_loc
: Location.t;
}
#
type structure_item_desc =
# | Pstr_eval of expression * attributes
# | Pstr_value of Asttypes.rec_flag * value_binding list
# | Pstr_primitive of value_description
# | Pstr_type of type_declaration list
# | Pstr_typext of type_extension
# | Pstr_exception of extension_constructor
# | Pstr_module of module_binding
# | Pstr_recmodule of module_binding list
# | Pstr_modtype of module_type_declaration
# | Pstr_open of open_description
# | Pstr_class of class_declaration list
# | Pstr_class_type of class_type_declaration list
# | Pstr_include of include_declaration
# | Pstr_attribute of attribute
# | Pstr_extension of extension * attributes
#
type value_binding = {
# pvb_pat
: pattern;
# pvb_expr
: expression;
# pvb_attributes
: attributes;
# pvb_loc
: Location.t;
}
#
type module_binding = {
# pmb_name
: string Asttypes.loc;
# pmb_expr
: module_expr;
# pmb_attributes
: attributes;
# pmb_loc
: Location.t;
}

Toplevel

#
type toplevel_phrase =
# | Ptop_def of structure
# | Ptop_dir of string * directive_argument
#
type directive_argument =
# | Pdir_none
# | Pdir_string of string
# | Pdir_int of int
# | Pdir_ident of Longident.t
# | Pdir_bool of bool
end