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

ajout warning unused variable 

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@6669 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Damien Doligez 2004-11-06 20:17:47 +00:00
parent d9ad8992f2
commit 4ffbf5ec57
21 changed files with 317 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
.depend
View File

@ -258,6 +258,10 @@ typing/typetexp.cmx: typing/btype.cmx typing/ctype.cmx typing/env.cmx \
parsing/location.cmx parsing/longident.cmx utils/misc.cmx \
parsing/parsetree.cmi typing/path.cmx typing/printtyp.cmx utils/tbl.cmx \
typing/types.cmx utils/warnings.cmx typing/typetexp.cmi
typing/unused_var.cmo: parsing/asttypes.cmi parsing/location.cmi \
parsing/longident.cmi parsing/parsetree.cmi utils/warnings.cmi
typing/unused_var.cmx: parsing/asttypes.cmi parsing/location.cmx \
parsing/longident.cmx parsing/parsetree.cmi utils/warnings.cmx
bytecomp/bytegen.cmi: bytecomp/instruct.cmi bytecomp/lambda.cmi
bytecomp/bytelink.cmi: bytecomp/emitcode.cmi bytecomp/symtable.cmi
bytecomp/bytepackager.cmi: typing/ident.cmi
@ -401,15 +405,15 @@ bytecomp/translcore.cmx: parsing/asttypes.cmi typing/btype.cmx \
utils/misc.cmx typing/path.cmx typing/predef.cmx typing/primitive.cmx \
bytecomp/translobj.cmx typing/typedtree.cmx bytecomp/typeopt.cmx \
typing/types.cmx bytecomp/translcore.cmi
bytecomp/translmod.cmo: parsing/asttypes.cmi utils/config.cmi \
typing/ctype.cmi typing/env.cmi typing/ident.cmi bytecomp/lambda.cmi \
parsing/location.cmi utils/misc.cmi typing/mtype.cmi typing/path.cmi \
bytecomp/translmod.cmo: parsing/asttypes.cmi typing/ctype.cmi typing/env.cmi \
typing/ident.cmi bytecomp/lambda.cmi parsing/location.cmi \
parsing/longident.cmi utils/misc.cmi typing/mtype.cmi typing/path.cmi \
typing/predef.cmi typing/primitive.cmi typing/printtyp.cmi \
bytecomp/translclass.cmi bytecomp/translcore.cmi bytecomp/translobj.cmi \
typing/typedtree.cmi typing/types.cmi bytecomp/translmod.cmi
bytecomp/translmod.cmx: parsing/asttypes.cmi utils/config.cmx \
typing/ctype.cmx typing/env.cmx typing/ident.cmx bytecomp/lambda.cmx \
parsing/location.cmx utils/misc.cmx typing/mtype.cmx typing/path.cmx \
bytecomp/translmod.cmx: parsing/asttypes.cmi typing/ctype.cmx typing/env.cmx \
typing/ident.cmx bytecomp/lambda.cmx parsing/location.cmx \
parsing/longident.cmx utils/misc.cmx typing/mtype.cmx typing/path.cmx \
typing/predef.cmx typing/primitive.cmx typing/printtyp.cmx \
bytecomp/translclass.cmx bytecomp/translcore.cmx bytecomp/translobj.cmx \
typing/typedtree.cmx typing/types.cmx bytecomp/translmod.cmi
@ -631,13 +635,15 @@ driver/compile.cmo: bytecomp/bytegen.cmi utils/ccomp.cmi utils/clflags.cmo \
utils/misc.cmi parsing/parse.cmi driver/pparse.cmi parsing/printast.cmi \
bytecomp/printinstr.cmi bytecomp/printlambda.cmi typing/printtyp.cmi \
bytecomp/simplif.cmi bytecomp/translmod.cmi typing/typedtree.cmi \
typing/typemod.cmi utils/warnings.cmi driver/compile.cmi
typing/typemod.cmi typing/unused_var.cmo utils/warnings.cmi \
driver/compile.cmi
driver/compile.cmx: bytecomp/bytegen.cmx utils/ccomp.cmx utils/clflags.cmx \
utils/config.cmx bytecomp/emitcode.cmx typing/env.cmx typing/ident.cmx \
utils/misc.cmx parsing/parse.cmx driver/pparse.cmx parsing/printast.cmx \
bytecomp/printinstr.cmx bytecomp/printlambda.cmx typing/printtyp.cmx \
bytecomp/simplif.cmx bytecomp/translmod.cmx typing/typedtree.cmx \
typing/typemod.cmx utils/warnings.cmx driver/compile.cmi
typing/typemod.cmx typing/unused_var.cmx utils/warnings.cmx \
driver/compile.cmi
driver/errors.cmo: bytecomp/bytelibrarian.cmi bytecomp/bytelink.cmi \
bytecomp/bytepackager.cmi typing/ctype.cmi typing/env.cmi \
typing/includemod.cmi parsing/lexer.cmi parsing/location.cmi \
@ -669,13 +675,13 @@ driver/optcompile.cmo: asmcomp/asmgen.cmi utils/ccomp.cmi utils/clflags.cmo \
utils/misc.cmi parsing/parse.cmi driver/pparse.cmi parsing/printast.cmi \
bytecomp/printlambda.cmi typing/printtyp.cmi bytecomp/simplif.cmi \
bytecomp/translmod.cmi typing/typedtree.cmi typing/typemod.cmi \
utils/warnings.cmi driver/optcompile.cmi
typing/unused_var.cmo utils/warnings.cmi driver/optcompile.cmi
driver/optcompile.cmx: asmcomp/asmgen.cmx utils/ccomp.cmx utils/clflags.cmx \
asmcomp/compilenv.cmx utils/config.cmx typing/env.cmx typing/ident.cmx \
utils/misc.cmx parsing/parse.cmx driver/pparse.cmx parsing/printast.cmx \
bytecomp/printlambda.cmx typing/printtyp.cmx bytecomp/simplif.cmx \
bytecomp/translmod.cmx typing/typedtree.cmx typing/typemod.cmx \
utils/warnings.cmx driver/optcompile.cmi
typing/unused_var.cmx utils/warnings.cmx driver/optcompile.cmi
driver/opterrors.cmo: asmcomp/asmgen.cmi asmcomp/asmlibrarian.cmi \
asmcomp/asmlink.cmi asmcomp/asmpackager.cmi asmcomp/compilenv.cmi \
typing/ctype.cmi typing/env.cmi typing/includemod.cmi parsing/lexer.cmi \

