Recovery in completions

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 =

analysis/src/CompletionBackEndRevamped.ml

@@ -121,3 +121,4 @@ let processCompletable ~debug ~full ~scope ~env ~pos
            (dec2, doc, maybeInsertText))
     |> List.map mkDecorator
   | CdecoratorPayload _ -> []
+  | Ccase _ -> []

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

analysis/src/CompletionFrontEndRevamped.ml

@@ -420,10 +420,10 @@ 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;
@@ -707,6 +707,7 @@ let completionWithParser ~currentFile ~debug ~offset ~path ~posCursor text =
         in
         (* TODO(revamp) Complete *)
         ()
+      | Ppat_hole -> setResult (Cpattern {kind = Empty; typeLoc = pat.ppat_loc})
       | _ -> ());
       Ast_iterator.default_iterator.pat iterator pat)
   in
@@ -800,7 +801,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 *)

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 =

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
 

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 =

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

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
@@ -539,9 +540,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;

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

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
@@ -208,8 +209,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

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 *)
@@ -231,8 +232,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 :

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

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
@@ -488,9 +489,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;

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;

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

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;

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;
@@ -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;

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;
@@ -681,10 +682,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 "<case>\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 "<case> %a\n" fmt_location pc_loc;
   pattern (i + 1) ppf pc_lhs;
   (match pc_guard with
   | None -> ()

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) ->
@@ -2371,7 +2372,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 +2422,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 +2455,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 ();
@@ -3847,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 =

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;
            ])

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]