open Asttypes

open Parsetree

open Docstrings

type 'a with_loc = 'a Location.loc

type loc = Location.t

type lid = Longident.t with_loc

type str = string with_loc

type str_opt = string option with_loc

type attrs = attribute list

let default_loc = ref Location.none

let with_default_loc l f =

Misc.protect_refs [Misc.R (default_loc, l)] f

module Const = struct

let integer ?suffix i = Pconst_integer (i, suffix)

let int ?suffix i = integer ?suffix (Int.to_string i)

let int32 ?(suffix='l') i = integer ~suffix (Int32.to_string i)

let int64 ?(suffix='L') i = integer ~suffix (Int64.to_string i)

let nativeint ?(suffix='n') i = integer ~suffix (Nativeint.to_string i)

let float ?suffix f = Pconst_float (f, suffix)

let char c = Pconst_char c

let string ?quotation_delimiter ?(loc= !default_loc) s =

Pconst_string (s, loc, quotation_delimiter)

module Attr = struct

let mk ?(loc= !default_loc) name payload =

{ attr_name = name;

attr_payload = payload;

attr_loc = loc }

module Typ = struct

let mk ?(loc = !default_loc) ?(attrs = []) d =

{ptyp_desc = d;

ptyp_loc = loc;

ptyp_loc_stack = [];

ptyp_attributes = attrs}

let attr d a = {d with ptyp_attributes = d.ptyp_attributes @ [a]}

let any ?loc ?attrs () = mk ?loc ?attrs Ptyp_any

let var ?loc ?attrs a = mk ?loc ?attrs (Ptyp_var a)

let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_arrow (a, b, c))

let tuple ?loc ?attrs a = mk ?loc ?attrs (Ptyp_tuple a)

let constr ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_constr (a, b))

let object_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_object (a, b))

let class_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_class (a, b))

let alias ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_alias (a, b))

let variant ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_variant (a, b, c))

let poly ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_poly (a, b))

let package ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_package (a, b))

let extension ?loc ?attrs a = mk ?loc ?attrs (Ptyp_extension a)

let force_poly t =

match t.ptyp_desc with

| Ptyp_poly _ -> t

| _ -> poly ~loc:t.ptyp_loc [] t (* -> ghost? *)

let varify_constructors var_names t =

let check_variable vl loc v =

if List.mem v vl then

raise Syntaxerr.(Error(Variable_in_scope(loc,v))) in

let var_names = List.map (fun v -> v.txt) var_names in

let rec loop t =

let desc =

match t.ptyp_desc with

| Ptyp_any -> Ptyp_any

| Ptyp_var x ->

check_variable var_names t.ptyp_loc x;

Ptyp_var x

| Ptyp_arrow (label,core_type,core_type') ->

Ptyp_arrow(label, loop core_type, loop core_type')

| Ptyp_tuple lst -> Ptyp_tuple (List.map loop lst)

| Ptyp_constr( { txt = Longident.Lident s }, [])

when List.mem s var_names ->

Ptyp_var s

| Ptyp_constr(longident, lst) ->

Ptyp_constr(longident, List.map loop lst)

| Ptyp_object (lst, o) ->

Ptyp_object (List.map loop_object_field lst, o)

| Ptyp_class (longident, lst) ->

Ptyp_class (longident, List.map loop lst)

| Ptyp_alias(core_type, string) ->

check_variable var_names t.ptyp_loc string;

Ptyp_alias(loop core_type, string)

| Ptyp_variant(row_field_list, flag, lbl_lst_option) ->

Ptyp_variant(List.map loop_row_field row_field_list,

flag, lbl_lst_option)

| Ptyp_poly(string_lst, core_type) ->

List.iter (fun v ->

check_variable var_names t.ptyp_loc v.txt) string_lst;

Ptyp_poly(string_lst, loop core_type)

| Ptyp_package(longident,lst) ->

Ptyp_package(longident,List.map (fun (n,typ) -> (n,loop typ) ) lst)

| Ptyp_extension (s, arg) ->

Ptyp_extension (s, arg)

in

{t with ptyp_desc = desc}

and loop_row_field field =

let prf_desc = match field.prf_desc with

| Rtag(label,flag,lst) ->

Rtag(label,flag,List.map loop lst)

| Rinherit t ->

Rinherit (loop t)

in

{ field with prf_desc; }

and loop_object_field field =

let pof_desc = match field.pof_desc with

| Otag(label, t) ->

Otag(label, loop t)

| Oinherit t ->

Oinherit (loop t)

in

{ field with pof_desc; }

in

loop t

module Pat = struct

let mk ?(loc = !default_loc) ?(attrs = []) d =

{ppat_desc = d;

ppat_loc = loc;

ppat_loc_stack = [];

ppat_attributes = attrs}

let attr d a = {d with ppat_attributes = d.ppat_attributes @ [a]}

let any ?loc ?attrs () = mk ?loc ?attrs Ppat_any

let var ?loc ?attrs a = mk ?loc ?attrs (Ppat_var a)

let alias ?loc ?attrs a b = mk ?loc ?attrs (Ppat_alias (a, b))

let constant ?loc ?attrs a = mk ?loc ?attrs (Ppat_constant a)

let interval ?loc ?attrs a b = mk ?loc ?attrs (Ppat_interval (a, b))

let tuple ?loc ?attrs a = mk ?loc ?attrs (Ppat_tuple a)

let construct ?loc ?attrs a b = mk ?loc ?attrs (Ppat_construct (a, b))

let variant ?loc ?attrs a b = mk ?loc ?attrs (Ppat_variant (a, b))

let record ?loc ?attrs a b = mk ?loc ?attrs (Ppat_record (a, b))

let array ?loc ?attrs a = mk ?loc ?attrs (Ppat_array a)

let or_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_or (a, b))

let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_constraint (a, b))

