diff options
-rw-r--r-- | .depend | 137 | ||||
-rw-r--r-- | camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml | 7 | ||||
-rw-r--r-- | camlp4/Camlp4/Struct/Grammar/Insert.ml | 4 | ||||
-rw-r--r-- | driver/compile.ml | 1 | ||||
-rw-r--r-- | driver/optcompile.ml | 2 | ||||
-rw-r--r-- | otherlibs/labltk/browser/.depend | 31 | ||||
-rw-r--r-- | toplevel/opttoploop.ml | 1 | ||||
-rw-r--r-- | toplevel/toploop.ml | 1 | ||||
-rw-r--r-- | typing/env.ml | 261 | ||||
-rw-r--r-- | typing/env.mli | 16 | ||||
-rw-r--r-- | typing/includecore.ml | 5 | ||||
-rw-r--r-- | typing/includemod.ml | 2 | ||||
-rw-r--r-- | typing/path.ml | 5 | ||||
-rw-r--r-- | typing/path.mli | 2 | ||||
-rw-r--r-- | typing/typeclass.ml | 46 | ||||
-rw-r--r-- | typing/typecore.ml | 141 | ||||
-rw-r--r-- | typing/typedecl.ml | 24 | ||||
-rw-r--r-- | typing/typedtree.mli | 1 | ||||
-rw-r--r-- | typing/typemod.ml | 18 | ||||
-rw-r--r-- | typing/unused_var.ml | 11 | ||||
-rw-r--r-- | typing/unused_var.mli | 3 | ||||
-rw-r--r-- | utils/misc.ml | 4 | ||||
-rw-r--r-- | utils/misc.mli | 4 | ||||
-rw-r--r-- | utils/warnings.ml | 30 | ||||
-rw-r--r-- | utils/warnings.mli | 6 |
25 files changed, 563 insertions, 200 deletions
@@ -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 9e3a83ddb..0200d1896 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 551ce95ec..24deb01f5 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 33a198ed8..a27ffaa19 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 ada7d9f71..1e6ab0ce3 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 4438a1dd8..5e3e2a2b8 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 aa40840f0..1fa5a3fd0 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 c7c626169..3d2f72f20 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 08597341e..64a8963e1 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 4e822de83..9323047c3 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 78348eb40..7f319af1f 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 70112c7b2..644a4d9a1 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 b4c1b16ad..7dc821a1e 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 a76f7e1a9..bdcc6ccab 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 0364de9bf..512f7cf8b 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 1db16e0c9..9a7a1d849 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 7929a6143..315e066d1 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 dc87885a2..0c5efa8ea 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 f29c6bffb..506784865 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 21f731743..3a6eeaeb5 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 dc8137aef..957fac5d9 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 0eab66dc5..c75ac3130 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 fdb492656..f1b869086 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 bcd5a3ce5..1f99b63c8 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 d9bd4a034..99c153ffd 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;; |