From db7eee656dc2db2ec075cc17d47e45e607b3eca8 Mon Sep 17 00:00:00 2001 From: nojaf Date: Thu, 6 Feb 2025 18:11:26 +0100 Subject: [PATCH 1/3] Intial exploration of JSX ast Map child expressions Initial mapping of Pexp_jsx_fragment to 0 Correct location in mapping Update analysis for jsx_fragment Remove unused code Print something for ml print Commit invalid test results for reference Try improve printing Correct fragment range, try and print comments Indent jsx Process comments from children inside fragment Attach comments to fragment tags Fix comment Improve comment formatting Print single element on same line Update comment WIP: Debug More debugging Works Fix some jsx printing Fix the test Clean up Update tests with location changes --- analysis/src/CompletionFrontEnd.ml | 3 +- analysis/src/Utils.ml | 5 + compiler/frontend/bs_ast_mapper.ml | 2 + compiler/ml/ast_helper.ml | 27 ++++ compiler/ml/ast_helper.mli | 10 ++ compiler/ml/ast_iterator.ml | 1 + compiler/ml/ast_mapper.ml | 2 + compiler/ml/ast_mapper_to0.ml | 12 ++ compiler/ml/depend.ml | 1 + compiler/ml/parsetree.ml | 10 +- compiler/ml/pprintast.ml | 2 + compiler/ml/printast.ml | 3 + compiler/ml/typecore.ml | 5 +- compiler/syntax/src/jsx_v4.ml | 137 +++++++----------- compiler/syntax/src/res_ast_debugger.ml | 5 + compiler/syntax/src/res_comments_table.ml | 39 ++--- compiler/syntax/src/res_core.ml | 61 +++----- compiler/syntax/src/res_parens.ml | 2 +- compiler/syntax/src/res_parsetree_viewer.ml | 1 + compiler/syntax/src/res_printer.ml | 62 ++++++-- .../tests/src/expected/Completion.res.txt | 2 +- .../tests/src/expected/Fragment.res.txt | 9 +- .../tests/src/expected/Jsx2.res.txt | 9 +- .../conversion/reason/expected/string.res.txt | 2 +- .../expected/bracedOrRecord.res.txt | 2 +- .../grammar/expressions/expected/jsx.res.txt | 41 +++--- .../data/printer/expr/expected/braced.res.txt | 4 +- .../data/printer/expr/expected/switch.res.txt | 3 +- .../syntax_tests/data/printer/expr/switch.res | 2 +- 29 files changed, 266 insertions(+), 198 deletions(-) diff --git a/analysis/src/CompletionFrontEnd.ml b/analysis/src/CompletionFrontEnd.ml index aea7a6141d..1ba52807d1 100644 --- a/analysis/src/CompletionFrontEnd.ml +++ b/analysis/src/CompletionFrontEnd.ml @@ -1232,7 +1232,8 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor then ValueOrField else Value); })) - | Pexp_construct ({txt = Lident ("::" | "()")}, _) -> + | Pexp_construct ({txt = Lident ("::" | "()")}, _) | Pexp_jsx_fragment _ + -> (* Ignore list expressions, used in JSX, unit, and more *) () | Pexp_construct (lid, eOpt) -> ( let lidPath = flattenLidCheckDot lid in diff --git a/analysis/src/Utils.ml b/analysis/src/Utils.ml index c274b5a9fb..1a068afedb 100644 --- a/analysis/src/Utils.ml +++ b/analysis/src/Utils.ml @@ -111,6 +111,7 @@ let identifyPexp pexp = | Pexp_pack _ -> "Pexp_pack" | Pexp_extension _ -> "Pexp_extension" | Pexp_open _ -> "Pexp_open" + | Pexp_jsx_fragment _ -> "Pexp_jsx_fragment" let identifyPpat pat = match pat with @@ -154,6 +155,10 @@ let isJsxComponent (vb : Parsetree.value_binding) = |> List.exists (function | {Location.txt = "react.component" | "jsx.component"}, _payload -> true | _ -> false) + || + match vb.pvb_expr.pexp_desc with + | Parsetree.Pexp_jsx_fragment _ -> true + | _ -> false let checkName name ~prefix ~exact = if exact then name = prefix else startsWith name prefix diff --git a/compiler/frontend/bs_ast_mapper.ml b/compiler/frontend/bs_ast_mapper.ml index 4bcda7c534..c2beac2140 100644 --- a/compiler/frontend/bs_ast_mapper.ml +++ b/compiler/frontend/bs_ast_mapper.ml @@ -366,6 +366,8 @@ module E = struct | Pexp_open (ovf, lid, e) -> open_ ~loc ~attrs ovf (map_loc sub lid) (sub.expr sub e) | Pexp_extension x -> extension ~loc ~attrs (sub.extension sub x) + | Pexp_jsx_fragment (o, xs, c) -> + jsx_fragment o (List.map (sub.expr sub) xs) c end module P = struct diff --git a/compiler/ml/ast_helper.ml b/compiler/ml/ast_helper.ml index aa0c66dbfc..5c27101d66 100644 --- a/compiler/ml/ast_helper.ml +++ b/compiler/ml/ast_helper.ml @@ -180,8 +180,35 @@ module Exp = struct let pack ?loc ?attrs a = mk ?loc ?attrs (Pexp_pack a) let open_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_open (a, b, c)) let extension ?loc ?attrs a = mk ?loc ?attrs (Pexp_extension a) + let jsx_fragment ?loc ?attrs a b c = + mk ?loc ?attrs (Pexp_jsx_fragment (a, b, c)) let case lhs ?guard rhs = {pc_lhs = lhs; pc_guard = guard; pc_rhs = rhs} + + let make_list_expression loc seq ext_opt = + let rec handle_seq = function + | [] -> ( + match ext_opt with + | Some ext -> ext + | None -> + let loc = {loc with Location.loc_ghost = true} in + let nil = Location.mkloc (Longident.Lident "[]") loc in + construct ~loc nil None) + | e1 :: el -> + let exp_el = handle_seq el in + let loc = + Location. + { + loc_start = e1.Parsetree.pexp_loc.Location.loc_start; + loc_end = exp_el.pexp_loc.loc_end; + loc_ghost = false; + } + in + let arg = tuple ~loc [e1; exp_el] in + construct ~loc (Location.mkloc (Longident.Lident "::") loc) (Some arg) + in + let expr = handle_seq seq in + {expr with pexp_loc = loc} end module Mty = struct diff --git a/compiler/ml/ast_helper.mli b/compiler/ml/ast_helper.mli index a78e33589e..c5adff0d05 100644 --- a/compiler/ml/ast_helper.mli +++ b/compiler/ml/ast_helper.mli @@ -208,8 +208,18 @@ module Exp : sig val open_ : ?loc:loc -> ?attrs:attrs -> override_flag -> lid -> expression -> expression val extension : ?loc:loc -> ?attrs:attrs -> extension -> expression + val jsx_fragment : + ?loc:loc -> + ?attrs:attrs -> + Lexing.position -> + expression list -> + Lexing.position -> + expression val case : pattern -> ?guard:expression -> expression -> case + + val make_list_expression : + Location.t -> expression list -> expression option -> expression end (** Value declarations *) diff --git a/compiler/ml/ast_iterator.ml b/compiler/ml/ast_iterator.ml index 1c0bd087da..3bd6f6df57 100644 --- a/compiler/ml/ast_iterator.ml +++ b/compiler/ml/ast_iterator.ml @@ -344,6 +344,7 @@ module E = struct iter_loc sub lid; sub.expr sub e | Pexp_extension x -> sub.extension sub x + | Pexp_jsx_fragment (_, xs, _) -> List.iter (sub.expr sub) xs end module P = struct diff --git a/compiler/ml/ast_mapper.ml b/compiler/ml/ast_mapper.ml index f2055efb93..efd5b247e1 100644 --- a/compiler/ml/ast_mapper.ml +++ b/compiler/ml/ast_mapper.ml @@ -329,6 +329,8 @@ module E = struct | Pexp_open (ovf, lid, e) -> open_ ~loc ~attrs ovf (map_loc sub lid) (sub.expr sub e) | Pexp_extension x -> extension ~loc ~attrs (sub.extension sub x) + | Pexp_jsx_fragment (o, xs, c) -> + jsx_fragment ~loc ~attrs o (List.map (sub.expr sub) xs) c end module P = struct diff --git a/compiler/ml/ast_mapper_to0.ml b/compiler/ml/ast_mapper_to0.ml index cc343762fc..bb2a97fbb3 100644 --- a/compiler/ml/ast_mapper_to0.ml +++ b/compiler/ml/ast_mapper_to0.ml @@ -407,6 +407,18 @@ module E = struct | Pexp_open (ovf, lid, e) -> open_ ~loc ~attrs ovf (map_loc sub lid) (sub.expr sub e) | Pexp_extension x -> extension ~loc ~attrs (sub.extension sub x) + | Pexp_jsx_fragment (o, xs, c) -> + (* + The location of Pexp_jsx_fragment is from the start of < till the end of />. + This is not the case in the old AST. There it is from >... add bv c | _ -> handle_extension e) | Pexp_extension e -> handle_extension e + | Pexp_jsx_fragment (_, xs, _) -> List.iter (add_expr bv) xs and add_cases bv cases = List.iter (add_case bv) cases diff --git a/compiler/ml/parsetree.ml b/compiler/ml/parsetree.ml index b7db5e902b..c4ac25cbc1 100644 --- a/compiler/ml/parsetree.ml +++ b/compiler/ml/parsetree.ml @@ -313,8 +313,14 @@ and expression_desc = let open M in E let! open M in E *) | Pexp_extension of extension -(* [%id] *) -(* . *) + (* [%id] *) + (* . *) + (* represents <> foo , the entire range is stored in the expression , we keep track of >, children and *) Lexing.position + * (* children *) + expression list + * (* E) or (P when E0 -> E) *) diff --git a/compiler/ml/pprintast.ml b/compiler/ml/pprintast.ml index 31cb171d81..71a0b203cb 100644 --- a/compiler/ml/pprintast.ml +++ b/compiler/ml/pprintast.ml @@ -794,6 +794,8 @@ and simple_expr ctxt f x = let expression = expression ctxt in pp f fmt (pattern ctxt) s expression e1 direction_flag df expression e2 expression e3 + | Pexp_jsx_fragment (_, xs, _) -> + pp f "<>%a" (list (simple_expr ctxt)) xs | _ -> paren true (expression ctxt) f x and attributes ctxt f l = List.iter (attribute ctxt f) l diff --git a/compiler/ml/printast.ml b/compiler/ml/printast.ml index 777829f0c9..2721b0bbda 100644 --- a/compiler/ml/printast.ml +++ b/compiler/ml/printast.ml @@ -345,6 +345,9 @@ and expression i ppf x = | Pexp_extension (s, arg) -> line i ppf "Pexp_extension \"%s\"\n" s.txt; payload i ppf arg + | Pexp_jsx_fragment (_, xs, _) -> + line i ppf "Pexp_jsx_fragment"; + list i expression ppf xs and value_description i ppf x = line i ppf "value_description %a %a\n" fmt_string_loc x.pval_name fmt_location diff --git a/compiler/ml/typecore.ml b/compiler/ml/typecore.ml index 2217d3c94d..a54e43d63b 100644 --- a/compiler/ml/typecore.ml +++ b/compiler/ml/typecore.ml @@ -148,7 +148,8 @@ let iter_expression f e = | Pexp_match (e, pel) | Pexp_try (e, pel) -> expr e; List.iter case pel - | Pexp_array el | Pexp_tuple el -> List.iter expr el + | Pexp_array el | Pexp_tuple el | Pexp_jsx_fragment (_, el, _) -> + List.iter expr el | Pexp_construct (_, eo) | Pexp_variant (_, eo) -> may expr eo | Pexp_record (iel, eo) -> may expr eo; @@ -3208,6 +3209,8 @@ and type_expect_ ?type_clash_context ?in_function ?(recarg = Rejected) env sexp | _ -> raise (Error (loc, env, Invalid_extension_constructor_payload))) | Pexp_extension ext -> raise (Error_forward (Builtin_attributes.error_of_extension ext)) + | Pexp_jsx_fragment _ -> + failwith "Pexp_jsx_fragment is expected to be transformed at this point" and type_function ?in_function ~arity ~async loc attrs env ty_expected_ l caselist = diff --git a/compiler/syntax/src/jsx_v4.ml b/compiler/syntax/src/jsx_v4.ml index b1eb169b84..32affe1e3b 100644 --- a/compiler/syntax/src/jsx_v4.ml +++ b/compiler/syntax/src/jsx_v4.ml @@ -1530,8 +1530,62 @@ let transform_jsx_call ~config mapper call_expression call_arguments "JSX: `createElement` should be preceeded by a simple, direct module \ name." -let expr ~config mapper expression = +let expr ~(config : Jsx_common.jsx_config) mapper expression = match expression with + | { + pexp_desc = Pexp_jsx_fragment (_, xs, _); + pexp_loc = loc; + pexp_attributes = attrs; + } -> + let loc = {loc with loc_ghost = true} in + let fragment = + match config.mode with + | "automatic" -> + Exp.ident ~loc {loc; txt = module_access_name config "jsxFragment"} + | "classic" | _ -> + Exp.ident ~loc {loc; txt = Ldot (Lident "React", "fragment")} + in + let record_of_children children = + Exp.record [(Location.mknoloc (Lident "children"), children, false)] None + in + let apply_jsx_array expr = + Exp.apply + (Exp.ident + {txt = module_access_name config "array"; loc = Location.none}) + [(Nolabel, expr)] + in + let children_props = + match xs with + | [] -> empty_record ~loc:Location.none + | [child] -> record_of_children (mapper.expr mapper child) + | _ -> ( + match config.mode with + | "automatic" -> + record_of_children + @@ apply_jsx_array (Exp.array (List.map (mapper.expr mapper) xs)) + | "classic" | _ -> empty_record ~loc:Location.none) + in + let args = + (nolabel, fragment) :: (nolabel, children_props) + :: + (match config.mode with + | "classic" when List.length xs > 1 -> + [(nolabel, Exp.array (List.map (mapper.expr mapper) xs))] + | _ -> []) + in + Exp.apply ~loc ~attrs + (* ReactDOM.createElement *) + (match config.mode with + | "automatic" -> + if List.length xs > 1 then + Exp.ident ~loc {loc; txt = module_access_name config "jsxs"} + else Exp.ident ~loc {loc; txt = module_access_name config "jsx"} + | "classic" | _ -> + if List.length xs > 1 then + Exp.ident ~loc + {loc; txt = Ldot (Lident "React", "createElementVariadic")} + else Exp.ident ~loc {loc; txt = Ldot (Lident "React", "createElement")}) + args (* Does the function application have the @JSX attribute? *) | { pexp_desc = Pexp_apply {funct = call_expression; args = call_arguments}; @@ -1549,87 +1603,6 @@ let expr ~config mapper expression = | _, non_jsx_attributes -> transform_jsx_call ~config mapper call_expression call_arguments pexp_loc non_jsx_attributes) - (* is it a list with jsx attribute? Reason <>foo desugars to [@JSX][foo]*) - | { - pexp_desc = - ( Pexp_construct - ({txt = Lident "::"; loc}, Some {pexp_desc = Pexp_tuple _}) - | Pexp_construct ({txt = Lident "[]"; loc}, None) ); - pexp_attributes; - } as list_items -> ( - let jsx_attribute, non_jsx_attributes = - List.partition - (fun (attribute, _) -> attribute.txt = "JSX") - pexp_attributes - in - match (jsx_attribute, non_jsx_attributes) with - (* no JSX attribute *) - | [], _ -> default_mapper.expr mapper expression - | _, non_jsx_attributes -> - let loc = {loc with loc_ghost = true} in - let fragment = - match config.mode with - | "automatic" -> - Exp.ident ~loc {loc; txt = module_access_name config "jsxFragment"} - | "classic" | _ -> - Exp.ident ~loc {loc; txt = Ldot (Lident "React", "fragment")} - in - let children_expr = transform_children_if_list ~mapper list_items in - let record_of_children children = - Exp.record - [(Location.mknoloc (Lident "children"), children, false)] - None - in - let apply_jsx_array expr = - Exp.apply - (Exp.ident - {txt = module_access_name config "array"; loc = Location.none}) - [(Nolabel, expr)] - in - let count_of_children = function - | {pexp_desc = Pexp_array children} -> List.length children - | _ -> 0 - in - let transform_children_to_props children_expr = - match children_expr with - | {pexp_desc = Pexp_array children} -> ( - match children with - | [] -> empty_record ~loc:Location.none - | [child] -> record_of_children child - | _ -> ( - match config.mode with - | "automatic" -> record_of_children @@ apply_jsx_array children_expr - | "classic" | _ -> empty_record ~loc:Location.none)) - | _ -> ( - match config.mode with - | "automatic" -> record_of_children @@ apply_jsx_array children_expr - | "classic" | _ -> empty_record ~loc:Location.none) - in - let args = - (nolabel, fragment) - :: (nolabel, transform_children_to_props children_expr) - :: - (match config.mode with - | "classic" when count_of_children children_expr > 1 -> - [(nolabel, children_expr)] - | _ -> []) - in - Exp.apply - ~loc (* throw away the [@JSX] attribute and keep the others, if any *) - ~attrs:non_jsx_attributes - (* ReactDOM.createElement *) - (match config.mode with - | "automatic" -> - if count_of_children children_expr > 1 then - Exp.ident ~loc {loc; txt = module_access_name config "jsxs"} - else Exp.ident ~loc {loc; txt = module_access_name config "jsx"} - | "classic" | _ -> - if count_of_children children_expr > 1 then - Exp.ident ~loc - {loc; txt = Ldot (Lident "React", "createElementVariadic")} - else - Exp.ident ~loc {loc; txt = Ldot (Lident "React", "createElement")}) - args) (* Delegate to the default mapper, a deep identity traversal *) | e -> default_mapper.expr mapper e diff --git a/compiler/syntax/src/res_ast_debugger.ml b/compiler/syntax/src/res_ast_debugger.ml index a4d4f4a390..72ec8226bc 100644 --- a/compiler/syntax/src/res_ast_debugger.ml +++ b/compiler/syntax/src/res_ast_debugger.ml @@ -707,6 +707,11 @@ module SexpAst = struct ] | Pexp_extension ext -> Sexp.list [Sexp.atom "Pexp_extension"; extension ext] + | Pexp_jsx_fragment (_, xs, _) -> + Sexp.list + [ + Sexp.atom "Pexp_jsx_fragment"; Sexp.list (map_empty ~f:expression xs); + ] in Sexp.list [Sexp.atom "expression"; desc] diff --git a/compiler/syntax/src/res_comments_table.ml b/compiler/syntax/src/res_comments_table.ml index c003d04ff6..ad7083811a 100644 --- a/compiler/syntax/src/res_comments_table.ml +++ b/compiler/syntax/src/res_comments_table.ml @@ -24,25 +24,24 @@ let copy tbl = let empty = make () +let print_loc (k : Warnings.loc) = + Doc.concat + [ + Doc.lbracket; + Doc.text (string_of_int k.loc_start.pos_lnum); + Doc.text ":"; + Doc.text (string_of_int (k.loc_start.pos_cnum - k.loc_start.pos_bol)); + Doc.text "-"; + Doc.text (string_of_int k.loc_end.pos_lnum); + Doc.text ":"; + Doc.text (string_of_int (k.loc_end.pos_cnum - k.loc_end.pos_bol)); + Doc.rbracket; + ] + let print_entries tbl = - let open Location in Hashtbl.fold (fun (k : Location.t) (v : Comment.t list) acc -> - let loc = - Doc.concat - [ - Doc.lbracket; - Doc.text (string_of_int k.loc_start.pos_lnum); - Doc.text ":"; - Doc.text - (string_of_int (k.loc_start.pos_cnum - k.loc_start.pos_bol)); - Doc.text "-"; - Doc.text (string_of_int k.loc_end.pos_lnum); - Doc.text ":"; - Doc.text (string_of_int (k.loc_end.pos_cnum - k.loc_end.pos_bol)); - Doc.rbracket; - ] - in + let loc = print_loc k in let doc = Doc.breakable_group ~force_break:true (Doc.concat @@ -1508,7 +1507,13 @@ and walk_expression expr t comments = attach t.leading return_expr.pexp_loc leading; walk_expression return_expr t inside; attach t.trailing return_expr.pexp_loc trailing) - | _ -> () + | Pexp_jsx_fragment (opening_greater_than, exprs, _closing_lesser_than) -> + let opening_token = {expr.pexp_loc with loc_end = opening_greater_than} in + let on_same_line, rest = partition_by_on_same_line opening_token comments in + attach t.trailing opening_token on_same_line; + let xs = exprs |> List.map (fun e -> Expression e) in + walk_list xs t rest + | Pexp_send _ -> () and walk_expr_parameter (_attrs, _argLbl, expr_opt, pattern) t comments = let leading, inside, trailing = partition_by_loc comments pattern.ppat_loc in diff --git a/compiler/syntax/src/res_core.ml b/compiler/syntax/src/res_core.ml index b1724b239a..c08f3c0c7d 100644 --- a/compiler/syntax/src/res_core.ml +++ b/compiler/syntax/src/res_core.ml @@ -435,28 +435,6 @@ let make_unary_expr start_pos token_end token operand = [(Nolabel, operand)] | _ -> operand -let make_list_expression loc seq ext_opt = - let rec handle_seq = function - | [] -> ( - match ext_opt with - | Some ext -> ext - | None -> - let loc = {loc with Location.loc_ghost = true} in - let nil = Location.mkloc (Longident.Lident "[]") loc in - Ast_helper.Exp.construct ~loc nil None) - | e1 :: el -> - let exp_el = handle_seq el in - let loc = - mk_loc e1.Parsetree.pexp_loc.Location.loc_start exp_el.pexp_loc.loc_end - in - let arg = Ast_helper.Exp.tuple ~loc [e1; exp_el] in - Ast_helper.Exp.construct ~loc - (Location.mkloc (Longident.Lident "::") loc) - (Some arg) - in - let expr = handle_seq seq in - {expr with pexp_loc = loc} - let make_list_pattern loc seq ext_opt = let rec handle_seq = function | [] -> @@ -2619,7 +2597,7 @@ and parse_jsx_opening_or_self_closing_element ~start_pos p = Scanner.pop_mode p.scanner Jsx; Parser.expect GreaterThan p; let loc = mk_loc children_start_pos children_end_pos in - make_list_expression loc [] None (* no children *) + Ast_helper.Exp.make_list_expression loc [] None (* no children *) | GreaterThan -> ( (* bar *) let children_start_pos = p.Parser.start_pos in @@ -2642,7 +2620,7 @@ and parse_jsx_opening_or_self_closing_element ~start_pos p = let loc = mk_loc children_start_pos children_end_pos in match (spread, children) with | true, child :: _ -> child - | _ -> make_list_expression loc children None) + | _ -> Ast_helper.Exp.make_list_expression loc children None) | token -> ( Scanner.pop_mode p.scanner Jsx; let () = @@ -2663,11 +2641,11 @@ and parse_jsx_opening_or_self_closing_element ~start_pos p = let loc = mk_loc children_start_pos children_end_pos in match (spread, children) with | true, child :: _ -> child - | _ -> make_list_expression loc children None)) + | _ -> Ast_helper.Exp.make_list_expression loc children None)) | token -> Scanner.pop_mode p.scanner Jsx; Parser.err p (Diagnostics.unexpected token p.breadcrumbs); - make_list_expression Location.none [] None + Ast_helper.Exp.make_list_expression Location.none [] None in let jsx_end_pos = p.prev_end_pos in let loc = mk_loc jsx_start_pos jsx_end_pos in @@ -2697,24 +2675,24 @@ and parse_jsx p = Parser.leave_breadcrumb p Grammar.Jsx; let start_pos = p.Parser.start_pos in Parser.expect LessThan p; - let jsx_expr = + let jsx_expr, jsx_attrs = match p.Parser.token with | Lident _ | Uident _ -> - parse_jsx_opening_or_self_closing_element ~start_pos p + (parse_jsx_opening_or_self_closing_element ~start_pos p, [jsx_attr]) | GreaterThan -> (* fragment: <> foo *) - parse_jsx_fragment p - | _ -> parse_jsx_name p + (parse_jsx_fragment start_pos p, []) + | _ -> (parse_jsx_name p, []) in Parser.eat_breadcrumb p; - {jsx_expr with pexp_attributes = [jsx_attr]} + {jsx_expr with pexp_attributes = jsx_attrs} (* * jsx-fragment ::= * | <> * | <> jsx-children *) -and parse_jsx_fragment p = +and parse_jsx_fragment start_pos p = let children_start_pos = p.Parser.start_pos in Parser.expect GreaterThan p; let _spread, children = parse_jsx_children p in @@ -2722,9 +2700,12 @@ and parse_jsx_fragment p = if p.token = LessThan then p.token <- Scanner.reconsider_less_than p.scanner; Parser.expect LessThanSlash p; Scanner.pop_mode p.scanner Jsx; + let end_pos = p.Parser.end_pos in Parser.expect GreaterThan p; - let loc = mk_loc children_start_pos children_end_pos in - make_list_expression loc children None + (* location is from starting < till closing > *) + let loc = mk_loc start_pos end_pos in + Ast_helper.Exp.jsx_fragment ~attrs:[] ~loc children_start_pos children + children_end_pos (* * jsx-prop ::= @@ -3864,9 +3845,10 @@ and parse_list_expr ~start_pos p = in let make_sub_expr = function | exprs, Some spread, start_pos, end_pos -> - make_list_expression (mk_loc start_pos end_pos) exprs (Some spread) + Ast_helper.Exp.make_list_expression (mk_loc start_pos end_pos) exprs + (Some spread) | exprs, None, start_pos, end_pos -> - make_list_expression (mk_loc start_pos end_pos) exprs None + Ast_helper.Exp.make_list_expression (mk_loc start_pos end_pos) exprs None in let list_exprs_rev = parse_comma_delimited_reversed_list p ~grammar:Grammar.ListExpr @@ -3875,9 +3857,10 @@ and parse_list_expr ~start_pos p = Parser.expect Rbrace p; let loc = mk_loc start_pos p.prev_end_pos in match split_by_spread list_exprs_rev with - | [] -> make_list_expression loc [] None - | [(exprs, Some spread, _, _)] -> make_list_expression loc exprs (Some spread) - | [(exprs, None, _, _)] -> make_list_expression loc exprs None + | [] -> Ast_helper.Exp.make_list_expression loc [] None + | [(exprs, Some spread, _, _)] -> + Ast_helper.Exp.make_list_expression loc exprs (Some spread) + | [(exprs, None, _, _)] -> Ast_helper.Exp.make_list_expression loc exprs None | exprs -> let list_exprs = List.map make_sub_expr exprs in Ast_helper.Exp.apply ~loc diff --git a/compiler/syntax/src/res_parens.ml b/compiler/syntax/src/res_parens.ml index 550c375df9..b9dc6a8c80 100644 --- a/compiler/syntax/src/res_parens.ml +++ b/compiler/syntax/src/res_parens.ml @@ -385,7 +385,7 @@ let jsx_child_expr expr = ( Pexp_ident _ | Pexp_constant _ | Pexp_field _ | Pexp_construct _ | Pexp_variant _ | Pexp_array _ | Pexp_pack _ | Pexp_record _ | Pexp_extension _ | Pexp_letmodule _ | Pexp_letexception _ - | Pexp_open _ | Pexp_sequence _ | Pexp_let _ ); + | Pexp_open _ | Pexp_sequence _ | Pexp_let _ | Pexp_jsx_fragment _ ); pexp_attributes = []; } -> Nothing diff --git a/compiler/syntax/src/res_parsetree_viewer.ml b/compiler/syntax/src/res_parsetree_viewer.ml index 71696b0845..ff33dd4156 100644 --- a/compiler/syntax/src/res_parsetree_viewer.ml +++ b/compiler/syntax/src/res_parsetree_viewer.ml @@ -492,6 +492,7 @@ let is_jsx_expression expr = | _ :: attrs -> loop attrs in match expr.pexp_desc with + | Pexp_jsx_fragment _ -> true | Pexp_apply _ -> loop expr.Parsetree.pexp_attributes | _ -> false diff --git a/compiler/syntax/src/res_printer.ml b/compiler/syntax/src/res_printer.ml index 9b313a00ea..74e3cc3a69 100644 --- a/compiler/syntax/src/res_printer.ml +++ b/compiler/syntax/src/res_printer.ml @@ -2098,6 +2098,7 @@ and print_value_binding ~state ~rec_flag (vb : Parsetree.value_binding) cmt_tbl | {pexp_desc = Pexp_newtype _} -> false | {pexp_attributes = [({Location.txt = "res.taggedTemplate"}, _)]} -> false + | {pexp_desc = Pexp_jsx_fragment _} -> true | e -> ParsetreeViewer.has_attributes e.pexp_attributes || ParsetreeViewer.is_array_access e) @@ -2782,9 +2783,8 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl = | Pexp_fun _ | Pexp_newtype _ -> print_arrow e | Parsetree.Pexp_constant c -> print_constant ~template_literal:(ParsetreeViewer.is_template_literal e) c - | Pexp_construct _ when ParsetreeViewer.has_jsx_attribute e.pexp_attributes - -> - print_jsx_fragment ~state e cmt_tbl + | Pexp_jsx_fragment (o, xs, c) -> + print_jsx_fragment ~state o xs c e.pexp_loc cmt_tbl | Pexp_construct ({txt = Longident.Lident "()"}, _) -> Doc.text "()" | Pexp_construct ({txt = Longident.Lident "[]"}, _) -> Doc.concat @@ -3413,6 +3413,7 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl = | Pexp_ifthenelse _ -> true | Pexp_match _ when ParsetreeViewer.is_if_let_expr e -> true + | Pexp_jsx_fragment _ -> true | Pexp_construct _ when ParsetreeViewer.has_jsx_attribute e.pexp_attributes -> true @@ -4403,27 +4404,66 @@ and print_jsx_expression ~state lident args cmt_tbl = ]); ]) -and print_jsx_fragment ~state expr cmt_tbl = - let opening = Doc.text "<>" in - let closing = Doc.text "" in +and print_jsx_fragment ~state (opening_greater_than : Lexing.position) + (children : Parsetree.expression list) + (closing_lesser_than : Lexing.position) (fragment_loc : Warnings.loc) + cmt_tbl = + let opening = + let loc : Location.t = {fragment_loc with loc_end = opening_greater_than} in + print_comments (Doc.text "<>") cmt_tbl loc + in + let closing = + let loc : Location.t = + {fragment_loc with loc_start = closing_lesser_than} + in + print_comments (Doc.text "") cmt_tbl loc + in let line_sep = - if has_nested_jsx_or_more_than_one_child expr then Doc.hard_line + if + List.length children > 1 + || List.exists ParsetreeViewer.is_jsx_expression children + then Doc.hard_line else Doc.line in Doc.group (Doc.concat [ opening; - (match expr.pexp_desc with - | Pexp_construct ({txt = Longident.Lident "[]"}, None) -> Doc.nil - | _ -> + (match children with + | [] -> Doc.nil + | children -> Doc.indent (Doc.concat - [Doc.line; print_jsx_children ~state expr ~sep:line_sep cmt_tbl])); + [ + Doc.line; + Doc.join ~sep:line_sep + (List.map + (fun e -> print_jsx_child ~state e cmt_tbl) + children); + ])); line_sep; closing; ]) +and print_jsx_child ~state (expr : Parsetree.expression) cmt_tbl = + let leading_line_comment_present = + has_leading_line_comment cmt_tbl expr.pexp_loc + in + let expr_doc = print_expression_with_comments ~state expr cmt_tbl in + let add_parens_or_braces expr_doc = + (* {(20: int)} make sure that we also protect the expression inside *) + let inner_doc = + if Parens.braced_expr expr then add_parens expr_doc else expr_doc + in + if leading_line_comment_present then add_braces inner_doc + else Doc.concat [Doc.lbrace; inner_doc; Doc.rbrace] + in + match Parens.jsx_child_expr expr with + | Nothing -> expr_doc + | Parenthesized -> add_parens_or_braces expr_doc + | Braced braces_loc -> + print_comments (add_parens_or_braces expr_doc) cmt_tbl braces_loc + and print_jsx_children ~state (children_expr : Parsetree.expression) ~sep cmt_tbl = match children_expr.pexp_desc with diff --git a/tests/analysis_tests/tests/src/expected/Completion.res.txt b/tests/analysis_tests/tests/src/expected/Completion.res.txt index b2aa5b483f..64d1d2b373 100644 --- a/tests/analysis_tests/tests/src/expected/Completion.res.txt +++ b/tests/analysis_tests/tests/src/expected/Completion.res.txt @@ -963,7 +963,7 @@ Path Objects.Rec. Complete src/Completion.res 120:7 posCursor:[120:7] posNoWhite:[120:6] Found expr:[119:11->123:1] -posCursor:[120:7] posNoWhite:[120:6] Found expr:[120:5->122:5] +posCursor:[120:7] posNoWhite:[120:6] Found expr:[120:5->122:8] posCursor:[120:7] posNoWhite:[120:6] Found expr:[120:5->120:7] Pexp_ident my:[120:5->120:7] Completable: Cpath Value[my] diff --git a/tests/analysis_tests/tests/src/expected/Fragment.res.txt b/tests/analysis_tests/tests/src/expected/Fragment.res.txt index 3b67cf3a42..6250ed882a 100644 --- a/tests/analysis_tests/tests/src/expected/Fragment.res.txt +++ b/tests/analysis_tests/tests/src/expected/Fragment.res.txt @@ -3,15 +3,8 @@ Hover src/Fragment.res 6:19 Hover src/Fragment.res 9:56 Nothing at that position. Now trying to use completion. -posCursor:[9:56] posNoWhite:[9:55] Found expr:[9:10->9:67] -posCursor:[9:56] posNoWhite:[9:55] Found expr:[9:13->9:67] +posCursor:[9:56] posNoWhite:[9:55] Found expr:[9:9->9:70] posCursor:[9:56] posNoWhite:[9:55] Found expr:[9:13->9:66] JSX 9:26] > _children:9:26 -posCursor:[9:56] posNoWhite:[9:55] Found expr:__ghost__[9:10->9:67] -Pexp_construct []:__ghost__[9:10->9:67] None -Completable: Cexpression CTypeAtPos()=[]->variantPayload::::($1) -Package opens Stdlib.place holder Pervasives.JsxModules.place holder -Resolved opens 1 Stdlib -ContextPath CTypeAtPos() null diff --git a/tests/analysis_tests/tests/src/expected/Jsx2.res.txt b/tests/analysis_tests/tests/src/expected/Jsx2.res.txt index 87e09267cf..2364cc159c 100644 --- a/tests/analysis_tests/tests/src/expected/Jsx2.res.txt +++ b/tests/analysis_tests/tests/src/expected/Jsx2.res.txt @@ -534,8 +534,7 @@ Path Nested. Hover src/Jsx2.res 162:12 Nothing at that position. Now trying to use completion. -posCursor:[162:12] posNoWhite:[162:11] Found expr:[162:3->162:21] -posCursor:[162:12] posNoWhite:[162:11] Found expr:[162:6->162:21] +posCursor:[162:12] posNoWhite:[162:11] Found expr:[162:2->162:24] posCursor:[162:12] posNoWhite:[162:11] Found expr:[162:6->162:20] JSX 162:10] age[162:11->162:14]=...[162:15->162:17]> _children:162:18 Completable: Cjsx([Comp], age, [age]) @@ -546,10 +545,8 @@ Path Comp.make Hover src/Jsx2.res 167:16 Nothing at that position. Now trying to use completion. -posCursor:[167:16] posNoWhite:[167:15] Found expr:[167:3->167:30] -posCursor:[167:16] posNoWhite:[167:15] Found expr:[167:7->167:30] -posCursor:[167:16] posNoWhite:[167:15] Found expr:[167:7->167:25] -posCursor:[167:16] posNoWhite:[167:15] Found expr:[167:10->167:25] +posCursor:[167:16] posNoWhite:[167:15] Found expr:[167:2->167:33] +posCursor:[167:16] posNoWhite:[167:15] Found expr:[167:6->167:28] posCursor:[167:16] posNoWhite:[167:15] Found expr:[167:10->167:24] JSX 167:14] age[167:15->167:18]=...[167:19->167:21]> _children:167:22 Completable: Cjsx([Comp], age, [age]) diff --git a/tests/syntax_tests/data/conversion/reason/expected/string.res.txt b/tests/syntax_tests/data/conversion/reason/expected/string.res.txt index dde635285c..217af2ddad 100644 --- a/tests/syntax_tests/data/conversion/reason/expected/string.res.txt +++ b/tests/syntax_tests/data/conversion/reason/expected/string.res.txt @@ -8,7 +8,7 @@ carriage return` let x = "\"" let y = "\n" -(<> {"\n"->React.string} ) +<> {"\n"->React.string} // The `//` should not result into an extra comment let x = `https://www.apple.com` diff --git a/tests/syntax_tests/data/parsing/grammar/expressions/expected/bracedOrRecord.res.txt b/tests/syntax_tests/data/parsing/grammar/expressions/expected/bracedOrRecord.res.txt index d561dd0ad7..cdb2da8111 100644 --- a/tests/syntax_tests/data/parsing/grammar/expressions/expected/bracedOrRecord.res.txt +++ b/tests/syntax_tests/data/parsing/grammar/expressions/expected/bracedOrRecord.res.txt @@ -26,4 +26,4 @@ let f = ((fun [arity:1]event -> (event.target).value)[@res.braces ]) let f = ((fun [arity:1]event -> ((event.target).value : string)) [@res.braces ]) let x = ((let a = 1 in let b = 2 in a + b)[@res.braces ]) -;;(([(({js|\n|js} -> React.string)[@res.braces ])])[@JSX ]) \ No newline at end of file +;;<>(({js|\n|js} -> React.string)[@res.braces ]) \ No newline at end of file diff --git a/tests/syntax_tests/data/parsing/grammar/expressions/expected/jsx.res.txt b/tests/syntax_tests/data/parsing/grammar/expressions/expected/jsx.res.txt index 7a853a944a..b4004d3d06 100644 --- a/tests/syntax_tests/data/parsing/grammar/expressions/expected/jsx.res.txt +++ b/tests/syntax_tests/data/parsing/grammar/expressions/expected/jsx.res.txt @@ -51,8 +51,8 @@ let _ = ((el ~punned ~children:[] ())[@JSX ]) let _ = ((el ?punned ~children:[] ())[@JSX ]) let _ = ((el ?a:b ~children:[] ())[@JSX ]) let _ = ((el ?a:b ~children:[] ())[@JSX ]) -let _ = (([])[@JSX ]) -let _ = (([])[@JSX ]) +let _ = <> +let _ = <> let _ = ((div ~className:{js|menu|js} ~children:[((div ~className:{js|submenu|js} ~children:[sub1] ()) @@ -83,8 +83,7 @@ let _ = ((Outer.createElement ~inner:((Inner.createElement ~children:[] ()) [@JSX ]) ~children:[] ()) [@JSX ]) -let _ = - ((div ~onClick:onClickHandler ~children:[(([{js|foobar|js}])[@JSX ])] ()) +let _ = ((div ~onClick:onClickHandler ~children:[<>{js|foobar|js}] ()) [@JSX ]) let _ = ((Window.createElement @@ -98,21 +97,19 @@ let _ = } ~children:[] ()) [@JSX ]) let _ = ((OverEager.createElement ~fiber:Metal.fiber ~children:[] ())[@JSX ]) -let arrayOfListOfJsx = [|(([])[@JSX ])|] -let arrayOfListOfJsx = - [|(([((Foo.createElement ~children:[] ())[@JSX ])])[@JSX ])|] +let arrayOfListOfJsx = [|<>|] +let arrayOfListOfJsx = [|<>((Foo.createElement ~children:[] ())[@JSX ])|] let arrayOfListOfJsx = - [|(([((Foo.createElement ~children:[] ())[@JSX ])]) - [@JSX ]);(([((Bar.createElement ~children:[] ())[@JSX ])])[@JSX ])|] -let sameButWithSpaces = [|(([])[@JSX ])|] -let sameButWithSpaces = - [|(([((Foo.createElement ~children:[] ())[@JSX ])])[@JSX ])|] + [|<>((Foo.createElement ~children:[] ()) + [@JSX ]);<>((Bar.createElement ~children:[] ())[@JSX ])|] +let sameButWithSpaces = [|<>|] +let sameButWithSpaces = [|<>((Foo.createElement ~children:[] ())[@JSX ])|] let sameButWithSpaces = - [|(([((Foo.createElement ~children:[] ())[@JSX ])]) - [@JSX ]);(([((Bar.createElement ~children:[] ())[@JSX ])])[@JSX ])|] + [|<>((Foo.createElement ~children:[] ()) + [@JSX ]);<>((Bar.createElement ~children:[] ())[@JSX ])|] let sameButWithSpaces = - [|(([((Foo.createElement ~children:[] ())[@JSX ])]) - [@JSX ]);(([((Bar.createElement ~children:[] ())[@JSX ])])[@JSX ])|] + [|<>((Foo.createElement ~children:[] ()) + [@JSX ]);<>((Bar.createElement ~children:[] ())[@JSX ])|] let arrayOfJsx = [||] let arrayOfJsx = [|((Foo.createElement ~children:[] ())[@JSX ])|] let arrayOfJsx = @@ -495,11 +492,11 @@ let _ = ;;((div ~children:[|a|] ())[@JSX ]) ;;((div ~children:(1, 2) ())[@JSX ]) ;;((div ~children:((array -> f)[@res.braces ]) ())[@JSX ]) -;;(([element])[@JSX ]) -;;(([(((fun [arity:1]a -> 1))[@res.braces ])])[@JSX ]) -;;(([((span ~children:[] ())[@JSX ])])[@JSX ]) -;;(([[|a|]])[@JSX ]) -;;(([(1, 2)])[@JSX ]) -;;(([((array -> f)[@res.braces ])])[@JSX ]) +;;<>element +;;<>((fun [arity:1]a -> 1)[@res.braces ]) +;;<>((span ~children:[] ())[@JSX ]) +;;<>[|a|] +;;<>(1, 2) +;;<>((array -> f)[@res.braces ]) let _ = ((A.createElement ~x:{js|y|js} ~_spreadProps:str ~children:[] ()) [@JSX ]) \ No newline at end of file diff --git a/tests/syntax_tests/data/printer/expr/expected/braced.res.txt b/tests/syntax_tests/data/printer/expr/expected/braced.res.txt index 26c9d855b4..80ea824389 100644 --- a/tests/syntax_tests/data/printer/expr/expected/braced.res.txt +++ b/tests/syntax_tests/data/printer/expr/expected/braced.res.txt @@ -318,5 +318,5 @@ let x = { } // string constant should be printed correct -(<> {"\n"->React.string} ) -(<> {"\""->React.string} ) +<> {"\n"->React.string} +<> {"\""->React.string} diff --git a/tests/syntax_tests/data/printer/expr/expected/switch.res.txt b/tests/syntax_tests/data/printer/expr/expected/switch.res.txt index da576e4d29..80b1a07044 100644 --- a/tests/syntax_tests/data/printer/expr/expected/switch.res.txt +++ b/tests/syntax_tests/data/printer/expr/expected/switch.res.txt @@ -49,8 +49,7 @@ switch route {
{React.string("Second A div")}
| B => - <> - // fragment tag moves to the next line + <> // fragment tag stays after <>
{React.string("First B div")}
{React.string("Second B div")}
diff --git a/tests/syntax_tests/data/printer/expr/switch.res b/tests/syntax_tests/data/printer/expr/switch.res index 7d4f8aa0f6..6887e3adb5 100644 --- a/tests/syntax_tests/data/printer/expr/switch.res +++ b/tests/syntax_tests/data/printer/expr/switch.res @@ -44,7 +44,7 @@ switch route {
{React.string("First A div")}
{React.string("Second A div")}
-| B => <> // fragment tag moves to the next line +| B => <> // fragment tag stays after <>
{React.string("First B div")}
{React.string("Second B div")}
From 28aa287b1aafd415a14aa726d5710e94f06ce201 Mon Sep 17 00:00:00 2001 From: nojaf Date: Mon, 24 Feb 2025 13:38:52 +0100 Subject: [PATCH 2/3] Initial mapping from0 --- compiler/ml/ast_mapper_from0.ml | 4 ++++ tests/tools_tests/package-lock.json | 2 +- tests/tools_tests/ppx/TestPpx.res | 4 ++++ tests/tools_tests/src/expected/TestPpx.res.jsout | 5 +++++ 4 files changed, 14 insertions(+), 1 deletion(-) diff --git a/compiler/ml/ast_mapper_from0.ml b/compiler/ml/ast_mapper_from0.ml index 1e3e3687b7..caf646b661 100644 --- a/compiler/ml/ast_mapper_from0.ml +++ b/compiler/ml/ast_mapper_from0.ml @@ -358,6 +358,10 @@ module E = struct match_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel) | Pexp_try (e, pel) -> try_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel) | Pexp_tuple el -> tuple ~loc ~attrs (List.map (sub.expr sub) el) + | Pexp_construct ({txt = Longident.Lident "[]"}, None) + when attrs |> List.exists (fun ({txt}, _) -> txt == "JSX") -> + let attrs = attrs |> List.filter (fun ({txt}, _) -> txt != "JSX") in + jsx_fragment ~loc ~attrs loc.loc_start [] loc.loc_end | Pexp_construct (lid, arg) -> ( let lid1 = map_loc sub lid in let arg1 = map_opt (sub.expr sub) arg in diff --git a/tests/tools_tests/package-lock.json b/tests/tools_tests/package-lock.json index 9d3242c476..7ab9790b95 100644 --- a/tests/tools_tests/package-lock.json +++ b/tests/tools_tests/package-lock.json @@ -26,7 +26,7 @@ }, "devDependencies": { "@biomejs/biome": "1.8.3", - "mocha": "10.1.0", + "mocha": "10.8.2", "nyc": "15.0.0" }, "engines": { diff --git a/tests/tools_tests/ppx/TestPpx.res b/tests/tools_tests/ppx/TestPpx.res index b18c96a8ae..d42c9b8e12 100644 --- a/tests/tools_tests/ppx/TestPpx.res +++ b/tests/tools_tests/ppx/TestPpx.res @@ -61,3 +61,7 @@ let eq2 = 3 === 3 let test = async () => 12 let f = async () => (await test()) + 1 + +module Fragments = { + let f1 = <> +} diff --git a/tests/tools_tests/src/expected/TestPpx.res.jsout b/tests/tools_tests/src/expected/TestPpx.res.jsout index 87ea7737ee..829050f25c 100644 --- a/tests/tools_tests/src/expected/TestPpx.res.jsout +++ b/tests/tools_tests/src/expected/TestPpx.res.jsout @@ -80,6 +80,10 @@ async function f() { return await test() + 1 | 0; } +let Fragments = { + f1: /* [] */0 +}; + let a = "A"; let b = "B"; @@ -114,4 +118,5 @@ exports.eq = eq; exports.eq2 = eq2; exports.test = test; exports.f = f; +exports.Fragments = Fragments; /* Not a pure module */ From b57f2df2b79edaf84ee2838c84c9054cbd2b2de6 Mon Sep 17 00:00:00 2001 From: nojaf Date: Mon, 24 Feb 2025 13:54:36 +0100 Subject: [PATCH 3/3] Format code --- tests/tools_tests/ppx/TestPpx.res | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/tools_tests/ppx/TestPpx.res b/tests/tools_tests/ppx/TestPpx.res index d42c9b8e12..4262befc9f 100644 --- a/tests/tools_tests/ppx/TestPpx.res +++ b/tests/tools_tests/ppx/TestPpx.res @@ -63,5 +63,5 @@ let test = async () => 12 let f = async () => (await test()) + 1 module Fragments = { - let f1 = <> + let f1 = <> }