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 01/54] 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 02/54] 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 03/54] 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 04/54] 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 05/54] 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 06/54] 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 07/54] 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 08/54] 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 09/54] 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 10/54] 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 11/54] 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 12/54] 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 13/54] 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 14/54] 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 15/54] 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 16/54] 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 17/54] 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 18/54] 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 19/54] 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 20/54] 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 21/54] 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 22/54] 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 23/54] 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 24/54] 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 25/54] 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 26/54] 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 27/54] 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 28/54] 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 29/54] 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 30/54] 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 31/54] 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 32/54] 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 33/54] 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 34/54] 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 35/54] 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 36/54] 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 37/54] 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 38/54] 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 39/54] 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 40/54] 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 41/54] 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 42/54] 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 ca357456c940b57e4b16a176deb1eed3e2732aa0 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Fri, 23 Jun 2023 14:10:14 +0200
Subject: [PATCH 43/54] Move break out of `fmt_cmt`

---
 lib/Cmts.ml | 18 +++++++++---------
 1 file changed, 9 insertions(+), 9 deletions(-)

diff --git a/lib/Cmts.ml b/lib/Cmts.ml
index df8ecf525c..af30a15400 100644
--- a/lib/Cmts.ml
+++ b/lib/Cmts.ml
@@ -591,21 +591,14 @@ 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 =
   let open Fmt in
-  let break =
-    fmt_if_k
-      (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
   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 ->
@@ -623,7 +616,14 @@ 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] ->
+             let break =
+               fmt_if_k
+                 ( Poly.(pos = Cmt.After)
+                 && String.contains (Cmt.txt cmt) '\n' )
+                 (break_unless_newline 1000 0)
+             in
+             break $ fmt_cmt conf cmt ~fmt_code
          | group ->
              list group "@;<1000 0>" (fun cmt ->
                  wrap "(*" "*)" (str (Cmt.txt cmt)) ) )

From 27a0074786423f43da5ffbb23bb680b0f6d04f20 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Fri, 23 Jun 2023 14:17:59 +0200
Subject: [PATCH 44/54] Revert change to test break_separators.ml

---
 test/passing/tests/break_separators-after.ml.ref         | 3 +--
 test/passing/tests/break_separators-after_docked.ml.ref  | 3 +--
 test/passing/tests/break_separators-before_docked.ml.ref | 3 +--
 test/passing/tests/break_separators.ml                   | 3 +--
 4 files changed, 4 insertions(+), 8 deletions(-)

diff --git a/test/passing/tests/break_separators-after.ml.ref b/test/passing/tests/break_separators-after.ml.ref
index fa0b13d651..a3d77ee546 100644
--- a/test/passing/tests/break_separators-after.ml.ref
+++ b/test/passing/tests/break_separators-after.ml.ref
@@ -370,8 +370,7 @@ 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
diff --git a/test/passing/tests/break_separators-after_docked.ml.ref b/test/passing/tests/break_separators-after_docked.ml.ref
index 5afade9dec..325930a4f4 100644
--- a/test/passing/tests/break_separators-after_docked.ml.ref
+++ b/test/passing/tests/break_separators-after_docked.ml.ref
@@ -419,8 +419,7 @@ 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
diff --git a/test/passing/tests/break_separators-before_docked.ml.ref b/test/passing/tests/break_separators-before_docked.ml.ref
index ba8931df39..63a5e062e7 100644
--- a/test/passing/tests/break_separators-before_docked.ml.ref
+++ b/test/passing/tests/break_separators-before_docked.ml.ref
@@ -419,8 +419,7 @@ 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
diff --git a/test/passing/tests/break_separators.ml b/test/passing/tests/break_separators.ml
index 900e80fe92..5d5af4f814 100644
--- a/test/passing/tests/break_separators.ml
+++ b/test/passing/tests/break_separators.ml
@@ -370,8 +370,7 @@ 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

From fcf2b8059d7690325ae7fbad8eef57e851468132 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Tue, 19 Sep 2023 11:31:26 +0200
Subject: [PATCH 45/54] Remove unecessary test 'asterisk_prefixed_cmts'

---
 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/wrap_comments.ml           | 34 ++++++++++++++++++
 test/passing/tests/wrap_comments.ml.err       | 18 ++++++++++
 test/passing/tests/wrap_comments.ml.ref       | 36 +++++++++++++++++++
 7 files changed, 88 insertions(+), 60 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/test/passing/dune.inc b/test/passing/dune.inc
index 239f60516f..7ae5163d6c 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
diff --git a/test/passing/tests/wrap_comments.ml b/test/passing/tests/wrap_comments.ml
index 7f9abdfda0..35a5b08d25 100644
--- a/test/passing/tests/wrap_comments.ml
+++ b/test/passing/tests/wrap_comments.ml
@@ -199,3 +199,37 @@ let _ =
  * foo
    bar
  *)
+
+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
+
+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/wrap_comments.ml.err b/test/passing/tests/wrap_comments.ml.err
index 1de4237e92..965a1d76b3 100644
--- a/test/passing/tests/wrap_comments.ml.err
+++ b/test/passing/tests/wrap_comments.ml.err
@@ -1 +1,19 @@
 Warning: tests/wrap_comments.ml:58 exceeds the margin
+Warning: tests/wrap_comments.ml:186 exceeds the margin
+Warning: tests/wrap_comments.ml:187 exceeds the margin
+Warning: tests/wrap_comments.ml:188 exceeds the margin
+Warning: tests/wrap_comments.ml:192 exceeds the margin
+Warning: tests/wrap_comments.ml:193 exceeds the margin
+Warning: tests/wrap_comments.ml:194 exceeds the margin
+Warning: tests/wrap_comments.ml:197 exceeds the margin
+Warning: tests/wrap_comments.ml:198 exceeds the margin
+Warning: tests/wrap_comments.ml:199 exceeds the margin
+Warning: tests/wrap_comments.ml:204 exceeds the margin
+Warning: tests/wrap_comments.ml:205 exceeds the margin
+Warning: tests/wrap_comments.ml:206 exceeds the margin
+Warning: tests/wrap_comments.ml:210 exceeds the margin
+Warning: tests/wrap_comments.ml:211 exceeds the margin
+Warning: tests/wrap_comments.ml:212 exceeds the margin
+Warning: tests/wrap_comments.ml:215 exceeds the margin
+Warning: tests/wrap_comments.ml:216 exceeds the margin
+Warning: tests/wrap_comments.ml:217 exceeds the margin
diff --git a/test/passing/tests/wrap_comments.ml.ref b/test/passing/tests/wrap_comments.ml.ref
index 20e0897ae9..abc7ec36c4 100644
--- a/test/passing/tests/wrap_comments.ml.ref
+++ b/test/passing/tests/wrap_comments.ml.ref
@@ -182,3 +182,39 @@ let _ =
  * foo
    bar
 *)