4
Makefile
View File

@ -19,7 +19,7 @@ include stdlib/StdlibModules
CAMLC=boot/ocamlrun boot/ocamlc -nostdlib -I boot
CAMLOPT=boot/ocamlrun ./ocamlopt -nostdlib -I stdlib
COMPFLAGS=-warn-error A $(INCLUDES)
COMPFLAGS=-warn-error Ay -w Y $(INCLUDES)
LINKFLAGS=
CAMLYACC=boot/ocamlyacc
@ -44,7 +44,7 @@ PARSING=parsing/linenum.cmo parsing/location.cmo parsing/longident.cmo \
parsing/syntaxerr.cmo parsing/parser.cmo \
parsing/lexer.cmo parsing/parse.cmo parsing/printast.cmo
TYPING=typing/ident.cmo typing/path.cmo \
TYPING=typing/unused_var.cmo typing/ident.cmo typing/path.cmo \
typing/primitive.cmo typing/types.cmo \
typing/btype.cmo typing/oprint.cmo \
typing/subst.cmo typing/predef.cmo \

1
driver/compile.ml
View File

@ -99,6 +99,7 @@ let implementation ppf sourcefile outputprefix =
try
Pparse.file ppf inputfile Parse.implementation ast_impl_magic_number
++ print_if ppf Clflags.dump_parsetree Printast.implementation
++ Unused_var.warn ppf
++ Typemod.type_implementation sourcefile outputprefix modulename env
++ Translmod.transl_implementation modulename
++ print_if ppf Clflags.dump_rawlambda Printlambda.lambda

6
driver/main_args.ml
View File

