add flag to control space around high precedence infix

Signed-off-by: Sacha Ayoun <sachaayoun@gmail.com>

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

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

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

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,20 +1863,16 @@ 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))
              | None -> (op $ break, noop)
            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)

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))

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)

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)

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

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)
+;;

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)

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)

test/passing/tests/space_around_high_precedence_infix.ml.opts

@@ -0,0 +1 @@
+--space-around-high-precedence-infix