fmt

Julow · Julow · commit a3602e6be427 · 2024-10-23T15:51:43.000+02:00
diff --git a/lib/Ast.ml b/lib/Ast.ml
@@ -1208,13 +1208,13 @@ end = struct
     in
     let check_cases = List.exists ~f:(fun c -> c.pc_lhs == pat) in
     let check_binding {pvb_pat; pvb_body; _} =
-          check_subpat pvb_pat || match pvb_body with
-          | Pfunction_body _ -> false
-                                | Pfunction_cases (cases, _, _) ->
-        check_cases cases in
-    let check_bindings l =
-      List.exists l ~f:check_binding
+      check_subpat pvb_pat
+      ||
+      match pvb_body with
+      | Pfunction_body _ -> false
+      | Pfunction_cases (cases, _, _) -> check_cases cases
     in
+    let check_bindings l = List.exists l ~f:check_binding in
     let check_param_val (_, _, p) = p == pat in
     let check_expr_function_param param =
       match param.pparam_desc with
@@ -1389,7 +1389,8 @@ end = struct
             assert (check_cases cases)
         | Pexp_function (params, _, body) ->
             assert (
-              List.exists ~f:check_expr_function_param params || check_fun_body body )
+              List.exists ~f:check_expr_function_param params
+              || check_fun_body body )
         | Pexp_indexop_access {pia_lhs; pia_kind= Builtin idx; pia_rhs; _} ->
             assert (
               pia_lhs == exp || idx == exp
@@ -1927,10 +1928,11 @@ end = struct
         | Ppat_or _ | Ppat_alias _ ) ) ->
         true
     | Bo {pbop_typ= Some _; _}, (Ppat_any | Ppat_tuple _) -> true
-    | Exp {pexp_desc= (Pexp_function (_, _, Pfunction_body _)); _}, Ppat_or _
+    | Exp {pexp_desc= Pexp_function (_, _, Pfunction_body _); _}, Ppat_or _
      |( Exp {pexp_desc= Pexp_function (_, _, Pfunction_body _); _}
       , ( Ppat_construct _ | Ppat_cons _ | Ppat_lazy _ | Ppat_tuple _
-        | Ppat_variant _ ) ) -> true
+        | Ppat_variant _ ) ) ->
+        true
     | _, Ppat_constraint _
      |_, Ppat_unpack _
      |( Pat
@@ -1944,8 +1946,7 @@ end = struct
                 ( Ppat_construct _ | Ppat_exception _ | Ppat_or _
                 | Ppat_lazy _ | Ppat_tuple _ | Ppat_variant _ | Ppat_list _ )
             ; _ }
