diff --git a/.ocamlformat b/.ocamlformat index d20e3da59..3f39f6d4f 100644 --- a/.ocamlformat +++ b/.ocamlformat @@ -1,3 +1,3 @@ -version=0.27.0 +version=0.28.1 profile=conventional parse-docstrings=true diff --git a/bench/drivers/identity/inputs/bap_knowledge.ml b/bench/drivers/identity/inputs/bap_knowledge.ml index 8e312f4ed..e4c3432b5 100644 --- a/bench/drivers/identity/inputs/bap_knowledge.ml +++ b/bench/drivers/identity/inputs/bap_knowledge.ml @@ -754,11 +754,11 @@ module Domain = struct try Result.return @@ Map.merge x y ~f:(fun ~key:_ -> function - | `Left v | `Right v -> Some v - | `Both (x, y) -> ( - match join x y with - | Error conflict -> raise @@ Join.Conflict conflict - | Ok z -> Some z)) + | `Left v | `Right v -> Some v + | `Both (x, y) -> ( + match join x y with + | Error conflict -> raise @@ Join.Conflict conflict + | Ok z -> Some z)) with Join.Conflict err -> Error err in let inspect xs = @@ -767,9 +767,9 @@ module Domain = struct let order x y = Map.symmetric_diff x y ~data_equal:equal |> Sequence.fold ~init:(0, 0, 0) ~f:(fun (l, m, r) -> function - | _, `Left _ -> (l + 1, m, r) - | _, `Right _ -> (l, m, r + 1) - | _, `Unequal _ -> (l, m + 1, r)) + | _, `Left _ -> (l + 1, m, r) + | _, `Right _ -> (l, m, r + 1) + | _, `Unequal _ -> (l, m + 1, r)) |> function | 0, 0, 0 -> Order.EQ | 0, 0, _ -> LT @@ -1077,9 +1077,8 @@ module Documentation = struct let classes () = Hashtbl.to_alist Registry.public |> List.map ~f:(fun (cls, slots) -> - ( (cls, Registry.(find classes) cls), - List.map slots ~f:(fun slot -> (slot, Registry.(find slots) slot)) - )) + ( (cls, Registry.(find classes) cls), + List.map slots ~f:(fun slot -> (slot, Registry.(find slots) slot)) )) let rules () = Hash_set.to_list Registry.rules end @@ -2882,22 +2881,22 @@ module Knowledge = struct fun cls -> Oid.Tree.to_sequence cls.vals |> Knowledge.Seq.fold ~init:cls ~f:(fun cls (obj, (info : Env.info)) -> - match info.name with - | None -> Knowledge.return cls - | Some sym -> - if not (needs_import cls sym obj) then Knowledge.return cls - else - let obj' = - match Map.find cls.objs { package; name = sym.name } with - | None -> Oid.zero - | Some obj' -> obj' - in - if (not strict) || Oid.(obj' = zero || obj' = obj) then - intern_symbol sym obj cls - else - let info = Oid.Tree.find_exn cls.vals obj' in - let sym' = Option.value_exn info.name in - Knowledge.fail (Import (sym, sym'))) + match info.name with + | None -> Knowledge.return cls + | Some sym -> + if not (needs_import cls sym obj) then Knowledge.return cls + else + let obj' = + match Map.find cls.objs { package; name = sym.name } with + | None -> Oid.zero + | Some obj' -> obj' + in + if (not strict) || Oid.(obj' = zero || obj' = obj) then + intern_symbol sym obj cls + else + let info = Oid.Tree.find_exn cls.vals obj' in + let sym' = Option.value_exn info.name in + Knowledge.fail (Import (sym, sym'))) let package_exists package = Map.exists ~f:(fun { Env.objs } -> @@ -3021,7 +3020,7 @@ module Knowledge = struct fun cls obj -> Slot.enum cls |> Base.List.filter ~f:(function Slot.Pack { promises } -> - not (Hashtbl.is_empty promises)) + not (Hashtbl.is_empty promises)) |> List.iter ~f:(fun (Slot.Pack s) -> ignore_m @@ collect s obj) let get_value cls obj = @@ -3154,15 +3153,15 @@ module Knowledge = struct let payload = Map.to_alist classes |> List.map ~f:(fun (cid, { Env.vals; last }) -> - let data = - Oid.Tree.to_list vals - |> List.filter_map ~f:(fun (oid, { Env.data; name; comp }) -> - let data = serialize_record data in - let comp = Map.keys comp in - if Array.is_empty data && Option.is_none name then None - else Some { key = oid; sym = name; data; comp }) - in - (cid, (last, data))) + let data = + Oid.Tree.to_list vals + |> List.filter_map ~f:(fun (oid, { Env.data; name; comp }) -> + let data = serialize_record data in + let comp = Map.keys comp in + if Array.is_empty data && Option.is_none name then None + else Some { key = oid; sym = name; data; comp }) + in + (cid, (last, data))) in { version = V2; payload } diff --git a/bench/drivers/identity/inputs/market_data.ml b/bench/drivers/identity/inputs/market_data.ml index ecacfd0a5..b3ea4fd3f 100644 --- a/bench/drivers/identity/inputs/market_data.ml +++ b/bench/drivers/identity/inputs/market_data.ml @@ -307,7 +307,7 @@ module T = struct | `Auction_indicative_price -> Auction_indicative_price_event.of_yojson json' |> Result.map ~f:(fun event -> - `Auction_indicative_price event) + `Auction_indicative_price event) | `Auction_outcome -> Auction_outcome_event.of_yojson json' |> Result.map ~f:(fun event -> `Auction_outcome event)))) @@ -400,12 +400,12 @@ module T = struct "socket_sequence" ) in (match message_type with - | `Heartbeat -> - heartbeat_of_yojson json' - |> Result.map ~f:(fun event -> `Heartbeat event) - | `Update -> - Update.of_yojson json' - |> Result.map ~f:(fun event -> `Update event)) + | `Heartbeat -> + heartbeat_of_yojson json' + |> Result.map ~f:(fun event -> `Heartbeat event) + | `Update -> + Update.of_yojson json' + |> Result.map ~f:(fun event -> `Update event)) |> Result.map ~f:(fun message -> { socket_sequence; message }))) | #Yojson.Safe.t as json -> Result.failf diff --git a/bench/drivers/ppx_sexp_conv/inputs/bap_knowledge.ml b/bench/drivers/ppx_sexp_conv/inputs/bap_knowledge.ml index 8e312f4ed..e4c3432b5 100644 --- a/bench/drivers/ppx_sexp_conv/inputs/bap_knowledge.ml +++ b/bench/drivers/ppx_sexp_conv/inputs/bap_knowledge.ml @@ -754,11 +754,11 @@ module Domain = struct try Result.return @@ Map.merge x y ~f:(fun ~key:_ -> function - | `Left v | `Right v -> Some v - | `Both (x, y) -> ( - match join x y with - | Error conflict -> raise @@ Join.Conflict conflict - | Ok z -> Some z)) + | `Left v | `Right v -> Some v + | `Both (x, y) -> ( + match join x y with + | Error conflict -> raise @@ Join.Conflict conflict + | Ok z -> Some z)) with Join.Conflict err -> Error err in let inspect xs = @@ -767,9 +767,9 @@ module Domain = struct let order x y = Map.symmetric_diff x y ~data_equal:equal |> Sequence.fold ~init:(0, 0, 0) ~f:(fun (l, m, r) -> function - | _, `Left _ -> (l + 1, m, r) - | _, `Right _ -> (l, m, r + 1) - | _, `Unequal _ -> (l, m + 1, r)) + | _, `Left _ -> (l + 1, m, r) + | _, `Right _ -> (l, m, r + 1) + | _, `Unequal _ -> (l, m + 1, r)) |> function | 0, 0, 0 -> Order.EQ | 0, 0, _ -> LT @@ -1077,9 +1077,8 @@ module Documentation = struct let classes () = Hashtbl.to_alist Registry.public |> List.map ~f:(fun (cls, slots) -> - ( (cls, Registry.(find classes) cls), - List.map slots ~f:(fun slot -> (slot, Registry.(find slots) slot)) - )) + ( (cls, Registry.(find classes) cls), + List.map slots ~f:(fun slot -> (slot, Registry.(find slots) slot)) )) let rules () = Hash_set.to_list Registry.rules end @@ -2882,22 +2881,22 @@ module Knowledge = struct fun cls -> Oid.Tree.to_sequence cls.vals |> Knowledge.Seq.fold ~init:cls ~f:(fun cls (obj, (info : Env.info)) -> - match info.name with - | None -> Knowledge.return cls - | Some sym -> - if not (needs_import cls sym obj) then Knowledge.return cls - else - let obj' = - match Map.find cls.objs { package; name = sym.name } with - | None -> Oid.zero - | Some obj' -> obj' - in - if (not strict) || Oid.(obj' = zero || obj' = obj) then - intern_symbol sym obj cls - else - let info = Oid.Tree.find_exn cls.vals obj' in - let sym' = Option.value_exn info.name in - Knowledge.fail (Import (sym, sym'))) + match info.name with + | None -> Knowledge.return cls + | Some sym -> + if not (needs_import cls sym obj) then Knowledge.return cls + else + let obj' = + match Map.find cls.objs { package; name = sym.name } with + | None -> Oid.zero + | Some obj' -> obj' + in + if (not strict) || Oid.(obj' = zero || obj' = obj) then + intern_symbol sym obj cls + else + let info = Oid.Tree.find_exn cls.vals obj' in + let sym' = Option.value_exn info.name in + Knowledge.fail (Import (sym, sym'))) let package_exists package = Map.exists ~f:(fun { Env.objs } -> @@ -3021,7 +3020,7 @@ module Knowledge = struct fun cls obj -> Slot.enum cls |> Base.List.filter ~f:(function Slot.Pack { promises } -> - not (Hashtbl.is_empty promises)) + not (Hashtbl.is_empty promises)) |> List.iter ~f:(fun (Slot.Pack s) -> ignore_m @@ collect s obj) let get_value cls obj = @@ -3154,15 +3153,15 @@ module Knowledge = struct let payload = Map.to_alist classes |> List.map ~f:(fun (cid, { Env.vals; last }) -> - let data = - Oid.Tree.to_list vals - |> List.filter_map ~f:(fun (oid, { Env.data; name; comp }) -> - let data = serialize_record data in - let comp = Map.keys comp in - if Array.is_empty data && Option.is_none name then None - else Some { key = oid; sym = name; data; comp }) - in - (cid, (last, data))) + let data = + Oid.Tree.to_list vals + |> List.filter_map ~f:(fun (oid, { Env.data; name; comp }) -> + let data = serialize_record data in + let comp = Map.keys comp in + if Array.is_empty data && Option.is_none name then None + else Some { key = oid; sym = name; data; comp }) + in + (cid, (last, data))) in { version = V2; payload } diff --git a/bench/drivers/ppx_sexp_conv/inputs/market_data.ml b/bench/drivers/ppx_sexp_conv/inputs/market_data.ml index ecacfd0a5..b3ea4fd3f 100644 --- a/bench/drivers/ppx_sexp_conv/inputs/market_data.ml +++ b/bench/drivers/ppx_sexp_conv/inputs/market_data.ml @@ -307,7 +307,7 @@ module T = struct | `Auction_indicative_price -> Auction_indicative_price_event.of_yojson json' |> Result.map ~f:(fun event -> - `Auction_indicative_price event) + `Auction_indicative_price event) | `Auction_outcome -> Auction_outcome_event.of_yojson json' |> Result.map ~f:(fun event -> `Auction_outcome event)))) @@ -400,12 +400,12 @@ module T = struct "socket_sequence" ) in (match message_type with - | `Heartbeat -> - heartbeat_of_yojson json' - |> Result.map ~f:(fun event -> `Heartbeat event) - | `Update -> - Update.of_yojson json' - |> Result.map ~f:(fun event -> `Update event)) + | `Heartbeat -> + heartbeat_of_yojson json' + |> Result.map ~f:(fun event -> `Heartbeat event) + | `Update -> + Update.of_yojson json' + |> Result.map ~f:(fun event -> `Update event)) |> Result.map ~f:(fun message -> { socket_sequence; message }))) | #Yojson.Safe.t as json -> Result.failf diff --git a/dune-project b/dune-project index 2bb3a1387..047d0decd 100644 --- a/dune-project +++ b/dune-project @@ -25,7 +25,7 @@ (ocamlfind :with-test) (re (and :with-test (>= 1.9.0))) (cinaps (and :with-test (>= v0.12.1))) - (ocamlformat (and :with-dev-setup (= 0.26.2)))) + (ocamlformat (and :with-dev-setup (= 0.28.1)))) (conflicts (ocaml-migrate-parsetree (< 2.0.0)) (ocaml-base-compiler (= 5.1.0~alpha1)) diff --git a/ppxlib.opam b/ppxlib.opam index 22689098e..4ae8db179 100644 --- a/ppxlib.opam +++ b/ppxlib.opam @@ -30,7 +30,7 @@ depends: [ "ocamlfind" {with-test} "re" {with-test & >= "1.9.0"} "cinaps" {with-test & >= "v0.12.1"} - "ocamlformat" {with-dev-setup & = "0.26.2"} + "ocamlformat" {with-dev-setup & = "0.28.1"} "odoc" {with-doc} ] conflicts: [ diff --git a/src/common.ml b/src/common.ml index 08576aae3..28657c154 100644 --- a/src/common.ml +++ b/src/common.ml @@ -24,8 +24,8 @@ let strip_gen_symbol_suffix = if chop 1 ~or_more:false string pos (Char.equal '_') && chop 3 ~or_more:true string pos (function - | '0' .. '9' -> true - | _ -> false) + | '0' .. '9' -> true + | _ -> false) && chop 2 ~or_more:false string pos (Char.equal '_') then String.prefix string !pos else string @@ -46,17 +46,17 @@ let name_type_params_in_td_res (td : type_declaration) : in let name_param i (tp, variance) = (match tp.ptyp_desc with - | Ptyp_any -> Ok (Ptyp_var (gen_symbol ~prefix:(prefix_string i) ())) - | Ptyp_var _ as v -> Ok v - | _ -> - Error (Location.Error.createf ~loc:tp.ptyp_loc "not a type parameter")) + | Ptyp_any -> Ok (Ptyp_var (gen_symbol ~prefix:(prefix_string i) ())) + | Ptyp_var _ as v -> Ok v + | _ -> + Error (Location.Error.createf ~loc:tp.ptyp_loc "not a type parameter")) >>| fun ptyp_desc -> ({ tp with ptyp_desc }, variance) in let ptype_params, errors = td.ptype_params |> List.mapi ~f:name_param |> List.partition_map (function - | Ok o -> Either.Left o - | Error e -> Either.Right e) + | Ok o -> Either.Left o + | Error e -> Either.Right e) in match errors with [] -> Ok { td with ptype_params } | t :: q -> Error (t, q) diff --git a/src/context_free.ml b/src/context_free.ml index 99e668904..fb7ec7b97 100644 --- a/src/context_free.ml +++ b/src/context_free.ml @@ -390,19 +390,19 @@ let handle_attr_replace_once context attrs item base_ctxt : 'a option t = let rec handle_attr_replace_str attrs item base_ctxt = (match item.pstr_desc with - | Pstr_extension _ -> - handle_attr_replace_once AC.Pstr_extension attrs item base_ctxt - | Pstr_eval _ -> handle_attr_replace_once AC.Pstr_eval attrs item base_ctxt - | _ -> return None) + | Pstr_extension _ -> + handle_attr_replace_once AC.Pstr_extension attrs item base_ctxt + | Pstr_eval _ -> handle_attr_replace_once AC.Pstr_eval attrs item base_ctxt + | _ -> return None) >>= function | Some item -> handle_attr_replace_str attrs item base_ctxt | None -> return item let rec handle_attr_replace_sig attrs item base_ctxt = (match item.psig_desc with - | Psig_extension _ -> - handle_attr_replace_once AC.Psig_extension attrs item base_ctxt - | _ -> return None) + | Psig_extension _ -> + handle_attr_replace_once AC.Psig_extension attrs item base_ctxt + | _ -> return None) >>= function | Some item -> handle_attr_replace_sig attrs item base_ctxt | None -> return item @@ -1015,14 +1015,14 @@ class map_top_down ?(expect_mismatch_handler = Expect_mismatch_handler.nop) let original_rest = rest in loop rest ~in_generated_code >>= fun rest -> (match expect_items with - | [] -> return () - | _ -> - let expected = rev_concat expect_items in - let pos = item.pstr_loc.loc_end in - Code_matcher.match_structure_res original_rest ~pos ~expected - ~mismatch_handler:(fun loc repl -> - expect_mismatch_handler.f Structure_item loc repl) - |> of_result ~default:()) + | [] -> return () + | _ -> + let expected = rev_concat expect_items in + let pos = item.pstr_loc.loc_end in + Code_matcher.match_structure_res original_rest ~pos ~expected + ~mismatch_handler:(fun loc repl -> + expect_mismatch_handler.f Structure_item loc repl) + |> of_result ~default:()) >>| fun () -> item :: (extra_items @ rest) and loop st ~in_generated_code = match st with @@ -1063,13 +1063,13 @@ class map_top_down ?(expect_mismatch_handler = Expect_mismatch_handler.nop) should be only one (outer) list among [expect_items_expanded] unless a single floating attribute is somehow registered twice. *) (match rev_concat expect_items_expanded with - | [] -> return () - | expected -> - Code_matcher.match_structure_res rest - ~pos:item.pstr_loc.loc_end ~expected - ~mismatch_handler: - (expect_mismatch_handler.f Structure_item) - |> of_result ~default:()) + | [] -> return () + | expected -> + Code_matcher.match_structure_res rest + ~pos:item.pstr_loc.loc_end ~expected + ~mismatch_handler: + (expect_mismatch_handler.f Structure_item) + |> of_result ~default:()) >>= fun () -> super#structure_item base_ctxt item >>= fun expanded_item -> loop rest ~in_generated_code >>| fun expanded_rest -> @@ -1156,14 +1156,14 @@ class map_top_down ?(expect_mismatch_handler = Expect_mismatch_handler.nop) let original_rest = rest in loop rest ~in_generated_code >>= fun rest -> (match expect_items with - | [] -> return () - | _ -> - let expected = rev_concat expect_items in - let pos = item.psig_loc.loc_end in - Code_matcher.match_signature_res original_rest ~pos ~expected - ~mismatch_handler:(fun loc repl -> - expect_mismatch_handler.f Signature_item loc repl) - |> of_result ~default:()) + | [] -> return () + | _ -> + let expected = rev_concat expect_items in + let pos = item.psig_loc.loc_end in + Code_matcher.match_signature_res original_rest ~pos ~expected + ~mismatch_handler:(fun loc repl -> + expect_mismatch_handler.f Signature_item loc repl) + |> of_result ~default:()) >>| fun () -> item :: (extra_items @ rest) and loop sg ~in_generated_code = match sg with @@ -1204,13 +1204,13 @@ class map_top_down ?(expect_mismatch_handler = Expect_mismatch_handler.nop) should be only one (outer) list among [expect_items_expanded] unless a single floating attribute is somehow registered twice. *) (match rev_concat expect_items_expanded with - | [] -> return () - | expected -> - Code_matcher.match_signature_res rest - ~pos:item.psig_loc.loc_end ~expected - ~mismatch_handler: - (expect_mismatch_handler.f Signature_item) - |> of_result ~default:()) + | [] -> return () + | expected -> + Code_matcher.match_signature_res rest + ~pos:item.psig_loc.loc_end ~expected + ~mismatch_handler: + (expect_mismatch_handler.f Signature_item) + |> of_result ~default:()) >>= fun () -> super#signature_item base_ctxt item >>= fun expanded_item -> loop rest ~in_generated_code >>| fun expanded_rest -> diff --git a/src/driver.ml b/src/driver.ml index 327fae785..0e67702d9 100644 --- a/src/driver.ml +++ b/src/driver.ml @@ -536,7 +536,7 @@ let get_whole_ast_passes ~embed_errors ~hook ~expect_mismatch_handler ~tool_name ~tool_name ~input_name :: transforms) |> List.filter ~f:(fun (ct : Transform.t) -> - match (ct.impl, ct.intf) with None, None -> false | _ -> true) + match (ct.impl, ct.intf) with None, None -> false | _ -> true) in linters @ preprocess @ before_instrs @ make_generic cts @ after_instrs diff --git a/src/gen/gen_ast_builder.ml b/src/gen/gen_ast_builder.ml index 2275a61d2..2da54363f 100644 --- a/src/gen/gen_ast_builder.ml +++ b/src/gen/gen_ast_builder.ml @@ -288,13 +288,12 @@ let generate filename = List.filter types_with_wrapped ~f:(fun (path, _, _) -> not (List.mem path ~set:wrapped)) |> List.map ~f:(fun (path, td, wrapped) -> - match wrapped with - | None -> (path, td, None) - | Some (prefix, has_attrs, has_loc_stack, p) -> - ( path, - td, - Some (prefix, has_attrs, has_loc_stack, p, List.assoc p types) - )) + match wrapped with + | None -> (path, td, None) + | Some (prefix, has_attrs, has_loc_stack, p) -> + ( path, + td, + Some (prefix, has_attrs, has_loc_stack, p, List.assoc p types) )) in (* let all_types = List.map fst types in*) let types = List.sort types ~cmp:(fun (a, _, _) (b, _, _) -> compare a b) in diff --git a/src/gen/gen_ast_pattern.ml b/src/gen/gen_ast_pattern.ml index 5f078b1cd..c15722ac6 100644 --- a/src/gen/gen_ast_pattern.ml +++ b/src/gen/gen_ast_pattern.ml @@ -233,10 +233,10 @@ let generate filename = List.filter types_with_wrapped ~f:(fun (path, _, _) -> not (List.mem path ~set:wrapped)) |> List.map ~f:(fun (path, td, wrapped) -> - match wrapped with - | None -> (path, td, None) - | Some (prefix, has_attrs, p) -> - (path, td, Some (prefix, has_attrs, p, List.assoc p types))) + match wrapped with + | None -> (path, td, None) + | Some (prefix, has_attrs, p) -> + (path, td, Some (prefix, has_attrs, p, List.assoc p types))) in (* let all_types = List.map fst types in*) let types = List.sort types ~cmp:(fun (a, _, _) (b, _, _) -> compare a b) in diff --git a/src/location_check.ml b/src/location_check.ml index fcabcef06..833deb16e 100644 --- a/src/location_check.ml +++ b/src/location_check.ml @@ -188,8 +188,8 @@ let do_check ~node_name node_loc childrens_locs siblings_locs = outside of this node's.@.Child %s found at:@ %a" node_name ((match String.unsafe_get child_name 0 with - | 'a' | 'e' | 'i' | 'o' | 'u' -> "n " - | _ -> " ") + | 'a' | 'e' | 'i' | 'o' | 'u' -> "n " + | _ -> " ") ^ child_name) child_name Location.print child_loc diff --git a/test/driver/exception_handling/constant_type.ml b/test/driver/exception_handling/constant_type.ml index 6b8efbf6f..606aa7825 100644 --- a/test/driver/exception_handling/constant_type.ml +++ b/test/driver/exception_handling/constant_type.ml @@ -8,6 +8,6 @@ let rewriter loc s = let rule = Context_free.Rule.constant kind 'g' rewriter;; -Driver.register_transformation ~rules:[ rule ] "constant" +Driver.register_transformation ~rules:[ rule ] "constant";; let () = Driver.standalone () diff --git a/test/driver/exception_handling/special_functions.ml b/test/driver/exception_handling/special_functions.ml index 3d3bbc365..d180e889a 100644 --- a/test/driver/exception_handling/special_functions.ml +++ b/test/driver/exception_handling/special_functions.ml @@ -8,6 +8,6 @@ let expand2 e = let rule = Context_free.Rule.special_function "n_args" expand let rule2 = Context_free.Rule.special_function "n_args2" expand2;; -Driver.register_transformation ~rules:[ rule; rule2 ] "special_function_demo" +Driver.register_transformation ~rules:[ rule; rule2 ] "special_function_demo";; let () = Driver.standalone ()