From 2cd1d44b59dc1c0712953412f1ba016ee76c9bcc Mon Sep 17 00:00:00 2001 From: Sacha Ayoun Date: Fri, 13 Dec 2024 16:59:52 +0100 Subject: [PATCH] add flag to control space around high precedence infix Signed-off-by: Sacha Ayoun --- lib/Conf.ml | 17 +++++++++++++++++ lib/Conf_t.ml | 1 + lib/Conf_t.mli | 1 + lib/Fmt_ast.ml | 14 +++++++------- test/cli/print_config.t | 3 +++ test/passing/gen/dune.inc | 18 ++++++++++++++++++ .../space_around_high_precedence_infix.ml.ref | 5 +++++ .../space_around_high_precedence_infix.ml.err | 1 + .../space_around_high_precedence_infix.ml.ref | 4 ++++ .../space_around_high_precedence_infix.ml.ref | 5 +++++ .../space_around_high_precedence_infix.ml | 4 ++++ .../space_around_high_precedence_infix.ml.opts | 1 + 12 files changed, 67 insertions(+), 7 deletions(-) create mode 100644 test/passing/refs.default/space_around_high_precedence_infix.ml.ref create mode 100644 test/passing/refs.janestreet/space_around_high_precedence_infix.ml.err create mode 100644 test/passing/refs.janestreet/space_around_high_precedence_infix.ml.ref create mode 100644 test/passing/refs.ocamlformat/space_around_high_precedence_infix.ml.ref create mode 100644 test/passing/tests/space_around_high_precedence_infix.ml create mode 100644 test/passing/tests/space_around_high_precedence_infix.ml.opts diff --git a/lib/Conf.ml b/lib/Conf.ml index 04cf9fa406..48abd0a525 100644 --- a/lib/Conf.ml +++ b/lib/Conf.ml @@ -103,6 +103,7 @@ let conventional_profile from = ; sequence_style= elt `Terminator ; single_case= elt `Compact ; space_around_arrays= elt true + ; space_around_high_precedence_infix= elt false ; space_around_lists= elt true ; space_around_records= elt true ; space_around_variants= elt true @@ -172,6 +173,7 @@ let ocamlformat_profile from = ; sequence_style= elt `Separator ; single_case= elt `Compact ; space_around_arrays= elt false + ; space_around_high_precedence_infix= elt false ; space_around_lists= elt false ; space_around_records= elt false ; space_around_variants= elt false @@ -240,6 +242,7 @@ let janestreet_profile from = ; sequence_style= elt `Terminator ; single_case= elt `Sparse ; space_around_arrays= elt true + ; space_around_high_precedence_infix= elt false ; space_around_lists= elt true ; space_around_records= elt true ; space_around_variants= elt true @@ -1220,6 +1223,19 @@ module Formatting = struct update conf ~f:(fun f -> {f with space_around_arrays= elt}) ) (fun conf -> conf.fmt_opts.space_around_arrays) + let space_around_high_precedence_infix = + let doc = + "Use space around high precedence infix operators (which start with a \ + #). If false, no space is used to indicate high precedence (e.g. \ + 'a##b')" + in + let names = ["space-around-high-precedence-infix"] in + Decl.flag ~names ~default ~doc ~kind ~allow_inline:false + (fun conf elt -> + update conf ~f:(fun f -> + {f with space_around_high_precedence_infix= elt} ) ) + (fun conf -> conf.fmt_opts.space_around_high_precedence_infix) + let space_around_lists = let doc = "Add a space inside the delimiters of lists." in let names = ["space-around-lists"] in @@ -1357,6 +1373,7 @@ module Formatting = struct ; elt sequence_style ; elt single_case ; elt space_around_arrays + ; elt space_around_high_precedence_infix ; elt space_around_lists ; elt space_around_records ; elt space_around_variants diff --git a/lib/Conf_t.ml b/lib/Conf_t.ml index 0958eb2ad2..f5a89fc44c 100644 --- a/lib/Conf_t.ml +++ b/lib/Conf_t.ml @@ -111,6 +111,7 @@ type fmt_opts = ; sequence_style: [`Before | `Separator | `Terminator] elt ; single_case: [`Compact | `Sparse] elt ; space_around_arrays: bool elt + ; space_around_high_precedence_infix: bool elt ; space_around_lists: bool elt ; space_around_records: bool elt ; space_around_variants: bool elt diff --git a/lib/Conf_t.mli b/lib/Conf_t.mli index a8a8bf87da..2de6045342 100644 --- a/lib/Conf_t.mli +++ b/lib/Conf_t.mli @@ -109,6 +109,7 @@ type fmt_opts = ; sequence_style: [`Before | `Separator | `Terminator] elt ; single_case: [`Compact | `Sparse] elt ; space_around_arrays: bool elt + ; space_around_high_precedence_infix: bool elt ; space_around_lists: bool elt ; space_around_records: bool elt ; space_around_variants: bool elt diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml index 32d28a9688..d2f572b76a 100644 --- a/lib/Fmt_ast.ml +++ b/lib/Fmt_ast.ml @@ -1793,6 +1793,10 @@ and fmt_infix_op_args c ~parens xexp op_args = let op_prec_higher_than_apply = match op_prec with Some p -> Prec.compare p Apply > 0 | None -> false in + let space_around_op = + c.conf.fmt_opts.space_around_high_precedence_infix.v + || not op_prec_higher_than_apply + in let groups = let width xe = expression_width c xe in let not_simple arg = not (is_simple c.conf width arg) in @@ -1859,10 +1863,7 @@ and fmt_infix_op_args c ~parens xexp op_args = let pro, before_arg = let break = if very_last && is_not_indented xarg then space_break - else - fmt_if - ((not very_first) && not op_prec_higher_than_apply) - (str " ") + else fmt_if ((not very_first) && space_around_op) (str " ") in match cmts_after with | Some c -> (noop, hovbox 0 (op $ space_break $ c)) @@ -1870,9 +1871,8 @@ and fmt_infix_op_args c ~parens xexp op_args = in fmt_opt cmts_before $ before_arg $ fmt_arg ~pro ~very_last xarg - $ fmt_if ((not last) && not op_prec_higher_than_apply) (break 1 0) ) - ) - $ fmt_if ((not last_grp) && not op_prec_higher_than_apply) (break 1 0) + $ fmt_if ((not last) && space_around_op) (break 1 0) ) ) + $ fmt_if ((not last_grp) && space_around_op) (break 1 0) in Params.Exp.Infix_op_arg.wrap c.conf ~parens ~parens_nested:(Ast.parenze_nested_exp xexp) diff --git a/test/cli/print_config.t b/test/cli/print_config.t index 1f608ef9d9..824b19f3cd 100644 --- a/test/cli/print_config.t +++ b/test/cli/print_config.t @@ -75,6 +75,7 @@ No redundant values: sequence-style=terminator (profile conventional (file .ocamlformat:1)) single-case=compact (profile conventional (file .ocamlformat:1)) space-around-arrays=true (profile conventional (file .ocamlformat:1)) + space-around-high-precedence-infix=false (profile conventional (file .ocamlformat:1)) space-around-lists=true (profile conventional (file .ocamlformat:1)) space-around-records=true (profile conventional (file .ocamlformat:1)) space-around-variants=true (profile conventional (file .ocamlformat:1)) @@ -154,6 +155,7 @@ Redundant values from the conventional profile: sequence-style=terminator (profile conventional (file .ocamlformat:1)) single-case=compact (profile conventional (file .ocamlformat:1)) space-around-arrays=true (profile conventional (file .ocamlformat:1)) + space-around-high-precedence-infix=false (profile conventional (file .ocamlformat:1)) space-around-lists=true (profile conventional (file .ocamlformat:1)) space-around-records=true (profile conventional (file .ocamlformat:1)) space-around-variants=true (profile conventional (file .ocamlformat:1)) @@ -233,6 +235,7 @@ Redundant values from the ocamlformat profile: sequence-style=separator (profile ocamlformat (file .ocamlformat:1)) single-case=compact (profile ocamlformat (file .ocamlformat:1)) space-around-arrays=false (profile ocamlformat (file .ocamlformat:1)) + space-around-high-precedence-infix=false (profile ocamlformat (file .ocamlformat:1)) space-around-lists=false (profile ocamlformat (file .ocamlformat:1)) space-around-records=false (profile ocamlformat (file .ocamlformat:1)) space-around-variants=false (profile ocamlformat (file .ocamlformat:1)) diff --git a/test/passing/gen/dune.inc b/test/passing/gen/dune.inc index 32446352e3..d112955e4e 100644 --- a/test/passing/gen/dune.inc +++ b/test/passing/gen/dune.inc @@ -5077,6 +5077,24 @@ (package ocamlformat) (action (diff source.ml.err source.ml.stderr))) +(rule + (deps .ocamlformat) + (package ocamlformat) + (action + (with-stdout-to space_around_high_precedence_infix.ml.stdout + (with-stderr-to space_around_high_precedence_infix.ml.stderr + (run %{bin:ocamlformat} --name space_around_high_precedence_infix.ml --margin-check --space-around-high-precedence-infix %{dep:../tests/space_around_high_precedence_infix.ml}))))) + +(rule + (alias runtest) + (package ocamlformat) + (action (diff space_around_high_precedence_infix.ml.ref space_around_high_precedence_infix.ml.stdout))) + +(rule + (alias runtest) + (package ocamlformat) + (action (diff space_around_high_precedence_infix.ml.err space_around_high_precedence_infix.ml.stderr))) + (rule (deps .ocamlformat) (package ocamlformat) diff --git a/test/passing/refs.default/space_around_high_precedence_infix.ml.ref b/test/passing/refs.default/space_around_high_precedence_infix.ml.ref new file mode 100644 index 0000000000..879f5a78d9 --- /dev/null +++ b/test/passing/refs.default/space_around_high_precedence_infix.ml.ref @@ -0,0 +1,5 @@ +let formula_base x = + let open Formula.Infix in + (Expr.typeof x) #== (Lit (Type IntType)) + #&& (x #<= (Expr.int 4)) + #&& ((Expr.int 0) #< x) diff --git a/test/passing/refs.janestreet/space_around_high_precedence_infix.ml.err b/test/passing/refs.janestreet/space_around_high_precedence_infix.ml.err new file mode 100644 index 0000000000..1cc623a2cd --- /dev/null +++ b/test/passing/refs.janestreet/space_around_high_precedence_infix.ml.err @@ -0,0 +1 @@ +Warning: space_around_high_precedence_infix.ml:2 exceeds the margin diff --git a/test/passing/refs.janestreet/space_around_high_precedence_infix.ml.ref b/test/passing/refs.janestreet/space_around_high_precedence_infix.ml.ref new file mode 100644 index 0000000000..450b304294 --- /dev/null +++ b/test/passing/refs.janestreet/space_around_high_precedence_infix.ml.ref @@ -0,0 +1,4 @@ +let formula_base x = + let open Formula.Infix in + (Expr.typeof x) #== (Lit (Type IntType)) #&& (x #<= (Expr.int 4)) #&& ((Expr.int 0) #< x) +;; diff --git a/test/passing/refs.ocamlformat/space_around_high_precedence_infix.ml.ref b/test/passing/refs.ocamlformat/space_around_high_precedence_infix.ml.ref new file mode 100644 index 0000000000..879f5a78d9 --- /dev/null +++ b/test/passing/refs.ocamlformat/space_around_high_precedence_infix.ml.ref @@ -0,0 +1,5 @@ +let formula_base x = + let open Formula.Infix in + (Expr.typeof x) #== (Lit (Type IntType)) + #&& (x #<= (Expr.int 4)) + #&& ((Expr.int 0) #< x) diff --git a/test/passing/tests/space_around_high_precedence_infix.ml b/test/passing/tests/space_around_high_precedence_infix.ml new file mode 100644 index 0000000000..6657ddbcd7 --- /dev/null +++ b/test/passing/tests/space_around_high_precedence_infix.ml @@ -0,0 +1,4 @@ +let formula_base x = + let open Formula.Infix in (Expr.typeof x) #== (Lit (Type IntType)) + #&& (x #<= (Expr.int 4)) + #&& ((Expr.int 0) #< x) \ No newline at end of file diff --git a/test/passing/tests/space_around_high_precedence_infix.ml.opts b/test/passing/tests/space_around_high_precedence_infix.ml.opts new file mode 100644 index 0000000000..57eb984c8d --- /dev/null +++ b/test/passing/tests/space_around_high_precedence_infix.ml.opts @@ -0,0 +1 @@ +--space-around-high-precedence-infix \ No newline at end of file