From dab938d3e6f316c20cc141aaff534a0f5f0ab70f Mon Sep 17 00:00:00 2001 From: Nathan Rebours Date: Thu, 1 Feb 2024 10:33:32 +0100 Subject: [PATCH 1/2] Upgrade to ocamlformat.0.26.1 Signed-off-by: Nathan Rebours --- .ocamlformat | 2 +- ast/ast.ml | 181 +++++++++--------- .../drivers/identity/inputs/bap_knowledge.ml | 90 ++++----- .../ppx_sexp_conv/inputs/bap_knowledge.ml | 90 ++++----- src/ast_builder_intf.ml | 8 +- src/ast_traverse.mli | 104 +++++----- src/ast_traverse0.mli | 54 +++--- src/attribute.ml | 7 +- src/attribute.mli | 4 +- src/common.mli | 15 +- src/context_free.mli | 16 +- src/driver.ml | 49 ++--- src/driver.mli | 11 +- src/location_check.mli | 2 +- src/merlin_helpers.mli | 4 +- src/spellcheck.ml | 4 +- traverse/ppxlib_traverse.ml | 46 ++--- traverse_builtins/ppxlib_traverse_builtins.ml | 100 +++++----- 18 files changed, 381 insertions(+), 406 deletions(-) diff --git a/.ocamlformat b/.ocamlformat index dd9f5db54..07c241f82 100644 --- a/.ocamlformat +++ b/.ocamlformat @@ -1,3 +1,3 @@ -version=0.24.1 +version=0.26.1 profile=conventional parse-docstrings=true diff --git a/ast/ast.ml b/ast/ast.ml index 534608f86..992874a37 100644 --- a/ast/ast.ml +++ b/ast/ast.ml @@ -114,7 +114,7 @@ and constant = Parsetree.constant = | Pconst_integer of string * char option (** Integer constants such as [3] [3l] [3L] [3n]. - Suffixes [\[g-z\]\[G-Z\]] are accepted by the parser. Suffixes except + Suffixes [[g-z][G-Z]] are accepted by the parser. Suffixes except ['l'], ['L'] and ['n'] are rejected by the typechecker *) | Pconst_char of char (** Character such as ['c']. *) | Pconst_string of string * location * string option @@ -135,13 +135,13 @@ and attribute = Parsetree.attribute = { attr_payload : payload; attr_loc : location; } -(** Attributes such as [\[@id ARG\]] and [\[@@id ARG\]]. +(** Attributes such as [[@id ARG]] and [[@@id ARG]]. Metadata containers passed around within the AST. The compiler ignores unknown attributes. *) and extension = string loc * payload -(** Extension points such as [\[%id ARG\] and \[%%id ARG\]]. +(** Extension points such as [[%id ARG] and [%%id ARG]]. Sub-language placeholder -- rejected by the typechecker. *) @@ -161,7 +161,7 @@ and core_type = Parsetree.core_type = { ptyp_desc : core_type_desc; ptyp_loc : location; ptyp_loc_stack : location_stack; - ptyp_attributes : attributes; (** [... \[@id1\] \[@id2\]] *) + ptyp_attributes : attributes; (** [... [@id1] [@id2]] *) } and core_type_desc = Parsetree.core_type_desc = @@ -176,18 +176,18 @@ and core_type_desc = Parsetree.core_type_desc = - [?l:T1 -> T2] when [lbl] is {{!Asttypes.arg_label.Optional} [Optional]}. *) | Ptyp_tuple of core_type list - (** [Ptyp_tuple(\[T1 ; ... ; Tn\])] represents a product type + (** [Ptyp_tuple([T1 ; ... ; Tn])] represents a product type [T1 * ... * Tn]. Invariant: [n >= 2]. *) | Ptyp_constr of longident_loc * core_type list (** [Ptyp_constr(lident, l)] represents: - - [tconstr] when [l=\[\]], - - [T tconstr] when [l=\[T\]], - - [(T1, ..., Tn) tconstr] when [l=\[T1 ; ... ; Tn\]]. *) + - [tconstr] when [l=[]], + - [T tconstr] when [l=[T]], + - [(T1, ..., Tn) tconstr] when [l=[T1 ; ... ; Tn]]. *) | Ptyp_object of object_field list * closed_flag - (** [Ptyp_object(\[ l1:T1; ...; ln:Tn \], flag)] represents: + (** [Ptyp_object([ l1:T1; ...; ln:Tn ], flag)] represents: - [< l1:T1; ...; ln:Tn >] when [flag] is {{!Asttypes.closed_flag.Closed} [Closed]}, @@ -196,22 +196,21 @@ and core_type_desc = Parsetree.core_type_desc = | Ptyp_class of longident_loc * core_type list (** [Ptyp_class(tconstr, l)] represents: - - [#tconstr] when [l=\[\]], - - [T #tconstr] when [l=\[T\]], - - [(T1, ..., Tn) #tconstr] when [l=\[T1 ; ... ; Tn\]]. *) + - [#tconstr] when [l=[]], + - [T #tconstr] when [l=[T]], + - [(T1, ..., Tn) #tconstr] when [l=[T1 ; ... ; Tn]]. *) | Ptyp_alias of core_type * string (** [T as 'a]. *) | Ptyp_variant of row_field list * closed_flag * label list option - (** [Ptyp_variant(\[`A;`B\], flag, labels)] represents: + (** [Ptyp_variant([`A;`B], flag, labels)] represents: - - [\[ `A|`B \]] when [flag] is {{!Asttypes.closed_flag.Closed} + - [[ `A|`B ]] when [flag] is {{!Asttypes.closed_flag.Closed} [Closed]}, and [labels] is [None], - - [\[> `A|`B \]] when [flag] is {{!Asttypes.closed_flag.Open} [Open]}, + - [[> `A|`B ]] when [flag] is {{!Asttypes.closed_flag.Open} [Open]}, and [labels] is [None], - - [\[< `A|`B \]] when [flag] is {{!Asttypes.closed_flag.Closed} - [Closed]}, and [labels] is [Some \[\]], - - [\[< `A|`B > `X `Y \]] when [flag] is - {{!Asttypes.closed_flag.Closed} [Closed]}, and [labels] is - [Some \["X";"Y"\]]. *) + - [[< `A|`B ]] when [flag] is {{!Asttypes.closed_flag.Closed} + [Closed]}, and [labels] is [Some []], + - [[< `A|`B > `X `Y ]] when [flag] is {{!Asttypes.closed_flag.Closed} + [Closed]}, and [labels] is [Some ["X";"Y"]]. *) | Ptyp_poly of string loc list * core_type (** ['a1 ... 'an. T] @@ -242,13 +241,13 @@ and core_type_desc = Parsetree.core_type_desc = - As the {{!value_description.pval_type} [pval_type]} field of a {!value_description}. *) | Ptyp_package of package_type (** [(module S)]. *) - | Ptyp_extension of extension (** [\[%id\]]. *) + | Ptyp_extension of extension (** [[%id]]. *) and package_type = longident_loc * (longident_loc * core_type) list (** As {!package_type} typed values: - - [(S, \[\])] represents [(module S)], - - [(S, \[(t1, T1) ; ... ; (tn, Tn)\])] represents + - [(S, [])] represents [(module S)], + - [(S, [(t1, T1) ; ... ; (tn, Tn)])] represents [(module S with type t1 = T1 and ... and tn = Tn)]. *) and row_field = Parsetree.row_field = { @@ -261,16 +260,16 @@ and row_field_desc = Parsetree.row_field_desc = | Rtag of label loc * bool * core_type list (** [Rtag(`A, b, l)] represents: - - [`A] when [b] is [true] and [l] is [\[\]], - - [`A of T] when [b] is [false] and [l] is [\[T\]], - - [`A of T1 & .. & Tn] when [b] is [false] and [l] is [\[T1;...Tn\]], - - [`A of & T1 & .. & Tn] when [b] is [true] and [l] is [\[T1;...Tn\]]. + - [`A] when [b] is [true] and [l] is [[]], + - [`A of T] when [b] is [false] and [l] is [[T]], + - [`A of T1 & .. & Tn] when [b] is [false] and [l] is [[T1;...Tn]], + - [`A of & T1 & .. & Tn] when [b] is [true] and [l] is [[T1;...Tn]]. - The [bool] field is true if the tag contains a constant (empty) constructor. - [&] occurs when several types are used for the same constructor (see 4.2 in the manual) *) - | Rinherit of core_type (** [\[ | t \]] *) + | Rinherit of core_type (** [[ | t ]] *) and object_field = Parsetree.object_field = { pof_desc : object_field_desc; @@ -288,7 +287,7 @@ and pattern = Parsetree.pattern = { ppat_desc : pattern_desc; ppat_loc : location; ppat_loc_stack : location_stack; - ppat_attributes : attributes; (** [... \[@id1\] \[@id2\]] *) + ppat_attributes : attributes; (** [... [@id1] [@id2]] *) } and pattern_desc = Parsetree.pattern_desc = @@ -311,17 +310,17 @@ and pattern_desc = Parsetree.pattern_desc = (** [Ppat_construct(C, args)] represents: - [C] when [args] is [None], - - [C P] when [args] is [Some (\[\], P)] + - [C P] when [args] is [Some ([], P)] - [C (P1, ..., Pn)] when [args] is - [Some (\[\], Ppat_tuple \[P1; ...; Pn\])] - - [C (type a b) P] when [args] is [Some (\[a; b\], P)] *) + [Some ([], Ppat_tuple [P1; ...; Pn])] + - [C (type a b) P] when [args] is [Some ([a; b], P)] *) | Ppat_variant of label * pattern option (** [Ppat_variant(`A, pat)] represents: - [`A] when [pat] is [None], - [`A P] when [pat] is [Some P] *) | Ppat_record of (longident_loc * pattern) list * closed_flag - (** [Ppat_record(\[(l1, P1) ; ... ; (ln, Pn)\], flag)] represents: + (** [Ppat_record([(l1, P1) ; ... ; (ln, Pn)], flag)] represents: - [{ l1=P1; ...; ln=Pn }] when [flag] is {{!Asttypes.closed_flag.Closed} [Closed]} @@ -329,7 +328,7 @@ and pattern_desc = Parsetree.pattern_desc = {{!Asttypes.closed_flag.Open} [Open]} Invariant: [n > 0] *) - | Ppat_array of pattern list (** Pattern [\[| P1; ...; Pn |\]] *) + | Ppat_array of pattern list (** Pattern [[| P1; ...; Pn |]] *) | Ppat_or of pattern * pattern (** Pattern [P1 | P2] *) | Ppat_constraint of pattern * core_type (** Pattern [(P : T)] *) | Ppat_type of longident_loc (** Pattern [#tconst] *) @@ -343,7 +342,7 @@ and pattern_desc = Parsetree.pattern_desc = Note: [(module P : S)] is represented as [Ppat_constraint(Ppat_unpack(Some "P"), Ptyp_package S)] *) | Ppat_exception of pattern (** Pattern [exception P] *) - | Ppat_extension of extension (** Pattern [\[%id\]] *) + | Ppat_extension of extension (** Pattern [[%id]] *) | Ppat_open of longident_loc * pattern (** Pattern [M.(P)] *) (** {2 Value expressions} *) @@ -352,7 +351,7 @@ and expression = Parsetree.expression = { pexp_desc : expression_desc; pexp_loc : location; pexp_loc_stack : location_stack; - pexp_attributes : attributes; (** [... \[@id1\] \[@id2\]] *) + pexp_attributes : attributes; (** [... [@id1] [@id2]] *) } and expression_desc = Parsetree.expression_desc = @@ -361,7 +360,7 @@ and expression_desc = Parsetree.expression_desc = (** Expressions constant such as [1], ['a'], ["true"], [1.0], [1l], [1L], [1n] *) | Pexp_let of rec_flag * value_binding list * expression - (** [Pexp_let(flag, \[(P1,E1) ; ... ; (Pn,En)\], E)] represents: + (** [Pexp_let(flag, [(P1,E1) ; ... ; (Pn,En)], E)] represents: - [let P1 = E1 and ... and Pn = EN in E] when [flag] is {{!Asttypes.rec_flag.Nonrecursive} [Nonrecursive]}, @@ -390,7 +389,7 @@ and expression_desc = Parsetree.expression_desc = - [let f P = E] is represented using {{!expression_desc.Pexp_fun} [Pexp_fun]}. *) | Pexp_apply of expression * (arg_label * expression) list - (** [Pexp_apply(E0, \[(l1, E1) ; ... ; (ln, En)\])] represents + (** [Pexp_apply(E0, [(l1, E1) ; ... ; (ln, En)])] represents [E0 ~l1:E1 ... ~ln:En] [li] can be {{!Asttypes.arg_label.Nolabel} [Nolabel]} (non labeled @@ -412,14 +411,14 @@ and expression_desc = Parsetree.expression_desc = - [C] when [exp] is [None], - [C E] when [exp] is [Some E], - - [C (E1, ..., En)] when [exp] is [Some (Pexp_tuple\[E1;...;En\])] *) + - [C (E1, ..., En)] when [exp] is [Some (Pexp_tuple[E1;...;En])] *) | Pexp_variant of label * expression option (** [Pexp_variant(`A, exp)] represents - [`A] when [exp] is [None] - [`A E] when [exp] is [Some E] *) | Pexp_record of (longident_loc * expression) list * expression option - (** [Pexp_record(\[(l1,P1) ; ... ; (ln,Pn)\], exp0)] represents + (** [Pexp_record([(l1,P1) ; ... ; (ln,Pn)], exp0)] represents - [{ l1=P1; ...; ln=Pn }] when [exp0] is [None] - [{ E0 with l1=P1; ...; ln=Pn }] when [exp0] is [Some E0] @@ -428,7 +427,7 @@ and expression_desc = Parsetree.expression_desc = | Pexp_field of expression * longident_loc (** [E.l] *) | Pexp_setfield of expression * longident_loc * expression (** [E1.l <- E2] *) - | Pexp_array of expression list (** [\[| E1; ...; En |\]] *) + | Pexp_array of expression list (** [[| E1; ...; En |]] *) | Pexp_ifthenelse of expression * expression * expression option (** [if E1 then E2 else E3] *) | Pexp_sequence of expression * expression (** [E1; E2] *) @@ -480,7 +479,7 @@ and expression_desc = Parsetree.expression_desc = | Pexp_letop of letop (** - [let* P = E0 in E1] - [let* P0 = E00 and* P1 = E01 in E1] *) - | Pexp_extension of extension (** [\[%id\]] *) + | Pexp_extension of extension (** [[%id]] *) | Pexp_unreachable (** [.] *) and case = Parsetree.case = { @@ -509,14 +508,14 @@ and value_description = Parsetree.value_description = { pval_name : string loc; pval_type : core_type; pval_prim : string list; - pval_attributes : attributes; (** [... \[@@id1\] \[@@id2\]] *) + pval_attributes : attributes; (** [... [@@id1] [@@id2]] *) pval_loc : location; } (** Values of type {!value_description} represents: - - [val x: T], when {{!value_description.pval_prim} [pval_prim]} is [\[\]] + - [val x: T], when {{!value_description.pval_prim} [pval_prim]} is [[]] - [external x: T = "s1" ... "sn"] when {{!value_description.pval_prim} - [pval_prim]} is [\["s1";..."sn"\]] *) + [pval_prim]} is [["s1";..."sn"]] *) (** {2 Type declarations} *) @@ -529,7 +528,7 @@ and type_declaration = Parsetree.type_declaration = { ptype_kind : type_kind; ptype_private : private_flag; (** for [= private ...] *) ptype_manifest : core_type option; (** represents [= T] *) - ptype_attributes : attributes; (** [... \[@@id1\] \[@@id2\]] *) + ptype_attributes : attributes; (** [... [@@id1] [@@id2]] *) ptype_loc : location; } (** Here are type declarations and their representation, for various @@ -562,7 +561,7 @@ and label_declaration = Parsetree.label_declaration = { pld_mutable : mutable_flag; pld_type : core_type; pld_loc : location; - pld_attributes : attributes; (** [l : T \[@id1\] \[@id2\]] *) + pld_attributes : attributes; (** [l : T [@id1] [@id2]] *) } (** - [{ ...; l: T; ... }] when {{!label_declaration.pld_mutable} [pld_mutable]} is {{!Asttypes.mutable_flag.Immutable} [Immutable]}, @@ -577,7 +576,7 @@ and constructor_declaration = Parsetree.constructor_declaration = { pcd_args : constructor_arguments; pcd_res : core_type option; pcd_loc : location; - pcd_attributes : attributes; (** [C of ... \[@id1\] \[@id2\]] *) + pcd_attributes : attributes; (** [C of ... [@id1] [@id2]] *) } and constructor_arguments = Parsetree.constructor_arguments = @@ -587,13 +586,13 @@ and constructor_arguments = Parsetree.constructor_arguments = arguments of: - [C of T1 * ... * Tn] when [res = None], and - [args = Pcstr_tuple \[T1; ... ; Tn\]], - - [C: T0] when [res = Some T0], and [args = Pcstr_tuple \[\]], + [args = Pcstr_tuple [T1; ... ; Tn]], + - [C: T0] when [res = Some T0], and [args = Pcstr_tuple []], - [C: T1 * ... * Tn -> T0] when [res = Some T0], and - [args = Pcstr_tuple \[T1; ... ; Tn\]], - - [C of {...}] when [res = None], and [args = Pcstr_record \[...\]], + [args = Pcstr_tuple [T1; ... ; Tn]], + - [C of {...}] when [res = None], and [args = Pcstr_record [...]], - [C: {...} -> T0] when [res = Some T0], and - [args = Pcstr_record \[...\]]. *) + [args = Pcstr_record [...]]. *) and type_extension = Parsetree.type_extension = { ptyext_path : longident_loc; @@ -610,13 +609,13 @@ and extension_constructor = Parsetree.extension_constructor = { pext_name : string loc; pext_kind : extension_constructor_kind; pext_loc : location; - pext_attributes : attributes; (** [C of ... \[@id1\] \[@id2\]] *) + pext_attributes : attributes; (** [C of ... [@id1] [@id2]] *) } and type_exception = Parsetree.type_exception = { ptyexn_constructor : extension_constructor; ptyexn_loc : location; - ptyexn_attributes : attributes; (** [... \[@@id1\] \[@@id2\]] *) + ptyexn_attributes : attributes; (** [... [@@id1] [@@id2]] *) } (** Definition of a new exception ([exception E]). *) @@ -629,29 +628,29 @@ and extension_constructor_kind = Parsetree.extension_constructor_kind = {- [C of T1 * ... * Tn] when: - - [existentials] is [\[\]], - - [c_args] is [\[T1; ...; Tn\]], + - [existentials] is [[]], + - [c_args] is [[T1; ...; Tn]], - [t_opt] is [None]. } {- [C: T0] when - - [existentials] is [\[\]], - - [c_args] is [\[\]], + - [existentials] is [[]], + - [c_args] is [[]], - [t_opt] is [Some T0]. } {- [C: T1 * ... * Tn -> T0] when - - [existentials] is [\[\]], - - [c_args] is [\[T1; ...; Tn\]], + - [existentials] is [[]], + - [c_args] is [[T1; ...; Tn]], - [t_opt] is [Some T0]. } {- [C: 'a... . T1 * ... * Tn -> T0] when - - [existentials] is [\['a;...\]], - - [c_args] is [\[T1; ... ; Tn\]], + - [existentials] is [['a;...]], + - [c_args] is [[T1; ... ; Tn]], - [t_opt] is [Some T0]. } } *) @@ -664,13 +663,13 @@ and extension_constructor_kind = Parsetree.extension_constructor_kind = and class_type = Parsetree.class_type = { pcty_desc : class_type_desc; pcty_loc : location; - pcty_attributes : attributes; (** [... \[@id1\] \[@id2\]] *) + pcty_attributes : attributes; (** [... [@id1] [@id2]] *) } and class_type_desc = Parsetree.class_type_desc = | Pcty_constr of longident_loc * core_type list (** - [c] - - [\['a1, ..., 'an\] c] *) + - [['a1, ..., 'an] c] *) | Pcty_signature of class_signature (** [object ... end] *) | Pcty_arrow of arg_label * core_type * class_type (** [Pcty_arrow(lbl, T, CT)] represents: @@ -696,7 +695,7 @@ and class_signature = Parsetree.class_signature = { and class_type_field = Parsetree.class_type_field = { pctf_desc : class_type_field_desc; pctf_loc : location; - pctf_attributes : attributes; (** [... \[@@id1\] \[@@id2\]] *) + pctf_attributes : attributes; (** [... [@@id1] [@@id2]] *) } and class_type_field_desc = Parsetree.class_type_field_desc = @@ -708,8 +707,8 @@ and class_type_field_desc = Parsetree.class_type_field_desc = Note: [T] can be a {{!core_type_desc.Ptyp_poly} [Ptyp_poly]}. *) | Pctf_constraint of (core_type * core_type) (** [constraint T1 = T2] *) - | Pctf_attribute of attribute (** [\[@@@id\]] *) - | Pctf_extension of extension (** [\[%%id\]] *) + | Pctf_attribute of attribute (** [[@@@id]] *) + | Pctf_extension of extension (** [[%%id]] *) and 'a class_infos = 'a Parsetree.class_infos = { pci_virt : virtual_flag; @@ -717,12 +716,12 @@ and 'a class_infos = 'a Parsetree.class_infos = { pci_name : string loc; pci_expr : 'a; pci_loc : location; - pci_attributes : attributes; (** [... \[@@id1\] \[@@id2\]] *) + pci_attributes : attributes; (** [... [@@id1] [@@id2]] *) } (** Values of type [class_expr class_infos] represents: - [class c = ...] - - [class \['a1,...,'an\] c = ...] + - [class ['a1,...,'an] c = ...] - [class virtual c = ...] They are also used for "class type" declaration. *) @@ -735,12 +734,12 @@ and class_type_declaration = class_type class_infos and class_expr = Parsetree.class_expr = { pcl_desc : class_expr_desc; pcl_loc : location; - pcl_attributes : attributes; (** [... \[@id1\] \[@id2\]] *) + pcl_attributes : attributes; (** [... [@id1] [@id2]] *) } and class_expr_desc = Parsetree.class_expr_desc = | Pcl_constr of longident_loc * core_type list - (** [c] and [\['a1, ..., 'an\] c] *) + (** [c] and [['a1, ..., 'an] c] *) | Pcl_structure of class_structure (** [object ... end] *) | Pcl_fun of arg_label * expression option * pattern * class_expr (** [Pcl_fun(lbl, exp0, P, CE)] represents: @@ -755,20 +754,20 @@ and class_expr_desc = Parsetree.class_expr_desc = {{!Asttypes.arg_label.Optional} [Optional l]} and [exp0] is [Some E0]. *) | Pcl_apply of class_expr * (arg_label * expression) list - (** [Pcl_apply(CE, \[(l1,E1) ; ... ; (ln,En)\])] represents + (** [Pcl_apply(CE, [(l1,E1) ; ... ; (ln,En)])] represents [CE ~l1:E1 ... ~ln:En]. [li] can be empty (non labeled argument) or start with [?] (optional argument). Invariant: [n > 0] *) | Pcl_let of rec_flag * value_binding list * class_expr - (** [Pcl_let(rec, \[(P1, E1); ... ; (Pn, En)\], CE)] represents: + (** [Pcl_let(rec, [(P1, E1); ... ; (Pn, En)], CE)] represents: - [let P1 = E1 and ... and Pn = EN in CE] when [rec] is {{!Asttypes.rec_flag.Nonrecursive} [Nonrecursive]}, - [let rec P1 = E1 and ... and Pn = EN in CE] when [rec] is {{!Asttypes.rec_flag.Recursive} [Recursive]}. *) | Pcl_constraint of class_expr * class_type (** [(CE : CT)] *) - | Pcl_extension of extension (** [\[%id\]] *) + | Pcl_extension of extension (** [[%id]] *) | Pcl_open of open_description * class_expr (** [let open M in CE] *) and class_structure = Parsetree.class_structure = { @@ -784,7 +783,7 @@ and class_structure = Parsetree.class_structure = { and class_field = Parsetree.class_field = { pcf_desc : class_field_desc; pcf_loc : location; - pcf_attributes : attributes; (** [... \[@@id1\] \[@@id2\]] *) + pcf_attributes : attributes; (** [... [@@id1] [@@id2]] *) } and class_field_desc = Parsetree.class_field_desc = @@ -821,8 +820,8 @@ and class_field_desc = Parsetree.class_field_desc = [Ptyp_poly]}) *) | Pcf_constraint of (core_type * core_type) (** [constraint T1 = T2] *) | Pcf_initializer of expression (** [initializer E] *) - | Pcf_attribute of attribute (** [\[@@@id\]] *) - | Pcf_extension of extension (** [\[%%id\]] *) + | Pcf_attribute of attribute (** [[@@@id]] *) + | Pcf_extension of extension (** [[%%id]] *) and class_field_kind = Parsetree.class_field_kind = | Cfk_virtual of core_type @@ -836,7 +835,7 @@ and class_declaration = class_expr class_infos and module_type = Parsetree.module_type = { pmty_desc : module_type_desc; pmty_loc : location; - pmty_attributes : attributes; (** [... \[@id1\] \[@id2\]] *) + pmty_attributes : attributes; (** [... [@id1] [@id2]] *) } and module_type_desc = Parsetree.module_type_desc = @@ -846,7 +845,7 @@ and module_type_desc = Parsetree.module_type_desc = (** [functor(X : MT1) -> MT2] *) | Pmty_with of module_type * with_constraint list (** [MT with ...] *) | Pmty_typeof of module_expr (** [module type of ME] *) - | Pmty_extension of extension (** [\[%id\]] *) + | Pmty_extension of extension (** [[%id]] *) | Pmty_alias of longident_loc (** [(module M)] *) and functor_parameter = Parsetree.functor_parameter = @@ -887,13 +886,13 @@ and signature_item_desc = Parsetree.signature_item_desc = (** [class c1 : ... and ... and cn : ...] *) | Psig_class_type of class_type_declaration list (** [class type ct1 = ... and ... and ctn = ...] *) - | Psig_attribute of attribute (** [\[@@@id\]] *) - | Psig_extension of extension * attributes (** [\[%%id\]] *) + | Psig_attribute of attribute (** [[@@@id]] *) + | Psig_extension of extension * attributes (** [[%%id]] *) and module_declaration = Parsetree.module_declaration = { pmd_name : string option loc; pmd_type : module_type; - pmd_attributes : attributes; (** [... \[@@id1\] \[@@id2\]] *) + pmd_attributes : attributes; (** [... [@@id1] [@@id2]] *) pmd_loc : location; } (** Values of type [module_declaration] represents [S : MT] *) @@ -901,7 +900,7 @@ and module_declaration = Parsetree.module_declaration = { and module_substitution = Parsetree.module_substitution = { pms_name : string loc; pms_manifest : longident_loc; - pms_attributes : attributes; (** [... \[@@id1\] \[@@id2\]] *) + pms_attributes : attributes; (** [... [@@id1] [@@id2]] *) pms_loc : location; } (** Values of type [module_substitution] represents [S := M] *) @@ -909,7 +908,7 @@ and module_substitution = Parsetree.module_substitution = { and module_type_declaration = Parsetree.module_type_declaration = { pmtd_name : string loc; pmtd_type : module_type option; - pmtd_attributes : attributes; (** [... \[@@id1\] \[@@id2\]] *) + pmtd_attributes : attributes; (** [... [@@id1] [@@id2]] *) pmtd_loc : location; } (** Values of type [module_type_declaration] represents: @@ -969,7 +968,7 @@ and with_constraint = Parsetree.with_constraint = | Pwith_modtypesubst of longident_loc * module_type (** [with module type X.Y := sig end] *) | Pwith_typesubst of longident_loc * type_declaration - (** [with type X.t := ..., same format as \[Pwith_type\]] *) + (** [with type X.t := ..., same format as [Pwith_type]] *) | Pwith_modsubst of longident_loc * longident_loc (** [with module X.Y := Z] *) @@ -978,7 +977,7 @@ and with_constraint = Parsetree.with_constraint = and module_expr = Parsetree.module_expr = { pmod_desc : module_expr_desc; pmod_loc : location; - pmod_attributes : attributes; (** [... \[@id1\] \[@id2\]] *) + pmod_attributes : attributes; (** [... [@id1] [@id2]] *) } and module_expr_desc = Parsetree.module_expr_desc = @@ -989,7 +988,7 @@ and module_expr_desc = Parsetree.module_expr_desc = | Pmod_apply of module_expr * module_expr (** [ME1(ME2)] *) | Pmod_constraint of module_expr * module_type (** [(ME : MT)] *) | Pmod_unpack of expression (** [(val E)] *) - | Pmod_extension of extension (** [\[%id\]] *) + | Pmod_extension of extension (** [[%id]] *) and structure = structure_item list @@ -1001,7 +1000,7 @@ and structure_item = Parsetree.structure_item = { and structure_item_desc = Parsetree.structure_item_desc = | Pstr_eval of expression * attributes (** [E] *) | Pstr_value of rec_flag * value_binding list - (** [Pstr_value(rec, \[(P1, E1 ; ... ; (Pn, En))\])] represents: + (** [Pstr_value(rec, [(P1, E1 ; ... ; (Pn, En))])] represents: - [let P1 = E1 and ... and Pn = EN] when [rec] is {{!Asttypes.rec_flag.Nonrecursive} [Nonrecursive]}, @@ -1026,8 +1025,8 @@ and structure_item_desc = Parsetree.structure_item_desc = | Pstr_class_type of class_type_declaration list (** [class type ct1 = ... and ... and ctn = ...] *) | Pstr_include of include_declaration (** [include ME] *) - | Pstr_attribute of attribute (** [\[@@@id\]] *) - | Pstr_extension of extension * attributes (** [\[%%id\]] *) + | Pstr_attribute of attribute (** [[@@@id]] *) + | Pstr_extension of extension * attributes (** [[%%id]] *) and value_binding = Parsetree.value_binding = { pvb_pat : pattern; diff --git a/bench/drivers/identity/inputs/bap_knowledge.ml b/bench/drivers/identity/inputs/bap_knowledge.ml index ba7e05881..8e6e9e4d8 100644 --- a/bench/drivers/identity/inputs/bap_knowledge.ml +++ b/bench/drivers/identity/inputs/bap_knowledge.ml @@ -137,7 +137,7 @@ end = struct let m = one lsl to_int bit in let y = k' lor (m - one) land lnot m in if x = y then if k' land m = zero then LB else RB else NA - [@@inline] + [@@inline] let equal { key = k1 } { key = k2 } = equal k1 k2 [@@inline] @@ -196,7 +196,7 @@ end = struct | NA -> join (Tip (k, nil ())) k t (Key.payload k') | LB -> Bin (k', update_with l k ~has ~nil, r) | RB -> Bin (k', l, update_with r k ~has ~nil)) - [@@specialise] + [@@specialise] let rec update t k ~f = match t with @@ -208,7 +208,7 @@ end = struct | NA -> join (Tip (k, f None)) k t (Key.payload k') | LB -> Bin (k', update l k f, r) | RB -> Bin (k', l, update r k f)) - [@@specialise] + [@@specialise] let rec set t k v = match t with @@ -248,7 +248,7 @@ end = struct | LB -> if is_zero ~bit:b2 k1 then Bin (p2, merge t1 l2 ~f, r2) else Bin (p2, l2, merge t1 r2 ~f)) - [@@specialise] + [@@specialise] let rec iter t ~f = match t with @@ -257,14 +257,14 @@ end = struct | Bin (_, l, r) -> iter l ~f; iter r ~f - [@@specialise] + [@@specialise] let rec fold t ~init ~f = match t with | Nil -> init | Tip (k, v) -> f k v init | Bin (_, l, r) -> fold r ~f ~init:(fold l ~init ~f) - [@@specialise] + [@@specialise] let rec max_elt = function | Nil -> None @@ -1164,7 +1164,7 @@ module Dict = struct let compare k1 k2 = let k1 = uid k1 and k2 = uid k2 in (Uid.compare [@inlined]) k1 k2 - [@@inline] + [@@inline] let name x = x.name let to_sexp x = x.show @@ -1240,7 +1240,7 @@ module Dict = struct | () when contains a b c d -> Contains | () when equals a b c d -> Equals | () -> assert false - [@@inline] + [@@inline] end (** Extension of the Allen's Algebra over points. @@ -1268,7 +1268,7 @@ module Dict = struct | () when finishes p a b -> Finishes | () when after p a b -> After | () -> assert false - [@@inline] + [@@inline] end end @@ -1354,7 +1354,7 @@ module Dict = struct let ( <$ ) k1 k2 = let k1 = Key.uid k1 and k2 = Key.uid k2 in (Key.Uid.( < ) [@inlined]) k1 k2 - [@@inline] + [@@inline] let make0 = T0 [@@inlined] let make1 k a = T1 (k, a) [@@inline] @@ -1364,27 +1364,27 @@ module Dict = struct let make5 ka a kb b kc c kd d ke e = EQ (make2 ka a kb b, kc, c, make2 kd d ke e) - [@@inline] + [@@inline] let make6 ka a kb b kc c kd d ke e kf f = EQ (T2 (ka, a, kb, b), kc, c, T3 (kd, d, ke, e, kf, f)) - [@@inline] + [@@inline] let make7 ka a kb b kc c kd d ke e kf f kg g = EQ (T3 (ka, a, kb, b, kc, c), kd, d, T3 (ke, e, kf, f, kg, g)) - [@@inline] + [@@inline] let make8 ka a kb b kc c kd d ke e kf f kg g kh h = EQ (T3 (ka, a, kb, b, kc, c), kd, d, T4 (ke, e, kf, f, kg, g, kh, h)) - [@@inline] + [@@inline] let make9 ka a kb b kc c kd d ke e kf f kg g kh h ki i = EQ (T4 (ka, a, kb, b, kc, c, kd, d), ke, e, T4 (kf, f, kg, g, kh, h, ki, i)) - [@@inline] + [@@inline] let make10 ka a kb b kc c kd d ke e kf f kg g kh h ki i kj j = LL (make4 ka a kb b kc c kd d, ke, e, make5 kf f kg g kh h ki i kj j) - [@@inline] + [@@inline] type 'r visitor = { visit : 'a. 'a key -> 'a -> 'r -> 'r } @@ -1475,7 +1475,7 @@ module Dict = struct *) EQ (EQ (w, ka, a, x), kb, b, LL (y, kc, c, z)) | r -> raise (Rol_wrong_rank r) - [@@inline] + [@@inline] let ror = function | LR (LR (x, ka, a, y), kb, b, z) -> @@ -1540,7 +1540,7 @@ module Dict = struct *) EQ (LR (w, ka, a, x), kb, b, EQ (y, kc, c, z)) | r -> raise (Ror_wrong_rank r) - [@@inline] + [@@inline] let rank_increases was now = match (was, now) with @@ -1551,7 +1551,7 @@ module Dict = struct | EQ _, LL _ | EQ _, LR _ -> true | LR _, LL _ | LL _, LR _ -> false | _ -> false - [@@inline] + [@@inline] (* [p += c] updates the right subtree of [p] with [c]. pre: rank p > 1 /\ rank c > 1 *) @@ -1564,7 +1564,7 @@ module Dict = struct | EQ (b, k, x, c) -> if rank_increases c c' then LL (b, k, x, c') else EQ (b, k, x, c') | _ -> failwith "+=: rank < 2" - [@@inline] + [@@inline] (* [b =+ p] updates the left subtree of [p] with [b]. pre: rank p > 1 /\ rank b > 1 *) @@ -1577,7 +1577,7 @@ module Dict = struct | EQ (b, k, x, c) -> if rank_increases b b' then LR (b', k, x, c) else EQ (b', k, x, c) | _ -> failwith "=+: rank < 2" - [@@inline] + [@@inline] (* pre: - a is not in t; @@ -1695,7 +1695,7 @@ module Dict = struct upsert ka a x ~update:(fun k -> ret @@ fun f -> LR (k f, kb, b, y)) ~insert:(fun x -> add (x =+ t))) - [@@specialise] + [@@specialise] let monomorphic_merge : type t. t key -> (t -> t -> t) -> merge = fun k f -> @@ -1705,12 +1705,12 @@ module Dict = struct let T = Key.same k kb in f b a); } - [@@specialise] + [@@specialise] let update f ka a x = let f = monomorphic_merge ka f in upsert ka a x ~update:(fun k -> k f) ~insert:(fun x -> x) - [@@specialise] + [@@specialise] let set ka a x = let f = monomorphic_merge ka (fun _ x -> x) in @@ -1721,7 +1721,7 @@ module Dict = struct let return (type a b) (k : a key) (ka : b key) (a : b) : a = let T = Key.same k ka in a - [@@inline] + [@@inline] let rec get k = function | T0 -> raise Field_not_found @@ -1767,7 +1767,7 @@ module Dict = struct | 0 -> make1 ka (app m ka kb b a) | 1 -> make2 kb b ka a | _ -> make2 ka a kb b - [@@inline] + [@@inline] let merge_12 m ka a kb b kc c = match Key.Point.relate ka kb kc with @@ -1776,7 +1776,7 @@ module Dict = struct | During -> make3 kb b ka a kc c | Finishes -> make2 kb b ka (app m ka kc c a) | After -> make3 kb b kc c ka a - [@@inline] + [@@inline] let merge_13 m ka a kb b kc c kd d = match Key.Point.relate ka kb kd with @@ -1789,7 +1789,7 @@ module Dict = struct | 0 -> make3 kb b kc (app m kc ka a c) kd d | 1 -> make4 kb b kc c ka a kd d | _ -> make4 kb b ka a kc c kd d) - [@@inline] + [@@inline] let merge_22 m ka a kb b kc c kd d = match Key.Interval.relate ka kb kc kd with @@ -1806,7 +1806,7 @@ module Dict = struct | During -> make4 kc c ka a kb b kd d | Contains -> make4 ka a kc c kd d kb b | Equals -> make2 ka (app m ka kc c a) kb (app m kb kd d b) - [@@inline] + [@@inline] let merge m x y = if phys_equal x y then x @@ -1820,7 +1820,7 @@ module Dict = struct | T3 (kb, b, kc, c, kd, d), T1 (ka, a) -> merge_13 m ka a kb b kc c kd d | T2 (ka, a, kb, b), T2 (kc, c, kd, d) -> merge_22 m ka a kb b kc c kd d | _ -> fold_merge m x y - [@@inline] + [@@inline] let sexp_of_t dict = Sexp.List @@ -2127,7 +2127,7 @@ module Knowledge = struct type _ error = conflict let fail p : 'a t = { run = (fun ~reject ~accept:_ _ -> reject p) } - [@@inline] + [@@inline] let catch x err = { @@ -2135,13 +2135,13 @@ module Knowledge = struct (fun ~reject ~accept s -> x.run s ~accept ~reject:(fun p -> (err p).run ~reject ~accept s)); } - [@@inline] + [@@inline] include Monad.Make (struct type 'a t = 'a knowledge let return x : 'a t = { run = (fun ~reject:_ ~accept s -> accept x s) } - [@@inline] + [@@inline] let bind : 'a t -> ('a -> 'b t) -> 'b t = fun x f -> @@ -2150,7 +2150,7 @@ module Knowledge = struct (fun ~reject ~accept s -> x.run s ~reject ~accept:(fun x s -> (f x).run ~reject ~accept s)); } - [@@inline] + [@@inline] let map : 'a t -> f:('a -> 'b) -> 'b t = fun x ~f -> @@ -2159,7 +2159,7 @@ module Knowledge = struct (fun ~reject ~accept s -> x.run s ~reject ~accept:(fun x s -> accept (f x) s)); } - [@@inline] + [@@inline] let map = `Custom map end) @@ -2352,22 +2352,22 @@ module Knowledge = struct let get () : state knowledge = { run = (fun ~reject:_ ~accept s -> accept s s) } - [@@inline] + [@@inline] let put s = { run = (fun ~reject:_ ~accept _ -> accept () s) } [@@inline] let gets f = { run = (fun ~reject:_ ~accept s -> accept (f s) s) } - [@@inline] [@@specialise] + [@@inline] [@@specialise] let update f = { run = (fun ~reject:_ ~accept s -> accept () (f s)) } - [@@inline] [@@specialise] + [@@inline] [@@specialise] let objects { Class.name } = get () >>| fun { classes } -> match Map.find classes name with | None -> Env.empty_class | Some objs -> objs - [@@inline] + [@@inline] let update_objects { Class.name } f = update @@ fun state -> @@ -2379,7 +2379,7 @@ module Knowledge = struct | Some objs -> objs in { state with classes = Map.set state.classes name objs } - [@@specialise] + [@@specialise] let map_update_objects { Class.name } f = get () >>= fun state -> @@ -2391,7 +2391,7 @@ module Knowledge = struct f objs @@ fun objs res -> put { state with classes = Map.set state.classes name objs } >>| fun () -> res - [@@specialise] + [@@specialise] module Object = struct type +'a t = 'a obj @@ -2692,7 +2692,7 @@ module Knowledge = struct type slot_status = Sleep | Awoke | Ready of Dict.record let is_empty { Slot.dom; key } v = Domain.is_empty dom (Record.get key dom v) - [@@inline] + [@@inline] let status : ('a, _) slot -> 'a obj -> slot_status knowledge = fun slot obj -> @@ -2974,7 +2974,7 @@ module Knowledge = struct | None -> accept None s | Some x -> (f x).run ~accept ~reject s)); } - [@@inline] [@@specialise] + [@@inline] [@@specialise] let ( >>|? ) x f = { @@ -2983,7 +2983,7 @@ module Knowledge = struct x.run s ~reject ~accept:(fun x s -> match x with None -> accept None s | Some x -> accept (f x) s)); } - [@@inline] [@@specialise] + [@@inline] [@@specialise] let ( let*? ) = ( >>=? ) let ( let+? ) = ( >>|? ) @@ -2995,7 +2995,7 @@ module Knowledge = struct x.run s ~reject ~accept:(fun x s -> y.run s ~reject ~accept:(fun y s -> accept (x, y) s))); } - [@@inline] [@@specialise] + [@@inline] [@@specialise] let ( and* ) = ( and+ ) let ( .$[] ) v s = Value.get s v diff --git a/bench/drivers/ppx_sexp_conv/inputs/bap_knowledge.ml b/bench/drivers/ppx_sexp_conv/inputs/bap_knowledge.ml index ba7e05881..8e6e9e4d8 100644 --- a/bench/drivers/ppx_sexp_conv/inputs/bap_knowledge.ml +++ b/bench/drivers/ppx_sexp_conv/inputs/bap_knowledge.ml @@ -137,7 +137,7 @@ end = struct let m = one lsl to_int bit in let y = k' lor (m - one) land lnot m in if x = y then if k' land m = zero then LB else RB else NA - [@@inline] + [@@inline] let equal { key = k1 } { key = k2 } = equal k1 k2 [@@inline] @@ -196,7 +196,7 @@ end = struct | NA -> join (Tip (k, nil ())) k t (Key.payload k') | LB -> Bin (k', update_with l k ~has ~nil, r) | RB -> Bin (k', l, update_with r k ~has ~nil)) - [@@specialise] + [@@specialise] let rec update t k ~f = match t with @@ -208,7 +208,7 @@ end = struct | NA -> join (Tip (k, f None)) k t (Key.payload k') | LB -> Bin (k', update l k f, r) | RB -> Bin (k', l, update r k f)) - [@@specialise] + [@@specialise] let rec set t k v = match t with @@ -248,7 +248,7 @@ end = struct | LB -> if is_zero ~bit:b2 k1 then Bin (p2, merge t1 l2 ~f, r2) else Bin (p2, l2, merge t1 r2 ~f)) - [@@specialise] + [@@specialise] let rec iter t ~f = match t with @@ -257,14 +257,14 @@ end = struct | Bin (_, l, r) -> iter l ~f; iter r ~f - [@@specialise] + [@@specialise] let rec fold t ~init ~f = match t with | Nil -> init | Tip (k, v) -> f k v init | Bin (_, l, r) -> fold r ~f ~init:(fold l ~init ~f) - [@@specialise] + [@@specialise] let rec max_elt = function | Nil -> None @@ -1164,7 +1164,7 @@ module Dict = struct let compare k1 k2 = let k1 = uid k1 and k2 = uid k2 in (Uid.compare [@inlined]) k1 k2 - [@@inline] + [@@inline] let name x = x.name let to_sexp x = x.show @@ -1240,7 +1240,7 @@ module Dict = struct | () when contains a b c d -> Contains | () when equals a b c d -> Equals | () -> assert false - [@@inline] + [@@inline] end (** Extension of the Allen's Algebra over points. @@ -1268,7 +1268,7 @@ module Dict = struct | () when finishes p a b -> Finishes | () when after p a b -> After | () -> assert false - [@@inline] + [@@inline] end end @@ -1354,7 +1354,7 @@ module Dict = struct let ( <$ ) k1 k2 = let k1 = Key.uid k1 and k2 = Key.uid k2 in (Key.Uid.( < ) [@inlined]) k1 k2 - [@@inline] + [@@inline] let make0 = T0 [@@inlined] let make1 k a = T1 (k, a) [@@inline] @@ -1364,27 +1364,27 @@ module Dict = struct let make5 ka a kb b kc c kd d ke e = EQ (make2 ka a kb b, kc, c, make2 kd d ke e) - [@@inline] + [@@inline] let make6 ka a kb b kc c kd d ke e kf f = EQ (T2 (ka, a, kb, b), kc, c, T3 (kd, d, ke, e, kf, f)) - [@@inline] + [@@inline] let make7 ka a kb b kc c kd d ke e kf f kg g = EQ (T3 (ka, a, kb, b, kc, c), kd, d, T3 (ke, e, kf, f, kg, g)) - [@@inline] + [@@inline] let make8 ka a kb b kc c kd d ke e kf f kg g kh h = EQ (T3 (ka, a, kb, b, kc, c), kd, d, T4 (ke, e, kf, f, kg, g, kh, h)) - [@@inline] + [@@inline] let make9 ka a kb b kc c kd d ke e kf f kg g kh h ki i = EQ (T4 (ka, a, kb, b, kc, c, kd, d), ke, e, T4 (kf, f, kg, g, kh, h, ki, i)) - [@@inline] + [@@inline] let make10 ka a kb b kc c kd d ke e kf f kg g kh h ki i kj j = LL (make4 ka a kb b kc c kd d, ke, e, make5 kf f kg g kh h ki i kj j) - [@@inline] + [@@inline] type 'r visitor = { visit : 'a. 'a key -> 'a -> 'r -> 'r } @@ -1475,7 +1475,7 @@ module Dict = struct *) EQ (EQ (w, ka, a, x), kb, b, LL (y, kc, c, z)) | r -> raise (Rol_wrong_rank r) - [@@inline] + [@@inline] let ror = function | LR (LR (x, ka, a, y), kb, b, z) -> @@ -1540,7 +1540,7 @@ module Dict = struct *) EQ (LR (w, ka, a, x), kb, b, EQ (y, kc, c, z)) | r -> raise (Ror_wrong_rank r) - [@@inline] + [@@inline] let rank_increases was now = match (was, now) with @@ -1551,7 +1551,7 @@ module Dict = struct | EQ _, LL _ | EQ _, LR _ -> true | LR _, LL _ | LL _, LR _ -> false | _ -> false - [@@inline] + [@@inline] (* [p += c] updates the right subtree of [p] with [c]. pre: rank p > 1 /\ rank c > 1 *) @@ -1564,7 +1564,7 @@ module Dict = struct | EQ (b, k, x, c) -> if rank_increases c c' then LL (b, k, x, c') else EQ (b, k, x, c') | _ -> failwith "+=: rank < 2" - [@@inline] + [@@inline] (* [b =+ p] updates the left subtree of [p] with [b]. pre: rank p > 1 /\ rank b > 1 *) @@ -1577,7 +1577,7 @@ module Dict = struct | EQ (b, k, x, c) -> if rank_increases b b' then LR (b', k, x, c) else EQ (b', k, x, c) | _ -> failwith "=+: rank < 2" - [@@inline] + [@@inline] (* pre: - a is not in t; @@ -1695,7 +1695,7 @@ module Dict = struct upsert ka a x ~update:(fun k -> ret @@ fun f -> LR (k f, kb, b, y)) ~insert:(fun x -> add (x =+ t))) - [@@specialise] + [@@specialise] let monomorphic_merge : type t. t key -> (t -> t -> t) -> merge = fun k f -> @@ -1705,12 +1705,12 @@ module Dict = struct let T = Key.same k kb in f b a); } - [@@specialise] + [@@specialise] let update f ka a x = let f = monomorphic_merge ka f in upsert ka a x ~update:(fun k -> k f) ~insert:(fun x -> x) - [@@specialise] + [@@specialise] let set ka a x = let f = monomorphic_merge ka (fun _ x -> x) in @@ -1721,7 +1721,7 @@ module Dict = struct let return (type a b) (k : a key) (ka : b key) (a : b) : a = let T = Key.same k ka in a - [@@inline] + [@@inline] let rec get k = function | T0 -> raise Field_not_found @@ -1767,7 +1767,7 @@ module Dict = struct | 0 -> make1 ka (app m ka kb b a) | 1 -> make2 kb b ka a | _ -> make2 ka a kb b - [@@inline] + [@@inline] let merge_12 m ka a kb b kc c = match Key.Point.relate ka kb kc with @@ -1776,7 +1776,7 @@ module Dict = struct | During -> make3 kb b ka a kc c | Finishes -> make2 kb b ka (app m ka kc c a) | After -> make3 kb b kc c ka a - [@@inline] + [@@inline] let merge_13 m ka a kb b kc c kd d = match Key.Point.relate ka kb kd with @@ -1789,7 +1789,7 @@ module Dict = struct | 0 -> make3 kb b kc (app m kc ka a c) kd d | 1 -> make4 kb b kc c ka a kd d | _ -> make4 kb b ka a kc c kd d) - [@@inline] + [@@inline] let merge_22 m ka a kb b kc c kd d = match Key.Interval.relate ka kb kc kd with @@ -1806,7 +1806,7 @@ module Dict = struct | During -> make4 kc c ka a kb b kd d | Contains -> make4 ka a kc c kd d kb b | Equals -> make2 ka (app m ka kc c a) kb (app m kb kd d b) - [@@inline] + [@@inline] let merge m x y = if phys_equal x y then x @@ -1820,7 +1820,7 @@ module Dict = struct | T3 (kb, b, kc, c, kd, d), T1 (ka, a) -> merge_13 m ka a kb b kc c kd d | T2 (ka, a, kb, b), T2 (kc, c, kd, d) -> merge_22 m ka a kb b kc c kd d | _ -> fold_merge m x y - [@@inline] + [@@inline] let sexp_of_t dict = Sexp.List @@ -2127,7 +2127,7 @@ module Knowledge = struct type _ error = conflict let fail p : 'a t = { run = (fun ~reject ~accept:_ _ -> reject p) } - [@@inline] + [@@inline] let catch x err = { @@ -2135,13 +2135,13 @@ module Knowledge = struct (fun ~reject ~accept s -> x.run s ~accept ~reject:(fun p -> (err p).run ~reject ~accept s)); } - [@@inline] + [@@inline] include Monad.Make (struct type 'a t = 'a knowledge let return x : 'a t = { run = (fun ~reject:_ ~accept s -> accept x s) } - [@@inline] + [@@inline] let bind : 'a t -> ('a -> 'b t) -> 'b t = fun x f -> @@ -2150,7 +2150,7 @@ module Knowledge = struct (fun ~reject ~accept s -> x.run s ~reject ~accept:(fun x s -> (f x).run ~reject ~accept s)); } - [@@inline] + [@@inline] let map : 'a t -> f:('a -> 'b) -> 'b t = fun x ~f -> @@ -2159,7 +2159,7 @@ module Knowledge = struct (fun ~reject ~accept s -> x.run s ~reject ~accept:(fun x s -> accept (f x) s)); } - [@@inline] + [@@inline] let map = `Custom map end) @@ -2352,22 +2352,22 @@ module Knowledge = struct let get () : state knowledge = { run = (fun ~reject:_ ~accept s -> accept s s) } - [@@inline] + [@@inline] let put s = { run = (fun ~reject:_ ~accept _ -> accept () s) } [@@inline] let gets f = { run = (fun ~reject:_ ~accept s -> accept (f s) s) } - [@@inline] [@@specialise] + [@@inline] [@@specialise] let update f = { run = (fun ~reject:_ ~accept s -> accept () (f s)) } - [@@inline] [@@specialise] + [@@inline] [@@specialise] let objects { Class.name } = get () >>| fun { classes } -> match Map.find classes name with | None -> Env.empty_class | Some objs -> objs - [@@inline] + [@@inline] let update_objects { Class.name } f = update @@ fun state -> @@ -2379,7 +2379,7 @@ module Knowledge = struct | Some objs -> objs in { state with classes = Map.set state.classes name objs } - [@@specialise] + [@@specialise] let map_update_objects { Class.name } f = get () >>= fun state -> @@ -2391,7 +2391,7 @@ module Knowledge = struct f objs @@ fun objs res -> put { state with classes = Map.set state.classes name objs } >>| fun () -> res - [@@specialise] + [@@specialise] module Object = struct type +'a t = 'a obj @@ -2692,7 +2692,7 @@ module Knowledge = struct type slot_status = Sleep | Awoke | Ready of Dict.record let is_empty { Slot.dom; key } v = Domain.is_empty dom (Record.get key dom v) - [@@inline] + [@@inline] let status : ('a, _) slot -> 'a obj -> slot_status knowledge = fun slot obj -> @@ -2974,7 +2974,7 @@ module Knowledge = struct | None -> accept None s | Some x -> (f x).run ~accept ~reject s)); } - [@@inline] [@@specialise] + [@@inline] [@@specialise] let ( >>|? ) x f = { @@ -2983,7 +2983,7 @@ module Knowledge = struct x.run s ~reject ~accept:(fun x s -> match x with None -> accept None s | Some x -> accept (f x) s)); } - [@@inline] [@@specialise] + [@@inline] [@@specialise] let ( let*? ) = ( >>=? ) let ( let+? ) = ( >>|? ) @@ -2995,7 +2995,7 @@ module Knowledge = struct x.run s ~reject ~accept:(fun x s -> y.run s ~reject ~accept:(fun y s -> accept (x, y) s))); } - [@@inline] [@@specialise] + [@@inline] [@@specialise] let ( and* ) = ( and+ ) let ( .$[] ) v s = Value.get s v diff --git a/src/ast_builder_intf.ml b/src/ast_builder_intf.ml index d95c17e13..652828d93 100644 --- a/src/ast_builder_intf.ml +++ b/src/ast_builder_intf.ml @@ -50,8 +50,8 @@ module type Additional_helpers = sig Asttypes.rec_flag -> value_binding list -> structure_item list - (** [pstr_value_list ~loc rf vbs] = [pstr_value ~loc rf vbs] if [vbs <> \[\]], - [\[\]] otherwise. *) + (** [pstr_value_list ~loc rf vbs] = [pstr_value ~loc rf vbs] if [vbs <> []], + [[]] otherwise. *) val nonrec_type_declaration : (name:string Loc.t -> @@ -62,8 +62,8 @@ module type Additional_helpers = sig manifest:core_type option -> type_declaration) with_loc - [@@deprecated - "[since 2016-10] use Nonrecursive on the P(str|sig)_type instead"] + [@@deprecated + "[since 2016-10] use Nonrecursive on the P(str|sig)_type instead"] val unapplied_type_constr_conv : (Longident.t Loc.t -> f:(string -> string) -> expression) with_loc diff --git a/src/ast_traverse.mli b/src/ast_traverse.mli index e6c7a23e0..0ef0e073c 100644 --- a/src/ast_traverse.mli +++ b/src/ast_traverse.mli @@ -35,35 +35,30 @@ open! Import let string_constants_of_structure = string_constants_of#structure ]} *) -class map : - object - inherit Ppxlib_traverse_builtins.map - inherit Ast.map - end - -class iter : - object - inherit Ppxlib_traverse_builtins.iter - inherit Ast.iter - end - -class ['acc] fold : - object - inherit ['acc] Ppxlib_traverse_builtins.fold - inherit ['acc] Ast.fold - end - -class ['acc] fold_map : - object - inherit ['acc] Ppxlib_traverse_builtins.fold_map - inherit ['acc] Ast.fold_map - end - -class ['ctx] map_with_context : - object - inherit ['ctx] Ppxlib_traverse_builtins.map_with_context - inherit ['ctx] Ast.map_with_context - end +class map : object + inherit Ppxlib_traverse_builtins.map + inherit Ast.map +end + +class iter : object + inherit Ppxlib_traverse_builtins.iter + inherit Ast.iter +end + +class ['acc] fold : object + inherit ['acc] Ppxlib_traverse_builtins.fold + inherit ['acc] Ast.fold +end + +class ['acc] fold_map : object + inherit ['acc] Ppxlib_traverse_builtins.fold_map + inherit ['acc] Ast.fold_map +end + +class ['ctx] map_with_context : object + inherit ['ctx] Ppxlib_traverse_builtins.map_with_context + inherit ['ctx] Ast.map_with_context +end class map_with_path : [string] map_with_context @@ -79,33 +74,28 @@ val do_not_enter_module_type_declaration : val do_not_enter_let_module : (expression, unit) Attribute.t -class virtual ['res] lift : - object - inherit ['res] Ppxlib_traverse_builtins.lift - inherit ['res] Ast.lift - end - -class virtual ['ctx, 'res] lift_map_with_context : - object - inherit ['ctx, 'res] Ppxlib_traverse_builtins.lift_map_with_context - inherit ['ctx, 'res] Ast.lift_map_with_context - end - -class map_with_expansion_context_and_errors : - object - inherit - [Expansion_context.Base.t, Location.Error.t list] Ppxlib_traverse_builtins - .std_lift_mappers_with_context - - inherit - [Expansion_context.Base.t, Location.Error.t list] Ast - .lift_map_with_context - end - -class sexp_of : - object - inherit [Sexp.t] Ppxlib_traverse_builtins.std_lifters - inherit [Sexp.t] Ast.lift - end +class virtual ['res] lift : object + inherit ['res] Ppxlib_traverse_builtins.lift + inherit ['res] Ast.lift +end + +class virtual ['ctx, 'res] lift_map_with_context : object + inherit ['ctx, 'res] Ppxlib_traverse_builtins.lift_map_with_context + inherit ['ctx, 'res] Ast.lift_map_with_context +end + +class map_with_expansion_context_and_errors : object + inherit + [Expansion_context.Base.t, Location.Error.t list] Ppxlib_traverse_builtins + .std_lift_mappers_with_context + + inherit + [Expansion_context.Base.t, Location.Error.t list] Ast.lift_map_with_context +end + +class sexp_of : object + inherit [Sexp.t] Ppxlib_traverse_builtins.std_lifters + inherit [Sexp.t] Ast.lift +end val sexp_of : sexp_of diff --git a/src/ast_traverse0.mli b/src/ast_traverse0.mli index 6ce0d44b1..1f27e2adc 100644 --- a/src/ast_traverse0.mli +++ b/src/ast_traverse0.mli @@ -1,37 +1,31 @@ open! Import -class map : - object - inherit Ppxlib_traverse_builtins.map - inherit Ast.map - end +class map : object + inherit Ppxlib_traverse_builtins.map + inherit Ast.map +end -class iter : - object - inherit Ppxlib_traverse_builtins.iter - inherit Ast.iter - end +class iter : object + inherit Ppxlib_traverse_builtins.iter + inherit Ast.iter +end -class ['acc] fold : - object - inherit ['acc] Ppxlib_traverse_builtins.fold - inherit ['acc] Ast.fold - end +class ['acc] fold : object + inherit ['acc] Ppxlib_traverse_builtins.fold + inherit ['acc] Ast.fold +end -class ['acc] fold_map : - object - inherit ['acc] Ppxlib_traverse_builtins.fold_map - inherit ['acc] Ast.fold_map - end +class ['acc] fold_map : object + inherit ['acc] Ppxlib_traverse_builtins.fold_map + inherit ['acc] Ast.fold_map +end -class ['ctx] map_with_context : - object - inherit ['ctx] Ppxlib_traverse_builtins.map_with_context - inherit ['ctx] Ast.map_with_context - end +class ['ctx] map_with_context : object + inherit ['ctx] Ppxlib_traverse_builtins.map_with_context + inherit ['ctx] Ast.map_with_context +end -class virtual ['res] lift : - object - inherit ['res] Ppxlib_traverse_builtins.lift - inherit ['res] Ast.lift - end +class virtual ['res] lift : object + inherit ['res] Ppxlib_traverse_builtins.lift + inherit ['res] Ast.lift +end diff --git a/src/attribute.ml b/src/attribute.ml index 4de54a7cc..92ef8c6f7 100644 --- a/src/attribute.ml +++ b/src/attribute.ml @@ -510,8 +510,7 @@ let collect_unused_attributes_errors = let errors = List.map attrs ~f:(fun - ({ attr_name = name; attr_payload = payload; _ } as attr) - -> + ({ attr_name = name; attr_payload = payload; _ } as attr) -> let collected_errors = self#payload payload [] @ collect_attribute_errors registrar (On_item context) name @@ -695,8 +694,8 @@ let check_unused = | [] -> node | _ -> List.iter attrs - ~f:(fun ({ attr_name = name; attr_payload = payload; _ } as attr) - -> + ~f:(fun + ({ attr_name = name; attr_payload = payload; _ } as attr) -> self#payload payload; check_attribute registrar (On_item context) name; (* If we allow the attribute to pass through, mark it as seen *) diff --git a/src/attribute.mli b/src/attribute.mli index fad528f23..6b6166fe9 100644 --- a/src/attribute.mli +++ b/src/attribute.mli @@ -97,8 +97,8 @@ val declare : names: "default", "bar.default" and "foo.bar.default". Additionally it is possible to prevent a suffix to be shortened by prefixing - it with '\@'. So for instance an attribute declared with name - "foo.\@bar.default" will match exactly these attribute names: "bar.default" + it with '@'. So for instance an attribute declared with name + "foo.@bar.default" will match exactly these attribute names: "bar.default" and "foo.bar.default". When matching against a list of attributes on an item, if several matches diff --git a/src/common.mli b/src/common.mli index d09d0f58e..72e1a507e 100644 --- a/src/common.mli +++ b/src/common.mli @@ -37,15 +37,12 @@ val get_type_param_name : core_type * (variance * injectivity) -> string Loc.t is really a recursive type. We disregard recursive occurrences appearing in arrow types. You can override the search for certain type expressions by inheriting from this class. *) -class type_is_recursive : - rec_flag - -> type_declaration list - -> object - inherit Ast_traverse0.iter - val type_names : string list - method return_true : unit -> unit - method go : unit -> rec_flag - end +class type_is_recursive : rec_flag -> type_declaration list -> object + inherit Ast_traverse0.iter + val type_names : string list + method return_true : unit -> unit + method go : unit -> rec_flag +end val really_recursive : rec_flag -> type_declaration list -> rec_flag (** [really_recursive rec_flag tds = (new type_is_recursive rec_flag tds)#go ()] *) diff --git a/src/context_free.mli b/src/context_free.mli index 5d9726b11..d68727610 100644 --- a/src/context_free.mli +++ b/src/context_free.mli @@ -146,11 +146,11 @@ end parser should be fixed. *) class map_top_down : ?expect_mismatch_handler: - Expect_mismatch_handler.t (* default: Expect_mismatch_handler.nop *) - -> ?generated_code_hook: - Generated_code_hook.t (* default: Generated_code_hook.nop *) - -> Rule.t list - -> embed_errors:bool - -> object - inherit Ast_traverse.map_with_expansion_context_and_errors - end + Expect_mismatch_handler.t (* default: Expect_mismatch_handler.nop *) -> + ?generated_code_hook: + Generated_code_hook.t (* default: Generated_code_hook.nop *) -> + Rule.t list -> + embed_errors:bool -> +object + inherit Ast_traverse.map_with_expansion_context_and_errors +end diff --git a/src/driver.ml b/src/driver.ml index c95eea78a..659df1d3f 100644 --- a/src/driver.ml +++ b/src/driver.ml @@ -429,7 +429,7 @@ let register_transformation ?extensions ?rules ?enclose_impl ?enclose_intf ?impl let register_code_transformation ~name ?(aliases = []) ~impl ~intf = register_transformation name ~impl ~intf ~aliases - [@@warning "-16"] +[@@warning "-16"] (* This function triggers a warning 16 as of ocaml 4.12 *) let register_transformation_using_ocaml_current_ast ?impl ?intf = @@ -474,13 +474,13 @@ let get_whole_ast_passes ~embed_errors ~hook ~expect_mismatch_handler ~tool_name in (* Allow only one preprocessor to assure deterministic order *) (if List.length preprocess > 1 then - let pp = - String.concat ~sep:", " (List.map preprocess ~f:(fun t -> t.name)) - in - let err = - Printf.sprintf "At most one preprocessor is allowed, while got: %s" pp - in - failwith err); + let pp = + String.concat ~sep:", " (List.map preprocess ~f:(fun t -> t.name)) + in + let err = + Printf.sprintf "At most one preprocessor is allowed, while got: %s" pp + in + failwith err); let make_generic transforms = if !no_merge then List.map transforms @@ -541,8 +541,8 @@ let apply_transforms ~tool_name ~file_path ~field ~lint_field ~dropped_so_far in let acc = List.fold_left cts ~init:(ast, [], [], []) - ~f:(fun (ast, dropped, (lint_errors : _ list), errors) (ct : Transform.t) - -> + ~f:(fun + (ast, dropped, (lint_errors : _ list), errors) (ct : Transform.t) -> let input_name = match input_name with | Some input_name -> input_name @@ -677,11 +677,11 @@ let map_structure_gen st ~tool_name ~hook ~expect_mismatch_handler ~input_name in let not_seen_errors = Attribute.collect_unseen_errors () in (if !perform_locations_check then - let open Location_check in - ignore - ((enforce_invariants !loc_fname)#structure st - Non_intersecting_ranges.empty - : Non_intersecting_ranges.t)); + let open Location_check in + ignore + ((enforce_invariants !loc_fname)#structure st + Non_intersecting_ranges.empty + : Non_intersecting_ranges.t)); unused_attributes_errors @ unused_extension_errors @ not_seen_errors) else [] in @@ -753,11 +753,11 @@ let map_signature_gen sg ~tool_name ~hook ~expect_mismatch_handler ~input_name in let not_seen_errors = Attribute.collect_unseen_errors () in (if !perform_locations_check then - let open Location_check in - ignore - ((enforce_invariants !loc_fname)#signature sg - Non_intersecting_ranges.empty - : Non_intersecting_ranges.t)); + let open Location_check in + ignore + ((enforce_invariants !loc_fname)#signature sg + Non_intersecting_ranges.empty + : Non_intersecting_ranges.t)); unused_attributes_errors @ unused_extension_errors @ not_seen_errors) else [] in @@ -1023,10 +1023,11 @@ module File_property = struct Some (t.name, t.sexp_of_t v)) end -module Create_file_property (Name : sig - val name : string -end) -(T : Sexpable.S) = +module Create_file_property + (Name : sig + val name : string + end) + (T : Sexpable.S) = struct let t : _ File_property.t = { name = Name.name; data = None; sexp_of_t = T.sexp_of_t } diff --git a/src/driver.mli b/src/driver.mli index 41a759828..49e9e9a60 100644 --- a/src/driver.mli +++ b/src/driver.mli @@ -149,7 +149,7 @@ val register_code_transformation : impl:(structure -> structure) -> intf:(signature -> signature) -> unit - [@@deprecated "[since 2015-11] use register_transformation instead"] +[@@deprecated "[since 2015-11] use register_transformation instead"] (** Same as: {[ @@ -217,10 +217,11 @@ end In the future we could also use this to directly compute the dependencies and pass them here, to avoid calling ocamldep separately. *) -module Create_file_property (Name : sig - val name : string -end) -(T : Sexpable.S) : sig +module Create_file_property + (Name : sig + val name : string + end) + (T : Sexpable.S) : sig val set : T.t -> unit end diff --git a/src/location_check.mli b/src/location_check.mli index 22cd2ac0a..6a744fca2 100644 --- a/src/location_check.mli +++ b/src/location_check.mli @@ -44,7 +44,7 @@ but [B2] has a ghost location, then [B1], [X] and [Y] are considered siblings. - Additionally, there is an attribute [\[@merlin.hide\]] that you can add on + Additionally, there is an attribute [[@merlin.hide]] that you can add on nodes to tell merlin (and the check) to ignore this node and all of its children. Some helpers for this are provided in {!Merlin_helpers}. *) diff --git a/src/merlin_helpers.mli b/src/merlin_helpers.mli index bb6a942fb..cd1a077ae 100644 --- a/src/merlin_helpers.mli +++ b/src/merlin_helpers.mli @@ -9,12 +9,12 @@ open! Import (** {2 Annotations merlin understand} *) val hide_attribute : attribute -(** Adding this [\[@merlin.hide\]] attribute on a piece of AST "hides" it from +(** Adding this [[@merlin.hide]] attribute on a piece of AST "hides" it from merlin: it tells merlin not to consider that branch if another piece of AST with the same location exist. *) val focus_attribute : attribute -(** Adding this [\[@merlin.focus\]] attribute on a piece of AST tells merlin to +(** Adding this [[@merlin.focus]] attribute on a piece of AST tells merlin to prefer it to any other piece of AST when several have the same location. *) (** {2 Helpers} diff --git a/src/spellcheck.ml b/src/spellcheck.ml index 81242883f..c07801c1f 100644 --- a/src/spellcheck.ml +++ b/src/spellcheck.ml @@ -58,8 +58,8 @@ let spellcheck names name = in let _, suggestions = List.fold_left names ~init:(Int.max_int, []) - ~f:(fun ((best_distance, names_at_best_distance) as acc) registered_name - -> + ~f:(fun + ((best_distance, names_at_best_distance) as acc) registered_name -> match levenshtein_distance name registered_name cutoff with | None -> acc | Some dist -> diff --git a/traverse/ppxlib_traverse.ml b/traverse/ppxlib_traverse.ml index eade5547f..48e21caf7 100644 --- a/traverse/ppxlib_traverse.ml +++ b/traverse/ppxlib_traverse.ml @@ -54,31 +54,27 @@ module Backends = struct method tuple ~loc es = pexp_tuple ~loc es end - class type what = - object - method name : string - inherit reconstructors - - method class_params : - loc:Location.t -> (core_type * (variance * injectivity)) list - - method virtual_methods : loc:Location.t -> class_field list - - method apply : - loc:Location.t -> expression -> expression list -> expression - - method abstract : loc:Location.t -> pattern -> expression -> expression - - (* Basic combinator type *) - method typ : loc:Location.t -> core_type -> core_type - method any : loc:Location.t -> expression - - method combine : - loc:Location.t -> - (string loc * expression) list -> - reconstruct:expression -> - expression - end + class type what = object + method name : string + inherit reconstructors + + method class_params : + loc:Location.t -> (core_type * (variance * injectivity)) list + + method virtual_methods : loc:Location.t -> class_field list + method apply : loc:Location.t -> expression -> expression list -> expression + method abstract : loc:Location.t -> pattern -> expression -> expression + + (* Basic combinator type *) + method typ : loc:Location.t -> core_type -> core_type + method any : loc:Location.t -> expression + + method combine : + loc:Location.t -> + (string loc * expression) list -> + reconstruct:expression -> + expression + end let mapper : what = object diff --git a/traverse_builtins/ppxlib_traverse_builtins.ml b/traverse_builtins/ppxlib_traverse_builtins.ml index 5ebb63fbf..be8b847e7 100644 --- a/traverse_builtins/ppxlib_traverse_builtins.ml +++ b/traverse_builtins/ppxlib_traverse_builtins.ml @@ -208,55 +208,53 @@ class virtual ['ctx, 'res] lift_map_with_context = (x :: l, self#constr ctx "::" [ res_head; res_tail ]) end -class type ['res] std_lifters = - object - method other : 'a. ('a, 'res) T.lift - method int : (int, 'res) T.lift - method string : (string, 'res) T.lift - method bool : (bool, 'res) T.lift - method char : (char, 'res) T.lift - method array : 'a. ('a, 'res) T.lift -> ('a array, 'res) T.lift - method record : (string * 'res) list -> 'res - method constr : string -> 'res list -> 'res - method tuple : 'res list -> 'res - method float : (float, 'res) T.lift - method int32 : (int32, 'res) T.lift - method int64 : (int64, 'res) T.lift - method nativeint : (nativeint, 'res) T.lift - method unit : (unit, 'res) T.lift - method option : 'a. ('a, 'res) T.lift -> ('a option, 'res) T.lift - method list : 'a. ('a, 'res) T.lift -> ('a list, 'res) T.lift - end +class type ['res] std_lifters = object + method other : 'a. ('a, 'res) T.lift + method int : (int, 'res) T.lift + method string : (string, 'res) T.lift + method bool : (bool, 'res) T.lift + method char : (char, 'res) T.lift + method array : 'a. ('a, 'res) T.lift -> ('a array, 'res) T.lift + method record : (string * 'res) list -> 'res + method constr : string -> 'res list -> 'res + method tuple : 'res list -> 'res + method float : (float, 'res) T.lift + method int32 : (int32, 'res) T.lift + method int64 : (int64, 'res) T.lift + method nativeint : (nativeint, 'res) T.lift + method unit : (unit, 'res) T.lift + method option : 'a. ('a, 'res) T.lift -> ('a option, 'res) T.lift + method list : 'a. ('a, 'res) T.lift -> ('a list, 'res) T.lift +end -class type ['ctx, 'res] std_lift_mappers_with_context = - object - method other : 'a. 'ctx -> 'a -> 'res - method int : ('ctx, int, 'res) T.lift_map_with_context - method string : ('ctx, string, 'res) T.lift_map_with_context - method bool : ('ctx, bool, 'res) T.lift_map_with_context - method char : ('ctx, char, 'res) T.lift_map_with_context - - method array : - 'a. - ('ctx, 'a, 'res) T.lift_map_with_context -> - ('ctx, 'a array, 'res) T.lift_map_with_context - - method record : 'ctx -> (string * 'res) list -> 'res - method constr : 'ctx -> string -> 'res list -> 'res - method tuple : 'ctx -> 'res list -> 'res - method float : ('ctx, float, 'res) T.lift_map_with_context - method int32 : ('ctx, int32, 'res) T.lift_map_with_context - method int64 : ('ctx, int64, 'res) T.lift_map_with_context - method nativeint : ('ctx, nativeint, 'res) T.lift_map_with_context - method unit : ('ctx, unit, 'res) T.lift_map_with_context - - method option : - 'a. - ('ctx, 'a, 'res) T.lift_map_with_context -> - ('ctx, 'a option, 'res) T.lift_map_with_context - - method list : - 'a. - ('ctx, 'a, 'res) T.lift_map_with_context -> - ('ctx, 'a list, 'res) T.lift_map_with_context - end +class type ['ctx, 'res] std_lift_mappers_with_context = object + method other : 'a. 'ctx -> 'a -> 'res + method int : ('ctx, int, 'res) T.lift_map_with_context + method string : ('ctx, string, 'res) T.lift_map_with_context + method bool : ('ctx, bool, 'res) T.lift_map_with_context + method char : ('ctx, char, 'res) T.lift_map_with_context + + method array : + 'a. + ('ctx, 'a, 'res) T.lift_map_with_context -> + ('ctx, 'a array, 'res) T.lift_map_with_context + + method record : 'ctx -> (string * 'res) list -> 'res + method constr : 'ctx -> string -> 'res list -> 'res + method tuple : 'ctx -> 'res list -> 'res + method float : ('ctx, float, 'res) T.lift_map_with_context + method int32 : ('ctx, int32, 'res) T.lift_map_with_context + method int64 : ('ctx, int64, 'res) T.lift_map_with_context + method nativeint : ('ctx, nativeint, 'res) T.lift_map_with_context + method unit : ('ctx, unit, 'res) T.lift_map_with_context + + method option : + 'a. + ('ctx, 'a, 'res) T.lift_map_with_context -> + ('ctx, 'a option, 'res) T.lift_map_with_context + + method list : + 'a. + ('ctx, 'a, 'res) T.lift_map_with_context -> + ('ctx, 'a list, 'res) T.lift_map_with_context +end From 4bc92e46b219e225925a4e81f86f6e0a7ad57027 Mon Sep 17 00:00:00 2001 From: Nathan Rebours Date: Thu, 1 Feb 2024 10:34:51 +0100 Subject: [PATCH 2/2] Update .git-blame-ignore-revs Signed-off-by: Nathan Rebours --- .git-blame-ignore-revs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/.git-blame-ignore-revs b/.git-blame-ignore-revs index a2ee08316..731e7a7c2 100644 --- a/.git-blame-ignore-revs +++ b/.git-blame-ignore-revs @@ -6,3 +6,6 @@ #The commit upgrading to ocamlformat 0.24.1 0970c3a7f91291bd92eb277331b5b6af20b608e9 + +#The commit upgrading to ocamlformat.0.26.1 +dab938d3e6f316c20cc141aaff534a0f5f0ab70f