+
+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
+
+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 8f3d79990ea224c1e3c0b2532d5a911787ad1f20 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Thu, 26 Oct 2023 16:13:31 +0200
Subject: [PATCH 46/54] Add testcase for
 https://github.com/ocaml-ppx/ocamlformat/issues/2468

---
 test/passing/tests/js_source.ml     | 9 +++++++++
 test/passing/tests/js_source.ml.ocp | 2 ++
 test/passing/tests/js_source.ml.ref | 2 ++
 3 files changed, 13 insertions(+)

diff --git a/test/passing/tests/js_source.ml b/test/passing/tests/js_source.ml
index 1140d15ae0..4b4e6504dc 100644
--- a/test/passing/tests/js_source.ml
+++ b/test/passing/tests/js_source.ml
@@ -8179,3 +8179,12 @@ module type M = sig
     : Simple_value_approx.function_declarations option
         Set_of_closures_id.Tbl.fooooooooooooooooooooooooo
 end
+
+(*$
+  let _ =
+    [ x (*
+      *)
+    ; y
+    ]
+  ;;
+*)
diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp
index 8f85ed789f..889cce31c5 100644
--- a/test/passing/tests/js_source.ml.ocp
+++ b/test/passing/tests/js_source.ml.ocp
@@ -10440,3 +10440,5 @@ module type M = sig
     : Simple_value_approx.function_declarations option
         Set_of_closures_id.Tbl.fooooooooooooooooooooooooo
 end
+
+(*$ let _ = [ x (* *); y ] *)
diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
index 743e9933e3..a60e340e05 100644
--- a/test/passing/tests/js_source.ml.ref
+++ b/test/passing/tests/js_source.ml.ref
@@ -10440,3 +10440,5 @@ module type M = sig
     : Simple_value_approx.function_declarations option
         Set_of_closures_id.Tbl.fooooooooooooooooooooooooo
 end
+
+(*$ let _ = [ x (* *); y ] *)

From 971df854ef3a70ebebb7daeb593561d8c7dd2f00 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Thu, 2 Nov 2023 14:54:20 +0100
Subject: [PATCH 47/54] Add test variant for unwrapped comments

---
 test/passing/dune.inc                       |  18 +
 test/passing/tests/comments-no-wrap.ml.err  |   5 +
 test/passing/tests/comments-no-wrap.ml.opts |   2 +
 test/passing/tests/comments-no-wrap.ml.ref  | 422 ++++++++++++++++++++
 4 files changed, 447 insertions(+)
 create mode 100644 test/passing/tests/comments-no-wrap.ml.err
 create mode 100644 test/passing/tests/comments-no-wrap.ml.opts
 create mode 100644 test/passing/tests/comments-no-wrap.ml.ref

diff --git a/test/passing/dune.inc b/test/passing/dune.inc
index c0f7ffb010..8b0d575cbe 100644
--- a/test/passing/dune.inc
+++ b/test/passing/dune.inc
@@ -1130,6 +1130,24 @@
  (package ocamlformat)
  (action (diff tests/comment_sparse.ml.err comment_sparse.ml.stderr)))
 
