diff --git a/.github/workflows/ocaml-lsp-compat.yml b/.github/workflows/ocaml-lsp-compat.yml index 865f795435..da3d0fda74 100644 --- a/.github/workflows/ocaml-lsp-compat.yml +++ b/.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 diff --git a/CHANGES.md b/CHANGES.md index 1322fe29b2..e38c3afe97 100644 --- a/CHANGES.md +++ b/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 diff --git a/src/analysis/tail_analysis.ml b/src/analysis/tail_analysis.ml index 3f9ee77d6b..091a2b4b37 100644 --- a/src/analysis/tail_analysis.ml +++ b/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) diff --git a/src/analysis/typed_hole.ml b/src/analysis/typed_hole.ml new file mode 100644 index 0000000000..d71bd893c0 --- /dev/null +++ b/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 +;; diff --git a/src/analysis/typed_hole.mli b/src/analysis/typed_hole.mli new file mode 100644 index 0000000000..ff44c7871f --- /dev/null +++ b/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 diff --git a/src/frontend/query_commands.ml b/src/frontend/query_commands.ml index c1c12ff464..be1ca4d2f9 100644 --- a/src/frontend/query_commands.ml +++ b/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) diff --git a/src/ocaml/merlin_specific/browse_raw.ml b/src/ocaml/merlin_specific/browse_raw.ml index a9d5cbc1e4..3110122d9c 100644 --- a/src/ocaml/merlin_specific/browse_raw.ml +++ b/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 diff --git a/src/ocaml/typing/cmt_format.ml b/src/ocaml/typing/cmt_format.ml index dda3dcbfba..c86ecc24ba 100644 --- a/src/ocaml/typing/cmt_format.ml +++ b/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 = diff --git a/src/ocaml/typing/printtyped.ml b/src/ocaml/typing/printtyped.ml index b60920e970..f71b8db569 100644 --- a/src/ocaml/typing/printtyped.ml +++ b/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; diff --git a/src/ocaml/typing/tast_iterator.ml b/src/ocaml/typing/tast_iterator.ml index a77402de0e..6c1c73ac35 100644 --- a/src/ocaml/typing/tast_iterator.ml +++ b/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) -> diff --git a/src/ocaml/typing/tast_mapper.ml b/src/ocaml/typing/tast_mapper.ml index ea8af17a53..a1a26c11a9 100644 --- a/src/ocaml/typing/tast_mapper.ml +++ b/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) diff --git a/src/ocaml/typing/typecore.ml b/src/ocaml/typing/typecore.ml index 4fe27d1402..527947c045 100644 --- a/src/ocaml/typing/typecore.ml +++ b/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; diff --git a/src/ocaml/typing/typedtree.ml b/src/ocaml/typing/typedtree.ml index 90baca5fb1..1361a8ac55 100644 --- a/src/ocaml/typing/typedtree.ml +++ b/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; diff --git a/src/ocaml/typing/typedtree.mli b/src/ocaml/typing/typedtree.mli index 13a197b7ae..c67a500e9a 100644 --- a/src/ocaml/typing/typedtree.mli +++ b/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; diff --git a/src/ocaml/typing/typemod.ml b/src/ocaml/typing/typemod.ml index d072a10b58..0c00450dc5 100644 --- a/src/ocaml/typing/typemod.ml +++ b/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; diff --git a/src/ocaml/typing/untypeast.ml b/src/ocaml/typing/untypeast.ml index a5e0741ac6..bba3f2d3ed 100644 --- a/src/ocaml/typing/untypeast.ml +++ b/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 diff --git a/src/ocaml/typing/value_rec_check.ml b/src/ocaml/typing/value_rec_check.ml index 985e42a639..39d107549b 100644 --- a/src/ocaml/typing/value_rec_check.ml +++ b/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 *)