Merge branch 'main' into let-attr-missing-parens

.github/workflows/build-linux.yml

@@ -51,12 +51,14 @@ jobs:
         run: opam exec -- dune build @gen_manpage --auto-promote
 
       - name: Upload binary
-        uses: actions/upload-artifact@v3
+        # Using a specific version because of https://github.com/actions/upload-artifact/issues/590
+        uses: actions/[email protected]
         with:
           name: ocamlformat-${{ runner.os }}-${{ runner.arch }}
           path: _build/install/default/bin/ocamlformat
 
   test-branch:
+    if: ${{ github.ref != 'refs/heads/main' }}
     needs: build-linux
     runs-on: ubuntu-latest
     strategy:
@@ -98,7 +100,7 @@ jobs:
           path: ocamlformat-a
 
       - name: Fetch new build of ocamlformat
-        uses: actions/download-artifact@v3
+        uses: actions/download-artifact@v4.1.7
         with:
           name: ocamlformat-${{ runner.os }}-${{ runner.arch }}
           path: ocamlformat-b

.github/workflows/build-mingw64.yml

@@ -63,7 +63,7 @@ jobs:
           install/bin/ocamlformat.exe --version
 
       - name: Upload Artifact
-        uses: actions/upload-artifact@v3
+        uses: actions/upload-artifact@v4
         with:
           name: ${{ env.artifact_name }}
           path: ${{ env.artifact_name }}

.vscode/launch.json

@@ -0,0 +1,13 @@
+{
+    "version": "0.2.0",
+    "configurations": [
+        {
+            "name": "OCaml earlybird (experimental)",
+            "type": "ocaml.earlybird",
+            "request": "launch",
+            "program": "${workspaceRoot}/_build/default/bin/ocamlformat/main.bc",
+            "arguments": ["-g", "${workspaceRoot}/test.ml"],
+            "stopOnEntry": true
+        }
+    ]
+}

CHANGES.md