+(rule
+ (deps tests/.ocamlformat )
+ (package ocamlformat)
+ (action
+  (with-stdout-to comments-no-wrap.ml.stdout
+   (with-stderr-to comments-no-wrap.ml.stderr
+     (run %{bin:ocamlformat} --margin-check --no-wrap-comments --max-iter=3 %{dep:tests/comments.ml})))))
+
+(rule
+ (alias runtest)
+ (package ocamlformat)
+ (action (diff tests/comments-no-wrap.ml.ref comments-no-wrap.ml.stdout)))
+
+(rule
+ (alias runtest)
+ (package ocamlformat)
+ (action (diff tests/comments-no-wrap.ml.err comments-no-wrap.ml.stderr)))
+
 (rule
  (deps tests/.ocamlformat )
  (package ocamlformat)
diff --git a/test/passing/tests/comments-no-wrap.ml.err b/test/passing/tests/comments-no-wrap.ml.err
new file mode 100644
index 0000000000..26769f21aa
--- /dev/null
+++ b/test/passing/tests/comments-no-wrap.ml.err
@@ -0,0 +1,5 @@
+Warning: tests/comments.ml:186 exceeds the margin
+Warning: tests/comments.ml:190 exceeds the margin
+Warning: tests/comments.ml:248 exceeds the margin
+Warning: tests/comments.ml:383 exceeds the margin
+Warning: tests/comments.ml:415 exceeds the margin
diff --git a/test/passing/tests/comments-no-wrap.ml.opts b/test/passing/tests/comments-no-wrap.ml.opts
new file mode 100644
index 0000000000..4fa0ab82c2
--- /dev/null
+++ b/test/passing/tests/comments-no-wrap.ml.opts
@@ -0,0 +1,2 @@
+--no-wrap-comments
+--max-iter=3
diff --git a/test/passing/tests/comments-no-wrap.ml.ref b/test/passing/tests/comments-no-wrap.ml.ref
new file mode 100644
index 0000000000..dd11ad8aa5
--- /dev/null
+++ b/test/passing/tests/comments-no-wrap.ml.ref
@@ -0,0 +1,422 @@
+(* *)
+
+(**)
+
+(* *)
+
+(*$*)
+(*$ *)
+(*$  *)
+
+let _ = f (*f*) a (*a*) ~b (*comment*) ~c:(*comment*) c' ?d ?e ()
+
+let _ =
+  let _ =
+    f
+      (*comment*)
+      (let open M in
+       let x = x in
+       e )
+  in
+  ()
+
+let _ = ((*comment*) a (*comment*), b)
+
+let foo = function Blah ((* old *) x, y) -> ()
+
+let foo = function Blah (x (* old *), y) -> ()
+
+let foo = function Blah, (* old *) (x, y) -> ()
+
+let foo = function Blah (x, y) (* old *) -> ()
+
+let foo = function Blah, (x, y (* old *)) -> ()
+
+let foo = function Blah, (x, (* old *) y) -> ()
+
+let foo = function (x, y) (* old *), z -> ()
+
+let _ =
+  if (* a0 *) b (* c0 *) then (* d0 *) e (* f0 *) else (* g0 *) h (* i0 *)
+
+let _ =
+  if (* a1 *) b (* c1 *) then (* d1 *) e (* f1 *) else (* g1 *) h (* i1 *)
+
+let _ =
+  if (* a2 *) B (* c2 *) then (* d2 *) E (* f2 *) else (* g2 *) H (* i2 *)
+
+let _ =
+  if (* a3 *) B (* c3 *) then (* d3 *) E (* f3 *) else (* g3 *) H (* i3 *)
+;;
+
+match x with
+| true -> "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+| false -> "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
+(* this comment should not change the formatting of the following case *)
+| false -> "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
+;;
+
+try f x
+with
+(* this comment is intended to refer to the entire case below *)
+| Caml.Not_found ->
+  ()
+;;
+
+match x with
+(* this comment is intended to refer to the entire case below *)
+| false -> ()
+;;
+
+match x with
+| Aaaaaaaaaaaaaaaaaaaa
+(* this comment is intended to refer to the case below *)
+ |Bbbbbbbbbbbbbbbbbbbb ->
+    ()
+
+let _ =
+  (* this comment is intended to refer to the entire match below *)
+  match x with
+  | "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" -> ()
+  | "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" -> ()
+
+module type M = sig
+  val f (* A list of [name], [count] pairs. *) : (string * int) list -> int
+end
+
+let _ = f ~f:(fun a b -> c) (* comment *) ~f:(fun a b -> c)
+
+let _ = f (fun x -> g h) (* comment *) ~f:(fun a b -> c)
+
+let _ = f (g h) (* comment *) ~f:(fun a b -> c)
+
+let _ = f (0 + 0 (* test *) + (1 * 1) (* test *))
+
+let _ = f ((1 * 1) (* test *) + (0 + 0) (* test *))
+
+let _ = match e with 3 (* test *) -> e | 3 (* test *) :: tail -> e
+
+let _ = if a then b :: c (* d *) else e
+
+let (b :: c (* d *)) = x
+
+module rec A = struct end
+
+(*test*)
+and B = struct end
+
+module type T = sig
+  module rec A : sig end
+
+  (*test*)
+  and B : sig end
+end
+
+let f = (* comment *) function x -> x
+
+let foo x : z = (* comment *) y
+
+let _ =
+  (*a*)
+  s (*b*).((*c*)
+           (*d*)
+           i
+           (*e*))
+
+let _ =
+  (*a*)
+  s (*b*).((*c*)
+           (*d*)
+           i
+           (*e*)) <-
+    (*f*)
+    (*g*)
+    x
+
+let _ =
+  (*a*)
+  s (*b*).[(*c*)
+           (*d*)
+           i
+           (*e*)]
+
+let _ =
+  (*a*)
+  s (*b*).[(*c*)
+           (*d*)
+           i
+           (*e*)] <-
+    (*f*)
+    (*g*)
+    x
+
+let _ =
+  (*a*)
+  s (*b*).{(*c*)
+           (*d*)
+           i
+           (*e*)}
+
+let _ =
+  (*a*)
+  s (*b*).{(*c*)
+           (*d*)
+           i
+           (*e*)} <-
+    (*f*)
+    (*g*)
+    x
+
+let _ = (*a*) s (*b*).%{(*c*) i (*d*)}
+
+let _ =
+  (*a*)
+  s (*b*).%{(*c*) i (*d*)} <-
+    (*e*)
+    (*f*)
+    x
+
+type t = {a: int [@default a] (* comment *); b: flag}
+
+let () =
+  (* *)
+
+  (* *)
+  ()
+
+(* break when unicode sequence length measured in bytes but ¬ in code points *)
+
+type t =
+  | Aaaaaaaaaa
+    (* Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. *)
+  | Bbbbbbbbbb (* foo *)
+  | Bbbbbbbbbb (* foo *)
+
+let () =
+  xxxxxxxxxx
+  || (* xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx *)
+  xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
+
+let () =
+  xxxxxxxxxx
+  land (* xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx *)
+  xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
+
+let rec fooooooooooo = function
+  (*XX*)
+  | x :: t (*YY*) -> k
+  (* AA*)
+  | [ (*BB*)
+      (* CC *)
+      x
+      (* DD *)
+    ; (* EE *)
+      y
+      (* FF *)
+      (* GG *) ]
+  (* HH *) ->
+      k
+  (* AA*)
+  (*BB*)
+  (* CC *)
+  | x (* DD *) :: (* EE *) t
+  (* FF *)
+  (* GG *)
+  (* HH *) ->
+      k
+  (* AA*)
+  (*BB*)
+  (* CC *)
+  | x
+    (* DD *)
+    (* XX *)
+    :: (* YY *)
+       (* EE *) t
+  (* FF *)
+  (* GG *)
+  (* HH *) ->
+      k
+  (* AA *)
+  (* BB *)
+  | (module (* CC *)
+            (* DD *) F (* EE *) : (* FF *) M (* GG *) ) (* HH *)
+    :: (* II *) t
+  (* JJ *)
+  (* KK *) ->
+      foo
+
+let%map
+    (* __________________________________________________________________________________________ *)
+    _ =
+  ()
+
+type t = < (* a *)
+         a: int [@atr] (* b *) ; b: int (* c *) >
+
+type t = < a: int (* a *) ; (* b *) .. (* c *) >
+
+type t = < (* a *) .. (* b *) >
+
+class type i = object
+  (* test *)
+  inherit oo
+end
+
+class i =
+  object
+    (* test *)
+    inherit oo
+  end
+
+let _ =
+  try_with (fun () ->
+      (* comment before *)
+      match get () with
+      | None -> do_something ()
+      | Some _ -> () (* do nothing *) )
+
+let _ = try_with (fun () -> (* comment before *)
+                            a ; b (* after b *) )
+
+let _ =
+  match x with
+  | Some y -> (
+    match y with None -> () | Some z -> incr z (* double some *) )
+  | None -> ()
+
+type prefix =
+  {sib_extend: int  (** add more as needed *) (* extended sib index bit *)}
+
+type t =
+  | A (* A *)
+  (* | B *)
+  | C
+
+type t =
+  (* | B *)
+  | A
+  (* A *)
+  | C
+
+type t =
+  | A
+  (* A *)
+  (* | B *)
+  | C
+
+type foo = Alpha | Beta
+[@@ocaml.warning "-37" (* Explanation of warning *)]
+
+type foo =
+  | Alpha______________________________
+  | Beta_______________________________
+[@@ocaml.warning "-37" (* Explanation of warning *)]
+
+let y =
+  f
+    (* a *)
+    (* b *)
+    x
+
+module A (* A *) () (* B *) = (* C *) B
+
+let kk = (* foo *) (module A : T)
+
+let kk = (* foo *) (module A : T)
+
+let kk = (module A : T) (* foo *)
+
+let kk = (* foo *) (module A : T) (* foo *)
+
+let kk =
+  (* before exp *)
+  (* before exp_pack *)
+  (module (* before A *) A (* after A *))
+(* after exp_pack *)
+(* after exp *)
+
+let kk =
+  (* before exp *)
+  (* before exp_pack *)
+  (module (* before A *) A (* after A *) : (* before S *) S (* after S *))
+(* after exp_pack *)
+(* after exp *)
+
+let _ = assert (foo (bar + baz <= quux))
+(* this comment should stay attached to the preceding item *)
+
+let _ = foo
+
+let a =
+  [ b
+    (*  *)
+    (* c *) ]
+
+let _ =
+  1
+  + (* foooooooooooooooooooooooo fooooooooooooooo fooooooooooooooooo *)
+  fooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
+  - (* fooooooooooooo foooooooooooooooooooooo foooooooooooooooooooo *)
+  foooooooooooooo foooooooooooooo foooooooooooooooooo fooooooooo
+  % (* foooooooooooooooo foooooooooooo foooooooooooooooooo *)
+  fooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
+  / (* foooooooooooooooooooooooo fooooooooooooooo fooooooooooooooooo *)
+  barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr
+  * (* convert from foos to bars blah blah blah blah blah blah blah blah *)
+  foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo
+  $ (* convert from foos to bars blah blah blah blah blah blah blah blah *)
+  foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo
+  & (* convert from foos to bars blah blah blah blah blah blah blah blah *)
+  foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo
+  = (* convert from foos to bars blah blah blah blah blah blah blah blah *)
+  foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo
+  > (* convert from foos to bars blah blah blah blah blah blah blah blah *)
+  foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo
+  < (* convert from foos to bars blah blah blah blah blah blah blah blah *)
+  foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo
+  (* convert from foos to bars blah blah blah blah blah blah blah blah *)
+  @ foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo
+  ^ (* convert from foos to bars blah blah blah blah blah blah blah blah *)
+  foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo
+  || (* convert from foos to bars blah blah blah blah blah blah blah blah *)
+  foooooooooooooooooooooooo foooooooooooooooo
+    fooooooooooooooo
+    #= (* convert from foos to bars blah blah blah blah blah blah blah blah *)
+    foooooooooooooooooooooooo
+    foooooooooooooooo fooooooooooooooo
+
+let _ =
+  !
+    (*a*)
+    (*b*)
+    x
+
+let _ =
+  (*x*)
+  !
+    (*a*)
+    (*b*)
+    x (*c*) y
+
+let _ =
+  f
+    ((*x*)
+     !
+       (*a*)
+       (*b*)
+       x
+       (*c*) y )
+    y
+
+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 *)
+      x:
+      int }
+
+let _ = (x + y) [@attr] + z
+
+let _ = x ^ (y ^ z) [@attr]