let type_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_type a)

let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_lazy a)

let unpack ?loc ?attrs a = mk ?loc ?attrs (Ppat_unpack a)

let open_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_open (a, b))

let exception_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_exception a)

let extension ?loc ?attrs a = mk ?loc ?attrs (Ppat_extension a)

module Exp = struct

let mk ?(loc = !default_loc) ?(attrs = []) d =

{pexp_desc = d;

pexp_loc = loc;

pexp_loc_stack = [];

pexp_attributes = attrs}

let attr d a = {d with pexp_attributes = d.pexp_attributes @ [a]}

let ident ?loc ?attrs a = mk ?loc ?attrs (Pexp_ident a)

let constant ?loc ?attrs a = mk ?loc ?attrs (Pexp_constant a)

let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_let (a, b, c))

let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pexp_fun (a, b, c, d))

let function_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_function a)

let apply ?loc ?attrs a b = mk ?loc ?attrs (Pexp_apply (a, b))

let match_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_match (a, b))

let try_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_try (a, b))

let tuple ?loc ?attrs a = mk ?loc ?attrs (Pexp_tuple a)

let construct ?loc ?attrs a b = mk ?loc ?attrs (Pexp_construct (a, b))

let variant ?loc ?attrs a b = mk ?loc ?attrs (Pexp_variant (a, b))

let record ?loc ?attrs a b = mk ?loc ?attrs (Pexp_record (a, b))

let field ?loc ?attrs a b = mk ?loc ?attrs (Pexp_field (a, b))

let setfield ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_setfield (a, b, c))

let array ?loc ?attrs a = mk ?loc ?attrs (Pexp_array a)

let ifthenelse ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_ifthenelse (a, b, c))

let sequence ?loc ?attrs a b = mk ?loc ?attrs (Pexp_sequence (a, b))

let while_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_while (a, b))

let for_ ?loc ?attrs a b c d e = mk ?loc ?attrs (Pexp_for (a, b, c, d, e))

let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_constraint (a, b))

let coerce ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_coerce (a, b, c))

let send ?loc ?attrs a b = mk ?loc ?attrs (Pexp_send (a, b))

let new_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_new a)

let setinstvar ?loc ?attrs a b = mk ?loc ?attrs (Pexp_setinstvar (a, b))

let override ?loc ?attrs a = mk ?loc ?attrs (Pexp_override a)

let letmodule ?loc ?attrs a b c= mk ?loc ?attrs (Pexp_letmodule (a, b, c))

let letexception ?loc ?attrs a b = mk ?loc ?attrs (Pexp_letexception (a, b))

let assert_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_assert a)

let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_lazy a)

let poly ?loc ?attrs a b = mk ?loc ?attrs (Pexp_poly (a, b))

let object_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_object a)

let newtype ?loc ?attrs a b = mk ?loc ?attrs (Pexp_newtype (a, b))

let pack ?loc ?attrs a = mk ?loc ?attrs (Pexp_pack a)

let open_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_open (a, b))

let letop ?loc ?attrs let_ ands body =

mk ?loc ?attrs (Pexp_letop {let_; ands; body})

let extension ?loc ?attrs a = mk ?loc ?attrs (Pexp_extension a)

