Try alternative formatting

ocaml-ppx · Sep 18, 2023 · 6230e01 · 6230e01
1 parent 10d2912
commit 6230e01
Show file tree

Hide file tree

Showing 10 changed files with 66 additions and 91 deletions.
diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
@@ -4286,24 +4286,23 @@ and fmt_value_binding c ~rec_flag ?ext ?in_ ?epi
   in
   let doc1, atrs = doc_atrs lb_attrs in
   let doc2, atrs = doc_atrs atrs in
-  let fmt_cstr =
+  let fmt_newtypes, fmt_cstr =
     let fmt_sep x =
       match c.conf.fmt_opts.break_colon.v with
       | `Before -> fmt "@ " $ str x $ char ' '
       | `After -> char ' ' $ str x $ fmt "@ "
     in
     match lb_typ with
     | `Polynewtype (pvars, xtyp) ->
-        fmt_sep ":"
-        $ hvbox 0
-            ( str "type "
-            $ list pvars " " (fmt_str_loc c)
-            $ fmt ".@ " $ fmt_core_type c xtyp )
+        ( fmt_sep ":"
+          $ hvbox 0 (str "type " $ list pvars " " (fmt_str_loc c) $ str ".")
+        , fmt "@ " $ fmt_core_type c xtyp )
     | `Coerce (xtyp1, xtyp2) ->
-        opt xtyp1 (fun xtyp1 -> fmt_sep ":" $ fmt_core_type c xtyp1)
-        $ fmt_sep ":>" $ fmt_core_type c xtyp2
-    | `Other xtyp -> fmt_type_cstr c xtyp
-    | `None -> noop
+        ( noop
+        , opt xtyp1 (fun xtyp1 -> fmt_sep ":" $ fmt_core_type c xtyp1)
+          $ fmt_sep ":>" $ fmt_core_type c xtyp2 )
+    | `Other xtyp -> (noop, fmt_type_cstr c xtyp)
+    | `None -> (noop, noop)
   in
   let indent =
     match lb_exp.ast.pexp_desc with