From bce8df8295ba5b439f0044a652b70fb45f63ceb2 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Thu, 2 Nov 2023 16:09:32 +0100
Subject: [PATCH 48/54] Preserve trailing empty line of unwrapped comments

---
 lib/Cmts.ml                                | 14 -------------
 test/passing/tests/comments-no-wrap.ml.ref | 15 ++++++++++++++
 test/passing/tests/comments.ml             | 15 ++++++++++++++
 test/passing/tests/comments.ml.ref         | 11 ++++++++++
 test/passing/tests/wrap_comments.ml.err    | 24 +++++++++++-----------
 test/passing/tests/wrap_comments.ml.ref    | 14 +++++++------
 6 files changed, 61 insertions(+), 32 deletions(-)

diff --git a/lib/Cmts.ml b/lib/Cmts.ml
index ad591f1c4f..1c4c43c45b 100644
--- a/lib/Cmts.ml
+++ b/lib/Cmts.ml
@@ -508,26 +508,12 @@ end
 module Unwrapped = struct
   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
-    String.contains ~pos s '\n'
-
   let fmt_line ~first:_ ~last:_ l =
     (* The last line will be followed by the [epi]. *)
     str "\n" $ str l
 
   (** [txt] contains trailing spaces and leading/trailing empty lines. *)
   let fmt ~pro ~epi txt =
-    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 ->
         vbox 0 ~name:"unwrapped" (pro $ str hd $ list_fl tl fmt_line) $ epi
diff --git a/test/passing/tests/comments-no-wrap.ml.ref b/test/passing/tests/comments-no-wrap.ml.ref
index dd11ad8aa5..92d042380c 100644
--- a/test/passing/tests/comments-no-wrap.ml.ref
+++ b/test/passing/tests/comments-no-wrap.ml.ref
@@ -420,3 +420,18 @@ type t =
 let _ = (x + y) [@attr] + z
 
 let _ = x ^ (y ^ z) [@attr]