let unreachable ?loc ?attrs () = mk ?loc ?attrs Pexp_unreachable

let case lhs ?guard rhs =

{

pc_lhs = lhs;

pc_guard = guard;

pc_rhs = rhs;

}

let binding_op op pat exp loc =

{

pbop_op = op;

pbop_pat = pat;

pbop_exp = exp;

pbop_loc = loc;

}

module Mty = struct

let mk ?(loc = !default_loc) ?(attrs = []) d =

{pmty_desc = d; pmty_loc = loc; pmty_attributes = attrs}

let attr d a = {d with pmty_attributes = d.pmty_attributes @ [a]}

let ident ?loc ?attrs a = mk ?loc ?attrs (Pmty_ident a)

let alias ?loc ?attrs a = mk ?loc ?attrs (Pmty_alias a)

let signature ?loc ?attrs a = mk ?loc ?attrs (Pmty_signature a)

let functor_ ?loc ?attrs a b = mk ?loc ?attrs (Pmty_functor (a, b))

let with_ ?loc ?attrs a b = mk ?loc ?attrs (Pmty_with (a, b))

let typeof_ ?loc ?attrs a = mk ?loc ?attrs (Pmty_typeof a)

let extension ?loc ?attrs a = mk ?loc ?attrs (Pmty_extension a)

module Mod = struct

let mk ?(loc = !default_loc) ?(attrs = []) d =

{pmod_desc = d; pmod_loc = loc; pmod_attributes = attrs}

let attr d a = {d with pmod_attributes = d.pmod_attributes @ [a]}

let ident ?loc ?attrs x = mk ?loc ?attrs (Pmod_ident x)

let structure ?loc ?attrs x = mk ?loc ?attrs (Pmod_structure x)

let functor_ ?loc ?attrs arg body =

mk ?loc ?attrs (Pmod_functor (arg, body))

let apply ?loc ?attrs m1 m2 = mk ?loc ?attrs (Pmod_apply (m1, m2))

let constraint_ ?loc ?attrs m mty = mk ?loc ?attrs (Pmod_constraint (m, mty))

let unpack ?loc ?attrs e = mk ?loc ?attrs (Pmod_unpack e)

let extension ?loc ?attrs a = mk ?loc ?attrs (Pmod_extension a)

module Sig = struct

let mk ?(loc = !default_loc) d = {psig_desc = d; psig_loc = loc}

let value ?loc a = mk ?loc (Psig_value a)

let type_ ?loc rec_flag a = mk ?loc (Psig_type (rec_flag, a))

let type_subst ?loc a = mk ?loc (Psig_typesubst a)

let type_extension ?loc a = mk ?loc (Psig_typext a)

let exception_ ?loc a = mk ?loc (Psig_exception a)

let module_ ?loc a = mk ?loc (Psig_module a)

let mod_subst ?loc a = mk ?loc (Psig_modsubst a)

let rec_module ?loc a = mk ?loc (Psig_recmodule a)

let modtype ?loc a = mk ?loc (Psig_modtype a)

let open_ ?loc a = mk ?loc (Psig_open a)

let include_ ?loc a = mk ?loc (Psig_include a)

let class_ ?loc a = mk ?loc (Psig_class a)

let class_type ?loc a = mk ?loc (Psig_class_type a)

let extension ?loc ?(attrs = []) a = mk ?loc (Psig_extension (a, attrs))

let attribute ?loc a = mk ?loc (Psig_attribute a)

let text txt =

let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in

List.map

(fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds))

f_txt

module Str = struct

let mk ?(loc = !default_loc) d = {pstr_desc = d; pstr_loc = loc}

let eval ?loc ?(attrs = []) a = mk ?loc (Pstr_eval (a, attrs))

let value ?loc a b = mk ?loc (Pstr_value (a, b))

let primitive ?loc a = mk ?loc (Pstr_primitive a)

let type_ ?loc rec_flag a = mk ?loc (Pstr_type (rec_flag, a))

let type_extension ?loc a = mk ?loc (Pstr_typext a)

let exception_ ?loc a = mk ?loc (Pstr_exception a)

let module_ ?loc a = mk ?loc (Pstr_module a)

let rec_module ?loc a = mk ?loc (Pstr_recmodule a)

let modtype ?loc a = mk ?loc (Pstr_modtype a)

let open_ ?loc a = mk ?loc (Pstr_open a)

let class_ ?loc a = mk ?loc (Pstr_class a)

let class_type ?loc a = mk ?loc (Pstr_class_type a)

let include_ ?loc a = mk ?loc (Pstr_include a)