-        | Exp {pexp_desc= Pexp_function (_, _, Pfunction_body _); _}
-        )
+        | Exp {pexp_desc= Pexp_function (_, _, Pfunction_body _); _} )
       , Ppat_alias _ )
      |( Pat {ppat_desc= Ppat_lazy _; _}
       , ( Ppat_construct _ | Ppat_cons _
@@ -1966,8 +1967,7 @@ end = struct
      |Cl {pcl_desc= Pcl_fun _; _}, Ppat_construct _
      |Cl {pcl_desc= Pcl_fun _; _}, Ppat_alias _
      |Cl {pcl_desc= Pcl_fun _; _}, Ppat_lazy _
-     |(Exp {pexp_desc= Pexp_letop _; _} | Bo _), Ppat_exception _
-                      ->
+     |(Exp {pexp_desc= Pexp_letop _; _} | Bo _), Ppat_exception _ ->
         true
     | (Str _ | Exp _ | Lb _), Ppat_lazy _ -> true
     | ( (Fpe _ | Fpc _)
@@ -1995,14 +1995,14 @@ end = struct
         true
     | _ -> false
 
-  (* Whether an expression in a let binding shouldn't be parenthesed, bypassing
-     the other Ast rules. *)
+  (* Whether an expression in a let binding shouldn't be parenthesed,
+     bypassing the other Ast rules. *)
   let dont_parenze_exp_in_bindings bindings exp =
     match exp.pexp_desc with
     | Pexp_function ([], None, (Pfunction_cases _ as fun_body)) ->
         (* [fun_body] is the body of the let binding and shouldn't be
-           parenthesed. [exp] is a synthetic expression constructed in
-           the formatting code. *)
+           parenthesed. [exp] is a synthetic expression constructed in the
+           formatting code. *)
         List.exists bindings ~f:(fun {pvb_body; _} -> pvb_body == fun_body)
     | _ -> false
 
@@ -2170,16 +2170,19 @@ end = struct
   (* Whether to parenze an expr on the RHS of a let binding.
      [dont_parenze_exp_in_bindings] must have been checked before. *)
   and parenze_exp_in_bindings bindings exp =
-        List.exists bindings ~f:(fun {pvb_body; pvb_args; _} ->
-              match pvb_body with
-                | Pfunction_body ({pexp_desc = Pexp_function ([],None,Pfunction_cases _);_} as let_body) when let_body == exp ->
-                  (* Function with cases and no 'fun' keyword is in the body of
-                     a binding, parentheses are needed if the binding also
-                     defines arguments. *)
-                  not (List.is_empty pvb_args)
-                | Pfunction_cases (cases,_,_) -> parenze_exp_in_match_case cases exp
-              | _ -> false
-          )
+    List.exists bindings ~f:(fun {pvb_body; pvb_args; _} ->
+        match pvb_body with
+        | Pfunction_body
+            ( {pexp_desc= Pexp_function ([], None, Pfunction_cases _); _} as
+              let_body )
+          when let_body == exp ->
+            (* Function with cases and no 'fun' keyword is in the body of a
+               binding, parentheses are needed if the binding also defines
+               arguments. *)
+            not (List.is_empty pvb_args)
+        | Pfunction_cases (cases, _, _) ->
+            parenze_exp_in_match_case cases exp
+        | _ -> false )
 
   (** [parenze_exp {ctx; ast}] holds when expression [ast] should be
       parenthesized in context [ctx]. *)
@@ -2235,18 +2238,19 @@ end = struct
     ||
     match (ctx, exp) with
     | Str {pstr_desc= Pstr_eval _; _}, _ -> false
-    | ( Lb pvb, _) when dont_parenze_exp_in_bindings [pvb] exp -> false
-    | ( Exp {pexp_desc=Pexp_let ({ pvbs_bindings; _ }, _, _);_}, _)
-    | ( Cl {pcl_desc= Pcl_let ({ pvbs_bindings; _ }, _,_);_}, _)
+    | Lb pvb, _ when dont_parenze_exp_in_bindings [pvb] exp -> false
+    | Exp {pexp_desc= Pexp_let ({pvbs_bindings; _}, _, _); _}, _
+     |Cl {pcl_desc= Pcl_let ({pvbs_bindings; _}, _, _); _}, _
       when dont_parenze_exp_in_bindings pvbs_bindings exp ->
         false
-    | ( Lb pvb, _) when parenze_exp_in_bindings [pvb] exp ->
-        true
-    | ( Exp {pexp_desc=Pexp_let ({ pvbs_bindings; _ }, _, _);_}, _)
-    | ( Cl {pcl_desc= Pcl_let ({ pvbs_bindings; _ }, _,_);_}, _)
+    | Lb pvb, _ when parenze_exp_in_bindings [pvb] exp -> true
+    | Exp {pexp_desc= Pexp_let ({pvbs_bindings; _}, _, _); _}, _
+     |Cl {pcl_desc= Pcl_let ({pvbs_bindings; _}, _, _); _}, _
       when parenze_exp_in_bindings pvbs_bindings exp ->
         true
-    | _, {pexp_desc= Pexp_infix _; pexp_attributes= _ :: _; _} when ctx_sensitive_to_trailing_attributes ctx -> true
+    | _, {pexp_desc= Pexp_infix _; pexp_attributes= _ :: _; _}
+      when ctx_sensitive_to_trailing_attributes ctx ->
+        true
     | ( Str
           { pstr_desc=
               Pstr_value
@@ -2336,24 +2340,27 @@ end = struct
       , {pexp_desc= Pexp_function ([], None, Pfunction_cases _); _} )
       when e == exp ->
         true
-    | Exp {pexp_desc=
-       Pexp_extension
-          ( _
-          , PStr
-              [ { pstr_desc=
-                    Pstr_eval
-                      ( { pexp_desc=
-                            ( Pexp_function
-                                (_, _, Pfunction_cases (cases, _, _))
-                            | Pexp_match (_, cases)
-                            | Pexp_try (_, cases) )
-                        ; _ }
-                      , _ )
-                ; _ } ] )
-       |Pexp_function (_, _, Pfunction_cases (cases, _, _))
-       |Pexp_match (_, cases)
-       |Pexp_try (_, cases)
-             ; _}, _ -> parenze_exp_in_match_case cases exp
+    | ( Exp
+          { pexp_desc=
+              ( Pexp_extension
+                  ( _
+                  , PStr
+                      [ { pstr_desc=
+                            Pstr_eval
+                              ( { pexp_desc=
+                                    ( Pexp_function
+                                        (_, _, Pfunction_cases (cases, _, _))
+                                    | Pexp_match (_, cases)
+                                    | Pexp_try (_, cases) )
+                                ; _ }
+                              , _ )
+                        ; _ } ] )
+              | Pexp_function (_, _, Pfunction_cases (cases, _, _))
+              | Pexp_match (_, cases)
+              | Pexp_try (_, cases) )
+          ; _ }
+      , _ ) ->
+        parenze_exp_in_match_case cases exp
     | Exp {pexp_desc; _}, _ -> (
       match pexp_desc with
       | Pexp_ifthenelse (eN, _)
@@ -2417,7 +2424,10 @@ end = struct
         | _ -> Exp.has_trailing_attributes exp || parenze () ) )
     | _, {pexp_desc= Pexp_list _; _} -> false
     | _, {pexp_desc= Pexp_array _; _} -> false
-    | _, exp when ctx_sensitive_to_trailing_attributes ctx && Exp.has_trailing_attributes exp -> true
+    | _, exp
+      when ctx_sensitive_to_trailing_attributes ctx
+           && Exp.has_trailing_attributes exp ->
+        true
     | _ -> false
 
   (** [parenze_cl {ctx; ast}] holds when class expr [ast] should be
diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
@@ -1256,8 +1256,7 @@ and fmt_pattern ?ext c ?pro ?parens ?(box = false)
               $ close_box )
         $ fmt_or nested
             (fits_breaks (if parens then ")" else "") ~hint:(1, 2) ")")
-            (fits_breaks (if parens then ")" else "") "")
-      )
+            (fits_breaks (if parens then ")" else "") "") )
   | Ppat_constraint (pat, typ) ->
       hvbox 2
         (Params.parens_if parens c.conf
@@ -1539,8 +1538,8 @@ and fmt_function ?(last_arg = false) ?force_closing_paren ~ctx ~ctx0
             if Params.Exp.function_attrs_sp c.conf ~ctx0 ~ctx then Some Blank
             else None
           in
-          Cmts.fmt_before c function_loc $
-          str "function"
+          Cmts.fmt_before c function_loc
+          $ str "function"
           $ fmt_extension_suffix c ext
           $ fmt_attributes ?pre c spilled_attrs
           $ fmt_attributes ?pre c cs_attrs
@@ -2074,7 +2073,8 @@ and fmt_expression c ?(box = true) ?(pro = noop) ?eol ?parens
             ; _ }
           when not (Std_longident.is_infix id) ->
             has_attr && parens
