diff --git a/ast/builder.ml b/ast/builder.ml index a3e11a31..0f019d46 100644 --- a/ast/builder.ml +++ b/ast/builder.ml @@ -1,3 +1,8 @@ +module V4_08 = struct + include Builder_common + include Builder_v4_08 +end + module V4_07 = struct include Builder_common include Builder_v4_07 diff --git a/ast/builder.mli b/ast/builder.mli index dc29c449..fe158752 100644 --- a/ast/builder.mli +++ b/ast/builder.mli @@ -1,3 +1,8 @@ +module V4_08 : sig + include module type of Builder_common + include module type of Builder_v4_08 +end + module V4_07 : sig include module type of Builder_common include module type of Builder_v4_07 diff --git a/ast/builder_v4_08.ml b/ast/builder_v4_08.ml new file mode 100644 index 00000000..ec66386e --- /dev/null +++ b/ast/builder_v4_08.ml @@ -0,0 +1,331 @@ +(*$ Ppx_ast_cinaps.print_builder_ml (Astlib.Version.of_string "v4_08") *) +open Versions.V4_08 +let attribute ~loc ~name ~payload = +Attribute.create ~attr_name:name ~attr_payload:payload ~attr_loc:loc +let ptyp_any ~loc = +Core_type.create ~ptyp_desc:(Core_type_desc.ptyp_any) ~ptyp_loc:loc ~ptyp_attributes:(Attributes.of_concrete []) ~ptyp_loc_stack:[] +let ptyp_var ~loc a1 = +Core_type.create ~ptyp_desc:(Core_type_desc.ptyp_var a1) ~ptyp_loc:loc ~ptyp_attributes:(Attributes.of_concrete []) ~ptyp_loc_stack:[] +let ptyp_arrow ~loc a1 a2 a3 = +Core_type.create ~ptyp_desc:(Core_type_desc.ptyp_arrow a1 a2 a3) ~ptyp_loc:loc ~ptyp_attributes:(Attributes.of_concrete []) ~ptyp_loc_stack:[] +let ptyp_tuple ~loc a1 = +Core_type.create ~ptyp_desc:(Core_type_desc.ptyp_tuple a1) ~ptyp_loc:loc ~ptyp_attributes:(Attributes.of_concrete []) ~ptyp_loc_stack:[] +let ptyp_constr ~loc a1 a2 = +Core_type.create ~ptyp_desc:(Core_type_desc.ptyp_constr a1 a2) ~ptyp_loc:loc ~ptyp_attributes:(Attributes.of_concrete []) ~ptyp_loc_stack:[] +let ptyp_object ~loc a1 a2 = +Core_type.create ~ptyp_desc:(Core_type_desc.ptyp_object a1 a2) ~ptyp_loc:loc ~ptyp_attributes:(Attributes.of_concrete []) ~ptyp_loc_stack:[] +let ptyp_class ~loc a1 a2 = +Core_type.create ~ptyp_desc:(Core_type_desc.ptyp_class a1 a2) ~ptyp_loc:loc ~ptyp_attributes:(Attributes.of_concrete []) ~ptyp_loc_stack:[] +let ptyp_alias ~loc a1 a2 = +Core_type.create ~ptyp_desc:(Core_type_desc.ptyp_alias a1 a2) ~ptyp_loc:loc ~ptyp_attributes:(Attributes.of_concrete []) ~ptyp_loc_stack:[] +let ptyp_variant ~loc a1 a2 a3 = +Core_type.create ~ptyp_desc:(Core_type_desc.ptyp_variant a1 a2 a3) ~ptyp_loc:loc ~ptyp_attributes:(Attributes.of_concrete []) ~ptyp_loc_stack:[] +let ptyp_poly ~loc a1 a2 = +Core_type.create ~ptyp_desc:(Core_type_desc.ptyp_poly a1 a2) ~ptyp_loc:loc ~ptyp_attributes:(Attributes.of_concrete []) ~ptyp_loc_stack:[] +let ptyp_package ~loc a1 = +Core_type.create ~ptyp_desc:(Core_type_desc.ptyp_package a1) ~ptyp_loc:loc ~ptyp_attributes:(Attributes.of_concrete []) ~ptyp_loc_stack:[] +let ptyp_extension ~loc a1 = +Core_type.create ~ptyp_desc:(Core_type_desc.ptyp_extension a1) ~ptyp_loc:loc ~ptyp_attributes:(Attributes.of_concrete []) ~ptyp_loc_stack:[] +let rtag ~loc a1 a2 a3 = +Row_field.create ~prf_desc:(Row_field_desc.rtag a1 a2 a3) ~prf_loc:loc ~prf_attributes:(Attributes.of_concrete []) +let rinherit ~loc a1 = +Row_field.create ~prf_desc:(Row_field_desc.rinherit a1) ~prf_loc:loc ~prf_attributes:(Attributes.of_concrete []) +let otag ~loc a1 a2 = +Object_field.create ~pof_desc:(Object_field_desc.otag a1 a2) ~pof_loc:loc ~pof_attributes:(Attributes.of_concrete []) +let oinherit ~loc a1 = +Object_field.create ~pof_desc:(Object_field_desc.oinherit a1) ~pof_loc:loc ~pof_attributes:(Attributes.of_concrete []) +let ppat_any ~loc = +Pattern.create ~ppat_desc:(Pattern_desc.ppat_any) ~ppat_loc:loc ~ppat_attributes:(Attributes.of_concrete []) ~ppat_loc_stack:[] +let ppat_var ~loc a1 = +Pattern.create ~ppat_desc:(Pattern_desc.ppat_var a1) ~ppat_loc:loc ~ppat_attributes:(Attributes.of_concrete []) ~ppat_loc_stack:[] +let ppat_alias ~loc a1 a2 = +Pattern.create ~ppat_desc:(Pattern_desc.ppat_alias a1 a2) ~ppat_loc:loc ~ppat_attributes:(Attributes.of_concrete []) ~ppat_loc_stack:[] +let ppat_constant ~loc a1 = +Pattern.create ~ppat_desc:(Pattern_desc.ppat_constant a1) ~ppat_loc:loc ~ppat_attributes:(Attributes.of_concrete []) ~ppat_loc_stack:[] +let ppat_interval ~loc a1 a2 = +Pattern.create ~ppat_desc:(Pattern_desc.ppat_interval a1 a2) ~ppat_loc:loc ~ppat_attributes:(Attributes.of_concrete []) ~ppat_loc_stack:[] +let ppat_tuple ~loc a1 = +Pattern.create ~ppat_desc:(Pattern_desc.ppat_tuple a1) ~ppat_loc:loc ~ppat_attributes:(Attributes.of_concrete []) ~ppat_loc_stack:[] +let ppat_construct ~loc a1 a2 = +Pattern.create ~ppat_desc:(Pattern_desc.ppat_construct a1 a2) ~ppat_loc:loc ~ppat_attributes:(Attributes.of_concrete []) ~ppat_loc_stack:[] +let ppat_variant ~loc a1 a2 = +Pattern.create ~ppat_desc:(Pattern_desc.ppat_variant a1 a2) ~ppat_loc:loc ~ppat_attributes:(Attributes.of_concrete []) ~ppat_loc_stack:[] +let ppat_record ~loc a1 a2 = +Pattern.create ~ppat_desc:(Pattern_desc.ppat_record a1 a2) ~ppat_loc:loc ~ppat_attributes:(Attributes.of_concrete []) ~ppat_loc_stack:[] +let ppat_array ~loc a1 = +Pattern.create ~ppat_desc:(Pattern_desc.ppat_array a1) ~ppat_loc:loc ~ppat_attributes:(Attributes.of_concrete []) ~ppat_loc_stack:[] +let ppat_or ~loc a1 a2 = +Pattern.create ~ppat_desc:(Pattern_desc.ppat_or a1 a2) ~ppat_loc:loc ~ppat_attributes:(Attributes.of_concrete []) ~ppat_loc_stack:[] +let ppat_constraint ~loc a1 a2 = +Pattern.create ~ppat_desc:(Pattern_desc.ppat_constraint a1 a2) ~ppat_loc:loc ~ppat_attributes:(Attributes.of_concrete []) ~ppat_loc_stack:[] +let ppat_type ~loc a1 = +Pattern.create ~ppat_desc:(Pattern_desc.ppat_type a1) ~ppat_loc:loc ~ppat_attributes:(Attributes.of_concrete []) ~ppat_loc_stack:[] +let ppat_lazy ~loc a1 = +Pattern.create ~ppat_desc:(Pattern_desc.ppat_lazy a1) ~ppat_loc:loc ~ppat_attributes:(Attributes.of_concrete []) ~ppat_loc_stack:[] +let ppat_unpack ~loc a1 = +Pattern.create ~ppat_desc:(Pattern_desc.ppat_unpack a1) ~ppat_loc:loc ~ppat_attributes:(Attributes.of_concrete []) ~ppat_loc_stack:[] +let ppat_exception ~loc a1 = +Pattern.create ~ppat_desc:(Pattern_desc.ppat_exception a1) ~ppat_loc:loc ~ppat_attributes:(Attributes.of_concrete []) ~ppat_loc_stack:[] +let ppat_extension ~loc a1 = +Pattern.create ~ppat_desc:(Pattern_desc.ppat_extension a1) ~ppat_loc:loc ~ppat_attributes:(Attributes.of_concrete []) ~ppat_loc_stack:[] +let ppat_open ~loc a1 a2 = +Pattern.create ~ppat_desc:(Pattern_desc.ppat_open a1 a2) ~ppat_loc:loc ~ppat_attributes:(Attributes.of_concrete []) ~ppat_loc_stack:[] +let pexp_ident ~loc a1 = +Expression.create ~pexp_desc:(Expression_desc.pexp_ident a1) ~pexp_loc:loc ~pexp_attributes:(Attributes.of_concrete []) ~pexp_loc_stack:[] +let pexp_constant ~loc a1 = +Expression.create ~pexp_desc:(Expression_desc.pexp_constant a1) ~pexp_loc:loc ~pexp_attributes:(Attributes.of_concrete []) ~pexp_loc_stack:[] +let pexp_let ~loc a1 a2 a3 = +Expression.create ~pexp_desc:(Expression_desc.pexp_let a1 a2 a3) ~pexp_loc:loc ~pexp_attributes:(Attributes.of_concrete []) ~pexp_loc_stack:[] +let pexp_function ~loc a1 = +Expression.create ~pexp_desc:(Expression_desc.pexp_function a1) ~pexp_loc:loc ~pexp_attributes:(Attributes.of_concrete []) ~pexp_loc_stack:[] +let pexp_fun ~loc a1 a2 a3 a4 = +Expression.create ~pexp_desc:(Expression_desc.pexp_fun a1 a2 a3 a4) ~pexp_loc:loc ~pexp_attributes:(Attributes.of_concrete []) ~pexp_loc_stack:[] +let pexp_apply ~loc a1 a2 = +Expression.create ~pexp_desc:(Expression_desc.pexp_apply a1 a2) ~pexp_loc:loc ~pexp_attributes:(Attributes.of_concrete []) ~pexp_loc_stack:[] +let pexp_match ~loc a1 a2 = +Expression.create ~pexp_desc:(Expression_desc.pexp_match a1 a2) ~pexp_loc:loc ~pexp_attributes:(Attributes.of_concrete []) ~pexp_loc_stack:[] +let pexp_try ~loc a1 a2 = +Expression.create ~pexp_desc:(Expression_desc.pexp_try a1 a2) ~pexp_loc:loc ~pexp_attributes:(Attributes.of_concrete []) ~pexp_loc_stack:[] +let pexp_tuple ~loc a1 = +Expression.create ~pexp_desc:(Expression_desc.pexp_tuple a1) ~pexp_loc:loc ~pexp_attributes:(Attributes.of_concrete []) ~pexp_loc_stack:[] +let pexp_construct ~loc a1 a2 = +Expression.create ~pexp_desc:(Expression_desc.pexp_construct a1 a2) ~pexp_loc:loc ~pexp_attributes:(Attributes.of_concrete []) ~pexp_loc_stack:[] +let pexp_variant ~loc a1 a2 = +Expression.create ~pexp_desc:(Expression_desc.pexp_variant a1 a2) ~pexp_loc:loc ~pexp_attributes:(Attributes.of_concrete []) ~pexp_loc_stack:[] +let pexp_record ~loc a1 a2 = +Expression.create ~pexp_desc:(Expression_desc.pexp_record a1 a2) ~pexp_loc:loc ~pexp_attributes:(Attributes.of_concrete []) ~pexp_loc_stack:[] +let pexp_field ~loc a1 a2 = +Expression.create ~pexp_desc:(Expression_desc.pexp_field a1 a2) ~pexp_loc:loc ~pexp_attributes:(Attributes.of_concrete []) ~pexp_loc_stack:[] +let pexp_setfield ~loc a1 a2 a3 = +Expression.create ~pexp_desc:(Expression_desc.pexp_setfield a1 a2 a3) ~pexp_loc:loc ~pexp_attributes:(Attributes.of_concrete []) ~pexp_loc_stack:[] +let pexp_array ~loc a1 = +Expression.create ~pexp_desc:(Expression_desc.pexp_array a1) ~pexp_loc:loc ~pexp_attributes:(Attributes.of_concrete []) ~pexp_loc_stack:[] +let pexp_ifthenelse ~loc a1 a2 a3 = +Expression.create ~pexp_desc:(Expression_desc.pexp_ifthenelse a1 a2 a3) ~pexp_loc:loc ~pexp_attributes:(Attributes.of_concrete []) ~pexp_loc_stack:[] +let pexp_sequence ~loc a1 a2 = +Expression.create ~pexp_desc:(Expression_desc.pexp_sequence a1 a2) ~pexp_loc:loc ~pexp_attributes:(Attributes.of_concrete []) ~pexp_loc_stack:[] +let pexp_while ~loc a1 a2 = +Expression.create ~pexp_desc:(Expression_desc.pexp_while a1 a2) ~pexp_loc:loc ~pexp_attributes:(Attributes.of_concrete []) ~pexp_loc_stack:[] +let pexp_for ~loc a1 a2 a3 a4 a5 = +Expression.create ~pexp_desc:(Expression_desc.pexp_for a1 a2 a3 a4 a5) ~pexp_loc:loc ~pexp_attributes:(Attributes.of_concrete []) ~pexp_loc_stack:[] +let pexp_constraint ~loc a1 a2 = +Expression.create ~pexp_desc:(Expression_desc.pexp_constraint a1 a2) ~pexp_loc:loc ~pexp_attributes:(Attributes.of_concrete []) ~pexp_loc_stack:[] +let pexp_coerce ~loc a1 a2 a3 = +Expression.create ~pexp_desc:(Expression_desc.pexp_coerce a1 a2 a3) ~pexp_loc:loc ~pexp_attributes:(Attributes.of_concrete []) ~pexp_loc_stack:[] +let pexp_send ~loc a1 a2 = +Expression.create ~pexp_desc:(Expression_desc.pexp_send a1 a2) ~pexp_loc:loc ~pexp_attributes:(Attributes.of_concrete []) ~pexp_loc_stack:[] +let pexp_new ~loc a1 = +Expression.create ~pexp_desc:(Expression_desc.pexp_new a1) ~pexp_loc:loc ~pexp_attributes:(Attributes.of_concrete []) ~pexp_loc_stack:[] +let pexp_setinstvar ~loc a1 a2 = +Expression.create ~pexp_desc:(Expression_desc.pexp_setinstvar a1 a2) ~pexp_loc:loc ~pexp_attributes:(Attributes.of_concrete []) ~pexp_loc_stack:[] +let pexp_override ~loc a1 = +Expression.create ~pexp_desc:(Expression_desc.pexp_override a1) ~pexp_loc:loc ~pexp_attributes:(Attributes.of_concrete []) ~pexp_loc_stack:[] +let pexp_letmodule ~loc a1 a2 a3 = +Expression.create ~pexp_desc:(Expression_desc.pexp_letmodule a1 a2 a3) ~pexp_loc:loc ~pexp_attributes:(Attributes.of_concrete []) ~pexp_loc_stack:[] +let pexp_letexception ~loc a1 a2 = +Expression.create ~pexp_desc:(Expression_desc.pexp_letexception a1 a2) ~pexp_loc:loc ~pexp_attributes:(Attributes.of_concrete []) ~pexp_loc_stack:[] +let pexp_assert ~loc a1 = +Expression.create ~pexp_desc:(Expression_desc.pexp_assert a1) ~pexp_loc:loc ~pexp_attributes:(Attributes.of_concrete []) ~pexp_loc_stack:[] +let pexp_lazy ~loc a1 = +Expression.create ~pexp_desc:(Expression_desc.pexp_lazy a1) ~pexp_loc:loc ~pexp_attributes:(Attributes.of_concrete []) ~pexp_loc_stack:[] +let pexp_poly ~loc a1 a2 = +Expression.create ~pexp_desc:(Expression_desc.pexp_poly a1 a2) ~pexp_loc:loc ~pexp_attributes:(Attributes.of_concrete []) ~pexp_loc_stack:[] +let pexp_object ~loc a1 = +Expression.create ~pexp_desc:(Expression_desc.pexp_object a1) ~pexp_loc:loc ~pexp_attributes:(Attributes.of_concrete []) ~pexp_loc_stack:[] +let pexp_newtype ~loc a1 a2 = +Expression.create ~pexp_desc:(Expression_desc.pexp_newtype a1 a2) ~pexp_loc:loc ~pexp_attributes:(Attributes.of_concrete []) ~pexp_loc_stack:[] +let pexp_pack ~loc a1 = +Expression.create ~pexp_desc:(Expression_desc.pexp_pack a1) ~pexp_loc:loc ~pexp_attributes:(Attributes.of_concrete []) ~pexp_loc_stack:[] +let pexp_open ~loc a1 a2 = +Expression.create ~pexp_desc:(Expression_desc.pexp_open a1 a2) ~pexp_loc:loc ~pexp_attributes:(Attributes.of_concrete []) ~pexp_loc_stack:[] +let pexp_letop ~loc a1 = +Expression.create ~pexp_desc:(Expression_desc.pexp_letop a1) ~pexp_loc:loc ~pexp_attributes:(Attributes.of_concrete []) ~pexp_loc_stack:[] +let pexp_extension ~loc a1 = +Expression.create ~pexp_desc:(Expression_desc.pexp_extension a1) ~pexp_loc:loc ~pexp_attributes:(Attributes.of_concrete []) ~pexp_loc_stack:[] +let pexp_unreachable ~loc = +Expression.create ~pexp_desc:(Expression_desc.pexp_unreachable) ~pexp_loc:loc ~pexp_attributes:(Attributes.of_concrete []) ~pexp_loc_stack:[] +let case ~guard ~lhs ~rhs = +Case.create ~pc_lhs:lhs ~pc_guard:guard ~pc_rhs:rhs +let letop ~ands ~body ~let_ = +Letop.create ~let_ ~ands ~body +let binding_op ~loc ~exp ~op ~pat = +Binding_op.create ~pbop_op:op ~pbop_pat:pat ~pbop_exp:exp ~pbop_loc:loc +let value_description ~loc ~name ~prim ~type_ = +Value_description.create ~pval_name:name ~pval_type:type_ ~pval_prim:prim ~pval_attributes:(Attributes.of_concrete []) ~pval_loc:loc +let type_declaration ~loc ~cstrs ~kind ~manifest ~name ~params ~private_ = +Type_declaration.create ~ptype_name:name ~ptype_params:params ~ptype_cstrs:cstrs ~ptype_kind:kind ~ptype_private:private_ ~ptype_manifest:manifest ~ptype_attributes:(Attributes.of_concrete []) ~ptype_loc:loc +let label_declaration ~loc ~mutable_ ~name ~type_ = +Label_declaration.create ~pld_name:name ~pld_mutable:mutable_ ~pld_type:type_ ~pld_loc:loc ~pld_attributes:(Attributes.of_concrete []) +let constructor_declaration ~loc ~args ~name ~res = +Constructor_declaration.create ~pcd_name:name ~pcd_args:args ~pcd_res:res ~pcd_loc:loc ~pcd_attributes:(Attributes.of_concrete []) +let type_extension ~loc ~constructors ~params ~path ~private_ = +Type_extension.create ~ptyext_path:path ~ptyext_params:params ~ptyext_constructors:constructors ~ptyext_private:private_ ~ptyext_loc:loc ~ptyext_attributes:(Attributes.of_concrete []) +let extension_constructor ~loc ~kind ~name = +Extension_constructor.create ~pext_name:name ~pext_kind:kind ~pext_loc:loc ~pext_attributes:(Attributes.of_concrete []) +let type_exception ~loc ~constructor = +Type_exception.create ~ptyexn_constructor:constructor ~ptyexn_loc:loc ~ptyexn_attributes:(Attributes.of_concrete []) +let pcty_constr ~loc a1 a2 = +Class_type.create ~pcty_desc:(Class_type_desc.pcty_constr a1 a2) ~pcty_loc:loc ~pcty_attributes:(Attributes.of_concrete []) +let pcty_signature ~loc a1 = +Class_type.create ~pcty_desc:(Class_type_desc.pcty_signature a1) ~pcty_loc:loc ~pcty_attributes:(Attributes.of_concrete []) +let pcty_arrow ~loc a1 a2 a3 = +Class_type.create ~pcty_desc:(Class_type_desc.pcty_arrow a1 a2 a3) ~pcty_loc:loc ~pcty_attributes:(Attributes.of_concrete []) +let pcty_extension ~loc a1 = +Class_type.create ~pcty_desc:(Class_type_desc.pcty_extension a1) ~pcty_loc:loc ~pcty_attributes:(Attributes.of_concrete []) +let pcty_open ~loc a1 a2 = +Class_type.create ~pcty_desc:(Class_type_desc.pcty_open a1 a2) ~pcty_loc:loc ~pcty_attributes:(Attributes.of_concrete []) +let class_signature ~fields ~self = +Class_signature.create ~pcsig_self:self ~pcsig_fields:fields +let pctf_inherit ~loc a1 = +Class_type_field.create ~pctf_desc:(Class_type_field_desc.pctf_inherit a1) ~pctf_loc:loc ~pctf_attributes:(Attributes.of_concrete []) +let pctf_val ~loc a1 = +Class_type_field.create ~pctf_desc:(Class_type_field_desc.pctf_val a1) ~pctf_loc:loc ~pctf_attributes:(Attributes.of_concrete []) +let pctf_method ~loc a1 = +Class_type_field.create ~pctf_desc:(Class_type_field_desc.pctf_method a1) ~pctf_loc:loc ~pctf_attributes:(Attributes.of_concrete []) +let pctf_constraint ~loc a1 = +Class_type_field.create ~pctf_desc:(Class_type_field_desc.pctf_constraint a1) ~pctf_loc:loc ~pctf_attributes:(Attributes.of_concrete []) +let pctf_attribute ~loc a1 = +Class_type_field.create ~pctf_desc:(Class_type_field_desc.pctf_attribute a1) ~pctf_loc:loc ~pctf_attributes:(Attributes.of_concrete []) +let pctf_extension ~loc a1 = +Class_type_field.create ~pctf_desc:(Class_type_field_desc.pctf_extension a1) ~pctf_loc:loc ~pctf_attributes:(Attributes.of_concrete []) +let pcl_constr ~loc a1 a2 = +Class_expr.create ~pcl_desc:(Class_expr_desc.pcl_constr a1 a2) ~pcl_loc:loc ~pcl_attributes:(Attributes.of_concrete []) +let pcl_structure ~loc a1 = +Class_expr.create ~pcl_desc:(Class_expr_desc.pcl_structure a1) ~pcl_loc:loc ~pcl_attributes:(Attributes.of_concrete []) +let pcl_fun ~loc a1 a2 a3 a4 = +Class_expr.create ~pcl_desc:(Class_expr_desc.pcl_fun a1 a2 a3 a4) ~pcl_loc:loc ~pcl_attributes:(Attributes.of_concrete []) +let pcl_apply ~loc a1 a2 = +Class_expr.create ~pcl_desc:(Class_expr_desc.pcl_apply a1 a2) ~pcl_loc:loc ~pcl_attributes:(Attributes.of_concrete []) +let pcl_let ~loc a1 a2 a3 = +Class_expr.create ~pcl_desc:(Class_expr_desc.pcl_let a1 a2 a3) ~pcl_loc:loc ~pcl_attributes:(Attributes.of_concrete []) +let pcl_constraint ~loc a1 a2 = +Class_expr.create ~pcl_desc:(Class_expr_desc.pcl_constraint a1 a2) ~pcl_loc:loc ~pcl_attributes:(Attributes.of_concrete []) +let pcl_extension ~loc a1 = +Class_expr.create ~pcl_desc:(Class_expr_desc.pcl_extension a1) ~pcl_loc:loc ~pcl_attributes:(Attributes.of_concrete []) +let pcl_open ~loc a1 a2 = +Class_expr.create ~pcl_desc:(Class_expr_desc.pcl_open a1 a2) ~pcl_loc:loc ~pcl_attributes:(Attributes.of_concrete []) +let class_structure ~fields ~self = +Class_structure.create ~pcstr_self:self ~pcstr_fields:fields +let pcf_inherit ~loc a1 a2 a3 = +Class_field.create ~pcf_desc:(Class_field_desc.pcf_inherit a1 a2 a3) ~pcf_loc:loc ~pcf_attributes:(Attributes.of_concrete []) +let pcf_val ~loc a1 = +Class_field.create ~pcf_desc:(Class_field_desc.pcf_val a1) ~pcf_loc:loc ~pcf_attributes:(Attributes.of_concrete []) +let pcf_method ~loc a1 = +Class_field.create ~pcf_desc:(Class_field_desc.pcf_method a1) ~pcf_loc:loc ~pcf_attributes:(Attributes.of_concrete []) +let pcf_constraint ~loc a1 = +Class_field.create ~pcf_desc:(Class_field_desc.pcf_constraint a1) ~pcf_loc:loc ~pcf_attributes:(Attributes.of_concrete []) +let pcf_initializer ~loc a1 = +Class_field.create ~pcf_desc:(Class_field_desc.pcf_initializer a1) ~pcf_loc:loc ~pcf_attributes:(Attributes.of_concrete []) +let pcf_attribute ~loc a1 = +Class_field.create ~pcf_desc:(Class_field_desc.pcf_attribute a1) ~pcf_loc:loc ~pcf_attributes:(Attributes.of_concrete []) +let pcf_extension ~loc a1 = +Class_field.create ~pcf_desc:(Class_field_desc.pcf_extension a1) ~pcf_loc:loc ~pcf_attributes:(Attributes.of_concrete []) +let pmty_ident ~loc a1 = +Module_type.create ~pmty_desc:(Module_type_desc.pmty_ident a1) ~pmty_loc:loc ~pmty_attributes:(Attributes.of_concrete []) +let pmty_signature ~loc a1 = +Module_type.create ~pmty_desc:(Module_type_desc.pmty_signature a1) ~pmty_loc:loc ~pmty_attributes:(Attributes.of_concrete []) +let pmty_functor ~loc a1 a2 a3 = +Module_type.create ~pmty_desc:(Module_type_desc.pmty_functor a1 a2 a3) ~pmty_loc:loc ~pmty_attributes:(Attributes.of_concrete []) +let pmty_with ~loc a1 a2 = +Module_type.create ~pmty_desc:(Module_type_desc.pmty_with a1 a2) ~pmty_loc:loc ~pmty_attributes:(Attributes.of_concrete []) +let pmty_typeof ~loc a1 = +Module_type.create ~pmty_desc:(Module_type_desc.pmty_typeof a1) ~pmty_loc:loc ~pmty_attributes:(Attributes.of_concrete []) +let pmty_extension ~loc a1 = +Module_type.create ~pmty_desc:(Module_type_desc.pmty_extension a1) ~pmty_loc:loc ~pmty_attributes:(Attributes.of_concrete []) +let pmty_alias ~loc a1 = +Module_type.create ~pmty_desc:(Module_type_desc.pmty_alias a1) ~pmty_loc:loc ~pmty_attributes:(Attributes.of_concrete []) +let psig_value ~loc a1 = +Signature_item.create ~psig_desc:(Signature_item_desc.psig_value a1) ~psig_loc:loc +let psig_type ~loc a1 a2 = +Signature_item.create ~psig_desc:(Signature_item_desc.psig_type a1 a2) ~psig_loc:loc +let psig_typesubst ~loc a1 = +Signature_item.create ~psig_desc:(Signature_item_desc.psig_typesubst a1) ~psig_loc:loc +let psig_typext ~loc a1 = +Signature_item.create ~psig_desc:(Signature_item_desc.psig_typext a1) ~psig_loc:loc +let psig_exception ~loc a1 = +Signature_item.create ~psig_desc:(Signature_item_desc.psig_exception a1) ~psig_loc:loc +let psig_module ~loc a1 = +Signature_item.create ~psig_desc:(Signature_item_desc.psig_module a1) ~psig_loc:loc +let psig_modsubst ~loc a1 = +Signature_item.create ~psig_desc:(Signature_item_desc.psig_modsubst a1) ~psig_loc:loc +let psig_recmodule ~loc a1 = +Signature_item.create ~psig_desc:(Signature_item_desc.psig_recmodule a1) ~psig_loc:loc +let psig_modtype ~loc a1 = +Signature_item.create ~psig_desc:(Signature_item_desc.psig_modtype a1) ~psig_loc:loc +let psig_open ~loc a1 = +Signature_item.create ~psig_desc:(Signature_item_desc.psig_open a1) ~psig_loc:loc +let psig_include ~loc a1 = +Signature_item.create ~psig_desc:(Signature_item_desc.psig_include a1) ~psig_loc:loc +let psig_class ~loc a1 = +Signature_item.create ~psig_desc:(Signature_item_desc.psig_class a1) ~psig_loc:loc +let psig_class_type ~loc a1 = +Signature_item.create ~psig_desc:(Signature_item_desc.psig_class_type a1) ~psig_loc:loc +let psig_attribute ~loc a1 = +Signature_item.create ~psig_desc:(Signature_item_desc.psig_attribute a1) ~psig_loc:loc +let psig_extension ~loc a1 a2 = +Signature_item.create ~psig_desc:(Signature_item_desc.psig_extension a1 a2) ~psig_loc:loc +let module_declaration ~loc ~name ~type_ = +Module_declaration.create ~pmd_name:name ~pmd_type:type_ ~pmd_attributes:(Attributes.of_concrete []) ~pmd_loc:loc +let module_substitution ~loc ~manifest ~name = +Module_substitution.create ~pms_name:name ~pms_manifest:manifest ~pms_attributes:(Attributes.of_concrete []) ~pms_loc:loc +let module_type_declaration ~loc ~name ~type_ = +Module_type_declaration.create ~pmtd_name:name ~pmtd_type:type_ ~pmtd_attributes:(Attributes.of_concrete []) ~pmtd_loc:loc +let pmod_ident ~loc a1 = +Module_expr.create ~pmod_desc:(Module_expr_desc.pmod_ident a1) ~pmod_loc:loc ~pmod_attributes:(Attributes.of_concrete []) +let pmod_structure ~loc a1 = +Module_expr.create ~pmod_desc:(Module_expr_desc.pmod_structure a1) ~pmod_loc:loc ~pmod_attributes:(Attributes.of_concrete []) +let pmod_functor ~loc a1 a2 a3 = +Module_expr.create ~pmod_desc:(Module_expr_desc.pmod_functor a1 a2 a3) ~pmod_loc:loc ~pmod_attributes:(Attributes.of_concrete []) +let pmod_apply ~loc a1 a2 = +Module_expr.create ~pmod_desc:(Module_expr_desc.pmod_apply a1 a2) ~pmod_loc:loc ~pmod_attributes:(Attributes.of_concrete []) +let pmod_constraint ~loc a1 a2 = +Module_expr.create ~pmod_desc:(Module_expr_desc.pmod_constraint a1 a2) ~pmod_loc:loc ~pmod_attributes:(Attributes.of_concrete []) +let pmod_unpack ~loc a1 = +Module_expr.create ~pmod_desc:(Module_expr_desc.pmod_unpack a1) ~pmod_loc:loc ~pmod_attributes:(Attributes.of_concrete []) +let pmod_extension ~loc a1 = +Module_expr.create ~pmod_desc:(Module_expr_desc.pmod_extension a1) ~pmod_loc:loc ~pmod_attributes:(Attributes.of_concrete []) +let pstr_eval ~loc a1 a2 = +Structure_item.create ~pstr_desc:(Structure_item_desc.pstr_eval a1 a2) ~pstr_loc:loc +let pstr_value ~loc a1 a2 = +Structure_item.create ~pstr_desc:(Structure_item_desc.pstr_value a1 a2) ~pstr_loc:loc +let pstr_primitive ~loc a1 = +Structure_item.create ~pstr_desc:(Structure_item_desc.pstr_primitive a1) ~pstr_loc:loc +let pstr_type ~loc a1 a2 = +Structure_item.create ~pstr_desc:(Structure_item_desc.pstr_type a1 a2) ~pstr_loc:loc +let pstr_typext ~loc a1 = +Structure_item.create ~pstr_desc:(Structure_item_desc.pstr_typext a1) ~pstr_loc:loc +let pstr_exception ~loc a1 = +Structure_item.create ~pstr_desc:(Structure_item_desc.pstr_exception a1) ~pstr_loc:loc +let pstr_module ~loc a1 = +Structure_item.create ~pstr_desc:(Structure_item_desc.pstr_module a1) ~pstr_loc:loc +let pstr_recmodule ~loc a1 = +Structure_item.create ~pstr_desc:(Structure_item_desc.pstr_recmodule a1) ~pstr_loc:loc +let pstr_modtype ~loc a1 = +Structure_item.create ~pstr_desc:(Structure_item_desc.pstr_modtype a1) ~pstr_loc:loc +let pstr_open ~loc a1 = +Structure_item.create ~pstr_desc:(Structure_item_desc.pstr_open a1) ~pstr_loc:loc +let pstr_class ~loc a1 = +Structure_item.create ~pstr_desc:(Structure_item_desc.pstr_class a1) ~pstr_loc:loc +let pstr_class_type ~loc a1 = +Structure_item.create ~pstr_desc:(Structure_item_desc.pstr_class_type a1) ~pstr_loc:loc +let pstr_include ~loc a1 = +Structure_item.create ~pstr_desc:(Structure_item_desc.pstr_include a1) ~pstr_loc:loc +let pstr_attribute ~loc a1 = +Structure_item.create ~pstr_desc:(Structure_item_desc.pstr_attribute a1) ~pstr_loc:loc +let pstr_extension ~loc a1 a2 = +Structure_item.create ~pstr_desc:(Structure_item_desc.pstr_extension a1 a2) ~pstr_loc:loc +let value_binding ~loc ~expr ~pat = +Value_binding.create ~pvb_pat:pat ~pvb_expr:expr ~pvb_attributes:(Attributes.of_concrete []) ~pvb_loc:loc +let module_binding ~loc ~expr ~name = +Module_binding.create ~pmb_name:name ~pmb_expr:expr ~pmb_attributes:(Attributes.of_concrete []) ~pmb_loc:loc +let toplevel_directive ~loc ~arg ~name = +Toplevel_directive.create ~pdir_name:name ~pdir_arg:arg ~pdir_loc:loc +let pdir_string ~loc a1 = +Directive_argument.create ~pdira_desc:(Directive_argument_desc.pdir_string a1) ~pdira_loc:loc +let pdir_int ~loc a1 a2 = +Directive_argument.create ~pdira_desc:(Directive_argument_desc.pdir_int a1 a2) ~pdira_loc:loc +let pdir_ident ~loc a1 = +Directive_argument.create ~pdira_desc:(Directive_argument_desc.pdir_ident a1) ~pdira_loc:loc +let pdir_bool ~loc a1 = +Directive_argument.create ~pdira_desc:(Directive_argument_desc.pdir_bool a1) ~pdira_loc:loc +(*$*) diff --git a/ast/builder_v4_08.mli b/ast/builder_v4_08.mli new file mode 100644 index 00000000..472f5d28 --- /dev/null +++ b/ast/builder_v4_08.mli @@ -0,0 +1,764 @@ +(*$ Ppx_ast_cinaps.print_builder_mli (Astlib.Version.of_string "v4_08") *) +open Versions.V4_08 +val attribute : + loc:Astlib.Location.t + -> name:string Astlib.Loc.t + -> payload:Payload.t + -> Attribute.t +val ptyp_any : + loc:Astlib.Location.t + -> Core_type.t +val ptyp_var : + loc:Astlib.Location.t + -> string + -> Core_type.t +val ptyp_arrow : + loc:Astlib.Location.t + -> Arg_label.t + -> Core_type.t + -> Core_type.t + -> Core_type.t +val ptyp_tuple : + loc:Astlib.Location.t + -> Core_type.t list + -> Core_type.t +val ptyp_constr : + loc:Astlib.Location.t + -> Longident_loc.t + -> Core_type.t list + -> Core_type.t +val ptyp_object : + loc:Astlib.Location.t + -> Object_field.t list + -> Closed_flag.t + -> Core_type.t +val ptyp_class : + loc:Astlib.Location.t + -> Longident_loc.t + -> Core_type.t list + -> Core_type.t +val ptyp_alias : + loc:Astlib.Location.t + -> Core_type.t + -> string + -> Core_type.t +val ptyp_variant : + loc:Astlib.Location.t + -> Row_field.t list + -> Closed_flag.t + -> string list option + -> Core_type.t +val ptyp_poly : + loc:Astlib.Location.t + -> string Astlib.Loc.t list + -> Core_type.t + -> Core_type.t +val ptyp_package : + loc:Astlib.Location.t + -> Package_type.t + -> Core_type.t +val ptyp_extension : + loc:Astlib.Location.t + -> Extension.t + -> Core_type.t +val rtag : + loc:Astlib.Location.t + -> string Astlib.Loc.t + -> bool + -> Core_type.t list + -> Row_field.t +val rinherit : + loc:Astlib.Location.t + -> Core_type.t + -> Row_field.t +val otag : + loc:Astlib.Location.t + -> string Astlib.Loc.t + -> Core_type.t + -> Object_field.t +val oinherit : + loc:Astlib.Location.t + -> Core_type.t + -> Object_field.t +val ppat_any : + loc:Astlib.Location.t + -> Pattern.t +val ppat_var : + loc:Astlib.Location.t + -> string Astlib.Loc.t + -> Pattern.t +val ppat_alias : + loc:Astlib.Location.t + -> Pattern.t + -> string Astlib.Loc.t + -> Pattern.t +val ppat_constant : + loc:Astlib.Location.t + -> Constant.t + -> Pattern.t +val ppat_interval : + loc:Astlib.Location.t + -> Constant.t + -> Constant.t + -> Pattern.t +val ppat_tuple : + loc:Astlib.Location.t + -> Pattern.t list + -> Pattern.t +val ppat_construct : + loc:Astlib.Location.t + -> Longident_loc.t + -> Pattern.t option + -> Pattern.t +val ppat_variant : + loc:Astlib.Location.t + -> string + -> Pattern.t option + -> Pattern.t +val ppat_record : + loc:Astlib.Location.t + -> (Longident_loc.t * Pattern.t) list + -> Closed_flag.t + -> Pattern.t +val ppat_array : + loc:Astlib.Location.t + -> Pattern.t list + -> Pattern.t +val ppat_or : + loc:Astlib.Location.t + -> Pattern.t + -> Pattern.t + -> Pattern.t +val ppat_constraint : + loc:Astlib.Location.t + -> Pattern.t + -> Core_type.t + -> Pattern.t +val ppat_type : + loc:Astlib.Location.t + -> Longident_loc.t + -> Pattern.t +val ppat_lazy : + loc:Astlib.Location.t + -> Pattern.t + -> Pattern.t +val ppat_unpack : + loc:Astlib.Location.t + -> string Astlib.Loc.t + -> Pattern.t +val ppat_exception : + loc:Astlib.Location.t + -> Pattern.t + -> Pattern.t +val ppat_extension : + loc:Astlib.Location.t + -> Extension.t + -> Pattern.t +val ppat_open : + loc:Astlib.Location.t + -> Longident_loc.t + -> Pattern.t + -> Pattern.t +val pexp_ident : + loc:Astlib.Location.t + -> Longident_loc.t + -> Expression.t +val pexp_constant : + loc:Astlib.Location.t + -> Constant.t + -> Expression.t +val pexp_let : + loc:Astlib.Location.t + -> Rec_flag.t + -> Value_binding.t list + -> Expression.t + -> Expression.t +val pexp_function : + loc:Astlib.Location.t + -> Case.t list + -> Expression.t +val pexp_fun : + loc:Astlib.Location.t + -> Arg_label.t + -> Expression.t option + -> Pattern.t + -> Expression.t + -> Expression.t +val pexp_apply : + loc:Astlib.Location.t + -> Expression.t + -> (Arg_label.t * Expression.t) list + -> Expression.t +val pexp_match : + loc:Astlib.Location.t + -> Expression.t + -> Case.t list + -> Expression.t +val pexp_try : + loc:Astlib.Location.t + -> Expression.t + -> Case.t list + -> Expression.t +val pexp_tuple : + loc:Astlib.Location.t + -> Expression.t list + -> Expression.t +val pexp_construct : + loc:Astlib.Location.t + -> Longident_loc.t + -> Expression.t option + -> Expression.t +val pexp_variant : + loc:Astlib.Location.t + -> string + -> Expression.t option + -> Expression.t +val pexp_record : + loc:Astlib.Location.t + -> (Longident_loc.t * Expression.t) list + -> Expression.t option + -> Expression.t +val pexp_field : + loc:Astlib.Location.t + -> Expression.t + -> Longident_loc.t + -> Expression.t +val pexp_setfield : + loc:Astlib.Location.t + -> Expression.t + -> Longident_loc.t + -> Expression.t + -> Expression.t +val pexp_array : + loc:Astlib.Location.t + -> Expression.t list + -> Expression.t +val pexp_ifthenelse : + loc:Astlib.Location.t + -> Expression.t + -> Expression.t + -> Expression.t option + -> Expression.t +val pexp_sequence : + loc:Astlib.Location.t + -> Expression.t + -> Expression.t + -> Expression.t +val pexp_while : + loc:Astlib.Location.t + -> Expression.t + -> Expression.t + -> Expression.t +val pexp_for : + loc:Astlib.Location.t + -> Pattern.t + -> Expression.t + -> Expression.t + -> Direction_flag.t + -> Expression.t + -> Expression.t +val pexp_constraint : + loc:Astlib.Location.t + -> Expression.t + -> Core_type.t + -> Expression.t +val pexp_coerce : + loc:Astlib.Location.t + -> Expression.t + -> Core_type.t option + -> Core_type.t + -> Expression.t +val pexp_send : + loc:Astlib.Location.t + -> Expression.t + -> string Astlib.Loc.t + -> Expression.t +val pexp_new : + loc:Astlib.Location.t + -> Longident_loc.t + -> Expression.t +val pexp_setinstvar : + loc:Astlib.Location.t + -> string Astlib.Loc.t + -> Expression.t + -> Expression.t +val pexp_override : + loc:Astlib.Location.t + -> (string Astlib.Loc.t * Expression.t) list + -> Expression.t +val pexp_letmodule : + loc:Astlib.Location.t + -> string Astlib.Loc.t + -> Module_expr.t + -> Expression.t + -> Expression.t +val pexp_letexception : + loc:Astlib.Location.t + -> Extension_constructor.t + -> Expression.t + -> Expression.t +val pexp_assert : + loc:Astlib.Location.t + -> Expression.t + -> Expression.t +val pexp_lazy : + loc:Astlib.Location.t + -> Expression.t + -> Expression.t +val pexp_poly : + loc:Astlib.Location.t + -> Expression.t + -> Core_type.t option + -> Expression.t +val pexp_object : + loc:Astlib.Location.t + -> Class_structure.t + -> Expression.t +val pexp_newtype : + loc:Astlib.Location.t + -> string Astlib.Loc.t + -> Expression.t + -> Expression.t +val pexp_pack : + loc:Astlib.Location.t + -> Module_expr.t + -> Expression.t +val pexp_open : + loc:Astlib.Location.t + -> Open_declaration.t + -> Expression.t + -> Expression.t +val pexp_letop : + loc:Astlib.Location.t + -> Letop.t + -> Expression.t +val pexp_extension : + loc:Astlib.Location.t + -> Extension.t + -> Expression.t +val pexp_unreachable : + loc:Astlib.Location.t + -> Expression.t +val case : + guard:Expression.t option + -> lhs:Pattern.t + -> rhs:Expression.t + -> Case.t +val letop : + ands:Binding_op.t list + -> body:Expression.t + -> let_:Binding_op.t + -> Letop.t +val binding_op : + loc:Astlib.Location.t + -> exp:Expression.t + -> op:string Astlib.Loc.t + -> pat:Pattern.t + -> Binding_op.t +val value_description : + loc:Astlib.Location.t + -> name:string Astlib.Loc.t + -> prim:string list + -> type_:Core_type.t + -> Value_description.t +val type_declaration : + loc:Astlib.Location.t + -> cstrs:(Core_type.t * Core_type.t * Astlib.Location.t) list + -> kind:Type_kind.t + -> manifest:Core_type.t option + -> name:string Astlib.Loc.t + -> params:(Core_type.t * Variance.t) list + -> private_:Private_flag.t + -> Type_declaration.t +val label_declaration : + loc:Astlib.Location.t + -> mutable_:Mutable_flag.t + -> name:string Astlib.Loc.t + -> type_:Core_type.t + -> Label_declaration.t +val constructor_declaration : + loc:Astlib.Location.t + -> args:Constructor_arguments.t + -> name:string Astlib.Loc.t + -> res:Core_type.t option + -> Constructor_declaration.t +val type_extension : + loc:Astlib.Location.t + -> constructors:Extension_constructor.t list + -> params:(Core_type.t * Variance.t) list + -> path:Longident_loc.t + -> private_:Private_flag.t + -> Type_extension.t +val extension_constructor : + loc:Astlib.Location.t + -> kind:Extension_constructor_kind.t + -> name:string Astlib.Loc.t + -> Extension_constructor.t +val type_exception : + loc:Astlib.Location.t + -> constructor:Extension_constructor.t + -> Type_exception.t +val pcty_constr : + loc:Astlib.Location.t + -> Longident_loc.t + -> Core_type.t list + -> Class_type.t +val pcty_signature : + loc:Astlib.Location.t + -> Class_signature.t + -> Class_type.t +val pcty_arrow : + loc:Astlib.Location.t + -> Arg_label.t + -> Core_type.t + -> Class_type.t + -> Class_type.t +val pcty_extension : + loc:Astlib.Location.t + -> Extension.t + -> Class_type.t +val pcty_open : + loc:Astlib.Location.t + -> Open_description.t + -> Class_type.t + -> Class_type.t +val class_signature : + fields:Class_type_field.t list + -> self:Core_type.t + -> Class_signature.t +val pctf_inherit : + loc:Astlib.Location.t + -> Class_type.t + -> Class_type_field.t +val pctf_val : + loc:Astlib.Location.t + -> (string Astlib.Loc.t * Mutable_flag.t * Virtual_flag.t * Core_type.t) + -> Class_type_field.t +val pctf_method : + loc:Astlib.Location.t + -> (string Astlib.Loc.t * Private_flag.t * Virtual_flag.t * Core_type.t) + -> Class_type_field.t +val pctf_constraint : + loc:Astlib.Location.t + -> (Core_type.t * Core_type.t) + -> Class_type_field.t +val pctf_attribute : + loc:Astlib.Location.t + -> Attribute.t + -> Class_type_field.t +val pctf_extension : + loc:Astlib.Location.t + -> Extension.t + -> Class_type_field.t +val pcl_constr : + loc:Astlib.Location.t + -> Longident_loc.t + -> Core_type.t list + -> Class_expr.t +val pcl_structure : + loc:Astlib.Location.t + -> Class_structure.t + -> Class_expr.t +val pcl_fun : + loc:Astlib.Location.t + -> Arg_label.t + -> Expression.t option + -> Pattern.t + -> Class_expr.t + -> Class_expr.t +val pcl_apply : + loc:Astlib.Location.t + -> Class_expr.t + -> (Arg_label.t * Expression.t) list + -> Class_expr.t +val pcl_let : + loc:Astlib.Location.t + -> Rec_flag.t + -> Value_binding.t list + -> Class_expr.t + -> Class_expr.t +val pcl_constraint : + loc:Astlib.Location.t + -> Class_expr.t + -> Class_type.t + -> Class_expr.t +val pcl_extension : + loc:Astlib.Location.t + -> Extension.t + -> Class_expr.t +val pcl_open : + loc:Astlib.Location.t + -> Open_description.t + -> Class_expr.t + -> Class_expr.t +val class_structure : + fields:Class_field.t list + -> self:Pattern.t + -> Class_structure.t +val pcf_inherit : + loc:Astlib.Location.t + -> Override_flag.t + -> Class_expr.t + -> string Astlib.Loc.t option + -> Class_field.t +val pcf_val : + loc:Astlib.Location.t + -> (string Astlib.Loc.t * Mutable_flag.t * Class_field_kind.t) + -> Class_field.t +val pcf_method : + loc:Astlib.Location.t + -> (string Astlib.Loc.t * Private_flag.t * Class_field_kind.t) + -> Class_field.t +val pcf_constraint : + loc:Astlib.Location.t + -> (Core_type.t * Core_type.t) + -> Class_field.t +val pcf_initializer : + loc:Astlib.Location.t + -> Expression.t + -> Class_field.t +val pcf_attribute : + loc:Astlib.Location.t + -> Attribute.t + -> Class_field.t +val pcf_extension : + loc:Astlib.Location.t + -> Extension.t + -> Class_field.t +val pmty_ident : + loc:Astlib.Location.t + -> Longident_loc.t + -> Module_type.t +val pmty_signature : + loc:Astlib.Location.t + -> Signature.t + -> Module_type.t +val pmty_functor : + loc:Astlib.Location.t + -> string Astlib.Loc.t + -> Module_type.t option + -> Module_type.t + -> Module_type.t +val pmty_with : + loc:Astlib.Location.t + -> Module_type.t + -> With_constraint.t list + -> Module_type.t +val pmty_typeof : + loc:Astlib.Location.t + -> Module_expr.t + -> Module_type.t +val pmty_extension : + loc:Astlib.Location.t + -> Extension.t + -> Module_type.t +val pmty_alias : + loc:Astlib.Location.t + -> Longident_loc.t + -> Module_type.t +val psig_value : + loc:Astlib.Location.t + -> Value_description.t + -> Signature_item.t +val psig_type : + loc:Astlib.Location.t + -> Rec_flag.t + -> Type_declaration.t list + -> Signature_item.t +val psig_typesubst : + loc:Astlib.Location.t + -> Type_declaration.t list + -> Signature_item.t +val psig_typext : + loc:Astlib.Location.t + -> Type_extension.t + -> Signature_item.t +val psig_exception : + loc:Astlib.Location.t + -> Type_exception.t + -> Signature_item.t +val psig_module : + loc:Astlib.Location.t + -> Module_declaration.t + -> Signature_item.t +val psig_modsubst : + loc:Astlib.Location.t + -> Module_substitution.t + -> Signature_item.t +val psig_recmodule : + loc:Astlib.Location.t + -> Module_declaration.t list + -> Signature_item.t +val psig_modtype : + loc:Astlib.Location.t + -> Module_type_declaration.t + -> Signature_item.t +val psig_open : + loc:Astlib.Location.t + -> Open_description.t + -> Signature_item.t +val psig_include : + loc:Astlib.Location.t + -> Include_description.t + -> Signature_item.t +val psig_class : + loc:Astlib.Location.t + -> Class_description.t list + -> Signature_item.t +val psig_class_type : + loc:Astlib.Location.t + -> Class_type_declaration.t list + -> Signature_item.t +val psig_attribute : + loc:Astlib.Location.t + -> Attribute.t + -> Signature_item.t +val psig_extension : + loc:Astlib.Location.t + -> Extension.t + -> Attributes.t + -> Signature_item.t +val module_declaration : + loc:Astlib.Location.t + -> name:string Astlib.Loc.t + -> type_:Module_type.t + -> Module_declaration.t +val module_substitution : + loc:Astlib.Location.t + -> manifest:Longident_loc.t + -> name:string Astlib.Loc.t + -> Module_substitution.t +val module_type_declaration : + loc:Astlib.Location.t + -> name:string Astlib.Loc.t + -> type_:Module_type.t option + -> Module_type_declaration.t +val pmod_ident : + loc:Astlib.Location.t + -> Longident_loc.t + -> Module_expr.t +val pmod_structure : + loc:Astlib.Location.t + -> Structure.t + -> Module_expr.t +val pmod_functor : + loc:Astlib.Location.t + -> string Astlib.Loc.t + -> Module_type.t option + -> Module_expr.t + -> Module_expr.t +val pmod_apply : + loc:Astlib.Location.t + -> Module_expr.t + -> Module_expr.t + -> Module_expr.t +val pmod_constraint : + loc:Astlib.Location.t + -> Module_expr.t + -> Module_type.t + -> Module_expr.t +val pmod_unpack : + loc:Astlib.Location.t + -> Expression.t + -> Module_expr.t +val pmod_extension : + loc:Astlib.Location.t + -> Extension.t + -> Module_expr.t +val pstr_eval : + loc:Astlib.Location.t + -> Expression.t + -> Attributes.t + -> Structure_item.t +val pstr_value : + loc:Astlib.Location.t + -> Rec_flag.t + -> Value_binding.t list + -> Structure_item.t +val pstr_primitive : + loc:Astlib.Location.t + -> Value_description.t + -> Structure_item.t +val pstr_type : + loc:Astlib.Location.t + -> Rec_flag.t + -> Type_declaration.t list + -> Structure_item.t +val pstr_typext : + loc:Astlib.Location.t + -> Type_extension.t + -> Structure_item.t +val pstr_exception : + loc:Astlib.Location.t + -> Type_exception.t + -> Structure_item.t +val pstr_module : + loc:Astlib.Location.t + -> Module_binding.t + -> Structure_item.t +val pstr_recmodule : + loc:Astlib.Location.t + -> Module_binding.t list + -> Structure_item.t +val pstr_modtype : + loc:Astlib.Location.t + -> Module_type_declaration.t + -> Structure_item.t +val pstr_open : + loc:Astlib.Location.t + -> Open_declaration.t + -> Structure_item.t +val pstr_class : + loc:Astlib.Location.t + -> Class_declaration.t list + -> Structure_item.t +val pstr_class_type : + loc:Astlib.Location.t + -> Class_type_declaration.t list + -> Structure_item.t +val pstr_include : + loc:Astlib.Location.t + -> Include_declaration.t + -> Structure_item.t +val pstr_attribute : + loc:Astlib.Location.t + -> Attribute.t + -> Structure_item.t +val pstr_extension : + loc:Astlib.Location.t + -> Extension.t + -> Attributes.t + -> Structure_item.t +val value_binding : + loc:Astlib.Location.t + -> expr:Expression.t + -> pat:Pattern.t + -> Value_binding.t +val module_binding : + loc:Astlib.Location.t + -> expr:Module_expr.t + -> name:string Astlib.Loc.t + -> Module_binding.t +val toplevel_directive : + loc:Astlib.Location.t + -> arg:Directive_argument.t option + -> name:string Astlib.Loc.t + -> Toplevel_directive.t +val pdir_string : + loc:Astlib.Location.t + -> string + -> Directive_argument.t +val pdir_int : + loc:Astlib.Location.t + -> string + -> char option + -> Directive_argument.t +val pdir_ident : + loc:Astlib.Location.t + -> Longident.t + -> Directive_argument.t +val pdir_bool : + loc:Astlib.Location.t + -> bool + -> Directive_argument.t +(*$*) diff --git a/ast/cinaps/gen_builder.ml b/ast/cinaps/gen_builder.ml index 5b974ffa..3a71f2ca 100644 --- a/ast/cinaps/gen_builder.ml +++ b/ast/cinaps/gen_builder.ml @@ -164,12 +164,17 @@ module Builder = struct match (shortcut type_name : Shortcut.t option) with | None -> [] | Some {other_fields = _::_; _} -> - (* There currently is only attr, loc and descr in records for which we - have shortcuts and the code here relies on it, if new fields or added - we'll need do deal with them. - Note that a [xxx_loc_stack] has been added in recent OCaml versions. *) + (* There currently is only attr, loc, loc_stack and descr in records for + which we have shortcuts and the code here relies on it, if new fields + are added we'll need do deal with them. *) assert false - | Some {outer_record; desc_field; loc_field; attr_field; other_fields = []; _} -> + | Some + { outer_record + ; desc_field + ; loc_field + ; attr_field + ; loc_stack_field + ; other_fields = []; _} -> let type_ = Astlib.Grammar.Name outer_record in List.map v ~f:(fun (cname, (constr : Astlib.Grammar.clause)) -> let arr = @@ -206,6 +211,7 @@ module Builder = struct [ Some (Some desc_field, desc) ; (loc_field >>| fun fname -> (Some fname, Expr.Ident "loc")) ; (attr_field >>| fun fname -> (Some fname, empty_attributes)) + ; (loc_stack_field >>| fun fname -> (Some fname, Expr.Const Nil)) ] |> List.filter_opt in diff --git a/ast/cinaps/gen_viewer.ml b/ast/cinaps/gen_viewer.ml index c23cb343..907af6fe 100644 --- a/ast/cinaps/gen_viewer.ml +++ b/ast/cinaps/gen_viewer.ml @@ -15,7 +15,11 @@ let wrapper_types grammar = | _ -> acc) let shortcut_viewer_name ~shortcut cname = - let _, base_name = String.lsplit2_exn ~on:'_' cname in + let base_name = + match String.lsplit2 ~on:'_' cname with + | Some (_prefix, basename) -> basename + | None -> String.lowercase_ascii cname + in let prefix = match shortcut.Shortcut.outer_record with | "expression" -> "e" @@ -29,6 +33,9 @@ let shortcut_viewer_name ~shortcut cname = | "class_expr" -> "ce" | "class_type" -> "ct" | "class_type_field" -> "ctf" + | "row_field" -> "rf" + | "object_field" -> "of" + | "directive_argument" -> "da" | s -> failwith "No prefix for shortcut: " ^ s in variant_viewer_name (prefix ^ base_name) diff --git a/ast/cinaps/shortcut.ml b/ast/cinaps/shortcut.ml index 8a6a7e56..591c181d 100644 --- a/ast/cinaps/shortcut.ml +++ b/ast/cinaps/shortcut.ml @@ -6,6 +6,7 @@ type t = ; desc_field : string ; attr_field : string option ; loc_field : string option + ; loc_stack_field : string option ; other_fields : (string * Astlib.Grammar.ty) list } @@ -18,6 +19,7 @@ let find_field ~suffix record : (string * Astlib.Grammar.ty) option = let loc_suffix = "_loc" let desc_suffix = "_desc" let attr_suffix = "_attributes" +let loc_stack_suffix = "_loc_stack" let desc_field record = find_field ~suffix:desc_suffix record @@ -33,13 +35,20 @@ let loc_field record = | Some (loc_field, Location) -> Some loc_field | Some (_, _) -> assert false +let loc_stack_field record = + match find_field ~suffix:loc_stack_suffix record with + | None -> None + | Some (loc_stack_field, List Location) -> Some loc_stack_field + | Some (_, _) -> assert false + let other_fields record = List.filter record ~f:(fun (field_name, _) -> not ( String.is_suffix ~suffix:loc_suffix field_name || String.is_suffix ~suffix:desc_suffix field_name - || String.is_suffix ~suffix:attr_suffix field_name )) + || String.is_suffix ~suffix:attr_suffix field_name + || String.is_suffix ~suffix:loc_stack_suffix field_name)) let from_record ~name record = match desc_field record with @@ -47,10 +56,11 @@ let from_record ~name record = | Some (desc_field, Name inner_variant) -> let loc_field = loc_field record in let attr_field = attr_field record in + let loc_stack_field = loc_stack_field record in let other_fields = other_fields record in Some { outer_record = name; inner_variant - ; desc_field; loc_field; attr_field; other_fields } + ; desc_field; loc_field; attr_field; loc_stack_field; other_fields } | Some (_, _) -> assert false diff --git a/ast/cinaps/shortcut.mli b/ast/cinaps/shortcut.mli index 6c0344e2..40d08f91 100644 --- a/ast/cinaps/shortcut.mli +++ b/ast/cinaps/shortcut.mli @@ -5,6 +5,8 @@ description - [loc_field] is the name of the field in the parent pointing to the location, if any + - [loc_stack_field] is the name of the field in the parent pointing to the + location stack, if any - [attr_field] is the name of the field in the parent pointing to the attributes, if any - [other_fields] is the list of the remaining fields of the parent *) @@ -14,6 +16,7 @@ type t = ; desc_field : string ; attr_field : string option ; loc_field : string option + ; loc_stack_field : string option ; other_fields : (string * Astlib.Grammar.ty) list } diff --git a/ast/conversion.ml b/ast/conversion.ml index b7c65447..18e66636 100644 --- a/ast/conversion.ml +++ b/ast/conversion.ml @@ -2,12 +2,12 @@ open Stdppx (*$ Ppx_ast_cinaps.print_conversion_ml () *) let rec ast_of_longident - : Compiler_types.longident -> Versions.V4_07.Longident.t + : Compiler_types.longident -> Versions.V4_08.Longident.t = fun x -> - Versions.V4_07.Longident.of_concrete (concrete_of_longident x) + Versions.V4_08.Longident.of_concrete (concrete_of_longident x) and concrete_of_longident - : Compiler_types.longident -> Versions.V4_07.Longident.concrete + : Compiler_types.longident -> Versions.V4_08.Longident.concrete = fun x -> match (x : Compiler_types.longident) with | Lident (x1) -> @@ -21,15 +21,15 @@ and concrete_of_longident Lapply (x1, x2) and ast_to_longident - : Versions.V4_07.Longident.t -> Compiler_types.longident + : Versions.V4_08.Longident.t -> Compiler_types.longident = fun x -> - let concrete = Versions.V4_07.Longident.to_concrete x in + let concrete = Versions.V4_08.Longident.to_concrete x in concrete_to_longident concrete and concrete_to_longident - : Versions.V4_07.Longident.concrete -> Compiler_types.longident + : Versions.V4_08.Longident.concrete -> Compiler_types.longident = fun x -> - match (x : Versions.V4_07.Longident.concrete) with + match (x : Versions.V4_08.Longident.concrete) with | Lident (x1) -> Lident (x1) | Ldot (x1, x2) -> @@ -41,208 +41,208 @@ and concrete_to_longident Lapply (x1, x2) and ast_of_longident_loc - : Compiler_types.longident_loc -> Versions.V4_07.Longident_loc.t + : Compiler_types.longident_loc -> Versions.V4_08.Longident_loc.t = fun x -> - Versions.V4_07.Longident_loc.of_concrete (concrete_of_longident_loc x) + Versions.V4_08.Longident_loc.of_concrete (concrete_of_longident_loc x) and concrete_of_longident_loc - : Compiler_types.longident_loc -> Versions.V4_07.Longident_loc.concrete + : Compiler_types.longident_loc -> Versions.V4_08.Longident_loc.concrete = fun x -> (Astlib.Loc.map ~f:ast_of_longident) x and ast_to_longident_loc - : Versions.V4_07.Longident_loc.t -> Compiler_types.longident_loc + : Versions.V4_08.Longident_loc.t -> Compiler_types.longident_loc = fun x -> - let concrete = Versions.V4_07.Longident_loc.to_concrete x in + let concrete = Versions.V4_08.Longident_loc.to_concrete x in concrete_to_longident_loc concrete and concrete_to_longident_loc - : Versions.V4_07.Longident_loc.concrete -> Compiler_types.longident_loc + : Versions.V4_08.Longident_loc.concrete -> Compiler_types.longident_loc = fun x -> (Astlib.Loc.map ~f:ast_to_longident) x and ast_of_rec_flag - : Compiler_types.rec_flag -> Versions.V4_07.Rec_flag.t + : Compiler_types.rec_flag -> Versions.V4_08.Rec_flag.t = fun x -> - Versions.V4_07.Rec_flag.of_concrete (concrete_of_rec_flag x) + Versions.V4_08.Rec_flag.of_concrete (concrete_of_rec_flag x) and concrete_of_rec_flag - : Compiler_types.rec_flag -> Versions.V4_07.Rec_flag.concrete + : Compiler_types.rec_flag -> Versions.V4_08.Rec_flag.concrete = fun x -> match (x : Compiler_types.rec_flag) with | Nonrecursive -> Nonrecursive | Recursive -> Recursive and ast_to_rec_flag - : Versions.V4_07.Rec_flag.t -> Compiler_types.rec_flag + : Versions.V4_08.Rec_flag.t -> Compiler_types.rec_flag = fun x -> - let concrete = Versions.V4_07.Rec_flag.to_concrete x in + let concrete = Versions.V4_08.Rec_flag.to_concrete x in concrete_to_rec_flag concrete and concrete_to_rec_flag - : Versions.V4_07.Rec_flag.concrete -> Compiler_types.rec_flag + : Versions.V4_08.Rec_flag.concrete -> Compiler_types.rec_flag = fun x -> - match (x : Versions.V4_07.Rec_flag.concrete) with + match (x : Versions.V4_08.Rec_flag.concrete) with | Nonrecursive -> Nonrecursive | Recursive -> Recursive and ast_of_direction_flag - : Compiler_types.direction_flag -> Versions.V4_07.Direction_flag.t + : Compiler_types.direction_flag -> Versions.V4_08.Direction_flag.t = fun x -> - Versions.V4_07.Direction_flag.of_concrete (concrete_of_direction_flag x) + Versions.V4_08.Direction_flag.of_concrete (concrete_of_direction_flag x) and concrete_of_direction_flag - : Compiler_types.direction_flag -> Versions.V4_07.Direction_flag.concrete + : Compiler_types.direction_flag -> Versions.V4_08.Direction_flag.concrete = fun x -> match (x : Compiler_types.direction_flag) with | Upto -> Upto | Downto -> Downto and ast_to_direction_flag - : Versions.V4_07.Direction_flag.t -> Compiler_types.direction_flag + : Versions.V4_08.Direction_flag.t -> Compiler_types.direction_flag = fun x -> - let concrete = Versions.V4_07.Direction_flag.to_concrete x in + let concrete = Versions.V4_08.Direction_flag.to_concrete x in concrete_to_direction_flag concrete and concrete_to_direction_flag - : Versions.V4_07.Direction_flag.concrete -> Compiler_types.direction_flag + : Versions.V4_08.Direction_flag.concrete -> Compiler_types.direction_flag = fun x -> - match (x : Versions.V4_07.Direction_flag.concrete) with + match (x : Versions.V4_08.Direction_flag.concrete) with | Upto -> Upto | Downto -> Downto and ast_of_private_flag - : Compiler_types.private_flag -> Versions.V4_07.Private_flag.t + : Compiler_types.private_flag -> Versions.V4_08.Private_flag.t = fun x -> - Versions.V4_07.Private_flag.of_concrete (concrete_of_private_flag x) + Versions.V4_08.Private_flag.of_concrete (concrete_of_private_flag x) and concrete_of_private_flag - : Compiler_types.private_flag -> Versions.V4_07.Private_flag.concrete + : Compiler_types.private_flag -> Versions.V4_08.Private_flag.concrete = fun x -> match (x : Compiler_types.private_flag) with | Private -> Private | Public -> Public and ast_to_private_flag - : Versions.V4_07.Private_flag.t -> Compiler_types.private_flag + : Versions.V4_08.Private_flag.t -> Compiler_types.private_flag = fun x -> - let concrete = Versions.V4_07.Private_flag.to_concrete x in + let concrete = Versions.V4_08.Private_flag.to_concrete x in concrete_to_private_flag concrete and concrete_to_private_flag - : Versions.V4_07.Private_flag.concrete -> Compiler_types.private_flag + : Versions.V4_08.Private_flag.concrete -> Compiler_types.private_flag = fun x -> - match (x : Versions.V4_07.Private_flag.concrete) with + match (x : Versions.V4_08.Private_flag.concrete) with | Private -> Private | Public -> Public and ast_of_mutable_flag - : Compiler_types.mutable_flag -> Versions.V4_07.Mutable_flag.t + : Compiler_types.mutable_flag -> Versions.V4_08.Mutable_flag.t = fun x -> - Versions.V4_07.Mutable_flag.of_concrete (concrete_of_mutable_flag x) + Versions.V4_08.Mutable_flag.of_concrete (concrete_of_mutable_flag x) and concrete_of_mutable_flag - : Compiler_types.mutable_flag -> Versions.V4_07.Mutable_flag.concrete + : Compiler_types.mutable_flag -> Versions.V4_08.Mutable_flag.concrete = fun x -> match (x : Compiler_types.mutable_flag) with | Immutable -> Immutable | Mutable -> Mutable and ast_to_mutable_flag - : Versions.V4_07.Mutable_flag.t -> Compiler_types.mutable_flag + : Versions.V4_08.Mutable_flag.t -> Compiler_types.mutable_flag = fun x -> - let concrete = Versions.V4_07.Mutable_flag.to_concrete x in + let concrete = Versions.V4_08.Mutable_flag.to_concrete x in concrete_to_mutable_flag concrete and concrete_to_mutable_flag - : Versions.V4_07.Mutable_flag.concrete -> Compiler_types.mutable_flag + : Versions.V4_08.Mutable_flag.concrete -> Compiler_types.mutable_flag = fun x -> - match (x : Versions.V4_07.Mutable_flag.concrete) with + match (x : Versions.V4_08.Mutable_flag.concrete) with | Immutable -> Immutable | Mutable -> Mutable and ast_of_virtual_flag - : Compiler_types.virtual_flag -> Versions.V4_07.Virtual_flag.t + : Compiler_types.virtual_flag -> Versions.V4_08.Virtual_flag.t = fun x -> - Versions.V4_07.Virtual_flag.of_concrete (concrete_of_virtual_flag x) + Versions.V4_08.Virtual_flag.of_concrete (concrete_of_virtual_flag x) and concrete_of_virtual_flag - : Compiler_types.virtual_flag -> Versions.V4_07.Virtual_flag.concrete + : Compiler_types.virtual_flag -> Versions.V4_08.Virtual_flag.concrete = fun x -> match (x : Compiler_types.virtual_flag) with | Virtual -> Virtual | Concrete -> Concrete and ast_to_virtual_flag - : Versions.V4_07.Virtual_flag.t -> Compiler_types.virtual_flag + : Versions.V4_08.Virtual_flag.t -> Compiler_types.virtual_flag = fun x -> - let concrete = Versions.V4_07.Virtual_flag.to_concrete x in + let concrete = Versions.V4_08.Virtual_flag.to_concrete x in concrete_to_virtual_flag concrete and concrete_to_virtual_flag - : Versions.V4_07.Virtual_flag.concrete -> Compiler_types.virtual_flag + : Versions.V4_08.Virtual_flag.concrete -> Compiler_types.virtual_flag = fun x -> - match (x : Versions.V4_07.Virtual_flag.concrete) with + match (x : Versions.V4_08.Virtual_flag.concrete) with | Virtual -> Virtual | Concrete -> Concrete and ast_of_override_flag - : Compiler_types.override_flag -> Versions.V4_07.Override_flag.t + : Compiler_types.override_flag -> Versions.V4_08.Override_flag.t = fun x -> - Versions.V4_07.Override_flag.of_concrete (concrete_of_override_flag x) + Versions.V4_08.Override_flag.of_concrete (concrete_of_override_flag x) and concrete_of_override_flag - : Compiler_types.override_flag -> Versions.V4_07.Override_flag.concrete + : Compiler_types.override_flag -> Versions.V4_08.Override_flag.concrete = fun x -> match (x : Compiler_types.override_flag) with | Override -> Override | Fresh -> Fresh and ast_to_override_flag - : Versions.V4_07.Override_flag.t -> Compiler_types.override_flag + : Versions.V4_08.Override_flag.t -> Compiler_types.override_flag = fun x -> - let concrete = Versions.V4_07.Override_flag.to_concrete x in + let concrete = Versions.V4_08.Override_flag.to_concrete x in concrete_to_override_flag concrete and concrete_to_override_flag - : Versions.V4_07.Override_flag.concrete -> Compiler_types.override_flag + : Versions.V4_08.Override_flag.concrete -> Compiler_types.override_flag = fun x -> - match (x : Versions.V4_07.Override_flag.concrete) with + match (x : Versions.V4_08.Override_flag.concrete) with | Override -> Override | Fresh -> Fresh and ast_of_closed_flag - : Compiler_types.closed_flag -> Versions.V4_07.Closed_flag.t + : Compiler_types.closed_flag -> Versions.V4_08.Closed_flag.t = fun x -> - Versions.V4_07.Closed_flag.of_concrete (concrete_of_closed_flag x) + Versions.V4_08.Closed_flag.of_concrete (concrete_of_closed_flag x) and concrete_of_closed_flag - : Compiler_types.closed_flag -> Versions.V4_07.Closed_flag.concrete + : Compiler_types.closed_flag -> Versions.V4_08.Closed_flag.concrete = fun x -> match (x : Compiler_types.closed_flag) with | Closed -> Closed | Open -> Open and ast_to_closed_flag - : Versions.V4_07.Closed_flag.t -> Compiler_types.closed_flag + : Versions.V4_08.Closed_flag.t -> Compiler_types.closed_flag = fun x -> - let concrete = Versions.V4_07.Closed_flag.to_concrete x in + let concrete = Versions.V4_08.Closed_flag.to_concrete x in concrete_to_closed_flag concrete and concrete_to_closed_flag - : Versions.V4_07.Closed_flag.concrete -> Compiler_types.closed_flag + : Versions.V4_08.Closed_flag.concrete -> Compiler_types.closed_flag = fun x -> - match (x : Versions.V4_07.Closed_flag.concrete) with + match (x : Versions.V4_08.Closed_flag.concrete) with | Closed -> Closed | Open -> Open and ast_of_arg_label - : Compiler_types.arg_label -> Versions.V4_07.Arg_label.t + : Compiler_types.arg_label -> Versions.V4_08.Arg_label.t = fun x -> - Versions.V4_07.Arg_label.of_concrete (concrete_of_arg_label x) + Versions.V4_08.Arg_label.of_concrete (concrete_of_arg_label x) and concrete_of_arg_label - : Compiler_types.arg_label -> Versions.V4_07.Arg_label.concrete + : Compiler_types.arg_label -> Versions.V4_08.Arg_label.concrete = fun x -> match (x : Compiler_types.arg_label) with | Nolabel -> Nolabel @@ -252,15 +252,15 @@ and concrete_of_arg_label Optional (x1) and ast_to_arg_label - : Versions.V4_07.Arg_label.t -> Compiler_types.arg_label + : Versions.V4_08.Arg_label.t -> Compiler_types.arg_label = fun x -> - let concrete = Versions.V4_07.Arg_label.to_concrete x in + let concrete = Versions.V4_08.Arg_label.to_concrete x in concrete_to_arg_label concrete and concrete_to_arg_label - : Versions.V4_07.Arg_label.concrete -> Compiler_types.arg_label + : Versions.V4_08.Arg_label.concrete -> Compiler_types.arg_label = fun x -> - match (x : Versions.V4_07.Arg_label.concrete) with + match (x : Versions.V4_08.Arg_label.concrete) with | Nolabel -> Nolabel | Labelled (x1) -> Labelled (x1) @@ -268,12 +268,12 @@ and concrete_to_arg_label Optional (x1) and ast_of_variance - : Compiler_types.variance -> Versions.V4_07.Variance.t + : Compiler_types.variance -> Versions.V4_08.Variance.t = fun x -> - Versions.V4_07.Variance.of_concrete (concrete_of_variance x) + Versions.V4_08.Variance.of_concrete (concrete_of_variance x) and concrete_of_variance - : Compiler_types.variance -> Versions.V4_07.Variance.concrete + : Compiler_types.variance -> Versions.V4_08.Variance.concrete = fun x -> match (x : Compiler_types.variance) with | Covariant -> Covariant @@ -281,26 +281,26 @@ and concrete_of_variance | Invariant -> Invariant and ast_to_variance - : Versions.V4_07.Variance.t -> Compiler_types.variance + : Versions.V4_08.Variance.t -> Compiler_types.variance = fun x -> - let concrete = Versions.V4_07.Variance.to_concrete x in + let concrete = Versions.V4_08.Variance.to_concrete x in concrete_to_variance concrete and concrete_to_variance - : Versions.V4_07.Variance.concrete -> Compiler_types.variance + : Versions.V4_08.Variance.concrete -> Compiler_types.variance = fun x -> - match (x : Versions.V4_07.Variance.concrete) with + match (x : Versions.V4_08.Variance.concrete) with | Covariant -> Covariant | Contravariant -> Contravariant | Invariant -> Invariant and ast_of_constant - : Compiler_types.constant -> Versions.V4_07.Constant.t + : Compiler_types.constant -> Versions.V4_08.Constant.t = fun x -> - Versions.V4_07.Constant.of_concrete (concrete_of_constant x) + Versions.V4_08.Constant.of_concrete (concrete_of_constant x) and concrete_of_constant - : Compiler_types.constant -> Versions.V4_07.Constant.concrete + : Compiler_types.constant -> Versions.V4_08.Constant.concrete = fun x -> match (x : Compiler_types.constant) with | Pconst_integer (x1, x2) -> @@ -313,15 +313,15 @@ and concrete_of_constant Pconst_float (x1, x2) and ast_to_constant - : Versions.V4_07.Constant.t -> Compiler_types.constant + : Versions.V4_08.Constant.t -> Compiler_types.constant = fun x -> - let concrete = Versions.V4_07.Constant.to_concrete x in + let concrete = Versions.V4_08.Constant.to_concrete x in concrete_to_constant concrete and concrete_to_constant - : Versions.V4_07.Constant.concrete -> Compiler_types.constant + : Versions.V4_08.Constant.concrete -> Compiler_types.constant = fun x -> - match (x : Versions.V4_07.Constant.concrete) with + match (x : Versions.V4_08.Constant.concrete) with | Pconst_integer (x1, x2) -> Pconst_integer (x1, x2) | Pconst_char (x1) -> @@ -332,75 +332,77 @@ and concrete_to_constant Pconst_float (x1, x2) and ast_of_attribute - : Compiler_types.attribute -> Versions.V4_07.Attribute.t + : Compiler_types.attribute -> Versions.V4_08.Attribute.t = fun x -> - Versions.V4_07.Attribute.of_concrete (concrete_of_attribute x) + Versions.V4_08.Attribute.of_concrete (concrete_of_attribute x) and concrete_of_attribute - : Compiler_types.attribute -> Versions.V4_07.Attribute.concrete - = fun x -> - (Tuple.map2 ~f1:Fn.id ~f2:ast_of_payload) x + : Compiler_types.attribute -> Versions.V4_08.Attribute.concrete + = fun { attr_name; attr_payload; attr_loc } -> + let attr_payload = ast_of_payload attr_payload in + { attr_name; attr_payload; attr_loc } and ast_to_attribute - : Versions.V4_07.Attribute.t -> Compiler_types.attribute + : Versions.V4_08.Attribute.t -> Compiler_types.attribute = fun x -> - let concrete = Versions.V4_07.Attribute.to_concrete x in + let concrete = Versions.V4_08.Attribute.to_concrete x in concrete_to_attribute concrete and concrete_to_attribute - : Versions.V4_07.Attribute.concrete -> Compiler_types.attribute - = fun x -> - (Tuple.map2 ~f1:Fn.id ~f2:ast_to_payload) x + : Versions.V4_08.Attribute.concrete -> Compiler_types.attribute + = fun { attr_name; attr_payload; attr_loc } -> + let attr_payload = ast_to_payload attr_payload in + { attr_name; attr_payload; attr_loc } and ast_of_extension - : Compiler_types.extension -> Versions.V4_07.Extension.t + : Compiler_types.extension -> Versions.V4_08.Extension.t = fun x -> - Versions.V4_07.Extension.of_concrete (concrete_of_extension x) + Versions.V4_08.Extension.of_concrete (concrete_of_extension x) and concrete_of_extension - : Compiler_types.extension -> Versions.V4_07.Extension.concrete + : Compiler_types.extension -> Versions.V4_08.Extension.concrete = fun x -> (Tuple.map2 ~f1:Fn.id ~f2:ast_of_payload) x and ast_to_extension - : Versions.V4_07.Extension.t -> Compiler_types.extension + : Versions.V4_08.Extension.t -> Compiler_types.extension = fun x -> - let concrete = Versions.V4_07.Extension.to_concrete x in + let concrete = Versions.V4_08.Extension.to_concrete x in concrete_to_extension concrete and concrete_to_extension - : Versions.V4_07.Extension.concrete -> Compiler_types.extension + : Versions.V4_08.Extension.concrete -> Compiler_types.extension = fun x -> (Tuple.map2 ~f1:Fn.id ~f2:ast_to_payload) x and ast_of_attributes - : Compiler_types.attributes -> Versions.V4_07.Attributes.t + : Compiler_types.attributes -> Versions.V4_08.Attributes.t = fun x -> - Versions.V4_07.Attributes.of_concrete (concrete_of_attributes x) + Versions.V4_08.Attributes.of_concrete (concrete_of_attributes x) and concrete_of_attributes - : Compiler_types.attributes -> Versions.V4_07.Attributes.concrete + : Compiler_types.attributes -> Versions.V4_08.Attributes.concrete = fun x -> (List.map ~f:ast_of_attribute) x and ast_to_attributes - : Versions.V4_07.Attributes.t -> Compiler_types.attributes + : Versions.V4_08.Attributes.t -> Compiler_types.attributes = fun x -> - let concrete = Versions.V4_07.Attributes.to_concrete x in + let concrete = Versions.V4_08.Attributes.to_concrete x in concrete_to_attributes concrete and concrete_to_attributes - : Versions.V4_07.Attributes.concrete -> Compiler_types.attributes + : Versions.V4_08.Attributes.concrete -> Compiler_types.attributes = fun x -> (List.map ~f:ast_to_attribute) x and ast_of_payload - : Compiler_types.payload -> Versions.V4_07.Payload.t + : Compiler_types.payload -> Versions.V4_08.Payload.t = fun x -> - Versions.V4_07.Payload.of_concrete (concrete_of_payload x) + Versions.V4_08.Payload.of_concrete (concrete_of_payload x) and concrete_of_payload - : Compiler_types.payload -> Versions.V4_07.Payload.concrete + : Compiler_types.payload -> Versions.V4_08.Payload.concrete = fun x -> match (x : Compiler_types.payload) with | PStr (x1) -> @@ -418,15 +420,15 @@ and concrete_of_payload PPat (x1, x2) and ast_to_payload - : Versions.V4_07.Payload.t -> Compiler_types.payload + : Versions.V4_08.Payload.t -> Compiler_types.payload = fun x -> - let concrete = Versions.V4_07.Payload.to_concrete x in + let concrete = Versions.V4_08.Payload.to_concrete x in concrete_to_payload concrete and concrete_to_payload - : Versions.V4_07.Payload.concrete -> Compiler_types.payload + : Versions.V4_08.Payload.concrete -> Compiler_types.payload = fun x -> - match (x : Versions.V4_07.Payload.concrete) with + match (x : Versions.V4_08.Payload.concrete) with | PStr (x1) -> let x1 = ast_to_structure x1 in PStr (x1) @@ -442,37 +444,37 @@ and concrete_to_payload PPat (x1, x2) and ast_of_core_type - : Compiler_types.core_type -> Versions.V4_07.Core_type.t + : Compiler_types.core_type -> Versions.V4_08.Core_type.t = fun x -> - Versions.V4_07.Core_type.of_concrete (concrete_of_core_type x) + Versions.V4_08.Core_type.of_concrete (concrete_of_core_type x) and concrete_of_core_type - : Compiler_types.core_type -> Versions.V4_07.Core_type.concrete - = fun { ptyp_desc; ptyp_loc; ptyp_attributes } -> + : Compiler_types.core_type -> Versions.V4_08.Core_type.concrete + = fun { ptyp_desc; ptyp_loc; ptyp_loc_stack; ptyp_attributes } -> let ptyp_desc = ast_of_core_type_desc ptyp_desc in let ptyp_attributes = ast_of_attributes ptyp_attributes in - { ptyp_desc; ptyp_loc; ptyp_attributes } + { ptyp_desc; ptyp_loc; ptyp_loc_stack; ptyp_attributes } and ast_to_core_type - : Versions.V4_07.Core_type.t -> Compiler_types.core_type + : Versions.V4_08.Core_type.t -> Compiler_types.core_type = fun x -> - let concrete = Versions.V4_07.Core_type.to_concrete x in + let concrete = Versions.V4_08.Core_type.to_concrete x in concrete_to_core_type concrete and concrete_to_core_type - : Versions.V4_07.Core_type.concrete -> Compiler_types.core_type - = fun { ptyp_desc; ptyp_loc; ptyp_attributes } -> + : Versions.V4_08.Core_type.concrete -> Compiler_types.core_type + = fun { ptyp_desc; ptyp_loc; ptyp_loc_stack; ptyp_attributes } -> let ptyp_desc = ast_to_core_type_desc ptyp_desc in let ptyp_attributes = ast_to_attributes ptyp_attributes in - { ptyp_desc; ptyp_loc; ptyp_attributes } + { ptyp_desc; ptyp_loc; ptyp_loc_stack; ptyp_attributes } and ast_of_core_type_desc - : Compiler_types.core_type_desc -> Versions.V4_07.Core_type_desc.t + : Compiler_types.core_type_desc -> Versions.V4_08.Core_type_desc.t = fun x -> - Versions.V4_07.Core_type_desc.of_concrete (concrete_of_core_type_desc x) + Versions.V4_08.Core_type_desc.of_concrete (concrete_of_core_type_desc x) and concrete_of_core_type_desc - : Compiler_types.core_type_desc -> Versions.V4_07.Core_type_desc.concrete + : Compiler_types.core_type_desc -> Versions.V4_08.Core_type_desc.concrete = fun x -> match (x : Compiler_types.core_type_desc) with | Ptyp_any -> Ptyp_any @@ -516,15 +518,15 @@ and concrete_of_core_type_desc Ptyp_extension (x1) and ast_to_core_type_desc - : Versions.V4_07.Core_type_desc.t -> Compiler_types.core_type_desc + : Versions.V4_08.Core_type_desc.t -> Compiler_types.core_type_desc = fun x -> - let concrete = Versions.V4_07.Core_type_desc.to_concrete x in + let concrete = Versions.V4_08.Core_type_desc.to_concrete x in concrete_to_core_type_desc concrete and concrete_to_core_type_desc - : Versions.V4_07.Core_type_desc.concrete -> Compiler_types.core_type_desc + : Versions.V4_08.Core_type_desc.concrete -> Compiler_types.core_type_desc = fun x -> - match (x : Versions.V4_07.Core_type_desc.concrete) with + match (x : Versions.V4_08.Core_type_desc.concrete) with | Ptyp_any -> Ptyp_any | Ptyp_var (x1) -> Ptyp_var (x1) @@ -566,128 +568,174 @@ and concrete_to_core_type_desc Ptyp_extension (x1) and ast_of_package_type - : Compiler_types.package_type -> Versions.V4_07.Package_type.t + : Compiler_types.package_type -> Versions.V4_08.Package_type.t = fun x -> - Versions.V4_07.Package_type.of_concrete (concrete_of_package_type x) + Versions.V4_08.Package_type.of_concrete (concrete_of_package_type x) and concrete_of_package_type - : Compiler_types.package_type -> Versions.V4_07.Package_type.concrete + : Compiler_types.package_type -> Versions.V4_08.Package_type.concrete = fun x -> (Tuple.map2 ~f1:ast_of_longident_loc ~f2:(List.map ~f:(Tuple.map2 ~f1:ast_of_longident_loc ~f2:ast_of_core_type))) x and ast_to_package_type - : Versions.V4_07.Package_type.t -> Compiler_types.package_type + : Versions.V4_08.Package_type.t -> Compiler_types.package_type = fun x -> - let concrete = Versions.V4_07.Package_type.to_concrete x in + let concrete = Versions.V4_08.Package_type.to_concrete x in concrete_to_package_type concrete and concrete_to_package_type - : Versions.V4_07.Package_type.concrete -> Compiler_types.package_type + : Versions.V4_08.Package_type.concrete -> Compiler_types.package_type = fun x -> (Tuple.map2 ~f1:ast_to_longident_loc ~f2:(List.map ~f:(Tuple.map2 ~f1:ast_to_longident_loc ~f2:ast_to_core_type))) x and ast_of_row_field - : Compiler_types.row_field -> Versions.V4_07.Row_field.t + : Compiler_types.row_field -> Versions.V4_08.Row_field.t = fun x -> - Versions.V4_07.Row_field.of_concrete (concrete_of_row_field x) + Versions.V4_08.Row_field.of_concrete (concrete_of_row_field x) and concrete_of_row_field - : Compiler_types.row_field -> Versions.V4_07.Row_field.concrete + : Compiler_types.row_field -> Versions.V4_08.Row_field.concrete + = fun { prf_desc; prf_loc; prf_attributes } -> + let prf_desc = ast_of_row_field_desc prf_desc in + let prf_attributes = ast_of_attributes prf_attributes in + { prf_desc; prf_loc; prf_attributes } + +and ast_to_row_field + : Versions.V4_08.Row_field.t -> Compiler_types.row_field = fun x -> - match (x : Compiler_types.row_field) with - | Rtag (x1, x2, x3, x4) -> - let x2 = ast_of_attributes x2 in - let x4 = (List.map ~f:ast_of_core_type) x4 in - Rtag (x1, x2, x3, x4) + let concrete = Versions.V4_08.Row_field.to_concrete x in + concrete_to_row_field concrete + +and concrete_to_row_field + : Versions.V4_08.Row_field.concrete -> Compiler_types.row_field + = fun { prf_desc; prf_loc; prf_attributes } -> + let prf_desc = ast_to_row_field_desc prf_desc in + let prf_attributes = ast_to_attributes prf_attributes in + { prf_desc; prf_loc; prf_attributes } + +and ast_of_row_field_desc + : Compiler_types.row_field_desc -> Versions.V4_08.Row_field_desc.t + = fun x -> + Versions.V4_08.Row_field_desc.of_concrete (concrete_of_row_field_desc x) + +and concrete_of_row_field_desc + : Compiler_types.row_field_desc -> Versions.V4_08.Row_field_desc.concrete + = fun x -> + match (x : Compiler_types.row_field_desc) with + | Rtag (x1, x2, x3) -> + let x3 = (List.map ~f:ast_of_core_type) x3 in + Rtag (x1, x2, x3) | Rinherit (x1) -> let x1 = ast_of_core_type x1 in Rinherit (x1) -and ast_to_row_field - : Versions.V4_07.Row_field.t -> Compiler_types.row_field +and ast_to_row_field_desc + : Versions.V4_08.Row_field_desc.t -> Compiler_types.row_field_desc = fun x -> - let concrete = Versions.V4_07.Row_field.to_concrete x in - concrete_to_row_field concrete + let concrete = Versions.V4_08.Row_field_desc.to_concrete x in + concrete_to_row_field_desc concrete -and concrete_to_row_field - : Versions.V4_07.Row_field.concrete -> Compiler_types.row_field +and concrete_to_row_field_desc + : Versions.V4_08.Row_field_desc.concrete -> Compiler_types.row_field_desc = fun x -> - match (x : Versions.V4_07.Row_field.concrete) with - | Rtag (x1, x2, x3, x4) -> - let x2 = ast_to_attributes x2 in - let x4 = (List.map ~f:ast_to_core_type) x4 in - Rtag (x1, x2, x3, x4) + match (x : Versions.V4_08.Row_field_desc.concrete) with + | Rtag (x1, x2, x3) -> + let x3 = (List.map ~f:ast_to_core_type) x3 in + Rtag (x1, x2, x3) | Rinherit (x1) -> let x1 = ast_to_core_type x1 in Rinherit (x1) and ast_of_object_field - : Compiler_types.object_field -> Versions.V4_07.Object_field.t + : Compiler_types.object_field -> Versions.V4_08.Object_field.t = fun x -> - Versions.V4_07.Object_field.of_concrete (concrete_of_object_field x) + Versions.V4_08.Object_field.of_concrete (concrete_of_object_field x) and concrete_of_object_field - : Compiler_types.object_field -> Versions.V4_07.Object_field.concrete + : Compiler_types.object_field -> Versions.V4_08.Object_field.concrete + = fun { pof_desc; pof_loc; pof_attributes } -> + let pof_desc = ast_of_object_field_desc pof_desc in + let pof_attributes = ast_of_attributes pof_attributes in + { pof_desc; pof_loc; pof_attributes } + +and ast_to_object_field + : Versions.V4_08.Object_field.t -> Compiler_types.object_field = fun x -> - match (x : Compiler_types.object_field) with - | Otag (x1, x2, x3) -> - let x2 = ast_of_attributes x2 in - let x3 = ast_of_core_type x3 in - Otag (x1, x2, x3) + let concrete = Versions.V4_08.Object_field.to_concrete x in + concrete_to_object_field concrete + +and concrete_to_object_field + : Versions.V4_08.Object_field.concrete -> Compiler_types.object_field + = fun { pof_desc; pof_loc; pof_attributes } -> + let pof_desc = ast_to_object_field_desc pof_desc in + let pof_attributes = ast_to_attributes pof_attributes in + { pof_desc; pof_loc; pof_attributes } + +and ast_of_object_field_desc + : Compiler_types.object_field_desc -> Versions.V4_08.Object_field_desc.t + = fun x -> + Versions.V4_08.Object_field_desc.of_concrete (concrete_of_object_field_desc x) + +and concrete_of_object_field_desc + : Compiler_types.object_field_desc -> Versions.V4_08.Object_field_desc.concrete + = fun x -> + match (x : Compiler_types.object_field_desc) with + | Otag (x1, x2) -> + let x2 = ast_of_core_type x2 in + Otag (x1, x2) | Oinherit (x1) -> let x1 = ast_of_core_type x1 in Oinherit (x1) -and ast_to_object_field - : Versions.V4_07.Object_field.t -> Compiler_types.object_field +and ast_to_object_field_desc + : Versions.V4_08.Object_field_desc.t -> Compiler_types.object_field_desc = fun x -> - let concrete = Versions.V4_07.Object_field.to_concrete x in - concrete_to_object_field concrete + let concrete = Versions.V4_08.Object_field_desc.to_concrete x in + concrete_to_object_field_desc concrete -and concrete_to_object_field - : Versions.V4_07.Object_field.concrete -> Compiler_types.object_field +and concrete_to_object_field_desc + : Versions.V4_08.Object_field_desc.concrete -> Compiler_types.object_field_desc = fun x -> - match (x : Versions.V4_07.Object_field.concrete) with - | Otag (x1, x2, x3) -> - let x2 = ast_to_attributes x2 in - let x3 = ast_to_core_type x3 in - Otag (x1, x2, x3) + match (x : Versions.V4_08.Object_field_desc.concrete) with + | Otag (x1, x2) -> + let x2 = ast_to_core_type x2 in + Otag (x1, x2) | Oinherit (x1) -> let x1 = ast_to_core_type x1 in Oinherit (x1) and ast_of_pattern - : Compiler_types.pattern -> Versions.V4_07.Pattern.t + : Compiler_types.pattern -> Versions.V4_08.Pattern.t = fun x -> - Versions.V4_07.Pattern.of_concrete (concrete_of_pattern x) + Versions.V4_08.Pattern.of_concrete (concrete_of_pattern x) and concrete_of_pattern - : Compiler_types.pattern -> Versions.V4_07.Pattern.concrete - = fun { ppat_desc; ppat_loc; ppat_attributes } -> + : Compiler_types.pattern -> Versions.V4_08.Pattern.concrete + = fun { ppat_desc; ppat_loc; ppat_loc_stack; ppat_attributes } -> let ppat_desc = ast_of_pattern_desc ppat_desc in let ppat_attributes = ast_of_attributes ppat_attributes in - { ppat_desc; ppat_loc; ppat_attributes } + { ppat_desc; ppat_loc; ppat_loc_stack; ppat_attributes } and ast_to_pattern - : Versions.V4_07.Pattern.t -> Compiler_types.pattern + : Versions.V4_08.Pattern.t -> Compiler_types.pattern = fun x -> - let concrete = Versions.V4_07.Pattern.to_concrete x in + let concrete = Versions.V4_08.Pattern.to_concrete x in concrete_to_pattern concrete and concrete_to_pattern - : Versions.V4_07.Pattern.concrete -> Compiler_types.pattern - = fun { ppat_desc; ppat_loc; ppat_attributes } -> + : Versions.V4_08.Pattern.concrete -> Compiler_types.pattern + = fun { ppat_desc; ppat_loc; ppat_loc_stack; ppat_attributes } -> let ppat_desc = ast_to_pattern_desc ppat_desc in let ppat_attributes = ast_to_attributes ppat_attributes in - { ppat_desc; ppat_loc; ppat_attributes } + { ppat_desc; ppat_loc; ppat_loc_stack; ppat_attributes } and ast_of_pattern_desc - : Compiler_types.pattern_desc -> Versions.V4_07.Pattern_desc.t + : Compiler_types.pattern_desc -> Versions.V4_08.Pattern_desc.t = fun x -> - Versions.V4_07.Pattern_desc.of_concrete (concrete_of_pattern_desc x) + Versions.V4_08.Pattern_desc.of_concrete (concrete_of_pattern_desc x) and concrete_of_pattern_desc - : Compiler_types.pattern_desc -> Versions.V4_07.Pattern_desc.concrete + : Compiler_types.pattern_desc -> Versions.V4_08.Pattern_desc.concrete = fun x -> match (x : Compiler_types.pattern_desc) with | Ppat_any -> Ppat_any @@ -748,15 +796,15 @@ and concrete_of_pattern_desc Ppat_open (x1, x2) and ast_to_pattern_desc - : Versions.V4_07.Pattern_desc.t -> Compiler_types.pattern_desc + : Versions.V4_08.Pattern_desc.t -> Compiler_types.pattern_desc = fun x -> - let concrete = Versions.V4_07.Pattern_desc.to_concrete x in + let concrete = Versions.V4_08.Pattern_desc.to_concrete x in concrete_to_pattern_desc concrete and concrete_to_pattern_desc - : Versions.V4_07.Pattern_desc.concrete -> Compiler_types.pattern_desc + : Versions.V4_08.Pattern_desc.concrete -> Compiler_types.pattern_desc = fun x -> - match (x : Versions.V4_07.Pattern_desc.concrete) with + match (x : Versions.V4_08.Pattern_desc.concrete) with | Ppat_any -> Ppat_any | Ppat_var (x1) -> Ppat_var (x1) @@ -815,37 +863,37 @@ and concrete_to_pattern_desc Ppat_open (x1, x2) and ast_of_expression - : Compiler_types.expression -> Versions.V4_07.Expression.t + : Compiler_types.expression -> Versions.V4_08.Expression.t = fun x -> - Versions.V4_07.Expression.of_concrete (concrete_of_expression x) + Versions.V4_08.Expression.of_concrete (concrete_of_expression x) and concrete_of_expression - : Compiler_types.expression -> Versions.V4_07.Expression.concrete - = fun { pexp_desc; pexp_loc; pexp_attributes } -> + : Compiler_types.expression -> Versions.V4_08.Expression.concrete + = fun { pexp_desc; pexp_loc; pexp_loc_stack; pexp_attributes } -> let pexp_desc = ast_of_expression_desc pexp_desc in let pexp_attributes = ast_of_attributes pexp_attributes in - { pexp_desc; pexp_loc; pexp_attributes } + { pexp_desc; pexp_loc; pexp_loc_stack; pexp_attributes } and ast_to_expression - : Versions.V4_07.Expression.t -> Compiler_types.expression + : Versions.V4_08.Expression.t -> Compiler_types.expression = fun x -> - let concrete = Versions.V4_07.Expression.to_concrete x in + let concrete = Versions.V4_08.Expression.to_concrete x in concrete_to_expression concrete and concrete_to_expression - : Versions.V4_07.Expression.concrete -> Compiler_types.expression - = fun { pexp_desc; pexp_loc; pexp_attributes } -> + : Versions.V4_08.Expression.concrete -> Compiler_types.expression + = fun { pexp_desc; pexp_loc; pexp_loc_stack; pexp_attributes } -> let pexp_desc = ast_to_expression_desc pexp_desc in let pexp_attributes = ast_to_attributes pexp_attributes in - { pexp_desc; pexp_loc; pexp_attributes } + { pexp_desc; pexp_loc; pexp_loc_stack; pexp_attributes } and ast_of_expression_desc - : Compiler_types.expression_desc -> Versions.V4_07.Expression_desc.t + : Compiler_types.expression_desc -> Versions.V4_08.Expression_desc.t = fun x -> - Versions.V4_07.Expression_desc.of_concrete (concrete_of_expression_desc x) + Versions.V4_08.Expression_desc.of_concrete (concrete_of_expression_desc x) and concrete_of_expression_desc - : Compiler_types.expression_desc -> Versions.V4_07.Expression_desc.concrete + : Compiler_types.expression_desc -> Versions.V4_08.Expression_desc.concrete = fun x -> match (x : Compiler_types.expression_desc) with | Pexp_ident (x1) -> @@ -974,26 +1022,28 @@ and concrete_of_expression_desc | Pexp_pack (x1) -> let x1 = ast_of_module_expr x1 in Pexp_pack (x1) - | Pexp_open (x1, x2, x3) -> - let x1 = ast_of_override_flag x1 in - let x2 = ast_of_longident_loc x2 in - let x3 = ast_of_expression x3 in - Pexp_open (x1, x2, x3) + | Pexp_open (x1, x2) -> + let x1 = ast_of_open_declaration x1 in + let x2 = ast_of_expression x2 in + Pexp_open (x1, x2) + | Pexp_letop (x1) -> + let x1 = ast_of_letop x1 in + Pexp_letop (x1) | Pexp_extension (x1) -> let x1 = ast_of_extension x1 in Pexp_extension (x1) | Pexp_unreachable -> Pexp_unreachable and ast_to_expression_desc - : Versions.V4_07.Expression_desc.t -> Compiler_types.expression_desc + : Versions.V4_08.Expression_desc.t -> Compiler_types.expression_desc = fun x -> - let concrete = Versions.V4_07.Expression_desc.to_concrete x in + let concrete = Versions.V4_08.Expression_desc.to_concrete x in concrete_to_expression_desc concrete and concrete_to_expression_desc - : Versions.V4_07.Expression_desc.concrete -> Compiler_types.expression_desc + : Versions.V4_08.Expression_desc.concrete -> Compiler_types.expression_desc = fun x -> - match (x : Versions.V4_07.Expression_desc.concrete) with + match (x : Versions.V4_08.Expression_desc.concrete) with | Pexp_ident (x1) -> let x1 = ast_to_longident_loc x1 in Pexp_ident (x1) @@ -1120,23 +1170,25 @@ and concrete_to_expression_desc | Pexp_pack (x1) -> let x1 = ast_to_module_expr x1 in Pexp_pack (x1) - | Pexp_open (x1, x2, x3) -> - let x1 = ast_to_override_flag x1 in - let x2 = ast_to_longident_loc x2 in - let x3 = ast_to_expression x3 in - Pexp_open (x1, x2, x3) + | Pexp_open (x1, x2) -> + let x1 = ast_to_open_declaration x1 in + let x2 = ast_to_expression x2 in + Pexp_open (x1, x2) + | Pexp_letop (x1) -> + let x1 = ast_to_letop x1 in + Pexp_letop (x1) | Pexp_extension (x1) -> let x1 = ast_to_extension x1 in Pexp_extension (x1) | Pexp_unreachable -> Pexp_unreachable and ast_of_case - : Compiler_types.case -> Versions.V4_07.Case.t + : Compiler_types.case -> Versions.V4_08.Case.t = fun x -> - Versions.V4_07.Case.of_concrete (concrete_of_case x) + Versions.V4_08.Case.of_concrete (concrete_of_case x) and concrete_of_case - : Compiler_types.case -> Versions.V4_07.Case.concrete + : Compiler_types.case -> Versions.V4_08.Case.concrete = fun { pc_lhs; pc_guard; pc_rhs } -> let pc_lhs = ast_of_pattern pc_lhs in let pc_guard = (Option.map ~f:ast_of_expression) pc_guard in @@ -1144,51 +1196,103 @@ and concrete_of_case { pc_lhs; pc_guard; pc_rhs } and ast_to_case - : Versions.V4_07.Case.t -> Compiler_types.case + : Versions.V4_08.Case.t -> Compiler_types.case = fun x -> - let concrete = Versions.V4_07.Case.to_concrete x in + let concrete = Versions.V4_08.Case.to_concrete x in concrete_to_case concrete and concrete_to_case - : Versions.V4_07.Case.concrete -> Compiler_types.case + : Versions.V4_08.Case.concrete -> Compiler_types.case = fun { pc_lhs; pc_guard; pc_rhs } -> let pc_lhs = ast_to_pattern pc_lhs in let pc_guard = (Option.map ~f:ast_to_expression) pc_guard in let pc_rhs = ast_to_expression pc_rhs in { pc_lhs; pc_guard; pc_rhs } +and ast_of_letop + : Compiler_types.letop -> Versions.V4_08.Letop.t + = fun x -> + Versions.V4_08.Letop.of_concrete (concrete_of_letop x) + +and concrete_of_letop + : Compiler_types.letop -> Versions.V4_08.Letop.concrete + = fun { let_; ands; body } -> + let let_ = ast_of_binding_op let_ in + let ands = (List.map ~f:ast_of_binding_op) ands in + let body = ast_of_expression body in + { let_; ands; body } + +and ast_to_letop + : Versions.V4_08.Letop.t -> Compiler_types.letop + = fun x -> + let concrete = Versions.V4_08.Letop.to_concrete x in + concrete_to_letop concrete + +and concrete_to_letop + : Versions.V4_08.Letop.concrete -> Compiler_types.letop + = fun { let_; ands; body } -> + let let_ = ast_to_binding_op let_ in + let ands = (List.map ~f:ast_to_binding_op) ands in + let body = ast_to_expression body in + { let_; ands; body } + +and ast_of_binding_op + : Compiler_types.binding_op -> Versions.V4_08.Binding_op.t + = fun x -> + Versions.V4_08.Binding_op.of_concrete (concrete_of_binding_op x) + +and concrete_of_binding_op + : Compiler_types.binding_op -> Versions.V4_08.Binding_op.concrete + = fun { pbop_op; pbop_pat; pbop_exp; pbop_loc } -> + let pbop_pat = ast_of_pattern pbop_pat in + let pbop_exp = ast_of_expression pbop_exp in + { pbop_op; pbop_pat; pbop_exp; pbop_loc } + +and ast_to_binding_op + : Versions.V4_08.Binding_op.t -> Compiler_types.binding_op + = fun x -> + let concrete = Versions.V4_08.Binding_op.to_concrete x in + concrete_to_binding_op concrete + +and concrete_to_binding_op + : Versions.V4_08.Binding_op.concrete -> Compiler_types.binding_op + = fun { pbop_op; pbop_pat; pbop_exp; pbop_loc } -> + let pbop_pat = ast_to_pattern pbop_pat in + let pbop_exp = ast_to_expression pbop_exp in + { pbop_op; pbop_pat; pbop_exp; pbop_loc } + and ast_of_value_description - : Compiler_types.value_description -> Versions.V4_07.Value_description.t + : Compiler_types.value_description -> Versions.V4_08.Value_description.t = fun x -> - Versions.V4_07.Value_description.of_concrete (concrete_of_value_description x) + Versions.V4_08.Value_description.of_concrete (concrete_of_value_description x) and concrete_of_value_description - : Compiler_types.value_description -> Versions.V4_07.Value_description.concrete + : Compiler_types.value_description -> Versions.V4_08.Value_description.concrete = fun { pval_name; pval_type; pval_prim; pval_attributes; pval_loc } -> let pval_type = ast_of_core_type pval_type in let pval_attributes = ast_of_attributes pval_attributes in { pval_name; pval_type; pval_prim; pval_attributes; pval_loc } and ast_to_value_description - : Versions.V4_07.Value_description.t -> Compiler_types.value_description + : Versions.V4_08.Value_description.t -> Compiler_types.value_description = fun x -> - let concrete = Versions.V4_07.Value_description.to_concrete x in + let concrete = Versions.V4_08.Value_description.to_concrete x in concrete_to_value_description concrete and concrete_to_value_description - : Versions.V4_07.Value_description.concrete -> Compiler_types.value_description + : Versions.V4_08.Value_description.concrete -> Compiler_types.value_description = fun { pval_name; pval_type; pval_prim; pval_attributes; pval_loc } -> let pval_type = ast_to_core_type pval_type in let pval_attributes = ast_to_attributes pval_attributes in { pval_name; pval_type; pval_prim; pval_attributes; pval_loc } and ast_of_type_declaration - : Compiler_types.type_declaration -> Versions.V4_07.Type_declaration.t + : Compiler_types.type_declaration -> Versions.V4_08.Type_declaration.t = fun x -> - Versions.V4_07.Type_declaration.of_concrete (concrete_of_type_declaration x) + Versions.V4_08.Type_declaration.of_concrete (concrete_of_type_declaration x) and concrete_of_type_declaration - : Compiler_types.type_declaration -> Versions.V4_07.Type_declaration.concrete + : Compiler_types.type_declaration -> Versions.V4_08.Type_declaration.concrete = fun { ptype_name; ptype_params; ptype_cstrs; ptype_kind; ptype_private; ptype_manifest; ptype_attributes; ptype_loc } -> let ptype_params = (List.map ~f:(Tuple.map2 ~f1:ast_of_core_type ~f2:ast_of_variance)) ptype_params in let ptype_cstrs = (List.map ~f:(Tuple.map3 ~f1:ast_of_core_type ~f2:ast_of_core_type ~f3:Fn.id)) ptype_cstrs in @@ -1199,13 +1303,13 @@ and concrete_of_type_declaration { ptype_name; ptype_params; ptype_cstrs; ptype_kind; ptype_private; ptype_manifest; ptype_attributes; ptype_loc } and ast_to_type_declaration - : Versions.V4_07.Type_declaration.t -> Compiler_types.type_declaration + : Versions.V4_08.Type_declaration.t -> Compiler_types.type_declaration = fun x -> - let concrete = Versions.V4_07.Type_declaration.to_concrete x in + let concrete = Versions.V4_08.Type_declaration.to_concrete x in concrete_to_type_declaration concrete and concrete_to_type_declaration - : Versions.V4_07.Type_declaration.concrete -> Compiler_types.type_declaration + : Versions.V4_08.Type_declaration.concrete -> Compiler_types.type_declaration = fun { ptype_name; ptype_params; ptype_cstrs; ptype_kind; ptype_private; ptype_manifest; ptype_attributes; ptype_loc } -> let ptype_params = (List.map ~f:(Tuple.map2 ~f1:ast_to_core_type ~f2:ast_to_variance)) ptype_params in let ptype_cstrs = (List.map ~f:(Tuple.map3 ~f1:ast_to_core_type ~f2:ast_to_core_type ~f3:Fn.id)) ptype_cstrs in @@ -1216,12 +1320,12 @@ and concrete_to_type_declaration { ptype_name; ptype_params; ptype_cstrs; ptype_kind; ptype_private; ptype_manifest; ptype_attributes; ptype_loc } and ast_of_type_kind - : Compiler_types.type_kind -> Versions.V4_07.Type_kind.t + : Compiler_types.type_kind -> Versions.V4_08.Type_kind.t = fun x -> - Versions.V4_07.Type_kind.of_concrete (concrete_of_type_kind x) + Versions.V4_08.Type_kind.of_concrete (concrete_of_type_kind x) and concrete_of_type_kind - : Compiler_types.type_kind -> Versions.V4_07.Type_kind.concrete + : Compiler_types.type_kind -> Versions.V4_08.Type_kind.concrete = fun x -> match (x : Compiler_types.type_kind) with | Ptype_abstract -> Ptype_abstract @@ -1234,15 +1338,15 @@ and concrete_of_type_kind | Ptype_open -> Ptype_open and ast_to_type_kind - : Versions.V4_07.Type_kind.t -> Compiler_types.type_kind + : Versions.V4_08.Type_kind.t -> Compiler_types.type_kind = fun x -> - let concrete = Versions.V4_07.Type_kind.to_concrete x in + let concrete = Versions.V4_08.Type_kind.to_concrete x in concrete_to_type_kind concrete and concrete_to_type_kind - : Versions.V4_07.Type_kind.concrete -> Compiler_types.type_kind + : Versions.V4_08.Type_kind.concrete -> Compiler_types.type_kind = fun x -> - match (x : Versions.V4_07.Type_kind.concrete) with + match (x : Versions.V4_08.Type_kind.concrete) with | Ptype_abstract -> Ptype_abstract | Ptype_variant (x1) -> let x1 = (List.map ~f:ast_to_constructor_declaration) x1 in @@ -1253,12 +1357,12 @@ and concrete_to_type_kind | Ptype_open -> Ptype_open and ast_of_label_declaration - : Compiler_types.label_declaration -> Versions.V4_07.Label_declaration.t + : Compiler_types.label_declaration -> Versions.V4_08.Label_declaration.t = fun x -> - Versions.V4_07.Label_declaration.of_concrete (concrete_of_label_declaration x) + Versions.V4_08.Label_declaration.of_concrete (concrete_of_label_declaration x) and concrete_of_label_declaration - : Compiler_types.label_declaration -> Versions.V4_07.Label_declaration.concrete + : Compiler_types.label_declaration -> Versions.V4_08.Label_declaration.concrete = fun { pld_name; pld_mutable; pld_type; pld_loc; pld_attributes } -> let pld_mutable = ast_of_mutable_flag pld_mutable in let pld_type = ast_of_core_type pld_type in @@ -1266,13 +1370,13 @@ and concrete_of_label_declaration { pld_name; pld_mutable; pld_type; pld_loc; pld_attributes } and ast_to_label_declaration - : Versions.V4_07.Label_declaration.t -> Compiler_types.label_declaration + : Versions.V4_08.Label_declaration.t -> Compiler_types.label_declaration = fun x -> - let concrete = Versions.V4_07.Label_declaration.to_concrete x in + let concrete = Versions.V4_08.Label_declaration.to_concrete x in concrete_to_label_declaration concrete and concrete_to_label_declaration - : Versions.V4_07.Label_declaration.concrete -> Compiler_types.label_declaration + : Versions.V4_08.Label_declaration.concrete -> Compiler_types.label_declaration = fun { pld_name; pld_mutable; pld_type; pld_loc; pld_attributes } -> let pld_mutable = ast_to_mutable_flag pld_mutable in let pld_type = ast_to_core_type pld_type in @@ -1280,12 +1384,12 @@ and concrete_to_label_declaration { pld_name; pld_mutable; pld_type; pld_loc; pld_attributes } and ast_of_constructor_declaration - : Compiler_types.constructor_declaration -> Versions.V4_07.Constructor_declaration.t + : Compiler_types.constructor_declaration -> Versions.V4_08.Constructor_declaration.t = fun x -> - Versions.V4_07.Constructor_declaration.of_concrete (concrete_of_constructor_declaration x) + Versions.V4_08.Constructor_declaration.of_concrete (concrete_of_constructor_declaration x) and concrete_of_constructor_declaration - : Compiler_types.constructor_declaration -> Versions.V4_07.Constructor_declaration.concrete + : Compiler_types.constructor_declaration -> Versions.V4_08.Constructor_declaration.concrete = fun { pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes } -> let pcd_args = ast_of_constructor_arguments pcd_args in let pcd_res = (Option.map ~f:ast_of_core_type) pcd_res in @@ -1293,13 +1397,13 @@ and concrete_of_constructor_declaration { pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes } and ast_to_constructor_declaration - : Versions.V4_07.Constructor_declaration.t -> Compiler_types.constructor_declaration + : Versions.V4_08.Constructor_declaration.t -> Compiler_types.constructor_declaration = fun x -> - let concrete = Versions.V4_07.Constructor_declaration.to_concrete x in + let concrete = Versions.V4_08.Constructor_declaration.to_concrete x in concrete_to_constructor_declaration concrete and concrete_to_constructor_declaration - : Versions.V4_07.Constructor_declaration.concrete -> Compiler_types.constructor_declaration + : Versions.V4_08.Constructor_declaration.concrete -> Compiler_types.constructor_declaration = fun { pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes } -> let pcd_args = ast_to_constructor_arguments pcd_args in let pcd_res = (Option.map ~f:ast_to_core_type) pcd_res in @@ -1307,12 +1411,12 @@ and concrete_to_constructor_declaration { pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes } and ast_of_constructor_arguments - : Compiler_types.constructor_arguments -> Versions.V4_07.Constructor_arguments.t + : Compiler_types.constructor_arguments -> Versions.V4_08.Constructor_arguments.t = fun x -> - Versions.V4_07.Constructor_arguments.of_concrete (concrete_of_constructor_arguments x) + Versions.V4_08.Constructor_arguments.of_concrete (concrete_of_constructor_arguments x) and concrete_of_constructor_arguments - : Compiler_types.constructor_arguments -> Versions.V4_07.Constructor_arguments.concrete + : Compiler_types.constructor_arguments -> Versions.V4_08.Constructor_arguments.concrete = fun x -> match (x : Compiler_types.constructor_arguments) with | Pcstr_tuple (x1) -> @@ -1323,15 +1427,15 @@ and concrete_of_constructor_arguments Pcstr_record (x1) and ast_to_constructor_arguments - : Versions.V4_07.Constructor_arguments.t -> Compiler_types.constructor_arguments + : Versions.V4_08.Constructor_arguments.t -> Compiler_types.constructor_arguments = fun x -> - let concrete = Versions.V4_07.Constructor_arguments.to_concrete x in + let concrete = Versions.V4_08.Constructor_arguments.to_concrete x in concrete_to_constructor_arguments concrete and concrete_to_constructor_arguments - : Versions.V4_07.Constructor_arguments.concrete -> Compiler_types.constructor_arguments + : Versions.V4_08.Constructor_arguments.concrete -> Compiler_types.constructor_arguments = fun x -> - match (x : Versions.V4_07.Constructor_arguments.concrete) with + match (x : Versions.V4_08.Constructor_arguments.concrete) with | Pcstr_tuple (x1) -> let x1 = (List.map ~f:ast_to_core_type) x1 in Pcstr_tuple (x1) @@ -1340,68 +1444,93 @@ and concrete_to_constructor_arguments Pcstr_record (x1) and ast_of_type_extension - : Compiler_types.type_extension -> Versions.V4_07.Type_extension.t + : Compiler_types.type_extension -> Versions.V4_08.Type_extension.t = fun x -> - Versions.V4_07.Type_extension.of_concrete (concrete_of_type_extension x) + Versions.V4_08.Type_extension.of_concrete (concrete_of_type_extension x) and concrete_of_type_extension - : Compiler_types.type_extension -> Versions.V4_07.Type_extension.concrete - = fun { ptyext_path; ptyext_params; ptyext_constructors; ptyext_private; ptyext_attributes } -> + : Compiler_types.type_extension -> Versions.V4_08.Type_extension.concrete + = fun { ptyext_path; ptyext_params; ptyext_constructors; ptyext_private; ptyext_loc; ptyext_attributes } -> let ptyext_path = ast_of_longident_loc ptyext_path in let ptyext_params = (List.map ~f:(Tuple.map2 ~f1:ast_of_core_type ~f2:ast_of_variance)) ptyext_params in let ptyext_constructors = (List.map ~f:ast_of_extension_constructor) ptyext_constructors in let ptyext_private = ast_of_private_flag ptyext_private in let ptyext_attributes = ast_of_attributes ptyext_attributes in - { ptyext_path; ptyext_params; ptyext_constructors; ptyext_private; ptyext_attributes } + { ptyext_path; ptyext_params; ptyext_constructors; ptyext_private; ptyext_loc; ptyext_attributes } and ast_to_type_extension - : Versions.V4_07.Type_extension.t -> Compiler_types.type_extension + : Versions.V4_08.Type_extension.t -> Compiler_types.type_extension = fun x -> - let concrete = Versions.V4_07.Type_extension.to_concrete x in + let concrete = Versions.V4_08.Type_extension.to_concrete x in concrete_to_type_extension concrete and concrete_to_type_extension - : Versions.V4_07.Type_extension.concrete -> Compiler_types.type_extension - = fun { ptyext_path; ptyext_params; ptyext_constructors; ptyext_private; ptyext_attributes } -> + : Versions.V4_08.Type_extension.concrete -> Compiler_types.type_extension + = fun { ptyext_path; ptyext_params; ptyext_constructors; ptyext_private; ptyext_loc; ptyext_attributes } -> let ptyext_path = ast_to_longident_loc ptyext_path in let ptyext_params = (List.map ~f:(Tuple.map2 ~f1:ast_to_core_type ~f2:ast_to_variance)) ptyext_params in let ptyext_constructors = (List.map ~f:ast_to_extension_constructor) ptyext_constructors in let ptyext_private = ast_to_private_flag ptyext_private in let ptyext_attributes = ast_to_attributes ptyext_attributes in - { ptyext_path; ptyext_params; ptyext_constructors; ptyext_private; ptyext_attributes } + { ptyext_path; ptyext_params; ptyext_constructors; ptyext_private; ptyext_loc; ptyext_attributes } and ast_of_extension_constructor - : Compiler_types.extension_constructor -> Versions.V4_07.Extension_constructor.t + : Compiler_types.extension_constructor -> Versions.V4_08.Extension_constructor.t = fun x -> - Versions.V4_07.Extension_constructor.of_concrete (concrete_of_extension_constructor x) + Versions.V4_08.Extension_constructor.of_concrete (concrete_of_extension_constructor x) and concrete_of_extension_constructor - : Compiler_types.extension_constructor -> Versions.V4_07.Extension_constructor.concrete + : Compiler_types.extension_constructor -> Versions.V4_08.Extension_constructor.concrete = fun { pext_name; pext_kind; pext_loc; pext_attributes } -> let pext_kind = ast_of_extension_constructor_kind pext_kind in let pext_attributes = ast_of_attributes pext_attributes in { pext_name; pext_kind; pext_loc; pext_attributes } and ast_to_extension_constructor - : Versions.V4_07.Extension_constructor.t -> Compiler_types.extension_constructor + : Versions.V4_08.Extension_constructor.t -> Compiler_types.extension_constructor = fun x -> - let concrete = Versions.V4_07.Extension_constructor.to_concrete x in + let concrete = Versions.V4_08.Extension_constructor.to_concrete x in concrete_to_extension_constructor concrete and concrete_to_extension_constructor - : Versions.V4_07.Extension_constructor.concrete -> Compiler_types.extension_constructor + : Versions.V4_08.Extension_constructor.concrete -> Compiler_types.extension_constructor = fun { pext_name; pext_kind; pext_loc; pext_attributes } -> let pext_kind = ast_to_extension_constructor_kind pext_kind in let pext_attributes = ast_to_attributes pext_attributes in { pext_name; pext_kind; pext_loc; pext_attributes } +and ast_of_type_exception + : Compiler_types.type_exception -> Versions.V4_08.Type_exception.t + = fun x -> + Versions.V4_08.Type_exception.of_concrete (concrete_of_type_exception x) + +and concrete_of_type_exception + : Compiler_types.type_exception -> Versions.V4_08.Type_exception.concrete + = fun { ptyexn_constructor; ptyexn_loc; ptyexn_attributes } -> + let ptyexn_constructor = ast_of_extension_constructor ptyexn_constructor in + let ptyexn_attributes = ast_of_attributes ptyexn_attributes in + { ptyexn_constructor; ptyexn_loc; ptyexn_attributes } + +and ast_to_type_exception + : Versions.V4_08.Type_exception.t -> Compiler_types.type_exception + = fun x -> + let concrete = Versions.V4_08.Type_exception.to_concrete x in + concrete_to_type_exception concrete + +and concrete_to_type_exception + : Versions.V4_08.Type_exception.concrete -> Compiler_types.type_exception + = fun { ptyexn_constructor; ptyexn_loc; ptyexn_attributes } -> + let ptyexn_constructor = ast_to_extension_constructor ptyexn_constructor in + let ptyexn_attributes = ast_to_attributes ptyexn_attributes in + { ptyexn_constructor; ptyexn_loc; ptyexn_attributes } + and ast_of_extension_constructor_kind - : Compiler_types.extension_constructor_kind -> Versions.V4_07.Extension_constructor_kind.t + : Compiler_types.extension_constructor_kind -> Versions.V4_08.Extension_constructor_kind.t = fun x -> - Versions.V4_07.Extension_constructor_kind.of_concrete (concrete_of_extension_constructor_kind x) + Versions.V4_08.Extension_constructor_kind.of_concrete (concrete_of_extension_constructor_kind x) and concrete_of_extension_constructor_kind - : Compiler_types.extension_constructor_kind -> Versions.V4_07.Extension_constructor_kind.concrete + : Compiler_types.extension_constructor_kind -> Versions.V4_08.Extension_constructor_kind.concrete = fun x -> match (x : Compiler_types.extension_constructor_kind) with | Pext_decl (x1, x2) -> @@ -1413,15 +1542,15 @@ and concrete_of_extension_constructor_kind Pext_rebind (x1) and ast_to_extension_constructor_kind - : Versions.V4_07.Extension_constructor_kind.t -> Compiler_types.extension_constructor_kind + : Versions.V4_08.Extension_constructor_kind.t -> Compiler_types.extension_constructor_kind = fun x -> - let concrete = Versions.V4_07.Extension_constructor_kind.to_concrete x in + let concrete = Versions.V4_08.Extension_constructor_kind.to_concrete x in concrete_to_extension_constructor_kind concrete and concrete_to_extension_constructor_kind - : Versions.V4_07.Extension_constructor_kind.concrete -> Compiler_types.extension_constructor_kind + : Versions.V4_08.Extension_constructor_kind.concrete -> Compiler_types.extension_constructor_kind = fun x -> - match (x : Versions.V4_07.Extension_constructor_kind.concrete) with + match (x : Versions.V4_08.Extension_constructor_kind.concrete) with | Pext_decl (x1, x2) -> let x1 = ast_to_constructor_arguments x1 in let x2 = (Option.map ~f:ast_to_core_type) x2 in @@ -1431,37 +1560,37 @@ and concrete_to_extension_constructor_kind Pext_rebind (x1) and ast_of_class_type - : Compiler_types.class_type -> Versions.V4_07.Class_type.t + : Compiler_types.class_type -> Versions.V4_08.Class_type.t = fun x -> - Versions.V4_07.Class_type.of_concrete (concrete_of_class_type x) + Versions.V4_08.Class_type.of_concrete (concrete_of_class_type x) and concrete_of_class_type - : Compiler_types.class_type -> Versions.V4_07.Class_type.concrete + : Compiler_types.class_type -> Versions.V4_08.Class_type.concrete = fun { pcty_desc; pcty_loc; pcty_attributes } -> let pcty_desc = ast_of_class_type_desc pcty_desc in let pcty_attributes = ast_of_attributes pcty_attributes in { pcty_desc; pcty_loc; pcty_attributes } and ast_to_class_type - : Versions.V4_07.Class_type.t -> Compiler_types.class_type + : Versions.V4_08.Class_type.t -> Compiler_types.class_type = fun x -> - let concrete = Versions.V4_07.Class_type.to_concrete x in + let concrete = Versions.V4_08.Class_type.to_concrete x in concrete_to_class_type concrete and concrete_to_class_type - : Versions.V4_07.Class_type.concrete -> Compiler_types.class_type + : Versions.V4_08.Class_type.concrete -> Compiler_types.class_type = fun { pcty_desc; pcty_loc; pcty_attributes } -> let pcty_desc = ast_to_class_type_desc pcty_desc in let pcty_attributes = ast_to_attributes pcty_attributes in { pcty_desc; pcty_loc; pcty_attributes } and ast_of_class_type_desc - : Compiler_types.class_type_desc -> Versions.V4_07.Class_type_desc.t + : Compiler_types.class_type_desc -> Versions.V4_08.Class_type_desc.t = fun x -> - Versions.V4_07.Class_type_desc.of_concrete (concrete_of_class_type_desc x) + Versions.V4_08.Class_type_desc.of_concrete (concrete_of_class_type_desc x) and concrete_of_class_type_desc - : Compiler_types.class_type_desc -> Versions.V4_07.Class_type_desc.concrete + : Compiler_types.class_type_desc -> Versions.V4_08.Class_type_desc.concrete = fun x -> match (x : Compiler_types.class_type_desc) with | Pcty_constr (x1, x2) -> @@ -1479,22 +1608,21 @@ and concrete_of_class_type_desc | Pcty_extension (x1) -> let x1 = ast_of_extension x1 in Pcty_extension (x1) - | Pcty_open (x1, x2, x3) -> - let x1 = ast_of_override_flag x1 in - let x2 = ast_of_longident_loc x2 in - let x3 = ast_of_class_type x3 in - Pcty_open (x1, x2, x3) + | Pcty_open (x1, x2) -> + let x1 = ast_of_open_description x1 in + let x2 = ast_of_class_type x2 in + Pcty_open (x1, x2) and ast_to_class_type_desc - : Versions.V4_07.Class_type_desc.t -> Compiler_types.class_type_desc + : Versions.V4_08.Class_type_desc.t -> Compiler_types.class_type_desc = fun x -> - let concrete = Versions.V4_07.Class_type_desc.to_concrete x in + let concrete = Versions.V4_08.Class_type_desc.to_concrete x in concrete_to_class_type_desc concrete and concrete_to_class_type_desc - : Versions.V4_07.Class_type_desc.concrete -> Compiler_types.class_type_desc + : Versions.V4_08.Class_type_desc.concrete -> Compiler_types.class_type_desc = fun x -> - match (x : Versions.V4_07.Class_type_desc.concrete) with + match (x : Versions.V4_08.Class_type_desc.concrete) with | Pcty_constr (x1, x2) -> let x1 = ast_to_longident_loc x1 in let x2 = (List.map ~f:ast_to_core_type) x2 in @@ -1510,69 +1638,68 @@ and concrete_to_class_type_desc | Pcty_extension (x1) -> let x1 = ast_to_extension x1 in Pcty_extension (x1) - | Pcty_open (x1, x2, x3) -> - let x1 = ast_to_override_flag x1 in - let x2 = ast_to_longident_loc x2 in - let x3 = ast_to_class_type x3 in - Pcty_open (x1, x2, x3) + | Pcty_open (x1, x2) -> + let x1 = ast_to_open_description x1 in + let x2 = ast_to_class_type x2 in + Pcty_open (x1, x2) and ast_of_class_signature - : Compiler_types.class_signature -> Versions.V4_07.Class_signature.t + : Compiler_types.class_signature -> Versions.V4_08.Class_signature.t = fun x -> - Versions.V4_07.Class_signature.of_concrete (concrete_of_class_signature x) + Versions.V4_08.Class_signature.of_concrete (concrete_of_class_signature x) and concrete_of_class_signature - : Compiler_types.class_signature -> Versions.V4_07.Class_signature.concrete + : Compiler_types.class_signature -> Versions.V4_08.Class_signature.concrete = fun { pcsig_self; pcsig_fields } -> let pcsig_self = ast_of_core_type pcsig_self in let pcsig_fields = (List.map ~f:ast_of_class_type_field) pcsig_fields in { pcsig_self; pcsig_fields } and ast_to_class_signature - : Versions.V4_07.Class_signature.t -> Compiler_types.class_signature + : Versions.V4_08.Class_signature.t -> Compiler_types.class_signature = fun x -> - let concrete = Versions.V4_07.Class_signature.to_concrete x in + let concrete = Versions.V4_08.Class_signature.to_concrete x in concrete_to_class_signature concrete and concrete_to_class_signature - : Versions.V4_07.Class_signature.concrete -> Compiler_types.class_signature + : Versions.V4_08.Class_signature.concrete -> Compiler_types.class_signature = fun { pcsig_self; pcsig_fields } -> let pcsig_self = ast_to_core_type pcsig_self in let pcsig_fields = (List.map ~f:ast_to_class_type_field) pcsig_fields in { pcsig_self; pcsig_fields } and ast_of_class_type_field - : Compiler_types.class_type_field -> Versions.V4_07.Class_type_field.t + : Compiler_types.class_type_field -> Versions.V4_08.Class_type_field.t = fun x -> - Versions.V4_07.Class_type_field.of_concrete (concrete_of_class_type_field x) + Versions.V4_08.Class_type_field.of_concrete (concrete_of_class_type_field x) and concrete_of_class_type_field - : Compiler_types.class_type_field -> Versions.V4_07.Class_type_field.concrete + : Compiler_types.class_type_field -> Versions.V4_08.Class_type_field.concrete = fun { pctf_desc; pctf_loc; pctf_attributes } -> let pctf_desc = ast_of_class_type_field_desc pctf_desc in let pctf_attributes = ast_of_attributes pctf_attributes in { pctf_desc; pctf_loc; pctf_attributes } and ast_to_class_type_field - : Versions.V4_07.Class_type_field.t -> Compiler_types.class_type_field + : Versions.V4_08.Class_type_field.t -> Compiler_types.class_type_field = fun x -> - let concrete = Versions.V4_07.Class_type_field.to_concrete x in + let concrete = Versions.V4_08.Class_type_field.to_concrete x in concrete_to_class_type_field concrete and concrete_to_class_type_field - : Versions.V4_07.Class_type_field.concrete -> Compiler_types.class_type_field + : Versions.V4_08.Class_type_field.concrete -> Compiler_types.class_type_field = fun { pctf_desc; pctf_loc; pctf_attributes } -> let pctf_desc = ast_to_class_type_field_desc pctf_desc in let pctf_attributes = ast_to_attributes pctf_attributes in { pctf_desc; pctf_loc; pctf_attributes } and ast_of_class_type_field_desc - : Compiler_types.class_type_field_desc -> Versions.V4_07.Class_type_field_desc.t + : Compiler_types.class_type_field_desc -> Versions.V4_08.Class_type_field_desc.t = fun x -> - Versions.V4_07.Class_type_field_desc.of_concrete (concrete_of_class_type_field_desc x) + Versions.V4_08.Class_type_field_desc.of_concrete (concrete_of_class_type_field_desc x) and concrete_of_class_type_field_desc - : Compiler_types.class_type_field_desc -> Versions.V4_07.Class_type_field_desc.concrete + : Compiler_types.class_type_field_desc -> Versions.V4_08.Class_type_field_desc.concrete = fun x -> match (x : Compiler_types.class_type_field_desc) with | Pctf_inherit (x1) -> @@ -1595,15 +1722,15 @@ and concrete_of_class_type_field_desc Pctf_extension (x1) and ast_to_class_type_field_desc - : Versions.V4_07.Class_type_field_desc.t -> Compiler_types.class_type_field_desc + : Versions.V4_08.Class_type_field_desc.t -> Compiler_types.class_type_field_desc = fun x -> - let concrete = Versions.V4_07.Class_type_field_desc.to_concrete x in + let concrete = Versions.V4_08.Class_type_field_desc.to_concrete x in concrete_to_class_type_field_desc concrete and concrete_to_class_type_field_desc - : Versions.V4_07.Class_type_field_desc.concrete -> Compiler_types.class_type_field_desc + : Versions.V4_08.Class_type_field_desc.concrete -> Compiler_types.class_type_field_desc = fun x -> - match (x : Versions.V4_07.Class_type_field_desc.concrete) with + match (x : Versions.V4_08.Class_type_field_desc.concrete) with | Pctf_inherit (x1) -> let x1 = ast_to_class_type x1 in Pctf_inherit (x1) @@ -1624,12 +1751,12 @@ and concrete_to_class_type_field_desc Pctf_extension (x1) and ast_of_class_infos - : type a a_ .(a_ -> a Unversioned.Types.node) -> a_ Compiler_types.class_infos -> a Unversioned.Types.node Versions.V4_07.Class_infos.t + : type a a_ .(a_ -> a Unversioned.Types.node) -> a_ Compiler_types.class_infos -> a Unversioned.Types.node Versions.V4_08.Class_infos.t = fun ast_of_a x -> - Versions.V4_07.Class_infos.of_concrete (concrete_of_class_infos ast_of_a x) + Versions.V4_08.Class_infos.of_concrete (concrete_of_class_infos ast_of_a x) and concrete_of_class_infos - : type a a_ .(a_ -> a Unversioned.Types.node) -> a_ Compiler_types.class_infos -> a Unversioned.Types.node Versions.V4_07.Class_infos.concrete + : type a a_ .(a_ -> a Unversioned.Types.node) -> a_ Compiler_types.class_infos -> a Unversioned.Types.node Versions.V4_08.Class_infos.concrete = fun ast_of_a { pci_virt; pci_params; pci_name; pci_expr; pci_loc; pci_attributes } -> let pci_virt = ast_of_virtual_flag pci_virt in let pci_params = (List.map ~f:(Tuple.map2 ~f1:ast_of_core_type ~f2:ast_of_variance)) pci_params in @@ -1638,13 +1765,13 @@ and concrete_of_class_infos { pci_virt; pci_params; pci_name; pci_expr; pci_loc; pci_attributes } and ast_to_class_infos - : type a a_ .(a Unversioned.Types.node -> a_) -> a Unversioned.Types.node Versions.V4_07.Class_infos.t -> a_ Compiler_types.class_infos + : type a a_ .(a Unversioned.Types.node -> a_) -> a Unversioned.Types.node Versions.V4_08.Class_infos.t -> a_ Compiler_types.class_infos = fun ast_to_a x -> - let concrete = Versions.V4_07.Class_infos.to_concrete x in + let concrete = Versions.V4_08.Class_infos.to_concrete x in concrete_to_class_infos ast_to_a concrete and concrete_to_class_infos - : type a a_ .(a Unversioned.Types.node -> a_) -> a Unversioned.Types.node Versions.V4_07.Class_infos.concrete -> a_ Compiler_types.class_infos + : type a a_ .(a Unversioned.Types.node -> a_) -> a Unversioned.Types.node Versions.V4_08.Class_infos.concrete -> a_ Compiler_types.class_infos = fun ast_to_a { pci_virt; pci_params; pci_name; pci_expr; pci_loc; pci_attributes } -> let pci_virt = ast_to_virtual_flag pci_virt in let pci_params = (List.map ~f:(Tuple.map2 ~f1:ast_to_core_type ~f2:ast_to_variance)) pci_params in @@ -1653,79 +1780,79 @@ and concrete_to_class_infos { pci_virt; pci_params; pci_name; pci_expr; pci_loc; pci_attributes } and ast_of_class_description - : Compiler_types.class_description -> Versions.V4_07.Class_description.t + : Compiler_types.class_description -> Versions.V4_08.Class_description.t = fun x -> - Versions.V4_07.Class_description.of_concrete (concrete_of_class_description x) + Versions.V4_08.Class_description.of_concrete (concrete_of_class_description x) and concrete_of_class_description - : Compiler_types.class_description -> Versions.V4_07.Class_description.concrete + : Compiler_types.class_description -> Versions.V4_08.Class_description.concrete = fun x -> (ast_of_class_infos ast_of_class_type) x and ast_to_class_description - : Versions.V4_07.Class_description.t -> Compiler_types.class_description + : Versions.V4_08.Class_description.t -> Compiler_types.class_description = fun x -> - let concrete = Versions.V4_07.Class_description.to_concrete x in + let concrete = Versions.V4_08.Class_description.to_concrete x in concrete_to_class_description concrete and concrete_to_class_description - : Versions.V4_07.Class_description.concrete -> Compiler_types.class_description + : Versions.V4_08.Class_description.concrete -> Compiler_types.class_description = fun x -> (ast_to_class_infos ast_to_class_type) x and ast_of_class_type_declaration - : Compiler_types.class_type_declaration -> Versions.V4_07.Class_type_declaration.t + : Compiler_types.class_type_declaration -> Versions.V4_08.Class_type_declaration.t = fun x -> - Versions.V4_07.Class_type_declaration.of_concrete (concrete_of_class_type_declaration x) + Versions.V4_08.Class_type_declaration.of_concrete (concrete_of_class_type_declaration x) and concrete_of_class_type_declaration - : Compiler_types.class_type_declaration -> Versions.V4_07.Class_type_declaration.concrete + : Compiler_types.class_type_declaration -> Versions.V4_08.Class_type_declaration.concrete = fun x -> (ast_of_class_infos ast_of_class_type) x and ast_to_class_type_declaration - : Versions.V4_07.Class_type_declaration.t -> Compiler_types.class_type_declaration + : Versions.V4_08.Class_type_declaration.t -> Compiler_types.class_type_declaration = fun x -> - let concrete = Versions.V4_07.Class_type_declaration.to_concrete x in + let concrete = Versions.V4_08.Class_type_declaration.to_concrete x in concrete_to_class_type_declaration concrete and concrete_to_class_type_declaration - : Versions.V4_07.Class_type_declaration.concrete -> Compiler_types.class_type_declaration + : Versions.V4_08.Class_type_declaration.concrete -> Compiler_types.class_type_declaration = fun x -> (ast_to_class_infos ast_to_class_type) x and ast_of_class_expr - : Compiler_types.class_expr -> Versions.V4_07.Class_expr.t + : Compiler_types.class_expr -> Versions.V4_08.Class_expr.t = fun x -> - Versions.V4_07.Class_expr.of_concrete (concrete_of_class_expr x) + Versions.V4_08.Class_expr.of_concrete (concrete_of_class_expr x) and concrete_of_class_expr - : Compiler_types.class_expr -> Versions.V4_07.Class_expr.concrete + : Compiler_types.class_expr -> Versions.V4_08.Class_expr.concrete = fun { pcl_desc; pcl_loc; pcl_attributes } -> let pcl_desc = ast_of_class_expr_desc pcl_desc in let pcl_attributes = ast_of_attributes pcl_attributes in { pcl_desc; pcl_loc; pcl_attributes } and ast_to_class_expr - : Versions.V4_07.Class_expr.t -> Compiler_types.class_expr + : Versions.V4_08.Class_expr.t -> Compiler_types.class_expr = fun x -> - let concrete = Versions.V4_07.Class_expr.to_concrete x in + let concrete = Versions.V4_08.Class_expr.to_concrete x in concrete_to_class_expr concrete and concrete_to_class_expr - : Versions.V4_07.Class_expr.concrete -> Compiler_types.class_expr + : Versions.V4_08.Class_expr.concrete -> Compiler_types.class_expr = fun { pcl_desc; pcl_loc; pcl_attributes } -> let pcl_desc = ast_to_class_expr_desc pcl_desc in let pcl_attributes = ast_to_attributes pcl_attributes in { pcl_desc; pcl_loc; pcl_attributes } and ast_of_class_expr_desc - : Compiler_types.class_expr_desc -> Versions.V4_07.Class_expr_desc.t + : Compiler_types.class_expr_desc -> Versions.V4_08.Class_expr_desc.t = fun x -> - Versions.V4_07.Class_expr_desc.of_concrete (concrete_of_class_expr_desc x) + Versions.V4_08.Class_expr_desc.of_concrete (concrete_of_class_expr_desc x) and concrete_of_class_expr_desc - : Compiler_types.class_expr_desc -> Versions.V4_07.Class_expr_desc.concrete + : Compiler_types.class_expr_desc -> Versions.V4_08.Class_expr_desc.concrete = fun x -> match (x : Compiler_types.class_expr_desc) with | Pcl_constr (x1, x2) -> @@ -1757,22 +1884,21 @@ and concrete_of_class_expr_desc | Pcl_extension (x1) -> let x1 = ast_of_extension x1 in Pcl_extension (x1) - | Pcl_open (x1, x2, x3) -> - let x1 = ast_of_override_flag x1 in - let x2 = ast_of_longident_loc x2 in - let x3 = ast_of_class_expr x3 in - Pcl_open (x1, x2, x3) + | Pcl_open (x1, x2) -> + let x1 = ast_of_open_description x1 in + let x2 = ast_of_class_expr x2 in + Pcl_open (x1, x2) and ast_to_class_expr_desc - : Versions.V4_07.Class_expr_desc.t -> Compiler_types.class_expr_desc + : Versions.V4_08.Class_expr_desc.t -> Compiler_types.class_expr_desc = fun x -> - let concrete = Versions.V4_07.Class_expr_desc.to_concrete x in + let concrete = Versions.V4_08.Class_expr_desc.to_concrete x in concrete_to_class_expr_desc concrete and concrete_to_class_expr_desc - : Versions.V4_07.Class_expr_desc.concrete -> Compiler_types.class_expr_desc + : Versions.V4_08.Class_expr_desc.concrete -> Compiler_types.class_expr_desc = fun x -> - match (x : Versions.V4_07.Class_expr_desc.concrete) with + match (x : Versions.V4_08.Class_expr_desc.concrete) with | Pcl_constr (x1, x2) -> let x1 = ast_to_longident_loc x1 in let x2 = (List.map ~f:ast_to_core_type) x2 in @@ -1802,69 +1928,68 @@ and concrete_to_class_expr_desc | Pcl_extension (x1) -> let x1 = ast_to_extension x1 in Pcl_extension (x1) - | Pcl_open (x1, x2, x3) -> - let x1 = ast_to_override_flag x1 in - let x2 = ast_to_longident_loc x2 in - let x3 = ast_to_class_expr x3 in - Pcl_open (x1, x2, x3) + | Pcl_open (x1, x2) -> + let x1 = ast_to_open_description x1 in + let x2 = ast_to_class_expr x2 in + Pcl_open (x1, x2) and ast_of_class_structure - : Compiler_types.class_structure -> Versions.V4_07.Class_structure.t + : Compiler_types.class_structure -> Versions.V4_08.Class_structure.t = fun x -> - Versions.V4_07.Class_structure.of_concrete (concrete_of_class_structure x) + Versions.V4_08.Class_structure.of_concrete (concrete_of_class_structure x) and concrete_of_class_structure - : Compiler_types.class_structure -> Versions.V4_07.Class_structure.concrete + : Compiler_types.class_structure -> Versions.V4_08.Class_structure.concrete = fun { pcstr_self; pcstr_fields } -> let pcstr_self = ast_of_pattern pcstr_self in let pcstr_fields = (List.map ~f:ast_of_class_field) pcstr_fields in { pcstr_self; pcstr_fields } and ast_to_class_structure - : Versions.V4_07.Class_structure.t -> Compiler_types.class_structure + : Versions.V4_08.Class_structure.t -> Compiler_types.class_structure = fun x -> - let concrete = Versions.V4_07.Class_structure.to_concrete x in + let concrete = Versions.V4_08.Class_structure.to_concrete x in concrete_to_class_structure concrete and concrete_to_class_structure - : Versions.V4_07.Class_structure.concrete -> Compiler_types.class_structure + : Versions.V4_08.Class_structure.concrete -> Compiler_types.class_structure = fun { pcstr_self; pcstr_fields } -> let pcstr_self = ast_to_pattern pcstr_self in let pcstr_fields = (List.map ~f:ast_to_class_field) pcstr_fields in { pcstr_self; pcstr_fields } and ast_of_class_field - : Compiler_types.class_field -> Versions.V4_07.Class_field.t + : Compiler_types.class_field -> Versions.V4_08.Class_field.t = fun x -> - Versions.V4_07.Class_field.of_concrete (concrete_of_class_field x) + Versions.V4_08.Class_field.of_concrete (concrete_of_class_field x) and concrete_of_class_field - : Compiler_types.class_field -> Versions.V4_07.Class_field.concrete + : Compiler_types.class_field -> Versions.V4_08.Class_field.concrete = fun { pcf_desc; pcf_loc; pcf_attributes } -> let pcf_desc = ast_of_class_field_desc pcf_desc in let pcf_attributes = ast_of_attributes pcf_attributes in { pcf_desc; pcf_loc; pcf_attributes } and ast_to_class_field - : Versions.V4_07.Class_field.t -> Compiler_types.class_field + : Versions.V4_08.Class_field.t -> Compiler_types.class_field = fun x -> - let concrete = Versions.V4_07.Class_field.to_concrete x in + let concrete = Versions.V4_08.Class_field.to_concrete x in concrete_to_class_field concrete and concrete_to_class_field - : Versions.V4_07.Class_field.concrete -> Compiler_types.class_field + : Versions.V4_08.Class_field.concrete -> Compiler_types.class_field = fun { pcf_desc; pcf_loc; pcf_attributes } -> let pcf_desc = ast_to_class_field_desc pcf_desc in let pcf_attributes = ast_to_attributes pcf_attributes in { pcf_desc; pcf_loc; pcf_attributes } and ast_of_class_field_desc - : Compiler_types.class_field_desc -> Versions.V4_07.Class_field_desc.t + : Compiler_types.class_field_desc -> Versions.V4_08.Class_field_desc.t = fun x -> - Versions.V4_07.Class_field_desc.of_concrete (concrete_of_class_field_desc x) + Versions.V4_08.Class_field_desc.of_concrete (concrete_of_class_field_desc x) and concrete_of_class_field_desc - : Compiler_types.class_field_desc -> Versions.V4_07.Class_field_desc.concrete + : Compiler_types.class_field_desc -> Versions.V4_08.Class_field_desc.concrete = fun x -> match (x : Compiler_types.class_field_desc) with | Pcf_inherit (x1, x2, x3) -> @@ -1891,15 +2016,15 @@ and concrete_of_class_field_desc Pcf_extension (x1) and ast_to_class_field_desc - : Versions.V4_07.Class_field_desc.t -> Compiler_types.class_field_desc + : Versions.V4_08.Class_field_desc.t -> Compiler_types.class_field_desc = fun x -> - let concrete = Versions.V4_07.Class_field_desc.to_concrete x in + let concrete = Versions.V4_08.Class_field_desc.to_concrete x in concrete_to_class_field_desc concrete and concrete_to_class_field_desc - : Versions.V4_07.Class_field_desc.concrete -> Compiler_types.class_field_desc + : Versions.V4_08.Class_field_desc.concrete -> Compiler_types.class_field_desc = fun x -> - match (x : Versions.V4_07.Class_field_desc.concrete) with + match (x : Versions.V4_08.Class_field_desc.concrete) with | Pcf_inherit (x1, x2, x3) -> let x1 = ast_to_override_flag x1 in let x2 = ast_to_class_expr x2 in @@ -1924,12 +2049,12 @@ and concrete_to_class_field_desc Pcf_extension (x1) and ast_of_class_field_kind - : Compiler_types.class_field_kind -> Versions.V4_07.Class_field_kind.t + : Compiler_types.class_field_kind -> Versions.V4_08.Class_field_kind.t = fun x -> - Versions.V4_07.Class_field_kind.of_concrete (concrete_of_class_field_kind x) + Versions.V4_08.Class_field_kind.of_concrete (concrete_of_class_field_kind x) and concrete_of_class_field_kind - : Compiler_types.class_field_kind -> Versions.V4_07.Class_field_kind.concrete + : Compiler_types.class_field_kind -> Versions.V4_08.Class_field_kind.concrete = fun x -> match (x : Compiler_types.class_field_kind) with | Cfk_virtual (x1) -> @@ -1941,15 +2066,15 @@ and concrete_of_class_field_kind Cfk_concrete (x1, x2) and ast_to_class_field_kind - : Versions.V4_07.Class_field_kind.t -> Compiler_types.class_field_kind + : Versions.V4_08.Class_field_kind.t -> Compiler_types.class_field_kind = fun x -> - let concrete = Versions.V4_07.Class_field_kind.to_concrete x in + let concrete = Versions.V4_08.Class_field_kind.to_concrete x in concrete_to_class_field_kind concrete and concrete_to_class_field_kind - : Versions.V4_07.Class_field_kind.concrete -> Compiler_types.class_field_kind + : Versions.V4_08.Class_field_kind.concrete -> Compiler_types.class_field_kind = fun x -> - match (x : Versions.V4_07.Class_field_kind.concrete) with + match (x : Versions.V4_08.Class_field_kind.concrete) with | Cfk_virtual (x1) -> let x1 = ast_to_core_type x1 in Cfk_virtual (x1) @@ -1959,58 +2084,58 @@ and concrete_to_class_field_kind Cfk_concrete (x1, x2) and ast_of_class_declaration - : Compiler_types.class_declaration -> Versions.V4_07.Class_declaration.t + : Compiler_types.class_declaration -> Versions.V4_08.Class_declaration.t = fun x -> - Versions.V4_07.Class_declaration.of_concrete (concrete_of_class_declaration x) + Versions.V4_08.Class_declaration.of_concrete (concrete_of_class_declaration x) and concrete_of_class_declaration - : Compiler_types.class_declaration -> Versions.V4_07.Class_declaration.concrete + : Compiler_types.class_declaration -> Versions.V4_08.Class_declaration.concrete = fun x -> (ast_of_class_infos ast_of_class_expr) x and ast_to_class_declaration - : Versions.V4_07.Class_declaration.t -> Compiler_types.class_declaration + : Versions.V4_08.Class_declaration.t -> Compiler_types.class_declaration = fun x -> - let concrete = Versions.V4_07.Class_declaration.to_concrete x in + let concrete = Versions.V4_08.Class_declaration.to_concrete x in concrete_to_class_declaration concrete and concrete_to_class_declaration - : Versions.V4_07.Class_declaration.concrete -> Compiler_types.class_declaration + : Versions.V4_08.Class_declaration.concrete -> Compiler_types.class_declaration = fun x -> (ast_to_class_infos ast_to_class_expr) x and ast_of_module_type - : Compiler_types.module_type -> Versions.V4_07.Module_type.t + : Compiler_types.module_type -> Versions.V4_08.Module_type.t = fun x -> - Versions.V4_07.Module_type.of_concrete (concrete_of_module_type x) + Versions.V4_08.Module_type.of_concrete (concrete_of_module_type x) and concrete_of_module_type - : Compiler_types.module_type -> Versions.V4_07.Module_type.concrete + : Compiler_types.module_type -> Versions.V4_08.Module_type.concrete = fun { pmty_desc; pmty_loc; pmty_attributes } -> let pmty_desc = ast_of_module_type_desc pmty_desc in let pmty_attributes = ast_of_attributes pmty_attributes in { pmty_desc; pmty_loc; pmty_attributes } and ast_to_module_type - : Versions.V4_07.Module_type.t -> Compiler_types.module_type + : Versions.V4_08.Module_type.t -> Compiler_types.module_type = fun x -> - let concrete = Versions.V4_07.Module_type.to_concrete x in + let concrete = Versions.V4_08.Module_type.to_concrete x in concrete_to_module_type concrete and concrete_to_module_type - : Versions.V4_07.Module_type.concrete -> Compiler_types.module_type + : Versions.V4_08.Module_type.concrete -> Compiler_types.module_type = fun { pmty_desc; pmty_loc; pmty_attributes } -> let pmty_desc = ast_to_module_type_desc pmty_desc in let pmty_attributes = ast_to_attributes pmty_attributes in { pmty_desc; pmty_loc; pmty_attributes } and ast_of_module_type_desc - : Compiler_types.module_type_desc -> Versions.V4_07.Module_type_desc.t + : Compiler_types.module_type_desc -> Versions.V4_08.Module_type_desc.t = fun x -> - Versions.V4_07.Module_type_desc.of_concrete (concrete_of_module_type_desc x) + Versions.V4_08.Module_type_desc.of_concrete (concrete_of_module_type_desc x) and concrete_of_module_type_desc - : Compiler_types.module_type_desc -> Versions.V4_07.Module_type_desc.concrete + : Compiler_types.module_type_desc -> Versions.V4_08.Module_type_desc.concrete = fun x -> match (x : Compiler_types.module_type_desc) with | Pmty_ident (x1) -> @@ -2038,15 +2163,15 @@ and concrete_of_module_type_desc Pmty_alias (x1) and ast_to_module_type_desc - : Versions.V4_07.Module_type_desc.t -> Compiler_types.module_type_desc + : Versions.V4_08.Module_type_desc.t -> Compiler_types.module_type_desc = fun x -> - let concrete = Versions.V4_07.Module_type_desc.to_concrete x in + let concrete = Versions.V4_08.Module_type_desc.to_concrete x in concrete_to_module_type_desc concrete and concrete_to_module_type_desc - : Versions.V4_07.Module_type_desc.concrete -> Compiler_types.module_type_desc + : Versions.V4_08.Module_type_desc.concrete -> Compiler_types.module_type_desc = fun x -> - match (x : Versions.V4_07.Module_type_desc.concrete) with + match (x : Versions.V4_08.Module_type_desc.concrete) with | Pmty_ident (x1) -> let x1 = ast_to_longident_loc x1 in Pmty_ident (x1) @@ -2072,56 +2197,56 @@ and concrete_to_module_type_desc Pmty_alias (x1) and ast_of_signature - : Compiler_types.signature -> Versions.V4_07.Signature.t + : Compiler_types.signature -> Versions.V4_08.Signature.t = fun x -> - Versions.V4_07.Signature.of_concrete (concrete_of_signature x) + Versions.V4_08.Signature.of_concrete (concrete_of_signature x) and concrete_of_signature - : Compiler_types.signature -> Versions.V4_07.Signature.concrete + : Compiler_types.signature -> Versions.V4_08.Signature.concrete = fun x -> (List.map ~f:ast_of_signature_item) x and ast_to_signature - : Versions.V4_07.Signature.t -> Compiler_types.signature + : Versions.V4_08.Signature.t -> Compiler_types.signature = fun x -> - let concrete = Versions.V4_07.Signature.to_concrete x in + let concrete = Versions.V4_08.Signature.to_concrete x in concrete_to_signature concrete and concrete_to_signature - : Versions.V4_07.Signature.concrete -> Compiler_types.signature + : Versions.V4_08.Signature.concrete -> Compiler_types.signature = fun x -> (List.map ~f:ast_to_signature_item) x and ast_of_signature_item - : Compiler_types.signature_item -> Versions.V4_07.Signature_item.t + : Compiler_types.signature_item -> Versions.V4_08.Signature_item.t = fun x -> - Versions.V4_07.Signature_item.of_concrete (concrete_of_signature_item x) + Versions.V4_08.Signature_item.of_concrete (concrete_of_signature_item x) and concrete_of_signature_item - : Compiler_types.signature_item -> Versions.V4_07.Signature_item.concrete + : Compiler_types.signature_item -> Versions.V4_08.Signature_item.concrete = fun { psig_desc; psig_loc } -> let psig_desc = ast_of_signature_item_desc psig_desc in { psig_desc; psig_loc } and ast_to_signature_item - : Versions.V4_07.Signature_item.t -> Compiler_types.signature_item + : Versions.V4_08.Signature_item.t -> Compiler_types.signature_item = fun x -> - let concrete = Versions.V4_07.Signature_item.to_concrete x in + let concrete = Versions.V4_08.Signature_item.to_concrete x in concrete_to_signature_item concrete and concrete_to_signature_item - : Versions.V4_07.Signature_item.concrete -> Compiler_types.signature_item + : Versions.V4_08.Signature_item.concrete -> Compiler_types.signature_item = fun { psig_desc; psig_loc } -> let psig_desc = ast_to_signature_item_desc psig_desc in { psig_desc; psig_loc } and ast_of_signature_item_desc - : Compiler_types.signature_item_desc -> Versions.V4_07.Signature_item_desc.t + : Compiler_types.signature_item_desc -> Versions.V4_08.Signature_item_desc.t = fun x -> - Versions.V4_07.Signature_item_desc.of_concrete (concrete_of_signature_item_desc x) + Versions.V4_08.Signature_item_desc.of_concrete (concrete_of_signature_item_desc x) and concrete_of_signature_item_desc - : Compiler_types.signature_item_desc -> Versions.V4_07.Signature_item_desc.concrete + : Compiler_types.signature_item_desc -> Versions.V4_08.Signature_item_desc.concrete = fun x -> match (x : Compiler_types.signature_item_desc) with | Psig_value (x1) -> @@ -2131,15 +2256,21 @@ and concrete_of_signature_item_desc let x1 = ast_of_rec_flag x1 in let x2 = (List.map ~f:ast_of_type_declaration) x2 in Psig_type (x1, x2) + | Psig_typesubst (x1) -> + let x1 = (List.map ~f:ast_of_type_declaration) x1 in + Psig_typesubst (x1) | Psig_typext (x1) -> let x1 = ast_of_type_extension x1 in Psig_typext (x1) | Psig_exception (x1) -> - let x1 = ast_of_extension_constructor x1 in + let x1 = ast_of_type_exception x1 in Psig_exception (x1) | Psig_module (x1) -> let x1 = ast_of_module_declaration x1 in Psig_module (x1) + | Psig_modsubst (x1) -> + let x1 = ast_of_module_substitution x1 in + Psig_modsubst (x1) | Psig_recmodule (x1) -> let x1 = (List.map ~f:ast_of_module_declaration) x1 in Psig_recmodule (x1) @@ -2167,15 +2298,15 @@ and concrete_of_signature_item_desc Psig_extension (x1, x2) and ast_to_signature_item_desc - : Versions.V4_07.Signature_item_desc.t -> Compiler_types.signature_item_desc + : Versions.V4_08.Signature_item_desc.t -> Compiler_types.signature_item_desc = fun x -> - let concrete = Versions.V4_07.Signature_item_desc.to_concrete x in + let concrete = Versions.V4_08.Signature_item_desc.to_concrete x in concrete_to_signature_item_desc concrete and concrete_to_signature_item_desc - : Versions.V4_07.Signature_item_desc.concrete -> Compiler_types.signature_item_desc + : Versions.V4_08.Signature_item_desc.concrete -> Compiler_types.signature_item_desc = fun x -> - match (x : Versions.V4_07.Signature_item_desc.concrete) with + match (x : Versions.V4_08.Signature_item_desc.concrete) with | Psig_value (x1) -> let x1 = ast_to_value_description x1 in Psig_value (x1) @@ -2183,15 +2314,21 @@ and concrete_to_signature_item_desc let x1 = ast_to_rec_flag x1 in let x2 = (List.map ~f:ast_to_type_declaration) x2 in Psig_type (x1, x2) + | Psig_typesubst (x1) -> + let x1 = (List.map ~f:ast_to_type_declaration) x1 in + Psig_typesubst (x1) | Psig_typext (x1) -> let x1 = ast_to_type_extension x1 in Psig_typext (x1) | Psig_exception (x1) -> - let x1 = ast_to_extension_constructor x1 in + let x1 = ast_to_type_exception x1 in Psig_exception (x1) | Psig_module (x1) -> let x1 = ast_to_module_declaration x1 in Psig_module (x1) + | Psig_modsubst (x1) -> + let x1 = ast_to_module_substitution x1 in + Psig_modsubst (x1) | Psig_recmodule (x1) -> let x1 = (List.map ~f:ast_to_module_declaration) x1 in Psig_recmodule (x1) @@ -2219,156 +2356,223 @@ and concrete_to_signature_item_desc Psig_extension (x1, x2) and ast_of_module_declaration - : Compiler_types.module_declaration -> Versions.V4_07.Module_declaration.t + : Compiler_types.module_declaration -> Versions.V4_08.Module_declaration.t = fun x -> - Versions.V4_07.Module_declaration.of_concrete (concrete_of_module_declaration x) + Versions.V4_08.Module_declaration.of_concrete (concrete_of_module_declaration x) and concrete_of_module_declaration - : Compiler_types.module_declaration -> Versions.V4_07.Module_declaration.concrete + : Compiler_types.module_declaration -> Versions.V4_08.Module_declaration.concrete = fun { pmd_name; pmd_type; pmd_attributes; pmd_loc } -> let pmd_type = ast_of_module_type pmd_type in let pmd_attributes = ast_of_attributes pmd_attributes in { pmd_name; pmd_type; pmd_attributes; pmd_loc } and ast_to_module_declaration - : Versions.V4_07.Module_declaration.t -> Compiler_types.module_declaration + : Versions.V4_08.Module_declaration.t -> Compiler_types.module_declaration = fun x -> - let concrete = Versions.V4_07.Module_declaration.to_concrete x in + let concrete = Versions.V4_08.Module_declaration.to_concrete x in concrete_to_module_declaration concrete and concrete_to_module_declaration - : Versions.V4_07.Module_declaration.concrete -> Compiler_types.module_declaration + : Versions.V4_08.Module_declaration.concrete -> Compiler_types.module_declaration = fun { pmd_name; pmd_type; pmd_attributes; pmd_loc } -> let pmd_type = ast_to_module_type pmd_type in let pmd_attributes = ast_to_attributes pmd_attributes in { pmd_name; pmd_type; pmd_attributes; pmd_loc } +and ast_of_module_substitution + : Compiler_types.module_substitution -> Versions.V4_08.Module_substitution.t + = fun x -> + Versions.V4_08.Module_substitution.of_concrete (concrete_of_module_substitution x) + +and concrete_of_module_substitution + : Compiler_types.module_substitution -> Versions.V4_08.Module_substitution.concrete + = fun { pms_name; pms_manifest; pms_attributes; pms_loc } -> + let pms_manifest = ast_of_longident_loc pms_manifest in + let pms_attributes = ast_of_attributes pms_attributes in + { pms_name; pms_manifest; pms_attributes; pms_loc } + +and ast_to_module_substitution + : Versions.V4_08.Module_substitution.t -> Compiler_types.module_substitution + = fun x -> + let concrete = Versions.V4_08.Module_substitution.to_concrete x in + concrete_to_module_substitution concrete + +and concrete_to_module_substitution + : Versions.V4_08.Module_substitution.concrete -> Compiler_types.module_substitution + = fun { pms_name; pms_manifest; pms_attributes; pms_loc } -> + let pms_manifest = ast_to_longident_loc pms_manifest in + let pms_attributes = ast_to_attributes pms_attributes in + { pms_name; pms_manifest; pms_attributes; pms_loc } + and ast_of_module_type_declaration - : Compiler_types.module_type_declaration -> Versions.V4_07.Module_type_declaration.t + : Compiler_types.module_type_declaration -> Versions.V4_08.Module_type_declaration.t = fun x -> - Versions.V4_07.Module_type_declaration.of_concrete (concrete_of_module_type_declaration x) + Versions.V4_08.Module_type_declaration.of_concrete (concrete_of_module_type_declaration x) and concrete_of_module_type_declaration - : Compiler_types.module_type_declaration -> Versions.V4_07.Module_type_declaration.concrete + : Compiler_types.module_type_declaration -> Versions.V4_08.Module_type_declaration.concrete = fun { pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc } -> let pmtd_type = (Option.map ~f:ast_of_module_type) pmtd_type in let pmtd_attributes = ast_of_attributes pmtd_attributes in { pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc } and ast_to_module_type_declaration - : Versions.V4_07.Module_type_declaration.t -> Compiler_types.module_type_declaration + : Versions.V4_08.Module_type_declaration.t -> Compiler_types.module_type_declaration = fun x -> - let concrete = Versions.V4_07.Module_type_declaration.to_concrete x in + let concrete = Versions.V4_08.Module_type_declaration.to_concrete x in concrete_to_module_type_declaration concrete and concrete_to_module_type_declaration - : Versions.V4_07.Module_type_declaration.concrete -> Compiler_types.module_type_declaration + : Versions.V4_08.Module_type_declaration.concrete -> Compiler_types.module_type_declaration = fun { pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc } -> let pmtd_type = (Option.map ~f:ast_to_module_type) pmtd_type in let pmtd_attributes = ast_to_attributes pmtd_attributes in { pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc } +and ast_of_open_infos + : type a a_ .(a_ -> a Unversioned.Types.node) -> a_ Compiler_types.open_infos -> a Unversioned.Types.node Versions.V4_08.Open_infos.t + = fun ast_of_a x -> + Versions.V4_08.Open_infos.of_concrete (concrete_of_open_infos ast_of_a x) + +and concrete_of_open_infos + : type a a_ .(a_ -> a Unversioned.Types.node) -> a_ Compiler_types.open_infos -> a Unversioned.Types.node Versions.V4_08.Open_infos.concrete + = fun ast_of_a { popen_expr; popen_override; popen_loc; popen_attributes } -> + let popen_expr = ast_of_a popen_expr in + let popen_override = ast_of_override_flag popen_override in + let popen_attributes = ast_of_attributes popen_attributes in + { popen_expr; popen_override; popen_loc; popen_attributes } + +and ast_to_open_infos + : type a a_ .(a Unversioned.Types.node -> a_) -> a Unversioned.Types.node Versions.V4_08.Open_infos.t -> a_ Compiler_types.open_infos + = fun ast_to_a x -> + let concrete = Versions.V4_08.Open_infos.to_concrete x in + concrete_to_open_infos ast_to_a concrete + +and concrete_to_open_infos + : type a a_ .(a Unversioned.Types.node -> a_) -> a Unversioned.Types.node Versions.V4_08.Open_infos.concrete -> a_ Compiler_types.open_infos + = fun ast_to_a { popen_expr; popen_override; popen_loc; popen_attributes } -> + let popen_expr = ast_to_a popen_expr in + let popen_override = ast_to_override_flag popen_override in + let popen_attributes = ast_to_attributes popen_attributes in + { popen_expr; popen_override; popen_loc; popen_attributes } + and ast_of_open_description - : Compiler_types.open_description -> Versions.V4_07.Open_description.t + : Compiler_types.open_description -> Versions.V4_08.Open_description.t = fun x -> - Versions.V4_07.Open_description.of_concrete (concrete_of_open_description x) + Versions.V4_08.Open_description.of_concrete (concrete_of_open_description x) and concrete_of_open_description - : Compiler_types.open_description -> Versions.V4_07.Open_description.concrete - = fun { popen_lid; popen_override; popen_loc; popen_attributes } -> - let popen_lid = ast_of_longident_loc popen_lid in - let popen_override = ast_of_override_flag popen_override in - let popen_attributes = ast_of_attributes popen_attributes in - { popen_lid; popen_override; popen_loc; popen_attributes } + : Compiler_types.open_description -> Versions.V4_08.Open_description.concrete + = fun x -> + (ast_of_open_infos ast_of_longident_loc) x and ast_to_open_description - : Versions.V4_07.Open_description.t -> Compiler_types.open_description + : Versions.V4_08.Open_description.t -> Compiler_types.open_description = fun x -> - let concrete = Versions.V4_07.Open_description.to_concrete x in + let concrete = Versions.V4_08.Open_description.to_concrete x in concrete_to_open_description concrete and concrete_to_open_description - : Versions.V4_07.Open_description.concrete -> Compiler_types.open_description - = fun { popen_lid; popen_override; popen_loc; popen_attributes } -> - let popen_lid = ast_to_longident_loc popen_lid in - let popen_override = ast_to_override_flag popen_override in - let popen_attributes = ast_to_attributes popen_attributes in - { popen_lid; popen_override; popen_loc; popen_attributes } + : Versions.V4_08.Open_description.concrete -> Compiler_types.open_description + = fun x -> + (ast_to_open_infos ast_to_longident_loc) x + +and ast_of_open_declaration + : Compiler_types.open_declaration -> Versions.V4_08.Open_declaration.t + = fun x -> + Versions.V4_08.Open_declaration.of_concrete (concrete_of_open_declaration x) + +and concrete_of_open_declaration + : Compiler_types.open_declaration -> Versions.V4_08.Open_declaration.concrete + = fun x -> + (ast_of_open_infos ast_of_module_expr) x + +and ast_to_open_declaration + : Versions.V4_08.Open_declaration.t -> Compiler_types.open_declaration + = fun x -> + let concrete = Versions.V4_08.Open_declaration.to_concrete x in + concrete_to_open_declaration concrete + +and concrete_to_open_declaration + : Versions.V4_08.Open_declaration.concrete -> Compiler_types.open_declaration + = fun x -> + (ast_to_open_infos ast_to_module_expr) x and ast_of_include_infos - : type a a_ .(a_ -> a Unversioned.Types.node) -> a_ Compiler_types.include_infos -> a Unversioned.Types.node Versions.V4_07.Include_infos.t + : type a a_ .(a_ -> a Unversioned.Types.node) -> a_ Compiler_types.include_infos -> a Unversioned.Types.node Versions.V4_08.Include_infos.t = fun ast_of_a x -> - Versions.V4_07.Include_infos.of_concrete (concrete_of_include_infos ast_of_a x) + Versions.V4_08.Include_infos.of_concrete (concrete_of_include_infos ast_of_a x) and concrete_of_include_infos - : type a a_ .(a_ -> a Unversioned.Types.node) -> a_ Compiler_types.include_infos -> a Unversioned.Types.node Versions.V4_07.Include_infos.concrete + : type a a_ .(a_ -> a Unversioned.Types.node) -> a_ Compiler_types.include_infos -> a Unversioned.Types.node Versions.V4_08.Include_infos.concrete = fun ast_of_a { pincl_mod; pincl_loc; pincl_attributes } -> let pincl_mod = ast_of_a pincl_mod in let pincl_attributes = ast_of_attributes pincl_attributes in { pincl_mod; pincl_loc; pincl_attributes } and ast_to_include_infos - : type a a_ .(a Unversioned.Types.node -> a_) -> a Unversioned.Types.node Versions.V4_07.Include_infos.t -> a_ Compiler_types.include_infos + : type a a_ .(a Unversioned.Types.node -> a_) -> a Unversioned.Types.node Versions.V4_08.Include_infos.t -> a_ Compiler_types.include_infos = fun ast_to_a x -> - let concrete = Versions.V4_07.Include_infos.to_concrete x in + let concrete = Versions.V4_08.Include_infos.to_concrete x in concrete_to_include_infos ast_to_a concrete and concrete_to_include_infos - : type a a_ .(a Unversioned.Types.node -> a_) -> a Unversioned.Types.node Versions.V4_07.Include_infos.concrete -> a_ Compiler_types.include_infos + : type a a_ .(a Unversioned.Types.node -> a_) -> a Unversioned.Types.node Versions.V4_08.Include_infos.concrete -> a_ Compiler_types.include_infos = fun ast_to_a { pincl_mod; pincl_loc; pincl_attributes } -> let pincl_mod = ast_to_a pincl_mod in let pincl_attributes = ast_to_attributes pincl_attributes in { pincl_mod; pincl_loc; pincl_attributes } and ast_of_include_description - : Compiler_types.include_description -> Versions.V4_07.Include_description.t + : Compiler_types.include_description -> Versions.V4_08.Include_description.t = fun x -> - Versions.V4_07.Include_description.of_concrete (concrete_of_include_description x) + Versions.V4_08.Include_description.of_concrete (concrete_of_include_description x) and concrete_of_include_description - : Compiler_types.include_description -> Versions.V4_07.Include_description.concrete + : Compiler_types.include_description -> Versions.V4_08.Include_description.concrete = fun x -> (ast_of_include_infos ast_of_module_type) x and ast_to_include_description - : Versions.V4_07.Include_description.t -> Compiler_types.include_description + : Versions.V4_08.Include_description.t -> Compiler_types.include_description = fun x -> - let concrete = Versions.V4_07.Include_description.to_concrete x in + let concrete = Versions.V4_08.Include_description.to_concrete x in concrete_to_include_description concrete and concrete_to_include_description - : Versions.V4_07.Include_description.concrete -> Compiler_types.include_description + : Versions.V4_08.Include_description.concrete -> Compiler_types.include_description = fun x -> (ast_to_include_infos ast_to_module_type) x and ast_of_include_declaration - : Compiler_types.include_declaration -> Versions.V4_07.Include_declaration.t + : Compiler_types.include_declaration -> Versions.V4_08.Include_declaration.t = fun x -> - Versions.V4_07.Include_declaration.of_concrete (concrete_of_include_declaration x) + Versions.V4_08.Include_declaration.of_concrete (concrete_of_include_declaration x) and concrete_of_include_declaration - : Compiler_types.include_declaration -> Versions.V4_07.Include_declaration.concrete + : Compiler_types.include_declaration -> Versions.V4_08.Include_declaration.concrete = fun x -> (ast_of_include_infos ast_of_module_expr) x and ast_to_include_declaration - : Versions.V4_07.Include_declaration.t -> Compiler_types.include_declaration + : Versions.V4_08.Include_declaration.t -> Compiler_types.include_declaration = fun x -> - let concrete = Versions.V4_07.Include_declaration.to_concrete x in + let concrete = Versions.V4_08.Include_declaration.to_concrete x in concrete_to_include_declaration concrete and concrete_to_include_declaration - : Versions.V4_07.Include_declaration.concrete -> Compiler_types.include_declaration + : Versions.V4_08.Include_declaration.concrete -> Compiler_types.include_declaration = fun x -> (ast_to_include_infos ast_to_module_expr) x and ast_of_with_constraint - : Compiler_types.with_constraint -> Versions.V4_07.With_constraint.t + : Compiler_types.with_constraint -> Versions.V4_08.With_constraint.t = fun x -> - Versions.V4_07.With_constraint.of_concrete (concrete_of_with_constraint x) + Versions.V4_08.With_constraint.of_concrete (concrete_of_with_constraint x) and concrete_of_with_constraint - : Compiler_types.with_constraint -> Versions.V4_07.With_constraint.concrete + : Compiler_types.with_constraint -> Versions.V4_08.With_constraint.concrete = fun x -> match (x : Compiler_types.with_constraint) with | Pwith_type (x1, x2) -> @@ -2389,15 +2593,15 @@ and concrete_of_with_constraint Pwith_modsubst (x1, x2) and ast_to_with_constraint - : Versions.V4_07.With_constraint.t -> Compiler_types.with_constraint + : Versions.V4_08.With_constraint.t -> Compiler_types.with_constraint = fun x -> - let concrete = Versions.V4_07.With_constraint.to_concrete x in + let concrete = Versions.V4_08.With_constraint.to_concrete x in concrete_to_with_constraint concrete and concrete_to_with_constraint - : Versions.V4_07.With_constraint.concrete -> Compiler_types.with_constraint + : Versions.V4_08.With_constraint.concrete -> Compiler_types.with_constraint = fun x -> - match (x : Versions.V4_07.With_constraint.concrete) with + match (x : Versions.V4_08.With_constraint.concrete) with | Pwith_type (x1, x2) -> let x1 = ast_to_longident_loc x1 in let x2 = ast_to_type_declaration x2 in @@ -2416,37 +2620,37 @@ and concrete_to_with_constraint Pwith_modsubst (x1, x2) and ast_of_module_expr - : Compiler_types.module_expr -> Versions.V4_07.Module_expr.t + : Compiler_types.module_expr -> Versions.V4_08.Module_expr.t = fun x -> - Versions.V4_07.Module_expr.of_concrete (concrete_of_module_expr x) + Versions.V4_08.Module_expr.of_concrete (concrete_of_module_expr x) and concrete_of_module_expr - : Compiler_types.module_expr -> Versions.V4_07.Module_expr.concrete + : Compiler_types.module_expr -> Versions.V4_08.Module_expr.concrete = fun { pmod_desc; pmod_loc; pmod_attributes } -> let pmod_desc = ast_of_module_expr_desc pmod_desc in let pmod_attributes = ast_of_attributes pmod_attributes in { pmod_desc; pmod_loc; pmod_attributes } and ast_to_module_expr - : Versions.V4_07.Module_expr.t -> Compiler_types.module_expr + : Versions.V4_08.Module_expr.t -> Compiler_types.module_expr = fun x -> - let concrete = Versions.V4_07.Module_expr.to_concrete x in + let concrete = Versions.V4_08.Module_expr.to_concrete x in concrete_to_module_expr concrete and concrete_to_module_expr - : Versions.V4_07.Module_expr.concrete -> Compiler_types.module_expr + : Versions.V4_08.Module_expr.concrete -> Compiler_types.module_expr = fun { pmod_desc; pmod_loc; pmod_attributes } -> let pmod_desc = ast_to_module_expr_desc pmod_desc in let pmod_attributes = ast_to_attributes pmod_attributes in { pmod_desc; pmod_loc; pmod_attributes } and ast_of_module_expr_desc - : Compiler_types.module_expr_desc -> Versions.V4_07.Module_expr_desc.t + : Compiler_types.module_expr_desc -> Versions.V4_08.Module_expr_desc.t = fun x -> - Versions.V4_07.Module_expr_desc.of_concrete (concrete_of_module_expr_desc x) + Versions.V4_08.Module_expr_desc.of_concrete (concrete_of_module_expr_desc x) and concrete_of_module_expr_desc - : Compiler_types.module_expr_desc -> Versions.V4_07.Module_expr_desc.concrete + : Compiler_types.module_expr_desc -> Versions.V4_08.Module_expr_desc.concrete = fun x -> match (x : Compiler_types.module_expr_desc) with | Pmod_ident (x1) -> @@ -2475,15 +2679,15 @@ and concrete_of_module_expr_desc Pmod_extension (x1) and ast_to_module_expr_desc - : Versions.V4_07.Module_expr_desc.t -> Compiler_types.module_expr_desc + : Versions.V4_08.Module_expr_desc.t -> Compiler_types.module_expr_desc = fun x -> - let concrete = Versions.V4_07.Module_expr_desc.to_concrete x in + let concrete = Versions.V4_08.Module_expr_desc.to_concrete x in concrete_to_module_expr_desc concrete and concrete_to_module_expr_desc - : Versions.V4_07.Module_expr_desc.concrete -> Compiler_types.module_expr_desc + : Versions.V4_08.Module_expr_desc.concrete -> Compiler_types.module_expr_desc = fun x -> - match (x : Versions.V4_07.Module_expr_desc.concrete) with + match (x : Versions.V4_08.Module_expr_desc.concrete) with | Pmod_ident (x1) -> let x1 = ast_to_longident_loc x1 in Pmod_ident (x1) @@ -2510,56 +2714,56 @@ and concrete_to_module_expr_desc Pmod_extension (x1) and ast_of_structure - : Compiler_types.structure -> Versions.V4_07.Structure.t + : Compiler_types.structure -> Versions.V4_08.Structure.t = fun x -> - Versions.V4_07.Structure.of_concrete (concrete_of_structure x) + Versions.V4_08.Structure.of_concrete (concrete_of_structure x) and concrete_of_structure - : Compiler_types.structure -> Versions.V4_07.Structure.concrete + : Compiler_types.structure -> Versions.V4_08.Structure.concrete = fun x -> (List.map ~f:ast_of_structure_item) x and ast_to_structure - : Versions.V4_07.Structure.t -> Compiler_types.structure + : Versions.V4_08.Structure.t -> Compiler_types.structure = fun x -> - let concrete = Versions.V4_07.Structure.to_concrete x in + let concrete = Versions.V4_08.Structure.to_concrete x in concrete_to_structure concrete and concrete_to_structure - : Versions.V4_07.Structure.concrete -> Compiler_types.structure + : Versions.V4_08.Structure.concrete -> Compiler_types.structure = fun x -> (List.map ~f:ast_to_structure_item) x and ast_of_structure_item - : Compiler_types.structure_item -> Versions.V4_07.Structure_item.t + : Compiler_types.structure_item -> Versions.V4_08.Structure_item.t = fun x -> - Versions.V4_07.Structure_item.of_concrete (concrete_of_structure_item x) + Versions.V4_08.Structure_item.of_concrete (concrete_of_structure_item x) and concrete_of_structure_item - : Compiler_types.structure_item -> Versions.V4_07.Structure_item.concrete + : Compiler_types.structure_item -> Versions.V4_08.Structure_item.concrete = fun { pstr_desc; pstr_loc } -> let pstr_desc = ast_of_structure_item_desc pstr_desc in { pstr_desc; pstr_loc } and ast_to_structure_item - : Versions.V4_07.Structure_item.t -> Compiler_types.structure_item + : Versions.V4_08.Structure_item.t -> Compiler_types.structure_item = fun x -> - let concrete = Versions.V4_07.Structure_item.to_concrete x in + let concrete = Versions.V4_08.Structure_item.to_concrete x in concrete_to_structure_item concrete and concrete_to_structure_item - : Versions.V4_07.Structure_item.concrete -> Compiler_types.structure_item + : Versions.V4_08.Structure_item.concrete -> Compiler_types.structure_item = fun { pstr_desc; pstr_loc } -> let pstr_desc = ast_to_structure_item_desc pstr_desc in { pstr_desc; pstr_loc } and ast_of_structure_item_desc - : Compiler_types.structure_item_desc -> Versions.V4_07.Structure_item_desc.t + : Compiler_types.structure_item_desc -> Versions.V4_08.Structure_item_desc.t = fun x -> - Versions.V4_07.Structure_item_desc.of_concrete (concrete_of_structure_item_desc x) + Versions.V4_08.Structure_item_desc.of_concrete (concrete_of_structure_item_desc x) and concrete_of_structure_item_desc - : Compiler_types.structure_item_desc -> Versions.V4_07.Structure_item_desc.concrete + : Compiler_types.structure_item_desc -> Versions.V4_08.Structure_item_desc.concrete = fun x -> match (x : Compiler_types.structure_item_desc) with | Pstr_eval (x1, x2) -> @@ -2581,7 +2785,7 @@ and concrete_of_structure_item_desc let x1 = ast_of_type_extension x1 in Pstr_typext (x1) | Pstr_exception (x1) -> - let x1 = ast_of_extension_constructor x1 in + let x1 = ast_of_type_exception x1 in Pstr_exception (x1) | Pstr_module (x1) -> let x1 = ast_of_module_binding x1 in @@ -2593,7 +2797,7 @@ and concrete_of_structure_item_desc let x1 = ast_of_module_type_declaration x1 in Pstr_modtype (x1) | Pstr_open (x1) -> - let x1 = ast_of_open_description x1 in + let x1 = ast_of_open_declaration x1 in Pstr_open (x1) | Pstr_class (x1) -> let x1 = (List.map ~f:ast_of_class_declaration) x1 in @@ -2613,15 +2817,15 @@ and concrete_of_structure_item_desc Pstr_extension (x1, x2) and ast_to_structure_item_desc - : Versions.V4_07.Structure_item_desc.t -> Compiler_types.structure_item_desc + : Versions.V4_08.Structure_item_desc.t -> Compiler_types.structure_item_desc = fun x -> - let concrete = Versions.V4_07.Structure_item_desc.to_concrete x in + let concrete = Versions.V4_08.Structure_item_desc.to_concrete x in concrete_to_structure_item_desc concrete and concrete_to_structure_item_desc - : Versions.V4_07.Structure_item_desc.concrete -> Compiler_types.structure_item_desc + : Versions.V4_08.Structure_item_desc.concrete -> Compiler_types.structure_item_desc = fun x -> - match (x : Versions.V4_07.Structure_item_desc.concrete) with + match (x : Versions.V4_08.Structure_item_desc.concrete) with | Pstr_eval (x1, x2) -> let x1 = ast_to_expression x1 in let x2 = ast_to_attributes x2 in @@ -2641,7 +2845,7 @@ and concrete_to_structure_item_desc let x1 = ast_to_type_extension x1 in Pstr_typext (x1) | Pstr_exception (x1) -> - let x1 = ast_to_extension_constructor x1 in + let x1 = ast_to_type_exception x1 in Pstr_exception (x1) | Pstr_module (x1) -> let x1 = ast_to_module_binding x1 in @@ -2653,7 +2857,7 @@ and concrete_to_structure_item_desc let x1 = ast_to_module_type_declaration x1 in Pstr_modtype (x1) | Pstr_open (x1) -> - let x1 = ast_to_open_description x1 in + let x1 = ast_to_open_declaration x1 in Pstr_open (x1) | Pstr_class (x1) -> let x1 = (List.map ~f:ast_to_class_declaration) x1 in @@ -2673,12 +2877,12 @@ and concrete_to_structure_item_desc Pstr_extension (x1, x2) and ast_of_value_binding - : Compiler_types.value_binding -> Versions.V4_07.Value_binding.t + : Compiler_types.value_binding -> Versions.V4_08.Value_binding.t = fun x -> - Versions.V4_07.Value_binding.of_concrete (concrete_of_value_binding x) + Versions.V4_08.Value_binding.of_concrete (concrete_of_value_binding x) and concrete_of_value_binding - : Compiler_types.value_binding -> Versions.V4_07.Value_binding.concrete + : Compiler_types.value_binding -> Versions.V4_08.Value_binding.concrete = fun { pvb_pat; pvb_expr; pvb_attributes; pvb_loc } -> let pvb_pat = ast_of_pattern pvb_pat in let pvb_expr = ast_of_expression pvb_expr in @@ -2686,13 +2890,13 @@ and concrete_of_value_binding { pvb_pat; pvb_expr; pvb_attributes; pvb_loc } and ast_to_value_binding - : Versions.V4_07.Value_binding.t -> Compiler_types.value_binding + : Versions.V4_08.Value_binding.t -> Compiler_types.value_binding = fun x -> - let concrete = Versions.V4_07.Value_binding.to_concrete x in + let concrete = Versions.V4_08.Value_binding.to_concrete x in concrete_to_value_binding concrete and concrete_to_value_binding - : Versions.V4_07.Value_binding.concrete -> Compiler_types.value_binding + : Versions.V4_08.Value_binding.concrete -> Compiler_types.value_binding = fun { pvb_pat; pvb_expr; pvb_attributes; pvb_loc } -> let pvb_pat = ast_to_pattern pvb_pat in let pvb_expr = ast_to_expression pvb_expr in @@ -2700,73 +2904,118 @@ and concrete_to_value_binding { pvb_pat; pvb_expr; pvb_attributes; pvb_loc } and ast_of_module_binding - : Compiler_types.module_binding -> Versions.V4_07.Module_binding.t + : Compiler_types.module_binding -> Versions.V4_08.Module_binding.t = fun x -> - Versions.V4_07.Module_binding.of_concrete (concrete_of_module_binding x) + Versions.V4_08.Module_binding.of_concrete (concrete_of_module_binding x) and concrete_of_module_binding - : Compiler_types.module_binding -> Versions.V4_07.Module_binding.concrete + : Compiler_types.module_binding -> Versions.V4_08.Module_binding.concrete = fun { pmb_name; pmb_expr; pmb_attributes; pmb_loc } -> let pmb_expr = ast_of_module_expr pmb_expr in let pmb_attributes = ast_of_attributes pmb_attributes in { pmb_name; pmb_expr; pmb_attributes; pmb_loc } and ast_to_module_binding - : Versions.V4_07.Module_binding.t -> Compiler_types.module_binding + : Versions.V4_08.Module_binding.t -> Compiler_types.module_binding = fun x -> - let concrete = Versions.V4_07.Module_binding.to_concrete x in + let concrete = Versions.V4_08.Module_binding.to_concrete x in concrete_to_module_binding concrete and concrete_to_module_binding - : Versions.V4_07.Module_binding.concrete -> Compiler_types.module_binding + : Versions.V4_08.Module_binding.concrete -> Compiler_types.module_binding = fun { pmb_name; pmb_expr; pmb_attributes; pmb_loc } -> let pmb_expr = ast_to_module_expr pmb_expr in let pmb_attributes = ast_to_attributes pmb_attributes in { pmb_name; pmb_expr; pmb_attributes; pmb_loc } and ast_of_toplevel_phrase - : Compiler_types.toplevel_phrase -> Versions.V4_07.Toplevel_phrase.t + : Compiler_types.toplevel_phrase -> Versions.V4_08.Toplevel_phrase.t = fun x -> - Versions.V4_07.Toplevel_phrase.of_concrete (concrete_of_toplevel_phrase x) + Versions.V4_08.Toplevel_phrase.of_concrete (concrete_of_toplevel_phrase x) and concrete_of_toplevel_phrase - : Compiler_types.toplevel_phrase -> Versions.V4_07.Toplevel_phrase.concrete + : Compiler_types.toplevel_phrase -> Versions.V4_08.Toplevel_phrase.concrete = fun x -> match (x : Compiler_types.toplevel_phrase) with | Ptop_def (x1) -> let x1 = ast_of_structure x1 in Ptop_def (x1) - | Ptop_dir (x1, x2) -> - let x2 = ast_of_directive_argument x2 in - Ptop_dir (x1, x2) + | Ptop_dir (x1) -> + let x1 = ast_of_toplevel_directive x1 in + Ptop_dir (x1) and ast_to_toplevel_phrase - : Versions.V4_07.Toplevel_phrase.t -> Compiler_types.toplevel_phrase + : Versions.V4_08.Toplevel_phrase.t -> Compiler_types.toplevel_phrase = fun x -> - let concrete = Versions.V4_07.Toplevel_phrase.to_concrete x in + let concrete = Versions.V4_08.Toplevel_phrase.to_concrete x in concrete_to_toplevel_phrase concrete and concrete_to_toplevel_phrase - : Versions.V4_07.Toplevel_phrase.concrete -> Compiler_types.toplevel_phrase + : Versions.V4_08.Toplevel_phrase.concrete -> Compiler_types.toplevel_phrase = fun x -> - match (x : Versions.V4_07.Toplevel_phrase.concrete) with + match (x : Versions.V4_08.Toplevel_phrase.concrete) with | Ptop_def (x1) -> let x1 = ast_to_structure x1 in Ptop_def (x1) - | Ptop_dir (x1, x2) -> - let x2 = ast_to_directive_argument x2 in - Ptop_dir (x1, x2) + | Ptop_dir (x1) -> + let x1 = ast_to_toplevel_directive x1 in + Ptop_dir (x1) + +and ast_of_toplevel_directive + : Compiler_types.toplevel_directive -> Versions.V4_08.Toplevel_directive.t + = fun x -> + Versions.V4_08.Toplevel_directive.of_concrete (concrete_of_toplevel_directive x) + +and concrete_of_toplevel_directive + : Compiler_types.toplevel_directive -> Versions.V4_08.Toplevel_directive.concrete + = fun { pdir_name; pdir_arg; pdir_loc } -> + let pdir_arg = (Option.map ~f:ast_of_directive_argument) pdir_arg in + { pdir_name; pdir_arg; pdir_loc } + +and ast_to_toplevel_directive + : Versions.V4_08.Toplevel_directive.t -> Compiler_types.toplevel_directive + = fun x -> + let concrete = Versions.V4_08.Toplevel_directive.to_concrete x in + concrete_to_toplevel_directive concrete + +and concrete_to_toplevel_directive + : Versions.V4_08.Toplevel_directive.concrete -> Compiler_types.toplevel_directive + = fun { pdir_name; pdir_arg; pdir_loc } -> + let pdir_arg = (Option.map ~f:ast_to_directive_argument) pdir_arg in + { pdir_name; pdir_arg; pdir_loc } and ast_of_directive_argument - : Compiler_types.directive_argument -> Versions.V4_07.Directive_argument.t + : Compiler_types.directive_argument -> Versions.V4_08.Directive_argument.t = fun x -> - Versions.V4_07.Directive_argument.of_concrete (concrete_of_directive_argument x) + Versions.V4_08.Directive_argument.of_concrete (concrete_of_directive_argument x) and concrete_of_directive_argument - : Compiler_types.directive_argument -> Versions.V4_07.Directive_argument.concrete + : Compiler_types.directive_argument -> Versions.V4_08.Directive_argument.concrete + = fun { pdira_desc; pdira_loc } -> + let pdira_desc = ast_of_directive_argument_desc pdira_desc in + { pdira_desc; pdira_loc } + +and ast_to_directive_argument + : Versions.V4_08.Directive_argument.t -> Compiler_types.directive_argument = fun x -> - match (x : Compiler_types.directive_argument) with - | Pdir_none -> Pdir_none + let concrete = Versions.V4_08.Directive_argument.to_concrete x in + concrete_to_directive_argument concrete + +and concrete_to_directive_argument + : Versions.V4_08.Directive_argument.concrete -> Compiler_types.directive_argument + = fun { pdira_desc; pdira_loc } -> + let pdira_desc = ast_to_directive_argument_desc pdira_desc in + { pdira_desc; pdira_loc } + +and ast_of_directive_argument_desc + : Compiler_types.directive_argument_desc -> Versions.V4_08.Directive_argument_desc.t + = fun x -> + Versions.V4_08.Directive_argument_desc.of_concrete (concrete_of_directive_argument_desc x) + +and concrete_of_directive_argument_desc + : Compiler_types.directive_argument_desc -> Versions.V4_08.Directive_argument_desc.concrete + = fun x -> + match (x : Compiler_types.directive_argument_desc) with | Pdir_string (x1) -> Pdir_string (x1) | Pdir_int (x1, x2) -> @@ -2777,17 +3026,16 @@ and concrete_of_directive_argument | Pdir_bool (x1) -> Pdir_bool (x1) -and ast_to_directive_argument - : Versions.V4_07.Directive_argument.t -> Compiler_types.directive_argument +and ast_to_directive_argument_desc + : Versions.V4_08.Directive_argument_desc.t -> Compiler_types.directive_argument_desc = fun x -> - let concrete = Versions.V4_07.Directive_argument.to_concrete x in - concrete_to_directive_argument concrete + let concrete = Versions.V4_08.Directive_argument_desc.to_concrete x in + concrete_to_directive_argument_desc concrete -and concrete_to_directive_argument - : Versions.V4_07.Directive_argument.concrete -> Compiler_types.directive_argument +and concrete_to_directive_argument_desc + : Versions.V4_08.Directive_argument_desc.concrete -> Compiler_types.directive_argument_desc = fun x -> - match (x : Versions.V4_07.Directive_argument.concrete) with - | Pdir_none -> Pdir_none + match (x : Versions.V4_08.Directive_argument_desc.concrete) with | Pdir_string (x1) -> Pdir_string (x1) | Pdir_int (x1, x2) -> diff --git a/ast/conversion.mli b/ast/conversion.mli index 1f358281..5bcb438b 100644 --- a/ast/conversion.mli +++ b/ast/conversion.mli @@ -1,573 +1,655 @@ (*$ Ppx_ast_cinaps.print_conversion_mli () *) val ast_of_longident : Compiler_types.longident - -> Versions.V4_07.Longident.t + -> Versions.V4_08.Longident.t val ast_to_longident : - Versions.V4_07.Longident.t + Versions.V4_08.Longident.t -> Compiler_types.longident val ast_of_longident_loc : Compiler_types.longident_loc - -> Versions.V4_07.Longident_loc.t + -> Versions.V4_08.Longident_loc.t val ast_to_longident_loc : - Versions.V4_07.Longident_loc.t + Versions.V4_08.Longident_loc.t -> Compiler_types.longident_loc val ast_of_rec_flag : Compiler_types.rec_flag - -> Versions.V4_07.Rec_flag.t + -> Versions.V4_08.Rec_flag.t val ast_to_rec_flag : - Versions.V4_07.Rec_flag.t + Versions.V4_08.Rec_flag.t -> Compiler_types.rec_flag val ast_of_direction_flag : Compiler_types.direction_flag - -> Versions.V4_07.Direction_flag.t + -> Versions.V4_08.Direction_flag.t val ast_to_direction_flag : - Versions.V4_07.Direction_flag.t + Versions.V4_08.Direction_flag.t -> Compiler_types.direction_flag val ast_of_private_flag : Compiler_types.private_flag - -> Versions.V4_07.Private_flag.t + -> Versions.V4_08.Private_flag.t val ast_to_private_flag : - Versions.V4_07.Private_flag.t + Versions.V4_08.Private_flag.t -> Compiler_types.private_flag val ast_of_mutable_flag : Compiler_types.mutable_flag - -> Versions.V4_07.Mutable_flag.t + -> Versions.V4_08.Mutable_flag.t val ast_to_mutable_flag : - Versions.V4_07.Mutable_flag.t + Versions.V4_08.Mutable_flag.t -> Compiler_types.mutable_flag val ast_of_virtual_flag : Compiler_types.virtual_flag - -> Versions.V4_07.Virtual_flag.t + -> Versions.V4_08.Virtual_flag.t val ast_to_virtual_flag : - Versions.V4_07.Virtual_flag.t + Versions.V4_08.Virtual_flag.t -> Compiler_types.virtual_flag val ast_of_override_flag : Compiler_types.override_flag - -> Versions.V4_07.Override_flag.t + -> Versions.V4_08.Override_flag.t val ast_to_override_flag : - Versions.V4_07.Override_flag.t + Versions.V4_08.Override_flag.t -> Compiler_types.override_flag val ast_of_closed_flag : Compiler_types.closed_flag - -> Versions.V4_07.Closed_flag.t + -> Versions.V4_08.Closed_flag.t val ast_to_closed_flag : - Versions.V4_07.Closed_flag.t + Versions.V4_08.Closed_flag.t -> Compiler_types.closed_flag val ast_of_arg_label : Compiler_types.arg_label - -> Versions.V4_07.Arg_label.t + -> Versions.V4_08.Arg_label.t val ast_to_arg_label : - Versions.V4_07.Arg_label.t + Versions.V4_08.Arg_label.t -> Compiler_types.arg_label val ast_of_variance : Compiler_types.variance - -> Versions.V4_07.Variance.t + -> Versions.V4_08.Variance.t val ast_to_variance : - Versions.V4_07.Variance.t + Versions.V4_08.Variance.t -> Compiler_types.variance val ast_of_constant : Compiler_types.constant - -> Versions.V4_07.Constant.t + -> Versions.V4_08.Constant.t val ast_to_constant : - Versions.V4_07.Constant.t + Versions.V4_08.Constant.t -> Compiler_types.constant val ast_of_attribute : Compiler_types.attribute - -> Versions.V4_07.Attribute.t + -> Versions.V4_08.Attribute.t val ast_to_attribute : - Versions.V4_07.Attribute.t + Versions.V4_08.Attribute.t -> Compiler_types.attribute val ast_of_extension : Compiler_types.extension - -> Versions.V4_07.Extension.t + -> Versions.V4_08.Extension.t val ast_to_extension : - Versions.V4_07.Extension.t + Versions.V4_08.Extension.t -> Compiler_types.extension val ast_of_attributes : Compiler_types.attributes - -> Versions.V4_07.Attributes.t + -> Versions.V4_08.Attributes.t val ast_to_attributes : - Versions.V4_07.Attributes.t + Versions.V4_08.Attributes.t -> Compiler_types.attributes val ast_of_payload : Compiler_types.payload - -> Versions.V4_07.Payload.t + -> Versions.V4_08.Payload.t val ast_to_payload : - Versions.V4_07.Payload.t + Versions.V4_08.Payload.t -> Compiler_types.payload val ast_of_core_type : Compiler_types.core_type - -> Versions.V4_07.Core_type.t + -> Versions.V4_08.Core_type.t val ast_to_core_type : - Versions.V4_07.Core_type.t + Versions.V4_08.Core_type.t -> Compiler_types.core_type val ast_of_core_type_desc : Compiler_types.core_type_desc - -> Versions.V4_07.Core_type_desc.t + -> Versions.V4_08.Core_type_desc.t val ast_to_core_type_desc : - Versions.V4_07.Core_type_desc.t + Versions.V4_08.Core_type_desc.t -> Compiler_types.core_type_desc val ast_of_package_type : Compiler_types.package_type - -> Versions.V4_07.Package_type.t + -> Versions.V4_08.Package_type.t val ast_to_package_type : - Versions.V4_07.Package_type.t + Versions.V4_08.Package_type.t -> Compiler_types.package_type val ast_of_row_field : Compiler_types.row_field - -> Versions.V4_07.Row_field.t + -> Versions.V4_08.Row_field.t val ast_to_row_field : - Versions.V4_07.Row_field.t + Versions.V4_08.Row_field.t -> Compiler_types.row_field +val ast_of_row_field_desc : + Compiler_types.row_field_desc + -> Versions.V4_08.Row_field_desc.t + +val ast_to_row_field_desc : + Versions.V4_08.Row_field_desc.t + -> Compiler_types.row_field_desc + val ast_of_object_field : Compiler_types.object_field - -> Versions.V4_07.Object_field.t + -> Versions.V4_08.Object_field.t val ast_to_object_field : - Versions.V4_07.Object_field.t + Versions.V4_08.Object_field.t -> Compiler_types.object_field +val ast_of_object_field_desc : + Compiler_types.object_field_desc + -> Versions.V4_08.Object_field_desc.t + +val ast_to_object_field_desc : + Versions.V4_08.Object_field_desc.t + -> Compiler_types.object_field_desc + val ast_of_pattern : Compiler_types.pattern - -> Versions.V4_07.Pattern.t + -> Versions.V4_08.Pattern.t val ast_to_pattern : - Versions.V4_07.Pattern.t + Versions.V4_08.Pattern.t -> Compiler_types.pattern val ast_of_pattern_desc : Compiler_types.pattern_desc - -> Versions.V4_07.Pattern_desc.t + -> Versions.V4_08.Pattern_desc.t val ast_to_pattern_desc : - Versions.V4_07.Pattern_desc.t + Versions.V4_08.Pattern_desc.t -> Compiler_types.pattern_desc val ast_of_expression : Compiler_types.expression - -> Versions.V4_07.Expression.t + -> Versions.V4_08.Expression.t val ast_to_expression : - Versions.V4_07.Expression.t + Versions.V4_08.Expression.t -> Compiler_types.expression val ast_of_expression_desc : Compiler_types.expression_desc - -> Versions.V4_07.Expression_desc.t + -> Versions.V4_08.Expression_desc.t val ast_to_expression_desc : - Versions.V4_07.Expression_desc.t + Versions.V4_08.Expression_desc.t -> Compiler_types.expression_desc val ast_of_case : Compiler_types.case - -> Versions.V4_07.Case.t + -> Versions.V4_08.Case.t val ast_to_case : - Versions.V4_07.Case.t + Versions.V4_08.Case.t -> Compiler_types.case +val ast_of_letop : + Compiler_types.letop + -> Versions.V4_08.Letop.t + +val ast_to_letop : + Versions.V4_08.Letop.t + -> Compiler_types.letop + +val ast_of_binding_op : + Compiler_types.binding_op + -> Versions.V4_08.Binding_op.t + +val ast_to_binding_op : + Versions.V4_08.Binding_op.t + -> Compiler_types.binding_op + val ast_of_value_description : Compiler_types.value_description - -> Versions.V4_07.Value_description.t + -> Versions.V4_08.Value_description.t val ast_to_value_description : - Versions.V4_07.Value_description.t + Versions.V4_08.Value_description.t -> Compiler_types.value_description val ast_of_type_declaration : Compiler_types.type_declaration - -> Versions.V4_07.Type_declaration.t + -> Versions.V4_08.Type_declaration.t val ast_to_type_declaration : - Versions.V4_07.Type_declaration.t + Versions.V4_08.Type_declaration.t -> Compiler_types.type_declaration val ast_of_type_kind : Compiler_types.type_kind - -> Versions.V4_07.Type_kind.t + -> Versions.V4_08.Type_kind.t val ast_to_type_kind : - Versions.V4_07.Type_kind.t + Versions.V4_08.Type_kind.t -> Compiler_types.type_kind val ast_of_label_declaration : Compiler_types.label_declaration - -> Versions.V4_07.Label_declaration.t + -> Versions.V4_08.Label_declaration.t val ast_to_label_declaration : - Versions.V4_07.Label_declaration.t + Versions.V4_08.Label_declaration.t -> Compiler_types.label_declaration val ast_of_constructor_declaration : Compiler_types.constructor_declaration - -> Versions.V4_07.Constructor_declaration.t + -> Versions.V4_08.Constructor_declaration.t val ast_to_constructor_declaration : - Versions.V4_07.Constructor_declaration.t + Versions.V4_08.Constructor_declaration.t -> Compiler_types.constructor_declaration val ast_of_constructor_arguments : Compiler_types.constructor_arguments - -> Versions.V4_07.Constructor_arguments.t + -> Versions.V4_08.Constructor_arguments.t val ast_to_constructor_arguments : - Versions.V4_07.Constructor_arguments.t + Versions.V4_08.Constructor_arguments.t -> Compiler_types.constructor_arguments val ast_of_type_extension : Compiler_types.type_extension - -> Versions.V4_07.Type_extension.t + -> Versions.V4_08.Type_extension.t val ast_to_type_extension : - Versions.V4_07.Type_extension.t + Versions.V4_08.Type_extension.t -> Compiler_types.type_extension val ast_of_extension_constructor : Compiler_types.extension_constructor - -> Versions.V4_07.Extension_constructor.t + -> Versions.V4_08.Extension_constructor.t val ast_to_extension_constructor : - Versions.V4_07.Extension_constructor.t + Versions.V4_08.Extension_constructor.t -> Compiler_types.extension_constructor +val ast_of_type_exception : + Compiler_types.type_exception + -> Versions.V4_08.Type_exception.t + +val ast_to_type_exception : + Versions.V4_08.Type_exception.t + -> Compiler_types.type_exception + val ast_of_extension_constructor_kind : Compiler_types.extension_constructor_kind - -> Versions.V4_07.Extension_constructor_kind.t + -> Versions.V4_08.Extension_constructor_kind.t val ast_to_extension_constructor_kind : - Versions.V4_07.Extension_constructor_kind.t + Versions.V4_08.Extension_constructor_kind.t -> Compiler_types.extension_constructor_kind val ast_of_class_type : Compiler_types.class_type - -> Versions.V4_07.Class_type.t + -> Versions.V4_08.Class_type.t val ast_to_class_type : - Versions.V4_07.Class_type.t + Versions.V4_08.Class_type.t -> Compiler_types.class_type val ast_of_class_type_desc : Compiler_types.class_type_desc - -> Versions.V4_07.Class_type_desc.t + -> Versions.V4_08.Class_type_desc.t val ast_to_class_type_desc : - Versions.V4_07.Class_type_desc.t + Versions.V4_08.Class_type_desc.t -> Compiler_types.class_type_desc val ast_of_class_signature : Compiler_types.class_signature - -> Versions.V4_07.Class_signature.t + -> Versions.V4_08.Class_signature.t val ast_to_class_signature : - Versions.V4_07.Class_signature.t + Versions.V4_08.Class_signature.t -> Compiler_types.class_signature val ast_of_class_type_field : Compiler_types.class_type_field - -> Versions.V4_07.Class_type_field.t + -> Versions.V4_08.Class_type_field.t val ast_to_class_type_field : - Versions.V4_07.Class_type_field.t + Versions.V4_08.Class_type_field.t -> Compiler_types.class_type_field val ast_of_class_type_field_desc : Compiler_types.class_type_field_desc - -> Versions.V4_07.Class_type_field_desc.t + -> Versions.V4_08.Class_type_field_desc.t val ast_to_class_type_field_desc : - Versions.V4_07.Class_type_field_desc.t + Versions.V4_08.Class_type_field_desc.t -> Compiler_types.class_type_field_desc val ast_of_class_infos : ('a_ -> 'a Unversioned.Types.node) -> 'a_ Compiler_types.class_infos - -> 'a Unversioned.Types.node Versions.V4_07.Class_infos.t + -> 'a Unversioned.Types.node Versions.V4_08.Class_infos.t val ast_to_class_infos : ('a Unversioned.Types.node -> 'a_) - -> 'a Unversioned.Types.node Versions.V4_07.Class_infos.t + -> 'a Unversioned.Types.node Versions.V4_08.Class_infos.t -> 'a_ Compiler_types.class_infos val ast_of_class_description : Compiler_types.class_description - -> Versions.V4_07.Class_description.t + -> Versions.V4_08.Class_description.t val ast_to_class_description : - Versions.V4_07.Class_description.t + Versions.V4_08.Class_description.t -> Compiler_types.class_description val ast_of_class_type_declaration : Compiler_types.class_type_declaration - -> Versions.V4_07.Class_type_declaration.t + -> Versions.V4_08.Class_type_declaration.t val ast_to_class_type_declaration : - Versions.V4_07.Class_type_declaration.t + Versions.V4_08.Class_type_declaration.t -> Compiler_types.class_type_declaration val ast_of_class_expr : Compiler_types.class_expr - -> Versions.V4_07.Class_expr.t + -> Versions.V4_08.Class_expr.t val ast_to_class_expr : - Versions.V4_07.Class_expr.t + Versions.V4_08.Class_expr.t -> Compiler_types.class_expr val ast_of_class_expr_desc : Compiler_types.class_expr_desc - -> Versions.V4_07.Class_expr_desc.t + -> Versions.V4_08.Class_expr_desc.t val ast_to_class_expr_desc : - Versions.V4_07.Class_expr_desc.t + Versions.V4_08.Class_expr_desc.t -> Compiler_types.class_expr_desc val ast_of_class_structure : Compiler_types.class_structure - -> Versions.V4_07.Class_structure.t + -> Versions.V4_08.Class_structure.t val ast_to_class_structure : - Versions.V4_07.Class_structure.t + Versions.V4_08.Class_structure.t -> Compiler_types.class_structure val ast_of_class_field : Compiler_types.class_field - -> Versions.V4_07.Class_field.t + -> Versions.V4_08.Class_field.t val ast_to_class_field : - Versions.V4_07.Class_field.t + Versions.V4_08.Class_field.t -> Compiler_types.class_field val ast_of_class_field_desc : Compiler_types.class_field_desc - -> Versions.V4_07.Class_field_desc.t + -> Versions.V4_08.Class_field_desc.t val ast_to_class_field_desc : - Versions.V4_07.Class_field_desc.t + Versions.V4_08.Class_field_desc.t -> Compiler_types.class_field_desc val ast_of_class_field_kind : Compiler_types.class_field_kind - -> Versions.V4_07.Class_field_kind.t + -> Versions.V4_08.Class_field_kind.t val ast_to_class_field_kind : - Versions.V4_07.Class_field_kind.t + Versions.V4_08.Class_field_kind.t -> Compiler_types.class_field_kind val ast_of_class_declaration : Compiler_types.class_declaration - -> Versions.V4_07.Class_declaration.t + -> Versions.V4_08.Class_declaration.t val ast_to_class_declaration : - Versions.V4_07.Class_declaration.t + Versions.V4_08.Class_declaration.t -> Compiler_types.class_declaration val ast_of_module_type : Compiler_types.module_type - -> Versions.V4_07.Module_type.t + -> Versions.V4_08.Module_type.t val ast_to_module_type : - Versions.V4_07.Module_type.t + Versions.V4_08.Module_type.t -> Compiler_types.module_type val ast_of_module_type_desc : Compiler_types.module_type_desc - -> Versions.V4_07.Module_type_desc.t + -> Versions.V4_08.Module_type_desc.t val ast_to_module_type_desc : - Versions.V4_07.Module_type_desc.t + Versions.V4_08.Module_type_desc.t -> Compiler_types.module_type_desc val ast_of_signature : Compiler_types.signature - -> Versions.V4_07.Signature.t + -> Versions.V4_08.Signature.t val ast_to_signature : - Versions.V4_07.Signature.t + Versions.V4_08.Signature.t -> Compiler_types.signature val ast_of_signature_item : Compiler_types.signature_item - -> Versions.V4_07.Signature_item.t + -> Versions.V4_08.Signature_item.t val ast_to_signature_item : - Versions.V4_07.Signature_item.t + Versions.V4_08.Signature_item.t -> Compiler_types.signature_item val ast_of_signature_item_desc : Compiler_types.signature_item_desc - -> Versions.V4_07.Signature_item_desc.t + -> Versions.V4_08.Signature_item_desc.t val ast_to_signature_item_desc : - Versions.V4_07.Signature_item_desc.t + Versions.V4_08.Signature_item_desc.t -> Compiler_types.signature_item_desc val ast_of_module_declaration : Compiler_types.module_declaration - -> Versions.V4_07.Module_declaration.t + -> Versions.V4_08.Module_declaration.t val ast_to_module_declaration : - Versions.V4_07.Module_declaration.t + Versions.V4_08.Module_declaration.t -> Compiler_types.module_declaration +val ast_of_module_substitution : + Compiler_types.module_substitution + -> Versions.V4_08.Module_substitution.t + +val ast_to_module_substitution : + Versions.V4_08.Module_substitution.t + -> Compiler_types.module_substitution + val ast_of_module_type_declaration : Compiler_types.module_type_declaration - -> Versions.V4_07.Module_type_declaration.t + -> Versions.V4_08.Module_type_declaration.t val ast_to_module_type_declaration : - Versions.V4_07.Module_type_declaration.t + Versions.V4_08.Module_type_declaration.t -> Compiler_types.module_type_declaration +val ast_of_open_infos : + ('a_ -> 'a Unversioned.Types.node) + -> 'a_ Compiler_types.open_infos + -> 'a Unversioned.Types.node Versions.V4_08.Open_infos.t + +val ast_to_open_infos : + ('a Unversioned.Types.node -> 'a_) + -> 'a Unversioned.Types.node Versions.V4_08.Open_infos.t + -> 'a_ Compiler_types.open_infos + val ast_of_open_description : Compiler_types.open_description - -> Versions.V4_07.Open_description.t + -> Versions.V4_08.Open_description.t val ast_to_open_description : - Versions.V4_07.Open_description.t + Versions.V4_08.Open_description.t -> Compiler_types.open_description +val ast_of_open_declaration : + Compiler_types.open_declaration + -> Versions.V4_08.Open_declaration.t + +val ast_to_open_declaration : + Versions.V4_08.Open_declaration.t + -> Compiler_types.open_declaration + val ast_of_include_infos : ('a_ -> 'a Unversioned.Types.node) -> 'a_ Compiler_types.include_infos - -> 'a Unversioned.Types.node Versions.V4_07.Include_infos.t + -> 'a Unversioned.Types.node Versions.V4_08.Include_infos.t val ast_to_include_infos : ('a Unversioned.Types.node -> 'a_) - -> 'a Unversioned.Types.node Versions.V4_07.Include_infos.t + -> 'a Unversioned.Types.node Versions.V4_08.Include_infos.t -> 'a_ Compiler_types.include_infos val ast_of_include_description : Compiler_types.include_description - -> Versions.V4_07.Include_description.t + -> Versions.V4_08.Include_description.t val ast_to_include_description : - Versions.V4_07.Include_description.t + Versions.V4_08.Include_description.t -> Compiler_types.include_description val ast_of_include_declaration : Compiler_types.include_declaration - -> Versions.V4_07.Include_declaration.t + -> Versions.V4_08.Include_declaration.t val ast_to_include_declaration : - Versions.V4_07.Include_declaration.t + Versions.V4_08.Include_declaration.t -> Compiler_types.include_declaration val ast_of_with_constraint : Compiler_types.with_constraint - -> Versions.V4_07.With_constraint.t + -> Versions.V4_08.With_constraint.t val ast_to_with_constraint : - Versions.V4_07.With_constraint.t + Versions.V4_08.With_constraint.t -> Compiler_types.with_constraint val ast_of_module_expr : Compiler_types.module_expr - -> Versions.V4_07.Module_expr.t + -> Versions.V4_08.Module_expr.t val ast_to_module_expr : - Versions.V4_07.Module_expr.t + Versions.V4_08.Module_expr.t -> Compiler_types.module_expr val ast_of_module_expr_desc : Compiler_types.module_expr_desc - -> Versions.V4_07.Module_expr_desc.t + -> Versions.V4_08.Module_expr_desc.t val ast_to_module_expr_desc : - Versions.V4_07.Module_expr_desc.t + Versions.V4_08.Module_expr_desc.t -> Compiler_types.module_expr_desc val ast_of_structure : Compiler_types.structure - -> Versions.V4_07.Structure.t + -> Versions.V4_08.Structure.t val ast_to_structure : - Versions.V4_07.Structure.t + Versions.V4_08.Structure.t -> Compiler_types.structure val ast_of_structure_item : Compiler_types.structure_item - -> Versions.V4_07.Structure_item.t + -> Versions.V4_08.Structure_item.t val ast_to_structure_item : - Versions.V4_07.Structure_item.t + Versions.V4_08.Structure_item.t -> Compiler_types.structure_item val ast_of_structure_item_desc : Compiler_types.structure_item_desc - -> Versions.V4_07.Structure_item_desc.t + -> Versions.V4_08.Structure_item_desc.t val ast_to_structure_item_desc : - Versions.V4_07.Structure_item_desc.t + Versions.V4_08.Structure_item_desc.t -> Compiler_types.structure_item_desc val ast_of_value_binding : Compiler_types.value_binding - -> Versions.V4_07.Value_binding.t + -> Versions.V4_08.Value_binding.t val ast_to_value_binding : - Versions.V4_07.Value_binding.t + Versions.V4_08.Value_binding.t -> Compiler_types.value_binding val ast_of_module_binding : Compiler_types.module_binding - -> Versions.V4_07.Module_binding.t + -> Versions.V4_08.Module_binding.t val ast_to_module_binding : - Versions.V4_07.Module_binding.t + Versions.V4_08.Module_binding.t -> Compiler_types.module_binding val ast_of_toplevel_phrase : Compiler_types.toplevel_phrase - -> Versions.V4_07.Toplevel_phrase.t + -> Versions.V4_08.Toplevel_phrase.t val ast_to_toplevel_phrase : - Versions.V4_07.Toplevel_phrase.t + Versions.V4_08.Toplevel_phrase.t -> Compiler_types.toplevel_phrase +val ast_of_toplevel_directive : + Compiler_types.toplevel_directive + -> Versions.V4_08.Toplevel_directive.t + +val ast_to_toplevel_directive : + Versions.V4_08.Toplevel_directive.t + -> Compiler_types.toplevel_directive + val ast_of_directive_argument : Compiler_types.directive_argument - -> Versions.V4_07.Directive_argument.t + -> Versions.V4_08.Directive_argument.t val ast_to_directive_argument : - Versions.V4_07.Directive_argument.t + Versions.V4_08.Directive_argument.t -> Compiler_types.directive_argument + +val ast_of_directive_argument_desc : + Compiler_types.directive_argument_desc + -> Versions.V4_08.Directive_argument_desc.t + +val ast_to_directive_argument_desc : + Versions.V4_08.Directive_argument_desc.t + -> Compiler_types.directive_argument_desc (*$*) diff --git a/ast/ppx_ast.ml b/ast/ppx_ast.ml index 04ca9178..0ede2583 100644 --- a/ast/ppx_ast.ml +++ b/ast/ppx_ast.ml @@ -3,6 +3,23 @@ module Conversion = Conversion module Traverse_builtins = Traverse_builtins include Unversioned.Types +module Unversioned : sig + module Private : sig + exception Cannot_interpret_ast of { + version : Astlib.Version.t; + node_name : string; + node : Node.t; + } + end +end = Unversioned + +module V4_08 = struct + include Versions.V4_08 + include Builder.V4_08 + include Viewer.V4_08 + include Traverse.V4_08 +end + module V4_07 = struct include Versions.V4_07 include Builder.V4_07 diff --git a/ast/test/cinaps/ppx_ast_tests_cinaps.ml b/ast/test/cinaps/ppx_ast_tests_cinaps.ml index 1d6322c4..f971d2cd 100644 --- a/ast/test/cinaps/ppx_ast_tests_cinaps.ml +++ b/ast/test/cinaps/ppx_ast_tests_cinaps.ml @@ -125,6 +125,24 @@ let clause_is_recursive clause = | Tuple tuple -> List.exists tuple ~f:ty_is_recursive | Record record -> List.exists record ~f:(fun (_, ty) -> ty_is_recursive ty) +let gen_id name = Ml.id ("gen_" ^ name) + +let print_fields_gen record = + List.iteri record ~f:(fun index (field, ty) -> + let id = gen_id field in + let generator_string = + let open Astlib.Grammar in + match field, ty with + | s, (List Location) when String.is_suffix ~suffix:"loc_stack" s -> + "Generator.return []" + | _ -> generator_string ty + in + Print.println "%s %s = %s" + (if index = 0 then "let" else "and") + id + generator_string); + Print.println "in" + let print_quickcheck_generator decl ~index ~name ~tvars = if List.length tvars = 0 then @@ -148,18 +166,12 @@ let print_quickcheck_generator decl ~index ~name ~tvars = (List.map tvars ~f:(fun tvar -> Ml.id ("quickcheck_generator_" ^ tvar)))))); Print.indented (fun () -> - let gen_id name = Ml.id ("gen_" ^ name) in match (decl : Astlib.Grammar.decl) with | Ty ty -> Print.println "let gen = %s in" (generator_string ty); Print.println "Generator.generate gen ~size ~random" | Record record -> - List.iteri record ~f:(fun index (field, ty) -> - Print.println "%s %s = %s" - (if index = 0 then "let" else "and") - (gen_id field) - (generator_string ty)); - Print.println "in"; + print_fields_gen record; List.iteri record ~f:(fun index (field, _) -> Print.println "%s %s = Generator.generate gen_%s ~size ~random" (if index = 0 then "{" else ";") @@ -304,27 +316,28 @@ let print_test name ~version = Print.println "(module Deriving.%s)" (Ml.module_name name); Print.println "~f:(fun x ->"; Print.indented (fun () -> - Print.println "require_equal [%%here] (module Deriving.%s) x" - (Ml.module_name name); + Print.println "try"; Print.indented (fun () -> - Print.println - "(Conversion.ast_to_%s" - (Ml.id name); + Print.println "require_equal [%%here] (module Deriving.%s) x" + (Ml.module_name name); Print.indented (fun () -> Print.println - "((new %s.map)#%s" - (Ml.module_name (Astlib.Version.to_string version)) + "(Conversion.ast_to_%s" (Ml.id name); Print.indented (fun () -> Print.println - "(Conversion.ast_of_%s x))));" - (Ml.id name)))))); + "((new %s.map)#%s" + (Ml.module_name (Astlib.Version.to_string version)) + (Ml.id name); + Print.indented (fun () -> + Print.println + "(Conversion.ast_of_%s x)))" + (Ml.id name))))); + Print.println "with Unversioned.Private.Cannot_interpret_ast _ -> ());")); Print.println "[%%expect {| |}]") let print_test_ml () = let alist = Astlib.History.versioned_grammars Astlib.history in - Print.newline (); - Print.println "let config = { Test.default_config with test_count = 1_000 }"; List.iter alist ~f:(fun (version, grammar) -> Print.newline (); Ml.define_module (Astlib.Version.to_string version) (fun () -> diff --git a/ast/test/deriving.ml b/ast/test/deriving.ml index 17a41485..9bf3677a 100644 --- a/ast/test/deriving.ml +++ b/ast/test/deriving.ml @@ -13,10 +13,15 @@ type position = Lexing.position = type location = Location.t = { loc_start : position ; loc_end : position - ; loc_ghost : bool + ; loc_ghost : bool [@quickcheck.generator Generator.return true] } [@@deriving equal, quickcheck, sexp_of] +let equal_location l l' = + match l.loc_ghost, l'.loc_ghost with + | true, _ | _, true -> true + | _ -> equal_location l l' + type 'a loc = 'a Location.loc = { txt : 'a; loc : location } [@@deriving equal, quickcheck, sexp_of] @@ -106,7 +111,11 @@ and constant = | Pconst_float of string * char option and attribute = - (string loc * payload) + Compiler_types.attribute = + { attr_name : string loc + ; attr_payload : payload + ; attr_loc : location + } and extension = (string loc * payload) @@ -125,6 +134,7 @@ and core_type = Compiler_types.core_type = { ptyp_desc : core_type_desc ; ptyp_loc : location + ; ptyp_loc_stack : location list ; ptyp_attributes : attributes } @@ -148,18 +158,33 @@ and package_type = and row_field = Compiler_types.row_field = - | Rtag of string loc * attributes * bool * core_type list + { prf_desc : row_field_desc + ; prf_loc : location + ; prf_attributes : attributes + } + +and row_field_desc = + Compiler_types.row_field_desc = + | Rtag of string loc * bool * core_type list | Rinherit of core_type and object_field = Compiler_types.object_field = - | Otag of string loc * attributes * core_type + { pof_desc : object_field_desc + ; pof_loc : location + ; pof_attributes : attributes + } + +and object_field_desc = + Compiler_types.object_field_desc = + | Otag of string loc * core_type | Oinherit of core_type and pattern = Compiler_types.pattern = { ppat_desc : pattern_desc ; ppat_loc : location + ; ppat_loc_stack : location list ; ppat_attributes : attributes } @@ -188,6 +213,7 @@ and expression = Compiler_types.expression = { pexp_desc : expression_desc ; pexp_loc : location + ; pexp_loc_stack : location list ; pexp_attributes : attributes } @@ -226,7 +252,8 @@ and expression_desc = | Pexp_object of class_structure | Pexp_newtype of string loc * expression | Pexp_pack of module_expr - | Pexp_open of override_flag * longident_loc * expression + | Pexp_open of open_declaration * expression + | Pexp_letop of letop | Pexp_extension of extension | Pexp_unreachable @@ -237,6 +264,21 @@ and case = ; pc_rhs : expression } +and letop = + Compiler_types.letop = + { let_ : binding_op + ; ands : binding_op list + ; body : expression + } + +and binding_op = + Compiler_types.binding_op = + { pbop_op : string loc + ; pbop_pat : pattern + ; pbop_exp : expression + ; pbop_loc : location + } + and value_description = Compiler_types.value_description = { pval_name : string loc @@ -294,6 +336,7 @@ and type_extension = ; ptyext_params : (core_type * variance) list ; ptyext_constructors : extension_constructor list ; ptyext_private : private_flag + ; ptyext_loc : location ; ptyext_attributes : attributes } @@ -305,6 +348,13 @@ and extension_constructor = ; pext_attributes : attributes } +and type_exception = + Compiler_types.type_exception = + { ptyexn_constructor : extension_constructor + ; ptyexn_loc : location + ; ptyexn_attributes : attributes + } + and extension_constructor_kind = Compiler_types.extension_constructor_kind = | Pext_decl of constructor_arguments * core_type option @@ -323,7 +373,7 @@ and class_type_desc = | Pcty_signature of class_signature | Pcty_arrow of arg_label * core_type * class_type | Pcty_extension of extension - | Pcty_open of override_flag * longident_loc * class_type + | Pcty_open of open_description * class_type and class_signature = Compiler_types.class_signature = @@ -379,7 +429,7 @@ and class_expr_desc = | Pcl_let of rec_flag * value_binding list * class_expr | Pcl_constraint of class_expr * class_type | Pcl_extension of extension - | Pcl_open of override_flag * longident_loc * class_expr + | Pcl_open of open_description * class_expr and class_structure = Compiler_types.class_structure = @@ -442,9 +492,11 @@ and signature_item_desc = Compiler_types.signature_item_desc = | Psig_value of value_description | Psig_type of rec_flag * type_declaration list + | Psig_typesubst of type_declaration list | Psig_typext of type_extension - | Psig_exception of extension_constructor + | Psig_exception of type_exception | Psig_module of module_declaration + | Psig_modsubst of module_substitution | Psig_recmodule of module_declaration list | Psig_modtype of module_type_declaration | Psig_open of open_description @@ -462,6 +514,14 @@ and module_declaration = ; pmd_loc : location } +and module_substitution = + Compiler_types.module_substitution = + { pms_name : string loc + ; pms_manifest : longident_loc + ; pms_attributes : attributes + ; pms_loc : location + } + and module_type_declaration = Compiler_types.module_type_declaration = { pmtd_name : string loc @@ -470,14 +530,20 @@ and module_type_declaration = ; pmtd_loc : location } -and open_description = - Compiler_types.open_description = - { popen_lid : longident_loc +and 'a open_infos = + 'a Compiler_types.open_infos = + { popen_expr : 'a ; popen_override : override_flag ; popen_loc : location ; popen_attributes : attributes } +and open_description = + longident_loc open_infos + +and open_declaration = + module_expr open_infos + and 'a include_infos = 'a Compiler_types.include_infos = { pincl_mod : 'a @@ -531,11 +597,11 @@ and structure_item_desc = | Pstr_primitive of value_description | Pstr_type of rec_flag * type_declaration list | Pstr_typext of type_extension - | Pstr_exception of extension_constructor + | Pstr_exception of type_exception | Pstr_module of module_binding | Pstr_recmodule of module_binding list | Pstr_modtype of module_type_declaration - | Pstr_open of open_description + | Pstr_open of open_declaration | Pstr_class of class_declaration list | Pstr_class_type of class_type_declaration list | Pstr_include of include_declaration @@ -561,11 +627,23 @@ and module_binding = and toplevel_phrase = Compiler_types.toplevel_phrase = | Ptop_def of structure - | Ptop_dir of string * directive_argument + | Ptop_dir of toplevel_directive + +and toplevel_directive = + Compiler_types.toplevel_directive = + { pdir_name : string loc + ; pdir_arg : directive_argument option + ; pdir_loc : location + } and directive_argument = Compiler_types.directive_argument = - | Pdir_none + { pdira_desc : directive_argument_desc + ; pdira_loc : location + } + +and directive_argument_desc = + Compiler_types.directive_argument_desc = | Pdir_string of string | Pdir_int of string * char option | Pdir_ident of longident @@ -746,8 +824,14 @@ and generate_constant ~size ~random = (Base_quickcheck.Generator.union [gen_pconst_integer; gen_pconst_char; gen_pconst_string; gen_pconst_float]) and generate_attribute ~size ~random = - let gen = (quickcheck_generator_tuple2 (quickcheck_generator_loc quickcheck_generator_string) (Generator.create generate_payload)) in - Generator.generate gen ~size ~random + let gen_attr_name = (quickcheck_generator_loc quickcheck_generator_string) + and gen_attr_payload = (Generator.create generate_payload) + and gen_attr_loc = quickcheck_generator_location + in + { attr_name = Generator.generate gen_attr_name ~size ~random + ; attr_payload = Generator.generate gen_attr_payload ~size ~random + ; attr_loc = Generator.generate gen_attr_loc ~size ~random + } and generate_extension ~size ~random = let gen = (quickcheck_generator_tuple2 (quickcheck_generator_loc quickcheck_generator_string) (Generator.create generate_payload)) in Generator.generate gen ~size ~random @@ -792,10 +876,12 @@ and generate_payload ~size ~random = and generate_core_type ~size ~random = let gen_ptyp_desc = (Generator.create generate_core_type_desc) and gen_ptyp_loc = quickcheck_generator_location + and gen_ptyp_loc_stack = Generator.return [] and gen_ptyp_attributes = (Generator.create generate_attributes) in { ptyp_desc = Generator.generate gen_ptyp_desc ~size ~random ; ptyp_loc = Generator.generate gen_ptyp_loc ~size ~random + ; ptyp_loc_stack = Generator.generate gen_ptyp_loc_stack ~size ~random ; ptyp_attributes = Generator.generate gen_ptyp_attributes ~size ~random } and generate_core_type_desc ~size ~random = @@ -910,18 +996,25 @@ and generate_package_type ~size ~random = let gen = (quickcheck_generator_tuple2 (Generator.create generate_longident_loc) (quickcheck_generator_list (quickcheck_generator_tuple2 (Generator.create generate_longident_loc) (Generator.create generate_core_type)))) in Generator.generate gen ~size ~random and generate_row_field ~size ~random = + let gen_prf_desc = (Generator.create generate_row_field_desc) + and gen_prf_loc = quickcheck_generator_location + and gen_prf_attributes = (Generator.create generate_attributes) + in + { prf_desc = Generator.generate gen_prf_desc ~size ~random + ; prf_loc = Generator.generate gen_prf_loc ~size ~random + ; prf_attributes = Generator.generate gen_prf_attributes ~size ~random + } +and generate_row_field_desc ~size ~random = let gen_rtag = Generator.create (fun ~size ~random -> let gen0 = (quickcheck_generator_loc quickcheck_generator_string) - and gen1 = (Generator.create generate_attributes) - and gen2 = quickcheck_generator_bool - and gen3 = (quickcheck_generator_list (Generator.create generate_core_type)) + and gen1 = quickcheck_generator_bool + and gen2 = (quickcheck_generator_list (Generator.create generate_core_type)) in Rtag ( Generator.generate gen0 ~size ~random , Generator.generate gen1 ~size ~random , Generator.generate gen2 ~size ~random - , Generator.generate gen3 ~size ~random )) and gen_rinherit = Generator.create (fun ~size ~random -> @@ -935,16 +1028,23 @@ and generate_row_field ~size ~random = (Base_quickcheck.Generator.union [gen_rtag; gen_rinherit]) and generate_object_field ~size ~random = + let gen_pof_desc = (Generator.create generate_object_field_desc) + and gen_pof_loc = quickcheck_generator_location + and gen_pof_attributes = (Generator.create generate_attributes) + in + { pof_desc = Generator.generate gen_pof_desc ~size ~random + ; pof_loc = Generator.generate gen_pof_loc ~size ~random + ; pof_attributes = Generator.generate gen_pof_attributes ~size ~random + } +and generate_object_field_desc ~size ~random = let gen_otag = Generator.create (fun ~size ~random -> let gen0 = (quickcheck_generator_loc quickcheck_generator_string) - and gen1 = (Generator.create generate_attributes) - and gen2 = (Generator.create generate_core_type) + and gen1 = (Generator.create generate_core_type) in Otag ( Generator.generate gen0 ~size ~random , Generator.generate gen1 ~size ~random - , Generator.generate gen2 ~size ~random )) and gen_oinherit = Generator.create (fun ~size ~random -> @@ -960,10 +1060,12 @@ and generate_object_field ~size ~random = and generate_pattern ~size ~random = let gen_ppat_desc = (Generator.create generate_pattern_desc) and gen_ppat_loc = quickcheck_generator_location + and gen_ppat_loc_stack = Generator.return [] and gen_ppat_attributes = (Generator.create generate_attributes) in { ppat_desc = Generator.generate gen_ppat_desc ~size ~random ; ppat_loc = Generator.generate gen_ppat_loc ~size ~random + ; ppat_loc_stack = Generator.generate gen_ppat_loc_stack ~size ~random ; ppat_attributes = Generator.generate gen_ppat_attributes ~size ~random } and generate_pattern_desc ~size ~random = @@ -1117,10 +1219,12 @@ and generate_pattern_desc ~size ~random = and generate_expression ~size ~random = let gen_pexp_desc = (Generator.create generate_expression_desc) and gen_pexp_loc = quickcheck_generator_location + and gen_pexp_loc_stack = Generator.return [] and gen_pexp_attributes = (Generator.create generate_attributes) in { pexp_desc = Generator.generate gen_pexp_desc ~size ~random ; pexp_loc = Generator.generate gen_pexp_loc ~size ~random + ; pexp_loc_stack = Generator.generate gen_pexp_loc_stack ~size ~random ; pexp_attributes = Generator.generate gen_pexp_attributes ~size ~random } and generate_expression_desc ~size ~random = @@ -1421,14 +1525,19 @@ and generate_expression_desc ~size ~random = )) and gen_pexp_open = Generator.create (fun ~size ~random -> - let gen0 = (Generator.create generate_override_flag) - and gen1 = (Generator.create generate_longident_loc) - and gen2 = (Generator.create generate_expression) + let gen0 = (Generator.create generate_open_declaration) + and gen1 = (Generator.create generate_expression) in Pexp_open ( Generator.generate gen0 ~size ~random , Generator.generate gen1 ~size ~random - , Generator.generate gen2 ~size ~random + )) + and gen_pexp_letop = + Generator.create (fun ~size ~random -> + let gen0 = (Generator.create generate_letop) + in + Pexp_letop + ( Generator.generate gen0 ~size ~random )) and gen_pexp_extension = Generator.create (fun ~size ~random -> @@ -1448,7 +1557,7 @@ and generate_expression_desc ~size ~random = else Generator.generate ~size:(size-1) ~random (Base_quickcheck.Generator.union - [gen_pexp_unreachable; gen_pexp_ident; gen_pexp_constant; gen_pexp_let; gen_pexp_function; gen_pexp_fun; gen_pexp_apply; gen_pexp_match; gen_pexp_try; gen_pexp_tuple; gen_pexp_construct; gen_pexp_variant; gen_pexp_record; gen_pexp_field; gen_pexp_setfield; gen_pexp_array; gen_pexp_ifthenelse; gen_pexp_sequence; gen_pexp_while; gen_pexp_for; gen_pexp_constraint; gen_pexp_coerce; gen_pexp_send; gen_pexp_new; gen_pexp_setinstvar; gen_pexp_override; gen_pexp_letmodule; gen_pexp_letexception; gen_pexp_assert; gen_pexp_lazy; gen_pexp_poly; gen_pexp_object; gen_pexp_newtype; gen_pexp_pack; gen_pexp_open; gen_pexp_extension]) + [gen_pexp_unreachable; gen_pexp_ident; gen_pexp_constant; gen_pexp_let; gen_pexp_function; gen_pexp_fun; gen_pexp_apply; gen_pexp_match; gen_pexp_try; gen_pexp_tuple; gen_pexp_construct; gen_pexp_variant; gen_pexp_record; gen_pexp_field; gen_pexp_setfield; gen_pexp_array; gen_pexp_ifthenelse; gen_pexp_sequence; gen_pexp_while; gen_pexp_for; gen_pexp_constraint; gen_pexp_coerce; gen_pexp_send; gen_pexp_new; gen_pexp_setinstvar; gen_pexp_override; gen_pexp_letmodule; gen_pexp_letexception; gen_pexp_assert; gen_pexp_lazy; gen_pexp_poly; gen_pexp_object; gen_pexp_newtype; gen_pexp_pack; gen_pexp_open; gen_pexp_letop; gen_pexp_extension]) and generate_case ~size ~random = let gen_pc_lhs = (Generator.create generate_pattern) and gen_pc_guard = (quickcheck_generator_option (Generator.create generate_expression)) @@ -1458,6 +1567,26 @@ and generate_case ~size ~random = ; pc_guard = Generator.generate gen_pc_guard ~size ~random ; pc_rhs = Generator.generate gen_pc_rhs ~size ~random } +and generate_letop ~size ~random = + let gen_let_ = (Generator.create generate_binding_op) + and gen_ands = (quickcheck_generator_list (Generator.create generate_binding_op)) + and gen_body = (Generator.create generate_expression) + in + { let_ = Generator.generate gen_let_ ~size ~random + ; ands = Generator.generate gen_ands ~size ~random + ; body = Generator.generate gen_body ~size ~random + } +and generate_binding_op ~size ~random = + let gen_pbop_op = (quickcheck_generator_loc quickcheck_generator_string) + and gen_pbop_pat = (Generator.create generate_pattern) + and gen_pbop_exp = (Generator.create generate_expression) + and gen_pbop_loc = quickcheck_generator_location + in + { pbop_op = Generator.generate gen_pbop_op ~size ~random + ; pbop_pat = Generator.generate gen_pbop_pat ~size ~random + ; pbop_exp = Generator.generate gen_pbop_exp ~size ~random + ; pbop_loc = Generator.generate gen_pbop_loc ~size ~random + } and generate_value_description ~size ~random = let gen_pval_name = (quickcheck_generator_loc quickcheck_generator_string) and gen_pval_type = (Generator.create generate_core_type) @@ -1569,12 +1698,14 @@ and generate_type_extension ~size ~random = and gen_ptyext_params = (quickcheck_generator_list (quickcheck_generator_tuple2 (Generator.create generate_core_type) (Generator.create generate_variance))) and gen_ptyext_constructors = (quickcheck_generator_list (Generator.create generate_extension_constructor)) and gen_ptyext_private = (Generator.create generate_private_flag) + and gen_ptyext_loc = quickcheck_generator_location and gen_ptyext_attributes = (Generator.create generate_attributes) in { ptyext_path = Generator.generate gen_ptyext_path ~size ~random ; ptyext_params = Generator.generate gen_ptyext_params ~size ~random ; ptyext_constructors = Generator.generate gen_ptyext_constructors ~size ~random ; ptyext_private = Generator.generate gen_ptyext_private ~size ~random + ; ptyext_loc = Generator.generate gen_ptyext_loc ~size ~random ; ptyext_attributes = Generator.generate gen_ptyext_attributes ~size ~random } and generate_extension_constructor ~size ~random = @@ -1588,6 +1719,15 @@ and generate_extension_constructor ~size ~random = ; pext_loc = Generator.generate gen_pext_loc ~size ~random ; pext_attributes = Generator.generate gen_pext_attributes ~size ~random } +and generate_type_exception ~size ~random = + let gen_ptyexn_constructor = (Generator.create generate_extension_constructor) + and gen_ptyexn_loc = quickcheck_generator_location + and gen_ptyexn_attributes = (Generator.create generate_attributes) + in + { ptyexn_constructor = Generator.generate gen_ptyexn_constructor ~size ~random + ; ptyexn_loc = Generator.generate gen_ptyexn_loc ~size ~random + ; ptyexn_attributes = Generator.generate gen_ptyexn_attributes ~size ~random + } and generate_extension_constructor_kind ~size ~random = let gen_pext_decl = Generator.create (fun ~size ~random -> @@ -1655,14 +1795,12 @@ and generate_class_type_desc ~size ~random = )) and gen_pcty_open = Generator.create (fun ~size ~random -> - let gen0 = (Generator.create generate_override_flag) - and gen1 = (Generator.create generate_longident_loc) - and gen2 = (Generator.create generate_class_type) + let gen0 = (Generator.create generate_open_description) + and gen1 = (Generator.create generate_class_type) in Pcty_open ( Generator.generate gen0 ~size ~random , Generator.generate gen1 ~size ~random - , Generator.generate gen2 ~size ~random )) in Generator.generate ~size ~random @@ -1831,14 +1969,12 @@ and generate_class_expr_desc ~size ~random = )) and gen_pcl_open = Generator.create (fun ~size ~random -> - let gen0 = (Generator.create generate_override_flag) - and gen1 = (Generator.create generate_longident_loc) - and gen2 = (Generator.create generate_class_expr) + let gen0 = (Generator.create generate_open_description) + and gen1 = (Generator.create generate_class_expr) in Pcl_open ( Generator.generate gen0 ~size ~random , Generator.generate gen1 ~size ~random - , Generator.generate gen2 ~size ~random )) in Generator.generate ~size ~random @@ -2038,6 +2174,13 @@ and generate_signature_item_desc ~size ~random = ( Generator.generate gen0 ~size ~random , Generator.generate gen1 ~size ~random )) + and gen_psig_typesubst = + Generator.create (fun ~size ~random -> + let gen0 = (quickcheck_generator_list (Generator.create generate_type_declaration)) + in + Psig_typesubst + ( Generator.generate gen0 ~size ~random + )) and gen_psig_typext = Generator.create (fun ~size ~random -> let gen0 = (Generator.create generate_type_extension) @@ -2047,7 +2190,7 @@ and generate_signature_item_desc ~size ~random = )) and gen_psig_exception = Generator.create (fun ~size ~random -> - let gen0 = (Generator.create generate_extension_constructor) + let gen0 = (Generator.create generate_type_exception) in Psig_exception ( Generator.generate gen0 ~size ~random @@ -2059,6 +2202,13 @@ and generate_signature_item_desc ~size ~random = Psig_module ( Generator.generate gen0 ~size ~random )) + and gen_psig_modsubst = + Generator.create (fun ~size ~random -> + let gen0 = (Generator.create generate_module_substitution) + in + Psig_modsubst + ( Generator.generate gen0 ~size ~random + )) and gen_psig_recmodule = Generator.create (fun ~size ~random -> let gen0 = (quickcheck_generator_list (Generator.create generate_module_declaration)) @@ -2120,7 +2270,7 @@ and generate_signature_item_desc ~size ~random = in Generator.generate ~size ~random (Base_quickcheck.Generator.union - [gen_psig_value; gen_psig_type; gen_psig_typext; gen_psig_exception; gen_psig_module; gen_psig_recmodule; gen_psig_modtype; gen_psig_open; gen_psig_include; gen_psig_class; gen_psig_class_type; gen_psig_attribute; gen_psig_extension]) + [gen_psig_value; gen_psig_type; gen_psig_typesubst; gen_psig_typext; gen_psig_exception; gen_psig_module; gen_psig_modsubst; gen_psig_recmodule; gen_psig_modtype; gen_psig_open; gen_psig_include; gen_psig_class; gen_psig_class_type; gen_psig_attribute; gen_psig_extension]) and generate_module_declaration ~size ~random = let gen_pmd_name = (quickcheck_generator_loc quickcheck_generator_string) and gen_pmd_type = (Generator.create generate_module_type) @@ -2132,6 +2282,17 @@ and generate_module_declaration ~size ~random = ; pmd_attributes = Generator.generate gen_pmd_attributes ~size ~random ; pmd_loc = Generator.generate gen_pmd_loc ~size ~random } +and generate_module_substitution ~size ~random = + let gen_pms_name = (quickcheck_generator_loc quickcheck_generator_string) + and gen_pms_manifest = (Generator.create generate_longident_loc) + and gen_pms_attributes = (Generator.create generate_attributes) + and gen_pms_loc = quickcheck_generator_location + in + { pms_name = Generator.generate gen_pms_name ~size ~random + ; pms_manifest = Generator.generate gen_pms_manifest ~size ~random + ; pms_attributes = Generator.generate gen_pms_attributes ~size ~random + ; pms_loc = Generator.generate gen_pms_loc ~size ~random + } and generate_module_type_declaration ~size ~random = let gen_pmtd_name = (quickcheck_generator_loc quickcheck_generator_string) and gen_pmtd_type = (quickcheck_generator_option (Generator.create generate_module_type)) @@ -2143,17 +2304,25 @@ and generate_module_type_declaration ~size ~random = ; pmtd_attributes = Generator.generate gen_pmtd_attributes ~size ~random ; pmtd_loc = Generator.generate gen_pmtd_loc ~size ~random } -and generate_open_description ~size ~random = - let gen_popen_lid = (Generator.create generate_longident_loc) +and generate_open_infos + : type a . a Generator.t -> size:int -> random:Splittable_random.State.t -> a open_infos + = fun quickcheck_generator_a ~size ~random -> + let gen_popen_expr = quickcheck_generator_a and gen_popen_override = (Generator.create generate_override_flag) and gen_popen_loc = quickcheck_generator_location and gen_popen_attributes = (Generator.create generate_attributes) in - { popen_lid = Generator.generate gen_popen_lid ~size ~random + { popen_expr = Generator.generate gen_popen_expr ~size ~random ; popen_override = Generator.generate gen_popen_override ~size ~random ; popen_loc = Generator.generate gen_popen_loc ~size ~random ; popen_attributes = Generator.generate gen_popen_attributes ~size ~random } +and generate_open_description ~size ~random = + let gen = (Generator.create (generate_open_infos (Generator.create generate_longident_loc))) in + Generator.generate gen ~size ~random +and generate_open_declaration ~size ~random = + let gen = (Generator.create (generate_open_infos (Generator.create generate_module_expr))) in + Generator.generate gen ~size ~random and generate_include_infos : type a . a Generator.t -> size:int -> random:Splittable_random.State.t -> a include_infos = fun quickcheck_generator_a ~size ~random -> @@ -2337,7 +2506,7 @@ and generate_structure_item_desc ~size ~random = )) and gen_pstr_exception = Generator.create (fun ~size ~random -> - let gen0 = (Generator.create generate_extension_constructor) + let gen0 = (Generator.create generate_type_exception) in Pstr_exception ( Generator.generate gen0 ~size ~random @@ -2365,7 +2534,7 @@ and generate_structure_item_desc ~size ~random = )) and gen_pstr_open = Generator.create (fun ~size ~random -> - let gen0 = (Generator.create generate_open_description) + let gen0 = (Generator.create generate_open_declaration) in Pstr_open ( Generator.generate gen0 ~size ~random @@ -2443,21 +2612,33 @@ and generate_toplevel_phrase ~size ~random = )) and gen_ptop_dir = Generator.create (fun ~size ~random -> - let gen0 = quickcheck_generator_string - and gen1 = (Generator.create generate_directive_argument) + let gen0 = (Generator.create generate_toplevel_directive) in Ptop_dir ( Generator.generate gen0 ~size ~random - , Generator.generate gen1 ~size ~random )) in Generator.generate ~size ~random (Base_quickcheck.Generator.union [gen_ptop_def; gen_ptop_dir]) +and generate_toplevel_directive ~size ~random = + let gen_pdir_name = (quickcheck_generator_loc quickcheck_generator_string) + and gen_pdir_arg = (quickcheck_generator_option (Generator.create generate_directive_argument)) + and gen_pdir_loc = quickcheck_generator_location + in + { pdir_name = Generator.generate gen_pdir_name ~size ~random + ; pdir_arg = Generator.generate gen_pdir_arg ~size ~random + ; pdir_loc = Generator.generate gen_pdir_loc ~size ~random + } and generate_directive_argument ~size ~random = - let gen_pdir_none = - Generator.return Pdir_none - and gen_pdir_string = + let gen_pdira_desc = (Generator.create generate_directive_argument_desc) + and gen_pdira_loc = quickcheck_generator_location + in + { pdira_desc = Generator.generate gen_pdira_desc ~size ~random + ; pdira_loc = Generator.generate gen_pdira_loc ~size ~random + } +and generate_directive_argument_desc ~size ~random = + let gen_pdir_string = Generator.create (fun ~size ~random -> let gen0 = quickcheck_generator_string in @@ -2492,11 +2673,11 @@ and generate_directive_argument ~size ~random = then Generator.generate ~size ~random (Base_quickcheck.Generator.union - [gen_pdir_none; gen_pdir_string; gen_pdir_int; gen_pdir_bool]) + [gen_pdir_string; gen_pdir_int; gen_pdir_bool]) else Generator.generate ~size:(size-1) ~random (Base_quickcheck.Generator.union - [gen_pdir_none; gen_pdir_string; gen_pdir_int; gen_pdir_bool; gen_pdir_ident]) + [gen_pdir_string; gen_pdir_int; gen_pdir_bool; gen_pdir_ident]) let quickcheck_generator_longident = Generator.create generate_longident @@ -2538,8 +2719,12 @@ let quickcheck_generator_package_type = Generator.create generate_package_type let quickcheck_generator_row_field = Generator.create generate_row_field +let quickcheck_generator_row_field_desc = + Generator.create generate_row_field_desc let quickcheck_generator_object_field = Generator.create generate_object_field +let quickcheck_generator_object_field_desc = + Generator.create generate_object_field_desc let quickcheck_generator_pattern = Generator.create generate_pattern let quickcheck_generator_pattern_desc = @@ -2550,6 +2735,10 @@ let quickcheck_generator_expression_desc = Generator.create generate_expression_desc let quickcheck_generator_case = Generator.create generate_case +let quickcheck_generator_letop = + Generator.create generate_letop +let quickcheck_generator_binding_op = + Generator.create generate_binding_op let quickcheck_generator_value_description = Generator.create generate_value_description let quickcheck_generator_type_declaration = @@ -2566,6 +2755,8 @@ let quickcheck_generator_type_extension = Generator.create generate_type_extension let quickcheck_generator_extension_constructor = Generator.create generate_extension_constructor +let quickcheck_generator_type_exception = + Generator.create generate_type_exception let quickcheck_generator_extension_constructor_kind = Generator.create generate_extension_constructor_kind let quickcheck_generator_class_type = @@ -2610,10 +2801,16 @@ let quickcheck_generator_signature_item_desc = Generator.create generate_signature_item_desc let quickcheck_generator_module_declaration = Generator.create generate_module_declaration +let quickcheck_generator_module_substitution = + Generator.create generate_module_substitution let quickcheck_generator_module_type_declaration = Generator.create generate_module_type_declaration +let quickcheck_generator_open_infos quickcheck_generator_a = + Generator.create (generate_open_infos quickcheck_generator_a) let quickcheck_generator_open_description = Generator.create generate_open_description +let quickcheck_generator_open_declaration = + Generator.create generate_open_declaration let quickcheck_generator_include_infos quickcheck_generator_a = Generator.create (generate_include_infos quickcheck_generator_a) let quickcheck_generator_include_description = @@ -2638,8 +2835,12 @@ let quickcheck_generator_module_binding = Generator.create generate_module_binding let quickcheck_generator_toplevel_phrase = Generator.create generate_toplevel_phrase +let quickcheck_generator_toplevel_directive = + Generator.create generate_toplevel_directive let quickcheck_generator_directive_argument = Generator.create generate_directive_argument +let quickcheck_generator_directive_argument_desc = + Generator.create generate_directive_argument_desc let quickcheck_observer_longident = Observer.opaque let quickcheck_observer_longident_loc = Observer.opaque @@ -2661,12 +2862,16 @@ let quickcheck_observer_core_type = Observer.opaque let quickcheck_observer_core_type_desc = Observer.opaque let quickcheck_observer_package_type = Observer.opaque let quickcheck_observer_row_field = Observer.opaque +let quickcheck_observer_row_field_desc = Observer.opaque let quickcheck_observer_object_field = Observer.opaque +let quickcheck_observer_object_field_desc = Observer.opaque let quickcheck_observer_pattern = Observer.opaque let quickcheck_observer_pattern_desc = Observer.opaque let quickcheck_observer_expression = Observer.opaque let quickcheck_observer_expression_desc = Observer.opaque let quickcheck_observer_case = Observer.opaque +let quickcheck_observer_letop = Observer.opaque +let quickcheck_observer_binding_op = Observer.opaque let quickcheck_observer_value_description = Observer.opaque let quickcheck_observer_type_declaration = Observer.opaque let quickcheck_observer_type_kind = Observer.opaque @@ -2675,6 +2880,7 @@ let quickcheck_observer_constructor_declaration = Observer.opaque let quickcheck_observer_constructor_arguments = Observer.opaque let quickcheck_observer_type_extension = Observer.opaque let quickcheck_observer_extension_constructor = Observer.opaque +let quickcheck_observer_type_exception = Observer.opaque let quickcheck_observer_extension_constructor_kind = Observer.opaque let quickcheck_observer_class_type = Observer.opaque let quickcheck_observer_class_type_desc = Observer.opaque @@ -2697,8 +2903,11 @@ let quickcheck_observer_signature = Observer.opaque let quickcheck_observer_signature_item = Observer.opaque let quickcheck_observer_signature_item_desc = Observer.opaque let quickcheck_observer_module_declaration = Observer.opaque +let quickcheck_observer_module_substitution = Observer.opaque let quickcheck_observer_module_type_declaration = Observer.opaque +let quickcheck_observer_open_infos _ = Observer.opaque let quickcheck_observer_open_description = Observer.opaque +let quickcheck_observer_open_declaration = Observer.opaque let quickcheck_observer_include_infos _ = Observer.opaque let quickcheck_observer_include_description = Observer.opaque let quickcheck_observer_include_declaration = Observer.opaque @@ -2711,7 +2920,9 @@ let quickcheck_observer_structure_item_desc = Observer.opaque let quickcheck_observer_value_binding = Observer.opaque let quickcheck_observer_module_binding = Observer.opaque let quickcheck_observer_toplevel_phrase = Observer.opaque +let quickcheck_observer_toplevel_directive = Observer.opaque let quickcheck_observer_directive_argument = Observer.opaque +let quickcheck_observer_directive_argument_desc = Observer.opaque let quickcheck_shrinker_longident = Shrinker.atomic let quickcheck_shrinker_longident_loc = Shrinker.atomic @@ -2733,12 +2944,16 @@ let quickcheck_shrinker_core_type = Shrinker.atomic let quickcheck_shrinker_core_type_desc = Shrinker.atomic let quickcheck_shrinker_package_type = Shrinker.atomic let quickcheck_shrinker_row_field = Shrinker.atomic +let quickcheck_shrinker_row_field_desc = Shrinker.atomic let quickcheck_shrinker_object_field = Shrinker.atomic +let quickcheck_shrinker_object_field_desc = Shrinker.atomic let quickcheck_shrinker_pattern = Shrinker.atomic let quickcheck_shrinker_pattern_desc = Shrinker.atomic let quickcheck_shrinker_expression = Shrinker.atomic let quickcheck_shrinker_expression_desc = Shrinker.atomic let quickcheck_shrinker_case = Shrinker.atomic +let quickcheck_shrinker_letop = Shrinker.atomic +let quickcheck_shrinker_binding_op = Shrinker.atomic let quickcheck_shrinker_value_description = Shrinker.atomic let quickcheck_shrinker_type_declaration = Shrinker.atomic let quickcheck_shrinker_type_kind = Shrinker.atomic @@ -2747,6 +2962,7 @@ let quickcheck_shrinker_constructor_declaration = Shrinker.atomic let quickcheck_shrinker_constructor_arguments = Shrinker.atomic let quickcheck_shrinker_type_extension = Shrinker.atomic let quickcheck_shrinker_extension_constructor = Shrinker.atomic +let quickcheck_shrinker_type_exception = Shrinker.atomic let quickcheck_shrinker_extension_constructor_kind = Shrinker.atomic let quickcheck_shrinker_class_type = Shrinker.atomic let quickcheck_shrinker_class_type_desc = Shrinker.atomic @@ -2769,8 +2985,11 @@ let quickcheck_shrinker_signature = Shrinker.atomic let quickcheck_shrinker_signature_item = Shrinker.atomic let quickcheck_shrinker_signature_item_desc = Shrinker.atomic let quickcheck_shrinker_module_declaration = Shrinker.atomic +let quickcheck_shrinker_module_substitution = Shrinker.atomic let quickcheck_shrinker_module_type_declaration = Shrinker.atomic +let quickcheck_shrinker_open_infos _ = Shrinker.atomic let quickcheck_shrinker_open_description = Shrinker.atomic +let quickcheck_shrinker_open_declaration = Shrinker.atomic let quickcheck_shrinker_include_infos _ = Shrinker.atomic let quickcheck_shrinker_include_description = Shrinker.atomic let quickcheck_shrinker_include_declaration = Shrinker.atomic @@ -2783,7 +3002,9 @@ let quickcheck_shrinker_structure_item_desc = Shrinker.atomic let quickcheck_shrinker_value_binding = Shrinker.atomic let quickcheck_shrinker_module_binding = Shrinker.atomic let quickcheck_shrinker_toplevel_phrase = Shrinker.atomic +let quickcheck_shrinker_toplevel_directive = Shrinker.atomic let quickcheck_shrinker_directive_argument = Shrinker.atomic +let quickcheck_shrinker_directive_argument_desc = Shrinker.atomic module Longident = struct type t = longident @@ -2885,11 +3106,21 @@ module Row_field = struct [@@deriving equal, quickcheck, sexp_of] end +module Row_field_desc = struct + type t = row_field_desc + [@@deriving equal, quickcheck, sexp_of] +end + module Object_field = struct type t = object_field [@@deriving equal, quickcheck, sexp_of] end +module Object_field_desc = struct + type t = object_field_desc + [@@deriving equal, quickcheck, sexp_of] +end + module Pattern = struct type t = pattern [@@deriving equal, quickcheck, sexp_of] @@ -2915,6 +3146,16 @@ module Case = struct [@@deriving equal, quickcheck, sexp_of] end +module Letop = struct + type t = letop + [@@deriving equal, quickcheck, sexp_of] +end + +module Binding_op = struct + type t = binding_op + [@@deriving equal, quickcheck, sexp_of] +end + module Value_description = struct type t = value_description [@@deriving equal, quickcheck, sexp_of] @@ -2955,6 +3196,11 @@ module Extension_constructor = struct [@@deriving equal, quickcheck, sexp_of] end +module Type_exception = struct + type t = type_exception + [@@deriving equal, quickcheck, sexp_of] +end + module Extension_constructor_kind = struct type t = extension_constructor_kind [@@deriving equal, quickcheck, sexp_of] @@ -3065,16 +3311,31 @@ module Module_declaration = struct [@@deriving equal, quickcheck, sexp_of] end +module Module_substitution = struct + type t = module_substitution + [@@deriving equal, quickcheck, sexp_of] +end + module Module_type_declaration = struct type t = module_type_declaration [@@deriving equal, quickcheck, sexp_of] end +module Open_infos = struct + type 'a t = 'a open_infos + [@@deriving equal, quickcheck, sexp_of] +end + module Open_description = struct type t = open_description [@@deriving equal, quickcheck, sexp_of] end +module Open_declaration = struct + type t = open_declaration + [@@deriving equal, quickcheck, sexp_of] +end + module Include_infos = struct type 'a t = 'a include_infos [@@deriving equal, quickcheck, sexp_of] @@ -3135,8 +3396,18 @@ module Toplevel_phrase = struct [@@deriving equal, quickcheck, sexp_of] end +module Toplevel_directive = struct + type t = toplevel_directive + [@@deriving equal, quickcheck, sexp_of] +end + module Directive_argument = struct type t = directive_argument [@@deriving equal, quickcheck, sexp_of] end + +module Directive_argument_desc = struct + type t = directive_argument_desc + [@@deriving equal, quickcheck, sexp_of] +end (*$*) diff --git a/ast/test/deriving.mli b/ast/test/deriving.mli index 1c6aaf32..b36021c6 100644 --- a/ast/test/deriving.mli +++ b/ast/test/deriving.mli @@ -101,11 +101,21 @@ module Row_field : sig [@@deriving equal, quickcheck, sexp_of] end +module Row_field_desc : sig + type t = Compiler_types.row_field_desc + [@@deriving equal, quickcheck, sexp_of] +end + module Object_field : sig type t = Compiler_types.object_field [@@deriving equal, quickcheck, sexp_of] end +module Object_field_desc : sig + type t = Compiler_types.object_field_desc + [@@deriving equal, quickcheck, sexp_of] +end + module Pattern : sig type t = Compiler_types.pattern [@@deriving equal, quickcheck, sexp_of] @@ -131,6 +141,16 @@ module Case : sig [@@deriving equal, quickcheck, sexp_of] end +module Letop : sig + type t = Compiler_types.letop + [@@deriving equal, quickcheck, sexp_of] +end + +module Binding_op : sig + type t = Compiler_types.binding_op + [@@deriving equal, quickcheck, sexp_of] +end + module Value_description : sig type t = Compiler_types.value_description [@@deriving equal, quickcheck, sexp_of] @@ -171,6 +191,11 @@ module Extension_constructor : sig [@@deriving equal, quickcheck, sexp_of] end +module Type_exception : sig + type t = Compiler_types.type_exception + [@@deriving equal, quickcheck, sexp_of] +end + module Extension_constructor_kind : sig type t = Compiler_types.extension_constructor_kind [@@deriving equal, quickcheck, sexp_of] @@ -281,16 +306,31 @@ module Module_declaration : sig [@@deriving equal, quickcheck, sexp_of] end +module Module_substitution : sig + type t = Compiler_types.module_substitution + [@@deriving equal, quickcheck, sexp_of] +end + module Module_type_declaration : sig type t = Compiler_types.module_type_declaration [@@deriving equal, quickcheck, sexp_of] end +module Open_infos : sig + type 'a t = 'a Compiler_types.open_infos + [@@deriving equal, quickcheck, sexp_of] +end + module Open_description : sig type t = Compiler_types.open_description [@@deriving equal, quickcheck, sexp_of] end +module Open_declaration : sig + type t = Compiler_types.open_declaration + [@@deriving equal, quickcheck, sexp_of] +end + module Include_infos : sig type 'a t = 'a Compiler_types.include_infos [@@deriving equal, quickcheck, sexp_of] @@ -351,8 +391,18 @@ module Toplevel_phrase : sig [@@deriving equal, quickcheck, sexp_of] end +module Toplevel_directive : sig + type t = Compiler_types.toplevel_directive + [@@deriving equal, quickcheck, sexp_of] +end + module Directive_argument : sig type t = Compiler_types.directive_argument [@@deriving equal, quickcheck, sexp_of] end + +module Directive_argument_desc : sig + type t = Compiler_types.directive_argument_desc + [@@deriving equal, quickcheck, sexp_of] +end (*$*) diff --git a/ast/test/migrations/dune b/ast/test/migrations/dune new file mode 100644 index 00000000..071c27f9 --- /dev/null +++ b/ast/test/migrations/dune @@ -0,0 +1,6 @@ +(library + (name ppx_test_ast_migrations) + (libraries ppx_ast) + (flags (:standard -safe-string)) + (inline_tests) + (preprocess (pps ppx_expect))) diff --git a/ast/test/migrations/migration_07_08.ml b/ast/test/migrations/migration_07_08.ml new file mode 100644 index 00000000..fba49d42 --- /dev/null +++ b/ast/test/migrations/migration_07_08.ml @@ -0,0 +1,583 @@ +open Ppx_ast + +let ok () = print_string "OK" +let ko () = print_string "KO" + +let pos pos_fname = + Astlib.Position.{pos_fname; pos_lnum = 0; pos_bol = 0; pos_cnum = 0} + +let loc n = + let pos = pos n in + Astlib.Location.{loc_start = pos; loc_end = pos; loc_ghost = false} + +let%expect_test "upgrade attribute" = + let attribute_07 = + let open V4_07 in + Attribute.create + ({txt = "x"; loc = loc "name_loc"}, Payload.pstr (Structure.create [])) + in + ( match V4_08.Attribute.to_concrete attribute_07 with + | { attr_loc = {loc_start = {pos_fname = "name_loc"; _}; _}; _ } -> ok () + | _ -> ko () ); + [%expect {|OK|}] + +let%expect_test "downgrade attribute" = + let attribute_08 = + let open V4_08 in + Attribute.create + ~attr_name:{txt = "x"; loc = loc "name_loc"} + ~attr_payload:(Payload.pstr (Structure.create [])) + ~attr_loc:(loc "attr_loc") + in + ( match V4_07.Attribute.to_concrete attribute_08 with + | ({loc = {loc_start = {pos_fname = "name_loc"; _}; _}; _}, _payload) -> + ok () + | _ -> ko () ); + [%expect {|OK|}] + +let%expect_test "upgrade core_type" = + let core_type_07 = + let open V4_07 in + Core_type.create + ~ptyp_loc:(loc "a") + ~ptyp_attributes:(Attributes.create []) + ~ptyp_desc:Core_type_desc.ptyp_any + in + ( match V4_08.Core_type.to_concrete core_type_07 with + | { ptyp_loc_stack = []; _ } -> ok () + | _ -> ko () ); + [%expect {|OK|}] + +let%expect_test "downgrade core_type" = + let core_type_08 = + let open V4_08 in + Core_type.create + ~ptyp_loc:(loc "a") + ~ptyp_attributes:(Attributes.create []) + ~ptyp_desc:Core_type_desc.ptyp_any + ~ptyp_loc_stack:[loc "b"; loc "c"] + in + ( match V4_07.Core_type.to_concrete core_type_08 with + | _ -> ok () ); + [%expect {|OK|}] + +let%expect_test "upgrade rinherit" = + let rinherit_07 = + let open V4_07 in + Row_field.rinherit (ptyp_any ~loc:(loc "a")) + in + let open V4_08 in + ( match Row_field.to_concrete rinherit_07 with + | { prf_loc = { loc_start = { pos_fname = "a"; _ }; _ } + ; prf_attributes + ; prf_desc } -> + let concrete_attr = Attributes.to_concrete prf_attributes in + let concrete_desc = Row_field_desc.to_concrete prf_desc in + ( match concrete_attr, concrete_desc with + | [], Rinherit _ -> ok () + | _ -> ko () ) + | _ -> ko () ); + [%expect {|OK|}] + +let%expect_test "upgrade rtag" = + let rtag_07 = + let open V4_07 in + Row_field.rtag + {txt = "A"; loc = loc "tag"} + ( Attributes.create + [ Attribute.create + ( {txt = "x"; loc = loc "attr"} + , (Payload.pstr (Structure.create [])) ) ] ) + true + [] + in + let open V4_08 in + ( match Row_field.to_concrete rtag_07 with + | { prf_loc = { loc_start = { pos_fname = "tag"; _ }; _ } + ; prf_attributes + ; prf_desc } -> + let concrete_attr = Attributes.to_concrete prf_attributes in + let concrete_desc = Row_field_desc.to_concrete prf_desc in + ( match concrete_attr, concrete_desc with + | [ _ ], Rtag (_, true, []) -> ok () + | _ -> ko () ) + | _ -> ko () ); + [%expect {|OK|}] + +let%expect_test "downgrade rinherit" = + let rinherit_08 = + let open V4_08 in + Row_field.create + ~prf_loc:(loc "a") + ~prf_attributes:(Attributes.create []) + ~prf_desc:(Row_field_desc.rinherit (ptyp_any ~loc:(loc "type"))) + in + ( match V4_07.Row_field.to_concrete rinherit_08 with + | Rinherit _ -> ok () + | _ -> ko () ); + [%expect {|OK|}] + +let%expect_test "downgrade rtag" = + let rtag_08 = + let open V4_08 in + Row_field.create + ~prf_loc:(loc "rwo_field") + ~prf_attributes: + ( Attributes.create + [ Attribute.create + ~attr_name:{txt = "attr"; loc = loc "attr_name"} + ~attr_loc:(loc "attr") + ~attr_payload:(Payload.pstr (Structure.create [])) ] ) + ~prf_desc:(Row_field_desc.rtag {txt = "A"; loc = loc "tag"} true []) + in + let open V4_07 in + ( match Row_field.to_concrete rtag_08 with + | Rtag (_, attributes, true, []) -> + ( match Attributes.to_concrete attributes with + | [ _ ] -> ok () + | _ -> ko () ) + | _ -> ko () ); + [%expect {|OK|}] + +let%expect_test "upgrade oinherit" = + let oinherit_07 = + let open V4_07 in + Object_field.oinherit (ptyp_any ~loc:(loc "a")) + in + let open V4_08 in + ( match Object_field.to_concrete oinherit_07 with + | { pof_loc = { loc_start = { pos_fname = "a"; _ }; _ } + ; pof_attributes + ; pof_desc } -> + let concrete_attr = Attributes.to_concrete pof_attributes in + let concrete_desc = Object_field_desc.to_concrete pof_desc in + ( match concrete_attr, concrete_desc with + | [], Oinherit _ -> ok () + | _ -> ko () ) + | _ -> ko () ); + [%expect {|OK|}] + +let%expect_test "upgrade otag" = + let otag_07 = + let open V4_07 in + Object_field.otag + {txt = "A"; loc = loc "tag"} + ( Attributes.create + [ Attribute.create + ( {txt = "x"; loc = loc "attr"} + , (Payload.pstr (Structure.create [])) ) ] ) + (ptyp_any ~loc:(loc "typ")) + in + let open V4_08 in + ( match Object_field.to_concrete otag_07 with + | { pof_loc = { loc_start = { pos_fname = "tag"; _ }; _ } + ; pof_attributes + ; pof_desc } -> + let concrete_attr = Attributes.to_concrete pof_attributes in + let concrete_desc = Object_field_desc.to_concrete pof_desc in + ( match concrete_attr, concrete_desc with + | [ _ ], Otag _ -> ok () + | _ -> ko () ) + | _ -> ko () ); + [%expect {|OK|}] + +let%expect_test "downgrade oinherit" = + let oinherit_08 = + let open V4_08 in + Object_field.create + ~pof_loc:(loc "a") + ~pof_attributes:(Attributes.create []) + ~pof_desc:(Object_field_desc.oinherit (ptyp_any ~loc:(loc "type"))) + in + ( match V4_07.Object_field.to_concrete oinherit_08 with + | Oinherit _ -> ok () + | _ -> ko () ); + [%expect {|OK|}] + +let%expect_test "downgrade otag" = + let oinherit_08 = + let open V4_08 in + Object_field.create + ~pof_loc:(loc "rwo_field") + ~pof_attributes: + ( Attributes.create + [ Attribute.create + ~attr_name:{txt = "attr"; loc = loc "attr_name"} + ~attr_loc:(loc "attr") + ~attr_payload:(Payload.pstr (Structure.create [])) ] ) + ~pof_desc: + ( Object_field_desc.otag + {txt = "A"; loc = loc "tag"} + (ptyp_any ~loc:(loc "typ")) ) + in + let open V4_07 in + ( match Object_field.to_concrete oinherit_08 with + | Otag (_, attributes, _) -> + ( match Attributes.to_concrete attributes with + | [ _ ] -> ok () + | _ -> ko () ) + | _ -> ko () ); + [%expect {|OK|}] + +let%expect_test "upgrade pattern" = + let pattern_07 = + let open V4_07 in + Pattern.create + ~ppat_loc:(loc "a") + ~ppat_attributes:(Attributes.create []) + ~ppat_desc:Pattern_desc.ppat_any + in + ( match V4_08.Pattern.to_concrete pattern_07 with + | { ppat_loc_stack = []; _ } -> ok () + | _ -> ko () ); + [%expect {|OK|}] + +let%expect_test "downgrade pattern" = + let pattern_08 = + let open V4_08 in + Pattern.create + ~ppat_loc:(loc "a") + ~ppat_attributes:(Attributes.create []) + ~ppat_desc:Pattern_desc.ppat_any + ~ppat_loc_stack:[loc "b"; loc "c"] + in + ( match V4_07.Pattern.to_concrete pattern_08 with + | _ -> ok () ); + [%expect {|OK|}] + +let%expect_test "upgrade expression" = + let expression_07 = + let open V4_07 in + Expression.create + ~pexp_loc:(loc "a") + ~pexp_attributes:(Attributes.create []) + ~pexp_desc:Expression_desc.pexp_unreachable + in + ( match V4_08.Expression.to_concrete expression_07 with + | { pexp_loc_stack = []; _ } -> ok () + | _ -> ko () ); + [%expect {|OK|}] + +let%expect_test "downgrade expression" = + let expression_08 = + let open V4_08 in + Expression.create + ~pexp_loc:(loc "a") + ~pexp_attributes:(Attributes.create []) + ~pexp_desc:Expression_desc.pexp_unreachable + ~pexp_loc_stack:[loc "b"; loc "c"] + in + ( match V4_07.Expression.to_concrete expression_08 with + | _ -> ok () ); + [%expect {|OK|}] + +let%expect_test "upgrade expression_desc any" = + let edesc_07 = V4_07.Expression_desc.pexp_unreachable in + ( match V4_08.Expression_desc.to_concrete edesc_07 with + | Pexp_unreachable -> ok () + | _ -> ko () ); + [%expect {|OK|}] + +let%expect_test "downgrade expression_desc any" = + let edesc_08 = V4_08.Expression_desc.pexp_unreachable in + ( match V4_07.Expression_desc.to_concrete edesc_08 with + | Pexp_unreachable -> ok () + | _ -> ko () ); + [%expect {|OK|}] + +let%expect_test "upgrade pexp_open" = + let pexp_open_07 = + let open V4_07 in + Expression_desc.pexp_open + Override_flag.fresh + (Longident_loc.create { txt = Longident.lident "A"; loc = loc "li" }) + (pexp_unreachable ~loc:(loc "expr")) + in + let open V4_08 in + ( match Expression_desc.to_concrete pexp_open_07 with + | Pexp_open (open_decl, _expr) -> + let open_decl = Open_declaration.to_concrete open_decl in + let open_infos = Open_infos.to_concrete open_decl in + let oi_loc = open_infos.popen_loc.loc_start.pos_fname in + let attr = Attributes.to_concrete open_infos.popen_attributes in + let mod_expr = Module_expr.to_concrete open_infos.popen_expr in + let me_loc = mod_expr.pmod_loc.loc_start.pos_fname in + let me_desc = Module_expr_desc.to_concrete mod_expr.pmod_desc in + let me_attr = Attributes.to_concrete mod_expr.pmod_attributes in + ( match attr, me_attr, oi_loc, me_loc, me_desc with + | [], [], "li", "li", Pmod_ident _ -> ok () + | _ -> ko () ) + | _ -> ko () ); + [%expect {|OK|}] + +let%expect_test "downgrade pexp_open" = + let pexp_open_08 = + let open V4_08 in + Expression_desc.pexp_open + (Open_declaration.create + (Open_infos.create + ~popen_expr: + (pmod_ident + ~loc:(loc "me") + (Longident_loc.create + { txt = Longident.lident "A"; loc = loc "li" })) + ~popen_override:Override_flag.fresh + ~popen_loc:(loc "open_infos") + ~popen_attributes:(Attributes.create []))) + (pexp_unreachable ~loc:(loc "expr")) + in + ( match V4_07.Expression_desc.to_concrete pexp_open_08 with + | Pexp_open (_flag, _li, _expr) -> ok () + | _ -> ko () ); + [%expect {|OK|}] + +let%expect_test "downgrade pexp_letop" = + let pexp_letop = + let open V4_08 in + Expression_desc.pexp_letop + (Letop.create + ~let_: + (Binding_op.create + ~pbop_op:{txt = "+"; loc = loc "a"} + ~pbop_pat:(ppat_any ~loc:(loc "b")) + ~pbop_exp:(pexp_unreachable ~loc:(loc "c")) + ~pbop_loc:(loc "d")) + ~ands:[] + ~body:(pexp_unreachable ~loc:(loc "e"))) + in + ( match V4_07.Expression_desc.to_concrete_opt pexp_letop with + | None -> ok () + | _ -> ko () ); + [%expect {|OK|}] + +let%expect_test "upgrade pcty_open" = + let pcty_open_07 = + let open V4_07 in + Class_type_desc.pcty_open + Override_flag.fresh + (Longident_loc.create {txt = Longident.lident "A"; loc = loc "li"}) + (Class_type.create + ~pcty_loc:(loc "ct") + ~pcty_attributes:(Attributes.create []) + ~pcty_desc: + (Class_type_desc.pcty_constr + (Longident_loc.create + {txt = Longident.lident "B"; loc = loc "li_const"}) + [])) + in + let open V4_08 in + ( match Class_type_desc.to_concrete pcty_open_07 with + | Pcty_open (open_desc, _) -> + let open_desc = Open_description.to_concrete open_desc in + let open_infos = Open_infos.to_concrete open_desc in + let attributes = Attributes.to_concrete open_infos.popen_attributes in + let loc = open_infos.popen_loc.loc_start.pos_fname in + ( match attributes, loc with + | [], "li" -> ok () + | _ -> ko () ) + | _ -> ko () ); + [%expect {|OK|}] + +let%expect_test "upgrade type_extension" = + let type_ext_07 = + let open V4_07 in + Type_extension.create + ~ptyext_path: + (Longident_loc.create + {txt = Longident.lident "a"; loc = loc "ptyext_path"}) + ~ptyext_params:[] + ~ptyext_constructors:[] + ~ptyext_private:Private_flag.public + ~ptyext_attributes:(Attributes.create []) + in + ( match V4_08.Type_extension.to_concrete type_ext_07 with + | { ptyext_loc = {loc_start = {pos_fname = "ptyext_path"; _}; _}; _} -> + ok () + | _ -> ko () ); + [%expect {|OK|}] + +let%expect_test "downgrade type_extension" = + let type_ext_07 = + let open V4_08 in + Type_extension.create + ~ptyext_path: + (Longident_loc.create + {txt = Longident.lident "a"; loc = loc "ptyext_path"}) + ~ptyext_params:[] + ~ptyext_constructors:[] + ~ptyext_private:Private_flag.public + ~ptyext_loc:(loc "ptyext") + ~ptyext_attributes:(Attributes.create []) + in + match V4_07.Type_extension.to_concrete type_ext_07 with + | _ -> ok (); + [%expect {|OK|}] + +let%expect_test "upgrade pstr_exception" = + let pstr_exception_07 = + let open V4_07 in + Structure_item_desc.pstr_exception + (Extension_constructor.create + ~pext_name:{txt = "a"; loc = loc "pext_name"} + ~pext_loc:(loc "pext") + ~pext_attributes:(Attributes.create []) + ~pext_kind: + (Extension_constructor_kind.pext_rebind + (Longident_loc.create + {loc = loc "pext_kind"; txt = Longident.lident "i"}))) + in + let open V4_08 in + ( match Structure_item_desc.to_concrete pstr_exception_07 with + | Pstr_exception type_exc -> + ( match Type_exception.to_concrete type_exc with + | { ptyexn_constructor + ; ptyexn_attributes + ; ptyexn_loc = {loc_start = {pos_fname = "pext"; _}; _} } -> + let attributes = Attributes.to_concrete ptyexn_attributes in + let ext_ctor = Extension_constructor.to_concrete ptyexn_constructor in + ( match attributes, ext_ctor with + | [], _ -> ok () + | _ -> ko () ) + | _ -> ko () ) + | _ -> ko () ); + [%expect {|OK|}] + +let%expect_test "downgrade pstr_exception" = + let pstr_exception_07 = + let open V4_08 in + Structure_item_desc.pstr_exception + (Type_exception.create + ~ptyexn_loc:(loc "ptyexn") + ~ptyexn_attributes:(Attributes.create []) + ~ptyexn_constructor: + (Extension_constructor.create + ~pext_name:{txt = "a"; loc = loc "pext_name"} + ~pext_loc:(loc "pext") + ~pext_attributes:(Attributes.create []) + ~pext_kind: + (Extension_constructor_kind.pext_rebind + (Longident_loc.create + {loc = loc "pext_kind"; txt = Longident.lident "i"})))) + in + let open V4_07 in + ( match Structure_item_desc.to_concrete pstr_exception_07 with + | Pstr_exception _ -> ok () + | _ -> ko () ); + [%expect {|OK|}] + +let%expect_test "upgrade pstr_open" = + let pstr_open_07 = + let open V4_07 in + Structure_item_desc.pstr_open + (Open_description.create + ~popen_lid: + (Longident_loc.create {txt = Longident.lident "A"; loc = loc "a"}) + ~popen_loc:(loc "b") + ~popen_override:Override_flag.fresh + ~popen_attributes:(Attributes.create [])) + in + let open V4_08 in + ( match Structure_item_desc.to_concrete pstr_open_07 with + | Pstr_open open_decl -> + let open_decl = Open_declaration.to_concrete open_decl in + let open_infos = Open_infos.to_concrete open_decl in + let mod_expr = Module_expr.to_concrete open_infos.popen_expr in + let loc = mod_expr.pmod_loc.loc_start.pos_fname in + let attributes = Attributes.to_concrete mod_expr.pmod_attributes in + let desc = Module_expr_desc.to_concrete mod_expr.pmod_desc in + ( match loc, attributes, desc with + | "a", [], Pmod_ident _ -> ok () + | _ -> ko () ) + | _ -> ko () ); + [%expect {|OK|}] + +let%expect_test "downgrade pstr_open" = + let pstr_open_08 = + let open V4_08 in + Structure_item_desc.pstr_open + (Open_declaration.create + (Open_infos.create + ~popen_loc:(loc "a") + ~popen_override:Override_flag.fresh + ~popen_attributes:(Attributes.create []) + ~popen_expr: + (pmod_ident + ~loc:(loc "b") + (Longident_loc.create + {txt = Longident.lident "A"; loc = loc "c"})))) + in + let open V4_07 in + ( match Structure_item_desc.to_concrete pstr_open_08 with + | Pstr_open open_desc -> + let _ = Open_description.to_concrete open_desc in + ok () + | _ -> ko () ); + [%expect {|OK|}] + +let%expect_test "upgrade ptop_dir pdir_none" = + let ptop_dir_07 = + let open V4_07 in + Toplevel_phrase.ptop_dir "a" (Directive_argument.pdir_none) + in + let open V4_08 in + ( match Toplevel_phrase.to_concrete ptop_dir_07 with + | Ptop_dir directive -> + ( match Toplevel_directive.to_concrete directive with + | {pdir_name = {txt = "a"; _}; pdir_arg = None; _} -> ok () + | _ -> ko () ) + | _ -> ko () ); + [%expect {|OK|}] + +let%expect_test "downgrade ptop_dir pdir_none" = + let ptop_dir_08 = + let open V4_08 in + Toplevel_phrase.ptop_dir + (Toplevel_directive.create + ~pdir_name:{txt = "a"; loc = loc ""} + ~pdir_loc:(loc "") + ~pdir_arg:None) + in + let open V4_07 in + ( match Toplevel_phrase.to_concrete ptop_dir_08 with + | Ptop_dir ("a", arg) -> + ( match Directive_argument.to_concrete arg with + | Pdir_none -> ok () + | _ -> ko () ) + | _ -> ko () ); + [%expect {|OK|}] + +let%expect_test "upgrade ptop_dir" = + let ptop_dir_07 = + let open V4_07 in + Toplevel_phrase.ptop_dir "a" (Directive_argument.pdir_string "b") + in + let open V4_08 in + ( match Toplevel_phrase.to_concrete ptop_dir_07 with + | Ptop_dir directive -> + ( match Toplevel_directive.to_concrete directive with + | {pdir_name = {txt = "a"; _}; pdir_arg = Some _; _} -> ok () + | _ -> ko () ) + | _ -> ko () ); + [%expect {|OK|}] + +let%expect_test "downgrade ptop_dir" = + let ptop_dir_08 = + let open V4_08 in + Toplevel_phrase.ptop_dir + (Toplevel_directive.create + ~pdir_name:{txt = "a"; loc = loc ""} + ~pdir_loc:(loc "") + ~pdir_arg: + (Some + (Directive_argument.create + ~pdira_loc:(loc "") + ~pdira_desc:(Directive_argument_desc.pdir_string "b")))) + in + let open V4_07 in + ( match Toplevel_phrase.to_concrete ptop_dir_08 with + | Ptop_dir ("a", arg) -> + ( match Directive_argument.to_concrete arg with + | Pdir_string "b" -> ok () + | _ -> ko () ) + | _ -> ko () ); + [%expect {|OK|}] diff --git a/ast/test/ppx_ast_tests.ml b/ast/test/ppx_ast_tests.ml index 813fccb0..a3b9abea 100644 --- a/ast/test/ppx_ast_tests.ml +++ b/ast/test/ppx_ast_tests.ml @@ -2,38 +2,44 @@ open Base_quickcheck open Ppx_ast open Expect_test_helpers_kernel -(*$ Ppx_ast_tests_cinaps.print_test_ml () *) -let config = { Test.default_config with test_count = 1_000 } +let config = { Test.default_config with test_count = 1000 } +(*$ Ppx_ast_tests_cinaps.print_test_ml () *) module Unstable_for_testing = struct let%expect_test "toplevel_phrase" = Test.run_exn ~config (module Deriving.Toplevel_phrase) ~f:(fun x -> - require_equal [%here] (module Deriving.Toplevel_phrase) x - (Conversion.ast_to_toplevel_phrase - ((new Unstable_for_testing.map)#toplevel_phrase - (Conversion.ast_of_toplevel_phrase x)))); + try + require_equal [%here] (module Deriving.Toplevel_phrase) x + (Conversion.ast_to_toplevel_phrase + ((new Unstable_for_testing.map)#toplevel_phrase + (Conversion.ast_of_toplevel_phrase x))) + with Unversioned.Private.Cannot_interpret_ast _ -> ()); [%expect {| |}] let%expect_test "structure" = Test.run_exn ~config (module Deriving.Structure) ~f:(fun x -> - require_equal [%here] (module Deriving.Structure) x - (Conversion.ast_to_structure - ((new Unstable_for_testing.map)#structure - (Conversion.ast_of_structure x)))); + try + require_equal [%here] (module Deriving.Structure) x + (Conversion.ast_to_structure + ((new Unstable_for_testing.map)#structure + (Conversion.ast_of_structure x))) + with Unversioned.Private.Cannot_interpret_ast _ -> ()); [%expect {| |}] let%expect_test "signature" = Test.run_exn ~config (module Deriving.Signature) ~f:(fun x -> - require_equal [%here] (module Deriving.Signature) x - (Conversion.ast_to_signature - ((new Unstable_for_testing.map)#signature - (Conversion.ast_of_signature x)))); + try + require_equal [%here] (module Deriving.Signature) x + (Conversion.ast_to_signature + ((new Unstable_for_testing.map)#signature + (Conversion.ast_of_signature x))) + with Unversioned.Private.Cannot_interpret_ast _ -> ()); [%expect {| |}] end @@ -42,30 +48,74 @@ module V4_07 = struct Test.run_exn ~config (module Deriving.Signature) ~f:(fun x -> - require_equal [%here] (module Deriving.Signature) x - (Conversion.ast_to_signature - ((new V4_07.map)#signature - (Conversion.ast_of_signature x)))); + try + require_equal [%here] (module Deriving.Signature) x + (Conversion.ast_to_signature + ((new V4_07.map)#signature + (Conversion.ast_of_signature x))) + with Unversioned.Private.Cannot_interpret_ast _ -> ()); + [%expect {| |}] + + let%expect_test "structure" = + Test.run_exn ~config + (module Deriving.Structure) + ~f:(fun x -> + try + require_equal [%here] (module Deriving.Structure) x + (Conversion.ast_to_structure + ((new V4_07.map)#structure + (Conversion.ast_of_structure x))) + with Unversioned.Private.Cannot_interpret_ast _ -> ()); + [%expect {| |}] + + let%expect_test "toplevel_phrase" = + Test.run_exn ~config + (module Deriving.Toplevel_phrase) + ~f:(fun x -> + try + require_equal [%here] (module Deriving.Toplevel_phrase) x + (Conversion.ast_to_toplevel_phrase + ((new V4_07.map)#toplevel_phrase + (Conversion.ast_of_toplevel_phrase x))) + with Unversioned.Private.Cannot_interpret_ast _ -> ()); + [%expect {| |}] +end + +module V4_08 = struct + let%expect_test "signature" = + Test.run_exn ~config + (module Deriving.Signature) + ~f:(fun x -> + try + require_equal [%here] (module Deriving.Signature) x + (Conversion.ast_to_signature + ((new V4_08.map)#signature + (Conversion.ast_of_signature x))) + with Unversioned.Private.Cannot_interpret_ast _ -> ()); [%expect {| |}] let%expect_test "structure" = Test.run_exn ~config (module Deriving.Structure) ~f:(fun x -> - require_equal [%here] (module Deriving.Structure) x - (Conversion.ast_to_structure - ((new V4_07.map)#structure - (Conversion.ast_of_structure x)))); + try + require_equal [%here] (module Deriving.Structure) x + (Conversion.ast_to_structure + ((new V4_08.map)#structure + (Conversion.ast_of_structure x))) + with Unversioned.Private.Cannot_interpret_ast _ -> ()); [%expect {| |}] let%expect_test "toplevel_phrase" = Test.run_exn ~config (module Deriving.Toplevel_phrase) ~f:(fun x -> - require_equal [%here] (module Deriving.Toplevel_phrase) x - (Conversion.ast_to_toplevel_phrase - ((new V4_07.map)#toplevel_phrase - (Conversion.ast_of_toplevel_phrase x)))); + try + require_equal [%here] (module Deriving.Toplevel_phrase) x + (Conversion.ast_to_toplevel_phrase + ((new V4_08.map)#toplevel_phrase + (Conversion.ast_of_toplevel_phrase x))) + with Unversioned.Private.Cannot_interpret_ast _ -> ()); [%expect {| |}] end (*$*) diff --git a/ast/traverse.ml b/ast/traverse.ml index 874caa95..ab86e4f6 100644 --- a/ast/traverse.ml +++ b/ast/traverse.ml @@ -1,2 +1,3 @@ +module V4_08 = Traverse_v4_08 module V4_07 = Traverse_v4_07 module Unstable_for_testing = Traverse_unstable_for_testing diff --git a/ast/traverse.mli b/ast/traverse.mli index 874caa95..ab86e4f6 100644 --- a/ast/traverse.mli +++ b/ast/traverse.mli @@ -1,2 +1,3 @@ +module V4_08 = Traverse_v4_08 module V4_07 = Traverse_v4_07 module Unstable_for_testing = Traverse_unstable_for_testing diff --git a/ast/traverse_v4_08.ml b/ast/traverse_v4_08.ml new file mode 100644 index 00000000..b5c923b9 --- /dev/null +++ b/ast/traverse_v4_08.ml @@ -0,0 +1,37 @@ +(*$ Ppx_ast_cinaps.print_traverse_ml (Astlib.Version.of_string "V4_07") *) +class map = + object + inherit Traverse_builtins.map + inherit Virtual_traverse.V4_07.map + end + +class iter = + object + inherit Traverse_builtins.iter + inherit Virtual_traverse.V4_07.iter + end + +class ['acc] fold = + object + inherit ['acc] Traverse_builtins.fold + inherit ['acc] Virtual_traverse.V4_07.fold + end + +class ['acc] fold_map = + object + inherit ['acc] Traverse_builtins.fold_map + inherit ['acc] Virtual_traverse.V4_07.fold_map + end + +class ['ctx] map_with_context = + object + inherit ['ctx] Traverse_builtins.map_with_context + inherit ['ctx] Virtual_traverse.V4_07.map_with_context + end + +class virtual ['res] lift = + object + inherit ['res] Traverse_builtins.lift + inherit ['res] Virtual_traverse.V4_07.lift + end +(*$*) diff --git a/ast/traverse_v4_08.mli b/ast/traverse_v4_08.mli new file mode 100644 index 00000000..6bec8869 --- /dev/null +++ b/ast/traverse_v4_08.mli @@ -0,0 +1,37 @@ +(*$ Ppx_ast_cinaps.print_traverse_mli (Astlib.Version.of_string "V4_07") *) +class map : + object + inherit Traverse_builtins.map + inherit Virtual_traverse.V4_07.map + end + +class iter : + object + inherit Traverse_builtins.iter + inherit Virtual_traverse.V4_07.iter + end + +class ['acc] fold : + object + inherit ['acc] Traverse_builtins.fold + inherit ['acc] Virtual_traverse.V4_07.fold + end + +class ['acc] fold_map : + object + inherit ['acc] Traverse_builtins.fold_map + inherit ['acc] Virtual_traverse.V4_07.fold_map + end + +class ['ctx] map_with_context : + object + inherit ['ctx] Traverse_builtins.map_with_context + inherit ['ctx] Virtual_traverse.V4_07.map_with_context + end + +class virtual ['res] lift : + object + inherit ['res] Traverse_builtins.lift + inherit ['res] Virtual_traverse.V4_07.lift + end +(*$*) diff --git a/ast/unversioned.ml b/ast/unversioned.ml index abd7dbc0..da686fed 100644 --- a/ast/unversioned.ml +++ b/ast/unversioned.ml @@ -5,6 +5,7 @@ module Types = struct type arg_label_ type attribute_ type attributes_ + type binding_op_ type case_ type class_declaration_ type class_description_ @@ -29,6 +30,7 @@ module Types = struct type core_type_desc_ type direction_flag_ type directive_argument_ + type directive_argument_desc_ type expression_ type expression_desc_ type extension_ @@ -38,18 +40,23 @@ module Types = struct type include_description_ type 'a include_infos_ type label_declaration_ + type letop_ type longident_ type longident_loc_ type module_binding_ type module_declaration_ type module_expr_ type module_expr_desc_ + type module_substitution_ type module_type_ type module_type_declaration_ type module_type_desc_ type mutable_flag_ type object_field_ + type object_field_desc_ + type open_declaration_ type open_description_ + type 'a open_infos_ type override_flag_ type package_type_ type pattern_ @@ -58,14 +65,17 @@ module Types = struct type private_flag_ type rec_flag_ type row_field_ + type row_field_desc_ type signature_ type signature_item_ type signature_item_desc_ type structure_ type structure_item_ type structure_item_desc_ + type toplevel_directive_ type toplevel_phrase_ type type_declaration_ + type type_exception_ type type_extension_ type type_kind_ type value_binding_ @@ -77,6 +87,7 @@ module Types = struct type arg_label = arg_label_ node type attribute = attribute_ node type attributes = attributes_ node + type binding_op = binding_op_ node type case = case_ node type class_declaration = class_declaration_ node type class_description = class_description_ node @@ -101,6 +112,7 @@ module Types = struct type core_type_desc = core_type_desc_ node type direction_flag = direction_flag_ node type directive_argument = directive_argument_ node + type directive_argument_desc = directive_argument_desc_ node type expression = expression_ node type expression_desc = expression_desc_ node type extension = extension_ node @@ -110,18 +122,23 @@ module Types = struct type include_description = include_description_ node type 'a include_infos = 'a include_infos_ node type label_declaration = label_declaration_ node + type letop = letop_ node type longident = longident_ node type longident_loc = longident_loc_ node type module_binding = module_binding_ node type module_declaration = module_declaration_ node type module_expr = module_expr_ node type module_expr_desc = module_expr_desc_ node + type module_substitution = module_substitution_ node type module_type = module_type_ node type module_type_declaration = module_type_declaration_ node type module_type_desc = module_type_desc_ node type mutable_flag = mutable_flag_ node type object_field = object_field_ node + type object_field_desc = object_field_desc_ node + type open_declaration = open_declaration_ node type open_description = open_description_ node + type 'a open_infos = 'a open_infos_ node type override_flag = override_flag_ node type package_type = package_type_ node type pattern = pattern_ node @@ -130,14 +147,17 @@ module Types = struct type private_flag = private_flag_ node type rec_flag = rec_flag_ node type row_field = row_field_ node + type row_field_desc = row_field_desc_ node type signature = signature_ node type signature_item = signature_item_ node type signature_item_desc = signature_item_desc_ node type structure = structure_ node type structure_item = structure_item_ node type structure_item_desc = structure_item_desc_ node + type toplevel_directive = toplevel_directive_ node type toplevel_phrase = toplevel_phrase_ node type type_declaration = type_declaration_ node + type type_exception = type_exception_ node type type_extension = type_extension_ node type type_kind = type_kind_ node type value_binding = value_binding_ node diff --git a/ast/unversioned.mli b/ast/unversioned.mli index b1b107df..75482890 100644 --- a/ast/unversioned.mli +++ b/ast/unversioned.mli @@ -5,6 +5,7 @@ module Types : sig type arg_label_ type attribute_ type attributes_ + type binding_op_ type case_ type class_declaration_ type class_description_ @@ -29,6 +30,7 @@ module Types : sig type core_type_desc_ type direction_flag_ type directive_argument_ + type directive_argument_desc_ type expression_ type expression_desc_ type extension_ @@ -38,18 +40,23 @@ module Types : sig type include_description_ type 'a include_infos_ type label_declaration_ + type letop_ type longident_ type longident_loc_ type module_binding_ type module_declaration_ type module_expr_ type module_expr_desc_ + type module_substitution_ type module_type_ type module_type_declaration_ type module_type_desc_ type mutable_flag_ type object_field_ + type object_field_desc_ + type open_declaration_ type open_description_ + type 'a open_infos_ type override_flag_ type package_type_ type pattern_ @@ -58,14 +65,17 @@ module Types : sig type private_flag_ type rec_flag_ type row_field_ + type row_field_desc_ type signature_ type signature_item_ type signature_item_desc_ type structure_ type structure_item_ type structure_item_desc_ + type toplevel_directive_ type toplevel_phrase_ type type_declaration_ + type type_exception_ type type_extension_ type type_kind_ type value_binding_ @@ -77,6 +87,7 @@ module Types : sig type arg_label = arg_label_ node type attribute = attribute_ node type attributes = attributes_ node + type binding_op = binding_op_ node type case = case_ node type class_declaration = class_declaration_ node type class_description = class_description_ node @@ -101,6 +112,7 @@ module Types : sig type core_type_desc = core_type_desc_ node type direction_flag = direction_flag_ node type directive_argument = directive_argument_ node + type directive_argument_desc = directive_argument_desc_ node type expression = expression_ node type expression_desc = expression_desc_ node type extension = extension_ node @@ -110,18 +122,23 @@ module Types : sig type include_description = include_description_ node type 'a include_infos = 'a include_infos_ node type label_declaration = label_declaration_ node + type letop = letop_ node type longident = longident_ node type longident_loc = longident_loc_ node type module_binding = module_binding_ node type module_declaration = module_declaration_ node type module_expr = module_expr_ node type module_expr_desc = module_expr_desc_ node + type module_substitution = module_substitution_ node type module_type = module_type_ node type module_type_declaration = module_type_declaration_ node type module_type_desc = module_type_desc_ node type mutable_flag = mutable_flag_ node type object_field = object_field_ node + type object_field_desc = object_field_desc_ node + type open_declaration = open_declaration_ node type open_description = open_description_ node + type 'a open_infos = 'a open_infos_ node type override_flag = override_flag_ node type package_type = package_type_ node type pattern = pattern_ node @@ -130,14 +147,17 @@ module Types : sig type private_flag = private_flag_ node type rec_flag = rec_flag_ node type row_field = row_field_ node + type row_field_desc = row_field_desc_ node type signature = signature_ node type signature_item = signature_item_ node type signature_item_desc = signature_item_desc_ node type structure = structure_ node type structure_item = structure_item_ node type structure_item_desc = structure_item_desc_ node + type toplevel_directive = toplevel_directive_ node type toplevel_phrase = toplevel_phrase_ node type type_declaration = type_declaration_ node + type type_exception = type_exception_ node type type_extension = type_extension_ node type type_kind = type_kind_ node type value_binding = value_binding_ node diff --git a/ast/version_v4_08.ml b/ast/version_v4_08.ml new file mode 100644 index 00000000..c725df64 --- /dev/null +++ b/ast/version_v4_08.ml @@ -0,0 +1,6025 @@ +open Stdppx +open Unversioned.Types + +(*$ Ppx_ast_cinaps.print_version_ml (Astlib.Version.of_string "v4_08") *) +let version = Astlib.Version.of_string "v4_08" +let node name data = Unversioned.Private.opaque (Node.wrap ~version { name; data }) + +module Longident = struct + type t = longident + + type concrete = + | Lident of string + | Ldot of longident * string + | Lapply of longident * longident + + let lident x1 = + node "longident" + (Variant + { tag = "Lident" + ; args = + [| Data.of_string x1 + |] + }) + let ldot x1 x2 = + node "longident" + (Variant + { tag = "Ldot" + ; args = + [| Data.of_node x1 + ; Data.of_string x2 + |] + }) + let lapply x1 x2 = + node "longident" + (Variant + { tag = "Lapply" + ; args = + [| Data.of_node x1 + ; Data.of_node x2 + |] + }) + + let of_concrete c = + match c with + | Lident (x1) -> + lident x1 + | Ldot (x1, x2) -> + ldot x1 x2 + | Lapply (x1, x2) -> + lapply x1 x2 + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "longident"; data } -> + begin + match data with + | Variant { tag = "Lident"; args = [| x1 |] } -> + Option.bind (Data.to_string x1) ~f:(fun x1 -> + Some (Lident (x1)) + ) + | Variant { tag = "Ldot"; args = [| x1; x2 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind (Data.to_string x2) ~f:(fun x2 -> + Some (Ldot (x1, x2)) + )) + | Variant { tag = "Lapply"; args = [| x1; x2 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind (Data.to_node x2) ~f:(fun x2 -> + Some (Lapply (x1, x2)) + )) + | _ -> None + end + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "longident"; + node = Unversioned.Private.transparent node; + }) +end + +module Longident_loc = struct + type t = longident_loc + + type concrete = longident Astlib.Loc.t + + let create = + let data = (Data.of_loc ~f:Data.of_node) in + fun x -> node "longident_loc" (data x) + + let of_concrete = create + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "longident_loc"; data } -> (Data.to_loc ~f:Data.to_node) data + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "longident_loc"; + node = Unversioned.Private.transparent node; + }) +end + +module Rec_flag = struct + type t = rec_flag + + type concrete = + | Nonrecursive + | Recursive + + let nonrecursive = + node "rec_flag" (Variant { tag = "Nonrecursive"; args = [||] }) + let recursive = + node "rec_flag" (Variant { tag = "Recursive"; args = [||] }) + + let of_concrete c = + match c with + | Nonrecursive -> nonrecursive + | Recursive -> recursive + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "rec_flag"; data } -> + begin + match data with + | Variant { tag = "Nonrecursive"; args = [||] } -> Some Nonrecursive + | Variant { tag = "Recursive"; args = [||] } -> Some Recursive + | _ -> None + end + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "rec_flag"; + node = Unversioned.Private.transparent node; + }) +end + +module Direction_flag = struct + type t = direction_flag + + type concrete = + | Upto + | Downto + + let upto = + node "direction_flag" (Variant { tag = "Upto"; args = [||] }) + let downto_ = + node "direction_flag" (Variant { tag = "Downto"; args = [||] }) + + let of_concrete c = + match c with + | Upto -> upto + | Downto -> downto_ + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "direction_flag"; data } -> + begin + match data with + | Variant { tag = "Upto"; args = [||] } -> Some Upto + | Variant { tag = "Downto"; args = [||] } -> Some Downto + | _ -> None + end + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "direction_flag"; + node = Unversioned.Private.transparent node; + }) +end + +module Private_flag = struct + type t = private_flag + + type concrete = + | Private + | Public + + let private_ = + node "private_flag" (Variant { tag = "Private"; args = [||] }) + let public = + node "private_flag" (Variant { tag = "Public"; args = [||] }) + + let of_concrete c = + match c with + | Private -> private_ + | Public -> public + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "private_flag"; data } -> + begin + match data with + | Variant { tag = "Private"; args = [||] } -> Some Private + | Variant { tag = "Public"; args = [||] } -> Some Public + | _ -> None + end + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "private_flag"; + node = Unversioned.Private.transparent node; + }) +end + +module Mutable_flag = struct + type t = mutable_flag + + type concrete = + | Immutable + | Mutable + + let immutable = + node "mutable_flag" (Variant { tag = "Immutable"; args = [||] }) + let mutable_ = + node "mutable_flag" (Variant { tag = "Mutable"; args = [||] }) + + let of_concrete c = + match c with + | Immutable -> immutable + | Mutable -> mutable_ + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "mutable_flag"; data } -> + begin + match data with + | Variant { tag = "Immutable"; args = [||] } -> Some Immutable + | Variant { tag = "Mutable"; args = [||] } -> Some Mutable + | _ -> None + end + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "mutable_flag"; + node = Unversioned.Private.transparent node; + }) +end + +module Virtual_flag = struct + type t = virtual_flag + + type concrete = + | Virtual + | Concrete + + let virtual_ = + node "virtual_flag" (Variant { tag = "Virtual"; args = [||] }) + let concrete = + node "virtual_flag" (Variant { tag = "Concrete"; args = [||] }) + + let of_concrete c = + match c with + | Virtual -> virtual_ + | Concrete -> concrete + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "virtual_flag"; data } -> + begin + match data with + | Variant { tag = "Virtual"; args = [||] } -> Some Virtual + | Variant { tag = "Concrete"; args = [||] } -> Some Concrete + | _ -> None + end + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "virtual_flag"; + node = Unversioned.Private.transparent node; + }) +end + +module Override_flag = struct + type t = override_flag + + type concrete = + | Override + | Fresh + + let override = + node "override_flag" (Variant { tag = "Override"; args = [||] }) + let fresh = + node "override_flag" (Variant { tag = "Fresh"; args = [||] }) + + let of_concrete c = + match c with + | Override -> override + | Fresh -> fresh + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "override_flag"; data } -> + begin + match data with + | Variant { tag = "Override"; args = [||] } -> Some Override + | Variant { tag = "Fresh"; args = [||] } -> Some Fresh + | _ -> None + end + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "override_flag"; + node = Unversioned.Private.transparent node; + }) +end + +module Closed_flag = struct + type t = closed_flag + + type concrete = + | Closed + | Open + + let closed = + node "closed_flag" (Variant { tag = "Closed"; args = [||] }) + let open_ = + node "closed_flag" (Variant { tag = "Open"; args = [||] }) + + let of_concrete c = + match c with + | Closed -> closed + | Open -> open_ + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "closed_flag"; data } -> + begin + match data with + | Variant { tag = "Closed"; args = [||] } -> Some Closed + | Variant { tag = "Open"; args = [||] } -> Some Open + | _ -> None + end + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "closed_flag"; + node = Unversioned.Private.transparent node; + }) +end + +module Arg_label = struct + type t = arg_label + + type concrete = + | Nolabel + | Labelled of string + | Optional of string + + let nolabel = + node "arg_label" (Variant { tag = "Nolabel"; args = [||] }) + let labelled x1 = + node "arg_label" + (Variant + { tag = "Labelled" + ; args = + [| Data.of_string x1 + |] + }) + let optional x1 = + node "arg_label" + (Variant + { tag = "Optional" + ; args = + [| Data.of_string x1 + |] + }) + + let of_concrete c = + match c with + | Nolabel -> nolabel + | Labelled (x1) -> + labelled x1 + | Optional (x1) -> + optional x1 + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "arg_label"; data } -> + begin + match data with + | Variant { tag = "Nolabel"; args = [||] } -> Some Nolabel + | Variant { tag = "Labelled"; args = [| x1 |] } -> + Option.bind (Data.to_string x1) ~f:(fun x1 -> + Some (Labelled (x1)) + ) + | Variant { tag = "Optional"; args = [| x1 |] } -> + Option.bind (Data.to_string x1) ~f:(fun x1 -> + Some (Optional (x1)) + ) + | _ -> None + end + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "arg_label"; + node = Unversioned.Private.transparent node; + }) +end + +module Variance = struct + type t = variance + + type concrete = + | Covariant + | Contravariant + | Invariant + + let covariant = + node "variance" (Variant { tag = "Covariant"; args = [||] }) + let contravariant = + node "variance" (Variant { tag = "Contravariant"; args = [||] }) + let invariant = + node "variance" (Variant { tag = "Invariant"; args = [||] }) + + let of_concrete c = + match c with + | Covariant -> covariant + | Contravariant -> contravariant + | Invariant -> invariant + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "variance"; data } -> + begin + match data with + | Variant { tag = "Covariant"; args = [||] } -> Some Covariant + | Variant { tag = "Contravariant"; args = [||] } -> Some Contravariant + | Variant { tag = "Invariant"; args = [||] } -> Some Invariant + | _ -> None + end + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "variance"; + node = Unversioned.Private.transparent node; + }) +end + +module Constant = struct + type t = constant + + type concrete = + | Pconst_integer of string * char option + | Pconst_char of char + | Pconst_string of string * string option + | Pconst_float of string * char option + + let pconst_integer x1 x2 = + node "constant" + (Variant + { tag = "Pconst_integer" + ; args = + [| Data.of_string x1 + ; (Data.of_option ~f:Data.of_char) x2 + |] + }) + let pconst_char x1 = + node "constant" + (Variant + { tag = "Pconst_char" + ; args = + [| Data.of_char x1 + |] + }) + let pconst_string x1 x2 = + node "constant" + (Variant + { tag = "Pconst_string" + ; args = + [| Data.of_string x1 + ; (Data.of_option ~f:Data.of_string) x2 + |] + }) + let pconst_float x1 x2 = + node "constant" + (Variant + { tag = "Pconst_float" + ; args = + [| Data.of_string x1 + ; (Data.of_option ~f:Data.of_char) x2 + |] + }) + + let of_concrete c = + match c with + | Pconst_integer (x1, x2) -> + pconst_integer x1 x2 + | Pconst_char (x1) -> + pconst_char x1 + | Pconst_string (x1, x2) -> + pconst_string x1 x2 + | Pconst_float (x1, x2) -> + pconst_float x1 x2 + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "constant"; data } -> + begin + match data with + | Variant { tag = "Pconst_integer"; args = [| x1; x2 |] } -> + Option.bind (Data.to_string x1) ~f:(fun x1 -> + Option.bind ((Data.to_option ~f:Data.to_char) x2) ~f:(fun x2 -> + Some (Pconst_integer (x1, x2)) + )) + | Variant { tag = "Pconst_char"; args = [| x1 |] } -> + Option.bind (Data.to_char x1) ~f:(fun x1 -> + Some (Pconst_char (x1)) + ) + | Variant { tag = "Pconst_string"; args = [| x1; x2 |] } -> + Option.bind (Data.to_string x1) ~f:(fun x1 -> + Option.bind ((Data.to_option ~f:Data.to_string) x2) ~f:(fun x2 -> + Some (Pconst_string (x1, x2)) + )) + | Variant { tag = "Pconst_float"; args = [| x1; x2 |] } -> + Option.bind (Data.to_string x1) ~f:(fun x1 -> + Option.bind ((Data.to_option ~f:Data.to_char) x2) ~f:(fun x2 -> + Some (Pconst_float (x1, x2)) + )) + | _ -> None + end + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "constant"; + node = Unversioned.Private.transparent node; + }) +end + +module Attribute = struct + type t = attribute + + type concrete = + { attr_name : string Astlib.Loc.t + ; attr_payload : payload + ; attr_loc : Astlib.Location.t + } + + let create ~attr_name ~attr_payload ~attr_loc = + let fields = + [| (Data.of_loc ~f:Data.of_string) attr_name + ; Data.of_node attr_payload + ; Data.of_location attr_loc + |] + in + node "attribute" (Record fields) + + let of_concrete { attr_name; attr_payload; attr_loc } = + create ~attr_name ~attr_payload ~attr_loc + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "attribute" + ; data = Record [| attr_name; attr_payload; attr_loc |] + } -> + Option.bind ((Data.to_loc ~f:Data.to_string) attr_name) ~f:(fun attr_name -> + Option.bind (Data.to_node attr_payload) ~f:(fun attr_payload -> + Option.bind (Data.to_location attr_loc) ~f:(fun attr_loc -> + Some { attr_name; attr_payload; attr_loc } + ))) + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "attribute"; + node = Unversioned.Private.transparent node; + }) + + let attr_name t = (to_concrete t).attr_name + let attr_payload t = (to_concrete t).attr_payload + let attr_loc t = (to_concrete t).attr_loc +end + +module Extension = struct + type t = extension + + type concrete = (string Astlib.Loc.t * payload) + + let create = + let data = (Data.of_tuple2 ~f1:(Data.of_loc ~f:Data.of_string) ~f2:Data.of_node) in + fun x -> node "extension" (data x) + + let of_concrete = create + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "extension"; data } -> (Data.to_tuple2 ~f1:(Data.to_loc ~f:Data.to_string) ~f2:Data.to_node) data + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "extension"; + node = Unversioned.Private.transparent node; + }) +end + +module Attributes = struct + type t = attributes + + type concrete = attribute list + + let create = + let data = (Data.of_list ~f:Data.of_node) in + fun x -> node "attributes" (data x) + + let of_concrete = create + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "attributes"; data } -> (Data.to_list ~f:Data.to_node) data + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "attributes"; + node = Unversioned.Private.transparent node; + }) +end + +module Payload = struct + type t = payload + + type concrete = + | PStr of structure + | PSig of signature + | PTyp of core_type + | PPat of pattern * expression option + + let pstr x1 = + node "payload" + (Variant + { tag = "PStr" + ; args = + [| Data.of_node x1 + |] + }) + let psig x1 = + node "payload" + (Variant + { tag = "PSig" + ; args = + [| Data.of_node x1 + |] + }) + let ptyp x1 = + node "payload" + (Variant + { tag = "PTyp" + ; args = + [| Data.of_node x1 + |] + }) + let ppat x1 x2 = + node "payload" + (Variant + { tag = "PPat" + ; args = + [| Data.of_node x1 + ; (Data.of_option ~f:Data.of_node) x2 + |] + }) + + let of_concrete c = + match c with + | PStr (x1) -> + pstr x1 + | PSig (x1) -> + psig x1 + | PTyp (x1) -> + ptyp x1 + | PPat (x1, x2) -> + ppat x1 x2 + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "payload"; data } -> + begin + match data with + | Variant { tag = "PStr"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (PStr (x1)) + ) + | Variant { tag = "PSig"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (PSig (x1)) + ) + | Variant { tag = "PTyp"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (PTyp (x1)) + ) + | Variant { tag = "PPat"; args = [| x1; x2 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind ((Data.to_option ~f:Data.to_node) x2) ~f:(fun x2 -> + Some (PPat (x1, x2)) + )) + | _ -> None + end + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "payload"; + node = Unversioned.Private.transparent node; + }) +end + +module Core_type = struct + type t = core_type + + type concrete = + { ptyp_desc : core_type_desc + ; ptyp_loc : Astlib.Location.t + ; ptyp_loc_stack : Astlib.Location.t list + ; ptyp_attributes : attributes + } + + let create ~ptyp_desc ~ptyp_loc ~ptyp_loc_stack ~ptyp_attributes = + let fields = + [| Data.of_node ptyp_desc + ; Data.of_location ptyp_loc + ; (Data.of_list ~f:Data.of_location) ptyp_loc_stack + ; Data.of_node ptyp_attributes + |] + in + node "core_type" (Record fields) + + let of_concrete { ptyp_desc; ptyp_loc; ptyp_loc_stack; ptyp_attributes } = + create ~ptyp_desc ~ptyp_loc ~ptyp_loc_stack ~ptyp_attributes + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "core_type" + ; data = Record [| ptyp_desc; ptyp_loc; ptyp_loc_stack; ptyp_attributes |] + } -> + Option.bind (Data.to_node ptyp_desc) ~f:(fun ptyp_desc -> + Option.bind (Data.to_location ptyp_loc) ~f:(fun ptyp_loc -> + Option.bind ((Data.to_list ~f:Data.to_location) ptyp_loc_stack) ~f:(fun ptyp_loc_stack -> + Option.bind (Data.to_node ptyp_attributes) ~f:(fun ptyp_attributes -> + Some { ptyp_desc; ptyp_loc; ptyp_loc_stack; ptyp_attributes } + )))) + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "core_type"; + node = Unversioned.Private.transparent node; + }) + + let ptyp_desc t = (to_concrete t).ptyp_desc + let ptyp_loc t = (to_concrete t).ptyp_loc + let ptyp_loc_stack t = (to_concrete t).ptyp_loc_stack + let ptyp_attributes t = (to_concrete t).ptyp_attributes +end + +module Core_type_desc = struct + type t = core_type_desc + + type concrete = + | Ptyp_any + | Ptyp_var of string + | Ptyp_arrow of arg_label * core_type * core_type + | Ptyp_tuple of core_type list + | Ptyp_constr of longident_loc * core_type list + | Ptyp_object of object_field list * closed_flag + | Ptyp_class of longident_loc * core_type list + | Ptyp_alias of core_type * string + | Ptyp_variant of row_field list * closed_flag * string list option + | Ptyp_poly of string Astlib.Loc.t list * core_type + | Ptyp_package of package_type + | Ptyp_extension of extension + + let ptyp_any = + node "core_type_desc" (Variant { tag = "Ptyp_any"; args = [||] }) + let ptyp_var x1 = + node "core_type_desc" + (Variant + { tag = "Ptyp_var" + ; args = + [| Data.of_string x1 + |] + }) + let ptyp_arrow x1 x2 x3 = + node "core_type_desc" + (Variant + { tag = "Ptyp_arrow" + ; args = + [| Data.of_node x1 + ; Data.of_node x2 + ; Data.of_node x3 + |] + }) + let ptyp_tuple x1 = + node "core_type_desc" + (Variant + { tag = "Ptyp_tuple" + ; args = + [| (Data.of_list ~f:Data.of_node) x1 + |] + }) + let ptyp_constr x1 x2 = + node "core_type_desc" + (Variant + { tag = "Ptyp_constr" + ; args = + [| Data.of_node x1 + ; (Data.of_list ~f:Data.of_node) x2 + |] + }) + let ptyp_object x1 x2 = + node "core_type_desc" + (Variant + { tag = "Ptyp_object" + ; args = + [| (Data.of_list ~f:Data.of_node) x1 + ; Data.of_node x2 + |] + }) + let ptyp_class x1 x2 = + node "core_type_desc" + (Variant + { tag = "Ptyp_class" + ; args = + [| Data.of_node x1 + ; (Data.of_list ~f:Data.of_node) x2 + |] + }) + let ptyp_alias x1 x2 = + node "core_type_desc" + (Variant + { tag = "Ptyp_alias" + ; args = + [| Data.of_node x1 + ; Data.of_string x2 + |] + }) + let ptyp_variant x1 x2 x3 = + node "core_type_desc" + (Variant + { tag = "Ptyp_variant" + ; args = + [| (Data.of_list ~f:Data.of_node) x1 + ; Data.of_node x2 + ; (Data.of_option ~f:(Data.of_list ~f:Data.of_string)) x3 + |] + }) + let ptyp_poly x1 x2 = + node "core_type_desc" + (Variant + { tag = "Ptyp_poly" + ; args = + [| (Data.of_list ~f:(Data.of_loc ~f:Data.of_string)) x1 + ; Data.of_node x2 + |] + }) + let ptyp_package x1 = + node "core_type_desc" + (Variant + { tag = "Ptyp_package" + ; args = + [| Data.of_node x1 + |] + }) + let ptyp_extension x1 = + node "core_type_desc" + (Variant + { tag = "Ptyp_extension" + ; args = + [| Data.of_node x1 + |] + }) + + let of_concrete c = + match c with + | Ptyp_any -> ptyp_any + | Ptyp_var (x1) -> + ptyp_var x1 + | Ptyp_arrow (x1, x2, x3) -> + ptyp_arrow x1 x2 x3 + | Ptyp_tuple (x1) -> + ptyp_tuple x1 + | Ptyp_constr (x1, x2) -> + ptyp_constr x1 x2 + | Ptyp_object (x1, x2) -> + ptyp_object x1 x2 + | Ptyp_class (x1, x2) -> + ptyp_class x1 x2 + | Ptyp_alias (x1, x2) -> + ptyp_alias x1 x2 + | Ptyp_variant (x1, x2, x3) -> + ptyp_variant x1 x2 x3 + | Ptyp_poly (x1, x2) -> + ptyp_poly x1 x2 + | Ptyp_package (x1) -> + ptyp_package x1 + | Ptyp_extension (x1) -> + ptyp_extension x1 + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "core_type_desc"; data } -> + begin + match data with + | Variant { tag = "Ptyp_any"; args = [||] } -> Some Ptyp_any + | Variant { tag = "Ptyp_var"; args = [| x1 |] } -> + Option.bind (Data.to_string x1) ~f:(fun x1 -> + Some (Ptyp_var (x1)) + ) + | Variant { tag = "Ptyp_arrow"; args = [| x1; x2; x3 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind (Data.to_node x2) ~f:(fun x2 -> + Option.bind (Data.to_node x3) ~f:(fun x3 -> + Some (Ptyp_arrow (x1, x2, x3)) + ))) + | Variant { tag = "Ptyp_tuple"; args = [| x1 |] } -> + Option.bind ((Data.to_list ~f:Data.to_node) x1) ~f:(fun x1 -> + Some (Ptyp_tuple (x1)) + ) + | Variant { tag = "Ptyp_constr"; args = [| x1; x2 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind ((Data.to_list ~f:Data.to_node) x2) ~f:(fun x2 -> + Some (Ptyp_constr (x1, x2)) + )) + | Variant { tag = "Ptyp_object"; args = [| x1; x2 |] } -> + Option.bind ((Data.to_list ~f:Data.to_node) x1) ~f:(fun x1 -> + Option.bind (Data.to_node x2) ~f:(fun x2 -> + Some (Ptyp_object (x1, x2)) + )) + | Variant { tag = "Ptyp_class"; args = [| x1; x2 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind ((Data.to_list ~f:Data.to_node) x2) ~f:(fun x2 -> + Some (Ptyp_class (x1, x2)) + )) + | Variant { tag = "Ptyp_alias"; args = [| x1; x2 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind (Data.to_string x2) ~f:(fun x2 -> + Some (Ptyp_alias (x1, x2)) + )) + | Variant { tag = "Ptyp_variant"; args = [| x1; x2; x3 |] } -> + Option.bind ((Data.to_list ~f:Data.to_node) x1) ~f:(fun x1 -> + Option.bind (Data.to_node x2) ~f:(fun x2 -> + Option.bind ((Data.to_option ~f:(Data.to_list ~f:Data.to_string)) x3) ~f:(fun x3 -> + Some (Ptyp_variant (x1, x2, x3)) + ))) + | Variant { tag = "Ptyp_poly"; args = [| x1; x2 |] } -> + Option.bind ((Data.to_list ~f:(Data.to_loc ~f:Data.to_string)) x1) ~f:(fun x1 -> + Option.bind (Data.to_node x2) ~f:(fun x2 -> + Some (Ptyp_poly (x1, x2)) + )) + | Variant { tag = "Ptyp_package"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Ptyp_package (x1)) + ) + | Variant { tag = "Ptyp_extension"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Ptyp_extension (x1)) + ) + | _ -> None + end + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "core_type_desc"; + node = Unversioned.Private.transparent node; + }) +end + +module Package_type = struct + type t = package_type + + type concrete = (longident_loc * (longident_loc * core_type) list) + + let create = + let data = (Data.of_tuple2 ~f1:Data.of_node ~f2:(Data.of_list ~f:(Data.of_tuple2 ~f1:Data.of_node ~f2:Data.of_node))) in + fun x -> node "package_type" (data x) + + let of_concrete = create + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "package_type"; data } -> (Data.to_tuple2 ~f1:Data.to_node ~f2:(Data.to_list ~f:(Data.to_tuple2 ~f1:Data.to_node ~f2:Data.to_node))) data + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "package_type"; + node = Unversioned.Private.transparent node; + }) +end + +module Row_field = struct + type t = row_field + + type concrete = + { prf_desc : row_field_desc + ; prf_loc : Astlib.Location.t + ; prf_attributes : attributes + } + + let create ~prf_desc ~prf_loc ~prf_attributes = + let fields = + [| Data.of_node prf_desc + ; Data.of_location prf_loc + ; Data.of_node prf_attributes + |] + in + node "row_field" (Record fields) + + let of_concrete { prf_desc; prf_loc; prf_attributes } = + create ~prf_desc ~prf_loc ~prf_attributes + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "row_field" + ; data = Record [| prf_desc; prf_loc; prf_attributes |] + } -> + Option.bind (Data.to_node prf_desc) ~f:(fun prf_desc -> + Option.bind (Data.to_location prf_loc) ~f:(fun prf_loc -> + Option.bind (Data.to_node prf_attributes) ~f:(fun prf_attributes -> + Some { prf_desc; prf_loc; prf_attributes } + ))) + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "row_field"; + node = Unversioned.Private.transparent node; + }) + + let prf_desc t = (to_concrete t).prf_desc + let prf_loc t = (to_concrete t).prf_loc + let prf_attributes t = (to_concrete t).prf_attributes +end + +module Row_field_desc = struct + type t = row_field_desc + + type concrete = + | Rtag of string Astlib.Loc.t * bool * core_type list + | Rinherit of core_type + + let rtag x1 x2 x3 = + node "row_field_desc" + (Variant + { tag = "Rtag" + ; args = + [| (Data.of_loc ~f:Data.of_string) x1 + ; Data.of_bool x2 + ; (Data.of_list ~f:Data.of_node) x3 + |] + }) + let rinherit x1 = + node "row_field_desc" + (Variant + { tag = "Rinherit" + ; args = + [| Data.of_node x1 + |] + }) + + let of_concrete c = + match c with + | Rtag (x1, x2, x3) -> + rtag x1 x2 x3 + | Rinherit (x1) -> + rinherit x1 + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "row_field_desc"; data } -> + begin + match data with + | Variant { tag = "Rtag"; args = [| x1; x2; x3 |] } -> + Option.bind ((Data.to_loc ~f:Data.to_string) x1) ~f:(fun x1 -> + Option.bind (Data.to_bool x2) ~f:(fun x2 -> + Option.bind ((Data.to_list ~f:Data.to_node) x3) ~f:(fun x3 -> + Some (Rtag (x1, x2, x3)) + ))) + | Variant { tag = "Rinherit"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Rinherit (x1)) + ) + | _ -> None + end + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "row_field_desc"; + node = Unversioned.Private.transparent node; + }) +end + +module Object_field = struct + type t = object_field + + type concrete = + { pof_desc : object_field_desc + ; pof_loc : Astlib.Location.t + ; pof_attributes : attributes + } + + let create ~pof_desc ~pof_loc ~pof_attributes = + let fields = + [| Data.of_node pof_desc + ; Data.of_location pof_loc + ; Data.of_node pof_attributes + |] + in + node "object_field" (Record fields) + + let of_concrete { pof_desc; pof_loc; pof_attributes } = + create ~pof_desc ~pof_loc ~pof_attributes + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "object_field" + ; data = Record [| pof_desc; pof_loc; pof_attributes |] + } -> + Option.bind (Data.to_node pof_desc) ~f:(fun pof_desc -> + Option.bind (Data.to_location pof_loc) ~f:(fun pof_loc -> + Option.bind (Data.to_node pof_attributes) ~f:(fun pof_attributes -> + Some { pof_desc; pof_loc; pof_attributes } + ))) + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "object_field"; + node = Unversioned.Private.transparent node; + }) + + let pof_desc t = (to_concrete t).pof_desc + let pof_loc t = (to_concrete t).pof_loc + let pof_attributes t = (to_concrete t).pof_attributes +end + +module Object_field_desc = struct + type t = object_field_desc + + type concrete = + | Otag of string Astlib.Loc.t * core_type + | Oinherit of core_type + + let otag x1 x2 = + node "object_field_desc" + (Variant + { tag = "Otag" + ; args = + [| (Data.of_loc ~f:Data.of_string) x1 + ; Data.of_node x2 + |] + }) + let oinherit x1 = + node "object_field_desc" + (Variant + { tag = "Oinherit" + ; args = + [| Data.of_node x1 + |] + }) + + let of_concrete c = + match c with + | Otag (x1, x2) -> + otag x1 x2 + | Oinherit (x1) -> + oinherit x1 + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "object_field_desc"; data } -> + begin + match data with + | Variant { tag = "Otag"; args = [| x1; x2 |] } -> + Option.bind ((Data.to_loc ~f:Data.to_string) x1) ~f:(fun x1 -> + Option.bind (Data.to_node x2) ~f:(fun x2 -> + Some (Otag (x1, x2)) + )) + | Variant { tag = "Oinherit"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Oinherit (x1)) + ) + | _ -> None + end + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "object_field_desc"; + node = Unversioned.Private.transparent node; + }) +end + +module Pattern = struct + type t = pattern + + type concrete = + { ppat_desc : pattern_desc + ; ppat_loc : Astlib.Location.t + ; ppat_loc_stack : Astlib.Location.t list + ; ppat_attributes : attributes + } + + let create ~ppat_desc ~ppat_loc ~ppat_loc_stack ~ppat_attributes = + let fields = + [| Data.of_node ppat_desc + ; Data.of_location ppat_loc + ; (Data.of_list ~f:Data.of_location) ppat_loc_stack + ; Data.of_node ppat_attributes + |] + in + node "pattern" (Record fields) + + let of_concrete { ppat_desc; ppat_loc; ppat_loc_stack; ppat_attributes } = + create ~ppat_desc ~ppat_loc ~ppat_loc_stack ~ppat_attributes + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "pattern" + ; data = Record [| ppat_desc; ppat_loc; ppat_loc_stack; ppat_attributes |] + } -> + Option.bind (Data.to_node ppat_desc) ~f:(fun ppat_desc -> + Option.bind (Data.to_location ppat_loc) ~f:(fun ppat_loc -> + Option.bind ((Data.to_list ~f:Data.to_location) ppat_loc_stack) ~f:(fun ppat_loc_stack -> + Option.bind (Data.to_node ppat_attributes) ~f:(fun ppat_attributes -> + Some { ppat_desc; ppat_loc; ppat_loc_stack; ppat_attributes } + )))) + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "pattern"; + node = Unversioned.Private.transparent node; + }) + + let ppat_desc t = (to_concrete t).ppat_desc + let ppat_loc t = (to_concrete t).ppat_loc + let ppat_loc_stack t = (to_concrete t).ppat_loc_stack + let ppat_attributes t = (to_concrete t).ppat_attributes +end + +module Pattern_desc = struct + type t = pattern_desc + + type concrete = + | Ppat_any + | Ppat_var of string Astlib.Loc.t + | Ppat_alias of pattern * string Astlib.Loc.t + | Ppat_constant of constant + | Ppat_interval of constant * constant + | Ppat_tuple of pattern list + | Ppat_construct of longident_loc * pattern option + | Ppat_variant of string * pattern option + | Ppat_record of (longident_loc * pattern) list * closed_flag + | Ppat_array of pattern list + | Ppat_or of pattern * pattern + | Ppat_constraint of pattern * core_type + | Ppat_type of longident_loc + | Ppat_lazy of pattern + | Ppat_unpack of string Astlib.Loc.t + | Ppat_exception of pattern + | Ppat_extension of extension + | Ppat_open of longident_loc * pattern + + let ppat_any = + node "pattern_desc" (Variant { tag = "Ppat_any"; args = [||] }) + let ppat_var x1 = + node "pattern_desc" + (Variant + { tag = "Ppat_var" + ; args = + [| (Data.of_loc ~f:Data.of_string) x1 + |] + }) + let ppat_alias x1 x2 = + node "pattern_desc" + (Variant + { tag = "Ppat_alias" + ; args = + [| Data.of_node x1 + ; (Data.of_loc ~f:Data.of_string) x2 + |] + }) + let ppat_constant x1 = + node "pattern_desc" + (Variant + { tag = "Ppat_constant" + ; args = + [| Data.of_node x1 + |] + }) + let ppat_interval x1 x2 = + node "pattern_desc" + (Variant + { tag = "Ppat_interval" + ; args = + [| Data.of_node x1 + ; Data.of_node x2 + |] + }) + let ppat_tuple x1 = + node "pattern_desc" + (Variant + { tag = "Ppat_tuple" + ; args = + [| (Data.of_list ~f:Data.of_node) x1 + |] + }) + let ppat_construct x1 x2 = + node "pattern_desc" + (Variant + { tag = "Ppat_construct" + ; args = + [| Data.of_node x1 + ; (Data.of_option ~f:Data.of_node) x2 + |] + }) + let ppat_variant x1 x2 = + node "pattern_desc" + (Variant + { tag = "Ppat_variant" + ; args = + [| Data.of_string x1 + ; (Data.of_option ~f:Data.of_node) x2 + |] + }) + let ppat_record x1 x2 = + node "pattern_desc" + (Variant + { tag = "Ppat_record" + ; args = + [| (Data.of_list ~f:(Data.of_tuple2 ~f1:Data.of_node ~f2:Data.of_node)) x1 + ; Data.of_node x2 + |] + }) + let ppat_array x1 = + node "pattern_desc" + (Variant + { tag = "Ppat_array" + ; args = + [| (Data.of_list ~f:Data.of_node) x1 + |] + }) + let ppat_or x1 x2 = + node "pattern_desc" + (Variant + { tag = "Ppat_or" + ; args = + [| Data.of_node x1 + ; Data.of_node x2 + |] + }) + let ppat_constraint x1 x2 = + node "pattern_desc" + (Variant + { tag = "Ppat_constraint" + ; args = + [| Data.of_node x1 + ; Data.of_node x2 + |] + }) + let ppat_type x1 = + node "pattern_desc" + (Variant + { tag = "Ppat_type" + ; args = + [| Data.of_node x1 + |] + }) + let ppat_lazy x1 = + node "pattern_desc" + (Variant + { tag = "Ppat_lazy" + ; args = + [| Data.of_node x1 + |] + }) + let ppat_unpack x1 = + node "pattern_desc" + (Variant + { tag = "Ppat_unpack" + ; args = + [| (Data.of_loc ~f:Data.of_string) x1 + |] + }) + let ppat_exception x1 = + node "pattern_desc" + (Variant + { tag = "Ppat_exception" + ; args = + [| Data.of_node x1 + |] + }) + let ppat_extension x1 = + node "pattern_desc" + (Variant + { tag = "Ppat_extension" + ; args = + [| Data.of_node x1 + |] + }) + let ppat_open x1 x2 = + node "pattern_desc" + (Variant + { tag = "Ppat_open" + ; args = + [| Data.of_node x1 + ; Data.of_node x2 + |] + }) + + let of_concrete c = + match c with + | Ppat_any -> ppat_any + | Ppat_var (x1) -> + ppat_var x1 + | Ppat_alias (x1, x2) -> + ppat_alias x1 x2 + | Ppat_constant (x1) -> + ppat_constant x1 + | Ppat_interval (x1, x2) -> + ppat_interval x1 x2 + | Ppat_tuple (x1) -> + ppat_tuple x1 + | Ppat_construct (x1, x2) -> + ppat_construct x1 x2 + | Ppat_variant (x1, x2) -> + ppat_variant x1 x2 + | Ppat_record (x1, x2) -> + ppat_record x1 x2 + | Ppat_array (x1) -> + ppat_array x1 + | Ppat_or (x1, x2) -> + ppat_or x1 x2 + | Ppat_constraint (x1, x2) -> + ppat_constraint x1 x2 + | Ppat_type (x1) -> + ppat_type x1 + | Ppat_lazy (x1) -> + ppat_lazy x1 + | Ppat_unpack (x1) -> + ppat_unpack x1 + | Ppat_exception (x1) -> + ppat_exception x1 + | Ppat_extension (x1) -> + ppat_extension x1 + | Ppat_open (x1, x2) -> + ppat_open x1 x2 + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "pattern_desc"; data } -> + begin + match data with + | Variant { tag = "Ppat_any"; args = [||] } -> Some Ppat_any + | Variant { tag = "Ppat_var"; args = [| x1 |] } -> + Option.bind ((Data.to_loc ~f:Data.to_string) x1) ~f:(fun x1 -> + Some (Ppat_var (x1)) + ) + | Variant { tag = "Ppat_alias"; args = [| x1; x2 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind ((Data.to_loc ~f:Data.to_string) x2) ~f:(fun x2 -> + Some (Ppat_alias (x1, x2)) + )) + | Variant { tag = "Ppat_constant"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Ppat_constant (x1)) + ) + | Variant { tag = "Ppat_interval"; args = [| x1; x2 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind (Data.to_node x2) ~f:(fun x2 -> + Some (Ppat_interval (x1, x2)) + )) + | Variant { tag = "Ppat_tuple"; args = [| x1 |] } -> + Option.bind ((Data.to_list ~f:Data.to_node) x1) ~f:(fun x1 -> + Some (Ppat_tuple (x1)) + ) + | Variant { tag = "Ppat_construct"; args = [| x1; x2 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind ((Data.to_option ~f:Data.to_node) x2) ~f:(fun x2 -> + Some (Ppat_construct (x1, x2)) + )) + | Variant { tag = "Ppat_variant"; args = [| x1; x2 |] } -> + Option.bind (Data.to_string x1) ~f:(fun x1 -> + Option.bind ((Data.to_option ~f:Data.to_node) x2) ~f:(fun x2 -> + Some (Ppat_variant (x1, x2)) + )) + | Variant { tag = "Ppat_record"; args = [| x1; x2 |] } -> + Option.bind ((Data.to_list ~f:(Data.to_tuple2 ~f1:Data.to_node ~f2:Data.to_node)) x1) ~f:(fun x1 -> + Option.bind (Data.to_node x2) ~f:(fun x2 -> + Some (Ppat_record (x1, x2)) + )) + | Variant { tag = "Ppat_array"; args = [| x1 |] } -> + Option.bind ((Data.to_list ~f:Data.to_node) x1) ~f:(fun x1 -> + Some (Ppat_array (x1)) + ) + | Variant { tag = "Ppat_or"; args = [| x1; x2 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind (Data.to_node x2) ~f:(fun x2 -> + Some (Ppat_or (x1, x2)) + )) + | Variant { tag = "Ppat_constraint"; args = [| x1; x2 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind (Data.to_node x2) ~f:(fun x2 -> + Some (Ppat_constraint (x1, x2)) + )) + | Variant { tag = "Ppat_type"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Ppat_type (x1)) + ) + | Variant { tag = "Ppat_lazy"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Ppat_lazy (x1)) + ) + | Variant { tag = "Ppat_unpack"; args = [| x1 |] } -> + Option.bind ((Data.to_loc ~f:Data.to_string) x1) ~f:(fun x1 -> + Some (Ppat_unpack (x1)) + ) + | Variant { tag = "Ppat_exception"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Ppat_exception (x1)) + ) + | Variant { tag = "Ppat_extension"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Ppat_extension (x1)) + ) + | Variant { tag = "Ppat_open"; args = [| x1; x2 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind (Data.to_node x2) ~f:(fun x2 -> + Some (Ppat_open (x1, x2)) + )) + | _ -> None + end + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "pattern_desc"; + node = Unversioned.Private.transparent node; + }) +end + +module Expression = struct + type t = expression + + type concrete = + { pexp_desc : expression_desc + ; pexp_loc : Astlib.Location.t + ; pexp_loc_stack : Astlib.Location.t list + ; pexp_attributes : attributes + } + + let create ~pexp_desc ~pexp_loc ~pexp_loc_stack ~pexp_attributes = + let fields = + [| Data.of_node pexp_desc + ; Data.of_location pexp_loc + ; (Data.of_list ~f:Data.of_location) pexp_loc_stack + ; Data.of_node pexp_attributes + |] + in + node "expression" (Record fields) + + let of_concrete { pexp_desc; pexp_loc; pexp_loc_stack; pexp_attributes } = + create ~pexp_desc ~pexp_loc ~pexp_loc_stack ~pexp_attributes + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "expression" + ; data = Record [| pexp_desc; pexp_loc; pexp_loc_stack; pexp_attributes |] + } -> + Option.bind (Data.to_node pexp_desc) ~f:(fun pexp_desc -> + Option.bind (Data.to_location pexp_loc) ~f:(fun pexp_loc -> + Option.bind ((Data.to_list ~f:Data.to_location) pexp_loc_stack) ~f:(fun pexp_loc_stack -> + Option.bind (Data.to_node pexp_attributes) ~f:(fun pexp_attributes -> + Some { pexp_desc; pexp_loc; pexp_loc_stack; pexp_attributes } + )))) + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "expression"; + node = Unversioned.Private.transparent node; + }) + + let pexp_desc t = (to_concrete t).pexp_desc + let pexp_loc t = (to_concrete t).pexp_loc + let pexp_loc_stack t = (to_concrete t).pexp_loc_stack + let pexp_attributes t = (to_concrete t).pexp_attributes +end + +module Expression_desc = struct + type t = expression_desc + + type concrete = + | Pexp_ident of longident_loc + | Pexp_constant of constant + | Pexp_let of rec_flag * value_binding list * expression + | Pexp_function of case list + | Pexp_fun of arg_label * expression option * pattern * expression + | Pexp_apply of expression * (arg_label * expression) list + | Pexp_match of expression * case list + | Pexp_try of expression * case list + | Pexp_tuple of expression list + | Pexp_construct of longident_loc * expression option + | Pexp_variant of string * expression option + | Pexp_record of (longident_loc * expression) list * expression option + | Pexp_field of expression * longident_loc + | Pexp_setfield of expression * longident_loc * expression + | Pexp_array of expression list + | Pexp_ifthenelse of expression * expression * expression option + | Pexp_sequence of expression * expression + | Pexp_while of expression * expression + | Pexp_for of pattern * expression * expression * direction_flag * expression + | Pexp_constraint of expression * core_type + | Pexp_coerce of expression * core_type option * core_type + | Pexp_send of expression * string Astlib.Loc.t + | Pexp_new of longident_loc + | Pexp_setinstvar of string Astlib.Loc.t * expression + | Pexp_override of (string Astlib.Loc.t * expression) list + | Pexp_letmodule of string Astlib.Loc.t * module_expr * expression + | Pexp_letexception of extension_constructor * expression + | Pexp_assert of expression + | Pexp_lazy of expression + | Pexp_poly of expression * core_type option + | Pexp_object of class_structure + | Pexp_newtype of string Astlib.Loc.t * expression + | Pexp_pack of module_expr + | Pexp_open of open_declaration * expression + | Pexp_letop of letop + | Pexp_extension of extension + | Pexp_unreachable + + let pexp_ident x1 = + node "expression_desc" + (Variant + { tag = "Pexp_ident" + ; args = + [| Data.of_node x1 + |] + }) + let pexp_constant x1 = + node "expression_desc" + (Variant + { tag = "Pexp_constant" + ; args = + [| Data.of_node x1 + |] + }) + let pexp_let x1 x2 x3 = + node "expression_desc" + (Variant + { tag = "Pexp_let" + ; args = + [| Data.of_node x1 + ; (Data.of_list ~f:Data.of_node) x2 + ; Data.of_node x3 + |] + }) + let pexp_function x1 = + node "expression_desc" + (Variant + { tag = "Pexp_function" + ; args = + [| (Data.of_list ~f:Data.of_node) x1 + |] + }) + let pexp_fun x1 x2 x3 x4 = + node "expression_desc" + (Variant + { tag = "Pexp_fun" + ; args = + [| Data.of_node x1 + ; (Data.of_option ~f:Data.of_node) x2 + ; Data.of_node x3 + ; Data.of_node x4 + |] + }) + let pexp_apply x1 x2 = + node "expression_desc" + (Variant + { tag = "Pexp_apply" + ; args = + [| Data.of_node x1 + ; (Data.of_list ~f:(Data.of_tuple2 ~f1:Data.of_node ~f2:Data.of_node)) x2 + |] + }) + let pexp_match x1 x2 = + node "expression_desc" + (Variant + { tag = "Pexp_match" + ; args = + [| Data.of_node x1 + ; (Data.of_list ~f:Data.of_node) x2 + |] + }) + let pexp_try x1 x2 = + node "expression_desc" + (Variant + { tag = "Pexp_try" + ; args = + [| Data.of_node x1 + ; (Data.of_list ~f:Data.of_node) x2 + |] + }) + let pexp_tuple x1 = + node "expression_desc" + (Variant + { tag = "Pexp_tuple" + ; args = + [| (Data.of_list ~f:Data.of_node) x1 + |] + }) + let pexp_construct x1 x2 = + node "expression_desc" + (Variant + { tag = "Pexp_construct" + ; args = + [| Data.of_node x1 + ; (Data.of_option ~f:Data.of_node) x2 + |] + }) + let pexp_variant x1 x2 = + node "expression_desc" + (Variant + { tag = "Pexp_variant" + ; args = + [| Data.of_string x1 + ; (Data.of_option ~f:Data.of_node) x2 + |] + }) + let pexp_record x1 x2 = + node "expression_desc" + (Variant + { tag = "Pexp_record" + ; args = + [| (Data.of_list ~f:(Data.of_tuple2 ~f1:Data.of_node ~f2:Data.of_node)) x1 + ; (Data.of_option ~f:Data.of_node) x2 + |] + }) + let pexp_field x1 x2 = + node "expression_desc" + (Variant + { tag = "Pexp_field" + ; args = + [| Data.of_node x1 + ; Data.of_node x2 + |] + }) + let pexp_setfield x1 x2 x3 = + node "expression_desc" + (Variant + { tag = "Pexp_setfield" + ; args = + [| Data.of_node x1 + ; Data.of_node x2 + ; Data.of_node x3 + |] + }) + let pexp_array x1 = + node "expression_desc" + (Variant + { tag = "Pexp_array" + ; args = + [| (Data.of_list ~f:Data.of_node) x1 + |] + }) + let pexp_ifthenelse x1 x2 x3 = + node "expression_desc" + (Variant + { tag = "Pexp_ifthenelse" + ; args = + [| Data.of_node x1 + ; Data.of_node x2 + ; (Data.of_option ~f:Data.of_node) x3 + |] + }) + let pexp_sequence x1 x2 = + node "expression_desc" + (Variant + { tag = "Pexp_sequence" + ; args = + [| Data.of_node x1 + ; Data.of_node x2 + |] + }) + let pexp_while x1 x2 = + node "expression_desc" + (Variant + { tag = "Pexp_while" + ; args = + [| Data.of_node x1 + ; Data.of_node x2 + |] + }) + let pexp_for x1 x2 x3 x4 x5 = + node "expression_desc" + (Variant + { tag = "Pexp_for" + ; args = + [| Data.of_node x1 + ; Data.of_node x2 + ; Data.of_node x3 + ; Data.of_node x4 + ; Data.of_node x5 + |] + }) + let pexp_constraint x1 x2 = + node "expression_desc" + (Variant + { tag = "Pexp_constraint" + ; args = + [| Data.of_node x1 + ; Data.of_node x2 + |] + }) + let pexp_coerce x1 x2 x3 = + node "expression_desc" + (Variant + { tag = "Pexp_coerce" + ; args = + [| Data.of_node x1 + ; (Data.of_option ~f:Data.of_node) x2 + ; Data.of_node x3 + |] + }) + let pexp_send x1 x2 = + node "expression_desc" + (Variant + { tag = "Pexp_send" + ; args = + [| Data.of_node x1 + ; (Data.of_loc ~f:Data.of_string) x2 + |] + }) + let pexp_new x1 = + node "expression_desc" + (Variant + { tag = "Pexp_new" + ; args = + [| Data.of_node x1 + |] + }) + let pexp_setinstvar x1 x2 = + node "expression_desc" + (Variant + { tag = "Pexp_setinstvar" + ; args = + [| (Data.of_loc ~f:Data.of_string) x1 + ; Data.of_node x2 + |] + }) + let pexp_override x1 = + node "expression_desc" + (Variant + { tag = "Pexp_override" + ; args = + [| (Data.of_list ~f:(Data.of_tuple2 ~f1:(Data.of_loc ~f:Data.of_string) ~f2:Data.of_node)) x1 + |] + }) + let pexp_letmodule x1 x2 x3 = + node "expression_desc" + (Variant + { tag = "Pexp_letmodule" + ; args = + [| (Data.of_loc ~f:Data.of_string) x1 + ; Data.of_node x2 + ; Data.of_node x3 + |] + }) + let pexp_letexception x1 x2 = + node "expression_desc" + (Variant + { tag = "Pexp_letexception" + ; args = + [| Data.of_node x1 + ; Data.of_node x2 + |] + }) + let pexp_assert x1 = + node "expression_desc" + (Variant + { tag = "Pexp_assert" + ; args = + [| Data.of_node x1 + |] + }) + let pexp_lazy x1 = + node "expression_desc" + (Variant + { tag = "Pexp_lazy" + ; args = + [| Data.of_node x1 + |] + }) + let pexp_poly x1 x2 = + node "expression_desc" + (Variant + { tag = "Pexp_poly" + ; args = + [| Data.of_node x1 + ; (Data.of_option ~f:Data.of_node) x2 + |] + }) + let pexp_object x1 = + node "expression_desc" + (Variant + { tag = "Pexp_object" + ; args = + [| Data.of_node x1 + |] + }) + let pexp_newtype x1 x2 = + node "expression_desc" + (Variant + { tag = "Pexp_newtype" + ; args = + [| (Data.of_loc ~f:Data.of_string) x1 + ; Data.of_node x2 + |] + }) + let pexp_pack x1 = + node "expression_desc" + (Variant + { tag = "Pexp_pack" + ; args = + [| Data.of_node x1 + |] + }) + let pexp_open x1 x2 = + node "expression_desc" + (Variant + { tag = "Pexp_open" + ; args = + [| Data.of_node x1 + ; Data.of_node x2 + |] + }) + let pexp_letop x1 = + node "expression_desc" + (Variant + { tag = "Pexp_letop" + ; args = + [| Data.of_node x1 + |] + }) + let pexp_extension x1 = + node "expression_desc" + (Variant + { tag = "Pexp_extension" + ; args = + [| Data.of_node x1 + |] + }) + let pexp_unreachable = + node "expression_desc" (Variant { tag = "Pexp_unreachable"; args = [||] }) + + let of_concrete c = + match c with + | Pexp_ident (x1) -> + pexp_ident x1 + | Pexp_constant (x1) -> + pexp_constant x1 + | Pexp_let (x1, x2, x3) -> + pexp_let x1 x2 x3 + | Pexp_function (x1) -> + pexp_function x1 + | Pexp_fun (x1, x2, x3, x4) -> + pexp_fun x1 x2 x3 x4 + | Pexp_apply (x1, x2) -> + pexp_apply x1 x2 + | Pexp_match (x1, x2) -> + pexp_match x1 x2 + | Pexp_try (x1, x2) -> + pexp_try x1 x2 + | Pexp_tuple (x1) -> + pexp_tuple x1 + | Pexp_construct (x1, x2) -> + pexp_construct x1 x2 + | Pexp_variant (x1, x2) -> + pexp_variant x1 x2 + | Pexp_record (x1, x2) -> + pexp_record x1 x2 + | Pexp_field (x1, x2) -> + pexp_field x1 x2 + | Pexp_setfield (x1, x2, x3) -> + pexp_setfield x1 x2 x3 + | Pexp_array (x1) -> + pexp_array x1 + | Pexp_ifthenelse (x1, x2, x3) -> + pexp_ifthenelse x1 x2 x3 + | Pexp_sequence (x1, x2) -> + pexp_sequence x1 x2 + | Pexp_while (x1, x2) -> + pexp_while x1 x2 + | Pexp_for (x1, x2, x3, x4, x5) -> + pexp_for x1 x2 x3 x4 x5 + | Pexp_constraint (x1, x2) -> + pexp_constraint x1 x2 + | Pexp_coerce (x1, x2, x3) -> + pexp_coerce x1 x2 x3 + | Pexp_send (x1, x2) -> + pexp_send x1 x2 + | Pexp_new (x1) -> + pexp_new x1 + | Pexp_setinstvar (x1, x2) -> + pexp_setinstvar x1 x2 + | Pexp_override (x1) -> + pexp_override x1 + | Pexp_letmodule (x1, x2, x3) -> + pexp_letmodule x1 x2 x3 + | Pexp_letexception (x1, x2) -> + pexp_letexception x1 x2 + | Pexp_assert (x1) -> + pexp_assert x1 + | Pexp_lazy (x1) -> + pexp_lazy x1 + | Pexp_poly (x1, x2) -> + pexp_poly x1 x2 + | Pexp_object (x1) -> + pexp_object x1 + | Pexp_newtype (x1, x2) -> + pexp_newtype x1 x2 + | Pexp_pack (x1) -> + pexp_pack x1 + | Pexp_open (x1, x2) -> + pexp_open x1 x2 + | Pexp_letop (x1) -> + pexp_letop x1 + | Pexp_extension (x1) -> + pexp_extension x1 + | Pexp_unreachable -> pexp_unreachable + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "expression_desc"; data } -> + begin + match data with + | Variant { tag = "Pexp_ident"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Pexp_ident (x1)) + ) + | Variant { tag = "Pexp_constant"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Pexp_constant (x1)) + ) + | Variant { tag = "Pexp_let"; args = [| x1; x2; x3 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind ((Data.to_list ~f:Data.to_node) x2) ~f:(fun x2 -> + Option.bind (Data.to_node x3) ~f:(fun x3 -> + Some (Pexp_let (x1, x2, x3)) + ))) + | Variant { tag = "Pexp_function"; args = [| x1 |] } -> + Option.bind ((Data.to_list ~f:Data.to_node) x1) ~f:(fun x1 -> + Some (Pexp_function (x1)) + ) + | Variant { tag = "Pexp_fun"; args = [| x1; x2; x3; x4 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind ((Data.to_option ~f:Data.to_node) x2) ~f:(fun x2 -> + Option.bind (Data.to_node x3) ~f:(fun x3 -> + Option.bind (Data.to_node x4) ~f:(fun x4 -> + Some (Pexp_fun (x1, x2, x3, x4)) + )))) + | Variant { tag = "Pexp_apply"; args = [| x1; x2 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind ((Data.to_list ~f:(Data.to_tuple2 ~f1:Data.to_node ~f2:Data.to_node)) x2) ~f:(fun x2 -> + Some (Pexp_apply (x1, x2)) + )) + | Variant { tag = "Pexp_match"; args = [| x1; x2 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind ((Data.to_list ~f:Data.to_node) x2) ~f:(fun x2 -> + Some (Pexp_match (x1, x2)) + )) + | Variant { tag = "Pexp_try"; args = [| x1; x2 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind ((Data.to_list ~f:Data.to_node) x2) ~f:(fun x2 -> + Some (Pexp_try (x1, x2)) + )) + | Variant { tag = "Pexp_tuple"; args = [| x1 |] } -> + Option.bind ((Data.to_list ~f:Data.to_node) x1) ~f:(fun x1 -> + Some (Pexp_tuple (x1)) + ) + | Variant { tag = "Pexp_construct"; args = [| x1; x2 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind ((Data.to_option ~f:Data.to_node) x2) ~f:(fun x2 -> + Some (Pexp_construct (x1, x2)) + )) + | Variant { tag = "Pexp_variant"; args = [| x1; x2 |] } -> + Option.bind (Data.to_string x1) ~f:(fun x1 -> + Option.bind ((Data.to_option ~f:Data.to_node) x2) ~f:(fun x2 -> + Some (Pexp_variant (x1, x2)) + )) + | Variant { tag = "Pexp_record"; args = [| x1; x2 |] } -> + Option.bind ((Data.to_list ~f:(Data.to_tuple2 ~f1:Data.to_node ~f2:Data.to_node)) x1) ~f:(fun x1 -> + Option.bind ((Data.to_option ~f:Data.to_node) x2) ~f:(fun x2 -> + Some (Pexp_record (x1, x2)) + )) + | Variant { tag = "Pexp_field"; args = [| x1; x2 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind (Data.to_node x2) ~f:(fun x2 -> + Some (Pexp_field (x1, x2)) + )) + | Variant { tag = "Pexp_setfield"; args = [| x1; x2; x3 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind (Data.to_node x2) ~f:(fun x2 -> + Option.bind (Data.to_node x3) ~f:(fun x3 -> + Some (Pexp_setfield (x1, x2, x3)) + ))) + | Variant { tag = "Pexp_array"; args = [| x1 |] } -> + Option.bind ((Data.to_list ~f:Data.to_node) x1) ~f:(fun x1 -> + Some (Pexp_array (x1)) + ) + | Variant { tag = "Pexp_ifthenelse"; args = [| x1; x2; x3 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind (Data.to_node x2) ~f:(fun x2 -> + Option.bind ((Data.to_option ~f:Data.to_node) x3) ~f:(fun x3 -> + Some (Pexp_ifthenelse (x1, x2, x3)) + ))) + | Variant { tag = "Pexp_sequence"; args = [| x1; x2 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind (Data.to_node x2) ~f:(fun x2 -> + Some (Pexp_sequence (x1, x2)) + )) + | Variant { tag = "Pexp_while"; args = [| x1; x2 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind (Data.to_node x2) ~f:(fun x2 -> + Some (Pexp_while (x1, x2)) + )) + | Variant { tag = "Pexp_for"; args = [| x1; x2; x3; x4; x5 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind (Data.to_node x2) ~f:(fun x2 -> + Option.bind (Data.to_node x3) ~f:(fun x3 -> + Option.bind (Data.to_node x4) ~f:(fun x4 -> + Option.bind (Data.to_node x5) ~f:(fun x5 -> + Some (Pexp_for (x1, x2, x3, x4, x5)) + ))))) + | Variant { tag = "Pexp_constraint"; args = [| x1; x2 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind (Data.to_node x2) ~f:(fun x2 -> + Some (Pexp_constraint (x1, x2)) + )) + | Variant { tag = "Pexp_coerce"; args = [| x1; x2; x3 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind ((Data.to_option ~f:Data.to_node) x2) ~f:(fun x2 -> + Option.bind (Data.to_node x3) ~f:(fun x3 -> + Some (Pexp_coerce (x1, x2, x3)) + ))) + | Variant { tag = "Pexp_send"; args = [| x1; x2 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind ((Data.to_loc ~f:Data.to_string) x2) ~f:(fun x2 -> + Some (Pexp_send (x1, x2)) + )) + | Variant { tag = "Pexp_new"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Pexp_new (x1)) + ) + | Variant { tag = "Pexp_setinstvar"; args = [| x1; x2 |] } -> + Option.bind ((Data.to_loc ~f:Data.to_string) x1) ~f:(fun x1 -> + Option.bind (Data.to_node x2) ~f:(fun x2 -> + Some (Pexp_setinstvar (x1, x2)) + )) + | Variant { tag = "Pexp_override"; args = [| x1 |] } -> + Option.bind ((Data.to_list ~f:(Data.to_tuple2 ~f1:(Data.to_loc ~f:Data.to_string) ~f2:Data.to_node)) x1) ~f:(fun x1 -> + Some (Pexp_override (x1)) + ) + | Variant { tag = "Pexp_letmodule"; args = [| x1; x2; x3 |] } -> + Option.bind ((Data.to_loc ~f:Data.to_string) x1) ~f:(fun x1 -> + Option.bind (Data.to_node x2) ~f:(fun x2 -> + Option.bind (Data.to_node x3) ~f:(fun x3 -> + Some (Pexp_letmodule (x1, x2, x3)) + ))) + | Variant { tag = "Pexp_letexception"; args = [| x1; x2 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind (Data.to_node x2) ~f:(fun x2 -> + Some (Pexp_letexception (x1, x2)) + )) + | Variant { tag = "Pexp_assert"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Pexp_assert (x1)) + ) + | Variant { tag = "Pexp_lazy"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Pexp_lazy (x1)) + ) + | Variant { tag = "Pexp_poly"; args = [| x1; x2 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind ((Data.to_option ~f:Data.to_node) x2) ~f:(fun x2 -> + Some (Pexp_poly (x1, x2)) + )) + | Variant { tag = "Pexp_object"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Pexp_object (x1)) + ) + | Variant { tag = "Pexp_newtype"; args = [| x1; x2 |] } -> + Option.bind ((Data.to_loc ~f:Data.to_string) x1) ~f:(fun x1 -> + Option.bind (Data.to_node x2) ~f:(fun x2 -> + Some (Pexp_newtype (x1, x2)) + )) + | Variant { tag = "Pexp_pack"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Pexp_pack (x1)) + ) + | Variant { tag = "Pexp_open"; args = [| x1; x2 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind (Data.to_node x2) ~f:(fun x2 -> + Some (Pexp_open (x1, x2)) + )) + | Variant { tag = "Pexp_letop"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Pexp_letop (x1)) + ) + | Variant { tag = "Pexp_extension"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Pexp_extension (x1)) + ) + | Variant { tag = "Pexp_unreachable"; args = [||] } -> Some Pexp_unreachable + | _ -> None + end + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "expression_desc"; + node = Unversioned.Private.transparent node; + }) +end + +module Case = struct + type t = case + + type concrete = + { pc_lhs : pattern + ; pc_guard : expression option + ; pc_rhs : expression + } + + let create ~pc_lhs ~pc_guard ~pc_rhs = + let fields = + [| Data.of_node pc_lhs + ; (Data.of_option ~f:Data.of_node) pc_guard + ; Data.of_node pc_rhs + |] + in + node "case" (Record fields) + + let of_concrete { pc_lhs; pc_guard; pc_rhs } = + create ~pc_lhs ~pc_guard ~pc_rhs + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "case" + ; data = Record [| pc_lhs; pc_guard; pc_rhs |] + } -> + Option.bind (Data.to_node pc_lhs) ~f:(fun pc_lhs -> + Option.bind ((Data.to_option ~f:Data.to_node) pc_guard) ~f:(fun pc_guard -> + Option.bind (Data.to_node pc_rhs) ~f:(fun pc_rhs -> + Some { pc_lhs; pc_guard; pc_rhs } + ))) + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "case"; + node = Unversioned.Private.transparent node; + }) + + let pc_lhs t = (to_concrete t).pc_lhs + let pc_guard t = (to_concrete t).pc_guard + let pc_rhs t = (to_concrete t).pc_rhs +end + +module Letop = struct + type t = letop + + type concrete = + { let_ : binding_op + ; ands : binding_op list + ; body : expression + } + + let create ~let_ ~ands ~body = + let fields = + [| Data.of_node let_ + ; (Data.of_list ~f:Data.of_node) ands + ; Data.of_node body + |] + in + node "letop" (Record fields) + + let of_concrete { let_; ands; body } = + create ~let_ ~ands ~body + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "letop" + ; data = Record [| let_; ands; body |] + } -> + Option.bind (Data.to_node let_) ~f:(fun let_ -> + Option.bind ((Data.to_list ~f:Data.to_node) ands) ~f:(fun ands -> + Option.bind (Data.to_node body) ~f:(fun body -> + Some { let_; ands; body } + ))) + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "letop"; + node = Unversioned.Private.transparent node; + }) + + let let_ t = (to_concrete t).let_ + let ands t = (to_concrete t).ands + let body t = (to_concrete t).body +end + +module Binding_op = struct + type t = binding_op + + type concrete = + { pbop_op : string Astlib.Loc.t + ; pbop_pat : pattern + ; pbop_exp : expression + ; pbop_loc : Astlib.Location.t + } + + let create ~pbop_op ~pbop_pat ~pbop_exp ~pbop_loc = + let fields = + [| (Data.of_loc ~f:Data.of_string) pbop_op + ; Data.of_node pbop_pat + ; Data.of_node pbop_exp + ; Data.of_location pbop_loc + |] + in + node "binding_op" (Record fields) + + let of_concrete { pbop_op; pbop_pat; pbop_exp; pbop_loc } = + create ~pbop_op ~pbop_pat ~pbop_exp ~pbop_loc + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "binding_op" + ; data = Record [| pbop_op; pbop_pat; pbop_exp; pbop_loc |] + } -> + Option.bind ((Data.to_loc ~f:Data.to_string) pbop_op) ~f:(fun pbop_op -> + Option.bind (Data.to_node pbop_pat) ~f:(fun pbop_pat -> + Option.bind (Data.to_node pbop_exp) ~f:(fun pbop_exp -> + Option.bind (Data.to_location pbop_loc) ~f:(fun pbop_loc -> + Some { pbop_op; pbop_pat; pbop_exp; pbop_loc } + )))) + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "binding_op"; + node = Unversioned.Private.transparent node; + }) + + let pbop_op t = (to_concrete t).pbop_op + let pbop_pat t = (to_concrete t).pbop_pat + let pbop_exp t = (to_concrete t).pbop_exp + let pbop_loc t = (to_concrete t).pbop_loc +end + +module Value_description = struct + type t = value_description + + type concrete = + { pval_name : string Astlib.Loc.t + ; pval_type : core_type + ; pval_prim : string list + ; pval_attributes : attributes + ; pval_loc : Astlib.Location.t + } + + let create ~pval_name ~pval_type ~pval_prim ~pval_attributes ~pval_loc = + let fields = + [| (Data.of_loc ~f:Data.of_string) pval_name + ; Data.of_node pval_type + ; (Data.of_list ~f:Data.of_string) pval_prim + ; Data.of_node pval_attributes + ; Data.of_location pval_loc + |] + in + node "value_description" (Record fields) + + let of_concrete { pval_name; pval_type; pval_prim; pval_attributes; pval_loc } = + create ~pval_name ~pval_type ~pval_prim ~pval_attributes ~pval_loc + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "value_description" + ; data = Record [| pval_name; pval_type; pval_prim; pval_attributes; pval_loc |] + } -> + Option.bind ((Data.to_loc ~f:Data.to_string) pval_name) ~f:(fun pval_name -> + Option.bind (Data.to_node pval_type) ~f:(fun pval_type -> + Option.bind ((Data.to_list ~f:Data.to_string) pval_prim) ~f:(fun pval_prim -> + Option.bind (Data.to_node pval_attributes) ~f:(fun pval_attributes -> + Option.bind (Data.to_location pval_loc) ~f:(fun pval_loc -> + Some { pval_name; pval_type; pval_prim; pval_attributes; pval_loc } + ))))) + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "value_description"; + node = Unversioned.Private.transparent node; + }) + + let pval_name t = (to_concrete t).pval_name + let pval_type t = (to_concrete t).pval_type + let pval_prim t = (to_concrete t).pval_prim + let pval_attributes t = (to_concrete t).pval_attributes + let pval_loc t = (to_concrete t).pval_loc +end + +module Type_declaration = struct + type t = type_declaration + + type concrete = + { ptype_name : string Astlib.Loc.t + ; ptype_params : (core_type * variance) list + ; ptype_cstrs : (core_type * core_type * Astlib.Location.t) list + ; ptype_kind : type_kind + ; ptype_private : private_flag + ; ptype_manifest : core_type option + ; ptype_attributes : attributes + ; ptype_loc : Astlib.Location.t + } + + let create ~ptype_name ~ptype_params ~ptype_cstrs ~ptype_kind ~ptype_private ~ptype_manifest ~ptype_attributes ~ptype_loc = + let fields = + [| (Data.of_loc ~f:Data.of_string) ptype_name + ; (Data.of_list ~f:(Data.of_tuple2 ~f1:Data.of_node ~f2:Data.of_node)) ptype_params + ; (Data.of_list ~f:(Data.of_tuple3 ~f1:Data.of_node ~f2:Data.of_node ~f3:Data.of_location)) ptype_cstrs + ; Data.of_node ptype_kind + ; Data.of_node ptype_private + ; (Data.of_option ~f:Data.of_node) ptype_manifest + ; Data.of_node ptype_attributes + ; Data.of_location ptype_loc + |] + in + node "type_declaration" (Record fields) + + let of_concrete { ptype_name; ptype_params; ptype_cstrs; ptype_kind; ptype_private; ptype_manifest; ptype_attributes; ptype_loc } = + create ~ptype_name ~ptype_params ~ptype_cstrs ~ptype_kind ~ptype_private ~ptype_manifest ~ptype_attributes ~ptype_loc + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "type_declaration" + ; data = Record [| ptype_name; ptype_params; ptype_cstrs; ptype_kind; ptype_private; ptype_manifest; ptype_attributes; ptype_loc |] + } -> + Option.bind ((Data.to_loc ~f:Data.to_string) ptype_name) ~f:(fun ptype_name -> + Option.bind ((Data.to_list ~f:(Data.to_tuple2 ~f1:Data.to_node ~f2:Data.to_node)) ptype_params) ~f:(fun ptype_params -> + Option.bind ((Data.to_list ~f:(Data.to_tuple3 ~f1:Data.to_node ~f2:Data.to_node ~f3:Data.to_location)) ptype_cstrs) ~f:(fun ptype_cstrs -> + Option.bind (Data.to_node ptype_kind) ~f:(fun ptype_kind -> + Option.bind (Data.to_node ptype_private) ~f:(fun ptype_private -> + Option.bind ((Data.to_option ~f:Data.to_node) ptype_manifest) ~f:(fun ptype_manifest -> + Option.bind (Data.to_node ptype_attributes) ~f:(fun ptype_attributes -> + Option.bind (Data.to_location ptype_loc) ~f:(fun ptype_loc -> + Some { ptype_name; ptype_params; ptype_cstrs; ptype_kind; ptype_private; ptype_manifest; ptype_attributes; ptype_loc } + )))))))) + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "type_declaration"; + node = Unversioned.Private.transparent node; + }) + + let ptype_name t = (to_concrete t).ptype_name + let ptype_params t = (to_concrete t).ptype_params + let ptype_cstrs t = (to_concrete t).ptype_cstrs + let ptype_kind t = (to_concrete t).ptype_kind + let ptype_private t = (to_concrete t).ptype_private + let ptype_manifest t = (to_concrete t).ptype_manifest + let ptype_attributes t = (to_concrete t).ptype_attributes + let ptype_loc t = (to_concrete t).ptype_loc +end + +module Type_kind = struct + type t = type_kind + + type concrete = + | Ptype_abstract + | Ptype_variant of constructor_declaration list + | Ptype_record of label_declaration list + | Ptype_open + + let ptype_abstract = + node "type_kind" (Variant { tag = "Ptype_abstract"; args = [||] }) + let ptype_variant x1 = + node "type_kind" + (Variant + { tag = "Ptype_variant" + ; args = + [| (Data.of_list ~f:Data.of_node) x1 + |] + }) + let ptype_record x1 = + node "type_kind" + (Variant + { tag = "Ptype_record" + ; args = + [| (Data.of_list ~f:Data.of_node) x1 + |] + }) + let ptype_open = + node "type_kind" (Variant { tag = "Ptype_open"; args = [||] }) + + let of_concrete c = + match c with + | Ptype_abstract -> ptype_abstract + | Ptype_variant (x1) -> + ptype_variant x1 + | Ptype_record (x1) -> + ptype_record x1 + | Ptype_open -> ptype_open + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "type_kind"; data } -> + begin + match data with + | Variant { tag = "Ptype_abstract"; args = [||] } -> Some Ptype_abstract + | Variant { tag = "Ptype_variant"; args = [| x1 |] } -> + Option.bind ((Data.to_list ~f:Data.to_node) x1) ~f:(fun x1 -> + Some (Ptype_variant (x1)) + ) + | Variant { tag = "Ptype_record"; args = [| x1 |] } -> + Option.bind ((Data.to_list ~f:Data.to_node) x1) ~f:(fun x1 -> + Some (Ptype_record (x1)) + ) + | Variant { tag = "Ptype_open"; args = [||] } -> Some Ptype_open + | _ -> None + end + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "type_kind"; + node = Unversioned.Private.transparent node; + }) +end + +module Label_declaration = struct + type t = label_declaration + + type concrete = + { pld_name : string Astlib.Loc.t + ; pld_mutable : mutable_flag + ; pld_type : core_type + ; pld_loc : Astlib.Location.t + ; pld_attributes : attributes + } + + let create ~pld_name ~pld_mutable ~pld_type ~pld_loc ~pld_attributes = + let fields = + [| (Data.of_loc ~f:Data.of_string) pld_name + ; Data.of_node pld_mutable + ; Data.of_node pld_type + ; Data.of_location pld_loc + ; Data.of_node pld_attributes + |] + in + node "label_declaration" (Record fields) + + let of_concrete { pld_name; pld_mutable; pld_type; pld_loc; pld_attributes } = + create ~pld_name ~pld_mutable ~pld_type ~pld_loc ~pld_attributes + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "label_declaration" + ; data = Record [| pld_name; pld_mutable; pld_type; pld_loc; pld_attributes |] + } -> + Option.bind ((Data.to_loc ~f:Data.to_string) pld_name) ~f:(fun pld_name -> + Option.bind (Data.to_node pld_mutable) ~f:(fun pld_mutable -> + Option.bind (Data.to_node pld_type) ~f:(fun pld_type -> + Option.bind (Data.to_location pld_loc) ~f:(fun pld_loc -> + Option.bind (Data.to_node pld_attributes) ~f:(fun pld_attributes -> + Some { pld_name; pld_mutable; pld_type; pld_loc; pld_attributes } + ))))) + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "label_declaration"; + node = Unversioned.Private.transparent node; + }) + + let pld_name t = (to_concrete t).pld_name + let pld_mutable t = (to_concrete t).pld_mutable + let pld_type t = (to_concrete t).pld_type + let pld_loc t = (to_concrete t).pld_loc + let pld_attributes t = (to_concrete t).pld_attributes +end + +module Constructor_declaration = struct + type t = constructor_declaration + + type concrete = + { pcd_name : string Astlib.Loc.t + ; pcd_args : constructor_arguments + ; pcd_res : core_type option + ; pcd_loc : Astlib.Location.t + ; pcd_attributes : attributes + } + + let create ~pcd_name ~pcd_args ~pcd_res ~pcd_loc ~pcd_attributes = + let fields = + [| (Data.of_loc ~f:Data.of_string) pcd_name + ; Data.of_node pcd_args + ; (Data.of_option ~f:Data.of_node) pcd_res + ; Data.of_location pcd_loc + ; Data.of_node pcd_attributes + |] + in + node "constructor_declaration" (Record fields) + + let of_concrete { pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes } = + create ~pcd_name ~pcd_args ~pcd_res ~pcd_loc ~pcd_attributes + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "constructor_declaration" + ; data = Record [| pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes |] + } -> + Option.bind ((Data.to_loc ~f:Data.to_string) pcd_name) ~f:(fun pcd_name -> + Option.bind (Data.to_node pcd_args) ~f:(fun pcd_args -> + Option.bind ((Data.to_option ~f:Data.to_node) pcd_res) ~f:(fun pcd_res -> + Option.bind (Data.to_location pcd_loc) ~f:(fun pcd_loc -> + Option.bind (Data.to_node pcd_attributes) ~f:(fun pcd_attributes -> + Some { pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes } + ))))) + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "constructor_declaration"; + node = Unversioned.Private.transparent node; + }) + + let pcd_name t = (to_concrete t).pcd_name + let pcd_args t = (to_concrete t).pcd_args + let pcd_res t = (to_concrete t).pcd_res + let pcd_loc t = (to_concrete t).pcd_loc + let pcd_attributes t = (to_concrete t).pcd_attributes +end + +module Constructor_arguments = struct + type t = constructor_arguments + + type concrete = + | Pcstr_tuple of core_type list + | Pcstr_record of label_declaration list + + let pcstr_tuple x1 = + node "constructor_arguments" + (Variant + { tag = "Pcstr_tuple" + ; args = + [| (Data.of_list ~f:Data.of_node) x1 + |] + }) + let pcstr_record x1 = + node "constructor_arguments" + (Variant + { tag = "Pcstr_record" + ; args = + [| (Data.of_list ~f:Data.of_node) x1 + |] + }) + + let of_concrete c = + match c with + | Pcstr_tuple (x1) -> + pcstr_tuple x1 + | Pcstr_record (x1) -> + pcstr_record x1 + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "constructor_arguments"; data } -> + begin + match data with + | Variant { tag = "Pcstr_tuple"; args = [| x1 |] } -> + Option.bind ((Data.to_list ~f:Data.to_node) x1) ~f:(fun x1 -> + Some (Pcstr_tuple (x1)) + ) + | Variant { tag = "Pcstr_record"; args = [| x1 |] } -> + Option.bind ((Data.to_list ~f:Data.to_node) x1) ~f:(fun x1 -> + Some (Pcstr_record (x1)) + ) + | _ -> None + end + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "constructor_arguments"; + node = Unversioned.Private.transparent node; + }) +end + +module Type_extension = struct + type t = type_extension + + type concrete = + { ptyext_path : longident_loc + ; ptyext_params : (core_type * variance) list + ; ptyext_constructors : extension_constructor list + ; ptyext_private : private_flag + ; ptyext_loc : Astlib.Location.t + ; ptyext_attributes : attributes + } + + let create ~ptyext_path ~ptyext_params ~ptyext_constructors ~ptyext_private ~ptyext_loc ~ptyext_attributes = + let fields = + [| Data.of_node ptyext_path + ; (Data.of_list ~f:(Data.of_tuple2 ~f1:Data.of_node ~f2:Data.of_node)) ptyext_params + ; (Data.of_list ~f:Data.of_node) ptyext_constructors + ; Data.of_node ptyext_private + ; Data.of_location ptyext_loc + ; Data.of_node ptyext_attributes + |] + in + node "type_extension" (Record fields) + + let of_concrete { ptyext_path; ptyext_params; ptyext_constructors; ptyext_private; ptyext_loc; ptyext_attributes } = + create ~ptyext_path ~ptyext_params ~ptyext_constructors ~ptyext_private ~ptyext_loc ~ptyext_attributes + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "type_extension" + ; data = Record [| ptyext_path; ptyext_params; ptyext_constructors; ptyext_private; ptyext_loc; ptyext_attributes |] + } -> + Option.bind (Data.to_node ptyext_path) ~f:(fun ptyext_path -> + Option.bind ((Data.to_list ~f:(Data.to_tuple2 ~f1:Data.to_node ~f2:Data.to_node)) ptyext_params) ~f:(fun ptyext_params -> + Option.bind ((Data.to_list ~f:Data.to_node) ptyext_constructors) ~f:(fun ptyext_constructors -> + Option.bind (Data.to_node ptyext_private) ~f:(fun ptyext_private -> + Option.bind (Data.to_location ptyext_loc) ~f:(fun ptyext_loc -> + Option.bind (Data.to_node ptyext_attributes) ~f:(fun ptyext_attributes -> + Some { ptyext_path; ptyext_params; ptyext_constructors; ptyext_private; ptyext_loc; ptyext_attributes } + )))))) + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "type_extension"; + node = Unversioned.Private.transparent node; + }) + + let ptyext_path t = (to_concrete t).ptyext_path + let ptyext_params t = (to_concrete t).ptyext_params + let ptyext_constructors t = (to_concrete t).ptyext_constructors + let ptyext_private t = (to_concrete t).ptyext_private + let ptyext_loc t = (to_concrete t).ptyext_loc + let ptyext_attributes t = (to_concrete t).ptyext_attributes +end + +module Extension_constructor = struct + type t = extension_constructor + + type concrete = + { pext_name : string Astlib.Loc.t + ; pext_kind : extension_constructor_kind + ; pext_loc : Astlib.Location.t + ; pext_attributes : attributes + } + + let create ~pext_name ~pext_kind ~pext_loc ~pext_attributes = + let fields = + [| (Data.of_loc ~f:Data.of_string) pext_name + ; Data.of_node pext_kind + ; Data.of_location pext_loc + ; Data.of_node pext_attributes + |] + in + node "extension_constructor" (Record fields) + + let of_concrete { pext_name; pext_kind; pext_loc; pext_attributes } = + create ~pext_name ~pext_kind ~pext_loc ~pext_attributes + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "extension_constructor" + ; data = Record [| pext_name; pext_kind; pext_loc; pext_attributes |] + } -> + Option.bind ((Data.to_loc ~f:Data.to_string) pext_name) ~f:(fun pext_name -> + Option.bind (Data.to_node pext_kind) ~f:(fun pext_kind -> + Option.bind (Data.to_location pext_loc) ~f:(fun pext_loc -> + Option.bind (Data.to_node pext_attributes) ~f:(fun pext_attributes -> + Some { pext_name; pext_kind; pext_loc; pext_attributes } + )))) + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "extension_constructor"; + node = Unversioned.Private.transparent node; + }) + + let pext_name t = (to_concrete t).pext_name + let pext_kind t = (to_concrete t).pext_kind + let pext_loc t = (to_concrete t).pext_loc + let pext_attributes t = (to_concrete t).pext_attributes +end + +module Type_exception = struct + type t = type_exception + + type concrete = + { ptyexn_constructor : extension_constructor + ; ptyexn_loc : Astlib.Location.t + ; ptyexn_attributes : attributes + } + + let create ~ptyexn_constructor ~ptyexn_loc ~ptyexn_attributes = + let fields = + [| Data.of_node ptyexn_constructor + ; Data.of_location ptyexn_loc + ; Data.of_node ptyexn_attributes + |] + in + node "type_exception" (Record fields) + + let of_concrete { ptyexn_constructor; ptyexn_loc; ptyexn_attributes } = + create ~ptyexn_constructor ~ptyexn_loc ~ptyexn_attributes + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "type_exception" + ; data = Record [| ptyexn_constructor; ptyexn_loc; ptyexn_attributes |] + } -> + Option.bind (Data.to_node ptyexn_constructor) ~f:(fun ptyexn_constructor -> + Option.bind (Data.to_location ptyexn_loc) ~f:(fun ptyexn_loc -> + Option.bind (Data.to_node ptyexn_attributes) ~f:(fun ptyexn_attributes -> + Some { ptyexn_constructor; ptyexn_loc; ptyexn_attributes } + ))) + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "type_exception"; + node = Unversioned.Private.transparent node; + }) + + let ptyexn_constructor t = (to_concrete t).ptyexn_constructor + let ptyexn_loc t = (to_concrete t).ptyexn_loc + let ptyexn_attributes t = (to_concrete t).ptyexn_attributes +end + +module Extension_constructor_kind = struct + type t = extension_constructor_kind + + type concrete = + | Pext_decl of constructor_arguments * core_type option + | Pext_rebind of longident_loc + + let pext_decl x1 x2 = + node "extension_constructor_kind" + (Variant + { tag = "Pext_decl" + ; args = + [| Data.of_node x1 + ; (Data.of_option ~f:Data.of_node) x2 + |] + }) + let pext_rebind x1 = + node "extension_constructor_kind" + (Variant + { tag = "Pext_rebind" + ; args = + [| Data.of_node x1 + |] + }) + + let of_concrete c = + match c with + | Pext_decl (x1, x2) -> + pext_decl x1 x2 + | Pext_rebind (x1) -> + pext_rebind x1 + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "extension_constructor_kind"; data } -> + begin + match data with + | Variant { tag = "Pext_decl"; args = [| x1; x2 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind ((Data.to_option ~f:Data.to_node) x2) ~f:(fun x2 -> + Some (Pext_decl (x1, x2)) + )) + | Variant { tag = "Pext_rebind"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Pext_rebind (x1)) + ) + | _ -> None + end + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "extension_constructor_kind"; + node = Unversioned.Private.transparent node; + }) +end + +module Class_type = struct + type t = class_type + + type concrete = + { pcty_desc : class_type_desc + ; pcty_loc : Astlib.Location.t + ; pcty_attributes : attributes + } + + let create ~pcty_desc ~pcty_loc ~pcty_attributes = + let fields = + [| Data.of_node pcty_desc + ; Data.of_location pcty_loc + ; Data.of_node pcty_attributes + |] + in + node "class_type" (Record fields) + + let of_concrete { pcty_desc; pcty_loc; pcty_attributes } = + create ~pcty_desc ~pcty_loc ~pcty_attributes + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "class_type" + ; data = Record [| pcty_desc; pcty_loc; pcty_attributes |] + } -> + Option.bind (Data.to_node pcty_desc) ~f:(fun pcty_desc -> + Option.bind (Data.to_location pcty_loc) ~f:(fun pcty_loc -> + Option.bind (Data.to_node pcty_attributes) ~f:(fun pcty_attributes -> + Some { pcty_desc; pcty_loc; pcty_attributes } + ))) + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "class_type"; + node = Unversioned.Private.transparent node; + }) + + let pcty_desc t = (to_concrete t).pcty_desc + let pcty_loc t = (to_concrete t).pcty_loc + let pcty_attributes t = (to_concrete t).pcty_attributes +end + +module Class_type_desc = struct + type t = class_type_desc + + type concrete = + | Pcty_constr of longident_loc * core_type list + | Pcty_signature of class_signature + | Pcty_arrow of arg_label * core_type * class_type + | Pcty_extension of extension + | Pcty_open of open_description * class_type + + let pcty_constr x1 x2 = + node "class_type_desc" + (Variant + { tag = "Pcty_constr" + ; args = + [| Data.of_node x1 + ; (Data.of_list ~f:Data.of_node) x2 + |] + }) + let pcty_signature x1 = + node "class_type_desc" + (Variant + { tag = "Pcty_signature" + ; args = + [| Data.of_node x1 + |] + }) + let pcty_arrow x1 x2 x3 = + node "class_type_desc" + (Variant + { tag = "Pcty_arrow" + ; args = + [| Data.of_node x1 + ; Data.of_node x2 + ; Data.of_node x3 + |] + }) + let pcty_extension x1 = + node "class_type_desc" + (Variant + { tag = "Pcty_extension" + ; args = + [| Data.of_node x1 + |] + }) + let pcty_open x1 x2 = + node "class_type_desc" + (Variant + { tag = "Pcty_open" + ; args = + [| Data.of_node x1 + ; Data.of_node x2 + |] + }) + + let of_concrete c = + match c with + | Pcty_constr (x1, x2) -> + pcty_constr x1 x2 + | Pcty_signature (x1) -> + pcty_signature x1 + | Pcty_arrow (x1, x2, x3) -> + pcty_arrow x1 x2 x3 + | Pcty_extension (x1) -> + pcty_extension x1 + | Pcty_open (x1, x2) -> + pcty_open x1 x2 + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "class_type_desc"; data } -> + begin + match data with + | Variant { tag = "Pcty_constr"; args = [| x1; x2 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind ((Data.to_list ~f:Data.to_node) x2) ~f:(fun x2 -> + Some (Pcty_constr (x1, x2)) + )) + | Variant { tag = "Pcty_signature"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Pcty_signature (x1)) + ) + | Variant { tag = "Pcty_arrow"; args = [| x1; x2; x3 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind (Data.to_node x2) ~f:(fun x2 -> + Option.bind (Data.to_node x3) ~f:(fun x3 -> + Some (Pcty_arrow (x1, x2, x3)) + ))) + | Variant { tag = "Pcty_extension"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Pcty_extension (x1)) + ) + | Variant { tag = "Pcty_open"; args = [| x1; x2 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind (Data.to_node x2) ~f:(fun x2 -> + Some (Pcty_open (x1, x2)) + )) + | _ -> None + end + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "class_type_desc"; + node = Unversioned.Private.transparent node; + }) +end + +module Class_signature = struct + type t = class_signature + + type concrete = + { pcsig_self : core_type + ; pcsig_fields : class_type_field list + } + + let create ~pcsig_self ~pcsig_fields = + let fields = + [| Data.of_node pcsig_self + ; (Data.of_list ~f:Data.of_node) pcsig_fields + |] + in + node "class_signature" (Record fields) + + let of_concrete { pcsig_self; pcsig_fields } = + create ~pcsig_self ~pcsig_fields + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "class_signature" + ; data = Record [| pcsig_self; pcsig_fields |] + } -> + Option.bind (Data.to_node pcsig_self) ~f:(fun pcsig_self -> + Option.bind ((Data.to_list ~f:Data.to_node) pcsig_fields) ~f:(fun pcsig_fields -> + Some { pcsig_self; pcsig_fields } + )) + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "class_signature"; + node = Unversioned.Private.transparent node; + }) + + let pcsig_self t = (to_concrete t).pcsig_self + let pcsig_fields t = (to_concrete t).pcsig_fields +end + +module Class_type_field = struct + type t = class_type_field + + type concrete = + { pctf_desc : class_type_field_desc + ; pctf_loc : Astlib.Location.t + ; pctf_attributes : attributes + } + + let create ~pctf_desc ~pctf_loc ~pctf_attributes = + let fields = + [| Data.of_node pctf_desc + ; Data.of_location pctf_loc + ; Data.of_node pctf_attributes + |] + in + node "class_type_field" (Record fields) + + let of_concrete { pctf_desc; pctf_loc; pctf_attributes } = + create ~pctf_desc ~pctf_loc ~pctf_attributes + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "class_type_field" + ; data = Record [| pctf_desc; pctf_loc; pctf_attributes |] + } -> + Option.bind (Data.to_node pctf_desc) ~f:(fun pctf_desc -> + Option.bind (Data.to_location pctf_loc) ~f:(fun pctf_loc -> + Option.bind (Data.to_node pctf_attributes) ~f:(fun pctf_attributes -> + Some { pctf_desc; pctf_loc; pctf_attributes } + ))) + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "class_type_field"; + node = Unversioned.Private.transparent node; + }) + + let pctf_desc t = (to_concrete t).pctf_desc + let pctf_loc t = (to_concrete t).pctf_loc + let pctf_attributes t = (to_concrete t).pctf_attributes +end + +module Class_type_field_desc = struct + type t = class_type_field_desc + + type concrete = + | Pctf_inherit of class_type + | Pctf_val of (string Astlib.Loc.t * mutable_flag * virtual_flag * core_type) + | Pctf_method of (string Astlib.Loc.t * private_flag * virtual_flag * core_type) + | Pctf_constraint of (core_type * core_type) + | Pctf_attribute of attribute + | Pctf_extension of extension + + let pctf_inherit x1 = + node "class_type_field_desc" + (Variant + { tag = "Pctf_inherit" + ; args = + [| Data.of_node x1 + |] + }) + let pctf_val x1 = + node "class_type_field_desc" + (Variant + { tag = "Pctf_val" + ; args = + [| (Data.of_tuple4 ~f1:(Data.of_loc ~f:Data.of_string) ~f2:Data.of_node ~f3:Data.of_node ~f4:Data.of_node) x1 + |] + }) + let pctf_method x1 = + node "class_type_field_desc" + (Variant + { tag = "Pctf_method" + ; args = + [| (Data.of_tuple4 ~f1:(Data.of_loc ~f:Data.of_string) ~f2:Data.of_node ~f3:Data.of_node ~f4:Data.of_node) x1 + |] + }) + let pctf_constraint x1 = + node "class_type_field_desc" + (Variant + { tag = "Pctf_constraint" + ; args = + [| (Data.of_tuple2 ~f1:Data.of_node ~f2:Data.of_node) x1 + |] + }) + let pctf_attribute x1 = + node "class_type_field_desc" + (Variant + { tag = "Pctf_attribute" + ; args = + [| Data.of_node x1 + |] + }) + let pctf_extension x1 = + node "class_type_field_desc" + (Variant + { tag = "Pctf_extension" + ; args = + [| Data.of_node x1 + |] + }) + + let of_concrete c = + match c with + | Pctf_inherit (x1) -> + pctf_inherit x1 + | Pctf_val (x1) -> + pctf_val x1 + | Pctf_method (x1) -> + pctf_method x1 + | Pctf_constraint (x1) -> + pctf_constraint x1 + | Pctf_attribute (x1) -> + pctf_attribute x1 + | Pctf_extension (x1) -> + pctf_extension x1 + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "class_type_field_desc"; data } -> + begin + match data with + | Variant { tag = "Pctf_inherit"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Pctf_inherit (x1)) + ) + | Variant { tag = "Pctf_val"; args = [| x1 |] } -> + Option.bind ((Data.to_tuple4 ~f1:(Data.to_loc ~f:Data.to_string) ~f2:Data.to_node ~f3:Data.to_node ~f4:Data.to_node) x1) ~f:(fun x1 -> + Some (Pctf_val (x1)) + ) + | Variant { tag = "Pctf_method"; args = [| x1 |] } -> + Option.bind ((Data.to_tuple4 ~f1:(Data.to_loc ~f:Data.to_string) ~f2:Data.to_node ~f3:Data.to_node ~f4:Data.to_node) x1) ~f:(fun x1 -> + Some (Pctf_method (x1)) + ) + | Variant { tag = "Pctf_constraint"; args = [| x1 |] } -> + Option.bind ((Data.to_tuple2 ~f1:Data.to_node ~f2:Data.to_node) x1) ~f:(fun x1 -> + Some (Pctf_constraint (x1)) + ) + | Variant { tag = "Pctf_attribute"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Pctf_attribute (x1)) + ) + | Variant { tag = "Pctf_extension"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Pctf_extension (x1)) + ) + | _ -> None + end + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "class_type_field_desc"; + node = Unversioned.Private.transparent node; + }) +end + +module Class_infos = struct + type 'a t = 'a class_infos + + type 'a concrete = + { pci_virt : virtual_flag + ; pci_params : (core_type * variance) list + ; pci_name : string Astlib.Loc.t + ; pci_expr : 'a + ; pci_loc : Astlib.Location.t + ; pci_attributes : attributes + } + + let create ~pci_virt ~pci_params ~pci_name ~pci_expr ~pci_loc ~pci_attributes = + let fields = + [| Data.of_node pci_virt + ; (Data.of_list ~f:(Data.of_tuple2 ~f1:Data.of_node ~f2:Data.of_node)) pci_params + ; (Data.of_loc ~f:Data.of_string) pci_name + ; Data.of_node pci_expr + ; Data.of_location pci_loc + ; Data.of_node pci_attributes + |] + in + node "class_infos" (Record fields) + + let of_concrete { pci_virt; pci_params; pci_name; pci_expr; pci_loc; pci_attributes } = + create ~pci_virt ~pci_params ~pci_name ~pci_expr ~pci_loc ~pci_attributes + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "class_infos" + ; data = Record [| pci_virt; pci_params; pci_name; pci_expr; pci_loc; pci_attributes |] + } -> + Option.bind (Data.to_node pci_virt) ~f:(fun pci_virt -> + Option.bind ((Data.to_list ~f:(Data.to_tuple2 ~f1:Data.to_node ~f2:Data.to_node)) pci_params) ~f:(fun pci_params -> + Option.bind ((Data.to_loc ~f:Data.to_string) pci_name) ~f:(fun pci_name -> + Option.bind (Data.to_node pci_expr) ~f:(fun pci_expr -> + Option.bind (Data.to_location pci_loc) ~f:(fun pci_loc -> + Option.bind (Data.to_node pci_attributes) ~f:(fun pci_attributes -> + Some { pci_virt; pci_params; pci_name; pci_expr; pci_loc; pci_attributes } + )))))) + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "class_infos"; + node = Unversioned.Private.transparent node; + }) + + let pci_virt t = (to_concrete t).pci_virt + let pci_params t = (to_concrete t).pci_params + let pci_name t = (to_concrete t).pci_name + let pci_expr t = (to_concrete t).pci_expr + let pci_loc t = (to_concrete t).pci_loc + let pci_attributes t = (to_concrete t).pci_attributes +end + +module Class_description = struct + type t = class_description + + type concrete = class_type class_infos + + let create = + let data = Data.of_node in + fun x -> node "class_description" (data x) + + let of_concrete = create + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "class_description"; data } -> Data.to_node data + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "class_description"; + node = Unversioned.Private.transparent node; + }) +end + +module Class_type_declaration = struct + type t = class_type_declaration + + type concrete = class_type class_infos + + let create = + let data = Data.of_node in + fun x -> node "class_type_declaration" (data x) + + let of_concrete = create + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "class_type_declaration"; data } -> Data.to_node data + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "class_type_declaration"; + node = Unversioned.Private.transparent node; + }) +end + +module Class_expr = struct + type t = class_expr + + type concrete = + { pcl_desc : class_expr_desc + ; pcl_loc : Astlib.Location.t + ; pcl_attributes : attributes + } + + let create ~pcl_desc ~pcl_loc ~pcl_attributes = + let fields = + [| Data.of_node pcl_desc + ; Data.of_location pcl_loc + ; Data.of_node pcl_attributes + |] + in + node "class_expr" (Record fields) + + let of_concrete { pcl_desc; pcl_loc; pcl_attributes } = + create ~pcl_desc ~pcl_loc ~pcl_attributes + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "class_expr" + ; data = Record [| pcl_desc; pcl_loc; pcl_attributes |] + } -> + Option.bind (Data.to_node pcl_desc) ~f:(fun pcl_desc -> + Option.bind (Data.to_location pcl_loc) ~f:(fun pcl_loc -> + Option.bind (Data.to_node pcl_attributes) ~f:(fun pcl_attributes -> + Some { pcl_desc; pcl_loc; pcl_attributes } + ))) + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "class_expr"; + node = Unversioned.Private.transparent node; + }) + + let pcl_desc t = (to_concrete t).pcl_desc + let pcl_loc t = (to_concrete t).pcl_loc + let pcl_attributes t = (to_concrete t).pcl_attributes +end + +module Class_expr_desc = struct + type t = class_expr_desc + + type concrete = + | Pcl_constr of longident_loc * core_type list + | Pcl_structure of class_structure + | Pcl_fun of arg_label * expression option * pattern * class_expr + | Pcl_apply of class_expr * (arg_label * expression) list + | Pcl_let of rec_flag * value_binding list * class_expr + | Pcl_constraint of class_expr * class_type + | Pcl_extension of extension + | Pcl_open of open_description * class_expr + + let pcl_constr x1 x2 = + node "class_expr_desc" + (Variant + { tag = "Pcl_constr" + ; args = + [| Data.of_node x1 + ; (Data.of_list ~f:Data.of_node) x2 + |] + }) + let pcl_structure x1 = + node "class_expr_desc" + (Variant + { tag = "Pcl_structure" + ; args = + [| Data.of_node x1 + |] + }) + let pcl_fun x1 x2 x3 x4 = + node "class_expr_desc" + (Variant + { tag = "Pcl_fun" + ; args = + [| Data.of_node x1 + ; (Data.of_option ~f:Data.of_node) x2 + ; Data.of_node x3 + ; Data.of_node x4 + |] + }) + let pcl_apply x1 x2 = + node "class_expr_desc" + (Variant + { tag = "Pcl_apply" + ; args = + [| Data.of_node x1 + ; (Data.of_list ~f:(Data.of_tuple2 ~f1:Data.of_node ~f2:Data.of_node)) x2 + |] + }) + let pcl_let x1 x2 x3 = + node "class_expr_desc" + (Variant + { tag = "Pcl_let" + ; args = + [| Data.of_node x1 + ; (Data.of_list ~f:Data.of_node) x2 + ; Data.of_node x3 + |] + }) + let pcl_constraint x1 x2 = + node "class_expr_desc" + (Variant + { tag = "Pcl_constraint" + ; args = + [| Data.of_node x1 + ; Data.of_node x2 + |] + }) + let pcl_extension x1 = + node "class_expr_desc" + (Variant + { tag = "Pcl_extension" + ; args = + [| Data.of_node x1 + |] + }) + let pcl_open x1 x2 = + node "class_expr_desc" + (Variant + { tag = "Pcl_open" + ; args = + [| Data.of_node x1 + ; Data.of_node x2 + |] + }) + + let of_concrete c = + match c with + | Pcl_constr (x1, x2) -> + pcl_constr x1 x2 + | Pcl_structure (x1) -> + pcl_structure x1 + | Pcl_fun (x1, x2, x3, x4) -> + pcl_fun x1 x2 x3 x4 + | Pcl_apply (x1, x2) -> + pcl_apply x1 x2 + | Pcl_let (x1, x2, x3) -> + pcl_let x1 x2 x3 + | Pcl_constraint (x1, x2) -> + pcl_constraint x1 x2 + | Pcl_extension (x1) -> + pcl_extension x1 + | Pcl_open (x1, x2) -> + pcl_open x1 x2 + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "class_expr_desc"; data } -> + begin + match data with + | Variant { tag = "Pcl_constr"; args = [| x1; x2 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind ((Data.to_list ~f:Data.to_node) x2) ~f:(fun x2 -> + Some (Pcl_constr (x1, x2)) + )) + | Variant { tag = "Pcl_structure"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Pcl_structure (x1)) + ) + | Variant { tag = "Pcl_fun"; args = [| x1; x2; x3; x4 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind ((Data.to_option ~f:Data.to_node) x2) ~f:(fun x2 -> + Option.bind (Data.to_node x3) ~f:(fun x3 -> + Option.bind (Data.to_node x4) ~f:(fun x4 -> + Some (Pcl_fun (x1, x2, x3, x4)) + )))) + | Variant { tag = "Pcl_apply"; args = [| x1; x2 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind ((Data.to_list ~f:(Data.to_tuple2 ~f1:Data.to_node ~f2:Data.to_node)) x2) ~f:(fun x2 -> + Some (Pcl_apply (x1, x2)) + )) + | Variant { tag = "Pcl_let"; args = [| x1; x2; x3 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind ((Data.to_list ~f:Data.to_node) x2) ~f:(fun x2 -> + Option.bind (Data.to_node x3) ~f:(fun x3 -> + Some (Pcl_let (x1, x2, x3)) + ))) + | Variant { tag = "Pcl_constraint"; args = [| x1; x2 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind (Data.to_node x2) ~f:(fun x2 -> + Some (Pcl_constraint (x1, x2)) + )) + | Variant { tag = "Pcl_extension"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Pcl_extension (x1)) + ) + | Variant { tag = "Pcl_open"; args = [| x1; x2 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind (Data.to_node x2) ~f:(fun x2 -> + Some (Pcl_open (x1, x2)) + )) + | _ -> None + end + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "class_expr_desc"; + node = Unversioned.Private.transparent node; + }) +end + +module Class_structure = struct + type t = class_structure + + type concrete = + { pcstr_self : pattern + ; pcstr_fields : class_field list + } + + let create ~pcstr_self ~pcstr_fields = + let fields = + [| Data.of_node pcstr_self + ; (Data.of_list ~f:Data.of_node) pcstr_fields + |] + in + node "class_structure" (Record fields) + + let of_concrete { pcstr_self; pcstr_fields } = + create ~pcstr_self ~pcstr_fields + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "class_structure" + ; data = Record [| pcstr_self; pcstr_fields |] + } -> + Option.bind (Data.to_node pcstr_self) ~f:(fun pcstr_self -> + Option.bind ((Data.to_list ~f:Data.to_node) pcstr_fields) ~f:(fun pcstr_fields -> + Some { pcstr_self; pcstr_fields } + )) + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "class_structure"; + node = Unversioned.Private.transparent node; + }) + + let pcstr_self t = (to_concrete t).pcstr_self + let pcstr_fields t = (to_concrete t).pcstr_fields +end + +module Class_field = struct + type t = class_field + + type concrete = + { pcf_desc : class_field_desc + ; pcf_loc : Astlib.Location.t + ; pcf_attributes : attributes + } + + let create ~pcf_desc ~pcf_loc ~pcf_attributes = + let fields = + [| Data.of_node pcf_desc + ; Data.of_location pcf_loc + ; Data.of_node pcf_attributes + |] + in + node "class_field" (Record fields) + + let of_concrete { pcf_desc; pcf_loc; pcf_attributes } = + create ~pcf_desc ~pcf_loc ~pcf_attributes + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "class_field" + ; data = Record [| pcf_desc; pcf_loc; pcf_attributes |] + } -> + Option.bind (Data.to_node pcf_desc) ~f:(fun pcf_desc -> + Option.bind (Data.to_location pcf_loc) ~f:(fun pcf_loc -> + Option.bind (Data.to_node pcf_attributes) ~f:(fun pcf_attributes -> + Some { pcf_desc; pcf_loc; pcf_attributes } + ))) + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "class_field"; + node = Unversioned.Private.transparent node; + }) + + let pcf_desc t = (to_concrete t).pcf_desc + let pcf_loc t = (to_concrete t).pcf_loc + let pcf_attributes t = (to_concrete t).pcf_attributes +end + +module Class_field_desc = struct + type t = class_field_desc + + type concrete = + | Pcf_inherit of override_flag * class_expr * string Astlib.Loc.t option + | Pcf_val of (string Astlib.Loc.t * mutable_flag * class_field_kind) + | Pcf_method of (string Astlib.Loc.t * private_flag * class_field_kind) + | Pcf_constraint of (core_type * core_type) + | Pcf_initializer of expression + | Pcf_attribute of attribute + | Pcf_extension of extension + + let pcf_inherit x1 x2 x3 = + node "class_field_desc" + (Variant + { tag = "Pcf_inherit" + ; args = + [| Data.of_node x1 + ; Data.of_node x2 + ; (Data.of_option ~f:(Data.of_loc ~f:Data.of_string)) x3 + |] + }) + let pcf_val x1 = + node "class_field_desc" + (Variant + { tag = "Pcf_val" + ; args = + [| (Data.of_tuple3 ~f1:(Data.of_loc ~f:Data.of_string) ~f2:Data.of_node ~f3:Data.of_node) x1 + |] + }) + let pcf_method x1 = + node "class_field_desc" + (Variant + { tag = "Pcf_method" + ; args = + [| (Data.of_tuple3 ~f1:(Data.of_loc ~f:Data.of_string) ~f2:Data.of_node ~f3:Data.of_node) x1 + |] + }) + let pcf_constraint x1 = + node "class_field_desc" + (Variant + { tag = "Pcf_constraint" + ; args = + [| (Data.of_tuple2 ~f1:Data.of_node ~f2:Data.of_node) x1 + |] + }) + let pcf_initializer x1 = + node "class_field_desc" + (Variant + { tag = "Pcf_initializer" + ; args = + [| Data.of_node x1 + |] + }) + let pcf_attribute x1 = + node "class_field_desc" + (Variant + { tag = "Pcf_attribute" + ; args = + [| Data.of_node x1 + |] + }) + let pcf_extension x1 = + node "class_field_desc" + (Variant + { tag = "Pcf_extension" + ; args = + [| Data.of_node x1 + |] + }) + + let of_concrete c = + match c with + | Pcf_inherit (x1, x2, x3) -> + pcf_inherit x1 x2 x3 + | Pcf_val (x1) -> + pcf_val x1 + | Pcf_method (x1) -> + pcf_method x1 + | Pcf_constraint (x1) -> + pcf_constraint x1 + | Pcf_initializer (x1) -> + pcf_initializer x1 + | Pcf_attribute (x1) -> + pcf_attribute x1 + | Pcf_extension (x1) -> + pcf_extension x1 + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "class_field_desc"; data } -> + begin + match data with + | Variant { tag = "Pcf_inherit"; args = [| x1; x2; x3 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind (Data.to_node x2) ~f:(fun x2 -> + Option.bind ((Data.to_option ~f:(Data.to_loc ~f:Data.to_string)) x3) ~f:(fun x3 -> + Some (Pcf_inherit (x1, x2, x3)) + ))) + | Variant { tag = "Pcf_val"; args = [| x1 |] } -> + Option.bind ((Data.to_tuple3 ~f1:(Data.to_loc ~f:Data.to_string) ~f2:Data.to_node ~f3:Data.to_node) x1) ~f:(fun x1 -> + Some (Pcf_val (x1)) + ) + | Variant { tag = "Pcf_method"; args = [| x1 |] } -> + Option.bind ((Data.to_tuple3 ~f1:(Data.to_loc ~f:Data.to_string) ~f2:Data.to_node ~f3:Data.to_node) x1) ~f:(fun x1 -> + Some (Pcf_method (x1)) + ) + | Variant { tag = "Pcf_constraint"; args = [| x1 |] } -> + Option.bind ((Data.to_tuple2 ~f1:Data.to_node ~f2:Data.to_node) x1) ~f:(fun x1 -> + Some (Pcf_constraint (x1)) + ) + | Variant { tag = "Pcf_initializer"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Pcf_initializer (x1)) + ) + | Variant { tag = "Pcf_attribute"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Pcf_attribute (x1)) + ) + | Variant { tag = "Pcf_extension"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Pcf_extension (x1)) + ) + | _ -> None + end + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "class_field_desc"; + node = Unversioned.Private.transparent node; + }) +end + +module Class_field_kind = struct + type t = class_field_kind + + type concrete = + | Cfk_virtual of core_type + | Cfk_concrete of override_flag * expression + + let cfk_virtual x1 = + node "class_field_kind" + (Variant + { tag = "Cfk_virtual" + ; args = + [| Data.of_node x1 + |] + }) + let cfk_concrete x1 x2 = + node "class_field_kind" + (Variant + { tag = "Cfk_concrete" + ; args = + [| Data.of_node x1 + ; Data.of_node x2 + |] + }) + + let of_concrete c = + match c with + | Cfk_virtual (x1) -> + cfk_virtual x1 + | Cfk_concrete (x1, x2) -> + cfk_concrete x1 x2 + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "class_field_kind"; data } -> + begin + match data with + | Variant { tag = "Cfk_virtual"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Cfk_virtual (x1)) + ) + | Variant { tag = "Cfk_concrete"; args = [| x1; x2 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind (Data.to_node x2) ~f:(fun x2 -> + Some (Cfk_concrete (x1, x2)) + )) + | _ -> None + end + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "class_field_kind"; + node = Unversioned.Private.transparent node; + }) +end + +module Class_declaration = struct + type t = class_declaration + + type concrete = class_expr class_infos + + let create = + let data = Data.of_node in + fun x -> node "class_declaration" (data x) + + let of_concrete = create + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "class_declaration"; data } -> Data.to_node data + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "class_declaration"; + node = Unversioned.Private.transparent node; + }) +end + +module Module_type = struct + type t = module_type + + type concrete = + { pmty_desc : module_type_desc + ; pmty_loc : Astlib.Location.t + ; pmty_attributes : attributes + } + + let create ~pmty_desc ~pmty_loc ~pmty_attributes = + let fields = + [| Data.of_node pmty_desc + ; Data.of_location pmty_loc + ; Data.of_node pmty_attributes + |] + in + node "module_type" (Record fields) + + let of_concrete { pmty_desc; pmty_loc; pmty_attributes } = + create ~pmty_desc ~pmty_loc ~pmty_attributes + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "module_type" + ; data = Record [| pmty_desc; pmty_loc; pmty_attributes |] + } -> + Option.bind (Data.to_node pmty_desc) ~f:(fun pmty_desc -> + Option.bind (Data.to_location pmty_loc) ~f:(fun pmty_loc -> + Option.bind (Data.to_node pmty_attributes) ~f:(fun pmty_attributes -> + Some { pmty_desc; pmty_loc; pmty_attributes } + ))) + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "module_type"; + node = Unversioned.Private.transparent node; + }) + + let pmty_desc t = (to_concrete t).pmty_desc + let pmty_loc t = (to_concrete t).pmty_loc + let pmty_attributes t = (to_concrete t).pmty_attributes +end + +module Module_type_desc = struct + type t = module_type_desc + + type concrete = + | Pmty_ident of longident_loc + | Pmty_signature of signature + | Pmty_functor of string Astlib.Loc.t * module_type option * module_type + | Pmty_with of module_type * with_constraint list + | Pmty_typeof of module_expr + | Pmty_extension of extension + | Pmty_alias of longident_loc + + let pmty_ident x1 = + node "module_type_desc" + (Variant + { tag = "Pmty_ident" + ; args = + [| Data.of_node x1 + |] + }) + let pmty_signature x1 = + node "module_type_desc" + (Variant + { tag = "Pmty_signature" + ; args = + [| Data.of_node x1 + |] + }) + let pmty_functor x1 x2 x3 = + node "module_type_desc" + (Variant + { tag = "Pmty_functor" + ; args = + [| (Data.of_loc ~f:Data.of_string) x1 + ; (Data.of_option ~f:Data.of_node) x2 + ; Data.of_node x3 + |] + }) + let pmty_with x1 x2 = + node "module_type_desc" + (Variant + { tag = "Pmty_with" + ; args = + [| Data.of_node x1 + ; (Data.of_list ~f:Data.of_node) x2 + |] + }) + let pmty_typeof x1 = + node "module_type_desc" + (Variant + { tag = "Pmty_typeof" + ; args = + [| Data.of_node x1 + |] + }) + let pmty_extension x1 = + node "module_type_desc" + (Variant + { tag = "Pmty_extension" + ; args = + [| Data.of_node x1 + |] + }) + let pmty_alias x1 = + node "module_type_desc" + (Variant + { tag = "Pmty_alias" + ; args = + [| Data.of_node x1 + |] + }) + + let of_concrete c = + match c with + | Pmty_ident (x1) -> + pmty_ident x1 + | Pmty_signature (x1) -> + pmty_signature x1 + | Pmty_functor (x1, x2, x3) -> + pmty_functor x1 x2 x3 + | Pmty_with (x1, x2) -> + pmty_with x1 x2 + | Pmty_typeof (x1) -> + pmty_typeof x1 + | Pmty_extension (x1) -> + pmty_extension x1 + | Pmty_alias (x1) -> + pmty_alias x1 + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "module_type_desc"; data } -> + begin + match data with + | Variant { tag = "Pmty_ident"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Pmty_ident (x1)) + ) + | Variant { tag = "Pmty_signature"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Pmty_signature (x1)) + ) + | Variant { tag = "Pmty_functor"; args = [| x1; x2; x3 |] } -> + Option.bind ((Data.to_loc ~f:Data.to_string) x1) ~f:(fun x1 -> + Option.bind ((Data.to_option ~f:Data.to_node) x2) ~f:(fun x2 -> + Option.bind (Data.to_node x3) ~f:(fun x3 -> + Some (Pmty_functor (x1, x2, x3)) + ))) + | Variant { tag = "Pmty_with"; args = [| x1; x2 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind ((Data.to_list ~f:Data.to_node) x2) ~f:(fun x2 -> + Some (Pmty_with (x1, x2)) + )) + | Variant { tag = "Pmty_typeof"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Pmty_typeof (x1)) + ) + | Variant { tag = "Pmty_extension"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Pmty_extension (x1)) + ) + | Variant { tag = "Pmty_alias"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Pmty_alias (x1)) + ) + | _ -> None + end + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "module_type_desc"; + node = Unversioned.Private.transparent node; + }) +end + +module Signature = struct + type t = signature + + type concrete = signature_item list + + let create = + let data = (Data.of_list ~f:Data.of_node) in + fun x -> node "signature" (data x) + + let of_concrete = create + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "signature"; data } -> (Data.to_list ~f:Data.to_node) data + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "signature"; + node = Unversioned.Private.transparent node; + }) +end + +module Signature_item = struct + type t = signature_item + + type concrete = + { psig_desc : signature_item_desc + ; psig_loc : Astlib.Location.t + } + + let create ~psig_desc ~psig_loc = + let fields = + [| Data.of_node psig_desc + ; Data.of_location psig_loc + |] + in + node "signature_item" (Record fields) + + let of_concrete { psig_desc; psig_loc } = + create ~psig_desc ~psig_loc + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "signature_item" + ; data = Record [| psig_desc; psig_loc |] + } -> + Option.bind (Data.to_node psig_desc) ~f:(fun psig_desc -> + Option.bind (Data.to_location psig_loc) ~f:(fun psig_loc -> + Some { psig_desc; psig_loc } + )) + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "signature_item"; + node = Unversioned.Private.transparent node; + }) + + let psig_desc t = (to_concrete t).psig_desc + let psig_loc t = (to_concrete t).psig_loc +end + +module Signature_item_desc = struct + type t = signature_item_desc + + type concrete = + | Psig_value of value_description + | Psig_type of rec_flag * type_declaration list + | Psig_typesubst of type_declaration list + | Psig_typext of type_extension + | Psig_exception of type_exception + | Psig_module of module_declaration + | Psig_modsubst of module_substitution + | Psig_recmodule of module_declaration list + | Psig_modtype of module_type_declaration + | Psig_open of open_description + | Psig_include of include_description + | Psig_class of class_description list + | Psig_class_type of class_type_declaration list + | Psig_attribute of attribute + | Psig_extension of extension * attributes + + let psig_value x1 = + node "signature_item_desc" + (Variant + { tag = "Psig_value" + ; args = + [| Data.of_node x1 + |] + }) + let psig_type x1 x2 = + node "signature_item_desc" + (Variant + { tag = "Psig_type" + ; args = + [| Data.of_node x1 + ; (Data.of_list ~f:Data.of_node) x2 + |] + }) + let psig_typesubst x1 = + node "signature_item_desc" + (Variant + { tag = "Psig_typesubst" + ; args = + [| (Data.of_list ~f:Data.of_node) x1 + |] + }) + let psig_typext x1 = + node "signature_item_desc" + (Variant + { tag = "Psig_typext" + ; args = + [| Data.of_node x1 + |] + }) + let psig_exception x1 = + node "signature_item_desc" + (Variant + { tag = "Psig_exception" + ; args = + [| Data.of_node x1 + |] + }) + let psig_module x1 = + node "signature_item_desc" + (Variant + { tag = "Psig_module" + ; args = + [| Data.of_node x1 + |] + }) + let psig_modsubst x1 = + node "signature_item_desc" + (Variant + { tag = "Psig_modsubst" + ; args = + [| Data.of_node x1 + |] + }) + let psig_recmodule x1 = + node "signature_item_desc" + (Variant + { tag = "Psig_recmodule" + ; args = + [| (Data.of_list ~f:Data.of_node) x1 + |] + }) + let psig_modtype x1 = + node "signature_item_desc" + (Variant + { tag = "Psig_modtype" + ; args = + [| Data.of_node x1 + |] + }) + let psig_open x1 = + node "signature_item_desc" + (Variant + { tag = "Psig_open" + ; args = + [| Data.of_node x1 + |] + }) + let psig_include x1 = + node "signature_item_desc" + (Variant + { tag = "Psig_include" + ; args = + [| Data.of_node x1 + |] + }) + let psig_class x1 = + node "signature_item_desc" + (Variant + { tag = "Psig_class" + ; args = + [| (Data.of_list ~f:Data.of_node) x1 + |] + }) + let psig_class_type x1 = + node "signature_item_desc" + (Variant + { tag = "Psig_class_type" + ; args = + [| (Data.of_list ~f:Data.of_node) x1 + |] + }) + let psig_attribute x1 = + node "signature_item_desc" + (Variant + { tag = "Psig_attribute" + ; args = + [| Data.of_node x1 + |] + }) + let psig_extension x1 x2 = + node "signature_item_desc" + (Variant + { tag = "Psig_extension" + ; args = + [| Data.of_node x1 + ; Data.of_node x2 + |] + }) + + let of_concrete c = + match c with + | Psig_value (x1) -> + psig_value x1 + | Psig_type (x1, x2) -> + psig_type x1 x2 + | Psig_typesubst (x1) -> + psig_typesubst x1 + | Psig_typext (x1) -> + psig_typext x1 + | Psig_exception (x1) -> + psig_exception x1 + | Psig_module (x1) -> + psig_module x1 + | Psig_modsubst (x1) -> + psig_modsubst x1 + | Psig_recmodule (x1) -> + psig_recmodule x1 + | Psig_modtype (x1) -> + psig_modtype x1 + | Psig_open (x1) -> + psig_open x1 + | Psig_include (x1) -> + psig_include x1 + | Psig_class (x1) -> + psig_class x1 + | Psig_class_type (x1) -> + psig_class_type x1 + | Psig_attribute (x1) -> + psig_attribute x1 + | Psig_extension (x1, x2) -> + psig_extension x1 x2 + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "signature_item_desc"; data } -> + begin + match data with + | Variant { tag = "Psig_value"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Psig_value (x1)) + ) + | Variant { tag = "Psig_type"; args = [| x1; x2 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind ((Data.to_list ~f:Data.to_node) x2) ~f:(fun x2 -> + Some (Psig_type (x1, x2)) + )) + | Variant { tag = "Psig_typesubst"; args = [| x1 |] } -> + Option.bind ((Data.to_list ~f:Data.to_node) x1) ~f:(fun x1 -> + Some (Psig_typesubst (x1)) + ) + | Variant { tag = "Psig_typext"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Psig_typext (x1)) + ) + | Variant { tag = "Psig_exception"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Psig_exception (x1)) + ) + | Variant { tag = "Psig_module"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Psig_module (x1)) + ) + | Variant { tag = "Psig_modsubst"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Psig_modsubst (x1)) + ) + | Variant { tag = "Psig_recmodule"; args = [| x1 |] } -> + Option.bind ((Data.to_list ~f:Data.to_node) x1) ~f:(fun x1 -> + Some (Psig_recmodule (x1)) + ) + | Variant { tag = "Psig_modtype"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Psig_modtype (x1)) + ) + | Variant { tag = "Psig_open"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Psig_open (x1)) + ) + | Variant { tag = "Psig_include"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Psig_include (x1)) + ) + | Variant { tag = "Psig_class"; args = [| x1 |] } -> + Option.bind ((Data.to_list ~f:Data.to_node) x1) ~f:(fun x1 -> + Some (Psig_class (x1)) + ) + | Variant { tag = "Psig_class_type"; args = [| x1 |] } -> + Option.bind ((Data.to_list ~f:Data.to_node) x1) ~f:(fun x1 -> + Some (Psig_class_type (x1)) + ) + | Variant { tag = "Psig_attribute"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Psig_attribute (x1)) + ) + | Variant { tag = "Psig_extension"; args = [| x1; x2 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind (Data.to_node x2) ~f:(fun x2 -> + Some (Psig_extension (x1, x2)) + )) + | _ -> None + end + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "signature_item_desc"; + node = Unversioned.Private.transparent node; + }) +end + +module Module_declaration = struct + type t = module_declaration + + type concrete = + { pmd_name : string Astlib.Loc.t + ; pmd_type : module_type + ; pmd_attributes : attributes + ; pmd_loc : Astlib.Location.t + } + + let create ~pmd_name ~pmd_type ~pmd_attributes ~pmd_loc = + let fields = + [| (Data.of_loc ~f:Data.of_string) pmd_name + ; Data.of_node pmd_type + ; Data.of_node pmd_attributes + ; Data.of_location pmd_loc + |] + in + node "module_declaration" (Record fields) + + let of_concrete { pmd_name; pmd_type; pmd_attributes; pmd_loc } = + create ~pmd_name ~pmd_type ~pmd_attributes ~pmd_loc + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "module_declaration" + ; data = Record [| pmd_name; pmd_type; pmd_attributes; pmd_loc |] + } -> + Option.bind ((Data.to_loc ~f:Data.to_string) pmd_name) ~f:(fun pmd_name -> + Option.bind (Data.to_node pmd_type) ~f:(fun pmd_type -> + Option.bind (Data.to_node pmd_attributes) ~f:(fun pmd_attributes -> + Option.bind (Data.to_location pmd_loc) ~f:(fun pmd_loc -> + Some { pmd_name; pmd_type; pmd_attributes; pmd_loc } + )))) + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "module_declaration"; + node = Unversioned.Private.transparent node; + }) + + let pmd_name t = (to_concrete t).pmd_name + let pmd_type t = (to_concrete t).pmd_type + let pmd_attributes t = (to_concrete t).pmd_attributes + let pmd_loc t = (to_concrete t).pmd_loc +end + +module Module_substitution = struct + type t = module_substitution + + type concrete = + { pms_name : string Astlib.Loc.t + ; pms_manifest : longident_loc + ; pms_attributes : attributes + ; pms_loc : Astlib.Location.t + } + + let create ~pms_name ~pms_manifest ~pms_attributes ~pms_loc = + let fields = + [| (Data.of_loc ~f:Data.of_string) pms_name + ; Data.of_node pms_manifest + ; Data.of_node pms_attributes + ; Data.of_location pms_loc + |] + in + node "module_substitution" (Record fields) + + let of_concrete { pms_name; pms_manifest; pms_attributes; pms_loc } = + create ~pms_name ~pms_manifest ~pms_attributes ~pms_loc + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "module_substitution" + ; data = Record [| pms_name; pms_manifest; pms_attributes; pms_loc |] + } -> + Option.bind ((Data.to_loc ~f:Data.to_string) pms_name) ~f:(fun pms_name -> + Option.bind (Data.to_node pms_manifest) ~f:(fun pms_manifest -> + Option.bind (Data.to_node pms_attributes) ~f:(fun pms_attributes -> + Option.bind (Data.to_location pms_loc) ~f:(fun pms_loc -> + Some { pms_name; pms_manifest; pms_attributes; pms_loc } + )))) + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "module_substitution"; + node = Unversioned.Private.transparent node; + }) + + let pms_name t = (to_concrete t).pms_name + let pms_manifest t = (to_concrete t).pms_manifest + let pms_attributes t = (to_concrete t).pms_attributes + let pms_loc t = (to_concrete t).pms_loc +end + +module Module_type_declaration = struct + type t = module_type_declaration + + type concrete = + { pmtd_name : string Astlib.Loc.t + ; pmtd_type : module_type option + ; pmtd_attributes : attributes + ; pmtd_loc : Astlib.Location.t + } + + let create ~pmtd_name ~pmtd_type ~pmtd_attributes ~pmtd_loc = + let fields = + [| (Data.of_loc ~f:Data.of_string) pmtd_name + ; (Data.of_option ~f:Data.of_node) pmtd_type + ; Data.of_node pmtd_attributes + ; Data.of_location pmtd_loc + |] + in + node "module_type_declaration" (Record fields) + + let of_concrete { pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc } = + create ~pmtd_name ~pmtd_type ~pmtd_attributes ~pmtd_loc + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "module_type_declaration" + ; data = Record [| pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc |] + } -> + Option.bind ((Data.to_loc ~f:Data.to_string) pmtd_name) ~f:(fun pmtd_name -> + Option.bind ((Data.to_option ~f:Data.to_node) pmtd_type) ~f:(fun pmtd_type -> + Option.bind (Data.to_node pmtd_attributes) ~f:(fun pmtd_attributes -> + Option.bind (Data.to_location pmtd_loc) ~f:(fun pmtd_loc -> + Some { pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc } + )))) + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "module_type_declaration"; + node = Unversioned.Private.transparent node; + }) + + let pmtd_name t = (to_concrete t).pmtd_name + let pmtd_type t = (to_concrete t).pmtd_type + let pmtd_attributes t = (to_concrete t).pmtd_attributes + let pmtd_loc t = (to_concrete t).pmtd_loc +end + +module Open_infos = struct + type 'a t = 'a open_infos + + type 'a concrete = + { popen_expr : 'a + ; popen_override : override_flag + ; popen_loc : Astlib.Location.t + ; popen_attributes : attributes + } + + let create ~popen_expr ~popen_override ~popen_loc ~popen_attributes = + let fields = + [| Data.of_node popen_expr + ; Data.of_node popen_override + ; Data.of_location popen_loc + ; Data.of_node popen_attributes + |] + in + node "open_infos" (Record fields) + + let of_concrete { popen_expr; popen_override; popen_loc; popen_attributes } = + create ~popen_expr ~popen_override ~popen_loc ~popen_attributes + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "open_infos" + ; data = Record [| popen_expr; popen_override; popen_loc; popen_attributes |] + } -> + Option.bind (Data.to_node popen_expr) ~f:(fun popen_expr -> + Option.bind (Data.to_node popen_override) ~f:(fun popen_override -> + Option.bind (Data.to_location popen_loc) ~f:(fun popen_loc -> + Option.bind (Data.to_node popen_attributes) ~f:(fun popen_attributes -> + Some { popen_expr; popen_override; popen_loc; popen_attributes } + )))) + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "open_infos"; + node = Unversioned.Private.transparent node; + }) + + let popen_expr t = (to_concrete t).popen_expr + let popen_override t = (to_concrete t).popen_override + let popen_loc t = (to_concrete t).popen_loc + let popen_attributes t = (to_concrete t).popen_attributes +end + +module Open_description = struct + type t = open_description + + type concrete = longident_loc open_infos + + let create = + let data = Data.of_node in + fun x -> node "open_description" (data x) + + let of_concrete = create + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "open_description"; data } -> Data.to_node data + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "open_description"; + node = Unversioned.Private.transparent node; + }) +end + +module Open_declaration = struct + type t = open_declaration + + type concrete = module_expr open_infos + + let create = + let data = Data.of_node in + fun x -> node "open_declaration" (data x) + + let of_concrete = create + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "open_declaration"; data } -> Data.to_node data + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "open_declaration"; + node = Unversioned.Private.transparent node; + }) +end + +module Include_infos = struct + type 'a t = 'a include_infos + + type 'a concrete = + { pincl_mod : 'a + ; pincl_loc : Astlib.Location.t + ; pincl_attributes : attributes + } + + let create ~pincl_mod ~pincl_loc ~pincl_attributes = + let fields = + [| Data.of_node pincl_mod + ; Data.of_location pincl_loc + ; Data.of_node pincl_attributes + |] + in + node "include_infos" (Record fields) + + let of_concrete { pincl_mod; pincl_loc; pincl_attributes } = + create ~pincl_mod ~pincl_loc ~pincl_attributes + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "include_infos" + ; data = Record [| pincl_mod; pincl_loc; pincl_attributes |] + } -> + Option.bind (Data.to_node pincl_mod) ~f:(fun pincl_mod -> + Option.bind (Data.to_location pincl_loc) ~f:(fun pincl_loc -> + Option.bind (Data.to_node pincl_attributes) ~f:(fun pincl_attributes -> + Some { pincl_mod; pincl_loc; pincl_attributes } + ))) + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "include_infos"; + node = Unversioned.Private.transparent node; + }) + + let pincl_mod t = (to_concrete t).pincl_mod + let pincl_loc t = (to_concrete t).pincl_loc + let pincl_attributes t = (to_concrete t).pincl_attributes +end + +module Include_description = struct + type t = include_description + + type concrete = module_type include_infos + + let create = + let data = Data.of_node in + fun x -> node "include_description" (data x) + + let of_concrete = create + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "include_description"; data } -> Data.to_node data + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "include_description"; + node = Unversioned.Private.transparent node; + }) +end + +module Include_declaration = struct + type t = include_declaration + + type concrete = module_expr include_infos + + let create = + let data = Data.of_node in + fun x -> node "include_declaration" (data x) + + let of_concrete = create + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "include_declaration"; data } -> Data.to_node data + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "include_declaration"; + node = Unversioned.Private.transparent node; + }) +end + +module With_constraint = struct + type t = with_constraint + + type concrete = + | Pwith_type of longident_loc * type_declaration + | Pwith_module of longident_loc * longident_loc + | Pwith_typesubst of longident_loc * type_declaration + | Pwith_modsubst of longident_loc * longident_loc + + let pwith_type x1 x2 = + node "with_constraint" + (Variant + { tag = "Pwith_type" + ; args = + [| Data.of_node x1 + ; Data.of_node x2 + |] + }) + let pwith_module x1 x2 = + node "with_constraint" + (Variant + { tag = "Pwith_module" + ; args = + [| Data.of_node x1 + ; Data.of_node x2 + |] + }) + let pwith_typesubst x1 x2 = + node "with_constraint" + (Variant + { tag = "Pwith_typesubst" + ; args = + [| Data.of_node x1 + ; Data.of_node x2 + |] + }) + let pwith_modsubst x1 x2 = + node "with_constraint" + (Variant + { tag = "Pwith_modsubst" + ; args = + [| Data.of_node x1 + ; Data.of_node x2 + |] + }) + + let of_concrete c = + match c with + | Pwith_type (x1, x2) -> + pwith_type x1 x2 + | Pwith_module (x1, x2) -> + pwith_module x1 x2 + | Pwith_typesubst (x1, x2) -> + pwith_typesubst x1 x2 + | Pwith_modsubst (x1, x2) -> + pwith_modsubst x1 x2 + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "with_constraint"; data } -> + begin + match data with + | Variant { tag = "Pwith_type"; args = [| x1; x2 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind (Data.to_node x2) ~f:(fun x2 -> + Some (Pwith_type (x1, x2)) + )) + | Variant { tag = "Pwith_module"; args = [| x1; x2 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind (Data.to_node x2) ~f:(fun x2 -> + Some (Pwith_module (x1, x2)) + )) + | Variant { tag = "Pwith_typesubst"; args = [| x1; x2 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind (Data.to_node x2) ~f:(fun x2 -> + Some (Pwith_typesubst (x1, x2)) + )) + | Variant { tag = "Pwith_modsubst"; args = [| x1; x2 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind (Data.to_node x2) ~f:(fun x2 -> + Some (Pwith_modsubst (x1, x2)) + )) + | _ -> None + end + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "with_constraint"; + node = Unversioned.Private.transparent node; + }) +end + +module Module_expr = struct + type t = module_expr + + type concrete = + { pmod_desc : module_expr_desc + ; pmod_loc : Astlib.Location.t + ; pmod_attributes : attributes + } + + let create ~pmod_desc ~pmod_loc ~pmod_attributes = + let fields = + [| Data.of_node pmod_desc + ; Data.of_location pmod_loc + ; Data.of_node pmod_attributes + |] + in + node "module_expr" (Record fields) + + let of_concrete { pmod_desc; pmod_loc; pmod_attributes } = + create ~pmod_desc ~pmod_loc ~pmod_attributes + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "module_expr" + ; data = Record [| pmod_desc; pmod_loc; pmod_attributes |] + } -> + Option.bind (Data.to_node pmod_desc) ~f:(fun pmod_desc -> + Option.bind (Data.to_location pmod_loc) ~f:(fun pmod_loc -> + Option.bind (Data.to_node pmod_attributes) ~f:(fun pmod_attributes -> + Some { pmod_desc; pmod_loc; pmod_attributes } + ))) + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "module_expr"; + node = Unversioned.Private.transparent node; + }) + + let pmod_desc t = (to_concrete t).pmod_desc + let pmod_loc t = (to_concrete t).pmod_loc + let pmod_attributes t = (to_concrete t).pmod_attributes +end + +module Module_expr_desc = struct + type t = module_expr_desc + + type concrete = + | Pmod_ident of longident_loc + | Pmod_structure of structure + | Pmod_functor of string Astlib.Loc.t * module_type option * module_expr + | Pmod_apply of module_expr * module_expr + | Pmod_constraint of module_expr * module_type + | Pmod_unpack of expression + | Pmod_extension of extension + + let pmod_ident x1 = + node "module_expr_desc" + (Variant + { tag = "Pmod_ident" + ; args = + [| Data.of_node x1 + |] + }) + let pmod_structure x1 = + node "module_expr_desc" + (Variant + { tag = "Pmod_structure" + ; args = + [| Data.of_node x1 + |] + }) + let pmod_functor x1 x2 x3 = + node "module_expr_desc" + (Variant + { tag = "Pmod_functor" + ; args = + [| (Data.of_loc ~f:Data.of_string) x1 + ; (Data.of_option ~f:Data.of_node) x2 + ; Data.of_node x3 + |] + }) + let pmod_apply x1 x2 = + node "module_expr_desc" + (Variant + { tag = "Pmod_apply" + ; args = + [| Data.of_node x1 + ; Data.of_node x2 + |] + }) + let pmod_constraint x1 x2 = + node "module_expr_desc" + (Variant + { tag = "Pmod_constraint" + ; args = + [| Data.of_node x1 + ; Data.of_node x2 + |] + }) + let pmod_unpack x1 = + node "module_expr_desc" + (Variant + { tag = "Pmod_unpack" + ; args = + [| Data.of_node x1 + |] + }) + let pmod_extension x1 = + node "module_expr_desc" + (Variant + { tag = "Pmod_extension" + ; args = + [| Data.of_node x1 + |] + }) + + let of_concrete c = + match c with + | Pmod_ident (x1) -> + pmod_ident x1 + | Pmod_structure (x1) -> + pmod_structure x1 + | Pmod_functor (x1, x2, x3) -> + pmod_functor x1 x2 x3 + | Pmod_apply (x1, x2) -> + pmod_apply x1 x2 + | Pmod_constraint (x1, x2) -> + pmod_constraint x1 x2 + | Pmod_unpack (x1) -> + pmod_unpack x1 + | Pmod_extension (x1) -> + pmod_extension x1 + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "module_expr_desc"; data } -> + begin + match data with + | Variant { tag = "Pmod_ident"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Pmod_ident (x1)) + ) + | Variant { tag = "Pmod_structure"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Pmod_structure (x1)) + ) + | Variant { tag = "Pmod_functor"; args = [| x1; x2; x3 |] } -> + Option.bind ((Data.to_loc ~f:Data.to_string) x1) ~f:(fun x1 -> + Option.bind ((Data.to_option ~f:Data.to_node) x2) ~f:(fun x2 -> + Option.bind (Data.to_node x3) ~f:(fun x3 -> + Some (Pmod_functor (x1, x2, x3)) + ))) + | Variant { tag = "Pmod_apply"; args = [| x1; x2 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind (Data.to_node x2) ~f:(fun x2 -> + Some (Pmod_apply (x1, x2)) + )) + | Variant { tag = "Pmod_constraint"; args = [| x1; x2 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind (Data.to_node x2) ~f:(fun x2 -> + Some (Pmod_constraint (x1, x2)) + )) + | Variant { tag = "Pmod_unpack"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Pmod_unpack (x1)) + ) + | Variant { tag = "Pmod_extension"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Pmod_extension (x1)) + ) + | _ -> None + end + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "module_expr_desc"; + node = Unversioned.Private.transparent node; + }) +end + +module Structure = struct + type t = structure + + type concrete = structure_item list + + let create = + let data = (Data.of_list ~f:Data.of_node) in + fun x -> node "structure" (data x) + + let of_concrete = create + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "structure"; data } -> (Data.to_list ~f:Data.to_node) data + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "structure"; + node = Unversioned.Private.transparent node; + }) +end + +module Structure_item = struct + type t = structure_item + + type concrete = + { pstr_desc : structure_item_desc + ; pstr_loc : Astlib.Location.t + } + + let create ~pstr_desc ~pstr_loc = + let fields = + [| Data.of_node pstr_desc + ; Data.of_location pstr_loc + |] + in + node "structure_item" (Record fields) + + let of_concrete { pstr_desc; pstr_loc } = + create ~pstr_desc ~pstr_loc + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "structure_item" + ; data = Record [| pstr_desc; pstr_loc |] + } -> + Option.bind (Data.to_node pstr_desc) ~f:(fun pstr_desc -> + Option.bind (Data.to_location pstr_loc) ~f:(fun pstr_loc -> + Some { pstr_desc; pstr_loc } + )) + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "structure_item"; + node = Unversioned.Private.transparent node; + }) + + let pstr_desc t = (to_concrete t).pstr_desc + let pstr_loc t = (to_concrete t).pstr_loc +end + +module Structure_item_desc = struct + type t = structure_item_desc + + type concrete = + | Pstr_eval of expression * attributes + | Pstr_value of rec_flag * value_binding list + | Pstr_primitive of value_description + | Pstr_type of rec_flag * type_declaration list + | Pstr_typext of type_extension + | Pstr_exception of type_exception + | Pstr_module of module_binding + | Pstr_recmodule of module_binding list + | Pstr_modtype of module_type_declaration + | Pstr_open of open_declaration + | Pstr_class of class_declaration list + | Pstr_class_type of class_type_declaration list + | Pstr_include of include_declaration + | Pstr_attribute of attribute + | Pstr_extension of extension * attributes + + let pstr_eval x1 x2 = + node "structure_item_desc" + (Variant + { tag = "Pstr_eval" + ; args = + [| Data.of_node x1 + ; Data.of_node x2 + |] + }) + let pstr_value x1 x2 = + node "structure_item_desc" + (Variant + { tag = "Pstr_value" + ; args = + [| Data.of_node x1 + ; (Data.of_list ~f:Data.of_node) x2 + |] + }) + let pstr_primitive x1 = + node "structure_item_desc" + (Variant + { tag = "Pstr_primitive" + ; args = + [| Data.of_node x1 + |] + }) + let pstr_type x1 x2 = + node "structure_item_desc" + (Variant + { tag = "Pstr_type" + ; args = + [| Data.of_node x1 + ; (Data.of_list ~f:Data.of_node) x2 + |] + }) + let pstr_typext x1 = + node "structure_item_desc" + (Variant + { tag = "Pstr_typext" + ; args = + [| Data.of_node x1 + |] + }) + let pstr_exception x1 = + node "structure_item_desc" + (Variant + { tag = "Pstr_exception" + ; args = + [| Data.of_node x1 + |] + }) + let pstr_module x1 = + node "structure_item_desc" + (Variant + { tag = "Pstr_module" + ; args = + [| Data.of_node x1 + |] + }) + let pstr_recmodule x1 = + node "structure_item_desc" + (Variant + { tag = "Pstr_recmodule" + ; args = + [| (Data.of_list ~f:Data.of_node) x1 + |] + }) + let pstr_modtype x1 = + node "structure_item_desc" + (Variant + { tag = "Pstr_modtype" + ; args = + [| Data.of_node x1 + |] + }) + let pstr_open x1 = + node "structure_item_desc" + (Variant + { tag = "Pstr_open" + ; args = + [| Data.of_node x1 + |] + }) + let pstr_class x1 = + node "structure_item_desc" + (Variant + { tag = "Pstr_class" + ; args = + [| (Data.of_list ~f:Data.of_node) x1 + |] + }) + let pstr_class_type x1 = + node "structure_item_desc" + (Variant + { tag = "Pstr_class_type" + ; args = + [| (Data.of_list ~f:Data.of_node) x1 + |] + }) + let pstr_include x1 = + node "structure_item_desc" + (Variant + { tag = "Pstr_include" + ; args = + [| Data.of_node x1 + |] + }) + let pstr_attribute x1 = + node "structure_item_desc" + (Variant + { tag = "Pstr_attribute" + ; args = + [| Data.of_node x1 + |] + }) + let pstr_extension x1 x2 = + node "structure_item_desc" + (Variant + { tag = "Pstr_extension" + ; args = + [| Data.of_node x1 + ; Data.of_node x2 + |] + }) + + let of_concrete c = + match c with + | Pstr_eval (x1, x2) -> + pstr_eval x1 x2 + | Pstr_value (x1, x2) -> + pstr_value x1 x2 + | Pstr_primitive (x1) -> + pstr_primitive x1 + | Pstr_type (x1, x2) -> + pstr_type x1 x2 + | Pstr_typext (x1) -> + pstr_typext x1 + | Pstr_exception (x1) -> + pstr_exception x1 + | Pstr_module (x1) -> + pstr_module x1 + | Pstr_recmodule (x1) -> + pstr_recmodule x1 + | Pstr_modtype (x1) -> + pstr_modtype x1 + | Pstr_open (x1) -> + pstr_open x1 + | Pstr_class (x1) -> + pstr_class x1 + | Pstr_class_type (x1) -> + pstr_class_type x1 + | Pstr_include (x1) -> + pstr_include x1 + | Pstr_attribute (x1) -> + pstr_attribute x1 + | Pstr_extension (x1, x2) -> + pstr_extension x1 x2 + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "structure_item_desc"; data } -> + begin + match data with + | Variant { tag = "Pstr_eval"; args = [| x1; x2 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind (Data.to_node x2) ~f:(fun x2 -> + Some (Pstr_eval (x1, x2)) + )) + | Variant { tag = "Pstr_value"; args = [| x1; x2 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind ((Data.to_list ~f:Data.to_node) x2) ~f:(fun x2 -> + Some (Pstr_value (x1, x2)) + )) + | Variant { tag = "Pstr_primitive"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Pstr_primitive (x1)) + ) + | Variant { tag = "Pstr_type"; args = [| x1; x2 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind ((Data.to_list ~f:Data.to_node) x2) ~f:(fun x2 -> + Some (Pstr_type (x1, x2)) + )) + | Variant { tag = "Pstr_typext"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Pstr_typext (x1)) + ) + | Variant { tag = "Pstr_exception"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Pstr_exception (x1)) + ) + | Variant { tag = "Pstr_module"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Pstr_module (x1)) + ) + | Variant { tag = "Pstr_recmodule"; args = [| x1 |] } -> + Option.bind ((Data.to_list ~f:Data.to_node) x1) ~f:(fun x1 -> + Some (Pstr_recmodule (x1)) + ) + | Variant { tag = "Pstr_modtype"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Pstr_modtype (x1)) + ) + | Variant { tag = "Pstr_open"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Pstr_open (x1)) + ) + | Variant { tag = "Pstr_class"; args = [| x1 |] } -> + Option.bind ((Data.to_list ~f:Data.to_node) x1) ~f:(fun x1 -> + Some (Pstr_class (x1)) + ) + | Variant { tag = "Pstr_class_type"; args = [| x1 |] } -> + Option.bind ((Data.to_list ~f:Data.to_node) x1) ~f:(fun x1 -> + Some (Pstr_class_type (x1)) + ) + | Variant { tag = "Pstr_include"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Pstr_include (x1)) + ) + | Variant { tag = "Pstr_attribute"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Pstr_attribute (x1)) + ) + | Variant { tag = "Pstr_extension"; args = [| x1; x2 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Option.bind (Data.to_node x2) ~f:(fun x2 -> + Some (Pstr_extension (x1, x2)) + )) + | _ -> None + end + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "structure_item_desc"; + node = Unversioned.Private.transparent node; + }) +end + +module Value_binding = struct + type t = value_binding + + type concrete = + { pvb_pat : pattern + ; pvb_expr : expression + ; pvb_attributes : attributes + ; pvb_loc : Astlib.Location.t + } + + let create ~pvb_pat ~pvb_expr ~pvb_attributes ~pvb_loc = + let fields = + [| Data.of_node pvb_pat + ; Data.of_node pvb_expr + ; Data.of_node pvb_attributes + ; Data.of_location pvb_loc + |] + in + node "value_binding" (Record fields) + + let of_concrete { pvb_pat; pvb_expr; pvb_attributes; pvb_loc } = + create ~pvb_pat ~pvb_expr ~pvb_attributes ~pvb_loc + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "value_binding" + ; data = Record [| pvb_pat; pvb_expr; pvb_attributes; pvb_loc |] + } -> + Option.bind (Data.to_node pvb_pat) ~f:(fun pvb_pat -> + Option.bind (Data.to_node pvb_expr) ~f:(fun pvb_expr -> + Option.bind (Data.to_node pvb_attributes) ~f:(fun pvb_attributes -> + Option.bind (Data.to_location pvb_loc) ~f:(fun pvb_loc -> + Some { pvb_pat; pvb_expr; pvb_attributes; pvb_loc } + )))) + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "value_binding"; + node = Unversioned.Private.transparent node; + }) + + let pvb_pat t = (to_concrete t).pvb_pat + let pvb_expr t = (to_concrete t).pvb_expr + let pvb_attributes t = (to_concrete t).pvb_attributes + let pvb_loc t = (to_concrete t).pvb_loc +end + +module Module_binding = struct + type t = module_binding + + type concrete = + { pmb_name : string Astlib.Loc.t + ; pmb_expr : module_expr + ; pmb_attributes : attributes + ; pmb_loc : Astlib.Location.t + } + + let create ~pmb_name ~pmb_expr ~pmb_attributes ~pmb_loc = + let fields = + [| (Data.of_loc ~f:Data.of_string) pmb_name + ; Data.of_node pmb_expr + ; Data.of_node pmb_attributes + ; Data.of_location pmb_loc + |] + in + node "module_binding" (Record fields) + + let of_concrete { pmb_name; pmb_expr; pmb_attributes; pmb_loc } = + create ~pmb_name ~pmb_expr ~pmb_attributes ~pmb_loc + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "module_binding" + ; data = Record [| pmb_name; pmb_expr; pmb_attributes; pmb_loc |] + } -> + Option.bind ((Data.to_loc ~f:Data.to_string) pmb_name) ~f:(fun pmb_name -> + Option.bind (Data.to_node pmb_expr) ~f:(fun pmb_expr -> + Option.bind (Data.to_node pmb_attributes) ~f:(fun pmb_attributes -> + Option.bind (Data.to_location pmb_loc) ~f:(fun pmb_loc -> + Some { pmb_name; pmb_expr; pmb_attributes; pmb_loc } + )))) + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "module_binding"; + node = Unversioned.Private.transparent node; + }) + + let pmb_name t = (to_concrete t).pmb_name + let pmb_expr t = (to_concrete t).pmb_expr + let pmb_attributes t = (to_concrete t).pmb_attributes + let pmb_loc t = (to_concrete t).pmb_loc +end + +module Toplevel_phrase = struct + type t = toplevel_phrase + + type concrete = + | Ptop_def of structure + | Ptop_dir of toplevel_directive + + let ptop_def x1 = + node "toplevel_phrase" + (Variant + { tag = "Ptop_def" + ; args = + [| Data.of_node x1 + |] + }) + let ptop_dir x1 = + node "toplevel_phrase" + (Variant + { tag = "Ptop_dir" + ; args = + [| Data.of_node x1 + |] + }) + + let of_concrete c = + match c with + | Ptop_def (x1) -> + ptop_def x1 + | Ptop_dir (x1) -> + ptop_dir x1 + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "toplevel_phrase"; data } -> + begin + match data with + | Variant { tag = "Ptop_def"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Ptop_def (x1)) + ) + | Variant { tag = "Ptop_dir"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Ptop_dir (x1)) + ) + | _ -> None + end + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "toplevel_phrase"; + node = Unversioned.Private.transparent node; + }) +end + +module Toplevel_directive = struct + type t = toplevel_directive + + type concrete = + { pdir_name : string Astlib.Loc.t + ; pdir_arg : directive_argument option + ; pdir_loc : Astlib.Location.t + } + + let create ~pdir_name ~pdir_arg ~pdir_loc = + let fields = + [| (Data.of_loc ~f:Data.of_string) pdir_name + ; (Data.of_option ~f:Data.of_node) pdir_arg + ; Data.of_location pdir_loc + |] + in + node "toplevel_directive" (Record fields) + + let of_concrete { pdir_name; pdir_arg; pdir_loc } = + create ~pdir_name ~pdir_arg ~pdir_loc + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "toplevel_directive" + ; data = Record [| pdir_name; pdir_arg; pdir_loc |] + } -> + Option.bind ((Data.to_loc ~f:Data.to_string) pdir_name) ~f:(fun pdir_name -> + Option.bind ((Data.to_option ~f:Data.to_node) pdir_arg) ~f:(fun pdir_arg -> + Option.bind (Data.to_location pdir_loc) ~f:(fun pdir_loc -> + Some { pdir_name; pdir_arg; pdir_loc } + ))) + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "toplevel_directive"; + node = Unversioned.Private.transparent node; + }) + + let pdir_name t = (to_concrete t).pdir_name + let pdir_arg t = (to_concrete t).pdir_arg + let pdir_loc t = (to_concrete t).pdir_loc +end + +module Directive_argument = struct + type t = directive_argument + + type concrete = + { pdira_desc : directive_argument_desc + ; pdira_loc : Astlib.Location.t + } + + let create ~pdira_desc ~pdira_loc = + let fields = + [| Data.of_node pdira_desc + ; Data.of_location pdira_loc + |] + in + node "directive_argument" (Record fields) + + let of_concrete { pdira_desc; pdira_loc } = + create ~pdira_desc ~pdira_loc + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "directive_argument" + ; data = Record [| pdira_desc; pdira_loc |] + } -> + Option.bind (Data.to_node pdira_desc) ~f:(fun pdira_desc -> + Option.bind (Data.to_location pdira_loc) ~f:(fun pdira_loc -> + Some { pdira_desc; pdira_loc } + )) + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "directive_argument"; + node = Unversioned.Private.transparent node; + }) + + let pdira_desc t = (to_concrete t).pdira_desc + let pdira_loc t = (to_concrete t).pdira_loc +end + +module Directive_argument_desc = struct + type t = directive_argument_desc + + type concrete = + | Pdir_string of string + | Pdir_int of string * char option + | Pdir_ident of longident + | Pdir_bool of bool + + let pdir_string x1 = + node "directive_argument_desc" + (Variant + { tag = "Pdir_string" + ; args = + [| Data.of_string x1 + |] + }) + let pdir_int x1 x2 = + node "directive_argument_desc" + (Variant + { tag = "Pdir_int" + ; args = + [| Data.of_string x1 + ; (Data.of_option ~f:Data.of_char) x2 + |] + }) + let pdir_ident x1 = + node "directive_argument_desc" + (Variant + { tag = "Pdir_ident" + ; args = + [| Data.of_node x1 + |] + }) + let pdir_bool x1 = + node "directive_argument_desc" + (Variant + { tag = "Pdir_bool" + ; args = + [| Data.of_bool x1 + |] + }) + + let of_concrete c = + match c with + | Pdir_string (x1) -> + pdir_string x1 + | Pdir_int (x1, x2) -> + pdir_int x1 x2 + | Pdir_ident (x1) -> + pdir_ident x1 + | Pdir_bool (x1) -> + pdir_bool x1 + + let to_concrete_opt t = + match Node.unwrap (Unversioned.Private.transparent t) ~version with + | Some { name = "directive_argument_desc"; data } -> + begin + match data with + | Variant { tag = "Pdir_string"; args = [| x1 |] } -> + Option.bind (Data.to_string x1) ~f:(fun x1 -> + Some (Pdir_string (x1)) + ) + | Variant { tag = "Pdir_int"; args = [| x1; x2 |] } -> + Option.bind (Data.to_string x1) ~f:(fun x1 -> + Option.bind ((Data.to_option ~f:Data.to_char) x2) ~f:(fun x2 -> + Some (Pdir_int (x1, x2)) + )) + | Variant { tag = "Pdir_ident"; args = [| x1 |] } -> + Option.bind (Data.to_node x1) ~f:(fun x1 -> + Some (Pdir_ident (x1)) + ) + | Variant { tag = "Pdir_bool"; args = [| x1 |] } -> + Option.bind (Data.to_bool x1) ~f:(fun x1 -> + Some (Pdir_bool (x1)) + ) + | _ -> None + end + | _ -> None + + let to_concrete node = + match to_concrete_opt node with + | Some concrete -> concrete + | None -> + raise + (Unversioned.Private.Cannot_interpret_ast { + version; + node_name = "directive_argument_desc"; + node = Unversioned.Private.transparent node; + }) +end +(*$*) diff --git a/ast/version_v4_08.mli b/ast/version_v4_08.mli new file mode 100644 index 00000000..479d8978 --- /dev/null +++ b/ast/version_v4_08.mli @@ -0,0 +1,2260 @@ +open Unversioned.Types + +(*$ Ppx_ast_cinaps.print_version_mli (Astlib.Version.of_string "v4_08") *) +module rec Longident : sig + type t = longident + + type concrete = + | Lident of string + | Ldot of Longident.t * string + | Lapply of Longident.t * Longident.t + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val lident : + string + -> t + val ldot : + Longident.t + -> string + -> t + val lapply : + Longident.t + -> Longident.t + -> t +end + +and Longident_loc : sig + type t = longident_loc + + type concrete = Longident.t Astlib.Loc.t + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val create : Longident.t Astlib.Loc.t -> t +end + +and Rec_flag : sig + type t = rec_flag + + type concrete = + | Nonrecursive + | Recursive + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val nonrecursive : t + val recursive : t +end + +and Direction_flag : sig + type t = direction_flag + + type concrete = + | Upto + | Downto + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val upto : t + val downto_ : t +end + +and Private_flag : sig + type t = private_flag + + type concrete = + | Private + | Public + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val private_ : t + val public : t +end + +and Mutable_flag : sig + type t = mutable_flag + + type concrete = + | Immutable + | Mutable + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val immutable : t + val mutable_ : t +end + +and Virtual_flag : sig + type t = virtual_flag + + type concrete = + | Virtual + | Concrete + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val virtual_ : t + val concrete : t +end + +and Override_flag : sig + type t = override_flag + + type concrete = + | Override + | Fresh + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val override : t + val fresh : t +end + +and Closed_flag : sig + type t = closed_flag + + type concrete = + | Closed + | Open + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val closed : t + val open_ : t +end + +and Arg_label : sig + type t = arg_label + + type concrete = + | Nolabel + | Labelled of string + | Optional of string + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val nolabel : t + val labelled : + string + -> t + val optional : + string + -> t +end + +and Variance : sig + type t = variance + + type concrete = + | Covariant + | Contravariant + | Invariant + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val covariant : t + val contravariant : t + val invariant : t +end + +and Constant : sig + type t = constant + + type concrete = + | Pconst_integer of string * char option + | Pconst_char of char + | Pconst_string of string * string option + | Pconst_float of string * char option + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val pconst_integer : + string + -> char option + -> t + val pconst_char : + char + -> t + val pconst_string : + string + -> string option + -> t + val pconst_float : + string + -> char option + -> t +end + +and Attribute : sig + type t = attribute + + type concrete = + { attr_name : string Astlib.Loc.t + ; attr_payload : Payload.t + ; attr_loc : Astlib.Location.t + } + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val create : + attr_name:string Astlib.Loc.t + -> attr_payload:Payload.t + -> attr_loc:Astlib.Location.t + -> t + + val attr_name : t -> string Astlib.Loc.t + val attr_payload : t -> Payload.t + val attr_loc : t -> Astlib.Location.t +end + +and Extension : sig + type t = extension + + type concrete = (string Astlib.Loc.t * Payload.t) + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val create : (string Astlib.Loc.t * Payload.t) -> t +end + +and Attributes : sig + type t = attributes + + type concrete = Attribute.t list + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val create : Attribute.t list -> t +end + +and Payload : sig + type t = payload + + type concrete = + | PStr of Structure.t + | PSig of Signature.t + | PTyp of Core_type.t + | PPat of Pattern.t * Expression.t option + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val pstr : + Structure.t + -> t + val psig : + Signature.t + -> t + val ptyp : + Core_type.t + -> t + val ppat : + Pattern.t + -> Expression.t option + -> t +end + +and Core_type : sig + type t = core_type + + type concrete = + { ptyp_desc : Core_type_desc.t + ; ptyp_loc : Astlib.Location.t + ; ptyp_loc_stack : Astlib.Location.t list + ; ptyp_attributes : Attributes.t + } + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val create : + ptyp_desc:Core_type_desc.t + -> ptyp_loc:Astlib.Location.t + -> ptyp_loc_stack:Astlib.Location.t list + -> ptyp_attributes:Attributes.t + -> t + + val ptyp_desc : t -> Core_type_desc.t + val ptyp_loc : t -> Astlib.Location.t + val ptyp_loc_stack : t -> Astlib.Location.t list + val ptyp_attributes : t -> Attributes.t +end + +and Core_type_desc : sig + type t = core_type_desc + + type concrete = + | Ptyp_any + | Ptyp_var of string + | Ptyp_arrow of Arg_label.t * Core_type.t * Core_type.t + | Ptyp_tuple of Core_type.t list + | Ptyp_constr of Longident_loc.t * Core_type.t list + | Ptyp_object of Object_field.t list * Closed_flag.t + | Ptyp_class of Longident_loc.t * Core_type.t list + | Ptyp_alias of Core_type.t * string + | Ptyp_variant of Row_field.t list * Closed_flag.t * string list option + | Ptyp_poly of string Astlib.Loc.t list * Core_type.t + | Ptyp_package of Package_type.t + | Ptyp_extension of Extension.t + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val ptyp_any : t + val ptyp_var : + string + -> t + val ptyp_arrow : + Arg_label.t + -> Core_type.t + -> Core_type.t + -> t + val ptyp_tuple : + Core_type.t list + -> t + val ptyp_constr : + Longident_loc.t + -> Core_type.t list + -> t + val ptyp_object : + Object_field.t list + -> Closed_flag.t + -> t + val ptyp_class : + Longident_loc.t + -> Core_type.t list + -> t + val ptyp_alias : + Core_type.t + -> string + -> t + val ptyp_variant : + Row_field.t list + -> Closed_flag.t + -> string list option + -> t + val ptyp_poly : + string Astlib.Loc.t list + -> Core_type.t + -> t + val ptyp_package : + Package_type.t + -> t + val ptyp_extension : + Extension.t + -> t +end + +and Package_type : sig + type t = package_type + + type concrete = (Longident_loc.t * (Longident_loc.t * Core_type.t) list) + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val create : (Longident_loc.t * (Longident_loc.t * Core_type.t) list) -> t +end + +and Row_field : sig + type t = row_field + + type concrete = + { prf_desc : Row_field_desc.t + ; prf_loc : Astlib.Location.t + ; prf_attributes : Attributes.t + } + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val create : + prf_desc:Row_field_desc.t + -> prf_loc:Astlib.Location.t + -> prf_attributes:Attributes.t + -> t + + val prf_desc : t -> Row_field_desc.t + val prf_loc : t -> Astlib.Location.t + val prf_attributes : t -> Attributes.t +end + +and Row_field_desc : sig + type t = row_field_desc + + type concrete = + | Rtag of string Astlib.Loc.t * bool * Core_type.t list + | Rinherit of Core_type.t + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val rtag : + string Astlib.Loc.t + -> bool + -> Core_type.t list + -> t + val rinherit : + Core_type.t + -> t +end + +and Object_field : sig + type t = object_field + + type concrete = + { pof_desc : Object_field_desc.t + ; pof_loc : Astlib.Location.t + ; pof_attributes : Attributes.t + } + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val create : + pof_desc:Object_field_desc.t + -> pof_loc:Astlib.Location.t + -> pof_attributes:Attributes.t + -> t + + val pof_desc : t -> Object_field_desc.t + val pof_loc : t -> Astlib.Location.t + val pof_attributes : t -> Attributes.t +end + +and Object_field_desc : sig + type t = object_field_desc + + type concrete = + | Otag of string Astlib.Loc.t * Core_type.t + | Oinherit of Core_type.t + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val otag : + string Astlib.Loc.t + -> Core_type.t + -> t + val oinherit : + Core_type.t + -> t +end + +and Pattern : sig + type t = pattern + + type concrete = + { ppat_desc : Pattern_desc.t + ; ppat_loc : Astlib.Location.t + ; ppat_loc_stack : Astlib.Location.t list + ; ppat_attributes : Attributes.t + } + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val create : + ppat_desc:Pattern_desc.t + -> ppat_loc:Astlib.Location.t + -> ppat_loc_stack:Astlib.Location.t list + -> ppat_attributes:Attributes.t + -> t + + val ppat_desc : t -> Pattern_desc.t + val ppat_loc : t -> Astlib.Location.t + val ppat_loc_stack : t -> Astlib.Location.t list + val ppat_attributes : t -> Attributes.t +end + +and Pattern_desc : sig + type t = pattern_desc + + type concrete = + | Ppat_any + | Ppat_var of string Astlib.Loc.t + | Ppat_alias of Pattern.t * string Astlib.Loc.t + | Ppat_constant of Constant.t + | Ppat_interval of Constant.t * Constant.t + | Ppat_tuple of Pattern.t list + | Ppat_construct of Longident_loc.t * Pattern.t option + | Ppat_variant of string * Pattern.t option + | Ppat_record of (Longident_loc.t * Pattern.t) list * Closed_flag.t + | Ppat_array of Pattern.t list + | Ppat_or of Pattern.t * Pattern.t + | Ppat_constraint of Pattern.t * Core_type.t + | Ppat_type of Longident_loc.t + | Ppat_lazy of Pattern.t + | Ppat_unpack of string Astlib.Loc.t + | Ppat_exception of Pattern.t + | Ppat_extension of Extension.t + | Ppat_open of Longident_loc.t * Pattern.t + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val ppat_any : t + val ppat_var : + string Astlib.Loc.t + -> t + val ppat_alias : + Pattern.t + -> string Astlib.Loc.t + -> t + val ppat_constant : + Constant.t + -> t + val ppat_interval : + Constant.t + -> Constant.t + -> t + val ppat_tuple : + Pattern.t list + -> t + val ppat_construct : + Longident_loc.t + -> Pattern.t option + -> t + val ppat_variant : + string + -> Pattern.t option + -> t + val ppat_record : + (Longident_loc.t * Pattern.t) list + -> Closed_flag.t + -> t + val ppat_array : + Pattern.t list + -> t + val ppat_or : + Pattern.t + -> Pattern.t + -> t + val ppat_constraint : + Pattern.t + -> Core_type.t + -> t + val ppat_type : + Longident_loc.t + -> t + val ppat_lazy : + Pattern.t + -> t + val ppat_unpack : + string Astlib.Loc.t + -> t + val ppat_exception : + Pattern.t + -> t + val ppat_extension : + Extension.t + -> t + val ppat_open : + Longident_loc.t + -> Pattern.t + -> t +end + +and Expression : sig + type t = expression + + type concrete = + { pexp_desc : Expression_desc.t + ; pexp_loc : Astlib.Location.t + ; pexp_loc_stack : Astlib.Location.t list + ; pexp_attributes : Attributes.t + } + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val create : + pexp_desc:Expression_desc.t + -> pexp_loc:Astlib.Location.t + -> pexp_loc_stack:Astlib.Location.t list + -> pexp_attributes:Attributes.t + -> t + + val pexp_desc : t -> Expression_desc.t + val pexp_loc : t -> Astlib.Location.t + val pexp_loc_stack : t -> Astlib.Location.t list + val pexp_attributes : t -> Attributes.t +end + +and Expression_desc : sig + type t = expression_desc + + type concrete = + | Pexp_ident of Longident_loc.t + | Pexp_constant of Constant.t + | Pexp_let of Rec_flag.t * Value_binding.t list * Expression.t + | Pexp_function of Case.t list + | Pexp_fun of Arg_label.t * Expression.t option * Pattern.t * Expression.t + | Pexp_apply of Expression.t * (Arg_label.t * Expression.t) list + | Pexp_match of Expression.t * Case.t list + | Pexp_try of Expression.t * Case.t list + | Pexp_tuple of Expression.t list + | Pexp_construct of Longident_loc.t * Expression.t option + | Pexp_variant of string * Expression.t option + | Pexp_record of (Longident_loc.t * Expression.t) list * Expression.t option + | Pexp_field of Expression.t * Longident_loc.t + | Pexp_setfield of Expression.t * Longident_loc.t * Expression.t + | Pexp_array of Expression.t list + | Pexp_ifthenelse of Expression.t * Expression.t * Expression.t option + | Pexp_sequence of Expression.t * Expression.t + | Pexp_while of Expression.t * Expression.t + | Pexp_for of Pattern.t * Expression.t * Expression.t * Direction_flag.t * Expression.t + | Pexp_constraint of Expression.t * Core_type.t + | Pexp_coerce of Expression.t * Core_type.t option * Core_type.t + | Pexp_send of Expression.t * string Astlib.Loc.t + | Pexp_new of Longident_loc.t + | Pexp_setinstvar of string Astlib.Loc.t * Expression.t + | Pexp_override of (string Astlib.Loc.t * Expression.t) list + | Pexp_letmodule of string Astlib.Loc.t * Module_expr.t * Expression.t + | Pexp_letexception of Extension_constructor.t * Expression.t + | Pexp_assert of Expression.t + | Pexp_lazy of Expression.t + | Pexp_poly of Expression.t * Core_type.t option + | Pexp_object of Class_structure.t + | Pexp_newtype of string Astlib.Loc.t * Expression.t + | Pexp_pack of Module_expr.t + | Pexp_open of Open_declaration.t * Expression.t + | Pexp_letop of Letop.t + | Pexp_extension of Extension.t + | Pexp_unreachable + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val pexp_ident : + Longident_loc.t + -> t + val pexp_constant : + Constant.t + -> t + val pexp_let : + Rec_flag.t + -> Value_binding.t list + -> Expression.t + -> t + val pexp_function : + Case.t list + -> t + val pexp_fun : + Arg_label.t + -> Expression.t option + -> Pattern.t + -> Expression.t + -> t + val pexp_apply : + Expression.t + -> (Arg_label.t * Expression.t) list + -> t + val pexp_match : + Expression.t + -> Case.t list + -> t + val pexp_try : + Expression.t + -> Case.t list + -> t + val pexp_tuple : + Expression.t list + -> t + val pexp_construct : + Longident_loc.t + -> Expression.t option + -> t + val pexp_variant : + string + -> Expression.t option + -> t + val pexp_record : + (Longident_loc.t * Expression.t) list + -> Expression.t option + -> t + val pexp_field : + Expression.t + -> Longident_loc.t + -> t + val pexp_setfield : + Expression.t + -> Longident_loc.t + -> Expression.t + -> t + val pexp_array : + Expression.t list + -> t + val pexp_ifthenelse : + Expression.t + -> Expression.t + -> Expression.t option + -> t + val pexp_sequence : + Expression.t + -> Expression.t + -> t + val pexp_while : + Expression.t + -> Expression.t + -> t + val pexp_for : + Pattern.t + -> Expression.t + -> Expression.t + -> Direction_flag.t + -> Expression.t + -> t + val pexp_constraint : + Expression.t + -> Core_type.t + -> t + val pexp_coerce : + Expression.t + -> Core_type.t option + -> Core_type.t + -> t + val pexp_send : + Expression.t + -> string Astlib.Loc.t + -> t + val pexp_new : + Longident_loc.t + -> t + val pexp_setinstvar : + string Astlib.Loc.t + -> Expression.t + -> t + val pexp_override : + (string Astlib.Loc.t * Expression.t) list + -> t + val pexp_letmodule : + string Astlib.Loc.t + -> Module_expr.t + -> Expression.t + -> t + val pexp_letexception : + Extension_constructor.t + -> Expression.t + -> t + val pexp_assert : + Expression.t + -> t + val pexp_lazy : + Expression.t + -> t + val pexp_poly : + Expression.t + -> Core_type.t option + -> t + val pexp_object : + Class_structure.t + -> t + val pexp_newtype : + string Astlib.Loc.t + -> Expression.t + -> t + val pexp_pack : + Module_expr.t + -> t + val pexp_open : + Open_declaration.t + -> Expression.t + -> t + val pexp_letop : + Letop.t + -> t + val pexp_extension : + Extension.t + -> t + val pexp_unreachable : t +end + +and Case : sig + type t = case + + type concrete = + { pc_lhs : Pattern.t + ; pc_guard : Expression.t option + ; pc_rhs : Expression.t + } + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val create : + pc_lhs:Pattern.t + -> pc_guard:Expression.t option + -> pc_rhs:Expression.t + -> t + + val pc_lhs : t -> Pattern.t + val pc_guard : t -> Expression.t option + val pc_rhs : t -> Expression.t +end + +and Letop : sig + type t = letop + + type concrete = + { let_ : Binding_op.t + ; ands : Binding_op.t list + ; body : Expression.t + } + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val create : + let_:Binding_op.t + -> ands:Binding_op.t list + -> body:Expression.t + -> t + + val let_ : t -> Binding_op.t + val ands : t -> Binding_op.t list + val body : t -> Expression.t +end + +and Binding_op : sig + type t = binding_op + + type concrete = + { pbop_op : string Astlib.Loc.t + ; pbop_pat : Pattern.t + ; pbop_exp : Expression.t + ; pbop_loc : Astlib.Location.t + } + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val create : + pbop_op:string Astlib.Loc.t + -> pbop_pat:Pattern.t + -> pbop_exp:Expression.t + -> pbop_loc:Astlib.Location.t + -> t + + val pbop_op : t -> string Astlib.Loc.t + val pbop_pat : t -> Pattern.t + val pbop_exp : t -> Expression.t + val pbop_loc : t -> Astlib.Location.t +end + +and Value_description : sig + type t = value_description + + type concrete = + { pval_name : string Astlib.Loc.t + ; pval_type : Core_type.t + ; pval_prim : string list + ; pval_attributes : Attributes.t + ; pval_loc : Astlib.Location.t + } + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val create : + pval_name:string Astlib.Loc.t + -> pval_type:Core_type.t + -> pval_prim:string list + -> pval_attributes:Attributes.t + -> pval_loc:Astlib.Location.t + -> t + + val pval_name : t -> string Astlib.Loc.t + val pval_type : t -> Core_type.t + val pval_prim : t -> string list + val pval_attributes : t -> Attributes.t + val pval_loc : t -> Astlib.Location.t +end + +and Type_declaration : sig + type t = type_declaration + + type concrete = + { ptype_name : string Astlib.Loc.t + ; ptype_params : (Core_type.t * Variance.t) list + ; ptype_cstrs : (Core_type.t * Core_type.t * Astlib.Location.t) list + ; ptype_kind : Type_kind.t + ; ptype_private : Private_flag.t + ; ptype_manifest : Core_type.t option + ; ptype_attributes : Attributes.t + ; ptype_loc : Astlib.Location.t + } + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val create : + ptype_name:string Astlib.Loc.t + -> ptype_params:(Core_type.t * Variance.t) list + -> ptype_cstrs:(Core_type.t * Core_type.t * Astlib.Location.t) list + -> ptype_kind:Type_kind.t + -> ptype_private:Private_flag.t + -> ptype_manifest:Core_type.t option + -> ptype_attributes:Attributes.t + -> ptype_loc:Astlib.Location.t + -> t + + val ptype_name : t -> string Astlib.Loc.t + val ptype_params : t -> (Core_type.t * Variance.t) list + val ptype_cstrs : t -> (Core_type.t * Core_type.t * Astlib.Location.t) list + val ptype_kind : t -> Type_kind.t + val ptype_private : t -> Private_flag.t + val ptype_manifest : t -> Core_type.t option + val ptype_attributes : t -> Attributes.t + val ptype_loc : t -> Astlib.Location.t +end + +and Type_kind : sig + type t = type_kind + + type concrete = + | Ptype_abstract + | Ptype_variant of Constructor_declaration.t list + | Ptype_record of Label_declaration.t list + | Ptype_open + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val ptype_abstract : t + val ptype_variant : + Constructor_declaration.t list + -> t + val ptype_record : + Label_declaration.t list + -> t + val ptype_open : t +end + +and Label_declaration : sig + type t = label_declaration + + type concrete = + { pld_name : string Astlib.Loc.t + ; pld_mutable : Mutable_flag.t + ; pld_type : Core_type.t + ; pld_loc : Astlib.Location.t + ; pld_attributes : Attributes.t + } + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val create : + pld_name:string Astlib.Loc.t + -> pld_mutable:Mutable_flag.t + -> pld_type:Core_type.t + -> pld_loc:Astlib.Location.t + -> pld_attributes:Attributes.t + -> t + + val pld_name : t -> string Astlib.Loc.t + val pld_mutable : t -> Mutable_flag.t + val pld_type : t -> Core_type.t + val pld_loc : t -> Astlib.Location.t + val pld_attributes : t -> Attributes.t +end + +and Constructor_declaration : sig + type t = constructor_declaration + + type concrete = + { pcd_name : string Astlib.Loc.t + ; pcd_args : Constructor_arguments.t + ; pcd_res : Core_type.t option + ; pcd_loc : Astlib.Location.t + ; pcd_attributes : Attributes.t + } + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val create : + pcd_name:string Astlib.Loc.t + -> pcd_args:Constructor_arguments.t + -> pcd_res:Core_type.t option + -> pcd_loc:Astlib.Location.t + -> pcd_attributes:Attributes.t + -> t + + val pcd_name : t -> string Astlib.Loc.t + val pcd_args : t -> Constructor_arguments.t + val pcd_res : t -> Core_type.t option + val pcd_loc : t -> Astlib.Location.t + val pcd_attributes : t -> Attributes.t +end + +and Constructor_arguments : sig + type t = constructor_arguments + + type concrete = + | Pcstr_tuple of Core_type.t list + | Pcstr_record of Label_declaration.t list + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val pcstr_tuple : + Core_type.t list + -> t + val pcstr_record : + Label_declaration.t list + -> t +end + +and Type_extension : sig + type t = type_extension + + type concrete = + { ptyext_path : Longident_loc.t + ; ptyext_params : (Core_type.t * Variance.t) list + ; ptyext_constructors : Extension_constructor.t list + ; ptyext_private : Private_flag.t + ; ptyext_loc : Astlib.Location.t + ; ptyext_attributes : Attributes.t + } + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val create : + ptyext_path:Longident_loc.t + -> ptyext_params:(Core_type.t * Variance.t) list + -> ptyext_constructors:Extension_constructor.t list + -> ptyext_private:Private_flag.t + -> ptyext_loc:Astlib.Location.t + -> ptyext_attributes:Attributes.t + -> t + + val ptyext_path : t -> Longident_loc.t + val ptyext_params : t -> (Core_type.t * Variance.t) list + val ptyext_constructors : t -> Extension_constructor.t list + val ptyext_private : t -> Private_flag.t + val ptyext_loc : t -> Astlib.Location.t + val ptyext_attributes : t -> Attributes.t +end + +and Extension_constructor : sig + type t = extension_constructor + + type concrete = + { pext_name : string Astlib.Loc.t + ; pext_kind : Extension_constructor_kind.t + ; pext_loc : Astlib.Location.t + ; pext_attributes : Attributes.t + } + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val create : + pext_name:string Astlib.Loc.t + -> pext_kind:Extension_constructor_kind.t + -> pext_loc:Astlib.Location.t + -> pext_attributes:Attributes.t + -> t + + val pext_name : t -> string Astlib.Loc.t + val pext_kind : t -> Extension_constructor_kind.t + val pext_loc : t -> Astlib.Location.t + val pext_attributes : t -> Attributes.t +end + +and Type_exception : sig + type t = type_exception + + type concrete = + { ptyexn_constructor : Extension_constructor.t + ; ptyexn_loc : Astlib.Location.t + ; ptyexn_attributes : Attributes.t + } + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val create : + ptyexn_constructor:Extension_constructor.t + -> ptyexn_loc:Astlib.Location.t + -> ptyexn_attributes:Attributes.t + -> t + + val ptyexn_constructor : t -> Extension_constructor.t + val ptyexn_loc : t -> Astlib.Location.t + val ptyexn_attributes : t -> Attributes.t +end + +and Extension_constructor_kind : sig + type t = extension_constructor_kind + + type concrete = + | Pext_decl of Constructor_arguments.t * Core_type.t option + | Pext_rebind of Longident_loc.t + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val pext_decl : + Constructor_arguments.t + -> Core_type.t option + -> t + val pext_rebind : + Longident_loc.t + -> t +end + +and Class_type : sig + type t = class_type + + type concrete = + { pcty_desc : Class_type_desc.t + ; pcty_loc : Astlib.Location.t + ; pcty_attributes : Attributes.t + } + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val create : + pcty_desc:Class_type_desc.t + -> pcty_loc:Astlib.Location.t + -> pcty_attributes:Attributes.t + -> t + + val pcty_desc : t -> Class_type_desc.t + val pcty_loc : t -> Astlib.Location.t + val pcty_attributes : t -> Attributes.t +end + +and Class_type_desc : sig + type t = class_type_desc + + type concrete = + | Pcty_constr of Longident_loc.t * Core_type.t list + | Pcty_signature of Class_signature.t + | Pcty_arrow of Arg_label.t * Core_type.t * Class_type.t + | Pcty_extension of Extension.t + | Pcty_open of Open_description.t * Class_type.t + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val pcty_constr : + Longident_loc.t + -> Core_type.t list + -> t + val pcty_signature : + Class_signature.t + -> t + val pcty_arrow : + Arg_label.t + -> Core_type.t + -> Class_type.t + -> t + val pcty_extension : + Extension.t + -> t + val pcty_open : + Open_description.t + -> Class_type.t + -> t +end + +and Class_signature : sig + type t = class_signature + + type concrete = + { pcsig_self : Core_type.t + ; pcsig_fields : Class_type_field.t list + } + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val create : + pcsig_self:Core_type.t + -> pcsig_fields:Class_type_field.t list + -> t + + val pcsig_self : t -> Core_type.t + val pcsig_fields : t -> Class_type_field.t list +end + +and Class_type_field : sig + type t = class_type_field + + type concrete = + { pctf_desc : Class_type_field_desc.t + ; pctf_loc : Astlib.Location.t + ; pctf_attributes : Attributes.t + } + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val create : + pctf_desc:Class_type_field_desc.t + -> pctf_loc:Astlib.Location.t + -> pctf_attributes:Attributes.t + -> t + + val pctf_desc : t -> Class_type_field_desc.t + val pctf_loc : t -> Astlib.Location.t + val pctf_attributes : t -> Attributes.t +end + +and Class_type_field_desc : sig + type t = class_type_field_desc + + type concrete = + | Pctf_inherit of Class_type.t + | Pctf_val of (string Astlib.Loc.t * Mutable_flag.t * Virtual_flag.t * Core_type.t) + | Pctf_method of (string Astlib.Loc.t * Private_flag.t * Virtual_flag.t * Core_type.t) + | Pctf_constraint of (Core_type.t * Core_type.t) + | Pctf_attribute of Attribute.t + | Pctf_extension of Extension.t + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val pctf_inherit : + Class_type.t + -> t + val pctf_val : + (string Astlib.Loc.t * Mutable_flag.t * Virtual_flag.t * Core_type.t) + -> t + val pctf_method : + (string Astlib.Loc.t * Private_flag.t * Virtual_flag.t * Core_type.t) + -> t + val pctf_constraint : + (Core_type.t * Core_type.t) + -> t + val pctf_attribute : + Attribute.t + -> t + val pctf_extension : + Extension.t + -> t +end + +and Class_infos : sig + type 'a t = 'a class_infos + + type 'a concrete = + { pci_virt : Virtual_flag.t + ; pci_params : (Core_type.t * Variance.t) list + ; pci_name : string Astlib.Loc.t + ; pci_expr : 'a + ; pci_loc : Astlib.Location.t + ; pci_attributes : Attributes.t + } + + val of_concrete : 'a node concrete -> 'a node t + val to_concrete : 'a node t -> 'a node concrete + val to_concrete_opt : 'a node t -> 'a node concrete option + + val create : + pci_virt:Virtual_flag.t + -> pci_params:(Core_type.t * Variance.t) list + -> pci_name:string Astlib.Loc.t + -> pci_expr:'a node + -> pci_loc:Astlib.Location.t + -> pci_attributes:Attributes.t + -> 'a node t + + val pci_virt : 'a node t -> Virtual_flag.t + val pci_params : 'a node t -> (Core_type.t * Variance.t) list + val pci_name : 'a node t -> string Astlib.Loc.t + val pci_expr : 'a node t -> 'a node + val pci_loc : 'a node t -> Astlib.Location.t + val pci_attributes : 'a node t -> Attributes.t +end + +and Class_description : sig + type t = class_description + + type concrete = Class_type.t Class_infos.t + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val create : Class_type.t Class_infos.t -> t +end + +and Class_type_declaration : sig + type t = class_type_declaration + + type concrete = Class_type.t Class_infos.t + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val create : Class_type.t Class_infos.t -> t +end + +and Class_expr : sig + type t = class_expr + + type concrete = + { pcl_desc : Class_expr_desc.t + ; pcl_loc : Astlib.Location.t + ; pcl_attributes : Attributes.t + } + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val create : + pcl_desc:Class_expr_desc.t + -> pcl_loc:Astlib.Location.t + -> pcl_attributes:Attributes.t + -> t + + val pcl_desc : t -> Class_expr_desc.t + val pcl_loc : t -> Astlib.Location.t + val pcl_attributes : t -> Attributes.t +end + +and Class_expr_desc : sig + type t = class_expr_desc + + type concrete = + | Pcl_constr of Longident_loc.t * Core_type.t list + | Pcl_structure of Class_structure.t + | Pcl_fun of Arg_label.t * Expression.t option * Pattern.t * Class_expr.t + | Pcl_apply of Class_expr.t * (Arg_label.t * Expression.t) list + | Pcl_let of Rec_flag.t * Value_binding.t list * Class_expr.t + | Pcl_constraint of Class_expr.t * Class_type.t + | Pcl_extension of Extension.t + | Pcl_open of Open_description.t * Class_expr.t + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val pcl_constr : + Longident_loc.t + -> Core_type.t list + -> t + val pcl_structure : + Class_structure.t + -> t + val pcl_fun : + Arg_label.t + -> Expression.t option + -> Pattern.t + -> Class_expr.t + -> t + val pcl_apply : + Class_expr.t + -> (Arg_label.t * Expression.t) list + -> t + val pcl_let : + Rec_flag.t + -> Value_binding.t list + -> Class_expr.t + -> t + val pcl_constraint : + Class_expr.t + -> Class_type.t + -> t + val pcl_extension : + Extension.t + -> t + val pcl_open : + Open_description.t + -> Class_expr.t + -> t +end + +and Class_structure : sig + type t = class_structure + + type concrete = + { pcstr_self : Pattern.t + ; pcstr_fields : Class_field.t list + } + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val create : + pcstr_self:Pattern.t + -> pcstr_fields:Class_field.t list + -> t + + val pcstr_self : t -> Pattern.t + val pcstr_fields : t -> Class_field.t list +end + +and Class_field : sig + type t = class_field + + type concrete = + { pcf_desc : Class_field_desc.t + ; pcf_loc : Astlib.Location.t + ; pcf_attributes : Attributes.t + } + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val create : + pcf_desc:Class_field_desc.t + -> pcf_loc:Astlib.Location.t + -> pcf_attributes:Attributes.t + -> t + + val pcf_desc : t -> Class_field_desc.t + val pcf_loc : t -> Astlib.Location.t + val pcf_attributes : t -> Attributes.t +end + +and Class_field_desc : sig + type t = class_field_desc + + type concrete = + | Pcf_inherit of Override_flag.t * Class_expr.t * string Astlib.Loc.t option + | Pcf_val of (string Astlib.Loc.t * Mutable_flag.t * Class_field_kind.t) + | Pcf_method of (string Astlib.Loc.t * Private_flag.t * Class_field_kind.t) + | Pcf_constraint of (Core_type.t * Core_type.t) + | Pcf_initializer of Expression.t + | Pcf_attribute of Attribute.t + | Pcf_extension of Extension.t + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val pcf_inherit : + Override_flag.t + -> Class_expr.t + -> string Astlib.Loc.t option + -> t + val pcf_val : + (string Astlib.Loc.t * Mutable_flag.t * Class_field_kind.t) + -> t + val pcf_method : + (string Astlib.Loc.t * Private_flag.t * Class_field_kind.t) + -> t + val pcf_constraint : + (Core_type.t * Core_type.t) + -> t + val pcf_initializer : + Expression.t + -> t + val pcf_attribute : + Attribute.t + -> t + val pcf_extension : + Extension.t + -> t +end + +and Class_field_kind : sig + type t = class_field_kind + + type concrete = + | Cfk_virtual of Core_type.t + | Cfk_concrete of Override_flag.t * Expression.t + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val cfk_virtual : + Core_type.t + -> t + val cfk_concrete : + Override_flag.t + -> Expression.t + -> t +end + +and Class_declaration : sig + type t = class_declaration + + type concrete = Class_expr.t Class_infos.t + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val create : Class_expr.t Class_infos.t -> t +end + +and Module_type : sig + type t = module_type + + type concrete = + { pmty_desc : Module_type_desc.t + ; pmty_loc : Astlib.Location.t + ; pmty_attributes : Attributes.t + } + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val create : + pmty_desc:Module_type_desc.t + -> pmty_loc:Astlib.Location.t + -> pmty_attributes:Attributes.t + -> t + + val pmty_desc : t -> Module_type_desc.t + val pmty_loc : t -> Astlib.Location.t + val pmty_attributes : t -> Attributes.t +end + +and Module_type_desc : sig + type t = module_type_desc + + type concrete = + | Pmty_ident of Longident_loc.t + | Pmty_signature of Signature.t + | Pmty_functor of string Astlib.Loc.t * Module_type.t option * Module_type.t + | Pmty_with of Module_type.t * With_constraint.t list + | Pmty_typeof of Module_expr.t + | Pmty_extension of Extension.t + | Pmty_alias of Longident_loc.t + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val pmty_ident : + Longident_loc.t + -> t + val pmty_signature : + Signature.t + -> t + val pmty_functor : + string Astlib.Loc.t + -> Module_type.t option + -> Module_type.t + -> t + val pmty_with : + Module_type.t + -> With_constraint.t list + -> t + val pmty_typeof : + Module_expr.t + -> t + val pmty_extension : + Extension.t + -> t + val pmty_alias : + Longident_loc.t + -> t +end + +and Signature : sig + type t = signature + + type concrete = Signature_item.t list + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val create : Signature_item.t list -> t +end + +and Signature_item : sig + type t = signature_item + + type concrete = + { psig_desc : Signature_item_desc.t + ; psig_loc : Astlib.Location.t + } + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val create : + psig_desc:Signature_item_desc.t + -> psig_loc:Astlib.Location.t + -> t + + val psig_desc : t -> Signature_item_desc.t + val psig_loc : t -> Astlib.Location.t +end + +and Signature_item_desc : sig + type t = signature_item_desc + + type concrete = + | Psig_value of Value_description.t + | Psig_type of Rec_flag.t * Type_declaration.t list + | Psig_typesubst of Type_declaration.t list + | Psig_typext of Type_extension.t + | Psig_exception of Type_exception.t + | Psig_module of Module_declaration.t + | Psig_modsubst of Module_substitution.t + | Psig_recmodule of Module_declaration.t list + | Psig_modtype of Module_type_declaration.t + | Psig_open of Open_description.t + | Psig_include of Include_description.t + | Psig_class of Class_description.t list + | Psig_class_type of Class_type_declaration.t list + | Psig_attribute of Attribute.t + | Psig_extension of Extension.t * Attributes.t + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val psig_value : + Value_description.t + -> t + val psig_type : + Rec_flag.t + -> Type_declaration.t list + -> t + val psig_typesubst : + Type_declaration.t list + -> t + val psig_typext : + Type_extension.t + -> t + val psig_exception : + Type_exception.t + -> t + val psig_module : + Module_declaration.t + -> t + val psig_modsubst : + Module_substitution.t + -> t + val psig_recmodule : + Module_declaration.t list + -> t + val psig_modtype : + Module_type_declaration.t + -> t + val psig_open : + Open_description.t + -> t + val psig_include : + Include_description.t + -> t + val psig_class : + Class_description.t list + -> t + val psig_class_type : + Class_type_declaration.t list + -> t + val psig_attribute : + Attribute.t + -> t + val psig_extension : + Extension.t + -> Attributes.t + -> t +end + +and Module_declaration : sig + type t = module_declaration + + type concrete = + { pmd_name : string Astlib.Loc.t + ; pmd_type : Module_type.t + ; pmd_attributes : Attributes.t + ; pmd_loc : Astlib.Location.t + } + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val create : + pmd_name:string Astlib.Loc.t + -> pmd_type:Module_type.t + -> pmd_attributes:Attributes.t + -> pmd_loc:Astlib.Location.t + -> t + + val pmd_name : t -> string Astlib.Loc.t + val pmd_type : t -> Module_type.t + val pmd_attributes : t -> Attributes.t + val pmd_loc : t -> Astlib.Location.t +end + +and Module_substitution : sig + type t = module_substitution + + type concrete = + { pms_name : string Astlib.Loc.t + ; pms_manifest : Longident_loc.t + ; pms_attributes : Attributes.t + ; pms_loc : Astlib.Location.t + } + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val create : + pms_name:string Astlib.Loc.t + -> pms_manifest:Longident_loc.t + -> pms_attributes:Attributes.t + -> pms_loc:Astlib.Location.t + -> t + + val pms_name : t -> string Astlib.Loc.t + val pms_manifest : t -> Longident_loc.t + val pms_attributes : t -> Attributes.t + val pms_loc : t -> Astlib.Location.t +end + +and Module_type_declaration : sig + type t = module_type_declaration + + type concrete = + { pmtd_name : string Astlib.Loc.t + ; pmtd_type : Module_type.t option + ; pmtd_attributes : Attributes.t + ; pmtd_loc : Astlib.Location.t + } + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val create : + pmtd_name:string Astlib.Loc.t + -> pmtd_type:Module_type.t option + -> pmtd_attributes:Attributes.t + -> pmtd_loc:Astlib.Location.t + -> t + + val pmtd_name : t -> string Astlib.Loc.t + val pmtd_type : t -> Module_type.t option + val pmtd_attributes : t -> Attributes.t + val pmtd_loc : t -> Astlib.Location.t +end + +and Open_infos : sig + type 'a t = 'a open_infos + + type 'a concrete = + { popen_expr : 'a + ; popen_override : Override_flag.t + ; popen_loc : Astlib.Location.t + ; popen_attributes : Attributes.t + } + + val of_concrete : 'a node concrete -> 'a node t + val to_concrete : 'a node t -> 'a node concrete + val to_concrete_opt : 'a node t -> 'a node concrete option + + val create : + popen_expr:'a node + -> popen_override:Override_flag.t + -> popen_loc:Astlib.Location.t + -> popen_attributes:Attributes.t + -> 'a node t + + val popen_expr : 'a node t -> 'a node + val popen_override : 'a node t -> Override_flag.t + val popen_loc : 'a node t -> Astlib.Location.t + val popen_attributes : 'a node t -> Attributes.t +end + +and Open_description : sig + type t = open_description + + type concrete = Longident_loc.t Open_infos.t + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val create : Longident_loc.t Open_infos.t -> t +end + +and Open_declaration : sig + type t = open_declaration + + type concrete = Module_expr.t Open_infos.t + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val create : Module_expr.t Open_infos.t -> t +end + +and Include_infos : sig + type 'a t = 'a include_infos + + type 'a concrete = + { pincl_mod : 'a + ; pincl_loc : Astlib.Location.t + ; pincl_attributes : Attributes.t + } + + val of_concrete : 'a node concrete -> 'a node t + val to_concrete : 'a node t -> 'a node concrete + val to_concrete_opt : 'a node t -> 'a node concrete option + + val create : + pincl_mod:'a node + -> pincl_loc:Astlib.Location.t + -> pincl_attributes:Attributes.t + -> 'a node t + + val pincl_mod : 'a node t -> 'a node + val pincl_loc : 'a node t -> Astlib.Location.t + val pincl_attributes : 'a node t -> Attributes.t +end + +and Include_description : sig + type t = include_description + + type concrete = Module_type.t Include_infos.t + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val create : Module_type.t Include_infos.t -> t +end + +and Include_declaration : sig + type t = include_declaration + + type concrete = Module_expr.t Include_infos.t + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val create : Module_expr.t Include_infos.t -> t +end + +and With_constraint : sig + type t = with_constraint + + type concrete = + | Pwith_type of Longident_loc.t * Type_declaration.t + | Pwith_module of Longident_loc.t * Longident_loc.t + | Pwith_typesubst of Longident_loc.t * Type_declaration.t + | Pwith_modsubst of Longident_loc.t * Longident_loc.t + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val pwith_type : + Longident_loc.t + -> Type_declaration.t + -> t + val pwith_module : + Longident_loc.t + -> Longident_loc.t + -> t + val pwith_typesubst : + Longident_loc.t + -> Type_declaration.t + -> t + val pwith_modsubst : + Longident_loc.t + -> Longident_loc.t + -> t +end + +and Module_expr : sig + type t = module_expr + + type concrete = + { pmod_desc : Module_expr_desc.t + ; pmod_loc : Astlib.Location.t + ; pmod_attributes : Attributes.t + } + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val create : + pmod_desc:Module_expr_desc.t + -> pmod_loc:Astlib.Location.t + -> pmod_attributes:Attributes.t + -> t + + val pmod_desc : t -> Module_expr_desc.t + val pmod_loc : t -> Astlib.Location.t + val pmod_attributes : t -> Attributes.t +end + +and Module_expr_desc : sig + type t = module_expr_desc + + type concrete = + | Pmod_ident of Longident_loc.t + | Pmod_structure of Structure.t + | Pmod_functor of string Astlib.Loc.t * Module_type.t option * Module_expr.t + | Pmod_apply of Module_expr.t * Module_expr.t + | Pmod_constraint of Module_expr.t * Module_type.t + | Pmod_unpack of Expression.t + | Pmod_extension of Extension.t + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val pmod_ident : + Longident_loc.t + -> t + val pmod_structure : + Structure.t + -> t + val pmod_functor : + string Astlib.Loc.t + -> Module_type.t option + -> Module_expr.t + -> t + val pmod_apply : + Module_expr.t + -> Module_expr.t + -> t + val pmod_constraint : + Module_expr.t + -> Module_type.t + -> t + val pmod_unpack : + Expression.t + -> t + val pmod_extension : + Extension.t + -> t +end + +and Structure : sig + type t = structure + + type concrete = Structure_item.t list + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val create : Structure_item.t list -> t +end + +and Structure_item : sig + type t = structure_item + + type concrete = + { pstr_desc : Structure_item_desc.t + ; pstr_loc : Astlib.Location.t + } + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val create : + pstr_desc:Structure_item_desc.t + -> pstr_loc:Astlib.Location.t + -> t + + val pstr_desc : t -> Structure_item_desc.t + val pstr_loc : t -> Astlib.Location.t +end + +and Structure_item_desc : sig + type t = structure_item_desc + + type concrete = + | Pstr_eval of Expression.t * Attributes.t + | Pstr_value of Rec_flag.t * Value_binding.t list + | Pstr_primitive of Value_description.t + | Pstr_type of Rec_flag.t * Type_declaration.t list + | Pstr_typext of Type_extension.t + | Pstr_exception of Type_exception.t + | Pstr_module of Module_binding.t + | Pstr_recmodule of Module_binding.t list + | Pstr_modtype of Module_type_declaration.t + | Pstr_open of Open_declaration.t + | Pstr_class of Class_declaration.t list + | Pstr_class_type of Class_type_declaration.t list + | Pstr_include of Include_declaration.t + | Pstr_attribute of Attribute.t + | Pstr_extension of Extension.t * Attributes.t + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val pstr_eval : + Expression.t + -> Attributes.t + -> t + val pstr_value : + Rec_flag.t + -> Value_binding.t list + -> t + val pstr_primitive : + Value_description.t + -> t + val pstr_type : + Rec_flag.t + -> Type_declaration.t list + -> t + val pstr_typext : + Type_extension.t + -> t + val pstr_exception : + Type_exception.t + -> t + val pstr_module : + Module_binding.t + -> t + val pstr_recmodule : + Module_binding.t list + -> t + val pstr_modtype : + Module_type_declaration.t + -> t + val pstr_open : + Open_declaration.t + -> t + val pstr_class : + Class_declaration.t list + -> t + val pstr_class_type : + Class_type_declaration.t list + -> t + val pstr_include : + Include_declaration.t + -> t + val pstr_attribute : + Attribute.t + -> t + val pstr_extension : + Extension.t + -> Attributes.t + -> t +end + +and Value_binding : sig + type t = value_binding + + type concrete = + { pvb_pat : Pattern.t + ; pvb_expr : Expression.t + ; pvb_attributes : Attributes.t + ; pvb_loc : Astlib.Location.t + } + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val create : + pvb_pat:Pattern.t + -> pvb_expr:Expression.t + -> pvb_attributes:Attributes.t + -> pvb_loc:Astlib.Location.t + -> t + + val pvb_pat : t -> Pattern.t + val pvb_expr : t -> Expression.t + val pvb_attributes : t -> Attributes.t + val pvb_loc : t -> Astlib.Location.t +end + +and Module_binding : sig + type t = module_binding + + type concrete = + { pmb_name : string Astlib.Loc.t + ; pmb_expr : Module_expr.t + ; pmb_attributes : Attributes.t + ; pmb_loc : Astlib.Location.t + } + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val create : + pmb_name:string Astlib.Loc.t + -> pmb_expr:Module_expr.t + -> pmb_attributes:Attributes.t + -> pmb_loc:Astlib.Location.t + -> t + + val pmb_name : t -> string Astlib.Loc.t + val pmb_expr : t -> Module_expr.t + val pmb_attributes : t -> Attributes.t + val pmb_loc : t -> Astlib.Location.t +end + +and Toplevel_phrase : sig + type t = toplevel_phrase + + type concrete = + | Ptop_def of Structure.t + | Ptop_dir of Toplevel_directive.t + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val ptop_def : + Structure.t + -> t + val ptop_dir : + Toplevel_directive.t + -> t +end + +and Toplevel_directive : sig + type t = toplevel_directive + + type concrete = + { pdir_name : string Astlib.Loc.t + ; pdir_arg : Directive_argument.t option + ; pdir_loc : Astlib.Location.t + } + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val create : + pdir_name:string Astlib.Loc.t + -> pdir_arg:Directive_argument.t option + -> pdir_loc:Astlib.Location.t + -> t + + val pdir_name : t -> string Astlib.Loc.t + val pdir_arg : t -> Directive_argument.t option + val pdir_loc : t -> Astlib.Location.t +end + +and Directive_argument : sig + type t = directive_argument + + type concrete = + { pdira_desc : Directive_argument_desc.t + ; pdira_loc : Astlib.Location.t + } + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val create : + pdira_desc:Directive_argument_desc.t + -> pdira_loc:Astlib.Location.t + -> t + + val pdira_desc : t -> Directive_argument_desc.t + val pdira_loc : t -> Astlib.Location.t +end + +and Directive_argument_desc : sig + type t = directive_argument_desc + + type concrete = + | Pdir_string of string + | Pdir_int of string * char option + | Pdir_ident of Longident.t + | Pdir_bool of bool + + val of_concrete : concrete -> t + val to_concrete : t -> concrete + val to_concrete_opt : t -> concrete option + + val pdir_string : + string + -> t + val pdir_int : + string + -> char option + -> t + val pdir_ident : + Longident.t + -> t + val pdir_bool : + bool + -> t +end +(*$*) diff --git a/ast/versions.ml b/ast/versions.ml index aed7ca6f..3daae0c3 100644 --- a/ast/versions.ml +++ b/ast/versions.ml @@ -1,3 +1,4 @@ include Unversioned.Types +module V4_08 = Version_v4_08 module V4_07 = Version_v4_07 module Unstable_for_testing = Version_unstable_for_testing diff --git a/ast/versions.mli b/ast/versions.mli index 13248d8b..711861d1 100644 --- a/ast/versions.mli +++ b/ast/versions.mli @@ -1,3 +1,4 @@ include module type of struct include Unversioned.Types end +module V4_08 = Version_v4_08 module V4_07 = Version_v4_07 module Unstable_for_testing = Version_unstable_for_testing diff --git a/ast/viewer.ml b/ast/viewer.ml index c71e87f6..7772a8a0 100644 --- a/ast/viewer.ml +++ b/ast/viewer.ml @@ -1,2 +1,3 @@ +module V4_08 = Viewer_v4_08 module V4_07 = Viewer_v4_07 module Unstable_for_testing = Viewer_unstable_for_testing diff --git a/ast/viewer.mli b/ast/viewer.mli index c71e87f6..7772a8a0 100644 --- a/ast/viewer.mli +++ b/ast/viewer.mli @@ -1,2 +1,3 @@ +module V4_08 = Viewer_v4_08 module V4_07 = Viewer_v4_07 module Unstable_for_testing = Viewer_unstable_for_testing diff --git a/ast/viewer_v4_08.ml b/ast/viewer_v4_08.ml new file mode 100644 index 00000000..ae9adfbd --- /dev/null +++ b/ast/viewer_v4_08.ml @@ -0,0 +1,2894 @@ +open Viewlib + +(*$ Ppx_ast_cinaps.print_viewer_ml (Astlib.Version.of_string "v4_08") *) +open Versions.V4_08 +include Viewer_common + +let lident'const view value = + let concrete = Longident.to_concrete value in + match concrete with + | Longident.Lident arg -> view arg + | _ -> View.error + +let ldot'const view value = + let concrete = Longident.to_concrete value in + match concrete with + | Longident.Ldot (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let lapply'const view value = + let concrete = Longident.to_concrete value in + match concrete with + | Longident.Lapply (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let longident_loc'const view value = + let concrete0 = Longident_loc.to_concrete value in + view concrete0 + +let nonrecursive'const value = + let concrete = Rec_flag.to_concrete value in + match concrete with + | Rec_flag.Nonrecursive -> View.ok + | _ -> View.error + +let recursive'const value = + let concrete = Rec_flag.to_concrete value in + match concrete with + | Rec_flag.Recursive -> View.ok + | _ -> View.error + +let upto'const value = + let concrete = Direction_flag.to_concrete value in + match concrete with + | Direction_flag.Upto -> View.ok + | _ -> View.error + +let downto'const value = + let concrete = Direction_flag.to_concrete value in + match concrete with + | Direction_flag.Downto -> View.ok + | _ -> View.error + +let private'const value = + let concrete = Private_flag.to_concrete value in + match concrete with + | Private_flag.Private -> View.ok + | _ -> View.error + +let public'const value = + let concrete = Private_flag.to_concrete value in + match concrete with + | Private_flag.Public -> View.ok + | _ -> View.error + +let immutable'const value = + let concrete = Mutable_flag.to_concrete value in + match concrete with + | Mutable_flag.Immutable -> View.ok + | _ -> View.error + +let mutable'const value = + let concrete = Mutable_flag.to_concrete value in + match concrete with + | Mutable_flag.Mutable -> View.ok + | _ -> View.error + +let virtual'const value = + let concrete = Virtual_flag.to_concrete value in + match concrete with + | Virtual_flag.Virtual -> View.ok + | _ -> View.error + +let concrete'const value = + let concrete = Virtual_flag.to_concrete value in + match concrete with + | Virtual_flag.Concrete -> View.ok + | _ -> View.error + +let override'const value = + let concrete = Override_flag.to_concrete value in + match concrete with + | Override_flag.Override -> View.ok + | _ -> View.error + +let fresh'const value = + let concrete = Override_flag.to_concrete value in + match concrete with + | Override_flag.Fresh -> View.ok + | _ -> View.error + +let closed'const value = + let concrete = Closed_flag.to_concrete value in + match concrete with + | Closed_flag.Closed -> View.ok + | _ -> View.error + +let open'const value = + let concrete = Closed_flag.to_concrete value in + match concrete with + | Closed_flag.Open -> View.ok + | _ -> View.error + +let nolabel'const value = + let concrete = Arg_label.to_concrete value in + match concrete with + | Arg_label.Nolabel -> View.ok + | _ -> View.error + +let labelled'const view value = + let concrete = Arg_label.to_concrete value in + match concrete with + | Arg_label.Labelled arg -> view arg + | _ -> View.error + +let optional'const view value = + let concrete = Arg_label.to_concrete value in + match concrete with + | Arg_label.Optional arg -> view arg + | _ -> View.error + +let covariant'const value = + let concrete = Variance.to_concrete value in + match concrete with + | Variance.Covariant -> View.ok + | _ -> View.error + +let contravariant'const value = + let concrete = Variance.to_concrete value in + match concrete with + | Variance.Contravariant -> View.ok + | _ -> View.error + +let invariant'const value = + let concrete = Variance.to_concrete value in + match concrete with + | Variance.Invariant -> View.ok + | _ -> View.error + +let pconst_integer'const view value = + let concrete = Constant.to_concrete value in + match concrete with + | Constant.Pconst_integer (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let pconst_char'const view value = + let concrete = Constant.to_concrete value in + match concrete with + | Constant.Pconst_char arg -> view arg + | _ -> View.error + +let pconst_string'const view value = + let concrete = Constant.to_concrete value in + match concrete with + | Constant.Pconst_string (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let pconst_float'const view value = + let concrete = Constant.to_concrete value in + match concrete with + | Constant.Pconst_float (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let attr_name'match view value = + let concrete = Attribute.to_concrete value in + view concrete.Attribute.attr_name + +let attr_payload'match view value = + let concrete = Attribute.to_concrete value in + view concrete.Attribute.attr_payload + +let attr_loc'match view value = + let concrete = Attribute.to_concrete value in + view concrete.Attribute.attr_loc + +let extension'const view value = + let concrete0 = Extension.to_concrete value in + view concrete0 + +let attributes'const view value = + let concrete0 = Attributes.to_concrete value in + view concrete0 + +let pstr'const view value = + let concrete = Payload.to_concrete value in + match concrete with + | Payload.PStr arg -> view arg + | _ -> View.error + +let psig'const view value = + let concrete = Payload.to_concrete value in + match concrete with + | Payload.PSig arg -> view arg + | _ -> View.error + +let ptyp'const view value = + let concrete = Payload.to_concrete value in + match concrete with + | Payload.PTyp arg -> view arg + | _ -> View.error + +let ppat'const view value = + let concrete = Payload.to_concrete value in + match concrete with + | Payload.PPat (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let ptyp_desc'match view value = + let concrete = Core_type.to_concrete value in + view concrete.Core_type.ptyp_desc + +let ptyp_loc'match view value = + let concrete = Core_type.to_concrete value in + view concrete.Core_type.ptyp_loc + +let ptyp_loc_stack'match view value = + let concrete = Core_type.to_concrete value in + view concrete.Core_type.ptyp_loc_stack + +let ptyp_attributes'match view value = + let concrete = Core_type.to_concrete value in + view concrete.Core_type.ptyp_attributes + +let ptyp_any'const value = + let concrete = Core_type_desc.to_concrete value in + match concrete with + | Core_type_desc.Ptyp_any -> View.ok + | _ -> View.error + +let tany'const value = + let parent_concrete = Core_type.to_concrete value in + let desc = parent_concrete.Core_type.ptyp_desc in + let concrete = Core_type_desc.to_concrete desc in + match concrete with + | Core_type_desc.Ptyp_any -> View.ok + | _ -> View.error + +let ptyp_var'const view value = + let concrete = Core_type_desc.to_concrete value in + match concrete with + | Core_type_desc.Ptyp_var arg -> view arg + | _ -> View.error + +let tvar'const view value = + let parent_concrete = Core_type.to_concrete value in + let desc = parent_concrete.Core_type.ptyp_desc in + let concrete = Core_type_desc.to_concrete desc in + match concrete with + | Core_type_desc.Ptyp_var arg -> view arg + | _ -> View.error + +let ptyp_arrow'const view value = + let concrete = Core_type_desc.to_concrete value in + match concrete with + | Core_type_desc.Ptyp_arrow (arg0, arg1, arg2) -> view (arg0, arg1, arg2) + | _ -> View.error + +let tarrow'const view value = + let parent_concrete = Core_type.to_concrete value in + let desc = parent_concrete.Core_type.ptyp_desc in + let concrete = Core_type_desc.to_concrete desc in + match concrete with + | Core_type_desc.Ptyp_arrow (arg0, arg1, arg2) -> view (arg0, arg1, arg2) + | _ -> View.error + +let ptyp_tuple'const view value = + let concrete = Core_type_desc.to_concrete value in + match concrete with + | Core_type_desc.Ptyp_tuple arg -> view arg + | _ -> View.error + +let ttuple'const view value = + let parent_concrete = Core_type.to_concrete value in + let desc = parent_concrete.Core_type.ptyp_desc in + let concrete = Core_type_desc.to_concrete desc in + match concrete with + | Core_type_desc.Ptyp_tuple arg -> view arg + | _ -> View.error + +let ptyp_constr'const view value = + let concrete = Core_type_desc.to_concrete value in + match concrete with + | Core_type_desc.Ptyp_constr (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let tconstr'const view value = + let parent_concrete = Core_type.to_concrete value in + let desc = parent_concrete.Core_type.ptyp_desc in + let concrete = Core_type_desc.to_concrete desc in + match concrete with + | Core_type_desc.Ptyp_constr (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let ptyp_object'const view value = + let concrete = Core_type_desc.to_concrete value in + match concrete with + | Core_type_desc.Ptyp_object (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let tobject'const view value = + let parent_concrete = Core_type.to_concrete value in + let desc = parent_concrete.Core_type.ptyp_desc in + let concrete = Core_type_desc.to_concrete desc in + match concrete with + | Core_type_desc.Ptyp_object (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let ptyp_class'const view value = + let concrete = Core_type_desc.to_concrete value in + match concrete with + | Core_type_desc.Ptyp_class (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let tclass'const view value = + let parent_concrete = Core_type.to_concrete value in + let desc = parent_concrete.Core_type.ptyp_desc in + let concrete = Core_type_desc.to_concrete desc in + match concrete with + | Core_type_desc.Ptyp_class (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let ptyp_alias'const view value = + let concrete = Core_type_desc.to_concrete value in + match concrete with + | Core_type_desc.Ptyp_alias (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let talias'const view value = + let parent_concrete = Core_type.to_concrete value in + let desc = parent_concrete.Core_type.ptyp_desc in + let concrete = Core_type_desc.to_concrete desc in + match concrete with + | Core_type_desc.Ptyp_alias (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let ptyp_variant'const view value = + let concrete = Core_type_desc.to_concrete value in + match concrete with + | Core_type_desc.Ptyp_variant (arg0, arg1, arg2) -> view (arg0, arg1, arg2) + | _ -> View.error + +let tvariant'const view value = + let parent_concrete = Core_type.to_concrete value in + let desc = parent_concrete.Core_type.ptyp_desc in + let concrete = Core_type_desc.to_concrete desc in + match concrete with + | Core_type_desc.Ptyp_variant (arg0, arg1, arg2) -> view (arg0, arg1, arg2) + | _ -> View.error + +let ptyp_poly'const view value = + let concrete = Core_type_desc.to_concrete value in + match concrete with + | Core_type_desc.Ptyp_poly (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let tpoly'const view value = + let parent_concrete = Core_type.to_concrete value in + let desc = parent_concrete.Core_type.ptyp_desc in + let concrete = Core_type_desc.to_concrete desc in + match concrete with + | Core_type_desc.Ptyp_poly (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let ptyp_package'const view value = + let concrete = Core_type_desc.to_concrete value in + match concrete with + | Core_type_desc.Ptyp_package arg -> view arg + | _ -> View.error + +let tpackage'const view value = + let parent_concrete = Core_type.to_concrete value in + let desc = parent_concrete.Core_type.ptyp_desc in + let concrete = Core_type_desc.to_concrete desc in + match concrete with + | Core_type_desc.Ptyp_package arg -> view arg + | _ -> View.error + +let ptyp_extension'const view value = + let concrete = Core_type_desc.to_concrete value in + match concrete with + | Core_type_desc.Ptyp_extension arg -> view arg + | _ -> View.error + +let textension'const view value = + let parent_concrete = Core_type.to_concrete value in + let desc = parent_concrete.Core_type.ptyp_desc in + let concrete = Core_type_desc.to_concrete desc in + match concrete with + | Core_type_desc.Ptyp_extension arg -> view arg + | _ -> View.error + +let package_type'const view value = + let concrete0 = Package_type.to_concrete value in + view concrete0 + +let prf_desc'match view value = + let concrete = Row_field.to_concrete value in + view concrete.Row_field.prf_desc + +let prf_loc'match view value = + let concrete = Row_field.to_concrete value in + view concrete.Row_field.prf_loc + +let prf_attributes'match view value = + let concrete = Row_field.to_concrete value in + view concrete.Row_field.prf_attributes + +let rtag'const view value = + let concrete = Row_field_desc.to_concrete value in + match concrete with + | Row_field_desc.Rtag (arg0, arg1, arg2) -> view (arg0, arg1, arg2) + | _ -> View.error + +let rfrtag'const view value = + let parent_concrete = Row_field.to_concrete value in + let desc = parent_concrete.Row_field.prf_desc in + let concrete = Row_field_desc.to_concrete desc in + match concrete with + | Row_field_desc.Rtag (arg0, arg1, arg2) -> view (arg0, arg1, arg2) + | _ -> View.error + +let rinherit'const view value = + let concrete = Row_field_desc.to_concrete value in + match concrete with + | Row_field_desc.Rinherit arg -> view arg + | _ -> View.error + +let rfrinherit'const view value = + let parent_concrete = Row_field.to_concrete value in + let desc = parent_concrete.Row_field.prf_desc in + let concrete = Row_field_desc.to_concrete desc in + match concrete with + | Row_field_desc.Rinherit arg -> view arg + | _ -> View.error + +let pof_desc'match view value = + let concrete = Object_field.to_concrete value in + view concrete.Object_field.pof_desc + +let pof_loc'match view value = + let concrete = Object_field.to_concrete value in + view concrete.Object_field.pof_loc + +let pof_attributes'match view value = + let concrete = Object_field.to_concrete value in + view concrete.Object_field.pof_attributes + +let otag'const view value = + let concrete = Object_field_desc.to_concrete value in + match concrete with + | Object_field_desc.Otag (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let ofotag'const view value = + let parent_concrete = Object_field.to_concrete value in + let desc = parent_concrete.Object_field.pof_desc in + let concrete = Object_field_desc.to_concrete desc in + match concrete with + | Object_field_desc.Otag (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let oinherit'const view value = + let concrete = Object_field_desc.to_concrete value in + match concrete with + | Object_field_desc.Oinherit arg -> view arg + | _ -> View.error + +let ofoinherit'const view value = + let parent_concrete = Object_field.to_concrete value in + let desc = parent_concrete.Object_field.pof_desc in + let concrete = Object_field_desc.to_concrete desc in + match concrete with + | Object_field_desc.Oinherit arg -> view arg + | _ -> View.error + +let ppat_desc'match view value = + let concrete = Pattern.to_concrete value in + view concrete.Pattern.ppat_desc + +let ppat_loc'match view value = + let concrete = Pattern.to_concrete value in + view concrete.Pattern.ppat_loc + +let ppat_loc_stack'match view value = + let concrete = Pattern.to_concrete value in + view concrete.Pattern.ppat_loc_stack + +let ppat_attributes'match view value = + let concrete = Pattern.to_concrete value in + view concrete.Pattern.ppat_attributes + +let ppat_any'const value = + let concrete = Pattern_desc.to_concrete value in + match concrete with + | Pattern_desc.Ppat_any -> View.ok + | _ -> View.error + +let pany'const value = + let parent_concrete = Pattern.to_concrete value in + let desc = parent_concrete.Pattern.ppat_desc in + let concrete = Pattern_desc.to_concrete desc in + match concrete with + | Pattern_desc.Ppat_any -> View.ok + | _ -> View.error + +let ppat_var'const view value = + let concrete = Pattern_desc.to_concrete value in + match concrete with + | Pattern_desc.Ppat_var arg -> view arg + | _ -> View.error + +let pvar'const view value = + let parent_concrete = Pattern.to_concrete value in + let desc = parent_concrete.Pattern.ppat_desc in + let concrete = Pattern_desc.to_concrete desc in + match concrete with + | Pattern_desc.Ppat_var arg -> view arg + | _ -> View.error + +let ppat_alias'const view value = + let concrete = Pattern_desc.to_concrete value in + match concrete with + | Pattern_desc.Ppat_alias (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let palias'const view value = + let parent_concrete = Pattern.to_concrete value in + let desc = parent_concrete.Pattern.ppat_desc in + let concrete = Pattern_desc.to_concrete desc in + match concrete with + | Pattern_desc.Ppat_alias (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let ppat_constant'const view value = + let concrete = Pattern_desc.to_concrete value in + match concrete with + | Pattern_desc.Ppat_constant arg -> view arg + | _ -> View.error + +let pconstant'const view value = + let parent_concrete = Pattern.to_concrete value in + let desc = parent_concrete.Pattern.ppat_desc in + let concrete = Pattern_desc.to_concrete desc in + match concrete with + | Pattern_desc.Ppat_constant arg -> view arg + | _ -> View.error + +let ppat_interval'const view value = + let concrete = Pattern_desc.to_concrete value in + match concrete with + | Pattern_desc.Ppat_interval (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let pinterval'const view value = + let parent_concrete = Pattern.to_concrete value in + let desc = parent_concrete.Pattern.ppat_desc in + let concrete = Pattern_desc.to_concrete desc in + match concrete with + | Pattern_desc.Ppat_interval (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let ppat_tuple'const view value = + let concrete = Pattern_desc.to_concrete value in + match concrete with + | Pattern_desc.Ppat_tuple arg -> view arg + | _ -> View.error + +let ptuple'const view value = + let parent_concrete = Pattern.to_concrete value in + let desc = parent_concrete.Pattern.ppat_desc in + let concrete = Pattern_desc.to_concrete desc in + match concrete with + | Pattern_desc.Ppat_tuple arg -> view arg + | _ -> View.error + +let ppat_construct'const view value = + let concrete = Pattern_desc.to_concrete value in + match concrete with + | Pattern_desc.Ppat_construct (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let pconstruct'const view value = + let parent_concrete = Pattern.to_concrete value in + let desc = parent_concrete.Pattern.ppat_desc in + let concrete = Pattern_desc.to_concrete desc in + match concrete with + | Pattern_desc.Ppat_construct (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let ppat_variant'const view value = + let concrete = Pattern_desc.to_concrete value in + match concrete with + | Pattern_desc.Ppat_variant (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let pvariant'const view value = + let parent_concrete = Pattern.to_concrete value in + let desc = parent_concrete.Pattern.ppat_desc in + let concrete = Pattern_desc.to_concrete desc in + match concrete with + | Pattern_desc.Ppat_variant (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let ppat_record'const view value = + let concrete = Pattern_desc.to_concrete value in + match concrete with + | Pattern_desc.Ppat_record (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let precord'const view value = + let parent_concrete = Pattern.to_concrete value in + let desc = parent_concrete.Pattern.ppat_desc in + let concrete = Pattern_desc.to_concrete desc in + match concrete with + | Pattern_desc.Ppat_record (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let ppat_array'const view value = + let concrete = Pattern_desc.to_concrete value in + match concrete with + | Pattern_desc.Ppat_array arg -> view arg + | _ -> View.error + +let parray'const view value = + let parent_concrete = Pattern.to_concrete value in + let desc = parent_concrete.Pattern.ppat_desc in + let concrete = Pattern_desc.to_concrete desc in + match concrete with + | Pattern_desc.Ppat_array arg -> view arg + | _ -> View.error + +let ppat_or'const view value = + let concrete = Pattern_desc.to_concrete value in + match concrete with + | Pattern_desc.Ppat_or (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let por'const view value = + let parent_concrete = Pattern.to_concrete value in + let desc = parent_concrete.Pattern.ppat_desc in + let concrete = Pattern_desc.to_concrete desc in + match concrete with + | Pattern_desc.Ppat_or (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let ppat_constraint'const view value = + let concrete = Pattern_desc.to_concrete value in + match concrete with + | Pattern_desc.Ppat_constraint (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let pconstraint'const view value = + let parent_concrete = Pattern.to_concrete value in + let desc = parent_concrete.Pattern.ppat_desc in + let concrete = Pattern_desc.to_concrete desc in + match concrete with + | Pattern_desc.Ppat_constraint (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let ppat_type'const view value = + let concrete = Pattern_desc.to_concrete value in + match concrete with + | Pattern_desc.Ppat_type arg -> view arg + | _ -> View.error + +let ptype'const view value = + let parent_concrete = Pattern.to_concrete value in + let desc = parent_concrete.Pattern.ppat_desc in + let concrete = Pattern_desc.to_concrete desc in + match concrete with + | Pattern_desc.Ppat_type arg -> view arg + | _ -> View.error + +let ppat_lazy'const view value = + let concrete = Pattern_desc.to_concrete value in + match concrete with + | Pattern_desc.Ppat_lazy arg -> view arg + | _ -> View.error + +let plazy'const view value = + let parent_concrete = Pattern.to_concrete value in + let desc = parent_concrete.Pattern.ppat_desc in + let concrete = Pattern_desc.to_concrete desc in + match concrete with + | Pattern_desc.Ppat_lazy arg -> view arg + | _ -> View.error + +let ppat_unpack'const view value = + let concrete = Pattern_desc.to_concrete value in + match concrete with + | Pattern_desc.Ppat_unpack arg -> view arg + | _ -> View.error + +let punpack'const view value = + let parent_concrete = Pattern.to_concrete value in + let desc = parent_concrete.Pattern.ppat_desc in + let concrete = Pattern_desc.to_concrete desc in + match concrete with + | Pattern_desc.Ppat_unpack arg -> view arg + | _ -> View.error + +let ppat_exception'const view value = + let concrete = Pattern_desc.to_concrete value in + match concrete with + | Pattern_desc.Ppat_exception arg -> view arg + | _ -> View.error + +let pexception'const view value = + let parent_concrete = Pattern.to_concrete value in + let desc = parent_concrete.Pattern.ppat_desc in + let concrete = Pattern_desc.to_concrete desc in + match concrete with + | Pattern_desc.Ppat_exception arg -> view arg + | _ -> View.error + +let ppat_extension'const view value = + let concrete = Pattern_desc.to_concrete value in + match concrete with + | Pattern_desc.Ppat_extension arg -> view arg + | _ -> View.error + +let pextension'const view value = + let parent_concrete = Pattern.to_concrete value in + let desc = parent_concrete.Pattern.ppat_desc in + let concrete = Pattern_desc.to_concrete desc in + match concrete with + | Pattern_desc.Ppat_extension arg -> view arg + | _ -> View.error + +let ppat_open'const view value = + let concrete = Pattern_desc.to_concrete value in + match concrete with + | Pattern_desc.Ppat_open (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let popen'const view value = + let parent_concrete = Pattern.to_concrete value in + let desc = parent_concrete.Pattern.ppat_desc in + let concrete = Pattern_desc.to_concrete desc in + match concrete with + | Pattern_desc.Ppat_open (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let pexp_desc'match view value = + let concrete = Expression.to_concrete value in + view concrete.Expression.pexp_desc + +let pexp_loc'match view value = + let concrete = Expression.to_concrete value in + view concrete.Expression.pexp_loc + +let pexp_loc_stack'match view value = + let concrete = Expression.to_concrete value in + view concrete.Expression.pexp_loc_stack + +let pexp_attributes'match view value = + let concrete = Expression.to_concrete value in + view concrete.Expression.pexp_attributes + +let pexp_ident'const view value = + let concrete = Expression_desc.to_concrete value in + match concrete with + | Expression_desc.Pexp_ident arg -> view arg + | _ -> View.error + +let eident'const view value = + let parent_concrete = Expression.to_concrete value in + let desc = parent_concrete.Expression.pexp_desc in + let concrete = Expression_desc.to_concrete desc in + match concrete with + | Expression_desc.Pexp_ident arg -> view arg + | _ -> View.error + +let pexp_constant'const view value = + let concrete = Expression_desc.to_concrete value in + match concrete with + | Expression_desc.Pexp_constant arg -> view arg + | _ -> View.error + +let econstant'const view value = + let parent_concrete = Expression.to_concrete value in + let desc = parent_concrete.Expression.pexp_desc in + let concrete = Expression_desc.to_concrete desc in + match concrete with + | Expression_desc.Pexp_constant arg -> view arg + | _ -> View.error + +let pexp_let'const view value = + let concrete = Expression_desc.to_concrete value in + match concrete with + | Expression_desc.Pexp_let (arg0, arg1, arg2) -> view (arg0, arg1, arg2) + | _ -> View.error + +let elet'const view value = + let parent_concrete = Expression.to_concrete value in + let desc = parent_concrete.Expression.pexp_desc in + let concrete = Expression_desc.to_concrete desc in + match concrete with + | Expression_desc.Pexp_let (arg0, arg1, arg2) -> view (arg0, arg1, arg2) + | _ -> View.error + +let pexp_function'const view value = + let concrete = Expression_desc.to_concrete value in + match concrete with + | Expression_desc.Pexp_function arg -> view arg + | _ -> View.error + +let efunction'const view value = + let parent_concrete = Expression.to_concrete value in + let desc = parent_concrete.Expression.pexp_desc in + let concrete = Expression_desc.to_concrete desc in + match concrete with + | Expression_desc.Pexp_function arg -> view arg + | _ -> View.error + +let pexp_fun'const view value = + let concrete = Expression_desc.to_concrete value in + match concrete with + | Expression_desc.Pexp_fun (arg0, arg1, arg2, arg3) -> view (arg0, arg1, arg2, arg3) + | _ -> View.error + +let efun'const view value = + let parent_concrete = Expression.to_concrete value in + let desc = parent_concrete.Expression.pexp_desc in + let concrete = Expression_desc.to_concrete desc in + match concrete with + | Expression_desc.Pexp_fun (arg0, arg1, arg2, arg3) -> view (arg0, arg1, arg2, arg3) + | _ -> View.error + +let pexp_apply'const view value = + let concrete = Expression_desc.to_concrete value in + match concrete with + | Expression_desc.Pexp_apply (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let eapply'const view value = + let parent_concrete = Expression.to_concrete value in + let desc = parent_concrete.Expression.pexp_desc in + let concrete = Expression_desc.to_concrete desc in + match concrete with + | Expression_desc.Pexp_apply (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let pexp_match'const view value = + let concrete = Expression_desc.to_concrete value in + match concrete with + | Expression_desc.Pexp_match (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let ematch'const view value = + let parent_concrete = Expression.to_concrete value in + let desc = parent_concrete.Expression.pexp_desc in + let concrete = Expression_desc.to_concrete desc in + match concrete with + | Expression_desc.Pexp_match (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let pexp_try'const view value = + let concrete = Expression_desc.to_concrete value in + match concrete with + | Expression_desc.Pexp_try (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let etry'const view value = + let parent_concrete = Expression.to_concrete value in + let desc = parent_concrete.Expression.pexp_desc in + let concrete = Expression_desc.to_concrete desc in + match concrete with + | Expression_desc.Pexp_try (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let pexp_tuple'const view value = + let concrete = Expression_desc.to_concrete value in + match concrete with + | Expression_desc.Pexp_tuple arg -> view arg + | _ -> View.error + +let etuple'const view value = + let parent_concrete = Expression.to_concrete value in + let desc = parent_concrete.Expression.pexp_desc in + let concrete = Expression_desc.to_concrete desc in + match concrete with + | Expression_desc.Pexp_tuple arg -> view arg + | _ -> View.error + +let pexp_construct'const view value = + let concrete = Expression_desc.to_concrete value in + match concrete with + | Expression_desc.Pexp_construct (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let econstruct'const view value = + let parent_concrete = Expression.to_concrete value in + let desc = parent_concrete.Expression.pexp_desc in + let concrete = Expression_desc.to_concrete desc in + match concrete with + | Expression_desc.Pexp_construct (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let pexp_variant'const view value = + let concrete = Expression_desc.to_concrete value in + match concrete with + | Expression_desc.Pexp_variant (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let evariant'const view value = + let parent_concrete = Expression.to_concrete value in + let desc = parent_concrete.Expression.pexp_desc in + let concrete = Expression_desc.to_concrete desc in + match concrete with + | Expression_desc.Pexp_variant (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let pexp_record'const view value = + let concrete = Expression_desc.to_concrete value in + match concrete with + | Expression_desc.Pexp_record (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let erecord'const view value = + let parent_concrete = Expression.to_concrete value in + let desc = parent_concrete.Expression.pexp_desc in + let concrete = Expression_desc.to_concrete desc in + match concrete with + | Expression_desc.Pexp_record (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let pexp_field'const view value = + let concrete = Expression_desc.to_concrete value in + match concrete with + | Expression_desc.Pexp_field (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let efield'const view value = + let parent_concrete = Expression.to_concrete value in + let desc = parent_concrete.Expression.pexp_desc in + let concrete = Expression_desc.to_concrete desc in + match concrete with + | Expression_desc.Pexp_field (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let pexp_setfield'const view value = + let concrete = Expression_desc.to_concrete value in + match concrete with + | Expression_desc.Pexp_setfield (arg0, arg1, arg2) -> view (arg0, arg1, arg2) + | _ -> View.error + +let esetfield'const view value = + let parent_concrete = Expression.to_concrete value in + let desc = parent_concrete.Expression.pexp_desc in + let concrete = Expression_desc.to_concrete desc in + match concrete with + | Expression_desc.Pexp_setfield (arg0, arg1, arg2) -> view (arg0, arg1, arg2) + | _ -> View.error + +let pexp_array'const view value = + let concrete = Expression_desc.to_concrete value in + match concrete with + | Expression_desc.Pexp_array arg -> view arg + | _ -> View.error + +let earray'const view value = + let parent_concrete = Expression.to_concrete value in + let desc = parent_concrete.Expression.pexp_desc in + let concrete = Expression_desc.to_concrete desc in + match concrete with + | Expression_desc.Pexp_array arg -> view arg + | _ -> View.error + +let pexp_ifthenelse'const view value = + let concrete = Expression_desc.to_concrete value in + match concrete with + | Expression_desc.Pexp_ifthenelse (arg0, arg1, arg2) -> view (arg0, arg1, arg2) + | _ -> View.error + +let eifthenelse'const view value = + let parent_concrete = Expression.to_concrete value in + let desc = parent_concrete.Expression.pexp_desc in + let concrete = Expression_desc.to_concrete desc in + match concrete with + | Expression_desc.Pexp_ifthenelse (arg0, arg1, arg2) -> view (arg0, arg1, arg2) + | _ -> View.error + +let pexp_sequence'const view value = + let concrete = Expression_desc.to_concrete value in + match concrete with + | Expression_desc.Pexp_sequence (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let esequence'const view value = + let parent_concrete = Expression.to_concrete value in + let desc = parent_concrete.Expression.pexp_desc in + let concrete = Expression_desc.to_concrete desc in + match concrete with + | Expression_desc.Pexp_sequence (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let pexp_while'const view value = + let concrete = Expression_desc.to_concrete value in + match concrete with + | Expression_desc.Pexp_while (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let ewhile'const view value = + let parent_concrete = Expression.to_concrete value in + let desc = parent_concrete.Expression.pexp_desc in + let concrete = Expression_desc.to_concrete desc in + match concrete with + | Expression_desc.Pexp_while (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let pexp_for'const view value = + let concrete = Expression_desc.to_concrete value in + match concrete with + | Expression_desc.Pexp_for (arg0, arg1, arg2, arg3, arg4) -> view (arg0, arg1, arg2, arg3, arg4) + | _ -> View.error + +let efor'const view value = + let parent_concrete = Expression.to_concrete value in + let desc = parent_concrete.Expression.pexp_desc in + let concrete = Expression_desc.to_concrete desc in + match concrete with + | Expression_desc.Pexp_for (arg0, arg1, arg2, arg3, arg4) -> view (arg0, arg1, arg2, arg3, arg4) + | _ -> View.error + +let pexp_constraint'const view value = + let concrete = Expression_desc.to_concrete value in + match concrete with + | Expression_desc.Pexp_constraint (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let econstraint'const view value = + let parent_concrete = Expression.to_concrete value in + let desc = parent_concrete.Expression.pexp_desc in + let concrete = Expression_desc.to_concrete desc in + match concrete with + | Expression_desc.Pexp_constraint (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let pexp_coerce'const view value = + let concrete = Expression_desc.to_concrete value in + match concrete with + | Expression_desc.Pexp_coerce (arg0, arg1, arg2) -> view (arg0, arg1, arg2) + | _ -> View.error + +let ecoerce'const view value = + let parent_concrete = Expression.to_concrete value in + let desc = parent_concrete.Expression.pexp_desc in + let concrete = Expression_desc.to_concrete desc in + match concrete with + | Expression_desc.Pexp_coerce (arg0, arg1, arg2) -> view (arg0, arg1, arg2) + | _ -> View.error + +let pexp_send'const view value = + let concrete = Expression_desc.to_concrete value in + match concrete with + | Expression_desc.Pexp_send (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let esend'const view value = + let parent_concrete = Expression.to_concrete value in + let desc = parent_concrete.Expression.pexp_desc in + let concrete = Expression_desc.to_concrete desc in + match concrete with + | Expression_desc.Pexp_send (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let pexp_new'const view value = + let concrete = Expression_desc.to_concrete value in + match concrete with + | Expression_desc.Pexp_new arg -> view arg + | _ -> View.error + +let enew'const view value = + let parent_concrete = Expression.to_concrete value in + let desc = parent_concrete.Expression.pexp_desc in + let concrete = Expression_desc.to_concrete desc in + match concrete with + | Expression_desc.Pexp_new arg -> view arg + | _ -> View.error + +let pexp_setinstvar'const view value = + let concrete = Expression_desc.to_concrete value in + match concrete with + | Expression_desc.Pexp_setinstvar (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let esetinstvar'const view value = + let parent_concrete = Expression.to_concrete value in + let desc = parent_concrete.Expression.pexp_desc in + let concrete = Expression_desc.to_concrete desc in + match concrete with + | Expression_desc.Pexp_setinstvar (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let pexp_override'const view value = + let concrete = Expression_desc.to_concrete value in + match concrete with + | Expression_desc.Pexp_override arg -> view arg + | _ -> View.error + +let eoverride'const view value = + let parent_concrete = Expression.to_concrete value in + let desc = parent_concrete.Expression.pexp_desc in + let concrete = Expression_desc.to_concrete desc in + match concrete with + | Expression_desc.Pexp_override arg -> view arg + | _ -> View.error + +let pexp_letmodule'const view value = + let concrete = Expression_desc.to_concrete value in + match concrete with + | Expression_desc.Pexp_letmodule (arg0, arg1, arg2) -> view (arg0, arg1, arg2) + | _ -> View.error + +let eletmodule'const view value = + let parent_concrete = Expression.to_concrete value in + let desc = parent_concrete.Expression.pexp_desc in + let concrete = Expression_desc.to_concrete desc in + match concrete with + | Expression_desc.Pexp_letmodule (arg0, arg1, arg2) -> view (arg0, arg1, arg2) + | _ -> View.error + +let pexp_letexception'const view value = + let concrete = Expression_desc.to_concrete value in + match concrete with + | Expression_desc.Pexp_letexception (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let eletexception'const view value = + let parent_concrete = Expression.to_concrete value in + let desc = parent_concrete.Expression.pexp_desc in + let concrete = Expression_desc.to_concrete desc in + match concrete with + | Expression_desc.Pexp_letexception (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let pexp_assert'const view value = + let concrete = Expression_desc.to_concrete value in + match concrete with + | Expression_desc.Pexp_assert arg -> view arg + | _ -> View.error + +let eassert'const view value = + let parent_concrete = Expression.to_concrete value in + let desc = parent_concrete.Expression.pexp_desc in + let concrete = Expression_desc.to_concrete desc in + match concrete with + | Expression_desc.Pexp_assert arg -> view arg + | _ -> View.error + +let pexp_lazy'const view value = + let concrete = Expression_desc.to_concrete value in + match concrete with + | Expression_desc.Pexp_lazy arg -> view arg + | _ -> View.error + +let elazy'const view value = + let parent_concrete = Expression.to_concrete value in + let desc = parent_concrete.Expression.pexp_desc in + let concrete = Expression_desc.to_concrete desc in + match concrete with + | Expression_desc.Pexp_lazy arg -> view arg + | _ -> View.error + +let pexp_poly'const view value = + let concrete = Expression_desc.to_concrete value in + match concrete with + | Expression_desc.Pexp_poly (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let epoly'const view value = + let parent_concrete = Expression.to_concrete value in + let desc = parent_concrete.Expression.pexp_desc in + let concrete = Expression_desc.to_concrete desc in + match concrete with + | Expression_desc.Pexp_poly (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let pexp_object'const view value = + let concrete = Expression_desc.to_concrete value in + match concrete with + | Expression_desc.Pexp_object arg -> view arg + | _ -> View.error + +let eobject'const view value = + let parent_concrete = Expression.to_concrete value in + let desc = parent_concrete.Expression.pexp_desc in + let concrete = Expression_desc.to_concrete desc in + match concrete with + | Expression_desc.Pexp_object arg -> view arg + | _ -> View.error + +let pexp_newtype'const view value = + let concrete = Expression_desc.to_concrete value in + match concrete with + | Expression_desc.Pexp_newtype (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let enewtype'const view value = + let parent_concrete = Expression.to_concrete value in + let desc = parent_concrete.Expression.pexp_desc in + let concrete = Expression_desc.to_concrete desc in + match concrete with + | Expression_desc.Pexp_newtype (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let pexp_pack'const view value = + let concrete = Expression_desc.to_concrete value in + match concrete with + | Expression_desc.Pexp_pack arg -> view arg + | _ -> View.error + +let epack'const view value = + let parent_concrete = Expression.to_concrete value in + let desc = parent_concrete.Expression.pexp_desc in + let concrete = Expression_desc.to_concrete desc in + match concrete with + | Expression_desc.Pexp_pack arg -> view arg + | _ -> View.error + +let pexp_open'const view value = + let concrete = Expression_desc.to_concrete value in + match concrete with + | Expression_desc.Pexp_open (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let eopen'const view value = + let parent_concrete = Expression.to_concrete value in + let desc = parent_concrete.Expression.pexp_desc in + let concrete = Expression_desc.to_concrete desc in + match concrete with + | Expression_desc.Pexp_open (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let pexp_letop'const view value = + let concrete = Expression_desc.to_concrete value in + match concrete with + | Expression_desc.Pexp_letop arg -> view arg + | _ -> View.error + +let eletop'const view value = + let parent_concrete = Expression.to_concrete value in + let desc = parent_concrete.Expression.pexp_desc in + let concrete = Expression_desc.to_concrete desc in + match concrete with + | Expression_desc.Pexp_letop arg -> view arg + | _ -> View.error + +let pexp_extension'const view value = + let concrete = Expression_desc.to_concrete value in + match concrete with + | Expression_desc.Pexp_extension arg -> view arg + | _ -> View.error + +let eextension'const view value = + let parent_concrete = Expression.to_concrete value in + let desc = parent_concrete.Expression.pexp_desc in + let concrete = Expression_desc.to_concrete desc in + match concrete with + | Expression_desc.Pexp_extension arg -> view arg + | _ -> View.error + +let pexp_unreachable'const value = + let concrete = Expression_desc.to_concrete value in + match concrete with + | Expression_desc.Pexp_unreachable -> View.ok + | _ -> View.error + +let eunreachable'const value = + let parent_concrete = Expression.to_concrete value in + let desc = parent_concrete.Expression.pexp_desc in + let concrete = Expression_desc.to_concrete desc in + match concrete with + | Expression_desc.Pexp_unreachable -> View.ok + | _ -> View.error + +let pc_lhs'match view value = + let concrete = Case.to_concrete value in + view concrete.Case.pc_lhs + +let pc_guard'match view value = + let concrete = Case.to_concrete value in + view concrete.Case.pc_guard + +let pc_rhs'match view value = + let concrete = Case.to_concrete value in + view concrete.Case.pc_rhs + +let let_'match view value = + let concrete = Letop.to_concrete value in + view concrete.Letop.let_ + +let ands'match view value = + let concrete = Letop.to_concrete value in + view concrete.Letop.ands + +let body'match view value = + let concrete = Letop.to_concrete value in + view concrete.Letop.body + +let pbop_op'match view value = + let concrete = Binding_op.to_concrete value in + view concrete.Binding_op.pbop_op + +let pbop_pat'match view value = + let concrete = Binding_op.to_concrete value in + view concrete.Binding_op.pbop_pat + +let pbop_exp'match view value = + let concrete = Binding_op.to_concrete value in + view concrete.Binding_op.pbop_exp + +let pbop_loc'match view value = + let concrete = Binding_op.to_concrete value in + view concrete.Binding_op.pbop_loc + +let pval_name'match view value = + let concrete = Value_description.to_concrete value in + view concrete.Value_description.pval_name + +let pval_type'match view value = + let concrete = Value_description.to_concrete value in + view concrete.Value_description.pval_type + +let pval_prim'match view value = + let concrete = Value_description.to_concrete value in + view concrete.Value_description.pval_prim + +let pval_attributes'match view value = + let concrete = Value_description.to_concrete value in + view concrete.Value_description.pval_attributes + +let pval_loc'match view value = + let concrete = Value_description.to_concrete value in + view concrete.Value_description.pval_loc + +let ptype_name'match view value = + let concrete = Type_declaration.to_concrete value in + view concrete.Type_declaration.ptype_name + +let ptype_params'match view value = + let concrete = Type_declaration.to_concrete value in + view concrete.Type_declaration.ptype_params + +let ptype_cstrs'match view value = + let concrete = Type_declaration.to_concrete value in + view concrete.Type_declaration.ptype_cstrs + +let ptype_kind'match view value = + let concrete = Type_declaration.to_concrete value in + view concrete.Type_declaration.ptype_kind + +let ptype_private'match view value = + let concrete = Type_declaration.to_concrete value in + view concrete.Type_declaration.ptype_private + +let ptype_manifest'match view value = + let concrete = Type_declaration.to_concrete value in + view concrete.Type_declaration.ptype_manifest + +let ptype_attributes'match view value = + let concrete = Type_declaration.to_concrete value in + view concrete.Type_declaration.ptype_attributes + +let ptype_loc'match view value = + let concrete = Type_declaration.to_concrete value in + view concrete.Type_declaration.ptype_loc + +let ptype_abstract'const value = + let concrete = Type_kind.to_concrete value in + match concrete with + | Type_kind.Ptype_abstract -> View.ok + | _ -> View.error + +let ptype_variant'const view value = + let concrete = Type_kind.to_concrete value in + match concrete with + | Type_kind.Ptype_variant arg -> view arg + | _ -> View.error + +let ptype_record'const view value = + let concrete = Type_kind.to_concrete value in + match concrete with + | Type_kind.Ptype_record arg -> view arg + | _ -> View.error + +let ptype_open'const value = + let concrete = Type_kind.to_concrete value in + match concrete with + | Type_kind.Ptype_open -> View.ok + | _ -> View.error + +let pld_name'match view value = + let concrete = Label_declaration.to_concrete value in + view concrete.Label_declaration.pld_name + +let pld_mutable'match view value = + let concrete = Label_declaration.to_concrete value in + view concrete.Label_declaration.pld_mutable + +let pld_type'match view value = + let concrete = Label_declaration.to_concrete value in + view concrete.Label_declaration.pld_type + +let pld_loc'match view value = + let concrete = Label_declaration.to_concrete value in + view concrete.Label_declaration.pld_loc + +let pld_attributes'match view value = + let concrete = Label_declaration.to_concrete value in + view concrete.Label_declaration.pld_attributes + +let pcd_name'match view value = + let concrete = Constructor_declaration.to_concrete value in + view concrete.Constructor_declaration.pcd_name + +let pcd_args'match view value = + let concrete = Constructor_declaration.to_concrete value in + view concrete.Constructor_declaration.pcd_args + +let pcd_res'match view value = + let concrete = Constructor_declaration.to_concrete value in + view concrete.Constructor_declaration.pcd_res + +let pcd_loc'match view value = + let concrete = Constructor_declaration.to_concrete value in + view concrete.Constructor_declaration.pcd_loc + +let pcd_attributes'match view value = + let concrete = Constructor_declaration.to_concrete value in + view concrete.Constructor_declaration.pcd_attributes + +let pcstr_tuple'const view value = + let concrete = Constructor_arguments.to_concrete value in + match concrete with + | Constructor_arguments.Pcstr_tuple arg -> view arg + | _ -> View.error + +let pcstr_record'const view value = + let concrete = Constructor_arguments.to_concrete value in + match concrete with + | Constructor_arguments.Pcstr_record arg -> view arg + | _ -> View.error + +let ptyext_path'match view value = + let concrete = Type_extension.to_concrete value in + view concrete.Type_extension.ptyext_path + +let ptyext_params'match view value = + let concrete = Type_extension.to_concrete value in + view concrete.Type_extension.ptyext_params + +let ptyext_constructors'match view value = + let concrete = Type_extension.to_concrete value in + view concrete.Type_extension.ptyext_constructors + +let ptyext_private'match view value = + let concrete = Type_extension.to_concrete value in + view concrete.Type_extension.ptyext_private + +let ptyext_loc'match view value = + let concrete = Type_extension.to_concrete value in + view concrete.Type_extension.ptyext_loc + +let ptyext_attributes'match view value = + let concrete = Type_extension.to_concrete value in + view concrete.Type_extension.ptyext_attributes + +let pext_name'match view value = + let concrete = Extension_constructor.to_concrete value in + view concrete.Extension_constructor.pext_name + +let pext_kind'match view value = + let concrete = Extension_constructor.to_concrete value in + view concrete.Extension_constructor.pext_kind + +let pext_loc'match view value = + let concrete = Extension_constructor.to_concrete value in + view concrete.Extension_constructor.pext_loc + +let pext_attributes'match view value = + let concrete = Extension_constructor.to_concrete value in + view concrete.Extension_constructor.pext_attributes + +let ptyexn_constructor'match view value = + let concrete = Type_exception.to_concrete value in + view concrete.Type_exception.ptyexn_constructor + +let ptyexn_loc'match view value = + let concrete = Type_exception.to_concrete value in + view concrete.Type_exception.ptyexn_loc + +let ptyexn_attributes'match view value = + let concrete = Type_exception.to_concrete value in + view concrete.Type_exception.ptyexn_attributes + +let pext_decl'const view value = + let concrete = Extension_constructor_kind.to_concrete value in + match concrete with + | Extension_constructor_kind.Pext_decl (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let pext_rebind'const view value = + let concrete = Extension_constructor_kind.to_concrete value in + match concrete with + | Extension_constructor_kind.Pext_rebind arg -> view arg + | _ -> View.error + +let pcty_desc'match view value = + let concrete = Class_type.to_concrete value in + view concrete.Class_type.pcty_desc + +let pcty_loc'match view value = + let concrete = Class_type.to_concrete value in + view concrete.Class_type.pcty_loc + +let pcty_attributes'match view value = + let concrete = Class_type.to_concrete value in + view concrete.Class_type.pcty_attributes + +let pcty_constr'const view value = + let concrete = Class_type_desc.to_concrete value in + match concrete with + | Class_type_desc.Pcty_constr (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let ctconstr'const view value = + let parent_concrete = Class_type.to_concrete value in + let desc = parent_concrete.Class_type.pcty_desc in + let concrete = Class_type_desc.to_concrete desc in + match concrete with + | Class_type_desc.Pcty_constr (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let pcty_signature'const view value = + let concrete = Class_type_desc.to_concrete value in + match concrete with + | Class_type_desc.Pcty_signature arg -> view arg + | _ -> View.error + +let ctsignature'const view value = + let parent_concrete = Class_type.to_concrete value in + let desc = parent_concrete.Class_type.pcty_desc in + let concrete = Class_type_desc.to_concrete desc in + match concrete with + | Class_type_desc.Pcty_signature arg -> view arg + | _ -> View.error + +let pcty_arrow'const view value = + let concrete = Class_type_desc.to_concrete value in + match concrete with + | Class_type_desc.Pcty_arrow (arg0, arg1, arg2) -> view (arg0, arg1, arg2) + | _ -> View.error + +let ctarrow'const view value = + let parent_concrete = Class_type.to_concrete value in + let desc = parent_concrete.Class_type.pcty_desc in + let concrete = Class_type_desc.to_concrete desc in + match concrete with + | Class_type_desc.Pcty_arrow (arg0, arg1, arg2) -> view (arg0, arg1, arg2) + | _ -> View.error + +let pcty_extension'const view value = + let concrete = Class_type_desc.to_concrete value in + match concrete with + | Class_type_desc.Pcty_extension arg -> view arg + | _ -> View.error + +let ctextension'const view value = + let parent_concrete = Class_type.to_concrete value in + let desc = parent_concrete.Class_type.pcty_desc in + let concrete = Class_type_desc.to_concrete desc in + match concrete with + | Class_type_desc.Pcty_extension arg -> view arg + | _ -> View.error + +let pcty_open'const view value = + let concrete = Class_type_desc.to_concrete value in + match concrete with + | Class_type_desc.Pcty_open (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let ctopen'const view value = + let parent_concrete = Class_type.to_concrete value in + let desc = parent_concrete.Class_type.pcty_desc in + let concrete = Class_type_desc.to_concrete desc in + match concrete with + | Class_type_desc.Pcty_open (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let pcsig_self'match view value = + let concrete = Class_signature.to_concrete value in + view concrete.Class_signature.pcsig_self + +let pcsig_fields'match view value = + let concrete = Class_signature.to_concrete value in + view concrete.Class_signature.pcsig_fields + +let pctf_desc'match view value = + let concrete = Class_type_field.to_concrete value in + view concrete.Class_type_field.pctf_desc + +let pctf_loc'match view value = + let concrete = Class_type_field.to_concrete value in + view concrete.Class_type_field.pctf_loc + +let pctf_attributes'match view value = + let concrete = Class_type_field.to_concrete value in + view concrete.Class_type_field.pctf_attributes + +let pctf_inherit'const view value = + let concrete = Class_type_field_desc.to_concrete value in + match concrete with + | Class_type_field_desc.Pctf_inherit arg -> view arg + | _ -> View.error + +let ctfinherit'const view value = + let parent_concrete = Class_type_field.to_concrete value in + let desc = parent_concrete.Class_type_field.pctf_desc in + let concrete = Class_type_field_desc.to_concrete desc in + match concrete with + | Class_type_field_desc.Pctf_inherit arg -> view arg + | _ -> View.error + +let pctf_val'const view value = + let concrete = Class_type_field_desc.to_concrete value in + match concrete with + | Class_type_field_desc.Pctf_val arg -> view arg + | _ -> View.error + +let ctfval'const view value = + let parent_concrete = Class_type_field.to_concrete value in + let desc = parent_concrete.Class_type_field.pctf_desc in + let concrete = Class_type_field_desc.to_concrete desc in + match concrete with + | Class_type_field_desc.Pctf_val arg -> view arg + | _ -> View.error + +let pctf_method'const view value = + let concrete = Class_type_field_desc.to_concrete value in + match concrete with + | Class_type_field_desc.Pctf_method arg -> view arg + | _ -> View.error + +let ctfmethod'const view value = + let parent_concrete = Class_type_field.to_concrete value in + let desc = parent_concrete.Class_type_field.pctf_desc in + let concrete = Class_type_field_desc.to_concrete desc in + match concrete with + | Class_type_field_desc.Pctf_method arg -> view arg + | _ -> View.error + +let pctf_constraint'const view value = + let concrete = Class_type_field_desc.to_concrete value in + match concrete with + | Class_type_field_desc.Pctf_constraint arg -> view arg + | _ -> View.error + +let ctfconstraint'const view value = + let parent_concrete = Class_type_field.to_concrete value in + let desc = parent_concrete.Class_type_field.pctf_desc in + let concrete = Class_type_field_desc.to_concrete desc in + match concrete with + | Class_type_field_desc.Pctf_constraint arg -> view arg + | _ -> View.error + +let pctf_attribute'const view value = + let concrete = Class_type_field_desc.to_concrete value in + match concrete with + | Class_type_field_desc.Pctf_attribute arg -> view arg + | _ -> View.error + +let ctfattribute'const view value = + let parent_concrete = Class_type_field.to_concrete value in + let desc = parent_concrete.Class_type_field.pctf_desc in + let concrete = Class_type_field_desc.to_concrete desc in + match concrete with + | Class_type_field_desc.Pctf_attribute arg -> view arg + | _ -> View.error + +let pctf_extension'const view value = + let concrete = Class_type_field_desc.to_concrete value in + match concrete with + | Class_type_field_desc.Pctf_extension arg -> view arg + | _ -> View.error + +let ctfextension'const view value = + let parent_concrete = Class_type_field.to_concrete value in + let desc = parent_concrete.Class_type_field.pctf_desc in + let concrete = Class_type_field_desc.to_concrete desc in + match concrete with + | Class_type_field_desc.Pctf_extension arg -> view arg + | _ -> View.error + +let pci_virt'match view value = + let concrete = Class_infos.to_concrete value in + view concrete.Class_infos.pci_virt + +let pci_params'match view value = + let concrete = Class_infos.to_concrete value in + view concrete.Class_infos.pci_params + +let pci_name'match view value = + let concrete = Class_infos.to_concrete value in + view concrete.Class_infos.pci_name + +let pci_expr'match view value = + let concrete = Class_infos.to_concrete value in + view concrete.Class_infos.pci_expr + +let pci_loc'match view value = + let concrete = Class_infos.to_concrete value in + view concrete.Class_infos.pci_loc + +let pci_attributes'match view value = + let concrete = Class_infos.to_concrete value in + view concrete.Class_infos.pci_attributes + +let class_description'const view value = + let concrete0 = Class_description.to_concrete value in + view concrete0 + +let class_type_declaration'const view value = + let concrete0 = Class_type_declaration.to_concrete value in + view concrete0 + +let pcl_desc'match view value = + let concrete = Class_expr.to_concrete value in + view concrete.Class_expr.pcl_desc + +let pcl_loc'match view value = + let concrete = Class_expr.to_concrete value in + view concrete.Class_expr.pcl_loc + +let pcl_attributes'match view value = + let concrete = Class_expr.to_concrete value in + view concrete.Class_expr.pcl_attributes + +let pcl_constr'const view value = + let concrete = Class_expr_desc.to_concrete value in + match concrete with + | Class_expr_desc.Pcl_constr (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let ceconstr'const view value = + let parent_concrete = Class_expr.to_concrete value in + let desc = parent_concrete.Class_expr.pcl_desc in + let concrete = Class_expr_desc.to_concrete desc in + match concrete with + | Class_expr_desc.Pcl_constr (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let pcl_structure'const view value = + let concrete = Class_expr_desc.to_concrete value in + match concrete with + | Class_expr_desc.Pcl_structure arg -> view arg + | _ -> View.error + +let cestructure'const view value = + let parent_concrete = Class_expr.to_concrete value in + let desc = parent_concrete.Class_expr.pcl_desc in + let concrete = Class_expr_desc.to_concrete desc in + match concrete with + | Class_expr_desc.Pcl_structure arg -> view arg + | _ -> View.error + +let pcl_fun'const view value = + let concrete = Class_expr_desc.to_concrete value in + match concrete with + | Class_expr_desc.Pcl_fun (arg0, arg1, arg2, arg3) -> view (arg0, arg1, arg2, arg3) + | _ -> View.error + +let cefun'const view value = + let parent_concrete = Class_expr.to_concrete value in + let desc = parent_concrete.Class_expr.pcl_desc in + let concrete = Class_expr_desc.to_concrete desc in + match concrete with + | Class_expr_desc.Pcl_fun (arg0, arg1, arg2, arg3) -> view (arg0, arg1, arg2, arg3) + | _ -> View.error + +let pcl_apply'const view value = + let concrete = Class_expr_desc.to_concrete value in + match concrete with + | Class_expr_desc.Pcl_apply (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let ceapply'const view value = + let parent_concrete = Class_expr.to_concrete value in + let desc = parent_concrete.Class_expr.pcl_desc in + let concrete = Class_expr_desc.to_concrete desc in + match concrete with + | Class_expr_desc.Pcl_apply (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let pcl_let'const view value = + let concrete = Class_expr_desc.to_concrete value in + match concrete with + | Class_expr_desc.Pcl_let (arg0, arg1, arg2) -> view (arg0, arg1, arg2) + | _ -> View.error + +let celet'const view value = + let parent_concrete = Class_expr.to_concrete value in + let desc = parent_concrete.Class_expr.pcl_desc in + let concrete = Class_expr_desc.to_concrete desc in + match concrete with + | Class_expr_desc.Pcl_let (arg0, arg1, arg2) -> view (arg0, arg1, arg2) + | _ -> View.error + +let pcl_constraint'const view value = + let concrete = Class_expr_desc.to_concrete value in + match concrete with + | Class_expr_desc.Pcl_constraint (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let ceconstraint'const view value = + let parent_concrete = Class_expr.to_concrete value in + let desc = parent_concrete.Class_expr.pcl_desc in + let concrete = Class_expr_desc.to_concrete desc in + match concrete with + | Class_expr_desc.Pcl_constraint (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let pcl_extension'const view value = + let concrete = Class_expr_desc.to_concrete value in + match concrete with + | Class_expr_desc.Pcl_extension arg -> view arg + | _ -> View.error + +let ceextension'const view value = + let parent_concrete = Class_expr.to_concrete value in + let desc = parent_concrete.Class_expr.pcl_desc in + let concrete = Class_expr_desc.to_concrete desc in + match concrete with + | Class_expr_desc.Pcl_extension arg -> view arg + | _ -> View.error + +let pcl_open'const view value = + let concrete = Class_expr_desc.to_concrete value in + match concrete with + | Class_expr_desc.Pcl_open (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let ceopen'const view value = + let parent_concrete = Class_expr.to_concrete value in + let desc = parent_concrete.Class_expr.pcl_desc in + let concrete = Class_expr_desc.to_concrete desc in + match concrete with + | Class_expr_desc.Pcl_open (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let pcstr_self'match view value = + let concrete = Class_structure.to_concrete value in + view concrete.Class_structure.pcstr_self + +let pcstr_fields'match view value = + let concrete = Class_structure.to_concrete value in + view concrete.Class_structure.pcstr_fields + +let pcf_desc'match view value = + let concrete = Class_field.to_concrete value in + view concrete.Class_field.pcf_desc + +let pcf_loc'match view value = + let concrete = Class_field.to_concrete value in + view concrete.Class_field.pcf_loc + +let pcf_attributes'match view value = + let concrete = Class_field.to_concrete value in + view concrete.Class_field.pcf_attributes + +let pcf_inherit'const view value = + let concrete = Class_field_desc.to_concrete value in + match concrete with + | Class_field_desc.Pcf_inherit (arg0, arg1, arg2) -> view (arg0, arg1, arg2) + | _ -> View.error + +let cfinherit'const view value = + let parent_concrete = Class_field.to_concrete value in + let desc = parent_concrete.Class_field.pcf_desc in + let concrete = Class_field_desc.to_concrete desc in + match concrete with + | Class_field_desc.Pcf_inherit (arg0, arg1, arg2) -> view (arg0, arg1, arg2) + | _ -> View.error + +let pcf_val'const view value = + let concrete = Class_field_desc.to_concrete value in + match concrete with + | Class_field_desc.Pcf_val arg -> view arg + | _ -> View.error + +let cfval'const view value = + let parent_concrete = Class_field.to_concrete value in + let desc = parent_concrete.Class_field.pcf_desc in + let concrete = Class_field_desc.to_concrete desc in + match concrete with + | Class_field_desc.Pcf_val arg -> view arg + | _ -> View.error + +let pcf_method'const view value = + let concrete = Class_field_desc.to_concrete value in + match concrete with + | Class_field_desc.Pcf_method arg -> view arg + | _ -> View.error + +let cfmethod'const view value = + let parent_concrete = Class_field.to_concrete value in + let desc = parent_concrete.Class_field.pcf_desc in + let concrete = Class_field_desc.to_concrete desc in + match concrete with + | Class_field_desc.Pcf_method arg -> view arg + | _ -> View.error + +let pcf_constraint'const view value = + let concrete = Class_field_desc.to_concrete value in + match concrete with + | Class_field_desc.Pcf_constraint arg -> view arg + | _ -> View.error + +let cfconstraint'const view value = + let parent_concrete = Class_field.to_concrete value in + let desc = parent_concrete.Class_field.pcf_desc in + let concrete = Class_field_desc.to_concrete desc in + match concrete with + | Class_field_desc.Pcf_constraint arg -> view arg + | _ -> View.error + +let pcf_initializer'const view value = + let concrete = Class_field_desc.to_concrete value in + match concrete with + | Class_field_desc.Pcf_initializer arg -> view arg + | _ -> View.error + +let cfinitializer'const view value = + let parent_concrete = Class_field.to_concrete value in + let desc = parent_concrete.Class_field.pcf_desc in + let concrete = Class_field_desc.to_concrete desc in + match concrete with + | Class_field_desc.Pcf_initializer arg -> view arg + | _ -> View.error + +let pcf_attribute'const view value = + let concrete = Class_field_desc.to_concrete value in + match concrete with + | Class_field_desc.Pcf_attribute arg -> view arg + | _ -> View.error + +let cfattribute'const view value = + let parent_concrete = Class_field.to_concrete value in + let desc = parent_concrete.Class_field.pcf_desc in + let concrete = Class_field_desc.to_concrete desc in + match concrete with + | Class_field_desc.Pcf_attribute arg -> view arg + | _ -> View.error + +let pcf_extension'const view value = + let concrete = Class_field_desc.to_concrete value in + match concrete with + | Class_field_desc.Pcf_extension arg -> view arg + | _ -> View.error + +let cfextension'const view value = + let parent_concrete = Class_field.to_concrete value in + let desc = parent_concrete.Class_field.pcf_desc in + let concrete = Class_field_desc.to_concrete desc in + match concrete with + | Class_field_desc.Pcf_extension arg -> view arg + | _ -> View.error + +let cfk_virtual'const view value = + let concrete = Class_field_kind.to_concrete value in + match concrete with + | Class_field_kind.Cfk_virtual arg -> view arg + | _ -> View.error + +let cfk_concrete'const view value = + let concrete = Class_field_kind.to_concrete value in + match concrete with + | Class_field_kind.Cfk_concrete (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let class_declaration'const view value = + let concrete0 = Class_declaration.to_concrete value in + view concrete0 + +let pmty_desc'match view value = + let concrete = Module_type.to_concrete value in + view concrete.Module_type.pmty_desc + +let pmty_loc'match view value = + let concrete = Module_type.to_concrete value in + view concrete.Module_type.pmty_loc + +let pmty_attributes'match view value = + let concrete = Module_type.to_concrete value in + view concrete.Module_type.pmty_attributes + +let pmty_ident'const view value = + let concrete = Module_type_desc.to_concrete value in + match concrete with + | Module_type_desc.Pmty_ident arg -> view arg + | _ -> View.error + +let mtident'const view value = + let parent_concrete = Module_type.to_concrete value in + let desc = parent_concrete.Module_type.pmty_desc in + let concrete = Module_type_desc.to_concrete desc in + match concrete with + | Module_type_desc.Pmty_ident arg -> view arg + | _ -> View.error + +let pmty_signature'const view value = + let concrete = Module_type_desc.to_concrete value in + match concrete with + | Module_type_desc.Pmty_signature arg -> view arg + | _ -> View.error + +let mtsignature'const view value = + let parent_concrete = Module_type.to_concrete value in + let desc = parent_concrete.Module_type.pmty_desc in + let concrete = Module_type_desc.to_concrete desc in + match concrete with + | Module_type_desc.Pmty_signature arg -> view arg + | _ -> View.error + +let pmty_functor'const view value = + let concrete = Module_type_desc.to_concrete value in + match concrete with + | Module_type_desc.Pmty_functor (arg0, arg1, arg2) -> view (arg0, arg1, arg2) + | _ -> View.error + +let mtfunctor'const view value = + let parent_concrete = Module_type.to_concrete value in + let desc = parent_concrete.Module_type.pmty_desc in + let concrete = Module_type_desc.to_concrete desc in + match concrete with + | Module_type_desc.Pmty_functor (arg0, arg1, arg2) -> view (arg0, arg1, arg2) + | _ -> View.error + +let pmty_with'const view value = + let concrete = Module_type_desc.to_concrete value in + match concrete with + | Module_type_desc.Pmty_with (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let mtwith'const view value = + let parent_concrete = Module_type.to_concrete value in + let desc = parent_concrete.Module_type.pmty_desc in + let concrete = Module_type_desc.to_concrete desc in + match concrete with + | Module_type_desc.Pmty_with (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let pmty_typeof'const view value = + let concrete = Module_type_desc.to_concrete value in + match concrete with + | Module_type_desc.Pmty_typeof arg -> view arg + | _ -> View.error + +let mttypeof'const view value = + let parent_concrete = Module_type.to_concrete value in + let desc = parent_concrete.Module_type.pmty_desc in + let concrete = Module_type_desc.to_concrete desc in + match concrete with + | Module_type_desc.Pmty_typeof arg -> view arg + | _ -> View.error + +let pmty_extension'const view value = + let concrete = Module_type_desc.to_concrete value in + match concrete with + | Module_type_desc.Pmty_extension arg -> view arg + | _ -> View.error + +let mtextension'const view value = + let parent_concrete = Module_type.to_concrete value in + let desc = parent_concrete.Module_type.pmty_desc in + let concrete = Module_type_desc.to_concrete desc in + match concrete with + | Module_type_desc.Pmty_extension arg -> view arg + | _ -> View.error + +let pmty_alias'const view value = + let concrete = Module_type_desc.to_concrete value in + match concrete with + | Module_type_desc.Pmty_alias arg -> view arg + | _ -> View.error + +let mtalias'const view value = + let parent_concrete = Module_type.to_concrete value in + let desc = parent_concrete.Module_type.pmty_desc in + let concrete = Module_type_desc.to_concrete desc in + match concrete with + | Module_type_desc.Pmty_alias arg -> view arg + | _ -> View.error + +let signature'const view value = + let concrete0 = Signature.to_concrete value in + view concrete0 + +let psig_desc'match view value = + let concrete = Signature_item.to_concrete value in + view concrete.Signature_item.psig_desc + +let psig_loc'match view value = + let concrete = Signature_item.to_concrete value in + view concrete.Signature_item.psig_loc + +let psig_value'const view value = + let concrete = Signature_item_desc.to_concrete value in + match concrete with + | Signature_item_desc.Psig_value arg -> view arg + | _ -> View.error + +let sigvalue'const view value = + let parent_concrete = Signature_item.to_concrete value in + let desc = parent_concrete.Signature_item.psig_desc in + let concrete = Signature_item_desc.to_concrete desc in + match concrete with + | Signature_item_desc.Psig_value arg -> view arg + | _ -> View.error + +let psig_type'const view value = + let concrete = Signature_item_desc.to_concrete value in + match concrete with + | Signature_item_desc.Psig_type (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let sigtype'const view value = + let parent_concrete = Signature_item.to_concrete value in + let desc = parent_concrete.Signature_item.psig_desc in + let concrete = Signature_item_desc.to_concrete desc in + match concrete with + | Signature_item_desc.Psig_type (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let psig_typesubst'const view value = + let concrete = Signature_item_desc.to_concrete value in + match concrete with + | Signature_item_desc.Psig_typesubst arg -> view arg + | _ -> View.error + +let sigtypesubst'const view value = + let parent_concrete = Signature_item.to_concrete value in + let desc = parent_concrete.Signature_item.psig_desc in + let concrete = Signature_item_desc.to_concrete desc in + match concrete with + | Signature_item_desc.Psig_typesubst arg -> view arg + | _ -> View.error + +let psig_typext'const view value = + let concrete = Signature_item_desc.to_concrete value in + match concrete with + | Signature_item_desc.Psig_typext arg -> view arg + | _ -> View.error + +let sigtypext'const view value = + let parent_concrete = Signature_item.to_concrete value in + let desc = parent_concrete.Signature_item.psig_desc in + let concrete = Signature_item_desc.to_concrete desc in + match concrete with + | Signature_item_desc.Psig_typext arg -> view arg + | _ -> View.error + +let psig_exception'const view value = + let concrete = Signature_item_desc.to_concrete value in + match concrete with + | Signature_item_desc.Psig_exception arg -> view arg + | _ -> View.error + +let sigexception'const view value = + let parent_concrete = Signature_item.to_concrete value in + let desc = parent_concrete.Signature_item.psig_desc in + let concrete = Signature_item_desc.to_concrete desc in + match concrete with + | Signature_item_desc.Psig_exception arg -> view arg + | _ -> View.error + +let psig_module'const view value = + let concrete = Signature_item_desc.to_concrete value in + match concrete with + | Signature_item_desc.Psig_module arg -> view arg + | _ -> View.error + +let sigmodule'const view value = + let parent_concrete = Signature_item.to_concrete value in + let desc = parent_concrete.Signature_item.psig_desc in + let concrete = Signature_item_desc.to_concrete desc in + match concrete with + | Signature_item_desc.Psig_module arg -> view arg + | _ -> View.error + +let psig_modsubst'const view value = + let concrete = Signature_item_desc.to_concrete value in + match concrete with + | Signature_item_desc.Psig_modsubst arg -> view arg + | _ -> View.error + +let sigmodsubst'const view value = + let parent_concrete = Signature_item.to_concrete value in + let desc = parent_concrete.Signature_item.psig_desc in + let concrete = Signature_item_desc.to_concrete desc in + match concrete with + | Signature_item_desc.Psig_modsubst arg -> view arg + | _ -> View.error + +let psig_recmodule'const view value = + let concrete = Signature_item_desc.to_concrete value in + match concrete with + | Signature_item_desc.Psig_recmodule arg -> view arg + | _ -> View.error + +let sigrecmodule'const view value = + let parent_concrete = Signature_item.to_concrete value in + let desc = parent_concrete.Signature_item.psig_desc in + let concrete = Signature_item_desc.to_concrete desc in + match concrete with + | Signature_item_desc.Psig_recmodule arg -> view arg + | _ -> View.error + +let psig_modtype'const view value = + let concrete = Signature_item_desc.to_concrete value in + match concrete with + | Signature_item_desc.Psig_modtype arg -> view arg + | _ -> View.error + +let sigmodtype'const view value = + let parent_concrete = Signature_item.to_concrete value in + let desc = parent_concrete.Signature_item.psig_desc in + let concrete = Signature_item_desc.to_concrete desc in + match concrete with + | Signature_item_desc.Psig_modtype arg -> view arg + | _ -> View.error + +let psig_open'const view value = + let concrete = Signature_item_desc.to_concrete value in + match concrete with + | Signature_item_desc.Psig_open arg -> view arg + | _ -> View.error + +let sigopen'const view value = + let parent_concrete = Signature_item.to_concrete value in + let desc = parent_concrete.Signature_item.psig_desc in + let concrete = Signature_item_desc.to_concrete desc in + match concrete with + | Signature_item_desc.Psig_open arg -> view arg + | _ -> View.error + +let psig_include'const view value = + let concrete = Signature_item_desc.to_concrete value in + match concrete with + | Signature_item_desc.Psig_include arg -> view arg + | _ -> View.error + +let siginclude'const view value = + let parent_concrete = Signature_item.to_concrete value in + let desc = parent_concrete.Signature_item.psig_desc in + let concrete = Signature_item_desc.to_concrete desc in + match concrete with + | Signature_item_desc.Psig_include arg -> view arg + | _ -> View.error + +let psig_class'const view value = + let concrete = Signature_item_desc.to_concrete value in + match concrete with + | Signature_item_desc.Psig_class arg -> view arg + | _ -> View.error + +let sigclass'const view value = + let parent_concrete = Signature_item.to_concrete value in + let desc = parent_concrete.Signature_item.psig_desc in + let concrete = Signature_item_desc.to_concrete desc in + match concrete with + | Signature_item_desc.Psig_class arg -> view arg + | _ -> View.error + +let psig_class_type'const view value = + let concrete = Signature_item_desc.to_concrete value in + match concrete with + | Signature_item_desc.Psig_class_type arg -> view arg + | _ -> View.error + +let sigclass_type'const view value = + let parent_concrete = Signature_item.to_concrete value in + let desc = parent_concrete.Signature_item.psig_desc in + let concrete = Signature_item_desc.to_concrete desc in + match concrete with + | Signature_item_desc.Psig_class_type arg -> view arg + | _ -> View.error + +let psig_attribute'const view value = + let concrete = Signature_item_desc.to_concrete value in + match concrete with + | Signature_item_desc.Psig_attribute arg -> view arg + | _ -> View.error + +let sigattribute'const view value = + let parent_concrete = Signature_item.to_concrete value in + let desc = parent_concrete.Signature_item.psig_desc in + let concrete = Signature_item_desc.to_concrete desc in + match concrete with + | Signature_item_desc.Psig_attribute arg -> view arg + | _ -> View.error + +let psig_extension'const view value = + let concrete = Signature_item_desc.to_concrete value in + match concrete with + | Signature_item_desc.Psig_extension (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let sigextension'const view value = + let parent_concrete = Signature_item.to_concrete value in + let desc = parent_concrete.Signature_item.psig_desc in + let concrete = Signature_item_desc.to_concrete desc in + match concrete with + | Signature_item_desc.Psig_extension (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let pmd_name'match view value = + let concrete = Module_declaration.to_concrete value in + view concrete.Module_declaration.pmd_name + +let pmd_type'match view value = + let concrete = Module_declaration.to_concrete value in + view concrete.Module_declaration.pmd_type + +let pmd_attributes'match view value = + let concrete = Module_declaration.to_concrete value in + view concrete.Module_declaration.pmd_attributes + +let pmd_loc'match view value = + let concrete = Module_declaration.to_concrete value in + view concrete.Module_declaration.pmd_loc + +let pms_name'match view value = + let concrete = Module_substitution.to_concrete value in + view concrete.Module_substitution.pms_name + +let pms_manifest'match view value = + let concrete = Module_substitution.to_concrete value in + view concrete.Module_substitution.pms_manifest + +let pms_attributes'match view value = + let concrete = Module_substitution.to_concrete value in + view concrete.Module_substitution.pms_attributes + +let pms_loc'match view value = + let concrete = Module_substitution.to_concrete value in + view concrete.Module_substitution.pms_loc + +let pmtd_name'match view value = + let concrete = Module_type_declaration.to_concrete value in + view concrete.Module_type_declaration.pmtd_name + +let pmtd_type'match view value = + let concrete = Module_type_declaration.to_concrete value in + view concrete.Module_type_declaration.pmtd_type + +let pmtd_attributes'match view value = + let concrete = Module_type_declaration.to_concrete value in + view concrete.Module_type_declaration.pmtd_attributes + +let pmtd_loc'match view value = + let concrete = Module_type_declaration.to_concrete value in + view concrete.Module_type_declaration.pmtd_loc + +let popen_expr'match view value = + let concrete = Open_infos.to_concrete value in + view concrete.Open_infos.popen_expr + +let popen_override'match view value = + let concrete = Open_infos.to_concrete value in + view concrete.Open_infos.popen_override + +let popen_loc'match view value = + let concrete = Open_infos.to_concrete value in + view concrete.Open_infos.popen_loc + +let popen_attributes'match view value = + let concrete = Open_infos.to_concrete value in + view concrete.Open_infos.popen_attributes + +let open_description'const view value = + let concrete0 = Open_description.to_concrete value in + view concrete0 + +let open_declaration'const view value = + let concrete0 = Open_declaration.to_concrete value in + view concrete0 + +let pincl_mod'match view value = + let concrete = Include_infos.to_concrete value in + view concrete.Include_infos.pincl_mod + +let pincl_loc'match view value = + let concrete = Include_infos.to_concrete value in + view concrete.Include_infos.pincl_loc + +let pincl_attributes'match view value = + let concrete = Include_infos.to_concrete value in + view concrete.Include_infos.pincl_attributes + +let include_description'const view value = + let concrete0 = Include_description.to_concrete value in + view concrete0 + +let include_declaration'const view value = + let concrete0 = Include_declaration.to_concrete value in + view concrete0 + +let pwith_type'const view value = + let concrete = With_constraint.to_concrete value in + match concrete with + | With_constraint.Pwith_type (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let pwith_module'const view value = + let concrete = With_constraint.to_concrete value in + match concrete with + | With_constraint.Pwith_module (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let pwith_typesubst'const view value = + let concrete = With_constraint.to_concrete value in + match concrete with + | With_constraint.Pwith_typesubst (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let pwith_modsubst'const view value = + let concrete = With_constraint.to_concrete value in + match concrete with + | With_constraint.Pwith_modsubst (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let pmod_desc'match view value = + let concrete = Module_expr.to_concrete value in + view concrete.Module_expr.pmod_desc + +let pmod_loc'match view value = + let concrete = Module_expr.to_concrete value in + view concrete.Module_expr.pmod_loc + +let pmod_attributes'match view value = + let concrete = Module_expr.to_concrete value in + view concrete.Module_expr.pmod_attributes + +let pmod_ident'const view value = + let concrete = Module_expr_desc.to_concrete value in + match concrete with + | Module_expr_desc.Pmod_ident arg -> view arg + | _ -> View.error + +let meident'const view value = + let parent_concrete = Module_expr.to_concrete value in + let desc = parent_concrete.Module_expr.pmod_desc in + let concrete = Module_expr_desc.to_concrete desc in + match concrete with + | Module_expr_desc.Pmod_ident arg -> view arg + | _ -> View.error + +let pmod_structure'const view value = + let concrete = Module_expr_desc.to_concrete value in + match concrete with + | Module_expr_desc.Pmod_structure arg -> view arg + | _ -> View.error + +let mestructure'const view value = + let parent_concrete = Module_expr.to_concrete value in + let desc = parent_concrete.Module_expr.pmod_desc in + let concrete = Module_expr_desc.to_concrete desc in + match concrete with + | Module_expr_desc.Pmod_structure arg -> view arg + | _ -> View.error + +let pmod_functor'const view value = + let concrete = Module_expr_desc.to_concrete value in + match concrete with + | Module_expr_desc.Pmod_functor (arg0, arg1, arg2) -> view (arg0, arg1, arg2) + | _ -> View.error + +let mefunctor'const view value = + let parent_concrete = Module_expr.to_concrete value in + let desc = parent_concrete.Module_expr.pmod_desc in + let concrete = Module_expr_desc.to_concrete desc in + match concrete with + | Module_expr_desc.Pmod_functor (arg0, arg1, arg2) -> view (arg0, arg1, arg2) + | _ -> View.error + +let pmod_apply'const view value = + let concrete = Module_expr_desc.to_concrete value in + match concrete with + | Module_expr_desc.Pmod_apply (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let meapply'const view value = + let parent_concrete = Module_expr.to_concrete value in + let desc = parent_concrete.Module_expr.pmod_desc in + let concrete = Module_expr_desc.to_concrete desc in + match concrete with + | Module_expr_desc.Pmod_apply (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let pmod_constraint'const view value = + let concrete = Module_expr_desc.to_concrete value in + match concrete with + | Module_expr_desc.Pmod_constraint (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let meconstraint'const view value = + let parent_concrete = Module_expr.to_concrete value in + let desc = parent_concrete.Module_expr.pmod_desc in + let concrete = Module_expr_desc.to_concrete desc in + match concrete with + | Module_expr_desc.Pmod_constraint (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let pmod_unpack'const view value = + let concrete = Module_expr_desc.to_concrete value in + match concrete with + | Module_expr_desc.Pmod_unpack arg -> view arg + | _ -> View.error + +let meunpack'const view value = + let parent_concrete = Module_expr.to_concrete value in + let desc = parent_concrete.Module_expr.pmod_desc in + let concrete = Module_expr_desc.to_concrete desc in + match concrete with + | Module_expr_desc.Pmod_unpack arg -> view arg + | _ -> View.error + +let pmod_extension'const view value = + let concrete = Module_expr_desc.to_concrete value in + match concrete with + | Module_expr_desc.Pmod_extension arg -> view arg + | _ -> View.error + +let meextension'const view value = + let parent_concrete = Module_expr.to_concrete value in + let desc = parent_concrete.Module_expr.pmod_desc in + let concrete = Module_expr_desc.to_concrete desc in + match concrete with + | Module_expr_desc.Pmod_extension arg -> view arg + | _ -> View.error + +let structure'const view value = + let concrete0 = Structure.to_concrete value in + view concrete0 + +let pstr_desc'match view value = + let concrete = Structure_item.to_concrete value in + view concrete.Structure_item.pstr_desc + +let pstr_loc'match view value = + let concrete = Structure_item.to_concrete value in + view concrete.Structure_item.pstr_loc + +let pstr_eval'const view value = + let concrete = Structure_item_desc.to_concrete value in + match concrete with + | Structure_item_desc.Pstr_eval (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let streval'const view value = + let parent_concrete = Structure_item.to_concrete value in + let desc = parent_concrete.Structure_item.pstr_desc in + let concrete = Structure_item_desc.to_concrete desc in + match concrete with + | Structure_item_desc.Pstr_eval (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let pstr_value'const view value = + let concrete = Structure_item_desc.to_concrete value in + match concrete with + | Structure_item_desc.Pstr_value (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let strvalue'const view value = + let parent_concrete = Structure_item.to_concrete value in + let desc = parent_concrete.Structure_item.pstr_desc in + let concrete = Structure_item_desc.to_concrete desc in + match concrete with + | Structure_item_desc.Pstr_value (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let pstr_primitive'const view value = + let concrete = Structure_item_desc.to_concrete value in + match concrete with + | Structure_item_desc.Pstr_primitive arg -> view arg + | _ -> View.error + +let strprimitive'const view value = + let parent_concrete = Structure_item.to_concrete value in + let desc = parent_concrete.Structure_item.pstr_desc in + let concrete = Structure_item_desc.to_concrete desc in + match concrete with + | Structure_item_desc.Pstr_primitive arg -> view arg + | _ -> View.error + +let pstr_type'const view value = + let concrete = Structure_item_desc.to_concrete value in + match concrete with + | Structure_item_desc.Pstr_type (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let strtype'const view value = + let parent_concrete = Structure_item.to_concrete value in + let desc = parent_concrete.Structure_item.pstr_desc in + let concrete = Structure_item_desc.to_concrete desc in + match concrete with + | Structure_item_desc.Pstr_type (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let pstr_typext'const view value = + let concrete = Structure_item_desc.to_concrete value in + match concrete with + | Structure_item_desc.Pstr_typext arg -> view arg + | _ -> View.error + +let strtypext'const view value = + let parent_concrete = Structure_item.to_concrete value in + let desc = parent_concrete.Structure_item.pstr_desc in + let concrete = Structure_item_desc.to_concrete desc in + match concrete with + | Structure_item_desc.Pstr_typext arg -> view arg + | _ -> View.error + +let pstr_exception'const view value = + let concrete = Structure_item_desc.to_concrete value in + match concrete with + | Structure_item_desc.Pstr_exception arg -> view arg + | _ -> View.error + +let strexception'const view value = + let parent_concrete = Structure_item.to_concrete value in + let desc = parent_concrete.Structure_item.pstr_desc in + let concrete = Structure_item_desc.to_concrete desc in + match concrete with + | Structure_item_desc.Pstr_exception arg -> view arg + | _ -> View.error + +let pstr_module'const view value = + let concrete = Structure_item_desc.to_concrete value in + match concrete with + | Structure_item_desc.Pstr_module arg -> view arg + | _ -> View.error + +let strmodule'const view value = + let parent_concrete = Structure_item.to_concrete value in + let desc = parent_concrete.Structure_item.pstr_desc in + let concrete = Structure_item_desc.to_concrete desc in + match concrete with + | Structure_item_desc.Pstr_module arg -> view arg + | _ -> View.error + +let pstr_recmodule'const view value = + let concrete = Structure_item_desc.to_concrete value in + match concrete with + | Structure_item_desc.Pstr_recmodule arg -> view arg + | _ -> View.error + +let strrecmodule'const view value = + let parent_concrete = Structure_item.to_concrete value in + let desc = parent_concrete.Structure_item.pstr_desc in + let concrete = Structure_item_desc.to_concrete desc in + match concrete with + | Structure_item_desc.Pstr_recmodule arg -> view arg + | _ -> View.error + +let pstr_modtype'const view value = + let concrete = Structure_item_desc.to_concrete value in + match concrete with + | Structure_item_desc.Pstr_modtype arg -> view arg + | _ -> View.error + +let strmodtype'const view value = + let parent_concrete = Structure_item.to_concrete value in + let desc = parent_concrete.Structure_item.pstr_desc in + let concrete = Structure_item_desc.to_concrete desc in + match concrete with + | Structure_item_desc.Pstr_modtype arg -> view arg + | _ -> View.error + +let pstr_open'const view value = + let concrete = Structure_item_desc.to_concrete value in + match concrete with + | Structure_item_desc.Pstr_open arg -> view arg + | _ -> View.error + +let stropen'const view value = + let parent_concrete = Structure_item.to_concrete value in + let desc = parent_concrete.Structure_item.pstr_desc in + let concrete = Structure_item_desc.to_concrete desc in + match concrete with + | Structure_item_desc.Pstr_open arg -> view arg + | _ -> View.error + +let pstr_class'const view value = + let concrete = Structure_item_desc.to_concrete value in + match concrete with + | Structure_item_desc.Pstr_class arg -> view arg + | _ -> View.error + +let strclass'const view value = + let parent_concrete = Structure_item.to_concrete value in + let desc = parent_concrete.Structure_item.pstr_desc in + let concrete = Structure_item_desc.to_concrete desc in + match concrete with + | Structure_item_desc.Pstr_class arg -> view arg + | _ -> View.error + +let pstr_class_type'const view value = + let concrete = Structure_item_desc.to_concrete value in + match concrete with + | Structure_item_desc.Pstr_class_type arg -> view arg + | _ -> View.error + +let strclass_type'const view value = + let parent_concrete = Structure_item.to_concrete value in + let desc = parent_concrete.Structure_item.pstr_desc in + let concrete = Structure_item_desc.to_concrete desc in + match concrete with + | Structure_item_desc.Pstr_class_type arg -> view arg + | _ -> View.error + +let pstr_include'const view value = + let concrete = Structure_item_desc.to_concrete value in + match concrete with + | Structure_item_desc.Pstr_include arg -> view arg + | _ -> View.error + +let strinclude'const view value = + let parent_concrete = Structure_item.to_concrete value in + let desc = parent_concrete.Structure_item.pstr_desc in + let concrete = Structure_item_desc.to_concrete desc in + match concrete with + | Structure_item_desc.Pstr_include arg -> view arg + | _ -> View.error + +let pstr_attribute'const view value = + let concrete = Structure_item_desc.to_concrete value in + match concrete with + | Structure_item_desc.Pstr_attribute arg -> view arg + | _ -> View.error + +let strattribute'const view value = + let parent_concrete = Structure_item.to_concrete value in + let desc = parent_concrete.Structure_item.pstr_desc in + let concrete = Structure_item_desc.to_concrete desc in + match concrete with + | Structure_item_desc.Pstr_attribute arg -> view arg + | _ -> View.error + +let pstr_extension'const view value = + let concrete = Structure_item_desc.to_concrete value in + match concrete with + | Structure_item_desc.Pstr_extension (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let strextension'const view value = + let parent_concrete = Structure_item.to_concrete value in + let desc = parent_concrete.Structure_item.pstr_desc in + let concrete = Structure_item_desc.to_concrete desc in + match concrete with + | Structure_item_desc.Pstr_extension (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let pvb_pat'match view value = + let concrete = Value_binding.to_concrete value in + view concrete.Value_binding.pvb_pat + +let pvb_expr'match view value = + let concrete = Value_binding.to_concrete value in + view concrete.Value_binding.pvb_expr + +let pvb_attributes'match view value = + let concrete = Value_binding.to_concrete value in + view concrete.Value_binding.pvb_attributes + +let pvb_loc'match view value = + let concrete = Value_binding.to_concrete value in + view concrete.Value_binding.pvb_loc + +let pmb_name'match view value = + let concrete = Module_binding.to_concrete value in + view concrete.Module_binding.pmb_name + +let pmb_expr'match view value = + let concrete = Module_binding.to_concrete value in + view concrete.Module_binding.pmb_expr + +let pmb_attributes'match view value = + let concrete = Module_binding.to_concrete value in + view concrete.Module_binding.pmb_attributes + +let pmb_loc'match view value = + let concrete = Module_binding.to_concrete value in + view concrete.Module_binding.pmb_loc + +let ptop_def'const view value = + let concrete = Toplevel_phrase.to_concrete value in + match concrete with + | Toplevel_phrase.Ptop_def arg -> view arg + | _ -> View.error + +let ptop_dir'const view value = + let concrete = Toplevel_phrase.to_concrete value in + match concrete with + | Toplevel_phrase.Ptop_dir arg -> view arg + | _ -> View.error + +let pdir_name'match view value = + let concrete = Toplevel_directive.to_concrete value in + view concrete.Toplevel_directive.pdir_name + +let pdir_arg'match view value = + let concrete = Toplevel_directive.to_concrete value in + view concrete.Toplevel_directive.pdir_arg + +let pdir_loc'match view value = + let concrete = Toplevel_directive.to_concrete value in + view concrete.Toplevel_directive.pdir_loc + +let pdira_desc'match view value = + let concrete = Directive_argument.to_concrete value in + view concrete.Directive_argument.pdira_desc + +let pdira_loc'match view value = + let concrete = Directive_argument.to_concrete value in + view concrete.Directive_argument.pdira_loc + +let pdir_string'const view value = + let concrete = Directive_argument_desc.to_concrete value in + match concrete with + | Directive_argument_desc.Pdir_string arg -> view arg + | _ -> View.error + +let dastring'const view value = + let parent_concrete = Directive_argument.to_concrete value in + let desc = parent_concrete.Directive_argument.pdira_desc in + let concrete = Directive_argument_desc.to_concrete desc in + match concrete with + | Directive_argument_desc.Pdir_string arg -> view arg + | _ -> View.error + +let pdir_int'const view value = + let concrete = Directive_argument_desc.to_concrete value in + match concrete with + | Directive_argument_desc.Pdir_int (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let daint'const view value = + let parent_concrete = Directive_argument.to_concrete value in + let desc = parent_concrete.Directive_argument.pdira_desc in + let concrete = Directive_argument_desc.to_concrete desc in + match concrete with + | Directive_argument_desc.Pdir_int (arg0, arg1) -> view (arg0, arg1) + | _ -> View.error + +let pdir_ident'const view value = + let concrete = Directive_argument_desc.to_concrete value in + match concrete with + | Directive_argument_desc.Pdir_ident arg -> view arg + | _ -> View.error + +let daident'const view value = + let parent_concrete = Directive_argument.to_concrete value in + let desc = parent_concrete.Directive_argument.pdira_desc in + let concrete = Directive_argument_desc.to_concrete desc in + match concrete with + | Directive_argument_desc.Pdir_ident arg -> view arg + | _ -> View.error + +let pdir_bool'const view value = + let concrete = Directive_argument_desc.to_concrete value in + match concrete with + | Directive_argument_desc.Pdir_bool arg -> view arg + | _ -> View.error + +let dabool'const view value = + let parent_concrete = Directive_argument.to_concrete value in + let desc = parent_concrete.Directive_argument.pdira_desc in + let concrete = Directive_argument_desc.to_concrete desc in + match concrete with + | Directive_argument_desc.Pdir_bool arg -> view arg + | _ -> View.error +(*$*) diff --git a/ast/viewer_v4_08.mli b/ast/viewer_v4_08.mli new file mode 100644 index 00000000..97615e80 --- /dev/null +++ b/ast/viewer_v4_08.mli @@ -0,0 +1,956 @@ +open Viewlib + +(*$ Ppx_ast_cinaps.print_viewer_mli (Astlib.Version.of_string "v4_08") *) +open Versions +open V4_08 +include module type of Viewer_common + +val lident'const : (string, 'i, 'o) View.t -> (Longident.t, 'i, 'o) View.t + +val ldot'const : ((Longident.t * string), 'i, 'o) View.t -> (Longident.t, 'i, 'o) View.t + +val lapply'const : ((Longident.t * Longident.t), 'i, 'o) View.t -> (Longident.t, 'i, 'o) View.t +val longident_loc'const: (Longident.t Astlib.Loc.t, 'i, 'o) View.t -> (Longident_loc.t, 'i, 'o) View.t + +val nonrecursive'const : (Rec_flag.t, 'a, 'a) View.t + +val recursive'const : (Rec_flag.t, 'a, 'a) View.t + +val upto'const : (Direction_flag.t, 'a, 'a) View.t + +val downto'const : (Direction_flag.t, 'a, 'a) View.t + +val private'const : (Private_flag.t, 'a, 'a) View.t + +val public'const : (Private_flag.t, 'a, 'a) View.t + +val immutable'const : (Mutable_flag.t, 'a, 'a) View.t + +val mutable'const : (Mutable_flag.t, 'a, 'a) View.t + +val virtual'const : (Virtual_flag.t, 'a, 'a) View.t + +val concrete'const : (Virtual_flag.t, 'a, 'a) View.t + +val override'const : (Override_flag.t, 'a, 'a) View.t + +val fresh'const : (Override_flag.t, 'a, 'a) View.t + +val closed'const : (Closed_flag.t, 'a, 'a) View.t + +val open'const : (Closed_flag.t, 'a, 'a) View.t + +val nolabel'const : (Arg_label.t, 'a, 'a) View.t + +val labelled'const : (string, 'i, 'o) View.t -> (Arg_label.t, 'i, 'o) View.t + +val optional'const : (string, 'i, 'o) View.t -> (Arg_label.t, 'i, 'o) View.t + +val covariant'const : (Variance.t, 'a, 'a) View.t + +val contravariant'const : (Variance.t, 'a, 'a) View.t + +val invariant'const : (Variance.t, 'a, 'a) View.t + +val pconst_integer'const : ((string * char option), 'i, 'o) View.t -> (Constant.t, 'i, 'o) View.t + +val pconst_char'const : (char, 'i, 'o) View.t -> (Constant.t, 'i, 'o) View.t + +val pconst_string'const : ((string * string option), 'i, 'o) View.t -> (Constant.t, 'i, 'o) View.t + +val pconst_float'const : ((string * char option), 'i, 'o) View.t -> (Constant.t, 'i, 'o) View.t + +val attr_name'match : (string Astlib.Loc.t, 'i, 'o) View.t -> (Attribute.t, 'i, 'o) View.t + +val attr_payload'match : (Payload.t, 'i, 'o) View.t -> (Attribute.t, 'i, 'o) View.t + +val attr_loc'match : (Astlib.Location.t, 'i, 'o) View.t -> (Attribute.t, 'i, 'o) View.t +val extension'const: ((string Astlib.Loc.t * Payload.t), 'i, 'o) View.t -> (Extension.t, 'i, 'o) View.t +val attributes'const: (Attribute.t list, 'i, 'o) View.t -> (Attributes.t, 'i, 'o) View.t + +val pstr'const : (Structure.t, 'i, 'o) View.t -> (Payload.t, 'i, 'o) View.t + +val psig'const : (Signature.t, 'i, 'o) View.t -> (Payload.t, 'i, 'o) View.t + +val ptyp'const : (Core_type.t, 'i, 'o) View.t -> (Payload.t, 'i, 'o) View.t + +val ppat'const : ((Pattern.t * Expression.t option), 'i, 'o) View.t -> (Payload.t, 'i, 'o) View.t + +val ptyp_desc'match : (Core_type_desc.t, 'i, 'o) View.t -> (Core_type.t, 'i, 'o) View.t + +val ptyp_loc'match : (Astlib.Location.t, 'i, 'o) View.t -> (Core_type.t, 'i, 'o) View.t + +val ptyp_loc_stack'match : (Astlib.Location.t list, 'i, 'o) View.t -> (Core_type.t, 'i, 'o) View.t + +val ptyp_attributes'match : (Attributes.t, 'i, 'o) View.t -> (Core_type.t, 'i, 'o) View.t + +val ptyp_any'const : (Core_type_desc.t, 'a, 'a) View.t + +val tany'const : (Core_type.t, 'a, 'a) View.t + +val ptyp_var'const : (string, 'i, 'o) View.t -> (Core_type_desc.t, 'i, 'o) View.t + +val tvar'const : (string, 'i, 'o) View.t -> (Core_type.t, 'i, 'o) View.t + +val ptyp_arrow'const : ((Arg_label.t * Core_type.t * Core_type.t), 'i, 'o) View.t -> (Core_type_desc.t, 'i, 'o) View.t + +val tarrow'const : ((Arg_label.t * Core_type.t * Core_type.t), 'i, 'o) View.t -> (Core_type.t, 'i, 'o) View.t + +val ptyp_tuple'const : (Core_type.t list, 'i, 'o) View.t -> (Core_type_desc.t, 'i, 'o) View.t + +val ttuple'const : (Core_type.t list, 'i, 'o) View.t -> (Core_type.t, 'i, 'o) View.t + +val ptyp_constr'const : ((Longident_loc.t * Core_type.t list), 'i, 'o) View.t -> (Core_type_desc.t, 'i, 'o) View.t + +val tconstr'const : ((Longident_loc.t * Core_type.t list), 'i, 'o) View.t -> (Core_type.t, 'i, 'o) View.t + +val ptyp_object'const : ((Object_field.t list * Closed_flag.t), 'i, 'o) View.t -> (Core_type_desc.t, 'i, 'o) View.t + +val tobject'const : ((Object_field.t list * Closed_flag.t), 'i, 'o) View.t -> (Core_type.t, 'i, 'o) View.t + +val ptyp_class'const : ((Longident_loc.t * Core_type.t list), 'i, 'o) View.t -> (Core_type_desc.t, 'i, 'o) View.t + +val tclass'const : ((Longident_loc.t * Core_type.t list), 'i, 'o) View.t -> (Core_type.t, 'i, 'o) View.t + +val ptyp_alias'const : ((Core_type.t * string), 'i, 'o) View.t -> (Core_type_desc.t, 'i, 'o) View.t + +val talias'const : ((Core_type.t * string), 'i, 'o) View.t -> (Core_type.t, 'i, 'o) View.t + +val ptyp_variant'const : ((Row_field.t list * Closed_flag.t * string list option), 'i, 'o) View.t -> (Core_type_desc.t, 'i, 'o) View.t + +val tvariant'const : ((Row_field.t list * Closed_flag.t * string list option), 'i, 'o) View.t -> (Core_type.t, 'i, 'o) View.t + +val ptyp_poly'const : ((string Astlib.Loc.t list * Core_type.t), 'i, 'o) View.t -> (Core_type_desc.t, 'i, 'o) View.t + +val tpoly'const : ((string Astlib.Loc.t list * Core_type.t), 'i, 'o) View.t -> (Core_type.t, 'i, 'o) View.t + +val ptyp_package'const : (Package_type.t, 'i, 'o) View.t -> (Core_type_desc.t, 'i, 'o) View.t + +val tpackage'const : (Package_type.t, 'i, 'o) View.t -> (Core_type.t, 'i, 'o) View.t + +val ptyp_extension'const : (Extension.t, 'i, 'o) View.t -> (Core_type_desc.t, 'i, 'o) View.t + +val textension'const : (Extension.t, 'i, 'o) View.t -> (Core_type.t, 'i, 'o) View.t +val package_type'const: ((Longident_loc.t * (Longident_loc.t * Core_type.t) list), 'i, 'o) View.t -> (Package_type.t, 'i, 'o) View.t + +val prf_desc'match : (Row_field_desc.t, 'i, 'o) View.t -> (Row_field.t, 'i, 'o) View.t + +val prf_loc'match : (Astlib.Location.t, 'i, 'o) View.t -> (Row_field.t, 'i, 'o) View.t + +val prf_attributes'match : (Attributes.t, 'i, 'o) View.t -> (Row_field.t, 'i, 'o) View.t + +val rtag'const : ((string Astlib.Loc.t * bool * Core_type.t list), 'i, 'o) View.t -> (Row_field_desc.t, 'i, 'o) View.t + +val rfrtag'const : ((string Astlib.Loc.t * bool * Core_type.t list), 'i, 'o) View.t -> (Row_field.t, 'i, 'o) View.t + +val rinherit'const : (Core_type.t, 'i, 'o) View.t -> (Row_field_desc.t, 'i, 'o) View.t + +val rfrinherit'const : (Core_type.t, 'i, 'o) View.t -> (Row_field.t, 'i, 'o) View.t + +val pof_desc'match : (Object_field_desc.t, 'i, 'o) View.t -> (Object_field.t, 'i, 'o) View.t + +val pof_loc'match : (Astlib.Location.t, 'i, 'o) View.t -> (Object_field.t, 'i, 'o) View.t + +val pof_attributes'match : (Attributes.t, 'i, 'o) View.t -> (Object_field.t, 'i, 'o) View.t + +val otag'const : ((string Astlib.Loc.t * Core_type.t), 'i, 'o) View.t -> (Object_field_desc.t, 'i, 'o) View.t + +val ofotag'const : ((string Astlib.Loc.t * Core_type.t), 'i, 'o) View.t -> (Object_field.t, 'i, 'o) View.t + +val oinherit'const : (Core_type.t, 'i, 'o) View.t -> (Object_field_desc.t, 'i, 'o) View.t + +val ofoinherit'const : (Core_type.t, 'i, 'o) View.t -> (Object_field.t, 'i, 'o) View.t + +val ppat_desc'match : (Pattern_desc.t, 'i, 'o) View.t -> (Pattern.t, 'i, 'o) View.t + +val ppat_loc'match : (Astlib.Location.t, 'i, 'o) View.t -> (Pattern.t, 'i, 'o) View.t + +val ppat_loc_stack'match : (Astlib.Location.t list, 'i, 'o) View.t -> (Pattern.t, 'i, 'o) View.t + +val ppat_attributes'match : (Attributes.t, 'i, 'o) View.t -> (Pattern.t, 'i, 'o) View.t + +val ppat_any'const : (Pattern_desc.t, 'a, 'a) View.t + +val pany'const : (Pattern.t, 'a, 'a) View.t + +val ppat_var'const : (string Astlib.Loc.t, 'i, 'o) View.t -> (Pattern_desc.t, 'i, 'o) View.t + +val pvar'const : (string Astlib.Loc.t, 'i, 'o) View.t -> (Pattern.t, 'i, 'o) View.t + +val ppat_alias'const : ((Pattern.t * string Astlib.Loc.t), 'i, 'o) View.t -> (Pattern_desc.t, 'i, 'o) View.t + +val palias'const : ((Pattern.t * string Astlib.Loc.t), 'i, 'o) View.t -> (Pattern.t, 'i, 'o) View.t + +val ppat_constant'const : (Constant.t, 'i, 'o) View.t -> (Pattern_desc.t, 'i, 'o) View.t + +val pconstant'const : (Constant.t, 'i, 'o) View.t -> (Pattern.t, 'i, 'o) View.t + +val ppat_interval'const : ((Constant.t * Constant.t), 'i, 'o) View.t -> (Pattern_desc.t, 'i, 'o) View.t + +val pinterval'const : ((Constant.t * Constant.t), 'i, 'o) View.t -> (Pattern.t, 'i, 'o) View.t + +val ppat_tuple'const : (Pattern.t list, 'i, 'o) View.t -> (Pattern_desc.t, 'i, 'o) View.t + +val ptuple'const : (Pattern.t list, 'i, 'o) View.t -> (Pattern.t, 'i, 'o) View.t + +val ppat_construct'const : ((Longident_loc.t * Pattern.t option), 'i, 'o) View.t -> (Pattern_desc.t, 'i, 'o) View.t + +val pconstruct'const : ((Longident_loc.t * Pattern.t option), 'i, 'o) View.t -> (Pattern.t, 'i, 'o) View.t + +val ppat_variant'const : ((string * Pattern.t option), 'i, 'o) View.t -> (Pattern_desc.t, 'i, 'o) View.t + +val pvariant'const : ((string * Pattern.t option), 'i, 'o) View.t -> (Pattern.t, 'i, 'o) View.t + +val ppat_record'const : (((Longident_loc.t * Pattern.t) list * Closed_flag.t), 'i, 'o) View.t -> (Pattern_desc.t, 'i, 'o) View.t + +val precord'const : (((Longident_loc.t * Pattern.t) list * Closed_flag.t), 'i, 'o) View.t -> (Pattern.t, 'i, 'o) View.t + +val ppat_array'const : (Pattern.t list, 'i, 'o) View.t -> (Pattern_desc.t, 'i, 'o) View.t + +val parray'const : (Pattern.t list, 'i, 'o) View.t -> (Pattern.t, 'i, 'o) View.t + +val ppat_or'const : ((Pattern.t * Pattern.t), 'i, 'o) View.t -> (Pattern_desc.t, 'i, 'o) View.t + +val por'const : ((Pattern.t * Pattern.t), 'i, 'o) View.t -> (Pattern.t, 'i, 'o) View.t + +val ppat_constraint'const : ((Pattern.t * Core_type.t), 'i, 'o) View.t -> (Pattern_desc.t, 'i, 'o) View.t + +val pconstraint'const : ((Pattern.t * Core_type.t), 'i, 'o) View.t -> (Pattern.t, 'i, 'o) View.t + +val ppat_type'const : (Longident_loc.t, 'i, 'o) View.t -> (Pattern_desc.t, 'i, 'o) View.t + +val ptype'const : (Longident_loc.t, 'i, 'o) View.t -> (Pattern.t, 'i, 'o) View.t + +val ppat_lazy'const : (Pattern.t, 'i, 'o) View.t -> (Pattern_desc.t, 'i, 'o) View.t + +val plazy'const : (Pattern.t, 'i, 'o) View.t -> (Pattern.t, 'i, 'o) View.t + +val ppat_unpack'const : (string Astlib.Loc.t, 'i, 'o) View.t -> (Pattern_desc.t, 'i, 'o) View.t + +val punpack'const : (string Astlib.Loc.t, 'i, 'o) View.t -> (Pattern.t, 'i, 'o) View.t + +val ppat_exception'const : (Pattern.t, 'i, 'o) View.t -> (Pattern_desc.t, 'i, 'o) View.t + +val pexception'const : (Pattern.t, 'i, 'o) View.t -> (Pattern.t, 'i, 'o) View.t + +val ppat_extension'const : (Extension.t, 'i, 'o) View.t -> (Pattern_desc.t, 'i, 'o) View.t + +val pextension'const : (Extension.t, 'i, 'o) View.t -> (Pattern.t, 'i, 'o) View.t + +val ppat_open'const : ((Longident_loc.t * Pattern.t), 'i, 'o) View.t -> (Pattern_desc.t, 'i, 'o) View.t + +val popen'const : ((Longident_loc.t * Pattern.t), 'i, 'o) View.t -> (Pattern.t, 'i, 'o) View.t + +val pexp_desc'match : (Expression_desc.t, 'i, 'o) View.t -> (Expression.t, 'i, 'o) View.t + +val pexp_loc'match : (Astlib.Location.t, 'i, 'o) View.t -> (Expression.t, 'i, 'o) View.t + +val pexp_loc_stack'match : (Astlib.Location.t list, 'i, 'o) View.t -> (Expression.t, 'i, 'o) View.t + +val pexp_attributes'match : (Attributes.t, 'i, 'o) View.t -> (Expression.t, 'i, 'o) View.t + +val pexp_ident'const : (Longident_loc.t, 'i, 'o) View.t -> (Expression_desc.t, 'i, 'o) View.t + +val eident'const : (Longident_loc.t, 'i, 'o) View.t -> (Expression.t, 'i, 'o) View.t + +val pexp_constant'const : (Constant.t, 'i, 'o) View.t -> (Expression_desc.t, 'i, 'o) View.t + +val econstant'const : (Constant.t, 'i, 'o) View.t -> (Expression.t, 'i, 'o) View.t + +val pexp_let'const : ((Rec_flag.t * Value_binding.t list * Expression.t), 'i, 'o) View.t -> (Expression_desc.t, 'i, 'o) View.t + +val elet'const : ((Rec_flag.t * Value_binding.t list * Expression.t), 'i, 'o) View.t -> (Expression.t, 'i, 'o) View.t + +val pexp_function'const : (Case.t list, 'i, 'o) View.t -> (Expression_desc.t, 'i, 'o) View.t + +val efunction'const : (Case.t list, 'i, 'o) View.t -> (Expression.t, 'i, 'o) View.t + +val pexp_fun'const : ((Arg_label.t * Expression.t option * Pattern.t * Expression.t), 'i, 'o) View.t -> (Expression_desc.t, 'i, 'o) View.t + +val efun'const : ((Arg_label.t * Expression.t option * Pattern.t * Expression.t), 'i, 'o) View.t -> (Expression.t, 'i, 'o) View.t + +val pexp_apply'const : ((Expression.t * (Arg_label.t * Expression.t) list), 'i, 'o) View.t -> (Expression_desc.t, 'i, 'o) View.t + +val eapply'const : ((Expression.t * (Arg_label.t * Expression.t) list), 'i, 'o) View.t -> (Expression.t, 'i, 'o) View.t + +val pexp_match'const : ((Expression.t * Case.t list), 'i, 'o) View.t -> (Expression_desc.t, 'i, 'o) View.t + +val ematch'const : ((Expression.t * Case.t list), 'i, 'o) View.t -> (Expression.t, 'i, 'o) View.t + +val pexp_try'const : ((Expression.t * Case.t list), 'i, 'o) View.t -> (Expression_desc.t, 'i, 'o) View.t + +val etry'const : ((Expression.t * Case.t list), 'i, 'o) View.t -> (Expression.t, 'i, 'o) View.t + +val pexp_tuple'const : (Expression.t list, 'i, 'o) View.t -> (Expression_desc.t, 'i, 'o) View.t + +val etuple'const : (Expression.t list, 'i, 'o) View.t -> (Expression.t, 'i, 'o) View.t + +val pexp_construct'const : ((Longident_loc.t * Expression.t option), 'i, 'o) View.t -> (Expression_desc.t, 'i, 'o) View.t + +val econstruct'const : ((Longident_loc.t * Expression.t option), 'i, 'o) View.t -> (Expression.t, 'i, 'o) View.t + +val pexp_variant'const : ((string * Expression.t option), 'i, 'o) View.t -> (Expression_desc.t, 'i, 'o) View.t + +val evariant'const : ((string * Expression.t option), 'i, 'o) View.t -> (Expression.t, 'i, 'o) View.t + +val pexp_record'const : (((Longident_loc.t * Expression.t) list * Expression.t option), 'i, 'o) View.t -> (Expression_desc.t, 'i, 'o) View.t + +val erecord'const : (((Longident_loc.t * Expression.t) list * Expression.t option), 'i, 'o) View.t -> (Expression.t, 'i, 'o) View.t + +val pexp_field'const : ((Expression.t * Longident_loc.t), 'i, 'o) View.t -> (Expression_desc.t, 'i, 'o) View.t + +val efield'const : ((Expression.t * Longident_loc.t), 'i, 'o) View.t -> (Expression.t, 'i, 'o) View.t + +val pexp_setfield'const : ((Expression.t * Longident_loc.t * Expression.t), 'i, 'o) View.t -> (Expression_desc.t, 'i, 'o) View.t + +val esetfield'const : ((Expression.t * Longident_loc.t * Expression.t), 'i, 'o) View.t -> (Expression.t, 'i, 'o) View.t + +val pexp_array'const : (Expression.t list, 'i, 'o) View.t -> (Expression_desc.t, 'i, 'o) View.t + +val earray'const : (Expression.t list, 'i, 'o) View.t -> (Expression.t, 'i, 'o) View.t + +val pexp_ifthenelse'const : ((Expression.t * Expression.t * Expression.t option), 'i, 'o) View.t -> (Expression_desc.t, 'i, 'o) View.t + +val eifthenelse'const : ((Expression.t * Expression.t * Expression.t option), 'i, 'o) View.t -> (Expression.t, 'i, 'o) View.t + +val pexp_sequence'const : ((Expression.t * Expression.t), 'i, 'o) View.t -> (Expression_desc.t, 'i, 'o) View.t + +val esequence'const : ((Expression.t * Expression.t), 'i, 'o) View.t -> (Expression.t, 'i, 'o) View.t + +val pexp_while'const : ((Expression.t * Expression.t), 'i, 'o) View.t -> (Expression_desc.t, 'i, 'o) View.t + +val ewhile'const : ((Expression.t * Expression.t), 'i, 'o) View.t -> (Expression.t, 'i, 'o) View.t + +val pexp_for'const : ((Pattern.t * Expression.t * Expression.t * Direction_flag.t * Expression.t), 'i, 'o) View.t -> (Expression_desc.t, 'i, 'o) View.t + +val efor'const : ((Pattern.t * Expression.t * Expression.t * Direction_flag.t * Expression.t), 'i, 'o) View.t -> (Expression.t, 'i, 'o) View.t + +val pexp_constraint'const : ((Expression.t * Core_type.t), 'i, 'o) View.t -> (Expression_desc.t, 'i, 'o) View.t + +val econstraint'const : ((Expression.t * Core_type.t), 'i, 'o) View.t -> (Expression.t, 'i, 'o) View.t + +val pexp_coerce'const : ((Expression.t * Core_type.t option * Core_type.t), 'i, 'o) View.t -> (Expression_desc.t, 'i, 'o) View.t + +val ecoerce'const : ((Expression.t * Core_type.t option * Core_type.t), 'i, 'o) View.t -> (Expression.t, 'i, 'o) View.t + +val pexp_send'const : ((Expression.t * string Astlib.Loc.t), 'i, 'o) View.t -> (Expression_desc.t, 'i, 'o) View.t + +val esend'const : ((Expression.t * string Astlib.Loc.t), 'i, 'o) View.t -> (Expression.t, 'i, 'o) View.t + +val pexp_new'const : (Longident_loc.t, 'i, 'o) View.t -> (Expression_desc.t, 'i, 'o) View.t + +val enew'const : (Longident_loc.t, 'i, 'o) View.t -> (Expression.t, 'i, 'o) View.t + +val pexp_setinstvar'const : ((string Astlib.Loc.t * Expression.t), 'i, 'o) View.t -> (Expression_desc.t, 'i, 'o) View.t + +val esetinstvar'const : ((string Astlib.Loc.t * Expression.t), 'i, 'o) View.t -> (Expression.t, 'i, 'o) View.t + +val pexp_override'const : ((string Astlib.Loc.t * Expression.t) list, 'i, 'o) View.t -> (Expression_desc.t, 'i, 'o) View.t + +val eoverride'const : ((string Astlib.Loc.t * Expression.t) list, 'i, 'o) View.t -> (Expression.t, 'i, 'o) View.t + +val pexp_letmodule'const : ((string Astlib.Loc.t * Module_expr.t * Expression.t), 'i, 'o) View.t -> (Expression_desc.t, 'i, 'o) View.t + +val eletmodule'const : ((string Astlib.Loc.t * Module_expr.t * Expression.t), 'i, 'o) View.t -> (Expression.t, 'i, 'o) View.t + +val pexp_letexception'const : ((Extension_constructor.t * Expression.t), 'i, 'o) View.t -> (Expression_desc.t, 'i, 'o) View.t + +val eletexception'const : ((Extension_constructor.t * Expression.t), 'i, 'o) View.t -> (Expression.t, 'i, 'o) View.t + +val pexp_assert'const : (Expression.t, 'i, 'o) View.t -> (Expression_desc.t, 'i, 'o) View.t + +val eassert'const : (Expression.t, 'i, 'o) View.t -> (Expression.t, 'i, 'o) View.t + +val pexp_lazy'const : (Expression.t, 'i, 'o) View.t -> (Expression_desc.t, 'i, 'o) View.t + +val elazy'const : (Expression.t, 'i, 'o) View.t -> (Expression.t, 'i, 'o) View.t + +val pexp_poly'const : ((Expression.t * Core_type.t option), 'i, 'o) View.t -> (Expression_desc.t, 'i, 'o) View.t + +val epoly'const : ((Expression.t * Core_type.t option), 'i, 'o) View.t -> (Expression.t, 'i, 'o) View.t + +val pexp_object'const : (Class_structure.t, 'i, 'o) View.t -> (Expression_desc.t, 'i, 'o) View.t + +val eobject'const : (Class_structure.t, 'i, 'o) View.t -> (Expression.t, 'i, 'o) View.t + +val pexp_newtype'const : ((string Astlib.Loc.t * Expression.t), 'i, 'o) View.t -> (Expression_desc.t, 'i, 'o) View.t + +val enewtype'const : ((string Astlib.Loc.t * Expression.t), 'i, 'o) View.t -> (Expression.t, 'i, 'o) View.t + +val pexp_pack'const : (Module_expr.t, 'i, 'o) View.t -> (Expression_desc.t, 'i, 'o) View.t + +val epack'const : (Module_expr.t, 'i, 'o) View.t -> (Expression.t, 'i, 'o) View.t + +val pexp_open'const : ((Open_declaration.t * Expression.t), 'i, 'o) View.t -> (Expression_desc.t, 'i, 'o) View.t + +val eopen'const : ((Open_declaration.t * Expression.t), 'i, 'o) View.t -> (Expression.t, 'i, 'o) View.t + +val pexp_letop'const : (Letop.t, 'i, 'o) View.t -> (Expression_desc.t, 'i, 'o) View.t + +val eletop'const : (Letop.t, 'i, 'o) View.t -> (Expression.t, 'i, 'o) View.t + +val pexp_extension'const : (Extension.t, 'i, 'o) View.t -> (Expression_desc.t, 'i, 'o) View.t + +val eextension'const : (Extension.t, 'i, 'o) View.t -> (Expression.t, 'i, 'o) View.t + +val pexp_unreachable'const : (Expression_desc.t, 'a, 'a) View.t + +val eunreachable'const : (Expression.t, 'a, 'a) View.t + +val pc_lhs'match : (Pattern.t, 'i, 'o) View.t -> (Case.t, 'i, 'o) View.t + +val pc_guard'match : (Expression.t option, 'i, 'o) View.t -> (Case.t, 'i, 'o) View.t + +val pc_rhs'match : (Expression.t, 'i, 'o) View.t -> (Case.t, 'i, 'o) View.t + +val let_'match : (Binding_op.t, 'i, 'o) View.t -> (Letop.t, 'i, 'o) View.t + +val ands'match : (Binding_op.t list, 'i, 'o) View.t -> (Letop.t, 'i, 'o) View.t + +val body'match : (Expression.t, 'i, 'o) View.t -> (Letop.t, 'i, 'o) View.t + +val pbop_op'match : (string Astlib.Loc.t, 'i, 'o) View.t -> (Binding_op.t, 'i, 'o) View.t + +val pbop_pat'match : (Pattern.t, 'i, 'o) View.t -> (Binding_op.t, 'i, 'o) View.t + +val pbop_exp'match : (Expression.t, 'i, 'o) View.t -> (Binding_op.t, 'i, 'o) View.t + +val pbop_loc'match : (Astlib.Location.t, 'i, 'o) View.t -> (Binding_op.t, 'i, 'o) View.t + +val pval_name'match : (string Astlib.Loc.t, 'i, 'o) View.t -> (Value_description.t, 'i, 'o) View.t + +val pval_type'match : (Core_type.t, 'i, 'o) View.t -> (Value_description.t, 'i, 'o) View.t + +val pval_prim'match : (string list, 'i, 'o) View.t -> (Value_description.t, 'i, 'o) View.t + +val pval_attributes'match : (Attributes.t, 'i, 'o) View.t -> (Value_description.t, 'i, 'o) View.t + +val pval_loc'match : (Astlib.Location.t, 'i, 'o) View.t -> (Value_description.t, 'i, 'o) View.t + +val ptype_name'match : (string Astlib.Loc.t, 'i, 'o) View.t -> (Type_declaration.t, 'i, 'o) View.t + +val ptype_params'match : ((Core_type.t * Variance.t) list, 'i, 'o) View.t -> (Type_declaration.t, 'i, 'o) View.t + +val ptype_cstrs'match : ((Core_type.t * Core_type.t * Astlib.Location.t) list, 'i, 'o) View.t -> (Type_declaration.t, 'i, 'o) View.t + +val ptype_kind'match : (Type_kind.t, 'i, 'o) View.t -> (Type_declaration.t, 'i, 'o) View.t + +val ptype_private'match : (Private_flag.t, 'i, 'o) View.t -> (Type_declaration.t, 'i, 'o) View.t + +val ptype_manifest'match : (Core_type.t option, 'i, 'o) View.t -> (Type_declaration.t, 'i, 'o) View.t + +val ptype_attributes'match : (Attributes.t, 'i, 'o) View.t -> (Type_declaration.t, 'i, 'o) View.t + +val ptype_loc'match : (Astlib.Location.t, 'i, 'o) View.t -> (Type_declaration.t, 'i, 'o) View.t + +val ptype_abstract'const : (Type_kind.t, 'a, 'a) View.t + +val ptype_variant'const : (Constructor_declaration.t list, 'i, 'o) View.t -> (Type_kind.t, 'i, 'o) View.t + +val ptype_record'const : (Label_declaration.t list, 'i, 'o) View.t -> (Type_kind.t, 'i, 'o) View.t + +val ptype_open'const : (Type_kind.t, 'a, 'a) View.t + +val pld_name'match : (string Astlib.Loc.t, 'i, 'o) View.t -> (Label_declaration.t, 'i, 'o) View.t + +val pld_mutable'match : (Mutable_flag.t, 'i, 'o) View.t -> (Label_declaration.t, 'i, 'o) View.t + +val pld_type'match : (Core_type.t, 'i, 'o) View.t -> (Label_declaration.t, 'i, 'o) View.t + +val pld_loc'match : (Astlib.Location.t, 'i, 'o) View.t -> (Label_declaration.t, 'i, 'o) View.t + +val pld_attributes'match : (Attributes.t, 'i, 'o) View.t -> (Label_declaration.t, 'i, 'o) View.t + +val pcd_name'match : (string Astlib.Loc.t, 'i, 'o) View.t -> (Constructor_declaration.t, 'i, 'o) View.t + +val pcd_args'match : (Constructor_arguments.t, 'i, 'o) View.t -> (Constructor_declaration.t, 'i, 'o) View.t + +val pcd_res'match : (Core_type.t option, 'i, 'o) View.t -> (Constructor_declaration.t, 'i, 'o) View.t + +val pcd_loc'match : (Astlib.Location.t, 'i, 'o) View.t -> (Constructor_declaration.t, 'i, 'o) View.t + +val pcd_attributes'match : (Attributes.t, 'i, 'o) View.t -> (Constructor_declaration.t, 'i, 'o) View.t + +val pcstr_tuple'const : (Core_type.t list, 'i, 'o) View.t -> (Constructor_arguments.t, 'i, 'o) View.t + +val pcstr_record'const : (Label_declaration.t list, 'i, 'o) View.t -> (Constructor_arguments.t, 'i, 'o) View.t + +val ptyext_path'match : (Longident_loc.t, 'i, 'o) View.t -> (Type_extension.t, 'i, 'o) View.t + +val ptyext_params'match : ((Core_type.t * Variance.t) list, 'i, 'o) View.t -> (Type_extension.t, 'i, 'o) View.t + +val ptyext_constructors'match : (Extension_constructor.t list, 'i, 'o) View.t -> (Type_extension.t, 'i, 'o) View.t + +val ptyext_private'match : (Private_flag.t, 'i, 'o) View.t -> (Type_extension.t, 'i, 'o) View.t + +val ptyext_loc'match : (Astlib.Location.t, 'i, 'o) View.t -> (Type_extension.t, 'i, 'o) View.t + +val ptyext_attributes'match : (Attributes.t, 'i, 'o) View.t -> (Type_extension.t, 'i, 'o) View.t + +val pext_name'match : (string Astlib.Loc.t, 'i, 'o) View.t -> (Extension_constructor.t, 'i, 'o) View.t + +val pext_kind'match : (Extension_constructor_kind.t, 'i, 'o) View.t -> (Extension_constructor.t, 'i, 'o) View.t + +val pext_loc'match : (Astlib.Location.t, 'i, 'o) View.t -> (Extension_constructor.t, 'i, 'o) View.t + +val pext_attributes'match : (Attributes.t, 'i, 'o) View.t -> (Extension_constructor.t, 'i, 'o) View.t + +val ptyexn_constructor'match : (Extension_constructor.t, 'i, 'o) View.t -> (Type_exception.t, 'i, 'o) View.t + +val ptyexn_loc'match : (Astlib.Location.t, 'i, 'o) View.t -> (Type_exception.t, 'i, 'o) View.t + +val ptyexn_attributes'match : (Attributes.t, 'i, 'o) View.t -> (Type_exception.t, 'i, 'o) View.t + +val pext_decl'const : ((Constructor_arguments.t * Core_type.t option), 'i, 'o) View.t -> (Extension_constructor_kind.t, 'i, 'o) View.t + +val pext_rebind'const : (Longident_loc.t, 'i, 'o) View.t -> (Extension_constructor_kind.t, 'i, 'o) View.t + +val pcty_desc'match : (Class_type_desc.t, 'i, 'o) View.t -> (Class_type.t, 'i, 'o) View.t + +val pcty_loc'match : (Astlib.Location.t, 'i, 'o) View.t -> (Class_type.t, 'i, 'o) View.t + +val pcty_attributes'match : (Attributes.t, 'i, 'o) View.t -> (Class_type.t, 'i, 'o) View.t + +val pcty_constr'const : ((Longident_loc.t * Core_type.t list), 'i, 'o) View.t -> (Class_type_desc.t, 'i, 'o) View.t + +val ctconstr'const : ((Longident_loc.t * Core_type.t list), 'i, 'o) View.t -> (Class_type.t, 'i, 'o) View.t + +val pcty_signature'const : (Class_signature.t, 'i, 'o) View.t -> (Class_type_desc.t, 'i, 'o) View.t + +val ctsignature'const : (Class_signature.t, 'i, 'o) View.t -> (Class_type.t, 'i, 'o) View.t + +val pcty_arrow'const : ((Arg_label.t * Core_type.t * Class_type.t), 'i, 'o) View.t -> (Class_type_desc.t, 'i, 'o) View.t + +val ctarrow'const : ((Arg_label.t * Core_type.t * Class_type.t), 'i, 'o) View.t -> (Class_type.t, 'i, 'o) View.t + +val pcty_extension'const : (Extension.t, 'i, 'o) View.t -> (Class_type_desc.t, 'i, 'o) View.t + +val ctextension'const : (Extension.t, 'i, 'o) View.t -> (Class_type.t, 'i, 'o) View.t + +val pcty_open'const : ((Open_description.t * Class_type.t), 'i, 'o) View.t -> (Class_type_desc.t, 'i, 'o) View.t + +val ctopen'const : ((Open_description.t * Class_type.t), 'i, 'o) View.t -> (Class_type.t, 'i, 'o) View.t + +val pcsig_self'match : (Core_type.t, 'i, 'o) View.t -> (Class_signature.t, 'i, 'o) View.t + +val pcsig_fields'match : (Class_type_field.t list, 'i, 'o) View.t -> (Class_signature.t, 'i, 'o) View.t + +val pctf_desc'match : (Class_type_field_desc.t, 'i, 'o) View.t -> (Class_type_field.t, 'i, 'o) View.t + +val pctf_loc'match : (Astlib.Location.t, 'i, 'o) View.t -> (Class_type_field.t, 'i, 'o) View.t + +val pctf_attributes'match : (Attributes.t, 'i, 'o) View.t -> (Class_type_field.t, 'i, 'o) View.t + +val pctf_inherit'const : (Class_type.t, 'i, 'o) View.t -> (Class_type_field_desc.t, 'i, 'o) View.t + +val ctfinherit'const : (Class_type.t, 'i, 'o) View.t -> (Class_type_field.t, 'i, 'o) View.t + +val pctf_val'const : ((string Astlib.Loc.t * Mutable_flag.t * Virtual_flag.t * Core_type.t), 'i, 'o) View.t -> (Class_type_field_desc.t, 'i, 'o) View.t + +val ctfval'const : ((string Astlib.Loc.t * Mutable_flag.t * Virtual_flag.t * Core_type.t), 'i, 'o) View.t -> (Class_type_field.t, 'i, 'o) View.t + +val pctf_method'const : ((string Astlib.Loc.t * Private_flag.t * Virtual_flag.t * Core_type.t), 'i, 'o) View.t -> (Class_type_field_desc.t, 'i, 'o) View.t + +val ctfmethod'const : ((string Astlib.Loc.t * Private_flag.t * Virtual_flag.t * Core_type.t), 'i, 'o) View.t -> (Class_type_field.t, 'i, 'o) View.t + +val pctf_constraint'const : ((Core_type.t * Core_type.t), 'i, 'o) View.t -> (Class_type_field_desc.t, 'i, 'o) View.t + +val ctfconstraint'const : ((Core_type.t * Core_type.t), 'i, 'o) View.t -> (Class_type_field.t, 'i, 'o) View.t + +val pctf_attribute'const : (Attribute.t, 'i, 'o) View.t -> (Class_type_field_desc.t, 'i, 'o) View.t + +val ctfattribute'const : (Attribute.t, 'i, 'o) View.t -> (Class_type_field.t, 'i, 'o) View.t + +val pctf_extension'const : (Extension.t, 'i, 'o) View.t -> (Class_type_field_desc.t, 'i, 'o) View.t + +val ctfextension'const : (Extension.t, 'i, 'o) View.t -> (Class_type_field.t, 'i, 'o) View.t + +val pci_virt'match : (Virtual_flag.t, 'i, 'o) View.t -> ('a node Class_infos.t, 'i, 'o) View.t + +val pci_params'match : ((Core_type.t * Variance.t) list, 'i, 'o) View.t -> ('a node Class_infos.t, 'i, 'o) View.t + +val pci_name'match : (string Astlib.Loc.t, 'i, 'o) View.t -> ('a node Class_infos.t, 'i, 'o) View.t + +val pci_expr'match : ('a node, 'i, 'o) View.t -> ('a node Class_infos.t, 'i, 'o) View.t + +val pci_loc'match : (Astlib.Location.t, 'i, 'o) View.t -> ('a node Class_infos.t, 'i, 'o) View.t + +val pci_attributes'match : (Attributes.t, 'i, 'o) View.t -> ('a node Class_infos.t, 'i, 'o) View.t +val class_description'const: (Class_type.t Class_infos.t, 'i, 'o) View.t -> (Class_description.t, 'i, 'o) View.t +val class_type_declaration'const: (Class_type.t Class_infos.t, 'i, 'o) View.t -> (Class_type_declaration.t, 'i, 'o) View.t + +val pcl_desc'match : (Class_expr_desc.t, 'i, 'o) View.t -> (Class_expr.t, 'i, 'o) View.t + +val pcl_loc'match : (Astlib.Location.t, 'i, 'o) View.t -> (Class_expr.t, 'i, 'o) View.t + +val pcl_attributes'match : (Attributes.t, 'i, 'o) View.t -> (Class_expr.t, 'i, 'o) View.t + +val pcl_constr'const : ((Longident_loc.t * Core_type.t list), 'i, 'o) View.t -> (Class_expr_desc.t, 'i, 'o) View.t + +val ceconstr'const : ((Longident_loc.t * Core_type.t list), 'i, 'o) View.t -> (Class_expr.t, 'i, 'o) View.t + +val pcl_structure'const : (Class_structure.t, 'i, 'o) View.t -> (Class_expr_desc.t, 'i, 'o) View.t + +val cestructure'const : (Class_structure.t, 'i, 'o) View.t -> (Class_expr.t, 'i, 'o) View.t + +val pcl_fun'const : ((Arg_label.t * Expression.t option * Pattern.t * Class_expr.t), 'i, 'o) View.t -> (Class_expr_desc.t, 'i, 'o) View.t + +val cefun'const : ((Arg_label.t * Expression.t option * Pattern.t * Class_expr.t), 'i, 'o) View.t -> (Class_expr.t, 'i, 'o) View.t + +val pcl_apply'const : ((Class_expr.t * (Arg_label.t * Expression.t) list), 'i, 'o) View.t -> (Class_expr_desc.t, 'i, 'o) View.t + +val ceapply'const : ((Class_expr.t * (Arg_label.t * Expression.t) list), 'i, 'o) View.t -> (Class_expr.t, 'i, 'o) View.t + +val pcl_let'const : ((Rec_flag.t * Value_binding.t list * Class_expr.t), 'i, 'o) View.t -> (Class_expr_desc.t, 'i, 'o) View.t + +val celet'const : ((Rec_flag.t * Value_binding.t list * Class_expr.t), 'i, 'o) View.t -> (Class_expr.t, 'i, 'o) View.t + +val pcl_constraint'const : ((Class_expr.t * Class_type.t), 'i, 'o) View.t -> (Class_expr_desc.t, 'i, 'o) View.t + +val ceconstraint'const : ((Class_expr.t * Class_type.t), 'i, 'o) View.t -> (Class_expr.t, 'i, 'o) View.t + +val pcl_extension'const : (Extension.t, 'i, 'o) View.t -> (Class_expr_desc.t, 'i, 'o) View.t + +val ceextension'const : (Extension.t, 'i, 'o) View.t -> (Class_expr.t, 'i, 'o) View.t + +val pcl_open'const : ((Open_description.t * Class_expr.t), 'i, 'o) View.t -> (Class_expr_desc.t, 'i, 'o) View.t + +val ceopen'const : ((Open_description.t * Class_expr.t), 'i, 'o) View.t -> (Class_expr.t, 'i, 'o) View.t + +val pcstr_self'match : (Pattern.t, 'i, 'o) View.t -> (Class_structure.t, 'i, 'o) View.t + +val pcstr_fields'match : (Class_field.t list, 'i, 'o) View.t -> (Class_structure.t, 'i, 'o) View.t + +val pcf_desc'match : (Class_field_desc.t, 'i, 'o) View.t -> (Class_field.t, 'i, 'o) View.t + +val pcf_loc'match : (Astlib.Location.t, 'i, 'o) View.t -> (Class_field.t, 'i, 'o) View.t + +val pcf_attributes'match : (Attributes.t, 'i, 'o) View.t -> (Class_field.t, 'i, 'o) View.t + +val pcf_inherit'const : ((Override_flag.t * Class_expr.t * string Astlib.Loc.t option), 'i, 'o) View.t -> (Class_field_desc.t, 'i, 'o) View.t + +val cfinherit'const : ((Override_flag.t * Class_expr.t * string Astlib.Loc.t option), 'i, 'o) View.t -> (Class_field.t, 'i, 'o) View.t + +val pcf_val'const : ((string Astlib.Loc.t * Mutable_flag.t * Class_field_kind.t), 'i, 'o) View.t -> (Class_field_desc.t, 'i, 'o) View.t + +val cfval'const : ((string Astlib.Loc.t * Mutable_flag.t * Class_field_kind.t), 'i, 'o) View.t -> (Class_field.t, 'i, 'o) View.t + +val pcf_method'const : ((string Astlib.Loc.t * Private_flag.t * Class_field_kind.t), 'i, 'o) View.t -> (Class_field_desc.t, 'i, 'o) View.t + +val cfmethod'const : ((string Astlib.Loc.t * Private_flag.t * Class_field_kind.t), 'i, 'o) View.t -> (Class_field.t, 'i, 'o) View.t + +val pcf_constraint'const : ((Core_type.t * Core_type.t), 'i, 'o) View.t -> (Class_field_desc.t, 'i, 'o) View.t + +val cfconstraint'const : ((Core_type.t * Core_type.t), 'i, 'o) View.t -> (Class_field.t, 'i, 'o) View.t + +val pcf_initializer'const : (Expression.t, 'i, 'o) View.t -> (Class_field_desc.t, 'i, 'o) View.t + +val cfinitializer'const : (Expression.t, 'i, 'o) View.t -> (Class_field.t, 'i, 'o) View.t + +val pcf_attribute'const : (Attribute.t, 'i, 'o) View.t -> (Class_field_desc.t, 'i, 'o) View.t + +val cfattribute'const : (Attribute.t, 'i, 'o) View.t -> (Class_field.t, 'i, 'o) View.t + +val pcf_extension'const : (Extension.t, 'i, 'o) View.t -> (Class_field_desc.t, 'i, 'o) View.t + +val cfextension'const : (Extension.t, 'i, 'o) View.t -> (Class_field.t, 'i, 'o) View.t + +val cfk_virtual'const : (Core_type.t, 'i, 'o) View.t -> (Class_field_kind.t, 'i, 'o) View.t + +val cfk_concrete'const : ((Override_flag.t * Expression.t), 'i, 'o) View.t -> (Class_field_kind.t, 'i, 'o) View.t +val class_declaration'const: (Class_expr.t Class_infos.t, 'i, 'o) View.t -> (Class_declaration.t, 'i, 'o) View.t + +val pmty_desc'match : (Module_type_desc.t, 'i, 'o) View.t -> (Module_type.t, 'i, 'o) View.t + +val pmty_loc'match : (Astlib.Location.t, 'i, 'o) View.t -> (Module_type.t, 'i, 'o) View.t + +val pmty_attributes'match : (Attributes.t, 'i, 'o) View.t -> (Module_type.t, 'i, 'o) View.t + +val pmty_ident'const : (Longident_loc.t, 'i, 'o) View.t -> (Module_type_desc.t, 'i, 'o) View.t + +val mtident'const : (Longident_loc.t, 'i, 'o) View.t -> (Module_type.t, 'i, 'o) View.t + +val pmty_signature'const : (Signature.t, 'i, 'o) View.t -> (Module_type_desc.t, 'i, 'o) View.t + +val mtsignature'const : (Signature.t, 'i, 'o) View.t -> (Module_type.t, 'i, 'o) View.t + +val pmty_functor'const : ((string Astlib.Loc.t * Module_type.t option * Module_type.t), 'i, 'o) View.t -> (Module_type_desc.t, 'i, 'o) View.t + +val mtfunctor'const : ((string Astlib.Loc.t * Module_type.t option * Module_type.t), 'i, 'o) View.t -> (Module_type.t, 'i, 'o) View.t + +val pmty_with'const : ((Module_type.t * With_constraint.t list), 'i, 'o) View.t -> (Module_type_desc.t, 'i, 'o) View.t + +val mtwith'const : ((Module_type.t * With_constraint.t list), 'i, 'o) View.t -> (Module_type.t, 'i, 'o) View.t + +val pmty_typeof'const : (Module_expr.t, 'i, 'o) View.t -> (Module_type_desc.t, 'i, 'o) View.t + +val mttypeof'const : (Module_expr.t, 'i, 'o) View.t -> (Module_type.t, 'i, 'o) View.t + +val pmty_extension'const : (Extension.t, 'i, 'o) View.t -> (Module_type_desc.t, 'i, 'o) View.t + +val mtextension'const : (Extension.t, 'i, 'o) View.t -> (Module_type.t, 'i, 'o) View.t + +val pmty_alias'const : (Longident_loc.t, 'i, 'o) View.t -> (Module_type_desc.t, 'i, 'o) View.t + +val mtalias'const : (Longident_loc.t, 'i, 'o) View.t -> (Module_type.t, 'i, 'o) View.t +val signature'const: (Signature_item.t list, 'i, 'o) View.t -> (Signature.t, 'i, 'o) View.t + +val psig_desc'match : (Signature_item_desc.t, 'i, 'o) View.t -> (Signature_item.t, 'i, 'o) View.t + +val psig_loc'match : (Astlib.Location.t, 'i, 'o) View.t -> (Signature_item.t, 'i, 'o) View.t + +val psig_value'const : (Value_description.t, 'i, 'o) View.t -> (Signature_item_desc.t, 'i, 'o) View.t + +val sigvalue'const : (Value_description.t, 'i, 'o) View.t -> (Signature_item.t, 'i, 'o) View.t + +val psig_type'const : ((Rec_flag.t * Type_declaration.t list), 'i, 'o) View.t -> (Signature_item_desc.t, 'i, 'o) View.t + +val sigtype'const : ((Rec_flag.t * Type_declaration.t list), 'i, 'o) View.t -> (Signature_item.t, 'i, 'o) View.t + +val psig_typesubst'const : (Type_declaration.t list, 'i, 'o) View.t -> (Signature_item_desc.t, 'i, 'o) View.t + +val sigtypesubst'const : (Type_declaration.t list, 'i, 'o) View.t -> (Signature_item.t, 'i, 'o) View.t + +val psig_typext'const : (Type_extension.t, 'i, 'o) View.t -> (Signature_item_desc.t, 'i, 'o) View.t + +val sigtypext'const : (Type_extension.t, 'i, 'o) View.t -> (Signature_item.t, 'i, 'o) View.t + +val psig_exception'const : (Type_exception.t, 'i, 'o) View.t -> (Signature_item_desc.t, 'i, 'o) View.t + +val sigexception'const : (Type_exception.t, 'i, 'o) View.t -> (Signature_item.t, 'i, 'o) View.t + +val psig_module'const : (Module_declaration.t, 'i, 'o) View.t -> (Signature_item_desc.t, 'i, 'o) View.t + +val sigmodule'const : (Module_declaration.t, 'i, 'o) View.t -> (Signature_item.t, 'i, 'o) View.t + +val psig_modsubst'const : (Module_substitution.t, 'i, 'o) View.t -> (Signature_item_desc.t, 'i, 'o) View.t + +val sigmodsubst'const : (Module_substitution.t, 'i, 'o) View.t -> (Signature_item.t, 'i, 'o) View.t + +val psig_recmodule'const : (Module_declaration.t list, 'i, 'o) View.t -> (Signature_item_desc.t, 'i, 'o) View.t + +val sigrecmodule'const : (Module_declaration.t list, 'i, 'o) View.t -> (Signature_item.t, 'i, 'o) View.t + +val psig_modtype'const : (Module_type_declaration.t, 'i, 'o) View.t -> (Signature_item_desc.t, 'i, 'o) View.t + +val sigmodtype'const : (Module_type_declaration.t, 'i, 'o) View.t -> (Signature_item.t, 'i, 'o) View.t + +val psig_open'const : (Open_description.t, 'i, 'o) View.t -> (Signature_item_desc.t, 'i, 'o) View.t + +val sigopen'const : (Open_description.t, 'i, 'o) View.t -> (Signature_item.t, 'i, 'o) View.t + +val psig_include'const : (Include_description.t, 'i, 'o) View.t -> (Signature_item_desc.t, 'i, 'o) View.t + +val siginclude'const : (Include_description.t, 'i, 'o) View.t -> (Signature_item.t, 'i, 'o) View.t + +val psig_class'const : (Class_description.t list, 'i, 'o) View.t -> (Signature_item_desc.t, 'i, 'o) View.t + +val sigclass'const : (Class_description.t list, 'i, 'o) View.t -> (Signature_item.t, 'i, 'o) View.t + +val psig_class_type'const : (Class_type_declaration.t list, 'i, 'o) View.t -> (Signature_item_desc.t, 'i, 'o) View.t + +val sigclass_type'const : (Class_type_declaration.t list, 'i, 'o) View.t -> (Signature_item.t, 'i, 'o) View.t + +val psig_attribute'const : (Attribute.t, 'i, 'o) View.t -> (Signature_item_desc.t, 'i, 'o) View.t + +val sigattribute'const : (Attribute.t, 'i, 'o) View.t -> (Signature_item.t, 'i, 'o) View.t + +val psig_extension'const : ((Extension.t * Attributes.t), 'i, 'o) View.t -> (Signature_item_desc.t, 'i, 'o) View.t + +val sigextension'const : ((Extension.t * Attributes.t), 'i, 'o) View.t -> (Signature_item.t, 'i, 'o) View.t + +val pmd_name'match : (string Astlib.Loc.t, 'i, 'o) View.t -> (Module_declaration.t, 'i, 'o) View.t + +val pmd_type'match : (Module_type.t, 'i, 'o) View.t -> (Module_declaration.t, 'i, 'o) View.t + +val pmd_attributes'match : (Attributes.t, 'i, 'o) View.t -> (Module_declaration.t, 'i, 'o) View.t + +val pmd_loc'match : (Astlib.Location.t, 'i, 'o) View.t -> (Module_declaration.t, 'i, 'o) View.t + +val pms_name'match : (string Astlib.Loc.t, 'i, 'o) View.t -> (Module_substitution.t, 'i, 'o) View.t + +val pms_manifest'match : (Longident_loc.t, 'i, 'o) View.t -> (Module_substitution.t, 'i, 'o) View.t + +val pms_attributes'match : (Attributes.t, 'i, 'o) View.t -> (Module_substitution.t, 'i, 'o) View.t + +val pms_loc'match : (Astlib.Location.t, 'i, 'o) View.t -> (Module_substitution.t, 'i, 'o) View.t + +val pmtd_name'match : (string Astlib.Loc.t, 'i, 'o) View.t -> (Module_type_declaration.t, 'i, 'o) View.t + +val pmtd_type'match : (Module_type.t option, 'i, 'o) View.t -> (Module_type_declaration.t, 'i, 'o) View.t + +val pmtd_attributes'match : (Attributes.t, 'i, 'o) View.t -> (Module_type_declaration.t, 'i, 'o) View.t + +val pmtd_loc'match : (Astlib.Location.t, 'i, 'o) View.t -> (Module_type_declaration.t, 'i, 'o) View.t + +val popen_expr'match : ('a node, 'i, 'o) View.t -> ('a node Open_infos.t, 'i, 'o) View.t + +val popen_override'match : (Override_flag.t, 'i, 'o) View.t -> ('a node Open_infos.t, 'i, 'o) View.t + +val popen_loc'match : (Astlib.Location.t, 'i, 'o) View.t -> ('a node Open_infos.t, 'i, 'o) View.t + +val popen_attributes'match : (Attributes.t, 'i, 'o) View.t -> ('a node Open_infos.t, 'i, 'o) View.t +val open_description'const: (Longident_loc.t Open_infos.t, 'i, 'o) View.t -> (Open_description.t, 'i, 'o) View.t +val open_declaration'const: (Module_expr.t Open_infos.t, 'i, 'o) View.t -> (Open_declaration.t, 'i, 'o) View.t + +val pincl_mod'match : ('a node, 'i, 'o) View.t -> ('a node Include_infos.t, 'i, 'o) View.t + +val pincl_loc'match : (Astlib.Location.t, 'i, 'o) View.t -> ('a node Include_infos.t, 'i, 'o) View.t + +val pincl_attributes'match : (Attributes.t, 'i, 'o) View.t -> ('a node Include_infos.t, 'i, 'o) View.t +val include_description'const: (Module_type.t Include_infos.t, 'i, 'o) View.t -> (Include_description.t, 'i, 'o) View.t +val include_declaration'const: (Module_expr.t Include_infos.t, 'i, 'o) View.t -> (Include_declaration.t, 'i, 'o) View.t + +val pwith_type'const : ((Longident_loc.t * Type_declaration.t), 'i, 'o) View.t -> (With_constraint.t, 'i, 'o) View.t + +val pwith_module'const : ((Longident_loc.t * Longident_loc.t), 'i, 'o) View.t -> (With_constraint.t, 'i, 'o) View.t + +val pwith_typesubst'const : ((Longident_loc.t * Type_declaration.t), 'i, 'o) View.t -> (With_constraint.t, 'i, 'o) View.t + +val pwith_modsubst'const : ((Longident_loc.t * Longident_loc.t), 'i, 'o) View.t -> (With_constraint.t, 'i, 'o) View.t + +val pmod_desc'match : (Module_expr_desc.t, 'i, 'o) View.t -> (Module_expr.t, 'i, 'o) View.t + +val pmod_loc'match : (Astlib.Location.t, 'i, 'o) View.t -> (Module_expr.t, 'i, 'o) View.t + +val pmod_attributes'match : (Attributes.t, 'i, 'o) View.t -> (Module_expr.t, 'i, 'o) View.t + +val pmod_ident'const : (Longident_loc.t, 'i, 'o) View.t -> (Module_expr_desc.t, 'i, 'o) View.t + +val meident'const : (Longident_loc.t, 'i, 'o) View.t -> (Module_expr.t, 'i, 'o) View.t + +val pmod_structure'const : (Structure.t, 'i, 'o) View.t -> (Module_expr_desc.t, 'i, 'o) View.t + +val mestructure'const : (Structure.t, 'i, 'o) View.t -> (Module_expr.t, 'i, 'o) View.t + +val pmod_functor'const : ((string Astlib.Loc.t * Module_type.t option * Module_expr.t), 'i, 'o) View.t -> (Module_expr_desc.t, 'i, 'o) View.t + +val mefunctor'const : ((string Astlib.Loc.t * Module_type.t option * Module_expr.t), 'i, 'o) View.t -> (Module_expr.t, 'i, 'o) View.t + +val pmod_apply'const : ((Module_expr.t * Module_expr.t), 'i, 'o) View.t -> (Module_expr_desc.t, 'i, 'o) View.t + +val meapply'const : ((Module_expr.t * Module_expr.t), 'i, 'o) View.t -> (Module_expr.t, 'i, 'o) View.t + +val pmod_constraint'const : ((Module_expr.t * Module_type.t), 'i, 'o) View.t -> (Module_expr_desc.t, 'i, 'o) View.t + +val meconstraint'const : ((Module_expr.t * Module_type.t), 'i, 'o) View.t -> (Module_expr.t, 'i, 'o) View.t + +val pmod_unpack'const : (Expression.t, 'i, 'o) View.t -> (Module_expr_desc.t, 'i, 'o) View.t + +val meunpack'const : (Expression.t, 'i, 'o) View.t -> (Module_expr.t, 'i, 'o) View.t + +val pmod_extension'const : (Extension.t, 'i, 'o) View.t -> (Module_expr_desc.t, 'i, 'o) View.t + +val meextension'const : (Extension.t, 'i, 'o) View.t -> (Module_expr.t, 'i, 'o) View.t +val structure'const: (Structure_item.t list, 'i, 'o) View.t -> (Structure.t, 'i, 'o) View.t + +val pstr_desc'match : (Structure_item_desc.t, 'i, 'o) View.t -> (Structure_item.t, 'i, 'o) View.t + +val pstr_loc'match : (Astlib.Location.t, 'i, 'o) View.t -> (Structure_item.t, 'i, 'o) View.t + +val pstr_eval'const : ((Expression.t * Attributes.t), 'i, 'o) View.t -> (Structure_item_desc.t, 'i, 'o) View.t + +val streval'const : ((Expression.t * Attributes.t), 'i, 'o) View.t -> (Structure_item.t, 'i, 'o) View.t + +val pstr_value'const : ((Rec_flag.t * Value_binding.t list), 'i, 'o) View.t -> (Structure_item_desc.t, 'i, 'o) View.t + +val strvalue'const : ((Rec_flag.t * Value_binding.t list), 'i, 'o) View.t -> (Structure_item.t, 'i, 'o) View.t + +val pstr_primitive'const : (Value_description.t, 'i, 'o) View.t -> (Structure_item_desc.t, 'i, 'o) View.t + +val strprimitive'const : (Value_description.t, 'i, 'o) View.t -> (Structure_item.t, 'i, 'o) View.t + +val pstr_type'const : ((Rec_flag.t * Type_declaration.t list), 'i, 'o) View.t -> (Structure_item_desc.t, 'i, 'o) View.t + +val strtype'const : ((Rec_flag.t * Type_declaration.t list), 'i, 'o) View.t -> (Structure_item.t, 'i, 'o) View.t + +val pstr_typext'const : (Type_extension.t, 'i, 'o) View.t -> (Structure_item_desc.t, 'i, 'o) View.t + +val strtypext'const : (Type_extension.t, 'i, 'o) View.t -> (Structure_item.t, 'i, 'o) View.t + +val pstr_exception'const : (Type_exception.t, 'i, 'o) View.t -> (Structure_item_desc.t, 'i, 'o) View.t + +val strexception'const : (Type_exception.t, 'i, 'o) View.t -> (Structure_item.t, 'i, 'o) View.t + +val pstr_module'const : (Module_binding.t, 'i, 'o) View.t -> (Structure_item_desc.t, 'i, 'o) View.t + +val strmodule'const : (Module_binding.t, 'i, 'o) View.t -> (Structure_item.t, 'i, 'o) View.t + +val pstr_recmodule'const : (Module_binding.t list, 'i, 'o) View.t -> (Structure_item_desc.t, 'i, 'o) View.t + +val strrecmodule'const : (Module_binding.t list, 'i, 'o) View.t -> (Structure_item.t, 'i, 'o) View.t + +val pstr_modtype'const : (Module_type_declaration.t, 'i, 'o) View.t -> (Structure_item_desc.t, 'i, 'o) View.t + +val strmodtype'const : (Module_type_declaration.t, 'i, 'o) View.t -> (Structure_item.t, 'i, 'o) View.t + +val pstr_open'const : (Open_declaration.t, 'i, 'o) View.t -> (Structure_item_desc.t, 'i, 'o) View.t + +val stropen'const : (Open_declaration.t, 'i, 'o) View.t -> (Structure_item.t, 'i, 'o) View.t + +val pstr_class'const : (Class_declaration.t list, 'i, 'o) View.t -> (Structure_item_desc.t, 'i, 'o) View.t + +val strclass'const : (Class_declaration.t list, 'i, 'o) View.t -> (Structure_item.t, 'i, 'o) View.t + +val pstr_class_type'const : (Class_type_declaration.t list, 'i, 'o) View.t -> (Structure_item_desc.t, 'i, 'o) View.t + +val strclass_type'const : (Class_type_declaration.t list, 'i, 'o) View.t -> (Structure_item.t, 'i, 'o) View.t + +val pstr_include'const : (Include_declaration.t, 'i, 'o) View.t -> (Structure_item_desc.t, 'i, 'o) View.t + +val strinclude'const : (Include_declaration.t, 'i, 'o) View.t -> (Structure_item.t, 'i, 'o) View.t + +val pstr_attribute'const : (Attribute.t, 'i, 'o) View.t -> (Structure_item_desc.t, 'i, 'o) View.t + +val strattribute'const : (Attribute.t, 'i, 'o) View.t -> (Structure_item.t, 'i, 'o) View.t + +val pstr_extension'const : ((Extension.t * Attributes.t), 'i, 'o) View.t -> (Structure_item_desc.t, 'i, 'o) View.t + +val strextension'const : ((Extension.t * Attributes.t), 'i, 'o) View.t -> (Structure_item.t, 'i, 'o) View.t + +val pvb_pat'match : (Pattern.t, 'i, 'o) View.t -> (Value_binding.t, 'i, 'o) View.t + +val pvb_expr'match : (Expression.t, 'i, 'o) View.t -> (Value_binding.t, 'i, 'o) View.t + +val pvb_attributes'match : (Attributes.t, 'i, 'o) View.t -> (Value_binding.t, 'i, 'o) View.t + +val pvb_loc'match : (Astlib.Location.t, 'i, 'o) View.t -> (Value_binding.t, 'i, 'o) View.t + +val pmb_name'match : (string Astlib.Loc.t, 'i, 'o) View.t -> (Module_binding.t, 'i, 'o) View.t + +val pmb_expr'match : (Module_expr.t, 'i, 'o) View.t -> (Module_binding.t, 'i, 'o) View.t + +val pmb_attributes'match : (Attributes.t, 'i, 'o) View.t -> (Module_binding.t, 'i, 'o) View.t + +val pmb_loc'match : (Astlib.Location.t, 'i, 'o) View.t -> (Module_binding.t, 'i, 'o) View.t + +val ptop_def'const : (Structure.t, 'i, 'o) View.t -> (Toplevel_phrase.t, 'i, 'o) View.t + +val ptop_dir'const : (Toplevel_directive.t, 'i, 'o) View.t -> (Toplevel_phrase.t, 'i, 'o) View.t + +val pdir_name'match : (string Astlib.Loc.t, 'i, 'o) View.t -> (Toplevel_directive.t, 'i, 'o) View.t + +val pdir_arg'match : (Directive_argument.t option, 'i, 'o) View.t -> (Toplevel_directive.t, 'i, 'o) View.t + +val pdir_loc'match : (Astlib.Location.t, 'i, 'o) View.t -> (Toplevel_directive.t, 'i, 'o) View.t + +val pdira_desc'match : (Directive_argument_desc.t, 'i, 'o) View.t -> (Directive_argument.t, 'i, 'o) View.t + +val pdira_loc'match : (Astlib.Location.t, 'i, 'o) View.t -> (Directive_argument.t, 'i, 'o) View.t + +val pdir_string'const : (string, 'i, 'o) View.t -> (Directive_argument_desc.t, 'i, 'o) View.t + +val dastring'const : (string, 'i, 'o) View.t -> (Directive_argument.t, 'i, 'o) View.t + +val pdir_int'const : ((string * char option), 'i, 'o) View.t -> (Directive_argument_desc.t, 'i, 'o) View.t + +val daint'const : ((string * char option), 'i, 'o) View.t -> (Directive_argument.t, 'i, 'o) View.t + +val pdir_ident'const : (Longident.t, 'i, 'o) View.t -> (Directive_argument_desc.t, 'i, 'o) View.t + +val daident'const : (Longident.t, 'i, 'o) View.t -> (Directive_argument.t, 'i, 'o) View.t + +val pdir_bool'const : (bool, 'i, 'o) View.t -> (Directive_argument_desc.t, 'i, 'o) View.t + +val dabool'const : (bool, 'i, 'o) View.t -> (Directive_argument.t, 'i, 'o) View.t +(*$*) diff --git a/ast/virtual_traverse.ml b/ast/virtual_traverse.ml index 95ac5c87..70fdb667 100644 --- a/ast/virtual_traverse.ml +++ b/ast/virtual_traverse.ml @@ -1,2 +1,3 @@ +module V4_08 = Virtual_traverse_v4_08 module V4_07 = Virtual_traverse_v4_07 module Unstable_for_testing = Virtual_traverse_unstable_for_testing diff --git a/ast/virtual_traverse.mli b/ast/virtual_traverse.mli index 95ac5c87..70fdb667 100644 --- a/ast/virtual_traverse.mli +++ b/ast/virtual_traverse.mli @@ -1,2 +1,3 @@ +module V4_08 = Virtual_traverse_v4_08 module V4_07 = Virtual_traverse_v4_07 module Unstable_for_testing = Virtual_traverse_unstable_for_testing diff --git a/ast/virtual_traverse_v4_08.ml b/ast/virtual_traverse_v4_08.ml new file mode 100644 index 00000000..11a60565 --- /dev/null +++ b/ast/virtual_traverse_v4_08.ml @@ -0,0 +1,6319 @@ +open Unversioned.Types +(*$ Ppx_ast_cinaps.print_virtual_traverse_ml (Astlib.Version.of_string "v4_07") *) +open Versions.V4_07 + +class virtual map = + object (self) + method virtual bool : bool -> bool + method virtual char : char -> char + method virtual int : int -> int + method virtual list : 'a . ('a -> 'a) -> 'a list -> 'a list + method virtual option : 'a . ('a -> 'a) -> 'a option -> 'a option + method virtual string : string -> string + method virtual location : Astlib.Location.t -> Astlib.Location.t + method virtual loc : 'a . ('a -> 'a) -> 'a Astlib.Loc.t -> 'a Astlib.Loc.t + method longident : Longident.t -> Longident.t = + fun longident -> + let concrete = Longident.to_concrete longident in + match (concrete : Longident.concrete) with + | Lident x0 -> + let x0 = self#string x0 in + Longident.of_concrete (Lident x0) + | Ldot (x0, x1) -> + let x0 = self#longident x0 in + let x1 = self#string x1 in + Longident.of_concrete (Ldot (x0, x1)) + | Lapply (x0, x1) -> + let x0 = self#longident x0 in + let x1 = self#longident x1 in + Longident.of_concrete (Lapply (x0, x1)) + method longident_loc : Longident_loc.t -> Longident_loc.t = + fun longident_loc -> + let concrete = Longident_loc.to_concrete longident_loc in + let concrete = self#loc self#longident concrete in + Longident_loc.of_concrete concrete + method rec_flag : Rec_flag.t -> Rec_flag.t = + fun rec_flag -> + let concrete = Rec_flag.to_concrete rec_flag in + match (concrete : Rec_flag.concrete) with + | Nonrecursive -> + Rec_flag.of_concrete Nonrecursive + | Recursive -> + Rec_flag.of_concrete Recursive + method direction_flag : Direction_flag.t -> Direction_flag.t = + fun direction_flag -> + let concrete = Direction_flag.to_concrete direction_flag in + match (concrete : Direction_flag.concrete) with + | Upto -> + Direction_flag.of_concrete Upto + | Downto -> + Direction_flag.of_concrete Downto + method private_flag : Private_flag.t -> Private_flag.t = + fun private_flag -> + let concrete = Private_flag.to_concrete private_flag in + match (concrete : Private_flag.concrete) with + | Private -> + Private_flag.of_concrete Private + | Public -> + Private_flag.of_concrete Public + method mutable_flag : Mutable_flag.t -> Mutable_flag.t = + fun mutable_flag -> + let concrete = Mutable_flag.to_concrete mutable_flag in + match (concrete : Mutable_flag.concrete) with + | Immutable -> + Mutable_flag.of_concrete Immutable + | Mutable -> + Mutable_flag.of_concrete Mutable + method virtual_flag : Virtual_flag.t -> Virtual_flag.t = + fun virtual_flag -> + let concrete = Virtual_flag.to_concrete virtual_flag in + match (concrete : Virtual_flag.concrete) with + | Virtual -> + Virtual_flag.of_concrete Virtual + | Concrete -> + Virtual_flag.of_concrete Concrete + method override_flag : Override_flag.t -> Override_flag.t = + fun override_flag -> + let concrete = Override_flag.to_concrete override_flag in + match (concrete : Override_flag.concrete) with + | Override -> + Override_flag.of_concrete Override + | Fresh -> + Override_flag.of_concrete Fresh + method closed_flag : Closed_flag.t -> Closed_flag.t = + fun closed_flag -> + let concrete = Closed_flag.to_concrete closed_flag in + match (concrete : Closed_flag.concrete) with + | Closed -> + Closed_flag.of_concrete Closed + | Open -> + Closed_flag.of_concrete Open + method arg_label : Arg_label.t -> Arg_label.t = + fun arg_label -> + let concrete = Arg_label.to_concrete arg_label in + match (concrete : Arg_label.concrete) with + | Nolabel -> + Arg_label.of_concrete Nolabel + | Labelled x0 -> + let x0 = self#string x0 in + Arg_label.of_concrete (Labelled x0) + | Optional x0 -> + let x0 = self#string x0 in + Arg_label.of_concrete (Optional x0) + method variance : Variance.t -> Variance.t = + fun variance -> + let concrete = Variance.to_concrete variance in + match (concrete : Variance.concrete) with + | Covariant -> + Variance.of_concrete Covariant + | Contravariant -> + Variance.of_concrete Contravariant + | Invariant -> + Variance.of_concrete Invariant + method constant : Constant.t -> Constant.t = + fun constant -> + let concrete = Constant.to_concrete constant in + match (concrete : Constant.concrete) with + | Pconst_integer (x0, x1) -> + let x0 = self#string x0 in + let x1 = self#option self#char x1 in + Constant.of_concrete (Pconst_integer (x0, x1)) + | Pconst_char x0 -> + let x0 = self#char x0 in + Constant.of_concrete (Pconst_char x0) + | Pconst_string (x0, x1) -> + let x0 = self#string x0 in + let x1 = self#option self#string x1 in + Constant.of_concrete (Pconst_string (x0, x1)) + | Pconst_float (x0, x1) -> + let x0 = self#string x0 in + let x1 = self#option self#char x1 in + Constant.of_concrete (Pconst_float (x0, x1)) + method attribute : Attribute.t -> Attribute.t = + fun attribute -> + let concrete = Attribute.to_concrete attribute in + let (x0, x1) = concrete in + let x0 = self#loc self#string x0 in + let x1 = self#payload x1 in + Attribute.of_concrete (x0, x1) + method extension : Extension.t -> Extension.t = + fun extension -> + let concrete = Extension.to_concrete extension in + let (x0, x1) = concrete in + let x0 = self#loc self#string x0 in + let x1 = self#payload x1 in + Extension.of_concrete (x0, x1) + method attributes : Attributes.t -> Attributes.t = + fun attributes -> + let concrete = Attributes.to_concrete attributes in + let concrete = self#list self#attribute concrete in + Attributes.of_concrete concrete + method payload : Payload.t -> Payload.t = + fun payload -> + let concrete = Payload.to_concrete payload in + match (concrete : Payload.concrete) with + | PStr x0 -> + let x0 = self#structure x0 in + Payload.of_concrete (PStr x0) + | PSig x0 -> + let x0 = self#signature x0 in + Payload.of_concrete (PSig x0) + | PTyp x0 -> + let x0 = self#core_type x0 in + Payload.of_concrete (PTyp x0) + | PPat (x0, x1) -> + let x0 = self#pattern x0 in + let x1 = self#option self#expression x1 in + Payload.of_concrete (PPat (x0, x1)) + method core_type : Core_type.t -> Core_type.t = + fun core_type -> + let concrete = Core_type.to_concrete core_type in + let { ptyp_desc; ptyp_loc; ptyp_attributes } : Core_type.concrete = concrete in + 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 + Core_type.of_concrete { ptyp_desc; ptyp_loc; ptyp_attributes } + method core_type_desc : Core_type_desc.t -> Core_type_desc.t = + fun core_type_desc -> + let concrete = Core_type_desc.to_concrete core_type_desc in + match (concrete : Core_type_desc.concrete) with + | Ptyp_any -> + Core_type_desc.of_concrete Ptyp_any + | Ptyp_var x0 -> + let x0 = self#string x0 in + Core_type_desc.of_concrete (Ptyp_var x0) + | Ptyp_arrow (x0, x1, x2) -> + let x0 = self#arg_label x0 in + let x1 = self#core_type x1 in + let x2 = self#core_type x2 in + Core_type_desc.of_concrete (Ptyp_arrow (x0, x1, x2)) + | Ptyp_tuple x0 -> + let x0 = self#list self#core_type x0 in + Core_type_desc.of_concrete (Ptyp_tuple x0) + | Ptyp_constr (x0, x1) -> + let x0 = self#longident_loc x0 in + let x1 = self#list self#core_type x1 in + Core_type_desc.of_concrete (Ptyp_constr (x0, x1)) + | Ptyp_object (x0, x1) -> + let x0 = self#list self#object_field x0 in + let x1 = self#closed_flag x1 in + Core_type_desc.of_concrete (Ptyp_object (x0, x1)) + | Ptyp_class (x0, x1) -> + let x0 = self#longident_loc x0 in + let x1 = self#list self#core_type x1 in + Core_type_desc.of_concrete (Ptyp_class (x0, x1)) + | Ptyp_alias (x0, x1) -> + let x0 = self#core_type x0 in + let x1 = self#string x1 in + Core_type_desc.of_concrete (Ptyp_alias (x0, x1)) + | Ptyp_variant (x0, x1, x2) -> + let x0 = self#list self#row_field x0 in + let x1 = self#closed_flag x1 in + let x2 = self#option (self#list self#string) x2 in + Core_type_desc.of_concrete (Ptyp_variant (x0, x1, x2)) + | Ptyp_poly (x0, x1) -> + let x0 = self#list (self#loc self#string) x0 in + let x1 = self#core_type x1 in + Core_type_desc.of_concrete (Ptyp_poly (x0, x1)) + | Ptyp_package x0 -> + let x0 = self#package_type x0 in + Core_type_desc.of_concrete (Ptyp_package x0) + | Ptyp_extension x0 -> + let x0 = self#extension x0 in + Core_type_desc.of_concrete (Ptyp_extension x0) + method package_type : Package_type.t -> Package_type.t = + fun package_type -> + let concrete = Package_type.to_concrete package_type in + let (x0, x1) = concrete in + let x0 = self#longident_loc x0 in + let x1 = self#list (fun (x0, x1) -> let x0 = self#longident_loc x0 in let x1 = self#core_type x1 in (x0, x1)) x1 in + Package_type.of_concrete (x0, x1) + method row_field : Row_field.t -> Row_field.t = + fun row_field -> + let concrete = Row_field.to_concrete row_field in + match (concrete : Row_field.concrete) with + | Rtag (x0, x1, x2, x3) -> + let x0 = self#loc self#string x0 in + let x1 = self#attributes x1 in + let x2 = self#bool x2 in + let x3 = self#list self#core_type x3 in + Row_field.of_concrete (Rtag (x0, x1, x2, x3)) + | Rinherit x0 -> + let x0 = self#core_type x0 in + Row_field.of_concrete (Rinherit x0) + method object_field : Object_field.t -> Object_field.t = + fun object_field -> + let concrete = Object_field.to_concrete object_field in + match (concrete : Object_field.concrete) with + | Otag (x0, x1, x2) -> + let x0 = self#loc self#string x0 in + let x1 = self#attributes x1 in + let x2 = self#core_type x2 in + Object_field.of_concrete (Otag (x0, x1, x2)) + | Oinherit x0 -> + let x0 = self#core_type x0 in + Object_field.of_concrete (Oinherit x0) + method pattern : Pattern.t -> Pattern.t = + fun pattern -> + let concrete = Pattern.to_concrete pattern in + let { ppat_desc; ppat_loc; ppat_attributes } : Pattern.concrete = concrete in + 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 + Pattern.of_concrete { ppat_desc; ppat_loc; ppat_attributes } + method pattern_desc : Pattern_desc.t -> Pattern_desc.t = + fun pattern_desc -> + let concrete = Pattern_desc.to_concrete pattern_desc in + match (concrete : Pattern_desc.concrete) with + | Ppat_any -> + Pattern_desc.of_concrete Ppat_any + | Ppat_var x0 -> + let x0 = self#loc self#string x0 in + Pattern_desc.of_concrete (Ppat_var x0) + | Ppat_alias (x0, x1) -> + let x0 = self#pattern x0 in + let x1 = self#loc self#string x1 in + Pattern_desc.of_concrete (Ppat_alias (x0, x1)) + | Ppat_constant x0 -> + let x0 = self#constant x0 in + Pattern_desc.of_concrete (Ppat_constant x0) + | Ppat_interval (x0, x1) -> + let x0 = self#constant x0 in + let x1 = self#constant x1 in + Pattern_desc.of_concrete (Ppat_interval (x0, x1)) + | Ppat_tuple x0 -> + let x0 = self#list self#pattern x0 in + Pattern_desc.of_concrete (Ppat_tuple x0) + | Ppat_construct (x0, x1) -> + let x0 = self#longident_loc x0 in + let x1 = self#option self#pattern x1 in + Pattern_desc.of_concrete (Ppat_construct (x0, x1)) + | Ppat_variant (x0, x1) -> + let x0 = self#string x0 in + let x1 = self#option self#pattern x1 in + Pattern_desc.of_concrete (Ppat_variant (x0, x1)) + | Ppat_record (x0, x1) -> + let x0 = self#list (fun (x0, x1) -> let x0 = self#longident_loc x0 in let x1 = self#pattern x1 in (x0, x1)) x0 in + let x1 = self#closed_flag x1 in + Pattern_desc.of_concrete (Ppat_record (x0, x1)) + | Ppat_array x0 -> + let x0 = self#list self#pattern x0 in + Pattern_desc.of_concrete (Ppat_array x0) + | Ppat_or (x0, x1) -> + let x0 = self#pattern x0 in + let x1 = self#pattern x1 in + Pattern_desc.of_concrete (Ppat_or (x0, x1)) + | Ppat_constraint (x0, x1) -> + let x0 = self#pattern x0 in + let x1 = self#core_type x1 in + Pattern_desc.of_concrete (Ppat_constraint (x0, x1)) + | Ppat_type x0 -> + let x0 = self#longident_loc x0 in + Pattern_desc.of_concrete (Ppat_type x0) + | Ppat_lazy x0 -> + let x0 = self#pattern x0 in + Pattern_desc.of_concrete (Ppat_lazy x0) + | Ppat_unpack x0 -> + let x0 = self#loc self#string x0 in + Pattern_desc.of_concrete (Ppat_unpack x0) + | Ppat_exception x0 -> + let x0 = self#pattern x0 in + Pattern_desc.of_concrete (Ppat_exception x0) + | Ppat_extension x0 -> + let x0 = self#extension x0 in + Pattern_desc.of_concrete (Ppat_extension x0) + | Ppat_open (x0, x1) -> + let x0 = self#longident_loc x0 in + let x1 = self#pattern x1 in + Pattern_desc.of_concrete (Ppat_open (x0, x1)) + method expression : Expression.t -> Expression.t = + fun expression -> + let concrete = Expression.to_concrete expression in + let { pexp_desc; pexp_loc; pexp_attributes } : Expression.concrete = concrete in + 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 + Expression.of_concrete { pexp_desc; pexp_loc; pexp_attributes } + method expression_desc : Expression_desc.t -> Expression_desc.t = + fun expression_desc -> + let concrete = Expression_desc.to_concrete expression_desc in + match (concrete : Expression_desc.concrete) with + | Pexp_ident x0 -> + let x0 = self#longident_loc x0 in + Expression_desc.of_concrete (Pexp_ident x0) + | Pexp_constant x0 -> + let x0 = self#constant x0 in + Expression_desc.of_concrete (Pexp_constant x0) + | Pexp_let (x0, x1, x2) -> + let x0 = self#rec_flag x0 in + let x1 = self#list self#value_binding x1 in + let x2 = self#expression x2 in + Expression_desc.of_concrete (Pexp_let (x0, x1, x2)) + | Pexp_function x0 -> + let x0 = self#list self#case x0 in + Expression_desc.of_concrete (Pexp_function x0) + | Pexp_fun (x0, x1, x2, x3) -> + let x0 = self#arg_label x0 in + let x1 = self#option self#expression x1 in + let x2 = self#pattern x2 in + let x3 = self#expression x3 in + Expression_desc.of_concrete (Pexp_fun (x0, x1, x2, x3)) + | Pexp_apply (x0, x1) -> + let x0 = self#expression x0 in + let x1 = self#list (fun (x0, x1) -> let x0 = self#arg_label x0 in let x1 = self#expression x1 in (x0, x1)) x1 in + Expression_desc.of_concrete (Pexp_apply (x0, x1)) + | Pexp_match (x0, x1) -> + let x0 = self#expression x0 in + let x1 = self#list self#case x1 in + Expression_desc.of_concrete (Pexp_match (x0, x1)) + | Pexp_try (x0, x1) -> + let x0 = self#expression x0 in + let x1 = self#list self#case x1 in + Expression_desc.of_concrete (Pexp_try (x0, x1)) + | Pexp_tuple x0 -> + let x0 = self#list self#expression x0 in + Expression_desc.of_concrete (Pexp_tuple x0) + | Pexp_construct (x0, x1) -> + let x0 = self#longident_loc x0 in + let x1 = self#option self#expression x1 in + Expression_desc.of_concrete (Pexp_construct (x0, x1)) + | Pexp_variant (x0, x1) -> + let x0 = self#string x0 in + let x1 = self#option self#expression x1 in + Expression_desc.of_concrete (Pexp_variant (x0, x1)) + | Pexp_record (x0, x1) -> + let x0 = self#list (fun (x0, x1) -> let x0 = self#longident_loc x0 in let x1 = self#expression x1 in (x0, x1)) x0 in + let x1 = self#option self#expression x1 in + Expression_desc.of_concrete (Pexp_record (x0, x1)) + | Pexp_field (x0, x1) -> + let x0 = self#expression x0 in + let x1 = self#longident_loc x1 in + Expression_desc.of_concrete (Pexp_field (x0, x1)) + | Pexp_setfield (x0, x1, x2) -> + let x0 = self#expression x0 in + let x1 = self#longident_loc x1 in + let x2 = self#expression x2 in + Expression_desc.of_concrete (Pexp_setfield (x0, x1, x2)) + | Pexp_array x0 -> + let x0 = self#list self#expression x0 in + Expression_desc.of_concrete (Pexp_array x0) + | Pexp_ifthenelse (x0, x1, x2) -> + let x0 = self#expression x0 in + let x1 = self#expression x1 in + let x2 = self#option self#expression x2 in + Expression_desc.of_concrete (Pexp_ifthenelse (x0, x1, x2)) + | Pexp_sequence (x0, x1) -> + let x0 = self#expression x0 in + let x1 = self#expression x1 in + Expression_desc.of_concrete (Pexp_sequence (x0, x1)) + | Pexp_while (x0, x1) -> + let x0 = self#expression x0 in + let x1 = self#expression x1 in + Expression_desc.of_concrete (Pexp_while (x0, x1)) + | Pexp_for (x0, x1, x2, x3, x4) -> + let x0 = self#pattern x0 in + let x1 = self#expression x1 in + let x2 = self#expression x2 in + let x3 = self#direction_flag x3 in + let x4 = self#expression x4 in + Expression_desc.of_concrete (Pexp_for (x0, x1, x2, x3, x4)) + | Pexp_constraint (x0, x1) -> + let x0 = self#expression x0 in + let x1 = self#core_type x1 in + Expression_desc.of_concrete (Pexp_constraint (x0, x1)) + | Pexp_coerce (x0, x1, x2) -> + let x0 = self#expression x0 in + let x1 = self#option self#core_type x1 in + let x2 = self#core_type x2 in + Expression_desc.of_concrete (Pexp_coerce (x0, x1, x2)) + | Pexp_send (x0, x1) -> + let x0 = self#expression x0 in + let x1 = self#loc self#string x1 in + Expression_desc.of_concrete (Pexp_send (x0, x1)) + | Pexp_new x0 -> + let x0 = self#longident_loc x0 in + Expression_desc.of_concrete (Pexp_new x0) + | Pexp_setinstvar (x0, x1) -> + let x0 = self#loc self#string x0 in + let x1 = self#expression x1 in + Expression_desc.of_concrete (Pexp_setinstvar (x0, x1)) + | Pexp_override x0 -> + let x0 = self#list (fun (x0, x1) -> let x0 = self#loc self#string x0 in let x1 = self#expression x1 in (x0, x1)) x0 in + Expression_desc.of_concrete (Pexp_override x0) + | Pexp_letmodule (x0, x1, x2) -> + let x0 = self#loc self#string x0 in + let x1 = self#module_expr x1 in + let x2 = self#expression x2 in + Expression_desc.of_concrete (Pexp_letmodule (x0, x1, x2)) + | Pexp_letexception (x0, x1) -> + let x0 = self#extension_constructor x0 in + let x1 = self#expression x1 in + Expression_desc.of_concrete (Pexp_letexception (x0, x1)) + | Pexp_assert x0 -> + let x0 = self#expression x0 in + Expression_desc.of_concrete (Pexp_assert x0) + | Pexp_lazy x0 -> + let x0 = self#expression x0 in + Expression_desc.of_concrete (Pexp_lazy x0) + | Pexp_poly (x0, x1) -> + let x0 = self#expression x0 in + let x1 = self#option self#core_type x1 in + Expression_desc.of_concrete (Pexp_poly (x0, x1)) + | Pexp_object x0 -> + let x0 = self#class_structure x0 in + Expression_desc.of_concrete (Pexp_object x0) + | Pexp_newtype (x0, x1) -> + let x0 = self#loc self#string x0 in + let x1 = self#expression x1 in + Expression_desc.of_concrete (Pexp_newtype (x0, x1)) + | Pexp_pack x0 -> + let x0 = self#module_expr x0 in + Expression_desc.of_concrete (Pexp_pack x0) + | Pexp_open (x0, x1, x2) -> + let x0 = self#override_flag x0 in + let x1 = self#longident_loc x1 in + let x2 = self#expression x2 in + Expression_desc.of_concrete (Pexp_open (x0, x1, x2)) + | Pexp_extension x0 -> + let x0 = self#extension x0 in + Expression_desc.of_concrete (Pexp_extension x0) + | Pexp_unreachable -> + Expression_desc.of_concrete Pexp_unreachable + method case : Case.t -> Case.t = + fun case -> + let concrete = Case.to_concrete case in + let { pc_lhs; pc_guard; pc_rhs } : Case.concrete = concrete in + 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 + Case.of_concrete { pc_lhs; pc_guard; pc_rhs } + method value_description : Value_description.t -> Value_description.t = + fun value_description -> + let concrete = Value_description.to_concrete value_description in + let { pval_name; pval_type; pval_prim; pval_attributes; pval_loc } : Value_description.concrete = concrete in + 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 + Value_description.of_concrete { pval_name; pval_type; pval_prim; pval_attributes; pval_loc } + method type_declaration : Type_declaration.t -> Type_declaration.t = + fun type_declaration -> + let concrete = Type_declaration.to_concrete type_declaration in + let { ptype_name; ptype_params; ptype_cstrs; ptype_kind; ptype_private; ptype_manifest; ptype_attributes; ptype_loc } : Type_declaration.concrete = concrete in + let ptype_name = self#loc self#string ptype_name in + let ptype_params = self#list (fun (x0, x1) -> let x0 = self#core_type x0 in let x1 = self#variance x1 in (x0, x1)) ptype_params in + let ptype_cstrs = self#list (fun (x0, x1, x2) -> let x0 = self#core_type x0 in let x1 = self#core_type x1 in let x2 = self#location x2 in (x0, x1, x2)) 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 + Type_declaration.of_concrete { ptype_name; ptype_params; ptype_cstrs; ptype_kind; ptype_private; ptype_manifest; ptype_attributes; ptype_loc } + method type_kind : Type_kind.t -> Type_kind.t = + fun type_kind -> + let concrete = Type_kind.to_concrete type_kind in + match (concrete : Type_kind.concrete) with + | Ptype_abstract -> + Type_kind.of_concrete Ptype_abstract + | Ptype_variant x0 -> + let x0 = self#list self#constructor_declaration x0 in + Type_kind.of_concrete (Ptype_variant x0) + | Ptype_record x0 -> + let x0 = self#list self#label_declaration x0 in + Type_kind.of_concrete (Ptype_record x0) + | Ptype_open -> + Type_kind.of_concrete Ptype_open + method label_declaration : Label_declaration.t -> Label_declaration.t = + fun label_declaration -> + let concrete = Label_declaration.to_concrete label_declaration in + let { pld_name; pld_mutable; pld_type; pld_loc; pld_attributes } : Label_declaration.concrete = concrete in + 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 + Label_declaration.of_concrete { pld_name; pld_mutable; pld_type; pld_loc; pld_attributes } + method constructor_declaration : Constructor_declaration.t -> Constructor_declaration.t = + fun constructor_declaration -> + let concrete = Constructor_declaration.to_concrete constructor_declaration in + let { pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes } : Constructor_declaration.concrete = concrete in + 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 + Constructor_declaration.of_concrete { pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes } + method constructor_arguments : Constructor_arguments.t -> Constructor_arguments.t = + fun constructor_arguments -> + let concrete = Constructor_arguments.to_concrete constructor_arguments in + match (concrete : Constructor_arguments.concrete) with + | Pcstr_tuple x0 -> + let x0 = self#list self#core_type x0 in + Constructor_arguments.of_concrete (Pcstr_tuple x0) + | Pcstr_record x0 -> + let x0 = self#list self#label_declaration x0 in + Constructor_arguments.of_concrete (Pcstr_record x0) + method type_extension : Type_extension.t -> Type_extension.t = + fun type_extension -> + let concrete = Type_extension.to_concrete type_extension in + let { ptyext_path; ptyext_params; ptyext_constructors; ptyext_private; ptyext_attributes } : Type_extension.concrete = concrete in + let ptyext_path = self#longident_loc ptyext_path in + let ptyext_params = self#list (fun (x0, x1) -> let x0 = self#core_type x0 in let x1 = self#variance x1 in (x0, x1)) 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 + Type_extension.of_concrete { ptyext_path; ptyext_params; ptyext_constructors; ptyext_private; ptyext_attributes } + method extension_constructor : Extension_constructor.t -> Extension_constructor.t = + fun extension_constructor -> + let concrete = Extension_constructor.to_concrete extension_constructor in + let { pext_name; pext_kind; pext_loc; pext_attributes } : Extension_constructor.concrete = concrete in + 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 + Extension_constructor.of_concrete { pext_name; pext_kind; pext_loc; pext_attributes } + method extension_constructor_kind : Extension_constructor_kind.t -> Extension_constructor_kind.t = + fun extension_constructor_kind -> + let concrete = Extension_constructor_kind.to_concrete extension_constructor_kind in + match (concrete : Extension_constructor_kind.concrete) with + | Pext_decl (x0, x1) -> + let x0 = self#constructor_arguments x0 in + let x1 = self#option self#core_type x1 in + Extension_constructor_kind.of_concrete (Pext_decl (x0, x1)) + | Pext_rebind x0 -> + let x0 = self#longident_loc x0 in + Extension_constructor_kind.of_concrete (Pext_rebind x0) + method class_type : Class_type.t -> Class_type.t = + fun class_type -> + let concrete = Class_type.to_concrete class_type in + let { pcty_desc; pcty_loc; pcty_attributes } : Class_type.concrete = concrete in + 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 + Class_type.of_concrete { pcty_desc; pcty_loc; pcty_attributes } + method class_type_desc : Class_type_desc.t -> Class_type_desc.t = + fun class_type_desc -> + let concrete = Class_type_desc.to_concrete class_type_desc in + match (concrete : Class_type_desc.concrete) with + | Pcty_constr (x0, x1) -> + let x0 = self#longident_loc x0 in + let x1 = self#list self#core_type x1 in + Class_type_desc.of_concrete (Pcty_constr (x0, x1)) + | Pcty_signature x0 -> + let x0 = self#class_signature x0 in + Class_type_desc.of_concrete (Pcty_signature x0) + | Pcty_arrow (x0, x1, x2) -> + let x0 = self#arg_label x0 in + let x1 = self#core_type x1 in + let x2 = self#class_type x2 in + Class_type_desc.of_concrete (Pcty_arrow (x0, x1, x2)) + | Pcty_extension x0 -> + let x0 = self#extension x0 in + Class_type_desc.of_concrete (Pcty_extension x0) + | Pcty_open (x0, x1, x2) -> + let x0 = self#override_flag x0 in + let x1 = self#longident_loc x1 in + let x2 = self#class_type x2 in + Class_type_desc.of_concrete (Pcty_open (x0, x1, x2)) + method class_signature : Class_signature.t -> Class_signature.t = + fun class_signature -> + let concrete = Class_signature.to_concrete class_signature in + let { pcsig_self; pcsig_fields } : Class_signature.concrete = concrete in + let pcsig_self = self#core_type pcsig_self in + let pcsig_fields = self#list self#class_type_field pcsig_fields in + Class_signature.of_concrete { pcsig_self; pcsig_fields } + method class_type_field : Class_type_field.t -> Class_type_field.t = + fun class_type_field -> + let concrete = Class_type_field.to_concrete class_type_field in + let { pctf_desc; pctf_loc; pctf_attributes } : Class_type_field.concrete = concrete in + 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 + Class_type_field.of_concrete { pctf_desc; pctf_loc; pctf_attributes } + method class_type_field_desc : Class_type_field_desc.t -> Class_type_field_desc.t = + fun class_type_field_desc -> + let concrete = Class_type_field_desc.to_concrete class_type_field_desc in + match (concrete : Class_type_field_desc.concrete) with + | Pctf_inherit x0 -> + let x0 = self#class_type x0 in + Class_type_field_desc.of_concrete (Pctf_inherit x0) + | Pctf_val x0 -> + let x0 = (fun (x0, x1, x2, x3) -> let x0 = self#loc self#string x0 in let x1 = self#mutable_flag x1 in let x2 = self#virtual_flag x2 in let x3 = self#core_type x3 in (x0, x1, x2, x3)) x0 in + Class_type_field_desc.of_concrete (Pctf_val x0) + | Pctf_method x0 -> + let x0 = (fun (x0, x1, x2, x3) -> let x0 = self#loc self#string x0 in let x1 = self#private_flag x1 in let x2 = self#virtual_flag x2 in let x3 = self#core_type x3 in (x0, x1, x2, x3)) x0 in + Class_type_field_desc.of_concrete (Pctf_method x0) + | Pctf_constraint x0 -> + let x0 = (fun (x0, x1) -> let x0 = self#core_type x0 in let x1 = self#core_type x1 in (x0, x1)) x0 in + Class_type_field_desc.of_concrete (Pctf_constraint x0) + | Pctf_attribute x0 -> + let x0 = self#attribute x0 in + Class_type_field_desc.of_concrete (Pctf_attribute x0) + | Pctf_extension x0 -> + let x0 = self#extension x0 in + Class_type_field_desc.of_concrete (Pctf_extension x0) + method class_infos : 'a . ('a node -> 'a node) -> 'a node Class_infos.t -> 'a node Class_infos.t = + fun fa class_infos -> + let concrete = Class_infos.to_concrete class_infos in + let { pci_virt; pci_params; pci_name; pci_expr; pci_loc; pci_attributes } : _ Class_infos.concrete = concrete in + let pci_virt = self#virtual_flag pci_virt in + let pci_params = self#list (fun (x0, x1) -> let x0 = self#core_type x0 in let x1 = self#variance x1 in (x0, x1)) pci_params in + let pci_name = self#loc self#string pci_name in + let pci_expr = fa pci_expr in + let pci_loc = self#location pci_loc in + let pci_attributes = self#attributes pci_attributes in + Class_infos.of_concrete { pci_virt; pci_params; pci_name; pci_expr; pci_loc; pci_attributes } + method class_description : Class_description.t -> Class_description.t = + fun class_description -> + let concrete = Class_description.to_concrete class_description in + let concrete = self#class_infos self#class_type concrete in + Class_description.of_concrete concrete + method class_type_declaration : Class_type_declaration.t -> Class_type_declaration.t = + fun class_type_declaration -> + let concrete = Class_type_declaration.to_concrete class_type_declaration in + let concrete = self#class_infos self#class_type concrete in + Class_type_declaration.of_concrete concrete + method class_expr : Class_expr.t -> Class_expr.t = + fun class_expr -> + let concrete = Class_expr.to_concrete class_expr in + let { pcl_desc; pcl_loc; pcl_attributes } : Class_expr.concrete = concrete in + 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 + Class_expr.of_concrete { pcl_desc; pcl_loc; pcl_attributes } + method class_expr_desc : Class_expr_desc.t -> Class_expr_desc.t = + fun class_expr_desc -> + let concrete = Class_expr_desc.to_concrete class_expr_desc in + match (concrete : Class_expr_desc.concrete) with + | Pcl_constr (x0, x1) -> + let x0 = self#longident_loc x0 in + let x1 = self#list self#core_type x1 in + Class_expr_desc.of_concrete (Pcl_constr (x0, x1)) + | Pcl_structure x0 -> + let x0 = self#class_structure x0 in + Class_expr_desc.of_concrete (Pcl_structure x0) + | Pcl_fun (x0, x1, x2, x3) -> + let x0 = self#arg_label x0 in + let x1 = self#option self#expression x1 in + let x2 = self#pattern x2 in + let x3 = self#class_expr x3 in + Class_expr_desc.of_concrete (Pcl_fun (x0, x1, x2, x3)) + | Pcl_apply (x0, x1) -> + let x0 = self#class_expr x0 in + let x1 = self#list (fun (x0, x1) -> let x0 = self#arg_label x0 in let x1 = self#expression x1 in (x0, x1)) x1 in + Class_expr_desc.of_concrete (Pcl_apply (x0, x1)) + | Pcl_let (x0, x1, x2) -> + let x0 = self#rec_flag x0 in + let x1 = self#list self#value_binding x1 in + let x2 = self#class_expr x2 in + Class_expr_desc.of_concrete (Pcl_let (x0, x1, x2)) + | Pcl_constraint (x0, x1) -> + let x0 = self#class_expr x0 in + let x1 = self#class_type x1 in + Class_expr_desc.of_concrete (Pcl_constraint (x0, x1)) + | Pcl_extension x0 -> + let x0 = self#extension x0 in + Class_expr_desc.of_concrete (Pcl_extension x0) + | Pcl_open (x0, x1, x2) -> + let x0 = self#override_flag x0 in + let x1 = self#longident_loc x1 in + let x2 = self#class_expr x2 in + Class_expr_desc.of_concrete (Pcl_open (x0, x1, x2)) + method class_structure : Class_structure.t -> Class_structure.t = + fun class_structure -> + let concrete = Class_structure.to_concrete class_structure in + let { pcstr_self; pcstr_fields } : Class_structure.concrete = concrete in + let pcstr_self = self#pattern pcstr_self in + let pcstr_fields = self#list self#class_field pcstr_fields in + Class_structure.of_concrete { pcstr_self; pcstr_fields } + method class_field : Class_field.t -> Class_field.t = + fun class_field -> + let concrete = Class_field.to_concrete class_field in + let { pcf_desc; pcf_loc; pcf_attributes } : Class_field.concrete = concrete in + 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 + Class_field.of_concrete { pcf_desc; pcf_loc; pcf_attributes } + method class_field_desc : Class_field_desc.t -> Class_field_desc.t = + fun class_field_desc -> + let concrete = Class_field_desc.to_concrete class_field_desc in + match (concrete : Class_field_desc.concrete) with + | Pcf_inherit (x0, x1, x2) -> + let x0 = self#override_flag x0 in + let x1 = self#class_expr x1 in + let x2 = self#option (self#loc self#string) x2 in + Class_field_desc.of_concrete (Pcf_inherit (x0, x1, x2)) + | Pcf_val x0 -> + let x0 = (fun (x0, x1, x2) -> let x0 = self#loc self#string x0 in let x1 = self#mutable_flag x1 in let x2 = self#class_field_kind x2 in (x0, x1, x2)) x0 in + Class_field_desc.of_concrete (Pcf_val x0) + | Pcf_method x0 -> + let x0 = (fun (x0, x1, x2) -> let x0 = self#loc self#string x0 in let x1 = self#private_flag x1 in let x2 = self#class_field_kind x2 in (x0, x1, x2)) x0 in + Class_field_desc.of_concrete (Pcf_method x0) + | Pcf_constraint x0 -> + let x0 = (fun (x0, x1) -> let x0 = self#core_type x0 in let x1 = self#core_type x1 in (x0, x1)) x0 in + Class_field_desc.of_concrete (Pcf_constraint x0) + | Pcf_initializer x0 -> + let x0 = self#expression x0 in + Class_field_desc.of_concrete (Pcf_initializer x0) + | Pcf_attribute x0 -> + let x0 = self#attribute x0 in + Class_field_desc.of_concrete (Pcf_attribute x0) + | Pcf_extension x0 -> + let x0 = self#extension x0 in + Class_field_desc.of_concrete (Pcf_extension x0) + method class_field_kind : Class_field_kind.t -> Class_field_kind.t = + fun class_field_kind -> + let concrete = Class_field_kind.to_concrete class_field_kind in + match (concrete : Class_field_kind.concrete) with + | Cfk_virtual x0 -> + let x0 = self#core_type x0 in + Class_field_kind.of_concrete (Cfk_virtual x0) + | Cfk_concrete (x0, x1) -> + let x0 = self#override_flag x0 in + let x1 = self#expression x1 in + Class_field_kind.of_concrete (Cfk_concrete (x0, x1)) + method class_declaration : Class_declaration.t -> Class_declaration.t = + fun class_declaration -> + let concrete = Class_declaration.to_concrete class_declaration in + let concrete = self#class_infos self#class_expr concrete in + Class_declaration.of_concrete concrete + method module_type : Module_type.t -> Module_type.t = + fun module_type -> + let concrete = Module_type.to_concrete module_type in + let { pmty_desc; pmty_loc; pmty_attributes } : Module_type.concrete = concrete in + 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 + Module_type.of_concrete { pmty_desc; pmty_loc; pmty_attributes } + method module_type_desc : Module_type_desc.t -> Module_type_desc.t = + fun module_type_desc -> + let concrete = Module_type_desc.to_concrete module_type_desc in + match (concrete : Module_type_desc.concrete) with + | Pmty_ident x0 -> + let x0 = self#longident_loc x0 in + Module_type_desc.of_concrete (Pmty_ident x0) + | Pmty_signature x0 -> + let x0 = self#signature x0 in + Module_type_desc.of_concrete (Pmty_signature x0) + | Pmty_functor (x0, x1, x2) -> + let x0 = self#loc self#string x0 in + let x1 = self#option self#module_type x1 in + let x2 = self#module_type x2 in + Module_type_desc.of_concrete (Pmty_functor (x0, x1, x2)) + | Pmty_with (x0, x1) -> + let x0 = self#module_type x0 in + let x1 = self#list self#with_constraint x1 in + Module_type_desc.of_concrete (Pmty_with (x0, x1)) + | Pmty_typeof x0 -> + let x0 = self#module_expr x0 in + Module_type_desc.of_concrete (Pmty_typeof x0) + | Pmty_extension x0 -> + let x0 = self#extension x0 in + Module_type_desc.of_concrete (Pmty_extension x0) + | Pmty_alias x0 -> + let x0 = self#longident_loc x0 in + Module_type_desc.of_concrete (Pmty_alias x0) + method signature : Signature.t -> Signature.t = + fun signature -> + let concrete = Signature.to_concrete signature in + let concrete = self#list self#signature_item concrete in + Signature.of_concrete concrete + method signature_item : Signature_item.t -> Signature_item.t = + fun signature_item -> + let concrete = Signature_item.to_concrete signature_item in + let { psig_desc; psig_loc } : Signature_item.concrete = concrete in + let psig_desc = self#signature_item_desc psig_desc in + let psig_loc = self#location psig_loc in + Signature_item.of_concrete { psig_desc; psig_loc } + method signature_item_desc : Signature_item_desc.t -> Signature_item_desc.t = + fun signature_item_desc -> + let concrete = Signature_item_desc.to_concrete signature_item_desc in + match (concrete : Signature_item_desc.concrete) with + | Psig_value x0 -> + let x0 = self#value_description x0 in + Signature_item_desc.of_concrete (Psig_value x0) + | Psig_type (x0, x1) -> + let x0 = self#rec_flag x0 in + let x1 = self#list self#type_declaration x1 in + Signature_item_desc.of_concrete (Psig_type (x0, x1)) + | Psig_typext x0 -> + let x0 = self#type_extension x0 in + Signature_item_desc.of_concrete (Psig_typext x0) + | Psig_exception x0 -> + let x0 = self#extension_constructor x0 in + Signature_item_desc.of_concrete (Psig_exception x0) + | Psig_module x0 -> + let x0 = self#module_declaration x0 in + Signature_item_desc.of_concrete (Psig_module x0) + | Psig_recmodule x0 -> + let x0 = self#list self#module_declaration x0 in + Signature_item_desc.of_concrete (Psig_recmodule x0) + | Psig_modtype x0 -> + let x0 = self#module_type_declaration x0 in + Signature_item_desc.of_concrete (Psig_modtype x0) + | Psig_open x0 -> + let x0 = self#open_description x0 in + Signature_item_desc.of_concrete (Psig_open x0) + | Psig_include x0 -> + let x0 = self#include_description x0 in + Signature_item_desc.of_concrete (Psig_include x0) + | Psig_class x0 -> + let x0 = self#list self#class_description x0 in + Signature_item_desc.of_concrete (Psig_class x0) + | Psig_class_type x0 -> + let x0 = self#list self#class_type_declaration x0 in + Signature_item_desc.of_concrete (Psig_class_type x0) + | Psig_attribute x0 -> + let x0 = self#attribute x0 in + Signature_item_desc.of_concrete (Psig_attribute x0) + | Psig_extension (x0, x1) -> + let x0 = self#extension x0 in + let x1 = self#attributes x1 in + Signature_item_desc.of_concrete (Psig_extension (x0, x1)) + method module_declaration : Module_declaration.t -> Module_declaration.t = + fun module_declaration -> + let concrete = Module_declaration.to_concrete module_declaration in + let { pmd_name; pmd_type; pmd_attributes; pmd_loc } : Module_declaration.concrete = concrete in + 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 + Module_declaration.of_concrete { pmd_name; pmd_type; pmd_attributes; pmd_loc } + method module_type_declaration : Module_type_declaration.t -> Module_type_declaration.t = + fun module_type_declaration -> + let concrete = Module_type_declaration.to_concrete module_type_declaration in + let { pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc } : Module_type_declaration.concrete = concrete in + 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 + Module_type_declaration.of_concrete { pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc } + method open_description : Open_description.t -> Open_description.t = + fun open_description -> + let concrete = Open_description.to_concrete open_description in + let { popen_lid; popen_override; popen_loc; popen_attributes } : Open_description.concrete = concrete in + 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 + Open_description.of_concrete { popen_lid; popen_override; popen_loc; popen_attributes } + method include_infos : 'a . ('a node -> 'a node) -> 'a node Include_infos.t -> 'a node Include_infos.t = + fun fa include_infos -> + let concrete = Include_infos.to_concrete include_infos in + let { pincl_mod; pincl_loc; pincl_attributes } : _ Include_infos.concrete = concrete in + let pincl_mod = fa pincl_mod in + let pincl_loc = self#location pincl_loc in + let pincl_attributes = self#attributes pincl_attributes in + Include_infos.of_concrete { pincl_mod; pincl_loc; pincl_attributes } + method include_description : Include_description.t -> Include_description.t = + fun include_description -> + let concrete = Include_description.to_concrete include_description in + let concrete = self#include_infos self#module_type concrete in + Include_description.of_concrete concrete + method include_declaration : Include_declaration.t -> Include_declaration.t = + fun include_declaration -> + let concrete = Include_declaration.to_concrete include_declaration in + let concrete = self#include_infos self#module_expr concrete in + Include_declaration.of_concrete concrete + method with_constraint : With_constraint.t -> With_constraint.t = + fun with_constraint -> + let concrete = With_constraint.to_concrete with_constraint in + match (concrete : With_constraint.concrete) with + | Pwith_type (x0, x1) -> + let x0 = self#longident_loc x0 in + let x1 = self#type_declaration x1 in + With_constraint.of_concrete (Pwith_type (x0, x1)) + | Pwith_module (x0, x1) -> + let x0 = self#longident_loc x0 in + let x1 = self#longident_loc x1 in + With_constraint.of_concrete (Pwith_module (x0, x1)) + | Pwith_typesubst (x0, x1) -> + let x0 = self#longident_loc x0 in + let x1 = self#type_declaration x1 in + With_constraint.of_concrete (Pwith_typesubst (x0, x1)) + | Pwith_modsubst (x0, x1) -> + let x0 = self#longident_loc x0 in + let x1 = self#longident_loc x1 in + With_constraint.of_concrete (Pwith_modsubst (x0, x1)) + method module_expr : Module_expr.t -> Module_expr.t = + fun module_expr -> + let concrete = Module_expr.to_concrete module_expr in + let { pmod_desc; pmod_loc; pmod_attributes } : Module_expr.concrete = concrete in + 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 + Module_expr.of_concrete { pmod_desc; pmod_loc; pmod_attributes } + method module_expr_desc : Module_expr_desc.t -> Module_expr_desc.t = + fun module_expr_desc -> + let concrete = Module_expr_desc.to_concrete module_expr_desc in + match (concrete : Module_expr_desc.concrete) with + | Pmod_ident x0 -> + let x0 = self#longident_loc x0 in + Module_expr_desc.of_concrete (Pmod_ident x0) + | Pmod_structure x0 -> + let x0 = self#structure x0 in + Module_expr_desc.of_concrete (Pmod_structure x0) + | Pmod_functor (x0, x1, x2) -> + let x0 = self#loc self#string x0 in + let x1 = self#option self#module_type x1 in + let x2 = self#module_expr x2 in + Module_expr_desc.of_concrete (Pmod_functor (x0, x1, x2)) + | Pmod_apply (x0, x1) -> + let x0 = self#module_expr x0 in + let x1 = self#module_expr x1 in + Module_expr_desc.of_concrete (Pmod_apply (x0, x1)) + | Pmod_constraint (x0, x1) -> + let x0 = self#module_expr x0 in + let x1 = self#module_type x1 in + Module_expr_desc.of_concrete (Pmod_constraint (x0, x1)) + | Pmod_unpack x0 -> + let x0 = self#expression x0 in + Module_expr_desc.of_concrete (Pmod_unpack x0) + | Pmod_extension x0 -> + let x0 = self#extension x0 in + Module_expr_desc.of_concrete (Pmod_extension x0) + method structure : Structure.t -> Structure.t = + fun structure -> + let concrete = Structure.to_concrete structure in + let concrete = self#list self#structure_item concrete in + Structure.of_concrete concrete + method structure_item : Structure_item.t -> Structure_item.t = + fun structure_item -> + let concrete = Structure_item.to_concrete structure_item in + let { pstr_desc; pstr_loc } : Structure_item.concrete = concrete in + let pstr_desc = self#structure_item_desc pstr_desc in + let pstr_loc = self#location pstr_loc in + Structure_item.of_concrete { pstr_desc; pstr_loc } + method structure_item_desc : Structure_item_desc.t -> Structure_item_desc.t = + fun structure_item_desc -> + let concrete = Structure_item_desc.to_concrete structure_item_desc in + match (concrete : Structure_item_desc.concrete) with + | Pstr_eval (x0, x1) -> + let x0 = self#expression x0 in + let x1 = self#attributes x1 in + Structure_item_desc.of_concrete (Pstr_eval (x0, x1)) + | Pstr_value (x0, x1) -> + let x0 = self#rec_flag x0 in + let x1 = self#list self#value_binding x1 in + Structure_item_desc.of_concrete (Pstr_value (x0, x1)) + | Pstr_primitive x0 -> + let x0 = self#value_description x0 in + Structure_item_desc.of_concrete (Pstr_primitive x0) + | Pstr_type (x0, x1) -> + let x0 = self#rec_flag x0 in + let x1 = self#list self#type_declaration x1 in + Structure_item_desc.of_concrete (Pstr_type (x0, x1)) + | Pstr_typext x0 -> + let x0 = self#type_extension x0 in + Structure_item_desc.of_concrete (Pstr_typext x0) + | Pstr_exception x0 -> + let x0 = self#extension_constructor x0 in + Structure_item_desc.of_concrete (Pstr_exception x0) + | Pstr_module x0 -> + let x0 = self#module_binding x0 in + Structure_item_desc.of_concrete (Pstr_module x0) + | Pstr_recmodule x0 -> + let x0 = self#list self#module_binding x0 in + Structure_item_desc.of_concrete (Pstr_recmodule x0) + | Pstr_modtype x0 -> + let x0 = self#module_type_declaration x0 in + Structure_item_desc.of_concrete (Pstr_modtype x0) + | Pstr_open x0 -> + let x0 = self#open_description x0 in + Structure_item_desc.of_concrete (Pstr_open x0) + | Pstr_class x0 -> + let x0 = self#list self#class_declaration x0 in + Structure_item_desc.of_concrete (Pstr_class x0) + | Pstr_class_type x0 -> + let x0 = self#list self#class_type_declaration x0 in + Structure_item_desc.of_concrete (Pstr_class_type x0) + | Pstr_include x0 -> + let x0 = self#include_declaration x0 in + Structure_item_desc.of_concrete (Pstr_include x0) + | Pstr_attribute x0 -> + let x0 = self#attribute x0 in + Structure_item_desc.of_concrete (Pstr_attribute x0) + | Pstr_extension (x0, x1) -> + let x0 = self#extension x0 in + let x1 = self#attributes x1 in + Structure_item_desc.of_concrete (Pstr_extension (x0, x1)) + method value_binding : Value_binding.t -> Value_binding.t = + fun value_binding -> + let concrete = Value_binding.to_concrete value_binding in + let { pvb_pat; pvb_expr; pvb_attributes; pvb_loc } : Value_binding.concrete = concrete in + 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 + Value_binding.of_concrete { pvb_pat; pvb_expr; pvb_attributes; pvb_loc } + method module_binding : Module_binding.t -> Module_binding.t = + fun module_binding -> + let concrete = Module_binding.to_concrete module_binding in + let { pmb_name; pmb_expr; pmb_attributes; pmb_loc } : Module_binding.concrete = concrete in + 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 + Module_binding.of_concrete { pmb_name; pmb_expr; pmb_attributes; pmb_loc } + method toplevel_phrase : Toplevel_phrase.t -> Toplevel_phrase.t = + fun toplevel_phrase -> + let concrete = Toplevel_phrase.to_concrete toplevel_phrase in + match (concrete : Toplevel_phrase.concrete) with + | Ptop_def x0 -> + let x0 = self#structure x0 in + Toplevel_phrase.of_concrete (Ptop_def x0) + | Ptop_dir (x0, x1) -> + let x0 = self#string x0 in + let x1 = self#directive_argument x1 in + Toplevel_phrase.of_concrete (Ptop_dir (x0, x1)) + method directive_argument : Directive_argument.t -> Directive_argument.t = + fun directive_argument -> + let concrete = Directive_argument.to_concrete directive_argument in + match (concrete : Directive_argument.concrete) with + | Pdir_none -> + Directive_argument.of_concrete Pdir_none + | Pdir_string x0 -> + let x0 = self#string x0 in + Directive_argument.of_concrete (Pdir_string x0) + | Pdir_int (x0, x1) -> + let x0 = self#string x0 in + let x1 = self#option self#char x1 in + Directive_argument.of_concrete (Pdir_int (x0, x1)) + | Pdir_ident x0 -> + let x0 = self#longident x0 in + Directive_argument.of_concrete (Pdir_ident x0) + | Pdir_bool x0 -> + let x0 = self#bool x0 in + Directive_argument.of_concrete (Pdir_bool x0) + end + +class virtual iter = + object (self) + method virtual bool : bool -> unit + method virtual char : char -> unit + method virtual int : int -> unit + method virtual list : 'a . ('a -> unit) -> 'a list -> unit + method virtual option : 'a . ('a -> unit) -> 'a option -> unit + method virtual string : string -> unit + method virtual location : Astlib.Location.t -> unit + method virtual loc : 'a . ('a -> unit) -> 'a Astlib.Loc.t -> unit + method longident : Longident.t -> unit = + fun longident -> + let concrete = Longident.to_concrete longident in + match (concrete : Longident.concrete) with + | Lident x0 -> + self#string x0 + | Ldot (x0, x1) -> + self#longident x0; + self#string x1 + | Lapply (x0, x1) -> + self#longident x0; + self#longident x1 + method longident_loc : Longident_loc.t -> unit = + fun longident_loc -> + let concrete = Longident_loc.to_concrete longident_loc in + self#loc self#longident concrete + method rec_flag : Rec_flag.t -> unit = + fun rec_flag -> + let concrete = Rec_flag.to_concrete rec_flag in + match (concrete : Rec_flag.concrete) with + | Nonrecursive -> + () + | Recursive -> + () + method direction_flag : Direction_flag.t -> unit = + fun direction_flag -> + let concrete = Direction_flag.to_concrete direction_flag in + match (concrete : Direction_flag.concrete) with + | Upto -> + () + | Downto -> + () + method private_flag : Private_flag.t -> unit = + fun private_flag -> + let concrete = Private_flag.to_concrete private_flag in + match (concrete : Private_flag.concrete) with + | Private -> + () + | Public -> + () + method mutable_flag : Mutable_flag.t -> unit = + fun mutable_flag -> + let concrete = Mutable_flag.to_concrete mutable_flag in + match (concrete : Mutable_flag.concrete) with + | Immutable -> + () + | Mutable -> + () + method virtual_flag : Virtual_flag.t -> unit = + fun virtual_flag -> + let concrete = Virtual_flag.to_concrete virtual_flag in + match (concrete : Virtual_flag.concrete) with + | Virtual -> + () + | Concrete -> + () + method override_flag : Override_flag.t -> unit = + fun override_flag -> + let concrete = Override_flag.to_concrete override_flag in + match (concrete : Override_flag.concrete) with + | Override -> + () + | Fresh -> + () + method closed_flag : Closed_flag.t -> unit = + fun closed_flag -> + let concrete = Closed_flag.to_concrete closed_flag in + match (concrete : Closed_flag.concrete) with + | Closed -> + () + | Open -> + () + method arg_label : Arg_label.t -> unit = + fun arg_label -> + let concrete = Arg_label.to_concrete arg_label in + match (concrete : Arg_label.concrete) with + | Nolabel -> + () + | Labelled x0 -> + self#string x0 + | Optional x0 -> + self#string x0 + method variance : Variance.t -> unit = + fun variance -> + let concrete = Variance.to_concrete variance in + match (concrete : Variance.concrete) with + | Covariant -> + () + | Contravariant -> + () + | Invariant -> + () + method constant : Constant.t -> unit = + fun constant -> + let concrete = Constant.to_concrete constant in + match (concrete : Constant.concrete) with + | Pconst_integer (x0, x1) -> + self#string x0; + self#option self#char x1 + | Pconst_char x0 -> + self#char x0 + | Pconst_string (x0, x1) -> + self#string x0; + self#option self#string x1 + | Pconst_float (x0, x1) -> + self#string x0; + self#option self#char x1 + method attribute : Attribute.t -> unit = + fun attribute -> + let concrete = Attribute.to_concrete attribute in + let (x0, x1) = concrete in + self#loc self#string x0; + self#payload x1 + method extension : Extension.t -> unit = + fun extension -> + let concrete = Extension.to_concrete extension in + let (x0, x1) = concrete in + self#loc self#string x0; + self#payload x1 + method attributes : Attributes.t -> unit = + fun attributes -> + let concrete = Attributes.to_concrete attributes in + self#list self#attribute concrete + method payload : Payload.t -> unit = + fun payload -> + let concrete = Payload.to_concrete payload in + match (concrete : Payload.concrete) with + | PStr x0 -> + self#structure x0 + | PSig x0 -> + self#signature x0 + | PTyp x0 -> + self#core_type x0 + | PPat (x0, x1) -> + self#pattern x0; + self#option self#expression x1 + method core_type : Core_type.t -> unit = + fun core_type -> + let concrete = Core_type.to_concrete core_type in + let { ptyp_desc; ptyp_loc; ptyp_attributes } : Core_type.concrete = concrete in + self#core_type_desc ptyp_desc; + self#location ptyp_loc; + self#attributes ptyp_attributes + method core_type_desc : Core_type_desc.t -> unit = + fun core_type_desc -> + let concrete = Core_type_desc.to_concrete core_type_desc in + match (concrete : Core_type_desc.concrete) with + | Ptyp_any -> + () + | Ptyp_var x0 -> + self#string x0 + | Ptyp_arrow (x0, x1, x2) -> + self#arg_label x0; + self#core_type x1; + self#core_type x2 + | Ptyp_tuple x0 -> + self#list self#core_type x0 + | Ptyp_constr (x0, x1) -> + self#longident_loc x0; + self#list self#core_type x1 + | Ptyp_object (x0, x1) -> + self#list self#object_field x0; + self#closed_flag x1 + | Ptyp_class (x0, x1) -> + self#longident_loc x0; + self#list self#core_type x1 + | Ptyp_alias (x0, x1) -> + self#core_type x0; + self#string x1 + | Ptyp_variant (x0, x1, x2) -> + self#list self#row_field x0; + self#closed_flag x1; + self#option (self#list self#string) x2 + | Ptyp_poly (x0, x1) -> + self#list (self#loc self#string) x0; + self#core_type x1 + | Ptyp_package x0 -> + self#package_type x0 + | Ptyp_extension x0 -> + self#extension x0 + method package_type : Package_type.t -> unit = + fun package_type -> + let concrete = Package_type.to_concrete package_type in + let (x0, x1) = concrete in + self#longident_loc x0; + self#list (fun (x0, x1) -> self#longident_loc x0; self#core_type x1) x1 + method row_field : Row_field.t -> unit = + fun row_field -> + let concrete = Row_field.to_concrete row_field in + match (concrete : Row_field.concrete) with + | Rtag (x0, x1, x2, x3) -> + self#loc self#string x0; + self#attributes x1; + self#bool x2; + self#list self#core_type x3 + | Rinherit x0 -> + self#core_type x0 + method object_field : Object_field.t -> unit = + fun object_field -> + let concrete = Object_field.to_concrete object_field in + match (concrete : Object_field.concrete) with + | Otag (x0, x1, x2) -> + self#loc self#string x0; + self#attributes x1; + self#core_type x2 + | Oinherit x0 -> + self#core_type x0 + method pattern : Pattern.t -> unit = + fun pattern -> + let concrete = Pattern.to_concrete pattern in + let { ppat_desc; ppat_loc; ppat_attributes } : Pattern.concrete = concrete in + self#pattern_desc ppat_desc; + self#location ppat_loc; + self#attributes ppat_attributes + method pattern_desc : Pattern_desc.t -> unit = + fun pattern_desc -> + let concrete = Pattern_desc.to_concrete pattern_desc in + match (concrete : Pattern_desc.concrete) with + | Ppat_any -> + () + | Ppat_var x0 -> + self#loc self#string x0 + | Ppat_alias (x0, x1) -> + self#pattern x0; + self#loc self#string x1 + | Ppat_constant x0 -> + self#constant x0 + | Ppat_interval (x0, x1) -> + self#constant x0; + self#constant x1 + | Ppat_tuple x0 -> + self#list self#pattern x0 + | Ppat_construct (x0, x1) -> + self#longident_loc x0; + self#option self#pattern x1 + | Ppat_variant (x0, x1) -> + self#string x0; + self#option self#pattern x1 + | Ppat_record (x0, x1) -> + self#list (fun (x0, x1) -> self#longident_loc x0; self#pattern x1) x0; + self#closed_flag x1 + | Ppat_array x0 -> + self#list self#pattern x0 + | Ppat_or (x0, x1) -> + self#pattern x0; + self#pattern x1 + | Ppat_constraint (x0, x1) -> + self#pattern x0; + self#core_type x1 + | Ppat_type x0 -> + self#longident_loc x0 + | Ppat_lazy x0 -> + self#pattern x0 + | Ppat_unpack x0 -> + self#loc self#string x0 + | Ppat_exception x0 -> + self#pattern x0 + | Ppat_extension x0 -> + self#extension x0 + | Ppat_open (x0, x1) -> + self#longident_loc x0; + self#pattern x1 + method expression : Expression.t -> unit = + fun expression -> + let concrete = Expression.to_concrete expression in + let { pexp_desc; pexp_loc; pexp_attributes } : Expression.concrete = concrete in + self#expression_desc pexp_desc; + self#location pexp_loc; + self#attributes pexp_attributes + method expression_desc : Expression_desc.t -> unit = + fun expression_desc -> + let concrete = Expression_desc.to_concrete expression_desc in + match (concrete : Expression_desc.concrete) with + | Pexp_ident x0 -> + self#longident_loc x0 + | Pexp_constant x0 -> + self#constant x0 + | Pexp_let (x0, x1, x2) -> + self#rec_flag x0; + self#list self#value_binding x1; + self#expression x2 + | Pexp_function x0 -> + self#list self#case x0 + | Pexp_fun (x0, x1, x2, x3) -> + self#arg_label x0; + self#option self#expression x1; + self#pattern x2; + self#expression x3 + | Pexp_apply (x0, x1) -> + self#expression x0; + self#list (fun (x0, x1) -> self#arg_label x0; self#expression x1) x1 + | Pexp_match (x0, x1) -> + self#expression x0; + self#list self#case x1 + | Pexp_try (x0, x1) -> + self#expression x0; + self#list self#case x1 + | Pexp_tuple x0 -> + self#list self#expression x0 + | Pexp_construct (x0, x1) -> + self#longident_loc x0; + self#option self#expression x1 + | Pexp_variant (x0, x1) -> + self#string x0; + self#option self#expression x1 + | Pexp_record (x0, x1) -> + self#list (fun (x0, x1) -> self#longident_loc x0; self#expression x1) x0; + self#option self#expression x1 + | Pexp_field (x0, x1) -> + self#expression x0; + self#longident_loc x1 + | Pexp_setfield (x0, x1, x2) -> + self#expression x0; + self#longident_loc x1; + self#expression x2 + | Pexp_array x0 -> + self#list self#expression x0 + | Pexp_ifthenelse (x0, x1, x2) -> + self#expression x0; + self#expression x1; + self#option self#expression x2 + | Pexp_sequence (x0, x1) -> + self#expression x0; + self#expression x1 + | Pexp_while (x0, x1) -> + self#expression x0; + self#expression x1 + | Pexp_for (x0, x1, x2, x3, x4) -> + self#pattern x0; + self#expression x1; + self#expression x2; + self#direction_flag x3; + self#expression x4 + | Pexp_constraint (x0, x1) -> + self#expression x0; + self#core_type x1 + | Pexp_coerce (x0, x1, x2) -> + self#expression x0; + self#option self#core_type x1; + self#core_type x2 + | Pexp_send (x0, x1) -> + self#expression x0; + self#loc self#string x1 + | Pexp_new x0 -> + self#longident_loc x0 + | Pexp_setinstvar (x0, x1) -> + self#loc self#string x0; + self#expression x1 + | Pexp_override x0 -> + self#list (fun (x0, x1) -> self#loc self#string x0; self#expression x1) x0 + | Pexp_letmodule (x0, x1, x2) -> + self#loc self#string x0; + self#module_expr x1; + self#expression x2 + | Pexp_letexception (x0, x1) -> + self#extension_constructor x0; + self#expression x1 + | Pexp_assert x0 -> + self#expression x0 + | Pexp_lazy x0 -> + self#expression x0 + | Pexp_poly (x0, x1) -> + self#expression x0; + self#option self#core_type x1 + | Pexp_object x0 -> + self#class_structure x0 + | Pexp_newtype (x0, x1) -> + self#loc self#string x0; + self#expression x1 + | Pexp_pack x0 -> + self#module_expr x0 + | Pexp_open (x0, x1, x2) -> + self#override_flag x0; + self#longident_loc x1; + self#expression x2 + | Pexp_extension x0 -> + self#extension x0 + | Pexp_unreachable -> + () + method case : Case.t -> unit = + fun case -> + let concrete = Case.to_concrete case in + let { pc_lhs; pc_guard; pc_rhs } : Case.concrete = concrete in + self#pattern pc_lhs; + self#option self#expression pc_guard; + self#expression pc_rhs + method value_description : Value_description.t -> unit = + fun value_description -> + let concrete = Value_description.to_concrete value_description in + let { pval_name; pval_type; pval_prim; pval_attributes; pval_loc } : Value_description.concrete = concrete in + 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.t -> unit = + fun type_declaration -> + let concrete = Type_declaration.to_concrete type_declaration in + let { ptype_name; ptype_params; ptype_cstrs; ptype_kind; ptype_private; ptype_manifest; ptype_attributes; ptype_loc } : Type_declaration.concrete = concrete in + self#loc self#string ptype_name; + self#list (fun (x0, x1) -> self#core_type x0; self#variance x1) ptype_params; + self#list (fun (x0, x1, x2) -> self#core_type x0; self#core_type x1; self#location x2) 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.t -> unit = + fun type_kind -> + let concrete = Type_kind.to_concrete type_kind in + match (concrete : Type_kind.concrete) with + | Ptype_abstract -> + () + | Ptype_variant x0 -> + self#list self#constructor_declaration x0 + | Ptype_record x0 -> + self#list self#label_declaration x0 + | Ptype_open -> + () + method label_declaration : Label_declaration.t -> unit = + fun label_declaration -> + let concrete = Label_declaration.to_concrete label_declaration in + let { pld_name; pld_mutable; pld_type; pld_loc; pld_attributes } : Label_declaration.concrete = concrete in + 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.t -> unit = + fun constructor_declaration -> + let concrete = Constructor_declaration.to_concrete constructor_declaration in + let { pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes } : Constructor_declaration.concrete = concrete in + 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.t -> unit = + fun constructor_arguments -> + let concrete = Constructor_arguments.to_concrete constructor_arguments in + match (concrete : Constructor_arguments.concrete) with + | Pcstr_tuple x0 -> + self#list self#core_type x0 + | Pcstr_record x0 -> + self#list self#label_declaration x0 + method type_extension : Type_extension.t -> unit = + fun type_extension -> + let concrete = Type_extension.to_concrete type_extension in + let { ptyext_path; ptyext_params; ptyext_constructors; ptyext_private; ptyext_attributes } : Type_extension.concrete = concrete in + self#longident_loc ptyext_path; + self#list (fun (x0, x1) -> self#core_type x0; self#variance x1) ptyext_params; + self#list self#extension_constructor ptyext_constructors; + self#private_flag ptyext_private; + self#attributes ptyext_attributes + method extension_constructor : Extension_constructor.t -> unit = + fun extension_constructor -> + let concrete = Extension_constructor.to_concrete extension_constructor in + let { pext_name; pext_kind; pext_loc; pext_attributes } : Extension_constructor.concrete = concrete in + self#loc self#string pext_name; + self#extension_constructor_kind pext_kind; + self#location pext_loc; + self#attributes pext_attributes + method extension_constructor_kind : Extension_constructor_kind.t -> unit = + fun extension_constructor_kind -> + let concrete = Extension_constructor_kind.to_concrete extension_constructor_kind in + match (concrete : Extension_constructor_kind.concrete) with + | Pext_decl (x0, x1) -> + self#constructor_arguments x0; + self#option self#core_type x1 + | Pext_rebind x0 -> + self#longident_loc x0 + method class_type : Class_type.t -> unit = + fun class_type -> + let concrete = Class_type.to_concrete class_type in + let { pcty_desc; pcty_loc; pcty_attributes } : Class_type.concrete = concrete in + self#class_type_desc pcty_desc; + self#location pcty_loc; + self#attributes pcty_attributes + method class_type_desc : Class_type_desc.t -> unit = + fun class_type_desc -> + let concrete = Class_type_desc.to_concrete class_type_desc in + match (concrete : Class_type_desc.concrete) with + | Pcty_constr (x0, x1) -> + self#longident_loc x0; + self#list self#core_type x1 + | Pcty_signature x0 -> + self#class_signature x0 + | Pcty_arrow (x0, x1, x2) -> + self#arg_label x0; + self#core_type x1; + self#class_type x2 + | Pcty_extension x0 -> + self#extension x0 + | Pcty_open (x0, x1, x2) -> + self#override_flag x0; + self#longident_loc x1; + self#class_type x2 + method class_signature : Class_signature.t -> unit = + fun class_signature -> + let concrete = Class_signature.to_concrete class_signature in + let { pcsig_self; pcsig_fields } : Class_signature.concrete = concrete in + self#core_type pcsig_self; + self#list self#class_type_field pcsig_fields + method class_type_field : Class_type_field.t -> unit = + fun class_type_field -> + let concrete = Class_type_field.to_concrete class_type_field in + let { pctf_desc; pctf_loc; pctf_attributes } : Class_type_field.concrete = concrete in + self#class_type_field_desc pctf_desc; + self#location pctf_loc; + self#attributes pctf_attributes + method class_type_field_desc : Class_type_field_desc.t -> unit = + fun class_type_field_desc -> + let concrete = Class_type_field_desc.to_concrete class_type_field_desc in + match (concrete : Class_type_field_desc.concrete) with + | Pctf_inherit x0 -> + self#class_type x0 + | Pctf_val x0 -> + (fun (x0, x1, x2, x3) -> self#loc self#string x0; self#mutable_flag x1; self#virtual_flag x2; self#core_type x3) x0 + | Pctf_method x0 -> + (fun (x0, x1, x2, x3) -> self#loc self#string x0; self#private_flag x1; self#virtual_flag x2; self#core_type x3) x0 + | Pctf_constraint x0 -> + (fun (x0, x1) -> self#core_type x0; self#core_type x1) x0 + | Pctf_attribute x0 -> + self#attribute x0 + | Pctf_extension x0 -> + self#extension x0 + method class_infos : 'a . ('a node -> unit) -> 'a node Class_infos.t -> unit = + fun fa class_infos -> + let concrete = Class_infos.to_concrete class_infos in + let { pci_virt; pci_params; pci_name; pci_expr; pci_loc; pci_attributes } : _ Class_infos.concrete = concrete in + self#virtual_flag pci_virt; + self#list (fun (x0, x1) -> self#core_type x0; self#variance x1) pci_params; + self#loc self#string pci_name; + fa pci_expr; + self#location pci_loc; + self#attributes pci_attributes + method class_description : Class_description.t -> unit = + fun class_description -> + let concrete = Class_description.to_concrete class_description in + self#class_infos self#class_type concrete + method class_type_declaration : Class_type_declaration.t -> unit = + fun class_type_declaration -> + let concrete = Class_type_declaration.to_concrete class_type_declaration in + self#class_infos self#class_type concrete + method class_expr : Class_expr.t -> unit = + fun class_expr -> + let concrete = Class_expr.to_concrete class_expr in + let { pcl_desc; pcl_loc; pcl_attributes } : Class_expr.concrete = concrete in + self#class_expr_desc pcl_desc; + self#location pcl_loc; + self#attributes pcl_attributes + method class_expr_desc : Class_expr_desc.t -> unit = + fun class_expr_desc -> + let concrete = Class_expr_desc.to_concrete class_expr_desc in + match (concrete : Class_expr_desc.concrete) with + | Pcl_constr (x0, x1) -> + self#longident_loc x0; + self#list self#core_type x1 + | Pcl_structure x0 -> + self#class_structure x0 + | Pcl_fun (x0, x1, x2, x3) -> + self#arg_label x0; + self#option self#expression x1; + self#pattern x2; + self#class_expr x3 + | Pcl_apply (x0, x1) -> + self#class_expr x0; + self#list (fun (x0, x1) -> self#arg_label x0; self#expression x1) x1 + | Pcl_let (x0, x1, x2) -> + self#rec_flag x0; + self#list self#value_binding x1; + self#class_expr x2 + | Pcl_constraint (x0, x1) -> + self#class_expr x0; + self#class_type x1 + | Pcl_extension x0 -> + self#extension x0 + | Pcl_open (x0, x1, x2) -> + self#override_flag x0; + self#longident_loc x1; + self#class_expr x2 + method class_structure : Class_structure.t -> unit = + fun class_structure -> + let concrete = Class_structure.to_concrete class_structure in + let { pcstr_self; pcstr_fields } : Class_structure.concrete = concrete in + self#pattern pcstr_self; + self#list self#class_field pcstr_fields + method class_field : Class_field.t -> unit = + fun class_field -> + let concrete = Class_field.to_concrete class_field in + let { pcf_desc; pcf_loc; pcf_attributes } : Class_field.concrete = concrete in + self#class_field_desc pcf_desc; + self#location pcf_loc; + self#attributes pcf_attributes + method class_field_desc : Class_field_desc.t -> unit = + fun class_field_desc -> + let concrete = Class_field_desc.to_concrete class_field_desc in + match (concrete : Class_field_desc.concrete) with + | Pcf_inherit (x0, x1, x2) -> + self#override_flag x0; + self#class_expr x1; + self#option (self#loc self#string) x2 + | Pcf_val x0 -> + (fun (x0, x1, x2) -> self#loc self#string x0; self#mutable_flag x1; self#class_field_kind x2) x0 + | Pcf_method x0 -> + (fun (x0, x1, x2) -> self#loc self#string x0; self#private_flag x1; self#class_field_kind x2) x0 + | Pcf_constraint x0 -> + (fun (x0, x1) -> self#core_type x0; self#core_type x1) x0 + | Pcf_initializer x0 -> + self#expression x0 + | Pcf_attribute x0 -> + self#attribute x0 + | Pcf_extension x0 -> + self#extension x0 + method class_field_kind : Class_field_kind.t -> unit = + fun class_field_kind -> + let concrete = Class_field_kind.to_concrete class_field_kind in + match (concrete : Class_field_kind.concrete) with + | Cfk_virtual x0 -> + self#core_type x0 + | Cfk_concrete (x0, x1) -> + self#override_flag x0; + self#expression x1 + method class_declaration : Class_declaration.t -> unit = + fun class_declaration -> + let concrete = Class_declaration.to_concrete class_declaration in + self#class_infos self#class_expr concrete + method module_type : Module_type.t -> unit = + fun module_type -> + let concrete = Module_type.to_concrete module_type in + let { pmty_desc; pmty_loc; pmty_attributes } : Module_type.concrete = concrete in + self#module_type_desc pmty_desc; + self#location pmty_loc; + self#attributes pmty_attributes + method module_type_desc : Module_type_desc.t -> unit = + fun module_type_desc -> + let concrete = Module_type_desc.to_concrete module_type_desc in + match (concrete : Module_type_desc.concrete) with + | Pmty_ident x0 -> + self#longident_loc x0 + | Pmty_signature x0 -> + self#signature x0 + | Pmty_functor (x0, x1, x2) -> + self#loc self#string x0; + self#option self#module_type x1; + self#module_type x2 + | Pmty_with (x0, x1) -> + self#module_type x0; + self#list self#with_constraint x1 + | Pmty_typeof x0 -> + self#module_expr x0 + | Pmty_extension x0 -> + self#extension x0 + | Pmty_alias x0 -> + self#longident_loc x0 + method signature : Signature.t -> unit = + fun signature -> + let concrete = Signature.to_concrete signature in + self#list self#signature_item concrete + method signature_item : Signature_item.t -> unit = + fun signature_item -> + let concrete = Signature_item.to_concrete signature_item in + let { psig_desc; psig_loc } : Signature_item.concrete = concrete in + self#signature_item_desc psig_desc; + self#location psig_loc + method signature_item_desc : Signature_item_desc.t -> unit = + fun signature_item_desc -> + let concrete = Signature_item_desc.to_concrete signature_item_desc in + match (concrete : Signature_item_desc.concrete) with + | Psig_value x0 -> + self#value_description x0 + | Psig_type (x0, x1) -> + self#rec_flag x0; + self#list self#type_declaration x1 + | Psig_typext x0 -> + self#type_extension x0 + | Psig_exception x0 -> + self#extension_constructor x0 + | Psig_module x0 -> + self#module_declaration x0 + | Psig_recmodule x0 -> + self#list self#module_declaration x0 + | Psig_modtype x0 -> + self#module_type_declaration x0 + | Psig_open x0 -> + self#open_description x0 + | Psig_include x0 -> + self#include_description x0 + | Psig_class x0 -> + self#list self#class_description x0 + | Psig_class_type x0 -> + self#list self#class_type_declaration x0 + | Psig_attribute x0 -> + self#attribute x0 + | Psig_extension (x0, x1) -> + self#extension x0; + self#attributes x1 + method module_declaration : Module_declaration.t -> unit = + fun module_declaration -> + let concrete = Module_declaration.to_concrete module_declaration in + let { pmd_name; pmd_type; pmd_attributes; pmd_loc } : Module_declaration.concrete = concrete in + self#loc self#string pmd_name; + self#module_type pmd_type; + self#attributes pmd_attributes; + self#location pmd_loc + method module_type_declaration : Module_type_declaration.t -> unit = + fun module_type_declaration -> + let concrete = Module_type_declaration.to_concrete module_type_declaration in + let { pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc } : Module_type_declaration.concrete = concrete in + self#loc self#string pmtd_name; + self#option self#module_type pmtd_type; + self#attributes pmtd_attributes; + self#location pmtd_loc + method open_description : Open_description.t -> unit = + fun open_description -> + let concrete = Open_description.to_concrete open_description in + let { popen_lid; popen_override; popen_loc; popen_attributes } : Open_description.concrete = concrete in + self#longident_loc popen_lid; + self#override_flag popen_override; + self#location popen_loc; + self#attributes popen_attributes + method include_infos : 'a . ('a node -> unit) -> 'a node Include_infos.t -> unit = + fun fa include_infos -> + let concrete = Include_infos.to_concrete include_infos in + let { pincl_mod; pincl_loc; pincl_attributes } : _ Include_infos.concrete = concrete in + fa pincl_mod; + self#location pincl_loc; + self#attributes pincl_attributes + method include_description : Include_description.t -> unit = + fun include_description -> + let concrete = Include_description.to_concrete include_description in + self#include_infos self#module_type concrete + method include_declaration : Include_declaration.t -> unit = + fun include_declaration -> + let concrete = Include_declaration.to_concrete include_declaration in + self#include_infos self#module_expr concrete + method with_constraint : With_constraint.t -> unit = + fun with_constraint -> + let concrete = With_constraint.to_concrete with_constraint in + match (concrete : With_constraint.concrete) with + | Pwith_type (x0, x1) -> + self#longident_loc x0; + self#type_declaration x1 + | Pwith_module (x0, x1) -> + self#longident_loc x0; + self#longident_loc x1 + | Pwith_typesubst (x0, x1) -> + self#longident_loc x0; + self#type_declaration x1 + | Pwith_modsubst (x0, x1) -> + self#longident_loc x0; + self#longident_loc x1 + method module_expr : Module_expr.t -> unit = + fun module_expr -> + let concrete = Module_expr.to_concrete module_expr in + let { pmod_desc; pmod_loc; pmod_attributes } : Module_expr.concrete = concrete in + self#module_expr_desc pmod_desc; + self#location pmod_loc; + self#attributes pmod_attributes + method module_expr_desc : Module_expr_desc.t -> unit = + fun module_expr_desc -> + let concrete = Module_expr_desc.to_concrete module_expr_desc in + match (concrete : Module_expr_desc.concrete) with + | Pmod_ident x0 -> + self#longident_loc x0 + | Pmod_structure x0 -> + self#structure x0 + | Pmod_functor (x0, x1, x2) -> + self#loc self#string x0; + self#option self#module_type x1; + self#module_expr x2 + | Pmod_apply (x0, x1) -> + self#module_expr x0; + self#module_expr x1 + | Pmod_constraint (x0, x1) -> + self#module_expr x0; + self#module_type x1 + | Pmod_unpack x0 -> + self#expression x0 + | Pmod_extension x0 -> + self#extension x0 + method structure : Structure.t -> unit = + fun structure -> + let concrete = Structure.to_concrete structure in + self#list self#structure_item concrete + method structure_item : Structure_item.t -> unit = + fun structure_item -> + let concrete = Structure_item.to_concrete structure_item in + let { pstr_desc; pstr_loc } : Structure_item.concrete = concrete in + self#structure_item_desc pstr_desc; + self#location pstr_loc + method structure_item_desc : Structure_item_desc.t -> unit = + fun structure_item_desc -> + let concrete = Structure_item_desc.to_concrete structure_item_desc in + match (concrete : Structure_item_desc.concrete) with + | Pstr_eval (x0, x1) -> + self#expression x0; + self#attributes x1 + | Pstr_value (x0, x1) -> + self#rec_flag x0; + self#list self#value_binding x1 + | Pstr_primitive x0 -> + self#value_description x0 + | Pstr_type (x0, x1) -> + self#rec_flag x0; + self#list self#type_declaration x1 + | Pstr_typext x0 -> + self#type_extension x0 + | Pstr_exception x0 -> + self#extension_constructor x0 + | Pstr_module x0 -> + self#module_binding x0 + | Pstr_recmodule x0 -> + self#list self#module_binding x0 + | Pstr_modtype x0 -> + self#module_type_declaration x0 + | Pstr_open x0 -> + self#open_description x0 + | Pstr_class x0 -> + self#list self#class_declaration x0 + | Pstr_class_type x0 -> + self#list self#class_type_declaration x0 + | Pstr_include x0 -> + self#include_declaration x0 + | Pstr_attribute x0 -> + self#attribute x0 + | Pstr_extension (x0, x1) -> + self#extension x0; + self#attributes x1 + method value_binding : Value_binding.t -> unit = + fun value_binding -> + let concrete = Value_binding.to_concrete value_binding in + let { pvb_pat; pvb_expr; pvb_attributes; pvb_loc } : Value_binding.concrete = concrete in + self#pattern pvb_pat; + self#expression pvb_expr; + self#attributes pvb_attributes; + self#location pvb_loc + method module_binding : Module_binding.t -> unit = + fun module_binding -> + let concrete = Module_binding.to_concrete module_binding in + let { pmb_name; pmb_expr; pmb_attributes; pmb_loc } : Module_binding.concrete = concrete in + self#loc self#string pmb_name; + self#module_expr pmb_expr; + self#attributes pmb_attributes; + self#location pmb_loc + method toplevel_phrase : Toplevel_phrase.t -> unit = + fun toplevel_phrase -> + let concrete = Toplevel_phrase.to_concrete toplevel_phrase in + match (concrete : Toplevel_phrase.concrete) with + | Ptop_def x0 -> + self#structure x0 + | Ptop_dir (x0, x1) -> + self#string x0; + self#directive_argument x1 + method directive_argument : Directive_argument.t -> unit = + fun directive_argument -> + let concrete = Directive_argument.to_concrete directive_argument in + match (concrete : Directive_argument.concrete) with + | Pdir_none -> + () + | Pdir_string x0 -> + self#string x0 + | Pdir_int (x0, x1) -> + self#string x0; + self#option self#char x1 + | Pdir_ident x0 -> + self#longident x0 + | Pdir_bool x0 -> + self#bool x0 + end + +class virtual ['acc] fold = + object (self) + method virtual bool : bool -> 'acc -> 'acc + method virtual char : char -> 'acc -> 'acc + method virtual int : int -> 'acc -> 'acc + method virtual list : 'a . ('a -> 'acc -> 'acc) -> 'a list -> 'acc -> 'acc + method virtual option : 'a . ('a -> 'acc -> 'acc) -> 'a option -> 'acc -> 'acc + method virtual string : string -> 'acc -> 'acc + method virtual location : Astlib.Location.t -> 'acc -> 'acc + method virtual loc : 'a . ('a -> 'acc -> 'acc) -> 'a Astlib.Loc.t -> 'acc -> 'acc + method longident : Longident.t -> 'acc -> 'acc = + fun longident acc -> + let concrete = Longident.to_concrete longident in + match (concrete : Longident.concrete) with + | Lident x0 -> + let acc = self#string x0 acc in + acc + | Ldot (x0, x1) -> + let acc = self#longident x0 acc in + let acc = self#string x1 acc in + acc + | Lapply (x0, x1) -> + let acc = self#longident x0 acc in + let acc = self#longident x1 acc in + acc + method longident_loc : Longident_loc.t -> 'acc -> 'acc = + fun longident_loc acc -> + let concrete = Longident_loc.to_concrete longident_loc in + let acc = self#loc self#longident concrete acc in + acc + method rec_flag : Rec_flag.t -> 'acc -> 'acc = + fun rec_flag acc -> + let concrete = Rec_flag.to_concrete rec_flag in + match (concrete : Rec_flag.concrete) with + | Nonrecursive -> + acc + | Recursive -> + acc + method direction_flag : Direction_flag.t -> 'acc -> 'acc = + fun direction_flag acc -> + let concrete = Direction_flag.to_concrete direction_flag in + match (concrete : Direction_flag.concrete) with + | Upto -> + acc + | Downto -> + acc + method private_flag : Private_flag.t -> 'acc -> 'acc = + fun private_flag acc -> + let concrete = Private_flag.to_concrete private_flag in + match (concrete : Private_flag.concrete) with + | Private -> + acc + | Public -> + acc + method mutable_flag : Mutable_flag.t -> 'acc -> 'acc = + fun mutable_flag acc -> + let concrete = Mutable_flag.to_concrete mutable_flag in + match (concrete : Mutable_flag.concrete) with + | Immutable -> + acc + | Mutable -> + acc + method virtual_flag : Virtual_flag.t -> 'acc -> 'acc = + fun virtual_flag acc -> + let concrete = Virtual_flag.to_concrete virtual_flag in + match (concrete : Virtual_flag.concrete) with + | Virtual -> + acc + | Concrete -> + acc + method override_flag : Override_flag.t -> 'acc -> 'acc = + fun override_flag acc -> + let concrete = Override_flag.to_concrete override_flag in + match (concrete : Override_flag.concrete) with + | Override -> + acc + | Fresh -> + acc + method closed_flag : Closed_flag.t -> 'acc -> 'acc = + fun closed_flag acc -> + let concrete = Closed_flag.to_concrete closed_flag in + match (concrete : Closed_flag.concrete) with + | Closed -> + acc + | Open -> + acc + method arg_label : Arg_label.t -> 'acc -> 'acc = + fun arg_label acc -> + let concrete = Arg_label.to_concrete arg_label in + match (concrete : Arg_label.concrete) with + | Nolabel -> + acc + | Labelled x0 -> + let acc = self#string x0 acc in + acc + | Optional x0 -> + let acc = self#string x0 acc in + acc + method variance : Variance.t -> 'acc -> 'acc = + fun variance acc -> + let concrete = Variance.to_concrete variance in + match (concrete : Variance.concrete) with + | Covariant -> + acc + | Contravariant -> + acc + | Invariant -> + acc + method constant : Constant.t -> 'acc -> 'acc = + fun constant acc -> + let concrete = Constant.to_concrete constant in + match (concrete : Constant.concrete) with + | Pconst_integer (x0, x1) -> + let acc = self#string x0 acc in + let acc = self#option self#char x1 acc in + acc + | Pconst_char x0 -> + let acc = self#char x0 acc in + acc + | Pconst_string (x0, x1) -> + let acc = self#string x0 acc in + let acc = self#option self#string x1 acc in + acc + | Pconst_float (x0, x1) -> + let acc = self#string x0 acc in + let acc = self#option self#char x1 acc in + acc + method attribute : Attribute.t -> 'acc -> 'acc = + fun attribute acc -> + let concrete = Attribute.to_concrete attribute in + let (x0, x1) = concrete in + let acc = self#loc self#string x0 acc in + let acc = self#payload x1 acc in + acc + method extension : Extension.t -> 'acc -> 'acc = + fun extension acc -> + let concrete = Extension.to_concrete extension in + let (x0, x1) = concrete in + let acc = self#loc self#string x0 acc in + let acc = self#payload x1 acc in + acc + method attributes : Attributes.t -> 'acc -> 'acc = + fun attributes acc -> + let concrete = Attributes.to_concrete attributes in + let acc = self#list self#attribute concrete acc in + acc + method payload : Payload.t -> 'acc -> 'acc = + fun payload acc -> + let concrete = Payload.to_concrete payload in + match (concrete : Payload.concrete) with + | PStr x0 -> + let acc = self#structure x0 acc in + acc + | PSig x0 -> + let acc = self#signature x0 acc in + acc + | PTyp x0 -> + let acc = self#core_type x0 acc in + acc + | PPat (x0, x1) -> + let acc = self#pattern x0 acc in + let acc = self#option self#expression x1 acc in + acc + method core_type : Core_type.t -> 'acc -> 'acc = + fun core_type acc -> + let concrete = Core_type.to_concrete core_type in + let { ptyp_desc; ptyp_loc; ptyp_attributes } : Core_type.concrete = concrete in + 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 + method core_type_desc : Core_type_desc.t -> 'acc -> 'acc = + fun core_type_desc acc -> + let concrete = Core_type_desc.to_concrete core_type_desc in + match (concrete : Core_type_desc.concrete) with + | Ptyp_any -> + acc + | Ptyp_var x0 -> + let acc = self#string x0 acc in + acc + | Ptyp_arrow (x0, x1, x2) -> + let acc = self#arg_label x0 acc in + let acc = self#core_type x1 acc in + let acc = self#core_type x2 acc in + acc + | Ptyp_tuple x0 -> + let acc = self#list self#core_type x0 acc in + acc + | Ptyp_constr (x0, x1) -> + let acc = self#longident_loc x0 acc in + let acc = self#list self#core_type x1 acc in + acc + | Ptyp_object (x0, x1) -> + let acc = self#list self#object_field x0 acc in + let acc = self#closed_flag x1 acc in + acc + | Ptyp_class (x0, x1) -> + let acc = self#longident_loc x0 acc in + let acc = self#list self#core_type x1 acc in + acc + | Ptyp_alias (x0, x1) -> + let acc = self#core_type x0 acc in + let acc = self#string x1 acc in + acc + | Ptyp_variant (x0, x1, x2) -> + let acc = self#list self#row_field x0 acc in + let acc = self#closed_flag x1 acc in + let acc = self#option (self#list self#string) x2 acc in + acc + | Ptyp_poly (x0, x1) -> + let acc = self#list (self#loc self#string) x0 acc in + let acc = self#core_type x1 acc in + acc + | Ptyp_package x0 -> + let acc = self#package_type x0 acc in + acc + | Ptyp_extension x0 -> + let acc = self#extension x0 acc in + acc + method package_type : Package_type.t -> 'acc -> 'acc = + fun package_type acc -> + let concrete = Package_type.to_concrete package_type in + let (x0, x1) = concrete in + let acc = self#longident_loc x0 acc in + let acc = self#list (fun (x0, x1) acc -> let acc = self#longident_loc x0 acc in let acc = self#core_type x1 acc in acc) x1 acc in + acc + method row_field : Row_field.t -> 'acc -> 'acc = + fun row_field acc -> + let concrete = Row_field.to_concrete row_field in + match (concrete : Row_field.concrete) with + | Rtag (x0, x1, x2, x3) -> + let acc = self#loc self#string x0 acc in + let acc = self#attributes x1 acc in + let acc = self#bool x2 acc in + let acc = self#list self#core_type x3 acc in + acc + | Rinherit x0 -> + let acc = self#core_type x0 acc in + acc + method object_field : Object_field.t -> 'acc -> 'acc = + fun object_field acc -> + let concrete = Object_field.to_concrete object_field in + match (concrete : Object_field.concrete) with + | Otag (x0, x1, x2) -> + let acc = self#loc self#string x0 acc in + let acc = self#attributes x1 acc in + let acc = self#core_type x2 acc in + acc + | Oinherit x0 -> + let acc = self#core_type x0 acc in + acc + method pattern : Pattern.t -> 'acc -> 'acc = + fun pattern acc -> + let concrete = Pattern.to_concrete pattern in + let { ppat_desc; ppat_loc; ppat_attributes } : Pattern.concrete = concrete in + 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 + method pattern_desc : Pattern_desc.t -> 'acc -> 'acc = + fun pattern_desc acc -> + let concrete = Pattern_desc.to_concrete pattern_desc in + match (concrete : Pattern_desc.concrete) with + | Ppat_any -> + acc + | Ppat_var x0 -> + let acc = self#loc self#string x0 acc in + acc + | Ppat_alias (x0, x1) -> + let acc = self#pattern x0 acc in + let acc = self#loc self#string x1 acc in + acc + | Ppat_constant x0 -> + let acc = self#constant x0 acc in + acc + | Ppat_interval (x0, x1) -> + let acc = self#constant x0 acc in + let acc = self#constant x1 acc in + acc + | Ppat_tuple x0 -> + let acc = self#list self#pattern x0 acc in + acc + | Ppat_construct (x0, x1) -> + let acc = self#longident_loc x0 acc in + let acc = self#option self#pattern x1 acc in + acc + | Ppat_variant (x0, x1) -> + let acc = self#string x0 acc in + let acc = self#option self#pattern x1 acc in + acc + | Ppat_record (x0, x1) -> + let acc = self#list (fun (x0, x1) acc -> let acc = self#longident_loc x0 acc in let acc = self#pattern x1 acc in acc) x0 acc in + let acc = self#closed_flag x1 acc in + acc + | Ppat_array x0 -> + let acc = self#list self#pattern x0 acc in + acc + | Ppat_or (x0, x1) -> + let acc = self#pattern x0 acc in + let acc = self#pattern x1 acc in + acc + | Ppat_constraint (x0, x1) -> + let acc = self#pattern x0 acc in + let acc = self#core_type x1 acc in + acc + | Ppat_type x0 -> + let acc = self#longident_loc x0 acc in + acc + | Ppat_lazy x0 -> + let acc = self#pattern x0 acc in + acc + | Ppat_unpack x0 -> + let acc = self#loc self#string x0 acc in + acc + | Ppat_exception x0 -> + let acc = self#pattern x0 acc in + acc + | Ppat_extension x0 -> + let acc = self#extension x0 acc in + acc + | Ppat_open (x0, x1) -> + let acc = self#longident_loc x0 acc in + let acc = self#pattern x1 acc in + acc + method expression : Expression.t -> 'acc -> 'acc = + fun expression acc -> + let concrete = Expression.to_concrete expression in + let { pexp_desc; pexp_loc; pexp_attributes } : Expression.concrete = concrete in + 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 + method expression_desc : Expression_desc.t -> 'acc -> 'acc = + fun expression_desc acc -> + let concrete = Expression_desc.to_concrete expression_desc in + match (concrete : Expression_desc.concrete) with + | Pexp_ident x0 -> + let acc = self#longident_loc x0 acc in + acc + | Pexp_constant x0 -> + let acc = self#constant x0 acc in + acc + | Pexp_let (x0, x1, x2) -> + let acc = self#rec_flag x0 acc in + let acc = self#list self#value_binding x1 acc in + let acc = self#expression x2 acc in + acc + | Pexp_function x0 -> + let acc = self#list self#case x0 acc in + acc + | Pexp_fun (x0, x1, x2, x3) -> + let acc = self#arg_label x0 acc in + let acc = self#option self#expression x1 acc in + let acc = self#pattern x2 acc in + let acc = self#expression x3 acc in + acc + | Pexp_apply (x0, x1) -> + let acc = self#expression x0 acc in + let acc = self#list (fun (x0, x1) acc -> let acc = self#arg_label x0 acc in let acc = self#expression x1 acc in acc) x1 acc in + acc + | Pexp_match (x0, x1) -> + let acc = self#expression x0 acc in + let acc = self#list self#case x1 acc in + acc + | Pexp_try (x0, x1) -> + let acc = self#expression x0 acc in + let acc = self#list self#case x1 acc in + acc + | Pexp_tuple x0 -> + let acc = self#list self#expression x0 acc in + acc + | Pexp_construct (x0, x1) -> + let acc = self#longident_loc x0 acc in + let acc = self#option self#expression x1 acc in + acc + | Pexp_variant (x0, x1) -> + let acc = self#string x0 acc in + let acc = self#option self#expression x1 acc in + acc + | Pexp_record (x0, x1) -> + let acc = self#list (fun (x0, x1) acc -> let acc = self#longident_loc x0 acc in let acc = self#expression x1 acc in acc) x0 acc in + let acc = self#option self#expression x1 acc in + acc + | Pexp_field (x0, x1) -> + let acc = self#expression x0 acc in + let acc = self#longident_loc x1 acc in + acc + | Pexp_setfield (x0, x1, x2) -> + let acc = self#expression x0 acc in + let acc = self#longident_loc x1 acc in + let acc = self#expression x2 acc in + acc + | Pexp_array x0 -> + let acc = self#list self#expression x0 acc in + acc + | Pexp_ifthenelse (x0, x1, x2) -> + let acc = self#expression x0 acc in + let acc = self#expression x1 acc in + let acc = self#option self#expression x2 acc in + acc + | Pexp_sequence (x0, x1) -> + let acc = self#expression x0 acc in + let acc = self#expression x1 acc in + acc + | Pexp_while (x0, x1) -> + let acc = self#expression x0 acc in + let acc = self#expression x1 acc in + acc + | Pexp_for (x0, x1, x2, x3, x4) -> + let acc = self#pattern x0 acc in + let acc = self#expression x1 acc in + let acc = self#expression x2 acc in + let acc = self#direction_flag x3 acc in + let acc = self#expression x4 acc in + acc + | Pexp_constraint (x0, x1) -> + let acc = self#expression x0 acc in + let acc = self#core_type x1 acc in + acc + | Pexp_coerce (x0, x1, x2) -> + let acc = self#expression x0 acc in + let acc = self#option self#core_type x1 acc in + let acc = self#core_type x2 acc in + acc + | Pexp_send (x0, x1) -> + let acc = self#expression x0 acc in + let acc = self#loc self#string x1 acc in + acc + | Pexp_new x0 -> + let acc = self#longident_loc x0 acc in + acc + | Pexp_setinstvar (x0, x1) -> + let acc = self#loc self#string x0 acc in + let acc = self#expression x1 acc in + acc + | Pexp_override x0 -> + let acc = self#list (fun (x0, x1) acc -> let acc = self#loc self#string x0 acc in let acc = self#expression x1 acc in acc) x0 acc in + acc + | Pexp_letmodule (x0, x1, x2) -> + let acc = self#loc self#string x0 acc in + let acc = self#module_expr x1 acc in + let acc = self#expression x2 acc in + acc + | Pexp_letexception (x0, x1) -> + let acc = self#extension_constructor x0 acc in + let acc = self#expression x1 acc in + acc + | Pexp_assert x0 -> + let acc = self#expression x0 acc in + acc + | Pexp_lazy x0 -> + let acc = self#expression x0 acc in + acc + | Pexp_poly (x0, x1) -> + let acc = self#expression x0 acc in + let acc = self#option self#core_type x1 acc in + acc + | Pexp_object x0 -> + let acc = self#class_structure x0 acc in + acc + | Pexp_newtype (x0, x1) -> + let acc = self#loc self#string x0 acc in + let acc = self#expression x1 acc in + acc + | Pexp_pack x0 -> + let acc = self#module_expr x0 acc in + acc + | Pexp_open (x0, x1, x2) -> + let acc = self#override_flag x0 acc in + let acc = self#longident_loc x1 acc in + let acc = self#expression x2 acc in + acc + | Pexp_extension x0 -> + let acc = self#extension x0 acc in + acc + | Pexp_unreachable -> + acc + method case : Case.t -> 'acc -> 'acc = + fun case acc -> + let concrete = Case.to_concrete case in + let { pc_lhs; pc_guard; pc_rhs } : Case.concrete = concrete in + 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 value_description : Value_description.t -> 'acc -> 'acc = + fun value_description acc -> + let concrete = Value_description.to_concrete value_description in + let { pval_name; pval_type; pval_prim; pval_attributes; pval_loc } : Value_description.concrete = concrete in + 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.t -> 'acc -> 'acc = + fun type_declaration acc -> + let concrete = Type_declaration.to_concrete type_declaration in + let { ptype_name; ptype_params; ptype_cstrs; ptype_kind; ptype_private; ptype_manifest; ptype_attributes; ptype_loc } : Type_declaration.concrete = concrete in + let acc = self#loc self#string ptype_name acc in + let acc = self#list (fun (x0, x1) acc -> let acc = self#core_type x0 acc in let acc = self#variance x1 acc in acc) ptype_params acc in + let acc = self#list (fun (x0, x1, x2) acc -> let acc = self#core_type x0 acc in let acc = self#core_type x1 acc in let acc = self#location x2 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.t -> 'acc -> 'acc = + fun type_kind acc -> + let concrete = Type_kind.to_concrete type_kind in + match (concrete : Type_kind.concrete) with + | Ptype_abstract -> + acc + | Ptype_variant x0 -> + let acc = self#list self#constructor_declaration x0 acc in + acc + | Ptype_record x0 -> + let acc = self#list self#label_declaration x0 acc in + acc + | Ptype_open -> + acc + method label_declaration : Label_declaration.t -> 'acc -> 'acc = + fun label_declaration acc -> + let concrete = Label_declaration.to_concrete label_declaration in + let { pld_name; pld_mutable; pld_type; pld_loc; pld_attributes } : Label_declaration.concrete = concrete in + 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.t -> 'acc -> 'acc = + fun constructor_declaration acc -> + let concrete = Constructor_declaration.to_concrete constructor_declaration in + let { pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes } : Constructor_declaration.concrete = concrete in + 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.t -> 'acc -> 'acc = + fun constructor_arguments acc -> + let concrete = Constructor_arguments.to_concrete constructor_arguments in + match (concrete : Constructor_arguments.concrete) with + | Pcstr_tuple x0 -> + let acc = self#list self#core_type x0 acc in + acc + | Pcstr_record x0 -> + let acc = self#list self#label_declaration x0 acc in + acc + method type_extension : Type_extension.t -> 'acc -> 'acc = + fun type_extension acc -> + let concrete = Type_extension.to_concrete type_extension in + let { ptyext_path; ptyext_params; ptyext_constructors; ptyext_private; ptyext_attributes } : Type_extension.concrete = concrete in + let acc = self#longident_loc ptyext_path acc in + let acc = self#list (fun (x0, x1) acc -> let acc = self#core_type x0 acc in let acc = self#variance x1 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 + method extension_constructor : Extension_constructor.t -> 'acc -> 'acc = + fun extension_constructor acc -> + let concrete = Extension_constructor.to_concrete extension_constructor in + let { pext_name; pext_kind; pext_loc; pext_attributes } : Extension_constructor.concrete = concrete in + 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 extension_constructor_kind : Extension_constructor_kind.t -> 'acc -> 'acc = + fun extension_constructor_kind acc -> + let concrete = Extension_constructor_kind.to_concrete extension_constructor_kind in + match (concrete : Extension_constructor_kind.concrete) with + | Pext_decl (x0, x1) -> + let acc = self#constructor_arguments x0 acc in + let acc = self#option self#core_type x1 acc in + acc + | Pext_rebind x0 -> + let acc = self#longident_loc x0 acc in + acc + method class_type : Class_type.t -> 'acc -> 'acc = + fun class_type acc -> + let concrete = Class_type.to_concrete class_type in + let { pcty_desc; pcty_loc; pcty_attributes } : Class_type.concrete = concrete in + 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.t -> 'acc -> 'acc = + fun class_type_desc acc -> + let concrete = Class_type_desc.to_concrete class_type_desc in + match (concrete : Class_type_desc.concrete) with + | Pcty_constr (x0, x1) -> + let acc = self#longident_loc x0 acc in + let acc = self#list self#core_type x1 acc in + acc + | Pcty_signature x0 -> + let acc = self#class_signature x0 acc in + acc + | Pcty_arrow (x0, x1, x2) -> + let acc = self#arg_label x0 acc in + let acc = self#core_type x1 acc in + let acc = self#class_type x2 acc in + acc + | Pcty_extension x0 -> + let acc = self#extension x0 acc in + acc + | Pcty_open (x0, x1, x2) -> + let acc = self#override_flag x0 acc in + let acc = self#longident_loc x1 acc in + let acc = self#class_type x2 acc in + acc + method class_signature : Class_signature.t -> 'acc -> 'acc = + fun class_signature acc -> + let concrete = Class_signature.to_concrete class_signature in + let { pcsig_self; pcsig_fields } : Class_signature.concrete = concrete in + 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.t -> 'acc -> 'acc = + fun class_type_field acc -> + let concrete = Class_type_field.to_concrete class_type_field in + let { pctf_desc; pctf_loc; pctf_attributes } : Class_type_field.concrete = concrete in + 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.t -> 'acc -> 'acc = + fun class_type_field_desc acc -> + let concrete = Class_type_field_desc.to_concrete class_type_field_desc in + match (concrete : Class_type_field_desc.concrete) with + | Pctf_inherit x0 -> + let acc = self#class_type x0 acc in + acc + | Pctf_val x0 -> + let acc = (fun (x0, x1, x2, x3) acc -> let acc = self#loc self#string x0 acc in let acc = self#mutable_flag x1 acc in let acc = self#virtual_flag x2 acc in let acc = self#core_type x3 acc in acc) x0 acc in + acc + | Pctf_method x0 -> + let acc = (fun (x0, x1, x2, x3) acc -> let acc = self#loc self#string x0 acc in let acc = self#private_flag x1 acc in let acc = self#virtual_flag x2 acc in let acc = self#core_type x3 acc in acc) x0 acc in + acc + | Pctf_constraint x0 -> + let acc = (fun (x0, x1) acc -> let acc = self#core_type x0 acc in let acc = self#core_type x1 acc in acc) x0 acc in + acc + | Pctf_attribute x0 -> + let acc = self#attribute x0 acc in + acc + | Pctf_extension x0 -> + let acc = self#extension x0 acc in + acc + method class_infos : 'a . ('a node -> 'acc -> 'acc) -> 'a node Class_infos.t -> 'acc -> 'acc = + fun fa class_infos acc -> + let concrete = Class_infos.to_concrete class_infos in + let { pci_virt; pci_params; pci_name; pci_expr; pci_loc; pci_attributes } : _ Class_infos.concrete = concrete in + let acc = self#virtual_flag pci_virt acc in + let acc = self#list (fun (x0, x1) acc -> let acc = self#core_type x0 acc in let acc = self#variance x1 acc in acc) pci_params acc in + let acc = self#loc self#string pci_name acc in + let acc = fa 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.t -> 'acc -> 'acc = + fun class_description acc -> + let concrete = Class_description.to_concrete class_description in + let acc = self#class_infos self#class_type concrete acc in + acc + method class_type_declaration : Class_type_declaration.t -> 'acc -> 'acc = + fun class_type_declaration acc -> + let concrete = Class_type_declaration.to_concrete class_type_declaration in + let acc = self#class_infos self#class_type concrete acc in + acc + method class_expr : Class_expr.t -> 'acc -> 'acc = + fun class_expr acc -> + let concrete = Class_expr.to_concrete class_expr in + let { pcl_desc; pcl_loc; pcl_attributes } : Class_expr.concrete = concrete in + 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.t -> 'acc -> 'acc = + fun class_expr_desc acc -> + let concrete = Class_expr_desc.to_concrete class_expr_desc in + match (concrete : Class_expr_desc.concrete) with + | Pcl_constr (x0, x1) -> + let acc = self#longident_loc x0 acc in + let acc = self#list self#core_type x1 acc in + acc + | Pcl_structure x0 -> + let acc = self#class_structure x0 acc in + acc + | Pcl_fun (x0, x1, x2, x3) -> + let acc = self#arg_label x0 acc in + let acc = self#option self#expression x1 acc in + let acc = self#pattern x2 acc in + let acc = self#class_expr x3 acc in + acc + | Pcl_apply (x0, x1) -> + let acc = self#class_expr x0 acc in + let acc = self#list (fun (x0, x1) acc -> let acc = self#arg_label x0 acc in let acc = self#expression x1 acc in acc) x1 acc in + acc + | Pcl_let (x0, x1, x2) -> + let acc = self#rec_flag x0 acc in + let acc = self#list self#value_binding x1 acc in + let acc = self#class_expr x2 acc in + acc + | Pcl_constraint (x0, x1) -> + let acc = self#class_expr x0 acc in + let acc = self#class_type x1 acc in + acc + | Pcl_extension x0 -> + let acc = self#extension x0 acc in + acc + | Pcl_open (x0, x1, x2) -> + let acc = self#override_flag x0 acc in + let acc = self#longident_loc x1 acc in + let acc = self#class_expr x2 acc in + acc + method class_structure : Class_structure.t -> 'acc -> 'acc = + fun class_structure acc -> + let concrete = Class_structure.to_concrete class_structure in + let { pcstr_self; pcstr_fields } : Class_structure.concrete = concrete in + 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.t -> 'acc -> 'acc = + fun class_field acc -> + let concrete = Class_field.to_concrete class_field in + let { pcf_desc; pcf_loc; pcf_attributes } : Class_field.concrete = concrete in + 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.t -> 'acc -> 'acc = + fun class_field_desc acc -> + let concrete = Class_field_desc.to_concrete class_field_desc in + match (concrete : Class_field_desc.concrete) with + | Pcf_inherit (x0, x1, x2) -> + let acc = self#override_flag x0 acc in + let acc = self#class_expr x1 acc in + let acc = self#option (self#loc self#string) x2 acc in + acc + | Pcf_val x0 -> + let acc = (fun (x0, x1, x2) acc -> let acc = self#loc self#string x0 acc in let acc = self#mutable_flag x1 acc in let acc = self#class_field_kind x2 acc in acc) x0 acc in + acc + | Pcf_method x0 -> + let acc = (fun (x0, x1, x2) acc -> let acc = self#loc self#string x0 acc in let acc = self#private_flag x1 acc in let acc = self#class_field_kind x2 acc in acc) x0 acc in + acc + | Pcf_constraint x0 -> + let acc = (fun (x0, x1) acc -> let acc = self#core_type x0 acc in let acc = self#core_type x1 acc in acc) x0 acc in + acc + | Pcf_initializer x0 -> + let acc = self#expression x0 acc in + acc + | Pcf_attribute x0 -> + let acc = self#attribute x0 acc in + acc + | Pcf_extension x0 -> + let acc = self#extension x0 acc in + acc + method class_field_kind : Class_field_kind.t -> 'acc -> 'acc = + fun class_field_kind acc -> + let concrete = Class_field_kind.to_concrete class_field_kind in + match (concrete : Class_field_kind.concrete) with + | Cfk_virtual x0 -> + let acc = self#core_type x0 acc in + acc + | Cfk_concrete (x0, x1) -> + let acc = self#override_flag x0 acc in + let acc = self#expression x1 acc in + acc + method class_declaration : Class_declaration.t -> 'acc -> 'acc = + fun class_declaration acc -> + let concrete = Class_declaration.to_concrete class_declaration in + let acc = self#class_infos self#class_expr concrete acc in + acc + method module_type : Module_type.t -> 'acc -> 'acc = + fun module_type acc -> + let concrete = Module_type.to_concrete module_type in + let { pmty_desc; pmty_loc; pmty_attributes } : Module_type.concrete = concrete in + 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.t -> 'acc -> 'acc = + fun module_type_desc acc -> + let concrete = Module_type_desc.to_concrete module_type_desc in + match (concrete : Module_type_desc.concrete) with + | Pmty_ident x0 -> + let acc = self#longident_loc x0 acc in + acc + | Pmty_signature x0 -> + let acc = self#signature x0 acc in + acc + | Pmty_functor (x0, x1, x2) -> + let acc = self#loc self#string x0 acc in + let acc = self#option self#module_type x1 acc in + let acc = self#module_type x2 acc in + acc + | Pmty_with (x0, x1) -> + let acc = self#module_type x0 acc in + let acc = self#list self#with_constraint x1 acc in + acc + | Pmty_typeof x0 -> + let acc = self#module_expr x0 acc in + acc + | Pmty_extension x0 -> + let acc = self#extension x0 acc in + acc + | Pmty_alias x0 -> + let acc = self#longident_loc x0 acc in + acc + method signature : Signature.t -> 'acc -> 'acc = + fun signature acc -> + let concrete = Signature.to_concrete signature in + let acc = self#list self#signature_item concrete acc in + acc + method signature_item : Signature_item.t -> 'acc -> 'acc = + fun signature_item acc -> + let concrete = Signature_item.to_concrete signature_item in + let { psig_desc; psig_loc } : Signature_item.concrete = concrete in + 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.t -> 'acc -> 'acc = + fun signature_item_desc acc -> + let concrete = Signature_item_desc.to_concrete signature_item_desc in + match (concrete : Signature_item_desc.concrete) with + | Psig_value x0 -> + let acc = self#value_description x0 acc in + acc + | Psig_type (x0, x1) -> + let acc = self#rec_flag x0 acc in + let acc = self#list self#type_declaration x1 acc in + acc + | Psig_typext x0 -> + let acc = self#type_extension x0 acc in + acc + | Psig_exception x0 -> + let acc = self#extension_constructor x0 acc in + acc + | Psig_module x0 -> + let acc = self#module_declaration x0 acc in + acc + | Psig_recmodule x0 -> + let acc = self#list self#module_declaration x0 acc in + acc + | Psig_modtype x0 -> + let acc = self#module_type_declaration x0 acc in + acc + | Psig_open x0 -> + let acc = self#open_description x0 acc in + acc + | Psig_include x0 -> + let acc = self#include_description x0 acc in + acc + | Psig_class x0 -> + let acc = self#list self#class_description x0 acc in + acc + | Psig_class_type x0 -> + let acc = self#list self#class_type_declaration x0 acc in + acc + | Psig_attribute x0 -> + let acc = self#attribute x0 acc in + acc + | Psig_extension (x0, x1) -> + let acc = self#extension x0 acc in + let acc = self#attributes x1 acc in + acc + method module_declaration : Module_declaration.t -> 'acc -> 'acc = + fun module_declaration acc -> + let concrete = Module_declaration.to_concrete module_declaration in + let { pmd_name; pmd_type; pmd_attributes; pmd_loc } : Module_declaration.concrete = concrete in + 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_type_declaration : Module_type_declaration.t -> 'acc -> 'acc = + fun module_type_declaration acc -> + let concrete = Module_type_declaration.to_concrete module_type_declaration in + let { pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc } : Module_type_declaration.concrete = concrete in + 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_description : Open_description.t -> 'acc -> 'acc = + fun open_description acc -> + let concrete = Open_description.to_concrete open_description in + let { popen_lid; popen_override; popen_loc; popen_attributes } : Open_description.concrete = concrete in + 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 + method include_infos : 'a . ('a node -> 'acc -> 'acc) -> 'a node Include_infos.t -> 'acc -> 'acc = + fun fa include_infos acc -> + let concrete = Include_infos.to_concrete include_infos in + let { pincl_mod; pincl_loc; pincl_attributes } : _ Include_infos.concrete = concrete in + let acc = fa 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.t -> 'acc -> 'acc = + fun include_description acc -> + let concrete = Include_description.to_concrete include_description in + let acc = self#include_infos self#module_type concrete acc in + acc + method include_declaration : Include_declaration.t -> 'acc -> 'acc = + fun include_declaration acc -> + let concrete = Include_declaration.to_concrete include_declaration in + let acc = self#include_infos self#module_expr concrete acc in + acc + method with_constraint : With_constraint.t -> 'acc -> 'acc = + fun with_constraint acc -> + let concrete = With_constraint.to_concrete with_constraint in + match (concrete : With_constraint.concrete) with + | Pwith_type (x0, x1) -> + let acc = self#longident_loc x0 acc in + let acc = self#type_declaration x1 acc in + acc + | Pwith_module (x0, x1) -> + let acc = self#longident_loc x0 acc in + let acc = self#longident_loc x1 acc in + acc + | Pwith_typesubst (x0, x1) -> + let acc = self#longident_loc x0 acc in + let acc = self#type_declaration x1 acc in + acc + | Pwith_modsubst (x0, x1) -> + let acc = self#longident_loc x0 acc in + let acc = self#longident_loc x1 acc in + acc + method module_expr : Module_expr.t -> 'acc -> 'acc = + fun module_expr acc -> + let concrete = Module_expr.to_concrete module_expr in + let { pmod_desc; pmod_loc; pmod_attributes } : Module_expr.concrete = concrete in + 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.t -> 'acc -> 'acc = + fun module_expr_desc acc -> + let concrete = Module_expr_desc.to_concrete module_expr_desc in + match (concrete : Module_expr_desc.concrete) with + | Pmod_ident x0 -> + let acc = self#longident_loc x0 acc in + acc + | Pmod_structure x0 -> + let acc = self#structure x0 acc in + acc + | Pmod_functor (x0, x1, x2) -> + let acc = self#loc self#string x0 acc in + let acc = self#option self#module_type x1 acc in + let acc = self#module_expr x2 acc in + acc + | Pmod_apply (x0, x1) -> + let acc = self#module_expr x0 acc in + let acc = self#module_expr x1 acc in + acc + | Pmod_constraint (x0, x1) -> + let acc = self#module_expr x0 acc in + let acc = self#module_type x1 acc in + acc + | Pmod_unpack x0 -> + let acc = self#expression x0 acc in + acc + | Pmod_extension x0 -> + let acc = self#extension x0 acc in + acc + method structure : Structure.t -> 'acc -> 'acc = + fun structure acc -> + let concrete = Structure.to_concrete structure in + let acc = self#list self#structure_item concrete acc in + acc + method structure_item : Structure_item.t -> 'acc -> 'acc = + fun structure_item acc -> + let concrete = Structure_item.to_concrete structure_item in + let { pstr_desc; pstr_loc } : Structure_item.concrete = concrete in + 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.t -> 'acc -> 'acc = + fun structure_item_desc acc -> + let concrete = Structure_item_desc.to_concrete structure_item_desc in + match (concrete : Structure_item_desc.concrete) with + | Pstr_eval (x0, x1) -> + let acc = self#expression x0 acc in + let acc = self#attributes x1 acc in + acc + | Pstr_value (x0, x1) -> + let acc = self#rec_flag x0 acc in + let acc = self#list self#value_binding x1 acc in + acc + | Pstr_primitive x0 -> + let acc = self#value_description x0 acc in + acc + | Pstr_type (x0, x1) -> + let acc = self#rec_flag x0 acc in + let acc = self#list self#type_declaration x1 acc in + acc + | Pstr_typext x0 -> + let acc = self#type_extension x0 acc in + acc + | Pstr_exception x0 -> + let acc = self#extension_constructor x0 acc in + acc + | Pstr_module x0 -> + let acc = self#module_binding x0 acc in + acc + | Pstr_recmodule x0 -> + let acc = self#list self#module_binding x0 acc in + acc + | Pstr_modtype x0 -> + let acc = self#module_type_declaration x0 acc in + acc + | Pstr_open x0 -> + let acc = self#open_description x0 acc in + acc + | Pstr_class x0 -> + let acc = self#list self#class_declaration x0 acc in + acc + | Pstr_class_type x0 -> + let acc = self#list self#class_type_declaration x0 acc in + acc + | Pstr_include x0 -> + let acc = self#include_declaration x0 acc in + acc + | Pstr_attribute x0 -> + let acc = self#attribute x0 acc in + acc + | Pstr_extension (x0, x1) -> + let acc = self#extension x0 acc in + let acc = self#attributes x1 acc in + acc + method value_binding : Value_binding.t -> 'acc -> 'acc = + fun value_binding acc -> + let concrete = Value_binding.to_concrete value_binding in + let { pvb_pat; pvb_expr; pvb_attributes; pvb_loc } : Value_binding.concrete = concrete in + 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.t -> 'acc -> 'acc = + fun module_binding acc -> + let concrete = Module_binding.to_concrete module_binding in + let { pmb_name; pmb_expr; pmb_attributes; pmb_loc } : Module_binding.concrete = concrete in + 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.t -> 'acc -> 'acc = + fun toplevel_phrase acc -> + let concrete = Toplevel_phrase.to_concrete toplevel_phrase in + match (concrete : Toplevel_phrase.concrete) with + | Ptop_def x0 -> + let acc = self#structure x0 acc in + acc + | Ptop_dir (x0, x1) -> + let acc = self#string x0 acc in + let acc = self#directive_argument x1 acc in + acc + method directive_argument : Directive_argument.t -> 'acc -> 'acc = + fun directive_argument acc -> + let concrete = Directive_argument.to_concrete directive_argument in + match (concrete : Directive_argument.concrete) with + | Pdir_none -> + acc + | Pdir_string x0 -> + let acc = self#string x0 acc in + acc + | Pdir_int (x0, x1) -> + let acc = self#string x0 acc in + let acc = self#option self#char x1 acc in + acc + | Pdir_ident x0 -> + let acc = self#longident x0 acc in + acc + | Pdir_bool x0 -> + let acc = self#bool x0 acc in + acc + end + +class virtual ['acc] fold_map = + object (self) + method virtual bool : bool -> 'acc -> (bool * 'acc) + method virtual char : char -> 'acc -> (char * 'acc) + method virtual int : int -> 'acc -> (int * 'acc) + method virtual list : '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) + method virtual string : string -> 'acc -> (string * 'acc) + method virtual location : Astlib.Location.t -> 'acc -> (Astlib.Location.t * 'acc) + method virtual loc : 'a . ('a -> 'acc -> ('a * 'acc)) -> 'a Astlib.Loc.t -> 'acc -> ('a Astlib.Loc.t * 'acc) + method longident : Longident.t -> 'acc -> (Longident.t * 'acc) = + fun longident acc -> + let concrete = Longident.to_concrete longident in + match (concrete : Longident.concrete) with + | Lident x0 -> + let (x0, acc) = self#string x0 acc in + (Longident.of_concrete (Lident x0), acc) + | Ldot (x0, x1) -> + let (x0, acc) = self#longident x0 acc in + let (x1, acc) = self#string x1 acc in + (Longident.of_concrete (Ldot (x0, x1)), acc) + | Lapply (x0, x1) -> + let (x0, acc) = self#longident x0 acc in + let (x1, acc) = self#longident x1 acc in + (Longident.of_concrete (Lapply (x0, x1)), acc) + method longident_loc : Longident_loc.t -> 'acc -> (Longident_loc.t * 'acc) = + fun longident_loc acc -> + let concrete = Longident_loc.to_concrete longident_loc in + let (concrete, acc) = self#loc self#longident concrete acc in + (Longident_loc.of_concrete concrete, acc) + method rec_flag : Rec_flag.t -> 'acc -> (Rec_flag.t * 'acc) = + fun rec_flag acc -> + let concrete = Rec_flag.to_concrete rec_flag in + match (concrete : Rec_flag.concrete) with + | Nonrecursive -> + (Rec_flag.of_concrete Nonrecursive, acc) + | Recursive -> + (Rec_flag.of_concrete Recursive, acc) + method direction_flag : Direction_flag.t -> 'acc -> (Direction_flag.t * 'acc) = + fun direction_flag acc -> + let concrete = Direction_flag.to_concrete direction_flag in + match (concrete : Direction_flag.concrete) with + | Upto -> + (Direction_flag.of_concrete Upto, acc) + | Downto -> + (Direction_flag.of_concrete Downto, acc) + method private_flag : Private_flag.t -> 'acc -> (Private_flag.t * 'acc) = + fun private_flag acc -> + let concrete = Private_flag.to_concrete private_flag in + match (concrete : Private_flag.concrete) with + | Private -> + (Private_flag.of_concrete Private, acc) + | Public -> + (Private_flag.of_concrete Public, acc) + method mutable_flag : Mutable_flag.t -> 'acc -> (Mutable_flag.t * 'acc) = + fun mutable_flag acc -> + let concrete = Mutable_flag.to_concrete mutable_flag in + match (concrete : Mutable_flag.concrete) with + | Immutable -> + (Mutable_flag.of_concrete Immutable, acc) + | Mutable -> + (Mutable_flag.of_concrete Mutable, acc) + method virtual_flag : Virtual_flag.t -> 'acc -> (Virtual_flag.t * 'acc) = + fun virtual_flag acc -> + let concrete = Virtual_flag.to_concrete virtual_flag in + match (concrete : Virtual_flag.concrete) with + | Virtual -> + (Virtual_flag.of_concrete Virtual, acc) + | Concrete -> + (Virtual_flag.of_concrete Concrete, acc) + method override_flag : Override_flag.t -> 'acc -> (Override_flag.t * 'acc) = + fun override_flag acc -> + let concrete = Override_flag.to_concrete override_flag in + match (concrete : Override_flag.concrete) with + | Override -> + (Override_flag.of_concrete Override, acc) + | Fresh -> + (Override_flag.of_concrete Fresh, acc) + method closed_flag : Closed_flag.t -> 'acc -> (Closed_flag.t * 'acc) = + fun closed_flag acc -> + let concrete = Closed_flag.to_concrete closed_flag in + match (concrete : Closed_flag.concrete) with + | Closed -> + (Closed_flag.of_concrete Closed, acc) + | Open -> + (Closed_flag.of_concrete Open, acc) + method arg_label : Arg_label.t -> 'acc -> (Arg_label.t * 'acc) = + fun arg_label acc -> + let concrete = Arg_label.to_concrete arg_label in + match (concrete : Arg_label.concrete) with + | Nolabel -> + (Arg_label.of_concrete Nolabel, acc) + | Labelled x0 -> + let (x0, acc) = self#string x0 acc in + (Arg_label.of_concrete (Labelled x0), acc) + | Optional x0 -> + let (x0, acc) = self#string x0 acc in + (Arg_label.of_concrete (Optional x0), acc) + method variance : Variance.t -> 'acc -> (Variance.t * 'acc) = + fun variance acc -> + let concrete = Variance.to_concrete variance in + match (concrete : Variance.concrete) with + | Covariant -> + (Variance.of_concrete Covariant, acc) + | Contravariant -> + (Variance.of_concrete Contravariant, acc) + | Invariant -> + (Variance.of_concrete Invariant, acc) + method constant : Constant.t -> 'acc -> (Constant.t * 'acc) = + fun constant acc -> + let concrete = Constant.to_concrete constant in + match (concrete : Constant.concrete) with + | Pconst_integer (x0, x1) -> + let (x0, acc) = self#string x0 acc in + let (x1, acc) = self#option self#char x1 acc in + (Constant.of_concrete (Pconst_integer (x0, x1)), acc) + | Pconst_char x0 -> + let (x0, acc) = self#char x0 acc in + (Constant.of_concrete (Pconst_char x0), acc) + | Pconst_string (x0, x1) -> + let (x0, acc) = self#string x0 acc in + let (x1, acc) = self#option self#string x1 acc in + (Constant.of_concrete (Pconst_string (x0, x1)), acc) + | Pconst_float (x0, x1) -> + let (x0, acc) = self#string x0 acc in + let (x1, acc) = self#option self#char x1 acc in + (Constant.of_concrete (Pconst_float (x0, x1)), acc) + method attribute : Attribute.t -> 'acc -> (Attribute.t * 'acc) = + fun attribute acc -> + let concrete = Attribute.to_concrete attribute in + let (x0, x1) = concrete in + let (x0, acc) = self#loc self#string x0 acc in + let (x1, acc) = self#payload x1 acc in + (Attribute.of_concrete (x0, x1), acc) + method extension : Extension.t -> 'acc -> (Extension.t * 'acc) = + fun extension acc -> + let concrete = Extension.to_concrete extension in + let (x0, x1) = concrete in + let (x0, acc) = self#loc self#string x0 acc in + let (x1, acc) = self#payload x1 acc in + (Extension.of_concrete (x0, x1), acc) + method attributes : Attributes.t -> 'acc -> (Attributes.t * 'acc) = + fun attributes acc -> + let concrete = Attributes.to_concrete attributes in + let (concrete, acc) = self#list self#attribute concrete acc in + (Attributes.of_concrete concrete, acc) + method payload : Payload.t -> 'acc -> (Payload.t * 'acc) = + fun payload acc -> + let concrete = Payload.to_concrete payload in + match (concrete : Payload.concrete) with + | PStr x0 -> + let (x0, acc) = self#structure x0 acc in + (Payload.of_concrete (PStr x0), acc) + | PSig x0 -> + let (x0, acc) = self#signature x0 acc in + (Payload.of_concrete (PSig x0), acc) + | PTyp x0 -> + let (x0, acc) = self#core_type x0 acc in + (Payload.of_concrete (PTyp x0), acc) + | PPat (x0, x1) -> + let (x0, acc) = self#pattern x0 acc in + let (x1, acc) = self#option self#expression x1 acc in + (Payload.of_concrete (PPat (x0, x1)), acc) + method core_type : Core_type.t -> 'acc -> (Core_type.t * 'acc) = + fun core_type acc -> + let concrete = Core_type.to_concrete core_type in + let { ptyp_desc; ptyp_loc; ptyp_attributes } : Core_type.concrete = concrete in + 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 + (Core_type.of_concrete { ptyp_desc; ptyp_loc; ptyp_attributes }, acc) + method core_type_desc : Core_type_desc.t -> 'acc -> (Core_type_desc.t * 'acc) = + fun core_type_desc acc -> + let concrete = Core_type_desc.to_concrete core_type_desc in + match (concrete : Core_type_desc.concrete) with + | Ptyp_any -> + (Core_type_desc.of_concrete Ptyp_any, acc) + | Ptyp_var x0 -> + let (x0, acc) = self#string x0 acc in + (Core_type_desc.of_concrete (Ptyp_var x0), acc) + | Ptyp_arrow (x0, x1, x2) -> + let (x0, acc) = self#arg_label x0 acc in + let (x1, acc) = self#core_type x1 acc in + let (x2, acc) = self#core_type x2 acc in + (Core_type_desc.of_concrete (Ptyp_arrow (x0, x1, x2)), acc) + | Ptyp_tuple x0 -> + let (x0, acc) = self#list self#core_type x0 acc in + (Core_type_desc.of_concrete (Ptyp_tuple x0), acc) + | Ptyp_constr (x0, x1) -> + let (x0, acc) = self#longident_loc x0 acc in + let (x1, acc) = self#list self#core_type x1 acc in + (Core_type_desc.of_concrete (Ptyp_constr (x0, x1)), acc) + | Ptyp_object (x0, x1) -> + let (x0, acc) = self#list self#object_field x0 acc in + let (x1, acc) = self#closed_flag x1 acc in + (Core_type_desc.of_concrete (Ptyp_object (x0, x1)), acc) + | Ptyp_class (x0, x1) -> + let (x0, acc) = self#longident_loc x0 acc in + let (x1, acc) = self#list self#core_type x1 acc in + (Core_type_desc.of_concrete (Ptyp_class (x0, x1)), acc) + | Ptyp_alias (x0, x1) -> + let (x0, acc) = self#core_type x0 acc in + let (x1, acc) = self#string x1 acc in + (Core_type_desc.of_concrete (Ptyp_alias (x0, x1)), acc) + | Ptyp_variant (x0, x1, x2) -> + let (x0, acc) = self#list self#row_field x0 acc in + let (x1, acc) = self#closed_flag x1 acc in + let (x2, acc) = self#option (self#list self#string) x2 acc in + (Core_type_desc.of_concrete (Ptyp_variant (x0, x1, x2)), acc) + | Ptyp_poly (x0, x1) -> + let (x0, acc) = self#list (self#loc self#string) x0 acc in + let (x1, acc) = self#core_type x1 acc in + (Core_type_desc.of_concrete (Ptyp_poly (x0, x1)), acc) + | Ptyp_package x0 -> + let (x0, acc) = self#package_type x0 acc in + (Core_type_desc.of_concrete (Ptyp_package x0), acc) + | Ptyp_extension x0 -> + let (x0, acc) = self#extension x0 acc in + (Core_type_desc.of_concrete (Ptyp_extension x0), acc) + method package_type : Package_type.t -> 'acc -> (Package_type.t * 'acc) = + fun package_type acc -> + let concrete = Package_type.to_concrete package_type in + let (x0, x1) = concrete in + let (x0, acc) = self#longident_loc x0 acc in + let (x1, acc) = self#list (fun (x0, x1) acc -> let (x0, acc) = self#longident_loc x0 acc in let (x1, acc) = self#core_type x1 acc in ((x0, x1), acc)) x1 acc in + (Package_type.of_concrete (x0, x1), acc) + method row_field : Row_field.t -> 'acc -> (Row_field.t * 'acc) = + fun row_field acc -> + let concrete = Row_field.to_concrete row_field in + match (concrete : Row_field.concrete) with + | Rtag (x0, x1, x2, x3) -> + let (x0, acc) = self#loc self#string x0 acc in + let (x1, acc) = self#attributes x1 acc in + let (x2, acc) = self#bool x2 acc in + let (x3, acc) = self#list self#core_type x3 acc in + (Row_field.of_concrete (Rtag (x0, x1, x2, x3)), acc) + | Rinherit x0 -> + let (x0, acc) = self#core_type x0 acc in + (Row_field.of_concrete (Rinherit x0), acc) + method object_field : Object_field.t -> 'acc -> (Object_field.t * 'acc) = + fun object_field acc -> + let concrete = Object_field.to_concrete object_field in + match (concrete : Object_field.concrete) with + | Otag (x0, x1, x2) -> + let (x0, acc) = self#loc self#string x0 acc in + let (x1, acc) = self#attributes x1 acc in + let (x2, acc) = self#core_type x2 acc in + (Object_field.of_concrete (Otag (x0, x1, x2)), acc) + | Oinherit x0 -> + let (x0, acc) = self#core_type x0 acc in + (Object_field.of_concrete (Oinherit x0), acc) + method pattern : Pattern.t -> 'acc -> (Pattern.t * 'acc) = + fun pattern acc -> + let concrete = Pattern.to_concrete pattern in + let { ppat_desc; ppat_loc; ppat_attributes } : Pattern.concrete = concrete in + 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 + (Pattern.of_concrete { ppat_desc; ppat_loc; ppat_attributes }, acc) + method pattern_desc : Pattern_desc.t -> 'acc -> (Pattern_desc.t * 'acc) = + fun pattern_desc acc -> + let concrete = Pattern_desc.to_concrete pattern_desc in + match (concrete : Pattern_desc.concrete) with + | Ppat_any -> + (Pattern_desc.of_concrete Ppat_any, acc) + | Ppat_var x0 -> + let (x0, acc) = self#loc self#string x0 acc in + (Pattern_desc.of_concrete (Ppat_var x0), acc) + | Ppat_alias (x0, x1) -> + let (x0, acc) = self#pattern x0 acc in + let (x1, acc) = self#loc self#string x1 acc in + (Pattern_desc.of_concrete (Ppat_alias (x0, x1)), acc) + | Ppat_constant x0 -> + let (x0, acc) = self#constant x0 acc in + (Pattern_desc.of_concrete (Ppat_constant x0), acc) + | Ppat_interval (x0, x1) -> + let (x0, acc) = self#constant x0 acc in + let (x1, acc) = self#constant x1 acc in + (Pattern_desc.of_concrete (Ppat_interval (x0, x1)), acc) + | Ppat_tuple x0 -> + let (x0, acc) = self#list self#pattern x0 acc in + (Pattern_desc.of_concrete (Ppat_tuple x0), acc) + | Ppat_construct (x0, x1) -> + let (x0, acc) = self#longident_loc x0 acc in + let (x1, acc) = self#option self#pattern x1 acc in + (Pattern_desc.of_concrete (Ppat_construct (x0, x1)), acc) + | Ppat_variant (x0, x1) -> + let (x0, acc) = self#string x0 acc in + let (x1, acc) = self#option self#pattern x1 acc in + (Pattern_desc.of_concrete (Ppat_variant (x0, x1)), acc) + | Ppat_record (x0, x1) -> + let (x0, acc) = self#list (fun (x0, x1) acc -> let (x0, acc) = self#longident_loc x0 acc in let (x1, acc) = self#pattern x1 acc in ((x0, x1), acc)) x0 acc in + let (x1, acc) = self#closed_flag x1 acc in + (Pattern_desc.of_concrete (Ppat_record (x0, x1)), acc) + | Ppat_array x0 -> + let (x0, acc) = self#list self#pattern x0 acc in + (Pattern_desc.of_concrete (Ppat_array x0), acc) + | Ppat_or (x0, x1) -> + let (x0, acc) = self#pattern x0 acc in + let (x1, acc) = self#pattern x1 acc in + (Pattern_desc.of_concrete (Ppat_or (x0, x1)), acc) + | Ppat_constraint (x0, x1) -> + let (x0, acc) = self#pattern x0 acc in + let (x1, acc) = self#core_type x1 acc in + (Pattern_desc.of_concrete (Ppat_constraint (x0, x1)), acc) + | Ppat_type x0 -> + let (x0, acc) = self#longident_loc x0 acc in + (Pattern_desc.of_concrete (Ppat_type x0), acc) + | Ppat_lazy x0 -> + let (x0, acc) = self#pattern x0 acc in + (Pattern_desc.of_concrete (Ppat_lazy x0), acc) + | Ppat_unpack x0 -> + let (x0, acc) = self#loc self#string x0 acc in + (Pattern_desc.of_concrete (Ppat_unpack x0), acc) + | Ppat_exception x0 -> + let (x0, acc) = self#pattern x0 acc in + (Pattern_desc.of_concrete (Ppat_exception x0), acc) + | Ppat_extension x0 -> + let (x0, acc) = self#extension x0 acc in + (Pattern_desc.of_concrete (Ppat_extension x0), acc) + | Ppat_open (x0, x1) -> + let (x0, acc) = self#longident_loc x0 acc in + let (x1, acc) = self#pattern x1 acc in + (Pattern_desc.of_concrete (Ppat_open (x0, x1)), acc) + method expression : Expression.t -> 'acc -> (Expression.t * 'acc) = + fun expression acc -> + let concrete = Expression.to_concrete expression in + let { pexp_desc; pexp_loc; pexp_attributes } : Expression.concrete = concrete in + 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 + (Expression.of_concrete { pexp_desc; pexp_loc; pexp_attributes }, acc) + method expression_desc : Expression_desc.t -> 'acc -> (Expression_desc.t * 'acc) = + fun expression_desc acc -> + let concrete = Expression_desc.to_concrete expression_desc in + match (concrete : Expression_desc.concrete) with + | Pexp_ident x0 -> + let (x0, acc) = self#longident_loc x0 acc in + (Expression_desc.of_concrete (Pexp_ident x0), acc) + | Pexp_constant x0 -> + let (x0, acc) = self#constant x0 acc in + (Expression_desc.of_concrete (Pexp_constant x0), acc) + | Pexp_let (x0, x1, x2) -> + let (x0, acc) = self#rec_flag x0 acc in + let (x1, acc) = self#list self#value_binding x1 acc in + let (x2, acc) = self#expression x2 acc in + (Expression_desc.of_concrete (Pexp_let (x0, x1, x2)), acc) + | Pexp_function x0 -> + let (x0, acc) = self#list self#case x0 acc in + (Expression_desc.of_concrete (Pexp_function x0), acc) + | Pexp_fun (x0, x1, x2, x3) -> + let (x0, acc) = self#arg_label x0 acc in + let (x1, acc) = self#option self#expression x1 acc in + let (x2, acc) = self#pattern x2 acc in + let (x3, acc) = self#expression x3 acc in + (Expression_desc.of_concrete (Pexp_fun (x0, x1, x2, x3)), acc) + | Pexp_apply (x0, x1) -> + let (x0, acc) = self#expression x0 acc in + let (x1, acc) = self#list (fun (x0, x1) acc -> let (x0, acc) = self#arg_label x0 acc in let (x1, acc) = self#expression x1 acc in ((x0, x1), acc)) x1 acc in + (Expression_desc.of_concrete (Pexp_apply (x0, x1)), acc) + | Pexp_match (x0, x1) -> + let (x0, acc) = self#expression x0 acc in + let (x1, acc) = self#list self#case x1 acc in + (Expression_desc.of_concrete (Pexp_match (x0, x1)), acc) + | Pexp_try (x0, x1) -> + let (x0, acc) = self#expression x0 acc in + let (x1, acc) = self#list self#case x1 acc in + (Expression_desc.of_concrete (Pexp_try (x0, x1)), acc) + | Pexp_tuple x0 -> + let (x0, acc) = self#list self#expression x0 acc in + (Expression_desc.of_concrete (Pexp_tuple x0), acc) + | Pexp_construct (x0, x1) -> + let (x0, acc) = self#longident_loc x0 acc in + let (x1, acc) = self#option self#expression x1 acc in + (Expression_desc.of_concrete (Pexp_construct (x0, x1)), acc) + | Pexp_variant (x0, x1) -> + let (x0, acc) = self#string x0 acc in + let (x1, acc) = self#option self#expression x1 acc in + (Expression_desc.of_concrete (Pexp_variant (x0, x1)), acc) + | Pexp_record (x0, x1) -> + let (x0, acc) = self#list (fun (x0, x1) acc -> let (x0, acc) = self#longident_loc x0 acc in let (x1, acc) = self#expression x1 acc in ((x0, x1), acc)) x0 acc in + let (x1, acc) = self#option self#expression x1 acc in + (Expression_desc.of_concrete (Pexp_record (x0, x1)), acc) + | Pexp_field (x0, x1) -> + let (x0, acc) = self#expression x0 acc in + let (x1, acc) = self#longident_loc x1 acc in + (Expression_desc.of_concrete (Pexp_field (x0, x1)), acc) + | Pexp_setfield (x0, x1, x2) -> + let (x0, acc) = self#expression x0 acc in + let (x1, acc) = self#longident_loc x1 acc in + let (x2, acc) = self#expression x2 acc in + (Expression_desc.of_concrete (Pexp_setfield (x0, x1, x2)), acc) + | Pexp_array x0 -> + let (x0, acc) = self#list self#expression x0 acc in + (Expression_desc.of_concrete (Pexp_array x0), acc) + | Pexp_ifthenelse (x0, x1, x2) -> + let (x0, acc) = self#expression x0 acc in + let (x1, acc) = self#expression x1 acc in + let (x2, acc) = self#option self#expression x2 acc in + (Expression_desc.of_concrete (Pexp_ifthenelse (x0, x1, x2)), acc) + | Pexp_sequence (x0, x1) -> + let (x0, acc) = self#expression x0 acc in + let (x1, acc) = self#expression x1 acc in + (Expression_desc.of_concrete (Pexp_sequence (x0, x1)), acc) + | Pexp_while (x0, x1) -> + let (x0, acc) = self#expression x0 acc in + let (x1, acc) = self#expression x1 acc in + (Expression_desc.of_concrete (Pexp_while (x0, x1)), acc) + | Pexp_for (x0, x1, x2, x3, x4) -> + let (x0, acc) = self#pattern x0 acc in + let (x1, acc) = self#expression x1 acc in + let (x2, acc) = self#expression x2 acc in + let (x3, acc) = self#direction_flag x3 acc in + let (x4, acc) = self#expression x4 acc in + (Expression_desc.of_concrete (Pexp_for (x0, x1, x2, x3, x4)), acc) + | Pexp_constraint (x0, x1) -> + let (x0, acc) = self#expression x0 acc in + let (x1, acc) = self#core_type x1 acc in + (Expression_desc.of_concrete (Pexp_constraint (x0, x1)), acc) + | Pexp_coerce (x0, x1, x2) -> + let (x0, acc) = self#expression x0 acc in + let (x1, acc) = self#option self#core_type x1 acc in + let (x2, acc) = self#core_type x2 acc in + (Expression_desc.of_concrete (Pexp_coerce (x0, x1, x2)), acc) + | Pexp_send (x0, x1) -> + let (x0, acc) = self#expression x0 acc in + let (x1, acc) = self#loc self#string x1 acc in + (Expression_desc.of_concrete (Pexp_send (x0, x1)), acc) + | Pexp_new x0 -> + let (x0, acc) = self#longident_loc x0 acc in + (Expression_desc.of_concrete (Pexp_new x0), acc) + | Pexp_setinstvar (x0, x1) -> + let (x0, acc) = self#loc self#string x0 acc in + let (x1, acc) = self#expression x1 acc in + (Expression_desc.of_concrete (Pexp_setinstvar (x0, x1)), acc) + | Pexp_override x0 -> + let (x0, acc) = self#list (fun (x0, x1) acc -> let (x0, acc) = self#loc self#string x0 acc in let (x1, acc) = self#expression x1 acc in ((x0, x1), acc)) x0 acc in + (Expression_desc.of_concrete (Pexp_override x0), acc) + | Pexp_letmodule (x0, x1, x2) -> + let (x0, acc) = self#loc self#string x0 acc in + let (x1, acc) = self#module_expr x1 acc in + let (x2, acc) = self#expression x2 acc in + (Expression_desc.of_concrete (Pexp_letmodule (x0, x1, x2)), acc) + | Pexp_letexception (x0, x1) -> + let (x0, acc) = self#extension_constructor x0 acc in + let (x1, acc) = self#expression x1 acc in + (Expression_desc.of_concrete (Pexp_letexception (x0, x1)), acc) + | Pexp_assert x0 -> + let (x0, acc) = self#expression x0 acc in + (Expression_desc.of_concrete (Pexp_assert x0), acc) + | Pexp_lazy x0 -> + let (x0, acc) = self#expression x0 acc in + (Expression_desc.of_concrete (Pexp_lazy x0), acc) + | Pexp_poly (x0, x1) -> + let (x0, acc) = self#expression x0 acc in + let (x1, acc) = self#option self#core_type x1 acc in + (Expression_desc.of_concrete (Pexp_poly (x0, x1)), acc) + | Pexp_object x0 -> + let (x0, acc) = self#class_structure x0 acc in + (Expression_desc.of_concrete (Pexp_object x0), acc) + | Pexp_newtype (x0, x1) -> + let (x0, acc) = self#loc self#string x0 acc in + let (x1, acc) = self#expression x1 acc in + (Expression_desc.of_concrete (Pexp_newtype (x0, x1)), acc) + | Pexp_pack x0 -> + let (x0, acc) = self#module_expr x0 acc in + (Expression_desc.of_concrete (Pexp_pack x0), acc) + | Pexp_open (x0, x1, x2) -> + let (x0, acc) = self#override_flag x0 acc in + let (x1, acc) = self#longident_loc x1 acc in + let (x2, acc) = self#expression x2 acc in + (Expression_desc.of_concrete (Pexp_open (x0, x1, x2)), acc) + | Pexp_extension x0 -> + let (x0, acc) = self#extension x0 acc in + (Expression_desc.of_concrete (Pexp_extension x0), acc) + | Pexp_unreachable -> + (Expression_desc.of_concrete Pexp_unreachable, acc) + method case : Case.t -> 'acc -> (Case.t * 'acc) = + fun case acc -> + let concrete = Case.to_concrete case in + let { pc_lhs; pc_guard; pc_rhs } : Case.concrete = concrete in + 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 + (Case.of_concrete { pc_lhs; pc_guard; pc_rhs }, acc) + method value_description : Value_description.t -> 'acc -> (Value_description.t * 'acc) = + fun value_description acc -> + let concrete = Value_description.to_concrete value_description in + let { pval_name; pval_type; pval_prim; pval_attributes; pval_loc } : Value_description.concrete = concrete in + 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 + (Value_description.of_concrete { pval_name; pval_type; pval_prim; pval_attributes; pval_loc }, acc) + method type_declaration : Type_declaration.t -> 'acc -> (Type_declaration.t * 'acc) = + fun type_declaration acc -> + let concrete = Type_declaration.to_concrete type_declaration in + let { ptype_name; ptype_params; ptype_cstrs; ptype_kind; ptype_private; ptype_manifest; ptype_attributes; ptype_loc } : Type_declaration.concrete = concrete in + let (ptype_name, acc) = self#loc self#string ptype_name acc in + let (ptype_params, acc) = self#list (fun (x0, x1) acc -> let (x0, acc) = self#core_type x0 acc in let (x1, acc) = self#variance x1 acc in ((x0, x1), acc)) ptype_params acc in + let (ptype_cstrs, acc) = self#list (fun (x0, x1, x2) acc -> let (x0, acc) = self#core_type x0 acc in let (x1, acc) = self#core_type x1 acc in let (x2, acc) = self#location x2 acc in ((x0, x1, x2), 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 + (Type_declaration.of_concrete { ptype_name; ptype_params; ptype_cstrs; ptype_kind; ptype_private; ptype_manifest; ptype_attributes; ptype_loc }, acc) + method type_kind : Type_kind.t -> 'acc -> (Type_kind.t * 'acc) = + fun type_kind acc -> + let concrete = Type_kind.to_concrete type_kind in + match (concrete : Type_kind.concrete) with + | Ptype_abstract -> + (Type_kind.of_concrete Ptype_abstract, acc) + | Ptype_variant x0 -> + let (x0, acc) = self#list self#constructor_declaration x0 acc in + (Type_kind.of_concrete (Ptype_variant x0), acc) + | Ptype_record x0 -> + let (x0, acc) = self#list self#label_declaration x0 acc in + (Type_kind.of_concrete (Ptype_record x0), acc) + | Ptype_open -> + (Type_kind.of_concrete Ptype_open, acc) + method label_declaration : Label_declaration.t -> 'acc -> (Label_declaration.t * 'acc) = + fun label_declaration acc -> + let concrete = Label_declaration.to_concrete label_declaration in + let { pld_name; pld_mutable; pld_type; pld_loc; pld_attributes } : Label_declaration.concrete = concrete in + 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 + (Label_declaration.of_concrete { pld_name; pld_mutable; pld_type; pld_loc; pld_attributes }, acc) + method constructor_declaration : Constructor_declaration.t -> 'acc -> (Constructor_declaration.t * 'acc) = + fun constructor_declaration acc -> + let concrete = Constructor_declaration.to_concrete constructor_declaration in + let { pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes } : Constructor_declaration.concrete = concrete in + 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 + (Constructor_declaration.of_concrete { pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes }, acc) + method constructor_arguments : Constructor_arguments.t -> 'acc -> (Constructor_arguments.t * 'acc) = + fun constructor_arguments acc -> + let concrete = Constructor_arguments.to_concrete constructor_arguments in + match (concrete : Constructor_arguments.concrete) with + | Pcstr_tuple x0 -> + let (x0, acc) = self#list self#core_type x0 acc in + (Constructor_arguments.of_concrete (Pcstr_tuple x0), acc) + | Pcstr_record x0 -> + let (x0, acc) = self#list self#label_declaration x0 acc in + (Constructor_arguments.of_concrete (Pcstr_record x0), acc) + method type_extension : Type_extension.t -> 'acc -> (Type_extension.t * 'acc) = + fun type_extension acc -> + let concrete = Type_extension.to_concrete type_extension in + let { ptyext_path; ptyext_params; ptyext_constructors; ptyext_private; ptyext_attributes } : Type_extension.concrete = concrete in + let (ptyext_path, acc) = self#longident_loc ptyext_path acc in + let (ptyext_params, acc) = self#list (fun (x0, x1) acc -> let (x0, acc) = self#core_type x0 acc in let (x1, acc) = self#variance x1 acc in ((x0, x1), 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 + (Type_extension.of_concrete { ptyext_path; ptyext_params; ptyext_constructors; ptyext_private; ptyext_attributes }, acc) + method extension_constructor : Extension_constructor.t -> 'acc -> (Extension_constructor.t * 'acc) = + fun extension_constructor acc -> + let concrete = Extension_constructor.to_concrete extension_constructor in + let { pext_name; pext_kind; pext_loc; pext_attributes } : Extension_constructor.concrete = concrete in + 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 + (Extension_constructor.of_concrete { pext_name; pext_kind; pext_loc; pext_attributes }, acc) + method extension_constructor_kind : Extension_constructor_kind.t -> 'acc -> (Extension_constructor_kind.t * 'acc) = + fun extension_constructor_kind acc -> + let concrete = Extension_constructor_kind.to_concrete extension_constructor_kind in + match (concrete : Extension_constructor_kind.concrete) with + | Pext_decl (x0, x1) -> + let (x0, acc) = self#constructor_arguments x0 acc in + let (x1, acc) = self#option self#core_type x1 acc in + (Extension_constructor_kind.of_concrete (Pext_decl (x0, x1)), acc) + | Pext_rebind x0 -> + let (x0, acc) = self#longident_loc x0 acc in + (Extension_constructor_kind.of_concrete (Pext_rebind x0), acc) + method class_type : Class_type.t -> 'acc -> (Class_type.t * 'acc) = + fun class_type acc -> + let concrete = Class_type.to_concrete class_type in + let { pcty_desc; pcty_loc; pcty_attributes } : Class_type.concrete = concrete in + 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 + (Class_type.of_concrete { pcty_desc; pcty_loc; pcty_attributes }, acc) + method class_type_desc : Class_type_desc.t -> 'acc -> (Class_type_desc.t * 'acc) = + fun class_type_desc acc -> + let concrete = Class_type_desc.to_concrete class_type_desc in + match (concrete : Class_type_desc.concrete) with + | Pcty_constr (x0, x1) -> + let (x0, acc) = self#longident_loc x0 acc in + let (x1, acc) = self#list self#core_type x1 acc in + (Class_type_desc.of_concrete (Pcty_constr (x0, x1)), acc) + | Pcty_signature x0 -> + let (x0, acc) = self#class_signature x0 acc in + (Class_type_desc.of_concrete (Pcty_signature x0), acc) + | Pcty_arrow (x0, x1, x2) -> + let (x0, acc) = self#arg_label x0 acc in + let (x1, acc) = self#core_type x1 acc in + let (x2, acc) = self#class_type x2 acc in + (Class_type_desc.of_concrete (Pcty_arrow (x0, x1, x2)), acc) + | Pcty_extension x0 -> + let (x0, acc) = self#extension x0 acc in + (Class_type_desc.of_concrete (Pcty_extension x0), acc) + | Pcty_open (x0, x1, x2) -> + let (x0, acc) = self#override_flag x0 acc in + let (x1, acc) = self#longident_loc x1 acc in + let (x2, acc) = self#class_type x2 acc in + (Class_type_desc.of_concrete (Pcty_open (x0, x1, x2)), acc) + method class_signature : Class_signature.t -> 'acc -> (Class_signature.t * 'acc) = + fun class_signature acc -> + let concrete = Class_signature.to_concrete class_signature in + let { pcsig_self; pcsig_fields } : Class_signature.concrete = concrete in + 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 + (Class_signature.of_concrete { pcsig_self; pcsig_fields }, acc) + method class_type_field : Class_type_field.t -> 'acc -> (Class_type_field.t * 'acc) = + fun class_type_field acc -> + let concrete = Class_type_field.to_concrete class_type_field in + let { pctf_desc; pctf_loc; pctf_attributes } : Class_type_field.concrete = concrete in + 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 + (Class_type_field.of_concrete { pctf_desc; pctf_loc; pctf_attributes }, acc) + method class_type_field_desc : Class_type_field_desc.t -> 'acc -> (Class_type_field_desc.t * 'acc) = + fun class_type_field_desc acc -> + let concrete = Class_type_field_desc.to_concrete class_type_field_desc in + match (concrete : Class_type_field_desc.concrete) with + | Pctf_inherit x0 -> + let (x0, acc) = self#class_type x0 acc in + (Class_type_field_desc.of_concrete (Pctf_inherit x0), acc) + | Pctf_val x0 -> + let (x0, acc) = (fun (x0, x1, x2, x3) acc -> let (x0, acc) = self#loc self#string x0 acc in let (x1, acc) = self#mutable_flag x1 acc in let (x2, acc) = self#virtual_flag x2 acc in let (x3, acc) = self#core_type x3 acc in ((x0, x1, x2, x3), acc)) x0 acc in + (Class_type_field_desc.of_concrete (Pctf_val x0), acc) + | Pctf_method x0 -> + let (x0, acc) = (fun (x0, x1, x2, x3) acc -> let (x0, acc) = self#loc self#string x0 acc in let (x1, acc) = self#private_flag x1 acc in let (x2, acc) = self#virtual_flag x2 acc in let (x3, acc) = self#core_type x3 acc in ((x0, x1, x2, x3), acc)) x0 acc in + (Class_type_field_desc.of_concrete (Pctf_method x0), acc) + | Pctf_constraint x0 -> + let (x0, acc) = (fun (x0, x1) acc -> let (x0, acc) = self#core_type x0 acc in let (x1, acc) = self#core_type x1 acc in ((x0, x1), acc)) x0 acc in + (Class_type_field_desc.of_concrete (Pctf_constraint x0), acc) + | Pctf_attribute x0 -> + let (x0, acc) = self#attribute x0 acc in + (Class_type_field_desc.of_concrete (Pctf_attribute x0), acc) + | Pctf_extension x0 -> + let (x0, acc) = self#extension x0 acc in + (Class_type_field_desc.of_concrete (Pctf_extension x0), acc) + method class_infos : 'a . ('a node -> 'acc -> ('a node * 'acc)) -> 'a node Class_infos.t -> 'acc -> ('a node Class_infos.t * 'acc) = + fun fa class_infos acc -> + let concrete = Class_infos.to_concrete class_infos in + let { pci_virt; pci_params; pci_name; pci_expr; pci_loc; pci_attributes } : _ Class_infos.concrete = concrete in + let (pci_virt, acc) = self#virtual_flag pci_virt acc in + let (pci_params, acc) = self#list (fun (x0, x1) acc -> let (x0, acc) = self#core_type x0 acc in let (x1, acc) = self#variance x1 acc in ((x0, x1), acc)) pci_params acc in + let (pci_name, acc) = self#loc self#string pci_name acc in + let (pci_expr, acc) = fa pci_expr acc in + let (pci_loc, acc) = self#location pci_loc acc in + let (pci_attributes, acc) = self#attributes pci_attributes acc in + (Class_infos.of_concrete { pci_virt; pci_params; pci_name; pci_expr; pci_loc; pci_attributes }, acc) + method class_description : Class_description.t -> 'acc -> (Class_description.t * 'acc) = + fun class_description acc -> + let concrete = Class_description.to_concrete class_description in + let (concrete, acc) = self#class_infos self#class_type concrete acc in + (Class_description.of_concrete concrete, acc) + method class_type_declaration : Class_type_declaration.t -> 'acc -> (Class_type_declaration.t * 'acc) = + fun class_type_declaration acc -> + let concrete = Class_type_declaration.to_concrete class_type_declaration in + let (concrete, acc) = self#class_infos self#class_type concrete acc in + (Class_type_declaration.of_concrete concrete, acc) + method class_expr : Class_expr.t -> 'acc -> (Class_expr.t * 'acc) = + fun class_expr acc -> + let concrete = Class_expr.to_concrete class_expr in + let { pcl_desc; pcl_loc; pcl_attributes } : Class_expr.concrete = concrete in + 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 + (Class_expr.of_concrete { pcl_desc; pcl_loc; pcl_attributes }, acc) + method class_expr_desc : Class_expr_desc.t -> 'acc -> (Class_expr_desc.t * 'acc) = + fun class_expr_desc acc -> + let concrete = Class_expr_desc.to_concrete class_expr_desc in + match (concrete : Class_expr_desc.concrete) with + | Pcl_constr (x0, x1) -> + let (x0, acc) = self#longident_loc x0 acc in + let (x1, acc) = self#list self#core_type x1 acc in + (Class_expr_desc.of_concrete (Pcl_constr (x0, x1)), acc) + | Pcl_structure x0 -> + let (x0, acc) = self#class_structure x0 acc in + (Class_expr_desc.of_concrete (Pcl_structure x0), acc) + | Pcl_fun (x0, x1, x2, x3) -> + let (x0, acc) = self#arg_label x0 acc in + let (x1, acc) = self#option self#expression x1 acc in + let (x2, acc) = self#pattern x2 acc in + let (x3, acc) = self#class_expr x3 acc in + (Class_expr_desc.of_concrete (Pcl_fun (x0, x1, x2, x3)), acc) + | Pcl_apply (x0, x1) -> + let (x0, acc) = self#class_expr x0 acc in + let (x1, acc) = self#list (fun (x0, x1) acc -> let (x0, acc) = self#arg_label x0 acc in let (x1, acc) = self#expression x1 acc in ((x0, x1), acc)) x1 acc in + (Class_expr_desc.of_concrete (Pcl_apply (x0, x1)), acc) + | Pcl_let (x0, x1, x2) -> + let (x0, acc) = self#rec_flag x0 acc in + let (x1, acc) = self#list self#value_binding x1 acc in + let (x2, acc) = self#class_expr x2 acc in + (Class_expr_desc.of_concrete (Pcl_let (x0, x1, x2)), acc) + | Pcl_constraint (x0, x1) -> + let (x0, acc) = self#class_expr x0 acc in + let (x1, acc) = self#class_type x1 acc in + (Class_expr_desc.of_concrete (Pcl_constraint (x0, x1)), acc) + | Pcl_extension x0 -> + let (x0, acc) = self#extension x0 acc in + (Class_expr_desc.of_concrete (Pcl_extension x0), acc) + | Pcl_open (x0, x1, x2) -> + let (x0, acc) = self#override_flag x0 acc in + let (x1, acc) = self#longident_loc x1 acc in + let (x2, acc) = self#class_expr x2 acc in + (Class_expr_desc.of_concrete (Pcl_open (x0, x1, x2)), acc) + method class_structure : Class_structure.t -> 'acc -> (Class_structure.t * 'acc) = + fun class_structure acc -> + let concrete = Class_structure.to_concrete class_structure in + let { pcstr_self; pcstr_fields } : Class_structure.concrete = concrete in + let (pcstr_self, acc) = self#pattern pcstr_self acc in + let (pcstr_fields, acc) = self#list self#class_field pcstr_fields acc in + (Class_structure.of_concrete { pcstr_self; pcstr_fields }, acc) + method class_field : Class_field.t -> 'acc -> (Class_field.t * 'acc) = + fun class_field acc -> + let concrete = Class_field.to_concrete class_field in + let { pcf_desc; pcf_loc; pcf_attributes } : Class_field.concrete = concrete in + 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 + (Class_field.of_concrete { pcf_desc; pcf_loc; pcf_attributes }, acc) + method class_field_desc : Class_field_desc.t -> 'acc -> (Class_field_desc.t * 'acc) = + fun class_field_desc acc -> + let concrete = Class_field_desc.to_concrete class_field_desc in + match (concrete : Class_field_desc.concrete) with + | Pcf_inherit (x0, x1, x2) -> + let (x0, acc) = self#override_flag x0 acc in + let (x1, acc) = self#class_expr x1 acc in + let (x2, acc) = self#option (self#loc self#string) x2 acc in + (Class_field_desc.of_concrete (Pcf_inherit (x0, x1, x2)), acc) + | Pcf_val x0 -> + let (x0, acc) = (fun (x0, x1, x2) acc -> let (x0, acc) = self#loc self#string x0 acc in let (x1, acc) = self#mutable_flag x1 acc in let (x2, acc) = self#class_field_kind x2 acc in ((x0, x1, x2), acc)) x0 acc in + (Class_field_desc.of_concrete (Pcf_val x0), acc) + | Pcf_method x0 -> + let (x0, acc) = (fun (x0, x1, x2) acc -> let (x0, acc) = self#loc self#string x0 acc in let (x1, acc) = self#private_flag x1 acc in let (x2, acc) = self#class_field_kind x2 acc in ((x0, x1, x2), acc)) x0 acc in + (Class_field_desc.of_concrete (Pcf_method x0), acc) + | Pcf_constraint x0 -> + let (x0, acc) = (fun (x0, x1) acc -> let (x0, acc) = self#core_type x0 acc in let (x1, acc) = self#core_type x1 acc in ((x0, x1), acc)) x0 acc in + (Class_field_desc.of_concrete (Pcf_constraint x0), acc) + | Pcf_initializer x0 -> + let (x0, acc) = self#expression x0 acc in + (Class_field_desc.of_concrete (Pcf_initializer x0), acc) + | Pcf_attribute x0 -> + let (x0, acc) = self#attribute x0 acc in + (Class_field_desc.of_concrete (Pcf_attribute x0), acc) + | Pcf_extension x0 -> + let (x0, acc) = self#extension x0 acc in + (Class_field_desc.of_concrete (Pcf_extension x0), acc) + method class_field_kind : Class_field_kind.t -> 'acc -> (Class_field_kind.t * 'acc) = + fun class_field_kind acc -> + let concrete = Class_field_kind.to_concrete class_field_kind in + match (concrete : Class_field_kind.concrete) with + | Cfk_virtual x0 -> + let (x0, acc) = self#core_type x0 acc in + (Class_field_kind.of_concrete (Cfk_virtual x0), acc) + | Cfk_concrete (x0, x1) -> + let (x0, acc) = self#override_flag x0 acc in + let (x1, acc) = self#expression x1 acc in + (Class_field_kind.of_concrete (Cfk_concrete (x0, x1)), acc) + method class_declaration : Class_declaration.t -> 'acc -> (Class_declaration.t * 'acc) = + fun class_declaration acc -> + let concrete = Class_declaration.to_concrete class_declaration in + let (concrete, acc) = self#class_infos self#class_expr concrete acc in + (Class_declaration.of_concrete concrete, acc) + method module_type : Module_type.t -> 'acc -> (Module_type.t * 'acc) = + fun module_type acc -> + let concrete = Module_type.to_concrete module_type in + let { pmty_desc; pmty_loc; pmty_attributes } : Module_type.concrete = concrete in + 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 + (Module_type.of_concrete { pmty_desc; pmty_loc; pmty_attributes }, acc) + method module_type_desc : Module_type_desc.t -> 'acc -> (Module_type_desc.t * 'acc) = + fun module_type_desc acc -> + let concrete = Module_type_desc.to_concrete module_type_desc in + match (concrete : Module_type_desc.concrete) with + | Pmty_ident x0 -> + let (x0, acc) = self#longident_loc x0 acc in + (Module_type_desc.of_concrete (Pmty_ident x0), acc) + | Pmty_signature x0 -> + let (x0, acc) = self#signature x0 acc in + (Module_type_desc.of_concrete (Pmty_signature x0), acc) + | Pmty_functor (x0, x1, x2) -> + let (x0, acc) = self#loc self#string x0 acc in + let (x1, acc) = self#option self#module_type x1 acc in + let (x2, acc) = self#module_type x2 acc in + (Module_type_desc.of_concrete (Pmty_functor (x0, x1, x2)), acc) + | Pmty_with (x0, x1) -> + let (x0, acc) = self#module_type x0 acc in + let (x1, acc) = self#list self#with_constraint x1 acc in + (Module_type_desc.of_concrete (Pmty_with (x0, x1)), acc) + | Pmty_typeof x0 -> + let (x0, acc) = self#module_expr x0 acc in + (Module_type_desc.of_concrete (Pmty_typeof x0), acc) + | Pmty_extension x0 -> + let (x0, acc) = self#extension x0 acc in + (Module_type_desc.of_concrete (Pmty_extension x0), acc) + | Pmty_alias x0 -> + let (x0, acc) = self#longident_loc x0 acc in + (Module_type_desc.of_concrete (Pmty_alias x0), acc) + method signature : Signature.t -> 'acc -> (Signature.t * 'acc) = + fun signature acc -> + let concrete = Signature.to_concrete signature in + let (concrete, acc) = self#list self#signature_item concrete acc in + (Signature.of_concrete concrete, acc) + method signature_item : Signature_item.t -> 'acc -> (Signature_item.t * 'acc) = + fun signature_item acc -> + let concrete = Signature_item.to_concrete signature_item in + let { psig_desc; psig_loc } : Signature_item.concrete = concrete in + let (psig_desc, acc) = self#signature_item_desc psig_desc acc in + let (psig_loc, acc) = self#location psig_loc acc in + (Signature_item.of_concrete { psig_desc; psig_loc }, acc) + method signature_item_desc : Signature_item_desc.t -> 'acc -> (Signature_item_desc.t * 'acc) = + fun signature_item_desc acc -> + let concrete = Signature_item_desc.to_concrete signature_item_desc in + match (concrete : Signature_item_desc.concrete) with + | Psig_value x0 -> + let (x0, acc) = self#value_description x0 acc in + (Signature_item_desc.of_concrete (Psig_value x0), acc) + | Psig_type (x0, x1) -> + let (x0, acc) = self#rec_flag x0 acc in + let (x1, acc) = self#list self#type_declaration x1 acc in + (Signature_item_desc.of_concrete (Psig_type (x0, x1)), acc) + | Psig_typext x0 -> + let (x0, acc) = self#type_extension x0 acc in + (Signature_item_desc.of_concrete (Psig_typext x0), acc) + | Psig_exception x0 -> + let (x0, acc) = self#extension_constructor x0 acc in + (Signature_item_desc.of_concrete (Psig_exception x0), acc) + | Psig_module x0 -> + let (x0, acc) = self#module_declaration x0 acc in + (Signature_item_desc.of_concrete (Psig_module x0), acc) + | Psig_recmodule x0 -> + let (x0, acc) = self#list self#module_declaration x0 acc in + (Signature_item_desc.of_concrete (Psig_recmodule x0), acc) + | Psig_modtype x0 -> + let (x0, acc) = self#module_type_declaration x0 acc in + (Signature_item_desc.of_concrete (Psig_modtype x0), acc) + | Psig_open x0 -> + let (x0, acc) = self#open_description x0 acc in + (Signature_item_desc.of_concrete (Psig_open x0), acc) + | Psig_include x0 -> + let (x0, acc) = self#include_description x0 acc in + (Signature_item_desc.of_concrete (Psig_include x0), acc) + | Psig_class x0 -> + let (x0, acc) = self#list self#class_description x0 acc in + (Signature_item_desc.of_concrete (Psig_class x0), acc) + | Psig_class_type x0 -> + let (x0, acc) = self#list self#class_type_declaration x0 acc in + (Signature_item_desc.of_concrete (Psig_class_type x0), acc) + | Psig_attribute x0 -> + let (x0, acc) = self#attribute x0 acc in + (Signature_item_desc.of_concrete (Psig_attribute x0), acc) + | Psig_extension (x0, x1) -> + let (x0, acc) = self#extension x0 acc in + let (x1, acc) = self#attributes x1 acc in + (Signature_item_desc.of_concrete (Psig_extension (x0, x1)), acc) + method module_declaration : Module_declaration.t -> 'acc -> (Module_declaration.t * 'acc) = + fun module_declaration acc -> + let concrete = Module_declaration.to_concrete module_declaration in + let { pmd_name; pmd_type; pmd_attributes; pmd_loc } : Module_declaration.concrete = concrete in + 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 + (Module_declaration.of_concrete { pmd_name; pmd_type; pmd_attributes; pmd_loc }, acc) + method module_type_declaration : Module_type_declaration.t -> 'acc -> (Module_type_declaration.t * 'acc) = + fun module_type_declaration acc -> + let concrete = Module_type_declaration.to_concrete module_type_declaration in + let { pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc } : Module_type_declaration.concrete = concrete in + 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 + (Module_type_declaration.of_concrete { pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc }, acc) + method open_description : Open_description.t -> 'acc -> (Open_description.t * 'acc) = + fun open_description acc -> + let concrete = Open_description.to_concrete open_description in + let { popen_lid; popen_override; popen_loc; popen_attributes } : Open_description.concrete = concrete in + 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 + (Open_description.of_concrete { popen_lid; popen_override; popen_loc; popen_attributes }, acc) + method include_infos : 'a . ('a node -> 'acc -> ('a node * 'acc)) -> 'a node Include_infos.t -> 'acc -> ('a node Include_infos.t * 'acc) = + fun fa include_infos acc -> + let concrete = Include_infos.to_concrete include_infos in + let { pincl_mod; pincl_loc; pincl_attributes } : _ Include_infos.concrete = concrete in + let (pincl_mod, acc) = fa pincl_mod acc in + let (pincl_loc, acc) = self#location pincl_loc acc in + let (pincl_attributes, acc) = self#attributes pincl_attributes acc in + (Include_infos.of_concrete { pincl_mod; pincl_loc; pincl_attributes }, acc) + method include_description : Include_description.t -> 'acc -> (Include_description.t * 'acc) = + fun include_description acc -> + let concrete = Include_description.to_concrete include_description in + let (concrete, acc) = self#include_infos self#module_type concrete acc in + (Include_description.of_concrete concrete, acc) + method include_declaration : Include_declaration.t -> 'acc -> (Include_declaration.t * 'acc) = + fun include_declaration acc -> + let concrete = Include_declaration.to_concrete include_declaration in + let (concrete, acc) = self#include_infos self#module_expr concrete acc in + (Include_declaration.of_concrete concrete, acc) + method with_constraint : With_constraint.t -> 'acc -> (With_constraint.t * 'acc) = + fun with_constraint acc -> + let concrete = With_constraint.to_concrete with_constraint in + match (concrete : With_constraint.concrete) with + | Pwith_type (x0, x1) -> + let (x0, acc) = self#longident_loc x0 acc in + let (x1, acc) = self#type_declaration x1 acc in + (With_constraint.of_concrete (Pwith_type (x0, x1)), acc) + | Pwith_module (x0, x1) -> + let (x0, acc) = self#longident_loc x0 acc in + let (x1, acc) = self#longident_loc x1 acc in + (With_constraint.of_concrete (Pwith_module (x0, x1)), acc) + | Pwith_typesubst (x0, x1) -> + let (x0, acc) = self#longident_loc x0 acc in + let (x1, acc) = self#type_declaration x1 acc in + (With_constraint.of_concrete (Pwith_typesubst (x0, x1)), acc) + | Pwith_modsubst (x0, x1) -> + let (x0, acc) = self#longident_loc x0 acc in + let (x1, acc) = self#longident_loc x1 acc in + (With_constraint.of_concrete (Pwith_modsubst (x0, x1)), acc) + method module_expr : Module_expr.t -> 'acc -> (Module_expr.t * 'acc) = + fun module_expr acc -> + let concrete = Module_expr.to_concrete module_expr in + let { pmod_desc; pmod_loc; pmod_attributes } : Module_expr.concrete = concrete in + 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 + (Module_expr.of_concrete { pmod_desc; pmod_loc; pmod_attributes }, acc) + method module_expr_desc : Module_expr_desc.t -> 'acc -> (Module_expr_desc.t * 'acc) = + fun module_expr_desc acc -> + let concrete = Module_expr_desc.to_concrete module_expr_desc in + match (concrete : Module_expr_desc.concrete) with + | Pmod_ident x0 -> + let (x0, acc) = self#longident_loc x0 acc in + (Module_expr_desc.of_concrete (Pmod_ident x0), acc) + | Pmod_structure x0 -> + let (x0, acc) = self#structure x0 acc in + (Module_expr_desc.of_concrete (Pmod_structure x0), acc) + | Pmod_functor (x0, x1, x2) -> + let (x0, acc) = self#loc self#string x0 acc in + let (x1, acc) = self#option self#module_type x1 acc in + let (x2, acc) = self#module_expr x2 acc in + (Module_expr_desc.of_concrete (Pmod_functor (x0, x1, x2)), acc) + | Pmod_apply (x0, x1) -> + let (x0, acc) = self#module_expr x0 acc in + let (x1, acc) = self#module_expr x1 acc in + (Module_expr_desc.of_concrete (Pmod_apply (x0, x1)), acc) + | Pmod_constraint (x0, x1) -> + let (x0, acc) = self#module_expr x0 acc in + let (x1, acc) = self#module_type x1 acc in + (Module_expr_desc.of_concrete (Pmod_constraint (x0, x1)), acc) + | Pmod_unpack x0 -> + let (x0, acc) = self#expression x0 acc in + (Module_expr_desc.of_concrete (Pmod_unpack x0), acc) + | Pmod_extension x0 -> + let (x0, acc) = self#extension x0 acc in + (Module_expr_desc.of_concrete (Pmod_extension x0), acc) + method structure : Structure.t -> 'acc -> (Structure.t * 'acc) = + fun structure acc -> + let concrete = Structure.to_concrete structure in + let (concrete, acc) = self#list self#structure_item concrete acc in + (Structure.of_concrete concrete, acc) + method structure_item : Structure_item.t -> 'acc -> (Structure_item.t * 'acc) = + fun structure_item acc -> + let concrete = Structure_item.to_concrete structure_item in + let { pstr_desc; pstr_loc } : Structure_item.concrete = concrete in + let (pstr_desc, acc) = self#structure_item_desc pstr_desc acc in + let (pstr_loc, acc) = self#location pstr_loc acc in + (Structure_item.of_concrete { pstr_desc; pstr_loc }, acc) + method structure_item_desc : Structure_item_desc.t -> 'acc -> (Structure_item_desc.t * 'acc) = + fun structure_item_desc acc -> + let concrete = Structure_item_desc.to_concrete structure_item_desc in + match (concrete : Structure_item_desc.concrete) with + | Pstr_eval (x0, x1) -> + let (x0, acc) = self#expression x0 acc in + let (x1, acc) = self#attributes x1 acc in + (Structure_item_desc.of_concrete (Pstr_eval (x0, x1)), acc) + | Pstr_value (x0, x1) -> + let (x0, acc) = self#rec_flag x0 acc in + let (x1, acc) = self#list self#value_binding x1 acc in + (Structure_item_desc.of_concrete (Pstr_value (x0, x1)), acc) + | Pstr_primitive x0 -> + let (x0, acc) = self#value_description x0 acc in + (Structure_item_desc.of_concrete (Pstr_primitive x0), acc) + | Pstr_type (x0, x1) -> + let (x0, acc) = self#rec_flag x0 acc in + let (x1, acc) = self#list self#type_declaration x1 acc in + (Structure_item_desc.of_concrete (Pstr_type (x0, x1)), acc) + | Pstr_typext x0 -> + let (x0, acc) = self#type_extension x0 acc in + (Structure_item_desc.of_concrete (Pstr_typext x0), acc) + | Pstr_exception x0 -> + let (x0, acc) = self#extension_constructor x0 acc in + (Structure_item_desc.of_concrete (Pstr_exception x0), acc) + | Pstr_module x0 -> + let (x0, acc) = self#module_binding x0 acc in + (Structure_item_desc.of_concrete (Pstr_module x0), acc) + | Pstr_recmodule x0 -> + let (x0, acc) = self#list self#module_binding x0 acc in + (Structure_item_desc.of_concrete (Pstr_recmodule x0), acc) + | Pstr_modtype x0 -> + let (x0, acc) = self#module_type_declaration x0 acc in + (Structure_item_desc.of_concrete (Pstr_modtype x0), acc) + | Pstr_open x0 -> + let (x0, acc) = self#open_description x0 acc in + (Structure_item_desc.of_concrete (Pstr_open x0), acc) + | Pstr_class x0 -> + let (x0, acc) = self#list self#class_declaration x0 acc in + (Structure_item_desc.of_concrete (Pstr_class x0), acc) + | Pstr_class_type x0 -> + let (x0, acc) = self#list self#class_type_declaration x0 acc in + (Structure_item_desc.of_concrete (Pstr_class_type x0), acc) + | Pstr_include x0 -> + let (x0, acc) = self#include_declaration x0 acc in + (Structure_item_desc.of_concrete (Pstr_include x0), acc) + | Pstr_attribute x0 -> + let (x0, acc) = self#attribute x0 acc in + (Structure_item_desc.of_concrete (Pstr_attribute x0), acc) + | Pstr_extension (x0, x1) -> + let (x0, acc) = self#extension x0 acc in + let (x1, acc) = self#attributes x1 acc in + (Structure_item_desc.of_concrete (Pstr_extension (x0, x1)), acc) + method value_binding : Value_binding.t -> 'acc -> (Value_binding.t * 'acc) = + fun value_binding acc -> + let concrete = Value_binding.to_concrete value_binding in + let { pvb_pat; pvb_expr; pvb_attributes; pvb_loc } : Value_binding.concrete = concrete in + 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 + (Value_binding.of_concrete { pvb_pat; pvb_expr; pvb_attributes; pvb_loc }, acc) + method module_binding : Module_binding.t -> 'acc -> (Module_binding.t * 'acc) = + fun module_binding acc -> + let concrete = Module_binding.to_concrete module_binding in + let { pmb_name; pmb_expr; pmb_attributes; pmb_loc } : Module_binding.concrete = concrete in + 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 + (Module_binding.of_concrete { pmb_name; pmb_expr; pmb_attributes; pmb_loc }, acc) + method toplevel_phrase : Toplevel_phrase.t -> 'acc -> (Toplevel_phrase.t * 'acc) = + fun toplevel_phrase acc -> + let concrete = Toplevel_phrase.to_concrete toplevel_phrase in + match (concrete : Toplevel_phrase.concrete) with + | Ptop_def x0 -> + let (x0, acc) = self#structure x0 acc in + (Toplevel_phrase.of_concrete (Ptop_def x0), acc) + | Ptop_dir (x0, x1) -> + let (x0, acc) = self#string x0 acc in + let (x1, acc) = self#directive_argument x1 acc in + (Toplevel_phrase.of_concrete (Ptop_dir (x0, x1)), acc) + method directive_argument : Directive_argument.t -> 'acc -> (Directive_argument.t * 'acc) = + fun directive_argument acc -> + let concrete = Directive_argument.to_concrete directive_argument in + match (concrete : Directive_argument.concrete) with + | Pdir_none -> + (Directive_argument.of_concrete Pdir_none, acc) + | Pdir_string x0 -> + let (x0, acc) = self#string x0 acc in + (Directive_argument.of_concrete (Pdir_string x0), acc) + | Pdir_int (x0, x1) -> + let (x0, acc) = self#string x0 acc in + let (x1, acc) = self#option self#char x1 acc in + (Directive_argument.of_concrete (Pdir_int (x0, x1)), acc) + | Pdir_ident x0 -> + let (x0, acc) = self#longident x0 acc in + (Directive_argument.of_concrete (Pdir_ident x0), acc) + | Pdir_bool x0 -> + let (x0, acc) = self#bool x0 acc in + (Directive_argument.of_concrete (Pdir_bool x0), acc) + end + +class virtual ['ctx] map_with_context = + object (self) + method virtual bool : 'ctx -> bool -> bool + method virtual char : 'ctx -> char -> char + method virtual int : 'ctx -> int -> int + method virtual list : 'a . ('ctx -> 'a -> 'a) -> 'ctx -> 'a list -> 'a list + method virtual option : 'a . ('ctx -> 'a -> 'a) -> 'ctx -> 'a option -> 'a option + method virtual string : 'ctx -> string -> string + method virtual location : 'ctx -> Astlib.Location.t -> Astlib.Location.t + method virtual loc : 'a . ('ctx -> 'a -> 'a) -> 'ctx -> 'a Astlib.Loc.t -> 'a Astlib.Loc.t + method longident : 'ctx -> Longident.t -> Longident.t = + fun _ctx longident -> + let concrete = Longident.to_concrete longident in + match (concrete : Longident.concrete) with + | Lident x0 -> + let x0 = self#string _ctx x0 in + Longident.of_concrete (Lident x0) + | Ldot (x0, x1) -> + let x0 = self#longident _ctx x0 in + let x1 = self#string _ctx x1 in + Longident.of_concrete (Ldot (x0, x1)) + | Lapply (x0, x1) -> + let x0 = self#longident _ctx x0 in + let x1 = self#longident _ctx x1 in + Longident.of_concrete (Lapply (x0, x1)) + method longident_loc : 'ctx -> Longident_loc.t -> Longident_loc.t = + fun _ctx longident_loc -> + let concrete = Longident_loc.to_concrete longident_loc in + let concrete = self#loc self#longident _ctx concrete in + Longident_loc.of_concrete concrete + method rec_flag : 'ctx -> Rec_flag.t -> Rec_flag.t = + fun _ctx rec_flag -> + let concrete = Rec_flag.to_concrete rec_flag in + match (concrete : Rec_flag.concrete) with + | Nonrecursive -> + Rec_flag.of_concrete Nonrecursive + | Recursive -> + Rec_flag.of_concrete Recursive + method direction_flag : 'ctx -> Direction_flag.t -> Direction_flag.t = + fun _ctx direction_flag -> + let concrete = Direction_flag.to_concrete direction_flag in + match (concrete : Direction_flag.concrete) with + | Upto -> + Direction_flag.of_concrete Upto + | Downto -> + Direction_flag.of_concrete Downto + method private_flag : 'ctx -> Private_flag.t -> Private_flag.t = + fun _ctx private_flag -> + let concrete = Private_flag.to_concrete private_flag in + match (concrete : Private_flag.concrete) with + | Private -> + Private_flag.of_concrete Private + | Public -> + Private_flag.of_concrete Public + method mutable_flag : 'ctx -> Mutable_flag.t -> Mutable_flag.t = + fun _ctx mutable_flag -> + let concrete = Mutable_flag.to_concrete mutable_flag in + match (concrete : Mutable_flag.concrete) with + | Immutable -> + Mutable_flag.of_concrete Immutable + | Mutable -> + Mutable_flag.of_concrete Mutable + method virtual_flag : 'ctx -> Virtual_flag.t -> Virtual_flag.t = + fun _ctx virtual_flag -> + let concrete = Virtual_flag.to_concrete virtual_flag in + match (concrete : Virtual_flag.concrete) with + | Virtual -> + Virtual_flag.of_concrete Virtual + | Concrete -> + Virtual_flag.of_concrete Concrete + method override_flag : 'ctx -> Override_flag.t -> Override_flag.t = + fun _ctx override_flag -> + let concrete = Override_flag.to_concrete override_flag in + match (concrete : Override_flag.concrete) with + | Override -> + Override_flag.of_concrete Override + | Fresh -> + Override_flag.of_concrete Fresh + method closed_flag : 'ctx -> Closed_flag.t -> Closed_flag.t = + fun _ctx closed_flag -> + let concrete = Closed_flag.to_concrete closed_flag in + match (concrete : Closed_flag.concrete) with + | Closed -> + Closed_flag.of_concrete Closed + | Open -> + Closed_flag.of_concrete Open + method arg_label : 'ctx -> Arg_label.t -> Arg_label.t = + fun _ctx arg_label -> + let concrete = Arg_label.to_concrete arg_label in + match (concrete : Arg_label.concrete) with + | Nolabel -> + Arg_label.of_concrete Nolabel + | Labelled x0 -> + let x0 = self#string _ctx x0 in + Arg_label.of_concrete (Labelled x0) + | Optional x0 -> + let x0 = self#string _ctx x0 in + Arg_label.of_concrete (Optional x0) + method variance : 'ctx -> Variance.t -> Variance.t = + fun _ctx variance -> + let concrete = Variance.to_concrete variance in + match (concrete : Variance.concrete) with + | Covariant -> + Variance.of_concrete Covariant + | Contravariant -> + Variance.of_concrete Contravariant + | Invariant -> + Variance.of_concrete Invariant + method constant : 'ctx -> Constant.t -> Constant.t = + fun _ctx constant -> + let concrete = Constant.to_concrete constant in + match (concrete : Constant.concrete) with + | Pconst_integer (x0, x1) -> + let x0 = self#string _ctx x0 in + let x1 = self#option self#char _ctx x1 in + Constant.of_concrete (Pconst_integer (x0, x1)) + | Pconst_char x0 -> + let x0 = self#char _ctx x0 in + Constant.of_concrete (Pconst_char x0) + | Pconst_string (x0, x1) -> + let x0 = self#string _ctx x0 in + let x1 = self#option self#string _ctx x1 in + Constant.of_concrete (Pconst_string (x0, x1)) + | Pconst_float (x0, x1) -> + let x0 = self#string _ctx x0 in + let x1 = self#option self#char _ctx x1 in + Constant.of_concrete (Pconst_float (x0, x1)) + method attribute : 'ctx -> Attribute.t -> Attribute.t = + fun _ctx attribute -> + let concrete = Attribute.to_concrete attribute in + let (x0, x1) = concrete in + let x0 = self#loc self#string _ctx x0 in + let x1 = self#payload _ctx x1 in + Attribute.of_concrete (x0, x1) + method extension : 'ctx -> Extension.t -> Extension.t = + fun _ctx extension -> + let concrete = Extension.to_concrete extension in + let (x0, x1) = concrete in + let x0 = self#loc self#string _ctx x0 in + let x1 = self#payload _ctx x1 in + Extension.of_concrete (x0, x1) + method attributes : 'ctx -> Attributes.t -> Attributes.t = + fun _ctx attributes -> + let concrete = Attributes.to_concrete attributes in + let concrete = self#list self#attribute _ctx concrete in + Attributes.of_concrete concrete + method payload : 'ctx -> Payload.t -> Payload.t = + fun _ctx payload -> + let concrete = Payload.to_concrete payload in + match (concrete : Payload.concrete) with + | PStr x0 -> + let x0 = self#structure _ctx x0 in + Payload.of_concrete (PStr x0) + | PSig x0 -> + let x0 = self#signature _ctx x0 in + Payload.of_concrete (PSig x0) + | PTyp x0 -> + let x0 = self#core_type _ctx x0 in + Payload.of_concrete (PTyp x0) + | PPat (x0, x1) -> + let x0 = self#pattern _ctx x0 in + let x1 = self#option self#expression _ctx x1 in + Payload.of_concrete (PPat (x0, x1)) + method core_type : 'ctx -> Core_type.t -> Core_type.t = + fun _ctx core_type -> + let concrete = Core_type.to_concrete core_type in + let { ptyp_desc; ptyp_loc; ptyp_attributes } : Core_type.concrete = concrete in + 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 + Core_type.of_concrete { ptyp_desc; ptyp_loc; ptyp_attributes } + method core_type_desc : 'ctx -> Core_type_desc.t -> Core_type_desc.t = + fun _ctx core_type_desc -> + let concrete = Core_type_desc.to_concrete core_type_desc in + match (concrete : Core_type_desc.concrete) with + | Ptyp_any -> + Core_type_desc.of_concrete Ptyp_any + | Ptyp_var x0 -> + let x0 = self#string _ctx x0 in + Core_type_desc.of_concrete (Ptyp_var x0) + | Ptyp_arrow (x0, x1, x2) -> + let x0 = self#arg_label _ctx x0 in + let x1 = self#core_type _ctx x1 in + let x2 = self#core_type _ctx x2 in + Core_type_desc.of_concrete (Ptyp_arrow (x0, x1, x2)) + | Ptyp_tuple x0 -> + let x0 = self#list self#core_type _ctx x0 in + Core_type_desc.of_concrete (Ptyp_tuple x0) + | Ptyp_constr (x0, x1) -> + let x0 = self#longident_loc _ctx x0 in + let x1 = self#list self#core_type _ctx x1 in + Core_type_desc.of_concrete (Ptyp_constr (x0, x1)) + | Ptyp_object (x0, x1) -> + let x0 = self#list self#object_field _ctx x0 in + let x1 = self#closed_flag _ctx x1 in + Core_type_desc.of_concrete (Ptyp_object (x0, x1)) + | Ptyp_class (x0, x1) -> + let x0 = self#longident_loc _ctx x0 in + let x1 = self#list self#core_type _ctx x1 in + Core_type_desc.of_concrete (Ptyp_class (x0, x1)) + | Ptyp_alias (x0, x1) -> + let x0 = self#core_type _ctx x0 in + let x1 = self#string _ctx x1 in + Core_type_desc.of_concrete (Ptyp_alias (x0, x1)) + | Ptyp_variant (x0, x1, x2) -> + let x0 = self#list self#row_field _ctx x0 in + let x1 = self#closed_flag _ctx x1 in + let x2 = self#option (self#list self#string) _ctx x2 in + Core_type_desc.of_concrete (Ptyp_variant (x0, x1, x2)) + | Ptyp_poly (x0, x1) -> + let x0 = self#list (self#loc self#string) _ctx x0 in + let x1 = self#core_type _ctx x1 in + Core_type_desc.of_concrete (Ptyp_poly (x0, x1)) + | Ptyp_package x0 -> + let x0 = self#package_type _ctx x0 in + Core_type_desc.of_concrete (Ptyp_package x0) + | Ptyp_extension x0 -> + let x0 = self#extension _ctx x0 in + Core_type_desc.of_concrete (Ptyp_extension x0) + method package_type : 'ctx -> Package_type.t -> Package_type.t = + fun _ctx package_type -> + let concrete = Package_type.to_concrete package_type in + let (x0, x1) = concrete in + let x0 = self#longident_loc _ctx x0 in + let x1 = self#list (fun _ctx (x0, x1) -> let x0 = self#longident_loc _ctx x0 in let x1 = self#core_type _ctx x1 in (x0, x1)) _ctx x1 in + Package_type.of_concrete (x0, x1) + method row_field : 'ctx -> Row_field.t -> Row_field.t = + fun _ctx row_field -> + let concrete = Row_field.to_concrete row_field in + match (concrete : Row_field.concrete) with + | Rtag (x0, x1, x2, x3) -> + let x0 = self#loc self#string _ctx x0 in + let x1 = self#attributes _ctx x1 in + let x2 = self#bool _ctx x2 in + let x3 = self#list self#core_type _ctx x3 in + Row_field.of_concrete (Rtag (x0, x1, x2, x3)) + | Rinherit x0 -> + let x0 = self#core_type _ctx x0 in + Row_field.of_concrete (Rinherit x0) + method object_field : 'ctx -> Object_field.t -> Object_field.t = + fun _ctx object_field -> + let concrete = Object_field.to_concrete object_field in + match (concrete : Object_field.concrete) with + | Otag (x0, x1, x2) -> + let x0 = self#loc self#string _ctx x0 in + let x1 = self#attributes _ctx x1 in + let x2 = self#core_type _ctx x2 in + Object_field.of_concrete (Otag (x0, x1, x2)) + | Oinherit x0 -> + let x0 = self#core_type _ctx x0 in + Object_field.of_concrete (Oinherit x0) + method pattern : 'ctx -> Pattern.t -> Pattern.t = + fun _ctx pattern -> + let concrete = Pattern.to_concrete pattern in + let { ppat_desc; ppat_loc; ppat_attributes } : Pattern.concrete = concrete in + 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 + Pattern.of_concrete { ppat_desc; ppat_loc; ppat_attributes } + method pattern_desc : 'ctx -> Pattern_desc.t -> Pattern_desc.t = + fun _ctx pattern_desc -> + let concrete = Pattern_desc.to_concrete pattern_desc in + match (concrete : Pattern_desc.concrete) with + | Ppat_any -> + Pattern_desc.of_concrete Ppat_any + | Ppat_var x0 -> + let x0 = self#loc self#string _ctx x0 in + Pattern_desc.of_concrete (Ppat_var x0) + | Ppat_alias (x0, x1) -> + let x0 = self#pattern _ctx x0 in + let x1 = self#loc self#string _ctx x1 in + Pattern_desc.of_concrete (Ppat_alias (x0, x1)) + | Ppat_constant x0 -> + let x0 = self#constant _ctx x0 in + Pattern_desc.of_concrete (Ppat_constant x0) + | Ppat_interval (x0, x1) -> + let x0 = self#constant _ctx x0 in + let x1 = self#constant _ctx x1 in + Pattern_desc.of_concrete (Ppat_interval (x0, x1)) + | Ppat_tuple x0 -> + let x0 = self#list self#pattern _ctx x0 in + Pattern_desc.of_concrete (Ppat_tuple x0) + | Ppat_construct (x0, x1) -> + let x0 = self#longident_loc _ctx x0 in + let x1 = self#option self#pattern _ctx x1 in + Pattern_desc.of_concrete (Ppat_construct (x0, x1)) + | Ppat_variant (x0, x1) -> + let x0 = self#string _ctx x0 in + let x1 = self#option self#pattern _ctx x1 in + Pattern_desc.of_concrete (Ppat_variant (x0, x1)) + | Ppat_record (x0, x1) -> + let x0 = self#list (fun _ctx (x0, x1) -> let x0 = self#longident_loc _ctx x0 in let x1 = self#pattern _ctx x1 in (x0, x1)) _ctx x0 in + let x1 = self#closed_flag _ctx x1 in + Pattern_desc.of_concrete (Ppat_record (x0, x1)) + | Ppat_array x0 -> + let x0 = self#list self#pattern _ctx x0 in + Pattern_desc.of_concrete (Ppat_array x0) + | Ppat_or (x0, x1) -> + let x0 = self#pattern _ctx x0 in + let x1 = self#pattern _ctx x1 in + Pattern_desc.of_concrete (Ppat_or (x0, x1)) + | Ppat_constraint (x0, x1) -> + let x0 = self#pattern _ctx x0 in + let x1 = self#core_type _ctx x1 in + Pattern_desc.of_concrete (Ppat_constraint (x0, x1)) + | Ppat_type x0 -> + let x0 = self#longident_loc _ctx x0 in + Pattern_desc.of_concrete (Ppat_type x0) + | Ppat_lazy x0 -> + let x0 = self#pattern _ctx x0 in + Pattern_desc.of_concrete (Ppat_lazy x0) + | Ppat_unpack x0 -> + let x0 = self#loc self#string _ctx x0 in + Pattern_desc.of_concrete (Ppat_unpack x0) + | Ppat_exception x0 -> + let x0 = self#pattern _ctx x0 in + Pattern_desc.of_concrete (Ppat_exception x0) + | Ppat_extension x0 -> + let x0 = self#extension _ctx x0 in + Pattern_desc.of_concrete (Ppat_extension x0) + | Ppat_open (x0, x1) -> + let x0 = self#longident_loc _ctx x0 in + let x1 = self#pattern _ctx x1 in + Pattern_desc.of_concrete (Ppat_open (x0, x1)) + method expression : 'ctx -> Expression.t -> Expression.t = + fun _ctx expression -> + let concrete = Expression.to_concrete expression in + let { pexp_desc; pexp_loc; pexp_attributes } : Expression.concrete = concrete in + 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 + Expression.of_concrete { pexp_desc; pexp_loc; pexp_attributes } + method expression_desc : 'ctx -> Expression_desc.t -> Expression_desc.t = + fun _ctx expression_desc -> + let concrete = Expression_desc.to_concrete expression_desc in + match (concrete : Expression_desc.concrete) with + | Pexp_ident x0 -> + let x0 = self#longident_loc _ctx x0 in + Expression_desc.of_concrete (Pexp_ident x0) + | Pexp_constant x0 -> + let x0 = self#constant _ctx x0 in + Expression_desc.of_concrete (Pexp_constant x0) + | Pexp_let (x0, x1, x2) -> + let x0 = self#rec_flag _ctx x0 in + let x1 = self#list self#value_binding _ctx x1 in + let x2 = self#expression _ctx x2 in + Expression_desc.of_concrete (Pexp_let (x0, x1, x2)) + | Pexp_function x0 -> + let x0 = self#list self#case _ctx x0 in + Expression_desc.of_concrete (Pexp_function x0) + | Pexp_fun (x0, x1, x2, x3) -> + let x0 = self#arg_label _ctx x0 in + let x1 = self#option self#expression _ctx x1 in + let x2 = self#pattern _ctx x2 in + let x3 = self#expression _ctx x3 in + Expression_desc.of_concrete (Pexp_fun (x0, x1, x2, x3)) + | Pexp_apply (x0, x1) -> + let x0 = self#expression _ctx x0 in + let x1 = self#list (fun _ctx (x0, x1) -> let x0 = self#arg_label _ctx x0 in let x1 = self#expression _ctx x1 in (x0, x1)) _ctx x1 in + Expression_desc.of_concrete (Pexp_apply (x0, x1)) + | Pexp_match (x0, x1) -> + let x0 = self#expression _ctx x0 in + let x1 = self#list self#case _ctx x1 in + Expression_desc.of_concrete (Pexp_match (x0, x1)) + | Pexp_try (x0, x1) -> + let x0 = self#expression _ctx x0 in + let x1 = self#list self#case _ctx x1 in + Expression_desc.of_concrete (Pexp_try (x0, x1)) + | Pexp_tuple x0 -> + let x0 = self#list self#expression _ctx x0 in + Expression_desc.of_concrete (Pexp_tuple x0) + | Pexp_construct (x0, x1) -> + let x0 = self#longident_loc _ctx x0 in + let x1 = self#option self#expression _ctx x1 in + Expression_desc.of_concrete (Pexp_construct (x0, x1)) + | Pexp_variant (x0, x1) -> + let x0 = self#string _ctx x0 in + let x1 = self#option self#expression _ctx x1 in + Expression_desc.of_concrete (Pexp_variant (x0, x1)) + | Pexp_record (x0, x1) -> + let x0 = self#list (fun _ctx (x0, x1) -> let x0 = self#longident_loc _ctx x0 in let x1 = self#expression _ctx x1 in (x0, x1)) _ctx x0 in + let x1 = self#option self#expression _ctx x1 in + Expression_desc.of_concrete (Pexp_record (x0, x1)) + | Pexp_field (x0, x1) -> + let x0 = self#expression _ctx x0 in + let x1 = self#longident_loc _ctx x1 in + Expression_desc.of_concrete (Pexp_field (x0, x1)) + | Pexp_setfield (x0, x1, x2) -> + let x0 = self#expression _ctx x0 in + let x1 = self#longident_loc _ctx x1 in + let x2 = self#expression _ctx x2 in + Expression_desc.of_concrete (Pexp_setfield (x0, x1, x2)) + | Pexp_array x0 -> + let x0 = self#list self#expression _ctx x0 in + Expression_desc.of_concrete (Pexp_array x0) + | Pexp_ifthenelse (x0, x1, x2) -> + let x0 = self#expression _ctx x0 in + let x1 = self#expression _ctx x1 in + let x2 = self#option self#expression _ctx x2 in + Expression_desc.of_concrete (Pexp_ifthenelse (x0, x1, x2)) + | Pexp_sequence (x0, x1) -> + let x0 = self#expression _ctx x0 in + let x1 = self#expression _ctx x1 in + Expression_desc.of_concrete (Pexp_sequence (x0, x1)) + | Pexp_while (x0, x1) -> + let x0 = self#expression _ctx x0 in + let x1 = self#expression _ctx x1 in + Expression_desc.of_concrete (Pexp_while (x0, x1)) + | Pexp_for (x0, x1, x2, x3, x4) -> + let x0 = self#pattern _ctx x0 in + let x1 = self#expression _ctx x1 in + let x2 = self#expression _ctx x2 in + let x3 = self#direction_flag _ctx x3 in + let x4 = self#expression _ctx x4 in + Expression_desc.of_concrete (Pexp_for (x0, x1, x2, x3, x4)) + | Pexp_constraint (x0, x1) -> + let x0 = self#expression _ctx x0 in + let x1 = self#core_type _ctx x1 in + Expression_desc.of_concrete (Pexp_constraint (x0, x1)) + | Pexp_coerce (x0, x1, x2) -> + let x0 = self#expression _ctx x0 in + let x1 = self#option self#core_type _ctx x1 in + let x2 = self#core_type _ctx x2 in + Expression_desc.of_concrete (Pexp_coerce (x0, x1, x2)) + | Pexp_send (x0, x1) -> + let x0 = self#expression _ctx x0 in + let x1 = self#loc self#string _ctx x1 in + Expression_desc.of_concrete (Pexp_send (x0, x1)) + | Pexp_new x0 -> + let x0 = self#longident_loc _ctx x0 in + Expression_desc.of_concrete (Pexp_new x0) + | Pexp_setinstvar (x0, x1) -> + let x0 = self#loc self#string _ctx x0 in + let x1 = self#expression _ctx x1 in + Expression_desc.of_concrete (Pexp_setinstvar (x0, x1)) + | Pexp_override x0 -> + let x0 = self#list (fun _ctx (x0, x1) -> let x0 = self#loc self#string _ctx x0 in let x1 = self#expression _ctx x1 in (x0, x1)) _ctx x0 in + Expression_desc.of_concrete (Pexp_override x0) + | Pexp_letmodule (x0, x1, x2) -> + let x0 = self#loc self#string _ctx x0 in + let x1 = self#module_expr _ctx x1 in + let x2 = self#expression _ctx x2 in + Expression_desc.of_concrete (Pexp_letmodule (x0, x1, x2)) + | Pexp_letexception (x0, x1) -> + let x0 = self#extension_constructor _ctx x0 in + let x1 = self#expression _ctx x1 in + Expression_desc.of_concrete (Pexp_letexception (x0, x1)) + | Pexp_assert x0 -> + let x0 = self#expression _ctx x0 in + Expression_desc.of_concrete (Pexp_assert x0) + | Pexp_lazy x0 -> + let x0 = self#expression _ctx x0 in + Expression_desc.of_concrete (Pexp_lazy x0) + | Pexp_poly (x0, x1) -> + let x0 = self#expression _ctx x0 in + let x1 = self#option self#core_type _ctx x1 in + Expression_desc.of_concrete (Pexp_poly (x0, x1)) + | Pexp_object x0 -> + let x0 = self#class_structure _ctx x0 in + Expression_desc.of_concrete (Pexp_object x0) + | Pexp_newtype (x0, x1) -> + let x0 = self#loc self#string _ctx x0 in + let x1 = self#expression _ctx x1 in + Expression_desc.of_concrete (Pexp_newtype (x0, x1)) + | Pexp_pack x0 -> + let x0 = self#module_expr _ctx x0 in + Expression_desc.of_concrete (Pexp_pack x0) + | Pexp_open (x0, x1, x2) -> + let x0 = self#override_flag _ctx x0 in + let x1 = self#longident_loc _ctx x1 in + let x2 = self#expression _ctx x2 in + Expression_desc.of_concrete (Pexp_open (x0, x1, x2)) + | Pexp_extension x0 -> + let x0 = self#extension _ctx x0 in + Expression_desc.of_concrete (Pexp_extension x0) + | Pexp_unreachable -> + Expression_desc.of_concrete Pexp_unreachable + method case : 'ctx -> Case.t -> Case.t = + fun _ctx case -> + let concrete = Case.to_concrete case in + let { pc_lhs; pc_guard; pc_rhs } : Case.concrete = concrete in + 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 + Case.of_concrete { pc_lhs; pc_guard; pc_rhs } + method value_description : 'ctx -> Value_description.t -> Value_description.t = + fun _ctx value_description -> + let concrete = Value_description.to_concrete value_description in + let { pval_name; pval_type; pval_prim; pval_attributes; pval_loc } : Value_description.concrete = concrete in + 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 + Value_description.of_concrete { pval_name; pval_type; pval_prim; pval_attributes; pval_loc } + method type_declaration : 'ctx -> Type_declaration.t -> Type_declaration.t = + fun _ctx type_declaration -> + let concrete = Type_declaration.to_concrete type_declaration in + let { ptype_name; ptype_params; ptype_cstrs; ptype_kind; ptype_private; ptype_manifest; ptype_attributes; ptype_loc } : Type_declaration.concrete = concrete in + let ptype_name = self#loc self#string _ctx ptype_name in + let ptype_params = self#list (fun _ctx (x0, x1) -> let x0 = self#core_type _ctx x0 in let x1 = self#variance _ctx x1 in (x0, x1)) _ctx ptype_params in + let ptype_cstrs = self#list (fun _ctx (x0, x1, x2) -> let x0 = self#core_type _ctx x0 in let x1 = self#core_type _ctx x1 in let x2 = self#location _ctx x2 in (x0, x1, x2)) _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 + Type_declaration.of_concrete { ptype_name; ptype_params; ptype_cstrs; ptype_kind; ptype_private; ptype_manifest; ptype_attributes; ptype_loc } + method type_kind : 'ctx -> Type_kind.t -> Type_kind.t = + fun _ctx type_kind -> + let concrete = Type_kind.to_concrete type_kind in + match (concrete : Type_kind.concrete) with + | Ptype_abstract -> + Type_kind.of_concrete Ptype_abstract + | Ptype_variant x0 -> + let x0 = self#list self#constructor_declaration _ctx x0 in + Type_kind.of_concrete (Ptype_variant x0) + | Ptype_record x0 -> + let x0 = self#list self#label_declaration _ctx x0 in + Type_kind.of_concrete (Ptype_record x0) + | Ptype_open -> + Type_kind.of_concrete Ptype_open + method label_declaration : 'ctx -> Label_declaration.t -> Label_declaration.t = + fun _ctx label_declaration -> + let concrete = Label_declaration.to_concrete label_declaration in + let { pld_name; pld_mutable; pld_type; pld_loc; pld_attributes } : Label_declaration.concrete = concrete in + 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 + Label_declaration.of_concrete { pld_name; pld_mutable; pld_type; pld_loc; pld_attributes } + method constructor_declaration : 'ctx -> Constructor_declaration.t -> Constructor_declaration.t = + fun _ctx constructor_declaration -> + let concrete = Constructor_declaration.to_concrete constructor_declaration in + let { pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes } : Constructor_declaration.concrete = concrete in + 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 + Constructor_declaration.of_concrete { pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes } + method constructor_arguments : 'ctx -> Constructor_arguments.t -> Constructor_arguments.t = + fun _ctx constructor_arguments -> + let concrete = Constructor_arguments.to_concrete constructor_arguments in + match (concrete : Constructor_arguments.concrete) with + | Pcstr_tuple x0 -> + let x0 = self#list self#core_type _ctx x0 in + Constructor_arguments.of_concrete (Pcstr_tuple x0) + | Pcstr_record x0 -> + let x0 = self#list self#label_declaration _ctx x0 in + Constructor_arguments.of_concrete (Pcstr_record x0) + method type_extension : 'ctx -> Type_extension.t -> Type_extension.t = + fun _ctx type_extension -> + let concrete = Type_extension.to_concrete type_extension in + let { ptyext_path; ptyext_params; ptyext_constructors; ptyext_private; ptyext_attributes } : Type_extension.concrete = concrete in + let ptyext_path = self#longident_loc _ctx ptyext_path in + let ptyext_params = self#list (fun _ctx (x0, x1) -> let x0 = self#core_type _ctx x0 in let x1 = self#variance _ctx x1 in (x0, x1)) _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 + Type_extension.of_concrete { ptyext_path; ptyext_params; ptyext_constructors; ptyext_private; ptyext_attributes } + method extension_constructor : 'ctx -> Extension_constructor.t -> Extension_constructor.t = + fun _ctx extension_constructor -> + let concrete = Extension_constructor.to_concrete extension_constructor in + let { pext_name; pext_kind; pext_loc; pext_attributes } : Extension_constructor.concrete = concrete in + 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 + Extension_constructor.of_concrete { pext_name; pext_kind; pext_loc; pext_attributes } + method extension_constructor_kind : 'ctx -> Extension_constructor_kind.t -> Extension_constructor_kind.t = + fun _ctx extension_constructor_kind -> + let concrete = Extension_constructor_kind.to_concrete extension_constructor_kind in + match (concrete : Extension_constructor_kind.concrete) with + | Pext_decl (x0, x1) -> + let x0 = self#constructor_arguments _ctx x0 in + let x1 = self#option self#core_type _ctx x1 in + Extension_constructor_kind.of_concrete (Pext_decl (x0, x1)) + | Pext_rebind x0 -> + let x0 = self#longident_loc _ctx x0 in + Extension_constructor_kind.of_concrete (Pext_rebind x0) + method class_type : 'ctx -> Class_type.t -> Class_type.t = + fun _ctx class_type -> + let concrete = Class_type.to_concrete class_type in + let { pcty_desc; pcty_loc; pcty_attributes } : Class_type.concrete = concrete in + 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 + Class_type.of_concrete { pcty_desc; pcty_loc; pcty_attributes } + method class_type_desc : 'ctx -> Class_type_desc.t -> Class_type_desc.t = + fun _ctx class_type_desc -> + let concrete = Class_type_desc.to_concrete class_type_desc in + match (concrete : Class_type_desc.concrete) with + | Pcty_constr (x0, x1) -> + let x0 = self#longident_loc _ctx x0 in + let x1 = self#list self#core_type _ctx x1 in + Class_type_desc.of_concrete (Pcty_constr (x0, x1)) + | Pcty_signature x0 -> + let x0 = self#class_signature _ctx x0 in + Class_type_desc.of_concrete (Pcty_signature x0) + | Pcty_arrow (x0, x1, x2) -> + let x0 = self#arg_label _ctx x0 in + let x1 = self#core_type _ctx x1 in + let x2 = self#class_type _ctx x2 in + Class_type_desc.of_concrete (Pcty_arrow (x0, x1, x2)) + | Pcty_extension x0 -> + let x0 = self#extension _ctx x0 in + Class_type_desc.of_concrete (Pcty_extension x0) + | Pcty_open (x0, x1, x2) -> + let x0 = self#override_flag _ctx x0 in + let x1 = self#longident_loc _ctx x1 in + let x2 = self#class_type _ctx x2 in + Class_type_desc.of_concrete (Pcty_open (x0, x1, x2)) + method class_signature : 'ctx -> Class_signature.t -> Class_signature.t = + fun _ctx class_signature -> + let concrete = Class_signature.to_concrete class_signature in + let { pcsig_self; pcsig_fields } : Class_signature.concrete = concrete in + let pcsig_self = self#core_type _ctx pcsig_self in + let pcsig_fields = self#list self#class_type_field _ctx pcsig_fields in + Class_signature.of_concrete { pcsig_self; pcsig_fields } + method class_type_field : 'ctx -> Class_type_field.t -> Class_type_field.t = + fun _ctx class_type_field -> + let concrete = Class_type_field.to_concrete class_type_field in + let { pctf_desc; pctf_loc; pctf_attributes } : Class_type_field.concrete = concrete in + 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 + Class_type_field.of_concrete { pctf_desc; pctf_loc; pctf_attributes } + method class_type_field_desc : 'ctx -> Class_type_field_desc.t -> Class_type_field_desc.t = + fun _ctx class_type_field_desc -> + let concrete = Class_type_field_desc.to_concrete class_type_field_desc in + match (concrete : Class_type_field_desc.concrete) with + | Pctf_inherit x0 -> + let x0 = self#class_type _ctx x0 in + Class_type_field_desc.of_concrete (Pctf_inherit x0) + | Pctf_val x0 -> + let x0 = (fun _ctx (x0, x1, x2, x3) -> let x0 = self#loc self#string _ctx x0 in let x1 = self#mutable_flag _ctx x1 in let x2 = self#virtual_flag _ctx x2 in let x3 = self#core_type _ctx x3 in (x0, x1, x2, x3)) _ctx x0 in + Class_type_field_desc.of_concrete (Pctf_val x0) + | Pctf_method x0 -> + let x0 = (fun _ctx (x0, x1, x2, x3) -> let x0 = self#loc self#string _ctx x0 in let x1 = self#private_flag _ctx x1 in let x2 = self#virtual_flag _ctx x2 in let x3 = self#core_type _ctx x3 in (x0, x1, x2, x3)) _ctx x0 in + Class_type_field_desc.of_concrete (Pctf_method x0) + | Pctf_constraint x0 -> + let x0 = (fun _ctx (x0, x1) -> let x0 = self#core_type _ctx x0 in let x1 = self#core_type _ctx x1 in (x0, x1)) _ctx x0 in + Class_type_field_desc.of_concrete (Pctf_constraint x0) + | Pctf_attribute x0 -> + let x0 = self#attribute _ctx x0 in + Class_type_field_desc.of_concrete (Pctf_attribute x0) + | Pctf_extension x0 -> + let x0 = self#extension _ctx x0 in + Class_type_field_desc.of_concrete (Pctf_extension x0) + method class_infos : 'a . ('ctx -> 'a node -> 'a node) -> 'ctx -> 'a node Class_infos.t -> 'a node Class_infos.t = + fun fa _ctx class_infos -> + let concrete = Class_infos.to_concrete class_infos in + let { pci_virt; pci_params; pci_name; pci_expr; pci_loc; pci_attributes } : _ Class_infos.concrete = concrete in + let pci_virt = self#virtual_flag _ctx pci_virt in + let pci_params = self#list (fun _ctx (x0, x1) -> let x0 = self#core_type _ctx x0 in let x1 = self#variance _ctx x1 in (x0, x1)) _ctx pci_params in + let pci_name = self#loc self#string _ctx pci_name in + let pci_expr = fa _ctx pci_expr in + let pci_loc = self#location _ctx pci_loc in + let pci_attributes = self#attributes _ctx pci_attributes in + Class_infos.of_concrete { pci_virt; pci_params; pci_name; pci_expr; pci_loc; pci_attributes } + method class_description : 'ctx -> Class_description.t -> Class_description.t = + fun _ctx class_description -> + let concrete = Class_description.to_concrete class_description in + let concrete = self#class_infos self#class_type _ctx concrete in + Class_description.of_concrete concrete + method class_type_declaration : 'ctx -> Class_type_declaration.t -> Class_type_declaration.t = + fun _ctx class_type_declaration -> + let concrete = Class_type_declaration.to_concrete class_type_declaration in + let concrete = self#class_infos self#class_type _ctx concrete in + Class_type_declaration.of_concrete concrete + method class_expr : 'ctx -> Class_expr.t -> Class_expr.t = + fun _ctx class_expr -> + let concrete = Class_expr.to_concrete class_expr in + let { pcl_desc; pcl_loc; pcl_attributes } : Class_expr.concrete = concrete in + 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 + Class_expr.of_concrete { pcl_desc; pcl_loc; pcl_attributes } + method class_expr_desc : 'ctx -> Class_expr_desc.t -> Class_expr_desc.t = + fun _ctx class_expr_desc -> + let concrete = Class_expr_desc.to_concrete class_expr_desc in + match (concrete : Class_expr_desc.concrete) with + | Pcl_constr (x0, x1) -> + let x0 = self#longident_loc _ctx x0 in + let x1 = self#list self#core_type _ctx x1 in + Class_expr_desc.of_concrete (Pcl_constr (x0, x1)) + | Pcl_structure x0 -> + let x0 = self#class_structure _ctx x0 in + Class_expr_desc.of_concrete (Pcl_structure x0) + | Pcl_fun (x0, x1, x2, x3) -> + let x0 = self#arg_label _ctx x0 in + let x1 = self#option self#expression _ctx x1 in + let x2 = self#pattern _ctx x2 in + let x3 = self#class_expr _ctx x3 in + Class_expr_desc.of_concrete (Pcl_fun (x0, x1, x2, x3)) + | Pcl_apply (x0, x1) -> + let x0 = self#class_expr _ctx x0 in + let x1 = self#list (fun _ctx (x0, x1) -> let x0 = self#arg_label _ctx x0 in let x1 = self#expression _ctx x1 in (x0, x1)) _ctx x1 in + Class_expr_desc.of_concrete (Pcl_apply (x0, x1)) + | Pcl_let (x0, x1, x2) -> + let x0 = self#rec_flag _ctx x0 in + let x1 = self#list self#value_binding _ctx x1 in + let x2 = self#class_expr _ctx x2 in + Class_expr_desc.of_concrete (Pcl_let (x0, x1, x2)) + | Pcl_constraint (x0, x1) -> + let x0 = self#class_expr _ctx x0 in + let x1 = self#class_type _ctx x1 in + Class_expr_desc.of_concrete (Pcl_constraint (x0, x1)) + | Pcl_extension x0 -> + let x0 = self#extension _ctx x0 in + Class_expr_desc.of_concrete (Pcl_extension x0) + | Pcl_open (x0, x1, x2) -> + let x0 = self#override_flag _ctx x0 in + let x1 = self#longident_loc _ctx x1 in + let x2 = self#class_expr _ctx x2 in + Class_expr_desc.of_concrete (Pcl_open (x0, x1, x2)) + method class_structure : 'ctx -> Class_structure.t -> Class_structure.t = + fun _ctx class_structure -> + let concrete = Class_structure.to_concrete class_structure in + let { pcstr_self; pcstr_fields } : Class_structure.concrete = concrete in + let pcstr_self = self#pattern _ctx pcstr_self in + let pcstr_fields = self#list self#class_field _ctx pcstr_fields in + Class_structure.of_concrete { pcstr_self; pcstr_fields } + method class_field : 'ctx -> Class_field.t -> Class_field.t = + fun _ctx class_field -> + let concrete = Class_field.to_concrete class_field in + let { pcf_desc; pcf_loc; pcf_attributes } : Class_field.concrete = concrete in + 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 + Class_field.of_concrete { pcf_desc; pcf_loc; pcf_attributes } + method class_field_desc : 'ctx -> Class_field_desc.t -> Class_field_desc.t = + fun _ctx class_field_desc -> + let concrete = Class_field_desc.to_concrete class_field_desc in + match (concrete : Class_field_desc.concrete) with + | Pcf_inherit (x0, x1, x2) -> + let x0 = self#override_flag _ctx x0 in + let x1 = self#class_expr _ctx x1 in + let x2 = self#option (self#loc self#string) _ctx x2 in + Class_field_desc.of_concrete (Pcf_inherit (x0, x1, x2)) + | Pcf_val x0 -> + let x0 = (fun _ctx (x0, x1, x2) -> let x0 = self#loc self#string _ctx x0 in let x1 = self#mutable_flag _ctx x1 in let x2 = self#class_field_kind _ctx x2 in (x0, x1, x2)) _ctx x0 in + Class_field_desc.of_concrete (Pcf_val x0) + | Pcf_method x0 -> + let x0 = (fun _ctx (x0, x1, x2) -> let x0 = self#loc self#string _ctx x0 in let x1 = self#private_flag _ctx x1 in let x2 = self#class_field_kind _ctx x2 in (x0, x1, x2)) _ctx x0 in + Class_field_desc.of_concrete (Pcf_method x0) + | Pcf_constraint x0 -> + let x0 = (fun _ctx (x0, x1) -> let x0 = self#core_type _ctx x0 in let x1 = self#core_type _ctx x1 in (x0, x1)) _ctx x0 in + Class_field_desc.of_concrete (Pcf_constraint x0) + | Pcf_initializer x0 -> + let x0 = self#expression _ctx x0 in + Class_field_desc.of_concrete (Pcf_initializer x0) + | Pcf_attribute x0 -> + let x0 = self#attribute _ctx x0 in + Class_field_desc.of_concrete (Pcf_attribute x0) + | Pcf_extension x0 -> + let x0 = self#extension _ctx x0 in + Class_field_desc.of_concrete (Pcf_extension x0) + method class_field_kind : 'ctx -> Class_field_kind.t -> Class_field_kind.t = + fun _ctx class_field_kind -> + let concrete = Class_field_kind.to_concrete class_field_kind in + match (concrete : Class_field_kind.concrete) with + | Cfk_virtual x0 -> + let x0 = self#core_type _ctx x0 in + Class_field_kind.of_concrete (Cfk_virtual x0) + | Cfk_concrete (x0, x1) -> + let x0 = self#override_flag _ctx x0 in + let x1 = self#expression _ctx x1 in + Class_field_kind.of_concrete (Cfk_concrete (x0, x1)) + method class_declaration : 'ctx -> Class_declaration.t -> Class_declaration.t = + fun _ctx class_declaration -> + let concrete = Class_declaration.to_concrete class_declaration in + let concrete = self#class_infos self#class_expr _ctx concrete in + Class_declaration.of_concrete concrete + method module_type : 'ctx -> Module_type.t -> Module_type.t = + fun _ctx module_type -> + let concrete = Module_type.to_concrete module_type in + let { pmty_desc; pmty_loc; pmty_attributes } : Module_type.concrete = concrete in + 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 + Module_type.of_concrete { pmty_desc; pmty_loc; pmty_attributes } + method module_type_desc : 'ctx -> Module_type_desc.t -> Module_type_desc.t = + fun _ctx module_type_desc -> + let concrete = Module_type_desc.to_concrete module_type_desc in + match (concrete : Module_type_desc.concrete) with + | Pmty_ident x0 -> + let x0 = self#longident_loc _ctx x0 in + Module_type_desc.of_concrete (Pmty_ident x0) + | Pmty_signature x0 -> + let x0 = self#signature _ctx x0 in + Module_type_desc.of_concrete (Pmty_signature x0) + | Pmty_functor (x0, x1, x2) -> + let x0 = self#loc self#string _ctx x0 in + let x1 = self#option self#module_type _ctx x1 in + let x2 = self#module_type _ctx x2 in + Module_type_desc.of_concrete (Pmty_functor (x0, x1, x2)) + | Pmty_with (x0, x1) -> + let x0 = self#module_type _ctx x0 in + let x1 = self#list self#with_constraint _ctx x1 in + Module_type_desc.of_concrete (Pmty_with (x0, x1)) + | Pmty_typeof x0 -> + let x0 = self#module_expr _ctx x0 in + Module_type_desc.of_concrete (Pmty_typeof x0) + | Pmty_extension x0 -> + let x0 = self#extension _ctx x0 in + Module_type_desc.of_concrete (Pmty_extension x0) + | Pmty_alias x0 -> + let x0 = self#longident_loc _ctx x0 in + Module_type_desc.of_concrete (Pmty_alias x0) + method signature : 'ctx -> Signature.t -> Signature.t = + fun _ctx signature -> + let concrete = Signature.to_concrete signature in + let concrete = self#list self#signature_item _ctx concrete in + Signature.of_concrete concrete + method signature_item : 'ctx -> Signature_item.t -> Signature_item.t = + fun _ctx signature_item -> + let concrete = Signature_item.to_concrete signature_item in + let { psig_desc; psig_loc } : Signature_item.concrete = concrete in + let psig_desc = self#signature_item_desc _ctx psig_desc in + let psig_loc = self#location _ctx psig_loc in + Signature_item.of_concrete { psig_desc; psig_loc } + method signature_item_desc : 'ctx -> Signature_item_desc.t -> Signature_item_desc.t = + fun _ctx signature_item_desc -> + let concrete = Signature_item_desc.to_concrete signature_item_desc in + match (concrete : Signature_item_desc.concrete) with + | Psig_value x0 -> + let x0 = self#value_description _ctx x0 in + Signature_item_desc.of_concrete (Psig_value x0) + | Psig_type (x0, x1) -> + let x0 = self#rec_flag _ctx x0 in + let x1 = self#list self#type_declaration _ctx x1 in + Signature_item_desc.of_concrete (Psig_type (x0, x1)) + | Psig_typext x0 -> + let x0 = self#type_extension _ctx x0 in + Signature_item_desc.of_concrete (Psig_typext x0) + | Psig_exception x0 -> + let x0 = self#extension_constructor _ctx x0 in + Signature_item_desc.of_concrete (Psig_exception x0) + | Psig_module x0 -> + let x0 = self#module_declaration _ctx x0 in + Signature_item_desc.of_concrete (Psig_module x0) + | Psig_recmodule x0 -> + let x0 = self#list self#module_declaration _ctx x0 in + Signature_item_desc.of_concrete (Psig_recmodule x0) + | Psig_modtype x0 -> + let x0 = self#module_type_declaration _ctx x0 in + Signature_item_desc.of_concrete (Psig_modtype x0) + | Psig_open x0 -> + let x0 = self#open_description _ctx x0 in + Signature_item_desc.of_concrete (Psig_open x0) + | Psig_include x0 -> + let x0 = self#include_description _ctx x0 in + Signature_item_desc.of_concrete (Psig_include x0) + | Psig_class x0 -> + let x0 = self#list self#class_description _ctx x0 in + Signature_item_desc.of_concrete (Psig_class x0) + | Psig_class_type x0 -> + let x0 = self#list self#class_type_declaration _ctx x0 in + Signature_item_desc.of_concrete (Psig_class_type x0) + | Psig_attribute x0 -> + let x0 = self#attribute _ctx x0 in + Signature_item_desc.of_concrete (Psig_attribute x0) + | Psig_extension (x0, x1) -> + let x0 = self#extension _ctx x0 in + let x1 = self#attributes _ctx x1 in + Signature_item_desc.of_concrete (Psig_extension (x0, x1)) + method module_declaration : 'ctx -> Module_declaration.t -> Module_declaration.t = + fun _ctx module_declaration -> + let concrete = Module_declaration.to_concrete module_declaration in + let { pmd_name; pmd_type; pmd_attributes; pmd_loc } : Module_declaration.concrete = concrete in + 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 + Module_declaration.of_concrete { pmd_name; pmd_type; pmd_attributes; pmd_loc } + method module_type_declaration : 'ctx -> Module_type_declaration.t -> Module_type_declaration.t = + fun _ctx module_type_declaration -> + let concrete = Module_type_declaration.to_concrete module_type_declaration in + let { pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc } : Module_type_declaration.concrete = concrete in + 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 + Module_type_declaration.of_concrete { pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc } + method open_description : 'ctx -> Open_description.t -> Open_description.t = + fun _ctx open_description -> + let concrete = Open_description.to_concrete open_description in + let { popen_lid; popen_override; popen_loc; popen_attributes } : Open_description.concrete = concrete in + 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 + Open_description.of_concrete { popen_lid; popen_override; popen_loc; popen_attributes } + method include_infos : 'a . ('ctx -> 'a node -> 'a node) -> 'ctx -> 'a node Include_infos.t -> 'a node Include_infos.t = + fun fa _ctx include_infos -> + let concrete = Include_infos.to_concrete include_infos in + let { pincl_mod; pincl_loc; pincl_attributes } : _ Include_infos.concrete = concrete in + let pincl_mod = fa _ctx pincl_mod in + let pincl_loc = self#location _ctx pincl_loc in + let pincl_attributes = self#attributes _ctx pincl_attributes in + Include_infos.of_concrete { pincl_mod; pincl_loc; pincl_attributes } + method include_description : 'ctx -> Include_description.t -> Include_description.t = + fun _ctx include_description -> + let concrete = Include_description.to_concrete include_description in + let concrete = self#include_infos self#module_type _ctx concrete in + Include_description.of_concrete concrete + method include_declaration : 'ctx -> Include_declaration.t -> Include_declaration.t = + fun _ctx include_declaration -> + let concrete = Include_declaration.to_concrete include_declaration in + let concrete = self#include_infos self#module_expr _ctx concrete in + Include_declaration.of_concrete concrete + method with_constraint : 'ctx -> With_constraint.t -> With_constraint.t = + fun _ctx with_constraint -> + let concrete = With_constraint.to_concrete with_constraint in + match (concrete : With_constraint.concrete) with + | Pwith_type (x0, x1) -> + let x0 = self#longident_loc _ctx x0 in + let x1 = self#type_declaration _ctx x1 in + With_constraint.of_concrete (Pwith_type (x0, x1)) + | Pwith_module (x0, x1) -> + let x0 = self#longident_loc _ctx x0 in + let x1 = self#longident_loc _ctx x1 in + With_constraint.of_concrete (Pwith_module (x0, x1)) + | Pwith_typesubst (x0, x1) -> + let x0 = self#longident_loc _ctx x0 in + let x1 = self#type_declaration _ctx x1 in + With_constraint.of_concrete (Pwith_typesubst (x0, x1)) + | Pwith_modsubst (x0, x1) -> + let x0 = self#longident_loc _ctx x0 in + let x1 = self#longident_loc _ctx x1 in + With_constraint.of_concrete (Pwith_modsubst (x0, x1)) + method module_expr : 'ctx -> Module_expr.t -> Module_expr.t = + fun _ctx module_expr -> + let concrete = Module_expr.to_concrete module_expr in + let { pmod_desc; pmod_loc; pmod_attributes } : Module_expr.concrete = concrete in + 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 + Module_expr.of_concrete { pmod_desc; pmod_loc; pmod_attributes } + method module_expr_desc : 'ctx -> Module_expr_desc.t -> Module_expr_desc.t = + fun _ctx module_expr_desc -> + let concrete = Module_expr_desc.to_concrete module_expr_desc in + match (concrete : Module_expr_desc.concrete) with + | Pmod_ident x0 -> + let x0 = self#longident_loc _ctx x0 in + Module_expr_desc.of_concrete (Pmod_ident x0) + | Pmod_structure x0 -> + let x0 = self#structure _ctx x0 in + Module_expr_desc.of_concrete (Pmod_structure x0) + | Pmod_functor (x0, x1, x2) -> + let x0 = self#loc self#string _ctx x0 in + let x1 = self#option self#module_type _ctx x1 in + let x2 = self#module_expr _ctx x2 in + Module_expr_desc.of_concrete (Pmod_functor (x0, x1, x2)) + | Pmod_apply (x0, x1) -> + let x0 = self#module_expr _ctx x0 in + let x1 = self#module_expr _ctx x1 in + Module_expr_desc.of_concrete (Pmod_apply (x0, x1)) + | Pmod_constraint (x0, x1) -> + let x0 = self#module_expr _ctx x0 in + let x1 = self#module_type _ctx x1 in + Module_expr_desc.of_concrete (Pmod_constraint (x0, x1)) + | Pmod_unpack x0 -> + let x0 = self#expression _ctx x0 in + Module_expr_desc.of_concrete (Pmod_unpack x0) + | Pmod_extension x0 -> + let x0 = self#extension _ctx x0 in + Module_expr_desc.of_concrete (Pmod_extension x0) + method structure : 'ctx -> Structure.t -> Structure.t = + fun _ctx structure -> + let concrete = Structure.to_concrete structure in + let concrete = self#list self#structure_item _ctx concrete in + Structure.of_concrete concrete + method structure_item : 'ctx -> Structure_item.t -> Structure_item.t = + fun _ctx structure_item -> + let concrete = Structure_item.to_concrete structure_item in + let { pstr_desc; pstr_loc } : Structure_item.concrete = concrete in + let pstr_desc = self#structure_item_desc _ctx pstr_desc in + let pstr_loc = self#location _ctx pstr_loc in + Structure_item.of_concrete { pstr_desc; pstr_loc } + method structure_item_desc : 'ctx -> Structure_item_desc.t -> Structure_item_desc.t = + fun _ctx structure_item_desc -> + let concrete = Structure_item_desc.to_concrete structure_item_desc in + match (concrete : Structure_item_desc.concrete) with + | Pstr_eval (x0, x1) -> + let x0 = self#expression _ctx x0 in + let x1 = self#attributes _ctx x1 in + Structure_item_desc.of_concrete (Pstr_eval (x0, x1)) + | Pstr_value (x0, x1) -> + let x0 = self#rec_flag _ctx x0 in + let x1 = self#list self#value_binding _ctx x1 in + Structure_item_desc.of_concrete (Pstr_value (x0, x1)) + | Pstr_primitive x0 -> + let x0 = self#value_description _ctx x0 in + Structure_item_desc.of_concrete (Pstr_primitive x0) + | Pstr_type (x0, x1) -> + let x0 = self#rec_flag _ctx x0 in + let x1 = self#list self#type_declaration _ctx x1 in + Structure_item_desc.of_concrete (Pstr_type (x0, x1)) + | Pstr_typext x0 -> + let x0 = self#type_extension _ctx x0 in + Structure_item_desc.of_concrete (Pstr_typext x0) + | Pstr_exception x0 -> + let x0 = self#extension_constructor _ctx x0 in + Structure_item_desc.of_concrete (Pstr_exception x0) + | Pstr_module x0 -> + let x0 = self#module_binding _ctx x0 in + Structure_item_desc.of_concrete (Pstr_module x0) + | Pstr_recmodule x0 -> + let x0 = self#list self#module_binding _ctx x0 in + Structure_item_desc.of_concrete (Pstr_recmodule x0) + | Pstr_modtype x0 -> + let x0 = self#module_type_declaration _ctx x0 in + Structure_item_desc.of_concrete (Pstr_modtype x0) + | Pstr_open x0 -> + let x0 = self#open_description _ctx x0 in + Structure_item_desc.of_concrete (Pstr_open x0) + | Pstr_class x0 -> + let x0 = self#list self#class_declaration _ctx x0 in + Structure_item_desc.of_concrete (Pstr_class x0) + | Pstr_class_type x0 -> + let x0 = self#list self#class_type_declaration _ctx x0 in + Structure_item_desc.of_concrete (Pstr_class_type x0) + | Pstr_include x0 -> + let x0 = self#include_declaration _ctx x0 in + Structure_item_desc.of_concrete (Pstr_include x0) + | Pstr_attribute x0 -> + let x0 = self#attribute _ctx x0 in + Structure_item_desc.of_concrete (Pstr_attribute x0) + | Pstr_extension (x0, x1) -> + let x0 = self#extension _ctx x0 in + let x1 = self#attributes _ctx x1 in + Structure_item_desc.of_concrete (Pstr_extension (x0, x1)) + method value_binding : 'ctx -> Value_binding.t -> Value_binding.t = + fun _ctx value_binding -> + let concrete = Value_binding.to_concrete value_binding in + let { pvb_pat; pvb_expr; pvb_attributes; pvb_loc } : Value_binding.concrete = concrete in + 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 + Value_binding.of_concrete { pvb_pat; pvb_expr; pvb_attributes; pvb_loc } + method module_binding : 'ctx -> Module_binding.t -> Module_binding.t = + fun _ctx module_binding -> + let concrete = Module_binding.to_concrete module_binding in + let { pmb_name; pmb_expr; pmb_attributes; pmb_loc } : Module_binding.concrete = concrete in + 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 + Module_binding.of_concrete { pmb_name; pmb_expr; pmb_attributes; pmb_loc } + method toplevel_phrase : 'ctx -> Toplevel_phrase.t -> Toplevel_phrase.t = + fun _ctx toplevel_phrase -> + let concrete = Toplevel_phrase.to_concrete toplevel_phrase in + match (concrete : Toplevel_phrase.concrete) with + | Ptop_def x0 -> + let x0 = self#structure _ctx x0 in + Toplevel_phrase.of_concrete (Ptop_def x0) + | Ptop_dir (x0, x1) -> + let x0 = self#string _ctx x0 in + let x1 = self#directive_argument _ctx x1 in + Toplevel_phrase.of_concrete (Ptop_dir (x0, x1)) + method directive_argument : 'ctx -> Directive_argument.t -> Directive_argument.t = + fun _ctx directive_argument -> + let concrete = Directive_argument.to_concrete directive_argument in + match (concrete : Directive_argument.concrete) with + | Pdir_none -> + Directive_argument.of_concrete Pdir_none + | Pdir_string x0 -> + let x0 = self#string _ctx x0 in + Directive_argument.of_concrete (Pdir_string x0) + | Pdir_int (x0, x1) -> + let x0 = self#string _ctx x0 in + let x1 = self#option self#char _ctx x1 in + Directive_argument.of_concrete (Pdir_int (x0, x1)) + | Pdir_ident x0 -> + let x0 = self#longident _ctx x0 in + Directive_argument.of_concrete (Pdir_ident x0) + | Pdir_bool x0 -> + let x0 = self#bool _ctx x0 in + Directive_argument.of_concrete (Pdir_bool x0) + end + +class virtual ['res] lift = + object (self) + method virtual node : (string * int) option -> 'res -> 'res + method virtual record : (string * int) option -> (string * 'res) list -> 'res + method virtual constr : (string * int) option -> string -> 'res list -> 'res + method virtual tuple : 'res list -> 'res + method virtual bool : bool -> 'res + method virtual char : char -> 'res + method virtual int : int -> 'res + method virtual list : 'a . ('a -> 'res) -> 'a list -> 'res + method virtual option : 'a . ('a -> 'res) -> 'a option -> 'res + method virtual string : string -> 'res + method virtual location : Astlib.Location.t -> 'res + method virtual loc : 'a . ('a -> 'res) -> 'a Astlib.Loc.t -> 'res + method longident : Longident.t -> 'res = + fun longident -> + let concrete = Longident.to_concrete longident in + match (concrete : Longident.concrete) with + | Lident x0 -> + let x0 = self#string x0 in + self#constr (Some ("longident", 0)) "Lident" [x0] + | Ldot (x0, x1) -> + let x0 = self#longident x0 in + let x1 = self#string x1 in + self#constr (Some ("longident", 0)) "Ldot" [x0; x1] + | Lapply (x0, x1) -> + let x0 = self#longident x0 in + let x1 = self#longident x1 in + self#constr (Some ("longident", 0)) "Lapply" [x0; x1] + method longident_loc : Longident_loc.t -> 'res = + fun longident_loc -> + let concrete = Longident_loc.to_concrete longident_loc in + let concrete = self#loc self#longident concrete in + self#node (Some ("longident_loc", 0)) concrete + method rec_flag : Rec_flag.t -> 'res = + fun rec_flag -> + let concrete = Rec_flag.to_concrete rec_flag in + match (concrete : Rec_flag.concrete) with + | Nonrecursive -> + self#constr (Some ("rec_flag", 0)) "Nonrecursive" [] + | Recursive -> + self#constr (Some ("rec_flag", 0)) "Recursive" [] + method direction_flag : Direction_flag.t -> 'res = + fun direction_flag -> + let concrete = Direction_flag.to_concrete direction_flag in + match (concrete : Direction_flag.concrete) with + | Upto -> + self#constr (Some ("direction_flag", 0)) "Upto" [] + | Downto -> + self#constr (Some ("direction_flag", 0)) "Downto" [] + method private_flag : Private_flag.t -> 'res = + fun private_flag -> + let concrete = Private_flag.to_concrete private_flag in + match (concrete : Private_flag.concrete) with + | Private -> + self#constr (Some ("private_flag", 0)) "Private" [] + | Public -> + self#constr (Some ("private_flag", 0)) "Public" [] + method mutable_flag : Mutable_flag.t -> 'res = + fun mutable_flag -> + let concrete = Mutable_flag.to_concrete mutable_flag in + match (concrete : Mutable_flag.concrete) with + | Immutable -> + self#constr (Some ("mutable_flag", 0)) "Immutable" [] + | Mutable -> + self#constr (Some ("mutable_flag", 0)) "Mutable" [] + method virtual_flag : Virtual_flag.t -> 'res = + fun virtual_flag -> + let concrete = Virtual_flag.to_concrete virtual_flag in + match (concrete : Virtual_flag.concrete) with + | Virtual -> + self#constr (Some ("virtual_flag", 0)) "Virtual" [] + | Concrete -> + self#constr (Some ("virtual_flag", 0)) "Concrete" [] + method override_flag : Override_flag.t -> 'res = + fun override_flag -> + let concrete = Override_flag.to_concrete override_flag in + match (concrete : Override_flag.concrete) with + | Override -> + self#constr (Some ("override_flag", 0)) "Override" [] + | Fresh -> + self#constr (Some ("override_flag", 0)) "Fresh" [] + method closed_flag : Closed_flag.t -> 'res = + fun closed_flag -> + let concrete = Closed_flag.to_concrete closed_flag in + match (concrete : Closed_flag.concrete) with + | Closed -> + self#constr (Some ("closed_flag", 0)) "Closed" [] + | Open -> + self#constr (Some ("closed_flag", 0)) "Open" [] + method arg_label : Arg_label.t -> 'res = + fun arg_label -> + let concrete = Arg_label.to_concrete arg_label in + match (concrete : Arg_label.concrete) with + | Nolabel -> + self#constr (Some ("arg_label", 0)) "Nolabel" [] + | Labelled x0 -> + let x0 = self#string x0 in + self#constr (Some ("arg_label", 0)) "Labelled" [x0] + | Optional x0 -> + let x0 = self#string x0 in + self#constr (Some ("arg_label", 0)) "Optional" [x0] + method variance : Variance.t -> 'res = + fun variance -> + let concrete = Variance.to_concrete variance in + match (concrete : Variance.concrete) with + | Covariant -> + self#constr (Some ("variance", 0)) "Covariant" [] + | Contravariant -> + self#constr (Some ("variance", 0)) "Contravariant" [] + | Invariant -> + self#constr (Some ("variance", 0)) "Invariant" [] + method constant : Constant.t -> 'res = + fun constant -> + let concrete = Constant.to_concrete constant in + match (concrete : Constant.concrete) with + | Pconst_integer (x0, x1) -> + let x0 = self#string x0 in + let x1 = self#option self#char x1 in + self#constr (Some ("constant", 0)) "Pconst_integer" [x0; x1] + | Pconst_char x0 -> + let x0 = self#char x0 in + self#constr (Some ("constant", 0)) "Pconst_char" [x0] + | Pconst_string (x0, x1) -> + let x0 = self#string x0 in + let x1 = self#option self#string x1 in + self#constr (Some ("constant", 0)) "Pconst_string" [x0; x1] + | Pconst_float (x0, x1) -> + let x0 = self#string x0 in + let x1 = self#option self#char x1 in + self#constr (Some ("constant", 0)) "Pconst_float" [x0; x1] + method attribute : Attribute.t -> 'res = + fun attribute -> + let concrete = Attribute.to_concrete attribute in + let (x0, x1) = concrete in + let x0 = self#loc self#string x0 in + let x1 = self#payload x1 in + self#node (Some ("attribute", 0)) (self#tuple [x0; x1]) + method extension : Extension.t -> 'res = + fun extension -> + let concrete = Extension.to_concrete extension in + let (x0, x1) = concrete in + let x0 = self#loc self#string x0 in + let x1 = self#payload x1 in + self#node (Some ("extension", 0)) (self#tuple [x0; x1]) + method attributes : Attributes.t -> 'res = + fun attributes -> + let concrete = Attributes.to_concrete attributes in + let concrete = self#list self#attribute concrete in + self#node (Some ("attributes", 0)) concrete + method payload : Payload.t -> 'res = + fun payload -> + let concrete = Payload.to_concrete payload in + match (concrete : Payload.concrete) with + | PStr x0 -> + let x0 = self#structure x0 in + self#constr (Some ("payload", 0)) "PStr" [x0] + | PSig x0 -> + let x0 = self#signature x0 in + self#constr (Some ("payload", 0)) "PSig" [x0] + | PTyp x0 -> + let x0 = self#core_type x0 in + self#constr (Some ("payload", 0)) "PTyp" [x0] + | PPat (x0, x1) -> + let x0 = self#pattern x0 in + let x1 = self#option self#expression x1 in + self#constr (Some ("payload", 0)) "PPat" [x0; x1] + method core_type : Core_type.t -> 'res = + fun core_type -> + let concrete = Core_type.to_concrete core_type in + let { ptyp_desc; ptyp_loc; ptyp_attributes } : Core_type.concrete = concrete in + 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 (Some ("core_type", 0)) [("ptyp_desc", ptyp_desc); ("ptyp_loc", ptyp_loc); ("ptyp_attributes", ptyp_attributes)] + method core_type_desc : Core_type_desc.t -> 'res = + fun core_type_desc -> + let concrete = Core_type_desc.to_concrete core_type_desc in + match (concrete : Core_type_desc.concrete) with + | Ptyp_any -> + self#constr (Some ("core_type_desc", 0)) "Ptyp_any" [] + | Ptyp_var x0 -> + let x0 = self#string x0 in + self#constr (Some ("core_type_desc", 0)) "Ptyp_var" [x0] + | Ptyp_arrow (x0, x1, x2) -> + let x0 = self#arg_label x0 in + let x1 = self#core_type x1 in + let x2 = self#core_type x2 in + self#constr (Some ("core_type_desc", 0)) "Ptyp_arrow" [x0; x1; x2] + | Ptyp_tuple x0 -> + let x0 = self#list self#core_type x0 in + self#constr (Some ("core_type_desc", 0)) "Ptyp_tuple" [x0] + | Ptyp_constr (x0, x1) -> + let x0 = self#longident_loc x0 in + let x1 = self#list self#core_type x1 in + self#constr (Some ("core_type_desc", 0)) "Ptyp_constr" [x0; x1] + | Ptyp_object (x0, x1) -> + let x0 = self#list self#object_field x0 in + let x1 = self#closed_flag x1 in + self#constr (Some ("core_type_desc", 0)) "Ptyp_object" [x0; x1] + | Ptyp_class (x0, x1) -> + let x0 = self#longident_loc x0 in + let x1 = self#list self#core_type x1 in + self#constr (Some ("core_type_desc", 0)) "Ptyp_class" [x0; x1] + | Ptyp_alias (x0, x1) -> + let x0 = self#core_type x0 in + let x1 = self#string x1 in + self#constr (Some ("core_type_desc", 0)) "Ptyp_alias" [x0; x1] + | Ptyp_variant (x0, x1, x2) -> + let x0 = self#list self#row_field x0 in + let x1 = self#closed_flag x1 in + let x2 = self#option (self#list self#string) x2 in + self#constr (Some ("core_type_desc", 0)) "Ptyp_variant" [x0; x1; x2] + | Ptyp_poly (x0, x1) -> + let x0 = self#list (self#loc self#string) x0 in + let x1 = self#core_type x1 in + self#constr (Some ("core_type_desc", 0)) "Ptyp_poly" [x0; x1] + | Ptyp_package x0 -> + let x0 = self#package_type x0 in + self#constr (Some ("core_type_desc", 0)) "Ptyp_package" [x0] + | Ptyp_extension x0 -> + let x0 = self#extension x0 in + self#constr (Some ("core_type_desc", 0)) "Ptyp_extension" [x0] + method package_type : Package_type.t -> 'res = + fun package_type -> + let concrete = Package_type.to_concrete package_type in + let (x0, x1) = concrete in + let x0 = self#longident_loc x0 in + let x1 = self#list (fun (x0, x1) -> let x0 = self#longident_loc x0 in let x1 = self#core_type x1 in self#node None (self#tuple [x0; x1])) x1 in + self#node (Some ("package_type", 0)) (self#tuple [x0; x1]) + method row_field : Row_field.t -> 'res = + fun row_field -> + let concrete = Row_field.to_concrete row_field in + match (concrete : Row_field.concrete) with + | Rtag (x0, x1, x2, x3) -> + let x0 = self#loc self#string x0 in + let x1 = self#attributes x1 in + let x2 = self#bool x2 in + let x3 = self#list self#core_type x3 in + self#constr (Some ("row_field", 0)) "Rtag" [x0; x1; x2; x3] + | Rinherit x0 -> + let x0 = self#core_type x0 in + self#constr (Some ("row_field", 0)) "Rinherit" [x0] + method object_field : Object_field.t -> 'res = + fun object_field -> + let concrete = Object_field.to_concrete object_field in + match (concrete : Object_field.concrete) with + | Otag (x0, x1, x2) -> + let x0 = self#loc self#string x0 in + let x1 = self#attributes x1 in + let x2 = self#core_type x2 in + self#constr (Some ("object_field", 0)) "Otag" [x0; x1; x2] + | Oinherit x0 -> + let x0 = self#core_type x0 in + self#constr (Some ("object_field", 0)) "Oinherit" [x0] + method pattern : Pattern.t -> 'res = + fun pattern -> + let concrete = Pattern.to_concrete pattern in + let { ppat_desc; ppat_loc; ppat_attributes } : Pattern.concrete = concrete in + 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 (Some ("pattern", 0)) [("ppat_desc", ppat_desc); ("ppat_loc", ppat_loc); ("ppat_attributes", ppat_attributes)] + method pattern_desc : Pattern_desc.t -> 'res = + fun pattern_desc -> + let concrete = Pattern_desc.to_concrete pattern_desc in + match (concrete : Pattern_desc.concrete) with + | Ppat_any -> + self#constr (Some ("pattern_desc", 0)) "Ppat_any" [] + | Ppat_var x0 -> + let x0 = self#loc self#string x0 in + self#constr (Some ("pattern_desc", 0)) "Ppat_var" [x0] + | Ppat_alias (x0, x1) -> + let x0 = self#pattern x0 in + let x1 = self#loc self#string x1 in + self#constr (Some ("pattern_desc", 0)) "Ppat_alias" [x0; x1] + | Ppat_constant x0 -> + let x0 = self#constant x0 in + self#constr (Some ("pattern_desc", 0)) "Ppat_constant" [x0] + | Ppat_interval (x0, x1) -> + let x0 = self#constant x0 in + let x1 = self#constant x1 in + self#constr (Some ("pattern_desc", 0)) "Ppat_interval" [x0; x1] + | Ppat_tuple x0 -> + let x0 = self#list self#pattern x0 in + self#constr (Some ("pattern_desc", 0)) "Ppat_tuple" [x0] + | Ppat_construct (x0, x1) -> + let x0 = self#longident_loc x0 in + let x1 = self#option self#pattern x1 in + self#constr (Some ("pattern_desc", 0)) "Ppat_construct" [x0; x1] + | Ppat_variant (x0, x1) -> + let x0 = self#string x0 in + let x1 = self#option self#pattern x1 in + self#constr (Some ("pattern_desc", 0)) "Ppat_variant" [x0; x1] + | Ppat_record (x0, x1) -> + let x0 = self#list (fun (x0, x1) -> let x0 = self#longident_loc x0 in let x1 = self#pattern x1 in self#node None (self#tuple [x0; x1])) x0 in + let x1 = self#closed_flag x1 in + self#constr (Some ("pattern_desc", 0)) "Ppat_record" [x0; x1] + | Ppat_array x0 -> + let x0 = self#list self#pattern x0 in + self#constr (Some ("pattern_desc", 0)) "Ppat_array" [x0] + | Ppat_or (x0, x1) -> + let x0 = self#pattern x0 in + let x1 = self#pattern x1 in + self#constr (Some ("pattern_desc", 0)) "Ppat_or" [x0; x1] + | Ppat_constraint (x0, x1) -> + let x0 = self#pattern x0 in + let x1 = self#core_type x1 in + self#constr (Some ("pattern_desc", 0)) "Ppat_constraint" [x0; x1] + | Ppat_type x0 -> + let x0 = self#longident_loc x0 in + self#constr (Some ("pattern_desc", 0)) "Ppat_type" [x0] + | Ppat_lazy x0 -> + let x0 = self#pattern x0 in + self#constr (Some ("pattern_desc", 0)) "Ppat_lazy" [x0] + | Ppat_unpack x0 -> + let x0 = self#loc self#string x0 in + self#constr (Some ("pattern_desc", 0)) "Ppat_unpack" [x0] + | Ppat_exception x0 -> + let x0 = self#pattern x0 in + self#constr (Some ("pattern_desc", 0)) "Ppat_exception" [x0] + | Ppat_extension x0 -> + let x0 = self#extension x0 in + self#constr (Some ("pattern_desc", 0)) "Ppat_extension" [x0] + | Ppat_open (x0, x1) -> + let x0 = self#longident_loc x0 in + let x1 = self#pattern x1 in + self#constr (Some ("pattern_desc", 0)) "Ppat_open" [x0; x1] + method expression : Expression.t -> 'res = + fun expression -> + let concrete = Expression.to_concrete expression in + let { pexp_desc; pexp_loc; pexp_attributes } : Expression.concrete = concrete in + 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 (Some ("expression", 0)) [("pexp_desc", pexp_desc); ("pexp_loc", pexp_loc); ("pexp_attributes", pexp_attributes)] + method expression_desc : Expression_desc.t -> 'res = + fun expression_desc -> + let concrete = Expression_desc.to_concrete expression_desc in + match (concrete : Expression_desc.concrete) with + | Pexp_ident x0 -> + let x0 = self#longident_loc x0 in + self#constr (Some ("expression_desc", 0)) "Pexp_ident" [x0] + | Pexp_constant x0 -> + let x0 = self#constant x0 in + self#constr (Some ("expression_desc", 0)) "Pexp_constant" [x0] + | Pexp_let (x0, x1, x2) -> + let x0 = self#rec_flag x0 in + let x1 = self#list self#value_binding x1 in + let x2 = self#expression x2 in + self#constr (Some ("expression_desc", 0)) "Pexp_let" [x0; x1; x2] + | Pexp_function x0 -> + let x0 = self#list self#case x0 in + self#constr (Some ("expression_desc", 0)) "Pexp_function" [x0] + | Pexp_fun (x0, x1, x2, x3) -> + let x0 = self#arg_label x0 in + let x1 = self#option self#expression x1 in + let x2 = self#pattern x2 in + let x3 = self#expression x3 in + self#constr (Some ("expression_desc", 0)) "Pexp_fun" [x0; x1; x2; x3] + | Pexp_apply (x0, x1) -> + let x0 = self#expression x0 in + let x1 = self#list (fun (x0, x1) -> let x0 = self#arg_label x0 in let x1 = self#expression x1 in self#node None (self#tuple [x0; x1])) x1 in + self#constr (Some ("expression_desc", 0)) "Pexp_apply" [x0; x1] + | Pexp_match (x0, x1) -> + let x0 = self#expression x0 in + let x1 = self#list self#case x1 in + self#constr (Some ("expression_desc", 0)) "Pexp_match" [x0; x1] + | Pexp_try (x0, x1) -> + let x0 = self#expression x0 in + let x1 = self#list self#case x1 in + self#constr (Some ("expression_desc", 0)) "Pexp_try" [x0; x1] + | Pexp_tuple x0 -> + let x0 = self#list self#expression x0 in + self#constr (Some ("expression_desc", 0)) "Pexp_tuple" [x0] + | Pexp_construct (x0, x1) -> + let x0 = self#longident_loc x0 in + let x1 = self#option self#expression x1 in + self#constr (Some ("expression_desc", 0)) "Pexp_construct" [x0; x1] + | Pexp_variant (x0, x1) -> + let x0 = self#string x0 in + let x1 = self#option self#expression x1 in + self#constr (Some ("expression_desc", 0)) "Pexp_variant" [x0; x1] + | Pexp_record (x0, x1) -> + let x0 = self#list (fun (x0, x1) -> let x0 = self#longident_loc x0 in let x1 = self#expression x1 in self#node None (self#tuple [x0; x1])) x0 in + let x1 = self#option self#expression x1 in + self#constr (Some ("expression_desc", 0)) "Pexp_record" [x0; x1] + | Pexp_field (x0, x1) -> + let x0 = self#expression x0 in + let x1 = self#longident_loc x1 in + self#constr (Some ("expression_desc", 0)) "Pexp_field" [x0; x1] + | Pexp_setfield (x0, x1, x2) -> + let x0 = self#expression x0 in + let x1 = self#longident_loc x1 in + let x2 = self#expression x2 in + self#constr (Some ("expression_desc", 0)) "Pexp_setfield" [x0; x1; x2] + | Pexp_array x0 -> + let x0 = self#list self#expression x0 in + self#constr (Some ("expression_desc", 0)) "Pexp_array" [x0] + | Pexp_ifthenelse (x0, x1, x2) -> + let x0 = self#expression x0 in + let x1 = self#expression x1 in + let x2 = self#option self#expression x2 in + self#constr (Some ("expression_desc", 0)) "Pexp_ifthenelse" [x0; x1; x2] + | Pexp_sequence (x0, x1) -> + let x0 = self#expression x0 in + let x1 = self#expression x1 in + self#constr (Some ("expression_desc", 0)) "Pexp_sequence" [x0; x1] + | Pexp_while (x0, x1) -> + let x0 = self#expression x0 in + let x1 = self#expression x1 in + self#constr (Some ("expression_desc", 0)) "Pexp_while" [x0; x1] + | Pexp_for (x0, x1, x2, x3, x4) -> + let x0 = self#pattern x0 in + let x1 = self#expression x1 in + let x2 = self#expression x2 in + let x3 = self#direction_flag x3 in + let x4 = self#expression x4 in + self#constr (Some ("expression_desc", 0)) "Pexp_for" [x0; x1; x2; x3; x4] + | Pexp_constraint (x0, x1) -> + let x0 = self#expression x0 in + let x1 = self#core_type x1 in + self#constr (Some ("expression_desc", 0)) "Pexp_constraint" [x0; x1] + | Pexp_coerce (x0, x1, x2) -> + let x0 = self#expression x0 in + let x1 = self#option self#core_type x1 in + let x2 = self#core_type x2 in + self#constr (Some ("expression_desc", 0)) "Pexp_coerce" [x0; x1; x2] + | Pexp_send (x0, x1) -> + let x0 = self#expression x0 in + let x1 = self#loc self#string x1 in + self#constr (Some ("expression_desc", 0)) "Pexp_send" [x0; x1] + | Pexp_new x0 -> + let x0 = self#longident_loc x0 in + self#constr (Some ("expression_desc", 0)) "Pexp_new" [x0] + | Pexp_setinstvar (x0, x1) -> + let x0 = self#loc self#string x0 in + let x1 = self#expression x1 in + self#constr (Some ("expression_desc", 0)) "Pexp_setinstvar" [x0; x1] + | Pexp_override x0 -> + let x0 = self#list (fun (x0, x1) -> let x0 = self#loc self#string x0 in let x1 = self#expression x1 in self#node None (self#tuple [x0; x1])) x0 in + self#constr (Some ("expression_desc", 0)) "Pexp_override" [x0] + | Pexp_letmodule (x0, x1, x2) -> + let x0 = self#loc self#string x0 in + let x1 = self#module_expr x1 in + let x2 = self#expression x2 in + self#constr (Some ("expression_desc", 0)) "Pexp_letmodule" [x0; x1; x2] + | Pexp_letexception (x0, x1) -> + let x0 = self#extension_constructor x0 in + let x1 = self#expression x1 in + self#constr (Some ("expression_desc", 0)) "Pexp_letexception" [x0; x1] + | Pexp_assert x0 -> + let x0 = self#expression x0 in + self#constr (Some ("expression_desc", 0)) "Pexp_assert" [x0] + | Pexp_lazy x0 -> + let x0 = self#expression x0 in + self#constr (Some ("expression_desc", 0)) "Pexp_lazy" [x0] + | Pexp_poly (x0, x1) -> + let x0 = self#expression x0 in + let x1 = self#option self#core_type x1 in + self#constr (Some ("expression_desc", 0)) "Pexp_poly" [x0; x1] + | Pexp_object x0 -> + let x0 = self#class_structure x0 in + self#constr (Some ("expression_desc", 0)) "Pexp_object" [x0] + | Pexp_newtype (x0, x1) -> + let x0 = self#loc self#string x0 in + let x1 = self#expression x1 in + self#constr (Some ("expression_desc", 0)) "Pexp_newtype" [x0; x1] + | Pexp_pack x0 -> + let x0 = self#module_expr x0 in + self#constr (Some ("expression_desc", 0)) "Pexp_pack" [x0] + | Pexp_open (x0, x1, x2) -> + let x0 = self#override_flag x0 in + let x1 = self#longident_loc x1 in + let x2 = self#expression x2 in + self#constr (Some ("expression_desc", 0)) "Pexp_open" [x0; x1; x2] + | Pexp_extension x0 -> + let x0 = self#extension x0 in + self#constr (Some ("expression_desc", 0)) "Pexp_extension" [x0] + | Pexp_unreachable -> + self#constr (Some ("expression_desc", 0)) "Pexp_unreachable" [] + method case : Case.t -> 'res = + fun case -> + let concrete = Case.to_concrete case in + let { pc_lhs; pc_guard; pc_rhs } : Case.concrete = concrete in + 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 (Some ("case", 0)) [("pc_lhs", pc_lhs); ("pc_guard", pc_guard); ("pc_rhs", pc_rhs)] + method value_description : Value_description.t -> 'res = + fun value_description -> + let concrete = Value_description.to_concrete value_description in + let { pval_name; pval_type; pval_prim; pval_attributes; pval_loc } : Value_description.concrete = concrete in + 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 (Some ("value_description", 0)) [("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.t -> 'res = + fun type_declaration -> + let concrete = Type_declaration.to_concrete type_declaration in + let { ptype_name; ptype_params; ptype_cstrs; ptype_kind; ptype_private; ptype_manifest; ptype_attributes; ptype_loc } : Type_declaration.concrete = concrete in + let ptype_name = self#loc self#string ptype_name in + let ptype_params = self#list (fun (x0, x1) -> let x0 = self#core_type x0 in let x1 = self#variance x1 in self#node None (self#tuple [x0; x1])) ptype_params in + let ptype_cstrs = self#list (fun (x0, x1, x2) -> let x0 = self#core_type x0 in let x1 = self#core_type x1 in let x2 = self#location x2 in self#node None (self#tuple [x0; x1; x2])) 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 (Some ("type_declaration", 0)) [("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.t -> 'res = + fun type_kind -> + let concrete = Type_kind.to_concrete type_kind in + match (concrete : Type_kind.concrete) with + | Ptype_abstract -> + self#constr (Some ("type_kind", 0)) "Ptype_abstract" [] + | Ptype_variant x0 -> + let x0 = self#list self#constructor_declaration x0 in + self#constr (Some ("type_kind", 0)) "Ptype_variant" [x0] + | Ptype_record x0 -> + let x0 = self#list self#label_declaration x0 in + self#constr (Some ("type_kind", 0)) "Ptype_record" [x0] + | Ptype_open -> + self#constr (Some ("type_kind", 0)) "Ptype_open" [] + method label_declaration : Label_declaration.t -> 'res = + fun label_declaration -> + let concrete = Label_declaration.to_concrete label_declaration in + let { pld_name; pld_mutable; pld_type; pld_loc; pld_attributes } : Label_declaration.concrete = concrete in + 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 (Some ("label_declaration", 0)) [("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.t -> 'res = + fun constructor_declaration -> + let concrete = Constructor_declaration.to_concrete constructor_declaration in + let { pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes } : Constructor_declaration.concrete = concrete in + 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 (Some ("constructor_declaration", 0)) [("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.t -> 'res = + fun constructor_arguments -> + let concrete = Constructor_arguments.to_concrete constructor_arguments in + match (concrete : Constructor_arguments.concrete) with + | Pcstr_tuple x0 -> + let x0 = self#list self#core_type x0 in + self#constr (Some ("constructor_arguments", 0)) "Pcstr_tuple" [x0] + | Pcstr_record x0 -> + let x0 = self#list self#label_declaration x0 in + self#constr (Some ("constructor_arguments", 0)) "Pcstr_record" [x0] + method type_extension : Type_extension.t -> 'res = + fun type_extension -> + let concrete = Type_extension.to_concrete type_extension in + let { ptyext_path; ptyext_params; ptyext_constructors; ptyext_private; ptyext_attributes } : Type_extension.concrete = concrete in + let ptyext_path = self#longident_loc ptyext_path in + let ptyext_params = self#list (fun (x0, x1) -> let x0 = self#core_type x0 in let x1 = self#variance x1 in self#node None (self#tuple [x0; x1])) 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 (Some ("type_extension", 0)) [("ptyext_path", ptyext_path); ("ptyext_params", ptyext_params); ("ptyext_constructors", ptyext_constructors); ("ptyext_private", ptyext_private); ("ptyext_attributes", ptyext_attributes)] + method extension_constructor : Extension_constructor.t -> 'res = + fun extension_constructor -> + let concrete = Extension_constructor.to_concrete extension_constructor in + let { pext_name; pext_kind; pext_loc; pext_attributes } : Extension_constructor.concrete = concrete in + 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 (Some ("extension_constructor", 0)) [("pext_name", pext_name); ("pext_kind", pext_kind); ("pext_loc", pext_loc); ("pext_attributes", pext_attributes)] + method extension_constructor_kind : Extension_constructor_kind.t -> 'res = + fun extension_constructor_kind -> + let concrete = Extension_constructor_kind.to_concrete extension_constructor_kind in + match (concrete : Extension_constructor_kind.concrete) with + | Pext_decl (x0, x1) -> + let x0 = self#constructor_arguments x0 in + let x1 = self#option self#core_type x1 in + self#constr (Some ("extension_constructor_kind", 0)) "Pext_decl" [x0; x1] + | Pext_rebind x0 -> + let x0 = self#longident_loc x0 in + self#constr (Some ("extension_constructor_kind", 0)) "Pext_rebind" [x0] + method class_type : Class_type.t -> 'res = + fun class_type -> + let concrete = Class_type.to_concrete class_type in + let { pcty_desc; pcty_loc; pcty_attributes } : Class_type.concrete = concrete in + 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 (Some ("class_type", 0)) [("pcty_desc", pcty_desc); ("pcty_loc", pcty_loc); ("pcty_attributes", pcty_attributes)] + method class_type_desc : Class_type_desc.t -> 'res = + fun class_type_desc -> + let concrete = Class_type_desc.to_concrete class_type_desc in + match (concrete : Class_type_desc.concrete) with + | Pcty_constr (x0, x1) -> + let x0 = self#longident_loc x0 in + let x1 = self#list self#core_type x1 in + self#constr (Some ("class_type_desc", 0)) "Pcty_constr" [x0; x1] + | Pcty_signature x0 -> + let x0 = self#class_signature x0 in + self#constr (Some ("class_type_desc", 0)) "Pcty_signature" [x0] + | Pcty_arrow (x0, x1, x2) -> + let x0 = self#arg_label x0 in + let x1 = self#core_type x1 in + let x2 = self#class_type x2 in + self#constr (Some ("class_type_desc", 0)) "Pcty_arrow" [x0; x1; x2] + | Pcty_extension x0 -> + let x0 = self#extension x0 in + self#constr (Some ("class_type_desc", 0)) "Pcty_extension" [x0] + | Pcty_open (x0, x1, x2) -> + let x0 = self#override_flag x0 in + let x1 = self#longident_loc x1 in + let x2 = self#class_type x2 in + self#constr (Some ("class_type_desc", 0)) "Pcty_open" [x0; x1; x2] + method class_signature : Class_signature.t -> 'res = + fun class_signature -> + let concrete = Class_signature.to_concrete class_signature in + let { pcsig_self; pcsig_fields } : Class_signature.concrete = concrete in + let pcsig_self = self#core_type pcsig_self in + let pcsig_fields = self#list self#class_type_field pcsig_fields in + self#record (Some ("class_signature", 0)) [("pcsig_self", pcsig_self); ("pcsig_fields", pcsig_fields)] + method class_type_field : Class_type_field.t -> 'res = + fun class_type_field -> + let concrete = Class_type_field.to_concrete class_type_field in + let { pctf_desc; pctf_loc; pctf_attributes } : Class_type_field.concrete = concrete in + 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 (Some ("class_type_field", 0)) [("pctf_desc", pctf_desc); ("pctf_loc", pctf_loc); ("pctf_attributes", pctf_attributes)] + method class_type_field_desc : Class_type_field_desc.t -> 'res = + fun class_type_field_desc -> + let concrete = Class_type_field_desc.to_concrete class_type_field_desc in + match (concrete : Class_type_field_desc.concrete) with + | Pctf_inherit x0 -> + let x0 = self#class_type x0 in + self#constr (Some ("class_type_field_desc", 0)) "Pctf_inherit" [x0] + | Pctf_val x0 -> + let x0 = (fun (x0, x1, x2, x3) -> let x0 = self#loc self#string x0 in let x1 = self#mutable_flag x1 in let x2 = self#virtual_flag x2 in let x3 = self#core_type x3 in self#node None (self#tuple [x0; x1; x2; x3])) x0 in + self#constr (Some ("class_type_field_desc", 0)) "Pctf_val" [x0] + | Pctf_method x0 -> + let x0 = (fun (x0, x1, x2, x3) -> let x0 = self#loc self#string x0 in let x1 = self#private_flag x1 in let x2 = self#virtual_flag x2 in let x3 = self#core_type x3 in self#node None (self#tuple [x0; x1; x2; x3])) x0 in + self#constr (Some ("class_type_field_desc", 0)) "Pctf_method" [x0] + | Pctf_constraint x0 -> + let x0 = (fun (x0, x1) -> let x0 = self#core_type x0 in let x1 = self#core_type x1 in self#node None (self#tuple [x0; x1])) x0 in + self#constr (Some ("class_type_field_desc", 0)) "Pctf_constraint" [x0] + | Pctf_attribute x0 -> + let x0 = self#attribute x0 in + self#constr (Some ("class_type_field_desc", 0)) "Pctf_attribute" [x0] + | Pctf_extension x0 -> + let x0 = self#extension x0 in + self#constr (Some ("class_type_field_desc", 0)) "Pctf_extension" [x0] + method class_infos : 'a . ('a node -> 'res) -> 'a node Class_infos.t -> 'res = + fun fa class_infos -> + let concrete = Class_infos.to_concrete class_infos in + let { pci_virt; pci_params; pci_name; pci_expr; pci_loc; pci_attributes } : _ Class_infos.concrete = concrete in + let pci_virt = self#virtual_flag pci_virt in + let pci_params = self#list (fun (x0, x1) -> let x0 = self#core_type x0 in let x1 = self#variance x1 in self#node None (self#tuple [x0; x1])) pci_params in + let pci_name = self#loc self#string pci_name in + let pci_expr = fa pci_expr in + let pci_loc = self#location pci_loc in + let pci_attributes = self#attributes pci_attributes in + self#record (Some ("class_infos", 1)) [("pci_virt", pci_virt); ("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.t -> 'res = + fun class_description -> + let concrete = Class_description.to_concrete class_description in + let concrete = self#class_infos self#class_type concrete in + self#node (Some ("class_description", 0)) concrete + method class_type_declaration : Class_type_declaration.t -> 'res = + fun class_type_declaration -> + let concrete = Class_type_declaration.to_concrete class_type_declaration in + let concrete = self#class_infos self#class_type concrete in + self#node (Some ("class_type_declaration", 0)) concrete + method class_expr : Class_expr.t -> 'res = + fun class_expr -> + let concrete = Class_expr.to_concrete class_expr in + let { pcl_desc; pcl_loc; pcl_attributes } : Class_expr.concrete = concrete in + 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 (Some ("class_expr", 0)) [("pcl_desc", pcl_desc); ("pcl_loc", pcl_loc); ("pcl_attributes", pcl_attributes)] + method class_expr_desc : Class_expr_desc.t -> 'res = + fun class_expr_desc -> + let concrete = Class_expr_desc.to_concrete class_expr_desc in + match (concrete : Class_expr_desc.concrete) with + | Pcl_constr (x0, x1) -> + let x0 = self#longident_loc x0 in + let x1 = self#list self#core_type x1 in + self#constr (Some ("class_expr_desc", 0)) "Pcl_constr" [x0; x1] + | Pcl_structure x0 -> + let x0 = self#class_structure x0 in + self#constr (Some ("class_expr_desc", 0)) "Pcl_structure" [x0] + | Pcl_fun (x0, x1, x2, x3) -> + let x0 = self#arg_label x0 in + let x1 = self#option self#expression x1 in + let x2 = self#pattern x2 in + let x3 = self#class_expr x3 in + self#constr (Some ("class_expr_desc", 0)) "Pcl_fun" [x0; x1; x2; x3] + | Pcl_apply (x0, x1) -> + let x0 = self#class_expr x0 in + let x1 = self#list (fun (x0, x1) -> let x0 = self#arg_label x0 in let x1 = self#expression x1 in self#node None (self#tuple [x0; x1])) x1 in + self#constr (Some ("class_expr_desc", 0)) "Pcl_apply" [x0; x1] + | Pcl_let (x0, x1, x2) -> + let x0 = self#rec_flag x0 in + let x1 = self#list self#value_binding x1 in + let x2 = self#class_expr x2 in + self#constr (Some ("class_expr_desc", 0)) "Pcl_let" [x0; x1; x2] + | Pcl_constraint (x0, x1) -> + let x0 = self#class_expr x0 in + let x1 = self#class_type x1 in + self#constr (Some ("class_expr_desc", 0)) "Pcl_constraint" [x0; x1] + | Pcl_extension x0 -> + let x0 = self#extension x0 in + self#constr (Some ("class_expr_desc", 0)) "Pcl_extension" [x0] + | Pcl_open (x0, x1, x2) -> + let x0 = self#override_flag x0 in + let x1 = self#longident_loc x1 in + let x2 = self#class_expr x2 in + self#constr (Some ("class_expr_desc", 0)) "Pcl_open" [x0; x1; x2] + method class_structure : Class_structure.t -> 'res = + fun class_structure -> + let concrete = Class_structure.to_concrete class_structure in + let { pcstr_self; pcstr_fields } : Class_structure.concrete = concrete in + let pcstr_self = self#pattern pcstr_self in + let pcstr_fields = self#list self#class_field pcstr_fields in + self#record (Some ("class_structure", 0)) [("pcstr_self", pcstr_self); ("pcstr_fields", pcstr_fields)] + method class_field : Class_field.t -> 'res = + fun class_field -> + let concrete = Class_field.to_concrete class_field in + let { pcf_desc; pcf_loc; pcf_attributes } : Class_field.concrete = concrete in + 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 (Some ("class_field", 0)) [("pcf_desc", pcf_desc); ("pcf_loc", pcf_loc); ("pcf_attributes", pcf_attributes)] + method class_field_desc : Class_field_desc.t -> 'res = + fun class_field_desc -> + let concrete = Class_field_desc.to_concrete class_field_desc in + match (concrete : Class_field_desc.concrete) with + | Pcf_inherit (x0, x1, x2) -> + let x0 = self#override_flag x0 in + let x1 = self#class_expr x1 in + let x2 = self#option (self#loc self#string) x2 in + self#constr (Some ("class_field_desc", 0)) "Pcf_inherit" [x0; x1; x2] + | Pcf_val x0 -> + let x0 = (fun (x0, x1, x2) -> let x0 = self#loc self#string x0 in let x1 = self#mutable_flag x1 in let x2 = self#class_field_kind x2 in self#node None (self#tuple [x0; x1; x2])) x0 in + self#constr (Some ("class_field_desc", 0)) "Pcf_val" [x0] + | Pcf_method x0 -> + let x0 = (fun (x0, x1, x2) -> let x0 = self#loc self#string x0 in let x1 = self#private_flag x1 in let x2 = self#class_field_kind x2 in self#node None (self#tuple [x0; x1; x2])) x0 in + self#constr (Some ("class_field_desc", 0)) "Pcf_method" [x0] + | Pcf_constraint x0 -> + let x0 = (fun (x0, x1) -> let x0 = self#core_type x0 in let x1 = self#core_type x1 in self#node None (self#tuple [x0; x1])) x0 in + self#constr (Some ("class_field_desc", 0)) "Pcf_constraint" [x0] + | Pcf_initializer x0 -> + let x0 = self#expression x0 in + self#constr (Some ("class_field_desc", 0)) "Pcf_initializer" [x0] + | Pcf_attribute x0 -> + let x0 = self#attribute x0 in + self#constr (Some ("class_field_desc", 0)) "Pcf_attribute" [x0] + | Pcf_extension x0 -> + let x0 = self#extension x0 in + self#constr (Some ("class_field_desc", 0)) "Pcf_extension" [x0] + method class_field_kind : Class_field_kind.t -> 'res = + fun class_field_kind -> + let concrete = Class_field_kind.to_concrete class_field_kind in + match (concrete : Class_field_kind.concrete) with + | Cfk_virtual x0 -> + let x0 = self#core_type x0 in + self#constr (Some ("class_field_kind", 0)) "Cfk_virtual" [x0] + | Cfk_concrete (x0, x1) -> + let x0 = self#override_flag x0 in + let x1 = self#expression x1 in + self#constr (Some ("class_field_kind", 0)) "Cfk_concrete" [x0; x1] + method class_declaration : Class_declaration.t -> 'res = + fun class_declaration -> + let concrete = Class_declaration.to_concrete class_declaration in + let concrete = self#class_infos self#class_expr concrete in + self#node (Some ("class_declaration", 0)) concrete + method module_type : Module_type.t -> 'res = + fun module_type -> + let concrete = Module_type.to_concrete module_type in + let { pmty_desc; pmty_loc; pmty_attributes } : Module_type.concrete = concrete in + 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 (Some ("module_type", 0)) [("pmty_desc", pmty_desc); ("pmty_loc", pmty_loc); ("pmty_attributes", pmty_attributes)] + method module_type_desc : Module_type_desc.t -> 'res = + fun module_type_desc -> + let concrete = Module_type_desc.to_concrete module_type_desc in + match (concrete : Module_type_desc.concrete) with + | Pmty_ident x0 -> + let x0 = self#longident_loc x0 in + self#constr (Some ("module_type_desc", 0)) "Pmty_ident" [x0] + | Pmty_signature x0 -> + let x0 = self#signature x0 in + self#constr (Some ("module_type_desc", 0)) "Pmty_signature" [x0] + | Pmty_functor (x0, x1, x2) -> + let x0 = self#loc self#string x0 in + let x1 = self#option self#module_type x1 in + let x2 = self#module_type x2 in + self#constr (Some ("module_type_desc", 0)) "Pmty_functor" [x0; x1; x2] + | Pmty_with (x0, x1) -> + let x0 = self#module_type x0 in + let x1 = self#list self#with_constraint x1 in + self#constr (Some ("module_type_desc", 0)) "Pmty_with" [x0; x1] + | Pmty_typeof x0 -> + let x0 = self#module_expr x0 in + self#constr (Some ("module_type_desc", 0)) "Pmty_typeof" [x0] + | Pmty_extension x0 -> + let x0 = self#extension x0 in + self#constr (Some ("module_type_desc", 0)) "Pmty_extension" [x0] + | Pmty_alias x0 -> + let x0 = self#longident_loc x0 in + self#constr (Some ("module_type_desc", 0)) "Pmty_alias" [x0] + method signature : Signature.t -> 'res = + fun signature -> + let concrete = Signature.to_concrete signature in + let concrete = self#list self#signature_item concrete in + self#node (Some ("signature", 0)) concrete + method signature_item : Signature_item.t -> 'res = + fun signature_item -> + let concrete = Signature_item.to_concrete signature_item in + let { psig_desc; psig_loc } : Signature_item.concrete = concrete in + let psig_desc = self#signature_item_desc psig_desc in + let psig_loc = self#location psig_loc in + self#record (Some ("signature_item", 0)) [("psig_desc", psig_desc); ("psig_loc", psig_loc)] + method signature_item_desc : Signature_item_desc.t -> 'res = + fun signature_item_desc -> + let concrete = Signature_item_desc.to_concrete signature_item_desc in + match (concrete : Signature_item_desc.concrete) with + | Psig_value x0 -> + let x0 = self#value_description x0 in + self#constr (Some ("signature_item_desc", 0)) "Psig_value" [x0] + | Psig_type (x0, x1) -> + let x0 = self#rec_flag x0 in + let x1 = self#list self#type_declaration x1 in + self#constr (Some ("signature_item_desc", 0)) "Psig_type" [x0; x1] + | Psig_typext x0 -> + let x0 = self#type_extension x0 in + self#constr (Some ("signature_item_desc", 0)) "Psig_typext" [x0] + | Psig_exception x0 -> + let x0 = self#extension_constructor x0 in + self#constr (Some ("signature_item_desc", 0)) "Psig_exception" [x0] + | Psig_module x0 -> + let x0 = self#module_declaration x0 in + self#constr (Some ("signature_item_desc", 0)) "Psig_module" [x0] + | Psig_recmodule x0 -> + let x0 = self#list self#module_declaration x0 in + self#constr (Some ("signature_item_desc", 0)) "Psig_recmodule" [x0] + | Psig_modtype x0 -> + let x0 = self#module_type_declaration x0 in + self#constr (Some ("signature_item_desc", 0)) "Psig_modtype" [x0] + | Psig_open x0 -> + let x0 = self#open_description x0 in + self#constr (Some ("signature_item_desc", 0)) "Psig_open" [x0] + | Psig_include x0 -> + let x0 = self#include_description x0 in + self#constr (Some ("signature_item_desc", 0)) "Psig_include" [x0] + | Psig_class x0 -> + let x0 = self#list self#class_description x0 in + self#constr (Some ("signature_item_desc", 0)) "Psig_class" [x0] + | Psig_class_type x0 -> + let x0 = self#list self#class_type_declaration x0 in + self#constr (Some ("signature_item_desc", 0)) "Psig_class_type" [x0] + | Psig_attribute x0 -> + let x0 = self#attribute x0 in + self#constr (Some ("signature_item_desc", 0)) "Psig_attribute" [x0] + | Psig_extension (x0, x1) -> + let x0 = self#extension x0 in + let x1 = self#attributes x1 in + self#constr (Some ("signature_item_desc", 0)) "Psig_extension" [x0; x1] + method module_declaration : Module_declaration.t -> 'res = + fun module_declaration -> + let concrete = Module_declaration.to_concrete module_declaration in + let { pmd_name; pmd_type; pmd_attributes; pmd_loc } : Module_declaration.concrete = concrete in + 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 (Some ("module_declaration", 0)) [("pmd_name", pmd_name); ("pmd_type", pmd_type); ("pmd_attributes", pmd_attributes); ("pmd_loc", pmd_loc)] + method module_type_declaration : Module_type_declaration.t -> 'res = + fun module_type_declaration -> + let concrete = Module_type_declaration.to_concrete module_type_declaration in + let { pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc } : Module_type_declaration.concrete = concrete in + 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 (Some ("module_type_declaration", 0)) [("pmtd_name", pmtd_name); ("pmtd_type", pmtd_type); ("pmtd_attributes", pmtd_attributes); ("pmtd_loc", pmtd_loc)] + method open_description : Open_description.t -> 'res = + fun open_description -> + let concrete = Open_description.to_concrete open_description in + let { popen_lid; popen_override; popen_loc; popen_attributes } : Open_description.concrete = concrete in + 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 (Some ("open_description", 0)) [("popen_lid", popen_lid); ("popen_override", popen_override); ("popen_loc", popen_loc); ("popen_attributes", popen_attributes)] + method include_infos : 'a . ('a node -> 'res) -> 'a node Include_infos.t -> 'res = + fun fa include_infos -> + let concrete = Include_infos.to_concrete include_infos in + let { pincl_mod; pincl_loc; pincl_attributes } : _ Include_infos.concrete = concrete in + let pincl_mod = fa pincl_mod in + let pincl_loc = self#location pincl_loc in + let pincl_attributes = self#attributes pincl_attributes in + self#record (Some ("include_infos", 1)) [("pincl_mod", pincl_mod); ("pincl_loc", pincl_loc); ("pincl_attributes", pincl_attributes)] + method include_description : Include_description.t -> 'res = + fun include_description -> + let concrete = Include_description.to_concrete include_description in + let concrete = self#include_infos self#module_type concrete in + self#node (Some ("include_description", 0)) concrete + method include_declaration : Include_declaration.t -> 'res = + fun include_declaration -> + let concrete = Include_declaration.to_concrete include_declaration in + let concrete = self#include_infos self#module_expr concrete in + self#node (Some ("include_declaration", 0)) concrete + method with_constraint : With_constraint.t -> 'res = + fun with_constraint -> + let concrete = With_constraint.to_concrete with_constraint in + match (concrete : With_constraint.concrete) with + | Pwith_type (x0, x1) -> + let x0 = self#longident_loc x0 in + let x1 = self#type_declaration x1 in + self#constr (Some ("with_constraint", 0)) "Pwith_type" [x0; x1] + | Pwith_module (x0, x1) -> + let x0 = self#longident_loc x0 in + let x1 = self#longident_loc x1 in + self#constr (Some ("with_constraint", 0)) "Pwith_module" [x0; x1] + | Pwith_typesubst (x0, x1) -> + let x0 = self#longident_loc x0 in + let x1 = self#type_declaration x1 in + self#constr (Some ("with_constraint", 0)) "Pwith_typesubst" [x0; x1] + | Pwith_modsubst (x0, x1) -> + let x0 = self#longident_loc x0 in + let x1 = self#longident_loc x1 in + self#constr (Some ("with_constraint", 0)) "Pwith_modsubst" [x0; x1] + method module_expr : Module_expr.t -> 'res = + fun module_expr -> + let concrete = Module_expr.to_concrete module_expr in + let { pmod_desc; pmod_loc; pmod_attributes } : Module_expr.concrete = concrete in + 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 (Some ("module_expr", 0)) [("pmod_desc", pmod_desc); ("pmod_loc", pmod_loc); ("pmod_attributes", pmod_attributes)] + method module_expr_desc : Module_expr_desc.t -> 'res = + fun module_expr_desc -> + let concrete = Module_expr_desc.to_concrete module_expr_desc in + match (concrete : Module_expr_desc.concrete) with + | Pmod_ident x0 -> + let x0 = self#longident_loc x0 in + self#constr (Some ("module_expr_desc", 0)) "Pmod_ident" [x0] + | Pmod_structure x0 -> + let x0 = self#structure x0 in + self#constr (Some ("module_expr_desc", 0)) "Pmod_structure" [x0] + | Pmod_functor (x0, x1, x2) -> + let x0 = self#loc self#string x0 in + let x1 = self#option self#module_type x1 in + let x2 = self#module_expr x2 in + self#constr (Some ("module_expr_desc", 0)) "Pmod_functor" [x0; x1; x2] + | Pmod_apply (x0, x1) -> + let x0 = self#module_expr x0 in + let x1 = self#module_expr x1 in + self#constr (Some ("module_expr_desc", 0)) "Pmod_apply" [x0; x1] + | Pmod_constraint (x0, x1) -> + let x0 = self#module_expr x0 in + let x1 = self#module_type x1 in + self#constr (Some ("module_expr_desc", 0)) "Pmod_constraint" [x0; x1] + | Pmod_unpack x0 -> + let x0 = self#expression x0 in + self#constr (Some ("module_expr_desc", 0)) "Pmod_unpack" [x0] + | Pmod_extension x0 -> + let x0 = self#extension x0 in + self#constr (Some ("module_expr_desc", 0)) "Pmod_extension" [x0] + method structure : Structure.t -> 'res = + fun structure -> + let concrete = Structure.to_concrete structure in + let concrete = self#list self#structure_item concrete in + self#node (Some ("structure", 0)) concrete + method structure_item : Structure_item.t -> 'res = + fun structure_item -> + let concrete = Structure_item.to_concrete structure_item in + let { pstr_desc; pstr_loc } : Structure_item.concrete = concrete in + let pstr_desc = self#structure_item_desc pstr_desc in + let pstr_loc = self#location pstr_loc in + self#record (Some ("structure_item", 0)) [("pstr_desc", pstr_desc); ("pstr_loc", pstr_loc)] + method structure_item_desc : Structure_item_desc.t -> 'res = + fun structure_item_desc -> + let concrete = Structure_item_desc.to_concrete structure_item_desc in + match (concrete : Structure_item_desc.concrete) with + | Pstr_eval (x0, x1) -> + let x0 = self#expression x0 in + let x1 = self#attributes x1 in + self#constr (Some ("structure_item_desc", 0)) "Pstr_eval" [x0; x1] + | Pstr_value (x0, x1) -> + let x0 = self#rec_flag x0 in + let x1 = self#list self#value_binding x1 in + self#constr (Some ("structure_item_desc", 0)) "Pstr_value" [x0; x1] + | Pstr_primitive x0 -> + let x0 = self#value_description x0 in + self#constr (Some ("structure_item_desc", 0)) "Pstr_primitive" [x0] + | Pstr_type (x0, x1) -> + let x0 = self#rec_flag x0 in + let x1 = self#list self#type_declaration x1 in + self#constr (Some ("structure_item_desc", 0)) "Pstr_type" [x0; x1] + | Pstr_typext x0 -> + let x0 = self#type_extension x0 in + self#constr (Some ("structure_item_desc", 0)) "Pstr_typext" [x0] + | Pstr_exception x0 -> + let x0 = self#extension_constructor x0 in + self#constr (Some ("structure_item_desc", 0)) "Pstr_exception" [x0] + | Pstr_module x0 -> + let x0 = self#module_binding x0 in + self#constr (Some ("structure_item_desc", 0)) "Pstr_module" [x0] + | Pstr_recmodule x0 -> + let x0 = self#list self#module_binding x0 in + self#constr (Some ("structure_item_desc", 0)) "Pstr_recmodule" [x0] + | Pstr_modtype x0 -> + let x0 = self#module_type_declaration x0 in + self#constr (Some ("structure_item_desc", 0)) "Pstr_modtype" [x0] + | Pstr_open x0 -> + let x0 = self#open_description x0 in + self#constr (Some ("structure_item_desc", 0)) "Pstr_open" [x0] + | Pstr_class x0 -> + let x0 = self#list self#class_declaration x0 in + self#constr (Some ("structure_item_desc", 0)) "Pstr_class" [x0] + | Pstr_class_type x0 -> + let x0 = self#list self#class_type_declaration x0 in + self#constr (Some ("structure_item_desc", 0)) "Pstr_class_type" [x0] + | Pstr_include x0 -> + let x0 = self#include_declaration x0 in + self#constr (Some ("structure_item_desc", 0)) "Pstr_include" [x0] + | Pstr_attribute x0 -> + let x0 = self#attribute x0 in + self#constr (Some ("structure_item_desc", 0)) "Pstr_attribute" [x0] + | Pstr_extension (x0, x1) -> + let x0 = self#extension x0 in + let x1 = self#attributes x1 in + self#constr (Some ("structure_item_desc", 0)) "Pstr_extension" [x0; x1] + method value_binding : Value_binding.t -> 'res = + fun value_binding -> + let concrete = Value_binding.to_concrete value_binding in + let { pvb_pat; pvb_expr; pvb_attributes; pvb_loc } : Value_binding.concrete = concrete in + 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 (Some ("value_binding", 0)) [("pvb_pat", pvb_pat); ("pvb_expr", pvb_expr); ("pvb_attributes", pvb_attributes); ("pvb_loc", pvb_loc)] + method module_binding : Module_binding.t -> 'res = + fun module_binding -> + let concrete = Module_binding.to_concrete module_binding in + let { pmb_name; pmb_expr; pmb_attributes; pmb_loc } : Module_binding.concrete = concrete in + 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 (Some ("module_binding", 0)) [("pmb_name", pmb_name); ("pmb_expr", pmb_expr); ("pmb_attributes", pmb_attributes); ("pmb_loc", pmb_loc)] + method toplevel_phrase : Toplevel_phrase.t -> 'res = + fun toplevel_phrase -> + let concrete = Toplevel_phrase.to_concrete toplevel_phrase in + match (concrete : Toplevel_phrase.concrete) with + | Ptop_def x0 -> + let x0 = self#structure x0 in + self#constr (Some ("toplevel_phrase", 0)) "Ptop_def" [x0] + | Ptop_dir (x0, x1) -> + let x0 = self#string x0 in + let x1 = self#directive_argument x1 in + self#constr (Some ("toplevel_phrase", 0)) "Ptop_dir" [x0; x1] + method directive_argument : Directive_argument.t -> 'res = + fun directive_argument -> + let concrete = Directive_argument.to_concrete directive_argument in + match (concrete : Directive_argument.concrete) with + | Pdir_none -> + self#constr (Some ("directive_argument", 0)) "Pdir_none" [] + | Pdir_string x0 -> + let x0 = self#string x0 in + self#constr (Some ("directive_argument", 0)) "Pdir_string" [x0] + | Pdir_int (x0, x1) -> + let x0 = self#string x0 in + let x1 = self#option self#char x1 in + self#constr (Some ("directive_argument", 0)) "Pdir_int" [x0; x1] + | Pdir_ident x0 -> + let x0 = self#longident x0 in + self#constr (Some ("directive_argument", 0)) "Pdir_ident" [x0] + | Pdir_bool x0 -> + let x0 = self#bool x0 in + self#constr (Some ("directive_argument", 0)) "Pdir_bool" [x0] + end +(*$*) diff --git a/ast/virtual_traverse_v4_08.mli b/ast/virtual_traverse_v4_08.mli new file mode 100644 index 00000000..90375b6d --- /dev/null +++ b/ast/virtual_traverse_v4_08.mli @@ -0,0 +1,506 @@ +open Unversioned.Types +(*$ Ppx_ast_cinaps.print_virtual_traverse_mli (Astlib.Version.of_string "v4_07") *) +open Versions.V4_07 + +class virtual map : + object + method virtual bool : bool -> bool + method virtual char : char -> char + method virtual int : int -> int + method virtual list : 'a . ('a -> 'a) -> 'a list -> 'a list + method virtual option : 'a . ('a -> 'a) -> 'a option -> 'a option + method virtual string : string -> string + method virtual location : Astlib.Location.t -> Astlib.Location.t + method virtual loc : 'a . ('a -> 'a) -> 'a Astlib.Loc.t -> 'a Astlib.Loc.t + method longident : Longident.t -> Longident.t + method longident_loc : Longident_loc.t -> Longident_loc.t + method rec_flag : Rec_flag.t -> Rec_flag.t + method direction_flag : Direction_flag.t -> Direction_flag.t + method private_flag : Private_flag.t -> Private_flag.t + method mutable_flag : Mutable_flag.t -> Mutable_flag.t + method virtual_flag : Virtual_flag.t -> Virtual_flag.t + method override_flag : Override_flag.t -> Override_flag.t + method closed_flag : Closed_flag.t -> Closed_flag.t + method arg_label : Arg_label.t -> Arg_label.t + method variance : Variance.t -> Variance.t + method constant : Constant.t -> Constant.t + method attribute : Attribute.t -> Attribute.t + method extension : Extension.t -> Extension.t + method attributes : Attributes.t -> Attributes.t + method payload : Payload.t -> Payload.t + method core_type : Core_type.t -> Core_type.t + method core_type_desc : Core_type_desc.t -> Core_type_desc.t + method package_type : Package_type.t -> Package_type.t + method row_field : Row_field.t -> Row_field.t + method object_field : Object_field.t -> Object_field.t + method pattern : Pattern.t -> Pattern.t + method pattern_desc : Pattern_desc.t -> Pattern_desc.t + method expression : Expression.t -> Expression.t + method expression_desc : Expression_desc.t -> Expression_desc.t + method case : Case.t -> Case.t + method value_description : Value_description.t -> Value_description.t + method type_declaration : Type_declaration.t -> Type_declaration.t + method type_kind : Type_kind.t -> Type_kind.t + method label_declaration : Label_declaration.t -> Label_declaration.t + method constructor_declaration : Constructor_declaration.t -> Constructor_declaration.t + method constructor_arguments : Constructor_arguments.t -> Constructor_arguments.t + method type_extension : Type_extension.t -> Type_extension.t + method extension_constructor : Extension_constructor.t -> Extension_constructor.t + method extension_constructor_kind : Extension_constructor_kind.t -> Extension_constructor_kind.t + method class_type : Class_type.t -> Class_type.t + method class_type_desc : Class_type_desc.t -> Class_type_desc.t + method class_signature : Class_signature.t -> Class_signature.t + method class_type_field : Class_type_field.t -> Class_type_field.t + method class_type_field_desc : Class_type_field_desc.t -> Class_type_field_desc.t + method class_infos : 'a . ('a node -> 'a node) -> 'a node Class_infos.t -> 'a node Class_infos.t + method class_description : Class_description.t -> Class_description.t + method class_type_declaration : Class_type_declaration.t -> Class_type_declaration.t + method class_expr : Class_expr.t -> Class_expr.t + method class_expr_desc : Class_expr_desc.t -> Class_expr_desc.t + method class_structure : Class_structure.t -> Class_structure.t + method class_field : Class_field.t -> Class_field.t + method class_field_desc : Class_field_desc.t -> Class_field_desc.t + method class_field_kind : Class_field_kind.t -> Class_field_kind.t + method class_declaration : Class_declaration.t -> Class_declaration.t + method module_type : Module_type.t -> Module_type.t + method module_type_desc : Module_type_desc.t -> Module_type_desc.t + method signature : Signature.t -> Signature.t + method signature_item : Signature_item.t -> Signature_item.t + method signature_item_desc : Signature_item_desc.t -> Signature_item_desc.t + method module_declaration : Module_declaration.t -> Module_declaration.t + method module_type_declaration : Module_type_declaration.t -> Module_type_declaration.t + method open_description : Open_description.t -> Open_description.t + method include_infos : 'a . ('a node -> 'a node) -> 'a node Include_infos.t -> 'a node Include_infos.t + method include_description : Include_description.t -> Include_description.t + method include_declaration : Include_declaration.t -> Include_declaration.t + method with_constraint : With_constraint.t -> With_constraint.t + method module_expr : Module_expr.t -> Module_expr.t + method module_expr_desc : Module_expr_desc.t -> Module_expr_desc.t + method structure : Structure.t -> Structure.t + method structure_item : Structure_item.t -> Structure_item.t + method structure_item_desc : Structure_item_desc.t -> Structure_item_desc.t + method value_binding : Value_binding.t -> Value_binding.t + method module_binding : Module_binding.t -> Module_binding.t + method toplevel_phrase : Toplevel_phrase.t -> Toplevel_phrase.t + method directive_argument : Directive_argument.t -> Directive_argument.t + end + +class virtual iter : + object + method virtual bool : bool -> unit + method virtual char : char -> unit + method virtual int : int -> unit + method virtual list : 'a . ('a -> unit) -> 'a list -> unit + method virtual option : 'a . ('a -> unit) -> 'a option -> unit + method virtual string : string -> unit + method virtual location : Astlib.Location.t -> unit + method virtual loc : 'a . ('a -> unit) -> 'a Astlib.Loc.t -> unit + method longident : Longident.t -> unit + method longident_loc : Longident_loc.t -> unit + method rec_flag : Rec_flag.t -> unit + method direction_flag : Direction_flag.t -> unit + method private_flag : Private_flag.t -> unit + method mutable_flag : Mutable_flag.t -> unit + method virtual_flag : Virtual_flag.t -> unit + method override_flag : Override_flag.t -> unit + method closed_flag : Closed_flag.t -> unit + method arg_label : Arg_label.t -> unit + method variance : Variance.t -> unit + method constant : Constant.t -> unit + method attribute : Attribute.t -> unit + method extension : Extension.t -> unit + method attributes : Attributes.t -> unit + method payload : Payload.t -> unit + method core_type : Core_type.t -> unit + method core_type_desc : Core_type_desc.t -> unit + method package_type : Package_type.t -> unit + method row_field : Row_field.t -> unit + method object_field : Object_field.t -> unit + method pattern : Pattern.t -> unit + method pattern_desc : Pattern_desc.t -> unit + method expression : Expression.t -> unit + method expression_desc : Expression_desc.t -> unit + method case : Case.t -> unit + method value_description : Value_description.t -> unit + method type_declaration : Type_declaration.t -> unit + method type_kind : Type_kind.t -> unit + method label_declaration : Label_declaration.t -> unit + method constructor_declaration : Constructor_declaration.t -> unit + method constructor_arguments : Constructor_arguments.t -> unit + method type_extension : Type_extension.t -> unit + method extension_constructor : Extension_constructor.t -> unit + method extension_constructor_kind : Extension_constructor_kind.t -> unit + method class_type : Class_type.t -> unit + method class_type_desc : Class_type_desc.t -> unit + method class_signature : Class_signature.t -> unit + method class_type_field : Class_type_field.t -> unit + method class_type_field_desc : Class_type_field_desc.t -> unit + method class_infos : 'a . ('a node -> unit) -> 'a node Class_infos.t -> unit + method class_description : Class_description.t -> unit + method class_type_declaration : Class_type_declaration.t -> unit + method class_expr : Class_expr.t -> unit + method class_expr_desc : Class_expr_desc.t -> unit + method class_structure : Class_structure.t -> unit + method class_field : Class_field.t -> unit + method class_field_desc : Class_field_desc.t -> unit + method class_field_kind : Class_field_kind.t -> unit + method class_declaration : Class_declaration.t -> unit + method module_type : Module_type.t -> unit + method module_type_desc : Module_type_desc.t -> unit + method signature : Signature.t -> unit + method signature_item : Signature_item.t -> unit + method signature_item_desc : Signature_item_desc.t -> unit + method module_declaration : Module_declaration.t -> unit + method module_type_declaration : Module_type_declaration.t -> unit + method open_description : Open_description.t -> unit + method include_infos : 'a . ('a node -> unit) -> 'a node Include_infos.t -> unit + method include_description : Include_description.t -> unit + method include_declaration : Include_declaration.t -> unit + method with_constraint : With_constraint.t -> unit + method module_expr : Module_expr.t -> unit + method module_expr_desc : Module_expr_desc.t -> unit + method structure : Structure.t -> unit + method structure_item : Structure_item.t -> unit + method structure_item_desc : Structure_item_desc.t -> unit + method value_binding : Value_binding.t -> unit + method module_binding : Module_binding.t -> unit + method toplevel_phrase : Toplevel_phrase.t -> unit + method directive_argument : Directive_argument.t -> unit + end + +class virtual ['acc] fold : + object + method virtual bool : bool -> 'acc -> 'acc + method virtual char : char -> 'acc -> 'acc + method virtual int : int -> 'acc -> 'acc + method virtual list : 'a . ('a -> 'acc -> 'acc) -> 'a list -> 'acc -> 'acc + method virtual option : 'a . ('a -> 'acc -> 'acc) -> 'a option -> 'acc -> 'acc + method virtual string : string -> 'acc -> 'acc + method virtual location : Astlib.Location.t -> 'acc -> 'acc + method virtual loc : 'a . ('a -> 'acc -> 'acc) -> 'a Astlib.Loc.t -> 'acc -> 'acc + method longident : Longident.t -> 'acc -> 'acc + method longident_loc : Longident_loc.t -> 'acc -> 'acc + method rec_flag : Rec_flag.t -> 'acc -> 'acc + method direction_flag : Direction_flag.t -> 'acc -> 'acc + method private_flag : Private_flag.t -> 'acc -> 'acc + method mutable_flag : Mutable_flag.t -> 'acc -> 'acc + method virtual_flag : Virtual_flag.t -> 'acc -> 'acc + method override_flag : Override_flag.t -> 'acc -> 'acc + method closed_flag : Closed_flag.t -> 'acc -> 'acc + method arg_label : Arg_label.t -> 'acc -> 'acc + method variance : Variance.t -> 'acc -> 'acc + method constant : Constant.t -> 'acc -> 'acc + method attribute : Attribute.t -> 'acc -> 'acc + method extension : Extension.t -> 'acc -> 'acc + method attributes : Attributes.t -> 'acc -> 'acc + method payload : Payload.t -> 'acc -> 'acc + method core_type : Core_type.t -> 'acc -> 'acc + method core_type_desc : Core_type_desc.t -> 'acc -> 'acc + method package_type : Package_type.t -> 'acc -> 'acc + method row_field : Row_field.t -> 'acc -> 'acc + method object_field : Object_field.t -> 'acc -> 'acc + method pattern : Pattern.t -> 'acc -> 'acc + method pattern_desc : Pattern_desc.t -> 'acc -> 'acc + method expression : Expression.t -> 'acc -> 'acc + method expression_desc : Expression_desc.t -> 'acc -> 'acc + method case : Case.t -> 'acc -> 'acc + method value_description : Value_description.t -> 'acc -> 'acc + method type_declaration : Type_declaration.t -> 'acc -> 'acc + method type_kind : Type_kind.t -> 'acc -> 'acc + method label_declaration : Label_declaration.t -> 'acc -> 'acc + method constructor_declaration : Constructor_declaration.t -> 'acc -> 'acc + method constructor_arguments : Constructor_arguments.t -> 'acc -> 'acc + method type_extension : Type_extension.t -> 'acc -> 'acc + method extension_constructor : Extension_constructor.t -> 'acc -> 'acc + method extension_constructor_kind : Extension_constructor_kind.t -> 'acc -> 'acc + method class_type : Class_type.t -> 'acc -> 'acc + method class_type_desc : Class_type_desc.t -> 'acc -> 'acc + method class_signature : Class_signature.t -> 'acc -> 'acc + method class_type_field : Class_type_field.t -> 'acc -> 'acc + method class_type_field_desc : Class_type_field_desc.t -> 'acc -> 'acc + method class_infos : 'a . ('a node -> 'acc -> 'acc) -> 'a node Class_infos.t -> 'acc -> 'acc + method class_description : Class_description.t -> 'acc -> 'acc + method class_type_declaration : Class_type_declaration.t -> 'acc -> 'acc + method class_expr : Class_expr.t -> 'acc -> 'acc + method class_expr_desc : Class_expr_desc.t -> 'acc -> 'acc + method class_structure : Class_structure.t -> 'acc -> 'acc + method class_field : Class_field.t -> 'acc -> 'acc + method class_field_desc : Class_field_desc.t -> 'acc -> 'acc + method class_field_kind : Class_field_kind.t -> 'acc -> 'acc + method class_declaration : Class_declaration.t -> 'acc -> 'acc + method module_type : Module_type.t -> 'acc -> 'acc + method module_type_desc : Module_type_desc.t -> 'acc -> 'acc + method signature : Signature.t -> 'acc -> 'acc + method signature_item : Signature_item.t -> 'acc -> 'acc + method signature_item_desc : Signature_item_desc.t -> 'acc -> 'acc + method module_declaration : Module_declaration.t -> 'acc -> 'acc + method module_type_declaration : Module_type_declaration.t -> 'acc -> 'acc + method open_description : Open_description.t -> 'acc -> 'acc + method include_infos : 'a . ('a node -> 'acc -> 'acc) -> 'a node Include_infos.t -> 'acc -> 'acc + method include_description : Include_description.t -> 'acc -> 'acc + method include_declaration : Include_declaration.t -> 'acc -> 'acc + method with_constraint : With_constraint.t -> 'acc -> 'acc + method module_expr : Module_expr.t -> 'acc -> 'acc + method module_expr_desc : Module_expr_desc.t -> 'acc -> 'acc + method structure : Structure.t -> 'acc -> 'acc + method structure_item : Structure_item.t -> 'acc -> 'acc + method structure_item_desc : Structure_item_desc.t -> 'acc -> 'acc + method value_binding : Value_binding.t -> 'acc -> 'acc + method module_binding : Module_binding.t -> 'acc -> 'acc + method toplevel_phrase : Toplevel_phrase.t -> 'acc -> 'acc + method directive_argument : Directive_argument.t -> 'acc -> 'acc + end + +class virtual ['acc] fold_map : + object + method virtual bool : bool -> 'acc -> (bool * 'acc) + method virtual char : char -> 'acc -> (char * 'acc) + method virtual int : int -> 'acc -> (int * 'acc) + method virtual list : '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) + method virtual string : string -> 'acc -> (string * 'acc) + method virtual location : Astlib.Location.t -> 'acc -> (Astlib.Location.t * 'acc) + method virtual loc : 'a . ('a -> 'acc -> ('a * 'acc)) -> 'a Astlib.Loc.t -> 'acc -> ('a Astlib.Loc.t * 'acc) + method longident : Longident.t -> 'acc -> (Longident.t * 'acc) + method longident_loc : Longident_loc.t -> 'acc -> (Longident_loc.t * 'acc) + method rec_flag : Rec_flag.t -> 'acc -> (Rec_flag.t * 'acc) + method direction_flag : Direction_flag.t -> 'acc -> (Direction_flag.t * 'acc) + method private_flag : Private_flag.t -> 'acc -> (Private_flag.t * 'acc) + method mutable_flag : Mutable_flag.t -> 'acc -> (Mutable_flag.t * 'acc) + method virtual_flag : Virtual_flag.t -> 'acc -> (Virtual_flag.t * 'acc) + method override_flag : Override_flag.t -> 'acc -> (Override_flag.t * 'acc) + method closed_flag : Closed_flag.t -> 'acc -> (Closed_flag.t * 'acc) + method arg_label : Arg_label.t -> 'acc -> (Arg_label.t * 'acc) + method variance : Variance.t -> 'acc -> (Variance.t * 'acc) + method constant : Constant.t -> 'acc -> (Constant.t * 'acc) + method attribute : Attribute.t -> 'acc -> (Attribute.t * 'acc) + method extension : Extension.t -> 'acc -> (Extension.t * 'acc) + method attributes : Attributes.t -> 'acc -> (Attributes.t * 'acc) + method payload : Payload.t -> 'acc -> (Payload.t * 'acc) + method core_type : Core_type.t -> 'acc -> (Core_type.t * 'acc) + method core_type_desc : Core_type_desc.t -> 'acc -> (Core_type_desc.t * 'acc) + method package_type : Package_type.t -> 'acc -> (Package_type.t * 'acc) + method row_field : Row_field.t -> 'acc -> (Row_field.t * 'acc) + method object_field : Object_field.t -> 'acc -> (Object_field.t * 'acc) + method pattern : Pattern.t -> 'acc -> (Pattern.t * 'acc) + method pattern_desc : Pattern_desc.t -> 'acc -> (Pattern_desc.t * 'acc) + method expression : Expression.t -> 'acc -> (Expression.t * 'acc) + method expression_desc : Expression_desc.t -> 'acc -> (Expression_desc.t * 'acc) + method case : Case.t -> 'acc -> (Case.t * 'acc) + method value_description : Value_description.t -> 'acc -> (Value_description.t * 'acc) + method type_declaration : Type_declaration.t -> 'acc -> (Type_declaration.t * 'acc) + method type_kind : Type_kind.t -> 'acc -> (Type_kind.t * 'acc) + method label_declaration : Label_declaration.t -> 'acc -> (Label_declaration.t * 'acc) + method constructor_declaration : Constructor_declaration.t -> 'acc -> (Constructor_declaration.t * 'acc) + method constructor_arguments : Constructor_arguments.t -> 'acc -> (Constructor_arguments.t * 'acc) + method type_extension : Type_extension.t -> 'acc -> (Type_extension.t * 'acc) + method extension_constructor : Extension_constructor.t -> 'acc -> (Extension_constructor.t * 'acc) + method extension_constructor_kind : Extension_constructor_kind.t -> 'acc -> (Extension_constructor_kind.t * 'acc) + method class_type : Class_type.t -> 'acc -> (Class_type.t * 'acc) + method class_type_desc : Class_type_desc.t -> 'acc -> (Class_type_desc.t * 'acc) + method class_signature : Class_signature.t -> 'acc -> (Class_signature.t * 'acc) + method class_type_field : Class_type_field.t -> 'acc -> (Class_type_field.t * 'acc) + method class_type_field_desc : Class_type_field_desc.t -> 'acc -> (Class_type_field_desc.t * 'acc) + method class_infos : 'a . ('a node -> 'acc -> ('a node * 'acc)) -> 'a node Class_infos.t -> 'acc -> ('a node Class_infos.t * 'acc) + method class_description : Class_description.t -> 'acc -> (Class_description.t * 'acc) + method class_type_declaration : Class_type_declaration.t -> 'acc -> (Class_type_declaration.t * 'acc) + method class_expr : Class_expr.t -> 'acc -> (Class_expr.t * 'acc) + method class_expr_desc : Class_expr_desc.t -> 'acc -> (Class_expr_desc.t * 'acc) + method class_structure : Class_structure.t -> 'acc -> (Class_structure.t * 'acc) + method class_field : Class_field.t -> 'acc -> (Class_field.t * 'acc) + method class_field_desc : Class_field_desc.t -> 'acc -> (Class_field_desc.t * 'acc) + method class_field_kind : Class_field_kind.t -> 'acc -> (Class_field_kind.t * 'acc) + method class_declaration : Class_declaration.t -> 'acc -> (Class_declaration.t * 'acc) + method module_type : Module_type.t -> 'acc -> (Module_type.t * 'acc) + method module_type_desc : Module_type_desc.t -> 'acc -> (Module_type_desc.t * 'acc) + method signature : Signature.t -> 'acc -> (Signature.t * 'acc) + method signature_item : Signature_item.t -> 'acc -> (Signature_item.t * 'acc) + method signature_item_desc : Signature_item_desc.t -> 'acc -> (Signature_item_desc.t * 'acc) + method module_declaration : Module_declaration.t -> 'acc -> (Module_declaration.t * 'acc) + method module_type_declaration : Module_type_declaration.t -> 'acc -> (Module_type_declaration.t * 'acc) + method open_description : Open_description.t -> 'acc -> (Open_description.t * 'acc) + method include_infos : 'a . ('a node -> 'acc -> ('a node * 'acc)) -> 'a node Include_infos.t -> 'acc -> ('a node Include_infos.t * 'acc) + method include_description : Include_description.t -> 'acc -> (Include_description.t * 'acc) + method include_declaration : Include_declaration.t -> 'acc -> (Include_declaration.t * 'acc) + method with_constraint : With_constraint.t -> 'acc -> (With_constraint.t * 'acc) + method module_expr : Module_expr.t -> 'acc -> (Module_expr.t * 'acc) + method module_expr_desc : Module_expr_desc.t -> 'acc -> (Module_expr_desc.t * 'acc) + method structure : Structure.t -> 'acc -> (Structure.t * 'acc) + method structure_item : Structure_item.t -> 'acc -> (Structure_item.t * 'acc) + method structure_item_desc : Structure_item_desc.t -> 'acc -> (Structure_item_desc.t * 'acc) + method value_binding : Value_binding.t -> 'acc -> (Value_binding.t * 'acc) + method module_binding : Module_binding.t -> 'acc -> (Module_binding.t * 'acc) + method toplevel_phrase : Toplevel_phrase.t -> 'acc -> (Toplevel_phrase.t * 'acc) + method directive_argument : Directive_argument.t -> 'acc -> (Directive_argument.t * 'acc) + end + +class virtual ['ctx] map_with_context : + object + method virtual bool : 'ctx -> bool -> bool + method virtual char : 'ctx -> char -> char + method virtual int : 'ctx -> int -> int + method virtual list : 'a . ('ctx -> 'a -> 'a) -> 'ctx -> 'a list -> 'a list + method virtual option : 'a . ('ctx -> 'a -> 'a) -> 'ctx -> 'a option -> 'a option + method virtual string : 'ctx -> string -> string + method virtual location : 'ctx -> Astlib.Location.t -> Astlib.Location.t + method virtual loc : 'a . ('ctx -> 'a -> 'a) -> 'ctx -> 'a Astlib.Loc.t -> 'a Astlib.Loc.t + method longident : 'ctx -> Longident.t -> Longident.t + method longident_loc : 'ctx -> Longident_loc.t -> Longident_loc.t + method rec_flag : 'ctx -> Rec_flag.t -> Rec_flag.t + method direction_flag : 'ctx -> Direction_flag.t -> Direction_flag.t + method private_flag : 'ctx -> Private_flag.t -> Private_flag.t + method mutable_flag : 'ctx -> Mutable_flag.t -> Mutable_flag.t + method virtual_flag : 'ctx -> Virtual_flag.t -> Virtual_flag.t + method override_flag : 'ctx -> Override_flag.t -> Override_flag.t + method closed_flag : 'ctx -> Closed_flag.t -> Closed_flag.t + method arg_label : 'ctx -> Arg_label.t -> Arg_label.t + method variance : 'ctx -> Variance.t -> Variance.t + method constant : 'ctx -> Constant.t -> Constant.t + method attribute : 'ctx -> Attribute.t -> Attribute.t + method extension : 'ctx -> Extension.t -> Extension.t + method attributes : 'ctx -> Attributes.t -> Attributes.t + method payload : 'ctx -> Payload.t -> Payload.t + method core_type : 'ctx -> Core_type.t -> Core_type.t + method core_type_desc : 'ctx -> Core_type_desc.t -> Core_type_desc.t + method package_type : 'ctx -> Package_type.t -> Package_type.t + method row_field : 'ctx -> Row_field.t -> Row_field.t + method object_field : 'ctx -> Object_field.t -> Object_field.t + method pattern : 'ctx -> Pattern.t -> Pattern.t + method pattern_desc : 'ctx -> Pattern_desc.t -> Pattern_desc.t + method expression : 'ctx -> Expression.t -> Expression.t + method expression_desc : 'ctx -> Expression_desc.t -> Expression_desc.t + method case : 'ctx -> Case.t -> Case.t + method value_description : 'ctx -> Value_description.t -> Value_description.t + method type_declaration : 'ctx -> Type_declaration.t -> Type_declaration.t + method type_kind : 'ctx -> Type_kind.t -> Type_kind.t + method label_declaration : 'ctx -> Label_declaration.t -> Label_declaration.t + method constructor_declaration : 'ctx -> Constructor_declaration.t -> Constructor_declaration.t + method constructor_arguments : 'ctx -> Constructor_arguments.t -> Constructor_arguments.t + method type_extension : 'ctx -> Type_extension.t -> Type_extension.t + method extension_constructor : 'ctx -> Extension_constructor.t -> Extension_constructor.t + method extension_constructor_kind : 'ctx -> Extension_constructor_kind.t -> Extension_constructor_kind.t + method class_type : 'ctx -> Class_type.t -> Class_type.t + method class_type_desc : 'ctx -> Class_type_desc.t -> Class_type_desc.t + method class_signature : 'ctx -> Class_signature.t -> Class_signature.t + method class_type_field : 'ctx -> Class_type_field.t -> Class_type_field.t + method class_type_field_desc : 'ctx -> Class_type_field_desc.t -> Class_type_field_desc.t + method class_infos : 'a . ('ctx -> 'a node -> 'a node) -> 'ctx -> 'a node Class_infos.t -> 'a node Class_infos.t + method class_description : 'ctx -> Class_description.t -> Class_description.t + method class_type_declaration : 'ctx -> Class_type_declaration.t -> Class_type_declaration.t + method class_expr : 'ctx -> Class_expr.t -> Class_expr.t + method class_expr_desc : 'ctx -> Class_expr_desc.t -> Class_expr_desc.t + method class_structure : 'ctx -> Class_structure.t -> Class_structure.t + method class_field : 'ctx -> Class_field.t -> Class_field.t + method class_field_desc : 'ctx -> Class_field_desc.t -> Class_field_desc.t + method class_field_kind : 'ctx -> Class_field_kind.t -> Class_field_kind.t + method class_declaration : 'ctx -> Class_declaration.t -> Class_declaration.t + method module_type : 'ctx -> Module_type.t -> Module_type.t + method module_type_desc : 'ctx -> Module_type_desc.t -> Module_type_desc.t + method signature : 'ctx -> Signature.t -> Signature.t + method signature_item : 'ctx -> Signature_item.t -> Signature_item.t + method signature_item_desc : 'ctx -> Signature_item_desc.t -> Signature_item_desc.t + method module_declaration : 'ctx -> Module_declaration.t -> Module_declaration.t + method module_type_declaration : 'ctx -> Module_type_declaration.t -> Module_type_declaration.t + method open_description : 'ctx -> Open_description.t -> Open_description.t + method include_infos : 'a . ('ctx -> 'a node -> 'a node) -> 'ctx -> 'a node Include_infos.t -> 'a node Include_infos.t + method include_description : 'ctx -> Include_description.t -> Include_description.t + method include_declaration : 'ctx -> Include_declaration.t -> Include_declaration.t + method with_constraint : 'ctx -> With_constraint.t -> With_constraint.t + method module_expr : 'ctx -> Module_expr.t -> Module_expr.t + method module_expr_desc : 'ctx -> Module_expr_desc.t -> Module_expr_desc.t + method structure : 'ctx -> Structure.t -> Structure.t + method structure_item : 'ctx -> Structure_item.t -> Structure_item.t + method structure_item_desc : 'ctx -> Structure_item_desc.t -> Structure_item_desc.t + method value_binding : 'ctx -> Value_binding.t -> Value_binding.t + method module_binding : 'ctx -> Module_binding.t -> Module_binding.t + method toplevel_phrase : 'ctx -> Toplevel_phrase.t -> Toplevel_phrase.t + method directive_argument : 'ctx -> Directive_argument.t -> Directive_argument.t + end + +class virtual ['res] lift : + object + method virtual node : (string * int) option -> 'res -> 'res + method virtual record : (string * int) option -> (string * 'res) list -> 'res + method virtual constr : (string * int) option -> string -> 'res list -> 'res + method virtual tuple : 'res list -> 'res + method virtual bool : bool -> 'res + method virtual char : char -> 'res + method virtual int : int -> 'res + method virtual list : 'a . ('a -> 'res) -> 'a list -> 'res + method virtual option : 'a . ('a -> 'res) -> 'a option -> 'res + method virtual string : string -> 'res + method virtual location : Astlib.Location.t -> 'res + method virtual loc : 'a . ('a -> 'res) -> 'a Astlib.Loc.t -> 'res + method longident : Longident.t -> 'res + method longident_loc : Longident_loc.t -> 'res + method rec_flag : Rec_flag.t -> 'res + method direction_flag : Direction_flag.t -> 'res + method private_flag : Private_flag.t -> 'res + method mutable_flag : Mutable_flag.t -> 'res + method virtual_flag : Virtual_flag.t -> 'res + method override_flag : Override_flag.t -> 'res + method closed_flag : Closed_flag.t -> 'res + method arg_label : Arg_label.t -> 'res + method variance : Variance.t -> 'res + method constant : Constant.t -> 'res + method attribute : Attribute.t -> 'res + method extension : Extension.t -> 'res + method attributes : Attributes.t -> 'res + method payload : Payload.t -> 'res + method core_type : Core_type.t -> 'res + method core_type_desc : Core_type_desc.t -> 'res + method package_type : Package_type.t -> 'res + method row_field : Row_field.t -> 'res + method object_field : Object_field.t -> 'res + method pattern : Pattern.t -> 'res + method pattern_desc : Pattern_desc.t -> 'res + method expression : Expression.t -> 'res + method expression_desc : Expression_desc.t -> 'res + method case : Case.t -> 'res + method value_description : Value_description.t -> 'res + method type_declaration : Type_declaration.t -> 'res + method type_kind : Type_kind.t -> 'res + method label_declaration : Label_declaration.t -> 'res + method constructor_declaration : Constructor_declaration.t -> 'res + method constructor_arguments : Constructor_arguments.t -> 'res + method type_extension : Type_extension.t -> 'res + method extension_constructor : Extension_constructor.t -> 'res + method extension_constructor_kind : Extension_constructor_kind.t -> 'res + method class_type : Class_type.t -> 'res + method class_type_desc : Class_type_desc.t -> 'res + method class_signature : Class_signature.t -> 'res + method class_type_field : Class_type_field.t -> 'res + method class_type_field_desc : Class_type_field_desc.t -> 'res + method class_infos : 'a . ('a node -> 'res) -> 'a node Class_infos.t -> 'res + method class_description : Class_description.t -> 'res + method class_type_declaration : Class_type_declaration.t -> 'res + method class_expr : Class_expr.t -> 'res + method class_expr_desc : Class_expr_desc.t -> 'res + method class_structure : Class_structure.t -> 'res + method class_field : Class_field.t -> 'res + method class_field_desc : Class_field_desc.t -> 'res + method class_field_kind : Class_field_kind.t -> 'res + method class_declaration : Class_declaration.t -> 'res + method module_type : Module_type.t -> 'res + method module_type_desc : Module_type_desc.t -> 'res + method signature : Signature.t -> 'res + method signature_item : Signature_item.t -> 'res + method signature_item_desc : Signature_item_desc.t -> 'res + method module_declaration : Module_declaration.t -> 'res + method module_type_declaration : Module_type_declaration.t -> 'res + method open_description : Open_description.t -> 'res + method include_infos : 'a . ('a node -> 'res) -> 'a node Include_infos.t -> 'res + method include_description : Include_description.t -> 'res + method include_declaration : Include_declaration.t -> 'res + method with_constraint : With_constraint.t -> 'res + method module_expr : Module_expr.t -> 'res + method module_expr_desc : Module_expr_desc.t -> 'res + method structure : Structure.t -> 'res + method structure_item : Structure_item.t -> 'res + method structure_item_desc : Structure_item_desc.t -> 'res + method value_binding : Value_binding.t -> 'res + method module_binding : Module_binding.t -> 'res + method toplevel_phrase : Toplevel_phrase.t -> 'res + method directive_argument : Directive_argument.t -> 'res + end +(*$*) diff --git a/astlib.opam b/astlib.opam index 1746fa93..a884824c 100644 --- a/astlib.opam +++ b/astlib.opam @@ -10,7 +10,7 @@ authors: ["Jane Street Group, LLC"] homepage: "https://github.com/ocaml-ppx/ppx" bug-reports: "https://github.com/ocaml-ppx/ppx/issues" depends: [ - "ocaml" {>= "4.07" & < "4.08"} + "ocaml" {>= "4.08" & < "4.09"} "base" {>= "v0.11.0"} "dune" {>= "1.8.0"} "ocaml-compiler-libs" {>= "v0.11.0"} diff --git a/astlib/latest_version.ml b/astlib/latest_version.ml index 40749a0f..b0f1069f 100644 --- a/astlib/latest_version.ml +++ b/astlib/latest_version.ml @@ -1,4 +1,4 @@ -let version = Version.of_string "v4_07" +let version = Version.of_string "v4_08" let conversions : History.conversion list = [] @@ -46,7 +46,11 @@ let grammar : Grammar.t = ; ("Pconst_string", Tuple [String; Option String]) ; ("Pconst_float", Tuple [String; Option Char]) ]) ) ; ( "attribute" - , Mono (Ty (Tuple [Loc String; Name "payload"])) ) + , Mono + (Record + [ ("attr_name", Loc String) + ; ("attr_payload", Name "payload") + ; ("attr_loc", Location) ])) ; ( "extension" , Mono (Ty (Tuple [Loc String; Name "payload"])) ) ; ("attributes", Mono (Ty (List (Name "attribute")))) @@ -63,6 +67,7 @@ let grammar : Grammar.t = (Record [ ("ptyp_desc", Name "core_type_desc") ; ("ptyp_loc", Location) + ; ("ptyp_loc_stack", List Location) ; ("ptyp_attributes", Name "attributes") ]) ) ; ( "core_type_desc" , Mono @@ -96,28 +101,40 @@ let grammar : Grammar.t = ; List (Tuple [Name "longident_loc"; Name "core_type"]) ])) ) ; ( "row_field" + , Mono + (Record + [ ("prf_desc", Name "row_field_desc") + ; ("prf_loc", Location) + ; ("prf_attributes", Name "attributes") ])) + ; ( "row_field_desc" , Mono (Variant - [ ( "Rtag" - , Tuple - [ Loc String - ; Name "attributes" - ; Bool - ; List (Name "core_type") ] ) - ; ("Rinherit", Tuple [Name "core_type"]) ]) ) + [ ( "Rtag" + , Tuple + [ Loc String + ; Bool + ; List (Name "core_type") ] ) + ; ("Rinherit", Tuple [Name "core_type"]) ]) ) ; ( "object_field" + , Mono + (Record + [ ("pof_desc", Name "object_field_desc") + ; ("pof_loc", Location) + ; ("pof_attributes", Name "attributes") ]) ) + ; ( "object_field_desc" , Mono (Variant - [ ( "Otag" - , Tuple - [Loc String; Name "attributes"; Name "core_type"] + [ ( "Otag" + , Tuple + [Loc String; Name "core_type"] ) - ; ("Oinherit", Tuple [Name "core_type"]) ]) ) + ; ("Oinherit", Tuple [Name "core_type"]) ]) ) ; ( "pattern" , Mono (Record [ ("ppat_desc", Name "pattern_desc") ; ("ppat_loc", Location) + ; ("ppat_loc_stack", List Location) ; ("ppat_attributes", Name "attributes") ]) ) ; ( "pattern_desc" , Mono @@ -150,6 +167,7 @@ let grammar : Grammar.t = (Record [ ("pexp_desc", Name "expression_desc") ; ("pexp_loc", Location) + ; ("pexp_loc_stack", List Location) ; ("pexp_attributes", Name "attributes") ]) ) ; ( "expression_desc" , Mono @@ -229,9 +247,9 @@ let grammar : Grammar.t = ; ("Pexp_pack", Tuple [Name "module_expr"]) ; ( "Pexp_open" , Tuple - [ Name "override_flag" - ; Name "longident_loc" + [ Name "open_declaration" ; Name "expression" ] ) + ; ("Pexp_letop", Tuple [Name "letop"]) ; ("Pexp_extension", Tuple [Name "extension"]) ; ("Pexp_unreachable", Empty) ]) ) ; ( "case" @@ -240,6 +258,19 @@ let grammar : Grammar.t = [ ("pc_lhs", Name "pattern") ; ("pc_guard", Option (Name "expression")) ; ("pc_rhs", Name "expression") ]) ) + ; ( "letop" + , Mono + (Record + [ ("let_", Name "binding_op") + ; ("ands", List (Name "binding_op")) + ; ("body", Name "expression") ]) ) + ; ( "binding_op" + , Mono + (Record + [ ("pbop_op", Loc String) + ; ("pbop_pat", Name "pattern") + ; ("pbop_exp", Name "expression") + ; ("pbop_loc", Location) ]) ) ; ( "value_description" , Mono (Record @@ -299,6 +330,7 @@ let grammar : Grammar.t = , List (Tuple [Name "core_type"; Name "variance"]) ) ; ("ptyext_constructors", List (Name "extension_constructor")) ; ("ptyext_private", Name "private_flag") + ; ("ptyext_loc", Location) ; ("ptyext_attributes", Name "attributes") ]) ) ; ( "extension_constructor" , Mono @@ -307,6 +339,12 @@ let grammar : Grammar.t = ; ("pext_kind", Name "extension_constructor_kind") ; ("pext_loc", Location) ; ("pext_attributes", Name "attributes") ]) ) + ; ( "type_exception" + , Mono + (Record + [ ("ptyexn_constructor", Name "extension_constructor") + ; ("ptyexn_loc", Location) + ; ("ptyexn_attributes", Name "attributes") ]) ) ; ( "extension_constructor_kind" , Mono (Variant @@ -333,8 +371,7 @@ let grammar : Grammar.t = ; ("Pcty_extension", Tuple [Name "extension"]) ; ( "Pcty_open" , Tuple - [ Name "override_flag" - ; Name "longident_loc" + [ Name "open_description" ; Name "class_type" ] ) ]) ) ; ( "class_signature" , Mono @@ -415,8 +452,7 @@ let grammar : Grammar.t = ; ("Pcl_extension", Tuple [Name "extension"]) ; ( "Pcl_open" , Tuple - [ Name "override_flag" - ; Name "longident_loc" + [ Name "open_description" ; Name "class_expr" ] ) ]) ) ; ( "class_structure" , Mono @@ -495,9 +531,11 @@ let grammar : Grammar.t = [ ("Psig_value", Tuple [Name "value_description"]) ; ( "Psig_type" , Tuple [Name "rec_flag"; List (Name "type_declaration")] ) + ; ("Psig_typesubst", Tuple [List (Name "type_declaration")]) ; ("Psig_typext", Tuple [Name "type_extension"]) - ; ("Psig_exception", Tuple [Name "extension_constructor"]) + ; ("Psig_exception", Tuple [Name "type_exception"]) ; ("Psig_module", Tuple [Name "module_declaration"]) + ; ("Psig_modsubst", Tuple [Name "module_substitution"]) ; ("Psig_recmodule", Tuple [List (Name "module_declaration")]) ; ("Psig_modtype", Tuple [Name "module_type_declaration"]) ; ("Psig_open", Tuple [Name "open_description"]) @@ -515,6 +553,13 @@ let grammar : Grammar.t = ; ("pmd_type", Name "module_type") ; ("pmd_attributes", Name "attributes") ; ("pmd_loc", Location) ]) ) + ; ( "module_substitution" + , Mono + (Record + [ ("pms_name", Loc String) + ; ("pms_manifest", Name "longident_loc") + ; ("pms_attributes", Name "attributes") + ; ("pms_loc", Location) ]) ) ; ( "module_type_declaration" , Mono (Record @@ -522,13 +567,18 @@ let grammar : Grammar.t = ; ("pmtd_type", Option (Name "module_type")) ; ("pmtd_attributes", Name "attributes") ; ("pmtd_loc", Location) ]) ) + ; ( "open_infos" + , Poly + ( ["a"] + , Record + [ ("popen_expr", Var "a") + ; ("popen_override", Name "override_flag") + ; ("popen_loc", Location) + ; ("popen_attributes", Name "attributes") ] ) ) ; ( "open_description" - , Mono - (Record - [ ("popen_lid", Name "longident_loc") - ; ("popen_override", Name "override_flag") - ; ("popen_loc", Location) - ; ("popen_attributes", Name "attributes") ]) ) + , Mono (Ty (Instance ("open_infos", [Tname "longident_loc"]))) ) + ; ( "open_declaration" + , Mono (Ty (Instance ("open_infos", [Tname "module_expr"]))) ) ; ( "include_infos" , Poly ( ["a"] @@ -588,18 +638,18 @@ let grammar : Grammar.t = ; ( "Pstr_type" , Tuple [Name "rec_flag"; List (Name "type_declaration")] ) ; ("Pstr_typext", Tuple [Name "type_extension"]) - ; ("Pstr_exception", Tuple [Name "extension_constructor"]) + ; ("Pstr_exception", Tuple [Name "type_exception"]) ; ("Pstr_module", Tuple [Name "module_binding"]) ; ("Pstr_recmodule", Tuple [List (Name "module_binding")]) ; ("Pstr_modtype", Tuple [Name "module_type_declaration"]) - ; ("Pstr_open", Tuple [Name "open_description"]) + ; ("Pstr_open", Tuple [Name "open_declaration"]) ; ("Pstr_class", Tuple [List (Name "class_declaration")]) ; ( "Pstr_class_type" , Tuple [List (Name "class_type_declaration")] ) ; ("Pstr_include", Tuple [Name "include_declaration"]) ; ("Pstr_attribute", Tuple [Name "attribute"]) - ; ("Pstr_extension", Tuple [Name "extension"; Name "attributes"]) - ]) ) + ; ( "Pstr_extension" + , Tuple [Name "extension"; Name "attributes"] ) ]) ) ; ( "value_binding" , Mono (Record @@ -618,12 +668,22 @@ let grammar : Grammar.t = , Mono (Variant [ ("Ptop_def", Tuple [Name "structure"]) - ; ("Ptop_dir", Tuple [String; Name "directive_argument"]) ]) ) + ; ("Ptop_dir", Tuple [Name "toplevel_directive"]) ]) ) + ; ( "toplevel_directive" + , Mono + (Record + [ ("pdir_name", Loc String) + ; ("pdir_arg", Option (Name "directive_argument")) + ; ("pdir_loc", Location) ]) ) ; ( "directive_argument" + , Mono + (Record + [ ("pdira_desc", Name "directive_argument_desc") + ; ("pdira_loc", Location) ]) ) + ; ( "directive_argument_desc" , Mono (Variant - [ ("Pdir_none", Empty) - ; ("Pdir_string", Tuple [String]) + [ ("Pdir_string", Tuple [String]) ; ("Pdir_int", Tuple [String; Option Char]) ; ("Pdir_ident", Tuple [Name "longident"]) ; ("Pdir_bool", Tuple [Bool]) ]) ) ] diff --git a/astlib/location.ml b/astlib/location.ml index 8e069bbd..fb12fb54 100644 --- a/astlib/location.ml +++ b/astlib/location.ml @@ -13,9 +13,9 @@ module Error = struct let of_error (t : t) = t let to_error (t : t) = t - let make ~loc f = Ocaml_common.Location.error_of_printer loc (fun fmt () -> f fmt) () - let location (t : t) = t.loc - let report fmt t = Ocaml_common.Location.report_error fmt t + let make ~loc f = Ocaml_common.Location.error_of_printer ~loc (fun fmt () -> f fmt) () + let location (t : t) = t.main.loc + let report fmt t = Ocaml_common.Location.print_report fmt t let register_of_exn f = Ocaml_common.Location.register_error_of_exn f let of_exn exn = diff --git a/astlib/unstable_for_testing.ml b/astlib/unstable_for_testing.ml index fad5cd5a..5921495c 100644 --- a/astlib/unstable_for_testing.ml +++ b/astlib/unstable_for_testing.ml @@ -2,7 +2,7 @@ open StdLabels let version = Version.of_string "unstable_for_testing" -module Stable = Latest_version +module Stable = Version_4_07 let rec update_ty ty : Grammar.ty = match (ty : Grammar.ty) with diff --git a/astlib/version_4_07.ml b/astlib/version_4_07.ml index 3cc3dd30..206ee55d 100644 --- a/astlib/version_4_07.ml +++ b/astlib/version_4_07.ml @@ -1 +1,674 @@ -include Latest_version +let version = Version.of_string "v4_07" + +let concat_map ~f l = + List.concat (List.map f l) + +module Grammar = struct + let list_remove ~f l = + let rec aux acc = function + | [] -> List.rev acc + | hd::tl when f hd -> aux acc tl + | hd::tl -> aux (hd::acc) tl + in + aux [] l + + let remove_field ~name record = + let open Grammar in + match record with + | Mono (Record fields) -> + let new_fields = list_remove ~f:(fun (n, _) -> n = name) fields in + Mono (Record new_fields) + | _ -> assert false + + let update_variant ~f variant = + let open Grammar in + match variant with + | Mono (Variant ctors) -> + Mono (Variant (concat_map ~f ctors)) + | _ -> assert false + + let append_ctor ctor variant = + let open Grammar in + match variant with + | Mono (Variant ctors) -> + Mono (Variant (ctor::ctors)) + | _ -> assert false + + let attribute : Grammar.kind = + Mono (Ty (Tuple [Loc String; Name "payload"])) + + let row_field : Grammar.kind = + Mono + (Variant + [ ( "Rtag" + , Tuple + [ Loc String + ; Name "attributes" + ; Bool + ; List (Name "core_type") ] ) + ; ("Rinherit", Tuple [Name "core_type"]) ]) + + let object_field : Grammar.kind = + Mono + (Variant + [ ( "Otag" + , Tuple + [Loc String; Name "attributes"; Name "core_type"] + ) + ; ("Oinherit", Tuple [Name "core_type"]) ]) + + let pexp_open : Grammar.clause = + Tuple + [ Name "override_flag" + ; Name "longident_loc" + ; Name "expression" ] + + let pcty_open : Grammar.clause = + Tuple + [ Name "override_flag" + ; Name "longident_loc" + ; Name "class_type" ] + + let pcl_open : Grammar.clause = + Tuple + [ Name "override_flag" + ; Name "longident_loc" + ; Name "class_expr" ] + + let psig_exception : Grammar.clause = + Tuple [Name "extension_constructor"] + + let open_description : Grammar.kind = + Mono + (Record + [ ("popen_lid", Name "longident_loc") + ; ("popen_override", Name "override_flag") + ; ("popen_loc", Location) + ; ("popen_attributes", Name "attributes") ]) + + let pstr_exception : Grammar.clause = + Tuple [Name "extension_constructor"] + + let pstr_open : Grammar.clause = + Tuple [Name "open_description"] + + let ptop_dir : Grammar.clause = + Tuple [String; Name "directive_argument"] + + let update_type_decl type_decl = + let drop = [] in + match type_decl with + | ("attribute" as n, _) -> [(n, attribute)] + | ("core_type" as n, record) -> + [(n, remove_field ~name:"ptyp_loc_stack" record)] + | ("row_field" as n, _) -> [(n, row_field)] + | ("row_field_desc", _) -> drop + | ("object_field" as n, _) -> [(n, object_field)] + | ("object_field_desc", _) -> drop + | ("pattern" as n, record) -> + [(n, remove_field ~name:"ppat_loc_stack" record)] + | ("expression" as n, record) -> + [(n, remove_field ~name:"pexp_loc_stack" record)] + | ("expression_desc" as n, variant) -> + [ ( n + , update_variant variant ~f:(function + | ("Pexp_open" as n, _) -> [(n, pexp_open)] + | ("Pexp_letop", _) -> drop + | c -> [c]) + ) + ] + | ("letop", _) -> drop + | ("binding_op", _) -> drop + | ("type_extension" as n, record) -> + [(n, remove_field ~name:"ptyext_loc" record)] + | ("type_exception", _) -> drop + | ("class_type_desc" as n, variant) -> + [ ( n + , update_variant variant ~f:(function + | ("Pcty_open" as n, _) -> [(n, pcty_open)] + | c -> [c]) + ) + ] + | ("class_expr_desc" as n, variant) -> + [ ( n + , update_variant variant ~f:(function + | ("Pcl_open" as n, _) -> [(n, pcl_open)] + | c -> [c])) + ] + | ("signature_item_desc" as n, variant) -> + [ ( n + , update_variant variant ~f:(function + | ("Psig_typesubst", _) -> drop + | ("Psig_exception" as n, _) -> [(n, psig_exception)] + | ("Psig_modsubst", _) -> drop + | c -> [c]) + ) + ] + | ("module_substitution", _) -> drop + | ("open_infos", _) -> drop + | ("open_description" as n, _) -> [(n, open_description)] + | ("open_declaration", _) -> drop + | ("structure_item_desc" as n, variant) -> + [ ( n + , update_variant variant ~f:(function + | ("Pstr_exception" as n, _) -> [(n, pstr_exception)] + | ("Pstr_open" as n, _) -> [(n, pstr_open)] + | c -> [c]) + ) + ] + | ("toplevel_phrase" as n, variant) -> + [ ( n + , update_variant variant ~f:(function + | ("Ptop_dir" as n, _) -> [(n, ptop_dir)] + | c -> [c]) + ) + ] + | ("toplevel_directive", _) -> drop + | ("directive_argument", _) -> drop + | ("directive_argument_desc", variant) -> + [("directive_argument", append_ctor ("Pdir_none", Empty) variant)] + | _ -> [type_decl] +end + +module Node = struct + open Ast + + let ghost loc = Location.{ loc with loc_ghost = true } + + let empty_attr ~wrap = + let data = List [] in + Node (wrap {name = "attributes"; data}) + + module Down = struct + let downgrade_attribute node = + match node.data with + | Record [| name; payload; _loc |] -> + Some { node with data = Tuple [| name; payload |] } + | _ -> None + + let drop_loc_stack node = + match node.data with + | Record [| desc; loc; _loc_stack; attributes |] -> + Some { node with data = Record [| desc; loc; attributes |] } + | _ -> None + + let downgrade_row_field ~unwrap node = + match node.data with + | Record [| Node prf_desc; _prf_loc; prf_attributes |] -> + ( match unwrap prf_desc with + | Some + { name = "row_field_desc" + ; data = + Variant + { tag = "Rtag" as tag + ; args = [| label; empty; args |] } } -> + let data = + Variant { tag; args = [| label; prf_attributes; empty; args |] } + in + Some { node with data } + | Some + { name = "row_field_desc" + ; data = Variant { tag = "Rinherit"; _} as variant } -> + Some { node with data = variant } + | _ -> None ) + | _ -> None + + let downgrade_object_field ~unwrap node = + match node.data with + | Record [| Node pof_desc; _pof_loc; pof_attributes |] -> + ( match unwrap pof_desc with + | Some + { name = "object_field_desc" + ; data = + Variant { tag = "Otag" as tag; args = [| label; args |] } } -> + let data = + Variant { tag; args = [| label; pof_attributes; args |] } + in + Some { node with data } + | Some + { name = "object_field_desc" + ; data = Variant {tag = "Oinherit"; _} as variant } -> + Some { node with data = variant } + | _ -> None ) + | _ -> None + + let deconstruct_odecl ~unwrap open_decl = + match unwrap open_decl with + | Some { name = "open_declaration" ; data = Node open_infos } -> + ( match unwrap open_infos with + | Some + { name = "open_infos" + ; data = Record [| Node mod_expr; override; loc; attr |] } -> + ( match unwrap mod_expr with + | Some + { name = "module_expr" + ; data = Record [| Node desc; _loc; _attr |] } -> + ( match unwrap desc with + | Some + { name = "module_expr_desc" + ; data = + Variant + { tag = "Pmod_ident"; args = [| lident |] } } -> + Some (lident, override, loc, attr) + | _ -> None ) + | _ -> None ) + | _ -> None ) + | _ -> None + + let downgrade_expression_desc ~unwrap node = + match node.data with + | Variant { tag = "Pexp_open" as tag; args = [| Node open_decl; expr |] } -> + ( match deconstruct_odecl ~unwrap open_decl with + | Some (lident, override, _loc, _attr) -> + let data = Variant {tag; args = [|override; lident; expr|]} in + Some { node with data } + | None -> None ) + | Variant { tag = "Pexp_open"; _ } + | Variant { tag = "Pexp_letop"; _ } -> None + | _ -> Some node + + let downgrade_type_extenstion node = + match node.data with + | Record [| path; params; ctors; private_; _loc; attr |] -> + let data = Record [| path; params; ctors; private_; attr |] in + Some { node with data } + | _ -> None + + let lident_and_override_from_odesc ~unwrap open_desc = + match unwrap open_desc with + | Some { name = "open_description" ; data = Node open_infos } -> + ( match unwrap open_infos with + | Some + { name = "open_infos" + ; data = Record [| lident; override; _loc; _attr |] } -> + Some (lident, override) + | _ -> None ) + | _ -> None + + let downgrade_class_type_desc ~unwrap node = + match node.data with + | Variant { tag = "Pcty_open" as tag; args = [| Node open_desc; cty |] } -> + ( match lident_and_override_from_odesc ~unwrap open_desc with + | Some (lident, override) -> + let data = Variant { tag; args = [| override; lident; cty |] } in + Some { node with data } + | None -> None ) + | Variant { tag = "Pcty_open"; _ } -> None + | _ -> Some node + + let downgrade_class_expr_desc ~unwrap node = + match node.data with + | Variant { tag = "Pcl_open" as tag; args = [| Node open_desc; cl |] } -> + ( match lident_and_override_from_odesc ~unwrap open_desc with + | Some (lident, override) -> + let data = Variant { tag; args = [| override; lident; cl |] } in + Some { node with data } + | None -> None ) + | Variant { tag = "Pcl_open"; _ } -> None + | _ -> Some node + + let ext_ctor_from_type_exc ~unwrap type_exc = + match unwrap type_exc with + | Some + { name = "type_exception" + ; data = Record [| ext_ctor; _loc; _attr |] } -> + Some ext_ctor + | _ -> None + + let downgrade_signature_item_desc ~unwrap node = + match node.data with + | Variant { tag = "Psig_exception" as tag; args = [| Node type_exc |] } -> + ( match ext_ctor_from_type_exc ~unwrap type_exc with + | Some ext_ctor -> + Some { node with data = Variant { tag; args = [| ext_ctor |] } } + | None -> None ) + | Variant { tag = "Psig_exception"; _ } + | Variant { tag = ("Psig_typesubst" | "Psig_modsubst"); _ } -> None + | _ -> Some node + + let downgrade_structure_item_desc ~wrap ~unwrap node = + match node.data with + | Variant { tag = "Pstr_exception" as tag; args = [| Node type_exc |] } -> + ( match ext_ctor_from_type_exc ~unwrap type_exc with + | Some ext_ctor -> + Some { node with data = Variant { tag; args = [| ext_ctor |] } } + | None -> None ) + | Variant { tag = "Pstr_open" as tag; args = [| Node open_decl |] } -> + ( match deconstruct_odecl ~unwrap open_decl with + | Some (lident, override, loc, attr) -> + let open_desc = + let data = Record [| lident; override; loc; attr |] in + wrap {name = "open_description"; data} + in + let data = Variant { tag; args = [| Node open_desc |] } in + Some { node with data } + | None -> None ) + | Variant { tag = ("Pstr_exception" | "Pstr_open"); _} -> None + | _ -> Some node + + let downgrade_open_description ~unwrap node = + match node.data with + | Node open_infos -> + ( match unwrap open_infos with + | Some { name = "open_infos"; data } -> Some { node with data } + | _ -> None ) + | _ -> None + + let dir_arg ~wrap ~unwrap pdir_arg = + let wrap data = + Node (wrap { name = "directive_argument"; data }) + in + match pdir_arg with + | Option None -> + Some (wrap (Variant { tag = "Pdir_none"; args = [||] })) + | Option (Some (Node dir_arg)) -> + ( match unwrap dir_arg with + | Some + { name = "directive_argument" + ; data = Record [| Node desc; _loc |] } -> + ( match unwrap desc with + | Some { name = "directive_argument_desc"; data } -> + Some (wrap data) + | _ -> None ) + | _ -> None ) + | _ -> None + + let downgrade_toplevel_phrase ~wrap ~unwrap node = + match node.data with + | Variant { tag = "Ptop_dir" as tag; args = [| Node tdir |] } -> + ( match unwrap tdir with + | Some + { name = "toplevel_directive" + ; data = Record [| Loc name; pdir_arg; _loc |] } -> + ( match dir_arg ~wrap ~unwrap pdir_arg with + | Some dir_arg -> + let data = Variant { tag; args = [| name.txt; dir_arg |] } in + Some { node with data } + | _ -> None ) + | _ -> None ) + | Variant { tag = "Ptop_dir"; _} -> None + | _ -> Some node + + let downgrade : _ History.conversion_function = + fun node ~unwrap ~wrap -> + match node.name with + | "attribute" -> downgrade_attribute node + | "core_type" + | "pattern" + | "expression" -> drop_loc_stack node + | "row_field" -> downgrade_row_field ~unwrap node + | "object_field" -> downgrade_object_field ~unwrap node + | "expression_desc" -> downgrade_expression_desc ~unwrap node + | "type_extension" -> downgrade_type_extenstion node + | "class_type_desc" -> downgrade_class_type_desc ~unwrap node + | "class_expr_desc" -> downgrade_class_expr_desc ~unwrap node + | "signature_item_desc" -> + downgrade_signature_item_desc ~unwrap node + | "open_description" -> downgrade_open_description ~unwrap node + | "structure_item_desc" -> + downgrade_structure_item_desc ~wrap ~unwrap node + | "toplevel_phrase" -> downgrade_toplevel_phrase ~wrap ~unwrap node + | _ -> Some node + end + + module Up = struct + let upgrade_attribute node = + match node.data with + | Tuple [| (Loc {loc; _}) as name ; payload |] -> + let loc = ghost loc in + Some { node with data = Record [| name; payload; Location loc |] } + | _ -> None + + let add_loc_stack node = + match node.data with + | Record [| desc; loc; attributes |] -> + Some { node with data = Record [| desc; loc; List []; attributes |] } + | _ -> None + + let upgrade_row_field ~wrap ~unwrap node = + let desc data = + Node (wrap {name = "row_field_desc"; data}) + in + match node.data with + | Variant + { tag = "Rtag" as tag + ; args = [|Loc x as label; attributes; empty; args|] } -> + let variant = Variant {tag; args = [|label; empty; args|]} in + let loc = ghost x.loc in + let data = Record [| desc variant; Location loc; attributes |] in + Some { node with data } + | Variant {tag = "Rinherit"; args = [| Node core_type |]} as variant -> + ( match unwrap core_type with + | Some + { name = "core_type" + ; data = Record [| _desc; Location loc; _attr |] } -> + let loc = ghost loc in + let data = + Record [| desc variant; Location loc; empty_attr ~wrap |] + in + Some { node with data } + | _ -> None ) + | _ -> None + + let upgrade_object_field ~wrap ~unwrap node = + let desc data = + Node (wrap {name = "object_field_desc"; data}) + in + match node.data with + | Variant + { tag = "Otag" as tag; args = [| Loc x as label; attr; args |] } -> + let variant = Variant {tag; args = [| label; args |]} in + let loc = ghost x.loc in + let data = Record [| desc variant; Location loc; attr |] in + Some { node with data } + | Variant { tag = "Oinherit"; args = [| Node core_type |] } as variant -> + ( match unwrap core_type with + | Some + { name = "core_type" + ; data = Record [| _desc; Location loc; _attr |] } -> + let attributes = + Node (wrap {name = "attributes"; data = List []}) + in + let loc = ghost loc in + let data = Record [| desc variant; Location loc; attributes |] in + Some { node with data } + | _ -> None ) + | _ -> None + + let od_pmod_ident + ~wrap ~unwrap ~override ~lident_loc ?popen_loc ?popen_attr () = + match unwrap lident_loc with + | Some { name = "longident_loc"; data = (Loc {loc; _}) } -> + let loc = ghost loc in + let popen_loc = Option.map ghost popen_loc in + let attr = empty_attr ~wrap in + let data = Variant {tag = "Pmod_ident"; args = [|Node lident_loc|]} in + let desc = wrap {name = "module_expr_desc"; data} in + let data = Record [| Node desc; Location loc; attr |] in + let mod_exp = wrap {name = "module_expr"; data} in + let popen_loc = Location (Option.value ~default:loc popen_loc) in + let popen_attr = Option.value ~default:attr popen_attr in + let data = Record [| Node mod_exp; override; popen_loc; popen_attr |] in + let open_infos = wrap {name = "open_infos"; data} in + let data = Node open_infos in + Some (Node (wrap {name = "open_declaration"; data})) + | _ -> None + + let upgrade_expression_desc ~wrap ~unwrap node = + match node.data with + | Variant + { tag = "Pexp_open" as tag + ; args = [|override; Node lident_loc; expr|] } -> + ( match od_pmod_ident ~wrap ~unwrap ~override ~lident_loc () with + | Some open_declaration -> + let data = Variant {tag; args = [|open_declaration; expr|]} in + Some { node with data } + | _ -> None ) + | Variant { tag = "Pexp_open"; _ } -> None + | _ -> Some node + + let upgrade_type_extension ~unwrap node = + match node.data with + | Record [| Node li as path; params; ctors; private_; attr |] -> + ( match unwrap li with + | Some { name = "longident_loc"; data = Loc x } -> + let loc = ghost x.loc in + let data = + Record [| path; params; ctors; private_; Location loc; attr |] + in + Some { node with data } + | _ -> None ) + | _ -> None + + let open_desc ~wrap ~unwrap ~override ~lident_loc = + match unwrap lident_loc with + | Some { name = "longident_loc"; data = Loc {loc; _} } -> + let loc = ghost loc in + let attr = empty_attr ~wrap in + let data = Record [| Node lident_loc; override; Location loc; attr |] in + let open_infos = wrap {name = "open_infos"; data} in + let data = Node open_infos in + Some (Node (wrap {name = "open_description"; data})) + | _ -> None + + let upgrade_class_type_desc ~wrap ~unwrap node = + match node.data with + | Variant + { tag = "Pcty_open" as tag + ; args = [| override; Node lident_loc; cty |] } -> + let open_desc = open_desc ~wrap ~unwrap ~override ~lident_loc in + Option.map + (fun odesc -> + { node with data = Variant { tag; args = [| odesc; cty |] } }) + open_desc + | Variant { tag = "Pcty_open"; _ } -> None + | _ -> Some node + + let upgrade_class_expr_desc ~wrap ~unwrap node = + match node.data with + | Variant + { tag = "Pcl_open" as tag + ; args = [| override; Node lident_loc; cl |] } -> + let open_desc = open_desc ~wrap ~unwrap ~override ~lident_loc in + Option.map + (fun odesc -> + { node with data = Variant { tag; args = [| odesc; cl |] } }) + open_desc + | _ -> Some node + + let type_exc ~wrap ~unwrap ext_ctor = + match unwrap ext_ctor with + | Some + { name = "extension_constructor"; + data = Record [| _name; _kind; Location loc; _attr |] } -> + let loc = ghost loc in + let data = Record [| Node ext_ctor; Location loc; empty_attr ~wrap |] in + Some (Node (wrap {name = "type_exception"; data})) + | _ -> None + + let upgrade_signature_item_desc ~wrap ~unwrap node = + match node.data with + | Variant { tag = "Psig_exception" as tag; args = [| Node ext_ctor |] } -> + ( match type_exc ~wrap ~unwrap ext_ctor with + | Some type_exc -> + Some { node with data = Variant {tag; args = [| type_exc |]} } + | None -> None ) + | Variant { tag = "Psig_exception"; _ } -> None + | _ -> Some node + + let upgrade_open_description ~wrap node = + let data = Node (wrap {name = "open_infos"; data = node.data}) in + Some { node with data } + + let upgrade_structure_item_desc ~wrap ~unwrap node = + match node.data with + | Variant { tag = "Pstr_exception" as tag; args = [| Node ext_ctor |] } -> + ( match type_exc ~wrap ~unwrap ext_ctor with + | Some type_exc -> + Some { node with data = Variant { tag; args = [| type_exc |] } } + | None -> None ) + | Variant { tag = "Pstr_open" as tag; args = [| Node open_desc |] } -> + ( match unwrap open_desc with + | Some + { name = "open_description" + ; data = + Record + [| Node lident_loc + ; override + ; Location popen_loc + ; popen_attr |] } -> + let open_decl = + od_pmod_ident + ~wrap ~unwrap ~lident_loc ~override ~popen_loc ~popen_attr () + in + Option.map + (fun open_decl -> + { node with data = Variant { tag; args = [| open_decl |] }}) + open_decl + | _ -> None ) + | Variant { tag = ("Pstr_exception" | "Pstr_open"); _ } -> None + | _ -> Some node + + let pdir_arg ~wrap ~unwrap dir_arg = + match unwrap dir_arg with + | Some + { name = "directive_argument" + ; data = Variant { tag = "Pdir_none"; args = [||] } } -> + Some (Option None) + | Some dir_arg -> + let desc = wrap {dir_arg with name = "directive_argument_desc"} in + let loc = ghost Location.none in + let data = Record [| Node desc; Location loc |] in + Some (Option (Some (Node (wrap {name = "directive_argument"; data})))) + | None -> None + + let upgrade_toplevel_phrase ~wrap ~unwrap node = + match node.data with + | Variant { tag = "Ptop_dir" as tag; args = [| name; Node dir_arg |] } -> + ( match pdir_arg ~wrap ~unwrap dir_arg with + | Some pdir_arg -> + let loc = ghost Location.none in + let pdir_loc = Location loc in + let pdir_name = Loc {txt = name; loc} in + let data = Record [| pdir_name; pdir_arg; pdir_loc |] in + let tdir = wrap {name = "toplevel_directive"; data} in + Some { node with data = Variant { tag; args = [| Node tdir |] } } + | None -> None ) + | _ -> Some node + + let upgrade : _ History.conversion_function = + fun node ~unwrap ~wrap -> + match node.name with + | "attribute" -> upgrade_attribute node + | "core_type" + | "pattern" + | "expression" -> add_loc_stack node + | "row_field" -> upgrade_row_field ~wrap ~unwrap node + | "object_field" -> upgrade_object_field ~wrap ~unwrap node + | "expression_desc" -> upgrade_expression_desc ~wrap ~unwrap node + | "type_extension" -> upgrade_type_extension ~unwrap node + | "class_type_desc" -> upgrade_class_type_desc ~wrap ~unwrap node + | "class_expr_desc" -> upgrade_class_expr_desc ~wrap ~unwrap node + | "signature_item_desc" -> upgrade_signature_item_desc ~wrap ~unwrap node + | "open_description" -> upgrade_open_description ~wrap node + | "structure_item_desc" -> upgrade_structure_item_desc ~wrap ~unwrap node + | "toplevel_phrase" -> upgrade_toplevel_phrase ~wrap ~unwrap node + | _ -> Some node + end +end + +let grammar = concat_map ~f:Grammar.update_type_decl Version_4_08.grammar + +let to_4_08 : History.conversion = + { src_version = version + ; dst_version = Version_4_08.version + ; f = Node.Up.upgrade + } + +let of_4_08 : History.conversion = + { src_version = Version_4_08.version + ; dst_version = version + ; f = Node.Down.downgrade + } + +let conversions = [to_4_08; of_4_08] diff --git a/astlib/version_4_08.ml b/astlib/version_4_08.ml new file mode 100644 index 00000000..3cc3dd30 --- /dev/null +++ b/astlib/version_4_08.ml @@ -0,0 +1 @@ +include Latest_version diff --git a/astlib/version_4_08.mli b/astlib/version_4_08.mli new file mode 100644 index 00000000..bee53d6c --- /dev/null +++ b/astlib/version_4_08.mli @@ -0,0 +1 @@ +include Ast_version_intf.S diff --git a/astlib/versions.ml b/astlib/versions.ml index e5e6e169..15c4abcd 100644 --- a/astlib/versions.ml +++ b/astlib/versions.ml @@ -1,11 +1,12 @@ open StdLabels -module Current = Version_4_07 +module Current = Version_4_08 let current_version = Current.version let versions : (module Ast_version_intf.S) list = [ (module Unstable_for_testing) + ; (module Version_4_07) ; (module Current) ] diff --git a/dune-project b/dune-project index 095e3b6e..90fa3705 100644 --- a/dune-project +++ b/dune-project @@ -22,7 +22,7 @@ A comprehensive toolbox for ppx development. It features: OCaml AST in the OCaml syntax; - a generator of open recursion classes from type definitions.") (depends - (ocaml (and (>= 4.07) (< 4.08))) + (ocaml (and (>= 4.08) (< 4.09))) ocaml-syntax-shims astlib (expect_test_helpers_kernel :with-test) @@ -43,7 +43,7 @@ A comprehensive toolbox for ppx development. It features: interfaces for constructing and deconstructing them so that ppx transformers can be easily migrated to new versions of the compiler.") (depends - (ocaml (and (>= 4.07) (< 4.08))) + (ocaml (and (>= 4.08) (< 4.09))) (base (>= v0.11.0)) (dune (>= 1.8.0)) (ocaml-compiler-libs (>= v0.11.0)) diff --git a/metaquot/test/test.ml b/metaquot/test/test.ml index 371f3d2b..3e22837c 100644 --- a/metaquot/test/test.ml +++ b/metaquot/test/test.ml @@ -22,5 +22,5 @@ val loc : Location.t = ~pexp_desc:(Ppx_ast.V4_07.Expression_desc.pexp_constant (Ppx_ast.V4_07.Constant.pconst_integer "42" None)) ~pexp_loc:loc ~pexp_attributes:(Ppx_ast.V4_07.Attributes.create []);; -- : Ppx_ast.V4_07.Expression.t = +- : Ppx_ast.V4_08.Expression.t = |}] diff --git a/ppx.opam b/ppx.opam index 9fbee18c..dee0b142 100644 --- a/ppx.opam +++ b/ppx.opam @@ -17,7 +17,7 @@ authors: ["Jane Street Group, LLC"] homepage: "https://github.com/ocaml-ppx/ppx" bug-reports: "https://github.com/ocaml-ppx/ppx/issues" depends: [ - "ocaml" {>= "4.07" & < "4.08"} + "ocaml" {>= "4.08" & < "4.09"} "ocaml-syntax-shims" "astlib" "expect_test_helpers_kernel" {with-test} diff --git a/stdppx/dune b/stdppx/dune index 266d0cac..fffa5096 100644 --- a/stdppx/dune +++ b/stdppx/dune @@ -2,4 +2,4 @@ (name stdppx) (public_name ppx._stdppx) (preprocess future_syntax) - (libraries ppx_caml unix)) + (libraries ppx_caml stdlib-shims unix)) diff --git a/stdppx/io.ml b/stdppx/io.ml index 5f96a300..17a9bd9b 100644 --- a/stdppx/io.ml +++ b/stdppx/io.ml @@ -1,4 +1,4 @@ -module P = Pervasives +module P = Stdlib let close_in = close_in let close_out = close_out diff --git a/stdppx/list.ml b/stdppx/list.ml index 5e5f5271..ae8b893c 100644 --- a/stdppx/list.ml +++ b/stdppx/list.ml @@ -137,7 +137,7 @@ let rec nth t i = | x :: _, 0 -> Some x | _ :: xs, i -> nth xs (i - 1) -let physically_equal = Pervasives.(==) +let physically_equal = Stdlib.(==) let init = let rec loop acc i n f = diff --git a/stdppx/pp.ml b/stdppx/pp.ml index 362e0982..b1f39329 100644 --- a/stdppx/pp.ml +++ b/stdppx/pp.ml @@ -114,6 +114,7 @@ module Renderer = struct pp_open_tag ppf (embed_tag ~opening ~closing); pp th ppf t; pp_close_tag ppf () + [@@warning "-3"] let setup ppf = let funcs = pp_get_formatter_tag_functions ppf () in @@ -123,6 +124,7 @@ module Renderer = struct mark_open_tag = extract_opening_tag ; mark_close_tag = extract_closing_tag } + [@@warning "-3"] let string () = let buf = Buffer.create 1024 in diff --git a/stdppx/sexp.ml b/stdppx/sexp.ml index 3b9efb35..d43d8ec0 100644 --- a/stdppx/sexp.ml +++ b/stdppx/sexp.ml @@ -66,7 +66,7 @@ let rec pp ppf = function let hash = Ppx_caml.Hashtbl.hash -let string_equal (x : string) (y : string) = Pervasives.(=) x y +let string_equal (x : string) (y : string) = Stdlib.(=) x y let rec equal x y = match x, y with