From a19a4642e5a81b51dda14dd759cc2ae74e0c51ee Mon Sep 17 00:00:00 2001 From: Alain Frisch Date: Wed, 19 Dec 2012 09:25:21 +0000 Subject: [PATCH] Enable 'unused stuff' warnings in tools/ and get rid of them. git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@13140 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02 --- tools/Makefile.shared | 2 +- tools/depend.ml | 5 +- tools/dumpobj.ml | 6 +-- tools/ocamldep.ml | 1 - tools/ocamlprof.ml | 5 +- tools/untypeast.ml | 105 +++++++++++++++++++++--------------------- tools/untypeast.mli | 1 + 7 files changed, 58 insertions(+), 67 deletions(-) diff --git a/tools/Makefile.shared b/tools/Makefile.shared index 503960593..a78594559 100644 --- a/tools/Makefile.shared +++ b/tools/Makefile.shared @@ -18,7 +18,7 @@ CAMLOPT=$(CAMLRUN) ../ocamlopt -nostdlib -I ../stdlib CAMLLEX=$(CAMLRUN) ../boot/ocamllex INCLUDES=-I ../utils -I ../parsing -I ../typing -I ../bytecomp -I ../asmcomp \ -I ../driver -COMPFLAGS= -warn-error A $(INCLUDES) +COMPFLAGS= -w +32+33+34+35+36+37+38+39 -warn-error A $(INCLUDES) LINKFLAGS=$(INCLUDES) all: ocamldep ocamlprof ocamlcp ocamloptp ocamlmktop ocamlmklib dumpobj \ diff --git a/tools/depend.ml b/tools/depend.ml index 282521834..3e0c8b386 100644 --- a/tools/depend.ml +++ b/tools/depend.ml @@ -11,7 +11,6 @@ (***********************************************************************) open Asttypes -open Format open Location open Longident open Parsetree @@ -20,8 +19,6 @@ module StringSet = Set.Make(struct type t = string let compare = compare end) (* Collect free module identifiers in the a.s.t. *) -let fst3 (x, _, _) = x - let free_structure_names = ref StringSet.empty let rec addmodule bv lid = @@ -75,7 +72,7 @@ let add_type_declaration bv td = (fun (ty1, ty2, _) -> add_type bv ty1; add_type bv ty2) td.ptype_cstrs; add_opt add_type bv td.ptype_manifest; - let rec add_tkind = function + let add_tkind = function Ptype_abstract -> () | Ptype_variant cstrs -> List.iter (fun (c, args, rty, _) -> List.iter (add_type bv) args; Misc.may (add_type bv) rty) cstrs diff --git a/tools/dumpobj.ml b/tools/dumpobj.ml index d68f3e101..df654a94c 100644 --- a/tools/dumpobj.ml +++ b/tools/dumpobj.ml @@ -14,11 +14,9 @@ open Asttypes open Config -open Emitcode open Instruct open Lambda open Location -open Obj open Opcodes open Opnames open Cmo_format @@ -450,7 +448,7 @@ let print_instr ic = let nvars = inputu ic in let orig = currpc ic in print_int nvars; - for i = 0 to nfuncs - 1 do + for _i = 0 to nfuncs - 1 do print_string ", "; print_int (orig + inputs ic); done; @@ -530,7 +528,7 @@ let dump_exe ic = begin try ignore (Bytesections.seek_section ic "DBUG"); let num_eventlists = input_binary_int ic in - for i = 1 to num_eventlists do + for _i = 1 to num_eventlists do let orig = input_binary_int ic in let evl = (input_value ic : debug_event list) in record_events orig evl diff --git a/tools/ocamldep.ml b/tools/ocamldep.ml index 8cec34b45..c6b11de3a 100644 --- a/tools/ocamldep.ml +++ b/tools/ocamldep.ml @@ -10,7 +10,6 @@ (* *) (***********************************************************************) -open Longident open Parsetree diff --git a/tools/ocamlprof.ml b/tools/ocamlprof.ml index d88c70c59..16f9def1f 100644 --- a/tools/ocamlprof.ml +++ b/tools/ocamlprof.ml @@ -13,10 +13,7 @@ open Printf -open Clflags -open Config open Location -open Misc open Parsetree (* User programs must not use identifiers that start with these prefixes. *) @@ -50,7 +47,7 @@ let copy_chars_unix nchars = done let copy_chars_win32 nchars = - for i = 1 to nchars do + for _i = 1 to nchars do let c = input_char !inchan in if c <> '\r' then output_char !outchan c done diff --git a/tools/untypeast.ml b/tools/untypeast.ml index b917c9b68..1fd2766e8 100644 --- a/tools/untypeast.ml +++ b/tools/untypeast.ml @@ -10,7 +10,6 @@ (* *) (**************************************************************************) -open Misc open Asttypes open Typedtree open Parsetree @@ -48,24 +47,24 @@ and untype_structure_item item = | Tstr_value (rec_flag, list) -> Pstr_value (rec_flag, List.map (fun (pat, exp) -> untype_pattern pat, untype_expression exp) list) - | Tstr_primitive (id, name, v) -> + | Tstr_primitive (_id, name, v) -> Pstr_primitive (name, untype_value_description v) | Tstr_type list -> - Pstr_type (List.map (fun (id, name, decl) -> + Pstr_type (List.map (fun (_id, name, decl) -> name, untype_type_declaration decl) list) - | Tstr_exception (id, name, decl) -> + | Tstr_exception (_id, name, decl) -> Pstr_exception (name, untype_exception_declaration decl) - | Tstr_exn_rebind (id, name, p, lid) -> + | Tstr_exn_rebind (_id, name, _p, lid) -> Pstr_exn_rebind (name, lid) - | Tstr_module (id, name, mexpr) -> + | Tstr_module (_id, name, mexpr) -> Pstr_module (name, untype_module_expr mexpr) | Tstr_recmodule list -> - Pstr_recmodule (List.map (fun (id, name, mtype, mexpr) -> + Pstr_recmodule (List.map (fun (_id, name, mtype, mexpr) -> name, untype_module_type mtype, untype_module_expr mexpr) list) - | Tstr_modtype (id, name, mtype) -> + | Tstr_modtype (_id, name, mtype) -> Pstr_modtype (name, untype_module_type mtype) - | Tstr_open (path, lid) -> Pstr_open (lid) + | Tstr_open (_path, lid) -> Pstr_open (lid) | Tstr_class list -> Pstr_class (List.map (fun (ci, _, _) -> { pci_virt = ci.ci_virt; @@ -77,7 +76,7 @@ and untype_structure_item item = } ) list) | Tstr_class_type list -> - Pstr_class_type (List.map (fun (id, name, ct) -> + Pstr_class_type (List.map (fun (_id, _name, ct) -> { pci_virt = ct.ci_virt; pci_params = ct.ci_params; @@ -108,11 +107,11 @@ and untype_type_declaration decl = ptype_kind = (match decl.typ_kind with Ttype_abstract -> Ptype_abstract | Ttype_variant list -> - Ptype_variant (List.map (fun (s, name, cts, loc) -> + Ptype_variant (List.map (fun (_s, name, cts, loc) -> (name, List.map untype_core_type cts, None, loc) ) list) | Ttype_record list -> - Ptype_record (List.map (fun (s, name, mut, ct, loc) -> + Ptype_record (List.map (fun (_s, name, mut, ct, loc) -> (name, mut, untype_core_type ct, loc) ) list) ); @@ -130,9 +129,9 @@ and untype_exception_declaration decl = and untype_pattern pat = let desc = match pat with - { pat_extra=[Tpat_unpack, _]; pat_desc = Tpat_var (_,name) } -> Ppat_unpack name - | { pat_extra=[Tpat_type (path, lid), _] } -> Ppat_type lid - | { pat_extra= (Tpat_constraint ct, _) :: rem } -> + { pat_extra=[Tpat_unpack, _]; pat_desc = Tpat_var (_,name); _ } -> Ppat_unpack name + | { pat_extra=[Tpat_type (_path, lid), _]; _ } -> Ppat_type lid + | { pat_extra= (Tpat_constraint ct, _) :: rem; _ } -> Ppat_constraint (untype_pattern { pat with pat_extra=rem }, untype_core_type ct) | _ -> match pat.pat_desc with @@ -145,7 +144,7 @@ and untype_pattern pat = | _ -> Ppat_var name end - | Tpat_alias (pat, id, name) -> + | Tpat_alias (pat, _id, name) -> Ppat_alias (untype_pattern pat, name) | Tpat_constant cst -> Ppat_constant cst | Tpat_tuple list -> @@ -183,7 +182,7 @@ and untype_extra (extra, loc) sexp = Pexp_constraint (sexp, option untype_core_type cty1, option untype_core_type cty2) - | Texp_open (path, lid, _) -> Pexp_open (lid, sexp) + | Texp_open (_path, lid, _) -> Pexp_open (lid, sexp) | Texp_poly cto -> Pexp_poly (sexp, option untype_core_type cto) | Texp_newtype s -> Pexp_newtype (s, sexp) in @@ -193,7 +192,7 @@ and untype_extra (extra, loc) sexp = and untype_expression exp = let desc = match exp.exp_desc with - Texp_ident (path, lid, _) -> Pexp_ident (lid) + Texp_ident (_path, lid, _) -> Pexp_ident (lid) | Texp_constant cst -> Pexp_constant cst | Texp_let (rec_flag, list, exp) -> Pexp_let (rec_flag, @@ -241,9 +240,9 @@ and untype_expression exp = match expo with None -> None | Some exp -> Some (untype_expression exp)) - | Texp_field (exp, lid, label) -> + | Texp_field (exp, lid, _label) -> Pexp_field (untype_expression exp, lid) - | Texp_setfield (exp1, lid, label, exp2) -> + | Texp_setfield (exp1, lid, _label, exp2) -> Pexp_setfield (untype_expression exp1, lid, untype_expression exp2) | Texp_array list -> @@ -258,7 +257,7 @@ and untype_expression exp = Pexp_sequence (untype_expression exp1, untype_expression exp2) | Texp_while (exp1, exp2) -> Pexp_while (untype_expression exp1, untype_expression exp2) - | Texp_for (id, name, exp1, exp2, dir, exp3) -> + | Texp_for (_id, name, exp1, exp2, dir, exp3) -> Pexp_for (name, untype_expression exp1, untype_expression exp2, dir, untype_expression exp3) @@ -268,16 +267,16 @@ and untype_expression exp = Pexp_send (untype_expression exp, match meth with Tmeth_name name -> name | Tmeth_val id -> Ident.name id) - | Texp_new (path, lid, _) -> Pexp_new (lid) + | Texp_new (_path, lid, _) -> Pexp_new (lid) | Texp_instvar (_, path, name) -> Pexp_ident ({name with txt = lident_of_path path}) - | Texp_setinstvar (_, path, lid, exp) -> + | Texp_setinstvar (_, _path, lid, exp) -> Pexp_setinstvar (lid, untype_expression exp) | Texp_override (_, list) -> - Pexp_override (List.map (fun (path, lid, exp) -> + Pexp_override (List.map (fun (_path, lid, exp) -> lid, untype_expression exp ) list) - | Texp_letmodule (id, name, mexpr, exp) -> + | Texp_letmodule (_id, name, mexpr, exp) -> Pexp_letmodule (name, untype_module_expr mexpr, untype_expression exp) | Texp_assert exp -> Pexp_assert (untype_expression exp) @@ -303,23 +302,23 @@ and untype_signature sg = and untype_signature_item item = let desc = match item.sig_desc with - Tsig_value (id, name, v) -> + Tsig_value (_id, name, v) -> Psig_value (name, untype_value_description v) | Tsig_type list -> - Psig_type (List.map (fun (id, name, decl) -> + Psig_type (List.map (fun (_id, name, decl) -> name, untype_type_declaration decl ) list) - | Tsig_exception (id, name, decl) -> + | Tsig_exception (_id, name, decl) -> Psig_exception (name, untype_exception_declaration decl) - | Tsig_module (id, name, mtype) -> + | Tsig_module (_id, name, mtype) -> Psig_module (name, untype_module_type mtype) | Tsig_recmodule list -> - Psig_recmodule (List.map (fun (id, name, mtype) -> + Psig_recmodule (List.map (fun (_id, name, mtype) -> name, untype_module_type mtype) list) - | Tsig_modtype (id, name, mdecl) -> + | Tsig_modtype (_id, name, mdecl) -> Psig_modtype (name, untype_modtype_declaration mdecl) - | Tsig_open (path, lid) -> Psig_open (lid) - | Tsig_include (mty, lid) -> Psig_include (untype_module_type mty) + | Tsig_open (_path, lid) -> Psig_open (lid) + | Tsig_include (mty, _lid) -> Psig_include (untype_module_type mty) | Tsig_class list -> Psig_class (List.map untype_class_description list) | Tsig_class_type list -> @@ -356,14 +355,14 @@ and untype_class_type_declaration cd = and untype_module_type mty = let desc = match mty.mty_desc with - Tmty_ident (path, lid) -> Pmty_ident (lid) + Tmty_ident (_path, lid) -> Pmty_ident (lid) | Tmty_signature sg -> Pmty_signature (untype_signature sg) - | Tmty_functor (id, name, mtype1, mtype2) -> + | Tmty_functor (_id, name, mtype1, mtype2) -> Pmty_functor (name, untype_module_type mtype1, untype_module_type mtype2) | Tmty_with (mtype, list) -> Pmty_with (untype_module_type mtype, - List.map (fun (path, lid, withc) -> + List.map (fun (_path, lid, withc) -> lid, untype_with_constraint withc ) list) | Tmty_typeof mexpr -> @@ -377,9 +376,9 @@ and untype_module_type mty = and untype_with_constraint cstr = match cstr with Twith_type decl -> Pwith_type (untype_type_declaration decl) - | Twith_module (path, lid) -> Pwith_module (lid) + | Twith_module (_path, lid) -> Pwith_module (lid) | Twith_typesubst decl -> Pwith_typesubst (untype_type_declaration decl) - | Twith_modsubst (path, lid) -> Pwith_modsubst (lid) + | Twith_modsubst (_path, lid) -> Pwith_modsubst (lid) and untype_module_expr mexpr = match mexpr.mod_desc with @@ -387,9 +386,9 @@ and untype_module_expr mexpr = untype_module_expr m | _ -> let desc = match mexpr.mod_desc with - Tmod_ident (p, lid) -> Pmod_ident (lid) + Tmod_ident (_p, lid) -> Pmod_ident (lid) | Tmod_structure st -> Pmod_structure (untype_structure st) - | Tmod_functor (id, name, mtype, mexpr) -> + | Tmod_functor (_id, name, mtype, mexpr) -> Pmod_functor (name, untype_module_type mtype, untype_module_expr mexpr) | Tmod_apply (mexp1, mexp2, _) -> @@ -397,9 +396,9 @@ and untype_module_expr mexpr = | Tmod_constraint (mexpr, _, Tmodtype_explicit mtype, _) -> Pmod_constraint (untype_module_expr mexpr, untype_module_type mtype) - | Tmod_constraint (mexpr, _, Tmodtype_implicit, _) -> + | Tmod_constraint (_mexpr, _, Tmodtype_implicit, _) -> assert false - | Tmod_unpack (exp, pack) -> + | Tmod_unpack (exp, _pack) -> Pmod_unpack (untype_expression exp) (* TODO , untype_package_type pack) *) @@ -411,12 +410,12 @@ and untype_module_expr mexpr = and untype_class_expr cexpr = let desc = match cexpr.cl_desc with - | Tcl_constraint ( { cl_desc = Tcl_ident (path, lid, tyl) }, None, _, _, _ ) -> + | Tcl_constraint ( { cl_desc = Tcl_ident (_path, lid, tyl); _ }, None, _, _, _ ) -> Pcl_constr (lid, List.map untype_core_type tyl) | Tcl_structure clstr -> Pcl_structure (untype_class_structure clstr) - | Tcl_fun (label, pat, pv, cl, partial) -> + | Tcl_fun (label, pat, _pv, cl, _partial) -> Pcl_fun (label, None, untype_pattern pat, untype_class_expr cl) | Tcl_apply (cl, args) -> @@ -427,13 +426,13 @@ and untype_class_expr cexpr = | Some exp -> (label, untype_expression exp) :: list ) args []) - | Tcl_let (rec_flat, bindings, ivars, cl) -> + | Tcl_let (rec_flat, bindings, _ivars, cl) -> Pcl_let (rec_flat, List.map (fun (pat, exp) -> (untype_pattern pat, untype_expression exp)) bindings, untype_class_expr cl) - | Tcl_constraint (cl, Some clty, vals, meths, concrs) -> + | Tcl_constraint (cl, Some clty, _vals, _meths, _concrs) -> Pcl_constraint (untype_class_expr cl, untype_class_type clty) | Tcl_ident _ -> assert false @@ -446,7 +445,7 @@ and untype_class_expr cexpr = and untype_class_type ct = let desc = match ct.cltyp_desc with Tcty_signature csg -> Pcty_signature (untype_class_signature csg) - | Tcty_constr (path, lid, list) -> + | Tcty_constr (_path, lid, list) -> Pcty_constr (lid, List.map untype_core_type list) | Tcty_fun (label, ct, cl) -> Pcty_fun (label, untype_core_type ct, untype_class_type cl) @@ -485,12 +484,12 @@ and untype_core_type ct = | Ttyp_arrow (label, ct1, ct2) -> Ptyp_arrow (label, untype_core_type ct1, untype_core_type ct2) | Ttyp_tuple list -> Ptyp_tuple (List.map untype_core_type list) - | Ttyp_constr (path, lid, list) -> + | Ttyp_constr (_path, lid, list) -> Ptyp_constr (lid, List.map untype_core_type list) | Ttyp_object list -> Ptyp_object (List.map untype_core_field_type list) - | Ttyp_class (path, lid, list, labels) -> + | Ttyp_class (_path, lid, list, labels) -> Ptyp_class (lid, List.map untype_core_type list, labels) | Ttyp_alias (ct, s) -> @@ -525,15 +524,15 @@ and untype_class_field cf = Pcf_inher (ovf, untype_class_expr cl, super) | Tcf_constr (cty, cty') -> Pcf_constr (untype_core_type cty, untype_core_type cty') - | Tcf_val (lab, name, mut, _, Tcfk_virtual cty, override) -> + | Tcf_val (_lab, name, mut, _, Tcfk_virtual cty, _override) -> Pcf_valvirt (name, mut, untype_core_type cty) - | Tcf_val (lab, name, mut, _, Tcfk_concrete exp, override) -> + | Tcf_val (_lab, name, mut, _, Tcfk_concrete exp, override) -> Pcf_val (name, mut, (if override then Override else Fresh), untype_expression exp) - | Tcf_meth (lab, name, priv, Tcfk_virtual cty, override) -> + | Tcf_meth (_lab, name, priv, Tcfk_virtual cty, _override) -> Pcf_virt (name, priv, untype_core_type cty) - | Tcf_meth (lab, name, priv, Tcfk_concrete exp, override) -> + | Tcf_meth (_lab, name, priv, Tcfk_concrete exp, override) -> Pcf_meth (name, priv, (if override then Override else Fresh), untype_expression exp) diff --git a/tools/untypeast.mli b/tools/untypeast.mli index 0e0805360..d61fd4fd5 100644 --- a/tools/untypeast.mli +++ b/tools/untypeast.mli @@ -12,5 +12,6 @@ val untype_structure : Typedtree.structure -> Parsetree.structure val untype_signature : Typedtree.signature -> Parsetree.signature +val untype_expression : Typedtree.expression -> Parsetree.expression val lident_of_path : Path.t -> Longident.t