diff --git a/CHANGES.md b/CHANGES.md index 0f2a70ab84..2cf1cdb585 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -4,6 +4,26 @@ Items marked with an asterisk (\*) are changes that are likely to format existing code differently from the previous release when using the default profile. This started with version 0.26.0. +## unreleased + +### Fixed + +- Fix JSX elements closed directly before `|]` in array literals (e.g. + `[|
aa
|]`) and before `}` in record/braced expressions (e.g. + `{x =
a
}`), which previously failed to parse because the + lexer read `>|]` as the `>|` operator followed by `]`, and `>}` as the + single object-override closer token, instead of giving the `>` back to + close the JSX tag. + +- Fix object types whose opening `<` is not followed by a space before + the first method name (e.g. ``), which previously failed to + parse because the lexer read `` is + unaffected. + ## 0.29.0 ### Highlight diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml index 0ffc06143f..9392ab235f 100644 --- a/lib/Fmt_ast.ml +++ b/lib/Fmt_ast.ml @@ -2990,6 +2990,12 @@ and fmt_expression c ?(box = true) ?(pro = noop) ?eol ?parens pcstr_fields $ fmt_atrs ) ) | Pexp_override l -> ( + (* a bare [>] comparison in an override field is ambiguous with the closer, so force parens *) + let is_bare_greater_comparison f = + match f.pexp_desc with + | Pexp_infix ({txt= ">"; _}, _, _) -> true + | _ -> false + in let fmt_field ({txt; loc}, f) = let eol = break 1 3 in let txt = Longident.lident txt in @@ -2999,9 +3005,11 @@ and fmt_expression c ?(box = true) ?(pro = noop) ?eol ?parens && List.is_empty f.pexp_attributes -> Cmts.fmt c ~eol loc @@ fmt_longident c txt' | _ -> + let force_parens = is_bare_greater_comparison f in Cmts.fmt c ~eol loc @@ fmt_longident c txt $ str " = " - $ fmt_expression c (sub_exp ~ctx f) + $ Params.parens_if force_parens c.conf + (fmt_expression c (sub_exp ~ctx f)) in match l with | [] -> diff --git a/test/mlx/mlx.t b/test/mlx/mlx.t index 864da17933..d793baa3d9 100644 --- a/test/mlx/mlx.t +++ b/test/mlx/mlx.t @@ -290,6 +290,60 @@ JSX with infix operators: $ echo 'let _ = ()' | fmt let _ = +JSX element closed directly before "|]" in an array literal, or before "}" in a record/braced expression: + $ echo 'let _ = [|
aa
|]' | fmt + let _ = [|
aa
|] + $ echo 'let _ = [|
aa
;
bb
|]' | fmt + let _ = [|
aa
;
bb
|] + $ echo 'let _ = [
aa
]' | fmt + let _ = [
aa
] + + $ echo 'let _ = {x =
a
}' | fmt + let _ = { x =
a
} + $ echo 'let _ = {x =
a
; y = 1}' | fmt + let _ = { x =
a
; y = 1 } + $ echo 'let r = {r with x =
a
}' | fmt + let r = { r with x =
a
} + +Object override still parses and formats stably, both spaced and unspaced: + $ echo 'let _ = object val x = 1 method m = {< x = 2 >} end' | fmt + let _ = + object + val x = 1 + method m = {} + end + $ echo 'let _ = object val x = 1 method m = {} end' | fmt + let _ = + object + val x = 1 + method m = {} + end + +An override field ending in an unparenthesized ">" comparison stays parenthesized so it re-parses: + $ echo 'let _ = object val x = true method m = {< x = (1 > 2) >} end' | fmt + let _ = + object + val x = true + method m = { 2)>} + end + $ echo 'let _ = object val x = true val y = 1 method m = {< x = (1 > 2); y = 5 >} end' | fmt + let _ = + object + val x = true + val y = 1 + method m = { 2); y = 5>} + end + +">|" still lexes as an ordinary operator everywhere else: + $ echo 'let (>|) a b = a + > let _ = 1>|2' | fmt + let ( >| ) a b = a + let _ = 1 >| 2 + $ echo 'let (>|) a b = a + > let _ = [|1>|2|]' | fmt + let ( >| ) a b = a + let _ = [| 1 >| 2 |] + Raw identifiers in JSX: $ echo 'let _ = <\#lazy />' | fmt let _ = <\#lazy /> @@ -329,3 +383,25 @@ regular applications: let _ = App.createElement ~children:[] ~children:[] () [@JSX] $ echo 'let _ = (((get_component ()) ~children:[] ()) [@JSX])' | fmt let _ = (get_component ()) ~children:[] () [@JSX] + +Object types whose opening "<" is not followed by a space: + $ echo 'let f (x : ) = x#m' | fmt + let f (x : < m : int >) = x#m + $ echo 'let f (x : ) = x#m' | fmt + let f (x : < m : int ; n : float >) = x#m + $ echo "let f (x : 'a>) = x#m" | fmt + let f (x : < m : 'a. 'a -> 'a >) = x#m + $ echo 'let f : -> unit = fun _ -> ()' | fmt + let f : < m : int > -> unit = fun _ -> () + +Regression guards: the spaced form, "< .. >", and the JSX expression form must keep working: + $ echo 'let f (x : < m : int >) = x#m' | fmt + let f (x : < m : int >) = x#m + $ echo 'let f (x : < .. >) = x' | fmt + let f (x : < .. >) = x + $ echo 'let f = ' | fmt + let f = + +Idempotency check: + $ echo 'let f (x : ) = x#m' | fmt | fmt + let f (x : < m : int >) = x#m diff --git a/vendor/parser-extended/dune b/vendor/parser-extended/dune index 5ffb0dd0e4..58fc950af5 100644 --- a/vendor/parser-extended/dune +++ b/vendor/parser-extended/dune @@ -31,6 +31,8 @@ EOL --unused-token GREATERRBRACKET + --unused-token + GREATERRBRACE --fixed-exception --table --strategy diff --git a/vendor/parser-extended/lexer.mll b/vendor/parser-extended/lexer.mll index ad661aa8d7..a7c6d2a839 100644 --- a/vendor/parser-extended/lexer.mll +++ b/vendor/parser-extended/lexer.mll @@ -747,7 +747,22 @@ rule token = parse | ">" { GREATER } | "/>" { SLASHGREATER } | "}" { RBRACE } - | ">}" { GREATERRBRACE } + | ">}" + { (* the dialect gives ">" back so the closing "}" lexes separately as RBRACE *) + lexbuf.Lexing.lex_curr_pos <- lexbuf.Lexing.lex_start_pos + 1; + let lex_start_p = lexbuf.lex_start_p in + lexbuf.lex_curr_p <- + { lex_start_p with pos_cnum = lex_start_p.pos_cnum + 1 }; + GREATER + } + | ">|]" + { (* the dialect gives ">" back so the closing "|]" lexes separately as BARRBRACKET *) + lexbuf.Lexing.lex_curr_pos <- lexbuf.Lexing.lex_start_pos + 1; + let lex_start_p = lexbuf.lex_start_p in + lexbuf.lex_curr_p <- + { lex_start_p with pos_cnum = lex_start_p.pos_cnum + 1 }; + GREATER + } | "[@" { LBRACKETAT } | "[@@" { LBRACKETATAT } | "[@@@" { LBRACKETATATAT } diff --git a/vendor/parser-extended/parser.mly b/vendor/parser-extended/parser.mly index 99b09f35ce..9ed6c0fd9e 100644 --- a/vendor/parser-extended/parser.mly +++ b/vendor/parser-extended/parser.mly @@ -2655,17 +2655,17 @@ simple_expr: { Pexp_prefix($1, $2) } | op(BANG {"!"}) simple_expr { Pexp_prefix($1, $2) } - | LBRACELESS object_expr_content GREATERRBRACE + | LBRACELESS object_expr_content GREATER RBRACE { Pexp_override $2 } | LBRACELESS object_expr_content error { unclosed "{<" $loc($1) ">}" $loc($3) } - | LBRACELESS GREATERRBRACE + | LBRACELESS GREATER RBRACE { Pexp_override [] } | simple_expr DOT mkrhs(label_longident) { Pexp_field($1, $3) } | od=open_dot_declaration DOT LPAREN seq_expr RPAREN { Pexp_open(od, $4) } - | od=open_dot_declaration DOT LBRACELESS object_expr_content GREATERRBRACE + | od=open_dot_declaration DOT LBRACELESS object_expr_content GREATER RBRACE { (* TODO: review the location of Pexp_override *) Pexp_open(od, mkexp ~loc:$sloc (Pexp_override $4)) } | mod_longident DOT LBRACELESS object_expr_content error @@ -3949,6 +3949,9 @@ object_type: { let (f, c) = meth_list in Ptyp_object (f, c) } | LESS GREATER { Ptyp_object ([], OClosed) } + (* [mlx]: a type context can never contain JSX, so a lexer-fused "<" + first-label token can be reinterpreted as the opening "<" of an object type *) + | meth_list = meth_list_jsx GREATER + { let (f, c) = meth_list in Ptyp_object (f, c) } ) { $1 } ; @@ -4051,27 +4054,36 @@ opt_ampersand: ; (* A method list (in an object type). *) meth_list: - head = field_semi tail = meth_list + head = field_semi(mkrhs(label)) tail = meth_list | head = inherit_field SEMI tail = meth_list { let (f, c) = tail in (head :: f, c) } - | head = field_semi + | head = field_semi(mkrhs(label)) | head = inherit_field SEMI { [head], OClosed } - | head = field + | head = field(mkrhs(label)) | head = inherit_field { [head], OClosed } | DOTDOT { [], OOpen (make_loc $sloc) } ; -%inline field: - mkrhs(label) COLON poly_type_no_attr attributes +(* [mlx]: same as [meth_list], but starting from a fused "<" + first-label JSX_LIDENT token instead of a separately-lexed [label] *) +meth_list_jsx: + head = field_semi(jsx_first_label) tail = meth_list + { let (f, c) = tail in (head :: f, c) } + | head = field_semi(jsx_first_label) + { [head], OClosed } + | head = field(jsx_first_label) + { [head], OClosed } +; +%inline field(label): + label COLON poly_type_no_attr attributes { let info = symbol_info $endpos in let attrs = add_info_attrs info $4 in Of.tag ~loc:(make_loc $sloc) ~attrs $1 $3 } ; -%inline field_semi: - mkrhs(label) COLON poly_type_no_attr attributes SEMI attributes +%inline field_semi(label): + label COLON poly_type_no_attr attributes SEMI attributes { let info = match rhs_info $endpos($4) with | Some _ as info_before_semi -> info_before_semi @@ -4080,6 +4092,10 @@ meth_list: let attrs = add_info_attrs info ($4 @ $6) in Of.tag ~loc:(make_loc $sloc) ~attrs $1 $3 } ; +(* [mlx]: the fused "<" + first-method-name JSX_LIDENT token, reinterpreted as an object-type label *) +%inline jsx_first_label: + name = JSX_LIDENT { mkrhs name $sloc } +; %inline inherit_field: ty = atomic_type diff --git a/vendor/parser-standard/dune b/vendor/parser-standard/dune index 67979f5b34..fc9364d74e 100644 --- a/vendor/parser-standard/dune +++ b/vendor/parser-standard/dune @@ -31,6 +31,8 @@ EOL --unused-token GREATERRBRACKET + --unused-token + GREATERRBRACE --fixed-exception --table --strategy diff --git a/vendor/parser-standard/lexer.mll b/vendor/parser-standard/lexer.mll index 04d1b531d2..27b95b9ceb 100644 --- a/vendor/parser-standard/lexer.mll +++ b/vendor/parser-standard/lexer.mll @@ -738,7 +738,22 @@ rule token = parse | ">" { GREATER } | "/>" { SLASHGREATER } | "}" { RBRACE } - | ">}" { GREATERRBRACE } + | ">}" + { (* the dialect gives ">" back so the closing "}" lexes separately as RBRACE *) + lexbuf.Lexing.lex_curr_pos <- lexbuf.Lexing.lex_start_pos + 1; + let lex_start_p = lexbuf.lex_start_p in + lexbuf.lex_curr_p <- + { lex_start_p with pos_cnum = lex_start_p.pos_cnum + 1 }; + GREATER + } + | ">|]" + { (* the dialect gives ">" back so the closing "|]" lexes separately as BARRBRACKET *) + lexbuf.Lexing.lex_curr_pos <- lexbuf.Lexing.lex_start_pos + 1; + let lex_start_p = lexbuf.lex_start_p in + lexbuf.lex_curr_p <- + { lex_start_p with pos_cnum = lex_start_p.pos_cnum + 1 }; + GREATER + } | "[@" { LBRACKETAT } | "[@@" { LBRACKETATAT } | "[@@@" { LBRACKETATATAT } diff --git a/vendor/parser-standard/parser.mly b/vendor/parser-standard/parser.mly index 4cd56a3bbe..2d20e7a0e7 100644 --- a/vendor/parser-standard/parser.mly +++ b/vendor/parser-standard/parser.mly @@ -2624,17 +2624,17 @@ simple_expr: { Pexp_apply($1, [Nolabel,$2]) } | op(BANG {"!"}) simple_expr { Pexp_apply($1, [Nolabel,$2]) } - | LBRACELESS object_expr_content GREATERRBRACE + | LBRACELESS object_expr_content GREATER RBRACE { Pexp_override $2 } | LBRACELESS object_expr_content error { unclosed "{<" $loc($1) ">}" $loc($3) } - | LBRACELESS GREATERRBRACE + | LBRACELESS GREATER RBRACE { Pexp_override [] } | simple_expr DOT mkrhs(label_longident) { Pexp_field($1, $3) } | od=open_dot_declaration DOT LPAREN seq_expr RPAREN { Pexp_struct_item(Str.open_ od, $4) } - | od=open_dot_declaration DOT LBRACELESS object_expr_content GREATERRBRACE + | od=open_dot_declaration DOT LBRACELESS object_expr_content GREATER RBRACE { (* TODO: review the location of Pexp_override *) Pexp_struct_item(Str.open_ od, mkexp ~loc:$sloc (Pexp_override $4)) } | mod_longident DOT LBRACELESS object_expr_content error @@ -3904,6 +3904,9 @@ object_type: { let (f, c) = meth_list in Ptyp_object (f, c) } | LESS GREATER { Ptyp_object ([], Closed) } + (* [mlx]: a type context can never contain JSX, so a lexer-fused "<" + first-label token can be reinterpreted as the opening "<" of an object type *) + | meth_list = meth_list_jsx GREATER + { let (f, c) = meth_list in Ptyp_object (f, c) } ) { $1 } ; @@ -4006,27 +4009,36 @@ opt_ampersand: ; (* A method list (in an object type). *) meth_list: - head = field_semi tail = meth_list + head = field_semi(mkrhs(label)) tail = meth_list | head = inherit_field SEMI tail = meth_list { let (f, c) = tail in (head :: f, c) } - | head = field_semi + | head = field_semi(mkrhs(label)) | head = inherit_field SEMI { [head], Closed } - | head = field + | head = field(mkrhs(label)) | head = inherit_field { [head], Closed } | DOTDOT { [], Open } ; -%inline field: - mkrhs(label) COLON poly_type_no_attr attributes +(* [mlx]: same as [meth_list], but starting from a fused "<" + first-label JSX_LIDENT token instead of a separately-lexed [label] *) +meth_list_jsx: + head = field_semi(jsx_first_label) tail = meth_list + { let (f, c) = tail in (head :: f, c) } + | head = field_semi(jsx_first_label) + { [head], Closed } + | head = field(jsx_first_label) + { [head], Closed } +; +%inline field(label): + label COLON poly_type_no_attr attributes { let info = symbol_info $endpos in let attrs = add_info_attrs info $4 in Of.tag ~loc:(make_loc $sloc) ~attrs $1 $3 } ; -%inline field_semi: - mkrhs(label) COLON poly_type_no_attr attributes SEMI attributes +%inline field_semi(label): + label COLON poly_type_no_attr attributes SEMI attributes { let info = match rhs_info $endpos($4) with | Some _ as info_before_semi -> info_before_semi @@ -4035,6 +4047,10 @@ meth_list: let attrs = add_info_attrs info ($4 @ $6) in Of.tag ~loc:(make_loc $sloc) ~attrs $1 $3 } ; +(* [mlx]: the fused "<" + first-method-name JSX_LIDENT token, reinterpreted as an object-type label *) +%inline jsx_first_label: + name = JSX_LIDENT { mkrhs name $sloc } +; %inline inherit_field: ty = atomic_type