+
+let _ =
+  () ;
+  (* indentation preserved
+  *)
+  () ;
+  (* indentation preserved
+   *)
+  () ;
+  (* indentation preserved
+     *)
+  () ;
+  (* indentation not preserved
+*)
+  ()
diff --git a/test/passing/tests/comments.ml b/test/passing/tests/comments.ml
index f6fa2146e7..eb247663d4 100644
--- a/test/passing/tests/comments.ml
+++ b/test/passing/tests/comments.ml
@@ -315,3 +315,18 @@ type t = { (* comment before mutable *) mutable
 let _ = (x + y) [@attr] + z
 
 let _ = x ^ (y ^ z) [@attr]
+
+let _ =
+  ();
+  (* indentation preserved
+  *)
+  ();
+  (* indentation preserved
+   *)
+  ();
+  (* indentation preserved
+     *)
+  ();
+  (* indentation not preserved
+*)
+  ()
diff --git a/test/passing/tests/comments.ml.ref b/test/passing/tests/comments.ml.ref
index 548fdc173f..a443e4e6db 100644
--- a/test/passing/tests/comments.ml.ref
+++ b/test/passing/tests/comments.ml.ref
@@ -424,3 +424,14 @@ type t =
 let _ = (x + y) [@attr] + z
 
 let _ = x ^ (y ^ z) [@attr]
+
+let _ =
+  () ;
+  (* indentation preserved *)
+  () ;
+  (* indentation preserved *)
+  () ;
+  (* indentation preserved *)
+  () ;
+  (* indentation not preserved *)
+  ()
diff --git a/test/passing/tests/wrap_comments.ml.err b/test/passing/tests/wrap_comments.ml.err
index 965a1d76b3..95c28292ba 100644
--- a/test/passing/tests/wrap_comments.ml.err
+++ b/test/passing/tests/wrap_comments.ml.err
@@ -1,19 +1,19 @@
 Warning: tests/wrap_comments.ml:58 exceeds the margin
-Warning: tests/wrap_comments.ml:186 exceeds the margin
-Warning: tests/wrap_comments.ml:187 exceeds the margin
 Warning: tests/wrap_comments.ml:188 exceeds the margin
-Warning: tests/wrap_comments.ml:192 exceeds the margin
-Warning: tests/wrap_comments.ml:193 exceeds the margin
+Warning: tests/wrap_comments.ml:189 exceeds the margin
+Warning: tests/wrap_comments.ml:190 exceeds the margin
 Warning: tests/wrap_comments.ml:194 exceeds the margin
-Warning: tests/wrap_comments.ml:197 exceeds the margin
-Warning: tests/wrap_comments.ml:198 exceeds the margin
+Warning: tests/wrap_comments.ml:195 exceeds the margin
+Warning: tests/wrap_comments.ml:196 exceeds the margin
 Warning: tests/wrap_comments.ml:199 exceeds the margin
-Warning: tests/wrap_comments.ml:204 exceeds the margin
-Warning: tests/wrap_comments.ml:205 exceeds the margin
+Warning: tests/wrap_comments.ml:200 exceeds the margin
+Warning: tests/wrap_comments.ml:201 exceeds the margin
 Warning: tests/wrap_comments.ml:206 exceeds the margin
-Warning: tests/wrap_comments.ml:210 exceeds the margin
-Warning: tests/wrap_comments.ml:211 exceeds the margin
+Warning: tests/wrap_comments.ml:207 exceeds the margin
+Warning: tests/wrap_comments.ml:208 exceeds the margin
 Warning: tests/wrap_comments.ml:212 exceeds the margin
-Warning: tests/wrap_comments.ml:215 exceeds the margin
-Warning: tests/wrap_comments.ml:216 exceeds the margin
+Warning: tests/wrap_comments.ml:213 exceeds the margin
+Warning: tests/wrap_comments.ml:214 exceeds the margin
 Warning: tests/wrap_comments.ml:217 exceeds the margin
+Warning: tests/wrap_comments.ml:218 exceeds the margin
+Warning: tests/wrap_comments.ml:219 exceeds the margin
diff --git a/test/passing/tests/wrap_comments.ml.ref b/test/passing/tests/wrap_comments.ml.ref
index abc7ec36c4..e6e59fbc72 100644
--- a/test/passing/tests/wrap_comments.ml.ref
+++ b/test/passing/tests/wrap_comments.ml.ref
@@ -50,7 +50,7 @@ let _ =
 (*
  * foo
    bar
-*)
+ *)
 
 [@@@ocamlformat "wrap-comments=false"]
 
@@ -114,7 +114,7 @@ let _ =
     (* first line
 
      second line
-    *)
+  *)
   ; "d"
     (* first line
 
@@ -124,12 +124,14 @@ let _ =
     (* first line
 
      second line
-    *)
+         *)
   ; "f"
     (* first line
 
      second line
-    *)
+
+
+         *)
   ; "g" ]
 
 let _ =
@@ -148,7 +150,7 @@ let _ =
 let _ =
   (*no space before
     just newline after
-  *)
+*)
   0
 
 let _ =
@@ -181,7 +183,7 @@ let _ =
 (*
  * foo
    bar
-*)
+ *)
 
 let _ =
   (* It is very confusing - same expression has two different types in two contexts:*)

From c86b00cf43a40738230bceca80c6f12e5a605770 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Mon, 6 Nov 2023 18:10:40 +0100
Subject: [PATCH 49/54] test: Add non-stabilizing comment

---
 test/passing/tests/wrap_comments.ml     | 12 ++++++++++++
 test/passing/tests/wrap_comments.ml.err | 14 +++++++-------
 test/passing/tests/wrap_comments.ml.ref | 15 +++++----------
 3 files changed, 24 insertions(+), 17 deletions(-)

diff --git a/test/passing/tests/wrap_comments.ml b/test/passing/tests/wrap_comments.ml
index 35a5b08d25..0632cc50e5 100644
--- a/test/passing/tests/wrap_comments.ml
+++ b/test/passing/tests/wrap_comments.ml
@@ -64,6 +64,12 @@ let _ =
    bar
  *)
 
+let _ =
+  f
+      (* foo
+      *)
+    a
+
 [@@@ocamlformat "wrap-comments=false"]
 
 type t =
@@ -233,3 +239,9 @@ let _ =
    *                   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
+
+let _ =
+  f
+      (* foo
+      *)
+    a
diff --git a/test/passing/tests/wrap_comments.ml.err b/test/passing/tests/wrap_comments.ml.err
index 95c28292ba..cee76675d2 100644
--- a/test/passing/tests/wrap_comments.ml.err
+++ b/test/passing/tests/wrap_comments.ml.err
@@ -1,19 +1,19 @@
 Warning: tests/wrap_comments.ml:58 exceeds the margin
-Warning: tests/wrap_comments.ml:188 exceeds the margin
+Warning: tests/wrap_comments.ml:183 exceeds the margin
+Warning: tests/wrap_comments.ml:184 exceeds the margin
+Warning: tests/wrap_comments.ml:185 exceeds the margin
 Warning: tests/wrap_comments.ml:189 exceeds the margin
 Warning: tests/wrap_comments.ml:190 exceeds the margin
+Warning: tests/wrap_comments.ml:191 exceeds the margin
 Warning: tests/wrap_comments.ml:194 exceeds the margin
 Warning: tests/wrap_comments.ml:195 exceeds the margin
 Warning: tests/wrap_comments.ml:196 exceeds the margin
-Warning: tests/wrap_comments.ml:199 exceeds the margin
-Warning: tests/wrap_comments.ml:200 exceeds the margin
 Warning: tests/wrap_comments.ml:201 exceeds the margin
-Warning: tests/wrap_comments.ml:206 exceeds the margin
+Warning: tests/wrap_comments.ml:202 exceeds the margin
+Warning: tests/wrap_comments.ml:203 exceeds the margin
 Warning: tests/wrap_comments.ml:207 exceeds the margin
 Warning: tests/wrap_comments.ml:208 exceeds the margin
