From e53ab8a51c37c5080cb9b30817fbb8c213b1128f Mon Sep 17 00:00:00 2001 From: nojaf Date: Tue, 29 Apr 2025 14:41:29 +0200 Subject: [PATCH 1/4] Capture pc_loc instead of pc_bar --- analysis/src/Codemod.ml | 3 ++- analysis/src/TypeUtils.ml | 2 +- analysis/src/Xform.ml | 9 +++++++-- compiler/frontend/bs_ast_mapper.ml | 4 ++-- compiler/frontend/bs_builtin_ppx.ml | 10 +++++++++- compiler/ml/ast_helper.ml | 4 ++-- compiler/ml/ast_helper.mli | 3 +-- compiler/ml/ast_mapper.ml | 4 ++-- compiler/ml/ast_mapper_from0.ml | 4 +++- compiler/ml/parsetree.ml | 2 +- compiler/ml/printast.ml | 6 ++---- compiler/ml/typecore.ml | 21 ++++++++++++++++----- compiler/syntax/src/jsx_v4.ml | 4 ++-- compiler/syntax/src/res_core.ml | 9 ++++++--- 14 files changed, 56 insertions(+), 29 deletions(-) diff --git a/analysis/src/Codemod.ml b/analysis/src/Codemod.ml index 5c273637de..47f87a151e 100644 --- a/analysis/src/Codemod.ml +++ b/analysis/src/Codemod.ml @@ -19,7 +19,8 @@ let transform ~path ~pos ~debug ~typ ~hint = let cases = collectPatterns pattern |> List.map (fun (p : Parsetree.pattern) -> - Ast_helper.Exp.case p (TypeUtils.Codegen.mkFailWithExp ())) + Ast_helper.Exp.case p.ppat_loc p + (TypeUtils.Codegen.mkFailWithExp ())) in let result = ref None in let mkIterator ~pos ~result = diff --git a/analysis/src/TypeUtils.ml b/analysis/src/TypeUtils.ml index 5507600c88..5662c1edde 100644 --- a/analysis/src/TypeUtils.ml +++ b/analysis/src/TypeUtils.ml @@ -1044,7 +1044,7 @@ module Codegen = struct Some (patterns |> List.map (fun (pat : Parsetree.pattern) -> - Ast_helper.Exp.case pat (mkFailWithExp ()))) + Ast_helper.Exp.case pat.ppat_loc pat (mkFailWithExp ()))) end let getModulePathRelativeToEnv ~debug ~(env : QueryEnv.t) ~envFromItem path = diff --git a/analysis/src/Xform.ml b/analysis/src/Xform.ml index 837f7df744..afe5b85050 100644 --- a/analysis/src/Xform.ml +++ b/analysis/src/Xform.ml @@ -105,8 +105,13 @@ module IfThenElse = struct let mkMatch ~arg ~pat = let cases = [ - Ast_helper.Exp.case pat e1; - Ast_helper.Exp.case (Ast_helper.Pat.any ()) e2; + Ast_helper.Exp.case + { + pat.Parsetree.ppat_loc with + Location.loc_end = e1.pexp_loc.loc_end; + } + pat e1; + Ast_helper.Exp.case e2.pexp_loc (Ast_helper.Pat.any ()) e2; ] in Ast_helper.Exp.match_ ~loc:e.pexp_loc ~attrs:e.pexp_attributes arg diff --git a/compiler/frontend/bs_ast_mapper.ml b/compiler/frontend/bs_ast_mapper.ml index fff7690b20..11ce8b192e 100644 --- a/compiler/frontend/bs_ast_mapper.ml +++ b/compiler/frontend/bs_ast_mapper.ml @@ -539,9 +539,9 @@ let default_mapper = ~attrs:(this.attributes this pld_attributes)); cases = (fun this l -> List.map (this.case this) l); case = - (fun this {pc_bar; pc_lhs; pc_guard; pc_rhs} -> + (fun this {pc_loc; pc_lhs; pc_guard; pc_rhs} -> { - pc_bar; + pc_loc = this.location this pc_loc; pc_lhs = this.pat this pc_lhs; pc_guard = map_opt (this.expr this) pc_guard; pc_rhs = this.expr this pc_rhs; diff --git a/compiler/frontend/bs_builtin_ppx.ml b/compiler/frontend/bs_builtin_ppx.ml index e6be7e6247..f36028eb34 100644 --- a/compiler/frontend/bs_builtin_ppx.ml +++ b/compiler/frontend/bs_builtin_ppx.ml @@ -167,7 +167,15 @@ let expr_mapper ~async_context ~in_function_def (self : mapper) pexp_desc = Pexp_match ( pvb_expr, - [{pc_bar = None; pc_lhs = p; pc_guard = None; pc_rhs = body}] ); + [ + { + pc_loc = + {p.ppat_loc with Location.loc_end = body.pexp_loc.loc_end}; + pc_lhs = p; + pc_guard = None; + pc_rhs = body; + }; + ] ); pexp_attributes = e.pexp_attributes @ pvb_attributes; }) (* let [@warning "a"] {a;b} = c in body diff --git a/compiler/ml/ast_helper.ml b/compiler/ml/ast_helper.ml index 347b5b5e0d..f10dcb6a9f 100644 --- a/compiler/ml/ast_helper.ml +++ b/compiler/ml/ast_helper.ml @@ -208,8 +208,8 @@ module Exp = struct jsx_container_element_closing_tag = e; })) - let case ?bar lhs ?guard rhs = - {pc_bar = bar; pc_lhs = lhs; pc_guard = guard; pc_rhs = rhs} + let case loc lhs ?guard rhs = + {pc_loc = loc; pc_lhs = lhs; pc_guard = guard; pc_rhs = rhs} let make_list_expression loc seq ext_opt = let rec handle_seq = function diff --git a/compiler/ml/ast_helper.mli b/compiler/ml/ast_helper.mli index d8cfef1c5e..906e41e88e 100644 --- a/compiler/ml/ast_helper.mli +++ b/compiler/ml/ast_helper.mli @@ -231,8 +231,7 @@ module Exp : sig Parsetree.jsx_closing_container_tag option -> expression - val case : - ?bar:Lexing.position -> pattern -> ?guard:expression -> expression -> case + val case : Location.t -> pattern -> ?guard:expression -> expression -> case val await : ?loc:loc -> ?attrs:attrs -> expression -> expression val make_list_expression : diff --git a/compiler/ml/ast_mapper.ml b/compiler/ml/ast_mapper.ml index ba678c1a85..83c45b476e 100644 --- a/compiler/ml/ast_mapper.ml +++ b/compiler/ml/ast_mapper.ml @@ -488,9 +488,9 @@ let default_mapper = ~attrs:(this.attributes this pld_attributes)); cases = (fun this l -> List.map (this.case this) l); case = - (fun this {pc_bar; pc_lhs; pc_guard; pc_rhs} -> + (fun this {pc_loc; pc_lhs; pc_guard; pc_rhs} -> { - pc_bar; + pc_loc = this.location this pc_loc; pc_lhs = this.pat this pc_lhs; pc_guard = map_opt (this.expr this) pc_guard; pc_rhs = this.expr this pc_rhs; diff --git a/compiler/ml/ast_mapper_from0.ml b/compiler/ml/ast_mapper_from0.ml index 959ef18690..5a31645a0d 100644 --- a/compiler/ml/ast_mapper_from0.ml +++ b/compiler/ml/ast_mapper_from0.ml @@ -665,7 +665,9 @@ let default_mapper = case = (fun this {pc_lhs; pc_guard; pc_rhs} -> { - pc_bar = None; + pc_loc = + this.location this + {pc_lhs.ppat_loc with Location.loc_end = pc_rhs.pexp_loc.loc_end}; pc_lhs = this.pat this pc_lhs; pc_guard = map_opt (this.expr this) pc_guard; pc_rhs = this.expr this pc_rhs; diff --git a/compiler/ml/parsetree.ml b/compiler/ml/parsetree.ml index 1fefea4a2d..811ae6f83e 100644 --- a/compiler/ml/parsetree.ml +++ b/compiler/ml/parsetree.ml @@ -381,7 +381,7 @@ and jsx_closing_container_tag = { and case = { (* (P -> E) or (P when E0 -> E) *) - pc_bar: Lexing.position option; + pc_loc: Location.t; pc_lhs: pattern; pc_guard: expression option; pc_rhs: expression; diff --git a/compiler/ml/printast.ml b/compiler/ml/printast.ml index ded0cfd35b..02d0833ffb 100644 --- a/compiler/ml/printast.ml +++ b/compiler/ml/printast.ml @@ -681,10 +681,8 @@ and longident_x_pattern i ppf (li, p, opt) = line i ppf "%a%s\n" fmt_longident_loc li (if opt then "?" else ""); pattern (i + 1) ppf p -and case i ppf {pc_bar; pc_lhs; pc_guard; pc_rhs} = - line i ppf "\n"; - pc_bar - |> Option.iter (fun bar -> line i ppf "| %a\n" (fmt_position false) bar); +and case i ppf {pc_loc; pc_lhs; pc_guard; pc_rhs} = + line i ppf " %a\n" fmt_location pc_loc; pattern (i + 1) ppf pc_lhs; (match pc_guard with | None -> () diff --git a/compiler/ml/typecore.ml b/compiler/ml/typecore.ml index 6f668b5908..4363a4c05b 100644 --- a/compiler/ml/typecore.ml +++ b/compiler/ml/typecore.ml @@ -2371,7 +2371,14 @@ and type_expect_ ?type_clash_context ?in_function ?(recarg = Rejected) env sexp type_expect ?in_function env { sexp with - pexp_desc = Pexp_match (sval, [Ast_helper.Exp.case spat sbody]); + pexp_desc = + Pexp_match + ( sval, + [ + Ast_helper.Exp.case + {spat.ppat_loc with Location.loc_end = sbody.pexp_loc.loc_end} + spat sbody; + ] ); } ty_expected | Pexp_let (rec_flag, spat_sexp_list, sbody) -> @@ -2414,12 +2421,12 @@ and type_expect_ ?type_clash_context ?in_function ?(recarg = Rejected) env sexp let default_loc = default.pexp_loc in let scases = [ - Exp.case + Exp.case default_loc (Pat.construct ~loc:default_loc (mknoloc Longident.(Ldot (Lident "*predef*", "Some"))) (Some (Pat.var ~loc:default_loc (mknoloc "*sth*")))) (Exp.ident ~loc:default_loc (mknoloc (Longident.Lident "*sth*"))); - Exp.case + Exp.case default_loc (Pat.construct ~loc:default_loc (mknoloc Longident.(Ldot (Lident "*predef*", "None"))) None) @@ -2447,13 +2454,17 @@ and type_expect_ ?type_clash_context ?in_function ?(recarg = Rejected) env sexp in type_function ?in_function ~arity ~async loc sexp.pexp_attributes env ty_expected l - [Exp.case pat body] + [Exp.case sloc pat body] | Pexp_fun {arg_label = l; default = None; lhs = spat; rhs = sbody; arity; async} -> let l = Asttypes.to_noloc l in type_function ?in_function ~arity ~async loc sexp.pexp_attributes env ty_expected l - [Ast_helper.Exp.case spat sbody] + [ + Ast_helper.Exp.case + {spat.ppat_loc with Location.loc_end = sbody.pexp_loc.loc_end} + spat sbody; + ] | Pexp_apply {funct = sfunct; args = sargs; partial} -> assert (sargs <> []); begin_def (); diff --git a/compiler/syntax/src/jsx_v4.ml b/compiler/syntax/src/jsx_v4.ml index febc245f21..396935385a 100644 --- a/compiler/syntax/src/jsx_v4.ml +++ b/compiler/syntax/src/jsx_v4.ml @@ -511,12 +511,12 @@ let vb_match ~expr (name, default, _, alias, loc, _) = (Exp.match_ (Exp.ident {txt = Lident ("__" ^ alias); loc = Location.none}) [ - Exp.case + Exp.case Location.none (Pat.construct (Location.mknoloc @@ Lident "Some") (Some (Pat.var (Location.mknoloc label)))) (Exp.ident (Location.mknoloc @@ Lident label)); - Exp.case + Exp.case Location.none (Pat.construct (Location.mknoloc @@ Lident "None") None) default; ]) diff --git a/compiler/syntax/src/res_core.ml b/compiler/syntax/src/res_core.ml index c9c36496c6..ef0c29c2f4 100644 --- a/compiler/syntax/src/res_core.ml +++ b/compiler/syntax/src/res_core.ml @@ -3431,8 +3431,10 @@ and parse_if_let_expr start_pos p = ~attrs:[if_let_attr; suppress_fragile_match_warning_attr] ~loc condition_expr [ - Ast_helper.Exp.case pattern then_expr; - Ast_helper.Exp.case (Ast_helper.Pat.any ()) else_expr; + Ast_helper.Exp.case + {pattern.ppat_loc with Location.loc_end = loc.loc_end} + pattern then_expr; + Ast_helper.Exp.case else_expr.pexp_loc (Ast_helper.Pat.any ()) else_expr; ] and parse_if_or_if_let_expression p = @@ -3557,7 +3559,8 @@ and parse_pattern_match_case p = let rhs = parse_expr_block p in Parser.end_region p; Parser.eat_breadcrumb p; - Some (Ast_helper.Exp.case ~bar lhs ?guard rhs) + let loc = mk_loc bar rhs.pexp_loc.loc_end in + Some (Ast_helper.Exp.case loc lhs ?guard rhs) | _ -> Parser.end_region p; Parser.eat_breadcrumb p; From c3d058313a4b5f47233a1e1a6aeaa660ec0a3b7b Mon Sep 17 00:00:00 2001 From: nojaf Date: Tue, 29 Apr 2025 14:42:00 +0200 Subject: [PATCH 2/4] WIP, find cursor in broken case --- analysis/src/CompletionBackEndRevamped.ml | 1 + analysis/src/CompletionFrontEndRevamped.ml | 16 ++++--- analysis/src/SharedTypes.ml | 3 ++ compiler/syntax/src/res_driver.ml | 5 ++- compiler/syntax/src/res_recovery.ml | 44 +++++++++++++++++++ ...hCaseCompletions.res_Empty_case_array.snap | 21 ++++----- ...chCaseCompletions.res_Empty_case_bool.snap | 29 ++++-------- ...CaseCompletions.res_Empty_case_record.snap | 20 ++++----- ...CaseCompletions.res_Empty_case_string.snap | 21 ++++----- 9 files changed, 93 insertions(+), 67 deletions(-) create mode 100644 compiler/syntax/src/res_recovery.ml diff --git a/analysis/src/CompletionBackEndRevamped.ml b/analysis/src/CompletionBackEndRevamped.ml index 824dbe6821..a5b8145445 100644 --- a/analysis/src/CompletionBackEndRevamped.ml +++ b/analysis/src/CompletionBackEndRevamped.ml @@ -121,3 +121,4 @@ let processCompletable ~debug ~full ~scope ~env ~pos (dec2, doc, maybeInsertText)) |> List.map mkDecorator | CdecoratorPayload _ -> [] + | Ccase _ -> [] diff --git a/analysis/src/CompletionFrontEndRevamped.ml b/analysis/src/CompletionFrontEndRevamped.ml index 6872cea3da..ae6f1d9bd0 100644 --- a/analysis/src/CompletionFrontEndRevamped.ml +++ b/analysis/src/CompletionFrontEndRevamped.ml @@ -420,16 +420,14 @@ let completionWithParser ~currentFile ~debug ~offset ~path ~posCursor text = if expr.pexp_loc |> Loc.hasPos ~pos:posNoWhite && !result = None then ( setFound (); match expr.pexp_desc with - | Pexp_match (switchExpr, [{pc_lhs = lhsPat}]) + (* | Pexp_match (switchExpr, [{pc_lhs = lhsPat}]) when CompletionPatterns.isPatternHole lhsPat && locHasCursor switchExpr.pexp_loc = false -> - setResult (Cpattern {kind = Empty; typeLoc = switchExpr.pexp_loc}) + setResult (Cpattern {kind = Empty; typeLoc = switchExpr.pexp_loc}) *) | Pexp_match (switchExpr, cases) -> let oldTypeLoc = !currentTypeLoc in currentTypeLoc := Some switchExpr.pexp_loc; - cases - |> List.iter (fun case -> - Ast_iterator.default_iterator.case iterator case); + cases |> List.iter (fun case -> iterator.case iterator case); currentTypeLoc := oldTypeLoc; processed := true | Pexp_extension ({txt = "obj"}, PStr [str_item]) -> @@ -615,6 +613,10 @@ let completionWithParser ~currentFile ~debug ~offset ~path ~posCursor text = | _ -> ()); if not !processed then Ast_iterator.default_iterator.expr iterator expr in + let case (_iterator : Ast_iterator.iterator) (case : Parsetree.case) = + if case.pc_loc |> Loc.hasPos ~pos:posCursor then + setResult (Ccase case.pc_loc) + in let typ (iterator : Ast_iterator.iterator) (core_type : Parsetree.core_type) = if core_type.ptyp_loc |> Loc.hasPos ~pos:posNoWhite then ( found := true; @@ -781,6 +783,7 @@ let completionWithParser ~currentFile ~debug ~offset ~path ~posCursor text = Ast_iterator.default_iterator with attribute; expr; + case; location; module_expr; module_type; @@ -800,7 +803,8 @@ let completionWithParser ~currentFile ~debug ~offset ~path ~posCursor text = Res_driver.parsing_engine.parse_implementation ~for_printer:false in let {Res_driver.parsetree = str} = parser ~filename:currentFile in - iterator.structure iterator str |> ignore; + let tree = Res_recovery.map str in + iterator.structure iterator tree |> ignore; if blankAfterCursor = Some ' ' || blankAfterCursor = Some '\n' then scope := !lastScopeBeforeCursor (* TODO(revamp) Complete any value *) diff --git a/analysis/src/SharedTypes.ml b/analysis/src/SharedTypes.ml index 2a8d6b6bf2..8db6664255 100644 --- a/analysis/src/SharedTypes.ml +++ b/analysis/src/SharedTypes.ml @@ -820,6 +820,7 @@ module CompletableRevamped = struct | CextensionNode of string | Cdecorator of string | CdecoratorPayload of decoratorPayload + | Ccase of Location.t let toString (t : t) = match t with @@ -829,11 +830,13 @@ module CompletableRevamped = struct | CextensionNode _ -> "CextensionNode" | Cdecorator _ -> "Cdecorator" | CdecoratorPayload _ -> "CdecoratorPayload" + | Ccase _ -> "Ccase" let try_loc (t : t) = match t with | Cexpression {typeLoc; _} -> Some typeLoc | Cpattern {typeLoc; _} -> Some typeLoc + | Ccase loc -> Some loc | _ -> None end diff --git a/compiler/syntax/src/res_driver.ml b/compiler/syntax/src/res_driver.ml index 64039e7656..dd5fe7a6da 100644 --- a/compiler/syntax/src/res_driver.ml +++ b/compiler/syntax/src/res_driver.ml @@ -139,8 +139,9 @@ let parse_implementation ?(ignore_parse_errors = false) sourcefile = in if parse_result.invalid then ( Res_diagnostics.print_report parse_result.diagnostics parse_result.source; - if not ignore_parse_errors then exit 1); - parse_result.parsetree + if not ignore_parse_errors then exit 1; + Res_recovery.map parse_result.parsetree) + else parse_result.parsetree [@@raises exit] let parse_interface ?(ignore_parse_errors = false) sourcefile = diff --git a/compiler/syntax/src/res_recovery.ml b/compiler/syntax/src/res_recovery.ml new file mode 100644 index 0000000000..082c7259ad --- /dev/null +++ b/compiler/syntax/src/res_recovery.ml @@ -0,0 +1,44 @@ +let map_expr (mapper : Ast_mapper.mapper) (expr : Parsetree.expression) = + match expr.pexp_desc with + | Pexp_match (e, cases) -> + let mapped_e = mapper.expr mapper e in + let match_end_loc = expr.pexp_loc.loc_end in + + let is_ghost_case case = + let open Parsetree in + case.pc_lhs.ppat_loc.loc_ghost && case.pc_rhs.pexp_loc.loc_ghost + in + + let rec process_cases mapped_cases cases = + match cases with + | [] -> mapped_cases + | [last_case] when is_ghost_case last_case -> + prerr_endline "last case"; + let mapped = + mapper.case mapper + { + last_case with + pc_loc = {last_case.pc_loc with loc_end = match_end_loc}; + } + in + process_cases (mapped :: mapped_cases) [] + | current :: (next :: _ as rest) when is_ghost_case current -> + let mapped = + mapper.case mapper + { + current with + pc_loc = + {current.pc_loc with loc_end = next.pc_lhs.ppat_loc.loc_start}; + } + in + process_cases (mapped :: mapped_cases) rest + | c :: rest -> process_cases (mapper.case mapper c :: mapped_cases) rest + in + + let adjusted_cases = process_cases [] cases in + {expr with pexp_desc = Pexp_match (mapped_e, adjusted_cases)} + | _ -> Ast_mapper.default_mapper.expr mapper expr + +let map (tree : Parsetree.structure) = + let mapper = {Ast_mapper.default_mapper with expr = map_expr} in + mapper.structure mapper tree diff --git a/tests/analysis_new_tests/tests/test_files/__snapshots__/SwitchCaseCompletions.res_Empty_case_array.snap b/tests/analysis_new_tests/tests/test_files/__snapshots__/SwitchCaseCompletions.res_Empty_case_array.snap index e76e288750..7410ac3da1 100644 --- a/tests/analysis_new_tests/tests/test_files/__snapshots__/SwitchCaseCompletions.res_Empty_case_array.snap +++ b/tests/analysis_new_tests/tests/test_files/__snapshots__/SwitchCaseCompletions.res_Empty_case_array.snap @@ -1,20 +1,15 @@ -Found Completable: Cpattern at type loc: [3:15->3:28] +case _ vamp [4:2->6:1], has cursor true +Found Completable: Ccase - 2 │ let someStringArr = ["hello"] 3 │ 4 │ let x = switch someStringArr { - │ ‾‾‾‾‾‾‾‾‾‾‾‾‾ 5 │ | + │ ‾‾ 6 │ // ^com + │ ‾‾‾‾‾‾‾‾ + 7 │ } + │ ‾ + 8 │ -[{ - "label": "[]", - "kind": 12, - "tags": [], - "detail": "array", - "documentation": null, - "sortText": "A", - "insertText": "[$0]", - "insertTextFormat": 2 - }] +[] diff --git a/tests/analysis_new_tests/tests/test_files/__snapshots__/SwitchCaseCompletions.res_Empty_case_bool.snap b/tests/analysis_new_tests/tests/test_files/__snapshots__/SwitchCaseCompletions.res_Empty_case_bool.snap index 0426088d9e..7f1ec08d6f 100644 --- a/tests/analysis_new_tests/tests/test_files/__snapshots__/SwitchCaseCompletions.res_Empty_case_bool.snap +++ b/tests/analysis_new_tests/tests/test_files/__snapshots__/SwitchCaseCompletions.res_Empty_case_bool.snap @@ -1,28 +1,15 @@ -Found Completable: Cpattern at type loc: [1:15->1:19] +case _ vamp [2:2->4:1], has cursor true +Found Completable: Ccase 1 │ // Empty case, bool 2 │ let x = switch true { - │ ‾‾‾‾ 3 │ | + │ ‾‾ 4 │ // ^com + │ ‾‾‾‾‾‾‾‾ + 5 │ } + │ ‾ + 6 │ -[{ - "label": "true", - "kind": 12, - "tags": [], - "detail": "bool", - "documentation": null, - "sortText": "A", - "insertText": "true", - "insertTextFormat": 2 - }, { - "label": "false", - "kind": 12, - "tags": [], - "detail": "bool", - "documentation": null, - "sortText": "A", - "insertText": "false", - "insertTextFormat": 2 - }] +[] diff --git a/tests/analysis_new_tests/tests/test_files/__snapshots__/SwitchCaseCompletions.res_Empty_case_record.snap b/tests/analysis_new_tests/tests/test_files/__snapshots__/SwitchCaseCompletions.res_Empty_case_record.snap index 2cc62fd712..4e905e4f9f 100644 --- a/tests/analysis_new_tests/tests/test_files/__snapshots__/SwitchCaseCompletions.res_Empty_case_record.snap +++ b/tests/analysis_new_tests/tests/test_files/__snapshots__/SwitchCaseCompletions.res_Empty_case_record.snap @@ -1,19 +1,15 @@ -Found Completable: Cpattern at type loc: [1:15->1:44] +case _ vamp [2:2->4:1], has cursor true +Found Completable: Ccase 1 │ // Empty case, record 2 │ let x = switch TestTypeDefs.nestedTestRecord { - │ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾ 3 │ | + │ ‾‾ 4 │ // ^com + │ ‾‾‾‾‾‾‾‾ + 5 │ } + │ ‾ + 6 │ -[{ - "label": "{}", - "kind": 12, - "tags": [], - "detail": "TestTypeDefs.nestedTestRecord", - "documentation": {"kind": "markdown", "value": "```rescript\ntype nestedTestRecord = {\n test: bool,\n nested: {name: string, oneMoreLevel: {here: bool}},\n}\n```"}, - "sortText": "A", - "insertText": "{$0}", - "insertTextFormat": 2 - }] +[] diff --git a/tests/analysis_new_tests/tests/test_files/__snapshots__/SwitchCaseCompletions.res_Empty_case_string.snap b/tests/analysis_new_tests/tests/test_files/__snapshots__/SwitchCaseCompletions.res_Empty_case_string.snap index 3a248ce44c..88c9864479 100644 --- a/tests/analysis_new_tests/tests/test_files/__snapshots__/SwitchCaseCompletions.res_Empty_case_string.snap +++ b/tests/analysis_new_tests/tests/test_files/__snapshots__/SwitchCaseCompletions.res_Empty_case_string.snap @@ -1,20 +1,15 @@ -Found Completable: Cpattern at type loc: [2:15->2:18] +case _ vamp [3:2->5:1], has cursor true +Found Completable: Ccase - 1 │ // Empty case, string 2 │ let str = "hello" 3 │ let x = switch str { - │ ‾‾‾ 4 │ | + │ ‾‾ 5 │ // ^com + │ ‾‾‾‾‾‾‾‾ + 6 │ } + │ ‾ + 7 │ -[{ - "label": "\"\"", - "kind": 12, - "tags": [], - "detail": "string", - "documentation": null, - "sortText": "A", - "insertText": "\"$0\"", - "insertTextFormat": 2 - }] +[] From 456d122a258ad0cf51a7397ac8aac5538734d373 Mon Sep 17 00:00:00 2001 From: nojaf Date: Thu, 1 May 2025 18:10:57 +0200 Subject: [PATCH 3/4] Use empty pattern as target node in completion frontend. --- analysis/src/CompletionFrontEndRevamped.ml | 13 ++++++------- compiler/syntax/src/res_recovery.ml | 12 ++++++++---- 2 files changed, 14 insertions(+), 11 deletions(-) diff --git a/analysis/src/CompletionFrontEndRevamped.ml b/analysis/src/CompletionFrontEndRevamped.ml index ae6f1d9bd0..1d827dfe96 100644 --- a/analysis/src/CompletionFrontEndRevamped.ml +++ b/analysis/src/CompletionFrontEndRevamped.ml @@ -427,7 +427,9 @@ let completionWithParser ~currentFile ~debug ~offset ~path ~posCursor text = | Pexp_match (switchExpr, cases) -> let oldTypeLoc = !currentTypeLoc in currentTypeLoc := Some switchExpr.pexp_loc; - cases |> List.iter (fun case -> iterator.case iterator case); + cases + |> List.iter (fun case -> + Ast_iterator.default_iterator.case iterator case); currentTypeLoc := oldTypeLoc; processed := true | Pexp_extension ({txt = "obj"}, PStr [str_item]) -> @@ -613,10 +615,6 @@ let completionWithParser ~currentFile ~debug ~offset ~path ~posCursor text = | _ -> ()); if not !processed then Ast_iterator.default_iterator.expr iterator expr in - let case (_iterator : Ast_iterator.iterator) (case : Parsetree.case) = - if case.pc_loc |> Loc.hasPos ~pos:posCursor then - setResult (Ccase case.pc_loc) - in let typ (iterator : Ast_iterator.iterator) (core_type : Parsetree.core_type) = if core_type.ptyp_loc |> Loc.hasPos ~pos:posNoWhite then ( found := true; @@ -709,7 +707,9 @@ let completionWithParser ~currentFile ~debug ~offset ~path ~posCursor text = in (* TODO(revamp) Complete *) () - | _ -> ()); + | _ -> + if CompletionPatterns.isPatternHole pat then + setResult (Cpattern {kind = Empty; typeLoc = pat.ppat_loc})); Ast_iterator.default_iterator.pat iterator pat) in let module_expr (iterator : Ast_iterator.iterator) @@ -783,7 +783,6 @@ let completionWithParser ~currentFile ~debug ~offset ~path ~posCursor text = Ast_iterator.default_iterator with attribute; expr; - case; location; module_expr; module_type; diff --git a/compiler/syntax/src/res_recovery.ml b/compiler/syntax/src/res_recovery.ml index 082c7259ad..56f6de2ff3 100644 --- a/compiler/syntax/src/res_recovery.ml +++ b/compiler/syntax/src/res_recovery.ml @@ -13,22 +13,26 @@ let map_expr (mapper : Ast_mapper.mapper) (expr : Parsetree.expression) = match cases with | [] -> mapped_cases | [last_case] when is_ghost_case last_case -> - prerr_endline "last case"; + let loc = {last_case.pc_loc with loc_end = match_end_loc} in let mapped = mapper.case mapper { last_case with - pc_loc = {last_case.pc_loc with loc_end = match_end_loc}; + pc_loc = loc; + pc_lhs = mapper.pat mapper {last_case.pc_lhs with ppat_loc = loc}; } in process_cases (mapped :: mapped_cases) [] | current :: (next :: _ as rest) when is_ghost_case current -> + let loc = + {current.pc_loc with loc_end = next.pc_lhs.ppat_loc.loc_start} + in let mapped = mapper.case mapper { current with - pc_loc = - {current.pc_loc with loc_end = next.pc_lhs.ppat_loc.loc_start}; + pc_loc = loc; + pc_lhs = mapper.pat mapper {current.pc_lhs with ppat_loc = loc}; } in process_cases (mapped :: mapped_cases) rest From 0ca5363f77358237e3b1596d4615ca7952ee2f42 Mon Sep 17 00:00:00 2001 From: nojaf Date: Thu, 1 May 2025 18:29:14 +0200 Subject: [PATCH 4/4] Add dedicated Ppat_hole node --- analysis/src/CompletionFrontEnd.ml | 1 + analysis/src/CompletionFrontEndRevamped.ml | 5 ++--- analysis/src/CompletionPatterns.ml | 2 +- compiler/frontend/bs_ast_mapper.ml | 1 + compiler/ml/ast_helper.ml | 1 + compiler/ml/ast_helper.mli | 1 + compiler/ml/ast_iterator.ml | 1 + compiler/ml/ast_mapper.ml | 1 + compiler/ml/ast_mapper_to0.ml | 3 +++ compiler/ml/depend.ml | 1 + compiler/ml/parsetree.ml | 4 ++-- compiler/ml/printast.ml | 1 + compiler/ml/typecore.ml | 4 +++- compiler/syntax/src/res_ast_debugger.ml | 1 + compiler/syntax/src/res_core.ml | 4 +--- compiler/syntax/src/res_printer.ml | 1 + 16 files changed, 22 insertions(+), 10 deletions(-) diff --git a/analysis/src/CompletionFrontEnd.ml b/analysis/src/CompletionFrontEnd.ml index e2d4a51f46..63d9ccda8e 100644 --- a/analysis/src/CompletionFrontEnd.ml +++ b/analysis/src/CompletionFrontEnd.ml @@ -543,6 +543,7 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor | Ppat_exception p -> scopePattern ~patternPath ?contextPath p | Ppat_extension _ -> () | Ppat_open (_, p) -> scopePattern ~patternPath ?contextPath p + | Ppat_hole -> () in let locHasCursor = CursorPosition.locHasCursor ~pos:posBeforeCursor in let locIsEmpty = CursorPosition.locIsEmpty ~pos:posBeforeCursor in diff --git a/analysis/src/CompletionFrontEndRevamped.ml b/analysis/src/CompletionFrontEndRevamped.ml index 1d827dfe96..43d8a450a5 100644 --- a/analysis/src/CompletionFrontEndRevamped.ml +++ b/analysis/src/CompletionFrontEndRevamped.ml @@ -707,9 +707,8 @@ let completionWithParser ~currentFile ~debug ~offset ~path ~posCursor text = in (* TODO(revamp) Complete *) () - | _ -> - if CompletionPatterns.isPatternHole pat then - setResult (Cpattern {kind = Empty; typeLoc = pat.ppat_loc})); + | Ppat_hole -> setResult (Cpattern {kind = Empty; typeLoc = pat.ppat_loc}) + | _ -> ()); Ast_iterator.default_iterator.pat iterator pat) in let module_expr (iterator : Ast_iterator.iterator) diff --git a/analysis/src/CompletionPatterns.ml b/analysis/src/CompletionPatterns.ml index c7d4e1646e..a6c1528ecd 100644 --- a/analysis/src/CompletionPatterns.ml +++ b/analysis/src/CompletionPatterns.ml @@ -2,7 +2,7 @@ open SharedTypes let isPatternHole pat = match pat.Parsetree.ppat_desc with - | Ppat_extension ({txt = "rescript.patternhole"}, _) -> true + | Ppat_hole -> true | _ -> false let isPatternTuple pat = diff --git a/compiler/frontend/bs_ast_mapper.ml b/compiler/frontend/bs_ast_mapper.ml index 11ce8b192e..e4f1010aa1 100644 --- a/compiler/frontend/bs_ast_mapper.ml +++ b/compiler/frontend/bs_ast_mapper.ml @@ -439,6 +439,7 @@ module P = struct | Ppat_open (lid, p) -> open_ ~loc ~attrs (map_loc sub lid) (sub.pat sub p) | Ppat_exception p -> exception_ ~loc ~attrs (sub.pat sub p) | Ppat_extension x -> extension ~loc ~attrs (sub.extension sub x) + | Ppat_hole -> hole ~loc ~attrs () end (* Now, a generic AST mapper, to be extended to cover all kinds and diff --git a/compiler/ml/ast_helper.ml b/compiler/ml/ast_helper.ml index f10dcb6a9f..5c58d07e08 100644 --- a/compiler/ml/ast_helper.ml +++ b/compiler/ml/ast_helper.ml @@ -141,6 +141,7 @@ module Pat = struct let open_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_open (a, b)) let exception_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_exception a) let extension ?loc ?attrs a = mk ?loc ?attrs (Ppat_extension a) + let hole ?loc ?attrs () = mk ?loc ?attrs Ppat_hole end module Exp = struct diff --git a/compiler/ml/ast_helper.mli b/compiler/ml/ast_helper.mli index 906e41e88e..f39f912004 100644 --- a/compiler/ml/ast_helper.mli +++ b/compiler/ml/ast_helper.mli @@ -119,6 +119,7 @@ module Pat : sig val open_ : ?loc:loc -> ?attrs:attrs -> lid -> pattern -> pattern val exception_ : ?loc:loc -> ?attrs:attrs -> pattern -> pattern val extension : ?loc:loc -> ?attrs:attrs -> extension -> pattern + val hole : ?loc:loc -> ?attrs:attrs -> unit -> pattern end (** Expressions *) diff --git a/compiler/ml/ast_iterator.ml b/compiler/ml/ast_iterator.ml index 9790cfc839..b1043c85af 100644 --- a/compiler/ml/ast_iterator.ml +++ b/compiler/ml/ast_iterator.ml @@ -414,6 +414,7 @@ module P = struct | Ppat_open (lid, p) -> iter_loc sub lid; sub.pat sub p + | Ppat_hole -> () end (* Now, a generic AST mapper, to be extended to cover all kinds and diff --git a/compiler/ml/ast_mapper.ml b/compiler/ml/ast_mapper.ml index 83c45b476e..e5c6b1bd98 100644 --- a/compiler/ml/ast_mapper.ml +++ b/compiler/ml/ast_mapper.ml @@ -403,6 +403,7 @@ module P = struct | Ppat_open (lid, p) -> open_ ~loc ~attrs (map_loc sub lid) (sub.pat sub p) | Ppat_exception p -> exception_ ~loc ~attrs (sub.pat sub p) | Ppat_extension x -> extension ~loc ~attrs (sub.extension sub x) + | Ppat_hole -> hole ~loc ~attrs () end (* Now, a generic AST mapper, to be extended to cover all kinds and diff --git a/compiler/ml/ast_mapper_to0.ml b/compiler/ml/ast_mapper_to0.ml index 0f5494bb23..04b0de2904 100644 --- a/compiler/ml/ast_mapper_to0.ml +++ b/compiler/ml/ast_mapper_to0.ml @@ -573,6 +573,9 @@ module P = struct | Ppat_open (lid, p) -> open_ ~loc ~attrs (map_loc sub lid) (sub.pat sub p) | Ppat_exception p -> exception_ ~loc ~attrs (sub.pat sub p) | Ppat_extension x -> extension ~loc ~attrs (sub.extension sub x) + | Ppat_hole -> + let id = Location.mknoloc "rescript.patternhole" in + extension (id, PStr []) end (* Now, a generic AST mapper, to be extended to cover all kinds and diff --git a/compiler/ml/depend.ml b/compiler/ml/depend.ml index ea3c71b947..64bac8bb2e 100644 --- a/compiler/ml/depend.ml +++ b/compiler/ml/depend.ml @@ -205,6 +205,7 @@ let rec add_pattern bv pat = add_pattern bv p | Ppat_exception p -> add_pattern bv p | Ppat_extension e -> handle_extension e + | Ppat_hole -> () let add_pattern bv pat = pattern_bv := bv; diff --git a/compiler/ml/parsetree.ml b/compiler/ml/parsetree.ml index 811ae6f83e..0908087fc7 100644 --- a/compiler/ml/parsetree.ml +++ b/compiler/ml/parsetree.ml @@ -202,10 +202,10 @@ and pattern_desc = | Ppat_exception of pattern (* exception P *) | Ppat_extension of extension (* [%id] *) | Ppat_open of Longident.t loc * pattern -(* M.(P) *) + (* M.(P) *) + | Ppat_hole (* Value expressions *) - and expression = { pexp_desc: expression_desc; pexp_loc: Location.t; diff --git a/compiler/ml/printast.ml b/compiler/ml/printast.ml index 02d0833ffb..631282da26 100644 --- a/compiler/ml/printast.ml +++ b/compiler/ml/printast.ml @@ -227,6 +227,7 @@ and pattern i ppf x = | Ppat_extension (s, arg) -> line i ppf "Ppat_extension \"%s\"\n" s.txt; payload i ppf arg + | Ppat_hole -> line i ppf "Ppat_hole\n" and expression i ppf x = line i ppf "expression %a\n" fmt_location x.pexp_loc; diff --git a/compiler/ml/typecore.ml b/compiler/ml/typecore.ml index 4363a4c05b..8104387ea9 100644 --- a/compiler/ml/typecore.ml +++ b/compiler/ml/typecore.ml @@ -1727,6 +1727,7 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp raise (Error (loc, !env, Exception_pattern_below_toplevel)) | Ppat_extension ext -> raise (Error_forward (Builtin_attributes.error_of_extension ext)) + | Ppat_hole -> failwith "Ppat_hole" let type_pat ?(allow_existentials = false) ?constrs ?labels ?(mode = Normal) ?(explode = 0) ?(lev = get_current_level ()) env sp expected_ty = @@ -2097,7 +2098,7 @@ let contains_variant_either ty = let iter_ppat f p = match p.ppat_desc with | Ppat_any | Ppat_var _ | Ppat_constant _ | Ppat_interval _ | Ppat_extension _ - | Ppat_type _ | Ppat_unpack _ -> + | Ppat_type _ | Ppat_unpack _ | Ppat_hole -> () | Ppat_array pats -> List.iter f pats | Ppat_or (p1, p2) -> @@ -3858,6 +3859,7 @@ and type_statement env sexp = exp (* Typing of match cases *) +(* TODO: if we have Ppat_hole we can probably just return the type of the match expression? *) and type_cases ?root_type_clash_context ?in_function env ty_arg ty_res partial_flag loc caselist : _ * Typedtree.partial = diff --git a/compiler/syntax/src/res_ast_debugger.ml b/compiler/syntax/src/res_ast_debugger.ml index 70f1e298bf..0686148d3c 100644 --- a/compiler/syntax/src/res_ast_debugger.ml +++ b/compiler/syntax/src/res_ast_debugger.ml @@ -831,6 +831,7 @@ module SexpAst = struct longident longident_loc.Location.txt; pattern p; ] + | Ppat_hole -> Sexp.atom "Ppat_hole" in Sexp.list [Sexp.atom "pattern"; descr] diff --git a/compiler/syntax/src/res_core.ml b/compiler/syntax/src/res_core.ml index ef0c29c2f4..c469bcdf27 100644 --- a/compiler/syntax/src/res_core.ml +++ b/compiler/syntax/src/res_core.ml @@ -25,9 +25,7 @@ module Recover = struct let id = Location.mknoloc "rescript.typehole" in Ast_helper.Typ.extension (id, PStr []) - let default_pattern () = - let id = Location.mknoloc "rescript.patternhole" in - Ast_helper.Pat.extension (id, PStr []) + let default_pattern () = Ast_helper.Pat.hole () let default_module_expr () = Ast_helper.Mod.structure [] let default_module_type () = Ast_helper.Mty.signature [] diff --git a/compiler/syntax/src/res_printer.ml b/compiler/syntax/src/res_printer.ml index 5b2a176068..78965ab7ea 100644 --- a/compiler/syntax/src/res_printer.ml +++ b/compiler/syntax/src/res_printer.ml @@ -2586,6 +2586,7 @@ and print_pattern ~state (p : Parsetree.pattern) cmt_tbl = | Ppat_interval (a, b) -> Doc.concat [print_constant a; Doc.text " .. "; print_constant b] | Ppat_open _ -> Doc.nil + | Ppat_hole -> Doc.nil in let doc = match p.ppat_attributes with