From 20ebef939b977d02c7d17cbbda7097b4c9ec8ecd Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Fri, 17 Mar 2023 22:36:39 +0100
Subject: [PATCH 001/115] JaneStreet: Disable 'max-indent=2'

---
 lib/Conf.ml                         |  2 +-
 test/cli/multiple_projects.t        | 12 ++---
 test/passing/tests/js_source.ml.err | 13 +++---
 test/passing/tests/js_source.ml.ocp |  9 ++--
 test/passing/tests/js_source.ml.ref | 69 +++++++++++++++--------------
 test/rpc/rpc_test.expected          |  4 +-
 6 files changed, 58 insertions(+), 51 deletions(-)

diff --git a/lib/Conf.ml b/lib/Conf.ml
index 94b05244ea..49c4634463 100644
--- a/lib/Conf.ml
+++ b/lib/Conf.ml
@@ -222,7 +222,7 @@ let janestreet_profile from =
   ; margin= elt 90
   ; match_indent= elt 0
   ; match_indent_nested= elt `Never
-  ; max_indent= elt @@ Some 2
+  ; max_indent= elt None
   ; module_item_spacing= elt `Compact
   ; nested_match= elt `Wrap
   ; ocp_indent_compat= elt true
diff --git a/test/cli/multiple_projects.t b/test/cli/multiple_projects.t
index 4cd1f41452..5ac73ca9f8 100644
--- a/test/cli/multiple_projects.t
+++ b/test/cli/multiple_projects.t
@@ -14,12 +14,12 @@ Second project formatted with the 'ocamlformat' profile:
 
   $ cat project1/main.ml
   let _machin
-    ?aaaaaaaaaa:_
-    ?bbbbbbbbbbb:_
-    ?cccccccccccc:_
-    ?ddddddddddddd:_
-    ?eeeeeeeeeeee:_
-    ()
+      ?aaaaaaaaaa:_
+      ?bbbbbbbbbbb:_
+      ?cccccccccccc:_
+      ?ddddddddddddd:_
+      ?eeeeeeeeeeee:_
+      ()
     =
     ()
   ;;
diff --git a/test/passing/tests/js_source.ml.err b/test/passing/tests/js_source.ml.err
index be4486aef5..dda65f00c0 100644
--- a/test/passing/tests/js_source.ml.err
+++ b/test/passing/tests/js_source.ml.err
@@ -1,7 +1,8 @@
 Warning: tests/js_source.ml:155 exceeds the margin
-Warning: tests/js_source.ml:3554 exceeds the margin
-Warning: tests/js_source.ml:9515 exceeds the margin
-Warning: tests/js_source.ml:9618 exceeds the margin
-Warning: tests/js_source.ml:9637 exceeds the margin
-Warning: tests/js_source.ml:9677 exceeds the margin
-Warning: tests/js_source.ml:9759 exceeds the margin
+Warning: tests/js_source.ml:3557 exceeds the margin
+Warning: tests/js_source.ml:9518 exceeds the margin
+Warning: tests/js_source.ml:9539 exceeds the margin
+Warning: tests/js_source.ml:9621 exceeds the margin
+Warning: tests/js_source.ml:9640 exceeds the margin
+Warning: tests/js_source.ml:9680 exceeds the margin
+Warning: tests/js_source.ml:9762 exceeds the margin
diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp
index ece5cab602..afb03246f4 100644
--- a/test/passing/tests/js_source.ml.ocp
+++ b/test/passing/tests/js_source.ml.ocp
@@ -1268,7 +1268,8 @@ let ty_abc =
   (* Define inj in advance to be able to write the type annotation easily *)
   and inj
     : type c.
-      (int -> string -> noarg -> unit, c) ty_sel * c -> [ `A of int | `B of string | `C ]
+      (int -> string -> noarg -> unit, c) ty_sel * c
+      -> [ `A of int | `B of string | `C ]
     = function
       | Thd, v -> `A v
       | Ttl Thd, v -> `B v
@@ -1721,7 +1722,8 @@ let rec elem : type h. int -> h avl -> bool =
 ;;
 
 let rec rotr
-  : type n. n succ succ avl -> int -> n avl -> (n succ succ avl, n succ succ succ avl) sum
+  : type n.
+    n succ succ avl -> int -> n avl -> (n succ succ avl, n succ succ succ avl) sum
   =
   fun tL y tR ->
   match tL with
@@ -1736,7 +1738,8 @@ let rec rotr
 ;;
 
 let rec rotl
-  : type n. n avl -> int -> n succ succ avl -> (n succ succ avl, n succ succ succ avl) sum
+  : type n.
+    n avl -> int -> n succ succ avl -> (n succ succ avl, n succ succ succ avl) sum
   =
   fun tL u tR ->
   match tR with
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index 9844830cc5..cd7035d1f3 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -1157,8 +1157,8 @@ let rec eq_sel : type a b c. (a, b) ty_sel -> (a, c) ty_sel -> (b, c) eq option
 
 (* Auxiliary function to get the type of a case from its selector *)
 let rec get_case
-  : type a b e.
-    (b, a) ty_sel -> (string * (e, b) ty_case) list -> string * (a, e) ty option
+    : type a b e.
+      (b, a) ty_sel -> (string * (e, b) ty_case) list -> string * (a, e) ty option
   =
   fun sel cases ->
   match cases with
@@ -1267,8 +1267,9 @@ let ty_abc =
     | `C -> "C", None
   (* Define inj in advance to be able to write the type annotation easily *)
   and inj
-    : type c.
-      (int -> string -> noarg -> unit, c) ty_sel * c -> [ `A of int | `B of string | `C ]
+      : type c.
+        (int -> string -> noarg -> unit, c) ty_sel * c
+        -> [ `A of int | `B of string | `C ]
     = function
     | Thd, v -> `A v
     | Ttl Thd, v -> `B v
@@ -1406,8 +1407,8 @@ let ty_abc : (([ `A of int | `B of string | `C ] as 'a), 'e) ty =
          ]
 
        method inj
-         : type c.  (int -> string -> noarg -> unit, c) ty_sel * c
-                   -> [ `A of int | `B of string | `C ] =
+           : type c.  (int -> string -> noarg -> unit, c) ty_sel * c
+                     -> [ `A of int | `B of string | `C ] =
          function
          | Thd, v -> `A v
          | Ttl Thd, v -> `B v
@@ -1613,12 +1614,12 @@ let rec plus_func : type a b m n. (a, b, m) plus -> (a, b, n) plus -> (m, n) equ
 ;;
 
 let rec plus_assoc
-  : type a b c ab bc m n.
-    (a, b, ab) plus
-    -> (ab, c, m) plus
-    -> (b, c, bc) plus
-    -> (a, bc, n) plus
-    -> (m, n) equal
+    : type a b c ab bc m n.
+      (a, b, ab) plus
+      -> (ab, c, m) plus
+      -> (b, c, bc) plus
+      -> (a, bc, n) plus
+      -> (m, n) equal
   =
   fun p1 p2 p3 p4 ->
   match p1, p4 with
@@ -1721,7 +1722,8 @@ let rec elem : type h. int -> h avl -> bool =
 ;;
 
 let rec rotr
-  : type n. n succ succ avl -> int -> n avl -> (n succ succ avl, n succ succ succ avl) sum
+    : type n.
+      n succ succ avl -> int -> n avl -> (n succ succ avl, n succ succ succ avl) sum
   =
   fun tL y tR ->
   match tL with
@@ -1736,7 +1738,8 @@ let rec rotr
 ;;
 
 let rec rotl
-  : type n. n avl -> int -> n succ succ avl -> (n succ succ avl, n succ succ succ avl) sum
+    : type n.
+      n avl -> int -> n succ succ avl -> (n succ succ avl, n succ succ succ avl) sum
   =
   fun tL u tR ->
   match tR with
@@ -2235,7 +2238,7 @@ type closed = rnil
 type 'a rlam = ((pexp, closed, 'a) lam, (pval, closed, 'a) lam) sum
 
 let rec rule
-  : type a b. (pval, closed, (a, b) tarr) lam -> (pval, closed, a) lam -> b rlam
+    : type a b. (pval, closed, (a, b) tarr) lam -> (pval, closed, a) lam -> b rlam
   =
   fun v1 v2 ->
   match v1, v2 with
@@ -2402,7 +2405,7 @@ type (_, _, _) binop =
   | Add : (int, int, int) binop
 
 let eval (type a b c) (bop : (a, b, c) binop) (x : a constant) (y : b constant)
-  : c constant
+    : c constant
   =
   match bop, x, y with
   | Eq, Bool x, Bool y -> Bool (if x then y else not y)
@@ -2645,7 +2648,7 @@ let vexpr (type visit_action) : ('a, 'result, visit_action) context -> 'a -> vis
 ;;
 
 let vexpr (type result visit_action)
-  : (unit, result, visit_action) context -> unit -> visit_action
+    : (unit, result, visit_action) context -> unit -> visit_action
   = function
   | Local -> fun _ -> raise Exit
   | Global -> fun _ -> raise Exit
@@ -3629,7 +3632,7 @@ let subst_lambda ~subst_rec ~free ~subst : _ lambda -> _ = function
     let used = free t in
     let used_expr =
       Subst.fold subst ~init:[] ~f:(fun ~key ~data acc ->
-        if Names.mem s used then data :: acc else acc)
+          if Names.mem s used then data :: acc else acc)
     in
     if List.exists used_expr ~f:(fun t -> Names.mem s (free t))
     then (
@@ -3867,7 +3870,7 @@ class ['a] lambda_ops (ops : ('a, 'a) #ops Lazy.t) =
         let used = !!free t in
         let used_expr =
           Subst.fold sub ~init:[] ~f:(fun ~key ~data acc ->
-            if Names.mem s used then data :: acc else acc)
+              if Names.mem s used then data :: acc else acc)
         in
         if List.exists used_expr ~f:(fun t -> Names.mem s (!!free t))
         then (
@@ -4109,7 +4112,7 @@ let lambda_ops (ops : ('a, 'a) #ops Lazy.t) =
         let used = !!free t in
         let used_expr =
           Subst.fold sub ~init:[] ~f:(fun ~key ~data acc ->
-            if Names.mem s used then data :: acc else acc)
+              if Names.mem s used then data :: acc else acc)
         in
         if List.exists used_expr ~f:(fun t -> Names.mem s (!!free t))
         then (
@@ -4955,8 +4958,8 @@ module type S = sig
 end
 
 module Foo
-  (Bar : S with type a = private [> `A ])
-  (Baz : S with type b = private < b : Bar.b ; .. >) =
+    (Bar : S with type a = private [> `A ])
+    (Baz : S with type b = private < b : Bar.b ; .. >) =
 struct end
 
 module A = struct
@@ -8597,8 +8600,8 @@ type v =
   | G
 
 let f
-  : type a b c d e f g.
-    a t * b t * c t * d t * e t * f t * g t * v * (a, b, c, d) u * (e, f, g, g) u -> int
+    : type a b c d e f g.
+      a t * b t * c t * d t * e t * f t * g t * v * (a, b, c, d) u * (e, f, g, g) u -> int
   = function
   | A, A, A, A, A, A, A, _, U, U -> 1
   | _, _, _, _, _, _, _, G, _, _ -> 1
@@ -9528,14 +9531,14 @@ else aaaaaaaaaaaa qqqqqqqqqqq
 include Base.Fn (** @open *)
 
 let ssmap
-  : (module MapT with type key = string and type data = string and type map = SSMap.map)
+    : (module MapT with type key = string and type data = string and type map = SSMap.map)
   =
   ()
 ;;
 
 let ssmap
-  :  (module MapT with type key = string and type data = string and type map = SSMap.map)
-  -> unit
+    :  (module MapT with type key = string and type data = string and type map = SSMap.map)
+    -> unit
   =
   ()
 ;;
@@ -9560,7 +9563,7 @@ let _ =
 
 let _ =
   List.map rows ~f:(fun row ->
-    Or_error.try_with (fun () -> fffffffffffffffffffffffff row))
+      Or_error.try_with (fun () -> fffffffffffffffffffffffff row))
 ;;
 
 module type T = sig
@@ -9689,7 +9692,7 @@ type t =
 
 type t =
   { field : ty
-      (* Here is some verbatim formatted text:
+        (* Here is some verbatim formatted text:
      {v
        starting at column 7
      v}*)
@@ -9790,22 +9793,22 @@ let[@a
 
 let x =
   foo (`A b) ~f:(fun thing ->
-    something that reaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaally needs wrapping)
+      something that reaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaally needs wrapping)
 ;;
 
 let x =
   foo (`A `b) ~f:(fun thing ->
-    something that reaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaally needs wrapping)
+      something that reaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaally needs wrapping)
 ;;
 
 let x =
   foo [ A; B ] ~f:(fun thing ->
-    something that reaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaally needs wrapping)
+      something that reaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaally needs wrapping)
 ;;
 
 let x =
   foo [ [ A ]; B ] ~f:(fun thing ->
-    something that reaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaally needs wrapping)
+      something that reaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaally needs wrapping)
 ;;
 
 let x =
diff --git a/test/rpc/rpc_test.expected b/test/rpc/rpc_test.expected
index cc1322656b..a8b36a0ea7 100644
--- a/test/rpc/rpc_test.expected
+++ b/test/rpc/rpc_test.expected
@@ -96,8 +96,8 @@ let ssmap
 '
 Output:
 let ssmap
-  :  (module MapT with type key = string and type data = string and type map = SSMap.map)
-  -> unit
+    :  (module MapT with type key = string and type data = string and type map = SSMap.map)
+    -> unit
   =
   ()
 ;;

From 3f41d48d24f2cc81c5dc9bb823160475d2695cf7 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Fri, 17 Mar 2023 22:38:35 +0100
Subject: [PATCH 002/115] ocp-indent-compat: Function args and type annot

---
 lib/Fmt_ast.ml                                | 16 +++++--
 test/cli/multiple_projects.t                  | 12 ++---
 .../tests/break_separators-after.ml.ref       | 10 ++--
 .../break_separators-after_docked.ml.ref      | 14 +++---
 .../break_separators-before_docked.ml.ref     | 14 +++---
 test/passing/tests/break_separators.ml        | 10 ++--
 test/passing/tests/js_source.ml.err           | 13 +++--
 test/passing/tests/js_source.ml.ocp           |  9 ++--
 test/passing/tests/js_source.ml.ref           | 47 +++++++++----------
 test/passing/tests/ocp_indent_compat.ml       | 20 ++++----
 test/rpc/rpc_test.expected                    |  4 +-
 11 files changed, 85 insertions(+), 84 deletions(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 6021890e0c..7c239d298a 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -80,6 +80,14 @@ let empty =
 let compose_module {opn; pro; psp; bdy; cls; esp; epi} ~f =
   f (fmt_opt pro $ opn $ psp $ bdy $ cls $ esp $ fmt_opt epi)
 
+module Indent = struct
+  let _ocp a b c = if c.conf.fmt_opts.ocp_indent_compat.v then a else b
+
+  let fun_type_annot = _ocp 2 4
+
+  let fun_args = _ocp 6 4
+end
+
 (* Debug: catch and report failures at nearest enclosing Ast.t *)
 
 let protect =
@@ -2913,8 +2921,8 @@ and fmt_class_field c ctx cf =
       hvbox 2
         ( hovbox 2
             ( hovbox 4
-                (box_fun_decl_args c 4
-                   ( box_fun_sig_args c 4
+                (box_fun_decl_args c (Indent.fun_args c)
+                   ( box_fun_sig_args c (Indent.fun_type_annot c)
                        ( str "method" $ virtual_or_override kind
                        $ fmt_private_virtual_flag c pv
                        $ str " " $ fmt_str_loc c name $ typ )
@@ -4231,8 +4239,8 @@ and fmt_value_binding c ~rec_flag ?ext ?in_ ?epi ctx
           ( hvbox_if toplevel 0
               ( hvbox_if toplevel indent
                   ( hovbox 2
-                      ( hovbox 4
-                          ( box_fun_decl_args c 4
+                      ( hovbox (Indent.fun_type_annot c)
+                          ( box_fun_decl_args c (Indent.fun_args c)
                               ( hovbox 4
                                   ( fmt_str_loc c lb_op
                                   $ fmt_extension_suffix c ext
diff --git a/test/cli/multiple_projects.t b/test/cli/multiple_projects.t
index 5ac73ca9f8..58937c4040 100644
--- a/test/cli/multiple_projects.t
+++ b/test/cli/multiple_projects.t
@@ -14,12 +14,12 @@ Second project formatted with the 'ocamlformat' profile:
 
   $ cat project1/main.ml
   let _machin
-      ?aaaaaaaaaa:_
-      ?bbbbbbbbbbb:_
-      ?cccccccccccc:_
-      ?ddddddddddddd:_
-      ?eeeeeeeeeeee:_
-      ()
+        ?aaaaaaaaaa:_
+        ?bbbbbbbbbbb:_
+        ?cccccccccccc:_
+        ?ddddddddddddd:_
+        ?eeeeeeeeeeee:_
+        ()
     =
     ()
   ;;
diff --git a/test/passing/tests/break_separators-after.ml.ref b/test/passing/tests/break_separators-after.ml.ref
index 5353f8eef8..e2fe2b8496 100644
--- a/test/passing/tests/break_separators-after.ml.ref
+++ b/test/passing/tests/break_separators-after.ml.ref
@@ -263,11 +263,11 @@ let x {aaaaaaaaaaaaaa; aaaaaaaaaaaaa; aaaaaaaaaa} =
   {aaaaaaaaaaaa= aaaaaaaaaaaaaaaaa; bbbbbbbbbbbbb= bbb bb bbbbbb}
 
 let x
-    { aaaaaaaaaaaaaaaaaaaaaa;
-      aaaaaaaaaaaaaaaaaaa;
-      aaaaaaaaaaaaaa;
-      aaaaaaaaaaaaaaaaaa;
-      aaaaaaaaaa }
+      { aaaaaaaaaaaaaaaaaaaaaa;
+        aaaaaaaaaaaaaaaaaaa;
+        aaaaaaaaaaaaaa;
+        aaaaaaaaaaaaaaaaaa;
+        aaaaaaaaaa }
   =
   { aaaaaaaaaaaa= aaaaaaaaaaaaaaaaa;
     bbbbbbbbbbbbb= bbb bb bbbbbb;
diff --git a/test/passing/tests/break_separators-after_docked.ml.ref b/test/passing/tests/break_separators-after_docked.ml.ref
index ae435ee3a2..6e609930c0 100644
--- a/test/passing/tests/break_separators-after_docked.ml.ref
+++ b/test/passing/tests/break_separators-after_docked.ml.ref
@@ -289,13 +289,13 @@ let x {aaaaaaaaaaaaaa; aaaaaaaaaaaaa; aaaaaaaaaa} =
   {aaaaaaaaaaaa= aaaaaaaaaaaaaaaaa; bbbbbbbbbbbbb= bbb bb bbbbbb}
 
 let x
-    {
-      aaaaaaaaaaaaaaaaaaaaaa;
-      aaaaaaaaaaaaaaaaaaa;
-      aaaaaaaaaaaaaa;
-      aaaaaaaaaaaaaaaaaa;
-      aaaaaaaaaa;
-    }
+      {
+        aaaaaaaaaaaaaaaaaaaaaa;
+        aaaaaaaaaaaaaaaaaaa;
+        aaaaaaaaaaaaaa;
+        aaaaaaaaaaaaaaaaaa;
+        aaaaaaaaaa;
+      }
   =
   {
     aaaaaaaaaaaa= aaaaaaaaaaaaaaaaa;
diff --git a/test/passing/tests/break_separators-before_docked.ml.ref b/test/passing/tests/break_separators-before_docked.ml.ref
index 7d0f75e25e..4fc2b8ad0d 100644
--- a/test/passing/tests/break_separators-before_docked.ml.ref
+++ b/test/passing/tests/break_separators-before_docked.ml.ref
@@ -289,13 +289,13 @@ let x {aaaaaaaaaaaaaa; aaaaaaaaaaaaa; aaaaaaaaaa} =
   {aaaaaaaaaaaa= aaaaaaaaaaaaaaaaa; bbbbbbbbbbbbb= bbb bb bbbbbb}
 
 let x
-    {
-      aaaaaaaaaaaaaaaaaaaaaa
-    ; aaaaaaaaaaaaaaaaaaa
-    ; aaaaaaaaaaaaaa
-    ; aaaaaaaaaaaaaaaaaa
-    ; aaaaaaaaaa
-    }
+      {
+        aaaaaaaaaaaaaaaaaaaaaa
+      ; aaaaaaaaaaaaaaaaaaa
+      ; aaaaaaaaaaaaaa
+      ; aaaaaaaaaaaaaaaaaa
+      ; aaaaaaaaaa
+      }
   =
   {
     aaaaaaaaaaaa= aaaaaaaaaaaaaaaaa
diff --git a/test/passing/tests/break_separators.ml b/test/passing/tests/break_separators.ml
index 29a972901e..5283c8d3e0 100644
--- a/test/passing/tests/break_separators.ml
+++ b/test/passing/tests/break_separators.ml
@@ -263,11 +263,11 @@ let x {aaaaaaaaaaaaaa; aaaaaaaaaaaaa; aaaaaaaaaa} =
   {aaaaaaaaaaaa= aaaaaaaaaaaaaaaaa; bbbbbbbbbbbbb= bbb bb bbbbbb}
 
 let x
-    { aaaaaaaaaaaaaaaaaaaaaa
-    ; aaaaaaaaaaaaaaaaaaa
-    ; aaaaaaaaaaaaaa
-    ; aaaaaaaaaaaaaaaaaa
-    ; aaaaaaaaaa }
+      { aaaaaaaaaaaaaaaaaaaaaa
+      ; aaaaaaaaaaaaaaaaaaa
+      ; aaaaaaaaaaaaaa
+      ; aaaaaaaaaaaaaaaaaa
+      ; aaaaaaaaaa }
   =
   { aaaaaaaaaaaa= aaaaaaaaaaaaaaaaa
   ; bbbbbbbbbbbbb= bbb bb bbbbbb
diff --git a/test/passing/tests/js_source.ml.err b/test/passing/tests/js_source.ml.err
index dda65f00c0..be4486aef5 100644
--- a/test/passing/tests/js_source.ml.err
+++ b/test/passing/tests/js_source.ml.err
@@ -1,8 +1,7 @@
 Warning: tests/js_source.ml:155 exceeds the margin
-Warning: tests/js_source.ml:3557 exceeds the margin
-Warning: tests/js_source.ml:9518 exceeds the margin
-Warning: tests/js_source.ml:9539 exceeds the margin
-Warning: tests/js_source.ml:9621 exceeds the margin
-Warning: tests/js_source.ml:9640 exceeds the margin
-Warning: tests/js_source.ml:9680 exceeds the margin
-Warning: tests/js_source.ml:9762 exceeds the margin
+Warning: tests/js_source.ml:3554 exceeds the margin
+Warning: tests/js_source.ml:9515 exceeds the margin
+Warning: tests/js_source.ml:9618 exceeds the margin
+Warning: tests/js_source.ml:9637 exceeds the margin
+Warning: tests/js_source.ml:9677 exceeds the margin
+Warning: tests/js_source.ml:9759 exceeds the margin
diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp
index afb03246f4..ece5cab602 100644
--- a/test/passing/tests/js_source.ml.ocp
+++ b/test/passing/tests/js_source.ml.ocp
@@ -1268,8 +1268,7 @@ let ty_abc =
   (* Define inj in advance to be able to write the type annotation easily *)
   and inj
     : type c.
-      (int -> string -> noarg -> unit, c) ty_sel * c
-      -> [ `A of int | `B of string | `C ]
+      (int -> string -> noarg -> unit, c) ty_sel * c -> [ `A of int | `B of string | `C ]
     = function
       | Thd, v -> `A v
       | Ttl Thd, v -> `B v
@@ -1722,8 +1721,7 @@ let rec elem : type h. int -> h avl -> bool =
 ;;
 
 let rec rotr
-  : type n.
-    n succ succ avl -> int -> n avl -> (n succ succ avl, n succ succ succ avl) sum
+  : type n. n succ succ avl -> int -> n avl -> (n succ succ avl, n succ succ succ avl) sum
   =
   fun tL y tR ->
   match tL with
@@ -1738,8 +1736,7 @@ let rec rotr
 ;;
 
 let rec rotl
-  : type n.
-    n avl -> int -> n succ succ avl -> (n succ succ avl, n succ succ succ avl) sum
+  : type n. n avl -> int -> n succ succ avl -> (n succ succ avl, n succ succ succ avl) sum
   =
   fun tL u tR ->
   match tR with
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index cd7035d1f3..0117584eee 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -1157,8 +1157,8 @@ let rec eq_sel : type a b c. (a, b) ty_sel -> (a, c) ty_sel -> (b, c) eq option
 
 (* Auxiliary function to get the type of a case from its selector *)
 let rec get_case
-    : type a b e.
-      (b, a) ty_sel -> (string * (e, b) ty_case) list -> string * (a, e) ty option
+  : type a b e.
+    (b, a) ty_sel -> (string * (e, b) ty_case) list -> string * (a, e) ty option
   =
   fun sel cases ->
   match cases with
@@ -1267,9 +1267,8 @@ let ty_abc =
     | `C -> "C", None
   (* Define inj in advance to be able to write the type annotation easily *)
   and inj
-      : type c.
-        (int -> string -> noarg -> unit, c) ty_sel * c
-        -> [ `A of int | `B of string | `C ]
+    : type c.
+      (int -> string -> noarg -> unit, c) ty_sel * c -> [ `A of int | `B of string | `C ]
     = function
     | Thd, v -> `A v
     | Ttl Thd, v -> `B v
@@ -1407,8 +1406,8 @@ let ty_abc : (([ `A of int | `B of string | `C ] as 'a), 'e) ty =
          ]
 
        method inj
-           : type c.  (int -> string -> noarg -> unit, c) ty_sel * c
-                     -> [ `A of int | `B of string | `C ] =
+         : type c.  (int -> string -> noarg -> unit, c) ty_sel * c
+                   -> [ `A of int | `B of string | `C ] =
          function
          | Thd, v -> `A v
          | Ttl Thd, v -> `B v
@@ -1614,12 +1613,12 @@ let rec plus_func : type a b m n. (a, b, m) plus -> (a, b, n) plus -> (m, n) equ
 ;;
 
 let rec plus_assoc
-    : type a b c ab bc m n.
-      (a, b, ab) plus
-      -> (ab, c, m) plus
-      -> (b, c, bc) plus
-      -> (a, bc, n) plus
-      -> (m, n) equal
+  : type a b c ab bc m n.
+    (a, b, ab) plus
+    -> (ab, c, m) plus
+    -> (b, c, bc) plus
+    -> (a, bc, n) plus
+    -> (m, n) equal
   =
   fun p1 p2 p3 p4 ->
   match p1, p4 with
@@ -1722,8 +1721,7 @@ let rec elem : type h. int -> h avl -> bool =
 ;;
 
 let rec rotr
-    : type n.
-      n succ succ avl -> int -> n avl -> (n succ succ avl, n succ succ succ avl) sum
+  : type n. n succ succ avl -> int -> n avl -> (n succ succ avl, n succ succ succ avl) sum
   =
   fun tL y tR ->
   match tL with
@@ -1738,8 +1736,7 @@ let rec rotr
 ;;
 
 let rec rotl
-    : type n.
-      n avl -> int -> n succ succ avl -> (n succ succ avl, n succ succ succ avl) sum
+  : type n. n avl -> int -> n succ succ avl -> (n succ succ avl, n succ succ succ avl) sum
   =
   fun tL u tR ->
   match tR with
@@ -2238,7 +2235,7 @@ type closed = rnil
 type 'a rlam = ((pexp, closed, 'a) lam, (pval, closed, 'a) lam) sum
 
 let rec rule
-    : type a b. (pval, closed, (a, b) tarr) lam -> (pval, closed, a) lam -> b rlam
+  : type a b. (pval, closed, (a, b) tarr) lam -> (pval, closed, a) lam -> b rlam
   =
   fun v1 v2 ->
   match v1, v2 with
@@ -2405,7 +2402,7 @@ type (_, _, _) binop =
   | Add : (int, int, int) binop
 
 let eval (type a b c) (bop : (a, b, c) binop) (x : a constant) (y : b constant)
-    : c constant
+  : c constant
   =
   match bop, x, y with
   | Eq, Bool x, Bool y -> Bool (if x then y else not y)
@@ -2648,7 +2645,7 @@ let vexpr (type visit_action) : ('a, 'result, visit_action) context -> 'a -> vis
 ;;
 
 let vexpr (type result visit_action)
-    : (unit, result, visit_action) context -> unit -> visit_action
+  : (unit, result, visit_action) context -> unit -> visit_action
   = function
   | Local -> fun _ -> raise Exit
   | Global -> fun _ -> raise Exit
@@ -8600,8 +8597,8 @@ type v =
   | G
 
 let f
-    : type a b c d e f g.
-      a t * b t * c t * d t * e t * f t * g t * v * (a, b, c, d) u * (e, f, g, g) u -> int
+  : type a b c d e f g.
+    a t * b t * c t * d t * e t * f t * g t * v * (a, b, c, d) u * (e, f, g, g) u -> int
   = function
   | A, A, A, A, A, A, A, _, U, U -> 1
   | _, _, _, _, _, _, _, G, _, _ -> 1
@@ -9531,14 +9528,14 @@ else aaaaaaaaaaaa qqqqqqqqqqq
 include Base.Fn (** @open *)
 
 let ssmap
-    : (module MapT with type key = string and type data = string and type map = SSMap.map)
+  : (module MapT with type key = string and type data = string and type map = SSMap.map)
   =
   ()
 ;;
 
 let ssmap
-    :  (module MapT with type key = string and type data = string and type map = SSMap.map)
-    -> unit
+  :  (module MapT with type key = string and type data = string and type map = SSMap.map)
+  -> unit
   =
   ()
 ;;
diff --git a/test/passing/tests/ocp_indent_compat.ml b/test/passing/tests/ocp_indent_compat.ml
index 578c10dfcf..b96d9110fc 100644
--- a/test/passing/tests/ocp_indent_compat.ml
+++ b/test/passing/tests/ocp_indent_compat.ml
@@ -68,24 +68,24 @@ module type M = sig
 end
 
 let ssmap
-    : (module MapT
-         with type key = string
-          and type data = string
-          and type map = SSMap.map )
+  : (module MapT
+       with type key = string
+        and type data = string
+        and type map = SSMap.map )
   =
   ()
 
 let ssmap
-    :  (module MapT
-          with type key = string
-           and type data = string
-           and type map = SSMap.map )
-    -> unit
+  :  (module MapT
+        with type key = string
+         and type data = string
+         and type map = SSMap.map )
+  -> unit
   =
   ()
 
 let long_function_name
-    : type a. a long_long_type -> a -> a -> a -> wrap_wrap_wrap -> unit
+  : type a. a long_long_type -> a -> a -> a -> wrap_wrap_wrap -> unit
   =
  fun () -> ()
 
diff --git a/test/rpc/rpc_test.expected b/test/rpc/rpc_test.expected
index a8b36a0ea7..cc1322656b 100644
--- a/test/rpc/rpc_test.expected
+++ b/test/rpc/rpc_test.expected
@@ -96,8 +96,8 @@ let ssmap
 '
 Output:
 let ssmap
-    :  (module MapT with type key = string and type data = string and type map = SSMap.map)
-    -> unit
+  :  (module MapT with type key = string and type data = string and type map = SSMap.map)
+  -> unit
   =
   ()
 ;;

From 13eeab17efb6c63371dbd6bcaf24e2f19b975608 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Fri, 17 Mar 2023 22:50:02 +0100
Subject: [PATCH 003/115] ocp-indent-compat: Docked `fun` body

This broke max-indent.
---
 lib/Fmt_ast.ml                      |  9 +++------
 test/passing/tests/js_source.ml.ref | 16 ++++++++--------
 test/passing/tests/max_indent.ml    | 13 +++++++------
 3 files changed, 18 insertions(+), 20 deletions(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 7c239d298a..4be6278039 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -1887,12 +1887,9 @@ and fmt_expression c ?(box = true) ?pro ?epi ?eol ?parens ?(indent_wrap = 0)
             let break_body =
               match eN1_body.pexp_desc with
               | Pexp_function _ -> fmt "@ "
-              | _ -> (
-                (* Avoid the "double indentation" of the application and the
-                   function matching when the [max-indent] option is set. *)
-                match c.conf.fmt_opts.max_indent.v with
-                | Some i when i <= 2 -> fmt "@ "
-                | _ -> fmt "@;<1 2>" )
+              | _ ->
+                  if c.conf.fmt_opts.ocp_indent_compat.v then fmt "@ "
+                  else fmt "@;<1 2>"
             in
             let wrap_intro x =
               wrap (fmt_args_grouped e0 args_before $ fmt "@ " $ hvbox 0 x)
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index 0117584eee..a4cbfeecd4 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -3629,7 +3629,7 @@ let subst_lambda ~subst_rec ~free ~subst : _ lambda -> _ = function
     let used = free t in
     let used_expr =
       Subst.fold subst ~init:[] ~f:(fun ~key ~data acc ->
-          if Names.mem s used then data :: acc else acc)
+        if Names.mem s used then data :: acc else acc)
     in
     if List.exists used_expr ~f:(fun t -> Names.mem s (free t))
     then (
@@ -3867,7 +3867,7 @@ class ['a] lambda_ops (ops : ('a, 'a) #ops Lazy.t) =
         let used = !!free t in
         let used_expr =
           Subst.fold sub ~init:[] ~f:(fun ~key ~data acc ->
-              if Names.mem s used then data :: acc else acc)
+            if Names.mem s used then data :: acc else acc)
         in
         if List.exists used_expr ~f:(fun t -> Names.mem s (!!free t))
         then (
@@ -4109,7 +4109,7 @@ let lambda_ops (ops : ('a, 'a) #ops Lazy.t) =
         let used = !!free t in
         let used_expr =
           Subst.fold sub ~init:[] ~f:(fun ~key ~data acc ->
-              if Names.mem s used then data :: acc else acc)
+            if Names.mem s used then data :: acc else acc)
         in
         if List.exists used_expr ~f:(fun t -> Names.mem s (!!free t))
         then (
@@ -9560,7 +9560,7 @@ let _ =
 
 let _ =
   List.map rows ~f:(fun row ->
-      Or_error.try_with (fun () -> fffffffffffffffffffffffff row))
+    Or_error.try_with (fun () -> fffffffffffffffffffffffff row))
 ;;
 
 module type T = sig
@@ -9790,22 +9790,22 @@ let[@a
 
 let x =
   foo (`A b) ~f:(fun thing ->
-      something that reaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaally needs wrapping)
+    something that reaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaally needs wrapping)
 ;;
 
 let x =
   foo (`A `b) ~f:(fun thing ->
-      something that reaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaally needs wrapping)
+    something that reaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaally needs wrapping)
 ;;
 
 let x =
   foo [ A; B ] ~f:(fun thing ->
-      something that reaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaally needs wrapping)
+    something that reaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaally needs wrapping)
 ;;
 
 let x =
   foo [ [ A ]; B ] ~f:(fun thing ->
-      something that reaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaally needs wrapping)
+    something that reaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaally needs wrapping)
 ;;
 
 let x =
diff --git a/test/passing/tests/max_indent.ml b/test/passing/tests/max_indent.ml
index c66e51aef2..c9f89bc958 100644
--- a/test/passing/tests/max_indent.ml
+++ b/test/passing/tests/max_indent.ml
@@ -1,18 +1,19 @@
 let () =
   fooooo
   |> List.iter (fun x ->
-       let x = x $ y in
-       fooooooooooo x )
+         let x = x $ y in
+         fooooooooooo x )
 
 let () =
   fooooo
   |> List.iter
        (fun
          some_really_really_really_long_name_that_doesn't_fit_on_the_line ->
-       let x =
-         some_really_really_really_long_name_that_doesn't_fit_on_the_line $ y
-       in
-       fooooooooooo x )
+         let x =
+           some_really_really_really_long_name_that_doesn't_fit_on_the_line
+           $ y
+         in
+         fooooooooooo x )
 
 let foooooooooo =
   foooooooooooooooooooooo

From f05c13cf050d634ed6bb6ec918eebeec494af956 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Fri, 17 Mar 2023 22:59:19 +0100
Subject: [PATCH 004/115] De-indent comment after record field

---
 lib/Fmt_ast.ml                               | 4 ++--
 test/passing/tests/comments_in_record.ml.ref | 4 ++--
 test/passing/tests/js_source.ml.ref          | 2 +-
 3 files changed, 5 insertions(+), 5 deletions(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 4be6278039..93d1c35552 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -3219,8 +3219,8 @@ and fmt_label_declaration c ctx ?(last = false) decl =
                     $ fmt_semicolon )
                 $ cmt_after_type )
             $ fmt_attributes c ~pre:(Break (1, 1)) atrs )
-        $ fmt_docstring_padded c doc
-        $ Cmts.fmt_after c pld_loc ) )
+        $ fmt_docstring_padded c doc )
+    $ Cmts.fmt_after c pld_loc )
 
 and fmt_constructor_declaration c ctx ~first ~last:_ cstr_decl =
   let { pcd_name= {txt; loc}
diff --git a/test/passing/tests/comments_in_record.ml.ref b/test/passing/tests/comments_in_record.ml.ref
index 6bdbdec0a5..7d40f5f419 100644
--- a/test/passing/tests/comments_in_record.ml.ref
+++ b/test/passing/tests/comments_in_record.ml.ref
@@ -40,8 +40,8 @@ type t =
         (* aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb
            cccccccccccccccccccccccccccc ddddddddddddddddd eeeee *)
   ; b: float
-        (* aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb
-           cccccccccccccccccccccccccccc ddddddddddddddddd eeeee *) }
+    (* aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb
+       cccccccccccccccccccccccccccc ddddddddddddddddd eeeee *) }
 
 type t =
   | Tuple of {elts: t vector; packed: bool}
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index a4cbfeecd4..ac60e975ba 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -9689,7 +9689,7 @@ type t =
 
 type t =
   { field : ty
-        (* Here is some verbatim formatted text:
+    (* Here is some verbatim formatted text:
      {v
        starting at column 7
      v}*)

From efcbba3bb86bd83a93b44b84d5c00e64ed747828 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Fri, 17 Mar 2023 23:07:16 +0100
Subject: [PATCH 005/115] ocp-indent-compat: Break before type constructors

---
 lib/Fmt_ast.ml                          | 9 ++++++++-
 test/passing/tests/ocp_indent_compat.ml | 2 +-
 2 files changed, 9 insertions(+), 2 deletions(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 93d1c35552..1447e93251 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -88,6 +88,12 @@ module Indent = struct
   let fun_args = _ocp 6 4
 end
 
+module Break = struct
+  let _ocp a b c = fmt (if c.conf.fmt_opts.ocp_indent_compat.v then a else b)
+
+  let type_constr = _ocp "@;<1 2>" "@ "
+end
+
 (* Debug: catch and report failures at nearest enclosing Ast.t *)
 
 let protect =
@@ -803,7 +809,8 @@ and fmt_core_type c ?(box = true) ?pro ?(pro_space = true) ?constraint_ctx
           (list xt1N (arrow_sep c ~parens) (fmt_arrow_param c ctx))
   | Ptyp_constr (lid, []) -> fmt_longident_loc c lid
   | Ptyp_constr (lid, [t1]) ->
-      fmt_core_type c (sub_typ ~ctx t1) $ fmt "@ " $ fmt_longident_loc c lid
+      fmt_core_type c (sub_typ ~ctx t1)
+      $ Break.type_constr c $ fmt_longident_loc c lid
   | Ptyp_constr (lid, t1N) ->
       wrap_fits_breaks c.conf "(" ")"
         (list t1N (Params.comma_sep c.conf)
diff --git a/test/passing/tests/ocp_indent_compat.ml b/test/passing/tests/ocp_indent_compat.ml
index b96d9110fc..aa846b884b 100644
--- a/test/passing/tests/ocp_indent_compat.ml
+++ b/test/passing/tests/ocp_indent_compat.ml
@@ -25,7 +25,7 @@ module type M = sig
 
   val imported_sets_of_closures_table
     : Simple_value_approx.function_declarations option
-      Set_of_closures_id.Tbl.t
+        Set_of_closures_id.Tbl.t
 
   type 'a option_decl =
     names:string list

From 7256e1a1b8319d152c317cac91accc3e36780108 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Fri, 17 Mar 2023 23:47:50 +0100
Subject: [PATCH 006/115] De-indent left-separated tuples

In some contextes like attribute or extension payloads, tuples must be
indented negatively instead of relying on the parent box.
---
 lib/Fmt_ast.ml                          |  4 ++--
 lib/Params.ml                           | 13 +++++++++----
 lib/Params.mli                          |  2 ++
 test/passing/tests/js_source.ml         | 14 ++++++++++++++
 test/passing/tests/js_source.ml.ocp     | 18 ++++++++++++++++++
 test/passing/tests/js_source.ml.ref     | 18 ++++++++++++++++++
 test/passing/tests/string.ml.ref        |  2 +-
 test/passing/tests/tuple.ml             |  8 ++++----
 test/passing/tests/tuple_less_parens.ml |  8 ++++----
 9 files changed, 72 insertions(+), 15 deletions(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 1447e93251..74b0ba3f39 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -1011,7 +1011,7 @@ and fmt_pattern ?ext c ?pro ?parens ?(box = false)
       in
       hvbox 0
         (Params.wrap_tuple ~parens ~no_parens_if_break:false c.conf
-           (list pats (Params.comma_sep c.conf)
+           (list_k pats (Params.tuple_sep c.conf)
               (sub_pat ~ctx >> fmt_pattern c) ) )
   | Ppat_construct ({txt= Lident (("()" | "[]") as txt); loc}, None) ->
       let opn = txt.[0] and cls = txt.[1] in
@@ -2450,7 +2450,7 @@ and fmt_expression c ?(box = true) ?pro ?epi ?eol ?parens ?(indent_wrap = 0)
            ( hvbox 0
                (Params.wrap_tuple ~parens:inner_wrap ~no_parens_if_break
                   c.conf
-                  (list es (Params.comma_sep c.conf)
+                  (list_k es (Params.tuple_sep c.conf)
                      (sub_exp ~ctx >> fmt_expression c) ) )
            $ fmt_atrs ) )
   | Pexp_lazy e ->
diff --git a/lib/Params.ml b/lib/Params.ml
index 9e76b4b481..63f6fcd896 100644
--- a/lib/Params.ml
+++ b/lib/Params.ml
@@ -206,10 +206,15 @@ let wrap_collec c ~space_around opn cls =
 let wrap_record (c : Conf.t) =
   wrap_collec c ~space_around:c.fmt_opts.space_around_records.v "{" "}"
 
-let wrap_tuple (c : Conf.t) ~parens ~no_parens_if_break =
-  if parens then wrap_fits_breaks c "(" ")"
-  else if no_parens_if_break then Fn.id
-  else wrap_k (fits_breaks "" "( ") (fits_breaks "" ~hint:(1, 0) ")")
+let wrap_tuple (c : Conf.t) ~parens ~no_parens_if_break k =
+  if parens then wrap_fits_breaks c "(" ")" (hvbox 0 k)
+  else if no_parens_if_break then k
+  else fits_breaks "" "( " $ hvbox 0 k $ fits_breaks "" ~hint:(1, 0) ")"
+
+let tuple_sep (c : Conf.t) =
+  match c.fmt_opts.break_separators.v with
+  | `Before -> fits_breaks ", " ~hint:(1000, -2) ", "
+  | `After -> fmt ",@ "
 
 type record_type =
   { docked_before: Fmt.t
diff --git a/lib/Params.mli b/lib/Params.mli
index 58c27d4dbc..4294fc179c 100644
--- a/lib/Params.mli
+++ b/lib/Params.mli
@@ -59,6 +59,8 @@ val get_cases :
 val wrap_tuple :
   Conf.t -> parens:bool -> no_parens_if_break:bool -> Fmt.t -> Fmt.t
 
+val tuple_sep : Conf.t -> Fmt.t
+
 type record_type =
   { docked_before: Fmt.t
   ; break_before: Fmt.t
diff --git a/test/passing/tests/js_source.ml b/test/passing/tests/js_source.ml
index b064e87be0..ca9d1ecb75 100644
--- a/test/passing/tests/js_source.ml
+++ b/test/passing/tests/js_source.ml
@@ -7663,3 +7663,17 @@ let _ =
                                          eeee) -> FFFFFFFFF gg)
     ~h
 ;;
+
+type t
+[@@deriving
+  some_deriver_name
+, another_deriver_name
+, another_deriver_name
+, another_deriver_name
+, yet_another_such_name
+, such_that_they_line_wrap]
+
+type t
+[@@deriving
+  some_deriver_name another_deriver_name another_deriver_name
+    another_deriver_name yet_another_such_name such_that_they_line_wrap]
diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp
index ece5cab602..374f467e5c 100644
--- a/test/passing/tests/js_source.ml.ocp
+++ b/test/passing/tests/js_source.ml.ocp
@@ -9871,3 +9871,21 @@ let _ =
         (_ : (ccccccccccccc * ddddddddddddddddddddddddddddd) eeee) -> FFFFFFFFF gg)
     ~h
 ;;
+
+type t
+[@@deriving
+  some_deriver_name
+, another_deriver_name
+, another_deriver_name
+, another_deriver_name
+, yet_another_such_name
+, such_that_they_line_wrap]
+
+type t
+[@@deriving
+  some_deriver_name
+    another_deriver_name
+    another_deriver_name
+    another_deriver_name
+    yet_another_such_name
+    such_that_they_line_wrap]
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index ac60e975ba..e72ac16f3f 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -9871,3 +9871,21 @@ let _ =
         (_ : (ccccccccccccc * ddddddddddddddddddddddddddddd) eeee) -> FFFFFFFFF gg)
     ~h
 ;;
+
+type t
+[@@deriving
+  some_deriver_name
+, another_deriver_name
+, another_deriver_name
+, another_deriver_name
+, yet_another_such_name
+, such_that_they_line_wrap]
+
+type t
+[@@deriving
+  some_deriver_name
+    another_deriver_name
+    another_deriver_name
+    another_deriver_name
+    yet_another_such_name
+    such_that_they_line_wrap]
diff --git a/test/passing/tests/string.ml.ref b/test/passing/tests/string.ml.ref
index 1d0ed4a0b7..aca6882ba8 100644
--- a/test/passing/tests/string.ml.ref
+++ b/test/passing/tests/string.ml.ref
@@ -4,7 +4,7 @@ let f = function
         [%sexp
           "Xxxx \036 \036 \036 \036 \036 \036 \036 xxx xxxx xx xxxxxx xx \
            xxx xxxxxxx xxxxxx, xxxxxxx xxxxxxxxxx xx xxxx.  Xxxx."
-          , 0]
+        , 0]
 
 let _ = "\010\xFFa\o123\n\\\u{12345}aa🐪🐪🐪🐪🐪\n"
 
diff --git a/test/passing/tests/tuple.ml b/test/passing/tests/tuple.ml
index d3bade6084..94258441fe 100644
--- a/test/passing/tests/tuple.ml
+++ b/test/passing/tests/tuple.ml
@@ -14,16 +14,16 @@ let _ = [%ext 1, 2, 3]
 let _ =
   [%ext
     loooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong
-    , 2
-    , 3]
+  , 2
+  , 3]
 
 type t = int [@@deriving 1, 2, 3]
 
 type t = int
 [@@deriving
   sexp
-  , compare
-  , loooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong]
+, compare
+, loooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong]
 
 let _ =
   ( 1
diff --git a/test/passing/tests/tuple_less_parens.ml b/test/passing/tests/tuple_less_parens.ml
index 9c22d9f8d1..b0a09269d8 100644
--- a/test/passing/tests/tuple_less_parens.ml
+++ b/test/passing/tests/tuple_less_parens.ml
@@ -14,16 +14,16 @@ let _ = [%ext 1, 2, 3]
 let _ =
   [%ext
     loooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong
-    , 2
-    , 3]
+  , 2
+  , 3]
 
 type t = int [@@deriving 1, 2, 3]
 
 type t = int
 [@@deriving
   sexp
-  , compare
-  , loooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong]
+, compare
+, loooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong]
 
 let _ =
   ( 1

From 574d62b8f16c55ccde309770229ccfe319e75faa Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Tue, 21 Mar 2023 18:48:23 +0100
Subject: [PATCH 007/115] ocp-indent-compat: Docked function cases

---
 lib/Fmt_ast.ml                      | 15 ++++++++-------
 test/passing/tests/js_source.ml     |  8 ++++++++
 test/passing/tests/js_source.ml.ocp |  8 ++++++++
 test/passing/tests/js_source.ml.ref |  8 ++++++++
 tools/test_branch.sh                | 22 +++++++++++++---------
 5 files changed, 45 insertions(+), 16 deletions(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 74b0ba3f39..61d9441ae8 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -86,6 +86,12 @@ module Indent = struct
   let fun_type_annot = _ocp 2 4
 
   let fun_args = _ocp 6 4
+
+  let docked_function ~ctx c =
+    if c.conf.fmt_opts.ocp_indent_compat.v then 3
+    else
+      let default = if c.conf.fmt_opts.wrap_fun_args.v then 2 else 4 in
+      Params.function_indent c.conf ~ctx ~default
 end
 
 module Break = struct
@@ -1951,13 +1957,8 @@ and fmt_expression c ?(box = true) ?pro ?epi ?eol ?parens ?(indent_wrap = 0)
                  is_simple c.conf (fun _ -> 0) (sub_exp ~ctx eI) ) ->
           let e1N = List.rev rev_e1N in
           let ctx'' = Exp eN in
-          let default_indent =
-            if c.conf.fmt_opts.wrap_fun_args.v then 2 else 4
-          in
-          let indent =
-            Params.function_indent c.conf ~ctx ~default:default_indent
-          in
-          hvbox indent
+          hvbox
+            (Indent.docked_function ~ctx c)
             (Params.parens_if parens c.conf
                ( hovbox 2
                    (wrap
diff --git a/test/passing/tests/js_source.ml b/test/passing/tests/js_source.ml
index ca9d1ecb75..7ef008f7d0 100644
--- a/test/passing/tests/js_source.ml
+++ b/test/passing/tests/js_source.ml
@@ -7677,3 +7677,11 @@ type t
 [@@deriving
   some_deriver_name another_deriver_name another_deriver_name
     another_deriver_name yet_another_such_name such_that_they_line_wrap]
+
+let pat =
+  String.Search_pattern.create
+    (String.init len ~f:(function
+        | 0 -> '\n'
+        | n when n < len - 1 -> ' '
+        | _ -> '*'))
+;;
diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp
index 374f467e5c..f3be9a98b0 100644
--- a/test/passing/tests/js_source.ml.ocp
+++ b/test/passing/tests/js_source.ml.ocp
@@ -9889,3 +9889,11 @@ type t
     another_deriver_name
     yet_another_such_name
     such_that_they_line_wrap]
+
+let pat =
+  String.Search_pattern.create
+    (String.init len ~f:(function
+       | 0 -> '\n'
+       | n when n < len - 1 -> ' '
+       | _ -> '*'))
+;;
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index e72ac16f3f..380faec066 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -9889,3 +9889,11 @@ type t
     another_deriver_name
     yet_another_such_name
     such_that_they_line_wrap]
+
+let pat =
+  String.Search_pattern.create
+    (String.init len ~f:(function
+       | 0 -> '\n'
+       | n when n < len - 1 -> ' '
+       | _ -> '*'))
+;;
diff --git a/tools/test_branch.sh b/tools/test_branch.sh
index 6513471646..1167aada1d 100755
--- a/tools/test_branch.sh
+++ b/tools/test_branch.sh
@@ -20,7 +20,8 @@
 # If -n is passed, values of -a and -b are paths to ocamlformat binaries
 # instead of revs.
 #
-# If -o is passed, ocp-indent is applied after ocamlformat in each pass.
+# If -o is passed, ocp-indent is applied after ocamlformat in the first pass.
+# Pass it twice to apply ocp-indent after each passes.
 # Options can be passed to it using the 'OCP_INDENT_CONFIG' environment
 # variable.
 #
@@ -47,7 +48,7 @@ while getopts "a:b:nol" opt; do
     a) arg_a=$OPTARG ;;
     b) arg_b=$OPTARG ;;
     n) arg_n=1 ;;
-    o) arg_o=1 ;;
+    o) arg_o=$((arg_o + 1)) ;;
     l) arg_l=1 ;;
   esac
 done
@@ -102,13 +103,16 @@ else
   exe_b=`realpath $arg_b`
 fi
 
-make -C test-extra test_setup test_unstage test_clean
+run () { make -C test-extra "$@"; }
+
+run test_setup test_unstage test_clean
 if [[ $arg_l -eq 0 ]]; then
-  make -C test-extra test_pull
+  run test_pull
 fi
 
-apply_ocp=()
-if [[ $arg_o -eq 1 ]]; then apply_ocp=(apply_ocp); fi
-
-OCAMLFORMAT="$opts_a" make -C test-extra "OCAMLFORMAT_EXE=$exe_a" test "${apply_ocp[@]}" test_stage
-OCAMLFORMAT="$opts_b" make -C test-extra "OCAMLFORMAT_EXE=$exe_b" test "${apply_ocp[@]}" test_diff
+OCAMLFORMAT="$opts_a" run "OCAMLFORMAT_EXE=$exe_a" test
+if [[ $arg_o -ge 1 ]]; then run apply_ocp; fi
+run test_stage
+OCAMLFORMAT="$opts_b" run "OCAMLFORMAT_EXE=$exe_b" test
+if [[ $arg_o -ge 2 ]]; then run apply_ocp; fi
+run test_diff

From 2ea9bf830b14aec8d0232d61f2abf086842c662c Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Tue, 21 Mar 2023 19:01:45 +0100
Subject: [PATCH 008/115] ocp-indent-compat: `fun` arguments

---
 lib/Fmt_ast.ml                      |  8 +++++++-
 test/passing/tests/js_source.ml.ref | 10 +++++-----
 2 files changed, 12 insertions(+), 6 deletions(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 61d9441ae8..23580d45c4 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -92,6 +92,10 @@ module Indent = struct
     else
       let default = if c.conf.fmt_opts.wrap_fun_args.v then 2 else 4 in
       Params.function_indent c.conf ~ctx ~default
+
+  let fun_args_group ast c =
+    if not c.conf.fmt_opts.ocp_indent_compat.v then 2
+    else match ast.pexp_desc with Pexp_function _ -> 2 | _ -> 3
 end
 
 module Break = struct
@@ -1454,7 +1458,9 @@ and fmt_args_grouped ?epi:(global_epi = noop) c ctx args =
       | Nolabel, _ -> Some (fits_breaks "" ~hint:(1000, -1) "")
       | _ -> Some (fits_breaks "" ~hint:(1000, -3) "")
     in
-    hovbox 2 (fmt_label_arg c ?box ?epi (lbl, xarg))
+    hovbox
+      (Indent.fun_args_group ast c)
+      (fmt_label_arg c ?box ?epi (lbl, xarg))
     $ fmt_if_k (not last) (break_unless_newline 1 0)
   in
   let fmt_args ~first ~last args =
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index 380faec066..317f9248c5 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -910,8 +910,8 @@ let id x = x
 
 let idb1 =
   (fun id ->
-    let _ = id true in
-    id)
+     let _ = id true in
+     id)
     id
 ;;
 
@@ -1059,8 +1059,8 @@ let rec devariantize : type t. t ty -> variant -> t =
     let builder = create_builder () in
     List.iter2
       (fun (Field { label; field_type; set }) (lab, v) ->
-        if label <> lab then raise VariantMismatch;
-        set builder (devariantize field_type v))
+         if label <> lab then raise VariantMismatch;
+         set builder (devariantize field_type v))
       fields
       fl;
     of_builder builder
@@ -9642,7 +9642,7 @@ let _ =
 let g =
   f
     ~x
-      (* this is a multiple-line-spanning
+       (* this is a multiple-line-spanning
                 comment *)
     ~y
 ;;

From fad20375061ed4e4db1fab5b1d9d79dec0f22e30 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Tue, 21 Mar 2023 19:20:41 +0100
Subject: [PATCH 009/115] ocp-indent-compat: Docstring after record field decl

---
 lib/Fmt_ast.ml                      | 11 ++++++++++-
 test/passing/tests/js_source.ml     |  9 +++++++++
 test/passing/tests/js_source.ml.ocp | 10 ++++++++++
 test/passing/tests/js_source.ml.ref | 10 ++++++++++
 4 files changed, 39 insertions(+), 1 deletion(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 23580d45c4..9efe730b9b 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -96,6 +96,14 @@ module Indent = struct
   let fun_args_group ast c =
     if not c.conf.fmt_opts.ocp_indent_compat.v then 2
     else match ast.pexp_desc with Pexp_function _ -> 2 | _ -> 3
+
+  let record_docstring c =
+    let ocp =
+      match c.conf.fmt_opts.break_separators.v with
+      | `Before -> -2
+      | `After -> 0
+    in
+    _ocp ocp 4 c
 end
 
 module Break = struct
@@ -3219,7 +3227,8 @@ and fmt_label_declaration c ctx ?(last = false) decl =
   in
   hovbox 0
     ( Cmts.fmt_before c pld_loc
-    $ hvbox 4
+    $ hvbox
+        (Indent.record_docstring c)
         ( hvbox 3
             ( hvbox 4
                 ( hvbox 2
diff --git a/test/passing/tests/js_source.ml b/test/passing/tests/js_source.ml
index 7ef008f7d0..fa747abc11 100644
--- a/test/passing/tests/js_source.ml
+++ b/test/passing/tests/js_source.ml
@@ -7685,3 +7685,12 @@ let pat =
         | n when n < len - 1 -> ' '
         | _ -> '*'))
 ;;
+
+type t =
+  { break_separators: [`Before | `After]
+  ; break_sequences: bool
+  ; break_string_literals: [`Auto | `Never]
+        (** How to potentially break string literals into new lines. *)
+  ; break_struct: bool
+  ; cases_exp_indent: int
+  ; cases_matching_exp_indent: [`Normal | `Compact] }
diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp
index f3be9a98b0..83a074b3d1 100644
--- a/test/passing/tests/js_source.ml.ocp
+++ b/test/passing/tests/js_source.ml.ocp
@@ -9897,3 +9897,13 @@ let pat =
        | n when n < len - 1 -> ' '
        | _ -> '*'))
 ;;
+
+type t =
+  { break_separators : [ `Before | `After ]
+  ; break_sequences : bool
+  ; break_string_literals : [ `Auto | `Never ]
+  (** How to potentially break string literals into new lines. *)
+  ; break_struct : bool
+  ; cases_exp_indent : int
+  ; cases_matching_exp_indent : [ `Normal | `Compact ]
+  }
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index 317f9248c5..caf129c5ec 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -9897,3 +9897,13 @@ let pat =
        | n when n < len - 1 -> ' '
        | _ -> '*'))
 ;;
+
+type t =
+  { break_separators : [ `Before | `After ]
+  ; break_sequences : bool
+  ; break_string_literals : [ `Auto | `Never ]
+  (** How to potentially break string literals into new lines. *)
+  ; break_struct : bool
+  ; cases_exp_indent : int
+  ; cases_matching_exp_indent : [ `Normal | `Compact ]
+  }

From 6756d12e6033e134a6f462c9d8f0a21e02afc7ef Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Tue, 21 Mar 2023 19:26:58 +0100
Subject: [PATCH 010/115] ocp-indent-compat: Recursive function arguments

---
 lib/Fmt_ast.ml                      |  5 +++--
 test/passing/tests/js_source.ml     |  4 ++++
 test/passing/tests/js_source.ml.ocp | 12 ++++++++++++
 test/passing/tests/js_source.ml.ref | 12 ++++++++++++
 4 files changed, 31 insertions(+), 2 deletions(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 9efe730b9b..cb17b84eaf 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -85,7 +85,7 @@ module Indent = struct
 
   let fun_type_annot = _ocp 2 4
 
-  let fun_args = _ocp 6 4
+  let fun_args ?(rec_flag = false) = _ocp (if rec_flag then 10 else 6) 4
 
   let docked_function ~ctx c =
     if c.conf.fmt_opts.ocp_indent_compat.v then 3
@@ -4260,7 +4260,8 @@ and fmt_value_binding c ~rec_flag ?ext ?in_ ?epi ctx
               ( hvbox_if toplevel indent
                   ( hovbox 2
                       ( hovbox (Indent.fun_type_annot c)
-                          ( box_fun_decl_args c (Indent.fun_args c)
+                          ( box_fun_decl_args c
+                              (Indent.fun_args ~rec_flag c)
                               ( hovbox 4
                                   ( fmt_str_loc c lb_op
                                   $ fmt_extension_suffix c ext
diff --git a/test/passing/tests/js_source.ml b/test/passing/tests/js_source.ml
index fa747abc11..07e900b4ef 100644
--- a/test/passing/tests/js_source.ml
+++ b/test/passing/tests/js_source.ml
@@ -7694,3 +7694,7 @@ type t =
   ; break_struct: bool
   ; cases_exp_indent: int
   ; cases_matching_exp_indent: [`Normal | `Compact] }
+
+let rec collect_files ~enable_outside_detected_project ~root ~segs ~ignores
+    ~enables ~files =
+  match segs with [] | [""] -> (ignores, enables, files, None)
diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp
index 83a074b3d1..044d0cb340 100644
--- a/test/passing/tests/js_source.ml.ocp
+++ b/test/passing/tests/js_source.ml.ocp
@@ -9907,3 +9907,15 @@ type t =
   ; cases_exp_indent : int
   ; cases_matching_exp_indent : [ `Normal | `Compact ]
   }
+
+let rec collect_files
+          ~enable_outside_detected_project
+          ~root
+          ~segs
+          ~ignores
+          ~enables
+          ~files
+  =
+  match segs with
+  | [] | [ "" ] -> ignores, enables, files, None
+;;
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index caf129c5ec..2d2378c3cc 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -9907,3 +9907,15 @@ type t =
   ; cases_exp_indent : int
   ; cases_matching_exp_indent : [ `Normal | `Compact ]
   }
+
+let rec collect_files
+          ~enable_outside_detected_project
+          ~root
+          ~segs
+          ~ignores
+          ~enables
+          ~files
+  =
+  match segs with
+  | [] | [ "" ] -> ignores, enables, files, None
+;;

From 4d0e61005a9e41bc5d130eec77c8b8a250a89181 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Tue, 21 Mar 2023 21:06:30 +0100
Subject: [PATCH 011/115] ocp-indent-compat: Labelled non-docked fun args

---
 lib/Fmt_ast.ml                      | 15 ++++++++------
 test/passing/tests/js_source.ml.ref | 32 ++++++++++++++---------------
 2 files changed, 25 insertions(+), 22 deletions(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 061ac25803..8fb1351a56 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -93,15 +93,18 @@ module Indent = struct
 
   let fun_args ?(rec_flag = false) = _ocp (if rec_flag then 10 else 6) 4
 
-  let docked_function ~ctx c =
-    if c.conf.fmt_opts.ocp_indent_compat.v then 3
+  let docked_function ~parens ~ctx c =
+    if c.conf.fmt_opts.ocp_indent_compat.v then if parens then 3 else 2
     else
       let default = if c.conf.fmt_opts.wrap_fun_args.v then 2 else 4 in
       Params.function_indent c.conf ~ctx ~default
 
-  let fun_args_group ast c =
+  let fun_args_group lbl ast c =
     if not c.conf.fmt_opts.ocp_indent_compat.v then 2
-    else match ast.pexp_desc with Pexp_function _ -> 2 | _ -> 3
+    else
+      match ast.pexp_desc with
+      | Pexp_function _ -> 2
+      | _ -> ( match lbl with Nolabel -> 3 | _ -> 2 )
 
   let record_docstring c =
     let ocp =
@@ -1473,7 +1476,7 @@ and fmt_args_grouped ?epi:(global_epi = noop) c ctx args =
       | _ -> Some (fits_breaks "" ~hint:(1000, -3) "")
     in
     hovbox
-      (Indent.fun_args_group ast c)
+      (Indent.fun_args_group lbl ast c)
       (fmt_label_arg c ?box ?epi (lbl, xarg))
     $ fmt_if_k (not last) (break_unless_newline 1 0)
   in
@@ -2000,7 +2003,7 @@ and fmt_expression c ?(box = true) ?pro ?epi ?eol ?parens ?(indent_wrap = 0)
           let e1N = List.rev rev_e1N in
           let ctx'' = Exp eN in
           hvbox
-            (Indent.docked_function ~ctx c)
+            (Indent.docked_function ~parens ~ctx c)
             ( expr_epi
             $ Params.parens_if parens c.conf
                 ( wrap
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index 8224d6d7ee..e406507f7d 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -9642,7 +9642,7 @@ let _ =
 let g =
   f
     ~x
-       (* this is a multiple-line-spanning
+      (* this is a multiple-line-spanning
                 comment *)
     ~y
 ;;
@@ -9969,11 +9969,11 @@ let _ = foo |> List.map (function A -> do_something ())
 let _ =
   foo
   |> List.map (function
-     | A -> do_something ()
-     | A -> do_something ()
-     | A -> do_something ()
-     | A -> do_something ()
-     | A -> do_something_else ())
+    | A -> do_something ()
+    | A -> do_something ()
+    | A -> do_something ()
+    | A -> do_something ()
+    | A -> do_something_else ())
   |> bar
 ;;
 
@@ -9981,16 +9981,16 @@ let _ =
   foo
   |> List.double_map
        ~f1:(fun x ->
-          do_something ();
-          do_something ();
-          do_something ();
-          do_something ();
-          do_something_else ())
+         do_something ();
+         do_something ();
+         do_something ();
+         do_something ();
+         do_something_else ())
        ~f2:(fun x ->
-          do_something ();
-          do_something ();
-          do_something ();
-          do_something ();
-          do_something_else ())
+         do_something ();
+         do_something ();
+         do_something ();
+         do_something ();
+         do_something_else ())
   |> bar
 ;;

From 484a31a87136905750252bfbfd23f36e08acdc8a Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Tue, 21 Mar 2023 21:48:33 +0100
Subject: [PATCH 012/115] ocp-indent-compat: Module unpack annotation

---
 lib/Fmt_ast.ml                      | 13 ++++++++-----
 test/passing/tests/js_source.ml     |  7 +++++++
 test/passing/tests/js_source.ml.ocp | 10 ++++++++++
 test/passing/tests/js_source.ml.ref | 10 ++++++++++
 4 files changed, 35 insertions(+), 5 deletions(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 8fb1351a56..764992655c 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -119,6 +119,8 @@ module Break = struct
   let _ocp a b c = fmt (if c.conf.fmt_opts.ocp_indent_compat.v then a else b)
 
   let type_constr = _ocp "@;<1 2>" "@ "
+
+  let unpack_annot = _ocp "@ " "@;<1 2>"
 end
 
 (* Debug: catch and report failures at nearest enclosing Ast.t *)
@@ -4058,9 +4060,10 @@ and fmt_module_expr ?(dock_struct = true) c ({ast= m; _} as xmod) =
             $ after ) }
   | Pmod_unpack (e, ty1, ty2) ->
       let package_type sep (lid, cstrs) =
-        hvbox 0
-          ( hovbox 0 (str sep $ fmt_longident_loc c lid)
-          $ fmt_package_type c ctx cstrs )
+        Break.unpack_annot c
+        $ hvbox 0
+            ( hovbox 0 (str sep $ fmt_longident_loc c lid)
+            $ fmt_package_type c ctx cstrs )
       in
       { empty with
         opn= Some (open_hvbox 2)
@@ -4071,8 +4074,8 @@ and fmt_module_expr ?(dock_struct = true) c ({ast= m; _} as xmod) =
                 (wrap_fits_breaks ~space:false c.conf "(" ")"
                    ( str "val "
                    $ fmt_expression c (sub_exp ~ctx e)
-                   $ opt ty1 (fun x -> break 1 2 $ package_type ": " x)
-                   $ opt ty2 (fun x -> break 1 2 $ package_type ":> " x) ) )
+                   $ opt ty1 (package_type ": ")
+                   $ opt ty2 (package_type ":> ") ) )
             $ fmt_attributes_and_docstrings c pmod_attributes ) }
   | Pmod_extension x1 ->
       { empty with
diff --git a/test/passing/tests/js_source.ml b/test/passing/tests/js_source.ml
index e5bb1f486a..73bba657bf 100644
--- a/test/passing/tests/js_source.ml
+++ b/test/passing/tests/js_source.ml
@@ -7768,3 +7768,10 @@ let _ =
           do_something ();
           do_something_else ())
   |> bar
+
+let _ =
+  let module M = struct
+    include ( val foooooooooooooooooooooooooooooooooooooooo
+                : fooooooooooooooooooooooooooooooooooooooooo )
+  end in
+  ()
diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp
index a71532d846..b0a01a72dd 100644
--- a/test/passing/tests/js_source.ml.ocp
+++ b/test/passing/tests/js_source.ml.ocp
@@ -9994,3 +9994,13 @@ let _ =
          do_something_else ())
   |> bar
 ;;
+
+let _ =
+  let module M = struct
+    include
+      (val foooooooooooooooooooooooooooooooooooooooo
+        : fooooooooooooooooooooooooooooooooooooooooo)
+  end
+  in
+  ()
+;;
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index e406507f7d..4f820e03ab 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -9994,3 +9994,13 @@ let _ =
          do_something_else ())
   |> bar
 ;;
+
+let _ =
+  let module M = struct
+    include
+      (val foooooooooooooooooooooooooooooooooooooooo
+        : fooooooooooooooooooooooooooooooooooooooooo)
+  end
+  in
+  ()
+;;

From 89d2da3b225294590e1f36a37464fe01984c2a14 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Tue, 21 Mar 2023 21:56:22 +0100
Subject: [PATCH 013/115] ocp-indent-compat: Expression type constraint

---
 lib/Fmt_ast.ml                      | 4 +++-
 test/passing/tests/js_source.ml.err | 1 -
 test/passing/tests/js_source.ml.ref | 6 +++---
 3 files changed, 6 insertions(+), 5 deletions(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 764992655c..b802d56356 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -113,6 +113,8 @@ module Indent = struct
       | `After -> 0
     in
     _ocp ocp 4 c
+
+  let exp_constraint = _ocp 1 2
 end
 
 module Break = struct
@@ -2079,7 +2081,7 @@ and fmt_expression c ?(box = true) ?pro ?epi ?eol ?parens ?(indent_wrap = 0)
         c.conf
         (fmt_constant c ?epi const $ fmt_atrs)
   | Pexp_constraint (e, t) ->
-      hvbox 2
+      hvbox (Indent.exp_constraint c)
         ( wrap_fits_breaks ~space:false c.conf "(" ")"
             ( fmt_expression c (sub_exp ~ctx e)
             $ fmt "@ : "
diff --git a/test/passing/tests/js_source.ml.err b/test/passing/tests/js_source.ml.err
index be4486aef5..d50afc786d 100644
--- a/test/passing/tests/js_source.ml.err
+++ b/test/passing/tests/js_source.ml.err
@@ -1,5 +1,4 @@
 Warning: tests/js_source.ml:155 exceeds the margin
-Warning: tests/js_source.ml:3554 exceeds the margin
 Warning: tests/js_source.ml:9515 exceeds the margin
 Warning: tests/js_source.ml:9618 exceeds the margin
 Warning: tests/js_source.ml:9637 exceeds the margin
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index 4f820e03ab..37ef85fd7c 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -3552,7 +3552,7 @@ let ssmap =
    end
    in
    (module S)
-    : (module MapT with type key = string and type data = string and type map = SSMap.map))
+   : (module MapT with type key = string and type data = string and type map = SSMap.map))
 ;;
 
 let ssmap = (module SSMap : MapT with type key = _ and type data = _ and type map = _)
@@ -9847,14 +9847,14 @@ let () =
 
 let () =
   ((one_mississippi, two_mississippi, three_mississippi, four_mississippi)
-    : Mississippi.t * Mississippi.t * Mississippi.t * Mississippi.t)
+   : Mississippi.t * Mississippi.t * Mississippi.t * Mississippi.t)
 ;;
 
 let _ =
   ((match foo with
     | Bar -> bar
     | Baz -> baz)
-    : string)
+   : string)
 ;;
 
 let _ =

From bc1cef60374630b4b6f060e3ecec5f56811f190a Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Wed, 22 Mar 2023 16:19:06 +0100
Subject: [PATCH 014/115] Revert "ocp-indent-compat: Recursive function
 arguments"

This reverts commit 6756d12e6033e134a6f462c9d8f0a21e02afc7ef.
---
 lib/Fmt_ast.ml                      |  5 ++---
 test/passing/tests/js_source.ml.ref | 12 ++++++------
 2 files changed, 8 insertions(+), 9 deletions(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index b802d56356..cf762a0c6c 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -91,7 +91,7 @@ module Indent = struct
 
   let fun_type_annot = _ocp 2 4
 
-  let fun_args ?(rec_flag = false) = _ocp (if rec_flag then 10 else 6) 4
+  let fun_args = _ocp 6 4
 
   let docked_function ~parens ~ctx c =
     if c.conf.fmt_opts.ocp_indent_compat.v then if parens then 3 else 2
@@ -4312,8 +4312,7 @@ and fmt_value_binding c ~rec_flag ?ext ?in_ ?epi ctx
               ( hvbox_if toplevel indent
                   ( hovbox 2
                       ( hovbox (Indent.fun_type_annot c)
-                          ( box_fun_decl_args c
-                              (Indent.fun_args ~rec_flag c)
+                          ( box_fun_decl_args c (Indent.fun_args c)
                               ( hovbox 4
                                   ( fmt_str_loc c lb_op
                                   $ fmt_extension_suffix c ext
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index 37ef85fd7c..d55f17d612 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -9909,12 +9909,12 @@ type t =
   }
 
 let rec collect_files
-          ~enable_outside_detected_project
-          ~root
-          ~segs
-          ~ignores
-          ~enables
-          ~files
+      ~enable_outside_detected_project
+      ~root
+      ~segs
+      ~ignores
+      ~enables
+      ~files
   =
   match segs with
   | [] | [ "" ] -> ignores, enables, files, None

From c9ef9727185143bbf2181dfdeb90cd6f7c5c1a14 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Wed, 22 Mar 2023 16:34:23 +0100
Subject: [PATCH 015/115] ocp-indent-compat: Align fun decl arguments

---
 lib/Fmt_ast.ml                      | 29 +++++++++++++++--------------
 lib/Params.ml                       |  5 +++++
 lib/Params.mli                      |  2 ++
 test/passing/tests/js_source.ml.ref | 12 ++++++------
 4 files changed, 28 insertions(+), 20 deletions(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index cf762a0c6c..5b2f65570d 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -4304,6 +4304,20 @@ and fmt_value_binding c ~rec_flag ?ext ?in_ ?epi ctx
         , Cmts.Toplevel.fmt_before c lb_loc
         , Cmts.Toplevel.fmt_after c lb_loc )
   in
+  let decl_args =
+    let decl =
+      fmt_str_loc c lb_op
+      $ fmt_extension_suffix c ext
+      $ fmt_attributes c at_attrs $ fmt_if rec_flag " rec"
+      $ fmt_or pat_has_cmt "@ " " "
+    and pattern = fmt_pattern c lb_pat
+    and args =
+      fmt_if_k
+        (not (List.is_empty xargs))
+        (fmt "@ " $ wrap_fun_decl_args c (fmt_fun_args c xargs))
+    in
+    box_fun_decl_args c 4 (Params.Align.fun_decl c.conf ~decl ~pattern ~args)
+  in
   fmt_docstring c ~epi:(fmt "@\n") doc1
   $ cmts_before
   $ hvbox 0
@@ -4312,20 +4326,7 @@ and fmt_value_binding c ~rec_flag ?ext ?in_ ?epi ctx
               ( hvbox_if toplevel indent
                   ( hovbox 2
                       ( hovbox (Indent.fun_type_annot c)
-                          ( box_fun_decl_args c (Indent.fun_args c)
-                              ( hovbox 4
-                                  ( fmt_str_loc c lb_op
-                                  $ fmt_extension_suffix c ext
-                                  $ fmt_attributes c at_attrs
-                                  $ fmt_if rec_flag " rec"
-                                  $ fmt_or pat_has_cmt "@ " " "
-                                  $ fmt_pattern c lb_pat )
-                              $ fmt_if_k
-                                  (not (List.is_empty xargs))
-                                  ( fmt "@ "
-                                  $ wrap_fun_decl_args c
-                                      (fmt_fun_args c xargs) ) )
-                          $ fmt_cstr )
+                          (decl_args $ fmt_cstr)
                       $ fmt_if_k (not lb_pun)
                           (fmt_or_k c.conf.fmt_opts.ocp_indent_compat.v
                              (fits_breaks " =" ~hint:(1000, 0) "=")
diff --git a/lib/Params.ml b/lib/Params.ml
index c69b2cfbf2..60ac4420bc 100644
--- a/lib/Params.ml
+++ b/lib/Params.ml
@@ -579,4 +579,9 @@ module Align = struct
       | _ -> parens && not c.fmt_opts.align_symbol_open_paren.v
     in
     hvbox_if align 0 t
+
+  let fun_decl (c : Conf.t) ~decl ~pattern ~args =
+    if c.fmt_opts.ocp_indent_compat.v then
+      hovbox 4 (decl $ hvbox 2 (pattern $ args))
+    else hovbox 4 (decl $ pattern) $ args
 end
diff --git a/lib/Params.mli b/lib/Params.mli
index 45571ed54a..f133acd4fb 100644
--- a/lib/Params.mli
+++ b/lib/Params.mli
@@ -154,4 +154,6 @@ module Align : sig
 
   val function_ :
     Conf.t -> parens:bool -> ctx0:Ast.t -> self:expression -> Fmt.t -> Fmt.t
+
+  val fun_decl : Conf.t -> decl:Fmt.t -> pattern:Fmt.t -> args:Fmt.t -> Fmt.t
 end
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index d55f17d612..37ef85fd7c 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -9909,12 +9909,12 @@ type t =
   }
 
 let rec collect_files
-      ~enable_outside_detected_project
-      ~root
-      ~segs
-      ~ignores
-      ~enables
-      ~files
+          ~enable_outside_detected_project
+          ~root
+          ~segs
+          ~ignores
+          ~enables
+          ~files
   =
   match segs with
   | [] | [ "" ] -> ignores, enables, files, None

From 50cc0170770a5e0655e128b1c30a95b988b7f5fe Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Wed, 22 Mar 2023 20:46:17 +0100
Subject: [PATCH 016/115] ocp-indent-compat: Begin-line assignment operator

---
 lib/Fmt_ast.ml                      | 20 +++++++++++++-------
 test/passing/tests/js_source.ml.err |  1 -
 test/passing/tests/js_source.ml.ref |  8 ++++----
 3 files changed, 17 insertions(+), 12 deletions(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 5b2f65570d..5ed6d8c6d3 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -123,6 +123,9 @@ module Break = struct
   let type_constr = _ocp "@;<1 2>" "@ "
 
   let unpack_annot = _ocp "@ " "@;<1 2>"
+
+  (** Valid for [assignment-operator = begin-line]. *)
+  let assignment_operator = _ocp "@ " "@;<1 2>"
 end
 
 (* Debug: catch and report failures at nearest enclosing Ast.t *)
@@ -529,7 +532,7 @@ let is_arrow_or_poly = function
 
 let fmt_assign_arrow c =
   match c.conf.fmt_opts.assignment_operator.v with
-  | `Begin_line -> fmt "@;<1 2><- "
+  | `Begin_line -> Break.assignment_operator c $ fmt "<- "
   | `End_line -> fmt " <-@;<1 2>"
 
 let arrow_sep c ~parens : Fmt.s =
@@ -1768,12 +1771,14 @@ and fmt_expression c ?(box = true) ?pro ?epi ?eol ?parens ?(indent_wrap = 0)
   | Pexp_infix ({txt= ":="; loc}, r, v)
     when is_simple c.conf (expression_width c) (sub_exp ~ctx r) ->
       let cmts_before =
-        let adj =
-          fmt_if
-            Poly.(c.conf.fmt_opts.assignment_operator.v = `End_line)
-            "@,"
+        let pro, adj =
+          (* Use the same break for comment and operator. Comments are placed
+             according to indentation. *)
+          match c.conf.fmt_opts.assignment_operator.v with
+          | `Begin_line -> (Break.assignment_operator c, noop)
+          | `End_line -> (break 1 2, fmt "@,")
         in
-        Cmts.fmt_before c loc ~pro:(break 1 2) ~epi:adj ~adj
+        Cmts.fmt_before c loc ~pro ~epi:adj ~adj
       in
       let cmts_after = Cmts.fmt_after c loc ~pro:noop ~epi:noop in
       Params.parens_if parens c.conf
@@ -1781,7 +1786,8 @@ and fmt_expression c ?(box = true) ?pro ?epi ?eol ?parens ?(indent_wrap = 0)
            ( match c.conf.fmt_opts.assignment_operator.v with
            | `Begin_line ->
                hvbox 0 (fmt_expression c (sub_exp ~ctx r) $ cmts_before)
-               $ fmt "@;<1 2>:= " $ cmts_after
+               $ Break.assignment_operator c
+               $ fmt ":= " $ cmts_after
                $ hvbox 2 (fmt_expression c (sub_exp ~ctx v))
            | `End_line ->
                hvbox 0
diff --git a/test/passing/tests/js_source.ml.err b/test/passing/tests/js_source.ml.err
index d50afc786d..116078db31 100644
--- a/test/passing/tests/js_source.ml.err
+++ b/test/passing/tests/js_source.ml.err
@@ -1,6 +1,5 @@
 Warning: tests/js_source.ml:155 exceeds the margin
 Warning: tests/js_source.ml:9515 exceeds the margin
 Warning: tests/js_source.ml:9618 exceeds the margin
-Warning: tests/js_source.ml:9637 exceeds the margin
 Warning: tests/js_source.ml:9677 exceeds the margin
 Warning: tests/js_source.ml:9759 exceeds the margin
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index 37ef85fd7c..8455fb9ddf 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -9415,8 +9415,8 @@ let foo : type a' b' c' t. a' -> b' -> c' -> t = fun a b c -> assert false
 
 let f x =
   x.contents
-    <- (print_string "coucou";
-        x.contents)
+  <- (print_string "coucou";
+      x.contents)
 ;;
 
 let ( ~$ ) x = Some x
@@ -9635,8 +9635,8 @@ let _ =
 
 let _ =
   aaaaaaa
-    (* __________________________________________________________________________________ *)
-    := bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
+  (* __________________________________________________________________________________ *)
+  := bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
 ;;
 
 let g =

From 5b448de459511f8ed24fc34adbe1f712b8f8223f Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Wed, 22 Mar 2023 21:32:29 +0100
Subject: [PATCH 017/115] ocp-indent-compat: Parenthesed `fun` and `function`

Indentation is different for labelled vs unlabelled functions.
The indentation for top-level functions can be simplified.
---
 lib/Fmt_ast.ml                      | 19 +++++++++---------
 lib/Params.ml                       | 31 +++++++++++++++++++----------
 lib/Params.mli                      |  3 ++-
 test/passing/tests/js_source.ml.ref | 20 +++++++++----------
 4 files changed, 41 insertions(+), 32 deletions(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 5ed6d8c6d3..8e7d8adc7d 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -93,11 +93,11 @@ module Indent = struct
 
   let fun_args = _ocp 6 4
 
-  let docked_function ~parens ~ctx c =
+  let docked_function ~parens ~xexp c =
     if c.conf.fmt_opts.ocp_indent_compat.v then if parens then 3 else 2
     else
       let default = if c.conf.fmt_opts.wrap_fun_args.v then 2 else 4 in
-      Params.function_indent c.conf ~ctx ~default
+      Params.function_indent c.conf ~parens:false ~xexp ~default
 
   let fun_args_group lbl ast c =
     if not c.conf.fmt_opts.ocp_indent_compat.v then 2
@@ -1860,7 +1860,7 @@ and fmt_expression c ?(box = true) ?pro ?epi ?eol ?parens ?(indent_wrap = 0)
       let cmts_after = Cmts.fmt_after c pexp_loc in
       let xr = sub_exp ~ctx r in
       let parens_r = parenze_exp xr in
-      let indent = Params.function_indent c.conf ~ctx in
+      let indent = Params.function_indent c.conf ~parens ~xexp:xr in
       Params.parens_if parens c.conf
         (hvbox indent
            ( hvbox 0
@@ -2011,9 +2011,10 @@ and fmt_expression c ?(box = true) ?pro ?epi ?eol ?parens ?(indent_wrap = 0)
             if c.conf.fmt_opts.wrap_fun_args.v then hovbox 2 else hvbox 2
           in
           let e1N = List.rev rev_e1N in
+          let xlast_arg = sub_exp ~ctx eN in
           let ctx'' = Exp eN in
           hvbox
-            (Indent.docked_function ~parens ~ctx c)
+            (Indent.docked_function ~parens ~xexp:xlast_arg c)
             ( expr_epi
             $ Params.parens_if parens c.conf
                 ( wrap
@@ -2158,7 +2159,7 @@ and fmt_expression c ?(box = true) ?pro ?epi ?eol ?parens ?(indent_wrap = 0)
         else 0
       in
       let indent =
-        Params.function_indent c.conf ~ctx ~default:default_indent
+        Params.function_indent c.conf ~parens ~xexp ~default:default_indent
       in
       hvbox_if (box || body_is_function) indent
         (Params.Exp.wrap c.conf ~parens ~disambiguate:true ~fits_breaks:false
@@ -2176,7 +2177,7 @@ and fmt_expression c ?(box = true) ?pro ?epi ?eol ?parens ?(indent_wrap = 0)
                $ str "->" $ pre_body )
            $ fmt "@ " $ body ) )
   | Pexp_function cs ->
-      let indent = Params.function_indent c.conf ~ctx in
+      let indent = Params.function_indent c.conf ~parens ~xexp in
       Params.Exp.wrap c.conf ~parens ~disambiguate:true ~fits_breaks:false
       @@ Params.Align.function_ c.conf ~parens ~ctx0 ~self:exp
       @@ ( hvbox 2
@@ -4248,7 +4249,7 @@ and fmt_let c ctx ~ext ~rec_flag ~bindings ~parens ~fmt_atrs ~fmt_expr
        $ hvbox 0 fmt_expr ) )
   $ fmt_atrs
 
-and fmt_value_binding c ~rec_flag ?ext ?in_ ?epi ctx
+and fmt_value_binding c ~rec_flag ?ext ?in_ ?epi _ctx
     {lb_op; lb_pat; lb_typ; lb_exp; lb_attrs; lb_loc; lb_pun} =
   update_config_maybe_disabled c lb_loc lb_attrs
   @@ fun c ->
@@ -4286,9 +4287,7 @@ and fmt_value_binding c ~rec_flag ?ext ?in_ ?epi ctx
   in
   let indent =
     match lb_exp.ast.pexp_desc with
-    | Pexp_function _ ->
-        Params.function_indent c.conf ~ctx
-          ~default:c.conf.fmt_opts.let_binding_indent.v
+    | Pexp_function _ -> c.conf.fmt_opts.function_indent.v
     | (Pexp_fun _ | Pexp_newtype _)
       when c.conf.fmt_opts.let_binding_deindent_fun.v ->
         max (c.conf.fmt_opts.let_binding_indent.v - 1) 0
diff --git a/lib/Params.ml b/lib/Params.ml
index 60ac4420bc..b6c6d893e5 100644
--- a/lib/Params.ml
+++ b/lib/Params.ml
@@ -15,6 +15,19 @@ open Asttypes
 open Fmt
 open Ast
 
+(** Whether [exp] occurs in [args] as a labelled argument. *)
+let is_labelled_arg args exp =
+  List.exists
+    ~f:(function
+      | Nolabel, _ -> false
+      | Labelled _, x | Optional _, x -> phys_equal x exp )
+    args
+
+let is_labelled_arg' xexp =
+  match xexp.Ast.ctx with
+  | Exp {pexp_desc= Pexp_apply (_, args); _} -> is_labelled_arg args xexp.ast
+  | _ -> false
+
 let parens_if parens (c : Conf.t) ?(disambiguate = false) k =
   if disambiguate && c.fmt_opts.disambiguate_non_breaking_match.v then
     wrap_if_fits_or parens "(" ")" k
@@ -536,9 +549,13 @@ let match_indent ?(default = 0) (c : Conf.t) ~(ctx : Ast.t) =
   | `Always, _ | _, (Top | Sig _ | Str _) -> c.fmt_opts.match_indent.v
   | _ -> default
 
-let function_indent ?(default = 0) (c : Conf.t) ~(ctx : Ast.t) =
-  match (c.fmt_opts.function_indent_nested.v, ctx) with
-  | `Always, _ | _, (Top | Sig _ | Str _) -> c.fmt_opts.function_indent.v
+let function_indent ?(default = 0) (c : Conf.t) ~parens ~xexp =
+  match c.fmt_opts.function_indent_nested.v with
+  | `Always -> c.fmt_opts.function_indent.v
+  | _
+    when c.fmt_opts.ocp_indent_compat.v && parens
+         && not (is_labelled_arg' xexp) ->
+      default + 1
   | _ -> default
 
 let comma_sep (c : Conf.t) : Fmt.s =
@@ -552,14 +569,6 @@ let semi_sep (c : Conf.t) : Fmt.s =
   | `After -> ";@;<1 2>"
 
 module Align = struct
-  (** Whether [exp] occurs in [args] as a labelled argument. *)
-  let is_labelled_arg args exp =
-    List.exists
-      ~f:(function
-        | Nolabel, _ -> false
-        | Labelled _, x | Optional _, x -> phys_equal x exp )
-      args
-
   let general (c : Conf.t) t =
     hvbox_if (not c.fmt_opts.align_symbol_open_paren.v) 0 t
 
diff --git a/lib/Params.mli b/lib/Params.mli
index f133acd4fb..657d36c8fa 100644
--- a/lib/Params.mli
+++ b/lib/Params.mli
@@ -132,7 +132,8 @@ val match_indent : ?default:int -> Conf.t -> ctx:Ast.t -> int
     option, or using the [default] indentation (0 if not provided) if the
     option does not apply. *)
 
-val function_indent : ?default:int -> Conf.t -> ctx:Ast.t -> int
+val function_indent :
+  ?default:int -> Conf.t -> parens:bool -> xexp:expression Ast.xt -> int
 (** [function_indent c ~ctx ~default] returns the indentation used for the
     function in context [ctx], depending on the `function-indent-nested`
     option, or using the [default] indentation (0 if not provided) if the
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index 8455fb9ddf..fe1e6d67bb 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -1210,7 +1210,7 @@ let rec variantize : type a e. e ty_env -> (a, e) ty -> a -> variant =
       ( tag
       , may_map
           (function
-           | Tdyn (ty, arg) -> variantize e ty arg)
+            | Tdyn (ty, arg) -> variantize e ty arg)
           arg )
 ;;
 
@@ -1302,14 +1302,14 @@ let ty_list : type a e. (a, e) ty -> (a vlist, e) ty =
     (Sum
        { sum_proj =
            (function
-            | `Nil -> "Nil", None
-            | `Cons p -> "Cons", Some (Tdyn (tcons, p)))
+             | `Nil -> "Nil", None
+             | `Cons p -> "Cons", Some (Tdyn (tcons, p)))
        ; sum_cases = [ "Nil", TCnoarg Thd; "Cons", TCarg (Ttl Thd, tcons) ]
        ; sum_inj =
            (fun (type c) : ((noarg -> a * a vlist -> unit, c) ty_sel * c -> a vlist) ->
               function
-             | Thd, Noarg -> `Nil
-             | Ttl Thd, v -> `Cons v)
+              | Thd, Noarg -> `Nil
+              | Ttl Thd, v -> `Cons v)
            (* One can also write the type annotation directly *)
        })
 ;;
@@ -1338,9 +1338,9 @@ let ty_abc : ([ `A of int | `B of string | `C ], 'e) ty =
   (* Could also use [get_case] for proj, but direct definition is shorter *)
   Sum
     ( (function
-       | `A n -> "A", Some (Tdyn (Int, n))
-       | `B s -> "B", Some (Tdyn (String, s))
-       | `C -> "C", None)
+        | `A n -> "A", Some (Tdyn (Int, n))
+        | `B s -> "B", Some (Tdyn (String, s))
+        | `C -> "C", None)
     , function
       | "A", Some (Tdyn (Int, n)) -> `A n
       | "B", Some (Tdyn (String, s)) -> `B s
@@ -1355,8 +1355,8 @@ let ty_list : type a e. (a, e) ty -> (a vlist, e) ty =
   Rec
     (Sum
        ( (function
-          | `Nil -> "Nil", None
-          | `Cons p -> "Cons", Some (Tdyn (targ, p)))
+           | `Nil -> "Nil", None
+           | `Cons p -> "Cons", Some (Tdyn (targ, p)))
        , function
          | "Nil", None -> `Nil
          | "Cons", Some (Tdyn (Pair (_, Var), (p : a * a vlist))) -> `Cons p ))

From 1f051c0c9b9d23fd910756fcc98967b2f5caf809 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Wed, 22 Mar 2023 22:38:05 +0100
Subject: [PATCH 018/115] ocp-indent-compat: Module constraint with inline
 struct/sig

---
 lib/Fmt_ast.ml                      | 19 +++++++++++++++++--
 test/passing/tests/js_source.ml.ref | 24 ++++++++++++------------
 2 files changed, 29 insertions(+), 14 deletions(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 8e7d8adc7d..3558872549 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -115,6 +115,13 @@ module Indent = struct
     _ocp ocp 4 c
 
   let exp_constraint = _ocp 1 2
+
+  let mod_constraint ~me c =
+    if c.conf.fmt_opts.ocp_indent_compat.v then
+      match me.pmod_desc with
+      | Pmod_structure _ -> 0
+      | _ -> 2
+    else 2
 end
 
 module Break = struct
@@ -126,6 +133,14 @@ module Break = struct
 
   (** Valid for [assignment-operator = begin-line]. *)
   let assignment_operator = _ocp "@ " "@;<1 2>"
+
+  let mod_constraint ~mt c =
+    if c.conf.fmt_opts.ocp_indent_compat.v then
+      match mt.pmty_desc with
+      | Pmty_signature _ -> break 1 0
+      | _ -> break 1 2
+    else break 1 2
+
 end
 
 (* Debug: catch and report failures at nearest enclosing Ast.t *)
@@ -4004,13 +4019,13 @@ and fmt_module_expr ?(dock_struct = true) c ({ast= m; _} as xmod) =
       let has_epi =
         Cmts.has_after c.cmts pmod_loc || not (List.is_empty pmod_attributes)
       in
-      { opn= Some (fmt_opt blk_t.opn $ fmt_opt blk_e.opn $ open_hovbox 2)
+      { opn= Some (fmt_opt blk_t.opn $ fmt_opt blk_e.opn $ open_hovbox (Indent.mod_constraint ~me c))
       ; pro= Some (Cmts.fmt_before c pmod_loc $ str "(")
       ; psp= fmt "@,"
       ; bdy=
           hvbox 0
             ( fmt_opt blk_e.pro $ blk_e.psp $ blk_e.bdy $ blk_e.esp
-            $ fmt_opt blk_e.epi $ fmt " :@;<1 2>"
+            $ fmt_opt blk_e.epi $ fmt " :" $ Break.mod_constraint ~mt c
             $ hvbox 0
                 ( fmt_opt blk_t.pro $ blk_t.psp $ blk_t.bdy $ blk_t.esp
                 $ fmt_opt blk_t.epi ) )
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index fe1e6d67bb..7ea5913485 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -5457,13 +5457,13 @@ module M2 : sig
   end
 end = (
   M :
-    sig
-      module N : sig
-        val x : int
-      end
+  sig
+    module N : sig
+      val x : int
+    end
 
-      module N' = N
-    end)
+    module N' = N
+  end)
 ;;
 
 M2.N'.x
@@ -5496,13 +5496,13 @@ module M2 : sig
   end
 end = (
   M :
-    sig
-      module C : sig
-        val chr : int -> char
-      end
+  sig
+    module C : sig
+      val chr : int -> char
+    end
 
-      module C' = C
-    end)
+    module C' = C
+  end)
 ;;
 
 M2.C'.chr 66;;

From 9af41efee5e2e8f2145aa64b83fec28a38372162 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Tue, 21 Mar 2023 20:05:05 +0100
Subject: [PATCH 019/115] ocp-indent-compat: Docked match after infix

This implements the `~epi` mechanism for matches.

Some care is needed to disable alignment and set the right indentation
for potentially docked matches.
---
 lib/Fmt_ast.ml                      | 31 ++++++++++++++++-------------
 lib/Params.ml                       | 15 +++++++++++++-
 lib/Params.mli                      |  2 +-
 test/passing/tests/js_source.ml     | 12 +++++++++++
 test/passing/tests/js_source.ml.ocp | 16 +++++++++++++++
 test/passing/tests/js_source.ml.ref | 16 +++++++++++++++
 6 files changed, 76 insertions(+), 16 deletions(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index e99777b723..71b8e34508 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -1627,19 +1627,21 @@ and fmt_pat_cons c ~parens args =
   Params.Exp.Infix_op_arg.wrap c.conf ~parens ~parens_nested:false
     (list_fl groups fmt_op_arg_group)
 
-and fmt_match c ~parens ?ext ctx xexp cs e0 keyword =
-  let indent = Params.match_indent c.conf ~ctx:xexp.ctx in
+and fmt_match c ?epi ~parens ?ext ctx xexp cs e0 keyword =
+  let ctx0 = xexp.ctx in
+  let indent = Params.match_indent c.conf ~ctx:ctx0 in
   hvbox indent
-    ( Params.Exp.wrap c.conf ~parens ~disambiguate:true
-    @@ Params.Align.match_ c.conf
-    @@ ( hvbox 0
-           ( str keyword
-           $ fmt_extension_suffix c ext
-           $ fmt_attributes c xexp.ast.pexp_attributes
-           $ fmt "@;<1 2>"
-           $ fmt_expression c (sub_exp ~ctx e0)
-           $ fmt "@ with" )
-       $ fmt "@ " $ fmt_cases c ctx cs ) )
+    ( fmt_opt epi
+    $ Params.Exp.wrap c.conf ~parens ~disambiguate:true
+      @@ Params.Align.match_ c.conf ~xexp
+      @@ ( hvbox 0
+             ( str keyword
+             $ fmt_extension_suffix c ext
+             $ fmt_attributes c xexp.ast.pexp_attributes
+             $ fmt "@;<1 2>"
+             $ fmt_expression c (sub_exp ~ctx e0)
+             $ fmt "@ with" )
+         $ fmt "@ " $ fmt_cases c ctx cs ) )
 
 and fmt_expression c ?(box = true) ?pro ?epi ?eol ?parens ?(indent_wrap = 0)
     ?ext ({ast= exp; ctx= ctx0} as xexp) =
@@ -2357,8 +2359,9 @@ and fmt_expression c ?(box = true) ?pro ?epi ?eol ?parens ?(indent_wrap = 0)
                | `No -> ")"
                | `Space -> " )"
                | `Closing_on_separate_line -> "@;<1000 -2>)" ) ) )
-  | Pexp_match (e0, cs) -> fmt_match c ~parens ?ext ctx xexp cs e0 "match"
-  | Pexp_try (e0, cs) -> fmt_match c ~parens ?ext ctx xexp cs e0 "try"
+  | Pexp_match (e0, cs) ->
+      fmt_match c ?epi ~parens ?ext ctx xexp cs e0 "match"
+  | Pexp_try (e0, cs) -> fmt_match c ?epi ~parens ?ext ctx xexp cs e0 "try"
   | Pexp_pack (me, pt) ->
       let outer_parens = parens && has_attr in
       let inner_parens = true in
diff --git a/lib/Params.ml b/lib/Params.ml
index 869605365b..a7703f45ef 100644
--- a/lib/Params.ml
+++ b/lib/Params.ml
@@ -57,6 +57,7 @@ module Exp = struct
             ->
               true
           | _ -> false )
+        | Pexp_match _ | Pexp_try _ -> true
         | _ -> false
   end
 
@@ -529,6 +530,9 @@ let get_if_then_else (c : Conf.t) ~first ~last ~parens_bch ~parens_prev_bch
 let match_indent ?(default = 0) (c : Conf.t) ~(ctx : Ast.t) =
   match (c.fmt_opts.match_indent_nested.v, ctx) with
   | `Always, _ | _, (Top | Sig _ | Str _) -> c.fmt_opts.match_indent.v
+  | _, Exp {pexp_desc= Pexp_infix _; _} when c.fmt_opts.ocp_indent_compat.v
+    ->
+      2 (* Match is docked *)
   | _ -> default
 
 let function_indent ?(default = 0) (c : Conf.t) ~(ctx : Ast.t) =
@@ -560,7 +564,16 @@ module Align = struct
 
   let infix_op = general
 
-  let match_ = general
+  let match_ (c : Conf.t) ~xexp:{ast; ctx} t =
+    (* Matches on the RHS of an infix are docked in ocp-indent-compat. *)
+    let docked =
+      match ctx with
+      | Exp {pexp_desc= Pexp_infix (_, _, rhs); _} when phys_equal rhs ast ->
+          c.fmt_opts.ocp_indent_compat.v
+      | _ -> false
+    in
+    let align = (not c.fmt_opts.align_symbol_open_paren.v) && not docked in
+    hvbox_if align 0 t
 
   let function_ (c : Conf.t) ~parens ~(ctx0 : Ast.t) ~self t =
     let align =
diff --git a/lib/Params.mli b/lib/Params.mli
index 64377b44ba..e6b743b480 100644
--- a/lib/Params.mli
+++ b/lib/Params.mli
@@ -148,7 +148,7 @@ module Align : sig
 
   val infix_op : Conf.t -> Fmt.t -> Fmt.t
 
-  val match_ : Conf.t -> Fmt.t -> Fmt.t
+  val match_ : Conf.t -> xexp:expression Ast.xt -> Fmt.t -> Fmt.t
 
   val function_ :
     Conf.t -> parens:bool -> ctx0:Ast.t -> self:expression -> Fmt.t -> Fmt.t
diff --git a/test/passing/tests/js_source.ml b/test/passing/tests/js_source.ml
index 84e8672e0d..f45df25bbd 100644
--- a/test/passing/tests/js_source.ml
+++ b/test/passing/tests/js_source.ml
@@ -7750,3 +7750,15 @@ end = struct
   external unsafe_memset : t -> pos:int -> len:int -> char -> unit = "bigstring_memset_stub"
   [@@noalloc]
 end
+
+let _ =
+  foo
+  $$ ( match group with [] -> impossible "previous match"
+    | [cmt] -> fmt_cmt t conf cmt ~fmt_code $ maybe_newline ~next cmt )
+  $$ bar
+
+let _ =
+  foo
+  $$ ( try group with [] -> impossible "previous match"
+    | [cmt] -> fmt_cmt t conf cmt ~fmt_code $ maybe_newline ~next cmt )
+  $$ bar
diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp
index 834281b156..469c135f20 100644
--- a/test/passing/tests/js_source.ml.ocp
+++ b/test/passing/tests/js_source.ml.ocp
@@ -9974,3 +9974,19 @@ end = struct
     = "bigstring_memset_stub"
   [@@noalloc]
 end
+
+let _ =
+  foo
+  $$ (match group with
+    | [] -> impossible "previous match"
+    | [ cmt ] -> fmt_cmt t conf cmt ~fmt_code $ maybe_newline ~next cmt)
+  $$ bar
+;;
+
+let _ =
+  foo
+  $$ (try group with
+    | [] -> impossible "previous match"
+    | [ cmt ] -> fmt_cmt t conf cmt ~fmt_code $ maybe_newline ~next cmt)
+  $$ bar
+;;
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index ae07ded1ad..2737c3342d 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -9974,3 +9974,19 @@ end = struct
     = "bigstring_memset_stub"
   [@@noalloc]
 end
+
+let _ =
+  foo
+  $$ (match group with
+    | [] -> impossible "previous match"
+    | [ cmt ] -> fmt_cmt t conf cmt ~fmt_code $ maybe_newline ~next cmt)
+  $$ bar
+;;
+
+let _ =
+  foo
+  $$ (try group with
+    | [] -> impossible "previous match"
+    | [ cmt ] -> fmt_cmt t conf cmt ~fmt_code $ maybe_newline ~next cmt)
+  $$ bar
+;;

From 3ca1db32ab93acf2356a161bfaedca3b91accf82 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Wed, 22 Mar 2023 17:04:44 +0100
Subject: [PATCH 020/115] Update CHANGES

---
 CHANGES.md | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/CHANGES.md b/CHANGES.md
index d77d674511..2e3821c154 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -19,7 +19,7 @@
 
 - Restore short form for first-class modules: `((module M) : (module S))` is formatted as `(module M : S)`) (#2280, #2300, @gpetiot, @Julow)
 - Restore short form formatting of record field aliases (#2282, @gpetiot)
-- Tweaks the JaneStreet profile to be more consistent with ocp-indent (#2281, #2284, #2289, #2299, #2302, #2309, #2310, #2311, #2313, @gpetiot, @Julow)
+- Tweaks the JaneStreet profile to be more consistent with ocp-indent (#2281, #2284, #2289, #2299, #2302, #2309, #2310, #2311, #2313, #2316, @gpetiot, @Julow)
 - Improve formatting of class signatures (#2301, @gpetiot, @Julow)
 
 ### New features

From 9f6010098b55b1b5a66c74cd7a4edea5c43cfaa3 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Wed, 22 Mar 2023 19:06:46 +0100
Subject: [PATCH 021/115] Fix regression on unparenthesed matches

---
 lib/Fmt_ast.ml                      | 2 +-
 lib/Params.ml                       | 6 +++---
 lib/Params.mli                      | 2 +-
 test/passing/tests/js_source.ml     | 7 +++++++
 test/passing/tests/js_source.ml.ocp | 8 ++++++++
 test/passing/tests/js_source.ml.ref | 8 ++++++++
 6 files changed, 28 insertions(+), 5 deletions(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 71b8e34508..b134f7f818 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -1629,7 +1629,7 @@ and fmt_pat_cons c ~parens args =
 
 and fmt_match c ?epi ~parens ?ext ctx xexp cs e0 keyword =
   let ctx0 = xexp.ctx in
-  let indent = Params.match_indent c.conf ~ctx:ctx0 in
+  let indent = Params.match_indent c.conf ~parens ~ctx:ctx0 in
   hvbox indent
     ( fmt_opt epi
     $ Params.Exp.wrap c.conf ~parens ~disambiguate:true
diff --git a/lib/Params.ml b/lib/Params.ml
index a7703f45ef..24fb2a17d3 100644
--- a/lib/Params.ml
+++ b/lib/Params.ml
@@ -527,11 +527,11 @@ let get_if_then_else (c : Conf.t) ~first ~last ~parens_bch ~parens_prev_bch
       ; break_end_branch= noop
       ; space_between_branches= fmt "@ " }
 
-let match_indent ?(default = 0) (c : Conf.t) ~(ctx : Ast.t) =
+let match_indent ?(default = 0) (c : Conf.t) ~parens ~(ctx : Ast.t) =
   match (c.fmt_opts.match_indent_nested.v, ctx) with
   | `Always, _ | _, (Top | Sig _ | Str _) -> c.fmt_opts.match_indent.v
-  | _, Exp {pexp_desc= Pexp_infix _; _} when c.fmt_opts.ocp_indent_compat.v
-    ->
+  | _, Exp {pexp_desc= Pexp_infix _; _}
+    when c.fmt_opts.ocp_indent_compat.v && parens ->
       2 (* Match is docked *)
   | _ -> default
 
diff --git a/lib/Params.mli b/lib/Params.mli
index e6b743b480..d31bc98424 100644
--- a/lib/Params.mli
+++ b/lib/Params.mli
@@ -124,7 +124,7 @@ val get_if_then_else :
   -> fmt_cond:(expression Ast.xt -> Fmt.t)
   -> if_then_else
 
-val match_indent : ?default:int -> Conf.t -> ctx:Ast.t -> int
+val match_indent : ?default:int -> Conf.t -> parens:bool -> ctx:Ast.t -> int
 (** [match_indent c ~ctx ~default] returns the indentation used for the
     pattern-matching in context [ctx], depending on the `match-indent-nested`
     option, or using the [default] indentation (0 if not provided) if the
diff --git a/test/passing/tests/js_source.ml b/test/passing/tests/js_source.ml
index f45df25bbd..73185ca357 100644
--- a/test/passing/tests/js_source.ml
+++ b/test/passing/tests/js_source.ml
@@ -7762,3 +7762,10 @@ let _ =
   $$ ( try group with [] -> impossible "previous match"
     | [cmt] -> fmt_cmt t conf cmt ~fmt_code $ maybe_newline ~next cmt )
   $$ bar
+
+let _ =
+  x == exp
+  ||
+  match x with
+  | {pexp_desc= Pexp_constraint (e, _); _} -> loop e
+  | _ -> false
diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp
index 469c135f20..c811113661 100644
--- a/test/passing/tests/js_source.ml.ocp
+++ b/test/passing/tests/js_source.ml.ocp
@@ -9990,3 +9990,11 @@ let _ =
     | [ cmt ] -> fmt_cmt t conf cmt ~fmt_code $ maybe_newline ~next cmt)
   $$ bar
 ;;
+
+let _ =
+  x == exp
+  ||
+  match x with
+  | { pexp_desc = Pexp_constraint (e, _); _ } -> loop e
+  | _ -> false
+;;
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index 2737c3342d..6f9399e235 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -9990,3 +9990,11 @@ let _ =
     | [ cmt ] -> fmt_cmt t conf cmt ~fmt_code $ maybe_newline ~next cmt)
   $$ bar
 ;;
+
+let _ =
+  x == exp
+  ||
+  match x with
+  | { pexp_desc = Pexp_constraint (e, _); _ } -> loop e
+  | _ -> false
+;;

From ff287626d7ea3416d26a62ac1e2c561aefe4d82c Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Thu, 23 Mar 2023 15:54:10 +0100
Subject: [PATCH 022/115] fmt

---
 lib/Fmt_ast.ml | 13 +++++++------
 1 file changed, 7 insertions(+), 6 deletions(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 676ce0e6d0..d0fbf6cf78 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -118,9 +118,7 @@ module Indent = struct
 
   let mod_constraint ~me c =
     if c.conf.fmt_opts.ocp_indent_compat.v then
-      match me.pmod_desc with
-      | Pmod_structure _ -> 0
-      | _ -> 2
+      match me.pmod_desc with Pmod_structure _ -> 0 | _ -> 2
     else 2
 end
 
@@ -140,7 +138,6 @@ module Break = struct
       | Pmty_signature _ -> break 1 0
       | _ -> break 1 2
     else break 1 2
-
 end
 
 (* Debug: catch and report failures at nearest enclosing Ast.t *)
@@ -4025,13 +4022,17 @@ and fmt_module_expr ?(dock_struct = true) c ({ast= m; _} as xmod) =
       let has_epi =
         Cmts.has_after c.cmts pmod_loc || not (List.is_empty pmod_attributes)
       in
-      { opn= Some (fmt_opt blk_t.opn $ fmt_opt blk_e.opn $ open_hovbox (Indent.mod_constraint ~me c))
+      { opn=
+          Some
+            ( fmt_opt blk_t.opn $ fmt_opt blk_e.opn
+            $ open_hovbox (Indent.mod_constraint ~me c) )
       ; pro= Some (Cmts.fmt_before c pmod_loc $ str "(")
       ; psp= fmt "@,"
       ; bdy=
           hvbox 0
             ( fmt_opt blk_e.pro $ blk_e.psp $ blk_e.bdy $ blk_e.esp
-            $ fmt_opt blk_e.epi $ fmt " :" $ Break.mod_constraint ~mt c
+            $ fmt_opt blk_e.epi $ fmt " :"
+            $ Break.mod_constraint ~mt c
             $ hvbox 0
                 ( fmt_opt blk_t.pro $ blk_t.psp $ blk_t.bdy $ blk_t.esp
                 $ fmt_opt blk_t.epi ) )

From 460641e41c31078a447e78ad725a8bd2dc16678c Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Thu, 23 Mar 2023 16:26:49 +0100
Subject: [PATCH 023/115] ocp-indent-compat: Docstring after variant
 constructor

---
 lib/Fmt_ast.ml                      | 13 ++++++++-----
 test/passing/tests/js_source.ml     |  8 ++++++++
 test/passing/tests/js_source.ml.ocp |  8 ++++++++
 test/passing/tests/js_source.ml.ref |  8 ++++++++
 4 files changed, 32 insertions(+), 5 deletions(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index d0fbf6cf78..671a1fe30a 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -114,6 +114,8 @@ module Indent = struct
     in
     _ocp ocp 4 c
 
+  let constructor_docstring = _ocp 0 4
+
   let exp_constraint = _ocp 1 2
 
   let mod_constraint ~me c =
@@ -3325,11 +3327,12 @@ and fmt_constructor_declaration c ctx ~first ~last:_ cstr_decl =
      eventual comment placed after the previous constructor *)
   fmt_if_k (not first) (fmt_or (sparse || has_cmt_before) "@;<1000 0>" "@ ")
   $ Cmts.fmt_before ~epi:(break 1000 0) c pcd_loc
-  $ fmt_or_k first (if_newline "| ") (str "| ")
-  $ hvbox ~name:"constructor_decl" 0
-      ( hovbox 2
-          ( hvbox 2
-              ( hovbox ~name:"constructor_decl_name" 0
+  $ hvbox ~name:"constructor_decl" 2
+      ( hvbox
+          (Indent.constructor_docstring c)
+          ( hvbox 4
+              ( fmt_or_k first (if_newline "| ") (str "| ")
+              $ hovbox ~name:"constructor_decl_name" 0
                   (Cmts.fmt c loc
                      (wrap_if
                         (Std_longident.String_id.is_symbol txt)
diff --git a/test/passing/tests/js_source.ml b/test/passing/tests/js_source.ml
index 017a560b88..6db99c383f 100644
--- a/test/passing/tests/js_source.ml
+++ b/test/passing/tests/js_source.ml
@@ -7811,3 +7811,11 @@ let _ =
                 : fooooooooooooooooooooooooooooooooooooooooo )
   end in
   ()
+
+type action =
+  | In_out of [ `Impl | `Intf ] input * string option
+  (** Format input file (or [-] for stdin) of given kind to output file,
+      or stdout if None. *)
+  (* foo *)
+  | Inplace of [ `Impl | `Intf ] input list
+  (** Format in-place, overwriting input file(s). *)
diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp
index 1436cbd631..ffb325e947 100644
--- a/test/passing/tests/js_source.ml.ocp
+++ b/test/passing/tests/js_source.ml.ocp
@@ -10056,3 +10056,11 @@ let _ =
   in
   ()
 ;;
+
+type action =
+  | In_out of [ `Impl | `Intf ] input * string option
+  (** Format input file (or [-] for stdin) of given kind to output file,
+      or stdout if None. *)
+  (* foo *)
+  | Inplace of [ `Impl | `Intf ] input list
+  (** Format in-place, overwriting input file(s). *)
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index 94783fbbde..25506cc333 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -10056,3 +10056,11 @@ let _ =
   in
   ()
 ;;
+
+type action =
+  | In_out of [ `Impl | `Intf ] input * string option
+  (** Format input file (or [-] for stdin) of given kind to output file,
+      or stdout if None. *)
+  (* foo *)
+  | Inplace of [ `Impl | `Intf ] input list
+  (** Format in-place, overwriting input file(s). *)

From 510e62203c100c1c8192ce692ec0f37f5548428c Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Thu, 23 Mar 2023 17:20:29 +0100
Subject: [PATCH 024/115] ocp-indent-compat: Align module packs

---
 lib/Fmt_ast.ml                      | 10 ++++++----
 lib/Params.ml                       |  8 ++++++++
 lib/Params.mli                      |  3 +++
 test/passing/tests/js_source.ml     | 10 ++++++++++
 test/passing/tests/js_source.ml.ocp | 10 ++++++++++
 test/passing/tests/js_source.ml.ref | 22 ++++++++++++++++------
 6 files changed, 53 insertions(+), 10 deletions(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 671a1fe30a..066356434e 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -2419,8 +2419,8 @@ and fmt_expression c ?(box = true) ?pro ?epi ?eol ?parens ?(indent_wrap = 0)
   | Pexp_try (e0, cs) -> fmt_match c ?epi ~parens ?ext ctx xexp cs e0 "try"
   | Pexp_pack (me, pt) ->
       let outer_parens = parens && has_attr in
-      let inner_parens = true in
       let blk = fmt_module_expr c (sub_mod ~ctx me) in
+      let align = Params.Align.module_pack c.conf ~me in
       let opn_paren =
         match c.conf.fmt_opts.indicate_multiline_delimiters.v with
         | `No | `Closing_on_separate_line -> str "("
@@ -2433,11 +2433,11 @@ and fmt_expression c ?(box = true) ?pro ?epi ?eol ?parens ?(indent_wrap = 0)
             fits_breaks ~level "(" "( "
       and cls_paren = closing_paren c ~offset:(-2) in
       let pro =
-        fmt_if_k inner_parens opn_paren
+        fmt_if_k (not align) opn_paren
         $ str "module"
         $ fmt_extension_suffix c ext
         $ char ' '
-      and epi = fmt_if_k inner_parens cls_paren in
+      and epi = cls_paren in
       let fmt_mod m =
         match pt with
         | Some (id, cnstrs) ->
@@ -2448,7 +2448,9 @@ and fmt_expression c ?(box = true) ?pro ?epi ?eol ?parens ?(indent_wrap = 0)
       in
       hvbox 0
         (Params.parens_if outer_parens c.conf
-           (compose_module ~pro ~epi blk ~f:fmt_mod $ fmt_atrs) )
+           ( fmt_if_k align opn_paren
+           $ compose_module ~pro ~epi blk ~f:fmt_mod
+           $ fmt_atrs ) )
   | Pexp_record (flds, default) ->
       let fmt_field (lid, (typ1, typ2), exp) =
         let typ1 = Option.map typ1 ~f:(sub_typ ~ctx) in
diff --git a/lib/Params.ml b/lib/Params.ml
index d35b185cd0..dbc7e188f1 100644
--- a/lib/Params.ml
+++ b/lib/Params.ml
@@ -606,4 +606,12 @@ module Align = struct
     if c.fmt_opts.ocp_indent_compat.v then
       hovbox 4 (decl $ hvbox 2 (pattern $ args))
     else hovbox 4 (decl $ pattern) $ args
+
+  let module_pack (c : Conf.t) ~me =
+    if not c.fmt_opts.ocp_indent_compat.v then false
+    else
+      (* Align when the constraint is not desugared. *)
+      match me.pmod_desc with
+      | Pmod_structure _ | Pmod_ident _ -> false
+      | _ -> true
 end
diff --git a/lib/Params.mli b/lib/Params.mli
index bc6198d53e..9d700e2a1a 100644
--- a/lib/Params.mli
+++ b/lib/Params.mli
@@ -157,4 +157,7 @@ module Align : sig
     Conf.t -> parens:bool -> ctx0:Ast.t -> self:expression -> Fmt.t -> Fmt.t
 
   val fun_decl : Conf.t -> decl:Fmt.t -> pattern:Fmt.t -> args:Fmt.t -> Fmt.t
+
+  val module_pack : Conf.t -> me:module_expr -> bool
+  (** Not implemented as a wrapper to work with the blk system. *)
 end
diff --git a/test/passing/tests/js_source.ml b/test/passing/tests/js_source.ml
index 6db99c383f..978d678a93 100644
--- a/test/passing/tests/js_source.ml
+++ b/test/passing/tests/js_source.ml
@@ -7819,3 +7819,13 @@ type action =
   (* foo *)
   | Inplace of [ `Impl | `Intf ] input list
   (** Format in-place, overwriting input file(s). *)
+
+let%test_module "semantics" =
+  (module (
+   struct
+     open Core
+     open Appendable_list
+     module Stable = Stable
+   end :
+     S))
+;;
diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp
index ffb325e947..c3646ee6b2 100644
--- a/test/passing/tests/js_source.ml.ocp
+++ b/test/passing/tests/js_source.ml.ocp
@@ -10064,3 +10064,13 @@ type action =
   (* foo *)
   | Inplace of [ `Impl | `Intf ] input list
   (** Format in-place, overwriting input file(s). *)
+
+let%test_module "semantics" =
+  (module (
+   struct
+     open Core
+     open Appendable_list
+     module Stable = Stable
+   end :
+     S))
+;;
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index 25506cc333..2ba0fa15ea 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -3314,20 +3314,20 @@ let sort (type s) (module Set : Set.S with type elt = s) l =
 (* No real improvement here? *)
 let make_set (type s) cmp : (module Set.S with type elt = s) =
   (module Set.Make (struct
-      type t = s
+       type t = s
 
-      let compare = cmp
-    end))
+       let compare = cmp
+     end))
 ;;
 
 (* No type annotation here *)
 let sort_cmp (type s) cmp =
   sort
     (module Set.Make (struct
-        type t = s
+         type t = s
 
-        let compare = cmp
-      end))
+         let compare = cmp
+       end))
 ;;
 
 module type S = sig
@@ -10064,3 +10064,13 @@ type action =
   (* foo *)
   | Inplace of [ `Impl | `Intf ] input list
   (** Format in-place, overwriting input file(s). *)
+
+let%test_module "semantics" =
+  (module (
+   struct
+     open Core
+     open Appendable_list
+     module Stable = Stable
+   end :
+     S))
+;;

From 3b611d23e43f0dcc03218fb43b117ce47999dcd7 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Thu, 23 Mar 2023 19:05:16 +0100
Subject: [PATCH 025/115] ocp-indent-compat: Parenthesed variant arguments

---
 lib/Fmt_ast.ml                      |  6 +++++-
 test/passing/tests/js_source.ml     | 11 +++++++++++
 test/passing/tests/js_source.ml.ocp | 11 +++++++++++
 test/passing/tests/js_source.ml.ref | 11 +++++++++++
 4 files changed, 38 insertions(+), 1 deletion(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 066356434e..a8bc5167b1 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -122,6 +122,9 @@ module Indent = struct
     if c.conf.fmt_opts.ocp_indent_compat.v then
       match me.pmod_desc with Pmod_structure _ -> 0 | _ -> 2
     else 2
+
+  let variant ~parens c =
+    if c.conf.fmt_opts.ocp_indent_compat.v && parens then 3 else 2
 end
 
 module Break = struct
@@ -2152,7 +2155,8 @@ and fmt_expression c ?(box = true) ?pro ?epi ?eol ?parens ?(indent_wrap = 0)
             $ fmt_expression c (sub_exp ~ctx arg) )
         $ fmt_atrs )
   | Pexp_variant (s, arg) ->
-      hvbox 2
+      hvbox
+        (Indent.variant ~parens c)
         (Params.parens_if parens c.conf
            ( variant_var c s
            $ opt arg (fmt "@ " >$ (sub_exp ~ctx >> fmt_expression c))
diff --git a/test/passing/tests/js_source.ml b/test/passing/tests/js_source.ml
index 978d678a93..e40ed31051 100644
--- a/test/passing/tests/js_source.ml
+++ b/test/passing/tests/js_source.ml
@@ -7829,3 +7829,14 @@ let%test_module "semantics" =
    end :
      S))
 ;;
+
+let _ =
+  Error
+    (`Foooooooooooooooooo
+       (name, Format.sprintf "expecting %S but got %S" Version.version value))
+;;
+
+let _ =
+  `Foooooooooooooooooo
+    (name, Format.sprintf "expecting %S but got %S" Version.version value)
+;;
diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp
index c3646ee6b2..5b26a04a71 100644
--- a/test/passing/tests/js_source.ml.ocp
+++ b/test/passing/tests/js_source.ml.ocp
@@ -10074,3 +10074,14 @@ let%test_module "semantics" =
    end :
      S))
 ;;
+
+let _ =
+  Error
+    (`Foooooooooooooooooo
+       (name, Format.sprintf "expecting %S but got %S" Version.version value))
+;;
+
+let _ =
+  `Foooooooooooooooooo
+    (name, Format.sprintf "expecting %S but got %S" Version.version value)
+;;
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index 2ba0fa15ea..9275133822 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -10074,3 +10074,14 @@ let%test_module "semantics" =
    end :
      S))
 ;;
+
+let _ =
+  Error
+    (`Foooooooooooooooooo
+       (name, Format.sprintf "expecting %S but got %S" Version.version value))
+;;
+
+let _ =
+  `Foooooooooooooooooo
+    (name, Format.sprintf "expecting %S but got %S" Version.version value)
+;;

From 9602774e00587de2e22106a114473931e4a9a9d5 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Thu, 23 Mar 2023 20:24:26 +0100
Subject: [PATCH 026/115] ocp-indent-compat: Breaking `fun` with no label

---
 lib/Fmt_ast.ml                      | 25 ++++++++++++-------------
 test/passing/tests/js_source.ml.ref |  6 +++---
 2 files changed, 15 insertions(+), 16 deletions(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index dc5babd3a7..85a09ddb98 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -125,6 +125,17 @@ module Indent = struct
 
   let variant ~parens c =
     if c.conf.fmt_opts.ocp_indent_compat.v && parens then 3 else 2
+
+  let docked_fun c ~loc ~lbl =
+    if not c.conf.fmt_opts.ocp_indent_compat.v then 2
+    else
+      let loc, if_breaks =
+        match lbl with
+        | Nolabel -> (loc, 3)
+        | Optional x | Labelled x -> (x.loc, 2)
+      in
+      if Source.begins_line ~ignore_spaces:true c.source loc then if_breaks
+      else 0
 end
 
 module Break = struct
@@ -1965,22 +1976,10 @@ and fmt_expression c ?(box = true) ?pro ?epi ?eol ?parens ?(indent_wrap = 0)
           let args_before = List.rev rev_args_before in
           let xlast_arg = sub_exp ~ctx eN1 in
           let args =
-            let begin_arg_loc =
-              match lbl with
-              | Nolabel -> eN1.pexp_loc
-              | Optional x | Labelled x -> x.loc
-            in
             let break_body =
               match eN1_body.pexp_desc with
               | Pexp_function _ -> fmt "@ "
-              | _ ->
-                  if c.conf.fmt_opts.ocp_indent_compat.v then
-                    if
-                      Source.begins_line ~ignore_spaces:true c.source
-                        begin_arg_loc
-                    then break 1 2
-                    else fmt "@ "
-                  else fmt "@;<1 2>"
+              | _ -> break 1 (Indent.docked_fun c ~loc:eN1.pexp_loc ~lbl)
             in
             let wrap_intro x =
               wrap
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index 7811fe1bd3..9393cf7050 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -9819,9 +9819,9 @@ let x =
   some_fun________________________________
     some_arg______________________________
     (fun param ->
-      do_something ();
-      do_something_else ();
-      return_this_value)
+       do_something ();
+       do_something_else ();
+       return_this_value)
 ;;
 
 let x =

From 51d33585b23f25eb4b8e032cdd3470f7b20eb07e Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Thu, 23 Mar 2023 21:52:42 +0100
Subject: [PATCH 027/115] ocp-indent-compat: `function` in `fun` body

---
 lib/Fmt_ast.ml                      | 13 ++++++++--
 test/passing/tests/js_source.ml     | 40 +++++++++++++++++++++++++++++
 test/passing/tests/js_source.ml.ocp | 40 +++++++++++++++++++++++++++++
 test/passing/tests/js_source.ml.ref | 40 +++++++++++++++++++++++++++++
 4 files changed, 131 insertions(+), 2 deletions(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 85a09ddb98..9a91028e8b 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -99,6 +99,11 @@ module Indent = struct
       let default = if c.conf.fmt_opts.wrap_fun_args.v then 2 else 4 in
       Params.function_indent c.conf ~parens:false ~xexp ~default
 
+  let docked_function_after_fun ~parens ~lbl c =
+    if c.conf.fmt_opts.ocp_indent_compat.v then
+      if parens && Poly.equal lbl Nolabel then 3 else 2
+    else 0
+
   let fun_args_group lbl ast c =
     if not c.conf.fmt_opts.ocp_indent_compat.v then 2
     else
@@ -1427,7 +1432,9 @@ and fmt_fun ?force_closing_paren
   let body =
     let box =
       match xbody.ast.pexp_desc with
-      | Pexp_fun _ | Pexp_newtype _ | Pexp_function _ -> Some false
+      | Pexp_fun _ | Pexp_newtype _ -> Some false
+      | Pexp_function _ when not c.conf.fmt_opts.ocp_indent_compat.v ->
+          Some false
       | _ -> None
     in
     fmt_expression c ?box xbody
@@ -1978,7 +1985,9 @@ and fmt_expression c ?(box = true) ?pro ?epi ?eol ?parens ?(indent_wrap = 0)
           let args =
             let break_body =
               match eN1_body.pexp_desc with
-              | Pexp_function _ -> fmt "@ "
+              | Pexp_function _ ->
+                  break 1
+                    (Indent.docked_function_after_fun ~parens:true ~lbl c)
               | _ -> break 1 (Indent.docked_fun c ~loc:eN1.pexp_loc ~lbl)
             in
             let wrap_intro x =
diff --git a/test/passing/tests/js_source.ml b/test/passing/tests/js_source.ml
index 9f5af8a3d0..d8a228afc8 100644
--- a/test/passing/tests/js_source.ml
+++ b/test/passing/tests/js_source.ml
@@ -7868,3 +7868,43 @@ let _ =
   `Foooooooooooooooooo
     (name, Format.sprintf "expecting %S but got %S" Version.version value)
 ;;
+
+let _ =
+  Foooooooooooooooooooo.foooooooooooooooooooo
+    foooooooooooooooooooo
+    foooooooooooooooooooo
+    (fun x ->
+       function
+       | Foooooooooooooooooooo -> foooooooooooooooooooo
+       | Foooooooooooooooooooo -> foooooooooooooooooooo)
+;;
+
+let _ =
+  Foooooooooooooooooooo.foooooooooooooooooooo
+    foooooooooooooooooooo
+    foooooooooooooooooooo
+    ~x:(fun x ->
+      function
+      | Foooooooooooooooooooo -> foooooooooooooooooooo
+      | Foooooooooooooooooooo -> foooooooooooooooooooo)
+;;
+
+let _ =
+  Foooooooooooooooooooo.foooooooooooooooooooo
+    foooooooooooooooooooo
+    foooooooooooooooooooo
+    (fun x ->
+       match foo with
+       | Foooooooooooooooooooo -> foooooooooooooooooooo
+       | Foooooooooooooooooooo -> foooooooooooooooooooo)
+;;
+
+let _ =
+  Foooooooooooooooooooo.foooooooooooooooooooo
+    foooooooooooooooooooo
+    foooooooooooooooooooo
+    ~x:(fun x ->
+      match foo with
+      | Foooooooooooooooooooo -> foooooooooooooooooooo
+      | Foooooooooooooooooooo -> foooooooooooooooooooo)
+;;
diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp
index cdc27320d7..eb1008efd9 100644
--- a/test/passing/tests/js_source.ml.ocp
+++ b/test/passing/tests/js_source.ml.ocp
@@ -10119,3 +10119,43 @@ let _ =
   `Foooooooooooooooooo
     (name, Format.sprintf "expecting %S but got %S" Version.version value)
 ;;
+
+let _ =
+  Foooooooooooooooooooo.foooooooooooooooooooo
+    foooooooooooooooooooo
+    foooooooooooooooooooo
+    (fun x ->
+       function
+       | Foooooooooooooooooooo -> foooooooooooooooooooo
+       | Foooooooooooooooooooo -> foooooooooooooooooooo)
+;;
+
+let _ =
+  Foooooooooooooooooooo.foooooooooooooooooooo
+    foooooooooooooooooooo
+    foooooooooooooooooooo
+    ~x:(fun x ->
+      function
+      | Foooooooooooooooooooo -> foooooooooooooooooooo
+      | Foooooooooooooooooooo -> foooooooooooooooooooo)
+;;
+
+let _ =
+  Foooooooooooooooooooo.foooooooooooooooooooo
+    foooooooooooooooooooo
+    foooooooooooooooooooo
+    (fun x ->
+       match foo with
+       | Foooooooooooooooooooo -> foooooooooooooooooooo
+       | Foooooooooooooooooooo -> foooooooooooooooooooo)
+;;
+
+let _ =
+  Foooooooooooooooooooo.foooooooooooooooooooo
+    foooooooooooooooooooo
+    foooooooooooooooooooo
+    ~x:(fun x ->
+      match foo with
+      | Foooooooooooooooooooo -> foooooooooooooooooooo
+      | Foooooooooooooooooooo -> foooooooooooooooooooo)
+;;
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index 9393cf7050..0ca634b067 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -10119,3 +10119,43 @@ let _ =
   `Foooooooooooooooooo
     (name, Format.sprintf "expecting %S but got %S" Version.version value)
 ;;
+
+let _ =
+  Foooooooooooooooooooo.foooooooooooooooooooo
+    foooooooooooooooooooo
+    foooooooooooooooooooo
+    (fun x ->
+       function
+       | Foooooooooooooooooooo -> foooooooooooooooooooo
+       | Foooooooooooooooooooo -> foooooooooooooooooooo)
+;;
+
+let _ =
+  Foooooooooooooooooooo.foooooooooooooooooooo
+    foooooooooooooooooooo
+    foooooooooooooooooooo
+    ~x:(fun x ->
+      function
+      | Foooooooooooooooooooo -> foooooooooooooooooooo
+      | Foooooooooooooooooooo -> foooooooooooooooooooo)
+;;
+
+let _ =
+  Foooooooooooooooooooo.foooooooooooooooooooo
+    foooooooooooooooooooo
+    foooooooooooooooooooo
+    (fun x ->
+       match foo with
+       | Foooooooooooooooooooo -> foooooooooooooooooooo
+       | Foooooooooooooooooooo -> foooooooooooooooooooo)
+;;
+
+let _ =
+  Foooooooooooooooooooo.foooooooooooooooooooo
+    foooooooooooooooooooo
+    foooooooooooooooooooo
+    ~x:(fun x ->
+      match foo with
+      | Foooooooooooooooooooo -> foooooooooooooooooooo
+      | Foooooooooooooooooooo -> foooooooooooooooooooo)
+;;

From fe066dd2ff253a1f2055b7e327634f3a0bc41396 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Thu, 23 Mar 2023 22:20:11 +0100
Subject: [PATCH 028/115] ocp-indent-compat: Don't align `fun` args

---
 lib/Fmt_ast.ml                      | 22 ++++++++++++++++------
 test/passing/tests/js_source.ml     |  7 +++++++
 test/passing/tests/js_source.ml.ocp | 11 +++++++++++
 test/passing/tests/js_source.ml.ref | 11 +++++++++++
 4 files changed, 45 insertions(+), 6 deletions(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 9a91028e8b..504b803cdc 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -161,6 +161,18 @@ module Break = struct
     else break 1 2
 end
 
+module Box = struct
+  let _ocp a b c k = if c.conf.fmt_opts.ocp_indent_compat.v then a k else b k
+
+  let fun_decl = _ocp (hvbox 2) (hovbox 4)
+
+  let fun_args c k =
+    hvbox_if
+      ( (not c.conf.fmt_opts.wrap_fun_args.v)
+      && not c.conf.fmt_opts.ocp_indent_compat.v )
+      0 k
+end
+
 (* Debug: catch and report failures at nearest enclosing Ast.t *)
 
 let protect =
@@ -2204,16 +2216,14 @@ and fmt_expression c ?(box = true) ?pro ?epi ?eol ?parens ?(indent_wrap = 0)
         (Params.Exp.wrap c.conf ~parens ~disambiguate:true ~fits_breaks:false
            ~offset_closing_paren:(-2)
            ( hovbox 2
-               ( hovbox 4
+               ( Box.fun_decl c
                    ( str "fun"
                    $ fmt_extension_suffix c ext
                    $ str " "
                    $ fmt_attributes c pexp_attributes ~suf:" "
-                   $ hvbox_if
-                       (not c.conf.fmt_opts.wrap_fun_args.v)
-                       0 (fmt_fun_args c xargs)
-                   $ fmt_opt fmt_cstr $ fmt "@ " )
-               $ str "->" $ pre_body )
+                   $ Box.fun_args c (fmt_fun_args c xargs)
+                   $ fmt_opt fmt_cstr )
+               $ fmt "@ " $ str "->" $ pre_body )
            $ fmt "@ " $ body ) )
   | Pexp_function cs ->
       let indent = Params.function_indent c.conf ~parens ~xexp in
diff --git a/test/passing/tests/js_source.ml b/test/passing/tests/js_source.ml
index d8a228afc8..f67e97ac31 100644
--- a/test/passing/tests/js_source.ml
+++ b/test/passing/tests/js_source.ml
@@ -7908,3 +7908,10 @@ let _ =
       | Foooooooooooooooooooo -> foooooooooooooooooooo
       | Foooooooooooooooooooo -> foooooooooooooooooooo)
 ;;
+
+let _ =
+  let x = x in
+  fun foooooooooooooooooo foooooooooooooooooo foooooooooooooooooo foooooooooooooooooo
+      foooooooooooooooooo foooooooooooooooooo ->
+    ()
+;;
diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp
index eb1008efd9..ae57bb268f 100644
--- a/test/passing/tests/js_source.ml.ocp
+++ b/test/passing/tests/js_source.ml.ocp
@@ -10159,3 +10159,14 @@ let _ =
       | Foooooooooooooooooooo -> foooooooooooooooooooo
       | Foooooooooooooooooooo -> foooooooooooooooooooo)
 ;;
+
+let _ =
+  let x = x in
+  fun foooooooooooooooooo
+    foooooooooooooooooo
+    foooooooooooooooooo
+    foooooooooooooooooo
+    foooooooooooooooooo
+    foooooooooooooooooo ->
+    ()
+;;
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index 0ca634b067..4dc27b58b3 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -10159,3 +10159,14 @@ let _ =
       | Foooooooooooooooooooo -> foooooooooooooooooooo
       | Foooooooooooooooooooo -> foooooooooooooooooooo)
 ;;
+
+let _ =
+  let x = x in
+  fun foooooooooooooooooo
+    foooooooooooooooooo
+    foooooooooooooooooo
+    foooooooooooooooooo
+    foooooooooooooooooo
+    foooooooooooooooooo ->
+    ()
+;;

From c7d25cec171fe1f52c1706578a4428b614612d43 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Thu, 23 Mar 2023 22:25:58 +0100
Subject: [PATCH 029/115] ocp-indent-compat: Module type with constraints

---
 lib/Fmt_ast.ml                      | 5 ++++-
 test/passing/tests/js_source.ml     | 5 +++++
 test/passing/tests/js_source.ml.ocp | 5 +++++
 test/passing/tests/js_source.ml.ref | 5 +++++
 4 files changed, 19 insertions(+), 1 deletion(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 504b803cdc..c02d0e81d8 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -128,6 +128,8 @@ module Indent = struct
       match me.pmod_desc with Pmod_structure _ -> 0 | _ -> 2
     else 2
 
+  let mty_with = _ocp 0 2
+
   let variant ~parens c =
     if c.conf.fmt_opts.ocp_indent_compat.v && parens then 3 else 2
 
@@ -3558,7 +3560,8 @@ and fmt_module_type c ({ast= mty; _} as xmty) =
               open_hvbox 0 $ fmt_if parens "(" $ pro )
       ; psp
       ; bdy=
-          fmt_if_k (Option.is_none pro) (open_hvbox 2 $ fmt_if parens "(")
+          fmt_if_k (Option.is_none pro)
+            (open_hvbox (Indent.mty_with c) $ fmt_if parens "(")
           $ hvbox 0 bdy
           $ fmt_if_k (Option.is_some epi) esp
           $ fmt_opt epi $ list_fl wcs fmt_cstrs $ fmt_if parens ")"
diff --git a/test/passing/tests/js_source.ml b/test/passing/tests/js_source.ml
index f67e97ac31..2cf44e15e8 100644
--- a/test/passing/tests/js_source.ml
+++ b/test/passing/tests/js_source.ml
@@ -7915,3 +7915,8 @@ let _ =
       foooooooooooooooooo foooooooooooooooooo ->
     ()
 ;;
+
+module type For_let_syntax_local =
+  For_let_syntax_gen
+    with type ('a, 'b) fn := ('a[@local]) -> 'b
+     and type ('a, 'b) f_labeled_fn := f:('a[@local]) -> 'b
diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp
index ae57bb268f..d04c06f62d 100644
--- a/test/passing/tests/js_source.ml.ocp
+++ b/test/passing/tests/js_source.ml.ocp
@@ -10170,3 +10170,8 @@ let _ =
     foooooooooooooooooo ->
     ()
 ;;
+
+module type For_let_syntax_local =
+  For_let_syntax_gen
+  with type ('a, 'b) fn := ('a[@local]) -> 'b
+   and type ('a, 'b) f_labeled_fn := f:('a[@local]) -> 'b
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index 4dc27b58b3..6e2501f27a 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -10170,3 +10170,8 @@ let _ =
     foooooooooooooooooo ->
     ()
 ;;
+
+module type For_let_syntax_local =
+  For_let_syntax_gen
+  with type ('a, 'b) fn := ('a[@local]) -> 'b
+   and type ('a, 'b) f_labeled_fn := f:('a[@local]) -> 'b

From 0cbcdd2f615ec2ab5450690396895ce0a0fb71bb Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Thu, 23 Mar 2023 22:48:35 +0100
Subject: [PATCH 030/115] Don't align condition when `if-then-else` =
 `keyword-first`

---
 lib/Fmt_ast.ml                                           | 2 +-
 test/passing/tests/ite-compact.ml.ref                    | 7 +++++++
 test/passing/tests/ite-compact_closing.ml.ref            | 7 +++++++
 test/passing/tests/ite-fit_or_vertical.ml.ref            | 9 +++++++++
 test/passing/tests/ite-fit_or_vertical_closing.ml.ref    | 9 +++++++++
 .../passing/tests/ite-fit_or_vertical_no_indicate.ml.ref | 9 +++++++++
 test/passing/tests/ite-kr.ml.ref                         | 9 +++++++++
 test/passing/tests/ite-kr_closing.ml.ref                 | 9 +++++++++
 test/passing/tests/ite-kw_first.ml.ref                   | 6 ++++++
 test/passing/tests/ite-kw_first_closing.ml.ref           | 6 ++++++
 test/passing/tests/ite-kw_first_no_indicate.ml.ref       | 6 ++++++
 test/passing/tests/ite-no_indicate.ml.ref                | 7 +++++++
 test/passing/tests/ite-vertical.ml.ref                   | 9 +++++++++
 test/passing/tests/ite.ml                                | 7 +++++++
 test/passing/tests/ite.ml.ref                            | 7 +++++++
 15 files changed, 108 insertions(+), 1 deletion(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index c02d0e81d8..14af7fc4d4 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -2282,7 +2282,7 @@ and fmt_expression c ?(box = true) ?pro ?epi ?eol ?parens ?(indent_wrap = 0)
                                fmt_extension_suffix c ext ) )
                         ~fmt_attributes:
                           (fmt_attributes c ~pre:Blank pexp_attributes)
-                        ~fmt_cond:(fmt_expression c)
+                        ~fmt_cond:(fmt_expression ~box:false c)
                     in
                     parens_prev_bch := parens_bch ;
                     p.box_branch
diff --git a/test/passing/tests/ite-compact.ml.ref b/test/passing/tests/ite-compact.ml.ref
index 47fb9ae628..c7607dc7c5 100644
--- a/test/passing/tests/ite-compact.ml.ref
+++ b/test/passing/tests/ite-compact.ml.ref
@@ -137,3 +137,10 @@ let _ =
     xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz
   else fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz ->
     xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz
+
+let _ =
+  if
+    (* foooooooooooooooooooooooooooooooooooooooooo *)
+    foooooooooooooooooooooooooooooooooooooooooo
+  then foooooooooooooooooooooooooooooooooooooooooo
+  else foooooooooooooooooooooooooooooooooooooooooo
diff --git a/test/passing/tests/ite-compact_closing.ml.ref b/test/passing/tests/ite-compact_closing.ml.ref
index 7a7e5e1008..d5143439e1 100644
--- a/test/passing/tests/ite-compact_closing.ml.ref
+++ b/test/passing/tests/ite-compact_closing.ml.ref
@@ -152,3 +152,10 @@ let _ =
     xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz
   else fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz ->
     xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz
+
+let _ =
+  if
+    (* foooooooooooooooooooooooooooooooooooooooooo *)
+    foooooooooooooooooooooooooooooooooooooooooo
+  then foooooooooooooooooooooooooooooooooooooooooo
+  else foooooooooooooooooooooooooooooooooooooooooo
diff --git a/test/passing/tests/ite-fit_or_vertical.ml.ref b/test/passing/tests/ite-fit_or_vertical.ml.ref
index 788fcace37..df2af0c9a8 100644
--- a/test/passing/tests/ite-fit_or_vertical.ml.ref
+++ b/test/passing/tests/ite-fit_or_vertical.ml.ref
@@ -168,3 +168,12 @@ let _ =
   else
     fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz ->
   xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz
+
+let _ =
+  if
+    (* foooooooooooooooooooooooooooooooooooooooooo *)
+    foooooooooooooooooooooooooooooooooooooooooo
+  then
+    foooooooooooooooooooooooooooooooooooooooooo
+  else
+    foooooooooooooooooooooooooooooooooooooooooo
diff --git a/test/passing/tests/ite-fit_or_vertical_closing.ml.ref b/test/passing/tests/ite-fit_or_vertical_closing.ml.ref
index 812812584e..1e1f7466d0 100644
--- a/test/passing/tests/ite-fit_or_vertical_closing.ml.ref
+++ b/test/passing/tests/ite-fit_or_vertical_closing.ml.ref
@@ -180,3 +180,12 @@ let _ =
   else
     fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz ->
   xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz
+
+let _ =
+  if
+    (* foooooooooooooooooooooooooooooooooooooooooo *)
+    foooooooooooooooooooooooooooooooooooooooooo
+  then
+    foooooooooooooooooooooooooooooooooooooooooo
+  else
+    foooooooooooooooooooooooooooooooooooooooooo
diff --git a/test/passing/tests/ite-fit_or_vertical_no_indicate.ml.ref b/test/passing/tests/ite-fit_or_vertical_no_indicate.ml.ref
index 8b92178848..cb8c1c7bd8 100644
--- a/test/passing/tests/ite-fit_or_vertical_no_indicate.ml.ref
+++ b/test/passing/tests/ite-fit_or_vertical_no_indicate.ml.ref
@@ -168,3 +168,12 @@ let _ =
   else
     fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz ->
   xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz
+
+let _ =
+  if
+    (* foooooooooooooooooooooooooooooooooooooooooo *)
+    foooooooooooooooooooooooooooooooooooooooooo
+  then
+    foooooooooooooooooooooooooooooooooooooooooo
+  else
+    foooooooooooooooooooooooooooooooooooooooooo
diff --git a/test/passing/tests/ite-kr.ml.ref b/test/passing/tests/ite-kr.ml.ref
index 631b238ebf..2e3a1b94d3 100644
--- a/test/passing/tests/ite-kr.ml.ref
+++ b/test/passing/tests/ite-kr.ml.ref
@@ -203,3 +203,12 @@ let _ =
   else
     fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz ->
   xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz
+
+let _ =
+  if
+    (* foooooooooooooooooooooooooooooooooooooooooo *)
+    foooooooooooooooooooooooooooooooooooooooooo
+  then
+    foooooooooooooooooooooooooooooooooooooooooo
+  else
+    foooooooooooooooooooooooooooooooooooooooooo
diff --git a/test/passing/tests/ite-kr_closing.ml.ref b/test/passing/tests/ite-kr_closing.ml.ref
index 3f70b3b86f..bdc3718d6d 100644
--- a/test/passing/tests/ite-kr_closing.ml.ref
+++ b/test/passing/tests/ite-kr_closing.ml.ref
@@ -213,3 +213,12 @@ let _ =
   else
     fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz ->
   xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz
+
+let _ =
+  if
+    (* foooooooooooooooooooooooooooooooooooooooooo *)
+    foooooooooooooooooooooooooooooooooooooooooo
+  then
+    foooooooooooooooooooooooooooooooooooooooooo
+  else
+    foooooooooooooooooooooooooooooooooooooooooo
diff --git a/test/passing/tests/ite-kw_first.ml.ref b/test/passing/tests/ite-kw_first.ml.ref
index 09d8646acc..a67b119fc1 100644
--- a/test/passing/tests/ite-kw_first.ml.ref
+++ b/test/passing/tests/ite-kw_first.ml.ref
@@ -160,3 +160,9 @@ let _ =
   else
     fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz ->
     xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz
+
+let _ =
+  if (* foooooooooooooooooooooooooooooooooooooooooo *)
+    foooooooooooooooooooooooooooooooooooooooooo
+  then foooooooooooooooooooooooooooooooooooooooooo
+  else foooooooooooooooooooooooooooooooooooooooooo
diff --git a/test/passing/tests/ite-kw_first_closing.ml.ref b/test/passing/tests/ite-kw_first_closing.ml.ref
index 77a21cb637..d4768682c9 100644
--- a/test/passing/tests/ite-kw_first_closing.ml.ref
+++ b/test/passing/tests/ite-kw_first_closing.ml.ref
@@ -175,3 +175,9 @@ let _ =
   else
     fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz ->
     xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz
+
+let _ =
+  if (* foooooooooooooooooooooooooooooooooooooooooo *)
+    foooooooooooooooooooooooooooooooooooooooooo
+  then foooooooooooooooooooooooooooooooooooooooooo
+  else foooooooooooooooooooooooooooooooooooooooooo
diff --git a/test/passing/tests/ite-kw_first_no_indicate.ml.ref b/test/passing/tests/ite-kw_first_no_indicate.ml.ref
index 7915d7551b..09e4e726f8 100644
--- a/test/passing/tests/ite-kw_first_no_indicate.ml.ref
+++ b/test/passing/tests/ite-kw_first_no_indicate.ml.ref
@@ -159,3 +159,9 @@ let _ =
   else
     fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz ->
     xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz
+
+let _ =
+  if (* foooooooooooooooooooooooooooooooooooooooooo *)
+    foooooooooooooooooooooooooooooooooooooooooo
+  then foooooooooooooooooooooooooooooooooooooooooo
+  else foooooooooooooooooooooooooooooooooooooooooo
diff --git a/test/passing/tests/ite-no_indicate.ml.ref b/test/passing/tests/ite-no_indicate.ml.ref
index c7f2d87ae8..e01dad5960 100644
--- a/test/passing/tests/ite-no_indicate.ml.ref
+++ b/test/passing/tests/ite-no_indicate.ml.ref
@@ -136,3 +136,10 @@ let _ =
     xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz
   else fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz ->
     xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz
+
+let _ =
+  if
+    (* foooooooooooooooooooooooooooooooooooooooooo *)
+    foooooooooooooooooooooooooooooooooooooooooo
+  then foooooooooooooooooooooooooooooooooooooooooo
+  else foooooooooooooooooooooooooooooooooooooooooo
diff --git a/test/passing/tests/ite-vertical.ml.ref b/test/passing/tests/ite-vertical.ml.ref
index 7624be7f37..6c317d6947 100644
--- a/test/passing/tests/ite-vertical.ml.ref
+++ b/test/passing/tests/ite-vertical.ml.ref
@@ -199,3 +199,12 @@ let _ =
   else
     fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz ->
       xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz
+
+let _ =
+  if
+    (* foooooooooooooooooooooooooooooooooooooooooo *)
+    foooooooooooooooooooooooooooooooooooooooooo
+  then
+    foooooooooooooooooooooooooooooooooooooooooo
+  else
+    foooooooooooooooooooooooooooooooooooooooooo
diff --git a/test/passing/tests/ite.ml b/test/passing/tests/ite.ml
index 910d40a169..3971585994 100644
--- a/test/passing/tests/ite.ml
+++ b/test/passing/tests/ite.ml
@@ -139,3 +139,10 @@ let _ =
   else
     (fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz ->
        xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz)
+
+let _ =
+  if
+    (* foooooooooooooooooooooooooooooooooooooooooo *)
+    foooooooooooooooooooooooooooooooooooooooooo
+  then foooooooooooooooooooooooooooooooooooooooooo
+  else foooooooooooooooooooooooooooooooooooooooooo
diff --git a/test/passing/tests/ite.ml.ref b/test/passing/tests/ite.ml.ref
index 47fb9ae628..c7607dc7c5 100644
--- a/test/passing/tests/ite.ml.ref
+++ b/test/passing/tests/ite.ml.ref
@@ -137,3 +137,10 @@ let _ =
     xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz
   else fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz ->
     xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz
+
+let _ =
+  if
+    (* foooooooooooooooooooooooooooooooooooooooooo *)
+    foooooooooooooooooooooooooooooooooooooooooo
+  then foooooooooooooooooooooooooooooooooooooooooo
+  else foooooooooooooooooooooooooooooooooooooooooo

From 44469228f435325f1b0ab61fd302f224242a79e1 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Thu, 23 Mar 2023 22:53:59 +0100
Subject: [PATCH 031/115] ocp-indent-compat: Indent type constr with args

---
 lib/Fmt_ast.ml                      |  2 +-
 test/passing/tests/js_source.ml     | 10 ++++++++++
 test/passing/tests/js_source.ml.ocp | 10 ++++++++++
 test/passing/tests/js_source.ml.ref | 10 ++++++++++
 4 files changed, 31 insertions(+), 1 deletion(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 14af7fc4d4..62bf6b4edd 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -897,7 +897,7 @@ and fmt_core_type c ?(box = true) ?pro ?(pro_space = true) ?constraint_ctx
       wrap_fits_breaks c.conf "(" ")"
         (list t1N (Params.comma_sep c.conf)
            (sub_typ ~ctx >> fmt_core_type c) )
-      $ fmt "@ " $ fmt_longident_loc c lid
+      $ Break.type_constr c $ fmt_longident_loc c lid
   | Ptyp_extension ext ->
       hvbox c.conf.fmt_opts.extension_indent.v (fmt_extension c ctx ext)
   | Ptyp_package (id, cnstrs) ->
diff --git a/test/passing/tests/js_source.ml b/test/passing/tests/js_source.ml
index 2cf44e15e8..1d43d360ef 100644
--- a/test/passing/tests/js_source.ml
+++ b/test/passing/tests/js_source.ml
@@ -7920,3 +7920,13 @@ module type For_let_syntax_local =
   For_let_syntax_gen
     with type ('a, 'b) fn := ('a[@local]) -> 'b
      and type ('a, 'b) f_labeled_fn := f:('a[@local]) -> 'b
+
+type fooooooooooooooooooooooooooooooo =
+  ( fooooooooooooooooooooooooooooooo
+  , fooooooooooooooooooooooooooooooo )
+    fooooooooooooooooooooooooooooooo
+
+val fooooooooooooooooooooooooooooooo
+  : ( fooooooooooooooooooooooooooooooo
+    , fooooooooooooooooooooooooooooooo )
+      fooooooooooooooooooooooooooooooo
diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp
index d04c06f62d..4d3187029a 100644
--- a/test/passing/tests/js_source.ml.ocp
+++ b/test/passing/tests/js_source.ml.ocp
@@ -10175,3 +10175,13 @@ module type For_let_syntax_local =
   For_let_syntax_gen
   with type ('a, 'b) fn := ('a[@local]) -> 'b
    and type ('a, 'b) f_labeled_fn := f:('a[@local]) -> 'b
+
+type fooooooooooooooooooooooooooooooo =
+  ( fooooooooooooooooooooooooooooooo
+  , fooooooooooooooooooooooooooooooo )
+    fooooooooooooooooooooooooooooooo
+
+val fooooooooooooooooooooooooooooooo
+  : ( fooooooooooooooooooooooooooooooo
+    , fooooooooooooooooooooooooooooooo )
+      fooooooooooooooooooooooooooooooo
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index 6e2501f27a..6ef70eddea 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -10175,3 +10175,13 @@ module type For_let_syntax_local =
   For_let_syntax_gen
   with type ('a, 'b) fn := ('a[@local]) -> 'b
    and type ('a, 'b) f_labeled_fn := f:('a[@local]) -> 'b
+
+type fooooooooooooooooooooooooooooooo =
+  ( fooooooooooooooooooooooooooooooo
+  , fooooooooooooooooooooooooooooooo )
+    fooooooooooooooooooooooooooooooo
+
+val fooooooooooooooooooooooooooooooo
+  : ( fooooooooooooooooooooooooooooooo
+    , fooooooooooooooooooooooooooooooo )
+      fooooooooooooooooooooooooooooooo

From b7df86c4a91588e6458d5fcc90e73f01a4ff44bb Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Fri, 24 Mar 2023 00:08:15 +0100
Subject: [PATCH 032/115] ocp-indent-compat: Constructor and variant patterns

---
 lib/Fmt_ast.ml                      |  6 ++++--
 test/passing/tests/js_source.ml     | 15 +++++++++++++++
 test/passing/tests/js_source.ml.ocp | 17 +++++++++++++++++
 test/passing/tests/js_source.ml.ref | 17 +++++++++++++++++
 4 files changed, 53 insertions(+), 2 deletions(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 62bf6b4edd..49d7fc7f7b 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -1106,7 +1106,8 @@ and fmt_pattern ?ext c ?pro ?parens ?(box = false)
       Cmts.fmt c ppat_loc
         (hvbox 0 (fmt_pat_cons c ~parens (List.map lp ~f:(sub_pat ~ctx))))
   | Ppat_construct (lid, Some (exists, pat)) ->
-      cbox 2
+      cbox
+        (Indent.variant ~parens c)
         (Params.parens_if parens c.conf
            ( fmt_longident_loc c lid $ fmt "@ "
            $ ( match exists with
@@ -1119,7 +1120,8 @@ and fmt_pattern ?ext c ?pro ?parens ?(box = false)
            $ fmt_pattern c (sub_pat ~ctx pat) ) )
   | Ppat_variant (lbl, None) -> variant_var c lbl
   | Ppat_variant (lbl, Some pat) ->
-      cbox 2
+      cbox
+        (Indent.variant ~parens c)
         (Params.parens_if parens c.conf
            (variant_var c lbl $ fmt "@ " $ fmt_pattern c (sub_pat ~ctx pat)) )
   | Ppat_record (flds, closed_flag) ->
diff --git a/test/passing/tests/js_source.ml b/test/passing/tests/js_source.ml
index 1d43d360ef..3eed3a53fb 100644
--- a/test/passing/tests/js_source.ml
+++ b/test/passing/tests/js_source.ml
@@ -7869,6 +7869,21 @@ let _ =
     (name, Format.sprintf "expecting %S but got %S" Version.version value)
 ;;
 
+let _ =
+  Foooooooooooooooooo
+    (name, Format.sprintf "expecting %S but got %S" Version.version value)
+;;
+
+let (`Foooooooooooooooooo
+      (foooooooooooooo, foooooooooooooo, foooooooooooooo, foooooooooooooo) )
+    =
+  x
+
+let (Foooooooooooooooooo
+      (foooooooooooooo, foooooooooooooo, foooooooooooooo, foooooooooooooo) )
+    =
+  x
+
 let _ =
   Foooooooooooooooooooo.foooooooooooooooooooo
     foooooooooooooooooooo
diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp
index 4d3187029a..e2e1b8707e 100644
--- a/test/passing/tests/js_source.ml.ocp
+++ b/test/passing/tests/js_source.ml.ocp
@@ -10120,6 +10120,23 @@ let _ =
     (name, Format.sprintf "expecting %S but got %S" Version.version value)
 ;;
 
+let _ =
+  Foooooooooooooooooo
+    (name, Format.sprintf "expecting %S but got %S" Version.version value)
+;;
+
+let (`Foooooooooooooooooo
+       (foooooooooooooo, foooooooooooooo, foooooooooooooo, foooooooooooooo))
+  =
+  x
+;;
+
+let (Foooooooooooooooooo
+       (foooooooooooooo, foooooooooooooo, foooooooooooooo, foooooooooooooo))
+  =
+  x
+;;
+
 let _ =
   Foooooooooooooooooooo.foooooooooooooooooooo
     foooooooooooooooooooo
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index 6ef70eddea..1c8a579606 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -10120,6 +10120,23 @@ let _ =
     (name, Format.sprintf "expecting %S but got %S" Version.version value)
 ;;
 
+let _ =
+  Foooooooooooooooooo
+    (name, Format.sprintf "expecting %S but got %S" Version.version value)
+;;
+
+let (`Foooooooooooooooooo
+       (foooooooooooooo, foooooooooooooo, foooooooooooooo, foooooooooooooo))
+  =
+  x
+;;
+
+let (Foooooooooooooooooo
+       (foooooooooooooo, foooooooooooooo, foooooooooooooo, foooooooooooooo))
+  =
+  x
+;;
+
 let _ =
   Foooooooooooooooooooo.foooooooooooooooooooo
     foooooooooooooooooooo

From 49756455574232d442767d5caf46d95f1ee52cc7 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Fri, 24 Mar 2023 17:22:23 +0100
Subject: [PATCH 033/115] Improve formatting of module arguments

Remove the unbalanced opening and closing boxes and re-implement module
arguments using the `pro` and `epi` concept.

The box structure is much more logical and it should be easier to
implement variantions.

The indentation is more concistent.
---
 lib/Fmt_ast.ml                              | 105 +++++++++-----------
 lib/Params.ml                               |  16 +++
 lib/Params.mli                              |   8 ++
 test/passing/tests/js_source.ml.err         |  10 +-
 test/passing/tests/js_source.ml.ocp         |  16 +--
 test/passing/tests/js_source.ml.ref         |  26 ++---
 test/passing/tests/let_module-sparse.ml.ref |   2 +-
 test/passing/tests/let_module.ml.ref        |   2 +-
 test/passing/tests/source.ml.ref            |  25 +++--
 9 files changed, 113 insertions(+), 97 deletions(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index e0187d6b9f..5315d04020 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -77,14 +77,16 @@ let empty =
   ; esp= noop
   ; epi= None }
 
-let compose_module ?pro ?epi ({opn; psp; bdy; cls; esp; _} as blk) ~f =
-  f
-    ( fmt_opt opn $ fmt_opt pro $ fmt_opt blk.pro $ psp $ bdy $ cls $ esp
-    $ fmt_opt blk.epi )
-  $ fmt_opt epi
+let blk_box ?(box = true) blk k =
+  match blk.opn with Some opn -> wrap_if_k box opn blk.cls k | None -> k
 
-let blk_box blk k =
-  match blk.opn with Some opn -> wrap_k opn blk.cls k | None -> k
+let compose_module' ?box ?pro ?epi ({psp; bdy; esp; _} as blk) =
+  ( blk_box ?box blk (fmt_opt pro $ (fmt_opt blk.pro $ psp $ bdy)) $ esp
+  , fmt_opt blk.epi $ fmt_opt epi )
+
+let compose_module ?box ?pro ?epi blk ~f =
+  let bdy, epi' = compose_module' ?box ?pro blk in
+  f (bdy $ epi') $ fmt_opt epi
 
 (* Debug: catch and report failures at nearest enclosing Ast.t *)
 
@@ -3665,17 +3667,6 @@ and fmt_class_exprs ?ext c ctx cls =
 
 and fmt_module c ctx ?ext ?epi ?(can_sparse = false) keyword ?(eqty = "=")
     name xargs xbody xmty attributes ~rec_flag =
-  let arg_blks =
-    List.map xargs ~f:(fun {loc; txt} ->
-        let txt =
-          match txt with
-          | Unit -> `Unit
-          | Named (name, mt) ->
-              let xmt = sub_mty ~ctx mt in
-              `Named (name, fmt_module_type c xmt)
-        in
-        {loc; txt} )
-  in
   let blk_t =
     Option.value_map xmty ~default:empty ~f:(fun xmty ->
         let blk = fmt_module_type c xmty in
@@ -3685,32 +3676,39 @@ and fmt_module c ctx ?ext ?epi ?(can_sparse = false) keyword ?(eqty = "=")
         ; psp= fmt_if (Option.is_none blk.pro) "@;<1 2>" $ blk.psp } )
   in
   let blk_b = Option.value_map xbody ~default:empty ~f:(fmt_module_expr c) in
-  let box_t = blk_box blk_t in
-  let box_b = blk_box blk_b in
-  let fmt_arg ~prev:_ arg_mtyp ~next =
-    let maybe_box k =
-      match arg_mtyp.txt with
-      | `Named (_, {pro= None; _}) -> hvbox 0 k
-      | _ -> k
-    in
-    fmt "@ "
-    $ maybe_box
-        (Cmts.fmt c arg_mtyp.loc
-           (wrap "(" ")"
-              ( match arg_mtyp.txt with
-              | `Unit -> noop
-              | `Named (name, {pro; psp; bdy; cls; esp; epi; opn= _}) ->
-                  (* TODO: handle opn *)
-                  fmt_str_loc_opt c name $ str " : "
-                  $ opt pro (fun pro -> pro $ close_box)
-                  $ psp $ bdy
-                  $ fmt_if_k (Option.is_some pro) cls
-                  $ esp
-                  $ ( match next with
-                    | Some {txt= `Named (_, {opn; pro= Some _; _}); _} ->
-                        fmt_opt opn $ open_hvbox 0
-                    | _ -> noop )
-                  $ fmt_opt epi ) ) )
+  let fmt_name_and_mt ~pro ~loc name mt =
+    let xmt = sub_mty ~ctx mt in
+    let blk = fmt_module_type c xmt in
+    let pro =
+      pro $ Cmts.fmt_before c loc $ str "(" $ fmt_str_loc_opt c name
+      $ str " : "
+    and epi = str ")" $ Cmts.fmt_after c loc in
+    compose_module' ~box:false ~pro ~epi blk
+  in
+  let args_p = Params.Mod.get_args c.conf xargs in
+  (* Carry the [epi] to be placed in the next argument's box. *)
+  let fmt_arg ~pro {loc; txt} =
+    match txt with
+    | Unit -> (pro $ fmt "@ " $ Cmts.fmt c loc (str "()"), noop)
+    | Named (name, mt) ->
+        if args_p.dock then
+          (* All signatures, put the [epi] into the box of the next arg and
+             don't break. *)
+          fmt_name_and_mt ~pro:(pro $ str " ") ~loc name mt
+        else
+          let bdy, epi = fmt_name_and_mt ~pro:noop ~loc name mt in
+          (pro $ fmt "@;<1 4>" $ hvbox 0 bdy $ epi, noop)
+  in
+  let rec fmt_args ~pro = function
+    | [] -> pro
+    | hd :: tl ->
+        let bdy, epi = fmt_arg ~pro hd in
+        bdy $ fmt_args ~pro:epi tl
+  in
+  let intro =
+    str keyword
+    $ fmt_extension_suffix c ext
+    $ fmt_if rec_flag " rec" $ str " " $ fmt_str_loc_opt c name
   in
   let single_line =
     Option.for_all xbody ~f:(fun x -> Mod.is_simple x.ast)
@@ -3728,24 +3726,11 @@ and fmt_module c ctx ?ext ?epi ?(can_sparse = false) keyword ?(eqty = "=")
   hvbox
     (if compact then 0 else 2)
     ( doc_before
-    $ box_b
+    $ blk_box blk_b
         ( (if Option.is_some blk_t.epi then hovbox else hvbox)
             0
-            ( box_t
-                ( hvbox_if
-                    (Option.is_some blk_t.pro)
-                    0
-                    ( ( match arg_blks with
-                      | {txt= `Named (_, {opn; pro= Some _; _}); _} :: _ ->
-                          fmt_opt opn $ open_hvbox 0
-                      | _ -> noop )
-                    $ hvbox 4
-                        ( str keyword
-                        $ fmt_extension_suffix c ext
-                        $ fmt_if rec_flag " rec" $ str " "
-                        $ fmt_str_loc_opt c name $ list_pn arg_blks fmt_arg
-                        )
-                    $ fmt_opt blk_t.pro )
+            ( blk_box blk_t
+                ( hvbox 0 (fmt_args ~pro:intro xargs $ fmt_opt blk_t.pro)
                 $ blk_t.psp $ blk_t.bdy )
             $ blk_t.esp $ fmt_opt blk_t.epi
             $ fmt_if (Option.is_some xbody) " ="
diff --git a/lib/Params.ml b/lib/Params.ml
index 869605365b..316711b19a 100644
--- a/lib/Params.ml
+++ b/lib/Params.ml
@@ -76,6 +76,22 @@ module Exp = struct
       | `No -> wrap "(" ")" k
 end
 
+module Mod = struct
+  type args = {dock: bool}
+
+  let arg_is_sig arg =
+    match arg.txt with
+    | Named
+        ( _
+        , { pmty_desc=
+              Pmty_signature _ | Pmty_typeof {pmod_desc= Pmod_structure _; _}
+          ; _ } ) ->
+        true
+    | _ -> false
+
+  let get_args (_c : Conf.t) args = {dock= List.for_all ~f:arg_is_sig args}
+end
+
 let get_or_pattern_sep ?(cmts_before = false) ?(space = false) (c : Conf.t)
     ~ctx =
   let nspaces = if cmts_before then 1000 else 1 in
diff --git a/lib/Params.mli b/lib/Params.mli
index 64377b44ba..06d978448c 100644
--- a/lib/Params.mli
+++ b/lib/Params.mli
@@ -10,6 +10,7 @@
 (**************************************************************************)
 
 open Extended_ast
+open Asttypes
 
 val parens_if : bool -> Conf.t -> ?disambiguate:bool -> Fmt.t -> Fmt.t
 
@@ -36,6 +37,13 @@ module Exp : sig
     -> Fmt.t
 end
 
+module Mod : sig
+  type args =
+    {dock: bool  (** Whether each argument [pro] should be docked. *)}
+
+  val get_args : Conf.t -> functor_parameter loc list -> args
+end
+
 val get_or_pattern_sep :
   ?cmts_before:bool -> ?space:bool -> Conf.t -> ctx:Ast.t -> Fmt.t
 
diff --git a/test/passing/tests/js_source.ml.err b/test/passing/tests/js_source.ml.err
index be4486aef5..a077d23e33 100644
--- a/test/passing/tests/js_source.ml.err
+++ b/test/passing/tests/js_source.ml.err
@@ -1,7 +1,7 @@
 Warning: tests/js_source.ml:155 exceeds the margin
 Warning: tests/js_source.ml:3554 exceeds the margin
-Warning: tests/js_source.ml:9515 exceeds the margin
-Warning: tests/js_source.ml:9618 exceeds the margin
-Warning: tests/js_source.ml:9637 exceeds the margin
-Warning: tests/js_source.ml:9677 exceeds the margin
-Warning: tests/js_source.ml:9759 exceeds the margin
+Warning: tests/js_source.ml:9517 exceeds the margin
+Warning: tests/js_source.ml:9620 exceeds the margin
+Warning: tests/js_source.ml:9639 exceeds the margin
+Warning: tests/js_source.ml:9679 exceeds the margin
+Warning: tests/js_source.ml:9761 exceeds the margin
diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp
index 6b57a0bae2..53bee59065 100644
--- a/test/passing/tests/js_source.ml.ocp
+++ b/test/passing/tests/js_source.ml.ocp
@@ -4741,9 +4741,10 @@ end
 let f (module M : S with type t = int) = { M.a = 0 }
 let flag = ref false
 
-module F (S : sig
-    module type T
-  end)
+module F
+    (S : sig
+       module type T
+     end)
     (A : S.T)
     (B : S.T) =
 struct
@@ -7130,8 +7131,9 @@ type 'a tree =
   | E
   | N of 'a tree * 'a * 'a tree
 
-module Bootstrap2 (MakeDiet : functor (X : ORD) ->
-    SET with type t = X.t tree and type elt = X.t) : SET with type elt = int = struct
+module Bootstrap2
+    (MakeDiet : functor (X : ORD) -> SET with type t = X.t tree and type elt = X.t) :
+  SET with type elt = int = struct
   type elt = int
 
   module rec Elt : sig
@@ -7563,8 +7565,8 @@ module type HEAP = sig
   val deleteMin : heap -> heap
 end
 
-module Bootstrap (MakeH : functor (Element : ORDERED) ->
-    HEAP with module Elem = Element)
+module Bootstrap
+    (MakeH : functor (Element : ORDERED) -> HEAP with module Elem = Element)
     (Element : ORDERED) : HEAP with module Elem = Element = struct
   module Elem = Element
 
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index 05301d4e50..25138caf8f 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -4741,11 +4741,12 @@ end
 let f (module M : S with type t = int) = { M.a = 0 }
 let flag = ref false
 
-module F (S : sig
-  module type T
-end)
-(A : S.T)
-(B : S.T) =
+module F
+    (S : sig
+      module type T
+    end)
+    (A : S.T)
+    (B : S.T) =
 struct
   module X = (val if !flag then (module A) else (module B) : S.T)
 end
@@ -4955,8 +4956,8 @@ module type S = sig
 end
 
 module Foo
-  (Bar : S with type a = private [> `A ])
-  (Baz : S with type b = private < b : Bar.b ; .. >) =
+    (Bar : S with type a = private [> `A ])
+    (Baz : S with type b = private < b : Bar.b ; .. >) =
 struct end
 
 module A = struct
@@ -7130,8 +7131,9 @@ type 'a tree =
   | E
   | N of 'a tree * 'a * 'a tree
 
-module Bootstrap2 (MakeDiet : functor (X : ORD) ->
-  SET with type t = X.t tree and type elt = X.t) : SET with type elt = int = struct
+module Bootstrap2
+    (MakeDiet : functor (X : ORD) -> SET with type t = X.t tree and type elt = X.t) :
+  SET with type elt = int = struct
   type elt = int
 
   module rec Elt : sig
@@ -7563,9 +7565,9 @@ module type HEAP = sig
   val deleteMin : heap -> heap
 end
 
-module Bootstrap (MakeH : functor (Element : ORDERED) ->
-  HEAP with module Elem = Element)
-(Element : ORDERED) : HEAP with module Elem = Element = struct
+module Bootstrap
+    (MakeH : functor (Element : ORDERED) -> HEAP with module Elem = Element)
+    (Element : ORDERED) : HEAP with module Elem = Element = struct
   module Elem = Element
 
   module rec BE : sig
diff --git a/test/passing/tests/let_module-sparse.ml.ref b/test/passing/tests/let_module-sparse.ml.ref
index 976d5928e6..66a42f904a 100644
--- a/test/passing/tests/let_module-sparse.ml.ref
+++ b/test/passing/tests/let_module-sparse.ml.ref
@@ -57,5 +57,5 @@ let () =
 
 let f () =
   let module (* comment *)
-      M = struct end in
+  M = struct end in
   ()
diff --git a/test/passing/tests/let_module.ml.ref b/test/passing/tests/let_module.ml.ref
index 9b100468d7..e484db2ded 100644
--- a/test/passing/tests/let_module.ml.ref
+++ b/test/passing/tests/let_module.ml.ref
@@ -49,5 +49,5 @@ let () =
 
 let f () =
   let module (* comment *)
-      M = struct end in
+  M = struct end in
   ()
diff --git a/test/passing/tests/source.ml.ref b/test/passing/tests/source.ml.ref
index 31a1440cbd..dec12fcfb8 100644
--- a/test/passing/tests/source.ml.ref
+++ b/test/passing/tests/source.ml.ref
@@ -4501,11 +4501,12 @@ let f (module M : S with type t = int) = {M.a= 0}
 
 let flag = ref false
 
-module F (S : sig
-  module type T
-end)
-(A : S.T)
-(B : S.T) =
+module F
+    (S : sig
+      module type T
+    end)
+    (A : S.T)
+    (B : S.T) =
 struct
   module X = (val if !flag then (module A) else (module B) : S.T)
 end
@@ -6914,9 +6915,11 @@ end
 
 type 'a tree = E | N of 'a tree * 'a * 'a tree
 
-module Bootstrap2 (MakeDiet : functor (X : ORD) ->
-  SET with type t = X.t tree and type elt = X.t) : SET with type elt = int =
-struct
+module Bootstrap2
+    (MakeDiet : functor
+      (X : ORD)
+      -> SET with type t = X.t tree and type elt = X.t) :
+  SET with type elt = int = struct
   type elt = int
 
   module rec Elt : sig
@@ -7337,9 +7340,9 @@ module type HEAP = sig
   val deleteMin : heap -> heap
 end
 
-module Bootstrap (MakeH : functor (Element : ORDERED) ->
-  HEAP with module Elem = Element)
-(Element : ORDERED) : HEAP with module Elem = Element = struct
+module Bootstrap
+    (MakeH : functor (Element : ORDERED) -> HEAP with module Elem = Element)
+    (Element : ORDERED) : HEAP with module Elem = Element = struct
   module Elem = Element
 
   module rec BE : sig

From 3a216df163e3419f910b69762d5311f7d8a9fbdd Mon Sep 17 00:00:00 2001
From: Guillaume Petiot <guillaume@tarides.com>
Date: Tue, 4 Apr 2023 09:35:57 +0100
Subject: [PATCH 034/115] ocp-indent-compat: variant argument

---
 lib/Fmt_ast.ml                      | 4 +++-
 test/passing/tests/js_source.ml.ref | 2 +-
 2 files changed, 4 insertions(+), 2 deletions(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 49d7fc7f7b..19ee5eff4f 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -133,6 +133,8 @@ module Indent = struct
   let variant ~parens c =
     if c.conf.fmt_opts.ocp_indent_compat.v && parens then 3 else 2
 
+  let variant_type_arg c = _ocp 2 0 c
+
   let docked_fun c ~loc ~lbl =
     if not c.conf.fmt_opts.ocp_indent_compat.v then 2
     else
@@ -1025,7 +1027,7 @@ and fmt_row_field c ctx {prf_desc; prf_attributes; prf_loc} =
     | Rinherit typ -> fmt_core_type c (sub_typ ~ctx typ)
   in
   hvbox 0
-    ( hvbox 0 (Cmts.fmt c prf_loc row)
+    ( hvbox (Indent.variant_type_arg c) (Cmts.fmt c prf_loc row)
     $ fmt_attributes_and_docstrings c prf_attributes )
 
 and fmt_pattern_attributes c xpat k =
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index 1c8a579606..702251d736 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -9675,7 +9675,7 @@ let _ =
 
 type t =
   [ `XXXX
-    (* __________________________________________________________________________________ *)
+      (* __________________________________________________________________________________ *)
   | `XXXX (* __________________________________________________________________ *)
   | `XXXX (* _____________________________________________________ *)
   | `XXXX (* ___________________________________________________ *)

From 93ac80a242f0043cd96abc1f1c04515d8fba9198 Mon Sep 17 00:00:00 2001
From: Guillaume Petiot <guillaume@tarides.com>
Date: Tue, 4 Apr 2023 10:01:10 +0100
Subject: [PATCH 035/115] ocp-indent-compat: fix non-breaking attr after expr

---
 lib/Fmt_ast.ml                      |  6 +-----
 test/passing/tests/js_source.ml.err | 10 +++++-----
 test/passing/tests/js_source.ml.ocp | 21 ++++++++++++++-------
 test/passing/tests/js_source.ml.ref | 27 +++++++++++++++++----------
 4 files changed, 37 insertions(+), 27 deletions(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 19ee5eff4f..abf40be395 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -707,11 +707,7 @@ and fmt_attribute c ~key {attr_name; attr_payload; attr_loc} =
 and fmt_attributes_aux c ?pre ?suf ~key attrs =
   let num = List.length attrs in
   fmt_if_k (num > 0)
-    ( opt pre (function
-        (* Breaking before an attribute can confuse ocp-indent that will
-           produce a suboptimal indentation. *)
-        | Space when c.conf.fmt_opts.ocp_indent_compat.v -> sp Blank
-        | pre -> sp pre )
+    ( opt pre sp
     $ hvbox_if (num > 1) 0
         (hvbox 0 (list attrs "@ " (fmt_attribute c ~key)) $ opt suf str) )
 
diff --git a/test/passing/tests/js_source.ml.err b/test/passing/tests/js_source.ml.err
index 116078db31..3554838a4d 100644
--- a/test/passing/tests/js_source.ml.err
+++ b/test/passing/tests/js_source.ml.err
@@ -1,5 +1,5 @@
-Warning: tests/js_source.ml:155 exceeds the margin
-Warning: tests/js_source.ml:9515 exceeds the margin
-Warning: tests/js_source.ml:9618 exceeds the margin
-Warning: tests/js_source.ml:9677 exceeds the margin
-Warning: tests/js_source.ml:9759 exceeds the margin
+Warning: tests/js_source.ml:160 exceeds the margin
+Warning: tests/js_source.ml:9521 exceeds the margin
+Warning: tests/js_source.ml:9624 exceeds the margin
+Warning: tests/js_source.ml:9683 exceeds the margin
+Warning: tests/js_source.ml:9765 exceeds the margin
diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp
index e2e1b8707e..18ca0e7ef6 100644
--- a/test/passing/tests/js_source.ml.ocp
+++ b/test/passing/tests/js_source.ml.ocp
@@ -83,7 +83,8 @@ let () =
   and[@foo] y = 4 in
   [%foo
     (let module M = M in
-     ()) [@foo]];
+     ())
+    [@foo]];
   [%foo
     (let open M in
      ()) [@foo]];
@@ -98,18 +99,21 @@ let () =
   [%foo
     while () do
       ()
-    done [@foo]];
+    done
+    [@foo]];
   [%foo
     for x = () to () do
       ()
-    done [@foo]];
+    done
+               [@foo]];
   [%foo assert true [@foo]];
   [%foo lazy x [@foo]];
   [%foo object end [@foo]];
   [%foo
     begin
       3
-    end [@foo]];
+    end
+    [@foo]];
   [%foo new x [@foo]];
   [%foo
     match[@foo] () with
@@ -131,7 +135,8 @@ class x =
     method virtual x : t [@@foo]
     method! private x = 3 [@@foo]
     initializer x [@@foo]
-  end [@foo]
+  end
+  [@foo]
 
 (* Class type expressions *)
 class type t = object
@@ -9457,7 +9462,8 @@ fun contents -> { contents = contents [@foo] };;
 
 ();
 (();
- ()) [@foo]
+ ())
+[@foo]
 
 (* https://github.com/LexiFi/gen_js_api/issues/61 *)
 
@@ -9782,7 +9788,8 @@ let[@a
              and y = b in
              x + y]
              | _ -> .) ->
-    y [@attr
+    y
+    [@attr
        (* ... *)
       (* ... *)
       attr (* ... *)]
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index 702251d736..1b26a45a08 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -83,7 +83,8 @@ let () =
   and[@foo] y = 4 in
   [%foo
     (let module M = M in
-    ()) [@foo]];
+    ())
+    [@foo]];
   [%foo
     (let open M in
      ()) [@foo]];
@@ -98,18 +99,21 @@ let () =
   [%foo
     while () do
       ()
-    done [@foo]];
+    done
+    [@foo]];
   [%foo
     for x = () to () do
       ()
-    done [@foo]];
+    done
+    [@foo]];
   [%foo assert true [@foo]];
   [%foo lazy x [@foo]];
   [%foo object end [@foo]];
   [%foo
     begin
       3
-    end [@foo]];
+    end
+    [@foo]];
   [%foo new x [@foo]];
   [%foo
     match[@foo] () with
@@ -131,7 +135,8 @@ class x =
       method virtual x : t [@@foo]
       method! private x = 3 [@@foo]
       initializer x [@@foo]
-    end [@foo]
+    end
+    [@foo]
 
 (* Class type expressions *)
 class type t = object
@@ -9457,7 +9462,8 @@ fun contents -> { contents = contents [@foo] };;
 
 ();
 (();
- ()) [@foo]
+ ())
+[@foo]
 
 (* https://github.com/LexiFi/gen_js_api/issues/61 *)
 
@@ -9782,10 +9788,11 @@ let[@a
                          and y = b in
                          x + y]
              | _ -> .) ->
-    y [@attr
-        (* ... *)
-        (* ... *)
-        attr (* ... *)]
+    y
+    [@attr
+      (* ... *)
+      (* ... *)
+      attr (* ... *)]
 ;;
 
 let x =

From 9ef66c7ff4a26c9e6a9429ba1eec1c906f4f4f68 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Fri, 24 Mar 2023 19:18:13 +0100
Subject: [PATCH 036/115] ocp-indent-compat: Dock only one argument

ocp-indent aligns the signatures of subsequent docked arguments. When
there's more than one argument, switch to a vertical formatting.
---
 lib/Fmt_ast.ml                      |  10 +--
 lib/Params.ml                       |  13 +++-
 lib/Params.mli                      |   4 +-
 test/passing/tests/js_source.ml.err |  12 ++--
 test/passing/tests/js_source.ml.ocp |  36 ++++++----
 test/passing/tests/js_source.ml.ref | 104 +++++++++++++++-------------
 6 files changed, 102 insertions(+), 77 deletions(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 5315d04020..677c9bc946 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -3688,16 +3688,17 @@ and fmt_module c ctx ?ext ?epi ?(can_sparse = false) keyword ?(eqty = "=")
   let args_p = Params.Mod.get_args c.conf xargs in
   (* Carry the [epi] to be placed in the next argument's box. *)
   let fmt_arg ~pro {loc; txt} =
+    let pro = pro $ args_p.arg_psp in
     match txt with
-    | Unit -> (pro $ fmt "@ " $ Cmts.fmt c loc (str "()"), noop)
+    | Unit -> (pro $ Cmts.fmt c loc (str "()"), noop)
     | Named (name, mt) ->
         if args_p.dock then
           (* All signatures, put the [epi] into the box of the next arg and
              don't break. *)
-          fmt_name_and_mt ~pro:(pro $ str " ") ~loc name mt
+          fmt_name_and_mt ~pro ~loc name mt
         else
           let bdy, epi = fmt_name_and_mt ~pro:noop ~loc name mt in
-          (pro $ fmt "@;<1 4>" $ hvbox 0 bdy $ epi, noop)
+          (pro $ hvbox 0 bdy $ epi, noop)
   in
   let rec fmt_args ~pro = function
     | [] -> pro
@@ -3730,7 +3731,8 @@ and fmt_module c ctx ?ext ?epi ?(can_sparse = false) keyword ?(eqty = "=")
         ( (if Option.is_some blk_t.epi then hovbox else hvbox)
             0
             ( blk_box blk_t
-                ( hvbox 0 (fmt_args ~pro:intro xargs $ fmt_opt blk_t.pro)
+                ( hvbox args_p.indent
+                    (fmt_args ~pro:intro xargs $ fmt_opt blk_t.pro)
                 $ blk_t.psp $ blk_t.bdy )
             $ blk_t.esp $ fmt_opt blk_t.epi
             $ fmt_if (Option.is_some xbody) " ="
diff --git a/lib/Params.ml b/lib/Params.ml
index 316711b19a..1dbf78a83b 100644
--- a/lib/Params.ml
+++ b/lib/Params.ml
@@ -15,6 +15,8 @@ open Asttypes
 open Fmt
 open Ast
 
+let ocp c = c.Conf.fmt_opts.ocp_indent_compat.v
+
 let parens_if parens (c : Conf.t) ?(disambiguate = false) k =
   if disambiguate && c.fmt_opts.disambiguate_non_breaking_match.v then
     wrap_if_fits_or parens "(" ")" k
@@ -77,7 +79,7 @@ module Exp = struct
 end
 
 module Mod = struct
-  type args = {dock: bool}
+  type args = {dock: bool; arg_psp: Fmt.t; indent: int}
 
   let arg_is_sig arg =
     match arg.txt with
@@ -89,7 +91,14 @@ module Mod = struct
         true
     | _ -> false
 
-  let get_args (_c : Conf.t) args = {dock= List.for_all ~f:arg_is_sig args}
+  let get_args (c : Conf.t) args =
+    let indent, psp_indent = if ocp c then (2, 2) else (0, 4) in
+    let dock =
+      if ocp c then match args with [arg] -> arg_is_sig arg | _ -> false
+      else List.for_all ~f:arg_is_sig args
+    in
+    let arg_psp = if dock then str " " else break 1 psp_indent in
+    {dock; arg_psp; indent}
 end
 
 let get_or_pattern_sep ?(cmts_before = false) ?(space = false) (c : Conf.t)
diff --git a/lib/Params.mli b/lib/Params.mli
index 06d978448c..02946f6085 100644
--- a/lib/Params.mli
+++ b/lib/Params.mli
@@ -39,7 +39,9 @@ end
 
 module Mod : sig
   type args =
-    {dock: bool  (** Whether each argument [pro] should be docked. *)}
+    { dock: bool  (** Whether each argument [pro] should be docked. *)
+    ; arg_psp: Fmt.t  (** Break before every arguments. *)
+    ; indent: int }
 
   val get_args : Conf.t -> functor_parameter loc list -> args
 end
diff --git a/test/passing/tests/js_source.ml.err b/test/passing/tests/js_source.ml.err
index a077d23e33..83a27e9efe 100644
--- a/test/passing/tests/js_source.ml.err
+++ b/test/passing/tests/js_source.ml.err
@@ -1,7 +1,7 @@
 Warning: tests/js_source.ml:155 exceeds the margin
-Warning: tests/js_source.ml:3554 exceeds the margin
-Warning: tests/js_source.ml:9517 exceeds the margin
-Warning: tests/js_source.ml:9620 exceeds the margin
-Warning: tests/js_source.ml:9639 exceeds the margin
-Warning: tests/js_source.ml:9679 exceeds the margin
-Warning: tests/js_source.ml:9761 exceeds the margin
+Warning: tests/js_source.ml:3556 exceeds the margin
+Warning: tests/js_source.ml:9523 exceeds the margin
+Warning: tests/js_source.ml:9626 exceeds the margin
+Warning: tests/js_source.ml:9645 exceeds the margin
+Warning: tests/js_source.ml:9685 exceeds the margin
+Warning: tests/js_source.ml:9767 exceeds the margin
diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp
index 53bee59065..f9a41f0379 100644
--- a/test/passing/tests/js_source.ml.ocp
+++ b/test/passing/tests/js_source.ml.ocp
@@ -2605,11 +2605,13 @@ type (_, _) t =
   | A : ('a, 'a) t
   | B : string -> ('a, 'b) t
 
-module M (A : sig
-    module type T
-  end) (B : sig
-          module type T
-        end) =
+module M
+    (A : sig
+       module type T
+     end)
+    (B : sig
+       module type T
+     end) =
 struct
   let f : ((module A.T), (module B.T)) t -> string = function
     | B s -> s
@@ -4989,11 +4991,13 @@ let _ = f (module A_alias_expanded) (* ok *)
 let _ = f (module A_alias : S with type t = (module A.A_S)) (* doesn't type *)
 let _ = f (module A_alias) (* doesn't type either *)
 
-module Foo (Bar : sig
-    type a = private [> `A ]
-  end) (Baz : module type of struct
-          include Bar
-        end) =
+module Foo
+    (Bar : sig
+       type a = private [> `A ]
+     end)
+    (Baz : module type of struct
+       include Bar
+     end) =
 struct end
 
 module Bazoinks = struct
@@ -5591,11 +5595,13 @@ module M = struct
   type t = Y.t
 end
 
-module F (Y : sig
-    type t
-  end) (M : sig
-          type t = Y.t
-        end) =
+module F
+    (Y : sig
+       type t
+     end)
+    (M : sig
+       type t = Y.t
+     end) =
 struct end
 
 module G = F (M.Y)
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index 25138caf8f..5441e3af0e 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -2363,8 +2363,8 @@ let inlineseq_from_astseq seq =
 ;;
 
 module Add (T : sig
-  type two
-end) =
+    type two
+  end) =
 struct
   type _ t =
     | One : [ `One ] t
@@ -2449,8 +2449,8 @@ let example6 : type a. a wrapPoly -> a -> int =
 let _ = example6 (WrapPoly AandBTags) `TagB (* This causes a seg fault *)
 
 module F (S : sig
-  type 'a t
-end) =
+    type 'a t
+  end) =
 struct
   type _ ab =
     | A : int S.t ab
@@ -2464,8 +2464,8 @@ struct
 end
 
 module F (S : sig
-  type 'a t
-end) =
+    type 'a t
+  end) =
 struct
   type a = int * int
   type b = int -> int
@@ -2567,9 +2567,9 @@ let f : (int s, int t) eq -> unit = function
 ;;
 
 module M (S : sig
-  type 'a t = T of 'a
-  type 'a s = T of 'a
-end) =
+    type 'a t = T of 'a
+    type 'a s = T of 'a
+  end) =
 struct
   let f : ('a S.s, 'a S.t) eq -> unit = function
     | Refl -> ()
@@ -2605,11 +2605,13 @@ type (_, _) t =
   | A : ('a, 'a) t
   | B : string -> ('a, 'b) t
 
-module M (A : sig
-  module type T
-end) (B : sig
-  module type T
-end) =
+module M
+    (A : sig
+      module type T
+    end)
+    (B : sig
+      module type T
+    end) =
 struct
   let f : ((module A.T), (module B.T)) t -> string = function
     | B s -> s
@@ -2807,8 +2809,8 @@ let f (type a) (Neq n : (a, a t) eq) = n
 (* warn! *)
 
 module F (T : sig
-  type _ t
-end) =
+    type _ t
+  end) =
 struct
   let f (type a) (Neq n : (a, a T.t) eq) = n (* warn! *)
 end
@@ -4687,11 +4689,11 @@ let x = (3 : X2.F(DUMMY)(DUMMY).t)
 let x = (3 : X2.F(DUMMY)(DUMMY).t')
 
 module F (M : sig
-  type 'a t
-  type 'a u = string
+    type 'a t
+    type 'a u = string
 
-  val f : unit -> _ u t
-end) =
+    val f : unit -> _ u t
+  end) =
 struct
   let t = M.f ()
 end
@@ -4989,11 +4991,13 @@ let _ = f (module A_alias_expanded) (* ok *)
 let _ = f (module A_alias : S with type t = (module A.A_S)) (* doesn't type *)
 let _ = f (module A_alias) (* doesn't type either *)
 
-module Foo (Bar : sig
-  type a = private [> `A ]
-end) (Baz : module type of struct
-  include Bar
-end) =
+module Foo
+    (Bar : sig
+      type a = private [> `A ]
+    end)
+    (Baz : module type of struct
+      include Bar
+    end) =
 struct end
 
 module Bazoinks = struct
@@ -5008,8 +5012,8 @@ type (_, _) eq = Eq : ('a, 'a) eq
 let cast : type a b. (a, b) eq -> a -> b = fun Eq x -> x
 
 module Fix (F : sig
-  type 'a f
-end) =
+    type 'a f
+  end) =
 struct
   type 'a fix = ('a, 'a F.f) eq
 
@@ -5531,8 +5535,8 @@ C.one.Complex.re
 include C
 
 module F (X : sig
-  module C = Char
-end) =
+    module C = Char
+  end) =
 struct
   module C = X.C
 end
@@ -5591,11 +5595,13 @@ module M = struct
   type t = Y.t
 end
 
-module F (Y : sig
-  type t
-end) (M : sig
-  type t = Y.t
-end) =
+module F
+    (Y : sig
+      type t
+    end)
+    (M : sig
+      type t = Y.t
+    end) =
 struct end
 
 module G = F (M.Y)
@@ -6676,8 +6682,8 @@ class ['a] s3object r : ['a] s3 =
   end
 
 module M (T : sig
-  type t
-end) =
+    type t
+  end) =
 struct
   type t = private { t : T.t }
 end
@@ -7799,8 +7805,8 @@ and Coerce3 : sig end = struct end
 let _ = test 81 (Coerce2.f1 ()) 1
 
 module Coerce4 (A : sig
-  val f : int -> int
-end) =
+    val f : int -> int
+  end) =
 struct
   let x = 0
   let at a = A.f a
@@ -7847,8 +7853,8 @@ let _ =
 
 (* PR#4316 *)
 module G (S : sig
-  val x : int Lazy.t
-end) =
+    val x : int Lazy.t
+  end) =
 struct
   include S
 end
@@ -7941,8 +7947,8 @@ module type S = sig
 end
 
 module F (X : sig
-  val x : (module S)
-end) =
+    val x : (module S)
+  end) =
 struct
   module A = (val X.x)
 end
@@ -8291,11 +8297,11 @@ module M = struct
 end
 
 module type S = sig
-  module M : sig
-    type t
+    module M : sig
+      type t
+    end
   end
-end
-with module M = M
+  with module M = M
 
 module type Printable = sig
   type t
@@ -8368,9 +8374,9 @@ end
 module type S' = S with module T := M
 
 module type S = sig
-  type 'a t
-end
-with type 'a t := unit
+    type 'a t
+  end
+  with type 'a t := unit
 
 (* Fails *)
 let property (type t) () =

From 2564d7d239ae618be2851b96ac0922e56b3947bd Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Tue, 4 Apr 2023 11:40:11 +0200
Subject: [PATCH 037/115] cmt

---
 lib/Params.ml  | 2 ++
 lib/Params.mli | 2 +-
 2 files changed, 3 insertions(+), 1 deletion(-)

diff --git a/lib/Params.ml b/lib/Params.ml
index 1dbf78a83b..cdc02016b3 100644
--- a/lib/Params.ml
+++ b/lib/Params.ml
@@ -94,6 +94,8 @@ module Mod = struct
   let get_args (c : Conf.t) args =
     let indent, psp_indent = if ocp c then (2, 2) else (0, 4) in
     let dock =
+      (* ocp-indent-compat: Dock only one argument to avoid alignment of
+         subsequent arguments. *)
       if ocp c then match args with [arg] -> arg_is_sig arg | _ -> false
       else List.for_all ~f:arg_is_sig args
     in
diff --git a/lib/Params.mli b/lib/Params.mli
index 02946f6085..19838623e1 100644
--- a/lib/Params.mli
+++ b/lib/Params.mli
@@ -39,7 +39,7 @@ end
 
 module Mod : sig
   type args =
-    { dock: bool  (** Whether each argument [pro] should be docked. *)
+    { dock: bool  (** Whether each argument's [pro] should be docked. *)
     ; arg_psp: Fmt.t  (** Break before every arguments. *)
     ; indent: int }
 

From 37c452b0fcf3cf2e5caa61d8528b22545b7c48f8 Mon Sep 17 00:00:00 2001
From: Guillaume Petiot <guillaume@tarides.com>
Date: Tue, 4 Apr 2023 16:17:18 +0100
Subject: [PATCH 038/115] indent Pmod_extension

---
 lib/Fmt_ast.ml               | 4 +++-
 test/passing/tests/module.ml | 6 ++++++
 2 files changed, 9 insertions(+), 1 deletion(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 7dfb23092a..75ceca8a20 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -4120,7 +4120,9 @@ and fmt_module_expr ?(dock_struct = true) c ({ast= m; _} as xmod) =
             $ fmt_attributes_and_docstrings c pmod_attributes ) }
   | Pmod_extension x1 ->
       { empty with
-        bdy=
+        opn= Some (open_hvbox 2)
+      ; cls= close_box
+      ; bdy=
           Cmts.fmt c pmod_loc
             ( fmt_extension c ctx x1
             $ fmt_attributes_and_docstrings c pmod_attributes ) }
diff --git a/test/passing/tests/module.ml b/test/passing/tests/module.ml
index 1458c06e24..778a4ff22b 100644
--- a/test/passing/tests/module.ml
+++ b/test/passing/tests/module.ml
@@ -116,3 +116,9 @@ let _ =
         N with type t = t (* ff *) )
   in
   ()
+
+module M =
+  [%demo
+  module Foo = Bar
+
+  type t]

From ea447cf02ebbbb47e0203df63a981f659ccdff2d Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Thu, 6 Apr 2023 12:14:05 +0200
Subject: [PATCH 039/115] ocp-indent-compat: Align functor arguments on parens

---
 lib/Fmt_ast.ml                      |  9 ++++++---
 lib/Params.ml                       |  5 +++--
 lib/Params.mli                      |  5 ++++-
 test/passing/tests/js_source.ml.ref | 28 ++++++++++++++--------------
 4 files changed, 27 insertions(+), 20 deletions(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 81e8df8696..367b535ef5 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -3764,16 +3764,19 @@ and fmt_module c ctx ?rec_ ?ext ?epi ?(can_sparse = false) keyword
         ; psp= fmt_if (Option.is_none blk.pro) "@;<1 2>" $ blk.psp } )
   in
   let blk_b = Option.value_map xbody ~default:empty ~f:(fmt_module_expr c) in
+  let args_p = Params.Mod.get_args c.conf xargs in
   let fmt_name_and_mt ~pro ~loc name mt =
     let xmt = sub_mty ~ctx mt in
     let blk = fmt_module_type c ?rec_ xmt in
+    let align_opn, align_cls =
+      if args_p.arg_align then open_hvbox 0, close_box else noop, noop
+    in
     let pro =
-      pro $ Cmts.fmt_before c loc $ str "(" $ fmt_str_loc_opt c name
+      pro $ Cmts.fmt_before c loc $ str "(" $ align_opn $ fmt_str_loc_opt c name
       $ str " : "
-    and epi = str ")" $ Cmts.fmt_after c loc in
+    and epi = str ")" $ Cmts.fmt_after c loc $ align_cls in
     compose_module' ~box:false ~pro ~epi blk
   in
-  let args_p = Params.Mod.get_args c.conf xargs in
   (* Carry the [epi] to be placed in the next argument's box. *)
   let fmt_arg ~pro {loc; txt} =
     let pro = pro $ args_p.arg_psp in
diff --git a/lib/Params.ml b/lib/Params.ml
index 69290acf3a..be772252dc 100644
--- a/lib/Params.ml
+++ b/lib/Params.ml
@@ -93,7 +93,7 @@ module Exp = struct
 end
 
 module Mod = struct
-  type args = {dock: bool; arg_psp: Fmt.t; indent: int}
+  type args = {dock: bool; arg_psp: Fmt.t; indent: int; arg_align : bool}
 
   let arg_is_sig arg =
     match arg.txt with
@@ -114,7 +114,8 @@ module Mod = struct
       else List.for_all ~f:arg_is_sig args
     in
     let arg_psp = if dock then str " " else break 1 psp_indent in
-    {dock; arg_psp; indent}
+    let arg_align = not dock && ocp c in
+    {dock; arg_psp; indent;arg_align}
 end
 
 let get_or_pattern_sep ?(cmts_before = false) ?(space = false) (c : Conf.t)
diff --git a/lib/Params.mli b/lib/Params.mli
index 0a8f4c1e04..764f180c2f 100644
--- a/lib/Params.mli
+++ b/lib/Params.mli
@@ -41,7 +41,10 @@ module Mod : sig
   type args =
     { dock: bool  (** Whether each argument's [pro] should be docked. *)
     ; arg_psp: Fmt.t  (** Break before every arguments. *)
-    ; indent: int }
+    ; indent: int
+    ; arg_align: bool
+          (** Whether arguments should be aligned on opening parentheses *)
+    }
 
   val get_args : Conf.t -> functor_parameter loc list -> args
 end
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index e237923bcb..88b833a7b3 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -2612,11 +2612,11 @@ type (_, _) t =
 
 module M
     (A : sig
-      module type T
-    end)
+       module type T
+     end)
     (B : sig
-      module type T
-    end) =
+       module type T
+     end) =
 struct
   let f : ((module A.T), (module B.T)) t -> string = function
     | B s -> s
@@ -4750,8 +4750,8 @@ let flag = ref false
 
 module F
     (S : sig
-      module type T
-    end)
+       module type T
+     end)
     (A : S.T)
     (B : S.T) =
 struct
@@ -4998,11 +4998,11 @@ let _ = f (module A_alias) (* doesn't type either *)
 
 module Foo
     (Bar : sig
-      type a = private [> `A ]
-    end)
+       type a = private [> `A ]
+     end)
     (Baz : module type of struct
-      include Bar
-    end) =
+       include Bar
+     end) =
 struct end
 
 module Bazoinks = struct
@@ -5602,11 +5602,11 @@ end
 
 module F
     (Y : sig
-      type t
-    end)
+       type t
+     end)
     (M : sig
-      type t = Y.t
-    end) =
+       type t = Y.t
+     end) =
 struct end
 
 module G = F (M.Y)

From ca18b9c3203d448554ac547be5f460262d64ea15 Mon Sep 17 00:00:00 2001
From: Guillaume Petiot <guillaume@tarides.com>
Date: Thu, 6 Apr 2023 16:01:10 +0100
Subject: [PATCH 040/115] Indent extensions according to
 [stritem-]extension-indent

---
 lib/Fmt_ast.ml                               | 16 +++++++++++-----
 test/passing/tests/extensions-indent.ml.ref  | 14 +++++++-------
 test/passing/tests/extensions-indent.mli.ref |  4 ++--
 test/passing/tests/js_source.ml              |  6 ++++++
 test/passing/tests/js_source.ml.ocp          |  6 ++++++
 test/passing/tests/js_source.ml.ref          |  6 ++++++
 test/passing/tests/module.ml                 |  4 ++--
 7 files changed, 40 insertions(+), 16 deletions(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 6ba26815d3..fe38f8ac5e 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -559,11 +559,17 @@ let rec fmt_extension_aux c ctx ~key (ext, pld) =
     when Source.extension_using_sugar ~name:ext ~payload:ppat_loc ->
       fmt_pattern c ~ext (sub_pat ~ctx pat)
   | _ ->
-      wrap "[" "]"
-        ( str (Ext.Key.to_string key)
-        $ fmt_str_loc c ext
-        $ fmt_payload c (Pld pld) pld
-        $ fmt_if (Exposed.Right.payload pld) " " )
+      let indent =
+        match key with
+        | Regular -> c.conf.fmt_opts.extension_indent.v
+        | Item -> c.conf.fmt_opts.stritem_extension_indent.v
+      in
+      hvbox indent
+        (wrap "[" "]"
+           ( str (Ext.Key.to_string key)
+           $ fmt_str_loc c ext
+           $ fmt_payload c (Pld pld) pld
+           $ fmt_if (Exposed.Right.payload pld) " " ) )
 
 and fmt_extension = fmt_extension_aux ~key:Ext.Key.Regular
 
diff --git a/test/passing/tests/extensions-indent.ml.ref b/test/passing/tests/extensions-indent.ml.ref
index 7b730b8c8a..658d1f5819 100644
--- a/test/passing/tests/extensions-indent.ml.ref
+++ b/test/passing/tests/extensions-indent.ml.ref
@@ -51,21 +51,21 @@ let _ = ([%ext? (x : x)] : [%ext? (x : x)])
    11111111111111111111111 22222222222222222222222 33333333333333333333333]
 
 [%%ext
-11111111111111111111 ;;
+   11111111111111111111 ;;
 
-22222222222222222222]
+   22222222222222222222]
 
 [%%ext
-11111111111111111111 ;;
+   11111111111111111111 ;;
 
-22222222222222222222 ;;
+   22222222222222222222 ;;
 
-33333333333333333333]
+   33333333333333333333]
 
 [%%ext
-let foooooooooooooooo = foooo
+   let foooooooooooooooo = foooo
 
-let fooooooooooooooo = foo]
+   let fooooooooooooooo = foo]
 
 let _ = [%stri let [%p xxx] = fun (t : [%t tt]) (ut : [%t tt]) -> [%e xxx]]
 
diff --git a/test/passing/tests/extensions-indent.mli.ref b/test/passing/tests/extensions-indent.mli.ref
index 48d033c7c5..4a1a9291ff 100644
--- a/test/passing/tests/extensions-indent.mli.ref
+++ b/test/passing/tests/extensions-indent.mli.ref
@@ -22,9 +22,9 @@ type t =
      foooooooooooooooooooooooooooo]
 
 [%%ext
-val foooooooooooooooooooooo : fooooooooooo
+   val foooooooooooooooooooooo : fooooooooooo
 
-val fooooooooooooooooooooooooooo : fooooo]
+   val fooooooooooooooooooooooooooo : fooooo]
 
 exception%ext E
 
diff --git a/test/passing/tests/js_source.ml b/test/passing/tests/js_source.ml
index f1082f032a..3e11821158 100644
--- a/test/passing/tests/js_source.ml
+++ b/test/passing/tests/js_source.ml
@@ -7810,3 +7810,9 @@ include S1
 type input =
   { name: string
   ; action: [`Format | `Numeric of range] }
+
+module M =
+  [%demo
+    module Foo = Bar
+
+    type t]
diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp
index 8eb1d8cee7..7814060512 100644
--- a/test/passing/tests/js_source.ml.ocp
+++ b/test/passing/tests/js_source.ml.ocp
@@ -10053,3 +10053,9 @@ type input =
   { name : string
   ; action : [ `Format | `Numeric of range ]
   }
+
+module M =
+  [%demo
+    module Foo = Bar
+
+    type t]
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index 1db50c90db..e2f1cf8b1f 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -10053,3 +10053,9 @@ type input =
   { name : string
   ; action : [ `Format | `Numeric of range ]
   }
+
+module M =
+  [%demo
+    module Foo = Bar
+
+    type t]
diff --git a/test/passing/tests/module.ml b/test/passing/tests/module.ml
index 778a4ff22b..71ee16cfe1 100644
--- a/test/passing/tests/module.ml
+++ b/test/passing/tests/module.ml
@@ -119,6 +119,6 @@ let _ =
 
 module M =
   [%demo
-  module Foo = Bar
+    module Foo = Bar
 
-  type t]
+    type t]

From 5fca39af45d5e6d18899217cf5ea761b4d10ff95 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Thu, 6 Apr 2023 17:28:24 +0200
Subject: [PATCH 041/115] Detect contained structure items

---
 lib/Fmt_ast.ml                               |  7 +++---
 test/passing/tests/extensions-indent.ml.ref  | 10 ++++----
 test/passing/tests/extensions-indent.mli.ref |  8 +++----
 test/passing/tests/extensions.ml.ref         | 10 ++++----
 test/passing/tests/extensions.mli            |  8 +++----
 test/passing/tests/module.ml                 |  4 ++--
 test/passing/tests/source.ml.ref             | 24 ++++++++++----------
 7 files changed, 36 insertions(+), 35 deletions(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index fe38f8ac5e..90a9e2afb5 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -560,9 +560,10 @@ let rec fmt_extension_aux c ctx ~key (ext, pld) =
       fmt_pattern c ~ext (sub_pat ~ctx pat)
   | _ ->
       let indent =
-        match key with
-        | Regular -> c.conf.fmt_opts.extension_indent.v
-        | Item -> c.conf.fmt_opts.stritem_extension_indent.v
+        match pld with
+        | PStr [{pstr_desc= Pstr_eval _; _}] | PTyp _ | PPat _ ->
+            c.conf.fmt_opts.extension_indent.v
+        | PSig _ | PStr _ -> c.conf.fmt_opts.stritem_extension_indent.v
       in
       hvbox indent
         (wrap "[" "]"
diff --git a/test/passing/tests/extensions-indent.ml.ref b/test/passing/tests/extensions-indent.ml.ref
index 658d1f5819..0c890635d1 100644
--- a/test/passing/tests/extensions-indent.ml.ref
+++ b/test/passing/tests/extensions-indent.ml.ref
@@ -48,7 +48,7 @@ let _ = ([%ext? (x : x)] : [%ext? (x : x)])
 [%%ext 11111111111111111111]
 
 [%%ext
-   11111111111111111111111 22222222222222222222222 33333333333333333333333]
+     11111111111111111111111 22222222222222222222222 33333333333333333333333]
 
 [%%ext
    11111111111111111111 ;;
@@ -163,10 +163,10 @@ let foo =
        foooooooooooooooooooooooooooo]
 
 [%%foooooooooo:
-   fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo
-   foooooooooooooooooooooooooooooooooo
-   foooooooooooooooooooooooooooo
-   foooooooooooooooooooooooooooo]
+     fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo
+     foooooooooooooooooooooooooooooooooo
+     foooooooooooooooooooooooooooo
+     foooooooooooooooooooooooooooo]
 
 [@@@foooooooooo
    fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo
diff --git a/test/passing/tests/extensions-indent.mli.ref b/test/passing/tests/extensions-indent.mli.ref
index 4a1a9291ff..3cea1724a2 100644
--- a/test/passing/tests/extensions-indent.mli.ref
+++ b/test/passing/tests/extensions-indent.mli.ref
@@ -11,10 +11,10 @@ type t =
        foooooooooooooooooooooooooooo]
 
 [%%foooooooooo:
-   fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo
-   foooooooooooooooooooooooooooooooooo
-   foooooooooooooooooooooooooooo
-   foooooooooooooooooooooooooooo]
+     fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo
+     foooooooooooooooooooooooooooooooooo
+     foooooooooooooooooooooooooooo
+     foooooooooooooooooooooooooooo]
 
 [@@@foooooooooo
    fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo
diff --git a/test/passing/tests/extensions.ml.ref b/test/passing/tests/extensions.ml.ref
index 3dbe10d019..aaf04f9dd6 100644
--- a/test/passing/tests/extensions.ml.ref
+++ b/test/passing/tests/extensions.ml.ref
@@ -48,7 +48,7 @@ let _ = ([%ext? (x : x)] : [%ext? (x : x)])
 [%%ext 11111111111111111111]
 
 [%%ext
-11111111111111111111111 22222222222222222222222 33333333333333333333333]
+  11111111111111111111111 22222222222222222222222 33333333333333333333333]
 
 [%%ext
 11111111111111111111 ;;
@@ -163,10 +163,10 @@ let foo =
     foooooooooooooooooooooooooooo]
 
 [%%foooooooooo:
-fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo
-foooooooooooooooooooooooooooooooooo
-foooooooooooooooooooooooooooo
-foooooooooooooooooooooooooooo]
+  fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo
+  foooooooooooooooooooooooooooooooooo
+  foooooooooooooooooooooooooooo
+  foooooooooooooooooooooooooooo]
 
 [@@@foooooooooo
 fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo
diff --git a/test/passing/tests/extensions.mli b/test/passing/tests/extensions.mli
index de0865db65..8bedbe65df 100644
--- a/test/passing/tests/extensions.mli
+++ b/test/passing/tests/extensions.mli
@@ -11,10 +11,10 @@ type t =
     foooooooooooooooooooooooooooo]
 
 [%%foooooooooo:
-fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo
-foooooooooooooooooooooooooooooooooo
-foooooooooooooooooooooooooooo
-foooooooooooooooooooooooooooo]
+  fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo
+  foooooooooooooooooooooooooooooooooo
+  foooooooooooooooooooooooooooo
+  foooooooooooooooooooooooooooo]
 
 [@@@foooooooooo
 fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo
diff --git a/test/passing/tests/module.ml b/test/passing/tests/module.ml
index 71ee16cfe1..778a4ff22b 100644
--- a/test/passing/tests/module.ml
+++ b/test/passing/tests/module.ml
@@ -119,6 +119,6 @@ let _ =
 
 module M =
   [%demo
-    module Foo = Bar
+  module Foo = Bar
 
-    type t]
+  type t]
diff --git a/test/passing/tests/source.ml.ref b/test/passing/tests/source.ml.ref
index dec12fcfb8..b53f7af68a 100644
--- a/test/passing/tests/source.ml.ref
+++ b/test/passing/tests/source.ml.ref
@@ -36,8 +36,8 @@ type obj =
 type var = [`Foo  (** foo *) | `Bar of int * string  (** bar *)]
 
 [%%foo
-let x = 1 in
-x]
+  let x = 1 in
+  x]
 
 let ([%foo 2 + 1] : [%foo bar.baz]) = [%foo "foo"]
 
@@ -59,9 +59,9 @@ let ([%foo? Bar x | Baz x] : [%foo? #bar]) = [%foo? {x}]
 
 let ([%foo: include S with type t = t] :
       [%foo:
-        val x : t
+      val x : t
 
-        val y : t] ) =
+      val y : t] ) =
   [%foo: type t = t]
 
 let int_with_custom_modifier =
@@ -2942,7 +2942,7 @@ end
 module F (M : S) : S = M
 
 [%%expect
-{|
+  {|
 module type S = sig type t [@@immediate] end
 module F : functor (M : S) -> S
 |}]
@@ -2966,7 +2966,7 @@ module A = struct
 end
 
 [%%expect
-{|
+  {|
 module A :
   sig
     type t [@@immediate]
@@ -2991,7 +2991,7 @@ module Z : sig
 end = (Y : X with type t = int )
 
 [%%expect
-{|
+  {|
 module type X = sig type t end
 module Y : sig type t = int end
 module Z : sig type t [@@immediate] end
@@ -3079,7 +3079,7 @@ module B = struct
 end
 
 [%%expect
-{|
+  {|
 Line _, characters 2-31:
 Error: Types marked with the immediate attribute must be
        non-pointer types like int or bool
@@ -3093,7 +3093,7 @@ module C = struct
 end
 
 [%%expect
-{|
+  {|
 Line _, characters 2-26:
 Error: Types marked with the immediate attribute must be
        non-pointer types like int or bool
@@ -3107,7 +3107,7 @@ end = struct
 end
 
 [%%expect
-{|
+  {|
 Line _, characters 42-70:
 Error: Signature mismatch:
        Modules do not match:
@@ -3131,7 +3131,7 @@ module FM_invalid = F (struct
 end)
 
 [%%expect
-{|
+  {|
 Line _, characters 23-49:
 Error: Signature mismatch:
        Modules do not match: sig type t = string end is not included in S
@@ -3150,7 +3150,7 @@ module E = struct
 end
 
 [%%expect
-{|
+  {|
 Line _, characters 2-26:
 Error: Types marked with the immediate attribute must be
        non-pointer types like int or bool

From 31a557a2346177799b597adce93578217891d11b Mon Sep 17 00:00:00 2001
From: Guillaume Petiot <guillaume@tarides.com>
Date: Tue, 11 Apr 2023 10:49:45 +0100
Subject: [PATCH 042/115] Reformat

---
 lib/Fmt_ast.ml | 6 +++---
 lib/Params.ml  | 6 +++---
 2 files changed, 6 insertions(+), 6 deletions(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 0b456b3e6f..92fdd7adef 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -3781,11 +3781,11 @@ and fmt_module c ctx ?rec_ ?ext ?epi ?(can_sparse = false) keyword
     let xmt = sub_mty ~ctx mt in
     let blk = fmt_module_type c ?rec_ xmt in
     let align_opn, align_cls =
-      if args_p.arg_align then open_hvbox 0, close_box else noop, noop
+      if args_p.arg_align then (open_hvbox 0, close_box) else (noop, noop)
     in
     let pro =
-      pro $ Cmts.fmt_before c loc $ str "(" $ align_opn $ fmt_str_loc_opt c name
-      $ str " : "
+      pro $ Cmts.fmt_before c loc $ str "(" $ align_opn
+      $ fmt_str_loc_opt c name $ str " : "
     and epi = str ")" $ Cmts.fmt_after c loc $ align_cls in
     compose_module' ~box:false ~pro ~epi blk
   in
diff --git a/lib/Params.ml b/lib/Params.ml
index be772252dc..224d674ad1 100644
--- a/lib/Params.ml
+++ b/lib/Params.ml
@@ -93,7 +93,7 @@ module Exp = struct
 end
 
 module Mod = struct
-  type args = {dock: bool; arg_psp: Fmt.t; indent: int; arg_align : bool}
+  type args = {dock: bool; arg_psp: Fmt.t; indent: int; arg_align: bool}
 
   let arg_is_sig arg =
     match arg.txt with
@@ -114,8 +114,8 @@ module Mod = struct
       else List.for_all ~f:arg_is_sig args
     in
     let arg_psp = if dock then str " " else break 1 psp_indent in
-    let arg_align = not dock && ocp c in
-    {dock; arg_psp; indent;arg_align}
+    let arg_align = (not dock) && ocp c in
+    {dock; arg_psp; indent; arg_align}
 end
 
 let get_or_pattern_sep ?(cmts_before = false) ?(space = false) (c : Conf.t)

From 439dd0e09d9ee22105b5c97def4fb54b584eed89 Mon Sep 17 00:00:00 2001
From: Guillaume Petiot <guillaume@tarides.com>
Date: Tue, 11 Apr 2023 10:54:05 +0100
Subject: [PATCH 043/115] ocp-indent: adjust indentation of Pexp_fun body and
 arguments

---
 lib/Fmt_ast.ml                      | 18 ++++++++++--------
 lib/Params.ml                       |  8 ++++++++
 lib/Params.mli                      |  4 ++++
 test/passing/tests/js_source.ml     |  9 +++++++++
 test/passing/tests/js_source.ml.ocp |  8 ++++++++
 test/passing/tests/js_source.ml.ref |  8 ++++++++
 6 files changed, 47 insertions(+), 8 deletions(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 92fdd7adef..90a644fc6f 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -170,7 +170,7 @@ end
 module Box = struct
   let _ocp a b c k = if c.conf.fmt_opts.ocp_indent_compat.v then a k else b k
 
-  let fun_decl = _ocp (hvbox 2) (hovbox 4)
+  let fun_decl ~parens = _ocp (hvbox (if parens then 1 else 2)) (hovbox 4)
 
   let fun_args c k =
     hvbox_if
@@ -2204,19 +2204,21 @@ and fmt_expression c ?(box = true) ?pro ?epi ?eol ?parens ?(indent_wrap = 0)
         match xbody.ast.pexp_desc with Pexp_function _ -> true | _ -> false
       in
       let pre_body, body = fmt_body c ?ext xbody in
-      let default_indent =
-        if Option.is_none eol then 2
-        else if c.conf.fmt_opts.let_binding_deindent_fun.v then 1
-        else 0
-      in
       let indent =
-        Params.function_indent c.conf ~parens ~xexp ~default:default_indent
+        if body_is_function then
+          let default_indent =
+            if Option.is_none eol then 2
+            else if c.conf.fmt_opts.let_binding_deindent_fun.v then 1
+            else 0
+          in
+          Params.function_indent c.conf ~parens ~xexp ~default:default_indent
+        else Params.fun_indent c.conf ?eol
       in
       hvbox_if (box || body_is_function) indent
         (Params.Exp.wrap c.conf ~parens ~disambiguate:true ~fits_breaks:false
            ~offset_closing_paren:(-2)
            ( hovbox 2
-               ( Box.fun_decl c
+               ( Box.fun_decl ~parens c
                    ( str "fun"
                    $ fmt_extension_suffix c ext
                    $ str " "
diff --git a/lib/Params.ml b/lib/Params.ml
index 224d674ad1..7bde5de6b5 100644
--- a/lib/Params.ml
+++ b/lib/Params.ml
@@ -590,6 +590,14 @@ let function_indent ?(default = 0) (c : Conf.t) ~parens ~xexp =
       default + 1
   | _ -> default
 
+let fun_indent ?eol (c : Conf.t) =
+  match c.fmt_opts.function_indent_nested.v with
+  | `Always -> c.fmt_opts.function_indent.v
+  | _ ->
+      if Option.is_none eol then 2
+      else if c.fmt_opts.let_binding_deindent_fun.v then 1
+      else 0
+
 let comma_sep (c : Conf.t) : Fmt.s =
   match c.fmt_opts.break_separators.v with
   | `Before -> "@,, "
diff --git a/lib/Params.mli b/lib/Params.mli
index 764f180c2f..d63feb5af6 100644
--- a/lib/Params.mli
+++ b/lib/Params.mli
@@ -152,6 +152,10 @@ val function_indent :
     option, or using the [default] indentation (0 if not provided) if the
     option does not apply. *)
 
+val fun_indent : ?eol:Fmt.t -> Conf.t -> int
+(** [fun_undent ?eol c] returns the indentation used for the function,
+    depending on the `function-indent-nested` option. *)
+
 val comma_sep : Conf.t -> Fmt.s
 (** [comma_sep c] returns the format string used to separate two elements
     with a comma, depending on the `break-separators` option. *)
diff --git a/test/passing/tests/js_source.ml b/test/passing/tests/js_source.ml
index 207dd5b17d..1ab59b97b2 100644
--- a/test/passing/tests/js_source.ml
+++ b/test/passing/tests/js_source.ml
@@ -7978,3 +7978,12 @@ module M =
     module Foo = Bar
 
     type t]
+;;
+
+let _ =
+  Some
+    (fun fooooooooooooooooooooooooooooooo
+        fooooooooooooooooooooooooooooooo
+        fooooooooooooooooooooooooooooooo ->
+        foo)
+;;
diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp
index ef9273e183..2cb7d386c8 100644
--- a/test/passing/tests/js_source.ml.ocp
+++ b/test/passing/tests/js_source.ml.ocp
@@ -10251,3 +10251,11 @@ module M =
     module Foo = Bar
 
     type t]
+
+let _ =
+  Some
+    (fun fooooooooooooooooooooooooooooooo
+      fooooooooooooooooooooooooooooooo
+      fooooooooooooooooooooooooooooooo ->
+      foo)
+;;
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index 7adcaaf31b..7462c421c8 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -10251,3 +10251,11 @@ module M =
     module Foo = Bar
 
     type t]
+
+let _ =
+  Some
+    (fun fooooooooooooooooooooooooooooooo
+      fooooooooooooooooooooooooooooooo
+      fooooooooooooooooooooooooooooooo ->
+      foo)
+;;

From 8e59d82232a7766208e8cb960e2c766108b3c05f Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Tue, 18 Apr 2023 15:02:32 +0200
Subject: [PATCH 044/115] Add failing test

---
 .../passing/tests/doc_comments-no-parse-docstrings.mli.ref | 7 +++++++
 test/passing/tests/doc_comments.mli                        | 7 +++++++
 2 files changed, 14 insertions(+)

diff --git a/test/passing/tests/doc_comments-no-parse-docstrings.mli.ref b/test/passing/tests/doc_comments-no-parse-docstrings.mli.ref
index df46bac62a..b0075f852f 100644
--- a/test/passing/tests/doc_comments-no-parse-docstrings.mli.ref
+++ b/test/passing/tests/doc_comments-no-parse-docstrings.mli.ref
@@ -620,3 +620,10 @@ type x =
     \,d\xi
     }
 *)
+
+(** {[
+     let _ = {|
+        Doc-comment contains code blocks that contains string with breaks and
+        ending with trailing spaces.
+       |}
+   ]} *)
diff --git a/test/passing/tests/doc_comments.mli b/test/passing/tests/doc_comments.mli
index 6eafc5f6de..85e68981e5 100644
--- a/test/passing/tests/doc_comments.mli
+++ b/test/passing/tests/doc_comments.mli
@@ -628,3 +628,10 @@ type x =
     \,d\xi
     }
 *)
+
+(** {[
+     let _ = {|
+        Doc-comment contains code blocks that contains string with breaks and
+        ending with trailing spaces.
+       |}
+   ]} *)

From 688e6f826516e786b94f2e1182a68ab2b53d638b Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Tue, 18 Apr 2023 15:45:58 +0200
Subject: [PATCH 045/115] Define 'fmt_code' type

---
 lib/Cmts.ml      |  4 ++--
 lib/Cmts.mli     | 18 +++++-------------
 lib/Fmt.ml       |  2 --
 lib/Fmt.mli      |  2 --
 lib/Fmt_ast.ml   | 12 +++++-------
 lib/Fmt_odoc.ml  |  6 ++++--
 lib/Fmt_odoc.mli |  7 ++++---
 7 files changed, 20 insertions(+), 31 deletions(-)

diff --git a/lib/Cmts.ml b/lib/Cmts.ml
index ecf9339357..1dc8b21dab 100644
--- a/lib/Cmts.ml
+++ b/lib/Cmts.ml
@@ -605,7 +605,7 @@ let fmt_cmt (conf : Conf.t) (cmt : Cmt.t) ~fmt_code pos =
         let cls : Fmt.s = if dollar_suf then "$*)" else "*)" in
         let len = String.length str - if dollar_suf then 2 else 1 in
         let source = String.sub ~pos:1 ~len str in
-        match fmt_code source with
+        match fmt_code conf source with
         | Ok formatted -> `Code (formatted, cls)
         | Error (`Msg _) -> `Unwrapped (cmt, None) )
     | str when Char.equal str.[0] '=' -> `Verbatim cmt.txt
@@ -648,7 +648,7 @@ let fmt_cmts_aux t (conf : Conf.t) cmts ~fmt_code pos =
     (list_pn groups (fun ~prev:_ group ~next ->
          ( match group with
          | [] -> impossible "previous match"
-         | [cmt] -> fmt_cmt conf cmt ~fmt_code:(fmt_code conf) pos
+         | [cmt] -> fmt_cmt conf cmt ~fmt_code pos
          | group ->
              list group "@;<1000 0>" (fun cmt ->
                  wrap "(*" "*)" (str (Cmt.txt cmt)) ) )
diff --git a/lib/Cmts.mli b/lib/Cmts.mli
index cedccdf5b0..be1a9da4bb 100644
--- a/lib/Cmts.mli
+++ b/lib/Cmts.mli
@@ -47,7 +47,7 @@ val relocate_wrongfully_attached_cmts :
 val fmt_before :
      t
   -> Conf.t
-  -> fmt_code:(Conf.t -> Fmt.code_formatter)
+  -> fmt_code:Fmt_odoc.fmt_code
   -> ?pro:Fmt.t
   -> ?epi:Fmt.t
   -> ?eol:Fmt.t
@@ -60,7 +60,7 @@ val fmt_before :
 val fmt_after :
      t
   -> Conf.t
-  -> fmt_code:(Conf.t -> Fmt.code_formatter)
+  -> fmt_code:Fmt_odoc.fmt_code
   -> ?pro:Fmt.t
   -> ?epi:Fmt.t
   -> ?filter:(Cmt.t -> bool)
@@ -72,7 +72,7 @@ val fmt_after :
 val fmt_within :
      t
   -> Conf.t
-  -> fmt_code:(Conf.t -> Fmt.code_formatter)
+  -> fmt_code:Fmt_odoc.fmt_code
   -> ?pro:Fmt.t
   -> ?epi:Fmt.t
   -> Location.t
@@ -82,20 +82,12 @@ val fmt_within :
 
 module Toplevel : sig
   val fmt_before :
-       t
-    -> Conf.t
-    -> fmt_code:(Conf.t -> Fmt.code_formatter)
-    -> Location.t
-    -> Fmt.t
+    t -> Conf.t -> fmt_code:Fmt_odoc.fmt_code -> Location.t -> Fmt.t
   (** [fmt_before loc] formats the comments associated with [loc] that appear
       before [loc]. *)
 
   val fmt_after :
-       t
-    -> Conf.t
-    -> fmt_code:(Conf.t -> Fmt.code_formatter)
-    -> Location.t
-    -> Fmt.t
+    t -> Conf.t -> fmt_code:Fmt_odoc.fmt_code -> Location.t -> Fmt.t
   (** [fmt_after loc] formats the comments associated with [loc] that appear
       after [loc]. *)
 end
diff --git a/lib/Fmt.ml b/lib/Fmt.ml
index b7a236f59c..e7b0d818f0 100644
--- a/lib/Fmt.ml
+++ b/lib/Fmt.ml
@@ -355,5 +355,3 @@ let fill_text ?(epi = "") text =
                | Some _ when not (String.is_empty curr) -> fmt "@ "
                | _ -> noop )
          $ str epi ) )
-
-type code_formatter = string -> t or_error
diff --git a/lib/Fmt.mli b/lib/Fmt.mli
index 736b6d17ec..ff607bbf0e 100644
--- a/lib/Fmt.mli
+++ b/lib/Fmt.mli
@@ -223,5 +223,3 @@ val hovbox_if : ?name:string -> bool -> int -> t -> t
 
 val fill_text : ?epi:string -> string -> t
 (** Format a non-empty string as filled text wrapped at the margin. *)
-
-type code_formatter = string -> t or_error
diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 5dc21c534b..25d20d1756 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -22,7 +22,7 @@ type c =
   ; debug: bool
   ; source: Source.t
   ; cmts: Cmts.t
-  ; fmt_code: Conf.t -> Fmt.code_formatter }
+  ; fmt_code: Fmt_odoc.fmt_code }
 
 module Cmts = struct
   include Cmts
@@ -388,10 +388,9 @@ let virtual_or_override = function
   | Cfk_concrete (Override, _) -> str "!"
   | Cfk_concrete (Fresh, _) -> noop
 
-let fmt_parsed_docstring c ~loc ?pro ~epi str_cmt parsed =
-  assert (not (String.is_empty str_cmt)) ;
-  let fmt_code = c.fmt_code c.conf in
-  let doc = Fmt_odoc.fmt_parsed c.conf ~fmt_code ~input:str_cmt parsed in
+let fmt_parsed_docstring c ~loc ?pro ~epi input parsed =
+  assert (not (String.is_empty input)) ;
+  let doc = Fmt_odoc.fmt_parsed c.conf ~fmt_code:c.fmt_code ~input parsed in
   Cmts.fmt c loc
   @@ vbox_if (Option.is_none pro) 0 (fmt_opt pro $ wrap "(**" "*)" doc $ epi)
 
@@ -4472,8 +4471,7 @@ let fmt_file (type a) ~ctx ~fmt_code ~debug (fragment : a Extended_ast.t)
   | Expression, e ->
       fmt_expression c (sub_exp ~ctx:(Str (Ast_helper.Str.eval e)) e)
   | Repl_file, l -> fmt_repl_file c ctx l
-  | Documentation, d ->
-      Fmt_odoc.fmt_ast c.conf ~fmt_code:(c.fmt_code c.conf) d
+  | Documentation, d -> Fmt_odoc.fmt_ast c.conf ~fmt_code:c.fmt_code d
 
 let fmt_parse_result conf ~debug ast_kind ast source comments ~fmt_code =
   let cmts = Cmts.init ast_kind ~debug source ast comments in
diff --git a/lib/Fmt_odoc.ml b/lib/Fmt_odoc.ml
index 1896d3b236..2aca0a58f7 100644
--- a/lib/Fmt_odoc.ml
+++ b/lib/Fmt_odoc.ml
@@ -13,7 +13,9 @@ open Fmt
 open Odoc_parser.Ast
 module Loc = Odoc_parser.Loc
 
-type c = {fmt_code: Fmt.code_formatter; conf: Conf.t}
+type fmt_code = Conf.t -> string -> Fmt.t or_error
+
+type c = {fmt_code: fmt_code; conf: Conf.t}
 
 (** Escape characters if they are not already escaped. [escapeworthy] should
     be [true] if the character should be escaped, [false] otherwise. *)
@@ -91,7 +93,7 @@ let fmt_code_block c s1 s2 =
   let Odoc_parser.Loc.{location; value} = s2 in
   match s1 with
   | Some ({value= "ocaml"; _}, _) | None -> (
-    match c.fmt_code value with
+    match c.fmt_code c.conf value with
     | Ok formatted -> hvbox 0 (wrap_code formatted)
     | Error (`Msg message) ->
         ( match message with
diff --git a/lib/Fmt_odoc.mli b/lib/Fmt_odoc.mli
index 46b47356a3..02d0ff9080 100644
--- a/lib/Fmt_odoc.mli
+++ b/lib/Fmt_odoc.mli
@@ -9,12 +9,13 @@
 (*                                                                        *)
 (**************************************************************************)
 
-val fmt_ast :
-  Conf.t -> fmt_code:Fmt.code_formatter -> Odoc_parser.Ast.t -> Fmt.t
+type fmt_code = Conf.t -> string -> Fmt.t or_error
+
+val fmt_ast : Conf.t -> fmt_code:fmt_code -> Odoc_parser.Ast.t -> Fmt.t
 
 val fmt_parsed :
      Conf.t
-  -> fmt_code:Fmt.code_formatter
+  -> fmt_code:fmt_code
   -> input:string
   -> (Odoc_parser.Ast.t, Odoc_parser.Warning.t list) Result.t
   -> Fmt.t

From 5b1d50b019a83010d8fcfc62c97b0bc7ea1dbe78 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Wed, 19 Apr 2023 11:31:59 +0200
Subject: [PATCH 046/115] Staged formatting of code blocks

This fixes "comment changed" issues due to string literals.

String literals that contain breaks must not be indented relative to the
containing box and use forced line breaks to ensure the string stays
equal.

Code blocks are evaluated before being inserted into the parent document
in order to be indented without changing string literals.

The margin have to be adjusted while formatting the code blocks.

The code block added to the test previously formatted to:

    (** {[
          let _ =
            {|
       Doc-comment contains code blocks that contains string with breaks and
       ending with trailing spaces.
      |}
        ]} *)

Which changed the string to start with 1 space instead of 3 and ending
with none instead of 2.
---
 lib/Cmts.ml                                   | 12 ++++---
 lib/Fmt_ast.ml                                | 22 ++++++++++---
 lib/Fmt_odoc.ml                               | 31 +++++++++++--------
 lib/Fmt_odoc.mli                              |  5 ++-
 test/passing/tests/crlf_to_crlf.ml.ref        |  3 +-
 test/passing/tests/crlf_to_lf.ml.ref          |  3 +-
 .../tests/doc_comments-no-wrap.mli.err        | 21 +++++++------
 .../tests/doc_comments-no-wrap.mli.ref        | 11 ++++++-
 test/passing/tests/doc_comments.mli.err       | 21 +++++++------
 test/passing/tests/doc_comments.mli.ref       | 11 ++++++-
 10 files changed, 93 insertions(+), 47 deletions(-)

diff --git a/lib/Cmts.ml b/lib/Cmts.ml
index 1dc8b21dab..ab5e8dc53b 100644
--- a/lib/Cmts.ml
+++ b/lib/Cmts.ml
@@ -563,7 +563,7 @@ module Verbatim = struct
 end
 
 module Ocp_indent_compat = struct
-  let fmt ~fmt_code conf (cmt : Cmt.t) (pos : Cmt.pos) ~post =
+  let fmt ~fmt_code conf (cmt : Cmt.t) ~offset (pos : Cmt.pos) ~post =
     let pre, doc, post =
       let lines = String.split_lines cmt.txt in
       match lines with
@@ -578,7 +578,7 @@ module Ocp_indent_compat = struct
     (* Disable warnings when parsing fails *)
     let quiet = Conf_t.Elt.make true `Default in
     let conf = {conf with Conf.opr_opts= {conf.Conf.opr_opts with quiet}} in
-    let doc = Fmt_odoc.fmt_parsed conf ~fmt_code ~input:doc parsed in
+    let doc = Fmt_odoc.fmt_parsed conf ~fmt_code ~input:doc ~offset parsed in
     let open Fmt in
     fmt_if_k
       (Poly.(pos = After) && String.contains cmt.txt '\n')
@@ -605,7 +605,7 @@ let fmt_cmt (conf : Conf.t) (cmt : Cmt.t) ~fmt_code pos =
         let cls : Fmt.s = if dollar_suf then "$*)" else "*)" in
         let len = String.length str - if dollar_suf then 2 else 1 in
         let source = String.sub ~pos:1 ~len str in
-        match fmt_code conf source with
+        match fmt_code conf ~offset:4 source with
         | Ok formatted -> `Code (formatted, cls)
         | Error (`Msg _) -> `Unwrapped (cmt, None) )
     | str when Char.equal str.[0] '=' -> `Verbatim cmt.txt
@@ -631,10 +631,12 @@ let fmt_cmt (conf : Conf.t) (cmt : Cmt.t) ~fmt_code pos =
   let open Fmt in
   match mode with
   | `Verbatim x -> Verbatim.fmt x pos
-  | `Code (x, cls) -> hvbox 2 @@ wrap "(*$@;" cls (x $ fmt "@;<1 -2>")
+  | `Code (x, cls) ->
+      hvbox 2 @@ wrap "(*$@;" cls (Verbatim.fmt x pos $ fmt "@;<1 -2>")
   | `Wrapped (x, epi) -> str "(*" $ fill_text x ~epi
   | `Unwrapped (x, ln) when conf.fmt_opts.ocp_indent_compat.v ->
-      Ocp_indent_compat.fmt ~fmt_code conf x pos ~post:ln
+      (* TODO: [offset] should be computed from location. *)
+      Ocp_indent_compat.fmt ~fmt_code conf x ~offset:2 pos ~post:ln
   | `Unwrapped (x, _) -> Unwrapped.fmt x
   | `Asterisk_prefixed x -> Asterisk_prefixed.fmt x
 
diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 25d20d1756..ca8e773929 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -390,7 +390,11 @@ let virtual_or_override = function
 
 let fmt_parsed_docstring c ~loc ?pro ~epi input parsed =
   assert (not (String.is_empty input)) ;
-  let doc = Fmt_odoc.fmt_parsed c.conf ~fmt_code:c.fmt_code ~input parsed in
+  let offset =
+    let pos = loc.Location.loc_start in
+    pos.pos_cnum - pos.pos_bol + 3
+  and fmt_code = c.fmt_code in
+  let doc = Fmt_odoc.fmt_parsed c.conf ~fmt_code ~offset ~input parsed in
   Cmts.fmt c loc
   @@ vbox_if (Option.is_none pro) 0 (fmt_opt pro $ wrap "(**" "*)" doc $ epi)
 
@@ -4476,11 +4480,21 @@ let fmt_file (type a) ~ctx ~fmt_code ~debug (fragment : a Extended_ast.t)
 let fmt_parse_result conf ~debug ast_kind ast source comments ~fmt_code =
   let cmts = Cmts.init ast_kind ~debug source ast comments in
   let ctx = Top in
-  Ok (fmt_file ~ctx ~debug ast_kind source cmts conf ast ~fmt_code)
+  let code =
+    set_margin conf.Conf.fmt_opts.margin.v
+    $ fmt_file ~ctx ~debug ast_kind source cmts conf ast ~fmt_code
+  in
+  Ok (Format_.asprintf "%a" Fmt.eval code)
 
 let fmt_code ~debug =
-  let rec fmt_code (conf : Conf.t) s =
-    let warn = conf.fmt_opts.parse_toplevel_phrases.v in
+  let rec fmt_code (conf : Conf.t) ~offset s =
+    let {Conf.fmt_opts; _} = conf in
+    let conf =
+      (* Adjust margin according to [offset]. *)
+      let margin = {fmt_opts.margin with v= fmt_opts.margin.v - offset} in
+      {conf with fmt_opts= {fmt_opts with margin}}
+    in
+    let warn = fmt_opts.parse_toplevel_phrases.v in
     let input_name = !Location.input_name in
     match Parse_with_comments.parse_toplevel conf ~input_name ~source:s with
     | Either.First {ast; comments; source; prefix= _} ->
diff --git a/lib/Fmt_odoc.ml b/lib/Fmt_odoc.ml
index 2aca0a58f7..c744da9d41 100644
--- a/lib/Fmt_odoc.ml
+++ b/lib/Fmt_odoc.ml
@@ -13,7 +13,7 @@ open Fmt
 open Odoc_parser.Ast
 module Loc = Odoc_parser.Loc
 
-type fmt_code = Conf.t -> string -> Fmt.t or_error
+type fmt_code = Conf.t -> offset:int -> string -> string or_error
 
 type c = {fmt_code: fmt_code; conf: Conf.t}
 
@@ -85,16 +85,17 @@ let fmt_code_block c s1 s2 =
     else if String.length l = 0 then str "\n"
     else fmt "@," $ str l
   in
-  let fmt_no_code s =
+  let fmt_code s =
     let lines = String.split_lines s in
     let box = match lines with _ :: _ :: _ -> vbox 0 | _ -> hvbox 0 in
     box (wrap_code (vbox 0 (list_fl lines fmt_line)))
   in
-  let Odoc_parser.Loc.{location; value} = s2 in
+  let Odoc_parser.Loc.{location; value= original} = s2 in
   match s1 with
   | Some ({value= "ocaml"; _}, _) | None -> (
-    match c.fmt_code c.conf value with
-    | Ok formatted -> hvbox 0 (wrap_code formatted)
+    (* [offset] doesn't take into account code blocks nested into lists. *)
+    match c.fmt_code c.conf ~offset:2 original with
+    | Ok formatted -> fmt_code formatted
     | Error (`Msg message) ->
         ( match message with
         | "" -> ()
@@ -105,8 +106,8 @@ let fmt_code_block c s1 s2 =
                 { location
                 ; message= Format.sprintf "invalid code block: %s" message }
         ) ;
-        fmt_no_code value )
-  | Some _ -> fmt_no_code value
+        fmt_code original )
+  | Some _ -> fmt_code original
 
 let fmt_code_span s = hovbox 0 (wrap "[" "]" (str (escape_brackets s)))
 
@@ -312,20 +313,24 @@ let fmt_ast conf ~fmt_code (docs : t) =
   let c = {fmt_code; conf} in
   vbox 0 (list_block_elem docs (fmt_block_element c))
 
-let fmt_parsed (conf : Conf.t) ~fmt_code ~input:str_cmt parsed =
+let fmt_parsed (conf : Conf.t) ~fmt_code ~input ~offset parsed =
   let open Fmt in
+  let begin_space = String.starts_with_whitespace input in
+  let offset = offset + if begin_space then 1 else 0 in
+  let fmt_code conf ~offset:offset' input =
+    fmt_code conf ~offset:(offset + offset') input
+  in
   let fmt_parsed parsed =
-    fmt_if (String.starts_with_whitespace str_cmt) " "
+    fmt_if begin_space " "
     $ fmt_ast conf ~fmt_code parsed
     $ fmt_if
-        (String.length str_cmt > 1 && String.ends_with_whitespace str_cmt)
+        (String.length input > 1 && String.ends_with_whitespace input)
         " "
   in
-  let fmt_raw str_cmt = str str_cmt in
   match parsed with
-  | _ when not conf.fmt_opts.parse_docstrings.v -> fmt_raw str_cmt
+  | _ when not conf.fmt_opts.parse_docstrings.v -> str input
   | Ok parsed -> fmt_parsed parsed
   | Error msgs ->
       if not conf.opr_opts.quiet.v then
         List.iter msgs ~f:(Docstring.warn Format.err_formatter) ;
-      fmt_raw str_cmt
+      str input
diff --git a/lib/Fmt_odoc.mli b/lib/Fmt_odoc.mli
index 02d0ff9080..0f1d561e87 100644
--- a/lib/Fmt_odoc.mli
+++ b/lib/Fmt_odoc.mli
@@ -9,7 +9,9 @@
 (*                                                                        *)
 (**************************************************************************)
 
-type fmt_code = Conf.t -> string -> Fmt.t or_error
+(** [offset] is the column at which the content of the comment begins. It is
+    used to adjust the margin. *)
+type fmt_code = Conf.t -> offset:int -> string -> string or_error
 
 val fmt_ast : Conf.t -> fmt_code:fmt_code -> Odoc_parser.Ast.t -> Fmt.t
 
@@ -17,5 +19,6 @@ val fmt_parsed :
      Conf.t
   -> fmt_code:fmt_code
   -> input:string
+  -> offset:int
   -> (Odoc_parser.Ast.t, Odoc_parser.Warning.t list) Result.t
   -> Fmt.t
diff --git a/test/passing/tests/crlf_to_crlf.ml.ref b/test/passing/tests/crlf_to_crlf.ml.ref
index 02ce9041bc..d4dad84ea5 100644
--- a/test/passing/tests/crlf_to_crlf.ml.ref
+++ b/test/passing/tests/crlf_to_crlf.ml.ref
@@ -16,7 +16,8 @@ foo
 
     {[
       let verbatim s =
-        s |> String.split_lines |> List.map ~f:String.strip
+        s |> String.split_lines
+        |> List.map ~f:String.strip
         |> fun s -> list s "@," Fmt.str
     ]} *)
 
diff --git a/test/passing/tests/crlf_to_lf.ml.ref b/test/passing/tests/crlf_to_lf.ml.ref
index 6f7170ad7b..095adcbfb7 100644
--- a/test/passing/tests/crlf_to_lf.ml.ref
+++ b/test/passing/tests/crlf_to_lf.ml.ref
@@ -16,7 +16,8 @@ foo
 
     {[
       let verbatim s =
-        s |> String.split_lines |> List.map ~f:String.strip
+        s |> String.split_lines
+        |> List.map ~f:String.strip
         |> fun s -> list s "@," Fmt.str
     ]} *)
 
diff --git a/test/passing/tests/doc_comments-no-wrap.mli.err b/test/passing/tests/doc_comments-no-wrap.mli.err
index 68bea81174..4a5e772c1d 100644
--- a/test/passing/tests/doc_comments-no-wrap.mli.err
+++ b/test/passing/tests/doc_comments-no-wrap.mli.err
@@ -7,13 +7,14 @@ Warning: tests/doc_comments.mli:87 exceeds the margin
 Warning: tests/doc_comments.mli:96 exceeds the margin
 Warning: tests/doc_comments.mli:99 exceeds the margin
 Warning: tests/doc_comments.mli:104 exceeds the margin
-Warning: tests/doc_comments.mli:308 exceeds the margin
-Warning: tests/doc_comments.mli:354 exceeds the margin
-Warning: tests/doc_comments.mli:361 exceeds the margin
-Warning: tests/doc_comments.mli:426 exceeds the margin
-Warning: tests/doc_comments.mli:439 exceeds the margin
-Warning: tests/doc_comments.mli:496 exceeds the margin
-Warning: tests/doc_comments.mli:526 exceeds the margin
-Warning: tests/doc_comments.mli:596 exceeds the margin
-Warning: tests/doc_comments.mli:598 exceeds the margin
-Warning: tests/doc_comments.mli:615 exceeds the margin
+Warning: tests/doc_comments.mli:309 exceeds the margin
+Warning: tests/doc_comments.mli:355 exceeds the margin
+Warning: tests/doc_comments.mli:362 exceeds the margin
+Warning: tests/doc_comments.mli:427 exceeds the margin
+Warning: tests/doc_comments.mli:440 exceeds the margin
+Warning: tests/doc_comments.mli:497 exceeds the margin
+Warning: tests/doc_comments.mli:527 exceeds the margin
+Warning: tests/doc_comments.mli:597 exceeds the margin
+Warning: tests/doc_comments.mli:599 exceeds the margin
+Warning: tests/doc_comments.mli:616 exceeds the margin
+Warning: tests/doc_comments.mli:628 exceeds the margin
diff --git a/test/passing/tests/doc_comments-no-wrap.mli.ref b/test/passing/tests/doc_comments-no-wrap.mli.ref
index eaa8737621..3e36eb81af 100644
--- a/test/passing/tests/doc_comments-no-wrap.mli.ref
+++ b/test/passing/tests/doc_comments-no-wrap.mli.ref
@@ -151,7 +151,8 @@ val x : x
 
     {[
       let verbatim s =
-        s |> String.split_lines |> List.map ~f:String.strip
+        s |> String.split_lines
+        |> List.map ~f:String.strip
         |> fun s -> list s "@," Fmt.str
     ]} *)
 
@@ -621,3 +622,11 @@ type x =
       \f\hat\xi\,e^{2 \pi i \xi x}
       \,d\xi
     } *)
+
+(** {[
+      let _ =
+        {|
+         Doc-comment contains code blocks that contains string with breaks and
+         ending with trailing spaces.
+        |}
+    ]} *)
diff --git a/test/passing/tests/doc_comments.mli.err b/test/passing/tests/doc_comments.mli.err
index 6067e1887c..2c02b0f18c 100644
--- a/test/passing/tests/doc_comments.mli.err
+++ b/test/passing/tests/doc_comments.mli.err
@@ -7,13 +7,14 @@ Warning: tests/doc_comments.mli:87 exceeds the margin
 Warning: tests/doc_comments.mli:96 exceeds the margin
 Warning: tests/doc_comments.mli:99 exceeds the margin
 Warning: tests/doc_comments.mli:104 exceeds the margin
-Warning: tests/doc_comments.mli:308 exceeds the margin
-Warning: tests/doc_comments.mli:354 exceeds the margin
-Warning: tests/doc_comments.mli:361 exceeds the margin
-Warning: tests/doc_comments.mli:426 exceeds the margin
-Warning: tests/doc_comments.mli:439 exceeds the margin
-Warning: tests/doc_comments.mli:496 exceeds the margin
-Warning: tests/doc_comments.mli:526 exceeds the margin
-Warning: tests/doc_comments.mli:590 exceeds the margin
-Warning: tests/doc_comments.mli:592 exceeds the margin
-Warning: tests/doc_comments.mli:609 exceeds the margin
+Warning: tests/doc_comments.mli:309 exceeds the margin
+Warning: tests/doc_comments.mli:355 exceeds the margin
+Warning: tests/doc_comments.mli:362 exceeds the margin
+Warning: tests/doc_comments.mli:427 exceeds the margin
+Warning: tests/doc_comments.mli:440 exceeds the margin
+Warning: tests/doc_comments.mli:497 exceeds the margin
+Warning: tests/doc_comments.mli:527 exceeds the margin
+Warning: tests/doc_comments.mli:591 exceeds the margin
+Warning: tests/doc_comments.mli:593 exceeds the margin
+Warning: tests/doc_comments.mli:610 exceeds the margin
+Warning: tests/doc_comments.mli:622 exceeds the margin
diff --git a/test/passing/tests/doc_comments.mli.ref b/test/passing/tests/doc_comments.mli.ref
index 8c48309623..b90ddc9db9 100644
--- a/test/passing/tests/doc_comments.mli.ref
+++ b/test/passing/tests/doc_comments.mli.ref
@@ -151,7 +151,8 @@ val x : x
 
     {[
       let verbatim s =
-        s |> String.split_lines |> List.map ~f:String.strip
+        s |> String.split_lines
+        |> List.map ~f:String.strip
         |> fun s -> list s "@," Fmt.str
     ]} *)
 
@@ -615,3 +616,11 @@ type x =
       \f\hat\xi\,e^{2 \pi i \xi x}
       \,d\xi
     } *)
+
+(** {[
+      let _ =
+        {|
+         Doc-comment contains code blocks that contains string with breaks and
+         ending with trailing spaces.
+        |}
+    ]} *)

From 2e2d6dc90c6663b6f6b0ec3408b8894a3d0da441 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Wed, 19 Apr 2023 12:15:31 +0200
Subject: [PATCH 047/115] Update CHANGES

---
 CHANGES.md | 1 +
 1 file changed, 1 insertion(+)

diff --git a/CHANGES.md b/CHANGES.md
index 8730f016da..07dc1a6025 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -6,6 +6,7 @@
 
 ### Bug fixes
 
+- Fix formatting of string literals in code blocks (#2338, @Julow)
 - Improve formatting of module arguments (#2322, @Julow)
 - Consistent indentation of `@@ let+ x = ...` (#2315, @Julow)
 - Remove double parenthesis around tuple in a match (#2308, @Julow)

From 7853ae50d54bf33599129da0716e64ed040c86fc Mon Sep 17 00:00:00 2001
From: Guillaume Petiot <guillaume@tarides.com>
Date: Wed, 19 Apr 2023 11:50:30 +0100
Subject: [PATCH 048/115] Fix non-stabilizing comments attached to type_constr

---
 lib/Fmt_ast.ml                      | 19 +++++++++++--------
 test/passing/tests/js_source.ml     |  9 +++++++++
 test/passing/tests/js_source.ml.ocp | 15 +++++++++++----
 test/passing/tests/js_source.ml.ref | 15 +++++++++++----
 4 files changed, 42 insertions(+), 16 deletions(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index e0623a4a91..83c497968c 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -137,6 +137,8 @@ module Indent = struct
 
   let variant_type_arg c = _ocp 2 0 c
 
+  let type_constr c = _ocp 2 0 c
+
   let docked_fun c ~loc ~lbl =
     if not c.conf.fmt_opts.ocp_indent_compat.v then 2
     else
@@ -152,8 +154,6 @@ end
 module Break = struct
   let _ocp a b c = fmt (if c.conf.fmt_opts.ocp_indent_compat.v then a else b)
 
-  let type_constr = _ocp "@;<1 2>" "@ "
-
   let unpack_annot = _ocp "@ " "@;<1 2>"
 
   (** Valid for [assignment-operator = begin-line]. *)
@@ -887,13 +887,16 @@ and fmt_core_type c ?(box = true) ?pro ?(pro_space = true) ?constraint_ctx
           (list xt1N (arrow_sep c ~parens) (fmt_arrow_param c ctx))
   | Ptyp_constr (lid, []) -> fmt_longident_loc c lid
   | Ptyp_constr (lid, [t1]) ->
-      fmt_core_type c (sub_typ ~ctx t1)
-      $ Break.type_constr c $ fmt_longident_loc c lid
+      hvbox (Indent.type_constr c)
+        ( fmt_core_type c (sub_typ ~ctx t1)
+        $ fmt "@ " $ fmt_longident_loc c lid )
   | Ptyp_constr (lid, t1N) ->
-      wrap_fits_breaks c.conf "(" ")"
-        (list t1N (Params.comma_sep c.conf)
-           (sub_typ ~ctx >> fmt_core_type c) )
-      $ Break.type_constr c $ fmt_longident_loc c lid
+      hvbox (Indent.type_constr c)
+        ( hvbox 0
+            (wrap_fits_breaks c.conf "(" ")"
+               (list t1N (Params.comma_sep c.conf)
+                  (sub_typ ~ctx >> fmt_core_type c) ) )
+        $ fmt "@ " $ fmt_longident_loc c lid )
   | Ptyp_extension ext ->
       hvbox c.conf.fmt_opts.extension_indent.v (fmt_extension c ctx ext)
   | Ptyp_package (id, cnstrs) ->
diff --git a/test/passing/tests/js_source.ml b/test/passing/tests/js_source.ml
index 1ab59b97b2..68ffd8334e 100644
--- a/test/passing/tests/js_source.ml
+++ b/test/passing/tests/js_source.ml
@@ -7987,3 +7987,12 @@ let _ =
         fooooooooooooooooooooooooooooooo ->
         foo)
 ;;
+
+type t =
+  { xxxxxx :
+      t
+        (* _________________________________________________________________________
+           ____________________________________________________________________
+           ___________ *)
+        XXXXXXX.t
+  }
diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp
index 2cb7d386c8..b4506ea83a 100644
--- a/test/passing/tests/js_source.ml.ocp
+++ b/test/passing/tests/js_source.ml.ocp
@@ -10210,13 +10210,11 @@ module type For_let_syntax_local =
    and type ('a, 'b) f_labeled_fn := f:('a[@local]) -> 'b
 
 type fooooooooooooooooooooooooooooooo =
-  ( fooooooooooooooooooooooooooooooo
-  , fooooooooooooooooooooooooooooooo )
+  (fooooooooooooooooooooooooooooooo, fooooooooooooooooooooooooooooooo)
     fooooooooooooooooooooooooooooooo
 
 val fooooooooooooooooooooooooooooooo
-  : ( fooooooooooooooooooooooooooooooo
-    , fooooooooooooooooooooooooooooooo )
+  : (fooooooooooooooooooooooooooooooo, fooooooooooooooooooooooooooooooo)
       fooooooooooooooooooooooooooooooo
 
 (*
@@ -10259,3 +10257,12 @@ let _ =
       fooooooooooooooooooooooooooooooo ->
       foo)
 ;;
+
+type t =
+  { xxxxxx :
+      t
+        (* _________________________________________________________________________
+           ____________________________________________________________________
+           ___________ *)
+        XXXXXXX.t
+  }
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index 7462c421c8..11474e1739 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -10210,13 +10210,11 @@ module type For_let_syntax_local =
    and type ('a, 'b) f_labeled_fn := f:('a[@local]) -> 'b
 
 type fooooooooooooooooooooooooooooooo =
-  ( fooooooooooooooooooooooooooooooo
-  , fooooooooooooooooooooooooooooooo )
+  (fooooooooooooooooooooooooooooooo, fooooooooooooooooooooooooooooooo)
     fooooooooooooooooooooooooooooooo
 
 val fooooooooooooooooooooooooooooooo
-  : ( fooooooooooooooooooooooooooooooo
-    , fooooooooooooooooooooooooooooooo )
+  : (fooooooooooooooooooooooooooooooo, fooooooooooooooooooooooooooooooo)
       fooooooooooooooooooooooooooooooo
 
 (*
@@ -10259,3 +10257,12 @@ let _ =
       fooooooooooooooooooooooooooooooo ->
       foo)
 ;;
+
+type t =
+  { xxxxxx :
+      t
+        (* _________________________________________________________________________
+           ____________________________________________________________________
+           ___________ *)
+        XXXXXXX.t
+  }

From f1ef7bfa908c6af92035b783bd2c976afde84547 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Wed, 19 Apr 2023 14:52:56 +0200
Subject: [PATCH 049/115] Fix formatting of cinaps comments

---
 lib/Cmts.ml                      | 15 +++++++++++++--
 test/passing/tests/cinaps.ml.err |  1 -
 test/passing/tests/cinaps.ml.ref |  5 +++--
 3 files changed, 16 insertions(+), 5 deletions(-)

diff --git a/lib/Cmts.ml b/lib/Cmts.ml
index ab5e8dc53b..367a8adb98 100644
--- a/lib/Cmts.ml
+++ b/lib/Cmts.ml
@@ -562,6 +562,18 @@ module Verbatim = struct
     $ wrap "(*" "*)" @@ str s
 end
 
+module Cinaps = struct
+  open Fmt
+
+  (** Comments enclosed in [(*$], [$*)] are formatted as code. *)
+  let fmt ~cls code =
+    let wrap k = hvbox 2 (fmt "(*$" $ k $ fmt cls) in
+    match String.split_lines code with
+    | [] | [""] -> wrap (str " ")
+    | [line] -> wrap (fmt "@ " $ str line $ fmt "@;<1 -2>")
+    | lines -> wrap (fmt "@\n" $ list lines "@\n" str $ fmt "@;<1000 -2>")
+end
+
 module Ocp_indent_compat = struct
   let fmt ~fmt_code conf (cmt : Cmt.t) ~offset (pos : Cmt.pos) ~post =
     let pre, doc, post =
@@ -631,8 +643,7 @@ let fmt_cmt (conf : Conf.t) (cmt : Cmt.t) ~fmt_code pos =
   let open Fmt in
   match mode with
   | `Verbatim x -> Verbatim.fmt x pos
-  | `Code (x, cls) ->
-      hvbox 2 @@ wrap "(*$@;" cls (Verbatim.fmt x pos $ fmt "@;<1 -2>")
+  | `Code (code, cls) -> Cinaps.fmt ~cls code
   | `Wrapped (x, epi) -> str "(*" $ fill_text x ~epi
   | `Unwrapped (x, ln) when conf.fmt_opts.ocp_indent_compat.v ->
       (* TODO: [offset] should be computed from location. *)
diff --git a/test/passing/tests/cinaps.ml.err b/test/passing/tests/cinaps.ml.err
index 6c128b0f94..e69de29bb2 100644
--- a/test/passing/tests/cinaps.ml.err
+++ b/test/passing/tests/cinaps.ml.err
@@ -1 +0,0 @@
-Warning: tests/cinaps.ml:24 exceeds the margin
diff --git a/test/passing/tests/cinaps.ml.ref b/test/passing/tests/cinaps.ml.ref
index 71fc3755f2..d2801ddeb6 100644
--- a/test/passing/tests/cinaps.ml.ref
+++ b/test/passing/tests/cinaps.ml.ref
@@ -20,9 +20,10 @@ let y = 2
 
 (*$
   #use "import.cinaps" ;;
-
+  
   List.iter all_fields ~f:(fun (name, type_) ->
-      printf "\nexternal get_%s\n  : unit -> %s = \"get_%s\"" name type_ name )
+      printf "\nexternal get_%s\n  : unit -> %s = \"get_%s\"" name type_
+        name )
 *)
 external get_name : unit -> string = "get_name"
 

From dec588e846b27b325a438c45a6e917a517fa498d Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Wed, 19 Apr 2023 15:41:54 +0200
Subject: [PATCH 050/115] Fix trailing spaces on empty lines in cinaps

---
 lib/Cmts.ml                      | 7 ++++++-
 test/passing/tests/cinaps.ml.ref | 2 +-
 2 files changed, 7 insertions(+), 2 deletions(-)

diff --git a/lib/Cmts.ml b/lib/Cmts.ml
index 367a8adb98..3e8efaeee0 100644
--- a/lib/Cmts.ml
+++ b/lib/Cmts.ml
@@ -571,7 +571,12 @@ module Cinaps = struct
     match String.split_lines code with
     | [] | [""] -> wrap (str " ")
     | [line] -> wrap (fmt "@ " $ str line $ fmt "@;<1 -2>")
-    | lines -> wrap (fmt "@\n" $ list lines "@\n" str $ fmt "@;<1000 -2>")
+    | lines ->
+        let fmt_line = function
+          | "" -> fmt "\n"
+          | line -> fmt "@\n" $ str line
+        in
+        wrap (list lines "" fmt_line $ fmt "@;<1000 -2>")
 end
 
 module Ocp_indent_compat = struct
diff --git a/test/passing/tests/cinaps.ml.ref b/test/passing/tests/cinaps.ml.ref
index d2801ddeb6..ec9b3a78fa 100644
--- a/test/passing/tests/cinaps.ml.ref
+++ b/test/passing/tests/cinaps.ml.ref
@@ -20,7 +20,7 @@ let y = 2
 
 (*$
   #use "import.cinaps" ;;
-  
+
   List.iter all_fields ~f:(fun (name, type_) ->
       printf "\nexternal get_%s\n  : unit -> %s = \"get_%s\"" name type_
         name )

From c8887f33cb706a4dd98061b639624f620fdf8ccd Mon Sep 17 00:00:00 2001
From: Guillaume Petiot <guillaume@tarides.com>
Date: Thu, 20 Apr 2023 11:34:53 +0100
Subject: [PATCH 051/115] Improve formatting of mty_with constraints

---
 lib/Fmt_ast.ml                      |  5 ++++-
 test/passing/tests/functor.ml       |  9 +++++----
 test/passing/tests/js_source.ml     | 15 +++++++++++++++
 test/passing/tests/js_source.ml.err |  1 +
 test/passing/tests/js_source.ml.ocp | 15 +++++++++++++++
 test/passing/tests/js_source.ml.ref | 15 +++++++++++++++
 6 files changed, 55 insertions(+), 5 deletions(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 583971d8a7..d43b514240 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -130,6 +130,8 @@ module Indent = struct
       match me.pmod_desc with Pmod_structure _ -> 0 | _ -> 2
     else 2
 
+  let mty = _ocp 2 3
+
   let mty_with = _ocp 0 2
 
   let variant ~parens c =
@@ -3792,7 +3794,8 @@ and fmt_module c ctx ?rec_ ?ext ?epi ?(can_sparse = false) keyword
     in
     let pro =
       pro $ Cmts.fmt_before c loc $ str "(" $ align_opn
-      $ fmt_str_loc_opt c name $ str " : "
+      $ fmt_str_loc_opt c name $ str " :"
+      $ fmt_or_k (Option.is_some blk.pro) (str " ") (break 1 (Indent.mty c))
     and epi = str ")" $ Cmts.fmt_after c loc $ align_cls in
     compose_module' ~box:false ~pro ~epi blk
   in
diff --git a/test/passing/tests/functor.ml b/test/passing/tests/functor.ml
index 52d911a6b0..0f8e5b9c7b 100644
--- a/test/passing/tests/functor.ml
+++ b/test/passing/tests/functor.ml
@@ -71,10 +71,11 @@ module type KV_MAKER = functor (G : Irmin_git.G) (C : Irmin.Contents.S) ->
 module Make
     (TT : TableFormat.TABLES)
     (IT : InspectionTableFormat.TABLES with type 'a lr1state = int)
-    (ET : EngineTypes.TABLE
-            with type terminal = int
-             and type nonterminal = int
-             and type semantic_value = Obj.t)
+    (ET :
+       EngineTypes.TABLE
+         with type terminal = int
+          and type nonterminal = int
+          and type semantic_value = Obj.t)
     (E : sig
       type 'a env = (ET.state, ET.semantic_value, ET.token) EngineTypes.env
     end) =
diff --git a/test/passing/tests/js_source.ml b/test/passing/tests/js_source.ml
index 68ffd8334e..abc58f2f02 100644
--- a/test/passing/tests/js_source.ml
+++ b/test/passing/tests/js_source.ml
@@ -7996,3 +7996,18 @@ type t =
            ___________ *)
         XXXXXXX.t
   }
+
+module Test_gen
+  (For_tests : For_tests_gen)
+  (Tested : S_gen
+            with type 'a src := 'a For_tests.Src.t
+            with type 'a dst := 'a For_tests.Dst.t)
+  (Tested : S_gen
+            with type 'a src := 'a For_tests.Src.t
+            with type 'a dst := 'a For_tests.Dst.t
+            and type 'a dst := 'a For_tests.Dst.t
+            and type 'a dst := 'a For_tests.Dst.t) =
+struct
+  open Tested
+  open For_tests
+end
diff --git a/test/passing/tests/js_source.ml.err b/test/passing/tests/js_source.ml.err
index 6b187de039..ed452c4608 100644
--- a/test/passing/tests/js_source.ml.err
+++ b/test/passing/tests/js_source.ml.err
@@ -3,3 +3,4 @@ Warning: tests/js_source.ml:9528 exceeds the margin
 Warning: tests/js_source.ml:9631 exceeds the margin
 Warning: tests/js_source.ml:9690 exceeds the margin
 Warning: tests/js_source.ml:9774 exceeds the margin
+Warning: tests/js_source.ml:10272 exceeds the margin
diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp
index b4506ea83a..d2385e44c8 100644
--- a/test/passing/tests/js_source.ml.ocp
+++ b/test/passing/tests/js_source.ml.ocp
@@ -10266,3 +10266,18 @@ type t =
            ___________ *)
         XXXXXXX.t
   }
+
+module Test_gen
+    (For_tests : For_tests_gen)
+    (Tested :
+       S_gen with type 'a src := 'a For_tests.Src.t with type 'a dst := 'a For_tests.Dst.t)
+    (Tested :
+       S_gen
+     with type 'a src := 'a For_tests.Src.t
+     with type 'a dst := 'a For_tests.Dst.t
+      and type 'a dst := 'a For_tests.Dst.t
+      and type 'a dst := 'a For_tests.Dst.t) =
+struct
+  open Tested
+  open For_tests
+end
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index 11474e1739..77672fa053 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -10266,3 +10266,18 @@ type t =
            ___________ *)
         XXXXXXX.t
   }
+
+module Test_gen
+    (For_tests : For_tests_gen)
+    (Tested :
+       S_gen with type 'a src := 'a For_tests.Src.t with type 'a dst := 'a For_tests.Dst.t)
+    (Tested :
+       S_gen
+       with type 'a src := 'a For_tests.Src.t
+       with type 'a dst := 'a For_tests.Dst.t
+        and type 'a dst := 'a For_tests.Dst.t
+        and type 'a dst := 'a For_tests.Dst.t) =
+struct
+  open Tested
+  open For_tests
+end

From c3b3d10d0fb88b735a3b4c8c7c4a09be3611189f Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Mon, 24 Apr 2023 17:31:50 +0200
Subject: [PATCH 052/115] Fix formatting of cinaps comments with strings

Strings containing breaks must carefully avoid changing the content of
strings while indenting the whole code.
---
 lib/Cmts.ml                         | 24 ++++++++++++------------
 test/passing/tests/js_source.ml     |  5 +++++
 test/passing/tests/js_source.ml.ocp |  5 +++++
 test/passing/tests/js_source.ml.ref |  5 +++++
 4 files changed, 27 insertions(+), 12 deletions(-)

diff --git a/lib/Cmts.ml b/lib/Cmts.ml
index 9c51e0ced4..7a23640d7e 100644
--- a/lib/Cmts.ml
+++ b/lib/Cmts.ml
@@ -566,17 +566,17 @@ module Cinaps = struct
   open Fmt
 
   (** Comments enclosed in [(*$], [$*)] are formatted as code. *)
-  let fmt ~cls code =
-    let wrap k = hvbox 2 (fmt "(*$" $ k $ fmt cls) in
-    match String.split_lines code with
-    | [] | [""] -> wrap (str " ")
-    | [line] -> wrap (fmt "@ " $ str line $ fmt "@;<1 -2>")
-    | lines ->
-        let fmt_line = function
-          | "" -> fmt "\n"
-          | line -> fmt "@\n" $ str line
-        in
-        wrap (list lines "" fmt_line $ fmt "@;<1000 -2>")
+  let fmt ~opn_pos ~cls code =
+    let code =
+      match String.split_lines code with
+      | [] | [""] -> noop
+      | [line] -> fmt "@ " $ str line
+      | first_line :: tl_lines ->
+          fmt "@,"
+          $ Unwrapped.fmt_multiline_cmt ~opn_pos ~starts_with_sp:false
+              first_line tl_lines
+    in
+    hvbox 2 (fmt "(*$" $ code $ fmt "@;<1 -2>" $ fmt cls)
 end
 
 module Ocp_indent_compat = struct
@@ -648,7 +648,7 @@ let fmt_cmt (conf : Conf.t) (cmt : Cmt.t) ~fmt_code pos =
   let open Fmt in
   match mode with
   | `Verbatim x -> Verbatim.fmt x pos
-  | `Code (code, cls) -> Cinaps.fmt ~cls code
+  | `Code (code, cls) -> Cinaps.fmt ~opn_pos:cmt.Cmt.loc.loc_start ~cls code
   | `Wrapped (x, epi) -> str "(*" $ fill_text x ~epi
   | `Unwrapped (x, ln) when conf.fmt_opts.ocp_indent_compat.v ->
       (* TODO: [offset] should be computed from location. *)
diff --git a/test/passing/tests/js_source.ml b/test/passing/tests/js_source.ml
index 9c49d5b9a2..d33182257c 100644
--- a/test/passing/tests/js_source.ml
+++ b/test/passing/tests/js_source.ml
@@ -7830,3 +7830,8 @@ class x =
       foo
 
 v}*)
+
+(*$
+    {|
+         f|}
+*)
diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp
index 494d8e409f..8360de5914 100644
--- a/test/passing/tests/js_source.ml.ocp
+++ b/test/passing/tests/js_source.ml.ocp
@@ -10072,3 +10072,8 @@ class x =
 (*{v
       foo
   v}*)
+
+(*$
+  {|
+         f|}
+*)
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index f14c9f2363..25eb067870 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -10072,3 +10072,8 @@ class x =
 (*{v
       foo
   v}*)
+
+(*$
+  {|
+         f|}
+*)

From 3b830509602bf5768260e42f54e7adcba482357b Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Mon, 24 Apr 2023 17:35:40 +0200
Subject: [PATCH 053/115] Update Changes

---
 CHANGES.md | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/CHANGES.md b/CHANGES.md
index 8a66ce84de..656c7ef0c2 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -8,7 +8,7 @@
 
 ### Bug fixes
 
-- Fix formatting of string literals in code blocks (#2338, @Julow)
+- Fix formatting of string literals in code blocks (#2338, #2349, @Julow)
 - Improve formatting of module arguments (#2322, @Julow)
 - Consistent indentation of `@@ let+ x = ...` (#2315, @Julow)
 - Remove double parenthesis around tuple in a match (#2308, @Julow)

From ad632eda262e63e4cfc35738a163384ac24e2500 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Tue, 25 Apr 2023 11:09:59 +0200
Subject: [PATCH 054/115] Fix changelog

---
 CHANGES.md | 1 +
 1 file changed, 1 insertion(+)

diff --git a/CHANGES.md b/CHANGES.md
index 9708088ba9..0c63dff096 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -9,6 +9,7 @@
 ### Bug fixes
 
 - Fix invalid formatting of `(::)` (#2347, @Julow)
+- Fix formatting of string literals in code blocks (#2338, #2349, @Julow)
 - Improve formatting of module arguments (#2322, @Julow)
 - Consistent indentation of `@@ let+ x = ...` (#2315, @Julow)
 - Remove double parenthesis around tuple in a match (#2308, @Julow)

From 6f48d88fe61c47ec53d7d3fa766a9efdb51efd9c Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Tue, 25 Apr 2023 11:48:36 +0200
Subject: [PATCH 055/115] Protect match after `fun _ : _ ->`

Add a missing check for exposed matches.
---
 lib/Ast.ml | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/lib/Ast.ml b/lib/Ast.ml
index e3b5c71b50..3f50ec184f 100644
--- a/lib/Ast.ml
+++ b/lib/Ast.ml
@@ -169,7 +169,10 @@ module Exp = struct
      |{pexp_desc= Pexp_ifthenelse _; _}, Non_apply
      |( {pexp_desc= Pexp_sequence _; _}
       , (Non_apply | Sequence | Then | ThenElse) )
-     |( {pexp_desc= Pexp_function _ | Pexp_match _ | Pexp_try _; _}
+     |( { pexp_desc=
+            ( Pexp_function _ | Pexp_match _ | Pexp_try _
+            | Pexp_fun (_, _, _, {pexp_desc= Pexp_constraint _; _}) )
+        ; _ }
       , (Match | Let_match | Non_apply) )
      |( { pexp_desc=
             ( Pexp_fun _ | Pexp_let _ | Pexp_letop _ | Pexp_letexception _

From 3ce5c961c24524f6cf2c3fb9178e6ca5551acf2d Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Tue, 25 Apr 2023 11:58:24 +0200
Subject: [PATCH 056/115] Update changes

---
 CHANGES.md | 1 +
 1 file changed, 1 insertion(+)

diff --git a/CHANGES.md b/CHANGES.md
index 8a66ce84de..0a57f25077 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -8,6 +8,7 @@
 
 ### Bug fixes
 
+- Protect match after `fun _ : _ ->` (#2352, @Julow)
 - Fix formatting of string literals in code blocks (#2338, @Julow)
 - Improve formatting of module arguments (#2322, @Julow)
 - Consistent indentation of `@@ let+ x = ...` (#2315, @Julow)

From 0ed40533125fdec72f305024516a4838178b5d33 Mon Sep 17 00:00:00 2001
From: Guillaume Petiot <guillaume@tarides.com>
Date: Tue, 25 Apr 2023 11:30:48 +0100
Subject: [PATCH 057/115] Fix non-stabilizing comments attached to a record
 type field

---
 lib/Fmt_ast.ml                              | 2 +-
 test/passing/tests/js_source.ml             | 5 +++++
 test/passing/tests/js_source.ml.ocp         | 6 ++++++
 test/passing/tests/js_source.ml.ref         | 6 ++++++
 test/passing/tests/record-loose.ml.ref      | 5 +++++
 test/passing/tests/record-tight_decl.ml.ref | 5 +++++
 test/passing/tests/record.ml                | 5 +++++
 test/passing/tests/record.ml.ref            | 5 +++++
 8 files changed, 38 insertions(+), 1 deletion(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index d43b514240..40eabbede0 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -3344,7 +3344,7 @@ and fmt_label_declaration c ctx ?(last = false) decl =
              (fits_breaks ~level:5 "" ";") )
           (str ";")
   in
-  hovbox 0
+  hvbox 0
     ( Cmts.fmt_before c pld_loc
     $ hvbox
         (Indent.record_docstring c)
diff --git a/test/passing/tests/js_source.ml b/test/passing/tests/js_source.ml
index abc58f2f02..657656e626 100644
--- a/test/passing/tests/js_source.ml
+++ b/test/passing/tests/js_source.ml
@@ -8011,3 +8011,8 @@ struct
   open Tested
   open For_tests
 end
+
+type t =
+  { xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx : YYYYYYYYYYYYYYYYYYYYY.t
+    (* ____________________________________ *)
+  }
diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp
index d2385e44c8..76474b340d 100644
--- a/test/passing/tests/js_source.ml.ocp
+++ b/test/passing/tests/js_source.ml.ocp
@@ -10281,3 +10281,9 @@ struct
   open Tested
   open For_tests
 end
+
+type t =
+  { xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx :
+      YYYYYYYYYYYYYYYYYYYYY.t
+      (* ____________________________________ *)
+  }
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index 77672fa053..044e24ed1a 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -10281,3 +10281,9 @@ struct
   open Tested
   open For_tests
 end
+
+type t =
+  { xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx :
+      YYYYYYYYYYYYYYYYYYYYY.t
+    (* ____________________________________ *)
+  }
diff --git a/test/passing/tests/record-loose.ml.ref b/test/passing/tests/record-loose.ml.ref
index 29e4a86f89..cb20c1f50e 100644
--- a/test/passing/tests/record-loose.ml.ref
+++ b/test/passing/tests/record-loose.ml.ref
@@ -138,3 +138,8 @@ let _ = {x : t :> t}
 let _ = {x : t :> t}
 
 let {x : t} = x
+
+type t =
+  { xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx :
+      YYYYYYYYYYYYYYYYYYYYY.t
+    (* ____________________________________ *) }
diff --git a/test/passing/tests/record-tight_decl.ml.ref b/test/passing/tests/record-tight_decl.ml.ref
index 67f243a15b..bbcb9d8c32 100644
--- a/test/passing/tests/record-tight_decl.ml.ref
+++ b/test/passing/tests/record-tight_decl.ml.ref
@@ -138,3 +138,8 @@ let _ = {x : t :> t}
 let _ = {x : t :> t}
 
 let {x : t} = x
+
+type t =
+  { xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx:
+      YYYYYYYYYYYYYYYYYYYYY.t
+    (* ____________________________________ *) }
diff --git a/test/passing/tests/record.ml b/test/passing/tests/record.ml
index ce2923835d..fc625715bd 100644
--- a/test/passing/tests/record.ml
+++ b/test/passing/tests/record.ml
@@ -139,3 +139,8 @@ let _ = { x = (x : t :> t) }
 let _ = { x : t = (x :> t) }
 
 let { x = (x : t) } = x
+
+type t =
+  { xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx : YYYYYYYYYYYYYYYYYYYYY.t
+    (* ____________________________________ *)
+  }
diff --git a/test/passing/tests/record.ml.ref b/test/passing/tests/record.ml.ref
index f8031d76b9..3cc96c42e7 100644
--- a/test/passing/tests/record.ml.ref
+++ b/test/passing/tests/record.ml.ref
@@ -138,3 +138,8 @@ let _ = {x: t :> t}
 let _ = {x: t :> t}
 
 let {x: t} = x
+
+type t =
+  { xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx:
+      YYYYYYYYYYYYYYYYYYYYY.t
+    (* ____________________________________ *) }

From ea482625bc127f140911219d7efd988fd71f8981 Mon Sep 17 00:00:00 2001
From: Guillaume Petiot <guillaume@tarides.com>
Date: Thu, 27 Apr 2023 09:42:44 +0100
Subject: [PATCH 058/115] Fix linebreaks in muktiline toplevel comments

---
 lib/Cmts.ml                         | 4 ++--
 test/passing/tests/js_source.ml     | 8 ++++++++
 test/passing/tests/js_source.ml.ocp | 8 ++++++++
 test/passing/tests/js_source.ml.ref | 8 ++++++++
 4 files changed, 26 insertions(+), 2 deletions(-)

diff --git a/lib/Cmts.ml b/lib/Cmts.ml
index 7a23640d7e..87af56f438 100644
--- a/lib/Cmts.ml
+++ b/lib/Cmts.ml
@@ -726,7 +726,7 @@ module Toplevel = struct
               if Source.begins_line t.source first_loc then
                 fmt_or
                   (Source.empty_line_before t.source first_loc)
-                  "\n@;<1000 0>" "@\n"
+                  "\n@;<1000 0>" "@;<1000 0>"
               else break 1 0
         in
         let epi =
@@ -736,7 +736,7 @@ module Toplevel = struct
               if Source.ends_line t.source last_loc then
                 fmt_or
                   (Source.empty_line_after t.source last_loc)
-                  "\n@;<1000 0>" "@\n"
+                  "\n@;<1000 0>" "@;<1000 0>"
               else break 1 0
           | After -> noop
         in
diff --git a/test/passing/tests/js_source.ml b/test/passing/tests/js_source.ml
index 99e329eac0..53ea9e482f 100644
--- a/test/passing/tests/js_source.ml
+++ b/test/passing/tests/js_source.ml
@@ -8027,3 +8027,11 @@ v}*)
     {|
          f|}
 *)
+
+type t =
+  { xxxxxxxxxxxxxxxxxxx : yyy
+                          [@zzzzzzzzzzzzzzzzzzz
+                             (* ________________________________
+                                ___ *)
+                            _______]
+  }
diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp
index 73aecd44bf..3e8d3d0f26 100644
--- a/test/passing/tests/js_source.ml.ocp
+++ b/test/passing/tests/js_source.ml.ocp
@@ -10296,3 +10296,11 @@ type t =
   {|
          f|}
 *)
+
+type t =
+  { xxxxxxxxxxxxxxxxxxx : yyy
+                          [@zzzzzzzzzzzzzzzzzzz
+                             (* ________________________________
+                                ___ *)
+                            _______]
+  }
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index 7b5e6ab17a..b809e0e1f8 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -10296,3 +10296,11 @@ type t =
   {|
          f|}
 *)
+
+type t =
+  { xxxxxxxxxxxxxxxxxxx : yyy
+        [@zzzzzzzzzzzzzzzzzzz
+          (* ________________________________
+             ___ *)
+          _______]
+  }

From 7e9bf8426a9e4057fa8e2cd0664b127e81b71ec8 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Tue, 9 May 2023 17:41:00 +0200
Subject: [PATCH 059/115] Add failing test

---
 .../tests/indicate_multiline_delimiters-cosl.ml.ref   | 11 +++++++++++
 .../tests/indicate_multiline_delimiters-space.ml.ref  | 10 ++++++++++
 test/passing/tests/indicate_multiline_delimiters.ml   | 10 ++++++++++
 3 files changed, 31 insertions(+)

diff --git a/test/passing/tests/indicate_multiline_delimiters-cosl.ml.ref b/test/passing/tests/indicate_multiline_delimiters-cosl.ml.ref
index 222820f0dc..ef68a60e26 100644
--- a/test/passing/tests/indicate_multiline_delimiters-cosl.ml.ref
+++ b/test/passing/tests/indicate_multiline_delimiters-cosl.ml.ref
@@ -49,3 +49,14 @@ let contrived =
   List.map l ~f:(fun aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa ->
       f aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
   )
+
+let x =
+  match y with
+  | Empty | Leaf _ -> assert false
+  | Node
+      ( {left= lr_left; key= _; value= fooooooo; height= _; right= lr_right}
+      as lr_node
+      ) ->
+      left_node.right <- lr_left ;
+      root_node.left <- lr_right ;
+      lr_node.right <- tree
diff --git a/test/passing/tests/indicate_multiline_delimiters-space.ml.ref b/test/passing/tests/indicate_multiline_delimiters-space.ml.ref
index e0808cf26e..ba4b305b1f 100644
--- a/test/passing/tests/indicate_multiline_delimiters-space.ml.ref
+++ b/test/passing/tests/indicate_multiline_delimiters-space.ml.ref
@@ -43,3 +43,13 @@ let contrived =
 let contrived =
   List.map l ~f:(fun aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa ->
       f aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa )
+
+let x =
+  match y with
+  | Empty | Leaf _ -> assert false
+  | Node
+      ( {left= lr_left; key= _; value= fooooooo; height= _; right= lr_right}
+      as lr_node ) ->
+      left_node.right <- lr_left ;
+      root_node.left <- lr_right ;
+      lr_node.right <- tree
diff --git a/test/passing/tests/indicate_multiline_delimiters.ml b/test/passing/tests/indicate_multiline_delimiters.ml
index 4ef8e1c5d7..8446811946 100644
--- a/test/passing/tests/indicate_multiline_delimiters.ml
+++ b/test/passing/tests/indicate_multiline_delimiters.ml
@@ -43,3 +43,13 @@ let contrived =
 let contrived =
   List.map l ~f:(fun aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa ->
       f aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa)
+
+let x =
+  match y with
+  | Empty | Leaf _ -> assert false
+  | Node
+      ({left= lr_left; key= _; value= fooooooo; height= _; right= lr_right}
+      as lr_node) ->
+      left_node.right <- lr_left ;
+      root_node.left <- lr_right ;
+      lr_node.right <- tree

From dfd63a7741ca57abdec96b77a2346c583bc31801 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Tue, 9 May 2023 17:42:41 +0200
Subject: [PATCH 060/115] Align pattern alias

The rhs of a `as` in a pattern should be aligned to the lhs when
parenthesis are added.

Increases readability, especially when there are nested parenthesis.
---
 lib/Fmt_ast.ml                                  | 17 +++++++++--------
 .../indicate_multiline_delimiters-cosl.ml.ref   |  2 +-
 .../indicate_multiline_delimiters-space.ml.ref  |  2 +-
 .../tests/indicate_multiline_delimiters.ml      |  2 +-
 4 files changed, 12 insertions(+), 11 deletions(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 47ebe3ccd6..44a0661087 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -974,12 +974,13 @@ and fmt_pattern ?ext c ?pro ?parens ?(box = false)
       in
       hovbox 0
         (wrap_fits_breaks_if ~space:false c.conf parens "(" ")"
-           ( fmt_pattern c ?parens:paren_pat (sub_pat ~ctx pat)
-           $ fmt "@ as@ "
-           $ Cmts.fmt c loc
-               (wrap_if
-                  (Std_longident.String_id.is_symbol txt)
-                  "( " " )" (str txt) ) ) )
+           (hovbox 0
+              ( fmt_pattern c ?parens:paren_pat (sub_pat ~ctx pat)
+              $ fmt "@ as@ "
+              $ Cmts.fmt c loc
+                  (wrap_if
+                     (Std_longident.String_id.is_symbol txt)
+                     "( " " )" (str txt) ) ) ) )
   | Ppat_constant const -> fmt_constant c const
   | Ppat_interval (l, u) -> fmt_constant c l $ str " .. " $ fmt_constant c u
   | Ppat_tuple pats ->
@@ -2402,7 +2403,7 @@ and fmt_expression c ?(box = true) ?pro ?epi ?eol ?parens ?(indent_wrap = 0)
           [ { pstr_desc=
                 Pstr_eval
                   ( ( {pexp_desc= Pexp_sequence _; pexp_attributes= []; _} as
-                    e1 )
+                      e1 )
                   , _ )
             ; pstr_loc= _ } ] )
     when Source.extension_using_sugar ~name:ext ~payload:e1.pexp_loc
@@ -2488,7 +2489,7 @@ and fmt_expression c ?(box = true) ?pro ?epi ?eol ?parens ?(indent_wrap = 0)
           [ ( { pstr_desc=
                   Pstr_eval
                     ( ( {pexp_desc= Pexp_infix _; pexp_attributes= []; _} as
-                      e1 )
+                        e1 )
                     , _ )
               ; pstr_loc= _ } as str ) ] )
     when List.is_empty pexp_attributes
diff --git a/test/passing/tests/indicate_multiline_delimiters-cosl.ml.ref b/test/passing/tests/indicate_multiline_delimiters-cosl.ml.ref
index ef68a60e26..764a7fa7a1 100644
--- a/test/passing/tests/indicate_multiline_delimiters-cosl.ml.ref
+++ b/test/passing/tests/indicate_multiline_delimiters-cosl.ml.ref
@@ -55,7 +55,7 @@ let x =
   | Empty | Leaf _ -> assert false
   | Node
       ( {left= lr_left; key= _; value= fooooooo; height= _; right= lr_right}
-      as lr_node
+        as lr_node
       ) ->
       left_node.right <- lr_left ;
       root_node.left <- lr_right ;
diff --git a/test/passing/tests/indicate_multiline_delimiters-space.ml.ref b/test/passing/tests/indicate_multiline_delimiters-space.ml.ref
index ba4b305b1f..b8a491787a 100644
--- a/test/passing/tests/indicate_multiline_delimiters-space.ml.ref
+++ b/test/passing/tests/indicate_multiline_delimiters-space.ml.ref
@@ -49,7 +49,7 @@ let x =
   | Empty | Leaf _ -> assert false
   | Node
       ( {left= lr_left; key= _; value= fooooooo; height= _; right= lr_right}
-      as lr_node ) ->
+        as lr_node ) ->
       left_node.right <- lr_left ;
       root_node.left <- lr_right ;
       lr_node.right <- tree
diff --git a/test/passing/tests/indicate_multiline_delimiters.ml b/test/passing/tests/indicate_multiline_delimiters.ml
index 8446811946..317d579957 100644
--- a/test/passing/tests/indicate_multiline_delimiters.ml
+++ b/test/passing/tests/indicate_multiline_delimiters.ml
@@ -49,7 +49,7 @@ let x =
   | Empty | Leaf _ -> assert false
   | Node
       ({left= lr_left; key= _; value= fooooooo; height= _; right= lr_right}
-      as lr_node) ->
+       as lr_node) ->
       left_node.right <- lr_left ;
       root_node.left <- lr_right ;
       lr_node.right <- tree

From 7df9213a9b3fe6a7b96c33081f396ba01ab0ec78 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Thu, 27 Apr 2023 22:43:51 +0200
Subject: [PATCH 061/115] WIP: Factorize interpretation of comments

Define and centralize how comments are interpreted. The new function is
also used by normalization, which had inconsistent rules before.
---
 lib/Cmt.ml                                    |  84 ++++++++-
 lib/Cmt.mli                                   |  18 +-
 lib/Cmts.ml                                   | 173 ++++--------------
 lib/Cmts.mli                                  |   7 -
 lib/Extended_ast.ml                           |   3 +-
 lib/Fmt_ast.ml                                |  12 +-
 lib/Normalize_extended_ast.ml                 | 103 +++++------
 lib/Normalize_extended_ast.mli                |   4 -
 lib/Translation_unit.ml                       |   7 +-
 test/passing/tests/break_cases-align.ml.err   |   2 +
 test/passing/tests/break_cases-align.ml.ref   |   8 +-
 test/passing/tests/break_cases-all.ml.err     |   2 +
 test/passing/tests/break_cases-all.ml.ref     |   8 +-
 ...reak_cases-closing_on_separate_line.ml.err |   2 +
 ...reak_cases-closing_on_separate_line.ml.ref |   8 +-
 ...te_line_leading_nested_match_parens.ml.err |   2 +
 ...te_line_leading_nested_match_parens.ml.ref |   8 +-
 .../tests/break_cases-cosl_lnmp_cmei.ml.err   |   2 +
 .../tests/break_cases-cosl_lnmp_cmei.ml.ref   |   8 +-
 .../tests/break_cases-fit_or_vertical.ml.err  |   2 +
 .../tests/break_cases-fit_or_vertical.ml.ref  |   8 +-
 test/passing/tests/break_cases-nested.ml.err  |   2 +
 test/passing/tests/break_cases-nested.ml.ref  |   8 +-
 .../tests/break_cases-normal_indent.ml.err    |   2 +
 .../tests/break_cases-normal_indent.ml.ref    |   8 +-
 .../passing/tests/break_cases-toplevel.ml.err |   2 +
 .../passing/tests/break_cases-toplevel.ml.ref |  10 +-
 .../passing/tests/break_cases-vertical.ml.err |   2 +
 .../passing/tests/break_cases-vertical.ml.ref |   8 +-
 test/passing/tests/break_cases.ml.err         |   2 +
 test/passing/tests/break_cases.ml.ref         |  10 +-
 .../tests/break_separators-after.ml.err       |   1 +
 .../tests/break_separators-after.ml.ref       |   3 +-
 .../break_separators-after_docked.ml.err      |   3 +-
 .../break_separators-after_docked.ml.ref      |   3 +-
 .../break_separators-before_docked.ml.err     |   1 +
 .../break_separators-before_docked.ml.ref     |   3 +-
 test/passing/tests/break_separators.ml        |   3 +-
 test/passing/tests/break_separators.ml.err    |   1 +
 test/passing/tests/error4.ml.ref              |   3 +-
 test/passing/tests/source.ml.ref              |  31 ++--
 41 files changed, 287 insertions(+), 290 deletions(-)
 create mode 100644 test/passing/tests/break_separators-after.ml.err
 create mode 100644 test/passing/tests/break_separators-before_docked.ml.err
 create mode 100644 test/passing/tests/break_separators.ml.err

diff --git a/lib/Cmt.ml b/lib/Cmt.ml
index 2c550c33e0..a837f5ed51 100644
--- a/lib/Cmt.ml
+++ b/lib/Cmt.ml
@@ -88,7 +88,16 @@ end
 
 type pos = Before | Within | After
 
-let unindent_lines ~offset first_line tl_lines =
+type decoded_kind =
+  | Verbatim of string
+  | Doc of string
+  | Normal of string
+  | Code of string list
+  | Asterisk_prefixed of string list
+
+type decoded = {prefix: string; suffix: string; kind: decoded_kind}
+
+let unindent_lines ~opn_pos first_line tl_lines =
   let indent_of_line s =
     (* index of first non-whitespace is indentation, None means white line *)
     String.lfindi s ~f:(fun _ c -> not (Char.is_whitespace c))
@@ -96,7 +105,8 @@ let unindent_lines ~offset first_line tl_lines =
   (* The indentation of the first line must account for the location of the
      comment opening *)
   let fl_spaces = Option.value ~default:0 (indent_of_line first_line) in
-  let fl_indent = fl_spaces + offset in
+  let fl_offset = opn_pos.Lexing.pos_cnum - opn_pos.pos_bol + 2 in
+  let fl_indent = fl_spaces + fl_offset in
   let min_indent =
     List.fold_left ~init:fl_indent
       ~f:(fun acc s ->
@@ -107,6 +117,72 @@ let unindent_lines ~offset first_line tl_lines =
   String.drop_prefix first_line fl_spaces
   :: List.map ~f:(fun s -> String.drop_prefix s min_indent) tl_lines
 
-let unindent_lines ~offset = function
+let unindent_lines ~opn_pos txt =
+  match String.split_lines txt with
   | [] -> []
-  | hd :: tl -> unindent_lines ~offset hd tl
+  | hd :: tl -> unindent_lines ~opn_pos hd tl
+
+let split_asterisk_prefixed ~opn_pos txt =
+  let len = Position.column opn_pos + 3 in
+  let pat =
+    String.Search_pattern.create
+      (String.init len ~f:(function
+        | 0 -> '\n'
+        | n when n < len - 1 -> ' '
+        | _ -> '*' ) )
+  in
+  let rec split_ pos =
+    match String.Search_pattern.index pat ~pos ~in_:txt with
+    | Some 0 -> "" :: split_ len
+    | Some idx -> String.sub txt ~pos ~len:(idx - pos) :: split_ (idx + len)
+    | _ ->
+        let drop = function ' ' | '\t' -> true | _ -> false in
+        let line = String.rstrip ~drop (String.drop_prefix txt pos) in
+        if String.is_empty line then [" "]
+        else if Char.equal line.[String.length line - 1] '\n' then
+          [String.drop_suffix line 1; ""]
+        else if Char.is_whitespace txt.[String.length txt - 1] then
+          [line ^ " "]
+        else [line]
+  in
+  split_ 0
+
+let decode {txt; loc} =
+  let mk ?(prefix = "") ?(suffix = "") kind = {prefix; suffix; kind} in
+  let txt =
+    (* Windows compatibility *)
+    let f = function '\r' -> false | _ -> true in
+    String.filter txt ~f
+  in
+  let opn_pos = loc.Location.loc_start in
+  if String.length txt >= 2 then
+    match txt.[0] with
+    | '$' when not (Char.is_whitespace txt.[1]) -> mk (Verbatim txt)
+    | '$' ->
+        let dollar_suf = Char.equal txt.[String.length txt - 1] '$' in
+        let suffix = if dollar_suf then "$" else "" in
+        let len = String.length txt - if dollar_suf then 2 else 1 in
+        let source = String.sub ~pos:1 ~len txt in
+        let source =
+          String.lstrip ~drop:(function '\n' -> true | _ -> false) source
+        in
+        mk ~prefix:"$" ~suffix (Code (unindent_lines ~opn_pos source))
+    | '=' -> mk (Verbatim txt)
+    | '*' -> mk ~prefix:"*" (Doc (String.drop_prefix txt 1))
+    | _ -> (
+      match split_asterisk_prefixed ~opn_pos txt with
+      | [] | [""] -> impossible "not produced by split_asterisk_prefixed"
+      (* Comments like [(*\n*)] would be normalized as [(* *)] *)
+      (* | [""; ""] when conf.fmt_opts.ocp_indent_compat.v -> *)
+      | [""; ""] -> mk (Verbatim " ")
+      | [txt] -> mk (Normal txt)
+      | [txt; ""] -> mk ~prefix:" " (Normal txt)
+      | lines -> mk (Asterisk_prefixed lines) )
+  else
+    match txt with
+    (* "(**)" is not parsed as a docstring but as a regular comment
+       containing '*' and would be rewritten as "(***)" *)
+    | "*" when Location.width loc = 4 -> mk (Verbatim "")
+    | ("*" | "$") as txt -> mk (Verbatim txt)
+    | "\n" -> mk (Verbatim " ")
+    | _ -> mk (Normal txt)
diff --git a/lib/Cmt.mli b/lib/Cmt.mli
index 59c73e3a15..db80cb4e8e 100644
--- a/lib/Cmt.mli
+++ b/lib/Cmt.mli
@@ -37,6 +37,18 @@ module Comparator_no_loc : sig
   include Comparator.S with type t := t
 end
 
-val unindent_lines : offset:int -> string list -> string list
-(** Detect and remove the baseline indentation of a comment or a code block.
-    [offset] is the column number at which the first line starts. *)
+type decoded_kind =
+  | Verbatim of string  (** Original content. *)
+  | Doc of string  (** Original content. *)
+  | Normal of string  (** Original content with whitespaces trimmed. *)
+  | Code of string list
+      (** Source code is line splitted with baseline indentation removed. *)
+  | Asterisk_prefixed of string list
+      (** Line splitted with asterisks removed. *)
+
+type decoded =
+  { prefix: string  (** Just after the opening. *)
+  ; suffix: string  (** Just before the closing. *)
+  ; kind: decoded_kind }
+
+val decode : t -> decoded
diff --git a/lib/Cmts.ml b/lib/Cmts.ml
index 41d1a5dddd..edc624d734 100644
--- a/lib/Cmts.ml
+++ b/lib/Cmts.ml
@@ -461,46 +461,19 @@ let break_comment_group source margin {Cmt.loc= a; _} {Cmt.loc= b; _} =
     && (vertical_align || horizontal_align) )
 
 module Asterisk_prefixed = struct
-  let split Cmt.{txt; loc= {Location.loc_start; _}} =
-    let len = Position.column loc_start + 3 in
-    let pat =
-      String.Search_pattern.create
-        (String.init len ~f:(function
-          | 0 -> '\n'
-          | n when n < len - 1 -> ' '
-          | _ -> '*' ) )
-    in
-    let rec split_ pos =
-      match String.Search_pattern.index pat ~pos ~in_:txt with
-      | Some 0 -> "" :: split_ len
-      | Some idx -> String.sub txt ~pos ~len:(idx - pos) :: split_ (idx + len)
-      | _ ->
-          let drop = function ' ' | '\t' -> true | _ -> false in
-          let line = String.rstrip ~drop (String.drop_prefix txt pos) in
-          if String.is_empty line then [" "]
-          else if Char.equal line.[String.length line - 1] '\n' then
-            [String.drop_suffix line 1; ""]
-          else if Char.is_whitespace txt.[String.length txt - 1] then
-            [line ^ " "]
-          else [line]
-    in
-    split_ 0
-
   let fmt lines =
     let open Fmt in
     vbox 1
-      ( fmt "(*"
-      $ list_fl lines (fun ~first:_ ~last line ->
-            match line with
-            | "" when last -> fmt ")"
-            | _ -> str line $ fmt_or last "*)" "@,*" ) )
+      (list_fl lines (fun ~first ~last line ->
+           match line with
+           | "" when last -> fmt "@,"
+           | _ -> fmt_if (not first) "@," $ str "*" $ str line ) )
 end
 
 module Unwrapped = struct
-  let fmt_multiline_cmt ?epi ~offset ~starts_with_sp lines =
+  let fmt_multiline_cmt ?epi ~starts_with_sp lines =
     let open Fmt in
     let is_white_line s = String.for_all s ~f:Char.is_whitespace in
-    let unindented = Cmt.unindent_lines ~offset lines in
     let fmt_line ~first ~last:_ s =
       let sep, sp =
         if is_white_line s then (str "\n", noop)
@@ -508,9 +481,9 @@ module Unwrapped = struct
       in
       fmt_if_k (not first) sep $ sp $ str (String.rstrip s)
     in
-    vbox 0 ~name:"multiline" (list_fl unindented fmt_line $ fmt_opt epi)
+    vbox 0 ~name:"multiline" (list_fl lines fmt_line $ fmt_opt epi)
 
-  let fmt ~offset s =
+  let fmt s =
     let open Fmt in
     let is_sp = function ' ' | '\t' -> true | _ -> false in
     match String.split_lines (String.rstrip s) with
@@ -526,9 +499,8 @@ module Unwrapped = struct
         in
         (* Preserve the first level of indentation *)
         let starts_with_sp = is_sp first_line.[0] in
-        wrap "(*" "*)"
-        @@ fmt_multiline_cmt ~offset ~epi ~starts_with_sp lines
-    | _ -> wrap "(*" "*)" @@ str s
+        fmt_multiline_cmt ~epi ~starts_with_sp lines
+    | _ -> str s
 end
 
 module Verbatim = struct
@@ -537,37 +509,37 @@ module Verbatim = struct
     fmt_if_k
       (Poly.(pos = After) && String.contains s '\n')
       (break_unless_newline 1000 0)
-    $ wrap "(*" "*)" @@ str s
+    $ str s
 end
 
 module Cinaps = struct
   open Fmt
 
   (** Comments enclosed in [(*$], [$*)] are formatted as code. *)
-  let fmt ~cls code =
-    let wrap k = hvbox 2 (fmt "(*$" $ k $ fmt cls) in
-    match String.split_lines code with
-    | [] | [""] -> wrap (str " ")
-    | [line] -> wrap (fmt "@ " $ str line $ fmt "@;<1 -2>")
+  let fmt code =
+    match code with
+    | [] | [""] -> str " "
+    | [line] -> fmt "@ " $ str line $ fmt "@;<1 -2>"
     | lines ->
         let fmt_line = function
           | "" -> fmt "\n"
           | line -> fmt "@\n" $ str line
         in
-        wrap (list lines "" fmt_line $ fmt "@;<1000 -2>")
+        list lines "" fmt_line $ fmt "@;<1000 -2>"
 end
 
 module Ocp_indent_compat = struct
-  let fmt ~fmt_code conf txt ~loc ~offset (pos : Cmt.pos) ~post =
-    let pre, doc, post =
+  let fmt ~fmt_code conf ~loc txt ~offset (pos : Cmt.pos) =
+    let endl = String.ends_with_whitespace txt in
+    let pre, doc =
       let lines = String.split_lines txt in
       match lines with
-      | [] | [_] -> (false, txt, false)
+      | [] | [_] -> (false, txt)
       | h :: _ ->
           let pre = String.is_empty (String.strip h) in
           let doc = if pre then String.lstrip txt else txt in
-          let doc = if Option.is_some post then String.rstrip doc else doc in
-          (pre, doc, Option.is_some post)
+          let doc = if endl then String.rstrip doc else doc in
+          (pre, doc)
     in
     let parsed = Docstring.parse ~loc doc in
     (* Disable warnings when parsing fails *)
@@ -578,72 +550,28 @@ module Ocp_indent_compat = struct
     fmt_if_k
       (Poly.(pos = After) && String.contains txt '\n')
       (break_unless_newline 1000 0)
-    $ wrap "(*" "*)"
-      @@ wrap_k (fmt_if pre "@;<1000 3>") (fmt_if post "@\n")
-      @@ doc
+    $ wrap_k (fmt_if pre "@;<1000 3>") (fmt_if endl "@\n") @@ doc
 end
 
-let fmt_cmt (conf : Conf.t) (cmt : Cmt.t) ~fmt_code pos =
-  let offset =
-    let pos = cmt.loc.Location.loc_start in
-    pos.pos_cnum - pos.pos_bol + 2
-  in
-  let mode =
-    match cmt.txt with
-    | "" -> impossible "not produced by parser"
-    (* "(**)" is not parsed as a docstring but as a regular comment
-       containing '*' and would be rewritten as "(***)" *)
-    | "*" when Location.width cmt.loc = 4 -> `Verbatim ""
-    | "*" -> `Verbatim "*"
-    | "$" -> `Verbatim "$"
-    (* Qtest pragmas *)
-    | str when Char.(str.[0] = '$' && not (is_whitespace str.[1])) ->
-        `Verbatim str
-    | str when Char.equal str.[0] '$' -> (
-        let dollar_suf = Char.equal str.[String.length str - 1] '$' in
-        let cls : Fmt.s = if dollar_suf then "$*)" else "*)" in
-        let len = String.length str - if dollar_suf then 2 else 1 in
-        let offset = offset + 1 in
-        let source = String.sub ~pos:1 ~len str in
-        let source =
-          String.split_lines source
-          |> Cmt.unindent_lines ~offset
-          |> String.concat ~sep:"\n"
-        in
-        match fmt_code conf ~offset source with
-        | Ok formatted -> `Code (formatted, cls)
-        | Error (`Msg _) -> `Unwrapped (str, None) )
-    | str when Char.equal str.[0] '=' -> `Verbatim cmt.txt
-    | _ -> (
-        let txt =
-          (* Windows compatibility *)
-          let filter = function '\r' -> false | _ -> true in
-          String.filter cmt.txt ~f:filter
-        in
-        let cmt = Cmt.create txt cmt.loc in
-        match Asterisk_prefixed.split cmt with
-        | [] | [""] -> impossible "not produced by split_asterisk_prefixed"
-        (* Comments like [(*\n*)] would be normalized as [(* *)] *)
-        | [""; ""] when conf.fmt_opts.ocp_indent_compat.v ->
-            `Unwrapped (txt, None)
-        | [""; ""] -> `Verbatim " "
-        | [text] when conf.fmt_opts.wrap_comments.v -> `Wrapped (text, "*)")
-        | [text; ""] when conf.fmt_opts.wrap_comments.v ->
-            `Wrapped (text, " *)")
-        | [_] -> `Unwrapped (txt, None)
-        | [_; ""] -> `Unwrapped (txt, Some `Ln)
-        | lines -> `Asterisk_prefixed lines )
-  in
+let fmt_cmt (conf : Conf.t) cmt ~fmt_code pos =
   let open Fmt in
-  match mode with
-  | `Verbatim x -> Verbatim.fmt x pos
-  | `Code (code, cls) -> Cinaps.fmt ~cls code
-  | `Wrapped (x, epi) -> str "(*" $ fill_text x ~epi
-  | `Unwrapped (x, ln) when conf.fmt_opts.ocp_indent_compat.v ->
-      Ocp_indent_compat.fmt ~fmt_code conf x ~loc:cmt.loc ~offset pos
-        ~post:ln
-  | `Unwrapped (x, _) -> Unwrapped.fmt ~offset x
-  | `Asterisk_prefixed x -> Asterisk_prefixed.fmt x
+  let decoded = Cmt.decode cmt in
+  (fun k ->
+    hvbox 2
+      (str "(*" $ str decoded.prefix $ k $ str decoded.suffix $ str "*)") )
+  @@
+  match decoded.kind with
+  | Verbatim txt -> Verbatim.fmt txt pos
+  | Doc txt ->
+      Ocp_indent_compat.fmt ~fmt_code conf ~loc:cmt.loc txt ~offset:2 pos
+  | Normal txt ->
+      if conf.fmt_opts.wrap_comments.v then fill_text txt ~epi:""
+      else if conf.fmt_opts.ocp_indent_compat.v then
+        (* TODO: [offset] should be computed from location. *)
+        Ocp_indent_compat.fmt ~fmt_code conf ~loc:cmt.loc txt ~offset:2 pos
+      else Unwrapped.fmt txt
+  | Code code -> Cinaps.fmt code
+  | Asterisk_prefixed lines -> Asterisk_prefixed.fmt lines
 
 let fmt_cmts_aux t (conf : Conf.t) cmts ~fmt_code pos =
   let open Fmt in
@@ -779,24 +707,3 @@ let remaining_comments t =
 let remaining_before t loc = Map.find_multi t.cmts_before loc
 
 let remaining_locs t = Set.to_list t.remaining
-
-let is_docstring (conf : Conf.t) (Cmt.{txt; loc} as cmt) =
-  match txt with
-  | "" | "*" -> Either.Second cmt
-  | _ when Char.equal txt.[0] '*' ->
-      (* Doc comments here (comming directly from the lexer) include their
-         leading star [*]. It is not part of the docstring and should be
-         dropped. When [ocp-indent-compat] is set, regular comments are
-         treated as doc-comments. *)
-      let txt = String.drop_prefix txt 1 in
-      let cmt = Cmt.create txt loc in
-      if conf.fmt_opts.parse_docstrings.v then Either.First cmt
-      else Either.Second cmt
-  | _ when Char.equal txt.[0] '$' -> Either.Second cmt
-  | _
-    when conf.fmt_opts.ocp_indent_compat.v
-         && conf.fmt_opts.parse_docstrings.v ->
-      (* In ocp_indent_compat mode, comments are parsed like docstrings. *)
-      let cmt = Cmt.create txt loc in
-      Either.First cmt
-  | _ -> Either.Second cmt
diff --git a/lib/Cmts.mli b/lib/Cmts.mli
index be1a9da4bb..a5c04848fd 100644
--- a/lib/Cmts.mli
+++ b/lib/Cmts.mli
@@ -121,10 +121,3 @@ type layout_cache_key =
 val preserve : cache_key:layout_cache_key -> (unit -> Fmt.t) -> t -> string
 (** [preserve f t] formats like [f ()] but returns a string and does not
     consume comments from [t]. *)
-
-val is_docstring : Conf.t -> Cmt.t -> (Cmt.t, Cmt.t) Either.t
-(** [is_docstring conf cmt] returns:
-
-    - [First  c] when [cmt] is a docstring, where [c] is its content stripped
-      of the leading [*];
-    - [Second c] when [cmt] is a regular comment, where [c] is its content. *)
diff --git a/lib/Extended_ast.ml b/lib/Extended_ast.ml
index 6c20bba92c..077514982a 100644
--- a/lib/Extended_ast.ml
+++ b/lib/Extended_ast.ml
@@ -210,8 +210,7 @@ module Parse = struct
         when Migrate_ast.Location.compare_start ptyp_loc pexp_loc > 0 ->
           (* Match locations to differentiate between the two position for
              the constraint, we want to shorten the second: - [let _ :
-             (module S) = (module M)] - [let _ = ((module M) : (module
-             S))] *)
+             (module S) = (module M)] - [let _ = ((module M) : (module S))] *)
           {p with pexp_desc= Pexp_pack (name, Some pt)}
       | e -> Ast_mapper.default_mapper.expr m e
     in
diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 03e7a07707..87eda4e91f 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -36,8 +36,7 @@ module Cmts = struct
   let fmt c ?pro ?epi ?eol ?adj loc =
     (* remove the before comments from the map first *)
     let before = fmt_before c ?pro ?epi ?eol ?adj loc in
-    (* remove the within comments from the map by accepting the
-       continuation *)
+    (* remove the within comments from the map by accepting the continuation *)
     fun inner ->
       (* delay the after comments until the within comments have been
          removed *)
@@ -717,8 +716,7 @@ and fmt_arrow_param c ctx {pap_label= lI; pap_loc= locI; pap_type= tI} =
 (* The context of [xtyp] refers to the RHS of the expression (namely
    Pexp_constraint) and does not give a relevant information as to whether
    [xtyp] should be parenthesized. [constraint_ctx] gives the higher context
-   of the expression, i.e. if the expression is part of a `fun`
-   expression. *)
+   of the expression, i.e. if the expression is part of a `fun` expression. *)
 and fmt_core_type c ?(box = true) ?pro ?(pro_space = true) ?constraint_ctx
     ({ast= typ; ctx} as xtyp) =
   protect c (Typ typ)
@@ -1351,8 +1349,7 @@ and fmt_fun ?force_closing_paren
     else noop
   in
   let (label_sep : s), break_fun =
-    (* Break between the label and the fun to avoid ocp-indent's
-       alignment. *)
+    (* Break between the label and the fun to avoid ocp-indent's alignment. *)
     if c.conf.fmt_opts.ocp_indent_compat.v then (":@,", fmt "@;<1 2>")
     else (":", fmt "@ ")
   in
@@ -2626,8 +2623,7 @@ and fmt_expression c ?(box = true) ?pro ?epi ?eol ?parens ?(indent_wrap = 0)
   | Pexp_beginend e ->
       let wrap_beginend =
         match ctx0 with
-        (* begin-end keywords are handled when printing if-then-else
-           branch *)
+        (* begin-end keywords are handled when printing if-then-else branch *)
         | Exp {pexp_desc= Pexp_ifthenelse (_, Some z); _}
           when Base.phys_equal xexp.ast z ->
             Fn.id
diff --git a/lib/Normalize_extended_ast.ml b/lib/Normalize_extended_ast.ml
index 9a0e048423..06c06877ce 100644
--- a/lib/Normalize_extended_ast.ml
+++ b/lib/Normalize_extended_ast.ml
@@ -11,10 +11,6 @@
 
 open Extended_ast
 
-let start_column loc =
-  let pos = loc.Location.loc_start in
-  pos.pos_cnum - pos.pos_bol
-
 let dedup_cmts fragment ast comments =
   let of_ast ast =
     let docs = ref (Set.empty (module Cmt)) in
@@ -53,12 +49,7 @@ let normalize_parse_result ast_kind ast comments =
     (normalize_comments (dedup_cmts ast_kind ast))
     comments
 
-let normalize_code conf (m : Ast_mapper.mapper) ~offset txt =
-  let txt =
-    String.split_lines txt
-    |> Cmt.unindent_lines ~offset
-    |> String.concat ~sep:"\n"
-  in
+let normalize_code conf (m : Ast_mapper.mapper) txt =
   let input_name = "<output>" in
   match Parse_with_comments.parse_toplevel conf ~input_name ~source:txt with
   | First {ast; comments; _} ->
@@ -95,10 +86,7 @@ let make_mapper conf ~ignore_doc_comments =
                   , [] )
             ; _ } as pstr ) ]
       when Ast.Attr.is_doc attr ->
-        let normalize_code =
-          (* Indentation is already stripped by odoc-parser. *)
-          normalize_code conf m ~offset:0
-        in
+        let normalize_code = normalize_code conf m in
         let doc' = docstring conf ~normalize_code doc in
         Ast_mapper.default_mapper.attribute m
           { attr with
@@ -166,9 +154,47 @@ let make_mapper conf ~ignore_doc_comments =
 let ast fragment ~ignore_doc_comments c =
   map fragment (make_mapper c ~ignore_doc_comments)
 
-let diff ~f ~cmt_kind x y =
-  let dropped x = {Cmt.kind= `Dropped x; cmt_kind} in
-  let added x = {Cmt.kind= `Added x; cmt_kind} in
+module Normalized_cmt = struct
+  type t =
+    { cmt_kind: [`Comment | `Doc_comment]
+    ; norm: string
+    ; orig: Cmt.t  (** Not compared. *) }
+
+  let compare a b = Poly.compare (a.cmt_kind, a.norm) (b.cmt_kind, b.norm)
+
+  let of_cmt ~normalize_code ~normalize_doc orig =
+    let cmt_kind, norm =
+      let decoded = Cmt.decode orig in
+      match decoded.Cmt.kind with
+      | Verbatim txt -> (`Comment, txt)
+      | Doc txt -> (`Doc_comment, normalize_doc txt)
+      | Normal txt -> (`Comment, Docstring.normalize_text txt)
+      | Code code -> (`Comment, normalize_code (String.concat ~sep:"\n" code))
+      | Asterisk_prefixed lines ->
+          ( `Comment
+          , String.concat ~sep:" "
+              (List.map ~f:Docstring.normalize_text lines) )
+    in
+    {cmt_kind; norm; orig}
+
+  let dropped {cmt_kind; orig; _} = {Cmt.kind= `Dropped orig; cmt_kind}
+
+  let added {cmt_kind; orig; _} = {Cmt.kind= `Added orig; cmt_kind}
+
+  let sexp_of_t _ = Sexp.Atom "Normalized_cmt.t"
+
+  module Comparator = struct
+    type nonrec t = t
+
+    include Comparator.Make (struct
+      type nonrec t = t
+
+      let compare, sexp_of_t = (compare, sexp_of_t)
+    end)
+  end
+end
+
+let diff ~f x y =
   (*= [symmetric_diff x y] returns a sequence of changes between [x] and [y]:
       - [First k] means [k] is in [x] but not [y]
       - [Second k] means [k] is in [y] but not [x] *)
@@ -176,46 +202,21 @@ let diff ~f ~cmt_kind x y =
   |> Sequence.to_list
   (*= - [First _] is reported as a comment dropped
       - [Second _] is reported as a comment added *)
-  |> List.map ~f:(Either.value_map ~first:dropped ~second:added)
+  |> List.map
+       ~f:
+         (Either.value_map ~first:Normalized_cmt.dropped
+            ~second:Normalized_cmt.added )
   |> function [] -> Ok () | errors -> Error errors
 
-let diff_docstrings c x y =
-  let mapper = make_mapper c ~ignore_doc_comments:false in
-  let docstring {Cmt.txt; loc} =
-    let offset = start_column loc + 3 in
-    let normalize_code = normalize_code c mapper ~offset in
-    docstring c ~normalize_code txt
-  in
-  let norm z =
-    let f (Cmt.{loc; _} as cmt) = Cmt.create (docstring cmt) loc in
-    Set.of_list (module Cmt.Comparator_no_loc) (List.map ~f z)
-  in
-  diff ~f:norm ~cmt_kind:`Doc_comment x y
-
 let diff_cmts (conf : Conf.t) x y =
   let mapper = make_mapper conf ~ignore_doc_comments:false in
   let normalize_code = normalize_code conf mapper in
-  let norm z =
-    let norm_non_code {Cmt.txt; loc} =
-      Cmt.create (Docstring.normalize_text txt) loc
-    in
-    let f z =
-      match Cmt.txt z with
-      | "" | "$" -> norm_non_code z
-      | str ->
-          if Char.equal str.[0] '$' then
-            let chars_removed =
-              if Char.equal str.[String.length str - 1] '$' then 2 else 1
-            in
-            let len = String.length str - chars_removed in
-            let source = String.sub ~pos:1 ~len str in
-            let offset = start_column z.loc + 3 in
-            Cmt.create (normalize_code ~offset source) z.loc
-          else norm_non_code z
-    in
-    Set.of_list (module Cmt.Comparator_no_loc) (List.map ~f z)
+  let normalize_doc = docstring conf ~normalize_code in
+  let f z =
+    let f = Normalized_cmt.of_cmt ~normalize_code ~normalize_doc in
+    Set.of_list (module Normalized_cmt.Comparator) (List.map ~f z)
   in
-  diff ~f:norm ~cmt_kind:`Comment x y
+  diff ~f x y
 
 let equal fragment ~ignore_doc_comments c ast1 ast2 =
   let map = ast fragment c ~ignore_doc_comments in
diff --git a/lib/Normalize_extended_ast.mli b/lib/Normalize_extended_ast.mli
index 4a996c2ba8..59f4644278 100644
--- a/lib/Normalize_extended_ast.mli
+++ b/lib/Normalize_extended_ast.mli
@@ -16,10 +16,6 @@ val equal :
   'a Extended_ast.t -> ignore_doc_comments:bool -> Conf.t -> 'a -> 'a -> bool
 (** Compare fragments for equality up to normalization. *)
 
-val diff_docstrings :
-  Conf.t -> Cmt.t list -> Cmt.t list -> (unit, Cmt.error list) Result.t
-(** Difference between two lists of doc comments. *)
-
 val diff_cmts :
   Conf.t -> Cmt.t list -> Cmt.t list -> (unit, Cmt.error list) Result.t
 (** Difference between two lists of comments. *)
diff --git a/lib/Translation_unit.ml b/lib/Translation_unit.ml
index aaf9bc318c..f0ef40db66 100644
--- a/lib/Translation_unit.ml
+++ b/lib/Translation_unit.ml
@@ -214,12 +214,7 @@ let check_comments (conf : Conf.t) cmts ~old:t_old ~new_:t_new =
     let errors =
       check_remaining_comments cmts
       >>= fun () ->
-      let split_cmts = List.partition_map ~f:(Cmts.is_docstring conf) in
-      let old_docs, old_cmts = split_cmts t_old.comments in
-      let new_docs, new_cmts = split_cmts t_new.comments in
-      Normalize_extended_ast.diff_cmts conf old_cmts new_cmts
-      >>= fun () ->
-      Normalize_extended_ast.diff_docstrings conf old_docs new_docs
+      Normalize_extended_ast.diff_cmts conf t_old.comments t_new.comments
     in
     match errors with
     | Ok () -> ()
diff --git a/test/passing/tests/break_cases-align.ml.err b/test/passing/tests/break_cases-align.ml.err
index afdf36620c..9925d97802 100644
--- a/test/passing/tests/break_cases-align.ml.err
+++ b/test/passing/tests/break_cases-align.ml.err
@@ -2,3 +2,5 @@ Warning: tests/break_cases.ml:68 exceeds the margin
 Warning: tests/break_cases.ml:141 exceeds the margin
 Warning: tests/break_cases.ml:242 exceeds the margin
 Warning: tests/break_cases.ml:250 exceeds the margin
+Warning: tests/break_cases.ml:267 exceeds the margin
+Warning: tests/break_cases.ml:277 exceeds the margin
diff --git a/test/passing/tests/break_cases-align.ml.ref b/test/passing/tests/break_cases-align.ml.ref
index dc56fcb9f5..685f96ea31 100644
--- a/test/passing/tests/break_cases-align.ml.ref
+++ b/test/passing/tests/break_cases-align.ml.ref
@@ -265,8 +265,8 @@ let foooooooooooooo = function
   | Foooooooooo
   | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *)
   | Foooo
-    (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo
-       fooo *) ->
+    (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *)
+    ->
       Foooooooooo.Foooooo
   | Foooo {foooo_fooo= {foooooooooo}} ->
       Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo
@@ -275,6 +275,6 @@ let get_nullability = function
   | ArrayAccess
   | OptimisticFallback (* non-null is the most optimistic type *)
   | Undef
-    (* This is a very special case, assigning non-null is a technical
-       trick *) ->
+    (* This is a very special case, assigning non-null is a technical trick *)
+    ->
       Nullability.Nonnull
diff --git a/test/passing/tests/break_cases-all.ml.err b/test/passing/tests/break_cases-all.ml.err
index afdf36620c..9925d97802 100644
--- a/test/passing/tests/break_cases-all.ml.err
+++ b/test/passing/tests/break_cases-all.ml.err
@@ -2,3 +2,5 @@ Warning: tests/break_cases.ml:68 exceeds the margin
 Warning: tests/break_cases.ml:141 exceeds the margin
 Warning: tests/break_cases.ml:242 exceeds the margin
 Warning: tests/break_cases.ml:250 exceeds the margin
+Warning: tests/break_cases.ml:267 exceeds the margin
+Warning: tests/break_cases.ml:277 exceeds the margin
diff --git a/test/passing/tests/break_cases-all.ml.ref b/test/passing/tests/break_cases-all.ml.ref
index 5a53dad8a6..b4231fcd3b 100644
--- a/test/passing/tests/break_cases-all.ml.ref
+++ b/test/passing/tests/break_cases-all.ml.ref
@@ -265,8 +265,8 @@ let foooooooooooooo = function
   | Foooooooooo
   | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *)
   | Foooo
-    (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo
-       fooo *) ->
+    (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *)
+    ->
       Foooooooooo.Foooooo
   | Foooo {foooo_fooo= {foooooooooo}} ->
       Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo
@@ -275,6 +275,6 @@ let get_nullability = function
   | ArrayAccess
   | OptimisticFallback (* non-null is the most optimistic type *)
   | Undef
-    (* This is a very special case, assigning non-null is a technical
-       trick *) ->
+    (* This is a very special case, assigning non-null is a technical trick *)
+    ->
       Nullability.Nonnull
diff --git a/test/passing/tests/break_cases-closing_on_separate_line.ml.err b/test/passing/tests/break_cases-closing_on_separate_line.ml.err
index f3dfae37a2..0df3c460ce 100644
--- a/test/passing/tests/break_cases-closing_on_separate_line.ml.err
+++ b/test/passing/tests/break_cases-closing_on_separate_line.ml.err
@@ -2,3 +2,5 @@ Warning: tests/break_cases.ml:76 exceeds the margin
 Warning: tests/break_cases.ml:151 exceeds the margin
 Warning: tests/break_cases.ml:255 exceeds the margin
 Warning: tests/break_cases.ml:264 exceeds the margin
+Warning: tests/break_cases.ml:282 exceeds the margin
+Warning: tests/break_cases.ml:292 exceeds the margin
diff --git a/test/passing/tests/break_cases-closing_on_separate_line.ml.ref b/test/passing/tests/break_cases-closing_on_separate_line.ml.ref
index f6c787edcf..6497d7ebd7 100644
--- a/test/passing/tests/break_cases-closing_on_separate_line.ml.ref
+++ b/test/passing/tests/break_cases-closing_on_separate_line.ml.ref
@@ -280,8 +280,8 @@ let foooooooooooooo = function
   | Foooooooooo
   | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *)
   | Foooo
-    (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo
-       fooo *) ->
+    (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *)
+    ->
       Foooooooooo.Foooooo
   | Foooo {foooo_fooo= {foooooooooo}} ->
       Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo
@@ -290,6 +290,6 @@ let get_nullability = function
   | ArrayAccess
   | OptimisticFallback (* non-null is the most optimistic type *)
   | Undef
-    (* This is a very special case, assigning non-null is a technical
-       trick *) ->
+    (* This is a very special case, assigning non-null is a technical trick *)
+    ->
       Nullability.Nonnull
diff --git a/test/passing/tests/break_cases-closing_on_separate_line_leading_nested_match_parens.ml.err b/test/passing/tests/break_cases-closing_on_separate_line_leading_nested_match_parens.ml.err
index f3dfae37a2..0df3c460ce 100644
--- a/test/passing/tests/break_cases-closing_on_separate_line_leading_nested_match_parens.ml.err
+++ b/test/passing/tests/break_cases-closing_on_separate_line_leading_nested_match_parens.ml.err
@@ -2,3 +2,5 @@ Warning: tests/break_cases.ml:76 exceeds the margin
 Warning: tests/break_cases.ml:151 exceeds the margin
 Warning: tests/break_cases.ml:255 exceeds the margin
 Warning: tests/break_cases.ml:264 exceeds the margin
+Warning: tests/break_cases.ml:282 exceeds the margin
+Warning: tests/break_cases.ml:292 exceeds the margin
diff --git a/test/passing/tests/break_cases-closing_on_separate_line_leading_nested_match_parens.ml.ref b/test/passing/tests/break_cases-closing_on_separate_line_leading_nested_match_parens.ml.ref
index 3dfca06fd7..fc957ff0f2 100644
--- a/test/passing/tests/break_cases-closing_on_separate_line_leading_nested_match_parens.ml.ref
+++ b/test/passing/tests/break_cases-closing_on_separate_line_leading_nested_match_parens.ml.ref
@@ -280,8 +280,8 @@ let foooooooooooooo = function
   | Foooooooooo
   | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *)
   | Foooo
-    (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo
-       fooo *) ->
+    (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *)
+    ->
       Foooooooooo.Foooooo
   | Foooo {foooo_fooo= {foooooooooo}} ->
       Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo
@@ -290,6 +290,6 @@ let get_nullability = function
   | ArrayAccess
   | OptimisticFallback (* non-null is the most optimistic type *)
   | Undef
-    (* This is a very special case, assigning non-null is a technical
-       trick *) ->
+    (* This is a very special case, assigning non-null is a technical trick *)
+    ->
       Nullability.Nonnull
diff --git a/test/passing/tests/break_cases-cosl_lnmp_cmei.ml.err b/test/passing/tests/break_cases-cosl_lnmp_cmei.ml.err
index f3dfae37a2..0df3c460ce 100644
--- a/test/passing/tests/break_cases-cosl_lnmp_cmei.ml.err
+++ b/test/passing/tests/break_cases-cosl_lnmp_cmei.ml.err
@@ -2,3 +2,5 @@ Warning: tests/break_cases.ml:76 exceeds the margin
 Warning: tests/break_cases.ml:151 exceeds the margin
 Warning: tests/break_cases.ml:255 exceeds the margin
 Warning: tests/break_cases.ml:264 exceeds the margin
+Warning: tests/break_cases.ml:282 exceeds the margin
+Warning: tests/break_cases.ml:292 exceeds the margin
diff --git a/test/passing/tests/break_cases-cosl_lnmp_cmei.ml.ref b/test/passing/tests/break_cases-cosl_lnmp_cmei.ml.ref
index d1777d5061..1231c2c031 100644
--- a/test/passing/tests/break_cases-cosl_lnmp_cmei.ml.ref
+++ b/test/passing/tests/break_cases-cosl_lnmp_cmei.ml.ref
@@ -280,8 +280,8 @@ let foooooooooooooo = function
   | Foooooooooo
   | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *)
   | Foooo
-    (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo
-       fooo *) ->
+    (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *)
+    ->
       Foooooooooo.Foooooo
   | Foooo {foooo_fooo= {foooooooooo}} ->
       Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo
@@ -290,6 +290,6 @@ let get_nullability = function
   | ArrayAccess
   | OptimisticFallback (* non-null is the most optimistic type *)
   | Undef
-    (* This is a very special case, assigning non-null is a technical
-       trick *) ->
+    (* This is a very special case, assigning non-null is a technical trick *)
+    ->
       Nullability.Nonnull
diff --git a/test/passing/tests/break_cases-fit_or_vertical.ml.err b/test/passing/tests/break_cases-fit_or_vertical.ml.err
index 79d75277be..7065f955b8 100644
--- a/test/passing/tests/break_cases-fit_or_vertical.ml.err
+++ b/test/passing/tests/break_cases-fit_or_vertical.ml.err
@@ -2,3 +2,5 @@ Warning: tests/break_cases.ml:57 exceeds the margin
 Warning: tests/break_cases.ml:119 exceeds the margin
 Warning: tests/break_cases.ml:204 exceeds the margin
 Warning: tests/break_cases.ml:211 exceeds the margin
+Warning: tests/break_cases.ml:228 exceeds the margin
+Warning: tests/break_cases.ml:237 exceeds the margin
diff --git a/test/passing/tests/break_cases-fit_or_vertical.ml.ref b/test/passing/tests/break_cases-fit_or_vertical.ml.ref
index e0821f1d20..a78915f100 100644
--- a/test/passing/tests/break_cases-fit_or_vertical.ml.ref
+++ b/test/passing/tests/break_cases-fit_or_vertical.ml.ref
@@ -226,8 +226,8 @@ let foooooooooooooo = function
   | Foooooooooo
   | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *)
   | Foooo
-    (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo
-       fooo *) -> Foooooooooo.Foooooo
+    (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *)
+    -> Foooooooooo.Foooooo
   | Foooo {foooo_fooo= {foooooooooo}} ->
       Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo
 
@@ -235,5 +235,5 @@ let get_nullability = function
   | ArrayAccess
   | OptimisticFallback (* non-null is the most optimistic type *)
   | Undef
-    (* This is a very special case, assigning non-null is a technical
-       trick *) -> Nullability.Nonnull
+    (* This is a very special case, assigning non-null is a technical trick *)
+    -> Nullability.Nonnull
diff --git a/test/passing/tests/break_cases-nested.ml.err b/test/passing/tests/break_cases-nested.ml.err
index cca3923b28..3eb8d2b980 100644
--- a/test/passing/tests/break_cases-nested.ml.err
+++ b/test/passing/tests/break_cases-nested.ml.err
@@ -2,3 +2,5 @@ Warning: tests/break_cases.ml:53 exceeds the margin
 Warning: tests/break_cases.ml:116 exceeds the margin
 Warning: tests/break_cases.ml:206 exceeds the margin
 Warning: tests/break_cases.ml:215 exceeds the margin
+Warning: tests/break_cases.ml:233 exceeds the margin
+Warning: tests/break_cases.ml:243 exceeds the margin
diff --git a/test/passing/tests/break_cases-nested.ml.ref b/test/passing/tests/break_cases-nested.ml.ref
index f0956e7f5b..7b5304737b 100644
--- a/test/passing/tests/break_cases-nested.ml.ref
+++ b/test/passing/tests/break_cases-nested.ml.ref
@@ -231,8 +231,8 @@ let foooooooooooooo = function
   | Foooooooooo
   | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *)
   | Foooo
-    (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo
-       fooo *) ->
+    (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *)
+    ->
       Foooooooooo.Foooooo
   | Foooo {foooo_fooo= {foooooooooo}} ->
       Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo
@@ -241,6 +241,6 @@ let get_nullability = function
   | ArrayAccess
   | OptimisticFallback (* non-null is the most optimistic type *)
   | Undef
-    (* This is a very special case, assigning non-null is a technical
-       trick *) ->
+    (* This is a very special case, assigning non-null is a technical trick *)
+    ->
       Nullability.Nonnull
diff --git a/test/passing/tests/break_cases-normal_indent.ml.err b/test/passing/tests/break_cases-normal_indent.ml.err
index afdf36620c..9925d97802 100644
--- a/test/passing/tests/break_cases-normal_indent.ml.err
+++ b/test/passing/tests/break_cases-normal_indent.ml.err
@@ -2,3 +2,5 @@ Warning: tests/break_cases.ml:68 exceeds the margin
 Warning: tests/break_cases.ml:141 exceeds the margin
 Warning: tests/break_cases.ml:242 exceeds the margin
 Warning: tests/break_cases.ml:250 exceeds the margin
+Warning: tests/break_cases.ml:267 exceeds the margin
+Warning: tests/break_cases.ml:277 exceeds the margin
diff --git a/test/passing/tests/break_cases-normal_indent.ml.ref b/test/passing/tests/break_cases-normal_indent.ml.ref
index b0e74cc93b..3cd85e813c 100644
--- a/test/passing/tests/break_cases-normal_indent.ml.ref
+++ b/test/passing/tests/break_cases-normal_indent.ml.ref
@@ -265,8 +265,8 @@ let foooooooooooooo = function
   | Foooooooooo
   | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *)
   | Foooo
-    (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo
-       fooo *) ->
+    (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *)
+    ->
       Foooooooooo.Foooooo
   | Foooo {foooo_fooo= {foooooooooo}} ->
       Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo
@@ -275,6 +275,6 @@ let get_nullability = function
   | ArrayAccess
   | OptimisticFallback (* non-null is the most optimistic type *)
   | Undef
-    (* This is a very special case, assigning non-null is a technical
-       trick *) ->
+    (* This is a very special case, assigning non-null is a technical trick *)
+    ->
       Nullability.Nonnull
diff --git a/test/passing/tests/break_cases-toplevel.ml.err b/test/passing/tests/break_cases-toplevel.ml.err
index 949e8ed317..d1b6fd8e99 100644
--- a/test/passing/tests/break_cases-toplevel.ml.err
+++ b/test/passing/tests/break_cases-toplevel.ml.err
@@ -2,3 +2,5 @@ Warning: tests/break_cases.ml:59 exceeds the margin
 Warning: tests/break_cases.ml:122 exceeds the margin
 Warning: tests/break_cases.ml:208 exceeds the margin
 Warning: tests/break_cases.ml:216 exceeds the margin
+Warning: tests/break_cases.ml:233 exceeds the margin
+Warning: tests/break_cases.ml:243 exceeds the margin
diff --git a/test/passing/tests/break_cases-toplevel.ml.ref b/test/passing/tests/break_cases-toplevel.ml.ref
index 6bda2cfa16..8b3c057e6a 100644
--- a/test/passing/tests/break_cases-toplevel.ml.ref
+++ b/test/passing/tests/break_cases-toplevel.ml.ref
@@ -227,12 +227,12 @@ let foooooooooooooo = function
      Foooooooooooooooooooooooooooooooooooo foooooooooooooooooooooooo foooooo.
      Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo
      foooooooooooooooooo foooooooo. Foooooooooooo fooooooooooo fooooooooooooo
-     foooooooooooooo foooooo. *)
+     foooooooooooooo foooooo.*)
   | Foooooooooo
   | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *)
   | Foooo
-    (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo
-       fooo *) ->
+    (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *)
+    ->
       Foooooooooo.Foooooo
   | Foooo {foooo_fooo= {foooooooooo}} ->
       Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo
@@ -241,6 +241,6 @@ let get_nullability = function
   | ArrayAccess
   | OptimisticFallback (* non-null is the most optimistic type *)
   | Undef
-    (* This is a very special case, assigning non-null is a technical
-       trick *) ->
+    (* This is a very special case, assigning non-null is a technical trick *)
+    ->
       Nullability.Nonnull
diff --git a/test/passing/tests/break_cases-vertical.ml.err b/test/passing/tests/break_cases-vertical.ml.err
index e9b75397df..ac5edda8df 100644
--- a/test/passing/tests/break_cases-vertical.ml.err
+++ b/test/passing/tests/break_cases-vertical.ml.err
@@ -2,3 +2,5 @@ Warning: tests/break_cases.ml:80 exceeds the margin
 Warning: tests/break_cases.ml:159 exceeds the margin
 Warning: tests/break_cases.ml:273 exceeds the margin
 Warning: tests/break_cases.ml:281 exceeds the margin
+Warning: tests/break_cases.ml:299 exceeds the margin
+Warning: tests/break_cases.ml:309 exceeds the margin
diff --git a/test/passing/tests/break_cases-vertical.ml.ref b/test/passing/tests/break_cases-vertical.ml.ref
index d0c5bb73a5..b328bdcd53 100644
--- a/test/passing/tests/break_cases-vertical.ml.ref
+++ b/test/passing/tests/break_cases-vertical.ml.ref
@@ -297,8 +297,8 @@ let foooooooooooooo = function
   | Foooooooooo
   | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *)
   | Foooo
-    (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo
-       fooo *) ->
+    (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *)
+    ->
       Foooooooooo.Foooooo
   | Foooo {foooo_fooo= {foooooooooo}} ->
       Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo
@@ -307,6 +307,6 @@ let get_nullability = function
   | ArrayAccess
   | OptimisticFallback (* non-null is the most optimistic type *)
   | Undef
-    (* This is a very special case, assigning non-null is a technical
-       trick *) ->
+    (* This is a very special case, assigning non-null is a technical trick *)
+    ->
       Nullability.Nonnull
diff --git a/test/passing/tests/break_cases.ml.err b/test/passing/tests/break_cases.ml.err
index 458af7e802..5aeb7f3422 100644
--- a/test/passing/tests/break_cases.ml.err
+++ b/test/passing/tests/break_cases.ml.err
@@ -2,3 +2,5 @@ Warning: tests/break_cases.ml:47 exceeds the margin
 Warning: tests/break_cases.ml:104 exceeds the margin
 Warning: tests/break_cases.ml:180 exceeds the margin
 Warning: tests/break_cases.ml:188 exceeds the margin
+Warning: tests/break_cases.ml:205 exceeds the margin
+Warning: tests/break_cases.ml:215 exceeds the margin
diff --git a/test/passing/tests/break_cases.ml.ref b/test/passing/tests/break_cases.ml.ref
index 49918f0249..6e2a9afb16 100644
--- a/test/passing/tests/break_cases.ml.ref
+++ b/test/passing/tests/break_cases.ml.ref
@@ -199,12 +199,12 @@ let foooooooooooooo = function
      Foooooooooooooooooooooooooooooooooooo foooooooooooooooooooooooo foooooo.
      Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo
      foooooooooooooooooo foooooooo. Foooooooooooo fooooooooooo fooooooooooooo
-     foooooooooooooo foooooo. *)
+     foooooooooooooo foooooo.*)
   | Foooooooooo
   | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *)
   | Foooo
-    (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo
-       fooo *) ->
+    (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *)
+    ->
       Foooooooooo.Foooooo
   | Foooo {foooo_fooo= {foooooooooo}} ->
       Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo
@@ -213,6 +213,6 @@ let get_nullability = function
   | ArrayAccess
   | OptimisticFallback (* non-null is the most optimistic type *)
   | Undef
-    (* This is a very special case, assigning non-null is a technical
-       trick *) ->
+    (* This is a very special case, assigning non-null is a technical trick *)
+    ->
       Nullability.Nonnull
diff --git a/test/passing/tests/break_separators-after.ml.err b/test/passing/tests/break_separators-after.ml.err
new file mode 100644
index 0000000000..7de3e58d2b
--- /dev/null
+++ b/test/passing/tests/break_separators-after.ml.err
@@ -0,0 +1 @@
+Warning: tests/break_separators.ml:289 exceeds the margin
diff --git a/test/passing/tests/break_separators-after.ml.ref b/test/passing/tests/break_separators-after.ml.ref
index 5353f8eef8..a3d77ee546 100644
--- a/test/passing/tests/break_separators-after.ml.ref
+++ b/test/passing/tests/break_separators-after.ml.ref
@@ -287,8 +287,7 @@ let foooooooooooo =
 
 let foooooooooooo =
   { foooooooooooooo with
-    (* foooooooooooooooo fooooooooooooooooooooooooo
-       foooooooooooooooooooooo *)
+    (* foooooooooooooooo fooooooooooooooooooooooooo foooooooooooooooooooooo *)
     fooooooooooooooooooooooooooooo= fooooooooooooo;
     fooooooooooooo= foooooooooooooo }
 
diff --git a/test/passing/tests/break_separators-after_docked.ml.err b/test/passing/tests/break_separators-after_docked.ml.err
index 2ccd970c7d..fd77cc8910 100644
--- a/test/passing/tests/break_separators-after_docked.ml.err
+++ b/test/passing/tests/break_separators-after_docked.ml.err
@@ -1 +1,2 @@
-Warning: tests/break_separators.ml:335 exceeds the margin
+Warning: tests/break_separators.ml:324 exceeds the margin
+Warning: tests/break_separators.ml:334 exceeds the margin
diff --git a/test/passing/tests/break_separators-after_docked.ml.ref b/test/passing/tests/break_separators-after_docked.ml.ref
index ae435ee3a2..325930a4f4 100644
--- a/test/passing/tests/break_separators-after_docked.ml.ref
+++ b/test/passing/tests/break_separators-after_docked.ml.ref
@@ -322,8 +322,7 @@ let foooooooooooo =
 let foooooooooooo =
   {
     foooooooooooooo with
-    (* foooooooooooooooo fooooooooooooooooooooooooo
-       foooooooooooooooooooooo *)
+    (* foooooooooooooooo fooooooooooooooooooooooooo foooooooooooooooooooooo *)
     fooooooooooooooooooooooooooooo= fooooooooooooo;
     fooooooooooooo= foooooooooooooo;
   }
diff --git a/test/passing/tests/break_separators-before_docked.ml.err b/test/passing/tests/break_separators-before_docked.ml.err
new file mode 100644
index 0000000000..43e94ebf2b
--- /dev/null
+++ b/test/passing/tests/break_separators-before_docked.ml.err
@@ -0,0 +1 @@
+Warning: tests/break_separators.ml:324 exceeds the margin
diff --git a/test/passing/tests/break_separators-before_docked.ml.ref b/test/passing/tests/break_separators-before_docked.ml.ref
index 7d0f75e25e..63a5e062e7 100644
--- a/test/passing/tests/break_separators-before_docked.ml.ref
+++ b/test/passing/tests/break_separators-before_docked.ml.ref
@@ -322,8 +322,7 @@ let foooooooooooo =
 let foooooooooooo =
   {
     foooooooooooooo with
-    (* foooooooooooooooo fooooooooooooooooooooooooo
-       foooooooooooooooooooooo *)
+    (* foooooooooooooooo fooooooooooooooooooooooooo foooooooooooooooooooooo *)
     fooooooooooooooooooooooooooooo= fooooooooooooo
   ; fooooooooooooo= foooooooooooooo
   }
diff --git a/test/passing/tests/break_separators.ml b/test/passing/tests/break_separators.ml
index 29a972901e..5d5af4f814 100644
--- a/test/passing/tests/break_separators.ml
+++ b/test/passing/tests/break_separators.ml
@@ -287,8 +287,7 @@ let foooooooooooo =
 
 let foooooooooooo =
   { foooooooooooooo with
-    (* foooooooooooooooo fooooooooooooooooooooooooo
-       foooooooooooooooooooooo *)
+    (* foooooooooooooooo fooooooooooooooooooooooooo foooooooooooooooooooooo *)
     fooooooooooooooooooooooooooooo= fooooooooooooo
   ; fooooooooooooo= foooooooooooooo }
 
diff --git a/test/passing/tests/break_separators.ml.err b/test/passing/tests/break_separators.ml.err
new file mode 100644
index 0000000000..7de3e58d2b
--- /dev/null
+++ b/test/passing/tests/break_separators.ml.err
@@ -0,0 +1 @@
+Warning: tests/break_separators.ml:289 exceeds the margin
diff --git a/test/passing/tests/error4.ml.ref b/test/passing/tests/error4.ml.ref
index 694725ec0a..a3f31480e2 100644
--- a/test/passing/tests/error4.ml.ref
+++ b/test/passing/tests/error4.ml.ref
@@ -2,4 +2,5 @@
 let a = ()
 
 (** a or b *)
-let b = (** ? *) ()
+let b = (** ?
+          *) ()
diff --git a/test/passing/tests/source.ml.ref b/test/passing/tests/source.ml.ref
index 29234fddd3..21c25ea2fe 100644
--- a/test/passing/tests/source.ml.ref
+++ b/test/passing/tests/source.ml.ref
@@ -1476,10 +1476,10 @@ let ty_list : type a e. (a, e) ty -> (a vlist, e) ty =
 
    and (_,_) ty_pvar = | Pnil : ('a,'e) ty_pvar | Pconst : 't * ('b,'e)
    ty_pvar -> ('t -> 'b, 'e) ty_pvar | Parg : 't * ('a,'e) ty * ('b,'e)
-   ty_pvar -> ('t * 'a -> 'b, 'e) ty_pvar *)
+   ty_pvar -> ('t * 'a -> 'b, 'e) ty_pvar*)
 (* An attempt at encoding omega examples from the 2nd Central European
    Functional Programming School: Generic Programming in Omega, by Tim Sheard
-   and Nathan Linger http://web.cecs.pdx.edu/~sheard/ *)
+   and Nathan Linger http://web.cecs.pdx.edu/~sheard/*)
 
 (* Basic types *)
 
@@ -1661,7 +1661,7 @@ type (_, _) diff = Diff : 'c nat * ('a, 'c, 'b) plus -> ('a, 'b) diff
 (* let rec diff : type a b. (a,b) le -> a nat -> b nat -> (a,b) diff = fun le
    a b -> match a, b, le with | NZ, m, _ -> Diff (m, PlusZ m) | NS x, NZ, _
    -> assert false | NS x, NS y, q -> match diff (smaller q) x y with Diff
-   (m, p) -> Diff (m, PlusS p) ;; *)
+   (m, p) -> Diff (m, PlusS p) ;;*)
 
 let rec diff : type a b. (a, b) le -> a nat -> b nat -> (a, b) diff =
  fun le a b ->
@@ -3163,7 +3163,7 @@ Error: Types marked with the immediate attribute must be
    function definition, match clauses, and let ... in.
 
    New: implicit pack is also supported, and you only need to be able to
-   infer the the module type path from the context. *)
+   infer the the module type path from the context.*)
 (* ocaml -principal *)
 
 (* Use a module pattern *)
@@ -4386,7 +4386,7 @@ let f3 (x : M'.t) : Std2.M.t = x
 
    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 *)
+   (Coverage.t, 'a) Hashtbl2.t end*)
 module type INCLUDING = sig
   include module type of List
 
@@ -4564,7 +4564,7 @@ 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 *)
+   Html5_types.div Html5.elt and type u = < foo: Html5.uri > end*)
 module type S = sig
   include Set.S
 
@@ -4779,7 +4779,7 @@ 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) *)
+   (cast bad 42)*)
 module M = struct
   module type S = sig
     type a
@@ -5002,7 +5002,7 @@ module type S' = S with module M := String
    Hashtbl.S and module Make := Hashtbl.Make and module MakeSeeded :=
    Hashtbl.MakeSeeded and module type SeededS := Hashtbl.SeededS and module
    type HashedType := Hashtbl.HashedType and module type SeededHashedType :=
-   Hashtbl.SeededHashedType) end;; *)
+   Hashtbl.SeededHashedType) end;;*)
 
 (* A subtle problem appearing with -principal *)
 type -'a t
@@ -5432,7 +5432,7 @@ end
    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 *) *)
+   invariants are broken *)*)
 
 (* Check behavior with submodules *)
 module M = struct
@@ -5619,11 +5619,11 @@ end = struct
 end
 
 (* The following introduces a (useless) dependency on A: module C : sig
-   module L : module type of List end = A *)
+   module L : module type of List end = A*)
 
 include D'
 
-(* let () = print_endline (string_of_int D'.M.y) *)
+(* let () = print_endline (string_of_int D'.M.y)*)
 open A
 
 let f = L.map S.capitalize
@@ -5637,7 +5637,7 @@ end = struct
 end
 
 (* The following introduces a (useless) dependency on A: module C : sig
-   module L : module type of List end = A *)
+   module L : module type of List end = A*)
 
 (* No dependency on D *)
 let x = 3
@@ -5840,7 +5840,7 @@ let f (x : entity entity_container) = ()
 
    method add_entity (s : entity) = entity_container#add_entity (s :> entity)
 
-   end *)
+   end*)
 (* Two v's in the same class *)
 class c v =
   object
@@ -6282,8 +6282,7 @@ module M : sig
 end = struct
   type refer = {poly: 'a 'b 'c. (('b, 'c) #Classdef.cl2 as 'a)}
 end
-(* ocamlc -c pr3918a.mli pr3918b.mli rm -f pr3918a.cmi ocamlc -c
-   pr3918c.ml *)
+(* ocamlc -c pr3918a.mli pr3918b.mli rm -f pr3918a.cmi ocamlc -c pr3918c.ml*)
 
 open Pr3918b
 
@@ -7140,7 +7139,7 @@ let _ =
 (* Early strict evaluation *)
 
 (* module rec Cyclic : sig val x : int end = struct let x = Cyclic.x + 1 end
-   ;; *)
+   ;;*)
 
 (* Reordering of evaluation based on dependencies *)
 

From 9caf607c56be13b15eda52c0c1e13d0e769fa178 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Fri, 26 May 2023 15:52:56 +0200
Subject: [PATCH 062/115] Fix lost ending space

---
 lib/Cmt.ml                                    |  2 +-
 .../passing/tests/break_cases-toplevel.ml.ref |  2 +-
 test/passing/tests/break_cases.ml.ref         |  2 +-
 test/passing/tests/source.ml.err              |  1 +
 test/passing/tests/source.ml.ref              | 30 +++++++++----------
 5 files changed, 19 insertions(+), 18 deletions(-)

diff --git a/lib/Cmt.ml b/lib/Cmt.ml
index a837f5ed51..b36646c810 100644
--- a/lib/Cmt.ml
+++ b/lib/Cmt.ml
@@ -176,7 +176,7 @@ let decode {txt; loc} =
       (* | [""; ""] when conf.fmt_opts.ocp_indent_compat.v -> *)
       | [""; ""] -> mk (Verbatim " ")
       | [txt] -> mk (Normal txt)
-      | [txt; ""] -> mk ~prefix:" " (Normal txt)
+      | [txt; ""] -> mk ~suffix:" " (Normal txt)
       | lines -> mk (Asterisk_prefixed lines) )
   else
     match txt with
diff --git a/test/passing/tests/break_cases-toplevel.ml.ref b/test/passing/tests/break_cases-toplevel.ml.ref
index 8b3c057e6a..cf28bf4262 100644
--- a/test/passing/tests/break_cases-toplevel.ml.ref
+++ b/test/passing/tests/break_cases-toplevel.ml.ref
@@ -227,7 +227,7 @@ let foooooooooooooo = function
      Foooooooooooooooooooooooooooooooooooo foooooooooooooooooooooooo foooooo.
      Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo
      foooooooooooooooooo foooooooo. Foooooooooooo fooooooooooo fooooooooooooo
-     foooooooooooooo foooooo.*)
+     foooooooooooooo foooooo. *)
   | Foooooooooo
   | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *)
   | Foooo
diff --git a/test/passing/tests/break_cases.ml.ref b/test/passing/tests/break_cases.ml.ref
index 6e2a9afb16..6a08470bd0 100644
--- a/test/passing/tests/break_cases.ml.ref
+++ b/test/passing/tests/break_cases.ml.ref
@@ -199,7 +199,7 @@ let foooooooooooooo = function
      Foooooooooooooooooooooooooooooooooooo foooooooooooooooooooooooo foooooo.
      Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo
      foooooooooooooooooo foooooooo. Foooooooooooo fooooooooooo fooooooooooooo
-     foooooooooooooo foooooo.*)
+     foooooooooooooo foooooo. *)
   | Foooooooooo
   | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *)
   | Foooo
diff --git a/test/passing/tests/source.ml.err b/test/passing/tests/source.ml.err
index 50f7e55a5d..d6e87d109e 100644
--- a/test/passing/tests/source.ml.err
+++ b/test/passing/tests/source.ml.err
@@ -1,2 +1,3 @@
 Warning: tests/source.ml:702 exceeds the margin
 Warning: tests/source.ml:2318 exceeds the margin
+Warning: tests/source.ml:6284 exceeds the margin
diff --git a/test/passing/tests/source.ml.ref b/test/passing/tests/source.ml.ref
index 21c25ea2fe..e948cdfce3 100644
--- a/test/passing/tests/source.ml.ref
+++ b/test/passing/tests/source.ml.ref
@@ -1476,10 +1476,10 @@ let ty_list : type a e. (a, e) ty -> (a vlist, e) ty =
 
    and (_,_) ty_pvar = | Pnil : ('a,'e) ty_pvar | Pconst : 't * ('b,'e)
    ty_pvar -> ('t -> 'b, 'e) ty_pvar | Parg : 't * ('a,'e) ty * ('b,'e)
-   ty_pvar -> ('t * 'a -> 'b, 'e) ty_pvar*)
+   ty_pvar -> ('t * 'a -> 'b, 'e) ty_pvar *)
 (* An attempt at encoding omega examples from the 2nd Central European
    Functional Programming School: Generic Programming in Omega, by Tim Sheard
-   and Nathan Linger http://web.cecs.pdx.edu/~sheard/*)
+   and Nathan Linger http://web.cecs.pdx.edu/~sheard/ *)
 
 (* Basic types *)
 
@@ -1661,7 +1661,7 @@ type (_, _) diff = Diff : 'c nat * ('a, 'c, 'b) plus -> ('a, 'b) diff
 (* let rec diff : type a b. (a,b) le -> a nat -> b nat -> (a,b) diff = fun le
    a b -> match a, b, le with | NZ, m, _ -> Diff (m, PlusZ m) | NS x, NZ, _
    -> assert false | NS x, NS y, q -> match diff (smaller q) x y with Diff
-   (m, p) -> Diff (m, PlusS p) ;;*)
+   (m, p) -> Diff (m, PlusS p) ;; *)
 
 let rec diff : type a b. (a, b) le -> a nat -> b nat -> (a, b) diff =
  fun le a b ->
@@ -3163,7 +3163,7 @@ Error: Types marked with the immediate attribute must be
    function definition, match clauses, and let ... in.
 
    New: implicit pack is also supported, and you only need to be able to
-   infer the the module type path from the context.*)
+   infer the the module type path from the context. *)
 (* ocaml -principal *)
 
 (* Use a module pattern *)
@@ -4386,7 +4386,7 @@ let f3 (x : M'.t) : Std2.M.t = x
 
    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*)
+   (Coverage.t, 'a) Hashtbl2.t end *)
 module type INCLUDING = sig
   include module type of List
 
@@ -4564,7 +4564,7 @@ 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*)
+   Html5_types.div Html5.elt and type u = < foo: Html5.uri > end *)
 module type S = sig
   include Set.S
 
@@ -4779,7 +4779,7 @@ 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)*)
+   (cast bad 42) *)
 module M = struct
   module type S = sig
     type a
@@ -5002,7 +5002,7 @@ module type S' = S with module M := String
    Hashtbl.S and module Make := Hashtbl.Make and module MakeSeeded :=
    Hashtbl.MakeSeeded and module type SeededS := Hashtbl.SeededS and module
    type HashedType := Hashtbl.HashedType and module type SeededHashedType :=
-   Hashtbl.SeededHashedType) end;;*)
+   Hashtbl.SeededHashedType) end;; *)
 
 (* A subtle problem appearing with -principal *)
 type -'a t
@@ -5432,7 +5432,7 @@ end
    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 *)*)
+   invariants are broken *) *)
 
 (* Check behavior with submodules *)
 module M = struct
@@ -5619,11 +5619,11 @@ end = struct
 end
 
 (* The following introduces a (useless) dependency on A: module C : sig
-   module L : module type of List end = A*)
+   module L : module type of List end = A *)
 
 include D'
 
-(* let () = print_endline (string_of_int D'.M.y)*)
+(* let () = print_endline (string_of_int D'.M.y) *)
 open A
 
 let f = L.map S.capitalize
@@ -5637,7 +5637,7 @@ end = struct
 end
 
 (* The following introduces a (useless) dependency on A: module C : sig
-   module L : module type of List end = A*)
+   module L : module type of List end = A *)
 
 (* No dependency on D *)
 let x = 3
@@ -5840,7 +5840,7 @@ let f (x : entity entity_container) = ()
 
    method add_entity (s : entity) = entity_container#add_entity (s :> entity)
 
-   end*)
+   end *)
 (* Two v's in the same class *)
 class c v =
   object
@@ -6282,7 +6282,7 @@ module M : sig
 end = struct
   type refer = {poly: 'a 'b 'c. (('b, 'c) #Classdef.cl2 as 'a)}
 end
-(* ocamlc -c pr3918a.mli pr3918b.mli rm -f pr3918a.cmi ocamlc -c pr3918c.ml*)
+(* ocamlc -c pr3918a.mli pr3918b.mli rm -f pr3918a.cmi ocamlc -c pr3918c.ml *)
 
 open Pr3918b
 
@@ -7139,7 +7139,7 @@ let _ =
 (* Early strict evaluation *)
 
 (* module rec Cyclic : sig val x : int end = struct let x = Cyclic.x + 1 end
-   ;;*)
+   ;; *)
 
 (* Reordering of evaluation based on dependencies *)
 

From 207f471411d18555cef023dee650dc2768f43e7d Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Fri, 26 May 2023 17:11:39 +0200
Subject: [PATCH 063/115] Promote

---
 lib-rpc-server/ocamlformat_rpc.ml               |  3 +--
 test/passing/tests/comment_header.ml.ref        | 16 +++++-----------
 test/passing/tests/comments.ml.err              |  5 ++++-
 test/passing/tests/comments.ml.ref              |  9 +++------
 test/passing/tests/doc_comments-no-wrap.mli.ref |  4 ++--
 test/passing/tests/polytypes-janestreet.ml.ref  |  3 ++-
 6 files changed, 17 insertions(+), 23 deletions(-)

diff --git a/lib-rpc-server/ocamlformat_rpc.ml b/lib-rpc-server/ocamlformat_rpc.ml
index c9799d888a..002b4ab556 100644
--- a/lib-rpc-server/ocamlformat_rpc.ml
+++ b/lib-rpc-server/ocamlformat_rpc.ml
@@ -85,8 +85,7 @@ let run_format conf x =
        `ocamlformat` processes it as a use file (toplevel phrases) anyway.
 
        `ocaml-lsp` should use core types, module types and signatures.
-       `ocaml-mdx` should use toplevel phrases, expressions and
-       signatures. *)
+       `ocaml-mdx` should use toplevel phrases, expressions and signatures. *)
     [ format Core_type
     ; format Signature
     ; format Module_type
diff --git a/test/passing/tests/comment_header.ml.ref b/test/passing/tests/comment_header.ml.ref
index 116c600c55..0dcca6e010 100644
--- a/test/passing/tests/comment_header.ml.ref
+++ b/test/passing/tests/comment_header.ml.ref
@@ -45,14 +45,8 @@ type typ = typ
 
 (* TEST arguments = "???" *)
 
-(* On Windows the runtime expand windows wildcards (asterisks and
- * question marks).
- *
- * This file is a non-regression test for github's PR#1623.
- *
- * On Windows 64bits, a segfault was triggered when one argument consists
- * only of wildcards.
- *
- * The source code of this test is empty: we just check the arguments
- * expansion.
- * *)
+(* On Windows the runtime expand windows wildcards (asterisks and * question
+   marks). * * This file is a non-regression test for github's PR#1623. * *
+   On Windows 64bits, a segfault was triggered when one argument consists *
+   only of wildcards. * * The source code of this test is empty: we just
+   check the arguments * expansion. * *)
diff --git a/test/passing/tests/comments.ml.err b/test/passing/tests/comments.ml.err
index 614b25d687..8eac92d41d 100644
--- a/test/passing/tests/comments.ml.err
+++ b/test/passing/tests/comments.ml.err
@@ -1 +1,4 @@
-Warning: tests/comments.ml:250 exceeds the margin
+Warning: tests/comments.ml:186 exceeds the margin
+Warning: tests/comments.ml:249 exceeds the margin
+Warning: tests/comments.ml:384 exceeds the margin
+Warning: tests/comments.ml:416 exceeds the margin
diff --git a/test/passing/tests/comments.ml.ref b/test/passing/tests/comments.ml.ref
index bfd372971a..5d67fdb91b 100644
--- a/test/passing/tests/comments.ml.ref
+++ b/test/passing/tests/comments.ml.ref
@@ -184,8 +184,7 @@ let () =
   (* *)
   ()
 
-(* break when unicode sequence length measured in bytes but ¬ in code
-   points *)
+(* break when unicode sequence length measured in bytes but ¬ in code points *)
 
 type t =
   | Aaaaaaaaaa
@@ -383,8 +382,7 @@ 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 *)
+    #= (* convert from foos to bars blah blah blah blah blah blah blah blah *)
     foooooooooooooooooooooooo
     foooooooooooooooo fooooooooooooooo
 
@@ -416,7 +414,6 @@ type a = b (* a *) as (* b *) 'c (* c *)
 type t =
   { (* comment before mutable *)
     mutable
-      (* really long comment that doesn't fit on the same line as other
-         stuff *)
+      (* really long comment that doesn't fit on the same line as other stuff *)
       x:
       int }
diff --git a/test/passing/tests/doc_comments-no-wrap.mli.ref b/test/passing/tests/doc_comments-no-wrap.mli.ref
index 3e36eb81af..b8682fd314 100644
--- a/test/passing/tests/doc_comments-no-wrap.mli.ref
+++ b/test/passing/tests/doc_comments-no-wrap.mli.ref
@@ -426,7 +426,7 @@ end
 
     {[
       (** This is a comment with code inside [ let code inside = f inside ] *)
-      let code inside (* comment   *) = f inside
+      let code inside (* comment *) = f inside
     ]}
 
     Code block with metadata:
@@ -439,7 +439,7 @@ end
     ]}
     {@ocaml kind=toplevel env=e1[
       (** This is a comment with code inside [ let code inside = f inside ] *)
-      let code inside (* comment   *) = f inside
+      let code inside (* comment *) = f inside
     ]} *)
 
 (** {e foooooooo oooooooooo ooooooooo ooooooooo}
diff --git a/test/passing/tests/polytypes-janestreet.ml.ref b/test/passing/tests/polytypes-janestreet.ml.ref
index 0787402439..8868f3cb2f 100644
--- a/test/passing/tests/polytypes-janestreet.ml.ref
+++ b/test/passing/tests/polytypes-janestreet.ml.ref
@@ -26,7 +26,8 @@ let t4 :
 ;;
 
 let foo : type a. a =
-  (* aaaaaa *)
+  (* aaaaaa 
+     *)
   failwith "foo"
 ;;
 

From 86ff2e4f17073e24977826011769f61796c8a219 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Fri, 26 May 2023 17:13:28 +0200
Subject: [PATCH 064/115] WIP: Rewrite parsing of normal and asterisk prefixed
 comments

A few regressions
---
 lib/Cmt.ml                                    | 48 ++++----------
 lib/Cmt.mli                                   |  2 +-
 lib/Cmts.ml                                   | 65 +++++++++++--------
 lib/Conf.ml                                   |  3 +-
 lib/Fmt.ml                                    | 36 ----------
 lib/Fmt.mli                                   |  5 --
 lib/Fmt_ast.ml                                |  3 +-
 lib/Normalize_std_ast.ml                      |  3 +-
 test/passing/tests/infix_bind-break.ml.err    |  2 +
 test/passing/tests/infix_bind-break.ml.ref    | 20 +++---
 .../infix_bind-fit_or_vertical-break.ml.err   |  2 +
 .../infix_bind-fit_or_vertical-break.ml.ref   | 20 +++---
 .../tests/infix_bind-fit_or_vertical.ml.ref   | 14 ++--
 test/passing/tests/infix_bind.ml              | 14 ++--
 test/passing/tests/js_args.ml.err             |  1 +
 test/passing/tests/js_args.ml.ref             |  3 +-
 16 files changed, 95 insertions(+), 146 deletions(-)
 create mode 100644 test/passing/tests/infix_bind-break.ml.err
 create mode 100644 test/passing/tests/infix_bind-fit_or_vertical-break.ml.err
 create mode 100644 test/passing/tests/js_args.ml.err

diff --git a/lib/Cmt.ml b/lib/Cmt.ml
index b36646c810..a8d375c5b3 100644
--- a/lib/Cmt.ml
+++ b/lib/Cmt.ml
@@ -122,33 +122,14 @@ let unindent_lines ~opn_pos txt =
   | [] -> []
   | hd :: tl -> unindent_lines ~opn_pos hd tl
 
-let split_asterisk_prefixed ~opn_pos txt =
-  let len = Position.column opn_pos + 3 in
-  let pat =
-    String.Search_pattern.create
-      (String.init len ~f:(function
-        | 0 -> '\n'
-        | n when n < len - 1 -> ' '
-        | _ -> '*' ) )
-  in
-  let rec split_ pos =
-    match String.Search_pattern.index pat ~pos ~in_:txt with
-    | Some 0 -> "" :: split_ len
-    | Some idx -> String.sub txt ~pos ~len:(idx - pos) :: split_ (idx + len)
-    | _ ->
-        let drop = function ' ' | '\t' -> true | _ -> false in
-        let line = String.rstrip ~drop (String.drop_prefix txt pos) in
-        if String.is_empty line then [" "]
-        else if Char.equal line.[String.length line - 1] '\n' then
-          [String.drop_suffix line 1; ""]
-        else if Char.is_whitespace txt.[String.length txt - 1] then
-          [line ^ " "]
-        else [line]
-  in
-  split_ 0
+let split_asterisk_prefixed lines =
+  if List.for_all ~f:(String.is_prefix ~prefix:"*") lines then
+    Some (List.map lines ~f:(fun s -> String.drop_prefix s 1))
+  else None
+
+let mk ?(prefix = "") ?(suffix = "") kind = {prefix; suffix; kind}
 
 let decode {txt; loc} =
-  let mk ?(prefix = "") ?(suffix = "") kind = {prefix; suffix; kind} in
   let txt =
     (* Windows compatibility *)
     let f = function '\r' -> false | _ -> true in
@@ -170,19 +151,18 @@ let decode {txt; loc} =
     | '=' -> mk (Verbatim txt)
     | '*' -> mk ~prefix:"*" (Doc (String.drop_prefix txt 1))
     | _ -> (
-      match split_asterisk_prefixed ~opn_pos txt with
-      | [] | [""] -> impossible "not produced by split_asterisk_prefixed"
-      (* Comments like [(*\n*)] would be normalized as [(* *)] *)
-      (* | [""; ""] when conf.fmt_opts.ocp_indent_compat.v -> *)
-      | [""; ""] -> mk (Verbatim " ")
-      | [txt] -> mk (Normal txt)
-      | [txt; ""] -> mk ~suffix:" " (Normal txt)
-      | lines -> mk (Asterisk_prefixed lines) )
+        let prefix = if String.starts_with_whitespace txt then " " else ""
+        and suffix = if String.ends_with_whitespace txt then " " else "" in
+        let lines = unindent_lines ~opn_pos txt in
+        match split_asterisk_prefixed lines with
+        | Some deprefixed_lines -> mk (Asterisk_prefixed deprefixed_lines)
+        | None -> mk ~prefix ~suffix (Normal (String.concat ~sep:"\n" lines))
+        )
   else
     match txt with
     (* "(**)" is not parsed as a docstring but as a regular comment
        containing '*' and would be rewritten as "(***)" *)
     | "*" when Location.width loc = 4 -> mk (Verbatim "")
     | ("*" | "$") as txt -> mk (Verbatim txt)
-    | "\n" -> mk (Verbatim " ")
+    | "\n" | " " -> mk (Verbatim " ")
     | _ -> mk (Normal txt)
diff --git a/lib/Cmt.mli b/lib/Cmt.mli
index db80cb4e8e..ed4ff5f699 100644
--- a/lib/Cmt.mli
+++ b/lib/Cmt.mli
@@ -42,7 +42,7 @@ type decoded_kind =
   | Doc of string  (** Original content. *)
   | Normal of string  (** Original content with whitespaces trimmed. *)
   | Code of string list
-      (** Source code is line splitted with baseline indentation removed. *)
+      (** Source code is line splitted with indentation removed. *)
   | Asterisk_prefixed of string list
       (** Line splitted with asterisks removed. *)
 
diff --git a/lib/Cmts.ml b/lib/Cmts.ml
index edc624d734..f602105971 100644
--- a/lib/Cmts.ml
+++ b/lib/Cmts.ml
@@ -460,6 +460,35 @@ let break_comment_group source margin {Cmt.loc= a; _} {Cmt.loc= b; _} =
     ( (Location.is_single_line a margin && Location.is_single_line b margin)
     && (vertical_align || horizontal_align) )
 
+module Wrapped = struct
+  let fmt text =
+    let open Fmt in
+    assert (not (String.is_empty text)) ;
+    let fmt_line line =
+      let words =
+        List.filter ~f:(Fn.non String.is_empty)
+          (String.split_on_chars line
+             ~on:['\t'; '\n'; '\011'; '\012'; '\r'; ' '] )
+      in
+      list words "@ " str
+    in
+    let lines =
+      List.remove_consecutive_duplicates
+        ~equal:(fun x y -> String.is_empty x && String.is_empty y)
+        (String.split (String.rstrip text) ~on:'\n')
+    in
+    hvbox 0
+      (hovbox 0
+         (list_pn lines (fun ~prev:_ curr ~next ->
+              fmt_line curr
+              $
+              match next with
+              | Some str when String.for_all str ~f:Char.is_whitespace ->
+                  close_box $ fmt "\n@," $ open_hovbox 0
+              | Some _ when not (String.is_empty curr) -> fmt "@ "
+              | _ -> noop ) ) )
+end
+
 module Asterisk_prefixed = struct
   let fmt lines =
     let open Fmt in
@@ -471,36 +500,20 @@ module Asterisk_prefixed = struct
 end
 
 module Unwrapped = struct
-  let fmt_multiline_cmt ?epi ~starts_with_sp lines =
+  let fmt_multiline_cmt lines =
     let open Fmt in
     let is_white_line s = String.for_all s ~f:Char.is_whitespace in
     let fmt_line ~first ~last:_ s =
-      let sep, sp =
-        if is_white_line s then (str "\n", noop)
-        else (fmt "@;<1000 0>", fmt_if starts_with_sp " ")
-      in
-      fmt_if_k (not first) sep $ sp $ str (String.rstrip s)
+      let s = String.rstrip s in
+      let sep = if is_white_line s then str "\n" else fmt "@;<1000 0>" in
+      fmt_if_k (not first) sep $ str s
     in
-    vbox 0 ~name:"multiline" (list_fl lines fmt_line $ fmt_opt epi)
+    vbox 0 ~name:"multiline" (list_fl lines fmt_line)
 
-  let fmt s =
-    let open Fmt in
-    let is_sp = function ' ' | '\t' -> true | _ -> false in
-    match String.split_lines (String.rstrip s) with
-    | first_line :: _ :: _ as lines when not (String.is_empty first_line) ->
-        let epi =
-          (* Preserve position of closing but strip empty lines at the end *)
-          match String.rfindi s ~f:(fun _ c -> not (is_sp c)) with
-          | Some i when Char.( = ) s.[i] '\n' ->
-              break 1000 (-2) (* Break before closing *)
-          | Some i when i < String.length s - 1 ->
-              str " " (* Preserve a space at the end *)
-          | _ -> noop
-        in
-        (* Preserve the first level of indentation *)
-        let starts_with_sp = is_sp first_line.[0] in
-        fmt_multiline_cmt ~epi ~starts_with_sp lines
-    | _ -> str s
+  let fmt txt =
+    match String.split_lines txt with
+    | _ :: _ as lines -> fmt_multiline_cmt lines
+    | [] -> Fmt.noop
 end
 
 module Verbatim = struct
@@ -565,7 +578,7 @@ let fmt_cmt (conf : Conf.t) cmt ~fmt_code pos =
   | Doc txt ->
       Ocp_indent_compat.fmt ~fmt_code conf ~loc:cmt.loc txt ~offset:2 pos
   | Normal txt ->
-      if conf.fmt_opts.wrap_comments.v then fill_text txt ~epi:""
+      if conf.fmt_opts.wrap_comments.v then Wrapped.fmt txt
       else if conf.fmt_opts.ocp_indent_compat.v then
         (* TODO: [offset] should be computed from location. *)
         Ocp_indent_compat.fmt ~fmt_code conf ~loc:cmt.loc txt ~offset:2 pos
diff --git a/lib/Conf.ml b/lib/Conf.ml
index bfd5fabe05..29730209d7 100644
--- a/lib/Conf.ml
+++ b/lib/Conf.ml
@@ -1377,8 +1377,7 @@ module Formatting = struct
       ; elt let_open ]
 end
 
-(* Flags that can be modified in the config file that don't affect
-   formatting *)
+(* Flags that can be modified in the config file that don't affect formatting *)
 
 let kind = Decl.Operational
 
diff --git a/lib/Fmt.ml b/lib/Fmt.ml
index e7b0d818f0..090bdb8fe1 100644
--- a/lib/Fmt.ml
+++ b/lib/Fmt.ml
@@ -319,39 +319,3 @@ and vbox_if ?name cnd n = wrap_if_k cnd (open_vbox ?name n) close_box
 and hvbox_if ?name cnd n = wrap_if_k cnd (open_hvbox ?name n) close_box
 
 and hovbox_if ?name cnd n = wrap_if_k cnd (open_hovbox ?name n) close_box
-
-(** Text filling --------------------------------------------------------*)
-
-let fill_text ?(epi = "") text =
-  assert (not (String.is_empty text)) ;
-  let fmt_line line =
-    let words =
-      List.filter ~f:(Fn.non String.is_empty)
-        (String.split_on_chars line
-           ~on:['\t'; '\n'; '\011'; '\012'; '\r'; ' '] )
-    in
-    list words "@ " str
-  in
-  let lines =
-    List.remove_consecutive_duplicates
-      ~equal:(fun x y -> String.is_empty x && String.is_empty y)
-      (String.split (String.rstrip text) ~on:'\n')
-  in
-  let pro = if String.starts_with_whitespace text then " " else "" in
-  let epi =
-    if String.length text > 1 && String.ends_with_whitespace text then
-      " " ^ epi
-    else epi
-  in
-  str pro
-  $ hvbox 0
-      (hovbox 0
-         ( list_pn lines (fun ~prev:_ curr ~next ->
-               fmt_line curr
-               $
-               match next with
-               | Some str when String.for_all str ~f:Char.is_whitespace ->
-                   close_box $ fmt "\n@," $ open_hovbox 0
-               | Some _ when not (String.is_empty curr) -> fmt "@ "
-               | _ -> noop )
-         $ str epi ) )
diff --git a/lib/Fmt.mli b/lib/Fmt.mli
index ff607bbf0e..af6e2040a6 100644
--- a/lib/Fmt.mli
+++ b/lib/Fmt.mli
@@ -218,8 +218,3 @@ val hvbox_if : ?name:string -> bool -> int -> t -> t
 val hovbox_if : ?name:string -> bool -> int -> t -> t
 (** Conditionally wrap a format thunk with an hovbox with specified
     indentation. *)
-
-(** Text filling --------------------------------------------------------*)
-
-val fill_text : ?epi:string -> string -> t
-(** Format a non-empty string as filled text wrapped at the margin. *)
diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 87eda4e91f..098ac5fcc4 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -38,8 +38,7 @@ module Cmts = struct
     let before = fmt_before c ?pro ?epi ?eol ?adj loc in
     (* remove the within comments from the map by accepting the continuation *)
     fun inner ->
-      (* delay the after comments until the within comments have been
-         removed *)
+      (* delay the after comments until the within comments have been removed *)
       let after = fmt_after c ?pro ?epi loc in
       let open Fmt in
       before $ inner $ after
diff --git a/lib/Normalize_std_ast.ml b/lib/Normalize_std_ast.ml
index ef893190d1..61c3c3f376 100644
--- a/lib/Normalize_std_ast.ml
+++ b/lib/Normalize_std_ast.ml
@@ -143,8 +143,7 @@ let make_mapper conf ~ignore_doc_comments =
              pat3 )
     | Ppat_constraint (pat1, {ptyp_desc= Ptyp_poly ([], _t); _}) ->
         (* The parser put the same type constraint in two different nodes:
-           [let _ : typ = exp] is represented as [let _ : typ = (exp :
-           typ)]. *)
+           [let _ : typ = exp] is represented as [let _ : typ = (exp : typ)]. *)
         m.pat m pat1
     | _ -> Ast_mapper.default_mapper.pat m pat
   in
diff --git a/test/passing/tests/infix_bind-break.ml.err b/test/passing/tests/infix_bind-break.ml.err
new file mode 100644
index 0000000000..37b1506a7a
--- /dev/null
+++ b/test/passing/tests/infix_bind-break.ml.err
@@ -0,0 +1,2 @@
+Warning: tests/infix_bind.ml:190 exceeds the margin
+Warning: tests/infix_bind.ml:196 exceeds the margin
diff --git a/test/passing/tests/infix_bind-break.ml.ref b/test/passing/tests/infix_bind-break.ml.ref
index 4ffe48c69e..119d008311 100644
--- a/test/passing/tests/infix_bind-break.ml.ref
+++ b/test/passing/tests/infix_bind-break.ml.ref
@@ -171,42 +171,40 @@ let _ =
   >>= fun (* foo before *) [@warning "-4"] (* foo after *) x ->
   fooooooooooooooooooooooo
 
-let f = Ok () >>= (* *) fun _ -> Ok ()
+let f = Ok () >>= (*  *) fun _ -> Ok ()
 
 let f =
   (* fooooooooooooooo foooooooooooooooo *)
   Ok ()
-  >>= (* *) fun _ -> Ok foooooooooooooooooooooooooooooooooooooooooooooooooo
+  >>= (*  *) fun _ -> Ok foooooooooooooooooooooooooooooooooooooooooooooooooo
 
-let f = Ok () >>= (* *) function Foo -> Ok ()
+let f = Ok () >>= (*  *) function Foo -> Ok ()
 
 let f =
   (* fooooooooooooooo foooooooooooooooo *)
   Ok ()
-  >>= (* *)
+  >>= (*  *)
   function Foo -> Ok foooooooooooooooooooooooooooooooooooooooooooooooooo
 
 let f =
   Ok ()
-  >>= (* fooooooooooooooo fooooooooooooooo fooooooooooooooo
-         foooooooooooooooo *)
+  >>= (* fooooooooooooooo fooooooooooooooo fooooooooooooooo foooooooooooooooo *)
   fun foooooo fooooo foooo foooooo ->
   Ok foooooooooooooooooooooooooooooooooooooooooooooooooo
 
 let f =
   Ok ()
-  >>= (* fooooooooooooooo fooooooooooooooo fooooooooooooooo
-         foooooooooooooooo *)
+  >>= (* fooooooooooooooo fooooooooooooooo fooooooooooooooo foooooooooooooooo *)
   function Foo -> Ok foooooooooooooooooooooooooooooooooooooooooooooooooo
 
 (** The tests below are testing a dropped comment with
     `--no-break-infix-before-func` *)
 
-let _ = x |> fun y -> y (* *)
+let _ = x |> fun y -> y (*  *)
 
-let _ = x |> function y -> y (* *)
+let _ = x |> function y -> y (*  *)
 
-let _ = match () with A -> ( x |> function y -> y (* *) ) | B -> ()
+let _ = match () with A -> ( x |> function y -> y (*  *) ) | B -> ()
 
 let _ = x |> function y -> ( function _ -> y (* A *) ) (* B *)
 
diff --git a/test/passing/tests/infix_bind-fit_or_vertical-break.ml.err b/test/passing/tests/infix_bind-fit_or_vertical-break.ml.err
new file mode 100644
index 0000000000..d98343563a
--- /dev/null
+++ b/test/passing/tests/infix_bind-fit_or_vertical-break.ml.err
@@ -0,0 +1,2 @@
+Warning: tests/infix_bind.ml:195 exceeds the margin
+Warning: tests/infix_bind.ml:201 exceeds the margin
diff --git a/test/passing/tests/infix_bind-fit_or_vertical-break.ml.ref b/test/passing/tests/infix_bind-fit_or_vertical-break.ml.ref
index 374187edbf..2e264d0ba0 100644
--- a/test/passing/tests/infix_bind-fit_or_vertical-break.ml.ref
+++ b/test/passing/tests/infix_bind-fit_or_vertical-break.ml.ref
@@ -176,42 +176,40 @@ let _ =
   >>= fun (* foo before *) [@warning "-4"] (* foo after *) x ->
   fooooooooooooooooooooooo
 
-let f = Ok () >>= (* *) fun _ -> Ok ()
+let f = Ok () >>= (*  *) fun _ -> Ok ()
 
 let f =
   (* fooooooooooooooo foooooooooooooooo *)
   Ok ()
-  >>= (* *) fun _ -> Ok foooooooooooooooooooooooooooooooooooooooooooooooooo
+  >>= (*  *) fun _ -> Ok foooooooooooooooooooooooooooooooooooooooooooooooooo
 
-let f = Ok () >>= (* *) function Foo -> Ok ()
+let f = Ok () >>= (*  *) function Foo -> Ok ()
 
 let f =
   (* fooooooooooooooo foooooooooooooooo *)
   Ok ()
-  >>= (* *)
+  >>= (*  *)
   function Foo -> Ok foooooooooooooooooooooooooooooooooooooooooooooooooo
 
 let f =
   Ok ()
-  >>= (* fooooooooooooooo fooooooooooooooo fooooooooooooooo
-         foooooooooooooooo *)
+  >>= (* fooooooooooooooo fooooooooooooooo fooooooooooooooo foooooooooooooooo *)
   fun foooooo fooooo foooo foooooo ->
   Ok foooooooooooooooooooooooooooooooooooooooooooooooooo
 
 let f =
   Ok ()
-  >>= (* fooooooooooooooo fooooooooooooooo fooooooooooooooo
-         foooooooooooooooo *)
+  >>= (* fooooooooooooooo fooooooooooooooo fooooooooooooooo foooooooooooooooo *)
   function Foo -> Ok foooooooooooooooooooooooooooooooooooooooooooooooooo
 
 (** The tests below are testing a dropped comment with
     `--no-break-infix-before-func` *)
 
-let _ = x |> fun y -> y (* *)
+let _ = x |> fun y -> y (*  *)
 
-let _ = x |> function y -> y (* *)
+let _ = x |> function y -> y (*  *)
 
-let _ = match () with A -> ( x |> function y -> y (* *) ) | B -> ()
+let _ = match () with A -> ( x |> function y -> y (*  *) ) | B -> ()
 
 let _ = x |> function y -> ( function _ -> y (* A *) ) (* B *)
 
diff --git a/test/passing/tests/infix_bind-fit_or_vertical.ml.ref b/test/passing/tests/infix_bind-fit_or_vertical.ml.ref
index d87402e3f0..3f170256e3 100644
--- a/test/passing/tests/infix_bind-fit_or_vertical.ml.ref
+++ b/test/passing/tests/infix_bind-fit_or_vertical.ml.ref
@@ -170,18 +170,18 @@ let _ =
   foo >>= fun (* foo before *) [@warning "-4"] (* foo after *) x ->
   fooooooooooooooooooooooo
 
-let f = Ok () >>= (* *) fun _ -> Ok ()
+let f = Ok () >>= (*  *) fun _ -> Ok ()
 
 let f =
   (* fooooooooooooooo foooooooooooooooo *)
-  Ok () >>= (* *) fun _ ->
+  Ok () >>= (*  *) fun _ ->
   Ok foooooooooooooooooooooooooooooooooooooooooooooooooo
 
-let f = Ok () >>= (* *) function Foo -> Ok ()
+let f = Ok () >>= (*  *) function Foo -> Ok ()
 
 let f =
   (* fooooooooooooooo foooooooooooooooo *)
-  Ok () >>= (* *) function
+  Ok () >>= (*  *) function
   | Foo -> Ok foooooooooooooooooooooooooooooooooooooooooooooooooo
 
 let f =
@@ -201,11 +201,11 @@ let f =
 (** The tests below are testing a dropped comment with
     `--no-break-infix-before-func` *)
 
-let _ = x |> fun y -> y (* *)
+let _ = x |> fun y -> y (*  *)
 
-let _ = x |> function y -> y (* *)
+let _ = x |> function y -> y (*  *)
 
-let _ = match () with A -> ( x |> function y -> y (* *) ) | B -> ()
+let _ = match () with A -> ( x |> function y -> y (*  *) ) | B -> ()
 
 let _ = x |> function y -> ( function _ -> y (* A *) ) (* B *)
 
diff --git a/test/passing/tests/infix_bind.ml b/test/passing/tests/infix_bind.ml
index c51734bcb9..8295f2540f 100644
--- a/test/passing/tests/infix_bind.ml
+++ b/test/passing/tests/infix_bind.ml
@@ -165,18 +165,18 @@ let _ =
   foo >>= fun (* foo before *) [@warning "-4"] (* foo after *) x ->
   fooooooooooooooooooooooo
 
-let f = Ok () >>= (* *) fun _ -> Ok ()
+let f = Ok () >>= (*  *) fun _ -> Ok ()
 
 let f =
   (* fooooooooooooooo foooooooooooooooo *)
-  Ok () >>= (* *) fun _ ->
+  Ok () >>= (*  *) fun _ ->
   Ok foooooooooooooooooooooooooooooooooooooooooooooooooo
 
-let f = Ok () >>= (* *) function Foo -> Ok ()
+let f = Ok () >>= (*  *) function Foo -> Ok ()
 
 let f =
   (* fooooooooooooooo foooooooooooooooo *)
-  Ok () >>= (* *) function
+  Ok () >>= (*  *) function
   | Foo -> Ok foooooooooooooooooooooooooooooooooooooooooooooooooo
 
 let f =
@@ -196,11 +196,11 @@ let f =
 (** The tests below are testing a dropped comment with
     `--no-break-infix-before-func` *)
 
-let _ = x |> fun y -> y (* *)
+let _ = x |> fun y -> y (*  *)
 
-let _ = x |> function y -> y (* *)
+let _ = x |> function y -> y (*  *)
 
-let _ = match () with A -> ( x |> function y -> y (* *) ) | B -> ()
+let _ = match () with A -> ( x |> function y -> y (*  *) ) | B -> ()
 
 let _ = x |> function y -> ( function _ -> y (* A *) ) (* B *)
 
diff --git a/test/passing/tests/js_args.ml.err b/test/passing/tests/js_args.ml.err
new file mode 100644
index 0000000000..610b9ed379
--- /dev/null
+++ b/test/passing/tests/js_args.ml.err
@@ -0,0 +1 @@
+Warning: tests/js_args.ml:50 exceeds the margin
diff --git a/test/passing/tests/js_args.ml.ref b/test/passing/tests/js_args.ml.ref
index 8addea5617..9b5f7abdac 100644
--- a/test/passing/tests/js_args.ml.ref
+++ b/test/passing/tests/js_args.ml.ref
@@ -48,8 +48,7 @@ let () =
 
 (* Except in specific cases, we want the argument indented relative to the
    function being called. (Exceptions include "fun" arguments where the line
-   ends with "->" and subsequent lines beginning with operators, like
-   above.) *)
+   ends with "->" and subsequent lines beginning with operators, like above.) *)
 let () =
   Some
     (Message_store.create s "herd-retransmitter" ~unlink:true

From f5cce1a860bf7877f76a2c0f765997bf0316be47 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Tue, 30 May 2023 17:54:42 +0200
Subject: [PATCH 065/115] Test 'error4' requires one more iteration

---
 test/passing/dune.inc             | 2 +-
 test/passing/tests/error4.ml.opts | 1 +
 2 files changed, 2 insertions(+), 1 deletion(-)

diff --git a/test/passing/dune.inc b/test/passing/dune.inc
index 4e73f8a0b4..351bab72fd 100644
--- a/test/passing/dune.inc
+++ b/test/passing/dune.inc
@@ -1721,7 +1721,7 @@
  (action
   (with-stdout-to error4.ml.stdout
    (with-stderr-to error4.ml.stderr
-     (run %{bin:ocamlformat} --margin-check --no-comment-check %{dep:tests/error4.ml})))))
+     (run %{bin:ocamlformat} --margin-check --no-comment-check --max-iter=3 %{dep:tests/error4.ml})))))
 
 (rule
  (alias runtest)
diff --git a/test/passing/tests/error4.ml.opts b/test/passing/tests/error4.ml.opts
index f53883279a..1caaafca6a 100644
--- a/test/passing/tests/error4.ml.opts
+++ b/test/passing/tests/error4.ml.opts
@@ -1 +1,2 @@
 --no-comment-check
+--max-iter=3

From 032f6c384eb226e09f709302073aca3b2d6fcc92 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Tue, 30 May 2023 18:23:53 +0200
Subject: [PATCH 066/115] Fix added newline in cinaps comments

---
 lib/Cmts.ml                      | 7 ++-----
 test/passing/tests/cinaps.ml.ref | 6 +++---
 2 files changed, 5 insertions(+), 8 deletions(-)

diff --git a/lib/Cmts.ml b/lib/Cmts.ml
index f602105971..36fc475cc6 100644
--- a/lib/Cmts.ml
+++ b/lib/Cmts.ml
@@ -517,12 +517,9 @@ module Unwrapped = struct
 end
 
 module Verbatim = struct
-  let fmt s (pos : Cmt.pos) =
+  let fmt s (_pos : Cmt.pos) =
     let open Fmt in
-    fmt_if_k
-      (Poly.(pos = After) && String.contains s '\n')
-      (break_unless_newline 1000 0)
-    $ str s
+    str s
 end
 
 module Cinaps = struct
diff --git a/test/passing/tests/cinaps.ml.ref b/test/passing/tests/cinaps.ml.ref
index 141ed76d1b..40fe5f4170 100644
--- a/test/passing/tests/cinaps.ml.ref
+++ b/test/passing/tests/cinaps.ml.ref
@@ -19,10 +19,10 @@ let x = 1
 let y = 2
 
 (*$
-  #use "import.cinaps" ;;
+  ;; #use "import.cinaps"
 
-  List.iter all_fields ~f:(fun (name, type_) ->
-      printf "\nexternal get_%s\n: unit -> %s = \"get_%s\"" name type_ name )
+  ;; List.iter all_fields ~f:(fun (name, type_) -> printf "\nexternal get_%s
+  : unit -> %s = \"get_%s\"" name type_ name) 
 *)
 external get_name : unit -> string = "get_name"
 

From 124a89b135a0b9aacd1c634186a533cf318d9b35 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Wed, 31 May 2023 16:58:42 +0200
Subject: [PATCH 067/115] Strip trailing spaces of cinaps comments

---
 lib/Cmt.ml | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/lib/Cmt.ml b/lib/Cmt.ml
index a8d375c5b3..bcba004c7f 100644
--- a/lib/Cmt.ml
+++ b/lib/Cmt.ml
@@ -147,7 +147,9 @@ let decode {txt; loc} =
         let source =
           String.lstrip ~drop:(function '\n' -> true | _ -> false) source
         in
-        mk ~prefix:"$" ~suffix (Code (unindent_lines ~opn_pos source))
+        let lines = unindent_lines ~opn_pos source in
+        let lines = List.map ~f:String.rstrip lines in
+        mk ~prefix:"$" ~suffix (Code lines)
     | '=' -> mk (Verbatim txt)
     | '*' -> mk ~prefix:"*" (Doc (String.drop_prefix txt 1))
     | _ -> (

From 2d0930dc1de39c9fc9d76874ab0a8d4926fc87e7 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Wed, 31 May 2023 16:59:56 +0200
Subject: [PATCH 068/115] Promote

---
 test/passing/tests/cinaps.ml.ref | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/test/passing/tests/cinaps.ml.ref b/test/passing/tests/cinaps.ml.ref
index 40fe5f4170..e8911267be 100644
--- a/test/passing/tests/cinaps.ml.ref
+++ b/test/passing/tests/cinaps.ml.ref
@@ -22,7 +22,7 @@ let y = 2
   ;; #use "import.cinaps"
 
   ;; List.iter all_fields ~f:(fun (name, type_) -> printf "\nexternal get_%s
-  : unit -> %s = \"get_%s\"" name type_ name) 
+  : unit -> %s = \"get_%s\"" name type_ name)
 *)
 external get_name : unit -> string = "get_name"
 

From b207454672bc3c5cf942ebb2de3f742e2b214c23 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Wed, 31 May 2023 17:40:04 +0200
Subject: [PATCH 069/115] Strip heading/trailing empty lines

This fixes two instances of unstable formatting but might be a
regression when `wrap-comments=false`.
---
 lib/Cmt.ml                                    | 10 +++-
 lib/Cmts.ml                                   |  2 +-
 .../passing/tests/polytypes-janestreet.ml.ref |  3 +-
 test/passing/tests/wrap_comments.ml.ref       | 52 ++++++++-----------
 4 files changed, 33 insertions(+), 34 deletions(-)

diff --git a/lib/Cmt.ml b/lib/Cmt.ml
index bcba004c7f..e1b94925f6 100644
--- a/lib/Cmt.ml
+++ b/lib/Cmt.ml
@@ -158,8 +158,14 @@ let decode {txt; loc} =
         let lines = unindent_lines ~opn_pos txt in
         match split_asterisk_prefixed lines with
         | Some deprefixed_lines -> mk (Asterisk_prefixed deprefixed_lines)
-        | None -> mk ~prefix ~suffix (Normal (String.concat ~sep:"\n" lines))
-        )
+        | None ->
+            (* Reconstruct the text with indentation removed and heading and
+               trailing empty lines removed. *)
+            let txt = String.strip (String.concat ~sep:"\n" lines) in
+            let cmt =
+              if String.is_empty txt then Verbatim "" else Normal txt
+            in
+            mk ~prefix ~suffix cmt )
   else
     match txt with
     (* "(**)" is not parsed as a docstring but as a regular comment
diff --git a/lib/Cmts.ml b/lib/Cmts.ml
index 36fc475cc6..76c12c608e 100644
--- a/lib/Cmts.ml
+++ b/lib/Cmts.ml
@@ -508,7 +508,7 @@ module Unwrapped = struct
       let sep = if is_white_line s then str "\n" else fmt "@;<1000 0>" in
       fmt_if_k (not first) sep $ str s
     in
-    vbox 0 ~name:"multiline" (list_fl lines fmt_line)
+    vbox 0 ~name:"unwrapped" (list_fl lines fmt_line)
 
   let fmt txt =
     match String.split_lines txt with
diff --git a/test/passing/tests/polytypes-janestreet.ml.ref b/test/passing/tests/polytypes-janestreet.ml.ref
index 8868f3cb2f..0787402439 100644
--- a/test/passing/tests/polytypes-janestreet.ml.ref
+++ b/test/passing/tests/polytypes-janestreet.ml.ref
@@ -26,8 +26,7 @@ let t4 :
 ;;
 
 let foo : type a. a =
-  (* aaaaaa 
-     *)
+  (* aaaaaa *)
   failwith "foo"
 ;;
 
diff --git a/test/passing/tests/wrap_comments.ml.ref b/test/passing/tests/wrap_comments.ml.ref
index a69a82c759..d95622223c 100644
--- a/test/passing/tests/wrap_comments.ml.ref
+++ b/test/passing/tests/wrap_comments.ml.ref
@@ -40,47 +40,47 @@ type t =
 let rex =
   Pcre.regexp
     ( "^[0-9]{2}"
-    (* xxxxxxxxxxx               *)
+    (* xxxxxxxxxxx *)
     ^ "(.{12})"
-    (* xxxxxxxxxxxxxxxxxx        *)
+    (* xxxxxxxxxxxxxxxxxx *)
     ^ "(.{4})"
-    (* xxxxxxxxxxxx              *)
+    (* xxxxxxxxxxxx *)
     ^ "([0-9]{3})"
-    (* xxxxxxxx                  *)
+    (* xxxxxxxx *)
     ^ "(.{60})"
-    (* xxxxxxxxxxxxxxxxxxxx      *)
+    (* xxxxxxxxxxxxxxxxxxxx *)
     ^ "(.{12})"
-    (* xxxxxxxxxxxxxxx           *)
+    (* xxxxxxxxxxxxxxx *)
     ^ "(.{12})"
-    (* xxxxxxxxxxxxxxxxxxx       *)
+    (* xxxxxxxxxxxxxxxxxxx *)
     ^ "([0-9]{3})"
     (* xxxxxxxxxxxxxxxxxxxxxxxxx *)
     ^ "([0-9]{3})"
-    (* xxxxxxxxxxx               *)
+    (* xxxxxxxxxxx *)
     ^ "(.{15})"
-    (* xxxxxxxxxxxxxxxxxx        *)
+    (* xxxxxxxxxxxxxxxxxx *)
     ^ "([0-9]{7})"
-    (* xxxxxxxxxxxxx             *)
+    (* xxxxxxxxxxxxx *)
     ^ "(.{10})"
-    (* xxxxxxxxxxxxx             *)
+    (* xxxxxxxxxxxxx *)
     ^ date_fmt
-    (* xxxxxxxxxxxxx             *)
+    (* xxxxxxxxxxxxx *)
     ^ "([0-9]{18})"
-    (* xxxxx                     *)
+    (* xxxxx *)
     ^ "(.)"
-    (* xxxxxxxxxxx               *)
+    (* xxxxxxxxxxx *)
     ^ "([0-9]{3})"
-    (* xxxxxxxxxxxxxx            *)
+    (* xxxxxxxxxxxxxx *)
     ^ "(.{15})"
-    (* xxxxxxxxxxxxxxxxxxxx      *)
+    (* xxxxxxxxxxxxxxxxxxxx *)
     ^ "(.{3})"
-    (* xxxxxxxxxx                *)
+    (* xxxxxxxxxx *)
     ^ "(.{27})$" )
 
 type foo =
   { some_field: int
         (* long long long long long long long long long long long long long long
-         * long long long long *)
+           * long long long long *)
   ; another_field: string }
 
 let _ =
@@ -91,8 +91,7 @@ let _ =
   ; "c"
     (* first line
 
-       second line
-    *)
+       second line *)
   ; "d"
     (* first line
 
@@ -101,13 +100,11 @@ let _ =
   ; "e"
     (* first line
 
-       second line
-    *)
+       second line *)
   ; "f"
     (* first line
 
-       second line
-    *)
+       second line *)
   ; "g" ]
 
 let _ =
@@ -125,8 +122,7 @@ let _ =
 
 let _ =
   (*no space before
-    just newline after
-  *)
+    just newline after *)
   0
 
 let _ =
@@ -146,7 +142,5 @@ let _ =
   ()
 
 let _ =
-  (*
-     blah blah
-  *)
+  (* blah blah *)
   ()

From e8875b5a11e56a2adf0ca63cb7937ba7b0d2ef4f Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Wed, 31 May 2023 17:47:33 +0200
Subject: [PATCH 070/115] Small cleanup in docstring fmt function

---
 lib/Cmts.ml | 37 ++++++++++++++++---------------------
 1 file changed, 16 insertions(+), 21 deletions(-)

diff --git a/lib/Cmts.ml b/lib/Cmts.ml
index 76c12c608e..d6365a6d56 100644
--- a/lib/Cmts.ml
+++ b/lib/Cmts.ml
@@ -517,7 +517,7 @@ module Unwrapped = struct
 end
 
 module Verbatim = struct
-  let fmt s (_pos : Cmt.pos) =
+  let fmt s =
     let open Fmt in
     str s
 end
@@ -538,32 +538,28 @@ module Cinaps = struct
         list lines "" fmt_line $ fmt "@;<1000 -2>"
 end
 
-module Ocp_indent_compat = struct
-  let fmt ~fmt_code conf ~loc txt ~offset (pos : Cmt.pos) =
-    let endl = String.ends_with_whitespace txt in
-    let pre, doc =
+module Doc = struct
+  let fmt ~fmt_code conf ~loc txt ~offset =
+    (* Whether the doc starts and ends with an empty line. *)
+    let pre_nl =
       let lines = String.split_lines txt in
       match lines with
-      | [] | [_] -> (false, txt)
-      | h :: _ ->
-          let pre = String.is_empty (String.strip h) in
-          let doc = if pre then String.lstrip txt else txt in
-          let doc = if endl then String.rstrip doc else doc in
-          (pre, doc)
+      | [] | [_] -> false
+      | h :: _ -> String.is_empty (String.strip h)
     in
+    let trail_nl = String.ends_with_whitespace txt in
+    let doc = if pre_nl then String.lstrip txt else txt in
+    let doc = if trail_nl then String.rstrip doc else doc in
     let parsed = Docstring.parse ~loc doc in
-    (* Disable warnings when parsing fails *)
+    (* Disable warnings when parsing of code blocks fails. *)
     let quiet = Conf_t.Elt.make true `Default in
     let conf = {conf with Conf.opr_opts= {conf.Conf.opr_opts with quiet}} in
     let doc = Fmt_odoc.fmt_parsed conf ~fmt_code ~input:doc ~offset parsed in
     let open Fmt in
-    fmt_if_k
-      (Poly.(pos = After) && String.contains txt '\n')
-      (break_unless_newline 1000 0)
-    $ wrap_k (fmt_if pre "@;<1000 3>") (fmt_if endl "@\n") @@ doc
+    wrap_k (fmt_if pre_nl "@;<1000 3>") (fmt_if trail_nl "@\n") @@ doc
 end
 
-let fmt_cmt (conf : Conf.t) cmt ~fmt_code pos =
+let fmt_cmt (conf : Conf.t) cmt ~fmt_code (_pos : Cmt.pos) =
   let open Fmt in
   let decoded = Cmt.decode cmt in
   (fun k ->
@@ -571,14 +567,13 @@ let fmt_cmt (conf : Conf.t) cmt ~fmt_code pos =
       (str "(*" $ str decoded.prefix $ k $ str decoded.suffix $ str "*)") )
   @@
   match decoded.kind with
-  | Verbatim txt -> Verbatim.fmt txt pos
-  | Doc txt ->
-      Ocp_indent_compat.fmt ~fmt_code conf ~loc:cmt.loc txt ~offset:2 pos
+  | Verbatim txt -> Verbatim.fmt txt
+  | Doc txt -> Doc.fmt ~fmt_code conf ~loc:cmt.loc txt ~offset:2
   | Normal txt ->
       if conf.fmt_opts.wrap_comments.v then Wrapped.fmt txt
       else if conf.fmt_opts.ocp_indent_compat.v then
         (* TODO: [offset] should be computed from location. *)
-        Ocp_indent_compat.fmt ~fmt_code conf ~loc:cmt.loc txt ~offset:2 pos
+        Doc.fmt ~fmt_code conf ~loc:cmt.loc txt ~offset:2
       else Unwrapped.fmt txt
   | Code code -> Cinaps.fmt code
   | Asterisk_prefixed lines -> Asterisk_prefixed.fmt lines

From c42280ad631765f2caf9f7288b6af2680583febf Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Wed, 31 May 2023 18:54:46 +0200
Subject: [PATCH 071/115] Fix incorrect unindenting of cinaps comments

---
 lib/Cmt.ml | 30 +++++++++++++++++-------------
 1 file changed, 17 insertions(+), 13 deletions(-)

diff --git a/lib/Cmt.ml b/lib/Cmt.ml
index e1b94925f6..007cc86f96 100644
--- a/lib/Cmt.ml
+++ b/lib/Cmt.ml
@@ -97,7 +97,8 @@ type decoded_kind =
 
 type decoded = {prefix: string; suffix: string; kind: decoded_kind}
 
-let unindent_lines ~opn_pos first_line tl_lines =
+(** [opn_offset] indicates at which column the body of the comment starts. *)
+let unindent_lines ~opn_offset first_line tl_lines =
   let indent_of_line s =
     (* index of first non-whitespace is indentation, None means white line *)
     String.lfindi s ~f:(fun _ c -> not (Char.is_whitespace c))
@@ -105,22 +106,21 @@ let unindent_lines ~opn_pos first_line tl_lines =
   (* The indentation of the first line must account for the location of the
      comment opening *)
   let fl_spaces = Option.value ~default:0 (indent_of_line first_line) in
-  let fl_offset = opn_pos.Lexing.pos_cnum - opn_pos.pos_bol + 2 in
-  let fl_indent = fl_spaces + fl_offset in
+  let fl_indent = fl_spaces + opn_offset in
   let min_indent =
     List.fold_left ~init:fl_indent
       ~f:(fun acc s ->
-        Option.value_map ~default:acc ~f:(min acc) (indent_of_line s) )
+        match indent_of_line s with Some i -> min acc i | None -> acc )
       tl_lines
   in
   (* Completely trim the first line *)
   String.drop_prefix first_line fl_spaces
   :: List.map ~f:(fun s -> String.drop_prefix s min_indent) tl_lines
 
-let unindent_lines ~opn_pos txt =
+let unindent_lines ~opn_offset txt =
   match String.split_lines txt with
   | [] -> []
-  | hd :: tl -> unindent_lines ~opn_pos hd tl
+  | hd :: tl -> unindent_lines ~opn_offset hd tl
 
 let split_asterisk_prefixed lines =
   if List.for_all ~f:(String.is_prefix ~prefix:"*") lines then
@@ -135,27 +135,31 @@ let decode {txt; loc} =
     let f = function '\r' -> false | _ -> true in
     String.filter txt ~f
   in
-  let opn_pos = loc.Location.loc_start in
+  let opn_offset =
+    let {Lexing.pos_cnum; pos_bol; _} = loc.Location.loc_start in
+    pos_cnum - pos_bol + 2
+  in
   if String.length txt >= 2 then
     match txt.[0] with
     | '$' when not (Char.is_whitespace txt.[1]) -> mk (Verbatim txt)
     | '$' ->
+        let opn_offset = opn_offset + 1 in
         let dollar_suf = Char.equal txt.[String.length txt - 1] '$' in
         let suffix = if dollar_suf then "$" else "" in
         let len = String.length txt - if dollar_suf then 2 else 1 in
-        let source = String.sub ~pos:1 ~len txt in
-        let source =
-          String.lstrip ~drop:(function '\n' -> true | _ -> false) source
-        in
-        let lines = unindent_lines ~opn_pos source in
+        (* Strip white lines at the end but not at the start until after
+           [unindent_lines] is called. *)
+        let source = String.rstrip (String.sub ~pos:1 ~len txt) in
+        let lines = unindent_lines ~opn_offset source in
         let lines = List.map ~f:String.rstrip lines in
+        let lines = List.drop_while ~f:String.is_empty lines in
         mk ~prefix:"$" ~suffix (Code lines)
     | '=' -> mk (Verbatim txt)
     | '*' -> mk ~prefix:"*" (Doc (String.drop_prefix txt 1))
     | _ -> (
         let prefix = if String.starts_with_whitespace txt then " " else ""
         and suffix = if String.ends_with_whitespace txt then " " else "" in
-        let lines = unindent_lines ~opn_pos txt in
+        let lines = unindent_lines ~opn_offset txt in
         match split_asterisk_prefixed lines with
         | Some deprefixed_lines -> mk (Asterisk_prefixed deprefixed_lines)
         | None ->

From 4e4ef136281ecebc588e95b81f15b8771ded1797 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Tue, 30 May 2023 16:54:05 +0200
Subject: [PATCH 072/115] Normalize comments in code in comments

---
 lib/Normalize_cmts.ml         |  79 ++++++++++++++++++++++++++
 lib/Normalize_extended_ast.ml | 102 +++++++---------------------------
 2 files changed, 99 insertions(+), 82 deletions(-)
 create mode 100644 lib/Normalize_cmts.ml

diff --git a/lib/Normalize_cmts.ml b/lib/Normalize_cmts.ml
new file mode 100644
index 0000000000..e9a4ff5203
--- /dev/null
+++ b/lib/Normalize_cmts.ml
@@ -0,0 +1,79 @@
+module Normalized_cmt = struct
+  type t =
+    { cmt_kind: [`Comment | `Doc_comment]
+    ; norm: string
+    ; orig: Cmt.t  (** Not compared. *) }
+
+  let compare a b = Poly.compare (a.cmt_kind, a.norm) (b.cmt_kind, b.norm)
+
+  let of_cmt ~normalize_code ~normalize_doc orig =
+    let cmt_kind, norm =
+      let decoded = Cmt.decode orig in
+      match decoded.Cmt.kind with
+      | Verbatim txt -> (`Comment, txt)
+      | Doc txt -> (`Doc_comment, normalize_doc txt)
+      | Normal txt -> (`Comment, Docstring.normalize_text txt)
+      | Code code -> (`Comment, normalize_code (String.concat ~sep:"\n" code))
+      | Asterisk_prefixed lines ->
+          ( `Comment
+          , String.concat ~sep:" "
+              (List.map ~f:Docstring.normalize_text lines) )
+    in
+    {cmt_kind; norm; orig}
+
+  let dropped {cmt_kind; orig; _} = {Cmt.kind= `Dropped orig; cmt_kind}
+
+  let added {cmt_kind; orig; _} = {Cmt.kind= `Added orig; cmt_kind}
+
+  let sexp_of_t _ = Sexp.Atom "Normalized_cmt.t"
+
+  module Comparator = struct
+    type nonrec t = t
+
+    include Comparator.Make (struct
+      type nonrec t = t
+
+      let compare, sexp_of_t = (compare, sexp_of_t)
+    end)
+  end
+end
+
+let diff ~f x y =
+  (*= [symmetric_diff x y] returns a sequence of changes between [x] and [y]:
+      - [First k] means [k] is in [x] but not [y]
+      - [Second k] means [k] is in [y] but not [x] *)
+  Set.symmetric_diff (f x) (f y)
+  |> Sequence.to_list
+  (*= - [First _] is reported as a comment dropped
+      - [Second _] is reported as a comment added *)
+  |> List.map
+       ~f:
+         (Either.value_map ~first:Normalized_cmt.dropped
+            ~second:Normalized_cmt.added )
+  |> function [] -> Ok () | errors -> Error errors
+
+let normalize ~normalize_code ~parse_docstrings =
+  object (self)
+    method cmt c =
+      Normalized_cmt.of_cmt ~normalize_code:self#code ~normalize_doc:self#doc
+        c
+
+    method cmts cs =
+      List.map ~f:(fun c -> (self#cmt c).Normalized_cmt.norm) cs
+
+    method code c = normalize_code ~normalize_cmts:self#cmts c
+
+    method doc d =
+      Docstring.normalize ~parse_docstrings ~normalize_code:self#code d
+  end
+
+let diff_cmts ~normalize_code ~parse_docstrings x y =
+  let n = normalize ~normalize_code ~parse_docstrings in
+  let f cmts =
+    Set.of_list (module Normalized_cmt.Comparator) (List.map ~f:n#cmt cmts)
+  in
+  diff ~f x y
+
+let normalize_docstring ~normalize_code ~parse_docstrings doc =
+  let n = normalize ~normalize_code ~parse_docstrings in
+  n#doc doc
diff --git a/lib/Normalize_extended_ast.ml b/lib/Normalize_extended_ast.ml
index 06c06877ce..a8ddb91ae1 100644
--- a/lib/Normalize_extended_ast.ml
+++ b/lib/Normalize_extended_ast.ml
@@ -38,32 +38,24 @@ let dedup_cmts fragment ast comments =
   in
   Set.(to_list (diff (of_list (module Cmt) comments) (of_ast ast)))
 
-let normalize_comments dedup fmt comments =
-  let comments = dedup comments in
-  List.sort comments ~compare:(fun {Cmt.loc= a; _} {Cmt.loc= b; _} ->
-      Migrate_ast.Location.compare a b )
-  |> List.iter ~f:(fun {Cmt.txt; _} -> Format.fprintf fmt "%s," txt)
-
-let normalize_parse_result ast_kind ast comments =
-  Format.asprintf "AST,%a,COMMENTS,[%a]" (Printast.ast ast_kind) ast
-    (normalize_comments (dedup_cmts ast_kind ast))
-    comments
+let normalize_parse_result ~normalize_cmts ast_kind ast comments =
+  let pp_cmt fmt cmts =
+    List.iter ~f:(fun cmt -> Format.fprintf fmt "%s," cmt) cmts
+  in
+  Format.asprintf "AST,%a,COMMENTS,[%a]" (Printast.ast ast_kind) ast pp_cmt
+    (normalize_cmts (dedup_cmts ast_kind ast comments))
 
-let normalize_code conf (m : Ast_mapper.mapper) txt =
+let normalize_code conf ~normalize_cmts (m : Ast_mapper.mapper) txt =
   let input_name = "<output>" in
   match Parse_with_comments.parse_toplevel conf ~input_name ~source:txt with
   | First {ast; comments; _} ->
-      normalize_parse_result Use_file
+      normalize_parse_result ~normalize_cmts Use_file
         (List.map ~f:(m.toplevel_phrase m) ast)
         comments
   | Second {ast; comments; _} ->
-      normalize_parse_result Repl_file
+      normalize_parse_result ~normalize_cmts Repl_file
         (List.map ~f:(m.repl_phrase m) ast)
         comments
-  | exception _ -> txt
-
-let docstring (c : Conf.t) =
-  Docstring.normalize ~parse_docstrings:c.fmt_opts.parse_docstrings.v
 
 let sort_attributes : attributes -> attributes =
   List.sort ~compare:Poly.compare
@@ -87,7 +79,11 @@ let make_mapper conf ~ignore_doc_comments =
             ; _ } as pstr ) ]
       when Ast.Attr.is_doc attr ->
         let normalize_code = normalize_code conf m in
-        let doc' = docstring conf ~normalize_code doc in
+        let parse_docstrings = conf.fmt_opts.parse_docstrings.v in
+        let doc' =
+          Normalize_cmts.normalize_docstring ~normalize_code
+            ~parse_docstrings doc
+        in
         Ast_mapper.default_mapper.attribute m
           { attr with
             attr_payload=
@@ -154,70 +150,12 @@ let make_mapper conf ~ignore_doc_comments =
 let ast fragment ~ignore_doc_comments c =
   map fragment (make_mapper c ~ignore_doc_comments)
 
-module Normalized_cmt = struct
-  type t =
-    { cmt_kind: [`Comment | `Doc_comment]
-    ; norm: string
-    ; orig: Cmt.t  (** Not compared. *) }
-
-  let compare a b = Poly.compare (a.cmt_kind, a.norm) (b.cmt_kind, b.norm)
-
-  let of_cmt ~normalize_code ~normalize_doc orig =
-    let cmt_kind, norm =
-      let decoded = Cmt.decode orig in
-      match decoded.Cmt.kind with
-      | Verbatim txt -> (`Comment, txt)
-      | Doc txt -> (`Doc_comment, normalize_doc txt)
-      | Normal txt -> (`Comment, Docstring.normalize_text txt)
-      | Code code -> (`Comment, normalize_code (String.concat ~sep:"\n" code))
-      | Asterisk_prefixed lines ->
-          ( `Comment
-          , String.concat ~sep:" "
-              (List.map ~f:Docstring.normalize_text lines) )
-    in
-    {cmt_kind; norm; orig}
-
-  let dropped {cmt_kind; orig; _} = {Cmt.kind= `Dropped orig; cmt_kind}
-
-  let added {cmt_kind; orig; _} = {Cmt.kind= `Added orig; cmt_kind}
-
-  let sexp_of_t _ = Sexp.Atom "Normalized_cmt.t"
-
-  module Comparator = struct
-    type nonrec t = t
-
-    include Comparator.Make (struct
-      type nonrec t = t
-
-      let compare, sexp_of_t = (compare, sexp_of_t)
-    end)
-  end
-end
-
-let diff ~f x y =
-  (*= [symmetric_diff x y] returns a sequence of changes between [x] and [y]:
-      - [First k] means [k] is in [x] but not [y]
-      - [Second k] means [k] is in [y] but not [x] *)
-  Set.symmetric_diff (f x) (f y)
-  |> Sequence.to_list
-  (*= - [First _] is reported as a comment dropped
-      - [Second _] is reported as a comment added *)
-  |> List.map
-       ~f:
-         (Either.value_map ~first:Normalized_cmt.dropped
-            ~second:Normalized_cmt.added )
-  |> function [] -> Ok () | errors -> Error errors
-
-let diff_cmts (conf : Conf.t) x y =
-  let mapper = make_mapper conf ~ignore_doc_comments:false in
-  let normalize_code = normalize_code conf mapper in
-  let normalize_doc = docstring conf ~normalize_code in
-  let f z =
-    let f = Normalized_cmt.of_cmt ~normalize_code ~normalize_doc in
-    Set.of_list (module Normalized_cmt.Comparator) (List.map ~f z)
-  in
-  diff ~f x y
-
 let equal fragment ~ignore_doc_comments c ast1 ast2 =
   let map = ast fragment c ~ignore_doc_comments in
   equal fragment (map ast1) (map ast2)
+
+let diff_cmts conf x y =
+  let mapper = make_mapper conf ~ignore_doc_comments:false in
+  let normalize_code = normalize_code conf mapper in
+  Normalize_cmts.diff_cmts ~normalize_code
+    ~parse_docstrings:conf.fmt_opts.parse_docstrings.v x y

From 7e9e6ab4b3436aff8d560038b89f81e6132c5081 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Wed, 31 May 2023 19:13:59 +0200
Subject: [PATCH 073/115] Revert "Normalize comments in code in comments"

This reverts commit 70e5752b06fdef97e3c729d3bbfed14888ece62a.
---
 lib/Normalize_cmts.ml         |  79 --------------------------
 lib/Normalize_extended_ast.ml | 102 +++++++++++++++++++++++++++-------
 2 files changed, 82 insertions(+), 99 deletions(-)
 delete mode 100644 lib/Normalize_cmts.ml

diff --git a/lib/Normalize_cmts.ml b/lib/Normalize_cmts.ml
deleted file mode 100644
index e9a4ff5203..0000000000
--- a/lib/Normalize_cmts.ml
+++ /dev/null
@@ -1,79 +0,0 @@
-module Normalized_cmt = struct
-  type t =
-    { cmt_kind: [`Comment | `Doc_comment]
-    ; norm: string
-    ; orig: Cmt.t  (** Not compared. *) }
-
-  let compare a b = Poly.compare (a.cmt_kind, a.norm) (b.cmt_kind, b.norm)
-
-  let of_cmt ~normalize_code ~normalize_doc orig =
-    let cmt_kind, norm =
-      let decoded = Cmt.decode orig in
-      match decoded.Cmt.kind with
-      | Verbatim txt -> (`Comment, txt)
-      | Doc txt -> (`Doc_comment, normalize_doc txt)
-      | Normal txt -> (`Comment, Docstring.normalize_text txt)
-      | Code code -> (`Comment, normalize_code (String.concat ~sep:"\n" code))
-      | Asterisk_prefixed lines ->
-          ( `Comment
-          , String.concat ~sep:" "
-              (List.map ~f:Docstring.normalize_text lines) )
-    in
-    {cmt_kind; norm; orig}
-
-  let dropped {cmt_kind; orig; _} = {Cmt.kind= `Dropped orig; cmt_kind}
-
-  let added {cmt_kind; orig; _} = {Cmt.kind= `Added orig; cmt_kind}
-
-  let sexp_of_t _ = Sexp.Atom "Normalized_cmt.t"
-
-  module Comparator = struct
-    type nonrec t = t
-
-    include Comparator.Make (struct
-      type nonrec t = t
-
-      let compare, sexp_of_t = (compare, sexp_of_t)
-    end)
-  end
-end
-
-let diff ~f x y =
-  (*= [symmetric_diff x y] returns a sequence of changes between [x] and [y]:
-      - [First k] means [k] is in [x] but not [y]
-      - [Second k] means [k] is in [y] but not [x] *)
-  Set.symmetric_diff (f x) (f y)
-  |> Sequence.to_list
-  (*= - [First _] is reported as a comment dropped
-      - [Second _] is reported as a comment added *)
-  |> List.map
-       ~f:
-         (Either.value_map ~first:Normalized_cmt.dropped
-            ~second:Normalized_cmt.added )
-  |> function [] -> Ok () | errors -> Error errors
-
-let normalize ~normalize_code ~parse_docstrings =
-  object (self)
-    method cmt c =
-      Normalized_cmt.of_cmt ~normalize_code:self#code ~normalize_doc:self#doc
-        c
-
-    method cmts cs =
-      List.map ~f:(fun c -> (self#cmt c).Normalized_cmt.norm) cs
-
-    method code c = normalize_code ~normalize_cmts:self#cmts c
-
-    method doc d =
-      Docstring.normalize ~parse_docstrings ~normalize_code:self#code d
-  end
-
-let diff_cmts ~normalize_code ~parse_docstrings x y =
-  let n = normalize ~normalize_code ~parse_docstrings in
-  let f cmts =
-    Set.of_list (module Normalized_cmt.Comparator) (List.map ~f:n#cmt cmts)
-  in
-  diff ~f x y
-
-let normalize_docstring ~normalize_code ~parse_docstrings doc =
-  let n = normalize ~normalize_code ~parse_docstrings in
-  n#doc doc
diff --git a/lib/Normalize_extended_ast.ml b/lib/Normalize_extended_ast.ml
index a8ddb91ae1..06c06877ce 100644
--- a/lib/Normalize_extended_ast.ml
+++ b/lib/Normalize_extended_ast.ml
@@ -38,24 +38,32 @@ let dedup_cmts fragment ast comments =
   in
   Set.(to_list (diff (of_list (module Cmt) comments) (of_ast ast)))
 
-let normalize_parse_result ~normalize_cmts ast_kind ast comments =
-  let pp_cmt fmt cmts =
-    List.iter ~f:(fun cmt -> Format.fprintf fmt "%s," cmt) cmts
-  in
-  Format.asprintf "AST,%a,COMMENTS,[%a]" (Printast.ast ast_kind) ast pp_cmt
-    (normalize_cmts (dedup_cmts ast_kind ast comments))
+let normalize_comments dedup fmt comments =
+  let comments = dedup comments in
+  List.sort comments ~compare:(fun {Cmt.loc= a; _} {Cmt.loc= b; _} ->
+      Migrate_ast.Location.compare a b )
+  |> List.iter ~f:(fun {Cmt.txt; _} -> Format.fprintf fmt "%s," txt)
+
+let normalize_parse_result ast_kind ast comments =
+  Format.asprintf "AST,%a,COMMENTS,[%a]" (Printast.ast ast_kind) ast
+    (normalize_comments (dedup_cmts ast_kind ast))
+    comments
 
-let normalize_code conf ~normalize_cmts (m : Ast_mapper.mapper) txt =
+let normalize_code conf (m : Ast_mapper.mapper) txt =
   let input_name = "<output>" in
   match Parse_with_comments.parse_toplevel conf ~input_name ~source:txt with
   | First {ast; comments; _} ->
-      normalize_parse_result ~normalize_cmts Use_file
+      normalize_parse_result Use_file
         (List.map ~f:(m.toplevel_phrase m) ast)
         comments
   | Second {ast; comments; _} ->
-      normalize_parse_result ~normalize_cmts Repl_file
+      normalize_parse_result Repl_file
         (List.map ~f:(m.repl_phrase m) ast)
         comments
+  | exception _ -> txt
+
+let docstring (c : Conf.t) =
+  Docstring.normalize ~parse_docstrings:c.fmt_opts.parse_docstrings.v
 
 let sort_attributes : attributes -> attributes =
   List.sort ~compare:Poly.compare
@@ -79,11 +87,7 @@ let make_mapper conf ~ignore_doc_comments =
             ; _ } as pstr ) ]
       when Ast.Attr.is_doc attr ->
         let normalize_code = normalize_code conf m in
-        let parse_docstrings = conf.fmt_opts.parse_docstrings.v in
-        let doc' =
-          Normalize_cmts.normalize_docstring ~normalize_code
-            ~parse_docstrings doc
-        in
+        let doc' = docstring conf ~normalize_code doc in
         Ast_mapper.default_mapper.attribute m
           { attr with
             attr_payload=
@@ -150,12 +154,70 @@ let make_mapper conf ~ignore_doc_comments =
 let ast fragment ~ignore_doc_comments c =
   map fragment (make_mapper c ~ignore_doc_comments)
 
-let equal fragment ~ignore_doc_comments c ast1 ast2 =
-  let map = ast fragment c ~ignore_doc_comments in
-  equal fragment (map ast1) (map ast2)
+module Normalized_cmt = struct
+  type t =
+    { cmt_kind: [`Comment | `Doc_comment]
+    ; norm: string
+    ; orig: Cmt.t  (** Not compared. *) }
+
+  let compare a b = Poly.compare (a.cmt_kind, a.norm) (b.cmt_kind, b.norm)
+
+  let of_cmt ~normalize_code ~normalize_doc orig =
+    let cmt_kind, norm =
+      let decoded = Cmt.decode orig in
+      match decoded.Cmt.kind with
+      | Verbatim txt -> (`Comment, txt)
+      | Doc txt -> (`Doc_comment, normalize_doc txt)
+      | Normal txt -> (`Comment, Docstring.normalize_text txt)
+      | Code code -> (`Comment, normalize_code (String.concat ~sep:"\n" code))
+      | Asterisk_prefixed lines ->
+          ( `Comment
+          , String.concat ~sep:" "
+              (List.map ~f:Docstring.normalize_text lines) )
+    in
+    {cmt_kind; norm; orig}
+
+  let dropped {cmt_kind; orig; _} = {Cmt.kind= `Dropped orig; cmt_kind}
+
+  let added {cmt_kind; orig; _} = {Cmt.kind= `Added orig; cmt_kind}
 
-let diff_cmts conf x y =
+  let sexp_of_t _ = Sexp.Atom "Normalized_cmt.t"
+
+  module Comparator = struct
+    type nonrec t = t
+
+    include Comparator.Make (struct
+      type nonrec t = t
+
+      let compare, sexp_of_t = (compare, sexp_of_t)
+    end)
+  end
+end
+
+let diff ~f x y =
+  (*= [symmetric_diff x y] returns a sequence of changes between [x] and [y]:
+      - [First k] means [k] is in [x] but not [y]
+      - [Second k] means [k] is in [y] but not [x] *)
+  Set.symmetric_diff (f x) (f y)
+  |> Sequence.to_list
+  (*= - [First _] is reported as a comment dropped
+      - [Second _] is reported as a comment added *)
+  |> List.map
+       ~f:
+         (Either.value_map ~first:Normalized_cmt.dropped
+            ~second:Normalized_cmt.added )
+  |> function [] -> Ok () | errors -> Error errors
+
+let diff_cmts (conf : Conf.t) x y =
   let mapper = make_mapper conf ~ignore_doc_comments:false in
   let normalize_code = normalize_code conf mapper in
-  Normalize_cmts.diff_cmts ~normalize_code
-    ~parse_docstrings:conf.fmt_opts.parse_docstrings.v x y
+  let normalize_doc = docstring conf ~normalize_code in
+  let f z =
+    let f = Normalized_cmt.of_cmt ~normalize_code ~normalize_doc in
+    Set.of_list (module Normalized_cmt.Comparator) (List.map ~f z)
+  in
+  diff ~f x y
+
+let equal fragment ~ignore_doc_comments c ast1 ast2 =
+  let map = ast fragment c ~ignore_doc_comments in
+  equal fragment (map ast1) (map ast2)

From 6061527e90d631b402836c5c586fbc13dfb07137 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Thu, 1 Jun 2023 18:20:39 +0200
Subject: [PATCH 074/115] Fix unindenting when first line is empty

---
 lib/Cmt.ml | 9 ++++++---
 1 file changed, 6 insertions(+), 3 deletions(-)

diff --git a/lib/Cmt.ml b/lib/Cmt.ml
index 007cc86f96..2e400425eb 100644
--- a/lib/Cmt.ml
+++ b/lib/Cmt.ml
@@ -104,9 +104,12 @@ let unindent_lines ~opn_offset first_line tl_lines =
     String.lfindi s ~f:(fun _ c -> not (Char.is_whitespace c))
   in
   (* The indentation of the first line must account for the location of the
-     comment opening *)
-  let fl_spaces = Option.value ~default:0 (indent_of_line first_line) in
-  let fl_indent = fl_spaces + opn_offset in
+     comment opening. Don't account for the first line if it's empty. *)
+  let fl_spaces, fl_indent =
+    match indent_of_line first_line with
+    | Some i -> (i, i + opn_offset)
+    | None -> (0, Stdlib.max_int)
+  in
   let min_indent =
     List.fold_left ~init:fl_indent
       ~f:(fun acc s ->

From 520a35ce6eb0766acae16016409d2279d27e09cd Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Thu, 1 Jun 2023 18:34:43 +0200
Subject: [PATCH 075/115] Don't unindent doc comments

The indentation of doc comments is significative for verbatim blocks.
The decision of parsing a regular comment as doc must be done before
decoding a comment.

Regressions are due to test cases previously crashing finally being run.
---
 lib/Cmt.ml                                    |    3 +-
 lib/Cmt.mli                                   |    2 +-
 lib/Cmts.ml                                   |    6 +-
 lib/Normalize_extended_ast.ml                 |   10 +-
 .../tests/break_separators-after.ml.err       |    1 -
 .../tests/break_separators-after.ml.ref       |   15 +-
 .../break_separators-after_docked.ml.err      |    3 +-
 .../break_separators-after_docked.ml.ref      |   15 +-
 .../break_separators-before_docked.ml.err     |    1 -
 .../break_separators-before_docked.ml.ref     |   15 +-
 test/passing/tests/break_separators.ml        |   15 +-
 test/passing/tests/break_separators.ml.err    |    1 -
 test/passing/tests/js_source.ml.err           |   12 +-
 test/passing/tests/js_source.ml.ocp           | 1488 ++++++++++-----
 test/passing/tests/js_source.ml.ref           | 1654 +++++++++++------
 test/passing/tests/ocp_indent_compat.ml       |   24 +-
 test/passing/tests/ocp_indent_compat.ml.err   |    2 +-
 .../passing/tests/polytypes-janestreet.ml.ref |    3 +-
 18 files changed, 2128 insertions(+), 1142 deletions(-)

diff --git a/lib/Cmt.ml b/lib/Cmt.ml
index 2e400425eb..423c5e605c 100644
--- a/lib/Cmt.ml
+++ b/lib/Cmt.ml
@@ -132,7 +132,7 @@ let split_asterisk_prefixed lines =
 
 let mk ?(prefix = "") ?(suffix = "") kind = {prefix; suffix; kind}
 
-let decode {txt; loc} =
+let decode ~parse_comments_as_doc {txt; loc} =
   let txt =
     (* Windows compatibility *)
     let f = function '\r' -> false | _ -> true in
@@ -159,6 +159,7 @@ let decode {txt; loc} =
         mk ~prefix:"$" ~suffix (Code lines)
     | '=' -> mk (Verbatim txt)
     | '*' -> mk ~prefix:"*" (Doc (String.drop_prefix txt 1))
+    | _ when parse_comments_as_doc -> mk (Doc txt)
     | _ -> (
         let prefix = if String.starts_with_whitespace txt then " " else ""
         and suffix = if String.ends_with_whitespace txt then " " else "" in
diff --git a/lib/Cmt.mli b/lib/Cmt.mli
index ed4ff5f699..d15de85bdd 100644
--- a/lib/Cmt.mli
+++ b/lib/Cmt.mli
@@ -51,4 +51,4 @@ type decoded =
   ; suffix: string  (** Just before the closing. *)
   ; kind: decoded_kind }
 
-val decode : t -> decoded
+val decode : parse_comments_as_doc:bool -> t -> decoded
diff --git a/lib/Cmts.ml b/lib/Cmts.ml
index d6365a6d56..fd42608c38 100644
--- a/lib/Cmts.ml
+++ b/lib/Cmts.ml
@@ -561,7 +561,8 @@ end
 
 let fmt_cmt (conf : Conf.t) cmt ~fmt_code (_pos : Cmt.pos) =
   let open Fmt in
-  let decoded = Cmt.decode cmt in
+  let parse_comments_as_doc = conf.fmt_opts.ocp_indent_compat.v in
+  let decoded = Cmt.decode ~parse_comments_as_doc cmt in
   (fun k ->
     hvbox 2
       (str "(*" $ str decoded.prefix $ k $ str decoded.suffix $ str "*)") )
@@ -571,9 +572,6 @@ let fmt_cmt (conf : Conf.t) cmt ~fmt_code (_pos : Cmt.pos) =
   | Doc txt -> Doc.fmt ~fmt_code conf ~loc:cmt.loc txt ~offset:2
   | Normal txt ->
       if conf.fmt_opts.wrap_comments.v then Wrapped.fmt txt
-      else if conf.fmt_opts.ocp_indent_compat.v then
-        (* TODO: [offset] should be computed from location. *)
-        Doc.fmt ~fmt_code conf ~loc:cmt.loc txt ~offset:2
       else Unwrapped.fmt txt
   | Code code -> Cinaps.fmt code
   | Asterisk_prefixed lines -> Asterisk_prefixed.fmt lines
diff --git a/lib/Normalize_extended_ast.ml b/lib/Normalize_extended_ast.ml
index 06c06877ce..181966bde2 100644
--- a/lib/Normalize_extended_ast.ml
+++ b/lib/Normalize_extended_ast.ml
@@ -162,9 +162,9 @@ module Normalized_cmt = struct
 
   let compare a b = Poly.compare (a.cmt_kind, a.norm) (b.cmt_kind, b.norm)
 
-  let of_cmt ~normalize_code ~normalize_doc orig =
+  let of_cmt ~parse_comments_as_doc ~normalize_code ~normalize_doc orig =
     let cmt_kind, norm =
-      let decoded = Cmt.decode orig in
+      let decoded = Cmt.decode ~parse_comments_as_doc orig in
       match decoded.Cmt.kind with
       | Verbatim txt -> (`Comment, txt)
       | Doc txt -> (`Doc_comment, normalize_doc txt)
@@ -209,11 +209,15 @@ let diff ~f x y =
   |> function [] -> Ok () | errors -> Error errors
 
 let diff_cmts (conf : Conf.t) x y =
+  let parse_comments_as_doc = conf.fmt_opts.ocp_indent_compat.v in
   let mapper = make_mapper conf ~ignore_doc_comments:false in
   let normalize_code = normalize_code conf mapper in
   let normalize_doc = docstring conf ~normalize_code in
   let f z =
-    let f = Normalized_cmt.of_cmt ~normalize_code ~normalize_doc in
+    let f =
+      Normalized_cmt.of_cmt ~parse_comments_as_doc ~normalize_code
+        ~normalize_doc
+    in
     Set.of_list (module Normalized_cmt.Comparator) (List.map ~f z)
   in
   diff ~f x y
diff --git a/test/passing/tests/break_separators-after.ml.err b/test/passing/tests/break_separators-after.ml.err
index 7de3e58d2b..e69de29bb2 100644
--- a/test/passing/tests/break_separators-after.ml.err
+++ b/test/passing/tests/break_separators-after.ml.err
@@ -1 +0,0 @@
-Warning: tests/break_separators.ml:289 exceeds the margin
diff --git a/test/passing/tests/break_separators-after.ml.ref b/test/passing/tests/break_separators-after.ml.ref
index a3d77ee546..391c814918 100644
--- a/test/passing/tests/break_separators-after.ml.ref
+++ b/test/passing/tests/break_separators-after.ml.ref
@@ -274,9 +274,11 @@ let x
     cccccc= cccc ccccccccccccccccccccccc }
 
 let foooooooooooooooooooooooooooooooooo =
-  { (* foooooooooooooooooooooooooooooooooooooooooooooooooooooooooo *)
+  { (* foooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
+      *)
     aaaaaaaaaaaa= aaaaaaaaaaaaaaaaa;
-    (* fooooooooooooooooooooooooooooooooooooooooooooooooooooooooo *)
+    (* fooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
+      *)
     bbbbbbbbbbbbb= bbb bb bbbbbb;
     cccccc= cccc ccccccccccccccccccccccc }
 
@@ -287,7 +289,8 @@ let foooooooooooo =
 
 let foooooooooooo =
   { foooooooooooooo with
-    (* foooooooooooooooo fooooooooooooooooooooooooo foooooooooooooooooooooo *)
+    (* foooooooooooooooo fooooooooooooooooooooooooo foooooooooooooooooooooo
+      *)
     fooooooooooooooooooooooooooooo= fooooooooooooo;
     fooooooooooooo= foooooooooooooo }
 
@@ -370,12 +373,14 @@ let g () =
        hhhhhhhhhh |] ->
       fooooooooo
 
-let () = match x with _, (* line 1 line 2 *) Some _ -> x
+let () = match x with _, (* line 1 line 2
+                           *) Some _ -> x
 
 let () =
   match x with
   | ( _,
       (* verrrrrrrrrrrrrrrrrrrrrrrry looooooooooooooooong line 1
-         veeeeeeeeeeeeeeeeeeeeeryyyy loooooooooooooooooong line 2 *)
+         veeeeeeeeeeeeeeeeeeeeeryyyy loooooooooooooooooong line 2
+        *)
       Some _ ) ->
       x
diff --git a/test/passing/tests/break_separators-after_docked.ml.err b/test/passing/tests/break_separators-after_docked.ml.err
index fd77cc8910..07c663bc61 100644
--- a/test/passing/tests/break_separators-after_docked.ml.err
+++ b/test/passing/tests/break_separators-after_docked.ml.err
@@ -1,2 +1 @@
-Warning: tests/break_separators.ml:324 exceeds the margin
-Warning: tests/break_separators.ml:334 exceeds the margin
+Warning: tests/break_separators.ml:337 exceeds the margin
diff --git a/test/passing/tests/break_separators-after_docked.ml.ref b/test/passing/tests/break_separators-after_docked.ml.ref
index 325930a4f4..c56548e895 100644
--- a/test/passing/tests/break_separators-after_docked.ml.ref
+++ b/test/passing/tests/break_separators-after_docked.ml.ref
@@ -305,9 +305,11 @@ let x
 
 let foooooooooooooooooooooooooooooooooo =
   {
-    (* foooooooooooooooooooooooooooooooooooooooooooooooooooooooooo *)
+    (* foooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
+      *)
     aaaaaaaaaaaa= aaaaaaaaaaaaaaaaa;
-    (* fooooooooooooooooooooooooooooooooooooooooooooooooooooooooo *)
+    (* fooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
+      *)
     bbbbbbbbbbbbb= bbb bb bbbbbb;
     cccccc= cccc ccccccccccccccccccccccc;
   }
@@ -322,7 +324,8 @@ let foooooooooooo =
 let foooooooooooo =
   {
     foooooooooooooo with
-    (* foooooooooooooooo fooooooooooooooooooooooooo foooooooooooooooooooooo *)
+    (* foooooooooooooooo fooooooooooooooooooooooooo foooooooooooooooooooooo
+      *)
     fooooooooooooooooooooooooooooo= fooooooooooooo;
     fooooooooooooo= foooooooooooooo;
   }
@@ -419,12 +422,14 @@ let g () =
   |] ->
       fooooooooo
 
-let () = match x with _, (* line 1 line 2 *) Some _ -> x
+let () = match x with _, (* line 1 line 2
+                           *) Some _ -> x
 
 let () =
   match x with
   | ( _,
       (* verrrrrrrrrrrrrrrrrrrrrrrry looooooooooooooooong line 1
-         veeeeeeeeeeeeeeeeeeeeeryyyy loooooooooooooooooong line 2 *)
+         veeeeeeeeeeeeeeeeeeeeeryyyy loooooooooooooooooong line 2
+        *)
       Some _ ) ->
       x
diff --git a/test/passing/tests/break_separators-before_docked.ml.err b/test/passing/tests/break_separators-before_docked.ml.err
index 43e94ebf2b..e69de29bb2 100644
--- a/test/passing/tests/break_separators-before_docked.ml.err
+++ b/test/passing/tests/break_separators-before_docked.ml.err
@@ -1 +0,0 @@
-Warning: tests/break_separators.ml:324 exceeds the margin
diff --git a/test/passing/tests/break_separators-before_docked.ml.ref b/test/passing/tests/break_separators-before_docked.ml.ref
index 63a5e062e7..490662cadd 100644
--- a/test/passing/tests/break_separators-before_docked.ml.ref
+++ b/test/passing/tests/break_separators-before_docked.ml.ref
@@ -305,9 +305,11 @@ let x
 
 let foooooooooooooooooooooooooooooooooo =
   {
-    (* foooooooooooooooooooooooooooooooooooooooooooooooooooooooooo *)
+    (* foooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
+      *)
     aaaaaaaaaaaa= aaaaaaaaaaaaaaaaa
-  ; (* fooooooooooooooooooooooooooooooooooooooooooooooooooooooooo *)
+  ; (* fooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
+      *)
     bbbbbbbbbbbbb= bbb bb bbbbbb
   ; cccccc= cccc ccccccccccccccccccccccc
   }
@@ -322,7 +324,8 @@ let foooooooooooo =
 let foooooooooooo =
   {
     foooooooooooooo with
-    (* foooooooooooooooo fooooooooooooooooooooooooo foooooooooooooooooooooo *)
+    (* foooooooooooooooo fooooooooooooooooooooooooo foooooooooooooooooooooo
+      *)
     fooooooooooooooooooooooooooooo= fooooooooooooo
   ; fooooooooooooo= foooooooooooooo
   }
@@ -419,12 +422,14 @@ let g () =
   |] ->
       fooooooooo
 
-let () = match x with _, (* line 1 line 2 *) Some _ -> x
+let () = match x with _, (* line 1 line 2
+                           *) Some _ -> x
 
 let () =
   match x with
   | ( _
     , (* verrrrrrrrrrrrrrrrrrrrrrrry looooooooooooooooong line 1
-         veeeeeeeeeeeeeeeeeeeeeryyyy loooooooooooooooooong line 2 *)
+         veeeeeeeeeeeeeeeeeeeeeryyyy loooooooooooooooooong line 2
+        *)
       Some _ ) ->
       x
diff --git a/test/passing/tests/break_separators.ml b/test/passing/tests/break_separators.ml
index 5d5af4f814..d7bd56273d 100644
--- a/test/passing/tests/break_separators.ml
+++ b/test/passing/tests/break_separators.ml
@@ -274,9 +274,11 @@ let x
   ; cccccc= cccc ccccccccccccccccccccccc }
 
 let foooooooooooooooooooooooooooooooooo =
-  { (* foooooooooooooooooooooooooooooooooooooooooooooooooooooooooo *)
+  { (* foooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
+      *)
     aaaaaaaaaaaa= aaaaaaaaaaaaaaaaa
-  ; (* fooooooooooooooooooooooooooooooooooooooooooooooooooooooooo *)
+  ; (* fooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
+      *)
     bbbbbbbbbbbbb= bbb bb bbbbbb
   ; cccccc= cccc ccccccccccccccccccccccc }
 
@@ -287,7 +289,8 @@ let foooooooooooo =
 
 let foooooooooooo =
   { foooooooooooooo with
-    (* foooooooooooooooo fooooooooooooooooooooooooo foooooooooooooooooooooo *)
+    (* foooooooooooooooo fooooooooooooooooooooooooo foooooooooooooooooooooo
+      *)
     fooooooooooooooooooooooooooooo= fooooooooooooo
   ; fooooooooooooo= foooooooooooooo }
 
@@ -370,12 +373,14 @@ let g () =
      ; hhhhhhhhhh |] ->
       fooooooooo
 
-let () = match x with _, (* line 1 line 2 *) Some _ -> x
+let () = match x with _, (* line 1 line 2
+                           *) Some _ -> x
 
 let () =
   match x with
   | ( _
     , (* verrrrrrrrrrrrrrrrrrrrrrrry looooooooooooooooong line 1
-         veeeeeeeeeeeeeeeeeeeeeryyyy loooooooooooooooooong line 2 *)
+         veeeeeeeeeeeeeeeeeeeeeryyyy loooooooooooooooooong line 2
+        *)
       Some _ ) ->
       x
diff --git a/test/passing/tests/break_separators.ml.err b/test/passing/tests/break_separators.ml.err
index 7de3e58d2b..e69de29bb2 100644
--- a/test/passing/tests/break_separators.ml.err
+++ b/test/passing/tests/break_separators.ml.err
@@ -1 +0,0 @@
-Warning: tests/break_separators.ml:289 exceeds the margin
diff --git a/test/passing/tests/js_source.ml.err b/test/passing/tests/js_source.ml.err
index 9ba7830b7d..476feacb17 100644
--- a/test/passing/tests/js_source.ml.err
+++ b/test/passing/tests/js_source.ml.err
@@ -1,7 +1,5 @@
-Warning: tests/js_source.ml:155 exceeds the margin
-Warning: tests/js_source.ml:3556 exceeds the margin
-Warning: tests/js_source.ml:9522 exceeds the margin
-Warning: tests/js_source.ml:9625 exceeds the margin
-Warning: tests/js_source.ml:9644 exceeds the margin
-Warning: tests/js_source.ml:9684 exceeds the margin
-Warning: tests/js_source.ml:9768 exceeds the margin
+Warning: tests/js_source.ml:162 exceeds the margin
+Warning: tests/js_source.ml:3741 exceeds the margin
+Warning: tests/js_source.ml:9978 exceeds the margin
+Warning: tests/js_source.ml:10082 exceeds the margin
+Warning: tests/js_source.ml:10236 exceeds the margin
diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp
index 613b954f1b..2f1758a61d 100644
--- a/test/passing/tests/js_source.ml.ocp
+++ b/test/passing/tests/js_source.ml.ocp
@@ -77,7 +77,8 @@ and _ = ()
 
 let%foo _ = ()
 
-(* Expressions *)
+(* Expressions
+*)
 let () =
   let%foo[@foo] x = 3
   and[@foo] y = 4 in
@@ -113,12 +114,14 @@ let () =
   [%foo new x [@foo]];
   [%foo
     match[@foo] () with
-    | [%foo? (* Pattern expressions *)
+    | [%foo? (* Pattern expressions
+             *)
              ((lazy x) [@foo])] -> ()
     | [%foo? ((exception x) [@foo])] -> ()]
 ;;
 
-(* Class expressions *)
+(* Class expressions
+*)
 class x =
   fun [@foo] x ->
   let[@foo] x = 3 in
@@ -133,7 +136,8 @@ class x =
     initializer x [@@foo]
   end [@foo]
 
-(* Class type expressions *)
+(* Class type expressions
+*)
 class type t = object
   inherit t [@@foo]
   val x : t [@@foo]
@@ -146,13 +150,16 @@ class type t = object
   [@@@aaa]
 end[@foo]
 
-(* Type expressions *)
+(* Type expressions
+*)
 type t = [%foo: ((module M)[@foo])]
 
-(* Module expressions *)
+(* Module expressions
+*)
 module M = (functor [@foo] (M : S) -> (val x) [@foo] (struct end [@foo]))
 
-(* Module type expression *)
+(* Module type expression
+*)
 module type S = functor [@foo] (M : S) -> functor (_ : (module type of M) [@foo]) -> sig end
                                                                                      [@foo]
 
@@ -168,7 +175,8 @@ module type S = sig
   and B : (S with type t = t)
 end
 
-(* Structure items *)
+(* Structure items
+*)
 let%foo[@foo] x = 4
 and[@foo] y = x
 
@@ -189,7 +197,8 @@ module type%foo S = S [@@foo]
 include%foo M [@@foo]
 open%foo M [@@foo]
 
-(* Signature items *)
+(* Signature items
+*)
 module type S = sig
   val%foo x : t [@@foo]
   external%foo x : t = "" [@@foo]
@@ -226,7 +235,8 @@ open M;;
 
 ([%extension_constructor A] : extension_constructor)
 
-(* By using two types we can have a recursive constraint *)
+(* By using two types we can have a recursive constraint
+*)
 type 'a class_name = .. constraint 'a = < cast : 'a. 'a name -> 'a ; .. >
 and 'a name = Class : 'a class_name -> (< cast : 'a. 'a name -> 'a ; .. > as 'a) name
 
@@ -255,7 +265,8 @@ class foo : foo_t =
     method foo = "foo"
   end
 
-(* Now we can create a subclass of foo *)
+(* Now we can create a subclass of foo
+*)
 
 class type bar_t = object
   inherit foo
@@ -278,7 +289,8 @@ class bar : bar_t =
     [%%id]
   end
 
-(* Now lets create a mutable list of castable objects *)
+(* Now lets create a mutable list of castable objects
+*)
 
 let clist : castable list ref = ref []
 let push_castable (c : #castable) = clist := (c :> castable) :: !clist
@@ -291,7 +303,8 @@ let pop_castable () =
   | [] -> raise Not_found
 ;;
 
-(* We can add foos and bars to this list, and retrive them *)
+(* We can add foos and bars to this list, and retrive them
+*)
 
 push_castable (new foo);;
 push_castable (new bar);;
@@ -301,27 +314,34 @@ let c1 : castable = pop_castable ()
 let c2 : castable = pop_castable ()
 let c3 : castable = pop_castable ()
 
-(* We can also downcast these values to foos and bars *)
+(* We can also downcast these values to foos and bars
+*)
 
 let f1 : foo = c1#cast (Class Foo)
 
-(* Ok *)
+(* Ok
+*)
 let f2 : foo = c2#cast (Class Foo)
 
-(* Ok *)
+(* Ok
+*)
 let f3 : foo = c3#cast (Class Foo)
 
-(* Ok *)
+(* Ok
+*)
 
 let b1 : bar = c1#cast (Class Bar)
 
-(* Exception Bad_cast *)
+(* Exception Bad_cast
+*)
 let b2 : bar = c2#cast (Class Bar)
 
-(* Ok *)
+(* Ok
+*)
 let b3 : bar = c3#cast (Class Bar)
 
-(* Exception Bad_cast *)
+(* Exception Bad_cast
+*)
 
 type foo = ..
 type foo += A | B of int
@@ -332,31 +352,39 @@ let is_a x =
   | _ -> false
 ;;
 
-(* The type must be open to create extension *)
+(* The type must be open to create extension
+*)
 
 type foo
-type foo += A of int (* Error type is not open *)
+type foo += A of int (* Error type is not open
+                     *)
 
-(* The type parameters must match *)
+(* The type parameters must match
+*)
 
 type 'a foo = ..
-type ('a, 'b) foo += A of int (* Error: type parameter mismatch *)
+type ('a, 'b) foo += A of int (* Error: type parameter mismatch
+                              *)
 
-(* In a signature the type does not have to be open *)
+(* In a signature the type does not have to be open
+*)
 
 module type S = sig
   type foo
   type foo += A of float
 end
 
-(* But it must still be extensible *)
+(* But it must still be extensible
+*)
 
 module type S = sig
   type foo = A of int
-  type foo += B of float (* Error foo does not have an extensible type *)
+  type foo += B of float (* Error foo does not have an extensible type
+                         *)
 end
 
-(* Signatures can change the grouping of extensions *)
+(* Signatures can change the grouping of extensions
+*)
 
 type foo = ..
 
@@ -373,7 +401,8 @@ end
 
 module M_S : S = M
 
-(* Extensions can be GADTs *)
+(* Extensions can be GADTs
+*)
 
 type 'a foo = ..
 type _ foo += A : int -> int foo | B : int foo
@@ -385,16 +414,20 @@ let get_num : type a. a foo -> a -> a option =
   | _ -> None
 ;;
 
-(* Extensions must obey constraints *)
+(* Extensions must obey constraints
+*)
 
 type 'a foo = .. constraint 'a = [> `Var ]
 type 'a foo += A of 'a
 
-let a = A 9 (* ERROR: Constraints not met *)
+let a = A 9 (* ERROR: Constraints not met
+            *)
 
-type 'a foo += B : int foo (* ERROR: Constraints not met *)
+type 'a foo += B : int foo (* ERROR: Constraints not met
+                           *)
 
-(* Signatures can make an extension private *)
+(* Signatures can make an extension private
+*)
 
 type foo = ..
 
@@ -416,9 +449,11 @@ let is_s x =
   | _ -> false
 ;;
 
-let a2 = M_S.A 20 (* ERROR: Cannot create a value using a private constructor *)
+let a2 = M_S.A 20 (* ERROR: Cannot create a value using a private constructor
+                  *)
 
-(* Extensions can be rebound *)
+(* Extensions can be rebound
+*)
 
 type foo = ..
 
@@ -428,17 +463,21 @@ end
 
 type foo += A2 = M.A1
 type bar = ..
-type bar += A3 = M.A1 (* Error: rebind wrong type *)
+type bar += A3 = M.A1 (* Error: rebind wrong type
+                      *)
 
 module M = struct
   type foo += private B1 of int
 end
 
 type foo += private B2 = M.B1
-type foo += B3 = M.B1 (* Error: rebind private extension *)
-type foo += C = Unknown (* Error: unbound extension *)
+type foo += B3 = M.B1 (* Error: rebind private extension
+                      *)
+type foo += C = Unknown (* Error: unbound extension
+                        *)
 
-(* Extensions can be rebound even if type is closed *)
+(* Extensions can be rebound even if type is closed
+*)
 
 module M : sig
   type foo
@@ -450,7 +489,8 @@ end
 
 type M.foo += A2 = M.A1
 
-(* Rebinding handles abbreviations *)
+(* Rebinding handles abbreviations
+*)
 
 type 'a foo = ..
 type 'a foo1 = 'a foo = ..
@@ -458,20 +498,25 @@ type 'a foo2 = 'a foo = ..
 type 'a foo1 += A of int | B of 'a | C : int foo1
 type 'a foo2 += D = A | E = B | F = C
 
-(* Extensions must obey variances *)
+(* Extensions must obey variances
+*)
 
 type +'a foo = ..
 type 'a foo += A of (int -> 'a)
 type 'a foo += B of ('a -> int)
-(* ERROR: Parameter variances are not satisfied *)
+(* ERROR: Parameter variances are not satisfied
+*)
 
 type _ foo += C : ('a -> int) -> 'a foo
-(* ERROR: Parameter variances are not satisfied *)
+(* ERROR: Parameter variances are not satisfied
+*)
 
 type 'a bar = ..
-type +'a bar += D of (int -> 'a) (* ERROR: type variances do not match *)
+type +'a bar += D of (int -> 'a) (* ERROR: type variances do not match
+                                 *)
 
-(* Exceptions are compatible with extensions *)
+(* Exceptions are compatible with extensions
+*)
 
 module M : sig
   type exn += Foo of int * float | Bar : 'a list -> exn
@@ -497,27 +542,33 @@ end = struct
   exception Foo = Foo
 end
 
-(* Test toplevel printing *)
+(* Test toplevel printing
+*)
 
 type foo = ..
 type foo += Foo of int * int option | Bar of int option
 
-let x = Foo (3, Some 4), Bar (Some 5) (* Prints Foo and Bar successfully *)
+let x = Foo (3, Some 4), Bar (Some 5) (* Prints Foo and Bar successfully
+                                      *)
 
 type foo += Foo of string
 
-let y = x (* Prints Bar but not Foo (which has been shadowed) *)
+let y = x (* Prints Bar but not Foo (which has been shadowed)
+          *)
 
 exception Foo of int * int option
 exception Bar of int option
 
-let x = Foo (3, Some 4), Bar (Some 5) (* Prints Foo and Bar successfully *)
+let x = Foo (3, Some 4), Bar (Some 5) (* Prints Foo and Bar successfully
+                                      *)
 
 type foo += Foo of string
 
-let y = x (* Prints Bar and part of Foo (which has been shadowed) *)
+let y = x (* Prints Bar and part of Foo (which has been shadowed)
+          *)
 
-(* Test Obj functions *)
+(* Test Obj functions
+*)
 
 type foo = ..
 type foo += Foo | Bar of int
@@ -526,14 +577,17 @@ let extension_name e = Obj.extension_name (Obj.extension_constructor e)
 let extension_id e = Obj.extension_id (Obj.extension_constructor e)
 let n1 = extension_name Foo
 let n2 = extension_name (Bar 1)
-let t = extension_id (Bar 2) = extension_id (Bar 3) (* true *)
-let f = extension_id (Bar 2) = extension_id Foo (* false *)
+let t = extension_id (Bar 2) = extension_id (Bar 3) (* true
+                                                    *)
+let f = extension_id (Bar 2) = extension_id Foo (* false
+                                                *)
 let is_foo x = extension_id Foo = extension_id x
 
 type foo += Foo
 
 let f = is_foo Foo
-let _ = Obj.extension_constructor 7 (* Invald_arg *)
+let _ = Obj.extension_constructor 7 (* Invald_arg
+                                    *)
 
 let _ =
   Obj.extension_constructor
@@ -542,9 +596,11 @@ let _ =
     end)
 ;;
 
-(* Invald_arg *)
+(* Invald_arg
+*)
 
-(* Typed names *)
+(* Typed names
+*)
 
 module Msg : sig
   type 'a tag
@@ -602,7 +658,8 @@ end = struct
     write_raw k.label content
   ;;
 
-  (* Add int kind *)
+  (* Add int kind
+  *)
 
   type 'a tag += Int : int tag
 
@@ -618,7 +675,8 @@ end = struct
     Hashtbl.add writeTbl (T Int) { f }
   ;;
 
-  (* Support user defined kinds *)
+  (* Support user defined kinds
+  *)
 
   module type Desc = sig
     type t
@@ -667,7 +725,8 @@ let read_one () =
   | _ -> print_string "Unknown"
 ;;
 
-(* Example of algorithm parametrized with modules *)
+(* Example of algorithm parametrized with modules
+*)
 
 let sort (type s) set l =
   let module Set = (val set : Set.S with type elt = s) in
@@ -694,7 +753,8 @@ let () =
     (String.concat "  " (List.map (String.concat "/") (both [ "abc"; "xyz"; "def" ])))
 ;;
 
-(* Hiding the internal representation *)
+(* Hiding the internal representation
+*)
 
 module type S = sig
   type t
@@ -743,7 +803,8 @@ let () =
   List.iter print (List.map apply [ int; apply int; apply (apply str) ])
 ;;
 
-(* Existential types + type equality witnesses -> pseudo GADT *)
+(* Existential types + type equality witnesses -> pseudo GADT
+*)
 
 module TypEq : sig
   type ('a, 'b) t
@@ -830,7 +891,8 @@ let () =
   print_endline (Print.to_string (pair int (pair str int)) (123, ("A", 456)))
 ;;
 
-(* #6262: first-class modules and module type aliases *)
+(* #6262: first-class modules and module type aliases
+*)
 
 module type S1 = sig end
 module type S2 = S1
@@ -847,7 +909,8 @@ end
 
 let _f (x : (module X.S)) : (module Y.S) = x
 
-(* PR#6194, main example *)
+(* PR#6194, main example
+*)
 module type S3 = sig
   val x : bool
 end
@@ -875,7 +938,8 @@ let fbool (type t) (x : t) (tag : t ty) =
   | Bool -> x
 ;;
 
-(* val fbool : 'a -> 'a ty -> 'a = <fun> *)
+(* val fbool : 'a -> 'a ty -> 'a = <fun>
+*)
 
 (** OK: the return value is x of type t **)
 
@@ -884,7 +948,8 @@ let fint (type t) (x : t) (tag : t ty) =
   | Int -> x > 0
 ;;
 
-(* val fint : 'a -> 'a ty -> bool = <fun> *)
+(* val fint : 'a -> 'a ty -> bool = <fun>
+*)
 
 (** OK: the return value is x > 0 of type bool;
     This has used the equation t = bool, not visible in the return type **)
@@ -895,7 +960,8 @@ let f (type t) (x : t) (tag : t ty) =
   | Bool -> x
 ;;
 
-(* val f : 'a -> 'a ty -> bool = <fun> *)
+(* val f : 'a -> 'a ty -> bool = <fun>
+*)
 
 let g (type t) (x : t) (tag : t ty) =
   match tag with
@@ -904,7 +970,8 @@ let g (type t) (x : t) (tag : t ty) =
 ;;
 
 (* Error: This expression has type bool but an expression was expected of type
-   t = int *)
+   t = int
+*)
 
 let id x = x
 
@@ -934,7 +1001,8 @@ let g (type t) (x : t) (tag : t ty) =
 (* (c) Alain Frisch / Lexifi *)
 (* cf. http://www.lexifi.com/blog/dynamic-types *)
 
-(* Basic tag *)
+(* Basic tag
+*)
 
 type 'a ty =
   | Int : int ty
@@ -942,7 +1010,8 @@ type 'a ty =
   | List : 'a ty -> 'a list ty
   | Pair : ('a ty * 'b ty) -> ('a * 'b) ty
 
-(* Tagging data *)
+(* Tagging data
+*)
 
 type variant =
   | VInt of int
@@ -952,15 +1021,20 @@ type variant =
 
 let rec variantize : type t. t ty -> t -> variant =
   fun ty x ->
-  (* type t is abstract here *)
+  (* type t is abstract here
+  *)
   match ty with
-  | Int -> VInt x (* in this branch: t = int *)
-  | String -> VString x (* t = string *)
-  | List ty1 -> VList (List.map (variantize ty1) x) (* t = 'a list for some 'a *)
+  | Int -> VInt x (* in this branch: t = int
+                  *)
+  | String -> VString x (* t = string
+                        *)
+  | List ty1 -> VList (List.map (variantize ty1) x) (* t = 'a list for some 'a
+                                                    *)
   | Pair (ty1, ty2) -> VPair (variantize ty1 (fst x), variantize ty2 (snd x))
 ;;
 
-(* t = ('a, 'b) for some 'a and 'b *)
+(* t = ('a, 'b) for some 'a and 'b
+*)
 
 exception VariantMismatch
 
@@ -974,7 +1048,8 @@ let rec devariantize : type t. t ty -> variant -> t =
   | _ -> raise VariantMismatch
 ;;
 
-(* Handling records *)
+(* Handling records
+*)
 
 type 'a ty =
   | Int : int ty
@@ -996,7 +1071,8 @@ and ('a, 'b) field =
   ; get : 'a -> 'b
   }
 
-(* Again *)
+(* Again
+*)
 
 type variant =
   | VInt of int
@@ -1007,14 +1083,19 @@ type variant =
 
 let rec variantize : type t. t ty -> t -> variant =
   fun ty x ->
-  (* type t is abstract here *)
+  (* type t is abstract here
+  *)
   match ty with
-  | Int -> VInt x (* in this branch: t = int *)
-  | String -> VString x (* t = string *)
-  | List ty1 -> VList (List.map (variantize ty1) x) (* t = 'a list for some 'a *)
+  | Int -> VInt x (* in this branch: t = int
+                  *)
+  | String -> VString x (* t = string
+                        *)
+  | List ty1 -> VList (List.map (variantize ty1) x) (* t = 'a list for some 'a
+                                                    *)
   | Pair (ty1, ty2) ->
     VPair (variantize ty1 (fst x), variantize ty2 (snd x))
-  (* t = ('a, 'b) for some 'a and 'b *)
+  (* t = ('a, 'b) for some 'a and 'b
+  *)
   | Record { fields } ->
     VRecord
       (List.map
@@ -1022,7 +1103,8 @@ let rec variantize : type t. t ty -> t -> variant =
          fields)
 ;;
 
-(* Extraction *)
+(* Extraction
+*)
 
 type 'a ty =
   | Int : int ty
@@ -1108,13 +1190,16 @@ type (_, _) ty =
   | List : ('a, 'e) ty -> ('a list, 'e) ty
   | Option : ('a, 'e) ty -> ('a option, 'e) ty
   | Pair : (('a, 'e) ty * ('b, 'e) ty) -> ('a * 'b, 'e) ty
-  (* Support for type variables and recursive types *)
+  (* Support for type variables and recursive types
+  *)
   | Var : ('a, 'a -> 'e) ty
   | Rec : ('a, 'a -> 'e) ty -> ('a, 'e) ty
   | Pop : ('a, 'e) ty -> ('a, 'b -> 'e) ty
-  (* Change the representation of a type *)
+  (* Change the representation of a type
+  *)
   | Conv : string * ('a -> 'b) * ('b -> 'a) * ('b, 'e) ty -> ('a, 'e) ty
-  (* Sum types (both normal sums and polymorphic variants) *)
+  (* Sum types (both normal sums and polymorphic variants)
+  *)
   | Sum : ('a, 'e, 'b) ty_sum -> ('a, 'e) ty
 
 and ('a, 'e, 'b) ty_sum =
@@ -1123,25 +1208,30 @@ and ('a, 'e, 'b) ty_sum =
   ; sum_inj : 'c. ('b, 'c) ty_sel * 'c -> 'a
   }
 
-and 'e ty_dyn = (* dynamic type *)
+and 'e ty_dyn = (* dynamic type
+                *)
   | Tdyn : ('a, 'e) ty * 'a -> 'e ty_dyn
 
 and (_, _) ty_sel =
-  (* selector from a list of types *)
+  (* selector from a list of types
+  *)
   | Thd : ('a -> 'b, 'a) ty_sel
   | Ttl : ('b -> 'c, 'd) ty_sel -> ('a -> 'b -> 'c, 'd) ty_sel
 
 and (_, _) ty_case =
-  (* type a sum case *)
+  (* type a sum case
+  *)
   | TCarg : ('b, 'a) ty_sel * ('a, 'e) ty -> ('e, 'b) ty_case
   | TCnoarg : ('b, noarg) ty_sel -> ('e, 'b) ty_case
 
 type _ ty_env =
-  (* type variable substitution *)
+  (* type variable substitution
+  *)
   | Enil : unit ty_env
   | Econs : ('a, 'e) ty * 'e ty_env -> ('a -> 'e) ty_env
 
-(* Comparing selectors *)
+(* Comparing selectors
+*)
 type (_, _) eq = Eq : ('a, 'a) eq
 
 let rec eq_sel : type a b c. (a, b) ty_sel -> (a, c) ty_sel -> (b, c) eq option =
@@ -1155,7 +1245,8 @@ let rec eq_sel : type a b c. (a, b) ty_sel -> (a, c) ty_sel -> (b, c) eq option
   | _ -> None
 ;;
 
-(* Auxiliary function to get the type of a case from its selector *)
+(* Auxiliary function to get the type of a case from its selector
+*)
 let rec get_case
   : type a b e.
     (b, a) ty_sel -> (string * (e, b) ty_case) list -> string * (a, e) ty option
@@ -1173,7 +1264,8 @@ let rec get_case
   | [] -> raise Not_found
 ;;
 
-(* Untyped representation of values *)
+(* Untyped representation of values
+*)
 type variant =
   | VInt of int
   | VString of string
@@ -1240,13 +1332,15 @@ let rec devariantize : type t e. e ty_env -> (t, e) ty -> variant -> t =
   | _ -> raise VariantMismatch
 ;;
 
-(* First attempt: represent 1-constructor variants using Conv *)
+(* First attempt: represent 1-constructor variants using Conv
+*)
 let wrap_A t = Conv ("`A", (fun (`A x) -> x), (fun x -> `A x), t)
 let ty a = Rec (wrap_A (Option (Pair (a, Var))))
 let v = variantize Enil (ty Int)
 let x = v (`A (Some (1, `A (Some (2, `A None)))))
 
-(* Can also use it to decompose a tuple *)
+(* Can also use it to decompose a tuple
+*)
 
 let triple t1 t2 t3 =
   Conv
@@ -1258,14 +1352,17 @@ let triple t1 t2 t3 =
 
 let v = variantize Enil (triple String Int Int) ("A", 2, 3)
 
-(* Second attempt: introduce a real sum construct *)
+(* Second attempt: introduce a real sum construct
+*)
 let ty_abc =
-  (* Could also use [get_case] for proj, but direct definition is shorter *)
+  (* Could also use [get_case] for proj, but direct definition is shorter
+  *)
   let proj = function
     | `A n -> "A", Some (Tdyn (Int, n))
     | `B s -> "B", Some (Tdyn (String, s))
     | `C -> "C", None
-  (* Define inj in advance to be able to write the type annotation easily *)
+  (* Define inj in advance to be able to write the type annotation easily
+  *)
   and inj
     : type c.
       (int -> string -> noarg -> unit, c) ty_sel * c -> [ `A of int | `B of string | `C ]
@@ -1274,7 +1371,8 @@ let ty_abc =
       | Ttl Thd, v -> `B v
       | Ttl (Ttl Thd), Noarg -> `C
   in
-  (* Coherence of sum_inj and sum_cases is checked by the typing *)
+  (* Coherence of sum_inj and sum_cases is checked by the typing
+  *)
   Sum
     { sum_proj = proj
     ; sum_inj = inj
@@ -1289,7 +1387,8 @@ let ty_abc =
 let v = variantize Enil ty_abc (`A 3)
 let a = devariantize Enil ty_abc v
 
-(* And an example with recursion... *)
+(* And an example with recursion...
+*)
 type 'a vlist =
   [ `Nil
   | `Cons of 'a * 'a vlist
@@ -1310,13 +1409,15 @@ let ty_list : type a e. (a, e) ty -> (a vlist, e) ty =
               function
               | Thd, Noarg -> `Nil
               | Ttl Thd, v -> `Cons v)
-           (* One can also write the type annotation directly *)
+           (* One can also write the type annotation directly
+           *)
        })
 ;;
 
 let v = variantize Enil (ty_list Int) (`Cons (1, `Cons (2, `Nil)))
 
-(* Simpler but weaker approach *)
+(* Simpler but weaker approach
+*)
 
 type (_, _) ty =
   | Int : (int, _) ty
@@ -1335,7 +1436,8 @@ type (_, _) ty =
 and 'e ty_dyn = Tdyn : ('a, 'e) ty * 'a -> 'e ty_dyn
 
 let ty_abc : ([ `A of int | `B of string | `C ], 'e) ty =
-  (* Could also use [get_case] for proj, but direct definition is shorter *)
+  (* Could also use [get_case] for proj, but direct definition is shorter
+  *)
   Sum
     ( (function
         | `A n -> "A", Some (Tdyn (Int, n))
@@ -1348,7 +1450,8 @@ let ty_abc : ([ `A of int | `B of string | `C ], 'e) ty =
       | _ -> invalid_arg "ty_abc" )
 ;;
 
-(* Breaks: no way to pattern-match on a full recursive type *)
+(* Breaks: no way to pattern-match on a full recursive type
+*)
 let ty_list : type a e. (a, e) ty -> (a vlist, e) ty =
   fun t ->
   let targ = Pair (Pop t, Var) in
@@ -1362,7 +1465,8 @@ let ty_list : type a e. (a, e) ty -> (a vlist, e) ty =
          | "Cons", Some (Tdyn (Pair (_, Var), (p : a * a vlist))) -> `Cons p ))
 ;;
 
-(* Define Sum using object instead of record for first-class polymorphism *)
+(* Define Sum using object instead of record for first-class polymorphism
+*)
 
 type (_, _) ty =
   | Int : (int, _) ty
@@ -1457,7 +1561,8 @@ let ty_list : type a e. (a, e) ty -> (a vlist, e) ty =
    http://web.cecs.pdx.edu/~sheard/
 *)
 
-(* Basic types *)
+(* Basic types
+*)
 
 type ('a, 'b) sum =
   | Inl of 'a
@@ -1470,7 +1575,8 @@ type _ nat =
   | NZ : zero nat
   | NS : 'a nat -> 'a succ nat
 
-(* 2: A simple example *)
+(* 2: A simple example
+*)
 
 type (_, _) seq =
   | Snil : ('a, zero) seq
@@ -1481,7 +1587,8 @@ let l1 = Scons (3, Scons (5, Snil))
 (* We do not have type level functions, so we need to use witnesses. *)
 (* We copy here the definitions from section 3.9 *)
 (* Note the addition of the ['a nat] argument to PlusZ, since we do not
-   have kinds *)
+   have kinds
+*)
 type (_, _, _) plus =
   | PlusZ : 'a nat -> (zero, 'a, 'a) plus
   | PlusS : ('a, 'b, 'c) plus -> ('a succ, 'b, 'c succ) plus
@@ -1492,7 +1599,8 @@ let rec length : type a n. (a, n) seq -> n nat = function
 ;;
 
 (* app returns the catenated lists with a witness proving that
-   the size is the sum of its two inputs *)
+   the size is the sum of its two inputs
+*)
 type (_, _, _) app = App : ('a, 'p) seq * ('n, 'm, 'p) plus -> ('a, 'n, 'm) app
 
 let rec app : type a n m. (a, n) seq -> (a, m) seq -> (a, n, m) app =
@@ -1504,9 +1612,11 @@ let rec app : type a n m. (a, n) seq -> (a, m) seq -> (a, n, m) app =
     App (Scons (x, xs''), PlusS pl)
 ;;
 
-(* 3.1 Feature: kinds *)
+(* 3.1 Feature: kinds
+*)
 
-(* We do not have kinds, but we can encode them as predicates *)
+(* We do not have kinds, but we can encode them as predicates
+*)
 
 type tp = TP
 type nd = ND
@@ -1524,7 +1634,8 @@ type _ boolean =
   | BT : tt boolean
   | BF : ff boolean
 
-(* 3.3 Feature : GADTs *)
+(* 3.3 Feature : GADTs
+*)
 
 type (_, _) path =
   | Pnone : 'a -> (tp, 'a) path
@@ -1557,7 +1668,8 @@ let rec extract : type sh. (sh, 'a) path -> (sh, 'a) tree -> 'a =
   | Pright p, Tfork (_, r) -> extract p r
 ;;
 
-(* 3.4 Pattern : Witness *)
+(* 3.4 Pattern : Witness
+*)
 
 type (_, _) le =
   | LeZ : 'a nat -> (zero, 'a) le
@@ -1584,7 +1696,8 @@ let rec summandLessThanSum : type a b c. (a, b, c) plus -> (a, c) le =
   | PlusS p' -> LeS (summandLessThanSum p')
 ;;
 
-(* 3.8 Pattern: Leibniz Equality *)
+(* 3.8 Pattern: Leibniz Equality
+*)
 
 type (_, _) equal = Eq : ('a, 'a) equal
 
@@ -1601,7 +1714,8 @@ let rec sameNat : type a b. a nat -> b nat -> (a, b) equal option =
   | _ -> None
 ;;
 
-(* Extra: associativity of addition *)
+(* Extra: associativity of addition
+*)
 
 let rec plus_func : type a b m n. (a, b, m) plus -> (a, b, n) plus -> (m, n) equal =
   fun p1 p2 ->
@@ -1631,9 +1745,11 @@ let rec plus_assoc
     Eq
 ;;
 
-(* 3.9 Computing Programs and Properties Simultaneously *)
+(* 3.9 Computing Programs and Properties Simultaneously
+*)
 
-(* Plus and app1 are moved to section 2 *)
+(* Plus and app1 are moved to section 2
+*)
 
 let smaller : type a b. (a succ, b succ) le -> (a, b) le = function
   | LeS x -> x
@@ -1664,7 +1780,8 @@ let rec diff : type a b. (a, b) le -> a nat -> b nat -> (a, b) diff =
 let rec diff : type a b. (a, b) le -> a nat -> b nat -> (a, b) diff =
   fun le a b ->
   match a, b, le with
-  (* warning *)
+  (* warning
+  *)
   | NZ, m, LeZ _ -> Diff (m, PlusZ m)
   | NS x, NS y, LeS q ->
     (match diff q x y with
@@ -1698,7 +1815,8 @@ let rec filter : type a n. (a -> bool) -> (a, n) seq -> (a, n) filter =
        if f a then Filter (LeS le, Scons (a, l')) else Filter (leS' le, l'))
 ;;
 
-(* 4.1 AVL trees *)
+(* 4.1 AVL trees
+*)
 
 type (_, _, _) balance =
   | Less : ('h, 'h succ, 'h succ) balance
@@ -1852,7 +1970,8 @@ let delete x (Avl t) =
   | Ddecr (_, t) -> Avl t
 ;;
 
-(* Exercise 22: Red-black trees *)
+(* Exercise 22: Red-black trees
+*)
 
 type red = RED
 type black = BLACK
@@ -1941,7 +2060,8 @@ let rec ins : type c n. int -> (c, n) sub_tree -> (c, n) ctxt -> rb_tree =
 
 let insert e (Root t) = ins e t CNil
 
-(* 5.7 typed object languages using GADTs *)
+(* 5.7 typed object languages using GADTs
+*)
 
 type _ term =
   | Const : int -> int term
@@ -2029,7 +2149,8 @@ let ex3 = Abs ("x", Rint, Ap (Add, Pair (Var ("x", Rint), Var ("x", Rint))))
 let ex4 = Ap (ex3, Const 3)
 let v4 = eval_term [] ex4
 
-(* 5.9/5.10 Language with binding *)
+(* 5.9/5.10 Language with binding
+*)
 
 type rnil = RNIL
 type ('a, 'b, 'c) rcons = RCons of 'a * 'b * 'c
@@ -2079,10 +2200,12 @@ let double = Abs (X, App (App (Shift add, Var X), Var X))
 let ex3 = App (double, _3)
 let v3 = eval_lam env0 ex3
 
-(* 5.13: Constructing typing derivations at runtime *)
+(* 5.13: Constructing typing derivations at runtime
+*)
 
 (* Modified slightly to use the language of 5.10, since this is more fun.
-   Of course this works also with the language of 5.12. *)
+   Of course this works also with the language of 5.12.
+*)
 
 type _ rep =
   | I : int rep
@@ -2172,7 +2295,8 @@ let eval_checked env = function
 
 let v2 = eval_checked env0 c2
 
-(* 5.12 Soundness *)
+(* 5.12 Soundness
+*)
 
 type pexp = PEXP
 type pval = PVAL
@@ -2279,10 +2403,12 @@ let f : type env a. (env, a) typ -> (env, a) typ -> int =
   | Tint, Tint -> 0
   | Tbool, Tbool -> 1
   | Tvar var, tb -> 2
-  | _ -> . (* error *)
+  | _ -> . (* error
+           *)
 ;;
 
-(* let x = f Tint (Tvar Zero) ;; *)
+(* let x = f Tint (Tvar Zero) ;;
+*)
 type inkind =
   [ `Link
   | `Nonlink
@@ -2325,7 +2451,8 @@ let inlineseq_from_astseq seq =
   List.map process_any seq
 ;;
 
-(* OK *)
+(* OK
+*)
 type _ linkp =
   | Nonlink : [ `Nonlink ] linkp
   | Maylink : inkind linkp
@@ -2345,7 +2472,8 @@ let inlineseq_from_astseq seq =
   List.map (process Maylink) seq
 ;;
 
-(* Bad *)
+(* Bad
+*)
 type _ linkp2 = Kind : 'a linkp -> ([< inkind ] as 'a) linkp2
 
 let inlineseq_from_astseq seq =
@@ -2422,7 +2550,8 @@ type tag =
 type 'a poly =
   | AandBTags : [< `TagA of int | `TagB ] poly
   | ATag : [< `TagA of int ] poly
-  (* constraint 'a = [< `TagA of int | `TagB] *)
+  (* constraint 'a = [< `TagA of int | `TagB]
+  *)
 
 let intA = function
   | `TagA i -> i
@@ -2443,10 +2572,12 @@ let example6 : type a. a wrapPoly -> a -> int =
   fun w ->
   match w with
   | WrapPoly ATag -> intA
-  | WrapPoly _ -> intA (* This should not be allowed *)
+  | WrapPoly _ -> intA (* This should not be allowed
+                       *)
 ;;
 
-let _ = example6 (WrapPoly AandBTags) `TagB (* This causes a seg fault *)
+let _ = example6 (WrapPoly AandBTags) `TagB (* This causes a seg fault
+                                            *)
 
 module F (S : sig
     type 'a t
@@ -2594,7 +2725,8 @@ let f (Aux x) =
   | Succ (Succ Zero) -> "2"
   | Succ (Succ (Succ Zero)) -> "3"
   | Succ (Succ (Succ (Succ Zero))) -> "4"
-  | _ -> . (* error *)
+  | _ -> . (* error
+           *)
 ;;
 
 type _ t = C : ((('a -> 'o) -> 'o) -> ('b -> 'o) -> 'o) t
@@ -2722,14 +2854,16 @@ type (_, _) t =
 
 let get1 (Cons (x, _) : (_ * 'a, 'a) t) = x
 
-(* warn, cf PR#6993 *)
+(* warn, cf PR#6993
+*)
 
 let get1' = function
   | (Cons (x, _) : (_ * 'a, 'a) t) -> x
   | Nil -> assert false
 ;;
 
-(* ok *)
+(* ok
+*)
 type _ t =
   | Int : int -> int t
   | String : string -> string t
@@ -2749,7 +2883,8 @@ type _ t = I : int t
 
 let f (type a) (x : a t) =
   let module M = struct
-    let (I : a t) = x (* fail because of toplevel let *)
+    let (I : a t) = x (* fail because of toplevel let
+                      *)
     let x = (I : a t)
   end
   in
@@ -2765,7 +2900,8 @@ let bad (type a) =
     module rec M : sig
       val e : (int, a) eq
     end = struct
-      let (Refl : (int, a) eq) = M.e (* must fail for soundness *)
+      let (Refl : (int, a) eq) = M.e (* must fail for soundness
+                                     *)
       let e : (int, a) eq = Refl
     end
   end
@@ -2792,7 +2928,8 @@ let undetected : ('a -> 'b -> nil) t -> 'a n -> 'b n -> unit =
 
 type _ t = T : int t
 
-(* Should raise Not_found *)
+(* Should raise Not_found
+*)
 let _ =
   match (raise Not_found : float t) with
   | _ -> .
@@ -2806,13 +2943,15 @@ type 'a t
 
 let f (type a) (Neq n : (a, a t) eq) = n
 
-(* warn! *)
+(* warn!
+*)
 
 module F (T : sig
     type _ t
   end) =
 struct
-  let f (type a) (Neq n : (a, a T.t) eq) = n (* warn! *)
+  let f (type a) (Neq n : (a, a T.t) eq) = n (* warn!
+                                             *)
 end
 
 (* First-Order Unification by Structural Recursion *)
@@ -2822,7 +2961,8 @@ end
 (* This is a translation of the code part to ocaml *)
 (* Of course, we do not prove other properties, not even termination *)
 
-(* 2.2 Inductive Families *)
+(* 2.2 Inductive Families
+*)
 
 type zero = Zero
 type _ succ = Succ
@@ -2838,9 +2978,11 @@ type _ fin =
 (* We cannot define
    val empty : zero fin -> 'a
    because we cannot write an empty pattern matching.
-   This might be useful to have *)
+   This might be useful to have
+*)
 
-(* In place, prove that the parameter is 'a succ *)
+(* In place, prove that the parameter is 'a succ
+*)
 type _ is_succ = IS : 'a succ is_succ
 
 let fin_succ : type n. n fin -> n is_succ = function
@@ -2848,7 +2990,8 @@ let fin_succ : type n. n fin -> n is_succ = function
   | FS _ -> IS
 ;;
 
-(* 3 First-Order Terms, Renaming and Substitution *)
+(* 3 First-Order Terms, Renaming and Substitution
+*)
 
 type 'a term =
   | Var of 'a fin
@@ -2866,9 +3009,11 @@ let rec pre_subst f = function
 
 let comp_subst f g (x : 'a fin) = pre_subst f (g x)
 (* val comp_subst :
-   ('b fin -> 'c term) -> ('a fin -> 'b term) -> 'a fin -> 'c term *)
+   ('b fin -> 'c term) -> ('a fin -> 'b term) -> 'a fin -> 'c term
+*)
 
-(* 4 The Occur-Check, through thick and thin *)
+(* 4 The Occur-Check, through thick and thin
+*)
 
 let rec thin : type n. n succ fin -> n fin -> n succ fin =
   fun x y ->
@@ -2884,7 +3029,8 @@ let bind t f =
   | Some x -> f x
 ;;
 
-(* val bind : 'a option -> ('a -> 'b option) -> 'b option *)
+(* val bind : 'a option -> ('a -> 'b option) -> 'b option
+*)
 
 let rec thick : type n. n succ fin -> n succ fin -> n fin option =
   fun x y ->
@@ -2914,12 +3060,15 @@ let subst_var x t' y =
   | Some y' -> Var y'
 ;;
 
-(* val subst_var : 'a succ fin -> 'a term -> 'a succ fin -> 'a term *)
+(* val subst_var : 'a succ fin -> 'a term -> 'a succ fin -> 'a term
+*)
 
 let subst x t' = pre_subst (subst_var x t')
-(* val subst : 'a succ fin -> 'a term -> 'a succ term -> 'a term *)
+(* val subst : 'a succ fin -> 'a term -> 'a succ term -> 'a term
+*)
 
-(* 5 A Refinement of Substitution *)
+(* 5 A Refinement of Substitution
+*)
 
 type (_, _) alist =
   | Anil : ('n, 'n) alist
@@ -2941,7 +3090,8 @@ type _ ealist = EAlist : ('a, 'b) alist -> 'a ealist
 
 let asnoc a t' x = EAlist (Asnoc (a, t', x))
 
-(* Extra work: we need sub to work on ealist too, for examples *)
+(* Extra work: we need sub to work on ealist too, for examples
+*)
 let rec weaken_fin : type n. n fin -> n succ fin = function
   | FZ -> FZ
   | FS x -> FS (weaken_fin x)
@@ -2961,9 +3111,11 @@ let rec sub' : type m. m ealist -> m fin -> m term = function
 ;;
 
 let subst' d = pre_subst (sub' d)
-(* val subst' : 'a ealist -> 'a term -> 'a term *)
+(* val subst' : 'a ealist -> 'a term -> 'a term
+*)
 
-(* 6 First-Order Unification *)
+(* 6 First-Order Unification
+*)
 
 let flex_flex x y =
   match thick x y with
@@ -2971,10 +3123,12 @@ let flex_flex x y =
   | None -> EAlist Anil
 ;;
 
-(* val flex_flex : 'a succ fin -> 'a succ fin -> 'a succ ealist *)
+(* val flex_flex : 'a succ fin -> 'a succ fin -> 'a succ ealist
+*)
 
 let flex_rigid x t = bind (check x t) (fun t' -> Some (asnoc Anil t' x))
-(* val flex_rigid : 'a succ fin -> 'a succ term -> 'a succ ealist option *)
+(* val flex_rigid : 'a succ fin -> 'a succ term -> 'a succ ealist option
+*)
 
 let rec amgu : type m. m term -> m term -> m ealist -> m ealist option =
   fun s t acc ->
@@ -2999,7 +3153,8 @@ let rec amgu : type m. m term -> m term -> m ealist -> m ealist option =
 ;;
 
 let mgu s t = amgu s t (EAlist Anil)
-(* val mgu : 'a term -> 'a term -> 'a ealist option *)
+(* val mgu : 'a term -> 'a term -> 'a ealist option
+*)
 
 let s = Fork (Var FZ, Fork (Var (FS (FS FZ)), Leaf))
 let t = Fork (Var (FS FZ), Var (FS FZ))
@@ -3013,7 +3168,8 @@ let d =
 let s' = subst' d s
 let t' = subst' d t
 
-(* Injectivity *)
+(* Injectivity
+*)
 
 type (_, _) eq = Refl : ('a, 'a) eq
 
@@ -3035,7 +3191,8 @@ let magic : 'a 'b. 'a -> 'b =
   M.f Refl
 ;;
 
-(* Variance and subtyping *)
+(* Variance and subtyping
+*)
 
 type (_, +_) eq = Refl : ('a, 'a) eq
 
@@ -3054,7 +3211,8 @@ let magic : 'a 'b. 'a -> 'b =
   #m
 ;;
 
-(* Record patterns *)
+(* Record patterns
+*)
 
 type _ t =
   | IntLit : int t
@@ -3087,19 +3245,24 @@ module type S = sig type t [@@immediate] end
 module F : functor (M : S) -> S
 |}]
 
-(* VALID DECLARATIONS *)
+(* VALID DECLARATIONS
+*)
 
 module A = struct
-  (* Abstract types can be immediate *)
+  (* Abstract types can be immediate
+  *)
   type t [@@immediate]
 
-  (* [@@immediate] tag here is unnecessary but valid since t has it *)
+  (* [@@immediate] tag here is unnecessary but valid since t has it
+  *)
   type s = t [@@immediate]
 
-  (* Again, valid alias even without tag *)
+  (* Again, valid alias even without tag
+  *)
   type r = s
 
-  (* Mutually recursive declarations work as well *)
+  (* Mutually recursive declarations work as well
+  *)
   type p = q [@@immediate]
   and q = int
 end
@@ -3116,7 +3279,8 @@ module A :
   end
 |}]
 
-(* Valid using with constraints *)
+(* Valid using with constraints
+*)
 module type X = sig
   type t
 end
@@ -3136,7 +3300,8 @@ module Y : sig type t = int end
 module Z : sig type t [@@immediate] end
 |}]
 
-(* Valid using an explicit signature *)
+(* Valid using an explicit signature
+*)
 module M_valid : S = struct
   type t = int
 end
@@ -3150,7 +3315,8 @@ module M_valid : S
 module FM_valid : S
 |}]
 
-(* Practical usage over modules *)
+(* Practical usage over modules
+*)
 module Foo : sig
   type t
 
@@ -3211,11 +3377,14 @@ 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 "With @@immediate: %fs\n" (test test_bar)
+*)
 
-(* INVALID DECLARATIONS *)
+(* INVALID DECLARATIONS
+*)
 
-(* Cannot directly declare a non-immediate type as immediate *)
+(* Cannot directly declare a non-immediate type as immediate
+*)
 module B = struct
   type t = string [@@immediate]
 end
@@ -3227,7 +3396,8 @@ Error: Types marked with the immediate attribute must be
        non-pointer types like int or bool
 |}]
 
-(* Not guaranteed that t is immediate, so this is an invalid declaration *)
+(* Not guaranteed that t is immediate, so this is an invalid declaration
+*)
 module C = struct
   type t
   type s = t [@@immediate]
@@ -3240,7 +3410,8 @@ Error: Types marked with the immediate attribute must be
        non-pointer types like int or bool
 |}]
 
-(* Can't ascribe to an immediate type signature with a non-immediate type *)
+(* Can't ascribe to an immediate type signature with a non-immediate type
+*)
 module D : sig
   type t [@@immediate]
 end = struct
@@ -3262,7 +3433,8 @@ Error: Signature mismatch:
        the first is not an immediate type.
 |}]
 
-(* Same as above but with explicit signature *)
+(* Same as above but with explicit signature
+*)
 module M_invalid : S = struct
   type t = string
 end
@@ -3283,7 +3455,8 @@ Error: Signature mismatch:
        the first is not an immediate type.
 |}]
 
-(* Can't use a non-immediate type even if mutually recursive *)
+(* Can't use a non-immediate type even if mutually recursive
+*)
 module E = struct
   type t = s [@@immediate]
   and s = string
@@ -3306,14 +3479,17 @@ Error: Types marked with the immediate attribute must be
    New: implicit pack is also supported, and you only need to be able
    to infer the the module type path from the context.
 *)
-(* ocaml -principal *)
+(* ocaml -principal
+*)
 
-(* Use a module pattern *)
+(* Use a module pattern
+*)
 let sort (type s) (module Set : Set.S with type elt = s) l =
   Set.elements (List.fold_right Set.add l Set.empty)
 ;;
 
-(* No real improvement here? *)
+(* No real improvement here?
+*)
 let make_set (type s) cmp : (module Set.S with type elt = s) =
   (module Set.Make (struct
        type t = s
@@ -3322,7 +3498,8 @@ let make_set (type s) cmp : (module Set.S with type elt = s) =
      end))
 ;;
 
-(* No type annotation here *)
+(* No type annotation here
+*)
 let sort_cmp (type s) cmp =
   sort
     (module Set.Make (struct
@@ -3341,7 +3518,8 @@ end
 let f (module M : S with type t = int) = M.x
 let f (module M : S with type t = 'a) = M.x
 
-(* Error *)
+(* Error
+*)
 let f (type a) (module M : S with type t = a) = M.x;;
 
 f
@@ -3363,7 +3541,8 @@ type 'a s = { s : (module S with type t = 'a) };;
 
 let f { s = (module M) } = M.x
 
-(* Error *)
+(* Error
+*)
 let f (type a) ({ s = (module M) } : a s) = M.x
 
 type s = { s : (module S with type t = int) }
@@ -3383,7 +3562,8 @@ let m =
   end)
 ;;
 
-(* Error *)
+(* Error
+*)
 let m =
   (module struct
     let x = 3
@@ -3405,12 +3585,14 @@ M.x
 
 let (module M) = m
 
-(* Error: only allowed in [let .. in] *)
+(* Error: only allowed in [let .. in]
+*)
 class c =
   let (module M) = m in
   object end
 
-(* Error again *)
+(* Error again
+*)
 module M = (val m)
 
 module type S' = sig
@@ -3418,7 +3600,8 @@ module type S' = sig
 end
 ;;
 
-(* Even works with recursion, but must be fully explicit *)
+(* Even works with recursion, but must be fully explicit
+*)
 let rec (module M : S') =
   (module struct
     let f n = if n <= 0 then 1 else n * M.f (n - 1)
@@ -3426,7 +3609,8 @@ let rec (module M : S') =
 in
 M.f 3
 
-(* Subtyping *)
+(* Subtyping
+*)
 
 module type S = sig
   type t
@@ -3503,7 +3687,8 @@ let rec to_string : 'a. 'a Typ.typ -> 'a -> string =
     Printf.sprintf "(%s,%s)" (to_string P.t1 x1) (to_string P.t2 x2)
 ;;
 
-(* Wrapping maps *)
+(* Wrapping maps
+*)
 module type MapT = sig
   include Map.S
 
@@ -3565,7 +3750,8 @@ add ssmap
 open StdLabels
 open MoreLabels
 
-(* Use maps for substitutions and sets for free variables *)
+(* Use maps for substitutions and sets for free variables
+*)
 
 module Subst = Map.Make (struct
     type t = string
@@ -3579,7 +3765,8 @@ module Names = Set.Make (struct
     let compare = compare
   end)
 
-(* Variables are common to lambda and expr *)
+(* Variables are common to lambda and expr
+*)
 
 type var = [ `Var of string ]
 
@@ -3593,7 +3780,8 @@ let free_var : var -> _ = function
   | `Var s -> Names.singleton s
 ;;
 
-(* The lambda language: free variables, substitutions, and evaluation *)
+(* The lambda language: free variables, substitutions, and evaluation
+*)
 
 type 'a lambda =
   [ `Var of string
@@ -3648,13 +3836,15 @@ let eval_lambda ~eval_rec ~subst l =
   | t -> t
 ;;
 
-(* Specialized versions to use on lambda *)
+(* Specialized versions to use on lambda
+*)
 
 let rec free1 x = free_lambda ~free_rec:free1 x
 let rec subst1 ~subst = subst_lambda ~subst_rec:subst1 ~free:free1 ~subst
 let rec eval1 x = eval_lambda ~eval_rec:eval1 ~subst:subst1 x
 
-(* The expr language of arithmetic expressions *)
+(* The expr language of arithmetic expressions
+*)
 
 type 'a expr =
   [ `Var of string
@@ -3672,7 +3862,8 @@ let free_expr ~free_rec : _ expr -> _ = function
   | `Mult (x, y) -> Names.union (free_rec x) (free_rec y)
 ;;
 
-(* Here map_expr helps a lot *)
+(* Here map_expr helps a lot
+*)
 let map_expr ~map_rec : _ expr -> _ = function
   | #var as x -> x
   | `Num _ as x -> x
@@ -3702,13 +3893,15 @@ let eval_expr ~eval_rec e =
   | #expr as e -> e
 ;;
 
-(* Specialized versions *)
+(* Specialized versions
+*)
 
 let rec free2 x = free_expr ~free_rec:free2 x
 let rec subst2 ~subst = subst_expr ~subst_rec:subst2 ~subst
 let rec eval2 x = eval_expr ~eval_rec:eval2 x
 
-(* The lexpr language, reunion of lambda and expr *)
+(* The lexpr language, reunion of lambda and expr
+*)
 
 type lexpr =
   [ `Var of string
@@ -3770,12 +3963,14 @@ let () =
   print_newline ()
 ;;
 
-(* Full fledge version, using objects to structure code *)
+(* Full fledge version, using objects to structure code
+*)
 
 open StdLabels
 open MoreLabels
 
-(* Use maps for substitutions and sets for free variables *)
+(* Use maps for substitutions and sets for free variables
+*)
 
 module Subst = Map.Make (struct
     type t = string
@@ -3789,7 +3984,8 @@ module Names = Set.Make (struct
     let compare = compare
   end)
 
-(* To build recursive objects *)
+(* To build recursive objects
+*)
 
 let lazy_fix make =
   let rec obj () = make (lazy (obj ()) : _ Lazy.t) in
@@ -3798,7 +3994,8 @@ let lazy_fix make =
 
 let ( !! ) = Lazy.force
 
-(* The basic operations *)
+(* The basic operations
+*)
 
 class type ['a, 'b] ops = object
   method free : x:'b -> ?y:'c -> Names.t
@@ -3806,7 +4003,8 @@ class type ['a, 'b] ops = object
   method eval : 'b -> 'a
 end
 
-(* Variables are common to lambda and expr *)
+(* Variables are common to lambda and expr
+*)
 
 type var = [ `Var of string ]
 
@@ -3822,7 +4020,8 @@ class ['a] var_ops =
     method eval (#var as v) = v
   end
 
-(* The lambda language: free variables, substitutions, and evaluation *)
+(* The lambda language: free variables, substitutions, and evaluation
+*)
 
 type 'a lambda =
   [ `Var of string
@@ -3885,11 +4084,13 @@ class ['a] lambda_ops (ops : ('a, 'a) #ops Lazy.t) =
       | t -> t
   end
 
-(* Operations specialized to lambda *)
+(* Operations specialized to lambda
+*)
 
 let lambda = lazy_fix (new lambda_ops)
 
-(* The expr language of arithmetic expressions *)
+(* The expr language of arithmetic expressions
+*)
 
 type 'a expr =
   [ `Var of string
@@ -3944,11 +4145,13 @@ class ['a] expr_ops (ops : ('a, 'a) #ops Lazy.t) =
       | e -> e
   end
 
-(* Specialized versions *)
+(* Specialized versions
+*)
 
 let expr = lazy_fix (new expr_ops)
 
-(* The lexpr language, reunion of lambda and expr *)
+(* The lexpr language, reunion of lambda and expr
+*)
 
 type 'a lexpr =
   [ 'a lambda
@@ -4016,12 +4219,14 @@ let () =
   print_newline ()
 ;;
 
-(* Full fledge version, using objects to structure code *)
+(* Full fledge version, using objects to structure code
+*)
 
 open StdLabels
 open MoreLabels
 
-(* Use maps for substitutions and sets for free variables *)
+(* Use maps for substitutions and sets for free variables
+*)
 
 module Subst = Map.Make (struct
     type t = string
@@ -4035,7 +4240,8 @@ module Names = Set.Make (struct
     let compare = compare
   end)
 
-(* To build recursive objects *)
+(* To build recursive objects
+*)
 
 let lazy_fix make =
   let rec obj () = make (lazy (obj ()) : _ Lazy.t) in
@@ -4044,7 +4250,8 @@ let lazy_fix make =
 
 let ( !! ) = Lazy.force
 
-(* The basic operations *)
+(* The basic operations
+*)
 
 class type ['a, 'b] ops = object
   method free : 'b -> Names.t
@@ -4052,7 +4259,8 @@ class type ['a, 'b] ops = object
   method eval : 'b -> 'a
 end
 
-(* Variables are common to lambda and expr *)
+(* Variables are common to lambda and expr
+*)
 
 type var = [ `Var of string ]
 
@@ -4067,7 +4275,8 @@ let var =
   end
 ;;
 
-(* The lambda language: free variables, substitutions, and evaluation *)
+(* The lambda language: free variables, substitutions, and evaluation
+*)
 
 type 'a lambda =
   [ `Var of string
@@ -4128,11 +4337,13 @@ let lambda_ops (ops : ('a, 'a) #ops Lazy.t) =
   end
 ;;
 
-(* Operations specialized to lambda *)
+(* Operations specialized to lambda
+*)
 
 let lambda = lazy_fix lambda_ops
 
-(* The expr language of arithmetic expressions *)
+(* The expr language of arithmetic expressions
+*)
 
 type 'a expr =
   [ `Var of string
@@ -4185,11 +4396,13 @@ let expr_ops (ops : ('a, 'a) #ops Lazy.t) =
   end
 ;;
 
-(* Specialized versions *)
+(* Specialized versions
+*)
 
 let expr = lazy_fix expr_ops
 
-(* The lexpr language, reunion of lambda and expr *)
+(* The lexpr language, reunion of lambda and expr
+*)
 
 type 'a lexpr =
   [ 'a lambda
@@ -4368,11 +4581,13 @@ let _ = foo ()
 
 type 'a t = [ `A of 'a t t ] as 'a
 
-(* fails *)
+(* fails
+*)
 
 type 'a t = [ `A of 'a t t ]
 
-(* fails *)
+(* fails
+*)
 
 type 'a t = [ `A of 'a t t ] constraint 'a = 'a t
 type 'a t = [ `A of 'a t ] constraint 'a = 'a t
@@ -4382,17 +4597,20 @@ type 'a v = [ `A of u v ] constraint 'a = t
 and t = u
 and u = t
 
-(* fails *)
+(* fails
+*)
 
 type 'a t = 'a
 
 let f (x : 'a t as 'a) = ()
 
-(* fails *)
+(* fails
+*)
 
 let f (x : 'a t) (y : 'a) = x = y
 
-(* PR#6505 *)
+(* PR#6505
+*)
 module type PR6505 = sig
   type 'o is_an_object = < .. > as 'o
   and 'o abs constraint 'o = 'o is_an_object
@@ -4401,13 +4619,16 @@ val abs : 'o is_an_object -> 'o abs
 val unabs : 'o abs -> 'o
 end
 
-(* fails *)
-(* PR#5835 *)
+(* fails
+*)
+(* PR#5835
+*)
 let f ~x = x + 1;;
 
 f ?x:0
 
-(* PR#6352 *)
+(* PR#6352
+*)
 let foo (f : unit -> unit) = ()
 let g ?x () = ();;
 
@@ -4416,11 +4637,14 @@ foo
    g)
 ;;
 
-(* PR#5748 *)
+(* PR#5748
+*)
 foo (fun ?opt () -> ())
 
-(* fails *)
-(* PR#5907 *)
+(* fails
+*)
+(* PR#5907
+*)
 
 type 'a t = 'a
 
@@ -4456,15 +4680,18 @@ let f (x : [< `A | `B ]) =
   | `A | `B | `C -> 0
 ;;
 
-(* warn *)
+(* warn
+*)
 let f (x : [ `A | `B ]) =
   match x with
   | `A | `B | `C -> 0
 ;;
 
-(* fail *)
+(* fail
+*)
 
-(* PR#6787 *)
+(* PR#6787
+*)
 let revapply x f = f x
 
 let f x (g : [< `Foo ]) =
@@ -4472,7 +4699,8 @@ let f x (g : [< `Foo ]) =
   revapply y (fun (`Bar i, _) -> i)
 ;;
 
-(* f : 'a -> [< `Foo ] -> 'a *)
+(* f : 'a -> [< `Foo ] -> 'a
+*)
 
 let rec x =
   [| x |];
@@ -4495,7 +4723,8 @@ let _ = fun (x : a t) -> f x
 let _ = fun (x : a t) -> g x
 let _ = fun (x : a t) -> h x
 
-(* PR#7012 *)
+(* PR#7012
+*)
 
 type t =
   [ 'A_name
@@ -4505,7 +4734,8 @@ type t =
 let f (x : 'id_arg) = x
 let f (x : 'Id_arg) = x
 
-(* undefined labels *)
+(* undefined labels
+*)
 type t =
   { x : int
   ; y : int
@@ -4515,16 +4745,19 @@ type t =
 { x = 3; z = 2 };;
 fun { x = 3; z = 2 } -> ();;
 
-(* mixed labels *)
+(* mixed labels
+*)
 { x = 3; contents = 2 }
 
-(* private types *)
+(* private types
+*)
 type u = private { mutable u : int };;
 
 { u = 3 };;
 fun x -> x.u <- 3
 
-(* Punning and abbreviations *)
+(* Punning and abbreviations
+*)
 module M = struct
   type t =
     { x : int
@@ -4536,12 +4769,14 @@ let f { M.x; y } = x + y
 let r = { M.x = 1; y = 2 }
 let z = f r
 
-(* messages *)
+(* messages
+*)
 type foo = { mutable y : int }
 
 let f (r : int) = r.y <- 3
 
-(* bugs *)
+(* bugs
+*)
 type foo =
   { y : int
   ; z : int
@@ -4557,10 +4792,12 @@ let r : foo = { ZZZ.x = 2 };;
 
 (ZZZ.X : int option)
 
-(* PR#5865 *)
+(* PR#5865
+*)
 let f (x : Complex.t) = x.Complex.z
 
-(* PR#6394 *)
+(* PR#6394
+*)
 
 module rec X : sig
   type t = int * bool
@@ -4574,7 +4811,8 @@ end = struct
   ;;
 end
 
-(* PR#6768 *)
+(* PR#6768
+*)
 
 type _ prod = Prod : ('a * 'y) prod
 
@@ -4606,7 +4844,8 @@ end =
 let f1 (x : (_, _) Hash1.t) : (_, _) Hashtbl.t = x
 let f2 (x : (_, _) Hash2.t) : (_, _) Hashtbl.t = x
 
-(* Another case, not using include *)
+(* Another case, not using include
+*)
 
 module Std2 = struct
   module M = struct
@@ -4753,7 +4992,8 @@ struct
   module X = (val if !flag then (module A) else (module B) : S.T)
 end
 
-(* If the above were accepted, one could break soundness *)
+(* If the above were accepted, one could break soundness
+*)
 module type S = sig
   type t
 
@@ -4943,7 +5183,8 @@ module X = struct
   end
 end
 
-(* open X  (* works! *) *)
+(* open X  (* works! *)
+*)
 module Y = X.Y
 
 type 'a arg_t = 'at constraint 'a = (module Y.S with type t = 'at)
@@ -4973,12 +5214,15 @@ module type S = sig
 end
 
 let f (type a) (module X : S with type t = a) = ()
-let _ = f (module A) (* ok *)
+let _ = f (module A) (* ok
+                     *)
 
 module A_annotated_alias : S with type t = (module A.A_S) = A
 
-let _ = f (module A_annotated_alias) (* ok *)
-let _ = f (module A_annotated_alias : S with type t = (module A.A_S)) (* ok *)
+let _ = f (module A_annotated_alias) (* ok
+                                     *)
+let _ = f (module A_annotated_alias : S with type t = (module A.A_S)) (* ok
+                                                                      *)
 
 module A_alias = A
 
@@ -4986,10 +5230,14 @@ module A_alias_expanded = struct
   include A_alias
 end
 
-let _ = f (module A_alias_expanded : S with type t = (module A.A_S)) (* ok *)
-let _ = f (module A_alias_expanded) (* ok *)
-let _ = f (module A_alias : S with type t = (module A.A_S)) (* doesn't type *)
-let _ = f (module A_alias) (* doesn't type either *)
+let _ = f (module A_alias_expanded : S with type t = (module A.A_S)) (* ok
+                                                                     *)
+let _ = f (module A_alias_expanded) (* ok
+                                    *)
+let _ = f (module A_alias : S with type t = (module A.A_S)) (* doesn't type
+                                                            *)
+let _ = f (module A_alias) (* doesn't type either
+                           *)
 
 module Foo
     (Bar : sig
@@ -5005,7 +5253,8 @@ module Bazoinks = struct
 end
 
 module Bug = Foo (Bazoinks) (Bazoinks)
-(* PR#6992, reported by Stephen Dolan *)
+(* PR#6992, reported by Stephen Dolan
+*)
 
 type (_, _) eq = Eq : ('a, 'a) eq
 
@@ -5061,7 +5310,8 @@ module type FOO = sig
 end
 
 module type BAR = sig
-  (* Works: module rec A : (sig include FOO with type t = < b:B.t > end) *)
+  (* Works: module rec A : (sig include FOO with type t = < b:B.t > end)
+  *)
   module rec A : (FOO with type t = < b : B.t >)
   and B : FOO
 end
@@ -5146,7 +5396,8 @@ end = struct
   let add_dec dec = Fast.attach Dem.key dec
 end
 
-(* simpler version *)
+(* simpler version
+*)
 
 module Simple = struct
   type 'a t
@@ -5209,7 +5460,8 @@ module rec M : sig
 end = struct
   external f : int -> int = "%identity"
 end
-(* with module *)
+(* with module
+*)
 
 module type S = sig
   type t
@@ -5225,7 +5477,8 @@ end
 
 module type S' = S with module M := String
 
-(* with module type *)
+(* with module type
+*)
 (*
    module type S = sig module type T module F(X:T) : T end;;
    module type T0 = sig type t end;;
@@ -5244,7 +5497,8 @@ module type S' = S with module M := String
    end;;
 *)
 
-(* A subtle problem appearing with -principal *)
+(* A subtle problem appearing with -principal
+*)
 type -'a t
 
 class type c = object
@@ -5260,21 +5514,24 @@ end = struct
   ;;
 end
 
-(* PR#4838 *)
+(* PR#4838
+*)
 
 let id =
   let module M = struct end in
   fun x -> x
 ;;
 
-(* PR#4511 *)
+(* PR#4511
+*)
 
 let ko =
   let module M = struct end in
   fun _ -> ()
 ;;
 
-(* PR#5993 *)
+(* PR#5993
+*)
 
 module M : sig
   type -'a t = private int
@@ -5282,7 +5539,8 @@ end = struct
   type +'a t = private int
 end
 
-(* PR#6005 *)
+(* PR#6005
+*)
 
 module type A = sig
   type t = X of int
@@ -5292,7 +5550,8 @@ type u = X of bool
 
 module type B = A with type t = u
 
-(* fail *)
+(* fail
+*)
 
 (* PR#5815 *)
 (* ---> duplicated exception name is now an error *)
@@ -5302,7 +5561,8 @@ module type S = sig
   exception Foo of bool
 end
 
-(* PR#6410 *)
+(* PR#6410
+*)
 
 module F (X : sig end) = struct
   let x = 3
@@ -5311,7 +5571,8 @@ end
 
 F.x
 
-(* fail *)
+(* fail
+*)
 module C = Char;;
 
 C.chr 66
@@ -5349,7 +5610,8 @@ module G (X : sig end) = struct
   module M = X
 end
 
-(* does not alias X *)
+(* does not alias X
+*)
 module M = G (struct end)
 
 module M' = struct
@@ -5492,7 +5754,8 @@ end =
   M
 ;;
 
-(* sound, but should probably fail *)
+(* sound, but should probably fail
+*)
 M1.C'.escaped 'A'
 
 module M2 : sig
@@ -5541,14 +5804,16 @@ struct
   module C = X.C
 end
 
-(* Applicative functors *)
+(* Applicative functors
+*)
 module S = String
 module StringSet = Set.Make (String)
 module SSet = Set.Make (S)
 
 let f (x : StringSet.t) : SSet.t = x
 
-(* Also using include (cf. Leo's mail 2013-11-16) *)
+(* Also using include (cf. Leo's mail 2013-11-16)
+*)
 module F (M : sig end) : sig
   type t
 end = struct
@@ -5590,7 +5855,8 @@ end
 
 module M = struct
   module X = struct end
-  module Y = FF (X) (* XXX *)
+  module Y = FF (X) (* XXX
+                    *)
 
   type t = Y.t
 end
@@ -5609,7 +5875,8 @@ module G = F (M.Y)
 (*module N = G (M);;
   module N = F (M.Y) (M);;*)
 
-(* PR#6307 *)
+(* PR#6307
+*)
 
 module A1 = struct end
 module A2 = struct end
@@ -5625,12 +5892,15 @@ end
 module F (L : module type of L1) = struct end
 module F1 = F (L1)
 
-(* ok *)
+(* ok
+*)
 module F2 = F (L2)
 
-(* should succeed too *)
+(* should succeed too
+*)
 
-(* Counter example: why we need to be careful with PR#6307 *)
+(* Counter example: why we need to be careful with PR#6307
+*)
 module Int = struct
   type t = int
 
@@ -5650,7 +5920,8 @@ end
 
 module type S = module type of M
 
-(* keep alias *)
+(* keep alias
+*)
 
 module Int2 = struct
   type t = int
@@ -5663,7 +5934,8 @@ module type S' = sig
   include S with module I := I
 end
 
-(* fail *)
+(* fail
+*)
 
 (* (* if the above succeeded, one could break invariants *)
    module rec M2 : S' = M2;; (* should succeed! (but this is bad) *)
@@ -5678,7 +5950,8 @@ end
    SInt2.mem 2 s';; (* invariants are broken *)
 *)
 
-(* Check behavior with submodules *)
+(* Check behavior with submodules
+*)
 module M = struct
   module N = struct
     module I = Int
@@ -5711,7 +5984,8 @@ end
 
 module type S = module type of M
 
-(* PR#6365 *)
+(* PR#6365
+*)
 module type S = sig
   module M : sig
     type t
@@ -5730,9 +6004,11 @@ module H' = H
 
 module type S' = S with module M = H'
 
-(* shouldn't introduce an alias *)
+(* shouldn't introduce an alias
+*)
 
-(* PR#6376 *)
+(* PR#6376
+*)
 module type Alias = sig
   module N : sig end
   module M = N
@@ -5746,7 +6022,8 @@ module type A = Alias with module N := F(List)
 
 module rec Bad : A = Bad
 
-(* Shinwell 2014-04-23 *)
+(* Shinwell 2014-04-23
+*)
 module B = struct
   module R = struct
     type t = string
@@ -5762,7 +6039,8 @@ end
 
 let x : K.N.t = "foo"
 
-(* PR#6465 *)
+(* PR#6465
+*)
 
 module M = struct
   type t = A
@@ -5779,7 +6057,8 @@ module P : sig
 end =
   M
 
-(* should be ok *)
+(* should be ok
+*)
 module P : sig
   type t = M.t = A
 
@@ -5819,9 +6098,11 @@ end
 
 module R' : S = R
 
-(* should be ok *)
+(* should be ok
+*)
 
-(* PR#6578 *)
+(* PR#6578
+*)
 
 module M = struct
   let f x = x
@@ -5883,7 +6164,8 @@ end
    module C : sig module L : module type of List end = A
 *)
 
-(* No dependency on D *)
+(* No dependency on D
+*)
 let x = 3
 
 module M = struct
@@ -5901,11 +6183,13 @@ module type S' = sig
 end
 
 (* ok to convert between structurally equal signatures, and parameters
-   are inferred *)
+   are inferred
+*)
 let f (x : (module S with type t = 'a and type u = 'b)) : (module S') = x
 let g x = (x : (module S with type t = 'a and type u = 'b) :> (module S'))
 
-(* with subtyping it is also ok to forget some types *)
+(* with subtyping it is also ok to forget some types
+*)
 module type S2 = sig
   type u
   type t
@@ -5916,12 +6200,15 @@ let g2 x = (x : (module S2 with type t = 'a and type u = 'b) :> (module S'))
 let h x = (x : (module S2 with type t = 'a) :> (module S with type t = 'a))
 let f2 (x : (module S2 with type t = 'a and type u = 'b)) : (module S') = x
 
-(* fail *)
+(* fail
+*)
 let k (x : (module S2 with type t = 'a)) : (module S with type t = 'a) = x
 
-(* fail *)
+(* fail
+*)
 
-(* but you cannot forget values (no physical coercions) *)
+(* but you cannot forget values (no physical coercions)
+*)
 module type S3 = sig
   type u
   type t
@@ -5931,10 +6218,13 @@ end
 
 let g3 x = (x : (module S3 with type t = 'a and type u = 'b) :> (module S'))
 
-(* fail *)
-(* Using generative functors *)
+(* fail
+*)
+(* Using generative functors
+*)
 
-(* Without type *)
+(* Without type
+*)
 module type S = sig
   val x : int
 end
@@ -5947,15 +6237,19 @@ let v =
 
 module F () = (val v)
 
-(* ok *)
+(* ok
+*)
 module G (X : sig end) : S = F ()
 
-(* ok *)
+(* ok
+*)
 module H (X : sig end) = (val v)
 
-(* ok *)
+(* ok
+*)
 
-(* With type *)
+(* With type
+*)
 module type S = sig
   type t
 
@@ -5972,34 +6266,44 @@ let v =
 
 module F () = (val v)
 
-(* ok *)
+(* ok
+*)
 module G (X : sig end) : S = F ()
 
-(* fail *)
+(* fail
+*)
 module H () = F ()
 
-(* ok *)
+(* ok
+*)
 
-(* Alias *)
+(* Alias
+*)
 module U = struct end
 module M = F (struct end)
 
-(* ok *)
+(* ok
+*)
 module M = F (U)
 
-(* fail *)
+(* fail
+*)
 
-(* Cannot coerce between applicative and generative *)
+(* Cannot coerce between applicative and generative
+*)
 module F1 (X : sig end) = struct end
 module F2 : functor () -> sig end = F1
 
-(* fail *)
+(* fail
+*)
 module F3 () = struct end
 module F4 : functor (X : sig end) -> sig end = F3
 
-(* fail *)
+(* fail
+*)
 
-(* tests for shortened functor notation () *)
+(* tests for shortened functor notation ()
+*)
 module X (X : sig end) (Y : sig end) = functor (Z : sig end) -> struct end
 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
@@ -6075,7 +6379,8 @@ let f (x : entity entity_container) = ()
 
    end
 *)
-(* Two v's in the same class *)
+(* Two v's in the same class
+*)
 class c v =
   object
     initializer print_endline v
@@ -6085,7 +6390,8 @@ class c v =
 
 new c "42"
 
-(* Two hidden v's in the same class! *)
+(* Two hidden v's in the same class!
+*)
 class c (v : int) =
   object
     method v0 = v
@@ -6143,7 +6449,8 @@ class c (x : int) =
 
 let r = (new c 2)#x
 
-(* test.ml *)
+(* test.ml
+*)
 class alfa =
   object (_ : 'self)
     method x : 'a. ('a, out_channel, unit) format -> 'a = Printf.printf
@@ -6161,7 +6468,8 @@ class charlie a =
     initializer y#x "charlie initialized"
   end
 
-(* The module begins *)
+(* The module begins
+*)
 exception Out_of_range
 
 class type ['a] cursor = object
@@ -6357,7 +6665,9 @@ module UText = struct
     done
   ;;
 
-  let concat s1 s2 = s1#concat (s2 (* : #ustorage *) :> uchar storage)
+  let concat s1 s2 = s1#concat (s2 (* : #ustorage
+                                   *) :> uchar storage)
+
   let iter proc s = s#iter proc
 end
 
@@ -6461,7 +6771,8 @@ end
 type refer1 = < poly : 'a 'b 'c. (('b, 'c) #Classdef.cl2 as 'a) >
 type refer2 = < poly : 'a 'b 'c. (('b, 'c) #Classdef.cl2 as 'a) >
 
-(* Actually this should succeed ... *)
+(* Actually this should succeed ...
+*)
 let f (x : refer1) : refer2 = x
 
 module Classdef = struct
@@ -6534,7 +6845,8 @@ module Make' (Unit : sig end) : Priv' = struct
 end
 
 module A' = Make' (struct end)
-(* PR5057 *)
+(* PR5057
+*)
 
 module TT = struct
   module IntSet = Set.Make (struct
@@ -6562,7 +6874,8 @@ let () =
   f `A
 ;;
 
-(* This one should fail *)
+(* This one should fail
+*)
 
 let f flag =
   let module T =
@@ -6709,7 +7022,8 @@ end =
 
 let f (x : F0.t) : Foobar.t = x
 
-(* fails *)
+(* fails
+*)
 
 module F = Foobar
 
@@ -6732,7 +7046,8 @@ end =
 
 fun (x : M1.t) : M2.t -> x
 
-(* fails *)
+(* fails
+*)
 
 module M3 : sig
   type t = private M1.t
@@ -6748,19 +7063,22 @@ module M4 : sig
 end =
   M2
 
-(* fails *)
+(* fails
+*)
 module M4 : sig
   type t = private M3.t
 end =
   M
 
-(* fails *)
+(* fails
+*)
 module M4 : sig
   type t = private M3.t
 end =
   M1
 
-(* might be ok *)
+(* might be ok
+*)
 module M5 : sig
   type t = private M1.t
 end =
@@ -6771,7 +7089,8 @@ module M6 : sig
 end =
   M1
 
-(* fails *)
+(* fails
+*)
 
 module Bar : sig
   type t = private Foobar.t
@@ -6783,7 +7102,8 @@ end = struct
   let f (x : int) : t = x
 end
 
-(* must fail *)
+(* must fail
+*)
 
 module M : sig
   type t = private T of int
@@ -6827,7 +7147,8 @@ module M4 : sig
 end =
   M
 
-(* Error: The variant or record definition does not match that of type M.t *)
+(* Error: The variant or record definition does not match that of type M.t
+*)
 
 module M5 : sig
   type t = M.t = private T of int
@@ -6874,7 +7195,8 @@ end = struct
   type 'a t = 'a M.t = private T of 'a
 end
 
-(* PR#6090 *)
+(* PR#6090
+*)
 module Test = struct
   type t = private A
 end
@@ -6885,12 +7207,15 @@ let f (x : Test.t) : Test2.t = x
 let f Test2.A = ()
 let a = Test2.A
 
-(* fail *)
+(* fail
+*)
 (* The following should fail from a semantical point of view,
-   but allow it for backward compatibility *)
+   but allow it for backward compatibility
+*)
 module Test2 : module type of Test with type t = private Test.t = Test
 
-(* PR#6331 *)
+(* PR#6331
+*)
 type t = private < x : int ; .. > as 'a
 type t = private (< x : int ; .. > as 'a) as 'a
 type t = private < x : int > as 'a
@@ -6898,14 +7223,16 @@ type t = private (< x : int > as 'a) as 'b
 type 'a t = private < x : int ; .. > as 'a
 type 'a t = private 'a constraint 'a = < x : int ; .. >
 
-(* Bad (t = t) *)
+(* Bad (t = t)
+*)
 module rec A : sig
   type t = A.t
 end = struct
   type t = A.t
 end
 
-(* Bad (t = t) *)
+(* Bad (t = t)
+*)
 module rec A : sig
   type t = B.t
 end = struct
@@ -6918,7 +7245,8 @@ end = struct
   type t = A.t
 end
 
-(* OK (t = int) *)
+(* OK (t = int)
+*)
 module rec A : sig
   type t = B.t
 end = struct
@@ -6931,14 +7259,16 @@ end = struct
   type t = int
 end
 
-(* Bad (t = int * t) *)
+(* Bad (t = int * t)
+*)
 module rec A : sig
   type t = int * A.t
 end = struct
   type t = int * A.t
 end
 
-(* Bad (t = t -> int) *)
+(* Bad (t = t -> int)
+*)
 module rec A : sig
   type t = B.t -> int
 end = struct
@@ -6951,7 +7281,8 @@ end = struct
   type t = A.t
 end
 
-(* OK (t = <m:t>) *)
+(* OK (t = <m:t>)
+*)
 module rec A : sig
   type t = < m : B.t >
 end = struct
@@ -6964,14 +7295,16 @@ end = struct
   type t = A.t
 end
 
-(* Bad (not regular) *)
+(* Bad (not regular)
+*)
 module rec A : sig
   type 'a t = < m : 'a list A.t >
 end = struct
   type 'a t = < m : 'a list A.t >
 end
 
-(* Bad (not regular) *)
+(* Bad (not regular)
+*)
 module rec A : sig
   type 'a t = < m : 'a list B.t ; n : 'a array B.t >
 end = struct
@@ -6984,7 +7317,8 @@ end = struct
   type 'a t = 'a A.t
 end
 
-(* Bad (not regular) *)
+(* Bad (not regular)
+*)
 module rec A : sig
   type 'a t = 'a B.t
 end = struct
@@ -6997,7 +7331,8 @@ end = struct
   type 'a t = < m : 'a list A.t ; n : 'a array A.t >
 end
 
-(* OK *)
+(* OK
+*)
 module rec A : sig
   type 'a t = 'a array B.t * 'a list B.t
 end = struct
@@ -7010,7 +7345,8 @@ end = struct
   type 'a t = < m : 'a B.t >
 end
 
-(* Bad (not regular) *)
+(* Bad (not regular)
+*)
 module rec A : sig
   type 'a t = 'a list B.t
 end = struct
@@ -7023,7 +7359,8 @@ end = struct
   type 'a t = < m : 'a array B.t >
 end
 
-(* Bad (not regular) *)
+(* Bad (not regular)
+*)
 module rec M : sig
   class ['a] c : 'a -> object
       method map : ('a -> 'b) -> 'b M.c
@@ -7035,7 +7372,8 @@ end = struct
     end
 end
 
-(* OK *)
+(* OK
+*)
 class type ['node] extension = object
   method node : 'node
 end
@@ -7051,7 +7389,8 @@ class x =
 
 type t = x node
 
-(* Bad - PR 4261 *)
+(* Bad - PR 4261
+*)
 
 module PR_4261 = struct
   module type S = sig
@@ -7068,7 +7407,8 @@ module PR_4261 = struct
   and U' : (S with type t = U'.t) = U
 end
 
-(* Bad - PR 4512 *)
+(* Bad - PR 4512
+*)
 module type S' = sig
   type t = int
 end
@@ -7077,7 +7417,8 @@ module rec M : (S' with type t = M.t) = struct
   type t = M.t
 end
 
-(* PR#4450 *)
+(* PR#4450
+*)
 
 module PR_4450_1 = struct
   module type MyT = sig
@@ -7118,7 +7459,8 @@ module PR_4450_2 = struct
 end
 
 (* A synthetic example of bootstrapped data structure
-   (suggested by J-C Filliatre) *)
+   (suggested by J-C Filliatre)
+*)
 
 module type ORD = sig
   type t
@@ -7171,7 +7513,8 @@ module Bootstrap2
 
   let iter f = Diet.iter (Elt.iter f)
 end
-(* PR 4470: simplified from OMake's sources *)
+(* PR 4470: simplified from OMake's sources
+*)
 
 module rec DirElt : sig
   type t =
@@ -7194,7 +7537,8 @@ and DirHash : sig
 end = struct
   type t = DirCompare.t list
 end
-(* PR 4758, PR 4266 *)
+(* PR 4758, PR 4266
+*)
 
 module PR_4758 = struct
   module type S = sig end
@@ -7211,7 +7555,8 @@ module PR_4758 = struct
     module Other = A
   end
 
-  module C' = C (* check that we can take an alias *)
+  module C' = C (* check that we can take an alias
+                *)
 
   module F (X : sig end) = struct
     type t
@@ -7220,7 +7565,8 @@ module PR_4758 = struct
   let f (x : F(C).t) : F(C').t = x
 end
 
-(* PR 4557 *)
+(* PR 4557
+*)
 module PR_4557 = struct
   module F (X : Set.OrderedType) = struct
     module rec Mod : sig
@@ -7280,7 +7626,8 @@ module F (X : Set.OrderedType) = struct
 
   and ModSet : (Set.S with type elt = Mod.t) = Set.Make (Mod)
 end
-(* Tests for recursive modules *)
+(* Tests for recursive modules
+*)
 
 let test number result expected =
   if result = expected
@@ -7289,7 +7636,8 @@ let test number result expected =
   flush stdout
 ;;
 
-(* Tree of sets *)
+(* Tree of sets
+*)
 
 module rec A : sig
   type t =
@@ -7323,7 +7671,8 @@ let _ =
   test 14 (A.compare x y) 1
 ;;
 
-(* Simple value recursion *)
+(* Simple value recursion
+*)
 
 module rec Fib : sig
   val f : int -> int
@@ -7333,7 +7682,8 @@ end
 
 let _ = test 20 (Fib.f 10) 89
 
-(* Update function by infix *)
+(* Update function by infix
+*)
 
 module rec Fib2 : sig
   val f : int -> int
@@ -7344,7 +7694,8 @@ end
 
 let _ = test 21 (Fib2.f 10) 89
 
-(* Early application *)
+(* Early application
+*)
 
 let _ =
   let res =
@@ -7367,7 +7718,8 @@ let _ =
   test 30 res true
 ;;
 
-(* Early strict evaluation *)
+(* Early strict evaluation
+*)
 
 (*
    module rec Cyclic
@@ -7376,7 +7728,8 @@ let _ =
    ;;
 *)
 
-(* Reordering of evaluation based on dependencies *)
+(* Reordering of evaluation based on dependencies
+*)
 
 module rec After : sig
   val x : int
@@ -7392,7 +7745,8 @@ end
 
 let _ = test 40 After.x 4
 
-(* Type identity between A.t and t within A's definition *)
+(* Type identity between A.t and t within A's definition
+*)
 
 module rec Strengthen : sig
   type t
@@ -7443,7 +7797,8 @@ end = struct
   end
 end
 
-(* Polymorphic recursion *)
+(* Polymorphic recursion
+*)
 
 module rec PolyRec : sig
   type 'a t =
@@ -7464,7 +7819,8 @@ end = struct
   ;;
 end
 
-(* Wrong LHS signatures (PR#4336) *)
+(* Wrong LHS signatures (PR#4336)
+*)
 
 (*
    module type ASig = sig type a val a:a val print:a -> unit end
@@ -7481,7 +7837,8 @@ end
    and NewB : BSig with type b = NewA.a = MakeB (struct end);;
 *)
 
-(* Expressions and bindings *)
+(* Expressions and bindings
+*)
 
 module StringSet = Set.Make (String)
 
@@ -7547,7 +7904,8 @@ let _ =
   test 51 (Expr.simpl e) e'
 ;;
 
-(* Okasaki's bootstrapping *)
+(* Okasaki's bootstrapping
+*)
 
 module type ORDERED = sig
   type t
@@ -7716,7 +8074,8 @@ let _ =
   test 62 (C.findMin (C.deleteMin (C.deleteMin h))) 4
 ;;
 
-(* Classes *)
+(* Classes
+*)
 
 module rec Class1 : sig
   class c : object
@@ -7769,7 +8128,8 @@ let _ =
   | Undefined_recursive_module _ -> test 71 true true
 ;;
 
-(* Coercions *)
+(* Coercions
+*)
 
 module rec Coerce1 : sig
   val g : int -> int
@@ -7826,7 +8186,8 @@ end =
 
 let _ = test 82 (Coerce6.at 100) 5
 
-(* Miscellaneous bug reports *)
+(* Miscellaneous bug reports
+*)
 
 module rec F : sig
   type t =
@@ -7850,7 +8211,8 @@ let _ =
   test 101 (F.f (F.Y 2)) true
 ;;
 
-(* PR#4316 *)
+(* PR#4316
+*)
 module G (S : sig
     val x : int Lazy.t
   end) =
@@ -7870,7 +8232,8 @@ end =
   G (M1)
 
 let _ = test 102 (Lazy.force M2.x) 3
-let _ = Gc.full_major () (* will shortcut forwarding in M1.x *)
+let _ = Gc.full_major () (* will shortcut forwarding in M1.x
+                         *)
 
 module rec M3 : sig
   val x : int Lazy.t
@@ -7888,22 +8251,28 @@ type t =
 
 let f (A r) = r
 
-(* -> escape *)
+(* -> escape
+*)
 let f (A r) = r.x
 
-(* ok *)
+(* ok
+*)
 let f x = A { x; y = x }
 
-(* ok *)
+(* ok
+*)
 let f (A r) = A { r with y = r.x + 1 }
 
-(* ok *)
+(* ok
+*)
 let f () = A { a = 1 }
 
-(* customized error message *)
+(* customized error message
+*)
 let f () = A { x = 1; y = 3 }
 
-(* ok *)
+(* ok
+*)
 
 type _ t =
   | A :
@@ -7914,10 +8283,12 @@ type _ t =
 
 let f (A { x; y }) = A { x; y = () }
 
-(* ok *)
+(* ok
+*)
 let f (A ({ x; y } as r)) = A { x = r.x; y = r.y }
 
-(* ok *)
+(* ok
+*)
 
 module M = struct
   type 'a t =
@@ -7952,7 +8323,8 @@ struct
   module A = (val X.x)
 end
 
-(* -> this expression creates fresh types (not really!) *)
+(* -> this expression creates fresh types (not really!)
+*)
 
 module type S = sig
   exception A of { x : int }
@@ -7999,7 +8371,8 @@ module Z = struct
   type X2.t += A of { x : int }
 end
 
-(* PR#6716 *)
+(* PR#6716
+*)
 
 type _ c = C : [ `A ] c
 type t = T : { x : [< `A ] c } -> t
@@ -8097,7 +8470,8 @@ open Core.Std
 let x = Int.Map.empty
 let y = x + x
 
-(* Avoid ambiguity *)
+(* Avoid ambiguity
+*)
 
 module M = struct
   type t = A
@@ -8155,7 +8529,8 @@ module N2 = struct
   and v = M1.v
 end
 
-(* PR#6566 *)
+(* PR#6566
+*)
 module type PR6566 = sig
   type t = string
 end
@@ -8179,26 +8554,32 @@ module M2 = struct
 end
 
 (* Adapted from: An Expressive Language of Signatures
-   by Norman Ramsey, Kathleen Fisher and Paul Govereau *)
+   by Norman Ramsey, Kathleen Fisher and Paul Govereau
+*)
 
 module type VALUE = sig
-  type value (* a Lua value *)
-  type state (* the state of a Lua interpreter *)
-  type usert (* a user-defined value *)
+  type value (* a Lua value
+             *)
+  type state (* the state of a Lua interpreter
+             *)
+  type usert (* a user-defined value
+             *)
 end
 
 module type CORE0 = sig
   module V : VALUE
 
   val setglobal : V.state -> string -> V.value -> unit
-  (* five more functions common to core and evaluator *)
+  (* five more functions common to core and evaluator
+  *)
 end
 
 module type CORE = sig
   include CORE0
 
   val apply : V.value -> V.state -> V.value list -> V.value
-  (* apply function f in state s to list of args *)
+  (* apply function f in state s to list of args
+  *)
 end
 
 module type AST = sig
@@ -8319,7 +8700,8 @@ module type PrintableComparable = sig
   include Comparable with type t = t
 end
 
-(* Fails *)
+(* Fails
+*)
 module type PrintableComparable = sig
   type t
 
@@ -8377,7 +8759,8 @@ module type S = sig
 end
 with type 'a t := unit
 
-(* Fails *)
+(* Fails
+*)
 let property (type t) () =
   let module M = struct
     exception E of t
@@ -8414,14 +8797,16 @@ let sort_uniq (type s) cmp l =
 let () = print_endline (String.concat "," (sort_uniq compare [ "abc"; "xyz"; "abc" ]))
 let f x (type a) (y : a) = x = y
 
-(* Fails *)
+(* Fails
+*)
 class ['a] c =
   object (self)
     method m : 'a -> 'a = fun x -> x
     method n : 'a -> 'a = fun (type g) (x : g) -> self#m x
   end
 
-(* Fails *)
+(* Fails
+*)
 
 external a : (int[@untagged]) -> unit = "a" "a_nat"
 external b : (int32[@unboxed]) -> unit = "b" "b_nat"
@@ -8450,7 +8835,8 @@ module Global_attributes = struct
   external d : float -> float = "d" "noalloc"
   external e : float -> float = "e"
 
-  (* Should output a warning: no native implementation provided *)
+  (* Should output a warning: no native implementation provided
+  *)
   external f : (int32[@unboxed]) -> (int32[@unboxed]) = "f" "noalloc"
   external g : int32 -> int32 = "g" "g_nat" [@@unboxed] [@@noalloc]
   external h : (int[@untagged]) -> (int[@untagged]) = "h" "h_nat" "noalloc"
@@ -8467,7 +8853,8 @@ module Old_style_warning = struct
   external e : float -> float = "c" "float"
 end
 
-(* Bad: attributes not reported in the interface *)
+(* Bad: attributes not reported in the interface
+*)
 
 module Bad1 : sig
   external f : int -> int = "f" "f_nat"
@@ -8493,7 +8880,8 @@ end = struct
   external f : (float[@unboxed]) -> float = "f" "f_nat"
 end
 
-(* Bad: attributes in the interface but not in the implementation *)
+(* Bad: attributes in the interface but not in the implementation
+*)
 
 module Bad5 : sig
   external f : int -> (int[@untagged]) = "f" "f_nat"
@@ -8519,29 +8907,35 @@ end = struct
   external f : float -> float = "a" "a_nat"
 end
 
-(* Bad: unboxed or untagged with the wrong type *)
+(* Bad: unboxed or untagged with the wrong type
+*)
 
 external g : (float[@untagged]) -> float = "g" "g_nat"
 external h : (int[@unboxed]) -> float = "h" "h_nat"
 
-(* Bad: unboxing the function type *)
+(* Bad: unboxing the function type
+*)
 external i : (int -> float[@unboxed]) = "i" "i_nat"
 
-(* Bad: unboxing a "deep" sub-type. *)
+(* Bad: unboxing a "deep" sub-type.
+*)
 external j : int -> (float[@unboxed]) * float = "j" "j_nat"
 
 (* This should be rejected, but it is quite complicated to do
-   in the current state of things *)
+   in the current state of things
+*)
 
 external k : int -> (float[@unboxd]) = "k" "k_nat"
 
-(* Bad: old style annotations + new style attributes *)
+(* Bad: old style annotations + new style attributes
+*)
 
 external l : float -> float = "l" "l_nat" "float" [@@unboxed]
 external m : (float[@unboxed]) -> float = "m" "m_nat" "float"
 external n : float -> float = "n" "noalloc" [@@noalloc]
 
-(* Warnings: unboxed / untagged without any native implementation *)
+(* Warnings: unboxed / untagged without any native implementation
+*)
 external o : (float[@unboxed]) -> float = "o"
 external p : float -> (float[@unboxed]) = "p"
 external q : (int[@untagged]) -> float = "q"
@@ -8552,13 +8946,15 @@ external t : float -> float = "t" [@@unboxed]
 let _ = ignore ( + )
 let _ = raise Exit 3;;
 
-(* comment 9644 of PR#6000 *)
+(* comment 9644 of PR#6000
+*)
 
 fun b -> if b then format_of_string "x" else "y";;
 fun b -> if b then "x" else format_of_string "y";;
 fun b : (_, _, _) format -> if b then "x" else "y"
 
-(* PR#7135 *)
+(* PR#7135
+*)
 
 module PR7135 = struct
   module M : sig
@@ -8572,7 +8968,8 @@ module PR7135 = struct
   let lift2 (f : int -> int -> int) (x : t) (y : t) = f (x :> int) (y :> int)
 end
 
-(* exemple of non-ground coercion *)
+(* exemple of non-ground coercion
+*)
 
 module Test1 = struct
   type t = private int
@@ -8583,13 +8980,15 @@ module Test1 = struct
   ;;
 end
 
-(* Warn about all relevant cases when possible *)
+(* Warn about all relevant cases when possible
+*)
 let f = function
   | None, None -> 1
   | Some _, Some _ -> 2
 ;;
 
-(* Exhaustiveness check is very slow *)
+(* Exhaustiveness check is very slow
+*)
 type _ t =
   | A : int t
   | B : bool t
@@ -8611,30 +9010,35 @@ let f
     | _, _, _, _, _, _, _, G, _, _ -> 1
 ;;
 
-(*| _ -> _ *)
+(*| _ -> _
+*)
 
-(* Unused cases *)
+(* Unused cases
+*)
 let f (x : int t) =
   match x with
   | A -> 1
   | _ -> 2
 ;;
 
-(* warn *)
+(* warn
+*)
 let f (x : unit t option) =
   match x with
   | None -> 1
   | _ -> 2
 ;;
 
-(* warn? *)
+(* warn?
+*)
 let f (x : unit t option) =
   match x with
   | None -> 1
   | Some _ -> 2
 ;;
 
-(* warn *)
+(* warn
+*)
 let f (x : int t option) =
   match x with
   | None -> 1
@@ -8646,9 +9050,11 @@ let f (x : int t option) =
   | None -> 1
 ;;
 
-(* warn *)
+(* warn
+*)
 
-(* Example with record, type, single case *)
+(* Example with record, type, single case
+*)
 
 type 'a box = Box of 'a
 
@@ -8665,7 +9071,8 @@ let f : (string t box pair * bool) option -> unit = function
   | None -> ()
 ;;
 
-(* Examples from ML2015 paper *)
+(* Examples from ML2015 paper
+*)
 
 type _ t =
   | Int : int t
@@ -8741,7 +9148,8 @@ let inv_zero : type a b c d. (a, b, c) plus -> (c, d, zero) plus -> bool =
   | Plus0, Plus0 -> true
 ;;
 
-(* Empty match *)
+(* Empty match
+*)
 
 type _ t = Int : int t
 
@@ -8750,39 +9158,46 @@ let f (x : bool t) =
   | _ -> .
 ;;
 
-(* ok *)
+(* ok
+*)
 
-(* trefis in PR#6437 *)
+(* trefis in PR#6437
+*)
 
 let f () =
   match None with
   | _ -> .
 ;;
 
-(* error *)
+(* error
+*)
 let g () =
   match None with
   | _ -> ()
   | exception _ -> .
 ;;
 
-(* error *)
+(* error
+*)
 let h () =
   match None with
   | _ -> .
   | exception _ -> .
 ;;
 
-(* error *)
+(* error
+*)
 let f x =
   match x with
   | _ -> ()
   | None -> .
 ;;
 
-(* do not warn *)
+(* do not warn
+*)
 
-(* #7059, all clauses guarded *)
+(* #7059, all clauses guarded
+*)
 
 let f x y =
   match 1 with
@@ -8799,7 +9214,8 @@ let f : label choice -> bool = function
   | Left -> true
 ;;
 
-(* warn *)
+(* warn
+*)
 exception A
 
 type a = A;;
@@ -8851,7 +9267,8 @@ end
 type t = A : t
 
 module X1 : sig end = struct
-  let _f ~x (* x unused argument *) = function
+  let _f ~x (* x unused argument
+            *) = function
     | A ->
       let x = () in
       x
@@ -8859,7 +9276,8 @@ module X1 : sig end = struct
 end
 
 module X2 : sig end = struct
-  let x = 42 (* unused value *)
+  let x = 42 (* unused value
+             *)
 
   let _f = function
     | A ->
@@ -8870,10 +9288,12 @@ end
 
 module X3 : sig end = struct
   module O = struct
-    let x = 42 (* unused *)
+    let x = 42 (* unused
+               *)
   end
 
-  open O (* unused open *)
+  open O (* unused open
+         *)
 
   let _f = function
     | A ->
@@ -8882,7 +9302,8 @@ module X3 : sig end = struct
   ;;
 end
 
-(* Use type information *)
+(* Use type information
+*)
 module M1 = struct
   type t =
     { x : int
@@ -8898,16 +9319,19 @@ end
 module OK = struct
   open M1
 
-  let f1 (r : t) = r.x (* ok *)
+  let f1 (r : t) = r.x (* ok
+                       *)
 
   let f2 r =
     ignore (r : t);
-    r.x (* non principal *)
+    r.x (* non principal
+        *)
   ;;
 
   let f3 (r : t) =
     match r with
-    | { x; y } -> y + y (* ok *)
+    | { x; y } -> y + y (* ok
+                        *)
   ;;
 end
 
@@ -8920,7 +9344,8 @@ module F1 = struct
   ;;
 end
 
-(* fails *)
+(* fails
+*)
 
 module F2 = struct
   open M1
@@ -8932,7 +9357,8 @@ module F2 = struct
   ;;
 end
 
-(* fails for -principal *)
+(* fails for -principal
+*)
 
 (* Use type information with modules*)
 module M = struct
@@ -8942,13 +9368,16 @@ end
 
 let f (r : M.t) = r.M.x
 
-(* ok *)
+(* ok
+*)
 let f (r : M.t) = r.x
 
-(* warning *)
+(* warning
+*)
 let f ({ x } : M.t) = x
 
-(* warning *)
+(* warning
+*)
 
 module M = struct
   type t =
@@ -8987,7 +9416,8 @@ module OK = struct
   let f (r : M.t) = r.x
 end
 
-(* Use field information *)
+(* Use field information
+*)
 module M = struct
   type u =
     { x : bool
@@ -9007,14 +9437,16 @@ module OK = struct
   let f { x; z } = x, z
 end
 
-(* ok *)
+(* ok
+*)
 module F3 = struct
   open M
 
   let r = { x = true; z = 'z' }
 end
 
-(* fail for missing label *)
+(* fail for missing label
+*)
 
 module OK = struct
   type u =
@@ -9031,9 +9463,11 @@ module OK = struct
   let r = { x = 3; y = true }
 end
 
-(* ok *)
+(* ok
+*)
 
-(* Corner cases *)
+(* Corner cases
+*)
 
 module F4 = struct
   type foo =
@@ -9046,7 +9480,8 @@ module F4 = struct
   let b : bar = { x = 3; y = 4 }
 end
 
-(* fail but don't warn *)
+(* fail but don't warn
+*)
 
 module M = struct
   type foo =
@@ -9064,7 +9499,8 @@ end
 
 let r = { M.x = 3; N.y = 4 }
 
-(* error: different definitions *)
+(* error: different definitions
+*)
 
 module MN = struct
   include M
@@ -9078,9 +9514,11 @@ end
 
 let r = { MN.x = 3; NM.y = 4 }
 
-(* error: type would change with order *)
+(* error: type would change with order
+*)
 
-(* Lpw25 *)
+(* Lpw25
+*)
 
 module M = struct
   type foo =
@@ -9139,9 +9577,11 @@ end
 
 let f (r : B.t) = r.A.x
 
-(* fail *)
+(* fail
+*)
 
-(* Spellchecking *)
+(* Spellchecking
+*)
 
 module F8 = struct
   type t =
@@ -9152,7 +9592,8 @@ module F8 = struct
   let a : t = { x = 1; yyz = 2 }
 end
 
-(* PR#6004 *)
+(* PR#6004
+*)
 
 type t = A
 type s = A
@@ -9160,14 +9601,17 @@ type s = A
 class f (_ : t) = object end
 class g = f A
 
-(* ok *)
+(* ok
+*)
 
 class f (_ : 'a) (_ : 'a) = object end
 class g = f (A : t) A
 
-(* warn with -principal *)
+(* warn with -principal
+*)
 
-(* PR#5980 *)
+(* PR#5980
+*)
 
 module Shadow1 = struct
   type t = { x : int }
@@ -9176,7 +9620,8 @@ module Shadow1 = struct
     type s = { x : string }
   end
 
-  open M (* this open is unused, it isn't reported as shadowing 'x' *)
+  open M (* this open is unused, it isn't reported as shadowing 'x'
+         *)
 
   let y : t = { x = 0 }
 end
@@ -9188,12 +9633,14 @@ module Shadow2 = struct
     type s = { x : string }
   end
 
-  open M (* this open shadows label 'x' *)
+  open M (* this open shadows label 'x'
+         *)
 
   let y = { x = "" }
 end
 
-(* PR#6235 *)
+(* PR#6235
+*)
 
 module P6235 = struct
   type t = { loc : string }
@@ -9211,7 +9658,8 @@ module P6235 = struct
   ;;
 end
 
-(* Remove interaction between branches *)
+(* Remove interaction between branches
+*)
 
 module P6235' = struct
   type t = { loc : string }
@@ -9373,12 +9821,15 @@ let () = proj1 (inj2 42)
 let _ = ~-1
 
 class id = [%exp]
-(* checkpoint *)
+(* checkpoint
+*)
 
-(* Subtyping is "syntactic" *)
+(* Subtyping is "syntactic"
+*)
 let _ = fun (x : < x : int >) y z -> (y :> 'a), (x :> 'a), (z :> 'a)
 
-(* - : (< x : int > as 'a) -> 'a -> 'a * 'a = <fun> *)
+(* - : (< x : int > as 'a) -> 'a -> 'a * 'a = <fun>
+*)
 
 class ['a] c () =
   object
@@ -9390,7 +9841,8 @@ and ['a] d () =
     inherit ['a] c ()
   end
 
-(* PR#7329 Pattern open *)
+(* PR#7329 Pattern open
+*)
 let _ =
   let module M = struct
     type t = { x : int }
@@ -9431,7 +9883,8 @@ let g x = ~$(x.contents)
 let ( ~$ ) x y = x, y
 let g x y = ~$(x.contents) y.contents
 
-(* PR#7506: attributes on list tail *)
+(* PR#7506: attributes on list tail
+*)
 
 let tail1 = [ 1; 2 ] [@hello]
 let tail2 = 0 :: ([ 1; 2 ] [@hello])
@@ -9466,11 +9919,13 @@ fun contents -> { contents = contents [@foo] };;
 (();
  ()) [@foo]
 
-(* https://github.com/LexiFi/gen_js_api/issues/61 *)
+(* https://github.com/LexiFi/gen_js_api/issues/61
+*)
 
 let () = foo##.bar := ()
 
-(* "let open" in classes and class types *)
+(* "let open" in classes and class types
+*)
 
 class c =
   let open M in
@@ -9484,7 +9939,8 @@ class type ct =
     method f : t
   end
 
-(* M.(::) notation *)
+(* M.(::) notation
+*)
 module Exotic_list = struct
   module Inner = struct
     type ('a, 'b) t =
@@ -9588,8 +10044,8 @@ exception Second_exception
 
 module M = struct
   type t
-  [@@immediate] (* ______________________________________ *)
-  [@@deriving variants, sexp_of]
+  [@@immediate] (* ______________________________________
+                *) [@@deriving variants, sexp_of]
 end
 
 module type Basic3 = sig
@@ -9620,7 +10076,8 @@ let _ =
   [ very_long_function_name____________________ very_long_argument_name____________ ]
 ;;
 
-(* FIX: exceed 90 columns *)
+(* FIX: exceed 90 columns
+*)
 let _ =
   [%str
     let () = very_long_function_name__________________ very_long_argument_name____________]
@@ -9631,7 +10088,8 @@ let _ =
   }
 ;;
 
-(* FIX: exceed 90 columns *)
+(* FIX: exceed 90 columns
+*)
 let _ =
   match () with
   | _ ->
@@ -9642,30 +10100,27 @@ let _ =
 
 let _ =
   aaaaaaa
-  (* __________________________________________________________________________________ *)
-  := bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
+  (* __________________________________________________________________________________
+  *) := bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
 ;;
 
-let g =
-  f
-    ~x
-    (* this is a multiple-line-spanning
-       comment *)
-    ~y
-;;
+let g = f ~x (* this is a multiple-line-spanning
+                comment
+             *) ~y
 
 let f =
   very_long_function_name
-    ~x:very_long_variable_name
-    (* this is a multiple-line-spanning
-       comment *)
+    ~x:very_long_variable_name (* this is a multiple-line-spanning
+                                  comment
+                               *)
     ~y
 ;;
 
 let _ =
   match x with
   | { y =
-        (* _____________________________________________________________________ *)
+        (* _____________________________________________________________________
+        *)
         ( X _ | Y _ )
     } -> ()
 ;;
@@ -9674,7 +10129,8 @@ let _ =
   match x with
   | { y =
         ( Z
-        (* _____________________________________________________________________ *)
+        (* _____________________________________________________________________
+        *)
         | X _
         | Y _ )
     } -> ()
@@ -9682,25 +10138,34 @@ let _ =
 
 type t =
   [ `XXXX
-  (* __________________________________________________________________________________ *)
-  | `XXXX (* __________________________________________________________________ *)
-  | `XXXX (* _____________________________________________________ *)
-  | `XXXX (* ___________________________________________________ *)
-  | `XXXX (* ___________________________________________________ *)
-  | `XXXX (* ________________________________________________ *)
-  | `XXXX (* __________________________________________ *)
-  | `XXXX (* _________________________________________ *)
-  | `XXXX (* ______________________________________ *)
-  | `XXXX (* ____________________________________ *)
+  (* __________________________________________________________________________________
+  *)
+  | `XXXX (* __________________________________________________________________
+          *)
+  | `XXXX (* _____________________________________________________
+          *)
+  | `XXXX (* ___________________________________________________
+          *)
+  | `XXXX (* ___________________________________________________
+          *)
+  | `XXXX (* ________________________________________________
+          *)
+  | `XXXX (* __________________________________________
+          *)
+  | `XXXX (* _________________________________________
+          *)
+  | `XXXX (* ______________________________________
+          *)
+  | `XXXX (* ____________________________________
+          *)
   ]
 
 type t =
-  { field : ty
-  (* Here is some verbatim formatted text:
+  { field : ty (* Here is some verbatim formatted text:
 
-     {v
+                  {v
        starting at column 7
-         v}*)
+                  v}*)
   }
 
 module Intro_sort = struct
@@ -9717,7 +10182,8 @@ module Intro_sort = struct
           4-----o--------o--o--|-----o--4
                 |              |     |
           5-----o--------------o-----o--5
-       v} *)
+       v}
+    *)
     foooooooooo fooooo fooo;
     foooooooooo fooooo fooo;
     foooooooooo fooooo fooo
@@ -9737,7 +10203,8 @@ let nullsafe_optimistic_third_party_params_in_non_strict =
        there was no actionable way to change third party annotations. Now
        that we have such a support, this behavior should be reconsidered,
        provided our tooling and error reporting is friendly enough to be
-       smoothly used by developers. *)
+       smoothly used by developers.
+    *)
     ~default:true
     "Nullsafe: in this mode we treat non annotated third party method params as if they \
      were annotated as nullable."
@@ -9745,7 +10212,8 @@ let nullsafe_optimistic_third_party_params_in_non_strict =
 
 let foo () =
   if%bind
-    (* this is a medium length comment of some sort *)
+    (* this is a medium length comment of some sort
+    *)
     this is a medium length expression of_some sort
   then x
   else y
@@ -9753,31 +10221,35 @@ let foo () =
 
 let xxxxxx =
   let%map (* _____________________________
-             __________ *) () = yyyyyyyy in
+             __________
+          *) () = yyyyyyyy in
   { zzzzzzzzzzzzz }
 ;;
 
 let _ =
   match x with
   | _
-    when f
-           ~f:(function [@ocaml.warning
-              (* ....................................... *) "-4"] _ -> .) -> y
+    when f ~f:(function [@ocaml.warning (* .......................................
+                                        *) "-4"] _ -> .) -> y
 ;;
 
 let[@a
-   (* .............................................. ........................... .......................... ...................... *)
+   (* .............................................. ........................... .......................... ......................
+   *)
   foo
   (* ....................... *)
   (* ................................. *)
   (* ...................... *)] _
   =
-  match[@ocaml.warning (* ....................................... *) "-4"]
-    x [@attr (* .......................... .................. *) some_attr]
+  match[@ocaml.warning (* .......................................
+                       *) "-4"]
+    x [@attr (* .......................... ..................
+             *) some_attr]
   with
   | _
     when f
-           ~f:(function[@ocaml.warning (* ....................................... *) "-4"]
+           ~f:(function[@ocaml.warning (* .......................................
+                                       *) "-4"]
              | _ -> .)
            ~f:(function[@ocaml.warning
               (* ....................................... *)
@@ -9786,7 +10258,8 @@ let[@a
               fooooooooooooooooooooooooooooooooooooo"]
              | _ -> .)
            ~f:(function[@ocaml.warning
-              (* ....................................... *)
+              (* .......................................
+              *)
              let x = a
              and y = b in
              x + y]
@@ -9794,7 +10267,8 @@ let[@a
     y [@attr
        (* ... *)
       (* ... *)
-      attr (* ... *)]
+      attr (* ...
+           *)]
 ;;
 
 let x =
@@ -10043,6 +10517,7 @@ let _ =
 ;;
 
 (*
+
 *)
 
 (** xxx *)
@@ -10075,7 +10550,10 @@ class x =
 
 let _ =
   match () with
-  (*$ Printf.(printf "\n  | _ -> .\n;;\n") *)
+  (*$
+    Printf.(
+      printf "\n  | _ -> .\n;;\n")
+  *)
   | _ -> .
 ;;
 
@@ -10090,7 +10568,8 @@ let _ =
 (*$*)
 
 (*$
-  [%string {| xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
+  [%string
+    {| xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
   zzzzzzzzzzzzzzzzzzzzzzzzzzzz
       |}]
 *)
@@ -10098,7 +10577,7 @@ let _ =
 
 (*$
   {|
-        f|}
+       f|}
 *)
 
 let () =
@@ -10110,7 +10589,8 @@ let () =
   | _ -> ()
 ;;
 
-(* ocp-indent-compat: Docked fun after apply only if on the same line. *)
+(* ocp-indent-compat: Docked fun after apply only if on the same line.
+*)
 
 let _ =
   fooooooooooooooooooooooooooooooo
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index c4fef9a79b..a86b5a0857 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -77,7 +77,8 @@ and _ = ()
 
 let%foo _ = ()
 
-(* Expressions *)
+(* Expressions
+  *)
 let () =
   let%foo[@foo] x = 3
   and[@foo] y = 4 in
@@ -113,12 +114,14 @@ let () =
   [%foo new x [@foo]];
   [%foo
     match[@foo] () with
-    | [%foo? (* Pattern expressions *)
+    | [%foo? (* Pattern expressions
+               *)
         ((lazy x) [@foo])] -> ()
     | [%foo? ((exception x) [@foo])] -> ()]
 ;;
 
-(* Class expressions *)
+(* Class expressions
+  *)
 class x =
   fun [@foo] x ->
   let[@foo] x = 3 in
@@ -133,7 +136,8 @@ class x =
     initializer x [@@foo]
   end [@foo]
 
-(* Class type expressions *)
+(* Class type expressions
+  *)
 class type t = object
   inherit t [@@foo]
   val x : t [@@foo]
@@ -146,13 +150,16 @@ class type t = object
   [@@@aaa]
 end[@foo]
 
-(* Type expressions *)
+(* Type expressions
+  *)
 type t = [%foo: ((module M)[@foo])]
 
-(* Module expressions *)
+(* Module expressions
+  *)
 module M = (functor [@foo] (M : S) -> (val x) [@foo] (struct end [@foo]))
 
-(* Module type expression *)
+(* Module type expression
+  *)
 module type S = functor [@foo] (M : S) -> functor (_ : (module type of M) [@foo]) -> sig end
 [@foo]
 
@@ -168,7 +175,8 @@ module type S = sig
   and B : (S with type t = t)
 end
 
-(* Structure items *)
+(* Structure items
+  *)
 let%foo[@foo] x = 4
 and[@foo] y = x
 
@@ -189,7 +197,8 @@ module type%foo S = S [@@foo]
 include%foo M [@@foo]
 open%foo M [@@foo]
 
-(* Signature items *)
+(* Signature items
+  *)
 module type S = sig
   val%foo x : t [@@foo]
   external%foo x : t = "" [@@foo]
@@ -226,7 +235,8 @@ open M;;
 
 ([%extension_constructor A] : extension_constructor)
 
-(* By using two types we can have a recursive constraint *)
+(* By using two types we can have a recursive constraint
+  *)
 type 'a class_name = .. constraint 'a = < cast : 'a. 'a name -> 'a ; .. >
 and 'a name = Class : 'a class_name -> (< cast : 'a. 'a name -> 'a ; .. > as 'a) name
 
@@ -255,7 +265,8 @@ class foo : foo_t =
     method foo = "foo"
   end
 
-(* Now we can create a subclass of foo *)
+(* Now we can create a subclass of foo
+  *)
 
 class type bar_t = object
   inherit foo
@@ -278,7 +289,8 @@ class bar : bar_t =
     [%%id]
   end
 
-(* Now lets create a mutable list of castable objects *)
+(* Now lets create a mutable list of castable objects
+  *)
 
 let clist : castable list ref = ref []
 let push_castable (c : #castable) = clist := (c :> castable) :: !clist
@@ -291,7 +303,8 @@ let pop_castable () =
   | [] -> raise Not_found
 ;;
 
-(* We can add foos and bars to this list, and retrive them *)
+(* We can add foos and bars to this list, and retrive them
+  *)
 
 push_castable (new foo);;
 push_castable (new bar);;
@@ -301,27 +314,34 @@ let c1 : castable = pop_castable ()
 let c2 : castable = pop_castable ()
 let c3 : castable = pop_castable ()
 
-(* We can also downcast these values to foos and bars *)
+(* We can also downcast these values to foos and bars
+  *)
 
 let f1 : foo = c1#cast (Class Foo)
 
-(* Ok *)
+(* Ok
+  *)
 let f2 : foo = c2#cast (Class Foo)
 
-(* Ok *)
+(* Ok
+  *)
 let f3 : foo = c3#cast (Class Foo)
 
-(* Ok *)
+(* Ok
+  *)
 
 let b1 : bar = c1#cast (Class Bar)
 
-(* Exception Bad_cast *)
+(* Exception Bad_cast
+  *)
 let b2 : bar = c2#cast (Class Bar)
 
-(* Ok *)
+(* Ok
+  *)
 let b3 : bar = c3#cast (Class Bar)
 
-(* Exception Bad_cast *)
+(* Exception Bad_cast
+  *)
 
 type foo = ..
 type foo += A | B of int
@@ -332,31 +352,39 @@ let is_a x =
   | _ -> false
 ;;
 
-(* The type must be open to create extension *)
+(* The type must be open to create extension
+  *)
 
 type foo
-type foo += A of int (* Error type is not open *)
+type foo += A of int (* Error type is not open
+                       *)
 
-(* The type parameters must match *)
+(* The type parameters must match
+  *)
 
 type 'a foo = ..
-type ('a, 'b) foo += A of int (* Error: type parameter mismatch *)
+type ('a, 'b) foo += A of int (* Error: type parameter mismatch
+                                *)
 
-(* In a signature the type does not have to be open *)
+(* In a signature the type does not have to be open
+  *)
 
 module type S = sig
   type foo
   type foo += A of float
 end
 
-(* But it must still be extensible *)
+(* But it must still be extensible
+  *)
 
 module type S = sig
   type foo = A of int
-  type foo += B of float (* Error foo does not have an extensible type *)
+  type foo += B of float (* Error foo does not have an extensible type
+                           *)
 end
 
-(* Signatures can change the grouping of extensions *)
+(* Signatures can change the grouping of extensions
+  *)
 
 type foo = ..
 
@@ -373,7 +401,8 @@ end
 
 module M_S : S = M
 
-(* Extensions can be GADTs *)
+(* Extensions can be GADTs
+  *)
 
 type 'a foo = ..
 type _ foo += A : int -> int foo | B : int foo
@@ -385,16 +414,20 @@ let get_num : type a. a foo -> a -> a option =
   | _ -> None
 ;;
 
-(* Extensions must obey constraints *)
+(* Extensions must obey constraints
+  *)
 
 type 'a foo = .. constraint 'a = [> `Var ]
 type 'a foo += A of 'a
 
-let a = A 9 (* ERROR: Constraints not met *)
+let a = A 9 (* ERROR: Constraints not met
+              *)
 
-type 'a foo += B : int foo (* ERROR: Constraints not met *)
+type 'a foo += B : int foo (* ERROR: Constraints not met
+                             *)
 
-(* Signatures can make an extension private *)
+(* Signatures can make an extension private
+  *)
 
 type foo = ..
 
@@ -416,9 +449,11 @@ let is_s x =
   | _ -> false
 ;;
 
-let a2 = M_S.A 20 (* ERROR: Cannot create a value using a private constructor *)
+let a2 = M_S.A 20 (* ERROR: Cannot create a value using a private constructor
+                    *)
 
-(* Extensions can be rebound *)
+(* Extensions can be rebound
+  *)
 
 type foo = ..
 
@@ -428,17 +463,21 @@ end
 
 type foo += A2 = M.A1
 type bar = ..
-type bar += A3 = M.A1 (* Error: rebind wrong type *)
+type bar += A3 = M.A1 (* Error: rebind wrong type
+                        *)
 
 module M = struct
   type foo += private B1 of int
 end
 
 type foo += private B2 = M.B1
-type foo += B3 = M.B1 (* Error: rebind private extension *)
-type foo += C = Unknown (* Error: unbound extension *)
+type foo += B3 = M.B1 (* Error: rebind private extension
+                        *)
+type foo += C = Unknown (* Error: unbound extension
+                          *)
 
-(* Extensions can be rebound even if type is closed *)
+(* Extensions can be rebound even if type is closed
+  *)
 
 module M : sig
   type foo
@@ -450,7 +489,8 @@ end
 
 type M.foo += A2 = M.A1
 
-(* Rebinding handles abbreviations *)
+(* Rebinding handles abbreviations
+  *)
 
 type 'a foo = ..
 type 'a foo1 = 'a foo = ..
@@ -458,20 +498,25 @@ type 'a foo2 = 'a foo = ..
 type 'a foo1 += A of int | B of 'a | C : int foo1
 type 'a foo2 += D = A | E = B | F = C
 
-(* Extensions must obey variances *)
+(* Extensions must obey variances
+  *)
 
 type +'a foo = ..
 type 'a foo += A of (int -> 'a)
 type 'a foo += B of ('a -> int)
-(* ERROR: Parameter variances are not satisfied *)
+(* ERROR: Parameter variances are not satisfied
+  *)
 
 type _ foo += C : ('a -> int) -> 'a foo
-(* ERROR: Parameter variances are not satisfied *)
+(* ERROR: Parameter variances are not satisfied
+  *)
 
 type 'a bar = ..
-type +'a bar += D of (int -> 'a) (* ERROR: type variances do not match *)
+type +'a bar += D of (int -> 'a) (* ERROR: type variances do not match
+                                   *)
 
-(* Exceptions are compatible with extensions *)
+(* Exceptions are compatible with extensions
+  *)
 
 module M : sig
   type exn += Foo of int * float | Bar : 'a list -> exn
@@ -497,27 +542,33 @@ end = struct
   exception Foo = Foo
 end
 
-(* Test toplevel printing *)
+(* Test toplevel printing
+  *)
 
 type foo = ..
 type foo += Foo of int * int option | Bar of int option
 
-let x = Foo (3, Some 4), Bar (Some 5) (* Prints Foo and Bar successfully *)
+let x = Foo (3, Some 4), Bar (Some 5) (* Prints Foo and Bar successfully
+                                        *)
 
 type foo += Foo of string
 
-let y = x (* Prints Bar but not Foo (which has been shadowed) *)
+let y = x (* Prints Bar but not Foo (which has been shadowed)
+            *)
 
 exception Foo of int * int option
 exception Bar of int option
 
-let x = Foo (3, Some 4), Bar (Some 5) (* Prints Foo and Bar successfully *)
+let x = Foo (3, Some 4), Bar (Some 5) (* Prints Foo and Bar successfully
+                                        *)
 
 type foo += Foo of string
 
-let y = x (* Prints Bar and part of Foo (which has been shadowed) *)
+let y = x (* Prints Bar and part of Foo (which has been shadowed)
+            *)
 
-(* Test Obj functions *)
+(* Test Obj functions
+  *)
 
 type foo = ..
 type foo += Foo | Bar of int
@@ -526,14 +577,17 @@ let extension_name e = Obj.extension_name (Obj.extension_constructor e)
 let extension_id e = Obj.extension_id (Obj.extension_constructor e)
 let n1 = extension_name Foo
 let n2 = extension_name (Bar 1)
-let t = extension_id (Bar 2) = extension_id (Bar 3) (* true *)
-let f = extension_id (Bar 2) = extension_id Foo (* false *)
+let t = extension_id (Bar 2) = extension_id (Bar 3) (* true
+                                                      *)
+let f = extension_id (Bar 2) = extension_id Foo (* false
+                                                  *)
 let is_foo x = extension_id Foo = extension_id x
 
 type foo += Foo
 
 let f = is_foo Foo
-let _ = Obj.extension_constructor 7 (* Invald_arg *)
+let _ = Obj.extension_constructor 7 (* Invald_arg
+                                      *)
 
 let _ =
   Obj.extension_constructor
@@ -542,9 +596,11 @@ let _ =
     end)
 ;;
 
-(* Invald_arg *)
+(* Invald_arg
+  *)
 
-(* Typed names *)
+(* Typed names
+  *)
 
 module Msg : sig
   type 'a tag
@@ -602,7 +658,8 @@ end = struct
     write_raw k.label content
   ;;
 
-  (* Add int kind *)
+  (* Add int kind
+    *)
 
   type 'a tag += Int : int tag
 
@@ -618,7 +675,8 @@ end = struct
     Hashtbl.add writeTbl (T Int) { f }
   ;;
 
-  (* Support user defined kinds *)
+  (* Support user defined kinds
+    *)
 
   module type Desc = sig
     type t
@@ -667,7 +725,8 @@ let read_one () =
   | _ -> print_string "Unknown"
 ;;
 
-(* Example of algorithm parametrized with modules *)
+(* Example of algorithm parametrized with modules
+  *)
 
 let sort (type s) set l =
   let module Set = (val set : Set.S with type elt = s) in
@@ -694,7 +753,8 @@ let () =
     (String.concat "  " (List.map (String.concat "/") (both [ "abc"; "xyz"; "def" ])))
 ;;
 
-(* Hiding the internal representation *)
+(* Hiding the internal representation
+  *)
 
 module type S = sig
   type t
@@ -743,7 +803,8 @@ let () =
   List.iter print (List.map apply [ int; apply int; apply (apply str) ])
 ;;
 
-(* Existential types + type equality witnesses -> pseudo GADT *)
+(* Existential types + type equality witnesses -> pseudo GADT
+  *)
 
 module TypEq : sig
   type ('a, 'b) t
@@ -830,7 +891,8 @@ let () =
   print_endline (Print.to_string (pair int (pair str int)) (123, ("A", 456)))
 ;;
 
-(* #6262: first-class modules and module type aliases *)
+(* #6262: first-class modules and module type aliases
+  *)
 
 module type S1 = sig end
 module type S2 = S1
@@ -847,7 +909,8 @@ end
 
 let _f (x : (module X.S)) : (module Y.S) = x
 
-(* PR#6194, main example *)
+(* PR#6194, main example
+  *)
 module type S3 = sig
   val x : bool
 end
@@ -875,7 +938,8 @@ let fbool (type t) (x : t) (tag : t ty) =
   | Bool -> x
 ;;
 
-(* val fbool : 'a -> 'a ty -> 'a = <fun> *)
+(* val fbool : 'a -> 'a ty -> 'a = <fun>
+  *)
 
 (** OK: the return value is x of type t **)
 
@@ -884,7 +948,8 @@ let fint (type t) (x : t) (tag : t ty) =
   | Int -> x > 0
 ;;
 
-(* val fint : 'a -> 'a ty -> bool = <fun> *)
+(* val fint : 'a -> 'a ty -> bool = <fun>
+  *)
 
 (** OK: the return value is x > 0 of type bool;
     This has used the equation t = bool, not visible in the return type **)
@@ -895,7 +960,8 @@ let f (type t) (x : t) (tag : t ty) =
   | Bool -> x
 ;;
 
-(* val f : 'a -> 'a ty -> bool = <fun> *)
+(* val f : 'a -> 'a ty -> bool = <fun>
+  *)
 
 let g (type t) (x : t) (tag : t ty) =
   match tag with
@@ -904,7 +970,8 @@ let g (type t) (x : t) (tag : t ty) =
 ;;
 
 (* Error: This expression has type bool but an expression was expected of type
-   t = int *)
+   t = int
+  *)
 
 let id x = x
 
@@ -934,7 +1001,8 @@ let g (type t) (x : t) (tag : t ty) =
 (* (c) Alain Frisch / Lexifi *)
 (* cf. http://www.lexifi.com/blog/dynamic-types *)
 
-(* Basic tag *)
+(* Basic tag
+  *)
 
 type 'a ty =
   | Int : int ty
@@ -942,7 +1010,8 @@ type 'a ty =
   | List : 'a ty -> 'a list ty
   | Pair : ('a ty * 'b ty) -> ('a * 'b) ty
 
-(* Tagging data *)
+(* Tagging data
+  *)
 
 type variant =
   | VInt of int
@@ -952,15 +1021,20 @@ type variant =
 
 let rec variantize : type t. t ty -> t -> variant =
   fun ty x ->
-  (* type t is abstract here *)
+  (* type t is abstract here
+    *)
   match ty with
-  | Int -> VInt x (* in this branch: t = int *)
-  | String -> VString x (* t = string *)
-  | List ty1 -> VList (List.map (variantize ty1) x) (* t = 'a list for some 'a *)
+  | Int -> VInt x (* in this branch: t = int
+                    *)
+  | String -> VString x (* t = string
+                          *)
+  | List ty1 -> VList (List.map (variantize ty1) x) (* t = 'a list for some 'a
+                                                      *)
   | Pair (ty1, ty2) -> VPair (variantize ty1 (fst x), variantize ty2 (snd x))
 ;;
 
-(* t = ('a, 'b) for some 'a and 'b *)
+(* t = ('a, 'b) for some 'a and 'b
+  *)
 
 exception VariantMismatch
 
@@ -974,7 +1048,8 @@ let rec devariantize : type t. t ty -> variant -> t =
   | _ -> raise VariantMismatch
 ;;
 
-(* Handling records *)
+(* Handling records
+  *)
 
 type 'a ty =
   | Int : int ty
@@ -996,7 +1071,8 @@ and ('a, 'b) field =
   ; get : 'a -> 'b
   }
 
-(* Again *)
+(* Again
+  *)
 
 type variant =
   | VInt of int
@@ -1007,14 +1083,19 @@ type variant =
 
 let rec variantize : type t. t ty -> t -> variant =
   fun ty x ->
-  (* type t is abstract here *)
+  (* type t is abstract here
+    *)
   match ty with
-  | Int -> VInt x (* in this branch: t = int *)
-  | String -> VString x (* t = string *)
-  | List ty1 -> VList (List.map (variantize ty1) x) (* t = 'a list for some 'a *)
+  | Int -> VInt x (* in this branch: t = int
+                    *)
+  | String -> VString x (* t = string
+                          *)
+  | List ty1 -> VList (List.map (variantize ty1) x) (* t = 'a list for some 'a
+                                                      *)
   | Pair (ty1, ty2) ->
     VPair (variantize ty1 (fst x), variantize ty2 (snd x))
-    (* t = ('a, 'b) for some 'a and 'b *)
+    (* t = ('a, 'b) for some 'a and 'b
+      *)
   | Record { fields } ->
     VRecord
       (List.map
@@ -1022,7 +1103,8 @@ let rec variantize : type t. t ty -> t -> variant =
          fields)
 ;;
 
-(* Extraction *)
+(* Extraction
+  *)
 
 type 'a ty =
   | Int : int ty
@@ -1108,13 +1190,16 @@ type (_, _) ty =
   | List : ('a, 'e) ty -> ('a list, 'e) ty
   | Option : ('a, 'e) ty -> ('a option, 'e) ty
   | Pair : (('a, 'e) ty * ('b, 'e) ty) -> ('a * 'b, 'e) ty
-  (* Support for type variables and recursive types *)
+  (* Support for type variables and recursive types
+    *)
   | Var : ('a, 'a -> 'e) ty
   | Rec : ('a, 'a -> 'e) ty -> ('a, 'e) ty
   | Pop : ('a, 'e) ty -> ('a, 'b -> 'e) ty
-  (* Change the representation of a type *)
+  (* Change the representation of a type
+    *)
   | Conv : string * ('a -> 'b) * ('b -> 'a) * ('b, 'e) ty -> ('a, 'e) ty
-  (* Sum types (both normal sums and polymorphic variants) *)
+  (* Sum types (both normal sums and polymorphic variants)
+    *)
   | Sum : ('a, 'e, 'b) ty_sum -> ('a, 'e) ty
 
 and ('a, 'e, 'b) ty_sum =
@@ -1123,25 +1208,30 @@ and ('a, 'e, 'b) ty_sum =
   ; sum_inj : 'c. ('b, 'c) ty_sel * 'c -> 'a
   }
 
-and 'e ty_dyn = (* dynamic type *)
+and 'e ty_dyn = (* dynamic type
+                  *)
   | Tdyn : ('a, 'e) ty * 'a -> 'e ty_dyn
 
 and (_, _) ty_sel =
-  (* selector from a list of types *)
+  (* selector from a list of types
+    *)
   | Thd : ('a -> 'b, 'a) ty_sel
   | Ttl : ('b -> 'c, 'd) ty_sel -> ('a -> 'b -> 'c, 'd) ty_sel
 
 and (_, _) ty_case =
-  (* type a sum case *)
+  (* type a sum case
+    *)
   | TCarg : ('b, 'a) ty_sel * ('a, 'e) ty -> ('e, 'b) ty_case
   | TCnoarg : ('b, noarg) ty_sel -> ('e, 'b) ty_case
 
 type _ ty_env =
-  (* type variable substitution *)
+  (* type variable substitution
+    *)
   | Enil : unit ty_env
   | Econs : ('a, 'e) ty * 'e ty_env -> ('a -> 'e) ty_env
 
-(* Comparing selectors *)
+(* Comparing selectors
+  *)
 type (_, _) eq = Eq : ('a, 'a) eq
 
 let rec eq_sel : type a b c. (a, b) ty_sel -> (a, c) ty_sel -> (b, c) eq option =
@@ -1155,7 +1245,8 @@ let rec eq_sel : type a b c. (a, b) ty_sel -> (a, c) ty_sel -> (b, c) eq option
   | _ -> None
 ;;
 
-(* Auxiliary function to get the type of a case from its selector *)
+(* Auxiliary function to get the type of a case from its selector
+  *)
 let rec get_case
   : type a b e.
     (b, a) ty_sel -> (string * (e, b) ty_case) list -> string * (a, e) ty option
@@ -1173,7 +1264,8 @@ let rec get_case
   | [] -> raise Not_found
 ;;
 
-(* Untyped representation of values *)
+(* Untyped representation of values
+  *)
 type variant =
   | VInt of int
   | VString of string
@@ -1240,13 +1332,15 @@ let rec devariantize : type t e. e ty_env -> (t, e) ty -> variant -> t =
   | _ -> raise VariantMismatch
 ;;
 
-(* First attempt: represent 1-constructor variants using Conv *)
+(* First attempt: represent 1-constructor variants using Conv
+  *)
 let wrap_A t = Conv ("`A", (fun (`A x) -> x), (fun x -> `A x), t)
 let ty a = Rec (wrap_A (Option (Pair (a, Var))))
 let v = variantize Enil (ty Int)
 let x = v (`A (Some (1, `A (Some (2, `A None)))))
 
-(* Can also use it to decompose a tuple *)
+(* Can also use it to decompose a tuple
+  *)
 
 let triple t1 t2 t3 =
   Conv
@@ -1258,14 +1352,17 @@ let triple t1 t2 t3 =
 
 let v = variantize Enil (triple String Int Int) ("A", 2, 3)
 
-(* Second attempt: introduce a real sum construct *)
+(* Second attempt: introduce a real sum construct
+  *)
 let ty_abc =
-  (* Could also use [get_case] for proj, but direct definition is shorter *)
+  (* Could also use [get_case] for proj, but direct definition is shorter
+    *)
   let proj = function
     | `A n -> "A", Some (Tdyn (Int, n))
     | `B s -> "B", Some (Tdyn (String, s))
     | `C -> "C", None
-  (* Define inj in advance to be able to write the type annotation easily *)
+  (* Define inj in advance to be able to write the type annotation easily
+    *)
   and inj
     : type c.
       (int -> string -> noarg -> unit, c) ty_sel * c -> [ `A of int | `B of string | `C ]
@@ -1274,7 +1371,8 @@ let ty_abc =
     | Ttl Thd, v -> `B v
     | Ttl (Ttl Thd), Noarg -> `C
   in
-  (* Coherence of sum_inj and sum_cases is checked by the typing *)
+  (* Coherence of sum_inj and sum_cases is checked by the typing
+    *)
   Sum
     { sum_proj = proj
     ; sum_inj = inj
@@ -1289,7 +1387,8 @@ let ty_abc =
 let v = variantize Enil ty_abc (`A 3)
 let a = devariantize Enil ty_abc v
 
-(* And an example with recursion... *)
+(* And an example with recursion...
+  *)
 type 'a vlist =
   [ `Nil
   | `Cons of 'a * 'a vlist
@@ -1310,13 +1409,15 @@ let ty_list : type a e. (a, e) ty -> (a vlist, e) ty =
               function
              | Thd, Noarg -> `Nil
              | Ttl Thd, v -> `Cons v)
-           (* One can also write the type annotation directly *)
+           (* One can also write the type annotation directly
+             *)
        })
 ;;
 
 let v = variantize Enil (ty_list Int) (`Cons (1, `Cons (2, `Nil)))
 
-(* Simpler but weaker approach *)
+(* Simpler but weaker approach
+  *)
 
 type (_, _) ty =
   | Int : (int, _) ty
@@ -1335,7 +1436,8 @@ type (_, _) ty =
 and 'e ty_dyn = Tdyn : ('a, 'e) ty * 'a -> 'e ty_dyn
 
 let ty_abc : ([ `A of int | `B of string | `C ], 'e) ty =
-  (* Could also use [get_case] for proj, but direct definition is shorter *)
+  (* Could also use [get_case] for proj, but direct definition is shorter
+    *)
   Sum
     ( (function
        | `A n -> "A", Some (Tdyn (Int, n))
@@ -1348,7 +1450,8 @@ let ty_abc : ([ `A of int | `B of string | `C ], 'e) ty =
       | _ -> invalid_arg "ty_abc" )
 ;;
 
-(* Breaks: no way to pattern-match on a full recursive type *)
+(* Breaks: no way to pattern-match on a full recursive type
+  *)
 let ty_list : type a e. (a, e) ty -> (a vlist, e) ty =
   fun t ->
   let targ = Pair (Pop t, Var) in
@@ -1362,7 +1465,8 @@ let ty_list : type a e. (a, e) ty -> (a vlist, e) ty =
          | "Cons", Some (Tdyn (Pair (_, Var), (p : a * a vlist))) -> `Cons p ))
 ;;
 
-(* Define Sum using object instead of record for first-class polymorphism *)
+(* Define Sum using object instead of record for first-class polymorphism
+  *)
 
 type (_, _) ty =
   | Int : (int, _) ty
@@ -1441,23 +1545,24 @@ let ty_list : type a e. (a, e) ty -> (a vlist, e) ty =
 ;;
 
 (*
-   type (_,_) ty_assoc =
-   | Anil : (unit,'e) ty_assoc
-   | Acons : string * ('a,'e) ty * ('b,'e) ty_assoc -> ('a -> 'b, 'e) ty_assoc
-
-   and (_,_) ty_pvar =
-   | Pnil : ('a,'e) ty_pvar
-   | Pconst : 't * ('b,'e) ty_pvar -> ('t -> 'b, 'e) ty_pvar
-   | Parg : 't * ('a,'e) ty * ('b,'e) ty_pvar -> ('t * 'a -> 'b, 'e) ty_pvar
-*)
+     type (_,_) ty_assoc =
+     | Anil : (unit,'e) ty_assoc
+     | Acons : string * ('a,'e) ty * ('b,'e) ty_assoc -> ('a -> 'b, 'e) ty_assoc
+
+     and (_,_) ty_pvar =
+     | Pnil : ('a,'e) ty_pvar
+     | Pconst : 't * ('b,'e) ty_pvar -> ('t -> 'b, 'e) ty_pvar
+     | Parg : 't * ('a,'e) ty * ('b,'e) ty_pvar -> ('t * 'a -> 'b, 'e) ty_pvar
+  *)
 (*
-   An attempt at encoding omega examples from the 2nd Central European
-   Functional Programming School:
-   Generic Programming in Omega, by Tim Sheard and Nathan Linger
-   http://web.cecs.pdx.edu/~sheard/
-*)
+     An attempt at encoding omega examples from the 2nd Central European
+     Functional Programming School:
+     Generic Programming in Omega, by Tim Sheard and Nathan Linger
+     http://web.cecs.pdx.edu/~sheard/
+  *)
 
-(* Basic types *)
+(* Basic types
+  *)
 
 type ('a, 'b) sum =
   | Inl of 'a
@@ -1470,7 +1575,8 @@ type _ nat =
   | NZ : zero nat
   | NS : 'a nat -> 'a succ nat
 
-(* 2: A simple example *)
+(* 2: A simple example
+  *)
 
 type (_, _) seq =
   | Snil : ('a, zero) seq
@@ -1481,7 +1587,8 @@ let l1 = Scons (3, Scons (5, Snil))
 (* We do not have type level functions, so we need to use witnesses. *)
 (* We copy here the definitions from section 3.9 *)
 (* Note the addition of the ['a nat] argument to PlusZ, since we do not
-   have kinds *)
+   have kinds
+  *)
 type (_, _, _) plus =
   | PlusZ : 'a nat -> (zero, 'a, 'a) plus
   | PlusS : ('a, 'b, 'c) plus -> ('a succ, 'b, 'c succ) plus
@@ -1492,7 +1599,8 @@ let rec length : type a n. (a, n) seq -> n nat = function
 ;;
 
 (* app returns the catenated lists with a witness proving that
-   the size is the sum of its two inputs *)
+   the size is the sum of its two inputs
+  *)
 type (_, _, _) app = App : ('a, 'p) seq * ('n, 'm, 'p) plus -> ('a, 'n, 'm) app
 
 let rec app : type a n m. (a, n) seq -> (a, m) seq -> (a, n, m) app =
@@ -1504,9 +1612,11 @@ let rec app : type a n m. (a, n) seq -> (a, m) seq -> (a, n, m) app =
     App (Scons (x, xs''), PlusS pl)
 ;;
 
-(* 3.1 Feature: kinds *)
+(* 3.1 Feature: kinds
+  *)
 
-(* We do not have kinds, but we can encode them as predicates *)
+(* We do not have kinds, but we can encode them as predicates
+  *)
 
 type tp = TP
 type nd = ND
@@ -1524,7 +1634,8 @@ type _ boolean =
   | BT : tt boolean
   | BF : ff boolean
 
-(* 3.3 Feature : GADTs *)
+(* 3.3 Feature : GADTs
+  *)
 
 type (_, _) path =
   | Pnone : 'a -> (tp, 'a) path
@@ -1557,7 +1668,8 @@ let rec extract : type sh. (sh, 'a) path -> (sh, 'a) tree -> 'a =
   | Pright p, Tfork (_, r) -> extract p r
 ;;
 
-(* 3.4 Pattern : Witness *)
+(* 3.4 Pattern : Witness
+  *)
 
 type (_, _) le =
   | LeZ : 'a nat -> (zero, 'a) le
@@ -1584,7 +1696,8 @@ let rec summandLessThanSum : type a b c. (a, b, c) plus -> (a, c) le =
   | PlusS p' -> LeS (summandLessThanSum p')
 ;;
 
-(* 3.8 Pattern: Leibniz Equality *)
+(* 3.8 Pattern: Leibniz Equality
+  *)
 
 type (_, _) equal = Eq : ('a, 'a) equal
 
@@ -1601,7 +1714,8 @@ let rec sameNat : type a b. a nat -> b nat -> (a, b) equal option =
   | _ -> None
 ;;
 
-(* Extra: associativity of addition *)
+(* Extra: associativity of addition
+  *)
 
 let rec plus_func : type a b m n. (a, b, m) plus -> (a, b, n) plus -> (m, n) equal =
   fun p1 p2 ->
@@ -1631,9 +1745,11 @@ let rec plus_assoc
     Eq
 ;;
 
-(* 3.9 Computing Programs and Properties Simultaneously *)
+(* 3.9 Computing Programs and Properties Simultaneously
+  *)
 
-(* Plus and app1 are moved to section 2 *)
+(* Plus and app1 are moved to section 2
+  *)
 
 let smaller : type a b. (a succ, b succ) le -> (a, b) le = function
   | LeS x -> x
@@ -1642,15 +1758,15 @@ let smaller : type a b. (a succ, b succ) le -> (a, b) le = function
 type (_, _) diff = Diff : 'c nat * ('a, 'c, 'b) plus -> ('a, 'b) diff
 
 (*
-   let rec diff : type a b. (a,b) le -> a nat -> b nat -> (a,b) diff =
-   fun le a b ->
-   match a, b, le with
-   | NZ, m, _ -> Diff (m, PlusZ m)
-   | NS x, NZ, _ -> assert false
-   | NS x, NS y, q ->
-   match diff (smaller q) x y with Diff (m, p) -> Diff (m, PlusS p)
-   ;;
-*)
+     let rec diff : type a b. (a,b) le -> a nat -> b nat -> (a,b) diff =
+     fun le a b ->
+     match a, b, le with
+     | NZ, m, _ -> Diff (m, PlusZ m)
+     | NS x, NZ, _ -> assert false
+     | NS x, NS y, q ->
+     match diff (smaller q) x y with Diff (m, p) -> Diff (m, PlusS p)
+     ;;
+  *)
 
 let rec diff : type a b. (a, b) le -> a nat -> b nat -> (a, b) diff =
   fun le a b ->
@@ -1664,7 +1780,8 @@ let rec diff : type a b. (a, b) le -> a nat -> b nat -> (a, b) diff =
 let rec diff : type a b. (a, b) le -> a nat -> b nat -> (a, b) diff =
   fun le a b ->
   match a, b, le with
-  (* warning *)
+  (* warning
+    *)
   | NZ, m, LeZ _ -> Diff (m, PlusZ m)
   | NS x, NS y, LeS q ->
     (match diff q x y with
@@ -1698,7 +1815,8 @@ let rec filter : type a n. (a -> bool) -> (a, n) seq -> (a, n) filter =
        if f a then Filter (LeS le, Scons (a, l')) else Filter (leS' le, l'))
 ;;
 
-(* 4.1 AVL trees *)
+(* 4.1 AVL trees
+  *)
 
 type (_, _, _) balance =
   | Less : ('h, 'h succ, 'h succ) balance
@@ -1852,7 +1970,8 @@ let delete x (Avl t) =
   | Ddecr (_, t) -> Avl t
 ;;
 
-(* Exercise 22: Red-black trees *)
+(* Exercise 22: Red-black trees
+  *)
 
 type red = RED
 type black = BLACK
@@ -1941,7 +2060,8 @@ let rec ins : type c n. int -> (c, n) sub_tree -> (c, n) ctxt -> rb_tree =
 
 let insert e (Root t) = ins e t CNil
 
-(* 5.7 typed object languages using GADTs *)
+(* 5.7 typed object languages using GADTs
+  *)
 
 type _ term =
   | Const : int -> int term
@@ -2029,7 +2149,8 @@ let ex3 = Abs ("x", Rint, Ap (Add, Pair (Var ("x", Rint), Var ("x", Rint))))
 let ex4 = Ap (ex3, Const 3)
 let v4 = eval_term [] ex4
 
-(* 5.9/5.10 Language with binding *)
+(* 5.9/5.10 Language with binding
+  *)
 
 type rnil = RNIL
 type ('a, 'b, 'c) rcons = RCons of 'a * 'b * 'c
@@ -2079,10 +2200,12 @@ let double = Abs (X, App (App (Shift add, Var X), Var X))
 let ex3 = App (double, _3)
 let v3 = eval_lam env0 ex3
 
-(* 5.13: Constructing typing derivations at runtime *)
+(* 5.13: Constructing typing derivations at runtime
+  *)
 
 (* Modified slightly to use the language of 5.10, since this is more fun.
-   Of course this works also with the language of 5.12. *)
+   Of course this works also with the language of 5.12.
+  *)
 
 type _ rep =
   | I : int rep
@@ -2172,7 +2295,8 @@ let eval_checked env = function
 
 let v2 = eval_checked env0 c2
 
-(* 5.12 Soundness *)
+(* 5.12 Soundness
+  *)
 
 type pexp = PEXP
 type pval = PVAL
@@ -2279,10 +2403,12 @@ let f : type env a. (env, a) typ -> (env, a) typ -> int =
   | Tint, Tint -> 0
   | Tbool, Tbool -> 1
   | Tvar var, tb -> 2
-  | _ -> . (* error *)
+  | _ -> . (* error
+             *)
 ;;
 
-(* let x = f Tint (Tvar Zero) ;; *)
+(* let x = f Tint (Tvar Zero) ;;
+  *)
 type inkind =
   [ `Link
   | `Nonlink
@@ -2325,7 +2451,8 @@ let inlineseq_from_astseq seq =
   List.map process_any seq
 ;;
 
-(* OK *)
+(* OK
+  *)
 type _ linkp =
   | Nonlink : [ `Nonlink ] linkp
   | Maylink : inkind linkp
@@ -2345,7 +2472,8 @@ let inlineseq_from_astseq seq =
   List.map (process Maylink) seq
 ;;
 
-(* Bad *)
+(* Bad
+  *)
 type _ linkp2 = Kind : 'a linkp -> ([< inkind ] as 'a) linkp2
 
 let inlineseq_from_astseq seq =
@@ -2422,7 +2550,8 @@ type tag =
 type 'a poly =
   | AandBTags : [< `TagA of int | `TagB ] poly
   | ATag : [< `TagA of int ] poly
-(* constraint 'a = [< `TagA of int | `TagB] *)
+(* constraint 'a = [< `TagA of int | `TagB]
+  *)
 
 let intA = function
   | `TagA i -> i
@@ -2443,10 +2572,12 @@ let example6 : type a. a wrapPoly -> a -> int =
   fun w ->
   match w with
   | WrapPoly ATag -> intA
-  | WrapPoly _ -> intA (* This should not be allowed *)
+  | WrapPoly _ -> intA (* This should not be allowed
+                         *)
 ;;
 
-let _ = example6 (WrapPoly AandBTags) `TagB (* This causes a seg fault *)
+let _ = example6 (WrapPoly AandBTags) `TagB (* This causes a seg fault
+                                              *)
 
 module F (S : sig
     type 'a t
@@ -2594,7 +2725,8 @@ let f (Aux x) =
   | Succ (Succ Zero) -> "2"
   | Succ (Succ (Succ Zero)) -> "3"
   | Succ (Succ (Succ (Succ Zero))) -> "4"
-  | _ -> . (* error *)
+  | _ -> . (* error
+             *)
 ;;
 
 type _ t = C : ((('a -> 'o) -> 'o) -> ('b -> 'o) -> 'o) t
@@ -2722,14 +2854,16 @@ type (_, _) t =
 
 let get1 (Cons (x, _) : (_ * 'a, 'a) t) = x
 
-(* warn, cf PR#6993 *)
+(* warn, cf PR#6993
+  *)
 
 let get1' = function
   | (Cons (x, _) : (_ * 'a, 'a) t) -> x
   | Nil -> assert false
 ;;
 
-(* ok *)
+(* ok
+  *)
 type _ t =
   | Int : int -> int t
   | String : string -> string t
@@ -2749,7 +2883,8 @@ type _ t = I : int t
 
 let f (type a) (x : a t) =
   let module M = struct
-    let (I : a t) = x (* fail because of toplevel let *)
+    let (I : a t) = x (* fail because of toplevel let
+                        *)
     let x = (I : a t)
   end
   in
@@ -2765,7 +2900,8 @@ let bad (type a) =
     module rec M : sig
       val e : (int, a) eq
     end = struct
-      let (Refl : (int, a) eq) = M.e (* must fail for soundness *)
+      let (Refl : (int, a) eq) = M.e (* must fail for soundness
+                                       *)
       let e : (int, a) eq = Refl
     end
   end
@@ -2792,7 +2928,8 @@ let undetected : ('a -> 'b -> nil) t -> 'a n -> 'b n -> unit =
 
 type _ t = T : int t
 
-(* Should raise Not_found *)
+(* Should raise Not_found
+  *)
 let _ =
   match (raise Not_found : float t) with
   | _ -> .
@@ -2806,13 +2943,15 @@ type 'a t
 
 let f (type a) (Neq n : (a, a t) eq) = n
 
-(* warn! *)
+(* warn!
+  *)
 
 module F (T : sig
     type _ t
   end) =
 struct
-  let f (type a) (Neq n : (a, a T.t) eq) = n (* warn! *)
+  let f (type a) (Neq n : (a, a T.t) eq) = n (* warn!
+                                               *)
 end
 
 (* First-Order Unification by Structural Recursion *)
@@ -2822,7 +2961,8 @@ end
 (* This is a translation of the code part to ocaml *)
 (* Of course, we do not prove other properties, not even termination *)
 
-(* 2.2 Inductive Families *)
+(* 2.2 Inductive Families
+  *)
 
 type zero = Zero
 type _ succ = Succ
@@ -2838,9 +2978,11 @@ type _ fin =
 (* We cannot define
    val empty : zero fin -> 'a
    because we cannot write an empty pattern matching.
-   This might be useful to have *)
+   This might be useful to have
+  *)
 
-(* In place, prove that the parameter is 'a succ *)
+(* In place, prove that the parameter is 'a succ
+  *)
 type _ is_succ = IS : 'a succ is_succ
 
 let fin_succ : type n. n fin -> n is_succ = function
@@ -2848,7 +2990,8 @@ let fin_succ : type n. n fin -> n is_succ = function
   | FS _ -> IS
 ;;
 
-(* 3 First-Order Terms, Renaming and Substitution *)
+(* 3 First-Order Terms, Renaming and Substitution
+  *)
 
 type 'a term =
   | Var of 'a fin
@@ -2866,9 +3009,11 @@ let rec pre_subst f = function
 
 let comp_subst f g (x : 'a fin) = pre_subst f (g x)
 (* val comp_subst :
-   ('b fin -> 'c term) -> ('a fin -> 'b term) -> 'a fin -> 'c term *)
+   ('b fin -> 'c term) -> ('a fin -> 'b term) -> 'a fin -> 'c term
+  *)
 
-(* 4 The Occur-Check, through thick and thin *)
+(* 4 The Occur-Check, through thick and thin
+  *)
 
 let rec thin : type n. n succ fin -> n fin -> n succ fin =
   fun x y ->
@@ -2884,7 +3029,8 @@ let bind t f =
   | Some x -> f x
 ;;
 
-(* val bind : 'a option -> ('a -> 'b option) -> 'b option *)
+(* val bind : 'a option -> ('a -> 'b option) -> 'b option
+  *)
 
 let rec thick : type n. n succ fin -> n succ fin -> n fin option =
   fun x y ->
@@ -2914,12 +3060,15 @@ let subst_var x t' y =
   | Some y' -> Var y'
 ;;
 
-(* val subst_var : 'a succ fin -> 'a term -> 'a succ fin -> 'a term *)
+(* val subst_var : 'a succ fin -> 'a term -> 'a succ fin -> 'a term
+  *)
 
 let subst x t' = pre_subst (subst_var x t')
-(* val subst : 'a succ fin -> 'a term -> 'a succ term -> 'a term *)
+(* val subst : 'a succ fin -> 'a term -> 'a succ term -> 'a term
+  *)
 
-(* 5 A Refinement of Substitution *)
+(* 5 A Refinement of Substitution
+  *)
 
 type (_, _) alist =
   | Anil : ('n, 'n) alist
@@ -2941,7 +3090,8 @@ type _ ealist = EAlist : ('a, 'b) alist -> 'a ealist
 
 let asnoc a t' x = EAlist (Asnoc (a, t', x))
 
-(* Extra work: we need sub to work on ealist too, for examples *)
+(* Extra work: we need sub to work on ealist too, for examples
+  *)
 let rec weaken_fin : type n. n fin -> n succ fin = function
   | FZ -> FZ
   | FS x -> FS (weaken_fin x)
@@ -2961,9 +3111,11 @@ let rec sub' : type m. m ealist -> m fin -> m term = function
 ;;
 
 let subst' d = pre_subst (sub' d)
-(* val subst' : 'a ealist -> 'a term -> 'a term *)
+(* val subst' : 'a ealist -> 'a term -> 'a term
+  *)
 
-(* 6 First-Order Unification *)
+(* 6 First-Order Unification
+  *)
 
 let flex_flex x y =
   match thick x y with
@@ -2971,10 +3123,12 @@ let flex_flex x y =
   | None -> EAlist Anil
 ;;
 
-(* val flex_flex : 'a succ fin -> 'a succ fin -> 'a succ ealist *)
+(* val flex_flex : 'a succ fin -> 'a succ fin -> 'a succ ealist
+  *)
 
 let flex_rigid x t = bind (check x t) (fun t' -> Some (asnoc Anil t' x))
-(* val flex_rigid : 'a succ fin -> 'a succ term -> 'a succ ealist option *)
+(* val flex_rigid : 'a succ fin -> 'a succ term -> 'a succ ealist option
+  *)
 
 let rec amgu : type m. m term -> m term -> m ealist -> m ealist option =
   fun s t acc ->
@@ -2999,7 +3153,8 @@ let rec amgu : type m. m term -> m term -> m ealist -> m ealist option =
 ;;
 
 let mgu s t = amgu s t (EAlist Anil)
-(* val mgu : 'a term -> 'a term -> 'a ealist option *)
+(* val mgu : 'a term -> 'a term -> 'a ealist option
+  *)
 
 let s = Fork (Var FZ, Fork (Var (FS (FS FZ)), Leaf))
 let t = Fork (Var (FS FZ), Var (FS FZ))
@@ -3013,7 +3168,8 @@ let d =
 let s' = subst' d s
 let t' = subst' d t
 
-(* Injectivity *)
+(* Injectivity
+  *)
 
 type (_, _) eq = Refl : ('a, 'a) eq
 
@@ -3035,7 +3191,8 @@ let magic : 'a 'b. 'a -> 'b =
   M.f Refl
 ;;
 
-(* Variance and subtyping *)
+(* Variance and subtyping
+  *)
 
 type (_, +_) eq = Refl : ('a, 'a) eq
 
@@ -3054,7 +3211,8 @@ let magic : 'a 'b. 'a -> 'b =
     #m
 ;;
 
-(* Record patterns *)
+(* Record patterns
+  *)
 
 type _ t =
   | IntLit : int t
@@ -3087,19 +3245,24 @@ module type S = sig type t [@@immediate] end
 module F : functor (M : S) -> S
 |}]
 
-(* VALID DECLARATIONS *)
+(* VALID DECLARATIONS
+  *)
 
 module A = struct
-  (* Abstract types can be immediate *)
+  (* Abstract types can be immediate
+    *)
   type t [@@immediate]
 
-  (* [@@immediate] tag here is unnecessary but valid since t has it *)
+  (* [@@immediate] tag here is unnecessary but valid since t has it
+    *)
   type s = t [@@immediate]
 
-  (* Again, valid alias even without tag *)
+  (* Again, valid alias even without tag
+    *)
   type r = s
 
-  (* Mutually recursive declarations work as well *)
+  (* Mutually recursive declarations work as well
+    *)
   type p = q [@@immediate]
   and q = int
 end
@@ -3116,7 +3279,8 @@ module A :
   end
 |}]
 
-(* Valid using with constraints *)
+(* Valid using with constraints
+  *)
 module type X = sig
   type t
 end
@@ -3136,7 +3300,8 @@ module Y : sig type t = int end
 module Z : sig type t [@@immediate] end
 |}]
 
-(* Valid using an explicit signature *)
+(* Valid using an explicit signature
+  *)
 module M_valid : S = struct
   type t = int
 end
@@ -3150,7 +3315,8 @@ module M_valid : S
 module FM_valid : S
 |}]
 
-(* Practical usage over modules *)
+(* Practical usage over modules
+  *)
 module Foo : sig
   type t
 
@@ -3211,11 +3377,14 @@ 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 "With @@immediate: %fs\n" (test test_bar)
+  *)
 
-(* INVALID DECLARATIONS *)
+(* INVALID DECLARATIONS
+  *)
 
-(* Cannot directly declare a non-immediate type as immediate *)
+(* Cannot directly declare a non-immediate type as immediate
+  *)
 module B = struct
   type t = string [@@immediate]
 end
@@ -3227,7 +3396,8 @@ Error: Types marked with the immediate attribute must be
        non-pointer types like int or bool
 |}]
 
-(* Not guaranteed that t is immediate, so this is an invalid declaration *)
+(* Not guaranteed that t is immediate, so this is an invalid declaration
+  *)
 module C = struct
   type t
   type s = t [@@immediate]
@@ -3240,7 +3410,8 @@ Error: Types marked with the immediate attribute must be
        non-pointer types like int or bool
 |}]
 
-(* Can't ascribe to an immediate type signature with a non-immediate type *)
+(* Can't ascribe to an immediate type signature with a non-immediate type
+  *)
 module D : sig
   type t [@@immediate]
 end = struct
@@ -3262,7 +3433,8 @@ Error: Signature mismatch:
        the first is not an immediate type.
 |}]
 
-(* Same as above but with explicit signature *)
+(* Same as above but with explicit signature
+  *)
 module M_invalid : S = struct
   type t = string
 end
@@ -3283,7 +3455,8 @@ Error: Signature mismatch:
        the first is not an immediate type.
 |}]
 
-(* Can't use a non-immediate type even if mutually recursive *)
+(* Can't use a non-immediate type even if mutually recursive
+  *)
 module E = struct
   type t = s [@@immediate]
   and s = string
@@ -3297,23 +3470,26 @@ Error: Types marked with the immediate attribute must be
 |}]
 
 (*
-   Implicit unpack allows to omit the signature in (val ...) expressions.
+     Implicit unpack allows to omit the signature in (val ...) expressions.
 
-   It also adds (module M : S) and (module M) patterns, relying on
-   implicit (val ...) for the implementation. Such patterns can only
-   be used in function definition, match clauses, and let ... in.
+     It also adds (module M : S) and (module M) patterns, relying on
+     implicit (val ...) for the implementation. Such patterns can only
+     be used in function definition, match clauses, and let ... in.
 
-   New: implicit pack is also supported, and you only need to be able
-   to infer the the module type path from the context.
-*)
-(* ocaml -principal *)
+     New: implicit pack is also supported, and you only need to be able
+     to infer the the module type path from the context.
+  *)
+(* ocaml -principal
+  *)
 
-(* Use a module pattern *)
+(* Use a module pattern
+  *)
 let sort (type s) (module Set : Set.S with type elt = s) l =
   Set.elements (List.fold_right Set.add l Set.empty)
 ;;
 
-(* No real improvement here? *)
+(* No real improvement here?
+  *)
 let make_set (type s) cmp : (module Set.S with type elt = s) =
   (module Set.Make (struct
       type t = s
@@ -3322,7 +3498,8 @@ let make_set (type s) cmp : (module Set.S with type elt = s) =
     end))
 ;;
 
-(* No type annotation here *)
+(* No type annotation here
+  *)
 let sort_cmp (type s) cmp =
   sort
     (module Set.Make (struct
@@ -3341,7 +3518,8 @@ end
 let f (module M : S with type t = int) = M.x
 let f (module M : S with type t = 'a) = M.x
 
-(* Error *)
+(* Error
+  *)
 let f (type a) (module M : S with type t = a) = M.x;;
 
 f
@@ -3363,7 +3541,8 @@ type 'a s = { s : (module S with type t = 'a) };;
 
 let f { s = (module M) } = M.x
 
-(* Error *)
+(* Error
+  *)
 let f (type a) ({ s = (module M) } : a s) = M.x
 
 type s = { s : (module S with type t = int) }
@@ -3383,7 +3562,8 @@ let m =
   end)
 ;;
 
-(* Error *)
+(* Error
+  *)
 let m =
   (module struct
     let x = 3
@@ -3405,12 +3585,14 @@ M.x
 
 let (module M) = m
 
-(* Error: only allowed in [let .. in] *)
+(* Error: only allowed in [let .. in]
+  *)
 class c =
   let (module M) = m in
   object end
 
-(* Error again *)
+(* Error again
+  *)
 module M = (val m)
 
 module type S' = sig
@@ -3418,7 +3600,8 @@ module type S' = sig
 end
 ;;
 
-(* Even works with recursion, but must be fully explicit *)
+(* Even works with recursion, but must be fully explicit
+  *)
 let rec (module M : S') =
   (module struct
     let f n = if n <= 0 then 1 else n * M.f (n - 1)
@@ -3426,7 +3609,8 @@ let rec (module M : S') =
 in
 M.f 3
 
-(* Subtyping *)
+(* Subtyping
+  *)
 
 module type S = sig
   type t
@@ -3503,7 +3687,8 @@ let rec to_string : 'a. 'a Typ.typ -> 'a -> string =
     Printf.sprintf "(%s,%s)" (to_string P.t1 x1) (to_string P.t2 x2)
 ;;
 
-(* Wrapping maps *)
+(* Wrapping maps
+  *)
 module type MapT = sig
   include Map.S
 
@@ -3565,7 +3750,8 @@ add ssmap
 open StdLabels
 open MoreLabels
 
-(* Use maps for substitutions and sets for free variables *)
+(* Use maps for substitutions and sets for free variables
+  *)
 
 module Subst = Map.Make (struct
     type t = string
@@ -3579,7 +3765,8 @@ module Names = Set.Make (struct
     let compare = compare
   end)
 
-(* Variables are common to lambda and expr *)
+(* Variables are common to lambda and expr
+  *)
 
 type var = [ `Var of string ]
 
@@ -3593,7 +3780,8 @@ let free_var : var -> _ = function
   | `Var s -> Names.singleton s
 ;;
 
-(* The lambda language: free variables, substitutions, and evaluation *)
+(* The lambda language: free variables, substitutions, and evaluation
+  *)
 
 type 'a lambda =
   [ `Var of string
@@ -3648,13 +3836,15 @@ let eval_lambda ~eval_rec ~subst l =
   | t -> t
 ;;
 
-(* Specialized versions to use on lambda *)
+(* Specialized versions to use on lambda
+  *)
 
 let rec free1 x = free_lambda ~free_rec:free1 x
 let rec subst1 ~subst = subst_lambda ~subst_rec:subst1 ~free:free1 ~subst
 let rec eval1 x = eval_lambda ~eval_rec:eval1 ~subst:subst1 x
 
-(* The expr language of arithmetic expressions *)
+(* The expr language of arithmetic expressions
+  *)
 
 type 'a expr =
   [ `Var of string
@@ -3672,7 +3862,8 @@ let free_expr ~free_rec : _ expr -> _ = function
   | `Mult (x, y) -> Names.union (free_rec x) (free_rec y)
 ;;
 
-(* Here map_expr helps a lot *)
+(* Here map_expr helps a lot
+  *)
 let map_expr ~map_rec : _ expr -> _ = function
   | #var as x -> x
   | `Num _ as x -> x
@@ -3702,13 +3893,15 @@ let eval_expr ~eval_rec e =
   | #expr as e -> e
 ;;
 
-(* Specialized versions *)
+(* Specialized versions
+  *)
 
 let rec free2 x = free_expr ~free_rec:free2 x
 let rec subst2 ~subst = subst_expr ~subst_rec:subst2 ~subst
 let rec eval2 x = eval_expr ~eval_rec:eval2 x
 
-(* The lexpr language, reunion of lambda and expr *)
+(* The lexpr language, reunion of lambda and expr
+  *)
 
 type lexpr =
   [ `Var of string
@@ -3770,12 +3963,14 @@ let () =
   print_newline ()
 ;;
 
-(* Full fledge version, using objects to structure code *)
+(* Full fledge version, using objects to structure code
+  *)
 
 open StdLabels
 open MoreLabels
 
-(* Use maps for substitutions and sets for free variables *)
+(* Use maps for substitutions and sets for free variables
+  *)
 
 module Subst = Map.Make (struct
     type t = string
@@ -3789,7 +3984,8 @@ module Names = Set.Make (struct
     let compare = compare
   end)
 
-(* To build recursive objects *)
+(* To build recursive objects
+  *)
 
 let lazy_fix make =
   let rec obj () = make (lazy (obj ()) : _ Lazy.t) in
@@ -3798,7 +3994,8 @@ let lazy_fix make =
 
 let ( !! ) = Lazy.force
 
-(* The basic operations *)
+(* The basic operations
+  *)
 
 class type ['a, 'b] ops = object
   method free : x:'b -> ?y:'c -> Names.t
@@ -3806,7 +4003,8 @@ class type ['a, 'b] ops = object
   method eval : 'b -> 'a
 end
 
-(* Variables are common to lambda and expr *)
+(* Variables are common to lambda and expr
+  *)
 
 type var = [ `Var of string ]
 
@@ -3822,7 +4020,8 @@ class ['a] var_ops =
     method eval (#var as v) = v
   end
 
-(* The lambda language: free variables, substitutions, and evaluation *)
+(* The lambda language: free variables, substitutions, and evaluation
+  *)
 
 type 'a lambda =
   [ `Var of string
@@ -3885,11 +4084,13 @@ class ['a] lambda_ops (ops : ('a, 'a) #ops Lazy.t) =
       | t -> t
   end
 
-(* Operations specialized to lambda *)
+(* Operations specialized to lambda
+  *)
 
 let lambda = lazy_fix (new lambda_ops)
 
-(* The expr language of arithmetic expressions *)
+(* The expr language of arithmetic expressions
+  *)
 
 type 'a expr =
   [ `Var of string
@@ -3944,11 +4145,13 @@ class ['a] expr_ops (ops : ('a, 'a) #ops Lazy.t) =
       | e -> e
   end
 
-(* Specialized versions *)
+(* Specialized versions
+  *)
 
 let expr = lazy_fix (new expr_ops)
 
-(* The lexpr language, reunion of lambda and expr *)
+(* The lexpr language, reunion of lambda and expr
+  *)
 
 type 'a lexpr =
   [ 'a lambda
@@ -4016,12 +4219,14 @@ let () =
   print_newline ()
 ;;
 
-(* Full fledge version, using objects to structure code *)
+(* Full fledge version, using objects to structure code
+  *)
 
 open StdLabels
 open MoreLabels
 
-(* Use maps for substitutions and sets for free variables *)
+(* Use maps for substitutions and sets for free variables
+  *)
 
 module Subst = Map.Make (struct
     type t = string
@@ -4035,7 +4240,8 @@ module Names = Set.Make (struct
     let compare = compare
   end)
 
-(* To build recursive objects *)
+(* To build recursive objects
+  *)
 
 let lazy_fix make =
   let rec obj () = make (lazy (obj ()) : _ Lazy.t) in
@@ -4044,7 +4250,8 @@ let lazy_fix make =
 
 let ( !! ) = Lazy.force
 
-(* The basic operations *)
+(* The basic operations
+  *)
 
 class type ['a, 'b] ops = object
   method free : 'b -> Names.t
@@ -4052,7 +4259,8 @@ class type ['a, 'b] ops = object
   method eval : 'b -> 'a
 end
 
-(* Variables are common to lambda and expr *)
+(* Variables are common to lambda and expr
+  *)
 
 type var = [ `Var of string ]
 
@@ -4067,7 +4275,8 @@ let var =
   end
 ;;
 
-(* The lambda language: free variables, substitutions, and evaluation *)
+(* The lambda language: free variables, substitutions, and evaluation
+  *)
 
 type 'a lambda =
   [ `Var of string
@@ -4128,11 +4337,13 @@ let lambda_ops (ops : ('a, 'a) #ops Lazy.t) =
   end
 ;;
 
-(* Operations specialized to lambda *)
+(* Operations specialized to lambda
+  *)
 
 let lambda = lazy_fix lambda_ops
 
-(* The expr language of arithmetic expressions *)
+(* The expr language of arithmetic expressions
+  *)
 
 type 'a expr =
   [ `Var of string
@@ -4185,11 +4396,13 @@ let expr_ops (ops : ('a, 'a) #ops Lazy.t) =
   end
 ;;
 
-(* Specialized versions *)
+(* Specialized versions
+  *)
 
 let expr = lazy_fix expr_ops
 
-(* The lexpr language, reunion of lambda and expr *)
+(* The lexpr language, reunion of lambda and expr
+  *)
 
 type 'a lexpr =
   [ 'a lambda
@@ -4368,11 +4581,13 @@ let _ = foo ()
 
 type 'a t = [ `A of 'a t t ] as 'a
 
-(* fails *)
+(* fails
+  *)
 
 type 'a t = [ `A of 'a t t ]
 
-(* fails *)
+(* fails
+  *)
 
 type 'a t = [ `A of 'a t t ] constraint 'a = 'a t
 type 'a t = [ `A of 'a t ] constraint 'a = 'a t
@@ -4382,17 +4597,20 @@ type 'a v = [ `A of u v ] constraint 'a = t
 and t = u
 and u = t
 
-(* fails *)
+(* fails
+  *)
 
 type 'a t = 'a
 
 let f (x : 'a t as 'a) = ()
 
-(* fails *)
+(* fails
+  *)
 
 let f (x : 'a t) (y : 'a) = x = y
 
-(* PR#6505 *)
+(* PR#6505
+  *)
 module type PR6505 = sig
   type 'o is_an_object = < .. > as 'o
   and 'o abs constraint 'o = 'o is_an_object
@@ -4401,13 +4619,16 @@ module type PR6505 = sig
   val unabs : 'o abs -> 'o
 end
 
-(* fails *)
-(* PR#5835 *)
+(* fails
+  *)
+(* PR#5835
+  *)
 let f ~x = x + 1;;
 
 f ?x:0
 
-(* PR#6352 *)
+(* PR#6352
+  *)
 let foo (f : unit -> unit) = ()
 let g ?x () = ();;
 
@@ -4416,11 +4637,14 @@ foo
    g)
 ;;
 
-(* PR#5748 *)
+(* PR#5748
+  *)
 foo (fun ?opt () -> ())
 
-(* fails *)
-(* PR#5907 *)
+(* fails
+  *)
+(* PR#5907
+  *)
 
 type 'a t = 'a
 
@@ -4456,15 +4680,18 @@ let f (x : [< `A | `B ]) =
   | `A | `B | `C -> 0
 ;;
 
-(* warn *)
+(* warn
+  *)
 let f (x : [ `A | `B ]) =
   match x with
   | `A | `B | `C -> 0
 ;;
 
-(* fail *)
+(* fail
+  *)
 
-(* PR#6787 *)
+(* PR#6787
+  *)
 let revapply x f = f x
 
 let f x (g : [< `Foo ]) =
@@ -4472,7 +4699,8 @@ let f x (g : [< `Foo ]) =
   revapply y (fun (`Bar i, _) -> i)
 ;;
 
-(* f : 'a -> [< `Foo ] -> 'a *)
+(* f : 'a -> [< `Foo ] -> 'a
+  *)
 
 let rec x =
   [| x |];
@@ -4495,7 +4723,8 @@ let _ = fun (x : a t) -> f x
 let _ = fun (x : a t) -> g x
 let _ = fun (x : a t) -> h x
 
-(* PR#7012 *)
+(* PR#7012
+  *)
 
 type t =
   [ 'A_name
@@ -4505,7 +4734,8 @@ type t =
 let f (x : 'id_arg) = x
 let f (x : 'Id_arg) = x
 
-(* undefined labels *)
+(* undefined labels
+  *)
 type t =
   { x : int
   ; y : int
@@ -4515,16 +4745,19 @@ type t =
 { x = 3; z = 2 };;
 fun { x = 3; z = 2 } -> ();;
 
-(* mixed labels *)
+(* mixed labels
+  *)
 { x = 3; contents = 2 }
 
-(* private types *)
+(* private types
+  *)
 type u = private { mutable u : int };;
 
 { u = 3 };;
 fun x -> x.u <- 3
 
-(* Punning and abbreviations *)
+(* Punning and abbreviations
+  *)
 module M = struct
   type t =
     { x : int
@@ -4536,12 +4769,14 @@ let f { M.x; y } = x + y
 let r = { M.x = 1; y = 2 }
 let z = f r
 
-(* messages *)
+(* messages
+  *)
 type foo = { mutable y : int }
 
 let f (r : int) = r.y <- 3
 
-(* bugs *)
+(* bugs
+  *)
 type foo =
   { y : int
   ; z : int
@@ -4557,10 +4792,12 @@ let r : foo = { ZZZ.x = 2 };;
 
 (ZZZ.X : int option)
 
-(* PR#5865 *)
+(* PR#5865
+  *)
 let f (x : Complex.t) = x.Complex.z
 
-(* PR#6394 *)
+(* PR#6394
+  *)
 
 module rec X : sig
   type t = int * bool
@@ -4574,7 +4811,8 @@ end = struct
   ;;
 end
 
-(* PR#6768 *)
+(* PR#6768
+  *)
 
 type _ prod = Prod : ('a * 'y) prod
 
@@ -4606,7 +4844,8 @@ end =
 let f1 (x : (_, _) Hash1.t) : (_, _) Hashtbl.t = x
 let f2 (x : (_, _) Hash2.t) : (_, _) Hashtbl.t = x
 
-(* Another case, not using include *)
+(* Another case, not using include
+  *)
 
 module Std2 = struct
   module M = struct
@@ -4634,7 +4873,7 @@ let f3 (x : M'.t) : Std2.M.t = x
    type doesnt_type = unit
    constraint 'a Coverage.Table.t = (Coverage.t, 'a) Hashtbl2.t
    end
-*)
+  *)
 module type INCLUDING = sig
   include module type of List
   include module type of ListLabels
@@ -4753,7 +4992,8 @@ struct
   module X = (val if !flag then (module A) else (module B) : S.T)
 end
 
-(* If the above were accepted, one could break soundness *)
+(* If the above were accepted, one could break soundness
+  *)
 module type S = sig
   type t
 
@@ -4815,7 +5055,7 @@ end
    -> S with type t = Html5_types.div Html5.elt and
    type u = < foo: Html5.uri >
    end
-*)
+  *)
 module type S = sig
   include Set.S
 
@@ -4943,7 +5183,8 @@ module X = struct
   end
 end
 
-(* open X  (* works! *) *)
+(* open X  (* works! *)
+  *)
 module Y = X.Y
 
 type 'a arg_t = 'at constraint 'a = (module Y.S with type t = 'at)
@@ -4973,12 +5214,15 @@ module type S = sig
 end
 
 let f (type a) (module X : S with type t = a) = ()
-let _ = f (module A) (* ok *)
+let _ = f (module A) (* ok
+                       *)
 
 module A_annotated_alias : S with type t = (module A.A_S) = A
 
-let _ = f (module A_annotated_alias) (* ok *)
-let _ = f (module A_annotated_alias : S with type t = (module A.A_S)) (* ok *)
+let _ = f (module A_annotated_alias) (* ok
+                                       *)
+let _ = f (module A_annotated_alias : S with type t = (module A.A_S)) (* ok
+                                                                        *)
 
 module A_alias = A
 
@@ -4986,10 +5230,14 @@ module A_alias_expanded = struct
   include A_alias
 end
 
-let _ = f (module A_alias_expanded : S with type t = (module A.A_S)) (* ok *)
-let _ = f (module A_alias_expanded) (* ok *)
-let _ = f (module A_alias : S with type t = (module A.A_S)) (* doesn't type *)
-let _ = f (module A_alias) (* doesn't type either *)
+let _ = f (module A_alias_expanded : S with type t = (module A.A_S)) (* ok
+                                                                       *)
+let _ = f (module A_alias_expanded) (* ok
+                                      *)
+let _ = f (module A_alias : S with type t = (module A.A_S)) (* doesn't type
+                                                              *)
+let _ = f (module A_alias) (* doesn't type either
+                             *)
 
 module Foo
     (Bar : sig
@@ -5005,7 +5253,8 @@ module Bazoinks = struct
 end
 
 module Bug = Foo (Bazoinks) (Bazoinks)
-(* PR#6992, reported by Stephen Dolan *)
+(* PR#6992, reported by Stephen Dolan
+  *)
 
 type (_, _) eq = Eq : ('a, 'a) eq
 
@@ -5024,7 +5273,7 @@ end
    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
     type a
@@ -5061,7 +5310,8 @@ module type FOO = sig
 end
 
 module type BAR = sig
-  (* Works: module rec A : (sig include FOO with type t = < b:B.t > end) *)
+  (* Works: module rec A : (sig include FOO with type t = < b:B.t > end)
+    *)
   module rec A : (FOO with type t = < b : B.t >)
   and B : FOO
 end
@@ -5146,7 +5396,8 @@ end = struct
   let add_dec dec = Fast.attach Dem.key dec
 end
 
-(* simpler version *)
+(* simpler version
+  *)
 
 module Simple = struct
   type 'a t
@@ -5209,7 +5460,8 @@ module rec M : sig
 end = struct
   external f : int -> int = "%identity"
 end
-(* with module *)
+(* with module
+  *)
 
 module type S = sig
   type t
@@ -5225,26 +5477,28 @@ end
 
 module type S' = S with module M := String
 
-(* with module type *)
+(* with module type
+  *)
 (*
-   module type S = sig module type T module F(X:T) : T end;;
-   module type T0 = sig type t end;;
-   module type S1 = S with module type T = T0;;
-   module type S2 = S with module type T := T0;;
-   module type S3 = S with module type T := sig type t = int end;;
-   module H = struct
-   include (Hashtbl : module type of Hashtbl with
-   type statistics := Hashtbl.statistics
-   and module type S := Hashtbl.S
-   and module Make := Hashtbl.Make
-   and module MakeSeeded := Hashtbl.MakeSeeded
-   and module type SeededS := Hashtbl.SeededS
-   and module type HashedType := Hashtbl.HashedType
-   and module type SeededHashedType := Hashtbl.SeededHashedType)
-   end;;
-*)
-
-(* A subtle problem appearing with -principal *)
+     module type S = sig module type T module F(X:T) : T end;;
+     module type T0 = sig type t end;;
+     module type S1 = S with module type T = T0;;
+     module type S2 = S with module type T := T0;;
+     module type S3 = S with module type T := sig type t = int end;;
+     module H = struct
+     include (Hashtbl : module type of Hashtbl with
+     type statistics := Hashtbl.statistics
+     and module type S := Hashtbl.S
+     and module Make := Hashtbl.Make
+     and module MakeSeeded := Hashtbl.MakeSeeded
+     and module type SeededS := Hashtbl.SeededS
+     and module type HashedType := Hashtbl.HashedType
+     and module type SeededHashedType := Hashtbl.SeededHashedType)
+     end;;
+  *)
+
+(* A subtle problem appearing with -principal
+  *)
 type -'a t
 
 class type c = object
@@ -5260,21 +5514,24 @@ end = struct
   ;;
 end
 
-(* PR#4838 *)
+(* PR#4838
+  *)
 
 let id =
   let module M = struct end in
   fun x -> x
 ;;
 
-(* PR#4511 *)
+(* PR#4511
+  *)
 
 let ko =
   let module M = struct end in
   fun _ -> ()
 ;;
 
-(* PR#5993 *)
+(* PR#5993
+  *)
 
 module M : sig
   type -'a t = private int
@@ -5282,7 +5539,8 @@ end = struct
   type +'a t = private int
 end
 
-(* PR#6005 *)
+(* PR#6005
+  *)
 
 module type A = sig
   type t = X of int
@@ -5292,7 +5550,8 @@ type u = X of bool
 
 module type B = A with type t = u
 
-(* fail *)
+(* fail
+  *)
 
 (* PR#5815 *)
 (* ---> duplicated exception name is now an error *)
@@ -5302,7 +5561,8 @@ module type S = sig
   exception Foo of bool
 end
 
-(* PR#6410 *)
+(* PR#6410
+  *)
 
 module F (X : sig end) = struct
   let x = 3
@@ -5311,7 +5571,8 @@ end
 
 F.x
 
-(* fail *)
+(* fail
+  *)
 module C = Char;;
 
 C.chr 66
@@ -5349,7 +5610,8 @@ module G (X : sig end) = struct
   module M = X
 end
 
-(* does not alias X *)
+(* does not alias X
+  *)
 module M = G (struct end)
 
 module M' = struct
@@ -5492,7 +5754,8 @@ end =
   M
 ;;
 
-(* sound, but should probably fail *)
+(* sound, but should probably fail
+  *)
 M1.C'.escaped 'A'
 
 module M2 : sig
@@ -5541,14 +5804,16 @@ struct
   module C = X.C
 end
 
-(* Applicative functors *)
+(* Applicative functors
+  *)
 module S = String
 module StringSet = Set.Make (String)
 module SSet = Set.Make (S)
 
 let f (x : StringSet.t) : SSet.t = x
 
-(* Also using include (cf. Leo's mail 2013-11-16) *)
+(* Also using include (cf. Leo's mail 2013-11-16)
+  *)
 module F (M : sig end) : sig
   type t
 end = struct
@@ -5590,7 +5855,8 @@ end
 
 module M = struct
   module X = struct end
-  module Y = FF (X) (* XXX *)
+  module Y = FF (X) (* XXX
+                      *)
 
   type t = Y.t
 end
@@ -5609,7 +5875,8 @@ module G = F (M.Y)
 (*module N = G (M);;
   module N = F (M.Y) (M);;*)
 
-(* PR#6307 *)
+(* PR#6307
+  *)
 
 module A1 = struct end
 module A2 = struct end
@@ -5625,12 +5892,15 @@ end
 module F (L : module type of L1) = struct end
 module F1 = F (L1)
 
-(* ok *)
+(* ok
+  *)
 module F2 = F (L2)
 
-(* should succeed too *)
+(* should succeed too
+  *)
 
-(* Counter example: why we need to be careful with PR#6307 *)
+(* Counter example: why we need to be careful with PR#6307
+  *)
 module Int = struct
   type t = int
 
@@ -5650,7 +5920,8 @@ end
 
 module type S = module type of M
 
-(* keep alias *)
+(* keep alias
+  *)
 
 module Int2 = struct
   type t = int
@@ -5663,7 +5934,8 @@ module type S' = sig
   include S with module I := I
 end
 
-(* fail *)
+(* fail
+  *)
 
 (* (* if the above succeeded, one could break invariants *)
    module rec M2 : S' = M2;; (* should succeed! (but this is bad) *)
@@ -5676,9 +5948,10 @@ end
    let s' : SInt2.t = conv eq s;;
    SInt2.elements s';;
    SInt2.mem 2 s';; (* invariants are broken *)
-*)
+  *)
 
-(* Check behavior with submodules *)
+(* Check behavior with submodules
+  *)
 module M = struct
   module N = struct
     module I = Int
@@ -5711,7 +5984,8 @@ end
 
 module type S = module type of M
 
-(* PR#6365 *)
+(* PR#6365
+  *)
 module type S = sig
   module M : sig
     type t
@@ -5730,9 +6004,11 @@ module H' = H
 
 module type S' = S with module M = H'
 
-(* shouldn't introduce an alias *)
+(* shouldn't introduce an alias
+  *)
 
-(* PR#6376 *)
+(* PR#6376
+  *)
 module type Alias = sig
   module N : sig end
   module M = N
@@ -5746,7 +6022,8 @@ module type A = Alias with module N := F(List)
 
 module rec Bad : A = Bad
 
-(* Shinwell 2014-04-23 *)
+(* Shinwell 2014-04-23
+  *)
 module B = struct
   module R = struct
     type t = string
@@ -5762,7 +6039,8 @@ end
 
 let x : K.N.t = "foo"
 
-(* PR#6465 *)
+(* PR#6465
+  *)
 
 module M = struct
   type t = A
@@ -5779,7 +6057,8 @@ module P : sig
 end =
   M
 
-(* should be ok *)
+(* should be ok
+  *)
 module P : sig
   type t = M.t = A
 
@@ -5819,9 +6098,11 @@ end
 
 module R' : S = R
 
-(* should be ok *)
+(* should be ok
+  *)
 
-(* PR#6578 *)
+(* PR#6578
+  *)
 
 module M = struct
   let f x = x
@@ -5860,14 +6141,14 @@ end
 
 (* The following introduces a (useless) dependency on A:
    module C : sig module L : module type of List end = A
-*)
+  *)
 
 include D'
 
 (*
-   let () =
-   print_endline (string_of_int D'.M.y)
-*)
+     let () =
+     print_endline (string_of_int D'.M.y)
+  *)
 open A
 
 let f = L.map S.capitalize
@@ -5881,9 +6162,10 @@ end
 
 (* The following introduces a (useless) dependency on A:
    module C : sig module L : module type of List end = A
-*)
+  *)
 
-(* No dependency on D *)
+(* No dependency on D
+  *)
 let x = 3
 
 module M = struct
@@ -5901,11 +6183,13 @@ module type S' = sig
 end
 
 (* ok to convert between structurally equal signatures, and parameters
-   are inferred *)
+   are inferred
+  *)
 let f (x : (module S with type t = 'a and type u = 'b)) : (module S') = x
 let g x = (x : (module S with type t = 'a and type u = 'b) :> (module S'))
 
-(* with subtyping it is also ok to forget some types *)
+(* with subtyping it is also ok to forget some types
+  *)
 module type S2 = sig
   type u
   type t
@@ -5916,12 +6200,15 @@ let g2 x = (x : (module S2 with type t = 'a and type u = 'b) :> (module S'))
 let h x = (x : (module S2 with type t = 'a) :> (module S with type t = 'a))
 let f2 (x : (module S2 with type t = 'a and type u = 'b)) : (module S') = x
 
-(* fail *)
+(* fail
+  *)
 let k (x : (module S2 with type t = 'a)) : (module S with type t = 'a) = x
 
-(* fail *)
+(* fail
+  *)
 
-(* but you cannot forget values (no physical coercions) *)
+(* but you cannot forget values (no physical coercions)
+  *)
 module type S3 = sig
   type u
   type t
@@ -5931,10 +6218,13 @@ end
 
 let g3 x = (x : (module S3 with type t = 'a and type u = 'b) :> (module S'))
 
-(* fail *)
-(* Using generative functors *)
+(* fail
+  *)
+(* Using generative functors
+  *)
 
-(* Without type *)
+(* Without type
+  *)
 module type S = sig
   val x : int
 end
@@ -5947,15 +6237,19 @@ let v =
 
 module F () = (val v)
 
-(* ok *)
+(* ok
+  *)
 module G (X : sig end) : S = F ()
 
-(* ok *)
+(* ok
+  *)
 module H (X : sig end) = (val v)
 
-(* ok *)
+(* ok
+  *)
 
-(* With type *)
+(* With type
+  *)
 module type S = sig
   type t
 
@@ -5972,34 +6266,44 @@ let v =
 
 module F () = (val v)
 
-(* ok *)
+(* ok
+  *)
 module G (X : sig end) : S = F ()
 
-(* fail *)
+(* fail
+  *)
 module H () = F ()
 
-(* ok *)
+(* ok
+  *)
 
-(* Alias *)
+(* Alias
+  *)
 module U = struct end
 module M = F (struct end)
 
-(* ok *)
+(* ok
+  *)
 module M = F (U)
 
-(* fail *)
+(* fail
+  *)
 
-(* Cannot coerce between applicative and generative *)
+(* Cannot coerce between applicative and generative
+  *)
 module F1 (X : sig end) = struct end
 module F2 : functor () -> sig end = F1
 
-(* fail *)
+(* fail
+  *)
 module F3 () = struct end
 module F4 : functor (X : sig end) -> sig end = F3
 
-(* fail *)
+(* fail
+  *)
 
-(* tests for shortened functor notation () *)
+(* tests for shortened functor notation ()
+  *)
 module X (X : sig end) (Y : sig end) = functor (Z : sig end) -> struct end
 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
@@ -6066,16 +6370,17 @@ class ['entity] entity_container =
 let f (x : entity entity_container) = ()
 
 (*
-   class world =
-   object
-   val entity_container : entity entity_container = new entity_container
+     class world =
+     object
+     val entity_container : entity entity_container = new entity_container
 
-   method add_entity (s : entity) =
-   entity_container#add_entity (s :> entity)
+     method add_entity (s : entity) =
+     entity_container#add_entity (s :> entity)
 
-   end
-*)
-(* Two v's in the same class *)
+     end
+  *)
+(* Two v's in the same class
+  *)
 class c v =
   object
     initializer print_endline v
@@ -6085,7 +6390,8 @@ class c v =
 
 new c "42"
 
-(* Two hidden v's in the same class! *)
+(* Two hidden v's in the same class!
+  *)
 class c (v : int) =
   object
     method v0 = v
@@ -6143,7 +6449,8 @@ class c (x : int) =
 
 let r = (new c 2)#x
 
-(* test.ml *)
+(* test.ml
+  *)
 class alfa =
   object (_ : 'self)
     method x : 'a. ('a, out_channel, unit) format -> 'a = Printf.printf
@@ -6161,7 +6468,8 @@ class charlie a =
     initializer y#x "charlie initialized"
   end
 
-(* The module begins *)
+(* The module begins
+  *)
 exception Out_of_range
 
 class type ['a] cursor = object
@@ -6357,7 +6665,9 @@ module UText = struct
     done
   ;;
 
-  let concat s1 s2 = s1#concat (s2 (* : #ustorage *) :> uchar storage)
+  let concat s1 s2 = s1#concat (s2 (* : #ustorage
+                                     *) :> uchar storage)
+
   let iter proc s = s#iter proc
 end
 
@@ -6461,7 +6771,8 @@ end
 type refer1 = < poly : 'a 'b 'c. (('b, 'c) #Classdef.cl2 as 'a) >
 type refer2 = < poly : 'a 'b 'c. (('b, 'c) #Classdef.cl2 as 'a) >
 
-(* Actually this should succeed ... *)
+(* Actually this should succeed ...
+  *)
 let f (x : refer1) : refer2 = x
 
 module Classdef = struct
@@ -6488,10 +6799,10 @@ end = struct
   type refer = { poly : 'a 'b 'c. (('b, 'c) #Classdef.cl2 as 'a) }
 end
 (*
-   ocamlc -c pr3918a.mli pr3918b.mli
-   rm -f pr3918a.cmi
-   ocamlc -c pr3918c.ml
-*)
+     ocamlc -c pr3918a.mli pr3918b.mli
+     rm -f pr3918a.cmi
+     ocamlc -c pr3918c.ml
+  *)
 
 open Pr3918b
 
@@ -6534,7 +6845,8 @@ module Make' (Unit : sig end) : Priv' = struct
 end
 
 module A' = Make' (struct end)
-(* PR5057 *)
+(* PR5057
+  *)
 
 module TT = struct
   module IntSet = Set.Make (struct
@@ -6562,7 +6874,8 @@ let () =
   f `A
 ;;
 
-(* This one should fail *)
+(* This one should fail
+  *)
 
 let f flag =
   let module T =
@@ -6709,7 +7022,8 @@ end =
 
 let f (x : F0.t) : Foobar.t = x
 
-(* fails *)
+(* fails
+  *)
 
 module F = Foobar
 
@@ -6732,7 +7046,8 @@ end =
 
 fun (x : M1.t) : M2.t -> x
 
-(* fails *)
+(* fails
+  *)
 
 module M3 : sig
   type t = private M1.t
@@ -6748,19 +7063,22 @@ module M4 : sig
 end =
   M2
 
-(* fails *)
+(* fails
+  *)
 module M4 : sig
   type t = private M3.t
 end =
   M
 
-(* fails *)
+(* fails
+  *)
 module M4 : sig
   type t = private M3.t
 end =
   M1
 
-(* might be ok *)
+(* might be ok
+  *)
 module M5 : sig
   type t = private M1.t
 end =
@@ -6771,7 +7089,8 @@ module M6 : sig
 end =
   M1
 
-(* fails *)
+(* fails
+  *)
 
 module Bar : sig
   type t = private Foobar.t
@@ -6783,7 +7102,8 @@ end = struct
   let f (x : int) : t = x
 end
 
-(* must fail *)
+(* must fail
+  *)
 
 module M : sig
   type t = private T of int
@@ -6827,7 +7147,8 @@ module M4 : sig
 end =
   M
 
-(* Error: The variant or record definition does not match that of type M.t *)
+(* Error: The variant or record definition does not match that of type M.t
+  *)
 
 module M5 : sig
   type t = M.t = private T of int
@@ -6874,7 +7195,8 @@ end = struct
   type 'a t = 'a M.t = private T of 'a
 end
 
-(* PR#6090 *)
+(* PR#6090
+  *)
 module Test = struct
   type t = private A
 end
@@ -6885,12 +7207,15 @@ let f (x : Test.t) : Test2.t = x
 let f Test2.A = ()
 let a = Test2.A
 
-(* fail *)
+(* fail
+  *)
 (* The following should fail from a semantical point of view,
-   but allow it for backward compatibility *)
+   but allow it for backward compatibility
+  *)
 module Test2 : module type of Test with type t = private Test.t = Test
 
-(* PR#6331 *)
+(* PR#6331
+  *)
 type t = private < x : int ; .. > as 'a
 type t = private (< x : int ; .. > as 'a) as 'a
 type t = private < x : int > as 'a
@@ -6898,14 +7223,16 @@ type t = private (< x : int > as 'a) as 'b
 type 'a t = private < x : int ; .. > as 'a
 type 'a t = private 'a constraint 'a = < x : int ; .. >
 
-(* Bad (t = t) *)
+(* Bad (t = t)
+  *)
 module rec A : sig
   type t = A.t
 end = struct
   type t = A.t
 end
 
-(* Bad (t = t) *)
+(* Bad (t = t)
+  *)
 module rec A : sig
   type t = B.t
 end = struct
@@ -6918,7 +7245,8 @@ end = struct
   type t = A.t
 end
 
-(* OK (t = int) *)
+(* OK (t = int)
+  *)
 module rec A : sig
   type t = B.t
 end = struct
@@ -6931,14 +7259,16 @@ end = struct
   type t = int
 end
 
-(* Bad (t = int * t) *)
+(* Bad (t = int * t)
+  *)
 module rec A : sig
   type t = int * A.t
 end = struct
   type t = int * A.t
 end
 
-(* Bad (t = t -> int) *)
+(* Bad (t = t -> int)
+  *)
 module rec A : sig
   type t = B.t -> int
 end = struct
@@ -6951,7 +7281,8 @@ end = struct
   type t = A.t
 end
 
-(* OK (t = <m:t>) *)
+(* OK (t = <m:t>)
+  *)
 module rec A : sig
   type t = < m : B.t >
 end = struct
@@ -6964,14 +7295,16 @@ end = struct
   type t = A.t
 end
 
-(* Bad (not regular) *)
+(* Bad (not regular)
+  *)
 module rec A : sig
   type 'a t = < m : 'a list A.t >
 end = struct
   type 'a t = < m : 'a list A.t >
 end
 
-(* Bad (not regular) *)
+(* Bad (not regular)
+  *)
 module rec A : sig
   type 'a t = < m : 'a list B.t ; n : 'a array B.t >
 end = struct
@@ -6984,7 +7317,8 @@ end = struct
   type 'a t = 'a A.t
 end
 
-(* Bad (not regular) *)
+(* Bad (not regular)
+  *)
 module rec A : sig
   type 'a t = 'a B.t
 end = struct
@@ -6997,7 +7331,8 @@ end = struct
   type 'a t = < m : 'a list A.t ; n : 'a array A.t >
 end
 
-(* OK *)
+(* OK
+  *)
 module rec A : sig
   type 'a t = 'a array B.t * 'a list B.t
 end = struct
@@ -7010,7 +7345,8 @@ end = struct
   type 'a t = < m : 'a B.t >
 end
 
-(* Bad (not regular) *)
+(* Bad (not regular)
+  *)
 module rec A : sig
   type 'a t = 'a list B.t
 end = struct
@@ -7023,7 +7359,8 @@ end = struct
   type 'a t = < m : 'a array B.t >
 end
 
-(* Bad (not regular) *)
+(* Bad (not regular)
+  *)
 module rec M : sig
   class ['a] c : 'a -> object
     method map : ('a -> 'b) -> 'b M.c
@@ -7035,7 +7372,8 @@ end = struct
     end
 end
 
-(* OK *)
+(* OK
+  *)
 class type ['node] extension = object
   method node : 'node
 end
@@ -7051,7 +7389,8 @@ class x =
 
 type t = x node
 
-(* Bad - PR 4261 *)
+(* Bad - PR 4261
+  *)
 
 module PR_4261 = struct
   module type S = sig
@@ -7068,7 +7407,8 @@ module PR_4261 = struct
   and U' : (S with type t = U'.t) = U
 end
 
-(* Bad - PR 4512 *)
+(* Bad - PR 4512
+  *)
 module type S' = sig
   type t = int
 end
@@ -7077,7 +7417,8 @@ module rec M : (S' with type t = M.t) = struct
   type t = M.t
 end
 
-(* PR#4450 *)
+(* PR#4450
+  *)
 
 module PR_4450_1 = struct
   module type MyT = sig
@@ -7118,7 +7459,8 @@ module PR_4450_2 = struct
 end
 
 (* A synthetic example of bootstrapped data structure
-   (suggested by J-C Filliatre) *)
+   (suggested by J-C Filliatre)
+  *)
 
 module type ORD = sig
   type t
@@ -7171,7 +7513,8 @@ module Bootstrap2
 
   let iter f = Diet.iter (Elt.iter f)
 end
-(* PR 4470: simplified from OMake's sources *)
+(* PR 4470: simplified from OMake's sources
+  *)
 
 module rec DirElt : sig
   type t =
@@ -7194,7 +7537,8 @@ and DirHash : sig
 end = struct
   type t = DirCompare.t list
 end
-(* PR 4758, PR 4266 *)
+(* PR 4758, PR 4266
+  *)
 
 module PR_4758 = struct
   module type S = sig end
@@ -7211,7 +7555,8 @@ module PR_4758 = struct
     module Other = A
   end
 
-  module C' = C (* check that we can take an alias *)
+  module C' = C (* check that we can take an alias
+                  *)
 
   module F (X : sig end) = struct
     type t
@@ -7220,7 +7565,8 @@ module PR_4758 = struct
   let f (x : F(C).t) : F(C').t = x
 end
 
-(* PR 4557 *)
+(* PR 4557
+  *)
 module PR_4557 = struct
   module F (X : Set.OrderedType) = struct
     module rec Mod : sig
@@ -7280,7 +7626,8 @@ module F (X : Set.OrderedType) = struct
 
   and ModSet : (Set.S with type elt = Mod.t) = Set.Make (Mod)
 end
-(* Tests for recursive modules *)
+(* Tests for recursive modules
+  *)
 
 let test number result expected =
   if result = expected
@@ -7289,7 +7636,8 @@ let test number result expected =
   flush stdout
 ;;
 
-(* Tree of sets *)
+(* Tree of sets
+  *)
 
 module rec A : sig
   type t =
@@ -7323,7 +7671,8 @@ let _ =
   test 14 (A.compare x y) 1
 ;;
 
-(* Simple value recursion *)
+(* Simple value recursion
+  *)
 
 module rec Fib : sig
   val f : int -> int
@@ -7333,7 +7682,8 @@ end
 
 let _ = test 20 (Fib.f 10) 89
 
-(* Update function by infix *)
+(* Update function by infix
+  *)
 
 module rec Fib2 : sig
   val f : int -> int
@@ -7344,7 +7694,8 @@ end
 
 let _ = test 21 (Fib2.f 10) 89
 
-(* Early application *)
+(* Early application
+  *)
 
 let _ =
   let res =
@@ -7367,16 +7718,18 @@ let _ =
   test 30 res true
 ;;
 
-(* Early strict evaluation *)
+(* Early strict evaluation
+  *)
 
 (*
-   module rec Cyclic
-   : sig val x : int end
-   = struct let x = Cyclic.x + 1 end
-   ;;
-*)
+     module rec Cyclic
+     : sig val x : int end
+     = struct let x = Cyclic.x + 1 end
+     ;;
+  *)
 
-(* Reordering of evaluation based on dependencies *)
+(* Reordering of evaluation based on dependencies
+  *)
 
 module rec After : sig
   val x : int
@@ -7392,7 +7745,8 @@ end
 
 let _ = test 40 After.x 4
 
-(* Type identity between A.t and t within A's definition *)
+(* Type identity between A.t and t within A's definition
+  *)
 
 module rec Strengthen : sig
   type t
@@ -7443,7 +7797,8 @@ end = struct
   end
 end
 
-(* Polymorphic recursion *)
+(* Polymorphic recursion
+  *)
 
 module rec PolyRec : sig
   type 'a t =
@@ -7464,24 +7819,26 @@ end = struct
   ;;
 end
 
-(* Wrong LHS signatures (PR#4336) *)
+(* Wrong LHS signatures (PR#4336)
+  *)
 
 (*
-   module type ASig = sig type a val a:a val print:a -> unit end
-   module type BSig = sig type b val b:b val print:b -> unit end
+     module type ASig = sig type a val a:a val print:a -> unit end
+     module type BSig = sig type b val b:b val print:b -> unit end
 
-   module A = struct type a = int let a = 0 let print = print_int end
-   module B = struct type b = float let b = 0.0 let print = print_float end
+     module A = struct type a = int let a = 0 let print = print_int end
+     module B = struct type b = float let b = 0.0 let print = print_float end
 
-   module MakeA (Empty:sig end) : ASig = A
-   module MakeB (Empty:sig end) : BSig = B
+     module MakeA (Empty:sig end) : ASig = A
+     module MakeB (Empty:sig end) : BSig = B
 
-   module
-   rec NewA : ASig = MakeA (struct end)
-   and NewB : BSig with type b = NewA.a = MakeB (struct end);;
-*)
+     module
+     rec NewA : ASig = MakeA (struct end)
+     and NewB : BSig with type b = NewA.a = MakeB (struct end);;
+  *)
 
-(* Expressions and bindings *)
+(* Expressions and bindings
+  *)
 
 module StringSet = Set.Make (String)
 
@@ -7547,7 +7904,8 @@ let _ =
   test 51 (Expr.simpl e) e'
 ;;
 
-(* Okasaki's bootstrapping *)
+(* Okasaki's bootstrapping
+  *)
 
 module type ORDERED = sig
   type t
@@ -7716,7 +8074,8 @@ let _ =
   test 62 (C.findMin (C.deleteMin (C.deleteMin h))) 4
 ;;
 
-(* Classes *)
+(* Classes
+  *)
 
 module rec Class1 : sig
   class c : object
@@ -7769,7 +8128,8 @@ let _ =
   | Undefined_recursive_module _ -> test 71 true true
 ;;
 
-(* Coercions *)
+(* Coercions
+  *)
 
 module rec Coerce1 : sig
   val g : int -> int
@@ -7826,7 +8186,8 @@ end =
 
 let _ = test 82 (Coerce6.at 100) 5
 
-(* Miscellaneous bug reports *)
+(* Miscellaneous bug reports
+  *)
 
 module rec F : sig
   type t =
@@ -7850,7 +8211,8 @@ let _ =
   test 101 (F.f (F.Y 2)) true
 ;;
 
-(* PR#4316 *)
+(* PR#4316
+  *)
 module G (S : sig
     val x : int Lazy.t
   end) =
@@ -7870,7 +8232,8 @@ end =
   G (M1)
 
 let _ = test 102 (Lazy.force M2.x) 3
-let _ = Gc.full_major () (* will shortcut forwarding in M1.x *)
+let _ = Gc.full_major () (* will shortcut forwarding in M1.x
+                           *)
 
 module rec M3 : sig
   val x : int Lazy.t
@@ -7888,22 +8251,28 @@ type t =
 
 let f (A r) = r
 
-(* -> escape *)
+(* -> escape
+  *)
 let f (A r) = r.x
 
-(* ok *)
+(* ok
+  *)
 let f x = A { x; y = x }
 
-(* ok *)
+(* ok
+  *)
 let f (A r) = A { r with y = r.x + 1 }
 
-(* ok *)
+(* ok
+  *)
 let f () = A { a = 1 }
 
-(* customized error message *)
+(* customized error message
+  *)
 let f () = A { x = 1; y = 3 }
 
-(* ok *)
+(* ok
+  *)
 
 type _ t =
   | A :
@@ -7914,10 +8283,12 @@ type _ t =
 
 let f (A { x; y }) = A { x; y = () }
 
-(* ok *)
+(* ok
+  *)
 let f (A ({ x; y } as r)) = A { x = r.x; y = r.y }
 
-(* ok *)
+(* ok
+  *)
 
 module M = struct
   type 'a t =
@@ -7952,7 +8323,8 @@ struct
   module A = (val X.x)
 end
 
-(* -> this expression creates fresh types (not really!) *)
+(* -> this expression creates fresh types (not really!)
+  *)
 
 module type S = sig
   exception A of { x : int }
@@ -7999,7 +8371,8 @@ module Z = struct
   type X2.t += A of { x : int }
 end
 
-(* PR#6716 *)
+(* PR#6716
+  *)
 
 type _ c = C : [ `A ] c
 type t = T : { x : [< `A ] c } -> t
@@ -8097,7 +8470,8 @@ open Core.Std
 let x = Int.Map.empty
 let y = x + x
 
-(* Avoid ambiguity *)
+(* Avoid ambiguity
+  *)
 
 module M = struct
   type t = A
@@ -8155,7 +8529,8 @@ module N2 = struct
   and v = M1.v
 end
 
-(* PR#6566 *)
+(* PR#6566
+  *)
 module type PR6566 = sig
   type t = string
 end
@@ -8179,26 +8554,32 @@ module M2 = struct
 end
 
 (* Adapted from: An Expressive Language of Signatures
-   by Norman Ramsey, Kathleen Fisher and Paul Govereau *)
+   by Norman Ramsey, Kathleen Fisher and Paul Govereau
+  *)
 
 module type VALUE = sig
-  type value (* a Lua value *)
-  type state (* the state of a Lua interpreter *)
-  type usert (* a user-defined value *)
+  type value (* a Lua value
+               *)
+  type state (* the state of a Lua interpreter
+               *)
+  type usert (* a user-defined value
+               *)
 end
 
 module type CORE0 = sig
   module V : VALUE
 
   val setglobal : V.state -> string -> V.value -> unit
-  (* five more functions common to core and evaluator *)
+  (* five more functions common to core and evaluator
+    *)
 end
 
 module type CORE = sig
   include CORE0
 
   val apply : V.value -> V.state -> V.value list -> V.value
-  (* apply function f in state s to list of args *)
+  (* apply function f in state s to list of args
+    *)
 end
 
 module type AST = sig
@@ -8319,7 +8700,8 @@ module type PrintableComparable = sig
   include Comparable with type t = t
 end
 
-(* Fails *)
+(* Fails
+  *)
 module type PrintableComparable = sig
   type t
 
@@ -8377,7 +8759,8 @@ module type S = sig
   end
   with type 'a t := unit
 
-(* Fails *)
+(* Fails
+  *)
 let property (type t) () =
   let module M = struct
     exception E of t
@@ -8414,14 +8797,16 @@ let sort_uniq (type s) cmp l =
 let () = print_endline (String.concat "," (sort_uniq compare [ "abc"; "xyz"; "abc" ]))
 let f x (type a) (y : a) = x = y
 
-(* Fails *)
+(* Fails
+  *)
 class ['a] c =
   object (self)
     method m : 'a -> 'a = fun x -> x
     method n : 'a -> 'a = fun (type g) (x : g) -> self#m x
   end
 
-(* Fails *)
+(* Fails
+  *)
 
 external a : (int[@untagged]) -> unit = "a" "a_nat"
 external b : (int32[@unboxed]) -> unit = "b" "b_nat"
@@ -8450,7 +8835,8 @@ module Global_attributes = struct
   external d : float -> float = "d" "noalloc"
   external e : float -> float = "e"
 
-  (* Should output a warning: no native implementation provided *)
+  (* Should output a warning: no native implementation provided
+    *)
   external f : (int32[@unboxed]) -> (int32[@unboxed]) = "f" "noalloc"
   external g : int32 -> int32 = "g" "g_nat" [@@unboxed] [@@noalloc]
   external h : (int[@untagged]) -> (int[@untagged]) = "h" "h_nat" "noalloc"
@@ -8467,7 +8853,8 @@ module Old_style_warning = struct
   external e : float -> float = "c" "float"
 end
 
-(* Bad: attributes not reported in the interface *)
+(* Bad: attributes not reported in the interface
+  *)
 
 module Bad1 : sig
   external f : int -> int = "f" "f_nat"
@@ -8493,7 +8880,8 @@ end = struct
   external f : (float[@unboxed]) -> float = "f" "f_nat"
 end
 
-(* Bad: attributes in the interface but not in the implementation *)
+(* Bad: attributes in the interface but not in the implementation
+  *)
 
 module Bad5 : sig
   external f : int -> (int[@untagged]) = "f" "f_nat"
@@ -8519,29 +8907,35 @@ end = struct
   external f : float -> float = "a" "a_nat"
 end
 
-(* Bad: unboxed or untagged with the wrong type *)
+(* Bad: unboxed or untagged with the wrong type
+  *)
 
 external g : (float[@untagged]) -> float = "g" "g_nat"
 external h : (int[@unboxed]) -> float = "h" "h_nat"
 
-(* Bad: unboxing the function type *)
+(* Bad: unboxing the function type
+  *)
 external i : (int -> float[@unboxed]) = "i" "i_nat"
 
-(* Bad: unboxing a "deep" sub-type. *)
+(* Bad: unboxing a "deep" sub-type.
+  *)
 external j : int -> (float[@unboxed]) * float = "j" "j_nat"
 
 (* This should be rejected, but it is quite complicated to do
-   in the current state of things *)
+   in the current state of things
+  *)
 
 external k : int -> (float[@unboxd]) = "k" "k_nat"
 
-(* Bad: old style annotations + new style attributes *)
+(* Bad: old style annotations + new style attributes
+  *)
 
 external l : float -> float = "l" "l_nat" "float" [@@unboxed]
 external m : (float[@unboxed]) -> float = "m" "m_nat" "float"
 external n : float -> float = "n" "noalloc" [@@noalloc]
 
-(* Warnings: unboxed / untagged without any native implementation *)
+(* Warnings: unboxed / untagged without any native implementation
+  *)
 external o : (float[@unboxed]) -> float = "o"
 external p : float -> (float[@unboxed]) = "p"
 external q : (int[@untagged]) -> float = "q"
@@ -8552,13 +8946,15 @@ external t : float -> float = "t" [@@unboxed]
 let _ = ignore ( + )
 let _ = raise Exit 3;;
 
-(* comment 9644 of PR#6000 *)
+(* comment 9644 of PR#6000
+  *)
 
 fun b -> if b then format_of_string "x" else "y";;
 fun b -> if b then "x" else format_of_string "y";;
 fun b : (_, _, _) format -> if b then "x" else "y"
 
-(* PR#7135 *)
+(* PR#7135
+  *)
 
 module PR7135 = struct
   module M : sig
@@ -8572,7 +8968,8 @@ module PR7135 = struct
   let lift2 (f : int -> int -> int) (x : t) (y : t) = f (x :> int) (y :> int)
 end
 
-(* exemple of non-ground coercion *)
+(* exemple of non-ground coercion
+  *)
 
 module Test1 = struct
   type t = private int
@@ -8583,13 +8980,15 @@ module Test1 = struct
   ;;
 end
 
-(* Warn about all relevant cases when possible *)
+(* Warn about all relevant cases when possible
+  *)
 let f = function
   | None, None -> 1
   | Some _, Some _ -> 2
 ;;
 
-(* Exhaustiveness check is very slow *)
+(* Exhaustiveness check is very slow
+  *)
 type _ t =
   | A : int t
   | B : bool t
@@ -8611,30 +9010,35 @@ let f
   | _, _, _, _, _, _, _, G, _, _ -> 1
 ;;
 
-(*| _ -> _ *)
+(*| _ -> _
+  *)
 
-(* Unused cases *)
+(* Unused cases
+  *)
 let f (x : int t) =
   match x with
   | A -> 1
   | _ -> 2
 ;;
 
-(* warn *)
+(* warn
+  *)
 let f (x : unit t option) =
   match x with
   | None -> 1
   | _ -> 2
 ;;
 
-(* warn? *)
+(* warn?
+  *)
 let f (x : unit t option) =
   match x with
   | None -> 1
   | Some _ -> 2
 ;;
 
-(* warn *)
+(* warn
+  *)
 let f (x : int t option) =
   match x with
   | None -> 1
@@ -8646,9 +9050,11 @@ let f (x : int t option) =
   | None -> 1
 ;;
 
-(* warn *)
+(* warn
+  *)
 
-(* Example with record, type, single case *)
+(* Example with record, type, single case
+  *)
 
 type 'a box = Box of 'a
 
@@ -8665,7 +9071,8 @@ let f : (string t box pair * bool) option -> unit = function
   | None -> ()
 ;;
 
-(* Examples from ML2015 paper *)
+(* Examples from ML2015 paper
+  *)
 
 type _ t =
   | Int : int t
@@ -8741,7 +9148,8 @@ let inv_zero : type a b c d. (a, b, c) plus -> (c, d, zero) plus -> bool =
   | Plus0, Plus0 -> true
 ;;
 
-(* Empty match *)
+(* Empty match
+  *)
 
 type _ t = Int : int t
 
@@ -8750,39 +9158,46 @@ let f (x : bool t) =
   | _ -> .
 ;;
 
-(* ok *)
+(* ok
+  *)
 
-(* trefis in PR#6437 *)
+(* trefis in PR#6437
+  *)
 
 let f () =
   match None with
   | _ -> .
 ;;
 
-(* error *)
+(* error
+  *)
 let g () =
   match None with
   | _ -> ()
   | exception _ -> .
 ;;
 
-(* error *)
+(* error
+  *)
 let h () =
   match None with
   | _ -> .
   | exception _ -> .
 ;;
 
-(* error *)
+(* error
+  *)
 let f x =
   match x with
   | _ -> ()
   | None -> .
 ;;
 
-(* do not warn *)
+(* do not warn
+  *)
 
-(* #7059, all clauses guarded *)
+(* #7059, all clauses guarded
+  *)
 
 let f x y =
   match 1 with
@@ -8799,7 +9214,8 @@ let f : label choice -> bool = function
   | Left -> true
 ;;
 
-(* warn *)
+(* warn
+  *)
 exception A
 
 type a = A;;
@@ -8851,7 +9267,8 @@ end
 type t = A : t
 
 module X1 : sig end = struct
-  let _f ~x (* x unused argument *) = function
+  let _f ~x (* x unused argument
+              *) = function
     | A ->
       let x = () in
       x
@@ -8859,7 +9276,8 @@ module X1 : sig end = struct
 end
 
 module X2 : sig end = struct
-  let x = 42 (* unused value *)
+  let x = 42 (* unused value
+               *)
 
   let _f = function
     | A ->
@@ -8870,10 +9288,12 @@ end
 
 module X3 : sig end = struct
   module O = struct
-    let x = 42 (* unused *)
+    let x = 42 (* unused
+                 *)
   end
 
-  open O (* unused open *)
+  open O (* unused open
+           *)
 
   let _f = function
     | A ->
@@ -8882,7 +9302,8 @@ module X3 : sig end = struct
   ;;
 end
 
-(* Use type information *)
+(* Use type information
+  *)
 module M1 = struct
   type t =
     { x : int
@@ -8898,16 +9319,19 @@ end
 module OK = struct
   open M1
 
-  let f1 (r : t) = r.x (* ok *)
+  let f1 (r : t) = r.x (* ok
+                         *)
 
   let f2 r =
     ignore (r : t);
-    r.x (* non principal *)
+    r.x (* non principal
+          *)
   ;;
 
   let f3 (r : t) =
     match r with
-    | { x; y } -> y + y (* ok *)
+    | { x; y } -> y + y (* ok
+                          *)
   ;;
 end
 
@@ -8920,7 +9344,8 @@ module F1 = struct
   ;;
 end
 
-(* fails *)
+(* fails
+  *)
 
 module F2 = struct
   open M1
@@ -8932,7 +9357,8 @@ module F2 = struct
   ;;
 end
 
-(* fails for -principal *)
+(* fails for -principal
+  *)
 
 (* Use type information with modules*)
 module M = struct
@@ -8942,13 +9368,16 @@ end
 
 let f (r : M.t) = r.M.x
 
-(* ok *)
+(* ok
+  *)
 let f (r : M.t) = r.x
 
-(* warning *)
+(* warning
+  *)
 let f ({ x } : M.t) = x
 
-(* warning *)
+(* warning
+  *)
 
 module M = struct
   type t =
@@ -8987,7 +9416,8 @@ module OK = struct
   let f (r : M.t) = r.x
 end
 
-(* Use field information *)
+(* Use field information
+  *)
 module M = struct
   type u =
     { x : bool
@@ -9007,14 +9437,16 @@ module OK = struct
   let f { x; z } = x, z
 end
 
-(* ok *)
+(* ok
+  *)
 module F3 = struct
   open M
 
   let r = { x = true; z = 'z' }
 end
 
-(* fail for missing label *)
+(* fail for missing label
+  *)
 
 module OK = struct
   type u =
@@ -9031,9 +9463,11 @@ module OK = struct
   let r = { x = 3; y = true }
 end
 
-(* ok *)
+(* ok
+  *)
 
-(* Corner cases *)
+(* Corner cases
+  *)
 
 module F4 = struct
   type foo =
@@ -9046,7 +9480,8 @@ module F4 = struct
   let b : bar = { x = 3; y = 4 }
 end
 
-(* fail but don't warn *)
+(* fail but don't warn
+  *)
 
 module M = struct
   type foo =
@@ -9064,7 +9499,8 @@ end
 
 let r = { M.x = 3; N.y = 4 }
 
-(* error: different definitions *)
+(* error: different definitions
+  *)
 
 module MN = struct
   include M
@@ -9078,9 +9514,11 @@ end
 
 let r = { MN.x = 3; NM.y = 4 }
 
-(* error: type would change with order *)
+(* error: type would change with order
+  *)
 
-(* Lpw25 *)
+(* Lpw25
+  *)
 
 module M = struct
   type foo =
@@ -9139,9 +9577,11 @@ end
 
 let f (r : B.t) = r.A.x
 
-(* fail *)
+(* fail
+  *)
 
-(* Spellchecking *)
+(* Spellchecking
+  *)
 
 module F8 = struct
   type t =
@@ -9152,7 +9592,8 @@ module F8 = struct
   let a : t = { x = 1; yyz = 2 }
 end
 
-(* PR#6004 *)
+(* PR#6004
+  *)
 
 type t = A
 type s = A
@@ -9160,14 +9601,17 @@ type s = A
 class f (_ : t) = object end
 class g = f A
 
-(* ok *)
+(* ok
+  *)
 
 class f (_ : 'a) (_ : 'a) = object end
 class g = f (A : t) A
 
-(* warn with -principal *)
+(* warn with -principal
+  *)
 
-(* PR#5980 *)
+(* PR#5980
+  *)
 
 module Shadow1 = struct
   type t = { x : int }
@@ -9176,7 +9620,8 @@ module Shadow1 = struct
     type s = { x : string }
   end
 
-  open M (* this open is unused, it isn't reported as shadowing 'x' *)
+  open M (* this open is unused, it isn't reported as shadowing 'x'
+           *)
 
   let y : t = { x = 0 }
 end
@@ -9188,12 +9633,14 @@ module Shadow2 = struct
     type s = { x : string }
   end
 
-  open M (* this open shadows label 'x' *)
+  open M (* this open shadows label 'x'
+           *)
 
   let y = { x = "" }
 end
 
-(* PR#6235 *)
+(* PR#6235
+  *)
 
 module P6235 = struct
   type t = { loc : string }
@@ -9211,7 +9658,8 @@ module P6235 = struct
   ;;
 end
 
-(* Remove interaction between branches *)
+(* Remove interaction between branches
+  *)
 
 module P6235' = struct
   type t = { loc : string }
@@ -9373,12 +9821,15 @@ let () = proj1 (inj2 42)
 let _ = ~-1
 
 class id = [%exp]
-(* checkpoint *)
+(* checkpoint
+  *)
 
-(* Subtyping is "syntactic" *)
+(* Subtyping is "syntactic"
+  *)
 let _ = fun (x : < x : int >) y z -> (y :> 'a), (x :> 'a), (z :> 'a)
 
-(* - : (< x : int > as 'a) -> 'a -> 'a * 'a = <fun> *)
+(* - : (< x : int > as 'a) -> 'a -> 'a * 'a = <fun>
+  *)
 
 class ['a] c () =
   object
@@ -9390,7 +9841,8 @@ and ['a] d () =
     inherit ['a] c ()
   end
 
-(* PR#7329 Pattern open *)
+(* PR#7329 Pattern open
+  *)
 let _ =
   let module M = struct
     type t = { x : int }
@@ -9431,7 +9883,8 @@ let g x = ~$(x.contents)
 let ( ~$ ) x y = x, y
 let g x y = ~$(x.contents) y.contents
 
-(* PR#7506: attributes on list tail *)
+(* PR#7506: attributes on list tail
+  *)
 
 let tail1 = [ 1; 2 ] [@hello]
 let tail2 = 0 :: ([ 1; 2 ] [@hello])
@@ -9466,11 +9919,13 @@ fun contents -> { contents = contents [@foo] };;
 (();
  ()) [@foo]
 
-(* https://github.com/LexiFi/gen_js_api/issues/61 *)
+(* https://github.com/LexiFi/gen_js_api/issues/61
+  *)
 
 let () = foo##.bar := ()
 
-(* "let open" in classes and class types *)
+(* "let open" in classes and class types
+  *)
 
 class c =
   let open M in
@@ -9484,7 +9939,8 @@ class type ct =
   method f : t
 end
 
-(* M.(::) notation *)
+(* M.(::) notation
+  *)
 module Exotic_list = struct
   module Inner = struct
     type ('a, 'b) t =
@@ -9588,8 +10044,8 @@ exception Second_exception
 
 module M = struct
   type t
-  [@@immediate] (* ______________________________________ *)
-  [@@deriving variants, sexp_of]
+  [@@immediate] (* ______________________________________
+                  *) [@@deriving variants, sexp_of]
 end
 
 module type Basic3 = sig
@@ -9620,7 +10076,8 @@ let _ =
   [ very_long_function_name____________________ very_long_argument_name____________ ]
 ;;
 
-(* FIX: exceed 90 columns *)
+(* FIX: exceed 90 columns
+  *)
 let _ =
   [%str
     let () = very_long_function_name__________________ very_long_argument_name____________]
@@ -9631,7 +10088,8 @@ let _ =
   }
 ;;
 
-(* FIX: exceed 90 columns *)
+(* FIX: exceed 90 columns
+  *)
 let _ =
   match () with
   | _ ->
@@ -9642,30 +10100,27 @@ let _ =
 
 let _ =
   aaaaaaa
-    (* __________________________________________________________________________________ *)
-    := bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
+    (* __________________________________________________________________________________
+      *) := bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
 ;;
 
-let g =
-  f
-    ~x
-      (* this is a multiple-line-spanning
-         comment *)
-    ~y
-;;
+let g = f ~x (* this is a multiple-line-spanning
+                comment
+               *) ~y
 
 let f =
   very_long_function_name
-    ~x:very_long_variable_name
-      (* this is a multiple-line-spanning
-         comment *)
+    ~x:very_long_variable_name (* this is a multiple-line-spanning
+                                  comment
+                                 *)
     ~y
 ;;
 
 let _ =
   match x with
   | { y =
-        (* _____________________________________________________________________ *)
+        (* _____________________________________________________________________
+          *)
         ( X _ | Y _ )
     } -> ()
 ;;
@@ -9674,7 +10129,8 @@ let _ =
   match x with
   | { y =
         ( Z
-        (* _____________________________________________________________________ *)
+        (* _____________________________________________________________________
+          *)
         | X _
         | Y _ )
     } -> ()
@@ -9682,25 +10138,34 @@ let _ =
 
 type t =
   [ `XXXX
-    (* __________________________________________________________________________________ *)
-  | `XXXX (* __________________________________________________________________ *)
-  | `XXXX (* _____________________________________________________ *)
-  | `XXXX (* ___________________________________________________ *)
-  | `XXXX (* ___________________________________________________ *)
-  | `XXXX (* ________________________________________________ *)
-  | `XXXX (* __________________________________________ *)
-  | `XXXX (* _________________________________________ *)
-  | `XXXX (* ______________________________________ *)
-  | `XXXX (* ____________________________________ *)
+    (* __________________________________________________________________________________
+      *)
+  | `XXXX (* __________________________________________________________________
+            *)
+  | `XXXX (* _____________________________________________________
+            *)
+  | `XXXX (* ___________________________________________________
+            *)
+  | `XXXX (* ___________________________________________________
+            *)
+  | `XXXX (* ________________________________________________
+            *)
+  | `XXXX (* __________________________________________
+            *)
+  | `XXXX (* _________________________________________
+            *)
+  | `XXXX (* ______________________________________
+            *)
+  | `XXXX (* ____________________________________
+            *)
   ]
 
 type t =
-  { field : ty
-      (* Here is some verbatim formatted text:
+  { field : ty (* Here is some verbatim formatted text:
 
-         {v
+                  {v
        starting at column 7
-         v}*)
+                  v}*)
   }
 
 module Intro_sort = struct
@@ -9717,7 +10182,8 @@ module Intro_sort = struct
           4-----o--------o--o--|-----o--4
                 |              |     |
           5-----o--------------o-----o--5
-       v} *)
+       v}
+      *)
     foooooooooo fooooo fooo;
     foooooooooo fooooo fooo;
     foooooooooo fooooo fooo
@@ -9737,7 +10203,8 @@ let nullsafe_optimistic_third_party_params_in_non_strict =
          there was no actionable way to change third party annotations. Now
          that we have such a support, this behavior should be reconsidered,
          provided our tooling and error reporting is friendly enough to be
-         smoothly used by developers. *)
+         smoothly used by developers.
+        *)
     ~default:true
     "Nullsafe: in this mode we treat non annotated third party method params as if they \
      were annotated as nullable."
@@ -9745,7 +10212,8 @@ let nullsafe_optimistic_third_party_params_in_non_strict =
 
 let foo () =
   if%bind
-    (* this is a medium length comment of some sort *)
+    (* this is a medium length comment of some sort
+      *)
     this is a medium length expression of_some sort
   then x
   else y
@@ -9753,31 +10221,35 @@ let foo () =
 
 let xxxxxx =
   let%map (* _____________________________
-             __________ *) () = yyyyyyyy in
+             __________
+            *) () = yyyyyyyy in
   { zzzzzzzzzzzzz }
 ;;
 
 let _ =
   match x with
   | _
-    when f
-           ~f:(function [@ocaml.warning
-                          (* ....................................... *) "-4"] _ -> .) -> y
+    when f ~f:(function [@ocaml.warning (* .......................................
+                                          *) "-4"] _ -> .) -> y
 ;;
 
 let[@a
-     (* .............................................. ........................... .......................... ...................... *)
+     (* .............................................. ........................... .......................... ......................
+       *)
      foo
      (* ....................... *)
      (* ................................. *)
      (* ...................... *)] _
   =
-  match[@ocaml.warning (* ....................................... *) "-4"]
-    x [@attr (* .......................... .................. *) some_attr]
+  match[@ocaml.warning (* .......................................
+                         *) "-4"]
+    x [@attr (* .......................... ..................
+               *) some_attr]
   with
   | _
     when f
-           ~f:(function[@ocaml.warning (* ....................................... *) "-4"]
+           ~f:(function[@ocaml.warning (* .......................................
+                                         *) "-4"]
              | _ -> .)
            ~f:(function[@ocaml.warning
                          (* ....................................... *)
@@ -9786,7 +10258,8 @@ let[@a
                           fooooooooooooooooooooooooooooooooooooo"]
              | _ -> .)
            ~f:(function[@ocaml.warning
-                         (* ....................................... *)
+                         (* .......................................
+                           *)
                          let x = a
                          and y = b in
                          x + y]
@@ -9794,7 +10267,8 @@ let[@a
     y [@attr
         (* ... *)
         (* ... *)
-        attr (* ... *)]
+        attr (* ...
+               *)]
 ;;
 
 let x =
@@ -10043,7 +10517,8 @@ let _ =
 ;;
 
 (*
-   *)
+     
+  *)
 
 (** xxx *)
 include S1
@@ -10075,7 +10550,10 @@ class x =
 
 let _ =
   match () with
-  (*$ Printf.(printf "\n  | _ -> .\n;;\n") *)
+  (*$
+    Printf.(
+      printf "\n  | _ -> .\n;;\n")
+  *)
   | _ -> .
 ;;
 
@@ -10090,7 +10568,8 @@ let _ =
 (*$*)
 
 (*$
-  [%string {| xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
+      [%string
+        {| xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
   zzzzzzzzzzzzzzzzzzzzzzzzzzzz
       |}]
 *)
@@ -10098,7 +10577,7 @@ let _ =
 
 (*$
   {|
-        f|}
+       f|}
 *)
 
 let () =
@@ -10110,7 +10589,8 @@ let () =
   | _ -> ()
 ;;
 
-(* ocp-indent-compat: Docked fun after apply only if on the same line. *)
+(* ocp-indent-compat: Docked fun after apply only if on the same line.
+  *)
 
 let _ =
   fooooooooooooooooooooooooooooooo
diff --git a/test/passing/tests/ocp_indent_compat.ml b/test/passing/tests/ocp_indent_compat.ml
index 578c10dfcf..0c1dfc75cf 100644
--- a/test/passing/tests/ocp_indent_compat.ml
+++ b/test/passing/tests/ocp_indent_compat.ml
@@ -2,7 +2,8 @@
 
 [@@@ocamlformat "break-colon=before"]
 
-(* Bad: unboxing the function type *)
+(* Bad: unboxing the function type
+  *)
 external i : (int -> float[@unboxed]) = "i" "i_nat"
 
 module type M = sig
@@ -15,12 +16,14 @@ module type M = sig
        * (string Location.loc * payload) list
 
   val transl_modtype_longident
-    (* from Typemod *)
+    (* from Typemod
+      *)
     : (Location.t -> Env.t -> Longident.t -> Path.t) ref
 
   val transl_modtype_longident
     (* foooooooooo fooooooooooooo foooooooooooo foooooooooooooo
-       foooooooooooooo foooooooooooo *)
+       foooooooooooooo foooooooooooo
+      *)
     : (Location.t -> Env.t -> Longident.t -> Path.t) ref
 
   val imported_sets_of_closures_table
@@ -37,15 +40,20 @@ module type M = sig
     -> 'a t
 
   val select
-    :  (* The fsevents context *)
+    :  (* The fsevents context
+         *)
        env
-    -> (* Additional file descriptor to select for reading *)
+    -> (* Additional file descriptor to select for reading
+         *)
        ?read_fdl:fd_select list
-    -> (* Additional file descriptor to select for writing *)
+    -> (* Additional file descriptor to select for writing
+         *)
        ?write_fdl:fd_select list
-    -> (* Timeout...like Unix.select *)
+    -> (* Timeout...like Unix.select
+         *)
        timeout:float
-    -> (* The callback for file system events *)
+    -> (* The callback for file system events
+         *)
        (event list -> unit)
     -> unit
 
diff --git a/test/passing/tests/ocp_indent_compat.ml.err b/test/passing/tests/ocp_indent_compat.ml.err
index 6faa1c0e72..928e600a46 100644
--- a/test/passing/tests/ocp_indent_compat.ml.err
+++ b/test/passing/tests/ocp_indent_compat.ml.err
@@ -1 +1 @@
-Warning: tests/ocp_indent_compat.ml:138 exceeds the margin
+Warning: tests/ocp_indent_compat.ml:146 exceeds the margin
diff --git a/test/passing/tests/polytypes-janestreet.ml.ref b/test/passing/tests/polytypes-janestreet.ml.ref
index 0787402439..a4c20ad5a6 100644
--- a/test/passing/tests/polytypes-janestreet.ml.ref
+++ b/test/passing/tests/polytypes-janestreet.ml.ref
@@ -26,7 +26,8 @@ let t4 :
 ;;
 
 let foo : type a. a =
-  (* aaaaaa *)
+  (* aaaaaa
+    *)
   failwith "foo"
 ;;
 

From 2095965845bedc71f0ce28461977e6d7be7a2097 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Thu, 1 Jun 2023 18:37:36 +0200
Subject: [PATCH 076/115] Revert "Test 'error4' requires one more iteration"

This reverts commit f5cce1a860bf7877f76a2c0f765997bf0316be47.

No longer the case.
---
 test/passing/dune.inc             | 2 +-
 test/passing/tests/error4.ml.opts | 1 -
 2 files changed, 1 insertion(+), 2 deletions(-)

diff --git a/test/passing/dune.inc b/test/passing/dune.inc
index 351bab72fd..4e73f8a0b4 100644
--- a/test/passing/dune.inc
+++ b/test/passing/dune.inc
@@ -1721,7 +1721,7 @@
  (action
   (with-stdout-to error4.ml.stdout
    (with-stderr-to error4.ml.stderr
-     (run %{bin:ocamlformat} --margin-check --no-comment-check --max-iter=3 %{dep:tests/error4.ml})))))
+     (run %{bin:ocamlformat} --margin-check --no-comment-check %{dep:tests/error4.ml})))))
 
 (rule
  (alias runtest)
diff --git a/test/passing/tests/error4.ml.opts b/test/passing/tests/error4.ml.opts
index 1caaafca6a..f53883279a 100644
--- a/test/passing/tests/error4.ml.opts
+++ b/test/passing/tests/error4.ml.opts
@@ -1,2 +1 @@
 --no-comment-check
---max-iter=3

From 606447a8acb33a3b3caa2cead54d2861fa779fac Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Thu, 1 Jun 2023 18:54:56 +0200
Subject: [PATCH 077/115] Trim trailing empty lines and whitespaces

---
 lib/Cmt.ml                                         | 14 +++++++++-----
 test/passing/tests/infix_bind-break.ml.ref         | 14 +++++++-------
 .../tests/infix_bind-fit_or_vertical-break.ml.ref  | 14 +++++++-------
 .../tests/infix_bind-fit_or_vertical.ml.ref        | 14 +++++++-------
 test/passing/tests/infix_bind.ml                   | 14 +++++++-------
 test/passing/tests/js_source.ml.ocp                |  4 +---
 test/passing/tests/js_source.ml.ref                |  4 +---
 7 files changed, 39 insertions(+), 39 deletions(-)

diff --git a/lib/Cmt.ml b/lib/Cmt.ml
index 423c5e605c..213a1543b4 100644
--- a/lib/Cmt.ml
+++ b/lib/Cmt.ml
@@ -132,6 +132,10 @@ let split_asterisk_prefixed lines =
 
 let mk ?(prefix = "") ?(suffix = "") kind = {prefix; suffix; kind}
 
+let is_all_whitespace s =
+  Option.is_none
+  @@ String.lfindi s ~f:(fun _ c -> not (Char.is_whitespace c))
+
 let decode ~parse_comments_as_doc {txt; loc} =
   let txt =
     (* Windows compatibility *)
@@ -159,21 +163,21 @@ let decode ~parse_comments_as_doc {txt; loc} =
         mk ~prefix:"$" ~suffix (Code lines)
     | '=' -> mk (Verbatim txt)
     | '*' -> mk ~prefix:"*" (Doc (String.drop_prefix txt 1))
+    | _ when is_all_whitespace txt ->
+        mk (Verbatim " ") (* Make sure not to format to [(**)]. *)
     | _ when parse_comments_as_doc -> mk (Doc txt)
     | _ -> (
         let prefix = if String.starts_with_whitespace txt then " " else ""
         and suffix = if String.ends_with_whitespace txt then " " else "" in
+        let txt = String.rstrip txt in
         let lines = unindent_lines ~opn_offset txt in
         match split_asterisk_prefixed lines with
         | Some deprefixed_lines -> mk (Asterisk_prefixed deprefixed_lines)
         | None ->
             (* Reconstruct the text with indentation removed and heading and
                trailing empty lines removed. *)
-            let txt = String.strip (String.concat ~sep:"\n" lines) in
-            let cmt =
-              if String.is_empty txt then Verbatim "" else Normal txt
-            in
-            mk ~prefix ~suffix cmt )
+            let txt = String.lstrip (String.concat ~sep:"\n" lines) in
+            mk ~prefix ~suffix (Normal txt) )
   else
     match txt with
     (* "(**)" is not parsed as a docstring but as a regular comment
diff --git a/test/passing/tests/infix_bind-break.ml.ref b/test/passing/tests/infix_bind-break.ml.ref
index 119d008311..726a203d6f 100644
--- a/test/passing/tests/infix_bind-break.ml.ref
+++ b/test/passing/tests/infix_bind-break.ml.ref
@@ -171,19 +171,19 @@ let _ =
   >>= fun (* foo before *) [@warning "-4"] (* foo after *) x ->
   fooooooooooooooooooooooo
 
-let f = Ok () >>= (*  *) fun _ -> Ok ()
+let f = Ok () >>= (* *) fun _ -> Ok ()
 
 let f =
   (* fooooooooooooooo foooooooooooooooo *)
   Ok ()
-  >>= (*  *) fun _ -> Ok foooooooooooooooooooooooooooooooooooooooooooooooooo
+  >>= (* *) fun _ -> Ok foooooooooooooooooooooooooooooooooooooooooooooooooo
 
-let f = Ok () >>= (*  *) function Foo -> Ok ()
+let f = Ok () >>= (* *) function Foo -> Ok ()
 
 let f =
   (* fooooooooooooooo foooooooooooooooo *)
   Ok ()
-  >>= (*  *)
+  >>= (* *)
   function Foo -> Ok foooooooooooooooooooooooooooooooooooooooooooooooooo
 
 let f =
@@ -200,11 +200,11 @@ let f =
 (** The tests below are testing a dropped comment with
     `--no-break-infix-before-func` *)
 
-let _ = x |> fun y -> y (*  *)
+let _ = x |> fun y -> y (* *)
 
-let _ = x |> function y -> y (*  *)
+let _ = x |> function y -> y (* *)
 
-let _ = match () with A -> ( x |> function y -> y (*  *) ) | B -> ()
+let _ = match () with A -> ( x |> function y -> y (* *) ) | B -> ()
 
 let _ = x |> function y -> ( function _ -> y (* A *) ) (* B *)
 
diff --git a/test/passing/tests/infix_bind-fit_or_vertical-break.ml.ref b/test/passing/tests/infix_bind-fit_or_vertical-break.ml.ref
index 2e264d0ba0..42fba2f9b6 100644
--- a/test/passing/tests/infix_bind-fit_or_vertical-break.ml.ref
+++ b/test/passing/tests/infix_bind-fit_or_vertical-break.ml.ref
@@ -176,19 +176,19 @@ let _ =
   >>= fun (* foo before *) [@warning "-4"] (* foo after *) x ->
   fooooooooooooooooooooooo
 
-let f = Ok () >>= (*  *) fun _ -> Ok ()
+let f = Ok () >>= (* *) fun _ -> Ok ()
 
 let f =
   (* fooooooooooooooo foooooooooooooooo *)
   Ok ()
-  >>= (*  *) fun _ -> Ok foooooooooooooooooooooooooooooooooooooooooooooooooo
+  >>= (* *) fun _ -> Ok foooooooooooooooooooooooooooooooooooooooooooooooooo
 
-let f = Ok () >>= (*  *) function Foo -> Ok ()
+let f = Ok () >>= (* *) function Foo -> Ok ()
 
 let f =
   (* fooooooooooooooo foooooooooooooooo *)
   Ok ()
-  >>= (*  *)
+  >>= (* *)
   function Foo -> Ok foooooooooooooooooooooooooooooooooooooooooooooooooo
 
 let f =
@@ -205,11 +205,11 @@ let f =
 (** The tests below are testing a dropped comment with
     `--no-break-infix-before-func` *)
 
-let _ = x |> fun y -> y (*  *)
+let _ = x |> fun y -> y (* *)
 
-let _ = x |> function y -> y (*  *)
+let _ = x |> function y -> y (* *)
 
-let _ = match () with A -> ( x |> function y -> y (*  *) ) | B -> ()
+let _ = match () with A -> ( x |> function y -> y (* *) ) | B -> ()
 
 let _ = x |> function y -> ( function _ -> y (* A *) ) (* B *)
 
diff --git a/test/passing/tests/infix_bind-fit_or_vertical.ml.ref b/test/passing/tests/infix_bind-fit_or_vertical.ml.ref
index 3f170256e3..d87402e3f0 100644
--- a/test/passing/tests/infix_bind-fit_or_vertical.ml.ref
+++ b/test/passing/tests/infix_bind-fit_or_vertical.ml.ref
@@ -170,18 +170,18 @@ let _ =
   foo >>= fun (* foo before *) [@warning "-4"] (* foo after *) x ->
   fooooooooooooooooooooooo
 
-let f = Ok () >>= (*  *) fun _ -> Ok ()
+let f = Ok () >>= (* *) fun _ -> Ok ()
 
 let f =
   (* fooooooooooooooo foooooooooooooooo *)
-  Ok () >>= (*  *) fun _ ->
+  Ok () >>= (* *) fun _ ->
   Ok foooooooooooooooooooooooooooooooooooooooooooooooooo
 
-let f = Ok () >>= (*  *) function Foo -> Ok ()
+let f = Ok () >>= (* *) function Foo -> Ok ()
 
 let f =
   (* fooooooooooooooo foooooooooooooooo *)
-  Ok () >>= (*  *) function
+  Ok () >>= (* *) function
   | Foo -> Ok foooooooooooooooooooooooooooooooooooooooooooooooooo
 
 let f =
@@ -201,11 +201,11 @@ let f =
 (** The tests below are testing a dropped comment with
     `--no-break-infix-before-func` *)
 
-let _ = x |> fun y -> y (*  *)
+let _ = x |> fun y -> y (* *)
 
-let _ = x |> function y -> y (*  *)
+let _ = x |> function y -> y (* *)
 
-let _ = match () with A -> ( x |> function y -> y (*  *) ) | B -> ()
+let _ = match () with A -> ( x |> function y -> y (* *) ) | B -> ()
 
 let _ = x |> function y -> ( function _ -> y (* A *) ) (* B *)
 
diff --git a/test/passing/tests/infix_bind.ml b/test/passing/tests/infix_bind.ml
index 8295f2540f..c51734bcb9 100644
--- a/test/passing/tests/infix_bind.ml
+++ b/test/passing/tests/infix_bind.ml
@@ -165,18 +165,18 @@ let _ =
   foo >>= fun (* foo before *) [@warning "-4"] (* foo after *) x ->
   fooooooooooooooooooooooo
 
-let f = Ok () >>= (*  *) fun _ -> Ok ()
+let f = Ok () >>= (* *) fun _ -> Ok ()
 
 let f =
   (* fooooooooooooooo foooooooooooooooo *)
-  Ok () >>= (*  *) fun _ ->
+  Ok () >>= (* *) fun _ ->
   Ok foooooooooooooooooooooooooooooooooooooooooooooooooo
 
-let f = Ok () >>= (*  *) function Foo -> Ok ()
+let f = Ok () >>= (* *) function Foo -> Ok ()
 
 let f =
   (* fooooooooooooooo foooooooooooooooo *)
-  Ok () >>= (*  *) function
+  Ok () >>= (* *) function
   | Foo -> Ok foooooooooooooooooooooooooooooooooooooooooooooooooo
 
 let f =
@@ -196,11 +196,11 @@ let f =
 (** The tests below are testing a dropped comment with
     `--no-break-infix-before-func` *)
 
-let _ = x |> fun y -> y (*  *)
+let _ = x |> fun y -> y (* *)
 
-let _ = x |> function y -> y (*  *)
+let _ = x |> function y -> y (* *)
 
-let _ = match () with A -> ( x |> function y -> y (*  *) ) | B -> ()
+let _ = match () with A -> ( x |> function y -> y (* *) ) | B -> ()
 
 let _ = x |> function y -> ( function _ -> y (* A *) ) (* B *)
 
diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp
index 2f1758a61d..bfc9918a5e 100644
--- a/test/passing/tests/js_source.ml.ocp
+++ b/test/passing/tests/js_source.ml.ocp
@@ -10516,9 +10516,7 @@ let _ =
   | _ -> false
 ;;
 
-(*
-
-*)
+(* *)
 
 (** xxx *)
 include S1
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index a86b5a0857..54d9777095 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -10516,9 +10516,7 @@ let _ =
   | _ -> false
 ;;
 
-(*
-     
-  *)
+(* *)
 
 (** xxx *)
 include S1

From 457201401c6e438f59509bfe129ca88b80719e44 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Fri, 2 Jun 2023 15:45:25 +0200
Subject: [PATCH 078/115] Preserve empty trailing lines in doc comments

---
 lib/Cmts.ml                                   |   18 +-
 test/passing/tests/error4.ml.ref              |    3 +-
 test/passing/tests/js_source.ml.err           |   12 +-
 test/passing/tests/js_source.ml.ocp           | 1502 ++++++-----------
 test/passing/tests/js_source.ml.ref           | 1502 ++++++-----------
 .../passing/tests/polytypes-janestreet.ml.ref |    3 +-
 6 files changed, 1026 insertions(+), 2014 deletions(-)

diff --git a/lib/Cmts.ml b/lib/Cmts.ml
index fd42608c38..98641af208 100644
--- a/lib/Cmts.ml
+++ b/lib/Cmts.ml
@@ -460,6 +460,8 @@ let break_comment_group source margin {Cmt.loc= a; _} {Cmt.loc= b; _} =
     ( (Location.is_single_line a margin && Location.is_single_line b margin)
     && (vertical_align || horizontal_align) )
 
+let is_only_whitespaces s = String.for_all s ~f:Char.is_whitespace
+
 module Wrapped = struct
   let fmt text =
     let open Fmt in
@@ -483,7 +485,7 @@ module Wrapped = struct
               fmt_line curr
               $
               match next with
-              | Some str when String.for_all str ~f:Char.is_whitespace ->
+              | Some str when is_only_whitespaces str ->
                   close_box $ fmt "\n@," $ open_hovbox 0
               | Some _ when not (String.is_empty curr) -> fmt "@ "
               | _ -> noop ) ) )
@@ -502,10 +504,11 @@ end
 module Unwrapped = struct
   let fmt_multiline_cmt lines =
     let open Fmt in
-    let is_white_line s = String.for_all s ~f:Char.is_whitespace in
     let fmt_line ~first ~last:_ s =
       let s = String.rstrip s in
-      let sep = if is_white_line s then str "\n" else fmt "@;<1000 0>" in
+      let sep =
+        if is_only_whitespaces s then str "\n" else fmt "@;<1000 0>"
+      in
       fmt_if_k (not first) sep $ str s
     in
     vbox 0 ~name:"unwrapped" (list_fl lines fmt_line)
@@ -541,13 +544,14 @@ end
 module Doc = struct
   let fmt ~fmt_code conf ~loc txt ~offset =
     (* Whether the doc starts and ends with an empty line. *)
-    let pre_nl =
+    let pre_nl, trail_nl =
       let lines = String.split_lines txt in
       match lines with
-      | [] | [_] -> false
-      | h :: _ -> String.is_empty (String.strip h)
+      | [] | [_] -> (false, false)
+      | h :: _ ->
+          let l = List.last_exn lines in
+          (is_only_whitespaces h, is_only_whitespaces l)
     in
-    let trail_nl = String.ends_with_whitespace txt in
     let doc = if pre_nl then String.lstrip txt else txt in
     let doc = if trail_nl then String.rstrip doc else doc in
     let parsed = Docstring.parse ~loc doc in
diff --git a/test/passing/tests/error4.ml.ref b/test/passing/tests/error4.ml.ref
index a3f31480e2..694725ec0a 100644
--- a/test/passing/tests/error4.ml.ref
+++ b/test/passing/tests/error4.ml.ref
@@ -2,5 +2,4 @@
 let a = ()
 
 (** a or b *)
-let b = (** ?
-          *) ()
+let b = (** ? *) ()
diff --git a/test/passing/tests/js_source.ml.err b/test/passing/tests/js_source.ml.err
index 476feacb17..6f3ab21084 100644
--- a/test/passing/tests/js_source.ml.err
+++ b/test/passing/tests/js_source.ml.err
@@ -1,5 +1,7 @@
-Warning: tests/js_source.ml:162 exceeds the margin
-Warning: tests/js_source.ml:3741 exceeds the margin
-Warning: tests/js_source.ml:9978 exceeds the margin
-Warning: tests/js_source.ml:10082 exceeds the margin
-Warning: tests/js_source.ml:10236 exceeds the margin
+Warning: tests/js_source.ml:155 exceeds the margin
+Warning: tests/js_source.ml:3553 exceeds the margin
+Warning: tests/js_source.ml:9508 exceeds the margin
+Warning: tests/js_source.ml:9611 exceeds the margin
+Warning: tests/js_source.ml:9630 exceeds the margin
+Warning: tests/js_source.ml:9664 exceeds the margin
+Warning: tests/js_source.ml:9747 exceeds the margin
diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp
index bfc9918a5e..4246151f4f 100644
--- a/test/passing/tests/js_source.ml.ocp
+++ b/test/passing/tests/js_source.ml.ocp
@@ -77,8 +77,7 @@ and _ = ()
 
 let%foo _ = ()
 
-(* Expressions
-*)
+(* Expressions *)
 let () =
   let%foo[@foo] x = 3
   and[@foo] y = 4 in
@@ -114,14 +113,12 @@ let () =
   [%foo new x [@foo]];
   [%foo
     match[@foo] () with
-    | [%foo? (* Pattern expressions
-             *)
+    | [%foo? (* Pattern expressions *)
              ((lazy x) [@foo])] -> ()
     | [%foo? ((exception x) [@foo])] -> ()]
 ;;
 
-(* Class expressions
-*)
+(* Class expressions *)
 class x =
   fun [@foo] x ->
   let[@foo] x = 3 in
@@ -136,8 +133,7 @@ class x =
     initializer x [@@foo]
   end [@foo]
 
-(* Class type expressions
-*)
+(* Class type expressions *)
 class type t = object
   inherit t [@@foo]
   val x : t [@@foo]
@@ -150,16 +146,13 @@ class type t = object
   [@@@aaa]
 end[@foo]
 
-(* Type expressions
-*)
+(* Type expressions *)
 type t = [%foo: ((module M)[@foo])]
 
-(* Module expressions
-*)
+(* Module expressions *)
 module M = (functor [@foo] (M : S) -> (val x) [@foo] (struct end [@foo]))
 
-(* Module type expression
-*)
+(* Module type expression *)
 module type S = functor [@foo] (M : S) -> functor (_ : (module type of M) [@foo]) -> sig end
                                                                                      [@foo]
 
@@ -175,8 +168,7 @@ module type S = sig
   and B : (S with type t = t)
 end
 
-(* Structure items
-*)
+(* Structure items *)
 let%foo[@foo] x = 4
 and[@foo] y = x
 
@@ -197,8 +189,7 @@ module type%foo S = S [@@foo]
 include%foo M [@@foo]
 open%foo M [@@foo]
 
-(* Signature items
-*)
+(* Signature items *)
 module type S = sig
   val%foo x : t [@@foo]
   external%foo x : t = "" [@@foo]
@@ -235,8 +226,7 @@ open M;;
 
 ([%extension_constructor A] : extension_constructor)
 
-(* By using two types we can have a recursive constraint
-*)
+(* By using two types we can have a recursive constraint *)
 type 'a class_name = .. constraint 'a = < cast : 'a. 'a name -> 'a ; .. >
 and 'a name = Class : 'a class_name -> (< cast : 'a. 'a name -> 'a ; .. > as 'a) name
 
@@ -265,8 +255,7 @@ class foo : foo_t =
     method foo = "foo"
   end
 
-(* Now we can create a subclass of foo
-*)
+(* Now we can create a subclass of foo *)
 
 class type bar_t = object
   inherit foo
@@ -289,8 +278,7 @@ class bar : bar_t =
     [%%id]
   end
 
-(* Now lets create a mutable list of castable objects
-*)
+(* Now lets create a mutable list of castable objects *)
 
 let clist : castable list ref = ref []
 let push_castable (c : #castable) = clist := (c :> castable) :: !clist
@@ -303,8 +291,7 @@ let pop_castable () =
   | [] -> raise Not_found
 ;;
 
-(* We can add foos and bars to this list, and retrive them
-*)
+(* We can add foos and bars to this list, and retrive them *)
 
 push_castable (new foo);;
 push_castable (new bar);;
@@ -314,34 +301,27 @@ let c1 : castable = pop_castable ()
 let c2 : castable = pop_castable ()
 let c3 : castable = pop_castable ()
 
-(* We can also downcast these values to foos and bars
-*)
+(* We can also downcast these values to foos and bars *)
 
 let f1 : foo = c1#cast (Class Foo)
 
-(* Ok
-*)
+(* Ok *)
 let f2 : foo = c2#cast (Class Foo)
 
-(* Ok
-*)
+(* Ok *)
 let f3 : foo = c3#cast (Class Foo)
 
-(* Ok
-*)
+(* Ok *)
 
 let b1 : bar = c1#cast (Class Bar)
 
-(* Exception Bad_cast
-*)
+(* Exception Bad_cast *)
 let b2 : bar = c2#cast (Class Bar)
 
-(* Ok
-*)
+(* Ok *)
 let b3 : bar = c3#cast (Class Bar)
 
-(* Exception Bad_cast
-*)
+(* Exception Bad_cast *)
 
 type foo = ..
 type foo += A | B of int
@@ -352,39 +332,31 @@ let is_a x =
   | _ -> false
 ;;
 
-(* The type must be open to create extension
-*)
+(* The type must be open to create extension *)
 
 type foo
-type foo += A of int (* Error type is not open
-                     *)
+type foo += A of int (* Error type is not open *)
 
-(* The type parameters must match
-*)
+(* The type parameters must match *)
 
 type 'a foo = ..
-type ('a, 'b) foo += A of int (* Error: type parameter mismatch
-                              *)
+type ('a, 'b) foo += A of int (* Error: type parameter mismatch *)
 
-(* In a signature the type does not have to be open
-*)
+(* In a signature the type does not have to be open *)
 
 module type S = sig
   type foo
   type foo += A of float
 end
 
-(* But it must still be extensible
-*)
+(* But it must still be extensible *)
 
 module type S = sig
   type foo = A of int
-  type foo += B of float (* Error foo does not have an extensible type
-                         *)
+  type foo += B of float (* Error foo does not have an extensible type *)
 end
 
-(* Signatures can change the grouping of extensions
-*)
+(* Signatures can change the grouping of extensions *)
 
 type foo = ..
 
@@ -401,8 +373,7 @@ end
 
 module M_S : S = M
 
-(* Extensions can be GADTs
-*)
+(* Extensions can be GADTs *)
 
 type 'a foo = ..
 type _ foo += A : int -> int foo | B : int foo
@@ -414,20 +385,16 @@ let get_num : type a. a foo -> a -> a option =
   | _ -> None
 ;;
 
-(* Extensions must obey constraints
-*)
+(* Extensions must obey constraints *)
 
 type 'a foo = .. constraint 'a = [> `Var ]
 type 'a foo += A of 'a
 
-let a = A 9 (* ERROR: Constraints not met
-            *)
+let a = A 9 (* ERROR: Constraints not met *)
 
-type 'a foo += B : int foo (* ERROR: Constraints not met
-                           *)
+type 'a foo += B : int foo (* ERROR: Constraints not met *)
 
-(* Signatures can make an extension private
-*)
+(* Signatures can make an extension private *)
 
 type foo = ..
 
@@ -449,11 +416,9 @@ let is_s x =
   | _ -> false
 ;;
 
-let a2 = M_S.A 20 (* ERROR: Cannot create a value using a private constructor
-                  *)
+let a2 = M_S.A 20 (* ERROR: Cannot create a value using a private constructor *)
 
-(* Extensions can be rebound
-*)
+(* Extensions can be rebound *)
 
 type foo = ..
 
@@ -463,21 +428,17 @@ end
 
 type foo += A2 = M.A1
 type bar = ..
-type bar += A3 = M.A1 (* Error: rebind wrong type
-                      *)
+type bar += A3 = M.A1 (* Error: rebind wrong type *)
 
 module M = struct
   type foo += private B1 of int
 end
 
 type foo += private B2 = M.B1
-type foo += B3 = M.B1 (* Error: rebind private extension
-                      *)
-type foo += C = Unknown (* Error: unbound extension
-                        *)
+type foo += B3 = M.B1 (* Error: rebind private extension *)
+type foo += C = Unknown (* Error: unbound extension *)
 
-(* Extensions can be rebound even if type is closed
-*)
+(* Extensions can be rebound even if type is closed *)
 
 module M : sig
   type foo
@@ -489,8 +450,7 @@ end
 
 type M.foo += A2 = M.A1
 
-(* Rebinding handles abbreviations
-*)
+(* Rebinding handles abbreviations *)
 
 type 'a foo = ..
 type 'a foo1 = 'a foo = ..
@@ -498,25 +458,20 @@ type 'a foo2 = 'a foo = ..
 type 'a foo1 += A of int | B of 'a | C : int foo1
 type 'a foo2 += D = A | E = B | F = C
 
-(* Extensions must obey variances
-*)
+(* Extensions must obey variances *)
 
 type +'a foo = ..
 type 'a foo += A of (int -> 'a)
 type 'a foo += B of ('a -> int)
-(* ERROR: Parameter variances are not satisfied
-*)
+(* ERROR: Parameter variances are not satisfied *)
 
 type _ foo += C : ('a -> int) -> 'a foo
-(* ERROR: Parameter variances are not satisfied
-*)
+(* ERROR: Parameter variances are not satisfied *)
 
 type 'a bar = ..
-type +'a bar += D of (int -> 'a) (* ERROR: type variances do not match
-                                 *)
+type +'a bar += D of (int -> 'a) (* ERROR: type variances do not match *)
 
-(* Exceptions are compatible with extensions
-*)
+(* Exceptions are compatible with extensions *)
 
 module M : sig
   type exn += Foo of int * float | Bar : 'a list -> exn
@@ -542,33 +497,27 @@ end = struct
   exception Foo = Foo
 end
 
-(* Test toplevel printing
-*)
+(* Test toplevel printing *)
 
 type foo = ..
 type foo += Foo of int * int option | Bar of int option
 
-let x = Foo (3, Some 4), Bar (Some 5) (* Prints Foo and Bar successfully
-                                      *)
+let x = Foo (3, Some 4), Bar (Some 5) (* Prints Foo and Bar successfully *)
 
 type foo += Foo of string
 
-let y = x (* Prints Bar but not Foo (which has been shadowed)
-          *)
+let y = x (* Prints Bar but not Foo (which has been shadowed) *)
 
 exception Foo of int * int option
 exception Bar of int option
 
-let x = Foo (3, Some 4), Bar (Some 5) (* Prints Foo and Bar successfully
-                                      *)
+let x = Foo (3, Some 4), Bar (Some 5) (* Prints Foo and Bar successfully *)
 
 type foo += Foo of string
 
-let y = x (* Prints Bar and part of Foo (which has been shadowed)
-          *)
+let y = x (* Prints Bar and part of Foo (which has been shadowed) *)
 
-(* Test Obj functions
-*)
+(* Test Obj functions *)
 
 type foo = ..
 type foo += Foo | Bar of int
@@ -577,17 +526,14 @@ let extension_name e = Obj.extension_name (Obj.extension_constructor e)
 let extension_id e = Obj.extension_id (Obj.extension_constructor e)
 let n1 = extension_name Foo
 let n2 = extension_name (Bar 1)
-let t = extension_id (Bar 2) = extension_id (Bar 3) (* true
-                                                    *)
-let f = extension_id (Bar 2) = extension_id Foo (* false
-                                                *)
+let t = extension_id (Bar 2) = extension_id (Bar 3) (* true *)
+let f = extension_id (Bar 2) = extension_id Foo (* false *)
 let is_foo x = extension_id Foo = extension_id x
 
 type foo += Foo
 
 let f = is_foo Foo
-let _ = Obj.extension_constructor 7 (* Invald_arg
-                                    *)
+let _ = Obj.extension_constructor 7 (* Invald_arg *)
 
 let _ =
   Obj.extension_constructor
@@ -596,11 +542,9 @@ let _ =
     end)
 ;;
 
-(* Invald_arg
-*)
+(* Invald_arg *)
 
-(* Typed names
-*)
+(* Typed names *)
 
 module Msg : sig
   type 'a tag
@@ -658,8 +602,7 @@ end = struct
     write_raw k.label content
   ;;
 
-  (* Add int kind
-  *)
+  (* Add int kind *)
 
   type 'a tag += Int : int tag
 
@@ -675,8 +618,7 @@ end = struct
     Hashtbl.add writeTbl (T Int) { f }
   ;;
 
-  (* Support user defined kinds
-  *)
+  (* Support user defined kinds *)
 
   module type Desc = sig
     type t
@@ -725,8 +667,7 @@ let read_one () =
   | _ -> print_string "Unknown"
 ;;
 
-(* Example of algorithm parametrized with modules
-*)
+(* Example of algorithm parametrized with modules *)
 
 let sort (type s) set l =
   let module Set = (val set : Set.S with type elt = s) in
@@ -753,8 +694,7 @@ let () =
     (String.concat "  " (List.map (String.concat "/") (both [ "abc"; "xyz"; "def" ])))
 ;;
 
-(* Hiding the internal representation
-*)
+(* Hiding the internal representation *)
 
 module type S = sig
   type t
@@ -803,8 +743,7 @@ let () =
   List.iter print (List.map apply [ int; apply int; apply (apply str) ])
 ;;
 
-(* Existential types + type equality witnesses -> pseudo GADT
-*)
+(* Existential types + type equality witnesses -> pseudo GADT *)
 
 module TypEq : sig
   type ('a, 'b) t
@@ -891,8 +830,7 @@ let () =
   print_endline (Print.to_string (pair int (pair str int)) (123, ("A", 456)))
 ;;
 
-(* #6262: first-class modules and module type aliases
-*)
+(* #6262: first-class modules and module type aliases *)
 
 module type S1 = sig end
 module type S2 = S1
@@ -909,8 +847,7 @@ end
 
 let _f (x : (module X.S)) : (module Y.S) = x
 
-(* PR#6194, main example
-*)
+(* PR#6194, main example *)
 module type S3 = sig
   val x : bool
 end
@@ -938,8 +875,7 @@ let fbool (type t) (x : t) (tag : t ty) =
   | Bool -> x
 ;;
 
-(* val fbool : 'a -> 'a ty -> 'a = <fun>
-*)
+(* val fbool : 'a -> 'a ty -> 'a = <fun> *)
 
 (** OK: the return value is x of type t **)
 
@@ -948,8 +884,7 @@ let fint (type t) (x : t) (tag : t ty) =
   | Int -> x > 0
 ;;
 
-(* val fint : 'a -> 'a ty -> bool = <fun>
-*)
+(* val fint : 'a -> 'a ty -> bool = <fun> *)
 
 (** OK: the return value is x > 0 of type bool;
     This has used the equation t = bool, not visible in the return type **)
@@ -960,8 +895,7 @@ let f (type t) (x : t) (tag : t ty) =
   | Bool -> x
 ;;
 
-(* val f : 'a -> 'a ty -> bool = <fun>
-*)
+(* val f : 'a -> 'a ty -> bool = <fun> *)
 
 let g (type t) (x : t) (tag : t ty) =
   match tag with
@@ -970,8 +904,7 @@ let g (type t) (x : t) (tag : t ty) =
 ;;
 
 (* Error: This expression has type bool but an expression was expected of type
-   t = int
-*)
+   t = int *)
 
 let id x = x
 
@@ -1001,8 +934,7 @@ let g (type t) (x : t) (tag : t ty) =
 (* (c) Alain Frisch / Lexifi *)
 (* cf. http://www.lexifi.com/blog/dynamic-types *)
 
-(* Basic tag
-*)
+(* Basic tag *)
 
 type 'a ty =
   | Int : int ty
@@ -1010,8 +942,7 @@ type 'a ty =
   | List : 'a ty -> 'a list ty
   | Pair : ('a ty * 'b ty) -> ('a * 'b) ty
 
-(* Tagging data
-*)
+(* Tagging data *)
 
 type variant =
   | VInt of int
@@ -1021,20 +952,15 @@ type variant =
 
 let rec variantize : type t. t ty -> t -> variant =
   fun ty x ->
-  (* type t is abstract here
-  *)
+  (* type t is abstract here *)
   match ty with
-  | Int -> VInt x (* in this branch: t = int
-                  *)
-  | String -> VString x (* t = string
-                        *)
-  | List ty1 -> VList (List.map (variantize ty1) x) (* t = 'a list for some 'a
-                                                    *)
+  | Int -> VInt x (* in this branch: t = int *)
+  | String -> VString x (* t = string *)
+  | List ty1 -> VList (List.map (variantize ty1) x) (* t = 'a list for some 'a *)
   | Pair (ty1, ty2) -> VPair (variantize ty1 (fst x), variantize ty2 (snd x))
 ;;
 
-(* t = ('a, 'b) for some 'a and 'b
-*)
+(* t = ('a, 'b) for some 'a and 'b *)
 
 exception VariantMismatch
 
@@ -1048,8 +974,7 @@ let rec devariantize : type t. t ty -> variant -> t =
   | _ -> raise VariantMismatch
 ;;
 
-(* Handling records
-*)
+(* Handling records *)
 
 type 'a ty =
   | Int : int ty
@@ -1071,8 +996,7 @@ and ('a, 'b) field =
   ; get : 'a -> 'b
   }
 
-(* Again
-*)
+(* Again *)
 
 type variant =
   | VInt of int
@@ -1083,19 +1007,14 @@ type variant =
 
 let rec variantize : type t. t ty -> t -> variant =
   fun ty x ->
-  (* type t is abstract here
-  *)
+  (* type t is abstract here *)
   match ty with
-  | Int -> VInt x (* in this branch: t = int
-                  *)
-  | String -> VString x (* t = string
-                        *)
-  | List ty1 -> VList (List.map (variantize ty1) x) (* t = 'a list for some 'a
-                                                    *)
+  | Int -> VInt x (* in this branch: t = int *)
+  | String -> VString x (* t = string *)
+  | List ty1 -> VList (List.map (variantize ty1) x) (* t = 'a list for some 'a *)
   | Pair (ty1, ty2) ->
     VPair (variantize ty1 (fst x), variantize ty2 (snd x))
-  (* t = ('a, 'b) for some 'a and 'b
-  *)
+  (* t = ('a, 'b) for some 'a and 'b *)
   | Record { fields } ->
     VRecord
       (List.map
@@ -1103,8 +1022,7 @@ let rec variantize : type t. t ty -> t -> variant =
          fields)
 ;;
 
-(* Extraction
-*)
+(* Extraction *)
 
 type 'a ty =
   | Int : int ty
@@ -1190,16 +1108,13 @@ type (_, _) ty =
   | List : ('a, 'e) ty -> ('a list, 'e) ty
   | Option : ('a, 'e) ty -> ('a option, 'e) ty
   | Pair : (('a, 'e) ty * ('b, 'e) ty) -> ('a * 'b, 'e) ty
-  (* Support for type variables and recursive types
-  *)
+  (* Support for type variables and recursive types *)
   | Var : ('a, 'a -> 'e) ty
   | Rec : ('a, 'a -> 'e) ty -> ('a, 'e) ty
   | Pop : ('a, 'e) ty -> ('a, 'b -> 'e) ty
-  (* Change the representation of a type
-  *)
+  (* Change the representation of a type *)
   | Conv : string * ('a -> 'b) * ('b -> 'a) * ('b, 'e) ty -> ('a, 'e) ty
-  (* Sum types (both normal sums and polymorphic variants)
-  *)
+  (* Sum types (both normal sums and polymorphic variants) *)
   | Sum : ('a, 'e, 'b) ty_sum -> ('a, 'e) ty
 
 and ('a, 'e, 'b) ty_sum =
@@ -1208,30 +1123,25 @@ and ('a, 'e, 'b) ty_sum =
   ; sum_inj : 'c. ('b, 'c) ty_sel * 'c -> 'a
   }
 
-and 'e ty_dyn = (* dynamic type
-                *)
+and 'e ty_dyn = (* dynamic type *)
   | Tdyn : ('a, 'e) ty * 'a -> 'e ty_dyn
 
 and (_, _) ty_sel =
-  (* selector from a list of types
-  *)
+  (* selector from a list of types *)
   | Thd : ('a -> 'b, 'a) ty_sel
   | Ttl : ('b -> 'c, 'd) ty_sel -> ('a -> 'b -> 'c, 'd) ty_sel
 
 and (_, _) ty_case =
-  (* type a sum case
-  *)
+  (* type a sum case *)
   | TCarg : ('b, 'a) ty_sel * ('a, 'e) ty -> ('e, 'b) ty_case
   | TCnoarg : ('b, noarg) ty_sel -> ('e, 'b) ty_case
 
 type _ ty_env =
-  (* type variable substitution
-  *)
+  (* type variable substitution *)
   | Enil : unit ty_env
   | Econs : ('a, 'e) ty * 'e ty_env -> ('a -> 'e) ty_env
 
-(* Comparing selectors
-*)
+(* Comparing selectors *)
 type (_, _) eq = Eq : ('a, 'a) eq
 
 let rec eq_sel : type a b c. (a, b) ty_sel -> (a, c) ty_sel -> (b, c) eq option =
@@ -1245,8 +1155,7 @@ let rec eq_sel : type a b c. (a, b) ty_sel -> (a, c) ty_sel -> (b, c) eq option
   | _ -> None
 ;;
 
-(* Auxiliary function to get the type of a case from its selector
-*)
+(* Auxiliary function to get the type of a case from its selector *)
 let rec get_case
   : type a b e.
     (b, a) ty_sel -> (string * (e, b) ty_case) list -> string * (a, e) ty option
@@ -1264,8 +1173,7 @@ let rec get_case
   | [] -> raise Not_found
 ;;
 
-(* Untyped representation of values
-*)
+(* Untyped representation of values *)
 type variant =
   | VInt of int
   | VString of string
@@ -1332,15 +1240,13 @@ let rec devariantize : type t e. e ty_env -> (t, e) ty -> variant -> t =
   | _ -> raise VariantMismatch
 ;;
 
-(* First attempt: represent 1-constructor variants using Conv
-*)
+(* First attempt: represent 1-constructor variants using Conv *)
 let wrap_A t = Conv ("`A", (fun (`A x) -> x), (fun x -> `A x), t)
 let ty a = Rec (wrap_A (Option (Pair (a, Var))))
 let v = variantize Enil (ty Int)
 let x = v (`A (Some (1, `A (Some (2, `A None)))))
 
-(* Can also use it to decompose a tuple
-*)
+(* Can also use it to decompose a tuple *)
 
 let triple t1 t2 t3 =
   Conv
@@ -1352,17 +1258,14 @@ let triple t1 t2 t3 =
 
 let v = variantize Enil (triple String Int Int) ("A", 2, 3)
 
-(* Second attempt: introduce a real sum construct
-*)
+(* Second attempt: introduce a real sum construct *)
 let ty_abc =
-  (* Could also use [get_case] for proj, but direct definition is shorter
-  *)
+  (* Could also use [get_case] for proj, but direct definition is shorter *)
   let proj = function
     | `A n -> "A", Some (Tdyn (Int, n))
     | `B s -> "B", Some (Tdyn (String, s))
     | `C -> "C", None
-  (* Define inj in advance to be able to write the type annotation easily
-  *)
+  (* Define inj in advance to be able to write the type annotation easily *)
   and inj
     : type c.
       (int -> string -> noarg -> unit, c) ty_sel * c -> [ `A of int | `B of string | `C ]
@@ -1371,8 +1274,7 @@ let ty_abc =
       | Ttl Thd, v -> `B v
       | Ttl (Ttl Thd), Noarg -> `C
   in
-  (* Coherence of sum_inj and sum_cases is checked by the typing
-  *)
+  (* Coherence of sum_inj and sum_cases is checked by the typing *)
   Sum
     { sum_proj = proj
     ; sum_inj = inj
@@ -1387,8 +1289,7 @@ let ty_abc =
 let v = variantize Enil ty_abc (`A 3)
 let a = devariantize Enil ty_abc v
 
-(* And an example with recursion...
-*)
+(* And an example with recursion... *)
 type 'a vlist =
   [ `Nil
   | `Cons of 'a * 'a vlist
@@ -1409,15 +1310,13 @@ let ty_list : type a e. (a, e) ty -> (a vlist, e) ty =
               function
               | Thd, Noarg -> `Nil
               | Ttl Thd, v -> `Cons v)
-           (* One can also write the type annotation directly
-           *)
+           (* One can also write the type annotation directly *)
        })
 ;;
 
 let v = variantize Enil (ty_list Int) (`Cons (1, `Cons (2, `Nil)))
 
-(* Simpler but weaker approach
-*)
+(* Simpler but weaker approach *)
 
 type (_, _) ty =
   | Int : (int, _) ty
@@ -1436,8 +1335,7 @@ type (_, _) ty =
 and 'e ty_dyn = Tdyn : ('a, 'e) ty * 'a -> 'e ty_dyn
 
 let ty_abc : ([ `A of int | `B of string | `C ], 'e) ty =
-  (* Could also use [get_case] for proj, but direct definition is shorter
-  *)
+  (* Could also use [get_case] for proj, but direct definition is shorter *)
   Sum
     ( (function
         | `A n -> "A", Some (Tdyn (Int, n))
@@ -1450,8 +1348,7 @@ let ty_abc : ([ `A of int | `B of string | `C ], 'e) ty =
       | _ -> invalid_arg "ty_abc" )
 ;;
 
-(* Breaks: no way to pattern-match on a full recursive type
-*)
+(* Breaks: no way to pattern-match on a full recursive type *)
 let ty_list : type a e. (a, e) ty -> (a vlist, e) ty =
   fun t ->
   let targ = Pair (Pop t, Var) in
@@ -1465,8 +1362,7 @@ let ty_list : type a e. (a, e) ty -> (a vlist, e) ty =
          | "Cons", Some (Tdyn (Pair (_, Var), (p : a * a vlist))) -> `Cons p ))
 ;;
 
-(* Define Sum using object instead of record for first-class polymorphism
-*)
+(* Define Sum using object instead of record for first-class polymorphism *)
 
 type (_, _) ty =
   | Int : (int, _) ty
@@ -1552,17 +1448,14 @@ let ty_list : type a e. (a, e) ty -> (a vlist, e) ty =
    and (_,_) ty_pvar =
    | Pnil : ('a,'e) ty_pvar
    | Pconst : 't * ('b,'e) ty_pvar -> ('t -> 'b, 'e) ty_pvar
-   | Parg : 't * ('a,'e) ty * ('b,'e) ty_pvar -> ('t * 'a -> 'b, 'e) ty_pvar
-*)
+   | Parg : 't * ('a,'e) ty * ('b,'e) ty_pvar -> ('t * 'a -> 'b, 'e) ty_pvar *)
 (*
    An attempt at encoding omega examples from the 2nd Central European
    Functional Programming School:
    Generic Programming in Omega, by Tim Sheard and Nathan Linger
-   http://web.cecs.pdx.edu/~sheard/
-*)
+   http://web.cecs.pdx.edu/~sheard/ *)
 
-(* Basic types
-*)
+(* Basic types *)
 
 type ('a, 'b) sum =
   | Inl of 'a
@@ -1575,8 +1468,7 @@ type _ nat =
   | NZ : zero nat
   | NS : 'a nat -> 'a succ nat
 
-(* 2: A simple example
-*)
+(* 2: A simple example *)
 
 type (_, _) seq =
   | Snil : ('a, zero) seq
@@ -1587,8 +1479,7 @@ let l1 = Scons (3, Scons (5, Snil))
 (* We do not have type level functions, so we need to use witnesses. *)
 (* We copy here the definitions from section 3.9 *)
 (* Note the addition of the ['a nat] argument to PlusZ, since we do not
-   have kinds
-*)
+   have kinds *)
 type (_, _, _) plus =
   | PlusZ : 'a nat -> (zero, 'a, 'a) plus
   | PlusS : ('a, 'b, 'c) plus -> ('a succ, 'b, 'c succ) plus
@@ -1599,8 +1490,7 @@ let rec length : type a n. (a, n) seq -> n nat = function
 ;;
 
 (* app returns the catenated lists with a witness proving that
-   the size is the sum of its two inputs
-*)
+   the size is the sum of its two inputs *)
 type (_, _, _) app = App : ('a, 'p) seq * ('n, 'm, 'p) plus -> ('a, 'n, 'm) app
 
 let rec app : type a n m. (a, n) seq -> (a, m) seq -> (a, n, m) app =
@@ -1612,11 +1502,9 @@ let rec app : type a n m. (a, n) seq -> (a, m) seq -> (a, n, m) app =
     App (Scons (x, xs''), PlusS pl)
 ;;
 
-(* 3.1 Feature: kinds
-*)
+(* 3.1 Feature: kinds *)
 
-(* We do not have kinds, but we can encode them as predicates
-*)
+(* We do not have kinds, but we can encode them as predicates *)
 
 type tp = TP
 type nd = ND
@@ -1634,8 +1522,7 @@ type _ boolean =
   | BT : tt boolean
   | BF : ff boolean
 
-(* 3.3 Feature : GADTs
-*)
+(* 3.3 Feature : GADTs *)
 
 type (_, _) path =
   | Pnone : 'a -> (tp, 'a) path
@@ -1668,8 +1555,7 @@ let rec extract : type sh. (sh, 'a) path -> (sh, 'a) tree -> 'a =
   | Pright p, Tfork (_, r) -> extract p r
 ;;
 
-(* 3.4 Pattern : Witness
-*)
+(* 3.4 Pattern : Witness *)
 
 type (_, _) le =
   | LeZ : 'a nat -> (zero, 'a) le
@@ -1696,8 +1582,7 @@ let rec summandLessThanSum : type a b c. (a, b, c) plus -> (a, c) le =
   | PlusS p' -> LeS (summandLessThanSum p')
 ;;
 
-(* 3.8 Pattern: Leibniz Equality
-*)
+(* 3.8 Pattern: Leibniz Equality *)
 
 type (_, _) equal = Eq : ('a, 'a) equal
 
@@ -1714,8 +1599,7 @@ let rec sameNat : type a b. a nat -> b nat -> (a, b) equal option =
   | _ -> None
 ;;
 
-(* Extra: associativity of addition
-*)
+(* Extra: associativity of addition *)
 
 let rec plus_func : type a b m n. (a, b, m) plus -> (a, b, n) plus -> (m, n) equal =
   fun p1 p2 ->
@@ -1745,11 +1629,9 @@ let rec plus_assoc
     Eq
 ;;
 
-(* 3.9 Computing Programs and Properties Simultaneously
-*)
+(* 3.9 Computing Programs and Properties Simultaneously *)
 
-(* Plus and app1 are moved to section 2
-*)
+(* Plus and app1 are moved to section 2 *)
 
 let smaller : type a b. (a succ, b succ) le -> (a, b) le = function
   | LeS x -> x
@@ -1765,8 +1647,7 @@ type (_, _) diff = Diff : 'c nat * ('a, 'c, 'b) plus -> ('a, 'b) diff
    | NS x, NZ, _ -> assert false
    | NS x, NS y, q ->
    match diff (smaller q) x y with Diff (m, p) -> Diff (m, PlusS p)
-   ;;
-*)
+   ;; *)
 
 let rec diff : type a b. (a, b) le -> a nat -> b nat -> (a, b) diff =
   fun le a b ->
@@ -1780,8 +1661,7 @@ let rec diff : type a b. (a, b) le -> a nat -> b nat -> (a, b) diff =
 let rec diff : type a b. (a, b) le -> a nat -> b nat -> (a, b) diff =
   fun le a b ->
   match a, b, le with
-  (* warning
-  *)
+  (* warning *)
   | NZ, m, LeZ _ -> Diff (m, PlusZ m)
   | NS x, NS y, LeS q ->
     (match diff q x y with
@@ -1815,8 +1695,7 @@ let rec filter : type a n. (a -> bool) -> (a, n) seq -> (a, n) filter =
        if f a then Filter (LeS le, Scons (a, l')) else Filter (leS' le, l'))
 ;;
 
-(* 4.1 AVL trees
-*)
+(* 4.1 AVL trees *)
 
 type (_, _, _) balance =
   | Less : ('h, 'h succ, 'h succ) balance
@@ -1970,8 +1849,7 @@ let delete x (Avl t) =
   | Ddecr (_, t) -> Avl t
 ;;
 
-(* Exercise 22: Red-black trees
-*)
+(* Exercise 22: Red-black trees *)
 
 type red = RED
 type black = BLACK
@@ -2060,8 +1938,7 @@ let rec ins : type c n. int -> (c, n) sub_tree -> (c, n) ctxt -> rb_tree =
 
 let insert e (Root t) = ins e t CNil
 
-(* 5.7 typed object languages using GADTs
-*)
+(* 5.7 typed object languages using GADTs *)
 
 type _ term =
   | Const : int -> int term
@@ -2149,8 +2026,7 @@ let ex3 = Abs ("x", Rint, Ap (Add, Pair (Var ("x", Rint), Var ("x", Rint))))
 let ex4 = Ap (ex3, Const 3)
 let v4 = eval_term [] ex4
 
-(* 5.9/5.10 Language with binding
-*)
+(* 5.9/5.10 Language with binding *)
 
 type rnil = RNIL
 type ('a, 'b, 'c) rcons = RCons of 'a * 'b * 'c
@@ -2200,12 +2076,10 @@ let double = Abs (X, App (App (Shift add, Var X), Var X))
 let ex3 = App (double, _3)
 let v3 = eval_lam env0 ex3
 
-(* 5.13: Constructing typing derivations at runtime
-*)
+(* 5.13: Constructing typing derivations at runtime *)
 
 (* Modified slightly to use the language of 5.10, since this is more fun.
-   Of course this works also with the language of 5.12.
-*)
+   Of course this works also with the language of 5.12. *)
 
 type _ rep =
   | I : int rep
@@ -2295,8 +2169,7 @@ let eval_checked env = function
 
 let v2 = eval_checked env0 c2
 
-(* 5.12 Soundness
-*)
+(* 5.12 Soundness *)
 
 type pexp = PEXP
 type pval = PVAL
@@ -2403,12 +2276,10 @@ let f : type env a. (env, a) typ -> (env, a) typ -> int =
   | Tint, Tint -> 0
   | Tbool, Tbool -> 1
   | Tvar var, tb -> 2
-  | _ -> . (* error
-           *)
+  | _ -> . (* error *)
 ;;
 
-(* let x = f Tint (Tvar Zero) ;;
-*)
+(* let x = f Tint (Tvar Zero) ;; *)
 type inkind =
   [ `Link
   | `Nonlink
@@ -2451,8 +2322,7 @@ let inlineseq_from_astseq seq =
   List.map process_any seq
 ;;
 
-(* OK
-*)
+(* OK *)
 type _ linkp =
   | Nonlink : [ `Nonlink ] linkp
   | Maylink : inkind linkp
@@ -2472,8 +2342,7 @@ let inlineseq_from_astseq seq =
   List.map (process Maylink) seq
 ;;
 
-(* Bad
-*)
+(* Bad *)
 type _ linkp2 = Kind : 'a linkp -> ([< inkind ] as 'a) linkp2
 
 let inlineseq_from_astseq seq =
@@ -2550,8 +2419,7 @@ type tag =
 type 'a poly =
   | AandBTags : [< `TagA of int | `TagB ] poly
   | ATag : [< `TagA of int ] poly
-  (* constraint 'a = [< `TagA of int | `TagB]
-  *)
+  (* constraint 'a = [< `TagA of int | `TagB] *)
 
 let intA = function
   | `TagA i -> i
@@ -2572,12 +2440,10 @@ let example6 : type a. a wrapPoly -> a -> int =
   fun w ->
   match w with
   | WrapPoly ATag -> intA
-  | WrapPoly _ -> intA (* This should not be allowed
-                       *)
+  | WrapPoly _ -> intA (* This should not be allowed *)
 ;;
 
-let _ = example6 (WrapPoly AandBTags) `TagB (* This causes a seg fault
-                                            *)
+let _ = example6 (WrapPoly AandBTags) `TagB (* This causes a seg fault *)
 
 module F (S : sig
     type 'a t
@@ -2725,8 +2591,7 @@ let f (Aux x) =
   | Succ (Succ Zero) -> "2"
   | Succ (Succ (Succ Zero)) -> "3"
   | Succ (Succ (Succ (Succ Zero))) -> "4"
-  | _ -> . (* error
-           *)
+  | _ -> . (* error *)
 ;;
 
 type _ t = C : ((('a -> 'o) -> 'o) -> ('b -> 'o) -> 'o) t
@@ -2854,16 +2719,14 @@ type (_, _) t =
 
 let get1 (Cons (x, _) : (_ * 'a, 'a) t) = x
 
-(* warn, cf PR#6993
-*)
+(* warn, cf PR#6993 *)
 
 let get1' = function
   | (Cons (x, _) : (_ * 'a, 'a) t) -> x
   | Nil -> assert false
 ;;
 
-(* ok
-*)
+(* ok *)
 type _ t =
   | Int : int -> int t
   | String : string -> string t
@@ -2883,8 +2746,7 @@ type _ t = I : int t
 
 let f (type a) (x : a t) =
   let module M = struct
-    let (I : a t) = x (* fail because of toplevel let
-                      *)
+    let (I : a t) = x (* fail because of toplevel let *)
     let x = (I : a t)
   end
   in
@@ -2900,8 +2762,7 @@ let bad (type a) =
     module rec M : sig
       val e : (int, a) eq
     end = struct
-      let (Refl : (int, a) eq) = M.e (* must fail for soundness
-                                     *)
+      let (Refl : (int, a) eq) = M.e (* must fail for soundness *)
       let e : (int, a) eq = Refl
     end
   end
@@ -2928,8 +2789,7 @@ let undetected : ('a -> 'b -> nil) t -> 'a n -> 'b n -> unit =
 
 type _ t = T : int t
 
-(* Should raise Not_found
-*)
+(* Should raise Not_found *)
 let _ =
   match (raise Not_found : float t) with
   | _ -> .
@@ -2943,15 +2803,13 @@ type 'a t
 
 let f (type a) (Neq n : (a, a t) eq) = n
 
-(* warn!
-*)
+(* warn! *)
 
 module F (T : sig
     type _ t
   end) =
 struct
-  let f (type a) (Neq n : (a, a T.t) eq) = n (* warn!
-                                             *)
+  let f (type a) (Neq n : (a, a T.t) eq) = n (* warn! *)
 end
 
 (* First-Order Unification by Structural Recursion *)
@@ -2961,8 +2819,7 @@ end
 (* This is a translation of the code part to ocaml *)
 (* Of course, we do not prove other properties, not even termination *)
 
-(* 2.2 Inductive Families
-*)
+(* 2.2 Inductive Families *)
 
 type zero = Zero
 type _ succ = Succ
@@ -2978,11 +2835,9 @@ type _ fin =
 (* We cannot define
    val empty : zero fin -> 'a
    because we cannot write an empty pattern matching.
-   This might be useful to have
-*)
+   This might be useful to have *)
 
-(* In place, prove that the parameter is 'a succ
-*)
+(* In place, prove that the parameter is 'a succ *)
 type _ is_succ = IS : 'a succ is_succ
 
 let fin_succ : type n. n fin -> n is_succ = function
@@ -2990,8 +2845,7 @@ let fin_succ : type n. n fin -> n is_succ = function
   | FS _ -> IS
 ;;
 
-(* 3 First-Order Terms, Renaming and Substitution
-*)
+(* 3 First-Order Terms, Renaming and Substitution *)
 
 type 'a term =
   | Var of 'a fin
@@ -3009,11 +2863,9 @@ let rec pre_subst f = function
 
 let comp_subst f g (x : 'a fin) = pre_subst f (g x)
 (* val comp_subst :
-   ('b fin -> 'c term) -> ('a fin -> 'b term) -> 'a fin -> 'c term
-*)
+   ('b fin -> 'c term) -> ('a fin -> 'b term) -> 'a fin -> 'c term *)
 
-(* 4 The Occur-Check, through thick and thin
-*)
+(* 4 The Occur-Check, through thick and thin *)
 
 let rec thin : type n. n succ fin -> n fin -> n succ fin =
   fun x y ->
@@ -3029,8 +2881,7 @@ let bind t f =
   | Some x -> f x
 ;;
 
-(* val bind : 'a option -> ('a -> 'b option) -> 'b option
-*)
+(* val bind : 'a option -> ('a -> 'b option) -> 'b option *)
 
 let rec thick : type n. n succ fin -> n succ fin -> n fin option =
   fun x y ->
@@ -3060,15 +2911,12 @@ let subst_var x t' y =
   | Some y' -> Var y'
 ;;
 
-(* val subst_var : 'a succ fin -> 'a term -> 'a succ fin -> 'a term
-*)
+(* val subst_var : 'a succ fin -> 'a term -> 'a succ fin -> 'a term *)
 
 let subst x t' = pre_subst (subst_var x t')
-(* val subst : 'a succ fin -> 'a term -> 'a succ term -> 'a term
-*)
+(* val subst : 'a succ fin -> 'a term -> 'a succ term -> 'a term *)
 
-(* 5 A Refinement of Substitution
-*)
+(* 5 A Refinement of Substitution *)
 
 type (_, _) alist =
   | Anil : ('n, 'n) alist
@@ -3090,8 +2938,7 @@ type _ ealist = EAlist : ('a, 'b) alist -> 'a ealist
 
 let asnoc a t' x = EAlist (Asnoc (a, t', x))
 
-(* Extra work: we need sub to work on ealist too, for examples
-*)
+(* Extra work: we need sub to work on ealist too, for examples *)
 let rec weaken_fin : type n. n fin -> n succ fin = function
   | FZ -> FZ
   | FS x -> FS (weaken_fin x)
@@ -3111,11 +2958,9 @@ let rec sub' : type m. m ealist -> m fin -> m term = function
 ;;
 
 let subst' d = pre_subst (sub' d)
-(* val subst' : 'a ealist -> 'a term -> 'a term
-*)
+(* val subst' : 'a ealist -> 'a term -> 'a term *)
 
-(* 6 First-Order Unification
-*)
+(* 6 First-Order Unification *)
 
 let flex_flex x y =
   match thick x y with
@@ -3123,12 +2968,10 @@ let flex_flex x y =
   | None -> EAlist Anil
 ;;
 
-(* val flex_flex : 'a succ fin -> 'a succ fin -> 'a succ ealist
-*)
+(* val flex_flex : 'a succ fin -> 'a succ fin -> 'a succ ealist *)
 
 let flex_rigid x t = bind (check x t) (fun t' -> Some (asnoc Anil t' x))
-(* val flex_rigid : 'a succ fin -> 'a succ term -> 'a succ ealist option
-*)
+(* val flex_rigid : 'a succ fin -> 'a succ term -> 'a succ ealist option *)
 
 let rec amgu : type m. m term -> m term -> m ealist -> m ealist option =
   fun s t acc ->
@@ -3153,8 +2996,7 @@ let rec amgu : type m. m term -> m term -> m ealist -> m ealist option =
 ;;
 
 let mgu s t = amgu s t (EAlist Anil)
-(* val mgu : 'a term -> 'a term -> 'a ealist option
-*)
+(* val mgu : 'a term -> 'a term -> 'a ealist option *)
 
 let s = Fork (Var FZ, Fork (Var (FS (FS FZ)), Leaf))
 let t = Fork (Var (FS FZ), Var (FS FZ))
@@ -3168,8 +3010,7 @@ let d =
 let s' = subst' d s
 let t' = subst' d t
 
-(* Injectivity
-*)
+(* Injectivity *)
 
 type (_, _) eq = Refl : ('a, 'a) eq
 
@@ -3191,8 +3032,7 @@ let magic : 'a 'b. 'a -> 'b =
   M.f Refl
 ;;
 
-(* Variance and subtyping
-*)
+(* Variance and subtyping *)
 
 type (_, +_) eq = Refl : ('a, 'a) eq
 
@@ -3211,8 +3051,7 @@ let magic : 'a 'b. 'a -> 'b =
   #m
 ;;
 
-(* Record patterns
-*)
+(* Record patterns *)
 
 type _ t =
   | IntLit : int t
@@ -3245,24 +3084,19 @@ module type S = sig type t [@@immediate] end
 module F : functor (M : S) -> S
 |}]
 
-(* VALID DECLARATIONS
-*)
+(* VALID DECLARATIONS *)
 
 module A = struct
-  (* Abstract types can be immediate
-  *)
+  (* Abstract types can be immediate *)
   type t [@@immediate]
 
-  (* [@@immediate] tag here is unnecessary but valid since t has it
-  *)
+  (* [@@immediate] tag here is unnecessary but valid since t has it *)
   type s = t [@@immediate]
 
-  (* Again, valid alias even without tag
-  *)
+  (* Again, valid alias even without tag *)
   type r = s
 
-  (* Mutually recursive declarations work as well
-  *)
+  (* Mutually recursive declarations work as well *)
   type p = q [@@immediate]
   and q = int
 end
@@ -3279,8 +3113,7 @@ module A :
   end
 |}]
 
-(* Valid using with constraints
-*)
+(* Valid using with constraints *)
 module type X = sig
   type t
 end
@@ -3300,8 +3133,7 @@ module Y : sig type t = int end
 module Z : sig type t [@@immediate] end
 |}]
 
-(* Valid using an explicit signature
-*)
+(* Valid using an explicit signature *)
 module M_valid : S = struct
   type t = int
 end
@@ -3315,8 +3147,7 @@ module M_valid : S
 module FM_valid : S
 |}]
 
-(* Practical usage over modules
-*)
+(* Practical usage over modules *)
 module Foo : sig
   type t
 
@@ -3377,14 +3208,11 @@ 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 "With @@immediate: %fs\n" (test test_bar) *)
 
-(* INVALID DECLARATIONS
-*)
+(* INVALID DECLARATIONS *)
 
-(* Cannot directly declare a non-immediate type as immediate
-*)
+(* Cannot directly declare a non-immediate type as immediate *)
 module B = struct
   type t = string [@@immediate]
 end
@@ -3396,8 +3224,7 @@ Error: Types marked with the immediate attribute must be
        non-pointer types like int or bool
 |}]
 
-(* Not guaranteed that t is immediate, so this is an invalid declaration
-*)
+(* Not guaranteed that t is immediate, so this is an invalid declaration *)
 module C = struct
   type t
   type s = t [@@immediate]
@@ -3410,8 +3237,7 @@ Error: Types marked with the immediate attribute must be
        non-pointer types like int or bool
 |}]
 
-(* Can't ascribe to an immediate type signature with a non-immediate type
-*)
+(* Can't ascribe to an immediate type signature with a non-immediate type *)
 module D : sig
   type t [@@immediate]
 end = struct
@@ -3433,8 +3259,7 @@ Error: Signature mismatch:
        the first is not an immediate type.
 |}]
 
-(* Same as above but with explicit signature
-*)
+(* Same as above but with explicit signature *)
 module M_invalid : S = struct
   type t = string
 end
@@ -3455,8 +3280,7 @@ Error: Signature mismatch:
        the first is not an immediate type.
 |}]
 
-(* Can't use a non-immediate type even if mutually recursive
-*)
+(* Can't use a non-immediate type even if mutually recursive *)
 module E = struct
   type t = s [@@immediate]
   and s = string
@@ -3479,17 +3303,14 @@ Error: Types marked with the immediate attribute must be
    New: implicit pack is also supported, and you only need to be able
    to infer the the module type path from the context.
 *)
-(* ocaml -principal
-*)
+(* ocaml -principal *)
 
-(* Use a module pattern
-*)
+(* Use a module pattern *)
 let sort (type s) (module Set : Set.S with type elt = s) l =
   Set.elements (List.fold_right Set.add l Set.empty)
 ;;
 
-(* No real improvement here?
-*)
+(* No real improvement here? *)
 let make_set (type s) cmp : (module Set.S with type elt = s) =
   (module Set.Make (struct
        type t = s
@@ -3498,8 +3319,7 @@ let make_set (type s) cmp : (module Set.S with type elt = s) =
      end))
 ;;
 
-(* No type annotation here
-*)
+(* No type annotation here *)
 let sort_cmp (type s) cmp =
   sort
     (module Set.Make (struct
@@ -3518,8 +3338,7 @@ end
 let f (module M : S with type t = int) = M.x
 let f (module M : S with type t = 'a) = M.x
 
-(* Error
-*)
+(* Error *)
 let f (type a) (module M : S with type t = a) = M.x;;
 
 f
@@ -3541,8 +3360,7 @@ type 'a s = { s : (module S with type t = 'a) };;
 
 let f { s = (module M) } = M.x
 
-(* Error
-*)
+(* Error *)
 let f (type a) ({ s = (module M) } : a s) = M.x
 
 type s = { s : (module S with type t = int) }
@@ -3562,8 +3380,7 @@ let m =
   end)
 ;;
 
-(* Error
-*)
+(* Error *)
 let m =
   (module struct
     let x = 3
@@ -3585,14 +3402,12 @@ M.x
 
 let (module M) = m
 
-(* Error: only allowed in [let .. in]
-*)
+(* Error: only allowed in [let .. in] *)
 class c =
   let (module M) = m in
   object end
 
-(* Error again
-*)
+(* Error again *)
 module M = (val m)
 
 module type S' = sig
@@ -3600,8 +3415,7 @@ module type S' = sig
 end
 ;;
 
-(* Even works with recursion, but must be fully explicit
-*)
+(* Even works with recursion, but must be fully explicit *)
 let rec (module M : S') =
   (module struct
     let f n = if n <= 0 then 1 else n * M.f (n - 1)
@@ -3609,8 +3423,7 @@ let rec (module M : S') =
 in
 M.f 3
 
-(* Subtyping
-*)
+(* Subtyping *)
 
 module type S = sig
   type t
@@ -3687,8 +3500,7 @@ let rec to_string : 'a. 'a Typ.typ -> 'a -> string =
     Printf.sprintf "(%s,%s)" (to_string P.t1 x1) (to_string P.t2 x2)
 ;;
 
-(* Wrapping maps
-*)
+(* Wrapping maps *)
 module type MapT = sig
   include Map.S
 
@@ -3750,8 +3562,7 @@ add ssmap
 open StdLabels
 open MoreLabels
 
-(* Use maps for substitutions and sets for free variables
-*)
+(* Use maps for substitutions and sets for free variables *)
 
 module Subst = Map.Make (struct
     type t = string
@@ -3765,8 +3576,7 @@ module Names = Set.Make (struct
     let compare = compare
   end)
 
-(* Variables are common to lambda and expr
-*)
+(* Variables are common to lambda and expr *)
 
 type var = [ `Var of string ]
 
@@ -3780,8 +3590,7 @@ let free_var : var -> _ = function
   | `Var s -> Names.singleton s
 ;;
 
-(* The lambda language: free variables, substitutions, and evaluation
-*)
+(* The lambda language: free variables, substitutions, and evaluation *)
 
 type 'a lambda =
   [ `Var of string
@@ -3836,15 +3645,13 @@ let eval_lambda ~eval_rec ~subst l =
   | t -> t
 ;;
 
-(* Specialized versions to use on lambda
-*)
+(* Specialized versions to use on lambda *)
 
 let rec free1 x = free_lambda ~free_rec:free1 x
 let rec subst1 ~subst = subst_lambda ~subst_rec:subst1 ~free:free1 ~subst
 let rec eval1 x = eval_lambda ~eval_rec:eval1 ~subst:subst1 x
 
-(* The expr language of arithmetic expressions
-*)
+(* The expr language of arithmetic expressions *)
 
 type 'a expr =
   [ `Var of string
@@ -3862,8 +3669,7 @@ let free_expr ~free_rec : _ expr -> _ = function
   | `Mult (x, y) -> Names.union (free_rec x) (free_rec y)
 ;;
 
-(* Here map_expr helps a lot
-*)
+(* Here map_expr helps a lot *)
 let map_expr ~map_rec : _ expr -> _ = function
   | #var as x -> x
   | `Num _ as x -> x
@@ -3893,15 +3699,13 @@ let eval_expr ~eval_rec e =
   | #expr as e -> e
 ;;
 
-(* Specialized versions
-*)
+(* Specialized versions *)
 
 let rec free2 x = free_expr ~free_rec:free2 x
 let rec subst2 ~subst = subst_expr ~subst_rec:subst2 ~subst
 let rec eval2 x = eval_expr ~eval_rec:eval2 x
 
-(* The lexpr language, reunion of lambda and expr
-*)
+(* The lexpr language, reunion of lambda and expr *)
 
 type lexpr =
   [ `Var of string
@@ -3963,14 +3767,12 @@ let () =
   print_newline ()
 ;;
 
-(* Full fledge version, using objects to structure code
-*)
+(* Full fledge version, using objects to structure code *)
 
 open StdLabels
 open MoreLabels
 
-(* Use maps for substitutions and sets for free variables
-*)
+(* Use maps for substitutions and sets for free variables *)
 
 module Subst = Map.Make (struct
     type t = string
@@ -3984,8 +3786,7 @@ module Names = Set.Make (struct
     let compare = compare
   end)
 
-(* To build recursive objects
-*)
+(* To build recursive objects *)
 
 let lazy_fix make =
   let rec obj () = make (lazy (obj ()) : _ Lazy.t) in
@@ -3994,8 +3795,7 @@ let lazy_fix make =
 
 let ( !! ) = Lazy.force
 
-(* The basic operations
-*)
+(* The basic operations *)
 
 class type ['a, 'b] ops = object
   method free : x:'b -> ?y:'c -> Names.t
@@ -4003,8 +3803,7 @@ class type ['a, 'b] ops = object
   method eval : 'b -> 'a
 end
 
-(* Variables are common to lambda and expr
-*)
+(* Variables are common to lambda and expr *)
 
 type var = [ `Var of string ]
 
@@ -4020,8 +3819,7 @@ class ['a] var_ops =
     method eval (#var as v) = v
   end
 
-(* The lambda language: free variables, substitutions, and evaluation
-*)
+(* The lambda language: free variables, substitutions, and evaluation *)
 
 type 'a lambda =
   [ `Var of string
@@ -4084,13 +3882,11 @@ class ['a] lambda_ops (ops : ('a, 'a) #ops Lazy.t) =
       | t -> t
   end
 
-(* Operations specialized to lambda
-*)
+(* Operations specialized to lambda *)
 
 let lambda = lazy_fix (new lambda_ops)
 
-(* The expr language of arithmetic expressions
-*)
+(* The expr language of arithmetic expressions *)
 
 type 'a expr =
   [ `Var of string
@@ -4145,13 +3941,11 @@ class ['a] expr_ops (ops : ('a, 'a) #ops Lazy.t) =
       | e -> e
   end
 
-(* Specialized versions
-*)
+(* Specialized versions *)
 
 let expr = lazy_fix (new expr_ops)
 
-(* The lexpr language, reunion of lambda and expr
-*)
+(* The lexpr language, reunion of lambda and expr *)
 
 type 'a lexpr =
   [ 'a lambda
@@ -4219,14 +4013,12 @@ let () =
   print_newline ()
 ;;
 
-(* Full fledge version, using objects to structure code
-*)
+(* Full fledge version, using objects to structure code *)
 
 open StdLabels
 open MoreLabels
 
-(* Use maps for substitutions and sets for free variables
-*)
+(* Use maps for substitutions and sets for free variables *)
 
 module Subst = Map.Make (struct
     type t = string
@@ -4240,8 +4032,7 @@ module Names = Set.Make (struct
     let compare = compare
   end)
 
-(* To build recursive objects
-*)
+(* To build recursive objects *)
 
 let lazy_fix make =
   let rec obj () = make (lazy (obj ()) : _ Lazy.t) in
@@ -4250,8 +4041,7 @@ let lazy_fix make =
 
 let ( !! ) = Lazy.force
 
-(* The basic operations
-*)
+(* The basic operations *)
 
 class type ['a, 'b] ops = object
   method free : 'b -> Names.t
@@ -4259,8 +4049,7 @@ class type ['a, 'b] ops = object
   method eval : 'b -> 'a
 end
 
-(* Variables are common to lambda and expr
-*)
+(* Variables are common to lambda and expr *)
 
 type var = [ `Var of string ]
 
@@ -4275,8 +4064,7 @@ let var =
   end
 ;;
 
-(* The lambda language: free variables, substitutions, and evaluation
-*)
+(* The lambda language: free variables, substitutions, and evaluation *)
 
 type 'a lambda =
   [ `Var of string
@@ -4337,13 +4125,11 @@ let lambda_ops (ops : ('a, 'a) #ops Lazy.t) =
   end
 ;;
 
-(* Operations specialized to lambda
-*)
+(* Operations specialized to lambda *)
 
 let lambda = lazy_fix lambda_ops
 
-(* The expr language of arithmetic expressions
-*)
+(* The expr language of arithmetic expressions *)
 
 type 'a expr =
   [ `Var of string
@@ -4396,13 +4182,11 @@ let expr_ops (ops : ('a, 'a) #ops Lazy.t) =
   end
 ;;
 
-(* Specialized versions
-*)
+(* Specialized versions *)
 
 let expr = lazy_fix expr_ops
 
-(* The lexpr language, reunion of lambda and expr
-*)
+(* The lexpr language, reunion of lambda and expr *)
 
 type 'a lexpr =
   [ 'a lambda
@@ -4581,13 +4365,11 @@ let _ = foo ()
 
 type 'a t = [ `A of 'a t t ] as 'a
 
-(* fails
-*)
+(* fails *)
 
 type 'a t = [ `A of 'a t t ]
 
-(* fails
-*)
+(* fails *)
 
 type 'a t = [ `A of 'a t t ] constraint 'a = 'a t
 type 'a t = [ `A of 'a t ] constraint 'a = 'a t
@@ -4597,20 +4379,17 @@ type 'a v = [ `A of u v ] constraint 'a = t
 and t = u
 and u = t
 
-(* fails
-*)
+(* fails *)
 
 type 'a t = 'a
 
 let f (x : 'a t as 'a) = ()
 
-(* fails
-*)
+(* fails *)
 
 let f (x : 'a t) (y : 'a) = x = y
 
-(* PR#6505
-*)
+(* PR#6505 *)
 module type PR6505 = sig
   type 'o is_an_object = < .. > as 'o
   and 'o abs constraint 'o = 'o is_an_object
@@ -4619,16 +4398,13 @@ val abs : 'o is_an_object -> 'o abs
 val unabs : 'o abs -> 'o
 end
 
-(* fails
-*)
-(* PR#5835
-*)
+(* fails *)
+(* PR#5835 *)
 let f ~x = x + 1;;
 
 f ?x:0
 
-(* PR#6352
-*)
+(* PR#6352 *)
 let foo (f : unit -> unit) = ()
 let g ?x () = ();;
 
@@ -4637,14 +4413,11 @@ foo
    g)
 ;;
 
-(* PR#5748
-*)
+(* PR#5748 *)
 foo (fun ?opt () -> ())
 
-(* fails
-*)
-(* PR#5907
-*)
+(* fails *)
+(* PR#5907 *)
 
 type 'a t = 'a
 
@@ -4680,18 +4453,15 @@ let f (x : [< `A | `B ]) =
   | `A | `B | `C -> 0
 ;;
 
-(* warn
-*)
+(* warn *)
 let f (x : [ `A | `B ]) =
   match x with
   | `A | `B | `C -> 0
 ;;
 
-(* fail
-*)
+(* fail *)
 
-(* PR#6787
-*)
+(* PR#6787 *)
 let revapply x f = f x
 
 let f x (g : [< `Foo ]) =
@@ -4699,8 +4469,7 @@ let f x (g : [< `Foo ]) =
   revapply y (fun (`Bar i, _) -> i)
 ;;
 
-(* f : 'a -> [< `Foo ] -> 'a
-*)
+(* f : 'a -> [< `Foo ] -> 'a *)
 
 let rec x =
   [| x |];
@@ -4723,8 +4492,7 @@ let _ = fun (x : a t) -> f x
 let _ = fun (x : a t) -> g x
 let _ = fun (x : a t) -> h x
 
-(* PR#7012
-*)
+(* PR#7012 *)
 
 type t =
   [ 'A_name
@@ -4734,8 +4502,7 @@ type t =
 let f (x : 'id_arg) = x
 let f (x : 'Id_arg) = x
 
-(* undefined labels
-*)
+(* undefined labels *)
 type t =
   { x : int
   ; y : int
@@ -4745,19 +4512,16 @@ type t =
 { x = 3; z = 2 };;
 fun { x = 3; z = 2 } -> ();;
 
-(* mixed labels
-*)
+(* mixed labels *)
 { x = 3; contents = 2 }
 
-(* private types
-*)
+(* private types *)
 type u = private { mutable u : int };;
 
 { u = 3 };;
 fun x -> x.u <- 3
 
-(* Punning and abbreviations
-*)
+(* Punning and abbreviations *)
 module M = struct
   type t =
     { x : int
@@ -4769,14 +4533,12 @@ let f { M.x; y } = x + y
 let r = { M.x = 1; y = 2 }
 let z = f r
 
-(* messages
-*)
+(* messages *)
 type foo = { mutable y : int }
 
 let f (r : int) = r.y <- 3
 
-(* bugs
-*)
+(* bugs *)
 type foo =
   { y : int
   ; z : int
@@ -4792,12 +4554,10 @@ let r : foo = { ZZZ.x = 2 };;
 
 (ZZZ.X : int option)
 
-(* PR#5865
-*)
+(* PR#5865 *)
 let f (x : Complex.t) = x.Complex.z
 
-(* PR#6394
-*)
+(* PR#6394 *)
 
 module rec X : sig
   type t = int * bool
@@ -4811,8 +4571,7 @@ end = struct
   ;;
 end
 
-(* PR#6768
-*)
+(* PR#6768 *)
 
 type _ prod = Prod : ('a * 'y) prod
 
@@ -4844,8 +4603,7 @@ end =
 let f1 (x : (_, _) Hash1.t) : (_, _) Hashtbl.t = x
 let f2 (x : (_, _) Hash2.t) : (_, _) Hashtbl.t = x
 
-(* Another case, not using include
-*)
+(* Another case, not using include *)
 
 module Std2 = struct
   module M = struct
@@ -4872,8 +4630,7 @@ let f3 (x : M'.t) : Std2.M.t = x
    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
-*)
+   end *)
 module type INCLUDING = sig
   include module type of List
   include module type of ListLabels
@@ -4992,8 +4749,7 @@ struct
   module X = (val if !flag then (module A) else (module B) : S.T)
 end
 
-(* If the above were accepted, one could break soundness
-*)
+(* If the above were accepted, one could break soundness *)
 module type S = sig
   type t
 
@@ -5054,8 +4810,7 @@ end
    type 'a list_wrap = 'a list)
    -> S with type t = Html5_types.div Html5.elt and
    type u = < foo: Html5.uri >
-   end
-*)
+   end *)
 module type S = sig
   include Set.S
 
@@ -5183,8 +4938,7 @@ module X = struct
   end
 end
 
-(* open X  (* works! *)
-*)
+(* open X  (* works! *) *)
 module Y = X.Y
 
 type 'a arg_t = 'at constraint 'a = (module Y.S with type t = 'at)
@@ -5214,15 +4968,12 @@ module type S = sig
 end
 
 let f (type a) (module X : S with type t = a) = ()
-let _ = f (module A) (* ok
-                     *)
+let _ = f (module A) (* ok *)
 
 module A_annotated_alias : S with type t = (module A.A_S) = A
 
-let _ = f (module A_annotated_alias) (* ok
-                                     *)
-let _ = f (module A_annotated_alias : S with type t = (module A.A_S)) (* ok
-                                                                      *)
+let _ = f (module A_annotated_alias) (* ok *)
+let _ = f (module A_annotated_alias : S with type t = (module A.A_S)) (* ok *)
 
 module A_alias = A
 
@@ -5230,14 +4981,10 @@ module A_alias_expanded = struct
   include A_alias
 end
 
-let _ = f (module A_alias_expanded : S with type t = (module A.A_S)) (* ok
-                                                                     *)
-let _ = f (module A_alias_expanded) (* ok
-                                    *)
-let _ = f (module A_alias : S with type t = (module A.A_S)) (* doesn't type
-                                                            *)
-let _ = f (module A_alias) (* doesn't type either
-                           *)
+let _ = f (module A_alias_expanded : S with type t = (module A.A_S)) (* ok *)
+let _ = f (module A_alias_expanded) (* ok *)
+let _ = f (module A_alias : S with type t = (module A.A_S)) (* doesn't type *)
+let _ = f (module A_alias) (* doesn't type either *)
 
 module Foo
     (Bar : sig
@@ -5253,8 +5000,7 @@ module Bazoinks = struct
 end
 
 module Bug = Foo (Bazoinks) (Bazoinks)
-(* PR#6992, reported by Stephen Dolan
-*)
+(* PR#6992, reported by Stephen Dolan *)
 
 type (_, _) eq = Eq : ('a, 'a) eq
 
@@ -5272,8 +5018,7 @@ 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)
-*)
+   let _ = Printf.printf "Oh dear: %s" (cast bad 42) *)
 module M = struct
   module type S = sig
     type a
@@ -5310,8 +5055,7 @@ module type FOO = sig
 end
 
 module type BAR = sig
-  (* Works: module rec A : (sig include FOO with type t = < b:B.t > end)
-  *)
+  (* Works: module rec A : (sig include FOO with type t = < b:B.t > end) *)
   module rec A : (FOO with type t = < b : B.t >)
   and B : FOO
 end
@@ -5396,8 +5140,7 @@ end = struct
   let add_dec dec = Fast.attach Dem.key dec
 end
 
-(* simpler version
-*)
+(* simpler version *)
 
 module Simple = struct
   type 'a t
@@ -5460,8 +5203,7 @@ module rec M : sig
 end = struct
   external f : int -> int = "%identity"
 end
-(* with module
-*)
+(* with module *)
 
 module type S = sig
   type t
@@ -5477,8 +5219,7 @@ end
 
 module type S' = S with module M := String
 
-(* with module type
-*)
+(* with module type *)
 (*
    module type S = sig module type T module F(X:T) : T end;;
    module type T0 = sig type t end;;
@@ -5494,11 +5235,9 @@ module type S' = S with module M := String
    and module type SeededS := Hashtbl.SeededS
    and module type HashedType := Hashtbl.HashedType
    and module type SeededHashedType := Hashtbl.SeededHashedType)
-   end;;
-*)
+   end;; *)
 
-(* A subtle problem appearing with -principal
-*)
+(* A subtle problem appearing with -principal *)
 type -'a t
 
 class type c = object
@@ -5514,24 +5253,21 @@ end = struct
   ;;
 end
 
-(* PR#4838
-*)
+(* PR#4838 *)
 
 let id =
   let module M = struct end in
   fun x -> x
 ;;
 
-(* PR#4511
-*)
+(* PR#4511 *)
 
 let ko =
   let module M = struct end in
   fun _ -> ()
 ;;
 
-(* PR#5993
-*)
+(* PR#5993 *)
 
 module M : sig
   type -'a t = private int
@@ -5539,8 +5275,7 @@ end = struct
   type +'a t = private int
 end
 
-(* PR#6005
-*)
+(* PR#6005 *)
 
 module type A = sig
   type t = X of int
@@ -5550,8 +5285,7 @@ type u = X of bool
 
 module type B = A with type t = u
 
-(* fail
-*)
+(* fail *)
 
 (* PR#5815 *)
 (* ---> duplicated exception name is now an error *)
@@ -5561,8 +5295,7 @@ module type S = sig
   exception Foo of bool
 end
 
-(* PR#6410
-*)
+(* PR#6410 *)
 
 module F (X : sig end) = struct
   let x = 3
@@ -5571,8 +5304,7 @@ end
 
 F.x
 
-(* fail
-*)
+(* fail *)
 module C = Char;;
 
 C.chr 66
@@ -5610,8 +5342,7 @@ module G (X : sig end) = struct
   module M = X
 end
 
-(* does not alias X
-*)
+(* does not alias X *)
 module M = G (struct end)
 
 module M' = struct
@@ -5754,8 +5485,7 @@ end =
   M
 ;;
 
-(* sound, but should probably fail
-*)
+(* sound, but should probably fail *)
 M1.C'.escaped 'A'
 
 module M2 : sig
@@ -5804,16 +5534,14 @@ struct
   module C = X.C
 end
 
-(* Applicative functors
-*)
+(* Applicative functors *)
 module S = String
 module StringSet = Set.Make (String)
 module SSet = Set.Make (S)
 
 let f (x : StringSet.t) : SSet.t = x
 
-(* Also using include (cf. Leo's mail 2013-11-16)
-*)
+(* Also using include (cf. Leo's mail 2013-11-16) *)
 module F (M : sig end) : sig
   type t
 end = struct
@@ -5855,8 +5583,7 @@ end
 
 module M = struct
   module X = struct end
-  module Y = FF (X) (* XXX
-                    *)
+  module Y = FF (X) (* XXX *)
 
   type t = Y.t
 end
@@ -5875,8 +5602,7 @@ module G = F (M.Y)
 (*module N = G (M);;
   module N = F (M.Y) (M);;*)
 
-(* PR#6307
-*)
+(* PR#6307 *)
 
 module A1 = struct end
 module A2 = struct end
@@ -5892,15 +5618,12 @@ end
 module F (L : module type of L1) = struct end
 module F1 = F (L1)
 
-(* ok
-*)
+(* ok *)
 module F2 = F (L2)
 
-(* should succeed too
-*)
+(* should succeed too *)
 
-(* Counter example: why we need to be careful with PR#6307
-*)
+(* Counter example: why we need to be careful with PR#6307 *)
 module Int = struct
   type t = int
 
@@ -5920,8 +5643,7 @@ end
 
 module type S = module type of M
 
-(* keep alias
-*)
+(* keep alias *)
 
 module Int2 = struct
   type t = int
@@ -5934,8 +5656,7 @@ module type S' = sig
   include S with module I := I
 end
 
-(* fail
-*)
+(* fail *)
 
 (* (* if the above succeeded, one could break invariants *)
    module rec M2 : S' = M2;; (* should succeed! (but this is bad) *)
@@ -5947,11 +5668,9 @@ end
    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 *)
-*)
+   SInt2.mem 2 s';; (* invariants are broken *) *)
 
-(* Check behavior with submodules
-*)
+(* Check behavior with submodules *)
 module M = struct
   module N = struct
     module I = Int
@@ -5984,8 +5703,7 @@ end
 
 module type S = module type of M
 
-(* PR#6365
-*)
+(* PR#6365 *)
 module type S = sig
   module M : sig
     type t
@@ -6004,11 +5722,9 @@ module H' = H
 
 module type S' = S with module M = H'
 
-(* shouldn't introduce an alias
-*)
+(* shouldn't introduce an alias *)
 
-(* PR#6376
-*)
+(* PR#6376 *)
 module type Alias = sig
   module N : sig end
   module M = N
@@ -6022,8 +5738,7 @@ module type A = Alias with module N := F(List)
 
 module rec Bad : A = Bad
 
-(* Shinwell 2014-04-23
-*)
+(* Shinwell 2014-04-23 *)
 module B = struct
   module R = struct
     type t = string
@@ -6039,8 +5754,7 @@ end
 
 let x : K.N.t = "foo"
 
-(* PR#6465
-*)
+(* PR#6465 *)
 
 module M = struct
   type t = A
@@ -6057,8 +5771,7 @@ module P : sig
 end =
   M
 
-(* should be ok
-*)
+(* should be ok *)
 module P : sig
   type t = M.t = A
 
@@ -6098,11 +5811,9 @@ end
 
 module R' : S = R
 
-(* should be ok
-*)
+(* should be ok *)
 
-(* PR#6578
-*)
+(* PR#6578 *)
 
 module M = struct
   let f x = x
@@ -6140,15 +5851,13 @@ 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 *)
 
 include D'
 
 (*
    let () =
-   print_endline (string_of_int D'.M.y)
-*)
+   print_endline (string_of_int D'.M.y) *)
 open A
 
 let f = L.map S.capitalize
@@ -6161,11 +5870,9 @@ 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
-*)
+(* No dependency on D *)
 let x = 3
 
 module M = struct
@@ -6183,13 +5890,11 @@ module type S' = sig
 end
 
 (* ok to convert between structurally equal signatures, and parameters
-   are inferred
-*)
+   are inferred *)
 let f (x : (module S with type t = 'a and type u = 'b)) : (module S') = x
 let g x = (x : (module S with type t = 'a and type u = 'b) :> (module S'))
 
-(* with subtyping it is also ok to forget some types
-*)
+(* with subtyping it is also ok to forget some types *)
 module type S2 = sig
   type u
   type t
@@ -6200,15 +5905,12 @@ let g2 x = (x : (module S2 with type t = 'a and type u = 'b) :> (module S'))
 let h x = (x : (module S2 with type t = 'a) :> (module S with type t = 'a))
 let f2 (x : (module S2 with type t = 'a and type u = 'b)) : (module S') = x
 
-(* fail
-*)
+(* fail *)
 let k (x : (module S2 with type t = 'a)) : (module S with type t = 'a) = x
 
-(* fail
-*)
+(* fail *)
 
-(* but you cannot forget values (no physical coercions)
-*)
+(* but you cannot forget values (no physical coercions) *)
 module type S3 = sig
   type u
   type t
@@ -6218,13 +5920,10 @@ end
 
 let g3 x = (x : (module S3 with type t = 'a and type u = 'b) :> (module S'))
 
-(* fail
-*)
-(* Using generative functors
-*)
+(* fail *)
+(* Using generative functors *)
 
-(* Without type
-*)
+(* Without type *)
 module type S = sig
   val x : int
 end
@@ -6237,19 +5936,15 @@ let v =
 
 module F () = (val v)
 
-(* ok
-*)
+(* ok *)
 module G (X : sig end) : S = F ()
 
-(* ok
-*)
+(* ok *)
 module H (X : sig end) = (val v)
 
-(* ok
-*)
+(* ok *)
 
-(* With type
-*)
+(* With type *)
 module type S = sig
   type t
 
@@ -6266,44 +5961,34 @@ let v =
 
 module F () = (val v)
 
-(* ok
-*)
+(* ok *)
 module G (X : sig end) : S = F ()
 
-(* fail
-*)
+(* fail *)
 module H () = F ()
 
-(* ok
-*)
+(* ok *)
 
-(* Alias
-*)
+(* Alias *)
 module U = struct end
 module M = F (struct end)
 
-(* ok
-*)
+(* ok *)
 module M = F (U)
 
-(* fail
-*)
+(* fail *)
 
-(* Cannot coerce between applicative and generative
-*)
+(* Cannot coerce between applicative and generative *)
 module F1 (X : sig end) = struct end
 module F2 : functor () -> sig end = F1
 
-(* fail
-*)
+(* fail *)
 module F3 () = struct end
 module F4 : functor (X : sig end) -> sig end = F3
 
-(* fail
-*)
+(* fail *)
 
-(* tests for shortened functor notation ()
-*)
+(* tests for shortened functor notation () *)
 module X (X : sig end) (Y : sig end) = functor (Z : sig end) -> struct end
 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
@@ -6377,10 +6062,8 @@ let f (x : entity entity_container) = ()
    method add_entity (s : entity) =
    entity_container#add_entity (s :> entity)
 
-   end
-*)
-(* Two v's in the same class
-*)
+   end *)
+(* Two v's in the same class *)
 class c v =
   object
     initializer print_endline v
@@ -6390,8 +6073,7 @@ class c v =
 
 new c "42"
 
-(* Two hidden v's in the same class!
-*)
+(* Two hidden v's in the same class! *)
 class c (v : int) =
   object
     method v0 = v
@@ -6449,8 +6131,7 @@ class c (x : int) =
 
 let r = (new c 2)#x
 
-(* test.ml
-*)
+(* test.ml *)
 class alfa =
   object (_ : 'self)
     method x : 'a. ('a, out_channel, unit) format -> 'a = Printf.printf
@@ -6468,8 +6149,7 @@ class charlie a =
     initializer y#x "charlie initialized"
   end
 
-(* The module begins
-*)
+(* The module begins *)
 exception Out_of_range
 
 class type ['a] cursor = object
@@ -6665,9 +6345,7 @@ module UText = struct
     done
   ;;
 
-  let concat s1 s2 = s1#concat (s2 (* : #ustorage
-                                   *) :> uchar storage)
-
+  let concat s1 s2 = s1#concat (s2 (* : #ustorage *) :> uchar storage)
   let iter proc s = s#iter proc
 end
 
@@ -6771,8 +6449,7 @@ end
 type refer1 = < poly : 'a 'b 'c. (('b, 'c) #Classdef.cl2 as 'a) >
 type refer2 = < poly : 'a 'b 'c. (('b, 'c) #Classdef.cl2 as 'a) >
 
-(* Actually this should succeed ...
-*)
+(* Actually this should succeed ... *)
 let f (x : refer1) : refer2 = x
 
 module Classdef = struct
@@ -6801,8 +6478,7 @@ end
 (*
    ocamlc -c pr3918a.mli pr3918b.mli
    rm -f pr3918a.cmi
-   ocamlc -c pr3918c.ml
-*)
+   ocamlc -c pr3918c.ml *)
 
 open Pr3918b
 
@@ -6845,8 +6521,7 @@ module Make' (Unit : sig end) : Priv' = struct
 end
 
 module A' = Make' (struct end)
-(* PR5057
-*)
+(* PR5057 *)
 
 module TT = struct
   module IntSet = Set.Make (struct
@@ -6874,8 +6549,7 @@ let () =
   f `A
 ;;
 
-(* This one should fail
-*)
+(* This one should fail *)
 
 let f flag =
   let module T =
@@ -7022,8 +6696,7 @@ end =
 
 let f (x : F0.t) : Foobar.t = x
 
-(* fails
-*)
+(* fails *)
 
 module F = Foobar
 
@@ -7046,8 +6719,7 @@ end =
 
 fun (x : M1.t) : M2.t -> x
 
-(* fails
-*)
+(* fails *)
 
 module M3 : sig
   type t = private M1.t
@@ -7063,22 +6735,19 @@ module M4 : sig
 end =
   M2
 
-(* fails
-*)
+(* fails *)
 module M4 : sig
   type t = private M3.t
 end =
   M
 
-(* fails
-*)
+(* fails *)
 module M4 : sig
   type t = private M3.t
 end =
   M1
 
-(* might be ok
-*)
+(* might be ok *)
 module M5 : sig
   type t = private M1.t
 end =
@@ -7089,8 +6758,7 @@ module M6 : sig
 end =
   M1
 
-(* fails
-*)
+(* fails *)
 
 module Bar : sig
   type t = private Foobar.t
@@ -7102,8 +6770,7 @@ end = struct
   let f (x : int) : t = x
 end
 
-(* must fail
-*)
+(* must fail *)
 
 module M : sig
   type t = private T of int
@@ -7147,8 +6814,7 @@ module M4 : sig
 end =
   M
 
-(* Error: The variant or record definition does not match that of type M.t
-*)
+(* Error: The variant or record definition does not match that of type M.t *)
 
 module M5 : sig
   type t = M.t = private T of int
@@ -7195,8 +6861,7 @@ end = struct
   type 'a t = 'a M.t = private T of 'a
 end
 
-(* PR#6090
-*)
+(* PR#6090 *)
 module Test = struct
   type t = private A
 end
@@ -7207,15 +6872,12 @@ let f (x : Test.t) : Test2.t = x
 let f Test2.A = ()
 let a = Test2.A
 
-(* fail
-*)
+(* fail *)
 (* The following should fail from a semantical point of view,
-   but allow it for backward compatibility
-*)
+   but allow it for backward compatibility *)
 module Test2 : module type of Test with type t = private Test.t = Test
 
-(* PR#6331
-*)
+(* PR#6331 *)
 type t = private < x : int ; .. > as 'a
 type t = private (< x : int ; .. > as 'a) as 'a
 type t = private < x : int > as 'a
@@ -7223,16 +6885,14 @@ type t = private (< x : int > as 'a) as 'b
 type 'a t = private < x : int ; .. > as 'a
 type 'a t = private 'a constraint 'a = < x : int ; .. >
 
-(* Bad (t = t)
-*)
+(* Bad (t = t) *)
 module rec A : sig
   type t = A.t
 end = struct
   type t = A.t
 end
 
-(* Bad (t = t)
-*)
+(* Bad (t = t) *)
 module rec A : sig
   type t = B.t
 end = struct
@@ -7245,8 +6905,7 @@ end = struct
   type t = A.t
 end
 
-(* OK (t = int)
-*)
+(* OK (t = int) *)
 module rec A : sig
   type t = B.t
 end = struct
@@ -7259,16 +6918,14 @@ end = struct
   type t = int
 end
 
-(* Bad (t = int * t)
-*)
+(* Bad (t = int * t) *)
 module rec A : sig
   type t = int * A.t
 end = struct
   type t = int * A.t
 end
 
-(* Bad (t = t -> int)
-*)
+(* Bad (t = t -> int) *)
 module rec A : sig
   type t = B.t -> int
 end = struct
@@ -7281,8 +6938,7 @@ end = struct
   type t = A.t
 end
 
-(* OK (t = <m:t>)
-*)
+(* OK (t = <m:t>) *)
 module rec A : sig
   type t = < m : B.t >
 end = struct
@@ -7295,16 +6951,14 @@ end = struct
   type t = A.t
 end
 
-(* Bad (not regular)
-*)
+(* Bad (not regular) *)
 module rec A : sig
   type 'a t = < m : 'a list A.t >
 end = struct
   type 'a t = < m : 'a list A.t >
 end
 
-(* Bad (not regular)
-*)
+(* Bad (not regular) *)
 module rec A : sig
   type 'a t = < m : 'a list B.t ; n : 'a array B.t >
 end = struct
@@ -7317,8 +6971,7 @@ end = struct
   type 'a t = 'a A.t
 end
 
-(* Bad (not regular)
-*)
+(* Bad (not regular) *)
 module rec A : sig
   type 'a t = 'a B.t
 end = struct
@@ -7331,8 +6984,7 @@ end = struct
   type 'a t = < m : 'a list A.t ; n : 'a array A.t >
 end
 
-(* OK
-*)
+(* OK *)
 module rec A : sig
   type 'a t = 'a array B.t * 'a list B.t
 end = struct
@@ -7345,8 +6997,7 @@ end = struct
   type 'a t = < m : 'a B.t >
 end
 
-(* Bad (not regular)
-*)
+(* Bad (not regular) *)
 module rec A : sig
   type 'a t = 'a list B.t
 end = struct
@@ -7359,8 +7010,7 @@ end = struct
   type 'a t = < m : 'a array B.t >
 end
 
-(* Bad (not regular)
-*)
+(* Bad (not regular) *)
 module rec M : sig
   class ['a] c : 'a -> object
       method map : ('a -> 'b) -> 'b M.c
@@ -7372,8 +7022,7 @@ end = struct
     end
 end
 
-(* OK
-*)
+(* OK *)
 class type ['node] extension = object
   method node : 'node
 end
@@ -7389,8 +7038,7 @@ class x =
 
 type t = x node
 
-(* Bad - PR 4261
-*)
+(* Bad - PR 4261 *)
 
 module PR_4261 = struct
   module type S = sig
@@ -7407,8 +7055,7 @@ module PR_4261 = struct
   and U' : (S with type t = U'.t) = U
 end
 
-(* Bad - PR 4512
-*)
+(* Bad - PR 4512 *)
 module type S' = sig
   type t = int
 end
@@ -7417,8 +7064,7 @@ module rec M : (S' with type t = M.t) = struct
   type t = M.t
 end
 
-(* PR#4450
-*)
+(* PR#4450 *)
 
 module PR_4450_1 = struct
   module type MyT = sig
@@ -7459,8 +7105,7 @@ module PR_4450_2 = struct
 end
 
 (* A synthetic example of bootstrapped data structure
-   (suggested by J-C Filliatre)
-*)
+   (suggested by J-C Filliatre) *)
 
 module type ORD = sig
   type t
@@ -7513,8 +7158,7 @@ module Bootstrap2
 
   let iter f = Diet.iter (Elt.iter f)
 end
-(* PR 4470: simplified from OMake's sources
-*)
+(* PR 4470: simplified from OMake's sources *)
 
 module rec DirElt : sig
   type t =
@@ -7537,8 +7181,7 @@ and DirHash : sig
 end = struct
   type t = DirCompare.t list
 end
-(* PR 4758, PR 4266
-*)
+(* PR 4758, PR 4266 *)
 
 module PR_4758 = struct
   module type S = sig end
@@ -7555,8 +7198,7 @@ module PR_4758 = struct
     module Other = A
   end
 
-  module C' = C (* check that we can take an alias
-                *)
+  module C' = C (* check that we can take an alias *)
 
   module F (X : sig end) = struct
     type t
@@ -7565,8 +7207,7 @@ module PR_4758 = struct
   let f (x : F(C).t) : F(C').t = x
 end
 
-(* PR 4557
-*)
+(* PR 4557 *)
 module PR_4557 = struct
   module F (X : Set.OrderedType) = struct
     module rec Mod : sig
@@ -7626,8 +7267,7 @@ module F (X : Set.OrderedType) = struct
 
   and ModSet : (Set.S with type elt = Mod.t) = Set.Make (Mod)
 end
-(* Tests for recursive modules
-*)
+(* Tests for recursive modules *)
 
 let test number result expected =
   if result = expected
@@ -7636,8 +7276,7 @@ let test number result expected =
   flush stdout
 ;;
 
-(* Tree of sets
-*)
+(* Tree of sets *)
 
 module rec A : sig
   type t =
@@ -7671,8 +7310,7 @@ let _ =
   test 14 (A.compare x y) 1
 ;;
 
-(* Simple value recursion
-*)
+(* Simple value recursion *)
 
 module rec Fib : sig
   val f : int -> int
@@ -7682,8 +7320,7 @@ end
 
 let _ = test 20 (Fib.f 10) 89
 
-(* Update function by infix
-*)
+(* Update function by infix *)
 
 module rec Fib2 : sig
   val f : int -> int
@@ -7694,8 +7331,7 @@ end
 
 let _ = test 21 (Fib2.f 10) 89
 
-(* Early application
-*)
+(* Early application *)
 
 let _ =
   let res =
@@ -7718,18 +7354,15 @@ let _ =
   test 30 res true
 ;;
 
-(* Early strict evaluation
-*)
+(* Early strict evaluation *)
 
 (*
    module rec Cyclic
    : sig val x : int end
    = struct let x = Cyclic.x + 1 end
-   ;;
-*)
+   ;; *)
 
-(* Reordering of evaluation based on dependencies
-*)
+(* Reordering of evaluation based on dependencies *)
 
 module rec After : sig
   val x : int
@@ -7745,8 +7378,7 @@ end
 
 let _ = test 40 After.x 4
 
-(* Type identity between A.t and t within A's definition
-*)
+(* Type identity between A.t and t within A's definition *)
 
 module rec Strengthen : sig
   type t
@@ -7797,8 +7429,7 @@ end = struct
   end
 end
 
-(* Polymorphic recursion
-*)
+(* Polymorphic recursion *)
 
 module rec PolyRec : sig
   type 'a t =
@@ -7819,8 +7450,7 @@ end = struct
   ;;
 end
 
-(* Wrong LHS signatures (PR#4336)
-*)
+(* Wrong LHS signatures (PR#4336) *)
 
 (*
    module type ASig = sig type a val a:a val print:a -> unit end
@@ -7837,8 +7467,7 @@ end
    and NewB : BSig with type b = NewA.a = MakeB (struct end);;
 *)
 
-(* Expressions and bindings
-*)
+(* Expressions and bindings *)
 
 module StringSet = Set.Make (String)
 
@@ -7904,8 +7533,7 @@ let _ =
   test 51 (Expr.simpl e) e'
 ;;
 
-(* Okasaki's bootstrapping
-*)
+(* Okasaki's bootstrapping *)
 
 module type ORDERED = sig
   type t
@@ -8074,8 +7702,7 @@ let _ =
   test 62 (C.findMin (C.deleteMin (C.deleteMin h))) 4
 ;;
 
-(* Classes
-*)
+(* Classes *)
 
 module rec Class1 : sig
   class c : object
@@ -8128,8 +7755,7 @@ let _ =
   | Undefined_recursive_module _ -> test 71 true true
 ;;
 
-(* Coercions
-*)
+(* Coercions *)
 
 module rec Coerce1 : sig
   val g : int -> int
@@ -8186,8 +7812,7 @@ end =
 
 let _ = test 82 (Coerce6.at 100) 5
 
-(* Miscellaneous bug reports
-*)
+(* Miscellaneous bug reports *)
 
 module rec F : sig
   type t =
@@ -8211,8 +7836,7 @@ let _ =
   test 101 (F.f (F.Y 2)) true
 ;;
 
-(* PR#4316
-*)
+(* PR#4316 *)
 module G (S : sig
     val x : int Lazy.t
   end) =
@@ -8232,8 +7856,7 @@ end =
   G (M1)
 
 let _ = test 102 (Lazy.force M2.x) 3
-let _ = Gc.full_major () (* will shortcut forwarding in M1.x
-                         *)
+let _ = Gc.full_major () (* will shortcut forwarding in M1.x *)
 
 module rec M3 : sig
   val x : int Lazy.t
@@ -8251,28 +7874,22 @@ type t =
 
 let f (A r) = r
 
-(* -> escape
-*)
+(* -> escape *)
 let f (A r) = r.x
 
-(* ok
-*)
+(* ok *)
 let f x = A { x; y = x }
 
-(* ok
-*)
+(* ok *)
 let f (A r) = A { r with y = r.x + 1 }
 
-(* ok
-*)
+(* ok *)
 let f () = A { a = 1 }
 
-(* customized error message
-*)
+(* customized error message *)
 let f () = A { x = 1; y = 3 }
 
-(* ok
-*)
+(* ok *)
 
 type _ t =
   | A :
@@ -8283,12 +7900,10 @@ type _ t =
 
 let f (A { x; y }) = A { x; y = () }
 
-(* ok
-*)
+(* ok *)
 let f (A ({ x; y } as r)) = A { x = r.x; y = r.y }
 
-(* ok
-*)
+(* ok *)
 
 module M = struct
   type 'a t =
@@ -8323,8 +7938,7 @@ struct
   module A = (val X.x)
 end
 
-(* -> this expression creates fresh types (not really!)
-*)
+(* -> this expression creates fresh types (not really!) *)
 
 module type S = sig
   exception A of { x : int }
@@ -8371,8 +7985,7 @@ module Z = struct
   type X2.t += A of { x : int }
 end
 
-(* PR#6716
-*)
+(* PR#6716 *)
 
 type _ c = C : [ `A ] c
 type t = T : { x : [< `A ] c } -> t
@@ -8470,8 +8083,7 @@ open Core.Std
 let x = Int.Map.empty
 let y = x + x
 
-(* Avoid ambiguity
-*)
+(* Avoid ambiguity *)
 
 module M = struct
   type t = A
@@ -8529,8 +8141,7 @@ module N2 = struct
   and v = M1.v
 end
 
-(* PR#6566
-*)
+(* PR#6566 *)
 module type PR6566 = sig
   type t = string
 end
@@ -8554,32 +8165,26 @@ module M2 = struct
 end
 
 (* Adapted from: An Expressive Language of Signatures
-   by Norman Ramsey, Kathleen Fisher and Paul Govereau
-*)
+   by Norman Ramsey, Kathleen Fisher and Paul Govereau *)
 
 module type VALUE = sig
-  type value (* a Lua value
-             *)
-  type state (* the state of a Lua interpreter
-             *)
-  type usert (* a user-defined value
-             *)
+  type value (* a Lua value *)
+  type state (* the state of a Lua interpreter *)
+  type usert (* a user-defined value *)
 end
 
 module type CORE0 = sig
   module V : VALUE
 
   val setglobal : V.state -> string -> V.value -> unit
-  (* five more functions common to core and evaluator
-  *)
+  (* five more functions common to core and evaluator *)
 end
 
 module type CORE = sig
   include CORE0
 
   val apply : V.value -> V.state -> V.value list -> V.value
-  (* apply function f in state s to list of args
-  *)
+  (* apply function f in state s to list of args *)
 end
 
 module type AST = sig
@@ -8700,8 +8305,7 @@ module type PrintableComparable = sig
   include Comparable with type t = t
 end
 
-(* Fails
-*)
+(* Fails *)
 module type PrintableComparable = sig
   type t
 
@@ -8759,8 +8363,7 @@ module type S = sig
 end
 with type 'a t := unit
 
-(* Fails
-*)
+(* Fails *)
 let property (type t) () =
   let module M = struct
     exception E of t
@@ -8797,16 +8400,14 @@ let sort_uniq (type s) cmp l =
 let () = print_endline (String.concat "," (sort_uniq compare [ "abc"; "xyz"; "abc" ]))
 let f x (type a) (y : a) = x = y
 
-(* Fails
-*)
+(* Fails *)
 class ['a] c =
   object (self)
     method m : 'a -> 'a = fun x -> x
     method n : 'a -> 'a = fun (type g) (x : g) -> self#m x
   end
 
-(* Fails
-*)
+(* Fails *)
 
 external a : (int[@untagged]) -> unit = "a" "a_nat"
 external b : (int32[@unboxed]) -> unit = "b" "b_nat"
@@ -8835,8 +8436,7 @@ module Global_attributes = struct
   external d : float -> float = "d" "noalloc"
   external e : float -> float = "e"
 
-  (* Should output a warning: no native implementation provided
-  *)
+  (* Should output a warning: no native implementation provided *)
   external f : (int32[@unboxed]) -> (int32[@unboxed]) = "f" "noalloc"
   external g : int32 -> int32 = "g" "g_nat" [@@unboxed] [@@noalloc]
   external h : (int[@untagged]) -> (int[@untagged]) = "h" "h_nat" "noalloc"
@@ -8853,8 +8453,7 @@ module Old_style_warning = struct
   external e : float -> float = "c" "float"
 end
 
-(* Bad: attributes not reported in the interface
-*)
+(* Bad: attributes not reported in the interface *)
 
 module Bad1 : sig
   external f : int -> int = "f" "f_nat"
@@ -8880,8 +8479,7 @@ end = struct
   external f : (float[@unboxed]) -> float = "f" "f_nat"
 end
 
-(* Bad: attributes in the interface but not in the implementation
-*)
+(* Bad: attributes in the interface but not in the implementation *)
 
 module Bad5 : sig
   external f : int -> (int[@untagged]) = "f" "f_nat"
@@ -8907,35 +8505,29 @@ end = struct
   external f : float -> float = "a" "a_nat"
 end
 
-(* Bad: unboxed or untagged with the wrong type
-*)
+(* Bad: unboxed or untagged with the wrong type *)
 
 external g : (float[@untagged]) -> float = "g" "g_nat"
 external h : (int[@unboxed]) -> float = "h" "h_nat"
 
-(* Bad: unboxing the function type
-*)
+(* Bad: unboxing the function type *)
 external i : (int -> float[@unboxed]) = "i" "i_nat"
 
-(* Bad: unboxing a "deep" sub-type.
-*)
+(* Bad: unboxing a "deep" sub-type. *)
 external j : int -> (float[@unboxed]) * float = "j" "j_nat"
 
 (* This should be rejected, but it is quite complicated to do
-   in the current state of things
-*)
+   in the current state of things *)
 
 external k : int -> (float[@unboxd]) = "k" "k_nat"
 
-(* Bad: old style annotations + new style attributes
-*)
+(* Bad: old style annotations + new style attributes *)
 
 external l : float -> float = "l" "l_nat" "float" [@@unboxed]
 external m : (float[@unboxed]) -> float = "m" "m_nat" "float"
 external n : float -> float = "n" "noalloc" [@@noalloc]
 
-(* Warnings: unboxed / untagged without any native implementation
-*)
+(* Warnings: unboxed / untagged without any native implementation *)
 external o : (float[@unboxed]) -> float = "o"
 external p : float -> (float[@unboxed]) = "p"
 external q : (int[@untagged]) -> float = "q"
@@ -8946,15 +8538,13 @@ external t : float -> float = "t" [@@unboxed]
 let _ = ignore ( + )
 let _ = raise Exit 3;;
 
-(* comment 9644 of PR#6000
-*)
+(* comment 9644 of PR#6000 *)
 
 fun b -> if b then format_of_string "x" else "y";;
 fun b -> if b then "x" else format_of_string "y";;
 fun b : (_, _, _) format -> if b then "x" else "y"
 
-(* PR#7135
-*)
+(* PR#7135 *)
 
 module PR7135 = struct
   module M : sig
@@ -8968,8 +8558,7 @@ module PR7135 = struct
   let lift2 (f : int -> int -> int) (x : t) (y : t) = f (x :> int) (y :> int)
 end
 
-(* exemple of non-ground coercion
-*)
+(* exemple of non-ground coercion *)
 
 module Test1 = struct
   type t = private int
@@ -8980,15 +8569,13 @@ module Test1 = struct
   ;;
 end
 
-(* Warn about all relevant cases when possible
-*)
+(* Warn about all relevant cases when possible *)
 let f = function
   | None, None -> 1
   | Some _, Some _ -> 2
 ;;
 
-(* Exhaustiveness check is very slow
-*)
+(* Exhaustiveness check is very slow *)
 type _ t =
   | A : int t
   | B : bool t
@@ -9010,35 +8597,30 @@ let f
     | _, _, _, _, _, _, _, G, _, _ -> 1
 ;;
 
-(*| _ -> _
-*)
+(*| _ -> _ *)
 
-(* Unused cases
-*)
+(* Unused cases *)
 let f (x : int t) =
   match x with
   | A -> 1
   | _ -> 2
 ;;
 
-(* warn
-*)
+(* warn *)
 let f (x : unit t option) =
   match x with
   | None -> 1
   | _ -> 2
 ;;
 
-(* warn?
-*)
+(* warn? *)
 let f (x : unit t option) =
   match x with
   | None -> 1
   | Some _ -> 2
 ;;
 
-(* warn
-*)
+(* warn *)
 let f (x : int t option) =
   match x with
   | None -> 1
@@ -9050,11 +8632,9 @@ let f (x : int t option) =
   | None -> 1
 ;;
 
-(* warn
-*)
+(* warn *)
 
-(* Example with record, type, single case
-*)
+(* Example with record, type, single case *)
 
 type 'a box = Box of 'a
 
@@ -9071,8 +8651,7 @@ let f : (string t box pair * bool) option -> unit = function
   | None -> ()
 ;;
 
-(* Examples from ML2015 paper
-*)
+(* Examples from ML2015 paper *)
 
 type _ t =
   | Int : int t
@@ -9148,8 +8727,7 @@ let inv_zero : type a b c d. (a, b, c) plus -> (c, d, zero) plus -> bool =
   | Plus0, Plus0 -> true
 ;;
 
-(* Empty match
-*)
+(* Empty match *)
 
 type _ t = Int : int t
 
@@ -9158,46 +8736,39 @@ let f (x : bool t) =
   | _ -> .
 ;;
 
-(* ok
-*)
+(* ok *)
 
-(* trefis in PR#6437
-*)
+(* trefis in PR#6437 *)
 
 let f () =
   match None with
   | _ -> .
 ;;
 
-(* error
-*)
+(* error *)
 let g () =
   match None with
   | _ -> ()
   | exception _ -> .
 ;;
 
-(* error
-*)
+(* error *)
 let h () =
   match None with
   | _ -> .
   | exception _ -> .
 ;;
 
-(* error
-*)
+(* error *)
 let f x =
   match x with
   | _ -> ()
   | None -> .
 ;;
 
-(* do not warn
-*)
+(* do not warn *)
 
-(* #7059, all clauses guarded
-*)
+(* #7059, all clauses guarded *)
 
 let f x y =
   match 1 with
@@ -9214,8 +8785,7 @@ let f : label choice -> bool = function
   | Left -> true
 ;;
 
-(* warn
-*)
+(* warn *)
 exception A
 
 type a = A;;
@@ -9267,8 +8837,7 @@ end
 type t = A : t
 
 module X1 : sig end = struct
-  let _f ~x (* x unused argument
-            *) = function
+  let _f ~x (* x unused argument *) = function
     | A ->
       let x = () in
       x
@@ -9276,8 +8845,7 @@ module X1 : sig end = struct
 end
 
 module X2 : sig end = struct
-  let x = 42 (* unused value
-             *)
+  let x = 42 (* unused value *)
 
   let _f = function
     | A ->
@@ -9288,12 +8856,10 @@ end
 
 module X3 : sig end = struct
   module O = struct
-    let x = 42 (* unused
-               *)
+    let x = 42 (* unused *)
   end
 
-  open O (* unused open
-         *)
+  open O (* unused open *)
 
   let _f = function
     | A ->
@@ -9302,8 +8868,7 @@ module X3 : sig end = struct
   ;;
 end
 
-(* Use type information
-*)
+(* Use type information *)
 module M1 = struct
   type t =
     { x : int
@@ -9319,19 +8884,16 @@ end
 module OK = struct
   open M1
 
-  let f1 (r : t) = r.x (* ok
-                       *)
+  let f1 (r : t) = r.x (* ok *)
 
   let f2 r =
     ignore (r : t);
-    r.x (* non principal
-        *)
+    r.x (* non principal *)
   ;;
 
   let f3 (r : t) =
     match r with
-    | { x; y } -> y + y (* ok
-                        *)
+    | { x; y } -> y + y (* ok *)
   ;;
 end
 
@@ -9344,8 +8906,7 @@ module F1 = struct
   ;;
 end
 
-(* fails
-*)
+(* fails *)
 
 module F2 = struct
   open M1
@@ -9357,8 +8918,7 @@ module F2 = struct
   ;;
 end
 
-(* fails for -principal
-*)
+(* fails for -principal *)
 
 (* Use type information with modules*)
 module M = struct
@@ -9368,16 +8928,13 @@ end
 
 let f (r : M.t) = r.M.x
 
-(* ok
-*)
+(* ok *)
 let f (r : M.t) = r.x
 
-(* warning
-*)
+(* warning *)
 let f ({ x } : M.t) = x
 
-(* warning
-*)
+(* warning *)
 
 module M = struct
   type t =
@@ -9416,8 +8973,7 @@ module OK = struct
   let f (r : M.t) = r.x
 end
 
-(* Use field information
-*)
+(* Use field information *)
 module M = struct
   type u =
     { x : bool
@@ -9437,16 +8993,14 @@ module OK = struct
   let f { x; z } = x, z
 end
 
-(* ok
-*)
+(* ok *)
 module F3 = struct
   open M
 
   let r = { x = true; z = 'z' }
 end
 
-(* fail for missing label
-*)
+(* fail for missing label *)
 
 module OK = struct
   type u =
@@ -9463,11 +9017,9 @@ module OK = struct
   let r = { x = 3; y = true }
 end
 
-(* ok
-*)
+(* ok *)
 
-(* Corner cases
-*)
+(* Corner cases *)
 
 module F4 = struct
   type foo =
@@ -9480,8 +9032,7 @@ module F4 = struct
   let b : bar = { x = 3; y = 4 }
 end
 
-(* fail but don't warn
-*)
+(* fail but don't warn *)
 
 module M = struct
   type foo =
@@ -9499,8 +9050,7 @@ end
 
 let r = { M.x = 3; N.y = 4 }
 
-(* error: different definitions
-*)
+(* error: different definitions *)
 
 module MN = struct
   include M
@@ -9514,11 +9064,9 @@ end
 
 let r = { MN.x = 3; NM.y = 4 }
 
-(* error: type would change with order
-*)
+(* error: type would change with order *)
 
-(* Lpw25
-*)
+(* Lpw25 *)
 
 module M = struct
   type foo =
@@ -9577,11 +9125,9 @@ end
 
 let f (r : B.t) = r.A.x
 
-(* fail
-*)
+(* fail *)
 
-(* Spellchecking
-*)
+(* Spellchecking *)
 
 module F8 = struct
   type t =
@@ -9592,8 +9138,7 @@ module F8 = struct
   let a : t = { x = 1; yyz = 2 }
 end
 
-(* PR#6004
-*)
+(* PR#6004 *)
 
 type t = A
 type s = A
@@ -9601,17 +9146,14 @@ type s = A
 class f (_ : t) = object end
 class g = f A
 
-(* ok
-*)
+(* ok *)
 
 class f (_ : 'a) (_ : 'a) = object end
 class g = f (A : t) A
 
-(* warn with -principal
-*)
+(* warn with -principal *)
 
-(* PR#5980
-*)
+(* PR#5980 *)
 
 module Shadow1 = struct
   type t = { x : int }
@@ -9620,8 +9162,7 @@ module Shadow1 = struct
     type s = { x : string }
   end
 
-  open M (* this open is unused, it isn't reported as shadowing 'x'
-         *)
+  open M (* this open is unused, it isn't reported as shadowing 'x' *)
 
   let y : t = { x = 0 }
 end
@@ -9633,14 +9174,12 @@ module Shadow2 = struct
     type s = { x : string }
   end
 
-  open M (* this open shadows label 'x'
-         *)
+  open M (* this open shadows label 'x' *)
 
   let y = { x = "" }
 end
 
-(* PR#6235
-*)
+(* PR#6235 *)
 
 module P6235 = struct
   type t = { loc : string }
@@ -9658,8 +9197,7 @@ module P6235 = struct
   ;;
 end
 
-(* Remove interaction between branches
-*)
+(* Remove interaction between branches *)
 
 module P6235' = struct
   type t = { loc : string }
@@ -9821,15 +9359,12 @@ let () = proj1 (inj2 42)
 let _ = ~-1
 
 class id = [%exp]
-(* checkpoint
-*)
+(* checkpoint *)
 
-(* Subtyping is "syntactic"
-*)
+(* Subtyping is "syntactic" *)
 let _ = fun (x : < x : int >) y z -> (y :> 'a), (x :> 'a), (z :> 'a)
 
-(* - : (< x : int > as 'a) -> 'a -> 'a * 'a = <fun>
-*)
+(* - : (< x : int > as 'a) -> 'a -> 'a * 'a = <fun> *)
 
 class ['a] c () =
   object
@@ -9841,8 +9376,7 @@ and ['a] d () =
     inherit ['a] c ()
   end
 
-(* PR#7329 Pattern open
-*)
+(* PR#7329 Pattern open *)
 let _ =
   let module M = struct
     type t = { x : int }
@@ -9883,8 +9417,7 @@ let g x = ~$(x.contents)
 let ( ~$ ) x y = x, y
 let g x y = ~$(x.contents) y.contents
 
-(* PR#7506: attributes on list tail
-*)
+(* PR#7506: attributes on list tail *)
 
 let tail1 = [ 1; 2 ] [@hello]
 let tail2 = 0 :: ([ 1; 2 ] [@hello])
@@ -9919,13 +9452,11 @@ fun contents -> { contents = contents [@foo] };;
 (();
  ()) [@foo]
 
-(* https://github.com/LexiFi/gen_js_api/issues/61
-*)
+(* https://github.com/LexiFi/gen_js_api/issues/61 *)
 
 let () = foo##.bar := ()
 
-(* "let open" in classes and class types
-*)
+(* "let open" in classes and class types *)
 
 class c =
   let open M in
@@ -9939,8 +9470,7 @@ class type ct =
     method f : t
   end
 
-(* M.(::) notation
-*)
+(* M.(::) notation *)
 module Exotic_list = struct
   module Inner = struct
     type ('a, 'b) t =
@@ -10044,8 +9574,8 @@ exception Second_exception
 
 module M = struct
   type t
-  [@@immediate] (* ______________________________________
-                *) [@@deriving variants, sexp_of]
+  [@@immediate] (* ______________________________________ *)
+  [@@deriving variants, sexp_of]
 end
 
 module type Basic3 = sig
@@ -10076,8 +9606,7 @@ let _ =
   [ very_long_function_name____________________ very_long_argument_name____________ ]
 ;;
 
-(* FIX: exceed 90 columns
-*)
+(* FIX: exceed 90 columns *)
 let _ =
   [%str
     let () = very_long_function_name__________________ very_long_argument_name____________]
@@ -10088,8 +9617,7 @@ let _ =
   }
 ;;
 
-(* FIX: exceed 90 columns
-*)
+(* FIX: exceed 90 columns *)
 let _ =
   match () with
   | _ ->
@@ -10100,27 +9628,24 @@ let _ =
 
 let _ =
   aaaaaaa
-  (* __________________________________________________________________________________
-  *) := bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
+  (* __________________________________________________________________________________ *)
+  := bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
 ;;
 
 let g = f ~x (* this is a multiple-line-spanning
-                comment
-             *) ~y
+                comment *) ~y
 
 let f =
   very_long_function_name
     ~x:very_long_variable_name (* this is a multiple-line-spanning
-                                  comment
-                               *)
+                                  comment *)
     ~y
 ;;
 
 let _ =
   match x with
   | { y =
-        (* _____________________________________________________________________
-        *)
+        (* _____________________________________________________________________ *)
         ( X _ | Y _ )
     } -> ()
 ;;
@@ -10129,8 +9654,7 @@ let _ =
   match x with
   | { y =
         ( Z
-        (* _____________________________________________________________________
-        *)
+        (* _____________________________________________________________________ *)
         | X _
         | Y _ )
     } -> ()
@@ -10138,26 +9662,16 @@ let _ =
 
 type t =
   [ `XXXX
-  (* __________________________________________________________________________________
-  *)
-  | `XXXX (* __________________________________________________________________
-          *)
-  | `XXXX (* _____________________________________________________
-          *)
-  | `XXXX (* ___________________________________________________
-          *)
-  | `XXXX (* ___________________________________________________
-          *)
-  | `XXXX (* ________________________________________________
-          *)
-  | `XXXX (* __________________________________________
-          *)
-  | `XXXX (* _________________________________________
-          *)
-  | `XXXX (* ______________________________________
-          *)
-  | `XXXX (* ____________________________________
-          *)
+  (* __________________________________________________________________________________ *)
+  | `XXXX (* __________________________________________________________________ *)
+  | `XXXX (* _____________________________________________________ *)
+  | `XXXX (* ___________________________________________________ *)
+  | `XXXX (* ___________________________________________________ *)
+  | `XXXX (* ________________________________________________ *)
+  | `XXXX (* __________________________________________ *)
+  | `XXXX (* _________________________________________ *)
+  | `XXXX (* ______________________________________ *)
+  | `XXXX (* ____________________________________ *)
   ]
 
 type t =
@@ -10182,8 +9696,7 @@ module Intro_sort = struct
           4-----o--------o--o--|-----o--4
                 |              |     |
           5-----o--------------o-----o--5
-       v}
-    *)
+       v} *)
     foooooooooo fooooo fooo;
     foooooooooo fooooo fooo;
     foooooooooo fooooo fooo
@@ -10203,8 +9716,7 @@ let nullsafe_optimistic_third_party_params_in_non_strict =
        there was no actionable way to change third party annotations. Now
        that we have such a support, this behavior should be reconsidered,
        provided our tooling and error reporting is friendly enough to be
-       smoothly used by developers.
-    *)
+       smoothly used by developers. *)
     ~default:true
     "Nullsafe: in this mode we treat non annotated third party method params as if they \
      were annotated as nullable."
@@ -10212,8 +9724,7 @@ let nullsafe_optimistic_third_party_params_in_non_strict =
 
 let foo () =
   if%bind
-    (* this is a medium length comment of some sort
-    *)
+    (* this is a medium length comment of some sort *)
     this is a medium length expression of_some sort
   then x
   else y
@@ -10221,35 +9732,31 @@ let foo () =
 
 let xxxxxx =
   let%map (* _____________________________
-             __________
-          *) () = yyyyyyyy in
+             __________ *) () = yyyyyyyy in
   { zzzzzzzzzzzzz }
 ;;
 
 let _ =
   match x with
   | _
-    when f ~f:(function [@ocaml.warning (* .......................................
-                                        *) "-4"] _ -> .) -> y
+    when f
+           ~f:(function [@ocaml.warning
+              (* ....................................... *) "-4"] _ -> .) -> y
 ;;
 
 let[@a
-   (* .............................................. ........................... .......................... ......................
-   *)
+   (* .............................................. ........................... .......................... ...................... *)
   foo
   (* ....................... *)
   (* ................................. *)
   (* ...................... *)] _
   =
-  match[@ocaml.warning (* .......................................
-                       *) "-4"]
-    x [@attr (* .......................... ..................
-             *) some_attr]
+  match[@ocaml.warning (* ....................................... *) "-4"]
+    x [@attr (* .......................... .................. *) some_attr]
   with
   | _
     when f
-           ~f:(function[@ocaml.warning (* .......................................
-                                       *) "-4"]
+           ~f:(function[@ocaml.warning (* ....................................... *) "-4"]
              | _ -> .)
            ~f:(function[@ocaml.warning
               (* ....................................... *)
@@ -10258,8 +9765,7 @@ let[@a
               fooooooooooooooooooooooooooooooooooooo"]
              | _ -> .)
            ~f:(function[@ocaml.warning
-              (* .......................................
-              *)
+              (* ....................................... *)
              let x = a
              and y = b in
              x + y]
@@ -10267,8 +9773,7 @@ let[@a
     y [@attr
        (* ... *)
       (* ... *)
-      attr (* ...
-           *)]
+      attr (* ... *)]
 ;;
 
 let x =
@@ -10587,8 +10092,7 @@ let () =
   | _ -> ()
 ;;
 
-(* ocp-indent-compat: Docked fun after apply only if on the same line.
-*)
+(* ocp-indent-compat: Docked fun after apply only if on the same line. *)
 
 let _ =
   fooooooooooooooooooooooooooooooo
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index 54d9777095..3a292b4105 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -77,8 +77,7 @@ and _ = ()
 
 let%foo _ = ()
 
-(* Expressions
-  *)
+(* Expressions *)
 let () =
   let%foo[@foo] x = 3
   and[@foo] y = 4 in
@@ -114,14 +113,12 @@ let () =
   [%foo new x [@foo]];
   [%foo
     match[@foo] () with
-    | [%foo? (* Pattern expressions
-               *)
+    | [%foo? (* Pattern expressions *)
         ((lazy x) [@foo])] -> ()
     | [%foo? ((exception x) [@foo])] -> ()]
 ;;
 
-(* Class expressions
-  *)
+(* Class expressions *)
 class x =
   fun [@foo] x ->
   let[@foo] x = 3 in
@@ -136,8 +133,7 @@ class x =
     initializer x [@@foo]
   end [@foo]
 
-(* Class type expressions
-  *)
+(* Class type expressions *)
 class type t = object
   inherit t [@@foo]
   val x : t [@@foo]
@@ -150,16 +146,13 @@ class type t = object
   [@@@aaa]
 end[@foo]
 
-(* Type expressions
-  *)
+(* Type expressions *)
 type t = [%foo: ((module M)[@foo])]
 
-(* Module expressions
-  *)
+(* Module expressions *)
 module M = (functor [@foo] (M : S) -> (val x) [@foo] (struct end [@foo]))
 
-(* Module type expression
-  *)
+(* Module type expression *)
 module type S = functor [@foo] (M : S) -> functor (_ : (module type of M) [@foo]) -> sig end
 [@foo]
 
@@ -175,8 +168,7 @@ module type S = sig
   and B : (S with type t = t)
 end
 
-(* Structure items
-  *)
+(* Structure items *)
 let%foo[@foo] x = 4
 and[@foo] y = x
 
@@ -197,8 +189,7 @@ module type%foo S = S [@@foo]
 include%foo M [@@foo]
 open%foo M [@@foo]
 
-(* Signature items
-  *)
+(* Signature items *)
 module type S = sig
   val%foo x : t [@@foo]
   external%foo x : t = "" [@@foo]
@@ -235,8 +226,7 @@ open M;;
 
 ([%extension_constructor A] : extension_constructor)
 
-(* By using two types we can have a recursive constraint
-  *)
+(* By using two types we can have a recursive constraint *)
 type 'a class_name = .. constraint 'a = < cast : 'a. 'a name -> 'a ; .. >
 and 'a name = Class : 'a class_name -> (< cast : 'a. 'a name -> 'a ; .. > as 'a) name
 
@@ -265,8 +255,7 @@ class foo : foo_t =
     method foo = "foo"
   end
 
-(* Now we can create a subclass of foo
-  *)
+(* Now we can create a subclass of foo *)
 
 class type bar_t = object
   inherit foo
@@ -289,8 +278,7 @@ class bar : bar_t =
     [%%id]
   end
 
-(* Now lets create a mutable list of castable objects
-  *)
+(* Now lets create a mutable list of castable objects *)
 
 let clist : castable list ref = ref []
 let push_castable (c : #castable) = clist := (c :> castable) :: !clist
@@ -303,8 +291,7 @@ let pop_castable () =
   | [] -> raise Not_found
 ;;
 
-(* We can add foos and bars to this list, and retrive them
-  *)
+(* We can add foos and bars to this list, and retrive them *)
 
 push_castable (new foo);;
 push_castable (new bar);;
@@ -314,34 +301,27 @@ let c1 : castable = pop_castable ()
 let c2 : castable = pop_castable ()
 let c3 : castable = pop_castable ()
 
-(* We can also downcast these values to foos and bars
-  *)
+(* We can also downcast these values to foos and bars *)
 
 let f1 : foo = c1#cast (Class Foo)
 
-(* Ok
-  *)
+(* Ok *)
 let f2 : foo = c2#cast (Class Foo)
 
-(* Ok
-  *)
+(* Ok *)
 let f3 : foo = c3#cast (Class Foo)
 
-(* Ok
-  *)
+(* Ok *)
 
 let b1 : bar = c1#cast (Class Bar)
 
-(* Exception Bad_cast
-  *)
+(* Exception Bad_cast *)
 let b2 : bar = c2#cast (Class Bar)
 
-(* Ok
-  *)
+(* Ok *)
 let b3 : bar = c3#cast (Class Bar)
 
-(* Exception Bad_cast
-  *)
+(* Exception Bad_cast *)
 
 type foo = ..
 type foo += A | B of int
@@ -352,39 +332,31 @@ let is_a x =
   | _ -> false
 ;;
 
-(* The type must be open to create extension
-  *)
+(* The type must be open to create extension *)
 
 type foo
-type foo += A of int (* Error type is not open
-                       *)
+type foo += A of int (* Error type is not open *)
 
-(* The type parameters must match
-  *)
+(* The type parameters must match *)
 
 type 'a foo = ..
-type ('a, 'b) foo += A of int (* Error: type parameter mismatch
-                                *)
+type ('a, 'b) foo += A of int (* Error: type parameter mismatch *)
 
-(* In a signature the type does not have to be open
-  *)
+(* In a signature the type does not have to be open *)
 
 module type S = sig
   type foo
   type foo += A of float
 end
 
-(* But it must still be extensible
-  *)
+(* But it must still be extensible *)
 
 module type S = sig
   type foo = A of int
-  type foo += B of float (* Error foo does not have an extensible type
-                           *)
+  type foo += B of float (* Error foo does not have an extensible type *)
 end
 
-(* Signatures can change the grouping of extensions
-  *)
+(* Signatures can change the grouping of extensions *)
 
 type foo = ..
 
@@ -401,8 +373,7 @@ end
 
 module M_S : S = M
 
-(* Extensions can be GADTs
-  *)
+(* Extensions can be GADTs *)
 
 type 'a foo = ..
 type _ foo += A : int -> int foo | B : int foo
@@ -414,20 +385,16 @@ let get_num : type a. a foo -> a -> a option =
   | _ -> None
 ;;
 
-(* Extensions must obey constraints
-  *)
+(* Extensions must obey constraints *)
 
 type 'a foo = .. constraint 'a = [> `Var ]
 type 'a foo += A of 'a
 
-let a = A 9 (* ERROR: Constraints not met
-              *)
+let a = A 9 (* ERROR: Constraints not met *)
 
-type 'a foo += B : int foo (* ERROR: Constraints not met
-                             *)
+type 'a foo += B : int foo (* ERROR: Constraints not met *)
 
-(* Signatures can make an extension private
-  *)
+(* Signatures can make an extension private *)
 
 type foo = ..
 
@@ -449,11 +416,9 @@ let is_s x =
   | _ -> false
 ;;
 
-let a2 = M_S.A 20 (* ERROR: Cannot create a value using a private constructor
-                    *)
+let a2 = M_S.A 20 (* ERROR: Cannot create a value using a private constructor *)
 
-(* Extensions can be rebound
-  *)
+(* Extensions can be rebound *)
 
 type foo = ..
 
@@ -463,21 +428,17 @@ end
 
 type foo += A2 = M.A1
 type bar = ..
-type bar += A3 = M.A1 (* Error: rebind wrong type
-                        *)
+type bar += A3 = M.A1 (* Error: rebind wrong type *)
 
 module M = struct
   type foo += private B1 of int
 end
 
 type foo += private B2 = M.B1
-type foo += B3 = M.B1 (* Error: rebind private extension
-                        *)
-type foo += C = Unknown (* Error: unbound extension
-                          *)
+type foo += B3 = M.B1 (* Error: rebind private extension *)
+type foo += C = Unknown (* Error: unbound extension *)
 
-(* Extensions can be rebound even if type is closed
-  *)
+(* Extensions can be rebound even if type is closed *)
 
 module M : sig
   type foo
@@ -489,8 +450,7 @@ end
 
 type M.foo += A2 = M.A1
 
-(* Rebinding handles abbreviations
-  *)
+(* Rebinding handles abbreviations *)
 
 type 'a foo = ..
 type 'a foo1 = 'a foo = ..
@@ -498,25 +458,20 @@ type 'a foo2 = 'a foo = ..
 type 'a foo1 += A of int | B of 'a | C : int foo1
 type 'a foo2 += D = A | E = B | F = C
 
-(* Extensions must obey variances
-  *)
+(* Extensions must obey variances *)
 
 type +'a foo = ..
 type 'a foo += A of (int -> 'a)
 type 'a foo += B of ('a -> int)
-(* ERROR: Parameter variances are not satisfied
-  *)
+(* ERROR: Parameter variances are not satisfied *)
 
 type _ foo += C : ('a -> int) -> 'a foo
-(* ERROR: Parameter variances are not satisfied
-  *)
+(* ERROR: Parameter variances are not satisfied *)
 
 type 'a bar = ..
-type +'a bar += D of (int -> 'a) (* ERROR: type variances do not match
-                                   *)
+type +'a bar += D of (int -> 'a) (* ERROR: type variances do not match *)
 
-(* Exceptions are compatible with extensions
-  *)
+(* Exceptions are compatible with extensions *)
 
 module M : sig
   type exn += Foo of int * float | Bar : 'a list -> exn
@@ -542,33 +497,27 @@ end = struct
   exception Foo = Foo
 end
 
-(* Test toplevel printing
-  *)
+(* Test toplevel printing *)
 
 type foo = ..
 type foo += Foo of int * int option | Bar of int option
 
-let x = Foo (3, Some 4), Bar (Some 5) (* Prints Foo and Bar successfully
-                                        *)
+let x = Foo (3, Some 4), Bar (Some 5) (* Prints Foo and Bar successfully *)
 
 type foo += Foo of string
 
-let y = x (* Prints Bar but not Foo (which has been shadowed)
-            *)
+let y = x (* Prints Bar but not Foo (which has been shadowed) *)
 
 exception Foo of int * int option
 exception Bar of int option
 
-let x = Foo (3, Some 4), Bar (Some 5) (* Prints Foo and Bar successfully
-                                        *)
+let x = Foo (3, Some 4), Bar (Some 5) (* Prints Foo and Bar successfully *)
 
 type foo += Foo of string
 
-let y = x (* Prints Bar and part of Foo (which has been shadowed)
-            *)
+let y = x (* Prints Bar and part of Foo (which has been shadowed) *)
 
-(* Test Obj functions
-  *)
+(* Test Obj functions *)
 
 type foo = ..
 type foo += Foo | Bar of int
@@ -577,17 +526,14 @@ let extension_name e = Obj.extension_name (Obj.extension_constructor e)
 let extension_id e = Obj.extension_id (Obj.extension_constructor e)
 let n1 = extension_name Foo
 let n2 = extension_name (Bar 1)
-let t = extension_id (Bar 2) = extension_id (Bar 3) (* true
-                                                      *)
-let f = extension_id (Bar 2) = extension_id Foo (* false
-                                                  *)
+let t = extension_id (Bar 2) = extension_id (Bar 3) (* true *)
+let f = extension_id (Bar 2) = extension_id Foo (* false *)
 let is_foo x = extension_id Foo = extension_id x
 
 type foo += Foo
 
 let f = is_foo Foo
-let _ = Obj.extension_constructor 7 (* Invald_arg
-                                      *)
+let _ = Obj.extension_constructor 7 (* Invald_arg *)
 
 let _ =
   Obj.extension_constructor
@@ -596,11 +542,9 @@ let _ =
     end)
 ;;
 
-(* Invald_arg
-  *)
+(* Invald_arg *)
 
-(* Typed names
-  *)
+(* Typed names *)
 
 module Msg : sig
   type 'a tag
@@ -658,8 +602,7 @@ end = struct
     write_raw k.label content
   ;;
 
-  (* Add int kind
-    *)
+  (* Add int kind *)
 
   type 'a tag += Int : int tag
 
@@ -675,8 +618,7 @@ end = struct
     Hashtbl.add writeTbl (T Int) { f }
   ;;
 
-  (* Support user defined kinds
-    *)
+  (* Support user defined kinds *)
 
   module type Desc = sig
     type t
@@ -725,8 +667,7 @@ let read_one () =
   | _ -> print_string "Unknown"
 ;;
 
-(* Example of algorithm parametrized with modules
-  *)
+(* Example of algorithm parametrized with modules *)
 
 let sort (type s) set l =
   let module Set = (val set : Set.S with type elt = s) in
@@ -753,8 +694,7 @@ let () =
     (String.concat "  " (List.map (String.concat "/") (both [ "abc"; "xyz"; "def" ])))
 ;;
 
-(* Hiding the internal representation
-  *)
+(* Hiding the internal representation *)
 
 module type S = sig
   type t
@@ -803,8 +743,7 @@ let () =
   List.iter print (List.map apply [ int; apply int; apply (apply str) ])
 ;;
 
-(* Existential types + type equality witnesses -> pseudo GADT
-  *)
+(* Existential types + type equality witnesses -> pseudo GADT *)
 
 module TypEq : sig
   type ('a, 'b) t
@@ -891,8 +830,7 @@ let () =
   print_endline (Print.to_string (pair int (pair str int)) (123, ("A", 456)))
 ;;
 
-(* #6262: first-class modules and module type aliases
-  *)
+(* #6262: first-class modules and module type aliases *)
 
 module type S1 = sig end
 module type S2 = S1
@@ -909,8 +847,7 @@ end
 
 let _f (x : (module X.S)) : (module Y.S) = x
 
-(* PR#6194, main example
-  *)
+(* PR#6194, main example *)
 module type S3 = sig
   val x : bool
 end
@@ -938,8 +875,7 @@ let fbool (type t) (x : t) (tag : t ty) =
   | Bool -> x
 ;;
 
-(* val fbool : 'a -> 'a ty -> 'a = <fun>
-  *)
+(* val fbool : 'a -> 'a ty -> 'a = <fun> *)
 
 (** OK: the return value is x of type t **)
 
@@ -948,8 +884,7 @@ let fint (type t) (x : t) (tag : t ty) =
   | Int -> x > 0
 ;;
 
-(* val fint : 'a -> 'a ty -> bool = <fun>
-  *)
+(* val fint : 'a -> 'a ty -> bool = <fun> *)
 
 (** OK: the return value is x > 0 of type bool;
     This has used the equation t = bool, not visible in the return type **)
@@ -960,8 +895,7 @@ let f (type t) (x : t) (tag : t ty) =
   | Bool -> x
 ;;
 
-(* val f : 'a -> 'a ty -> bool = <fun>
-  *)
+(* val f : 'a -> 'a ty -> bool = <fun> *)
 
 let g (type t) (x : t) (tag : t ty) =
   match tag with
@@ -970,8 +904,7 @@ let g (type t) (x : t) (tag : t ty) =
 ;;
 
 (* Error: This expression has type bool but an expression was expected of type
-   t = int
-  *)
+   t = int *)
 
 let id x = x
 
@@ -1001,8 +934,7 @@ let g (type t) (x : t) (tag : t ty) =
 (* (c) Alain Frisch / Lexifi *)
 (* cf. http://www.lexifi.com/blog/dynamic-types *)
 
-(* Basic tag
-  *)
+(* Basic tag *)
 
 type 'a ty =
   | Int : int ty
@@ -1010,8 +942,7 @@ type 'a ty =
   | List : 'a ty -> 'a list ty
   | Pair : ('a ty * 'b ty) -> ('a * 'b) ty
 
-(* Tagging data
-  *)
+(* Tagging data *)
 
 type variant =
   | VInt of int
@@ -1021,20 +952,15 @@ type variant =
 
 let rec variantize : type t. t ty -> t -> variant =
   fun ty x ->
-  (* type t is abstract here
-    *)
+  (* type t is abstract here *)
   match ty with
-  | Int -> VInt x (* in this branch: t = int
-                    *)
-  | String -> VString x (* t = string
-                          *)
-  | List ty1 -> VList (List.map (variantize ty1) x) (* t = 'a list for some 'a
-                                                      *)
+  | Int -> VInt x (* in this branch: t = int *)
+  | String -> VString x (* t = string *)
+  | List ty1 -> VList (List.map (variantize ty1) x) (* t = 'a list for some 'a *)
   | Pair (ty1, ty2) -> VPair (variantize ty1 (fst x), variantize ty2 (snd x))
 ;;
 
-(* t = ('a, 'b) for some 'a and 'b
-  *)
+(* t = ('a, 'b) for some 'a and 'b *)
 
 exception VariantMismatch
 
@@ -1048,8 +974,7 @@ let rec devariantize : type t. t ty -> variant -> t =
   | _ -> raise VariantMismatch
 ;;
 
-(* Handling records
-  *)
+(* Handling records *)
 
 type 'a ty =
   | Int : int ty
@@ -1071,8 +996,7 @@ and ('a, 'b) field =
   ; get : 'a -> 'b
   }
 
-(* Again
-  *)
+(* Again *)
 
 type variant =
   | VInt of int
@@ -1083,19 +1007,14 @@ type variant =
 
 let rec variantize : type t. t ty -> t -> variant =
   fun ty x ->
-  (* type t is abstract here
-    *)
+  (* type t is abstract here *)
   match ty with
-  | Int -> VInt x (* in this branch: t = int
-                    *)
-  | String -> VString x (* t = string
-                          *)
-  | List ty1 -> VList (List.map (variantize ty1) x) (* t = 'a list for some 'a
-                                                      *)
+  | Int -> VInt x (* in this branch: t = int *)
+  | String -> VString x (* t = string *)
+  | List ty1 -> VList (List.map (variantize ty1) x) (* t = 'a list for some 'a *)
   | Pair (ty1, ty2) ->
     VPair (variantize ty1 (fst x), variantize ty2 (snd x))
-    (* t = ('a, 'b) for some 'a and 'b
-      *)
+    (* t = ('a, 'b) for some 'a and 'b *)
   | Record { fields } ->
     VRecord
       (List.map
@@ -1103,8 +1022,7 @@ let rec variantize : type t. t ty -> t -> variant =
          fields)
 ;;
 
-(* Extraction
-  *)
+(* Extraction *)
 
 type 'a ty =
   | Int : int ty
@@ -1190,16 +1108,13 @@ type (_, _) ty =
   | List : ('a, 'e) ty -> ('a list, 'e) ty
   | Option : ('a, 'e) ty -> ('a option, 'e) ty
   | Pair : (('a, 'e) ty * ('b, 'e) ty) -> ('a * 'b, 'e) ty
-  (* Support for type variables and recursive types
-    *)
+  (* Support for type variables and recursive types *)
   | Var : ('a, 'a -> 'e) ty
   | Rec : ('a, 'a -> 'e) ty -> ('a, 'e) ty
   | Pop : ('a, 'e) ty -> ('a, 'b -> 'e) ty
-  (* Change the representation of a type
-    *)
+  (* Change the representation of a type *)
   | Conv : string * ('a -> 'b) * ('b -> 'a) * ('b, 'e) ty -> ('a, 'e) ty
-  (* Sum types (both normal sums and polymorphic variants)
-    *)
+  (* Sum types (both normal sums and polymorphic variants) *)
   | Sum : ('a, 'e, 'b) ty_sum -> ('a, 'e) ty
 
 and ('a, 'e, 'b) ty_sum =
@@ -1208,30 +1123,25 @@ and ('a, 'e, 'b) ty_sum =
   ; sum_inj : 'c. ('b, 'c) ty_sel * 'c -> 'a
   }
 
-and 'e ty_dyn = (* dynamic type
-                  *)
+and 'e ty_dyn = (* dynamic type *)
   | Tdyn : ('a, 'e) ty * 'a -> 'e ty_dyn
 
 and (_, _) ty_sel =
-  (* selector from a list of types
-    *)
+  (* selector from a list of types *)
   | Thd : ('a -> 'b, 'a) ty_sel
   | Ttl : ('b -> 'c, 'd) ty_sel -> ('a -> 'b -> 'c, 'd) ty_sel
 
 and (_, _) ty_case =
-  (* type a sum case
-    *)
+  (* type a sum case *)
   | TCarg : ('b, 'a) ty_sel * ('a, 'e) ty -> ('e, 'b) ty_case
   | TCnoarg : ('b, noarg) ty_sel -> ('e, 'b) ty_case
 
 type _ ty_env =
-  (* type variable substitution
-    *)
+  (* type variable substitution *)
   | Enil : unit ty_env
   | Econs : ('a, 'e) ty * 'e ty_env -> ('a -> 'e) ty_env
 
-(* Comparing selectors
-  *)
+(* Comparing selectors *)
 type (_, _) eq = Eq : ('a, 'a) eq
 
 let rec eq_sel : type a b c. (a, b) ty_sel -> (a, c) ty_sel -> (b, c) eq option =
@@ -1245,8 +1155,7 @@ let rec eq_sel : type a b c. (a, b) ty_sel -> (a, c) ty_sel -> (b, c) eq option
   | _ -> None
 ;;
 
-(* Auxiliary function to get the type of a case from its selector
-  *)
+(* Auxiliary function to get the type of a case from its selector *)
 let rec get_case
   : type a b e.
     (b, a) ty_sel -> (string * (e, b) ty_case) list -> string * (a, e) ty option
@@ -1264,8 +1173,7 @@ let rec get_case
   | [] -> raise Not_found
 ;;
 
-(* Untyped representation of values
-  *)
+(* Untyped representation of values *)
 type variant =
   | VInt of int
   | VString of string
@@ -1332,15 +1240,13 @@ let rec devariantize : type t e. e ty_env -> (t, e) ty -> variant -> t =
   | _ -> raise VariantMismatch
 ;;
 
-(* First attempt: represent 1-constructor variants using Conv
-  *)
+(* First attempt: represent 1-constructor variants using Conv *)
 let wrap_A t = Conv ("`A", (fun (`A x) -> x), (fun x -> `A x), t)
 let ty a = Rec (wrap_A (Option (Pair (a, Var))))
 let v = variantize Enil (ty Int)
 let x = v (`A (Some (1, `A (Some (2, `A None)))))
 
-(* Can also use it to decompose a tuple
-  *)
+(* Can also use it to decompose a tuple *)
 
 let triple t1 t2 t3 =
   Conv
@@ -1352,17 +1258,14 @@ let triple t1 t2 t3 =
 
 let v = variantize Enil (triple String Int Int) ("A", 2, 3)
 
-(* Second attempt: introduce a real sum construct
-  *)
+(* Second attempt: introduce a real sum construct *)
 let ty_abc =
-  (* Could also use [get_case] for proj, but direct definition is shorter
-    *)
+  (* Could also use [get_case] for proj, but direct definition is shorter *)
   let proj = function
     | `A n -> "A", Some (Tdyn (Int, n))
     | `B s -> "B", Some (Tdyn (String, s))
     | `C -> "C", None
-  (* Define inj in advance to be able to write the type annotation easily
-    *)
+  (* Define inj in advance to be able to write the type annotation easily *)
   and inj
     : type c.
       (int -> string -> noarg -> unit, c) ty_sel * c -> [ `A of int | `B of string | `C ]
@@ -1371,8 +1274,7 @@ let ty_abc =
     | Ttl Thd, v -> `B v
     | Ttl (Ttl Thd), Noarg -> `C
   in
-  (* Coherence of sum_inj and sum_cases is checked by the typing
-    *)
+  (* Coherence of sum_inj and sum_cases is checked by the typing *)
   Sum
     { sum_proj = proj
     ; sum_inj = inj
@@ -1387,8 +1289,7 @@ let ty_abc =
 let v = variantize Enil ty_abc (`A 3)
 let a = devariantize Enil ty_abc v
 
-(* And an example with recursion...
-  *)
+(* And an example with recursion... *)
 type 'a vlist =
   [ `Nil
   | `Cons of 'a * 'a vlist
@@ -1409,15 +1310,13 @@ let ty_list : type a e. (a, e) ty -> (a vlist, e) ty =
               function
              | Thd, Noarg -> `Nil
              | Ttl Thd, v -> `Cons v)
-           (* One can also write the type annotation directly
-             *)
+           (* One can also write the type annotation directly *)
        })
 ;;
 
 let v = variantize Enil (ty_list Int) (`Cons (1, `Cons (2, `Nil)))
 
-(* Simpler but weaker approach
-  *)
+(* Simpler but weaker approach *)
 
 type (_, _) ty =
   | Int : (int, _) ty
@@ -1436,8 +1335,7 @@ type (_, _) ty =
 and 'e ty_dyn = Tdyn : ('a, 'e) ty * 'a -> 'e ty_dyn
 
 let ty_abc : ([ `A of int | `B of string | `C ], 'e) ty =
-  (* Could also use [get_case] for proj, but direct definition is shorter
-    *)
+  (* Could also use [get_case] for proj, but direct definition is shorter *)
   Sum
     ( (function
        | `A n -> "A", Some (Tdyn (Int, n))
@@ -1450,8 +1348,7 @@ let ty_abc : ([ `A of int | `B of string | `C ], 'e) ty =
       | _ -> invalid_arg "ty_abc" )
 ;;
 
-(* Breaks: no way to pattern-match on a full recursive type
-  *)
+(* Breaks: no way to pattern-match on a full recursive type *)
 let ty_list : type a e. (a, e) ty -> (a vlist, e) ty =
   fun t ->
   let targ = Pair (Pop t, Var) in
@@ -1465,8 +1362,7 @@ let ty_list : type a e. (a, e) ty -> (a vlist, e) ty =
          | "Cons", Some (Tdyn (Pair (_, Var), (p : a * a vlist))) -> `Cons p ))
 ;;
 
-(* Define Sum using object instead of record for first-class polymorphism
-  *)
+(* Define Sum using object instead of record for first-class polymorphism *)
 
 type (_, _) ty =
   | Int : (int, _) ty
@@ -1552,17 +1448,14 @@ let ty_list : type a e. (a, e) ty -> (a vlist, e) ty =
      and (_,_) ty_pvar =
      | Pnil : ('a,'e) ty_pvar
      | Pconst : 't * ('b,'e) ty_pvar -> ('t -> 'b, 'e) ty_pvar
-     | Parg : 't * ('a,'e) ty * ('b,'e) ty_pvar -> ('t * 'a -> 'b, 'e) ty_pvar
-  *)
+     | Parg : 't * ('a,'e) ty * ('b,'e) ty_pvar -> ('t * 'a -> 'b, 'e) ty_pvar *)
 (*
      An attempt at encoding omega examples from the 2nd Central European
      Functional Programming School:
      Generic Programming in Omega, by Tim Sheard and Nathan Linger
-     http://web.cecs.pdx.edu/~sheard/
-  *)
+     http://web.cecs.pdx.edu/~sheard/ *)
 
-(* Basic types
-  *)
+(* Basic types *)
 
 type ('a, 'b) sum =
   | Inl of 'a
@@ -1575,8 +1468,7 @@ type _ nat =
   | NZ : zero nat
   | NS : 'a nat -> 'a succ nat
 
-(* 2: A simple example
-  *)
+(* 2: A simple example *)
 
 type (_, _) seq =
   | Snil : ('a, zero) seq
@@ -1587,8 +1479,7 @@ let l1 = Scons (3, Scons (5, Snil))
 (* We do not have type level functions, so we need to use witnesses. *)
 (* We copy here the definitions from section 3.9 *)
 (* Note the addition of the ['a nat] argument to PlusZ, since we do not
-   have kinds
-  *)
+   have kinds *)
 type (_, _, _) plus =
   | PlusZ : 'a nat -> (zero, 'a, 'a) plus
   | PlusS : ('a, 'b, 'c) plus -> ('a succ, 'b, 'c succ) plus
@@ -1599,8 +1490,7 @@ let rec length : type a n. (a, n) seq -> n nat = function
 ;;
 
 (* app returns the catenated lists with a witness proving that
-   the size is the sum of its two inputs
-  *)
+   the size is the sum of its two inputs *)
 type (_, _, _) app = App : ('a, 'p) seq * ('n, 'm, 'p) plus -> ('a, 'n, 'm) app
 
 let rec app : type a n m. (a, n) seq -> (a, m) seq -> (a, n, m) app =
@@ -1612,11 +1502,9 @@ let rec app : type a n m. (a, n) seq -> (a, m) seq -> (a, n, m) app =
     App (Scons (x, xs''), PlusS pl)
 ;;
 
-(* 3.1 Feature: kinds
-  *)
+(* 3.1 Feature: kinds *)
 
-(* We do not have kinds, but we can encode them as predicates
-  *)
+(* We do not have kinds, but we can encode them as predicates *)
 
 type tp = TP
 type nd = ND
@@ -1634,8 +1522,7 @@ type _ boolean =
   | BT : tt boolean
   | BF : ff boolean
 
-(* 3.3 Feature : GADTs
-  *)
+(* 3.3 Feature : GADTs *)
 
 type (_, _) path =
   | Pnone : 'a -> (tp, 'a) path
@@ -1668,8 +1555,7 @@ let rec extract : type sh. (sh, 'a) path -> (sh, 'a) tree -> 'a =
   | Pright p, Tfork (_, r) -> extract p r
 ;;
 
-(* 3.4 Pattern : Witness
-  *)
+(* 3.4 Pattern : Witness *)
 
 type (_, _) le =
   | LeZ : 'a nat -> (zero, 'a) le
@@ -1696,8 +1582,7 @@ let rec summandLessThanSum : type a b c. (a, b, c) plus -> (a, c) le =
   | PlusS p' -> LeS (summandLessThanSum p')
 ;;
 
-(* 3.8 Pattern: Leibniz Equality
-  *)
+(* 3.8 Pattern: Leibniz Equality *)
 
 type (_, _) equal = Eq : ('a, 'a) equal
 
@@ -1714,8 +1599,7 @@ let rec sameNat : type a b. a nat -> b nat -> (a, b) equal option =
   | _ -> None
 ;;
 
-(* Extra: associativity of addition
-  *)
+(* Extra: associativity of addition *)
 
 let rec plus_func : type a b m n. (a, b, m) plus -> (a, b, n) plus -> (m, n) equal =
   fun p1 p2 ->
@@ -1745,11 +1629,9 @@ let rec plus_assoc
     Eq
 ;;
 
-(* 3.9 Computing Programs and Properties Simultaneously
-  *)
+(* 3.9 Computing Programs and Properties Simultaneously *)
 
-(* Plus and app1 are moved to section 2
-  *)
+(* Plus and app1 are moved to section 2 *)
 
 let smaller : type a b. (a succ, b succ) le -> (a, b) le = function
   | LeS x -> x
@@ -1765,8 +1647,7 @@ type (_, _) diff = Diff : 'c nat * ('a, 'c, 'b) plus -> ('a, 'b) diff
      | NS x, NZ, _ -> assert false
      | NS x, NS y, q ->
      match diff (smaller q) x y with Diff (m, p) -> Diff (m, PlusS p)
-     ;;
-  *)
+     ;; *)
 
 let rec diff : type a b. (a, b) le -> a nat -> b nat -> (a, b) diff =
   fun le a b ->
@@ -1780,8 +1661,7 @@ let rec diff : type a b. (a, b) le -> a nat -> b nat -> (a, b) diff =
 let rec diff : type a b. (a, b) le -> a nat -> b nat -> (a, b) diff =
   fun le a b ->
   match a, b, le with
-  (* warning
-    *)
+  (* warning *)
   | NZ, m, LeZ _ -> Diff (m, PlusZ m)
   | NS x, NS y, LeS q ->
     (match diff q x y with
@@ -1815,8 +1695,7 @@ let rec filter : type a n. (a -> bool) -> (a, n) seq -> (a, n) filter =
        if f a then Filter (LeS le, Scons (a, l')) else Filter (leS' le, l'))
 ;;
 
-(* 4.1 AVL trees
-  *)
+(* 4.1 AVL trees *)
 
 type (_, _, _) balance =
   | Less : ('h, 'h succ, 'h succ) balance
@@ -1970,8 +1849,7 @@ let delete x (Avl t) =
   | Ddecr (_, t) -> Avl t
 ;;
 
-(* Exercise 22: Red-black trees
-  *)
+(* Exercise 22: Red-black trees *)
 
 type red = RED
 type black = BLACK
@@ -2060,8 +1938,7 @@ let rec ins : type c n. int -> (c, n) sub_tree -> (c, n) ctxt -> rb_tree =
 
 let insert e (Root t) = ins e t CNil
 
-(* 5.7 typed object languages using GADTs
-  *)
+(* 5.7 typed object languages using GADTs *)
 
 type _ term =
   | Const : int -> int term
@@ -2149,8 +2026,7 @@ let ex3 = Abs ("x", Rint, Ap (Add, Pair (Var ("x", Rint), Var ("x", Rint))))
 let ex4 = Ap (ex3, Const 3)
 let v4 = eval_term [] ex4
 
-(* 5.9/5.10 Language with binding
-  *)
+(* 5.9/5.10 Language with binding *)
 
 type rnil = RNIL
 type ('a, 'b, 'c) rcons = RCons of 'a * 'b * 'c
@@ -2200,12 +2076,10 @@ let double = Abs (X, App (App (Shift add, Var X), Var X))
 let ex3 = App (double, _3)
 let v3 = eval_lam env0 ex3
 
-(* 5.13: Constructing typing derivations at runtime
-  *)
+(* 5.13: Constructing typing derivations at runtime *)
 
 (* Modified slightly to use the language of 5.10, since this is more fun.
-   Of course this works also with the language of 5.12.
-  *)
+   Of course this works also with the language of 5.12. *)
 
 type _ rep =
   | I : int rep
@@ -2295,8 +2169,7 @@ let eval_checked env = function
 
 let v2 = eval_checked env0 c2
 
-(* 5.12 Soundness
-  *)
+(* 5.12 Soundness *)
 
 type pexp = PEXP
 type pval = PVAL
@@ -2403,12 +2276,10 @@ let f : type env a. (env, a) typ -> (env, a) typ -> int =
   | Tint, Tint -> 0
   | Tbool, Tbool -> 1
   | Tvar var, tb -> 2
-  | _ -> . (* error
-             *)
+  | _ -> . (* error *)
 ;;
 
-(* let x = f Tint (Tvar Zero) ;;
-  *)
+(* let x = f Tint (Tvar Zero) ;; *)
 type inkind =
   [ `Link
   | `Nonlink
@@ -2451,8 +2322,7 @@ let inlineseq_from_astseq seq =
   List.map process_any seq
 ;;
 
-(* OK
-  *)
+(* OK *)
 type _ linkp =
   | Nonlink : [ `Nonlink ] linkp
   | Maylink : inkind linkp
@@ -2472,8 +2342,7 @@ let inlineseq_from_astseq seq =
   List.map (process Maylink) seq
 ;;
 
-(* Bad
-  *)
+(* Bad *)
 type _ linkp2 = Kind : 'a linkp -> ([< inkind ] as 'a) linkp2
 
 let inlineseq_from_astseq seq =
@@ -2550,8 +2419,7 @@ type tag =
 type 'a poly =
   | AandBTags : [< `TagA of int | `TagB ] poly
   | ATag : [< `TagA of int ] poly
-(* constraint 'a = [< `TagA of int | `TagB]
-  *)
+(* constraint 'a = [< `TagA of int | `TagB] *)
 
 let intA = function
   | `TagA i -> i
@@ -2572,12 +2440,10 @@ let example6 : type a. a wrapPoly -> a -> int =
   fun w ->
   match w with
   | WrapPoly ATag -> intA
-  | WrapPoly _ -> intA (* This should not be allowed
-                         *)
+  | WrapPoly _ -> intA (* This should not be allowed *)
 ;;
 
-let _ = example6 (WrapPoly AandBTags) `TagB (* This causes a seg fault
-                                              *)
+let _ = example6 (WrapPoly AandBTags) `TagB (* This causes a seg fault *)
 
 module F (S : sig
     type 'a t
@@ -2725,8 +2591,7 @@ let f (Aux x) =
   | Succ (Succ Zero) -> "2"
   | Succ (Succ (Succ Zero)) -> "3"
   | Succ (Succ (Succ (Succ Zero))) -> "4"
-  | _ -> . (* error
-             *)
+  | _ -> . (* error *)
 ;;
 
 type _ t = C : ((('a -> 'o) -> 'o) -> ('b -> 'o) -> 'o) t
@@ -2854,16 +2719,14 @@ type (_, _) t =
 
 let get1 (Cons (x, _) : (_ * 'a, 'a) t) = x
 
-(* warn, cf PR#6993
-  *)
+(* warn, cf PR#6993 *)
 
 let get1' = function
   | (Cons (x, _) : (_ * 'a, 'a) t) -> x
   | Nil -> assert false
 ;;
 
-(* ok
-  *)
+(* ok *)
 type _ t =
   | Int : int -> int t
   | String : string -> string t
@@ -2883,8 +2746,7 @@ type _ t = I : int t
 
 let f (type a) (x : a t) =
   let module M = struct
-    let (I : a t) = x (* fail because of toplevel let
-                        *)
+    let (I : a t) = x (* fail because of toplevel let *)
     let x = (I : a t)
   end
   in
@@ -2900,8 +2762,7 @@ let bad (type a) =
     module rec M : sig
       val e : (int, a) eq
     end = struct
-      let (Refl : (int, a) eq) = M.e (* must fail for soundness
-                                       *)
+      let (Refl : (int, a) eq) = M.e (* must fail for soundness *)
       let e : (int, a) eq = Refl
     end
   end
@@ -2928,8 +2789,7 @@ let undetected : ('a -> 'b -> nil) t -> 'a n -> 'b n -> unit =
 
 type _ t = T : int t
 
-(* Should raise Not_found
-  *)
+(* Should raise Not_found *)
 let _ =
   match (raise Not_found : float t) with
   | _ -> .
@@ -2943,15 +2803,13 @@ type 'a t
 
 let f (type a) (Neq n : (a, a t) eq) = n
 
-(* warn!
-  *)
+(* warn! *)
 
 module F (T : sig
     type _ t
   end) =
 struct
-  let f (type a) (Neq n : (a, a T.t) eq) = n (* warn!
-                                               *)
+  let f (type a) (Neq n : (a, a T.t) eq) = n (* warn! *)
 end
 
 (* First-Order Unification by Structural Recursion *)
@@ -2961,8 +2819,7 @@ end
 (* This is a translation of the code part to ocaml *)
 (* Of course, we do not prove other properties, not even termination *)
 
-(* 2.2 Inductive Families
-  *)
+(* 2.2 Inductive Families *)
 
 type zero = Zero
 type _ succ = Succ
@@ -2978,11 +2835,9 @@ type _ fin =
 (* We cannot define
    val empty : zero fin -> 'a
    because we cannot write an empty pattern matching.
-   This might be useful to have
-  *)
+   This might be useful to have *)
 
-(* In place, prove that the parameter is 'a succ
-  *)
+(* In place, prove that the parameter is 'a succ *)
 type _ is_succ = IS : 'a succ is_succ
 
 let fin_succ : type n. n fin -> n is_succ = function
@@ -2990,8 +2845,7 @@ let fin_succ : type n. n fin -> n is_succ = function
   | FS _ -> IS
 ;;
 
-(* 3 First-Order Terms, Renaming and Substitution
-  *)
+(* 3 First-Order Terms, Renaming and Substitution *)
 
 type 'a term =
   | Var of 'a fin
@@ -3009,11 +2863,9 @@ let rec pre_subst f = function
 
 let comp_subst f g (x : 'a fin) = pre_subst f (g x)
 (* val comp_subst :
-   ('b fin -> 'c term) -> ('a fin -> 'b term) -> 'a fin -> 'c term
-  *)
+   ('b fin -> 'c term) -> ('a fin -> 'b term) -> 'a fin -> 'c term *)
 
-(* 4 The Occur-Check, through thick and thin
-  *)
+(* 4 The Occur-Check, through thick and thin *)
 
 let rec thin : type n. n succ fin -> n fin -> n succ fin =
   fun x y ->
@@ -3029,8 +2881,7 @@ let bind t f =
   | Some x -> f x
 ;;
 
-(* val bind : 'a option -> ('a -> 'b option) -> 'b option
-  *)
+(* val bind : 'a option -> ('a -> 'b option) -> 'b option *)
 
 let rec thick : type n. n succ fin -> n succ fin -> n fin option =
   fun x y ->
@@ -3060,15 +2911,12 @@ let subst_var x t' y =
   | Some y' -> Var y'
 ;;
 
-(* val subst_var : 'a succ fin -> 'a term -> 'a succ fin -> 'a term
-  *)
+(* val subst_var : 'a succ fin -> 'a term -> 'a succ fin -> 'a term *)
 
 let subst x t' = pre_subst (subst_var x t')
-(* val subst : 'a succ fin -> 'a term -> 'a succ term -> 'a term
-  *)
+(* val subst : 'a succ fin -> 'a term -> 'a succ term -> 'a term *)
 
-(* 5 A Refinement of Substitution
-  *)
+(* 5 A Refinement of Substitution *)
 
 type (_, _) alist =
   | Anil : ('n, 'n) alist
@@ -3090,8 +2938,7 @@ type _ ealist = EAlist : ('a, 'b) alist -> 'a ealist
 
 let asnoc a t' x = EAlist (Asnoc (a, t', x))
 
-(* Extra work: we need sub to work on ealist too, for examples
-  *)
+(* Extra work: we need sub to work on ealist too, for examples *)
 let rec weaken_fin : type n. n fin -> n succ fin = function
   | FZ -> FZ
   | FS x -> FS (weaken_fin x)
@@ -3111,11 +2958,9 @@ let rec sub' : type m. m ealist -> m fin -> m term = function
 ;;
 
 let subst' d = pre_subst (sub' d)
-(* val subst' : 'a ealist -> 'a term -> 'a term
-  *)
+(* val subst' : 'a ealist -> 'a term -> 'a term *)
 
-(* 6 First-Order Unification
-  *)
+(* 6 First-Order Unification *)
 
 let flex_flex x y =
   match thick x y with
@@ -3123,12 +2968,10 @@ let flex_flex x y =
   | None -> EAlist Anil
 ;;
 
-(* val flex_flex : 'a succ fin -> 'a succ fin -> 'a succ ealist
-  *)
+(* val flex_flex : 'a succ fin -> 'a succ fin -> 'a succ ealist *)
 
 let flex_rigid x t = bind (check x t) (fun t' -> Some (asnoc Anil t' x))
-(* val flex_rigid : 'a succ fin -> 'a succ term -> 'a succ ealist option
-  *)
+(* val flex_rigid : 'a succ fin -> 'a succ term -> 'a succ ealist option *)
 
 let rec amgu : type m. m term -> m term -> m ealist -> m ealist option =
   fun s t acc ->
@@ -3153,8 +2996,7 @@ let rec amgu : type m. m term -> m term -> m ealist -> m ealist option =
 ;;
 
 let mgu s t = amgu s t (EAlist Anil)
-(* val mgu : 'a term -> 'a term -> 'a ealist option
-  *)
+(* val mgu : 'a term -> 'a term -> 'a ealist option *)
 
 let s = Fork (Var FZ, Fork (Var (FS (FS FZ)), Leaf))
 let t = Fork (Var (FS FZ), Var (FS FZ))
@@ -3168,8 +3010,7 @@ let d =
 let s' = subst' d s
 let t' = subst' d t
 
-(* Injectivity
-  *)
+(* Injectivity *)
 
 type (_, _) eq = Refl : ('a, 'a) eq
 
@@ -3191,8 +3032,7 @@ let magic : 'a 'b. 'a -> 'b =
   M.f Refl
 ;;
 
-(* Variance and subtyping
-  *)
+(* Variance and subtyping *)
 
 type (_, +_) eq = Refl : ('a, 'a) eq
 
@@ -3211,8 +3051,7 @@ let magic : 'a 'b. 'a -> 'b =
     #m
 ;;
 
-(* Record patterns
-  *)
+(* Record patterns *)
 
 type _ t =
   | IntLit : int t
@@ -3245,24 +3084,19 @@ module type S = sig type t [@@immediate] end
 module F : functor (M : S) -> S
 |}]
 
-(* VALID DECLARATIONS
-  *)
+(* VALID DECLARATIONS *)
 
 module A = struct
-  (* Abstract types can be immediate
-    *)
+  (* Abstract types can be immediate *)
   type t [@@immediate]
 
-  (* [@@immediate] tag here is unnecessary but valid since t has it
-    *)
+  (* [@@immediate] tag here is unnecessary but valid since t has it *)
   type s = t [@@immediate]
 
-  (* Again, valid alias even without tag
-    *)
+  (* Again, valid alias even without tag *)
   type r = s
 
-  (* Mutually recursive declarations work as well
-    *)
+  (* Mutually recursive declarations work as well *)
   type p = q [@@immediate]
   and q = int
 end
@@ -3279,8 +3113,7 @@ module A :
   end
 |}]
 
-(* Valid using with constraints
-  *)
+(* Valid using with constraints *)
 module type X = sig
   type t
 end
@@ -3300,8 +3133,7 @@ module Y : sig type t = int end
 module Z : sig type t [@@immediate] end
 |}]
 
-(* Valid using an explicit signature
-  *)
+(* Valid using an explicit signature *)
 module M_valid : S = struct
   type t = int
 end
@@ -3315,8 +3147,7 @@ module M_valid : S
 module FM_valid : S
 |}]
 
-(* Practical usage over modules
-  *)
+(* Practical usage over modules *)
 module Foo : sig
   type t
 
@@ -3377,14 +3208,11 @@ 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 "With @@immediate: %fs\n" (test test_bar) *)
 
-(* INVALID DECLARATIONS
-  *)
+(* INVALID DECLARATIONS *)
 
-(* Cannot directly declare a non-immediate type as immediate
-  *)
+(* Cannot directly declare a non-immediate type as immediate *)
 module B = struct
   type t = string [@@immediate]
 end
@@ -3396,8 +3224,7 @@ Error: Types marked with the immediate attribute must be
        non-pointer types like int or bool
 |}]
 
-(* Not guaranteed that t is immediate, so this is an invalid declaration
-  *)
+(* Not guaranteed that t is immediate, so this is an invalid declaration *)
 module C = struct
   type t
   type s = t [@@immediate]
@@ -3410,8 +3237,7 @@ Error: Types marked with the immediate attribute must be
        non-pointer types like int or bool
 |}]
 
-(* Can't ascribe to an immediate type signature with a non-immediate type
-  *)
+(* Can't ascribe to an immediate type signature with a non-immediate type *)
 module D : sig
   type t [@@immediate]
 end = struct
@@ -3433,8 +3259,7 @@ Error: Signature mismatch:
        the first is not an immediate type.
 |}]
 
-(* Same as above but with explicit signature
-  *)
+(* Same as above but with explicit signature *)
 module M_invalid : S = struct
   type t = string
 end
@@ -3455,8 +3280,7 @@ Error: Signature mismatch:
        the first is not an immediate type.
 |}]
 
-(* Can't use a non-immediate type even if mutually recursive
-  *)
+(* Can't use a non-immediate type even if mutually recursive *)
 module E = struct
   type t = s [@@immediate]
   and s = string
@@ -3479,17 +3303,14 @@ Error: Types marked with the immediate attribute must be
      New: implicit pack is also supported, and you only need to be able
      to infer the the module type path from the context.
   *)
-(* ocaml -principal
-  *)
+(* ocaml -principal *)
 
-(* Use a module pattern
-  *)
+(* Use a module pattern *)
 let sort (type s) (module Set : Set.S with type elt = s) l =
   Set.elements (List.fold_right Set.add l Set.empty)
 ;;
 
-(* No real improvement here?
-  *)
+(* No real improvement here? *)
 let make_set (type s) cmp : (module Set.S with type elt = s) =
   (module Set.Make (struct
       type t = s
@@ -3498,8 +3319,7 @@ let make_set (type s) cmp : (module Set.S with type elt = s) =
     end))
 ;;
 
-(* No type annotation here
-  *)
+(* No type annotation here *)
 let sort_cmp (type s) cmp =
   sort
     (module Set.Make (struct
@@ -3518,8 +3338,7 @@ end
 let f (module M : S with type t = int) = M.x
 let f (module M : S with type t = 'a) = M.x
 
-(* Error
-  *)
+(* Error *)
 let f (type a) (module M : S with type t = a) = M.x;;
 
 f
@@ -3541,8 +3360,7 @@ type 'a s = { s : (module S with type t = 'a) };;
 
 let f { s = (module M) } = M.x
 
-(* Error
-  *)
+(* Error *)
 let f (type a) ({ s = (module M) } : a s) = M.x
 
 type s = { s : (module S with type t = int) }
@@ -3562,8 +3380,7 @@ let m =
   end)
 ;;
 
-(* Error
-  *)
+(* Error *)
 let m =
   (module struct
     let x = 3
@@ -3585,14 +3402,12 @@ M.x
 
 let (module M) = m
 
-(* Error: only allowed in [let .. in]
-  *)
+(* Error: only allowed in [let .. in] *)
 class c =
   let (module M) = m in
   object end
 
-(* Error again
-  *)
+(* Error again *)
 module M = (val m)
 
 module type S' = sig
@@ -3600,8 +3415,7 @@ module type S' = sig
 end
 ;;
 
-(* Even works with recursion, but must be fully explicit
-  *)
+(* Even works with recursion, but must be fully explicit *)
 let rec (module M : S') =
   (module struct
     let f n = if n <= 0 then 1 else n * M.f (n - 1)
@@ -3609,8 +3423,7 @@ let rec (module M : S') =
 in
 M.f 3
 
-(* Subtyping
-  *)
+(* Subtyping *)
 
 module type S = sig
   type t
@@ -3687,8 +3500,7 @@ let rec to_string : 'a. 'a Typ.typ -> 'a -> string =
     Printf.sprintf "(%s,%s)" (to_string P.t1 x1) (to_string P.t2 x2)
 ;;
 
-(* Wrapping maps
-  *)
+(* Wrapping maps *)
 module type MapT = sig
   include Map.S
 
@@ -3750,8 +3562,7 @@ add ssmap
 open StdLabels
 open MoreLabels
 
-(* Use maps for substitutions and sets for free variables
-  *)
+(* Use maps for substitutions and sets for free variables *)
 
 module Subst = Map.Make (struct
     type t = string
@@ -3765,8 +3576,7 @@ module Names = Set.Make (struct
     let compare = compare
   end)
 
-(* Variables are common to lambda and expr
-  *)
+(* Variables are common to lambda and expr *)
 
 type var = [ `Var of string ]
 
@@ -3780,8 +3590,7 @@ let free_var : var -> _ = function
   | `Var s -> Names.singleton s
 ;;
 
-(* The lambda language: free variables, substitutions, and evaluation
-  *)
+(* The lambda language: free variables, substitutions, and evaluation *)
 
 type 'a lambda =
   [ `Var of string
@@ -3836,15 +3645,13 @@ let eval_lambda ~eval_rec ~subst l =
   | t -> t
 ;;
 
-(* Specialized versions to use on lambda
-  *)
+(* Specialized versions to use on lambda *)
 
 let rec free1 x = free_lambda ~free_rec:free1 x
 let rec subst1 ~subst = subst_lambda ~subst_rec:subst1 ~free:free1 ~subst
 let rec eval1 x = eval_lambda ~eval_rec:eval1 ~subst:subst1 x
 
-(* The expr language of arithmetic expressions
-  *)
+(* The expr language of arithmetic expressions *)
 
 type 'a expr =
   [ `Var of string
@@ -3862,8 +3669,7 @@ let free_expr ~free_rec : _ expr -> _ = function
   | `Mult (x, y) -> Names.union (free_rec x) (free_rec y)
 ;;
 
-(* Here map_expr helps a lot
-  *)
+(* Here map_expr helps a lot *)
 let map_expr ~map_rec : _ expr -> _ = function
   | #var as x -> x
   | `Num _ as x -> x
@@ -3893,15 +3699,13 @@ let eval_expr ~eval_rec e =
   | #expr as e -> e
 ;;
 
-(* Specialized versions
-  *)
+(* Specialized versions *)
 
 let rec free2 x = free_expr ~free_rec:free2 x
 let rec subst2 ~subst = subst_expr ~subst_rec:subst2 ~subst
 let rec eval2 x = eval_expr ~eval_rec:eval2 x
 
-(* The lexpr language, reunion of lambda and expr
-  *)
+(* The lexpr language, reunion of lambda and expr *)
 
 type lexpr =
   [ `Var of string
@@ -3963,14 +3767,12 @@ let () =
   print_newline ()
 ;;
 
-(* Full fledge version, using objects to structure code
-  *)
+(* Full fledge version, using objects to structure code *)
 
 open StdLabels
 open MoreLabels
 
-(* Use maps for substitutions and sets for free variables
-  *)
+(* Use maps for substitutions and sets for free variables *)
 
 module Subst = Map.Make (struct
     type t = string
@@ -3984,8 +3786,7 @@ module Names = Set.Make (struct
     let compare = compare
   end)
 
-(* To build recursive objects
-  *)
+(* To build recursive objects *)
 
 let lazy_fix make =
   let rec obj () = make (lazy (obj ()) : _ Lazy.t) in
@@ -3994,8 +3795,7 @@ let lazy_fix make =
 
 let ( !! ) = Lazy.force
 
-(* The basic operations
-  *)
+(* The basic operations *)
 
 class type ['a, 'b] ops = object
   method free : x:'b -> ?y:'c -> Names.t
@@ -4003,8 +3803,7 @@ class type ['a, 'b] ops = object
   method eval : 'b -> 'a
 end
 
-(* Variables are common to lambda and expr
-  *)
+(* Variables are common to lambda and expr *)
 
 type var = [ `Var of string ]
 
@@ -4020,8 +3819,7 @@ class ['a] var_ops =
     method eval (#var as v) = v
   end
 
-(* The lambda language: free variables, substitutions, and evaluation
-  *)
+(* The lambda language: free variables, substitutions, and evaluation *)
 
 type 'a lambda =
   [ `Var of string
@@ -4084,13 +3882,11 @@ class ['a] lambda_ops (ops : ('a, 'a) #ops Lazy.t) =
       | t -> t
   end
 
-(* Operations specialized to lambda
-  *)
+(* Operations specialized to lambda *)
 
 let lambda = lazy_fix (new lambda_ops)
 
-(* The expr language of arithmetic expressions
-  *)
+(* The expr language of arithmetic expressions *)
 
 type 'a expr =
   [ `Var of string
@@ -4145,13 +3941,11 @@ class ['a] expr_ops (ops : ('a, 'a) #ops Lazy.t) =
       | e -> e
   end
 
-(* Specialized versions
-  *)
+(* Specialized versions *)
 
 let expr = lazy_fix (new expr_ops)
 
-(* The lexpr language, reunion of lambda and expr
-  *)
+(* The lexpr language, reunion of lambda and expr *)
 
 type 'a lexpr =
   [ 'a lambda
@@ -4219,14 +4013,12 @@ let () =
   print_newline ()
 ;;
 
-(* Full fledge version, using objects to structure code
-  *)
+(* Full fledge version, using objects to structure code *)
 
 open StdLabels
 open MoreLabels
 
-(* Use maps for substitutions and sets for free variables
-  *)
+(* Use maps for substitutions and sets for free variables *)
 
 module Subst = Map.Make (struct
     type t = string
@@ -4240,8 +4032,7 @@ module Names = Set.Make (struct
     let compare = compare
   end)
 
-(* To build recursive objects
-  *)
+(* To build recursive objects *)
 
 let lazy_fix make =
   let rec obj () = make (lazy (obj ()) : _ Lazy.t) in
@@ -4250,8 +4041,7 @@ let lazy_fix make =
 
 let ( !! ) = Lazy.force
 
-(* The basic operations
-  *)
+(* The basic operations *)
 
 class type ['a, 'b] ops = object
   method free : 'b -> Names.t
@@ -4259,8 +4049,7 @@ class type ['a, 'b] ops = object
   method eval : 'b -> 'a
 end
 
-(* Variables are common to lambda and expr
-  *)
+(* Variables are common to lambda and expr *)
 
 type var = [ `Var of string ]
 
@@ -4275,8 +4064,7 @@ let var =
   end
 ;;
 
-(* The lambda language: free variables, substitutions, and evaluation
-  *)
+(* The lambda language: free variables, substitutions, and evaluation *)
 
 type 'a lambda =
   [ `Var of string
@@ -4337,13 +4125,11 @@ let lambda_ops (ops : ('a, 'a) #ops Lazy.t) =
   end
 ;;
 
-(* Operations specialized to lambda
-  *)
+(* Operations specialized to lambda *)
 
 let lambda = lazy_fix lambda_ops
 
-(* The expr language of arithmetic expressions
-  *)
+(* The expr language of arithmetic expressions *)
 
 type 'a expr =
   [ `Var of string
@@ -4396,13 +4182,11 @@ let expr_ops (ops : ('a, 'a) #ops Lazy.t) =
   end
 ;;
 
-(* Specialized versions
-  *)
+(* Specialized versions *)
 
 let expr = lazy_fix expr_ops
 
-(* The lexpr language, reunion of lambda and expr
-  *)
+(* The lexpr language, reunion of lambda and expr *)
 
 type 'a lexpr =
   [ 'a lambda
@@ -4581,13 +4365,11 @@ let _ = foo ()
 
 type 'a t = [ `A of 'a t t ] as 'a
 
-(* fails
-  *)
+(* fails *)
 
 type 'a t = [ `A of 'a t t ]
 
-(* fails
-  *)
+(* fails *)
 
 type 'a t = [ `A of 'a t t ] constraint 'a = 'a t
 type 'a t = [ `A of 'a t ] constraint 'a = 'a t
@@ -4597,20 +4379,17 @@ type 'a v = [ `A of u v ] constraint 'a = t
 and t = u
 and u = t
 
-(* fails
-  *)
+(* fails *)
 
 type 'a t = 'a
 
 let f (x : 'a t as 'a) = ()
 
-(* fails
-  *)
+(* fails *)
 
 let f (x : 'a t) (y : 'a) = x = y
 
-(* PR#6505
-  *)
+(* PR#6505 *)
 module type PR6505 = sig
   type 'o is_an_object = < .. > as 'o
   and 'o abs constraint 'o = 'o is_an_object
@@ -4619,16 +4398,13 @@ module type PR6505 = sig
   val unabs : 'o abs -> 'o
 end
 
-(* fails
-  *)
-(* PR#5835
-  *)
+(* fails *)
+(* PR#5835 *)
 let f ~x = x + 1;;
 
 f ?x:0
 
-(* PR#6352
-  *)
+(* PR#6352 *)
 let foo (f : unit -> unit) = ()
 let g ?x () = ();;
 
@@ -4637,14 +4413,11 @@ foo
    g)
 ;;
 
-(* PR#5748
-  *)
+(* PR#5748 *)
 foo (fun ?opt () -> ())
 
-(* fails
-  *)
-(* PR#5907
-  *)
+(* fails *)
+(* PR#5907 *)
 
 type 'a t = 'a
 
@@ -4680,18 +4453,15 @@ let f (x : [< `A | `B ]) =
   | `A | `B | `C -> 0
 ;;
 
-(* warn
-  *)
+(* warn *)
 let f (x : [ `A | `B ]) =
   match x with
   | `A | `B | `C -> 0
 ;;
 
-(* fail
-  *)
+(* fail *)
 
-(* PR#6787
-  *)
+(* PR#6787 *)
 let revapply x f = f x
 
 let f x (g : [< `Foo ]) =
@@ -4699,8 +4469,7 @@ let f x (g : [< `Foo ]) =
   revapply y (fun (`Bar i, _) -> i)
 ;;
 
-(* f : 'a -> [< `Foo ] -> 'a
-  *)
+(* f : 'a -> [< `Foo ] -> 'a *)
 
 let rec x =
   [| x |];
@@ -4723,8 +4492,7 @@ let _ = fun (x : a t) -> f x
 let _ = fun (x : a t) -> g x
 let _ = fun (x : a t) -> h x
 
-(* PR#7012
-  *)
+(* PR#7012 *)
 
 type t =
   [ 'A_name
@@ -4734,8 +4502,7 @@ type t =
 let f (x : 'id_arg) = x
 let f (x : 'Id_arg) = x
 
-(* undefined labels
-  *)
+(* undefined labels *)
 type t =
   { x : int
   ; y : int
@@ -4745,19 +4512,16 @@ type t =
 { x = 3; z = 2 };;
 fun { x = 3; z = 2 } -> ();;
 
-(* mixed labels
-  *)
+(* mixed labels *)
 { x = 3; contents = 2 }
 
-(* private types
-  *)
+(* private types *)
 type u = private { mutable u : int };;
 
 { u = 3 };;
 fun x -> x.u <- 3
 
-(* Punning and abbreviations
-  *)
+(* Punning and abbreviations *)
 module M = struct
   type t =
     { x : int
@@ -4769,14 +4533,12 @@ let f { M.x; y } = x + y
 let r = { M.x = 1; y = 2 }
 let z = f r
 
-(* messages
-  *)
+(* messages *)
 type foo = { mutable y : int }
 
 let f (r : int) = r.y <- 3
 
-(* bugs
-  *)
+(* bugs *)
 type foo =
   { y : int
   ; z : int
@@ -4792,12 +4554,10 @@ let r : foo = { ZZZ.x = 2 };;
 
 (ZZZ.X : int option)
 
-(* PR#5865
-  *)
+(* PR#5865 *)
 let f (x : Complex.t) = x.Complex.z
 
-(* PR#6394
-  *)
+(* PR#6394 *)
 
 module rec X : sig
   type t = int * bool
@@ -4811,8 +4571,7 @@ end = struct
   ;;
 end
 
-(* PR#6768
-  *)
+(* PR#6768 *)
 
 type _ prod = Prod : ('a * 'y) prod
 
@@ -4844,8 +4603,7 @@ end =
 let f1 (x : (_, _) Hash1.t) : (_, _) Hashtbl.t = x
 let f2 (x : (_, _) Hash2.t) : (_, _) Hashtbl.t = x
 
-(* Another case, not using include
-  *)
+(* Another case, not using include *)
 
 module Std2 = struct
   module M = struct
@@ -4872,8 +4630,7 @@ let f3 (x : M'.t) : Std2.M.t = x
    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
-  *)
+   end *)
 module type INCLUDING = sig
   include module type of List
   include module type of ListLabels
@@ -4992,8 +4749,7 @@ struct
   module X = (val if !flag then (module A) else (module B) : S.T)
 end
 
-(* If the above were accepted, one could break soundness
-  *)
+(* If the above were accepted, one could break soundness *)
 module type S = sig
   type t
 
@@ -5054,8 +4810,7 @@ end
    type 'a list_wrap = 'a list)
    -> S with type t = Html5_types.div Html5.elt and
    type u = < foo: Html5.uri >
-   end
-  *)
+   end *)
 module type S = sig
   include Set.S
 
@@ -5183,8 +4938,7 @@ module X = struct
   end
 end
 
-(* open X  (* works! *)
-  *)
+(* open X  (* works! *) *)
 module Y = X.Y
 
 type 'a arg_t = 'at constraint 'a = (module Y.S with type t = 'at)
@@ -5214,15 +4968,12 @@ module type S = sig
 end
 
 let f (type a) (module X : S with type t = a) = ()
-let _ = f (module A) (* ok
-                       *)
+let _ = f (module A) (* ok *)
 
 module A_annotated_alias : S with type t = (module A.A_S) = A
 
-let _ = f (module A_annotated_alias) (* ok
-                                       *)
-let _ = f (module A_annotated_alias : S with type t = (module A.A_S)) (* ok
-                                                                        *)
+let _ = f (module A_annotated_alias) (* ok *)
+let _ = f (module A_annotated_alias : S with type t = (module A.A_S)) (* ok *)
 
 module A_alias = A
 
@@ -5230,14 +4981,10 @@ module A_alias_expanded = struct
   include A_alias
 end
 
-let _ = f (module A_alias_expanded : S with type t = (module A.A_S)) (* ok
-                                                                       *)
-let _ = f (module A_alias_expanded) (* ok
-                                      *)
-let _ = f (module A_alias : S with type t = (module A.A_S)) (* doesn't type
-                                                              *)
-let _ = f (module A_alias) (* doesn't type either
-                             *)
+let _ = f (module A_alias_expanded : S with type t = (module A.A_S)) (* ok *)
+let _ = f (module A_alias_expanded) (* ok *)
+let _ = f (module A_alias : S with type t = (module A.A_S)) (* doesn't type *)
+let _ = f (module A_alias) (* doesn't type either *)
 
 module Foo
     (Bar : sig
@@ -5253,8 +5000,7 @@ module Bazoinks = struct
 end
 
 module Bug = Foo (Bazoinks) (Bazoinks)
-(* PR#6992, reported by Stephen Dolan
-  *)
+(* PR#6992, reported by Stephen Dolan *)
 
 type (_, _) eq = Eq : ('a, 'a) eq
 
@@ -5272,8 +5018,7 @@ 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)
-  *)
+   let _ = Printf.printf "Oh dear: %s" (cast bad 42) *)
 module M = struct
   module type S = sig
     type a
@@ -5310,8 +5055,7 @@ module type FOO = sig
 end
 
 module type BAR = sig
-  (* Works: module rec A : (sig include FOO with type t = < b:B.t > end)
-    *)
+  (* Works: module rec A : (sig include FOO with type t = < b:B.t > end) *)
   module rec A : (FOO with type t = < b : B.t >)
   and B : FOO
 end
@@ -5396,8 +5140,7 @@ end = struct
   let add_dec dec = Fast.attach Dem.key dec
 end
 
-(* simpler version
-  *)
+(* simpler version *)
 
 module Simple = struct
   type 'a t
@@ -5460,8 +5203,7 @@ module rec M : sig
 end = struct
   external f : int -> int = "%identity"
 end
-(* with module
-  *)
+(* with module *)
 
 module type S = sig
   type t
@@ -5477,8 +5219,7 @@ end
 
 module type S' = S with module M := String
 
-(* with module type
-  *)
+(* with module type *)
 (*
      module type S = sig module type T module F(X:T) : T end;;
      module type T0 = sig type t end;;
@@ -5494,11 +5235,9 @@ module type S' = S with module M := String
      and module type SeededS := Hashtbl.SeededS
      and module type HashedType := Hashtbl.HashedType
      and module type SeededHashedType := Hashtbl.SeededHashedType)
-     end;;
-  *)
+     end;; *)
 
-(* A subtle problem appearing with -principal
-  *)
+(* A subtle problem appearing with -principal *)
 type -'a t
 
 class type c = object
@@ -5514,24 +5253,21 @@ end = struct
   ;;
 end
 
-(* PR#4838
-  *)
+(* PR#4838 *)
 
 let id =
   let module M = struct end in
   fun x -> x
 ;;
 
-(* PR#4511
-  *)
+(* PR#4511 *)
 
 let ko =
   let module M = struct end in
   fun _ -> ()
 ;;
 
-(* PR#5993
-  *)
+(* PR#5993 *)
 
 module M : sig
   type -'a t = private int
@@ -5539,8 +5275,7 @@ end = struct
   type +'a t = private int
 end
 
-(* PR#6005
-  *)
+(* PR#6005 *)
 
 module type A = sig
   type t = X of int
@@ -5550,8 +5285,7 @@ type u = X of bool
 
 module type B = A with type t = u
 
-(* fail
-  *)
+(* fail *)
 
 (* PR#5815 *)
 (* ---> duplicated exception name is now an error *)
@@ -5561,8 +5295,7 @@ module type S = sig
   exception Foo of bool
 end
 
-(* PR#6410
-  *)
+(* PR#6410 *)
 
 module F (X : sig end) = struct
   let x = 3
@@ -5571,8 +5304,7 @@ end
 
 F.x
 
-(* fail
-  *)
+(* fail *)
 module C = Char;;
 
 C.chr 66
@@ -5610,8 +5342,7 @@ module G (X : sig end) = struct
   module M = X
 end
 
-(* does not alias X
-  *)
+(* does not alias X *)
 module M = G (struct end)
 
 module M' = struct
@@ -5754,8 +5485,7 @@ end =
   M
 ;;
 
-(* sound, but should probably fail
-  *)
+(* sound, but should probably fail *)
 M1.C'.escaped 'A'
 
 module M2 : sig
@@ -5804,16 +5534,14 @@ struct
   module C = X.C
 end
 
-(* Applicative functors
-  *)
+(* Applicative functors *)
 module S = String
 module StringSet = Set.Make (String)
 module SSet = Set.Make (S)
 
 let f (x : StringSet.t) : SSet.t = x
 
-(* Also using include (cf. Leo's mail 2013-11-16)
-  *)
+(* Also using include (cf. Leo's mail 2013-11-16) *)
 module F (M : sig end) : sig
   type t
 end = struct
@@ -5855,8 +5583,7 @@ end
 
 module M = struct
   module X = struct end
-  module Y = FF (X) (* XXX
-                      *)
+  module Y = FF (X) (* XXX *)
 
   type t = Y.t
 end
@@ -5875,8 +5602,7 @@ module G = F (M.Y)
 (*module N = G (M);;
   module N = F (M.Y) (M);;*)
 
-(* PR#6307
-  *)
+(* PR#6307 *)
 
 module A1 = struct end
 module A2 = struct end
@@ -5892,15 +5618,12 @@ end
 module F (L : module type of L1) = struct end
 module F1 = F (L1)
 
-(* ok
-  *)
+(* ok *)
 module F2 = F (L2)
 
-(* should succeed too
-  *)
+(* should succeed too *)
 
-(* Counter example: why we need to be careful with PR#6307
-  *)
+(* Counter example: why we need to be careful with PR#6307 *)
 module Int = struct
   type t = int
 
@@ -5920,8 +5643,7 @@ end
 
 module type S = module type of M
 
-(* keep alias
-  *)
+(* keep alias *)
 
 module Int2 = struct
   type t = int
@@ -5934,8 +5656,7 @@ module type S' = sig
   include S with module I := I
 end
 
-(* fail
-  *)
+(* fail *)
 
 (* (* if the above succeeded, one could break invariants *)
    module rec M2 : S' = M2;; (* should succeed! (but this is bad) *)
@@ -5947,11 +5668,9 @@ end
    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 *)
-  *)
+   SInt2.mem 2 s';; (* invariants are broken *) *)
 
-(* Check behavior with submodules
-  *)
+(* Check behavior with submodules *)
 module M = struct
   module N = struct
     module I = Int
@@ -5984,8 +5703,7 @@ end
 
 module type S = module type of M
 
-(* PR#6365
-  *)
+(* PR#6365 *)
 module type S = sig
   module M : sig
     type t
@@ -6004,11 +5722,9 @@ module H' = H
 
 module type S' = S with module M = H'
 
-(* shouldn't introduce an alias
-  *)
+(* shouldn't introduce an alias *)
 
-(* PR#6376
-  *)
+(* PR#6376 *)
 module type Alias = sig
   module N : sig end
   module M = N
@@ -6022,8 +5738,7 @@ module type A = Alias with module N := F(List)
 
 module rec Bad : A = Bad
 
-(* Shinwell 2014-04-23
-  *)
+(* Shinwell 2014-04-23 *)
 module B = struct
   module R = struct
     type t = string
@@ -6039,8 +5754,7 @@ end
 
 let x : K.N.t = "foo"
 
-(* PR#6465
-  *)
+(* PR#6465 *)
 
 module M = struct
   type t = A
@@ -6057,8 +5771,7 @@ module P : sig
 end =
   M
 
-(* should be ok
-  *)
+(* should be ok *)
 module P : sig
   type t = M.t = A
 
@@ -6098,11 +5811,9 @@ end
 
 module R' : S = R
 
-(* should be ok
-  *)
+(* should be ok *)
 
-(* PR#6578
-  *)
+(* PR#6578 *)
 
 module M = struct
   let f x = x
@@ -6140,15 +5851,13 @@ 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 *)
 
 include D'
 
 (*
      let () =
-     print_endline (string_of_int D'.M.y)
-  *)
+     print_endline (string_of_int D'.M.y) *)
 open A
 
 let f = L.map S.capitalize
@@ -6161,11 +5870,9 @@ 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
-  *)
+(* No dependency on D *)
 let x = 3
 
 module M = struct
@@ -6183,13 +5890,11 @@ module type S' = sig
 end
 
 (* ok to convert between structurally equal signatures, and parameters
-   are inferred
-  *)
+   are inferred *)
 let f (x : (module S with type t = 'a and type u = 'b)) : (module S') = x
 let g x = (x : (module S with type t = 'a and type u = 'b) :> (module S'))
 
-(* with subtyping it is also ok to forget some types
-  *)
+(* with subtyping it is also ok to forget some types *)
 module type S2 = sig
   type u
   type t
@@ -6200,15 +5905,12 @@ let g2 x = (x : (module S2 with type t = 'a and type u = 'b) :> (module S'))
 let h x = (x : (module S2 with type t = 'a) :> (module S with type t = 'a))
 let f2 (x : (module S2 with type t = 'a and type u = 'b)) : (module S') = x
 
-(* fail
-  *)
+(* fail *)
 let k (x : (module S2 with type t = 'a)) : (module S with type t = 'a) = x
 
-(* fail
-  *)
+(* fail *)
 
-(* but you cannot forget values (no physical coercions)
-  *)
+(* but you cannot forget values (no physical coercions) *)
 module type S3 = sig
   type u
   type t
@@ -6218,13 +5920,10 @@ end
 
 let g3 x = (x : (module S3 with type t = 'a and type u = 'b) :> (module S'))
 
-(* fail
-  *)
-(* Using generative functors
-  *)
+(* fail *)
+(* Using generative functors *)
 
-(* Without type
-  *)
+(* Without type *)
 module type S = sig
   val x : int
 end
@@ -6237,19 +5936,15 @@ let v =
 
 module F () = (val v)
 
-(* ok
-  *)
+(* ok *)
 module G (X : sig end) : S = F ()
 
-(* ok
-  *)
+(* ok *)
 module H (X : sig end) = (val v)
 
-(* ok
-  *)
+(* ok *)
 
-(* With type
-  *)
+(* With type *)
 module type S = sig
   type t
 
@@ -6266,44 +5961,34 @@ let v =
 
 module F () = (val v)
 
-(* ok
-  *)
+(* ok *)
 module G (X : sig end) : S = F ()
 
-(* fail
-  *)
+(* fail *)
 module H () = F ()
 
-(* ok
-  *)
+(* ok *)
 
-(* Alias
-  *)
+(* Alias *)
 module U = struct end
 module M = F (struct end)
 
-(* ok
-  *)
+(* ok *)
 module M = F (U)
 
-(* fail
-  *)
+(* fail *)
 
-(* Cannot coerce between applicative and generative
-  *)
+(* Cannot coerce between applicative and generative *)
 module F1 (X : sig end) = struct end
 module F2 : functor () -> sig end = F1
 
-(* fail
-  *)
+(* fail *)
 module F3 () = struct end
 module F4 : functor (X : sig end) -> sig end = F3
 
-(* fail
-  *)
+(* fail *)
 
-(* tests for shortened functor notation ()
-  *)
+(* tests for shortened functor notation () *)
 module X (X : sig end) (Y : sig end) = functor (Z : sig end) -> struct end
 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
@@ -6377,10 +6062,8 @@ let f (x : entity entity_container) = ()
      method add_entity (s : entity) =
      entity_container#add_entity (s :> entity)
 
-     end
-  *)
-(* Two v's in the same class
-  *)
+     end *)
+(* Two v's in the same class *)
 class c v =
   object
     initializer print_endline v
@@ -6390,8 +6073,7 @@ class c v =
 
 new c "42"
 
-(* Two hidden v's in the same class!
-  *)
+(* Two hidden v's in the same class! *)
 class c (v : int) =
   object
     method v0 = v
@@ -6449,8 +6131,7 @@ class c (x : int) =
 
 let r = (new c 2)#x
 
-(* test.ml
-  *)
+(* test.ml *)
 class alfa =
   object (_ : 'self)
     method x : 'a. ('a, out_channel, unit) format -> 'a = Printf.printf
@@ -6468,8 +6149,7 @@ class charlie a =
     initializer y#x "charlie initialized"
   end
 
-(* The module begins
-  *)
+(* The module begins *)
 exception Out_of_range
 
 class type ['a] cursor = object
@@ -6665,9 +6345,7 @@ module UText = struct
     done
   ;;
 
-  let concat s1 s2 = s1#concat (s2 (* : #ustorage
-                                     *) :> uchar storage)
-
+  let concat s1 s2 = s1#concat (s2 (* : #ustorage *) :> uchar storage)
   let iter proc s = s#iter proc
 end
 
@@ -6771,8 +6449,7 @@ end
 type refer1 = < poly : 'a 'b 'c. (('b, 'c) #Classdef.cl2 as 'a) >
 type refer2 = < poly : 'a 'b 'c. (('b, 'c) #Classdef.cl2 as 'a) >
 
-(* Actually this should succeed ...
-  *)
+(* Actually this should succeed ... *)
 let f (x : refer1) : refer2 = x
 
 module Classdef = struct
@@ -6801,8 +6478,7 @@ end
 (*
      ocamlc -c pr3918a.mli pr3918b.mli
      rm -f pr3918a.cmi
-     ocamlc -c pr3918c.ml
-  *)
+     ocamlc -c pr3918c.ml *)
 
 open Pr3918b
 
@@ -6845,8 +6521,7 @@ module Make' (Unit : sig end) : Priv' = struct
 end
 
 module A' = Make' (struct end)
-(* PR5057
-  *)
+(* PR5057 *)
 
 module TT = struct
   module IntSet = Set.Make (struct
@@ -6874,8 +6549,7 @@ let () =
   f `A
 ;;
 
-(* This one should fail
-  *)
+(* This one should fail *)
 
 let f flag =
   let module T =
@@ -7022,8 +6696,7 @@ end =
 
 let f (x : F0.t) : Foobar.t = x
 
-(* fails
-  *)
+(* fails *)
 
 module F = Foobar
 
@@ -7046,8 +6719,7 @@ end =
 
 fun (x : M1.t) : M2.t -> x
 
-(* fails
-  *)
+(* fails *)
 
 module M3 : sig
   type t = private M1.t
@@ -7063,22 +6735,19 @@ module M4 : sig
 end =
   M2
 
-(* fails
-  *)
+(* fails *)
 module M4 : sig
   type t = private M3.t
 end =
   M
 
-(* fails
-  *)
+(* fails *)
 module M4 : sig
   type t = private M3.t
 end =
   M1
 
-(* might be ok
-  *)
+(* might be ok *)
 module M5 : sig
   type t = private M1.t
 end =
@@ -7089,8 +6758,7 @@ module M6 : sig
 end =
   M1
 
-(* fails
-  *)
+(* fails *)
 
 module Bar : sig
   type t = private Foobar.t
@@ -7102,8 +6770,7 @@ end = struct
   let f (x : int) : t = x
 end
 
-(* must fail
-  *)
+(* must fail *)
 
 module M : sig
   type t = private T of int
@@ -7147,8 +6814,7 @@ module M4 : sig
 end =
   M
 
-(* Error: The variant or record definition does not match that of type M.t
-  *)
+(* Error: The variant or record definition does not match that of type M.t *)
 
 module M5 : sig
   type t = M.t = private T of int
@@ -7195,8 +6861,7 @@ end = struct
   type 'a t = 'a M.t = private T of 'a
 end
 
-(* PR#6090
-  *)
+(* PR#6090 *)
 module Test = struct
   type t = private A
 end
@@ -7207,15 +6872,12 @@ let f (x : Test.t) : Test2.t = x
 let f Test2.A = ()
 let a = Test2.A
 
-(* fail
-  *)
+(* fail *)
 (* The following should fail from a semantical point of view,
-   but allow it for backward compatibility
-  *)
+   but allow it for backward compatibility *)
 module Test2 : module type of Test with type t = private Test.t = Test
 
-(* PR#6331
-  *)
+(* PR#6331 *)
 type t = private < x : int ; .. > as 'a
 type t = private (< x : int ; .. > as 'a) as 'a
 type t = private < x : int > as 'a
@@ -7223,16 +6885,14 @@ type t = private (< x : int > as 'a) as 'b
 type 'a t = private < x : int ; .. > as 'a
 type 'a t = private 'a constraint 'a = < x : int ; .. >
 
-(* Bad (t = t)
-  *)
+(* Bad (t = t) *)
 module rec A : sig
   type t = A.t
 end = struct
   type t = A.t
 end
 
-(* Bad (t = t)
-  *)
+(* Bad (t = t) *)
 module rec A : sig
   type t = B.t
 end = struct
@@ -7245,8 +6905,7 @@ end = struct
   type t = A.t
 end
 
-(* OK (t = int)
-  *)
+(* OK (t = int) *)
 module rec A : sig
   type t = B.t
 end = struct
@@ -7259,16 +6918,14 @@ end = struct
   type t = int
 end
 
-(* Bad (t = int * t)
-  *)
+(* Bad (t = int * t) *)
 module rec A : sig
   type t = int * A.t
 end = struct
   type t = int * A.t
 end
 
-(* Bad (t = t -> int)
-  *)
+(* Bad (t = t -> int) *)
 module rec A : sig
   type t = B.t -> int
 end = struct
@@ -7281,8 +6938,7 @@ end = struct
   type t = A.t
 end
 
-(* OK (t = <m:t>)
-  *)
+(* OK (t = <m:t>) *)
 module rec A : sig
   type t = < m : B.t >
 end = struct
@@ -7295,16 +6951,14 @@ end = struct
   type t = A.t
 end
 
-(* Bad (not regular)
-  *)
+(* Bad (not regular) *)
 module rec A : sig
   type 'a t = < m : 'a list A.t >
 end = struct
   type 'a t = < m : 'a list A.t >
 end
 
-(* Bad (not regular)
-  *)
+(* Bad (not regular) *)
 module rec A : sig
   type 'a t = < m : 'a list B.t ; n : 'a array B.t >
 end = struct
@@ -7317,8 +6971,7 @@ end = struct
   type 'a t = 'a A.t
 end
 
-(* Bad (not regular)
-  *)
+(* Bad (not regular) *)
 module rec A : sig
   type 'a t = 'a B.t
 end = struct
@@ -7331,8 +6984,7 @@ end = struct
   type 'a t = < m : 'a list A.t ; n : 'a array A.t >
 end
 
-(* OK
-  *)
+(* OK *)
 module rec A : sig
   type 'a t = 'a array B.t * 'a list B.t
 end = struct
@@ -7345,8 +6997,7 @@ end = struct
   type 'a t = < m : 'a B.t >
 end
 
-(* Bad (not regular)
-  *)
+(* Bad (not regular) *)
 module rec A : sig
   type 'a t = 'a list B.t
 end = struct
@@ -7359,8 +7010,7 @@ end = struct
   type 'a t = < m : 'a array B.t >
 end
 
-(* Bad (not regular)
-  *)
+(* Bad (not regular) *)
 module rec M : sig
   class ['a] c : 'a -> object
     method map : ('a -> 'b) -> 'b M.c
@@ -7372,8 +7022,7 @@ end = struct
     end
 end
 
-(* OK
-  *)
+(* OK *)
 class type ['node] extension = object
   method node : 'node
 end
@@ -7389,8 +7038,7 @@ class x =
 
 type t = x node
 
-(* Bad - PR 4261
-  *)
+(* Bad - PR 4261 *)
 
 module PR_4261 = struct
   module type S = sig
@@ -7407,8 +7055,7 @@ module PR_4261 = struct
   and U' : (S with type t = U'.t) = U
 end
 
-(* Bad - PR 4512
-  *)
+(* Bad - PR 4512 *)
 module type S' = sig
   type t = int
 end
@@ -7417,8 +7064,7 @@ module rec M : (S' with type t = M.t) = struct
   type t = M.t
 end
 
-(* PR#4450
-  *)
+(* PR#4450 *)
 
 module PR_4450_1 = struct
   module type MyT = sig
@@ -7459,8 +7105,7 @@ module PR_4450_2 = struct
 end
 
 (* A synthetic example of bootstrapped data structure
-   (suggested by J-C Filliatre)
-  *)
+   (suggested by J-C Filliatre) *)
 
 module type ORD = sig
   type t
@@ -7513,8 +7158,7 @@ module Bootstrap2
 
   let iter f = Diet.iter (Elt.iter f)
 end
-(* PR 4470: simplified from OMake's sources
-  *)
+(* PR 4470: simplified from OMake's sources *)
 
 module rec DirElt : sig
   type t =
@@ -7537,8 +7181,7 @@ and DirHash : sig
 end = struct
   type t = DirCompare.t list
 end
-(* PR 4758, PR 4266
-  *)
+(* PR 4758, PR 4266 *)
 
 module PR_4758 = struct
   module type S = sig end
@@ -7555,8 +7198,7 @@ module PR_4758 = struct
     module Other = A
   end
 
-  module C' = C (* check that we can take an alias
-                  *)
+  module C' = C (* check that we can take an alias *)
 
   module F (X : sig end) = struct
     type t
@@ -7565,8 +7207,7 @@ module PR_4758 = struct
   let f (x : F(C).t) : F(C').t = x
 end
 
-(* PR 4557
-  *)
+(* PR 4557 *)
 module PR_4557 = struct
   module F (X : Set.OrderedType) = struct
     module rec Mod : sig
@@ -7626,8 +7267,7 @@ module F (X : Set.OrderedType) = struct
 
   and ModSet : (Set.S with type elt = Mod.t) = Set.Make (Mod)
 end
-(* Tests for recursive modules
-  *)
+(* Tests for recursive modules *)
 
 let test number result expected =
   if result = expected
@@ -7636,8 +7276,7 @@ let test number result expected =
   flush stdout
 ;;
 
-(* Tree of sets
-  *)
+(* Tree of sets *)
 
 module rec A : sig
   type t =
@@ -7671,8 +7310,7 @@ let _ =
   test 14 (A.compare x y) 1
 ;;
 
-(* Simple value recursion
-  *)
+(* Simple value recursion *)
 
 module rec Fib : sig
   val f : int -> int
@@ -7682,8 +7320,7 @@ end
 
 let _ = test 20 (Fib.f 10) 89
 
-(* Update function by infix
-  *)
+(* Update function by infix *)
 
 module rec Fib2 : sig
   val f : int -> int
@@ -7694,8 +7331,7 @@ end
 
 let _ = test 21 (Fib2.f 10) 89
 
-(* Early application
-  *)
+(* Early application *)
 
 let _ =
   let res =
@@ -7718,18 +7354,15 @@ let _ =
   test 30 res true
 ;;
 
-(* Early strict evaluation
-  *)
+(* Early strict evaluation *)
 
 (*
      module rec Cyclic
      : sig val x : int end
      = struct let x = Cyclic.x + 1 end
-     ;;
-  *)
+     ;; *)
 
-(* Reordering of evaluation based on dependencies
-  *)
+(* Reordering of evaluation based on dependencies *)
 
 module rec After : sig
   val x : int
@@ -7745,8 +7378,7 @@ end
 
 let _ = test 40 After.x 4
 
-(* Type identity between A.t and t within A's definition
-  *)
+(* Type identity between A.t and t within A's definition *)
 
 module rec Strengthen : sig
   type t
@@ -7797,8 +7429,7 @@ end = struct
   end
 end
 
-(* Polymorphic recursion
-  *)
+(* Polymorphic recursion *)
 
 module rec PolyRec : sig
   type 'a t =
@@ -7819,8 +7450,7 @@ end = struct
   ;;
 end
 
-(* Wrong LHS signatures (PR#4336)
-  *)
+(* Wrong LHS signatures (PR#4336) *)
 
 (*
      module type ASig = sig type a val a:a val print:a -> unit end
@@ -7837,8 +7467,7 @@ end
      and NewB : BSig with type b = NewA.a = MakeB (struct end);;
   *)
 
-(* Expressions and bindings
-  *)
+(* Expressions and bindings *)
 
 module StringSet = Set.Make (String)
 
@@ -7904,8 +7533,7 @@ let _ =
   test 51 (Expr.simpl e) e'
 ;;
 
-(* Okasaki's bootstrapping
-  *)
+(* Okasaki's bootstrapping *)
 
 module type ORDERED = sig
   type t
@@ -8074,8 +7702,7 @@ let _ =
   test 62 (C.findMin (C.deleteMin (C.deleteMin h))) 4
 ;;
 
-(* Classes
-  *)
+(* Classes *)
 
 module rec Class1 : sig
   class c : object
@@ -8128,8 +7755,7 @@ let _ =
   | Undefined_recursive_module _ -> test 71 true true
 ;;
 
-(* Coercions
-  *)
+(* Coercions *)
 
 module rec Coerce1 : sig
   val g : int -> int
@@ -8186,8 +7812,7 @@ end =
 
 let _ = test 82 (Coerce6.at 100) 5
 
-(* Miscellaneous bug reports
-  *)
+(* Miscellaneous bug reports *)
 
 module rec F : sig
   type t =
@@ -8211,8 +7836,7 @@ let _ =
   test 101 (F.f (F.Y 2)) true
 ;;
 
-(* PR#4316
-  *)
+(* PR#4316 *)
 module G (S : sig
     val x : int Lazy.t
   end) =
@@ -8232,8 +7856,7 @@ end =
   G (M1)
 
 let _ = test 102 (Lazy.force M2.x) 3
-let _ = Gc.full_major () (* will shortcut forwarding in M1.x
-                           *)
+let _ = Gc.full_major () (* will shortcut forwarding in M1.x *)
 
 module rec M3 : sig
   val x : int Lazy.t
@@ -8251,28 +7874,22 @@ type t =
 
 let f (A r) = r
 
-(* -> escape
-  *)
+(* -> escape *)
 let f (A r) = r.x
 
-(* ok
-  *)
+(* ok *)
 let f x = A { x; y = x }
 
-(* ok
-  *)
+(* ok *)
 let f (A r) = A { r with y = r.x + 1 }
 
-(* ok
-  *)
+(* ok *)
 let f () = A { a = 1 }
 
-(* customized error message
-  *)
+(* customized error message *)
 let f () = A { x = 1; y = 3 }
 
-(* ok
-  *)
+(* ok *)
 
 type _ t =
   | A :
@@ -8283,12 +7900,10 @@ type _ t =
 
 let f (A { x; y }) = A { x; y = () }
 
-(* ok
-  *)
+(* ok *)
 let f (A ({ x; y } as r)) = A { x = r.x; y = r.y }
 
-(* ok
-  *)
+(* ok *)
 
 module M = struct
   type 'a t =
@@ -8323,8 +7938,7 @@ struct
   module A = (val X.x)
 end
 
-(* -> this expression creates fresh types (not really!)
-  *)
+(* -> this expression creates fresh types (not really!) *)
 
 module type S = sig
   exception A of { x : int }
@@ -8371,8 +7985,7 @@ module Z = struct
   type X2.t += A of { x : int }
 end
 
-(* PR#6716
-  *)
+(* PR#6716 *)
 
 type _ c = C : [ `A ] c
 type t = T : { x : [< `A ] c } -> t
@@ -8470,8 +8083,7 @@ open Core.Std
 let x = Int.Map.empty
 let y = x + x
 
-(* Avoid ambiguity
-  *)
+(* Avoid ambiguity *)
 
 module M = struct
   type t = A
@@ -8529,8 +8141,7 @@ module N2 = struct
   and v = M1.v
 end
 
-(* PR#6566
-  *)
+(* PR#6566 *)
 module type PR6566 = sig
   type t = string
 end
@@ -8554,32 +8165,26 @@ module M2 = struct
 end
 
 (* Adapted from: An Expressive Language of Signatures
-   by Norman Ramsey, Kathleen Fisher and Paul Govereau
-  *)
+   by Norman Ramsey, Kathleen Fisher and Paul Govereau *)
 
 module type VALUE = sig
-  type value (* a Lua value
-               *)
-  type state (* the state of a Lua interpreter
-               *)
-  type usert (* a user-defined value
-               *)
+  type value (* a Lua value *)
+  type state (* the state of a Lua interpreter *)
+  type usert (* a user-defined value *)
 end
 
 module type CORE0 = sig
   module V : VALUE
 
   val setglobal : V.state -> string -> V.value -> unit
-  (* five more functions common to core and evaluator
-    *)
+  (* five more functions common to core and evaluator *)
 end
 
 module type CORE = sig
   include CORE0
 
   val apply : V.value -> V.state -> V.value list -> V.value
-  (* apply function f in state s to list of args
-    *)
+  (* apply function f in state s to list of args *)
 end
 
 module type AST = sig
@@ -8700,8 +8305,7 @@ module type PrintableComparable = sig
   include Comparable with type t = t
 end
 
-(* Fails
-  *)
+(* Fails *)
 module type PrintableComparable = sig
   type t
 
@@ -8759,8 +8363,7 @@ module type S = sig
   end
   with type 'a t := unit
 
-(* Fails
-  *)
+(* Fails *)
 let property (type t) () =
   let module M = struct
     exception E of t
@@ -8797,16 +8400,14 @@ let sort_uniq (type s) cmp l =
 let () = print_endline (String.concat "," (sort_uniq compare [ "abc"; "xyz"; "abc" ]))
 let f x (type a) (y : a) = x = y
 
-(* Fails
-  *)
+(* Fails *)
 class ['a] c =
   object (self)
     method m : 'a -> 'a = fun x -> x
     method n : 'a -> 'a = fun (type g) (x : g) -> self#m x
   end
 
-(* Fails
-  *)
+(* Fails *)
 
 external a : (int[@untagged]) -> unit = "a" "a_nat"
 external b : (int32[@unboxed]) -> unit = "b" "b_nat"
@@ -8835,8 +8436,7 @@ module Global_attributes = struct
   external d : float -> float = "d" "noalloc"
   external e : float -> float = "e"
 
-  (* Should output a warning: no native implementation provided
-    *)
+  (* Should output a warning: no native implementation provided *)
   external f : (int32[@unboxed]) -> (int32[@unboxed]) = "f" "noalloc"
   external g : int32 -> int32 = "g" "g_nat" [@@unboxed] [@@noalloc]
   external h : (int[@untagged]) -> (int[@untagged]) = "h" "h_nat" "noalloc"
@@ -8853,8 +8453,7 @@ module Old_style_warning = struct
   external e : float -> float = "c" "float"
 end
 
-(* Bad: attributes not reported in the interface
-  *)
+(* Bad: attributes not reported in the interface *)
 
 module Bad1 : sig
   external f : int -> int = "f" "f_nat"
@@ -8880,8 +8479,7 @@ end = struct
   external f : (float[@unboxed]) -> float = "f" "f_nat"
 end
 
-(* Bad: attributes in the interface but not in the implementation
-  *)
+(* Bad: attributes in the interface but not in the implementation *)
 
 module Bad5 : sig
   external f : int -> (int[@untagged]) = "f" "f_nat"
@@ -8907,35 +8505,29 @@ end = struct
   external f : float -> float = "a" "a_nat"
 end
 
-(* Bad: unboxed or untagged with the wrong type
-  *)
+(* Bad: unboxed or untagged with the wrong type *)
 
 external g : (float[@untagged]) -> float = "g" "g_nat"
 external h : (int[@unboxed]) -> float = "h" "h_nat"
 
-(* Bad: unboxing the function type
-  *)
+(* Bad: unboxing the function type *)
 external i : (int -> float[@unboxed]) = "i" "i_nat"
 
-(* Bad: unboxing a "deep" sub-type.
-  *)
+(* Bad: unboxing a "deep" sub-type. *)
 external j : int -> (float[@unboxed]) * float = "j" "j_nat"
 
 (* This should be rejected, but it is quite complicated to do
-   in the current state of things
-  *)
+   in the current state of things *)
 
 external k : int -> (float[@unboxd]) = "k" "k_nat"
 
-(* Bad: old style annotations + new style attributes
-  *)
+(* Bad: old style annotations + new style attributes *)
 
 external l : float -> float = "l" "l_nat" "float" [@@unboxed]
 external m : (float[@unboxed]) -> float = "m" "m_nat" "float"
 external n : float -> float = "n" "noalloc" [@@noalloc]
 
-(* Warnings: unboxed / untagged without any native implementation
-  *)
+(* Warnings: unboxed / untagged without any native implementation *)
 external o : (float[@unboxed]) -> float = "o"
 external p : float -> (float[@unboxed]) = "p"
 external q : (int[@untagged]) -> float = "q"
@@ -8946,15 +8538,13 @@ external t : float -> float = "t" [@@unboxed]
 let _ = ignore ( + )
 let _ = raise Exit 3;;
 
-(* comment 9644 of PR#6000
-  *)
+(* comment 9644 of PR#6000 *)
 
 fun b -> if b then format_of_string "x" else "y";;
 fun b -> if b then "x" else format_of_string "y";;
 fun b : (_, _, _) format -> if b then "x" else "y"
 
-(* PR#7135
-  *)
+(* PR#7135 *)
 
 module PR7135 = struct
   module M : sig
@@ -8968,8 +8558,7 @@ module PR7135 = struct
   let lift2 (f : int -> int -> int) (x : t) (y : t) = f (x :> int) (y :> int)
 end
 
-(* exemple of non-ground coercion
-  *)
+(* exemple of non-ground coercion *)
 
 module Test1 = struct
   type t = private int
@@ -8980,15 +8569,13 @@ module Test1 = struct
   ;;
 end
 
-(* Warn about all relevant cases when possible
-  *)
+(* Warn about all relevant cases when possible *)
 let f = function
   | None, None -> 1
   | Some _, Some _ -> 2
 ;;
 
-(* Exhaustiveness check is very slow
-  *)
+(* Exhaustiveness check is very slow *)
 type _ t =
   | A : int t
   | B : bool t
@@ -9010,35 +8597,30 @@ let f
   | _, _, _, _, _, _, _, G, _, _ -> 1
 ;;
 
-(*| _ -> _
-  *)
+(*| _ -> _ *)
 
-(* Unused cases
-  *)
+(* Unused cases *)
 let f (x : int t) =
   match x with
   | A -> 1
   | _ -> 2
 ;;
 
-(* warn
-  *)
+(* warn *)
 let f (x : unit t option) =
   match x with
   | None -> 1
   | _ -> 2
 ;;
 
-(* warn?
-  *)
+(* warn? *)
 let f (x : unit t option) =
   match x with
   | None -> 1
   | Some _ -> 2
 ;;
 
-(* warn
-  *)
+(* warn *)
 let f (x : int t option) =
   match x with
   | None -> 1
@@ -9050,11 +8632,9 @@ let f (x : int t option) =
   | None -> 1
 ;;
 
-(* warn
-  *)
+(* warn *)
 
-(* Example with record, type, single case
-  *)
+(* Example with record, type, single case *)
 
 type 'a box = Box of 'a
 
@@ -9071,8 +8651,7 @@ let f : (string t box pair * bool) option -> unit = function
   | None -> ()
 ;;
 
-(* Examples from ML2015 paper
-  *)
+(* Examples from ML2015 paper *)
 
 type _ t =
   | Int : int t
@@ -9148,8 +8727,7 @@ let inv_zero : type a b c d. (a, b, c) plus -> (c, d, zero) plus -> bool =
   | Plus0, Plus0 -> true
 ;;
 
-(* Empty match
-  *)
+(* Empty match *)
 
 type _ t = Int : int t
 
@@ -9158,46 +8736,39 @@ let f (x : bool t) =
   | _ -> .
 ;;
 
-(* ok
-  *)
+(* ok *)
 
-(* trefis in PR#6437
-  *)
+(* trefis in PR#6437 *)
 
 let f () =
   match None with
   | _ -> .
 ;;
 
-(* error
-  *)
+(* error *)
 let g () =
   match None with
   | _ -> ()
   | exception _ -> .
 ;;
 
-(* error
-  *)
+(* error *)
 let h () =
   match None with
   | _ -> .
   | exception _ -> .
 ;;
 
-(* error
-  *)
+(* error *)
 let f x =
   match x with
   | _ -> ()
   | None -> .
 ;;
 
-(* do not warn
-  *)
+(* do not warn *)
 
-(* #7059, all clauses guarded
-  *)
+(* #7059, all clauses guarded *)
 
 let f x y =
   match 1 with
@@ -9214,8 +8785,7 @@ let f : label choice -> bool = function
   | Left -> true
 ;;
 
-(* warn
-  *)
+(* warn *)
 exception A
 
 type a = A;;
@@ -9267,8 +8837,7 @@ end
 type t = A : t
 
 module X1 : sig end = struct
-  let _f ~x (* x unused argument
-              *) = function
+  let _f ~x (* x unused argument *) = function
     | A ->
       let x = () in
       x
@@ -9276,8 +8845,7 @@ module X1 : sig end = struct
 end
 
 module X2 : sig end = struct
-  let x = 42 (* unused value
-               *)
+  let x = 42 (* unused value *)
 
   let _f = function
     | A ->
@@ -9288,12 +8856,10 @@ end
 
 module X3 : sig end = struct
   module O = struct
-    let x = 42 (* unused
-                 *)
+    let x = 42 (* unused *)
   end
 
-  open O (* unused open
-           *)
+  open O (* unused open *)
 
   let _f = function
     | A ->
@@ -9302,8 +8868,7 @@ module X3 : sig end = struct
   ;;
 end
 
-(* Use type information
-  *)
+(* Use type information *)
 module M1 = struct
   type t =
     { x : int
@@ -9319,19 +8884,16 @@ end
 module OK = struct
   open M1
 
-  let f1 (r : t) = r.x (* ok
-                         *)
+  let f1 (r : t) = r.x (* ok *)
 
   let f2 r =
     ignore (r : t);
-    r.x (* non principal
-          *)
+    r.x (* non principal *)
   ;;
 
   let f3 (r : t) =
     match r with
-    | { x; y } -> y + y (* ok
-                          *)
+    | { x; y } -> y + y (* ok *)
   ;;
 end
 
@@ -9344,8 +8906,7 @@ module F1 = struct
   ;;
 end
 
-(* fails
-  *)
+(* fails *)
 
 module F2 = struct
   open M1
@@ -9357,8 +8918,7 @@ module F2 = struct
   ;;
 end
 
-(* fails for -principal
-  *)
+(* fails for -principal *)
 
 (* Use type information with modules*)
 module M = struct
@@ -9368,16 +8928,13 @@ end
 
 let f (r : M.t) = r.M.x
 
-(* ok
-  *)
+(* ok *)
 let f (r : M.t) = r.x
 
-(* warning
-  *)
+(* warning *)
 let f ({ x } : M.t) = x
 
-(* warning
-  *)
+(* warning *)
 
 module M = struct
   type t =
@@ -9416,8 +8973,7 @@ module OK = struct
   let f (r : M.t) = r.x
 end
 
-(* Use field information
-  *)
+(* Use field information *)
 module M = struct
   type u =
     { x : bool
@@ -9437,16 +8993,14 @@ module OK = struct
   let f { x; z } = x, z
 end
 
-(* ok
-  *)
+(* ok *)
 module F3 = struct
   open M
 
   let r = { x = true; z = 'z' }
 end
 
-(* fail for missing label
-  *)
+(* fail for missing label *)
 
 module OK = struct
   type u =
@@ -9463,11 +9017,9 @@ module OK = struct
   let r = { x = 3; y = true }
 end
 
-(* ok
-  *)
+(* ok *)
 
-(* Corner cases
-  *)
+(* Corner cases *)
 
 module F4 = struct
   type foo =
@@ -9480,8 +9032,7 @@ module F4 = struct
   let b : bar = { x = 3; y = 4 }
 end
 
-(* fail but don't warn
-  *)
+(* fail but don't warn *)
 
 module M = struct
   type foo =
@@ -9499,8 +9050,7 @@ end
 
 let r = { M.x = 3; N.y = 4 }
 
-(* error: different definitions
-  *)
+(* error: different definitions *)
 
 module MN = struct
   include M
@@ -9514,11 +9064,9 @@ end
 
 let r = { MN.x = 3; NM.y = 4 }
 
-(* error: type would change with order
-  *)
+(* error: type would change with order *)
 
-(* Lpw25
-  *)
+(* Lpw25 *)
 
 module M = struct
   type foo =
@@ -9577,11 +9125,9 @@ end
 
 let f (r : B.t) = r.A.x
 
-(* fail
-  *)
+(* fail *)
 
-(* Spellchecking
-  *)
+(* Spellchecking *)
 
 module F8 = struct
   type t =
@@ -9592,8 +9138,7 @@ module F8 = struct
   let a : t = { x = 1; yyz = 2 }
 end
 
-(* PR#6004
-  *)
+(* PR#6004 *)
 
 type t = A
 type s = A
@@ -9601,17 +9146,14 @@ type s = A
 class f (_ : t) = object end
 class g = f A
 
-(* ok
-  *)
+(* ok *)
 
 class f (_ : 'a) (_ : 'a) = object end
 class g = f (A : t) A
 
-(* warn with -principal
-  *)
+(* warn with -principal *)
 
-(* PR#5980
-  *)
+(* PR#5980 *)
 
 module Shadow1 = struct
   type t = { x : int }
@@ -9620,8 +9162,7 @@ module Shadow1 = struct
     type s = { x : string }
   end
 
-  open M (* this open is unused, it isn't reported as shadowing 'x'
-           *)
+  open M (* this open is unused, it isn't reported as shadowing 'x' *)
 
   let y : t = { x = 0 }
 end
@@ -9633,14 +9174,12 @@ module Shadow2 = struct
     type s = { x : string }
   end
 
-  open M (* this open shadows label 'x'
-           *)
+  open M (* this open shadows label 'x' *)
 
   let y = { x = "" }
 end
 
-(* PR#6235
-  *)
+(* PR#6235 *)
 
 module P6235 = struct
   type t = { loc : string }
@@ -9658,8 +9197,7 @@ module P6235 = struct
   ;;
 end
 
-(* Remove interaction between branches
-  *)
+(* Remove interaction between branches *)
 
 module P6235' = struct
   type t = { loc : string }
@@ -9821,15 +9359,12 @@ let () = proj1 (inj2 42)
 let _ = ~-1
 
 class id = [%exp]
-(* checkpoint
-  *)
+(* checkpoint *)
 
-(* Subtyping is "syntactic"
-  *)
+(* Subtyping is "syntactic" *)
 let _ = fun (x : < x : int >) y z -> (y :> 'a), (x :> 'a), (z :> 'a)
 
-(* - : (< x : int > as 'a) -> 'a -> 'a * 'a = <fun>
-  *)
+(* - : (< x : int > as 'a) -> 'a -> 'a * 'a = <fun> *)
 
 class ['a] c () =
   object
@@ -9841,8 +9376,7 @@ and ['a] d () =
     inherit ['a] c ()
   end
 
-(* PR#7329 Pattern open
-  *)
+(* PR#7329 Pattern open *)
 let _ =
   let module M = struct
     type t = { x : int }
@@ -9883,8 +9417,7 @@ let g x = ~$(x.contents)
 let ( ~$ ) x y = x, y
 let g x y = ~$(x.contents) y.contents
 
-(* PR#7506: attributes on list tail
-  *)
+(* PR#7506: attributes on list tail *)
 
 let tail1 = [ 1; 2 ] [@hello]
 let tail2 = 0 :: ([ 1; 2 ] [@hello])
@@ -9919,13 +9452,11 @@ fun contents -> { contents = contents [@foo] };;
 (();
  ()) [@foo]
 
-(* https://github.com/LexiFi/gen_js_api/issues/61
-  *)
+(* https://github.com/LexiFi/gen_js_api/issues/61 *)
 
 let () = foo##.bar := ()
 
-(* "let open" in classes and class types
-  *)
+(* "let open" in classes and class types *)
 
 class c =
   let open M in
@@ -9939,8 +9470,7 @@ class type ct =
   method f : t
 end
 
-(* M.(::) notation
-  *)
+(* M.(::) notation *)
 module Exotic_list = struct
   module Inner = struct
     type ('a, 'b) t =
@@ -10044,8 +9574,8 @@ exception Second_exception
 
 module M = struct
   type t
-  [@@immediate] (* ______________________________________
-                  *) [@@deriving variants, sexp_of]
+  [@@immediate] (* ______________________________________ *)
+  [@@deriving variants, sexp_of]
 end
 
 module type Basic3 = sig
@@ -10076,8 +9606,7 @@ let _ =
   [ very_long_function_name____________________ very_long_argument_name____________ ]
 ;;
 
-(* FIX: exceed 90 columns
-  *)
+(* FIX: exceed 90 columns *)
 let _ =
   [%str
     let () = very_long_function_name__________________ very_long_argument_name____________]
@@ -10088,8 +9617,7 @@ let _ =
   }
 ;;
 
-(* FIX: exceed 90 columns
-  *)
+(* FIX: exceed 90 columns *)
 let _ =
   match () with
   | _ ->
@@ -10100,27 +9628,24 @@ let _ =
 
 let _ =
   aaaaaaa
-    (* __________________________________________________________________________________
-      *) := bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
+    (* __________________________________________________________________________________ *)
+    := bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
 ;;
 
 let g = f ~x (* this is a multiple-line-spanning
-                comment
-               *) ~y
+                comment *) ~y
 
 let f =
   very_long_function_name
     ~x:very_long_variable_name (* this is a multiple-line-spanning
-                                  comment
-                                 *)
+                                  comment *)
     ~y
 ;;
 
 let _ =
   match x with
   | { y =
-        (* _____________________________________________________________________
-          *)
+        (* _____________________________________________________________________ *)
         ( X _ | Y _ )
     } -> ()
 ;;
@@ -10129,8 +9654,7 @@ let _ =
   match x with
   | { y =
         ( Z
-        (* _____________________________________________________________________
-          *)
+        (* _____________________________________________________________________ *)
         | X _
         | Y _ )
     } -> ()
@@ -10138,26 +9662,16 @@ let _ =
 
 type t =
   [ `XXXX
-    (* __________________________________________________________________________________
-      *)
-  | `XXXX (* __________________________________________________________________
-            *)
-  | `XXXX (* _____________________________________________________
-            *)
-  | `XXXX (* ___________________________________________________
-            *)
-  | `XXXX (* ___________________________________________________
-            *)
-  | `XXXX (* ________________________________________________
-            *)
-  | `XXXX (* __________________________________________
-            *)
-  | `XXXX (* _________________________________________
-            *)
-  | `XXXX (* ______________________________________
-            *)
-  | `XXXX (* ____________________________________
-            *)
+    (* __________________________________________________________________________________ *)
+  | `XXXX (* __________________________________________________________________ *)
+  | `XXXX (* _____________________________________________________ *)
+  | `XXXX (* ___________________________________________________ *)
+  | `XXXX (* ___________________________________________________ *)
+  | `XXXX (* ________________________________________________ *)
+  | `XXXX (* __________________________________________ *)
+  | `XXXX (* _________________________________________ *)
+  | `XXXX (* ______________________________________ *)
+  | `XXXX (* ____________________________________ *)
   ]
 
 type t =
@@ -10182,8 +9696,7 @@ module Intro_sort = struct
           4-----o--------o--o--|-----o--4
                 |              |     |
           5-----o--------------o-----o--5
-       v}
-      *)
+       v} *)
     foooooooooo fooooo fooo;
     foooooooooo fooooo fooo;
     foooooooooo fooooo fooo
@@ -10203,8 +9716,7 @@ let nullsafe_optimistic_third_party_params_in_non_strict =
          there was no actionable way to change third party annotations. Now
          that we have such a support, this behavior should be reconsidered,
          provided our tooling and error reporting is friendly enough to be
-         smoothly used by developers.
-        *)
+         smoothly used by developers. *)
     ~default:true
     "Nullsafe: in this mode we treat non annotated third party method params as if they \
      were annotated as nullable."
@@ -10212,8 +9724,7 @@ let nullsafe_optimistic_third_party_params_in_non_strict =
 
 let foo () =
   if%bind
-    (* this is a medium length comment of some sort
-      *)
+    (* this is a medium length comment of some sort *)
     this is a medium length expression of_some sort
   then x
   else y
@@ -10221,35 +9732,31 @@ let foo () =
 
 let xxxxxx =
   let%map (* _____________________________
-             __________
-            *) () = yyyyyyyy in
+             __________ *) () = yyyyyyyy in
   { zzzzzzzzzzzzz }
 ;;
 
 let _ =
   match x with
   | _
-    when f ~f:(function [@ocaml.warning (* .......................................
-                                          *) "-4"] _ -> .) -> y
+    when f
+           ~f:(function [@ocaml.warning
+                          (* ....................................... *) "-4"] _ -> .) -> y
 ;;
 
 let[@a
-     (* .............................................. ........................... .......................... ......................
-       *)
+     (* .............................................. ........................... .......................... ...................... *)
      foo
      (* ....................... *)
      (* ................................. *)
      (* ...................... *)] _
   =
-  match[@ocaml.warning (* .......................................
-                         *) "-4"]
-    x [@attr (* .......................... ..................
-               *) some_attr]
+  match[@ocaml.warning (* ....................................... *) "-4"]
+    x [@attr (* .......................... .................. *) some_attr]
   with
   | _
     when f
-           ~f:(function[@ocaml.warning (* .......................................
-                                         *) "-4"]
+           ~f:(function[@ocaml.warning (* ....................................... *) "-4"]
              | _ -> .)
            ~f:(function[@ocaml.warning
                          (* ....................................... *)
@@ -10258,8 +9765,7 @@ let[@a
                           fooooooooooooooooooooooooooooooooooooo"]
              | _ -> .)
            ~f:(function[@ocaml.warning
-                         (* .......................................
-                           *)
+                         (* ....................................... *)
                          let x = a
                          and y = b in
                          x + y]
@@ -10267,8 +9773,7 @@ let[@a
     y [@attr
         (* ... *)
         (* ... *)
-        attr (* ...
-               *)]
+        attr (* ... *)]
 ;;
 
 let x =
@@ -10587,8 +10092,7 @@ let () =
   | _ -> ()
 ;;
 
-(* ocp-indent-compat: Docked fun after apply only if on the same line.
-  *)
+(* ocp-indent-compat: Docked fun after apply only if on the same line. *)
 
 let _ =
   fooooooooooooooooooooooooooooooo
diff --git a/test/passing/tests/polytypes-janestreet.ml.ref b/test/passing/tests/polytypes-janestreet.ml.ref
index a4c20ad5a6..0787402439 100644
--- a/test/passing/tests/polytypes-janestreet.ml.ref
+++ b/test/passing/tests/polytypes-janestreet.ml.ref
@@ -26,8 +26,7 @@ let t4 :
 ;;
 
 let foo : type a. a =
-  (* aaaaaa
-    *)
+  (* aaaaaa *)
   failwith "foo"
 ;;
 

From 34683951dba850c1a4cec24fecbc69ec9709be64 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Fri, 2 Jun 2023 15:54:01 +0200
Subject: [PATCH 079/115] Restore formatting of cinaps comments

---
 lib/Cmt.ml                          |  5 +++--
 lib/Cmt.mli                         |  3 +--
 lib/Cmts.ml                         | 17 ++++++++++++-----
 lib/Normalize_extended_ast.ml       |  2 +-
 test/passing/tests/cinaps.ml.ref    |  6 +++---
 test/passing/tests/js_source.ml.ocp |  8 ++------
 test/passing/tests/js_source.ml.ref |  8 ++------
 7 files changed, 24 insertions(+), 25 deletions(-)

diff --git a/lib/Cmt.ml b/lib/Cmt.ml
index 213a1543b4..b0696943c5 100644
--- a/lib/Cmt.ml
+++ b/lib/Cmt.ml
@@ -92,7 +92,7 @@ type decoded_kind =
   | Verbatim of string
   | Doc of string
   | Normal of string
-  | Code of string list
+  | Code of string
   | Asterisk_prefixed of string list
 
 type decoded = {prefix: string; suffix: string; kind: decoded_kind}
@@ -160,7 +160,8 @@ let decode ~parse_comments_as_doc {txt; loc} =
         let lines = unindent_lines ~opn_offset source in
         let lines = List.map ~f:String.rstrip lines in
         let lines = List.drop_while ~f:String.is_empty lines in
-        mk ~prefix:"$" ~suffix (Code lines)
+        let code = String.concat ~sep:"\n" lines in
+        mk ~prefix:"$" ~suffix (Code code)
     | '=' -> mk (Verbatim txt)
     | '*' -> mk ~prefix:"*" (Doc (String.drop_prefix txt 1))
     | _ when is_all_whitespace txt ->
diff --git a/lib/Cmt.mli b/lib/Cmt.mli
index d15de85bdd..b9a1eb9442 100644
--- a/lib/Cmt.mli
+++ b/lib/Cmt.mli
@@ -41,8 +41,7 @@ type decoded_kind =
   | Verbatim of string  (** Original content. *)
   | Doc of string  (** Original content. *)
   | Normal of string  (** Original content with whitespaces trimmed. *)
-  | Code of string list
-      (** Source code is line splitted with indentation removed. *)
+  | Code of string  (** Source code with indentation removed. *)
   | Asterisk_prefixed of string list
       (** Line splitted with asterisks removed. *)
 
diff --git a/lib/Cmts.ml b/lib/Cmts.ml
index 98641af208..0ef8ada853 100644
--- a/lib/Cmts.ml
+++ b/lib/Cmts.ml
@@ -528,9 +528,8 @@ end
 module Cinaps = struct
   open Fmt
 
-  (** Comments enclosed in [(*$], [$*)] are formatted as code. *)
-  let fmt code =
-    match code with
+  let fmt_code_str code =
+    match String.split_lines code with
     | [] | [""] -> str " "
     | [line] -> fmt "@ " $ str line $ fmt "@;<1 -2>"
     | lines ->
@@ -539,6 +538,12 @@ module Cinaps = struct
           | line -> fmt "@\n" $ str line
         in
         list lines "" fmt_line $ fmt "@;<1000 -2>"
+
+  (** Comments enclosed in [(*$], [$*)] are formatted as code. *)
+  let fmt ~fmt_code conf ~offset code =
+    match fmt_code conf ~offset code with
+    | Ok code -> fmt_code_str code
+    | Error _ -> fmt_code_str code
 end
 
 module Doc = struct
@@ -567,17 +572,19 @@ let fmt_cmt (conf : Conf.t) cmt ~fmt_code (_pos : Cmt.pos) =
   let open Fmt in
   let parse_comments_as_doc = conf.fmt_opts.ocp_indent_compat.v in
   let decoded = Cmt.decode ~parse_comments_as_doc cmt in
+  (* TODO: Offset should be computed from location. *)
+  let offset = 2 + String.length decoded.prefix in
   (fun k ->
     hvbox 2
       (str "(*" $ str decoded.prefix $ k $ str decoded.suffix $ str "*)") )
   @@
   match decoded.kind with
   | Verbatim txt -> Verbatim.fmt txt
-  | Doc txt -> Doc.fmt ~fmt_code conf ~loc:cmt.loc txt ~offset:2
+  | Doc txt -> Doc.fmt ~fmt_code conf ~loc:cmt.loc txt ~offset
   | Normal txt ->
       if conf.fmt_opts.wrap_comments.v then Wrapped.fmt txt
       else Unwrapped.fmt txt
-  | Code code -> Cinaps.fmt code
+  | Code code -> Cinaps.fmt ~fmt_code conf ~offset code
   | Asterisk_prefixed lines -> Asterisk_prefixed.fmt lines
 
 let fmt_cmts_aux t (conf : Conf.t) cmts ~fmt_code pos =
diff --git a/lib/Normalize_extended_ast.ml b/lib/Normalize_extended_ast.ml
index 181966bde2..1c0f1e9e47 100644
--- a/lib/Normalize_extended_ast.ml
+++ b/lib/Normalize_extended_ast.ml
@@ -169,7 +169,7 @@ module Normalized_cmt = struct
       | Verbatim txt -> (`Comment, txt)
       | Doc txt -> (`Doc_comment, normalize_doc txt)
       | Normal txt -> (`Comment, Docstring.normalize_text txt)
-      | Code code -> (`Comment, normalize_code (String.concat ~sep:"\n" code))
+      | Code code -> (`Comment, normalize_code code)
       | Asterisk_prefixed lines ->
           ( `Comment
           , String.concat ~sep:" "
diff --git a/test/passing/tests/cinaps.ml.ref b/test/passing/tests/cinaps.ml.ref
index e8911267be..141ed76d1b 100644
--- a/test/passing/tests/cinaps.ml.ref
+++ b/test/passing/tests/cinaps.ml.ref
@@ -19,10 +19,10 @@ let x = 1
 let y = 2
 
 (*$
-  ;; #use "import.cinaps"
+  #use "import.cinaps" ;;
 
-  ;; List.iter all_fields ~f:(fun (name, type_) -> printf "\nexternal get_%s
-  : unit -> %s = \"get_%s\"" name type_ name)
+  List.iter all_fields ~f:(fun (name, type_) ->
+      printf "\nexternal get_%s\n: unit -> %s = \"get_%s\"" name type_ name )
 *)
 external get_name : unit -> string = "get_name"
 
diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp
index 4246151f4f..51d264d5d6 100644
--- a/test/passing/tests/js_source.ml.ocp
+++ b/test/passing/tests/js_source.ml.ocp
@@ -10053,10 +10053,7 @@ class x =
 
 let _ =
   match () with
-  (*$
-    Printf.(
-      printf "\n  | _ -> .\n;;\n")
-  *)
+  (*$ Printf.(printf "\n  | _ -> .\n;;\n") *)
   | _ -> .
 ;;
 
@@ -10071,8 +10068,7 @@ let _ =
 (*$*)
 
 (*$
-  [%string
-    {| xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
+  [%string {| xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
   zzzzzzzzzzzzzzzzzzzzzzzzzzzz
       |}]
 *)
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index 3a292b4105..a29eebfc1a 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -10053,10 +10053,7 @@ class x =
 
 let _ =
   match () with
-  (*$
-    Printf.(
-      printf "\n  | _ -> .\n;;\n")
-  *)
+  (*$ Printf.(printf "\n  | _ -> .\n;;\n") *)
   | _ -> .
 ;;
 
@@ -10071,8 +10068,7 @@ let _ =
 (*$*)
 
 (*$
-      [%string
-        {| xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
+  [%string {| xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
   zzzzzzzzzzzzzzzzzzzzzzzzzzzz
       |}]
 *)

From aa805419375b5da9a8fbd05f64dfc539d40205dc Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Fri, 2 Jun 2023 16:24:01 +0200
Subject: [PATCH 080/115] Preserve pro/epi break on comments as doc

---
 lib/Cmt.ml                                    |   6 +-
 lib/Cmts.ml                                   |  12 +-
 .../tests/break_separators-after.ml.err       |   1 +
 .../tests/break_separators-after.ml.ref       |  16 +-
 .../break_separators-after_docked.ml.err      |   3 +-
 .../break_separators-after_docked.ml.ref      |  16 +-
 .../break_separators-before_docked.ml.err     |   1 +
 .../break_separators-before_docked.ml.ref     |  16 +-
 test/passing/tests/break_separators.ml        |  16 +-
 test/passing/tests/break_separators.ml.err    |   1 +
 test/passing/tests/js_source.ml.err           |  12 +-
 test/passing/tests/js_source.ml.ocp           |  42 +++--
 test/passing/tests/js_source.ml.ref           | 160 ++++++++++--------
 test/passing/tests/ocp_indent_compat.ml       |  24 +--
 test/passing/tests/ocp_indent_compat.ml.err   |   2 +-
 15 files changed, 167 insertions(+), 161 deletions(-)

diff --git a/lib/Cmt.ml b/lib/Cmt.ml
index b0696943c5..73980b3deb 100644
--- a/lib/Cmt.ml
+++ b/lib/Cmt.ml
@@ -132,9 +132,7 @@ let split_asterisk_prefixed lines =
 
 let mk ?(prefix = "") ?(suffix = "") kind = {prefix; suffix; kind}
 
-let is_all_whitespace s =
-  Option.is_none
-  @@ String.lfindi s ~f:(fun _ c -> not (Char.is_whitespace c))
+let is_all_whitespace s = String.for_all s ~f:Char.is_whitespace
 
 let decode ~parse_comments_as_doc {txt; loc} =
   let txt =
@@ -159,7 +157,7 @@ let decode ~parse_comments_as_doc {txt; loc} =
         let source = String.rstrip (String.sub ~pos:1 ~len txt) in
         let lines = unindent_lines ~opn_offset source in
         let lines = List.map ~f:String.rstrip lines in
-        let lines = List.drop_while ~f:String.is_empty lines in
+        let lines = List.drop_while ~f:is_all_whitespace lines in
         let code = String.concat ~sep:"\n" lines in
         mk ~prefix:"$" ~suffix (Code code)
     | '=' -> mk (Verbatim txt)
diff --git a/lib/Cmts.ml b/lib/Cmts.ml
index 0ef8ada853..b94ce0e1f8 100644
--- a/lib/Cmts.ml
+++ b/lib/Cmts.ml
@@ -550,22 +550,22 @@ module Doc = struct
   let fmt ~fmt_code conf ~loc txt ~offset =
     (* Whether the doc starts and ends with an empty line. *)
     let pre_nl, trail_nl =
-      let lines = String.split_lines txt in
+      let lines = String.split ~on:'\n' txt in
       match lines with
       | [] | [_] -> (false, false)
       | h :: _ ->
           let l = List.last_exn lines in
           (is_only_whitespaces h, is_only_whitespaces l)
     in
-    let doc = if pre_nl then String.lstrip txt else txt in
-    let doc = if trail_nl then String.rstrip doc else doc in
-    let parsed = Docstring.parse ~loc doc in
+    let txt = if pre_nl then String.lstrip txt else txt in
+    let txt = if trail_nl then String.rstrip txt else txt in
+    let parsed = Docstring.parse ~loc txt in
     (* Disable warnings when parsing of code blocks fails. *)
     let quiet = Conf_t.Elt.make true `Default in
     let conf = {conf with Conf.opr_opts= {conf.Conf.opr_opts with quiet}} in
-    let doc = Fmt_odoc.fmt_parsed conf ~fmt_code ~input:doc ~offset parsed in
+    let doc = Fmt_odoc.fmt_parsed conf ~fmt_code ~input:txt ~offset parsed in
     let open Fmt in
-    wrap_k (fmt_if pre_nl "@;<1000 3>") (fmt_if trail_nl "@\n") @@ doc
+    wrap_k (fmt_if pre_nl "@;<1000 1>") (fmt_if trail_nl "@;<1000 -2>") doc
 end
 
 let fmt_cmt (conf : Conf.t) cmt ~fmt_code (_pos : Cmt.pos) =
diff --git a/test/passing/tests/break_separators-after.ml.err b/test/passing/tests/break_separators-after.ml.err
index e69de29bb2..7de3e58d2b 100644
--- a/test/passing/tests/break_separators-after.ml.err
+++ b/test/passing/tests/break_separators-after.ml.err
@@ -0,0 +1 @@
+Warning: tests/break_separators.ml:289 exceeds the margin
diff --git a/test/passing/tests/break_separators-after.ml.ref b/test/passing/tests/break_separators-after.ml.ref
index 391c814918..fa0b13d651 100644
--- a/test/passing/tests/break_separators-after.ml.ref
+++ b/test/passing/tests/break_separators-after.ml.ref
@@ -274,11 +274,9 @@ let x
     cccccc= cccc ccccccccccccccccccccccc }
 
 let foooooooooooooooooooooooooooooooooo =
-  { (* foooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
-      *)
+  { (* foooooooooooooooooooooooooooooooooooooooooooooooooooooooooo *)
     aaaaaaaaaaaa= aaaaaaaaaaaaaaaaa;
-    (* fooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
-      *)
+    (* fooooooooooooooooooooooooooooooooooooooooooooooooooooooooo *)
     bbbbbbbbbbbbb= bbb bb bbbbbb;
     cccccc= cccc ccccccccccccccccccccccc }
 
@@ -289,8 +287,7 @@ let foooooooooooo =
 
 let foooooooooooo =
   { foooooooooooooo with
-    (* foooooooooooooooo fooooooooooooooooooooooooo foooooooooooooooooooooo
-      *)
+    (* foooooooooooooooo fooooooooooooooooooooooooo foooooooooooooooooooooo *)
     fooooooooooooooooooooooooooooo= fooooooooooooo;
     fooooooooooooo= foooooooooooooo }
 
@@ -373,14 +370,13 @@ let g () =
        hhhhhhhhhh |] ->
       fooooooooo
 
-let () = match x with _, (* line 1 line 2
-                           *) Some _ -> x
+let () = match x with _, (* line 1 line 2 *)
+                         Some _ -> x
 
 let () =
   match x with
   | ( _,
       (* verrrrrrrrrrrrrrrrrrrrrrrry looooooooooooooooong line 1
-         veeeeeeeeeeeeeeeeeeeeeryyyy loooooooooooooooooong line 2
-        *)
+         veeeeeeeeeeeeeeeeeeeeeryyyy loooooooooooooooooong line 2 *)
       Some _ ) ->
       x
diff --git a/test/passing/tests/break_separators-after_docked.ml.err b/test/passing/tests/break_separators-after_docked.ml.err
index 07c663bc61..fd77cc8910 100644
--- a/test/passing/tests/break_separators-after_docked.ml.err
+++ b/test/passing/tests/break_separators-after_docked.ml.err
@@ -1 +1,2 @@
-Warning: tests/break_separators.ml:337 exceeds the margin
+Warning: tests/break_separators.ml:324 exceeds the margin
+Warning: tests/break_separators.ml:334 exceeds the margin
diff --git a/test/passing/tests/break_separators-after_docked.ml.ref b/test/passing/tests/break_separators-after_docked.ml.ref
index c56548e895..5afade9dec 100644
--- a/test/passing/tests/break_separators-after_docked.ml.ref
+++ b/test/passing/tests/break_separators-after_docked.ml.ref
@@ -305,11 +305,9 @@ let x
 
 let foooooooooooooooooooooooooooooooooo =
   {
-    (* foooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
-      *)
+    (* foooooooooooooooooooooooooooooooooooooooooooooooooooooooooo *)
     aaaaaaaaaaaa= aaaaaaaaaaaaaaaaa;
-    (* fooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
-      *)
+    (* fooooooooooooooooooooooooooooooooooooooooooooooooooooooooo *)
     bbbbbbbbbbbbb= bbb bb bbbbbb;
     cccccc= cccc ccccccccccccccccccccccc;
   }
@@ -324,8 +322,7 @@ let foooooooooooo =
 let foooooooooooo =
   {
     foooooooooooooo with
-    (* foooooooooooooooo fooooooooooooooooooooooooo foooooooooooooooooooooo
-      *)
+    (* foooooooooooooooo fooooooooooooooooooooooooo foooooooooooooooooooooo *)
     fooooooooooooooooooooooooooooo= fooooooooooooo;
     fooooooooooooo= foooooooooooooo;
   }
@@ -422,14 +419,13 @@ let g () =
   |] ->
       fooooooooo
 
-let () = match x with _, (* line 1 line 2
-                           *) Some _ -> x
+let () = match x with _, (* line 1 line 2 *)
+                         Some _ -> x
 
 let () =
   match x with
   | ( _,
       (* verrrrrrrrrrrrrrrrrrrrrrrry looooooooooooooooong line 1
-         veeeeeeeeeeeeeeeeeeeeeryyyy loooooooooooooooooong line 2
-        *)
+         veeeeeeeeeeeeeeeeeeeeeryyyy loooooooooooooooooong line 2 *)
       Some _ ) ->
       x
diff --git a/test/passing/tests/break_separators-before_docked.ml.err b/test/passing/tests/break_separators-before_docked.ml.err
index e69de29bb2..43e94ebf2b 100644
--- a/test/passing/tests/break_separators-before_docked.ml.err
+++ b/test/passing/tests/break_separators-before_docked.ml.err
@@ -0,0 +1 @@
+Warning: tests/break_separators.ml:324 exceeds the margin
diff --git a/test/passing/tests/break_separators-before_docked.ml.ref b/test/passing/tests/break_separators-before_docked.ml.ref
index 490662cadd..ba8931df39 100644
--- a/test/passing/tests/break_separators-before_docked.ml.ref
+++ b/test/passing/tests/break_separators-before_docked.ml.ref
@@ -305,11 +305,9 @@ let x
 
 let foooooooooooooooooooooooooooooooooo =
   {
-    (* foooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
-      *)
+    (* foooooooooooooooooooooooooooooooooooooooooooooooooooooooooo *)
     aaaaaaaaaaaa= aaaaaaaaaaaaaaaaa
-  ; (* fooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
-      *)
+  ; (* fooooooooooooooooooooooooooooooooooooooooooooooooooooooooo *)
     bbbbbbbbbbbbb= bbb bb bbbbbb
   ; cccccc= cccc ccccccccccccccccccccccc
   }
@@ -324,8 +322,7 @@ let foooooooooooo =
 let foooooooooooo =
   {
     foooooooooooooo with
-    (* foooooooooooooooo fooooooooooooooooooooooooo foooooooooooooooooooooo
-      *)
+    (* foooooooooooooooo fooooooooooooooooooooooooo foooooooooooooooooooooo *)
     fooooooooooooooooooooooooooooo= fooooooooooooo
   ; fooooooooooooo= foooooooooooooo
   }
@@ -422,14 +419,13 @@ let g () =
   |] ->
       fooooooooo
 
-let () = match x with _, (* line 1 line 2
-                           *) Some _ -> x
+let () = match x with _, (* line 1 line 2 *)
+                         Some _ -> x
 
 let () =
   match x with
   | ( _
     , (* verrrrrrrrrrrrrrrrrrrrrrrry looooooooooooooooong line 1
-         veeeeeeeeeeeeeeeeeeeeeryyyy loooooooooooooooooong line 2
-        *)
+         veeeeeeeeeeeeeeeeeeeeeryyyy loooooooooooooooooong line 2 *)
       Some _ ) ->
       x
diff --git a/test/passing/tests/break_separators.ml b/test/passing/tests/break_separators.ml
index d7bd56273d..900e80fe92 100644
--- a/test/passing/tests/break_separators.ml
+++ b/test/passing/tests/break_separators.ml
@@ -274,11 +274,9 @@ let x
   ; cccccc= cccc ccccccccccccccccccccccc }
 
 let foooooooooooooooooooooooooooooooooo =
-  { (* foooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
-      *)
+  { (* foooooooooooooooooooooooooooooooooooooooooooooooooooooooooo *)
     aaaaaaaaaaaa= aaaaaaaaaaaaaaaaa
-  ; (* fooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
-      *)
+  ; (* fooooooooooooooooooooooooooooooooooooooooooooooooooooooooo *)
     bbbbbbbbbbbbb= bbb bb bbbbbb
   ; cccccc= cccc ccccccccccccccccccccccc }
 
@@ -289,8 +287,7 @@ let foooooooooooo =
 
 let foooooooooooo =
   { foooooooooooooo with
-    (* foooooooooooooooo fooooooooooooooooooooooooo foooooooooooooooooooooo
-      *)
+    (* foooooooooooooooo fooooooooooooooooooooooooo foooooooooooooooooooooo *)
     fooooooooooooooooooooooooooooo= fooooooooooooo
   ; fooooooooooooo= foooooooooooooo }
 
@@ -373,14 +370,13 @@ let g () =
      ; hhhhhhhhhh |] ->
       fooooooooo
 
-let () = match x with _, (* line 1 line 2
-                           *) Some _ -> x
+let () = match x with _, (* line 1 line 2 *)
+                         Some _ -> x
 
 let () =
   match x with
   | ( _
     , (* verrrrrrrrrrrrrrrrrrrrrrrry looooooooooooooooong line 1
-         veeeeeeeeeeeeeeeeeeeeeryyyy loooooooooooooooooong line 2
-        *)
+         veeeeeeeeeeeeeeeeeeeeeryyyy loooooooooooooooooong line 2 *)
       Some _ ) ->
       x
diff --git a/test/passing/tests/break_separators.ml.err b/test/passing/tests/break_separators.ml.err
index e69de29bb2..7de3e58d2b 100644
--- a/test/passing/tests/break_separators.ml.err
+++ b/test/passing/tests/break_separators.ml.err
@@ -0,0 +1 @@
+Warning: tests/break_separators.ml:289 exceeds the margin
diff --git a/test/passing/tests/js_source.ml.err b/test/passing/tests/js_source.ml.err
index 6f3ab21084..addaec2421 100644
--- a/test/passing/tests/js_source.ml.err
+++ b/test/passing/tests/js_source.ml.err
@@ -1,7 +1,7 @@
 Warning: tests/js_source.ml:155 exceeds the margin
-Warning: tests/js_source.ml:3553 exceeds the margin
-Warning: tests/js_source.ml:9508 exceeds the margin
-Warning: tests/js_source.ml:9611 exceeds the margin
-Warning: tests/js_source.ml:9630 exceeds the margin
-Warning: tests/js_source.ml:9664 exceeds the margin
-Warning: tests/js_source.ml:9747 exceeds the margin
+Warning: tests/js_source.ml:3556 exceeds the margin
+Warning: tests/js_source.ml:9522 exceeds the margin
+Warning: tests/js_source.ml:9625 exceeds the margin
+Warning: tests/js_source.ml:9644 exceeds the margin
+Warning: tests/js_source.ml:9678 exceeds the margin
+Warning: tests/js_source.ml:9761 exceeds the margin
diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp
index 51d264d5d6..f1edf05818 100644
--- a/test/passing/tests/js_source.ml.ocp
+++ b/test/passing/tests/js_source.ml.ocp
@@ -1448,12 +1448,14 @@ let ty_list : type a e. (a, e) ty -> (a vlist, e) ty =
    and (_,_) ty_pvar =
    | Pnil : ('a,'e) ty_pvar
    | Pconst : 't * ('b,'e) ty_pvar -> ('t -> 'b, 'e) ty_pvar
-   | Parg : 't * ('a,'e) ty * ('b,'e) ty_pvar -> ('t * 'a -> 'b, 'e) ty_pvar *)
+   | Parg : 't * ('a,'e) ty * ('b,'e) ty_pvar -> ('t * 'a -> 'b, 'e) ty_pvar
+*)
 (*
    An attempt at encoding omega examples from the 2nd Central European
    Functional Programming School:
    Generic Programming in Omega, by Tim Sheard and Nathan Linger
-   http://web.cecs.pdx.edu/~sheard/ *)
+   http://web.cecs.pdx.edu/~sheard/
+*)
 
 (* Basic types *)
 
@@ -1647,7 +1649,8 @@ type (_, _) diff = Diff : 'c nat * ('a, 'c, 'b) plus -> ('a, 'b) diff
    | NS x, NZ, _ -> assert false
    | NS x, NS y, q ->
    match diff (smaller q) x y with Diff (m, p) -> Diff (m, PlusS p)
-   ;; *)
+   ;;
+*)
 
 let rec diff : type a b. (a, b) le -> a nat -> b nat -> (a, b) diff =
   fun le a b ->
@@ -4630,7 +4633,8 @@ let f3 (x : M'.t) : Std2.M.t = x
    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 *)
+   end
+*)
 module type INCLUDING = sig
   include module type of List
   include module type of ListLabels
@@ -4810,7 +4814,8 @@ end
    type 'a list_wrap = 'a list)
    -> S with type t = Html5_types.div Html5.elt and
    type u = < foo: Html5.uri >
-   end *)
+   end
+*)
 module type S = sig
   include Set.S
 
@@ -5018,7 +5023,8 @@ 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) *)
+   let _ = Printf.printf "Oh dear: %s" (cast bad 42)
+*)
 module M = struct
   module type S = sig
     type a
@@ -5235,7 +5241,8 @@ module type S' = S with module M := String
    and module type SeededS := Hashtbl.SeededS
    and module type HashedType := Hashtbl.HashedType
    and module type SeededHashedType := Hashtbl.SeededHashedType)
-   end;; *)
+   end;;
+*)
 
 (* A subtle problem appearing with -principal *)
 type -'a t
@@ -5668,7 +5675,8 @@ end
    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 *) *)
+   SInt2.mem 2 s';; (* invariants are broken *)
+*)
 
 (* Check behavior with submodules *)
 module M = struct
@@ -5851,13 +5859,15 @@ 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
+*)
 
 include D'
 
 (*
    let () =
-   print_endline (string_of_int D'.M.y) *)
+   print_endline (string_of_int D'.M.y)
+*)
 open A
 
 let f = L.map S.capitalize
@@ -5870,7 +5880,8 @@ 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 *)
 let x = 3
@@ -6062,7 +6073,8 @@ let f (x : entity entity_container) = ()
    method add_entity (s : entity) =
    entity_container#add_entity (s :> entity)
 
-   end *)
+   end
+*)
 (* Two v's in the same class *)
 class c v =
   object
@@ -6478,7 +6490,8 @@ end
 (*
    ocamlc -c pr3918a.mli pr3918b.mli
    rm -f pr3918a.cmi
-   ocamlc -c pr3918c.ml *)
+   ocamlc -c pr3918c.ml
+*)
 
 open Pr3918b
 
@@ -7360,7 +7373,8 @@ let _ =
    module rec Cyclic
    : sig val x : int end
    = struct let x = Cyclic.x + 1 end
-   ;; *)
+   ;;
+*)
 
 (* Reordering of evaluation based on dependencies *)
 
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index a29eebfc1a..961d61ebaa 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -1441,19 +1441,21 @@ let ty_list : type a e. (a, e) ty -> (a vlist, e) ty =
 ;;
 
 (*
-     type (_,_) ty_assoc =
-     | Anil : (unit,'e) ty_assoc
-     | Acons : string * ('a,'e) ty * ('b,'e) ty_assoc -> ('a -> 'b, 'e) ty_assoc
-
-     and (_,_) ty_pvar =
-     | Pnil : ('a,'e) ty_pvar
-     | Pconst : 't * ('b,'e) ty_pvar -> ('t -> 'b, 'e) ty_pvar
-     | Parg : 't * ('a,'e) ty * ('b,'e) ty_pvar -> ('t * 'a -> 'b, 'e) ty_pvar *)
+   type (_,_) ty_assoc =
+   | Anil : (unit,'e) ty_assoc
+   | Acons : string * ('a,'e) ty * ('b,'e) ty_assoc -> ('a -> 'b, 'e) ty_assoc
+
+   and (_,_) ty_pvar =
+   | Pnil : ('a,'e) ty_pvar
+   | Pconst : 't * ('b,'e) ty_pvar -> ('t -> 'b, 'e) ty_pvar
+   | Parg : 't * ('a,'e) ty * ('b,'e) ty_pvar -> ('t * 'a -> 'b, 'e) ty_pvar
+*)
 (*
-     An attempt at encoding omega examples from the 2nd Central European
-     Functional Programming School:
-     Generic Programming in Omega, by Tim Sheard and Nathan Linger
-     http://web.cecs.pdx.edu/~sheard/ *)
+   An attempt at encoding omega examples from the 2nd Central European
+   Functional Programming School:
+   Generic Programming in Omega, by Tim Sheard and Nathan Linger
+   http://web.cecs.pdx.edu/~sheard/
+*)
 
 (* Basic types *)
 
@@ -1640,14 +1642,15 @@ let smaller : type a b. (a succ, b succ) le -> (a, b) le = function
 type (_, _) diff = Diff : 'c nat * ('a, 'c, 'b) plus -> ('a, 'b) diff
 
 (*
-     let rec diff : type a b. (a,b) le -> a nat -> b nat -> (a,b) diff =
-     fun le a b ->
-     match a, b, le with
-     | NZ, m, _ -> Diff (m, PlusZ m)
-     | NS x, NZ, _ -> assert false
-     | NS x, NS y, q ->
-     match diff (smaller q) x y with Diff (m, p) -> Diff (m, PlusS p)
-     ;; *)
+   let rec diff : type a b. (a,b) le -> a nat -> b nat -> (a,b) diff =
+   fun le a b ->
+   match a, b, le with
+   | NZ, m, _ -> Diff (m, PlusZ m)
+   | NS x, NZ, _ -> assert false
+   | NS x, NS y, q ->
+   match diff (smaller q) x y with Diff (m, p) -> Diff (m, PlusS p)
+   ;;
+*)
 
 let rec diff : type a b. (a, b) le -> a nat -> b nat -> (a, b) diff =
   fun le a b ->
@@ -3294,15 +3297,15 @@ Error: Types marked with the immediate attribute must be
 |}]
 
 (*
-     Implicit unpack allows to omit the signature in (val ...) expressions.
+   Implicit unpack allows to omit the signature in (val ...) expressions.
 
-     It also adds (module M : S) and (module M) patterns, relying on
-     implicit (val ...) for the implementation. Such patterns can only
-     be used in function definition, match clauses, and let ... in.
+   It also adds (module M : S) and (module M) patterns, relying on
+   implicit (val ...) for the implementation. Such patterns can only
+   be used in function definition, match clauses, and let ... in.
 
-     New: implicit pack is also supported, and you only need to be able
-     to infer the the module type path from the context.
-  *)
+   New: implicit pack is also supported, and you only need to be able
+   to infer the the module type path from the context.
+*)
 (* ocaml -principal *)
 
 (* Use a module pattern *)
@@ -4630,7 +4633,8 @@ let f3 (x : M'.t) : Std2.M.t = x
    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 *)
+   end
+*)
 module type INCLUDING = sig
   include module type of List
   include module type of ListLabels
@@ -4810,7 +4814,8 @@ end
    type 'a list_wrap = 'a list)
    -> S with type t = Html5_types.div Html5.elt and
    type u = < foo: Html5.uri >
-   end *)
+   end
+*)
 module type S = sig
   include Set.S
 
@@ -5018,7 +5023,8 @@ 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) *)
+   let _ = Printf.printf "Oh dear: %s" (cast bad 42)
+*)
 module M = struct
   module type S = sig
     type a
@@ -5221,21 +5227,22 @@ module type S' = S with module M := String
 
 (* with module type *)
 (*
-     module type S = sig module type T module F(X:T) : T end;;
-     module type T0 = sig type t end;;
-     module type S1 = S with module type T = T0;;
-     module type S2 = S with module type T := T0;;
-     module type S3 = S with module type T := sig type t = int end;;
-     module H = struct
-     include (Hashtbl : module type of Hashtbl with
-     type statistics := Hashtbl.statistics
-     and module type S := Hashtbl.S
-     and module Make := Hashtbl.Make
-     and module MakeSeeded := Hashtbl.MakeSeeded
-     and module type SeededS := Hashtbl.SeededS
-     and module type HashedType := Hashtbl.HashedType
-     and module type SeededHashedType := Hashtbl.SeededHashedType)
-     end;; *)
+   module type S = sig module type T module F(X:T) : T end;;
+   module type T0 = sig type t end;;
+   module type S1 = S with module type T = T0;;
+   module type S2 = S with module type T := T0;;
+   module type S3 = S with module type T := sig type t = int end;;
+   module H = struct
+   include (Hashtbl : module type of Hashtbl with
+   type statistics := Hashtbl.statistics
+   and module type S := Hashtbl.S
+   and module Make := Hashtbl.Make
+   and module MakeSeeded := Hashtbl.MakeSeeded
+   and module type SeededS := Hashtbl.SeededS
+   and module type HashedType := Hashtbl.HashedType
+   and module type SeededHashedType := Hashtbl.SeededHashedType)
+   end;;
+*)
 
 (* A subtle problem appearing with -principal *)
 type -'a t
@@ -5668,7 +5675,8 @@ end
    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 *) *)
+   SInt2.mem 2 s';; (* invariants are broken *)
+*)
 
 (* Check behavior with submodules *)
 module M = struct
@@ -5851,13 +5859,15 @@ 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
+*)
 
 include D'
 
 (*
-     let () =
-     print_endline (string_of_int D'.M.y) *)
+   let () =
+   print_endline (string_of_int D'.M.y)
+*)
 open A
 
 let f = L.map S.capitalize
@@ -5870,7 +5880,8 @@ 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 *)
 let x = 3
@@ -6055,14 +6066,15 @@ class ['entity] entity_container =
 let f (x : entity entity_container) = ()
 
 (*
-     class world =
-     object
-     val entity_container : entity entity_container = new entity_container
+   class world =
+   object
+   val entity_container : entity entity_container = new entity_container
 
-     method add_entity (s : entity) =
-     entity_container#add_entity (s :> entity)
+   method add_entity (s : entity) =
+   entity_container#add_entity (s :> entity)
 
-     end *)
+   end
+*)
 (* Two v's in the same class *)
 class c v =
   object
@@ -6476,9 +6488,10 @@ end = struct
   type refer = { poly : 'a 'b 'c. (('b, 'c) #Classdef.cl2 as 'a) }
 end
 (*
-     ocamlc -c pr3918a.mli pr3918b.mli
-     rm -f pr3918a.cmi
-     ocamlc -c pr3918c.ml *)
+   ocamlc -c pr3918a.mli pr3918b.mli
+   rm -f pr3918a.cmi
+   ocamlc -c pr3918c.ml
+*)
 
 open Pr3918b
 
@@ -7357,10 +7370,11 @@ let _ =
 (* Early strict evaluation *)
 
 (*
-     module rec Cyclic
-     : sig val x : int end
-     = struct let x = Cyclic.x + 1 end
-     ;; *)
+   module rec Cyclic
+   : sig val x : int end
+   = struct let x = Cyclic.x + 1 end
+   ;;
+*)
 
 (* Reordering of evaluation based on dependencies *)
 
@@ -7453,19 +7467,19 @@ end
 (* Wrong LHS signatures (PR#4336) *)
 
 (*
-     module type ASig = sig type a val a:a val print:a -> unit end
-     module type BSig = sig type b val b:b val print:b -> unit end
+   module type ASig = sig type a val a:a val print:a -> unit end
+   module type BSig = sig type b val b:b val print:b -> unit end
 
-     module A = struct type a = int let a = 0 let print = print_int end
-     module B = struct type b = float let b = 0.0 let print = print_float end
+   module A = struct type a = int let a = 0 let print = print_int end
+   module B = struct type b = float let b = 0.0 let print = print_float end
 
-     module MakeA (Empty:sig end) : ASig = A
-     module MakeB (Empty:sig end) : BSig = B
+   module MakeA (Empty:sig end) : ASig = A
+   module MakeB (Empty:sig end) : BSig = B
 
-     module
-     rec NewA : ASig = MakeA (struct end)
-     and NewB : BSig with type b = NewA.a = MakeB (struct end);;
-  *)
+   module
+   rec NewA : ASig = MakeA (struct end)
+   and NewB : BSig with type b = NewA.a = MakeB (struct end);;
+*)
 
 (* Expressions and bindings *)
 
diff --git a/test/passing/tests/ocp_indent_compat.ml b/test/passing/tests/ocp_indent_compat.ml
index 0c1dfc75cf..578c10dfcf 100644
--- a/test/passing/tests/ocp_indent_compat.ml
+++ b/test/passing/tests/ocp_indent_compat.ml
@@ -2,8 +2,7 @@
 
 [@@@ocamlformat "break-colon=before"]
 
-(* Bad: unboxing the function type
-  *)
+(* Bad: unboxing the function type *)
 external i : (int -> float[@unboxed]) = "i" "i_nat"
 
 module type M = sig
@@ -16,14 +15,12 @@ module type M = sig
        * (string Location.loc * payload) list
 
   val transl_modtype_longident
-    (* from Typemod
-      *)
+    (* from Typemod *)
     : (Location.t -> Env.t -> Longident.t -> Path.t) ref
 
   val transl_modtype_longident
     (* foooooooooo fooooooooooooo foooooooooooo foooooooooooooo
-       foooooooooooooo foooooooooooo
-      *)
+       foooooooooooooo foooooooooooo *)
     : (Location.t -> Env.t -> Longident.t -> Path.t) ref
 
   val imported_sets_of_closures_table
@@ -40,20 +37,15 @@ module type M = sig
     -> 'a t
 
   val select
-    :  (* The fsevents context
-         *)
+    :  (* The fsevents context *)
        env
-    -> (* Additional file descriptor to select for reading
-         *)
+    -> (* Additional file descriptor to select for reading *)
        ?read_fdl:fd_select list
-    -> (* Additional file descriptor to select for writing
-         *)
+    -> (* Additional file descriptor to select for writing *)
        ?write_fdl:fd_select list
-    -> (* Timeout...like Unix.select
-         *)
+    -> (* Timeout...like Unix.select *)
        timeout:float
-    -> (* The callback for file system events
-         *)
+    -> (* The callback for file system events *)
        (event list -> unit)
     -> unit
 
diff --git a/test/passing/tests/ocp_indent_compat.ml.err b/test/passing/tests/ocp_indent_compat.ml.err
index 928e600a46..6faa1c0e72 100644
--- a/test/passing/tests/ocp_indent_compat.ml.err
+++ b/test/passing/tests/ocp_indent_compat.ml.err
@@ -1 +1 @@
-Warning: tests/ocp_indent_compat.ml:146 exceeds the margin
+Warning: tests/ocp_indent_compat.ml:138 exceeds the margin

From 364fc75988f9b86ea6a188c5a0af6defbe9ca2e7 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Mon, 5 Jun 2023 17:27:53 +0200
Subject: [PATCH 081/115] Fix regressions on unwrapped comments

---
 lib-rpc-server/ocamlformat_rpc.ml             |  6 +-
 lib/Cmt.ml                                    | 21 ++++-
 lib/Cmt.mli                                   |  4 +-
 lib/Cmts.ml                                   | 90 ++++++++++---------
 lib/Conf.ml                                   |  3 +-
 lib/Extended_ast.ml                           |  3 +-
 lib/Fmt_ast.ml                                | 15 ++--
 lib/Normalize_std_ast.ml                      |  3 +-
 test/passing/tests/args_grouped.ml            |  7 +-
 test/passing/tests/break_cases-align.ml.err   |  2 -
 test/passing/tests/break_cases-align.ml.ref   |  8 +-
 test/passing/tests/break_cases-all.ml.err     |  2 -
 test/passing/tests/break_cases-all.ml.ref     |  8 +-
 ...reak_cases-closing_on_separate_line.ml.err |  2 -
 ...reak_cases-closing_on_separate_line.ml.ref |  8 +-
 ...te_line_leading_nested_match_parens.ml.err |  2 -
 ...te_line_leading_nested_match_parens.ml.ref |  8 +-
 .../tests/break_cases-cosl_lnmp_cmei.ml.err   |  2 -
 .../tests/break_cases-cosl_lnmp_cmei.ml.ref   |  8 +-
 .../tests/break_cases-fit_or_vertical.ml.err  |  2 -
 .../tests/break_cases-fit_or_vertical.ml.ref  |  8 +-
 test/passing/tests/break_cases-nested.ml.err  |  2 -
 test/passing/tests/break_cases-nested.ml.ref  |  8 +-
 .../tests/break_cases-normal_indent.ml.err    |  2 -
 .../tests/break_cases-normal_indent.ml.ref    |  8 +-
 .../passing/tests/break_cases-toplevel.ml.err |  2 -
 .../passing/tests/break_cases-toplevel.ml.ref |  8 +-
 .../passing/tests/break_cases-vertical.ml.err |  2 -
 .../passing/tests/break_cases-vertical.ml.ref |  8 +-
 test/passing/tests/break_cases.ml.err         |  2 -
 test/passing/tests/break_cases.ml.ref         |  8 +-
 test/passing/tests/comments.ml.err            |  5 +-
 test/passing/tests/comments.ml.ref            |  9 +-
 .../tests/doc_comments-no-wrap.mli.ref        |  4 +-
 test/passing/tests/infix_bind-break.ml.err    |  2 -
 test/passing/tests/infix_bind-break.ml.ref    |  6 +-
 .../infix_bind-fit_or_vertical-break.ml.err   |  2 -
 .../infix_bind-fit_or_vertical-break.ml.ref   |  6 +-
 test/passing/tests/js_args.ml.err             |  1 -
 test/passing/tests/js_args.ml.ref             |  3 +-
 test/passing/tests/js_to_do.ml.ref            |  3 +-
 test/passing/tests/sequence-preserve.ml.ref   |  4 +-
 test/passing/tests/sequence.ml.ref            |  4 +-
 test/passing/tests/source.ml.err              |  1 -
 test/passing/tests/source.ml.ref              |  6 +-
 test/passing/tests/wrap_comments.ml.err       |  2 +-
 test/passing/tests/wrap_comments.ml.ref       | 75 ++++++++--------
 47 files changed, 207 insertions(+), 188 deletions(-)

diff --git a/lib-rpc-server/ocamlformat_rpc.ml b/lib-rpc-server/ocamlformat_rpc.ml
index 002b4ab556..02d4ade212 100644
--- a/lib-rpc-server/ocamlformat_rpc.ml
+++ b/lib-rpc-server/ocamlformat_rpc.ml
@@ -82,10 +82,12 @@ let run_format conf x =
     (* The formatting functions are ordered in such a way that the ones
        expecting a keyword first (like signatures) are placed before the more
        general ones (like toplevel phrases). Parsing a file as `--impl` with
-       `ocamlformat` processes it as a use file (toplevel phrases) anyway.
+       `ocamlformat` processes it as a use file (toplevel phrases)
+       anyway.
 
        `ocaml-lsp` should use core types, module types and signatures.
-       `ocaml-mdx` should use toplevel phrases, expressions and signatures. *)
+       `ocaml-mdx` should use toplevel phrases, expressions and
+       signatures. *)
     [ format Core_type
     ; format Signature
     ; format Module_type
diff --git a/lib/Cmt.ml b/lib/Cmt.ml
index 73980b3deb..e6016b8d49 100644
--- a/lib/Cmt.ml
+++ b/lib/Cmt.ml
@@ -134,6 +134,13 @@ let mk ?(prefix = "") ?(suffix = "") kind = {prefix; suffix; kind}
 
 let is_all_whitespace s = String.for_all s ~f:Char.is_whitespace
 
+let remove_head_tail_empty_lines lines =
+  lines
+  |> List.drop_while ~f:is_all_whitespace
+  |> List.rev
+  |> List.drop_while ~f:is_all_whitespace
+  |> List.rev
+
 let decode ~parse_comments_as_doc {txt; loc} =
   let txt =
     (* Windows compatibility *)
@@ -166,16 +173,22 @@ let decode ~parse_comments_as_doc {txt; loc} =
         mk (Verbatim " ") (* Make sure not to format to [(**)]. *)
     | _ when parse_comments_as_doc -> mk (Doc txt)
     | _ -> (
-        let prefix = if String.starts_with_whitespace txt then " " else ""
-        and suffix = if String.ends_with_whitespace txt then " " else "" in
-        let txt = String.rstrip txt in
+        let suffix, txt =
+          if String.ends_with_whitespace txt then
+            (" ", String.drop_suffix txt 1)
+          else ("", txt)
+        in
         let lines = unindent_lines ~opn_offset txt in
         match split_asterisk_prefixed lines with
         | Some deprefixed_lines -> mk (Asterisk_prefixed deprefixed_lines)
         | None ->
+            let prefix =
+              if String.starts_with_whitespace txt then " " else ""
+            in
+            let lines = remove_head_tail_empty_lines lines in
             (* Reconstruct the text with indentation removed and heading and
                trailing empty lines removed. *)
-            let txt = String.lstrip (String.concat ~sep:"\n" lines) in
+            let txt = String.concat ~sep:"\n" lines in
             mk ~prefix ~suffix (Normal txt) )
   else
     match txt with
diff --git a/lib/Cmt.mli b/lib/Cmt.mli
index b9a1eb9442..19eb797525 100644
--- a/lib/Cmt.mli
+++ b/lib/Cmt.mli
@@ -40,7 +40,9 @@ end
 type decoded_kind =
   | Verbatim of string  (** Original content. *)
   | Doc of string  (** Original content. *)
-  | Normal of string  (** Original content with whitespaces trimmed. *)
+  | Normal of string
+      (** Original content with indentation trimmed and empty head and tail
+          lines removed. Trailing spaces are not removed. *)
   | Code of string  (** Source code with indentation removed. *)
   | Asterisk_prefixed of string list
       (** Line splitted with asterisks removed. *)
diff --git a/lib/Cmts.ml b/lib/Cmts.ml
index b94ce0e1f8..09a79336b6 100644
--- a/lib/Cmts.ml
+++ b/lib/Cmts.ml
@@ -463,7 +463,7 @@ let break_comment_group source margin {Cmt.loc= a; _} {Cmt.loc= b; _} =
 let is_only_whitespaces s = String.for_all s ~f:Char.is_whitespace
 
 module Wrapped = struct
-  let fmt text =
+  let fmt ~pro ~epi text =
     let open Fmt in
     assert (not (String.is_empty text)) ;
     let fmt_line line =
@@ -480,49 +480,51 @@ module Wrapped = struct
         (String.split (String.rstrip text) ~on:'\n')
     in
     hvbox 0
-      (hovbox 0
-         (list_pn lines (fun ~prev:_ curr ~next ->
-              fmt_line curr
-              $
-              match next with
-              | Some str when is_only_whitespaces str ->
-                  close_box $ fmt "\n@," $ open_hovbox 0
-              | Some _ when not (String.is_empty curr) -> fmt "@ "
-              | _ -> noop ) ) )
+      ( pro
+      $ hovbox 0
+          ( list_pn lines (fun ~prev:_ curr ~next ->
+                fmt_line curr
+                $
+                match next with
+                | Some str when is_only_whitespaces str -> fmt "\n@\n"
+                | Some _ when not (String.is_empty curr) -> fmt "@ "
+                | _ -> noop )
+          $ epi ) )
 end
 
 module Asterisk_prefixed = struct
-  let fmt lines =
+  let fmt ~pro ~epi lines =
     let open Fmt in
     vbox 1
-      (list_fl lines (fun ~first ~last line ->
-           match line with
-           | "" when last -> fmt "@,"
-           | _ -> fmt_if (not first) "@," $ str "*" $ str line ) )
+      ( pro
+      $ list_fl lines (fun ~first ~last line ->
+            match line with
+            | "" when last -> fmt "@,"
+            | _ -> fmt_if (not first) "@," $ str "*" $ str line )
+      $ epi )
 end
 
 module Unwrapped = struct
   let fmt_multiline_cmt lines =
     let open Fmt in
     let fmt_line ~first ~last:_ s =
-      let s = String.rstrip s in
-      let sep =
-        if is_only_whitespaces s then str "\n" else fmt "@;<1000 0>"
-      in
+      let sep = if is_only_whitespaces s then str "\n" else fmt "@," in
       fmt_if_k (not first) sep $ str s
     in
-    vbox 0 ~name:"unwrapped" (list_fl lines fmt_line)
+    list_fl lines fmt_line
 
-  let fmt txt =
+  let fmt ~pro ~epi txt =
+    let open Fmt in
     match String.split_lines txt with
-    | _ :: _ as lines -> fmt_multiline_cmt lines
-    | [] -> Fmt.noop
+    | _ :: _ as lines ->
+        pro $ vbox 0 ~name:"unwrapped" (fmt_multiline_cmt lines $ epi)
+    | [] -> noop
 end
 
 module Verbatim = struct
-  let fmt s =
+  let fmt ~pro ~epi s =
     let open Fmt in
-    str s
+    pro $ str s $ epi
 end
 
 module Cinaps = struct
@@ -540,14 +542,17 @@ module Cinaps = struct
         list lines "" fmt_line $ fmt "@;<1000 -2>"
 
   (** Comments enclosed in [(*$], [$*)] are formatted as code. *)
-  let fmt ~fmt_code conf ~offset code =
-    match fmt_code conf ~offset code with
-    | Ok code -> fmt_code_str code
-    | Error _ -> fmt_code_str code
+  let fmt ~pro ~epi ~fmt_code conf ~offset code =
+    let code =
+      match fmt_code conf ~offset code with
+      | Ok code -> code
+      | Error _ -> code
+    in
+    hvbox 2 (pro $ fmt_code_str code $ epi)
 end
 
 module Doc = struct
-  let fmt ~fmt_code conf ~loc txt ~offset =
+  let fmt ~pro ~epi ~fmt_code conf ~loc txt ~offset =
     (* Whether the doc starts and ends with an empty line. *)
     let pre_nl, trail_nl =
       let lines = String.split ~on:'\n' txt in
@@ -565,7 +570,12 @@ module Doc = struct
     let conf = {conf with Conf.opr_opts= {conf.Conf.opr_opts with quiet}} in
     let doc = Fmt_odoc.fmt_parsed conf ~fmt_code ~input:txt ~offset parsed in
     let open Fmt in
-    wrap_k (fmt_if pre_nl "@;<1000 1>") (fmt_if trail_nl "@;<1000 -2>") doc
+    hvbox 2
+      ( pro
+      $ fmt_if pre_nl "@;<1000 1>"
+      $ doc
+      $ fmt_if trail_nl "@;<1000 -2>"
+      $ epi )
 end
 
 let fmt_cmt (conf : Conf.t) cmt ~fmt_code (_pos : Cmt.pos) =
@@ -574,18 +584,16 @@ let fmt_cmt (conf : Conf.t) cmt ~fmt_code (_pos : Cmt.pos) =
   let decoded = Cmt.decode ~parse_comments_as_doc cmt in
   (* TODO: Offset should be computed from location. *)
   let offset = 2 + String.length decoded.prefix in
-  (fun k ->
-    hvbox 2
-      (str "(*" $ str decoded.prefix $ k $ str decoded.suffix $ str "*)") )
-  @@
+  let pro = str "(*" $ str decoded.prefix
+  and epi = str decoded.suffix $ str "*)" in
   match decoded.kind with
-  | Verbatim txt -> Verbatim.fmt txt
-  | Doc txt -> Doc.fmt ~fmt_code conf ~loc:cmt.loc txt ~offset
+  | Verbatim txt -> Verbatim.fmt ~pro ~epi txt
+  | Doc txt -> Doc.fmt ~pro ~epi ~fmt_code conf ~loc:cmt.loc txt ~offset
   | Normal txt ->
-      if conf.fmt_opts.wrap_comments.v then Wrapped.fmt txt
-      else Unwrapped.fmt txt
-  | Code code -> Cinaps.fmt ~fmt_code conf ~offset code
-  | Asterisk_prefixed lines -> Asterisk_prefixed.fmt lines
+      if conf.fmt_opts.wrap_comments.v then Wrapped.fmt ~pro ~epi txt
+      else Unwrapped.fmt ~pro ~epi txt
+  | Code code -> Cinaps.fmt ~pro ~epi ~fmt_code conf ~offset code
+  | Asterisk_prefixed lines -> Asterisk_prefixed.fmt ~pro ~epi lines
 
 let fmt_cmts_aux t (conf : Conf.t) cmts ~fmt_code pos =
   let open Fmt in
diff --git a/lib/Conf.ml b/lib/Conf.ml
index 29730209d7..bfd5fabe05 100644
--- a/lib/Conf.ml
+++ b/lib/Conf.ml
@@ -1377,7 +1377,8 @@ module Formatting = struct
       ; elt let_open ]
 end
 
-(* Flags that can be modified in the config file that don't affect formatting *)
+(* Flags that can be modified in the config file that don't affect
+   formatting *)
 
 let kind = Decl.Operational
 
diff --git a/lib/Extended_ast.ml b/lib/Extended_ast.ml
index 077514982a..6c20bba92c 100644
--- a/lib/Extended_ast.ml
+++ b/lib/Extended_ast.ml
@@ -210,7 +210,8 @@ module Parse = struct
         when Migrate_ast.Location.compare_start ptyp_loc pexp_loc > 0 ->
           (* Match locations to differentiate between the two position for
              the constraint, we want to shorten the second: - [let _ :
-             (module S) = (module M)] - [let _ = ((module M) : (module S))] *)
+             (module S) = (module M)] - [let _ = ((module M) : (module
+             S))] *)
           {p with pexp_desc= Pexp_pack (name, Some pt)}
       | e -> Ast_mapper.default_mapper.expr m e
     in
diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 098ac5fcc4..03e7a07707 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -36,9 +36,11 @@ module Cmts = struct
   let fmt c ?pro ?epi ?eol ?adj loc =
     (* remove the before comments from the map first *)
     let before = fmt_before c ?pro ?epi ?eol ?adj loc in
-    (* remove the within comments from the map by accepting the continuation *)
+    (* remove the within comments from the map by accepting the
+       continuation *)
     fun inner ->
-      (* delay the after comments until the within comments have been removed *)
+      (* delay the after comments until the within comments have been
+         removed *)
       let after = fmt_after c ?pro ?epi loc in
       let open Fmt in
       before $ inner $ after
@@ -715,7 +717,8 @@ and fmt_arrow_param c ctx {pap_label= lI; pap_loc= locI; pap_type= tI} =
 (* The context of [xtyp] refers to the RHS of the expression (namely
    Pexp_constraint) and does not give a relevant information as to whether
    [xtyp] should be parenthesized. [constraint_ctx] gives the higher context
-   of the expression, i.e. if the expression is part of a `fun` expression. *)
+   of the expression, i.e. if the expression is part of a `fun`
+   expression. *)
 and fmt_core_type c ?(box = true) ?pro ?(pro_space = true) ?constraint_ctx
     ({ast= typ; ctx} as xtyp) =
   protect c (Typ typ)
@@ -1348,7 +1351,8 @@ and fmt_fun ?force_closing_paren
     else noop
   in
   let (label_sep : s), break_fun =
-    (* Break between the label and the fun to avoid ocp-indent's alignment. *)
+    (* Break between the label and the fun to avoid ocp-indent's
+       alignment. *)
     if c.conf.fmt_opts.ocp_indent_compat.v then (":@,", fmt "@;<1 2>")
     else (":", fmt "@ ")
   in
@@ -2622,7 +2626,8 @@ and fmt_expression c ?(box = true) ?pro ?epi ?eol ?parens ?(indent_wrap = 0)
   | Pexp_beginend e ->
       let wrap_beginend =
         match ctx0 with
-        (* begin-end keywords are handled when printing if-then-else branch *)
+        (* begin-end keywords are handled when printing if-then-else
+           branch *)
         | Exp {pexp_desc= Pexp_ifthenelse (_, Some z); _}
           when Base.phys_equal xexp.ast z ->
             Fn.id
diff --git a/lib/Normalize_std_ast.ml b/lib/Normalize_std_ast.ml
index 61c3c3f376..ef893190d1 100644
--- a/lib/Normalize_std_ast.ml
+++ b/lib/Normalize_std_ast.ml
@@ -143,7 +143,8 @@ let make_mapper conf ~ignore_doc_comments =
              pat3 )
     | Ppat_constraint (pat1, {ptyp_desc= Ptyp_poly ([], _t); _}) ->
         (* The parser put the same type constraint in two different nodes:
-           [let _ : typ = exp] is represented as [let _ : typ = (exp : typ)]. *)
+           [let _ : typ = exp] is represented as [let _ : typ = (exp :
+           typ)]. *)
         m.pat m pat1
     | _ -> Ast_mapper.default_mapper.pat m pat
   in
diff --git a/test/passing/tests/args_grouped.ml b/test/passing/tests/args_grouped.ml
index 557710a46a..b2c7debe10 100644
--- a/test/passing/tests/args_grouped.ml
+++ b/test/passing/tests/args_grouped.ml
@@ -73,10 +73,9 @@ let gen_with_record_deps ~expand t resolved_forms ~dep_kind =
 
 let f =
   very_long_function_name
-    ~very_long_variable_name:(very_long expression)
-      (* this is a
-         multiple-line-spanning
-         comment *)
+    ~very_long_variable_name:(very_long expression) (* this is a
+                                                       multiple-line-spanning
+                                                       comment *)
     ~y
 
 let eradicate_meta_class_is_nullsafe =
diff --git a/test/passing/tests/break_cases-align.ml.err b/test/passing/tests/break_cases-align.ml.err
index 9925d97802..afdf36620c 100644
--- a/test/passing/tests/break_cases-align.ml.err
+++ b/test/passing/tests/break_cases-align.ml.err
@@ -2,5 +2,3 @@ Warning: tests/break_cases.ml:68 exceeds the margin
 Warning: tests/break_cases.ml:141 exceeds the margin
 Warning: tests/break_cases.ml:242 exceeds the margin
 Warning: tests/break_cases.ml:250 exceeds the margin
-Warning: tests/break_cases.ml:267 exceeds the margin
-Warning: tests/break_cases.ml:277 exceeds the margin
diff --git a/test/passing/tests/break_cases-align.ml.ref b/test/passing/tests/break_cases-align.ml.ref
index 685f96ea31..dc56fcb9f5 100644
--- a/test/passing/tests/break_cases-align.ml.ref
+++ b/test/passing/tests/break_cases-align.ml.ref
@@ -265,8 +265,8 @@ let foooooooooooooo = function
   | Foooooooooo
   | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *)
   | Foooo
-    (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *)
-    ->
+    (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo
+       fooo *) ->
       Foooooooooo.Foooooo
   | Foooo {foooo_fooo= {foooooooooo}} ->
       Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo
@@ -275,6 +275,6 @@ let get_nullability = function
   | ArrayAccess
   | OptimisticFallback (* non-null is the most optimistic type *)
   | Undef
-    (* This is a very special case, assigning non-null is a technical trick *)
-    ->
+    (* This is a very special case, assigning non-null is a technical
+       trick *) ->
       Nullability.Nonnull
diff --git a/test/passing/tests/break_cases-all.ml.err b/test/passing/tests/break_cases-all.ml.err
index 9925d97802..afdf36620c 100644
--- a/test/passing/tests/break_cases-all.ml.err
+++ b/test/passing/tests/break_cases-all.ml.err
@@ -2,5 +2,3 @@ Warning: tests/break_cases.ml:68 exceeds the margin
 Warning: tests/break_cases.ml:141 exceeds the margin
 Warning: tests/break_cases.ml:242 exceeds the margin
 Warning: tests/break_cases.ml:250 exceeds the margin
-Warning: tests/break_cases.ml:267 exceeds the margin
-Warning: tests/break_cases.ml:277 exceeds the margin
diff --git a/test/passing/tests/break_cases-all.ml.ref b/test/passing/tests/break_cases-all.ml.ref
index b4231fcd3b..5a53dad8a6 100644
--- a/test/passing/tests/break_cases-all.ml.ref
+++ b/test/passing/tests/break_cases-all.ml.ref
@@ -265,8 +265,8 @@ let foooooooooooooo = function
   | Foooooooooo
   | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *)
   | Foooo
-    (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *)
-    ->
+    (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo
+       fooo *) ->
       Foooooooooo.Foooooo
   | Foooo {foooo_fooo= {foooooooooo}} ->
       Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo
@@ -275,6 +275,6 @@ let get_nullability = function
   | ArrayAccess
   | OptimisticFallback (* non-null is the most optimistic type *)
   | Undef
-    (* This is a very special case, assigning non-null is a technical trick *)
-    ->
+    (* This is a very special case, assigning non-null is a technical
+       trick *) ->
       Nullability.Nonnull
diff --git a/test/passing/tests/break_cases-closing_on_separate_line.ml.err b/test/passing/tests/break_cases-closing_on_separate_line.ml.err
index 0df3c460ce..f3dfae37a2 100644
--- a/test/passing/tests/break_cases-closing_on_separate_line.ml.err
+++ b/test/passing/tests/break_cases-closing_on_separate_line.ml.err
@@ -2,5 +2,3 @@ Warning: tests/break_cases.ml:76 exceeds the margin
 Warning: tests/break_cases.ml:151 exceeds the margin
 Warning: tests/break_cases.ml:255 exceeds the margin
 Warning: tests/break_cases.ml:264 exceeds the margin
-Warning: tests/break_cases.ml:282 exceeds the margin
-Warning: tests/break_cases.ml:292 exceeds the margin
diff --git a/test/passing/tests/break_cases-closing_on_separate_line.ml.ref b/test/passing/tests/break_cases-closing_on_separate_line.ml.ref
index 6497d7ebd7..f6c787edcf 100644
--- a/test/passing/tests/break_cases-closing_on_separate_line.ml.ref
+++ b/test/passing/tests/break_cases-closing_on_separate_line.ml.ref
@@ -280,8 +280,8 @@ let foooooooooooooo = function
   | Foooooooooo
   | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *)
   | Foooo
-    (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *)
-    ->
+    (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo
+       fooo *) ->
       Foooooooooo.Foooooo
   | Foooo {foooo_fooo= {foooooooooo}} ->
       Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo
@@ -290,6 +290,6 @@ let get_nullability = function
   | ArrayAccess
   | OptimisticFallback (* non-null is the most optimistic type *)
   | Undef
-    (* This is a very special case, assigning non-null is a technical trick *)
-    ->
+    (* This is a very special case, assigning non-null is a technical
+       trick *) ->
       Nullability.Nonnull
diff --git a/test/passing/tests/break_cases-closing_on_separate_line_leading_nested_match_parens.ml.err b/test/passing/tests/break_cases-closing_on_separate_line_leading_nested_match_parens.ml.err
index 0df3c460ce..f3dfae37a2 100644
--- a/test/passing/tests/break_cases-closing_on_separate_line_leading_nested_match_parens.ml.err
+++ b/test/passing/tests/break_cases-closing_on_separate_line_leading_nested_match_parens.ml.err
@@ -2,5 +2,3 @@ Warning: tests/break_cases.ml:76 exceeds the margin
 Warning: tests/break_cases.ml:151 exceeds the margin
 Warning: tests/break_cases.ml:255 exceeds the margin
 Warning: tests/break_cases.ml:264 exceeds the margin
-Warning: tests/break_cases.ml:282 exceeds the margin
-Warning: tests/break_cases.ml:292 exceeds the margin
diff --git a/test/passing/tests/break_cases-closing_on_separate_line_leading_nested_match_parens.ml.ref b/test/passing/tests/break_cases-closing_on_separate_line_leading_nested_match_parens.ml.ref
index fc957ff0f2..3dfca06fd7 100644
--- a/test/passing/tests/break_cases-closing_on_separate_line_leading_nested_match_parens.ml.ref
+++ b/test/passing/tests/break_cases-closing_on_separate_line_leading_nested_match_parens.ml.ref
@@ -280,8 +280,8 @@ let foooooooooooooo = function
   | Foooooooooo
   | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *)
   | Foooo
-    (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *)
-    ->
+    (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo
+       fooo *) ->
       Foooooooooo.Foooooo
   | Foooo {foooo_fooo= {foooooooooo}} ->
       Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo
@@ -290,6 +290,6 @@ let get_nullability = function
   | ArrayAccess
   | OptimisticFallback (* non-null is the most optimistic type *)
   | Undef
-    (* This is a very special case, assigning non-null is a technical trick *)
-    ->
+    (* This is a very special case, assigning non-null is a technical
+       trick *) ->
       Nullability.Nonnull
diff --git a/test/passing/tests/break_cases-cosl_lnmp_cmei.ml.err b/test/passing/tests/break_cases-cosl_lnmp_cmei.ml.err
index 0df3c460ce..f3dfae37a2 100644
--- a/test/passing/tests/break_cases-cosl_lnmp_cmei.ml.err
+++ b/test/passing/tests/break_cases-cosl_lnmp_cmei.ml.err
@@ -2,5 +2,3 @@ Warning: tests/break_cases.ml:76 exceeds the margin
 Warning: tests/break_cases.ml:151 exceeds the margin
 Warning: tests/break_cases.ml:255 exceeds the margin
 Warning: tests/break_cases.ml:264 exceeds the margin
-Warning: tests/break_cases.ml:282 exceeds the margin
-Warning: tests/break_cases.ml:292 exceeds the margin
diff --git a/test/passing/tests/break_cases-cosl_lnmp_cmei.ml.ref b/test/passing/tests/break_cases-cosl_lnmp_cmei.ml.ref
index 1231c2c031..d1777d5061 100644
--- a/test/passing/tests/break_cases-cosl_lnmp_cmei.ml.ref
+++ b/test/passing/tests/break_cases-cosl_lnmp_cmei.ml.ref
@@ -280,8 +280,8 @@ let foooooooooooooo = function
   | Foooooooooo
   | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *)
   | Foooo
-    (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *)
-    ->
+    (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo
+       fooo *) ->
       Foooooooooo.Foooooo
   | Foooo {foooo_fooo= {foooooooooo}} ->
       Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo
@@ -290,6 +290,6 @@ let get_nullability = function
   | ArrayAccess
   | OptimisticFallback (* non-null is the most optimistic type *)
   | Undef
-    (* This is a very special case, assigning non-null is a technical trick *)
-    ->
+    (* This is a very special case, assigning non-null is a technical
+       trick *) ->
       Nullability.Nonnull
diff --git a/test/passing/tests/break_cases-fit_or_vertical.ml.err b/test/passing/tests/break_cases-fit_or_vertical.ml.err
index 7065f955b8..79d75277be 100644
--- a/test/passing/tests/break_cases-fit_or_vertical.ml.err
+++ b/test/passing/tests/break_cases-fit_or_vertical.ml.err
@@ -2,5 +2,3 @@ Warning: tests/break_cases.ml:57 exceeds the margin
 Warning: tests/break_cases.ml:119 exceeds the margin
 Warning: tests/break_cases.ml:204 exceeds the margin
 Warning: tests/break_cases.ml:211 exceeds the margin
-Warning: tests/break_cases.ml:228 exceeds the margin
-Warning: tests/break_cases.ml:237 exceeds the margin
diff --git a/test/passing/tests/break_cases-fit_or_vertical.ml.ref b/test/passing/tests/break_cases-fit_or_vertical.ml.ref
index a78915f100..e0821f1d20 100644
--- a/test/passing/tests/break_cases-fit_or_vertical.ml.ref
+++ b/test/passing/tests/break_cases-fit_or_vertical.ml.ref
@@ -226,8 +226,8 @@ let foooooooooooooo = function
   | Foooooooooo
   | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *)
   | Foooo
-    (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *)
-    -> Foooooooooo.Foooooo
+    (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo
+       fooo *) -> Foooooooooo.Foooooo
   | Foooo {foooo_fooo= {foooooooooo}} ->
       Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo
 
@@ -235,5 +235,5 @@ let get_nullability = function
   | ArrayAccess
   | OptimisticFallback (* non-null is the most optimistic type *)
   | Undef
-    (* This is a very special case, assigning non-null is a technical trick *)
-    -> Nullability.Nonnull
+    (* This is a very special case, assigning non-null is a technical
+       trick *) -> Nullability.Nonnull
diff --git a/test/passing/tests/break_cases-nested.ml.err b/test/passing/tests/break_cases-nested.ml.err
index 3eb8d2b980..cca3923b28 100644
--- a/test/passing/tests/break_cases-nested.ml.err
+++ b/test/passing/tests/break_cases-nested.ml.err
@@ -2,5 +2,3 @@ Warning: tests/break_cases.ml:53 exceeds the margin
 Warning: tests/break_cases.ml:116 exceeds the margin
 Warning: tests/break_cases.ml:206 exceeds the margin
 Warning: tests/break_cases.ml:215 exceeds the margin
-Warning: tests/break_cases.ml:233 exceeds the margin
-Warning: tests/break_cases.ml:243 exceeds the margin
diff --git a/test/passing/tests/break_cases-nested.ml.ref b/test/passing/tests/break_cases-nested.ml.ref
index 7b5304737b..f0956e7f5b 100644
--- a/test/passing/tests/break_cases-nested.ml.ref
+++ b/test/passing/tests/break_cases-nested.ml.ref
@@ -231,8 +231,8 @@ let foooooooooooooo = function
   | Foooooooooo
   | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *)
   | Foooo
-    (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *)
-    ->
+    (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo
+       fooo *) ->
       Foooooooooo.Foooooo
   | Foooo {foooo_fooo= {foooooooooo}} ->
       Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo
@@ -241,6 +241,6 @@ let get_nullability = function
   | ArrayAccess
   | OptimisticFallback (* non-null is the most optimistic type *)
   | Undef
-    (* This is a very special case, assigning non-null is a technical trick *)
-    ->
+    (* This is a very special case, assigning non-null is a technical
+       trick *) ->
       Nullability.Nonnull
diff --git a/test/passing/tests/break_cases-normal_indent.ml.err b/test/passing/tests/break_cases-normal_indent.ml.err
index 9925d97802..afdf36620c 100644
--- a/test/passing/tests/break_cases-normal_indent.ml.err
+++ b/test/passing/tests/break_cases-normal_indent.ml.err
@@ -2,5 +2,3 @@ Warning: tests/break_cases.ml:68 exceeds the margin
 Warning: tests/break_cases.ml:141 exceeds the margin
 Warning: tests/break_cases.ml:242 exceeds the margin
 Warning: tests/break_cases.ml:250 exceeds the margin
-Warning: tests/break_cases.ml:267 exceeds the margin
-Warning: tests/break_cases.ml:277 exceeds the margin
diff --git a/test/passing/tests/break_cases-normal_indent.ml.ref b/test/passing/tests/break_cases-normal_indent.ml.ref
index 3cd85e813c..b0e74cc93b 100644
--- a/test/passing/tests/break_cases-normal_indent.ml.ref
+++ b/test/passing/tests/break_cases-normal_indent.ml.ref
@@ -265,8 +265,8 @@ let foooooooooooooo = function
   | Foooooooooo
   | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *)
   | Foooo
-    (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *)
-    ->
+    (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo
+       fooo *) ->
       Foooooooooo.Foooooo
   | Foooo {foooo_fooo= {foooooooooo}} ->
       Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo
@@ -275,6 +275,6 @@ let get_nullability = function
   | ArrayAccess
   | OptimisticFallback (* non-null is the most optimistic type *)
   | Undef
-    (* This is a very special case, assigning non-null is a technical trick *)
-    ->
+    (* This is a very special case, assigning non-null is a technical
+       trick *) ->
       Nullability.Nonnull
diff --git a/test/passing/tests/break_cases-toplevel.ml.err b/test/passing/tests/break_cases-toplevel.ml.err
index d1b6fd8e99..949e8ed317 100644
--- a/test/passing/tests/break_cases-toplevel.ml.err
+++ b/test/passing/tests/break_cases-toplevel.ml.err
@@ -2,5 +2,3 @@ Warning: tests/break_cases.ml:59 exceeds the margin
 Warning: tests/break_cases.ml:122 exceeds the margin
 Warning: tests/break_cases.ml:208 exceeds the margin
 Warning: tests/break_cases.ml:216 exceeds the margin
-Warning: tests/break_cases.ml:233 exceeds the margin
-Warning: tests/break_cases.ml:243 exceeds the margin
diff --git a/test/passing/tests/break_cases-toplevel.ml.ref b/test/passing/tests/break_cases-toplevel.ml.ref
index cf28bf4262..6bda2cfa16 100644
--- a/test/passing/tests/break_cases-toplevel.ml.ref
+++ b/test/passing/tests/break_cases-toplevel.ml.ref
@@ -231,8 +231,8 @@ let foooooooooooooo = function
   | Foooooooooo
   | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *)
   | Foooo
-    (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *)
-    ->
+    (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo
+       fooo *) ->
       Foooooooooo.Foooooo
   | Foooo {foooo_fooo= {foooooooooo}} ->
       Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo
@@ -241,6 +241,6 @@ let get_nullability = function
   | ArrayAccess
   | OptimisticFallback (* non-null is the most optimistic type *)
   | Undef
-    (* This is a very special case, assigning non-null is a technical trick *)
-    ->
+    (* This is a very special case, assigning non-null is a technical
+       trick *) ->
       Nullability.Nonnull
diff --git a/test/passing/tests/break_cases-vertical.ml.err b/test/passing/tests/break_cases-vertical.ml.err
index ac5edda8df..e9b75397df 100644
--- a/test/passing/tests/break_cases-vertical.ml.err
+++ b/test/passing/tests/break_cases-vertical.ml.err
@@ -2,5 +2,3 @@ Warning: tests/break_cases.ml:80 exceeds the margin
 Warning: tests/break_cases.ml:159 exceeds the margin
 Warning: tests/break_cases.ml:273 exceeds the margin
 Warning: tests/break_cases.ml:281 exceeds the margin
-Warning: tests/break_cases.ml:299 exceeds the margin
-Warning: tests/break_cases.ml:309 exceeds the margin
diff --git a/test/passing/tests/break_cases-vertical.ml.ref b/test/passing/tests/break_cases-vertical.ml.ref
index b328bdcd53..d0c5bb73a5 100644
--- a/test/passing/tests/break_cases-vertical.ml.ref
+++ b/test/passing/tests/break_cases-vertical.ml.ref
@@ -297,8 +297,8 @@ let foooooooooooooo = function
   | Foooooooooo
   | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *)
   | Foooo
-    (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *)
-    ->
+    (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo
+       fooo *) ->
       Foooooooooo.Foooooo
   | Foooo {foooo_fooo= {foooooooooo}} ->
       Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo
@@ -307,6 +307,6 @@ let get_nullability = function
   | ArrayAccess
   | OptimisticFallback (* non-null is the most optimistic type *)
   | Undef
-    (* This is a very special case, assigning non-null is a technical trick *)
-    ->
+    (* This is a very special case, assigning non-null is a technical
+       trick *) ->
       Nullability.Nonnull
diff --git a/test/passing/tests/break_cases.ml.err b/test/passing/tests/break_cases.ml.err
index 5aeb7f3422..458af7e802 100644
--- a/test/passing/tests/break_cases.ml.err
+++ b/test/passing/tests/break_cases.ml.err
@@ -2,5 +2,3 @@ Warning: tests/break_cases.ml:47 exceeds the margin
 Warning: tests/break_cases.ml:104 exceeds the margin
 Warning: tests/break_cases.ml:180 exceeds the margin
 Warning: tests/break_cases.ml:188 exceeds the margin
-Warning: tests/break_cases.ml:205 exceeds the margin
-Warning: tests/break_cases.ml:215 exceeds the margin
diff --git a/test/passing/tests/break_cases.ml.ref b/test/passing/tests/break_cases.ml.ref
index 6a08470bd0..49918f0249 100644
--- a/test/passing/tests/break_cases.ml.ref
+++ b/test/passing/tests/break_cases.ml.ref
@@ -203,8 +203,8 @@ let foooooooooooooo = function
   | Foooooooooo
   | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *)
   | Foooo
-    (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *)
-    ->
+    (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo
+       fooo *) ->
       Foooooooooo.Foooooo
   | Foooo {foooo_fooo= {foooooooooo}} ->
       Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo
@@ -213,6 +213,6 @@ let get_nullability = function
   | ArrayAccess
   | OptimisticFallback (* non-null is the most optimistic type *)
   | Undef
-    (* This is a very special case, assigning non-null is a technical trick *)
-    ->
+    (* This is a very special case, assigning non-null is a technical
+       trick *) ->
       Nullability.Nonnull
diff --git a/test/passing/tests/comments.ml.err b/test/passing/tests/comments.ml.err
index 8eac92d41d..614b25d687 100644
--- a/test/passing/tests/comments.ml.err
+++ b/test/passing/tests/comments.ml.err
@@ -1,4 +1 @@
-Warning: tests/comments.ml:186 exceeds the margin
-Warning: tests/comments.ml:249 exceeds the margin
-Warning: tests/comments.ml:384 exceeds the margin
-Warning: tests/comments.ml:416 exceeds the margin
+Warning: tests/comments.ml:250 exceeds the margin
diff --git a/test/passing/tests/comments.ml.ref b/test/passing/tests/comments.ml.ref
index 5d67fdb91b..bfd372971a 100644
--- a/test/passing/tests/comments.ml.ref
+++ b/test/passing/tests/comments.ml.ref
@@ -184,7 +184,8 @@ let () =
   (* *)
   ()
 
-(* break when unicode sequence length measured in bytes but ¬ in code points *)
+(* break when unicode sequence length measured in bytes but ¬ in code
+   points *)
 
 type t =
   | Aaaaaaaaaa
@@ -382,7 +383,8 @@ 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 *)
+    #= (* convert from foos to bars blah blah blah blah blah blah blah
+          blah *)
     foooooooooooooooooooooooo
     foooooooooooooooo fooooooooooooooo
 
@@ -414,6 +416,7 @@ type a = b (* a *) as (* b *) 'c (* c *)
 type t =
   { (* comment before mutable *)
     mutable
-      (* really long comment that doesn't fit on the same line as other stuff *)
+      (* really long comment that doesn't fit on the same line as other
+         stuff *)
       x:
       int }
diff --git a/test/passing/tests/doc_comments-no-wrap.mli.ref b/test/passing/tests/doc_comments-no-wrap.mli.ref
index b8682fd314..3e36eb81af 100644
--- a/test/passing/tests/doc_comments-no-wrap.mli.ref
+++ b/test/passing/tests/doc_comments-no-wrap.mli.ref
@@ -426,7 +426,7 @@ end
 
     {[
       (** This is a comment with code inside [ let code inside = f inside ] *)
-      let code inside (* comment *) = f inside
+      let code inside (* comment   *) = f inside
     ]}
 
     Code block with metadata:
@@ -439,7 +439,7 @@ end
     ]}
     {@ocaml kind=toplevel env=e1[
       (** This is a comment with code inside [ let code inside = f inside ] *)
-      let code inside (* comment *) = f inside
+      let code inside (* comment   *) = f inside
     ]} *)
 
 (** {e foooooooo oooooooooo ooooooooo ooooooooo}
diff --git a/test/passing/tests/infix_bind-break.ml.err b/test/passing/tests/infix_bind-break.ml.err
index 37b1506a7a..e69de29bb2 100644
--- a/test/passing/tests/infix_bind-break.ml.err
+++ b/test/passing/tests/infix_bind-break.ml.err
@@ -1,2 +0,0 @@
-Warning: tests/infix_bind.ml:190 exceeds the margin
-Warning: tests/infix_bind.ml:196 exceeds the margin
diff --git a/test/passing/tests/infix_bind-break.ml.ref b/test/passing/tests/infix_bind-break.ml.ref
index 726a203d6f..4ffe48c69e 100644
--- a/test/passing/tests/infix_bind-break.ml.ref
+++ b/test/passing/tests/infix_bind-break.ml.ref
@@ -188,13 +188,15 @@ let f =
 
 let f =
   Ok ()
-  >>= (* fooooooooooooooo fooooooooooooooo fooooooooooooooo foooooooooooooooo *)
+  >>= (* fooooooooooooooo fooooooooooooooo fooooooooooooooo
+         foooooooooooooooo *)
   fun foooooo fooooo foooo foooooo ->
   Ok foooooooooooooooooooooooooooooooooooooooooooooooooo
 
 let f =
   Ok ()
-  >>= (* fooooooooooooooo fooooooooooooooo fooooooooooooooo foooooooooooooooo *)
+  >>= (* fooooooooooooooo fooooooooooooooo fooooooooooooooo
+         foooooooooooooooo *)
   function Foo -> Ok foooooooooooooooooooooooooooooooooooooooooooooooooo
 
 (** The tests below are testing a dropped comment with
diff --git a/test/passing/tests/infix_bind-fit_or_vertical-break.ml.err b/test/passing/tests/infix_bind-fit_or_vertical-break.ml.err
index d98343563a..e69de29bb2 100644
--- a/test/passing/tests/infix_bind-fit_or_vertical-break.ml.err
+++ b/test/passing/tests/infix_bind-fit_or_vertical-break.ml.err
@@ -1,2 +0,0 @@
-Warning: tests/infix_bind.ml:195 exceeds the margin
-Warning: tests/infix_bind.ml:201 exceeds the margin
diff --git a/test/passing/tests/infix_bind-fit_or_vertical-break.ml.ref b/test/passing/tests/infix_bind-fit_or_vertical-break.ml.ref
index 42fba2f9b6..374187edbf 100644
--- a/test/passing/tests/infix_bind-fit_or_vertical-break.ml.ref
+++ b/test/passing/tests/infix_bind-fit_or_vertical-break.ml.ref
@@ -193,13 +193,15 @@ let f =
 
 let f =
   Ok ()
-  >>= (* fooooooooooooooo fooooooooooooooo fooooooooooooooo foooooooooooooooo *)
+  >>= (* fooooooooooooooo fooooooooooooooo fooooooooooooooo
+         foooooooooooooooo *)
   fun foooooo fooooo foooo foooooo ->
   Ok foooooooooooooooooooooooooooooooooooooooooooooooooo
 
 let f =
   Ok ()
-  >>= (* fooooooooooooooo fooooooooooooooo fooooooooooooooo foooooooooooooooo *)
+  >>= (* fooooooooooooooo fooooooooooooooo fooooooooooooooo
+         foooooooooooooooo *)
   function Foo -> Ok foooooooooooooooooooooooooooooooooooooooooooooooooo
 
 (** The tests below are testing a dropped comment with
diff --git a/test/passing/tests/js_args.ml.err b/test/passing/tests/js_args.ml.err
index 610b9ed379..e69de29bb2 100644
--- a/test/passing/tests/js_args.ml.err
+++ b/test/passing/tests/js_args.ml.err
@@ -1 +0,0 @@
-Warning: tests/js_args.ml:50 exceeds the margin
diff --git a/test/passing/tests/js_args.ml.ref b/test/passing/tests/js_args.ml.ref
index 9b5f7abdac..8addea5617 100644
--- a/test/passing/tests/js_args.ml.ref
+++ b/test/passing/tests/js_args.ml.ref
@@ -48,7 +48,8 @@ let () =
 
 (* Except in specific cases, we want the argument indented relative to the
    function being called. (Exceptions include "fun" arguments where the line
-   ends with "->" and subsequent lines beginning with operators, like above.) *)
+   ends with "->" and subsequent lines beginning with operators, like
+   above.) *)
 let () =
   Some
     (Message_store.create s "herd-retransmitter" ~unlink:true
diff --git a/test/passing/tests/js_to_do.ml.ref b/test/passing/tests/js_to_do.ml.ref
index 3917f02f27..48da134128 100644
--- a/test/passing/tests/js_to_do.ml.ref
+++ b/test/passing/tests/js_to_do.ml.ref
@@ -14,7 +14,8 @@ let _ =
 (* js-type *)
 
 (* The following tests incorporate several subtle and different indentation
-   ideas. Please consider this only a proposal for discussion, for now.
+   ideas. Please consider this only a proposal for discussion, for
+   now.
 
    First, notice the display treatment of "(,)" tuples, analogous to "[;]"
    lists. While "(,)" is an intensional combination of "()" and ",", unlike
diff --git a/test/passing/tests/sequence-preserve.ml.ref b/test/passing/tests/sequence-preserve.ml.ref
index f166b4ea22..ad7ca7ea13 100644
--- a/test/passing/tests/sequence-preserve.ml.ref
+++ b/test/passing/tests/sequence-preserve.ml.ref
@@ -94,7 +94,9 @@ let foo x y =
 (* This test require --max-iter=3 *)
 let _ =
   some statement ;
-  (* comment with an empty line in it tricky *)
+  (* comment with an empty line in it
+
+     tricky *)
   an other statement
 
 let foo x y =
diff --git a/test/passing/tests/sequence.ml.ref b/test/passing/tests/sequence.ml.ref
index 87c2afe57f..f25d9f1d02 100644
--- a/test/passing/tests/sequence.ml.ref
+++ b/test/passing/tests/sequence.ml.ref
@@ -82,7 +82,9 @@ let foo x y =
 (* This test require --max-iter=3 *)
 let _ =
   some statement ;
-  (* comment with an empty line in it tricky *)
+  (* comment with an empty line in it
+
+     tricky *)
   an other statement
 
 let foo x y =
diff --git a/test/passing/tests/source.ml.err b/test/passing/tests/source.ml.err
index d6e87d109e..50f7e55a5d 100644
--- a/test/passing/tests/source.ml.err
+++ b/test/passing/tests/source.ml.err
@@ -1,3 +1,2 @@
 Warning: tests/source.ml:702 exceeds the margin
 Warning: tests/source.ml:2318 exceeds the margin
-Warning: tests/source.ml:6284 exceeds the margin
diff --git a/test/passing/tests/source.ml.ref b/test/passing/tests/source.ml.ref
index e948cdfce3..e9e1eb8878 100644
--- a/test/passing/tests/source.ml.ref
+++ b/test/passing/tests/source.ml.ref
@@ -5838,7 +5838,8 @@ let f (x : entity entity_container) = ()
 (* class world = object val entity_container : entity entity_container = new
    entity_container
 
-   method add_entity (s : entity) = entity_container#add_entity (s :> entity)
+   method add_entity (s : entity) = entity_container#add_entity (s :>
+   entity)
 
    end *)
 (* Two v's in the same class *)
@@ -6282,7 +6283,8 @@ module M : sig
 end = struct
   type refer = {poly: 'a 'b 'c. (('b, 'c) #Classdef.cl2 as 'a)}
 end
-(* ocamlc -c pr3918a.mli pr3918b.mli rm -f pr3918a.cmi ocamlc -c pr3918c.ml *)
+(* ocamlc -c pr3918a.mli pr3918b.mli rm -f pr3918a.cmi ocamlc -c
+   pr3918c.ml *)
 
 open Pr3918b
 
diff --git a/test/passing/tests/wrap_comments.ml.err b/test/passing/tests/wrap_comments.ml.err
index 6f7c17597e..d46e312eca 100644
--- a/test/passing/tests/wrap_comments.ml.err
+++ b/test/passing/tests/wrap_comments.ml.err
@@ -1 +1 @@
-Warning: tests/wrap_comments.ml:36 exceeds the margin
+Warning: tests/wrap_comments.ml:44 exceeds the margin
diff --git a/test/passing/tests/wrap_comments.ml.ref b/test/passing/tests/wrap_comments.ml.ref
index d95622223c..1a6476634f 100644
--- a/test/passing/tests/wrap_comments.ml.ref
+++ b/test/passing/tests/wrap_comments.ml.ref
@@ -9,10 +9,18 @@ type t =
 let _ =
   [ "a"
   ; "b" (* first line second line *)
-  ; "c" (* first line second line *)
-  ; "d" (* first line second line *)
-  ; "e" (* first line second line *)
-  ; "f" (* first line second line *)
+  ; "c" (* first line
+
+           second line *)
+  ; "d" (* first line
+
+           second line *)
+  ; "e" (* first line
+
+           second line *)
+  ; "f" (* first line
+
+           second line *)
   ; "g" ]
 
 let _ =
@@ -40,41 +48,41 @@ type t =
 let rex =
   Pcre.regexp
     ( "^[0-9]{2}"
-    (* xxxxxxxxxxx *)
+    (* xxxxxxxxxxx               *)
     ^ "(.{12})"
-    (* xxxxxxxxxxxxxxxxxx *)
+    (* xxxxxxxxxxxxxxxxxx        *)
     ^ "(.{4})"
-    (* xxxxxxxxxxxx *)
+    (* xxxxxxxxxxxx              *)
     ^ "([0-9]{3})"
-    (* xxxxxxxx *)
+    (* xxxxxxxx                  *)
     ^ "(.{60})"
-    (* xxxxxxxxxxxxxxxxxxxx *)
+    (* xxxxxxxxxxxxxxxxxxxx      *)
     ^ "(.{12})"
-    (* xxxxxxxxxxxxxxx *)
+    (* xxxxxxxxxxxxxxx           *)
     ^ "(.{12})"
-    (* xxxxxxxxxxxxxxxxxxx *)
+    (* xxxxxxxxxxxxxxxxxxx       *)
     ^ "([0-9]{3})"
     (* xxxxxxxxxxxxxxxxxxxxxxxxx *)
     ^ "([0-9]{3})"
-    (* xxxxxxxxxxx *)
+    (* xxxxxxxxxxx               *)
     ^ "(.{15})"
-    (* xxxxxxxxxxxxxxxxxx *)
+    (* xxxxxxxxxxxxxxxxxx        *)
     ^ "([0-9]{7})"
-    (* xxxxxxxxxxxxx *)
+    (* xxxxxxxxxxxxx             *)
     ^ "(.{10})"
-    (* xxxxxxxxxxxxx *)
+    (* xxxxxxxxxxxxx             *)
     ^ date_fmt
-    (* xxxxxxxxxxxxx *)
+    (* xxxxxxxxxxxxx             *)
     ^ "([0-9]{18})"
-    (* xxxxx *)
+    (* xxxxx                     *)
     ^ "(.)"
-    (* xxxxxxxxxxx *)
+    (* xxxxxxxxxxx               *)
     ^ "([0-9]{3})"
-    (* xxxxxxxxxxxxxx *)
+    (* xxxxxxxxxxxxxx            *)
     ^ "(.{15})"
-    (* xxxxxxxxxxxxxxxxxxxx *)
+    (* xxxxxxxxxxxxxxxxxxxx      *)
     ^ "(.{3})"
-    (* xxxxxxxxxx *)
+    (* xxxxxxxxxx                *)
     ^ "(.{27})$" )
 
 type foo =
@@ -85,26 +93,21 @@ type foo =
 
 let _ =
   [ "a"
-  ; "b"
-    (* first line
-       second line *)
-  ; "c"
-    (* first line
+  ; "b" (* first line
+           second line *)
+  ; "c" (* first line
 
-       second line *)
-  ; "d"
-    (* first line
+           second line *)
+  ; "d" (* first line
 
 
-       second line *)
-  ; "e"
-    (* first line
+           second line *)
+  ; "e" (* first line
 
-       second line *)
-  ; "f"
-    (* first line
+           second line *)
+  ; "f" (* first line
 
-       second line *)
+           second line *)
   ; "g" ]
 
 let _ =

From e009001c76c8d3214ad2a99752e1dd5ce3294228 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Mon, 5 Jun 2023 17:38:37 +0200
Subject: [PATCH 082/115] Fix parsing of asterisk prefixed comments

---
 lib/Cmt.ml                                       | 16 ++++++++--------
 lib/Cmts.ml                                      | 13 ++++++-------
 test/passing/tests/comment_header.ml.ref         | 16 +++++++++++-----
 test/passing/tests/doc_comments-after.ml.err     |  5 ++++-
 test/passing/tests/doc_comments-after.ml.ref     |  8 +++-----
 .../tests/doc_comments-before-except-val.ml.err  |  5 ++++-
 .../tests/doc_comments-before-except-val.ml.ref  |  8 +++-----
 test/passing/tests/doc_comments-before.ml.err    |  5 ++++-
 test/passing/tests/doc_comments-before.ml.ref    |  8 +++-----
 test/passing/tests/doc_comments.ml.err           |  5 ++++-
 test/passing/tests/doc_comments.ml.ref           |  8 +++-----
 test/passing/tests/wrap_comments.ml.ref          |  2 +-
 12 files changed, 54 insertions(+), 45 deletions(-)

diff --git a/lib/Cmt.ml b/lib/Cmt.ml
index e6016b8d49..5ae6dc3dd3 100644
--- a/lib/Cmt.ml
+++ b/lib/Cmt.ml
@@ -125,10 +125,11 @@ let unindent_lines ~opn_offset txt =
   | [] -> []
   | hd :: tl -> unindent_lines ~opn_offset hd tl
 
-let split_asterisk_prefixed lines =
-  if List.for_all ~f:(String.is_prefix ~prefix:"*") lines then
-    Some (List.map lines ~f:(fun s -> String.drop_prefix s 1))
-  else None
+let split_asterisk_prefixed = function
+  | hd :: (_ :: _ as tl)
+    when List.for_all ~f:(String.is_prefix ~prefix:"*") tl ->
+      Some (hd :: List.map tl ~f:(fun s -> String.drop_prefix s 1))
+  | _ -> None
 
 let mk ?(prefix = "") ?(suffix = "") kind = {prefix; suffix; kind}
 
@@ -173,6 +174,7 @@ let decode ~parse_comments_as_doc {txt; loc} =
         mk (Verbatim " ") (* Make sure not to format to [(**)]. *)
     | _ when parse_comments_as_doc -> mk (Doc txt)
     | _ -> (
+        let prefix = if String.starts_with_whitespace txt then " " else "" in
         let suffix, txt =
           if String.ends_with_whitespace txt then
             (" ", String.drop_suffix txt 1)
@@ -180,11 +182,9 @@ let decode ~parse_comments_as_doc {txt; loc} =
         in
         let lines = unindent_lines ~opn_offset txt in
         match split_asterisk_prefixed lines with
-        | Some deprefixed_lines -> mk (Asterisk_prefixed deprefixed_lines)
+        | Some deprefixed_lines ->
+            mk ~prefix ~suffix (Asterisk_prefixed deprefixed_lines)
         | None ->
-            let prefix =
-              if String.starts_with_whitespace txt then " " else ""
-            in
             let lines = remove_head_tail_empty_lines lines in
             (* Reconstruct the text with indentation removed and heading and
                trailing empty lines removed. *)
diff --git a/lib/Cmts.ml b/lib/Cmts.ml
index 09a79336b6..00ba25d1c3 100644
--- a/lib/Cmts.ml
+++ b/lib/Cmts.ml
@@ -495,13 +495,12 @@ end
 module Asterisk_prefixed = struct
   let fmt ~pro ~epi lines =
     let open Fmt in
-    vbox 1
-      ( pro
-      $ list_fl lines (fun ~first ~last line ->
-            match line with
-            | "" when last -> fmt "@,"
-            | _ -> fmt_if (not first) "@," $ str "*" $ str line )
-      $ epi )
+    let fmt_lines =
+      match lines with
+      | hd :: tl -> str hd $ list tl "" (fun s -> fmt "@,*" $ str s)
+      | [] -> noop
+    in
+    vbox 1 (pro $ fmt_lines $ epi)
 end
 
 module Unwrapped = struct
diff --git a/test/passing/tests/comment_header.ml.ref b/test/passing/tests/comment_header.ml.ref
index 0dcca6e010..116c600c55 100644
--- a/test/passing/tests/comment_header.ml.ref
+++ b/test/passing/tests/comment_header.ml.ref
@@ -45,8 +45,14 @@ type typ = typ
 
 (* TEST arguments = "???" *)
 
-(* On Windows the runtime expand windows wildcards (asterisks and * question
-   marks). * * This file is a non-regression test for github's PR#1623. * *
-   On Windows 64bits, a segfault was triggered when one argument consists *
-   only of wildcards. * * The source code of this test is empty: we just
-   check the arguments * expansion. * *)
+(* On Windows the runtime expand windows wildcards (asterisks and
+ * question marks).
+ *
+ * This file is a non-regression test for github's PR#1623.
+ *
+ * On Windows 64bits, a segfault was triggered when one argument consists
+ * only of wildcards.
+ *
+ * The source code of this test is empty: we just check the arguments
+ * expansion.
+ * *)
diff --git a/test/passing/tests/doc_comments-after.ml.err b/test/passing/tests/doc_comments-after.ml.err
index dd738d90f3..71ec524f66 100644
--- a/test/passing/tests/doc_comments-after.ml.err
+++ b/test/passing/tests/doc_comments-after.ml.err
@@ -1 +1,4 @@
-Warning: tests/doc_comments.ml:301 exceeds the margin
+Warning: tests/doc_comments.ml:268 exceeds the margin
+Warning: tests/doc_comments.ml:269 exceeds the margin
+Warning: tests/doc_comments.ml:270 exceeds the margin
+Warning: tests/doc_comments.ml:299 exceeds the margin
diff --git a/test/passing/tests/doc_comments-after.ml.ref b/test/passing/tests/doc_comments-after.ml.ref
index fdacc13e71..ad4ad77c2e 100644
--- a/test/passing/tests/doc_comments-after.ml.ref
+++ b/test/passing/tests/doc_comments-after.ml.ref
@@ -266,11 +266,9 @@ module A = struct
   end
 end
 
-(* Same with get_pure, except that when we have both "x = t" and "y = t"
-   where t is a primed ident, * we add "x = y" to the result. This is crucial
-   for the normalizer, as it tend to drop "x = t" before * processing "y =
-   t". If we don't explicitly preserve "x = y", the normalizer cannot pick it
-   up *)
+(* Same with get_pure, except that when we have both "x = t" and "y = t" where t is a primed ident,
+ * we add "x = y" to the result. This is crucial for the normalizer, as it tend to drop "x = t" before
+ * processing "y = t". If we don't explicitly preserve "x = y", the normalizer cannot pick it up *)
 let _ = ()
 
 (** Tags without text *)
diff --git a/test/passing/tests/doc_comments-before-except-val.ml.err b/test/passing/tests/doc_comments-before-except-val.ml.err
index dd738d90f3..71ec524f66 100644
--- a/test/passing/tests/doc_comments-before-except-val.ml.err
+++ b/test/passing/tests/doc_comments-before-except-val.ml.err
@@ -1 +1,4 @@
-Warning: tests/doc_comments.ml:301 exceeds the margin
+Warning: tests/doc_comments.ml:268 exceeds the margin
+Warning: tests/doc_comments.ml:269 exceeds the margin
+Warning: tests/doc_comments.ml:270 exceeds the margin
+Warning: tests/doc_comments.ml:299 exceeds the margin
diff --git a/test/passing/tests/doc_comments-before-except-val.ml.ref b/test/passing/tests/doc_comments-before-except-val.ml.ref
index 59a6180c19..66cc7751a1 100644
--- a/test/passing/tests/doc_comments-before-except-val.ml.ref
+++ b/test/passing/tests/doc_comments-before-except-val.ml.ref
@@ -266,11 +266,9 @@ module A = struct
   end
 end
 
-(* Same with get_pure, except that when we have both "x = t" and "y = t"
-   where t is a primed ident, * we add "x = y" to the result. This is crucial
-   for the normalizer, as it tend to drop "x = t" before * processing "y =
-   t". If we don't explicitly preserve "x = y", the normalizer cannot pick it
-   up *)
+(* Same with get_pure, except that when we have both "x = t" and "y = t" where t is a primed ident,
+ * we add "x = y" to the result. This is crucial for the normalizer, as it tend to drop "x = t" before
+ * processing "y = t". If we don't explicitly preserve "x = y", the normalizer cannot pick it up *)
 let _ = ()
 
 (** Tags without text *)
diff --git a/test/passing/tests/doc_comments-before.ml.err b/test/passing/tests/doc_comments-before.ml.err
index dd738d90f3..71ec524f66 100644
--- a/test/passing/tests/doc_comments-before.ml.err
+++ b/test/passing/tests/doc_comments-before.ml.err
@@ -1 +1,4 @@
-Warning: tests/doc_comments.ml:301 exceeds the margin
+Warning: tests/doc_comments.ml:268 exceeds the margin
+Warning: tests/doc_comments.ml:269 exceeds the margin
+Warning: tests/doc_comments.ml:270 exceeds the margin
+Warning: tests/doc_comments.ml:299 exceeds the margin
diff --git a/test/passing/tests/doc_comments-before.ml.ref b/test/passing/tests/doc_comments-before.ml.ref
index efa518581f..ae6ef68376 100644
--- a/test/passing/tests/doc_comments-before.ml.ref
+++ b/test/passing/tests/doc_comments-before.ml.ref
@@ -266,11 +266,9 @@ module A = struct
   end
 end
 
-(* Same with get_pure, except that when we have both "x = t" and "y = t"
-   where t is a primed ident, * we add "x = y" to the result. This is crucial
-   for the normalizer, as it tend to drop "x = t" before * processing "y =
-   t". If we don't explicitly preserve "x = y", the normalizer cannot pick it
-   up *)
+(* Same with get_pure, except that when we have both "x = t" and "y = t" where t is a primed ident,
+ * we add "x = y" to the result. This is crucial for the normalizer, as it tend to drop "x = t" before
+ * processing "y = t". If we don't explicitly preserve "x = y", the normalizer cannot pick it up *)
 let _ = ()
 
 (** Tags without text *)
diff --git a/test/passing/tests/doc_comments.ml.err b/test/passing/tests/doc_comments.ml.err
index dd738d90f3..71ec524f66 100644
--- a/test/passing/tests/doc_comments.ml.err
+++ b/test/passing/tests/doc_comments.ml.err
@@ -1 +1,4 @@
-Warning: tests/doc_comments.ml:301 exceeds the margin
+Warning: tests/doc_comments.ml:268 exceeds the margin
+Warning: tests/doc_comments.ml:269 exceeds the margin
+Warning: tests/doc_comments.ml:270 exceeds the margin
+Warning: tests/doc_comments.ml:299 exceeds the margin
diff --git a/test/passing/tests/doc_comments.ml.ref b/test/passing/tests/doc_comments.ml.ref
index 59a6180c19..66cc7751a1 100644
--- a/test/passing/tests/doc_comments.ml.ref
+++ b/test/passing/tests/doc_comments.ml.ref
@@ -266,11 +266,9 @@ module A = struct
   end
 end
 
-(* Same with get_pure, except that when we have both "x = t" and "y = t"
-   where t is a primed ident, * we add "x = y" to the result. This is crucial
-   for the normalizer, as it tend to drop "x = t" before * processing "y =
-   t". If we don't explicitly preserve "x = y", the normalizer cannot pick it
-   up *)
+(* Same with get_pure, except that when we have both "x = t" and "y = t" where t is a primed ident,
+ * we add "x = y" to the result. This is crucial for the normalizer, as it tend to drop "x = t" before
+ * processing "y = t". If we don't explicitly preserve "x = y", the normalizer cannot pick it up *)
 let _ = ()
 
 (** Tags without text *)
diff --git a/test/passing/tests/wrap_comments.ml.ref b/test/passing/tests/wrap_comments.ml.ref
index 1a6476634f..483aba77aa 100644
--- a/test/passing/tests/wrap_comments.ml.ref
+++ b/test/passing/tests/wrap_comments.ml.ref
@@ -88,7 +88,7 @@ let rex =
 type foo =
   { some_field: int
         (* long long long long long long long long long long long long long long
-           * long long long long *)
+         * long long long long *)
   ; another_field: string }
 
 let _ =

From 7bff959f487f37e7dc3feeac5411916ff4a74a0a Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Mon, 5 Jun 2023 17:41:02 +0200
Subject: [PATCH 083/115] Restore break before preceeding multi-line comments

This break was removed in previous commits
---
 lib/Cmts.ml                             |  9 ++++-
 test/passing/tests/args_grouped.ml      |  7 ++--
 test/passing/tests/js_source.ml.err     |  4 +--
 test/passing/tests/js_source.ml.ocp     | 21 ++++++++----
 test/passing/tests/js_source.ml.ref     | 21 ++++++++----
 test/passing/tests/wrap_comments.ml.err |  2 +-
 test/passing/tests/wrap_comments.ml.ref | 45 +++++++++++++++----------
 7 files changed, 70 insertions(+), 39 deletions(-)

diff --git a/lib/Cmts.ml b/lib/Cmts.ml
index 00ba25d1c3..74858bf642 100644
--- a/lib/Cmts.ml
+++ b/lib/Cmts.ml
@@ -577,14 +577,21 @@ module Doc = struct
       $ epi )
 end
 
-let fmt_cmt (conf : Conf.t) cmt ~fmt_code (_pos : Cmt.pos) =
+let fmt_cmt (conf : Conf.t) cmt ~fmt_code (pos : Cmt.pos) =
   let open Fmt in
+  let break =
+    fmt_if_k
+      (Poly.(pos = After) && String.contains cmt.Cmt.txt '\n')
+      (break_unless_newline 1000 0)
+  in
   let parse_comments_as_doc = conf.fmt_opts.ocp_indent_compat.v in
   let decoded = Cmt.decode ~parse_comments_as_doc cmt in
   (* TODO: Offset should be computed from location. *)
   let offset = 2 + String.length decoded.prefix in
   let pro = str "(*" $ str decoded.prefix
   and epi = str decoded.suffix $ str "*)" in
+  break
+  $
   match decoded.kind with
   | Verbatim txt -> Verbatim.fmt ~pro ~epi txt
   | Doc txt -> Doc.fmt ~pro ~epi ~fmt_code conf ~loc:cmt.loc txt ~offset
diff --git a/test/passing/tests/args_grouped.ml b/test/passing/tests/args_grouped.ml
index b2c7debe10..557710a46a 100644
--- a/test/passing/tests/args_grouped.ml
+++ b/test/passing/tests/args_grouped.ml
@@ -73,9 +73,10 @@ let gen_with_record_deps ~expand t resolved_forms ~dep_kind =
 
 let f =
   very_long_function_name
-    ~very_long_variable_name:(very_long expression) (* this is a
-                                                       multiple-line-spanning
-                                                       comment *)
+    ~very_long_variable_name:(very_long expression)
+      (* this is a
+         multiple-line-spanning
+         comment *)
     ~y
 
 let eradicate_meta_class_is_nullsafe =
diff --git a/test/passing/tests/js_source.ml.err b/test/passing/tests/js_source.ml.err
index addaec2421..9ba7830b7d 100644
--- a/test/passing/tests/js_source.ml.err
+++ b/test/passing/tests/js_source.ml.err
@@ -3,5 +3,5 @@ Warning: tests/js_source.ml:3556 exceeds the margin
 Warning: tests/js_source.ml:9522 exceeds the margin
 Warning: tests/js_source.ml:9625 exceeds the margin
 Warning: tests/js_source.ml:9644 exceeds the margin
-Warning: tests/js_source.ml:9678 exceeds the margin
-Warning: tests/js_source.ml:9761 exceeds the margin
+Warning: tests/js_source.ml:9684 exceeds the margin
+Warning: tests/js_source.ml:9768 exceeds the margin
diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp
index f1edf05818..fc676c8779 100644
--- a/test/passing/tests/js_source.ml.ocp
+++ b/test/passing/tests/js_source.ml.ocp
@@ -9646,13 +9646,19 @@ let _ =
   := bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
 ;;
 
-let g = f ~x (* this is a multiple-line-spanning
-                comment *) ~y
+let g =
+  f
+    ~x
+    (* this is a multiple-line-spanning
+       comment *)
+    ~y
+;;
 
 let f =
   very_long_function_name
-    ~x:very_long_variable_name (* this is a multiple-line-spanning
-                                  comment *)
+    ~x:very_long_variable_name
+    (* this is a multiple-line-spanning
+       comment *)
     ~y
 ;;
 
@@ -9689,11 +9695,12 @@ type t =
   ]
 
 type t =
-  { field : ty (* Here is some verbatim formatted text:
+  { field : ty
+  (* Here is some verbatim formatted text:
 
-                  {v
+     {v
        starting at column 7
-                  v}*)
+         v}*)
   }
 
 module Intro_sort = struct
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index 961d61ebaa..211f46c744 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -9646,13 +9646,19 @@ let _ =
     := bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
 ;;
 
-let g = f ~x (* this is a multiple-line-spanning
-                comment *) ~y
+let g =
+  f
+    ~x
+      (* this is a multiple-line-spanning
+         comment *)
+    ~y
+;;
 
 let f =
   very_long_function_name
-    ~x:very_long_variable_name (* this is a multiple-line-spanning
-                                  comment *)
+    ~x:very_long_variable_name
+      (* this is a multiple-line-spanning
+         comment *)
     ~y
 ;;
 
@@ -9689,11 +9695,12 @@ type t =
   ]
 
 type t =
-  { field : ty (* Here is some verbatim formatted text:
+  { field : ty
+      (* Here is some verbatim formatted text:
 
-                  {v
+         {v
        starting at column 7
-                  v}*)
+         v}*)
   }
 
 module Intro_sort = struct
diff --git a/test/passing/tests/wrap_comments.ml.err b/test/passing/tests/wrap_comments.ml.err
index d46e312eca..93a64804f2 100644
--- a/test/passing/tests/wrap_comments.ml.err
+++ b/test/passing/tests/wrap_comments.ml.err
@@ -1 +1 @@
-Warning: tests/wrap_comments.ml:44 exceeds the margin
+Warning: tests/wrap_comments.ml:48 exceeds the margin
diff --git a/test/passing/tests/wrap_comments.ml.ref b/test/passing/tests/wrap_comments.ml.ref
index 483aba77aa..cbebfe6f47 100644
--- a/test/passing/tests/wrap_comments.ml.ref
+++ b/test/passing/tests/wrap_comments.ml.ref
@@ -9,18 +9,22 @@ type t =
 let _ =
   [ "a"
   ; "b" (* first line second line *)
-  ; "c" (* first line
+  ; "c"
+    (* first line
 
-           second line *)
-  ; "d" (* first line
+       second line *)
+  ; "d"
+    (* first line
 
-           second line *)
-  ; "e" (* first line
+       second line *)
+  ; "e"
+    (* first line
 
-           second line *)
-  ; "f" (* first line
+       second line *)
+  ; "f"
+    (* first line
 
-           second line *)
+       second line *)
   ; "g" ]
 
 let _ =
@@ -93,21 +97,26 @@ type foo =
 
 let _ =
   [ "a"
-  ; "b" (* first line
-           second line *)
-  ; "c" (* first line
+  ; "b"
+    (* first line
+       second line *)
+  ; "c"
+    (* first line
 
-           second line *)
-  ; "d" (* first line
+       second line *)
+  ; "d"
+    (* first line
 
 
-           second line *)
-  ; "e" (* first line
+       second line *)
+  ; "e"
+    (* first line
 
-           second line *)
-  ; "f" (* first line
+       second line *)
+  ; "f"
+    (* first line
 
-           second line *)
+       second line *)
   ; "g" ]
 
 let _ =

From f8719ba0449d84ebb752b3c1d4257b6597231145 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Mon, 5 Jun 2023 20:00:48 +0200
Subject: [PATCH 084/115] Preserve leading/trailing newlines in unwrapped
 comments

---
 lib/Cmt.ml                              | 43 ++++++++-----------
 lib/Cmt.mli                             |  4 +-
 lib/Cmts.ml                             | 55 +++++++++++++++----------
 test/passing/tests/wrap_comments.ml.ref | 16 ++++---
 4 files changed, 64 insertions(+), 54 deletions(-)

diff --git a/lib/Cmt.ml b/lib/Cmt.ml
index 5ae6dc3dd3..05c4e0905b 100644
--- a/lib/Cmt.ml
+++ b/lib/Cmt.ml
@@ -108,7 +108,7 @@ let unindent_lines ~opn_offset first_line tl_lines =
   let fl_spaces, fl_indent =
     match indent_of_line first_line with
     | Some i -> (i, i + opn_offset)
-    | None -> (0, Stdlib.max_int)
+    | None -> (String.length first_line, Stdlib.max_int)
   in
   let min_indent =
     List.fold_left ~init:fl_indent
@@ -121,7 +121,7 @@ let unindent_lines ~opn_offset first_line tl_lines =
   :: List.map ~f:(fun s -> String.drop_prefix s min_indent) tl_lines
 
 let unindent_lines ~opn_offset txt =
-  match String.split_lines txt with
+  match String.split ~on:'\n' txt with
   | [] -> []
   | hd :: tl -> unindent_lines ~opn_offset hd tl
 
@@ -135,13 +135,6 @@ let mk ?(prefix = "") ?(suffix = "") kind = {prefix; suffix; kind}
 
 let is_all_whitespace s = String.for_all s ~f:Char.is_whitespace
 
-let remove_head_tail_empty_lines lines =
-  lines
-  |> List.drop_while ~f:is_all_whitespace
-  |> List.rev
-  |> List.drop_while ~f:is_all_whitespace
-  |> List.rev
-
 let decode ~parse_comments_as_doc {txt; loc} =
   let txt =
     (* Windows compatibility *)
@@ -159,10 +152,10 @@ let decode ~parse_comments_as_doc {txt; loc} =
         let opn_offset = opn_offset + 1 in
         let dollar_suf = Char.equal txt.[String.length txt - 1] '$' in
         let suffix = if dollar_suf then "$" else "" in
-        let len = String.length txt - if dollar_suf then 2 else 1 in
-        (* Strip white lines at the end but not at the start until after
-           [unindent_lines] is called. *)
-        let source = String.rstrip (String.sub ~pos:1 ~len txt) in
+        let source =
+          let len = String.length txt - if dollar_suf then 2 else 1 in
+          String.sub ~pos:1 ~len txt
+        in
         let lines = unindent_lines ~opn_offset source in
         let lines = List.map ~f:String.rstrip lines in
         let lines = List.drop_while ~f:is_all_whitespace lines in
@@ -174,22 +167,20 @@ let decode ~parse_comments_as_doc {txt; loc} =
         mk (Verbatim " ") (* Make sure not to format to [(**)]. *)
     | _ when parse_comments_as_doc -> mk (Doc txt)
     | _ -> (
-        let prefix = if String.starts_with_whitespace txt then " " else "" in
-        let suffix, txt =
-          if String.ends_with_whitespace txt then
-            (" ", String.drop_suffix txt 1)
-          else ("", txt)
-        in
         let lines = unindent_lines ~opn_offset txt in
+        (* Don't add a space to the prefix if the first line was only
+           spaces. *)
+        let prefix =
+          if
+            String.starts_with_whitespace txt
+            && not (String.is_empty (List.hd_exn lines))
+          then " "
+          else ""
+        in
         match split_asterisk_prefixed lines with
         | Some deprefixed_lines ->
-            mk ~prefix ~suffix (Asterisk_prefixed deprefixed_lines)
-        | None ->
-            let lines = remove_head_tail_empty_lines lines in
-            (* Reconstruct the text with indentation removed and heading and
-               trailing empty lines removed. *)
-            let txt = String.concat ~sep:"\n" lines in
-            mk ~prefix ~suffix (Normal txt) )
+            mk ~prefix (Asterisk_prefixed deprefixed_lines)
+        | None -> mk ~prefix (Normal (String.concat ~sep:"\n" lines)) )
   else
     match txt with
     (* "(**)" is not parsed as a docstring but as a regular comment
diff --git a/lib/Cmt.mli b/lib/Cmt.mli
index 19eb797525..f3ef074c18 100644
--- a/lib/Cmt.mli
+++ b/lib/Cmt.mli
@@ -41,8 +41,8 @@ type decoded_kind =
   | Verbatim of string  (** Original content. *)
   | Doc of string  (** Original content. *)
   | Normal of string
-      (** Original content with indentation trimmed and empty head and tail
-          lines removed. Trailing spaces are not removed. *)
+      (** Original content with indentation trimmed. Trailing spaces are not
+          removed. *)
   | Code of string  (** Source code with indentation removed. *)
   | Asterisk_prefixed of string list
       (** Line splitted with asterisks removed. *)
diff --git a/lib/Cmts.ml b/lib/Cmts.ml
index 74858bf642..efc4f3ee39 100644
--- a/lib/Cmts.ml
+++ b/lib/Cmts.ml
@@ -466,6 +466,8 @@ module Wrapped = struct
   let fmt ~pro ~epi text =
     let open Fmt in
     assert (not (String.is_empty text)) ;
+    let prefix = if String.starts_with_whitespace text then " " else ""
+    and suffix = if String.ends_with_whitespace text then " " else "" in
     let fmt_line line =
       let words =
         List.filter ~f:(Fn.non String.is_empty)
@@ -479,17 +481,16 @@ module Wrapped = struct
         ~equal:(fun x y -> String.is_empty x && String.is_empty y)
         (String.split (String.rstrip text) ~on:'\n')
     in
-    hvbox 0
-      ( pro
-      $ hovbox 0
-          ( list_pn lines (fun ~prev:_ curr ~next ->
-                fmt_line curr
-                $
-                match next with
-                | Some str when is_only_whitespaces str -> fmt "\n@\n"
-                | Some _ when not (String.is_empty curr) -> fmt "@ "
-                | _ -> noop )
-          $ epi ) )
+    pro $ str prefix
+    $ hovbox 0
+        ( list_pn lines (fun ~prev:_ curr ~next ->
+              fmt_line curr
+              $
+              match next with
+              | Some str when is_only_whitespaces str -> fmt "\n@\n"
+              | Some _ when not (String.is_empty curr) -> fmt "@ "
+              | _ -> noop )
+        $ str suffix $ epi )
 end
 
 module Asterisk_prefixed = struct
@@ -504,19 +505,31 @@ module Asterisk_prefixed = struct
 end
 
 module Unwrapped = struct
-  let fmt_multiline_cmt lines =
-    let open Fmt in
-    let fmt_line ~first ~last:_ s =
-      let sep = if is_only_whitespaces s then str "\n" else fmt "@," in
-      fmt_if_k (not first) sep $ str s
+  open Fmt
+
+  let has_trailing_empty_lines s =
+    let pos =
+      match String.rfindi s ~f:(fun _ c -> not (Char.is_whitespace c)) with
+      | Some i -> i + 1
+      | None -> 0
     in
-    list_fl lines fmt_line
+    String.contains ~pos s '\n'
 
+  let fmt_line ~first:_ ~last l =
+    (* The last line will be followed by the [epi]. *)
+    if is_only_whitespaces l && not last then str "\n" else fmt "@," $ str l
+
+  (** [txt] contains trailing spaces and leading/trailing empty lines. *)
   let fmt ~pro ~epi txt =
-    let open Fmt in
-    match String.split_lines txt with
-    | _ :: _ as lines ->
-        pro $ vbox 0 ~name:"unwrapped" (fmt_multiline_cmt lines $ epi)
+    let txt, epi =
+      (* Preserve one trailing newline. *)
+      if has_trailing_empty_lines txt then
+        (String.rstrip txt, fmt "@\n" $ epi)
+      else (txt, epi)
+    in
+    match String.split ~on:'\n' txt with
+    | hd :: tl ->
+        pro $ vbox 0 ~name:"unwrapped" (str hd $ list_fl tl fmt_line) $ epi
     | [] -> noop
 end
 
diff --git a/test/passing/tests/wrap_comments.ml.ref b/test/passing/tests/wrap_comments.ml.ref
index cbebfe6f47..b335d64423 100644
--- a/test/passing/tests/wrap_comments.ml.ref
+++ b/test/passing/tests/wrap_comments.ml.ref
@@ -103,7 +103,8 @@ let _ =
   ; "c"
     (* first line
 
-       second line *)
+       second line
+    *)
   ; "d"
     (* first line
 
@@ -112,11 +113,13 @@ let _ =
   ; "e"
     (* first line
 
-       second line *)
+       second line
+    *)
   ; "f"
     (* first line
 
-       second line *)
+       second line
+    *)
   ; "g" ]
 
 let _ =
@@ -134,7 +137,8 @@ let _ =
 
 let _ =
   (*no space before
-    just newline after *)
+    just newline after
+  *)
   0
 
 let _ =
@@ -154,5 +158,7 @@ let _ =
   ()
 
 let _ =
-  (* blah blah *)
+  (*
+    blah blah
+  *)
   ()

From 69f2a8e67120b0b92de65235b8cbbaa5da1baee6 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Tue, 6 Jun 2023 11:40:57 +0200
Subject: [PATCH 085/115] Tests: Remove no longer necessary `--max-iter`

---
 test/passing/dune.inc                       | 2 +-
 test/passing/tests/sequence-preserve.ml.ref | 1 -
 test/passing/tests/sequence.ml              | 1 -
 test/passing/tests/sequence.ml.opts         | 2 +-
 test/passing/tests/sequence.ml.ref          | 1 -
 5 files changed, 2 insertions(+), 5 deletions(-)

diff --git a/test/passing/dune.inc b/test/passing/dune.inc
index 4e73f8a0b4..7ae5163d6c 100644
--- a/test/passing/dune.inc
+++ b/test/passing/dune.inc
@@ -4684,7 +4684,7 @@
  (action
   (with-stdout-to sequence.ml.stdout
    (with-stderr-to sequence.ml.stderr
-     (run %{bin:ocamlformat} --margin-check --sequence-blank-line=compact --max-iter=3 %{dep:tests/sequence.ml})))))
+     (run %{bin:ocamlformat} --margin-check --sequence-blank-line=compact %{dep:tests/sequence.ml})))))
 
 (rule
  (alias runtest)
diff --git a/test/passing/tests/sequence-preserve.ml.ref b/test/passing/tests/sequence-preserve.ml.ref
index ad7ca7ea13..323209b026 100644
--- a/test/passing/tests/sequence-preserve.ml.ref
+++ b/test/passing/tests/sequence-preserve.ml.ref
@@ -91,7 +91,6 @@ let foo x y =
   another_important_function x y ;
   cleanup x y
 
-(* This test require --max-iter=3 *)
 let _ =
   some statement ;
   (* comment with an empty line in it
diff --git a/test/passing/tests/sequence.ml b/test/passing/tests/sequence.ml
index 260fdd39d6..92ebaddc0e 100644
--- a/test/passing/tests/sequence.ml
+++ b/test/passing/tests/sequence.ml
@@ -93,7 +93,6 @@ let foo x y =
   another_important_function x y ;
   cleanup x y
 
-(* This test require --max-iter=3 *)
 let _ =
   some statement;
   (* comment with an empty line in it
diff --git a/test/passing/tests/sequence.ml.opts b/test/passing/tests/sequence.ml.opts
index e2b6533785..0eb0c717da 100644
--- a/test/passing/tests/sequence.ml.opts
+++ b/test/passing/tests/sequence.ml.opts
@@ -1 +1 @@
---sequence-blank-line=compact --max-iter=3
+--sequence-blank-line=compact
diff --git a/test/passing/tests/sequence.ml.ref b/test/passing/tests/sequence.ml.ref
index f25d9f1d02..8d74ca96cb 100644
--- a/test/passing/tests/sequence.ml.ref
+++ b/test/passing/tests/sequence.ml.ref
@@ -79,7 +79,6 @@ let foo x y =
   another_important_function x y ;
   cleanup x y
 
-(* This test require --max-iter=3 *)
 let _ =
   some statement ;
   (* comment with an empty line in it

From 5a56bf13c688a1746dd2b6017ee7cd171fa7a184 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Tue, 6 Jun 2023 11:49:27 +0200
Subject: [PATCH 086/115] Tests: Remove empty .err files

---
 test/passing/tests/break_before_in-auto.ml.err               | 0
 test/passing/tests/break_before_in.ml.err                    | 0
 test/passing/tests/break_fun_decl-smart.ml.err               | 0
 test/passing/tests/break_sequence_before.ml.err              | 0
 test/passing/tests/break_string_literals.ml.err              | 0
 test/passing/tests/break_struct.ml.err                       | 0
 test/passing/tests/cases_exp_grouping.ml.err                 | 0
 test/passing/tests/cinaps.ml.err                             | 0
 test/passing/tests/disambiguate.ml.err                       | 0
 test/passing/tests/exp_grouping-parens.ml.err                | 0
 test/passing/tests/exp_grouping.ml.err                       | 0
 test/passing/tests/extensions-indent.ml.err                  | 0
 test/passing/tests/extensions-indent.mli.err                 | 0
 test/passing/tests/function_indent-never.ml.err              | 0
 test/passing/tests/function_indent.ml.err                    | 0
 test/passing/tests/indicate_multiline_delimiters-cosl.ml.err | 0
 test/passing/tests/infix_bind-break.ml.err                   | 0
 test/passing/tests/infix_bind-fit_or_vertical-break.ml.err   | 0
 test/passing/tests/invalid_docstrings.mli.err                | 0
 test/passing/tests/ite-fit_or_vertical.ml.err                | 0
 test/passing/tests/ite-fit_or_vertical_closing.ml.err        | 0
 test/passing/tests/ite-fit_or_vertical_no_indicate.ml.err    | 0
 test/passing/tests/ite-kr.ml.err                             | 0
 test/passing/tests/ite-kr_closing.ml.err                     | 0
 test/passing/tests/ite-kw_first_closing.ml.err               | 0
 test/passing/tests/ite-vertical.ml.err                       | 0
 test/passing/tests/js_args.ml.err                            | 0
 test/passing/tests/let_binding-in_indent.ml.err              | 0
 test/passing/tests/let_binding-indent.ml.err                 | 0
 test/passing/tests/let_binding_spacing-sparse.ml.err         | 0
 test/passing/tests/match_indent-never.ml.err                 | 0
 test/passing/tests/match_indent.ml.err                       | 0
 test/passing/tests/module_item_spacing-preserve.ml.err       | 0
 test/passing/tests/module_item_spacing.mli.err               | 0
 test/passing/tests/open-closing-on-separate-line.ml.err      | 0
 test/passing/tests/parens_tuple_patterns.ml.err              | 0
 test/passing/tests/sequence-preserve.ml.err                  | 0
 test/passing/tests/sequence.ml.err                           | 0
 test/passing/tests/str_value.ml.err                          | 0
 test/passing/tests/try_with_or_pattern.ml.err                | 0
 test/passing/tests/types-indent.ml.err                       | 0
 41 files changed, 0 insertions(+), 0 deletions(-)
 delete mode 100644 test/passing/tests/break_before_in-auto.ml.err
 delete mode 100644 test/passing/tests/break_before_in.ml.err
 delete mode 100644 test/passing/tests/break_fun_decl-smart.ml.err
 delete mode 100644 test/passing/tests/break_sequence_before.ml.err
 delete mode 100644 test/passing/tests/break_string_literals.ml.err
 delete mode 100644 test/passing/tests/break_struct.ml.err
 delete mode 100644 test/passing/tests/cases_exp_grouping.ml.err
 delete mode 100644 test/passing/tests/cinaps.ml.err
 delete mode 100644 test/passing/tests/disambiguate.ml.err
 delete mode 100644 test/passing/tests/exp_grouping-parens.ml.err
 delete mode 100644 test/passing/tests/exp_grouping.ml.err
 delete mode 100644 test/passing/tests/extensions-indent.ml.err
 delete mode 100644 test/passing/tests/extensions-indent.mli.err
 delete mode 100644 test/passing/tests/function_indent-never.ml.err
 delete mode 100644 test/passing/tests/function_indent.ml.err
 delete mode 100644 test/passing/tests/indicate_multiline_delimiters-cosl.ml.err
 delete mode 100644 test/passing/tests/infix_bind-break.ml.err
 delete mode 100644 test/passing/tests/infix_bind-fit_or_vertical-break.ml.err
 delete mode 100644 test/passing/tests/invalid_docstrings.mli.err
 delete mode 100644 test/passing/tests/ite-fit_or_vertical.ml.err
 delete mode 100644 test/passing/tests/ite-fit_or_vertical_closing.ml.err
 delete mode 100644 test/passing/tests/ite-fit_or_vertical_no_indicate.ml.err
 delete mode 100644 test/passing/tests/ite-kr.ml.err
 delete mode 100644 test/passing/tests/ite-kr_closing.ml.err
 delete mode 100644 test/passing/tests/ite-kw_first_closing.ml.err
 delete mode 100644 test/passing/tests/ite-vertical.ml.err
 delete mode 100644 test/passing/tests/js_args.ml.err
 delete mode 100644 test/passing/tests/let_binding-in_indent.ml.err
 delete mode 100644 test/passing/tests/let_binding-indent.ml.err
 delete mode 100644 test/passing/tests/let_binding_spacing-sparse.ml.err
 delete mode 100644 test/passing/tests/match_indent-never.ml.err
 delete mode 100644 test/passing/tests/match_indent.ml.err
 delete mode 100644 test/passing/tests/module_item_spacing-preserve.ml.err
 delete mode 100644 test/passing/tests/module_item_spacing.mli.err
 delete mode 100644 test/passing/tests/open-closing-on-separate-line.ml.err
 delete mode 100644 test/passing/tests/parens_tuple_patterns.ml.err
 delete mode 100644 test/passing/tests/sequence-preserve.ml.err
 delete mode 100644 test/passing/tests/sequence.ml.err
 delete mode 100644 test/passing/tests/str_value.ml.err
 delete mode 100644 test/passing/tests/try_with_or_pattern.ml.err
 delete mode 100644 test/passing/tests/types-indent.ml.err

diff --git a/test/passing/tests/break_before_in-auto.ml.err b/test/passing/tests/break_before_in-auto.ml.err
deleted file mode 100644
index e69de29bb2..0000000000
diff --git a/test/passing/tests/break_before_in.ml.err b/test/passing/tests/break_before_in.ml.err
deleted file mode 100644
index e69de29bb2..0000000000
diff --git a/test/passing/tests/break_fun_decl-smart.ml.err b/test/passing/tests/break_fun_decl-smart.ml.err
deleted file mode 100644
index e69de29bb2..0000000000
diff --git a/test/passing/tests/break_sequence_before.ml.err b/test/passing/tests/break_sequence_before.ml.err
deleted file mode 100644
index e69de29bb2..0000000000
diff --git a/test/passing/tests/break_string_literals.ml.err b/test/passing/tests/break_string_literals.ml.err
deleted file mode 100644
index e69de29bb2..0000000000
diff --git a/test/passing/tests/break_struct.ml.err b/test/passing/tests/break_struct.ml.err
deleted file mode 100644
index e69de29bb2..0000000000
diff --git a/test/passing/tests/cases_exp_grouping.ml.err b/test/passing/tests/cases_exp_grouping.ml.err
deleted file mode 100644
index e69de29bb2..0000000000
diff --git a/test/passing/tests/cinaps.ml.err b/test/passing/tests/cinaps.ml.err
deleted file mode 100644
index e69de29bb2..0000000000
diff --git a/test/passing/tests/disambiguate.ml.err b/test/passing/tests/disambiguate.ml.err
deleted file mode 100644
index e69de29bb2..0000000000
diff --git a/test/passing/tests/exp_grouping-parens.ml.err b/test/passing/tests/exp_grouping-parens.ml.err
deleted file mode 100644
index e69de29bb2..0000000000
diff --git a/test/passing/tests/exp_grouping.ml.err b/test/passing/tests/exp_grouping.ml.err
deleted file mode 100644
index e69de29bb2..0000000000
diff --git a/test/passing/tests/extensions-indent.ml.err b/test/passing/tests/extensions-indent.ml.err
deleted file mode 100644
index e69de29bb2..0000000000
diff --git a/test/passing/tests/extensions-indent.mli.err b/test/passing/tests/extensions-indent.mli.err
deleted file mode 100644
index e69de29bb2..0000000000
diff --git a/test/passing/tests/function_indent-never.ml.err b/test/passing/tests/function_indent-never.ml.err
deleted file mode 100644
index e69de29bb2..0000000000
diff --git a/test/passing/tests/function_indent.ml.err b/test/passing/tests/function_indent.ml.err
deleted file mode 100644
index e69de29bb2..0000000000
diff --git a/test/passing/tests/indicate_multiline_delimiters-cosl.ml.err b/test/passing/tests/indicate_multiline_delimiters-cosl.ml.err
deleted file mode 100644
index e69de29bb2..0000000000
diff --git a/test/passing/tests/infix_bind-break.ml.err b/test/passing/tests/infix_bind-break.ml.err
deleted file mode 100644
index e69de29bb2..0000000000
diff --git a/test/passing/tests/infix_bind-fit_or_vertical-break.ml.err b/test/passing/tests/infix_bind-fit_or_vertical-break.ml.err
deleted file mode 100644
index e69de29bb2..0000000000
diff --git a/test/passing/tests/invalid_docstrings.mli.err b/test/passing/tests/invalid_docstrings.mli.err
deleted file mode 100644
index e69de29bb2..0000000000
diff --git a/test/passing/tests/ite-fit_or_vertical.ml.err b/test/passing/tests/ite-fit_or_vertical.ml.err
deleted file mode 100644
index e69de29bb2..0000000000
diff --git a/test/passing/tests/ite-fit_or_vertical_closing.ml.err b/test/passing/tests/ite-fit_or_vertical_closing.ml.err
deleted file mode 100644
index e69de29bb2..0000000000
diff --git a/test/passing/tests/ite-fit_or_vertical_no_indicate.ml.err b/test/passing/tests/ite-fit_or_vertical_no_indicate.ml.err
deleted file mode 100644
index e69de29bb2..0000000000
diff --git a/test/passing/tests/ite-kr.ml.err b/test/passing/tests/ite-kr.ml.err
deleted file mode 100644
index e69de29bb2..0000000000
diff --git a/test/passing/tests/ite-kr_closing.ml.err b/test/passing/tests/ite-kr_closing.ml.err
deleted file mode 100644
index e69de29bb2..0000000000
diff --git a/test/passing/tests/ite-kw_first_closing.ml.err b/test/passing/tests/ite-kw_first_closing.ml.err
deleted file mode 100644
index e69de29bb2..0000000000
diff --git a/test/passing/tests/ite-vertical.ml.err b/test/passing/tests/ite-vertical.ml.err
deleted file mode 100644
index e69de29bb2..0000000000
diff --git a/test/passing/tests/js_args.ml.err b/test/passing/tests/js_args.ml.err
deleted file mode 100644
index e69de29bb2..0000000000
diff --git a/test/passing/tests/let_binding-in_indent.ml.err b/test/passing/tests/let_binding-in_indent.ml.err
deleted file mode 100644
index e69de29bb2..0000000000
diff --git a/test/passing/tests/let_binding-indent.ml.err b/test/passing/tests/let_binding-indent.ml.err
deleted file mode 100644
index e69de29bb2..0000000000
diff --git a/test/passing/tests/let_binding_spacing-sparse.ml.err b/test/passing/tests/let_binding_spacing-sparse.ml.err
deleted file mode 100644
index e69de29bb2..0000000000
diff --git a/test/passing/tests/match_indent-never.ml.err b/test/passing/tests/match_indent-never.ml.err
deleted file mode 100644
index e69de29bb2..0000000000
diff --git a/test/passing/tests/match_indent.ml.err b/test/passing/tests/match_indent.ml.err
deleted file mode 100644
index e69de29bb2..0000000000
diff --git a/test/passing/tests/module_item_spacing-preserve.ml.err b/test/passing/tests/module_item_spacing-preserve.ml.err
deleted file mode 100644
index e69de29bb2..0000000000
diff --git a/test/passing/tests/module_item_spacing.mli.err b/test/passing/tests/module_item_spacing.mli.err
deleted file mode 100644
index e69de29bb2..0000000000
diff --git a/test/passing/tests/open-closing-on-separate-line.ml.err b/test/passing/tests/open-closing-on-separate-line.ml.err
deleted file mode 100644
index e69de29bb2..0000000000
diff --git a/test/passing/tests/parens_tuple_patterns.ml.err b/test/passing/tests/parens_tuple_patterns.ml.err
deleted file mode 100644
index e69de29bb2..0000000000
diff --git a/test/passing/tests/sequence-preserve.ml.err b/test/passing/tests/sequence-preserve.ml.err
deleted file mode 100644
index e69de29bb2..0000000000
diff --git a/test/passing/tests/sequence.ml.err b/test/passing/tests/sequence.ml.err
deleted file mode 100644
index e69de29bb2..0000000000
diff --git a/test/passing/tests/str_value.ml.err b/test/passing/tests/str_value.ml.err
deleted file mode 100644
index e69de29bb2..0000000000
diff --git a/test/passing/tests/try_with_or_pattern.ml.err b/test/passing/tests/try_with_or_pattern.ml.err
deleted file mode 100644
index e69de29bb2..0000000000
diff --git a/test/passing/tests/types-indent.ml.err b/test/passing/tests/types-indent.ml.err
deleted file mode 100644
index e69de29bb2..0000000000

From 37bf3f01599597fa74a1d588387b07e386d722d4 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Tue, 6 Jun 2023 15:16:12 +0200
Subject: [PATCH 087/115] Fix parsing and printing of header-like comments

Allow indented lines with no asterisks and trailing newline in asterisk
prefixed comments.

A trailing newline results in the star of the closing token to be
aligned with the asterisks.
---
 lib/Cmt.ml                              | 10 +++++++---
 lib/Cmts.ml                             | 16 ++++++++--------
 test/passing/tests/wrap_comments.ml     | 20 ++++++++++++++++++++
 test/passing/tests/wrap_comments.ml.err |  2 +-
 test/passing/tests/wrap_comments.ml.ref | 20 ++++++++++++++++++++
 5 files changed, 56 insertions(+), 12 deletions(-)

diff --git a/lib/Cmt.ml b/lib/Cmt.ml
index 05c4e0905b..3e76d42c3d 100644
--- a/lib/Cmt.ml
+++ b/lib/Cmt.ml
@@ -125,9 +125,13 @@ let unindent_lines ~opn_offset txt =
   | [] -> []
   | hd :: tl -> unindent_lines ~opn_offset hd tl
 
-let split_asterisk_prefixed = function
-  | hd :: (_ :: _ as tl)
-    when List.for_all ~f:(String.is_prefix ~prefix:"*") tl ->
+let split_asterisk_prefixed =
+  let line_is_asterisk_prefixed s =
+    if String.is_empty s then true
+    else match s.[0] with '*' | ' ' -> true | _ -> false
+  in
+  function
+  | hd :: (_ :: _ as tl) when List.for_all ~f:line_is_asterisk_prefixed tl ->
       Some (hd :: List.map tl ~f:(fun s -> String.drop_prefix s 1))
   | _ -> None
 
diff --git a/lib/Cmts.ml b/lib/Cmts.ml
index efc4f3ee39..3c4a4c6bf8 100644
--- a/lib/Cmts.ml
+++ b/lib/Cmts.ml
@@ -494,14 +494,14 @@ module Wrapped = struct
 end
 
 module Asterisk_prefixed = struct
-  let fmt ~pro ~epi lines =
-    let open Fmt in
-    let fmt_lines =
-      match lines with
-      | hd :: tl -> str hd $ list tl "" (fun s -> fmt "@,*" $ str s)
-      | [] -> noop
-    in
-    vbox 1 (pro $ fmt_lines $ epi)
+  open Fmt
+
+  let fmt_line ~first:_ ~last s =
+    if last && String.is_empty s then fmt "@," else fmt "@,*" $ str s
+
+  let fmt ~pro ~epi = function
+    | hd :: tl -> vbox 1 (pro $ str hd $ list_fl tl fmt_line $ epi)
+    | [] -> noop
 end
 
 module Unwrapped = struct
diff --git a/test/passing/tests/wrap_comments.ml b/test/passing/tests/wrap_comments.ml
index 9f24983b48..7f9abdfda0 100644
--- a/test/passing/tests/wrap_comments.ml
+++ b/test/passing/tests/wrap_comments.ml
@@ -54,6 +54,16 @@ let _ =
   ()
 ;;
 
+(*
+ * foo
+ * bar
+ *)
+
+(*
+ * foo
+   bar
+ *)
+
 [@@@ocamlformat "wrap-comments=false"]
 
 type t =
@@ -179,3 +189,13 @@ let _ =
   *)
   ()
 ;;
+
+(*
+ * foo
+ * bar
+ *)
+
+(*
+ * foo
+   bar
+ *)
diff --git a/test/passing/tests/wrap_comments.ml.err b/test/passing/tests/wrap_comments.ml.err
index 93a64804f2..1de4237e92 100644
--- a/test/passing/tests/wrap_comments.ml.err
+++ b/test/passing/tests/wrap_comments.ml.err
@@ -1 +1 @@
-Warning: tests/wrap_comments.ml:48 exceeds the margin
+Warning: tests/wrap_comments.ml:58 exceeds the margin
diff --git a/test/passing/tests/wrap_comments.ml.ref b/test/passing/tests/wrap_comments.ml.ref
index b335d64423..b6f1e893ab 100644
--- a/test/passing/tests/wrap_comments.ml.ref
+++ b/test/passing/tests/wrap_comments.ml.ref
@@ -42,6 +42,16 @@ let _ =
   (* blah blah *)
   ()
 
+(*
+ * foo
+ * bar
+ *)
+
+(*
+ * foo
+ * bar
+ *)
+
 [@@@ocamlformat "wrap-comments=false"]
 
 type t =
@@ -162,3 +172,13 @@ let _ =
     blah blah
   *)
   ()
+
+(*
+ * foo
+ * bar
+ *)
+
+(*
+ * foo
+ * bar
+ *)

From 8bf52f2961a286d1847d50d69ff663c127eb4506 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Tue, 6 Jun 2023 15:19:44 +0200
Subject: [PATCH 088/115] Update changes

---
 CHANGES.md | 1 +
 1 file changed, 1 insertion(+)

diff --git a/CHANGES.md b/CHANGES.md
index 48120fb975..cc74ef4a05 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -8,6 +8,7 @@
 
 ### Bug fixes
 
+- Consistent formatting of comments (#2371, @Julow)
 - Fix invalid formatting of `then begin end` (#2369, @Julow)
 - Protect match after `fun _ : _ ->` (#2352, @Julow)
 - Fix invalid formatting of `(::)` (#2347, @Julow)

From cf878da8959ebc6e7ebe743030058e3942148b68 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Tue, 6 Jun 2023 15:46:24 +0200
Subject: [PATCH 089/115] Fix parsing of asterisk prefixed comments too open

---
 lib/Cmt.ml | 11 +++++++++--
 1 file changed, 9 insertions(+), 2 deletions(-)

diff --git a/lib/Cmt.ml b/lib/Cmt.ml
index 3e76d42c3d..fc47acf101 100644
--- a/lib/Cmt.ml
+++ b/lib/Cmt.ml
@@ -126,12 +126,19 @@ let unindent_lines ~opn_offset txt =
   | hd :: tl -> unindent_lines ~opn_offset hd tl
 
 let split_asterisk_prefixed =
-  let line_is_asterisk_prefixed s =
+  let line_is_asterisk_prefixed s = String.is_prefix s ~prefix:"*" in
+  let line_is_asterisk_or_space_prefixed s =
     if String.is_empty s then true
     else match s.[0] with '*' | ' ' -> true | _ -> false
   in
+  (* Whether every lines starts with "*" or " ". At least one line must start
+     with a "*" and completely empty lines are allowed. *)
+  let lines_are_asterisk_prefixed lines =
+    List.exists ~f:line_is_asterisk_prefixed lines
+    && List.for_all ~f:line_is_asterisk_or_space_prefixed lines
+  in
   function
-  | hd :: (_ :: _ as tl) when List.for_all ~f:line_is_asterisk_prefixed tl ->
+  | hd :: (_ :: _ as tl) when lines_are_asterisk_prefixed tl ->
       Some (hd :: List.map tl ~f:(fun s -> String.drop_prefix s 1))
   | _ -> None
 

From 6e0ae1047a71098e296beb6f85c51016d0f9eeba Mon Sep 17 00:00:00 2001
From: Guillaume Petiot <guillaume@tarides.com>
Date: Wed, 7 Jun 2023 10:55:41 +0100
Subject: [PATCH 090/115] Cleanup Cmt

---
 lib/Cmt.ml  | 15 ---------------
 lib/Cmt.mli |  8 --------
 2 files changed, 23 deletions(-)

diff --git a/lib/Cmt.ml b/lib/Cmt.ml
index fc47acf101..e775598ec0 100644
--- a/lib/Cmt.ml
+++ b/lib/Cmt.ml
@@ -71,21 +71,6 @@ let pp_error fs {kind; cmt_kind} =
              formatting using the option --no-parse-docstrings.\n\
              %!" )
 
-module T_no_loc = struct
-  include T
-
-  let compare =
-    Comparable.lexicographic [Comparable.lift String.compare ~f:txt]
-end
-
-type loc = t
-
-module Comparator_no_loc = struct
-  type t = loc
-
-  include Comparator.Make (T_no_loc)
-end
-
 type pos = Before | Within | After
 
 type decoded_kind =
diff --git a/lib/Cmt.mli b/lib/Cmt.mli
index f3ef074c18..92a785e3f1 100644
--- a/lib/Cmt.mli
+++ b/lib/Cmt.mli
@@ -29,14 +29,6 @@ val pp_error : Format.formatter -> error -> unit
 
 type pos = Before | Within | After
 
-type loc = t
-
-module Comparator_no_loc : sig
-  type t = loc
-
-  include Comparator.S with type t := t
-end
-
 type decoded_kind =
   | Verbatim of string  (** Original content. *)
   | Doc of string  (** Original content. *)

From 9a5bb99c8c4916d0d15a9032ac704c621b66474b Mon Sep 17 00:00:00 2001
From: Guillaume Petiot <guillaume@tarides.com>
Date: Wed, 7 Jun 2023 11:08:22 +0100
Subject: [PATCH 091/115] Don't check the margin to group comments

---
 lib/Cmts.ml                                   | 11 +--
 test/passing/dune.inc                         | 18 ++++
 test/passing/tests/asterisk_prefixed_cmts.ml  | 16 ++++
 .../tests/asterisk_prefixed_cmts.ml.err       |  9 ++
 .../tests/asterisk_prefixed_cmts.ml.ref       | 17 ++++
 test/passing/tests/js_source.ml.ocp           |  7 +-
 test/passing/tests/js_source.ml.ref           | 71 ++++++++--------
 test/passing/tests/source.ml.err              |  2 +-
 test/passing/tests/source.ml.ref              | 82 ++++++++++++-------
 9 files changed, 155 insertions(+), 78 deletions(-)
 create mode 100644 test/passing/tests/asterisk_prefixed_cmts.ml
 create mode 100644 test/passing/tests/asterisk_prefixed_cmts.ml.err
 create mode 100644 test/passing/tests/asterisk_prefixed_cmts.ml.ref

diff --git a/lib/Cmts.ml b/lib/Cmts.ml
index 3c4a4c6bf8..b3cba5763f 100644
--- a/lib/Cmts.ml
+++ b/lib/Cmts.ml
@@ -446,7 +446,7 @@ let find_cmts ?(filter = Fn.const true) t pos loc =
       update_cmts t pos ~f:(Map.set ~key:loc ~data:not_picked) ;
       picked )
 
-let break_comment_group source margin {Cmt.loc= a; _} {Cmt.loc= b; _} =
+let break_comment_group source {Cmt.loc= a; _} {Cmt.loc= b; _} =
   let vertical_align =
     Location.line_difference a b = 1 && Location.compare_start_col a b = 0
   in
@@ -456,9 +456,7 @@ let break_comment_group source margin {Cmt.loc= a; _} {Cmt.loc= b; _} =
          (Source.tokens_between source a.loc_end b.loc_start
               ~filter:(function _ -> true) )
   in
-  not
-    ( (Location.is_single_line a margin && Location.is_single_line b margin)
-    && (vertical_align || horizontal_align) )
+  not (vertical_align || horizontal_align)
 
 let is_only_whitespaces s = String.for_all s ~f:Char.is_whitespace
 
@@ -616,10 +614,7 @@ let fmt_cmt (conf : Conf.t) cmt ~fmt_code (pos : Cmt.pos) =
 
 let fmt_cmts_aux t (conf : Conf.t) cmts ~fmt_code pos =
   let open Fmt in
-  let groups =
-    List.group cmts
-      ~break:(break_comment_group t.source conf.fmt_opts.margin.v)
-  in
+  let groups = List.group cmts ~break:(break_comment_group t.source) in
   vbox 0 ~name:"cmts"
     (list_pn groups (fun ~prev:_ group ~next ->
          ( match group with
diff --git a/test/passing/dune.inc b/test/passing/dune.inc
index 7ae5163d6c..239f60516f 100644
--- a/test/passing/dune.inc
+++ b/test/passing/dune.inc
@@ -161,6 +161,24 @@
  (package ocamlformat)
  (action (diff tests/assignment_operator.ml.err assignment_operator.ml.stderr)))
 
+(rule
+ (deps tests/.ocamlformat )
+ (package ocamlformat)
+ (action
+  (with-stdout-to asterisk_prefixed_cmts.ml.stdout
+   (with-stderr-to asterisk_prefixed_cmts.ml.stderr
+     (run %{bin:ocamlformat} --margin-check %{dep:tests/asterisk_prefixed_cmts.ml})))))
+
+(rule
+ (alias runtest)
+ (package ocamlformat)
+ (action (diff tests/asterisk_prefixed_cmts.ml.ref asterisk_prefixed_cmts.ml.stdout)))
+
+(rule
+ (alias runtest)
+ (package ocamlformat)
+ (action (diff tests/asterisk_prefixed_cmts.ml.err asterisk_prefixed_cmts.ml.stderr)))
+
 (rule
  (deps tests/.ocamlformat )
  (package ocamlformat)
diff --git a/test/passing/tests/asterisk_prefixed_cmts.ml b/test/passing/tests/asterisk_prefixed_cmts.ml
new file mode 100644
index 0000000000..1ac4cb99d4
--- /dev/null
+++ b/test/passing/tests/asterisk_prefixed_cmts.ml
@@ -0,0 +1,16 @@
+let _ =
+  (* It is very confusing - same expression has two different types in two contexts:*)
+  (* 1. if passed as parameter it's RETURN_TYPE* since we are passing it as rvalue *)
+  (* 2. for return expression it's RETURN_TYPE since backend allows to treat it as lvalue*)
+  (*    of RETURN_TYPE *)
+  (* Implications: *)
+  (* Fields: field_deref_trans relies on it - if exp has RETURN_TYPE then *)
+  (*         it means that it's not lvalue in clang's AST (it'd be reference otherwise) *)
+  (* Methods: method_deref_trans actually wants a pointer to the object, which is*)
+  (*          equivalent of value of ret_param. Since ret_exp has type RETURN_TYPE,*)
+  (*          we optionally add pointer there to avoid backend confusion. *)
+  (*          It works either way *)
+  (* Passing by value: may cause problems - there needs to be extra Sil.Load, but*)
+  (*                   doing so would create problems with methods. Passing structs by*)
+  (*                   value doesn't work good anyway. This may need to be revisited later*)
+  let x = y in z
diff --git a/test/passing/tests/asterisk_prefixed_cmts.ml.err b/test/passing/tests/asterisk_prefixed_cmts.ml.err
new file mode 100644
index 0000000000..dfda3bc2e5
--- /dev/null
+++ b/test/passing/tests/asterisk_prefixed_cmts.ml.err
@@ -0,0 +1,9 @@
+Warning: tests/asterisk_prefixed_cmts.ml:1 exceeds the margin
+Warning: tests/asterisk_prefixed_cmts.ml:2 exceeds the margin
+Warning: tests/asterisk_prefixed_cmts.ml:3 exceeds the margin
+Warning: tests/asterisk_prefixed_cmts.ml:7 exceeds the margin
+Warning: tests/asterisk_prefixed_cmts.ml:8 exceeds the margin
+Warning: tests/asterisk_prefixed_cmts.ml:9 exceeds the margin
+Warning: tests/asterisk_prefixed_cmts.ml:12 exceeds the margin
+Warning: tests/asterisk_prefixed_cmts.ml:13 exceeds the margin
+Warning: tests/asterisk_prefixed_cmts.ml:14 exceeds the margin
diff --git a/test/passing/tests/asterisk_prefixed_cmts.ml.ref b/test/passing/tests/asterisk_prefixed_cmts.ml.ref
new file mode 100644
index 0000000000..ff4677e024
--- /dev/null
+++ b/test/passing/tests/asterisk_prefixed_cmts.ml.ref
@@ -0,0 +1,17 @@
+let _ =
+  (* It is very confusing - same expression has two different types in two contexts:*)
+  (* 1. if passed as parameter it's RETURN_TYPE* since we are passing it as rvalue *)
+  (* 2. for return expression it's RETURN_TYPE since backend allows to treat it as lvalue*)
+  (*    of RETURN_TYPE *)
+  (* Implications: *)
+  (* Fields: field_deref_trans relies on it - if exp has RETURN_TYPE then *)
+  (*         it means that it's not lvalue in clang's AST (it'd be reference otherwise) *)
+  (* Methods: method_deref_trans actually wants a pointer to the object, which is*)
+  (*          equivalent of value of ret_param. Since ret_exp has type RETURN_TYPE,*)
+  (*          we optionally add pointer there to avoid backend confusion. *)
+  (*          It works either way *)
+  (* Passing by value: may cause problems - there needs to be extra Sil.Load, but*)
+  (*                   doing so would create problems with methods. Passing structs by*)
+  (*                   value doesn't work good anyway. This may need to be revisited later*)
+  let x = y in
+  z
diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp
index fc676c8779..9264822829 100644
--- a/test/passing/tests/js_source.ml.ocp
+++ b/test/passing/tests/js_source.ml.ocp
@@ -10089,9 +10089,10 @@ let _ =
 (*$*)
 
 (*$
-  [%string {| xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
-  zzzzzzzzzzzzzzzzzzzzzzzzzzzz
-      |}]
+  [%string
+    {| xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
+zzzzzzzzzzzzzzzzzzzzzzzzzzzz
+    |}]
 *)
 (*$*)
 
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index 211f46c744..58ed460503 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -1441,20 +1441,20 @@ let ty_list : type a e. (a, e) ty -> (a vlist, e) ty =
 ;;
 
 (*
-   type (_,_) ty_assoc =
-   | Anil : (unit,'e) ty_assoc
-   | Acons : string * ('a,'e) ty * ('b,'e) ty_assoc -> ('a -> 'b, 'e) ty_assoc
-
-   and (_,_) ty_pvar =
-   | Pnil : ('a,'e) ty_pvar
-   | Pconst : 't * ('b,'e) ty_pvar -> ('t -> 'b, 'e) ty_pvar
-   | Parg : 't * ('a,'e) ty * ('b,'e) ty_pvar -> ('t * 'a -> 'b, 'e) ty_pvar
+type (_,_) ty_assoc =
+  | Anil : (unit,'e) ty_assoc
+  | Acons : string * ('a,'e) ty * ('b,'e) ty_assoc -> ('a -> 'b, 'e) ty_assoc
+
+and (_,_) ty_pvar =
+  | Pnil : ('a,'e) ty_pvar
+  | Pconst : 't * ('b,'e) ty_pvar -> ('t -> 'b, 'e) ty_pvar
+  | Parg : 't * ('a,'e) ty * ('b,'e) ty_pvar -> ('t * 'a -> 'b, 'e) ty_pvar
 *)
 (*
    An attempt at encoding omega examples from the 2nd Central European
    Functional Programming School:
-   Generic Programming in Omega, by Tim Sheard and Nathan Linger
-   http://web.cecs.pdx.edu/~sheard/
+     Generic Programming in Omega, by Tim Sheard and Nathan Linger
+          http://web.cecs.pdx.edu/~sheard/
 *)
 
 (* Basic types *)
@@ -3305,7 +3305,7 @@ Error: Types marked with the immediate attribute must be
 
    New: implicit pack is also supported, and you only need to be able
    to infer the the module type path from the context.
-*)
+ *)
 (* ocaml -principal *)
 
 (* Use a module pattern *)
@@ -5227,21 +5227,21 @@ module type S' = S with module M := String
 
 (* with module type *)
 (*
-   module type S = sig module type T module F(X:T) : T end;;
-   module type T0 = sig type t end;;
-   module type S1 = S with module type T = T0;;
-   module type S2 = S with module type T := T0;;
-   module type S3 = S with module type T := sig type t = int end;;
-   module H = struct
-   include (Hashtbl : module type of Hashtbl with
-   type statistics := Hashtbl.statistics
-   and module type S := Hashtbl.S
-   and module Make := Hashtbl.Make
-   and module MakeSeeded := Hashtbl.MakeSeeded
-   and module type SeededS := Hashtbl.SeededS
-   and module type HashedType := Hashtbl.HashedType
-   and module type SeededHashedType := Hashtbl.SeededHashedType)
-   end;;
+module type S = sig module type T module F(X:T) : T end;;
+module type T0 = sig type t end;;
+module type S1 = S with module type T = T0;;
+module type S2 = S with module type T := T0;;
+module type S3 = S with module type T := sig type t = int end;;
+module H = struct
+  include (Hashtbl : module type of Hashtbl with
+           type statistics := Hashtbl.statistics
+           and module type S := Hashtbl.S
+           and module Make := Hashtbl.Make
+           and module MakeSeeded := Hashtbl.MakeSeeded
+           and module type SeededS := Hashtbl.SeededS
+           and module type HashedType := Hashtbl.HashedType
+           and module type SeededHashedType := Hashtbl.SeededHashedType)
+end;;
 *)
 
 (* A subtle problem appearing with -principal *)
@@ -6066,14 +6066,14 @@ class ['entity] entity_container =
 let f (x : entity entity_container) = ()
 
 (*
-   class world =
-   object
-   val entity_container : entity entity_container = new entity_container
+class world =
+  object
+    val entity_container : entity entity_container = new entity_container
 
-   method add_entity (s : entity) =
-   entity_container#add_entity (s :> entity)
+    method add_entity (s : entity) =
+      entity_container#add_entity (s :> entity)
 
-   end
+  end
 *)
 (* Two v's in the same class *)
 class c v =
@@ -10089,9 +10089,10 @@ let _ =
 (*$*)
 
 (*$
-  [%string {| xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
-  zzzzzzzzzzzzzzzzzzzzzzzzzzzz
-      |}]
+    [%string
+      {| xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
+zzzzzzzzzzzzzzzzzzzzzzzzzzzz
+    |}]
 *)
 (*$*)
 
diff --git a/test/passing/tests/source.ml.err b/test/passing/tests/source.ml.err
index 50f7e55a5d..4c07f04df3 100644
--- a/test/passing/tests/source.ml.err
+++ b/test/passing/tests/source.ml.err
@@ -1,2 +1,2 @@
 Warning: tests/source.ml:702 exceeds the margin
-Warning: tests/source.ml:2318 exceeds the margin
+Warning: tests/source.ml:2325 exceeds the margin
diff --git a/test/passing/tests/source.ml.ref b/test/passing/tests/source.ml.ref
index e9e1eb8878..6c9f1869a5 100644
--- a/test/passing/tests/source.ml.ref
+++ b/test/passing/tests/source.ml.ref
@@ -1471,15 +1471,22 @@ let ty_list : type a e. (a, e) ty -> (a vlist, e) ty =
             function Thd, Noarg -> `Nil | Ttl Thd, v -> `Cons v
        end ) )
 
-(* type (_,_) ty_assoc = | Anil : (unit,'e) ty_assoc | Acons : string *
-   ('a,'e) ty * ('b,'e) ty_assoc -> ('a -> 'b, 'e) ty_assoc
-
-   and (_,_) ty_pvar = | Pnil : ('a,'e) ty_pvar | Pconst : 't * ('b,'e)
-   ty_pvar -> ('t -> 'b, 'e) ty_pvar | Parg : 't * ('a,'e) ty * ('b,'e)
-   ty_pvar -> ('t * 'a -> 'b, 'e) ty_pvar *)
-(* An attempt at encoding omega examples from the 2nd Central European
-   Functional Programming School: Generic Programming in Omega, by Tim Sheard
-   and Nathan Linger http://web.cecs.pdx.edu/~sheard/ *)
+(*
+type (_,_) ty_assoc =
+  | Anil : (unit,'e) ty_assoc
+  | Acons : string * ('a,'e) ty * ('b,'e) ty_assoc -> ('a -> 'b, 'e) ty_assoc
+
+and (_,_) ty_pvar =
+  | Pnil : ('a,'e) ty_pvar
+  | Pconst : 't * ('b,'e) ty_pvar -> ('t -> 'b, 'e) ty_pvar
+  | Parg : 't * ('a,'e) ty * ('b,'e) ty_pvar -> ('t * 'a -> 'b, 'e) ty_pvar
+*)
+(*
+   An attempt at encoding omega examples from the 2nd Central European
+   Functional Programming School:
+     Generic Programming in Omega, by Tim Sheard and Nathan Linger
+          http://web.cecs.pdx.edu/~sheard/
+*)
 
 (* Basic types *)
 
@@ -1501,8 +1508,8 @@ let l1 = Scons (3, Scons (5, Snil))
 
 (* We do not have type level functions, so we need to use witnesses. *)
 (* We copy here the definitions from section 3.9 *)
-(* Note the addition of the ['a nat] argument to PlusZ, since we do not have
-   kinds *)
+(* Note the addition of the ['a nat] argument to PlusZ, since we do not
+   have kinds *)
 type (_, _, _) plus =
   | PlusZ : 'a nat -> (zero, 'a, 'a) plus
   | PlusS : ('a, 'b, 'c) plus -> ('a succ, 'b, 'c succ) plus
@@ -3156,14 +3163,16 @@ Error: Types marked with the immediate attribute must be
        non-pointer types like int or bool
 |}]
 
-(* Implicit unpack allows to omit the signature in (val ...) expressions.
+(*
+   Implicit unpack allows to omit the signature in (val ...) expressions.
 
-   It also adds (module M : S) and (module M) patterns, relying on implicit
-   (val ...) for the implementation. Such patterns can only be used in
-   function definition, match clauses, and let ... in.
+   It also adds (module M : S) and (module M) patterns, relying on
+   implicit (val ...) for the implementation. Such patterns can only
+   be used in function definition, match clauses, and let ... in.
 
-   New: implicit pack is also supported, and you only need to be able to
-   infer the the module type path from the context. *)
+   New: implicit pack is also supported, and you only need to be able
+   to infer the the module type path from the context.
+ *)
 (* ocaml -principal *)
 
 (* Use a module pattern *)
@@ -4994,15 +5003,23 @@ end
 module type S' = S with module M := String
 
 (* with module type *)
-(* module type S = sig module type T module F(X:T) : T end;; module type T0 =
-   sig type t end;; module type S1 = S with module type T = T0;; module type
-   S2 = S with module type T := T0;; module type S3 = S with module type T :=
-   sig type t = int end;; module H = struct include (Hashtbl : module type of
-   Hashtbl with type statistics := Hashtbl.statistics and module type S :=
-   Hashtbl.S and module Make := Hashtbl.Make and module MakeSeeded :=
-   Hashtbl.MakeSeeded and module type SeededS := Hashtbl.SeededS and module
-   type HashedType := Hashtbl.HashedType and module type SeededHashedType :=
-   Hashtbl.SeededHashedType) end;; *)
+(*
+module type S = sig module type T module F(X:T) : T end;;
+module type T0 = sig type t end;;
+module type S1 = S with module type T = T0;;
+module type S2 = S with module type T := T0;;
+module type S3 = S with module type T := sig type t = int end;;
+module H = struct
+  include (Hashtbl : module type of Hashtbl with
+           type statistics := Hashtbl.statistics
+           and module type S := Hashtbl.S
+           and module Make := Hashtbl.Make
+           and module MakeSeeded := Hashtbl.MakeSeeded
+           and module type SeededS := Hashtbl.SeededS
+           and module type HashedType := Hashtbl.HashedType
+           and module type SeededHashedType := Hashtbl.SeededHashedType)
+end;;
+*)
 
 (* A subtle problem appearing with -principal *)
 type -'a t
@@ -5835,13 +5852,16 @@ class ['entity] entity_container =
 
 let f (x : entity entity_container) = ()
 
-(* class world = object val entity_container : entity entity_container = new
-   entity_container
+(*
+class world =
+  object
+    val entity_container : entity entity_container = new entity_container
 
-   method add_entity (s : entity) = entity_container#add_entity (s :>
-   entity)
+    method add_entity (s : entity) =
+      entity_container#add_entity (s :> entity)
 
-   end *)
+  end
+*)
 (* Two v's in the same class *)
 class c v =
   object

From 58e8d0b349aea675006a7094d3b13000bb9b0969 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Wed, 7 Jun 2023 13:25:41 +0200
Subject: [PATCH 092/115] Even less open parsing of asterisk prefixed

This could interfere with a comment like:

      (*with exn ->
          failwiths "binary_search bug"
          (exn, `length length, `search_key search_key, `pos pos, `len len)
          <:sexp_of< exn * [ `length of int ] * [ `search_key of int ]
       * [ `pos of int ] * [ `len of int ] >>*)
---
 lib/Cmt.ml                              | 22 ++++++++++------------
 test/passing/tests/wrap_comments.ml.ref | 12 ++++++------
 2 files changed, 16 insertions(+), 18 deletions(-)

diff --git a/lib/Cmt.ml b/lib/Cmt.ml
index e775598ec0..18b8dc22da 100644
--- a/lib/Cmt.ml
+++ b/lib/Cmt.ml
@@ -111,20 +111,18 @@ let unindent_lines ~opn_offset txt =
   | hd :: tl -> unindent_lines ~opn_offset hd tl
 
 let split_asterisk_prefixed =
-  let line_is_asterisk_prefixed s = String.is_prefix s ~prefix:"*" in
-  let line_is_asterisk_or_space_prefixed s =
-    if String.is_empty s then true
-    else match s.[0] with '*' | ' ' -> true | _ -> false
-  in
-  (* Whether every lines starts with "*" or " ". At least one line must start
-     with a "*" and completely empty lines are allowed. *)
-  let lines_are_asterisk_prefixed lines =
-    List.exists ~f:line_is_asterisk_prefixed lines
-    && List.for_all ~f:line_is_asterisk_or_space_prefixed lines
+  let rec lines_are_asterisk_prefixed = function
+    (* Allow the last line to be empty *)
+    | [] | [""] -> true
+    | hd :: tl ->
+        String.is_prefix hd ~prefix:"*" && lines_are_asterisk_prefixed tl
   in
   function
-  | hd :: (_ :: _ as tl) when lines_are_asterisk_prefixed tl ->
-      Some (hd :: List.map tl ~f:(fun s -> String.drop_prefix s 1))
+  (* Check whether the second line is not empty to avoid matching a comment
+     with no asterisks. *)
+  | fst_line :: (snd_line :: _ as tl)
+    when lines_are_asterisk_prefixed tl && not (String.is_empty snd_line) ->
+      Some (fst_line :: List.map tl ~f:(fun s -> String.drop_prefix s 1))
   | _ -> None
 
 let mk ?(prefix = "") ?(suffix = "") kind = {prefix; suffix; kind}
diff --git a/test/passing/tests/wrap_comments.ml.ref b/test/passing/tests/wrap_comments.ml.ref
index b6f1e893ab..05bd65017a 100644
--- a/test/passing/tests/wrap_comments.ml.ref
+++ b/test/passing/tests/wrap_comments.ml.ref
@@ -48,9 +48,9 @@ let _ =
  *)
 
 (*
- * foo
- * bar
- *)
+  * foo
+    bar
+*)
 
 [@@@ocamlformat "wrap-comments=false"]
 
@@ -179,6 +179,6 @@ let _ =
  *)
 
 (*
- * foo
- * bar
- *)
+  * foo
+    bar
+*)

From f4f64ca58decdc948fb585e2fb28276a09781898 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Wed, 7 Jun 2023 16:03:48 +0200
Subject: [PATCH 093/115] Change the baseline indentation for unwrapped
 comments

Preserve comments like:

    (*
    foo
    *)
---
 lib/Cmt.ml                                    | 43 ++++++++++++-------
 lib/Cmts.ml                                   |  2 +-
 test/passing/tests/doc_comments-after.ml.err  |  5 +--
 test/passing/tests/doc_comments-after.ml.ref  |  8 ++--
 .../doc_comments-before-except-val.ml.err     |  5 +--
 .../doc_comments-before-except-val.ml.ref     |  8 ++--
 test/passing/tests/doc_comments-before.ml.err |  5 +--
 test/passing/tests/doc_comments-before.ml.ref |  8 ++--
 test/passing/tests/doc_comments.ml.err        |  5 +--
 test/passing/tests/doc_comments.ml.ref        |  8 ++--
 test/passing/tests/wrap_comments.ml.ref       | 10 ++---
 11 files changed, 58 insertions(+), 49 deletions(-)

diff --git a/lib/Cmt.ml b/lib/Cmt.ml
index 18b8dc22da..3241008522 100644
--- a/lib/Cmt.ml
+++ b/lib/Cmt.ml
@@ -82,8 +82,11 @@ type decoded_kind =
 
 type decoded = {prefix: string; suffix: string; kind: decoded_kind}
 
-(** [opn_offset] indicates at which column the body of the comment starts. *)
-let unindent_lines ~opn_offset first_line tl_lines =
+(** [~content_offset] indicates at which column the body of the comment
+    starts (1-indexed). [~max_idnent] indicates the maximum amount of
+    indentation to trim. *)
+let unindent_lines ?(max_indent = Stdlib.max_int) ~content_offset first_line
+    tl_lines =
   let indent_of_line s =
     (* index of first non-whitespace is indentation, None means white line *)
     String.lfindi s ~f:(fun _ c -> not (Char.is_whitespace c))
@@ -92,9 +95,10 @@ let unindent_lines ~opn_offset first_line tl_lines =
      comment opening. Don't account for the first line if it's empty. *)
   let fl_spaces, fl_indent =
     match indent_of_line first_line with
-    | Some i -> (i, i + opn_offset)
+    | Some i -> (i, i + content_offset - 1)
     | None -> (String.length first_line, Stdlib.max_int)
   in
+  let fl_indent = min max_indent fl_indent in
   let min_indent =
     List.fold_left ~init:fl_indent
       ~f:(fun acc s ->
@@ -105,30 +109,33 @@ let unindent_lines ~opn_offset first_line tl_lines =
   String.drop_prefix first_line fl_spaces
   :: List.map ~f:(fun s -> String.drop_prefix s min_indent) tl_lines
 
-let unindent_lines ~opn_offset txt =
+let unindent_lines ?max_indent ~content_offset txt =
   match String.split ~on:'\n' txt with
   | [] -> []
-  | hd :: tl -> unindent_lines ~opn_offset hd tl
+  | hd :: tl -> unindent_lines ?max_indent ~content_offset hd tl
+
+let is_all_whitespace s = String.for_all s ~f:Char.is_whitespace
 
 let split_asterisk_prefixed =
+  let prefix = " *" in
+  let drop_prefix s = String.drop_prefix s (String.length prefix) in
   let rec lines_are_asterisk_prefixed = function
+    | [] -> true
     (* Allow the last line to be empty *)
-    | [] | [""] -> true
+    | [last] when is_all_whitespace last -> true
     | hd :: tl ->
-        String.is_prefix hd ~prefix:"*" && lines_are_asterisk_prefixed tl
+        String.is_prefix hd ~prefix && lines_are_asterisk_prefixed tl
   in
   function
   (* Check whether the second line is not empty to avoid matching a comment
      with no asterisks. *)
   | fst_line :: (snd_line :: _ as tl)
     when lines_are_asterisk_prefixed tl && not (String.is_empty snd_line) ->
-      Some (fst_line :: List.map tl ~f:(fun s -> String.drop_prefix s 1))
+      Some (fst_line :: List.map tl ~f:drop_prefix)
   | _ -> None
 
 let mk ?(prefix = "") ?(suffix = "") kind = {prefix; suffix; kind}
 
-let is_all_whitespace s = String.for_all s ~f:Char.is_whitespace
-
 let decode ~parse_comments_as_doc {txt; loc} =
   let txt =
     (* Windows compatibility *)
@@ -137,20 +144,20 @@ let decode ~parse_comments_as_doc {txt; loc} =
   in
   let opn_offset =
     let {Lexing.pos_cnum; pos_bol; _} = loc.Location.loc_start in
-    pos_cnum - pos_bol + 2
+    pos_cnum - pos_bol + 1
   in
   if String.length txt >= 2 then
     match txt.[0] with
     | '$' when not (Char.is_whitespace txt.[1]) -> mk (Verbatim txt)
     | '$' ->
-        let opn_offset = opn_offset + 1 in
+        let content_offset = opn_offset + 3 (* for opening + [$] *) in
         let dollar_suf = Char.equal txt.[String.length txt - 1] '$' in
         let suffix = if dollar_suf then "$" else "" in
         let source =
           let len = String.length txt - if dollar_suf then 2 else 1 in
           String.sub ~pos:1 ~len txt
         in
-        let lines = unindent_lines ~opn_offset source in
+        let lines = unindent_lines ~content_offset source in
         let lines = List.map ~f:String.rstrip lines in
         let lines = List.drop_while ~f:is_all_whitespace lines in
         let code = String.concat ~sep:"\n" lines in
@@ -161,13 +168,19 @@ let decode ~parse_comments_as_doc {txt; loc} =
         mk (Verbatim " ") (* Make sure not to format to [(**)]. *)
     | _ when parse_comments_as_doc -> mk (Doc txt)
     | _ -> (
-        let lines = unindent_lines ~opn_offset txt in
+        (* Indentation baseline is at the level of the opening to avoid
+           indenting commented code. *)
+        let lines =
+          let content_offset = opn_offset + 2
+          and max_indent = opn_offset - 1 in
+          unindent_lines ~max_indent ~content_offset txt
+        in
         (* Don't add a space to the prefix if the first line was only
            spaces. *)
         let prefix =
           if
             String.starts_with_whitespace txt
-            && not (String.is_empty (List.hd_exn lines))
+            && not (is_all_whitespace (List.hd_exn lines))
           then " "
           else ""
         in
diff --git a/lib/Cmts.ml b/lib/Cmts.ml
index b3cba5763f..907a1c6d6c 100644
--- a/lib/Cmts.ml
+++ b/lib/Cmts.ml
@@ -527,7 +527,7 @@ module Unwrapped = struct
     in
     match String.split ~on:'\n' txt with
     | hd :: tl ->
-        pro $ vbox 0 ~name:"unwrapped" (str hd $ list_fl tl fmt_line) $ epi
+        vbox 0 ~name:"unwrapped" (pro $ str hd $ list_fl tl fmt_line) $ epi
     | [] -> noop
 end
 
diff --git a/test/passing/tests/doc_comments-after.ml.err b/test/passing/tests/doc_comments-after.ml.err
index 71ec524f66..dd738d90f3 100644
--- a/test/passing/tests/doc_comments-after.ml.err
+++ b/test/passing/tests/doc_comments-after.ml.err
@@ -1,4 +1 @@
-Warning: tests/doc_comments.ml:268 exceeds the margin
-Warning: tests/doc_comments.ml:269 exceeds the margin
-Warning: tests/doc_comments.ml:270 exceeds the margin
-Warning: tests/doc_comments.ml:299 exceeds the margin
+Warning: tests/doc_comments.ml:301 exceeds the margin
diff --git a/test/passing/tests/doc_comments-after.ml.ref b/test/passing/tests/doc_comments-after.ml.ref
index ad4ad77c2e..fdacc13e71 100644
--- a/test/passing/tests/doc_comments-after.ml.ref
+++ b/test/passing/tests/doc_comments-after.ml.ref
@@ -266,9 +266,11 @@ module A = struct
   end
 end
 
-(* Same with get_pure, except that when we have both "x = t" and "y = t" where t is a primed ident,
- * we add "x = y" to the result. This is crucial for the normalizer, as it tend to drop "x = t" before
- * processing "y = t". If we don't explicitly preserve "x = y", the normalizer cannot pick it up *)
+(* Same with get_pure, except that when we have both "x = t" and "y = t"
+   where t is a primed ident, * we add "x = y" to the result. This is crucial
+   for the normalizer, as it tend to drop "x = t" before * processing "y =
+   t". If we don't explicitly preserve "x = y", the normalizer cannot pick it
+   up *)
 let _ = ()
 
 (** Tags without text *)
diff --git a/test/passing/tests/doc_comments-before-except-val.ml.err b/test/passing/tests/doc_comments-before-except-val.ml.err
index 71ec524f66..dd738d90f3 100644
--- a/test/passing/tests/doc_comments-before-except-val.ml.err
+++ b/test/passing/tests/doc_comments-before-except-val.ml.err
@@ -1,4 +1 @@
-Warning: tests/doc_comments.ml:268 exceeds the margin
-Warning: tests/doc_comments.ml:269 exceeds the margin
-Warning: tests/doc_comments.ml:270 exceeds the margin
-Warning: tests/doc_comments.ml:299 exceeds the margin
+Warning: tests/doc_comments.ml:301 exceeds the margin
diff --git a/test/passing/tests/doc_comments-before-except-val.ml.ref b/test/passing/tests/doc_comments-before-except-val.ml.ref
index 66cc7751a1..59a6180c19 100644
--- a/test/passing/tests/doc_comments-before-except-val.ml.ref
+++ b/test/passing/tests/doc_comments-before-except-val.ml.ref
@@ -266,9 +266,11 @@ module A = struct
   end
 end
 
-(* Same with get_pure, except that when we have both "x = t" and "y = t" where t is a primed ident,
- * we add "x = y" to the result. This is crucial for the normalizer, as it tend to drop "x = t" before
- * processing "y = t". If we don't explicitly preserve "x = y", the normalizer cannot pick it up *)
+(* Same with get_pure, except that when we have both "x = t" and "y = t"
+   where t is a primed ident, * we add "x = y" to the result. This is crucial
+   for the normalizer, as it tend to drop "x = t" before * processing "y =
+   t". If we don't explicitly preserve "x = y", the normalizer cannot pick it
+   up *)
 let _ = ()
 
 (** Tags without text *)
diff --git a/test/passing/tests/doc_comments-before.ml.err b/test/passing/tests/doc_comments-before.ml.err
index 71ec524f66..dd738d90f3 100644
--- a/test/passing/tests/doc_comments-before.ml.err
+++ b/test/passing/tests/doc_comments-before.ml.err
@@ -1,4 +1 @@
-Warning: tests/doc_comments.ml:268 exceeds the margin
-Warning: tests/doc_comments.ml:269 exceeds the margin
-Warning: tests/doc_comments.ml:270 exceeds the margin
-Warning: tests/doc_comments.ml:299 exceeds the margin
+Warning: tests/doc_comments.ml:301 exceeds the margin
diff --git a/test/passing/tests/doc_comments-before.ml.ref b/test/passing/tests/doc_comments-before.ml.ref
index ae6ef68376..efa518581f 100644
--- a/test/passing/tests/doc_comments-before.ml.ref
+++ b/test/passing/tests/doc_comments-before.ml.ref
@@ -266,9 +266,11 @@ module A = struct
   end
 end
 
-(* Same with get_pure, except that when we have both "x = t" and "y = t" where t is a primed ident,
- * we add "x = y" to the result. This is crucial for the normalizer, as it tend to drop "x = t" before
- * processing "y = t". If we don't explicitly preserve "x = y", the normalizer cannot pick it up *)
+(* Same with get_pure, except that when we have both "x = t" and "y = t"
+   where t is a primed ident, * we add "x = y" to the result. This is crucial
+   for the normalizer, as it tend to drop "x = t" before * processing "y =
+   t". If we don't explicitly preserve "x = y", the normalizer cannot pick it
+   up *)
 let _ = ()
 
 (** Tags without text *)
diff --git a/test/passing/tests/doc_comments.ml.err b/test/passing/tests/doc_comments.ml.err
index 71ec524f66..dd738d90f3 100644
--- a/test/passing/tests/doc_comments.ml.err
+++ b/test/passing/tests/doc_comments.ml.err
@@ -1,4 +1 @@
-Warning: tests/doc_comments.ml:268 exceeds the margin
-Warning: tests/doc_comments.ml:269 exceeds the margin
-Warning: tests/doc_comments.ml:270 exceeds the margin
-Warning: tests/doc_comments.ml:299 exceeds the margin
+Warning: tests/doc_comments.ml:301 exceeds the margin
diff --git a/test/passing/tests/doc_comments.ml.ref b/test/passing/tests/doc_comments.ml.ref
index 66cc7751a1..59a6180c19 100644
--- a/test/passing/tests/doc_comments.ml.ref
+++ b/test/passing/tests/doc_comments.ml.ref
@@ -266,9 +266,11 @@ module A = struct
   end
 end
 
-(* Same with get_pure, except that when we have both "x = t" and "y = t" where t is a primed ident,
- * we add "x = y" to the result. This is crucial for the normalizer, as it tend to drop "x = t" before
- * processing "y = t". If we don't explicitly preserve "x = y", the normalizer cannot pick it up *)
+(* Same with get_pure, except that when we have both "x = t" and "y = t"
+   where t is a primed ident, * we add "x = y" to the result. This is crucial
+   for the normalizer, as it tend to drop "x = t" before * processing "y =
+   t". If we don't explicitly preserve "x = y", the normalizer cannot pick it
+   up *)
 let _ = ()
 
 (** Tags without text *)
diff --git a/test/passing/tests/wrap_comments.ml.ref b/test/passing/tests/wrap_comments.ml.ref
index 05bd65017a..896b5e6eaa 100644
--- a/test/passing/tests/wrap_comments.ml.ref
+++ b/test/passing/tests/wrap_comments.ml.ref
@@ -48,8 +48,8 @@ let _ =
  *)
 
 (*
-  * foo
-    bar
+ * foo
+   bar
 *)
 
 [@@@ocamlformat "wrap-comments=false"]
@@ -135,7 +135,7 @@ let _ =
 let _ =
   let _ =
     (* This is indented 7
-       This 0 *)
+    This 0 *)
     0
   in
   0
@@ -179,6 +179,6 @@ let _ =
  *)
 
 (*
-  * foo
-    bar
+ * foo
+   bar
 *)

From 017935dea86efb14c90d7798c7066c6643f9ffae Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Wed, 7 Jun 2023 16:37:31 +0200
Subject: [PATCH 094/115] Fix interference between f4f64ca5 and 58e8d0b3

---
 lib/Cmt.ml | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/lib/Cmt.ml b/lib/Cmt.ml
index 3241008522..0cdbef7019 100644
--- a/lib/Cmt.ml
+++ b/lib/Cmt.ml
@@ -130,7 +130,8 @@ let split_asterisk_prefixed =
   (* Check whether the second line is not empty to avoid matching a comment
      with no asterisks. *)
   | fst_line :: (snd_line :: _ as tl)
-    when lines_are_asterisk_prefixed tl && not (String.is_empty snd_line) ->
+    when lines_are_asterisk_prefixed tl && not (is_all_whitespace snd_line)
+    ->
       Some (fst_line :: List.map tl ~f:drop_prefix)
   | _ -> None
 

From 1ee288d608dc33e2ad3cc8989b5350602ff9a6e1 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Wed, 7 Jun 2023 16:43:30 +0200
Subject: [PATCH 095/115] Don't unindent unwrapped comments

---
 lib/Cmt.ml                                         | 11 ++++-------
 lib/Cmts.ml                                        |  4 ++--
 test/passing/tests/doc_comments-after.ml.err       |  5 ++++-
 test/passing/tests/doc_comments-after.ml.ref       |  8 +++-----
 .../tests/doc_comments-before-except-val.ml.err    |  5 ++++-
 .../tests/doc_comments-before-except-val.ml.ref    |  8 +++-----
 test/passing/tests/doc_comments-before.ml.err      |  5 ++++-
 test/passing/tests/doc_comments-before.ml.ref      |  8 +++-----
 test/passing/tests/doc_comments.ml.err             |  5 ++++-
 test/passing/tests/doc_comments.ml.ref             |  8 +++-----
 test/passing/tests/wrap_comments.ml.ref            | 14 +++++++-------
 11 files changed, 41 insertions(+), 40 deletions(-)

diff --git a/lib/Cmt.ml b/lib/Cmt.ml
index 0cdbef7019..e26bfc73d7 100644
--- a/lib/Cmt.ml
+++ b/lib/Cmt.ml
@@ -117,7 +117,7 @@ let unindent_lines ?max_indent ~content_offset txt =
 let is_all_whitespace s = String.for_all s ~f:Char.is_whitespace
 
 let split_asterisk_prefixed =
-  let prefix = " *" in
+  let prefix = "*" in
   let drop_prefix s = String.drop_prefix s (String.length prefix) in
   let rec lines_are_asterisk_prefixed = function
     | [] -> true
@@ -169,12 +169,9 @@ let decode ~parse_comments_as_doc {txt; loc} =
         mk (Verbatim " ") (* Make sure not to format to [(**)]. *)
     | _ when parse_comments_as_doc -> mk (Doc txt)
     | _ -> (
-        (* Indentation baseline is at the level of the opening to avoid
-           indenting commented code. *)
         let lines =
-          let content_offset = opn_offset + 2
-          and max_indent = opn_offset - 1 in
-          unindent_lines ~max_indent ~content_offset txt
+          let content_offset = opn_offset + 2 in
+          unindent_lines ~content_offset txt
         in
         (* Don't add a space to the prefix if the first line was only
            spaces. *)
@@ -188,7 +185,7 @@ let decode ~parse_comments_as_doc {txt; loc} =
         match split_asterisk_prefixed lines with
         | Some deprefixed_lines ->
             mk ~prefix (Asterisk_prefixed deprefixed_lines)
-        | None -> mk ~prefix (Normal (String.concat ~sep:"\n" lines)) )
+        | None -> mk (Normal txt) )
   else
     match txt with
     (* "(**)" is not parsed as a docstring but as a regular comment
diff --git a/lib/Cmts.ml b/lib/Cmts.ml
index 907a1c6d6c..1c5ed0eed3 100644
--- a/lib/Cmts.ml
+++ b/lib/Cmts.ml
@@ -513,9 +513,9 @@ module Unwrapped = struct
     in
     String.contains ~pos s '\n'
 
-  let fmt_line ~first:_ ~last l =
+  let fmt_line ~first:_ ~last:_ l =
     (* The last line will be followed by the [epi]. *)
-    if is_only_whitespaces l && not last then str "\n" else fmt "@," $ str l
+    str "\n" $ str l
 
   (** [txt] contains trailing spaces and leading/trailing empty lines. *)
   let fmt ~pro ~epi txt =
diff --git a/test/passing/tests/doc_comments-after.ml.err b/test/passing/tests/doc_comments-after.ml.err
index dd738d90f3..71ec524f66 100644
--- a/test/passing/tests/doc_comments-after.ml.err
+++ b/test/passing/tests/doc_comments-after.ml.err
@@ -1 +1,4 @@
-Warning: tests/doc_comments.ml:301 exceeds the margin
+Warning: tests/doc_comments.ml:268 exceeds the margin
+Warning: tests/doc_comments.ml:269 exceeds the margin
+Warning: tests/doc_comments.ml:270 exceeds the margin
+Warning: tests/doc_comments.ml:299 exceeds the margin
diff --git a/test/passing/tests/doc_comments-after.ml.ref b/test/passing/tests/doc_comments-after.ml.ref
index fdacc13e71..ad4ad77c2e 100644
--- a/test/passing/tests/doc_comments-after.ml.ref
+++ b/test/passing/tests/doc_comments-after.ml.ref
@@ -266,11 +266,9 @@ module A = struct
   end
 end
 
-(* Same with get_pure, except that when we have both "x = t" and "y = t"
-   where t is a primed ident, * we add "x = y" to the result. This is crucial
-   for the normalizer, as it tend to drop "x = t" before * processing "y =
-   t". If we don't explicitly preserve "x = y", the normalizer cannot pick it
-   up *)
+(* Same with get_pure, except that when we have both "x = t" and "y = t" where t is a primed ident,
+ * we add "x = y" to the result. This is crucial for the normalizer, as it tend to drop "x = t" before
+ * processing "y = t". If we don't explicitly preserve "x = y", the normalizer cannot pick it up *)
 let _ = ()
 
 (** Tags without text *)
diff --git a/test/passing/tests/doc_comments-before-except-val.ml.err b/test/passing/tests/doc_comments-before-except-val.ml.err
index dd738d90f3..71ec524f66 100644
--- a/test/passing/tests/doc_comments-before-except-val.ml.err
+++ b/test/passing/tests/doc_comments-before-except-val.ml.err
@@ -1 +1,4 @@
-Warning: tests/doc_comments.ml:301 exceeds the margin
+Warning: tests/doc_comments.ml:268 exceeds the margin
+Warning: tests/doc_comments.ml:269 exceeds the margin
+Warning: tests/doc_comments.ml:270 exceeds the margin
+Warning: tests/doc_comments.ml:299 exceeds the margin
diff --git a/test/passing/tests/doc_comments-before-except-val.ml.ref b/test/passing/tests/doc_comments-before-except-val.ml.ref
index 59a6180c19..66cc7751a1 100644
--- a/test/passing/tests/doc_comments-before-except-val.ml.ref
+++ b/test/passing/tests/doc_comments-before-except-val.ml.ref
@@ -266,11 +266,9 @@ module A = struct
   end
 end
 
-(* Same with get_pure, except that when we have both "x = t" and "y = t"
-   where t is a primed ident, * we add "x = y" to the result. This is crucial
-   for the normalizer, as it tend to drop "x = t" before * processing "y =
-   t". If we don't explicitly preserve "x = y", the normalizer cannot pick it
-   up *)
+(* Same with get_pure, except that when we have both "x = t" and "y = t" where t is a primed ident,
+ * we add "x = y" to the result. This is crucial for the normalizer, as it tend to drop "x = t" before
+ * processing "y = t". If we don't explicitly preserve "x = y", the normalizer cannot pick it up *)
 let _ = ()
 
 (** Tags without text *)
diff --git a/test/passing/tests/doc_comments-before.ml.err b/test/passing/tests/doc_comments-before.ml.err
index dd738d90f3..71ec524f66 100644
--- a/test/passing/tests/doc_comments-before.ml.err
+++ b/test/passing/tests/doc_comments-before.ml.err
@@ -1 +1,4 @@
-Warning: tests/doc_comments.ml:301 exceeds the margin
+Warning: tests/doc_comments.ml:268 exceeds the margin
+Warning: tests/doc_comments.ml:269 exceeds the margin
+Warning: tests/doc_comments.ml:270 exceeds the margin
+Warning: tests/doc_comments.ml:299 exceeds the margin
diff --git a/test/passing/tests/doc_comments-before.ml.ref b/test/passing/tests/doc_comments-before.ml.ref
index efa518581f..ae6ef68376 100644
--- a/test/passing/tests/doc_comments-before.ml.ref
+++ b/test/passing/tests/doc_comments-before.ml.ref
@@ -266,11 +266,9 @@ module A = struct
   end
 end
 
-(* Same with get_pure, except that when we have both "x = t" and "y = t"
-   where t is a primed ident, * we add "x = y" to the result. This is crucial
-   for the normalizer, as it tend to drop "x = t" before * processing "y =
-   t". If we don't explicitly preserve "x = y", the normalizer cannot pick it
-   up *)
+(* Same with get_pure, except that when we have both "x = t" and "y = t" where t is a primed ident,
+ * we add "x = y" to the result. This is crucial for the normalizer, as it tend to drop "x = t" before
+ * processing "y = t". If we don't explicitly preserve "x = y", the normalizer cannot pick it up *)
 let _ = ()
 
 (** Tags without text *)
diff --git a/test/passing/tests/doc_comments.ml.err b/test/passing/tests/doc_comments.ml.err
index dd738d90f3..71ec524f66 100644
--- a/test/passing/tests/doc_comments.ml.err
+++ b/test/passing/tests/doc_comments.ml.err
@@ -1 +1,4 @@
-Warning: tests/doc_comments.ml:301 exceeds the margin
+Warning: tests/doc_comments.ml:268 exceeds the margin
+Warning: tests/doc_comments.ml:269 exceeds the margin
+Warning: tests/doc_comments.ml:270 exceeds the margin
+Warning: tests/doc_comments.ml:299 exceeds the margin
diff --git a/test/passing/tests/doc_comments.ml.ref b/test/passing/tests/doc_comments.ml.ref
index 59a6180c19..66cc7751a1 100644
--- a/test/passing/tests/doc_comments.ml.ref
+++ b/test/passing/tests/doc_comments.ml.ref
@@ -266,11 +266,9 @@ module A = struct
   end
 end
 
-(* Same with get_pure, except that when we have both "x = t" and "y = t"
-   where t is a primed ident, * we add "x = y" to the result. This is crucial
-   for the normalizer, as it tend to drop "x = t" before * processing "y =
-   t". If we don't explicitly preserve "x = y", the normalizer cannot pick it
-   up *)
+(* Same with get_pure, except that when we have both "x = t" and "y = t" where t is a primed ident,
+ * we add "x = y" to the result. This is crucial for the normalizer, as it tend to drop "x = t" before
+ * processing "y = t". If we don't explicitly preserve "x = y", the normalizer cannot pick it up *)
 let _ = ()
 
 (** Tags without text *)
diff --git a/test/passing/tests/wrap_comments.ml.ref b/test/passing/tests/wrap_comments.ml.ref
index 896b5e6eaa..20e0897ae9 100644
--- a/test/passing/tests/wrap_comments.ml.ref
+++ b/test/passing/tests/wrap_comments.ml.ref
@@ -109,33 +109,33 @@ let _ =
   [ "a"
   ; "b"
     (* first line
-       second line *)
+     second line *)
   ; "c"
     (* first line
 
-       second line
+     second line
     *)
   ; "d"
     (* first line
 
 
-       second line *)
+     second line *)
   ; "e"
     (* first line
 
-       second line
+     second line
     *)
   ; "f"
     (* first line
 
-       second line
+     second line
     *)
   ; "g" ]
 
 let _ =
   let _ =
     (* This is indented 7
-    This 0 *)
+This 0 *)
     0
   in
   0
@@ -168,7 +168,7 @@ let _ =
   ()
 
 let _ =
-  (*
+  (* 
     blah blah
   *)
   ()

From 09a9638b3b6558ba6ba2f58ef39c16827dc555b2 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Wed, 7 Jun 2023 16:48:38 +0200
Subject: [PATCH 096/115] Fix last line of asterisk prefixed

---
 lib/Cmts.ml                              | 2 +-
 test/passing/tests/comment_header.ml.ref | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/lib/Cmts.ml b/lib/Cmts.ml
index 1c5ed0eed3..c94a1b9855 100644
--- a/lib/Cmts.ml
+++ b/lib/Cmts.ml
@@ -495,7 +495,7 @@ module Asterisk_prefixed = struct
   open Fmt
 
   let fmt_line ~first:_ ~last s =
-    if last && String.is_empty s then fmt "@," else fmt "@,*" $ str s
+    if last && is_only_whitespaces s then fmt "@," else fmt "@,*" $ str s
 
   let fmt ~pro ~epi = function
     | hd :: tl -> vbox 1 (pro $ str hd $ list_fl tl fmt_line $ epi)
diff --git a/test/passing/tests/comment_header.ml.ref b/test/passing/tests/comment_header.ml.ref
index 116c600c55..6940cb8125 100644
--- a/test/passing/tests/comment_header.ml.ref
+++ b/test/passing/tests/comment_header.ml.ref
@@ -55,4 +55,4 @@ type typ = typ
  *
  * The source code of this test is empty: we just check the arguments
  * expansion.
- * *)
+ *)

From b92c62f9069983ff654ce86c33ec5b03ed433002 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Wed, 7 Jun 2023 17:19:13 +0200
Subject: [PATCH 097/115] Make Cmt.t abstract

---
 lib/Cmt.mli                   |  2 +-
 lib/Cmts.ml                   | 62 ++++++++++++++++++++---------------
 lib/Fmt_ast.ml                |  9 ++---
 lib/Normalize_extended_ast.ml |  6 ++--
 lib/Normalize_std_ast.ml      |  6 ++--
 5 files changed, 47 insertions(+), 38 deletions(-)

diff --git a/lib/Cmt.mli b/lib/Cmt.mli
index 92a785e3f1..dcfa3a94c7 100644
--- a/lib/Cmt.mli
+++ b/lib/Cmt.mli
@@ -11,7 +11,7 @@
 
 open Migrate_ast
 
-type t = private {txt: string; loc: Location.t}
+type t
 
 val create : string -> Location.t -> t
 
diff --git a/lib/Cmts.ml b/lib/Cmts.ml
index c94a1b9855..df8ecf525c 100644
--- a/lib/Cmts.ml
+++ b/lib/Cmts.ml
@@ -161,7 +161,7 @@ end = struct
 
   let of_list cmts =
     List.fold cmts ~init:empty ~f:(fun map cmt ->
-        let pos = cmt.Cmt.loc.loc_start in
+        let pos = (Cmt.loc cmt).loc_start in
         Map.add_multi map ~key:pos ~data:cmt )
 
   let to_list map = List.concat (Map.data map)
@@ -188,16 +188,16 @@ end = struct
       | _ -> true
     in
     match to_list cmts with
-    | Cmt.{loc; _} :: _ as cmtl
-      when is_adjacent ~filter:ignore_docstrings src prev loc -> (
+    | cmt :: _ as cmtl
+      when is_adjacent ~filter:ignore_docstrings src prev (Cmt.loc cmt) -> (
       match
         List.group cmtl ~break:(fun l1 l2 ->
             not (is_adjacent src (Cmt.loc l1) (Cmt.loc l2)) )
       with
-      | [cmtl] when is_adjacent src (List.last_exn cmtl).loc next ->
+      | [cmtl] when is_adjacent src (Cmt.loc (List.last_exn cmtl)) next ->
           let open Location in
-          let first_loc = (List.hd_exn cmtl).loc in
-          let last_loc = (List.last_exn cmtl).loc in
+          let first_loc = Cmt.loc (List.hd_exn cmtl) in
+          let last_loc = Cmt.loc (List.last_exn cmtl) in
           let same_line_as_prev l =
             prev.loc_end.pos_lnum = l.loc_start.pos_lnum
           in
@@ -211,7 +211,9 @@ end = struct
             | 0, _ -> `After_prev
             | 1, 1 ->
                 if
-                  Location.compare_start_col (List.last_exn cmtl).loc next
+                  Location.compare_start_col
+                    (Cmt.loc (List.last_exn cmtl))
+                    next
                   <= 0
                 then `Before_next
                 else `After_prev
@@ -229,8 +231,8 @@ end = struct
           let prev, next =
             if not (same_line_as_prev next) then
               let next, prev =
-                List.partition_tf cmtl ~f:(fun {Cmt.loc= l; _} ->
-                    match decide l with
+                List.partition_tf cmtl ~f:(fun cmt ->
+                    match decide (Cmt.loc cmt) with
                     | `After_prev -> false
                     | `Before_next -> true )
               in
@@ -249,10 +251,10 @@ let add_cmts t position loc ?deep_loc cmts =
     let key =
       match deep_loc with
       | Some deep_loc ->
-          let cmt = List.last_exn cmtl in
+          let cmt_loc = Cmt.loc (List.last_exn cmtl) in
           if
-            is_adjacent t.source deep_loc cmt.loc
-            && not (Source.begins_line ~ignore_spaces:true t.source cmt.loc)
+            is_adjacent t.source deep_loc cmt_loc
+            && not (Source.begins_line ~ignore_spaces:true t.source cmt_loc)
           then deep_loc
           else loc
       | None -> loc
@@ -294,8 +296,8 @@ let rec place t loc_tree ?prev_loc ?deep_loc locs cmts =
       | Some prev_loc -> add_cmts t `After prev_loc cmts ?deep_loc
       | None ->
           if t.debug then
-            List.iter (CmtSet.to_list cmts) ~f:(fun {Cmt.txt; _} ->
-                Format_.eprintf "lost: %s@\n%!" txt ) ) ;
+            List.iter (CmtSet.to_list cmts) ~f:(fun cmt ->
+                Format_.eprintf "lost: %s@\n%!" (Cmt.txt cmt) ) ) ;
       deep_loc
 
 (** Relocate comments, for Ast transformations such as sugaring. *)
@@ -321,8 +323,8 @@ let relocate (t : t) ~src ~before ~after =
 
 let relocate_cmts_before (t : t) ~src ~sep ~dst =
   let f map =
-    Multimap.partition_multi map ~src ~dst ~f:(fun Cmt.{loc; _} ->
-        Location.compare_end loc sep < 0 )
+    Multimap.partition_multi map ~src ~dst ~f:(fun cmt ->
+        Location.compare_end (Cmt.loc cmt) sep < 0 )
   in
   update_cmts t `Before ~f ; update_cmts t `Within ~f
 
@@ -446,7 +448,8 @@ let find_cmts ?(filter = Fn.const true) t pos loc =
       update_cmts t pos ~f:(Map.set ~key:loc ~data:not_picked) ;
       picked )
 
-let break_comment_group source {Cmt.loc= a; _} {Cmt.loc= b; _} =
+let break_comment_group source a b =
+  let a = Cmt.loc a and b = Cmt.loc b in
   let vertical_align =
     Location.line_difference a b = 1 && Location.compare_start_col a b = 0
   in
@@ -592,7 +595,7 @@ let fmt_cmt (conf : Conf.t) cmt ~fmt_code (pos : Cmt.pos) =
   let open Fmt in
   let break =
     fmt_if_k
-      (Poly.(pos = After) && String.contains cmt.Cmt.txt '\n')
+      (Poly.(pos = After) && String.contains (Cmt.txt cmt) '\n')
       (break_unless_newline 1000 0)
   in
   let parse_comments_as_doc = conf.fmt_opts.ocp_indent_compat.v in
@@ -605,7 +608,8 @@ let fmt_cmt (conf : Conf.t) cmt ~fmt_code (pos : Cmt.pos) =
   $
   match decoded.kind with
   | Verbatim txt -> Verbatim.fmt ~pro ~epi txt
-  | Doc txt -> Doc.fmt ~pro ~epi ~fmt_code conf ~loc:cmt.loc txt ~offset
+  | Doc txt ->
+      Doc.fmt ~pro ~epi ~fmt_code conf ~loc:(Cmt.loc cmt) txt ~offset
   | Normal txt ->
       if conf.fmt_opts.wrap_comments.v then Wrapped.fmt ~pro ~epi txt
       else Unwrapped.fmt ~pro ~epi txt
@@ -625,9 +629,12 @@ let fmt_cmts_aux t (conf : Conf.t) cmts ~fmt_code pos =
                  wrap "(*" "*)" (str (Cmt.txt cmt)) ) )
          $
          match next with
-         | Some ({loc= next; _} :: _) ->
-             let Cmt.{loc= last; _} = List.last_exn group in
-             fmt_if (Location.line_difference last next > 1) "\n" $ fmt "@ "
+         | Some (next :: _) ->
+             let last = List.last_exn group in
+             fmt_if
+               (Location.line_difference (Cmt.loc last) (Cmt.loc next) > 1)
+               "\n"
+             $ fmt "@ "
          | _ -> noop ) )
 
 (** Format comments for loc. *)
@@ -638,7 +645,7 @@ let fmt_cmts t conf ~fmt_code ?pro ?epi ?(eol = Fmt.fmt "@\n") ?(adj = eol)
   | None | Some [] -> noop
   | Some cmts ->
       let epi =
-        let ({loc= last_loc; _} : Cmt.t) = List.last_exn cmts in
+        let last_loc = Cmt.loc (List.last_exn cmts) in
         let eol_cmt = Source.ends_line t.source last_loc in
         let adj_cmt = eol_cmt && Location.line_difference last_loc loc = 1 in
         fmt_or_k eol_cmt (fmt_or_k adj_cmt adj eol) (fmt_opt epi)
@@ -671,7 +678,8 @@ module Toplevel = struct
     let open Fmt in
     match found with
     | None | Some [] -> noop
-    | Some (({loc= first_loc; _} : Cmt.t) :: _ as cmts) ->
+    | Some (first :: _ as cmts) ->
+        let first_loc = Cmt.loc first in
         let pro =
           match pos with
           | Before -> noop
@@ -683,7 +691,7 @@ module Toplevel = struct
               else break 1 0
         in
         let epi =
-          let ({loc= last_loc; _} : Cmt.t) = List.last_exn cmts in
+          let last_loc = Cmt.loc (List.last_exn cmts) in
           match pos with
           | Before | Within ->
               if Source.ends_line t.source last_loc then
@@ -715,8 +723,8 @@ let drop_inside t loc =
   let clear pos =
     update_cmts t pos
       ~f:
-        (Multimap.filter ~f:(fun {Cmt.loc= cmt_loc; _} ->
-             not (Location.contains loc cmt_loc) ) )
+        (Multimap.filter ~f:(fun cmt ->
+             not (Location.contains loc (Cmt.loc cmt)) ) )
   in
   clear `Before ;
   clear `Within ;
diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 03e7a07707..d6cb1b2264 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -114,8 +114,8 @@ let collection_last_cmt ?pro c (loc : Location.t) locs =
       with
       | [] -> noop
       | (_, semicolon_loc) :: _ ->
-          Cmts.fmt_after ?pro c last ~filter:(fun Cmt.{loc; _} ->
-              Location.compare loc semicolon_loc >= 0 ) )
+          Cmts.fmt_after ?pro c last ~filter:(fun cmt ->
+              Location.compare (Cmt.loc cmt) semicolon_loc >= 0 ) )
 
 let fmt_elements_collection ?pro ?(first_sep = true) ?(last_sep = true) c
     (p : Params.elements_collection) f loc fmt_x xs =
@@ -488,9 +488,10 @@ let sequence_blank_line c (l1 : Location.t) (l2 : Location.t) =
   | `Preserve_one ->
       let rec loop prev_pos = function
         | cmt :: tl ->
+            let loc = Cmt.loc cmt in
             (* Check empty line before each comment *)
-            Source.empty_line_between c.source prev_pos cmt.Cmt.loc.loc_start
-            || loop cmt.Cmt.loc.loc_end tl
+            Source.empty_line_between c.source prev_pos loc.loc_start
+            || loop loc.loc_end tl
         | [] ->
             (* Check empty line after all comments *)
             Source.empty_line_between c.source prev_pos l2.loc_start
diff --git a/lib/Normalize_extended_ast.ml b/lib/Normalize_extended_ast.ml
index 1c0f1e9e47..aca74547f2 100644
--- a/lib/Normalize_extended_ast.ml
+++ b/lib/Normalize_extended_ast.ml
@@ -40,9 +40,9 @@ let dedup_cmts fragment ast comments =
 
 let normalize_comments dedup fmt comments =
   let comments = dedup comments in
-  List.sort comments ~compare:(fun {Cmt.loc= a; _} {Cmt.loc= b; _} ->
-      Migrate_ast.Location.compare a b )
-  |> List.iter ~f:(fun {Cmt.txt; _} -> Format.fprintf fmt "%s," txt)
+  List.sort comments ~compare:(fun a b ->
+      Migrate_ast.Location.compare (Cmt.loc a) (Cmt.loc b) )
+  |> List.iter ~f:(fun cmt -> Format.fprintf fmt "%s," (Cmt.txt cmt))
 
 let normalize_parse_result ast_kind ast comments =
   Format.asprintf "AST,%a,COMMENTS,[%a]" (Printast.ast ast_kind) ast
diff --git a/lib/Normalize_std_ast.ml b/lib/Normalize_std_ast.ml
index ef893190d1..da75cb4224 100644
--- a/lib/Normalize_std_ast.ml
+++ b/lib/Normalize_std_ast.ml
@@ -51,9 +51,9 @@ let normalize_code conf (m : Ast_mapper.mapper) txt =
   | {ast; comments; _} ->
       let comments = dedup_cmts Structure ast comments in
       let print_comments fmt (l : Cmt.t list) =
-        List.sort l ~compare:(fun {Cmt.loc= a; _} {Cmt.loc= b; _} ->
-            Migrate_ast.Location.compare a b )
-        |> List.iter ~f:(fun {Cmt.txt; _} -> Format.fprintf fmt "%s," txt)
+        List.sort l ~compare:(fun a b ->
+            Migrate_ast.Location.compare (Cmt.loc a) (Cmt.loc b) )
+        |> List.iter ~f:(fun cmt -> Format.fprintf fmt "%s," (Cmt.txt cmt))
       in
       let ast = m.structure m ast in
       Format.asprintf "AST,%a,COMMENTS,[%a]" Printast.implementation ast

From 25aa14cf2c14744045ee64333c06ac15711d3f32 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Wed, 7 Jun 2023 17:34:12 +0200
Subject: [PATCH 098/115] Don't mix comments and docstrings

Comments and docstrings no longer have to be differentiated before
formatting. Concatenating "*" to docstrings is no longer necessary.

Some comments starting with `(**` were in fact not docstrings.
---
 lib/Cmt.ml                       | 42 +++++++++++++++++++++++---------
 lib/Cmt.mli                      |  4 ++-
 lib/Normalize_extended_ast.ml    |  2 +-
 lib/Normalize_std_ast.ml         |  4 +--
 lib/Parse_with_comments.ml       |  8 +++---
 vendor/parser-extended/lexer.mll | 15 ++++++------
 6 files changed, 49 insertions(+), 26 deletions(-)

diff --git a/lib/Cmt.ml b/lib/Cmt.ml
index e26bfc73d7..25d47f648b 100644
--- a/lib/Cmt.ml
+++ b/lib/Cmt.ml
@@ -12,21 +12,30 @@
 open Migrate_ast
 
 module T = struct
-  type t = {txt: string; loc: Location.t}
+  type t =
+    | Comment of {txt: string; loc: Location.t}
+    | Docstring of {txt: string; loc: Location.t}
 
-  let loc t = t.loc
+  let loc (Comment {loc; _} | Docstring {loc; _}) = loc
 
-  let txt t = t.txt
+  let txt (Comment {txt; _} | Docstring {txt; _}) = txt
 
-  let create txt loc = {txt; loc}
+  let create_comment txt loc = Comment {txt; loc}
 
-  let compare =
-    Comparable.lexicographic
-      [ Comparable.lift String.compare ~f:txt
-      ; Comparable.lift Location.compare ~f:loc ]
+  let create_docstring txt loc = Docstring {txt; loc}
 
-  let sexp_of_t {txt; loc} =
-    Sexp.Atom (Format.asprintf "%s %a" txt Migrate_ast.Location.fmt loc)
+  let compare = Poly.compare
+
+  let sexp_of_t cmt =
+    let kind, txt, loc =
+      match cmt with
+      | Comment {txt; loc} -> ("comment", txt, loc)
+      | Docstring {txt; loc} -> ("docstring", txt, loc)
+    in
+    Sexp.List
+      [ Sexp.Atom kind
+      ; Sexp.Atom txt
+      ; Sexp.Atom (Format.asprintf "%a" Migrate_ast.Location.fmt loc) ]
 end
 
 include T
@@ -137,7 +146,7 @@ let split_asterisk_prefixed =
 
 let mk ?(prefix = "") ?(suffix = "") kind = {prefix; suffix; kind}
 
-let decode ~parse_comments_as_doc {txt; loc} =
+let decode_comment ~parse_comments_as_doc txt loc =
   let txt =
     (* Windows compatibility *)
     let f = function '\r' -> false | _ -> true in
@@ -164,7 +173,6 @@ let decode ~parse_comments_as_doc {txt; loc} =
         let code = String.concat ~sep:"\n" lines in
         mk ~prefix:"$" ~suffix (Code code)
     | '=' -> mk (Verbatim txt)
-    | '*' -> mk ~prefix:"*" (Doc (String.drop_prefix txt 1))
     | _ when is_all_whitespace txt ->
         mk (Verbatim " ") (* Make sure not to format to [(**)]. *)
     | _ when parse_comments_as_doc -> mk (Doc txt)
@@ -194,3 +202,13 @@ let decode ~parse_comments_as_doc {txt; loc} =
     | ("*" | "$") as txt -> mk (Verbatim txt)
     | "\n" | " " -> mk (Verbatim " ")
     | _ -> mk (Normal txt)
+
+let decode_docstring _loc = function
+  | "" -> mk (Verbatim "")
+  | ("*" | "$") as txt -> mk (Verbatim txt)
+  | "\n" | " " -> mk (Verbatim " ")
+  | txt -> mk ~prefix:"*" (Doc txt)
+
+let decode ~parse_comments_as_doc = function
+  | Comment {txt; loc} -> decode_comment ~parse_comments_as_doc txt loc
+  | Docstring {txt; loc} -> decode_docstring loc txt
diff --git a/lib/Cmt.mli b/lib/Cmt.mli
index dcfa3a94c7..4632f4462f 100644
--- a/lib/Cmt.mli
+++ b/lib/Cmt.mli
@@ -13,7 +13,9 @@ open Migrate_ast
 
 type t
 
-val create : string -> Location.t -> t
+val create_comment : string -> Location.t -> t
+
+val create_docstring : string -> Location.t -> t
 
 val loc : t -> Location.t
 
diff --git a/lib/Normalize_extended_ast.ml b/lib/Normalize_extended_ast.ml
index aca74547f2..9b845cd38e 100644
--- a/lib/Normalize_extended_ast.ml
+++ b/lib/Normalize_extended_ast.ml
@@ -29,7 +29,7 @@ let dedup_cmts fragment ast comments =
                 ; _ } ]
         ; _ }
         when Ast.Attr.is_doc atr ->
-          docs := Set.add !docs (Cmt.create ("*" ^ doc) pexp_loc) ;
+          docs := Set.add !docs (Cmt.create_docstring doc pexp_loc) ;
           atr
       | _ -> Ast_mapper.default_mapper.attribute m atr
     in
diff --git a/lib/Normalize_std_ast.ml b/lib/Normalize_std_ast.ml
index da75cb4224..7651e0d2ec 100644
--- a/lib/Normalize_std_ast.ml
+++ b/lib/Normalize_std_ast.ml
@@ -33,7 +33,7 @@ let dedup_cmts fragment ast comments =
                 ; _ } ]
         ; _ }
         when is_doc atr ->
-          docs := Set.add !docs (Cmt.create ("*" ^ doc) pexp_loc) ;
+          docs := Set.add !docs (Cmt.create_docstring doc pexp_loc) ;
           atr
       | _ -> Ast_mapper.default_mapper.attribute m atr
     in
@@ -206,7 +206,7 @@ let moved_docstrings fragment c s1 s2 =
   let d2 = docstrings fragment s2 in
   let equal (_, x) (_, y) = String.equal (docstring c x) (docstring c y) in
   let cmt_kind = `Doc_comment in
-  let cmt (loc, x) = Cmt.create x loc in
+  let cmt (loc, x) = Cmt.create_docstring x loc in
   let dropped x = {Cmt.kind= `Dropped (cmt x); cmt_kind} in
   let added x = {Cmt.kind= `Added (cmt x); cmt_kind} in
   let modified (x, y) = {Cmt.kind= `Modified (cmt x, cmt y); cmt_kind} in
diff --git a/lib/Parse_with_comments.ml b/lib/Parse_with_comments.ml
index 9bf40cebaf..8003fd72b4 100644
--- a/lib/Parse_with_comments.ml
+++ b/lib/Parse_with_comments.ml
@@ -84,9 +84,11 @@ let parse ?(disable_w50 = false) parse fragment (conf : Conf.t) ~input_name
         let ast = parse fragment ~input_name source in
         Warnings.check_fatal () ;
         let comments =
-          List.map
-            ~f:(fun (txt, loc) -> Cmt.create txt loc)
-            (Lexer.comments ())
+          let mk_cmt = function
+            | `Comment txt, loc -> Cmt.create_comment txt loc
+            | `Docstring txt, loc -> Cmt.create_docstring txt loc
+          in
+          List.map ~f:mk_cmt (Lexer.comments ())
         in
         let tokens =
           let lexbuf, _ = fresh_lexbuf source in
diff --git a/vendor/parser-extended/lexer.mll b/vendor/parser-extended/lexer.mll
index 1a54bf9398..c6713eca47 100644
--- a/vendor/parser-extended/lexer.mll
+++ b/vendor/parser-extended/lexer.mll
@@ -289,17 +289,18 @@ let warn_latin1 lexbuf =
     (Location.curr lexbuf)
     "ISO-Latin1 characters in identifiers"
 
+type comment = [ `Comment of string | `Docstring of string ]
+
 let handle_docstrings = ref true
-let comment_list = ref []
+let comment_list : (comment * _) list ref = ref []
 
-let add_comment com =
-  comment_list := com :: !comment_list
+let add_comment (txt, loc) =
+  comment_list := (`Comment txt, loc) :: !comment_list
 
 let add_docstring_comment ds =
-  let com =
-    ("*" ^ Docstrings.docstring_body ds, Docstrings.docstring_loc ds)
-  in
-    add_comment com
+  let txt = Docstrings.docstring_body ds
+  and loc = Docstrings.docstring_loc ds in
+  comment_list := (`Docstring txt, loc) :: !comment_list
 
 let comments () = List.rev !comment_list
 

From cd00fe6f80f0182839b8fab6a9de28f25293a70c Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Wed, 7 Jun 2023 17:19:13 +0200
Subject: [PATCH 099/115] Make Cmt.t abstract

Preliminary to changing its representation.
---
 lib/Cmt.mli                   |  2 +-
 lib/Cmts.ml                   | 94 +++++++++++++++++++----------------
 lib/Fmt_ast.ml                |  9 ++--
 lib/Normalize_extended_ast.ml | 23 +++++----
 lib/Normalize_std_ast.ml      |  6 +--
 5 files changed, 71 insertions(+), 63 deletions(-)

diff --git a/lib/Cmt.mli b/lib/Cmt.mli
index 59c73e3a15..b2a75e8e08 100644
--- a/lib/Cmt.mli
+++ b/lib/Cmt.mli
@@ -11,7 +11,7 @@
 
 open Migrate_ast
 
-type t = private {txt: string; loc: Location.t}
+type t
 
 val create : string -> Location.t -> t
 
diff --git a/lib/Cmts.ml b/lib/Cmts.ml
index 41d1a5dddd..04a8d24b72 100644
--- a/lib/Cmts.ml
+++ b/lib/Cmts.ml
@@ -161,7 +161,7 @@ end = struct
 
   let of_list cmts =
     List.fold cmts ~init:empty ~f:(fun map cmt ->
-        let pos = cmt.Cmt.loc.loc_start in
+        let pos = (Cmt.loc cmt).loc_start in
         Map.add_multi map ~key:pos ~data:cmt )
 
   let to_list map = List.concat (Map.data map)
@@ -188,16 +188,16 @@ end = struct
       | _ -> true
     in
     match to_list cmts with
-    | Cmt.{loc; _} :: _ as cmtl
-      when is_adjacent ~filter:ignore_docstrings src prev loc -> (
+    | cmt :: _ as cmtl
+      when is_adjacent ~filter:ignore_docstrings src prev (Cmt.loc cmt) -> (
       match
         List.group cmtl ~break:(fun l1 l2 ->
             not (is_adjacent src (Cmt.loc l1) (Cmt.loc l2)) )
       with
-      | [cmtl] when is_adjacent src (List.last_exn cmtl).loc next ->
+      | [cmtl] when is_adjacent src (Cmt.loc (List.last_exn cmtl)) next ->
           let open Location in
-          let first_loc = (List.hd_exn cmtl).loc in
-          let last_loc = (List.last_exn cmtl).loc in
+          let first_loc = Cmt.loc (List.hd_exn cmtl) in
+          let last_loc = Cmt.loc (List.last_exn cmtl) in
           let same_line_as_prev l =
             prev.loc_end.pos_lnum = l.loc_start.pos_lnum
           in
@@ -211,7 +211,9 @@ end = struct
             | 0, _ -> `After_prev
             | 1, 1 ->
                 if
-                  Location.compare_start_col (List.last_exn cmtl).loc next
+                  Location.compare_start_col
+                    (Cmt.loc (List.last_exn cmtl))
+                    next
                   <= 0
                 then `Before_next
                 else `After_prev
@@ -229,8 +231,8 @@ end = struct
           let prev, next =
             if not (same_line_as_prev next) then
               let next, prev =
-                List.partition_tf cmtl ~f:(fun {Cmt.loc= l; _} ->
-                    match decide l with
+                List.partition_tf cmtl ~f:(fun cmt ->
+                    match decide (Cmt.loc cmt) with
                     | `After_prev -> false
                     | `Before_next -> true )
               in
@@ -249,10 +251,10 @@ let add_cmts t position loc ?deep_loc cmts =
     let key =
       match deep_loc with
       | Some deep_loc ->
-          let cmt = List.last_exn cmtl in
+          let cmt_loc = Cmt.loc (List.last_exn cmtl) in
           if
-            is_adjacent t.source deep_loc cmt.loc
-            && not (Source.begins_line ~ignore_spaces:true t.source cmt.loc)
+            is_adjacent t.source deep_loc cmt_loc
+            && not (Source.begins_line ~ignore_spaces:true t.source cmt_loc)
           then deep_loc
           else loc
       | None -> loc
@@ -294,8 +296,8 @@ let rec place t loc_tree ?prev_loc ?deep_loc locs cmts =
       | Some prev_loc -> add_cmts t `After prev_loc cmts ?deep_loc
       | None ->
           if t.debug then
-            List.iter (CmtSet.to_list cmts) ~f:(fun {Cmt.txt; _} ->
-                Format_.eprintf "lost: %s@\n%!" txt ) ) ;
+            List.iter (CmtSet.to_list cmts) ~f:(fun cmt ->
+                Format_.eprintf "lost: %s@\n%!" (Cmt.txt cmt) ) ) ;
       deep_loc
 
 (** Relocate comments, for Ast transformations such as sugaring. *)
@@ -321,8 +323,8 @@ let relocate (t : t) ~src ~before ~after =
 
 let relocate_cmts_before (t : t) ~src ~sep ~dst =
   let f map =
-    Multimap.partition_multi map ~src ~dst ~f:(fun Cmt.{loc; _} ->
-        Location.compare_end loc sep < 0 )
+    Multimap.partition_multi map ~src ~dst ~f:(fun cmt ->
+        Location.compare_end (Cmt.loc cmt) sep < 0 )
   in
   update_cmts t `Before ~f ; update_cmts t `Within ~f
 
@@ -446,7 +448,8 @@ let find_cmts ?(filter = Fn.const true) t pos loc =
       update_cmts t pos ~f:(Map.set ~key:loc ~data:not_picked) ;
       picked )
 
-let break_comment_group source margin {Cmt.loc= a; _} {Cmt.loc= b; _} =
+let break_comment_group source margin a b =
+  let a = Cmt.loc a and b = Cmt.loc b in
   let vertical_align =
     Location.line_difference a b = 1 && Location.compare_start_col a b = 0
   in
@@ -461,7 +464,7 @@ let break_comment_group source margin {Cmt.loc= a; _} {Cmt.loc= b; _} =
     && (vertical_align || horizontal_align) )
 
 module Asterisk_prefixed = struct
-  let split Cmt.{txt; loc= {Location.loc_start; _}} =
+  let split txt {Location.loc_start; _} =
     let len = Position.column loc_start + 3 in
     let pat =
       String.Search_pattern.create
@@ -583,17 +586,18 @@ module Ocp_indent_compat = struct
       @@ doc
 end
 
-let fmt_cmt (conf : Conf.t) (cmt : Cmt.t) ~fmt_code pos =
+let fmt_cmt (conf : Conf.t) cmt ~fmt_code pos =
+  let loc = Cmt.loc cmt in
   let offset =
-    let pos = cmt.loc.Location.loc_start in
+    let pos = loc.Location.loc_start in
     pos.pos_cnum - pos.pos_bol + 2
   in
   let mode =
-    match cmt.txt with
+    match Cmt.txt cmt with
     | "" -> impossible "not produced by parser"
     (* "(**)" is not parsed as a docstring but as a regular comment
        containing '*' and would be rewritten as "(***)" *)
-    | "*" when Location.width cmt.loc = 4 -> `Verbatim ""
+    | "*" when Location.width loc = 4 -> `Verbatim ""
     | "*" -> `Verbatim "*"
     | "$" -> `Verbatim "$"
     (* Qtest pragmas *)
@@ -613,15 +617,14 @@ let fmt_cmt (conf : Conf.t) (cmt : Cmt.t) ~fmt_code pos =
         match fmt_code conf ~offset source with
         | Ok formatted -> `Code (formatted, cls)
         | Error (`Msg _) -> `Unwrapped (str, None) )
-    | str when Char.equal str.[0] '=' -> `Verbatim cmt.txt
-    | _ -> (
+    | txt when Char.equal txt.[0] '=' -> `Verbatim txt
+    | txt -> (
         let txt =
           (* Windows compatibility *)
           let filter = function '\r' -> false | _ -> true in
-          String.filter cmt.txt ~f:filter
+          String.filter txt ~f:filter
         in
-        let cmt = Cmt.create txt cmt.loc in
-        match Asterisk_prefixed.split cmt with
+        match Asterisk_prefixed.split txt loc with
         | [] | [""] -> impossible "not produced by split_asterisk_prefixed"
         (* Comments like [(*\n*)] would be normalized as [(* *)] *)
         | [""; ""] when conf.fmt_opts.ocp_indent_compat.v ->
@@ -640,8 +643,7 @@ let fmt_cmt (conf : Conf.t) (cmt : Cmt.t) ~fmt_code pos =
   | `Code (code, cls) -> Cinaps.fmt ~cls code
   | `Wrapped (x, epi) -> str "(*" $ fill_text x ~epi
   | `Unwrapped (x, ln) when conf.fmt_opts.ocp_indent_compat.v ->
-      Ocp_indent_compat.fmt ~fmt_code conf x ~loc:cmt.loc ~offset pos
-        ~post:ln
+      Ocp_indent_compat.fmt ~fmt_code conf x ~loc ~offset pos ~post:ln
   | `Unwrapped (x, _) -> Unwrapped.fmt ~offset x
   | `Asterisk_prefixed x -> Asterisk_prefixed.fmt x
 
@@ -661,9 +663,12 @@ let fmt_cmts_aux t (conf : Conf.t) cmts ~fmt_code pos =
                  wrap "(*" "*)" (str (Cmt.txt cmt)) ) )
          $
          match next with
-         | Some ({loc= next; _} :: _) ->
-             let Cmt.{loc= last; _} = List.last_exn group in
-             fmt_if (Location.line_difference last next > 1) "\n" $ fmt "@ "
+         | Some (next :: _) ->
+             let last = List.last_exn group in
+             fmt_if
+               (Location.line_difference (Cmt.loc last) (Cmt.loc next) > 1)
+               "\n"
+             $ fmt "@ "
          | _ -> noop ) )
 
 (** Format comments for loc. *)
@@ -674,7 +679,7 @@ let fmt_cmts t conf ~fmt_code ?pro ?epi ?(eol = Fmt.fmt "@\n") ?(adj = eol)
   | None | Some [] -> noop
   | Some cmts ->
       let epi =
-        let ({loc= last_loc; _} : Cmt.t) = List.last_exn cmts in
+        let last_loc = Cmt.loc (List.last_exn cmts) in
         let eol_cmt = Source.ends_line t.source last_loc in
         let adj_cmt = eol_cmt && Location.line_difference last_loc loc = 1 in
         fmt_or_k eol_cmt (fmt_or_k adj_cmt adj eol) (fmt_opt epi)
@@ -707,7 +712,8 @@ module Toplevel = struct
     let open Fmt in
     match found with
     | None | Some [] -> noop
-    | Some (({loc= first_loc; _} : Cmt.t) :: _ as cmts) ->
+    | Some (first :: _ as cmts) ->
+        let first_loc = Cmt.loc first in
         let pro =
           match pos with
           | Before -> noop
@@ -719,7 +725,7 @@ module Toplevel = struct
               else break 1 0
         in
         let epi =
-          let ({loc= last_loc; _} : Cmt.t) = List.last_exn cmts in
+          let last_loc = Cmt.loc (List.last_exn cmts) in
           match pos with
           | Before | Within ->
               if Source.ends_line t.source last_loc then
@@ -751,8 +757,8 @@ let drop_inside t loc =
   let clear pos =
     update_cmts t pos
       ~f:
-        (Multimap.filter ~f:(fun {Cmt.loc= cmt_loc; _} ->
-             not (Location.contains loc cmt_loc) ) )
+        (Multimap.filter ~f:(fun cmt ->
+             not (Location.contains loc (Cmt.loc cmt)) ) )
   in
   clear `Before ;
   clear `Within ;
@@ -780,23 +786,23 @@ let remaining_before t loc = Map.find_multi t.cmts_before loc
 
 let remaining_locs t = Set.to_list t.remaining
 
-let is_docstring (conf : Conf.t) (Cmt.{txt; loc} as cmt) =
-  match txt with
+let is_docstring (conf : Conf.t) cmt =
+  match Cmt.txt cmt with
   | "" | "*" -> Either.Second cmt
-  | _ when Char.equal txt.[0] '*' ->
+  | txt when Char.equal txt.[0] '*' ->
       (* Doc comments here (comming directly from the lexer) include their
          leading star [*]. It is not part of the docstring and should be
          dropped. When [ocp-indent-compat] is set, regular comments are
          treated as doc-comments. *)
       let txt = String.drop_prefix txt 1 in
-      let cmt = Cmt.create txt loc in
+      let cmt = Cmt.create txt (Cmt.loc cmt) in
       if conf.fmt_opts.parse_docstrings.v then Either.First cmt
       else Either.Second cmt
-  | _ when Char.equal txt.[0] '$' -> Either.Second cmt
-  | _
+  | txt when Char.equal txt.[0] '$' -> Either.Second cmt
+  | txt
     when conf.fmt_opts.ocp_indent_compat.v
          && conf.fmt_opts.parse_docstrings.v ->
       (* In ocp_indent_compat mode, comments are parsed like docstrings. *)
-      let cmt = Cmt.create txt loc in
+      let cmt = Cmt.create txt (Cmt.loc cmt) in
       Either.First cmt
   | _ -> Either.Second cmt
diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 03e7a07707..d6cb1b2264 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -114,8 +114,8 @@ let collection_last_cmt ?pro c (loc : Location.t) locs =
       with
       | [] -> noop
       | (_, semicolon_loc) :: _ ->
-          Cmts.fmt_after ?pro c last ~filter:(fun Cmt.{loc; _} ->
-              Location.compare loc semicolon_loc >= 0 ) )
+          Cmts.fmt_after ?pro c last ~filter:(fun cmt ->
+              Location.compare (Cmt.loc cmt) semicolon_loc >= 0 ) )
 
 let fmt_elements_collection ?pro ?(first_sep = true) ?(last_sep = true) c
     (p : Params.elements_collection) f loc fmt_x xs =
@@ -488,9 +488,10 @@ let sequence_blank_line c (l1 : Location.t) (l2 : Location.t) =
   | `Preserve_one ->
       let rec loop prev_pos = function
         | cmt :: tl ->
+            let loc = Cmt.loc cmt in
             (* Check empty line before each comment *)
-            Source.empty_line_between c.source prev_pos cmt.Cmt.loc.loc_start
-            || loop cmt.Cmt.loc.loc_end tl
+            Source.empty_line_between c.source prev_pos loc.loc_start
+            || loop loc.loc_end tl
         | [] ->
             (* Check empty line after all comments *)
             Source.empty_line_between c.source prev_pos l2.loc_start
diff --git a/lib/Normalize_extended_ast.ml b/lib/Normalize_extended_ast.ml
index 9a0e048423..793a5bea21 100644
--- a/lib/Normalize_extended_ast.ml
+++ b/lib/Normalize_extended_ast.ml
@@ -44,9 +44,9 @@ let dedup_cmts fragment ast comments =
 
 let normalize_comments dedup fmt comments =
   let comments = dedup comments in
-  List.sort comments ~compare:(fun {Cmt.loc= a; _} {Cmt.loc= b; _} ->
-      Migrate_ast.Location.compare a b )
-  |> List.iter ~f:(fun {Cmt.txt; _} -> Format.fprintf fmt "%s," txt)
+  List.sort comments ~compare:(fun a b ->
+      Migrate_ast.Location.compare (Cmt.loc a) (Cmt.loc b) )
+  |> List.iter ~f:(fun cmt -> Format.fprintf fmt "%s," (Cmt.txt cmt))
 
 let normalize_parse_result ast_kind ast comments =
   Format.asprintf "AST,%a,COMMENTS,[%a]" (Printast.ast ast_kind) ast
@@ -181,13 +181,13 @@ let diff ~f ~cmt_kind x y =
 
 let diff_docstrings c x y =
   let mapper = make_mapper c ~ignore_doc_comments:false in
-  let docstring {Cmt.txt; loc} =
-    let offset = start_column loc + 3 in
+  let docstring cmt =
+    let offset = start_column (Cmt.loc cmt) + 3 in
     let normalize_code = normalize_code c mapper ~offset in
-    docstring c ~normalize_code txt
+    docstring c ~normalize_code (Cmt.txt cmt)
   in
   let norm z =
-    let f (Cmt.{loc; _} as cmt) = Cmt.create (docstring cmt) loc in
+    let f cmt = Cmt.create (docstring cmt) (Cmt.loc cmt) in
     Set.of_list (module Cmt.Comparator_no_loc) (List.map ~f z)
   in
   diff ~f:norm ~cmt_kind:`Doc_comment x y
@@ -196,8 +196,8 @@ let diff_cmts (conf : Conf.t) x y =
   let mapper = make_mapper conf ~ignore_doc_comments:false in
   let normalize_code = normalize_code conf mapper in
   let norm z =
-    let norm_non_code {Cmt.txt; loc} =
-      Cmt.create (Docstring.normalize_text txt) loc
+    let norm_non_code cmt =
+      Cmt.create (Docstring.normalize_text (Cmt.txt cmt)) (Cmt.loc cmt)
     in
     let f z =
       match Cmt.txt z with
@@ -209,8 +209,9 @@ let diff_cmts (conf : Conf.t) x y =
             in
             let len = String.length str - chars_removed in
             let source = String.sub ~pos:1 ~len str in
-            let offset = start_column z.loc + 3 in
-            Cmt.create (normalize_code ~offset source) z.loc
+            let loc = Cmt.loc z in
+            let offset = start_column loc + 3 in
+            Cmt.create (normalize_code ~offset source) loc
           else norm_non_code z
     in
     Set.of_list (module Cmt.Comparator_no_loc) (List.map ~f z)
diff --git a/lib/Normalize_std_ast.ml b/lib/Normalize_std_ast.ml
index ef893190d1..da75cb4224 100644
--- a/lib/Normalize_std_ast.ml
+++ b/lib/Normalize_std_ast.ml
@@ -51,9 +51,9 @@ let normalize_code conf (m : Ast_mapper.mapper) txt =
   | {ast; comments; _} ->
       let comments = dedup_cmts Structure ast comments in
       let print_comments fmt (l : Cmt.t list) =
-        List.sort l ~compare:(fun {Cmt.loc= a; _} {Cmt.loc= b; _} ->
-            Migrate_ast.Location.compare a b )
-        |> List.iter ~f:(fun {Cmt.txt; _} -> Format.fprintf fmt "%s," txt)
+        List.sort l ~compare:(fun a b ->
+            Migrate_ast.Location.compare (Cmt.loc a) (Cmt.loc b) )
+        |> List.iter ~f:(fun cmt -> Format.fprintf fmt "%s," (Cmt.txt cmt))
       in
       let ast = m.structure m ast in
       Format.asprintf "AST,%a,COMMENTS,[%a]" Printast.implementation ast

From ef208e95ca7739c7715d9de1f461eefbedeeae28 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Wed, 7 Jun 2023 17:34:12 +0200
Subject: [PATCH 100/115] Don't mix comments and docstrings

Comments and docstrings no longer have to be differentiated before
formatting. Concatenating "*" to docstrings is no longer necessary.

Some comments starting with `(**` were in fact not docstrings.
What is a docstring is now dictated by the lexer, which removes this
kind of bug.
---
 lib/Cmt.ml                       | 31 ++++++++++------
 lib/Cmt.mli                      |  6 +++-
 lib/Cmts.ml                      | 61 ++++++++++++++------------------
 lib/Normalize_extended_ast.ml    | 10 +++---
 lib/Normalize_std_ast.ml         |  4 +--
 lib/Parse_with_comments.ml       |  8 +++--
 vendor/parser-extended/lexer.mll | 15 ++++----
 7 files changed, 74 insertions(+), 61 deletions(-)

diff --git a/lib/Cmt.ml b/lib/Cmt.ml
index 2c550c33e0..af090f517d 100644
--- a/lib/Cmt.ml
+++ b/lib/Cmt.ml
@@ -12,21 +12,32 @@
 open Migrate_ast
 
 module T = struct
-  type t = {txt: string; loc: Location.t}
+  type t =
+    | Comment of {txt: string; loc: Location.t}
+    | Docstring of {txt: string; loc: Location.t}
 
-  let loc t = t.loc
+  let loc (Comment {loc; _} | Docstring {loc; _}) = loc
 
-  let txt t = t.txt
+  let txt (Comment {txt; _} | Docstring {txt; _}) = txt
 
-  let create txt loc = {txt; loc}
+  let create_comment txt loc = Comment {txt; loc}
 
-  let compare =
-    Comparable.lexicographic
-      [ Comparable.lift String.compare ~f:txt
-      ; Comparable.lift Location.compare ~f:loc ]
+  let create_docstring txt loc = Docstring {txt; loc}
+
+  let is_docstring = function Comment _ -> false | Docstring _ -> true
+
+  let compare = Poly.compare
 
-  let sexp_of_t {txt; loc} =
-    Sexp.Atom (Format.asprintf "%s %a" txt Migrate_ast.Location.fmt loc)
+  let sexp_of_t cmt =
+    let kind, txt, loc =
+      match cmt with
+      | Comment {txt; loc} -> ("comment", txt, loc)
+      | Docstring {txt; loc} -> ("docstring", txt, loc)
+    in
+    Sexp.List
+      [ Sexp.Atom kind
+      ; Sexp.Atom txt
+      ; Sexp.Atom (Format.asprintf "%a" Migrate_ast.Location.fmt loc) ]
 end
 
 include T
diff --git a/lib/Cmt.mli b/lib/Cmt.mli
index b2a75e8e08..8782f265b0 100644
--- a/lib/Cmt.mli
+++ b/lib/Cmt.mli
@@ -13,7 +13,11 @@ open Migrate_ast
 
 type t
 
-val create : string -> Location.t -> t
+val create_comment : string -> Location.t -> t
+
+val create_docstring : string -> Location.t -> t
+
+val is_docstring : t -> bool
 
 val loc : t -> Location.t
 
diff --git a/lib/Cmts.ml b/lib/Cmts.ml
index 04a8d24b72..1c104e2609 100644
--- a/lib/Cmts.ml
+++ b/lib/Cmts.ml
@@ -489,10 +489,10 @@ module Asterisk_prefixed = struct
     in
     split_ 0
 
-  let fmt lines =
+  let fmt ~opn lines =
     let open Fmt in
     vbox 1
-      ( fmt "(*"
+      ( opn
       $ list_fl lines (fun ~first:_ ~last line ->
             match line with
             | "" when last -> fmt ")"
@@ -513,7 +513,7 @@ module Unwrapped = struct
     in
     vbox 0 ~name:"multiline" (list_fl unindented fmt_line $ fmt_opt epi)
 
-  let fmt ~offset s =
+  let fmt ~opn ~offset s =
     let open Fmt in
     let is_sp = function ' ' | '\t' -> true | _ -> false in
     match String.split_lines (String.rstrip s) with
@@ -529,9 +529,8 @@ module Unwrapped = struct
         in
         (* Preserve the first level of indentation *)
         let starts_with_sp = is_sp first_line.[0] in
-        wrap "(*" "*)"
-        @@ fmt_multiline_cmt ~offset ~epi ~starts_with_sp lines
-    | _ -> wrap "(*" "*)" @@ str s
+        opn $ fmt_multiline_cmt ~offset ~epi ~starts_with_sp lines $ str "*)"
+    | _ -> opn $ str s $ str "*)"
 end
 
 module Verbatim = struct
@@ -561,7 +560,7 @@ module Cinaps = struct
 end
 
 module Ocp_indent_compat = struct
-  let fmt ~fmt_code conf txt ~loc ~offset (pos : Cmt.pos) ~post =
+  let fmt ~fmt_code conf txt ~loc ~offset ~opn (pos : Cmt.pos) ~post =
     let pre, doc, post =
       let lines = String.split_lines txt in
       match lines with
@@ -581,9 +580,9 @@ module Ocp_indent_compat = struct
     fmt_if_k
       (Poly.(pos = After) && String.contains txt '\n')
       (break_unless_newline 1000 0)
-    $ wrap "(*" "*)"
-      @@ wrap_k (fmt_if pre "@;<1000 3>") (fmt_if post "@\n")
-      @@ doc
+    $ opn
+    $ wrap_k (fmt_if pre "@;<1000 3>") (fmt_if post "@\n") doc
+    $ str "*)"
 end
 
 let fmt_cmt (conf : Conf.t) cmt ~fmt_code pos =
@@ -594,7 +593,7 @@ let fmt_cmt (conf : Conf.t) cmt ~fmt_code pos =
   in
   let mode =
     match Cmt.txt cmt with
-    | "" -> impossible "not produced by parser"
+    | "" -> `Verbatim ""
     (* "(**)" is not parsed as a docstring but as a regular comment
        containing '*' and would be rewritten as "(***)" *)
     | "*" when Location.width loc = 4 -> `Verbatim ""
@@ -638,14 +637,15 @@ let fmt_cmt (conf : Conf.t) cmt ~fmt_code pos =
         | lines -> `Asterisk_prefixed lines )
   in
   let open Fmt in
+  let opn = if Cmt.is_docstring cmt then str "(**" else str "(*" in
   match mode with
   | `Verbatim x -> Verbatim.fmt x pos
   | `Code (code, cls) -> Cinaps.fmt ~cls code
-  | `Wrapped (x, epi) -> str "(*" $ fill_text x ~epi
+  | `Wrapped (x, epi) -> opn $ fill_text x ~epi
   | `Unwrapped (x, ln) when conf.fmt_opts.ocp_indent_compat.v ->
-      Ocp_indent_compat.fmt ~fmt_code conf x ~loc ~offset pos ~post:ln
-  | `Unwrapped (x, _) -> Unwrapped.fmt ~offset x
-  | `Asterisk_prefixed x -> Asterisk_prefixed.fmt x
+      Ocp_indent_compat.fmt ~fmt_code conf x ~loc ~offset ~opn pos ~post:ln
+  | `Unwrapped (x, _) -> Unwrapped.fmt ~opn ~offset x
+  | `Asterisk_prefixed x -> Asterisk_prefixed.fmt ~opn x
 
 let fmt_cmts_aux t (conf : Conf.t) cmts ~fmt_code pos =
   let open Fmt in
@@ -787,22 +787,15 @@ let remaining_before t loc = Map.find_multi t.cmts_before loc
 let remaining_locs t = Set.to_list t.remaining
 
 let is_docstring (conf : Conf.t) cmt =
-  match Cmt.txt cmt with
-  | "" | "*" -> Either.Second cmt
-  | txt when Char.equal txt.[0] '*' ->
-      (* Doc comments here (comming directly from the lexer) include their
-         leading star [*]. It is not part of the docstring and should be
-         dropped. When [ocp-indent-compat] is set, regular comments are
-         treated as doc-comments. *)
-      let txt = String.drop_prefix txt 1 in
-      let cmt = Cmt.create txt (Cmt.loc cmt) in
-      if conf.fmt_opts.parse_docstrings.v then Either.First cmt
-      else Either.Second cmt
-  | txt when Char.equal txt.[0] '$' -> Either.Second cmt
-  | txt
-    when conf.fmt_opts.ocp_indent_compat.v
-         && conf.fmt_opts.parse_docstrings.v ->
-      (* In ocp_indent_compat mode, comments are parsed like docstrings. *)
-      let cmt = Cmt.create txt (Cmt.loc cmt) in
-      Either.First cmt
-  | _ -> Either.Second cmt
+  let might_be_docstring cmt =
+    match Cmt.txt cmt with
+    | "" | "*" -> false
+    | txt -> not (Char.equal txt.[0] '$')
+  in
+  (* In ocp_indent_compat mode, comments are parsed like docstrings. *)
+  if
+    conf.fmt_opts.parse_docstrings.v
+    && ( Cmt.is_docstring cmt
+       || (conf.fmt_opts.ocp_indent_compat.v && might_be_docstring cmt) )
+  then Either.First cmt
+  else Either.Second cmt
diff --git a/lib/Normalize_extended_ast.ml b/lib/Normalize_extended_ast.ml
index 793a5bea21..99f74d03a8 100644
--- a/lib/Normalize_extended_ast.ml
+++ b/lib/Normalize_extended_ast.ml
@@ -33,7 +33,7 @@ let dedup_cmts fragment ast comments =
                 ; _ } ]
         ; _ }
         when Ast.Attr.is_doc atr ->
-          docs := Set.add !docs (Cmt.create ("*" ^ doc) pexp_loc) ;
+          docs := Set.add !docs (Cmt.create_docstring doc pexp_loc) ;
           atr
       | _ -> Ast_mapper.default_mapper.attribute m atr
     in
@@ -187,7 +187,7 @@ let diff_docstrings c x y =
     docstring c ~normalize_code (Cmt.txt cmt)
   in
   let norm z =
-    let f cmt = Cmt.create (docstring cmt) (Cmt.loc cmt) in
+    let f cmt = Cmt.create_docstring (docstring cmt) (Cmt.loc cmt) in
     Set.of_list (module Cmt.Comparator_no_loc) (List.map ~f z)
   in
   diff ~f:norm ~cmt_kind:`Doc_comment x y
@@ -197,7 +197,9 @@ let diff_cmts (conf : Conf.t) x y =
   let normalize_code = normalize_code conf mapper in
   let norm z =
     let norm_non_code cmt =
-      Cmt.create (Docstring.normalize_text (Cmt.txt cmt)) (Cmt.loc cmt)
+      Cmt.create_comment
+        (Docstring.normalize_text (Cmt.txt cmt))
+        (Cmt.loc cmt)
     in
     let f z =
       match Cmt.txt z with
@@ -211,7 +213,7 @@ let diff_cmts (conf : Conf.t) x y =
             let source = String.sub ~pos:1 ~len str in
             let loc = Cmt.loc z in
             let offset = start_column loc + 3 in
-            Cmt.create (normalize_code ~offset source) loc
+            Cmt.create_comment (normalize_code ~offset source) loc
           else norm_non_code z
     in
     Set.of_list (module Cmt.Comparator_no_loc) (List.map ~f z)
diff --git a/lib/Normalize_std_ast.ml b/lib/Normalize_std_ast.ml
index da75cb4224..7651e0d2ec 100644
--- a/lib/Normalize_std_ast.ml
+++ b/lib/Normalize_std_ast.ml
@@ -33,7 +33,7 @@ let dedup_cmts fragment ast comments =
                 ; _ } ]
         ; _ }
         when is_doc atr ->
-          docs := Set.add !docs (Cmt.create ("*" ^ doc) pexp_loc) ;
+          docs := Set.add !docs (Cmt.create_docstring doc pexp_loc) ;
           atr
       | _ -> Ast_mapper.default_mapper.attribute m atr
     in
@@ -206,7 +206,7 @@ let moved_docstrings fragment c s1 s2 =
   let d2 = docstrings fragment s2 in
   let equal (_, x) (_, y) = String.equal (docstring c x) (docstring c y) in
   let cmt_kind = `Doc_comment in
-  let cmt (loc, x) = Cmt.create x loc in
+  let cmt (loc, x) = Cmt.create_docstring x loc in
   let dropped x = {Cmt.kind= `Dropped (cmt x); cmt_kind} in
   let added x = {Cmt.kind= `Added (cmt x); cmt_kind} in
   let modified (x, y) = {Cmt.kind= `Modified (cmt x, cmt y); cmt_kind} in
diff --git a/lib/Parse_with_comments.ml b/lib/Parse_with_comments.ml
index 9bf40cebaf..8003fd72b4 100644
--- a/lib/Parse_with_comments.ml
+++ b/lib/Parse_with_comments.ml
@@ -84,9 +84,11 @@ let parse ?(disable_w50 = false) parse fragment (conf : Conf.t) ~input_name
         let ast = parse fragment ~input_name source in
         Warnings.check_fatal () ;
         let comments =
-          List.map
-            ~f:(fun (txt, loc) -> Cmt.create txt loc)
-            (Lexer.comments ())
+          let mk_cmt = function
+            | `Comment txt, loc -> Cmt.create_comment txt loc
+            | `Docstring txt, loc -> Cmt.create_docstring txt loc
+          in
+          List.map ~f:mk_cmt (Lexer.comments ())
         in
         let tokens =
           let lexbuf, _ = fresh_lexbuf source in
diff --git a/vendor/parser-extended/lexer.mll b/vendor/parser-extended/lexer.mll
index 1a54bf9398..c6713eca47 100644
--- a/vendor/parser-extended/lexer.mll
+++ b/vendor/parser-extended/lexer.mll
@@ -289,17 +289,18 @@ let warn_latin1 lexbuf =
     (Location.curr lexbuf)
     "ISO-Latin1 characters in identifiers"
 
+type comment = [ `Comment of string | `Docstring of string ]
+
 let handle_docstrings = ref true
-let comment_list = ref []
+let comment_list : (comment * _) list ref = ref []
 
-let add_comment com =
-  comment_list := com :: !comment_list
+let add_comment (txt, loc) =
+  comment_list := (`Comment txt, loc) :: !comment_list
 
 let add_docstring_comment ds =
-  let com =
-    ("*" ^ Docstrings.docstring_body ds, Docstrings.docstring_loc ds)
-  in
-    add_comment com
+  let txt = Docstrings.docstring_body ds
+  and loc = Docstrings.docstring_loc ds in
+  comment_list := (`Docstring txt, loc) :: !comment_list
 
 let comments () = List.rev !comment_list
 

From c37b6adf0c8ae1debf9bfa97b2a33016164d2eca Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Fri, 9 Jun 2023 19:22:19 +0200
Subject: [PATCH 101/115] Normalize comments inside comments

---
 lib/Normalize_extended_ast.ml       | 79 ++++++++++++++++-------------
 test/passing/tests/js_source.ml     |  5 ++
 test/passing/tests/js_source.ml.ocp |  2 +
 test/passing/tests/js_source.ml.ref |  2 +
 4 files changed, 54 insertions(+), 34 deletions(-)

diff --git a/lib/Normalize_extended_ast.ml b/lib/Normalize_extended_ast.ml
index 9b845cd38e..3355c7670e 100644
--- a/lib/Normalize_extended_ast.ml
+++ b/lib/Normalize_extended_ast.ml
@@ -38,26 +38,27 @@ let dedup_cmts fragment ast comments =
   in
   Set.(to_list (diff (of_list (module Cmt) comments) (of_ast ast)))
 
-let normalize_comments dedup fmt comments =
-  let comments = dedup comments in
-  List.sort comments ~compare:(fun a b ->
-      Migrate_ast.Location.compare (Cmt.loc a) (Cmt.loc b) )
-  |> List.iter ~f:(fun cmt -> Format.fprintf fmt "%s," (Cmt.txt cmt))
+let normalize_comments ~normalize_cmt dedup fmt comments =
+  dedup comments
+  |> List.sort ~compare:(fun a b ->
+         Migrate_ast.Location.compare (Cmt.loc a) (Cmt.loc b) )
+  |> List.iter ~f:(fun cmt -> Format.fprintf fmt "%s," (normalize_cmt cmt))
 
-let normalize_parse_result ast_kind ast comments =
+let normalize_parse_result ~normalize_cmt ast_kind ast comments =
   Format.asprintf "AST,%a,COMMENTS,[%a]" (Printast.ast ast_kind) ast
-    (normalize_comments (dedup_cmts ast_kind ast))
+    (normalize_comments ~normalize_cmt (dedup_cmts ast_kind ast))
     comments
 
-let normalize_code conf (m : Ast_mapper.mapper) txt =
+let normalize_code ~normalize_cmt conf (m : Ast_mapper.mapper) txt =
   let input_name = "<output>" in
+  let normalize_cmt = normalize_cmt conf in
   match Parse_with_comments.parse_toplevel conf ~input_name ~source:txt with
   | First {ast; comments; _} ->
-      normalize_parse_result Use_file
+      normalize_parse_result ~normalize_cmt Use_file
         (List.map ~f:(m.toplevel_phrase m) ast)
         comments
   | Second {ast; comments; _} ->
-      normalize_parse_result Repl_file
+      normalize_parse_result ~normalize_cmt Repl_file
         (List.map ~f:(m.repl_phrase m) ast)
         comments
   | exception _ -> txt
@@ -68,7 +69,7 @@ let docstring (c : Conf.t) =
 let sort_attributes : attributes -> attributes =
   List.sort ~compare:Poly.compare
 
-let make_mapper conf ~ignore_doc_comments =
+let make_mapper ~ignore_doc_comments ~normalize_doc =
   let open Ast_helper in
   (* remove locations *)
   let location _ _ = Location.none in
@@ -86,8 +87,7 @@ let make_mapper conf ~ignore_doc_comments =
                   , [] )
             ; _ } as pstr ) ]
       when Ast.Attr.is_doc attr ->
-        let normalize_code = normalize_code conf m in
-        let doc' = docstring conf ~normalize_code doc in
+        let doc' = normalize_doc doc in
         Ast_mapper.default_mapper.attribute m
           { attr with
             attr_payload=
@@ -151,8 +151,33 @@ let make_mapper conf ~ignore_doc_comments =
   ; expr
   ; typ }
 
+let normalize_cmt (conf : Conf.t) =
+  let parse_comments_as_doc = conf.fmt_opts.ocp_indent_compat.v in
+  object (self)
+    method cmt c =
+      let decoded = Cmt.decode ~parse_comments_as_doc c in
+      match decoded.Cmt.kind with
+      | Verbatim txt -> txt
+      | Doc txt -> self#doc txt
+      | Normal txt -> Docstring.normalize_text txt
+      | Code txt -> self#code txt
+      | Asterisk_prefixed lines ->
+          String.concat ~sep:" " (List.map ~f:Docstring.normalize_text lines)
+
+    method doc d = docstring conf ~normalize_code:self#code d
+
+    method code c =
+      let mapper =
+        make_mapper ~ignore_doc_comments:false ~normalize_doc:self#doc
+      in
+      let normalize_cmt _conf cmt = self#cmt cmt in
+      normalize_code ~normalize_cmt conf mapper c
+  end
+
 let ast fragment ~ignore_doc_comments c =
-  map fragment (make_mapper c ~ignore_doc_comments)
+  let normalize_cmt = normalize_cmt c in
+  map fragment
+    (make_mapper ~ignore_doc_comments ~normalize_doc:normalize_cmt#doc)
 
 module Normalized_cmt = struct
   type t =
@@ -162,19 +187,11 @@ module Normalized_cmt = struct
 
   let compare a b = Poly.compare (a.cmt_kind, a.norm) (b.cmt_kind, b.norm)
 
-  let of_cmt ~parse_comments_as_doc ~normalize_code ~normalize_doc orig =
-    let cmt_kind, norm =
-      let decoded = Cmt.decode ~parse_comments_as_doc orig in
-      match decoded.Cmt.kind with
-      | Verbatim txt -> (`Comment, txt)
-      | Doc txt -> (`Doc_comment, normalize_doc txt)
-      | Normal txt -> (`Comment, Docstring.normalize_text txt)
-      | Code code -> (`Comment, normalize_code code)
-      | Asterisk_prefixed lines ->
-          ( `Comment
-          , String.concat ~sep:" "
-              (List.map ~f:Docstring.normalize_text lines) )
+  let of_cmt normalize_cmt orig =
+    let cmt_kind =
+      if Cmt.is_docstring orig then `Doc_comment else `Comment
     in
+    let norm = normalize_cmt orig in
     {cmt_kind; norm; orig}
 
   let dropped {cmt_kind; orig; _} = {Cmt.kind= `Dropped orig; cmt_kind}
@@ -209,15 +226,9 @@ let diff ~f x y =
   |> function [] -> Ok () | errors -> Error errors
 
 let diff_cmts (conf : Conf.t) x y =
-  let parse_comments_as_doc = conf.fmt_opts.ocp_indent_compat.v in
-  let mapper = make_mapper conf ~ignore_doc_comments:false in
-  let normalize_code = normalize_code conf mapper in
-  let normalize_doc = docstring conf ~normalize_code in
+  let normalize = normalize_cmt conf in
   let f z =
-    let f =
-      Normalized_cmt.of_cmt ~parse_comments_as_doc ~normalize_code
-        ~normalize_doc
-    in
+    let f = Normalized_cmt.of_cmt normalize#cmt in
     Set.of_list (module Normalized_cmt.Comparator) (List.map ~f z)
   in
   diff ~f x y
diff --git a/test/passing/tests/js_source.ml b/test/passing/tests/js_source.ml
index 938d810946..0125098254 100644
--- a/test/passing/tests/js_source.ml
+++ b/test/passing/tests/js_source.ml
@@ -7953,3 +7953,8 @@ let _ =
 ;;
 
 (* *)
+
+(*$
+  (* 
+     *)
+  *)
diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp
index 9264822829..bf1188586c 100644
--- a/test/passing/tests/js_source.ml.ocp
+++ b/test/passing/tests/js_source.ml.ocp
@@ -10189,3 +10189,5 @@ let _ =
 ;;
 
 (* *)
+
+(*$ (* *) *)
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index 58ed460503..76f246bfb1 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -10189,3 +10189,5 @@ let _ =
 ;;
 
 (* *)
+
+(*$ (* *) *)

From 8a4e1cfc634b51764e6496fe3b1ad28f462c9ac4 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Mon, 12 Jun 2023 14:04:41 +0200
Subject: [PATCH 102/115] Add #2372 to changelog

---
 CHANGES.md | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/CHANGES.md b/CHANGES.md
index 774f3bb475..cb839b89b9 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -8,7 +8,7 @@
 
 ### Bug fixes
 
-- Consistent formatting of comments (#2371, @Julow)
+- Consistent formatting of comments (#2371, #2372, @Julow)
 - Fix crash due to `module T = (val (x : (module S)))` (#2370, @Julow)
 - Fix invalid formatting of `then begin end` (#2369, @Julow)
 - Protect match after `fun _ : _ ->` (#2352, @Julow)

From 674b07ce4ebda56781e21508736f7a10ac893f70 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Thu, 22 Jun 2023 18:21:48 +0200
Subject: [PATCH 103/115] Preserve blank lines in docstrings

We were always adding empty lines before and after paragraphs, even when
they are not necessary.

Empty lines are now added only when necessary or if they are present in
the original source file.
---
 lib/Cmts.ml                                   | 14 ++--
 lib/Fmt_ast.ml                                | 10 ++-
 lib/Fmt_odoc.ml                               | 68 +++++++++++++------
 lib/Fmt_odoc.mli                              | 10 ++-
 lib/Source.ml                                 |  2 +
 lib/Source.mli                                |  2 +
 test/passing/tests/doc.mld.ref                |  2 -
 .../tests/doc_comments-no-wrap.mli.err        | 34 +++++-----
 .../tests/doc_comments-no-wrap.mli.ref        | 37 ++++++++--
 test/passing/tests/doc_comments.mli.err       | 34 +++++-----
 test/passing/tests/doc_comments.mli.ref       | 37 ++++++++--
 test/passing/tests/doc_repl.mld.ref           |  1 -
 test/passing/tests/invalid_docstrings.mli.ref |  1 -
 test/passing/tests/js_source.ml.err           |  2 +-
 test/passing/tests/js_source.ml.ocp           |  2 -
 test/passing/tests/js_source.ml.ref           |  2 -
 test/passing/tests/repl.mli.ref               | 15 ----
 17 files changed, 178 insertions(+), 95 deletions(-)

diff --git a/lib/Cmts.ml b/lib/Cmts.ml
index 1c104e2609..f65755c522 100644
--- a/lib/Cmts.ml
+++ b/lib/Cmts.ml
@@ -560,7 +560,8 @@ module Cinaps = struct
 end
 
 module Ocp_indent_compat = struct
-  let fmt ~fmt_code conf txt ~loc ~offset ~opn (pos : Cmt.pos) ~post =
+  let fmt ~source ~fmt_code conf txt ~loc ~offset ~opn (pos : Cmt.pos) ~post
+      =
     let pre, doc, post =
       let lines = String.split_lines txt in
       match lines with
@@ -575,7 +576,9 @@ module Ocp_indent_compat = struct
     (* Disable warnings when parsing fails *)
     let quiet = Conf_t.Elt.make true `Default in
     let conf = {conf with Conf.opr_opts= {conf.Conf.opr_opts with quiet}} in
-    let doc = Fmt_odoc.fmt_parsed conf ~fmt_code ~input:doc ~offset parsed in
+    let doc =
+      Fmt_odoc.fmt_parsed ~source conf ~fmt_code ~input:doc ~offset parsed
+    in
     let open Fmt in
     fmt_if_k
       (Poly.(pos = After) && String.contains txt '\n')
@@ -585,7 +588,7 @@ module Ocp_indent_compat = struct
     $ str "*)"
 end
 
-let fmt_cmt (conf : Conf.t) cmt ~fmt_code pos =
+let fmt_cmt ~source (conf : Conf.t) cmt ~fmt_code pos =
   let loc = Cmt.loc cmt in
   let offset =
     let pos = loc.Location.loc_start in
@@ -643,7 +646,8 @@ let fmt_cmt (conf : Conf.t) cmt ~fmt_code pos =
   | `Code (code, cls) -> Cinaps.fmt ~cls code
   | `Wrapped (x, epi) -> opn $ fill_text x ~epi
   | `Unwrapped (x, ln) when conf.fmt_opts.ocp_indent_compat.v ->
-      Ocp_indent_compat.fmt ~fmt_code conf x ~loc ~offset ~opn pos ~post:ln
+      Ocp_indent_compat.fmt ~source ~fmt_code conf x ~loc ~offset ~opn pos
+        ~post:ln
   | `Unwrapped (x, _) -> Unwrapped.fmt ~opn ~offset x
   | `Asterisk_prefixed x -> Asterisk_prefixed.fmt ~opn x
 
@@ -657,7 +661,7 @@ let fmt_cmts_aux t (conf : Conf.t) cmts ~fmt_code pos =
     (list_pn groups (fun ~prev:_ group ~next ->
          ( match group with
          | [] -> impossible "previous match"
-         | [cmt] -> fmt_cmt conf cmt ~fmt_code pos
+         | [cmt] -> fmt_cmt ~source:t.source conf cmt ~fmt_code pos
          | group ->
              list group "@;<1000 0>" (fun cmt ->
                  wrap "(*" "*)" (str (Cmt.txt cmt)) ) )
diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 0c345da787..4fd334c697 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -385,7 +385,10 @@ let fmt_parsed_docstring c ~loc ?pro ~epi input parsed =
     let pos = loc.Location.loc_start in
     pos.pos_cnum - pos.pos_bol + 3
   and fmt_code = c.fmt_code in
-  let doc = Fmt_odoc.fmt_parsed c.conf ~fmt_code ~offset ~input parsed in
+  let doc =
+    Fmt_odoc.fmt_parsed ~source:c.source c.conf ~fmt_code ~offset ~input
+      parsed
+  in
   Cmts.fmt c loc
   @@ vbox_if (Option.is_none pro) 0 (fmt_opt pro $ wrap "(**" "*)" doc $ epi)
 
@@ -4478,7 +4481,10 @@ let fmt_file (type a) ~ctx ~fmt_code ~debug (fragment : a Extended_ast.t)
   | Expression, e ->
       fmt_expression c (sub_exp ~ctx:(Str (Ast_helper.Str.eval e)) e)
   | Repl_file, l -> fmt_repl_file c ctx l
-  | Documentation, d -> Fmt_odoc.fmt_ast c.conf ~fmt_code:c.fmt_code d
+  | Documentation, d ->
+      (* TODO: [source] and [cmts] should have never been computed when
+         formatting doc. *)
+      Fmt_odoc.fmt_ast ~source c.conf ~fmt_code:c.fmt_code d
 
 let fmt_parse_result conf ~debug ast_kind ast source comments ~fmt_code =
   let cmts = Cmts.init ast_kind ~debug source ast comments in
diff --git a/lib/Fmt_odoc.ml b/lib/Fmt_odoc.ml
index 6c17f2d971..74bfbc8cdb 100644
--- a/lib/Fmt_odoc.ml
+++ b/lib/Fmt_odoc.ml
@@ -13,9 +13,22 @@ open Fmt
 open Odoc_parser.Ast
 module Loc = Odoc_parser.Loc
 
+(** Odoc locations are represented as line/column and don't work well with
+    the [Source] module. Additionally [Source] functions operate on tokens
+    and cannot see the content of doc comments. *)
+module Doc_source = struct
+  type t = {src: string array}
+
+  let of_source src =
+    let src = Array.of_list (String.split_lines (Source.text src)) in
+    {src}
+
+  let is_line_empty t l = String.for_all t.src.(l - 1) ~f:Char.is_whitespace
+end
+
 type fmt_code = Conf.t -> offset:int -> string -> string or_error
 
-type c = {fmt_code: fmt_code; conf: Conf.t}
+type c = {fmt_code: fmt_code; conf: Conf.t; source: Doc_source.t}
 
 (** Escape characters if they are not already escaped. [escapeworthy] should
     be [true] if the character should be escaped, [false] otherwise. *)
@@ -164,27 +177,35 @@ let list_should_use_heavy_syntax items =
   in
   List.exists items ~f:heavy_nestable_block_elements
 
-(* Decide if should break between two elements *)
-let block_element_should_break elem next =
+(* Decide if a blank line should be added between two elements *)
+let block_element_should_blank elem next =
   match (elem, next) with
-  (* Mandatory breaks *)
-  | `List (_, _, _), _ | `Paragraph _, `Paragraph _ -> true
-  (* Arbitrary breaks *)
-  | (`Paragraph _ | `Heading _), _ | _, (`Paragraph _ | `Heading _) -> true
+  | `Tag _, `Tag _ -> false
+  (* Mandatory blanks lines. *)
+  | (`List _ | `Tag _), _ | `Paragraph _, `Paragraph _ -> true
   | _, _ -> false
 
+let should_preserve_blank c (a : Loc.span) (b : Loc.span) =
+  let rec loop a b =
+    if a >= b then false
+    else Doc_source.is_line_empty c.source a || loop (a + 1) b
+  in
+  loop (a.end_.line + 1) b.start.line
+
 (* Format a list of block_elements separated by newlines Inserts blank line
-   depending on [block_element_should_break] *)
-let list_block_elem elems f =
+   depending on [block_element_should_blank] *)
+let list_block_elem c elems f =
   list_pn elems (fun ~prev:_ elem ~next ->
       let break =
         match next with
-        | Some {Loc.value= n; _}
-          when block_element_should_break
-                 (elem.value :> block_element)
-                 (n :> block_element) ->
-            fmt "\n@\n"
-        | Some _ -> fmt "@\n"
+        | Some n ->
+            if
+              block_element_should_blank
+                (elem.Loc.value :> block_element)
+                (n.value :> block_element)
+              || should_preserve_blank c elem.location n.location
+            then fmt "\n@\n"
+            else fmt "@\n"
         | None -> noop
       in
       f elem $ break )
@@ -281,7 +302,7 @@ and fmt_list_light c kind items =
   vbox 0 (list items "@," fmt_item)
 
 and fmt_nestable_block_elements c elems =
-  list_block_elem elems (fmt_nestable_block_element c)
+  list_block_elem c elems (fmt_nestable_block_element c)
 
 let at = char '@'
 
@@ -331,20 +352,25 @@ let fmt_block_element c elm =
   | #nestable_block_element as value ->
       hovbox 0 (fmt_nestable_block_element c {elm with value})
 
-let fmt_ast conf ~fmt_code (docs : t) =
-  let c = {fmt_code; conf} in
-  vbox 0 (list_block_elem docs (fmt_block_element c))
+let fmt_ast ~source conf ~fmt_code (docs : t) =
+  (* We cannot use the content of the comment as source because the locations
+     in the AST are based on the absolute position in the whole source
+     file. *)
+  let source = Doc_source.of_source source in
+  let c = {fmt_code; conf; source} in
+  vbox 0 (list_block_elem c docs (fmt_block_element c))
 
-let fmt_parsed (conf : Conf.t) ~fmt_code ~input ~offset parsed =
+let fmt_parsed (conf : Conf.t) ~fmt_code ~source ~input ~offset parsed =
   let open Fmt in
   let begin_space = String.starts_with_whitespace input in
+  (* The offset is used to adjust the margin when formatting code blocks. *)
   let offset = offset + if begin_space then 1 else 0 in
   let fmt_code conf ~offset:offset' input =
     fmt_code conf ~offset:(offset + offset') input
   in
   let fmt_parsed parsed =
     fmt_if begin_space " "
-    $ fmt_ast conf ~fmt_code parsed
+    $ fmt_ast ~source conf ~fmt_code parsed
     $ fmt_if
         (String.length input > 1 && String.ends_with_whitespace input)
         " "
diff --git a/lib/Fmt_odoc.mli b/lib/Fmt_odoc.mli
index 0f1d561e87..8f66066d1f 100644
--- a/lib/Fmt_odoc.mli
+++ b/lib/Fmt_odoc.mli
@@ -13,12 +13,20 @@
     used to adjust the margin. *)
 type fmt_code = Conf.t -> offset:int -> string -> string or_error
 
-val fmt_ast : Conf.t -> fmt_code:fmt_code -> Odoc_parser.Ast.t -> Fmt.t
+val fmt_ast :
+     source:Source.t
+  -> Conf.t
+  -> fmt_code:fmt_code
+  -> Odoc_parser.Ast.t
+  -> Fmt.t
 
 val fmt_parsed :
      Conf.t
   -> fmt_code:fmt_code
+  -> source:Source.t
   -> input:string
   -> offset:int
   -> (Odoc_parser.Ast.t, Odoc_parser.Warning.t list) Result.t
   -> Fmt.t
+(** [source] is the global source in which the locations in the AST make
+    sense. [input] is the content of the doc-comment. *)
diff --git a/lib/Source.ml b/lib/Source.ml
index bb234a292d..9a0592c0fc 100644
--- a/lib/Source.ml
+++ b/lib/Source.ml
@@ -15,6 +15,8 @@ open Extended_ast
 (** Concrete syntax. *)
 type t = {text: string; tokens: (Parser.token * Location.t) array}
 
+let text t = t.text
+
 let create ~text ~tokens =
   let tokens =
     List.filter tokens ~f:(fun (tok, _) ->
diff --git a/lib/Source.mli b/lib/Source.mli
index 4d7217040c..71f3333053 100644
--- a/lib/Source.mli
+++ b/lib/Source.mli
@@ -15,6 +15,8 @@ type t
 
 val create : text:string -> tokens:(Parser.token * Location.t) list -> t
 
+val text : t -> string
+
 val empty_line_between : t -> Lexing.position -> Lexing.position -> bool
 (** [empty_line_between t p1 p2] is [true] if there is an empty line between
     [p1] and [p2]. The lines containing [p1] and [p2] are not considered
diff --git a/test/passing/tests/doc.mld.ref b/test/passing/tests/doc.mld.ref
index 98ebe4d631..496caa257e 100644
--- a/test/passing/tests/doc.mld.ref
+++ b/test/passing/tests/doc.mld.ref
@@ -1,5 +1,4 @@
 {0 Parent/Child Specification}
-
 This parent/child specification allows more flexible output support, e.g.,
 per library documentation. See
 {{:https://v3.ocaml.org/packages} v3.ocaml.org/packages}.
@@ -102,7 +101,6 @@ The output of the [odoc link] command is an [.odocl] file, by default, in the
 same path as the original [.odoc] file.
 
 {2 Generating HTML}
-
 {v
 $ odoc html-generate --indent -o html page-john.odocl
   && odoc html-generate --indent -o html page-doe.odocl
diff --git a/test/passing/tests/doc_comments-no-wrap.mli.err b/test/passing/tests/doc_comments-no-wrap.mli.err
index 4a5e772c1d..49df9d7f4b 100644
--- a/test/passing/tests/doc_comments-no-wrap.mli.err
+++ b/test/passing/tests/doc_comments-no-wrap.mli.err
@@ -1,20 +1,20 @@
 Warning: tests/doc_comments.mli:10 exceeds the margin
-Warning: tests/doc_comments.mli:78 exceeds the margin
-Warning: tests/doc_comments.mli:80 exceeds the margin
-Warning: tests/doc_comments.mli:82 exceeds the margin
-Warning: tests/doc_comments.mli:85 exceeds the margin
+Warning: tests/doc_comments.mli:79 exceeds the margin
+Warning: tests/doc_comments.mli:83 exceeds the margin
 Warning: tests/doc_comments.mli:87 exceeds the margin
+Warning: tests/doc_comments.mli:92 exceeds the margin
 Warning: tests/doc_comments.mli:96 exceeds the margin
-Warning: tests/doc_comments.mli:99 exceeds the margin
-Warning: tests/doc_comments.mli:104 exceeds the margin
-Warning: tests/doc_comments.mli:309 exceeds the margin
-Warning: tests/doc_comments.mli:355 exceeds the margin
-Warning: tests/doc_comments.mli:362 exceeds the margin
-Warning: tests/doc_comments.mli:427 exceeds the margin
-Warning: tests/doc_comments.mli:440 exceeds the margin
-Warning: tests/doc_comments.mli:497 exceeds the margin
-Warning: tests/doc_comments.mli:527 exceeds the margin
-Warning: tests/doc_comments.mli:597 exceeds the margin
-Warning: tests/doc_comments.mli:599 exceeds the margin
-Warning: tests/doc_comments.mli:616 exceeds the margin
-Warning: tests/doc_comments.mli:628 exceeds the margin
+Warning: tests/doc_comments.mli:110 exceeds the margin
+Warning: tests/doc_comments.mli:115 exceeds the margin
+Warning: tests/doc_comments.mli:124 exceeds the margin
+Warning: tests/doc_comments.mli:328 exceeds the margin
+Warning: tests/doc_comments.mli:377 exceeds the margin
+Warning: tests/doc_comments.mli:384 exceeds the margin
+Warning: tests/doc_comments.mli:451 exceeds the margin
+Warning: tests/doc_comments.mli:465 exceeds the margin
+Warning: tests/doc_comments.mli:522 exceeds the margin
+Warning: tests/doc_comments.mli:552 exceeds the margin
+Warning: tests/doc_comments.mli:622 exceeds the margin
+Warning: tests/doc_comments.mli:624 exceeds the margin
+Warning: tests/doc_comments.mli:645 exceeds the margin
+Warning: tests/doc_comments.mli:658 exceeds the margin
diff --git a/test/passing/tests/doc_comments-no-wrap.mli.ref b/test/passing/tests/doc_comments-no-wrap.mli.ref
index fdd25b053d..bf0cfed150 100644
--- a/test/passing/tests/doc_comments-no-wrap.mli.ref
+++ b/test/passing/tests/doc_comments-no-wrap.mli.ref
@@ -76,32 +76,52 @@ val k : k
 (** this is a comment
 
     @author foo
+
     @author Foooooooooooooooooooooooooooooooooooo Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar
+
     @version foo
+
     @version Foooooooooooooooooooooooooooooooooooo Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar
+
     @see <foo> foo
+
     @see <https://slash-create.js.org/#/docs/main/latest/class/SlashCreator?scrollTo=registerCommandsIn>
       this url is very long
+
     @since foo
+
     @since Foooooooooooooooooooooooooooooooooooo.Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar
+
     @before foo [foo]
+
     @before Foooooooooooooooooooooooooooooooooooo.Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar
       Foo bar
+
     @deprecated [foo]
+
     @deprecated
       Foooooooooooooooooooooooooooooooooooo
       Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar Foo bar
+
     @param foo [foo]
+
     @param Foooooooooooooo_Baaaaaaaaaaaaar
       Fooooooooooo foooooooooooo fooooooooooo baaaaaaaaar
+
     @param Foooooooooooooooooooooooooooooooooooo_baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar
       Foo bar
+
     @raise foo [foo]
+
     @raise Foooooooooooooooooooooooooooooooooooo_baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar
       Foo bar
+
     @return [foo]
+
     @inline
+
     @canonical foo
+
     @canonical Foooooooooooooooooooooooooooooooooooo.Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar *)
 
 val x : x
@@ -293,7 +313,6 @@ a
       ]} *)
 
 (** Code block
-
     {[
       Single line
     ]}
@@ -349,8 +368,11 @@ end
     {!field:f} {!field:t.f} {!field:M.t.f} *)
 
 (** {!modules:Foo}
+
     {!modules:Foo Bar.Baz}
+
     @canonical Foo
+
     @canonical Foo.Bar *)
 
 (** {%html:<p>Raw markup</p>%} {%Without language%} {%other:Other language%} *)
@@ -400,6 +422,7 @@ end
 (** {[
       let this = is_short
     ]}
+
     {[
         does not parse: verbatim
       +/+/+ /+/+/ +/+//+/+/+/+/+/+/+/
@@ -407,6 +430,7 @@ end
       +/+/+ /+/+/ +/+//+/+/+/+/+/+/+/
       +/+/+ /+/+/ +/+//+/+
     ]}
+
     {[
       [@@@ocamlformat "break-separators = after"]
 
@@ -415,6 +439,7 @@ end
           foooooooooooooooooooooooooooooooo;
           foooooooooooooooooooooooooooooooo ]
     ]}
+
     {[
       let fooooooooooooooooo =
         [ foooooooooooooooooooooooooooooooo
@@ -423,20 +448,20 @@ end
     ]} *)
 
 (** This is a comment with code inside
-
     {[
       (** This is a comment with code inside [ let code inside = f inside ] *)
       let code inside (* comment   *) = f inside
     ]}
 
     Code block with metadata:
-
     {@ocaml[
       code
     ]}
+
     {@ocaml kind=toplevel[
       code
     ]}
+
     {@ocaml kind=toplevel env=e1[
       (** This is a comment with code inside [ let code inside = f inside ] *)
       let code inside (* comment   *) = f inside
@@ -602,8 +627,11 @@ type x =
     Block math:
 
     {math \infty}
+
     {math \infty}
+
     {math \pi}
+
     {math
       \infty
 
@@ -613,9 +641,11 @@ type x =
 
       \pi
     }
+
     {math
       {m \f\relax{x} = \int_{-\infty}^\infty \f\hat\xi\,e^{2 \pi i \xi x} \,d\xi}
     }
+
     {math
       % \f is defined as #1f(#2) using the macro
       \f\relax{x} = \int_{-\infty}^\infty
@@ -632,7 +662,6 @@ type x =
     ]} *)
 
 (** ISO-Latin1 characters in identifiers
-
     {[
       ω
     ]}*)
diff --git a/test/passing/tests/doc_comments.mli.err b/test/passing/tests/doc_comments.mli.err
index 2c02b0f18c..db9ce31256 100644
--- a/test/passing/tests/doc_comments.mli.err
+++ b/test/passing/tests/doc_comments.mli.err
@@ -1,20 +1,20 @@
 Warning: tests/doc_comments.mli:10 exceeds the margin
-Warning: tests/doc_comments.mli:78 exceeds the margin
-Warning: tests/doc_comments.mli:80 exceeds the margin
-Warning: tests/doc_comments.mli:82 exceeds the margin
-Warning: tests/doc_comments.mli:85 exceeds the margin
+Warning: tests/doc_comments.mli:79 exceeds the margin
+Warning: tests/doc_comments.mli:83 exceeds the margin
 Warning: tests/doc_comments.mli:87 exceeds the margin
+Warning: tests/doc_comments.mli:92 exceeds the margin
 Warning: tests/doc_comments.mli:96 exceeds the margin
-Warning: tests/doc_comments.mli:99 exceeds the margin
-Warning: tests/doc_comments.mli:104 exceeds the margin
-Warning: tests/doc_comments.mli:309 exceeds the margin
-Warning: tests/doc_comments.mli:355 exceeds the margin
-Warning: tests/doc_comments.mli:362 exceeds the margin
-Warning: tests/doc_comments.mli:427 exceeds the margin
-Warning: tests/doc_comments.mli:440 exceeds the margin
-Warning: tests/doc_comments.mli:497 exceeds the margin
-Warning: tests/doc_comments.mli:527 exceeds the margin
-Warning: tests/doc_comments.mli:591 exceeds the margin
-Warning: tests/doc_comments.mli:593 exceeds the margin
-Warning: tests/doc_comments.mli:610 exceeds the margin
-Warning: tests/doc_comments.mli:622 exceeds the margin
+Warning: tests/doc_comments.mli:110 exceeds the margin
+Warning: tests/doc_comments.mli:115 exceeds the margin
+Warning: tests/doc_comments.mli:124 exceeds the margin
+Warning: tests/doc_comments.mli:328 exceeds the margin
+Warning: tests/doc_comments.mli:377 exceeds the margin
+Warning: tests/doc_comments.mli:384 exceeds the margin
+Warning: tests/doc_comments.mli:451 exceeds the margin
+Warning: tests/doc_comments.mli:465 exceeds the margin
+Warning: tests/doc_comments.mli:522 exceeds the margin
+Warning: tests/doc_comments.mli:552 exceeds the margin
+Warning: tests/doc_comments.mli:616 exceeds the margin
+Warning: tests/doc_comments.mli:618 exceeds the margin
+Warning: tests/doc_comments.mli:639 exceeds the margin
+Warning: tests/doc_comments.mli:652 exceeds the margin
diff --git a/test/passing/tests/doc_comments.mli.ref b/test/passing/tests/doc_comments.mli.ref
index b651f07de6..04cdb10d17 100644
--- a/test/passing/tests/doc_comments.mli.ref
+++ b/test/passing/tests/doc_comments.mli.ref
@@ -76,32 +76,52 @@ val k : k
 (** this is a comment
 
     @author foo
+
     @author Foooooooooooooooooooooooooooooooooooo Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar
+
     @version foo
+
     @version Foooooooooooooooooooooooooooooooooooo Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar
+
     @see <foo> foo
+
     @see <https://slash-create.js.org/#/docs/main/latest/class/SlashCreator?scrollTo=registerCommandsIn>
       this url is very long
+
     @since foo
+
     @since Foooooooooooooooooooooooooooooooooooo.Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar
+
     @before foo [foo]
+
     @before Foooooooooooooooooooooooooooooooooooo.Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar
       Foo bar
+
     @deprecated [foo]
+
     @deprecated
       Foooooooooooooooooooooooooooooooooooo
       Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar Foo bar
+
     @param foo [foo]
+
     @param Foooooooooooooo_Baaaaaaaaaaaaar
       Fooooooooooo foooooooooooo fooooooooooo baaaaaaaaar
+
     @param Foooooooooooooooooooooooooooooooooooo_baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar
       Foo bar
+
     @raise foo [foo]
+
     @raise Foooooooooooooooooooooooooooooooooooo_baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar
       Foo bar
+
     @return [foo]
+
     @inline
+
     @canonical foo
+
     @canonical Foooooooooooooooooooooooooooooooooooo.Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar *)
 
 val x : x
@@ -293,7 +313,6 @@ a
       ]} *)
 
 (** Code block
-
     {[
       Single line
     ]}
@@ -349,8 +368,11 @@ end
     {!field:f} {!field:t.f} {!field:M.t.f} *)
 
 (** {!modules:Foo}
+
     {!modules:Foo Bar.Baz}
+
     @canonical Foo
+
     @canonical Foo.Bar *)
 
 (** {%html:<p>Raw markup</p>%} {%Without language%} {%other:Other language%} *)
@@ -400,6 +422,7 @@ end
 (** {[
       let this = is_short
     ]}
+
     {[
         does not parse: verbatim
       +/+/+ /+/+/ +/+//+/+/+/+/+/+/+/
@@ -407,6 +430,7 @@ end
       +/+/+ /+/+/ +/+//+/+/+/+/+/+/+/
       +/+/+ /+/+/ +/+//+/+
     ]}
+
     {[
       [@@@ocamlformat "break-separators = after"]
 
@@ -415,6 +439,7 @@ end
           foooooooooooooooooooooooooooooooo;
           foooooooooooooooooooooooooooooooo ]
     ]}
+
     {[
       let fooooooooooooooooo =
         [ foooooooooooooooooooooooooooooooo
@@ -423,20 +448,20 @@ end
     ]} *)
 
 (** This is a comment with code inside
-
     {[
       (** This is a comment with code inside [ let code inside = f inside ] *)
       let code inside (* comment *) = f inside
     ]}
 
     Code block with metadata:
-
     {@ocaml[
       code
     ]}
+
     {@ocaml kind=toplevel[
       code
     ]}
+
     {@ocaml kind=toplevel env=e1[
       (** This is a comment with code inside [ let code inside = f inside ] *)
       let code inside (* comment *) = f inside
@@ -596,8 +621,11 @@ type x =
     Block math:
 
     {math \infty}
+
     {math \infty}
+
     {math \pi}
+
     {math
       \infty
 
@@ -607,9 +635,11 @@ type x =
 
       \pi
     }
+
     {math
       {m \f\relax{x} = \int_{-\infty}^\infty \f\hat\xi\,e^{2 \pi i \xi x} \,d\xi}
     }
+
     {math
       % \f is defined as #1f(#2) using the macro
       \f\relax{x} = \int_{-\infty}^\infty
@@ -626,7 +656,6 @@ type x =
     ]} *)
 
 (** ISO-Latin1 characters in identifiers
-
     {[
       ω
     ]}*)
diff --git a/test/passing/tests/doc_repl.mld.ref b/test/passing/tests/doc_repl.mld.ref
index 9aee8d67be..cf705ea36a 100644
--- a/test/passing/tests/doc_repl.mld.ref
+++ b/test/passing/tests/doc_repl.mld.ref
@@ -77,7 +77,6 @@ Linebreak after `#`:
 ]}
 
 Invalid toplevel phrase/ocaml block:
-
 {[
   - : int =
    4
diff --git a/test/passing/tests/invalid_docstrings.mli.ref b/test/passing/tests/invalid_docstrings.mli.ref
index 611cb39584..accc12530d 100644
--- a/test/passing/tests/invalid_docstrings.mli.ref
+++ b/test/passing/tests/invalid_docstrings.mli.ref
@@ -1,6 +1,5 @@
 val x : y
 (** Blablabla. Otherwise, the given protocol can not be:
-
     - registered into {!resolvers}
     - used as a service with {!serve_with_handler]/{!serve}
 
diff --git a/test/passing/tests/js_source.ml.err b/test/passing/tests/js_source.ml.err
index 9ba7830b7d..0e73dc9f96 100644
--- a/test/passing/tests/js_source.ml.err
+++ b/test/passing/tests/js_source.ml.err
@@ -4,4 +4,4 @@ Warning: tests/js_source.ml:9522 exceeds the margin
 Warning: tests/js_source.ml:9625 exceeds the margin
 Warning: tests/js_source.ml:9644 exceeds the margin
 Warning: tests/js_source.ml:9684 exceeds the margin
-Warning: tests/js_source.ml:9768 exceeds the margin
+Warning: tests/js_source.ml:9766 exceeds the margin
diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp
index 613b954f1b..3e8103d72c 100644
--- a/test/passing/tests/js_source.ml.ocp
+++ b/test/passing/tests/js_source.ml.ocp
@@ -9697,7 +9697,6 @@ type t =
 type t =
   { field : ty
   (* Here is some verbatim formatted text:
-
      {v
        starting at column 7
          v}*)
@@ -9706,7 +9705,6 @@ type t =
 module Intro_sort = struct
   let foo_fooo_foooo fooo ~foooo m1 m2 m3 m4 m5 =
     (* Fooooooooooooooooooooooooooo:
-
        {v
           1--o-----o-----o--------------1
              |     |     |
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index c4fef9a79b..6af1654eec 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -9697,7 +9697,6 @@ type t =
 type t =
   { field : ty
       (* Here is some verbatim formatted text:
-
          {v
        starting at column 7
          v}*)
@@ -9706,7 +9705,6 @@ type t =
 module Intro_sort = struct
   let foo_fooo_foooo fooo ~foooo m1 m2 m3 m4 m5 =
     (* Fooooooooooooooooooooooooooo:
-
        {v
           1--o-----o-----o--------------1
              |     |     |
diff --git a/test/passing/tests/repl.mli.ref b/test/passing/tests/repl.mli.ref
index c978e51a22..1c27c1d576 100644
--- a/test/passing/tests/repl.mli.ref
+++ b/test/passing/tests/repl.mli.ref
@@ -1,40 +1,34 @@
 (** VALID BLOCKS:
 
     Block delimiters should be on their own line:
-
     {[
       let x = 1
     ]}
 
     As of odoc 2.1, a block can carry metadata:
-
     {@ocaml[
       let x = 2
     ]}
 
     An OCaml block that should break:
-
     {[
       let x = 2 in
       x + x
     ]}
 
     A toplevel phrase with no output:
-
     {[
       # let x = 2 and y = 3 in
         x + y ;;
     ]}
 
     A toplevel phrase with output:
-
     {@ocaml[
       # let x = 2;;
       val x : int = 2
     ]}
 
     Many toplevel phrases without output:
-
     {[
       # let x = 2 ;;
       # x + 2 ;;
@@ -43,7 +37,6 @@
     ]}
 
     Many toplevel phrases with output:
-
     {[
       # let x = 2 ;;
       val x : int = 2
@@ -54,7 +47,6 @@
     ]}
 
     Output are printed after a newline:
-
     {[
       # let x = 2;; val x : int = 2
       # let x = 3;;
@@ -62,7 +54,6 @@
     ]}
 
     Excessive linebreaks are removed:
-
     {[
       # let x = 2 in
         x + 1 ;;
@@ -72,7 +63,6 @@
     ]}
 
     Linebreak after `#`:
-
     {[
       # let x = 2 in
         x + 1 ;;
@@ -82,34 +72,29 @@ type t = k
 (** INVALID BLOCKS: The formatting of invalid blocks is preserved.
 
     Invalid toplevel phrase/ocaml block:
-
     {[
       - : int =
        4
     ]}
 
     Output before a toplevel phrase:
-
     {[
       - : int = 4
       # 2+2;;
     ]}
 
     No `;;` at the end of the phrase, no output:
-
     {[
       # let x = 2 in x+1
     ]}
 
     No `;;` at the end of the phrase, with output:
-
     {[
       # let x = 2 in x+1
       some output
     ]}
 
     Multiple phrases without `;;` at the end:
-
     {[
       # let x = 2 in x+1
       # let x = 4 in x+1

From 61ab7d0833b2d2862da152303466333932e31da9 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Thu, 22 Jun 2023 18:30:51 +0200
Subject: [PATCH 104/115] Update CHANGES

---
 CHANGES.md | 1 +
 1 file changed, 1 insertion(+)

diff --git a/CHANGES.md b/CHANGES.md
index 31a0ea2f8b..0cb641cb89 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -27,6 +27,7 @@
 
 ### Changes
 
+- Preserve empty lines in doc-comments (#2379, @Julow)
 - Escape less in doc-comments when possible (#2376, #2377, @Julow)
 - Disable reporting of deprecated alerts while formatting code blocks (#2373, @Julow)
 - Improve indentation of `as`-patterns (#2359, @Julow)

From 4a542d81bc094b543eca7bdb8161dd944e58564e Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Thu, 22 Jun 2023 19:03:40 +0200
Subject: [PATCH 105/115] Do not rely on the original source code

Instead, compare the location to find out whether two elements are
separated by an empty line.
---
 lib/Cmts.ml      | 14 +++++---------
 lib/Fmt_ast.ml   |  7 ++-----
 lib/Fmt_odoc.ml  | 36 ++++++++----------------------------
 lib/Fmt_odoc.mli |  8 +-------
 4 files changed, 16 insertions(+), 49 deletions(-)

diff --git a/lib/Cmts.ml b/lib/Cmts.ml
index f65755c522..1c104e2609 100644
--- a/lib/Cmts.ml
+++ b/lib/Cmts.ml
@@ -560,8 +560,7 @@ module Cinaps = struct
 end
 
 module Ocp_indent_compat = struct
-  let fmt ~source ~fmt_code conf txt ~loc ~offset ~opn (pos : Cmt.pos) ~post
-      =
+  let fmt ~fmt_code conf txt ~loc ~offset ~opn (pos : Cmt.pos) ~post =
     let pre, doc, post =
       let lines = String.split_lines txt in
       match lines with
@@ -576,9 +575,7 @@ module Ocp_indent_compat = struct
     (* Disable warnings when parsing fails *)
     let quiet = Conf_t.Elt.make true `Default in
     let conf = {conf with Conf.opr_opts= {conf.Conf.opr_opts with quiet}} in
-    let doc =
-      Fmt_odoc.fmt_parsed ~source conf ~fmt_code ~input:doc ~offset parsed
-    in
+    let doc = Fmt_odoc.fmt_parsed conf ~fmt_code ~input:doc ~offset parsed in
     let open Fmt in
     fmt_if_k
       (Poly.(pos = After) && String.contains txt '\n')
@@ -588,7 +585,7 @@ module Ocp_indent_compat = struct
     $ str "*)"
 end
 
-let fmt_cmt ~source (conf : Conf.t) cmt ~fmt_code pos =
+let fmt_cmt (conf : Conf.t) cmt ~fmt_code pos =
   let loc = Cmt.loc cmt in
   let offset =
     let pos = loc.Location.loc_start in
@@ -646,8 +643,7 @@ let fmt_cmt ~source (conf : Conf.t) cmt ~fmt_code pos =
   | `Code (code, cls) -> Cinaps.fmt ~cls code
   | `Wrapped (x, epi) -> opn $ fill_text x ~epi
   | `Unwrapped (x, ln) when conf.fmt_opts.ocp_indent_compat.v ->
-      Ocp_indent_compat.fmt ~source ~fmt_code conf x ~loc ~offset ~opn pos
-        ~post:ln
+      Ocp_indent_compat.fmt ~fmt_code conf x ~loc ~offset ~opn pos ~post:ln
   | `Unwrapped (x, _) -> Unwrapped.fmt ~opn ~offset x
   | `Asterisk_prefixed x -> Asterisk_prefixed.fmt ~opn x
 
@@ -661,7 +657,7 @@ let fmt_cmts_aux t (conf : Conf.t) cmts ~fmt_code pos =
     (list_pn groups (fun ~prev:_ group ~next ->
          ( match group with
          | [] -> impossible "previous match"
-         | [cmt] -> fmt_cmt ~source:t.source conf cmt ~fmt_code pos
+         | [cmt] -> fmt_cmt conf cmt ~fmt_code pos
          | group ->
              list group "@;<1000 0>" (fun cmt ->
                  wrap "(*" "*)" (str (Cmt.txt cmt)) ) )
diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 4fd334c697..e54dd52d00 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -385,10 +385,7 @@ let fmt_parsed_docstring c ~loc ?pro ~epi input parsed =
     let pos = loc.Location.loc_start in
     pos.pos_cnum - pos.pos_bol + 3
   and fmt_code = c.fmt_code in
-  let doc =
-    Fmt_odoc.fmt_parsed ~source:c.source c.conf ~fmt_code ~offset ~input
-      parsed
-  in
+  let doc = Fmt_odoc.fmt_parsed c.conf ~fmt_code ~offset ~input parsed in
   Cmts.fmt c loc
   @@ vbox_if (Option.is_none pro) 0 (fmt_opt pro $ wrap "(**" "*)" doc $ epi)
 
@@ -4484,7 +4481,7 @@ let fmt_file (type a) ~ctx ~fmt_code ~debug (fragment : a Extended_ast.t)
   | Documentation, d ->
       (* TODO: [source] and [cmts] should have never been computed when
          formatting doc. *)
-      Fmt_odoc.fmt_ast ~source c.conf ~fmt_code:c.fmt_code d
+      Fmt_odoc.fmt_ast c.conf ~fmt_code:c.fmt_code d
 
 let fmt_parse_result conf ~debug ast_kind ast source comments ~fmt_code =
   let cmts = Cmts.init ast_kind ~debug source ast comments in
diff --git a/lib/Fmt_odoc.ml b/lib/Fmt_odoc.ml
index 74bfbc8cdb..cc5ec93321 100644
--- a/lib/Fmt_odoc.ml
+++ b/lib/Fmt_odoc.ml
@@ -13,22 +13,9 @@ open Fmt
 open Odoc_parser.Ast
 module Loc = Odoc_parser.Loc
 
-(** Odoc locations are represented as line/column and don't work well with
-    the [Source] module. Additionally [Source] functions operate on tokens
-    and cannot see the content of doc comments. *)
-module Doc_source = struct
-  type t = {src: string array}
-
-  let of_source src =
-    let src = Array.of_list (String.split_lines (Source.text src)) in
-    {src}
-
-  let is_line_empty t l = String.for_all t.src.(l - 1) ~f:Char.is_whitespace
-end
-
 type fmt_code = Conf.t -> offset:int -> string -> string or_error
 
-type c = {fmt_code: fmt_code; conf: Conf.t; source: Doc_source.t}
+type c = {fmt_code: fmt_code; conf: Conf.t}
 
 (** Escape characters if they are not already escaped. [escapeworthy] should
     be [true] if the character should be escaped, [false] otherwise. *)
@@ -185,12 +172,9 @@ let block_element_should_blank elem next =
   | (`List _ | `Tag _), _ | `Paragraph _, `Paragraph _ -> true
   | _, _ -> false
 
-let should_preserve_blank c (a : Loc.span) (b : Loc.span) =
-  let rec loop a b =
-    if a >= b then false
-    else Doc_source.is_line_empty c.source a || loop (a + 1) b
-  in
-  loop (a.end_.line + 1) b.start.line
+let should_preserve_blank _c (a : Loc.span) (b : Loc.span) =
+  (* Whether there were already an empty line *)
+  b.start.line - a.end_.line > 1
 
 (* Format a list of block_elements separated by newlines Inserts blank line
    depending on [block_element_should_blank] *)
@@ -352,15 +336,11 @@ let fmt_block_element c elm =
   | #nestable_block_element as value ->
       hovbox 0 (fmt_nestable_block_element c {elm with value})
 
-let fmt_ast ~source conf ~fmt_code (docs : t) =
-  (* We cannot use the content of the comment as source because the locations
-     in the AST are based on the absolute position in the whole source
-     file. *)
-  let source = Doc_source.of_source source in
-  let c = {fmt_code; conf; source} in
+let fmt_ast conf ~fmt_code (docs : t) =
+  let c = {fmt_code; conf} in
   vbox 0 (list_block_elem c docs (fmt_block_element c))
 
-let fmt_parsed (conf : Conf.t) ~fmt_code ~source ~input ~offset parsed =
+let fmt_parsed (conf : Conf.t) ~fmt_code ~input ~offset parsed =
   let open Fmt in
   let begin_space = String.starts_with_whitespace input in
   (* The offset is used to adjust the margin when formatting code blocks. *)
@@ -370,7 +350,7 @@ let fmt_parsed (conf : Conf.t) ~fmt_code ~source ~input ~offset parsed =
   in
   let fmt_parsed parsed =
     fmt_if begin_space " "
-    $ fmt_ast ~source conf ~fmt_code parsed
+    $ fmt_ast conf ~fmt_code parsed
     $ fmt_if
         (String.length input > 1 && String.ends_with_whitespace input)
         " "
diff --git a/lib/Fmt_odoc.mli b/lib/Fmt_odoc.mli
index 8f66066d1f..8b0aff5ea4 100644
--- a/lib/Fmt_odoc.mli
+++ b/lib/Fmt_odoc.mli
@@ -13,17 +13,11 @@
     used to adjust the margin. *)
 type fmt_code = Conf.t -> offset:int -> string -> string or_error
 
-val fmt_ast :
-     source:Source.t
-  -> Conf.t
-  -> fmt_code:fmt_code
-  -> Odoc_parser.Ast.t
-  -> Fmt.t
+val fmt_ast : Conf.t -> fmt_code:fmt_code -> Odoc_parser.Ast.t -> Fmt.t
 
 val fmt_parsed :
      Conf.t
   -> fmt_code:fmt_code
-  -> source:Source.t
   -> input:string
   -> offset:int
   -> (Odoc_parser.Ast.t, Odoc_parser.Warning.t list) Result.t

From a313c0d295f3c0d2649f590db7427c19c4c524c2 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Thu, 22 Jun 2023 19:05:41 +0200
Subject: [PATCH 106/115] Revert change to Source

---
 lib/Source.ml  | 2 --
 lib/Source.mli | 2 --
 2 files changed, 4 deletions(-)

diff --git a/lib/Source.ml b/lib/Source.ml
index 9a0592c0fc..bb234a292d 100644
--- a/lib/Source.ml
+++ b/lib/Source.ml
@@ -15,8 +15,6 @@ open Extended_ast
 (** Concrete syntax. *)
 type t = {text: string; tokens: (Parser.token * Location.t) array}
 
-let text t = t.text
-
 let create ~text ~tokens =
   let tokens =
     List.filter tokens ~f:(fun (tok, _) ->
diff --git a/lib/Source.mli b/lib/Source.mli
index 71f3333053..4d7217040c 100644
--- a/lib/Source.mli
+++ b/lib/Source.mli
@@ -15,8 +15,6 @@ type t
 
 val create : text:string -> tokens:(Parser.token * Location.t) list -> t
 
-val text : t -> string
-
 val empty_line_between : t -> Lexing.position -> Lexing.position -> bool
 (** [empty_line_between t p1 p2] is [true] if there is an empty line between
     [p1] and [p2]. The lines containing [p1] and [p2] are not considered

From 31a37b153d9a5144aa071e31d5853da6039fb3d7 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Mon, 4 Dec 2023 14:17:15 +0100
Subject: [PATCH 107/115] Format and reduce diff

---
 lib/Cmt.ml                                     |  4 +---
 lib/Cmts.ml                                    |  4 ++--
 lib/Fmt_ast.ml                                 | 17 +++++++++--------
 lib/Params.ml                                  |  6 +++---
 lib/Params.mli                                 |  5 ++---
 test/passing/dune.inc                          | 18 ------------------
 test/passing/tests/asterisk_prefixed_cmts.ml   | 16 ----------------
 .../tests/asterisk_prefixed_cmts.ml.err        |  9 ---------
 .../tests/asterisk_prefixed_cmts.ml.ref        | 17 -----------------
 9 files changed, 17 insertions(+), 79 deletions(-)
 delete mode 100644 test/passing/tests/asterisk_prefixed_cmts.ml
 delete mode 100644 test/passing/tests/asterisk_prefixed_cmts.ml.err
 delete mode 100644 test/passing/tests/asterisk_prefixed_cmts.ml.ref

diff --git a/lib/Cmt.ml b/lib/Cmt.ml
index 05a4970390..5798f51f09 100644
--- a/lib/Cmt.ml
+++ b/lib/Cmt.ml
@@ -101,9 +101,7 @@ let unindent_lines ?(max_indent = Stdlib.max_int) ~content_offset first_line
   let tl_indent =
     List.fold_left ~init:max_indent
       ~f:(fun acc s ->
-        match String.indent_of_line s with
-        | Some i -> min acc i
-        | None -> acc )
+        Option.value_map ~default:acc ~f:(min acc) (String.indent_of_line s) )
       tl_lines
   in
   (* The indentation of the first line must account for the location of the
diff --git a/lib/Cmts.ml b/lib/Cmts.ml
index d4056e078a..72bbca00a8 100644
--- a/lib/Cmts.ml
+++ b/lib/Cmts.ml
@@ -664,7 +664,7 @@ module Toplevel = struct
               if Source.begins_line t.source first_loc then
                 fmt_or
                   (Source.empty_line_before t.source first_loc)
-                  "\n@;<1000 0>" "@;<1000 0>"
+                  "\n@;<1000 0>" "@\n"
               else break 1 0
         in
         let epi =
@@ -674,7 +674,7 @@ module Toplevel = struct
               if Source.ends_line t.source last_loc then
                 fmt_or
                   (Source.empty_line_after t.source last_loc)
-                  "\n@;<1000 0>" "@;<1000 0>"
+                  "\n@;<1000 0>" "@\n"
               else break 1 0
           | After -> noop
         in
diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 902c20103d..318451255c 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -2187,7 +2187,8 @@ and fmt_expression c ?(box = true) ?(pro = noop) ?eol ?parens
   | Pexp_variant (s, arg) ->
       pro
       $ Params.parens_if parens c.conf
-          (hvbox (Params.Indent.variant c.conf ~parens)
+          (hvbox
+             (Params.Indent.variant c.conf ~parens)
              ( variant_var c s
              $ opt arg (fmt "@ " >$ (sub_exp ~ctx >> fmt_expression c))
              $ fmt_atrs ) )
@@ -2496,9 +2497,9 @@ and fmt_expression c ?(box = true) ?(pro = noop) ?eol ?parens
       outer_pro
       $ hvbox 0
           (Params.parens_if outer_parens c.conf
-           ( fmt_if_k align opn_paren
+             ( fmt_if_k align opn_paren
              $ compose_module ~pro ~epi blk ~f:fmt_mod
-           $ fmt_atrs ) )
+             $ fmt_atrs ) )
   | Pexp_record (flds, default) ->
       let fmt_field (lid, tc, exp) =
         let typ1, typ2 =
@@ -3842,7 +3843,7 @@ and fmt_module c ctx ?rec_ ?epi ?(can_sparse = false) keyword ?(eqty = "=")
     let xmt = sub_mty ~ctx mt in
     let blk = fmt_module_type c ?rec_ xmt in
     let align_opn, align_cls =
-      if args_p.arg_align then (open_hvbox 0, close_box) else (noop, noop)
+      if args_p.align then (open_hvbox 0, close_box) else (noop, noop)
     in
     let pro =
       pro $ Cmts.fmt_before c loc $ str "(" $ align_opn
@@ -3865,7 +3866,7 @@ and fmt_module c ctx ?rec_ ?epi ?(can_sparse = false) keyword ?(eqty = "=")
           fmt_name_and_mt ~pro ~loc name mt
         else
           let bdy, epi = fmt_name_and_mt ~pro:noop ~loc name mt in
-          let bdy_indent = if args_p.arg_align then 1 else 0 in
+          let bdy_indent = if args_p.align then 1 else 0 in
           (pro $ hvbox bdy_indent bdy $ epi, noop)
   in
   let rec fmt_args ~pro = function
@@ -4487,9 +4488,9 @@ and fmt_value_binding c ~rec_flag ?ext ?in_ ?epi
           ( hvbox_if toplevel 0
               ( hvbox_if toplevel indent
                   ( hovbox 2
-                      ( hovbox (Params.Indent.fun_type_annot c.conf)
-                          ( decl_args
-                          $ fmt_cstr )
+                      ( hovbox
+                          (Params.Indent.fun_type_annot c.conf)
+                          (decl_args $ fmt_cstr)
                       $ fmt_if_k (not lb_pun)
                           (fmt_or_k c.conf.fmt_opts.ocp_indent_compat.v
                              (fits_breaks " =" ~hint:(1000, 0) "=")
diff --git a/lib/Params.ml b/lib/Params.ml
index b2109910c3..16b0c72ce8 100644
--- a/lib/Params.ml
+++ b/lib/Params.ml
@@ -102,7 +102,7 @@ module Exp = struct
 end
 
 module Mod = struct
-  type args = {dock: bool; arg_psp: Fmt.t; indent: int; arg_align: bool}
+  type args = {dock: bool; arg_psp: Fmt.t; indent: int; align: bool}
 
   let arg_is_sig arg =
     match arg.txt with
@@ -123,8 +123,8 @@ module Mod = struct
       else List.for_all ~f:arg_is_sig args
     in
     let arg_psp = if dock then str " " else break 1 psp_indent in
-    let arg_align = (not dock) && ocp c in
-    {dock; arg_psp; indent; arg_align}
+    let align = (not dock) && ocp c in
+    {dock; arg_psp; indent; align}
 
   let break_constraint c ~rhs =
     if ocp c then
diff --git a/lib/Params.mli b/lib/Params.mli
index b4231a3e8a..cce0788f68 100644
--- a/lib/Params.mli
+++ b/lib/Params.mli
@@ -52,9 +52,8 @@ module Mod : sig
     { dock: bool  (** Whether each argument's [pro] should be docked. *)
     ; arg_psp: Fmt.t  (** Break before every arguments. *)
     ; indent: int
-    ; arg_align: bool
-          (** Whether arguments should be aligned on opening parentheses *)
-    }
+    ; align: bool
+          (** Whether to align argument types inside their parenthesis. *) }
 
   val get_args : Conf.t -> functor_parameter loc list -> args
 
diff --git a/test/passing/dune.inc b/test/passing/dune.inc
index 519eb83fbe..8b0d575cbe 100644
--- a/test/passing/dune.inc
+++ b/test/passing/dune.inc
@@ -161,24 +161,6 @@
  (package ocamlformat)
  (action (diff tests/assignment_operator.ml.err assignment_operator.ml.stderr)))
 
-(rule
- (deps tests/.ocamlformat )
- (package ocamlformat)
- (action
-  (with-stdout-to asterisk_prefixed_cmts.ml.stdout
-   (with-stderr-to asterisk_prefixed_cmts.ml.stderr
-     (run %{bin:ocamlformat} --margin-check %{dep:tests/asterisk_prefixed_cmts.ml})))))
-
-(rule
- (alias runtest)
- (package ocamlformat)
- (action (diff tests/asterisk_prefixed_cmts.ml.ref asterisk_prefixed_cmts.ml.stdout)))
-
-(rule
- (alias runtest)
- (package ocamlformat)
- (action (diff tests/asterisk_prefixed_cmts.ml.err asterisk_prefixed_cmts.ml.stderr)))
-
 (rule
  (deps tests/.ocamlformat )
  (package ocamlformat)
diff --git a/test/passing/tests/asterisk_prefixed_cmts.ml b/test/passing/tests/asterisk_prefixed_cmts.ml
deleted file mode 100644
index 1ac4cb99d4..0000000000
--- a/test/passing/tests/asterisk_prefixed_cmts.ml
+++ /dev/null
@@ -1,16 +0,0 @@
-let _ =
-  (* It is very confusing - same expression has two different types in two contexts:*)
-  (* 1. if passed as parameter it's RETURN_TYPE* since we are passing it as rvalue *)
-  (* 2. for return expression it's RETURN_TYPE since backend allows to treat it as lvalue*)
-  (*    of RETURN_TYPE *)
-  (* Implications: *)
-  (* Fields: field_deref_trans relies on it - if exp has RETURN_TYPE then *)
-  (*         it means that it's not lvalue in clang's AST (it'd be reference otherwise) *)
-  (* Methods: method_deref_trans actually wants a pointer to the object, which is*)
-  (*          equivalent of value of ret_param. Since ret_exp has type RETURN_TYPE,*)
-  (*          we optionally add pointer there to avoid backend confusion. *)
-  (*          It works either way *)
-  (* Passing by value: may cause problems - there needs to be extra Sil.Load, but*)
-  (*                   doing so would create problems with methods. Passing structs by*)
-  (*                   value doesn't work good anyway. This may need to be revisited later*)
-  let x = y in z
diff --git a/test/passing/tests/asterisk_prefixed_cmts.ml.err b/test/passing/tests/asterisk_prefixed_cmts.ml.err
deleted file mode 100644
index dfda3bc2e5..0000000000
--- a/test/passing/tests/asterisk_prefixed_cmts.ml.err
+++ /dev/null
@@ -1,9 +0,0 @@
-Warning: tests/asterisk_prefixed_cmts.ml:1 exceeds the margin
-Warning: tests/asterisk_prefixed_cmts.ml:2 exceeds the margin
-Warning: tests/asterisk_prefixed_cmts.ml:3 exceeds the margin
-Warning: tests/asterisk_prefixed_cmts.ml:7 exceeds the margin
-Warning: tests/asterisk_prefixed_cmts.ml:8 exceeds the margin
-Warning: tests/asterisk_prefixed_cmts.ml:9 exceeds the margin
-Warning: tests/asterisk_prefixed_cmts.ml:12 exceeds the margin
-Warning: tests/asterisk_prefixed_cmts.ml:13 exceeds the margin
-Warning: tests/asterisk_prefixed_cmts.ml:14 exceeds the margin
diff --git a/test/passing/tests/asterisk_prefixed_cmts.ml.ref b/test/passing/tests/asterisk_prefixed_cmts.ml.ref
deleted file mode 100644
index ff4677e024..0000000000
--- a/test/passing/tests/asterisk_prefixed_cmts.ml.ref
+++ /dev/null
@@ -1,17 +0,0 @@
-let _ =
-  (* It is very confusing - same expression has two different types in two contexts:*)
-  (* 1. if passed as parameter it's RETURN_TYPE* since we are passing it as rvalue *)
-  (* 2. for return expression it's RETURN_TYPE since backend allows to treat it as lvalue*)
-  (*    of RETURN_TYPE *)
-  (* Implications: *)
-  (* Fields: field_deref_trans relies on it - if exp has RETURN_TYPE then *)
-  (*         it means that it's not lvalue in clang's AST (it'd be reference otherwise) *)
-  (* Methods: method_deref_trans actually wants a pointer to the object, which is*)
-  (*          equivalent of value of ret_param. Since ret_exp has type RETURN_TYPE,*)
-  (*          we optionally add pointer there to avoid backend confusion. *)
-  (*          It works either way *)
-  (* Passing by value: may cause problems - there needs to be extra Sil.Load, but*)
-  (*                   doing so would create problems with methods. Passing structs by*)
-  (*                   value doesn't work good anyway. This may need to be revisited later*)
-  let x = y in
-  z

From 561bf5ff0d785ce1bf3cc761a38886179d9a42c9 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Tue, 5 Dec 2023 14:12:05 +0100
Subject: [PATCH 108/115] Remove extension indent change in other profiles

---
 lib/Fmt_ast.ml                               | 15 +++++++-----
 test/passing/tests/extensions-indent.ml.ref  | 24 ++++++++++----------
 test/passing/tests/extensions-indent.mli.ref | 17 +++++++++-----
 test/passing/tests/extensions.ml.ref         | 10 ++++----
 test/passing/tests/extensions.mli            | 13 +++++++----
 test/passing/tests/source.ml.ref             | 24 ++++++++++----------
 6 files changed, 58 insertions(+), 45 deletions(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 318451255c..a60be5af6d 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -577,13 +577,16 @@ let rec fmt_extension_aux c ctx ~key (ext, pld) =
     when Source.extension_using_sugar ~name:ext ~payload:ppat_loc ->
       fmt_pattern c ~ext (sub_pat ~ctx pat)
   | _ ->
-      let indent =
-        match pld with
-        | PStr [{pstr_desc= Pstr_eval _; _}] | PTyp _ | PPat _ ->
-            c.conf.fmt_opts.extension_indent.v
-        | PSig _ | PStr _ -> c.conf.fmt_opts.stritem_extension_indent.v
+      let box =
+        if c.conf.fmt_opts.ocp_indent_compat.v then
+          match pld with
+          | PStr [{pstr_desc= Pstr_eval _; _}] | PTyp _ | PPat _ ->
+              hvbox c.conf.fmt_opts.extension_indent.v
+          | PSig _ | PStr _ ->
+              hvbox c.conf.fmt_opts.stritem_extension_indent.v
+        else Fn.id
       in
-      hvbox indent
+      box
         (wrap "[" "]"
            ( str (Ext.Key.to_string key)
            $ fmt_str_loc c ext
diff --git a/test/passing/tests/extensions-indent.ml.ref b/test/passing/tests/extensions-indent.ml.ref
index 0c890635d1..7b730b8c8a 100644
--- a/test/passing/tests/extensions-indent.ml.ref
+++ b/test/passing/tests/extensions-indent.ml.ref
@@ -48,24 +48,24 @@ let _ = ([%ext? (x : x)] : [%ext? (x : x)])
 [%%ext 11111111111111111111]
 
 [%%ext
-     11111111111111111111111 22222222222222222222222 33333333333333333333333]
+   11111111111111111111111 22222222222222222222222 33333333333333333333333]
 
 [%%ext
-   11111111111111111111 ;;
+11111111111111111111 ;;
 
-   22222222222222222222]
+22222222222222222222]
 
 [%%ext
-   11111111111111111111 ;;
+11111111111111111111 ;;
 
-   22222222222222222222 ;;
+22222222222222222222 ;;
 
-   33333333333333333333]
+33333333333333333333]
 
 [%%ext
-   let foooooooooooooooo = foooo
+let foooooooooooooooo = foooo
 
-   let fooooooooooooooo = foo]
+let fooooooooooooooo = foo]
 
 let _ = [%stri let [%p xxx] = fun (t : [%t tt]) (ut : [%t tt]) -> [%e xxx]]
 
@@ -163,10 +163,10 @@ let foo =
        foooooooooooooooooooooooooooo]
 
 [%%foooooooooo:
-     fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo
-     foooooooooooooooooooooooooooooooooo
-     foooooooooooooooooooooooooooo
-     foooooooooooooooooooooooooooo]
+   fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo
+   foooooooooooooooooooooooooooooooooo
+   foooooooooooooooooooooooooooo
+   foooooooooooooooooooooooooooo]
 
 [@@@foooooooooo
    fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo
diff --git a/test/passing/tests/extensions-indent.mli.ref b/test/passing/tests/extensions-indent.mli.ref
index 3cea1724a2..558f398b99 100644
--- a/test/passing/tests/extensions-indent.mli.ref
+++ b/test/passing/tests/extensions-indent.mli.ref
@@ -10,21 +10,26 @@ type t =
        foooooooooooooooooooooooooooooooooo foooooooooooooooooooooooooooo
        foooooooooooooooooooooooooooo]
 
-[%%foooooooooo:
-     fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo
-     foooooooooooooooooooooooooooooooooo
-     foooooooooooooooooooooooooooo
+[%%foooooooooo
+   fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo
+     foooooooooooooooooooooooooooooooooo foooooooooooooooooooooooooooo
      foooooooooooooooooooooooooooo]
 
+[%%foooooooooo:
+   fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo
+   foooooooooooooooooooooooooooooooooo
+   foooooooooooooooooooooooooooo
+   foooooooooooooooooooooooooooo]
+
 [@@@foooooooooo
    fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo
      foooooooooooooooooooooooooooooooooo foooooooooooooooooooooooooooo
      foooooooooooooooooooooooooooo]
 
 [%%ext
-   val foooooooooooooooooooooo : fooooooooooo
+val foooooooooooooooooooooo : fooooooooooo
 
-   val fooooooooooooooooooooooooooo : fooooo]
+val fooooooooooooooooooooooooooo : fooooo]
 
 exception%ext E
 
diff --git a/test/passing/tests/extensions.ml.ref b/test/passing/tests/extensions.ml.ref
index aaf04f9dd6..3dbe10d019 100644
--- a/test/passing/tests/extensions.ml.ref
+++ b/test/passing/tests/extensions.ml.ref
@@ -48,7 +48,7 @@ let _ = ([%ext? (x : x)] : [%ext? (x : x)])
 [%%ext 11111111111111111111]
 
 [%%ext
-  11111111111111111111111 22222222222222222222222 33333333333333333333333]
+11111111111111111111111 22222222222222222222222 33333333333333333333333]
 
 [%%ext
 11111111111111111111 ;;
@@ -163,10 +163,10 @@ let foo =
     foooooooooooooooooooooooooooo]
 
 [%%foooooooooo:
-  fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo
-  foooooooooooooooooooooooooooooooooo
-  foooooooooooooooooooooooooooo
-  foooooooooooooooooooooooooooo]
+fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo
+foooooooooooooooooooooooooooooooooo
+foooooooooooooooooooooooooooo
+foooooooooooooooooooooooooooo]
 
 [@@@foooooooooo
 fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo
diff --git a/test/passing/tests/extensions.mli b/test/passing/tests/extensions.mli
index 8bedbe65df..cb2956ae2e 100644
--- a/test/passing/tests/extensions.mli
+++ b/test/passing/tests/extensions.mli
@@ -10,12 +10,17 @@ type t =
     foooooooooooooooooooooooooooooooooo foooooooooooooooooooooooooooo
     foooooooooooooooooooooooooooo]
 
-[%%foooooooooo:
-  fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo
-  foooooooooooooooooooooooooooooooooo
-  foooooooooooooooooooooooooooo
+[%%foooooooooo
+fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo
+  foooooooooooooooooooooooooooooooooo foooooooooooooooooooooooooooo
   foooooooooooooooooooooooooooo]
 
+[%%foooooooooo:
+fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo
+foooooooooooooooooooooooooooooooooo
+foooooooooooooooooooooooooooo
+foooooooooooooooooooooooooooo]
+
 [@@@foooooooooo
 fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo
   foooooooooooooooooooooooooooooooooo foooooooooooooooooooooooooooo
diff --git a/test/passing/tests/source.ml.ref b/test/passing/tests/source.ml.ref
index 6f39ba6e48..8ffdea57f5 100644
--- a/test/passing/tests/source.ml.ref
+++ b/test/passing/tests/source.ml.ref
@@ -36,8 +36,8 @@ type obj =
 type var = [`Foo  (** foo *) | `Bar of int * string  (** bar *)]
 
 [%%foo
-  let x = 1 in
-  x]
+let x = 1 in
+x]
 
 let [%foo 2 + 1] : [%foo bar.baz] = [%foo "foo"]
 
@@ -59,9 +59,9 @@ let [%foo? Bar x | Baz x] : [%foo? #bar] = [%foo? {x}]
 
 let [%foo: include S with type t = t] :
     [%foo:
-    val x : t
+      val x : t
 
-    val y : t] =
+      val y : t] =
   [%foo: type t = t]
 
 let int_with_custom_modifier =
@@ -2942,7 +2942,7 @@ end
 module F (M : S) : S = M
 
 [%%expect
-  {|
+{|
 module type S = sig type t [@@immediate] end
 module F : functor (M : S) -> S
 |}]
@@ -2966,7 +2966,7 @@ module A = struct
 end
 
 [%%expect
-  {|
+{|
 module A :
   sig
     type t [@@immediate]
@@ -2991,7 +2991,7 @@ module Z : sig
 end = (Y : X with type t = int )
 
 [%%expect
-  {|
+{|
 module type X = sig type t end
 module Y : sig type t = int end
 module Z : sig type t [@@immediate] end
@@ -3079,7 +3079,7 @@ module B = struct
 end
 
 [%%expect
-  {|
+{|
 Line _, characters 2-31:
 Error: Types marked with the immediate attribute must be
        non-pointer types like int or bool
@@ -3093,7 +3093,7 @@ module C = struct
 end
 
 [%%expect
-  {|
+{|
 Line _, characters 2-26:
 Error: Types marked with the immediate attribute must be
        non-pointer types like int or bool
@@ -3107,7 +3107,7 @@ end = struct
 end
 
 [%%expect
-  {|
+{|
 Line _, characters 42-70:
 Error: Signature mismatch:
        Modules do not match:
@@ -3131,7 +3131,7 @@ module FM_invalid = F (struct
 end)
 
 [%%expect
-  {|
+{|
 Line _, characters 23-49:
 Error: Signature mismatch:
        Modules do not match: sig type t = string end is not included in S
@@ -3150,7 +3150,7 @@ module E = struct
 end
 
 [%%expect
-  {|
+{|
 Line _, characters 2-26:
 Error: Types marked with the immediate attribute must be
        non-pointer types like int or bool

From 4e7eb458a0770db7d0e94e748d3399f58f9cc15e Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Fri, 15 Dec 2023 17:26:21 +0100
Subject: [PATCH 109/115] Update CHANGES

---
 CHANGES.md | 1 +
 1 file changed, 1 insertion(+)

diff --git a/CHANGES.md b/CHANGES.md
index fdbb1738b6..48d6be2466 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -16,6 +16,7 @@ profile. This started with version 0.26.0.
 - \* Janestreet profile: do not break `fun _ -> function` (#2460, @tdelvecchio-jsc)
 - \* Reduce the indentation of (polytype) type constraints (#2437, @gpetiot)
 - \* Consistent indentation of polymorphic variant arguments (#2427, @Julow)
+- \* Improvements to ocp-indent-compat and the Janestreet profile (#2314, @Julow)
 
 ### Fixed
 

From 8347bf66b65018738f02063b28cc7b10fb0ac2d2 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Fri, 5 Jan 2024 16:32:54 +0100
Subject: [PATCH 110/115] Don't align module argument types

This alignment is not diff-friendly and is elsewhere recognized as a
bug.

     module Make
         (TT : TableFormat.TABLES)
         (IT : InspectionTableFormat.TABLES with type 'a lr1state = int)
    -    (ET : EngineTypes.TABLE
    -            with type terminal = int
    -             and type nonterminal = int
    -             and type semantic_value = Obj.t)
    +    (ET :
    +      EngineTypes.TABLE
    +        with type terminal = int
    +         and type nonterminal = int
    +         and type semantic_value = Obj.t)
         (E : sig
           type 'a env = (ET.state, ET.semantic_value, ET.token) EngineTypes.env
         end) =
---
 lib/Fmt_ast.ml                      | 12 ++++++++----
 lib/Params.ml                       |  2 +-
 test/passing/tests/functor.ml       |  9 +++++----
 test/passing/tests/js_source.ml.err |  1 +
 test/passing/tests/js_source.ml.ocp |  8 ++++----
 test/passing/tests/js_source.ml.ref | 16 ++++++++--------
 6 files changed, 27 insertions(+), 21 deletions(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index b7dca3acab..901210809c 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -3820,16 +3820,20 @@ and fmt_module c ctx ?rec_ ?epi ?(can_sparse = false) keyword ?(eqty = "=")
         ; psp= fmt_if (Option.is_none blk.pro) "@;<1 2>" $ blk.psp } )
   in
   let blk_b = Option.value_map xbody ~default:empty ~f:(fmt_module_expr c) in
+  let args_p = Params.Mod.get_args c.conf xargs in
   let fmt_name_and_mt ~pro ~loc name mt =
     let xmt = sub_mty ~ctx mt in
     let blk = fmt_module_type c ?rec_ xmt in
+    let align_opn, align_cls =
+      if args_p.align then (open_hvbox 0, close_box) else (noop, noop)
+    in
     let pro =
-      pro $ Cmts.fmt_before c loc $ str "(" $ fmt_str_loc_opt c name
-      $ str " : "
-    and epi = str ")" $ Cmts.fmt_after c loc in
+      pro $ Cmts.fmt_before c loc $ str "(" $ align_opn
+      $ fmt_str_loc_opt c name $ str " :"
+      $ fmt_or_k (Option.is_some blk.pro) (str " ") (break 1 2)
+    and epi = str ")" $ Cmts.fmt_after c loc $ align_cls in
     compose_module' ~box:false ~pro ~epi blk
   in
-  let args_p = Params.Mod.get_args c.conf xargs in
   (* Carry the [epi] to be placed in the next argument's box. *)
   let fmt_arg ~pro {loc; txt} =
     let pro = pro $ args_p.arg_psp in
diff --git a/lib/Params.ml b/lib/Params.ml
index 9fd2733031..62698e9077 100644
--- a/lib/Params.ml
+++ b/lib/Params.ml
@@ -123,7 +123,7 @@ module Mod = struct
       else List.for_all ~f:arg_is_sig args
     in
     let arg_psp = if dock then str " " else break 1 psp_indent in
-    let align = ocp c in
+    let align = (not dock) && ocp c in
     {dock; arg_psp; indent; align}
 
   let break_constraint c ~rhs =
diff --git a/test/passing/tests/functor.ml b/test/passing/tests/functor.ml
index 52d911a6b0..941d3cdd9d 100644
--- a/test/passing/tests/functor.ml
+++ b/test/passing/tests/functor.ml
@@ -71,10 +71,11 @@ module type KV_MAKER = functor (G : Irmin_git.G) (C : Irmin.Contents.S) ->
 module Make
     (TT : TableFormat.TABLES)
     (IT : InspectionTableFormat.TABLES with type 'a lr1state = int)
-    (ET : EngineTypes.TABLE
-            with type terminal = int
-             and type nonterminal = int
-             and type semantic_value = Obj.t)
+    (ET :
+      EngineTypes.TABLE
+        with type terminal = int
+         and type nonterminal = int
+         and type semantic_value = Obj.t)
     (E : sig
       type 'a env = (ET.state, ET.semantic_value, ET.token) EngineTypes.env
     end) =
diff --git a/test/passing/tests/js_source.ml.err b/test/passing/tests/js_source.ml.err
index 1d9cfa32c9..c6dd6784ca 100644
--- a/test/passing/tests/js_source.ml.err
+++ b/test/passing/tests/js_source.ml.err
@@ -3,3 +3,4 @@ Warning: tests/js_source.ml:9537 exceeds the margin
 Warning: tests/js_source.ml:9640 exceeds the margin
 Warning: tests/js_source.ml:9699 exceeds the margin
 Warning: tests/js_source.ml:9781 exceeds the margin
+Warning: tests/js_source.ml:10290 exceeds the margin
diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp
index aefdfbbbaa..4f4cd97249 100644
--- a/test/passing/tests/js_source.ml.ocp
+++ b/test/passing/tests/js_source.ml.ocp
@@ -10287,10 +10287,10 @@ type t =
 
 module Test_gen
     (For_tests : For_tests_gen)
-    (Tested : S_gen
-     with type 'a src := 'a For_tests.Src.t
-     with type 'a dst := 'a For_tests.Dst.t)
-    (Tested : S_gen
+    (Tested :
+       S_gen with type 'a src := 'a For_tests.Src.t with type 'a dst := 'a For_tests.Dst.t)
+    (Tested :
+       S_gen
      with type 'a src := 'a For_tests.Src.t
      with type 'a dst := 'a For_tests.Dst.t
       and type 'a dst := 'a For_tests.Dst.t
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index 23539bc8d4..1dce6ecd6c 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -10287,14 +10287,14 @@ type t =
 
 module Test_gen
     (For_tests : For_tests_gen)
-    (Tested : S_gen
-              with type 'a src := 'a For_tests.Src.t
-              with type 'a dst := 'a For_tests.Dst.t)
-    (Tested : S_gen
-              with type 'a src := 'a For_tests.Src.t
-              with type 'a dst := 'a For_tests.Dst.t
-               and type 'a dst := 'a For_tests.Dst.t
-               and type 'a dst := 'a For_tests.Dst.t) =
+    (Tested :
+       S_gen with type 'a src := 'a For_tests.Src.t with type 'a dst := 'a For_tests.Dst.t)
+    (Tested :
+       S_gen
+       with type 'a src := 'a For_tests.Src.t
+       with type 'a dst := 'a For_tests.Dst.t
+        and type 'a dst := 'a For_tests.Dst.t
+        and type 'a dst := 'a For_tests.Dst.t) =
 struct
   open Tested
   open For_tests

From 7c35657efcc471c7bec799cc7ec41f12332a5e17 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Fri, 5 Jan 2024 16:38:34 +0100
Subject: [PATCH 111/115] Update CHANGES

---
 CHANGES.md | 1 +
 1 file changed, 1 insertion(+)

diff --git a/CHANGES.md b/CHANGES.md
index fdbb1738b6..194ec52438 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -16,6 +16,7 @@ profile. This started with version 0.26.0.
 - \* Janestreet profile: do not break `fun _ -> function` (#2460, @tdelvecchio-jsc)
 - \* Reduce the indentation of (polytype) type constraints (#2437, @gpetiot)
 - \* Consistent indentation of polymorphic variant arguments (#2427, @Julow)
+- \* Don't align breaking module arguments (#2505, @Julow)
 
 ### Fixed
 

From 66e2e857b7f5e1639a2c8d48cce791941b2134ad Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Fri, 5 Jan 2024 17:00:42 +0100
Subject: [PATCH 112/115] Fix docstring in record regression

---
 lib/Fmt_ast.ml                               | 6 +++---
 lib/Params.ml                                | 2 +-
 test/passing/tests/comments_in_record.ml.ref | 4 ++--
 test/passing/tests/js_source.ml.ref          | 2 +-
 test/passing/tests/record-402.ml.ref         | 2 +-
 test/passing/tests/record-loose.ml.ref       | 2 +-
 test/passing/tests/record-tight_decl.ml.ref  | 2 +-
 test/passing/tests/record.ml.ref             | 2 +-
 8 files changed, 11 insertions(+), 11 deletions(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 5b06756528..e9109ca687 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -3379,7 +3379,7 @@ and fmt_label_declaration c ctx ?(last = false) decl =
              (fits_breaks ~level:5 "" ";") )
           (str ";")
   in
-  hvbox 0
+  hovbox 0
     ( Cmts.fmt_before c pld_loc
     $ hvbox
         (Params.Indent.record_docstring c.conf)
@@ -3396,8 +3396,8 @@ and fmt_label_declaration c ctx ?(last = false) decl =
                     $ fmt_semicolon )
                 $ cmt_after_type )
             $ fmt_attributes c ~pre:(Break (1, 1)) atrs )
-        $ fmt_docstring_padded c doc )
-    $ Cmts.fmt_after c pld_loc )
+        $ fmt_docstring_padded c doc
+        $ Cmts.fmt_after c pld_loc ) )
 
 and fmt_constructor_declaration c ctx ~first ~last:_ cstr_decl =
   let { pcd_name= {txt; loc}
diff --git a/lib/Params.ml b/lib/Params.ml
index c1a7d317a2..dab8860632 100644
--- a/lib/Params.ml
+++ b/lib/Params.ml
@@ -722,7 +722,7 @@ module Indent = struct
 
   let record_docstring (c : Conf.t) =
     if ocp c then
-      match c.fmt_opts.break_separators.v with `Before -> -2 | `After -> 0
+      match c.fmt_opts.break_separators.v with `Before -> 0 | `After -> 2
     else 4
 
   let constructor_docstring c = if ocp c then 0 else 4
diff --git a/test/passing/tests/comments_in_record.ml.ref b/test/passing/tests/comments_in_record.ml.ref
index 7d40f5f419..6bdbdec0a5 100644
--- a/test/passing/tests/comments_in_record.ml.ref
+++ b/test/passing/tests/comments_in_record.ml.ref
@@ -40,8 +40,8 @@ type t =
         (* aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb
            cccccccccccccccccccccccccccc ddddddddddddddddd eeeee *)
   ; b: float
-    (* aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb
-       cccccccccccccccccccccccccccc ddddddddddddddddd eeeee *) }
+        (* aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb
+           cccccccccccccccccccccccccccc ddddddddddddddddd eeeee *) }
 
 type t =
   | Tuple of {elts: t vector; packed: bool}
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index 1d4d0fc7ae..922e1736ab 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -9965,7 +9965,7 @@ type t =
   { break_separators : [ `Before | `After ]
   ; break_sequences : bool
   ; break_string_literals : [ `Auto | `Never ]
-  (** How to potentially break string literals into new lines. *)
+    (** How to potentially break string literals into new lines. *)
   ; break_struct : bool
   ; cases_exp_indent : int
   ; cases_matching_exp_indent : [ `Normal | `Compact ]
diff --git a/test/passing/tests/record-402.ml.ref b/test/passing/tests/record-402.ml.ref
index f22a291bea..193886e656 100644
--- a/test/passing/tests/record-402.ml.ref
+++ b/test/passing/tests/record-402.ml.ref
@@ -57,4 +57,4 @@ let {x= (x : t)} = x
 type t =
   { xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx:
       YYYYYYYYYYYYYYYYYYYYY.t
-    (* ____________________________________ *) }
+        (* ____________________________________ *) }
diff --git a/test/passing/tests/record-loose.ml.ref b/test/passing/tests/record-loose.ml.ref
index ed2ed8d53b..62bca17b96 100644
--- a/test/passing/tests/record-loose.ml.ref
+++ b/test/passing/tests/record-loose.ml.ref
@@ -57,4 +57,4 @@ let {x : t} = x
 type t =
   { xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx :
       YYYYYYYYYYYYYYYYYYYYY.t
-    (* ____________________________________ *) }
+        (* ____________________________________ *) }
diff --git a/test/passing/tests/record-tight_decl.ml.ref b/test/passing/tests/record-tight_decl.ml.ref
index 17e3508a60..c31018e185 100644
--- a/test/passing/tests/record-tight_decl.ml.ref
+++ b/test/passing/tests/record-tight_decl.ml.ref
@@ -57,4 +57,4 @@ let {x : t} = x
 type t =
   { xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx:
       YYYYYYYYYYYYYYYYYYYYY.t
-    (* ____________________________________ *) }
+        (* ____________________________________ *) }
diff --git a/test/passing/tests/record.ml.ref b/test/passing/tests/record.ml.ref
index 20fcf575a7..caa3b447a6 100644
--- a/test/passing/tests/record.ml.ref
+++ b/test/passing/tests/record.ml.ref
@@ -57,4 +57,4 @@ let {x: t} = x
 type t =
   { xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx:
       YYYYYYYYYYYYYYYYYYYYY.t
-    (* ____________________________________ *) }
+        (* ____________________________________ *) }

From 5516500963abc893b63deb3ffef39de8609c360a Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Wed, 10 Jan 2024 11:29:59 +0100
Subject: [PATCH 113/115] Fix functor argument indent regression

---
 lib/Fmt_ast.ml                |  3 +--
 lib/Params.ml                 |  2 --
 lib/Params.mli                |  2 --
 test/passing/tests/functor.ml | 19 ++++++++++++++-----
 4 files changed, 15 insertions(+), 11 deletions(-)

diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index e9109ca687..83c457e9de 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -3843,8 +3843,7 @@ and fmt_module c ctx ?rec_ ?epi ?(can_sparse = false) keyword ?(eqty = "=")
     let pro =
       pro $ Cmts.fmt_before c loc $ str "(" $ align_opn
       $ fmt_str_loc_opt c name $ str " :"
-      $ fmt_or_k (Option.is_some blk.pro) (str " ")
-          (break 1 (Params.Indent.mty c.conf))
+      $ fmt_or_k (Option.is_some blk.pro) (str " ") (break 1 2)
     and epi = str ")" $ Cmts.fmt_after c loc $ align_cls in
     compose_module' ~box:false ~pro ~epi blk
   in
diff --git a/lib/Params.ml b/lib/Params.ml
index dab8860632..1449b74479 100644
--- a/lib/Params.ml
+++ b/lib/Params.ml
@@ -737,8 +737,6 @@ module Indent = struct
 
   let mod_unpack_annot c = if ocp c then 0 else 2
 
-  let mty c = if ocp c then 2 else 3
-
   let mty_with c = if ocp c then 0 else 2
 
   let type_constr c = if ocp c then 2 else 0
diff --git a/lib/Params.mli b/lib/Params.mli
index b4106ff9ec..a057247520 100644
--- a/lib/Params.mli
+++ b/lib/Params.mli
@@ -227,8 +227,6 @@ module Indent : sig
 
   (** Module types *)
 
-  val mty : Conf.t -> int
-
   val mty_with : Conf.t -> int
 
   (** Types *)
diff --git a/test/passing/tests/functor.ml b/test/passing/tests/functor.ml
index 0f8e5b9c7b..8af0190553 100644
--- a/test/passing/tests/functor.ml
+++ b/test/passing/tests/functor.ml
@@ -70,12 +70,13 @@ module type KV_MAKER = functor (G : Irmin_git.G) (C : Irmin.Contents.S) ->
 
 module Make
     (TT : TableFormat.TABLES)
-    (IT : InspectionTableFormat.TABLES with type 'a lr1state = int)
+    (IT :
+      InspectionTableFormat.TABLES__________________________________________)
     (ET :
-       EngineTypes.TABLE
-         with type terminal = int
-          and type nonterminal = int
-          and type semantic_value = Obj.t)
+      EngineTypes.TABLE
+        with type terminal = int
+         and type nonterminal = int
+         and type semantic_value = Obj.t)
     (E : sig
       type 'a env = (ET.state, ET.semantic_value, ET.token) EngineTypes.env
     end) =
@@ -83,6 +84,14 @@ struct
   type t = t
 end
 
+module Make
+    (TT : TableFormat.TABLES)
+    (IT :
+      InspectionTableFormat.TABLES__________________________________________) =
+struct
+  type t = t
+end
+
 (* Long syntax should be preserved *)
 module M = functor (_ : S) -> struct end
 

From eb2f931dd3ff4aa17a78224a2d7c0850cfe4d21c Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Tue, 16 Jan 2024 16:08:31 +0100
Subject: [PATCH 114/115] Commit missing test file

---
 test/passing/tests/functor.ml.err | 1 +
 1 file changed, 1 insertion(+)
 create mode 100644 test/passing/tests/functor.ml.err

diff --git a/test/passing/tests/functor.ml.err b/test/passing/tests/functor.ml.err
new file mode 100644
index 0000000000..236d04d3f0
--- /dev/null
+++ b/test/passing/tests/functor.ml.err
@@ -0,0 +1 @@
+Warning: tests/functor.ml:89 exceeds the margin

From 725f1486aa534f363409d4bc6bb29d20bb279450 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Tue, 16 Jan 2024 16:21:09 +0100
Subject: [PATCH 115/115] Changes: Mark as non breaking change

---
 CHANGES.md | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/CHANGES.md b/CHANGES.md
index fef7a3d3ba..9991716aa6 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -17,7 +17,7 @@ profile. This started with version 0.26.0.
 - \* Reduce the indentation of (polytype) type constraints (#2437, @gpetiot)
 - \* Consistent indentation of polymorphic variant arguments (#2427, @Julow)
 - \* Don't align breaking module arguments (#2505, @Julow)
-- \* Improvements to ocp-indent-compat and the Janestreet profile (#2314, @Julow)
+- Improvements to ocp-indent-compat and the Janestreet profile (#2314, @Julow)
 
 ### Fixed