let extension ?loc ?(attrs = []) a = mk ?loc (Pstr_extension (a, attrs))

let attribute ?loc a = mk ?loc (Pstr_attribute a)

let text txt =

let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in

List.map

(fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds))

f_txt

module Cl = struct

let mk ?(loc = !default_loc) ?(attrs = []) d =

{

pcl_desc = d;

pcl_loc = loc;

pcl_attributes = attrs;

}

let attr d a = {d with pcl_attributes = d.pcl_attributes @ [a]}

let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constr (a, b))

let structure ?loc ?attrs a = mk ?loc ?attrs (Pcl_structure a)

let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pcl_fun (a, b, c, d))

let apply ?loc ?attrs a b = mk ?loc ?attrs (Pcl_apply (a, b))

let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcl_let (a, b, c))

let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constraint (a, b))

let extension ?loc ?attrs a = mk ?loc ?attrs (Pcl_extension a)

let open_ ?loc ?attrs a b = mk ?loc ?attrs (Pcl_open (a, b))

module Cty = struct

let mk ?(loc = !default_loc) ?(attrs = []) d =

{

pcty_desc = d;

pcty_loc = loc;

pcty_attributes = attrs;

}

let attr d a = {d with pcty_attributes = d.pcty_attributes @ [a]}

let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcty_constr (a, b))

let signature ?loc ?attrs a = mk ?loc ?attrs (Pcty_signature a)

let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Pcty_arrow (a, b, c))

let extension ?loc ?attrs a = mk ?loc ?attrs (Pcty_extension a)

let open_ ?loc ?attrs a b = mk ?loc ?attrs (Pcty_open (a, b))

module Ctf = struct

let mk ?(loc = !default_loc) ?(attrs = [])

?(docs = empty_docs) d =

{

pctf_desc = d;

pctf_loc = loc;

pctf_attributes = add_docs_attrs docs attrs;

}

let inherit_ ?loc ?attrs a = mk ?loc ?attrs (Pctf_inherit a)

let val_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_val (a, b, c, d))

let method_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_method (a, b, c, d))

let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pctf_constraint (a, b))

let extension ?loc ?attrs a = mk ?loc ?attrs (Pctf_extension a)

let attribute ?loc a = mk ?loc (Pctf_attribute a)

let text txt =

let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in

List.map

(fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds))

f_txt

let attr d a = {d with pctf_attributes = d.pctf_attributes @ [a]}

module Cf = struct

let mk ?(loc = !default_loc) ?(attrs = [])

?(docs = empty_docs) d =

{

pcf_desc = d;

pcf_loc = loc;

pcf_attributes = add_docs_attrs docs attrs;

}

let inherit_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_inherit (a, b, c))

let val_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_val (a, b, c))

let method_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_method (a, b, c))

let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcf_constraint (a, b))

let initializer_ ?loc ?attrs a = mk ?loc ?attrs (Pcf_initializer a)

let extension ?loc ?attrs a = mk ?loc ?attrs (Pcf_extension a)

let attribute ?loc a = mk ?loc (Pcf_attribute a)

let text txt =

let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in

List.map

(fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds))

f_txt

let virtual_ ct = Cfk_virtual ct

let concrete o e = Cfk_concrete (o, e)

let attr d a = {d with pcf_attributes = d.pcf_attributes @ [a]}

module Val = struct

let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs)

?(prim = []) name typ =

{

pval_name = name;

pval_type = typ;

pval_attributes = add_docs_attrs docs attrs;

pval_loc = loc;

pval_prim = prim;

}

module Md = struct

let mk ?(loc = !default_loc) ?(attrs = [])

?(docs = empty_docs) ?(text = []) name typ =

{

pmd_name = name;

pmd_type = typ;

pmd_attributes =

add_text_attrs text (add_docs_attrs docs attrs);

pmd_loc = loc;

}

module Ms = struct

let mk ?(loc = !default_loc) ?(attrs = [])

?(docs = empty_docs) ?(text = []) name syn =

{

pms_name = name;

pms_manifest = syn;

pms_attributes =

add_text_attrs text (add_docs_attrs docs attrs);

pms_loc = loc;

}

module Mtd = struct

let mk ?(loc = !default_loc) ?(attrs = [])

?(docs = empty_docs) ?(text = []) ?typ name =

{

pmtd_name = name;

pmtd_type = typ;

pmtd_attributes =

add_text_attrs text (add_docs_attrs docs attrs);

pmtd_loc = loc;

}

module Mb = struct

