Merge pull request #1888 from liam923/rename-holes

Rename `Texp_hole` and `Tmod_hole`

.github/workflows/ocaml-lsp-compat.yml

@@ -51,7 +51,7 @@ jobs:
 
       - name: Check that Merlin and OCaml-LSP are co-installable
         run: |
-          opam --cli=2.1 pin --with-version=dev --no-action https://github.com/voodoos/ocaml-lsp.git#merlin-503-compat
+          opam --cli=2.1 pin --with-version=dev --no-action https://github.com/liam923/ocaml-lsp.git#rename-holes
           opam --cli=2.1 pin --with-version=5.4-503 --no-action .
           opam install ocaml-lsp-server --ignore-constraints-on=ocamlformat
 

CHANGES.md

@@ -1,3 +1,10 @@
+unreleased
+==========
+
+  + merlin library
+    - Expose utilities to manipulate typed-holes in `Merlin_analysis.Typed_hole`
+      (#1888)
+
 merlin 5.4.1
 ============
 Mon Jan 13 10:55:42 CET 2025

src/analysis/tail_analysis.ml

@@ -75,7 +75,7 @@ let expr_tail_positions = function
   | Texp_unreachable
   | Texp_extension_constructor _
   | Texp_letop _
-  | Texp_hole -> []
+  | Texp_typed_hole -> []
   | Texp_match (_, cs, _, _) -> List.map cs ~f:(fun c -> Case c)
   | Texp_try (_, cs, _) -> List.map cs ~f:(fun c -> Case c)
   | Texp_letmodule (_, _, _, _, e)

src/analysis/typed_hole.ml

@@ -0,0 +1,17 @@
+let syntax_repr = "_"
+let can_be_hole s = String.equal syntax_repr s
+
+(* the pattern matching below is taken and modified (minimally, to adapt the
+   return type) from [Query_commands.dispatch]'s [Construct] branch;
+
+   If we directly dispatched [Construct] command to merlin, we'd be doing
+   useless computations: we need info whether the expression at the cursor is a
+   hole, we don't need constructed expressions yet.
+
+   Ideally, merlin should return a callback [option], which is [Some] when the
+   context is applicable. *)
+let is_a_hole = function
+  | (_, Browse_raw.Module_expr { mod_desc = Tmod_typed_hole; _ }) :: (_, _) :: _
+  | (_, Browse_raw.Expression { exp_desc = Texp_typed_hole; _ }) :: _ -> true
+  | [] | (_, _) :: _ -> false
+;;

src/analysis/typed_hole.mli

@@ -0,0 +1,15 @@
+(** This module should be used to work with typed holes. The main goal is to
+    hide syntactic representation of a typed hole, which may change in future *)
+
+(** checks whether the current string matches the syntax representation of a
+    typed hole *)
+val can_be_hole : string -> bool
+
+(** [is_a_hole nodes] checks whether the leaf node [1] is a typed hole
+
+    Note: this function is extracted from merlin sources handling [Construct]
+    command in [merlin/src/frontend/query_commands.ml]
+
+    [1] leaf node is the head of the list, as
+    [Mbrowse.t = (Env.t * Browse_raw.node) list]*)
+val is_a_hole : Mbrowse.t -> bool

src/frontend/query_commands.ml

@@ -626,12 +626,14 @@ let dispatch pipeline (type a) : a Query_protocol.t -> a = function
     let structures = Mbrowse.enclosing pos [ Mbrowse.of_typedtree typedtree ] in
     begin
       match structures with
-      | (_, (Browse_raw.Module_expr { mod_desc = Tmod_hole; _ } as node_for_loc))
+      | ( _,
+          (Browse_raw.Module_expr { mod_desc = Tmod_typed_hole; _ } as
+           node_for_loc) )
         :: (_, node)
         :: _parents ->
         let loc = Mbrowse.node_loc node_for_loc in
         (loc, Construct.node ~config ~keywords ?depth ~values_scope node)
-      | (_, (Browse_raw.Expression { exp_desc = Texp_hole; _ } as node))
+      | (_, (Browse_raw.Expression { exp_desc = Texp_typed_hole; _ } as node))
         :: _parents ->
         let loc = Mbrowse.node_loc node in
         (loc, Construct.node ~config ~keywords ?depth ~values_scope node)

src/ocaml/merlin_specific/browse_raw.ml

@@ -349,7 +349,7 @@ let of_method_call obj meth loc env (f : _ f0) acc =
 let rec of_expression_desc loc = function
   | Texp_ident _ | Texp_constant _ | Texp_instvar _
   | Texp_variant (_, None)
-  | Texp_new _ | Texp_hole -> id_fold
+  | Texp_new _ | Texp_typed_hole -> id_fold
   | Texp_let (_, vbs, e) -> of_expression e ** list_fold of_value_binding vbs
   | Texp_function (params, body) ->
     list_fold of_function_param params ** of_function_body body
@@ -474,7 +474,7 @@ and of_module_expr_desc = function
   | Tmod_constraint (me, _, mtc, _) ->
     of_module_expr me ** app (Module_type_constraint mtc)
   | Tmod_unpack (e, _) -> of_expression e
-  | Tmod_hole -> id_fold
+  | Tmod_typed_hole -> id_fold
 
 and of_structure_item_desc = function
   | Tstr_eval (e, _) -> of_expression e
@@ -933,9 +933,10 @@ let all_holes (env, node) =
   let rec aux acc (env, node) =
     let f env node acc =
       match node with
-      | Expression { exp_desc = Texp_hole; exp_loc; exp_type; exp_env; _ } ->
-        (exp_loc, exp_env, `Exp exp_type) :: acc
-      | Module_expr { mod_desc = Tmod_hole; mod_loc; mod_type; mod_env; _ } ->
+      | Expression { exp_desc = Texp_typed_hole; exp_loc; exp_type; exp_env; _ }
+        -> (exp_loc, exp_env, `Exp exp_type) :: acc
+      | Module_expr
+          { mod_desc = Tmod_typed_hole; mod_loc; mod_type; mod_env; _ } ->
         (mod_loc, mod_env, `Mod mod_type) :: acc
       | _ -> aux acc (env, node)
     in

src/ocaml/typing/cmt_format.ml

@@ -240,7 +240,7 @@ let iter_on_occurrences
       | Texp_send _
       | Texp_letmodule _ | Texp_letexception _ | Texp_assert _ | Texp_lazy _
       | Texp_object _ | Texp_pack _ | Texp_letop _ | Texp_unreachable
-      | Texp_open _ | Texp_hole -> ());
+      | Texp_open _ | Texp_typed_hole -> ());
       default_iterator.expr sub e);
 
   (* Remark: some types get iterated over twice due to how constraints are
@@ -305,7 +305,7 @@ let iter_on_occurrences
       (match mod_desc with
       | Tmod_ident (path, lid) -> f ~namespace:Module mod_env path lid
       | Tmod_structure _ | Tmod_functor _ | Tmod_apply _ | Tmod_apply_unit _
-      | Tmod_constraint _ | Tmod_unpack _ | Tmod_hole -> ());
+      | Tmod_constraint _ | Tmod_unpack _ | Tmod_typed_hole -> ());
       default_iterator.module_expr sub me);
 
   open_description =

src/ocaml/typing/printtyped.ml

@@ -468,8 +468,8 @@ and expression i ppf x =
       module_expr i ppf o.open_expr;
       attributes i ppf o.open_attributes;
       expression i ppf e;
-  | Texp_hole ->
-      line i ppf "Texp_hole"
+  | Texp_typed_hole ->
+      line i ppf "Texp_typed_hole"
 
 and value_description i ppf x =
   line i ppf "value_description %a %a\n" fmt_ident x.val_id fmt_location
@@ -840,7 +840,7 @@ and module_expr i ppf x =
   let i = i+1 in
   match x.mod_desc with
   | Tmod_ident (li,_) -> line i ppf "Tmod_ident %a\n" fmt_path li;
-  | Tmod_hole -> line i ppf "Tmod_hole\n";
+  | Tmod_typed_hole -> line i ppf "Tmod_typed_hole\n";
   | Tmod_structure (s) ->
       line i ppf "Tmod_structure\n";
       structure i ppf s;

src/ocaml/typing/tast_iterator.ml

@@ -387,7 +387,7 @@ let expr sub {exp_loc; exp_extra; exp_desc; exp_env; exp_attributes; _} =
   | Texp_open (od, e) ->
       sub.open_declaration sub od;
       sub.expr sub e
-  | Texp_hole -> ()
+  | Texp_typed_hole -> ()
 
 
 let package_type sub {pack_fields; pack_txt; _} =
@@ -489,7 +489,7 @@ let module_expr sub {mod_loc; mod_desc; mod_env; mod_attributes; _} =
   sub.attributes sub mod_attributes;
   sub.env sub mod_env;
   match mod_desc with
-  | Tmod_hole  -> ()
+  | Tmod_typed_hole  -> ()
   | Tmod_ident (_, lid) -> iter_loc sub lid
   | Tmod_structure st -> sub.structure sub st
   | Tmod_functor (arg, mexpr) ->

src/ocaml/typing/tast_mapper.ml

@@ -493,8 +493,8 @@ let expr sub x =
         Texp_extension_constructor (map_loc sub lid, path)
     | Texp_open (od, e) ->
         Texp_open (sub.open_declaration sub od, sub.expr sub e)
-    | Texp_hole ->
-        Texp_hole
+    | Texp_typed_hole ->
+        Texp_typed_hole
   in
   let exp_attributes = sub.attributes sub x.exp_attributes in
   {x with exp_loc; exp_extra; exp_desc; exp_env; exp_attributes}
@@ -625,7 +625,7 @@ let module_expr sub x =
   let mod_desc =
     match x.mod_desc with
     | Tmod_ident (path, lid) -> Tmod_ident (path, map_loc sub lid)
-    | Tmod_hole -> Tmod_hole
+    | Tmod_typed_hole -> Tmod_typed_hole
     | Tmod_structure st -> Tmod_structure (sub.structure sub st)
     | Tmod_functor (arg, mexpr) ->
         Tmod_functor (functor_parameter sub arg, sub.module_expr sub mexpr)

src/ocaml/typing/typecore.ml

@@ -2721,7 +2721,7 @@ let rec is_nonexpansive exp =
   | Texp_unreachable
   | Texp_function _
   | Texp_array []
-  | Texp_hole -> true
+  | Texp_typed_hole -> true
   | Texp_let(_rec_flag, pat_exp_list, body) ->
       List.for_all (fun vb -> is_nonexpansive vb.vb_expr) pat_exp_list &&
       is_nonexpansive body
@@ -2817,7 +2817,7 @@ and is_nonexpansive_mod mexp =
   match mexp.mod_desc with
   | Tmod_ident _
   | Tmod_functor _
-  | Tmod_hole -> true
+  | Tmod_typed_hole -> true
   | Tmod_unpack (e, _) -> is_nonexpansive e
   | Tmod_constraint (m, _, _, _) -> is_nonexpansive_mod m
   | Tmod_structure str ->
@@ -3117,7 +3117,7 @@ let check_partial_application ~statement exp =
             | Texp_apply _ | Texp_send _ | Texp_new _ | Texp_letop _ ->
                 Location.prerr_warning exp_loc
                   Warnings.Ignored_partial_application
-            | Texp_hole -> ()
+            | Texp_typed_hole -> ()
           end
         in
         check exp
@@ -4589,7 +4589,7 @@ and type_expect_
 
   | Pexp_extension ({ txt; _ } as s, payload) when txt = Ast_helper.hole_txt ->
     let attr = Ast_helper.Attr.mk s payload in
-    re { exp_desc = Texp_hole;
+    re { exp_desc = Texp_typed_hole;
          exp_loc = loc; exp_extra = [];
          exp_type = instance ty_expected;
          exp_attributes = attr :: sexp.pexp_attributes;

src/ocaml/typing/typedtree.ml

@@ -149,7 +149,7 @@ and expression_desc =
   | Texp_unreachable
   | Texp_extension_constructor of Longident.t loc * Path.t
   | Texp_open of open_declaration * expression
-  | Texp_hole
+  | Texp_typed_hole
 
 and meth =
   | Tmeth_name of string
@@ -285,7 +285,7 @@ and module_expr_desc =
   | Tmod_constraint of
       module_expr * Types.module_type * module_type_constraint * module_coercion
   | Tmod_unpack of expression * Types.module_type
-  | Tmod_hole
+  | Tmod_typed_hole
 
 and structure = {
   str_items : structure_item list;

src/ocaml/typing/typedtree.mli

@@ -292,7 +292,7 @@ and expression_desc =
   | Texp_extension_constructor of Longident.t loc * Path.t
   | Texp_open of open_declaration * expression
         (** let open[!] M in e *)
-  | Texp_hole
+  | Texp_typed_hole
 
 and meth =
     Tmeth_name of string
@@ -460,7 +460,7 @@ and module_expr_desc =
         (ME : MT)   (constraint = Tmodtype_explicit MT)
      *)
   | Tmod_unpack of expression * Types.module_type
-  | Tmod_hole
+  | Tmod_typed_hole
 
 and structure = {
   str_items : structure_item list;

src/ocaml/typing/typemod.ml

@@ -1910,7 +1910,7 @@ let rec path_of_module mexp =
   | Tmod_constraint (mexp, _, _, _) ->
       path_of_module mexp
   | (Tmod_structure _ | Tmod_functor _ | Tmod_apply_unit _ | Tmod_unpack _ |
-    Tmod_apply _ | Tmod_hole) ->
+    Tmod_apply _ | Tmod_typed_hole) ->
     raise Not_a_path
 
 let path_of_module mexp =
@@ -2382,7 +2382,7 @@ and type_module_aux ~alias sttn funct_body anchor env smod =
         | Pmod_extension ({ txt; _ }, _) when txt = Ast_helper.hole_txt ->
             Msupport.raise_error exn;
             {
-              mod_desc = Tmod_hole;
+              mod_desc = Tmod_typed_hole;
               mod_type = Mty_for_hole;
               mod_loc = sarg.pmod_loc;
               mod_env = env;
@@ -2424,7 +2424,7 @@ and type_module_aux ~alias sttn funct_body anchor env smod =
         mod_loc = smod.pmod_loc },
       Shape.leaf_for_unpack
   | Pmod_extension ({ txt; _ }, _) when txt = Ast_helper.hole_txt ->
-      { mod_desc = Tmod_hole;
+      { mod_desc = Tmod_typed_hole;
         mod_type = Mty_for_hole;
         mod_env = env;
         mod_attributes = smod.pmod_attributes;

src/ocaml/typing/untypeast.ml

@@ -560,7 +560,7 @@ let expression sub exp =
                              ])
     | Texp_open (od, exp) ->
         Pexp_open (sub.open_declaration sub od, sub.expr sub exp)
-    | Texp_hole ->
+    | Texp_typed_hole ->
         let id = Location.mkloc hole_txt loc in
         Pexp_extension (id, PStr [])
   in
@@ -727,7 +727,7 @@ let module_expr (sub : mapper) mexpr =
           | Tmod_unpack (exp, _pack) ->
               Pmod_unpack (sub.expr sub exp)
               (* TODO , sub.package_type sub pack) *)
-          | Tmod_hole ->
+          | Tmod_typed_hole ->
               let id = Location.mkloc hole_txt loc in
               Pmod_extension (id, PStr [])
         in

src/ocaml/typing/value_rec_check.ml

@@ -242,7 +242,7 @@ let classify_expression : Typedtree.expression -> sd =
     | Texp_letop _ ->
         Dynamic
 
-    | Texp_hole -> Static
+    | Texp_typed_hole -> Static
   and classify_value_bindings rec_flag env bindings =
     (* We use a non-recursive classification, classifying each
         binding with respect to the old environment
@@ -295,7 +295,7 @@ let classify_expression : Typedtree.expression -> sd =
             Dynamic
   and classify_module_expression env mexp : sd =
     match mexp.mod_desc with
-    | Tmod_hole ->
+    | Tmod_typed_hole ->
         Dynamic
     | Tmod_ident (path, _) ->
         classify_path env path
@@ -935,7 +935,7 @@ let rec expression : Typedtree.expression -> term_judg =
           list binding_op (let_ :: ands) << Dereference;
           case_env body << Delay
         ]
-    | Texp_unreachable | Texp_hole ->
+    | Texp_unreachable | Texp_typed_hole ->
       (*
         ----------
         [] |- .: m
@@ -1041,7 +1041,7 @@ and modexp : Typedtree.module_expr -> term_judg =
       coercion coe (fun m -> modexp mexp << m)
     | Tmod_unpack (e, _) ->
       expression e
-    | Tmod_hole -> fun _ -> Env.empty
+    | Tmod_typed_hole -> fun _ -> Env.empty
 
 
 (* G |- pth : m *)