@ -134,9 +134,11 @@ struct
\032 S/s enable/disable non-unit statement\n\
\032 U/u enable/disable unused match case\n\
\032 V/v enable/disable hidden instance variable\n\
\032 Y/y enable/disable unused variable\n\
\032 Z/z enable/disable unused variable (strict)\n\
\032 X/x enable/disable all other warnings\n\
\032 default setting is \"Ale\"\n\
\032 (all warnings but labels and fragile match enabled)";
\032 default setting is \"Aelyz\"\n\
\032 (all warnings enabled except fragile match, labels, unused var)";
"-warn-error" , Arg.String F._warn_error,
"<flags> Treat the warnings enabled by <flags> as errors.\n\
\032 See option -w for the list of flags.\n\

2
driver/optcompile.ml
View File

@ -88,10 +88,12 @@ let implementation ppf sourcefile outputprefix =
if !Clflags.print_types then ignore(
Pparse.file ppf inputfile Parse.implementation ast_impl_magic_number
++ print_if ppf Clflags.dump_parsetree Printast.implementation
++ Unused_var.warn ppf
++ Typemod.type_implementation sourcefile outputprefix modulename env)
else begin
Pparse.file ppf inputfile Parse.implementation ast_impl_magic_number
++ print_if ppf Clflags.dump_parsetree Printast.implementation
++ Unused_var.warn ppf
++ Typemod.type_implementation sourcefile outputprefix modulename env
++ Translmod.transl_store_implementation modulename
+++ print_if ppf Clflags.dump_rawlambda Printlambda.lambda

2
lex/Makefile
View File

@ -15,7 +15,7 @@
# The lexer generator
CAMLC=../boot/ocamlrun ../boot/ocamlc -nostdlib -I ../boot
CAMLOPT=../boot/ocamlrun ../ocamlopt -nostdlib -I ../stdlib
COMPFLAGS=-warn-error A
COMPFLAGS=-warn-error Ay -w Y
CAMLYACC=../boot/ocamlyacc
YACCFLAGS=-v
CAMLLEX=../boot/ocamlrun ../boot/ocamllex

2
otherlibs/bigarray/Makefile
View File

@ -20,7 +20,7 @@ CFLAGS=-I../../byterun -g -O $(BYTECCCOMPOPTS) $(SHAREDCCCOMPOPTS)
CAMLC=../../ocamlcomp.sh -I ../unix
CAMLOPT=../../ocamlcompopt.sh -I ../unix
MKLIB=../../boot/ocamlrun ../../tools/ocamlmklib
COMPFLAGS=-warn-error A
COMPFLAGS=-warn-error Ay -w Y
C_OBJS=bigarray_stubs.o mmap_unix.o

2
otherlibs/dbm/Makefile
View File

@ -22,7 +22,7 @@ CC=$(BYTECC) -g
CAMLC=../../ocamlcomp.sh
CAMLOPT=../../ocamlcompopt.sh
MKLIB=../../boot/ocamlrun ../../tools/ocamlmklib
COMPFLAGS=-warn-error A
COMPFLAGS=-warn-error Ay -w Y
CFLAGS=$(DBM_INCLUDES) -I../../byterun -O $(BYTECCCOMPOPTS) $(SHAREDCCCOMPOPTS)
COBJS=cldbm.o

2
otherlibs/dynlink/Makefile
View File

@ -19,7 +19,7 @@ include ../../config/Makefile
CAMLC=../../boot/ocamlrun ../../ocamlc
INCLUDES=-I ../../utils -I ../../typing -I ../../bytecomp
COMPFLAGS=-warn-error A -I ../../stdlib $(INCLUDES)
COMPFLAGS=-warn-error Ay -w Y -I ../../stdlib $(INCLUDES)
OBJS=dynlink.cmo
COMPILEROBJS=misc.cmo config.cmo tbl.cmo clflags.cmo consistbl.cmo \

2
otherlibs/graph/Makefile
View File

@ -22,7 +22,7 @@ CFLAGS=-I../../byterun $(X11_INCLUDES) -O $(BYTECCCOMPOPTS) $(SHAREDCCCOMPOPTS)
CAMLC=../../ocamlcomp.sh
CAMLOPT=../../ocamlcompopt.sh
MKLIB=../../boot/ocamlrun ../../tools/ocamlmklib
COMPFLAGS=-warn-error A
COMPFLAGS=-warn-error Ay -w Y
OBJS=open.o draw.o fill.o color.o text.o \
image.o make_img.o dump_img.o point_col.o sound.o events.o \

2
otherlibs/labltk/support/Makefile.common
View File

