Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Rename Texp_hole and Tmod_hole #1888

Open
wants to merge 4 commits into
base: main
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension


Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion .github/workflows/ocaml-lsp-compat.yml
Original file line number Diff line number Diff line change
Expand Up @@ -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

2 changes: 1 addition & 1 deletion src/analysis/tail_analysis.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
17 changes: 17 additions & 0 deletions src/analysis/typed_hole.ml
Original file line number Diff line number Diff line change
@@ -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
;;
15 changes: 15 additions & 0 deletions src/analysis/typed_hole.mli
Original file line number Diff line number Diff line change
@@ -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
6 changes: 4 additions & 2 deletions src/frontend/query_commands.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
11 changes: 6 additions & 5 deletions src/ocaml/merlin_specific/browse_raw.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
4 changes: 2 additions & 2 deletions src/ocaml/typing/cmt_format.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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 =
Expand Down
6 changes: 3 additions & 3 deletions src/ocaml/typing/printtyped.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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;
Expand Down
4 changes: 2 additions & 2 deletions src/ocaml/typing/tast_iterator.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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; _} =
Expand Down Expand Up @@ -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) ->
Expand Down
6 changes: 3 additions & 3 deletions src/ocaml/typing/tast_mapper.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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}
Expand Down Expand Up @@ -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)
Expand Down
8 changes: 4 additions & 4 deletions src/ocaml/typing/typecore.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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 ->
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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;
Expand Down
4 changes: 2 additions & 2 deletions src/ocaml/typing/typedtree.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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;
Expand Down
4 changes: 2 additions & 2 deletions src/ocaml/typing/typedtree.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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;
Expand Down
6 changes: 3 additions & 3 deletions src/ocaml/typing/typemod.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down Expand Up @@ -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;
Expand Down Expand Up @@ -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;
Expand Down
4 changes: 2 additions & 2 deletions src/ocaml/typing/untypeast.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
8 changes: 4 additions & 4 deletions src/ocaml/typing/value_rec_check.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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 *)
Expand Down
Loading