Merge the unused_declarations branch.

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@12035 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

25 files changed, 563 insertions, 200 deletions

diff --git a/.depend b/.depend
index ee61e2f7d3..e6c68ebc02 100644
--- a/.depend
+++ b/.depend
@@ -38,6 +38,8 @@ parsing/lexer.cmo: utils/warnings.cmi parsing/parser.cmi utils/misc.cmi \
     parsing/location.cmi parsing/lexer.cmi
 parsing/lexer.cmx: utils/warnings.cmx parsing/parser.cmx utils/misc.cmx \
     parsing/location.cmx parsing/lexer.cmi
+parsing/linenum.cmo: utils/misc.cmi
+parsing/linenum.cmx: utils/misc.cmx
 parsing/location.cmo: utils/warnings.cmi utils/terminfo.cmi \
     parsing/location.cmi
 parsing/location.cmx: utils/warnings.cmx utils/terminfo.cmx \
@@ -65,8 +67,9 @@ typing/btype.cmi: typing/types.cmi typing/path.cmi parsing/asttypes.cmi
 typing/ctype.cmi: typing/types.cmi typing/path.cmi parsing/longident.cmi \
     typing/ident.cmi typing/env.cmi parsing/asttypes.cmi
 typing/datarepr.cmi: typing/types.cmi typing/path.cmi parsing/asttypes.cmi
-typing/env.cmi: typing/types.cmi typing/path.cmi parsing/longident.cmi \
-    typing/ident.cmi utils/consistbl.cmi typing/annot.cmi
+typing/env.cmi: utils/warnings.cmi typing/types.cmi typing/path.cmi \
+    parsing/longident.cmi parsing/location.cmi typing/ident.cmi \
+    utils/consistbl.cmi typing/annot.cmi
 typing/ident.cmi:
 typing/includeclass.cmi: typing/types.cmi typing/typedtree.cmi typing/env.cmi \
     typing/ctype.cmi
@@ -122,16 +125,18 @@ 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 \
-    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 \
-    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/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: 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
 typing/ident.cmx: typing/ident.cmi
 typing/includeclass.cmo: typing/types.cmi typing/printtyp.cmi \
@@ -139,11 +144,13 @@ typing/includeclass.cmo: typing/types.cmi typing/printtyp.cmi \
 typing/includeclass.cmx: typing/types.cmx typing/printtyp.cmx \
     typing/ctype.cmx typing/includeclass.cmi
 typing/includecore.cmo: typing/types.cmi typing/typedtree.cmi \
-    typing/predef.cmi typing/path.cmi utils/misc.cmi typing/ctype.cmi \
-    typing/btype.cmi parsing/asttypes.cmi typing/includecore.cmi
+    typing/predef.cmi typing/path.cmi utils/misc.cmi typing/ident.cmi \
+    typing/env.cmi typing/ctype.cmi typing/btype.cmi parsing/asttypes.cmi \
+    typing/includecore.cmi
 typing/includecore.cmx: typing/types.cmx typing/typedtree.cmx \
-    typing/predef.cmx typing/path.cmx utils/misc.cmx typing/ctype.cmx \
-    typing/btype.cmx parsing/asttypes.cmi typing/includecore.cmi
+    typing/predef.cmx typing/path.cmx utils/misc.cmx typing/ident.cmx \
+    typing/env.cmx typing/ctype.cmx typing/btype.cmx parsing/asttypes.cmi \
+    typing/includecore.cmi
 typing/includemod.cmo: typing/types.cmi typing/typedtree.cmi utils/tbl.cmi \
     typing/subst.cmi typing/printtyp.cmi typing/path.cmi typing/mtype.cmi \
     utils/misc.cmi parsing/location.cmi typing/includecore.cmi \
@@ -725,20 +732,20 @@ driver/optcompile.cmi: typing/env.cmi
 driver/opterrors.cmi:
 driver/optmain.cmi:
 driver/pparse.cmi:
-driver/compile.cmo: utils/warnings.cmi typing/unused_var.cmi \
-    typing/typemod.cmi typing/typedtree.cmi bytecomp/translmod.cmi \
-    typing/stypes.cmi bytecomp/simplif.cmi typing/printtyp.cmi \
-    bytecomp/printlambda.cmi bytecomp/printinstr.cmi parsing/printast.cmi \
-    driver/pparse.cmi parsing/parse.cmi utils/misc.cmi parsing/location.cmi \
-    typing/ident.cmi typing/env.cmi bytecomp/emitcode.cmi utils/config.cmi \
-    utils/clflags.cmi utils/ccomp.cmi bytecomp/bytegen.cmi driver/compile.cmi
-driver/compile.cmx: utils/warnings.cmx typing/unused_var.cmx \
-    typing/typemod.cmx typing/typedtree.cmx bytecomp/translmod.cmx \
-    typing/stypes.cmx bytecomp/simplif.cmx typing/printtyp.cmx \
-    bytecomp/printlambda.cmx bytecomp/printinstr.cmx parsing/printast.cmx \
-    driver/pparse.cmx parsing/parse.cmx utils/misc.cmx parsing/location.cmx \
-    typing/ident.cmx typing/env.cmx bytecomp/emitcode.cmx utils/config.cmx \
-    utils/clflags.cmx utils/ccomp.cmx bytecomp/bytegen.cmx driver/compile.cmi
+driver/compile.cmo: utils/warnings.cmi typing/typemod.cmi \
+    typing/typedtree.cmi bytecomp/translmod.cmi typing/stypes.cmi \
+    bytecomp/simplif.cmi typing/printtyp.cmi bytecomp/printlambda.cmi \
+    bytecomp/printinstr.cmi parsing/printast.cmi driver/pparse.cmi \
+    parsing/parse.cmi utils/misc.cmi parsing/location.cmi typing/ident.cmi \
+    typing/env.cmi bytecomp/emitcode.cmi utils/config.cmi utils/clflags.cmi \
+    utils/ccomp.cmi bytecomp/bytegen.cmi driver/compile.cmi
+driver/compile.cmx: utils/warnings.cmx typing/typemod.cmx \
+    typing/typedtree.cmx bytecomp/translmod.cmx typing/stypes.cmx \
+    bytecomp/simplif.cmx typing/printtyp.cmx bytecomp/printlambda.cmx \
+    bytecomp/printinstr.cmx parsing/printast.cmx driver/pparse.cmx \
+    parsing/parse.cmx utils/misc.cmx parsing/location.cmx typing/ident.cmx \
+    typing/env.cmx bytecomp/emitcode.cmx utils/config.cmx utils/clflags.cmx \
+    utils/ccomp.cmx bytecomp/bytegen.cmx driver/compile.cmi
 driver/errors.cmo: utils/warnings.cmi typing/typetexp.cmi typing/typemod.cmi \
     typing/typedecl.cmi typing/typecore.cmi typing/typeclass.cmi \
     bytecomp/translmod.cmi bytecomp/translcore.cmi bytecomp/translclass.cmi \
@@ -763,20 +770,20 @@ driver/main.cmx: utils/warnings.cmx utils/misc.cmx driver/main_args.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 \
-    typing/typemod.cmi typing/typedtree.cmi bytecomp/translmod.cmi \
-    typing/stypes.cmi bytecomp/simplif.cmi typing/printtyp.cmi \
-    bytecomp/printlambda.cmi parsing/printast.cmi driver/pparse.cmi \
-    parsing/parse.cmi utils/misc.cmi parsing/location.cmi typing/ident.cmi \
-    typing/env.cmi utils/config.cmi asmcomp/compilenv.cmi utils/clflags.cmi \
-    utils/ccomp.cmi asmcomp/asmgen.cmi driver/optcompile.cmi
-driver/optcompile.cmx: utils/warnings.cmx typing/unused_var.cmx \
-    typing/typemod.cmx typing/typedtree.cmx bytecomp/translmod.cmx \
-    typing/stypes.cmx bytecomp/simplif.cmx typing/printtyp.cmx \
-    bytecomp/printlambda.cmx parsing/printast.cmx driver/pparse.cmx \
-    parsing/parse.cmx utils/misc.cmx parsing/location.cmx typing/ident.cmx \
-    typing/env.cmx utils/config.cmx asmcomp/compilenv.cmx utils/clflags.cmx \
-    utils/ccomp.cmx asmcomp/asmgen.cmx driver/optcompile.cmi
+driver/optcompile.cmo: utils/warnings.cmi typing/typemod.cmi \
+    typing/typedtree.cmi bytecomp/translmod.cmi typing/stypes.cmi \
+    bytecomp/simplif.cmi typing/printtyp.cmi bytecomp/printlambda.cmi \
+    parsing/printast.cmi driver/pparse.cmi parsing/parse.cmi utils/misc.cmi \
+    parsing/location.cmi typing/ident.cmi typing/env.cmi utils/config.cmi \
+    asmcomp/compilenv.cmi utils/clflags.cmi utils/ccomp.cmi \
+    asmcomp/asmgen.cmi driver/optcompile.cmi
+driver/optcompile.cmx: utils/warnings.cmx typing/typemod.cmx \
+    typing/typedtree.cmx bytecomp/translmod.cmx typing/stypes.cmx \
+    bytecomp/simplif.cmx typing/printtyp.cmx bytecomp/printlambda.cmx \
+    parsing/printast.cmx driver/pparse.cmx parsing/parse.cmx utils/misc.cmx \
+    parsing/location.cmx typing/ident.cmx typing/env.cmx utils/config.cmx \
+    asmcomp/compilenv.cmx utils/clflags.cmx utils/ccomp.cmx \
+    asmcomp/asmgen.cmx driver/optcompile.cmi
 driver/opterrors.cmo: utils/warnings.cmi typing/typetexp.cmi \
     typing/typemod.cmi typing/typedecl.cmi typing/typecore.cmi \
     typing/typeclass.cmi bytecomp/translmod.cmi bytecomp/translcore.cmi \
