Attach some comments

Signed-off-by: Etienne Millon <me@emillon.org>

src/dune_fmt.ml

@@ -44,23 +44,42 @@ let print_wrapped_list fmt =
       pp_simple
     )
 
-let pp_comment_line last fmt l =
-  Format.fprintf fmt "; %s" l;
-  if last then
-    Format.fprintf fmt "@ "
+let pp_comment_line fmt l =
+  Format.fprintf fmt "; %s" l
 
-let pp_comment loc ~last:last_in_list fmt (comment:Dune_lang.Cst.Comment.t) =
+let pp_comment loc fmt (comment:Dune_lang.Cst.Comment.t) =
   match comment with
   | Lines ls ->
-    Fmt.list_special
-      ~pp_sep:(fun fmt () -> Format.fprintf fmt "@ ")
-      (fun ~last -> pp_comment_line (last && last_in_list))
-      fmt
+    Format.fprintf fmt "@[<v 0>%a@]"
+      (Fmt.list
+         ~pp_sep:(fun fmt () -> Format.fprintf fmt "@;")
+         pp_comment_line)
       ls
   | Legacy ->
     Errors.fail loc "Formatting is only supported with the dune syntax"
 
-let rec pp_sexp ~last fmt : Dune_lang.Cst.t -> _ =
+let pp_list_with_comments pp_sexp fmt sexps =
+  let rec go fmt (l:Dune_lang.Cst.t list) =
+    match l with
+    | x :: ([Comment _ ] as xs) ->
+      Format.fprintf fmt "%a@,%a" pp_sexp x go xs
+    | x :: ((Comment (loc, c) :: xs) as xs0) ->
+      let attached = Loc.on_same_line (Dune_lang.Cst.loc x) loc in
+      if attached then
+        Format.fprintf fmt "%a %a@,%a" pp_sexp x (pp_comment loc) c go xs
+      else
+        Format.fprintf fmt "%a@,%a" pp_sexp x go xs0
+    | Comment (loc, c)::xs ->
+      Format.fprintf fmt "%a@,%a" (pp_comment loc) c go xs
+    | [x] ->
+      Format.fprintf fmt "%a" pp_sexp x;
+    | x :: xs ->
+      Format.fprintf fmt "%a@,%a" pp_sexp x go xs
+    | [] -> ()
+  in
+  go fmt sexps
+
+let rec pp_sexp fmt : Dune_lang.Cst.t -> _ =
   function
   | ( Atom _
     | Quoted_string _
@@ -78,15 +97,14 @@ let rec pp_sexp ~last fmt : Dune_lang.Cst.t -> _ =
       sexps
   | Comment (loc, c)
     ->
-    pp_comment loc ~last fmt c
+    pp_comment loc fmt c
 
 and pp_sexp_list fmt =
-  let pp_sep fmt () = Format.fprintf fmt "@," in
   Format.fprintf fmt "(%a)"
-    (Fmt.list_special ~pp_sep pp_sexp)
+    (pp_list_with_comments pp_sexp)
 
 let pp_top_sexp fmt sexp =
-  Format.fprintf fmt "%a\n" (pp_sexp ~last:false) sexp
+  Format.fprintf fmt "%a\n" pp_sexp sexp
 
 let pp_top_sexps =
   Fmt.list ~pp_sep:Fmt.nl pp_top_sexp

src/stdune/fmt.ml

@@ -22,14 +22,6 @@ let failwith fmt = kstrf failwith fmt
 
 let list = Format.pp_print_list
 
-let rec list_special ~pp_sep pp fmt = function
-  | [] -> ()
-  | [v] -> pp ~last:true fmt v
-  | v :: vs ->
-    pp ~last:false fmt v;
-    pp_sep fmt ();
-    list_special ~pp_sep pp fmt vs
-
 let string s ppf = Format.pp_print_string ppf s
 
 let text = Format.pp_print_text

src/stdune/fmt.mli

@@ -2,9 +2,6 @@ type 'a t = Format.formatter -> 'a -> unit
 
 val list : ?pp_sep:unit t -> 'a t -> 'a list t
 
-(** Like [list], but the printer gets an extra argument for the last element *)
-val list_special : pp_sep:unit t -> (last:bool -> 'a t) -> 'a list t
-
 val failwith : ('a, Format.formatter, unit, 'b) format4 -> 'a
 
 val string : string -> Format.formatter -> unit

src/stdune/loc.ml

@@ -159,3 +159,10 @@ let pp_file_excerpt ~context_lines ~max_lines_to_print_in_full
         file (Exn.pp_uncaught ~backtrace) exn
     | Ok () -> ()
   end
+
+let on_same_line loc1 loc2 =
+  let start1 = loc1.start in
+  let start2 = loc2.start in
+  let same_file = String.equal start1.pos_fname start2.pos_fname in
+  let same_line = Int.equal start1.pos_lnum start2.pos_lnum in
+  same_file && same_line

src/stdune/loc.mli

@@ -30,3 +30,5 @@ val pp_file_excerpt
   -> Format.formatter
   -> t
   -> unit
+
+val on_same_line : t -> t -> bool

test/blackbox-tests/test-cases/fmt/run.t

@@ -101,22 +101,37 @@ Comments are preserved.
 
   $ dune unstable-fmt <<EOF
   > ; comment
-  > (a b;comment
-  > c;multi
+  > (;first comment
+  > a b;comment for b
+  > ccc;multi
   > ;line
-  > ;comment
-  > d)
+  > ;comment for ccc
+  > d
+  > e
+  > ; unattached comment
+  > f
+  > ; unattached
+  > ; multi-line
+  > ; comment
+  > g
+  > )
   > EOF
   ;  comment
   
-  (a
-   b
-   ; comment
-   c
-   ; multi
-   ; line
-   ; comment
-   d)
+  (; first comment
+   a
+   b ; comment for b
+   ccc ; multi
+       ; line
+       ; comment for ccc
+   d
+   e
+   ;  unattached comment
+   f
+   ;  unattached
+   ;  multi-line
+   ;  comment
+   g)
 
 When a comment is at the end of a list, the ")" is on a own line.