diff --git a/ast/ast.ml b/ast/ast.ml index f2dd24f4b..e8d5ae54c 100644 --- a/ast/ast.ml +++ b/ast/ast.ml @@ -51,6 +51,8 @@ and location = Location.t = { loc_ghost: bool; } +and location_stack = location list + (* Note on the use of Lexing.position in this module. If [pos_fname = ""], then use [!input_name] instead. If [pos_lnum = -1], then [pos_bol = 0]. Use [pos_cnum] and @@ -125,7 +127,11 @@ and constant = Parsetree.constant = (** {1 Extension points} *) -and attribute = string loc * payload +and attribute = Parsetree.attribute = + { attr_name : string loc; + attr_payload : payload; + attr_loc : location; + } (* [@id ARG] [@@id ARG] @@ -156,6 +162,7 @@ and core_type = Parsetree.core_type = { ptyp_desc: core_type_desc; ptyp_loc: location; + ptyp_loc_stack: location_stack; ptyp_attributes: attributes; (* ... [@id1] [@id2] *) } @@ -228,7 +235,13 @@ and package_type = longident_loc * (longident_loc * core_type) list *) and row_field = Parsetree.row_field = - | Rtag of label loc * attributes * bool * core_type list + { prf_desc : row_field_desc; + prf_loc : location; + prf_attributes : attributes; + } + +and row_field_desc = Parsetree.row_field_desc = + | Rtag of label loc * bool * core_type list (* [`A] ( true, [] ) [`A of T] ( false, [T] ) [`A of T1 & .. & Tn] ( false, [T1;...Tn] ) @@ -245,7 +258,13 @@ and row_field = Parsetree.row_field = (* [ T ] *) and object_field = Parsetree.object_field = - | Otag of label loc * attributes * core_type + { pof_desc : object_field_desc; + pof_loc : location; + pof_attributes : attributes; + } + +and object_field_desc = Parsetree.object_field_desc = + | Otag of label loc * core_type | Oinherit of core_type (* Patterns *) @@ -254,6 +273,7 @@ and pattern = Parsetree.pattern = { ppat_desc: pattern_desc; ppat_loc: location; + ppat_loc_stack: location_stack; ppat_attributes: attributes; (* ... [@id1] [@id2] *) } @@ -319,6 +339,7 @@ and expression = Parsetree.expression = { pexp_desc: expression_desc; pexp_loc: location; + pexp_loc_stack: location_stack; pexp_attributes: attributes; (* ... [@id1] [@id2] *) } @@ -432,10 +453,13 @@ and expression_desc = Parsetree.expression_desc = (module ME : S) is represented as Pexp_constraint(Pexp_pack, Ptyp_package S) *) - | Pexp_open of override_flag * longident_loc * expression + | Pexp_open of open_declaration * expression (* M.(E) let open M in E let! open M in E *) + | Pexp_letop of letop + (* let* P = E in E + let* P = E and* P = E in E *) | Pexp_extension of extension (* [%id] *) | Pexp_unreachable @@ -448,6 +472,19 @@ and case = Parsetree.case = (* (P -> E) or (P when E0 -> E) *) pc_rhs: expression; } +and letop = Parsetree.letop = + { let_ : binding_op; + ands : binding_op list; + body : expression; + } + +and binding_op = Parsetree.binding_op = + { pbop_op : string loc; + pbop_pat : pattern; + pbop_exp : expression; + pbop_loc : location; + } + (* Value descriptions *) and value_description = Parsetree.value_description = @@ -540,6 +577,7 @@ and type_extension = Parsetree.type_extension = ptyext_params: (core_type * variance) list; ptyext_constructors: extension_constructor list; ptyext_private: private_flag; + ptyext_loc: location; ptyext_attributes: attributes; (* ... [@@id1] [@@id2] *) } (* @@ -554,6 +592,12 @@ and extension_constructor = Parsetree.extension_constructor = pext_attributes: attributes; (* C of ... [@id1] [@id2] *) } +and type_exception = Parsetree.type_exception = + { ptyexn_constructor: extension_constructor; + ptyexn_loc: location; + ptyexn_attributes: attributes; + } + and extension_constructor_kind = Parsetree.extension_constructor_kind = Pext_decl of constructor_arguments * core_type option (* @@ -590,7 +634,7 @@ and class_type_desc = Parsetree.class_type_desc = *) | Pcty_extension of extension (* [%id] *) - | Pcty_open of override_flag * longident_loc * class_type + | Pcty_open of open_description * class_type (* let open M in CT *) and class_signature = Parsetree.class_signature = @@ -682,7 +726,7 @@ and class_expr_desc = Parsetree.class_expr_desc = (* (CE : CT) *) | Pcl_extension of extension (* [%id] *) - | Pcl_open of override_flag * longident_loc * class_expr + | Pcl_open of open_description * class_expr (* let open M in CE *) @@ -775,12 +819,16 @@ and signature_item_desc = Parsetree.signature_item_desc = *) | Psig_type of rec_flag * type_declaration list (* type t1 = ... and ... and tn = ... *) + | Psig_typesubst of type_declaration list + (* type t1 := ... and ... and tn := ... *) | Psig_typext of type_extension (* type t1 += ... *) - | Psig_exception of extension_constructor + | Psig_exception of type_exception (* exception C of T *) | Psig_module of module_declaration (* module X : MT *) + | Psig_modsubst of module_substitution + (* module X := M *) | Psig_recmodule of module_declaration list (* module rec X1 : MT1 and ... and Xn : MTn *) | Psig_modtype of module_type_declaration @@ -808,6 +856,13 @@ and module_declaration = Parsetree.module_declaration = } (* S : MT *) +and module_substitution = Parsetree.module_substitution = + { pms_name: string loc; + pms_manifest: longident_loc; + pms_attributes: attributes; + pms_loc: location; + } + and module_type_declaration = Parsetree.module_type_declaration = { pmtd_name: string loc; @@ -819,18 +874,21 @@ and module_type_declaration = Parsetree.module_type_declaration = S (abstract module type declaration, pmtd_type = None) *) -and open_description = Parsetree.open_description = - { - popen_lid: longident_loc; +and 'a open_infos = 'a Parsetree.open_infos = + { popen_expr: 'a; popen_override: override_flag; popen_loc: location; popen_attributes: attributes; } + +and open_description = longident_loc open_infos (* open! X - popen_override = Override (silences the 'used identifier shadowing' warning) open X - popen_override = Fresh *) +and open_declaration = module_expr open_infos + and 'a include_infos = 'a Parsetree.include_infos = { pincl_mod: 'a; @@ -904,7 +962,7 @@ and structure_item_desc = Parsetree.structure_item_desc = (* type t1 = ... and ... and tn = ... *) | Pstr_typext of type_extension (* type t1 += ... *) - | Pstr_exception of extension_constructor + | Pstr_exception of type_exception (* exception C of T exception C = M.X *) | Pstr_module of module_binding @@ -913,7 +971,7 @@ and structure_item_desc = Parsetree.structure_item_desc = (* module rec X1 = ME1 and ... and Xn = MEn *) | Pstr_modtype of module_type_declaration (* module type S = MT *) - | Pstr_open of open_description + | Pstr_open of open_declaration (* open X *) | Pstr_class of class_declaration list (* class c1 = ... and ... and cn = ... *) @@ -949,11 +1007,20 @@ and module_binding = Parsetree.module_binding = and toplevel_phrase = Parsetree.toplevel_phrase = | Ptop_def of structure - | Ptop_dir of string * directive_argument + | Ptop_dir of toplevel_directive (* #use, #load ... *) +and toplevel_directive = Parsetree.toplevel_directive = + { pdir_name : string loc; + pdir_arg : directive_argument option; + pdir_loc : location; + } and directive_argument = Parsetree.directive_argument = - | Pdir_none + { pdira_desc : directive_argument_desc; + pdira_loc : location; + } + +and directive_argument_desc = Parsetree.directive_argument_desc = | Pdir_string of string | Pdir_int of string * char option | Pdir_ident of longident @@ -969,519 +1036,541 @@ class virtual map = method virtual option : 'a . ('a -> 'a) -> 'a option -> 'a option method virtual string : string -> string method position : position -> position= - fun { pos_fname; pos_lnum; pos_bol; pos_cnum } -> - let pos_fname = self#string pos_fname in - let pos_lnum = self#int pos_lnum in - let pos_bol = self#int pos_bol in - let pos_cnum = self#int pos_cnum in - { pos_fname; pos_lnum; pos_bol; pos_cnum } + fun { pos_fname; pos_lnum; pos_bol; pos_cnum } -> + let pos_fname = self#string pos_fname in + let pos_lnum = self#int pos_lnum in + let pos_bol = self#int pos_bol in + let pos_cnum = self#int pos_cnum in + { pos_fname; pos_lnum; pos_bol; pos_cnum } method location : location -> location= - fun { loc_start; loc_end; loc_ghost } -> - let loc_start = self#position loc_start in - let loc_end = self#position loc_end in - let loc_ghost = self#bool loc_ghost in - { loc_start; loc_end; loc_ghost } + fun { loc_start; loc_end; loc_ghost } -> + let loc_start = self#position loc_start in + let loc_end = self#position loc_end in + let loc_ghost = self#bool loc_ghost in + { loc_start; loc_end; loc_ghost } + method location_stack : location_stack -> location_stack = + self#list self#location method loc : 'a . ('a -> 'a) -> 'a loc -> 'a loc= - fun _a -> - fun { txt; loc } -> - let txt = _a txt in let loc = self#location loc in { txt; loc } + fun _a -> + fun { txt; loc } -> + let txt = _a txt in let loc = self#location loc in { txt; loc } method longident : longident -> longident= - fun x -> - match x with - | Lident a -> let a = self#string a in Lident a - | Ldot (a,b) -> - let a = self#longident a in - let b = self#string b in Ldot (a, b) - | Lapply (a,b) -> - let a = self#longident a in - let b = self#longident b in Lapply (a, b) + fun x -> + match x with + | Lident a -> let a = self#string a in Lident a + | Ldot (a, b) -> + let a = self#longident a in let b = self#string b in Ldot (a, b) + | Lapply (a, b) -> + let a = self#longident a in + let b = self#longident b in Lapply (a, b) method longident_loc : longident_loc -> longident_loc= self#loc self#longident - method rec_flag : rec_flag -> rec_flag= fun x -> x - method direction_flag : direction_flag -> direction_flag= fun x -> x - method private_flag : private_flag -> private_flag= fun x -> x - method mutable_flag : mutable_flag -> mutable_flag= fun x -> x - method virtual_flag : virtual_flag -> virtual_flag= fun x -> x - method override_flag : override_flag -> override_flag= fun x -> x - method closed_flag : closed_flag -> closed_flag= fun x -> x + method rec_flag : rec_flag -> rec_flag= fun x -> x + method direction_flag : direction_flag -> direction_flag= fun x -> x + method private_flag : private_flag -> private_flag= fun x -> x + method mutable_flag : mutable_flag -> mutable_flag= fun x -> x + method virtual_flag : virtual_flag -> virtual_flag= fun x -> x + method override_flag : override_flag -> override_flag= fun x -> x + method closed_flag : closed_flag -> closed_flag= fun x -> x method label : label -> label= self#string method arg_label : arg_label -> arg_label= - fun x -> - match x with - | Nolabel -> Nolabel - | Labelled a -> let a = self#string a in Labelled a - | Optional a -> let a = self#string a in Optional a - method variance : variance -> variance= fun x -> x + fun x -> + match x with + | Nolabel -> Nolabel + | Labelled a -> let a = self#string a in Labelled a + | Optional a -> let a = self#string a in Optional a + method variance : variance -> variance= fun x -> x method constant : constant -> constant= - fun x -> - match x with - | Pconst_integer (a,b) -> - let a = self#string a in - let b = self#option self#char b in Pconst_integer (a, b) - | Pconst_char a -> let a = self#char a in Pconst_char a - | Pconst_string (a,b) -> - let a = self#string a in - let b = self#option self#string b in Pconst_string (a, b) - | Pconst_float (a,b) -> - let a = self#string a in - let b = self#option self#char b in Pconst_float (a, b) + fun x -> + match x with + | Pconst_integer (a, b) -> + let a = self#string a in + let b = self#option self#char b in Pconst_integer (a, b) + | Pconst_char a -> let a = self#char a in Pconst_char a + | Pconst_string (a, b) -> + let a = self#string a in + let b = self#option self#string b in Pconst_string (a, b) + | Pconst_float (a, b) -> + let a = self#string a in + let b = self#option self#char b in Pconst_float (a, b) method attribute : attribute -> attribute= - fun (a,b) -> - let a = self#loc self#string a in let b = self#payload b in (a, b) + fun { attr_name; attr_payload; attr_loc } -> + let attr_name = self#loc self#string attr_name in + let attr_payload = self#payload attr_payload in + let attr_loc = self#location attr_loc in + { attr_name; attr_payload; attr_loc } method extension : extension -> extension= - fun (a,b) -> - let a = self#loc self#string a in let b = self#payload b in (a, b) + fun (a, b) -> + let a = self#loc self#string a in let b = self#payload b in (a, b) method attributes : attributes -> attributes= self#list self#attribute method payload : payload -> payload= - fun x -> - match x with - | PStr a -> let a = self#structure a in PStr a - | PSig a -> let a = self#signature a in PSig a - | PTyp a -> let a = self#core_type a in PTyp a - | PPat (a,b) -> - let a = self#pattern a in - let b = self#option self#expression b in PPat (a, b) + fun x -> + match x with + | PStr a -> let a = self#structure a in PStr a + | PSig a -> let a = self#signature a in PSig a + | PTyp a -> let a = self#core_type a in PTyp a + | PPat (a, b) -> + let a = self#pattern a in + let b = self#option self#expression b in PPat (a, b) method core_type : core_type -> core_type= - fun { ptyp_desc; ptyp_loc; ptyp_attributes } -> - let ptyp_desc = self#core_type_desc ptyp_desc in - let ptyp_loc = self#location ptyp_loc in - let ptyp_attributes = self#attributes ptyp_attributes in - { ptyp_desc; ptyp_loc; ptyp_attributes } + fun { ptyp_desc; ptyp_loc; ptyp_loc_stack; ptyp_attributes } -> + let ptyp_desc = self#core_type_desc ptyp_desc in + let ptyp_loc = self#location ptyp_loc in + let ptyp_loc_stack = self#location_stack ptyp_loc_stack in + let ptyp_attributes = self#attributes ptyp_attributes in + { ptyp_desc; ptyp_loc; ptyp_loc_stack; ptyp_attributes } method core_type_desc : core_type_desc -> core_type_desc= - fun x -> - match x with - | Ptyp_any -> Ptyp_any - | Ptyp_var a -> let a = self#string a in Ptyp_var a - | Ptyp_arrow (a,b,c) -> - let a = self#arg_label a in - let b = self#core_type b in - let c = self#core_type c in Ptyp_arrow (a, b, c) - | Ptyp_tuple a -> let a = self#list self#core_type a in Ptyp_tuple a - | Ptyp_constr (a,b) -> - let a = self#longident_loc a in - let b = self#list self#core_type b in Ptyp_constr (a, b) - | Ptyp_object (a,b) -> - let a = self#list self#object_field a in - let b = self#closed_flag b in Ptyp_object (a, b) - | Ptyp_class (a,b) -> - let a = self#longident_loc a in - let b = self#list self#core_type b in Ptyp_class (a, b) - | Ptyp_alias (a,b) -> - let a = self#core_type a in - let b = self#string b in Ptyp_alias (a, b) - | Ptyp_variant (a,b,c) -> - let a = self#list self#row_field a in - let b = self#closed_flag b in - let c = self#option (self#list self#label) c in - Ptyp_variant (a, b, c) - | Ptyp_poly (a,b) -> - let a = self#list (self#loc self#string) a in - let b = self#core_type b in Ptyp_poly (a, b) - | Ptyp_package a -> let a = self#package_type a in Ptyp_package a - | Ptyp_extension a -> let a = self#extension a in Ptyp_extension a + fun x -> + match x with + | Ptyp_any -> Ptyp_any + | Ptyp_var a -> let a = self#string a in Ptyp_var a + | Ptyp_arrow (a, b, c) -> + let a = self#arg_label a in + let b = self#core_type b in + let c = self#core_type c in Ptyp_arrow (a, b, c) + | Ptyp_tuple a -> let a = self#list self#core_type a in Ptyp_tuple a + | Ptyp_constr (a, b) -> + let a = self#longident_loc a in + let b = self#list self#core_type b in Ptyp_constr (a, b) + | Ptyp_object (a, b) -> + let a = self#list self#object_field a in + let b = self#closed_flag b in Ptyp_object (a, b) + | Ptyp_class (a, b) -> + let a = self#longident_loc a in + let b = self#list self#core_type b in Ptyp_class (a, b) + | Ptyp_alias (a, b) -> + let a = self#core_type a in + let b = self#string b in Ptyp_alias (a, b) + | Ptyp_variant (a, b, c) -> + let a = self#list self#row_field a in + let b = self#closed_flag b in + let c = self#option (self#list self#label) c in + Ptyp_variant (a, b, c) + | Ptyp_poly (a, b) -> + let a = self#list (self#loc self#string) a in + let b = self#core_type b in Ptyp_poly (a, b) + | Ptyp_package a -> let a = self#package_type a in Ptyp_package a + | Ptyp_extension a -> let a = self#extension a in Ptyp_extension a method package_type : package_type -> package_type= - fun (a,b) -> - let a = self#longident_loc a in - let b = - self#list - (fun (a,b) -> - let a = self#longident_loc a in - let b = self#core_type b in (a, b)) b - in - (a, b) + fun (a, b) -> + let a = self#longident_loc a in + let b = + self#list + (fun (a, b) -> + let a = self#longident_loc a in + let b = self#core_type b in (a, b)) b in + (a, b) method row_field : row_field -> row_field= - fun x -> - match x with - | Rtag (a,b,c,d) -> - let a = self#loc self#label a in - let b = self#attributes b in - let c = self#bool c in - let d = self#list self#core_type d in Rtag (a, b, c, d) - | Rinherit a -> let a = self#core_type a in Rinherit a + fun { prf_desc; prf_loc; prf_attributes } -> + let prf_desc = self#row_field_desc prf_desc in + let prf_loc = self#location prf_loc in + let prf_attributes = self#attributes prf_attributes in + { prf_desc; prf_loc; prf_attributes } + method row_field_desc : row_field_desc -> row_field_desc= + fun x -> + match x with + | Rtag (a, b, c) -> + let a = self#loc self#label a in + let b = self#bool b in + let c = self#list self#core_type c in Rtag (a, b, c) + | Rinherit a -> let a = self#core_type a in Rinherit a method object_field : object_field -> object_field= - fun x -> - match x with - | Otag (a,b,c) -> - let a = self#loc self#label a in - let b = self#attributes b in - let c = self#core_type c in Otag (a, b, c) - | Oinherit a -> let a = self#core_type a in Oinherit a + fun { pof_desc; pof_loc; pof_attributes } -> + let pof_desc = self#object_field_desc pof_desc in + let pof_loc = self#location pof_loc in + let pof_attributes = self#attributes pof_attributes in + { pof_desc; pof_loc; pof_attributes } + method object_field_desc : object_field_desc -> object_field_desc= + fun x -> + match x with + | Otag (a, b) -> + let a = self#loc self#label a in + let b = self#core_type b in Otag (a, b) + | Oinherit a -> let a = self#core_type a in Oinherit a method pattern : pattern -> pattern= - fun { ppat_desc; ppat_loc; ppat_attributes } -> - let ppat_desc = self#pattern_desc ppat_desc in - let ppat_loc = self#location ppat_loc in - let ppat_attributes = self#attributes ppat_attributes in - { ppat_desc; ppat_loc; ppat_attributes } + fun { ppat_desc; ppat_loc; ppat_loc_stack; ppat_attributes } -> + let ppat_desc = self#pattern_desc ppat_desc in + let ppat_loc = self#location ppat_loc in + let ppat_loc_stack = self#location_stack ppat_loc_stack in + let ppat_attributes = self#attributes ppat_attributes in + { ppat_desc; ppat_loc; ppat_loc_stack; ppat_attributes } method pattern_desc : pattern_desc -> pattern_desc= - fun x -> - match x with - | Ppat_any -> Ppat_any - | Ppat_var a -> let a = self#loc self#string a in Ppat_var a - | Ppat_alias (a,b) -> - let a = self#pattern a in - let b = self#loc self#string b in Ppat_alias (a, b) - | Ppat_constant a -> let a = self#constant a in Ppat_constant a - | Ppat_interval (a,b) -> - let a = self#constant a in - let b = self#constant b in Ppat_interval (a, b) - | Ppat_tuple a -> let a = self#list self#pattern a in Ppat_tuple a - | Ppat_construct (a,b) -> - let a = self#longident_loc a in - let b = self#option self#pattern b in Ppat_construct (a, b) - | Ppat_variant (a,b) -> - let a = self#label a in - let b = self#option self#pattern b in Ppat_variant (a, b) - | Ppat_record (a,b) -> - let a = - self#list - (fun (a,b) -> - let a = self#longident_loc a in - let b = self#pattern b in (a, b)) a - in - let b = self#closed_flag b in Ppat_record (a, b) - | Ppat_array a -> let a = self#list self#pattern a in Ppat_array a - | Ppat_or (a,b) -> - let a = self#pattern a in - let b = self#pattern b in Ppat_or (a, b) - | Ppat_constraint (a,b) -> - let a = self#pattern a in - let b = self#core_type b in Ppat_constraint (a, b) - | Ppat_type a -> let a = self#longident_loc a in Ppat_type a - | Ppat_lazy a -> let a = self#pattern a in Ppat_lazy a - | Ppat_unpack a -> let a = self#loc self#string a in Ppat_unpack a - | Ppat_exception a -> let a = self#pattern a in Ppat_exception a - | Ppat_extension a -> let a = self#extension a in Ppat_extension a - | Ppat_open (a,b) -> - let a = self#longident_loc a in - let b = self#pattern b in Ppat_open (a, b) + fun x -> + match x with + | Ppat_any -> Ppat_any + | Ppat_var a -> let a = self#loc self#string a in Ppat_var a + | Ppat_alias (a, b) -> + let a = self#pattern a in + let b = self#loc self#string b in Ppat_alias (a, b) + | Ppat_constant a -> let a = self#constant a in Ppat_constant a + | Ppat_interval (a, b) -> + let a = self#constant a in + let b = self#constant b in Ppat_interval (a, b) + | Ppat_tuple a -> let a = self#list self#pattern a in Ppat_tuple a + | Ppat_construct (a, b) -> + let a = self#longident_loc a in + let b = self#option self#pattern b in Ppat_construct (a, b) + | Ppat_variant (a, b) -> + let a = self#label a in + let b = self#option self#pattern b in Ppat_variant (a, b) + | Ppat_record (a, b) -> + let a = + self#list + (fun (a, b) -> + let a = self#longident_loc a in + let b = self#pattern b in (a, b)) a in + let b = self#closed_flag b in Ppat_record (a, b) + | Ppat_array a -> let a = self#list self#pattern a in Ppat_array a + | Ppat_or (a, b) -> + let a = self#pattern a in + let b = self#pattern b in Ppat_or (a, b) + | Ppat_constraint (a, b) -> + let a = self#pattern a in + let b = self#core_type b in Ppat_constraint (a, b) + | Ppat_type a -> let a = self#longident_loc a in Ppat_type a + | Ppat_lazy a -> let a = self#pattern a in Ppat_lazy a + | Ppat_unpack a -> let a = self#loc self#string a in Ppat_unpack a + | Ppat_exception a -> let a = self#pattern a in Ppat_exception a + | Ppat_extension a -> let a = self#extension a in Ppat_extension a + | Ppat_open (a, b) -> + let a = self#longident_loc a in + let b = self#pattern b in Ppat_open (a, b) method expression : expression -> expression= - fun { pexp_desc; pexp_loc; pexp_attributes } -> - let pexp_desc = self#expression_desc pexp_desc in - let pexp_loc = self#location pexp_loc in - let pexp_attributes = self#attributes pexp_attributes in - { pexp_desc; pexp_loc; pexp_attributes } + fun { pexp_desc; pexp_loc; pexp_loc_stack; pexp_attributes } -> + let pexp_desc = self#expression_desc pexp_desc in + let pexp_loc = self#location pexp_loc in + let pexp_loc_stack = self#location_stack pexp_loc_stack in + let pexp_attributes = self#attributes pexp_attributes in + { pexp_desc; pexp_loc; pexp_loc_stack; pexp_attributes } method expression_desc : expression_desc -> expression_desc= - fun x -> - match x with - | Pexp_ident a -> let a = self#longident_loc a in Pexp_ident a - | Pexp_constant a -> let a = self#constant a in Pexp_constant a - | Pexp_let (a,b,c) -> - let a = self#rec_flag a in - let b = self#list self#value_binding b in - let c = self#expression c in Pexp_let (a, b, c) - | Pexp_function a -> - let a = self#list self#case a in Pexp_function a - | Pexp_fun (a,b,c,d) -> - let a = self#arg_label a in - let b = self#option self#expression b in - let c = self#pattern c in - let d = self#expression d in Pexp_fun (a, b, c, d) - | Pexp_apply (a,b) -> - let a = self#expression a in - let b = - self#list - (fun (a,b) -> - let a = self#arg_label a in - let b = self#expression b in (a, b)) b - in - Pexp_apply (a, b) - | Pexp_match (a,b) -> - let a = self#expression a in - let b = self#list self#case b in Pexp_match (a, b) - | Pexp_try (a,b) -> - let a = self#expression a in - let b = self#list self#case b in Pexp_try (a, b) - | Pexp_tuple a -> - let a = self#list self#expression a in Pexp_tuple a - | Pexp_construct (a,b) -> - let a = self#longident_loc a in - let b = self#option self#expression b in Pexp_construct (a, b) - | Pexp_variant (a,b) -> - let a = self#label a in - let b = self#option self#expression b in Pexp_variant (a, b) - | Pexp_record (a,b) -> - let a = - self#list - (fun (a,b) -> - let a = self#longident_loc a in - let b = self#expression b in (a, b)) a - in - let b = self#option self#expression b in Pexp_record (a, b) - | Pexp_field (a,b) -> - let a = self#expression a in - let b = self#longident_loc b in Pexp_field (a, b) - | Pexp_setfield (a,b,c) -> - let a = self#expression a in - let b = self#longident_loc b in - let c = self#expression c in Pexp_setfield (a, b, c) - | Pexp_array a -> - let a = self#list self#expression a in Pexp_array a - | Pexp_ifthenelse (a,b,c) -> - let a = self#expression a in - let b = self#expression b in - let c = self#option self#expression c in - Pexp_ifthenelse (a, b, c) - | Pexp_sequence (a,b) -> - let a = self#expression a in - let b = self#expression b in Pexp_sequence (a, b) - | Pexp_while (a,b) -> - let a = self#expression a in - let b = self#expression b in Pexp_while (a, b) - | Pexp_for (a,b,c,d,e) -> - let a = self#pattern a in - let b = self#expression b in - let c = self#expression c in - let d = self#direction_flag d in - let e = self#expression e in Pexp_for (a, b, c, d, e) - | Pexp_constraint (a,b) -> - let a = self#expression a in - let b = self#core_type b in Pexp_constraint (a, b) - | Pexp_coerce (a,b,c) -> - let a = self#expression a in - let b = self#option self#core_type b in - let c = self#core_type c in Pexp_coerce (a, b, c) - | Pexp_send (a,b) -> - let a = self#expression a in - let b = self#loc self#label b in Pexp_send (a, b) - | Pexp_new a -> let a = self#longident_loc a in Pexp_new a - | Pexp_setinstvar (a,b) -> - let a = self#loc self#label a in - let b = self#expression b in Pexp_setinstvar (a, b) - | Pexp_override a -> - let a = - self#list - (fun (a,b) -> - let a = self#loc self#label a in - let b = self#expression b in (a, b)) a - in - Pexp_override a - | Pexp_letmodule (a,b,c) -> - let a = self#loc self#string a in - let b = self#module_expr b in - let c = self#expression c in Pexp_letmodule (a, b, c) - | Pexp_letexception (a,b) -> - let a = self#extension_constructor a in - let b = self#expression b in Pexp_letexception (a, b) - | Pexp_assert a -> let a = self#expression a in Pexp_assert a - | Pexp_lazy a -> let a = self#expression a in Pexp_lazy a - | Pexp_poly (a,b) -> - let a = self#expression a in - let b = self#option self#core_type b in Pexp_poly (a, b) - | Pexp_object a -> let a = self#class_structure a in Pexp_object a - | Pexp_newtype (a,b) -> - let a = self#loc self#string a in - let b = self#expression b in Pexp_newtype (a, b) - | Pexp_pack a -> let a = self#module_expr a in Pexp_pack a - | Pexp_open (a,b,c) -> - let a = self#override_flag a in - let b = self#longident_loc b in - let c = self#expression c in Pexp_open (a, b, c) - | Pexp_extension a -> let a = self#extension a in Pexp_extension a - | Pexp_unreachable -> Pexp_unreachable + fun x -> + match x with + | Pexp_ident a -> let a = self#longident_loc a in Pexp_ident a + | Pexp_constant a -> let a = self#constant a in Pexp_constant a + | Pexp_let (a, b, c) -> + let a = self#rec_flag a in + let b = self#list self#value_binding b in + let c = self#expression c in Pexp_let (a, b, c) + | Pexp_function a -> let a = self#list self#case a in Pexp_function a + | Pexp_fun (a, b, c, d) -> + let a = self#arg_label a in + let b = self#option self#expression b in + let c = self#pattern c in + let d = self#expression d in Pexp_fun (a, b, c, d) + | Pexp_apply (a, b) -> + let a = self#expression a in + let b = + self#list + (fun (a, b) -> + let a = self#arg_label a in + let b = self#expression b in (a, b)) b in + Pexp_apply (a, b) + | Pexp_match (a, b) -> + let a = self#expression a in + let b = self#list self#case b in Pexp_match (a, b) + | Pexp_try (a, b) -> + let a = self#expression a in + let b = self#list self#case b in Pexp_try (a, b) + | Pexp_tuple a -> let a = self#list self#expression a in Pexp_tuple a + | Pexp_construct (a, b) -> + let a = self#longident_loc a in + let b = self#option self#expression b in Pexp_construct (a, b) + | Pexp_variant (a, b) -> + let a = self#label a in + let b = self#option self#expression b in Pexp_variant (a, b) + | Pexp_record (a, b) -> + let a = + self#list + (fun (a, b) -> + let a = self#longident_loc a in + let b = self#expression b in (a, b)) a in + let b = self#option self#expression b in Pexp_record (a, b) + | Pexp_field (a, b) -> + let a = self#expression a in + let b = self#longident_loc b in Pexp_field (a, b) + | Pexp_setfield (a, b, c) -> + let a = self#expression a in + let b = self#longident_loc b in + let c = self#expression c in Pexp_setfield (a, b, c) + | Pexp_array a -> let a = self#list self#expression a in Pexp_array a + | Pexp_ifthenelse (a, b, c) -> + let a = self#expression a in + let b = self#expression b in + let c = self#option self#expression c in + Pexp_ifthenelse (a, b, c) + | Pexp_sequence (a, b) -> + let a = self#expression a in + let b = self#expression b in Pexp_sequence (a, b) + | Pexp_while (a, b) -> + let a = self#expression a in + let b = self#expression b in Pexp_while (a, b) + | Pexp_for (a, b, c, d, e) -> + let a = self#pattern a in + let b = self#expression b in + let c = self#expression c in + let d = self#direction_flag d in + let e = self#expression e in Pexp_for (a, b, c, d, e) + | Pexp_constraint (a, b) -> + let a = self#expression a in + let b = self#core_type b in Pexp_constraint (a, b) + | Pexp_coerce (a, b, c) -> + let a = self#expression a in + let b = self#option self#core_type b in + let c = self#core_type c in Pexp_coerce (a, b, c) + | Pexp_send (a, b) -> + let a = self#expression a in + let b = self#loc self#label b in Pexp_send (a, b) + | Pexp_new a -> let a = self#longident_loc a in Pexp_new a + | Pexp_setinstvar (a, b) -> + let a = self#loc self#label a in + let b = self#expression b in Pexp_setinstvar (a, b) + | Pexp_override a -> + let a = + self#list + (fun (a, b) -> + let a = self#loc self#label a in + let b = self#expression b in (a, b)) a in + Pexp_override a + | Pexp_letmodule (a, b, c) -> + let a = self#loc self#string a in + let b = self#module_expr b in + let c = self#expression c in Pexp_letmodule (a, b, c) + | Pexp_letexception (a, b) -> + let a = self#extension_constructor a in + let b = self#expression b in Pexp_letexception (a, b) + | Pexp_assert a -> let a = self#expression a in Pexp_assert a + | Pexp_lazy a -> let a = self#expression a in Pexp_lazy a + | Pexp_poly (a, b) -> + let a = self#expression a in + let b = self#option self#core_type b in Pexp_poly (a, b) + | Pexp_object a -> let a = self#class_structure a in Pexp_object a + | Pexp_newtype (a, b) -> + let a = self#loc self#string a in + let b = self#expression b in Pexp_newtype (a, b) + | Pexp_pack a -> let a = self#module_expr a in Pexp_pack a + | Pexp_open (a, b) -> + let a = self#open_declaration a in + let b = self#expression b in Pexp_open (a, b) + | Pexp_letop a -> let a = self#letop a in Pexp_letop a + | Pexp_extension a -> let a = self#extension a in Pexp_extension a + | Pexp_unreachable -> Pexp_unreachable method case : case -> case= - fun { pc_lhs; pc_guard; pc_rhs } -> - let pc_lhs = self#pattern pc_lhs in - let pc_guard = self#option self#expression pc_guard in - let pc_rhs = self#expression pc_rhs in { pc_lhs; pc_guard; pc_rhs } + fun { pc_lhs; pc_guard; pc_rhs } -> + let pc_lhs = self#pattern pc_lhs in + let pc_guard = self#option self#expression pc_guard in + let pc_rhs = self#expression pc_rhs in { pc_lhs; pc_guard; pc_rhs } + method letop : letop -> letop= + fun { let_; ands; body } -> + let let_ = self#binding_op let_ in + let ands = self#list self#binding_op ands in + let body = self#expression body in { let_; ands; body } + method binding_op : binding_op -> binding_op= + fun { pbop_op; pbop_pat; pbop_exp; pbop_loc } -> + let pbop_op = self#loc self#string pbop_op in + let pbop_pat = self#pattern pbop_pat in + let pbop_exp = self#expression pbop_exp in + let pbop_loc = self#location pbop_loc in + { pbop_op; pbop_pat; pbop_exp; pbop_loc } method value_description : value_description -> value_description= - fun { pval_name; pval_type; pval_prim; pval_attributes; pval_loc } -> - let pval_name = self#loc self#string pval_name in - let pval_type = self#core_type pval_type in - let pval_prim = self#list self#string pval_prim in - let pval_attributes = self#attributes pval_attributes in - let pval_loc = self#location pval_loc in - { pval_name; pval_type; pval_prim; pval_attributes; pval_loc } + fun { pval_name; pval_type; pval_prim; pval_attributes; pval_loc } -> + let pval_name = self#loc self#string pval_name in + let pval_type = self#core_type pval_type in + let pval_prim = self#list self#string pval_prim in + let pval_attributes = self#attributes pval_attributes in + let pval_loc = self#location pval_loc in + { pval_name; pval_type; pval_prim; pval_attributes; pval_loc } method type_declaration : type_declaration -> type_declaration= fun { ptype_name; ptype_params; ptype_cstrs; ptype_kind; ptype_private; ptype_manifest; ptype_attributes; ptype_loc } - -> - let ptype_name = self#loc self#string ptype_name in - let ptype_params = - self#list - (fun (a,b) -> - let a = self#core_type a in - let b = self#variance b in (a, b)) ptype_params - in - let ptype_cstrs = - self#list - (fun (a,b,c) -> - let a = self#core_type a in - let b = self#core_type b in - let c = self#location c in (a, b, c)) ptype_cstrs - in - let ptype_kind = self#type_kind ptype_kind in - let ptype_private = self#private_flag ptype_private in - let ptype_manifest = self#option self#core_type ptype_manifest in - let ptype_attributes = self#attributes ptype_attributes in - let ptype_loc = self#location ptype_loc in - { - ptype_name; - ptype_params; - ptype_cstrs; - ptype_kind; - ptype_private; - ptype_manifest; - ptype_attributes; - ptype_loc - } + -> + let ptype_name = self#loc self#string ptype_name in + let ptype_params = + self#list + (fun (a, b) -> + let a = self#core_type a in let b = self#variance b in (a, b)) + ptype_params in + let ptype_cstrs = + self#list + (fun (a, b, c) -> + let a = self#core_type a in + let b = self#core_type b in + let c = self#location c in (a, b, c)) ptype_cstrs in + let ptype_kind = self#type_kind ptype_kind in + let ptype_private = self#private_flag ptype_private in + let ptype_manifest = self#option self#core_type ptype_manifest in + let ptype_attributes = self#attributes ptype_attributes in + let ptype_loc = self#location ptype_loc in + { + ptype_name; + ptype_params; + ptype_cstrs; + ptype_kind; + ptype_private; + ptype_manifest; + ptype_attributes; + ptype_loc + } method type_kind : type_kind -> type_kind= - fun x -> - match x with - | Ptype_abstract -> Ptype_abstract - | Ptype_variant a -> - let a = self#list self#constructor_declaration a in - Ptype_variant a - | Ptype_record a -> - let a = self#list self#label_declaration a in Ptype_record a - | Ptype_open -> Ptype_open + fun x -> + match x with + | Ptype_abstract -> Ptype_abstract + | Ptype_variant a -> + let a = self#list self#constructor_declaration a in + Ptype_variant a + | Ptype_record a -> + let a = self#list self#label_declaration a in Ptype_record a + | Ptype_open -> Ptype_open method label_declaration : label_declaration -> label_declaration= - fun { pld_name; pld_mutable; pld_type; pld_loc; pld_attributes } -> - let pld_name = self#loc self#string pld_name in - let pld_mutable = self#mutable_flag pld_mutable in - let pld_type = self#core_type pld_type in - let pld_loc = self#location pld_loc in - let pld_attributes = self#attributes pld_attributes in - { pld_name; pld_mutable; pld_type; pld_loc; pld_attributes } + fun { pld_name; pld_mutable; pld_type; pld_loc; pld_attributes } -> + let pld_name = self#loc self#string pld_name in + let pld_mutable = self#mutable_flag pld_mutable in + let pld_type = self#core_type pld_type in + let pld_loc = self#location pld_loc in + let pld_attributes = self#attributes pld_attributes in + { pld_name; pld_mutable; pld_type; pld_loc; pld_attributes } method constructor_declaration : constructor_declaration -> constructor_declaration= - fun { pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes } -> - let pcd_name = self#loc self#string pcd_name in - let pcd_args = self#constructor_arguments pcd_args in - let pcd_res = self#option self#core_type pcd_res in - let pcd_loc = self#location pcd_loc in - let pcd_attributes = self#attributes pcd_attributes in - { pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes } + fun { pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes } -> + let pcd_name = self#loc self#string pcd_name in + let pcd_args = self#constructor_arguments pcd_args in + let pcd_res = self#option self#core_type pcd_res in + let pcd_loc = self#location pcd_loc in + let pcd_attributes = self#attributes pcd_attributes in + { pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes } method constructor_arguments : constructor_arguments -> constructor_arguments= - fun x -> - match x with - | Pcstr_tuple a -> - let a = self#list self#core_type a in Pcstr_tuple a - | Pcstr_record a -> - let a = self#list self#label_declaration a in Pcstr_record a + fun x -> + match x with + | Pcstr_tuple a -> + let a = self#list self#core_type a in Pcstr_tuple a + | Pcstr_record a -> + let a = self#list self#label_declaration a in Pcstr_record a method type_extension : type_extension -> type_extension= fun { ptyext_path; ptyext_params; ptyext_constructors; ptyext_private; - ptyext_attributes } - -> - let ptyext_path = self#longident_loc ptyext_path in - let ptyext_params = - self#list - (fun (a,b) -> - let a = self#core_type a in - let b = self#variance b in (a, b)) ptyext_params - in - let ptyext_constructors = - self#list self#extension_constructor ptyext_constructors in - let ptyext_private = self#private_flag ptyext_private in - let ptyext_attributes = self#attributes ptyext_attributes in - { - ptyext_path; - ptyext_params; - ptyext_constructors; - ptyext_private; - ptyext_attributes - } + ptyext_loc; ptyext_attributes } + -> + let ptyext_path = self#longident_loc ptyext_path in + let ptyext_params = + self#list + (fun (a, b) -> + let a = self#core_type a in let b = self#variance b in (a, b)) + ptyext_params in + let ptyext_constructors = + self#list self#extension_constructor ptyext_constructors in + let ptyext_private = self#private_flag ptyext_private in + let ptyext_loc = self#location ptyext_loc in + let ptyext_attributes = self#attributes ptyext_attributes in + { + ptyext_path; + ptyext_params; + ptyext_constructors; + ptyext_private; + ptyext_loc; + ptyext_attributes + } method extension_constructor : extension_constructor -> extension_constructor= - fun { pext_name; pext_kind; pext_loc; pext_attributes } -> - let pext_name = self#loc self#string pext_name in - let pext_kind = self#extension_constructor_kind pext_kind in - let pext_loc = self#location pext_loc in - let pext_attributes = self#attributes pext_attributes in - { pext_name; pext_kind; pext_loc; pext_attributes } + fun { pext_name; pext_kind; pext_loc; pext_attributes } -> + let pext_name = self#loc self#string pext_name in + let pext_kind = self#extension_constructor_kind pext_kind in + let pext_loc = self#location pext_loc in + let pext_attributes = self#attributes pext_attributes in + { pext_name; pext_kind; pext_loc; pext_attributes } + method type_exception : type_exception -> type_exception= + fun { ptyexn_constructor; ptyexn_loc; ptyexn_attributes } -> + let ptyexn_constructor = + self#extension_constructor ptyexn_constructor in + let ptyexn_loc = self#location ptyexn_loc in + let ptyexn_attributes = self#attributes ptyexn_attributes in + { ptyexn_constructor; ptyexn_loc; ptyexn_attributes } method extension_constructor_kind : extension_constructor_kind -> extension_constructor_kind= - fun x -> - match x with - | Pext_decl (a,b) -> - let a = self#constructor_arguments a in - let b = self#option self#core_type b in Pext_decl (a, b) - | Pext_rebind a -> let a = self#longident_loc a in Pext_rebind a + fun x -> + match x with + | Pext_decl (a, b) -> + let a = self#constructor_arguments a in + let b = self#option self#core_type b in Pext_decl (a, b) + | Pext_rebind a -> let a = self#longident_loc a in Pext_rebind a method class_type : class_type -> class_type= - fun { pcty_desc; pcty_loc; pcty_attributes } -> - let pcty_desc = self#class_type_desc pcty_desc in - let pcty_loc = self#location pcty_loc in - let pcty_attributes = self#attributes pcty_attributes in - { pcty_desc; pcty_loc; pcty_attributes } + fun { pcty_desc; pcty_loc; pcty_attributes } -> + let pcty_desc = self#class_type_desc pcty_desc in + let pcty_loc = self#location pcty_loc in + let pcty_attributes = self#attributes pcty_attributes in + { pcty_desc; pcty_loc; pcty_attributes } method class_type_desc : class_type_desc -> class_type_desc= - fun x -> - match x with - | Pcty_constr (a,b) -> - let a = self#longident_loc a in - let b = self#list self#core_type b in Pcty_constr (a, b) - | Pcty_signature a -> - let a = self#class_signature a in Pcty_signature a - | Pcty_arrow (a,b,c) -> - let a = self#arg_label a in - let b = self#core_type b in - let c = self#class_type c in Pcty_arrow (a, b, c) - | Pcty_extension a -> let a = self#extension a in Pcty_extension a - | Pcty_open (a,b,c) -> - let a = self#override_flag a in - let b = self#longident_loc b in - let c = self#class_type c in Pcty_open (a, b, c) + fun x -> + match x with + | Pcty_constr (a, b) -> + let a = self#longident_loc a in + let b = self#list self#core_type b in Pcty_constr (a, b) + | Pcty_signature a -> + let a = self#class_signature a in Pcty_signature a + | Pcty_arrow (a, b, c) -> + let a = self#arg_label a in + let b = self#core_type b in + let c = self#class_type c in Pcty_arrow (a, b, c) + | Pcty_extension a -> let a = self#extension a in Pcty_extension a + | Pcty_open (a, b) -> + let a = self#open_description a in + let b = self#class_type b in Pcty_open (a, b) method class_signature : class_signature -> class_signature= - fun { pcsig_self; pcsig_fields } -> - let pcsig_self = self#core_type pcsig_self in - let pcsig_fields = self#list self#class_type_field pcsig_fields in - { pcsig_self; pcsig_fields } + fun { pcsig_self; pcsig_fields } -> + let pcsig_self = self#core_type pcsig_self in + let pcsig_fields = self#list self#class_type_field pcsig_fields in + { pcsig_self; pcsig_fields } method class_type_field : class_type_field -> class_type_field= - fun { pctf_desc; pctf_loc; pctf_attributes } -> - let pctf_desc = self#class_type_field_desc pctf_desc in - let pctf_loc = self#location pctf_loc in - let pctf_attributes = self#attributes pctf_attributes in - { pctf_desc; pctf_loc; pctf_attributes } + fun { pctf_desc; pctf_loc; pctf_attributes } -> + let pctf_desc = self#class_type_field_desc pctf_desc in + let pctf_loc = self#location pctf_loc in + let pctf_attributes = self#attributes pctf_attributes in + { pctf_desc; pctf_loc; pctf_attributes } method class_type_field_desc : class_type_field_desc -> class_type_field_desc= - fun x -> - match x with - | Pctf_inherit a -> let a = self#class_type a in Pctf_inherit a - | Pctf_val a -> - let a = - (fun (a,b,c,d) -> - let a = self#loc self#label a in - let b = self#mutable_flag b in - let c = self#virtual_flag c in - let d = self#core_type d in (a, b, c, d)) a - in - Pctf_val a - | Pctf_method a -> - let a = - (fun (a,b,c,d) -> - let a = self#loc self#label a in - let b = self#private_flag b in - let c = self#virtual_flag c in - let d = self#core_type d in (a, b, c, d)) a - in - Pctf_method a - | Pctf_constraint a -> - let a = - (fun (a,b) -> - let a = self#core_type a in - let b = self#core_type b in (a, b)) a - in - Pctf_constraint a - | Pctf_attribute a -> let a = self#attribute a in Pctf_attribute a - | Pctf_extension a -> let a = self#extension a in Pctf_extension a + fun x -> + match x with + | Pctf_inherit a -> let a = self#class_type a in Pctf_inherit a + | Pctf_val a -> + let a = + (fun (a, b, c, d) -> + let a = self#loc self#label a in + let b = self#mutable_flag b in + let c = self#virtual_flag c in + let d = self#core_type d in (a, b, c, d)) a in + Pctf_val a + | Pctf_method a -> + let a = + (fun (a, b, c, d) -> + let a = self#loc self#label a in + let b = self#private_flag b in + let c = self#virtual_flag c in + let d = self#core_type d in (a, b, c, d)) a in + Pctf_method a + | Pctf_constraint a -> + let a = + (fun (a, b) -> + let a = self#core_type a in + let b = self#core_type b in (a, b)) a in + Pctf_constraint a + | Pctf_attribute a -> let a = self#attribute a in Pctf_attribute a + | Pctf_extension a -> let a = self#extension a in Pctf_extension a method class_infos : 'a . ('a -> 'a) -> 'a class_infos -> 'a class_infos= - fun _a -> - fun - { pci_virt; pci_params; pci_name; pci_expr; pci_loc; pci_attributes - } - -> - let pci_virt = self#virtual_flag pci_virt in + fun _a -> + fun + { pci_virt; pci_params; pci_name; pci_expr; pci_loc; pci_attributes + } + -> + let pci_virt = self#virtual_flag pci_virt in let pci_params = self#list - (fun (a,b) -> - let a = self#core_type a in - let b = self#variance b in (a, b)) pci_params - in - let pci_name = self#loc self#string pci_name in - let pci_expr = _a pci_expr in - let pci_loc = self#location pci_loc in - let pci_attributes = self#attributes pci_attributes in + (fun (a, b) -> + let a = self#core_type a in + let b = self#variance b in (a, b)) pci_params in + let pci_name = self#loc self#string pci_name in + let pci_expr = _a pci_expr in + let pci_loc = self#location pci_loc in + let pci_attributes = self#attributes pci_attributes in { pci_virt; pci_params; pci_name; pci_expr; pci_loc; pci_attributes } method class_description : class_description -> class_description= @@ -1490,296 +1579,313 @@ class virtual map = class_type_declaration -> class_type_declaration= self#class_infos self#class_type method class_expr : class_expr -> class_expr= - fun { pcl_desc; pcl_loc; pcl_attributes } -> - let pcl_desc = self#class_expr_desc pcl_desc in - let pcl_loc = self#location pcl_loc in - let pcl_attributes = self#attributes pcl_attributes in - { pcl_desc; pcl_loc; pcl_attributes } + fun { pcl_desc; pcl_loc; pcl_attributes } -> + let pcl_desc = self#class_expr_desc pcl_desc in + let pcl_loc = self#location pcl_loc in + let pcl_attributes = self#attributes pcl_attributes in + { pcl_desc; pcl_loc; pcl_attributes } method class_expr_desc : class_expr_desc -> class_expr_desc= - fun x -> - match x with - | Pcl_constr (a,b) -> - let a = self#longident_loc a in - let b = self#list self#core_type b in Pcl_constr (a, b) - | Pcl_structure a -> - let a = self#class_structure a in Pcl_structure a - | Pcl_fun (a,b,c,d) -> - let a = self#arg_label a in - let b = self#option self#expression b in - let c = self#pattern c in - let d = self#class_expr d in Pcl_fun (a, b, c, d) - | Pcl_apply (a,b) -> - let a = self#class_expr a in - let b = - self#list - (fun (a,b) -> - let a = self#arg_label a in - let b = self#expression b in (a, b)) b - in - Pcl_apply (a, b) - | Pcl_let (a,b,c) -> - let a = self#rec_flag a in - let b = self#list self#value_binding b in - let c = self#class_expr c in Pcl_let (a, b, c) - | Pcl_constraint (a,b) -> - let a = self#class_expr a in - let b = self#class_type b in Pcl_constraint (a, b) - | Pcl_extension a -> let a = self#extension a in Pcl_extension a - | Pcl_open (a,b,c) -> - let a = self#override_flag a in - let b = self#longident_loc b in - let c = self#class_expr c in Pcl_open (a, b, c) + fun x -> + match x with + | Pcl_constr (a, b) -> + let a = self#longident_loc a in + let b = self#list self#core_type b in Pcl_constr (a, b) + | Pcl_structure a -> + let a = self#class_structure a in Pcl_structure a + | Pcl_fun (a, b, c, d) -> + let a = self#arg_label a in + let b = self#option self#expression b in + let c = self#pattern c in + let d = self#class_expr d in Pcl_fun (a, b, c, d) + | Pcl_apply (a, b) -> + let a = self#class_expr a in + let b = + self#list + (fun (a, b) -> + let a = self#arg_label a in + let b = self#expression b in (a, b)) b in + Pcl_apply (a, b) + | Pcl_let (a, b, c) -> + let a = self#rec_flag a in + let b = self#list self#value_binding b in + let c = self#class_expr c in Pcl_let (a, b, c) + | Pcl_constraint (a, b) -> + let a = self#class_expr a in + let b = self#class_type b in Pcl_constraint (a, b) + | Pcl_extension a -> let a = self#extension a in Pcl_extension a + | Pcl_open (a, b) -> + let a = self#open_description a in + let b = self#class_expr b in Pcl_open (a, b) method class_structure : class_structure -> class_structure= - fun { pcstr_self; pcstr_fields } -> - let pcstr_self = self#pattern pcstr_self in - let pcstr_fields = self#list self#class_field pcstr_fields in - { pcstr_self; pcstr_fields } + fun { pcstr_self; pcstr_fields } -> + let pcstr_self = self#pattern pcstr_self in + let pcstr_fields = self#list self#class_field pcstr_fields in + { pcstr_self; pcstr_fields } method class_field : class_field -> class_field= - fun { pcf_desc; pcf_loc; pcf_attributes } -> - let pcf_desc = self#class_field_desc pcf_desc in - let pcf_loc = self#location pcf_loc in - let pcf_attributes = self#attributes pcf_attributes in - { pcf_desc; pcf_loc; pcf_attributes } + fun { pcf_desc; pcf_loc; pcf_attributes } -> + let pcf_desc = self#class_field_desc pcf_desc in + let pcf_loc = self#location pcf_loc in + let pcf_attributes = self#attributes pcf_attributes in + { pcf_desc; pcf_loc; pcf_attributes } method class_field_desc : class_field_desc -> class_field_desc= - fun x -> - match x with - | Pcf_inherit (a,b,c) -> - let a = self#override_flag a in - let b = self#class_expr b in - let c = self#option (self#loc self#string) c in - Pcf_inherit (a, b, c) - | Pcf_val a -> - let a = - (fun (a,b,c) -> - let a = self#loc self#label a in - let b = self#mutable_flag b in - let c = self#class_field_kind c in (a, b, c)) a - in - Pcf_val a - | Pcf_method a -> - let a = - (fun (a,b,c) -> - let a = self#loc self#label a in - let b = self#private_flag b in - let c = self#class_field_kind c in (a, b, c)) a - in - Pcf_method a - | Pcf_constraint a -> - let a = - (fun (a,b) -> - let a = self#core_type a in - let b = self#core_type b in (a, b)) a - in - Pcf_constraint a - | Pcf_initializer a -> - let a = self#expression a in Pcf_initializer a - | Pcf_attribute a -> let a = self#attribute a in Pcf_attribute a - | Pcf_extension a -> let a = self#extension a in Pcf_extension a + fun x -> + match x with + | Pcf_inherit (a, b, c) -> + let a = self#override_flag a in + let b = self#class_expr b in + let c = self#option (self#loc self#string) c in + Pcf_inherit (a, b, c) + | Pcf_val a -> + let a = + (fun (a, b, c) -> + let a = self#loc self#label a in + let b = self#mutable_flag b in + let c = self#class_field_kind c in (a, b, c)) a in + Pcf_val a + | Pcf_method a -> + let a = + (fun (a, b, c) -> + let a = self#loc self#label a in + let b = self#private_flag b in + let c = self#class_field_kind c in (a, b, c)) a in + Pcf_method a + | Pcf_constraint a -> + let a = + (fun (a, b) -> + let a = self#core_type a in + let b = self#core_type b in (a, b)) a in + Pcf_constraint a + | Pcf_initializer a -> let a = self#expression a in Pcf_initializer a + | Pcf_attribute a -> let a = self#attribute a in Pcf_attribute a + | Pcf_extension a -> let a = self#extension a in Pcf_extension a method class_field_kind : class_field_kind -> class_field_kind= - fun x -> - match x with - | Cfk_virtual a -> let a = self#core_type a in Cfk_virtual a - | Cfk_concrete (a,b) -> - let a = self#override_flag a in - let b = self#expression b in Cfk_concrete (a, b) + fun x -> + match x with + | Cfk_virtual a -> let a = self#core_type a in Cfk_virtual a + | Cfk_concrete (a, b) -> + let a = self#override_flag a in + let b = self#expression b in Cfk_concrete (a, b) method class_declaration : class_declaration -> class_declaration= self#class_infos self#class_expr method module_type : module_type -> module_type= - fun { pmty_desc; pmty_loc; pmty_attributes } -> - let pmty_desc = self#module_type_desc pmty_desc in - let pmty_loc = self#location pmty_loc in - let pmty_attributes = self#attributes pmty_attributes in - { pmty_desc; pmty_loc; pmty_attributes } + fun { pmty_desc; pmty_loc; pmty_attributes } -> + let pmty_desc = self#module_type_desc pmty_desc in + let pmty_loc = self#location pmty_loc in + let pmty_attributes = self#attributes pmty_attributes in + { pmty_desc; pmty_loc; pmty_attributes } method module_type_desc : module_type_desc -> module_type_desc= - fun x -> - match x with - | Pmty_ident a -> let a = self#longident_loc a in Pmty_ident a - | Pmty_signature a -> let a = self#signature a in Pmty_signature a - | Pmty_functor (a,b,c) -> - let a = self#loc self#string a in - let b = self#option self#module_type b in - let c = self#module_type c in Pmty_functor (a, b, c) - | Pmty_with (a,b) -> - let a = self#module_type a in - let b = self#list self#with_constraint b in Pmty_with (a, b) - | Pmty_typeof a -> let a = self#module_expr a in Pmty_typeof a - | Pmty_extension a -> let a = self#extension a in Pmty_extension a - | Pmty_alias a -> let a = self#longident_loc a in Pmty_alias a + fun x -> + match x with + | Pmty_ident a -> let a = self#longident_loc a in Pmty_ident a + | Pmty_signature a -> let a = self#signature a in Pmty_signature a + | Pmty_functor (a, b, c) -> + let a = self#loc self#string a in + let b = self#option self#module_type b in + let c = self#module_type c in Pmty_functor (a, b, c) + | Pmty_with (a, b) -> + let a = self#module_type a in + let b = self#list self#with_constraint b in Pmty_with (a, b) + | Pmty_typeof a -> let a = self#module_expr a in Pmty_typeof a + | Pmty_extension a -> let a = self#extension a in Pmty_extension a + | Pmty_alias a -> let a = self#longident_loc a in Pmty_alias a method signature : signature -> signature= self#list self#signature_item method signature_item : signature_item -> signature_item= - fun { psig_desc; psig_loc } -> - let psig_desc = self#signature_item_desc psig_desc in - let psig_loc = self#location psig_loc in { psig_desc; psig_loc } + fun { psig_desc; psig_loc } -> + let psig_desc = self#signature_item_desc psig_desc in + let psig_loc = self#location psig_loc in { psig_desc; psig_loc } method signature_item_desc : signature_item_desc -> signature_item_desc= - fun x -> - match x with - | Psig_value a -> let a = self#value_description a in Psig_value a - | Psig_type (a,b) -> - let a = self#rec_flag a in - let b = self#list self#type_declaration b in Psig_type (a, b) - | Psig_typext a -> let a = self#type_extension a in Psig_typext a - | Psig_exception a -> - let a = self#extension_constructor a in Psig_exception a - | Psig_module a -> - let a = self#module_declaration a in Psig_module a - | Psig_recmodule a -> - let a = self#list self#module_declaration a in Psig_recmodule a - | Psig_modtype a -> - let a = self#module_type_declaration a in Psig_modtype a - | Psig_open a -> let a = self#open_description a in Psig_open a - | Psig_include a -> - let a = self#include_description a in Psig_include a - | Psig_class a -> - let a = self#list self#class_description a in Psig_class a - | Psig_class_type a -> - let a = self#list self#class_type_declaration a in - Psig_class_type a - | Psig_attribute a -> let a = self#attribute a in Psig_attribute a - | Psig_extension (a,b) -> - let a = self#extension a in - let b = self#attributes b in Psig_extension (a, b) + fun x -> + match x with + | Psig_value a -> let a = self#value_description a in Psig_value a + | Psig_type (a, b) -> + let a = self#rec_flag a in + let b = self#list self#type_declaration b in Psig_type (a, b) + | Psig_typesubst a -> + let a = self#list self#type_declaration a in Psig_typesubst a + | Psig_typext a -> let a = self#type_extension a in Psig_typext a + | Psig_exception a -> + let a = self#type_exception a in Psig_exception a + | Psig_module a -> let a = self#module_declaration a in Psig_module a + | Psig_modsubst a -> + let a = self#module_substitution a in Psig_modsubst a + | Psig_recmodule a -> + let a = self#list self#module_declaration a in Psig_recmodule a + | Psig_modtype a -> + let a = self#module_type_declaration a in Psig_modtype a + | Psig_open a -> let a = self#open_description a in Psig_open a + | Psig_include a -> + let a = self#include_description a in Psig_include a + | Psig_class a -> + let a = self#list self#class_description a in Psig_class a + | Psig_class_type a -> + let a = self#list self#class_type_declaration a in + Psig_class_type a + | Psig_attribute a -> let a = self#attribute a in Psig_attribute a + | Psig_extension (a, b) -> + let a = self#extension a in + let b = self#attributes b in Psig_extension (a, b) method module_declaration : module_declaration -> module_declaration= - fun { pmd_name; pmd_type; pmd_attributes; pmd_loc } -> - let pmd_name = self#loc self#string pmd_name in - let pmd_type = self#module_type pmd_type in - let pmd_attributes = self#attributes pmd_attributes in - let pmd_loc = self#location pmd_loc in - { pmd_name; pmd_type; pmd_attributes; pmd_loc } + fun { pmd_name; pmd_type; pmd_attributes; pmd_loc } -> + let pmd_name = self#loc self#string pmd_name in + let pmd_type = self#module_type pmd_type in + let pmd_attributes = self#attributes pmd_attributes in + let pmd_loc = self#location pmd_loc in + { pmd_name; pmd_type; pmd_attributes; pmd_loc } + method module_substitution : module_substitution -> module_substitution= + fun { pms_name; pms_manifest; pms_attributes; pms_loc } -> + let pms_name = self#loc self#string pms_name in + let pms_manifest = self#longident_loc pms_manifest in + let pms_attributes = self#attributes pms_attributes in + let pms_loc = self#location pms_loc in + { pms_name; pms_manifest; pms_attributes; pms_loc } method module_type_declaration : module_type_declaration -> module_type_declaration= - fun { pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc } -> - let pmtd_name = self#loc self#string pmtd_name in - let pmtd_type = self#option self#module_type pmtd_type in - let pmtd_attributes = self#attributes pmtd_attributes in - let pmtd_loc = self#location pmtd_loc in - { pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc } + fun { pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc } -> + let pmtd_name = self#loc self#string pmtd_name in + let pmtd_type = self#option self#module_type pmtd_type in + let pmtd_attributes = self#attributes pmtd_attributes in + let pmtd_loc = self#location pmtd_loc in + { pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc } + method open_infos : 'a . ('a -> 'a) -> 'a open_infos -> 'a open_infos= + fun _a -> + fun { popen_expr; popen_override; popen_loc; popen_attributes } -> + let popen_expr = _a popen_expr in + let popen_override = self#override_flag popen_override in + let popen_loc = self#location popen_loc in + let popen_attributes = self#attributes popen_attributes in + { popen_expr; popen_override; popen_loc; popen_attributes } method open_description : open_description -> open_description= - fun { popen_lid; popen_override; popen_loc; popen_attributes } -> - let popen_lid = self#longident_loc popen_lid in - let popen_override = self#override_flag popen_override in - let popen_loc = self#location popen_loc in - let popen_attributes = self#attributes popen_attributes in - { popen_lid; popen_override; popen_loc; popen_attributes } + self#open_infos self#longident_loc + method open_declaration : open_declaration -> open_declaration= + self#open_infos self#module_expr method include_infos : 'a . ('a -> 'a) -> 'a include_infos -> 'a include_infos= - fun _a -> - fun { pincl_mod; pincl_loc; pincl_attributes } -> - let pincl_mod = _a pincl_mod in - let pincl_loc = self#location pincl_loc in - let pincl_attributes = self#attributes pincl_attributes in - { pincl_mod; pincl_loc; pincl_attributes } + fun _a -> + fun { pincl_mod; pincl_loc; pincl_attributes } -> + let pincl_mod = _a pincl_mod in + let pincl_loc = self#location pincl_loc in + let pincl_attributes = self#attributes pincl_attributes in + { pincl_mod; pincl_loc; pincl_attributes } method include_description : include_description -> include_description= self#include_infos self#module_type method include_declaration : include_declaration -> include_declaration= self#include_infos self#module_expr method with_constraint : with_constraint -> with_constraint= - fun x -> - match x with - | Pwith_type (a,b) -> - let a = self#longident_loc a in - let b = self#type_declaration b in Pwith_type (a, b) - | Pwith_module (a,b) -> - let a = self#longident_loc a in - let b = self#longident_loc b in Pwith_module (a, b) - | Pwith_typesubst (a,b) -> - let a = self#longident_loc a in - let b = self#type_declaration b in Pwith_typesubst (a, b) - | Pwith_modsubst (a,b) -> - let a = self#longident_loc a in - let b = self#longident_loc b in Pwith_modsubst (a, b) + fun x -> + match x with + | Pwith_type (a, b) -> + let a = self#longident_loc a in + let b = self#type_declaration b in Pwith_type (a, b) + | Pwith_module (a, b) -> + let a = self#longident_loc a in + let b = self#longident_loc b in Pwith_module (a, b) + | Pwith_typesubst (a, b) -> + let a = self#longident_loc a in + let b = self#type_declaration b in Pwith_typesubst (a, b) + | Pwith_modsubst (a, b) -> + let a = self#longident_loc a in + let b = self#longident_loc b in Pwith_modsubst (a, b) method module_expr : module_expr -> module_expr= - fun { pmod_desc; pmod_loc; pmod_attributes } -> - let pmod_desc = self#module_expr_desc pmod_desc in - let pmod_loc = self#location pmod_loc in - let pmod_attributes = self#attributes pmod_attributes in - { pmod_desc; pmod_loc; pmod_attributes } + fun { pmod_desc; pmod_loc; pmod_attributes } -> + let pmod_desc = self#module_expr_desc pmod_desc in + let pmod_loc = self#location pmod_loc in + let pmod_attributes = self#attributes pmod_attributes in + { pmod_desc; pmod_loc; pmod_attributes } method module_expr_desc : module_expr_desc -> module_expr_desc= - fun x -> - match x with - | Pmod_ident a -> let a = self#longident_loc a in Pmod_ident a - | Pmod_structure a -> let a = self#structure a in Pmod_structure a - | Pmod_functor (a,b,c) -> - let a = self#loc self#string a in - let b = self#option self#module_type b in - let c = self#module_expr c in Pmod_functor (a, b, c) - | Pmod_apply (a,b) -> - let a = self#module_expr a in - let b = self#module_expr b in Pmod_apply (a, b) - | Pmod_constraint (a,b) -> - let a = self#module_expr a in - let b = self#module_type b in Pmod_constraint (a, b) - | Pmod_unpack a -> let a = self#expression a in Pmod_unpack a - | Pmod_extension a -> let a = self#extension a in Pmod_extension a + fun x -> + match x with + | Pmod_ident a -> let a = self#longident_loc a in Pmod_ident a + | Pmod_structure a -> let a = self#structure a in Pmod_structure a + | Pmod_functor (a, b, c) -> + let a = self#loc self#string a in + let b = self#option self#module_type b in + let c = self#module_expr c in Pmod_functor (a, b, c) + | Pmod_apply (a, b) -> + let a = self#module_expr a in + let b = self#module_expr b in Pmod_apply (a, b) + | Pmod_constraint (a, b) -> + let a = self#module_expr a in + let b = self#module_type b in Pmod_constraint (a, b) + | Pmod_unpack a -> let a = self#expression a in Pmod_unpack a + | Pmod_extension a -> let a = self#extension a in Pmod_extension a method structure : structure -> structure= self#list self#structure_item method structure_item : structure_item -> structure_item= - fun { pstr_desc; pstr_loc } -> - let pstr_desc = self#structure_item_desc pstr_desc in - let pstr_loc = self#location pstr_loc in { pstr_desc; pstr_loc } + fun { pstr_desc; pstr_loc } -> + let pstr_desc = self#structure_item_desc pstr_desc in + let pstr_loc = self#location pstr_loc in { pstr_desc; pstr_loc } method structure_item_desc : structure_item_desc -> structure_item_desc= - fun x -> - match x with - | Pstr_eval (a,b) -> - let a = self#expression a in - let b = self#attributes b in Pstr_eval (a, b) - | Pstr_value (a,b) -> - let a = self#rec_flag a in - let b = self#list self#value_binding b in Pstr_value (a, b) - | Pstr_primitive a -> - let a = self#value_description a in Pstr_primitive a - | Pstr_type (a,b) -> - let a = self#rec_flag a in - let b = self#list self#type_declaration b in Pstr_type (a, b) - | Pstr_typext a -> let a = self#type_extension a in Pstr_typext a - | Pstr_exception a -> - let a = self#extension_constructor a in Pstr_exception a - | Pstr_module a -> let a = self#module_binding a in Pstr_module a - | Pstr_recmodule a -> - let a = self#list self#module_binding a in Pstr_recmodule a - | Pstr_modtype a -> - let a = self#module_type_declaration a in Pstr_modtype a - | Pstr_open a -> let a = self#open_description a in Pstr_open a - | Pstr_class a -> - let a = self#list self#class_declaration a in Pstr_class a - | Pstr_class_type a -> - let a = self#list self#class_type_declaration a in - Pstr_class_type a - | Pstr_include a -> - let a = self#include_declaration a in Pstr_include a - | Pstr_attribute a -> let a = self#attribute a in Pstr_attribute a - | Pstr_extension (a,b) -> - let a = self#extension a in - let b = self#attributes b in Pstr_extension (a, b) + fun x -> + match x with + | Pstr_eval (a, b) -> + let a = self#expression a in + let b = self#attributes b in Pstr_eval (a, b) + | Pstr_value (a, b) -> + let a = self#rec_flag a in + let b = self#list self#value_binding b in Pstr_value (a, b) + | Pstr_primitive a -> + let a = self#value_description a in Pstr_primitive a + | Pstr_type (a, b) -> + let a = self#rec_flag a in + let b = self#list self#type_declaration b in Pstr_type (a, b) + | Pstr_typext a -> let a = self#type_extension a in Pstr_typext a + | Pstr_exception a -> + let a = self#type_exception a in Pstr_exception a + | Pstr_module a -> let a = self#module_binding a in Pstr_module a + | Pstr_recmodule a -> + let a = self#list self#module_binding a in Pstr_recmodule a + | Pstr_modtype a -> + let a = self#module_type_declaration a in Pstr_modtype a + | Pstr_open a -> let a = self#open_declaration a in Pstr_open a + | Pstr_class a -> + let a = self#list self#class_declaration a in Pstr_class a + | Pstr_class_type a -> + let a = self#list self#class_type_declaration a in + Pstr_class_type a + | Pstr_include a -> + let a = self#include_declaration a in Pstr_include a + | Pstr_attribute a -> let a = self#attribute a in Pstr_attribute a + | Pstr_extension (a, b) -> + let a = self#extension a in + let b = self#attributes b in Pstr_extension (a, b) method value_binding : value_binding -> value_binding= - fun { pvb_pat; pvb_expr; pvb_attributes; pvb_loc } -> - let pvb_pat = self#pattern pvb_pat in - let pvb_expr = self#expression pvb_expr in - let pvb_attributes = self#attributes pvb_attributes in - let pvb_loc = self#location pvb_loc in - { pvb_pat; pvb_expr; pvb_attributes; pvb_loc } + fun { pvb_pat; pvb_expr; pvb_attributes; pvb_loc } -> + let pvb_pat = self#pattern pvb_pat in + let pvb_expr = self#expression pvb_expr in + let pvb_attributes = self#attributes pvb_attributes in + let pvb_loc = self#location pvb_loc in + { pvb_pat; pvb_expr; pvb_attributes; pvb_loc } method module_binding : module_binding -> module_binding= - fun { pmb_name; pmb_expr; pmb_attributes; pmb_loc } -> - let pmb_name = self#loc self#string pmb_name in - let pmb_expr = self#module_expr pmb_expr in - let pmb_attributes = self#attributes pmb_attributes in - let pmb_loc = self#location pmb_loc in - { pmb_name; pmb_expr; pmb_attributes; pmb_loc } + fun { pmb_name; pmb_expr; pmb_attributes; pmb_loc } -> + let pmb_name = self#loc self#string pmb_name in + let pmb_expr = self#module_expr pmb_expr in + let pmb_attributes = self#attributes pmb_attributes in + let pmb_loc = self#location pmb_loc in + { pmb_name; pmb_expr; pmb_attributes; pmb_loc } method toplevel_phrase : toplevel_phrase -> toplevel_phrase= - fun x -> - match x with - | Ptop_def a -> let a = self#structure a in Ptop_def a - | Ptop_dir (a,b) -> - let a = self#string a in - let b = self#directive_argument b in Ptop_dir (a, b) + fun x -> + match x with + | Ptop_def a -> let a = self#structure a in Ptop_def a + | Ptop_dir a -> let a = self#toplevel_directive a in Ptop_dir a + method toplevel_directive : toplevel_directive -> toplevel_directive= + fun { pdir_name; pdir_arg; pdir_loc } -> + let pdir_name = self#loc self#string pdir_name in + let pdir_arg = self#option self#directive_argument pdir_arg in + let pdir_loc = self#location pdir_loc in + { pdir_name; pdir_arg; pdir_loc } method directive_argument : directive_argument -> directive_argument= - fun x -> - match x with - | Pdir_none -> Pdir_none - | Pdir_string a -> let a = self#string a in Pdir_string a - | Pdir_int (a,b) -> - let a = self#string a in - let b = self#option self#char b in Pdir_int (a, b) - | Pdir_ident a -> let a = self#longident a in Pdir_ident a - | Pdir_bool a -> let a = self#bool a in Pdir_bool a + fun { pdira_desc; pdira_loc } -> + let pdira_desc = self#directive_argument_desc pdira_desc in + let pdira_loc = self#location pdira_loc in { pdira_desc; pdira_loc } + method directive_argument_desc : + directive_argument_desc -> directive_argument_desc= + fun x -> + match x with + | Pdir_string a -> let a = self#string a in Pdir_string a + | Pdir_int (a, b) -> + let a = self#string a in + let b = self#option self#char b in Pdir_int (a, b) + | Pdir_ident a -> let a = self#longident a in Pdir_ident a + | Pdir_bool a -> let a = self#bool a in Pdir_bool a end class virtual iter = object (self) @@ -1790,338 +1896,370 @@ class virtual iter = method virtual option : 'a . ('a -> unit) -> 'a option -> unit method virtual string : string -> unit method position : position -> unit= - fun { pos_fname; pos_lnum; pos_bol; pos_cnum } -> - self#string pos_fname; - self#int pos_lnum; - self#int pos_bol; - self#int pos_cnum + fun { pos_fname; pos_lnum; pos_bol; pos_cnum } -> + self#string pos_fname; + self#int pos_lnum; + self#int pos_bol; + self#int pos_cnum method location : location -> unit= - fun { loc_start; loc_end; loc_ghost } -> - self#position loc_start; self#position loc_end; self#bool loc_ghost + fun { loc_start; loc_end; loc_ghost } -> + self#position loc_start; self#position loc_end; self#bool loc_ghost + method location_stack : location_stack -> unit= + self#list self#location method loc : 'a . ('a -> unit) -> 'a loc -> unit= - fun _a -> fun { txt; loc } -> _a txt; self#location loc + fun _a -> fun { txt; loc } -> _a txt; self#location loc method longident : longident -> unit= - fun x -> - match x with - | Lident a -> self#string a - | Ldot (a,b) -> (self#longident a; self#string b) - | Lapply (a,b) -> (self#longident a; self#longident b) + fun x -> + match x with + | Lident a -> self#string a + | Ldot (a, b) -> (self#longident a; self#string b) + | Lapply (a, b) -> (self#longident a; self#longident b) method longident_loc : longident_loc -> unit= self#loc self#longident - method rec_flag : rec_flag -> unit= fun _ -> () - method direction_flag : direction_flag -> unit= fun _ -> () - method private_flag : private_flag -> unit= fun _ -> () - method mutable_flag : mutable_flag -> unit= fun _ -> () - method virtual_flag : virtual_flag -> unit= fun _ -> () - method override_flag : override_flag -> unit= fun _ -> () - method closed_flag : closed_flag -> unit= fun _ -> () + method rec_flag : rec_flag -> unit= fun _ -> () + method direction_flag : direction_flag -> unit= fun _ -> () + method private_flag : private_flag -> unit= fun _ -> () + method mutable_flag : mutable_flag -> unit= fun _ -> () + method virtual_flag : virtual_flag -> unit= fun _ -> () + method override_flag : override_flag -> unit= fun _ -> () + method closed_flag : closed_flag -> unit= fun _ -> () method label : label -> unit= self#string method arg_label : arg_label -> unit= - fun x -> - match x with - | Nolabel -> () - | Labelled a -> self#string a - | Optional a -> self#string a - method variance : variance -> unit= fun _ -> () + fun x -> + match x with + | Nolabel -> () + | Labelled a -> self#string a + | Optional a -> self#string a + method variance : variance -> unit= fun _ -> () method constant : constant -> unit= - fun x -> - match x with - | Pconst_integer (a,b) -> (self#string a; self#option self#char b) - | Pconst_char a -> self#char a - | Pconst_string (a,b) -> (self#string a; self#option self#string b) - | Pconst_float (a,b) -> (self#string a; self#option self#char b) + fun x -> + match x with + | Pconst_integer (a, b) -> (self#string a; self#option self#char b) + | Pconst_char a -> self#char a + | Pconst_string (a, b) -> (self#string a; self#option self#string b) + | Pconst_float (a, b) -> (self#string a; self#option self#char b) method attribute : attribute -> unit= - fun (a,b) -> self#loc self#string a; self#payload b + fun { attr_name; attr_payload; attr_loc } -> + self#loc self#string attr_name; + self#payload attr_payload; + self#location attr_loc method extension : extension -> unit= - fun (a,b) -> self#loc self#string a; self#payload b + fun (a, b) -> self#loc self#string a; self#payload b method attributes : attributes -> unit= self#list self#attribute method payload : payload -> unit= - fun x -> - match x with - | PStr a -> self#structure a - | PSig a -> self#signature a - | PTyp a -> self#core_type a - | PPat (a,b) -> (self#pattern a; self#option self#expression b) + fun x -> + match x with + | PStr a -> self#structure a + | PSig a -> self#signature a + | PTyp a -> self#core_type a + | PPat (a, b) -> (self#pattern a; self#option self#expression b) method core_type : core_type -> unit= - fun { ptyp_desc; ptyp_loc; ptyp_attributes } -> - self#core_type_desc ptyp_desc; - self#location ptyp_loc; - self#attributes ptyp_attributes + fun { ptyp_desc; ptyp_loc; ptyp_loc_stack; ptyp_attributes } -> + self#core_type_desc ptyp_desc; + self#location ptyp_loc; + self#location_stack ptyp_loc_stack; + self#attributes ptyp_attributes method core_type_desc : core_type_desc -> unit= - fun x -> - match x with - | Ptyp_any -> () - | Ptyp_var a -> self#string a - | Ptyp_arrow (a,b,c) -> - (self#arg_label a; self#core_type b; self#core_type c) - | Ptyp_tuple a -> self#list self#core_type a - | Ptyp_constr (a,b) -> - (self#longident_loc a; self#list self#core_type b) - | Ptyp_object (a,b) -> - (self#list self#object_field a; self#closed_flag b) - | Ptyp_class (a,b) -> - (self#longident_loc a; self#list self#core_type b) - | Ptyp_alias (a,b) -> (self#core_type a; self#string b) - | Ptyp_variant (a,b,c) -> - (self#list self#row_field a; - self#closed_flag b; - self#option (self#list self#label) c) - | Ptyp_poly (a,b) -> - (self#list (self#loc self#string) a; self#core_type b) - | Ptyp_package a -> self#package_type a - | Ptyp_extension a -> self#extension a + fun x -> + match x with + | Ptyp_any -> () + | Ptyp_var a -> self#string a + | Ptyp_arrow (a, b, c) -> + (self#arg_label a; self#core_type b; self#core_type c) + | Ptyp_tuple a -> self#list self#core_type a + | Ptyp_constr (a, b) -> + (self#longident_loc a; self#list self#core_type b) + | Ptyp_object (a, b) -> + (self#list self#object_field a; self#closed_flag b) + | Ptyp_class (a, b) -> + (self#longident_loc a; self#list self#core_type b) + | Ptyp_alias (a, b) -> (self#core_type a; self#string b) + | Ptyp_variant (a, b, c) -> + (self#list self#row_field a; + self#closed_flag b; + self#option (self#list self#label) c) + | Ptyp_poly (a, b) -> + (self#list (self#loc self#string) a; self#core_type b) + | Ptyp_package a -> self#package_type a + | Ptyp_extension a -> self#extension a method package_type : package_type -> unit= - fun (a,b) -> - self#longident_loc a; - self#list (fun (a,b) -> self#longident_loc a; self#core_type b) b + fun (a, b) -> + self#longident_loc a; + self#list (fun (a, b) -> self#longident_loc a; self#core_type b) b method row_field : row_field -> unit= - fun x -> - match x with - | Rtag (a,b,c,d) -> - (self#loc self#label a; - self#attributes b; - self#bool c; - self#list self#core_type d) - | Rinherit a -> self#core_type a + fun { prf_desc; prf_loc; prf_attributes } -> + self#row_field_desc prf_desc; + self#location prf_loc; + self#attributes prf_attributes + method row_field_desc : row_field_desc -> unit= + fun x -> + match x with + | Rtag (a, b, c) -> + (self#loc self#label a; self#bool b; self#list self#core_type c) + | Rinherit a -> self#core_type a method object_field : object_field -> unit= - fun x -> - match x with - | Otag (a,b,c) -> - (self#loc self#label a; self#attributes b; self#core_type c) - | Oinherit a -> self#core_type a + fun { pof_desc; pof_loc; pof_attributes } -> + self#object_field_desc pof_desc; + self#location pof_loc; + self#attributes pof_attributes + method object_field_desc : object_field_desc -> unit= + fun x -> + match x with + | Otag (a, b) -> (self#loc self#label a; self#core_type b) + | Oinherit a -> self#core_type a method pattern : pattern -> unit= - fun { ppat_desc; ppat_loc; ppat_attributes } -> - self#pattern_desc ppat_desc; - self#location ppat_loc; - self#attributes ppat_attributes + fun { ppat_desc; ppat_loc; ppat_loc_stack; ppat_attributes } -> + self#pattern_desc ppat_desc; + self#location ppat_loc; + self#location_stack ppat_loc_stack; + self#attributes ppat_attributes method pattern_desc : pattern_desc -> unit= - fun x -> - match x with - | Ppat_any -> () - | Ppat_var a -> self#loc self#string a - | Ppat_alias (a,b) -> (self#pattern a; self#loc self#string b) - | Ppat_constant a -> self#constant a - | Ppat_interval (a,b) -> (self#constant a; self#constant b) - | Ppat_tuple a -> self#list self#pattern a - | Ppat_construct (a,b) -> - (self#longident_loc a; self#option self#pattern b) - | Ppat_variant (a,b) -> (self#label a; self#option self#pattern b) - | Ppat_record (a,b) -> - (self#list (fun (a,b) -> self#longident_loc a; self#pattern b) a; - self#closed_flag b) - | Ppat_array a -> self#list self#pattern a - | Ppat_or (a,b) -> (self#pattern a; self#pattern b) - | Ppat_constraint (a,b) -> (self#pattern a; self#core_type b) - | Ppat_type a -> self#longident_loc a - | Ppat_lazy a -> self#pattern a - | Ppat_unpack a -> self#loc self#string a - | Ppat_exception a -> self#pattern a - | Ppat_extension a -> self#extension a - | Ppat_open (a,b) -> (self#longident_loc a; self#pattern b) + fun x -> + match x with + | Ppat_any -> () + | Ppat_var a -> self#loc self#string a + | Ppat_alias (a, b) -> (self#pattern a; self#loc self#string b) + | Ppat_constant a -> self#constant a + | Ppat_interval (a, b) -> (self#constant a; self#constant b) + | Ppat_tuple a -> self#list self#pattern a + | Ppat_construct (a, b) -> + (self#longident_loc a; self#option self#pattern b) + | Ppat_variant (a, b) -> (self#label a; self#option self#pattern b) + | Ppat_record (a, b) -> + (self#list (fun (a, b) -> self#longident_loc a; self#pattern b) a; + self#closed_flag b) + | Ppat_array a -> self#list self#pattern a + | Ppat_or (a, b) -> (self#pattern a; self#pattern b) + | Ppat_constraint (a, b) -> (self#pattern a; self#core_type b) + | Ppat_type a -> self#longident_loc a + | Ppat_lazy a -> self#pattern a + | Ppat_unpack a -> self#loc self#string a + | Ppat_exception a -> self#pattern a + | Ppat_extension a -> self#extension a + | Ppat_open (a, b) -> (self#longident_loc a; self#pattern b) method expression : expression -> unit= - fun { pexp_desc; pexp_loc; pexp_attributes } -> - self#expression_desc pexp_desc; - self#location pexp_loc; - self#attributes pexp_attributes + fun { pexp_desc; pexp_loc; pexp_loc_stack; pexp_attributes } -> + self#expression_desc pexp_desc; + self#location pexp_loc; + self#location_stack pexp_loc_stack; + self#attributes pexp_attributes method expression_desc : expression_desc -> unit= - fun x -> - match x with - | Pexp_ident a -> self#longident_loc a - | Pexp_constant a -> self#constant a - | Pexp_let (a,b,c) -> - (self#rec_flag a; - self#list self#value_binding b; - self#expression c) - | Pexp_function a -> self#list self#case a - | Pexp_fun (a,b,c,d) -> - (self#arg_label a; - self#option self#expression b; - self#pattern c; - self#expression d) - | Pexp_apply (a,b) -> - (self#expression a; - self#list (fun (a,b) -> self#arg_label a; self#expression b) b) - | Pexp_match (a,b) -> (self#expression a; self#list self#case b) - | Pexp_try (a,b) -> (self#expression a; self#list self#case b) - | Pexp_tuple a -> self#list self#expression a - | Pexp_construct (a,b) -> - (self#longident_loc a; self#option self#expression b) - | Pexp_variant (a,b) -> (self#label a; self#option self#expression b) - | Pexp_record (a,b) -> - (self#list - (fun (a,b) -> self#longident_loc a; self#expression b) a; - self#option self#expression b) - | Pexp_field (a,b) -> (self#expression a; self#longident_loc b) - | Pexp_setfield (a,b,c) -> - (self#expression a; self#longident_loc b; self#expression c) - | Pexp_array a -> self#list self#expression a - | Pexp_ifthenelse (a,b,c) -> - (self#expression a; - self#expression b; - self#option self#expression c) - | Pexp_sequence (a,b) -> (self#expression a; self#expression b) - | Pexp_while (a,b) -> (self#expression a; self#expression b) - | Pexp_for (a,b,c,d,e) -> - (self#pattern a; - self#expression b; - self#expression c; - self#direction_flag d; - self#expression e) - | Pexp_constraint (a,b) -> (self#expression a; self#core_type b) - | Pexp_coerce (a,b,c) -> - (self#expression a; - self#option self#core_type b; - self#core_type c) - | Pexp_send (a,b) -> (self#expression a; self#loc self#label b) - | Pexp_new a -> self#longident_loc a - | Pexp_setinstvar (a,b) -> (self#loc self#label a; self#expression b) - | Pexp_override a -> - self#list - (fun (a,b) -> self#loc self#label a; self#expression b) a - | Pexp_letmodule (a,b,c) -> - (self#loc self#string a; self#module_expr b; self#expression c) - | Pexp_letexception (a,b) -> - (self#extension_constructor a; self#expression b) - | Pexp_assert a -> self#expression a - | Pexp_lazy a -> self#expression a - | Pexp_poly (a,b) -> - (self#expression a; self#option self#core_type b) - | Pexp_object a -> self#class_structure a - | Pexp_newtype (a,b) -> (self#loc self#string a; self#expression b) - | Pexp_pack a -> self#module_expr a - | Pexp_open (a,b,c) -> - (self#override_flag a; self#longident_loc b; self#expression c) - | Pexp_extension a -> self#extension a - | Pexp_unreachable -> () + fun x -> + match x with + | Pexp_ident a -> self#longident_loc a + | Pexp_constant a -> self#constant a + | Pexp_let (a, b, c) -> + (self#rec_flag a; + self#list self#value_binding b; + self#expression c) + | Pexp_function a -> self#list self#case a + | Pexp_fun (a, b, c, d) -> + (self#arg_label a; + self#option self#expression b; + self#pattern c; + self#expression d) + | Pexp_apply (a, b) -> + (self#expression a; + self#list (fun (a, b) -> self#arg_label a; self#expression b) b) + | Pexp_match (a, b) -> (self#expression a; self#list self#case b) + | Pexp_try (a, b) -> (self#expression a; self#list self#case b) + | Pexp_tuple a -> self#list self#expression a + | Pexp_construct (a, b) -> + (self#longident_loc a; self#option self#expression b) + | Pexp_variant (a, b) -> + (self#label a; self#option self#expression b) + | Pexp_record (a, b) -> + (self#list + (fun (a, b) -> self#longident_loc a; self#expression b) a; + self#option self#expression b) + | Pexp_field (a, b) -> (self#expression a; self#longident_loc b) + | Pexp_setfield (a, b, c) -> + (self#expression a; self#longident_loc b; self#expression c) + | Pexp_array a -> self#list self#expression a + | Pexp_ifthenelse (a, b, c) -> + (self#expression a; + self#expression b; + self#option self#expression c) + | Pexp_sequence (a, b) -> (self#expression a; self#expression b) + | Pexp_while (a, b) -> (self#expression a; self#expression b) + | Pexp_for (a, b, c, d, e) -> + (self#pattern a; + self#expression b; + self#expression c; + self#direction_flag d; + self#expression e) + | Pexp_constraint (a, b) -> (self#expression a; self#core_type b) + | Pexp_coerce (a, b, c) -> + (self#expression a; + self#option self#core_type b; + self#core_type c) + | Pexp_send (a, b) -> (self#expression a; self#loc self#label b) + | Pexp_new a -> self#longident_loc a + | Pexp_setinstvar (a, b) -> + (self#loc self#label a; self#expression b) + | Pexp_override a -> + self#list + (fun (a, b) -> self#loc self#label a; self#expression b) a + | Pexp_letmodule (a, b, c) -> + (self#loc self#string a; self#module_expr b; self#expression c) + | Pexp_letexception (a, b) -> + (self#extension_constructor a; self#expression b) + | Pexp_assert a -> self#expression a + | Pexp_lazy a -> self#expression a + | Pexp_poly (a, b) -> + (self#expression a; self#option self#core_type b) + | Pexp_object a -> self#class_structure a + | Pexp_newtype (a, b) -> (self#loc self#string a; self#expression b) + | Pexp_pack a -> self#module_expr a + | Pexp_open (a, b) -> (self#open_declaration a; self#expression b) + | Pexp_letop a -> self#letop a + | Pexp_extension a -> self#extension a + | Pexp_unreachable -> () method case : case -> unit= - fun { pc_lhs; pc_guard; pc_rhs } -> - self#pattern pc_lhs; - self#option self#expression pc_guard; - self#expression pc_rhs + fun { pc_lhs; pc_guard; pc_rhs } -> + self#pattern pc_lhs; + self#option self#expression pc_guard; + self#expression pc_rhs + method letop : letop -> unit= + fun { let_; ands; body } -> + self#binding_op let_; + self#list self#binding_op ands; + self#expression body + method binding_op : binding_op -> unit= + fun { pbop_op; pbop_pat; pbop_exp; pbop_loc } -> + self#loc self#string pbop_op; + self#pattern pbop_pat; + self#expression pbop_exp; + self#location pbop_loc method value_description : value_description -> unit= - fun { pval_name; pval_type; pval_prim; pval_attributes; pval_loc } -> - self#loc self#string pval_name; - self#core_type pval_type; - self#list self#string pval_prim; - self#attributes pval_attributes; - self#location pval_loc + fun { pval_name; pval_type; pval_prim; pval_attributes; pval_loc } -> + self#loc self#string pval_name; + self#core_type pval_type; + self#list self#string pval_prim; + self#attributes pval_attributes; + self#location pval_loc method type_declaration : type_declaration -> unit= fun { ptype_name; ptype_params; ptype_cstrs; ptype_kind; ptype_private; ptype_manifest; ptype_attributes; ptype_loc } - -> - self#loc self#string ptype_name; - self#list (fun (a,b) -> self#core_type a; self#variance b) - ptype_params; - self#list - (fun (a,b,c) -> - self#core_type a; self#core_type b; self#location c) ptype_cstrs; - self#type_kind ptype_kind; - self#private_flag ptype_private; - self#option self#core_type ptype_manifest; - self#attributes ptype_attributes; - self#location ptype_loc + -> + self#loc self#string ptype_name; + self#list (fun (a, b) -> self#core_type a; self#variance b) + ptype_params; + self#list + (fun (a, b, c) -> + self#core_type a; self#core_type b; self#location c) ptype_cstrs; + self#type_kind ptype_kind; + self#private_flag ptype_private; + self#option self#core_type ptype_manifest; + self#attributes ptype_attributes; + self#location ptype_loc method type_kind : type_kind -> unit= - fun x -> - match x with - | Ptype_abstract -> () - | Ptype_variant a -> self#list self#constructor_declaration a - | Ptype_record a -> self#list self#label_declaration a - | Ptype_open -> () + fun x -> + match x with + | Ptype_abstract -> () + | Ptype_variant a -> self#list self#constructor_declaration a + | Ptype_record a -> self#list self#label_declaration a + | Ptype_open -> () method label_declaration : label_declaration -> unit= - fun { pld_name; pld_mutable; pld_type; pld_loc; pld_attributes } -> - self#loc self#string pld_name; - self#mutable_flag pld_mutable; - self#core_type pld_type; - self#location pld_loc; - self#attributes pld_attributes + fun { pld_name; pld_mutable; pld_type; pld_loc; pld_attributes } -> + self#loc self#string pld_name; + self#mutable_flag pld_mutable; + self#core_type pld_type; + self#location pld_loc; + self#attributes pld_attributes method constructor_declaration : constructor_declaration -> unit= - fun { pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes } -> - self#loc self#string pcd_name; - self#constructor_arguments pcd_args; - self#option self#core_type pcd_res; - self#location pcd_loc; - self#attributes pcd_attributes + fun { pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes } -> + self#loc self#string pcd_name; + self#constructor_arguments pcd_args; + self#option self#core_type pcd_res; + self#location pcd_loc; + self#attributes pcd_attributes method constructor_arguments : constructor_arguments -> unit= - fun x -> - match x with - | Pcstr_tuple a -> self#list self#core_type a - | Pcstr_record a -> self#list self#label_declaration a + fun x -> + match x with + | Pcstr_tuple a -> self#list self#core_type a + | Pcstr_record a -> self#list self#label_declaration a method type_extension : type_extension -> unit= fun { ptyext_path; ptyext_params; ptyext_constructors; ptyext_private; - ptyext_attributes } - -> - self#longident_loc ptyext_path; - self#list (fun (a,b) -> self#core_type a; self#variance b) - ptyext_params; - self#list self#extension_constructor ptyext_constructors; - self#private_flag ptyext_private; - self#attributes ptyext_attributes + ptyext_loc; ptyext_attributes } + -> + self#longident_loc ptyext_path; + self#list (fun (a, b) -> self#core_type a; self#variance b) + ptyext_params; + self#list self#extension_constructor ptyext_constructors; + self#private_flag ptyext_private; + self#location ptyext_loc; + self#attributes ptyext_attributes method extension_constructor : extension_constructor -> unit= - fun { pext_name; pext_kind; pext_loc; pext_attributes } -> - self#loc self#string pext_name; - self#extension_constructor_kind pext_kind; - self#location pext_loc; - self#attributes pext_attributes + fun { pext_name; pext_kind; pext_loc; pext_attributes } -> + self#loc self#string pext_name; + self#extension_constructor_kind pext_kind; + self#location pext_loc; + self#attributes pext_attributes + method type_exception : type_exception -> unit= + fun { ptyexn_constructor; ptyexn_loc; ptyexn_attributes } -> + self#extension_constructor ptyexn_constructor; + self#location ptyexn_loc; + self#attributes ptyexn_attributes method extension_constructor_kind : extension_constructor_kind -> unit= - fun x -> - match x with - | Pext_decl (a,b) -> - (self#constructor_arguments a; self#option self#core_type b) - | Pext_rebind a -> self#longident_loc a + fun x -> + match x with + | Pext_decl (a, b) -> + (self#constructor_arguments a; self#option self#core_type b) + | Pext_rebind a -> self#longident_loc a method class_type : class_type -> unit= - fun { pcty_desc; pcty_loc; pcty_attributes } -> - self#class_type_desc pcty_desc; - self#location pcty_loc; - self#attributes pcty_attributes + fun { pcty_desc; pcty_loc; pcty_attributes } -> + self#class_type_desc pcty_desc; + self#location pcty_loc; + self#attributes pcty_attributes method class_type_desc : class_type_desc -> unit= - fun x -> - match x with - | Pcty_constr (a,b) -> - (self#longident_loc a; self#list self#core_type b) - | Pcty_signature a -> self#class_signature a - | Pcty_arrow (a,b,c) -> - (self#arg_label a; self#core_type b; self#class_type c) - | Pcty_extension a -> self#extension a - | Pcty_open (a,b,c) -> - (self#override_flag a; self#longident_loc b; self#class_type c) + fun x -> + match x with + | Pcty_constr (a, b) -> + (self#longident_loc a; self#list self#core_type b) + | Pcty_signature a -> self#class_signature a + | Pcty_arrow (a, b, c) -> + (self#arg_label a; self#core_type b; self#class_type c) + | Pcty_extension a -> self#extension a + | Pcty_open (a, b) -> (self#open_description a; self#class_type b) method class_signature : class_signature -> unit= - fun { pcsig_self; pcsig_fields } -> - self#core_type pcsig_self; - self#list self#class_type_field pcsig_fields + fun { pcsig_self; pcsig_fields } -> + self#core_type pcsig_self; + self#list self#class_type_field pcsig_fields method class_type_field : class_type_field -> unit= - fun { pctf_desc; pctf_loc; pctf_attributes } -> - self#class_type_field_desc pctf_desc; - self#location pctf_loc; - self#attributes pctf_attributes + fun { pctf_desc; pctf_loc; pctf_attributes } -> + self#class_type_field_desc pctf_desc; + self#location pctf_loc; + self#attributes pctf_attributes method class_type_field_desc : class_type_field_desc -> unit= - fun x -> - match x with - | Pctf_inherit a -> self#class_type a - | Pctf_val a -> - ((fun (a,b,c,d) -> - self#loc self#label a; - self#mutable_flag b; - self#virtual_flag c; - self#core_type d)) a - | Pctf_method a -> - ((fun (a,b,c,d) -> - self#loc self#label a; - self#private_flag b; - self#virtual_flag c; - self#core_type d)) a - | Pctf_constraint a -> - ((fun (a,b) -> self#core_type a; self#core_type b)) a - | Pctf_attribute a -> self#attribute a - | Pctf_extension a -> self#extension a + fun x -> + match x with + | Pctf_inherit a -> self#class_type a + | Pctf_val a -> + ((fun (a, b, c, d) -> + self#loc self#label a; + self#mutable_flag b; + self#virtual_flag c; + self#core_type d)) a + | Pctf_method a -> + ((fun (a, b, c, d) -> + self#loc self#label a; + self#private_flag b; + self#virtual_flag c; + self#core_type d)) a + | Pctf_constraint a -> + ((fun (a, b) -> self#core_type a; self#core_type b)) a + | Pctf_attribute a -> self#attribute a + | Pctf_extension a -> self#extension a method class_infos : 'a . ('a -> unit) -> 'a class_infos -> unit= - fun _a -> - fun - { pci_virt; pci_params; pci_name; pci_expr; pci_loc; pci_attributes - } - -> + fun _a -> + fun + { pci_virt; pci_params; pci_name; pci_expr; pci_loc; pci_attributes + } + -> self#virtual_flag pci_virt; - self#list (fun (a,b) -> self#core_type a; self#variance b) + self#list (fun (a, b) -> self#core_type a; self#variance b) pci_params; self#loc self#string pci_name; _a pci_expr; @@ -2132,213 +2270,233 @@ class virtual iter = method class_type_declaration : class_type_declaration -> unit= self#class_infos self#class_type method class_expr : class_expr -> unit= - fun { pcl_desc; pcl_loc; pcl_attributes } -> - self#class_expr_desc pcl_desc; - self#location pcl_loc; - self#attributes pcl_attributes + fun { pcl_desc; pcl_loc; pcl_attributes } -> + self#class_expr_desc pcl_desc; + self#location pcl_loc; + self#attributes pcl_attributes method class_expr_desc : class_expr_desc -> unit= - fun x -> - match x with - | Pcl_constr (a,b) -> - (self#longident_loc a; self#list self#core_type b) - | Pcl_structure a -> self#class_structure a - | Pcl_fun (a,b,c,d) -> - (self#arg_label a; - self#option self#expression b; - self#pattern c; - self#class_expr d) - | Pcl_apply (a,b) -> - (self#class_expr a; - self#list (fun (a,b) -> self#arg_label a; self#expression b) b) - | Pcl_let (a,b,c) -> - (self#rec_flag a; - self#list self#value_binding b; - self#class_expr c) - | Pcl_constraint (a,b) -> (self#class_expr a; self#class_type b) - | Pcl_extension a -> self#extension a - | Pcl_open (a,b,c) -> - (self#override_flag a; self#longident_loc b; self#class_expr c) + fun x -> + match x with + | Pcl_constr (a, b) -> + (self#longident_loc a; self#list self#core_type b) + | Pcl_structure a -> self#class_structure a + | Pcl_fun (a, b, c, d) -> + (self#arg_label a; + self#option self#expression b; + self#pattern c; + self#class_expr d) + | Pcl_apply (a, b) -> + (self#class_expr a; + self#list (fun (a, b) -> self#arg_label a; self#expression b) b) + | Pcl_let (a, b, c) -> + (self#rec_flag a; + self#list self#value_binding b; + self#class_expr c) + | Pcl_constraint (a, b) -> (self#class_expr a; self#class_type b) + | Pcl_extension a -> self#extension a + | Pcl_open (a, b) -> (self#open_description a; self#class_expr b) method class_structure : class_structure -> unit= - fun { pcstr_self; pcstr_fields } -> - self#pattern pcstr_self; self#list self#class_field pcstr_fields + fun { pcstr_self; pcstr_fields } -> + self#pattern pcstr_self; self#list self#class_field pcstr_fields method class_field : class_field -> unit= - fun { pcf_desc; pcf_loc; pcf_attributes } -> - self#class_field_desc pcf_desc; - self#location pcf_loc; - self#attributes pcf_attributes + fun { pcf_desc; pcf_loc; pcf_attributes } -> + self#class_field_desc pcf_desc; + self#location pcf_loc; + self#attributes pcf_attributes method class_field_desc : class_field_desc -> unit= - fun x -> - match x with - | Pcf_inherit (a,b,c) -> - (self#override_flag a; - self#class_expr b; - self#option (self#loc self#string) c) - | Pcf_val a -> - ((fun (a,b,c) -> - self#loc self#label a; - self#mutable_flag b; - self#class_field_kind c)) a - | Pcf_method a -> - ((fun (a,b,c) -> - self#loc self#label a; - self#private_flag b; - self#class_field_kind c)) a - | Pcf_constraint a -> - ((fun (a,b) -> self#core_type a; self#core_type b)) a - | Pcf_initializer a -> self#expression a - | Pcf_attribute a -> self#attribute a - | Pcf_extension a -> self#extension a + fun x -> + match x with + | Pcf_inherit (a, b, c) -> + (self#override_flag a; + self#class_expr b; + self#option (self#loc self#string) c) + | Pcf_val a -> + ((fun (a, b, c) -> + self#loc self#label a; + self#mutable_flag b; + self#class_field_kind c)) a + | Pcf_method a -> + ((fun (a, b, c) -> + self#loc self#label a; + self#private_flag b; + self#class_field_kind c)) a + | Pcf_constraint a -> + ((fun (a, b) -> self#core_type a; self#core_type b)) a + | Pcf_initializer a -> self#expression a + | Pcf_attribute a -> self#attribute a + | Pcf_extension a -> self#extension a method class_field_kind : class_field_kind -> unit= - fun x -> - match x with - | Cfk_virtual a -> self#core_type a - | Cfk_concrete (a,b) -> (self#override_flag a; self#expression b) + fun x -> + match x with + | Cfk_virtual a -> self#core_type a + | Cfk_concrete (a, b) -> (self#override_flag a; self#expression b) method class_declaration : class_declaration -> unit= self#class_infos self#class_expr method module_type : module_type -> unit= - fun { pmty_desc; pmty_loc; pmty_attributes } -> - self#module_type_desc pmty_desc; - self#location pmty_loc; - self#attributes pmty_attributes + fun { pmty_desc; pmty_loc; pmty_attributes } -> + self#module_type_desc pmty_desc; + self#location pmty_loc; + self#attributes pmty_attributes method module_type_desc : module_type_desc -> unit= - fun x -> - match x with - | Pmty_ident a -> self#longident_loc a - | Pmty_signature a -> self#signature a - | Pmty_functor (a,b,c) -> - (self#loc self#string a; - self#option self#module_type b; - self#module_type c) - | Pmty_with (a,b) -> - (self#module_type a; self#list self#with_constraint b) - | Pmty_typeof a -> self#module_expr a - | Pmty_extension a -> self#extension a - | Pmty_alias a -> self#longident_loc a + fun x -> + match x with + | Pmty_ident a -> self#longident_loc a + | Pmty_signature a -> self#signature a + | Pmty_functor (a, b, c) -> + (self#loc self#string a; + self#option self#module_type b; + self#module_type c) + | Pmty_with (a, b) -> + (self#module_type a; self#list self#with_constraint b) + | Pmty_typeof a -> self#module_expr a + | Pmty_extension a -> self#extension a + | Pmty_alias a -> self#longident_loc a method signature : signature -> unit= self#list self#signature_item method signature_item : signature_item -> unit= - fun { psig_desc; psig_loc } -> - self#signature_item_desc psig_desc; self#location psig_loc + fun { psig_desc; psig_loc } -> + self#signature_item_desc psig_desc; self#location psig_loc method signature_item_desc : signature_item_desc -> unit= - fun x -> - match x with - | Psig_value a -> self#value_description a - | Psig_type (a,b) -> - (self#rec_flag a; self#list self#type_declaration b) - | Psig_typext a -> self#type_extension a - | Psig_exception a -> self#extension_constructor a - | Psig_module a -> self#module_declaration a - | Psig_recmodule a -> self#list self#module_declaration a - | Psig_modtype a -> self#module_type_declaration a - | Psig_open a -> self#open_description a - | Psig_include a -> self#include_description a - | Psig_class a -> self#list self#class_description a - | Psig_class_type a -> self#list self#class_type_declaration a - | Psig_attribute a -> self#attribute a - | Psig_extension (a,b) -> (self#extension a; self#attributes b) + fun x -> + match x with + | Psig_value a -> self#value_description a + | Psig_type (a, b) -> + (self#rec_flag a; self#list self#type_declaration b) + | Psig_typesubst a -> self#list self#type_declaration a + | Psig_typext a -> self#type_extension a + | Psig_exception a -> self#type_exception a + | Psig_module a -> self#module_declaration a + | Psig_modsubst a -> self#module_substitution a + | Psig_recmodule a -> self#list self#module_declaration a + | Psig_modtype a -> self#module_type_declaration a + | Psig_open a -> self#open_description a + | Psig_include a -> self#include_description a + | Psig_class a -> self#list self#class_description a + | Psig_class_type a -> self#list self#class_type_declaration a + | Psig_attribute a -> self#attribute a + | Psig_extension (a, b) -> (self#extension a; self#attributes b) method module_declaration : module_declaration -> unit= - fun { pmd_name; pmd_type; pmd_attributes; pmd_loc } -> - self#loc self#string pmd_name; - self#module_type pmd_type; - self#attributes pmd_attributes; - self#location pmd_loc + fun { pmd_name; pmd_type; pmd_attributes; pmd_loc } -> + self#loc self#string pmd_name; + self#module_type pmd_type; + self#attributes pmd_attributes; + self#location pmd_loc + method module_substitution : module_substitution -> unit= + fun { pms_name; pms_manifest; pms_attributes; pms_loc } -> + self#loc self#string pms_name; + self#longident_loc pms_manifest; + self#attributes pms_attributes; + self#location pms_loc method module_type_declaration : module_type_declaration -> unit= - fun { pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc } -> - self#loc self#string pmtd_name; - self#option self#module_type pmtd_type; - self#attributes pmtd_attributes; - self#location pmtd_loc + fun { pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc } -> + self#loc self#string pmtd_name; + self#option self#module_type pmtd_type; + self#attributes pmtd_attributes; + self#location pmtd_loc + method open_infos : 'a . ('a -> unit) -> 'a open_infos -> unit= + fun _a -> + fun { popen_expr; popen_override; popen_loc; popen_attributes } -> + _a popen_expr; + self#override_flag popen_override; + self#location popen_loc; + self#attributes popen_attributes method open_description : open_description -> unit= - fun { popen_lid; popen_override; popen_loc; popen_attributes } -> - self#longident_loc popen_lid; - self#override_flag popen_override; - self#location popen_loc; - self#attributes popen_attributes + self#open_infos self#longident_loc + method open_declaration : open_declaration -> unit= + self#open_infos self#module_expr method include_infos : 'a . ('a -> unit) -> 'a include_infos -> unit= - fun _a -> - fun { pincl_mod; pincl_loc; pincl_attributes } -> - _a pincl_mod; - self#location pincl_loc; - self#attributes pincl_attributes + fun _a -> + fun { pincl_mod; pincl_loc; pincl_attributes } -> + _a pincl_mod; + self#location pincl_loc; + self#attributes pincl_attributes method include_description : include_description -> unit= self#include_infos self#module_type method include_declaration : include_declaration -> unit= self#include_infos self#module_expr method with_constraint : with_constraint -> unit= - fun x -> - match x with - | Pwith_type (a,b) -> (self#longident_loc a; self#type_declaration b) - | Pwith_module (a,b) -> (self#longident_loc a; self#longident_loc b) - | Pwith_typesubst (a,b) -> - (self#longident_loc a; self#type_declaration b) - | Pwith_modsubst (a,b) -> - (self#longident_loc a; self#longident_loc b) + fun x -> + match x with + | Pwith_type (a, b) -> + (self#longident_loc a; self#type_declaration b) + | Pwith_module (a, b) -> (self#longident_loc a; self#longident_loc b) + | Pwith_typesubst (a, b) -> + (self#longident_loc a; self#type_declaration b) + | Pwith_modsubst (a, b) -> + (self#longident_loc a; self#longident_loc b) method module_expr : module_expr -> unit= - fun { pmod_desc; pmod_loc; pmod_attributes } -> - self#module_expr_desc pmod_desc; - self#location pmod_loc; - self#attributes pmod_attributes + fun { pmod_desc; pmod_loc; pmod_attributes } -> + self#module_expr_desc pmod_desc; + self#location pmod_loc; + self#attributes pmod_attributes method module_expr_desc : module_expr_desc -> unit= - fun x -> - match x with - | Pmod_ident a -> self#longident_loc a - | Pmod_structure a -> self#structure a - | Pmod_functor (a,b,c) -> - (self#loc self#string a; - self#option self#module_type b; - self#module_expr c) - | Pmod_apply (a,b) -> (self#module_expr a; self#module_expr b) - | Pmod_constraint (a,b) -> (self#module_expr a; self#module_type b) - | Pmod_unpack a -> self#expression a - | Pmod_extension a -> self#extension a + fun x -> + match x with + | Pmod_ident a -> self#longident_loc a + | Pmod_structure a -> self#structure a + | Pmod_functor (a, b, c) -> + (self#loc self#string a; + self#option self#module_type b; + self#module_expr c) + | Pmod_apply (a, b) -> (self#module_expr a; self#module_expr b) + | Pmod_constraint (a, b) -> (self#module_expr a; self#module_type b) + | Pmod_unpack a -> self#expression a + | Pmod_extension a -> self#extension a method structure : structure -> unit= self#list self#structure_item method structure_item : structure_item -> unit= - fun { pstr_desc; pstr_loc } -> - self#structure_item_desc pstr_desc; self#location pstr_loc + fun { pstr_desc; pstr_loc } -> + self#structure_item_desc pstr_desc; self#location pstr_loc method structure_item_desc : structure_item_desc -> unit= - fun x -> - match x with - | Pstr_eval (a,b) -> (self#expression a; self#attributes b) - | Pstr_value (a,b) -> - (self#rec_flag a; self#list self#value_binding b) - | Pstr_primitive a -> self#value_description a - | Pstr_type (a,b) -> - (self#rec_flag a; self#list self#type_declaration b) - | Pstr_typext a -> self#type_extension a - | Pstr_exception a -> self#extension_constructor a - | Pstr_module a -> self#module_binding a - | Pstr_recmodule a -> self#list self#module_binding a - | Pstr_modtype a -> self#module_type_declaration a - | Pstr_open a -> self#open_description a - | Pstr_class a -> self#list self#class_declaration a - | Pstr_class_type a -> self#list self#class_type_declaration a - | Pstr_include a -> self#include_declaration a - | Pstr_attribute a -> self#attribute a - | Pstr_extension (a,b) -> (self#extension a; self#attributes b) + fun x -> + match x with + | Pstr_eval (a, b) -> (self#expression a; self#attributes b) + | Pstr_value (a, b) -> + (self#rec_flag a; self#list self#value_binding b) + | Pstr_primitive a -> self#value_description a + | Pstr_type (a, b) -> + (self#rec_flag a; self#list self#type_declaration b) + | Pstr_typext a -> self#type_extension a + | Pstr_exception a -> self#type_exception a + | Pstr_module a -> self#module_binding a + | Pstr_recmodule a -> self#list self#module_binding a + | Pstr_modtype a -> self#module_type_declaration a + | Pstr_open a -> self#open_declaration a + | Pstr_class a -> self#list self#class_declaration a + | Pstr_class_type a -> self#list self#class_type_declaration a + | Pstr_include a -> self#include_declaration a + | Pstr_attribute a -> self#attribute a + | Pstr_extension (a, b) -> (self#extension a; self#attributes b) method value_binding : value_binding -> unit= - fun { pvb_pat; pvb_expr; pvb_attributes; pvb_loc } -> - self#pattern pvb_pat; - self#expression pvb_expr; - self#attributes pvb_attributes; - self#location pvb_loc + fun { pvb_pat; pvb_expr; pvb_attributes; pvb_loc } -> + self#pattern pvb_pat; + self#expression pvb_expr; + self#attributes pvb_attributes; + self#location pvb_loc method module_binding : module_binding -> unit= - fun { pmb_name; pmb_expr; pmb_attributes; pmb_loc } -> - self#loc self#string pmb_name; - self#module_expr pmb_expr; - self#attributes pmb_attributes; - self#location pmb_loc + fun { pmb_name; pmb_expr; pmb_attributes; pmb_loc } -> + self#loc self#string pmb_name; + self#module_expr pmb_expr; + self#attributes pmb_attributes; + self#location pmb_loc method toplevel_phrase : toplevel_phrase -> unit= - fun x -> - match x with - | Ptop_def a -> self#structure a - | Ptop_dir (a,b) -> (self#string a; self#directive_argument b) + fun x -> + match x with + | Ptop_def a -> self#structure a + | Ptop_dir a -> self#toplevel_directive a + method toplevel_directive : toplevel_directive -> unit= + fun { pdir_name; pdir_arg; pdir_loc } -> + self#loc self#string pdir_name; + self#option self#directive_argument pdir_arg; + self#location pdir_loc method directive_argument : directive_argument -> unit= - fun x -> - match x with - | Pdir_none -> () - | Pdir_string a -> self#string a - | Pdir_int (a,b) -> (self#string a; self#option self#char b) - | Pdir_ident a -> self#longident a - | Pdir_bool a -> self#bool a + fun { pdira_desc; pdira_loc } -> + self#directive_argument_desc pdira_desc; self#location pdira_loc + method directive_argument_desc : directive_argument_desc -> unit= + fun x -> + match x with + | Pdir_string a -> self#string a + | Pdir_int (a, b) -> (self#string a; self#option self#char b) + | Pdir_ident a -> self#longident a + | Pdir_bool a -> self#bool a end class virtual ['acc] fold = object (self) @@ -2351,802 +2509,849 @@ class virtual ['acc] fold = 'a . ('a -> 'acc -> 'acc) -> 'a option -> 'acc -> 'acc method virtual string : string -> 'acc -> 'acc method position : position -> 'acc -> 'acc= - fun { pos_fname; pos_lnum; pos_bol; pos_cnum } -> - fun acc -> - let acc = self#string pos_fname acc in - let acc = self#int pos_lnum acc in - let acc = self#int pos_bol acc in - let acc = self#int pos_cnum acc in acc + fun { pos_fname; pos_lnum; pos_bol; pos_cnum } -> + fun acc -> + let acc = self#string pos_fname acc in + let acc = self#int pos_lnum acc in + let acc = self#int pos_bol acc in + let acc = self#int pos_cnum acc in acc method location : location -> 'acc -> 'acc= - fun { loc_start; loc_end; loc_ghost } -> - fun acc -> - let acc = self#position loc_start acc in - let acc = self#position loc_end acc in - let acc = self#bool loc_ghost acc in acc + fun { loc_start; loc_end; loc_ghost } -> + fun acc -> + let acc = self#position loc_start acc in + let acc = self#position loc_end acc in + let acc = self#bool loc_ghost acc in acc + method location_stack : location_stack -> 'acc -> 'acc= + self#list self#location method loc : 'a . ('a -> 'acc -> 'acc) -> 'a loc -> 'acc -> 'acc= - fun _a -> - fun { txt; loc } -> - fun acc -> - let acc = _a txt acc in let acc = self#location loc acc in acc + fun _a -> + fun { txt; loc } -> + fun acc -> + let acc = _a txt acc in let acc = self#location loc acc in acc method longident : longident -> 'acc -> 'acc= - fun x -> - fun acc -> - match x with - | Lident a -> self#string a acc - | Ldot (a,b) -> - let acc = self#longident a acc in - let acc = self#string b acc in acc - | Lapply (a,b) -> - let acc = self#longident a acc in - let acc = self#longident b acc in acc + fun x -> + fun acc -> + match x with + | Lident a -> self#string a acc + | Ldot (a, b) -> + let acc = self#longident a acc in + let acc = self#string b acc in acc + | Lapply (a, b) -> + let acc = self#longident a acc in + let acc = self#longident b acc in acc method longident_loc : longident_loc -> 'acc -> 'acc= self#loc self#longident - method rec_flag : rec_flag -> 'acc -> 'acc= fun _ -> fun acc -> acc + method rec_flag : rec_flag -> 'acc -> 'acc= fun _ -> fun acc -> acc method direction_flag : direction_flag -> 'acc -> 'acc= - fun _ -> fun acc -> acc + fun _ -> fun acc -> acc method private_flag : private_flag -> 'acc -> 'acc= - fun _ -> fun acc -> acc + fun _ -> fun acc -> acc method mutable_flag : mutable_flag -> 'acc -> 'acc= - fun _ -> fun acc -> acc + fun _ -> fun acc -> acc method virtual_flag : virtual_flag -> 'acc -> 'acc= - fun _ -> fun acc -> acc + fun _ -> fun acc -> acc method override_flag : override_flag -> 'acc -> 'acc= - fun _ -> fun acc -> acc - method closed_flag : closed_flag -> 'acc -> 'acc= - fun _ -> fun acc -> acc + fun _ -> fun acc -> acc + method closed_flag : closed_flag -> 'acc -> 'acc= fun _ -> fun acc -> acc method label : label -> 'acc -> 'acc= self#string method arg_label : arg_label -> 'acc -> 'acc= - fun x -> - fun acc -> - match x with - | Nolabel -> acc - | Labelled a -> self#string a acc - | Optional a -> self#string a acc - method variance : variance -> 'acc -> 'acc= fun _ -> fun acc -> acc + fun x -> + fun acc -> + match x with + | Nolabel -> acc + | Labelled a -> self#string a acc + | Optional a -> self#string a acc + method variance : variance -> 'acc -> 'acc= fun _ -> fun acc -> acc method constant : constant -> 'acc -> 'acc= - fun x -> - fun acc -> - match x with - | Pconst_integer (a,b) -> - let acc = self#string a acc in - let acc = self#option self#char b acc in acc - | Pconst_char a -> self#char a acc - | Pconst_string (a,b) -> - let acc = self#string a acc in - let acc = self#option self#string b acc in acc - | Pconst_float (a,b) -> - let acc = self#string a acc in - let acc = self#option self#char b acc in acc + fun x -> + fun acc -> + match x with + | Pconst_integer (a, b) -> + let acc = self#string a acc in + let acc = self#option self#char b acc in acc + | Pconst_char a -> self#char a acc + | Pconst_string (a, b) -> + let acc = self#string a acc in + let acc = self#option self#string b acc in acc + | Pconst_float (a, b) -> + let acc = self#string a acc in + let acc = self#option self#char b acc in acc method attribute : attribute -> 'acc -> 'acc= - fun (a,b) -> - fun acc -> - let acc = self#loc self#string a acc in - let acc = self#payload b acc in acc + fun { attr_name; attr_payload; attr_loc } -> + fun acc -> + let acc = self#loc self#string attr_name acc in + let acc = self#payload attr_payload acc in + let acc = self#location attr_loc acc in acc method extension : extension -> 'acc -> 'acc= - fun (a,b) -> - fun acc -> - let acc = self#loc self#string a acc in - let acc = self#payload b acc in acc + fun (a, b) -> + fun acc -> + let acc = self#loc self#string a acc in + let acc = self#payload b acc in acc method attributes : attributes -> 'acc -> 'acc= self#list self#attribute method payload : payload -> 'acc -> 'acc= - fun x -> - fun acc -> - match x with - | PStr a -> self#structure a acc - | PSig a -> self#signature a acc - | PTyp a -> self#core_type a acc - | PPat (a,b) -> - let acc = self#pattern a acc in - let acc = self#option self#expression b acc in acc + fun x -> + fun acc -> + match x with + | PStr a -> self#structure a acc + | PSig a -> self#signature a acc + | PTyp a -> self#core_type a acc + | PPat (a, b) -> + let acc = self#pattern a acc in + let acc = self#option self#expression b acc in acc method core_type : core_type -> 'acc -> 'acc= - fun { ptyp_desc; ptyp_loc; ptyp_attributes } -> - fun acc -> - let acc = self#core_type_desc ptyp_desc acc in - let acc = self#location ptyp_loc acc in - let acc = self#attributes ptyp_attributes acc in acc + fun { ptyp_desc; ptyp_loc; ptyp_loc_stack; ptyp_attributes } -> + fun acc -> + let acc = self#core_type_desc ptyp_desc acc in + let acc = self#location ptyp_loc acc in + let acc = self#location_stack ptyp_loc_stack acc in + let acc = self#attributes ptyp_attributes acc in acc method core_type_desc : core_type_desc -> 'acc -> 'acc= - fun x -> - fun acc -> - match x with - | Ptyp_any -> acc - | Ptyp_var a -> self#string a acc - | Ptyp_arrow (a,b,c) -> - let acc = self#arg_label a acc in - let acc = self#core_type b acc in - let acc = self#core_type c acc in acc - | Ptyp_tuple a -> self#list self#core_type a acc - | Ptyp_constr (a,b) -> - let acc = self#longident_loc a acc in - let acc = self#list self#core_type b acc in acc - | Ptyp_object (a,b) -> - let acc = self#list self#object_field a acc in - let acc = self#closed_flag b acc in acc - | Ptyp_class (a,b) -> - let acc = self#longident_loc a acc in - let acc = self#list self#core_type b acc in acc - | Ptyp_alias (a,b) -> - let acc = self#core_type a acc in - let acc = self#string b acc in acc - | Ptyp_variant (a,b,c) -> - let acc = self#list self#row_field a acc in - let acc = self#closed_flag b acc in - let acc = self#option (self#list self#label) c acc in acc - | Ptyp_poly (a,b) -> - let acc = self#list (self#loc self#string) a acc in - let acc = self#core_type b acc in acc - | Ptyp_package a -> self#package_type a acc - | Ptyp_extension a -> self#extension a acc + fun x -> + fun acc -> + match x with + | Ptyp_any -> acc + | Ptyp_var a -> self#string a acc + | Ptyp_arrow (a, b, c) -> + let acc = self#arg_label a acc in + let acc = self#core_type b acc in + let acc = self#core_type c acc in acc + | Ptyp_tuple a -> self#list self#core_type a acc + | Ptyp_constr (a, b) -> + let acc = self#longident_loc a acc in + let acc = self#list self#core_type b acc in acc + | Ptyp_object (a, b) -> + let acc = self#list self#object_field a acc in + let acc = self#closed_flag b acc in acc + | Ptyp_class (a, b) -> + let acc = self#longident_loc a acc in + let acc = self#list self#core_type b acc in acc + | Ptyp_alias (a, b) -> + let acc = self#core_type a acc in + let acc = self#string b acc in acc + | Ptyp_variant (a, b, c) -> + let acc = self#list self#row_field a acc in + let acc = self#closed_flag b acc in + let acc = self#option (self#list self#label) c acc in acc + | Ptyp_poly (a, b) -> + let acc = self#list (self#loc self#string) a acc in + let acc = self#core_type b acc in acc + | Ptyp_package a -> self#package_type a acc + | Ptyp_extension a -> self#extension a acc method package_type : package_type -> 'acc -> 'acc= - fun (a,b) -> - fun acc -> - let acc = self#longident_loc a acc in - let acc = - self#list - (fun (a,b) -> - fun acc -> - let acc = self#longident_loc a acc in - let acc = self#core_type b acc in acc) b acc - in - acc + fun (a, b) -> + fun acc -> + let acc = self#longident_loc a acc in + let acc = + self#list + (fun (a, b) -> + fun acc -> + let acc = self#longident_loc a acc in + let acc = self#core_type b acc in acc) b acc in + acc method row_field : row_field -> 'acc -> 'acc= - fun x -> - fun acc -> - match x with - | Rtag (a,b,c,d) -> - let acc = self#loc self#label a acc in - let acc = self#attributes b acc in - let acc = self#bool c acc in - let acc = self#list self#core_type d acc in acc - | Rinherit a -> self#core_type a acc + fun { prf_desc; prf_loc; prf_attributes } -> + fun acc -> + let acc = self#row_field_desc prf_desc acc in + let acc = self#location prf_loc acc in + let acc = self#attributes prf_attributes acc in acc + method row_field_desc : row_field_desc -> 'acc -> 'acc= + fun x -> + fun acc -> + match x with + | Rtag (a, b, c) -> + let acc = self#loc self#label a acc in + let acc = self#bool b acc in + let acc = self#list self#core_type c acc in acc + | Rinherit a -> self#core_type a acc method object_field : object_field -> 'acc -> 'acc= - fun x -> - fun acc -> - match x with - | Otag (a,b,c) -> - let acc = self#loc self#label a acc in - let acc = self#attributes b acc in - let acc = self#core_type c acc in acc - | Oinherit a -> self#core_type a acc + fun { pof_desc; pof_loc; pof_attributes } -> + fun acc -> + let acc = self#object_field_desc pof_desc acc in + let acc = self#location pof_loc acc in + let acc = self#attributes pof_attributes acc in acc + method object_field_desc : object_field_desc -> 'acc -> 'acc= + fun x -> + fun acc -> + match x with + | Otag (a, b) -> + let acc = self#loc self#label a acc in + let acc = self#core_type b acc in acc + | Oinherit a -> self#core_type a acc method pattern : pattern -> 'acc -> 'acc= - fun { ppat_desc; ppat_loc; ppat_attributes } -> - fun acc -> - let acc = self#pattern_desc ppat_desc acc in - let acc = self#location ppat_loc acc in - let acc = self#attributes ppat_attributes acc in acc + fun { ppat_desc; ppat_loc; ppat_loc_stack; ppat_attributes } -> + fun acc -> + let acc = self#pattern_desc ppat_desc acc in + let acc = self#location ppat_loc acc in + let acc = self#location_stack ppat_loc_stack acc in + let acc = self#attributes ppat_attributes acc in acc method pattern_desc : pattern_desc -> 'acc -> 'acc= - fun x -> - fun acc -> - match x with - | Ppat_any -> acc - | Ppat_var a -> self#loc self#string a acc - | Ppat_alias (a,b) -> - let acc = self#pattern a acc in - let acc = self#loc self#string b acc in acc - | Ppat_constant a -> self#constant a acc - | Ppat_interval (a,b) -> - let acc = self#constant a acc in - let acc = self#constant b acc in acc - | Ppat_tuple a -> self#list self#pattern a acc - | Ppat_construct (a,b) -> - let acc = self#longident_loc a acc in - let acc = self#option self#pattern b acc in acc - | Ppat_variant (a,b) -> - let acc = self#label a acc in - let acc = self#option self#pattern b acc in acc - | Ppat_record (a,b) -> - let acc = - self#list - (fun (a,b) -> - fun acc -> - let acc = self#longident_loc a acc in - let acc = self#pattern b acc in acc) a acc - in - let acc = self#closed_flag b acc in acc - | Ppat_array a -> self#list self#pattern a acc - | Ppat_or (a,b) -> - let acc = self#pattern a acc in - let acc = self#pattern b acc in acc - | Ppat_constraint (a,b) -> - let acc = self#pattern a acc in - let acc = self#core_type b acc in acc - | Ppat_type a -> self#longident_loc a acc - | Ppat_lazy a -> self#pattern a acc - | Ppat_unpack a -> self#loc self#string a acc - | Ppat_exception a -> self#pattern a acc - | Ppat_extension a -> self#extension a acc - | Ppat_open (a,b) -> - let acc = self#longident_loc a acc in - let acc = self#pattern b acc in acc + fun x -> + fun acc -> + match x with + | Ppat_any -> acc + | Ppat_var a -> self#loc self#string a acc + | Ppat_alias (a, b) -> + let acc = self#pattern a acc in + let acc = self#loc self#string b acc in acc + | Ppat_constant a -> self#constant a acc + | Ppat_interval (a, b) -> + let acc = self#constant a acc in + let acc = self#constant b acc in acc + | Ppat_tuple a -> self#list self#pattern a acc + | Ppat_construct (a, b) -> + let acc = self#longident_loc a acc in + let acc = self#option self#pattern b acc in acc + | Ppat_variant (a, b) -> + let acc = self#label a acc in + let acc = self#option self#pattern b acc in acc + | Ppat_record (a, b) -> + let acc = + self#list + (fun (a, b) -> + fun acc -> + let acc = self#longident_loc a acc in + let acc = self#pattern b acc in acc) a acc in + let acc = self#closed_flag b acc in acc + | Ppat_array a -> self#list self#pattern a acc + | Ppat_or (a, b) -> + let acc = self#pattern a acc in + let acc = self#pattern b acc in acc + | Ppat_constraint (a, b) -> + let acc = self#pattern a acc in + let acc = self#core_type b acc in acc + | Ppat_type a -> self#longident_loc a acc + | Ppat_lazy a -> self#pattern a acc + | Ppat_unpack a -> self#loc self#string a acc + | Ppat_exception a -> self#pattern a acc + | Ppat_extension a -> self#extension a acc + | Ppat_open (a, b) -> + let acc = self#longident_loc a acc in + let acc = self#pattern b acc in acc method expression : expression -> 'acc -> 'acc= - fun { pexp_desc; pexp_loc; pexp_attributes } -> - fun acc -> - let acc = self#expression_desc pexp_desc acc in - let acc = self#location pexp_loc acc in - let acc = self#attributes pexp_attributes acc in acc + fun { pexp_desc; pexp_loc; pexp_loc_stack; pexp_attributes } -> + fun acc -> + let acc = self#expression_desc pexp_desc acc in + let acc = self#location pexp_loc acc in + let acc = self#location_stack pexp_loc_stack acc in + let acc = self#attributes pexp_attributes acc in acc method expression_desc : expression_desc -> 'acc -> 'acc= - fun x -> - fun acc -> - match x with - | Pexp_ident a -> self#longident_loc a acc - | Pexp_constant a -> self#constant a acc - | Pexp_let (a,b,c) -> - let acc = self#rec_flag a acc in - let acc = self#list self#value_binding b acc in - let acc = self#expression c acc in acc - | Pexp_function a -> self#list self#case a acc - | Pexp_fun (a,b,c,d) -> - let acc = self#arg_label a acc in - let acc = self#option self#expression b acc in - let acc = self#pattern c acc in - let acc = self#expression d acc in acc - | Pexp_apply (a,b) -> - let acc = self#expression a acc in - let acc = - self#list - (fun (a,b) -> - fun acc -> - let acc = self#arg_label a acc in - let acc = self#expression b acc in acc) b acc - in - acc - | Pexp_match (a,b) -> - let acc = self#expression a acc in - let acc = self#list self#case b acc in acc - | Pexp_try (a,b) -> - let acc = self#expression a acc in - let acc = self#list self#case b acc in acc - | Pexp_tuple a -> self#list self#expression a acc - | Pexp_construct (a,b) -> - let acc = self#longident_loc a acc in - let acc = self#option self#expression b acc in acc - | Pexp_variant (a,b) -> - let acc = self#label a acc in - let acc = self#option self#expression b acc in acc - | Pexp_record (a,b) -> - let acc = - self#list - (fun (a,b) -> - fun acc -> - let acc = self#longident_loc a acc in - let acc = self#expression b acc in acc) a acc - in - let acc = self#option self#expression b acc in acc - | Pexp_field (a,b) -> - let acc = self#expression a acc in - let acc = self#longident_loc b acc in acc - | Pexp_setfield (a,b,c) -> - let acc = self#expression a acc in - let acc = self#longident_loc b acc in - let acc = self#expression c acc in acc - | Pexp_array a -> self#list self#expression a acc - | Pexp_ifthenelse (a,b,c) -> - let acc = self#expression a acc in - let acc = self#expression b acc in - let acc = self#option self#expression c acc in acc - | Pexp_sequence (a,b) -> - let acc = self#expression a acc in - let acc = self#expression b acc in acc - | Pexp_while (a,b) -> - let acc = self#expression a acc in - let acc = self#expression b acc in acc - | Pexp_for (a,b,c,d,e) -> - let acc = self#pattern a acc in - let acc = self#expression b acc in - let acc = self#expression c acc in - let acc = self#direction_flag d acc in - let acc = self#expression e acc in acc - | Pexp_constraint (a,b) -> - let acc = self#expression a acc in - let acc = self#core_type b acc in acc - | Pexp_coerce (a,b,c) -> - let acc = self#expression a acc in - let acc = self#option self#core_type b acc in - let acc = self#core_type c acc in acc - | Pexp_send (a,b) -> - let acc = self#expression a acc in - let acc = self#loc self#label b acc in acc - | Pexp_new a -> self#longident_loc a acc - | Pexp_setinstvar (a,b) -> - let acc = self#loc self#label a acc in - let acc = self#expression b acc in acc - | Pexp_override a -> - self#list - (fun (a,b) -> - fun acc -> - let acc = self#loc self#label a acc in - let acc = self#expression b acc in acc) a acc - | Pexp_letmodule (a,b,c) -> - let acc = self#loc self#string a acc in - let acc = self#module_expr b acc in - let acc = self#expression c acc in acc - | Pexp_letexception (a,b) -> - let acc = self#extension_constructor a acc in - let acc = self#expression b acc in acc - | Pexp_assert a -> self#expression a acc - | Pexp_lazy a -> self#expression a acc - | Pexp_poly (a,b) -> - let acc = self#expression a acc in - let acc = self#option self#core_type b acc in acc - | Pexp_object a -> self#class_structure a acc - | Pexp_newtype (a,b) -> - let acc = self#loc self#string a acc in - let acc = self#expression b acc in acc - | Pexp_pack a -> self#module_expr a acc - | Pexp_open (a,b,c) -> - let acc = self#override_flag a acc in - let acc = self#longident_loc b acc in - let acc = self#expression c acc in acc - | Pexp_extension a -> self#extension a acc - | Pexp_unreachable -> acc + fun x -> + fun acc -> + match x with + | Pexp_ident a -> self#longident_loc a acc + | Pexp_constant a -> self#constant a acc + | Pexp_let (a, b, c) -> + let acc = self#rec_flag a acc in + let acc = self#list self#value_binding b acc in + let acc = self#expression c acc in acc + | Pexp_function a -> self#list self#case a acc + | Pexp_fun (a, b, c, d) -> + let acc = self#arg_label a acc in + let acc = self#option self#expression b acc in + let acc = self#pattern c acc in + let acc = self#expression d acc in acc + | Pexp_apply (a, b) -> + let acc = self#expression a acc in + let acc = + self#list + (fun (a, b) -> + fun acc -> + let acc = self#arg_label a acc in + let acc = self#expression b acc in acc) b acc in + acc + | Pexp_match (a, b) -> + let acc = self#expression a acc in + let acc = self#list self#case b acc in acc + | Pexp_try (a, b) -> + let acc = self#expression a acc in + let acc = self#list self#case b acc in acc + | Pexp_tuple a -> self#list self#expression a acc + | Pexp_construct (a, b) -> + let acc = self#longident_loc a acc in + let acc = self#option self#expression b acc in acc + | Pexp_variant (a, b) -> + let acc = self#label a acc in + let acc = self#option self#expression b acc in acc + | Pexp_record (a, b) -> + let acc = + self#list + (fun (a, b) -> + fun acc -> + let acc = self#longident_loc a acc in + let acc = self#expression b acc in acc) a acc in + let acc = self#option self#expression b acc in acc + | Pexp_field (a, b) -> + let acc = self#expression a acc in + let acc = self#longident_loc b acc in acc + | Pexp_setfield (a, b, c) -> + let acc = self#expression a acc in + let acc = self#longident_loc b acc in + let acc = self#expression c acc in acc + | Pexp_array a -> self#list self#expression a acc + | Pexp_ifthenelse (a, b, c) -> + let acc = self#expression a acc in + let acc = self#expression b acc in + let acc = self#option self#expression c acc in acc + | Pexp_sequence (a, b) -> + let acc = self#expression a acc in + let acc = self#expression b acc in acc + | Pexp_while (a, b) -> + let acc = self#expression a acc in + let acc = self#expression b acc in acc + | Pexp_for (a, b, c, d, e) -> + let acc = self#pattern a acc in + let acc = self#expression b acc in + let acc = self#expression c acc in + let acc = self#direction_flag d acc in + let acc = self#expression e acc in acc + | Pexp_constraint (a, b) -> + let acc = self#expression a acc in + let acc = self#core_type b acc in acc + | Pexp_coerce (a, b, c) -> + let acc = self#expression a acc in + let acc = self#option self#core_type b acc in + let acc = self#core_type c acc in acc + | Pexp_send (a, b) -> + let acc = self#expression a acc in + let acc = self#loc self#label b acc in acc + | Pexp_new a -> self#longident_loc a acc + | Pexp_setinstvar (a, b) -> + let acc = self#loc self#label a acc in + let acc = self#expression b acc in acc + | Pexp_override a -> + self#list + (fun (a, b) -> + fun acc -> + let acc = self#loc self#label a acc in + let acc = self#expression b acc in acc) a acc + | Pexp_letmodule (a, b, c) -> + let acc = self#loc self#string a acc in + let acc = self#module_expr b acc in + let acc = self#expression c acc in acc + | Pexp_letexception (a, b) -> + let acc = self#extension_constructor a acc in + let acc = self#expression b acc in acc + | Pexp_assert a -> self#expression a acc + | Pexp_lazy a -> self#expression a acc + | Pexp_poly (a, b) -> + let acc = self#expression a acc in + let acc = self#option self#core_type b acc in acc + | Pexp_object a -> self#class_structure a acc + | Pexp_newtype (a, b) -> + let acc = self#loc self#string a acc in + let acc = self#expression b acc in acc + | Pexp_pack a -> self#module_expr a acc + | Pexp_open (a, b) -> + let acc = self#open_declaration a acc in + let acc = self#expression b acc in acc + | Pexp_letop a -> self#letop a acc + | Pexp_extension a -> self#extension a acc + | Pexp_unreachable -> acc method case : case -> 'acc -> 'acc= - fun { pc_lhs; pc_guard; pc_rhs } -> - fun acc -> - let acc = self#pattern pc_lhs acc in - let acc = self#option self#expression pc_guard acc in - let acc = self#expression pc_rhs acc in acc + fun { pc_lhs; pc_guard; pc_rhs } -> + fun acc -> + let acc = self#pattern pc_lhs acc in + let acc = self#option self#expression pc_guard acc in + let acc = self#expression pc_rhs acc in acc + method letop : letop -> 'acc -> 'acc= + fun { let_; ands; body } -> + fun acc -> + let acc = self#binding_op let_ acc in + let acc = self#list self#binding_op ands acc in + let acc = self#expression body acc in acc + method binding_op : binding_op -> 'acc -> 'acc= + fun { pbop_op; pbop_pat; pbop_exp; pbop_loc } -> + fun acc -> + let acc = self#loc self#string pbop_op acc in + let acc = self#pattern pbop_pat acc in + let acc = self#expression pbop_exp acc in + let acc = self#location pbop_loc acc in acc method value_description : value_description -> 'acc -> 'acc= - fun { pval_name; pval_type; pval_prim; pval_attributes; pval_loc } -> - fun acc -> - let acc = self#loc self#string pval_name acc in - let acc = self#core_type pval_type acc in - let acc = self#list self#string pval_prim acc in - let acc = self#attributes pval_attributes acc in - let acc = self#location pval_loc acc in acc + fun { pval_name; pval_type; pval_prim; pval_attributes; pval_loc } -> + fun acc -> + let acc = self#loc self#string pval_name acc in + let acc = self#core_type pval_type acc in + let acc = self#list self#string pval_prim acc in + let acc = self#attributes pval_attributes acc in + let acc = self#location pval_loc acc in acc method type_declaration : type_declaration -> 'acc -> 'acc= fun { ptype_name; ptype_params; ptype_cstrs; ptype_kind; ptype_private; ptype_manifest; ptype_attributes; ptype_loc } - -> - fun acc -> - let acc = self#loc self#string ptype_name acc in - let acc = - self#list - (fun (a,b) -> - fun acc -> - let acc = self#core_type a acc in - let acc = self#variance b acc in acc) ptype_params acc - in - let acc = - self#list - (fun (a,b,c) -> - fun acc -> - let acc = self#core_type a acc in - let acc = self#core_type b acc in - let acc = self#location c acc in acc) ptype_cstrs acc - in - let acc = self#type_kind ptype_kind acc in - let acc = self#private_flag ptype_private acc in - let acc = self#option self#core_type ptype_manifest acc in - let acc = self#attributes ptype_attributes acc in - let acc = self#location ptype_loc acc in acc + -> + fun acc -> + let acc = self#loc self#string ptype_name acc in + let acc = + self#list + (fun (a, b) -> + fun acc -> + let acc = self#core_type a acc in + let acc = self#variance b acc in acc) ptype_params acc in + let acc = + self#list + (fun (a, b, c) -> + fun acc -> + let acc = self#core_type a acc in + let acc = self#core_type b acc in + let acc = self#location c acc in acc) ptype_cstrs acc in + let acc = self#type_kind ptype_kind acc in + let acc = self#private_flag ptype_private acc in + let acc = self#option self#core_type ptype_manifest acc in + let acc = self#attributes ptype_attributes acc in + let acc = self#location ptype_loc acc in acc method type_kind : type_kind -> 'acc -> 'acc= - fun x -> - fun acc -> - match x with - | Ptype_abstract -> acc - | Ptype_variant a -> self#list self#constructor_declaration a acc - | Ptype_record a -> self#list self#label_declaration a acc - | Ptype_open -> acc + fun x -> + fun acc -> + match x with + | Ptype_abstract -> acc + | Ptype_variant a -> self#list self#constructor_declaration a acc + | Ptype_record a -> self#list self#label_declaration a acc + | Ptype_open -> acc method label_declaration : label_declaration -> 'acc -> 'acc= - fun { pld_name; pld_mutable; pld_type; pld_loc; pld_attributes } -> - fun acc -> - let acc = self#loc self#string pld_name acc in - let acc = self#mutable_flag pld_mutable acc in - let acc = self#core_type pld_type acc in - let acc = self#location pld_loc acc in - let acc = self#attributes pld_attributes acc in acc + fun { pld_name; pld_mutable; pld_type; pld_loc; pld_attributes } -> + fun acc -> + let acc = self#loc self#string pld_name acc in + let acc = self#mutable_flag pld_mutable acc in + let acc = self#core_type pld_type acc in + let acc = self#location pld_loc acc in + let acc = self#attributes pld_attributes acc in acc method constructor_declaration : constructor_declaration -> 'acc -> 'acc= - fun { pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes } -> - fun acc -> - let acc = self#loc self#string pcd_name acc in - let acc = self#constructor_arguments pcd_args acc in - let acc = self#option self#core_type pcd_res acc in - let acc = self#location pcd_loc acc in - let acc = self#attributes pcd_attributes acc in acc + fun { pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes } -> + fun acc -> + let acc = self#loc self#string pcd_name acc in + let acc = self#constructor_arguments pcd_args acc in + let acc = self#option self#core_type pcd_res acc in + let acc = self#location pcd_loc acc in + let acc = self#attributes pcd_attributes acc in acc method constructor_arguments : constructor_arguments -> 'acc -> 'acc= - fun x -> - fun acc -> - match x with - | Pcstr_tuple a -> self#list self#core_type a acc - | Pcstr_record a -> self#list self#label_declaration a acc + fun x -> + fun acc -> + match x with + | Pcstr_tuple a -> self#list self#core_type a acc + | Pcstr_record a -> self#list self#label_declaration a acc method type_extension : type_extension -> 'acc -> 'acc= fun { ptyext_path; ptyext_params; ptyext_constructors; ptyext_private; - ptyext_attributes } - -> - fun acc -> - let acc = self#longident_loc ptyext_path acc in - let acc = - self#list - (fun (a,b) -> - fun acc -> - let acc = self#core_type a acc in - let acc = self#variance b acc in acc) ptyext_params acc - in - let acc = - self#list self#extension_constructor ptyext_constructors acc in - let acc = self#private_flag ptyext_private acc in - let acc = self#attributes ptyext_attributes acc in acc + ptyext_loc; ptyext_attributes } + -> + fun acc -> + let acc = self#longident_loc ptyext_path acc in + let acc = + self#list + (fun (a, b) -> + fun acc -> + let acc = self#core_type a acc in + let acc = self#variance b acc in acc) ptyext_params acc in + let acc = + self#list self#extension_constructor ptyext_constructors acc in + let acc = self#private_flag ptyext_private acc in + let acc = self#location ptyext_loc acc in + let acc = self#attributes ptyext_attributes acc in acc method extension_constructor : extension_constructor -> 'acc -> 'acc= - fun { pext_name; pext_kind; pext_loc; pext_attributes } -> - fun acc -> - let acc = self#loc self#string pext_name acc in - let acc = self#extension_constructor_kind pext_kind acc in - let acc = self#location pext_loc acc in - let acc = self#attributes pext_attributes acc in acc + fun { pext_name; pext_kind; pext_loc; pext_attributes } -> + fun acc -> + let acc = self#loc self#string pext_name acc in + let acc = self#extension_constructor_kind pext_kind acc in + let acc = self#location pext_loc acc in + let acc = self#attributes pext_attributes acc in acc + method type_exception : type_exception -> 'acc -> 'acc= + fun { ptyexn_constructor; ptyexn_loc; ptyexn_attributes } -> + fun acc -> + let acc = self#extension_constructor ptyexn_constructor acc in + let acc = self#location ptyexn_loc acc in + let acc = self#attributes ptyexn_attributes acc in acc method extension_constructor_kind : extension_constructor_kind -> 'acc -> 'acc= - fun x -> - fun acc -> - match x with - | Pext_decl (a,b) -> - let acc = self#constructor_arguments a acc in - let acc = self#option self#core_type b acc in acc - | Pext_rebind a -> self#longident_loc a acc + fun x -> + fun acc -> + match x with + | Pext_decl (a, b) -> + let acc = self#constructor_arguments a acc in + let acc = self#option self#core_type b acc in acc + | Pext_rebind a -> self#longident_loc a acc method class_type : class_type -> 'acc -> 'acc= - fun { pcty_desc; pcty_loc; pcty_attributes } -> - fun acc -> - let acc = self#class_type_desc pcty_desc acc in - let acc = self#location pcty_loc acc in - let acc = self#attributes pcty_attributes acc in acc + fun { pcty_desc; pcty_loc; pcty_attributes } -> + fun acc -> + let acc = self#class_type_desc pcty_desc acc in + let acc = self#location pcty_loc acc in + let acc = self#attributes pcty_attributes acc in acc method class_type_desc : class_type_desc -> 'acc -> 'acc= - fun x -> - fun acc -> - match x with - | Pcty_constr (a,b) -> - let acc = self#longident_loc a acc in - let acc = self#list self#core_type b acc in acc - | Pcty_signature a -> self#class_signature a acc - | Pcty_arrow (a,b,c) -> - let acc = self#arg_label a acc in - let acc = self#core_type b acc in - let acc = self#class_type c acc in acc - | Pcty_extension a -> self#extension a acc - | Pcty_open (a,b,c) -> - let acc = self#override_flag a acc in - let acc = self#longident_loc b acc in - let acc = self#class_type c acc in acc + fun x -> + fun acc -> + match x with + | Pcty_constr (a, b) -> + let acc = self#longident_loc a acc in + let acc = self#list self#core_type b acc in acc + | Pcty_signature a -> self#class_signature a acc + | Pcty_arrow (a, b, c) -> + let acc = self#arg_label a acc in + let acc = self#core_type b acc in + let acc = self#class_type c acc in acc + | Pcty_extension a -> self#extension a acc + | Pcty_open (a, b) -> + let acc = self#open_description a acc in + let acc = self#class_type b acc in acc method class_signature : class_signature -> 'acc -> 'acc= - fun { pcsig_self; pcsig_fields } -> - fun acc -> - let acc = self#core_type pcsig_self acc in - let acc = self#list self#class_type_field pcsig_fields acc in acc + fun { pcsig_self; pcsig_fields } -> + fun acc -> + let acc = self#core_type pcsig_self acc in + let acc = self#list self#class_type_field pcsig_fields acc in acc method class_type_field : class_type_field -> 'acc -> 'acc= - fun { pctf_desc; pctf_loc; pctf_attributes } -> - fun acc -> - let acc = self#class_type_field_desc pctf_desc acc in - let acc = self#location pctf_loc acc in - let acc = self#attributes pctf_attributes acc in acc + fun { pctf_desc; pctf_loc; pctf_attributes } -> + fun acc -> + let acc = self#class_type_field_desc pctf_desc acc in + let acc = self#location pctf_loc acc in + let acc = self#attributes pctf_attributes acc in acc method class_type_field_desc : class_type_field_desc -> 'acc -> 'acc= - fun x -> - fun acc -> - match x with - | Pctf_inherit a -> self#class_type a acc - | Pctf_val a -> - ((fun (a,b,c,d) -> - fun acc -> - let acc = self#loc self#label a acc in - let acc = self#mutable_flag b acc in - let acc = self#virtual_flag c acc in - let acc = self#core_type d acc in acc)) a acc - | Pctf_method a -> - ((fun (a,b,c,d) -> - fun acc -> - let acc = self#loc self#label a acc in - let acc = self#private_flag b acc in - let acc = self#virtual_flag c acc in - let acc = self#core_type d acc in acc)) a acc - | Pctf_constraint a -> - ((fun (a,b) -> - fun acc -> - let acc = self#core_type a acc in - let acc = self#core_type b acc in acc)) a acc - | Pctf_attribute a -> self#attribute a acc - | Pctf_extension a -> self#extension a acc + fun x -> + fun acc -> + match x with + | Pctf_inherit a -> self#class_type a acc + | Pctf_val a -> + ((fun (a, b, c, d) -> + fun acc -> + let acc = self#loc self#label a acc in + let acc = self#mutable_flag b acc in + let acc = self#virtual_flag c acc in + let acc = self#core_type d acc in acc)) a acc + | Pctf_method a -> + ((fun (a, b, c, d) -> + fun acc -> + let acc = self#loc self#label a acc in + let acc = self#private_flag b acc in + let acc = self#virtual_flag c acc in + let acc = self#core_type d acc in acc)) a acc + | Pctf_constraint a -> + ((fun (a, b) -> + fun acc -> + let acc = self#core_type a acc in + let acc = self#core_type b acc in acc)) a acc + | Pctf_attribute a -> self#attribute a acc + | Pctf_extension a -> self#extension a acc method class_infos : 'a . ('a -> 'acc -> 'acc) -> 'a class_infos -> 'acc -> 'acc= - fun _a -> - fun - { pci_virt; pci_params; pci_name; pci_expr; pci_loc; pci_attributes - } - -> - fun acc -> - let acc = self#virtual_flag pci_virt acc in - let acc = - self#list - (fun (a,b) -> - fun acc -> - let acc = self#core_type a acc in - let acc = self#variance b acc in acc) pci_params acc - in - let acc = self#loc self#string pci_name acc in - let acc = _a pci_expr acc in - let acc = self#location pci_loc acc in - let acc = self#attributes pci_attributes acc in acc + fun _a -> + fun + { pci_virt; pci_params; pci_name; pci_expr; pci_loc; pci_attributes + } + -> + fun acc -> + let acc = self#virtual_flag pci_virt acc in + let acc = + self#list + (fun (a, b) -> + fun acc -> + let acc = self#core_type a acc in + let acc = self#variance b acc in acc) pci_params acc in + let acc = self#loc self#string pci_name acc in + let acc = _a pci_expr acc in + let acc = self#location pci_loc acc in + let acc = self#attributes pci_attributes acc in acc method class_description : class_description -> 'acc -> 'acc= self#class_infos self#class_type method class_type_declaration : class_type_declaration -> 'acc -> 'acc= self#class_infos self#class_type method class_expr : class_expr -> 'acc -> 'acc= - fun { pcl_desc; pcl_loc; pcl_attributes } -> - fun acc -> - let acc = self#class_expr_desc pcl_desc acc in - let acc = self#location pcl_loc acc in - let acc = self#attributes pcl_attributes acc in acc + fun { pcl_desc; pcl_loc; pcl_attributes } -> + fun acc -> + let acc = self#class_expr_desc pcl_desc acc in + let acc = self#location pcl_loc acc in + let acc = self#attributes pcl_attributes acc in acc method class_expr_desc : class_expr_desc -> 'acc -> 'acc= - fun x -> - fun acc -> - match x with - | Pcl_constr (a,b) -> - let acc = self#longident_loc a acc in - let acc = self#list self#core_type b acc in acc - | Pcl_structure a -> self#class_structure a acc - | Pcl_fun (a,b,c,d) -> - let acc = self#arg_label a acc in - let acc = self#option self#expression b acc in - let acc = self#pattern c acc in - let acc = self#class_expr d acc in acc - | Pcl_apply (a,b) -> - let acc = self#class_expr a acc in - let acc = - self#list - (fun (a,b) -> - fun acc -> - let acc = self#arg_label a acc in - let acc = self#expression b acc in acc) b acc - in - acc - | Pcl_let (a,b,c) -> - let acc = self#rec_flag a acc in - let acc = self#list self#value_binding b acc in - let acc = self#class_expr c acc in acc - | Pcl_constraint (a,b) -> - let acc = self#class_expr a acc in - let acc = self#class_type b acc in acc - | Pcl_extension a -> self#extension a acc - | Pcl_open (a,b,c) -> - let acc = self#override_flag a acc in - let acc = self#longident_loc b acc in - let acc = self#class_expr c acc in acc + fun x -> + fun acc -> + match x with + | Pcl_constr (a, b) -> + let acc = self#longident_loc a acc in + let acc = self#list self#core_type b acc in acc + | Pcl_structure a -> self#class_structure a acc + | Pcl_fun (a, b, c, d) -> + let acc = self#arg_label a acc in + let acc = self#option self#expression b acc in + let acc = self#pattern c acc in + let acc = self#class_expr d acc in acc + | Pcl_apply (a, b) -> + let acc = self#class_expr a acc in + let acc = + self#list + (fun (a, b) -> + fun acc -> + let acc = self#arg_label a acc in + let acc = self#expression b acc in acc) b acc in + acc + | Pcl_let (a, b, c) -> + let acc = self#rec_flag a acc in + let acc = self#list self#value_binding b acc in + let acc = self#class_expr c acc in acc + | Pcl_constraint (a, b) -> + let acc = self#class_expr a acc in + let acc = self#class_type b acc in acc + | Pcl_extension a -> self#extension a acc + | Pcl_open (a, b) -> + let acc = self#open_description a acc in + let acc = self#class_expr b acc in acc method class_structure : class_structure -> 'acc -> 'acc= - fun { pcstr_self; pcstr_fields } -> - fun acc -> - let acc = self#pattern pcstr_self acc in - let acc = self#list self#class_field pcstr_fields acc in acc + fun { pcstr_self; pcstr_fields } -> + fun acc -> + let acc = self#pattern pcstr_self acc in + let acc = self#list self#class_field pcstr_fields acc in acc method class_field : class_field -> 'acc -> 'acc= - fun { pcf_desc; pcf_loc; pcf_attributes } -> - fun acc -> - let acc = self#class_field_desc pcf_desc acc in - let acc = self#location pcf_loc acc in - let acc = self#attributes pcf_attributes acc in acc + fun { pcf_desc; pcf_loc; pcf_attributes } -> + fun acc -> + let acc = self#class_field_desc pcf_desc acc in + let acc = self#location pcf_loc acc in + let acc = self#attributes pcf_attributes acc in acc method class_field_desc : class_field_desc -> 'acc -> 'acc= - fun x -> - fun acc -> - match x with - | Pcf_inherit (a,b,c) -> - let acc = self#override_flag a acc in - let acc = self#class_expr b acc in - let acc = self#option (self#loc self#string) c acc in acc - | Pcf_val a -> - ((fun (a,b,c) -> - fun acc -> - let acc = self#loc self#label a acc in - let acc = self#mutable_flag b acc in - let acc = self#class_field_kind c acc in acc)) a acc - | Pcf_method a -> - ((fun (a,b,c) -> - fun acc -> - let acc = self#loc self#label a acc in - let acc = self#private_flag b acc in - let acc = self#class_field_kind c acc in acc)) a acc - | Pcf_constraint a -> - ((fun (a,b) -> - fun acc -> - let acc = self#core_type a acc in - let acc = self#core_type b acc in acc)) a acc - | Pcf_initializer a -> self#expression a acc - | Pcf_attribute a -> self#attribute a acc - | Pcf_extension a -> self#extension a acc + fun x -> + fun acc -> + match x with + | Pcf_inherit (a, b, c) -> + let acc = self#override_flag a acc in + let acc = self#class_expr b acc in + let acc = self#option (self#loc self#string) c acc in acc + | Pcf_val a -> + ((fun (a, b, c) -> + fun acc -> + let acc = self#loc self#label a acc in + let acc = self#mutable_flag b acc in + let acc = self#class_field_kind c acc in acc)) a acc + | Pcf_method a -> + ((fun (a, b, c) -> + fun acc -> + let acc = self#loc self#label a acc in + let acc = self#private_flag b acc in + let acc = self#class_field_kind c acc in acc)) a acc + | Pcf_constraint a -> + ((fun (a, b) -> + fun acc -> + let acc = self#core_type a acc in + let acc = self#core_type b acc in acc)) a acc + | Pcf_initializer a -> self#expression a acc + | Pcf_attribute a -> self#attribute a acc + | Pcf_extension a -> self#extension a acc method class_field_kind : class_field_kind -> 'acc -> 'acc= - fun x -> - fun acc -> - match x with - | Cfk_virtual a -> self#core_type a acc - | Cfk_concrete (a,b) -> - let acc = self#override_flag a acc in - let acc = self#expression b acc in acc + fun x -> + fun acc -> + match x with + | Cfk_virtual a -> self#core_type a acc + | Cfk_concrete (a, b) -> + let acc = self#override_flag a acc in + let acc = self#expression b acc in acc method class_declaration : class_declaration -> 'acc -> 'acc= self#class_infos self#class_expr method module_type : module_type -> 'acc -> 'acc= - fun { pmty_desc; pmty_loc; pmty_attributes } -> - fun acc -> - let acc = self#module_type_desc pmty_desc acc in - let acc = self#location pmty_loc acc in - let acc = self#attributes pmty_attributes acc in acc + fun { pmty_desc; pmty_loc; pmty_attributes } -> + fun acc -> + let acc = self#module_type_desc pmty_desc acc in + let acc = self#location pmty_loc acc in + let acc = self#attributes pmty_attributes acc in acc method module_type_desc : module_type_desc -> 'acc -> 'acc= - fun x -> - fun acc -> - match x with - | Pmty_ident a -> self#longident_loc a acc - | Pmty_signature a -> self#signature a acc - | Pmty_functor (a,b,c) -> - let acc = self#loc self#string a acc in - let acc = self#option self#module_type b acc in - let acc = self#module_type c acc in acc - | Pmty_with (a,b) -> - let acc = self#module_type a acc in - let acc = self#list self#with_constraint b acc in acc - | Pmty_typeof a -> self#module_expr a acc - | Pmty_extension a -> self#extension a acc - | Pmty_alias a -> self#longident_loc a acc + fun x -> + fun acc -> + match x with + | Pmty_ident a -> self#longident_loc a acc + | Pmty_signature a -> self#signature a acc + | Pmty_functor (a, b, c) -> + let acc = self#loc self#string a acc in + let acc = self#option self#module_type b acc in + let acc = self#module_type c acc in acc + | Pmty_with (a, b) -> + let acc = self#module_type a acc in + let acc = self#list self#with_constraint b acc in acc + | Pmty_typeof a -> self#module_expr a acc + | Pmty_extension a -> self#extension a acc + | Pmty_alias a -> self#longident_loc a acc method signature : signature -> 'acc -> 'acc= self#list self#signature_item method signature_item : signature_item -> 'acc -> 'acc= - fun { psig_desc; psig_loc } -> - fun acc -> - let acc = self#signature_item_desc psig_desc acc in - let acc = self#location psig_loc acc in acc + fun { psig_desc; psig_loc } -> + fun acc -> + let acc = self#signature_item_desc psig_desc acc in + let acc = self#location psig_loc acc in acc method signature_item_desc : signature_item_desc -> 'acc -> 'acc= - fun x -> - fun acc -> - match x with - | Psig_value a -> self#value_description a acc - | Psig_type (a,b) -> - let acc = self#rec_flag a acc in - let acc = self#list self#type_declaration b acc in acc - | Psig_typext a -> self#type_extension a acc - | Psig_exception a -> self#extension_constructor a acc - | Psig_module a -> self#module_declaration a acc - | Psig_recmodule a -> self#list self#module_declaration a acc - | Psig_modtype a -> self#module_type_declaration a acc - | Psig_open a -> self#open_description a acc - | Psig_include a -> self#include_description a acc - | Psig_class a -> self#list self#class_description a acc - | Psig_class_type a -> self#list self#class_type_declaration a acc - | Psig_attribute a -> self#attribute a acc - | Psig_extension (a,b) -> - let acc = self#extension a acc in - let acc = self#attributes b acc in acc + fun x -> + fun acc -> + match x with + | Psig_value a -> self#value_description a acc + | Psig_type (a, b) -> + let acc = self#rec_flag a acc in + let acc = self#list self#type_declaration b acc in acc + | Psig_typesubst a -> self#list self#type_declaration a acc + | Psig_typext a -> self#type_extension a acc + | Psig_exception a -> self#type_exception a acc + | Psig_module a -> self#module_declaration a acc + | Psig_modsubst a -> self#module_substitution a acc + | Psig_recmodule a -> self#list self#module_declaration a acc + | Psig_modtype a -> self#module_type_declaration a acc + | Psig_open a -> self#open_description a acc + | Psig_include a -> self#include_description a acc + | Psig_class a -> self#list self#class_description a acc + | Psig_class_type a -> self#list self#class_type_declaration a acc + | Psig_attribute a -> self#attribute a acc + | Psig_extension (a, b) -> + let acc = self#extension a acc in + let acc = self#attributes b acc in acc method module_declaration : module_declaration -> 'acc -> 'acc= - fun { pmd_name; pmd_type; pmd_attributes; pmd_loc } -> - fun acc -> - let acc = self#loc self#string pmd_name acc in - let acc = self#module_type pmd_type acc in - let acc = self#attributes pmd_attributes acc in - let acc = self#location pmd_loc acc in acc + fun { pmd_name; pmd_type; pmd_attributes; pmd_loc } -> + fun acc -> + let acc = self#loc self#string pmd_name acc in + let acc = self#module_type pmd_type acc in + let acc = self#attributes pmd_attributes acc in + let acc = self#location pmd_loc acc in acc + method module_substitution : module_substitution -> 'acc -> 'acc= + fun { pms_name; pms_manifest; pms_attributes; pms_loc } -> + fun acc -> + let acc = self#loc self#string pms_name acc in + let acc = self#longident_loc pms_manifest acc in + let acc = self#attributes pms_attributes acc in + let acc = self#location pms_loc acc in acc method module_type_declaration : module_type_declaration -> 'acc -> 'acc= - fun { pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc } -> - fun acc -> - let acc = self#loc self#string pmtd_name acc in - let acc = self#option self#module_type pmtd_type acc in - let acc = self#attributes pmtd_attributes acc in - let acc = self#location pmtd_loc acc in acc + fun { pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc } -> + fun acc -> + let acc = self#loc self#string pmtd_name acc in + let acc = self#option self#module_type pmtd_type acc in + let acc = self#attributes pmtd_attributes acc in + let acc = self#location pmtd_loc acc in acc + method open_infos : + 'a . ('a -> 'acc -> 'acc) -> 'a open_infos -> 'acc -> 'acc= + fun _a -> + fun { popen_expr; popen_override; popen_loc; popen_attributes } -> + fun acc -> + let acc = _a popen_expr acc in + let acc = self#override_flag popen_override acc in + let acc = self#location popen_loc acc in + let acc = self#attributes popen_attributes acc in acc method open_description : open_description -> 'acc -> 'acc= - fun { popen_lid; popen_override; popen_loc; popen_attributes } -> - fun acc -> - let acc = self#longident_loc popen_lid acc in - let acc = self#override_flag popen_override acc in - let acc = self#location popen_loc acc in - let acc = self#attributes popen_attributes acc in acc + self#open_infos self#longident_loc + method open_declaration : open_declaration -> 'acc -> 'acc= + self#open_infos self#module_expr method include_infos : 'a . ('a -> 'acc -> 'acc) -> 'a include_infos -> 'acc -> 'acc= - fun _a -> - fun { pincl_mod; pincl_loc; pincl_attributes } -> - fun acc -> - let acc = _a pincl_mod acc in - let acc = self#location pincl_loc acc in - let acc = self#attributes pincl_attributes acc in acc + fun _a -> + fun { pincl_mod; pincl_loc; pincl_attributes } -> + fun acc -> + let acc = _a pincl_mod acc in + let acc = self#location pincl_loc acc in + let acc = self#attributes pincl_attributes acc in acc method include_description : include_description -> 'acc -> 'acc= self#include_infos self#module_type method include_declaration : include_declaration -> 'acc -> 'acc= self#include_infos self#module_expr method with_constraint : with_constraint -> 'acc -> 'acc= - fun x -> - fun acc -> - match x with - | Pwith_type (a,b) -> - let acc = self#longident_loc a acc in - let acc = self#type_declaration b acc in acc - | Pwith_module (a,b) -> - let acc = self#longident_loc a acc in - let acc = self#longident_loc b acc in acc - | Pwith_typesubst (a,b) -> - let acc = self#longident_loc a acc in - let acc = self#type_declaration b acc in acc - | Pwith_modsubst (a,b) -> - let acc = self#longident_loc a acc in - let acc = self#longident_loc b acc in acc + fun x -> + fun acc -> + match x with + | Pwith_type (a, b) -> + let acc = self#longident_loc a acc in + let acc = self#type_declaration b acc in acc + | Pwith_module (a, b) -> + let acc = self#longident_loc a acc in + let acc = self#longident_loc b acc in acc + | Pwith_typesubst (a, b) -> + let acc = self#longident_loc a acc in + let acc = self#type_declaration b acc in acc + | Pwith_modsubst (a, b) -> + let acc = self#longident_loc a acc in + let acc = self#longident_loc b acc in acc method module_expr : module_expr -> 'acc -> 'acc= - fun { pmod_desc; pmod_loc; pmod_attributes } -> - fun acc -> - let acc = self#module_expr_desc pmod_desc acc in - let acc = self#location pmod_loc acc in - let acc = self#attributes pmod_attributes acc in acc + fun { pmod_desc; pmod_loc; pmod_attributes } -> + fun acc -> + let acc = self#module_expr_desc pmod_desc acc in + let acc = self#location pmod_loc acc in + let acc = self#attributes pmod_attributes acc in acc method module_expr_desc : module_expr_desc -> 'acc -> 'acc= - fun x -> - fun acc -> - match x with - | Pmod_ident a -> self#longident_loc a acc - | Pmod_structure a -> self#structure a acc - | Pmod_functor (a,b,c) -> - let acc = self#loc self#string a acc in - let acc = self#option self#module_type b acc in - let acc = self#module_expr c acc in acc - | Pmod_apply (a,b) -> - let acc = self#module_expr a acc in - let acc = self#module_expr b acc in acc - | Pmod_constraint (a,b) -> - let acc = self#module_expr a acc in - let acc = self#module_type b acc in acc - | Pmod_unpack a -> self#expression a acc - | Pmod_extension a -> self#extension a acc + fun x -> + fun acc -> + match x with + | Pmod_ident a -> self#longident_loc a acc + | Pmod_structure a -> self#structure a acc + | Pmod_functor (a, b, c) -> + let acc = self#loc self#string a acc in + let acc = self#option self#module_type b acc in + let acc = self#module_expr c acc in acc + | Pmod_apply (a, b) -> + let acc = self#module_expr a acc in + let acc = self#module_expr b acc in acc + | Pmod_constraint (a, b) -> + let acc = self#module_expr a acc in + let acc = self#module_type b acc in acc + | Pmod_unpack a -> self#expression a acc + | Pmod_extension a -> self#extension a acc method structure : structure -> 'acc -> 'acc= self#list self#structure_item method structure_item : structure_item -> 'acc -> 'acc= - fun { pstr_desc; pstr_loc } -> - fun acc -> - let acc = self#structure_item_desc pstr_desc acc in - let acc = self#location pstr_loc acc in acc + fun { pstr_desc; pstr_loc } -> + fun acc -> + let acc = self#structure_item_desc pstr_desc acc in + let acc = self#location pstr_loc acc in acc method structure_item_desc : structure_item_desc -> 'acc -> 'acc= - fun x -> - fun acc -> - match x with - | Pstr_eval (a,b) -> - let acc = self#expression a acc in - let acc = self#attributes b acc in acc - | Pstr_value (a,b) -> - let acc = self#rec_flag a acc in - let acc = self#list self#value_binding b acc in acc - | Pstr_primitive a -> self#value_description a acc - | Pstr_type (a,b) -> - let acc = self#rec_flag a acc in - let acc = self#list self#type_declaration b acc in acc - | Pstr_typext a -> self#type_extension a acc - | Pstr_exception a -> self#extension_constructor a acc - | Pstr_module a -> self#module_binding a acc - | Pstr_recmodule a -> self#list self#module_binding a acc - | Pstr_modtype a -> self#module_type_declaration a acc - | Pstr_open a -> self#open_description a acc - | Pstr_class a -> self#list self#class_declaration a acc - | Pstr_class_type a -> self#list self#class_type_declaration a acc - | Pstr_include a -> self#include_declaration a acc - | Pstr_attribute a -> self#attribute a acc - | Pstr_extension (a,b) -> - let acc = self#extension a acc in - let acc = self#attributes b acc in acc + fun x -> + fun acc -> + match x with + | Pstr_eval (a, b) -> + let acc = self#expression a acc in + let acc = self#attributes b acc in acc + | Pstr_value (a, b) -> + let acc = self#rec_flag a acc in + let acc = self#list self#value_binding b acc in acc + | Pstr_primitive a -> self#value_description a acc + | Pstr_type (a, b) -> + let acc = self#rec_flag a acc in + let acc = self#list self#type_declaration b acc in acc + | Pstr_typext a -> self#type_extension a acc + | Pstr_exception a -> self#type_exception a acc + | Pstr_module a -> self#module_binding a acc + | Pstr_recmodule a -> self#list self#module_binding a acc + | Pstr_modtype a -> self#module_type_declaration a acc + | Pstr_open a -> self#open_declaration a acc + | Pstr_class a -> self#list self#class_declaration a acc + | Pstr_class_type a -> self#list self#class_type_declaration a acc + | Pstr_include a -> self#include_declaration a acc + | Pstr_attribute a -> self#attribute a acc + | Pstr_extension (a, b) -> + let acc = self#extension a acc in + let acc = self#attributes b acc in acc method value_binding : value_binding -> 'acc -> 'acc= - fun { pvb_pat; pvb_expr; pvb_attributes; pvb_loc } -> - fun acc -> - let acc = self#pattern pvb_pat acc in - let acc = self#expression pvb_expr acc in - let acc = self#attributes pvb_attributes acc in - let acc = self#location pvb_loc acc in acc + fun { pvb_pat; pvb_expr; pvb_attributes; pvb_loc } -> + fun acc -> + let acc = self#pattern pvb_pat acc in + let acc = self#expression pvb_expr acc in + let acc = self#attributes pvb_attributes acc in + let acc = self#location pvb_loc acc in acc method module_binding : module_binding -> 'acc -> 'acc= - fun { pmb_name; pmb_expr; pmb_attributes; pmb_loc } -> - fun acc -> - let acc = self#loc self#string pmb_name acc in - let acc = self#module_expr pmb_expr acc in - let acc = self#attributes pmb_attributes acc in - let acc = self#location pmb_loc acc in acc + fun { pmb_name; pmb_expr; pmb_attributes; pmb_loc } -> + fun acc -> + let acc = self#loc self#string pmb_name acc in + let acc = self#module_expr pmb_expr acc in + let acc = self#attributes pmb_attributes acc in + let acc = self#location pmb_loc acc in acc method toplevel_phrase : toplevel_phrase -> 'acc -> 'acc= - fun x -> - fun acc -> - match x with - | Ptop_def a -> self#structure a acc - | Ptop_dir (a,b) -> - let acc = self#string a acc in - let acc = self#directive_argument b acc in acc + fun x -> + fun acc -> + match x with + | Ptop_def a -> self#structure a acc + | Ptop_dir a -> self#toplevel_directive a acc + method toplevel_directive : toplevel_directive -> 'acc -> 'acc= + fun { pdir_name; pdir_arg; pdir_loc } -> + fun acc -> + let acc = self#loc self#string pdir_name acc in + let acc = self#option self#directive_argument pdir_arg acc in + let acc = self#location pdir_loc acc in acc method directive_argument : directive_argument -> 'acc -> 'acc= - fun x -> - fun acc -> - match x with - | Pdir_none -> acc - | Pdir_string a -> self#string a acc - | Pdir_int (a,b) -> - let acc = self#string a acc in - let acc = self#option self#char b acc in acc - | Pdir_ident a -> self#longident a acc - | Pdir_bool a -> self#bool a acc + fun { pdira_desc; pdira_loc } -> + fun acc -> + let acc = self#directive_argument_desc pdira_desc acc in + let acc = self#location pdira_loc acc in acc + method directive_argument_desc : directive_argument_desc -> 'acc -> 'acc= + fun x -> + fun acc -> + match x with + | Pdir_string a -> self#string a acc + | Pdir_int (a, b) -> + let acc = self#string a acc in + let acc = self#option self#char b acc in acc + | Pdir_ident a -> self#longident a acc + | Pdir_bool a -> self#bool a acc end class virtual ['acc] fold_map = object (self) @@ -3157,717 +3362,755 @@ class virtual ['acc] fold_map = 'a . ('a -> 'acc -> ('a * 'acc)) -> 'a list -> 'acc -> ('a list * 'acc) method virtual option : 'a . - ('a -> 'acc -> ('a * 'acc)) -> - 'a option -> 'acc -> ('a option * 'acc) + ('a -> 'acc -> ('a * 'acc)) -> + 'a option -> 'acc -> ('a option * 'acc) method virtual string : string -> 'acc -> (string * 'acc) method position : position -> 'acc -> (position * 'acc)= - fun { pos_fname; pos_lnum; pos_bol; pos_cnum } -> - fun acc -> - let (pos_fname,acc) = self#string pos_fname acc in - let (pos_lnum,acc) = self#int pos_lnum acc in - let (pos_bol,acc) = self#int pos_bol acc in - let (pos_cnum,acc) = self#int pos_cnum acc in - ({ pos_fname; pos_lnum; pos_bol; pos_cnum }, acc) + fun { pos_fname; pos_lnum; pos_bol; pos_cnum } -> + fun acc -> + let (pos_fname, acc) = self#string pos_fname acc in + let (pos_lnum, acc) = self#int pos_lnum acc in + let (pos_bol, acc) = self#int pos_bol acc in + let (pos_cnum, acc) = self#int pos_cnum acc in + ({ pos_fname; pos_lnum; pos_bol; pos_cnum }, acc) method location : location -> 'acc -> (location * 'acc)= - fun { loc_start; loc_end; loc_ghost } -> - fun acc -> - let (loc_start,acc) = self#position loc_start acc in - let (loc_end,acc) = self#position loc_end acc in - let (loc_ghost,acc) = self#bool loc_ghost acc in - ({ loc_start; loc_end; loc_ghost }, acc) + fun { loc_start; loc_end; loc_ghost } -> + fun acc -> + let (loc_start, acc) = self#position loc_start acc in + let (loc_end, acc) = self#position loc_end acc in + let (loc_ghost, acc) = self#bool loc_ghost acc in + ({ loc_start; loc_end; loc_ghost }, acc) + method location_stack : location_stack -> 'acc -> (location_stack * 'acc)= + self#list self#location method loc : 'a . ('a -> 'acc -> ('a * 'acc)) -> 'a loc -> 'acc -> ('a loc * 'acc)= - fun _a -> - fun { txt; loc } -> - fun acc -> - let (txt,acc) = _a txt acc in - let (loc,acc) = self#location loc acc in ({ txt; loc }, acc) + fun _a -> + fun { txt; loc } -> + fun acc -> + let (txt, acc) = _a txt acc in + let (loc, acc) = self#location loc acc in ({ txt; loc }, acc) method longident : longident -> 'acc -> (longident * 'acc)= - fun x -> - fun acc -> - match x with - | Lident a -> let (a,acc) = self#string a acc in ((Lident a), acc) - | Ldot (a,b) -> - let (a,acc) = self#longident a acc in - let (b,acc) = self#string b acc in ((Ldot (a, b)), acc) - | Lapply (a,b) -> - let (a,acc) = self#longident a acc in - let (b,acc) = self#longident b acc in ((Lapply (a, b)), acc) + fun x -> + fun acc -> + match x with + | Lident a -> let (a, acc) = self#string a acc in ((Lident a), acc) + | Ldot (a, b) -> + let (a, acc) = self#longident a acc in + let (b, acc) = self#string b acc in ((Ldot (a, b)), acc) + | Lapply (a, b) -> + let (a, acc) = self#longident a acc in + let (b, acc) = self#longident b acc in ((Lapply (a, b)), acc) method longident_loc : longident_loc -> 'acc -> (longident_loc * 'acc)= self#loc self#longident method rec_flag : rec_flag -> 'acc -> (rec_flag * 'acc)= - fun x -> fun acc -> (x, acc) + fun x -> fun acc -> (x, acc) method direction_flag : direction_flag -> 'acc -> (direction_flag * 'acc)= - fun x -> fun acc -> (x, acc) + fun x -> fun acc -> (x, acc) method private_flag : private_flag -> 'acc -> (private_flag * 'acc)= - fun x -> fun acc -> (x, acc) + fun x -> fun acc -> (x, acc) method mutable_flag : mutable_flag -> 'acc -> (mutable_flag * 'acc)= - fun x -> fun acc -> (x, acc) + fun x -> fun acc -> (x, acc) method virtual_flag : virtual_flag -> 'acc -> (virtual_flag * 'acc)= - fun x -> fun acc -> (x, acc) + fun x -> fun acc -> (x, acc) method override_flag : override_flag -> 'acc -> (override_flag * 'acc)= - fun x -> fun acc -> (x, acc) + fun x -> fun acc -> (x, acc) method closed_flag : closed_flag -> 'acc -> (closed_flag * 'acc)= - fun x -> fun acc -> (x, acc) + fun x -> fun acc -> (x, acc) method label : label -> 'acc -> (label * 'acc)= self#string method arg_label : arg_label -> 'acc -> (arg_label * 'acc)= - fun x -> - fun acc -> - match x with - | Nolabel -> (Nolabel, acc) - | Labelled a -> - let (a,acc) = self#string a acc in ((Labelled a), acc) - | Optional a -> - let (a,acc) = self#string a acc in ((Optional a), acc) + fun x -> + fun acc -> + match x with + | Nolabel -> (Nolabel, acc) + | Labelled a -> + let (a, acc) = self#string a acc in ((Labelled a), acc) + | Optional a -> + let (a, acc) = self#string a acc in ((Optional a), acc) method variance : variance -> 'acc -> (variance * 'acc)= - fun x -> fun acc -> (x, acc) + fun x -> fun acc -> (x, acc) method constant : constant -> 'acc -> (constant * 'acc)= - fun x -> - fun acc -> - match x with - | Pconst_integer (a,b) -> - let (a,acc) = self#string a acc in - let (b,acc) = self#option self#char b acc in - ((Pconst_integer (a, b)), acc) - | Pconst_char a -> - let (a,acc) = self#char a acc in ((Pconst_char a), acc) - | Pconst_string (a,b) -> - let (a,acc) = self#string a acc in - let (b,acc) = self#option self#string b acc in - ((Pconst_string (a, b)), acc) - | Pconst_float (a,b) -> - let (a,acc) = self#string a acc in - let (b,acc) = self#option self#char b acc in - ((Pconst_float (a, b)), acc) + fun x -> + fun acc -> + match x with + | Pconst_integer (a, b) -> + let (a, acc) = self#string a acc in + let (b, acc) = self#option self#char b acc in + ((Pconst_integer (a, b)), acc) + | Pconst_char a -> + let (a, acc) = self#char a acc in ((Pconst_char a), acc) + | Pconst_string (a, b) -> + let (a, acc) = self#string a acc in + let (b, acc) = self#option self#string b acc in + ((Pconst_string (a, b)), acc) + | Pconst_float (a, b) -> + let (a, acc) = self#string a acc in + let (b, acc) = self#option self#char b acc in + ((Pconst_float (a, b)), acc) method attribute : attribute -> 'acc -> (attribute * 'acc)= - fun (a,b) -> - fun acc -> - let (a,acc) = self#loc self#string a acc in - let (b,acc) = self#payload b acc in ((a, b), acc) + fun { attr_name; attr_payload; attr_loc } -> + fun acc -> + let (attr_name, acc) = self#loc self#string attr_name acc in + let (attr_payload, acc) = self#payload attr_payload acc in + let (attr_loc, acc) = self#location attr_loc acc in + ({ attr_name; attr_payload; attr_loc }, acc) method extension : extension -> 'acc -> (extension * 'acc)= - fun (a,b) -> - fun acc -> - let (a,acc) = self#loc self#string a acc in - let (b,acc) = self#payload b acc in ((a, b), acc) + fun (a, b) -> + fun acc -> + let (a, acc) = self#loc self#string a acc in + let (b, acc) = self#payload b acc in ((a, b), acc) method attributes : attributes -> 'acc -> (attributes * 'acc)= self#list self#attribute method payload : payload -> 'acc -> (payload * 'acc)= - fun x -> - fun acc -> - match x with - | PStr a -> let (a,acc) = self#structure a acc in ((PStr a), acc) - | PSig a -> let (a,acc) = self#signature a acc in ((PSig a), acc) - | PTyp a -> let (a,acc) = self#core_type a acc in ((PTyp a), acc) - | PPat (a,b) -> - let (a,acc) = self#pattern a acc in - let (b,acc) = self#option self#expression b acc in - ((PPat (a, b)), acc) + fun x -> + fun acc -> + match x with + | PStr a -> let (a, acc) = self#structure a acc in ((PStr a), acc) + | PSig a -> let (a, acc) = self#signature a acc in ((PSig a), acc) + | PTyp a -> let (a, acc) = self#core_type a acc in ((PTyp a), acc) + | PPat (a, b) -> + let (a, acc) = self#pattern a acc in + let (b, acc) = self#option self#expression b acc in + ((PPat (a, b)), acc) method core_type : core_type -> 'acc -> (core_type * 'acc)= - fun { ptyp_desc; ptyp_loc; ptyp_attributes } -> - fun acc -> - let (ptyp_desc,acc) = self#core_type_desc ptyp_desc acc in - let (ptyp_loc,acc) = self#location ptyp_loc acc in - let (ptyp_attributes,acc) = self#attributes ptyp_attributes acc in - ({ ptyp_desc; ptyp_loc; ptyp_attributes }, acc) + fun { ptyp_desc; ptyp_loc; ptyp_loc_stack; ptyp_attributes } -> + fun acc -> + let (ptyp_desc, acc) = self#core_type_desc ptyp_desc acc in + let (ptyp_loc, acc) = self#location ptyp_loc acc in + let (ptyp_loc_stack, acc) = + self#location_stack ptyp_loc_stack acc in + let (ptyp_attributes, acc) = self#attributes ptyp_attributes acc in + ({ ptyp_desc; ptyp_loc; ptyp_loc_stack; ptyp_attributes }, acc) method core_type_desc : core_type_desc -> 'acc -> (core_type_desc * 'acc)= - fun x -> - fun acc -> - match x with - | Ptyp_any -> (Ptyp_any, acc) - | Ptyp_var a -> - let (a,acc) = self#string a acc in ((Ptyp_var a), acc) - | Ptyp_arrow (a,b,c) -> - let (a,acc) = self#arg_label a acc in - let (b,acc) = self#core_type b acc in - let (c,acc) = self#core_type c acc in - ((Ptyp_arrow (a, b, c)), acc) - | Ptyp_tuple a -> - let (a,acc) = self#list self#core_type a acc in - ((Ptyp_tuple a), acc) - | Ptyp_constr (a,b) -> - let (a,acc) = self#longident_loc a acc in - let (b,acc) = self#list self#core_type b acc in - ((Ptyp_constr (a, b)), acc) - | Ptyp_object (a,b) -> - let (a,acc) = self#list self#object_field a acc in - let (b,acc) = self#closed_flag b acc in - ((Ptyp_object (a, b)), acc) - | Ptyp_class (a,b) -> - let (a,acc) = self#longident_loc a acc in - let (b,acc) = self#list self#core_type b acc in - ((Ptyp_class (a, b)), acc) - | Ptyp_alias (a,b) -> - let (a,acc) = self#core_type a acc in - let (b,acc) = self#string b acc in ((Ptyp_alias (a, b)), acc) - | Ptyp_variant (a,b,c) -> - let (a,acc) = self#list self#row_field a acc in - let (b,acc) = self#closed_flag b acc in - let (c,acc) = self#option (self#list self#label) c acc in - ((Ptyp_variant (a, b, c)), acc) - | Ptyp_poly (a,b) -> - let (a,acc) = self#list (self#loc self#string) a acc in - let (b,acc) = self#core_type b acc in - ((Ptyp_poly (a, b)), acc) - | Ptyp_package a -> - let (a,acc) = self#package_type a acc in - ((Ptyp_package a), acc) - | Ptyp_extension a -> - let (a,acc) = self#extension a acc in - ((Ptyp_extension a), acc) + fun x -> + fun acc -> + match x with + | Ptyp_any -> (Ptyp_any, acc) + | Ptyp_var a -> + let (a, acc) = self#string a acc in ((Ptyp_var a), acc) + | Ptyp_arrow (a, b, c) -> + let (a, acc) = self#arg_label a acc in + let (b, acc) = self#core_type b acc in + let (c, acc) = self#core_type c acc in + ((Ptyp_arrow (a, b, c)), acc) + | Ptyp_tuple a -> + let (a, acc) = self#list self#core_type a acc in + ((Ptyp_tuple a), acc) + | Ptyp_constr (a, b) -> + let (a, acc) = self#longident_loc a acc in + let (b, acc) = self#list self#core_type b acc in + ((Ptyp_constr (a, b)), acc) + | Ptyp_object (a, b) -> + let (a, acc) = self#list self#object_field a acc in + let (b, acc) = self#closed_flag b acc in + ((Ptyp_object (a, b)), acc) + | Ptyp_class (a, b) -> + let (a, acc) = self#longident_loc a acc in + let (b, acc) = self#list self#core_type b acc in + ((Ptyp_class (a, b)), acc) + | Ptyp_alias (a, b) -> + let (a, acc) = self#core_type a acc in + let (b, acc) = self#string b acc in ((Ptyp_alias (a, b)), acc) + | Ptyp_variant (a, b, c) -> + let (a, acc) = self#list self#row_field a acc in + let (b, acc) = self#closed_flag b acc in + let (c, acc) = self#option (self#list self#label) c acc in + ((Ptyp_variant (a, b, c)), acc) + | Ptyp_poly (a, b) -> + let (a, acc) = self#list (self#loc self#string) a acc in + let (b, acc) = self#core_type b acc in + ((Ptyp_poly (a, b)), acc) + | Ptyp_package a -> + let (a, acc) = self#package_type a acc in + ((Ptyp_package a), acc) + | Ptyp_extension a -> + let (a, acc) = self#extension a acc in + ((Ptyp_extension a), acc) method package_type : package_type -> 'acc -> (package_type * 'acc)= - fun (a,b) -> - fun acc -> - let (a,acc) = self#longident_loc a acc in - let (b,acc) = - self#list - (fun (a,b) -> - fun acc -> - let (a,acc) = self#longident_loc a acc in - let (b,acc) = self#core_type b acc in ((a, b), acc)) b - acc - in - ((a, b), acc) + fun (a, b) -> + fun acc -> + let (a, acc) = self#longident_loc a acc in + let (b, acc) = + self#list + (fun (a, b) -> + fun acc -> + let (a, acc) = self#longident_loc a acc in + let (b, acc) = self#core_type b acc in ((a, b), acc)) b + acc in + ((a, b), acc) method row_field : row_field -> 'acc -> (row_field * 'acc)= - fun x -> - fun acc -> - match x with - | Rtag (a,b,c,d) -> - let (a,acc) = self#loc self#label a acc in - let (b,acc) = self#attributes b acc in - let (c,acc) = self#bool c acc in - let (d,acc) = self#list self#core_type d acc in - ((Rtag (a, b, c, d)), acc) - | Rinherit a -> - let (a,acc) = self#core_type a acc in ((Rinherit a), acc) + fun { prf_desc; prf_loc; prf_attributes } -> + fun acc -> + let (prf_desc, acc) = self#row_field_desc prf_desc acc in + let (prf_loc, acc) = self#location prf_loc acc in + let (prf_attributes, acc) = self#attributes prf_attributes acc in + ({ prf_desc; prf_loc; prf_attributes }, acc) + method row_field_desc : + row_field_desc -> 'acc -> (row_field_desc * 'acc)= + fun x -> + fun acc -> + match x with + | Rtag (a, b, c) -> + let (a, acc) = self#loc self#label a acc in + let (b, acc) = self#bool b acc in + let (c, acc) = self#list self#core_type c acc in + ((Rtag (a, b, c)), acc) + | Rinherit a -> + let (a, acc) = self#core_type a acc in ((Rinherit a), acc) method object_field : object_field -> 'acc -> (object_field * 'acc)= - fun x -> - fun acc -> - match x with - | Otag (a,b,c) -> - let (a,acc) = self#loc self#label a acc in - let (b,acc) = self#attributes b acc in - let (c,acc) = self#core_type c acc in ((Otag (a, b, c)), acc) - | Oinherit a -> - let (a,acc) = self#core_type a acc in ((Oinherit a), acc) + fun { pof_desc; pof_loc; pof_attributes } -> + fun acc -> + let (pof_desc, acc) = self#object_field_desc pof_desc acc in + let (pof_loc, acc) = self#location pof_loc acc in + let (pof_attributes, acc) = self#attributes pof_attributes acc in + ({ pof_desc; pof_loc; pof_attributes }, acc) + method object_field_desc : + object_field_desc -> 'acc -> (object_field_desc * 'acc)= + fun x -> + fun acc -> + match x with + | Otag (a, b) -> + let (a, acc) = self#loc self#label a acc in + let (b, acc) = self#core_type b acc in ((Otag (a, b)), acc) + | Oinherit a -> + let (a, acc) = self#core_type a acc in ((Oinherit a), acc) method pattern : pattern -> 'acc -> (pattern * 'acc)= - fun { ppat_desc; ppat_loc; ppat_attributes } -> - fun acc -> - let (ppat_desc,acc) = self#pattern_desc ppat_desc acc in - let (ppat_loc,acc) = self#location ppat_loc acc in - let (ppat_attributes,acc) = self#attributes ppat_attributes acc in - ({ ppat_desc; ppat_loc; ppat_attributes }, acc) + fun { ppat_desc; ppat_loc; ppat_loc_stack; ppat_attributes } -> + fun acc -> + let (ppat_desc, acc) = self#pattern_desc ppat_desc acc in + let (ppat_loc, acc) = self#location ppat_loc acc in + let (ppat_loc_stack, acc) = + self#location_stack ppat_loc_stack acc in + let (ppat_attributes, acc) = self#attributes ppat_attributes acc in + ({ ppat_desc; ppat_loc; ppat_loc_stack; ppat_attributes }, acc) method pattern_desc : pattern_desc -> 'acc -> (pattern_desc * 'acc)= - fun x -> - fun acc -> - match x with - | Ppat_any -> (Ppat_any, acc) - | Ppat_var a -> - let (a,acc) = self#loc self#string a acc in - ((Ppat_var a), acc) - | Ppat_alias (a,b) -> - let (a,acc) = self#pattern a acc in - let (b,acc) = self#loc self#string b acc in - ((Ppat_alias (a, b)), acc) - | Ppat_constant a -> - let (a,acc) = self#constant a acc in ((Ppat_constant a), acc) - | Ppat_interval (a,b) -> - let (a,acc) = self#constant a acc in - let (b,acc) = self#constant b acc in - ((Ppat_interval (a, b)), acc) - | Ppat_tuple a -> - let (a,acc) = self#list self#pattern a acc in - ((Ppat_tuple a), acc) - | Ppat_construct (a,b) -> - let (a,acc) = self#longident_loc a acc in - let (b,acc) = self#option self#pattern b acc in - ((Ppat_construct (a, b)), acc) - | Ppat_variant (a,b) -> - let (a,acc) = self#label a acc in - let (b,acc) = self#option self#pattern b acc in - ((Ppat_variant (a, b)), acc) - | Ppat_record (a,b) -> - let (a,acc) = - self#list - (fun (a,b) -> - fun acc -> - let (a,acc) = self#longident_loc a acc in - let (b,acc) = self#pattern b acc in ((a, b), acc)) a - acc - in - let (b,acc) = self#closed_flag b acc in - ((Ppat_record (a, b)), acc) - | Ppat_array a -> - let (a,acc) = self#list self#pattern a acc in - ((Ppat_array a), acc) - | Ppat_or (a,b) -> - let (a,acc) = self#pattern a acc in - let (b,acc) = self#pattern b acc in ((Ppat_or (a, b)), acc) - | Ppat_constraint (a,b) -> - let (a,acc) = self#pattern a acc in - let (b,acc) = self#core_type b acc in - ((Ppat_constraint (a, b)), acc) - | Ppat_type a -> - let (a,acc) = self#longident_loc a acc in ((Ppat_type a), acc) - | Ppat_lazy a -> - let (a,acc) = self#pattern a acc in ((Ppat_lazy a), acc) - | Ppat_unpack a -> - let (a,acc) = self#loc self#string a acc in - ((Ppat_unpack a), acc) - | Ppat_exception a -> - let (a,acc) = self#pattern a acc in ((Ppat_exception a), acc) - | Ppat_extension a -> - let (a,acc) = self#extension a acc in - ((Ppat_extension a), acc) - | Ppat_open (a,b) -> - let (a,acc) = self#longident_loc a acc in - let (b,acc) = self#pattern b acc in ((Ppat_open (a, b)), acc) + fun x -> + fun acc -> + match x with + | Ppat_any -> (Ppat_any, acc) + | Ppat_var a -> + let (a, acc) = self#loc self#string a acc in + ((Ppat_var a), acc) + | Ppat_alias (a, b) -> + let (a, acc) = self#pattern a acc in + let (b, acc) = self#loc self#string b acc in + ((Ppat_alias (a, b)), acc) + | Ppat_constant a -> + let (a, acc) = self#constant a acc in ((Ppat_constant a), acc) + | Ppat_interval (a, b) -> + let (a, acc) = self#constant a acc in + let (b, acc) = self#constant b acc in + ((Ppat_interval (a, b)), acc) + | Ppat_tuple a -> + let (a, acc) = self#list self#pattern a acc in + ((Ppat_tuple a), acc) + | Ppat_construct (a, b) -> + let (a, acc) = self#longident_loc a acc in + let (b, acc) = self#option self#pattern b acc in + ((Ppat_construct (a, b)), acc) + | Ppat_variant (a, b) -> + let (a, acc) = self#label a acc in + let (b, acc) = self#option self#pattern b acc in + ((Ppat_variant (a, b)), acc) + | Ppat_record (a, b) -> + let (a, acc) = + self#list + (fun (a, b) -> + fun acc -> + let (a, acc) = self#longident_loc a acc in + let (b, acc) = self#pattern b acc in ((a, b), acc)) a + acc in + let (b, acc) = self#closed_flag b acc in + ((Ppat_record (a, b)), acc) + | Ppat_array a -> + let (a, acc) = self#list self#pattern a acc in + ((Ppat_array a), acc) + | Ppat_or (a, b) -> + let (a, acc) = self#pattern a acc in + let (b, acc) = self#pattern b acc in ((Ppat_or (a, b)), acc) + | Ppat_constraint (a, b) -> + let (a, acc) = self#pattern a acc in + let (b, acc) = self#core_type b acc in + ((Ppat_constraint (a, b)), acc) + | Ppat_type a -> + let (a, acc) = self#longident_loc a acc in ((Ppat_type a), acc) + | Ppat_lazy a -> + let (a, acc) = self#pattern a acc in ((Ppat_lazy a), acc) + | Ppat_unpack a -> + let (a, acc) = self#loc self#string a acc in + ((Ppat_unpack a), acc) + | Ppat_exception a -> + let (a, acc) = self#pattern a acc in ((Ppat_exception a), acc) + | Ppat_extension a -> + let (a, acc) = self#extension a acc in + ((Ppat_extension a), acc) + | Ppat_open (a, b) -> + let (a, acc) = self#longident_loc a acc in + let (b, acc) = self#pattern b acc in ((Ppat_open (a, b)), acc) method expression : expression -> 'acc -> (expression * 'acc)= - fun { pexp_desc; pexp_loc; pexp_attributes } -> - fun acc -> - let (pexp_desc,acc) = self#expression_desc pexp_desc acc in - let (pexp_loc,acc) = self#location pexp_loc acc in - let (pexp_attributes,acc) = self#attributes pexp_attributes acc in - ({ pexp_desc; pexp_loc; pexp_attributes }, acc) + fun { pexp_desc; pexp_loc; pexp_loc_stack; pexp_attributes } -> + fun acc -> + let (pexp_desc, acc) = self#expression_desc pexp_desc acc in + let (pexp_loc, acc) = self#location pexp_loc acc in + let (pexp_loc_stack, acc) = + self#location_stack pexp_loc_stack acc in + let (pexp_attributes, acc) = self#attributes pexp_attributes acc in + ({ pexp_desc; pexp_loc; pexp_loc_stack; pexp_attributes }, acc) method expression_desc : expression_desc -> 'acc -> (expression_desc * 'acc)= - fun x -> - fun acc -> - match x with - | Pexp_ident a -> - let (a,acc) = self#longident_loc a acc in - ((Pexp_ident a), acc) - | Pexp_constant a -> - let (a,acc) = self#constant a acc in ((Pexp_constant a), acc) - | Pexp_let (a,b,c) -> - let (a,acc) = self#rec_flag a acc in - let (b,acc) = self#list self#value_binding b acc in - let (c,acc) = self#expression c acc in - ((Pexp_let (a, b, c)), acc) - | Pexp_function a -> - let (a,acc) = self#list self#case a acc in - ((Pexp_function a), acc) - | Pexp_fun (a,b,c,d) -> - let (a,acc) = self#arg_label a acc in - let (b,acc) = self#option self#expression b acc in - let (c,acc) = self#pattern c acc in - let (d,acc) = self#expression d acc in - ((Pexp_fun (a, b, c, d)), acc) - | Pexp_apply (a,b) -> - let (a,acc) = self#expression a acc in - let (b,acc) = - self#list - (fun (a,b) -> - fun acc -> - let (a,acc) = self#arg_label a acc in - let (b,acc) = self#expression b acc in ((a, b), acc)) - b acc - in - ((Pexp_apply (a, b)), acc) - | Pexp_match (a,b) -> - let (a,acc) = self#expression a acc in - let (b,acc) = self#list self#case b acc in - ((Pexp_match (a, b)), acc) - | Pexp_try (a,b) -> - let (a,acc) = self#expression a acc in - let (b,acc) = self#list self#case b acc in - ((Pexp_try (a, b)), acc) - | Pexp_tuple a -> - let (a,acc) = self#list self#expression a acc in - ((Pexp_tuple a), acc) - | Pexp_construct (a,b) -> - let (a,acc) = self#longident_loc a acc in - let (b,acc) = self#option self#expression b acc in - ((Pexp_construct (a, b)), acc) - | Pexp_variant (a,b) -> - let (a,acc) = self#label a acc in - let (b,acc) = self#option self#expression b acc in - ((Pexp_variant (a, b)), acc) - | Pexp_record (a,b) -> - let (a,acc) = - self#list - (fun (a,b) -> - fun acc -> - let (a,acc) = self#longident_loc a acc in - let (b,acc) = self#expression b acc in ((a, b), acc)) - a acc - in - let (b,acc) = self#option self#expression b acc in - ((Pexp_record (a, b)), acc) - | Pexp_field (a,b) -> - let (a,acc) = self#expression a acc in - let (b,acc) = self#longident_loc b acc in - ((Pexp_field (a, b)), acc) - | Pexp_setfield (a,b,c) -> - let (a,acc) = self#expression a acc in - let (b,acc) = self#longident_loc b acc in - let (c,acc) = self#expression c acc in - ((Pexp_setfield (a, b, c)), acc) - | Pexp_array a -> - let (a,acc) = self#list self#expression a acc in - ((Pexp_array a), acc) - | Pexp_ifthenelse (a,b,c) -> - let (a,acc) = self#expression a acc in - let (b,acc) = self#expression b acc in - let (c,acc) = self#option self#expression c acc in - ((Pexp_ifthenelse (a, b, c)), acc) - | Pexp_sequence (a,b) -> - let (a,acc) = self#expression a acc in - let (b,acc) = self#expression b acc in - ((Pexp_sequence (a, b)), acc) - | Pexp_while (a,b) -> - let (a,acc) = self#expression a acc in - let (b,acc) = self#expression b acc in - ((Pexp_while (a, b)), acc) - | Pexp_for (a,b,c,d,e) -> - let (a,acc) = self#pattern a acc in - let (b,acc) = self#expression b acc in - let (c,acc) = self#expression c acc in - let (d,acc) = self#direction_flag d acc in - let (e,acc) = self#expression e acc in - ((Pexp_for (a, b, c, d, e)), acc) - | Pexp_constraint (a,b) -> - let (a,acc) = self#expression a acc in - let (b,acc) = self#core_type b acc in - ((Pexp_constraint (a, b)), acc) - | Pexp_coerce (a,b,c) -> - let (a,acc) = self#expression a acc in - let (b,acc) = self#option self#core_type b acc in - let (c,acc) = self#core_type c acc in - ((Pexp_coerce (a, b, c)), acc) - | Pexp_send (a,b) -> - let (a,acc) = self#expression a acc in - let (b,acc) = self#loc self#label b acc in - ((Pexp_send (a, b)), acc) - | Pexp_new a -> - let (a,acc) = self#longident_loc a acc in ((Pexp_new a), acc) - | Pexp_setinstvar (a,b) -> - let (a,acc) = self#loc self#label a acc in - let (b,acc) = self#expression b acc in - ((Pexp_setinstvar (a, b)), acc) - | Pexp_override a -> - let (a,acc) = - self#list - (fun (a,b) -> - fun acc -> - let (a,acc) = self#loc self#label a acc in - let (b,acc) = self#expression b acc in ((a, b), acc)) - a acc - in - ((Pexp_override a), acc) - | Pexp_letmodule (a,b,c) -> - let (a,acc) = self#loc self#string a acc in - let (b,acc) = self#module_expr b acc in - let (c,acc) = self#expression c acc in - ((Pexp_letmodule (a, b, c)), acc) - | Pexp_letexception (a,b) -> - let (a,acc) = self#extension_constructor a acc in - let (b,acc) = self#expression b acc in - ((Pexp_letexception (a, b)), acc) - | Pexp_assert a -> - let (a,acc) = self#expression a acc in ((Pexp_assert a), acc) - | Pexp_lazy a -> - let (a,acc) = self#expression a acc in ((Pexp_lazy a), acc) - | Pexp_poly (a,b) -> - let (a,acc) = self#expression a acc in - let (b,acc) = self#option self#core_type b acc in - ((Pexp_poly (a, b)), acc) - | Pexp_object a -> - let (a,acc) = self#class_structure a acc in - ((Pexp_object a), acc) - | Pexp_newtype (a,b) -> - let (a,acc) = self#loc self#string a acc in - let (b,acc) = self#expression b acc in - ((Pexp_newtype (a, b)), acc) - | Pexp_pack a -> - let (a,acc) = self#module_expr a acc in ((Pexp_pack a), acc) - | Pexp_open (a,b,c) -> - let (a,acc) = self#override_flag a acc in - let (b,acc) = self#longident_loc b acc in - let (c,acc) = self#expression c acc in - ((Pexp_open (a, b, c)), acc) - | Pexp_extension a -> - let (a,acc) = self#extension a acc in - ((Pexp_extension a), acc) - | Pexp_unreachable -> (Pexp_unreachable, acc) + fun x -> + fun acc -> + match x with + | Pexp_ident a -> + let (a, acc) = self#longident_loc a acc in + ((Pexp_ident a), acc) + | Pexp_constant a -> + let (a, acc) = self#constant a acc in ((Pexp_constant a), acc) + | Pexp_let (a, b, c) -> + let (a, acc) = self#rec_flag a acc in + let (b, acc) = self#list self#value_binding b acc in + let (c, acc) = self#expression c acc in + ((Pexp_let (a, b, c)), acc) + | Pexp_function a -> + let (a, acc) = self#list self#case a acc in + ((Pexp_function a), acc) + | Pexp_fun (a, b, c, d) -> + let (a, acc) = self#arg_label a acc in + let (b, acc) = self#option self#expression b acc in + let (c, acc) = self#pattern c acc in + let (d, acc) = self#expression d acc in + ((Pexp_fun (a, b, c, d)), acc) + | Pexp_apply (a, b) -> + let (a, acc) = self#expression a acc in + let (b, acc) = + self#list + (fun (a, b) -> + fun acc -> + let (a, acc) = self#arg_label a acc in + let (b, acc) = self#expression b acc in ((a, b), acc)) + b acc in + ((Pexp_apply (a, b)), acc) + | Pexp_match (a, b) -> + let (a, acc) = self#expression a acc in + let (b, acc) = self#list self#case b acc in + ((Pexp_match (a, b)), acc) + | Pexp_try (a, b) -> + let (a, acc) = self#expression a acc in + let (b, acc) = self#list self#case b acc in + ((Pexp_try (a, b)), acc) + | Pexp_tuple a -> + let (a, acc) = self#list self#expression a acc in + ((Pexp_tuple a), acc) + | Pexp_construct (a, b) -> + let (a, acc) = self#longident_loc a acc in + let (b, acc) = self#option self#expression b acc in + ((Pexp_construct (a, b)), acc) + | Pexp_variant (a, b) -> + let (a, acc) = self#label a acc in + let (b, acc) = self#option self#expression b acc in + ((Pexp_variant (a, b)), acc) + | Pexp_record (a, b) -> + let (a, acc) = + self#list + (fun (a, b) -> + fun acc -> + let (a, acc) = self#longident_loc a acc in + let (b, acc) = self#expression b acc in ((a, b), acc)) + a acc in + let (b, acc) = self#option self#expression b acc in + ((Pexp_record (a, b)), acc) + | Pexp_field (a, b) -> + let (a, acc) = self#expression a acc in + let (b, acc) = self#longident_loc b acc in + ((Pexp_field (a, b)), acc) + | Pexp_setfield (a, b, c) -> + let (a, acc) = self#expression a acc in + let (b, acc) = self#longident_loc b acc in + let (c, acc) = self#expression c acc in + ((Pexp_setfield (a, b, c)), acc) + | Pexp_array a -> + let (a, acc) = self#list self#expression a acc in + ((Pexp_array a), acc) + | Pexp_ifthenelse (a, b, c) -> + let (a, acc) = self#expression a acc in + let (b, acc) = self#expression b acc in + let (c, acc) = self#option self#expression c acc in + ((Pexp_ifthenelse (a, b, c)), acc) + | Pexp_sequence (a, b) -> + let (a, acc) = self#expression a acc in + let (b, acc) = self#expression b acc in + ((Pexp_sequence (a, b)), acc) + | Pexp_while (a, b) -> + let (a, acc) = self#expression a acc in + let (b, acc) = self#expression b acc in + ((Pexp_while (a, b)), acc) + | Pexp_for (a, b, c, d, e) -> + let (a, acc) = self#pattern a acc in + let (b, acc) = self#expression b acc in + let (c, acc) = self#expression c acc in + let (d, acc) = self#direction_flag d acc in + let (e, acc) = self#expression e acc in + ((Pexp_for (a, b, c, d, e)), acc) + | Pexp_constraint (a, b) -> + let (a, acc) = self#expression a acc in + let (b, acc) = self#core_type b acc in + ((Pexp_constraint (a, b)), acc) + | Pexp_coerce (a, b, c) -> + let (a, acc) = self#expression a acc in + let (b, acc) = self#option self#core_type b acc in + let (c, acc) = self#core_type c acc in + ((Pexp_coerce (a, b, c)), acc) + | Pexp_send (a, b) -> + let (a, acc) = self#expression a acc in + let (b, acc) = self#loc self#label b acc in + ((Pexp_send (a, b)), acc) + | Pexp_new a -> + let (a, acc) = self#longident_loc a acc in ((Pexp_new a), acc) + | Pexp_setinstvar (a, b) -> + let (a, acc) = self#loc self#label a acc in + let (b, acc) = self#expression b acc in + ((Pexp_setinstvar (a, b)), acc) + | Pexp_override a -> + let (a, acc) = + self#list + (fun (a, b) -> + fun acc -> + let (a, acc) = self#loc self#label a acc in + let (b, acc) = self#expression b acc in ((a, b), acc)) + a acc in + ((Pexp_override a), acc) + | Pexp_letmodule (a, b, c) -> + let (a, acc) = self#loc self#string a acc in + let (b, acc) = self#module_expr b acc in + let (c, acc) = self#expression c acc in + ((Pexp_letmodule (a, b, c)), acc) + | Pexp_letexception (a, b) -> + let (a, acc) = self#extension_constructor a acc in + let (b, acc) = self#expression b acc in + ((Pexp_letexception (a, b)), acc) + | Pexp_assert a -> + let (a, acc) = self#expression a acc in ((Pexp_assert a), acc) + | Pexp_lazy a -> + let (a, acc) = self#expression a acc in ((Pexp_lazy a), acc) + | Pexp_poly (a, b) -> + let (a, acc) = self#expression a acc in + let (b, acc) = self#option self#core_type b acc in + ((Pexp_poly (a, b)), acc) + | Pexp_object a -> + let (a, acc) = self#class_structure a acc in + ((Pexp_object a), acc) + | Pexp_newtype (a, b) -> + let (a, acc) = self#loc self#string a acc in + let (b, acc) = self#expression b acc in + ((Pexp_newtype (a, b)), acc) + | Pexp_pack a -> + let (a, acc) = self#module_expr a acc in ((Pexp_pack a), acc) + | Pexp_open (a, b) -> + let (a, acc) = self#open_declaration a acc in + let (b, acc) = self#expression b acc in + ((Pexp_open (a, b)), acc) + | Pexp_letop a -> + let (a, acc) = self#letop a acc in ((Pexp_letop a), acc) + | Pexp_extension a -> + let (a, acc) = self#extension a acc in + ((Pexp_extension a), acc) + | Pexp_unreachable -> (Pexp_unreachable, acc) method case : case -> 'acc -> (case * 'acc)= - fun { pc_lhs; pc_guard; pc_rhs } -> - fun acc -> - let (pc_lhs,acc) = self#pattern pc_lhs acc in - let (pc_guard,acc) = self#option self#expression pc_guard acc in - let (pc_rhs,acc) = self#expression pc_rhs acc in - ({ pc_lhs; pc_guard; pc_rhs }, acc) + fun { pc_lhs; pc_guard; pc_rhs } -> + fun acc -> + let (pc_lhs, acc) = self#pattern pc_lhs acc in + let (pc_guard, acc) = self#option self#expression pc_guard acc in + let (pc_rhs, acc) = self#expression pc_rhs acc in + ({ pc_lhs; pc_guard; pc_rhs }, acc) + method letop : letop -> 'acc -> (letop * 'acc)= + fun { let_; ands; body } -> + fun acc -> + let (let_, acc) = self#binding_op let_ acc in + let (ands, acc) = self#list self#binding_op ands acc in + let (body, acc) = self#expression body acc in + ({ let_; ands; body }, acc) + method binding_op : binding_op -> 'acc -> (binding_op * 'acc)= + fun { pbop_op; pbop_pat; pbop_exp; pbop_loc } -> + fun acc -> + let (pbop_op, acc) = self#loc self#string pbop_op acc in + let (pbop_pat, acc) = self#pattern pbop_pat acc in + let (pbop_exp, acc) = self#expression pbop_exp acc in + let (pbop_loc, acc) = self#location pbop_loc acc in + ({ pbop_op; pbop_pat; pbop_exp; pbop_loc }, acc) method value_description : value_description -> 'acc -> (value_description * 'acc)= - fun { pval_name; pval_type; pval_prim; pval_attributes; pval_loc } -> - fun acc -> - let (pval_name,acc) = self#loc self#string pval_name acc in - let (pval_type,acc) = self#core_type pval_type acc in - let (pval_prim,acc) = self#list self#string pval_prim acc in - let (pval_attributes,acc) = self#attributes pval_attributes acc in - let (pval_loc,acc) = self#location pval_loc acc in - ({ pval_name; pval_type; pval_prim; pval_attributes; pval_loc }, - acc) + fun { pval_name; pval_type; pval_prim; pval_attributes; pval_loc } -> + fun acc -> + let (pval_name, acc) = self#loc self#string pval_name acc in + let (pval_type, acc) = self#core_type pval_type acc in + let (pval_prim, acc) = self#list self#string pval_prim acc in + let (pval_attributes, acc) = self#attributes pval_attributes acc in + let (pval_loc, acc) = self#location pval_loc acc in + ({ pval_name; pval_type; pval_prim; pval_attributes; pval_loc }, + acc) method type_declaration : type_declaration -> 'acc -> (type_declaration * 'acc)= fun { ptype_name; ptype_params; ptype_cstrs; ptype_kind; ptype_private; ptype_manifest; ptype_attributes; ptype_loc } - -> - fun acc -> - let (ptype_name,acc) = self#loc self#string ptype_name acc in - let (ptype_params,acc) = - self#list - (fun (a,b) -> - fun acc -> - let (a,acc) = self#core_type a acc in - let (b,acc) = self#variance b acc in ((a, b), acc)) - ptype_params acc - in - let (ptype_cstrs,acc) = - self#list - (fun (a,b,c) -> - fun acc -> - let (a,acc) = self#core_type a acc in - let (b,acc) = self#core_type b acc in - let (c,acc) = self#location c acc in ((a, b, c), acc)) - ptype_cstrs acc - in - let (ptype_kind,acc) = self#type_kind ptype_kind acc in - let (ptype_private,acc) = self#private_flag ptype_private acc in - let (ptype_manifest,acc) = - self#option self#core_type ptype_manifest acc in - let (ptype_attributes,acc) = self#attributes ptype_attributes acc - in - let (ptype_loc,acc) = self#location ptype_loc acc in - ({ - ptype_name; - ptype_params; - ptype_cstrs; - ptype_kind; - ptype_private; - ptype_manifest; - ptype_attributes; - ptype_loc - }, acc) + -> + fun acc -> + let (ptype_name, acc) = self#loc self#string ptype_name acc in + let (ptype_params, acc) = + self#list + (fun (a, b) -> + fun acc -> + let (a, acc) = self#core_type a acc in + let (b, acc) = self#variance b acc in ((a, b), acc)) + ptype_params acc in + let (ptype_cstrs, acc) = + self#list + (fun (a, b, c) -> + fun acc -> + let (a, acc) = self#core_type a acc in + let (b, acc) = self#core_type b acc in + let (c, acc) = self#location c acc in ((a, b, c), acc)) + ptype_cstrs acc in + let (ptype_kind, acc) = self#type_kind ptype_kind acc in + let (ptype_private, acc) = self#private_flag ptype_private acc in + let (ptype_manifest, acc) = + self#option self#core_type ptype_manifest acc in + let (ptype_attributes, acc) = self#attributes ptype_attributes acc in + let (ptype_loc, acc) = self#location ptype_loc acc in + ({ + ptype_name; + ptype_params; + ptype_cstrs; + ptype_kind; + ptype_private; + ptype_manifest; + ptype_attributes; + ptype_loc + }, acc) method type_kind : type_kind -> 'acc -> (type_kind * 'acc)= - fun x -> - fun acc -> - match x with - | Ptype_abstract -> (Ptype_abstract, acc) - | Ptype_variant a -> - let (a,acc) = self#list self#constructor_declaration a acc in - ((Ptype_variant a), acc) - | Ptype_record a -> - let (a,acc) = self#list self#label_declaration a acc in - ((Ptype_record a), acc) - | Ptype_open -> (Ptype_open, acc) + fun x -> + fun acc -> + match x with + | Ptype_abstract -> (Ptype_abstract, acc) + | Ptype_variant a -> + let (a, acc) = self#list self#constructor_declaration a acc in + ((Ptype_variant a), acc) + | Ptype_record a -> + let (a, acc) = self#list self#label_declaration a acc in + ((Ptype_record a), acc) + | Ptype_open -> (Ptype_open, acc) method label_declaration : label_declaration -> 'acc -> (label_declaration * 'acc)= - fun { pld_name; pld_mutable; pld_type; pld_loc; pld_attributes } -> - fun acc -> - let (pld_name,acc) = self#loc self#string pld_name acc in - let (pld_mutable,acc) = self#mutable_flag pld_mutable acc in - let (pld_type,acc) = self#core_type pld_type acc in - let (pld_loc,acc) = self#location pld_loc acc in - let (pld_attributes,acc) = self#attributes pld_attributes acc in - ({ pld_name; pld_mutable; pld_type; pld_loc; pld_attributes }, acc) + fun { pld_name; pld_mutable; pld_type; pld_loc; pld_attributes } -> + fun acc -> + let (pld_name, acc) = self#loc self#string pld_name acc in + let (pld_mutable, acc) = self#mutable_flag pld_mutable acc in + let (pld_type, acc) = self#core_type pld_type acc in + let (pld_loc, acc) = self#location pld_loc acc in + let (pld_attributes, acc) = self#attributes pld_attributes acc in + ({ pld_name; pld_mutable; pld_type; pld_loc; pld_attributes }, acc) method constructor_declaration : constructor_declaration -> 'acc -> (constructor_declaration * 'acc)= - fun { pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes } -> - fun acc -> - let (pcd_name,acc) = self#loc self#string pcd_name acc in - let (pcd_args,acc) = self#constructor_arguments pcd_args acc in - let (pcd_res,acc) = self#option self#core_type pcd_res acc in - let (pcd_loc,acc) = self#location pcd_loc acc in - let (pcd_attributes,acc) = self#attributes pcd_attributes acc in - ({ pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes }, acc) + fun { pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes } -> + fun acc -> + let (pcd_name, acc) = self#loc self#string pcd_name acc in + let (pcd_args, acc) = self#constructor_arguments pcd_args acc in + let (pcd_res, acc) = self#option self#core_type pcd_res acc in + let (pcd_loc, acc) = self#location pcd_loc acc in + let (pcd_attributes, acc) = self#attributes pcd_attributes acc in + ({ pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes }, acc) method constructor_arguments : constructor_arguments -> 'acc -> (constructor_arguments * 'acc)= - fun x -> - fun acc -> - match x with - | Pcstr_tuple a -> - let (a,acc) = self#list self#core_type a acc in - ((Pcstr_tuple a), acc) - | Pcstr_record a -> - let (a,acc) = self#list self#label_declaration a acc in - ((Pcstr_record a), acc) + fun x -> + fun acc -> + match x with + | Pcstr_tuple a -> + let (a, acc) = self#list self#core_type a acc in + ((Pcstr_tuple a), acc) + | Pcstr_record a -> + let (a, acc) = self#list self#label_declaration a acc in + ((Pcstr_record a), acc) method type_extension : type_extension -> 'acc -> (type_extension * 'acc)= fun { ptyext_path; ptyext_params; ptyext_constructors; ptyext_private; - ptyext_attributes } - -> - fun acc -> - let (ptyext_path,acc) = self#longident_loc ptyext_path acc in - let (ptyext_params,acc) = - self#list - (fun (a,b) -> - fun acc -> - let (a,acc) = self#core_type a acc in - let (b,acc) = self#variance b acc in ((a, b), acc)) - ptyext_params acc - in - let (ptyext_constructors,acc) = - self#list self#extension_constructor ptyext_constructors acc in - let (ptyext_private,acc) = self#private_flag ptyext_private acc in - let (ptyext_attributes,acc) = self#attributes ptyext_attributes acc - in - ({ - ptyext_path; - ptyext_params; - ptyext_constructors; - ptyext_private; - ptyext_attributes - }, acc) + ptyext_loc; ptyext_attributes } + -> + fun acc -> + let (ptyext_path, acc) = self#longident_loc ptyext_path acc in + let (ptyext_params, acc) = + self#list + (fun (a, b) -> + fun acc -> + let (a, acc) = self#core_type a acc in + let (b, acc) = self#variance b acc in ((a, b), acc)) + ptyext_params acc in + let (ptyext_constructors, acc) = + self#list self#extension_constructor ptyext_constructors acc in + let (ptyext_private, acc) = self#private_flag ptyext_private acc in + let (ptyext_loc, acc) = self#location ptyext_loc acc in + let (ptyext_attributes, acc) = + self#attributes ptyext_attributes acc in + ({ + ptyext_path; + ptyext_params; + ptyext_constructors; + ptyext_private; + ptyext_loc; + ptyext_attributes + }, acc) method extension_constructor : extension_constructor -> 'acc -> (extension_constructor * 'acc)= - fun { pext_name; pext_kind; pext_loc; pext_attributes } -> - fun acc -> - let (pext_name,acc) = self#loc self#string pext_name acc in - let (pext_kind,acc) = self#extension_constructor_kind pext_kind acc - in - let (pext_loc,acc) = self#location pext_loc acc in - let (pext_attributes,acc) = self#attributes pext_attributes acc in - ({ pext_name; pext_kind; pext_loc; pext_attributes }, acc) + fun { pext_name; pext_kind; pext_loc; pext_attributes } -> + fun acc -> + let (pext_name, acc) = self#loc self#string pext_name acc in + let (pext_kind, acc) = + self#extension_constructor_kind pext_kind acc in + let (pext_loc, acc) = self#location pext_loc acc in + let (pext_attributes, acc) = self#attributes pext_attributes acc in + ({ pext_name; pext_kind; pext_loc; pext_attributes }, acc) + method type_exception : + type_exception -> 'acc -> (type_exception * 'acc)= + fun { ptyexn_constructor; ptyexn_loc; ptyexn_attributes } -> + fun acc -> + let (ptyexn_constructor, acc) = + self#extension_constructor ptyexn_constructor acc in + let (ptyexn_loc, acc) = self#location ptyexn_loc acc in + let (ptyexn_attributes, acc) = + self#attributes ptyexn_attributes acc in + ({ ptyexn_constructor; ptyexn_loc; ptyexn_attributes }, acc) method extension_constructor_kind : extension_constructor_kind -> - 'acc -> (extension_constructor_kind * 'acc)= - fun x -> - fun acc -> - match x with - | Pext_decl (a,b) -> - let (a,acc) = self#constructor_arguments a acc in - let (b,acc) = self#option self#core_type b acc in - ((Pext_decl (a, b)), acc) - | Pext_rebind a -> - let (a,acc) = self#longident_loc a acc in - ((Pext_rebind a), acc) + 'acc -> (extension_constructor_kind * 'acc)= + fun x -> + fun acc -> + match x with + | Pext_decl (a, b) -> + let (a, acc) = self#constructor_arguments a acc in + let (b, acc) = self#option self#core_type b acc in + ((Pext_decl (a, b)), acc) + | Pext_rebind a -> + let (a, acc) = self#longident_loc a acc in + ((Pext_rebind a), acc) method class_type : class_type -> 'acc -> (class_type * 'acc)= - fun { pcty_desc; pcty_loc; pcty_attributes } -> - fun acc -> - let (pcty_desc,acc) = self#class_type_desc pcty_desc acc in - let (pcty_loc,acc) = self#location pcty_loc acc in - let (pcty_attributes,acc) = self#attributes pcty_attributes acc in - ({ pcty_desc; pcty_loc; pcty_attributes }, acc) + fun { pcty_desc; pcty_loc; pcty_attributes } -> + fun acc -> + let (pcty_desc, acc) = self#class_type_desc pcty_desc acc in + let (pcty_loc, acc) = self#location pcty_loc acc in + let (pcty_attributes, acc) = self#attributes pcty_attributes acc in + ({ pcty_desc; pcty_loc; pcty_attributes }, acc) method class_type_desc : class_type_desc -> 'acc -> (class_type_desc * 'acc)= - fun x -> - fun acc -> - match x with - | Pcty_constr (a,b) -> - let (a,acc) = self#longident_loc a acc in - let (b,acc) = self#list self#core_type b acc in - ((Pcty_constr (a, b)), acc) - | Pcty_signature a -> - let (a,acc) = self#class_signature a acc in - ((Pcty_signature a), acc) - | Pcty_arrow (a,b,c) -> - let (a,acc) = self#arg_label a acc in - let (b,acc) = self#core_type b acc in - let (c,acc) = self#class_type c acc in - ((Pcty_arrow (a, b, c)), acc) - | Pcty_extension a -> - let (a,acc) = self#extension a acc in - ((Pcty_extension a), acc) - | Pcty_open (a,b,c) -> - let (a,acc) = self#override_flag a acc in - let (b,acc) = self#longident_loc b acc in - let (c,acc) = self#class_type c acc in - ((Pcty_open (a, b, c)), acc) + fun x -> + fun acc -> + match x with + | Pcty_constr (a, b) -> + let (a, acc) = self#longident_loc a acc in + let (b, acc) = self#list self#core_type b acc in + ((Pcty_constr (a, b)), acc) + | Pcty_signature a -> + let (a, acc) = self#class_signature a acc in + ((Pcty_signature a), acc) + | Pcty_arrow (a, b, c) -> + let (a, acc) = self#arg_label a acc in + let (b, acc) = self#core_type b acc in + let (c, acc) = self#class_type c acc in + ((Pcty_arrow (a, b, c)), acc) + | Pcty_extension a -> + let (a, acc) = self#extension a acc in + ((Pcty_extension a), acc) + | Pcty_open (a, b) -> + let (a, acc) = self#open_description a acc in + let (b, acc) = self#class_type b acc in + ((Pcty_open (a, b)), acc) method class_signature : class_signature -> 'acc -> (class_signature * 'acc)= - fun { pcsig_self; pcsig_fields } -> - fun acc -> - let (pcsig_self,acc) = self#core_type pcsig_self acc in - let (pcsig_fields,acc) = - self#list self#class_type_field pcsig_fields acc in - ({ pcsig_self; pcsig_fields }, acc) + fun { pcsig_self; pcsig_fields } -> + fun acc -> + let (pcsig_self, acc) = self#core_type pcsig_self acc in + let (pcsig_fields, acc) = + self#list self#class_type_field pcsig_fields acc in + ({ pcsig_self; pcsig_fields }, acc) method class_type_field : class_type_field -> 'acc -> (class_type_field * 'acc)= - fun { pctf_desc; pctf_loc; pctf_attributes } -> - fun acc -> - let (pctf_desc,acc) = self#class_type_field_desc pctf_desc acc in - let (pctf_loc,acc) = self#location pctf_loc acc in - let (pctf_attributes,acc) = self#attributes pctf_attributes acc in - ({ pctf_desc; pctf_loc; pctf_attributes }, acc) + fun { pctf_desc; pctf_loc; pctf_attributes } -> + fun acc -> + let (pctf_desc, acc) = self#class_type_field_desc pctf_desc acc in + let (pctf_loc, acc) = self#location pctf_loc acc in + let (pctf_attributes, acc) = self#attributes pctf_attributes acc in + ({ pctf_desc; pctf_loc; pctf_attributes }, acc) method class_type_field_desc : class_type_field_desc -> 'acc -> (class_type_field_desc * 'acc)= - fun x -> - fun acc -> - match x with - | Pctf_inherit a -> - let (a,acc) = self#class_type a acc in ((Pctf_inherit a), acc) - | Pctf_val a -> - let (a,acc) = - (fun (a,b,c,d) -> - fun acc -> - let (a,acc) = self#loc self#label a acc in - let (b,acc) = self#mutable_flag b acc in - let (c,acc) = self#virtual_flag c acc in - let (d,acc) = self#core_type d acc in - ((a, b, c, d), acc)) a acc - in - ((Pctf_val a), acc) - | Pctf_method a -> - let (a,acc) = - (fun (a,b,c,d) -> - fun acc -> - let (a,acc) = self#loc self#label a acc in - let (b,acc) = self#private_flag b acc in - let (c,acc) = self#virtual_flag c acc in - let (d,acc) = self#core_type d acc in - ((a, b, c, d), acc)) a acc - in - ((Pctf_method a), acc) - | Pctf_constraint a -> - let (a,acc) = - (fun (a,b) -> - fun acc -> - let (a,acc) = self#core_type a acc in - let (b,acc) = self#core_type b acc in ((a, b), acc)) a - acc - in - ((Pctf_constraint a), acc) - | Pctf_attribute a -> - let (a,acc) = self#attribute a acc in - ((Pctf_attribute a), acc) - | Pctf_extension a -> - let (a,acc) = self#extension a acc in - ((Pctf_extension a), acc) + fun x -> + fun acc -> + match x with + | Pctf_inherit a -> + let (a, acc) = self#class_type a acc in ((Pctf_inherit a), acc) + | Pctf_val a -> + let (a, acc) = + (fun (a, b, c, d) -> + fun acc -> + let (a, acc) = self#loc self#label a acc in + let (b, acc) = self#mutable_flag b acc in + let (c, acc) = self#virtual_flag c acc in + let (d, acc) = self#core_type d acc in + ((a, b, c, d), acc)) a acc in + ((Pctf_val a), acc) + | Pctf_method a -> + let (a, acc) = + (fun (a, b, c, d) -> + fun acc -> + let (a, acc) = self#loc self#label a acc in + let (b, acc) = self#private_flag b acc in + let (c, acc) = self#virtual_flag c acc in + let (d, acc) = self#core_type d acc in + ((a, b, c, d), acc)) a acc in + ((Pctf_method a), acc) + | Pctf_constraint a -> + let (a, acc) = + (fun (a, b) -> + fun acc -> + let (a, acc) = self#core_type a acc in + let (b, acc) = self#core_type b acc in ((a, b), acc)) a + acc in + ((Pctf_constraint a), acc) + | Pctf_attribute a -> + let (a, acc) = self#attribute a acc in + ((Pctf_attribute a), acc) + | Pctf_extension a -> + let (a, acc) = self#extension a acc in + ((Pctf_extension a), acc) method class_infos : 'a . - ('a -> 'acc -> ('a * 'acc)) -> - 'a class_infos -> 'acc -> ('a class_infos * 'acc)= - fun _a -> - fun - { pci_virt; pci_params; pci_name; pci_expr; pci_loc; pci_attributes - } - -> - fun acc -> - let (pci_virt,acc) = self#virtual_flag pci_virt acc in - let (pci_params,acc) = - self#list - (fun (a,b) -> - fun acc -> - let (a,acc) = self#core_type a acc in - let (b,acc) = self#variance b acc in ((a, b), acc)) - pci_params acc - in - let (pci_name,acc) = self#loc self#string pci_name acc in - let (pci_expr,acc) = _a pci_expr acc in - let (pci_loc,acc) = self#location pci_loc acc in - let (pci_attributes,acc) = self#attributes pci_attributes acc in - ({ - pci_virt; - pci_params; - pci_name; - pci_expr; - pci_loc; - pci_attributes - }, acc) + ('a -> 'acc -> ('a * 'acc)) -> + 'a class_infos -> 'acc -> ('a class_infos * 'acc)= + fun _a -> + fun + { pci_virt; pci_params; pci_name; pci_expr; pci_loc; pci_attributes + } + -> + fun acc -> + let (pci_virt, acc) = self#virtual_flag pci_virt acc in + let (pci_params, acc) = + self#list + (fun (a, b) -> + fun acc -> + let (a, acc) = self#core_type a acc in + let (b, acc) = self#variance b acc in ((a, b), acc)) + pci_params acc in + let (pci_name, acc) = self#loc self#string pci_name acc in + let (pci_expr, acc) = _a pci_expr acc in + let (pci_loc, acc) = self#location pci_loc acc in + let (pci_attributes, acc) = self#attributes pci_attributes acc in + ({ + pci_virt; + pci_params; + pci_name; + pci_expr; + pci_loc; + pci_attributes + }, acc) method class_description : class_description -> 'acc -> (class_description * 'acc)= self#class_infos self#class_type @@ -3875,264 +4118,282 @@ class virtual ['acc] fold_map = class_type_declaration -> 'acc -> (class_type_declaration * 'acc)= self#class_infos self#class_type method class_expr : class_expr -> 'acc -> (class_expr * 'acc)= - fun { pcl_desc; pcl_loc; pcl_attributes } -> - fun acc -> - let (pcl_desc,acc) = self#class_expr_desc pcl_desc acc in - let (pcl_loc,acc) = self#location pcl_loc acc in - let (pcl_attributes,acc) = self#attributes pcl_attributes acc in - ({ pcl_desc; pcl_loc; pcl_attributes }, acc) + fun { pcl_desc; pcl_loc; pcl_attributes } -> + fun acc -> + let (pcl_desc, acc) = self#class_expr_desc pcl_desc acc in + let (pcl_loc, acc) = self#location pcl_loc acc in + let (pcl_attributes, acc) = self#attributes pcl_attributes acc in + ({ pcl_desc; pcl_loc; pcl_attributes }, acc) method class_expr_desc : class_expr_desc -> 'acc -> (class_expr_desc * 'acc)= - fun x -> - fun acc -> - match x with - | Pcl_constr (a,b) -> - let (a,acc) = self#longident_loc a acc in - let (b,acc) = self#list self#core_type b acc in - ((Pcl_constr (a, b)), acc) - | Pcl_structure a -> - let (a,acc) = self#class_structure a acc in - ((Pcl_structure a), acc) - | Pcl_fun (a,b,c,d) -> - let (a,acc) = self#arg_label a acc in - let (b,acc) = self#option self#expression b acc in - let (c,acc) = self#pattern c acc in - let (d,acc) = self#class_expr d acc in - ((Pcl_fun (a, b, c, d)), acc) - | Pcl_apply (a,b) -> - let (a,acc) = self#class_expr a acc in - let (b,acc) = - self#list - (fun (a,b) -> - fun acc -> - let (a,acc) = self#arg_label a acc in - let (b,acc) = self#expression b acc in ((a, b), acc)) - b acc - in - ((Pcl_apply (a, b)), acc) - | Pcl_let (a,b,c) -> - let (a,acc) = self#rec_flag a acc in - let (b,acc) = self#list self#value_binding b acc in - let (c,acc) = self#class_expr c acc in - ((Pcl_let (a, b, c)), acc) - | Pcl_constraint (a,b) -> - let (a,acc) = self#class_expr a acc in - let (b,acc) = self#class_type b acc in - ((Pcl_constraint (a, b)), acc) - | Pcl_extension a -> - let (a,acc) = self#extension a acc in ((Pcl_extension a), acc) - | Pcl_open (a,b,c) -> - let (a,acc) = self#override_flag a acc in - let (b,acc) = self#longident_loc b acc in - let (c,acc) = self#class_expr c acc in - ((Pcl_open (a, b, c)), acc) + fun x -> + fun acc -> + match x with + | Pcl_constr (a, b) -> + let (a, acc) = self#longident_loc a acc in + let (b, acc) = self#list self#core_type b acc in + ((Pcl_constr (a, b)), acc) + | Pcl_structure a -> + let (a, acc) = self#class_structure a acc in + ((Pcl_structure a), acc) + | Pcl_fun (a, b, c, d) -> + let (a, acc) = self#arg_label a acc in + let (b, acc) = self#option self#expression b acc in + let (c, acc) = self#pattern c acc in + let (d, acc) = self#class_expr d acc in + ((Pcl_fun (a, b, c, d)), acc) + | Pcl_apply (a, b) -> + let (a, acc) = self#class_expr a acc in + let (b, acc) = + self#list + (fun (a, b) -> + fun acc -> + let (a, acc) = self#arg_label a acc in + let (b, acc) = self#expression b acc in ((a, b), acc)) + b acc in + ((Pcl_apply (a, b)), acc) + | Pcl_let (a, b, c) -> + let (a, acc) = self#rec_flag a acc in + let (b, acc) = self#list self#value_binding b acc in + let (c, acc) = self#class_expr c acc in + ((Pcl_let (a, b, c)), acc) + | Pcl_constraint (a, b) -> + let (a, acc) = self#class_expr a acc in + let (b, acc) = self#class_type b acc in + ((Pcl_constraint (a, b)), acc) + | Pcl_extension a -> + let (a, acc) = self#extension a acc in ((Pcl_extension a), acc) + | Pcl_open (a, b) -> + let (a, acc) = self#open_description a acc in + let (b, acc) = self#class_expr b acc in + ((Pcl_open (a, b)), acc) method class_structure : class_structure -> 'acc -> (class_structure * 'acc)= - fun { pcstr_self; pcstr_fields } -> - fun acc -> - let (pcstr_self,acc) = self#pattern pcstr_self acc in - let (pcstr_fields,acc) = - self#list self#class_field pcstr_fields acc in - ({ pcstr_self; pcstr_fields }, acc) + fun { pcstr_self; pcstr_fields } -> + fun acc -> + let (pcstr_self, acc) = self#pattern pcstr_self acc in + let (pcstr_fields, acc) = + self#list self#class_field pcstr_fields acc in + ({ pcstr_self; pcstr_fields }, acc) method class_field : class_field -> 'acc -> (class_field * 'acc)= - fun { pcf_desc; pcf_loc; pcf_attributes } -> - fun acc -> - let (pcf_desc,acc) = self#class_field_desc pcf_desc acc in - let (pcf_loc,acc) = self#location pcf_loc acc in - let (pcf_attributes,acc) = self#attributes pcf_attributes acc in - ({ pcf_desc; pcf_loc; pcf_attributes }, acc) + fun { pcf_desc; pcf_loc; pcf_attributes } -> + fun acc -> + let (pcf_desc, acc) = self#class_field_desc pcf_desc acc in + let (pcf_loc, acc) = self#location pcf_loc acc in + let (pcf_attributes, acc) = self#attributes pcf_attributes acc in + ({ pcf_desc; pcf_loc; pcf_attributes }, acc) method class_field_desc : class_field_desc -> 'acc -> (class_field_desc * 'acc)= - fun x -> - fun acc -> - match x with - | Pcf_inherit (a,b,c) -> - let (a,acc) = self#override_flag a acc in - let (b,acc) = self#class_expr b acc in - let (c,acc) = self#option (self#loc self#string) c acc in - ((Pcf_inherit (a, b, c)), acc) - | Pcf_val a -> - let (a,acc) = - (fun (a,b,c) -> - fun acc -> - let (a,acc) = self#loc self#label a acc in - let (b,acc) = self#mutable_flag b acc in - let (c,acc) = self#class_field_kind c acc in - ((a, b, c), acc)) a acc - in - ((Pcf_val a), acc) - | Pcf_method a -> - let (a,acc) = - (fun (a,b,c) -> - fun acc -> - let (a,acc) = self#loc self#label a acc in - let (b,acc) = self#private_flag b acc in - let (c,acc) = self#class_field_kind c acc in - ((a, b, c), acc)) a acc - in - ((Pcf_method a), acc) - | Pcf_constraint a -> - let (a,acc) = - (fun (a,b) -> - fun acc -> - let (a,acc) = self#core_type a acc in - let (b,acc) = self#core_type b acc in ((a, b), acc)) a - acc - in - ((Pcf_constraint a), acc) - | Pcf_initializer a -> - let (a,acc) = self#expression a acc in - ((Pcf_initializer a), acc) - | Pcf_attribute a -> - let (a,acc) = self#attribute a acc in ((Pcf_attribute a), acc) - | Pcf_extension a -> - let (a,acc) = self#extension a acc in ((Pcf_extension a), acc) + fun x -> + fun acc -> + match x with + | Pcf_inherit (a, b, c) -> + let (a, acc) = self#override_flag a acc in + let (b, acc) = self#class_expr b acc in + let (c, acc) = self#option (self#loc self#string) c acc in + ((Pcf_inherit (a, b, c)), acc) + | Pcf_val a -> + let (a, acc) = + (fun (a, b, c) -> + fun acc -> + let (a, acc) = self#loc self#label a acc in + let (b, acc) = self#mutable_flag b acc in + let (c, acc) = self#class_field_kind c acc in + ((a, b, c), acc)) a acc in + ((Pcf_val a), acc) + | Pcf_method a -> + let (a, acc) = + (fun (a, b, c) -> + fun acc -> + let (a, acc) = self#loc self#label a acc in + let (b, acc) = self#private_flag b acc in + let (c, acc) = self#class_field_kind c acc in + ((a, b, c), acc)) a acc in + ((Pcf_method a), acc) + | Pcf_constraint a -> + let (a, acc) = + (fun (a, b) -> + fun acc -> + let (a, acc) = self#core_type a acc in + let (b, acc) = self#core_type b acc in ((a, b), acc)) a + acc in + ((Pcf_constraint a), acc) + | Pcf_initializer a -> + let (a, acc) = self#expression a acc in + ((Pcf_initializer a), acc) + | Pcf_attribute a -> + let (a, acc) = self#attribute a acc in ((Pcf_attribute a), acc) + | Pcf_extension a -> + let (a, acc) = self#extension a acc in ((Pcf_extension a), acc) method class_field_kind : class_field_kind -> 'acc -> (class_field_kind * 'acc)= - fun x -> - fun acc -> - match x with - | Cfk_virtual a -> - let (a,acc) = self#core_type a acc in ((Cfk_virtual a), acc) - | Cfk_concrete (a,b) -> - let (a,acc) = self#override_flag a acc in - let (b,acc) = self#expression b acc in - ((Cfk_concrete (a, b)), acc) + fun x -> + fun acc -> + match x with + | Cfk_virtual a -> + let (a, acc) = self#core_type a acc in ((Cfk_virtual a), acc) + | Cfk_concrete (a, b) -> + let (a, acc) = self#override_flag a acc in + let (b, acc) = self#expression b acc in + ((Cfk_concrete (a, b)), acc) method class_declaration : class_declaration -> 'acc -> (class_declaration * 'acc)= self#class_infos self#class_expr method module_type : module_type -> 'acc -> (module_type * 'acc)= - fun { pmty_desc; pmty_loc; pmty_attributes } -> - fun acc -> - let (pmty_desc,acc) = self#module_type_desc pmty_desc acc in - let (pmty_loc,acc) = self#location pmty_loc acc in - let (pmty_attributes,acc) = self#attributes pmty_attributes acc in - ({ pmty_desc; pmty_loc; pmty_attributes }, acc) + fun { pmty_desc; pmty_loc; pmty_attributes } -> + fun acc -> + let (pmty_desc, acc) = self#module_type_desc pmty_desc acc in + let (pmty_loc, acc) = self#location pmty_loc acc in + let (pmty_attributes, acc) = self#attributes pmty_attributes acc in + ({ pmty_desc; pmty_loc; pmty_attributes }, acc) method module_type_desc : module_type_desc -> 'acc -> (module_type_desc * 'acc)= - fun x -> - fun acc -> - match x with - | Pmty_ident a -> - let (a,acc) = self#longident_loc a acc in - ((Pmty_ident a), acc) - | Pmty_signature a -> - let (a,acc) = self#signature a acc in - ((Pmty_signature a), acc) - | Pmty_functor (a,b,c) -> - let (a,acc) = self#loc self#string a acc in - let (b,acc) = self#option self#module_type b acc in - let (c,acc) = self#module_type c acc in - ((Pmty_functor (a, b, c)), acc) - | Pmty_with (a,b) -> - let (a,acc) = self#module_type a acc in - let (b,acc) = self#list self#with_constraint b acc in - ((Pmty_with (a, b)), acc) - | Pmty_typeof a -> - let (a,acc) = self#module_expr a acc in ((Pmty_typeof a), acc) - | Pmty_extension a -> - let (a,acc) = self#extension a acc in - ((Pmty_extension a), acc) - | Pmty_alias a -> - let (a,acc) = self#longident_loc a acc in - ((Pmty_alias a), acc) + fun x -> + fun acc -> + match x with + | Pmty_ident a -> + let (a, acc) = self#longident_loc a acc in + ((Pmty_ident a), acc) + | Pmty_signature a -> + let (a, acc) = self#signature a acc in + ((Pmty_signature a), acc) + | Pmty_functor (a, b, c) -> + let (a, acc) = self#loc self#string a acc in + let (b, acc) = self#option self#module_type b acc in + let (c, acc) = self#module_type c acc in + ((Pmty_functor (a, b, c)), acc) + | Pmty_with (a, b) -> + let (a, acc) = self#module_type a acc in + let (b, acc) = self#list self#with_constraint b acc in + ((Pmty_with (a, b)), acc) + | Pmty_typeof a -> + let (a, acc) = self#module_expr a acc in ((Pmty_typeof a), acc) + | Pmty_extension a -> + let (a, acc) = self#extension a acc in + ((Pmty_extension a), acc) + | Pmty_alias a -> + let (a, acc) = self#longident_loc a acc in + ((Pmty_alias a), acc) method signature : signature -> 'acc -> (signature * 'acc)= self#list self#signature_item method signature_item : signature_item -> 'acc -> (signature_item * 'acc)= - fun { psig_desc; psig_loc } -> - fun acc -> - let (psig_desc,acc) = self#signature_item_desc psig_desc acc in - let (psig_loc,acc) = self#location psig_loc acc in - ({ psig_desc; psig_loc }, acc) + fun { psig_desc; psig_loc } -> + fun acc -> + let (psig_desc, acc) = self#signature_item_desc psig_desc acc in + let (psig_loc, acc) = self#location psig_loc acc in + ({ psig_desc; psig_loc }, acc) method signature_item_desc : signature_item_desc -> 'acc -> (signature_item_desc * 'acc)= - fun x -> - fun acc -> - match x with - | Psig_value a -> - let (a,acc) = self#value_description a acc in - ((Psig_value a), acc) - | Psig_type (a,b) -> - let (a,acc) = self#rec_flag a acc in - let (b,acc) = self#list self#type_declaration b acc in - ((Psig_type (a, b)), acc) - | Psig_typext a -> - let (a,acc) = self#type_extension a acc in - ((Psig_typext a), acc) - | Psig_exception a -> - let (a,acc) = self#extension_constructor a acc in - ((Psig_exception a), acc) - | Psig_module a -> - let (a,acc) = self#module_declaration a acc in - ((Psig_module a), acc) - | Psig_recmodule a -> - let (a,acc) = self#list self#module_declaration a acc in - ((Psig_recmodule a), acc) - | Psig_modtype a -> - let (a,acc) = self#module_type_declaration a acc in - ((Psig_modtype a), acc) - | Psig_open a -> - let (a,acc) = self#open_description a acc in - ((Psig_open a), acc) - | Psig_include a -> - let (a,acc) = self#include_description a acc in - ((Psig_include a), acc) - | Psig_class a -> - let (a,acc) = self#list self#class_description a acc in - ((Psig_class a), acc) - | Psig_class_type a -> - let (a,acc) = self#list self#class_type_declaration a acc in - ((Psig_class_type a), acc) - | Psig_attribute a -> - let (a,acc) = self#attribute a acc in - ((Psig_attribute a), acc) - | Psig_extension (a,b) -> - let (a,acc) = self#extension a acc in - let (b,acc) = self#attributes b acc in - ((Psig_extension (a, b)), acc) + fun x -> + fun acc -> + match x with + | Psig_value a -> + let (a, acc) = self#value_description a acc in + ((Psig_value a), acc) + | Psig_type (a, b) -> + let (a, acc) = self#rec_flag a acc in + let (b, acc) = self#list self#type_declaration b acc in + ((Psig_type (a, b)), acc) + | Psig_typesubst a -> + let (a, acc) = self#list self#type_declaration a acc in + ((Psig_typesubst a), acc) + | Psig_typext a -> + let (a, acc) = self#type_extension a acc in + ((Psig_typext a), acc) + | Psig_exception a -> + let (a, acc) = self#type_exception a acc in + ((Psig_exception a), acc) + | Psig_module a -> + let (a, acc) = self#module_declaration a acc in + ((Psig_module a), acc) + | Psig_modsubst a -> + let (a, acc) = self#module_substitution a acc in + ((Psig_modsubst a), acc) + | Psig_recmodule a -> + let (a, acc) = self#list self#module_declaration a acc in + ((Psig_recmodule a), acc) + | Psig_modtype a -> + let (a, acc) = self#module_type_declaration a acc in + ((Psig_modtype a), acc) + | Psig_open a -> + let (a, acc) = self#open_description a acc in + ((Psig_open a), acc) + | Psig_include a -> + let (a, acc) = self#include_description a acc in + ((Psig_include a), acc) + | Psig_class a -> + let (a, acc) = self#list self#class_description a acc in + ((Psig_class a), acc) + | Psig_class_type a -> + let (a, acc) = self#list self#class_type_declaration a acc in + ((Psig_class_type a), acc) + | Psig_attribute a -> + let (a, acc) = self#attribute a acc in + ((Psig_attribute a), acc) + | Psig_extension (a, b) -> + let (a, acc) = self#extension a acc in + let (b, acc) = self#attributes b acc in + ((Psig_extension (a, b)), acc) method module_declaration : module_declaration -> 'acc -> (module_declaration * 'acc)= - fun { pmd_name; pmd_type; pmd_attributes; pmd_loc } -> - fun acc -> - let (pmd_name,acc) = self#loc self#string pmd_name acc in - let (pmd_type,acc) = self#module_type pmd_type acc in - let (pmd_attributes,acc) = self#attributes pmd_attributes acc in - let (pmd_loc,acc) = self#location pmd_loc acc in - ({ pmd_name; pmd_type; pmd_attributes; pmd_loc }, acc) + fun { pmd_name; pmd_type; pmd_attributes; pmd_loc } -> + fun acc -> + let (pmd_name, acc) = self#loc self#string pmd_name acc in + let (pmd_type, acc) = self#module_type pmd_type acc in + let (pmd_attributes, acc) = self#attributes pmd_attributes acc in + let (pmd_loc, acc) = self#location pmd_loc acc in + ({ pmd_name; pmd_type; pmd_attributes; pmd_loc }, acc) + method module_substitution : + module_substitution -> 'acc -> (module_substitution * 'acc)= + fun { pms_name; pms_manifest; pms_attributes; pms_loc } -> + fun acc -> + let (pms_name, acc) = self#loc self#string pms_name acc in + let (pms_manifest, acc) = self#longident_loc pms_manifest acc in + let (pms_attributes, acc) = self#attributes pms_attributes acc in + let (pms_loc, acc) = self#location pms_loc acc in + ({ pms_name; pms_manifest; pms_attributes; pms_loc }, acc) method module_type_declaration : module_type_declaration -> 'acc -> (module_type_declaration * 'acc)= - fun { pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc } -> - fun acc -> - let (pmtd_name,acc) = self#loc self#string pmtd_name acc in - let (pmtd_type,acc) = self#option self#module_type pmtd_type acc - in - let (pmtd_attributes,acc) = self#attributes pmtd_attributes acc in - let (pmtd_loc,acc) = self#location pmtd_loc acc in - ({ pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc }, acc) + fun { pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc } -> + fun acc -> + let (pmtd_name, acc) = self#loc self#string pmtd_name acc in + let (pmtd_type, acc) = self#option self#module_type pmtd_type acc in + let (pmtd_attributes, acc) = self#attributes pmtd_attributes acc in + let (pmtd_loc, acc) = self#location pmtd_loc acc in + ({ pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc }, acc) + method open_infos : + 'a . + ('a -> 'acc -> ('a * 'acc)) -> + 'a open_infos -> 'acc -> ('a open_infos * 'acc)= + fun _a -> + fun { popen_expr; popen_override; popen_loc; popen_attributes } -> + fun acc -> + let (popen_expr, acc) = _a popen_expr acc in + let (popen_override, acc) = self#override_flag popen_override acc in + let (popen_loc, acc) = self#location popen_loc acc in + let (popen_attributes, acc) = + self#attributes popen_attributes acc in + ({ popen_expr; popen_override; popen_loc; popen_attributes }, + acc) method open_description : open_description -> 'acc -> (open_description * 'acc)= - fun { popen_lid; popen_override; popen_loc; popen_attributes } -> - fun acc -> - let (popen_lid,acc) = self#longident_loc popen_lid acc in - let (popen_override,acc) = self#override_flag popen_override acc - in - let (popen_loc,acc) = self#location popen_loc acc in - let (popen_attributes,acc) = self#attributes popen_attributes acc - in - ({ popen_lid; popen_override; popen_loc; popen_attributes }, acc) + self#open_infos self#longident_loc + method open_declaration : + open_declaration -> 'acc -> (open_declaration * 'acc)= + self#open_infos self#module_expr method include_infos : 'a . - ('a -> 'acc -> ('a * 'acc)) -> - 'a include_infos -> 'acc -> ('a include_infos * 'acc)= - fun _a -> - fun { pincl_mod; pincl_loc; pincl_attributes } -> - fun acc -> - let (pincl_mod,acc) = _a pincl_mod acc in - let (pincl_loc,acc) = self#location pincl_loc acc in - let (pincl_attributes,acc) = self#attributes pincl_attributes acc - in - ({ pincl_mod; pincl_loc; pincl_attributes }, acc) + ('a -> 'acc -> ('a * 'acc)) -> + 'a include_infos -> 'acc -> ('a include_infos * 'acc)= + fun _a -> + fun { pincl_mod; pincl_loc; pincl_attributes } -> + fun acc -> + let (pincl_mod, acc) = _a pincl_mod acc in + let (pincl_loc, acc) = self#location pincl_loc acc in + let (pincl_attributes, acc) = + self#attributes pincl_attributes acc in + ({ pincl_mod; pincl_loc; pincl_attributes }, acc) method include_description : include_description -> 'acc -> (include_description * 'acc)= self#include_infos self#module_type @@ -4141,168 +4402,182 @@ class virtual ['acc] fold_map = self#include_infos self#module_expr method with_constraint : with_constraint -> 'acc -> (with_constraint * 'acc)= - fun x -> - fun acc -> - match x with - | Pwith_type (a,b) -> - let (a,acc) = self#longident_loc a acc in - let (b,acc) = self#type_declaration b acc in - ((Pwith_type (a, b)), acc) - | Pwith_module (a,b) -> - let (a,acc) = self#longident_loc a acc in - let (b,acc) = self#longident_loc b acc in - ((Pwith_module (a, b)), acc) - | Pwith_typesubst (a,b) -> - let (a,acc) = self#longident_loc a acc in - let (b,acc) = self#type_declaration b acc in - ((Pwith_typesubst (a, b)), acc) - | Pwith_modsubst (a,b) -> - let (a,acc) = self#longident_loc a acc in - let (b,acc) = self#longident_loc b acc in - ((Pwith_modsubst (a, b)), acc) + fun x -> + fun acc -> + match x with + | Pwith_type (a, b) -> + let (a, acc) = self#longident_loc a acc in + let (b, acc) = self#type_declaration b acc in + ((Pwith_type (a, b)), acc) + | Pwith_module (a, b) -> + let (a, acc) = self#longident_loc a acc in + let (b, acc) = self#longident_loc b acc in + ((Pwith_module (a, b)), acc) + | Pwith_typesubst (a, b) -> + let (a, acc) = self#longident_loc a acc in + let (b, acc) = self#type_declaration b acc in + ((Pwith_typesubst (a, b)), acc) + | Pwith_modsubst (a, b) -> + let (a, acc) = self#longident_loc a acc in + let (b, acc) = self#longident_loc b acc in + ((Pwith_modsubst (a, b)), acc) method module_expr : module_expr -> 'acc -> (module_expr * 'acc)= - fun { pmod_desc; pmod_loc; pmod_attributes } -> - fun acc -> - let (pmod_desc,acc) = self#module_expr_desc pmod_desc acc in - let (pmod_loc,acc) = self#location pmod_loc acc in - let (pmod_attributes,acc) = self#attributes pmod_attributes acc in - ({ pmod_desc; pmod_loc; pmod_attributes }, acc) + fun { pmod_desc; pmod_loc; pmod_attributes } -> + fun acc -> + let (pmod_desc, acc) = self#module_expr_desc pmod_desc acc in + let (pmod_loc, acc) = self#location pmod_loc acc in + let (pmod_attributes, acc) = self#attributes pmod_attributes acc in + ({ pmod_desc; pmod_loc; pmod_attributes }, acc) method module_expr_desc : module_expr_desc -> 'acc -> (module_expr_desc * 'acc)= - fun x -> - fun acc -> - match x with - | Pmod_ident a -> - let (a,acc) = self#longident_loc a acc in - ((Pmod_ident a), acc) - | Pmod_structure a -> - let (a,acc) = self#structure a acc in - ((Pmod_structure a), acc) - | Pmod_functor (a,b,c) -> - let (a,acc) = self#loc self#string a acc in - let (b,acc) = self#option self#module_type b acc in - let (c,acc) = self#module_expr c acc in - ((Pmod_functor (a, b, c)), acc) - | Pmod_apply (a,b) -> - let (a,acc) = self#module_expr a acc in - let (b,acc) = self#module_expr b acc in - ((Pmod_apply (a, b)), acc) - | Pmod_constraint (a,b) -> - let (a,acc) = self#module_expr a acc in - let (b,acc) = self#module_type b acc in - ((Pmod_constraint (a, b)), acc) - | Pmod_unpack a -> - let (a,acc) = self#expression a acc in ((Pmod_unpack a), acc) - | Pmod_extension a -> - let (a,acc) = self#extension a acc in - ((Pmod_extension a), acc) + fun x -> + fun acc -> + match x with + | Pmod_ident a -> + let (a, acc) = self#longident_loc a acc in + ((Pmod_ident a), acc) + | Pmod_structure a -> + let (a, acc) = self#structure a acc in + ((Pmod_structure a), acc) + | Pmod_functor (a, b, c) -> + let (a, acc) = self#loc self#string a acc in + let (b, acc) = self#option self#module_type b acc in + let (c, acc) = self#module_expr c acc in + ((Pmod_functor (a, b, c)), acc) + | Pmod_apply (a, b) -> + let (a, acc) = self#module_expr a acc in + let (b, acc) = self#module_expr b acc in + ((Pmod_apply (a, b)), acc) + | Pmod_constraint (a, b) -> + let (a, acc) = self#module_expr a acc in + let (b, acc) = self#module_type b acc in + ((Pmod_constraint (a, b)), acc) + | Pmod_unpack a -> + let (a, acc) = self#expression a acc in ((Pmod_unpack a), acc) + | Pmod_extension a -> + let (a, acc) = self#extension a acc in + ((Pmod_extension a), acc) method structure : structure -> 'acc -> (structure * 'acc)= self#list self#structure_item method structure_item : structure_item -> 'acc -> (structure_item * 'acc)= - fun { pstr_desc; pstr_loc } -> - fun acc -> - let (pstr_desc,acc) = self#structure_item_desc pstr_desc acc in - let (pstr_loc,acc) = self#location pstr_loc acc in - ({ pstr_desc; pstr_loc }, acc) + fun { pstr_desc; pstr_loc } -> + fun acc -> + let (pstr_desc, acc) = self#structure_item_desc pstr_desc acc in + let (pstr_loc, acc) = self#location pstr_loc acc in + ({ pstr_desc; pstr_loc }, acc) method structure_item_desc : structure_item_desc -> 'acc -> (structure_item_desc * 'acc)= - fun x -> - fun acc -> - match x with - | Pstr_eval (a,b) -> - let (a,acc) = self#expression a acc in - let (b,acc) = self#attributes b acc in - ((Pstr_eval (a, b)), acc) - | Pstr_value (a,b) -> - let (a,acc) = self#rec_flag a acc in - let (b,acc) = self#list self#value_binding b acc in - ((Pstr_value (a, b)), acc) - | Pstr_primitive a -> - let (a,acc) = self#value_description a acc in - ((Pstr_primitive a), acc) - | Pstr_type (a,b) -> - let (a,acc) = self#rec_flag a acc in - let (b,acc) = self#list self#type_declaration b acc in - ((Pstr_type (a, b)), acc) - | Pstr_typext a -> - let (a,acc) = self#type_extension a acc in - ((Pstr_typext a), acc) - | Pstr_exception a -> - let (a,acc) = self#extension_constructor a acc in - ((Pstr_exception a), acc) - | Pstr_module a -> - let (a,acc) = self#module_binding a acc in - ((Pstr_module a), acc) - | Pstr_recmodule a -> - let (a,acc) = self#list self#module_binding a acc in - ((Pstr_recmodule a), acc) - | Pstr_modtype a -> - let (a,acc) = self#module_type_declaration a acc in - ((Pstr_modtype a), acc) - | Pstr_open a -> - let (a,acc) = self#open_description a acc in - ((Pstr_open a), acc) - | Pstr_class a -> - let (a,acc) = self#list self#class_declaration a acc in - ((Pstr_class a), acc) - | Pstr_class_type a -> - let (a,acc) = self#list self#class_type_declaration a acc in - ((Pstr_class_type a), acc) - | Pstr_include a -> - let (a,acc) = self#include_declaration a acc in - ((Pstr_include a), acc) - | Pstr_attribute a -> - let (a,acc) = self#attribute a acc in - ((Pstr_attribute a), acc) - | Pstr_extension (a,b) -> - let (a,acc) = self#extension a acc in - let (b,acc) = self#attributes b acc in - ((Pstr_extension (a, b)), acc) + fun x -> + fun acc -> + match x with + | Pstr_eval (a, b) -> + let (a, acc) = self#expression a acc in + let (b, acc) = self#attributes b acc in + ((Pstr_eval (a, b)), acc) + | Pstr_value (a, b) -> + let (a, acc) = self#rec_flag a acc in + let (b, acc) = self#list self#value_binding b acc in + ((Pstr_value (a, b)), acc) + | Pstr_primitive a -> + let (a, acc) = self#value_description a acc in + ((Pstr_primitive a), acc) + | Pstr_type (a, b) -> + let (a, acc) = self#rec_flag a acc in + let (b, acc) = self#list self#type_declaration b acc in + ((Pstr_type (a, b)), acc) + | Pstr_typext a -> + let (a, acc) = self#type_extension a acc in + ((Pstr_typext a), acc) + | Pstr_exception a -> + let (a, acc) = self#type_exception a acc in + ((Pstr_exception a), acc) + | Pstr_module a -> + let (a, acc) = self#module_binding a acc in + ((Pstr_module a), acc) + | Pstr_recmodule a -> + let (a, acc) = self#list self#module_binding a acc in + ((Pstr_recmodule a), acc) + | Pstr_modtype a -> + let (a, acc) = self#module_type_declaration a acc in + ((Pstr_modtype a), acc) + | Pstr_open a -> + let (a, acc) = self#open_declaration a acc in + ((Pstr_open a), acc) + | Pstr_class a -> + let (a, acc) = self#list self#class_declaration a acc in + ((Pstr_class a), acc) + | Pstr_class_type a -> + let (a, acc) = self#list self#class_type_declaration a acc in + ((Pstr_class_type a), acc) + | Pstr_include a -> + let (a, acc) = self#include_declaration a acc in + ((Pstr_include a), acc) + | Pstr_attribute a -> + let (a, acc) = self#attribute a acc in + ((Pstr_attribute a), acc) + | Pstr_extension (a, b) -> + let (a, acc) = self#extension a acc in + let (b, acc) = self#attributes b acc in + ((Pstr_extension (a, b)), acc) method value_binding : value_binding -> 'acc -> (value_binding * 'acc)= - fun { pvb_pat; pvb_expr; pvb_attributes; pvb_loc } -> - fun acc -> - let (pvb_pat,acc) = self#pattern pvb_pat acc in - let (pvb_expr,acc) = self#expression pvb_expr acc in - let (pvb_attributes,acc) = self#attributes pvb_attributes acc in - let (pvb_loc,acc) = self#location pvb_loc acc in - ({ pvb_pat; pvb_expr; pvb_attributes; pvb_loc }, acc) + fun { pvb_pat; pvb_expr; pvb_attributes; pvb_loc } -> + fun acc -> + let (pvb_pat, acc) = self#pattern pvb_pat acc in + let (pvb_expr, acc) = self#expression pvb_expr acc in + let (pvb_attributes, acc) = self#attributes pvb_attributes acc in + let (pvb_loc, acc) = self#location pvb_loc acc in + ({ pvb_pat; pvb_expr; pvb_attributes; pvb_loc }, acc) method module_binding : module_binding -> 'acc -> (module_binding * 'acc)= - fun { pmb_name; pmb_expr; pmb_attributes; pmb_loc } -> - fun acc -> - let (pmb_name,acc) = self#loc self#string pmb_name acc in - let (pmb_expr,acc) = self#module_expr pmb_expr acc in - let (pmb_attributes,acc) = self#attributes pmb_attributes acc in - let (pmb_loc,acc) = self#location pmb_loc acc in - ({ pmb_name; pmb_expr; pmb_attributes; pmb_loc }, acc) + fun { pmb_name; pmb_expr; pmb_attributes; pmb_loc } -> + fun acc -> + let (pmb_name, acc) = self#loc self#string pmb_name acc in + let (pmb_expr, acc) = self#module_expr pmb_expr acc in + let (pmb_attributes, acc) = self#attributes pmb_attributes acc in + let (pmb_loc, acc) = self#location pmb_loc acc in + ({ pmb_name; pmb_expr; pmb_attributes; pmb_loc }, acc) method toplevel_phrase : toplevel_phrase -> 'acc -> (toplevel_phrase * 'acc)= - fun x -> - fun acc -> - match x with - | Ptop_def a -> - let (a,acc) = self#structure a acc in ((Ptop_def a), acc) - | Ptop_dir (a,b) -> - let (a,acc) = self#string a acc in - let (b,acc) = self#directive_argument b acc in - ((Ptop_dir (a, b)), acc) + fun x -> + fun acc -> + match x with + | Ptop_def a -> + let (a, acc) = self#structure a acc in ((Ptop_def a), acc) + | Ptop_dir a -> + let (a, acc) = self#toplevel_directive a acc in + ((Ptop_dir a), acc) + method toplevel_directive : + toplevel_directive -> 'acc -> (toplevel_directive * 'acc)= + fun { pdir_name; pdir_arg; pdir_loc } -> + fun acc -> + let (pdir_name, acc) = self#loc self#string pdir_name acc in + let (pdir_arg, acc) = + self#option self#directive_argument pdir_arg acc in + let (pdir_loc, acc) = self#location pdir_loc acc in + ({ pdir_name; pdir_arg; pdir_loc }, acc) method directive_argument : directive_argument -> 'acc -> (directive_argument * 'acc)= - fun x -> - fun acc -> - match x with - | Pdir_none -> (Pdir_none, acc) - | Pdir_string a -> - let (a,acc) = self#string a acc in ((Pdir_string a), acc) - | Pdir_int (a,b) -> - let (a,acc) = self#string a acc in - let (b,acc) = self#option self#char b acc in - ((Pdir_int (a, b)), acc) - | Pdir_ident a -> - let (a,acc) = self#longident a acc in ((Pdir_ident a), acc) - | Pdir_bool a -> - let (a,acc) = self#bool a acc in ((Pdir_bool a), acc) + fun { pdira_desc; pdira_loc } -> + fun acc -> + let (pdira_desc, acc) = self#directive_argument_desc pdira_desc acc in + let (pdira_loc, acc) = self#location pdira_loc acc in + ({ pdira_desc; pdira_loc }, acc) + method directive_argument_desc : + directive_argument_desc -> 'acc -> (directive_argument_desc * 'acc)= + fun x -> + fun acc -> + match x with + | Pdir_string a -> + let (a, acc) = self#string a acc in ((Pdir_string a), acc) + | Pdir_int (a, b) -> + let (a, acc) = self#string a acc in + let (b, acc) = self#option self#char b acc in + ((Pdir_int (a, b)), acc) + | Pdir_ident a -> + let (a, acc) = self#longident a acc in ((Pdir_ident a), acc) + | Pdir_bool a -> + let (a, acc) = self#bool a acc in ((Pdir_bool a), acc) end class virtual ['ctx] map_with_context = object (self) @@ -4315,410 +4590,431 @@ class virtual ['ctx] map_with_context = 'a . ('ctx -> 'a -> 'a) -> 'ctx -> 'a option -> 'a option method virtual string : 'ctx -> string -> string method position : 'ctx -> position -> position= - fun ctx -> - fun { pos_fname; pos_lnum; pos_bol; pos_cnum } -> - let pos_fname = self#string ctx pos_fname in - let pos_lnum = self#int ctx pos_lnum in - let pos_bol = self#int ctx pos_bol in - let pos_cnum = self#int ctx pos_cnum in - { pos_fname; pos_lnum; pos_bol; pos_cnum } + fun ctx -> + fun { pos_fname; pos_lnum; pos_bol; pos_cnum } -> + let pos_fname = self#string ctx pos_fname in + let pos_lnum = self#int ctx pos_lnum in + let pos_bol = self#int ctx pos_bol in + let pos_cnum = self#int ctx pos_cnum in + { pos_fname; pos_lnum; pos_bol; pos_cnum } method location : 'ctx -> location -> location= - fun ctx -> - fun { loc_start; loc_end; loc_ghost } -> - let loc_start = self#position ctx loc_start in - let loc_end = self#position ctx loc_end in - let loc_ghost = self#bool ctx loc_ghost in - { loc_start; loc_end; loc_ghost } + fun ctx -> + fun { loc_start; loc_end; loc_ghost } -> + let loc_start = self#position ctx loc_start in + let loc_end = self#position ctx loc_end in + let loc_ghost = self#bool ctx loc_ghost in + { loc_start; loc_end; loc_ghost } + method location_stack : 'ctx -> location_stack -> location_stack= + self#list self#location method loc : 'a . ('ctx -> 'a -> 'a) -> 'ctx -> 'a loc -> 'a loc= - fun _a -> - fun ctx -> - fun { txt; loc } -> - let txt = _a ctx txt in - let loc = self#location ctx loc in { txt; loc } + fun _a -> + fun ctx -> + fun { txt; loc } -> + let txt = _a ctx txt in + let loc = self#location ctx loc in { txt; loc } method longident : 'ctx -> longident -> longident= - fun ctx -> - fun x -> - match x with - | Lident a -> let a = self#string ctx a in Lident a - | Ldot (a,b) -> - let a = self#longident ctx a in - let b = self#string ctx b in Ldot (a, b) - | Lapply (a,b) -> - let a = self#longident ctx a in - let b = self#longident ctx b in Lapply (a, b) + fun ctx -> + fun x -> + match x with + | Lident a -> let a = self#string ctx a in Lident a + | Ldot (a, b) -> + let a = self#longident ctx a in + let b = self#string ctx b in Ldot (a, b) + | Lapply (a, b) -> + let a = self#longident ctx a in + let b = self#longident ctx b in Lapply (a, b) method longident_loc : 'ctx -> longident_loc -> longident_loc= self#loc self#longident - method rec_flag : 'ctx -> rec_flag -> rec_flag= fun _ctx -> fun x -> x + method rec_flag : 'ctx -> rec_flag -> rec_flag= fun _ctx -> fun x -> x method direction_flag : 'ctx -> direction_flag -> direction_flag= - fun _ctx -> fun x -> x + fun _ctx -> fun x -> x method private_flag : 'ctx -> private_flag -> private_flag= - fun _ctx -> fun x -> x + fun _ctx -> fun x -> x method mutable_flag : 'ctx -> mutable_flag -> mutable_flag= - fun _ctx -> fun x -> x + fun _ctx -> fun x -> x method virtual_flag : 'ctx -> virtual_flag -> virtual_flag= - fun _ctx -> fun x -> x + fun _ctx -> fun x -> x method override_flag : 'ctx -> override_flag -> override_flag= - fun _ctx -> fun x -> x + fun _ctx -> fun x -> x method closed_flag : 'ctx -> closed_flag -> closed_flag= - fun _ctx -> fun x -> x + fun _ctx -> fun x -> x method label : 'ctx -> label -> label= self#string method arg_label : 'ctx -> arg_label -> arg_label= - fun ctx -> - fun x -> - match x with - | Nolabel -> Nolabel - | Labelled a -> let a = self#string ctx a in Labelled a - | Optional a -> let a = self#string ctx a in Optional a - method variance : 'ctx -> variance -> variance= fun _ctx -> fun x -> x + fun ctx -> + fun x -> + match x with + | Nolabel -> Nolabel + | Labelled a -> let a = self#string ctx a in Labelled a + | Optional a -> let a = self#string ctx a in Optional a + method variance : 'ctx -> variance -> variance= fun _ctx -> fun x -> x method constant : 'ctx -> constant -> constant= - fun ctx -> - fun x -> - match x with - | Pconst_integer (a,b) -> - let a = self#string ctx a in - let b = self#option self#char ctx b in Pconst_integer (a, b) - | Pconst_char a -> let a = self#char ctx a in Pconst_char a - | Pconst_string (a,b) -> - let a = self#string ctx a in - let b = self#option self#string ctx b in Pconst_string (a, b) - | Pconst_float (a,b) -> - let a = self#string ctx a in - let b = self#option self#char ctx b in Pconst_float (a, b) + fun ctx -> + fun x -> + match x with + | Pconst_integer (a, b) -> + let a = self#string ctx a in + let b = self#option self#char ctx b in Pconst_integer (a, b) + | Pconst_char a -> let a = self#char ctx a in Pconst_char a + | Pconst_string (a, b) -> + let a = self#string ctx a in + let b = self#option self#string ctx b in Pconst_string (a, b) + | Pconst_float (a, b) -> + let a = self#string ctx a in + let b = self#option self#char ctx b in Pconst_float (a, b) method attribute : 'ctx -> attribute -> attribute= - fun ctx -> - fun (a,b) -> - let a = self#loc self#string ctx a in - let b = self#payload ctx b in (a, b) + fun ctx -> + fun { attr_name; attr_payload; attr_loc } -> + let attr_name = self#loc self#string ctx attr_name in + let attr_payload = self#payload ctx attr_payload in + let attr_loc = self#location ctx attr_loc in + { attr_name; attr_payload; attr_loc } method extension : 'ctx -> extension -> extension= - fun ctx -> - fun (a,b) -> - let a = self#loc self#string ctx a in - let b = self#payload ctx b in (a, b) + fun ctx -> + fun (a, b) -> + let a = self#loc self#string ctx a in + let b = self#payload ctx b in (a, b) method attributes : 'ctx -> attributes -> attributes= self#list self#attribute method payload : 'ctx -> payload -> payload= - fun ctx -> - fun x -> - match x with - | PStr a -> let a = self#structure ctx a in PStr a - | PSig a -> let a = self#signature ctx a in PSig a - | PTyp a -> let a = self#core_type ctx a in PTyp a - | PPat (a,b) -> - let a = self#pattern ctx a in - let b = self#option self#expression ctx b in PPat (a, b) + fun ctx -> + fun x -> + match x with + | PStr a -> let a = self#structure ctx a in PStr a + | PSig a -> let a = self#signature ctx a in PSig a + | PTyp a -> let a = self#core_type ctx a in PTyp a + | PPat (a, b) -> + let a = self#pattern ctx a in + let b = self#option self#expression ctx b in PPat (a, b) method core_type : 'ctx -> core_type -> core_type= - fun ctx -> - fun { ptyp_desc; ptyp_loc; ptyp_attributes } -> - let ptyp_desc = self#core_type_desc ctx ptyp_desc in - let ptyp_loc = self#location ctx ptyp_loc in - let ptyp_attributes = self#attributes ctx ptyp_attributes in - { ptyp_desc; ptyp_loc; ptyp_attributes } + fun ctx -> + fun { ptyp_desc; ptyp_loc; ptyp_loc_stack; ptyp_attributes } -> + let ptyp_desc = self#core_type_desc ctx ptyp_desc in + let ptyp_loc = self#location ctx ptyp_loc in + let ptyp_loc_stack = self#location_stack ctx ptyp_loc_stack in + let ptyp_attributes = self#attributes ctx ptyp_attributes in + { ptyp_desc; ptyp_loc; ptyp_loc_stack; ptyp_attributes } method core_type_desc : 'ctx -> core_type_desc -> core_type_desc= - fun ctx -> - fun x -> - match x with - | Ptyp_any -> Ptyp_any - | Ptyp_var a -> let a = self#string ctx a in Ptyp_var a - | Ptyp_arrow (a,b,c) -> - let a = self#arg_label ctx a in - let b = self#core_type ctx b in - let c = self#core_type ctx c in Ptyp_arrow (a, b, c) - | Ptyp_tuple a -> - let a = self#list self#core_type ctx a in Ptyp_tuple a - | Ptyp_constr (a,b) -> - let a = self#longident_loc ctx a in - let b = self#list self#core_type ctx b in Ptyp_constr (a, b) - | Ptyp_object (a,b) -> - let a = self#list self#object_field ctx a in - let b = self#closed_flag ctx b in Ptyp_object (a, b) - | Ptyp_class (a,b) -> - let a = self#longident_loc ctx a in - let b = self#list self#core_type ctx b in Ptyp_class (a, b) - | Ptyp_alias (a,b) -> - let a = self#core_type ctx a in - let b = self#string ctx b in Ptyp_alias (a, b) - | Ptyp_variant (a,b,c) -> - let a = self#list self#row_field ctx a in - let b = self#closed_flag ctx b in - let c = self#option (self#list self#label) ctx c in - Ptyp_variant (a, b, c) - | Ptyp_poly (a,b) -> - let a = self#list (self#loc self#string) ctx a in - let b = self#core_type ctx b in Ptyp_poly (a, b) - | Ptyp_package a -> - let a = self#package_type ctx a in Ptyp_package a - | Ptyp_extension a -> - let a = self#extension ctx a in Ptyp_extension a + fun ctx -> + fun x -> + match x with + | Ptyp_any -> Ptyp_any + | Ptyp_var a -> let a = self#string ctx a in Ptyp_var a + | Ptyp_arrow (a, b, c) -> + let a = self#arg_label ctx a in + let b = self#core_type ctx b in + let c = self#core_type ctx c in Ptyp_arrow (a, b, c) + | Ptyp_tuple a -> + let a = self#list self#core_type ctx a in Ptyp_tuple a + | Ptyp_constr (a, b) -> + let a = self#longident_loc ctx a in + let b = self#list self#core_type ctx b in Ptyp_constr (a, b) + | Ptyp_object (a, b) -> + let a = self#list self#object_field ctx a in + let b = self#closed_flag ctx b in Ptyp_object (a, b) + | Ptyp_class (a, b) -> + let a = self#longident_loc ctx a in + let b = self#list self#core_type ctx b in Ptyp_class (a, b) + | Ptyp_alias (a, b) -> + let a = self#core_type ctx a in + let b = self#string ctx b in Ptyp_alias (a, b) + | Ptyp_variant (a, b, c) -> + let a = self#list self#row_field ctx a in + let b = self#closed_flag ctx b in + let c = self#option (self#list self#label) ctx c in + Ptyp_variant (a, b, c) + | Ptyp_poly (a, b) -> + let a = self#list (self#loc self#string) ctx a in + let b = self#core_type ctx b in Ptyp_poly (a, b) + | Ptyp_package a -> + let a = self#package_type ctx a in Ptyp_package a + | Ptyp_extension a -> + let a = self#extension ctx a in Ptyp_extension a method package_type : 'ctx -> package_type -> package_type= - fun ctx -> - fun (a,b) -> - let a = self#longident_loc ctx a in - let b = - self#list - (fun ctx -> - fun (a,b) -> - let a = self#longident_loc ctx a in - let b = self#core_type ctx b in (a, b)) ctx b - in - (a, b) + fun ctx -> + fun (a, b) -> + let a = self#longident_loc ctx a in + let b = + self#list + (fun ctx -> + fun (a, b) -> + let a = self#longident_loc ctx a in + let b = self#core_type ctx b in (a, b)) ctx b in + (a, b) method row_field : 'ctx -> row_field -> row_field= - fun ctx -> - fun x -> - match x with - | Rtag (a,b,c,d) -> - let a = self#loc self#label ctx a in - let b = self#attributes ctx b in - let c = self#bool ctx c in - let d = self#list self#core_type ctx d in Rtag (a, b, c, d) - | Rinherit a -> let a = self#core_type ctx a in Rinherit a + fun ctx -> + fun { prf_desc; prf_loc; prf_attributes } -> + let prf_desc = self#row_field_desc ctx prf_desc in + let prf_loc = self#location ctx prf_loc in + let prf_attributes = self#attributes ctx prf_attributes in + { prf_desc; prf_loc; prf_attributes } + method row_field_desc : 'ctx -> row_field_desc -> row_field_desc= + fun ctx -> + fun x -> + match x with + | Rtag (a, b, c) -> + let a = self#loc self#label ctx a in + let b = self#bool ctx b in + let c = self#list self#core_type ctx c in Rtag (a, b, c) + | Rinherit a -> let a = self#core_type ctx a in Rinherit a method object_field : 'ctx -> object_field -> object_field= - fun ctx -> - fun x -> - match x with - | Otag (a,b,c) -> - let a = self#loc self#label ctx a in - let b = self#attributes ctx b in - let c = self#core_type ctx c in Otag (a, b, c) - | Oinherit a -> let a = self#core_type ctx a in Oinherit a + fun ctx -> + fun { pof_desc; pof_loc; pof_attributes } -> + let pof_desc = self#object_field_desc ctx pof_desc in + let pof_loc = self#location ctx pof_loc in + let pof_attributes = self#attributes ctx pof_attributes in + { pof_desc; pof_loc; pof_attributes } + method object_field_desc : + 'ctx -> object_field_desc -> object_field_desc= + fun ctx -> + fun x -> + match x with + | Otag (a, b) -> + let a = self#loc self#label ctx a in + let b = self#core_type ctx b in Otag (a, b) + | Oinherit a -> let a = self#core_type ctx a in Oinherit a method pattern : 'ctx -> pattern -> pattern= - fun ctx -> - fun { ppat_desc; ppat_loc; ppat_attributes } -> - let ppat_desc = self#pattern_desc ctx ppat_desc in - let ppat_loc = self#location ctx ppat_loc in - let ppat_attributes = self#attributes ctx ppat_attributes in - { ppat_desc; ppat_loc; ppat_attributes } + fun ctx -> + fun { ppat_desc; ppat_loc; ppat_loc_stack; ppat_attributes } -> + let ppat_desc = self#pattern_desc ctx ppat_desc in + let ppat_loc = self#location ctx ppat_loc in + let ppat_loc_stack = self#location_stack ctx ppat_loc_stack in + let ppat_attributes = self#attributes ctx ppat_attributes in + { ppat_desc; ppat_loc; ppat_loc_stack; ppat_attributes } method pattern_desc : 'ctx -> pattern_desc -> pattern_desc= - fun ctx -> - fun x -> - match x with - | Ppat_any -> Ppat_any - | Ppat_var a -> let a = self#loc self#string ctx a in Ppat_var a - | Ppat_alias (a,b) -> - let a = self#pattern ctx a in - let b = self#loc self#string ctx b in Ppat_alias (a, b) - | Ppat_constant a -> - let a = self#constant ctx a in Ppat_constant a - | Ppat_interval (a,b) -> - let a = self#constant ctx a in - let b = self#constant ctx b in Ppat_interval (a, b) - | Ppat_tuple a -> - let a = self#list self#pattern ctx a in Ppat_tuple a - | Ppat_construct (a,b) -> - let a = self#longident_loc ctx a in - let b = self#option self#pattern ctx b in - Ppat_construct (a, b) - | Ppat_variant (a,b) -> - let a = self#label ctx a in - let b = self#option self#pattern ctx b in Ppat_variant (a, b) - | Ppat_record (a,b) -> - let a = - self#list - (fun ctx -> - fun (a,b) -> - let a = self#longident_loc ctx a in - let b = self#pattern ctx b in (a, b)) ctx a - in - let b = self#closed_flag ctx b in Ppat_record (a, b) - | Ppat_array a -> - let a = self#list self#pattern ctx a in Ppat_array a - | Ppat_or (a,b) -> - let a = self#pattern ctx a in - let b = self#pattern ctx b in Ppat_or (a, b) - | Ppat_constraint (a,b) -> - let a = self#pattern ctx a in - let b = self#core_type ctx b in Ppat_constraint (a, b) - | Ppat_type a -> let a = self#longident_loc ctx a in Ppat_type a - | Ppat_lazy a -> let a = self#pattern ctx a in Ppat_lazy a - | Ppat_unpack a -> - let a = self#loc self#string ctx a in Ppat_unpack a - | Ppat_exception a -> - let a = self#pattern ctx a in Ppat_exception a - | Ppat_extension a -> - let a = self#extension ctx a in Ppat_extension a - | Ppat_open (a,b) -> - let a = self#longident_loc ctx a in - let b = self#pattern ctx b in Ppat_open (a, b) + fun ctx -> + fun x -> + match x with + | Ppat_any -> Ppat_any + | Ppat_var a -> let a = self#loc self#string ctx a in Ppat_var a + | Ppat_alias (a, b) -> + let a = self#pattern ctx a in + let b = self#loc self#string ctx b in Ppat_alias (a, b) + | Ppat_constant a -> let a = self#constant ctx a in Ppat_constant a + | Ppat_interval (a, b) -> + let a = self#constant ctx a in + let b = self#constant ctx b in Ppat_interval (a, b) + | Ppat_tuple a -> + let a = self#list self#pattern ctx a in Ppat_tuple a + | Ppat_construct (a, b) -> + let a = self#longident_loc ctx a in + let b = self#option self#pattern ctx b in Ppat_construct (a, b) + | Ppat_variant (a, b) -> + let a = self#label ctx a in + let b = self#option self#pattern ctx b in Ppat_variant (a, b) + | Ppat_record (a, b) -> + let a = + self#list + (fun ctx -> + fun (a, b) -> + let a = self#longident_loc ctx a in + let b = self#pattern ctx b in (a, b)) ctx a in + let b = self#closed_flag ctx b in Ppat_record (a, b) + | Ppat_array a -> + let a = self#list self#pattern ctx a in Ppat_array a + | Ppat_or (a, b) -> + let a = self#pattern ctx a in + let b = self#pattern ctx b in Ppat_or (a, b) + | Ppat_constraint (a, b) -> + let a = self#pattern ctx a in + let b = self#core_type ctx b in Ppat_constraint (a, b) + | Ppat_type a -> let a = self#longident_loc ctx a in Ppat_type a + | Ppat_lazy a -> let a = self#pattern ctx a in Ppat_lazy a + | Ppat_unpack a -> + let a = self#loc self#string ctx a in Ppat_unpack a + | Ppat_exception a -> + let a = self#pattern ctx a in Ppat_exception a + | Ppat_extension a -> + let a = self#extension ctx a in Ppat_extension a + | Ppat_open (a, b) -> + let a = self#longident_loc ctx a in + let b = self#pattern ctx b in Ppat_open (a, b) method expression : 'ctx -> expression -> expression= - fun ctx -> - fun { pexp_desc; pexp_loc; pexp_attributes } -> - let pexp_desc = self#expression_desc ctx pexp_desc in - let pexp_loc = self#location ctx pexp_loc in - let pexp_attributes = self#attributes ctx pexp_attributes in - { pexp_desc; pexp_loc; pexp_attributes } + fun ctx -> + fun { pexp_desc; pexp_loc; pexp_loc_stack; pexp_attributes } -> + let pexp_desc = self#expression_desc ctx pexp_desc in + let pexp_loc = self#location ctx pexp_loc in + let pexp_loc_stack = self#location_stack ctx pexp_loc_stack in + let pexp_attributes = self#attributes ctx pexp_attributes in + { pexp_desc; pexp_loc; pexp_loc_stack; pexp_attributes } method expression_desc : 'ctx -> expression_desc -> expression_desc= - fun ctx -> - fun x -> - match x with - | Pexp_ident a -> let a = self#longident_loc ctx a in Pexp_ident a - | Pexp_constant a -> - let a = self#constant ctx a in Pexp_constant a - | Pexp_let (a,b,c) -> - let a = self#rec_flag ctx a in - let b = self#list self#value_binding ctx b in - let c = self#expression ctx c in Pexp_let (a, b, c) - | Pexp_function a -> - let a = self#list self#case ctx a in Pexp_function a - | Pexp_fun (a,b,c,d) -> - let a = self#arg_label ctx a in - let b = self#option self#expression ctx b in - let c = self#pattern ctx c in - let d = self#expression ctx d in Pexp_fun (a, b, c, d) - | Pexp_apply (a,b) -> - let a = self#expression ctx a in - let b = - self#list - (fun ctx -> - fun (a,b) -> - let a = self#arg_label ctx a in - let b = self#expression ctx b in (a, b)) ctx b - in - Pexp_apply (a, b) - | Pexp_match (a,b) -> - let a = self#expression ctx a in - let b = self#list self#case ctx b in Pexp_match (a, b) - | Pexp_try (a,b) -> - let a = self#expression ctx a in - let b = self#list self#case ctx b in Pexp_try (a, b) - | Pexp_tuple a -> - let a = self#list self#expression ctx a in Pexp_tuple a - | Pexp_construct (a,b) -> - let a = self#longident_loc ctx a in - let b = self#option self#expression ctx b in - Pexp_construct (a, b) - | Pexp_variant (a,b) -> - let a = self#label ctx a in - let b = self#option self#expression ctx b in - Pexp_variant (a, b) - | Pexp_record (a,b) -> - let a = - self#list - (fun ctx -> - fun (a,b) -> - let a = self#longident_loc ctx a in - let b = self#expression ctx b in (a, b)) ctx a - in - let b = self#option self#expression ctx b in - Pexp_record (a, b) - | Pexp_field (a,b) -> - let a = self#expression ctx a in - let b = self#longident_loc ctx b in Pexp_field (a, b) - | Pexp_setfield (a,b,c) -> - let a = self#expression ctx a in - let b = self#longident_loc ctx b in - let c = self#expression ctx c in Pexp_setfield (a, b, c) - | Pexp_array a -> - let a = self#list self#expression ctx a in Pexp_array a - | Pexp_ifthenelse (a,b,c) -> - let a = self#expression ctx a in - let b = self#expression ctx b in - let c = self#option self#expression ctx c in - Pexp_ifthenelse (a, b, c) - | Pexp_sequence (a,b) -> - let a = self#expression ctx a in - let b = self#expression ctx b in Pexp_sequence (a, b) - | Pexp_while (a,b) -> - let a = self#expression ctx a in - let b = self#expression ctx b in Pexp_while (a, b) - | Pexp_for (a,b,c,d,e) -> - let a = self#pattern ctx a in - let b = self#expression ctx b in - let c = self#expression ctx c in - let d = self#direction_flag ctx d in - let e = self#expression ctx e in Pexp_for (a, b, c, d, e) - | Pexp_constraint (a,b) -> - let a = self#expression ctx a in - let b = self#core_type ctx b in Pexp_constraint (a, b) - | Pexp_coerce (a,b,c) -> - let a = self#expression ctx a in - let b = self#option self#core_type ctx b in - let c = self#core_type ctx c in Pexp_coerce (a, b, c) - | Pexp_send (a,b) -> - let a = self#expression ctx a in - let b = self#loc self#label ctx b in Pexp_send (a, b) - | Pexp_new a -> let a = self#longident_loc ctx a in Pexp_new a - | Pexp_setinstvar (a,b) -> - let a = self#loc self#label ctx a in - let b = self#expression ctx b in Pexp_setinstvar (a, b) - | Pexp_override a -> - let a = - self#list - (fun ctx -> - fun (a,b) -> - let a = self#loc self#label ctx a in - let b = self#expression ctx b in (a, b)) ctx a - in - Pexp_override a - | Pexp_letmodule (a,b,c) -> - let a = self#loc self#string ctx a in - let b = self#module_expr ctx b in - let c = self#expression ctx c in Pexp_letmodule (a, b, c) - | Pexp_letexception (a,b) -> - let a = self#extension_constructor ctx a in - let b = self#expression ctx b in Pexp_letexception (a, b) - | Pexp_assert a -> let a = self#expression ctx a in Pexp_assert a - | Pexp_lazy a -> let a = self#expression ctx a in Pexp_lazy a - | Pexp_poly (a,b) -> - let a = self#expression ctx a in - let b = self#option self#core_type ctx b in Pexp_poly (a, b) - | Pexp_object a -> - let a = self#class_structure ctx a in Pexp_object a - | Pexp_newtype (a,b) -> - let a = self#loc self#string ctx a in - let b = self#expression ctx b in Pexp_newtype (a, b) - | Pexp_pack a -> let a = self#module_expr ctx a in Pexp_pack a - | Pexp_open (a,b,c) -> - let a = self#override_flag ctx a in - let b = self#longident_loc ctx b in - let c = self#expression ctx c in Pexp_open (a, b, c) - | Pexp_extension a -> - let a = self#extension ctx a in Pexp_extension a - | Pexp_unreachable -> Pexp_unreachable + fun ctx -> + fun x -> + match x with + | Pexp_ident a -> let a = self#longident_loc ctx a in Pexp_ident a + | Pexp_constant a -> let a = self#constant ctx a in Pexp_constant a + | Pexp_let (a, b, c) -> + let a = self#rec_flag ctx a in + let b = self#list self#value_binding ctx b in + let c = self#expression ctx c in Pexp_let (a, b, c) + | Pexp_function a -> + let a = self#list self#case ctx a in Pexp_function a + | Pexp_fun (a, b, c, d) -> + let a = self#arg_label ctx a in + let b = self#option self#expression ctx b in + let c = self#pattern ctx c in + let d = self#expression ctx d in Pexp_fun (a, b, c, d) + | Pexp_apply (a, b) -> + let a = self#expression ctx a in + let b = + self#list + (fun ctx -> + fun (a, b) -> + let a = self#arg_label ctx a in + let b = self#expression ctx b in (a, b)) ctx b in + Pexp_apply (a, b) + | Pexp_match (a, b) -> + let a = self#expression ctx a in + let b = self#list self#case ctx b in Pexp_match (a, b) + | Pexp_try (a, b) -> + let a = self#expression ctx a in + let b = self#list self#case ctx b in Pexp_try (a, b) + | Pexp_tuple a -> + let a = self#list self#expression ctx a in Pexp_tuple a + | Pexp_construct (a, b) -> + let a = self#longident_loc ctx a in + let b = self#option self#expression ctx b in + Pexp_construct (a, b) + | Pexp_variant (a, b) -> + let a = self#label ctx a in + let b = self#option self#expression ctx b in + Pexp_variant (a, b) + | Pexp_record (a, b) -> + let a = + self#list + (fun ctx -> + fun (a, b) -> + let a = self#longident_loc ctx a in + let b = self#expression ctx b in (a, b)) ctx a in + let b = self#option self#expression ctx b in Pexp_record (a, b) + | Pexp_field (a, b) -> + let a = self#expression ctx a in + let b = self#longident_loc ctx b in Pexp_field (a, b) + | Pexp_setfield (a, b, c) -> + let a = self#expression ctx a in + let b = self#longident_loc ctx b in + let c = self#expression ctx c in Pexp_setfield (a, b, c) + | Pexp_array a -> + let a = self#list self#expression ctx a in Pexp_array a + | Pexp_ifthenelse (a, b, c) -> + let a = self#expression ctx a in + let b = self#expression ctx b in + let c = self#option self#expression ctx c in + Pexp_ifthenelse (a, b, c) + | Pexp_sequence (a, b) -> + let a = self#expression ctx a in + let b = self#expression ctx b in Pexp_sequence (a, b) + | Pexp_while (a, b) -> + let a = self#expression ctx a in + let b = self#expression ctx b in Pexp_while (a, b) + | Pexp_for (a, b, c, d, e) -> + let a = self#pattern ctx a in + let b = self#expression ctx b in + let c = self#expression ctx c in + let d = self#direction_flag ctx d in + let e = self#expression ctx e in Pexp_for (a, b, c, d, e) + | Pexp_constraint (a, b) -> + let a = self#expression ctx a in + let b = self#core_type ctx b in Pexp_constraint (a, b) + | Pexp_coerce (a, b, c) -> + let a = self#expression ctx a in + let b = self#option self#core_type ctx b in + let c = self#core_type ctx c in Pexp_coerce (a, b, c) + | Pexp_send (a, b) -> + let a = self#expression ctx a in + let b = self#loc self#label ctx b in Pexp_send (a, b) + | Pexp_new a -> let a = self#longident_loc ctx a in Pexp_new a + | Pexp_setinstvar (a, b) -> + let a = self#loc self#label ctx a in + let b = self#expression ctx b in Pexp_setinstvar (a, b) + | Pexp_override a -> + let a = + self#list + (fun ctx -> + fun (a, b) -> + let a = self#loc self#label ctx a in + let b = self#expression ctx b in (a, b)) ctx a in + Pexp_override a + | Pexp_letmodule (a, b, c) -> + let a = self#loc self#string ctx a in + let b = self#module_expr ctx b in + let c = self#expression ctx c in Pexp_letmodule (a, b, c) + | Pexp_letexception (a, b) -> + let a = self#extension_constructor ctx a in + let b = self#expression ctx b in Pexp_letexception (a, b) + | Pexp_assert a -> let a = self#expression ctx a in Pexp_assert a + | Pexp_lazy a -> let a = self#expression ctx a in Pexp_lazy a + | Pexp_poly (a, b) -> + let a = self#expression ctx a in + let b = self#option self#core_type ctx b in Pexp_poly (a, b) + | Pexp_object a -> + let a = self#class_structure ctx a in Pexp_object a + | Pexp_newtype (a, b) -> + let a = self#loc self#string ctx a in + let b = self#expression ctx b in Pexp_newtype (a, b) + | Pexp_pack a -> let a = self#module_expr ctx a in Pexp_pack a + | Pexp_open (a, b) -> + let a = self#open_declaration ctx a in + let b = self#expression ctx b in Pexp_open (a, b) + | Pexp_letop a -> let a = self#letop ctx a in Pexp_letop a + | Pexp_extension a -> + let a = self#extension ctx a in Pexp_extension a + | Pexp_unreachable -> Pexp_unreachable method case : 'ctx -> case -> case= - fun ctx -> - fun { pc_lhs; pc_guard; pc_rhs } -> - let pc_lhs = self#pattern ctx pc_lhs in - let pc_guard = self#option self#expression ctx pc_guard in - let pc_rhs = self#expression ctx pc_rhs in - { pc_lhs; pc_guard; pc_rhs } + fun ctx -> + fun { pc_lhs; pc_guard; pc_rhs } -> + let pc_lhs = self#pattern ctx pc_lhs in + let pc_guard = self#option self#expression ctx pc_guard in + let pc_rhs = self#expression ctx pc_rhs in + { pc_lhs; pc_guard; pc_rhs } + method letop : 'ctx -> letop -> letop= + fun ctx -> + fun { let_; ands; body } -> + let let_ = self#binding_op ctx let_ in + let ands = self#list self#binding_op ctx ands in + let body = self#expression ctx body in { let_; ands; body } + method binding_op : 'ctx -> binding_op -> binding_op= + fun ctx -> + fun { pbop_op; pbop_pat; pbop_exp; pbop_loc } -> + let pbop_op = self#loc self#string ctx pbop_op in + let pbop_pat = self#pattern ctx pbop_pat in + let pbop_exp = self#expression ctx pbop_exp in + let pbop_loc = self#location ctx pbop_loc in + { pbop_op; pbop_pat; pbop_exp; pbop_loc } method value_description : 'ctx -> value_description -> value_description= - fun ctx -> - fun { pval_name; pval_type; pval_prim; pval_attributes; pval_loc } - -> - let pval_name = self#loc self#string ctx pval_name in - let pval_type = self#core_type ctx pval_type in - let pval_prim = self#list self#string ctx pval_prim in - let pval_attributes = self#attributes ctx pval_attributes in - let pval_loc = self#location ctx pval_loc in - { pval_name; pval_type; pval_prim; pval_attributes; pval_loc } + fun ctx -> + fun { pval_name; pval_type; pval_prim; pval_attributes; pval_loc } -> + let pval_name = self#loc self#string ctx pval_name in + let pval_type = self#core_type ctx pval_type in + let pval_prim = self#list self#string ctx pval_prim in + let pval_attributes = self#attributes ctx pval_attributes in + let pval_loc = self#location ctx pval_loc in + { pval_name; pval_type; pval_prim; pval_attributes; pval_loc } method type_declaration : 'ctx -> type_declaration -> type_declaration= - fun ctx -> - fun - { ptype_name; ptype_params; ptype_cstrs; ptype_kind; ptype_private; - ptype_manifest; ptype_attributes; ptype_loc } - -> - let ptype_name = self#loc self#string ctx ptype_name in + fun ctx -> + fun + { ptype_name; ptype_params; ptype_cstrs; ptype_kind; ptype_private; + ptype_manifest; ptype_attributes; ptype_loc } + -> + let ptype_name = self#loc self#string ctx ptype_name in let ptype_params = self#list - (fun ctx -> - fun (a,b) -> - let a = self#core_type ctx a in - let b = self#variance ctx b in (a, b)) ctx ptype_params - in + (fun ctx -> + fun (a, b) -> + let a = self#core_type ctx a in + let b = self#variance ctx b in (a, b)) ctx ptype_params in let ptype_cstrs = self#list - (fun ctx -> - fun (a,b,c) -> - let a = self#core_type ctx a in - let b = self#core_type ctx b in - let c = self#location ctx c in (a, b, c)) ctx ptype_cstrs - in - let ptype_kind = self#type_kind ctx ptype_kind in - let ptype_private = self#private_flag ctx ptype_private in - let ptype_manifest = self#option self#core_type ctx ptype_manifest - in - let ptype_attributes = self#attributes ctx ptype_attributes in - let ptype_loc = self#location ctx ptype_loc in + (fun ctx -> + fun (a, b, c) -> + let a = self#core_type ctx a in + let b = self#core_type ctx b in + let c = self#location ctx c in (a, b, c)) ctx ptype_cstrs in + let ptype_kind = self#type_kind ctx ptype_kind in + let ptype_private = self#private_flag ctx ptype_private in + let ptype_manifest = self#option self#core_type ctx ptype_manifest in + let ptype_attributes = self#attributes ctx ptype_attributes in + let ptype_loc = self#location ctx ptype_loc in { ptype_name; ptype_params; @@ -4730,198 +5026,200 @@ class virtual ['ctx] map_with_context = ptype_loc } method type_kind : 'ctx -> type_kind -> type_kind= - fun ctx -> - fun x -> - match x with - | Ptype_abstract -> Ptype_abstract - | Ptype_variant a -> - let a = self#list self#constructor_declaration ctx a in - Ptype_variant a - | Ptype_record a -> - let a = self#list self#label_declaration ctx a in - Ptype_record a - | Ptype_open -> Ptype_open + fun ctx -> + fun x -> + match x with + | Ptype_abstract -> Ptype_abstract + | Ptype_variant a -> + let a = self#list self#constructor_declaration ctx a in + Ptype_variant a + | Ptype_record a -> + let a = self#list self#label_declaration ctx a in + Ptype_record a + | Ptype_open -> Ptype_open method label_declaration : 'ctx -> label_declaration -> label_declaration= - fun ctx -> - fun { pld_name; pld_mutable; pld_type; pld_loc; pld_attributes } -> - let pld_name = self#loc self#string ctx pld_name in - let pld_mutable = self#mutable_flag ctx pld_mutable in - let pld_type = self#core_type ctx pld_type in - let pld_loc = self#location ctx pld_loc in - let pld_attributes = self#attributes ctx pld_attributes in - { pld_name; pld_mutable; pld_type; pld_loc; pld_attributes } + fun ctx -> + fun { pld_name; pld_mutable; pld_type; pld_loc; pld_attributes } -> + let pld_name = self#loc self#string ctx pld_name in + let pld_mutable = self#mutable_flag ctx pld_mutable in + let pld_type = self#core_type ctx pld_type in + let pld_loc = self#location ctx pld_loc in + let pld_attributes = self#attributes ctx pld_attributes in + { pld_name; pld_mutable; pld_type; pld_loc; pld_attributes } method constructor_declaration : 'ctx -> constructor_declaration -> constructor_declaration= - fun ctx -> - fun { pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes } -> - let pcd_name = self#loc self#string ctx pcd_name in - let pcd_args = self#constructor_arguments ctx pcd_args in - let pcd_res = self#option self#core_type ctx pcd_res in - let pcd_loc = self#location ctx pcd_loc in - let pcd_attributes = self#attributes ctx pcd_attributes in - { pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes } + fun ctx -> + fun { pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes } -> + let pcd_name = self#loc self#string ctx pcd_name in + let pcd_args = self#constructor_arguments ctx pcd_args in + let pcd_res = self#option self#core_type ctx pcd_res in + let pcd_loc = self#location ctx pcd_loc in + let pcd_attributes = self#attributes ctx pcd_attributes in + { pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes } method constructor_arguments : 'ctx -> constructor_arguments -> constructor_arguments= - fun ctx -> - fun x -> - match x with - | Pcstr_tuple a -> - let a = self#list self#core_type ctx a in Pcstr_tuple a - | Pcstr_record a -> - let a = self#list self#label_declaration ctx a in - Pcstr_record a + fun ctx -> + fun x -> + match x with + | Pcstr_tuple a -> + let a = self#list self#core_type ctx a in Pcstr_tuple a + | Pcstr_record a -> + let a = self#list self#label_declaration ctx a in + Pcstr_record a method type_extension : 'ctx -> type_extension -> type_extension= - fun ctx -> - fun - { ptyext_path; ptyext_params; ptyext_constructors; ptyext_private; - ptyext_attributes } - -> - let ptyext_path = self#longident_loc ctx ptyext_path in + fun ctx -> + fun + { ptyext_path; ptyext_params; ptyext_constructors; ptyext_private; + ptyext_loc; ptyext_attributes } + -> + let ptyext_path = self#longident_loc ctx ptyext_path in let ptyext_params = self#list - (fun ctx -> - fun (a,b) -> - let a = self#core_type ctx a in - let b = self#variance ctx b in (a, b)) ctx ptyext_params - in + (fun ctx -> + fun (a, b) -> + let a = self#core_type ctx a in + let b = self#variance ctx b in (a, b)) ctx ptyext_params in let ptyext_constructors = - self#list self#extension_constructor ctx ptyext_constructors in - let ptyext_private = self#private_flag ctx ptyext_private in - let ptyext_attributes = self#attributes ctx ptyext_attributes in + self#list self#extension_constructor ctx ptyext_constructors in + let ptyext_private = self#private_flag ctx ptyext_private in + let ptyext_loc = self#location ctx ptyext_loc in + let ptyext_attributes = self#attributes ctx ptyext_attributes in { ptyext_path; ptyext_params; ptyext_constructors; ptyext_private; + ptyext_loc; ptyext_attributes } method extension_constructor : 'ctx -> extension_constructor -> extension_constructor= - fun ctx -> - fun { pext_name; pext_kind; pext_loc; pext_attributes } -> - let pext_name = self#loc self#string ctx pext_name in - let pext_kind = self#extension_constructor_kind ctx pext_kind in - let pext_loc = self#location ctx pext_loc in - let pext_attributes = self#attributes ctx pext_attributes in - { pext_name; pext_kind; pext_loc; pext_attributes } + fun ctx -> + fun { pext_name; pext_kind; pext_loc; pext_attributes } -> + let pext_name = self#loc self#string ctx pext_name in + let pext_kind = self#extension_constructor_kind ctx pext_kind in + let pext_loc = self#location ctx pext_loc in + let pext_attributes = self#attributes ctx pext_attributes in + { pext_name; pext_kind; pext_loc; pext_attributes } + method type_exception : 'ctx -> type_exception -> type_exception= + fun ctx -> + fun { ptyexn_constructor; ptyexn_loc; ptyexn_attributes } -> + let ptyexn_constructor = + self#extension_constructor ctx ptyexn_constructor in + let ptyexn_loc = self#location ctx ptyexn_loc in + let ptyexn_attributes = self#attributes ctx ptyexn_attributes in + { ptyexn_constructor; ptyexn_loc; ptyexn_attributes } method extension_constructor_kind : 'ctx -> extension_constructor_kind -> extension_constructor_kind= - fun ctx -> - fun x -> - match x with - | Pext_decl (a,b) -> - let a = self#constructor_arguments ctx a in - let b = self#option self#core_type ctx b in Pext_decl (a, b) - | Pext_rebind a -> - let a = self#longident_loc ctx a in Pext_rebind a + fun ctx -> + fun x -> + match x with + | Pext_decl (a, b) -> + let a = self#constructor_arguments ctx a in + let b = self#option self#core_type ctx b in Pext_decl (a, b) + | Pext_rebind a -> + let a = self#longident_loc ctx a in Pext_rebind a method class_type : 'ctx -> class_type -> class_type= - fun ctx -> - fun { pcty_desc; pcty_loc; pcty_attributes } -> - let pcty_desc = self#class_type_desc ctx pcty_desc in - let pcty_loc = self#location ctx pcty_loc in - let pcty_attributes = self#attributes ctx pcty_attributes in - { pcty_desc; pcty_loc; pcty_attributes } + fun ctx -> + fun { pcty_desc; pcty_loc; pcty_attributes } -> + let pcty_desc = self#class_type_desc ctx pcty_desc in + let pcty_loc = self#location ctx pcty_loc in + let pcty_attributes = self#attributes ctx pcty_attributes in + { pcty_desc; pcty_loc; pcty_attributes } method class_type_desc : 'ctx -> class_type_desc -> class_type_desc= - fun ctx -> - fun x -> - match x with - | Pcty_constr (a,b) -> - let a = self#longident_loc ctx a in - let b = self#list self#core_type ctx b in Pcty_constr (a, b) - | Pcty_signature a -> - let a = self#class_signature ctx a in Pcty_signature a - | Pcty_arrow (a,b,c) -> - let a = self#arg_label ctx a in - let b = self#core_type ctx b in - let c = self#class_type ctx c in Pcty_arrow (a, b, c) - | Pcty_extension a -> - let a = self#extension ctx a in Pcty_extension a - | Pcty_open (a,b,c) -> - let a = self#override_flag ctx a in - let b = self#longident_loc ctx b in - let c = self#class_type ctx c in Pcty_open (a, b, c) + fun ctx -> + fun x -> + match x with + | Pcty_constr (a, b) -> + let a = self#longident_loc ctx a in + let b = self#list self#core_type ctx b in Pcty_constr (a, b) + | Pcty_signature a -> + let a = self#class_signature ctx a in Pcty_signature a + | Pcty_arrow (a, b, c) -> + let a = self#arg_label ctx a in + let b = self#core_type ctx b in + let c = self#class_type ctx c in Pcty_arrow (a, b, c) + | Pcty_extension a -> + let a = self#extension ctx a in Pcty_extension a + | Pcty_open (a, b) -> + let a = self#open_description ctx a in + let b = self#class_type ctx b in Pcty_open (a, b) method class_signature : 'ctx -> class_signature -> class_signature= - fun ctx -> - fun { pcsig_self; pcsig_fields } -> - let pcsig_self = self#core_type ctx pcsig_self in - let pcsig_fields = self#list self#class_type_field ctx pcsig_fields - in - { pcsig_self; pcsig_fields } + fun ctx -> + fun { pcsig_self; pcsig_fields } -> + let pcsig_self = self#core_type ctx pcsig_self in + let pcsig_fields = self#list self#class_type_field ctx pcsig_fields in + { pcsig_self; pcsig_fields } method class_type_field : 'ctx -> class_type_field -> class_type_field= - fun ctx -> - fun { pctf_desc; pctf_loc; pctf_attributes } -> - let pctf_desc = self#class_type_field_desc ctx pctf_desc in - let pctf_loc = self#location ctx pctf_loc in - let pctf_attributes = self#attributes ctx pctf_attributes in - { pctf_desc; pctf_loc; pctf_attributes } + fun ctx -> + fun { pctf_desc; pctf_loc; pctf_attributes } -> + let pctf_desc = self#class_type_field_desc ctx pctf_desc in + let pctf_loc = self#location ctx pctf_loc in + let pctf_attributes = self#attributes ctx pctf_attributes in + { pctf_desc; pctf_loc; pctf_attributes } method class_type_field_desc : 'ctx -> class_type_field_desc -> class_type_field_desc= - fun ctx -> - fun x -> - match x with - | Pctf_inherit a -> - let a = self#class_type ctx a in Pctf_inherit a - | Pctf_val a -> - let a = - (fun ctx -> - fun (a,b,c,d) -> - let a = self#loc self#label ctx a in - let b = self#mutable_flag ctx b in - let c = self#virtual_flag ctx c in - let d = self#core_type ctx d in (a, b, c, d)) ctx a - in - Pctf_val a - | Pctf_method a -> - let a = - (fun ctx -> - fun (a,b,c,d) -> - let a = self#loc self#label ctx a in - let b = self#private_flag ctx b in - let c = self#virtual_flag ctx c in - let d = self#core_type ctx d in (a, b, c, d)) ctx a - in - Pctf_method a - | Pctf_constraint a -> - let a = - (fun ctx -> - fun (a,b) -> - let a = self#core_type ctx a in - let b = self#core_type ctx b in (a, b)) ctx a - in - Pctf_constraint a - | Pctf_attribute a -> - let a = self#attribute ctx a in Pctf_attribute a - | Pctf_extension a -> - let a = self#extension ctx a in Pctf_extension a + fun ctx -> + fun x -> + match x with + | Pctf_inherit a -> let a = self#class_type ctx a in Pctf_inherit a + | Pctf_val a -> + let a = + (fun ctx -> + fun (a, b, c, d) -> + let a = self#loc self#label ctx a in + let b = self#mutable_flag ctx b in + let c = self#virtual_flag ctx c in + let d = self#core_type ctx d in (a, b, c, d)) ctx a in + Pctf_val a + | Pctf_method a -> + let a = + (fun ctx -> + fun (a, b, c, d) -> + let a = self#loc self#label ctx a in + let b = self#private_flag ctx b in + let c = self#virtual_flag ctx c in + let d = self#core_type ctx d in (a, b, c, d)) ctx a in + Pctf_method a + | Pctf_constraint a -> + let a = + (fun ctx -> + fun (a, b) -> + let a = self#core_type ctx a in + let b = self#core_type ctx b in (a, b)) ctx a in + Pctf_constraint a + | Pctf_attribute a -> + let a = self#attribute ctx a in Pctf_attribute a + | Pctf_extension a -> + let a = self#extension ctx a in Pctf_extension a method class_infos : 'a . ('ctx -> 'a -> 'a) -> 'ctx -> 'a class_infos -> 'a class_infos= - fun _a -> - fun ctx -> - fun - { pci_virt; pci_params; pci_name; pci_expr; pci_loc; - pci_attributes } - -> - let pci_virt = self#virtual_flag ctx pci_virt in - let pci_params = - self#list - (fun ctx -> - fun (a,b) -> - let a = self#core_type ctx a in - let b = self#variance ctx b in (a, b)) ctx pci_params - in - let pci_name = self#loc self#string ctx pci_name in - let pci_expr = _a ctx pci_expr in - let pci_loc = self#location ctx pci_loc in - let pci_attributes = self#attributes ctx pci_attributes in - { - pci_virt; - pci_params; - pci_name; - pci_expr; - pci_loc; - pci_attributes - } + fun _a -> + fun ctx -> + fun + { pci_virt; pci_params; pci_name; pci_expr; pci_loc; + pci_attributes } + -> + let pci_virt = self#virtual_flag ctx pci_virt in + let pci_params = + self#list + (fun ctx -> + fun (a, b) -> + let a = self#core_type ctx a in + let b = self#variance ctx b in (a, b)) ctx pci_params in + let pci_name = self#loc self#string ctx pci_name in + let pci_expr = _a ctx pci_expr in + let pci_loc = self#location ctx pci_loc in + let pci_attributes = self#attributes ctx pci_attributes in + { + pci_virt; + pci_params; + pci_name; + pci_expr; + pci_loc; + pci_attributes + } method class_description : 'ctx -> class_description -> class_description= self#class_infos self#class_type @@ -4929,219 +5227,233 @@ class virtual ['ctx] map_with_context = 'ctx -> class_type_declaration -> class_type_declaration= self#class_infos self#class_type method class_expr : 'ctx -> class_expr -> class_expr= - fun ctx -> - fun { pcl_desc; pcl_loc; pcl_attributes } -> - let pcl_desc = self#class_expr_desc ctx pcl_desc in - let pcl_loc = self#location ctx pcl_loc in - let pcl_attributes = self#attributes ctx pcl_attributes in - { pcl_desc; pcl_loc; pcl_attributes } + fun ctx -> + fun { pcl_desc; pcl_loc; pcl_attributes } -> + let pcl_desc = self#class_expr_desc ctx pcl_desc in + let pcl_loc = self#location ctx pcl_loc in + let pcl_attributes = self#attributes ctx pcl_attributes in + { pcl_desc; pcl_loc; pcl_attributes } method class_expr_desc : 'ctx -> class_expr_desc -> class_expr_desc= - fun ctx -> - fun x -> - match x with - | Pcl_constr (a,b) -> - let a = self#longident_loc ctx a in - let b = self#list self#core_type ctx b in Pcl_constr (a, b) - | Pcl_structure a -> - let a = self#class_structure ctx a in Pcl_structure a - | Pcl_fun (a,b,c,d) -> - let a = self#arg_label ctx a in - let b = self#option self#expression ctx b in - let c = self#pattern ctx c in - let d = self#class_expr ctx d in Pcl_fun (a, b, c, d) - | Pcl_apply (a,b) -> - let a = self#class_expr ctx a in - let b = - self#list - (fun ctx -> - fun (a,b) -> - let a = self#arg_label ctx a in - let b = self#expression ctx b in (a, b)) ctx b - in - Pcl_apply (a, b) - | Pcl_let (a,b,c) -> - let a = self#rec_flag ctx a in - let b = self#list self#value_binding ctx b in - let c = self#class_expr ctx c in Pcl_let (a, b, c) - | Pcl_constraint (a,b) -> - let a = self#class_expr ctx a in - let b = self#class_type ctx b in Pcl_constraint (a, b) - | Pcl_extension a -> - let a = self#extension ctx a in Pcl_extension a - | Pcl_open (a,b,c) -> - let a = self#override_flag ctx a in - let b = self#longident_loc ctx b in - let c = self#class_expr ctx c in Pcl_open (a, b, c) + fun ctx -> + fun x -> + match x with + | Pcl_constr (a, b) -> + let a = self#longident_loc ctx a in + let b = self#list self#core_type ctx b in Pcl_constr (a, b) + | Pcl_structure a -> + let a = self#class_structure ctx a in Pcl_structure a + | Pcl_fun (a, b, c, d) -> + let a = self#arg_label ctx a in + let b = self#option self#expression ctx b in + let c = self#pattern ctx c in + let d = self#class_expr ctx d in Pcl_fun (a, b, c, d) + | Pcl_apply (a, b) -> + let a = self#class_expr ctx a in + let b = + self#list + (fun ctx -> + fun (a, b) -> + let a = self#arg_label ctx a in + let b = self#expression ctx b in (a, b)) ctx b in + Pcl_apply (a, b) + | Pcl_let (a, b, c) -> + let a = self#rec_flag ctx a in + let b = self#list self#value_binding ctx b in + let c = self#class_expr ctx c in Pcl_let (a, b, c) + | Pcl_constraint (a, b) -> + let a = self#class_expr ctx a in + let b = self#class_type ctx b in Pcl_constraint (a, b) + | Pcl_extension a -> + let a = self#extension ctx a in Pcl_extension a + | Pcl_open (a, b) -> + let a = self#open_description ctx a in + let b = self#class_expr ctx b in Pcl_open (a, b) method class_structure : 'ctx -> class_structure -> class_structure= - fun ctx -> - fun { pcstr_self; pcstr_fields } -> - let pcstr_self = self#pattern ctx pcstr_self in - let pcstr_fields = self#list self#class_field ctx pcstr_fields in - { pcstr_self; pcstr_fields } + fun ctx -> + fun { pcstr_self; pcstr_fields } -> + let pcstr_self = self#pattern ctx pcstr_self in + let pcstr_fields = self#list self#class_field ctx pcstr_fields in + { pcstr_self; pcstr_fields } method class_field : 'ctx -> class_field -> class_field= - fun ctx -> - fun { pcf_desc; pcf_loc; pcf_attributes } -> - let pcf_desc = self#class_field_desc ctx pcf_desc in - let pcf_loc = self#location ctx pcf_loc in - let pcf_attributes = self#attributes ctx pcf_attributes in - { pcf_desc; pcf_loc; pcf_attributes } + fun ctx -> + fun { pcf_desc; pcf_loc; pcf_attributes } -> + let pcf_desc = self#class_field_desc ctx pcf_desc in + let pcf_loc = self#location ctx pcf_loc in + let pcf_attributes = self#attributes ctx pcf_attributes in + { pcf_desc; pcf_loc; pcf_attributes } method class_field_desc : 'ctx -> class_field_desc -> class_field_desc= - fun ctx -> - fun x -> - match x with - | Pcf_inherit (a,b,c) -> - let a = self#override_flag ctx a in - let b = self#class_expr ctx b in - let c = self#option (self#loc self#string) ctx c in - Pcf_inherit (a, b, c) - | Pcf_val a -> - let a = - (fun ctx -> - fun (a,b,c) -> - let a = self#loc self#label ctx a in - let b = self#mutable_flag ctx b in - let c = self#class_field_kind ctx c in (a, b, c)) ctx a - in - Pcf_val a - | Pcf_method a -> - let a = - (fun ctx -> - fun (a,b,c) -> - let a = self#loc self#label ctx a in - let b = self#private_flag ctx b in - let c = self#class_field_kind ctx c in (a, b, c)) ctx a - in - Pcf_method a - | Pcf_constraint a -> - let a = - (fun ctx -> - fun (a,b) -> - let a = self#core_type ctx a in - let b = self#core_type ctx b in (a, b)) ctx a - in - Pcf_constraint a - | Pcf_initializer a -> - let a = self#expression ctx a in Pcf_initializer a - | Pcf_attribute a -> - let a = self#attribute ctx a in Pcf_attribute a - | Pcf_extension a -> - let a = self#extension ctx a in Pcf_extension a + fun ctx -> + fun x -> + match x with + | Pcf_inherit (a, b, c) -> + let a = self#override_flag ctx a in + let b = self#class_expr ctx b in + let c = self#option (self#loc self#string) ctx c in + Pcf_inherit (a, b, c) + | Pcf_val a -> + let a = + (fun ctx -> + fun (a, b, c) -> + let a = self#loc self#label ctx a in + let b = self#mutable_flag ctx b in + let c = self#class_field_kind ctx c in (a, b, c)) ctx a in + Pcf_val a + | Pcf_method a -> + let a = + (fun ctx -> + fun (a, b, c) -> + let a = self#loc self#label ctx a in + let b = self#private_flag ctx b in + let c = self#class_field_kind ctx c in (a, b, c)) ctx a in + Pcf_method a + | Pcf_constraint a -> + let a = + (fun ctx -> + fun (a, b) -> + let a = self#core_type ctx a in + let b = self#core_type ctx b in (a, b)) ctx a in + Pcf_constraint a + | Pcf_initializer a -> + let a = self#expression ctx a in Pcf_initializer a + | Pcf_attribute a -> + let a = self#attribute ctx a in Pcf_attribute a + | Pcf_extension a -> + let a = self#extension ctx a in Pcf_extension a method class_field_kind : 'ctx -> class_field_kind -> class_field_kind= - fun ctx -> - fun x -> - match x with - | Cfk_virtual a -> let a = self#core_type ctx a in Cfk_virtual a - | Cfk_concrete (a,b) -> - let a = self#override_flag ctx a in - let b = self#expression ctx b in Cfk_concrete (a, b) + fun ctx -> + fun x -> + match x with + | Cfk_virtual a -> let a = self#core_type ctx a in Cfk_virtual a + | Cfk_concrete (a, b) -> + let a = self#override_flag ctx a in + let b = self#expression ctx b in Cfk_concrete (a, b) method class_declaration : 'ctx -> class_declaration -> class_declaration= self#class_infos self#class_expr method module_type : 'ctx -> module_type -> module_type= - fun ctx -> - fun { pmty_desc; pmty_loc; pmty_attributes } -> - let pmty_desc = self#module_type_desc ctx pmty_desc in - let pmty_loc = self#location ctx pmty_loc in - let pmty_attributes = self#attributes ctx pmty_attributes in - { pmty_desc; pmty_loc; pmty_attributes } + fun ctx -> + fun { pmty_desc; pmty_loc; pmty_attributes } -> + let pmty_desc = self#module_type_desc ctx pmty_desc in + let pmty_loc = self#location ctx pmty_loc in + let pmty_attributes = self#attributes ctx pmty_attributes in + { pmty_desc; pmty_loc; pmty_attributes } method module_type_desc : 'ctx -> module_type_desc -> module_type_desc= - fun ctx -> - fun x -> - match x with - | Pmty_ident a -> let a = self#longident_loc ctx a in Pmty_ident a - | Pmty_signature a -> - let a = self#signature ctx a in Pmty_signature a - | Pmty_functor (a,b,c) -> - let a = self#loc self#string ctx a in - let b = self#option self#module_type ctx b in - let c = self#module_type ctx c in Pmty_functor (a, b, c) - | Pmty_with (a,b) -> - let a = self#module_type ctx a in - let b = self#list self#with_constraint ctx b in - Pmty_with (a, b) - | Pmty_typeof a -> let a = self#module_expr ctx a in Pmty_typeof a - | Pmty_extension a -> - let a = self#extension ctx a in Pmty_extension a - | Pmty_alias a -> let a = self#longident_loc ctx a in Pmty_alias a + fun ctx -> + fun x -> + match x with + | Pmty_ident a -> let a = self#longident_loc ctx a in Pmty_ident a + | Pmty_signature a -> + let a = self#signature ctx a in Pmty_signature a + | Pmty_functor (a, b, c) -> + let a = self#loc self#string ctx a in + let b = self#option self#module_type ctx b in + let c = self#module_type ctx c in Pmty_functor (a, b, c) + | Pmty_with (a, b) -> + let a = self#module_type ctx a in + let b = self#list self#with_constraint ctx b in + Pmty_with (a, b) + | Pmty_typeof a -> let a = self#module_expr ctx a in Pmty_typeof a + | Pmty_extension a -> + let a = self#extension ctx a in Pmty_extension a + | Pmty_alias a -> let a = self#longident_loc ctx a in Pmty_alias a method signature : 'ctx -> signature -> signature= self#list self#signature_item method signature_item : 'ctx -> signature_item -> signature_item= - fun ctx -> - fun { psig_desc; psig_loc } -> - let psig_desc = self#signature_item_desc ctx psig_desc in - let psig_loc = self#location ctx psig_loc in - { psig_desc; psig_loc } + fun ctx -> + fun { psig_desc; psig_loc } -> + let psig_desc = self#signature_item_desc ctx psig_desc in + let psig_loc = self#location ctx psig_loc in + { psig_desc; psig_loc } method signature_item_desc : 'ctx -> signature_item_desc -> signature_item_desc= - fun ctx -> - fun x -> - match x with - | Psig_value a -> - let a = self#value_description ctx a in Psig_value a - | Psig_type (a,b) -> - let a = self#rec_flag ctx a in - let b = self#list self#type_declaration ctx b in - Psig_type (a, b) - | Psig_typext a -> - let a = self#type_extension ctx a in Psig_typext a - | Psig_exception a -> - let a = self#extension_constructor ctx a in Psig_exception a - | Psig_module a -> - let a = self#module_declaration ctx a in Psig_module a - | Psig_recmodule a -> - let a = self#list self#module_declaration ctx a in - Psig_recmodule a - | Psig_modtype a -> - let a = self#module_type_declaration ctx a in Psig_modtype a - | Psig_open a -> - let a = self#open_description ctx a in Psig_open a - | Psig_include a -> - let a = self#include_description ctx a in Psig_include a - | Psig_class a -> - let a = self#list self#class_description ctx a in Psig_class a - | Psig_class_type a -> - let a = self#list self#class_type_declaration ctx a in - Psig_class_type a - | Psig_attribute a -> - let a = self#attribute ctx a in Psig_attribute a - | Psig_extension (a,b) -> - let a = self#extension ctx a in - let b = self#attributes ctx b in Psig_extension (a, b) + fun ctx -> + fun x -> + match x with + | Psig_value a -> + let a = self#value_description ctx a in Psig_value a + | Psig_type (a, b) -> + let a = self#rec_flag ctx a in + let b = self#list self#type_declaration ctx b in + Psig_type (a, b) + | Psig_typesubst a -> + let a = self#list self#type_declaration ctx a in + Psig_typesubst a + | Psig_typext a -> + let a = self#type_extension ctx a in Psig_typext a + | Psig_exception a -> + let a = self#type_exception ctx a in Psig_exception a + | Psig_module a -> + let a = self#module_declaration ctx a in Psig_module a + | Psig_modsubst a -> + let a = self#module_substitution ctx a in Psig_modsubst a + | Psig_recmodule a -> + let a = self#list self#module_declaration ctx a in + Psig_recmodule a + | Psig_modtype a -> + let a = self#module_type_declaration ctx a in Psig_modtype a + | Psig_open a -> let a = self#open_description ctx a in Psig_open a + | Psig_include a -> + let a = self#include_description ctx a in Psig_include a + | Psig_class a -> + let a = self#list self#class_description ctx a in Psig_class a + | Psig_class_type a -> + let a = self#list self#class_type_declaration ctx a in + Psig_class_type a + | Psig_attribute a -> + let a = self#attribute ctx a in Psig_attribute a + | Psig_extension (a, b) -> + let a = self#extension ctx a in + let b = self#attributes ctx b in Psig_extension (a, b) method module_declaration : 'ctx -> module_declaration -> module_declaration= - fun ctx -> - fun { pmd_name; pmd_type; pmd_attributes; pmd_loc } -> - let pmd_name = self#loc self#string ctx pmd_name in - let pmd_type = self#module_type ctx pmd_type in - let pmd_attributes = self#attributes ctx pmd_attributes in - let pmd_loc = self#location ctx pmd_loc in - { pmd_name; pmd_type; pmd_attributes; pmd_loc } + fun ctx -> + fun { pmd_name; pmd_type; pmd_attributes; pmd_loc } -> + let pmd_name = self#loc self#string ctx pmd_name in + let pmd_type = self#module_type ctx pmd_type in + let pmd_attributes = self#attributes ctx pmd_attributes in + let pmd_loc = self#location ctx pmd_loc in + { pmd_name; pmd_type; pmd_attributes; pmd_loc } + method module_substitution : + 'ctx -> module_substitution -> module_substitution= + fun ctx -> + fun { pms_name; pms_manifest; pms_attributes; pms_loc } -> + let pms_name = self#loc self#string ctx pms_name in + let pms_manifest = self#longident_loc ctx pms_manifest in + let pms_attributes = self#attributes ctx pms_attributes in + let pms_loc = self#location ctx pms_loc in + { pms_name; pms_manifest; pms_attributes; pms_loc } method module_type_declaration : 'ctx -> module_type_declaration -> module_type_declaration= - fun ctx -> - fun { pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc } -> - let pmtd_name = self#loc self#string ctx pmtd_name in - let pmtd_type = self#option self#module_type ctx pmtd_type in - let pmtd_attributes = self#attributes ctx pmtd_attributes in - let pmtd_loc = self#location ctx pmtd_loc in - { pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc } + fun ctx -> + fun { pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc } -> + let pmtd_name = self#loc self#string ctx pmtd_name in + let pmtd_type = self#option self#module_type ctx pmtd_type in + let pmtd_attributes = self#attributes ctx pmtd_attributes in + let pmtd_loc = self#location ctx pmtd_loc in + { pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc } + method open_infos : + 'a . ('ctx -> 'a -> 'a) -> 'ctx -> 'a open_infos -> 'a open_infos= + fun _a -> + fun ctx -> + fun { popen_expr; popen_override; popen_loc; popen_attributes } -> + let popen_expr = _a ctx popen_expr in + let popen_override = self#override_flag ctx popen_override in + let popen_loc = self#location ctx popen_loc in + let popen_attributes = self#attributes ctx popen_attributes in + { popen_expr; popen_override; popen_loc; popen_attributes } method open_description : 'ctx -> open_description -> open_description= - fun ctx -> - fun { popen_lid; popen_override; popen_loc; popen_attributes } -> - let popen_lid = self#longident_loc ctx popen_lid in - let popen_override = self#override_flag ctx popen_override in - let popen_loc = self#location ctx popen_loc in - let popen_attributes = self#attributes ctx popen_attributes in - { popen_lid; popen_override; popen_loc; popen_attributes } + self#open_infos self#longident_loc + method open_declaration : 'ctx -> open_declaration -> open_declaration= + self#open_infos self#module_expr method include_infos : 'a . ('ctx -> 'a -> 'a) -> 'ctx -> 'a include_infos -> 'a include_infos= - fun _a -> - fun ctx -> - fun { pincl_mod; pincl_loc; pincl_attributes } -> - let pincl_mod = _a ctx pincl_mod in - let pincl_loc = self#location ctx pincl_loc in - let pincl_attributes = self#attributes ctx pincl_attributes in - { pincl_mod; pincl_loc; pincl_attributes } + fun _a -> + fun ctx -> + fun { pincl_mod; pincl_loc; pincl_attributes } -> + let pincl_mod = _a ctx pincl_mod in + let pincl_loc = self#location ctx pincl_loc in + let pincl_attributes = self#attributes ctx pincl_attributes in + { pincl_mod; pincl_loc; pincl_attributes } method include_description : 'ctx -> include_description -> include_description= self#include_infos self#module_type @@ -5149,135 +5461,144 @@ class virtual ['ctx] map_with_context = 'ctx -> include_declaration -> include_declaration= self#include_infos self#module_expr method with_constraint : 'ctx -> with_constraint -> with_constraint= - fun ctx -> - fun x -> - match x with - | Pwith_type (a,b) -> - let a = self#longident_loc ctx a in - let b = self#type_declaration ctx b in Pwith_type (a, b) - | Pwith_module (a,b) -> - let a = self#longident_loc ctx a in - let b = self#longident_loc ctx b in Pwith_module (a, b) - | Pwith_typesubst (a,b) -> - let a = self#longident_loc ctx a in - let b = self#type_declaration ctx b in Pwith_typesubst (a, b) - | Pwith_modsubst (a,b) -> - let a = self#longident_loc ctx a in - let b = self#longident_loc ctx b in Pwith_modsubst (a, b) + fun ctx -> + fun x -> + match x with + | Pwith_type (a, b) -> + let a = self#longident_loc ctx a in + let b = self#type_declaration ctx b in Pwith_type (a, b) + | Pwith_module (a, b) -> + let a = self#longident_loc ctx a in + let b = self#longident_loc ctx b in Pwith_module (a, b) + | Pwith_typesubst (a, b) -> + let a = self#longident_loc ctx a in + let b = self#type_declaration ctx b in Pwith_typesubst (a, b) + | Pwith_modsubst (a, b) -> + let a = self#longident_loc ctx a in + let b = self#longident_loc ctx b in Pwith_modsubst (a, b) method module_expr : 'ctx -> module_expr -> module_expr= - fun ctx -> - fun { pmod_desc; pmod_loc; pmod_attributes } -> - let pmod_desc = self#module_expr_desc ctx pmod_desc in - let pmod_loc = self#location ctx pmod_loc in - let pmod_attributes = self#attributes ctx pmod_attributes in - { pmod_desc; pmod_loc; pmod_attributes } + fun ctx -> + fun { pmod_desc; pmod_loc; pmod_attributes } -> + let pmod_desc = self#module_expr_desc ctx pmod_desc in + let pmod_loc = self#location ctx pmod_loc in + let pmod_attributes = self#attributes ctx pmod_attributes in + { pmod_desc; pmod_loc; pmod_attributes } method module_expr_desc : 'ctx -> module_expr_desc -> module_expr_desc= - fun ctx -> - fun x -> - match x with - | Pmod_ident a -> let a = self#longident_loc ctx a in Pmod_ident a - | Pmod_structure a -> - let a = self#structure ctx a in Pmod_structure a - | Pmod_functor (a,b,c) -> - let a = self#loc self#string ctx a in - let b = self#option self#module_type ctx b in - let c = self#module_expr ctx c in Pmod_functor (a, b, c) - | Pmod_apply (a,b) -> - let a = self#module_expr ctx a in - let b = self#module_expr ctx b in Pmod_apply (a, b) - | Pmod_constraint (a,b) -> - let a = self#module_expr ctx a in - let b = self#module_type ctx b in Pmod_constraint (a, b) - | Pmod_unpack a -> let a = self#expression ctx a in Pmod_unpack a - | Pmod_extension a -> - let a = self#extension ctx a in Pmod_extension a + fun ctx -> + fun x -> + match x with + | Pmod_ident a -> let a = self#longident_loc ctx a in Pmod_ident a + | Pmod_structure a -> + let a = self#structure ctx a in Pmod_structure a + | Pmod_functor (a, b, c) -> + let a = self#loc self#string ctx a in + let b = self#option self#module_type ctx b in + let c = self#module_expr ctx c in Pmod_functor (a, b, c) + | Pmod_apply (a, b) -> + let a = self#module_expr ctx a in + let b = self#module_expr ctx b in Pmod_apply (a, b) + | Pmod_constraint (a, b) -> + let a = self#module_expr ctx a in + let b = self#module_type ctx b in Pmod_constraint (a, b) + | Pmod_unpack a -> let a = self#expression ctx a in Pmod_unpack a + | Pmod_extension a -> + let a = self#extension ctx a in Pmod_extension a method structure : 'ctx -> structure -> structure= self#list self#structure_item method structure_item : 'ctx -> structure_item -> structure_item= - fun ctx -> - fun { pstr_desc; pstr_loc } -> - let pstr_desc = self#structure_item_desc ctx pstr_desc in - let pstr_loc = self#location ctx pstr_loc in - { pstr_desc; pstr_loc } + fun ctx -> + fun { pstr_desc; pstr_loc } -> + let pstr_desc = self#structure_item_desc ctx pstr_desc in + let pstr_loc = self#location ctx pstr_loc in + { pstr_desc; pstr_loc } method structure_item_desc : 'ctx -> structure_item_desc -> structure_item_desc= - fun ctx -> - fun x -> - match x with - | Pstr_eval (a,b) -> - let a = self#expression ctx a in - let b = self#attributes ctx b in Pstr_eval (a, b) - | Pstr_value (a,b) -> - let a = self#rec_flag ctx a in - let b = self#list self#value_binding ctx b in - Pstr_value (a, b) - | Pstr_primitive a -> - let a = self#value_description ctx a in Pstr_primitive a - | Pstr_type (a,b) -> - let a = self#rec_flag ctx a in - let b = self#list self#type_declaration ctx b in - Pstr_type (a, b) - | Pstr_typext a -> - let a = self#type_extension ctx a in Pstr_typext a - | Pstr_exception a -> - let a = self#extension_constructor ctx a in Pstr_exception a - | Pstr_module a -> - let a = self#module_binding ctx a in Pstr_module a - | Pstr_recmodule a -> - let a = self#list self#module_binding ctx a in - Pstr_recmodule a - | Pstr_modtype a -> - let a = self#module_type_declaration ctx a in Pstr_modtype a - | Pstr_open a -> - let a = self#open_description ctx a in Pstr_open a - | Pstr_class a -> - let a = self#list self#class_declaration ctx a in Pstr_class a - | Pstr_class_type a -> - let a = self#list self#class_type_declaration ctx a in - Pstr_class_type a - | Pstr_include a -> - let a = self#include_declaration ctx a in Pstr_include a - | Pstr_attribute a -> - let a = self#attribute ctx a in Pstr_attribute a - | Pstr_extension (a,b) -> - let a = self#extension ctx a in - let b = self#attributes ctx b in Pstr_extension (a, b) + fun ctx -> + fun x -> + match x with + | Pstr_eval (a, b) -> + let a = self#expression ctx a in + let b = self#attributes ctx b in Pstr_eval (a, b) + | Pstr_value (a, b) -> + let a = self#rec_flag ctx a in + let b = self#list self#value_binding ctx b in Pstr_value (a, b) + | Pstr_primitive a -> + let a = self#value_description ctx a in Pstr_primitive a + | Pstr_type (a, b) -> + let a = self#rec_flag ctx a in + let b = self#list self#type_declaration ctx b in + Pstr_type (a, b) + | Pstr_typext a -> + let a = self#type_extension ctx a in Pstr_typext a + | Pstr_exception a -> + let a = self#type_exception ctx a in Pstr_exception a + | Pstr_module a -> + let a = self#module_binding ctx a in Pstr_module a + | Pstr_recmodule a -> + let a = self#list self#module_binding ctx a in Pstr_recmodule a + | Pstr_modtype a -> + let a = self#module_type_declaration ctx a in Pstr_modtype a + | Pstr_open a -> let a = self#open_declaration ctx a in Pstr_open a + | Pstr_class a -> + let a = self#list self#class_declaration ctx a in Pstr_class a + | Pstr_class_type a -> + let a = self#list self#class_type_declaration ctx a in + Pstr_class_type a + | Pstr_include a -> + let a = self#include_declaration ctx a in Pstr_include a + | Pstr_attribute a -> + let a = self#attribute ctx a in Pstr_attribute a + | Pstr_extension (a, b) -> + let a = self#extension ctx a in + let b = self#attributes ctx b in Pstr_extension (a, b) method value_binding : 'ctx -> value_binding -> value_binding= - fun ctx -> - fun { pvb_pat; pvb_expr; pvb_attributes; pvb_loc } -> - let pvb_pat = self#pattern ctx pvb_pat in - let pvb_expr = self#expression ctx pvb_expr in - let pvb_attributes = self#attributes ctx pvb_attributes in - let pvb_loc = self#location ctx pvb_loc in - { pvb_pat; pvb_expr; pvb_attributes; pvb_loc } + fun ctx -> + fun { pvb_pat; pvb_expr; pvb_attributes; pvb_loc } -> + let pvb_pat = self#pattern ctx pvb_pat in + let pvb_expr = self#expression ctx pvb_expr in + let pvb_attributes = self#attributes ctx pvb_attributes in + let pvb_loc = self#location ctx pvb_loc in + { pvb_pat; pvb_expr; pvb_attributes; pvb_loc } method module_binding : 'ctx -> module_binding -> module_binding= - fun ctx -> - fun { pmb_name; pmb_expr; pmb_attributes; pmb_loc } -> - let pmb_name = self#loc self#string ctx pmb_name in - let pmb_expr = self#module_expr ctx pmb_expr in - let pmb_attributes = self#attributes ctx pmb_attributes in - let pmb_loc = self#location ctx pmb_loc in - { pmb_name; pmb_expr; pmb_attributes; pmb_loc } + fun ctx -> + fun { pmb_name; pmb_expr; pmb_attributes; pmb_loc } -> + let pmb_name = self#loc self#string ctx pmb_name in + let pmb_expr = self#module_expr ctx pmb_expr in + let pmb_attributes = self#attributes ctx pmb_attributes in + let pmb_loc = self#location ctx pmb_loc in + { pmb_name; pmb_expr; pmb_attributes; pmb_loc } method toplevel_phrase : 'ctx -> toplevel_phrase -> toplevel_phrase= - fun ctx -> - fun x -> - match x with - | Ptop_def a -> let a = self#structure ctx a in Ptop_def a - | Ptop_dir (a,b) -> - let a = self#string ctx a in - let b = self#directive_argument ctx b in Ptop_dir (a, b) + fun ctx -> + fun x -> + match x with + | Ptop_def a -> let a = self#structure ctx a in Ptop_def a + | Ptop_dir a -> let a = self#toplevel_directive ctx a in Ptop_dir a + method toplevel_directive : + 'ctx -> toplevel_directive -> toplevel_directive= + fun ctx -> + fun { pdir_name; pdir_arg; pdir_loc } -> + let pdir_name = self#loc self#string ctx pdir_name in + let pdir_arg = self#option self#directive_argument ctx pdir_arg in + let pdir_loc = self#location ctx pdir_loc in + { pdir_name; pdir_arg; pdir_loc } method directive_argument : 'ctx -> directive_argument -> directive_argument= - fun ctx -> - fun x -> - match x with - | Pdir_none -> Pdir_none - | Pdir_string a -> let a = self#string ctx a in Pdir_string a - | Pdir_int (a,b) -> - let a = self#string ctx a in - let b = self#option self#char ctx b in Pdir_int (a, b) - | Pdir_ident a -> let a = self#longident ctx a in Pdir_ident a - | Pdir_bool a -> let a = self#bool ctx a in Pdir_bool a + fun ctx -> + fun { pdira_desc; pdira_loc } -> + let pdira_desc = self#directive_argument_desc ctx pdira_desc in + let pdira_loc = self#location ctx pdira_loc in + { pdira_desc; pdira_loc } + method directive_argument_desc : + 'ctx -> directive_argument_desc -> directive_argument_desc= + fun ctx -> + fun x -> + match x with + | Pdir_string a -> let a = self#string ctx a in Pdir_string a + | Pdir_int (a, b) -> + let a = self#string ctx a in + let b = self#option self#char ctx b in Pdir_int (a, b) + | Pdir_ident a -> let a = self#longident ctx a in Pdir_ident a + | Pdir_bool a -> let a = self#bool ctx a in Pdir_bool a end class virtual ['res] lift = object (self) @@ -5291,1035 +5612,1103 @@ class virtual ['res] lift = method virtual option : 'a . ('a -> 'res) -> 'a option -> 'res method virtual string : string -> 'res method position : position -> 'res= - fun { pos_fname; pos_lnum; pos_bol; pos_cnum } -> - let pos_fname = self#string pos_fname in - let pos_lnum = self#int pos_lnum in - let pos_bol = self#int pos_bol in - let pos_cnum = self#int pos_cnum in - self#record - [("pos_fname", pos_fname); - ("pos_lnum", pos_lnum); - ("pos_bol", pos_bol); - ("pos_cnum", pos_cnum)] + fun { pos_fname; pos_lnum; pos_bol; pos_cnum } -> + let pos_fname = self#string pos_fname in + let pos_lnum = self#int pos_lnum in + let pos_bol = self#int pos_bol in + let pos_cnum = self#int pos_cnum in + self#record + [("pos_fname", pos_fname); + ("pos_lnum", pos_lnum); + ("pos_bol", pos_bol); + ("pos_cnum", pos_cnum)] method location : location -> 'res= - fun { loc_start; loc_end; loc_ghost } -> - let loc_start = self#position loc_start in - let loc_end = self#position loc_end in - let loc_ghost = self#bool loc_ghost in - self#record - [("loc_start", loc_start); - ("loc_end", loc_end); - ("loc_ghost", loc_ghost)] + fun { loc_start; loc_end; loc_ghost } -> + let loc_start = self#position loc_start in + let loc_end = self#position loc_end in + let loc_ghost = self#bool loc_ghost in + self#record + [("loc_start", loc_start); + ("loc_end", loc_end); + ("loc_ghost", loc_ghost)] + method location_stack : location_stack -> 'res= + self#list self#location method loc : 'a . ('a -> 'res) -> 'a loc -> 'res= - fun _a -> - fun { txt; loc } -> - let txt = _a txt in - let loc = self#location loc in - self#record [("txt", txt); ("loc", loc)] + fun _a -> + fun { txt; loc } -> + let txt = _a txt in + let loc = self#location loc in + self#record [("txt", txt); ("loc", loc)] method longident : longident -> 'res= - fun x -> - match x with - | Lident a -> let a = self#string a in self#constr "Lident" [a] - | Ldot (a,b) -> - let a = self#longident a in - let b = self#string b in self#constr "Ldot" [a; b] - | Lapply (a,b) -> - let a = self#longident a in - let b = self#longident b in self#constr "Lapply" [a; b] + fun x -> + match x with + | Lident a -> let a = self#string a in self#constr "Lident" [a] + | Ldot (a, b) -> + let a = self#longident a in + let b = self#string b in self#constr "Ldot" [a; b] + | Lapply (a, b) -> + let a = self#longident a in + let b = self#longident b in self#constr "Lapply" [a; b] method longident_loc : longident_loc -> 'res= self#loc self#longident method rec_flag : rec_flag -> 'res= - fun x -> - match x with - | Nonrecursive -> self#constr "Nonrecursive" [] - | Recursive -> self#constr "Recursive" [] + fun x -> + match x with + | Nonrecursive -> self#constr "Nonrecursive" [] + | Recursive -> self#constr "Recursive" [] method direction_flag : direction_flag -> 'res= - fun x -> - match x with - | Upto -> self#constr "Upto" [] - | Downto -> self#constr "Downto" [] + fun x -> + match x with + | Upto -> self#constr "Upto" [] + | Downto -> self#constr "Downto" [] method private_flag : private_flag -> 'res= - fun x -> - match x with - | Private -> self#constr "Private" [] - | Public -> self#constr "Public" [] + fun x -> + match x with + | Private -> self#constr "Private" [] + | Public -> self#constr "Public" [] method mutable_flag : mutable_flag -> 'res= - fun x -> - match x with - | Immutable -> self#constr "Immutable" [] - | Mutable -> self#constr "Mutable" [] + fun x -> + match x with + | Immutable -> self#constr "Immutable" [] + | Mutable -> self#constr "Mutable" [] method virtual_flag : virtual_flag -> 'res= - fun x -> - match x with - | Virtual -> self#constr "Virtual" [] - | Concrete -> self#constr "Concrete" [] + fun x -> + match x with + | Virtual -> self#constr "Virtual" [] + | Concrete -> self#constr "Concrete" [] method override_flag : override_flag -> 'res= - fun x -> - match x with - | Override -> self#constr "Override" [] - | Fresh -> self#constr "Fresh" [] + fun x -> + match x with + | Override -> self#constr "Override" [] + | Fresh -> self#constr "Fresh" [] method closed_flag : closed_flag -> 'res= - fun x -> - match x with - | Closed -> self#constr "Closed" [] - | Open -> self#constr "Open" [] + fun x -> + match x with + | Closed -> self#constr "Closed" [] + | Open -> self#constr "Open" [] method label : label -> 'res= self#string method arg_label : arg_label -> 'res= - fun x -> - match x with - | Nolabel -> self#constr "Nolabel" [] - | Labelled a -> let a = self#string a in self#constr "Labelled" [a] - | Optional a -> let a = self#string a in self#constr "Optional" [a] + fun x -> + match x with + | Nolabel -> self#constr "Nolabel" [] + | Labelled a -> let a = self#string a in self#constr "Labelled" [a] + | Optional a -> let a = self#string a in self#constr "Optional" [a] method variance : variance -> 'res= - fun x -> - match x with - | Covariant -> self#constr "Covariant" [] - | Contravariant -> self#constr "Contravariant" [] - | Invariant -> self#constr "Invariant" [] + fun x -> + match x with + | Covariant -> self#constr "Covariant" [] + | Contravariant -> self#constr "Contravariant" [] + | Invariant -> self#constr "Invariant" [] method constant : constant -> 'res= - fun x -> - match x with - | Pconst_integer (a,b) -> - let a = self#string a in - let b = self#option self#char b in - self#constr "Pconst_integer" [a; b] - | Pconst_char a -> - let a = self#char a in self#constr "Pconst_char" [a] - | Pconst_string (a,b) -> - let a = self#string a in - let b = self#option self#string b in - self#constr "Pconst_string" [a; b] - | Pconst_float (a,b) -> - let a = self#string a in - let b = self#option self#char b in - self#constr "Pconst_float" [a; b] + fun x -> + match x with + | Pconst_integer (a, b) -> + let a = self#string a in + let b = self#option self#char b in + self#constr "Pconst_integer" [a; b] + | Pconst_char a -> + let a = self#char a in self#constr "Pconst_char" [a] + | Pconst_string (a, b) -> + let a = self#string a in + let b = self#option self#string b in + self#constr "Pconst_string" [a; b] + | Pconst_float (a, b) -> + let a = self#string a in + let b = self#option self#char b in + self#constr "Pconst_float" [a; b] method attribute : attribute -> 'res= - fun (a,b) -> - let a = self#loc self#string a in - let b = self#payload b in self#tuple [a; b] + fun { attr_name; attr_payload; attr_loc } -> + let attr_name = self#loc self#string attr_name in + let attr_payload = self#payload attr_payload in + let attr_loc = self#location attr_loc in + self#record + [("attr_name", attr_name); + ("attr_payload", attr_payload); + ("attr_loc", attr_loc)] method extension : extension -> 'res= - fun (a,b) -> - let a = self#loc self#string a in - let b = self#payload b in self#tuple [a; b] + fun (a, b) -> + let a = self#loc self#string a in + let b = self#payload b in self#tuple [a; b] method attributes : attributes -> 'res= self#list self#attribute method payload : payload -> 'res= - fun x -> - match x with - | PStr a -> let a = self#structure a in self#constr "PStr" [a] - | PSig a -> let a = self#signature a in self#constr "PSig" [a] - | PTyp a -> let a = self#core_type a in self#constr "PTyp" [a] - | PPat (a,b) -> - let a = self#pattern a in - let b = self#option self#expression b in - self#constr "PPat" [a; b] + fun x -> + match x with + | PStr a -> let a = self#structure a in self#constr "PStr" [a] + | PSig a -> let a = self#signature a in self#constr "PSig" [a] + | PTyp a -> let a = self#core_type a in self#constr "PTyp" [a] + | PPat (a, b) -> + let a = self#pattern a in + let b = self#option self#expression b in + self#constr "PPat" [a; b] method core_type : core_type -> 'res= - fun { ptyp_desc; ptyp_loc; ptyp_attributes } -> - let ptyp_desc = self#core_type_desc ptyp_desc in - let ptyp_loc = self#location ptyp_loc in - let ptyp_attributes = self#attributes ptyp_attributes in - self#record - [("ptyp_desc", ptyp_desc); - ("ptyp_loc", ptyp_loc); - ("ptyp_attributes", ptyp_attributes)] + fun { ptyp_desc; ptyp_loc; ptyp_loc_stack; ptyp_attributes } -> + let ptyp_desc = self#core_type_desc ptyp_desc in + let ptyp_loc = self#location ptyp_loc in + let ptyp_loc_stack = self#location_stack ptyp_loc_stack in + let ptyp_attributes = self#attributes ptyp_attributes in + self#record + [("ptyp_desc", ptyp_desc); + ("ptyp_loc", ptyp_loc); + ("ptyp_loc_stack", ptyp_loc_stack); + ("ptyp_attributes", ptyp_attributes)] method core_type_desc : core_type_desc -> 'res= - fun x -> - match x with - | Ptyp_any -> self#constr "Ptyp_any" [] - | Ptyp_var a -> let a = self#string a in self#constr "Ptyp_var" [a] - | Ptyp_arrow (a,b,c) -> - let a = self#arg_label a in - let b = self#core_type b in - let c = self#core_type c in self#constr "Ptyp_arrow" [a; b; c] - | Ptyp_tuple a -> - let a = self#list self#core_type a in - self#constr "Ptyp_tuple" [a] - | Ptyp_constr (a,b) -> - let a = self#longident_loc a in - let b = self#list self#core_type b in - self#constr "Ptyp_constr" [a; b] - | Ptyp_object (a,b) -> - let a = self#list self#object_field a in - let b = self#closed_flag b in self#constr "Ptyp_object" [a; b] - | Ptyp_class (a,b) -> - let a = self#longident_loc a in - let b = self#list self#core_type b in - self#constr "Ptyp_class" [a; b] - | Ptyp_alias (a,b) -> - let a = self#core_type a in - let b = self#string b in self#constr "Ptyp_alias" [a; b] - | Ptyp_variant (a,b,c) -> - let a = self#list self#row_field a in - let b = self#closed_flag b in - let c = self#option (self#list self#label) c in - self#constr "Ptyp_variant" [a; b; c] - | Ptyp_poly (a,b) -> - let a = self#list (self#loc self#string) a in - let b = self#core_type b in self#constr "Ptyp_poly" [a; b] - | Ptyp_package a -> - let a = self#package_type a in self#constr "Ptyp_package" [a] - | Ptyp_extension a -> - let a = self#extension a in self#constr "Ptyp_extension" [a] + fun x -> + match x with + | Ptyp_any -> self#constr "Ptyp_any" [] + | Ptyp_var a -> let a = self#string a in self#constr "Ptyp_var" [a] + | Ptyp_arrow (a, b, c) -> + let a = self#arg_label a in + let b = self#core_type b in + let c = self#core_type c in self#constr "Ptyp_arrow" [a; b; c] + | Ptyp_tuple a -> + let a = self#list self#core_type a in + self#constr "Ptyp_tuple" [a] + | Ptyp_constr (a, b) -> + let a = self#longident_loc a in + let b = self#list self#core_type b in + self#constr "Ptyp_constr" [a; b] + | Ptyp_object (a, b) -> + let a = self#list self#object_field a in + let b = self#closed_flag b in self#constr "Ptyp_object" [a; b] + | Ptyp_class (a, b) -> + let a = self#longident_loc a in + let b = self#list self#core_type b in + self#constr "Ptyp_class" [a; b] + | Ptyp_alias (a, b) -> + let a = self#core_type a in + let b = self#string b in self#constr "Ptyp_alias" [a; b] + | Ptyp_variant (a, b, c) -> + let a = self#list self#row_field a in + let b = self#closed_flag b in + let c = self#option (self#list self#label) c in + self#constr "Ptyp_variant" [a; b; c] + | Ptyp_poly (a, b) -> + let a = self#list (self#loc self#string) a in + let b = self#core_type b in self#constr "Ptyp_poly" [a; b] + | Ptyp_package a -> + let a = self#package_type a in self#constr "Ptyp_package" [a] + | Ptyp_extension a -> + let a = self#extension a in self#constr "Ptyp_extension" [a] method package_type : package_type -> 'res= - fun (a,b) -> - let a = self#longident_loc a in - let b = - self#list - (fun (a,b) -> - let a = self#longident_loc a in - let b = self#core_type b in self#tuple [a; b]) b - in - self#tuple [a; b] + fun (a, b) -> + let a = self#longident_loc a in + let b = + self#list + (fun (a, b) -> + let a = self#longident_loc a in + let b = self#core_type b in self#tuple [a; b]) b in + self#tuple [a; b] method row_field : row_field -> 'res= - fun x -> - match x with - | Rtag (a,b,c,d) -> - let a = self#loc self#label a in - let b = self#attributes b in - let c = self#bool c in - let d = self#list self#core_type d in - self#constr "Rtag" [a; b; c; d] - | Rinherit a -> - let a = self#core_type a in self#constr "Rinherit" [a] + fun { prf_desc; prf_loc; prf_attributes } -> + let prf_desc = self#row_field_desc prf_desc in + let prf_loc = self#location prf_loc in + let prf_attributes = self#attributes prf_attributes in + self#record + [("prf_desc", prf_desc); + ("prf_loc", prf_loc); + ("prf_attributes", prf_attributes)] + method row_field_desc : row_field_desc -> 'res= + fun x -> + match x with + | Rtag (a, b, c) -> + let a = self#loc self#label a in + let b = self#bool b in + let c = self#list self#core_type c in + self#constr "Rtag" [a; b; c] + | Rinherit a -> + let a = self#core_type a in self#constr "Rinherit" [a] method object_field : object_field -> 'res= - fun x -> - match x with - | Otag (a,b,c) -> - let a = self#loc self#label a in - let b = self#attributes b in - let c = self#core_type c in self#constr "Otag" [a; b; c] - | Oinherit a -> - let a = self#core_type a in self#constr "Oinherit" [a] + fun { pof_desc; pof_loc; pof_attributes } -> + let pof_desc = self#object_field_desc pof_desc in + let pof_loc = self#location pof_loc in + let pof_attributes = self#attributes pof_attributes in + self#record + [("pof_desc", pof_desc); + ("pof_loc", pof_loc); + ("pof_attributes", pof_attributes)] + method object_field_desc : object_field_desc -> 'res= + fun x -> + match x with + | Otag (a, b) -> + let a = self#loc self#label a in + let b = self#core_type b in self#constr "Otag" [a; b] + | Oinherit a -> + let a = self#core_type a in self#constr "Oinherit" [a] method pattern : pattern -> 'res= - fun { ppat_desc; ppat_loc; ppat_attributes } -> - let ppat_desc = self#pattern_desc ppat_desc in - let ppat_loc = self#location ppat_loc in - let ppat_attributes = self#attributes ppat_attributes in - self#record - [("ppat_desc", ppat_desc); - ("ppat_loc", ppat_loc); - ("ppat_attributes", ppat_attributes)] + fun { ppat_desc; ppat_loc; ppat_loc_stack; ppat_attributes } -> + let ppat_desc = self#pattern_desc ppat_desc in + let ppat_loc = self#location ppat_loc in + let ppat_loc_stack = self#location_stack ppat_loc_stack in + let ppat_attributes = self#attributes ppat_attributes in + self#record + [("ppat_desc", ppat_desc); + ("ppat_loc", ppat_loc); + ("ppat_loc_stack", ppat_loc_stack); + ("ppat_attributes", ppat_attributes)] method pattern_desc : pattern_desc -> 'res= - fun x -> - match x with - | Ppat_any -> self#constr "Ppat_any" [] - | Ppat_var a -> - let a = self#loc self#string a in self#constr "Ppat_var" [a] - | Ppat_alias (a,b) -> - let a = self#pattern a in - let b = self#loc self#string b in - self#constr "Ppat_alias" [a; b] - | Ppat_constant a -> - let a = self#constant a in self#constr "Ppat_constant" [a] - | Ppat_interval (a,b) -> - let a = self#constant a in - let b = self#constant b in self#constr "Ppat_interval" [a; b] - | Ppat_tuple a -> - let a = self#list self#pattern a in self#constr "Ppat_tuple" [a] - | Ppat_construct (a,b) -> - let a = self#longident_loc a in - let b = self#option self#pattern b in - self#constr "Ppat_construct" [a; b] - | Ppat_variant (a,b) -> - let a = self#label a in - let b = self#option self#pattern b in - self#constr "Ppat_variant" [a; b] - | Ppat_record (a,b) -> - let a = - self#list - (fun (a,b) -> - let a = self#longident_loc a in - let b = self#pattern b in self#tuple [a; b]) a - in - let b = self#closed_flag b in self#constr "Ppat_record" [a; b] - | Ppat_array a -> - let a = self#list self#pattern a in self#constr "Ppat_array" [a] - | Ppat_or (a,b) -> - let a = self#pattern a in - let b = self#pattern b in self#constr "Ppat_or" [a; b] - | Ppat_constraint (a,b) -> - let a = self#pattern a in - let b = self#core_type b in self#constr "Ppat_constraint" [a; b] - | Ppat_type a -> - let a = self#longident_loc a in self#constr "Ppat_type" [a] - | Ppat_lazy a -> - let a = self#pattern a in self#constr "Ppat_lazy" [a] - | Ppat_unpack a -> - let a = self#loc self#string a in self#constr "Ppat_unpack" [a] - | Ppat_exception a -> - let a = self#pattern a in self#constr "Ppat_exception" [a] - | Ppat_extension a -> - let a = self#extension a in self#constr "Ppat_extension" [a] - | Ppat_open (a,b) -> - let a = self#longident_loc a in - let b = self#pattern b in self#constr "Ppat_open" [a; b] + fun x -> + match x with + | Ppat_any -> self#constr "Ppat_any" [] + | Ppat_var a -> + let a = self#loc self#string a in self#constr "Ppat_var" [a] + | Ppat_alias (a, b) -> + let a = self#pattern a in + let b = self#loc self#string b in self#constr "Ppat_alias" [a; b] + | Ppat_constant a -> + let a = self#constant a in self#constr "Ppat_constant" [a] + | Ppat_interval (a, b) -> + let a = self#constant a in + let b = self#constant b in self#constr "Ppat_interval" [a; b] + | Ppat_tuple a -> + let a = self#list self#pattern a in self#constr "Ppat_tuple" [a] + | Ppat_construct (a, b) -> + let a = self#longident_loc a in + let b = self#option self#pattern b in + self#constr "Ppat_construct" [a; b] + | Ppat_variant (a, b) -> + let a = self#label a in + let b = self#option self#pattern b in + self#constr "Ppat_variant" [a; b] + | Ppat_record (a, b) -> + let a = + self#list + (fun (a, b) -> + let a = self#longident_loc a in + let b = self#pattern b in self#tuple [a; b]) a in + let b = self#closed_flag b in self#constr "Ppat_record" [a; b] + | Ppat_array a -> + let a = self#list self#pattern a in self#constr "Ppat_array" [a] + | Ppat_or (a, b) -> + let a = self#pattern a in + let b = self#pattern b in self#constr "Ppat_or" [a; b] + | Ppat_constraint (a, b) -> + let a = self#pattern a in + let b = self#core_type b in self#constr "Ppat_constraint" [a; b] + | Ppat_type a -> + let a = self#longident_loc a in self#constr "Ppat_type" [a] + | Ppat_lazy a -> + let a = self#pattern a in self#constr "Ppat_lazy" [a] + | Ppat_unpack a -> + let a = self#loc self#string a in self#constr "Ppat_unpack" [a] + | Ppat_exception a -> + let a = self#pattern a in self#constr "Ppat_exception" [a] + | Ppat_extension a -> + let a = self#extension a in self#constr "Ppat_extension" [a] + | Ppat_open (a, b) -> + let a = self#longident_loc a in + let b = self#pattern b in self#constr "Ppat_open" [a; b] method expression : expression -> 'res= - fun { pexp_desc; pexp_loc; pexp_attributes } -> - let pexp_desc = self#expression_desc pexp_desc in - let pexp_loc = self#location pexp_loc in - let pexp_attributes = self#attributes pexp_attributes in - self#record - [("pexp_desc", pexp_desc); - ("pexp_loc", pexp_loc); - ("pexp_attributes", pexp_attributes)] + fun { pexp_desc; pexp_loc; pexp_loc_stack; pexp_attributes } -> + let pexp_desc = self#expression_desc pexp_desc in + let pexp_loc = self#location pexp_loc in + let pexp_loc_stack = self#location_stack pexp_loc_stack in + let pexp_attributes = self#attributes pexp_attributes in + self#record + [("pexp_desc", pexp_desc); + ("pexp_loc", pexp_loc); + ("pexp_loc_stack", pexp_loc_stack); + ("pexp_attributes", pexp_attributes)] method expression_desc : expression_desc -> 'res= - fun x -> - match x with - | Pexp_ident a -> - let a = self#longident_loc a in self#constr "Pexp_ident" [a] - | Pexp_constant a -> - let a = self#constant a in self#constr "Pexp_constant" [a] - | Pexp_let (a,b,c) -> - let a = self#rec_flag a in - let b = self#list self#value_binding b in - let c = self#expression c in self#constr "Pexp_let" [a; b; c] - | Pexp_function a -> - let a = self#list self#case a in self#constr "Pexp_function" [a] - | Pexp_fun (a,b,c,d) -> - let a = self#arg_label a in - let b = self#option self#expression b in - let c = self#pattern c in - let d = self#expression d in self#constr "Pexp_fun" [a; b; c; d] - | Pexp_apply (a,b) -> - let a = self#expression a in - let b = - self#list - (fun (a,b) -> - let a = self#arg_label a in - let b = self#expression b in self#tuple [a; b]) b - in - self#constr "Pexp_apply" [a; b] - | Pexp_match (a,b) -> - let a = self#expression a in - let b = self#list self#case b in self#constr "Pexp_match" [a; b] - | Pexp_try (a,b) -> - let a = self#expression a in - let b = self#list self#case b in self#constr "Pexp_try" [a; b] - | Pexp_tuple a -> - let a = self#list self#expression a in - self#constr "Pexp_tuple" [a] - | Pexp_construct (a,b) -> - let a = self#longident_loc a in - let b = self#option self#expression b in - self#constr "Pexp_construct" [a; b] - | Pexp_variant (a,b) -> - let a = self#label a in - let b = self#option self#expression b in - self#constr "Pexp_variant" [a; b] - | Pexp_record (a,b) -> - let a = - self#list - (fun (a,b) -> - let a = self#longident_loc a in - let b = self#expression b in self#tuple [a; b]) a - in - let b = self#option self#expression b in - self#constr "Pexp_record" [a; b] - | Pexp_field (a,b) -> - let a = self#expression a in - let b = self#longident_loc b in self#constr "Pexp_field" [a; b] - | Pexp_setfield (a,b,c) -> - let a = self#expression a in - let b = self#longident_loc b in - let c = self#expression c in - self#constr "Pexp_setfield" [a; b; c] - | Pexp_array a -> - let a = self#list self#expression a in - self#constr "Pexp_array" [a] - | Pexp_ifthenelse (a,b,c) -> - let a = self#expression a in - let b = self#expression b in - let c = self#option self#expression c in - self#constr "Pexp_ifthenelse" [a; b; c] - | Pexp_sequence (a,b) -> - let a = self#expression a in - let b = self#expression b in self#constr "Pexp_sequence" [a; b] - | Pexp_while (a,b) -> - let a = self#expression a in - let b = self#expression b in self#constr "Pexp_while" [a; b] - | Pexp_for (a,b,c,d,e) -> - let a = self#pattern a in - let b = self#expression b in - let c = self#expression c in - let d = self#direction_flag d in - let e = self#expression e in - self#constr "Pexp_for" [a; b; c; d; e] - | Pexp_constraint (a,b) -> - let a = self#expression a in - let b = self#core_type b in self#constr "Pexp_constraint" [a; b] - | Pexp_coerce (a,b,c) -> - let a = self#expression a in - let b = self#option self#core_type b in - let c = self#core_type c in self#constr "Pexp_coerce" [a; b; c] - | Pexp_send (a,b) -> - let a = self#expression a in - let b = self#loc self#label b in self#constr "Pexp_send" [a; b] - | Pexp_new a -> - let a = self#longident_loc a in self#constr "Pexp_new" [a] - | Pexp_setinstvar (a,b) -> - let a = self#loc self#label a in - let b = self#expression b in - self#constr "Pexp_setinstvar" [a; b] - | Pexp_override a -> - let a = - self#list - (fun (a,b) -> - let a = self#loc self#label a in - let b = self#expression b in self#tuple [a; b]) a - in - self#constr "Pexp_override" [a] - | Pexp_letmodule (a,b,c) -> - let a = self#loc self#string a in - let b = self#module_expr b in - let c = self#expression c in - self#constr "Pexp_letmodule" [a; b; c] - | Pexp_letexception (a,b) -> - let a = self#extension_constructor a in - let b = self#expression b in - self#constr "Pexp_letexception" [a; b] - | Pexp_assert a -> - let a = self#expression a in self#constr "Pexp_assert" [a] - | Pexp_lazy a -> - let a = self#expression a in self#constr "Pexp_lazy" [a] - | Pexp_poly (a,b) -> - let a = self#expression a in - let b = self#option self#core_type b in - self#constr "Pexp_poly" [a; b] - | Pexp_object a -> - let a = self#class_structure a in self#constr "Pexp_object" [a] - | Pexp_newtype (a,b) -> - let a = self#loc self#string a in - let b = self#expression b in self#constr "Pexp_newtype" [a; b] - | Pexp_pack a -> - let a = self#module_expr a in self#constr "Pexp_pack" [a] - | Pexp_open (a,b,c) -> - let a = self#override_flag a in - let b = self#longident_loc b in - let c = self#expression c in self#constr "Pexp_open" [a; b; c] - | Pexp_extension a -> - let a = self#extension a in self#constr "Pexp_extension" [a] - | Pexp_unreachable -> self#constr "Pexp_unreachable" [] + fun x -> + match x with + | Pexp_ident a -> + let a = self#longident_loc a in self#constr "Pexp_ident" [a] + | Pexp_constant a -> + let a = self#constant a in self#constr "Pexp_constant" [a] + | Pexp_let (a, b, c) -> + let a = self#rec_flag a in + let b = self#list self#value_binding b in + let c = self#expression c in self#constr "Pexp_let" [a; b; c] + | Pexp_function a -> + let a = self#list self#case a in self#constr "Pexp_function" [a] + | Pexp_fun (a, b, c, d) -> + let a = self#arg_label a in + let b = self#option self#expression b in + let c = self#pattern c in + let d = self#expression d in self#constr "Pexp_fun" [a; b; c; d] + | Pexp_apply (a, b) -> + let a = self#expression a in + let b = + self#list + (fun (a, b) -> + let a = self#arg_label a in + let b = self#expression b in self#tuple [a; b]) b in + self#constr "Pexp_apply" [a; b] + | Pexp_match (a, b) -> + let a = self#expression a in + let b = self#list self#case b in self#constr "Pexp_match" [a; b] + | Pexp_try (a, b) -> + let a = self#expression a in + let b = self#list self#case b in self#constr "Pexp_try" [a; b] + | Pexp_tuple a -> + let a = self#list self#expression a in + self#constr "Pexp_tuple" [a] + | Pexp_construct (a, b) -> + let a = self#longident_loc a in + let b = self#option self#expression b in + self#constr "Pexp_construct" [a; b] + | Pexp_variant (a, b) -> + let a = self#label a in + let b = self#option self#expression b in + self#constr "Pexp_variant" [a; b] + | Pexp_record (a, b) -> + let a = + self#list + (fun (a, b) -> + let a = self#longident_loc a in + let b = self#expression b in self#tuple [a; b]) a in + let b = self#option self#expression b in + self#constr "Pexp_record" [a; b] + | Pexp_field (a, b) -> + let a = self#expression a in + let b = self#longident_loc b in self#constr "Pexp_field" [a; b] + | Pexp_setfield (a, b, c) -> + let a = self#expression a in + let b = self#longident_loc b in + let c = self#expression c in + self#constr "Pexp_setfield" [a; b; c] + | Pexp_array a -> + let a = self#list self#expression a in + self#constr "Pexp_array" [a] + | Pexp_ifthenelse (a, b, c) -> + let a = self#expression a in + let b = self#expression b in + let c = self#option self#expression c in + self#constr "Pexp_ifthenelse" [a; b; c] + | Pexp_sequence (a, b) -> + let a = self#expression a in + let b = self#expression b in self#constr "Pexp_sequence" [a; b] + | Pexp_while (a, b) -> + let a = self#expression a in + let b = self#expression b in self#constr "Pexp_while" [a; b] + | Pexp_for (a, b, c, d, e) -> + let a = self#pattern a in + let b = self#expression b in + let c = self#expression c in + let d = self#direction_flag d in + let e = self#expression e in + self#constr "Pexp_for" [a; b; c; d; e] + | Pexp_constraint (a, b) -> + let a = self#expression a in + let b = self#core_type b in self#constr "Pexp_constraint" [a; b] + | Pexp_coerce (a, b, c) -> + let a = self#expression a in + let b = self#option self#core_type b in + let c = self#core_type c in self#constr "Pexp_coerce" [a; b; c] + | Pexp_send (a, b) -> + let a = self#expression a in + let b = self#loc self#label b in self#constr "Pexp_send" [a; b] + | Pexp_new a -> + let a = self#longident_loc a in self#constr "Pexp_new" [a] + | Pexp_setinstvar (a, b) -> + let a = self#loc self#label a in + let b = self#expression b in self#constr "Pexp_setinstvar" [a; b] + | Pexp_override a -> + let a = + self#list + (fun (a, b) -> + let a = self#loc self#label a in + let b = self#expression b in self#tuple [a; b]) a in + self#constr "Pexp_override" [a] + | Pexp_letmodule (a, b, c) -> + let a = self#loc self#string a in + let b = self#module_expr b in + let c = self#expression c in + self#constr "Pexp_letmodule" [a; b; c] + | Pexp_letexception (a, b) -> + let a = self#extension_constructor a in + let b = self#expression b in + self#constr "Pexp_letexception" [a; b] + | Pexp_assert a -> + let a = self#expression a in self#constr "Pexp_assert" [a] + | Pexp_lazy a -> + let a = self#expression a in self#constr "Pexp_lazy" [a] + | Pexp_poly (a, b) -> + let a = self#expression a in + let b = self#option self#core_type b in + self#constr "Pexp_poly" [a; b] + | Pexp_object a -> + let a = self#class_structure a in self#constr "Pexp_object" [a] + | Pexp_newtype (a, b) -> + let a = self#loc self#string a in + let b = self#expression b in self#constr "Pexp_newtype" [a; b] + | Pexp_pack a -> + let a = self#module_expr a in self#constr "Pexp_pack" [a] + | Pexp_open (a, b) -> + let a = self#open_declaration a in + let b = self#expression b in self#constr "Pexp_open" [a; b] + | Pexp_letop a -> + let a = self#letop a in self#constr "Pexp_letop" [a] + | Pexp_extension a -> + let a = self#extension a in self#constr "Pexp_extension" [a] + | Pexp_unreachable -> self#constr "Pexp_unreachable" [] method case : case -> 'res= - fun { pc_lhs; pc_guard; pc_rhs } -> - let pc_lhs = self#pattern pc_lhs in - let pc_guard = self#option self#expression pc_guard in - let pc_rhs = self#expression pc_rhs in - self#record - [("pc_lhs", pc_lhs); ("pc_guard", pc_guard); ("pc_rhs", pc_rhs)] + fun { pc_lhs; pc_guard; pc_rhs } -> + let pc_lhs = self#pattern pc_lhs in + let pc_guard = self#option self#expression pc_guard in + let pc_rhs = self#expression pc_rhs in + self#record + [("pc_lhs", pc_lhs); ("pc_guard", pc_guard); ("pc_rhs", pc_rhs)] + method letop : letop -> 'res= + fun { let_; ands; body } -> + let let_ = self#binding_op let_ in + let ands = self#list self#binding_op ands in + let body = self#expression body in + self#record [("let_", let_); ("ands", ands); ("body", body)] + method binding_op : binding_op -> 'res= + fun { pbop_op; pbop_pat; pbop_exp; pbop_loc } -> + let pbop_op = self#loc self#string pbop_op in + let pbop_pat = self#pattern pbop_pat in + let pbop_exp = self#expression pbop_exp in + let pbop_loc = self#location pbop_loc in + self#record + [("pbop_op", pbop_op); + ("pbop_pat", pbop_pat); + ("pbop_exp", pbop_exp); + ("pbop_loc", pbop_loc)] method value_description : value_description -> 'res= - fun { pval_name; pval_type; pval_prim; pval_attributes; pval_loc } -> - let pval_name = self#loc self#string pval_name in - let pval_type = self#core_type pval_type in - let pval_prim = self#list self#string pval_prim in - let pval_attributes = self#attributes pval_attributes in - let pval_loc = self#location pval_loc in - self#record - [("pval_name", pval_name); - ("pval_type", pval_type); - ("pval_prim", pval_prim); - ("pval_attributes", pval_attributes); - ("pval_loc", pval_loc)] + fun { pval_name; pval_type; pval_prim; pval_attributes; pval_loc } -> + let pval_name = self#loc self#string pval_name in + let pval_type = self#core_type pval_type in + let pval_prim = self#list self#string pval_prim in + let pval_attributes = self#attributes pval_attributes in + let pval_loc = self#location pval_loc in + self#record + [("pval_name", pval_name); + ("pval_type", pval_type); + ("pval_prim", pval_prim); + ("pval_attributes", pval_attributes); + ("pval_loc", pval_loc)] method type_declaration : type_declaration -> 'res= fun { ptype_name; ptype_params; ptype_cstrs; ptype_kind; ptype_private; ptype_manifest; ptype_attributes; ptype_loc } - -> - let ptype_name = self#loc self#string ptype_name in - let ptype_params = - self#list - (fun (a,b) -> - let a = self#core_type a in - let b = self#variance b in self#tuple [a; b]) ptype_params - in - let ptype_cstrs = - self#list - (fun (a,b,c) -> - let a = self#core_type a in - let b = self#core_type b in - let c = self#location c in self#tuple [a; b; c]) ptype_cstrs - in - let ptype_kind = self#type_kind ptype_kind in - let ptype_private = self#private_flag ptype_private in - let ptype_manifest = self#option self#core_type ptype_manifest in - let ptype_attributes = self#attributes ptype_attributes in - let ptype_loc = self#location ptype_loc in - self#record - [("ptype_name", ptype_name); - ("ptype_params", ptype_params); - ("ptype_cstrs", ptype_cstrs); - ("ptype_kind", ptype_kind); - ("ptype_private", ptype_private); - ("ptype_manifest", ptype_manifest); - ("ptype_attributes", ptype_attributes); - ("ptype_loc", ptype_loc)] + -> + let ptype_name = self#loc self#string ptype_name in + let ptype_params = + self#list + (fun (a, b) -> + let a = self#core_type a in + let b = self#variance b in self#tuple [a; b]) ptype_params in + let ptype_cstrs = + self#list + (fun (a, b, c) -> + let a = self#core_type a in + let b = self#core_type b in + let c = self#location c in self#tuple [a; b; c]) ptype_cstrs in + let ptype_kind = self#type_kind ptype_kind in + let ptype_private = self#private_flag ptype_private in + let ptype_manifest = self#option self#core_type ptype_manifest in + let ptype_attributes = self#attributes ptype_attributes in + let ptype_loc = self#location ptype_loc in + self#record + [("ptype_name", ptype_name); + ("ptype_params", ptype_params); + ("ptype_cstrs", ptype_cstrs); + ("ptype_kind", ptype_kind); + ("ptype_private", ptype_private); + ("ptype_manifest", ptype_manifest); + ("ptype_attributes", ptype_attributes); + ("ptype_loc", ptype_loc)] method type_kind : type_kind -> 'res= - fun x -> - match x with - | Ptype_abstract -> self#constr "Ptype_abstract" [] - | Ptype_variant a -> - let a = self#list self#constructor_declaration a in - self#constr "Ptype_variant" [a] - | Ptype_record a -> - let a = self#list self#label_declaration a in - self#constr "Ptype_record" [a] - | Ptype_open -> self#constr "Ptype_open" [] + fun x -> + match x with + | Ptype_abstract -> self#constr "Ptype_abstract" [] + | Ptype_variant a -> + let a = self#list self#constructor_declaration a in + self#constr "Ptype_variant" [a] + | Ptype_record a -> + let a = self#list self#label_declaration a in + self#constr "Ptype_record" [a] + | Ptype_open -> self#constr "Ptype_open" [] method label_declaration : label_declaration -> 'res= - fun { pld_name; pld_mutable; pld_type; pld_loc; pld_attributes } -> - let pld_name = self#loc self#string pld_name in - let pld_mutable = self#mutable_flag pld_mutable in - let pld_type = self#core_type pld_type in - let pld_loc = self#location pld_loc in - let pld_attributes = self#attributes pld_attributes in - self#record - [("pld_name", pld_name); - ("pld_mutable", pld_mutable); - ("pld_type", pld_type); - ("pld_loc", pld_loc); - ("pld_attributes", pld_attributes)] + fun { pld_name; pld_mutable; pld_type; pld_loc; pld_attributes } -> + let pld_name = self#loc self#string pld_name in + let pld_mutable = self#mutable_flag pld_mutable in + let pld_type = self#core_type pld_type in + let pld_loc = self#location pld_loc in + let pld_attributes = self#attributes pld_attributes in + self#record + [("pld_name", pld_name); + ("pld_mutable", pld_mutable); + ("pld_type", pld_type); + ("pld_loc", pld_loc); + ("pld_attributes", pld_attributes)] method constructor_declaration : constructor_declaration -> 'res= - fun { pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes } -> - let pcd_name = self#loc self#string pcd_name in - let pcd_args = self#constructor_arguments pcd_args in - let pcd_res = self#option self#core_type pcd_res in - let pcd_loc = self#location pcd_loc in - let pcd_attributes = self#attributes pcd_attributes in - self#record - [("pcd_name", pcd_name); - ("pcd_args", pcd_args); - ("pcd_res", pcd_res); - ("pcd_loc", pcd_loc); - ("pcd_attributes", pcd_attributes)] + fun { pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes } -> + let pcd_name = self#loc self#string pcd_name in + let pcd_args = self#constructor_arguments pcd_args in + let pcd_res = self#option self#core_type pcd_res in + let pcd_loc = self#location pcd_loc in + let pcd_attributes = self#attributes pcd_attributes in + self#record + [("pcd_name", pcd_name); + ("pcd_args", pcd_args); + ("pcd_res", pcd_res); + ("pcd_loc", pcd_loc); + ("pcd_attributes", pcd_attributes)] method constructor_arguments : constructor_arguments -> 'res= - fun x -> - match x with - | Pcstr_tuple a -> - let a = self#list self#core_type a in - self#constr "Pcstr_tuple" [a] - | Pcstr_record a -> - let a = self#list self#label_declaration a in - self#constr "Pcstr_record" [a] + fun x -> + match x with + | Pcstr_tuple a -> + let a = self#list self#core_type a in + self#constr "Pcstr_tuple" [a] + | Pcstr_record a -> + let a = self#list self#label_declaration a in + self#constr "Pcstr_record" [a] method type_extension : type_extension -> 'res= fun { ptyext_path; ptyext_params; ptyext_constructors; ptyext_private; - ptyext_attributes } - -> - let ptyext_path = self#longident_loc ptyext_path in - let ptyext_params = - self#list - (fun (a,b) -> - let a = self#core_type a in - let b = self#variance b in self#tuple [a; b]) ptyext_params - in - let ptyext_constructors = - self#list self#extension_constructor ptyext_constructors in - let ptyext_private = self#private_flag ptyext_private in - let ptyext_attributes = self#attributes ptyext_attributes in - self#record - [("ptyext_path", ptyext_path); - ("ptyext_params", ptyext_params); - ("ptyext_constructors", ptyext_constructors); - ("ptyext_private", ptyext_private); - ("ptyext_attributes", ptyext_attributes)] + ptyext_loc; ptyext_attributes } + -> + let ptyext_path = self#longident_loc ptyext_path in + let ptyext_params = + self#list + (fun (a, b) -> + let a = self#core_type a in + let b = self#variance b in self#tuple [a; b]) ptyext_params in + let ptyext_constructors = + self#list self#extension_constructor ptyext_constructors in + let ptyext_private = self#private_flag ptyext_private in + let ptyext_loc = self#location ptyext_loc in + let ptyext_attributes = self#attributes ptyext_attributes in + self#record + [("ptyext_path", ptyext_path); + ("ptyext_params", ptyext_params); + ("ptyext_constructors", ptyext_constructors); + ("ptyext_private", ptyext_private); + ("ptyext_loc", ptyext_loc); + ("ptyext_attributes", ptyext_attributes)] method extension_constructor : extension_constructor -> 'res= - fun { pext_name; pext_kind; pext_loc; pext_attributes } -> - let pext_name = self#loc self#string pext_name in - let pext_kind = self#extension_constructor_kind pext_kind in - let pext_loc = self#location pext_loc in - let pext_attributes = self#attributes pext_attributes in - self#record - [("pext_name", pext_name); - ("pext_kind", pext_kind); - ("pext_loc", pext_loc); - ("pext_attributes", pext_attributes)] + fun { pext_name; pext_kind; pext_loc; pext_attributes } -> + let pext_name = self#loc self#string pext_name in + let pext_kind = self#extension_constructor_kind pext_kind in + let pext_loc = self#location pext_loc in + let pext_attributes = self#attributes pext_attributes in + self#record + [("pext_name", pext_name); + ("pext_kind", pext_kind); + ("pext_loc", pext_loc); + ("pext_attributes", pext_attributes)] + method type_exception : type_exception -> 'res= + fun { ptyexn_constructor; ptyexn_loc; ptyexn_attributes } -> + let ptyexn_constructor = + self#extension_constructor ptyexn_constructor in + let ptyexn_loc = self#location ptyexn_loc in + let ptyexn_attributes = self#attributes ptyexn_attributes in + self#record + [("ptyexn_constructor", ptyexn_constructor); + ("ptyexn_loc", ptyexn_loc); + ("ptyexn_attributes", ptyexn_attributes)] method extension_constructor_kind : extension_constructor_kind -> 'res= - fun x -> - match x with - | Pext_decl (a,b) -> - let a = self#constructor_arguments a in - let b = self#option self#core_type b in - self#constr "Pext_decl" [a; b] - | Pext_rebind a -> - let a = self#longident_loc a in self#constr "Pext_rebind" [a] + fun x -> + match x with + | Pext_decl (a, b) -> + let a = self#constructor_arguments a in + let b = self#option self#core_type b in + self#constr "Pext_decl" [a; b] + | Pext_rebind a -> + let a = self#longident_loc a in self#constr "Pext_rebind" [a] method class_type : class_type -> 'res= - fun { pcty_desc; pcty_loc; pcty_attributes } -> - let pcty_desc = self#class_type_desc pcty_desc in - let pcty_loc = self#location pcty_loc in - let pcty_attributes = self#attributes pcty_attributes in - self#record - [("pcty_desc", pcty_desc); - ("pcty_loc", pcty_loc); - ("pcty_attributes", pcty_attributes)] + fun { pcty_desc; pcty_loc; pcty_attributes } -> + let pcty_desc = self#class_type_desc pcty_desc in + let pcty_loc = self#location pcty_loc in + let pcty_attributes = self#attributes pcty_attributes in + self#record + [("pcty_desc", pcty_desc); + ("pcty_loc", pcty_loc); + ("pcty_attributes", pcty_attributes)] method class_type_desc : class_type_desc -> 'res= - fun x -> - match x with - | Pcty_constr (a,b) -> - let a = self#longident_loc a in - let b = self#list self#core_type b in - self#constr "Pcty_constr" [a; b] - | Pcty_signature a -> - let a = self#class_signature a in - self#constr "Pcty_signature" [a] - | Pcty_arrow (a,b,c) -> - let a = self#arg_label a in - let b = self#core_type b in - let c = self#class_type c in self#constr "Pcty_arrow" [a; b; c] - | Pcty_extension a -> - let a = self#extension a in self#constr "Pcty_extension" [a] - | Pcty_open (a,b,c) -> - let a = self#override_flag a in - let b = self#longident_loc b in - let c = self#class_type c in self#constr "Pcty_open" [a; b; c] + fun x -> + match x with + | Pcty_constr (a, b) -> + let a = self#longident_loc a in + let b = self#list self#core_type b in + self#constr "Pcty_constr" [a; b] + | Pcty_signature a -> + let a = self#class_signature a in + self#constr "Pcty_signature" [a] + | Pcty_arrow (a, b, c) -> + let a = self#arg_label a in + let b = self#core_type b in + let c = self#class_type c in self#constr "Pcty_arrow" [a; b; c] + | Pcty_extension a -> + let a = self#extension a in self#constr "Pcty_extension" [a] + | Pcty_open (a, b) -> + let a = self#open_description a in + let b = self#class_type b in self#constr "Pcty_open" [a; b] method class_signature : class_signature -> 'res= - fun { pcsig_self; pcsig_fields } -> - let pcsig_self = self#core_type pcsig_self in - let pcsig_fields = self#list self#class_type_field pcsig_fields in - self#record - [("pcsig_self", pcsig_self); ("pcsig_fields", pcsig_fields)] + fun { pcsig_self; pcsig_fields } -> + let pcsig_self = self#core_type pcsig_self in + let pcsig_fields = self#list self#class_type_field pcsig_fields in + self#record + [("pcsig_self", pcsig_self); ("pcsig_fields", pcsig_fields)] method class_type_field : class_type_field -> 'res= - fun { pctf_desc; pctf_loc; pctf_attributes } -> - let pctf_desc = self#class_type_field_desc pctf_desc in - let pctf_loc = self#location pctf_loc in - let pctf_attributes = self#attributes pctf_attributes in - self#record - [("pctf_desc", pctf_desc); - ("pctf_loc", pctf_loc); - ("pctf_attributes", pctf_attributes)] + fun { pctf_desc; pctf_loc; pctf_attributes } -> + let pctf_desc = self#class_type_field_desc pctf_desc in + let pctf_loc = self#location pctf_loc in + let pctf_attributes = self#attributes pctf_attributes in + self#record + [("pctf_desc", pctf_desc); + ("pctf_loc", pctf_loc); + ("pctf_attributes", pctf_attributes)] method class_type_field_desc : class_type_field_desc -> 'res= - fun x -> - match x with - | Pctf_inherit a -> - let a = self#class_type a in self#constr "Pctf_inherit" [a] - | Pctf_val a -> - let a = - (fun (a,b,c,d) -> - let a = self#loc self#label a in - let b = self#mutable_flag b in - let c = self#virtual_flag c in - let d = self#core_type d in self#tuple [a; b; c; d]) a - in - self#constr "Pctf_val" [a] - | Pctf_method a -> - let a = - (fun (a,b,c,d) -> - let a = self#loc self#label a in - let b = self#private_flag b in - let c = self#virtual_flag c in - let d = self#core_type d in self#tuple [a; b; c; d]) a - in - self#constr "Pctf_method" [a] - | Pctf_constraint a -> - let a = - (fun (a,b) -> - let a = self#core_type a in - let b = self#core_type b in self#tuple [a; b]) a - in - self#constr "Pctf_constraint" [a] - | Pctf_attribute a -> - let a = self#attribute a in self#constr "Pctf_attribute" [a] - | Pctf_extension a -> - let a = self#extension a in self#constr "Pctf_extension" [a] + fun x -> + match x with + | Pctf_inherit a -> + let a = self#class_type a in self#constr "Pctf_inherit" [a] + | Pctf_val a -> + let a = + (fun (a, b, c, d) -> + let a = self#loc self#label a in + let b = self#mutable_flag b in + let c = self#virtual_flag c in + let d = self#core_type d in self#tuple [a; b; c; d]) a in + self#constr "Pctf_val" [a] + | Pctf_method a -> + let a = + (fun (a, b, c, d) -> + let a = self#loc self#label a in + let b = self#private_flag b in + let c = self#virtual_flag c in + let d = self#core_type d in self#tuple [a; b; c; d]) a in + self#constr "Pctf_method" [a] + | Pctf_constraint a -> + let a = + (fun (a, b) -> + let a = self#core_type a in + let b = self#core_type b in self#tuple [a; b]) a in + self#constr "Pctf_constraint" [a] + | Pctf_attribute a -> + let a = self#attribute a in self#constr "Pctf_attribute" [a] + | Pctf_extension a -> + let a = self#extension a in self#constr "Pctf_extension" [a] method class_infos : 'a . ('a -> 'res) -> 'a class_infos -> 'res= - fun _a -> - fun - { pci_virt; pci_params; pci_name; pci_expr; pci_loc; pci_attributes - } - -> - let pci_virt = self#virtual_flag pci_virt in + fun _a -> + fun + { pci_virt; pci_params; pci_name; pci_expr; pci_loc; pci_attributes + } + -> + let pci_virt = self#virtual_flag pci_virt in let pci_params = self#list - (fun (a,b) -> - let a = self#core_type a in - let b = self#variance b in self#tuple [a; b]) pci_params - in - let pci_name = self#loc self#string pci_name in - let pci_expr = _a pci_expr in - let pci_loc = self#location pci_loc in - let pci_attributes = self#attributes pci_attributes in + (fun (a, b) -> + let a = self#core_type a in + let b = self#variance b in self#tuple [a; b]) pci_params in + let pci_name = self#loc self#string pci_name in + let pci_expr = _a pci_expr in + let pci_loc = self#location pci_loc in + let pci_attributes = self#attributes pci_attributes in self#record [("pci_virt", pci_virt); - ("pci_params", pci_params); - ("pci_name", pci_name); - ("pci_expr", pci_expr); - ("pci_loc", pci_loc); - ("pci_attributes", pci_attributes)] + ("pci_params", pci_params); + ("pci_name", pci_name); + ("pci_expr", pci_expr); + ("pci_loc", pci_loc); + ("pci_attributes", pci_attributes)] method class_description : class_description -> 'res= self#class_infos self#class_type method class_type_declaration : class_type_declaration -> 'res= self#class_infos self#class_type method class_expr : class_expr -> 'res= - fun { pcl_desc; pcl_loc; pcl_attributes } -> - let pcl_desc = self#class_expr_desc pcl_desc in - let pcl_loc = self#location pcl_loc in - let pcl_attributes = self#attributes pcl_attributes in - self#record - [("pcl_desc", pcl_desc); - ("pcl_loc", pcl_loc); - ("pcl_attributes", pcl_attributes)] + fun { pcl_desc; pcl_loc; pcl_attributes } -> + let pcl_desc = self#class_expr_desc pcl_desc in + let pcl_loc = self#location pcl_loc in + let pcl_attributes = self#attributes pcl_attributes in + self#record + [("pcl_desc", pcl_desc); + ("pcl_loc", pcl_loc); + ("pcl_attributes", pcl_attributes)] method class_expr_desc : class_expr_desc -> 'res= - fun x -> - match x with - | Pcl_constr (a,b) -> - let a = self#longident_loc a in - let b = self#list self#core_type b in - self#constr "Pcl_constr" [a; b] - | Pcl_structure a -> - let a = self#class_structure a in - self#constr "Pcl_structure" [a] - | Pcl_fun (a,b,c,d) -> - let a = self#arg_label a in - let b = self#option self#expression b in - let c = self#pattern c in - let d = self#class_expr d in self#constr "Pcl_fun" [a; b; c; d] - | Pcl_apply (a,b) -> - let a = self#class_expr a in - let b = - self#list - (fun (a,b) -> - let a = self#arg_label a in - let b = self#expression b in self#tuple [a; b]) b - in - self#constr "Pcl_apply" [a; b] - | Pcl_let (a,b,c) -> - let a = self#rec_flag a in - let b = self#list self#value_binding b in - let c = self#class_expr c in self#constr "Pcl_let" [a; b; c] - | Pcl_constraint (a,b) -> - let a = self#class_expr a in - let b = self#class_type b in self#constr "Pcl_constraint" [a; b] - | Pcl_extension a -> - let a = self#extension a in self#constr "Pcl_extension" [a] - | Pcl_open (a,b,c) -> - let a = self#override_flag a in - let b = self#longident_loc b in - let c = self#class_expr c in self#constr "Pcl_open" [a; b; c] + fun x -> + match x with + | Pcl_constr (a, b) -> + let a = self#longident_loc a in + let b = self#list self#core_type b in + self#constr "Pcl_constr" [a; b] + | Pcl_structure a -> + let a = self#class_structure a in self#constr "Pcl_structure" [a] + | Pcl_fun (a, b, c, d) -> + let a = self#arg_label a in + let b = self#option self#expression b in + let c = self#pattern c in + let d = self#class_expr d in self#constr "Pcl_fun" [a; b; c; d] + | Pcl_apply (a, b) -> + let a = self#class_expr a in + let b = + self#list + (fun (a, b) -> + let a = self#arg_label a in + let b = self#expression b in self#tuple [a; b]) b in + self#constr "Pcl_apply" [a; b] + | Pcl_let (a, b, c) -> + let a = self#rec_flag a in + let b = self#list self#value_binding b in + let c = self#class_expr c in self#constr "Pcl_let" [a; b; c] + | Pcl_constraint (a, b) -> + let a = self#class_expr a in + let b = self#class_type b in self#constr "Pcl_constraint" [a; b] + | Pcl_extension a -> + let a = self#extension a in self#constr "Pcl_extension" [a] + | Pcl_open (a, b) -> + let a = self#open_description a in + let b = self#class_expr b in self#constr "Pcl_open" [a; b] method class_structure : class_structure -> 'res= - fun { pcstr_self; pcstr_fields } -> - let pcstr_self = self#pattern pcstr_self in - let pcstr_fields = self#list self#class_field pcstr_fields in - self#record - [("pcstr_self", pcstr_self); ("pcstr_fields", pcstr_fields)] + fun { pcstr_self; pcstr_fields } -> + let pcstr_self = self#pattern pcstr_self in + let pcstr_fields = self#list self#class_field pcstr_fields in + self#record + [("pcstr_self", pcstr_self); ("pcstr_fields", pcstr_fields)] method class_field : class_field -> 'res= - fun { pcf_desc; pcf_loc; pcf_attributes } -> - let pcf_desc = self#class_field_desc pcf_desc in - let pcf_loc = self#location pcf_loc in - let pcf_attributes = self#attributes pcf_attributes in - self#record - [("pcf_desc", pcf_desc); - ("pcf_loc", pcf_loc); - ("pcf_attributes", pcf_attributes)] + fun { pcf_desc; pcf_loc; pcf_attributes } -> + let pcf_desc = self#class_field_desc pcf_desc in + let pcf_loc = self#location pcf_loc in + let pcf_attributes = self#attributes pcf_attributes in + self#record + [("pcf_desc", pcf_desc); + ("pcf_loc", pcf_loc); + ("pcf_attributes", pcf_attributes)] method class_field_desc : class_field_desc -> 'res= - fun x -> - match x with - | Pcf_inherit (a,b,c) -> - let a = self#override_flag a in - let b = self#class_expr b in - let c = self#option (self#loc self#string) c in - self#constr "Pcf_inherit" [a; b; c] - | Pcf_val a -> - let a = - (fun (a,b,c) -> - let a = self#loc self#label a in - let b = self#mutable_flag b in - let c = self#class_field_kind c in self#tuple [a; b; c]) a - in - self#constr "Pcf_val" [a] - | Pcf_method a -> - let a = - (fun (a,b,c) -> - let a = self#loc self#label a in - let b = self#private_flag b in - let c = self#class_field_kind c in self#tuple [a; b; c]) a - in - self#constr "Pcf_method" [a] - | Pcf_constraint a -> - let a = - (fun (a,b) -> - let a = self#core_type a in - let b = self#core_type b in self#tuple [a; b]) a - in - self#constr "Pcf_constraint" [a] - | Pcf_initializer a -> - let a = self#expression a in self#constr "Pcf_initializer" [a] - | Pcf_attribute a -> - let a = self#attribute a in self#constr "Pcf_attribute" [a] - | Pcf_extension a -> - let a = self#extension a in self#constr "Pcf_extension" [a] + fun x -> + match x with + | Pcf_inherit (a, b, c) -> + let a = self#override_flag a in + let b = self#class_expr b in + let c = self#option (self#loc self#string) c in + self#constr "Pcf_inherit" [a; b; c] + | Pcf_val a -> + let a = + (fun (a, b, c) -> + let a = self#loc self#label a in + let b = self#mutable_flag b in + let c = self#class_field_kind c in self#tuple [a; b; c]) a in + self#constr "Pcf_val" [a] + | Pcf_method a -> + let a = + (fun (a, b, c) -> + let a = self#loc self#label a in + let b = self#private_flag b in + let c = self#class_field_kind c in self#tuple [a; b; c]) a in + self#constr "Pcf_method" [a] + | Pcf_constraint a -> + let a = + (fun (a, b) -> + let a = self#core_type a in + let b = self#core_type b in self#tuple [a; b]) a in + self#constr "Pcf_constraint" [a] + | Pcf_initializer a -> + let a = self#expression a in self#constr "Pcf_initializer" [a] + | Pcf_attribute a -> + let a = self#attribute a in self#constr "Pcf_attribute" [a] + | Pcf_extension a -> + let a = self#extension a in self#constr "Pcf_extension" [a] method class_field_kind : class_field_kind -> 'res= - fun x -> - match x with - | Cfk_virtual a -> - let a = self#core_type a in self#constr "Cfk_virtual" [a] - | Cfk_concrete (a,b) -> - let a = self#override_flag a in - let b = self#expression b in self#constr "Cfk_concrete" [a; b] + fun x -> + match x with + | Cfk_virtual a -> + let a = self#core_type a in self#constr "Cfk_virtual" [a] + | Cfk_concrete (a, b) -> + let a = self#override_flag a in + let b = self#expression b in self#constr "Cfk_concrete" [a; b] method class_declaration : class_declaration -> 'res= self#class_infos self#class_expr method module_type : module_type -> 'res= - fun { pmty_desc; pmty_loc; pmty_attributes } -> - let pmty_desc = self#module_type_desc pmty_desc in - let pmty_loc = self#location pmty_loc in - let pmty_attributes = self#attributes pmty_attributes in - self#record - [("pmty_desc", pmty_desc); - ("pmty_loc", pmty_loc); - ("pmty_attributes", pmty_attributes)] + fun { pmty_desc; pmty_loc; pmty_attributes } -> + let pmty_desc = self#module_type_desc pmty_desc in + let pmty_loc = self#location pmty_loc in + let pmty_attributes = self#attributes pmty_attributes in + self#record + [("pmty_desc", pmty_desc); + ("pmty_loc", pmty_loc); + ("pmty_attributes", pmty_attributes)] method module_type_desc : module_type_desc -> 'res= - fun x -> - match x with - | Pmty_ident a -> - let a = self#longident_loc a in self#constr "Pmty_ident" [a] - | Pmty_signature a -> - let a = self#signature a in self#constr "Pmty_signature" [a] - | Pmty_functor (a,b,c) -> - let a = self#loc self#string a in - let b = self#option self#module_type b in - let c = self#module_type c in - self#constr "Pmty_functor" [a; b; c] - | Pmty_with (a,b) -> - let a = self#module_type a in - let b = self#list self#with_constraint b in - self#constr "Pmty_with" [a; b] - | Pmty_typeof a -> - let a = self#module_expr a in self#constr "Pmty_typeof" [a] - | Pmty_extension a -> - let a = self#extension a in self#constr "Pmty_extension" [a] - | Pmty_alias a -> - let a = self#longident_loc a in self#constr "Pmty_alias" [a] + fun x -> + match x with + | Pmty_ident a -> + let a = self#longident_loc a in self#constr "Pmty_ident" [a] + | Pmty_signature a -> + let a = self#signature a in self#constr "Pmty_signature" [a] + | Pmty_functor (a, b, c) -> + let a = self#loc self#string a in + let b = self#option self#module_type b in + let c = self#module_type c in + self#constr "Pmty_functor" [a; b; c] + | Pmty_with (a, b) -> + let a = self#module_type a in + let b = self#list self#with_constraint b in + self#constr "Pmty_with" [a; b] + | Pmty_typeof a -> + let a = self#module_expr a in self#constr "Pmty_typeof" [a] + | Pmty_extension a -> + let a = self#extension a in self#constr "Pmty_extension" [a] + | Pmty_alias a -> + let a = self#longident_loc a in self#constr "Pmty_alias" [a] method signature : signature -> 'res= self#list self#signature_item method signature_item : signature_item -> 'res= - fun { psig_desc; psig_loc } -> - let psig_desc = self#signature_item_desc psig_desc in - let psig_loc = self#location psig_loc in - self#record [("psig_desc", psig_desc); ("psig_loc", psig_loc)] + fun { psig_desc; psig_loc } -> + let psig_desc = self#signature_item_desc psig_desc in + let psig_loc = self#location psig_loc in + self#record [("psig_desc", psig_desc); ("psig_loc", psig_loc)] method signature_item_desc : signature_item_desc -> 'res= - fun x -> - match x with - | Psig_value a -> - let a = self#value_description a in self#constr "Psig_value" [a] - | Psig_type (a,b) -> - let a = self#rec_flag a in - let b = self#list self#type_declaration b in - self#constr "Psig_type" [a; b] - | Psig_typext a -> - let a = self#type_extension a in self#constr "Psig_typext" [a] - | Psig_exception a -> - let a = self#extension_constructor a in - self#constr "Psig_exception" [a] - | Psig_module a -> - let a = self#module_declaration a in - self#constr "Psig_module" [a] - | Psig_recmodule a -> - let a = self#list self#module_declaration a in - self#constr "Psig_recmodule" [a] - | Psig_modtype a -> - let a = self#module_type_declaration a in - self#constr "Psig_modtype" [a] - | Psig_open a -> - let a = self#open_description a in self#constr "Psig_open" [a] - | Psig_include a -> - let a = self#include_description a in - self#constr "Psig_include" [a] - | Psig_class a -> - let a = self#list self#class_description a in - self#constr "Psig_class" [a] - | Psig_class_type a -> - let a = self#list self#class_type_declaration a in - self#constr "Psig_class_type" [a] - | Psig_attribute a -> - let a = self#attribute a in self#constr "Psig_attribute" [a] - | Psig_extension (a,b) -> - let a = self#extension a in - let b = self#attributes b in self#constr "Psig_extension" [a; b] + fun x -> + match x with + | Psig_value a -> + let a = self#value_description a in self#constr "Psig_value" [a] + | Psig_type (a, b) -> + let a = self#rec_flag a in + let b = self#list self#type_declaration b in + self#constr "Psig_type" [a; b] + | Psig_typesubst a -> + let a = self#list self#type_declaration a in + self#constr "Psig_typesubst" [a] + | Psig_typext a -> + let a = self#type_extension a in self#constr "Psig_typext" [a] + | Psig_exception a -> + let a = self#type_exception a in self#constr "Psig_exception" [a] + | Psig_module a -> + let a = self#module_declaration a in + self#constr "Psig_module" [a] + | Psig_modsubst a -> + let a = self#module_substitution a in + self#constr "Psig_modsubst" [a] + | Psig_recmodule a -> + let a = self#list self#module_declaration a in + self#constr "Psig_recmodule" [a] + | Psig_modtype a -> + let a = self#module_type_declaration a in + self#constr "Psig_modtype" [a] + | Psig_open a -> + let a = self#open_description a in self#constr "Psig_open" [a] + | Psig_include a -> + let a = self#include_description a in + self#constr "Psig_include" [a] + | Psig_class a -> + let a = self#list self#class_description a in + self#constr "Psig_class" [a] + | Psig_class_type a -> + let a = self#list self#class_type_declaration a in + self#constr "Psig_class_type" [a] + | Psig_attribute a -> + let a = self#attribute a in self#constr "Psig_attribute" [a] + | Psig_extension (a, b) -> + let a = self#extension a in + let b = self#attributes b in self#constr "Psig_extension" [a; b] method module_declaration : module_declaration -> 'res= - fun { pmd_name; pmd_type; pmd_attributes; pmd_loc } -> - let pmd_name = self#loc self#string pmd_name in - let pmd_type = self#module_type pmd_type in - let pmd_attributes = self#attributes pmd_attributes in - let pmd_loc = self#location pmd_loc in - self#record - [("pmd_name", pmd_name); - ("pmd_type", pmd_type); - ("pmd_attributes", pmd_attributes); - ("pmd_loc", pmd_loc)] + fun { pmd_name; pmd_type; pmd_attributes; pmd_loc } -> + let pmd_name = self#loc self#string pmd_name in + let pmd_type = self#module_type pmd_type in + let pmd_attributes = self#attributes pmd_attributes in + let pmd_loc = self#location pmd_loc in + self#record + [("pmd_name", pmd_name); + ("pmd_type", pmd_type); + ("pmd_attributes", pmd_attributes); + ("pmd_loc", pmd_loc)] + method module_substitution : module_substitution -> 'res= + fun { pms_name; pms_manifest; pms_attributes; pms_loc } -> + let pms_name = self#loc self#string pms_name in + let pms_manifest = self#longident_loc pms_manifest in + let pms_attributes = self#attributes pms_attributes in + let pms_loc = self#location pms_loc in + self#record + [("pms_name", pms_name); + ("pms_manifest", pms_manifest); + ("pms_attributes", pms_attributes); + ("pms_loc", pms_loc)] method module_type_declaration : module_type_declaration -> 'res= - fun { pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc } -> - let pmtd_name = self#loc self#string pmtd_name in - let pmtd_type = self#option self#module_type pmtd_type in - let pmtd_attributes = self#attributes pmtd_attributes in - let pmtd_loc = self#location pmtd_loc in - self#record - [("pmtd_name", pmtd_name); - ("pmtd_type", pmtd_type); - ("pmtd_attributes", pmtd_attributes); - ("pmtd_loc", pmtd_loc)] + fun { pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc } -> + let pmtd_name = self#loc self#string pmtd_name in + let pmtd_type = self#option self#module_type pmtd_type in + let pmtd_attributes = self#attributes pmtd_attributes in + let pmtd_loc = self#location pmtd_loc in + self#record + [("pmtd_name", pmtd_name); + ("pmtd_type", pmtd_type); + ("pmtd_attributes", pmtd_attributes); + ("pmtd_loc", pmtd_loc)] + method open_infos : 'a . ('a -> 'res) -> 'a open_infos -> 'res= + fun _a -> + fun { popen_expr; popen_override; popen_loc; popen_attributes } -> + let popen_expr = _a popen_expr in + let popen_override = self#override_flag popen_override in + let popen_loc = self#location popen_loc in + let popen_attributes = self#attributes popen_attributes in + self#record + [("popen_expr", popen_expr); + ("popen_override", popen_override); + ("popen_loc", popen_loc); + ("popen_attributes", popen_attributes)] method open_description : open_description -> 'res= - fun { popen_lid; popen_override; popen_loc; popen_attributes } -> - let popen_lid = self#longident_loc popen_lid in - let popen_override = self#override_flag popen_override in - let popen_loc = self#location popen_loc in - let popen_attributes = self#attributes popen_attributes in - self#record - [("popen_lid", popen_lid); - ("popen_override", popen_override); - ("popen_loc", popen_loc); - ("popen_attributes", popen_attributes)] + self#open_infos self#longident_loc + method open_declaration : open_declaration -> 'res= + self#open_infos self#module_expr method include_infos : 'a . ('a -> 'res) -> 'a include_infos -> 'res= - fun _a -> - fun { pincl_mod; pincl_loc; pincl_attributes } -> - let pincl_mod = _a pincl_mod in - let pincl_loc = self#location pincl_loc in - let pincl_attributes = self#attributes pincl_attributes in - self#record - [("pincl_mod", pincl_mod); - ("pincl_loc", pincl_loc); - ("pincl_attributes", pincl_attributes)] + fun _a -> + fun { pincl_mod; pincl_loc; pincl_attributes } -> + let pincl_mod = _a pincl_mod in + let pincl_loc = self#location pincl_loc in + let pincl_attributes = self#attributes pincl_attributes in + self#record + [("pincl_mod", pincl_mod); + ("pincl_loc", pincl_loc); + ("pincl_attributes", pincl_attributes)] method include_description : include_description -> 'res= self#include_infos self#module_type method include_declaration : include_declaration -> 'res= self#include_infos self#module_expr method with_constraint : with_constraint -> 'res= - fun x -> - match x with - | Pwith_type (a,b) -> - let a = self#longident_loc a in - let b = self#type_declaration b in - self#constr "Pwith_type" [a; b] - | Pwith_module (a,b) -> - let a = self#longident_loc a in - let b = self#longident_loc b in - self#constr "Pwith_module" [a; b] - | Pwith_typesubst (a,b) -> - let a = self#longident_loc a in - let b = self#type_declaration b in - self#constr "Pwith_typesubst" [a; b] - | Pwith_modsubst (a,b) -> - let a = self#longident_loc a in - let b = self#longident_loc b in - self#constr "Pwith_modsubst" [a; b] + fun x -> + match x with + | Pwith_type (a, b) -> + let a = self#longident_loc a in + let b = self#type_declaration b in + self#constr "Pwith_type" [a; b] + | Pwith_module (a, b) -> + let a = self#longident_loc a in + let b = self#longident_loc b in self#constr "Pwith_module" [a; b] + | Pwith_typesubst (a, b) -> + let a = self#longident_loc a in + let b = self#type_declaration b in + self#constr "Pwith_typesubst" [a; b] + | Pwith_modsubst (a, b) -> + let a = self#longident_loc a in + let b = self#longident_loc b in + self#constr "Pwith_modsubst" [a; b] method module_expr : module_expr -> 'res= - fun { pmod_desc; pmod_loc; pmod_attributes } -> - let pmod_desc = self#module_expr_desc pmod_desc in - let pmod_loc = self#location pmod_loc in - let pmod_attributes = self#attributes pmod_attributes in - self#record - [("pmod_desc", pmod_desc); - ("pmod_loc", pmod_loc); - ("pmod_attributes", pmod_attributes)] + fun { pmod_desc; pmod_loc; pmod_attributes } -> + let pmod_desc = self#module_expr_desc pmod_desc in + let pmod_loc = self#location pmod_loc in + let pmod_attributes = self#attributes pmod_attributes in + self#record + [("pmod_desc", pmod_desc); + ("pmod_loc", pmod_loc); + ("pmod_attributes", pmod_attributes)] method module_expr_desc : module_expr_desc -> 'res= - fun x -> - match x with - | Pmod_ident a -> - let a = self#longident_loc a in self#constr "Pmod_ident" [a] - | Pmod_structure a -> - let a = self#structure a in self#constr "Pmod_structure" [a] - | Pmod_functor (a,b,c) -> - let a = self#loc self#string a in - let b = self#option self#module_type b in - let c = self#module_expr c in - self#constr "Pmod_functor" [a; b; c] - | Pmod_apply (a,b) -> - let a = self#module_expr a in - let b = self#module_expr b in self#constr "Pmod_apply" [a; b] - | Pmod_constraint (a,b) -> - let a = self#module_expr a in - let b = self#module_type b in - self#constr "Pmod_constraint" [a; b] - | Pmod_unpack a -> - let a = self#expression a in self#constr "Pmod_unpack" [a] - | Pmod_extension a -> - let a = self#extension a in self#constr "Pmod_extension" [a] + fun x -> + match x with + | Pmod_ident a -> + let a = self#longident_loc a in self#constr "Pmod_ident" [a] + | Pmod_structure a -> + let a = self#structure a in self#constr "Pmod_structure" [a] + | Pmod_functor (a, b, c) -> + let a = self#loc self#string a in + let b = self#option self#module_type b in + let c = self#module_expr c in + self#constr "Pmod_functor" [a; b; c] + | Pmod_apply (a, b) -> + let a = self#module_expr a in + let b = self#module_expr b in self#constr "Pmod_apply" [a; b] + | Pmod_constraint (a, b) -> + let a = self#module_expr a in + let b = self#module_type b in + self#constr "Pmod_constraint" [a; b] + | Pmod_unpack a -> + let a = self#expression a in self#constr "Pmod_unpack" [a] + | Pmod_extension a -> + let a = self#extension a in self#constr "Pmod_extension" [a] method structure : structure -> 'res= self#list self#structure_item method structure_item : structure_item -> 'res= - fun { pstr_desc; pstr_loc } -> - let pstr_desc = self#structure_item_desc pstr_desc in - let pstr_loc = self#location pstr_loc in - self#record [("pstr_desc", pstr_desc); ("pstr_loc", pstr_loc)] + fun { pstr_desc; pstr_loc } -> + let pstr_desc = self#structure_item_desc pstr_desc in + let pstr_loc = self#location pstr_loc in + self#record [("pstr_desc", pstr_desc); ("pstr_loc", pstr_loc)] method structure_item_desc : structure_item_desc -> 'res= - fun x -> - match x with - | Pstr_eval (a,b) -> - let a = self#expression a in - let b = self#attributes b in self#constr "Pstr_eval" [a; b] - | Pstr_value (a,b) -> - let a = self#rec_flag a in - let b = self#list self#value_binding b in - self#constr "Pstr_value" [a; b] - | Pstr_primitive a -> - let a = self#value_description a in - self#constr "Pstr_primitive" [a] - | Pstr_type (a,b) -> - let a = self#rec_flag a in - let b = self#list self#type_declaration b in - self#constr "Pstr_type" [a; b] - | Pstr_typext a -> - let a = self#type_extension a in self#constr "Pstr_typext" [a] - | Pstr_exception a -> - let a = self#extension_constructor a in - self#constr "Pstr_exception" [a] - | Pstr_module a -> - let a = self#module_binding a in self#constr "Pstr_module" [a] - | Pstr_recmodule a -> - let a = self#list self#module_binding a in - self#constr "Pstr_recmodule" [a] - | Pstr_modtype a -> - let a = self#module_type_declaration a in - self#constr "Pstr_modtype" [a] - | Pstr_open a -> - let a = self#open_description a in self#constr "Pstr_open" [a] - | Pstr_class a -> - let a = self#list self#class_declaration a in - self#constr "Pstr_class" [a] - | Pstr_class_type a -> - let a = self#list self#class_type_declaration a in - self#constr "Pstr_class_type" [a] - | Pstr_include a -> - let a = self#include_declaration a in - self#constr "Pstr_include" [a] - | Pstr_attribute a -> - let a = self#attribute a in self#constr "Pstr_attribute" [a] - | Pstr_extension (a,b) -> - let a = self#extension a in - let b = self#attributes b in self#constr "Pstr_extension" [a; b] + fun x -> + match x with + | Pstr_eval (a, b) -> + let a = self#expression a in + let b = self#attributes b in self#constr "Pstr_eval" [a; b] + | Pstr_value (a, b) -> + let a = self#rec_flag a in + let b = self#list self#value_binding b in + self#constr "Pstr_value" [a; b] + | Pstr_primitive a -> + let a = self#value_description a in + self#constr "Pstr_primitive" [a] + | Pstr_type (a, b) -> + let a = self#rec_flag a in + let b = self#list self#type_declaration b in + self#constr "Pstr_type" [a; b] + | Pstr_typext a -> + let a = self#type_extension a in self#constr "Pstr_typext" [a] + | Pstr_exception a -> + let a = self#type_exception a in self#constr "Pstr_exception" [a] + | Pstr_module a -> + let a = self#module_binding a in self#constr "Pstr_module" [a] + | Pstr_recmodule a -> + let a = self#list self#module_binding a in + self#constr "Pstr_recmodule" [a] + | Pstr_modtype a -> + let a = self#module_type_declaration a in + self#constr "Pstr_modtype" [a] + | Pstr_open a -> + let a = self#open_declaration a in self#constr "Pstr_open" [a] + | Pstr_class a -> + let a = self#list self#class_declaration a in + self#constr "Pstr_class" [a] + | Pstr_class_type a -> + let a = self#list self#class_type_declaration a in + self#constr "Pstr_class_type" [a] + | Pstr_include a -> + let a = self#include_declaration a in + self#constr "Pstr_include" [a] + | Pstr_attribute a -> + let a = self#attribute a in self#constr "Pstr_attribute" [a] + | Pstr_extension (a, b) -> + let a = self#extension a in + let b = self#attributes b in self#constr "Pstr_extension" [a; b] method value_binding : value_binding -> 'res= - fun { pvb_pat; pvb_expr; pvb_attributes; pvb_loc } -> - let pvb_pat = self#pattern pvb_pat in - let pvb_expr = self#expression pvb_expr in - let pvb_attributes = self#attributes pvb_attributes in - let pvb_loc = self#location pvb_loc in - self#record - [("pvb_pat", pvb_pat); - ("pvb_expr", pvb_expr); - ("pvb_attributes", pvb_attributes); - ("pvb_loc", pvb_loc)] + fun { pvb_pat; pvb_expr; pvb_attributes; pvb_loc } -> + let pvb_pat = self#pattern pvb_pat in + let pvb_expr = self#expression pvb_expr in + let pvb_attributes = self#attributes pvb_attributes in + let pvb_loc = self#location pvb_loc in + self#record + [("pvb_pat", pvb_pat); + ("pvb_expr", pvb_expr); + ("pvb_attributes", pvb_attributes); + ("pvb_loc", pvb_loc)] method module_binding : module_binding -> 'res= - fun { pmb_name; pmb_expr; pmb_attributes; pmb_loc } -> - let pmb_name = self#loc self#string pmb_name in - let pmb_expr = self#module_expr pmb_expr in - let pmb_attributes = self#attributes pmb_attributes in - let pmb_loc = self#location pmb_loc in - self#record - [("pmb_name", pmb_name); - ("pmb_expr", pmb_expr); - ("pmb_attributes", pmb_attributes); - ("pmb_loc", pmb_loc)] + fun { pmb_name; pmb_expr; pmb_attributes; pmb_loc } -> + let pmb_name = self#loc self#string pmb_name in + let pmb_expr = self#module_expr pmb_expr in + let pmb_attributes = self#attributes pmb_attributes in + let pmb_loc = self#location pmb_loc in + self#record + [("pmb_name", pmb_name); + ("pmb_expr", pmb_expr); + ("pmb_attributes", pmb_attributes); + ("pmb_loc", pmb_loc)] method toplevel_phrase : toplevel_phrase -> 'res= - fun x -> - match x with - | Ptop_def a -> - let a = self#structure a in self#constr "Ptop_def" [a] - | Ptop_dir (a,b) -> - let a = self#string a in - let b = self#directive_argument b in - self#constr "Ptop_dir" [a; b] + fun x -> + match x with + | Ptop_def a -> + let a = self#structure a in self#constr "Ptop_def" [a] + | Ptop_dir a -> + let a = self#toplevel_directive a in self#constr "Ptop_dir" [a] + method toplevel_directive : toplevel_directive -> 'res= + fun { pdir_name; pdir_arg; pdir_loc } -> + let pdir_name = self#loc self#string pdir_name in + let pdir_arg = self#option self#directive_argument pdir_arg in + let pdir_loc = self#location pdir_loc in + self#record + [("pdir_name", pdir_name); + ("pdir_arg", pdir_arg); + ("pdir_loc", pdir_loc)] method directive_argument : directive_argument -> 'res= - fun x -> - match x with - | Pdir_none -> self#constr "Pdir_none" [] - | Pdir_string a -> - let a = self#string a in self#constr "Pdir_string" [a] - | Pdir_int (a,b) -> - let a = self#string a in - let b = self#option self#char b in self#constr "Pdir_int" [a; b] - | Pdir_ident a -> - let a = self#longident a in self#constr "Pdir_ident" [a] - | Pdir_bool a -> let a = self#bool a in self#constr "Pdir_bool" [a] + fun { pdira_desc; pdira_loc } -> + let pdira_desc = self#directive_argument_desc pdira_desc in + let pdira_loc = self#location pdira_loc in + self#record [("pdira_desc", pdira_desc); ("pdira_loc", pdira_loc)] + method directive_argument_desc : directive_argument_desc -> 'res= + fun x -> + match x with + | Pdir_string a -> + let a = self#string a in self#constr "Pdir_string" [a] + | Pdir_int (a, b) -> + let a = self#string a in + let b = self#option self#char b in self#constr "Pdir_int" [a; b] + | Pdir_ident a -> + let a = self#longident a in self#constr "Pdir_ident" [a] + | Pdir_bool a -> let a = self#bool a in self#constr "Pdir_bool" [a] end [@@@end] diff --git a/ast/import.ml b/ast/import.ml index 2f3b34d4a..b1c767c55 100644 --- a/ast/import.ml +++ b/ast/import.ml @@ -4,7 +4,7 @@ It must be opened in all modules, especially the ones coming from the compiler. *) -module Js = Migrate_parsetree.OCaml_407 +module Js = Migrate_parsetree.OCaml_408 module Ocaml = Migrate_parsetree.Versions.OCaml_current module Select_ast(Ocaml : Migrate_parsetree.Versions.OCaml_version) = struct diff --git a/ast/pprintast.ml b/ast/pprintast.ml index f37c106ae..362c0b9e2 100644 --- a/ast/pprintast.ml +++ b/ast/pprintast.ml @@ -37,16 +37,33 @@ let infix_symbols = [ '='; '<'; '>'; '@'; '^'; '|'; '&'; '+'; '-'; '*'; '/'; let special_infix_strings = ["asr"; "land"; "lor"; "lsl"; "lsr"; "lxor"; "mod"; "or"; ":="; "!="; "::" ] +let letop s = + String.length s > 3 + && s.[0] = 'l' + && s.[1] = 'e' + && s.[2] = 't' + && List.mem s.[3] infix_symbols + +let andop s = + String.length s > 3 + && s.[0] = 'a' + && s.[1] = 'n' + && s.[2] = 'd' + && List.mem s.[3] infix_symbols + (* determines if the string is an infix string. checks backwards, first allowing a renaming postfix ("_102") which may have resulted from Pexp -> Texp -> Pexp translation, then checking if all the characters in the beginning of the string are valid infix characters. *) let fixity_of_string = function + | "" -> `Normal | s when List.mem s special_infix_strings -> `Infix s | s when List.mem s.[0] infix_symbols -> `Infix s | s when List.mem s.[0] prefix_symbols -> `Prefix s | s when s.[0] = '.' -> `Mixfix s + | s when letop s -> `Letop s + | s when andop s -> `Andop s | _ -> `Normal let view_fixity_of_exp = function @@ -54,20 +71,30 @@ let view_fixity_of_exp = function fixity_of_string l | _ -> `Normal -let is_infix = function | `Infix _ -> true | _ -> false +let is_infix = function `Infix _ -> true | _ -> false let is_mixfix = function `Mixfix _ -> true | _ -> false +let is_kwdop = function `Letop _ | `Andop _ -> true | _ -> false + +let first_is c str = + str <> "" && str.[0] = c +let last_is c str = + str <> "" && str.[String.length str - 1] = c + +let first_is_in cs str = + str <> "" && List.mem str.[0] cs (* which identifiers are in fact operators needing parentheses *) let needs_parens txt = let fix = fixity_of_string txt in is_infix fix || is_mixfix fix - || List.mem txt.[0] prefix_symbols + || is_kwdop fix + || first_is_in prefix_symbols txt (* some infixes need spaces around parens to avoid clashes with comment syntax *) let needs_spaces txt = - txt.[0]='*' || txt.[String.length txt - 1] = '*' + first_is '*' txt || last_is '*' txt (* add parentheses to binders when they are in fact infix or prefix operators *) let protect_ident ppf txt = @@ -193,15 +220,20 @@ let rec longident f = function let longident_loc f x = pp f "%a" longident x.txt let constant f = function - | Pconst_char i -> pp f "%C" i - | Pconst_string (i, None) -> pp f "%S" i - | Pconst_string (i, Some delim) -> pp f "{%s|%s|%s}" delim i delim - | Pconst_integer (i, None) -> paren (i.[0]='-') (fun f -> pp f "%s") f i + | Pconst_char i -> + pp f "%C" i + | Pconst_string (i, None) -> + pp f "%S" i + | Pconst_string (i, Some delim) -> + pp f "{%s|%s|%s}" delim i delim + | Pconst_integer (i, None) -> + paren (first_is '-' i) (fun f -> pp f "%s") f i | Pconst_integer (i, Some m) -> - paren (i.[0]='-') (fun f (i, m) -> pp f "%s%c" i m) f (i,m) - | Pconst_float (i, None) -> paren (i.[0]='-') (fun f -> pp f "%s") f i - | Pconst_float (i, Some m) -> paren (i.[0]='-') (fun f (i,m) -> - pp f "%s%c" i m) f (i,m) + paren (first_is '-' i) (fun f (i, m) -> pp f "%s%c" i m) f (i,m) + | Pconst_float (i, None) -> + paren (first_is '-' i) (fun f -> pp f "%s") f i + | Pconst_float (i, Some m) -> + paren (first_is '-' i) (fun f (i,m) -> pp f "%s%c" i m) f (i,m) (* trailing space*) let mutable_flag f = function @@ -227,9 +259,19 @@ let private_flag f = function | Public -> () | Private -> pp f "private@ " +let iter_loc f ctxt {txt; loc = _} = f ctxt txt + let constant_string f s = pp f "%S" s -let tyvar f str = pp f "'%s" str -let tyvar_loc f str = pp f "'%s" str.txt + +let tyvar ppf s = + if String.length s >= 2 && s.[1] = '\'' then + (* without the space, this would be parsed as + a character literal *) + Format.fprintf ppf "' %s" s + else + Format.fprintf ppf "'%s" s + +let tyvar_loc f str = tyvar f str.txt let string_quot f x = pp f "`%s" x (* c ['a,'b] *) @@ -255,7 +297,7 @@ and core_type ctxt f x = pp f "@[<2>%a@;->@;%a@]" (* FIXME remove parens later *) (type_with_label ctxt) (l,ct1) (core_type ctxt) ct2 | Ptyp_alias (ct, s) -> - pp f "@[<2>%a@;as@;'%s@]" (core_type1 ctxt) ct s + pp f "@[<2>%a@;as@;%a@]" (core_type1 ctxt) ct tyvar s | Ptyp_poly ([], ct) -> core_type ctxt f ct | Ptyp_poly (sl, ct) -> @@ -286,14 +328,14 @@ and core_type1 ctxt f x = l longident_loc li | Ptyp_variant (l, closed, low) -> let type_variant_helper f x = - match x with - | Rtag (l, attrs, _, ctl) -> - pp f "@[<2>%a%a@;%a@]" string_quot l.txt + match x.prf_desc with + | Rtag (l, _, ctl) -> + pp f "@[<2>%a%a@;%a@]" (iter_loc string_quot) l (fun f l -> match l with |[] -> () | _ -> pp f "@;of@;%a" (list (core_type ctxt) ~sep:"&") ctl) ctl - (attributes ctxt) attrs + (attributes ctxt) x.prf_attributes | Rinherit ct -> core_type ctxt f ct in pp f "@[<2>[%a%a]@]" (fun f l -> @@ -313,10 +355,11 @@ and core_type1 ctxt f x = pp f ">@ %a" (list string_quot) xs) low | Ptyp_object (l, o) -> - let core_field_type f = function - | Otag (l, attrs, ct) -> + let core_field_type f x = match x.pof_desc with + | Otag (l, ct) -> + (* Cf #7200 *) pp f "@[%s: %a@ %a@ @]" l.txt - (core_type ctxt) ct (attributes ctxt) attrs (* Cf #7200 *) + (core_type ctxt) ct (attributes ctxt) x.pof_attributes | Oinherit ct -> pp f "@[%a@ @]" (core_type ctxt) ct in @@ -327,7 +370,8 @@ and core_type1 ctxt f x = | [] -> pp f ".." | _ -> pp f " ;.." in - pp f "@[<@ %a%a@ > @]" (list core_field_type ~sep:";") l + pp f "@[<@ %a%a@ > @]" + (list core_field_type ~sep:";") l field_var o (* Cf #7200 *) | Ptyp_class (li, l) -> (*FIXME*) pp f "@[%a#%a@]" @@ -512,15 +556,15 @@ and sugar_expr ctxt f e = | _ -> false end | (Lident s | Ldot(_,s)) , a :: i :: rest - when s.[0] = '.' -> - let n = String.length s in + when first_is '.' s -> (* extract operator: assignment operators end with [right_bracket ^ "<-"], access operators end with [right_bracket] directly *) - let assign = s.[n - 1] = '-' in + let assign = last_is '-' s in let kind = (* extract the right end bracket *) + let n = String.length s in if assign then s.[n - 3] else s.[n - 1] in let left, right = match kind with | ')' -> '(', ")" @@ -547,7 +591,8 @@ and expression ctxt f x = paren true (expression reset_ctxt) f x | Pexp_ifthenelse _ | Pexp_sequence _ when ctxt.ifthenelse -> paren true (expression reset_ctxt) f x - | Pexp_let _ | Pexp_letmodule _ | Pexp_open _ | Pexp_letexception _ + | Pexp_let _ | Pexp_letmodule _ | Pexp_open _ + | Pexp_letexception _ | Pexp_letop _ when ctxt.semi -> paren true (expression reset_ctxt) f x | Pexp_fun (l, e0, p, e) -> @@ -667,11 +712,17 @@ and expression ctxt f x = | Pexp_poly (e, Some ct) -> pp f "@[(!poly!@ %a@ : %a)@]" (simple_expr ctxt) e (core_type ctxt) ct - | Pexp_open (ovf, lid, e) -> - pp f "@[<2>let open%s %a in@;%a@]" (override ovf) longident_loc lid + | Pexp_open (o, e) -> + pp f "@[<2>let open%s %a in@;%a@]" + (override o.popen_override) (module_expr ctxt) o.popen_expr (expression ctxt) e | Pexp_variant (l,Some eo) -> pp f "@[<2>`%s@;%a@]" l (simple_expr ctxt) eo + | Pexp_letop {let_; ands; body} -> + pp f "@[<2>@[%a@,%a@] in@;<1 -2>%a@]" + (binding_op ctxt) let_ + (list ~sep:"@," (binding_op ctxt)) ands + (expression ctxt) body | Pexp_extension e -> extension ctxt f e | Pexp_unreachable -> pp f "." | _ -> expression1 ctxt f x @@ -755,14 +806,14 @@ and attributes ctxt f l = and item_attributes ctxt f l = List.iter (item_attribute ctxt f) l -and attribute ctxt f (s, e) = - pp f "@[<2>[@@%s@ %a]@]" s.txt (payload ctxt) e +and attribute ctxt f a = + pp f "@[<2>[@@%s@ %a]@]" a.attr_name.txt (payload ctxt) a.attr_payload -and item_attribute ctxt f (s, e) = - pp f "@[<2>[@@@@%s@ %a]@]" s.txt (payload ctxt) e +and item_attribute ctxt f a = + pp f "@[<2>[@@@@%s@ %a]@]" a.attr_name.txt (payload ctxt) a.attr_payload -and floating_attribute ctxt f (s, e) = - pp f "@[<2>[@@@@@@%s@ %a]@]" s.txt (payload ctxt) e +and floating_attribute ctxt f a = + pp f "@[<2>[@@@@@@%s@ %a]@]" a.attr_name.txt (payload ctxt) a.attr_payload and value_description ctxt f x = (* note: value_description has an attribute field, @@ -779,8 +830,10 @@ and extension ctxt f (s, e) = and item_extension ctxt f (s, e) = pp f "@[<2>[%%%%%s@ %a]@]" s.txt (payload ctxt) e -and exception_declaration ctxt f ext = - pp f "@[exception@ %a@]" (extension_constructor ctxt) ext +and exception_declaration ctxt f x = + pp f "@[exception@ %a@]%a" + (extension_constructor ctxt) x.ptyexn_constructor + (item_attributes ctxt) x.ptyexn_attributes and class_type_field ctxt f x = match x.pctf_desc with @@ -831,8 +884,9 @@ and class_type ctxt f x = | Pcty_extension e -> extension ctxt f e; attributes ctxt f x.pcty_attributes - | Pcty_open (ovf, lid, e) -> - pp f "@[<2>let open%s %a in@;%a@]" (override ovf) longident_loc lid + | Pcty_open (o, e) -> + pp f "@[<2>let open%s %a in@;%a@]" + (override o.popen_override) longident_loc o.popen_expr (class_type ctxt) e (* [class type a = object end] *) @@ -881,7 +935,10 @@ and class_field ctxt f x = let bind e = binding ctxt f {pvb_pat= - {ppat_desc=Ppat_var s;ppat_loc=Location.none;ppat_attributes=[]}; + {ppat_desc=Ppat_var s; + ppat_loc=Location.none; + ppat_loc_stack=[]; + ppat_attributes=[]}; pvb_expr=e; pvb_attributes=[]; pvb_loc=Location.none; @@ -950,8 +1007,9 @@ and class_expr ctxt f x = (class_expr ctxt) ce (class_type ctxt) ct | Pcl_extension e -> extension ctxt f e - | Pcl_open (ovf, lid, e) -> - pp f "@[<2>let open%s %a in@;%a@]" (override ovf) longident_loc lid + | Pcl_open (o, e) -> + pp f "@[<2>let open%s %a in@;%a@]" + (override o.popen_override) longident_loc o.popen_expr (class_expr ctxt) e and module_type ctxt f x = @@ -1011,7 +1069,9 @@ and signature ctxt f x = list ~sep:"@\n" (signature_item ctxt) f x and signature_item ctxt f x : unit = match x.psig_desc with | Psig_type (rf, l) -> - type_def_list ctxt f (rf, l) + type_def_list ctxt f (rf, true, l) + | Psig_typesubst l -> + type_def_list ctxt f (Nonrecursive, false, l) | Psig_value vd -> let intro = if vd.pval_prim = [] then "val" else "external" in pp f "@[<2>%s@ %a@ :@ %a@]%a" intro @@ -1048,10 +1108,14 @@ and signature_item ctxt f x : unit = pmd.pmd_name.txt (module_type ctxt) pmd.pmd_type (item_attributes ctxt) pmd.pmd_attributes + | Psig_modsubst pms -> + pp f "@[module@ %s@ :=@ %a@]%a" pms.pms_name.txt + longident_loc pms.pms_manifest + (item_attributes ctxt) pms.pms_attributes | Psig_open od -> pp f "@[open%s@ %a@]%a" (override od.popen_override) - longident_loc od.popen_lid + longident_loc od.popen_expr (item_attributes ctxt) od.popen_attributes | Psig_include incl -> pp f "@[include@ %a@]%a" @@ -1213,6 +1277,10 @@ and bindings ctxt f (rf,l) = (binding "let" rf) x (list ~sep:"@," (binding "and" Nonrecursive)) xs +and binding_op ctxt f x = + pp f "@[<2>%s %a@;=@;%a@]" + x.pbop_op.txt (pattern ctxt) x.pbop_pat (expression ctxt) x.pbop_exp + and structure_item ctxt f x = match x.pstr_desc with | Pstr_eval (e, attrs) -> @@ -1220,7 +1288,7 @@ and structure_item ctxt f x = (expression ctxt) e (item_attributes ctxt) attrs | Pstr_type (_, []) -> assert false - | Pstr_type (rf, l) -> type_def_list ctxt f (rf, l) + | Pstr_type (rf, l) -> type_def_list ctxt f (rf, true, l) | Pstr_value (rf, l) -> (* pp f "@[let %a%a@]" rec_flag rf bindings l *) pp f "@[<2>%a@]" (bindings ctxt) (rf,l) @@ -1253,7 +1321,7 @@ and structure_item ctxt f x = | Pstr_open od -> pp f "@[<2>open%s@;%a@]%a" (override od.popen_override) - longident_loc od.popen_lid + (module_expr ctxt) od.popen_expr (item_attributes ctxt) od.popen_attributes | Pstr_modtype {pmtd_name=s; pmtd_type=md; pmtd_attributes=attrs} -> pp f "@[module@ type@ %s%a@]%a" @@ -1342,12 +1410,13 @@ and type_params ctxt f = function | [] -> () | l -> pp f "%a " (list (type_param ctxt) ~first:"(" ~last:")" ~sep:",@;") l -and type_def_list ctxt f (rf, l) = +and type_def_list ctxt f (rf, exported, l) = let type_decl kwd rf f x = let eq = if (x.ptype_kind = Ptype_abstract) && (x.ptype_manifest = None) then "" - else " =" + else if exported then " =" + else " :=" in pp f "@[<2>%s %a%a%s%s%a@]%a" kwd nonrec_flag rf @@ -1502,8 +1571,7 @@ and label_x_expression_param ctxt f (l,e) = pp f "~%s:%a" lbl (simple_expr ctxt) e and directive_argument f x = - match x with - | Pdir_none -> () + match x.pdira_desc with | Pdir_string (s) -> pp f "@ %S" s | Pdir_int (n, None) -> pp f "@ %s" n | Pdir_int (n, Some m) -> pp f "@ %s%c" n m @@ -1516,9 +1584,10 @@ let toplevel_phrase f x = (* pp_open_hvbox f 0; *) (* pp_print_list structure_item f s ; *) (* pp_close_box f (); *) - | Ptop_dir (s, da) -> - pp f "@[#%s@ %a@]" s directive_argument da - (* pp f "@[#%s@ %a@]" s directive_argument da *) + | Ptop_dir {pdir_name; pdir_arg = None; _} -> + pp f "@[#%s@]" pdir_name.txt + | Ptop_dir {pdir_name; pdir_arg = Some pdir_arg; _} -> + pp f "@[#%s@ %a@]" pdir_name.txt directive_argument pdir_arg let expression f x = pp f "@[%a@]" (expression reset_ctxt) x diff --git a/metaquot/ppxlib_metaquot.ml b/metaquot/ppxlib_metaquot.ml index d4eb39a1f..eba212b5d 100644 --- a/metaquot/ppxlib_metaquot.ml +++ b/metaquot/ppxlib_metaquot.ml @@ -8,6 +8,7 @@ module Make(M : sig type result val cast : extension -> result val location : location -> result + val location_stack : (location -> result) option val attributes : (location -> result) option class std_lifters : location -> [result] Ppxlib_traverse_builtins.std_lifters end) = struct @@ -25,6 +26,11 @@ module Make(M : sig | None -> super#attributes x | Some f -> assert_no_attributes x; f loc + method! location_stack x = + match M.location_stack with + | None -> super#location_stack x + | Some f -> f loc + method! expression e = match e.pexp_desc with | Pexp_extension ({ txt = "e"; _}, _ as ext)-> M.cast ext @@ -69,6 +75,7 @@ end module Expr = Make(struct type result = expression let location loc = evar ~loc "loc" + let location_stack = None let attributes = None class std_lifters = Ppxlib_metaquot_lifters.expression_lifters let cast ext = @@ -77,13 +84,14 @@ module Expr = Make(struct assert_no_attributes attrs; e | _ -> - Location.raise_errorf ~loc:(loc_of_attribute ext) + Location.raise_errorf ~loc:(loc_of_extension ext) "expression expected" end) module Patt = Make(struct type result = pattern let location loc = ppat_any ~loc + let location_stack = Some (fun loc -> ppat_any ~loc) let attributes = Some (fun loc -> ppat_any ~loc) class std_lifters = Ppxlib_metaquot_lifters.pattern_lifters let cast ext = @@ -93,7 +101,7 @@ module Patt = Make(struct Location.raise_errorf ~loc:e.pexp_loc "guard not expected here" | _ -> - Location.raise_errorf ~loc:(loc_of_attribute ext) + Location.raise_errorf ~loc:(loc_of_extension ext) "pattern expected" end) diff --git a/src/ast_builder.ml b/src/ast_builder.ml index ad5cbbc16..6f989cefe 100644 --- a/src/ast_builder.ml +++ b/src/ast_builder.ml @@ -167,14 +167,16 @@ module Default = struct Pexp_fun (label, None (* no default expression *), subpat, body) ; pexp_attributes = [] ; pexp_loc = _ + ; pexp_loc_stack = _ } -> begin match subpat with - | { ppat_desc = Ppat_var name; ppat_attributes = []; ppat_loc = _ } -> + | { ppat_desc = Ppat_var name; ppat_attributes = []; ppat_loc = _; ppat_loc_stack = _ } -> gather_params ((label, name, None) :: acc) body | { ppat_desc = Ppat_constraint ({ ppat_desc = Ppat_var name ; ppat_attributes = [] - ; ppat_loc = _ }, ty) - ; ppat_attributes = []; ppat_loc = _ } -> + ; ppat_loc = _ + ; ppat_loc_stack = _ }, ty) + ; ppat_attributes = []; ppat_loc = _; ppat_loc_stack = _ } -> (* We reduce [fun (x : ty) -> f x] by rewriting it [(f : ty -> _)]. *) gather_params ((label, name, Some ty) :: acc) body | _ -> List.rev acc, expr @@ -202,7 +204,7 @@ module Default = struct if n = 0 then Some (x, []) else match x with | { pexp_desc = Pexp_apply (body, args) - ; pexp_attributes = []; pexp_loc = _ } -> + ; pexp_attributes = []; pexp_loc = _; pexp_loc_stack = _ } -> if List.length args <= n then match gather_args (n - List.length args) body with | None -> None @@ -222,7 +224,7 @@ module Default = struct List.for_all2 args params ~f:(fun (arg_label, arg) (param_label, param, _) -> Poly.(=) (arg_label : arg_label) param_label && match arg with - | { pexp_desc = Pexp_ident { txt = Lident name'; _ }; pexp_attributes = []; pexp_loc = _ } + | { pexp_desc = Pexp_ident { txt = Lident name'; _ }; pexp_attributes = []; pexp_loc = _; pexp_loc_stack = _ } -> String.(=) name' param.txt | _ -> false) with diff --git a/src/ast_pattern.ml b/src/ast_pattern.ml index b9ceb7e46..31230a482 100644 --- a/src/ast_pattern.ml +++ b/src/ast_pattern.ml @@ -191,14 +191,12 @@ let single_expr_payload t = pstr (pstr_eval t nil ^:: nil) let no_label t = (cst Asttypes.Nolabel ~to_string:(fun _ -> "Nolabel")) ** t -let attribute (T f1) (T f2) = T (fun ctx loc ((name : _ Loc.t), payload) k -> +let extension (T f1) (T f2) = T (fun ctx loc ((name : _ Loc.t), payload) k -> let k = f1 ctx name.loc name.txt k in let k = f2 ctx loc payload k in k ) -let extension = attribute - let rec parse_elist (e : Parsetree.expression) acc = Common.assert_no_attributes e.pexp_attributes; match e.pexp_desc with diff --git a/src/ast_pattern.mli b/src/ast_pattern.mli index 426184275..56d732ec8 100644 --- a/src/ast_pattern.mli +++ b/src/ast_pattern.mli @@ -215,8 +215,8 @@ val single_expr_payload : (expression, 'a, 'b) t -> (payload, 'a, 'b) t val no_label : (expression, 'a, 'b) t -> (Asttypes.arg_label * expression, 'a, 'b) t -val attribute : (string, 'a, 'b) t -> (payload, 'b, 'c) t -> (attribute, 'a, 'c) t -val extension : (string, 'a, 'b) t -> (payload, 'b, 'c) t -> (attribute, 'a, 'c) t +val attribute : name:(string, 'a, 'b) t -> payload:(payload, 'b, 'c) t -> (attribute, 'a, 'c) t +val extension : (string, 'a, 'b) t -> (payload, 'b, 'c) t -> (extension, 'a, 'c) t val elist : (expression, 'a -> 'a, 'b) t -> (expression, 'b list -> 'c, 'c) t diff --git a/src/attribute.ml b/src/attribute.ml index 827221f99..d53ec12ab 100644 --- a/src/attribute.ml +++ b/src/attribute.ml @@ -12,6 +12,7 @@ module Context = struct | Label_declaration : label_declaration t | Constructor_declaration : constructor_declaration t | Type_declaration : type_declaration t + | Type_exception : type_exception t | Type_extension : type_extension t | Extension_constructor : extension_constructor t | Pattern : pattern t @@ -26,7 +27,9 @@ module Context = struct | Module_type : module_type t | Module_declaration : module_declaration t | Module_type_declaration : module_type_declaration t + | Module_substitution : module_substitution t | Open_description : open_description t + | Open_declaration : open_declaration t | Include_infos : _ include_infos t | Module_expr : module_expr t | Value_binding : value_binding t @@ -41,6 +44,7 @@ module Context = struct let constructor_declaration = Constructor_declaration let type_declaration = Type_declaration let type_extension = Type_extension + let type_exception = Type_exception let extension_constructor = Extension_constructor let pattern = Pattern let core_type = Core_type @@ -86,6 +90,7 @@ module Context = struct | Constructor_declaration -> x.pcd_attributes | Type_declaration -> x.ptype_attributes | Type_extension -> x.ptyext_attributes + | Type_exception -> x.ptyexn_attributes | Extension_constructor -> x.pext_attributes | Pattern -> x.ppat_attributes | Core_type -> x.ptyp_attributes @@ -99,7 +104,9 @@ module Context = struct | Module_type -> x.pmty_attributes | Module_declaration -> x.pmd_attributes | Module_type_declaration -> x.pmtd_attributes + | Module_substitution -> x.pms_attributes | Open_description -> x.popen_attributes + | Open_declaration -> x.popen_attributes | Include_infos -> x.pincl_attributes | Module_expr -> x.pmod_attributes | Value_binding -> x.pvb_attributes @@ -107,16 +114,8 @@ module Context = struct | Pstr_eval -> snd (get_pstr_eval x) | Pstr_extension -> snd (get_pstr_extension x) | Psig_extension -> snd (get_psig_extension x) - | Rtag -> - begin match x with - | Rtag (_, attrs, _, _) -> attrs - | Rinherit _ -> [] - end - | Object_type_field -> - begin match x with - | Otag (_, attrs, _) -> attrs - | Oinherit _ -> [] - end + | Rtag -> x.prf_attributes + | Object_type_field -> x.pof_attributes let set_attributes : type a. a t -> a -> attributes -> a = fun t x attrs -> match t with @@ -124,6 +123,7 @@ module Context = struct | Constructor_declaration -> { x with pcd_attributes = attrs } | Type_declaration -> { x with ptype_attributes = attrs } | Type_extension -> { x with ptyext_attributes = attrs } + | Type_exception -> { x with ptyexn_attributes = attrs } | Extension_constructor -> { x with pext_attributes = attrs } | Pattern -> { x with ppat_attributes = attrs } | Core_type -> { x with ptyp_attributes = attrs } @@ -137,7 +137,9 @@ module Context = struct | Module_type -> { x with pmty_attributes = attrs } | Module_declaration -> { x with pmd_attributes = attrs } | Module_type_declaration -> { x with pmtd_attributes = attrs } + | Module_substitution -> { x with pms_attributes = attrs } | Open_description -> { x with popen_attributes = attrs } + | Open_declaration -> { x with popen_attributes = attrs } | Include_infos -> { x with pincl_attributes = attrs } | Module_expr -> { x with pmod_attributes = attrs } | Value_binding -> { x with pvb_attributes = attrs } @@ -148,28 +150,15 @@ module Context = struct { x with pstr_desc = Pstr_extension (get_pstr_extension x |> fst, attrs) } | Psig_extension -> { x with psig_desc = Psig_extension (get_psig_extension x |> fst, attrs) } - | Rtag -> - begin match x with - | Rtag (lbl, _, can_be_constant, params_opts) -> - Rtag (lbl, attrs, can_be_constant, params_opts) - | Rinherit _ -> - assert (List.is_empty attrs); - x - end - | Object_type_field -> - begin match x with - | Otag (lbl, _, typ) -> - Otag (lbl, attrs, typ) - | Oinherit _ -> - assert (List.is_empty attrs); - x - end + | Rtag -> { x with prf_attributes = attrs} + | Object_type_field -> { x with pof_attributes = attrs} let desc : type a. a t -> string = function | Label_declaration -> "label declaration" | Constructor_declaration -> "constructor declaration" | Type_declaration -> "type declaration" | Type_extension -> "type extension" + | Type_exception -> "type exception" | Extension_constructor -> "extension constructor" | Pattern -> "pattern" | Core_type -> "core type" @@ -183,7 +172,9 @@ module Context = struct | Module_type -> "module type" | Module_declaration -> "module declaration" | Module_type_declaration -> "module type declaration" + | Module_substitution -> "module substitution" | Open_description -> "open" + | Open_declaration -> "open" | Include_infos -> "include" | Module_expr -> "module expression" | Value_binding -> "value binding" @@ -302,9 +293,8 @@ module Attribute_table = Caml.Hashtbl.Make(struct let not_seen = Attribute_table.create 128 -let mark_as_seen attr = - let name = fst attr in - Attribute_table.remove not_seen name +let mark_as_seen { attr_name; _ } = + Attribute_table.remove not_seen attr_name ;; let mark_as_handled_manually = mark_as_seen @@ -318,11 +308,11 @@ let get_internal = let rec find_best_match t attributes longest_match = match attributes with | [] -> longest_match - | (name, _) as attr :: rest -> + | { attr_name = name; _ } as attr :: rest -> if Name.Pattern.matches t.name name.txt then begin match longest_match with | None -> find_best_match t rest (Some attr) - | Some (name', _) -> + | Some { attr_name = name'; _ } -> let len = String.length name.txt in let len' = String.length name'.txt in if len > len' then @@ -341,8 +331,8 @@ let get_internal = let convert ?(do_mark_as_seen = true) pattern attr = if do_mark_as_seen then mark_as_seen attr; let (Payload_parser (pattern, k)) = pattern in - Ast_pattern.parse pattern (Common.loc_of_payload attr) (snd attr) - (k ~name_loc:(fst attr).loc) + Ast_pattern.parse pattern (Common.loc_of_payload attr) attr.attr_payload + (k ~name_loc:attr.attr_name.loc) ;; let get t ?mark_as_seen:do_mark_as_seen x = @@ -372,7 +362,7 @@ let remove_seen (type a) (context : a Context.t) packeds (x : a) = match get_internal t attrs with | None -> loop acc rest | Some attr -> - let name = fst attr in + let name = attr.attr_name in if Attribute_table.mem not_seen name then loop acc rest else @@ -423,7 +413,7 @@ module Floating = struct | { context; _ } :: _ -> assert (List.for_all ts ~f:(fun t -> Context.equal t.context context)); let attr = Context.get_attribute context x in - let name = fst attr in + let name = attr.attr_name in match List.filter ts ~f:(fun t -> Name.Pattern.matches t.name name.txt) with | [] -> None | [t] -> Some (convert t.payload attr) @@ -447,7 +437,7 @@ let check_attribute registrar context name = let check_unused = object(self) inherit Ast_traverse.iter as super - method! attribute (name, _) = + method! attribute { attr_name = name; _ } = Location.raise_errorf ~loc:name.loc "attribute not expected here, Ppxlib.Attribute needs updating!" @@ -456,7 +446,7 @@ let check_unused = object(self) match attrs with | [] -> node | _ -> - List.iter attrs ~f:(fun ((name, payload) as attr) -> + List.iter attrs ~f:(fun ({ attr_name = name; attr_payload = payload; _ } as attr) -> self#payload payload; check_attribute registrar (On_item context) name; (* If we allow the attribute to pass through, mark it as seen *) @@ -467,7 +457,7 @@ let check_unused = object(self) = fun context node -> match Floating.Context.get_attribute_if_is_floating_node context node with | None -> node - | Some ((name, payload) as attr) -> + | Some ({ attr_name = name; attr_payload = payload; _ } as attr) -> self#payload payload; check_attribute registrar (Floating context) name; mark_as_seen attr; @@ -477,6 +467,7 @@ let check_unused = object(self) method! constructor_declaration x = super#constructor_declaration (self#check_node Constructor_declaration x) method! type_declaration x = super#type_declaration (self#check_node Type_declaration x) method! type_extension x = super#type_extension (self#check_node Type_extension x) + method! type_exception x = super#type_exception (self#check_node Type_exception x) method! extension_constructor x = super#extension_constructor (self#check_node Extension_constructor x) method! pattern x = super#pattern (self#check_node Pattern x) method! core_type x = super#core_type (self#check_node Core_type x) @@ -489,6 +480,7 @@ let check_unused = object(self) method! module_declaration x = super#module_declaration (self#check_node Module_declaration x) method! module_type_declaration x = super#module_type_declaration (self#check_node Module_type_declaration x) method! open_description x = super#open_description (self#check_node Open_description x) + method! open_declaration x = super#open_declaration (self#check_node Open_declaration x) method! include_infos f x = super#include_infos f (self#check_node Include_infos x) method! module_expr x = super#module_expr (self#check_node Module_expr x) method! value_binding x = super#value_binding (self#check_node Value_binding x) @@ -506,7 +498,7 @@ let check_unused = object(self) method! row_field x = let x = - match x with + match x.prf_desc with | Rtag _ -> self#check_node Rtag x | _ -> x in @@ -547,7 +539,7 @@ let reset_checks () = Attribute_table.clear not_seen let collect = object inherit Ast_traverse.iter as super - method! attribute ((name, payload) as attr) = + method! attribute ({ attr_name = name; attr_payload = payload; _ } as attr) = let loc = Common.loc_of_attribute attr in super#payload payload; Attribute_table.add not_seen name loc @@ -565,7 +557,7 @@ let check_all_seen () = let remove_attributes_present_in table = object inherit Ast_traverse.iter as super - method! attribute (name, payload) = + method! attribute { attr_name = name; attr_payload = payload; _ } = super#payload payload; Attribute_table.remove table name end diff --git a/src/attribute.mli b/src/attribute.mli index 3556bfa15..fc1f844f3 100644 --- a/src/attribute.mli +++ b/src/attribute.mli @@ -19,6 +19,7 @@ module Context : sig | Label_declaration : label_declaration t | Constructor_declaration : constructor_declaration t | Type_declaration : type_declaration t + | Type_exception : type_exception t | Type_extension : type_extension t | Extension_constructor : extension_constructor t | Pattern : pattern t @@ -33,7 +34,9 @@ module Context : sig | Module_type : module_type t | Module_declaration : module_declaration t | Module_type_declaration : module_type_declaration t + | Module_substitution : module_substitution t | Open_description : open_description t + | Open_declaration : open_declaration t | Include_infos : _ include_infos t | Module_expr : module_expr t | Value_binding : value_binding t @@ -48,6 +51,7 @@ module Context : sig val constructor_declaration : constructor_declaration t val type_declaration : type_declaration t val type_extension : type_extension t + val type_exception : type_exception t val extension_constructor : extension_constructor t val pattern : pattern t val core_type : core_type t diff --git a/src/code_matcher.ml b/src/code_matcher.ml index 421d19154..a5503e175 100644 --- a/src/code_matcher.ml +++ b/src/code_matcher.ml @@ -55,6 +55,9 @@ struct inherit Ast_traverse.map method! location _ = Location.none + + method! location_stack _ = [] + end module M_map = M.Transform(struct type 'a t = 'a -> 'a end) diff --git a/src/common.ml b/src/common.ml index b0152ead3..61a019862 100644 --- a/src/common.ml +++ b/src/common.ml @@ -98,7 +98,7 @@ let rec last x l = | x :: l -> last x l ;; -let loc_of_payload (name, payload) = +let loc_of_name_and_payload name payload = match payload with | PStr [] -> name.loc | PStr (x :: l) -> { x.pstr_loc with loc_end = (last x l).pstr_loc.loc_end } @@ -109,14 +109,25 @@ let loc_of_payload (name, payload) = | PPat (x, Some e) -> { x.ppat_loc with loc_end = e.pexp_loc.loc_end } ;; -let loc_of_attribute ((name, _) as attr) = - (* TODO: fix this in the compiler *) +let loc_of_payload { attr_name; attr_payload; attr_loc = _; } = + loc_of_name_and_payload attr_name attr_payload + +let loc_of_attribute { attr_name; attr_payload; attr_loc = _; } = + (* TODO: fix this in the compiler, and move the logic to omp when converting + from older asts. *) (* "ocaml.doc" attributes are generated with [Location.none], which is not helpful for error messages. *) + if Poly.(=) attr_name.loc Location.none then + loc_of_name_and_payload attr_name attr_payload + else + { attr_name.loc with loc_end = (loc_of_name_and_payload attr_name attr_payload).loc_end } +;; + +let loc_of_extension (name, payload) = if Poly.(=) name.loc Location.none then - loc_of_payload attr + loc_of_name_and_payload name payload else - { name.loc with loc_end = (loc_of_payload attr).loc_end } + { name.loc with loc_end = (loc_of_name_and_payload name payload).loc_end } ;; let curry_applications expr = @@ -134,7 +145,7 @@ let curry_applications expr = let rec assert_no_attributes = function | [] -> () - | (name, _) :: rest when Name.ignore_checks name.Location.txt -> + | { attr_name = name; attr_loc = _; attr_payload = _; } :: rest when Name.ignore_checks name.Location.txt -> assert_no_attributes rest | attr :: _ -> let loc = loc_of_attribute attr in @@ -147,8 +158,9 @@ let assert_no_attributes_in = object end let attribute_of_warning loc s = - ({ loc; txt = "ocaml.ppwarning" }, - PStr ([pstr_eval ~loc (estring ~loc s) []])) + { attr_name = { loc; txt = "ocaml.ppwarning" }; + attr_payload = PStr ([pstr_eval ~loc (estring ~loc s) []]); + attr_loc = loc; } let is_polymorphic_variant = let rec check = function diff --git a/src/common.mli b/src/common.mli index 2eb95cb84..004a86e75 100644 --- a/src/common.mli +++ b/src/common.mli @@ -44,6 +44,7 @@ val really_recursive : rec_flag -> type_declaration list -> rec_flag val loc_of_payload : attribute -> Location.t val loc_of_attribute : attribute -> Location.t +val loc_of_extension : extension -> Location.t (** convert multi-arg function applications into a cascade of 1-arg applications *) val curry_applications : expression -> expression diff --git a/src/context_free.ml b/src/context_free.ml index 5d28a7fbe..8f3da6d46 100644 --- a/src/context_free.ml +++ b/src/context_free.ml @@ -71,8 +71,8 @@ module Rule = struct | Attr_sig_type_decl : (signature_item, type_declaration) Attr_group_inline.t t | Attr_str_type_ext : (structure_item, type_extension) Attr_inline.t t | Attr_sig_type_ext : (signature_item, type_extension) Attr_inline.t t - | Attr_str_exception : (structure_item, extension_constructor) Attr_inline.t t - | Attr_sig_exception : (signature_item, extension_constructor) Attr_inline.t t + | Attr_str_exception : (structure_item, type_exception) Attr_inline.t t + | Attr_sig_exception : (signature_item, type_exception) Attr_inline.t t type (_, _) equality = Eq : ('a, 'a) equality | Ne : (_, _) equality @@ -461,13 +461,14 @@ class map_top_down ?(expect_mismatch_handler=Expect_mismatch_handler.nop) - func.pexp_desc = Pexp_ident _ *) method private pexp_apply_without_traversing_function base_ctxt e func args = - let { pexp_desc = _; pexp_loc; pexp_attributes } = e in + let { pexp_desc = _; pexp_loc; pexp_attributes; pexp_loc_stack; } = e in let func = - let { pexp_desc; pexp_loc; pexp_attributes } = func in + let { pexp_desc; pexp_loc; pexp_attributes; pexp_loc_stack } = func in let pexp_attributes = self#attributes base_ctxt pexp_attributes in { pexp_desc ; pexp_loc (* location doesn't need to be traversed *) ; pexp_attributes + ; pexp_loc_stack } in let args = List.map args ~f:(fun (lab, exp) -> (lab, self#expression base_ctxt exp)) in @@ -475,6 +476,7 @@ class map_top_down ?(expect_mismatch_handler=Expect_mismatch_handler.nop) { pexp_loc ; pexp_attributes ; pexp_desc = Pexp_apply (func, args) + ; pexp_loc_stack } method! class_type base_ctxt x = diff --git a/src/context_free.mli b/src/context_free.mli index 889eea8b1..1ac3acc22 100644 --- a/src/context_free.mli +++ b/src/context_free.mli @@ -94,11 +94,11 @@ module Rule : sig val attr_str_type_ext_expect : (structure_item, type_extension, _) attr_inline val attr_sig_type_ext_expect : (signature_item, type_extension, _) attr_inline - val attr_str_exception : (structure_item, extension_constructor, _) attr_inline - val attr_sig_exception : (signature_item, extension_constructor, _) attr_inline + val attr_str_exception : (structure_item, type_exception, _) attr_inline + val attr_sig_exception : (signature_item, type_exception, _) attr_inline - val attr_str_exception_expect : (structure_item, extension_constructor, _) attr_inline - val attr_sig_exception_expect : (signature_item, extension_constructor, _) attr_inline + val attr_str_exception_expect : (structure_item, type_exception, _) attr_inline + val attr_sig_exception_expect : (signature_item, type_exception, _) attr_inline end (**/**) diff --git a/src/deriving.ml b/src/deriving.ml index 2018c7c1b..dffbb8c1e 100644 --- a/src/deriving.ml +++ b/src/deriving.ml @@ -213,10 +213,10 @@ module Deriver = struct { name : string ; str_type_decl : (structure, rec_flag * type_declaration list) Generator.t option ; str_type_ext : (structure, type_extension ) Generator.t option - ; str_exception : (structure, extension_constructor ) Generator.t option + ; str_exception : (structure, type_exception ) Generator.t option ; sig_type_decl : (signature, rec_flag * type_declaration list) Generator.t option ; sig_type_ext : (signature, type_extension ) Generator.t option - ; sig_exception : (signature, extension_constructor ) Generator.t option + ; sig_exception : (signature, type_exception ) Generator.t option ; extension : (loc:Location.t -> path:string -> core_type -> expression) option } end @@ -500,13 +500,13 @@ module Attr = struct let suffix = "" let td = mk_deriving_attr ~prefix:"ppxlib." ~suffix Type_declaration let te = mk_deriving_attr ~prefix:"ppxlib." ~suffix Type_extension - let ec = mk_deriving_attr ~prefix:"ppxlib." ~suffix Extension_constructor + let ec = mk_deriving_attr ~prefix:"ppxlib." ~suffix Type_exception module Expect = struct let suffix = "_inline" let td = mk_deriving_attr ~prefix:"ppxlib." ~suffix Type_declaration let te = mk_deriving_attr ~prefix:"ppxlib." ~suffix Type_extension - let ec = mk_deriving_attr ~prefix:"ppxlib." ~suffix Extension_constructor + let ec = mk_deriving_attr ~prefix:"ppxlib." ~suffix Type_exception end end @@ -515,13 +515,15 @@ end +-----------------------------------------------------------------+ *) let disable_unused_warning_attribute ~loc = - ({ txt = "ocaml.warning"; loc }, - PStr [pstr_eval ~loc (estring ~loc "-32") []]) + { attr_name = { txt = "ocaml.warning"; loc }; + attr_payload = PStr [pstr_eval ~loc (estring ~loc "-32") []]; + attr_loc = loc; } ;; let inline_doc_attr ~loc = - ({ txt = "ocaml.doc"; loc }, - PStr [pstr_eval ~loc (estring ~loc "@inline") []]) + { attr_name = { txt = "ocaml.doc"; loc }; + attr_payload = PStr [pstr_eval ~loc (estring ~loc "@inline") []]; + attr_loc = loc; } ;; let disable_unused_warning_str ~loc st = diff --git a/src/deriving.mli b/src/deriving.mli index 74c9035e7..7f110898e 100644 --- a/src/deriving.mli +++ b/src/deriving.mli @@ -98,10 +98,10 @@ end with type deriver := t val add : ?str_type_decl:(structure, rec_flag * type_declaration list) Generator.t -> ?str_type_ext :(structure, type_extension ) Generator.t - -> ?str_exception:(structure, extension_constructor ) Generator.t + -> ?str_exception:(structure, type_exception ) Generator.t -> ?sig_type_decl:(signature, rec_flag * type_declaration list) Generator.t -> ?sig_type_ext :(signature, type_extension ) Generator.t - -> ?sig_exception:(signature, extension_constructor ) Generator.t + -> ?sig_exception:(signature, type_exception ) Generator.t -> ?extension:(loc:Location.t -> path:string -> core_type -> expression) -> string -> t diff --git a/src/driver.ml b/src/driver.ml index 423d27831..f35ac8139 100644 --- a/src/driver.ml +++ b/src/driver.ml @@ -479,7 +479,7 @@ let real_map_structure config cookies st = match lint_errors with | [] -> st | _ -> - List.map lint_errors ~f:(fun (({ loc; _ }, _) as attr) -> + List.map lint_errors ~f:(fun ({ attr_name = { loc; _ }; _} as attr) -> Ast_builder.Default.pstr_attribute ~loc attr) @ st in @@ -522,7 +522,7 @@ let real_map_signature config cookies sg = match lint_errors with | [] -> sg | _ -> - List.map lint_errors ~f:(fun (({ loc; _ }, _) as attr) -> + List.map lint_errors ~f:(fun ({ attr_name = { loc; _ }; _} as attr) -> Ast_builder.Default.psig_attribute ~loc attr) @ sg in @@ -733,7 +733,7 @@ type output_mode = (*$*) let extract_cookies_str st = match st with - | { pstr_desc = Pstr_attribute({txt = "ocaml.ppx.context"; _}, _); _ } as prefix + | { pstr_desc = Pstr_attribute {attr_name={txt = "ocaml.ppx.context"; _}; _}; _ } as prefix :: st -> let prefix = Ppxlib_ast.Selected_ast.to_ocaml Structure [prefix] in assert (List.is_empty @@ -751,7 +751,7 @@ let add_cookies_str st = (*$ str_to_sig _last_text_block *) let extract_cookies_sig sg = match sg with - | { psig_desc = Psig_attribute({txt = "ocaml.ppx.context"; _}, _); _ } as prefix + | { psig_desc = Psig_attribute {attr_name={txt = "ocaml.ppx.context"; _}; _}; _ } as prefix :: sg -> let prefix = Ppxlib_ast.Selected_ast.to_ocaml Signature [prefix] in assert (List.is_empty diff --git a/src/gen/gen_ast_builder.ml b/src/gen/gen_ast_builder.ml index 55af599a7..667b76ee0 100644 --- a/src/gen/gen_ast_builder.ml +++ b/src/gen/gen_ast_builder.ml @@ -8,7 +8,7 @@ let prefix_of_record lds = module Gen(Fixed_loc : sig val fixed_loc : bool end) = struct open Fixed_loc - let gen_combinator_for_constructor ~wrapper:(wpath, wprefix, has_attrs) path ~prefix cd = + let gen_combinator_for_constructor ~wrapper:(wpath, wprefix, has_attrs, has_loc_stack) path ~prefix cd = match cd.pcd_args with | Pcstr_record _ -> (* TODO. *) @@ -43,6 +43,15 @@ module Gen(Fixed_loc : sig val fixed_loc : bool end) = struct else fields in + let fields = + if has_loc_stack then + ( Loc.mk (fqn_longident' wpath (wprefix ^ "loc_stack")) + , M.expr "[]" + ) + :: fields + else + fields + in Exp.record fields None in let body = @@ -132,7 +141,7 @@ end let filter_labels ~prefix lds = List.filter lds ~f:(fun ld -> match without_prefix ~prefix ld.pld_name.txt with - | "loc" | "attributes" -> false + | "loc" | "loc_stack" | "attributes" -> false | _ -> true) ;; @@ -163,14 +172,17 @@ let generate filename = let has_attrs = List.exists lds ~f:(fun ld -> ld.pld_name.txt = prefix ^ "attributes") in - (path, td, Some (prefix, has_attrs, p.txt))) + let has_loc_stack = List.exists lds ~f:(fun ld -> + ld.pld_name.txt = prefix ^ "loc_stack") + in + (path, td, Some (prefix, has_attrs, has_loc_stack, p.txt))) | _ -> (path, td, None)) in let wrapped = List.filter_map types_with_wrapped ~f:(fun (_, _, x) -> match x with | None -> None - | Some (_, _, p) -> Some p) + | Some (_, _, _, p) -> Some p) in let types = List.filter types_with_wrapped ~f:(fun (path, _, _) -> @@ -178,8 +190,8 @@ let generate filename = |> List.map ~f:(fun (path, td, wrapped) -> match wrapped with | None -> (path, td, None) - | Some (prefix, has_attrs, p) -> - (path, td, Some (prefix, has_attrs, p, List.assoc p types))) + | Some (prefix, has_attrs, has_loc_stack, p) -> + (path, td, Some (prefix, has_attrs, has_loc_stack, p, List.assoc p types))) in (* let all_types = List.map fst types in*) let types = @@ -194,13 +206,13 @@ let generate filename = else match wrapped with | None -> G.gen_td path td - | Some (prefix, has_attrs, path', td') -> - G.gen_td ~wrapper:(path, prefix, has_attrs) path' td' + | Some (prefix, has_attrs, has_loc_stack, path', td') -> + G.gen_td ~wrapper:(path, prefix, has_attrs, has_loc_stack) path' td' ) |> List.flatten in let st = - [ Str.open_ (Opn.mk (Loc.lident "Import")) + [ Str.open_ (Opn.mk (Mod.ident (Loc.lident "Import"))) ; Str.module_ (Mb.mk (Loc.mk "M") (Mod.structure (items false))) ; Str.module_ (Mb.mk (Loc.mk "Make") (Mod.functor_ (Loc.mk "Loc") (Some (Mty.signature [ diff --git a/src/gen/gen_ast_pattern.ml b/src/gen/gen_ast_pattern.ml index 5356d2523..5a380a7ef 100644 --- a/src/gen/gen_ast_pattern.ml +++ b/src/gen/gen_ast_pattern.ml @@ -3,20 +3,22 @@ open Ast_helper open Printf let apply_parsers funcs args types = - List.fold_right2 (List.combine funcs args) types ~init:(M.expr "k") - ~f:(fun (func, arg) typ acc -> + List.fold_right2 (List.combine funcs args) types ~init:(M.expr "k", false) + ~f:(fun (func, arg) typ (acc, needs_loc) -> match typ.ptyp_desc with | Ptyp_constr (path, _) when is_loc path.txt -> M.expr "let k = %a ctx %a.loc %a.txt k in %a" A.expr (evar func) A.expr arg A.expr arg - A.expr acc + A.expr acc, + needs_loc | _ -> M.expr "let k = %a ctx loc %a k in %a" A.expr (evar func) A.expr arg - A.expr acc) + A.expr acc, + true) ;; let assert_no_attributes ~path ~prefix = @@ -40,7 +42,7 @@ let gen_combinator_for_constructor ?wrapper path ~prefix cd = | [x] -> Some (pvar x) | _ -> Some (Pat.tuple (List.map args ~f:pvar))) in - let exp = + let exp, _ = apply_parsers funcs (List.map args ~f:evar) cd_args in let expected = without_prefix ~prefix cd.pcd_name.txt in @@ -97,7 +99,7 @@ let gen_combinator_for_record path ~prefix ~has_attrs lds = let funcs = List.map lds ~f:(fun ld -> map_keyword (without_prefix ~prefix ld.pld_name.txt)) in - let body = + let body, needs_loc = apply_parsers funcs (List.map fields ~f:(fun field -> Exp.field (evar "x") (Loc.mk field))) (List.map lds ~f:(fun ld -> ld.pld_type)) @@ -108,7 +110,11 @@ let gen_combinator_for_record path ~prefix ~has_attrs lds = else body in - let body = M.expr "T (fun ctx loc x k -> %a)" A.expr body in + let body = + M.expr "T (fun ctx %s x k -> %a)" + (if needs_loc then "loc" else "_loc") + A.expr body + in let body = List.fold_right funcs ~init:body ~f:(fun func acc -> Exp.fun_ (Labelled func) None (M.patt "T %a" A.patt (pvar func)) acc) @@ -123,7 +129,7 @@ let prefix_of_record lds = common_prefix (List.map lds ~f:(fun ld -> ld.pld_name let filter_labels ~prefix lds = List.filter lds ~f:(fun ld -> match without_prefix ~prefix ld.pld_name.txt with - | "loc" | "attributes" -> false + | "loc" | "loc_stack" | "attributes" -> false | _ -> true) ;; @@ -270,8 +276,8 @@ let generate filename = |> List.flatten in let st = - Str.open_ (Opn.mk (Loc.lident "Import")) - :: Str.open_ (Opn.mk (Loc.lident "Ast_pattern0")) + Str.open_ (Opn.mk (Mod.ident (Loc.lident "Import"))) + :: Str.open_ (Opn.mk (Mod.ident (Loc.lident "Ast_pattern0"))) :: items in dump "ast_pattern_generated" Pprintast.structure st ~ext:".ml" diff --git a/src/merlin_helpers.ml b/src/merlin_helpers.ml index a3e5efb57..65baf571f 100644 --- a/src/merlin_helpers.ml +++ b/src/merlin_helpers.ml @@ -1,9 +1,9 @@ open! Import -let mknoloc txt = Location.{ txt; loc = none } +let mk_attr_noloc txt = Ast_helper.Attr.mk Location.{ txt; loc = none } -let hide_attribute : attribute = mknoloc "merlin.hide", PStr [] -let focus_attribute : attribute = mknoloc "merlin.focus", PStr [] +let hide_attribute : attribute = mk_attr_noloc "merlin.hide" (PStr []) +let focus_attribute : attribute = mk_attr_noloc "merlin.focus" (PStr []) let hide_pattern ({ ppat_attributes ; _ } as p) = { p with ppat_attributes = hide_attribute :: ppat_attributes } diff --git a/test/deriving/inline/foo-deriver/ppx_foo_deriver.ml b/test/deriving/inline/foo-deriver/ppx_foo_deriver.ml index 1f02c9240..8112d5ecf 100644 --- a/test/deriving/inline/foo-deriver/ppx_foo_deriver.ml +++ b/test/deriving/inline/foo-deriver/ppx_foo_deriver.ml @@ -17,6 +17,7 @@ let add_deriver () = { pexp_desc = desc; pexp_loc = loc; pexp_attributes = []; + pexp_loc_stack = []; } in [ @@ -27,6 +28,7 @@ let add_deriver () = { ppat_desc = Ppat_any; ppat_loc = loc; ppat_attributes = []; + ppat_loc_stack = []; } ; pvb_expr = expr ( @@ -63,6 +65,7 @@ let () = { pexp_desc = Pexp_constant (Pconst_string ("foo", None)); pexp_loc = loc; pexp_attributes = []; + pexp_loc_stack = []; })) ] diff --git a/test/deriving/test.ml b/test/deriving/test.ml index a42e4034f..9d6bca52b 100644 --- a/test/deriving/test.ml +++ b/test/deriving/test.ml @@ -35,8 +35,8 @@ Line _, characters 25-33: Error: Deriver foo is needed for bar, you need to add it before in the list |}] -type t = int [@@deriving foo, bar] +type nonrec int = int [@@deriving foo, bar] [%%expect{| -type t = int +type nonrec int = int val x : int = 42 |}] diff --git a/test/driver/transformations/test.ml b/test/driver/transformations/test.ml index edb7db6db..b10cd303b 100644 --- a/test/driver/transformations/test.ml +++ b/test/driver/transformations/test.ml @@ -38,7 +38,7 @@ type t = } [%%expect{| Line _, characters 0-36: -Error (Warning 22): Fields are not sorted! +Error (warning 22): Fields are not sorted! |}] diff --git a/test/expect/dune b/test/expect/dune index a0148e92f..a07559c1c 100644 --- a/test/expect/dune +++ b/test/expect/dune @@ -1,8 +1,13 @@ (executable (name expect_test) - (modules expect_test) + (modules expect_test printers) (link_flags (-linkall)) (modes byte) (libraries unix compiler-libs.toplevel ppxlib ppxlib.traverse)) +(rule + (deps printers_lt_408.ml printers_ge_408.ml) + (targets printers.ml) + (action (with-stdout-to printers.ml (run %{ocaml} %{dep:gen-printers} %{ocaml_version})))) + (ocamllex expect_test) diff --git a/test/expect/expect_test.mll b/test/expect/expect_test.mll index dfb3a1a2a..018b02106 100644 --- a/test/expect/expect_test.mll +++ b/test/expect/expect_test.mll @@ -68,31 +68,6 @@ and expectation txt = parse } { - -let print_loc ppf (loc : Location.t) = - let startchar = loc.loc_start.pos_cnum - loc.loc_start.pos_bol in - let endchar = loc.loc_end.pos_cnum - loc.loc_start.pos_cnum + startchar in - Format.fprintf ppf "Line _"; - if startchar >= 0 then - Format.fprintf ppf ", characters %d-%d" startchar endchar; - Format.fprintf ppf ":@."; -;; -let warning_printer loc ppf w = - match Warnings.report w with - | `Inactive -> () - | `Active { Warnings. number; message; is_error; sub_locs = _ } -> - print_loc ppf loc; - if is_error - then - Format.fprintf ppf "Error (Warning %d): %s@." number message - else Format.fprintf ppf "Warning %d: %s@." number message -;; -let rec error_reporter ppf {Location.loc; msg; sub; if_highlight=_} = - print_loc ppf loc; - Format.fprintf ppf "Error: %s" msg; - List.iter sub ~f:(fun err -> - Format.fprintf ppf "@\n@[<2>%a@]" error_reporter err) -;; let apply_rewriters : (Parsetree.toplevel_phrase -> Parsetree.toplevel_phrase) = function | Ptop_dir _ as x -> x | Ptop_def s -> @@ -119,9 +94,7 @@ let main () = let buf = Buffer.create (String.length file_contents + 1024) in let ppf = Format.formatter_of_buffer buf in - Location.formatter_for_warnings := ppf; - Location.warning_printer := warning_printer; - Location.error_reporter := error_reporter; + Printers.setup ppf; List.iter chunks ~f:(fun (pos, s) -> Format.fprintf ppf "%s[%%%%expect{|@." s; let lexbuf = Lexing.from_string s in diff --git a/test/expect/gen-printers b/test/expect/gen-printers new file mode 100644 index 000000000..3c4453ca7 --- /dev/null +++ b/test/expect/gen-printers @@ -0,0 +1,19 @@ +(* -*- tuareg -*- *) + +let () = + let ocaml_major, ocaml_minor = + Scanf.sscanf Sys.argv.(1) "%u.%u" (fun a b -> (a, b)) + in + let file = + if ocaml_major > 4 || ocaml_major = 4 && ocaml_minor >= 8 then + "printers_ge_408.ml" + else + "printers_lt_408.ml" + in + let channel = open_in file in + try + while true do + print_endline (input_line channel) + done + with End_of_file -> + close_in_noerr channel diff --git a/test/expect/printers_ge_408.ml b/test/expect/printers_ge_408.ml new file mode 100644 index 000000000..d88cf5ac6 --- /dev/null +++ b/test/expect/printers_ge_408.ml @@ -0,0 +1,20 @@ +let print_loc _ _ ppf (loc : Location.t) = + let startchar = loc.loc_start.pos_cnum - loc.loc_start.pos_bol in + let endchar = loc.loc_end.pos_cnum - loc.loc_start.pos_cnum + startchar in + Format.fprintf ppf "Line _"; + if startchar >= 0 then + Format.fprintf ppf ", characters %d-%d" startchar endchar; + Format.fprintf ppf ":@."; +;; + +let report_printer () = + let printer = Location.default_report_printer () in + { printer with Location. pp_main_loc = print_loc; pp_submsg_loc = print_loc; } +;; + +let setup ppf = + Location.formatter_for_warnings := ppf; + Location.warning_reporter := Location.default_warning_reporter; + Location.report_printer := report_printer; + Location.alert_reporter := Location.default_alert_reporter; +;; diff --git a/test/expect/printers_lt_408.ml b/test/expect/printers_lt_408.ml new file mode 100644 index 000000000..de1c436ac --- /dev/null +++ b/test/expect/printers_lt_408.ml @@ -0,0 +1,33 @@ +let print_loc ppf (loc : Location.t) = + let startchar = loc.loc_start.pos_cnum - loc.loc_start.pos_bol in + let endchar = loc.loc_end.pos_cnum - loc.loc_start.pos_cnum + startchar in + Format.fprintf ppf "Line _"; + if startchar >= 0 then + Format.fprintf ppf ", characters %d-%d" startchar endchar; + Format.fprintf ppf ":@."; +;; + +let warning_printer loc ppf w = + match Warnings.report w with + | `Inactive -> () + | `Active { Warnings. number; message; is_error; sub_locs = _ } -> + print_loc ppf loc; + if is_error + then + Format.fprintf ppf "Error (warning %d): %s@." number message + else Format.fprintf ppf "Warning %d: %s@." number message +;; + +let rec error_reporter ppf {Location.loc; msg; sub; if_highlight=_} = + print_loc ppf loc; + Format.fprintf ppf "Error: %s" msg; + List.iter (fun err -> + Format.fprintf ppf "@\n@[<2>%a@]" error_reporter err) + sub +;; + +let setup ppf = + Location.formatter_for_warnings := ppf; + Location.warning_printer := warning_printer; + Location.error_reporter := error_reporter; +;;