From 0f371cc3e7de0cdd20c9e6794ee47c915fa8e783 Mon Sep 17 00:00:00 2001 From: Liam Stevenson Date: Thu, 16 Jan 2025 17:39:45 -0500 Subject: [PATCH] Rename Texp_hole to Texp_typed_hole --- src/analysis/tail_analysis.ml | 2 +- src/frontend/query_commands.ml | 2 +- src/ocaml/merlin_specific/browse_raw.ml | 4 ++-- src/ocaml/typing/cmt_format.ml | 2 +- src/ocaml/typing/printtyped.ml | 4 ++-- src/ocaml/typing/tast_iterator.ml | 2 +- src/ocaml/typing/tast_mapper.ml | 4 ++-- src/ocaml/typing/typecore.ml | 6 +++--- src/ocaml/typing/typedtree.ml | 2 +- src/ocaml/typing/typedtree.mli | 2 +- src/ocaml/typing/untypeast.ml | 2 +- src/ocaml/typing/value_rec_check.ml | 4 ++-- 12 files changed, 18 insertions(+), 18 deletions(-) diff --git a/src/analysis/tail_analysis.ml b/src/analysis/tail_analysis.ml index 3f9ee77d6..091a2b4b3 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/frontend/query_commands.ml b/src/frontend/query_commands.ml index c1c12ff46..207e41593 100644 --- a/src/frontend/query_commands.ml +++ b/src/frontend/query_commands.ml @@ -631,7 +631,7 @@ let dispatch pipeline (type a) : a Query_protocol.t -> a = function :: _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 a9d5cbc1e..a64643503 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 @@ -933,7 +933,7 @@ 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; _ } -> + | 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_hole; mod_loc; mod_type; mod_env; _ } -> (mod_loc, mod_env, `Mod mod_type) :: acc diff --git a/src/ocaml/typing/cmt_format.ml b/src/ocaml/typing/cmt_format.ml index dda3dcbfb..03ca1346b 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 diff --git a/src/ocaml/typing/printtyped.ml b/src/ocaml/typing/printtyped.ml index b60920e97..1eb2edd2d 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 diff --git a/src/ocaml/typing/tast_iterator.ml b/src/ocaml/typing/tast_iterator.ml index a77402de0..46501dfb6 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; _} = diff --git a/src/ocaml/typing/tast_mapper.ml b/src/ocaml/typing/tast_mapper.ml index ea8af17a5..9a5f51a45 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} diff --git a/src/ocaml/typing/typecore.ml b/src/ocaml/typing/typecore.ml index 4fe27d140..609814609 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 @@ -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 90baca5fb..976cb55c0 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 diff --git a/src/ocaml/typing/typedtree.mli b/src/ocaml/typing/typedtree.mli index 13a197b7a..9aff88191 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 diff --git a/src/ocaml/typing/untypeast.ml b/src/ocaml/typing/untypeast.ml index a5e0741ac..5ff513658 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 diff --git a/src/ocaml/typing/value_rec_check.ml b/src/ocaml/typing/value_rec_check.ml index 985e42a63..08538b1a9 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 @@ -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