@@ -843,22 +850,22 @@ toplevel/opttopdirs.cmx: utils/warnings.cmx typing/types.cmx \
     utils/misc.cmx parsing/longident.cmx typing/ident.cmx typing/env.cmx \
     typing/ctype.cmx utils/config.cmx utils/clflags.cmx asmcomp/asmlink.cmx \
     toplevel/opttopdirs.cmi
-toplevel/opttoploop.cmo: utils/warnings.cmi typing/unused_var.cmi \
-    typing/types.cmi typing/typemod.cmi typing/typedtree.cmi \
-    typing/typecore.cmi bytecomp/translmod.cmi bytecomp/simplif.cmi \
-    typing/printtyp.cmi bytecomp/printlambda.cmi parsing/printast.cmi \
-    typing/predef.cmi typing/path.cmi parsing/parsetree.cmi parsing/parse.cmi \
+toplevel/opttoploop.cmo: utils/warnings.cmi typing/types.cmi \
+    typing/typemod.cmi typing/typedtree.cmi typing/typecore.cmi \
+    bytecomp/translmod.cmi bytecomp/simplif.cmi typing/printtyp.cmi \
+    bytecomp/printlambda.cmi parsing/printast.cmi typing/predef.cmi \
+    typing/path.cmi parsing/parsetree.cmi parsing/parse.cmi \
     typing/outcometree.cmi driver/opterrors.cmi driver/optcompile.cmi \
     typing/oprint.cmi utils/misc.cmi parsing/longident.cmi \
     parsing/location.cmi parsing/lexer.cmi bytecomp/lambda.cmi \
     typing/ident.cmi toplevel/genprintval.cmi typing/env.cmi utils/config.cmi \
     asmcomp/compilenv.cmi utils/clflags.cmi typing/btype.cmi \
     asmcomp/asmlink.cmi asmcomp/asmgen.cmi toplevel/opttoploop.cmi
-toplevel/opttoploop.cmx: utils/warnings.cmx typing/unused_var.cmx \
-    typing/types.cmx typing/typemod.cmx typing/typedtree.cmx \
-    typing/typecore.cmx bytecomp/translmod.cmx bytecomp/simplif.cmx \
-    typing/printtyp.cmx bytecomp/printlambda.cmx parsing/printast.cmx \
-    typing/predef.cmx typing/path.cmx parsing/parsetree.cmi parsing/parse.cmx \
+toplevel/opttoploop.cmx: utils/warnings.cmx typing/types.cmx \
+    typing/typemod.cmx typing/typedtree.cmx typing/typecore.cmx \
+    bytecomp/translmod.cmx bytecomp/simplif.cmx typing/printtyp.cmx \
+    bytecomp/printlambda.cmx parsing/printast.cmx typing/predef.cmx \
+    typing/path.cmx parsing/parsetree.cmi parsing/parse.cmx \
     typing/outcometree.cmi driver/opterrors.cmx driver/optcompile.cmx \
     typing/oprint.cmx utils/misc.cmx parsing/longident.cmx \
     parsing/location.cmx parsing/lexer.cmx bytecomp/lambda.cmx \
@@ -887,24 +894,22 @@ toplevel/topdirs.cmx: utils/warnings.cmx typing/types.cmx toplevel/trace.cmx \
     parsing/longident.cmx typing/ident.cmx typing/env.cmx bytecomp/dll.cmx \
     typing/ctype.cmx utils/consistbl.cmx utils/config.cmx \
     bytecomp/cmo_format.cmi utils/clflags.cmx toplevel/topdirs.cmi
-toplevel/toploop.cmo: utils/warnings.cmi typing/unused_var.cmi \
-    typing/types.cmi typing/typemod.cmi typing/typedtree.cmi \
-    typing/typecore.cmi bytecomp/translmod.cmi bytecomp/symtable.cmi \
-    bytecomp/simplif.cmi typing/printtyp.cmi bytecomp/printlambda.cmi \
-    bytecomp/printinstr.cmi parsing/printast.cmi typing/predef.cmi \
-    typing/path.cmi parsing/parsetree.cmi parsing/parse.cmi \
+toplevel/toploop.cmo: utils/warnings.cmi typing/types.cmi typing/typemod.cmi \
+    typing/typedtree.cmi typing/typecore.cmi bytecomp/translmod.cmi \
+    bytecomp/symtable.cmi bytecomp/simplif.cmi typing/printtyp.cmi \
+    bytecomp/printlambda.cmi bytecomp/printinstr.cmi parsing/printast.cmi \
+    typing/predef.cmi typing/path.cmi parsing/parsetree.cmi parsing/parse.cmi \
     typing/outcometree.cmi typing/oprint.cmi utils/misc.cmi bytecomp/meta.cmi \
     parsing/longident.cmi parsing/location.cmi parsing/lexer.cmi \
     typing/ident.cmi toplevel/genprintval.cmi driver/errors.cmi \
     typing/env.cmi bytecomp/emitcode.cmi bytecomp/dll.cmi utils/consistbl.cmi \
     utils/config.cmi driver/compile.cmi utils/clflags.cmi \
     bytecomp/bytegen.cmi typing/btype.cmi toplevel/toploop.cmi
-toplevel/toploop.cmx: utils/warnings.cmx typing/unused_var.cmx \
-    typing/types.cmx typing/typemod.cmx typing/typedtree.cmx \
-    typing/typecore.cmx bytecomp/translmod.cmx bytecomp/symtable.cmx \
-    bytecomp/simplif.cmx typing/printtyp.cmx bytecomp/printlambda.cmx \
-    bytecomp/printinstr.cmx parsing/printast.cmx typing/predef.cmx \
-    typing/path.cmx parsing/parsetree.cmi parsing/parse.cmx \
+toplevel/toploop.cmx: utils/warnings.cmx typing/types.cmx typing/typemod.cmx \
+    typing/typedtree.cmx typing/typecore.cmx bytecomp/translmod.cmx \
+    bytecomp/symtable.cmx bytecomp/simplif.cmx typing/printtyp.cmx \
+    bytecomp/printlambda.cmx bytecomp/printinstr.cmx parsing/printast.cmx \
+    typing/predef.cmx typing/path.cmx parsing/parsetree.cmi parsing/parse.cmx \
     typing/outcometree.cmi typing/oprint.cmx utils/misc.cmx bytecomp/meta.cmx \
     parsing/longident.cmx parsing/location.cmx parsing/lexer.cmx \
     typing/ident.cmx toplevel/genprintval.cmx driver/errors.cmx \
diff --git a/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml b/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml
index 9e3a83ddbc..0200d18969 100644
--- a/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml
+++ b/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml
@@ -880,13 +880,6 @@ value varify_constructors var_names =
       in
       let vars = id_to_string vs in
       let ampersand_vars = List.map (fun x -> "&" ^ x) vars in
-      let rec merge_quoted_vars lst = 
-	match lst with
-	  [
-	    [x] -> x
-	  | [x::y] -> <:ctyp<$x$ $merge_quoted_vars y$ >>
-	  | [] -> assert False ]
-      in
       let ty' = varify_constructors vars (ctyp ty) in
       let mkexp = mkexp _loc in
       let mkpat = mkpat _loc in
