Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Represent 'let f _ = function' in the CST #2596

Merged
merged 22 commits into from
Oct 24, 2024
Merged
Show file tree
Hide file tree
Changes from 1 commit
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
Prev Previous commit
Next Next commit
fmt
  • Loading branch information
Julow committed Oct 23, 2024
commit a3602e6be427ef5d5184559adae5a06707d421f5
118 changes: 64 additions & 54 deletions lib/Ast.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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 _
Expand All @@ -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 _)
Expand Down Expand Up @@ -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

Expand Down Expand Up @@ -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]. *)
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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, _)
Expand Down Expand Up @@ -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
Expand Down
49 changes: 24 additions & 25 deletions lib/Fmt_ast.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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 =
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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 _
Expand All @@ -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 =
Expand Down Expand Up @@ -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 "(" ")"
Expand Down Expand Up @@ -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)
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down
34 changes: 21 additions & 13 deletions lib/Params.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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 "| "
Expand Down Expand Up @@ -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
Expand Down
3 changes: 2 additions & 1 deletion lib/Params.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
Loading