@@ -4357,7 +4356,8 @@ and fmt_value_binding c ~rec_flag ?ext ?in_ ?epi
                                   (not (List.is_empty lb_args))
                                   ( fmt "@ "
                                   $ wrap_fun_decl_args c
-                                      (fmt_fun_args c lb_args) ) )
+                                      (fmt_fun_args c lb_args) )
+                              $ fmt_newtypes )
                           $ fmt_cstr )
                       $ fmt_if_k (not lb_pun)
                           (fmt_or_k c.conf.fmt_opts.ocp_indent_compat.v

diff --git a/lib/box_debug.ml b/lib/box_debug.ml
@@ -120,8 +120,7 @@ let _pp_format_lit fs =
   | Escaped_percent -> fprintf fs "@@%%"
   | Scan_indic c -> pp_keyword fs ("@" ^ String.make 1 c)
 
-let rec _format_string :
-    type a b c d e f.
+let rec _format_string : type a b c d e f.
     _ -> (a, b, c, d, e, f) CamlinternalFormatBasics.fmt -> unit =
   let open CamlinternalFormatBasics in
   fun fs -> function

diff --git a/test/passing/tests/break_colon-before.ml.ref b/test/passing/tests/break_colon-before.ml.ref
@@ -77,8 +77,8 @@ let ssmap
     -> unit =
   ()
 
-let long_function_name
-    : type a. a long_long_type -> a -> a -> a -> wrap_wrap_wrap -> unit =
+let long_function_name : type a.
+    a long_long_type -> a -> a -> a -> wrap_wrap_wrap -> unit =
  fun () -> ()
 
 let array_fold_transf (f : numbering -> 'a -> numbering * 'b) n (a : 'a array)

diff --git a/test/passing/tests/break_colon.ml b/test/passing/tests/break_colon.ml
@@ -76,8 +76,8 @@ let ssmap :
     -> unit =
   ()
 
-let long_function_name :
-    type a. a long_long_type -> a -> a -> a -> wrap_wrap_wrap -> unit =
+let long_function_name : type a.
+    a long_long_type -> a -> a -> a -> wrap_wrap_wrap -> unit =
  fun () -> ()
 
 let array_fold_transf (f : numbering -> 'a -> numbering * 'b) n (a : 'a array)

diff --git a/test/passing/tests/js_source.ml.err b/test/passing/tests/js_source.ml.err
@@ -1,5 +1,5 @@
 Warning: tests/js_source.ml:155 exceeds the margin
-Warning: tests/js_source.ml:9522 exceeds the margin
-Warning: tests/js_source.ml:9625 exceeds the margin
-Warning: tests/js_source.ml:9684 exceeds the margin
-Warning: tests/js_source.ml:9766 exceeds the margin
+Warning: tests/js_source.ml:9514 exceeds the margin
+Warning: tests/js_source.ml:9617 exceeds the margin
+Warning: tests/js_source.ml:9676 exceeds the margin
+Warning: tests/js_source.ml:9758 exceeds the margin
diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp
@@ -1156,9 +1156,8 @@ let rec eq_sel : type a b c. (a, b) ty_sel -> (a, c) ty_sel -> (b, c) eq option
 ;;
 
 (* Auxiliary function to get the type of a case from its selector *)
-let rec get_case
-  : type a b e.
-    (b, a) ty_sel -> (string * (e, b) ty_case) list -> string * (a, e) ty option
+let rec get_case : type a b e.
+  (b, a) ty_sel -> (string * (e, b) ty_case) list -> string * (a, e) ty option
   =
   fun sel cases ->
   match cases with
@@ -1266,9 +1265,8 @@ let ty_abc =
     | `B s -> "B", Some (Tdyn (String, s))
     | `C -> "C", None
   (* Define inj in advance to be able to write the type annotation easily *)
-  and inj
-    : type c.
-      (int -> string -> noarg -> unit, c) ty_sel * c -> [ `A of int | `B of string | `C ]
+  and inj : type c.
+    (int -> string -> noarg -> unit, c) ty_sel * c -> [ `A of int | `B of string | `C ]
     = function
       | Thd, v -> `A v
       | Ttl Thd, v -> `B v
@@ -1612,13 +1610,8 @@ let rec plus_func : type a b m n. (a, b, m) plus -> (a, b, n) plus -> (m, n) equ
     Eq
 ;;
 
-let rec plus_assoc
-  : type a b c ab bc m n.
-    (a, b, ab) plus
-    -> (ab, c, m) plus
-    -> (b, c, bc) plus
-    -> (a, bc, n) plus
-    -> (m, n) equal
+let rec plus_assoc : type a b c ab bc m n.
+  (a, b, ab) plus -> (ab, c, m) plus -> (b, c, bc) plus -> (a, bc, n) plus -> (m, n) equal
   =
   fun p1 p2 p3 p4 ->
   match p1, p4 with
@@ -1720,8 +1713,8 @@ let rec elem : type h. int -> h avl -> bool =
   | Node (_, l, y, r) -> x = y || if x < y then elem x l else elem x r
 ;;
 
-let rec rotr
-  : type n. n succ succ avl -> int -> n avl -> (n succ succ avl, n succ succ succ avl) sum
+let rec rotr : type n.
+  n succ succ avl -> int -> n avl -> (n succ succ avl, n succ succ succ avl) sum
   =
   fun tL y tR ->
   match tL with
@@ -1735,8 +1728,8 @@ let rec rotr
     Inl (Node (Same, Node (Same, a, x, b), z, Node (Less, c, y, tR)))
 ;;
 
-let rec rotl
-  : type n. n avl -> int -> n succ succ avl -> (n succ succ avl, n succ succ succ avl) sum
+let rec rotl : type n.
+  n avl -> int -> n succ succ avl -> (n succ succ avl, n succ succ succ avl) sum
   =
   fun tL u tR ->
   match tR with
@@ -2234,8 +2227,8 @@ let rec subst : type m1 r t s. (m1, r, t) lam -> (r, s) sub -> (s, t) lam' =
 type closed = rnil
 type 'a rlam = ((pexp, closed, 'a) lam, (pval, closed, 'a) lam) sum
 
-let rec rule
-  : type a b. (pval, closed, (a, b) tarr) lam -> (pval, closed, a) lam -> b rlam
+let rec rule : type a b.
+  (pval, closed, (a, b) tarr) lam -> (pval, closed, a) lam -> b rlam
   =
   fun v1 v2 ->
   match v1, v2 with
@@ -8603,9 +8596,8 @@ type v =
   | F
   | G
 
-let f
-  : type a b c d e f g.
-    a t * b t * c t * d t * e t * f t * g t * v * (a, b, c, d) u * (e, f, g, g) u -> int
+let f : type a b c d e f g.
+  a t * b t * c t * d t * e t * f t * g t * v * (a, b, c, d) u * (e, f, g, g) u -> int
   = function
     | A, A, A, A, A, A, A, _, U, U -> 1
     | _, _, _, _, _, _, _, G, _, _ -> 1

diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref
@@ -1156,9 +1156,8 @@ let rec eq_sel : type a b c. (a, b) ty_sel -> (a, c) ty_sel -> (b, c) eq option
 ;;
 
 (* Auxiliary function to get the type of a case from its selector *)
-let rec get_case
-  : type a b e.
-    (b, a) ty_sel -> (string * (e, b) ty_case) list -> string * (a, e) ty option
+let rec get_case : type a b e.
+  (b, a) ty_sel -> (string * (e, b) ty_case) list -> string * (a, e) ty option
   =
   fun sel cases ->
   match cases with
@@ -1266,9 +1265,8 @@ let ty_abc =
     | `B s -> "B", Some (Tdyn (String, s))
     | `C -> "C", None
   (* Define inj in advance to be able to write the type annotation easily *)
-  and inj
-    : type c.
-      (int -> string -> noarg -> unit, c) ty_sel * c -> [ `A of int | `B of string | `C ]
+  and inj : type c.
+    (int -> string -> noarg -> unit, c) ty_sel * c -> [ `A of int | `B of string | `C ]
     = function
     | Thd, v -> `A v
     | Ttl Thd, v -> `B v
@@ -1612,13 +1610,8 @@ let rec plus_func : type a b m n. (a, b, m) plus -> (a, b, n) plus -> (m, n) equ
     Eq
 ;;
 
-let rec plus_assoc
-  : type a b c ab bc m n.
-    (a, b, ab) plus
-    -> (ab, c, m) plus
-    -> (b, c, bc) plus
-    -> (a, bc, n) plus
-    -> (m, n) equal
+let rec plus_assoc : type a b c ab bc m n.
+  (a, b, ab) plus -> (ab, c, m) plus -> (b, c, bc) plus -> (a, bc, n) plus -> (m, n) equal
   =
   fun p1 p2 p3 p4 ->
   match p1, p4 with
@@ -1720,8 +1713,8 @@ let rec elem : type h. int -> h avl -> bool =
   | Node (_, l, y, r) -> x = y || if x < y then elem x l else elem x r
 ;;
 
-let rec rotr
-  : type n. n succ succ avl -> int -> n avl -> (n succ succ avl, n succ succ succ avl) sum
+let rec rotr : type n.
+  n succ succ avl -> int -> n avl -> (n succ succ avl, n succ succ succ avl) sum
   =
   fun tL y tR ->
   match tL with
@@ -1735,8 +1728,8 @@ let rec rotr
     Inl (Node (Same, Node (Same, a, x, b), z, Node (Less, c, y, tR)))
 ;;
 
-let rec rotl
-  : type n. n avl -> int -> n succ succ avl -> (n succ succ avl, n succ succ succ avl) sum
+let rec rotl : type n.
+  n avl -> int -> n succ succ avl -> (n succ succ avl, n succ succ succ avl) sum
   =
   fun tL u tR ->
   match tR with
@@ -2234,8 +2227,8 @@ let rec subst : type m1 r t s. (m1, r, t) lam -> (r, s) sub -> (s, t) lam' =
 type closed = rnil
 type 'a rlam = ((pexp, closed, 'a) lam, (pval, closed, 'a) lam) sum
 
-let rec rule
-  : type a b. (pval, closed, (a, b) tarr) lam -> (pval, closed, a) lam -> b rlam
+let rec rule : type a b.
+  (pval, closed, (a, b) tarr) lam -> (pval, closed, a) lam -> b rlam
   =
   fun v1 v2 ->
   match v1, v2 with
@@ -8603,9 +8596,8 @@ type v =
   | F
   | G
 
-let f
-  : type a b c d e f g.
-    a t * b t * c t * d t * e t * f t * g t * v * (a, b, c, d) u * (e, f, g, g) u -> int
+let f : type a b c d e f g.
+  a t * b t * c t * d t * e t * f t * g t * v * (a, b, c, d) u * (e, f, g, g) u -> int
   = function
   | A, A, A, A, A, A, A, _, U, U -> 1
   | _, _, _, _, _, _, _, G, _, _ -> 1

diff --git a/test/passing/tests/ocp_indent_compat.ml b/test/passing/tests/ocp_indent_compat.ml
@@ -84,8 +84,8 @@ let ssmap
   =
   ()
 
-let long_function_name
-    : type a. a long_long_type -> a -> a -> a -> wrap_wrap_wrap -> unit
+let long_function_name : type a.
+    a long_long_type -> a -> a -> a -> wrap_wrap_wrap -> unit
   =
  fun () -> ()
 
@@ -147,6 +147,6 @@ let to_clambda_function (id, (function_decl : Flambda.function_declaration))
      various closures in the set. Such closures will always be ... *)
   x
 
-let long_function_name :
-    type a. a long_long_type -> a -> a -> a -> wrap_wrap_wrap -> unit =
+let long_function_name : type a.
+    a long_long_type -> a -> a -> a -> wrap_wrap_wrap -> unit =
  fun () -> ()
diff --git 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:2311 exceeds the margin
diff --git a/test/passing/tests/source.ml.ref b/test/passing/tests/source.ml.ref
@@ -1206,8 +1206,8 @@ type _ ty_env =
 (* 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 =
+let rec eq_sel : type a b c.
+    (a, b) ty_sel -> (a, c) ty_sel -> (b, c) eq option =
  fun s1 s2 ->
   match (s1, s2) with
   | Thd, Thd -> Some Eq
@@ -1216,8 +1216,7 @@ let rec eq_sel :
   | _ -> None
 
 (* Auxiliary function to get the type of a case from its selector *)
-let rec get_case :
-    type a b e.
+let rec get_case : type a b e.
        (b, a) ty_sel
     -> (string * (e, b) ty_case) list
     -> string * (a, e) ty option =
@@ -1312,8 +1311,7 @@ let ty_abc =
     | `B s -> ("B", Some (Tdyn (String, s)))
     | `C -> ("C", None)
   (* Define inj in advance to be able to write the type annotation easily *)
-  and inj :
-      type c.
+  and inj : type c.
          (int -> string -> noarg -> unit, c) ty_sel * c
       -> [`A of int | `B of string | `C] = function
     | Thd, v -> `A v
@@ -1560,9 +1558,8 @@ type (_, _) tree =
 
 let tree1 = Tfork (Tfork (Ttip, Tnode 4), Tfork (Tnode 4, Tnode 3))
 
-let rec find :
-    type sh. ('a -> 'a -> bool) -> 'a -> (sh, 'a) tree -> (sh, 'a) path list
-    =
+let rec find : type sh.
+    ('a -> 'a -> bool) -> 'a -> (sh, 'a) tree -> (sh, 'a) path list =
  fun eq n t ->
   match t with
   | Ttip -> []
@@ -1623,17 +1620,16 @@ let rec sameNat : type a b. a nat -> b nat -> (a, b) equal option =
 
 (* Extra: associativity of addition *)
 
-let rec plus_func :
-    type a b m n. (a, b, m) plus -> (a, b, n) plus -> (m, n) equal =
+let rec plus_func : type a b m n.
+    (a, b, m) plus -> (a, b, n) plus -> (m, n) equal =
  fun p1 p2 ->
   match (p1, p2) with
   | PlusZ _, PlusZ _ -> Eq
   | PlusS p1', PlusS p2' ->
       let Eq = plus_func p1' p2' in
       Eq
 
-let rec plus_assoc :
-    type a b c ab bc m n.
+let rec plus_assoc : type a b c ab bc m n.
        (a, b, ab) plus
     -> (ab, c, m) plus
     -> (b, c, bc) plus
@@ -1724,8 +1720,7 @@ let rec elem : type h. int -> h avl -> bool =
   | Leaf -> false
   | Node (_, l, y, r) -> x = y || if x < y then elem x l else elem x r
 
-let rec rotr :
-    type n.
+let rec rotr : type n.
        n succ succ avl
     -> int
     -> n avl
@@ -1741,8 +1736,7 @@ let rec rotr :
   | Node (Less, a, x, Node (More, b, z, c)) ->
       Inl (Node (Same, Node (Same, a, x, b), z, Node (Less, c, y, tR)))
 
-let rec rotl :
-    type n.
+let rec rotl : type n.
        n avl
     -> int
     -> n succ succ avl
@@ -2223,8 +2217,7 @@ type closed = rnil
 
 type 'a rlam = ((pexp, closed, 'a) lam, (pval, closed, 'a) lam) sum
 
-let rec rule :
-    type a b.
+let rec rule : type a b.
     (pval, closed, (a, b) tarr) lam -> (pval, closed, a) lam -> b rlam =
  fun v1 v2 ->
   match (v1, v2) with
@@ -8370,8 +8363,7 @@ type (_, _, _, _) u = U : (int, int, int, int) u
 
 type v = E | F | G
 
-let f :
-    type a b c d e f g.
+let f : type a b c d e f g.
        a t
        * b t
        * c t