-        | Lb {pvb_body=Pfunction_body body;_} when phys_equal body exp -> has_attr && parens
+        | Lb {pvb_body= Pfunction_body body; _} when phys_equal body exp ->
+            has_attr && parens
         | _ -> has_attr && not parens
       in
       let infix_op_args =
@@ -2389,14 +2389,14 @@ and fmt_expression c ?(box = true) ?(pro = noop) ?eol ?parens
       in
       let fmt_expr = fmt_expression c (sub_exp ~ctx body) in
       pro
-      $ fmt_let_bindings c ~ctx0:ctx ~parens ~fmt_atrs ~fmt_expr ~has_attr ~loc_in
-          lbs.pvbs_rec bindings body
+      $ fmt_let_bindings c ~ctx0:ctx ~parens ~fmt_atrs ~fmt_expr ~has_attr
+          ~loc_in lbs.pvbs_rec bindings body
   | Pexp_letop {let_; ands; body; loc_in} ->
       let bd = Sugar.Let_binding.of_binding_ops (let_ :: ands) in
       let fmt_expr = fmt_expression c (sub_exp ~ctx body) in
       pro
-      $ fmt_let_bindings c ~ctx0:ctx ~parens ~fmt_atrs ~fmt_expr ~has_attr ~loc_in
-          Nonrecursive bd body
+      $ fmt_let_bindings c ~ctx0:ctx ~parens ~fmt_atrs ~fmt_expr ~has_attr
+          ~loc_in Nonrecursive bd body
   | Pexp_letexception (ext_cstr, exp) ->
       let pre =
         str "let exception" $ fmt_extension_suffix c ext $ space_break