@ -15,7 +15,7 @@ INSTALLDIR=$(LIBDIR)/$(LIBNAME)
CAMLRUN=$(TOPDIR)/boot/ocamlrun
CAMLC=$(TOPDIR)/ocamlcomp.sh
CAMLOPT=$(TOPDIR)/ocamlcompopt.sh
CAMLCOMP=$(CAMLC) -c -warn-error A
CAMLCOMP=$(CAMLC) -c -warn-error Ay -w Y
CAMLYACC=$(TOPDIR)/boot/ocamlyacc -v
CAMLLEX=$(CAMLRUN) $(TOPDIR)/boot/ocamllex
CAMLLIBR=$(CAMLC) -a

6
otherlibs/num/Makefile
View File

@ -21,10 +21,10 @@ include ../../config/Makefile
CC=$(BYTECC)
CFLAGS=-O -I../../byterun $(BYTECCCOMPOPTS) $(SHAREDCCCOMPOPTS) \
-DBNG_ARCH_$(BNG_ARCH) -DBNG_ASM_LEVEL=$(BNG_ASM_LEVEL)
CAMLC=../../ocamlcomp.sh -w s
CAMLOPT=../../ocamlcompopt.sh -w s
CAMLC=../../ocamlcomp.sh
CAMLOPT=../../ocamlcompopt.sh
MKLIB=../../boot/ocamlrun ../../tools/ocamlmklib
COMPFLAGS=-warn-error A
COMPFLAGS=-w sY -warn-error Ay
CAMLOBJS=int_misc.cmo string_misc.cmo nat.cmo big_int.cmo arith_flags.cmo \
ratio.cmo num.cmo arith_status.cmo

2
otherlibs/str/Makefile
View File

@ -22,7 +22,7 @@ CC=$(BYTECC)
CFLAGS=-O -I../../byterun $(BYTECCCOMPOPTS) $(SHAREDCCCOMPOPTS)
CAMLC=../../ocamlcomp.sh
CAMLOPT=../../ocamlcompopt.sh
COMPFLAGS=-warn-error A
COMPFLAGS=-warn-error Ay -w Y
COBJS=strstubs.o
MKLIB=../../boot/ocamlrun ../../tools/ocamlmklib

2
otherlibs/systhreads/Makefile
View File

@ -18,7 +18,7 @@ include ../../config/Makefile
CAMLC=../../ocamlcomp.sh -I ../unix
CAMLOPT=../../ocamlcompopt.sh -I ../unix
MKLIB=../../boot/ocamlrun ../../tools/ocamlmklib
COMPFLAGS=-warn-error A
COMPFLAGS=-warn-error Ay -w Y
BYTECODE_C_OBJS=posix_b.o
NATIVECODE_C_OBJS=posix_n.o

2
otherlibs/threads/Makefile
View File

@ -19,7 +19,7 @@ CC=$(BYTECC)
CFLAGS=-I../../byterun -O $(BYTECCCOMPOPTS) $(SHAREDCCCOMPOPTS) -g
CAMLC=../../ocamlcomp.sh -I ../unix
MKLIB=../../boot/ocamlrun ../../tools/ocamlmklib
COMPFLAGS=-warn-error A
COMPFLAGS=-warn-error Ay -w Y
C_OBJS=scheduler.o

2
otherlibs/unix/Makefile
View File

@ -23,7 +23,7 @@ CFLAGS=-I../../byterun -O $(BYTECCCOMPOPTS) $(SHAREDCCCOMPOPTS)
CAMLC=../../ocamlcomp.sh
CAMLOPT=../../ocamlcompopt.sh
MKLIB=../../boot/ocamlrun ../../tools/ocamlmklib
COMPFLAGS=-warn-error A
COMPFLAGS=-warn-error Ay -w Y
OBJS=accept.o access.o addrofstr.o alarm.o bind.o chdir.o chmod.o \
chown.o chroot.o close.o closedir.o connect.o cst2constr.o cstringv.o \

2
stdlib/Makefile
View File