diff --git a/camlp4/Camlp4/Struct/Grammar/Insert.ml b/camlp4/Camlp4/Struct/Grammar/Insert.ml
index 551ce95ec7..24deb01f58 100644
--- a/camlp4/Camlp4/Struct/Grammar/Insert.ml
+++ b/camlp4/Camlp4/Struct/Grammar/Insert.ml
@@ -256,10 +256,6 @@ module Make (Structure : Structure.S) = struct
                 Some t
             | None -> None ]
       | LocAct _ _ | DeadEnd -> None ]
-    and insert_new =
-      fun
-      [ [s :: sl] -> Node {node = s; son = insert_new sl; brother = DeadEnd}
-      | [] -> LocAct action [] ]
     in
     insert gsymbols tree
   ;
diff --git a/driver/compile.ml b/driver/compile.ml
index 33a198ed83..a27ffaa19b 100644
--- a/driver/compile.ml
+++ b/driver/compile.ml
@@ -126,7 +126,6 @@ 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
diff --git a/driver/optcompile.ml b/driver/optcompile.ml
index ada7d9f71e..1e6ab0ce3f 100644
--- a/driver/optcompile.ml
+++ b/driver/optcompile.ml
@@ -119,12 +119,10 @@ 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
diff --git a/otherlibs/labltk/browser/.depend b/otherlibs/labltk/browser/.depend
index 4438a1dd83..5e3e2a2b80 100644
--- a/otherlibs/labltk/browser/.depend
+++ b/otherlibs/labltk/browser/.depend
@@ -10,10 +10,14 @@ fileselect.cmo: useunix.cmi setpath.cmi list2.cmo jg_toplevel.cmo jg_memo.cmi \
     jg_entry.cmo jg_box.cmo fileselect.cmi
 fileselect.cmx: useunix.cmx setpath.cmx list2.cmx jg_toplevel.cmx jg_memo.cmx \
     jg_entry.cmx jg_box.cmx fileselect.cmi
+help.cmo:
+help.cmx:
 jg_bind.cmo: jg_bind.cmi
 jg_bind.cmx: jg_bind.cmi
 jg_box.cmo: jg_completion.cmi jg_bind.cmi
 jg_box.cmx: jg_completion.cmx jg_bind.cmx
+jg_button.cmo:
+jg_button.cmx:
 jg_completion.cmo: jg_completion.cmi
 jg_completion.cmx: jg_completion.cmi
 jg_config.cmo: jg_tk.cmo jg_config.cmi
@@ -22,6 +26,8 @@ jg_entry.cmo: jg_bind.cmi
 jg_entry.cmx: jg_bind.cmx
 jg_memo.cmo: jg_memo.cmi
 jg_memo.cmx: jg_memo.cmi
+jg_menu.cmo:
+jg_menu.cmx:
 jg_message.cmo: jg_toplevel.cmo jg_tk.cmo jg_text.cmi jg_bind.cmi \
     jg_message.cmi
 jg_message.cmx: jg_toplevel.cmx jg_tk.cmx jg_text.cmx jg_bind.cmx \
@@ -30,8 +36,14 @@ jg_multibox.cmo: jg_completion.cmi jg_bind.cmi jg_multibox.cmi
 jg_multibox.cmx: jg_completion.cmx jg_bind.cmx jg_multibox.cmi
 jg_text.cmo: jg_toplevel.cmo jg_tk.cmo jg_button.cmo jg_bind.cmi jg_text.cmi
 jg_text.cmx: jg_toplevel.cmx jg_tk.cmx jg_button.cmx jg_bind.cmx jg_text.cmi
+jg_tk.cmo:
+jg_tk.cmx:
+jg_toplevel.cmo:
+jg_toplevel.cmx:
 lexical.cmo: jg_tk.cmo lexical.cmi
 lexical.cmx: jg_tk.cmx lexical.cmi
+list2.cmo:
+list2.cmx:
 main.cmo: viewer.cmi shell.cmi searchpos.cmi searchid.cmi jg_config.cmi \
     editor.cmi
 main.cmx: viewer.cmx shell.cmx searchpos.cmx searchid.cmx jg_config.cmx \
@@ -62,5 +74,24 @@ viewer.cmx: useunix.cmx shell.cmx setpath.cmx searchpos.cmx searchid.cmx \
     mytypes.cmi jg_toplevel.cmx jg_tk.cmx jg_text.cmx jg_multibox.cmx \
     jg_message.cmx jg_menu.cmx jg_entry.cmx jg_completion.cmx jg_button.cmx \
     jg_box.cmx jg_bind.cmx help.cmx viewer.cmi
+dummy.cmi:
+dummyUnix.cmi:
+dummyWin.cmi:
+editor.cmi:
+fileselect.cmi:
+jg_bind.cmi:
+jg_completion.cmi:
+jg_config.cmi:
+jg_memo.cmi:
+jg_message.cmi:
+jg_multibox.cmi:
+jg_text.cmi:
+lexical.cmi:
 mytypes.cmi: shell.cmi
+searchid.cmi:
+searchpos.cmi:
+setpath.cmi:
+shell.cmi:
 typecheck.cmi: mytypes.cmi
+useunix.cmi:
+viewer.cmi:
diff --git a/toplevel/opttoploop.ml b/toplevel/opttoploop.ml
index aa40840f07..1fa5a3fd08 100644
--- a/toplevel/opttoploop.ml
+++ b/toplevel/opttoploop.ml
@@ -225,7 +225,6 @@ let execute_phrase print_outcome ppf phr =
       incr phrase_seqid;
       phrase_name := Printf.sprintf "TOP%i" !phrase_seqid;
       Compilenv.reset ?packname:None !phrase_name;
-      let _ = Unused_var.warn ppf sstr in
       Typecore.reset_delayed_checks ();
       let (str, sg, newenv) = Typemod.type_structure oldenv sstr Location.none
       in
diff --git a/toplevel/toploop.ml b/toplevel/toploop.ml
index c7c6261695..3d2f72f201 100644
--- a/toplevel/toploop.ml
+++ b/toplevel/toploop.ml
@@ -217,7 +217,6 @@ let execute_phrase print_outcome ppf phr =
   match phr with
   | Ptop_def sstr ->
       let oldenv = !toplevel_env in
-      let _ = Unused_var.warn ppf sstr in
       Typecore.reset_delayed_checks ();
       let (str, sg, newenv) = Typemod.type_structure oldenv sstr Location.none
       in
diff --git a/typing/env.ml b/typing/env.ml
index 08597341e9..64a8963e1b 100644
--- a/typing/env.ml
+++ b/typing/env.ml
@@ -22,6 +22,17 @@ open Path
 open Types
 open Btype
 
+let add_delayed_check_forward = ref (fun _ -> assert false)
+
+let value_declarations : ((string * Location.t), (unit -> unit)) Hashtbl.t = 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). *)
+
+let type_declarations = Hashtbl.create 16
+
+let used_constructors : (string * Location.t * string, (unit -> unit)) Hashtbl.t = Hashtbl.create 16
 
 type error =
     Not_an_interface of string
@@ -44,18 +55,53 @@ type summary =
   | Env_cltype of summary * Ident.t * cltype_declaration
   | Env_open of summary * Path.t
 