+Warning: tests/wrap_comments.ml:209 exceeds the margin
 Warning: tests/wrap_comments.ml:212 exceeds the margin
 Warning: tests/wrap_comments.ml:213 exceeds the margin
 Warning: tests/wrap_comments.ml:214 exceeds the margin
-Warning: tests/wrap_comments.ml:217 exceeds the margin
-Warning: tests/wrap_comments.ml:218 exceeds the margin
-Warning: tests/wrap_comments.ml:219 exceeds the margin
diff --git a/test/passing/tests/wrap_comments.ml.ref b/test/passing/tests/wrap_comments.ml.ref
index e6e59fbc72..de32c0531f 100644
--- a/test/passing/tests/wrap_comments.ml.ref
+++ b/test/passing/tests/wrap_comments.ml.ref
@@ -107,26 +107,21 @@ type foo =
 
 let _ =
   [ "a"
-  ; "b"
-    (* first line
+  ; "b" (* first line
      second line *)
-  ; "c"
-    (* first line
+  ; "c" (* first line
 
      second line
   *)
-  ; "d"
-    (* first line
+  ; "d" (* first line
 
 
      second line *)
-  ; "e"
-    (* first line
+  ; "e" (* first line
 
      second line
          *)
-  ; "f"
-    (* first line
+  ; "f" (* first line
 
      second line
 

From 907d70a68ad706ef5c8639050ada9ed92c83c98f Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Mon, 6 Nov 2023 18:15:09 +0100
Subject: [PATCH 50/54] Fix non-stabilizing comment

Remove the forced line break before a multi-line comment. The asymmetry
of this forced line break allowed comments to be move back and forth
between being attached to after `f` or before `a`.

This adds regressions.
---
 lib/Cmts.ml                             |  3 ++-
 test/passing/tests/wrap_comments.ml.err | 16 ++++++-------
 test/passing/tests/wrap_comments.ml.ref | 30 ++++++++++++-------------
 3 files changed, 24 insertions(+), 25 deletions(-)

diff --git a/lib/Cmts.ml b/lib/Cmts.ml
index 1c4c43c45b..f5a182f976 100644
--- a/lib/Cmts.ml
+++ b/lib/Cmts.ml
@@ -592,7 +592,8 @@ let fmt_cmts_aux t (conf : Conf.t) cmts ~fmt_code pos =
          | [cmt] ->
              let break =
                fmt_if_k
-                 ( Poly.(pos = Cmt.After)
+                 ( conf.fmt_opts.ocp_indent_compat.v
+                 && Poly.(pos = Cmt.After)
                  && String.contains (Cmt.txt cmt) '\n' )
                  (break_unless_newline 1000 0)
              in
diff --git a/test/passing/tests/wrap_comments.ml.err b/test/passing/tests/wrap_comments.ml.err
index cee76675d2..22d75f70b4 100644
--- a/test/passing/tests/wrap_comments.ml.err
+++ b/test/passing/tests/wrap_comments.ml.err
@@ -1,19 +1,19 @@
-Warning: tests/wrap_comments.ml:58 exceeds the margin
-Warning: tests/wrap_comments.ml:183 exceeds the margin
+Warning: tests/wrap_comments.ml:53 exceeds the margin
+Warning: tests/wrap_comments.ml:178 exceeds the margin
+Warning: tests/wrap_comments.ml:179 exceeds the margin
+Warning: tests/wrap_comments.ml:180 exceeds the margin
 Warning: tests/wrap_comments.ml:184 exceeds the margin
 Warning: tests/wrap_comments.ml:185 exceeds the margin
+Warning: tests/wrap_comments.ml:186 exceeds the margin
 Warning: tests/wrap_comments.ml:189 exceeds the margin
 Warning: tests/wrap_comments.ml:190 exceeds the margin
 Warning: tests/wrap_comments.ml:191 exceeds the margin
-Warning: tests/wrap_comments.ml:194 exceeds the margin
-Warning: tests/wrap_comments.ml:195 exceeds the margin
 Warning: tests/wrap_comments.ml:196 exceeds the margin
-Warning: tests/wrap_comments.ml:201 exceeds the margin
+Warning: tests/wrap_comments.ml:197 exceeds the margin
+Warning: tests/wrap_comments.ml:198 exceeds the margin
 Warning: tests/wrap_comments.ml:202 exceeds the margin
 Warning: tests/wrap_comments.ml:203 exceeds the margin
+Warning: tests/wrap_comments.ml:204 exceeds the margin
 Warning: tests/wrap_comments.ml:207 exceeds the margin
 Warning: tests/wrap_comments.ml:208 exceeds the margin
 Warning: tests/wrap_comments.ml:209 exceeds the margin
-Warning: tests/wrap_comments.ml:212 exceeds the margin
-Warning: tests/wrap_comments.ml:213 exceeds the margin
-Warning: tests/wrap_comments.ml:214 exceeds the margin
diff --git a/test/passing/tests/wrap_comments.ml.ref b/test/passing/tests/wrap_comments.ml.ref
index de32c0531f..91de5455c2 100644
--- a/test/passing/tests/wrap_comments.ml.ref
+++ b/test/passing/tests/wrap_comments.ml.ref
@@ -9,22 +9,18 @@ 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 _ =
@@ -47,10 +43,9 @@ let _ =
  * bar
  *)
 
-(*
- * foo
-   bar
- *)
+(* * foo bar *)
+
+let _ = f (* foo *) a
 
 [@@@ocamlformat "wrap-comments=false"]
 
@@ -215,3 +210,6 @@ let _ =
    *                   value doesn't work good anyway. This may need to be revisited later*)
   let x = y in
   z
+
+let _ = f (* foo
+      *) a

From a400535b88e2ab05a4aedddd253c15fea5a6f795 Mon Sep 17 00:00:00 2001
From: Guillaume Petiot <guillaume@tarides.com>
Date: Tue, 7 Nov 2023 11:39:28 +0800
Subject: [PATCH 51/54] Fix regression (break introduced before the end of a
 paragraph)

---
 lib-rpc-server/ocamlformat_rpc.ml  |  3 +--
 lib/Cmts.ml                        | 19 +++++++++++--------
 test/passing/tests/js_to_do.ml.ref |  3 +--
 3 files changed, 13 insertions(+), 12 deletions(-)

diff --git a/lib-rpc-server/ocamlformat_rpc.ml b/lib-rpc-server/ocamlformat_rpc.ml
index 02d4ade212..c9799d888a 100644
--- a/lib-rpc-server/ocamlformat_rpc.ml
+++ b/lib-rpc-server/ocamlformat_rpc.ml
@@ -82,8 +82,7 @@ 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
diff --git a/lib/Cmts.ml b/lib/Cmts.ml
index f5a182f976..72bbca00a8 100644
--- a/lib/Cmts.ml
+++ b/lib/Cmts.ml
@@ -482,16 +482,19 @@ module Wrapped = struct
         ~equal:(fun x y -> String.is_empty x && String.is_empty y)
         (String.split (String.rstrip text) ~on:'\n')
     in
+    let groups =
+      List.group lines ~break:(fun _ y -> is_only_whitespaces y)
+    in
     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 )
+        (list_fl groups (fun ~first ~last:last_group group ->
+             let group = List.filter group ~f:(Fn.non is_only_whitespaces) in
+             fmt_if (not first) "\n@\n"
+             $ hovbox 0
+                 (list_fl group (fun ~first ~last x ->
+                      fmt_if (not first) "@ " $ fmt_line x
+                      $ fmt_if_k (last_group && last) (str suffix $ epi) ) ) )
+        )
 end
 
 module Asterisk_prefixed = struct
diff --git a/test/passing/tests/js_to_do.ml.ref b/test/passing/tests/js_to_do.ml.ref
index 48da134128..3917f02f27 100644
--- a/test/passing/tests/js_to_do.ml.ref
+++ b/test/passing/tests/js_to_do.ml.ref
@@ -14,8 +14,7 @@ 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

From a0c9aaeeda5386cb88b10d3ad63f4ab35abe97fc Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Tue, 7 Nov 2023 09:57:58 +0100
Subject: [PATCH 52/54] Don't trim first line of asterisk prefixed comment

---
 lib/Cmt.ml                              | 38 ++++++++++---------------
 test/passing/tests/wrap_comments.ml     | 12 ++++++++
 test/passing/tests/wrap_comments.ml.err | 14 ++++-----
 test/passing/tests/wrap_comments.ml.ref | 12 ++++++++
 4 files changed, 46 insertions(+), 30 deletions(-)

diff --git a/lib/Cmt.ml b/lib/Cmt.ml
index b35ebfb759..5798f51f09 100644
--- a/lib/Cmt.ml
+++ b/lib/Cmt.ml
@@ -98,22 +98,24 @@ type decoded = {prefix: string; suffix: string; kind: decoded_kind}
     indentation to trim. *)
 let unindent_lines ?(max_indent = Stdlib.max_int) ~content_offset first_line
     tl_lines =
-  (* The indentation of the first line must account for the location of the
-     comment opening. Don't account for the first line if it's empty. *)
-  let fl_spaces, fl_indent =
-    match String.indent_of_line first_line with
-    | 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
+  let tl_indent =
+    List.fold_left ~init:max_indent
       ~f:(fun acc s ->
         Option.value_map ~default:acc ~f:(min acc) (String.indent_of_line s) )
       tl_lines
   in
-  (* Completely trim the first line *)
-  String.drop_prefix first_line fl_spaces
+  (* The indentation of the first line must account for the location of the
+     comment opening. Don't account for the first line if it's empty.
+     [fl_trim] is the number of characters to remove from the first line. *)
+  let fl_trim, fl_indent =
+    match String.indent_of_line first_line with
+    | Some i ->
+        (max 0 (min i (tl_indent - content_offset)), i + content_offset - 1)
+    | None -> (String.length first_line, max_indent)
+  in
+  let min_indent = min tl_indent fl_indent in
+  let first_line = String.drop_prefix first_line fl_trim in
+  first_line
   :: List.map ~f:(fun s -> String.drop_prefix s min_indent) tl_lines
 
 let unindent_lines ?max_indent ~content_offset txt =
@@ -174,18 +176,8 @@ let decode_comment ~parse_comments_as_doc txt loc =
           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. *)
-        let prefix =
-          if
-            String.starts_with_whitespace txt
-            && not (is_all_whitespace (List.hd_exn lines))
-          then " "
-          else ""
-        in
         match split_asterisk_prefixed lines with
-        | Some deprefixed_lines ->
-            mk ~prefix (Asterisk_prefixed deprefixed_lines)
+        | Some deprefixed_lines -> mk (Asterisk_prefixed deprefixed_lines)
         | None -> mk (Normal txt) )
   else
     match txt with
diff --git a/test/passing/tests/wrap_comments.ml b/test/passing/tests/wrap_comments.ml
index 0632cc50e5..f2002adf0d 100644
--- a/test/passing/tests/wrap_comments.ml
+++ b/test/passing/tests/wrap_comments.ml
@@ -70,6 +70,12 @@ let _ =
       *)
     a
 
+(*   1
+ * + 2
+ * ---
+ *   3
+ *)
+
 [@@@ocamlformat "wrap-comments=false"]
 
 type t =
@@ -245,3 +251,9 @@ let _ =
       (* foo
       *)
     a
+
+(*   1
+ * + 2
+ * ---
+ *   3
+ *)
diff --git a/test/passing/tests/wrap_comments.ml.err b/test/passing/tests/wrap_comments.ml.err
index 22d75f70b4..ed65e4c631 100644
--- a/test/passing/tests/wrap_comments.ml.err
+++ b/test/passing/tests/wrap_comments.ml.err
@@ -1,19 +1,19 @@
-Warning: tests/wrap_comments.ml:53 exceeds the margin
-Warning: tests/wrap_comments.ml:178 exceeds the margin
-Warning: tests/wrap_comments.ml:179 exceeds the margin
-Warning: tests/wrap_comments.ml:180 exceeds the margin
+Warning: tests/wrap_comments.ml:59 exceeds the margin
 Warning: tests/wrap_comments.ml:184 exceeds the margin
 Warning: tests/wrap_comments.ml:185 exceeds the margin
 Warning: tests/wrap_comments.ml:186 exceeds the margin
-Warning: tests/wrap_comments.ml:189 exceeds the margin
 Warning: tests/wrap_comments.ml:190 exceeds the margin
 Warning: tests/wrap_comments.ml:191 exceeds the margin
+Warning: tests/wrap_comments.ml:192 exceeds the margin
+Warning: tests/wrap_comments.ml:195 exceeds the margin
 Warning: tests/wrap_comments.ml:196 exceeds the margin
 Warning: tests/wrap_comments.ml:197 exceeds the margin
-Warning: tests/wrap_comments.ml:198 exceeds the margin
 Warning: tests/wrap_comments.ml:202 exceeds the margin
 Warning: tests/wrap_comments.ml:203 exceeds the margin
 Warning: tests/wrap_comments.ml:204 exceeds the margin
-Warning: tests/wrap_comments.ml:207 exceeds the margin
 Warning: tests/wrap_comments.ml:208 exceeds the margin
 Warning: tests/wrap_comments.ml:209 exceeds the margin
+Warning: tests/wrap_comments.ml:210 exceeds the margin
+Warning: tests/wrap_comments.ml:213 exceeds the margin
+Warning: tests/wrap_comments.ml:214 exceeds the margin
+Warning: tests/wrap_comments.ml:215 exceeds the margin
diff --git a/test/passing/tests/wrap_comments.ml.ref b/test/passing/tests/wrap_comments.ml.ref
index 91de5455c2..2f2be32386 100644
--- a/test/passing/tests/wrap_comments.ml.ref
+++ b/test/passing/tests/wrap_comments.ml.ref
@@ -47,6 +47,12 @@ let _ =
 
 let _ = f (* foo *) a
 
+(*   1
+ * + 2
+ * ---
+ *   3
+ *)
+
 [@@@ocamlformat "wrap-comments=false"]
 
 type t =
@@ -213,3 +219,9 @@ let _ =
 
 let _ = f (* foo
       *) a
+
+(*   1
+ * + 2
+ * ---
+ *   3
+ *)

From 5f5532ec42009133898759f4fc3d974320e7ca81 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Tue, 7 Nov 2023 10:02:04 +0100
Subject: [PATCH 53/54] Add test case from #2469

---
 test/passing/tests/cinaps.ml     | 17 +++++++++++++++++
 test/passing/tests/cinaps.ml.ref | 17 +++++++++++++++++
 2 files changed, 34 insertions(+)

diff --git a/test/passing/tests/cinaps.ml b/test/passing/tests/cinaps.ml
index e5e14331be..b91fbcf39e 100644
--- a/test/passing/tests/cinaps.ml
+++ b/test/passing/tests/cinaps.ml
@@ -57,3 +57,20 @@ let foo = foo
     ["+"; "-"; "*"; "/"]
 *)
 (*$*)
+
+(*$
+  (*
+     x
+  *)
+*)
+(*$*)
+
+(*$
+  let _ =
+    [ x (*
+        *)
+    ; y
+    ]
+  ;;
+*)
+(*$*)
diff --git a/test/passing/tests/cinaps.ml.ref b/test/passing/tests/cinaps.ml.ref
index 71fc3755f2..7644d35977 100644
--- a/test/passing/tests/cinaps.ml.ref
+++ b/test/passing/tests/cinaps.ml.ref
@@ -59,3 +59,20 @@ let foo = foo
     ["+"; "-"; "*"; "/"]
 *)
 (*$*)
