From f8d5e36a2da4450387c9fa0cb1ff9a755ecf8b11 Mon Sep 17 00:00:00 2001 From: nojaf Date: Sun, 10 Aug 2025 21:13:35 +0200 Subject: [PATCH 01/12] Add jsx_tag_name --- analysis/src/CompletionFrontEnd.ml | 38 +- analysis/src/SemanticTokens.ml | 32 +- compiler/ml/ast_helper.ml | 15 + compiler/ml/ast_helper.mli | 7 +- compiler/ml/ast_iterator.ml | 8 +- compiler/ml/ast_mapper.ml | 6 +- compiler/ml/ast_mapper_from0.ml | 17 +- compiler/ml/ast_mapper_to0.ml | 22 +- compiler/ml/depend.ml | 9 +- compiler/ml/parsetree.ml | 11 +- compiler/ml/pprintast.ml | 16 +- compiler/ml/printast.ml | 12 +- compiler/syntax/src/jsx_v4.ml | 40 +- compiler/syntax/src/res_comments_table.ml | 38 +- compiler/syntax/src/res_core.ml | 341 ++++++++++++------ compiler/syntax/src/res_parsetree_viewer.ml | 7 +- compiler/syntax/src/res_printer.ml | 115 +++--- .../tests/src/expected/Completion.res.txt | 16 +- .../errors/expressions/expected/jsx.res.txt | 6 +- 19 files changed, 510 insertions(+), 246 deletions(-) diff --git a/analysis/src/CompletionFrontEnd.ml b/analysis/src/CompletionFrontEnd.ml index fb92e81d19..b0003739da 100644 --- a/analysis/src/CompletionFrontEnd.ml +++ b/analysis/src/CompletionFrontEnd.ml @@ -1351,14 +1351,27 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor children | _ -> JSXChildrenItems [] in + let compName_loc = + match compName with + | Parsetree.Lower {loc; _} + | Parsetree.QualifiedLower {loc; _} + | Parsetree.Upper {loc; _} -> + loc + in + let compName_lid = Ast_helper.longident_of_jsx_tag_name compName in let jsxProps = - CompletionJsx.extractJsxProps ~compName ~props ~children + CompletionJsx.extractJsxProps + ~compName:(Location.mkloc compName_lid compName_loc) + ~props ~children + in + let compNamePath = + flattenLidCheckDot ~jsx:true + {txt = compName_lid; loc = compName_loc} in - let compNamePath = flattenLidCheckDot ~jsx:true compName in if debug then Printf.printf "JSX <%s:%s %s> _children:%s\n" (compNamePath |> String.concat ".") - (Loc.toString compName.loc) + (Loc.toString compName_loc) (jsxProps.props |> List.map (fun ({name; posStart; posEnd; exp} : CompletionJsx.prop) -> @@ -1369,6 +1382,19 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor (match jsxProps.childrenStart with | None -> "None" | Some childrenPosStart -> Pos.toString childrenPosStart); + (* If the tag name is an uppercase path and the cursor is right after a dot (e.g., + setResult + (Cpath + (CPId + { + loc = compName_loc; + path = compNamePath; + completionContext = Module; + })) + | _ -> ()); let jsxCompletable = match expr.pexp_desc with | Pexp_jsx_element @@ -1383,11 +1409,11 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor | _ -> CompletionJsx.findJsxPropsCompletable ~jsxProps ~endPos:(Loc.end_ expr.pexp_loc) ~posBeforeCursor - ~posAfterCompName:(Loc.end_ compName.loc) + ~posAfterCompName:(Loc.end_ compName_loc) ~firstCharBeforeCursorNoWhite ~charAtCursor in if jsxCompletable <> None then setResultOpt jsxCompletable - else if compName.loc |> Loc.hasPos ~pos:posBeforeCursor then + else if compName_loc |> Loc.hasPos ~pos:posBeforeCursor then setResult (match compNamePath with | [prefix] when Char.lowercase_ascii prefix.[0] = prefix.[0] -> @@ -1396,7 +1422,7 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor Cpath (CPId { - loc = compName.loc; + loc = compName_loc; path = compNamePath; completionContext = Module; })) diff --git a/analysis/src/SemanticTokens.ml b/analysis/src/SemanticTokens.ml index a3b509a493..0cc0024523 100644 --- a/analysis/src/SemanticTokens.ml +++ b/analysis/src/SemanticTokens.ml @@ -265,7 +265,15 @@ let command ~debug ~emitter ~path = *) emitter (* --> emitJsxTag ~debug ~name:"<" ~pos:(Loc.start e.pexp_loc); - emitter |> emitJsxOpen ~lid:lident.txt ~debug ~loc:lident.loc; + let lid = Ast_helper.longident_of_jsx_tag_name lident in + let loc = + match lident with + | Parsetree.Lower {loc; _} + | Parsetree.QualifiedLower {loc; _} + | Parsetree.Upper {loc; _} -> + loc + in + emitter |> emitJsxOpen ~lid ~debug ~loc; let closing_line, closing_column = Loc.end_ e.pexp_loc in emitter (* <-- *) |> emitJsxTag ~debug ~name:"/>" ~pos:(closing_line, closing_column - 2) @@ -281,7 +289,15 @@ let command ~debug ~emitter ~path = (* opening tag *) emitter (* --> emitJsxTag ~debug ~name:"<" ~pos:(Loc.start e.pexp_loc); - emitter |> emitJsxOpen ~lid:lident.txt ~debug ~loc:lident.loc; + let lid = Ast_helper.longident_of_jsx_tag_name lident in + let loc = + match lident with + | Parsetree.Lower {loc; _} + | Parsetree.QualifiedLower {loc; _} + | Parsetree.Upper {loc; _} -> + loc + in + emitter |> emitJsxOpen ~lid ~debug ~loc; emitter (* <-- *) |> emitJsxTag ~debug ~name:">" ~pos:(Pos.ofLexing posOfGreatherthanAfterProps); @@ -308,9 +324,15 @@ let command ~debug ~emitter ~path = emitter |> emitJsxTag ~debug ~name:" emitJsxClose ~debug ~lid:lident.txt - ~pos:(Loc.start tag_name_end.loc); + let lid = Ast_helper.longident_of_jsx_tag_name tag_name_end in + let loc = + match tag_name_end with + | Parsetree.Lower {loc; _} + | Parsetree.QualifiedLower {loc; _} + | Parsetree.Upper {loc; _} -> + loc + in + emitter |> emitJsxClose ~debug ~lid ~pos:(Loc.end_ loc); emitter (* ... <-- *) |> emitJsxTag ~debug ~name:">" ~pos:(Pos.ofLexing final_greather_than)) diff --git a/compiler/ml/ast_helper.ml b/compiler/ml/ast_helper.ml index baab03db21..558478a415 100644 --- a/compiler/ml/ast_helper.ml +++ b/compiler/ml/ast_helper.ml @@ -428,3 +428,18 @@ module Te = struct pext_attributes = attrs; } end + +(* Helpers for JSX *) +let string_of_jsx_tag_name (tag_name : Parsetree.jsx_tag_name) : string = + match tag_name with + | Parsetree.Lower {name; _} -> name + | Parsetree.QualifiedLower {path; name; _} -> + String.concat "." (Longident.flatten path) ^ "." ^ name + | Parsetree.Upper {path; _} -> String.concat "." (Longident.flatten path) + +let longident_of_jsx_tag_name (tag_name : Parsetree.jsx_tag_name) : Longident.t + = + match tag_name with + | Parsetree.Lower {name; _} -> Longident.Lident name + | Parsetree.QualifiedLower {path; name; _} -> Longident.Ldot (path, name) + | Parsetree.Upper {path; _} -> path diff --git a/compiler/ml/ast_helper.mli b/compiler/ml/ast_helper.mli index 889e617b7d..41c1914391 100644 --- a/compiler/ml/ast_helper.mli +++ b/compiler/ml/ast_helper.mli @@ -212,13 +212,13 @@ module Exp : sig val jsx_unary_element : ?loc:loc -> ?attrs:attrs -> - Longident.t Location.loc -> + Parsetree.jsx_tag_name -> Parsetree.jsx_props -> expression val jsx_container_element : ?loc:loc -> ?attrs:attrs -> - Longident.t Location.loc -> + Parsetree.jsx_tag_name -> Parsetree.jsx_props -> Lexing.position -> Parsetree.jsx_children -> @@ -301,6 +301,9 @@ module Te : sig val rebind : ?loc:loc -> ?attrs:attrs -> str -> lid -> extension_constructor end +val string_of_jsx_tag_name : Parsetree.jsx_tag_name -> string +val longident_of_jsx_tag_name : Parsetree.jsx_tag_name -> Longident.t + (** {1 Module language} *) (** Module type expressions *) diff --git a/compiler/ml/ast_iterator.ml b/compiler/ml/ast_iterator.ml index 4380ca1af2..5795ffafd7 100644 --- a/compiler/ml/ast_iterator.ml +++ b/compiler/ml/ast_iterator.ml @@ -365,18 +365,18 @@ module E = struct iter_jsx_children sub children | Pexp_jsx_element (Jsx_unary_element - {jsx_unary_element_tag_name = name; jsx_unary_element_props = props}) + {jsx_unary_element_tag_name = _name; jsx_unary_element_props = props}) -> - iter_loc sub name; + (* jsx_tag_name contains a Location.t inside; attributes and visitors can + visit props and children as before *) iter_jsx_props sub props | Pexp_jsx_element (Jsx_container_element { - jsx_container_element_tag_name_start = name; + jsx_container_element_tag_name_start = _name; jsx_container_element_props = props; jsx_container_element_children = children; }) -> - iter_loc sub name; iter_jsx_props sub props; iter_jsx_children sub children end diff --git a/compiler/ml/ast_mapper.ml b/compiler/ml/ast_mapper.ml index e2f4d6cad0..7476c01741 100644 --- a/compiler/ml/ast_mapper.ml +++ b/compiler/ml/ast_mapper.ml @@ -358,7 +358,8 @@ module E = struct (Jsx_unary_element {jsx_unary_element_tag_name = name; jsx_unary_element_props = props}) -> - jsx_unary_element ~loc ~attrs (map_loc sub name) (map_jsx_props sub props) + (* pass through jsx_tag_name unchanged; it is not a loc *) + jsx_unary_element ~loc ~attrs name (map_jsx_props sub props) | Pexp_jsx_element (Jsx_container_element { @@ -368,8 +369,7 @@ module E = struct jsx_container_element_children = children; jsx_container_element_closing_tag = closing_tag; }) -> - jsx_container_element ~loc ~attrs (map_loc sub name) - (map_jsx_props sub props) ote + jsx_container_element ~loc ~attrs name (map_jsx_props sub props) ote (map_jsx_children sub children) closing_tag end diff --git a/compiler/ml/ast_mapper_from0.ml b/compiler/ml/ast_mapper_from0.ml index 4f1f6fff60..c34dd50a0f 100644 --- a/compiler/ml/ast_mapper_from0.ml +++ b/compiler/ml/ast_mapper_from0.ml @@ -396,10 +396,23 @@ module E = struct when has_jsx_attribute () -> ( let attrs = attrs |> List.filter (fun ({txt}, _) -> txt <> "JSX") in let props, children = extract_props_and_children sub args in + let jsx_tag : Pt.jsx_tag_name = + match tag_name.txt with + | Longident.Lident s + when String.length s > 0 && Char.lowercase_ascii s.[0] = s.[0] -> + Pt.Lower {name = s; loc = tag_name.loc} + | Longident.Lident _ -> + Pt.Upper {path = tag_name.txt; loc = tag_name.loc} + | Longident.Ldot (path, last) + when String.length last > 0 + && Char.lowercase_ascii last.[0] = last.[0] -> + Pt.QualifiedLower {path; name = last; loc = tag_name.loc} + | _ -> Pt.Upper {path = tag_name.txt; loc = tag_name.loc} + in match children with - | None -> jsx_unary_element ~loc ~attrs tag_name props + | None -> jsx_unary_element ~loc ~attrs jsx_tag props | Some children -> - jsx_container_element ~loc ~attrs tag_name props Lexing.dummy_pos + jsx_container_element ~loc ~attrs jsx_tag props Lexing.dummy_pos children None) | Pexp_apply (e, l) -> let e = diff --git a/compiler/ml/ast_mapper_to0.ml b/compiler/ml/ast_mapper_to0.ml index 57101ff671..33502694ac 100644 --- a/compiler/ml/ast_mapper_to0.ml +++ b/compiler/ml/ast_mapper_to0.ml @@ -495,7 +495,16 @@ module E = struct jsx_unary_element_tag_name = tag_name; jsx_unary_element_props = props; }) -> - let tag_ident = map_loc sub tag_name in + let tag_ident : Longident.t Location.loc = + let txt, loc = + match tag_name with + | Lower {name; loc} -> (Longident.Lident name, loc) + | QualifiedLower {path; name; loc} -> + (Longident.Ldot (path, name), loc) + | Upper {path; loc} -> (path, loc) + in + {txt; loc} + in let props = map_jsx_props sub props in let children_expr = let loc = @@ -525,7 +534,16 @@ module E = struct jsx_container_element_props = props; jsx_container_element_children = children; }) -> - let tag_ident = map_loc sub tag_name in + let tag_ident : Longident.t Location.loc = + let txt, loc = + match tag_name with + | Lower {name; loc} -> (Longident.Lident name, loc) + | QualifiedLower {path; name; loc} -> + (Longident.Ldot (path, name), loc) + | Upper {path; loc} -> (path, loc) + in + {txt; loc} + in let props = map_jsx_props sub props in let children_expr = map_jsx_children sub loc children in apply ~loc ~attrs:(jsx_attr sub :: attrs) (ident tag_ident) diff --git a/compiler/ml/depend.ml b/compiler/ml/depend.ml index 63be3846ba..54ff81f1d7 100644 --- a/compiler/ml/depend.ml +++ b/compiler/ml/depend.ml @@ -294,7 +294,10 @@ let rec add_expr bv exp = (Jsx_unary_element {jsx_unary_element_tag_name = name; jsx_unary_element_props = props}) -> - add bv name; + (* Conservatively add all module path segments referenced by the tag name *) + (match name with + | Lower _ -> () + | QualifiedLower {path; _} | Upper {path; _} -> add_path bv path); and_jsx_props bv props | Pexp_jsx_element (Jsx_container_element @@ -303,7 +306,9 @@ let rec add_expr bv exp = jsx_container_element_props = props; jsx_container_element_children = children; }) -> - add bv name; + (match name with + | Lower _ -> () + | QualifiedLower {path; _} | Upper {path; _} -> add_path bv path); and_jsx_props bv props; add_jsx_children bv children diff --git a/compiler/ml/parsetree.ml b/compiler/ml/parsetree.ml index 77194522e8..190580bfa9 100644 --- a/compiler/ml/parsetree.ml +++ b/compiler/ml/parsetree.ml @@ -325,6 +325,11 @@ and jsx_element = | Jsx_unary_element of jsx_unary_element | Jsx_container_element of jsx_container_element +and jsx_tag_name = + | Lower of {name: string; loc: Location.t} + | QualifiedLower of {path: Longident.t; name: string; loc: Location.t} + | Upper of {path: Longident.t; loc: Location.t} + and jsx_fragment = { (* > *) jsx_fragment_opening: Lexing.position; (* children *) jsx_fragment_children: jsx_children; @@ -332,13 +337,13 @@ and jsx_fragment = { } and jsx_unary_element = { - jsx_unary_element_tag_name: Longident.t loc; + jsx_unary_element_tag_name: jsx_tag_name; jsx_unary_element_props: jsx_props; } and jsx_container_element = { (* jsx_container_element_opening_tag_start: Lexing.position; *) - jsx_container_element_tag_name_start: Longident.t loc; + jsx_container_element_tag_name_start: jsx_tag_name; (* > *) jsx_container_element_opening_tag_end: Lexing.position; jsx_container_element_props: jsx_props; @@ -376,7 +381,7 @@ and jsx_closing_container_tag = { (* *) jsx_closing_container_tag_end: Lexing.position; } diff --git a/compiler/ml/pprintast.ml b/compiler/ml/pprintast.ml index ff7f3f8c70..4064ee8e17 100644 --- a/compiler/ml/pprintast.ml +++ b/compiler/ml/pprintast.ml @@ -805,7 +805,13 @@ and simple_expr ctxt f x = jsx_unary_element_tag_name = tag_name; jsx_unary_element_props = props; }) -> ( - let name = Longident.flatten tag_name.txt |> String.concat "." in + let name = + match tag_name with + | Lower {name} -> name + | QualifiedLower {path; name; _} -> + (Longident.flatten path |> String.concat ".") ^ "." ^ name + | Upper {path; _} -> Longident.flatten path |> String.concat "." + in match props with | [] -> pp f "<%s />" name | _ -> pp f "<%s %a />" name (print_jsx_props ctxt) props) @@ -816,7 +822,13 @@ and simple_expr ctxt f x = jsx_container_element_props = props; jsx_container_element_children = children; }) -> ( - let name = Longident.flatten tag_name.txt |> String.concat "." in + let name = + match tag_name with + | Lower {name} -> name + | QualifiedLower {path; name; _} -> + (Longident.flatten path |> String.concat ".") ^ "." ^ name + | Upper {path; _} -> Longident.flatten path |> String.concat "." + in match props with | [] -> pp f "<%s>%a" name diff --git a/compiler/ml/printast.ml b/compiler/ml/printast.ml index 4d2ea003d0..b95f5fcde1 100644 --- a/compiler/ml/printast.ml +++ b/compiler/ml/printast.ml @@ -42,6 +42,14 @@ let rec fmt_longident_aux f x = let fmt_longident_loc f (x : Longident.t loc) = fprintf f "\"%a\" %a" fmt_longident_aux x.txt fmt_location x.loc +let fmt_jsx_tag_name f (x : jsx_tag_name) = + match x with + | Lower {name; loc} -> fprintf f "\"%s\" %a" name fmt_location loc + | QualifiedLower {path; name; loc} -> + fprintf f "\"%a.%s\" %a" fmt_longident_aux path name fmt_location loc + | Upper {path; loc} -> + fprintf f "\"%a\" %a" fmt_longident_aux path fmt_location loc + let fmt_string_loc f (x : string loc) = fprintf f "\"%s\" %a" x.txt fmt_location x.loc @@ -350,7 +358,7 @@ and expression i ppf x = (Jsx_unary_element {jsx_unary_element_tag_name = name; jsx_unary_element_props = props}) -> - line i ppf "Pexp_jsx_unary_element %a\n" fmt_longident_loc name; + line i ppf "Pexp_jsx_unary_element %a\n" fmt_jsx_tag_name name; jsx_props i ppf props | Pexp_jsx_element (Jsx_container_element @@ -360,7 +368,7 @@ and expression i ppf x = jsx_container_element_opening_tag_end = gt; jsx_container_element_children = children; }) -> - line i ppf "Pexp_jsx_container_element %a\n" fmt_longident_loc name; + line i ppf "Pexp_jsx_container_element %a\n" fmt_jsx_tag_name name; jsx_props i ppf props; if !Clflags.dump_location then line i ppf "> %a\n" (fmt_position false) gt; jsx_children i ppf children diff --git a/compiler/syntax/src/jsx_v4.ml b/compiler/syntax/src/jsx_v4.ml index b7ec8b15e3..b78d741124 100644 --- a/compiler/syntax/src/jsx_v4.ml +++ b/compiler/syntax/src/jsx_v4.ml @@ -1095,6 +1095,15 @@ let starts_with_uppercase s = let c = s.[0] in Char.uppercase_ascii c = c +let jsx_tag_name_to_string_and_loc (tag_name : jsx_tag_name) : + string * Location.t = + let name = Ast_helper.string_of_jsx_tag_name tag_name in + let loc = + match tag_name with + | Lower {loc; _} | QualifiedLower {loc; _} | Upper {loc; _} -> loc + in + (name, loc) + (* There appear to be slightly different rules of transformation whether the component is upper-, lowercase or a fragment *) type componentDescription = | LowercasedComponent @@ -1289,12 +1298,19 @@ let mk_react_jsx (config : Jsx_common.jsx_config) mapper loc attrs *) let mk_uppercase_tag_name_expr tag_name = let tag_identifier : Longident.t = - if Longident.flatten tag_name.txt |> List.for_all starts_with_uppercase then - (* All parts are uppercase, so we append .make *) - Ldot (tag_name.txt, "make") - else tag_name.txt + match tag_name with + | Lower {name; _} -> Longident.Lident name + | QualifiedLower {path; name; _} -> Longident.Ldot (path, name) + | Upper {path; _} -> + if Longident.flatten path |> List.for_all starts_with_uppercase then + Longident.Ldot (path, "make") + else path + in + let loc = + match tag_name with + | Lower {loc; _} | QualifiedLower {loc; _} | Upper {loc; _} -> loc in - Exp.ident ~loc:tag_name.loc {txt = tag_identifier; loc = tag_name.loc} + Exp.ident ~loc {txt = tag_identifier; loc} let expr ~(config : Jsx_common.jsx_config) mapper expression = match expression with @@ -1313,10 +1329,10 @@ let expr ~(config : Jsx_common.jsx_config) mapper expression = | Jsx_unary_element {jsx_unary_element_tag_name = tag_name; jsx_unary_element_props = props} -> - let name = Longident.flatten tag_name.txt |> String.concat "." in + let name, tag_loc = jsx_tag_name_to_string_and_loc tag_name in if starts_with_lowercase name then (* For example 'input' *) - let component_name_expr = constant_string ~loc:tag_name.loc name in + let component_name_expr = constant_string ~loc:tag_loc name in mk_react_jsx config mapper loc attrs LowercasedComponent component_name_expr props (JSXChildrenItems []) else if starts_with_uppercase name then @@ -1326,20 +1342,19 @@ let expr ~(config : Jsx_common.jsx_config) mapper expression = (JSXChildrenItems []) else Jsx_common.raise_error ~loc - "JSX: element name is neither upper- or lowercase, got \"%s\"" - (Longident.flatten tag_name.txt |> String.concat ".") + "JSX: element name is neither upper- or lowercase, got \"%s\"" name | Jsx_container_element { jsx_container_element_tag_name_start = tag_name; jsx_container_element_props = props; jsx_container_element_children = children; } -> - let name = Longident.flatten tag_name.txt |> String.concat "." in + let name, tag_loc = jsx_tag_name_to_string_and_loc tag_name in (* For example:


This has an impact if we want to use ReactDOM.jsx or ReactDOM.jsxs *) if starts_with_lowercase name then - let component_name_expr = constant_string ~loc:tag_name.loc name in + let component_name_expr = constant_string ~loc:tag_loc name in mk_react_jsx config mapper loc attrs LowercasedComponent component_name_expr props children else if starts_with_uppercase name then @@ -1349,8 +1364,7 @@ let expr ~(config : Jsx_common.jsx_config) mapper expression = children else Jsx_common.raise_error ~loc - "JSX: element name is neither upper- or lowercase, got \"%s\"" - (Longident.flatten tag_name.txt |> String.concat ".")) + "JSX: element name is neither upper- or lowercase, got \"%s\"" name) | e -> default_mapper.expr mapper e let module_binding ~(config : Jsx_common.jsx_config) mapper module_binding = diff --git a/compiler/syntax/src/res_comments_table.ml b/compiler/syntax/src/res_comments_table.ml index 59946df5e1..f91d7ad880 100644 --- a/compiler/syntax/src/res_comments_table.ml +++ b/compiler/syntax/src/res_comments_table.ml @@ -1682,12 +1682,26 @@ and walk_expression expr t comments = | [] -> closing_token_loc | head :: _ -> ParsetreeViewer.get_jsx_prop_loc head in - partition_adjacent_trailing_before_next_token_on_same_line tag_name.loc + let name_loc = + match tag_name with + | Parsetree.Lower {loc; _} + | Parsetree.QualifiedLower {loc; _} + | Parsetree.Upper {loc; _} -> + loc + in + partition_adjacent_trailing_before_next_token_on_same_line name_loc next_token comments in (* Only attach comments to the element name if they are on the same line *) - attach t.trailing tag_name.loc after_opening_tag_name; + let name_loc = + match tag_name with + | Parsetree.Lower {loc; _} + | Parsetree.QualifiedLower {loc; _} + | Parsetree.Upper {loc; _} -> + loc + in + attach t.trailing name_loc after_opening_tag_name; match props with | [] -> let before_closing_token, _rest = @@ -1726,11 +1740,25 @@ and walk_expression expr t comments = | [] -> opening_greater_than_loc | head :: _ -> ParsetreeViewer.get_jsx_prop_loc head in - partition_adjacent_trailing_before_next_token_on_same_line - tag_name_start.loc next_token comments + let name_loc = + match tag_name_start with + | Parsetree.Lower {loc; _} + | Parsetree.QualifiedLower {loc; _} + | Parsetree.Upper {loc; _} -> + loc + in + partition_adjacent_trailing_before_next_token_on_same_line name_loc + next_token comments in (* Only attach comments to the element name if they are on the same line *) - attach t.trailing tag_name_start.loc after_opening_tag_name; + let name_loc = + match tag_name_start with + | Parsetree.Lower {loc; _} + | Parsetree.QualifiedLower {loc; _} + | Parsetree.Upper {loc; _} -> + loc + in + attach t.trailing name_loc after_opening_tag_name; let rest = match props with | [] -> diff --git a/compiler/syntax/src/res_core.ml b/compiler/syntax/src/res_core.ml index 3702403c1b..980af86c4d 100644 --- a/compiler/syntax/src/res_core.ml +++ b/compiler/syntax/src/res_core.ml @@ -721,46 +721,120 @@ let parse_module_long_ident_tail ~lowercase p start_pos ident = - All immediately following ("-" IDENT) chunks have been consumed from the scanner - No hyphen that belongs to the JSX name remains unconsumed - The returned token is the combined Lident/Uident for the full name *) -let parse_jsx_ident (p : Parser.t) : Token.t option = - (* check if the next tokens are minus and ident, if so, add them to the buffer *) - let rec visit buffer = - match p.Parser.token with - | Minus -> ( +(* Non-mutating helpers to parse JSX identifiers with optional hyphen chains *) +type jsx_ident_kind = [`Lower | `Upper] + +(* Inspect current token; do not advance *) +let peek_ident (p : Parser.t) : (string * Location.t * jsx_ident_kind) option = + match p.Parser.token with + | Lident txt -> Some (txt, mk_loc p.start_pos p.end_pos, `Lower) + | Uident txt -> Some (txt, mk_loc p.start_pos p.end_pos, `Upper) + | _ -> None + +(* Consume one Lident/Uident if present *) +let expect_ident (p : Parser.t) : (string * Location.t * jsx_ident_kind) option + = + match peek_ident p with + | None -> None + | Some (txt, loc, k) -> + Parser.next p; + Some (txt, loc, k) + +(* Consume ("-" IDENT)*, appending to buffer; update last_end; diagnose trailing '-' *) +let rec read_hyphen_chain (p : Parser.t) (buf : Buffer.t) + (last_end : Lexing.position ref) : unit = + match p.Parser.token with + | Minus -> ( + Parser.next p; + (* after '-' *) + match peek_ident p with + | Some (txt, _loc, _) -> + Buffer.add_char buf '-'; + Buffer.add_string buf txt; + (* consume ident *) Parser.next p; + last_end := p.prev_end_pos; + read_hyphen_chain p buf last_end + | None -> + (* Match previous behavior: rely on parser's current location *) + Parser.err p + (Diagnostics.message "JSX identifier cannot end with a hyphen")) + | _ -> () + +(* Read local jsx name: returns combined name + loc + kind of head ident *) +let read_local_jsx_name (p : Parser.t) : + (string * Location.t * jsx_ident_kind) option = + match expect_ident p with + | None -> None + | Some (head, head_loc, kind) -> + let buf = Buffer.create (String.length head + 8) in + Buffer.add_string buf head; + let start_pos = head_loc.Location.loc_start in + let last_end = ref head_loc.Location.loc_end in + read_hyphen_chain p buf last_end; + let name = Buffer.contents buf in + let loc = mk_loc start_pos !last_end in + Some (name, loc, kind) + +(* Build a Longident from a non-empty list of segments *) +let longident_of_segments (segs : string list) : Longident.t = + match segs with + | [] -> Longident.Lident "_" + | hd :: tl -> + List.fold_left + (fun acc s -> Longident.Ldot (acc, s)) + (Longident.Lident hd) tl + +(* Read a JSX tag name and return a combined Longident + loc; does not mutate tokens *) +let read_jsx_tag_name (p : Parser.t) : Longident.t Location.loc option = + match peek_ident p with + | Some (_, _, `Lower) -> + read_local_jsx_name p + |> Option.map (fun (name, loc, _) -> + Location.mkloc (Longident.Lident name) loc) + | Some (seg, seg_loc, `Upper) -> + let start_pos = seg_loc.Location.loc_start in + let rev_segs = ref [seg] in + let last_end = ref seg_loc.Location.loc_end in + (* consume first Uident *) + Parser.next p; + let rec loop () = match p.Parser.token with - | Lident txt | Uident txt -> - Buffer.add_char buffer '-'; - Buffer.add_string buffer txt; - if Scanner.peekMinus p.scanner then ( + | Dot -> ( + Parser.next p; + (* after '.' *) + match peek_ident p with + | Some (txt, _loc, `Upper) -> + (* another path segment *) + rev_segs := txt :: !rev_segs; Parser.next p; - visit buffer) - else buffer + last_end := p.prev_end_pos; + loop () + | Some (_, _, `Lower) -> ( + (* final lowercase with optional hyphens *) + match read_local_jsx_name p with + | Some (lname, l_loc, _) -> + let path = longident_of_segments (List.rev !rev_segs) in + let loc = mk_loc start_pos l_loc.Location.loc_end in + Some (Location.mkloc (Longident.Ldot (path, lname)) loc) + | None -> None) + | None -> + Parser.err p + (Diagnostics.message "expected identifier after '.' in JSX tag name"); + None) | _ -> - (* Error: hyphen must be followed by an identifier *) - Parser.err p - (Diagnostics.message "JSX identifier cannot end with a hyphen"); - buffer) - | _ -> buffer - in - match p.Parser.token with - | Lident txt when Scanner.peekMinus p.scanner -> - let buffer = Buffer.create (String.length txt) in - Buffer.add_string buffer txt; - Parser.next p; - let name = visit buffer |> Buffer.contents in - Some (Token.Lident name) - | Uident txt when Scanner.peekMinus p.scanner -> - let buffer = Buffer.create (String.length txt) in - Buffer.add_string buffer txt; - Parser.next p; - let name = visit buffer |> Buffer.contents in - Some (Token.Uident name) - | _ -> None + (* pure Upper path *) + let path = longident_of_segments (List.rev !rev_segs) in + let loc = mk_loc start_pos !last_end in + Some (Location.mkloc path loc) + in + loop () + | None -> None (* Parses module identifiers: Foo Foo.Bar *) -let parse_module_long_ident ~lowercase ?(is_jsx_name : bool = false) p = +let parse_module_long_ident ~lowercase p = (* Parser.leaveBreadcrumb p Reporting.ModuleLongIdent; *) let start_pos = p.Parser.start_pos in let module_ident = @@ -777,8 +851,7 @@ let parse_module_long_ident ~lowercase ?(is_jsx_name : bool = false) p = match p.Parser.token with | Dot -> Parser.next p; - if is_jsx_name then - parse_jsx_ident p |> Option.iter (fun t -> p.Parser.token <- t); + (* For JSX names, we allow a final lowercase segment that may include hyphens. *) parse_module_long_ident_tail ~lowercase p start_pos lident | _ -> Location.mkloc lident (mk_loc start_pos end_pos)) | t -> @@ -788,25 +861,33 @@ let parse_module_long_ident ~lowercase ?(is_jsx_name : bool = false) p = (* Parser.eatBreadcrumb p; *) module_ident -let verify_jsx_opening_closing_name p - (name_longident : Longident.t Location.loc) : bool = - let closing = - match p.Parser.token with - | Lident lident -> - Parser.next p; - Longident.Lident lident - | Uident _ -> - (parse_module_long_ident ~lowercase:true ~is_jsx_name:true p).txt - | _ -> Longident.Lident "" - in - let opening = name_longident.txt in - opening = closing +(* Guard-style verifier that consumes the closing tag name from the stream, + mirroring the original semantics so downstream error ranges/messages stay identical *) +let _verify_jsx_opening_closing_name_unused_warning_hack = () let string_of_longident (longindent : Longident.t Location.loc) = Longident.flatten longindent.txt (* |> List.filter (fun s -> s <> "createElement") *) |> String.concat "." +let jsx_tag_of_longident (lid : Longident.t Location.loc) : + Parsetree.jsx_tag_name = + let loc = lid.loc in + let starts_with_lowercase s = + match s with + | "" -> false + | _ -> + let c = s.[0] in + c >= 'a' && c <= 'z' + in + match lid.txt with + | Longident.Lident s when starts_with_lowercase s -> + Parsetree.Lower {name = s; loc} + | Longident.Lident _ -> Parsetree.Upper {path = lid.txt; loc} + | Longident.Ldot (path, last) when starts_with_lowercase last -> + Parsetree.QualifiedLower {path; name = last; loc} + | _ -> Parsetree.Upper {path = lid.txt; loc} + (* open-def ::= * | open module-path * | open! module-path *) @@ -2585,21 +2666,9 @@ and parse_let_bindings ~attrs ~start_pos p = (rec_flag, loop p [first]) and parse_jsx_name p : Longident.t Location.loc = - (* jsx allows for `-` token in the name, we need to combine some tokens *) - parse_jsx_ident p |> Option.iter (fun t -> p.Parser.token <- t); - match p.Parser.token with - | Lident ident -> - let ident_start = p.start_pos in - let ident_end = p.end_pos in - Parser.next p; - let loc = mk_loc ident_start ident_end in - Location.mkloc (Longident.Lident ident) loc - | Uident _ -> - let longident = - parse_module_long_ident ~lowercase:true ~is_jsx_name:true p - in - longident - | _ -> + match read_jsx_tag_name p with + | Some lid -> lid + | None -> let msg = "A jsx name must be a lowercase or uppercase name, like: div in
\ or Navbar in " @@ -2618,8 +2687,8 @@ and parse_jsx_opening_or_self_closing_element (* start of the opening < *) let jsx_end_pos = p.end_pos in Parser.expect GreaterThan p; let loc = mk_loc start_pos jsx_end_pos in - Ast_helper.Exp.jsx_unary_element ~loc name jsx_props - | GreaterThan -> ( + Ast_helper.Exp.jsx_unary_element ~loc (jsx_tag_of_longident name) jsx_props + | GreaterThan -> (* bar *) let opening_tag_end = p.Parser.start_pos in Parser.next p; @@ -2639,51 +2708,85 @@ and parse_jsx_opening_or_self_closing_element (* start of the opening < *) (Diagnostics.message "Did you forget a ` Option.iter (fun t -> p.Parser.token <- t); - match p.Parser.token with - | (Lident _ | Uident _) when verify_jsx_opening_closing_name p name -> - let end_tag_name = {name with loc = mk_loc p.start_pos p.end_pos} in - let closing_tag_end = p.start_pos in - Parser.expect GreaterThan p; - let loc = mk_loc start_pos p.prev_end_pos in - let closing_tag = - closing_tag_start - |> Option.map (fun closing_tag_start -> - { - Parsetree.jsx_closing_container_tag_start = closing_tag_start; - jsx_closing_container_tag_name = end_tag_name; - jsx_closing_container_tag_end = closing_tag_end; - }) - in - - Ast_helper.Exp.jsx_container_element ~loc name jsx_props opening_tag_end - children closing_tag - | token -> - let () = - if Grammar.is_structure_item_start token then - let closing = "" in - let msg = Diagnostics.message ("Missing " ^ closing) in - Parser.err ~start_pos ~end_pos:p.prev_end_pos p msg - else - let opening = "" in - let msg = - "Closing jsx name should be the same as the opening name. Did you \ - mean " ^ opening ^ " ?" + (* Read the closing tag name and verify it matches the opening name *) + let token0 = p.Parser.token in + let expr_after_closing = + match token0 with + | Lident _ | Uident _ -> ( + (* Consume the closing name without mutating tokens beforehand *) + match read_jsx_tag_name p with + | Some closing_name when closing_name.txt = name.txt -> + let end_tag_name = closing_name in + let closing_tag_end = p.start_pos in + Parser.expect GreaterThan p; + let loc = mk_loc start_pos p.prev_end_pos in + let closing_tag = + closing_tag_start + |> Option.map (fun closing_tag_start -> + { + Parsetree.jsx_closing_container_tag_start = + closing_tag_start; + jsx_closing_container_tag_name = + (match end_tag_name.txt with + | Longident.Lident name -> + Parsetree.Lower {name; loc = end_tag_name.loc} + | _ -> + Parsetree.Upper + {path = end_tag_name.txt; loc = end_tag_name.loc}); + jsx_closing_container_tag_end = closing_tag_end; + }) in - Parser.err ~start_pos ~end_pos:p.prev_end_pos p - (Diagnostics.message msg); - Parser.expect GreaterThan p - in - Ast_helper.Exp.jsx_container_element - ~loc:(mk_loc start_pos p.prev_end_pos) - name jsx_props opening_tag_end children None) + Ast_helper.Exp.jsx_container_element ~loc + (jsx_tag_of_longident name) + jsx_props opening_tag_end children closing_tag + | _ -> + let () = + if Grammar.is_structure_item_start token0 then + let closing = "" in + let msg = Diagnostics.message ("Missing " ^ closing) in + Parser.err ~start_pos ~end_pos:p.prev_end_pos p msg + else + let opening = "" in + let msg = + "Closing jsx name should be the same as the opening name. Did \ + you mean " ^ opening ^ " ?" + in + Parser.err ~start_pos ~end_pos:p.prev_end_pos p + (Diagnostics.message msg); + (* read_jsx_tag_name already consumed the name; expect the '>') *) + Parser.expect GreaterThan p + in + Ast_helper.Exp.jsx_container_element + ~loc:(mk_loc start_pos p.prev_end_pos) + (jsx_tag_of_longident name) + jsx_props opening_tag_end children None) + | token -> + let () = + if Grammar.is_structure_item_start token then + let closing = "" in + let msg = Diagnostics.message ("Missing " ^ closing) in + Parser.err ~start_pos ~end_pos:p.prev_end_pos p msg + else + let opening = "" in + let msg = + "Closing jsx name should be the same as the opening name. Did \ + you mean " ^ opening ^ " ?" + in + Parser.err ~start_pos ~end_pos:p.prev_end_pos p + (Diagnostics.message msg) + in + Ast_helper.Exp.jsx_container_element + ~loc:(mk_loc start_pos p.prev_end_pos) + (jsx_tag_of_longident name) + jsx_props opening_tag_end children None + in + expr_after_closing | token -> Parser.err p (Diagnostics.unexpected token p.breadcrumbs); Ast_helper.Exp.jsx_unary_element ~loc:(mk_loc start_pos p.prev_end_pos) - name jsx_props + (jsx_tag_of_longident name) + jsx_props (* * jsx ::= @@ -2739,23 +2842,25 @@ and parse_jsx_fragment start_pos p = * | {...jsx_expr} *) and parse_jsx_prop p : Parsetree.jsx_prop option = - (* prop can have `-`, we need to combine some tokens into a single ident *) - parse_jsx_ident p |> Option.iter (fun t -> p.Parser.token <- t); match p.Parser.token with | Question | Lident _ -> ( let optional = Parser.optional p Question in - let name, loc = parse_lident p in - (* optional punning: *) - if optional then Some (Parsetree.JSXPropPunning (true, {txt = name; loc})) - else - match p.Parser.token with - | Equal -> - Parser.next p; - (* no punning *) - let optional = Parser.optional p Question in - let attr_expr = parse_primary_expr ~operand:(parse_atomic_expr p) p in - Some (Parsetree.JSXPropValue ({txt = name; loc}, optional, attr_expr)) - | _ -> Some (Parsetree.JSXPropPunning (false, {txt = name; loc}))) + (* allow hyphens inside prop names by reading a local jsx name *) + match read_local_jsx_name p with + | Some (name, loc, `Lower) -> ( + if optional then Some (Parsetree.JSXPropPunning (true, {txt = name; loc})) + else + match p.Parser.token with + | Equal -> + Parser.next p; + let optional = Parser.optional p Question in + let attr_expr = parse_primary_expr ~operand:(parse_atomic_expr p) p in + Some (Parsetree.JSXPropValue ({txt = name; loc}, optional, attr_expr)) + | _ -> Some (Parsetree.JSXPropPunning (false, {txt = name; loc}))) + | Some (_name, _loc, `Upper) -> + Parser.err p (Diagnostics.message "JSX prop names must be lowercase"); + None + | None -> None) (* {...props} *) | Lbrace -> ( let spread_start = p.Parser.start_pos in diff --git a/compiler/syntax/src/res_parsetree_viewer.ml b/compiler/syntax/src/res_parsetree_viewer.ml index fe5430ebe5..fc2d6d7bcc 100644 --- a/compiler/syntax/src/res_parsetree_viewer.ml +++ b/compiler/syntax/src/res_parsetree_viewer.ml @@ -773,7 +773,12 @@ let get_jsx_prop_loc = function let container_element_closing_tag_loc (tag : Parsetree.jsx_closing_container_tag) = { - tag.jsx_closing_container_tag_name.loc with + (match tag.jsx_closing_container_tag_name with + | Parsetree.Lower {loc; _} + | Parsetree.QualifiedLower {loc; _} + | Parsetree.Upper {loc; _} -> + loc) + with loc_start = tag.jsx_closing_container_tag_start; loc_end = tag.jsx_closing_container_tag_end; } diff --git a/compiler/syntax/src/res_printer.ml b/compiler/syntax/src/res_printer.ml index 845cf31cde..a05131ac12 100644 --- a/compiler/syntax/src/res_printer.ml +++ b/compiler/syntax/src/res_printer.ml @@ -4442,7 +4442,14 @@ and print_pexp_apply ~state expr cmt_tbl = and print_jsx_unary_tag ~state tag_name props expr_loc cmt_tbl = let name = print_jsx_name tag_name in let formatted_props = print_jsx_props ~state props cmt_tbl in - let tag_has_trailing_comment = has_trailing_comments cmt_tbl tag_name.loc in + let tag_loc = + match tag_name with + | Parsetree.Lower {loc; _} + | Parsetree.QualifiedLower {loc; _} + | Parsetree.Upper {loc; _} -> + loc + in + let tag_has_trailing_comment = has_trailing_comments cmt_tbl tag_loc in let tag_has_no_props = List.length props == 0 in let closing_token_loc = ParsetreeViewer.unary_element_closing_token expr_loc @@ -4462,9 +4469,7 @@ and print_jsx_unary_tag ~state tag_name props expr_loc cmt_tbl = ] in let opening_tag = - print_comments - (Doc.concat [Doc.less_than; name]) - cmt_tbl tag_name.Asttypes.loc + print_comments (Doc.concat [Doc.less_than; name]) cmt_tbl tag_loc in let opening_tag_doc = if tag_has_trailing_comment && not tag_has_no_props then @@ -4553,52 +4558,45 @@ and print_jsx_container_tag ~state tag_name Doc.group (Doc.concat [ - print_comments - (Doc.concat [Doc.less_than; name]) - cmt_tbl tag_name.Asttypes.loc; - (if List.length formatted_props == 0 then Doc.nil - else - Doc.indent - (Doc.concat - [ - Doc.line; - Doc.group (Doc.join formatted_props ~sep:Doc.line); - ])); - (* - if the element name has a single comment on the same line - - - - - We need to force a newline. - *) - (if - has_trailing_single_line_comment cmt_tbl - tag_name.Asttypes.loc - then Doc.concat [Doc.hard_line; opening_greater_than_doc] - (* - if the last prop has trailing comment - - - - - or there are leading comments before `>` - - - - then put > on the next line - *) - else if - last_prop_has_comment_after - || opening_greater_than_has_leading_comments - then Doc.concat [Doc.soft_line; opening_greater_than_doc] - else opening_greater_than_doc); + (* Opening tag name and props *) + (let tag_loc = + match tag_name with + | Parsetree.Lower {loc; _} + | Parsetree.QualifiedLower {loc; _} + | Parsetree.Upper {loc; _} -> + loc + in + let opening_tag_name_doc = + print_comments + (Doc.concat [Doc.less_than; name]) + cmt_tbl tag_loc + in + let props_block_doc = + if List.length formatted_props == 0 then Doc.nil + else + Doc.indent + (Doc.concat + [ + Doc.line; + Doc.group (Doc.join formatted_props ~sep:Doc.line); + ]) + in + let after_name_and_props_doc = + (* if the element name has a single comment on the same line, force newline before '>' *) + if has_trailing_single_line_comment cmt_tbl tag_loc then + Doc.concat [Doc.hard_line; opening_greater_than_doc] + else if + last_prop_has_comment_after + || opening_greater_than_has_leading_comments + then Doc.concat [Doc.soft_line; opening_greater_than_doc] + else opening_greater_than_doc + in + Doc.concat + [ + opening_tag_name_doc; + props_block_doc; + after_name_and_props_doc; + ]); ]); Doc.concat [ @@ -4783,19 +4781,12 @@ and print_jsx_prop ~state prop cmt_tbl = and print_jsx_props ~state props cmt_tbl : Doc.t list = props |> List.map (fun prop -> print_jsx_prop ~state prop cmt_tbl) -and print_jsx_name {txt = lident} = +and print_jsx_name (tag_name : Parsetree.jsx_tag_name) = let print_ident = print_ident_like ~allow_uident:true ~allow_hyphen:true in - let rec flatten acc lident = - match lident with - | Longident.Lident txt -> print_ident txt :: acc - | Ldot (lident, txt) -> flatten (print_ident txt :: acc) lident - | _ -> acc - in - match lident with - | Longident.Lident txt -> print_ident txt - | _ as lident -> - let segments = flatten [] lident in - Doc.join ~sep:Doc.dot segments + let name = Ast_helper.string_of_jsx_tag_name tag_name in + (* Split by '.' to print each segment with ident rules *) + let segments = Ext_string.split name '.' |> List.map print_ident in + Doc.join ~sep:Doc.dot segments and print_arguments_with_callback_in_first_position ~state ~partial args cmt_tbl = diff --git a/tests/analysis_tests/tests/src/expected/Completion.res.txt b/tests/analysis_tests/tests/src/expected/Completion.res.txt index 3361871351..d7208e37f6 100644 --- a/tests/analysis_tests/tests/src/expected/Completion.res.txt +++ b/tests/analysis_tests/tests/src/expected/Completion.res.txt @@ -1065,19 +1065,13 @@ Path Objects.object Complete src/Completion.res 151:6 posCursor:[151:6] posNoWhite:[151:5] Found expr:[151:3->151:6] -JSX 151:6] > _children:None -Completable: Cpath Module[O, ""] +JSX <_:__ghost__[0:-1->0:-1] > _children:None +Completable: Cpath Module[_] Package opens Stdlib.place holder Pervasives.JsxModules.place holder Resolved opens 1 Stdlib -ContextPath Module[O, ""] -Path O. -[{ - "label": "Comp", - "kind": 9, - "tags": [], - "detail": "module Comp", - "documentation": null - }] +ContextPath Module[_] +Path _ +[] Complete src/Completion.res 157:8 posCursor:[157:8] posNoWhite:[157:7] Found expr:[157:3->157:8] diff --git a/tests/syntax_tests/data/parsing/errors/expressions/expected/jsx.res.txt b/tests/syntax_tests/data/parsing/errors/expressions/expected/jsx.res.txt index dd4bdcf6b7..7d347c1bfe 100644 --- a/tests/syntax_tests/data/parsing/errors/expressions/expected/jsx.res.txt +++ b/tests/syntax_tests/data/parsing/errors/expressions/expected/jsx.res.txt @@ -98,6 +98,6 @@ let x = > ([%rescript.exprhole ]) let x = > ([%rescript.exprhole ]) let x = > ([%rescript.exprhole ]) let x = -let x = -let x = -let x = \ No newline at end of file +let x = +let x = +let x = \ No newline at end of file From 3b6f5e62039470fdb3d75b70df1b23594f766876 Mon Sep 17 00:00:00 2001 From: nojaf Date: Sun, 10 Aug 2025 21:40:42 +0200 Subject: [PATCH 02/12] Clean up parser --- analysis/src/CompletionFrontEnd.ml | 94 ++++++++++----- compiler/syntax/src/res_core.ml | 109 +++++++----------- .../tests/src/expected/Completion.res.txt | 7 +- 3 files changed, 105 insertions(+), 105 deletions(-) diff --git a/analysis/src/CompletionFrontEnd.ml b/analysis/src/CompletionFrontEnd.ml index b0003739da..3aaae0bd4c 100644 --- a/analysis/src/CompletionFrontEnd.ml +++ b/analysis/src/CompletionFrontEnd.ml @@ -1341,8 +1341,19 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor { jsx_container_element_tag_name_start = compName; jsx_container_element_props = props; - } ) -> + } ) -> ( inJsxContext := true; + let is_valid_tag_for_props = + let is_alpha c = + let oc = Char.code c in + (oc >= Char.code 'a' && oc <= Char.code 'z') + || (oc >= Char.code 'A' && oc <= Char.code 'Z') + in + match compName with + | Parsetree.Lower {name; _} | Parsetree.QualifiedLower {name; _} -> + String.length name > 0 && is_alpha name.[0] + | Parsetree.Upper _ -> true + in let children = match expr.pexp_desc with | Pexp_jsx_element @@ -1359,29 +1370,39 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor loc in let compName_lid = Ast_helper.longident_of_jsx_tag_name compName in - let jsxProps = - CompletionJsx.extractJsxProps - ~compName:(Location.mkloc compName_lid compName_loc) - ~props ~children + let jsxPropsOpt = + if is_valid_tag_for_props then + Some + (CompletionJsx.extractJsxProps + ~compName:(Location.mkloc compName_lid compName_loc) + ~props ~children) + else None in let compNamePath = flattenLidCheckDot ~jsx:true {txt = compName_lid; loc = compName_loc} in - if debug then - Printf.printf "JSX <%s:%s %s> _children:%s\n" - (compNamePath |> String.concat ".") - (Loc.toString compName_loc) - (jsxProps.props - |> List.map - (fun ({name; posStart; posEnd; exp} : CompletionJsx.prop) -> - Printf.sprintf "%s[%s->%s]=...%s" name - (Pos.toString posStart) (Pos.toString posEnd) - (Loc.toString exp.pexp_loc)) - |> String.concat " ") - (match jsxProps.childrenStart with - | None -> "None" - | Some childrenPosStart -> Pos.toString childrenPosStart); + (if debug then + match jsxPropsOpt with + | Some jsxProps -> + Printf.printf "JSX <%s:%s %s> _children:%s\n" + (compNamePath |> String.concat ".") + (Loc.toString compName_loc) + (jsxProps.props + |> List.map + (fun + ({name; posStart; posEnd; exp} : CompletionJsx.prop) -> + Printf.sprintf "%s[%s->%s]=...%s" name + (Pos.toString posStart) (Pos.toString posEnd) + (Loc.toString exp.pexp_loc)) + |> String.concat " ") + (match jsxProps.childrenStart with + | None -> "None" + | Some childrenPosStart -> Pos.toString childrenPosStart) + | None -> + Printf.printf "JSX <%s:%s > _children:None\n" + (compNamePath |> String.concat ".") + (Loc.toString compName_loc)); (* If the tag name is an uppercase path and the cursor is right after a dot (e.g., ()); let jsxCompletable = - match expr.pexp_desc with - | Pexp_jsx_element - (Jsx_container_element - { - jsx_container_element_closing_tag = None; - jsx_container_element_children = - JSXChildrenSpreading _ | JSXChildrenItems (_ :: _); - }) -> - (* This is a weird edge case where there is no closing tag but there are children *) + match (jsxPropsOpt, expr.pexp_desc) with + | ( Some _, + Pexp_jsx_element + (Jsx_container_element + { + jsx_container_element_closing_tag = None; + jsx_container_element_children = + JSXChildrenSpreading _ | JSXChildrenItems (_ :: _); + }) ) -> None - | _ -> + | Some jsxProps, _ -> CompletionJsx.findJsxPropsCompletable ~jsxProps ~endPos:(Loc.end_ expr.pexp_loc) ~posBeforeCursor ~posAfterCompName:(Loc.end_ compName_loc) ~firstCharBeforeCursorNoWhite ~charAtCursor + | None, _ -> None in - if jsxCompletable <> None then setResultOpt jsxCompletable - else if compName_loc |> Loc.hasPos ~pos:posBeforeCursor then + (match jsxCompletable with + | Some _ as res -> setResultOpt res + | None -> ()); + if + jsxCompletable = None + && compName_loc |> Loc.hasPos ~pos:posBeforeCursor + then setResult (match compNamePath with | [prefix] when Char.lowercase_ascii prefix.[0] = prefix.[0] -> @@ -1426,7 +1453,10 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor path = compNamePath; completionContext = Module; })) - else iterateJsxProps ~iterator jsxProps + else + match jsxPropsOpt with + | Some jsxProps -> iterateJsxProps ~iterator jsxProps + | None -> ()) | Pexp_apply { funct = {pexp_desc = Pexp_ident {txt = Lident "->"}}; diff --git a/compiler/syntax/src/res_core.ml b/compiler/syntax/src/res_core.ml index 980af86c4d..fea758974a 100644 --- a/compiler/syntax/src/res_core.ml +++ b/compiler/syntax/src/res_core.ml @@ -785,13 +785,13 @@ let longident_of_segments (segs : string list) : Longident.t = (fun acc s -> Longident.Ldot (acc, s)) (Longident.Lident hd) tl -(* Read a JSX tag name and return a combined Longident + loc; does not mutate tokens *) -let read_jsx_tag_name (p : Parser.t) : Longident.t Location.loc option = +(* Read a JSX tag name and return a jsx_tag_name; does not mutate tokens beyond what it consumes *) +let read_jsx_tag_name (p : Parser.t) : Parsetree.jsx_tag_name option = match peek_ident p with + | None -> None | Some (_, _, `Lower) -> read_local_jsx_name p - |> Option.map (fun (name, loc, _) -> - Location.mkloc (Longident.Lident name) loc) + |> Option.map (fun (name, loc, _) -> Parsetree.Lower {name; loc}) | Some (seg, seg_loc, `Upper) -> let start_pos = seg_loc.Location.loc_start in let rev_segs = ref [seg] in @@ -804,6 +804,10 @@ let read_jsx_tag_name (p : Parser.t) : Longident.t Location.loc option = Parser.next p; (* after '.' *) match peek_ident p with + | None -> + Parser.err p + (Diagnostics.message "expected identifier after '.' in JSX tag name"); + None | Some (txt, _loc, `Upper) -> (* another path segment *) rev_segs := txt :: !rev_segs; @@ -816,20 +820,15 @@ let read_jsx_tag_name (p : Parser.t) : Longident.t Location.loc option = | Some (lname, l_loc, _) -> let path = longident_of_segments (List.rev !rev_segs) in let loc = mk_loc start_pos l_loc.Location.loc_end in - Some (Location.mkloc (Longident.Ldot (path, lname)) loc) - | None -> None) - | None -> - Parser.err p - (Diagnostics.message "expected identifier after '.' in JSX tag name"); - None) + Some (Parsetree.QualifiedLower {path; name = lname; loc}) + | None -> None)) | _ -> (* pure Upper path *) let path = longident_of_segments (List.rev !rev_segs) in let loc = mk_loc start_pos !last_end in - Some (Location.mkloc path loc) + Some (Parsetree.Upper {path; loc}) in loop () - | None -> None (* Parses module identifiers: Foo @@ -851,7 +850,6 @@ let parse_module_long_ident ~lowercase p = match p.Parser.token with | Dot -> Parser.next p; - (* For JSX names, we allow a final lowercase segment that may include hyphens. *) parse_module_long_ident_tail ~lowercase p start_pos lident | _ -> Location.mkloc lident (mk_loc start_pos end_pos)) | t -> @@ -861,33 +859,6 @@ let parse_module_long_ident ~lowercase p = (* Parser.eatBreadcrumb p; *) module_ident -(* Guard-style verifier that consumes the closing tag name from the stream, - mirroring the original semantics so downstream error ranges/messages stay identical *) -let _verify_jsx_opening_closing_name_unused_warning_hack = () - -let string_of_longident (longindent : Longident.t Location.loc) = - Longident.flatten longindent.txt - (* |> List.filter (fun s -> s <> "createElement") *) - |> String.concat "." - -let jsx_tag_of_longident (lid : Longident.t Location.loc) : - Parsetree.jsx_tag_name = - let loc = lid.loc in - let starts_with_lowercase s = - match s with - | "" -> false - | _ -> - let c = s.[0] in - c >= 'a' && c <= 'z' - in - match lid.txt with - | Longident.Lident s when starts_with_lowercase s -> - Parsetree.Lower {name = s; loc} - | Longident.Lident _ -> Parsetree.Upper {path = lid.txt; loc} - | Longident.Ldot (path, last) when starts_with_lowercase last -> - Parsetree.QualifiedLower {path; name = last; loc} - | _ -> Parsetree.Upper {path = lid.txt; loc} - (* open-def ::= * | open module-path * | open! module-path *) @@ -2665,16 +2636,16 @@ and parse_let_bindings ~attrs ~start_pos p = in (rec_flag, loop p [first]) -and parse_jsx_name p : Longident.t Location.loc = +and parse_jsx_name p : Parsetree.jsx_tag_name = match read_jsx_tag_name p with - | Some lid -> lid + | Some name -> name | None -> let msg = "A jsx name must be a lowercase or uppercase name, like: div in
\ or Navbar in " in Parser.err p (Diagnostics.message msg); - Location.mknoloc (Longident.Lident "_") + Parsetree.Lower {name = "_"; loc = Location.none} and parse_jsx_opening_or_self_closing_element (* start of the opening < *) ~start_pos p : Parsetree.expression = @@ -2687,7 +2658,7 @@ and parse_jsx_opening_or_self_closing_element (* start of the opening < *) let jsx_end_pos = p.end_pos in Parser.expect GreaterThan p; let loc = mk_loc start_pos jsx_end_pos in - Ast_helper.Exp.jsx_unary_element ~loc (jsx_tag_of_longident name) jsx_props + Ast_helper.Exp.jsx_unary_element ~loc name jsx_props | GreaterThan -> (* bar *) let opening_tag_end = p.Parser.start_pos in @@ -2715,7 +2686,9 @@ and parse_jsx_opening_or_self_closing_element (* start of the opening < *) | Lident _ | Uident _ -> ( (* Consume the closing name without mutating tokens beforehand *) match read_jsx_tag_name p with - | Some closing_name when closing_name.txt = name.txt -> + | Some closing_name + when Ast_helper.longident_of_jsx_tag_name closing_name + = Ast_helper.longident_of_jsx_tag_name name -> let end_tag_name = closing_name in let closing_tag_end = p.start_pos in Parser.expect GreaterThan p; @@ -2726,27 +2699,24 @@ and parse_jsx_opening_or_self_closing_element (* start of the opening < *) { Parsetree.jsx_closing_container_tag_start = closing_tag_start; - jsx_closing_container_tag_name = - (match end_tag_name.txt with - | Longident.Lident name -> - Parsetree.Lower {name; loc = end_tag_name.loc} - | _ -> - Parsetree.Upper - {path = end_tag_name.txt; loc = end_tag_name.loc}); + jsx_closing_container_tag_name = end_tag_name; jsx_closing_container_tag_end = closing_tag_end; }) in - Ast_helper.Exp.jsx_container_element ~loc - (jsx_tag_of_longident name) - jsx_props opening_tag_end children closing_tag + Ast_helper.Exp.jsx_container_element ~loc name jsx_props + opening_tag_end children closing_tag | _ -> let () = if Grammar.is_structure_item_start token0 then - let closing = "" in + let closing = + "" + in let msg = Diagnostics.message ("Missing " ^ closing) in Parser.err ~start_pos ~end_pos:p.prev_end_pos p msg else - let opening = "" in + let opening = + "" + in let msg = "Closing jsx name should be the same as the opening name. Did \ you mean " ^ opening ^ " ?" @@ -2758,16 +2728,15 @@ and parse_jsx_opening_or_self_closing_element (* start of the opening < *) in Ast_helper.Exp.jsx_container_element ~loc:(mk_loc start_pos p.prev_end_pos) - (jsx_tag_of_longident name) - jsx_props opening_tag_end children None) + name jsx_props opening_tag_end children None) | token -> let () = if Grammar.is_structure_item_start token then - let closing = "" in + let closing = "" in let msg = Diagnostics.message ("Missing " ^ closing) in Parser.err ~start_pos ~end_pos:p.prev_end_pos p msg else - let opening = "" in + let opening = "" in let msg = "Closing jsx name should be the same as the opening name. Did \ you mean " ^ opening ^ " ?" @@ -2777,16 +2746,14 @@ and parse_jsx_opening_or_self_closing_element (* start of the opening < *) in Ast_helper.Exp.jsx_container_element ~loc:(mk_loc start_pos p.prev_end_pos) - (jsx_tag_of_longident name) - jsx_props opening_tag_end children None + name jsx_props opening_tag_end children None in expr_after_closing | token -> Parser.err p (Diagnostics.unexpected token p.breadcrumbs); Ast_helper.Exp.jsx_unary_element ~loc:(mk_loc start_pos p.prev_end_pos) - (jsx_tag_of_longident name) - jsx_props + name jsx_props (* * jsx ::= @@ -2808,8 +2775,16 @@ and parse_jsx p = (* fragment: <> foo *) parse_jsx_fragment start_pos p | _ -> - let longident = parse_jsx_name p in - Ast_helper.Exp.ident ~loc:longident.loc longident + let tag_name = parse_jsx_name p in + let (loc : Location.t) = + match tag_name with + | Parsetree.Lower {loc; _} + | Parsetree.QualifiedLower {loc; _} + | Parsetree.Upper {loc; _} -> + loc + in + let lid = Ast_helper.longident_of_jsx_tag_name tag_name in + Ast_helper.Exp.ident ~loc (Location.mkloc lid loc) in Parser.eat_breadcrumb p; jsx_expr diff --git a/tests/analysis_tests/tests/src/expected/Completion.res.txt b/tests/analysis_tests/tests/src/expected/Completion.res.txt index d7208e37f6..3597d9a7c4 100644 --- a/tests/analysis_tests/tests/src/expected/Completion.res.txt +++ b/tests/analysis_tests/tests/src/expected/Completion.res.txt @@ -1065,12 +1065,7 @@ Path Objects.object Complete src/Completion.res 151:6 posCursor:[151:6] posNoWhite:[151:5] Found expr:[151:3->151:6] -JSX <_:__ghost__[0:-1->0:-1] > _children:None -Completable: Cpath Module[_] -Package opens Stdlib.place holder Pervasives.JsxModules.place holder -Resolved opens 1 Stdlib -ContextPath Module[_] -Path _ +JSX <_:__ghost__[0:-1->0:-1]> (no props due to invalid tag) [] Complete src/Completion.res 157:8 From 111230de284b9b2337b8ede0009bf75af77f253a Mon Sep 17 00:00:00 2001 From: nojaf Date: Sun, 10 Aug 2025 22:05:24 +0200 Subject: [PATCH 03/12] Some better union case names --- analysis/src/CompletionFrontEnd.ml | 16 ++++------- analysis/src/SemanticTokens.ml | 21 ++++++++------ compiler/ml/ast_helper.ml | 22 +++++++++++---- compiler/ml/ast_helper.mli | 1 + compiler/ml/ast_mapper_from0.ml | 8 +++--- compiler/ml/ast_mapper_to0.ml | 24 ++++++---------- compiler/ml/depend.ml | 8 +++--- compiler/ml/parsetree.ml | 7 +++-- compiler/ml/pprintast.ml | 16 ++--------- compiler/ml/printast.ml | 7 +++-- compiler/syntax/src/jsx_v4.ml | 17 ++++------- compiler/syntax/src/res_comments_table.ml | 28 +++++++++++-------- compiler/syntax/src/res_core.ml | 17 ++++------- compiler/syntax/src/res_parsetree_viewer.ml | 7 +---- compiler/syntax/src/res_printer.ml | 17 ++--------- .../tests/src/expected/Completion.res.txt | 2 +- 16 files changed, 94 insertions(+), 124 deletions(-) diff --git a/analysis/src/CompletionFrontEnd.ml b/analysis/src/CompletionFrontEnd.ml index 3aaae0bd4c..515bd8292b 100644 --- a/analysis/src/CompletionFrontEnd.ml +++ b/analysis/src/CompletionFrontEnd.ml @@ -1350,9 +1350,11 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor || (oc >= Char.code 'A' && oc <= Char.code 'Z') in match compName with - | Parsetree.Lower {name; _} | Parsetree.QualifiedLower {name; _} -> + | Parsetree.JsxLowerTag {name; _} + | Parsetree.JsxQualifiedLowerTag {name; _} -> String.length name > 0 && is_alpha name.[0] - | Parsetree.Upper _ -> true + | Parsetree.JsxUpperTag _ -> true + | Parsetree.JsxTagInvalid _ -> false in let children = match expr.pexp_desc with @@ -1362,13 +1364,7 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor children | _ -> JSXChildrenItems [] in - let compName_loc = - match compName with - | Parsetree.Lower {loc; _} - | Parsetree.QualifiedLower {loc; _} - | Parsetree.Upper {loc; _} -> - loc - in + let compName_loc = Ast_helper.loc_of_jsx_tag_name compName in let compName_lid = Ast_helper.longident_of_jsx_tag_name compName in let jsxPropsOpt = if is_valid_tag_for_props then @@ -1406,7 +1402,7 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor (* If the tag name is an uppercase path and the cursor is right after a dot (e.g., + | Parsetree.JsxUpperTag _ when blankAfterCursor = Some '.' -> setResult (Cpath (CPId diff --git a/analysis/src/SemanticTokens.ml b/analysis/src/SemanticTokens.ml index 0cc0024523..eec51b59a3 100644 --- a/analysis/src/SemanticTokens.ml +++ b/analysis/src/SemanticTokens.ml @@ -268,9 +268,10 @@ let command ~debug ~emitter ~path = let lid = Ast_helper.longident_of_jsx_tag_name lident in let loc = match lident with - | Parsetree.Lower {loc; _} - | Parsetree.QualifiedLower {loc; _} - | Parsetree.Upper {loc; _} -> + | Parsetree.JsxLowerTag {loc; _} + | Parsetree.JsxQualifiedLowerTag {loc; _} + | Parsetree.JsxUpperTag {loc; _} + | Parsetree.JsxTagInvalid {loc} -> loc in emitter |> emitJsxOpen ~lid ~debug ~loc; @@ -292,9 +293,10 @@ let command ~debug ~emitter ~path = let lid = Ast_helper.longident_of_jsx_tag_name lident in let loc = match lident with - | Parsetree.Lower {loc; _} - | Parsetree.QualifiedLower {loc; _} - | Parsetree.Upper {loc; _} -> + | Parsetree.JsxLowerTag {loc; _} + | Parsetree.JsxQualifiedLowerTag {loc; _} + | Parsetree.JsxUpperTag {loc; _} + | Parsetree.JsxTagInvalid {loc} -> loc in emitter |> emitJsxOpen ~lid ~debug ~loc; @@ -327,9 +329,10 @@ let command ~debug ~emitter ~path = let lid = Ast_helper.longident_of_jsx_tag_name tag_name_end in let loc = match tag_name_end with - | Parsetree.Lower {loc; _} - | Parsetree.QualifiedLower {loc; _} - | Parsetree.Upper {loc; _} -> + | Parsetree.JsxLowerTag {loc; _} + | Parsetree.JsxQualifiedLowerTag {loc; _} + | Parsetree.JsxUpperTag {loc; _} + | Parsetree.JsxTagInvalid {loc} -> loc in emitter |> emitJsxClose ~debug ~lid ~pos:(Loc.end_ loc); diff --git a/compiler/ml/ast_helper.ml b/compiler/ml/ast_helper.ml index 558478a415..2fa0c7d688 100644 --- a/compiler/ml/ast_helper.ml +++ b/compiler/ml/ast_helper.ml @@ -432,14 +432,24 @@ end (* Helpers for JSX *) let string_of_jsx_tag_name (tag_name : Parsetree.jsx_tag_name) : string = match tag_name with - | Parsetree.Lower {name; _} -> name - | Parsetree.QualifiedLower {path; name; _} -> + | Parsetree.JsxLowerTag {name; _} -> name + | Parsetree.JsxQualifiedLowerTag {path; name; _} -> String.concat "." (Longident.flatten path) ^ "." ^ name - | Parsetree.Upper {path; _} -> String.concat "." (Longident.flatten path) + | Parsetree.JsxUpperTag {path; _} -> + String.concat "." (Longident.flatten path) + | Parsetree.JsxTagInvalid _ -> "_" let longident_of_jsx_tag_name (tag_name : Parsetree.jsx_tag_name) : Longident.t = match tag_name with - | Parsetree.Lower {name; _} -> Longident.Lident name - | Parsetree.QualifiedLower {path; name; _} -> Longident.Ldot (path, name) - | Parsetree.Upper {path; _} -> path + | Parsetree.JsxLowerTag {name; _} -> Longident.Lident name + | Parsetree.JsxQualifiedLowerTag {path; name; _} -> Longident.Ldot (path, name) + | Parsetree.JsxUpperTag {path; _} -> path + | Parsetree.JsxTagInvalid _ -> Longident.Lident "_" + +let loc_of_jsx_tag_name (tag_name : Parsetree.jsx_tag_name) : Location.t = + match tag_name with + | Parsetree.JsxLowerTag {loc; _} -> loc + | Parsetree.JsxQualifiedLowerTag {loc; _} -> loc + | Parsetree.JsxUpperTag {loc; _} -> loc + | Parsetree.JsxTagInvalid {loc; _} -> loc diff --git a/compiler/ml/ast_helper.mli b/compiler/ml/ast_helper.mli index 41c1914391..0206feb53b 100644 --- a/compiler/ml/ast_helper.mli +++ b/compiler/ml/ast_helper.mli @@ -303,6 +303,7 @@ end val string_of_jsx_tag_name : Parsetree.jsx_tag_name -> string val longident_of_jsx_tag_name : Parsetree.jsx_tag_name -> Longident.t +val loc_of_jsx_tag_name : Parsetree.jsx_tag_name -> Location.t (** {1 Module language} *) diff --git a/compiler/ml/ast_mapper_from0.ml b/compiler/ml/ast_mapper_from0.ml index c34dd50a0f..abcd7feb42 100644 --- a/compiler/ml/ast_mapper_from0.ml +++ b/compiler/ml/ast_mapper_from0.ml @@ -400,14 +400,14 @@ module E = struct match tag_name.txt with | Longident.Lident s when String.length s > 0 && Char.lowercase_ascii s.[0] = s.[0] -> - Pt.Lower {name = s; loc = tag_name.loc} + Pt.JsxLowerTag {name = s; loc = tag_name.loc} | Longident.Lident _ -> - Pt.Upper {path = tag_name.txt; loc = tag_name.loc} + Pt.JsxUpperTag {path = tag_name.txt; loc = tag_name.loc} | Longident.Ldot (path, last) when String.length last > 0 && Char.lowercase_ascii last.[0] = last.[0] -> - Pt.QualifiedLower {path; name = last; loc = tag_name.loc} - | _ -> Pt.Upper {path = tag_name.txt; loc = tag_name.loc} + Pt.JsxQualifiedLowerTag {path; name = last; loc = tag_name.loc} + | _ -> Pt.JsxUpperTag {path = tag_name.txt; loc = tag_name.loc} in match children with | None -> jsx_unary_element ~loc ~attrs jsx_tag props diff --git a/compiler/ml/ast_mapper_to0.ml b/compiler/ml/ast_mapper_to0.ml index 33502694ac..e6593e1ff5 100644 --- a/compiler/ml/ast_mapper_to0.ml +++ b/compiler/ml/ast_mapper_to0.ml @@ -496,14 +496,10 @@ module E = struct jsx_unary_element_props = props; }) -> let tag_ident : Longident.t Location.loc = - let txt, loc = - match tag_name with - | Lower {name; loc} -> (Longident.Lident name, loc) - | QualifiedLower {path; name; loc} -> - (Longident.Ldot (path, name), loc) - | Upper {path; loc} -> (path, loc) - in - {txt; loc} + { + txt = Ast_helper.longident_of_jsx_tag_name tag_name; + loc = Ast_helper.loc_of_jsx_tag_name tag_name; + } in let props = map_jsx_props sub props in let children_expr = @@ -535,14 +531,10 @@ module E = struct jsx_container_element_children = children; }) -> let tag_ident : Longident.t Location.loc = - let txt, loc = - match tag_name with - | Lower {name; loc} -> (Longident.Lident name, loc) - | QualifiedLower {path; name; loc} -> - (Longident.Ldot (path, name), loc) - | Upper {path; loc} -> (path, loc) - in - {txt; loc} + { + txt = Ast_helper.longident_of_jsx_tag_name tag_name; + loc = Ast_helper.loc_of_jsx_tag_name tag_name; + } in let props = map_jsx_props sub props in let children_expr = map_jsx_children sub loc children in diff --git a/compiler/ml/depend.ml b/compiler/ml/depend.ml index 54ff81f1d7..e661da002d 100644 --- a/compiler/ml/depend.ml +++ b/compiler/ml/depend.ml @@ -296,8 +296,8 @@ let rec add_expr bv exp = -> (* Conservatively add all module path segments referenced by the tag name *) (match name with - | Lower _ -> () - | QualifiedLower {path; _} | Upper {path; _} -> add_path bv path); + | JsxLowerTag _ | JsxTagInvalid _ -> () + | JsxQualifiedLowerTag {path; _} | JsxUpperTag {path; _} -> add_path bv path); and_jsx_props bv props | Pexp_jsx_element (Jsx_container_element @@ -307,8 +307,8 @@ let rec add_expr bv exp = jsx_container_element_children = children; }) -> (match name with - | Lower _ -> () - | QualifiedLower {path; _} | Upper {path; _} -> add_path bv path); + | JsxLowerTag _ | JsxTagInvalid _ -> () + | JsxQualifiedLowerTag {path; _} | JsxUpperTag {path; _} -> add_path bv path); and_jsx_props bv props; add_jsx_children bv children diff --git a/compiler/ml/parsetree.ml b/compiler/ml/parsetree.ml index 190580bfa9..09a04f3014 100644 --- a/compiler/ml/parsetree.ml +++ b/compiler/ml/parsetree.ml @@ -326,9 +326,10 @@ and jsx_element = | Jsx_container_element of jsx_container_element and jsx_tag_name = - | Lower of {name: string; loc: Location.t} - | QualifiedLower of {path: Longident.t; name: string; loc: Location.t} - | Upper of {path: Longident.t; loc: Location.t} + | JsxLowerTag of {name: string; loc: Location.t} + | JsxQualifiedLowerTag of {path: Longident.t; name: string; loc: Location.t} + | JsxUpperTag of {path: Longident.t; loc: Location.t} + | JsxTagInvalid of {loc: Location.t} and jsx_fragment = { (* > *) jsx_fragment_opening: Lexing.position; diff --git a/compiler/ml/pprintast.ml b/compiler/ml/pprintast.ml index 4064ee8e17..6166d033ba 100644 --- a/compiler/ml/pprintast.ml +++ b/compiler/ml/pprintast.ml @@ -805,13 +805,7 @@ and simple_expr ctxt f x = jsx_unary_element_tag_name = tag_name; jsx_unary_element_props = props; }) -> ( - let name = - match tag_name with - | Lower {name} -> name - | QualifiedLower {path; name; _} -> - (Longident.flatten path |> String.concat ".") ^ "." ^ name - | Upper {path; _} -> Longident.flatten path |> String.concat "." - in + let name = Ast_helper.string_of_jsx_tag_name tag_name in match props with | [] -> pp f "<%s />" name | _ -> pp f "<%s %a />" name (print_jsx_props ctxt) props) @@ -822,13 +816,7 @@ and simple_expr ctxt f x = jsx_container_element_props = props; jsx_container_element_children = children; }) -> ( - let name = - match tag_name with - | Lower {name} -> name - | QualifiedLower {path; name; _} -> - (Longident.flatten path |> String.concat ".") ^ "." ^ name - | Upper {path; _} -> Longident.flatten path |> String.concat "." - in + let name = Ast_helper.string_of_jsx_tag_name tag_name in match props with | [] -> pp f "<%s>%a" name diff --git a/compiler/ml/printast.ml b/compiler/ml/printast.ml index b95f5fcde1..7f239d61da 100644 --- a/compiler/ml/printast.ml +++ b/compiler/ml/printast.ml @@ -44,11 +44,12 @@ let fmt_longident_loc f (x : Longident.t loc) = let fmt_jsx_tag_name f (x : jsx_tag_name) = match x with - | Lower {name; loc} -> fprintf f "\"%s\" %a" name fmt_location loc - | QualifiedLower {path; name; loc} -> + | JsxLowerTag {name; loc} -> fprintf f "\"%s\" %a" name fmt_location loc + | JsxQualifiedLowerTag {path; name; loc} -> fprintf f "\"%a.%s\" %a" fmt_longident_aux path name fmt_location loc - | Upper {path; loc} -> + | JsxUpperTag {path; loc} -> fprintf f "\"%a\" %a" fmt_longident_aux path fmt_location loc + | JsxTagInvalid {loc} -> fprintf f "\"_\" %a" fmt_location loc let fmt_string_loc f (x : string loc) = fprintf f "\"%s\" %a" x.txt fmt_location x.loc diff --git a/compiler/syntax/src/jsx_v4.ml b/compiler/syntax/src/jsx_v4.ml index b78d741124..2781c7e8db 100644 --- a/compiler/syntax/src/jsx_v4.ml +++ b/compiler/syntax/src/jsx_v4.ml @@ -1098,10 +1098,7 @@ let starts_with_uppercase s = let jsx_tag_name_to_string_and_loc (tag_name : jsx_tag_name) : string * Location.t = let name = Ast_helper.string_of_jsx_tag_name tag_name in - let loc = - match tag_name with - | Lower {loc; _} | QualifiedLower {loc; _} | Upper {loc; _} -> loc - in + let loc = Ast_helper.loc_of_jsx_tag_name tag_name in (name, loc) (* There appear to be slightly different rules of transformation whether the component is upper-, lowercase or a fragment *) @@ -1299,17 +1296,15 @@ let mk_react_jsx (config : Jsx_common.jsx_config) mapper loc attrs let mk_uppercase_tag_name_expr tag_name = let tag_identifier : Longident.t = match tag_name with - | Lower {name; _} -> Longident.Lident name - | QualifiedLower {path; name; _} -> Longident.Ldot (path, name) - | Upper {path; _} -> + | JsxTagInvalid _ -> Longident.Lident "_" + | JsxLowerTag {name; _} -> Longident.Lident name + | JsxQualifiedLowerTag {path; name; _} -> Longident.Ldot (path, name) + | JsxUpperTag {path; _} -> if Longident.flatten path |> List.for_all starts_with_uppercase then Longident.Ldot (path, "make") else path in - let loc = - match tag_name with - | Lower {loc; _} | QualifiedLower {loc; _} | Upper {loc; _} -> loc - in + let loc = Ast_helper.loc_of_jsx_tag_name tag_name in Exp.ident ~loc {txt = tag_identifier; loc} let expr ~(config : Jsx_common.jsx_config) mapper expression = diff --git a/compiler/syntax/src/res_comments_table.ml b/compiler/syntax/src/res_comments_table.ml index f91d7ad880..701a8cca63 100644 --- a/compiler/syntax/src/res_comments_table.ml +++ b/compiler/syntax/src/res_comments_table.ml @@ -1684,9 +1684,10 @@ and walk_expression expr t comments = in let name_loc = match tag_name with - | Parsetree.Lower {loc; _} - | Parsetree.QualifiedLower {loc; _} - | Parsetree.Upper {loc; _} -> + | Parsetree.JsxLowerTag {loc; _} + | Parsetree.JsxQualifiedLowerTag {loc; _} + | Parsetree.JsxUpperTag {loc; _} + | Parsetree.JsxTagInvalid {loc} -> loc in partition_adjacent_trailing_before_next_token_on_same_line name_loc @@ -1696,9 +1697,10 @@ and walk_expression expr t comments = (* Only attach comments to the element name if they are on the same line *) let name_loc = match tag_name with - | Parsetree.Lower {loc; _} - | Parsetree.QualifiedLower {loc; _} - | Parsetree.Upper {loc; _} -> + | Parsetree.JsxLowerTag {loc; _} + | Parsetree.JsxQualifiedLowerTag {loc; _} + | Parsetree.JsxUpperTag {loc; _} + | Parsetree.JsxTagInvalid {loc} -> loc in attach t.trailing name_loc after_opening_tag_name; @@ -1742,9 +1744,10 @@ and walk_expression expr t comments = in let name_loc = match tag_name_start with - | Parsetree.Lower {loc; _} - | Parsetree.QualifiedLower {loc; _} - | Parsetree.Upper {loc; _} -> + | Parsetree.JsxLowerTag {loc; _} + | Parsetree.JsxQualifiedLowerTag {loc; _} + | Parsetree.JsxUpperTag {loc; _} + | Parsetree.JsxTagInvalid {loc} -> loc in partition_adjacent_trailing_before_next_token_on_same_line name_loc @@ -1753,9 +1756,10 @@ and walk_expression expr t comments = (* Only attach comments to the element name if they are on the same line *) let name_loc = match tag_name_start with - | Parsetree.Lower {loc; _} - | Parsetree.QualifiedLower {loc; _} - | Parsetree.Upper {loc; _} -> + | Parsetree.JsxLowerTag {loc; _} + | Parsetree.JsxQualifiedLowerTag {loc; _} + | Parsetree.JsxUpperTag {loc; _} + | Parsetree.JsxTagInvalid {loc} -> loc in attach t.trailing name_loc after_opening_tag_name; diff --git a/compiler/syntax/src/res_core.ml b/compiler/syntax/src/res_core.ml index fea758974a..8f106a9958 100644 --- a/compiler/syntax/src/res_core.ml +++ b/compiler/syntax/src/res_core.ml @@ -791,7 +791,7 @@ let read_jsx_tag_name (p : Parser.t) : Parsetree.jsx_tag_name option = | None -> None | Some (_, _, `Lower) -> read_local_jsx_name p - |> Option.map (fun (name, loc, _) -> Parsetree.Lower {name; loc}) + |> Option.map (fun (name, loc, _) -> Parsetree.JsxLowerTag {name; loc}) | Some (seg, seg_loc, `Upper) -> let start_pos = seg_loc.Location.loc_start in let rev_segs = ref [seg] in @@ -820,13 +820,13 @@ let read_jsx_tag_name (p : Parser.t) : Parsetree.jsx_tag_name option = | Some (lname, l_loc, _) -> let path = longident_of_segments (List.rev !rev_segs) in let loc = mk_loc start_pos l_loc.Location.loc_end in - Some (Parsetree.QualifiedLower {path; name = lname; loc}) + Some (Parsetree.JsxQualifiedLowerTag {path; name = lname; loc}) | None -> None)) | _ -> (* pure Upper path *) let path = longident_of_segments (List.rev !rev_segs) in let loc = mk_loc start_pos !last_end in - Some (Parsetree.Upper {path; loc}) + Some (Parsetree.JsxUpperTag {path; loc}) in loop () @@ -2645,7 +2645,7 @@ and parse_jsx_name p : Parsetree.jsx_tag_name = or Navbar in " in Parser.err p (Diagnostics.message msg); - Parsetree.Lower {name = "_"; loc = Location.none} + Parsetree.JsxTagInvalid {loc = Location.none} and parse_jsx_opening_or_self_closing_element (* start of the opening < *) ~start_pos p : Parsetree.expression = @@ -2776,13 +2776,8 @@ and parse_jsx p = parse_jsx_fragment start_pos p | _ -> let tag_name = parse_jsx_name p in - let (loc : Location.t) = - match tag_name with - | Parsetree.Lower {loc; _} - | Parsetree.QualifiedLower {loc; _} - | Parsetree.Upper {loc; _} -> - loc - in + let (loc : Location.t) = Ast_helper.loc_of_jsx_tag_name tag_name in + let lid = Ast_helper.longident_of_jsx_tag_name tag_name in Ast_helper.Exp.ident ~loc (Location.mkloc lid loc) in diff --git a/compiler/syntax/src/res_parsetree_viewer.ml b/compiler/syntax/src/res_parsetree_viewer.ml index fc2d6d7bcc..b592d9b266 100644 --- a/compiler/syntax/src/res_parsetree_viewer.ml +++ b/compiler/syntax/src/res_parsetree_viewer.ml @@ -773,12 +773,7 @@ let get_jsx_prop_loc = function let container_element_closing_tag_loc (tag : Parsetree.jsx_closing_container_tag) = { - (match tag.jsx_closing_container_tag_name with - | Parsetree.Lower {loc; _} - | Parsetree.QualifiedLower {loc; _} - | Parsetree.Upper {loc; _} -> - loc) - with + (Ast_helper.loc_of_jsx_tag_name tag.jsx_closing_container_tag_name) with loc_start = tag.jsx_closing_container_tag_start; loc_end = tag.jsx_closing_container_tag_end; } diff --git a/compiler/syntax/src/res_printer.ml b/compiler/syntax/src/res_printer.ml index a05131ac12..5bd5c9ae38 100644 --- a/compiler/syntax/src/res_printer.ml +++ b/compiler/syntax/src/res_printer.ml @@ -4442,13 +4442,7 @@ and print_pexp_apply ~state expr cmt_tbl = and print_jsx_unary_tag ~state tag_name props expr_loc cmt_tbl = let name = print_jsx_name tag_name in let formatted_props = print_jsx_props ~state props cmt_tbl in - let tag_loc = - match tag_name with - | Parsetree.Lower {loc; _} - | Parsetree.QualifiedLower {loc; _} - | Parsetree.Upper {loc; _} -> - loc - in + let tag_loc = Ast_helper.loc_of_jsx_tag_name tag_name in let tag_has_trailing_comment = has_trailing_comments cmt_tbl tag_loc in let tag_has_no_props = List.length props == 0 in let closing_token_loc = @@ -4559,13 +4553,8 @@ and print_jsx_container_tag ~state tag_name (Doc.concat [ (* Opening tag name and props *) - (let tag_loc = - match tag_name with - | Parsetree.Lower {loc; _} - | Parsetree.QualifiedLower {loc; _} - | Parsetree.Upper {loc; _} -> - loc - in + (let tag_loc = Ast_helper.loc_of_jsx_tag_name tag_name in + let opening_tag_name_doc = print_comments (Doc.concat [Doc.less_than; name]) diff --git a/tests/analysis_tests/tests/src/expected/Completion.res.txt b/tests/analysis_tests/tests/src/expected/Completion.res.txt index 3597d9a7c4..5805eb7aaa 100644 --- a/tests/analysis_tests/tests/src/expected/Completion.res.txt +++ b/tests/analysis_tests/tests/src/expected/Completion.res.txt @@ -1065,7 +1065,7 @@ Path Objects.object Complete src/Completion.res 151:6 posCursor:[151:6] posNoWhite:[151:5] Found expr:[151:3->151:6] -JSX <_:__ghost__[0:-1->0:-1]> (no props due to invalid tag) +JSX <_:__ghost__[0:-1->0:-1] > _children:None [] Complete src/Completion.res 157:8 From 902709568a402a3c053c62c0fd74090809ba1040 Mon Sep 17 00:00:00 2001 From: nojaf Date: Mon, 11 Aug 2025 09:05:37 +0200 Subject: [PATCH 04/12] jsx_tag_name loc --- analysis/src/CompletionFrontEnd.ml | 22 ++++------- analysis/src/SemanticTokens.ml | 33 ++++------------- compiler/ml/ast_helper.ml | 41 +++++++++------------ compiler/ml/ast_helper.mli | 11 +++--- compiler/ml/ast_mapper_from0.ml | 14 +++---- compiler/ml/ast_mapper_to0.ml | 10 +---- compiler/ml/depend.ml | 12 +++--- compiler/ml/location.ml | 2 + compiler/ml/location.mli | 2 + compiler/ml/parsetree.ml | 14 +++---- compiler/ml/pprintast.ml | 4 +- compiler/ml/printast.ml | 13 ++++--- compiler/syntax/src/jsx_v4.ml | 26 ++++++------- compiler/syntax/src/res_comments_table.ml | 36 ++---------------- compiler/syntax/src/res_core.ml | 40 ++++++++++++-------- compiler/syntax/src/res_parsetree_viewer.ml | 2 +- compiler/syntax/src/res_printer.ml | 10 ++--- 17 files changed, 120 insertions(+), 172 deletions(-) diff --git a/analysis/src/CompletionFrontEnd.ml b/analysis/src/CompletionFrontEnd.ml index 515bd8292b..4ccc2fd839 100644 --- a/analysis/src/CompletionFrontEnd.ml +++ b/analysis/src/CompletionFrontEnd.ml @@ -1344,17 +1344,9 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor } ) -> ( inJsxContext := true; let is_valid_tag_for_props = - let is_alpha c = - let oc = Char.code c in - (oc >= Char.code 'a' && oc <= Char.code 'z') - || (oc >= Char.code 'A' && oc <= Char.code 'Z') - in - match compName with - | Parsetree.JsxLowerTag {name; _} - | Parsetree.JsxQualifiedLowerTag {name; _} -> - String.length name > 0 && is_alpha name.[0] - | Parsetree.JsxUpperTag _ -> true - | Parsetree.JsxTagInvalid _ -> false + match compName.txt with + | Parsetree.JsxTagInvalid -> false + | _ -> true in let children = match expr.pexp_desc with @@ -1364,8 +1356,10 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor children | _ -> JSXChildrenItems [] in - let compName_loc = Ast_helper.loc_of_jsx_tag_name compName in - let compName_lid = Ast_helper.longident_of_jsx_tag_name compName in + let compName_loc = compName.loc in + let compName_lid = + Ast_helper.Jsx.longident_of_jsx_tag_name compName.txt + in let jsxPropsOpt = if is_valid_tag_for_props then Some @@ -1401,7 +1395,7 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor (Loc.toString compName_loc)); (* If the tag name is an uppercase path and the cursor is right after a dot (e.g., setResult (Cpath diff --git a/analysis/src/SemanticTokens.ml b/analysis/src/SemanticTokens.ml index eec51b59a3..ad22221186 100644 --- a/analysis/src/SemanticTokens.ml +++ b/analysis/src/SemanticTokens.ml @@ -265,15 +265,8 @@ let command ~debug ~emitter ~path = *) emitter (* --> emitJsxTag ~debug ~name:"<" ~pos:(Loc.start e.pexp_loc); - let lid = Ast_helper.longident_of_jsx_tag_name lident in - let loc = - match lident with - | Parsetree.JsxLowerTag {loc; _} - | Parsetree.JsxQualifiedLowerTag {loc; _} - | Parsetree.JsxUpperTag {loc; _} - | Parsetree.JsxTagInvalid {loc} -> - loc - in + let lid = Ast_helper.Jsx.longident_of_jsx_tag_name lident.txt in + let loc = lident.loc in emitter |> emitJsxOpen ~lid ~debug ~loc; let closing_line, closing_column = Loc.end_ e.pexp_loc in emitter (* <-- *) @@ -290,15 +283,8 @@ let command ~debug ~emitter ~path = (* opening tag *) emitter (* --> emitJsxTag ~debug ~name:"<" ~pos:(Loc.start e.pexp_loc); - let lid = Ast_helper.longident_of_jsx_tag_name lident in - let loc = - match lident with - | Parsetree.JsxLowerTag {loc; _} - | Parsetree.JsxQualifiedLowerTag {loc; _} - | Parsetree.JsxUpperTag {loc; _} - | Parsetree.JsxTagInvalid {loc} -> - loc - in + let lid = Ast_helper.Jsx.longident_of_jsx_tag_name lident.txt in + let loc = lident.loc in emitter |> emitJsxOpen ~lid ~debug ~loc; emitter (* <-- *) |> emitJsxTag ~debug ~name:">" @@ -326,15 +312,10 @@ let command ~debug ~emitter ~path = emitter |> emitJsxTag ~debug ~name:" - loc + let lid = + Ast_helper.Jsx.longident_of_jsx_tag_name tag_name_end.txt in + let loc = tag_name_end.loc in emitter |> emitJsxClose ~debug ~lid ~pos:(Loc.end_ loc); emitter (* ... <-- *) |> emitJsxTag ~debug ~name:">" diff --git a/compiler/ml/ast_helper.ml b/compiler/ml/ast_helper.ml index 2fa0c7d688..b4db90b526 100644 --- a/compiler/ml/ast_helper.ml +++ b/compiler/ml/ast_helper.ml @@ -429,27 +429,20 @@ module Te = struct } end -(* Helpers for JSX *) -let string_of_jsx_tag_name (tag_name : Parsetree.jsx_tag_name) : string = - match tag_name with - | Parsetree.JsxLowerTag {name; _} -> name - | Parsetree.JsxQualifiedLowerTag {path; name; _} -> - String.concat "." (Longident.flatten path) ^ "." ^ name - | Parsetree.JsxUpperTag {path; _} -> - String.concat "." (Longident.flatten path) - | Parsetree.JsxTagInvalid _ -> "_" - -let longident_of_jsx_tag_name (tag_name : Parsetree.jsx_tag_name) : Longident.t - = - match tag_name with - | Parsetree.JsxLowerTag {name; _} -> Longident.Lident name - | Parsetree.JsxQualifiedLowerTag {path; name; _} -> Longident.Ldot (path, name) - | Parsetree.JsxUpperTag {path; _} -> path - | Parsetree.JsxTagInvalid _ -> Longident.Lident "_" - -let loc_of_jsx_tag_name (tag_name : Parsetree.jsx_tag_name) : Location.t = - match tag_name with - | Parsetree.JsxLowerTag {loc; _} -> loc - | Parsetree.JsxQualifiedLowerTag {loc; _} -> loc - | Parsetree.JsxUpperTag {loc; _} -> loc - | Parsetree.JsxTagInvalid {loc; _} -> loc +module Jsx = struct + let string_of_jsx_tag_name (tag_name : Parsetree.jsx_tag_name) : string = + match tag_name with + | Parsetree.JsxLowerTag name -> name + | Parsetree.JsxQualifiedLowerTag {path; name} -> + String.concat "." (Longident.flatten path) ^ "." ^ name + | Parsetree.JsxUpperTag path -> String.concat "." (Longident.flatten path) + | Parsetree.JsxTagInvalid -> "_" + + let longident_of_jsx_tag_name (tag_name : Parsetree.jsx_tag_name) : + Longident.t = + match tag_name with + | Parsetree.JsxLowerTag name -> Longident.Lident name + | Parsetree.JsxQualifiedLowerTag {path; name} -> Longident.Ldot (path, name) + | Parsetree.JsxUpperTag path -> path + | Parsetree.JsxTagInvalid -> Longident.Lident "_" +end diff --git a/compiler/ml/ast_helper.mli b/compiler/ml/ast_helper.mli index 0206feb53b..11227b903a 100644 --- a/compiler/ml/ast_helper.mli +++ b/compiler/ml/ast_helper.mli @@ -212,13 +212,13 @@ module Exp : sig val jsx_unary_element : ?loc:loc -> ?attrs:attrs -> - Parsetree.jsx_tag_name -> + Parsetree.jsx_tag_name Location.loc -> Parsetree.jsx_props -> expression val jsx_container_element : ?loc:loc -> ?attrs:attrs -> - Parsetree.jsx_tag_name -> + Parsetree.jsx_tag_name Location.loc -> Parsetree.jsx_props -> Lexing.position -> Parsetree.jsx_children -> @@ -301,9 +301,10 @@ module Te : sig val rebind : ?loc:loc -> ?attrs:attrs -> str -> lid -> extension_constructor end -val string_of_jsx_tag_name : Parsetree.jsx_tag_name -> string -val longident_of_jsx_tag_name : Parsetree.jsx_tag_name -> Longident.t -val loc_of_jsx_tag_name : Parsetree.jsx_tag_name -> Location.t +module Jsx : sig + val string_of_jsx_tag_name : Parsetree.jsx_tag_name -> string + val longident_of_jsx_tag_name : Parsetree.jsx_tag_name -> Longident.t +end (** {1 Module language} *) diff --git a/compiler/ml/ast_mapper_from0.ml b/compiler/ml/ast_mapper_from0.ml index abcd7feb42..eb01c014f7 100644 --- a/compiler/ml/ast_mapper_from0.ml +++ b/compiler/ml/ast_mapper_from0.ml @@ -400,19 +400,19 @@ module E = struct match tag_name.txt with | Longident.Lident s when String.length s > 0 && Char.lowercase_ascii s.[0] = s.[0] -> - Pt.JsxLowerTag {name = s; loc = tag_name.loc} - | Longident.Lident _ -> - Pt.JsxUpperTag {path = tag_name.txt; loc = tag_name.loc} + Pt.JsxLowerTag s + | Longident.Lident _ -> Pt.JsxUpperTag tag_name.txt | Longident.Ldot (path, last) when String.length last > 0 && Char.lowercase_ascii last.[0] = last.[0] -> - Pt.JsxQualifiedLowerTag {path; name = last; loc = tag_name.loc} - | _ -> Pt.JsxUpperTag {path = tag_name.txt; loc = tag_name.loc} + Pt.JsxQualifiedLowerTag {path; name = last} + | _ -> Pt.JsxUpperTag tag_name.txt in + let jsx_tag_name = {txt = jsx_tag; loc = tag_name.loc} in match children with - | None -> jsx_unary_element ~loc ~attrs jsx_tag props + | None -> jsx_unary_element ~loc ~attrs jsx_tag_name props | Some children -> - jsx_container_element ~loc ~attrs jsx_tag props Lexing.dummy_pos + jsx_container_element ~loc ~attrs jsx_tag_name props Lexing.dummy_pos children None) | Pexp_apply (e, l) -> let e = diff --git a/compiler/ml/ast_mapper_to0.ml b/compiler/ml/ast_mapper_to0.ml index e6593e1ff5..3f87389bcf 100644 --- a/compiler/ml/ast_mapper_to0.ml +++ b/compiler/ml/ast_mapper_to0.ml @@ -496,10 +496,7 @@ module E = struct jsx_unary_element_props = props; }) -> let tag_ident : Longident.t Location.loc = - { - txt = Ast_helper.longident_of_jsx_tag_name tag_name; - loc = Ast_helper.loc_of_jsx_tag_name tag_name; - } + tag_name |> Location.map_loc Ast_helper.Jsx.longident_of_jsx_tag_name in let props = map_jsx_props sub props in let children_expr = @@ -531,10 +528,7 @@ module E = struct jsx_container_element_children = children; }) -> let tag_ident : Longident.t Location.loc = - { - txt = Ast_helper.longident_of_jsx_tag_name tag_name; - loc = Ast_helper.loc_of_jsx_tag_name tag_name; - } + tag_name |> Location.map_loc Ast_helper.Jsx.longident_of_jsx_tag_name in let props = map_jsx_props sub props in let children_expr = map_jsx_children sub loc children in diff --git a/compiler/ml/depend.ml b/compiler/ml/depend.ml index e661da002d..9c92881177 100644 --- a/compiler/ml/depend.ml +++ b/compiler/ml/depend.ml @@ -295,9 +295,9 @@ let rec add_expr bv exp = {jsx_unary_element_tag_name = name; jsx_unary_element_props = props}) -> (* Conservatively add all module path segments referenced by the tag name *) - (match name with - | JsxLowerTag _ | JsxTagInvalid _ -> () - | JsxQualifiedLowerTag {path; _} | JsxUpperTag {path; _} -> add_path bv path); + (match name.txt with + | JsxLowerTag _ | JsxTagInvalid -> () + | JsxQualifiedLowerTag {path; _} | JsxUpperTag path -> add_path bv path); and_jsx_props bv props | Pexp_jsx_element (Jsx_container_element @@ -306,9 +306,9 @@ let rec add_expr bv exp = jsx_container_element_props = props; jsx_container_element_children = children; }) -> - (match name with - | JsxLowerTag _ | JsxTagInvalid _ -> () - | JsxQualifiedLowerTag {path; _} | JsxUpperTag {path; _} -> add_path bv path); + (match name.txt with + | JsxLowerTag _ | JsxTagInvalid -> () + | JsxQualifiedLowerTag {path; _} | JsxUpperTag path -> add_path bv path); and_jsx_props bv props; add_jsx_children bv children diff --git a/compiler/ml/location.ml b/compiler/ml/location.ml index 19de2b7125..caa0f98c86 100644 --- a/compiler/ml/location.ml +++ b/compiler/ml/location.ml @@ -300,3 +300,5 @@ let raise_errorf ?(loc = none) ?(sub = []) ?(if_highlight = "") = let deprecated ?(def = none) ?(use = none) loc msg = prerr_warning loc (Warnings.Deprecated (msg, def, use)) + +let map_loc f {txt; loc} = {txt = f txt; loc} diff --git a/compiler/ml/location.mli b/compiler/ml/location.mli index 49758de42a..bff4609205 100644 --- a/compiler/ml/location.mli +++ b/compiler/ml/location.mli @@ -131,3 +131,5 @@ val report_exception : formatter -> exn -> unit (** Reraise the exception if it is unknown. *) val deprecated : ?def:t -> ?use:t -> t -> string -> unit + +val map_loc : ('a -> 'b) -> 'a loc -> 'b loc diff --git a/compiler/ml/parsetree.ml b/compiler/ml/parsetree.ml index 09a04f3014..180daece6f 100644 --- a/compiler/ml/parsetree.ml +++ b/compiler/ml/parsetree.ml @@ -326,10 +326,10 @@ and jsx_element = | Jsx_container_element of jsx_container_element and jsx_tag_name = - | JsxLowerTag of {name: string; loc: Location.t} - | JsxQualifiedLowerTag of {path: Longident.t; name: string; loc: Location.t} - | JsxUpperTag of {path: Longident.t; loc: Location.t} - | JsxTagInvalid of {loc: Location.t} + | JsxLowerTag of string + | JsxQualifiedLowerTag of {path: Longident.t; name: string} + | JsxUpperTag of Longident.t + | JsxTagInvalid and jsx_fragment = { (* > *) jsx_fragment_opening: Lexing.position; @@ -338,13 +338,13 @@ and jsx_fragment = { } and jsx_unary_element = { - jsx_unary_element_tag_name: jsx_tag_name; + jsx_unary_element_tag_name: jsx_tag_name loc; jsx_unary_element_props: jsx_props; } and jsx_container_element = { (* jsx_container_element_opening_tag_start: Lexing.position; *) - jsx_container_element_tag_name_start: jsx_tag_name; + jsx_container_element_tag_name_start: jsx_tag_name loc; (* > *) jsx_container_element_opening_tag_end: Lexing.position; jsx_container_element_props: jsx_props; @@ -382,7 +382,7 @@ and jsx_closing_container_tag = { (* *) jsx_closing_container_tag_end: Lexing.position; } diff --git a/compiler/ml/pprintast.ml b/compiler/ml/pprintast.ml index 6166d033ba..3c61bd4a48 100644 --- a/compiler/ml/pprintast.ml +++ b/compiler/ml/pprintast.ml @@ -805,7 +805,7 @@ and simple_expr ctxt f x = jsx_unary_element_tag_name = tag_name; jsx_unary_element_props = props; }) -> ( - let name = Ast_helper.string_of_jsx_tag_name tag_name in + let name = Ast_helper.Jsx.string_of_jsx_tag_name tag_name.txt in match props with | [] -> pp f "<%s />" name | _ -> pp f "<%s %a />" name (print_jsx_props ctxt) props) @@ -816,7 +816,7 @@ and simple_expr ctxt f x = jsx_container_element_props = props; jsx_container_element_children = children; }) -> ( - let name = Ast_helper.string_of_jsx_tag_name tag_name in + let name = Ast_helper.Jsx.string_of_jsx_tag_name tag_name.txt in match props with | [] -> pp f "<%s>%a" name diff --git a/compiler/ml/printast.ml b/compiler/ml/printast.ml index 7f239d61da..4a961c443d 100644 --- a/compiler/ml/printast.ml +++ b/compiler/ml/printast.ml @@ -42,14 +42,15 @@ let rec fmt_longident_aux f x = let fmt_longident_loc f (x : Longident.t loc) = fprintf f "\"%a\" %a" fmt_longident_aux x.txt fmt_location x.loc -let fmt_jsx_tag_name f (x : jsx_tag_name) = - match x with - | JsxLowerTag {name; loc} -> fprintf f "\"%s\" %a" name fmt_location loc - | JsxQualifiedLowerTag {path; name; loc} -> +let fmt_jsx_tag_name f (x : jsx_tag_name loc) = + let loc = x.loc in + match x.txt with + | JsxLowerTag name -> fprintf f "\"%s\" %a" name fmt_location loc + | JsxQualifiedLowerTag {path; name} -> fprintf f "\"%a.%s\" %a" fmt_longident_aux path name fmt_location loc - | JsxUpperTag {path; loc} -> + | JsxUpperTag path -> fprintf f "\"%a\" %a" fmt_longident_aux path fmt_location loc - | JsxTagInvalid {loc} -> fprintf f "\"_\" %a" fmt_location loc + | JsxTagInvalid -> fprintf f "\"_\" %a" fmt_location loc let fmt_string_loc f (x : string loc) = fprintf f "\"%s\" %a" x.txt fmt_location x.loc diff --git a/compiler/syntax/src/jsx_v4.ml b/compiler/syntax/src/jsx_v4.ml index 2781c7e8db..c91dd942e4 100644 --- a/compiler/syntax/src/jsx_v4.ml +++ b/compiler/syntax/src/jsx_v4.ml @@ -1083,6 +1083,7 @@ let transform_signature_item ~config item = "Only one JSX component call can exist on a component at one time") | _ -> [item] +(* TODO: refactor *) let starts_with_lowercase s = if String.length s = 0 then false else @@ -1095,12 +1096,6 @@ let starts_with_uppercase s = let c = s.[0] in Char.uppercase_ascii c = c -let jsx_tag_name_to_string_and_loc (tag_name : jsx_tag_name) : - string * Location.t = - let name = Ast_helper.string_of_jsx_tag_name tag_name in - let loc = Ast_helper.loc_of_jsx_tag_name tag_name in - (name, loc) - (* There appear to be slightly different rules of transformation whether the component is upper-, lowercase or a fragment *) type componentDescription = | LowercasedComponent @@ -1295,16 +1290,16 @@ let mk_react_jsx (config : Jsx_common.jsx_config) mapper loc attrs *) let mk_uppercase_tag_name_expr tag_name = let tag_identifier : Longident.t = - match tag_name with - | JsxTagInvalid _ -> Longident.Lident "_" - | JsxLowerTag {name; _} -> Longident.Lident name - | JsxQualifiedLowerTag {path; name; _} -> Longident.Ldot (path, name) - | JsxUpperTag {path; _} -> + match tag_name.txt with + | JsxTagInvalid -> Longident.Lident "_" + | JsxLowerTag name -> Longident.Lident name + | JsxQualifiedLowerTag {path; name} -> Longident.Ldot (path, name) + | JsxUpperTag path -> if Longident.flatten path |> List.for_all starts_with_uppercase then Longident.Ldot (path, "make") else path in - let loc = Ast_helper.loc_of_jsx_tag_name tag_name in + let loc = tag_name.loc in Exp.ident ~loc {txt = tag_identifier; loc} let expr ~(config : Jsx_common.jsx_config) mapper expression = @@ -1324,7 +1319,8 @@ let expr ~(config : Jsx_common.jsx_config) mapper expression = | Jsx_unary_element {jsx_unary_element_tag_name = tag_name; jsx_unary_element_props = props} -> - let name, tag_loc = jsx_tag_name_to_string_and_loc tag_name in + let name = Ast_helper.Jsx.string_of_jsx_tag_name tag_name.txt in + let tag_loc = tag_name.loc in if starts_with_lowercase name then (* For example 'input' *) let component_name_expr = constant_string ~loc:tag_loc name in @@ -1344,7 +1340,9 @@ let expr ~(config : Jsx_common.jsx_config) mapper expression = jsx_container_element_props = props; jsx_container_element_children = children; } -> - let name, tag_loc = jsx_tag_name_to_string_and_loc tag_name in + let name, tag_loc = + (Ast_helper.Jsx.string_of_jsx_tag_name tag_name.txt, tag_name.loc) + in (* For example:


This has an impact if we want to use ReactDOM.jsx or ReactDOM.jsxs *) diff --git a/compiler/syntax/src/res_comments_table.ml b/compiler/syntax/src/res_comments_table.ml index 701a8cca63..2c4608476f 100644 --- a/compiler/syntax/src/res_comments_table.ml +++ b/compiler/syntax/src/res_comments_table.ml @@ -1682,27 +1682,13 @@ and walk_expression expr t comments = | [] -> closing_token_loc | head :: _ -> ParsetreeViewer.get_jsx_prop_loc head in - let name_loc = - match tag_name with - | Parsetree.JsxLowerTag {loc; _} - | Parsetree.JsxQualifiedLowerTag {loc; _} - | Parsetree.JsxUpperTag {loc; _} - | Parsetree.JsxTagInvalid {loc} -> - loc - in + let name_loc = tag_name.loc in partition_adjacent_trailing_before_next_token_on_same_line name_loc next_token comments in (* Only attach comments to the element name if they are on the same line *) - let name_loc = - match tag_name with - | Parsetree.JsxLowerTag {loc; _} - | Parsetree.JsxQualifiedLowerTag {loc; _} - | Parsetree.JsxUpperTag {loc; _} - | Parsetree.JsxTagInvalid {loc} -> - loc - in + let name_loc = tag_name.loc in attach t.trailing name_loc after_opening_tag_name; match props with | [] -> @@ -1742,26 +1728,12 @@ and walk_expression expr t comments = | [] -> opening_greater_than_loc | head :: _ -> ParsetreeViewer.get_jsx_prop_loc head in - let name_loc = - match tag_name_start with - | Parsetree.JsxLowerTag {loc; _} - | Parsetree.JsxQualifiedLowerTag {loc; _} - | Parsetree.JsxUpperTag {loc; _} - | Parsetree.JsxTagInvalid {loc} -> - loc - in + let name_loc = tag_name_start.loc in partition_adjacent_trailing_before_next_token_on_same_line name_loc next_token comments in (* Only attach comments to the element name if they are on the same line *) - let name_loc = - match tag_name_start with - | Parsetree.JsxLowerTag {loc; _} - | Parsetree.JsxQualifiedLowerTag {loc; _} - | Parsetree.JsxUpperTag {loc; _} - | Parsetree.JsxTagInvalid {loc} -> - loc - in + let name_loc = tag_name_start.loc in attach t.trailing name_loc after_opening_tag_name; let rest = match props with diff --git a/compiler/syntax/src/res_core.ml b/compiler/syntax/src/res_core.ml index 8f106a9958..9ad404433e 100644 --- a/compiler/syntax/src/res_core.ml +++ b/compiler/syntax/src/res_core.ml @@ -786,12 +786,14 @@ let longident_of_segments (segs : string list) : Longident.t = (Longident.Lident hd) tl (* Read a JSX tag name and return a jsx_tag_name; does not mutate tokens beyond what it consumes *) -let read_jsx_tag_name (p : Parser.t) : Parsetree.jsx_tag_name option = +let read_jsx_tag_name (p : Parser.t) : + Parsetree.jsx_tag_name Location.loc option = match peek_ident p with | None -> None | Some (_, _, `Lower) -> read_local_jsx_name p - |> Option.map (fun (name, loc, _) -> Parsetree.JsxLowerTag {name; loc}) + |> Option.map (fun (name, loc, _) -> + {Location.txt = Parsetree.JsxLowerTag name; loc}) | Some (seg, seg_loc, `Upper) -> let start_pos = seg_loc.Location.loc_start in let rev_segs = ref [seg] in @@ -820,13 +822,18 @@ let read_jsx_tag_name (p : Parser.t) : Parsetree.jsx_tag_name option = | Some (lname, l_loc, _) -> let path = longident_of_segments (List.rev !rev_segs) in let loc = mk_loc start_pos l_loc.Location.loc_end in - Some (Parsetree.JsxQualifiedLowerTag {path; name = lname; loc}) + Some + { + Location.txt = + Parsetree.JsxQualifiedLowerTag {path; name = lname}; + loc; + } | None -> None)) | _ -> (* pure Upper path *) let path = longident_of_segments (List.rev !rev_segs) in let loc = mk_loc start_pos !last_end in - Some (Parsetree.JsxUpperTag {path; loc}) + Some {txt = Parsetree.JsxUpperTag path; loc} in loop () @@ -2636,7 +2643,7 @@ and parse_let_bindings ~attrs ~start_pos p = in (rec_flag, loop p [first]) -and parse_jsx_name p : Parsetree.jsx_tag_name = +and parse_jsx_name p : Parsetree.jsx_tag_name Location.loc = match read_jsx_tag_name p with | Some name -> name | None -> @@ -2645,7 +2652,7 @@ and parse_jsx_name p : Parsetree.jsx_tag_name = or Navbar in " in Parser.err p (Diagnostics.message msg); - Parsetree.JsxTagInvalid {loc = Location.none} + {txt = Parsetree.JsxTagInvalid; loc = Location.none} and parse_jsx_opening_or_self_closing_element (* start of the opening < *) ~start_pos p : Parsetree.expression = @@ -2687,8 +2694,8 @@ and parse_jsx_opening_or_self_closing_element (* start of the opening < *) (* Consume the closing name without mutating tokens beforehand *) match read_jsx_tag_name p with | Some closing_name - when Ast_helper.longident_of_jsx_tag_name closing_name - = Ast_helper.longident_of_jsx_tag_name name -> + when Ast_helper.Jsx.longident_of_jsx_tag_name closing_name.txt + = Ast_helper.Jsx.longident_of_jsx_tag_name name.txt -> let end_tag_name = closing_name in let closing_tag_end = p.start_pos in Parser.expect GreaterThan p; @@ -2709,13 +2716,13 @@ and parse_jsx_opening_or_self_closing_element (* start of the opening < *) let () = if Grammar.is_structure_item_start token0 then let closing = - "" + "" in let msg = Diagnostics.message ("Missing " ^ closing) in Parser.err ~start_pos ~end_pos:p.prev_end_pos p msg else let opening = - "" + "" in let msg = "Closing jsx name should be the same as the opening name. Did \ @@ -2732,11 +2739,15 @@ and parse_jsx_opening_or_self_closing_element (* start of the opening < *) | token -> let () = if Grammar.is_structure_item_start token then - let closing = "" in + let closing = + "" + in let msg = Diagnostics.message ("Missing " ^ closing) in Parser.err ~start_pos ~end_pos:p.prev_end_pos p msg else - let opening = "" in + let opening = + "" + in let msg = "Closing jsx name should be the same as the opening name. Did \ you mean " ^ opening ^ " ?" @@ -2776,9 +2787,8 @@ and parse_jsx p = parse_jsx_fragment start_pos p | _ -> let tag_name = parse_jsx_name p in - let (loc : Location.t) = Ast_helper.loc_of_jsx_tag_name tag_name in - - let lid = Ast_helper.longident_of_jsx_tag_name tag_name in + let (loc : Location.t) = tag_name.loc in + let lid = Ast_helper.Jsx.longident_of_jsx_tag_name tag_name.txt in Ast_helper.Exp.ident ~loc (Location.mkloc lid loc) in Parser.eat_breadcrumb p; diff --git a/compiler/syntax/src/res_parsetree_viewer.ml b/compiler/syntax/src/res_parsetree_viewer.ml index b592d9b266..fe5430ebe5 100644 --- a/compiler/syntax/src/res_parsetree_viewer.ml +++ b/compiler/syntax/src/res_parsetree_viewer.ml @@ -773,7 +773,7 @@ let get_jsx_prop_loc = function let container_element_closing_tag_loc (tag : Parsetree.jsx_closing_container_tag) = { - (Ast_helper.loc_of_jsx_tag_name tag.jsx_closing_container_tag_name) with + tag.jsx_closing_container_tag_name.loc with loc_start = tag.jsx_closing_container_tag_start; loc_end = tag.jsx_closing_container_tag_end; } diff --git a/compiler/syntax/src/res_printer.ml b/compiler/syntax/src/res_printer.ml index 5bd5c9ae38..fba786433e 100644 --- a/compiler/syntax/src/res_printer.ml +++ b/compiler/syntax/src/res_printer.ml @@ -4440,9 +4440,9 @@ and print_pexp_apply ~state expr cmt_tbl = | _ -> assert false and print_jsx_unary_tag ~state tag_name props expr_loc cmt_tbl = - let name = print_jsx_name tag_name in + let name = print_jsx_name tag_name.txt in let formatted_props = print_jsx_props ~state props cmt_tbl in - let tag_loc = Ast_helper.loc_of_jsx_tag_name tag_name in + let tag_loc = tag_name.loc in let tag_has_trailing_comment = has_trailing_comments cmt_tbl tag_loc in let tag_has_no_props = List.length props == 0 in let closing_token_loc = @@ -4488,7 +4488,7 @@ and print_jsx_container_tag ~state tag_name (children : Parsetree.jsx_children) (closing_tag : Parsetree.jsx_closing_container_tag option) (pexp_loc : Location.t) cmt_tbl = - let name = print_jsx_name tag_name in + let name = print_jsx_name tag_name.txt in let last_prop_has_comment_after = let rec visit props = match props with @@ -4553,7 +4553,7 @@ and print_jsx_container_tag ~state tag_name (Doc.concat [ (* Opening tag name and props *) - (let tag_loc = Ast_helper.loc_of_jsx_tag_name tag_name in + (let tag_loc = tag_name.loc in let opening_tag_name_doc = print_comments @@ -4772,7 +4772,7 @@ and print_jsx_props ~state props cmt_tbl : Doc.t list = and print_jsx_name (tag_name : Parsetree.jsx_tag_name) = let print_ident = print_ident_like ~allow_uident:true ~allow_hyphen:true in - let name = Ast_helper.string_of_jsx_tag_name tag_name in + let name = Ast_helper.Jsx.string_of_jsx_tag_name tag_name in (* Split by '.' to print each segment with ident rules *) let segments = Ext_string.split name '.' |> List.map print_ident in Doc.join ~sep:Doc.dot segments From d275fcd63e0aa8da4dcf8702011203fb260e1d60 Mon Sep 17 00:00:00 2001 From: nojaf Date: Mon, 11 Aug 2025 09:14:43 +0200 Subject: [PATCH 05/12] Use info from jsx_tag_name to determine upper or lower. --- compiler/syntax/src/jsx_v4.ml | 44 ++++++++++++----------------------- 1 file changed, 15 insertions(+), 29 deletions(-) diff --git a/compiler/syntax/src/jsx_v4.ml b/compiler/syntax/src/jsx_v4.ml index c91dd942e4..f8dafcca05 100644 --- a/compiler/syntax/src/jsx_v4.ml +++ b/compiler/syntax/src/jsx_v4.ml @@ -1083,19 +1083,6 @@ let transform_signature_item ~config item = "Only one JSX component call can exist on a component at one time") | _ -> [item] -(* TODO: refactor *) -let starts_with_lowercase s = - if String.length s = 0 then false - else - let c = s.[0] in - Char.lowercase_ascii c = c - -let starts_with_uppercase s = - if String.length s = 0 then false - else - let c = s.[0] in - Char.uppercase_ascii c = c - (* There appear to be slightly different rules of transformation whether the component is upper-, lowercase or a fragment *) type componentDescription = | LowercasedComponent @@ -1291,13 +1278,10 @@ let mk_react_jsx (config : Jsx_common.jsx_config) mapper loc attrs let mk_uppercase_tag_name_expr tag_name = let tag_identifier : Longident.t = match tag_name.txt with - | JsxTagInvalid -> Longident.Lident "_" - | JsxLowerTag name -> Longident.Lident name + | JsxTagInvalid | JsxLowerTag _ -> + failwith "Unreachable code at mk_uppercase_tag_name_expr" | JsxQualifiedLowerTag {path; name} -> Longident.Ldot (path, name) - | JsxUpperTag path -> - if Longident.flatten path |> List.for_all starts_with_uppercase then - Longident.Ldot (path, "make") - else path + | JsxUpperTag path -> Longident.Ldot (path, "make") in let loc = tag_name.loc in Exp.ident ~loc {txt = tag_identifier; loc} @@ -1318,46 +1302,48 @@ let expr ~(config : Jsx_common.jsx_config) mapper expression = children | Jsx_unary_element {jsx_unary_element_tag_name = tag_name; jsx_unary_element_props = props} - -> + -> ( let name = Ast_helper.Jsx.string_of_jsx_tag_name tag_name.txt in let tag_loc = tag_name.loc in - if starts_with_lowercase name then + match tag_name.txt with + | JsxLowerTag _ -> (* For example 'input' *) let component_name_expr = constant_string ~loc:tag_loc name in mk_react_jsx config mapper loc attrs LowercasedComponent component_name_expr props (JSXChildrenItems []) - else if starts_with_uppercase name then + | JsxUpperTag _ | JsxQualifiedLowerTag _ -> (* MyModule.make *) let make_id = mk_uppercase_tag_name_expr tag_name in mk_react_jsx config mapper loc attrs UppercasedComponent make_id props (JSXChildrenItems []) - else + | JsxTagInvalid -> Jsx_common.raise_error ~loc - "JSX: element name is neither upper- or lowercase, got \"%s\"" name + "JSX: element name is neither upper- or lowercase, got \"%s\"" name) | Jsx_container_element { jsx_container_element_tag_name_start = tag_name; jsx_container_element_props = props; jsx_container_element_children = children; - } -> + } -> ( let name, tag_loc = (Ast_helper.Jsx.string_of_jsx_tag_name tag_name.txt, tag_name.loc) in (* For example:


This has an impact if we want to use ReactDOM.jsx or ReactDOM.jsxs *) - if starts_with_lowercase name then + match tag_name.txt with + | JsxLowerTag _ -> let component_name_expr = constant_string ~loc:tag_loc name in mk_react_jsx config mapper loc attrs LowercasedComponent component_name_expr props children - else if starts_with_uppercase name then + | JsxQualifiedLowerTag _ | JsxUpperTag _ -> (* MyModule.make *) let make_id = mk_uppercase_tag_name_expr tag_name in mk_react_jsx config mapper loc attrs UppercasedComponent make_id props children - else + | JsxTagInvalid -> Jsx_common.raise_error ~loc - "JSX: element name is neither upper- or lowercase, got \"%s\"" name) + "JSX: element name is neither upper- or lowercase, got \"%s\"" name)) | e -> default_mapper.expr mapper e let module_binding ~(config : Jsx_common.jsx_config) mapper module_binding = From d95c0ff88e0ff16a31d14738cc4953042f295f97 Mon Sep 17 00:00:00 2001 From: nojaf Date: Mon, 11 Aug 2025 09:27:07 +0200 Subject: [PATCH 06/12] Clean up --- compiler/ml/ast_iterator.ml | 8 ++++---- compiler/ml/ast_mapper.ml | 6 +++--- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/compiler/ml/ast_iterator.ml b/compiler/ml/ast_iterator.ml index 5795ffafd7..4380ca1af2 100644 --- a/compiler/ml/ast_iterator.ml +++ b/compiler/ml/ast_iterator.ml @@ -365,18 +365,18 @@ module E = struct iter_jsx_children sub children | Pexp_jsx_element (Jsx_unary_element - {jsx_unary_element_tag_name = _name; jsx_unary_element_props = props}) + {jsx_unary_element_tag_name = name; jsx_unary_element_props = props}) -> - (* jsx_tag_name contains a Location.t inside; attributes and visitors can - visit props and children as before *) + iter_loc sub name; iter_jsx_props sub props | Pexp_jsx_element (Jsx_container_element { - jsx_container_element_tag_name_start = _name; + jsx_container_element_tag_name_start = name; jsx_container_element_props = props; jsx_container_element_children = children; }) -> + iter_loc sub name; iter_jsx_props sub props; iter_jsx_children sub children end diff --git a/compiler/ml/ast_mapper.ml b/compiler/ml/ast_mapper.ml index 7476c01741..e2f4d6cad0 100644 --- a/compiler/ml/ast_mapper.ml +++ b/compiler/ml/ast_mapper.ml @@ -358,8 +358,7 @@ module E = struct (Jsx_unary_element {jsx_unary_element_tag_name = name; jsx_unary_element_props = props}) -> - (* pass through jsx_tag_name unchanged; it is not a loc *) - jsx_unary_element ~loc ~attrs name (map_jsx_props sub props) + jsx_unary_element ~loc ~attrs (map_loc sub name) (map_jsx_props sub props) | Pexp_jsx_element (Jsx_container_element { @@ -369,7 +368,8 @@ module E = struct jsx_container_element_children = children; jsx_container_element_closing_tag = closing_tag; }) -> - jsx_container_element ~loc ~attrs name (map_jsx_props sub props) ote + jsx_container_element ~loc ~attrs (map_loc sub name) + (map_jsx_props sub props) ote (map_jsx_children sub children) closing_tag end From b2da822f749f7ee63060a8e42c8bbb32f61ba903 Mon Sep 17 00:00:00 2001 From: nojaf Date: Mon, 11 Aug 2025 09:40:22 +0200 Subject: [PATCH 07/12] Parser clean up --- compiler/syntax/src/res_core.ml | 106 +++++++++++++++----------------- 1 file changed, 51 insertions(+), 55 deletions(-) diff --git a/compiler/syntax/src/res_core.ml b/compiler/syntax/src/res_core.ml index 9ad404433e..6bf1979ca7 100644 --- a/compiler/syntax/src/res_core.ml +++ b/compiler/syntax/src/res_core.ml @@ -2666,7 +2666,7 @@ and parse_jsx_opening_or_self_closing_element (* start of the opening < *) Parser.expect GreaterThan p; let loc = mk_loc start_pos jsx_end_pos in Ast_helper.Exp.jsx_unary_element ~loc name jsx_props - | GreaterThan -> + | GreaterThan -> ( (* bar *) let opening_tag_end = p.Parser.start_pos in Parser.next p; @@ -2688,57 +2688,31 @@ and parse_jsx_opening_or_self_closing_element (* start of the opening < *) in (* Read the closing tag name and verify it matches the opening name *) let token0 = p.Parser.token in - let expr_after_closing = - match token0 with - | Lident _ | Uident _ -> ( - (* Consume the closing name without mutating tokens beforehand *) - match read_jsx_tag_name p with - | Some closing_name - when Ast_helper.Jsx.longident_of_jsx_tag_name closing_name.txt - = Ast_helper.Jsx.longident_of_jsx_tag_name name.txt -> - let end_tag_name = closing_name in - let closing_tag_end = p.start_pos in - Parser.expect GreaterThan p; - let loc = mk_loc start_pos p.prev_end_pos in - let closing_tag = - closing_tag_start - |> Option.map (fun closing_tag_start -> - { - Parsetree.jsx_closing_container_tag_start = - closing_tag_start; - jsx_closing_container_tag_name = end_tag_name; - jsx_closing_container_tag_end = closing_tag_end; - }) - in - Ast_helper.Exp.jsx_container_element ~loc name jsx_props - opening_tag_end children closing_tag - | _ -> - let () = - if Grammar.is_structure_item_start token0 then - let closing = - "" - in - let msg = Diagnostics.message ("Missing " ^ closing) in - Parser.err ~start_pos ~end_pos:p.prev_end_pos p msg - else - let opening = - "" - in - let msg = - "Closing jsx name should be the same as the opening name. Did \ - you mean " ^ opening ^ " ?" - in - Parser.err ~start_pos ~end_pos:p.prev_end_pos p - (Diagnostics.message msg); - (* read_jsx_tag_name already consumed the name; expect the '>') *) - Parser.expect GreaterThan p - in - Ast_helper.Exp.jsx_container_element - ~loc:(mk_loc start_pos p.prev_end_pos) - name jsx_props opening_tag_end children None) - | token -> + match token0 with + | Lident _ | Uident _ -> ( + (* Consume the closing name without mutating tokens beforehand *) + match read_jsx_tag_name p with + | Some closing_name + when Ast_helper.Jsx.longident_of_jsx_tag_name closing_name.txt + = Ast_helper.Jsx.longident_of_jsx_tag_name name.txt -> + let end_tag_name = closing_name in + let closing_tag_end = p.start_pos in + Parser.expect GreaterThan p; + let loc = mk_loc start_pos p.prev_end_pos in + let closing_tag = + closing_tag_start + |> Option.map (fun closing_tag_start -> + { + Parsetree.jsx_closing_container_tag_start = closing_tag_start; + jsx_closing_container_tag_name = end_tag_name; + jsx_closing_container_tag_end = closing_tag_end; + }) + in + Ast_helper.Exp.jsx_container_element ~loc name jsx_props opening_tag_end + children closing_tag + | _ -> let () = - if Grammar.is_structure_item_start token then + if Grammar.is_structure_item_start token0 then let closing = "" in @@ -2753,13 +2727,35 @@ and parse_jsx_opening_or_self_closing_element (* start of the opening < *) you mean " ^ opening ^ " ?" in Parser.err ~start_pos ~end_pos:p.prev_end_pos p - (Diagnostics.message msg) + (Diagnostics.message msg); + (* read_jsx_tag_name already consumed the name; expect the '>') *) + Parser.expect GreaterThan p in Ast_helper.Exp.jsx_container_element ~loc:(mk_loc start_pos p.prev_end_pos) - name jsx_props opening_tag_end children None - in - expr_after_closing + name jsx_props opening_tag_end children None) + | token -> + let () = + if Grammar.is_structure_item_start token then + let closing = + "" + in + let msg = Diagnostics.message ("Missing " ^ closing) in + Parser.err ~start_pos ~end_pos:p.prev_end_pos p msg + else + let opening = + "" + in + let msg = + "Closing jsx name should be the same as the opening name. Did you \ + mean " ^ opening ^ " ?" + in + Parser.err ~start_pos ~end_pos:p.prev_end_pos p + (Diagnostics.message msg) + in + Ast_helper.Exp.jsx_container_element + ~loc:(mk_loc start_pos p.prev_end_pos) + name jsx_props opening_tag_end children None) | token -> Parser.err p (Diagnostics.unexpected token p.breadcrumbs); Ast_helper.Exp.jsx_unary_element From 1924b7039a5dc77250aaf5d28688c4ed54ed8cc6 Mon Sep 17 00:00:00 2001 From: nojaf Date: Mon, 11 Aug 2025 10:51:02 +0200 Subject: [PATCH 08/12] Refactor read_jsx_tag_name --- compiler/syntax/src/res_core.ml | 49 +++++++++++++++++---------------- 1 file changed, 26 insertions(+), 23 deletions(-) diff --git a/compiler/syntax/src/res_core.ml b/compiler/syntax/src/res_core.ml index 6bf1979ca7..b7776b8d7f 100644 --- a/compiler/syntax/src/res_core.ml +++ b/compiler/syntax/src/res_core.ml @@ -779,7 +779,7 @@ let read_local_jsx_name (p : Parser.t) : (* Build a Longident from a non-empty list of segments *) let longident_of_segments (segs : string list) : Longident.t = match segs with - | [] -> Longident.Lident "_" + | [] -> invalid_arg "longident_of_segments: empty list" | hd :: tl -> List.fold_left (fun acc s -> Longident.Ldot (acc, s)) @@ -794,13 +794,11 @@ let read_jsx_tag_name (p : Parser.t) : read_local_jsx_name p |> Option.map (fun (name, loc, _) -> {Location.txt = Parsetree.JsxLowerTag name; loc}) - | Some (seg, seg_loc, `Upper) -> - let start_pos = seg_loc.Location.loc_start in - let rev_segs = ref [seg] in - let last_end = ref seg_loc.Location.loc_end in + | Some (first_seg, first_loc, `Upper) -> + let start_pos = first_loc.Location.loc_start in (* consume first Uident *) Parser.next p; - let rec loop () = + let rec loop rev_segs last_end = match p.Parser.token with | Dot -> ( Parser.next p; @@ -812,30 +810,35 @@ let read_jsx_tag_name (p : Parser.t) : None | Some (txt, _loc, `Upper) -> (* another path segment *) - rev_segs := txt :: !rev_segs; Parser.next p; - last_end := p.prev_end_pos; - loop () + loop (txt :: rev_segs) p.prev_end_pos | Some (_, _, `Lower) -> ( (* final lowercase with optional hyphens *) match read_local_jsx_name p with - | Some (lname, l_loc, _) -> - let path = longident_of_segments (List.rev !rev_segs) in - let loc = mk_loc start_pos l_loc.Location.loc_end in - Some - { - Location.txt = - Parsetree.JsxQualifiedLowerTag {path; name = lname}; - loc; - } + | Some (lname, l_loc, _) -> ( + match rev_segs with + | [] -> None + | _ -> + let path = longident_of_segments (List.rev rev_segs) in + let loc = mk_loc start_pos l_loc.Location.loc_end in + Some + { + Location.txt = + Parsetree.JsxQualifiedLowerTag {path; name = lname}; + loc; + }) | None -> None)) - | _ -> + | _ -> ( (* pure Upper path *) - let path = longident_of_segments (List.rev !rev_segs) in - let loc = mk_loc start_pos !last_end in - Some {txt = Parsetree.JsxUpperTag path; loc} + match rev_segs with + | [] -> None + | _ -> + let path = longident_of_segments (List.rev rev_segs) in + let loc = mk_loc start_pos last_end in + Some {txt = Parsetree.JsxUpperTag path; loc}) in - loop () + (* seed with the first segment already consumed *) + loop [first_seg] first_loc.Location.loc_end (* Parses module identifiers: Foo From 92c46c7abef4db8e1b17178b2f51da7adb0f8c7d Mon Sep 17 00:00:00 2001 From: nojaf Date: Mon, 11 Aug 2025 11:43:59 +0200 Subject: [PATCH 09/12] Add value to JsxInvalid --- analysis/src/CompletionFrontEnd.ml | 2 +- compiler/ml/ast_helper.ml | 4 +- compiler/ml/depend.ml | 4 +- compiler/ml/parsetree.ml | 2 +- compiler/ml/pprintast.ml | 17 ++++-- compiler/ml/printast.ml | 12 +++-- compiler/syntax/src/jsx_v4.ml | 6 +-- compiler/syntax/src/res_core.ml | 53 +++++++++++++------ compiler/syntax/src/res_printer.ml | 29 +++++++--- .../errors/expressions/expected/jsx.res.txt | 34 ++++++++++-- .../data/parsing/errors/expressions/jsx.res | 4 ++ .../expected/jsxChildren.res.txt | 2 +- 12 files changed, 125 insertions(+), 44 deletions(-) diff --git a/analysis/src/CompletionFrontEnd.ml b/analysis/src/CompletionFrontEnd.ml index 4ccc2fd839..ff605b5de7 100644 --- a/analysis/src/CompletionFrontEnd.ml +++ b/analysis/src/CompletionFrontEnd.ml @@ -1345,7 +1345,7 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor inJsxContext := true; let is_valid_tag_for_props = match compName.txt with - | Parsetree.JsxTagInvalid -> false + | Parsetree.JsxTagInvalid _ -> false | _ -> true in let children = diff --git a/compiler/ml/ast_helper.ml b/compiler/ml/ast_helper.ml index b4db90b526..2fae640eb0 100644 --- a/compiler/ml/ast_helper.ml +++ b/compiler/ml/ast_helper.ml @@ -436,7 +436,7 @@ module Jsx = struct | Parsetree.JsxQualifiedLowerTag {path; name} -> String.concat "." (Longident.flatten path) ^ "." ^ name | Parsetree.JsxUpperTag path -> String.concat "." (Longident.flatten path) - | Parsetree.JsxTagInvalid -> "_" + | Parsetree.JsxTagInvalid name -> name let longident_of_jsx_tag_name (tag_name : Parsetree.jsx_tag_name) : Longident.t = @@ -444,5 +444,5 @@ module Jsx = struct | Parsetree.JsxLowerTag name -> Longident.Lident name | Parsetree.JsxQualifiedLowerTag {path; name} -> Longident.Ldot (path, name) | Parsetree.JsxUpperTag path -> path - | Parsetree.JsxTagInvalid -> Longident.Lident "_" + | Parsetree.JsxTagInvalid name -> Longident.Lident name end diff --git a/compiler/ml/depend.ml b/compiler/ml/depend.ml index 9c92881177..bb467ef592 100644 --- a/compiler/ml/depend.ml +++ b/compiler/ml/depend.ml @@ -296,7 +296,7 @@ let rec add_expr bv exp = -> (* Conservatively add all module path segments referenced by the tag name *) (match name.txt with - | JsxLowerTag _ | JsxTagInvalid -> () + | JsxLowerTag _ | JsxTagInvalid _ -> () | JsxQualifiedLowerTag {path; _} | JsxUpperTag path -> add_path bv path); and_jsx_props bv props | Pexp_jsx_element @@ -307,7 +307,7 @@ let rec add_expr bv exp = jsx_container_element_children = children; }) -> (match name.txt with - | JsxLowerTag _ | JsxTagInvalid -> () + | JsxLowerTag _ | JsxTagInvalid _ -> () | JsxQualifiedLowerTag {path; _} | JsxUpperTag path -> add_path bv path); and_jsx_props bv props; add_jsx_children bv children diff --git a/compiler/ml/parsetree.ml b/compiler/ml/parsetree.ml index 180daece6f..cc99af9b92 100644 --- a/compiler/ml/parsetree.ml +++ b/compiler/ml/parsetree.ml @@ -329,7 +329,7 @@ and jsx_tag_name = | JsxLowerTag of string | JsxQualifiedLowerTag of {path: Longident.t; name: string} | JsxUpperTag of Longident.t - | JsxTagInvalid + | JsxTagInvalid of string and jsx_fragment = { (* > *) jsx_fragment_opening: Lexing.position; diff --git a/compiler/ml/pprintast.ml b/compiler/ml/pprintast.ml index 3c61bd4a48..2a91e8fd1f 100644 --- a/compiler/ml/pprintast.ml +++ b/compiler/ml/pprintast.ml @@ -815,19 +815,28 @@ and simple_expr ctxt f x = jsx_container_element_tag_name_start = tag_name; jsx_container_element_props = props; jsx_container_element_children = children; + jsx_container_element_closing_tag = closing_tag; }) -> ( let name = Ast_helper.Jsx.string_of_jsx_tag_name tag_name.txt in + let closing_name = + match closing_tag with + | None -> "" + | Some closing_tag -> + Format.sprintf "" + (Ast_helper.Jsx.string_of_jsx_tag_name + closing_tag.jsx_closing_container_tag_name.txt) + in match props with | [] -> - pp f "<%s>%a" name + pp f "<%s>%a%s" name (list (simple_expr ctxt)) (collect_jsx_children children) - name + closing_name | _ -> - pp f "<%s %a>%a" name (print_jsx_props ctxt) props + pp f "<%s %a>%a%s" name (print_jsx_props ctxt) props (list (simple_expr ctxt)) (collect_jsx_children children) - name) + closing_name) | _ -> paren true (expression ctxt) f x and collect_jsx_children = function diff --git a/compiler/ml/printast.ml b/compiler/ml/printast.ml index 4a961c443d..756511f0bb 100644 --- a/compiler/ml/printast.ml +++ b/compiler/ml/printast.ml @@ -50,7 +50,7 @@ let fmt_jsx_tag_name f (x : jsx_tag_name loc) = fprintf f "\"%a.%s\" %a" fmt_longident_aux path name fmt_location loc | JsxUpperTag path -> fprintf f "\"%a\" %a" fmt_longident_aux path fmt_location loc - | JsxTagInvalid -> fprintf f "\"_\" %a" fmt_location loc + | JsxTagInvalid name -> fprintf f "\"%s\" %a" name fmt_location loc let fmt_string_loc f (x : string loc) = fprintf f "\"%s\" %a" x.txt fmt_location x.loc @@ -369,11 +369,17 @@ and expression i ppf x = jsx_container_element_props = props; jsx_container_element_opening_tag_end = gt; jsx_container_element_children = children; - }) -> + jsx_container_element_closing_tag = closing_tag; + }) -> ( line i ppf "Pexp_jsx_container_element %a\n" fmt_jsx_tag_name name; jsx_props i ppf props; if !Clflags.dump_location then line i ppf "> %a\n" (fmt_position false) gt; - jsx_children i ppf children + jsx_children i ppf children; + match closing_tag with + | None -> () + | Some closing_tag -> + line i ppf "closing_tag =%a\n" fmt_jsx_tag_name + closing_tag.jsx_closing_container_tag_name) and jsx_children i ppf children = line i ppf "jsx_children =\n"; diff --git a/compiler/syntax/src/jsx_v4.ml b/compiler/syntax/src/jsx_v4.ml index f8dafcca05..7351aaf384 100644 --- a/compiler/syntax/src/jsx_v4.ml +++ b/compiler/syntax/src/jsx_v4.ml @@ -1278,7 +1278,7 @@ let mk_react_jsx (config : Jsx_common.jsx_config) mapper loc attrs let mk_uppercase_tag_name_expr tag_name = let tag_identifier : Longident.t = match tag_name.txt with - | JsxTagInvalid | JsxLowerTag _ -> + | JsxTagInvalid _ | JsxLowerTag _ -> failwith "Unreachable code at mk_uppercase_tag_name_expr" | JsxQualifiedLowerTag {path; name} -> Longident.Ldot (path, name) | JsxUpperTag path -> Longident.Ldot (path, "make") @@ -1316,7 +1316,7 @@ let expr ~(config : Jsx_common.jsx_config) mapper expression = let make_id = mk_uppercase_tag_name_expr tag_name in mk_react_jsx config mapper loc attrs UppercasedComponent make_id props (JSXChildrenItems []) - | JsxTagInvalid -> + | JsxTagInvalid name -> Jsx_common.raise_error ~loc "JSX: element name is neither upper- or lowercase, got \"%s\"" name) | Jsx_container_element @@ -1341,7 +1341,7 @@ let expr ~(config : Jsx_common.jsx_config) mapper expression = let make_id = mk_uppercase_tag_name_expr tag_name in mk_react_jsx config mapper loc attrs UppercasedComponent make_id props children - | JsxTagInvalid -> + | JsxTagInvalid name -> Jsx_common.raise_error ~loc "JSX: element name is neither upper- or lowercase, got \"%s\"" name)) | e -> default_mapper.expr mapper e diff --git a/compiler/syntax/src/res_core.ml b/compiler/syntax/src/res_core.ml index b7776b8d7f..a4df491b0a 100644 --- a/compiler/syntax/src/res_core.ml +++ b/compiler/syntax/src/res_core.ml @@ -787,18 +787,20 @@ let longident_of_segments (segs : string list) : Longident.t = (* Read a JSX tag name and return a jsx_tag_name; does not mutate tokens beyond what it consumes *) let read_jsx_tag_name (p : Parser.t) : - Parsetree.jsx_tag_name Location.loc option = + (Parsetree.jsx_tag_name Location.loc, string) result = match peek_ident p with - | None -> None + | None -> Error "" | Some (_, _, `Lower) -> read_local_jsx_name p |> Option.map (fun (name, loc, _) -> {Location.txt = Parsetree.JsxLowerTag name; loc}) + |> Option.to_result ~none:"" | Some (first_seg, first_loc, `Upper) -> let start_pos = first_loc.Location.loc_start in (* consume first Uident *) Parser.next p; let rec loop rev_segs last_end = + let string_of_rev_segments segs = String.concat "." (List.rev segs) in match p.Parser.token with | Dot -> ( Parser.next p; @@ -807,7 +809,7 @@ let read_jsx_tag_name (p : Parser.t) : | None -> Parser.err p (Diagnostics.message "expected identifier after '.' in JSX tag name"); - None + Error (string_of_rev_segments rev_segs ^ ".") | Some (txt, _loc, `Upper) -> (* another path segment *) Parser.next p; @@ -817,25 +819,25 @@ let read_jsx_tag_name (p : Parser.t) : match read_local_jsx_name p with | Some (lname, l_loc, _) -> ( match rev_segs with - | [] -> None + | [] -> Error "" | _ -> let path = longident_of_segments (List.rev rev_segs) in let loc = mk_loc start_pos l_loc.Location.loc_end in - Some + Ok { Location.txt = Parsetree.JsxQualifiedLowerTag {path; name = lname}; loc; }) - | None -> None)) + | None -> Error "")) | _ -> ( (* pure Upper path *) match rev_segs with - | [] -> None + | [] -> Error "" | _ -> let path = longident_of_segments (List.rev rev_segs) in let loc = mk_loc start_pos last_end in - Some {txt = Parsetree.JsxUpperTag path; loc}) + Ok {txt = Parsetree.JsxUpperTag path; loc}) in (* seed with the first segment already consumed *) loop [first_seg] first_loc.Location.loc_end @@ -2648,14 +2650,14 @@ and parse_let_bindings ~attrs ~start_pos p = and parse_jsx_name p : Parsetree.jsx_tag_name Location.loc = match read_jsx_tag_name p with - | Some name -> name - | None -> + | Ok name -> name + | Error invalid_str -> let msg = "A jsx name must be a lowercase or uppercase name, like: div in
\ or Navbar in " in Parser.err p (Diagnostics.message msg); - {txt = Parsetree.JsxTagInvalid; loc = Location.none} + {txt = Parsetree.JsxTagInvalid invalid_str; loc = Location.none} and parse_jsx_opening_or_self_closing_element (* start of the opening < *) ~start_pos p : Parsetree.expression = @@ -2694,8 +2696,9 @@ and parse_jsx_opening_or_self_closing_element (* start of the opening < *) match token0 with | Lident _ | Uident _ -> ( (* Consume the closing name without mutating tokens beforehand *) - match read_jsx_tag_name p with - | Some closing_name + let closing_name_res = read_jsx_tag_name p in + match closing_name_res with + | Ok closing_name when Ast_helper.Jsx.longident_of_jsx_tag_name closing_name.txt = Ast_helper.Jsx.longident_of_jsx_tag_name name.txt -> let end_tag_name = closing_name in @@ -2715,12 +2718,14 @@ and parse_jsx_opening_or_self_closing_element (* start of the opening < *) children closing_tag | _ -> let () = - if Grammar.is_structure_item_start token0 then + if Grammar.is_structure_item_start token0 then ( let closing = "" in let msg = Diagnostics.message ("Missing " ^ closing) in - Parser.err ~start_pos ~end_pos:p.prev_end_pos p msg + Parser.err ~start_pos ~end_pos:p.prev_end_pos p msg; + (* We attempted to read a closing name; consume the '>' to keep AST shape stable *) + Parser.expect GreaterThan p) else let opening = "" @@ -2734,9 +2739,25 @@ and parse_jsx_opening_or_self_closing_element (* start of the opening < *) (* read_jsx_tag_name already consumed the name; expect the '>') *) Parser.expect GreaterThan p in + let end_tag_name = + match closing_name_res with + | Ok closing_name -> closing_name + | Error invalid_str -> + {txt = Parsetree.JsxTagInvalid invalid_str; loc = Location.none} + in + let closing_tag_end = p.prev_end_pos in + let closing_tag = + closing_tag_start + |> Option.map (fun closing_tag_start -> + { + Parsetree.jsx_closing_container_tag_start = closing_tag_start; + jsx_closing_container_tag_name = end_tag_name; + jsx_closing_container_tag_end = closing_tag_end; + }) + in Ast_helper.Exp.jsx_container_element ~loc:(mk_loc start_pos p.prev_end_pos) - name jsx_props opening_tag_end children None) + name jsx_props opening_tag_end children closing_tag) | token -> let () = if Grammar.is_structure_item_start token then diff --git a/compiler/syntax/src/res_printer.ml b/compiler/syntax/src/res_printer.ml index fba786433e..a7c95cf5ee 100644 --- a/compiler/syntax/src/res_printer.ml +++ b/compiler/syntax/src/res_printer.ml @@ -4542,8 +4542,11 @@ and print_jsx_container_tag ~state tag_name let closing_tag_loc = ParsetreeViewer.container_element_closing_tag_loc closing_tag in + let closing_name = + print_jsx_name closing_tag.jsx_closing_container_tag_name.txt + in print_comments - (Doc.concat [Doc.text " List.map (fun prop -> print_jsx_prop ~state prop cmt_tbl) and print_jsx_name (tag_name : Parsetree.jsx_tag_name) = - let print_ident = print_ident_like ~allow_uident:true ~allow_hyphen:true in - let name = Ast_helper.Jsx.string_of_jsx_tag_name tag_name in - (* Split by '.' to print each segment with ident rules *) - let segments = Ext_string.split name '.' |> List.map print_ident in - Doc.join ~sep:Doc.dot segments + match tag_name with + | Parsetree.JsxTagInvalid invalid -> + (* Preserve exactly what the parser recorded as invalid *) + Doc.text invalid + | Parsetree.JsxLowerTag name -> + print_ident_like ~allow_uident:true ~allow_hyphen:true name + | Parsetree.JsxQualifiedLowerTag {path; name} -> + let upper_segs = Longident.flatten path in + let printed_upper = + upper_segs |> List.map (print_ident_like ~allow_uident:true) + in + let printed_lower = + print_ident_like ~allow_uident:true ~allow_hyphen:true name + in + Doc.join ~sep:Doc.dot (printed_upper @ [printed_lower]) + | Parsetree.JsxUpperTag path -> + let segs = Longident.flatten path in + let printed = segs |> List.map (print_ident_like ~allow_uident:true) in + Doc.join ~sep:Doc.dot printed and print_arguments_with_callback_in_first_position ~state ~partial args cmt_tbl = diff --git a/tests/syntax_tests/data/parsing/errors/expressions/expected/jsx.res.txt b/tests/syntax_tests/data/parsing/errors/expressions/expected/jsx.res.txt index 7d347c1bfe..67191bd9ca 100644 --- a/tests/syntax_tests/data/parsing/errors/expressions/expected/jsx.res.txt +++ b/tests/syntax_tests/data/parsing/errors/expressions/expected/jsx.res.txt @@ -89,15 +89,39 @@ 10 │ let x = 11 │ let x = 12 │ + 13 │ // Trailing dots in tag names JSX identifier cannot end with a hyphen + + Syntax error! + syntax_tests/data/parsing/errors/expressions/jsx.res:14:15 + + 12 │ + 13 │ // Trailing dots in tag names + 14 │ let x = + 15 │ let x = + + expected identifier after '.' in JSX tag name + + + Syntax error! + syntax_tests/data/parsing/errors/expressions/jsx.res:15:20 + + 13 │ // Trailing dots in tag names + 14 │ let x = + 15 │ let x = + + expected identifier after '.' in JSX tag name + let x = -let x = -let x = > ([%rescript.exprhole ]) -let x = > ([%rescript.exprhole ]) -let x = > ([%rescript.exprhole ]) +let x = +let x = +let x = +let x = let x = let x = let x = -let x = \ No newline at end of file +let x = +let x = +let x = \ No newline at end of file diff --git a/tests/syntax_tests/data/parsing/errors/expressions/jsx.res b/tests/syntax_tests/data/parsing/errors/expressions/jsx.res index f27b5d3ebf..1be9e395d3 100644 --- a/tests/syntax_tests/data/parsing/errors/expressions/jsx.res +++ b/tests/syntax_tests/data/parsing/errors/expressions/jsx.res @@ -9,3 +9,7 @@ let x = let x = let x = let x = + +// Trailing dots in tag names +let x = +let x = \ No newline at end of file diff --git a/tests/syntax_tests/data/parsing/infiniteLoops/expected/jsxChildren.res.txt b/tests/syntax_tests/data/parsing/infiniteLoops/expected/jsxChildren.res.txt index bc2fbd3a60..04158f30aa 100644 --- a/tests/syntax_tests/data/parsing/infiniteLoops/expected/jsxChildren.res.txt +++ b/tests/syntax_tests/data/parsing/infiniteLoops/expected/jsxChildren.res.txt @@ -20,7 +20,7 @@ type nonrec action = | AddUser -;; +;; let (a : action) = AddUser {js|test|js} ;;etype ;;s = { x = ((list < i) > ([%rescript.exprhole ])) } \ No newline at end of file From 2bc1835830cdff3c5a5f38e50cb091f2b43c48b8 Mon Sep 17 00:00:00 2001 From: nojaf Date: Mon, 11 Aug 2025 11:44:48 +0200 Subject: [PATCH 10/12] Update snapshot --- tests/analysis_tests/tests/src/expected/Completion.res.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/analysis_tests/tests/src/expected/Completion.res.txt b/tests/analysis_tests/tests/src/expected/Completion.res.txt index 5805eb7aaa..2f8e8231ed 100644 --- a/tests/analysis_tests/tests/src/expected/Completion.res.txt +++ b/tests/analysis_tests/tests/src/expected/Completion.res.txt @@ -1065,7 +1065,7 @@ Path Objects.object Complete src/Completion.res 151:6 posCursor:[151:6] posNoWhite:[151:5] Found expr:[151:3->151:6] -JSX <_:__ghost__[0:-1->0:-1] > _children:None +JSX 0:-1] > _children:None [] Complete src/Completion.res 157:8 From a8aa56db79e854d33ee6df51a06bd73cff0d8a86 Mon Sep 17 00:00:00 2001 From: nojaf Date: Mon, 11 Aug 2025 11:57:21 +0200 Subject: [PATCH 11/12] Move helper out of loop --- compiler/syntax/src/res_core.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/syntax/src/res_core.ml b/compiler/syntax/src/res_core.ml index a4df491b0a..ab9d0d4cee 100644 --- a/compiler/syntax/src/res_core.ml +++ b/compiler/syntax/src/res_core.ml @@ -799,8 +799,8 @@ let read_jsx_tag_name (p : Parser.t) : let start_pos = first_loc.Location.loc_start in (* consume first Uident *) Parser.next p; + let string_of_rev_segments segs = String.concat "." (List.rev segs) in let rec loop rev_segs last_end = - let string_of_rev_segments segs = String.concat "." (List.rev segs) in match p.Parser.token with | Dot -> ( Parser.next p; From 88f41f7867c0128f0973fde80196b2f33263ea9e Mon Sep 17 00:00:00 2001 From: nojaf Date: Mon, 11 Aug 2025 11:58:39 +0200 Subject: [PATCH 12/12] Add changelog entry --- CHANGELOG.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 7aa9bf1fad..063eb7713d 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -26,6 +26,8 @@ #### :house: Internal +- AST: Use jsx_tag_name instead of Longindent.t to store jsx tag name. https://github.com/rescript-lang/rescript/pull/7760 + # 12.0.0-beta.5 #### :bug: Bug fix