+module EnvTbl =
+  struct
+    (* A table indexed by identifier, with an extra slot to record usage. *)
+    type 'a t = 'a Ident.tbl * bool ref Ident.tbl
+
+    let empty = (Ident.empty, Ident.empty)
+    let current_slot = ref (ref true)
+
+    let add id x (tbl, slots) =
+      let slot = !current_slot in
+      let slots = if !slot then slots else Ident.add id slot slots in
+      Ident.add id x tbl, slots
+
+    let find_same_not_using id (tbl, _) =
+      Ident.find_same id tbl
+
+    let find_same id (tbl, slots) =
+      (try Ident.find_same id slots := true with Not_found -> ());
+      Ident.find_same id tbl
+
+    let find_name s (tbl, slots) =
+      (try Ident.find_name s slots := true with Not_found -> ());
+      Ident.find_name s tbl
+
+    let with_slot slot f x =
+      let old_slot = !current_slot in
+      current_slot := slot;
+      try_finally
+        (fun () -> f x)
+        (fun () -> current_slot := old_slot)
+
+    let keys (tbl, _) =
+      Ident.keys tbl
+  end
+
 type t = {
-  values: (Path.t * value_description) Ident.tbl;
-  annotations: (Path.t * Annot.ident) Ident.tbl;
-  constrs: constructor_description Ident.tbl;
-  labels: label_description Ident.tbl;
-  constrs_by_path: (Path.t * (constructor_description list)) Ident.tbl;
-  types: (Path.t * type_declaration) Ident.tbl;
-  modules: (Path.t * module_type) Ident.tbl;
-  modtypes: (Path.t * modtype_declaration) Ident.tbl;
-  components: (Path.t * module_components) Ident.tbl;
-  classes: (Path.t * class_declaration) Ident.tbl;
-  cltypes: (Path.t * cltype_declaration) Ident.tbl;
+  values: (Path.t * value_description) EnvTbl.t;
+  annotations: (Path.t * Annot.ident) EnvTbl.t;
+  constrs: constructor_description EnvTbl.t;
+  labels: label_description EnvTbl.t;
+  constrs_by_path: (Path.t * (constructor_description list)) EnvTbl.t;
+  types: (Path.t * type_declaration) EnvTbl.t;
+  modules: (Path.t * module_type) EnvTbl.t;
+  modtypes: (Path.t * modtype_declaration) EnvTbl.t;
+  components: (Path.t * module_components) EnvTbl.t;
+  classes: (Path.t * class_declaration) EnvTbl.t;
+  cltypes: (Path.t * cltype_declaration) EnvTbl.t;
   summary: summary;
   local_constraints: bool;
   gadt_instances: (int * TypeSet.t ref) list;
@@ -92,20 +138,20 @@ and functor_components = {
 }
 
 let empty = {
-  values = Ident.empty; annotations = Ident.empty; constrs = Ident.empty;
-  labels = Ident.empty; types = Ident.empty; 
-  constrs_by_path = Ident.empty;
-  modules = Ident.empty; modtypes = Ident.empty;
-  components = Ident.empty; classes = Ident.empty;
-  cltypes = Ident.empty; 
+  values = EnvTbl.empty; annotations = EnvTbl.empty; constrs = EnvTbl.empty;
+  labels = EnvTbl.empty; types = EnvTbl.empty; 
+  constrs_by_path = EnvTbl.empty;
+  modules = EnvTbl.empty; modtypes = EnvTbl.empty;
+  components = EnvTbl.empty; classes = EnvTbl.empty;
+  cltypes = EnvTbl.empty; 
   summary = Env_empty; local_constraints = false; gadt_instances = [] }
 
 let diff_keys is_local tbl1 tbl2 =
-  let keys2 = Ident.keys tbl2 in
+  let keys2 = EnvTbl.keys tbl2 in
   List.filter
     (fun id ->
-      is_local (Ident.find_same id tbl2) &&
-      try ignore (Ident.find_same id tbl1); false with Not_found -> true)
+      is_local (EnvTbl.find_same_not_using id tbl2) &&
+      try ignore (EnvTbl.find_same_not_using id tbl1); false with Not_found -> true)
     keys2
 
 let is_ident = function
@@ -224,7 +270,9 @@ 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;
+  Hashtbl.clear type_declarations
 
 let set_unit_name name =
   current_unit := name
@@ -235,7 +283,7 @@ let rec find_module_descr path env =
   match path with
     Pident id ->
       begin try
-        let (p, desc) = Ident.find_same id env.components
+        let (p, desc) = EnvTbl.find_same id env.components
         in desc
       with Not_found ->
         if Ident.persistent id
@@ -261,7 +309,7 @@ let rec find_module_descr path env =
 let find proj1 proj2 path env =
   match path with
     Pident id ->
-      let (p, data) = Ident.find_same id (proj1 env)
+      let (p, data) = EnvTbl.find_same id (proj1 env)
       in data
   | Pdot(p, s, pos) ->
       begin match Lazy.force(find_module_descr p env) with
@@ -323,7 +371,7 @@ let find_module path env =
   match path with
     Pident id ->
       begin try
-        let (p, data) = Ident.find_same id env.modules
+        let (p, data) = EnvTbl.find_same id env.modules
         in data
       with Not_found ->
         if Ident.persistent id then
@@ -347,7 +395,7 @@ let rec lookup_module_descr lid env =
   match lid with
     Lident s ->
       begin try
-        Ident.find_name s env.components
+        EnvTbl.find_name s env.components
       with Not_found ->
         if s = !current_unit then raise Not_found;
         let ps = find_pers_struct s in
@@ -377,7 +425,7 @@ and lookup_module lid env =
   match lid with
     Lident s ->
       begin try
-        Ident.find_name s env.modules
+        EnvTbl.find_name s env.modules
       with Not_found ->
         if s = !current_unit then raise Not_found;
         let ps = find_pers_struct s in
@@ -408,7 +456,7 @@ and lookup_module lid env =
 let lookup proj1 proj2 lid env =
   match lid with
     Lident s ->
-      Ident.find_name s (proj1 env)
+      EnvTbl.find_name s (proj1 env)
   | Ldot(l, s) ->
       let (p, desc) = lookup_module_descr l env in
       begin match Lazy.force desc with
@@ -424,7 +472,7 @@ let lookup proj1 proj2 lid env =
 let lookup_simple proj1 proj2 lid env =
   match lid with
     Lident s ->
-      Ident.find_name s (proj1 env)
+      EnvTbl.find_name s (proj1 env)
   | Ldot(l, s) ->
       let (p, desc) = lookup_module_descr l env in
       begin match Lazy.force desc with
@@ -456,6 +504,82 @@ 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 mark_type_used name vd =
+  try Hashtbl.find type_declarations (name, vd.type_loc) ()
+  with Not_found -> ()
+
+let mark_constructor_used name vd constr =
+  try Hashtbl.find used_constructors (name, vd.type_loc, constr) ()
+  with Not_found -> ()
+
+let set_value_used_callback name vd callback =
+  let key = (name, vd.val_loc) in
+  try
+    let old = Hashtbl.find value_declarations key in
+    Hashtbl.replace value_declarations key (fun () -> old (); callback ())
+      (* this is to support cases like:
+               let x = let x = 1 in x in x
+         where the two declarations have the same location
+         (e.g. resulting from Camlp4 expansion of grammar entries) *)
+  with Not_found ->
+    Hashtbl.add value_declarations key callback
+
+let set_type_used_callback name td callback =
+  let old = try Hashtbl.find type_declarations (name, td.type_loc) with Not_found -> assert false in
+  Hashtbl.replace type_declarations (name, td.type_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
+
+let lookup_type lid env =
+  let (_, desc) as r = lookup_type lid env in
+  mark_type_used (Longident.last lid) desc;
+  r
+
+let mark_type_path env path =
+  let decl = try find_type path env with Not_found -> assert false in
+  mark_type_used (Path.last path) decl
+
+let ty_path = function
+  | {desc=Tconstr(path, _, _)} -> path
+  | _ -> assert false
+
+let lookup_constructor lid env =
+  let desc = lookup_constructor lid env in
+  mark_type_path env (ty_path desc.cstr_res);
+  desc
+
+let mark_constructor env name desc =
+  let ty_path = ty_path desc.cstr_res in
+  let ty_decl = try find_type ty_path env with Not_found -> assert false in
+  let ty_name = Path.last ty_path in
+  mark_constructor_used ty_name ty_decl name
+
+let lookup_label lid env =
+  let desc = lookup_label lid env in
+  mark_type_path env (ty_path desc.lbl_res);
+  desc
+
+let lookup_class lid env =
+  let (_, desc) as r = lookup_class lid env in
+  (* special support for Typeclass.unbound_class *)
+  if Path.name desc.cty_path = "" then ignore (lookup_type lid env)
+  else mark_type_path env desc.cty_path;
+  r
+
+let lookup_cltype lid env =
+  let (_, desc) as r = lookup_cltype lid env in
+  if Path.name desc.clty_path = "" then ignore (lookup_type lid env)
+  else mark_type_path env desc.clty_path;
+  mark_type_path env desc.clty_path;
+  r
+
 (* GADT instance tracking *)
 
 let add_gadt_instance_level lv env =
@@ -676,38 +800,71 @@ let rec components_of_module env sub path mty =
 
 (* Insertion of bindings by identifier + path *)
 
-and store_value id path decl env =
+and check_usage loc id warn tbl =
+  if not loc.Location.loc_ghost && Warnings.is_active (warn "") then begin
+    let name = Ident.name id in
+    let key = (name, loc) in
+    if Hashtbl.mem tbl key then ()
+    else let used = ref false in
+    Hashtbl.add tbl key (fun () -> used := true);
+    if not (name = "" || name.[0] = '_' || name.[0] = '#')
+    then
+      !add_delayed_check_forward
+        (fun () -> if not !used then Location.prerr_warning loc (warn name))
+  end;
+
+and store_value ?check id path decl env =
+  begin match check with Some f -> check_usage decl.val_loc id f value_declarations | None -> () end;
   { env with
-    values = Ident.add id (path, decl) env.values;
+    values = EnvTbl.add id (path, decl) env.values;
     summary = Env_value(env.summary, id, decl) }
 
 and store_annot id path annot env =
   if !Clflags.annotations then
     { env with
-      annotations = Ident.add id (path, annot) env.annotations }
+      annotations = EnvTbl.add id (path, annot) env.annotations }
   else env
 
 and store_type id path info env =