@@ -2864,8 +2864,8 @@ and fmt_expression c ?(box = true) ?(pro = noop) ?eol ?parens
              (sub_exp ~ctx e) )
       $ fmt_atrs
 
-and fmt_let_bindings c ~ctx0 ~parens ~has_attr ~fmt_atrs ~fmt_expr ~loc_in rec_flag
-    bindings body =
+and fmt_let_bindings c ~ctx0 ~parens ~has_attr ~fmt_atrs ~fmt_expr ~loc_in
+    rec_flag bindings body =
   let indent_after_in =
     match body.pexp_desc with
     | Pexp_let _ | Pexp_letmodule _
@@ -2882,8 +2882,8 @@ and fmt_let_bindings c ~ctx0 ~parens ~has_attr ~fmt_atrs ~fmt_expr ~loc_in rec_f
         0
     | _ -> c.conf.fmt_opts.indent_after_in.v
   in
-  fmt_let c ~ctx0 ~rec_flag ~bindings ~parens ~has_attr ~fmt_atrs ~fmt_expr ~loc_in
-    ~body_loc:body.pexp_loc ~indent_after_in
+  fmt_let c ~ctx0 ~rec_flag ~bindings ~parens ~has_attr ~fmt_atrs ~fmt_expr
+    ~loc_in ~body_loc:body.pexp_loc ~indent_after_in
 
 and fmt_class_structure c ~ctx ?ext self_ fields =
   let update_config c i =
@@ -3055,8 +3055,8 @@ and fmt_class_expr c ({ast= exp; ctx= ctx0} as xexp) =
       in
       let fmt_expr = fmt_class_expr c (sub_cl ~ctx body) in
       let has_attr = not (List.is_empty pcl_attributes) in
