JaneStreet profile: treat comments as doc-comments

[gpetiot]

Bringing the janestreet profile closer to what ocp-indent is producing.

Here is how the diff is reduced on the js_source test:

• without handling {v v}:

--- /Users/gp/diff.0	2023-03-02 10:55:26
+++ /Users/gp/diff.2	2023-03-03 16:05:47
@@ -1,5 +1,5 @@
 diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ocp
-index 5dac4eaf..88f6c9d4 100644
+index b27438e7..85b6b08e 100644
 --- a/test/passing/tests/js_source.ml.ref
 +++ b/test/passing/tests/js_source.ml.ocp
 @@ -33,8 +33,8 @@ type var =
@@ -126,15 +126,8 @@
  
  let f (type t) (x : t) (tag : t ty) =
    match tag with
-@@ -908,14 +908,14 @@ let g (type t) (x : t) (tag : t ty) =
- ;;
+@@ -914,8 +914,8 @@ let id x = x
  
- (* Error: This expression has type bool but an expression was expected of type
--t = int *)
-+   t = int *)
- 
- let id x = x
- 
  let idb1 =
    (fun id ->
 -    let _ = id true in
@@ -939,15 +932,6 @@
  struct
    let f (type a) (Neq n : (a, a T.t) eq) = n (* warn! *)
  end
-@@ -2838,7 +2838,7 @@ type _ fin =
-   | FS : 'a fin -> 'a succ fin
- 
- (* We cannot define
--     val empty : zero fin -> 'a
-+   val empty : zero fin -> 'a
-    because we cannot write an empty pattern matching.
-    This might be useful to have *)
- 
 @@ -2873,7 +2873,7 @@ let comp_subst f g (x : 'a fin) = pre_subst f (g x)
  (* 4 The Occur-Check, through thick and thin *)
  
@@ -1094,17 +1078,6 @@
  
  [%%expect {|
  module M_valid : S
-@@ -3212,8 +3212,8 @@ val test_bar : unit -> unit = <fun>
- |}]
- 
- (* Uncomment these to test. Should see substantial speedup!
--let () = Printf.printf "No @@immediate: %fs\n" (test test_foo)
--let () = Printf.printf "With @@immediate: %fs\n" (test test_bar) *)
-+   let () = Printf.printf "No @@immediate: %fs\n" (test test_foo)
-+   let () = Printf.printf "With @@immediate: %fs\n" (test test_bar) *)
- 
- (* INVALID DECLARATIONS *)
- 
 @@ -3223,7 +3223,7 @@ module B = struct
  end
  
@@ -1322,38 +1295,6 @@
  end
  
  (* fails *)
-@@ -4624,20 +4624,20 @@ module M' : module type of Std'.M = Std2.M
- let f3 (x : M'.t) : Std2.M.t = x
- 
- (* original report required Core_kernel:
--module type S = sig
--open Core_kernel.Std
-+   module type S = sig
-+   open Core_kernel.Std
- 
--module Hashtbl1 : module type of Hashtbl
--module Hashtbl2 : sig
--  include (module type of Hashtbl)
--end
-+   module Hashtbl1 : module type of Hashtbl
-+   module Hashtbl2 : sig
-+   include (module type of Hashtbl)
-+   end
- 
--module Coverage : Core_kernel.Std.Hashable
-+   module Coverage : Core_kernel.Std.Hashable
- 
--type types = unit constraint 'a Coverage.Table.t = (Coverage.t, 'a) Hashtbl1.t
--type doesnt_type = unit
--  constraint 'a Coverage.Table.t = (Coverage.t, 'a) Hashtbl2.t
--end
-+   type types = unit constraint 'a Coverage.Table.t = (Coverage.t, 'a) Hashtbl1.t
-+   type doesnt_type = unit
-+   constraint 'a Coverage.Table.t = (Coverage.t, 'a) Hashtbl2.t
-+   end
- *)
- module type INCLUDING = sig
-   include module type of List
 @@ -4693,11 +4693,11 @@ let x = (3 : X2.F(DUMMY)(DUMMY).t)
  let x = (3 : X2.F(DUMMY)(DUMMY).t')
  
@@ -1396,40 +1337,6 @@
  
  let () = flag := false
  
-@@ -4804,20 +4804,20 @@ module type PR6513 = sig
- end
- 
- (* Requires -package tyxml
--module type PR6513_orig = sig
--module type S =
--sig
--        type t
--        type u
--end
-+   module type PR6513_orig = sig
-+   module type S =
-+   sig
-+   type t
-+   type u
-+   end
- 
--module Make: functor (Html5: Html5_sigs.T
--                             with type 'a Xml.wrap = 'a and
--                             type 'a wrap = 'a and
--                             type 'a list_wrap = 'a list)
--                     -> S with type t = Html5_types.div Html5.elt and
--                               type u = < foo: Html5.uri >
--end
-+   module Make: functor (Html5: Html5_sigs.T
-+   with type 'a Xml.wrap = 'a and
-+   type 'a wrap = 'a and
-+   type 'a list_wrap = 'a list)
-+   -> S with type t = Html5_types.div Html5.elt and
-+   type u = < foo: Html5.uri >
-+   end
- *)
- module type S = sig
-   include Set.S
 @@ -4961,8 +4961,8 @@ module type S = sig
  end
  
@@ -1467,19 +1374,6 @@
  struct
    type 'a fix = ('a, 'a F.f) eq
  
-@@ -5022,9 +5022,9 @@ struct
- end
- 
- (* This would allow:
--module FixId = Fix (struct type 'a f = 'a end)
-- let bad : (int, string) eq = FixId.uniq Eq Eq
-- let _ = Printf.printf "Oh dear: %s" (cast bad 42)
-+   module FixId = Fix (struct type 'a f = 'a end)
-+   let bad : (int, string) eq = FixId.uniq Eq Eq
-+   let _ = Printf.printf "Oh dear: %s" (cast bad 42)
- *)
- module M = struct
-   module type S = sig
 @@ -5233,21 +5233,21 @@ module type S' = S with module M := String
  
  (* with module type *)
@@ -1568,7 +1462,7 @@
  struct
    module C = X.C
  end
-@@ -5603,16 +5603,16 @@ module M = struct
+@@ -5603,10 +5603,10 @@ module M = struct
  end
  
  module F (Y : sig
@@ -1583,46 +1477,7 @@
  struct end
  
  module G = F (M.Y)
- 
- (*module N = G (M);;
--module N = F (M.Y) (M);;*)
-+  module N = F (M.Y) (M);;*)
- 
- (* PR#6307 *)
- 
-@@ -5671,16 +5671,16 @@ end
- (* fail *)
- 
- (* (* if the above succeeded, one could break invariants *)
--module rec M2 : S' = M2;; (* should succeed! (but this is bad) *)
-+   module rec M2 : S' = M2;; (* should succeed! (but this is bad) *)
- 
--let M2.W eq = W Eq;;
-+   let M2.W eq = W Eq;;
- 
--let s = List.fold_right SInt.add [1;2;3] SInt.empty;;
--module SInt2 = Set.Make(Int2);;
--let conv : type a b. (a,b) eq -> a -> b = fun Eq x -> x;;
--let s' : SInt2.t = conv eq s;;
--SInt2.elements s';;
--SInt2.mem 2 s';; (* invariants are broken *)
-+   let s = List.fold_right SInt.add [1;2;3] SInt.empty;;
-+   module SInt2 = Set.Make(Int2);;
-+   let conv : type a b. (a,b) eq -> a -> b = fun Eq x -> x;;
-+   let s' : SInt2.t = conv eq s;;
-+   SInt2.elements s';;
-+   SInt2.mem 2 s';; (* invariants are broken *)
- *)
- 
- (* Check behavior with submodules *)
-@@ -5864,14 +5864,14 @@ end = struct
- end
- 
- (* The following introduces a (useless) dependency on A:
--module C : sig module L : module type of List end = A
-+   module C : sig module L : module type of List end = A
- *)
- 
+@@ -5870,8 +5870,8 @@ end
  include D'
  
  (*
@@ -1633,15 +1488,6 @@
  *)
  open A
  
-@@ -5885,7 +5885,7 @@ end = struct
- end
- 
- (* The following introduces a (useless) dependency on A:
--module C : sig module L : module type of List end = A
-+   module C : sig module L : module type of List end = A
- *)
- 
- (* No dependency on D *)
 @@ -6010,7 +6010,7 @@ module Y = functor (X : sig end) (Y : sig end) (Z : sig end) -> struct end
  module Z = functor (_ : sig end) (_ : sig end) (_ : sig end) -> struct end
  
@@ -1924,7 +1770,7 @@
    =
    ()
  ;;
-@@ -9666,22 +9666,22 @@ let _ =
+@@ -9666,23 +9666,23 @@ let _ =
  
  let _ =
    aaaaaaa
@@ -1938,7 +1784,7 @@
    f
      ~x
 -      (* this is a multiple-line-spanning
--                comment *)
+-         comment *)
 +    (* this is a multiple-line-spanning
 +       comment *)
      ~y
@@ -1948,10 +1794,12 @@
    very_long_function_name
      ~x:very_long_variable_name
 -      (* this is a multiple-line-spanning
+-         comment *)
 +    (* this is a multiple-line-spanning
-        comment *)
++       comment *)
      ~y
  ;;