+  let loc = info.type_loc in
+  check_usage loc id (fun s -> Warnings.Unused_type_declaration s) type_declarations;
   let constructors = constructors_of_type path info in
-  let labels = labels_of_type path info in 
+  let labels = labels_of_type path info in
+
+  if not loc.Location.loc_ghost && Warnings.is_active (Warnings.Unused_constructor "") then begin
+    let ty = Ident.name id in
+    List.iter
+      (fun (c, _) ->
+        let k = (ty, loc, c) in
+        if not (Hashtbl.mem used_constructors k) then
+          let used = ref false in
+          Hashtbl.add used_constructors k (fun () -> used := true);
+          !add_delayed_check_forward
+            (fun () ->
+              if not !used then
+                Location.prerr_warning loc (Warnings.Unused_constructor c)
+            )
+         )
+      constructors
+  end;
   { env with
     constrs =
       List.fold_right
         (fun (name, descr) constrs ->
-          Ident.add (Ident.create name) descr constrs)
+          EnvTbl.add (Ident.create name) descr constrs)
         constructors 
         env.constrs;
 
     constrs_by_path = 
-      Ident.add id 
+      EnvTbl.add id 
         (path,List.map snd constructors) env.constrs_by_path;
     labels =
       List.fold_right
         (fun (name, descr) labels ->
-          Ident.add (Ident.create name) descr labels)
+          EnvTbl.add (Ident.create name) descr labels)
         labels
         env.labels;
-    types = Ident.add id (path, info) env.types;
+    types = EnvTbl.add id (path, info) env.types;
     summary = Env_type(env.summary, id, info) }
 
 and store_type_infos id path info env =
@@ -717,35 +874,35 @@ and store_type_infos id path info env =
      keep track of type abbreviations (e.g. type t = float) in the
      computation of label representations. *)
   { env with
-    types = Ident.add id (path, info) env.types;
+    types = EnvTbl.add id (path, info) env.types;
     summary = Env_type(env.summary, id, info) }
 
 and store_exception id path decl env =
   { env with
-    constrs = Ident.add id (Datarepr.exception_descr path decl) env.constrs;
+    constrs = EnvTbl.add id (Datarepr.exception_descr path decl) env.constrs;
     summary = Env_exception(env.summary, id, decl) }
 
 and store_module id path mty env =
   { env with
-    modules = Ident.add id (path, mty) env.modules;
+    modules = EnvTbl.add id (path, mty) env.modules;
     components =
-      Ident.add id (path, components_of_module env Subst.identity path mty)
+      EnvTbl.add id (path, components_of_module env Subst.identity path mty)
                    env.components;
     summary = Env_module(env.summary, id, mty) }
 
 and store_modtype id path info env =
   { env with
-    modtypes = Ident.add id (path, info) env.modtypes;
+    modtypes = EnvTbl.add id (path, info) env.modtypes;
     summary = Env_modtype(env.summary, id, info) }
 
 and store_class id path desc env =
   { env with
-    classes = Ident.add id (path, desc) env.classes;
+    classes = EnvTbl.add id (path, desc) env.classes;
     summary = Env_class(env.summary, id, desc) }
 
 and store_cltype id path desc env =
   { env with
-    cltypes = Ident.add id (path, desc) env.cltypes;
+    cltypes = EnvTbl.add id (path, desc) env.cltypes;
     summary = Env_cltype(env.summary, id, desc) }
 
 (* Compute the components of a functor application in a path. *)
@@ -770,8 +927,8 @@ let _ =
 
 (* Insertion of bindings by identifier *)
 
-let add_value id desc env =
-  store_value id (Pident id) desc env
+let add_value ?check id desc env =
+  store_value ?check id (Pident id) desc env
 
 let add_annot id annot env =
   store_annot id (Pident id) annot env
@@ -808,7 +965,7 @@ let add_local_constraint id info elv env =
 let enter store_fun name data env =
   let id = Ident.create name in (id, store_fun id (Pident id) data env)
 
-let enter_value = enter store_value
+let enter_value ?check = enter (store_value ?check)
 and enter_type = enter store_type
 and enter_exception = enter store_exception
 and enter_module = enter store_module
@@ -873,6 +1030,18 @@ let open_pers_signature name env =
   let ps = find_pers_struct name in
   open_signature (Pident(Ident.create_persistent name)) ps.ps_sig env
 
+let open_signature ?(loc = Location.none) root sg env =
+  if not loc.Location.loc_ghost && Warnings.is_active (Warnings.Unused_open "") then begin
+    let used = ref false in
+    !add_delayed_check_forward
+      (fun () ->
+        if not !used then
+          Location.prerr_warning loc (Warnings.Unused_open (Path.name root))
+      );
+    EnvTbl.with_slot used (open_signature root sg) env
+  end else
+    open_signature root sg env
+
 (* Read a signature from a file *)
 
 let read_signature modname filename =
diff --git a/typing/env.mli b/typing/env.mli
index 4e822de83e..9323047c35 100644
--- a/typing/env.mli
+++ b/typing/env.mli
@@ -60,7 +60,7 @@ val lookup_cltype: Longident.t -> t -> Path.t * cltype_declaration
 
 (* Insertion by identifier *)
 
-val add_value: Ident.t -> value_description -> t -> t
+val add_value: ?check:(string -> Warnings.t) -> Ident.t -> value_description -> t -> t
 val add_annot: Ident.t -> Annot.ident -> t -> t
 val add_type: Ident.t -> type_declaration -> t -> t
 val add_exception: Ident.t -> exception_declaration -> t -> t
@@ -78,12 +78,12 @@ val add_signature: signature -> t -> t
 (* Insertion of all fields of a signature, relative to the given path.
    Used to implement open. *)
 
-val open_signature: Path.t -> signature -> t -> t
+val open_signature: ?loc:Location.t -> Path.t -> signature -> t -> t
 val open_pers_signature: string -> t -> t
 
 (* Insertion by name *)
 
-val enter_value: string -> value_description -> t -> Ident.t * t
+val enter_value: ?check:(string -> Warnings.t) -> string -> value_description -> t -> Ident.t * t
 val enter_type: string -> type_declaration -> t -> Ident.t * t
 val enter_exception: string -> exception_declaration -> t -> Ident.t * t
 val enter_module: string -> module_type -> t -> Ident.t * t
@@ -152,6 +152,16 @@ open Format
 
 val report_error: formatter -> error -> unit
 