@ -18,7 +18,7 @@ include ../config/Makefile
RUNTIME=../boot/ocamlrun
COMPILER=../ocamlc
CAMLC=$(RUNTIME) $(COMPILER)
COMPFLAGS=-g -warn-error A -nostdlib
COMPFLAGS=-g -warn-error Ay -w Y -nostdlib
OPTCOMPILER=../ocamlopt
CAMLOPT=$(RUNTIME) $(OPTCOMPILER)
OPTCOMPFLAGS=-warn-error A -nostdlib

2
stdlib/sys.ml
View File

@ -78,4 +78,4 @@ let catch_break on =
(* OCaml version string, must be in the format described in sys.mli. *)
let ocaml_version = "3.09+dev5 (2004-11-02)";;
let ocaml_version = "3.09+dev6 (2004-11-06)";;

267
typing/unused_var.ml Normal file
View File

@ -0,0 +1,267 @@
(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Damien Doligez, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 2004 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the Q Public License version 1.0. *)
(* *)
(***********************************************************************)
(* $Id$ *)
open Parsetree
let silent v = String.length v > 0 && v.[0] = '_';;
let add_vars tbl (vll1, vll2) =
let add_var (v, _loc, used) = Hashtbl.add tbl v used in
List.iter add_var vll1;
List.iter add_var vll2;
;;
let rm_vars tbl (vll1, vll2) =
let rm_var (v, _, _) = Hashtbl.remove tbl v in
List.iter rm_var vll1;
List.iter rm_var vll2;
;;
let w_lax x = Warnings.Unused_var x;;
let w_strict x = Warnings.Unused_var_strict x;;
let w_either x =
if Warnings.is_active (w_strict x) then w_strict x else w_lax x
;;
let check_rm_vars ppf tbl (vlul_pat, vlul_as) =
let check_rm_var kind (v, loc, used) =
if not !used && not (silent v)
then Location.print_warning loc ppf (kind v);
Hashtbl.remove tbl v;
in
List.iter (check_rm_var w_strict) vlul_pat;
List.iter (check_rm_var w_either) vlul_as;
;;
let check_rm_let ppf tbl vlulpl =
if Warnings.is_active (w_strict "") then begin
List.iter (check_rm_vars ppf tbl) vlulpl;
end else begin
let check_rm_one flag (v, loc, used) =
Hashtbl.remove tbl v;
flag && (silent v || not !used)
in
let warn_var (v, loc, used) =
if not (silent v) && not !used
then Location.print_warning loc ppf (w_lax v)
in
let check_rm_pat (def, def_as) =
let def_unused = List.fold_left check_rm_one true def in
let all_unused = List.fold_left check_rm_one def_unused def_as in
if all_unused then List.iter warn_var def;
List.iter warn_var def_as;
in
List.iter check_rm_pat vlulpl;
end;
;;
let rec get_vars ((vacc, asacc) as acc) p =
match p.ppat_desc with
| Ppat_any -> acc
| Ppat_var v -> ((v, p.ppat_loc, ref false) :: vacc, asacc)
| Ppat_alias (pp, v) ->
get_vars (vacc, ((v, p.ppat_loc, ref false) :: asacc)) pp
| Ppat_constant _ -> acc
| Ppat_tuple pl -> List.fold_left get_vars acc pl
| Ppat_construct (_, po, _) -> get_vars_option acc po
| Ppat_variant (_, po) -> get_vars_option acc po
| Ppat_record ipl ->
List.fold_left (fun a (_, p) -> get_vars a p) acc ipl
| Ppat_array pl -> List.fold_left get_vars acc pl
| Ppat_or (p1, _p2) -> get_vars acc p1
| Ppat_constraint (pp, _) -> get_vars acc pp
| Ppat_type _ -> acc
and get_vars_option acc po =
match po with
| Some p -> get_vars acc p
| None -> acc
;;
let get_pel_vars pel =
List.map (fun (p, _) -> get_vars ([], []) p) pel
;;
let rec structure ppf tbl l =
List.iter (structure_item ppf tbl) l
and structure_item ppf tbl s =
match s.pstr_desc with
| Pstr_eval e -> expression ppf tbl e;
| Pstr_value (recflag, pel) -> let_pel ppf tbl recflag pel None;
| Pstr_primitive _ -> ()
| Pstr_type _ -> ()
| Pstr_exception _ -> ()
| Pstr_exn_rebind _ -> ()
| Pstr_module (_, me) -> module_expr ppf tbl me;
| Pstr_recmodule stml ->
List.iter (fun (_, _, me) -> module_expr ppf tbl me) stml;
| Pstr_modtype _ -> ()
| Pstr_open _ -> ()
| Pstr_class cdl -> List.iter (class_declaration ppf tbl) cdl;
| Pstr_class_type _ -> ()
| Pstr_include _ -> ()
and expression ppf tbl e =
match e.pexp_desc with
| Pexp_ident (Longident.Lident id) ->
begin try (Hashtbl.find tbl id) := true;
with Not_found -> ()
end;
| Pexp_ident _ -> ()
| Pexp_constant _ -> ()
| Pexp_let (recflag, pel, e) ->
let_pel ppf tbl recflag pel (Some (fun ppf tbl -> expression ppf tbl e));
| Pexp_function (_, eo, pel) ->
expression_option ppf tbl eo;
match_pel ppf tbl pel;
| Pexp_apply (e, lel) ->
expression ppf tbl e;
List.iter (fun (_, e) -> expression ppf tbl e) lel;
| Pexp_match (e, pel) ->
expression ppf tbl e;
match_pel ppf tbl pel;
| Pexp_try (e, pel) ->
expression ppf tbl e;
match_pel ppf tbl pel;
| Pexp_tuple el -> List.iter (expression ppf tbl) el;
| Pexp_construct (_, eo, _) -> expression_option ppf tbl eo;
| Pexp_variant (_, eo) -> expression_option ppf tbl eo;
| Pexp_record (iel, eo) ->
List.iter (fun (_, e) -> expression ppf tbl e) iel;
expression_option ppf tbl eo;
| Pexp_field (e, _) -> expression ppf tbl e;
| Pexp_setfield (e1, _, e2) ->
expression ppf tbl e1;
expression ppf tbl e2;
| Pexp_array el -> List.iter (expression ppf tbl) el;
| Pexp_ifthenelse (e1, e2, eo) ->
expression ppf tbl e1;
expression ppf tbl e2;
expression_option ppf tbl eo;
| Pexp_sequence (e1, e2) ->
expression ppf tbl e1;
expression ppf tbl e2;
| Pexp_while (e1, e2) ->
expression ppf tbl e1;
expression ppf tbl e2;
| Pexp_for (id, e1, e2, _, e3) ->
expression ppf tbl e1;
expression ppf tbl e2;
let defined = ([ (id, e.pexp_loc, ref false) ], []) in
add_vars tbl defined;
expression ppf tbl e3;
check_rm_vars ppf tbl defined;
| Pexp_constraint (e, _, _) -> expression ppf tbl e;
| Pexp_when (e1, e2) ->
expression ppf tbl e1;
expression ppf tbl e2;
| Pexp_send (e, _) -> expression ppf tbl e;
| Pexp_new _ -> ()
| Pexp_setinstvar (_, e) -> expression ppf tbl e;
| Pexp_override sel -> List.iter (fun (_, e) -> expression ppf tbl e) sel;
| Pexp_letmodule (_, me, e) ->
module_expr ppf tbl me;
expression ppf tbl e;
| Pexp_assert e -> expression ppf tbl e;
| Pexp_assertfalse -> ()
| Pexp_lazy e -> expression ppf tbl e;
| Pexp_poly (e, _) -> expression ppf tbl e;
| Pexp_object cs -> class_structure ppf tbl cs;
and expression_option ppf tbl eo =
match eo with
| Some e -> expression ppf tbl e;
| None -> ()
and let_pel ppf tbl recflag pel body =
match recflag with
| Asttypes.Recursive ->
let defined = get_pel_vars pel in
List.iter (add_vars tbl) defined;
List.iter (fun (_, e) -> expression ppf tbl e) pel;
begin match body with
| None ->
List.iter (rm_vars tbl) defined;
| Some f ->
f ppf tbl;
check_rm_let ppf tbl defined;
end;
| _ ->
List.iter (fun (_, e) -> expression ppf tbl e) pel;
begin match body with
| None -> ()
| Some f ->
let defined = get_pel_vars pel in
List.iter (add_vars tbl) defined;
f ppf tbl;
check_rm_let ppf tbl defined;
end;
and match_pel ppf tbl pel =
List.iter (match_pe ppf tbl) pel
and match_pe ppf tbl (p, e) =
let defined = get_vars ([], []) p in
add_vars tbl defined;
expression ppf tbl e;
check_rm_vars ppf tbl defined;
and module_expr ppf tbl me =
match me.pmod_desc with
| Pmod_ident _ -> ()
| Pmod_structure s -> structure ppf tbl s
| Pmod_functor (_, _, me) -> module_expr ppf tbl me
| Pmod_apply (me1, me2) ->
module_expr ppf tbl me1;
module_expr ppf tbl me2;
| Pmod_constraint (me, _) -> module_expr ppf tbl me
and class_declaration ppf tbl cd = class_expr ppf tbl cd.pci_expr
and class_expr ppf tbl ce =
match ce.pcl_desc with
| Pcl_constr _ -> ()
| Pcl_structure cs -> class_structure ppf tbl cs
| Pcl_fun (_, _, _, ce) -> class_expr ppf tbl ce
| Pcl_apply (ce, _) -> class_expr ppf tbl ce
| Pcl_let (recflag, pel, ce) ->
let_pel ppf tbl recflag pel (Some (fun ppf tbl -> class_expr ppf tbl ce));
| Pcl_constraint (ce, _) -> class_expr ppf tbl ce;
and class_structure ppf tbl (p, cfl) =
let defined = get_vars ([], []) p in
add_vars tbl defined;
List.iter (class_field ppf tbl) cfl;
check_rm_vars ppf tbl defined;
and class_field ppf tbl cf =
match cf with
| Pcf_inher (ce, _) -> class_expr ppf tbl ce;
| Pcf_val (_, _, e, _) -> expression ppf tbl e;
| Pcf_virt _ -> ()
| Pcf_meth (_, _, e, _) -> expression ppf tbl e;
| Pcf_cstr _ -> ()
| Pcf_let (recflag, pel, _) -> let_pel ppf tbl recflag pel None;
| Pcf_init e -> expression ppf tbl e;
;;
let warn ppf ast =
if Warnings.is_active (w_lax "") || Warnings.is_active (w_strict "")
then begin
let tbl = Hashtbl.create 97 in
structure ppf tbl ast;
end;
ast
;;

