Merge branch 'MAIN' into pr/2714

Author: Julow

CHANGES.md

@@ -6,6 +6,23 @@ profile. This started with version 0.26.0.
 
 ## unreleased
 
+### Added
+
+- Support for OCaml 5.4 (#2717, #2720, @Julow, @Octachron)
+  OCamlformat now supports OCaml 5.4 syntax.
+  Module packing of the form `((module M) : (module S))` are no longer
+  rewritten to `(module M : S)` because these are now two different syntaxes.
+
+- Added option `module-indent` option (#2711, @HPRIOR) to control the indentation
+  of items within modules. This affects modules and signatures. For example, 
+  module-indent=4:
+  ```ocaml
+  module type M = sig
+      type t
+
+      val f : (string * int) list -> int
+  end
+  ```
 ### Deprecated
 
 - Starting in this release, ocamlformat can use cmdliner >= 2.0.0. When that is
@@ -80,6 +97,9 @@ profile. This started with version 0.26.0.
 - Fix a crash where `type%e nonrec t = t` was formatted as `type nonrec%e t = t`,
   which is invalid syntax. (#2712, @EmileTrotignon)
 
+- Fix commandline parsing being quadratic in the number of arguments 
+  (#2724, @let-def)
+
 ### Changed
 
 - `|> begin`, `~arg:begin`, `begin if`, `lazy begin`, `begin match`,
@@ -1784,3 +1804,4 @@ profile. This started with version 0.26.0.
 ## 0.1 (2017-10-19)
 
 - Initial release.
+

doc/manpage_ocamlformat.mld

@@ -295,6 +295,10 @@ OPTIONS (CODE FORMATTING STYLE)
            the offset of the previous line. The default value is 68. Cannot
            be set in attributes.
 
+       --module-indent=COLS
+           Indentation of items within struct ... end and sig ... end (COLS
+           columns). The default value is 2.
+
        --module-item-spacing={compact|sparse|preserve}
            Spacing between items of structures and signatures. compact will
            not leave open lines between one-liners of similar sorts. sparse

lib/Ast.ml

@@ -61,8 +61,8 @@ let longident_is_simple c x =
   let rec length x =
     match x with
     | Longident.Lident x -> String.length x
-    | Ldot (x, y) -> length x + 1 + String.length y
-    | Lapply (x, y) -> length x + length y + 3
+    | Ldot (x, y) -> length x.txt + 1 + String.length y.txt
+    | Lapply (x, y) -> length x.txt + length y.txt + 3
   in
   longident_fit_margin c (length x)
 
@@ -977,14 +977,16 @@ end = struct
       | Ptyp_alias (t1, _) | Ptyp_poly (_, t1) -> assert (typ == t1)
       | Ptyp_arrow (t, t2) ->
           assert (List.exists t ~f:(fun x -> typ == x.pap_type) || typ == t2)
-      | Ptyp_tuple t1N | Ptyp_constr (_, t1N) -> assert (List.exists t1N ~f)
+      | Ptyp_tuple t1N ->
+          assert (List.exists t1N ~f:(fun x -> x.lte_elt == typ))
+      | Ptyp_constr (_, t1N) -> assert (List.exists t1N ~f)
       | Ptyp_variant (r1N, _, _) ->
           assert (
             List.exists r1N ~f:(function
               | {prf_desc= Rtag (_, _, t1N); _} -> List.exists t1N ~f
               | {prf_desc= Rinherit t1; _} -> typ == t1 ) )
       | Ptyp_open (_, t1) -> assert (t1 == typ)
-      | Ptyp_package (_, it1N, _) -> assert (List.exists it1N ~f:snd_f)
+      | Ptyp_package ptyp -> assert (List.exists ptyp.ppt_cstrs ~f:snd_f)
       | Ptyp_object (fields, _) ->
           assert (
             List.exists fields ~f:(function
@@ -1017,15 +1019,20 @@ end = struct
       match ctx.ppat_desc with
       | Ppat_constraint (_, t1) -> assert (typ == t1)
       | Ppat_extension (_, PTyp t) -> assert (typ == t)
-      | Ppat_unpack (_, Some (_, l, _)) ->
-          assert (List.exists l ~f:(fun (_, t) -> typ == t))
+      | Ppat_unpack (_, Some ptyp) ->
+          assert (List.exists ptyp.ppt_cstrs ~f:(fun (_, t) -> typ == t))
       | Ppat_record (l, _) ->
           assert (List.exists l ~f:(fun (_, t, _) -> Option.exists t ~f))
+      | Ppat_tuple (l, _) ->
+          assert (
+            List.exists l ~f:(function
+              | Lte_constrained_pun x -> x.type_constraint == typ
+              | _ -> false ) )
       | _ -> assert false )
     | Exp ctx -> (
       match ctx.pexp_desc with
-      | Pexp_pack (_, Some (_, it1N, _), _) ->
-          assert (List.exists it1N ~f:snd_f)
+      | Pexp_pack (_, Some ptyp, _) ->
+          assert (List.exists ptyp.ppt_cstrs ~f:snd_f)
       | Pexp_constraint (_, t1)
        |Pexp_coerce (_, None, t1)
        |Pexp_extension (_, PTyp t1) ->
@@ -1039,6 +1046,16 @@ end = struct
                 Option.exists c ~f:check_type_constraint ) )
       | Pexp_let (lbs, _, _) -> assert (check_let_bindings lbs)
       | Pexp_function (_, Some t1, _, _) -> assert (check_type_constraint t1)
+      | Pexp_tuple l ->
+          assert (
+            List.exists l ~f:(function
+              | Lte_constrained_pun
+                  {type_constraint= Pconstraint t | Pcoerce (None, t); _} ->
+                  t == typ
+              | Lte_constrained_pun
+                  {type_constraint= Pcoerce (Some bty, ty); _} ->
+                  typ == bty || typ == ty
+              | _ -> false ) )
       | _ -> assert false )
     | Fpe _ | Fpc _ -> assert false
     | Vc c -> assert (check_value_constraint c)
@@ -1063,7 +1080,7 @@ end = struct
     | Mod ctx -> (
       match ctx.pmod_desc with
       | Pmod_unpack (_, ty1, ty2) ->
-          let f (_, cstrs, _) = List.exists cstrs ~f:(fun (_, x) -> f x) in
+          let f ptyp = List.exists ptyp.ppt_cstrs ~f:snd_f in
           assert (Option.exists ty1 ~f || Option.exists ty2 ~f)
       | _ -> assert false )
     | Sig ctx -> (
@@ -1255,7 +1272,12 @@ end = struct
     | Pat ctx -> (
         let f pI = pI == pat in
         match ctx.ppat_desc with
-        | Ppat_array p1N | Ppat_list p1N | Ppat_tuple p1N | Ppat_cons p1N ->
+        | Ppat_tuple (p1N, _) ->
+            assert (
+              List.exists p1N ~f:(function
+                | Lte_simple s -> f s.lte_elt
+                | _ -> false ) )
+        | Ppat_array p1N | Ppat_list p1N | Ppat_cons p1N ->
             assert (List.exists p1N ~f)
         | Ppat_record (p1N, _) ->
             assert (List.exists p1N ~f:(fun (_, _, x) -> Option.exists x ~f))
@@ -1423,7 +1445,12 @@ end = struct
         | Pexp_apply (e0, e1N) ->
             (* FAIL *)
             assert (e0 == exp || List.exists e1N ~f:snd_f)
-        | Pexp_tuple e1N | Pexp_array e1N | Pexp_list e1N | Pexp_cons e1N ->
+        | Pexp_tuple e1N ->
+            assert (
+              List.exists e1N ~f:(function
+                | Lte_simple te -> te.lte_elt == exp
+                | _ -> false ) )
+        | Pexp_array e1N | Pexp_list e1N | Pexp_cons e1N ->
             assert (List.exists e1N ~f)
         | Pexp_construct (_, e) | Pexp_variant (_, e) ->
             assert (Option.exists e ~f)
@@ -1529,7 +1556,13 @@ end = struct
         && fit_margin c (width xexp)
     | Pexp_construct (_, Some e0) | Pexp_variant (_, Some e0) ->
         Exp.is_trivial e0
-    | Pexp_array e1N | Pexp_list e1N | Pexp_tuple e1N ->
+    | Pexp_tuple e1N ->
+        List.for_all e1N ~f:(function
+          | Lte_pun _ -> true
+          | Lte_constrained_pun _ -> false
+          | Lte_simple lte -> Exp.is_trivial lte.lte_elt )
+        && fit_margin c (width xexp)
+    | Pexp_array e1N | Pexp_list e1N ->
         List.for_all e1N ~f:Exp.is_trivial && fit_margin c (width xexp)
     | Pexp_record (e1N, e0) ->
         Option.for_all e0 ~f:Exp.is_trivial
@@ -1631,8 +1664,9 @@ end = struct
     | {ast= Typ _; _} -> None
     | {ctx= Exp {pexp_desc; _}; ast= Exp exp} -> (
       match pexp_desc with
-      | Pexp_tuple (e0 :: _) ->
+      | Pexp_tuple (Lte_simple {lte_elt= e0; _} :: _) ->
           Some (Comma, if exp == e0 then Left else Right)
+      | Pexp_tuple (_ :: _) -> Some (Comma, Right)
       | Pexp_cons l ->
           Some (ColonColon, if exp == List.last_exn l then Right else Left)
       | Pexp_construct
@@ -1848,6 +1882,9 @@ end = struct
           ( Str {pstr_desc= Pstr_exception _; _}
           | Sig {psig_desc= Psig_exception _; _} ) } ->
         true
+    | { ast= {ptyp_desc= Ptyp_tuple ({lte_label= Some _; _} :: _); _}
+      ; ctx= Typ {ptyp_desc= Ptyp_arrow _; _} } ->
+        true
     | _ -> (
       match ambig_prec (sub_ast ~ctx (Typ typ)) with
       | `Ambiguous -> true
@@ -2039,6 +2076,9 @@ end = struct
     register_reset (fun () -> Hashtbl.clear memo) ;
     memo
 
+  let last_tuple_and_simple f l =
+    match List.last_exn l with Lte_simple l -> f l.lte_elt | _ -> false
+
   (** [exposed cls exp] holds if there is a right-most subexpression of [exp]
       which satisfies [Exp.mem_cls cls] and is not parenthesized. *)
   let rec exposed_right_exp =
@@ -2087,7 +2127,7 @@ end = struct
          |Pexp_try (_, cases, _) ->
             continue (List.last_exn cases).pc_rhs
         | Pexp_apply (_, args) -> continue (snd (List.last_exn args))
-        | Pexp_tuple es -> continue (List.last_exn es)
+        | Pexp_tuple es -> last_tuple_and_simple continue es
         | Pexp_array _ | Pexp_list _ | Pexp_coerce _ | Pexp_constant _
          |Pexp_constraint _
          |Pexp_construct (_, None)
@@ -2168,7 +2208,7 @@ end = struct
       | Pexp_indexop_access {pia_rhs= rhs; _} -> (
         match rhs with Some e -> continue e | None -> false )
       | Pexp_apply (_, args) -> continue (snd (List.last_exn args))
-      | Pexp_tuple es -> continue (List.last_exn es)
+      | Pexp_tuple es -> last_tuple_and_simple continue es
       | Pexp_array _ | Pexp_list _ | Pexp_coerce _ | Pexp_constant _
        |Pexp_constraint _
        |Pexp_construct (_, None)
@@ -2220,7 +2260,7 @@ end = struct
                && Option.value_map ~default:false (prec_ast ctx) ~f:(fun p ->
                    Prec.compare p Apply < 0 ) ->
             true
-        | Pexp_tuple e1N -> List.last_exn e1N == xexp.ast
+        | Pexp_tuple e1N -> last_tuple_and_simple (( == ) xexp.ast) e1N
         | _ -> false
       in
       match ambig_prec (sub_ast ~ctx (Exp exp)) with

lib/Conf.ml

@@ -91,6 +91,7 @@ let conventional_profile from =
   ; match_indent= elt 0
   ; match_indent_nested= elt `Never
   ; max_indent= elt None
+  ; module_indent= elt 2
   ; module_item_spacing= elt `Compact
   ; nested_match= elt `Wrap
   ; ocp_indent_compat= elt false
@@ -160,6 +161,7 @@ let ocamlformat_profile from =
   ; match_indent= elt 0
   ; match_indent_nested= elt `Never
   ; max_indent= elt None
+  ; module_indent= elt 2
   ; module_item_spacing= elt `Sparse
   ; nested_match= elt `Wrap
   ; ocp_indent_compat= elt false
@@ -228,6 +230,7 @@ let janestreet_profile from =
   ; match_indent= elt 0
   ; match_indent_nested= elt `Never
   ; max_indent= elt None
+  ; module_indent= elt 2
   ; module_item_spacing= elt `Compact
   ; nested_match= elt `Wrap
   ; ocp_indent_compat= elt true
@@ -1063,6 +1066,17 @@ module Formatting = struct
       (fun conf elt -> update conf ~f:(fun f -> {f with max_indent= elt}))
       (fun conf -> conf.fmt_opts.max_indent)
 
+  let module_indent =
+    let docv = "COLS" in
+    let doc =
+      "Indentation of items within struct ... end and sig ... end ($(docv) \
+       columns)."
+    in
+    let names = ["module-indent"] in
+    Decl.int ~names ~default ~doc ~docv ~kind
+      (fun conf elt -> update conf ~f:(fun f -> {f with module_indent= elt}))
+      (fun conf -> conf.fmt_opts.module_indent)
+
   let module_item_spacing =
     let doc = "Spacing between items of structures and signatures." in
     let names = ["module-item-spacing"] in
@@ -1344,6 +1358,7 @@ module Formatting = struct
       ; elt match_indent
       ; elt match_indent_nested
       ; elt max_indent
+      ; elt module_indent
       ; elt module_item_spacing
       ; elt nested_match
       ; elt ocp_indent_compat

lib/Conf_t.ml

@@ -99,6 +99,7 @@ type fmt_opts =
   ; match_indent: int elt
   ; match_indent_nested: [`Always | `Auto | `Never] elt
   ; max_indent: int option elt
+  ; module_indent: int elt
   ; module_item_spacing: [`Compact | `Preserve | `Sparse] elt
   ; nested_match: [`Wrap | `Align] elt
   ; ocp_indent_compat: bool elt

lib/Conf_t.mli

@@ -97,6 +97,7 @@ type fmt_opts =
   ; match_indent: int elt
   ; match_indent_nested: [`Always | `Auto | `Never] elt
   ; max_indent: int option elt
+  ; module_indent: int elt
   ; module_item_spacing: [`Compact | `Preserve | `Sparse] elt
   ; nested_match: [`Wrap | `Align] elt
   ; ocp_indent_compat: bool elt  (** Try to indent like ocp-indent *)

lib/Exposed.ml

@@ -15,7 +15,7 @@ module Left = struct
   let rec core_type typ =
     match typ.ptyp_desc with
     | Ptyp_arrow (t :: _, _) -> core_type t.pap_type
-    | Ptyp_tuple l -> core_type (List.hd_exn l)
+    | Ptyp_tuple l -> core_type (List.hd_exn l).lte_elt
     | Ptyp_object _ -> true
     | Ptyp_alias (typ, _) -> core_type typ
     | _ -> false
@@ -29,7 +29,7 @@ module Right = struct
     | {ptyp_desc; _} -> (
       match ptyp_desc with
       | Ptyp_arrow (_, t) -> core_type t
-      | Ptyp_tuple l -> core_type (List.last_exn l)
+      | Ptyp_tuple l -> core_type (List.last_exn l).lte_elt
       | Ptyp_object _ -> true
       | _ -> false )