+val mark_value_used: string -> value_description -> unit
+val mark_type_used: string -> type_declaration -> unit
+val mark_constructor_used: string -> type_declaration -> string -> unit
+val mark_constructor: t -> string -> constructor_description -> unit
+
+val set_value_used_callback: string -> value_description -> (unit -> unit) -> unit
+val set_type_used_callback: string -> type_declaration -> ((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/includecore.ml b/typing/includecore.ml
index 78348eb408..7f319af1fb 100644
--- a/typing/includecore.ml
+++ b/typing/includecore.ml
@@ -206,6 +206,11 @@ let type_declarations env id decl1 decl2 =
   let err = match (decl1.type_kind, decl2.type_kind) with
       (_, Type_abstract) -> []
     | (Type_variant cstrs1, Type_variant cstrs2) ->
+        let name = Ident.name id in
+        if decl1.type_private = Private || decl2.type_private = Public then
+          List.iter
+            (fun (c, _, _) -> Env.mark_constructor_used name decl1 c)
+            cstrs1;
         compare_variants env decl1 decl2 1 cstrs1 cstrs2
     | (Type_record(labels1,rep1), Type_record(labels2,rep2)) ->
         let err = compare_records env decl1 decl2 1 labels1 labels2 in
diff --git a/typing/includemod.ml b/typing/includemod.ml
index 70112c7b27..644a4d9a1f 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
@@ -60,6 +61,7 @@ let value_descriptions env cxt subst id vd1 vd2 =
 (* Inclusion between type declarations *)
 
 let type_declarations env cxt subst id decl1 decl2 =
+  Env.mark_type_used (Ident.name id) decl1;
   let decl2 = Subst.type_declaration subst decl2 in
   let err = Includecore.type_declarations env id decl1 decl2 in
   if err <> [] then raise(Error[cxt, Type_declarations(id, decl1, decl2, err)])
diff --git a/typing/path.ml b/typing/path.ml
index b4c1b16ad8..7dc821a1e3 100644
--- a/typing/path.ml
+++ b/typing/path.ml
@@ -49,3 +49,8 @@ let rec head = function
     Pident id -> id
   | Pdot(p, s, pos) -> head p
   | Papply(p1, p2) -> assert false
+
+let rec last = function
+  | Pident id -> Ident.name id
+  | Pdot(_, s, _) -> s
+  | Papply(_, p) -> last p
diff --git a/typing/path.mli b/typing/path.mli
index a76f7e1a98..bdcc6ccabe 100644
--- a/typing/path.mli
+++ b/typing/path.mli
@@ -28,3 +28,5 @@ val nopos: int
 val name: ?paren:(string -> bool) -> t -> string
     (* [paren] tells whether a path suffix needs parentheses *)
 val head: t -> Ident.t
+
+val last: t -> string
diff --git a/typing/typeclass.ml b/typing/typeclass.ml
index 0364de9bf7..512f7cf8b2 100644
--- a/typing/typeclass.ml
+++ b/typing/typeclass.ml
@@ -192,13 +192,13 @@ let rc node =
 
 
 (* Enter a value in the method environment only *)
-let enter_met_env lab kind ty val_env met_env par_env =
+let enter_met_env ?check loc lab kind ty val_env met_env par_env =
   let (id, val_env) =
-    Env.enter_value lab {val_type = ty; val_kind = Val_unbound; val_loc = Location.none} val_env
+    Env.enter_value lab {val_type = ty; val_kind = Val_unbound; val_loc = loc} val_env
   in
   (id, val_env,
-   Env.add_value id {val_type = ty; val_kind = kind; val_loc = Location.none} met_env,
-   Env.add_value id {val_type = ty; val_kind = Val_unbound; val_loc = Location.none} par_env)
+   Env.add_value ?check id {val_type = ty; val_kind = kind; val_loc = loc} met_env,
+   Env.add_value id {val_type = ty; val_kind = Val_unbound; val_loc = loc} par_env)
 
 (* Enter an instance variable in the environment *)
 let enter_val cl_num vars inh lab mut virt ty val_env met_env par_env loc =
@@ -218,7 +218,7 @@ let enter_val cl_num vars inh lab mut virt ty val_env met_env par_env loc =
   let (id, _, _, _) as result =
     match id with Some id -> (id, val_env, met_env, par_env)
     | None ->
-        enter_met_env lab (Val_ivar (mut, cl_num)) ty val_env met_env par_env
+        enter_met_env Location.none lab (Val_ivar (mut, cl_num)) ty val_env met_env par_env
   in
   vars := Vars.add lab (id, mut, virt, ty) !vars;
   result
@@ -462,7 +462,8 @@ let rec class_field cl_num self_type meths vars
             (val_env, met_env, par_env)
         | Some name ->
             let (id, val_env, met_env, par_env) =
-              enter_met_env name (Val_anc (inh_meths, cl_num)) self_type
+              enter_met_env ~check:(fun s -> Warnings.Unused_ancestor s)
+                sparent.pcl_loc name (Val_anc (inh_meths, cl_num)) self_type
                 val_env met_env par_env
             in
             (val_env, met_env, par_env)
@@ -772,10 +773,16 @@ and class_expr cl_num val_env met_env scl =
       let pv =
         List.map
           (function (id, id', ty) ->
+            let path = Pident id' in
+            let vd = Env.find_value path val_env' (* do not mark the value as being used *) in
             (id,
-             Typecore.type_exp val_env'
-               {pexp_desc = Pexp_ident (Longident.Lident (Ident.name id));
-                pexp_loc = Location.none}))
+             {
+              exp_desc = Texp_ident(path, vd);
+              exp_loc = Location.none;
+              exp_type = Ctype.instance val_env' vd.val_type;
+              exp_env = val_env'
+             })
+          )
           pv
       in
       let rec not_function = function
@@ -900,18 +907,23 @@ and class_expr cl_num val_env met_env scl =
       let (vals, met_env) =
         List.fold_right
           (fun id (vals, met_env) ->
+             let path = Pident id in
+             let vd = Env.find_value path val_env in (* do not mark the value as used *)
              Ctype.begin_def ();
              let expr =
-               Typecore.type_exp val_env
-                 {pexp_desc = Pexp_ident (Longident.Lident (Ident.name id));
-                  pexp_loc = Location.none}
+               {
+                exp_desc = Texp_ident(path, vd);
+                exp_loc = Location.none;
+                exp_type = Ctype.instance val_env vd.val_type;
+                exp_env = val_env;
+               }
              in
              Ctype.end_def ();
              Ctype.generalize expr.exp_type;
              let desc =
                {val_type = expr.exp_type; val_kind = Val_ivar (Immutable,
                                                                cl_num);
-                val_loc = Location.none;
+                val_loc = vd.val_loc;
                }
              in
              let id' = Ident.create (Ident.name id) in
@@ -981,7 +993,7 @@ let rec approx_description ct =
 
 (*******************************)
 
-let temp_abbrev env id arity =
+let temp_abbrev loc env id arity =
   let params = ref [] in
   for i = 1 to arity do
     params := Ctype.newvar () :: !params
@@ -996,7 +1008,7 @@ let temp_abbrev env id arity =
        type_manifest = Some ty;
        type_variance = List.map (fun _ -> true, true, true) !params;
        type_newtype_level = None;
-       type_loc = Location.none;
+       type_loc = loc;
       }
       env
   in
@@ -1006,8 +1018,8 @@ let rec initial_env define_class approx
     (res, env) (cl, id, ty_id, obj_id, cl_id) =
   (* Temporary abbreviations *)
   let arity = List.length (fst cl.pci_params) in
-  let (obj_params, obj_ty, env) = temp_abbrev env obj_id arity in
-  let (cl_params, cl_ty, env) = temp_abbrev env cl_id arity in
+  let (obj_params, obj_ty, env) = temp_abbrev cl.pci_loc env obj_id arity in
+  let (cl_params, cl_ty, env) = temp_abbrev cl.pci_loc env cl_id arity in
 
   (* Temporary type for the class constructor *)
   let constr_type = approx cl.pci_expr in
diff --git a/typing/typecore.ml b/typing/typecore.ml
index 1db16e0c93..9a7a1d849e 100644
--- a/typing/typecore.ml
+++ b/typing/typecore.ml
@@ -242,7 +242,7 @@ let has_variants p =
 
 
 (* pattern environment *)
-let pattern_variables = ref ([]: (Ident.t * type_expr * Location.t) list)
+let pattern_variables = ref ([]: (Ident.t * type_expr * Location.t * bool (* as-variable *)) list)
 let pattern_force = ref ([] : (unit -> unit) list)
 let pattern_scope = ref (None : Annot.ident option);;
 let allow_modules = ref false
@@ -255,11 +255,11 @@ let reset_pattern scope allow =
   module_variables := [];
 ;;
 
-let enter_variable ?(is_module=false) loc name ty =
-  if List.exists (fun (id, _, _) -> Ident.name id = name) !pattern_variables
+let enter_variable ?(is_module=false) ?(is_as_variable=false) loc name ty =
+  if List.exists (fun (id, _, _, _) -> Ident.name id = name) !pattern_variables
   then raise(Error(loc, Multiply_bound_variable name));
   let id = Ident.create name in
-  pattern_variables := (id, ty, loc) :: !pattern_variables;
+  pattern_variables := (id, ty, loc, is_as_variable) :: !pattern_variables;
   if is_module then begin
     (* Note: unpack patterns enter a variable of the same name *)
     if not !allow_modules then raise (Error (loc, Modules_not_allowed));
@@ -273,7 +273,7 @@ let enter_variable ?(is_module=false) loc name ty =
 
 let sort_pattern_variables vs =
   List.sort
-    (fun (x,_,_) (y,_,_) -> Pervasives.compare (Ident.name x) (Ident.name y))
+    (fun (x,_,_,_) (y,_,_,_) -> Pervasives.compare (Ident.name x) (Ident.name y))
     vs
 
 let enter_orpat_variables loc env  p1_vs p2_vs =
@@ -283,7 +283,7 @@ let enter_orpat_variables loc env  p1_vs p2_vs =
   and p2_vs = sort_pattern_variables p2_vs in
 
   let rec unify_vars p1_vs p2_vs = match p1_vs, p2_vs with
-      | (x1,t1,l1)::rem1, (x2,t2,l2)::rem2 when Ident.equal x1 x2 ->
+      | (x1,t1,l1,a1)::rem1, (x2,t2,l2,a2)::rem2 when Ident.equal x1 x2 ->
           if x1==x2 then
             unify_vars rem1 rem2
           else begin
@@ -296,9 +296,9 @@ let enter_orpat_variables loc env  p1_vs p2_vs =
           (x2,x1)::unify_vars rem1 rem2
           end
       | [],[] -> []