+
+(*$
+  (*
+     x
+  *)
+*)
+(*$*)
+
+(*$
+  let _ =
+    [ x (*
+        *)
+    ; y
+    ]
+  ;;
+*)
+(*$*)

From 86e12c3c6fe88aeb0330a6e36a22a9399150f0ee Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Tue, 7 Nov 2023 10:15:22 +0100
Subject: [PATCH 54/54] test: Fix spacing in cinaps.ml

Consecutive comments with no empty line in between are not formatted.
---
 test/passing/tests/cinaps.ml     |  5 +++++
 test/passing/tests/cinaps.ml.err |  2 +-
 test/passing/tests/cinaps.ml.ref | 20 +++++++-------------
 3 files changed, 13 insertions(+), 14 deletions(-)

diff --git a/test/passing/tests/cinaps.ml b/test/passing/tests/cinaps.ml
index b91fbcf39e..34e45a43b0 100644
--- a/test/passing/tests/cinaps.ml
+++ b/test/passing/tests/cinaps.ml
@@ -15,6 +15,7 @@ let x = 1
     (fun s -> Printf.printf "let ( %s ) = Pervasives.( %s )\n" s s)
     ["+"; "-"; "*"; "/"]
 *)
+
 (*$*)
 let y = 2
 
@@ -35,6 +36,7 @@ let x = 1
   (* foooooooo *)
   z
 $*)
