From 44f40a744ab11c00c8275361ce89f25cf187ca07 Mon Sep 17 00:00:00 2001 From: Andrey Popp <8mayday@gmail.com> Date: Wed, 16 Sep 2026 12:12:18 +0200 Subject: [PATCH 1/3] Fix JSX elements closed directly before |] and } Port of ocaml-mlx/mlx#46 to both vendored parsers: a dedicated `>|]` lexer rule backtracks to give the `>` back so `|]` lexes as BARRBRACKET, and `>}` is stolen the same way with the object-override grammar compensating by closing with GREATER RBRACE. Also fix Pexp_override printing to keep parentheses around a bare `>` comparison used as a field value (any field, not just the last one): dropping them produced output that fails the reparse self-check, since an unparenthesized `a > b` in an override field list is ambiguous with the closing `>` under the new two-token close. Co-Authored-By: Claude Fable 5 --- CHANGES.md | 11 ++++++ lib/Fmt_ast.ml | 17 +++++++- test/mlx/mlx.t | 66 +++++++++++++++++++++++++++++++ vendor/parser-extended/dune | 2 + vendor/parser-extended/lexer.mll | 25 +++++++++++- vendor/parser-extended/parser.mly | 6 +-- vendor/parser-standard/dune | 2 + vendor/parser-standard/lexer.mll | 25 +++++++++++- vendor/parser-standard/parser.mly | 6 +-- 9 files changed, 151 insertions(+), 9 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 0f2a70ab84..0d0e80f473 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -4,6 +4,17 @@ 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. + ## 0.29.0 ### Highlight diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml index 0ffc06143f..c8c699c7e9 100644 --- a/lib/Fmt_ast.ml +++ b/lib/Fmt_ast.ml @@ -2990,6 +2990,19 @@ and fmt_expression c ?(box = true) ?(pro = noop) ?eol ?parens pcstr_fields $ fmt_atrs ) ) | Pexp_override l -> ( + (* The object-override closer is now printed as two tokens, [>] then + [}] (mlx JSX support requires the lexer to be able to give the [>] + back to close a JSX tag directly before [}]). Because the grammar + shares LALR states across every field's value and the closer's + trailing [>], a field whose value is an unparenthesized top-level + [>] comparison is grammatically ambiguous with the closer - + wherever that field sits in the list, not only when it is last; + force parens around such a value so the printed output re-parses. *) + 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 +3012,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..548797a689 100644 --- a/test/mlx/mlx.t +++ b/test/mlx/mlx.t @@ -290,6 +290,72 @@ JSX with infix operators: $ echo 'let _ = ()' | fmt let _ = +JSX element closed directly before "|]" inside an array literal, and +before "}" inside a record/braced expression (regression test for the +lexer treating ">|]" as the ">|" operator followed by "]", and ">}" as a +single GREATERRBRACE token, instead of giving the ">" back to close the +JSX tag): + $ 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, +since the grammar now closes `{< ... >}` with two tokens (GREATER RBRACE) +instead of the single GREATERRBRACE token: + $ 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 + +Splitting ">}" into GREATER RBRACE means the final GREATER of an override +field ending in an unparenthesized comparison is grammatically +indistinguishable from a continued infix ">", both right before the closer +and elsewhere in the field list; the printer keeps such fields parenthesized +so the output still 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 + +Operator sanity: only the exact sequences ">|]" and ">}" are special-cased, +so ">|" still lexes as an ordinary operator everywhere else, including +right before a closing "|]" that isn't immediately preceded by ">": + $ 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 /> 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..34b34f4337 100644 --- a/vendor/parser-extended/lexer.mll +++ b/vendor/parser-extended/lexer.mll @@ -747,7 +747,30 @@ rule token = parse | ">" { GREATER } | "/>" { SLASHGREATER } | "}" { RBRACE } - | ">}" { GREATERRBRACE } + | ">}" + { (* `>}` closes a JSX element directly inside a record/braced + expression (`{x =
}`): give the ">" back to close the tag + and let "}" lex separately as RBRACE. Object override + (`{< ... >}`) still parses because the grammar now closes it + with GREATER RBRACE instead of the single GREATERRBRACE token. *) + 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 + } + | ">|]" + { (* `>|]` closes a JSX element directly inside an array literal + (`[|
|]`): give the ">" back to close the tag and let "|]" + lex separately as BARRBRACKET. An operator like ">|" can never be + legally followed by "]" without parentheses, so nothing legal is + stolen from the operator grammar. *) + 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..bc2e7c4999 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 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..de50392118 100644 --- a/vendor/parser-standard/lexer.mll +++ b/vendor/parser-standard/lexer.mll @@ -738,7 +738,30 @@ rule token = parse | ">" { GREATER } | "/>" { SLASHGREATER } | "}" { RBRACE } - | ">}" { GREATERRBRACE } + | ">}" + { (* `>}` closes a JSX element directly inside a record/braced + expression (`{x =
}`): give the ">" back to close the tag + and let "}" lex separately as RBRACE. Object override + (`{< ... >}`) still parses because the grammar now closes it + with GREATER RBRACE instead of the single GREATERRBRACE token. *) + 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 + } + | ">|]" + { (* `>|]` closes a JSX element directly inside an array literal + (`[|
|]`): give the ">" back to close the tag and let "|]" + lex separately as BARRBRACKET. An operator like ">|" can never be + legally followed by "]" without parentheses, so nothing legal is + stolen from the operator grammar. *) + 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..9ec3fd3036 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 From faaad00f8e2f1953e67c7216a22f4612dc768211 Mon Sep 17 00:00:00 2001 From: Andrey Popp <8mayday@gmail.com> Date: Wed, 16 Sep 2026 12:26:36 +0200 Subject: [PATCH 2/3] Accept object types written without a space after < `(x : )` failed to parse because ``, and expression JSX are covered by regression tests. Co-Authored-By: Claude Fable 5 --- CHANGES.md | 9 +++++++ test/mlx/mlx.t | 25 +++++++++++++++++ vendor/parser-extended/parser.mly | 45 ++++++++++++++++++++++++++----- vendor/parser-standard/parser.mly | 45 ++++++++++++++++++++++++++----- 4 files changed, 110 insertions(+), 14 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 0d0e80f473..2cf1cdb585 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -15,6 +15,15 @@ profile. This started with version 0.26.0. 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/test/mlx/mlx.t b/test/mlx/mlx.t index 548797a689..d8c84f1d7d 100644 --- a/test/mlx/mlx.t +++ b/test/mlx/mlx.t @@ -395,3 +395,28 @@ 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 (the lexer would +otherwise read ") = 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/parser.mly b/vendor/parser-extended/parser.mly index bc2e7c4999..9e8040db7b 100644 --- a/vendor/parser-extended/parser.mly +++ b/vendor/parser-extended/parser.mly @@ -3949,6 +3949,13 @@ 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 when the lexer has + fused "<" with the first method name into a single JSX_LIDENT token + (e.g. because there is no space, as in []), we can + unambiguously reinterpret it as the opening [<] of an object type + followed by its first label. *) + | meth_list = meth_list_jsx GREATER + { let (f, c) = meth_list in Ptyp_object (f, c) } ) { $1 } ; @@ -4051,27 +4058,42 @@ 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 for use right after the lexer has fused + "<" with the first method's name into a single JSX_LIDENT token; the + first field is therefore parsed from that fused token (see + [jsx_first_label]) instead of from a separately-lexed [label]. Only the + field productions are needed here (not [inherit_field] or [DOTDOT]): + those alternatives do not begin with a bare label and so cannot follow a + fused "<" + name token. *) +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 +4102,15 @@ 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 token, reinterpreted as an + object-type label. Its payload (from the lexer rule + ["<" (lowercase identchar * as name)]) is already just the name, without + the leading "<"; we use the token's own location as-is (spanning the + "<" too), matching how [jsx_longident] already treats JSX_LIDENT/ + JSX_UIDENT elsewhere in this grammar. *) +%inline jsx_first_label: + name = JSX_LIDENT { mkrhs name $sloc } +; %inline inherit_field: ty = atomic_type diff --git a/vendor/parser-standard/parser.mly b/vendor/parser-standard/parser.mly index 9ec3fd3036..b012078a80 100644 --- a/vendor/parser-standard/parser.mly +++ b/vendor/parser-standard/parser.mly @@ -3904,6 +3904,13 @@ 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 when the lexer has + fused "<" with the first method name into a single JSX_LIDENT token + (e.g. because there is no space, as in []), we can + unambiguously reinterpret it as the opening [<] of an object type + followed by its first label. *) + | meth_list = meth_list_jsx GREATER + { let (f, c) = meth_list in Ptyp_object (f, c) } ) { $1 } ; @@ -4006,27 +4013,42 @@ 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 for use right after the lexer has fused + "<" with the first method's name into a single JSX_LIDENT token; the + first field is therefore parsed from that fused token (see + [jsx_first_label]) instead of from a separately-lexed [label]. Only the + field productions are needed here (not [inherit_field] or [DOTDOT]): + those alternatives do not begin with a bare label and so cannot follow a + fused "<" + name token. *) +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 +4057,15 @@ 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 token, reinterpreted as an + object-type label. Its payload (from the lexer rule + ["<" (lowercase identchar * as name)]) is already just the name, without + the leading "<"; we use the token's own location as-is (spanning the + "<" too), matching how [jsx_longident] already treats JSX_LIDENT/ + JSX_UIDENT elsewhere in this grammar. *) +%inline jsx_first_label: + name = JSX_LIDENT { mkrhs name $sloc } +; %inline inherit_field: ty = atomic_type From ad371518b23e6f5eb6a4b0f69ce21771f9518304 Mon Sep 17 00:00:00 2001 From: Andrey Popp <8mayday@gmail.com> Date: Wed, 16 Sep 2026 13:43:44 +0200 Subject: [PATCH 3/3] Condense comments to single lines Co-Authored-By: Claude Fable 5 --- lib/Fmt_ast.ml | 9 +-------- test/mlx/mlx.t | 27 ++++++--------------------- vendor/parser-extended/lexer.mll | 12 ++---------- vendor/parser-extended/parser.mly | 21 +++------------------ vendor/parser-standard/lexer.mll | 12 ++---------- vendor/parser-standard/parser.mly | 21 +++------------------ 6 files changed, 17 insertions(+), 85 deletions(-) diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml index c8c699c7e9..9392ab235f 100644 --- a/lib/Fmt_ast.ml +++ b/lib/Fmt_ast.ml @@ -2990,14 +2990,7 @@ and fmt_expression c ?(box = true) ?(pro = noop) ?eol ?parens pcstr_fields $ fmt_atrs ) ) | Pexp_override l -> ( - (* The object-override closer is now printed as two tokens, [>] then - [}] (mlx JSX support requires the lexer to be able to give the [>] - back to close a JSX tag directly before [}]). Because the grammar - shares LALR states across every field's value and the closer's - trailing [>], a field whose value is an unparenthesized top-level - [>] comparison is grammatically ambiguous with the closer - - wherever that field sits in the list, not only when it is last; - force parens around such a value so the printed output re-parses. *) + (* 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 diff --git a/test/mlx/mlx.t b/test/mlx/mlx.t index d8c84f1d7d..d793baa3d9 100644 --- a/test/mlx/mlx.t +++ b/test/mlx/mlx.t @@ -290,11 +290,7 @@ JSX with infix operators: $ echo 'let _ = ()' | fmt let _ = -JSX element closed directly before "|]" inside an array literal, and -before "}" inside a record/braced expression (regression test for the -lexer treating ">|]" as the ">|" operator followed by "]", and ">}" as a -single GREATERRBRACE token, instead of giving the ">" back to close the -JSX tag): +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 @@ -309,9 +305,7 @@ JSX tag): $ 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, -since the grammar now closes `{< ... >}` with two tokens (GREATER RBRACE) -instead of the single GREATERRBRACE token: +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 @@ -325,11 +319,7 @@ instead of the single GREATERRBRACE token: method m = {} end -Splitting ">}" into GREATER RBRACE means the final GREATER of an override -field ending in an unparenthesized comparison is grammatically -indistinguishable from a continued infix ">", both right before the closer -and elsewhere in the field list; the printer keeps such fields parenthesized -so the output still re-parses: +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 @@ -344,9 +334,7 @@ so the output still re-parses: method m = { 2); y = 5>} end -Operator sanity: only the exact sequences ">|]" and ">}" are special-cased, -so ">|" still lexes as an ordinary operator everywhere else, including -right before a closing "|]" that isn't immediately preceded by ">": +">|" still lexes as an ordinary operator everywhere else: $ echo 'let (>|) a b = a > let _ = 1>|2' | fmt let ( >| ) a b = a @@ -396,9 +384,7 @@ regular applications: $ echo 'let _ = (((get_component ()) ~children:[] ()) [@JSX])' | fmt let _ = (get_component ()) ~children:[] () [@JSX] -Object types whose opening "<" is not followed by a space (the lexer would -otherwise read ") = x#m' | fmt let f (x : < m : int >) = x#m $ echo 'let f (x : ) = x#m' | fmt @@ -408,8 +394,7 @@ contain JSX, so this is unambiguous): $ 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: +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 diff --git a/vendor/parser-extended/lexer.mll b/vendor/parser-extended/lexer.mll index 34b34f4337..a7c6d2a839 100644 --- a/vendor/parser-extended/lexer.mll +++ b/vendor/parser-extended/lexer.mll @@ -748,11 +748,7 @@ rule token = parse | "/>" { SLASHGREATER } | "}" { RBRACE } | ">}" - { (* `>}` closes a JSX element directly inside a record/braced - expression (`{x =
}`): give the ">" back to close the tag - and let "}" lex separately as RBRACE. Object override - (`{< ... >}`) still parses because the grammar now closes it - with GREATER RBRACE instead of the single GREATERRBRACE token. *) + { (* 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 <- @@ -760,11 +756,7 @@ rule token = parse GREATER } | ">|]" - { (* `>|]` closes a JSX element directly inside an array literal - (`[|
|]`): give the ">" back to close the tag and let "|]" - lex separately as BARRBRACKET. An operator like ">|" can never be - legally followed by "]" without parentheses, so nothing legal is - stolen from the operator grammar. *) + { (* 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 <- diff --git a/vendor/parser-extended/parser.mly b/vendor/parser-extended/parser.mly index 9e8040db7b..9ed6c0fd9e 100644 --- a/vendor/parser-extended/parser.mly +++ b/vendor/parser-extended/parser.mly @@ -3949,11 +3949,7 @@ 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 when the lexer has - fused "<" with the first method name into a single JSX_LIDENT token - (e.g. because there is no space, as in []), we can - unambiguously reinterpret it as the opening [<] of an object type - followed by its first label. *) + (* [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) } ) @@ -4070,13 +4066,7 @@ meth_list: | DOTDOT { [], OOpen (make_loc $sloc) } ; -(* [mlx]: same as [meth_list], but for use right after the lexer has fused - "<" with the first method's name into a single JSX_LIDENT token; the - first field is therefore parsed from that fused token (see - [jsx_first_label]) instead of from a separately-lexed [label]. Only the - field productions are needed here (not [inherit_field] or [DOTDOT]): - those alternatives do not begin with a bare label and so cannot follow a - fused "<" + name token. *) +(* [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) } @@ -4102,12 +4092,7 @@ meth_list_jsx: let attrs = add_info_attrs info ($4 @ $6) in Of.tag ~loc:(make_loc $sloc) ~attrs $1 $3 } ; -(* [mlx]: the fused "<" + first-method-name token, reinterpreted as an - object-type label. Its payload (from the lexer rule - ["<" (lowercase identchar * as name)]) is already just the name, without - the leading "<"; we use the token's own location as-is (spanning the - "<" too), matching how [jsx_longident] already treats JSX_LIDENT/ - JSX_UIDENT elsewhere in this grammar. *) +(* [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 } ; diff --git a/vendor/parser-standard/lexer.mll b/vendor/parser-standard/lexer.mll index de50392118..27b95b9ceb 100644 --- a/vendor/parser-standard/lexer.mll +++ b/vendor/parser-standard/lexer.mll @@ -739,11 +739,7 @@ rule token = parse | "/>" { SLASHGREATER } | "}" { RBRACE } | ">}" - { (* `>}` closes a JSX element directly inside a record/braced - expression (`{x =
}`): give the ">" back to close the tag - and let "}" lex separately as RBRACE. Object override - (`{< ... >}`) still parses because the grammar now closes it - with GREATER RBRACE instead of the single GREATERRBRACE token. *) + { (* 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 <- @@ -751,11 +747,7 @@ rule token = parse GREATER } | ">|]" - { (* `>|]` closes a JSX element directly inside an array literal - (`[|
|]`): give the ">" back to close the tag and let "|]" - lex separately as BARRBRACKET. An operator like ">|" can never be - legally followed by "]" without parentheses, so nothing legal is - stolen from the operator grammar. *) + { (* 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 <- diff --git a/vendor/parser-standard/parser.mly b/vendor/parser-standard/parser.mly index b012078a80..2d20e7a0e7 100644 --- a/vendor/parser-standard/parser.mly +++ b/vendor/parser-standard/parser.mly @@ -3904,11 +3904,7 @@ 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 when the lexer has - fused "<" with the first method name into a single JSX_LIDENT token - (e.g. because there is no space, as in []), we can - unambiguously reinterpret it as the opening [<] of an object type - followed by its first label. *) + (* [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) } ) @@ -4025,13 +4021,7 @@ meth_list: | DOTDOT { [], Open } ; -(* [mlx]: same as [meth_list], but for use right after the lexer has fused - "<" with the first method's name into a single JSX_LIDENT token; the - first field is therefore parsed from that fused token (see - [jsx_first_label]) instead of from a separately-lexed [label]. Only the - field productions are needed here (not [inherit_field] or [DOTDOT]): - those alternatives do not begin with a bare label and so cannot follow a - fused "<" + name token. *) +(* [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) } @@ -4057,12 +4047,7 @@ meth_list_jsx: let attrs = add_info_attrs info ($4 @ $6) in Of.tag ~loc:(make_loc $sloc) ~attrs $1 $3 } ; -(* [mlx]: the fused "<" + first-method-name token, reinterpreted as an - object-type label. Its payload (from the lexer rule - ["<" (lowercase identchar * as name)]) is already just the name, without - the leading "<"; we use the token's own location as-is (spanning the - "<" too), matching how [jsx_longident] already treats JSX_LIDENT/ - JSX_UIDENT elsewhere in this grammar. *) +(* [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 } ;