diff --git a/.depend b/.depend index 04e314e3d..5ab125bf0 100644 --- a/.depend +++ b/.depend @@ -101,8 +101,8 @@ typing/typedtree.cmi: typing/types.cmi typing/primitive.cmi typing/path.cmi \ typing/typemod.cmi: typing/types.cmi typing/typedtree.cmi \ parsing/parsetree.cmi parsing/longident.cmi parsing/location.cmi \ typing/includemod.cmi typing/ident.cmi typing/env.cmi -typing/types.cmi: typing/primitive.cmi typing/path.cmi parsing/location.cmi \ - typing/ident.cmi parsing/asttypes.cmi +typing/types.cmi: typing/primitive.cmi typing/path.cmi parsing/longident.cmi \ + parsing/location.cmi typing/ident.cmi parsing/asttypes.cmi typing/typetexp.cmi: typing/types.cmi typing/path.cmi parsing/parsetree.cmi \ parsing/longident.cmi parsing/location.cmi typing/env.cmi typing/unused_var.cmi: parsing/parsetree.cmi @@ -122,14 +122,16 @@ typing/datarepr.cmo: typing/types.cmi typing/predef.cmi utils/misc.cmi \ typing/btype.cmi parsing/asttypes.cmi typing/datarepr.cmi typing/datarepr.cmx: typing/types.cmx typing/predef.cmx utils/misc.cmx \ typing/btype.cmx parsing/asttypes.cmi typing/datarepr.cmi -typing/env.cmo: typing/types.cmi utils/tbl.cmi typing/subst.cmi \ - typing/predef.cmi typing/path.cmi utils/misc.cmi parsing/longident.cmi \ - typing/ident.cmi typing/datarepr.cmi utils/consistbl.cmi utils/config.cmi \ +typing/env.cmo: utils/warnings.cmi typing/types.cmi utils/tbl.cmi \ + typing/subst.cmi typing/predef.cmi typing/path.cmi utils/misc.cmi \ + parsing/longident.cmi parsing/location.cmi typing/ident.cmi \ + typing/datarepr.cmi utils/consistbl.cmi utils/config.cmi \ utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi typing/annot.cmi \ typing/env.cmi -typing/env.cmx: typing/types.cmx utils/tbl.cmx typing/subst.cmx \ - typing/predef.cmx typing/path.cmx utils/misc.cmx parsing/longident.cmx \ - typing/ident.cmx typing/datarepr.cmx utils/consistbl.cmx utils/config.cmx \ +typing/env.cmx: utils/warnings.cmx typing/types.cmx utils/tbl.cmx \ + typing/subst.cmx typing/predef.cmx typing/path.cmx utils/misc.cmx \ + parsing/longident.cmx parsing/location.cmx typing/ident.cmx \ + typing/datarepr.cmx utils/consistbl.cmx utils/config.cmx \ utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi typing/annot.cmi \ typing/env.cmi typing/ident.cmo: typing/ident.cmi @@ -216,21 +218,23 @@ typing/typeclass.cmx: utils/warnings.cmx typing/typetexp.cmx typing/types.cmx \ parsing/longident.cmx parsing/location.cmx typing/includeclass.cmx \ typing/ident.cmx typing/env.cmx typing/ctype.cmx utils/clflags.cmx \ typing/btype.cmx parsing/asttypes.cmi typing/typeclass.cmi -typing/typecore.cmo: utils/warnings.cmi typing/typetexp.cmi typing/types.cmi \ - typing/typedtree.cmi typing/subst.cmi typing/stypes.cmi \ - typing/printtyp.cmi typing/primitive.cmi typing/predef.cmi \ - typing/path.cmi parsing/parsetree.cmi typing/parmatch.cmi \ - typing/oprint.cmi utils/misc.cmi parsing/longident.cmi \ - parsing/location.cmi typing/ident.cmi typing/env.cmi typing/ctype.cmi \ - utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi typing/annot.cmi \ +typing/typecore.cmo: utils/warnings.cmi typing/unused_var.cmi \ + typing/typetexp.cmi typing/types.cmi typing/typedtree.cmi \ + typing/subst.cmi typing/stypes.cmi typing/printtyp.cmi \ + typing/primitive.cmi typing/predef.cmi typing/path.cmi \ + parsing/parsetree.cmi typing/parmatch.cmi typing/oprint.cmi \ + utils/misc.cmi parsing/longident.cmi parsing/location.cmi \ + typing/ident.cmi typing/env.cmi typing/ctype.cmi utils/clflags.cmi \ + typing/btype.cmi parsing/asttypes.cmi typing/annot.cmi \ typing/typecore.cmi -typing/typecore.cmx: utils/warnings.cmx typing/typetexp.cmx typing/types.cmx \ - typing/typedtree.cmx typing/subst.cmx typing/stypes.cmx \ - typing/printtyp.cmx typing/primitive.cmx typing/predef.cmx \ - typing/path.cmx parsing/parsetree.cmi typing/parmatch.cmx \ - typing/oprint.cmx utils/misc.cmx parsing/longident.cmx \ - parsing/location.cmx typing/ident.cmx typing/env.cmx typing/ctype.cmx \ - utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi typing/annot.cmi \ +typing/typecore.cmx: utils/warnings.cmx typing/unused_var.cmx \ + typing/typetexp.cmx typing/types.cmx typing/typedtree.cmx \ + typing/subst.cmx typing/stypes.cmx typing/printtyp.cmx \ + typing/primitive.cmx typing/predef.cmx typing/path.cmx \ + parsing/parsetree.cmi typing/parmatch.cmx typing/oprint.cmx \ + utils/misc.cmx parsing/longident.cmx parsing/location.cmx \ + typing/ident.cmx typing/env.cmx typing/ctype.cmx utils/clflags.cmx \ + typing/btype.cmx parsing/asttypes.cmi typing/annot.cmi \ typing/typecore.cmi typing/typedecl.cmo: utils/warnings.cmi typing/typetexp.cmi typing/types.cmi \ typing/typedtree.cmi typing/subst.cmi typing/printtyp.cmi \ @@ -269,11 +273,11 @@ typing/typemod.cmx: utils/warnings.cmx typing/typetexp.cmx typing/types.cmx \ typing/env.cmx typing/ctype.cmx utils/config.cmx utils/clflags.cmx \ typing/btype.cmx parsing/asttypes.cmi typing/annot.cmi typing/typemod.cmi typing/types.cmo: typing/primitive.cmi typing/path.cmi utils/misc.cmi \ - parsing/location.cmi typing/ident.cmi parsing/asttypes.cmi \ - typing/types.cmi + parsing/longident.cmi parsing/location.cmi typing/ident.cmi \ + parsing/asttypes.cmi typing/types.cmi typing/types.cmx: typing/primitive.cmx typing/path.cmx utils/misc.cmx \ - parsing/location.cmx typing/ident.cmx parsing/asttypes.cmi \ - typing/types.cmi + parsing/longident.cmx parsing/location.cmx typing/ident.cmx \ + parsing/asttypes.cmi typing/types.cmi typing/typetexp.cmo: utils/warnings.cmi typing/types.cmi utils/tbl.cmi \ typing/printtyp.cmi typing/path.cmi parsing/parsetree.cmi utils/misc.cmi \ parsing/longident.cmi parsing/location.cmi typing/env.cmi \ @@ -668,11 +672,11 @@ asmcomp/printmach.cmx: asmcomp/reg.cmx asmcomp/proc.cmx asmcomp/printcmm.cmx \ asmcomp/mach.cmx asmcomp/debuginfo.cmx asmcomp/cmm.cmx asmcomp/arch.cmx \ asmcomp/printmach.cmi asmcomp/proc.cmo: asmcomp/reg.cmi utils/misc.cmi asmcomp/mach.cmi \ - utils/config.cmi asmcomp/cmm.cmi utils/ccomp.cmi asmcomp/arch.cmo \ - asmcomp/proc.cmi + utils/config.cmi asmcomp/cmm.cmi utils/clflags.cmi utils/ccomp.cmi \ + asmcomp/arch.cmo asmcomp/proc.cmi asmcomp/proc.cmx: asmcomp/reg.cmx utils/misc.cmx asmcomp/mach.cmx \ - utils/config.cmx asmcomp/cmm.cmx utils/ccomp.cmx asmcomp/arch.cmx \ - asmcomp/proc.cmi + utils/config.cmx asmcomp/cmm.cmx utils/clflags.cmx utils/ccomp.cmx \ + asmcomp/arch.cmx asmcomp/proc.cmi asmcomp/reg.cmo: asmcomp/cmm.cmi asmcomp/reg.cmi asmcomp/reg.cmx: asmcomp/cmm.cmx asmcomp/reg.cmi asmcomp/reload.cmo: asmcomp/reloadgen.cmi asmcomp/reg.cmi asmcomp/mach.cmi \ @@ -750,13 +754,13 @@ driver/errors.cmx: utils/warnings.cmx typing/typetexp.cmx typing/typemod.cmx \ typing/env.cmx typing/ctype.cmx bytecomp/bytepackager.cmx \ bytecomp/bytelink.cmx bytecomp/bytelibrarian.cmx driver/errors.cmi driver/main.cmo: utils/warnings.cmi utils/misc.cmi driver/main_args.cmi \ - driver/errors.cmi utils/config.cmi driver/compile.cmi utils/clflags.cmi \ - bytecomp/bytepackager.cmi bytecomp/bytelink.cmi \ - bytecomp/bytelibrarian.cmi driver/main.cmi + parsing/location.cmi driver/errors.cmi utils/config.cmi \ + driver/compile.cmi utils/clflags.cmi bytecomp/bytepackager.cmi \ + bytecomp/bytelink.cmi bytecomp/bytelibrarian.cmi driver/main.cmi driver/main.cmx: utils/warnings.cmx utils/misc.cmx driver/main_args.cmx \ - driver/errors.cmx utils/config.cmx driver/compile.cmx utils/clflags.cmx \ - bytecomp/bytepackager.cmx bytecomp/bytelink.cmx \ - bytecomp/bytelibrarian.cmx driver/main.cmi + parsing/location.cmx driver/errors.cmx utils/config.cmx \ + driver/compile.cmx utils/clflags.cmx bytecomp/bytepackager.cmx \ + bytecomp/bytelink.cmx bytecomp/bytelibrarian.cmx driver/main.cmi driver/main_args.cmo: utils/warnings.cmi driver/main_args.cmi driver/main_args.cmx: utils/warnings.cmx driver/main_args.cmi driver/optcompile.cmo: utils/warnings.cmi typing/unused_var.cmi \ @@ -791,14 +795,14 @@ driver/opterrors.cmx: utils/warnings.cmx typing/typetexp.cmx \ asmcomp/asmgen.cmx driver/opterrors.cmi driver/optmain.cmo: utils/warnings.cmi asmcomp/printmach.cmi \ driver/opterrors.cmi driver/optcompile.cmi utils/misc.cmi \ - driver/main_args.cmi utils/config.cmi utils/clflags.cmi \ - asmcomp/asmpackager.cmi asmcomp/asmlink.cmi asmcomp/asmlibrarian.cmi \ - asmcomp/arch.cmo driver/optmain.cmi + driver/main_args.cmi parsing/location.cmi utils/config.cmi \ + utils/clflags.cmi asmcomp/asmpackager.cmi asmcomp/asmlink.cmi \ + asmcomp/asmlibrarian.cmi asmcomp/arch.cmo driver/optmain.cmi driver/optmain.cmx: utils/warnings.cmx asmcomp/printmach.cmx \ driver/opterrors.cmx driver/optcompile.cmx utils/misc.cmx \ - driver/main_args.cmx utils/config.cmx utils/clflags.cmx \ - asmcomp/asmpackager.cmx asmcomp/asmlink.cmx asmcomp/asmlibrarian.cmx \ - asmcomp/arch.cmx driver/optmain.cmi + driver/main_args.cmx parsing/location.cmx utils/config.cmx \ + utils/clflags.cmx asmcomp/asmpackager.cmx asmcomp/asmlink.cmx \ + asmcomp/asmlibrarian.cmx asmcomp/arch.cmx driver/optmain.cmi driver/pparse.cmo: utils/misc.cmi parsing/location.cmi utils/clflags.cmi \ utils/ccomp.cmi driver/pparse.cmi driver/pparse.cmx: utils/misc.cmx parsing/location.cmx utils/clflags.cmx \ @@ -863,12 +867,12 @@ toplevel/opttoploop.cmx: utils/warnings.cmx typing/unused_var.cmx \ asmcomp/asmlink.cmx asmcomp/asmgen.cmx toplevel/opttoploop.cmi toplevel/opttopmain.cmo: utils/warnings.cmi asmcomp/printmach.cmi \ toplevel/opttoploop.cmi toplevel/opttopdirs.cmi driver/opterrors.cmi \ - utils/misc.cmi driver/main_args.cmi utils/config.cmi utils/clflags.cmi \ - toplevel/opttopmain.cmi + utils/misc.cmi driver/main_args.cmi parsing/location.cmi utils/config.cmi \ + utils/clflags.cmi toplevel/opttopmain.cmi toplevel/opttopmain.cmx: utils/warnings.cmx asmcomp/printmach.cmx \ toplevel/opttoploop.cmx toplevel/opttopdirs.cmx driver/opterrors.cmx \ - utils/misc.cmx driver/main_args.cmx utils/config.cmx utils/clflags.cmx \ - toplevel/opttopmain.cmi + utils/misc.cmx driver/main_args.cmx parsing/location.cmx utils/config.cmx \ + utils/clflags.cmx toplevel/opttopmain.cmi toplevel/opttopstart.cmo: toplevel/opttopmain.cmi toplevel/opttopstart.cmx: toplevel/opttopmain.cmx toplevel/topdirs.cmo: utils/warnings.cmi typing/types.cmi toplevel/trace.cmi \ @@ -909,10 +913,12 @@ toplevel/toploop.cmx: utils/warnings.cmx typing/unused_var.cmx \ bytecomp/bytegen.cmx typing/btype.cmx toplevel/toploop.cmi toplevel/topmain.cmo: utils/warnings.cmi toplevel/toploop.cmi \ toplevel/topdirs.cmi utils/misc.cmi driver/main_args.cmi \ - driver/errors.cmi utils/config.cmi utils/clflags.cmi toplevel/topmain.cmi + parsing/location.cmi driver/errors.cmi utils/config.cmi utils/clflags.cmi \ + toplevel/topmain.cmi toplevel/topmain.cmx: utils/warnings.cmx toplevel/toploop.cmx \ toplevel/topdirs.cmx utils/misc.cmx driver/main_args.cmx \ - driver/errors.cmx utils/config.cmx utils/clflags.cmx toplevel/topmain.cmi + parsing/location.cmx driver/errors.cmx utils/config.cmx utils/clflags.cmx \ + toplevel/topmain.cmi toplevel/topstart.cmo: toplevel/topmain.cmi toplevel/topstart.cmx: toplevel/topmain.cmx toplevel/trace.cmo: typing/types.cmi toplevel/toploop.cmi typing/printtyp.cmi \ diff --git a/typing/env.ml b/typing/env.ml index 08597341e..4383582d3 100644 --- a/typing/env.ml +++ b/typing/env.ml @@ -22,6 +22,13 @@ open Path open Types open Btype +let add_delayed_check_forward = ref (fun _ -> assert false) + +let value_declarations : ((string * Location.t), (unit -> unit)) = Hashtbl.create 16 + (* This table is used to usage of value declarations. A declaration is + identified with its name and location. The callback attached to a declaration + is called whenever the value is used explicitly (lookup_value) or implicitly + (inclusion test between signatures, cf Includemod.value_descriptions). *) type error = Not_an_interface of string @@ -224,7 +231,8 @@ let find_pers_struct name = let reset_cache () = current_unit := ""; Hashtbl.clear persistent_structures; - Consistbl.clear crc_units + Consistbl.clear crc_units; + Hashtbl.clear value_declarations let set_unit_name name = current_unit := name @@ -456,6 +464,24 @@ and lookup_class = and lookup_cltype = lookup (fun env -> env.cltypes) (fun sc -> sc.comp_cltypes) +let mark_value_used name vd = + try Hashtbl.find value_declarations (name, vd.val_loc) (); + with Not_found -> () + +let set_value_used_callback name vd callback = + let old = + try Hashtbl.find value_declarations (name, vd.val_loc) + with Not_found -> + Format.eprintf "Cannot find callback for value %S %a@." name Location.print_loc vd.val_loc; + assert false + in + Hashtbl.replace value_declarations (name, vd.val_loc) (fun () -> callback old) + +let lookup_value lid env = + let (_, desc) as r = lookup_value lid env in + mark_value_used (Longident.last lid) desc; + r + (* GADT instance tracking *) let add_gadt_instance_level lv env = @@ -677,6 +703,21 @@ let rec components_of_module env sub path mty = (* Insertion of bindings by identifier + path *) and store_value id path decl env = + let loc = decl.val_loc in + if not loc.Location.loc_ghost && Warnings.is_active (Warnings.Unused_value_declaration "") then begin + let name = Ident.name id in + let key = (name, loc) in + if Hashtbl.mem value_declarations key then () + else let used = ref false in + Hashtbl.add value_declarations key (fun () -> used := true); + !add_delayed_check_forward + (fun () -> + if not (name = "" || name.[0] = '_' || !used) then begin + used := true; + Location.prerr_warning loc (Warnings.Unused_value_declaration name) + end + ) + end; { env with values = Ident.add id (path, decl) env.values; summary = Env_value(env.summary, id, decl) } diff --git a/typing/env.mli b/typing/env.mli index 4e822de83..5db3375c9 100644 --- a/typing/env.mli +++ b/typing/env.mli @@ -152,6 +152,11 @@ open Format val report_error: formatter -> error -> unit +val mark_value_used: string -> value_description -> unit +val set_value_used_callback: string -> value_description -> ((unit -> unit) -> unit) -> unit + (* Forward declaration to break mutual recursion with Includemod. *) val check_modtype_inclusion: (t -> module_type -> Path.t -> module_type -> unit) ref +(* Forward declaration to break mutual recursion with Typecore. *) +val add_delayed_check_forward: ((unit -> unit) -> unit) ref diff --git a/typing/includemod.ml b/typing/includemod.ml index 70112c7b2..5c25eeee8 100644 --- a/typing/includemod.ml +++ b/typing/includemod.ml @@ -51,6 +51,7 @@ exception Error of error list (* Inclusion between value descriptions *) let value_descriptions env cxt subst id vd1 vd2 = + Env.mark_value_used (Ident.name id) vd1; let vd2 = Subst.value_description subst vd2 in try Includecore.value_descriptions env vd1 vd2 diff --git a/typing/typecore.ml b/typing/typecore.ml index 9deb1be40..589548eee 100644 --- a/typing/typecore.ml +++ b/typing/typecore.ml @@ -1262,6 +1262,7 @@ let duplicate_ident_types loc caselist env = List.fold_left (fun env s -> try + (* XXX This will mark the value as being used; I don't think this is what we want *) let (path, desc) = Typetexp.find_value env loc (Longident.Lident s) in match path with Path.Pident id -> @@ -2613,7 +2614,8 @@ and type_let env rec_flag spat_sexp_list scope allow = let nvs = List.map (fun _ -> newvar ()) spatl in let (pat_list, new_env, force, unpacks) = type_pattern_list env spatl scope nvs allow in - if rec_flag = Recursive then + let is_recursive = (rec_flag = Recursive) in + if is_recursive then List.iter2 (fun pat (_, sexp) -> let pat = @@ -2643,12 +2645,55 @@ and type_let env rec_flag spat_sexp_list scope allow = (* Only bind pattern variables after generalizing *) List.iter (fun f -> f()) force; let exp_env = - match rec_flag with Nonrecursive | Default -> env | Recursive -> new_env in + if is_recursive then new_env else env in + + let current_slot = ref None in + let warn_unused = Warnings.is_active (Warnings.Unused_value_declaration "") in + let pat_slot_list = + (* Algorithm to detect unused declarations in recursive bindings: + - During type checking of the definitions, we capture the 'value_used' + events on the bound identifiers and record them in a slot corresponding + to the current definition (!current_slot). In effect, this creates a dependency + graph between definitions. + + - After type checking the definition (!current_slot = Mone), when one of the bound identifier is + effectively used, we trigger again all the events recorded in the corresponding + slot. The effect is to traverse the transitive closure of the graph created + in the first step. + *) + List.map + (fun pat -> + if not (is_recursive && warn_unused) then pat, None + else + let slot = ref [] in + let used_after_binding () = + List.iter + (fun (name, vd) -> Env.mark_value_used name vd) + (get_ref slot) + in + List.iter + (fun id -> + let vd = Env.find_value (Path.Pident id) new_env in (* note: Env.find_value does not trigger the value_used event *) + let name = Ident.name id in + Env.set_value_used_callback + name vd + (fun old_callback -> + match !current_slot with + | Some slot -> slot := (name, vd) :: !slot + | None -> used_after_binding (); old_callback () + ) + ) + (Typedtree.pat_bound_idents pat); + pat, Some slot + ) + pat_list + in let exp_list = List.map2 - (fun (spat, sexp) pat -> + (fun (spat, sexp) (pat, slot) -> let sexp = if rec_flag = Recursive then wrap_unpacks sexp unpacks else sexp in + current_slot := slot; match pat.pat_type.desc with | Tpoly (ty, tl) -> begin_def (); @@ -2663,7 +2708,8 @@ and type_let env rec_flag spat_sexp_list scope allow = check_univars env true "definition" exp pat.pat_type vars; {exp with exp_type = instance env exp.exp_type} | _ -> type_expect exp_env sexp pat.pat_type) - spat_sexp_list pat_list in + spat_sexp_list pat_slot_list in + current_slot := None; List.iter2 (fun pat exp -> ignore(Parmatch.check_partial pat.pat_loc [pat, exp])) pat_list exp_list; @@ -2872,3 +2918,6 @@ let report_error ppf = function | Unexpected_existential -> fprintf ppf "Unexpected existential" + +let () = + Env.add_delayed_check_forward := add_delayed_check diff --git a/typing/typedtree.mli b/typing/typedtree.mli index 266c72589..15acb6ac5 100644 --- a/typing/typedtree.mli +++ b/typing/typedtree.mli @@ -163,6 +163,7 @@ val map_pattern_desc : (pattern -> pattern) -> pattern_desc -> pattern_desc val let_bound_idents: (pattern * expression) list -> Ident.t list val rev_let_bound_idents: (pattern * expression) list -> Ident.t list +val pat_bound_idents: pattern -> Ident.t list (* Alpha conversion of patterns *) val alpha_pat : (Ident.t * Ident.t) list -> pattern -> pattern diff --git a/typing/typemod.ml b/typing/typemod.ml index f29c6bffb..666055443 100644 --- a/typing/typemod.ml +++ b/typing/typemod.ml @@ -816,6 +816,8 @@ and type_structure funct_body anchor env sstr scope = Typecore.type_binding env rec_flag sdefs scope in let (str_rem, sig_rem, final_env) = type_struct newenv srem in let bound_idents = let_bound_idents defs in + (* Note: Env.find_value does not trigger the value_used event. Values + will be marked as being used during the signature inclusion test. *) let make_sig_value id = Tsig_value(id, Env.find_value (Pident id) newenv) in (Tstr_value(rec_flag, defs) :: str_rem, @@ -1085,7 +1087,6 @@ let type_implementation sourcefile outputprefix modulename initial_env ast = Typecore.reset_delayed_checks (); let (str, sg, finalenv) = type_structure initial_env ast Location.none in let simple_sg = simplify_signature sg in - Typecore.force_delayed_checks (); if !Clflags.print_types then begin fprintf std_formatter "%a@." Printtyp.signature simple_sg; (str, Tcoerce_none) (* result is ignored by Compile.implementation *) @@ -1100,6 +1101,10 @@ let type_implementation sourcefile outputprefix modulename initial_env ast = raise(Error(Location.none, Interface_not_compiled sourceintf)) in let dclsig = Env.read_signature modulename intf_file in let coercion = Includemod.compunit sourcefile sg intf_file dclsig in + Typecore.force_delayed_checks (); + (* It is important to run these checks after the inclusion test above, + so that value declarations which are not used internally but exported + are not reported as being unused. *) (str, coercion) end else begin check_nongen_schemes finalenv str; @@ -1107,6 +1112,11 @@ let type_implementation sourcefile outputprefix modulename initial_env ast = let coercion = Includemod.compunit sourcefile sg "(inferred signature)" simple_sg in + Typecore.force_delayed_checks (); + (* See comment above. Here the target signature contains all + the value being exported. We can still capture unused + declarations like "let x = true;; let x = 1;;", because in this + case, the inferred signature contains only the last declaration. *) if not !Clflags.dont_write_files then Env.save_signature simple_sg modulename (outputprefix ^ ".cmi"); (str, coercion) diff --git a/utils/warnings.ml b/utils/warnings.ml index f77c5c060..9c527a63b 100644 --- a/utils/warnings.ml +++ b/utils/warnings.ml @@ -50,6 +50,7 @@ type t = | Wildcard_arg_to_constant_constr (* 28 *) | Eol_in_string (* 29 *) | Duplicate_definitions of string * string * string * string (*30 *) + | Unused_value_declaration of string (* 31 *) ;; (* If you remove a warning, leave a hole in the numbering. NEVER change @@ -89,9 +90,10 @@ let number = function | Wildcard_arg_to_constant_constr -> 28 | Eol_in_string -> 29 | Duplicate_definitions _ -> 30 + | Unused_value_declaration _ -> 31 ;; -let last_warning_number = 30;; +let last_warning_number = 31;; (* Must be the max number returned by the [number] function. *) let letter = function @@ -186,7 +188,7 @@ let parse_opt flags s = let parse_options errflag s = parse_opt (if errflag then error else active) s;; (* If you change these, don't forget to change them in man/ocamlc.m *) -let defaults_w = "+a-4-6-7-9-27-29";; +let defaults_w = "+a-4-6-7-9-27-29-31";; let defaults_warn_error = "-a";; let () = parse_options false defaults_w;; @@ -260,6 +262,7 @@ let message = function | Duplicate_definitions (kind, cname, tc1, tc2) -> Printf.sprintf "the %s %s is defined in both types %s and %s." kind cname tc1 tc2 + | Unused_value_declaration v -> "unused value " ^ v ^ "." ;; let nerrors = ref 0;; @@ -334,6 +337,7 @@ let descriptions = 29, "Unescaped end-of-line in a string constant (non-portable code)."; 30, "Two labels or constructors of the same name are defined in two\n\ \ mutually recursive types."; + 31, "Unused value declaration."; ] ;; diff --git a/utils/warnings.mli b/utils/warnings.mli index 61e372076..0b3157457 100644 --- a/utils/warnings.mli +++ b/utils/warnings.mli @@ -45,6 +45,7 @@ type t = | Wildcard_arg_to_constant_constr (* 28 *) | Eol_in_string (* 29 *) | Duplicate_definitions of string * string * string * string (*30 *) + | Unused_value_declaration of string (* 31 *) ;; val parse_options : bool -> string -> unit;;