-      | (x,_,_)::_, [] -> raise (Error (loc, Orpat_vars x))
-      | [],(x,_,_)::_  -> raise (Error (loc, Orpat_vars x))
-      | (x,_,_)::_, (y,_,_)::_ ->
+      | (x,_,_,_)::_, [] -> raise (Error (loc, Orpat_vars x))
+      | [],(x,_,_,_)::_  -> raise (Error (loc, Orpat_vars x))
+      | (x,_,_,_)::_, (y,_,_,_)::_ ->
           let min_var =
             if Ident.name x < Ident.name y then x
             else y in
@@ -537,7 +537,7 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty =
       let ty_var = build_as_type !env q in
       end_def ();
       generalize ty_var;
-      let id = enter_variable loc name ty_var in
+      let id = enter_variable ~is_as_variable:true loc name ty_var in
       rp {
         pat_desc = Tpat_alias(q, id);
         pat_loc = loc;
@@ -735,15 +735,12 @@ let rec iter3 f lst1 lst2 lst3 =
   | _ ->
       assert false
 
-let get_ref r =
-  let v = !r in
-  r := []; v
-
-let add_pattern_variables env =
+let add_pattern_variables ?check ?check_as env =
   let pv = get_ref pattern_variables in
   (List.fold_right
-    (fun (id, ty, loc) env ->
-       let e1 = Env.add_value id {val_type = ty; val_kind = Val_reg; val_loc = loc} env in
+    (fun (id, ty, loc, as_var) env ->
+       let check = if as_var then check_as else check in
+       let e1 = Env.add_value ?check id {val_type = ty; val_kind = Val_reg; val_loc = loc} env in
        Env.add_annot id (Annot.Iref_internal loc) e1
     )
     pv env,
@@ -753,7 +750,7 @@ let type_pattern ~lev env spat scope expected_ty =
   reset_pattern scope true;
   let new_env = ref env in
   let pat = type_pat ~allow_existentials:true ~lev new_env spat expected_ty in
-  let new_env, unpacks = add_pattern_variables !new_env in
+  let new_env, unpacks = add_pattern_variables ~check:(fun s -> Warnings.Unused_var_strict s) ~check_as:(fun s -> Warnings.Unused_var s) !new_env in
   (pat, new_env, get_ref pattern_force, unpacks)
 
 let type_pattern_list env spatl scope expected_tys allow =
@@ -775,13 +772,14 @@ let type_class_arg_pattern cl_num val_env met_env l spat =
   if is_optional l then unify_pat val_env pat (type_option (newvar ()));
   let (pv, met_env) =
     List.fold_right
-      (fun (id, ty, loc) (pv, env) ->
+      (fun (id, ty, loc, as_var) (pv, env) ->
+         let check s = if as_var then Warnings.Unused_var s else Warnings.Unused_var_strict s in
          let id' = Ident.create (Ident.name id) in
          ((id', id, ty)::pv,
           Env.add_value id' {val_type = ty;
                              val_kind = Val_ivar (Immutable, cl_num);
                              val_loc = loc;
-                            }
+                            } ~check
             env))
       !pattern_variables ([], met_env)
   in
@@ -805,7 +803,7 @@ let type_self_pattern cl_num privty val_env met_env par_env spat =
   pattern_variables := [];
   let (val_env, met_env, par_env) =
     List.fold_right
-      (fun (id, ty, loc) (val_env, met_env, par_env) ->
+      (fun (id, ty, loc, as_var) (val_env, met_env, par_env) ->
          (Env.add_value id {val_type = ty;
                             val_kind = Val_unbound;
                             val_loc = loc;
@@ -814,6 +812,7 @@ let type_self_pattern cl_num privty val_env met_env par_env spat =
                             val_kind = Val_self (meths, vars, cl_num, privty);
                             val_loc = loc;
                            }
+            ~check:(fun s -> if as_var then Warnings.Unused_var s else Warnings.Unused_var_strict s)
             met_env,
           Env.add_value id {val_type = ty; val_kind = Val_unbound;
                             val_loc = loc;
@@ -1282,6 +1281,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 ->
@@ -1708,7 +1708,9 @@ and type_expect ?in_function env sexp ty_expected =
         Env.enter_value param {val_type = instance_def Predef.type_int;
                                val_kind = Val_reg;
                                val_loc = loc;
-                              } env in
+                              } env
+          ~check:(fun s -> Warnings.Unused_for_index s)
+      in
       let body = type_statement new_env sbody in
       rue {
         exp_desc = Texp_for(id, low, high, dir, body);
@@ -2437,6 +2439,7 @@ and type_application env funct sargs =
 
 and type_construct env loc lid sarg explicit_arity ty_expected =
   let constr = Typetexp.find_constructor env loc lid in
+  Env.mark_constructor env (Longident.last lid) constr;
   let sargs =
     match sarg with
       None -> []
@@ -2612,9 +2615,19 @@ and type_cases ?in_function env ty_arg ty_res partial_flag loc caselist =
 
 (* Typing of let bindings *)
 
-and type_let env rec_flag spat_sexp_list scope allow =
+and type_let ?(check = fun s -> Warnings.Unused_var s) ?(check_strict = fun s -> Warnings.Unused_var_strict s) env rec_flag spat_sexp_list scope allow =
   begin_def();
   if !Clflags.principal then begin_def ();
+
+  let is_fake_let =
+    match spat_sexp_list with
+    | [_, {pexp_desc=Pexp_match({pexp_desc=Pexp_ident(Longident.Lident "*opt*")},_)}] ->
+        true (* the fake let-declaration introduced by fun ?(x = e) -> ... *)
+    | _ ->
+        false
+  in
+  let check = if is_fake_let then check_strict else check in
+
   let spatl =
     List.map
       (fun (spat, sexp) ->
@@ -2633,7 +2646,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 =
@@ -2664,12 +2678,67 @@ 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 (check "") || Warnings.is_active (check_strict "") 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.
+
+       We also keep track of whether *all* variables in a given pattern are unused.
+       If this is the case, for local declarations, the issued warning is 26, not 27.
+     *)
+    List.map
+      (fun pat ->
+        if not warn_unused then pat, None
+        else
+          let some_used = ref false in (* has one of the identifier of this pattern been used? *)
+          let slot = ref [] 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
+              let used = ref false in
+              if not (name = "" || name.[0] = '_' || name.[0] = '#') then
+                add_delayed_check
+                  (fun () ->
+                    if not !used then
+                      Location.prerr_warning vd.val_loc
+                        ((if !some_used then check_strict else check) name)
+                  );
+              Env.set_value_used_callback
+                name vd
+                (fun () ->
+                  match !current_slot with
+                  | Some slot -> slot := (name, vd) :: !slot
+                  | None ->
+                      List.iter
+                        (fun (name, vd) -> Env.mark_value_used name vd)
+                        (get_ref slot);
+                      used := true;
+                      some_used := true
+                )
+            )
+            (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
+        if is_recursive then current_slot := slot;
         match pat.pat_type.desc with
         | Tpoly (ty, tl) ->
             begin_def ();
@@ -2684,7 +2753,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;
@@ -2701,15 +2771,21 @@ and type_let env rec_flag spat_sexp_list scope allow =
 
 (* Typing of toplevel bindings *)
 
+let type_binding env rec_flag spat_sexp_list scope =
+  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)
+      env rec_flag spat_sexp_list scope false
+  in
+  (pat_exp_list, new_env)
+
 let type_let env rec_flag spat_sexp_list scope =
   let (pat_exp_list, new_env, unpacks) =
     type_let env rec_flag spat_sexp_list scope false in
   (pat_exp_list, new_env)
 
-let type_binding env rec_flag spat_sexp_list scope =
-  Typetexp.reset_type_variables();
-  type_let env rec_flag spat_sexp_list scope
-
 (* Typing of toplevel expressions *)
 
 let type_expression env sexp =
@@ -2897,3 +2973,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/typedecl.ml b/typing/typedecl.ml
index 7929a6143c..315e066d16 100644
--- a/typing/typedecl.ml
+++ b/typing/typedecl.ml
@@ -749,8 +749,28 @@ let transl_type_decl env name_sdecl_list =
   (* Enter types. *)
   let temp_env = List.fold_left2 enter_type env name_sdecl_list id_list in
   (* Translate each declaration. *)
-  let decls =
-    List.map2 (transl_declaration temp_env) name_sdecl_list id_list in
+  let current_slot = ref None in
+  let warn_unused = Warnings.is_active (Warnings.Unused_type_declaration "") in
+  let id_slots id =
+    if not warn_unused then id, None
+    else
+      (* See typecore.ml for a description of the algorithm used
+         to detect unused declarations in a set of recursive definitions. *)
+      let slot = ref [] in
+      let td = Env.find_type (Path.Pident id) temp_env in
+      let name = Ident.name id in
+      Env.set_type_used_callback
+        name td
+        (fun old_callback ->
+          match !current_slot with
+          | Some slot -> slot := (name, td) :: !slot
+          | None -> List.iter (fun (name, d) -> Env.mark_type_used name d) (get_ref slot); old_callback ()
+        );
+      id, Some slot
+  in
+  let transl_declaration name_sdecl (id, slot) = current_slot := slot; transl_declaration temp_env name_sdecl id in
+  let decls = List.map2 transl_declaration name_sdecl_list (List.map id_slots id_list) in
+  current_slot := None;
   (* Check for duplicates *)
   check_duplicates name_sdecl_list;
   (* Build the final env. *)
diff --git a/typing/typedtree.mli b/typing/typedtree.mli
index dc87885a24..0c5efa8ea8 100644
--- a/typing/typedtree.mli
+++ b/typing/typedtree.mli
@@ -161,6 +161,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 f29c6bffb7..506784865a 100644
--- a/typing/typemod.ml
+++ b/typing/typemod.ml
@@ -62,7 +62,7 @@ let extract_sig_open env loc mty =
 let type_open env loc lid =
   let (path, mty) = Typetexp.find_module env loc lid in
   let sg = extract_sig_open env loc mty in
-  Env.open_signature path sg env
+  Env.open_signature ~loc path sg env
 
 (* Record a module type *)
 let rm node =
@@ -382,7 +382,7 @@ and transl_signature env sg =
         match item.psig_desc with
         | Psig_value(name, sdesc) ->
             let desc = Typedecl.transl_value_decl env item.psig_loc sdesc in
-            let (id, newenv) = Env.enter_value name desc env in
+            let (id, newenv) = Env.enter_value ~check:(fun s -> Warnings.Unused_value_declaration s) name desc env in
             let rem = transl_sig newenv srem in
             if List.exists (Ident.equal id) (get_values rem) then rem
             else Tsig_value(id, desc) :: rem
@@ -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,
@@ -823,7 +825,7 @@ and type_structure funct_body anchor env sstr scope =
          final_env)
     | {pstr_desc = Pstr_primitive(name, sdesc); pstr_loc = loc} :: srem ->
         let desc = Typedecl.transl_value_decl env loc sdesc in
-        let (id, newenv) = Env.enter_value name desc env in
+        let (id, newenv) = Env.enter_value ~check:(fun s -> Warnings.Unused_value_declaration s) name desc env in
         let (str_rem, sig_rem, final_env) = type_struct newenv srem in
         (Tstr_primitive(id, desc) :: str_rem,
          Tsig_value(id, desc) :: sig_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/typing/unused_var.ml b/typing/unused_var.ml
index 21f7317431..3a6eeaeb50 100644
--- a/typing/unused_var.ml
+++ b/typing/unused_var.ml
@@ -14,6 +14,8 @@
 
 open Parsetree
 
+(* TODO: simpler implementation for free_idents *)
+
 let silent v = String.length v > 0 && v.[0] = '_';;
 
 let add_vars tbl (vll1, vll2) =
@@ -275,15 +277,6 @@ and class_field ppf tbl cf =
   | Pcf_init e -> expression ppf tbl e;
 ;;
 
-let warn ppf ast =
-  if Warnings.is_active (w_suspicious "") || Warnings.is_active (w_strict "")
-  then begin
-    let tbl = Hashtbl.create 97 in
-    structure (Ppf ppf) tbl ast;
-  end;
-  ast
-;;
-
 let free_idents e =
   let tbl = Hashtbl.create 7 in
   let idents = ref [] in
diff --git a/typing/unused_var.mli b/typing/unused_var.mli
index dc8137aef5..957fac5d9e 100644
--- a/typing/unused_var.mli
+++ b/typing/unused_var.mli
@@ -12,8 +12,5 @@
 
 (* $Id$ *)
 
-val warn : Format.formatter -> Parsetree.structure -> Parsetree.structure;;
-(* Warn on unused variables; return the second argument. *)
-
 val free_idents : Parsetree.expression -> string list
 (* Conservatively approximate the free variables of an expression. *)
diff --git a/utils/misc.ml b/utils/misc.ml
index 0eab66dc55..c75ac31308 100644
--- a/utils/misc.ml
+++ b/utils/misc.ml
@@ -195,3 +195,7 @@ let rev_split_words s =
       | _ -> split2 res i (j+1)
     end
   in split1 [] 0
+
+let get_ref r =
+  let v = !r in
+  r := []; v
diff --git a/utils/misc.mli b/utils/misc.mli
index fdb4926564..f1b869086b 100644
--- a/utils/misc.mli
+++ b/utils/misc.mli
@@ -102,3 +102,7 @@ val search_substring: string -> string -> int -> int
 val rev_split_words: string -> string list
         (* [rev_split_words s] splits [s] in blank-separated words, and return
            the list of words in reverse order. *)
+
+val get_ref: 'a list ref -> 'a list
+        (* [get_ref lr] returns the content of the list reference [lr] and reset
+           its content to the empty list. *)
diff --git a/utils/warnings.ml b/utils/warnings.ml
index bcd5a3ce50..1f99b63c82 100644
--- a/utils/warnings.ml
+++ b/utils/warnings.ml
@@ -51,6 +51,12 @@ type t =
   | Eol_in_string                           (* 29 *)
   | Duplicate_definitions of string * string * string * string (*30 *)
   | Multiple_definition of string * string * string (* 31 *)
+  | Unused_value_declaration of string      (* 32 *)
+  | Unused_open of string                   (* 33 *)
+  | Unused_type_declaration of string       (* 34 *)
+  | Unused_for_index of string              (* 35 *)
+  | Unused_ancestor of string               (* 36 *)
+  | Unused_constructor of string            (* 37 *)
 ;;
 
 (* If you remove a warning, leave a hole in the numbering.  NEVER change
@@ -91,9 +97,15 @@ let number = function
   | Eol_in_string -> 29
   | Duplicate_definitions _ -> 30
   | Multiple_definition _ -> 31
+  | Unused_value_declaration _ -> 32
+  | Unused_open _ -> 33
+  | Unused_type_declaration _ -> 34
+  | Unused_for_index _ -> 35
+  | Unused_ancestor _ -> 36
+  | Unused_constructor _ -> 37
 ;;
 
-let last_warning_number = 31;;
+let last_warning_number = 37;;
 (* Must be the max number returned by the [number] function. *)
 
 let letter = function
@@ -188,7 +200,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-32-33-34-35-36-37";;
 let defaults_warn_error = "-a";;
 
 let () = parse_options false defaults_w;;
@@ -266,6 +278,12 @@ let message = function
       Printf.sprintf
         "files %s and %s both define a module named %s"
         file1 file2 modname
+  | Unused_value_declaration v -> "unused value " ^ v ^ "."
+  | Unused_open s -> "unused open " ^ s ^ "."
+  | Unused_type_declaration s -> "unused type " ^ s ^ "."
+  | Unused_for_index s -> "unused for-loop index " ^ s ^ "."
+  | Unused_ancestor s -> "unused ancestor variable " ^ s ^ "."
+  | Unused_constructor s -> "unused constructor " ^ s ^ "."
 ;;
 
 let nerrors = ref 0;;
@@ -340,7 +358,13 @@ 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, "A module is linked twice in the same executable";
+   31, "A module is linked twice in the same executable.";
+   32, "Unused value declaration.";
+   33, "Unused open statement.";
+   34, "Unused type declaration.";
+   35, "Unused for-loop index.";
+   36, "Unused ancestor variable.";
+   37, "Unused constructor.";
   ]
 ;;
 
diff --git a/utils/warnings.mli b/utils/warnings.mli
index d9bd4a0348..99c153ffd6 100644
--- a/utils/warnings.mli
+++ b/utils/warnings.mli
@@ -46,6 +46,12 @@ type t =
   | Eol_in_string                           (* 29 *)
   | Duplicate_definitions of string * string * string * string (*30 *)
   | Multiple_definition of string * string * string (* 31 *)
+  | Unused_value_declaration of string      (* 32 *)
+  | Unused_open of string                   (* 33 *)
+  | Unused_type_declaration of string       (* 34 *)
+  | Unused_for_index of string              (* 35 *)
+  | Unused_ancestor of string               (* 36 *)
+  | Unused_constructor of string            (* 37 *)
 ;;
 
 val parse_options : bool -> string -> unit;;