-      fmt_let c ~ctx0:ctx ~rec_flag:lbs.pvbs_rec ~bindings ~parens ~loc_in ~has_attr
-        ~fmt_atrs ~fmt_expr ~body_loc:body.pcl_loc ~indent_after_in
+      fmt_let c ~ctx0:ctx ~rec_flag:lbs.pvbs_rec ~bindings ~parens ~loc_in
+        ~has_attr ~fmt_atrs ~fmt_expr ~body_loc:body.pcl_loc ~indent_after_in
   | Pcl_constraint (e, t) ->
       hvbox 2
         (wrap_fits_breaks ~space:false c.conf "(" ")"
@@ -4525,7 +4525,7 @@ and fmt_value_constraint c vc_opt =
   | None -> (noop, noop)
 
 and fmt_value_binding c ~ctx0 ~rec_flag ?in_ ?epi
-      {lb_op; lb_pat; lb_args; lb_typ; lb_body; lb_attrs; lb_loc; lb_pun} =
+    {lb_op; lb_pat; lb_args; lb_typ; lb_body; lb_attrs; lb_loc; lb_pun} =
   let in_, loc_in =
     match in_ with
     | None -> (None, None)
@@ -4552,10 +4552,9 @@ and fmt_value_binding c ~ctx0 ~rec_flag ?in_ ?epi
   let fmt_newtypes, fmt_cstr = fmt_value_constraint c lb_typ in
   let indent, intro_as_pro =
     match lb_body.ast with
-    | Pfunction_cases _ ->
-        (c.conf.fmt_opts.function_indent.v, true)
-    | Pfunction_body { pexp_desc = Pexp_function (_, _, _); _ } when c.conf.fmt_opts.let_binding_deindent_fun.v
-      ->
+    | Pfunction_cases _ -> (c.conf.fmt_opts.function_indent.v, true)
+    | Pfunction_body {pexp_desc= Pexp_function (_, _, _); _}
+      when c.conf.fmt_opts.let_binding_deindent_fun.v ->
         (max (c.conf.fmt_opts.let_binding_indent.v - 1) 0, false)
     | _ -> (c.conf.fmt_opts.let_binding_indent.v, false)
   in
@@ -4608,15 +4607,15 @@ and fmt_value_binding c ~ctx0 ~rec_flag ?in_ ?epi
             let wrap_intro intro =
               hovbox 2 (fmt_opt pro $ intro) $ space_break
             in
-            fmt_function ~ctx ~ctx0 ~wrap_intro ?box ~label:Nolabel ~attrs:[] ~loc:lb_loc c ([], None, body)
-        | Pfunction_body body -> fmt_expression c ?pro ?box (sub_exp ~ctx body)
+            fmt_function ~ctx ~ctx0 ~wrap_intro ?box ~label:Nolabel ~attrs:[]
+              ~loc:lb_loc c ([], None, body)
+        | Pfunction_body body ->
+            fmt_expression c ?pro ?box (sub_exp ~ctx body)
       in
       let pro =
         if c.conf.fmt_opts.ocp_indent_compat.v then
           let box =
-            match lb_body.ast with
-            | Pfunction_cases _ -> false
-            | _ -> true
+            match lb_body.ast with Pfunction_cases _ -> false | _ -> true
           in
           hvbox_if box 2 (decl $ fits_breaks " =" ~hint:(1000, 0) "=")
           $ space_break
diff --git a/lib/Params.ml b/lib/Params.ml
@@ -358,24 +358,28 @@ end
 
 (* Whether [pat] appears in [ctx] as a match/function/try case. *)
 let get_or_pattern_is_nested ~ctx pat =
-  let check_cases =List.exists ~f:(fun c -> phys_equal c.pc_lhs pat) in
+  let check_cases = List.exists ~f:(fun c -> phys_equal c.pc_lhs pat) in
   match ctx with
   | _ when not (List.is_empty pat.ppat_attributes) -> true
-  | Ast.Exp {pexp_desc= Pexp_function (_,_,Pfunction_cases (cases,_,_)) | Pexp_match (_,cases) | Pexp_try (_,cases); _}
-  | Lb {pvb_body=Pfunction_cases (cases,_,_);_} ->
+  | Ast.Exp
+      { pexp_desc=
+          ( Pexp_function (_, _, Pfunction_cases (cases, _, _))
+          | Pexp_match (_, cases)
+          | Pexp_try (_, cases) )
+      ; _ }
+   |Lb {pvb_body= Pfunction_cases (cases, _, _); _} ->
       not (check_cases cases)
-  | Exp {pexp_desc= Pexp_let (bindings, _,_); _}
-  | Cl {pcl_desc= Pcl_let (bindings, _,_); _}
-  | Str {pstr_desc= Pstr_value (bindings); _}
-    ->
-      not (List.exists bindings.pvbs_bindings ~f:(function
-          |{pvb_body=Pfunction_cases (cases,_,_);_} -> check_cases cases
-          | _ -> false
-        ))
+  | Exp {pexp_desc= Pexp_let (bindings, _, _); _}
+   |Cl {pcl_desc= Pcl_let (bindings, _, _); _}
+   |Str {pstr_desc= Pstr_value bindings; _} ->
+      not
+        (List.exists bindings.pvbs_bindings ~f:(function
+          | {pvb_body= Pfunction_cases (cases, _, _); _} -> check_cases cases
+          | _ -> false ))
   | _ -> true
 
 let get_or_pattern_sep ?(cmts_before = false) ?(space = false) (c : Conf.t)
-      ~nested =
+    ~nested =
   let nspaces = if cmts_before then 1000 else 1 in
   match c.fmt_opts.break_cases.v with
   | _ when nested -> break nspaces 0 $ str "| "
@@ -411,7 +415,11 @@ let get_cases (c : Conf.t) ~ctx ~first ~last ~cmts_before
   let indent =
     match (c.fmt_opts.cases_matching_exp_indent.v, (ctx, ast.pexp_desc)) with
     | ( `Compact
-      , (( Exp {pexp_desc= Pexp_function _ | Pexp_match _ | Pexp_try _ | Pexp_let _; _} | Lb {pvb_body = Pfunction_cases _;_})
+      , ( ( Exp
+              { pexp_desc=
+                  Pexp_function _ | Pexp_match _ | Pexp_try _ | Pexp_let _
+              ; _ }
+          | Lb {pvb_body= Pfunction_cases _; _} )
         , (Pexp_match _ | Pexp_try _ | Pexp_beginend _) ) ) ->
         2
     | _, _ -> c.fmt_opts.cases_exp_indent.v
diff --git a/lib/Params.mli b/lib/Params.mli
@@ -103,8 +103,9 @@ module Pcty : sig
   val break_let_open : Conf.t -> rhs:class_type -> Fmt.t
 end
 
-(** Whether an or-pattern should be disambiguated. *)
 val get_or_pattern_is_nested : ctx:Ast.t -> pattern -> bool
+(** Whether an or-pattern should be disambiguated. *)
+
 val get_or_pattern_sep :
   ?cmts_before:bool -> ?space:bool -> Conf.t -> nested:bool -> Fmt.t
 