let mk ?(loc = !default_loc) ?(attrs = [])

?(docs = empty_docs) ?(text = []) name expr =

{

pmb_name = name;

pmb_expr = expr;

pmb_attributes =

add_text_attrs text (add_docs_attrs docs attrs);

pmb_loc = loc;

}

module Opn = struct

let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs)

?(override = Fresh) expr =

{

popen_expr = expr;

popen_override = override;

popen_loc = loc;

popen_attributes = add_docs_attrs docs attrs;

}

module Incl = struct

let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) mexpr =

{

pincl_mod = mexpr;

pincl_loc = loc;

pincl_attributes = add_docs_attrs docs attrs;

}

module Vb = struct

let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs)

?(text = []) pat expr =

{

pvb_pat = pat;

pvb_expr = expr;

pvb_attributes =

add_text_attrs text (add_docs_attrs docs attrs);

pvb_loc = loc;

}

module Ci = struct

let mk ?(loc = !default_loc) ?(attrs = [])

?(docs = empty_docs) ?(text = [])

?(virt = Concrete) ?(params = []) name expr =

{

pci_virt = virt;

pci_params = params;

pci_name = name;

pci_expr = expr;

pci_attributes =

add_text_attrs text (add_docs_attrs docs attrs);

pci_loc = loc;

}

module Type = struct

let mk ?(loc = !default_loc) ?(attrs = [])

?(docs = empty_docs) ?(text = [])

?(params = [])

?(cstrs = [])

?(kind = Ptype_abstract)

?(priv = Public)

?manifest

name =

{

ptype_name = name;

ptype_params = params;

ptype_cstrs = cstrs;

ptype_kind = kind;

ptype_private = priv;

ptype_manifest = manifest;

ptype_attributes =

add_text_attrs text (add_docs_attrs docs attrs);

ptype_loc = loc;

}

let constructor ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info)

?(args = Pcstr_tuple []) ?res name =

{

pcd_name = name;

pcd_args = args;

pcd_res = res;

pcd_loc = loc;

pcd_attributes = add_info_attrs info attrs;

}

let field ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info)

?(mut = Immutable) name typ =

{

pld_name = name;

pld_mutable = mut;

pld_type = typ;

pld_loc = loc;

pld_attributes = add_info_attrs info attrs;

}

module Te = struct

let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs)

?(params = []) ?(priv = Public) path constructors =

{

ptyext_path = path;

ptyext_params = params;

ptyext_constructors = constructors;

ptyext_private = priv;

ptyext_loc = loc;

ptyext_attributes = add_docs_attrs docs attrs;

}

let mk_exception ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs)

constructor =

{

ptyexn_constructor = constructor;

ptyexn_loc = loc;

ptyexn_attributes = add_docs_attrs docs attrs;

}

let constructor ?(loc = !default_loc) ?(attrs = [])

?(docs = empty_docs) ?(info = empty_info) name kind =

{

pext_name = name;

pext_kind = kind;

pext_loc = loc;

pext_attributes = add_docs_attrs docs (add_info_attrs info attrs);

}

let decl ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs)

?(info = empty_info) ?(args = Pcstr_tuple []) ?res name =

{

pext_name = name;

pext_kind = Pext_decl(args, res);

pext_loc = loc;

pext_attributes = add_docs_attrs docs (add_info_attrs info attrs);

}

let rebind ?(loc = !default_loc) ?(attrs = [])

?(docs = empty_docs) ?(info = empty_info) name lid =

{

pext_name = name;

pext_kind = Pext_rebind lid;

pext_loc = loc;

pext_attributes = add_docs_attrs docs (add_info_attrs info attrs);

}

module Csig = struct

let mk self fields =

{

pcsig_self = self;

pcsig_fields = fields;

}

module Cstr = struct

let mk self fields =

{

pcstr_self = self;

pcstr_fields = fields;

}

module Rf = struct

let mk ?(loc = !default_loc) ?(attrs = []) desc = {

prf_desc = desc;

prf_loc = loc;

prf_attributes = attrs;

}

let tag ?loc ?attrs label const tys =

mk ?loc ?attrs (Rtag (label, const, tys))

let inherit_?loc ty =

mk ?loc (Rinherit ty)

module Of = struct

let mk ?(loc = !default_loc) ?(attrs=[]) desc = {

pof_desc = desc;

pof_loc = loc;

pof_attributes = attrs;

}

let tag ?loc ?attrs label ty =

mk ?loc ?attrs (Otag (label, ty))

let inherit_ ?loc ty =

mk ?loc (Oinherit ty)