Skip to content

Commit

Permalink
generate better asts for function bindings
Browse files Browse the repository at this point in the history
Currently:

```ocaml
let foo1 : _ = function () -> ()
let foo2 x : _ = function () -> ()
```

are parsed into these value_bindings:

```ocaml
  (* foo1 *)
  { pvb_args = []
  ; pvb_constraint = Some "_"
  ; pvb_body = Pfunction_cases ...
  }
  (* foo2 *)
  { pvb_args = ["x"]
  ; pvb_constraint = Some "_"
  ; pvb_body = Pfunction_cases ...
  }
```

I expect instead:

```ocaml
  (* foo1 *)
  { pvb_args = []
  ; pvb_constraint = Some "_"
  ; pvb_body = Pfunction_body (Pexp_function ([], None, Pfunction_cases ...))
  }
  (* foo2 (no changes here) *)
  { pvb_args = ["x"]
  ; pvb_constraint = Some "_"
  ; pvb_body = Pfunction_cases ...
  }
```

I think the ast for foo1:

- is confusing
- creates a needless distinction between
  `let f : _ = function () -> ()` vs `let f : _ = (function () -> ())`,
  unlike, say, `1 + function () -> ()` vs `1 + (function () -> ())`.
- is essentially an invariant violation. The type of value_bindings
  in ocamlformat should be understood to be the union of a non-function
  let-binding + an inline pexp_function node.
  But the node for foo1 corresponds to the syntax of neither a non-function
  let-binding (because of body = Pfunction_cases _), nor an inline
  pexp_function (because pexp_function can't have a type_constraint with
  an empty list of params).
  • Loading branch information
v-gb committed Feb 11, 2025
1 parent 2a071f8 commit 75ff311
Show file tree
Hide file tree
Showing 7 changed files with 26 additions and 21 deletions.
3 changes: 3 additions & 0 deletions CHANGES.md
Original file line number Diff line number Diff line change
Expand Up @@ -14,6 +14,9 @@ profile. This started with version 0.26.0.

- Fixed `nested-match=align` not working with `match%ext` (#2648, @EmileTrotignon)

- Fixed the AST generated for bindings of the form `let pattern : type = function ...`
(#2651, @v-gb)

## 0.27.0

### Highlight
Expand Down
12 changes: 9 additions & 3 deletions lib/Fmt_ast.ml
Original file line number Diff line number Diff line change
Expand Up @@ -4586,9 +4586,15 @@ and fmt_value_binding c ~ctx0 ~rec_flag ?in_ ?epi
in
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 (_, _, _); _}
match (lb_args, lb_body.ast) with
| _, Pfunction_cases _
|( []
, Pfunction_body
{ pexp_attributes= []
; pexp_desc= Pexp_function ([], None, 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)
Expand Down
3 changes: 1 addition & 2 deletions test/passing/refs.janestreet/let_binding-deindent-fun.ml.ref
Original file line number Diff line number Diff line change
Expand Up @@ -306,8 +306,7 @@ fun xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx : _ ->
match () with
| _ -> ()

let _
=
let _ =
(*
An alternative would be to track 'mutability of the field'
directly.
Expand Down
3 changes: 1 addition & 2 deletions test/passing/refs.janestreet/let_binding-in_indent.ml.ref
Original file line number Diff line number Diff line change
Expand Up @@ -306,8 +306,7 @@ fun xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx : _ ->
match () with
| _ -> ()

let _
=
let _ =
(*
An alternative would be to track 'mutability of the field'
directly.
Expand Down
3 changes: 1 addition & 2 deletions test/passing/refs.janestreet/let_binding-indent.ml.ref
Original file line number Diff line number Diff line change
Expand Up @@ -306,8 +306,7 @@ fun xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx : _ ->
match () with
| _ -> ()

let _
=
let _ =
(*
An alternative would be to track 'mutability of the field'
directly.
Expand Down
3 changes: 1 addition & 2 deletions test/passing/refs.janestreet/let_binding.ml.ref
Original file line number Diff line number Diff line change
Expand Up @@ -306,8 +306,7 @@ fun xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx : _ ->
match () with
| _ -> ()

let _
=
let _ =
(*
An alternative would be to track 'mutability of the field'
directly.
Expand Down
20 changes: 10 additions & 10 deletions vendor/parser-extended/parser.mly
Original file line number Diff line number Diff line change
Expand Up @@ -2619,30 +2619,30 @@ let_binding_body_no_punning:
let_ident strict_binding(fun_body)
{ let args, tc, exp = $2 in
($1, args, tc, exp) }
| let_ident type_constraint EQUAL fun_body
| let_ident type_constraint EQUAL seq_expr
{ let v = $1 in (* PR#7344 *)
let t =
match $2 with
Pconstraint t ->
Pvc_constraint { locally_abstract_univars = []; typ=t }
| Pcoerce (ground, coercion) -> Pvc_coercion { ground; coercion}
in
(v, [], Some t, $4)
(v, [], Some t, Pfunction_body $4)
}
| let_ident COLON poly(core_type) EQUAL fun_body
| let_ident COLON poly(core_type) EQUAL seq_expr
{
let t = ghtyp ~loc:($loc($3)) $3 in
($1, [], Some (Pvc_constraint { locally_abstract_univars = []; typ=t }), $5)
($1, [], Some (Pvc_constraint { locally_abstract_univars = []; typ=t }), Pfunction_body $5)
}
| let_ident COLON TYPE lident_list DOT core_type EQUAL fun_body
| let_ident COLON TYPE lident_list DOT core_type EQUAL seq_expr
{ let constraint' =
Pvc_constraint { locally_abstract_univars=$4; typ = $6}
in
($1, [], Some constraint', $8) }
| pattern_no_exn EQUAL fun_body
{ ($1, [], None, $3) }
| simple_pattern_not_ident COLON core_type EQUAL fun_body
{ ($1, [], Some(Pvc_constraint { locally_abstract_univars=[]; typ=$3 }), $5) }
($1, [], Some constraint', Pfunction_body $8) }
| pattern_no_exn EQUAL seq_expr
{ ($1, [], None, Pfunction_body $3) }
| simple_pattern_not_ident COLON core_type EQUAL seq_expr
{ ($1, [], Some(Pvc_constraint { locally_abstract_univars=[]; typ=$3 }), Pfunction_body $5) }
;
let_binding_body:
| let_binding_body_no_punning
Expand Down

0 comments on commit 75ff311

Please sign in to comment.