11
utils/warnings.ml
View File

@ -27,12 +27,14 @@ type t = (* A is all *)
| Unused_pat (* U *)
| Hide_instance_variable of string (* V *)
| Other of string (* X *)
| Unused_var of string (* Y *)
| Unused_var_strict of string (* Z *)
;;
let letter = function (* 'a' is all *)
| Comment _ -> 'c'
| Deprecated -> 'd'
| Fragile_pat _ -> 'e'
| Fragile_pat _ -> 'e'
| Partial_application -> 'f'
| Labels_omitted -> 'l'
| Method_override _ -> 'm'
@ -41,10 +43,12 @@ let letter = function (* 'a' is all *)
| Unused_match|Unused_pat -> 'u'
| Hide_instance_variable _ -> 'v'
| Other _ -> 'x'
| Unused_var _ -> 'y'
| Unused_var_strict _ -> 'z'
;;
let check c =
try ignore (String.index "acdeflmpsuvxACDEFLMPSUVX" c)
try ignore (String.index "acdeflmpsuvxyzACDEFLMPSUVXYZ" c)
with _ -> raise (Arg.Bad (Printf.sprintf "unknown warning option %c" c))
;;
@ -81,7 +85,7 @@ let parse_options iserr s =
done
;;
let () = parse_options false "el";;
let () = parse_options false "elyz";;
let message = function
| Partial_match "" -> "this pattern-matching is not exhaustive."
@ -113,6 +117,7 @@ let message = function
"this expression should have type unit."
| Comment s -> "this is " ^ s ^ "."
| Deprecated -> "this syntax is deprecated."
| Unused_var v | Unused_var_strict v -> "unused variable " ^ v ^ "."
| Other s -> s
;;

2
utils/warnings.mli
View File

@ -27,6 +27,8 @@ type t = (* A is all *)
| Unused_pat (* U *)
| Hide_instance_variable of string (* V *)
| Other of string (* X *)
| Unused_var of string (* Y *)
| Unused_var_strict of string (* Z *)
;;
val parse_options : bool -> string -> unit;;