+ 
 @@ -9706,7 +9706,7 @@ let _ =
  
  type t =
@@ -1961,15 +1809,17 @@
    | `XXXX (* __________________________________________________________________ *)
    | `XXXX (* _____________________________________________________ *)
    | `XXXX (* ___________________________________________________ *)
-@@ -9720,7 +9720,7 @@ type t =
+@@ -9720,8 +9720,8 @@ type t =
  
  type t =
    { field : ty
 -      (* Here is some verbatim formatted text:
+-         {v
 +  (* Here is some verbatim formatted text:
-      {v
-        starting at column 7
-      v}*)
++     {v
+          starting at column 7
+          v}*)
+   }
 @@ -9755,11 +9755,11 @@ let _ =
  let nullsafe_optimistic_third_party_params_in_non_strict =
    CLOpt.mk_bool
@@ -1987,7 +1837,7 @@
      ~default:true
      "Nullsafe: in this mode we treat non annotated third party method params as if they \
       were annotated as nullable."
-@@ -9784,15 +9784,15 @@ let _ =
+@@ -9788,15 +9788,15 @@ let _ =
    | _
      when f
             ~f:(function [@ocaml.warning
@@ -2009,7 +1859,7 @@
    =
    match[@ocaml.warning (* ....................................... *) "-4"]
      x [@attr (* .......................... .................. *) some_attr]
-@@ -9801,25 +9801,25 @@ let[@a
+@@ -9805,25 +9805,25 @@ let[@a
      when f
             ~f:
               (function[@ocaml.warning (* ....................................... *) "-4"]

• with basic handling of {v v}:

--- /Users/gp/diff.0	2023-03-02 10:55:26
+++ /Users/gp/diff.3	2023-03-06 12:39:30
@@ -1,5 +1,5 @@
 diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ocp
-index 5dac4eaf..88f6c9d4 100644
+index 4eb4d06a..2c6096ec 100644
 --- a/test/passing/tests/js_source.ml.ref
 +++ b/test/passing/tests/js_source.ml.ocp
 @@ -33,8 +33,8 @@ type var =
@@ -126,15 +126,8 @@
  
  let f (type t) (x : t) (tag : t ty) =
    match tag with
-@@ -908,14 +908,14 @@ let g (type t) (x : t) (tag : t ty) =
- ;;
+@@ -914,8 +914,8 @@ let id x = x
  
- (* Error: This expression has type bool but an expression was expected of type
--t = int *)
-+   t = int *)
- 
- let id x = x
- 
  let idb1 =
    (fun id ->
 -    let _ = id true in
@@ -939,15 +932,6 @@
  struct
    let f (type a) (Neq n : (a, a T.t) eq) = n (* warn! *)
  end
-@@ -2838,7 +2838,7 @@ type _ fin =
-   | FS : 'a fin -> 'a succ fin
- 
- (* We cannot define
--     val empty : zero fin -> 'a
-+   val empty : zero fin -> 'a
-    because we cannot write an empty pattern matching.
-    This might be useful to have *)
- 
 @@ -2873,7 +2873,7 @@ let comp_subst f g (x : 'a fin) = pre_subst f (g x)
  (* 4 The Occur-Check, through thick and thin *)
  
@@ -1094,17 +1078,6 @@
  
  [%%expect {|
  module M_valid : S
-@@ -3212,8 +3212,8 @@ val test_bar : unit -> unit = <fun>
- |}]
- 
- (* Uncomment these to test. Should see substantial speedup!
--let () = Printf.printf "No @@immediate: %fs\n" (test test_foo)
--let () = Printf.printf "With @@immediate: %fs\n" (test test_bar) *)
-+   let () = Printf.printf "No @@immediate: %fs\n" (test test_foo)
-+   let () = Printf.printf "With @@immediate: %fs\n" (test test_bar) *)
- 
- (* INVALID DECLARATIONS *)
- 
 @@ -3223,7 +3223,7 @@ module B = struct
  end
  
@@ -1322,38 +1295,6 @@
  end
  
  (* fails *)
-@@ -4624,20 +4624,20 @@ module M' : module type of Std'.M = Std2.M
- let f3 (x : M'.t) : Std2.M.t = x
- 
- (* original report required Core_kernel:
--module type S = sig
--open Core_kernel.Std
-+   module type S = sig
-+   open Core_kernel.Std
- 
--module Hashtbl1 : module type of Hashtbl
--module Hashtbl2 : sig
--  include (module type of Hashtbl)
--end
-+   module Hashtbl1 : module type of Hashtbl
-+   module Hashtbl2 : sig
-+   include (module type of Hashtbl)
-+   end
- 
--module Coverage : Core_kernel.Std.Hashable
-+   module Coverage : Core_kernel.Std.Hashable
- 
--type types = unit constraint 'a Coverage.Table.t = (Coverage.t, 'a) Hashtbl1.t
--type doesnt_type = unit
--  constraint 'a Coverage.Table.t = (Coverage.t, 'a) Hashtbl2.t
--end
-+   type types = unit constraint 'a Coverage.Table.t = (Coverage.t, 'a) Hashtbl1.t
-+   type doesnt_type = unit
-+   constraint 'a Coverage.Table.t = (Coverage.t, 'a) Hashtbl2.t
-+   end
- *)
- module type INCLUDING = sig
-   include module type of List
 @@ -4693,11 +4693,11 @@ let x = (3 : X2.F(DUMMY)(DUMMY).t)
  let x = (3 : X2.F(DUMMY)(DUMMY).t')
  
@@ -1396,40 +1337,6 @@
  
  let () = flag := false
  
-@@ -4804,20 +4804,20 @@ module type PR6513 = sig
- end
- 
- (* Requires -package tyxml
--module type PR6513_orig = sig
--module type S =
--sig
--        type t
--        type u
--end
-+   module type PR6513_orig = sig
-+   module type S =
-+   sig
-+   type t
-+   type u
-+   end
- 
--module Make: functor (Html5: Html5_sigs.T
--                             with type 'a Xml.wrap = 'a and
--                             type 'a wrap = 'a and
--                             type 'a list_wrap = 'a list)
--                     -> S with type t = Html5_types.div Html5.elt and
--                               type u = < foo: Html5.uri >
--end
-+   module Make: functor (Html5: Html5_sigs.T
-+   with type 'a Xml.wrap = 'a and
-+   type 'a wrap = 'a and
-+   type 'a list_wrap = 'a list)
-+   -> S with type t = Html5_types.div Html5.elt and
-+   type u = < foo: Html5.uri >
-+   end
- *)
- module type S = sig
-   include Set.S
 @@ -4961,8 +4961,8 @@ module type S = sig
  end
  
@@ -1467,19 +1374,6 @@
  struct
    type 'a fix = ('a, 'a F.f) eq
  
-@@ -5022,9 +5022,9 @@ struct
- end
- 
- (* This would allow:
--module FixId = Fix (struct type 'a f = 'a end)
-- let bad : (int, string) eq = FixId.uniq Eq Eq
-- let _ = Printf.printf "Oh dear: %s" (cast bad 42)
-+   module FixId = Fix (struct type 'a f = 'a end)
-+   let bad : (int, string) eq = FixId.uniq Eq Eq
-+   let _ = Printf.printf "Oh dear: %s" (cast bad 42)
- *)
- module M = struct
-   module type S = sig
 @@ -5233,21 +5233,21 @@ module type S' = S with module M := String
  
  (* with module type *)
@@ -1568,7 +1462,7 @@
  struct
    module C = X.C
  end
-@@ -5603,16 +5603,16 @@ module M = struct
+@@ -5603,10 +5603,10 @@ module M = struct
  end
  
  module F (Y : sig
@@ -1583,46 +1477,7 @@
  struct end
  
  module G = F (M.Y)
- 
- (*module N = G (M);;
--module N = F (M.Y) (M);;*)
-+  module N = F (M.Y) (M);;*)
- 
- (* PR#6307 *)
- 
-@@ -5671,16 +5671,16 @@ end
- (* fail *)
- 
- (* (* if the above succeeded, one could break invariants *)
--module rec M2 : S' = M2;; (* should succeed! (but this is bad) *)
-+   module rec M2 : S' = M2;; (* should succeed! (but this is bad) *)
- 
--let M2.W eq = W Eq;;
-+   let M2.W eq = W Eq;;
- 
--let s = List.fold_right SInt.add [1;2;3] SInt.empty;;
--module SInt2 = Set.Make(Int2);;
--let conv : type a b. (a,b) eq -> a -> b = fun Eq x -> x;;
--let s' : SInt2.t = conv eq s;;
--SInt2.elements s';;
--SInt2.mem 2 s';; (* invariants are broken *)
-+   let s = List.fold_right SInt.add [1;2;3] SInt.empty;;
-+   module SInt2 = Set.Make(Int2);;
-+   let conv : type a b. (a,b) eq -> a -> b = fun Eq x -> x;;
-+   let s' : SInt2.t = conv eq s;;
-+   SInt2.elements s';;
-+   SInt2.mem 2 s';; (* invariants are broken *)
- *)
- 
- (* Check behavior with submodules *)
-@@ -5864,14 +5864,14 @@ end = struct
- end
- 
- (* The following introduces a (useless) dependency on A:
--module C : sig module L : module type of List end = A
-+   module C : sig module L : module type of List end = A
- *)
- 
+@@ -5870,8 +5870,8 @@ end
  include D'
  
  (*
@@ -1633,15 +1488,6 @@
  *)
  open A
  
-@@ -5885,7 +5885,7 @@ end = struct
- end
- 
- (* The following introduces a (useless) dependency on A:
--module C : sig module L : module type of List end = A
-+   module C : sig module L : module type of List end = A
- *)
- 
- (* No dependency on D *)
 @@ -6010,7 +6010,7 @@ module Y = functor (X : sig end) (Y : sig end) (Z : sig end) -> struct end
  module Z = functor (_ : sig end) (_ : sig end) (_ : sig end) -> struct end
  
@@ -1924,7 +1770,7 @@
    =
    ()
  ;;
-@@ -9666,22 +9666,22 @@ let _ =
+@@ -9666,23 +9666,23 @@ let _ =
  
  let _ =
    aaaaaaa
@@ -1938,7 +1784,7 @@
    f
      ~x
 -      (* this is a multiple-line-spanning
--                comment *)
+-         comment *)
 +    (* this is a multiple-line-spanning
 +       comment *)
      ~y
@@ -1948,10 +1794,12 @@
    very_long_function_name
      ~x:very_long_variable_name
 -      (* this is a multiple-line-spanning
+-         comment *)
 +    (* this is a multiple-line-spanning
-        comment *)
++       comment *)
      ~y
  ;;
+ 
 @@ -9706,7 +9706,7 @@ let _ =
  
  type t =
@@ -1961,15 +1809,17 @@
    | `XXXX (* __________________________________________________________________ *)
    | `XXXX (* _____________________________________________________ *)
    | `XXXX (* ___________________________________________________ *)