@@ -11,6 +11,7 @@ profile. This started with version 0.26.0.
 - Support OCaml 5.2 syntax (#2519, @Julow)
   This includes:
   + Local open in types.
+- Allow a custom command to be used to run ocamlformat in the emacs plugin (#2577, @gridbugs)
 
 ### Changed
 
@@ -54,6 +55,7 @@ profile. This started with version 0.26.0.
 - Fix invalid syntax generated for begin..end attributes (#2551, @Julow)
   The attribute is moved from `begin .. end [@attr]` to `begin [@attr] .. end`.
 - Fix missing parentheses around `let .. in [@attr]` (#2564, @Julow)
+- 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)

bin/ocamlformat/dune

@@ -18,7 +18,8 @@
   (:standard -open Ocamlformat_stdlib))
  (instrumentation
   (backend bisect_ppx))
- (libraries ocamlformat-lib bin_conf))
+ (libraries ocamlformat-lib bin_conf)
+ (modes byte native))
 
 (rule
  (with-stdout-to

doc/manpage_ocamlformat.mld

@@ -456,12 +456,12 @@ OPTIONS (CODE FORMATTING STYLE)
            attributes.
 
        --wrap-comments
-           Wrap comments and docstrings. Comments and docstrings are divided
-           into paragraphs by open lines (two or more consecutive newlines),
-           and each paragraph is wrapped at the margin. Multi-line comments
-           with vertically-aligned asterisks on the left margin are not
-           wrapped. Consecutive comments with both left and right margin
-           aligned are not wrapped either. The flag is unset by default.
+           Comments are divided into paragraphs by open lines (two or more
+           consecutive newlines), and each paragraph is wrapped at the
+           margin. Multi-line comments with vertically-aligned asterisks on
+           the left margin are not wrapped. Consecutive comments with both
+           left and right margin aligned are not wrapped either. The flag is
+           unset by default.
 
        --wrap-fun-args
            Style for function call. The flag is set by default.

emacs/ocamlformat.el

@@ -48,7 +48,9 @@
 
 (defcustom ocamlformat-command "ocamlformat"
   "The `ocamlformat' command."
-  :type 'string
+  :type '(choice
+	  (string :tag "The name of the ocamlformat executable")
+	  (repeat :tag "The prefix of the command to run to run ocamlformat" string))
   :group 'ocamlformat)
 
 (defcustom ocamlformat-enable 'enable
@@ -266,15 +268,23 @@ is nil."
            ((eq ocamlformat-file-kind 'implementation)
             (list "--impl"))
            ((eq ocamlformat-file-kind 'interface)
-            (list "--intf")))))
+            (list "--intf"))))
+	 (ocamlformat-exe
+	  (if (listp ocamlformat-command)
+	      (car ocamlformat-command)
+	    ocamlformat-command))
+	 (ocamlformat-prefix-args
+	  (if (listp ocamlformat-command)
+	      (cdr ocamlformat-command)
+	    '())))
     (unwind-protect
         (save-restriction
           (widen)
           (write-region nil nil bufferfile)
           (if (zerop
                (apply #'call-process
-                      ocamlformat-command nil (list :file errorfile) nil
-                      (append margin-args enable-args extension-args
+                      ocamlformat-exe nil (list :file errorfile) nil
+                      (append ocamlformat-prefix-args margin-args enable-args extension-args
                               (list
                                "--name" buffer-file-name
                                "--output" outputfile bufferfile))))

lib/Conf.ml

@@ -1289,12 +1289,11 @@ module Formatting = struct
 
   let wrap_comments =
     let doc =
-      "Wrap comments and docstrings. Comments and docstrings are divided \
-       into paragraphs by open lines (two or more consecutive newlines), \
-       and each paragraph is wrapped at the margin. Multi-line comments \
-       with vertically-aligned asterisks on the left margin are not \
-       wrapped. Consecutive comments with both left and right margin \
-       aligned are not wrapped either."
+      "Comments are divided into paragraphs by open lines (two or more \
+       consecutive newlines), and each paragraph is wrapped at the margin. \
+       Multi-line comments with vertically-aligned asterisks on the left \
+       margin are not wrapped. Consecutive comments with both left and \
+       right margin aligned are not wrapped either."
     in
     Decl.flag ~default ~names:["wrap-comments"] ~doc ~kind
       (fun conf elt -> update conf ~f:(fun f -> {f with wrap_comments= elt}))

lib/Fmt.ml

@@ -88,21 +88,34 @@ let with_box_debug k = with_pp (Box_debug.with_box (fun fs -> eval fs k))
 (** Break hints and format strings --------------------------------------*)
 
 let break n o =
+  let stack = Box_debug.get_stack () in
   with_pp (fun fs ->
-      Box_debug.break fs n o ;
+      Box_debug.break fs n o ~stack ;
       Format_.pp_print_break fs n o )
 
 let force_break = break 1000 0
 
-let space_break = with_pp (fun fs -> Format_.pp_print_space fs ())
+let space_break =
+  (* a stack is useless here, this would require adding a unit parameter *)
+  with_pp (fun fs ->
+      Box_debug.space_break fs ;
+      Format_.pp_print_space fs () )
 
-let cut_break = with_pp (fun fs -> Format_.pp_print_cut fs ())
+let cut_break =
+  with_pp (fun fs ->
+      Box_debug.cut_break fs ;
+      Format_.pp_print_cut fs () )
 
-let force_newline = with_pp (fun fs -> Format_.pp_force_newline fs ())
+let force_newline =
+  let stack = Box_debug.get_stack () in
+  with_pp (fun fs ->
+      Box_debug.force_newline ~stack fs ;
+      Format_.pp_force_newline fs () )
 
 let cbreak ~fits ~breaks =
+  let stack = Box_debug.get_stack () in
   with_pp (fun fs ->
-      Box_debug.cbreak fs ~fits ~breaks ;
+      Box_debug.cbreak fs ~stack ~fits ~breaks ;
       Format_.pp_print_custom_break fs ~fits ~breaks )
 
 let noop = with_pp (fun _ -> ())
@@ -127,7 +140,12 @@ let char c = with_pp (fun fs -> Format_.pp_print_char fs c)
 let utf8_length s =
   Uuseg_string.fold_utf_8 `Grapheme_cluster (fun n _ -> n + 1) 0 s
 
-let str_as n s = with_pp (fun fs -> Format_.pp_print_as fs n s)
+let str_as n s =
+  let stack = Box_debug.get_stack () in
+  with_pp (fun fs ->
+      Box_debug.start_str fs ;
+      Format_.pp_print_as fs n s ;
+      Box_debug.end_str ~stack fs )
 
 let str s = if String.is_empty s then noop else str_as (utf8_length s) s
 
@@ -177,22 +195,25 @@ let fmt_opt o = Option.value o ~default:noop
 (** Conditional on immediately following a line break -------------------*)
 
 let if_newline s =
+  let stack = Box_debug.get_stack () in
   with_pp (fun fs ->
-      Box_debug.if_newline fs s ;
+      Box_debug.if_newline fs ~stack s ;
       Format_.pp_print_string_if_newline fs s )
 
 let break_unless_newline n o =
+  let stack = Box_debug.get_stack () in
   with_pp (fun fs ->
-      Box_debug.break_unless_newline fs n o ;
+      Box_debug.break_unless_newline fs ~stack n o ;
       Format_.pp_print_or_newline fs n o "" "" )
 
 (** Conditional on breaking of enclosing box ----------------------------*)
 
 type behavior = Fit | Break
 
 let fits_or_breaks ~level fits nspaces offset breaks =
+  let stack = Box_debug.get_stack () in
   with_pp (fun fs ->
-      Box_debug.fits_or_breaks fs fits nspaces offset breaks ;
+      Box_debug.fits_or_breaks fs ~stack fits nspaces offset breaks ;
       Format_.pp_print_fits_or_breaks fs ~level fits nspaces offset breaks )
 
 let fits_breaks ?force ?(hint = (0, Int.min_value)) ?(level = 0) fits breaks
@@ -236,27 +257,31 @@ let wrap_fits_breaks ?(space = true) conf x =
 let apply_max_indent n = Option.value_map !max_indent ~f:(min n) ~default:n
 
 let open_box ?name n =
+  let stack = Box_debug.get_stack () in
   with_pp (fun fs ->
       let n = apply_max_indent n in
-      Box_debug.box_open ?name "b" n fs ;
+      Box_debug.box_open ~stack ?name "b" n fs ;
       Format_.pp_open_box fs n )
 
 and open_vbox ?name n =
+  let stack = Box_debug.get_stack () in
   with_pp (fun fs ->
       let n = apply_max_indent n in
-      Box_debug.box_open ?name "v" n fs ;
+      Box_debug.box_open ~stack ?name "v" n fs ;
       Format_.pp_open_vbox fs n )
 
 and open_hvbox ?name n =
+  let stack = Box_debug.get_stack () in
   with_pp (fun fs ->
       let n = apply_max_indent n in
-      Box_debug.box_open ?name "hv" n fs ;
+      Box_debug.box_open ~stack ?name "hv" n fs ;
       Format_.pp_open_hvbox fs n )
 
 and open_hovbox ?name n =
+  let stack = Box_debug.get_stack () in
   with_pp (fun fs ->
       let n = apply_max_indent n in
-      Box_debug.box_open ?name "hov" n fs ;
+      Box_debug.box_open ~stack ?name "hov" n fs ;
       Format_.pp_open_hovbox fs n )
 
 and close_box =

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)

lib/Translation_unit.ml

@@ -233,6 +233,7 @@ let check_comments (conf : Conf.t) cmts ~old:t_old ~new_:t_new =
 let format (type ext std) (ext_fg : ext Extended_ast.t)
     (std_fg : std Std_ast.t) ?output_file ~input_name ~prev_source
     ~ext_parsed ~std_parsed (conf : Conf.t) =
+  Box_debug.enable_stacktraces := conf.opr_opts.debug.v ;
   let dump_ast fg ~suffix ast =
     if conf.opr_opts.debug.v then
       Some