Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Remove dead code (#9974)

master
Nicolás Ojeda Bär 2020-10-13 09:48:16 +02:00 committed by GitHub
parent 426b10c6a8
commit 246564e8db
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
6 changed files with 27 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
.depend
View File

@ -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 \

2
typing/typeclass.ml
View File

@ -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) ->

49
typing/typecore.ml
View File

@ -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 *)

2
typing/typecore.mli
View File

@ -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

27
typing/typemod.ml
View File

@ -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 ();

2
typing/typemod.mli
View File

@ -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 ->