-@@ -9720,7 +9720,7 @@ type t =
+@@ -9720,8 +9720,8 @@ type t =
  
  type t =
    { field : ty
 -      (* Here is some verbatim formatted text:
+-         {v
 +  (* Here is some verbatim formatted text:
-      {v
-        starting at column 7
-      v}*)
++     {v
+            starting at column 7
+          v}*)
+   }

[gpetiot]

@ceastlund: does this new behavior look good to you?

[ceastlund]

I'm not quite sure I understand the change here. I believe ocp-indent may change the indentation of the opening {v, since the whitespace preceding it is not verbatim. But anything between {v and v} should not be changed, right? That should be the purpose of a verbatim block.

[gpetiot]

@ceastlund: The issue is, contrary to ocp-indent, we cannot predict where the comment will be printed on the next round (ocamlformat is looking for a fixpoint) of formatting. If we try to preserve the line offset, it will still be shifted when formatting inside a comment.

A few months ago we added a new type of comments (prefixed by (*= in ocamlformat to keep the comments verbatim, so that {v v} is not necessary:

type t =
  { field : ty
      (*= Here is some verbatim formatted text:
     
       starting at column 7
      *)
  }

Would that solution be acceptable for the comments you need to preserve in Jane Street's codebase? Maybe this verbatim issue only affects a low count of comments, and most of them are fine by being vertically left-aligned like it's done in this PR? (ignoring the {v v} patch)

[ceastlund]

Oh, I see, you're trying to move stuff relative to the comment itself. I'd say don't bother with that. Treat {v ... v} like {| ... |} strings, if you can: you can move the starting points, but the contents don't shift, even if that makes them unaligned with surrounding code.

[Julow]

You are right, according to Odoc's parser (that is not used here but I think make sense to mention), the content of a verbatim shouldn't change, even its indentation.

[Julow]

I get a crash on this input: (profile janestreet)

(*
Foo
*)

(Invalid_argument "Negative position: -3")

[Julow]

Looks good! I fixed the conflicts, you can merge :)