From 246564e8db0e86f10339bc4a4045835590c3e8b9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Tue, 13 Oct 2020 09:48:16 +0200 Subject: [PATCH] Remove dead code (#9974) --- .depend | 7 +------ typing/typeclass.ml | 2 +- typing/typecore.ml | 49 ++++++++++++++++----------------------------- typing/typecore.mli | 2 -- typing/typemod.ml | 27 +++++++------------------ typing/typemod.mli | 2 +- 6 files changed, 27 insertions(+), 62 deletions(-) diff --git a/.depend b/.depend index f513576db..6ba99fac2 100644 --- a/.depend +++ b/.depend @@ -1215,7 +1215,6 @@ typing/typecore.cmo : \ typing/btype.cmi \ parsing/asttypes.cmi \ parsing/ast_helper.cmi \ - typing/annot.cmi \ typing/typecore.cmi typing/typecore.cmx : \ utils/warnings.cmx \ @@ -1246,7 +1245,6 @@ typing/typecore.cmx : \ typing/btype.cmx \ parsing/asttypes.cmi \ parsing/ast_helper.cmx \ - typing/annot.cmi \ typing/typecore.cmi typing/typecore.cmi : \ typing/types.cmi \ @@ -1258,8 +1256,7 @@ typing/typecore.cmi : \ typing/ident.cmi \ typing/env.cmi \ typing/ctype.cmi \ - parsing/asttypes.cmi \ - typing/annot.cmi + parsing/asttypes.cmi typing/typedecl.cmo : \ utils/warnings.cmi \ typing/typetexp.cmi \ @@ -1519,7 +1516,6 @@ typing/typemod.cmo : \ typing/btype.cmi \ parsing/attr_helper.cmi \ parsing/asttypes.cmi \ - typing/annot.cmi \ typing/typemod.cmi typing/typemod.cmx : \ utils/warnings.cmx \ @@ -1552,7 +1548,6 @@ typing/typemod.cmx : \ typing/btype.cmx \ parsing/attr_helper.cmx \ parsing/asttypes.cmi \ - typing/annot.cmi \ typing/typemod.cmi typing/typemod.cmi : \ typing/types.cmi \ diff --git a/typing/typeclass.ml b/typing/typeclass.ml index dbdbf26e7..04400c53e 100644 --- a/typing/typeclass.ml +++ b/typing/typeclass.ml @@ -1181,7 +1181,7 @@ and class_expr_aux cl_num val_env met_env scl = } | Pcl_let (rec_flag, sdefs, scl') -> let (defs, val_env) = - Typecore.type_let In_class_def val_env rec_flag sdefs None in + Typecore.type_let In_class_def val_env rec_flag sdefs in let (vals, met_env) = List.fold_right (fun (id, _id_loc, _typ) (vals, met_env) -> diff --git a/typing/typecore.ml b/typing/typecore.ml index 6482517d5..607633fe1 100644 --- a/typing/typecore.ml +++ b/typing/typecore.ml @@ -395,13 +395,11 @@ type module_variable = let pattern_variables = ref ([] : pattern_variable list) let pattern_force = ref ([] : (unit -> unit) list) -let pattern_scope = ref (None : Annot.ident option);; let allow_modules = ref false let module_variables = ref ([] : module_variable list) -let reset_pattern scope allow = +let reset_pattern allow = pattern_variables := []; pattern_force := []; - pattern_scope := scope; allow_modules := allow; module_variables := []; ;; @@ -1898,7 +1896,7 @@ let partial_pred ~lev ~splitting_mode ?(explode=0) constrs; labels; } in try - reset_pattern None true; + reset_pattern true; let typed_p = type_pat Value ~lev ~mode env p expected_ty in set_state state env; (* types are invalidated but we don't need them here *) @@ -1940,8 +1938,8 @@ let add_pattern_variables ?check ?check_as env pv = ) pv env -let type_pattern category ~lev env spat scope expected_ty = - reset_pattern scope true; +let type_pattern category ~lev env spat expected_ty = + reset_pattern true; let new_env = ref env in let pat = type_pat category ~lev new_env spat expected_ty in let pvs = get_ref pattern_variables in @@ -1949,9 +1947,9 @@ let type_pattern category ~lev env spat scope expected_ty = (pat, !new_env, get_ref pattern_force, pvs, unpacks) let type_pattern_list - category no_existentials env spatl scope expected_tys allow + category no_existentials env spatl expected_tys allow = - reset_pattern scope allow; + reset_pattern allow; let new_env = ref env in let type_pat (attrs, pat) ty = Builtin_attributes.warning_scope ~ppwarning:false attrs @@ -1970,7 +1968,7 @@ let type_pattern_list (patl, new_env, get_ref pattern_force, pvs, unpacks) let type_class_arg_pattern cl_num val_env met_env l spat = - reset_pattern None false; + reset_pattern false; let nv = newvar () in let pat = type_pat Value ~no_existentials:In_class_args (ref val_env) spat nv in @@ -2020,7 +2018,7 @@ let type_self_pattern cl_num privty val_env met_env par_env spat = Pat.mk (Ppat_alias (Pat.mk(Ppat_alias (spat, mknoloc "selfpat-*")), mknoloc ("selfpat-" ^ cl_num))) in - reset_pattern None false; + reset_pattern false; let nv = newvar() in let pat = type_pat Value ~no_existentials:In_self_pattern (ref val_env) spat nv in @@ -2686,14 +2684,8 @@ and type_expect_ if rec_flag = Recursive then In_rec else if List.compare_length_with spat_sexp_list 1 > 0 then In_group else With_attributes in - let scp = - match sexp.pexp_attributes, rec_flag with - | [{attr_name = {txt="#default"}; _}], _ -> None - | _, Recursive -> Some (Annot.Idef loc) - | _, Nonrecursive -> Some (Annot.Idef sbody.pexp_loc) - in let (pat_exp_list, new_env, unpacks) = - type_let existential_context env rec_flag spat_sexp_list scp true in + type_let existential_context env rec_flag spat_sexp_list true in let body = type_unpacks new_env unpacks sbody ty_expected_explained in let () = if rec_flag = Recursive then @@ -4624,21 +4616,14 @@ and type_cases Printtyp.raw_type_expr ty_arg; *) let half_typed_cases = List.map - (fun ({pc_lhs; pc_guard; pc_rhs} as case) -> - let loc = - let open Location in - match pc_guard with - | None -> pc_rhs.pexp_loc - | Some g -> {pc_rhs.pexp_loc with loc_start=g.pexp_loc.loc_start} - in + (fun ({pc_lhs; pc_guard = _; pc_rhs = _} as case) -> if !Clflags.principal then begin_def (); (* propagation of pattern *) - let scope = Some (Annot.Idef loc) in begin_def (); let ty_arg = instance ?partial:take_partial_instance ty_arg in end_def (); generalize_structure ty_arg; let (pat, ext_env, force, pvs, unpacks) = - type_pattern category ~lev env pc_lhs scope ty_arg + type_pattern category ~lev env pc_lhs ty_arg in pattern_force := force @ !pattern_force; let pat = @@ -4823,7 +4808,7 @@ and type_let ?(check = fun s -> Warnings.Unused_var s) ?(check_strict = fun s -> Warnings.Unused_var_strict s) existential_context - env rec_flag spat_sexp_list scope allow = + env rec_flag spat_sexp_list allow = let open Ast_helper in begin_def(); if !Clflags.principal then begin_def (); @@ -4856,7 +4841,7 @@ and type_let spat_sexp_list in let nvs = List.map (fun _ -> newvar ()) spatl in let (pat_list, new_env, force, pvs, unpacks) = - type_pattern_list Value existential_context env spatl scope nvs allow in + type_pattern_list Value existential_context env spatl nvs allow in let attrs_list = List.map fst spatl in let is_recursive = (rec_flag = Recursive) in (* If recursive, first unify with an approximation of the expression *) @@ -5132,20 +5117,20 @@ and type_andops env sarg sands expected_ty = (* Typing of toplevel bindings *) -let type_binding env rec_flag spat_sexp_list scope = +let type_binding env rec_flag spat_sexp_list = Typetexp.reset_type_variables(); let (pat_exp_list, new_env, _unpacks) = type_let ~check:(fun s -> Warnings.Unused_value_declaration s) ~check_strict:(fun s -> Warnings.Unused_value_declaration s) At_toplevel - env rec_flag spat_sexp_list scope false + env rec_flag spat_sexp_list false in (pat_exp_list, new_env) -let type_let existential_ctx env rec_flag spat_sexp_list scope = +let type_let existential_ctx env rec_flag spat_sexp_list = let (pat_exp_list, new_env, _unpacks) = - type_let existential_ctx env rec_flag spat_sexp_list scope false in + type_let existential_ctx env rec_flag spat_sexp_list false in (pat_exp_list, new_env) (* Typing of toplevel expressions *) diff --git a/typing/typecore.mli b/typing/typecore.mli index 2c8d177eb..bfaab7342 100644 --- a/typing/typecore.mli +++ b/typing/typecore.mli @@ -80,12 +80,10 @@ type existential_restriction = val type_binding: Env.t -> rec_flag -> Parsetree.value_binding list -> - Annot.ident option -> Typedtree.value_binding list * Env.t val type_let: existential_restriction -> Env.t -> rec_flag -> Parsetree.value_binding list -> - Annot.ident option -> Typedtree.value_binding list * Env.t val type_expression: Env.t -> Parsetree.expression -> Typedtree.expression diff --git a/typing/typemod.ml b/typing/typemod.ml index 8e23c43db..de937c642 100644 --- a/typing/typemod.ml +++ b/typing/typemod.ml @@ -1908,7 +1908,7 @@ and type_module_aux ~alias sttn funct_body anchor env smod = in md | Pmod_structure sstr -> let (str, sg, names, _finalenv) = - type_structure funct_body anchor env sstr smod.pmod_loc in + type_structure funct_body anchor env sstr in let md = { mod_desc = Tmod_structure str; mod_type = Mty_signature sg; @@ -2138,10 +2138,10 @@ and type_open_decl_aux ?used_slot ?toplevel funct_body names env od = } in open_descr, sg, newenv -and type_structure ?(toplevel = false) funct_body anchor env sstr scope = +and type_structure ?(toplevel = false) funct_body anchor env sstr = let names = Signature_names.create () in - let type_str_item env srem {pstr_loc = loc; pstr_desc = desc} = + let type_str_item env {pstr_loc = loc; pstr_desc = desc} = match desc with | Pstr_eval (sexpr, attrs) -> let expr = @@ -2150,21 +2150,8 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope = in Tstr_eval (expr, attrs), [], env | Pstr_value(rec_flag, sdefs) -> - let scope = - match rec_flag with - | Recursive -> - Some (Annot.Idef {scope with - Location.loc_start = loc.Location.loc_start}) - | Nonrecursive -> - let start = - match srem with - | [] -> loc.Location.loc_end - | {pstr_loc = loc2} :: _ -> loc2.Location.loc_start - in - Some (Annot.Idef {scope with Location.loc_start = start}) - in let (defs, newenv) = - Typecore.type_binding env rec_flag sdefs scope in + Typecore.type_binding env rec_flag sdefs in let () = if rec_flag = Recursive then Typecore.check_recursive_bindings env defs in @@ -2440,7 +2427,7 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope = | [] -> ([], [], env) | pstr :: srem -> let previous_saved_types = Cmt_format.get_saved_types () in - let desc, sg, new_env = type_str_item env srem pstr in + let desc, sg, new_env = type_str_item env pstr in let str = { str_desc = desc; str_loc = pstr.pstr_loc; str_env = env } in Cmt_format.set_saved_types (Cmt_format.Partial_structure_item str :: previous_saved_types); @@ -2461,7 +2448,7 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope = let type_toplevel_phrase env s = Env.reset_required_globals (); let (str, sg, to_remove_from_sg, env) = - type_structure ~toplevel:true false None env s Location.none in + type_structure ~toplevel:true false None env s in (str, sg, to_remove_from_sg, env) let type_module_alias = type_module ~alias:true true false None @@ -2641,7 +2628,7 @@ let type_implementation sourcefile outputprefix modulename initial_env ast = if !Clflags.print_types then (* #7656 *) Warnings.parse_options false "-32-34-37-38-60"; let (str, sg, names, finalenv) = - type_structure initial_env ast (Location.in_file sourcefile) in + type_structure initial_env ast in let simple_sg = Signature_names.simplify finalenv names sg in if !Clflags.print_types then begin Typecore.force_delayed_checks (); diff --git a/typing/typemod.mli b/typing/typemod.mli index e78cadd59..c24aa5e2a 100644 --- a/typing/typemod.mli +++ b/typing/typemod.mli @@ -32,7 +32,7 @@ end val type_module: Env.t -> Parsetree.module_expr -> Typedtree.module_expr val type_structure: - Env.t -> Parsetree.structure -> Location.t -> + Env.t -> Parsetree.structure -> Typedtree.structure * Types.signature * Signature_names.t * Env.t val type_toplevel_phrase: Env.t -> Parsetree.structure ->