fix up spacing in f a#:b (instead of f a #: b) (#2580)

CHANGES.md

@@ -54,6 +54,7 @@ profile. This started with version 0.26.0.
 - Fix closing `*)` in doc-comments exceeding the margin (#2550, @Julow)
 - Fix invalid syntax geneated for begin..end attributes (#2551, @Julow)
   The attribute is moved from `begin .. end [@attr]` to `begin [@attr] .. end`.
+- Display `a##b` instead of `a ## b` and similarly for operators that start with # (#2580, @v-gb)
 
 ### Changes
 - The location of attributes for structure items is now tracked and preserved. (#2247, @EmileTrotignon)

lib/Fmt_ast.ml

@@ -1655,6 +1655,9 @@ and fmt_sequence c ?ext ~has_attr parens width xexp fmt_atrs =
 
 and fmt_infix_op_args c ~parens xexp op_args =
   let op_prec = prec_ast (Exp xexp.ast) in
+  let op_prec_higher_than_apply =
+    match op_prec with Some p -> Prec.compare p Apply > 0 | None -> false
+  in
   let groups =
     let width xe = expression_width c xe in
     let not_simple arg = not (is_simple c.conf width arg) in
@@ -1724,16 +1727,20 @@ 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) (str " ")
+               else
+                 fmt_if
+                   ((not very_first) && not op_prec_higher_than_apply)
+                   (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) (break 1 0) ) )
-    $ fmt_if (not last_grp) (break 1 0)
+           $ 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)
   in
   Params.Exp.Infix_op_arg.wrap c.conf ~parens
     ~parens_nested:(Ast.parenze_nested_exp xexp)

test/passing/tests/comments-no-wrap.ml.err

@@ -1,4 +1,5 @@
 Warning: tests/comments.ml:186 exceeds the margin
 Warning: tests/comments.ml:190 exceeds the margin
 Warning: tests/comments.ml:250 exceeds the margin
-Warning: tests/comments.ml:434 exceeds the margin
+Warning: tests/comments.ml:401 exceeds the margin
+Warning: tests/comments.ml:433 exceeds the margin

test/passing/tests/comments-no-wrap.ml.ref

@@ -398,10 +398,9 @@ let _ =
   ||
   (* convert from foos to bars blah blah blah blah blah blah blah blah *)
   foooooooooooooooooooooooo foooooooooooooooo
-    fooooooooooooooo
-    #=
-    (* convert from foos to bars blah blah blah blah blah blah blah blah *)
-    foooooooooooooooooooooooo
+    fooooooooooooooo#=
+                    (* convert from foos to bars blah blah blah blah blah blah blah blah *)
+                    foooooooooooooooooooooooo
     foooooooooooooooo fooooooooooooooo
 
 let _ =

test/passing/tests/comments.ml.ref

@@ -400,10 +400,10 @@ let _ =
   ||
   (* convert from foos to bars blah blah blah blah blah blah blah blah *)
   foooooooooooooooooooooooo foooooooooooooooo
-    fooooooooooooooo
-    #=
-    (* convert from foos to bars blah blah blah blah blah blah blah blah *)
-    foooooooooooooooooooooooo
+    fooooooooooooooo#=
+                    (* convert from foos to bars blah blah blah blah blah
+                       blah blah blah *)
+                    foooooooooooooooooooooooo
     foooooooooooooooo fooooooooooooooo
 
 let _ =

test/passing/tests/index_op.ml

@@ -26,9 +26,9 @@ let ( .%() ) x y = x.(y)
 
 let x = [|0|]
 
-let _ = 1 #? x.(0)
+let _ = 1#?x.(0)
 
-let _ = 1 #? x.%(0) ;;
+let _ = 1#?x.%(0) ;;
 
 a.[b].[c] ;;
 

test/passing/tests/infix_bind-break.ml.ref

@@ -232,10 +232,10 @@ let encoder f =
   stagged @@ fun x k : t -> field_encode (f.fget x) k
 
 let default =
-  command ## hasPermission #= (fun ctx -> foooooooooooooooooo fooooooooooo) ;
-  command ## hasPermission
-  #= (fun ctx ->
-  foooooooooooooooooo fooooooooooo foooooo fooooooooo foooooooooo ) ;
+  command##hasPermission#=(fun ctx -> foooooooooooooooooo fooooooooooo) ;
+  command##hasPermission#=(fun ctx ->
+                        foooooooooooooooooo fooooooooooo foooooo fooooooooo
+                          foooooooooo ) ;
   foo
 
 let _ = ( let* ) x (fun y -> z)

test/passing/tests/infix_bind-fit_or_vertical-break.ml.ref

@@ -237,11 +237,10 @@ let encoder f =
   stagged @@ fun x k : t -> field_encode (f.fget x) k
 
 let default =
-  command ## hasPermission #= (fun ctx -> foooooooooooooooooo fooooooooooo) ;
-  command
-  ## hasPermission
-  #= (fun ctx ->
-  foooooooooooooooooo fooooooooooo foooooo fooooooooo foooooooooo ) ;
+  command##hasPermission#=(fun ctx -> foooooooooooooooooo fooooooooooo) ;
+  command##hasPermission#=(fun ctx ->
+                        foooooooooooooooooo fooooooooooo foooooo fooooooooo
+                          foooooooooo ) ;
   foo
 
 let _ = ( let* ) x (fun y -> z)

test/passing/tests/object.ml.ref

@@ -205,7 +205,7 @@ class x =
     (** floatting3 *)
   end
 
-let _ = f ##= (fun x -> x)
+let _ = f##=(fun x -> x)
 
 let o =
   object

test/passing/tests/source-conventional.ml.err

@@ -4,3 +4,4 @@ Warning: tests/source.ml:1225 exceeds the margin
 Warning: tests/source.ml:1342 exceeds the margin
 Warning: tests/source.ml:6617 exceeds the margin
 Warning: tests/source.ml:7075 exceeds the margin
+Warning: tests/source.ml:8652 exceeds the margin

test/passing/tests/source-conventional.ml.ref

@@ -8650,9 +8650,7 @@ let x = A (B).a
 
 let formula_base x =
   let open Formula.Infix in
-  (Expr.typeof x) #== (Lit (Type IntType))
-  #&& (x #<= (Expr.int 4))
-  #&& ((Expr.int 0) #< x)
+  (Expr.typeof x)#==(Lit (Type IntType))#&&(x#<=(Expr.int 4))#&&((Expr.int 0)#<x)
 
 let _ = call ~f:(fun pair : (a * b) -> pair);;
 

test/passing/tests/source.ml.err

@@ -1,2 +1,3 @@
 Warning: tests/source.ml:703 exceeds the margin
 Warning: tests/source.ml:2320 exceeds the margin
+Warning: tests/source.ml:9157 exceeds the margin

test/passing/tests/source.ml.ref

@@ -9155,9 +9155,8 @@ let x = A (B).a
 
 let formula_base x =
   let open Formula.Infix in
-  (Expr.typeof x) #== (Lit (Type IntType))
-  #&& (x #<= (Expr.int 4))
-  #&& ((Expr.int 0) #< x)
+  (Expr.typeof x)#==(Lit (Type IntType))#&&(x#<=(Expr.int 4))#&&( (Expr.int 0)
+                                                                #<x )
 
 let _ = call ~f:(fun pair : (a * b) -> pair) ;;