+
 (*$*)
 
 let foo = foo
@@ -56,6 +58,7 @@ let foo = foo
     (fun s -> Printf.printf "let ( %s ) = Pervasives.( %s )\n" s s)
     ["+"; "-"; "*"; "/"]
 *)
+
 (*$*)
 
 (*$
@@ -63,6 +66,7 @@ let foo = foo
      x
   *)
 *)
+
 (*$*)
 
 (*$
@@ -73,4 +77,5 @@ let foo = foo
     ]
   ;;
 *)
+
 (*$*)
diff --git a/test/passing/tests/cinaps.ml.err b/test/passing/tests/cinaps.ml.err
index 6c128b0f94..bd76194c26 100644
--- a/test/passing/tests/cinaps.ml.err
+++ b/test/passing/tests/cinaps.ml.err
@@ -1 +1 @@
-Warning: tests/cinaps.ml:24 exceeds the margin
+Warning: tests/cinaps.ml:25 exceeds the margin
diff --git a/test/passing/tests/cinaps.ml.ref b/test/passing/tests/cinaps.ml.ref
index 7644d35977..4c1d150e85 100644
--- a/test/passing/tests/cinaps.ml.ref
+++ b/test/passing/tests/cinaps.ml.ref
@@ -15,6 +15,7 @@ let x = 1
     (fun s -> Printf.printf "let ( %s ) = Pervasives.( %s )\n" s s)
     ["+"; "-"; "*"; "/"]
 *)
+
 (*$*)
 let y = 2
 
@@ -37,6 +38,7 @@ let x = 1
   (* foooooooo *)
   z
 $*)
+
 (*$*)
 
 let foo = foo
@@ -58,21 +60,13 @@ let foo = foo
     (fun s -> Printf.printf "let ( %s ) = Pervasives.( %s )\n" s s)
     ["+"; "-"; "*"; "/"]
 *)
+
 (*$*)
 
-(*$
-  (*
-     x
-  *)
-*)
+(*$ (* x *) *)
+
 (*$*)
 
-(*$
-  let _ =
-    [ x (*
-        *)
-    ; y
-    ]
-  ;;
-*)
+(*$ let _ = [x (* *); y] *)
+
 (*$*)