From 900d95913b625f9a7483dfefbf7ea0fbf93bcea2 Mon Sep 17 00:00:00 2001 From: barras Date: Fri, 3 Sep 2004 18:56:25 +0000 Subject: deplacement de clenv vers pretyping git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@6058 85f007b7-540e-0410-9357-904b9bb8a0f7 --- .depend | 235 +++++++++--------- Makefile | 6 +- parsing/printer.ml | 3 + pretyping/clenv.ml | 562 +++++++++++++++++++++++++++++++++++++++++++ pretyping/clenv.mli | 104 ++++++++ pretyping/pretype_errors.ml | 1 + pretyping/pretype_errors.mli | 1 + pretyping/unification.ml | 48 ++-- pretyping/unification.mli | 2 +- proofs/clenv.ml | 562 ------------------------------------------- proofs/clenv.mli | 104 -------- proofs/logic.ml | 8 +- proofs/logic.mli | 1 - proofs/refiner.ml | 4 +- proofs/tacmach.ml | 1 - proofs/tactic_debug.ml | 1 - toplevel/himsg.ml | 14 +- 17 files changed, 828 insertions(+), 829 deletions(-) create mode 100644 pretyping/clenv.ml create mode 100644 pretyping/clenv.mli delete mode 100644 proofs/clenv.ml delete mode 100644 proofs/clenv.mli diff --git a/.depend b/.depend index 885fa8d217..1ebac3f41a 100644 --- a/.depend +++ b/.depend @@ -153,6 +153,9 @@ pretyping/cbv.cmi: kernel/closure.cmi kernel/environ.cmi kernel/esubst.cmi \ pretyping/classops.cmi: library/decl_kinds.cmo kernel/environ.cmi \ pretyping/evd.cmi library/libnames.cmi library/libobject.cmi \ kernel/names.cmi library/nametab.cmi lib/pp.cmi kernel/term.cmi +pretyping/clenv.cmi: pretyping/evd.cmi kernel/names.cmi lib/pp.cmi \ + pretyping/pretyping.cmi pretyping/rawterm.cmi pretyping/reductionops.cmi \ + kernel/sign.cmi kernel/term.cmi pretyping/termops.cmi lib/util.cmi pretyping/coercion.cmi: kernel/environ.cmi pretyping/evarutil.cmi \ pretyping/evd.cmi kernel/names.cmi pretyping/rawterm.cmi kernel/sign.cmi \ kernel/term.cmi lib/util.cmi @@ -201,11 +204,7 @@ pretyping/typing.cmi: kernel/environ.cmi pretyping/evd.cmi kernel/term.cmi pretyping/unification.cmi: kernel/environ.cmi pretyping/evarutil.cmi \ pretyping/evd.cmi kernel/names.cmi pretyping/reductionops.cmi \ kernel/sign.cmi kernel/term.cmi lib/util.cmi -proofs/clenv.cmi: pretyping/evd.cmi kernel/names.cmi lib/pp.cmi \ - pretyping/pretyping.cmi proofs/proof_type.cmi pretyping/rawterm.cmi \ - pretyping/reductionops.cmi kernel/sign.cmi kernel/term.cmi \ - pretyping/termops.cmi lib/util.cmi -proofs/clenvtac.cmi: proofs/clenv.cmi pretyping/evd.cmi kernel/names.cmi \ +proofs/clenvtac.cmi: pretyping/clenv.cmi pretyping/evd.cmi kernel/names.cmi \ proofs/proof_type.cmi kernel/sign.cmi kernel/term.cmi lib/util.cmi proofs/evar_refiner.cmi: kernel/environ.cmi pretyping/evd.cmi \ kernel/names.cmi proofs/proof_type.cmi pretyping/rawterm.cmi \ @@ -234,7 +233,7 @@ proofs/tacmach.cmi: kernel/environ.cmi pretyping/evd.cmi kernel/names.cmi \ proofs/tactic_debug.cmi: kernel/environ.cmi pretyping/evd.cmi \ kernel/names.cmi pretyping/pattern.cmi lib/pp.cmi proofs/proof_type.cmi \ proofs/tacexpr.cmo kernel/term.cmi -tactics/auto.cmi: tactics/btermdn.cmi proofs/clenv.cmi kernel/environ.cmi \ +tactics/auto.cmi: tactics/btermdn.cmi pretyping/clenv.cmi kernel/environ.cmi \ pretyping/evd.cmi library/libnames.cmi kernel/names.cmi \ pretyping/pattern.cmi lib/pp.cmi proofs/proof_type.cmi \ pretyping/rawterm.cmi kernel/sign.cmi proofs/tacexpr.cmo \ @@ -284,10 +283,10 @@ tactics/tacinterp.cmi: parsing/coqast.cmi lib/dyn.cmi kernel/environ.cmi \ lib/pp.cmi proofs/proof_type.cmi proofs/tacexpr.cmo proofs/tacmach.cmi \ pretyping/tacred.cmi proofs/tactic_debug.cmi kernel/term.cmi \ interp/topconstr.cmi lib/util.cmi -tactics/tacticals.cmi: proofs/clenv.cmi interp/genarg.cmi kernel/names.cmi \ +tactics/tacticals.cmi: pretyping/clenv.cmi interp/genarg.cmi kernel/names.cmi \ pretyping/pattern.cmi proofs/proof_type.cmi kernel/reduction.cmi \ kernel/sign.cmi proofs/tacexpr.cmo proofs/tacmach.cmi kernel/term.cmi -tactics/tactics.cmi: proofs/clenv.cmi kernel/environ.cmi \ +tactics/tactics.cmi: pretyping/clenv.cmi kernel/environ.cmi \ proofs/evar_refiner.cmi pretyping/evd.cmi interp/genarg.cmi \ library/libnames.cmi kernel/names.cmi library/nametab.cmi \ proofs/proof_type.cmi pretyping/rawterm.cmi kernel/reduction.cmi \ @@ -423,7 +422,7 @@ contrib/interface/name_to_ast.cmi: parsing/coqast.cmi library/libnames.cmi \ contrib/interface/pbp.cmi: kernel/names.cmi proofs/proof_type.cmi \ proofs/tacexpr.cmo contrib/interface/showproof.cmi: contrib/interface/ascent.cmi \ - proofs/clenv.cmi parsing/coqast.cmi kernel/declarations.cmi \ + pretyping/clenv.cmi parsing/coqast.cmi kernel/declarations.cmi \ kernel/environ.cmi pretyping/evd.cmi kernel/inductive.cmi \ kernel/names.cmi proofs/pfedit.cmi lib/pp.cmi parsing/printer.cmi \ proofs/proof_trees.cmi proofs/proof_type.cmi kernel/reduction.cmi \ @@ -452,20 +451,20 @@ config/coq_config.cmo: config/coq_config.cmi config/coq_config.cmx: config/coq_config.cmi dev/db_printers.cmo: kernel/names.cmi lib/pp.cmi dev/db_printers.cmx: kernel/names.cmx lib/pp.cmx -dev/top_printers.cmo: parsing/ast.cmi toplevel/cerrors.cmi proofs/clenv.cmi \ - kernel/closure.cmi interp/constrextern.cmi kernel/declarations.cmi \ - kernel/environ.cmi pretyping/evd.cmi library/libnames.cmi \ - library/libobject.cmi library/nameops.cmi kernel/names.cmi lib/pp.cmi \ - parsing/pptactic.cmi parsing/printer.cmi proofs/proof_trees.cmi \ - proofs/refiner.cmi kernel/sign.cmi lib/system.cmi proofs/tacmach.cmi \ - kernel/term.cmi pretyping/termops.cmi kernel/univ.cmi -dev/top_printers.cmx: parsing/ast.cmx toplevel/cerrors.cmx proofs/clenv.cmx \ - kernel/closure.cmx interp/constrextern.cmx kernel/declarations.cmx \ - kernel/environ.cmx pretyping/evd.cmx library/libnames.cmx \ - library/libobject.cmx library/nameops.cmx kernel/names.cmx lib/pp.cmx \ - parsing/pptactic.cmx parsing/printer.cmx proofs/proof_trees.cmx \ - proofs/refiner.cmx kernel/sign.cmx lib/system.cmx proofs/tacmach.cmx \ - kernel/term.cmx pretyping/termops.cmx kernel/univ.cmx +dev/top_printers.cmo: parsing/ast.cmi toplevel/cerrors.cmi \ + pretyping/clenv.cmi kernel/closure.cmi interp/constrextern.cmi \ + kernel/declarations.cmi kernel/environ.cmi pretyping/evd.cmi \ + library/libnames.cmi library/libobject.cmi library/nameops.cmi \ + kernel/names.cmi lib/pp.cmi parsing/pptactic.cmi parsing/printer.cmi \ + proofs/proof_trees.cmi proofs/refiner.cmi kernel/sign.cmi lib/system.cmi \ + proofs/tacmach.cmi kernel/term.cmi pretyping/termops.cmi kernel/univ.cmi +dev/top_printers.cmx: parsing/ast.cmx toplevel/cerrors.cmx \ + pretyping/clenv.cmx kernel/closure.cmx interp/constrextern.cmx \ + kernel/declarations.cmx kernel/environ.cmx pretyping/evd.cmx \ + library/libnames.cmx library/libobject.cmx library/nameops.cmx \ + kernel/names.cmx lib/pp.cmx parsing/pptactic.cmx parsing/printer.cmx \ + proofs/proof_trees.cmx proofs/refiner.cmx kernel/sign.cmx lib/system.cmx \ + proofs/tacmach.cmx kernel/term.cmx pretyping/termops.cmx kernel/univ.cmx doc/parse.cmo: parsing/ast.cmi doc/parse.cmx: parsing/ast.cmx ide/blaster_window.cmo: ide/coq.cmi ide/ideutils.cmi @@ -1258,6 +1257,22 @@ pretyping/classops.cmx: library/decl_kinds.cmx kernel/environ.cmx \ lib/pp.cmx pretyping/rawterm.cmx pretyping/reductionops.cmx \ library/summary.cmx pretyping/tacred.cmx kernel/term.cmx \ pretyping/termops.cmx lib/util.cmx pretyping/classops.cmi +pretyping/clenv.cmo: pretyping/coercion.cmi kernel/environ.cmi \ + pretyping/evarutil.cmi pretyping/evd.cmi library/global.cmi \ + library/nameops.cmi kernel/names.cmi pretyping/pattern.cmi lib/pp.cmi \ + pretyping/pretype_errors.cmi pretyping/rawterm.cmi \ + pretyping/reductionops.cmi pretyping/retyping.cmi kernel/sign.cmi \ + proofs/tacexpr.cmo pretyping/tacred.cmi kernel/term.cmi \ + pretyping/termops.cmi pretyping/typing.cmi pretyping/unification.cmi \ + lib/util.cmi pretyping/clenv.cmi +pretyping/clenv.cmx: pretyping/coercion.cmx kernel/environ.cmx \ + pretyping/evarutil.cmx pretyping/evd.cmx library/global.cmx \ + library/nameops.cmx kernel/names.cmx pretyping/pattern.cmx lib/pp.cmx \ + pretyping/pretype_errors.cmx pretyping/rawterm.cmx \ + pretyping/reductionops.cmx pretyping/retyping.cmx kernel/sign.cmx \ + proofs/tacexpr.cmx pretyping/tacred.cmx kernel/term.cmx \ + pretyping/termops.cmx pretyping/typing.cmx pretyping/unification.cmx \ + lib/util.cmx pretyping/clenv.cmi pretyping/coercion.cmo: pretyping/classops.cmi kernel/environ.cmi \ pretyping/evarconv.cmi pretyping/evarutil.cmi pretyping/evd.cmi \ kernel/names.cmi pretyping/pretype_errors.cmi pretyping/rawterm.cmi \ @@ -1458,25 +1473,7 @@ pretyping/unification.cmx: kernel/environ.cmx pretyping/evarutil.cmx \ pretyping/rawterm.cmx pretyping/reductionops.cmx kernel/sign.cmx \ kernel/term.cmx pretyping/termops.cmx pretyping/typing.cmx lib/util.cmx \ pretyping/unification.cmi -proofs/clenv.cmo: pretyping/coercion.cmi kernel/environ.cmi \ - proofs/evar_refiner.cmi pretyping/evarutil.cmi pretyping/evd.cmi \ - library/global.cmi proofs/logic.cmi library/nameops.cmi kernel/names.cmi \ - pretyping/pattern.cmi lib/pp.cmi pretyping/pretype_errors.cmi \ - parsing/printer.cmi proofs/proof_trees.cmi proofs/proof_type.cmi \ - pretyping/rawterm.cmi pretyping/reductionops.cmi proofs/refiner.cmi \ - pretyping/retyping.cmi kernel/sign.cmi proofs/tacexpr.cmo \ - proofs/tacmach.cmi kernel/term.cmi pretyping/termops.cmi \ - pretyping/unification.cmi lib/util.cmi proofs/clenv.cmi -proofs/clenv.cmx: pretyping/coercion.cmx kernel/environ.cmx \ - proofs/evar_refiner.cmx pretyping/evarutil.cmx pretyping/evd.cmx \ - library/global.cmx proofs/logic.cmx library/nameops.cmx kernel/names.cmx \ - pretyping/pattern.cmx lib/pp.cmx pretyping/pretype_errors.cmx \ - parsing/printer.cmx proofs/proof_trees.cmx proofs/proof_type.cmx \ - pretyping/rawterm.cmx pretyping/reductionops.cmx proofs/refiner.cmx \ - pretyping/retyping.cmx kernel/sign.cmx proofs/tacexpr.cmx \ - proofs/tacmach.cmx kernel/term.cmx pretyping/termops.cmx \ - pretyping/unification.cmx lib/util.cmx proofs/clenv.cmi -proofs/clenvtac.cmo: proofs/clenv.cmi kernel/environ.cmi \ +proofs/clenvtac.cmo: pretyping/clenv.cmi kernel/environ.cmi \ proofs/evar_refiner.cmi pretyping/evarutil.cmi pretyping/evd.cmi \ proofs/logic.cmi library/nameops.cmi kernel/names.cmi \ pretyping/pattern.cmi lib/pp.cmi proofs/proof_trees.cmi \ @@ -1484,7 +1481,7 @@ proofs/clenvtac.cmo: proofs/clenv.cmi kernel/environ.cmi \ proofs/refiner.cmi kernel/sign.cmi proofs/tacexpr.cmo proofs/tacmach.cmi \ kernel/term.cmi pretyping/termops.cmi pretyping/unification.cmi \ lib/util.cmi proofs/clenvtac.cmi -proofs/clenvtac.cmx: proofs/clenv.cmx kernel/environ.cmx \ +proofs/clenvtac.cmx: pretyping/clenv.cmx kernel/environ.cmx \ proofs/evar_refiner.cmx pretyping/evarutil.cmx pretyping/evd.cmx \ proofs/logic.cmx library/nameops.cmx kernel/names.cmx \ pretyping/pattern.cmx lib/pp.cmx proofs/proof_trees.cmx \ @@ -1510,24 +1507,24 @@ proofs/evar_refiner.cmx: interp/constrintern.cmx kernel/environ.cmx \ pretyping/tacred.cmx kernel/term.cmx pretyping/termops.cmx \ kernel/type_errors.cmx pretyping/typing.cmx lib/util.cmx \ proofs/evar_refiner.cmi -proofs/logic.cmo: interp/constrextern.cmi parsing/coqast.cmi \ - kernel/environ.cmi pretyping/evarutil.cmi pretyping/evd.cmi \ - library/global.cmi kernel/inductive.cmi pretyping/inductiveops.cmi \ - library/nameops.cmi kernel/names.cmi library/nametab.cmi lib/options.cmi \ - lib/pp.cmi pretyping/pretype_errors.cmi parsing/printer.cmi \ - proofs/proof_trees.cmi proofs/proof_type.cmi pretyping/reductionops.cmi \ - pretyping/retyping.cmi kernel/sign.cmi kernel/term.cmi \ - pretyping/termops.cmi kernel/type_errors.cmi kernel/typeops.cmi \ - pretyping/typing.cmi lib/util.cmi proofs/logic.cmi -proofs/logic.cmx: interp/constrextern.cmx parsing/coqast.cmx \ - kernel/environ.cmx pretyping/evarutil.cmx pretyping/evd.cmx \ - library/global.cmx kernel/inductive.cmx pretyping/inductiveops.cmx \ - library/nameops.cmx kernel/names.cmx library/nametab.cmx lib/options.cmx \ - lib/pp.cmx pretyping/pretype_errors.cmx parsing/printer.cmx \ - proofs/proof_trees.cmx proofs/proof_type.cmx pretyping/reductionops.cmx \ - pretyping/retyping.cmx kernel/sign.cmx kernel/term.cmx \ - pretyping/termops.cmx kernel/type_errors.cmx kernel/typeops.cmx \ - pretyping/typing.cmx lib/util.cmx proofs/logic.cmi +proofs/logic.cmo: interp/constrextern.cmi kernel/environ.cmi \ + pretyping/evarutil.cmi pretyping/evd.cmi library/global.cmi \ + kernel/inductive.cmi pretyping/inductiveops.cmi library/nameops.cmi \ + kernel/names.cmi library/nametab.cmi lib/options.cmi lib/pp.cmi \ + pretyping/pretype_errors.cmi parsing/printer.cmi proofs/proof_trees.cmi \ + proofs/proof_type.cmi pretyping/reductionops.cmi pretyping/retyping.cmi \ + kernel/sign.cmi kernel/term.cmi pretyping/termops.cmi \ + kernel/type_errors.cmi kernel/typeops.cmi pretyping/typing.cmi \ + lib/util.cmi proofs/logic.cmi +proofs/logic.cmx: interp/constrextern.cmx kernel/environ.cmx \ + pretyping/evarutil.cmx pretyping/evd.cmx library/global.cmx \ + kernel/inductive.cmx pretyping/inductiveops.cmx library/nameops.cmx \ + kernel/names.cmx library/nametab.cmx lib/options.cmx lib/pp.cmx \ + pretyping/pretype_errors.cmx parsing/printer.cmx proofs/proof_trees.cmx \ + proofs/proof_type.cmx pretyping/reductionops.cmx pretyping/retyping.cmx \ + kernel/sign.cmx kernel/term.cmx pretyping/termops.cmx \ + kernel/type_errors.cmx kernel/typeops.cmx pretyping/typing.cmx \ + lib/util.cmx proofs/logic.cmi proofs/pfedit.cmo: library/decl_kinds.cmo kernel/declarations.cmi \ lib/edit.cmi kernel/entries.cmi kernel/environ.cmi \ proofs/evar_refiner.cmi pretyping/evd.cmi library/lib.cmi \ @@ -1588,33 +1585,33 @@ proofs/tacexpr.cmx: library/decl_kinds.cmx lib/dyn.cmx interp/genarg.cmx \ interp/topconstr.cmx lib/util.cmx proofs/tacmach.cmo: interp/constrintern.cmi kernel/environ.cmi \ pretyping/evd.cmi library/global.cmi proofs/logic.cmi library/nameops.cmi \ - kernel/names.cmi lib/pp.cmi parsing/printer.cmi proofs/proof_trees.cmi \ - proofs/proof_type.cmi pretyping/rawterm.cmi pretyping/reductionops.cmi \ - proofs/refiner.cmi kernel/sign.cmi proofs/tacexpr.cmo \ - pretyping/tacred.cmi kernel/term.cmi pretyping/termops.cmi \ - pretyping/typing.cmi lib/util.cmi proofs/tacmach.cmi + kernel/names.cmi lib/pp.cmi proofs/proof_trees.cmi proofs/proof_type.cmi \ + pretyping/rawterm.cmi pretyping/reductionops.cmi proofs/refiner.cmi \ + kernel/sign.cmi proofs/tacexpr.cmo pretyping/tacred.cmi kernel/term.cmi \ + pretyping/termops.cmi pretyping/typing.cmi lib/util.cmi \ + proofs/tacmach.cmi proofs/tacmach.cmx: interp/constrintern.cmx kernel/environ.cmx \ pretyping/evd.cmx library/global.cmx proofs/logic.cmx library/nameops.cmx \ - kernel/names.cmx lib/pp.cmx parsing/printer.cmx proofs/proof_trees.cmx \ - proofs/proof_type.cmx pretyping/rawterm.cmx pretyping/reductionops.cmx \ - proofs/refiner.cmx kernel/sign.cmx proofs/tacexpr.cmx \ - pretyping/tacred.cmx kernel/term.cmx pretyping/termops.cmx \ - pretyping/typing.cmx lib/util.cmx proofs/tacmach.cmi -proofs/tactic_debug.cmo: parsing/ast.cmi interp/constrextern.cmi \ - library/global.cmi proofs/logic.cmi kernel/names.cmi lib/options.cmi \ - lib/pp.cmi parsing/pptactic.cmi translate/pptacticnew.cmi \ - parsing/printer.cmi proofs/proof_trees.cmi proofs/tacexpr.cmo \ - proofs/tacmach.cmi pretyping/termops.cmi proofs/tactic_debug.cmi -proofs/tactic_debug.cmx: parsing/ast.cmx interp/constrextern.cmx \ - library/global.cmx proofs/logic.cmx kernel/names.cmx lib/options.cmx \ - lib/pp.cmx parsing/pptactic.cmx translate/pptacticnew.cmx \ - parsing/printer.cmx proofs/proof_trees.cmx proofs/tacexpr.cmx \ - proofs/tacmach.cmx pretyping/termops.cmx proofs/tactic_debug.cmi + kernel/names.cmx lib/pp.cmx proofs/proof_trees.cmx proofs/proof_type.cmx \ + pretyping/rawterm.cmx pretyping/reductionops.cmx proofs/refiner.cmx \ + kernel/sign.cmx proofs/tacexpr.cmx pretyping/tacred.cmx kernel/term.cmx \ + pretyping/termops.cmx pretyping/typing.cmx lib/util.cmx \ + proofs/tacmach.cmi +proofs/tactic_debug.cmo: interp/constrextern.cmi library/global.cmi \ + proofs/logic.cmi kernel/names.cmi lib/options.cmi lib/pp.cmi \ + parsing/pptactic.cmi translate/pptacticnew.cmi parsing/printer.cmi \ + proofs/proof_trees.cmi proofs/tacexpr.cmo proofs/tacmach.cmi \ + pretyping/termops.cmi proofs/tactic_debug.cmi +proofs/tactic_debug.cmx: interp/constrextern.cmx library/global.cmx \ + proofs/logic.cmx kernel/names.cmx lib/options.cmx lib/pp.cmx \ + parsing/pptactic.cmx translate/pptacticnew.cmx parsing/printer.cmx \ + proofs/proof_trees.cmx proofs/tacexpr.cmx proofs/tacmach.cmx \ + pretyping/termops.cmx proofs/tactic_debug.cmi scripts/coqc.cmo: config/coq_config.cmi toplevel/usage.cmi scripts/coqc.cmx: config/coq_config.cmx toplevel/usage.cmx scripts/coqmktop.cmo: config/coq_config.cmi scripts/tolink.cmo scripts/coqmktop.cmx: config/coq_config.cmx scripts/tolink.cmx -tactics/auto.cmo: tactics/btermdn.cmi proofs/clenv.cmi \ +tactics/auto.cmo: tactics/btermdn.cmi pretyping/clenv.cmi \ interp/constrintern.cmi kernel/declarations.cmi tactics/dhyp.cmi \ proofs/evar_refiner.cmi pretyping/evd.cmi library/global.cmi \ tactics/hiddentac.cmi tactics/hipattern.cmi kernel/inductive.cmi \ @@ -1628,7 +1625,7 @@ tactics/auto.cmo: tactics/btermdn.cmi proofs/clenv.cmi \ pretyping/tacred.cmi tactics/tacticals.cmi tactics/tactics.cmi \ kernel/term.cmi pretyping/termops.cmi pretyping/typing.cmi lib/util.cmi \ toplevel/vernacexpr.cmo tactics/auto.cmi -tactics/auto.cmx: tactics/btermdn.cmx proofs/clenv.cmx \ +tactics/auto.cmx: tactics/btermdn.cmx pretyping/clenv.cmx \ interp/constrintern.cmx kernel/declarations.cmx tactics/dhyp.cmx \ proofs/evar_refiner.cmx pretyping/evd.cmx library/global.cmx \ tactics/hiddentac.cmx tactics/hipattern.cmx kernel/inductive.cmx \ @@ -1666,7 +1663,7 @@ tactics/contradiction.cmx: interp/coqlib.cmx tactics/hipattern.cmx \ proofs/proof_type.cmx pretyping/rawterm.cmx pretyping/reductionops.cmx \ proofs/tacmach.cmx tactics/tacticals.cmx tactics/tactics.cmx \ kernel/term.cmx lib/util.cmx tactics/contradiction.cmi -tactics/dhyp.cmo: parsing/ast.cmi proofs/clenv.cmi interp/constrintern.cmi \ +tactics/dhyp.cmo: parsing/ast.cmi pretyping/clenv.cmi interp/constrintern.cmi \ kernel/environ.cmi pretyping/evd.cmi library/global.cmi library/lib.cmi \ library/libnames.cmi library/libobject.cmi library/library.cmi \ pretyping/matching.cmi kernel/names.cmi tactics/nbtermdn.cmi \ @@ -1675,7 +1672,7 @@ tactics/dhyp.cmo: parsing/ast.cmi proofs/clenv.cmi interp/constrintern.cmi \ library/summary.cmi proofs/tacexpr.cmo proofs/tacmach.cmi \ tactics/tacticals.cmi tactics/tactics.cmi kernel/term.cmi lib/util.cmi \ tactics/dhyp.cmi -tactics/dhyp.cmx: parsing/ast.cmx proofs/clenv.cmx interp/constrintern.cmx \ +tactics/dhyp.cmx: parsing/ast.cmx pretyping/clenv.cmx interp/constrintern.cmx \ kernel/environ.cmx pretyping/evd.cmx library/global.cmx library/lib.cmx \ library/libnames.cmx library/libobject.cmx library/library.cmx \ pretyping/matching.cmx kernel/names.cmx tactics/nbtermdn.cmx \ @@ -1686,7 +1683,7 @@ tactics/dhyp.cmx: parsing/ast.cmx proofs/clenv.cmx interp/constrintern.cmx \ tactics/dhyp.cmi tactics/dn.cmo: lib/tlm.cmi tactics/dn.cmi tactics/dn.cmx: lib/tlm.cmx tactics/dn.cmi -tactics/eauto.cmo: tactics/auto.cmi toplevel/cerrors.cmi proofs/clenv.cmi \ +tactics/eauto.cmo: tactics/auto.cmi toplevel/cerrors.cmi pretyping/clenv.cmi \ proofs/clenvtac.cmi kernel/declarations.cmi parsing/egrammar.cmi \ proofs/evar_refiner.cmi lib/explore.cmi parsing/extend.cmi \ interp/genarg.cmi library/global.cmi proofs/logic.cmi library/nameops.cmi \ @@ -1697,7 +1694,7 @@ tactics/eauto.cmo: tactics/auto.cmi toplevel/cerrors.cmi proofs/clenv.cmi \ tactics/tacinterp.cmi proofs/tacmach.cmi tactics/tacticals.cmi \ tactics/tactics.cmi kernel/term.cmi pretyping/termops.cmi lib/util.cmi \ tactics/eauto.cmi -tactics/eauto.cmx: tactics/auto.cmx toplevel/cerrors.cmx proofs/clenv.cmx \ +tactics/eauto.cmx: tactics/auto.cmx toplevel/cerrors.cmx pretyping/clenv.cmx \ proofs/clenvtac.cmx kernel/declarations.cmx parsing/egrammar.cmx \ proofs/evar_refiner.cmx lib/explore.cmx parsing/extend.cmx \ interp/genarg.cmx library/global.cmx proofs/logic.cmx library/nameops.cmx \ @@ -1708,14 +1705,14 @@ tactics/eauto.cmx: tactics/auto.cmx toplevel/cerrors.cmx proofs/clenv.cmx \ tactics/tacinterp.cmx proofs/tacmach.cmx tactics/tacticals.cmx \ tactics/tactics.cmx kernel/term.cmx pretyping/termops.cmx lib/util.cmx \ tactics/eauto.cmi -tactics/elim.cmo: proofs/clenv.cmi kernel/environ.cmi interp/genarg.cmi \ +tactics/elim.cmo: pretyping/clenv.cmi kernel/environ.cmi interp/genarg.cmi \ tactics/hiddentac.cmi tactics/hipattern.cmi pretyping/inductiveops.cmi \ library/libnames.cmi kernel/names.cmi lib/pp.cmi parsing/printer.cmi \ proofs/proof_type.cmi kernel/reduction.cmi proofs/refiner.cmi \ proofs/tacexpr.cmo proofs/tacmach.cmi tactics/tacticals.cmi \ tactics/tactics.cmi kernel/term.cmi pretyping/termops.cmi lib/util.cmi \ tactics/elim.cmi -tactics/elim.cmx: proofs/clenv.cmx kernel/environ.cmx interp/genarg.cmx \ +tactics/elim.cmx: pretyping/clenv.cmx kernel/environ.cmx interp/genarg.cmx \ tactics/hiddentac.cmx tactics/hipattern.cmx pretyping/inductiveops.cmx \ library/libnames.cmx kernel/names.cmx lib/pp.cmx parsing/printer.cmx \ proofs/proof_type.cmx kernel/reduction.cmx proofs/refiner.cmx \ @@ -1742,7 +1739,7 @@ tactics/eqdecide.cmx: tactics/auto.cmx toplevel/cerrors.cmx interp/coqlib.cmx \ proofs/refiner.cmx proofs/tacexpr.cmx tactics/tacinterp.cmx \ proofs/tacmach.cmx tactics/tacticals.cmx tactics/tactics.cmx \ kernel/term.cmx lib/util.cmx -tactics/equality.cmo: proofs/clenv.cmi interp/coqlib.cmi \ +tactics/equality.cmo: pretyping/clenv.cmi interp/coqlib.cmi \ kernel/declarations.cmi kernel/environ.cmi proofs/evar_refiner.cmi \ pretyping/evarconv.cmi pretyping/evarutil.cmi pretyping/evd.cmi \ tactics/hipattern.cmi pretyping/indrec.cmi kernel/inductive.cmi \ @@ -1755,7 +1752,7 @@ tactics/equality.cmo: proofs/clenv.cmi interp/coqlib.cmi \ tactics/tactics.cmi kernel/term.cmi pretyping/termops.cmi \ kernel/typeops.cmi pretyping/typing.cmi kernel/univ.cmi lib/util.cmi \ toplevel/vernacexpr.cmo tactics/equality.cmi -tactics/equality.cmx: proofs/clenv.cmx interp/coqlib.cmx \ +tactics/equality.cmx: pretyping/clenv.cmx interp/coqlib.cmx \ kernel/declarations.cmx kernel/environ.cmx proofs/evar_refiner.cmx \ pretyping/evarconv.cmx pretyping/evarutil.cmx pretyping/evd.cmx \ tactics/hipattern.cmx pretyping/indrec.cmx kernel/inductive.cmx \ @@ -1820,21 +1817,21 @@ tactics/hiddentac.cmx: tactics/evar_tactics.cmx interp/genarg.cmx \ proofs/proof_type.cmx pretyping/rawterm.cmx proofs/refiner.cmx \ proofs/tacexpr.cmx proofs/tacmach.cmx tactics/tactics.cmx kernel/term.cmx \ lib/util.cmx tactics/hiddentac.cmi -tactics/hipattern.cmo: proofs/clenv.cmi interp/coqlib.cmi \ +tactics/hipattern.cmo: pretyping/clenv.cmi interp/coqlib.cmi \ kernel/declarations.cmi kernel/environ.cmi pretyping/evd.cmi \ library/global.cmi pretyping/inductiveops.cmi pretyping/matching.cmi \ library/nameops.cmi kernel/names.cmi pretyping/pattern.cmi lib/pp.cmi \ proofs/proof_trees.cmi pretyping/reductionops.cmi proofs/tacmach.cmi \ tactics/tacticals.cmi kernel/term.cmi pretyping/termops.cmi lib/util.cmi \ tactics/hipattern.cmi -tactics/hipattern.cmx: proofs/clenv.cmx interp/coqlib.cmx \ +tactics/hipattern.cmx: pretyping/clenv.cmx interp/coqlib.cmx \ kernel/declarations.cmx kernel/environ.cmx pretyping/evd.cmx \ library/global.cmx pretyping/inductiveops.cmx pretyping/matching.cmx \ library/nameops.cmx kernel/names.cmx pretyping/pattern.cmx lib/pp.cmx \ proofs/proof_trees.cmx pretyping/reductionops.cmx proofs/tacmach.cmx \ tactics/tacticals.cmx kernel/term.cmx pretyping/termops.cmx lib/util.cmx \ tactics/hipattern.cmi -tactics/inv.cmo: proofs/clenv.cmi interp/coqlib.cmi tactics/elim.cmi \ +tactics/inv.cmo: pretyping/clenv.cmi interp/coqlib.cmi tactics/elim.cmi \ kernel/environ.cmi tactics/equality.cmi proofs/evar_refiner.cmi \ pretyping/evd.cmi interp/genarg.cmi library/global.cmi \ tactics/hipattern.cmi pretyping/inductiveops.cmi pretyping/matching.cmi \ @@ -1845,7 +1842,7 @@ tactics/inv.cmo: proofs/clenv.cmi interp/coqlib.cmi tactics/elim.cmi \ tactics/tacticals.cmi tactics/tactics.cmi kernel/term.cmi \ pretyping/termops.cmi pretyping/typing.cmi pretyping/unification.cmi \ lib/util.cmi tactics/inv.cmi -tactics/inv.cmx: proofs/clenv.cmx interp/coqlib.cmx tactics/elim.cmx \ +tactics/inv.cmx: pretyping/clenv.cmx interp/coqlib.cmx tactics/elim.cmx \ kernel/environ.cmx tactics/equality.cmx proofs/evar_refiner.cmx \ pretyping/evd.cmx interp/genarg.cmx library/global.cmx \ tactics/hipattern.cmx pretyping/inductiveops.cmx pretyping/matching.cmx \ @@ -1856,7 +1853,7 @@ tactics/inv.cmx: proofs/clenv.cmx interp/coqlib.cmx tactics/elim.cmx \ tactics/tacticals.cmx tactics/tactics.cmx kernel/term.cmx \ pretyping/termops.cmx pretyping/typing.cmx pretyping/unification.cmx \ lib/util.cmx tactics/inv.cmi -tactics/leminv.cmo: proofs/clenv.cmi proofs/clenvtac.cmi \ +tactics/leminv.cmo: pretyping/clenv.cmi proofs/clenvtac.cmi \ interp/constrintern.cmi library/decl_kinds.cmo kernel/declarations.cmi \ library/declare.cmi kernel/entries.cmi kernel/environ.cmi \ proofs/evar_refiner.cmi pretyping/evd.cmi library/global.cmi \ @@ -1867,7 +1864,7 @@ tactics/leminv.cmo: proofs/clenv.cmi proofs/clenvtac.cmi \ proofs/tacmach.cmi tactics/tacticals.cmi tactics/tactics.cmi \ kernel/term.cmi pretyping/termops.cmi lib/util.cmi \ toplevel/vernacexpr.cmo tactics/leminv.cmi -tactics/leminv.cmx: proofs/clenv.cmx proofs/clenvtac.cmx \ +tactics/leminv.cmx: pretyping/clenv.cmx proofs/clenvtac.cmx \ interp/constrintern.cmx library/decl_kinds.cmx kernel/declarations.cmx \ library/declare.cmx kernel/entries.cmx kernel/environ.cmx \ proofs/evar_refiner.cmx pretyping/evd.cmx library/global.cmx \ @@ -1884,19 +1881,19 @@ tactics/nbtermdn.cmo: tactics/btermdn.cmi lib/gmap.cmi library/libobject.cmi \ tactics/nbtermdn.cmx: tactics/btermdn.cmx lib/gmap.cmx library/libobject.cmx \ library/library.cmx kernel/names.cmx pretyping/pattern.cmx \ kernel/term.cmx tactics/termdn.cmx lib/util.cmx tactics/nbtermdn.cmi -tactics/refine.cmo: proofs/clenv.cmi kernel/environ.cmi pretyping/evd.cmi \ +tactics/refine.cmo: pretyping/clenv.cmi kernel/environ.cmi pretyping/evd.cmi \ kernel/names.cmi lib/pp.cmi parsing/printer.cmi kernel/reduction.cmi \ pretyping/retyping.cmi kernel/sign.cmi proofs/tacmach.cmi \ tactics/tacticals.cmi tactics/tactics.cmi kernel/term.cmi \ pretyping/termops.cmi pretyping/typing.cmi lib/util.cmi \ tactics/refine.cmi -tactics/refine.cmx: proofs/clenv.cmx kernel/environ.cmx pretyping/evd.cmx \ +tactics/refine.cmx: pretyping/clenv.cmx kernel/environ.cmx pretyping/evd.cmx \ kernel/names.cmx lib/pp.cmx parsing/printer.cmx kernel/reduction.cmx \ pretyping/retyping.cmx kernel/sign.cmx proofs/tacmach.cmx \ tactics/tacticals.cmx tactics/tactics.cmx kernel/term.cmx \ pretyping/termops.cmx pretyping/typing.cmx lib/util.cmx \ tactics/refine.cmi -tactics/setoid_replace.cmo: proofs/clenv.cmi interp/constrintern.cmi \ +tactics/setoid_replace.cmo: pretyping/clenv.cmi interp/constrintern.cmi \ interp/coqlib.cmi library/decl_kinds.cmo library/declare.cmi \ kernel/entries.cmi kernel/environ.cmi proofs/evar_refiner.cmi \ pretyping/evd.cmi library/global.cmi lib/gmap.cmi library/lib.cmi \ @@ -1906,9 +1903,9 @@ tactics/setoid_replace.cmo: proofs/clenv.cmi interp/constrintern.cmi \ pretyping/rawterm.cmi kernel/reduction.cmi pretyping/reductionops.cmi \ kernel/safe_typing.cmi library/summary.cmi proofs/tacmach.cmi \ tactics/tacticals.cmi tactics/tactics.cmi kernel/term.cmi \ - pretyping/termops.cmi pretyping/typing.cmi lib/util.cmi \ - toplevel/vernacexpr.cmo tactics/setoid_replace.cmi -tactics/setoid_replace.cmx: proofs/clenv.cmx interp/constrintern.cmx \ + pretyping/termops.cmi pretyping/typing.cmi pretyping/unification.cmi \ + lib/util.cmi toplevel/vernacexpr.cmo tactics/setoid_replace.cmi +tactics/setoid_replace.cmx: pretyping/clenv.cmx interp/constrintern.cmx \ interp/coqlib.cmx library/decl_kinds.cmx library/declare.cmx \ kernel/entries.cmx kernel/environ.cmx proofs/evar_refiner.cmx \ pretyping/evd.cmx library/global.cmx lib/gmap.cmx library/lib.cmx \ @@ -1918,8 +1915,8 @@ tactics/setoid_replace.cmx: proofs/clenv.cmx interp/constrintern.cmx \ pretyping/rawterm.cmx kernel/reduction.cmx pretyping/reductionops.cmx \ kernel/safe_typing.cmx library/summary.cmx proofs/tacmach.cmx \ tactics/tacticals.cmx tactics/tactics.cmx kernel/term.cmx \ - pretyping/termops.cmx pretyping/typing.cmx lib/util.cmx \ - toplevel/vernacexpr.cmx tactics/setoid_replace.cmi + pretyping/termops.cmx pretyping/typing.cmx pretyping/unification.cmx \ + lib/util.cmx toplevel/vernacexpr.cmx tactics/setoid_replace.cmi tactics/tacinterp.cmo: parsing/ast.cmi tactics/auto.cmi kernel/closure.cmi \ interp/constrintern.cmi parsing/coqast.cmi library/decl_kinds.cmo \ kernel/declarations.cmi tactics/dhyp.cmi lib/dyn.cmi tactics/elim.cmi \ @@ -1954,7 +1951,7 @@ tactics/tacinterp.cmx: parsing/ast.cmx tactics/auto.cmx kernel/closure.cmx \ tactics/tactics.cmx kernel/term.cmx pretyping/termops.cmx \ interp/topconstr.cmx pretyping/typing.cmx lib/util.cmx \ tactics/tacinterp.cmi -tactics/tacticals.cmo: proofs/clenv.cmi proofs/clenvtac.cmi \ +tactics/tacticals.cmo: pretyping/clenv.cmi proofs/clenvtac.cmi \ kernel/declarations.cmi kernel/environ.cmi proofs/evar_refiner.cmi \ pretyping/evd.cmi interp/genarg.cmi library/global.cmi \ pretyping/indrec.cmi kernel/inductive.cmi library/libnames.cmi \ @@ -1962,7 +1959,7 @@ tactics/tacticals.cmo: proofs/clenv.cmi proofs/clenvtac.cmi \ kernel/reduction.cmi proofs/refiner.cmi kernel/sign.cmi \ proofs/tacexpr.cmo proofs/tacmach.cmi kernel/term.cmi \ pretyping/termops.cmi lib/util.cmi tactics/tacticals.cmi -tactics/tacticals.cmx: proofs/clenv.cmx proofs/clenvtac.cmx \ +tactics/tacticals.cmx: pretyping/clenv.cmx proofs/clenvtac.cmx \ kernel/declarations.cmx kernel/environ.cmx proofs/evar_refiner.cmx \ pretyping/evd.cmx interp/genarg.cmx library/global.cmx \ pretyping/indrec.cmx kernel/inductive.cmx library/libnames.cmx \ @@ -1970,7 +1967,7 @@ tactics/tacticals.cmx: proofs/clenv.cmx proofs/clenvtac.cmx \ kernel/reduction.cmx proofs/refiner.cmx kernel/sign.cmx \ proofs/tacexpr.cmx proofs/tacmach.cmx kernel/term.cmx \ pretyping/termops.cmx lib/util.cmx tactics/tacticals.cmi -tactics/tactics.cmo: proofs/clenv.cmi proofs/clenvtac.cmi \ +tactics/tactics.cmo: pretyping/clenv.cmi proofs/clenvtac.cmi \ interp/constrintern.cmi interp/coqlib.cmi library/decl_kinds.cmo \ kernel/declarations.cmi library/declare.cmi kernel/entries.cmi \ kernel/environ.cmi proofs/evar_refiner.cmi pretyping/evd.cmi \ @@ -1983,7 +1980,7 @@ tactics/tactics.cmo: proofs/clenv.cmi proofs/clenvtac.cmi \ proofs/refiner.cmi kernel/sign.cmi proofs/tacexpr.cmo proofs/tacmach.cmi \ pretyping/tacred.cmi tactics/tacticals.cmi kernel/term.cmi \ pretyping/termops.cmi lib/util.cmi tactics/tactics.cmi -tactics/tactics.cmx: proofs/clenv.cmx proofs/clenvtac.cmx \ +tactics/tactics.cmx: pretyping/clenv.cmx proofs/clenvtac.cmx \ interp/constrintern.cmx interp/coqlib.cmx library/decl_kinds.cmx \ kernel/declarations.cmx library/declare.cmx kernel/entries.cmx \ kernel/environ.cmx proofs/evar_refiner.cmx pretyping/evd.cmx \ @@ -2764,12 +2761,12 @@ contrib/first-order/unify.cmx: contrib/first-order/formula.cmx \ kernel/names.cmx pretyping/reductionops.cmx proofs/tacmach.cmx \ kernel/term.cmx pretyping/termops.cmx lib/util.cmx \ contrib/first-order/unify.cmi -contrib/fourier/fourierR.cmo: proofs/clenv.cmi tactics/contradiction.cmi \ +contrib/fourier/fourierR.cmo: pretyping/clenv.cmi tactics/contradiction.cmi \ interp/coqlib.cmi tactics/equality.cmi contrib/fourier/fourier.cmo \ library/libnames.cmi library/library.cmi kernel/names.cmi \ contrib/ring/ring.cmo proofs/tacmach.cmi tactics/tacticals.cmi \ tactics/tactics.cmi kernel/term.cmi lib/util.cmi toplevel/vernacexpr.cmo -contrib/fourier/fourierR.cmx: proofs/clenv.cmx tactics/contradiction.cmx \ +contrib/fourier/fourierR.cmx: pretyping/clenv.cmx tactics/contradiction.cmx \ interp/coqlib.cmx tactics/equality.cmx contrib/fourier/fourier.cmx \ library/libnames.cmx library/library.cmx kernel/names.cmx \ contrib/ring/ring.cmx proofs/tacmach.cmx tactics/tacticals.cmx \ @@ -2820,7 +2817,7 @@ contrib/funind/tacinvutils.cmx: interp/coqlib.cmx kernel/declarations.cmx \ lib/pp.cmx parsing/printer.cmx pretyping/reductionops.cmx kernel/sign.cmx \ kernel/term.cmx pretyping/termops.cmx lib/util.cmx \ contrib/funind/tacinvutils.cmi -contrib/interface/blast.cmo: tactics/auto.cmi proofs/clenv.cmi \ +contrib/interface/blast.cmo: tactics/auto.cmi pretyping/clenv.cmi \ toplevel/command.cmi contrib/interface/ctast.cmo kernel/declarations.cmi \ library/declare.cmi tactics/eauto.cmi kernel/environ.cmi \ tactics/equality.cmi pretyping/evd.cmi lib/explore.cmi library/global.cmi \ @@ -2834,7 +2831,7 @@ contrib/interface/blast.cmo: tactics/auto.cmi proofs/clenv.cmi \ tactics/tactics.cmi kernel/term.cmi pretyping/termops.cmi \ pretyping/typing.cmi lib/util.cmi toplevel/vernacentries.cmi \ toplevel/vernacinterp.cmi contrib/interface/blast.cmi -contrib/interface/blast.cmx: tactics/auto.cmx proofs/clenv.cmx \ +contrib/interface/blast.cmx: tactics/auto.cmx pretyping/clenv.cmx \ toplevel/command.cmx contrib/interface/ctast.cmx kernel/declarations.cmx \ library/declare.cmx tactics/eauto.cmx kernel/environ.cmx \ tactics/equality.cmx pretyping/evd.cmx lib/explore.cmx library/global.cmx \ @@ -2994,7 +2991,7 @@ contrib/interface/showproof_ct.cmx: contrib/interface/ascent.cmi \ parsing/esyntax.cmx library/global.cmx toplevel/metasyntax.cmx lib/pp.cmx \ parsing/printer.cmx contrib/interface/translate.cmx \ contrib/interface/vtp.cmx contrib/interface/xlate.cmx -contrib/interface/showproof.cmo: proofs/clenv.cmi interp/constrintern.cmi \ +contrib/interface/showproof.cmo: pretyping/clenv.cmi interp/constrintern.cmi \ parsing/coqast.cmi kernel/declarations.cmi kernel/environ.cmi \ pretyping/evd.cmi interp/genarg.cmi library/global.cmi \ kernel/inductive.cmi pretyping/inductiveops.cmi library/libnames.cmi \ @@ -3006,7 +3003,7 @@ contrib/interface/showproof.cmo: proofs/clenv.cmi interp/constrintern.cmi \ pretyping/termops.cmi contrib/interface/translate.cmi \ pretyping/typing.cmi lib/util.cmi toplevel/vernacinterp.cmi \ contrib/interface/showproof.cmi -contrib/interface/showproof.cmx: proofs/clenv.cmx interp/constrintern.cmx \ +contrib/interface/showproof.cmx: pretyping/clenv.cmx interp/constrintern.cmx \ parsing/coqast.cmx kernel/declarations.cmx kernel/environ.cmx \ pretyping/evd.cmx interp/genarg.cmx library/global.cmx \ kernel/inductive.cmx pretyping/inductiveops.cmx library/libnames.cmx \ @@ -3064,7 +3061,7 @@ contrib/jprover/jlogic.cmo: contrib/jprover/jterm.cmi \ contrib/jprover/opname.cmi contrib/jprover/jlogic.cmi contrib/jprover/jlogic.cmx: contrib/jprover/jterm.cmx \ contrib/jprover/opname.cmx contrib/jprover/jlogic.cmi -contrib/jprover/jprover.cmo: toplevel/cerrors.cmi proofs/clenv.cmi \ +contrib/jprover/jprover.cmo: toplevel/cerrors.cmi pretyping/clenv.cmi \ parsing/egrammar.cmi interp/genarg.cmi library/global.cmi \ tactics/hiddentac.cmi tactics/hipattern.cmi contrib/jprover/jall.cmi \ contrib/jprover/jlogic.cmi contrib/jprover/jterm.cmi kernel/names.cmi \ @@ -3074,7 +3071,7 @@ contrib/jprover/jprover.cmo: toplevel/cerrors.cmi proofs/clenv.cmi \ proofs/refiner.cmi proofs/tacexpr.cmo tactics/tacinterp.cmi \ proofs/tacmach.cmi tactics/tacticals.cmi tactics/tactics.cmi \ kernel/term.cmi pretyping/termops.cmi lib/util.cmi -contrib/jprover/jprover.cmx: toplevel/cerrors.cmx proofs/clenv.cmx \ +contrib/jprover/jprover.cmx: toplevel/cerrors.cmx pretyping/clenv.cmx \ parsing/egrammar.cmx interp/genarg.cmx library/global.cmx \ tactics/hiddentac.cmx tactics/hipattern.cmx contrib/jprover/jall.cmx \ contrib/jprover/jlogic.cmx contrib/jprover/jterm.cmx kernel/names.cmx \ @@ -3092,7 +3089,7 @@ contrib/jprover/jtunify.cmo: contrib/jprover/jtunify.cmi contrib/jprover/jtunify.cmx: contrib/jprover/jtunify.cmi contrib/jprover/opname.cmo: contrib/jprover/opname.cmi contrib/jprover/opname.cmx: contrib/jprover/opname.cmi -contrib/omega/coq_omega.cmo: parsing/ast.cmi proofs/clenv.cmi \ +contrib/omega/coq_omega.cmo: parsing/ast.cmi pretyping/clenv.cmi \ kernel/closure.cmi tactics/contradiction.cmi interp/coqlib.cmi \ kernel/declarations.cmi kernel/environ.cmi tactics/equality.cmi \ proofs/evar_refiner.cmi library/global.cmi library/goptions.cmi \ @@ -3103,7 +3100,7 @@ contrib/omega/coq_omega.cmo: parsing/ast.cmi proofs/clenv.cmi \ kernel/sign.cmi proofs/tacmach.cmi pretyping/tacred.cmi \ tactics/tacticals.cmi tactics/tactics.cmi kernel/term.cmi \ pretyping/termops.cmi lib/util.cmi -contrib/omega/coq_omega.cmx: parsing/ast.cmx proofs/clenv.cmx \ +contrib/omega/coq_omega.cmx: parsing/ast.cmx pretyping/clenv.cmx \ kernel/closure.cmx tactics/contradiction.cmx interp/coqlib.cmx \ kernel/declarations.cmx kernel/environ.cmx tactics/equality.cmx \ proofs/evar_refiner.cmx library/global.cmx library/goptions.cmx \ diff --git a/Makefile b/Makefile index 48d4b551d2..09e7aace02 100644 --- a/Makefile +++ b/Makefile @@ -140,8 +140,8 @@ PRETYPING=\ pretyping/classops.cmo pretyping/recordops.cmo pretyping/indrec.cmo \ pretyping/evarutil.cmo pretyping/typing.cmo \ pretyping/unification.cmo pretyping/evarconv.cmo \ - pretyping/coercion.cmo pretyping/cases.cmo pretyping/pretyping.cmo \ - pretyping/matching.cmo + pretyping/coercion.cmo pretyping/clenv.cmo pretyping/cases.cmo \ + pretyping/pretyping.cmo pretyping/matching.cmo INTERP=\ parsing/lexer.cmo interp/topconstr.cmo interp/ppextend.cmo interp/symbols.cmo \ @@ -176,7 +176,7 @@ PROOFS=\ proofs/tacexpr.cmo proofs/proof_type.cmo \ proofs/proof_trees.cmo proofs/logic.cmo \ proofs/refiner.cmo proofs/evar_refiner.cmo proofs/tacmach.cmo \ - proofs/clenv.cmo proofs/pfedit.cmo proofs/tactic_debug.cmo \ + proofs/pfedit.cmo proofs/tactic_debug.cmo \ proofs/clenvtac.cmo TACTICS=\ diff --git a/parsing/printer.ml b/parsing/printer.ml index 477b7bf970..c331eea6fd 100644 --- a/parsing/printer.ml +++ b/parsing/printer.ml @@ -124,6 +124,8 @@ let prterm t = prterm_env (Global.env()) t let prtype t = prtype_env (Global.env()) t let prjudge j = prjudge_env (Global.env()) j +let _ = Termops.set_print_constr prterm + let pr_constant env cst = prterm_env env (mkConst cst) let pr_existential env ev = prterm_env env (mkEvar ev) let pr_inductive env ind = prterm_env env (mkInd ind) @@ -247,3 +249,4 @@ let pr_context_limit n env = let pr_context_of env = match Options.print_hyps_limit () with | None -> hv 0 (pr_context_unlimited env) | Some n -> hv 0 (pr_context_limit n env) + diff --git a/pretyping/clenv.ml b/pretyping/clenv.ml new file mode 100644 index 0000000000..0df34169a5 --- /dev/null +++ b/pretyping/clenv.ml @@ -0,0 +1,562 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* incr meta_ctr; !meta_ctr + +(* replaces a mapping of existentials into a mapping of metas. + Problem if an evar appears in the type of another one (pops anomaly) *) +let exist_to_meta sigma (emap, c) = + let metamap = ref [] in + let change_exist evar = + let ty = nf_betaiota (nf_evar emap (existential_type emap evar)) in + let n = new_meta() in + metamap := (n, ty) :: !metamap; + mkMeta n in + let rec replace c = + match kind_of_term c with + Evar (k,_ as ev) when not (Evd.in_dom sigma k) -> change_exist ev + | _ -> map_constr replace c in + (!metamap, replace c) + +(* collects all metavar occurences, in left-to-right order, preserving + * repetitions and all. *) + +let collect_metas c = + let rec collrec acc c = + match kind_of_term c with + | Meta mv -> mv::acc + | _ -> fold_constr collrec acc c + in + List.rev (collrec [] c) + +(* Clausal environments *) + +type 'a clausenv = { + templval : constr freelisted; + templtyp : constr freelisted; + namenv : identifier Metamap.t; + env : meta_map; + hook : 'a } + +type wc = named_context sigma + + +(* [mentions clenv mv0 mv1] is true if mv1 is defined and mentions + * mv0, or if one of the free vars on mv1's freelist mentions + * mv0 *) + +let mentions clenv mv0 = + let rec menrec mv1 = + try + (match Metamap.find mv1 clenv.env with + | Clval (b,_) -> + Metaset.mem mv0 b.freemetas || meta_exists menrec b.freemetas + | Cltyp _ -> false) + with Not_found -> + false + in + menrec + +(* Creates a new clause-environment, whose template has a given + * type, CTY. This is not all that useful, since not very often + * does one know the type of the clause - one usually only has + * a clause which one wants to backchain thru. *) + +let mk_clenv wc cty = + let mv = new_meta () in + let cty_fls = mk_freelisted cty in + { templval = mk_freelisted (mkMeta mv); + templtyp = cty_fls; + namenv = Metamap.empty; + env = Metamap.add mv (Cltyp cty_fls) Metamap.empty ; + hook = wc } + +let clenv_environments bound c = + let rec clrec (ne,e,metas) n c = + match n, kind_of_term c with + | (Some 0, _) -> (ne, e, List.rev metas, c) + | (n, Cast (c,_)) -> clrec (ne,e,metas) n c + | (n, Prod (na,c1,c2)) -> + let mv = new_meta () in + let dep = dependent (mkRel 1) c2 in + let ne' = + if dep then + match na with + | Anonymous -> ne + | Name id -> + if metamap_in_dom mv ne then begin + warning ("Cannot put metavar "^(string_of_meta mv)^ + " in name-environment twice"); + ne + end else + Metamap.add mv id ne + else + ne + in + let e' = Metamap.add mv (Cltyp (mk_freelisted c1)) e in + clrec (ne',e', (mkMeta mv)::metas) (option_app ((+) (-1)) n) + (if dep then (subst1 (mkMeta mv) c2) else c2) + | (n, LetIn (na,b,_,c)) -> + clrec (ne,e,metas) (option_app ((+) (-1)) n) (subst1 b c) + | (n, _) -> (ne, e, List.rev metas, c) + in + clrec (Metamap.empty,Metamap.empty,[]) bound c + +let mk_clenv_from_n wc n (c,cty) = + let (namenv,env,args,concl) = clenv_environments n cty in + { templval = mk_freelisted (match args with [] -> c | _ -> applist (c,args)); + templtyp = mk_freelisted concl; + namenv = namenv; + env = env; + hook = wc } + +let mk_clenv_from wc = mk_clenv_from_n wc None + +let subst_clenv f sub clenv = + { templval = map_fl (subst_mps sub) clenv.templval; + templtyp = map_fl (subst_mps sub) clenv.templtyp; + namenv = clenv.namenv; + env = Metamap.map (map_clb (subst_mps sub)) clenv.env; + hook = f sub clenv.hook } + +let connect_clenv gls clenv = + let wc = {it=gls.it.evar_hyps; sigma=gls.sigma} in + { clenv with hook = wc } + +let clenv_wtactic f clenv = + let (sigma',mmap') = f (clenv.hook.sigma, clenv.env) in + {clenv with env = mmap' ; hook = {it=clenv.hook.it; sigma=sigma'}} + +let mk_clenv_hnf_constr_type_of wc t = + mk_clenv_from wc (t,w_hnf_constr wc (w_type_of wc t)) + +let mk_clenv_rename_from wc (c,t) = + mk_clenv_from wc (c,rename_bound_var (get_env wc) [] t) + +let mk_clenv_rename_from_n wc n (c,t) = + mk_clenv_from_n wc n (c,rename_bound_var (get_env wc) [] t) + +let mk_clenv_rename_type_of wc t = + mk_clenv_from wc (t,rename_bound_var (get_env wc) [] (w_type_of wc t)) + +let mk_clenv_rename_hnf_constr_type_of wc t = + mk_clenv_from wc + (t,rename_bound_var (get_env wc) [] (w_hnf_constr wc (w_type_of wc t))) + +let mk_clenv_type_of wc t = mk_clenv_from wc (t,w_type_of wc t) + +let clenv_assign mv rhs clenv = + let rhs_fls = mk_freelisted rhs in + if meta_exists (mentions clenv mv) rhs_fls.freemetas then + error "clenv__assign: circularity in unification"; + try + (match Metamap.find mv clenv.env with + | Clval (fls,ty) -> + if not (eq_constr fls.rebus rhs) then + try + (* Streams are lazy, force evaluation of id to catch Not_found*) + let id = Metamap.find mv clenv.namenv in + errorlabstrm "clenv_assign" + (str "An incompatible instantiation has already been found for " ++ + pr_id id) + with Not_found -> + anomaly "clenv_assign: non dependent metavar already assigned" + else + clenv + | Cltyp bty -> + { templval = clenv.templval; + templtyp = clenv.templtyp; + namenv = clenv.namenv; + env = Metamap.add mv (Clval (rhs_fls,bty)) clenv.env; + hook = clenv.hook }) + with Not_found -> + error "clenv_assign" + +let clenv_val_of clenv mv = + let rec valrec mv = + try + (match Metamap.find mv clenv.env with + | Cltyp _ -> mkMeta mv + | Clval(b,_) -> + instance (List.map (fun mv' -> (mv',valrec mv')) + (Metaset.elements b.freemetas)) b.rebus) + with Not_found -> + mkMeta mv + in + valrec mv + +let clenv_instance clenv b = + let c_sigma = + List.map + (fun mv -> (mv,clenv_val_of clenv mv)) (Metaset.elements b.freemetas) + in + instance c_sigma b.rebus + +let clenv_instance_term clenv c = + clenv_instance clenv (mk_freelisted c) + +(* [clenv_pose (na,mv,cty) clenv] + * returns a new clausenv which has added to it the metavar MV, + * with type CTY. the name NA, if it is not ANONYMOUS, will + * be entered into the name-map, as a way of accessing the new + * metavar. *) + +let clenv_pose (na,mv,cty) clenv = + { templval = clenv.templval; + templtyp = clenv.templtyp; + env = Metamap.add mv (Cltyp (mk_freelisted cty)) clenv.env; + namenv = (match na with + | Anonymous -> clenv.namenv + | Name id -> Metamap.add mv id clenv.namenv); + hook = clenv.hook } + +let clenv_defined clenv mv = + match Metamap.find mv clenv.env with + | Clval _ -> true + | Cltyp _ -> false + +let clenv_value clenv mv = + match Metamap.find mv clenv.env with + | Clval(b,_) -> b + | Cltyp _ -> failwith "clenv_value" + +let clenv_type clenv mv = + match Metamap.find mv clenv.env with + | Cltyp b -> b + | Clval(_,b) -> b + +let clenv_template clenv = clenv.templval + +let clenv_template_type clenv = clenv.templtyp + +let clenv_instance_value clenv mv = + clenv_instance clenv (clenv_value clenv mv) + +let clenv_instance_type clenv mv = + clenv_instance clenv (clenv_type clenv mv) + +let clenv_instance_template clenv = + clenv_instance clenv (clenv_template clenv) + +let clenv_instance_template_type clenv = + clenv_instance clenv (clenv_template_type clenv) + +let clenv_type_of ce c = + let metamap = + List.map + (function + | (n,Clval(_,typ)) -> (n,typ.rebus) + | (n,Cltyp typ) -> (n,typ.rebus)) + (metamap_to_list ce.env) + in + Retyping.get_type_of_with_meta (get_env ce.hook) ce.hook.sigma metamap c + +let clenv_instance_type_of ce c = + clenv_instance ce (mk_freelisted (clenv_type_of ce c)) + +let clenv_unify allow_K cv_pb t1 t2 clenv = + let env = get_env clenv.hook in + clenv_wtactic (Unification.w_unify allow_K env cv_pb t1 t2) clenv + +let clenv_unique_resolver allow_K clause gl = + clenv_unify allow_K CUMUL + (clenv_instance_template_type clause) (get_concl gl) clause + +(* [clenv_bchain mv clenv' clenv] + * + * Resolves the value of "mv" (which must be undefined) in clenv to be + * the template of clenv' be the value "c", applied to "n" fresh + * metavars, whose types are chosen by destructing "clf", which should + * be a clausale forme generated from the type of "c". The process of + * resolution can cause unification of already-existing metavars, and + * of the fresh ones which get created. This operation is a composite + * of operations which pose new metavars, perform unification on + * terms, and make bindings. *) + +let clenv_bchain mv subclenv clenv = + (* Add the metavars of [subclenv] to [clenv], with their name-environment *) + let clenv' = + { templval = clenv.templval; + templtyp = clenv.templtyp; + namenv = + List.fold_left (fun ne (mv,id) -> + if clenv_defined subclenv mv then + ne + else if metamap_in_dom mv ne then begin + warning ("Cannot put metavar "^(string_of_meta mv)^ + " in name-environment twice"); + ne + end else + Metamap.add mv id ne) + clenv.namenv (metamap_to_list subclenv.namenv); + env = List.fold_left (fun m (n,v) -> Metamap.add n v m) + clenv.env (metamap_to_list subclenv.env); + hook = clenv.hook } + in + (* unify the type of the template of [subclenv] with the type of [mv] *) + let clenv'' = + clenv_unify true CUMUL + (clenv_instance clenv' (clenv_template_type subclenv)) + (clenv_instance_type clenv' mv) + clenv' + in + (* assign the metavar *) + let clenv''' = + clenv_assign mv (clenv_instance clenv' (clenv_template subclenv)) clenv'' + in + clenv''' + + +(* swaps the "hooks" in [clenv1] and [clenv2], so we can then use + backchain to hook them together *) + +let clenv_swap clenv1 clenv2 = + let clenv1' = { templval = clenv1.templval; + templtyp = clenv1.templtyp; + namenv = clenv1.namenv; + env = clenv1.env; + hook = clenv2.hook} + and clenv2' = { templval = clenv2.templval; + templtyp = clenv2.templtyp; + namenv = clenv2.namenv; + env = clenv2.env; + hook = clenv1.hook} + in + (clenv1',clenv2') + +let clenv_fchain mv nextclenv clenv = + let (clenv',nextclenv') = clenv_swap clenv nextclenv in + clenv_bchain mv clenv' nextclenv' + +(* [clenv_metavars clenv mv] + * returns a list of the metavars which appear in the type of + * the metavar mv. The list is unordered. *) + +let clenv_metavars clenv mv = + match Metamap.find mv clenv.env with + | Clval(_,b) -> b.freemetas + | Cltyp b -> b.freemetas + +let clenv_template_metavars clenv = clenv.templval.freemetas + +(* [clenv_dependent hyps_only clenv] + * returns a list of the metavars which appear in the template of clenv, + * and which are dependent, This is computed by taking the metavars in cval, + * in right-to-left order, and collecting the metavars which appear + * in their types, and adding in all the metavars appearing in the + * type of clenv. + * If [hyps_only] then metavariables occurring in the type are _excluded_ *) + +let dependent_metas clenv mvs conclmetas = + List.fold_right + (fun mv deps -> + Metaset.union deps (clenv_metavars clenv mv)) + mvs conclmetas + +let clenv_dependent hyps_only clenv = + let mvs = collect_metas (clenv_instance_template clenv) in + let ctyp_mvs = (mk_freelisted (clenv_instance_template_type clenv)).freemetas in + let deps = dependent_metas clenv mvs ctyp_mvs in + List.filter + (fun mv -> Metaset.mem mv deps && not (hyps_only && Metaset.mem mv ctyp_mvs)) + mvs + +let clenv_missing c = clenv_dependent true c + +(* [clenv_independent clenv] + * returns a list of metavariables which appear in the term cval, + * and which are not dependent. That is, they do not appear in + * the types of other metavars which are in cval, nor in the type + * of cval, ctyp. *) + +let clenv_independent clenv = + let mvs = collect_metas (clenv_instance_template clenv) in + let ctyp_mvs = (mk_freelisted (clenv_instance_template_type clenv)).freemetas in + let deps = dependent_metas clenv mvs ctyp_mvs in + List.filter (fun mv -> not (Metaset.mem mv deps)) mvs + +let w_coerce wc c ctyp target = + let j = make_judge c ctyp in + let env = get_env wc in + let isevars = Evarutil.create_evar_defs wc.sigma in + let j' = Coercion.inh_conv_coerce_to dummy_loc env isevars j target in + (* faire quelque chose avec isevars ? *) + j'.uj_val + +let clenv_constrain_dep_args hyps_only clause = function + | [] -> clause + | mlist -> + let occlist = clenv_dependent hyps_only clause in + if List.length occlist = List.length mlist then + List.fold_left2 + (fun clenv k c -> + let wc = clause.hook in + try + let k_typ = w_hnf_constr wc (clenv_instance_type clause k) in + let c_typ = w_hnf_constr wc (w_type_of wc c) in + let c' = w_coerce wc c c_typ k_typ in + clenv_unify true CONV (mkMeta k) c' clenv + with _ -> + clenv_unify true CONV (mkMeta k) c clenv) + clause occlist mlist + else + error ("Not the right number of missing arguments (expected " + ^(string_of_int (List.length occlist))^")") + +let clenv_constrain_missing_args mlist clause = + clenv_constrain_dep_args true clause mlist + +let clenv_lookup_name clenv id = + match metamap_inv clenv.namenv id with + | [] -> + errorlabstrm "clenv_lookup_name" + (str"No such bound variable " ++ pr_id id) + | [n] -> + n + | _ -> + anomaly "clenv_lookup_name: a name occurs more than once in clause" + +let clenv_match_args s clause = + let mvs = clenv_independent clause in + let rec matchrec clause = function + | [] -> clause + | (loc,b,c)::t -> + let k = + match b with + | NamedHyp s -> + if List.exists (fun (_,b',_) -> b=b') t then + errorlabstrm "clenv_match_args" + (str "The variable " ++ pr_id s ++ + str " occurs more than once in binding") + else + clenv_lookup_name clause s + | AnonHyp n -> + if List.exists (fun (_,b',_) -> b=b') t then + errorlabstrm "clenv_match_args" + (str "The position " ++ int n ++ + str " occurs more than once in binding"); + try + List.nth mvs (n-1) + with (Failure _|Invalid_argument _) -> + errorlabstrm "clenv_match_args" (str "No such binder") + in + let k_typ = w_hnf_constr clause.hook (clenv_instance_type clause k) + (* nf_betaiota was before in type_of - useful to reduce types like *) + (* (x:A)([x]P u) *) + and c_typ = w_hnf_constr clause.hook + (nf_betaiota (w_type_of clause.hook c)) in + let cl = + (* Try to infer some Meta/Evar from the type of [c] *) + try + clenv_assign k c (clenv_unify true CUMUL c_typ k_typ clause) + with _ -> + (* Try to coerce to the type of [k]; cannot merge with the + previous case because Coercion does not handle Meta *) + let c' = w_coerce clause.hook c c_typ k_typ in + try clenv_unify true CONV (mkMeta k) c' clause + with PretypeError (env,CannotUnify (m,n)) -> + Stdpp.raise_with_loc loc + (PretypeError (env,CannotUnifyBindingType (m,n))) + in matchrec cl t + in + matchrec clause s + +type arg_bindings = (int * constr) list + +let clenv_constrain_with_bindings bl clause = + if bl = [] then + clause + else + let all_mvs = collect_metas (clenv_template clause).rebus in + let rec matchrec clause = function + | [] -> clause + | (n,c)::t -> + let k = + (try + if n > 0 then + List.nth all_mvs (n-1) + else if n < 0 then + List.nth (List.rev all_mvs) (-n-1) + else error "clenv_constrain_with_bindings" + with Failure _ -> + errorlabstrm "clenv_constrain_with_bindings" + (str"Clause did not have " ++ int n ++ str"-th" ++ + str" absolute argument")) in + let env = Global.env () in + let sigma = Evd.empty in + let k_typ = nf_betaiota (clenv_instance_type clause k) in + let c_typ = nf_betaiota (w_type_of clause.hook c) in + matchrec + (clenv_assign k c (clenv_unify true CUMUL c_typ k_typ clause)) t + in + matchrec clause bl + + +(***************************) + +(* Clausal environment for an application *) + +let make_clenv_binding_gen n wc (c,t) = function + | ImplicitBindings largs -> + let clause = mk_clenv_from_n wc n (c,t) in + clenv_constrain_dep_args (n <> None) clause largs + | ExplicitBindings lbind -> + let clause = mk_clenv_rename_from_n wc n (c,t) in + clenv_match_args lbind clause + | NoBindings -> + mk_clenv_from_n wc n (c,t) + +let make_clenv_binding_apply wc n = make_clenv_binding_gen (Some n) wc +let make_clenv_binding = make_clenv_binding_gen None + +let pr_clenv clenv = + let pr_name mv = + try + let id = Metamap.find mv clenv.namenv in + (str"[" ++ pr_id id ++ str"]") + with Not_found -> (mt ()) + in + let pr_meta_binding = function + | (mv,Cltyp b) -> + hov 0 + (pr_meta mv ++ pr_name mv ++ str " : " ++ print_constr b.rebus ++ fnl ()) + | (mv,Clval(b,_)) -> + hov 0 + (pr_meta mv ++ pr_name mv ++ str " := " ++ print_constr b.rebus ++ fnl ()) + in + (str"TEMPL: " ++ print_constr clenv.templval.rebus ++ + str" : " ++ print_constr clenv.templtyp.rebus ++ fnl () ++ + (prlist pr_meta_binding (metamap_to_list clenv.env))) diff --git a/pretyping/clenv.mli b/pretyping/clenv.mli new file mode 100644 index 0000000000..ae5cafdf65 --- /dev/null +++ b/pretyping/clenv.mli @@ -0,0 +1,104 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* metavariable + +(* [exist_to_meta] generates new metavariables for each existential + and performs the replacement in the given constr *) +val exist_to_meta : + Evd.evar_map -> Pretyping.open_constr -> (Termops.metamap * constr) + +(* The Type of Constructions clausale environments. *) + +type 'a clausenv = { + templval : constr freelisted; + templtyp : constr freelisted; + namenv : identifier Metamap.t; + env : meta_map; + hook : 'a } + +type wc = named_context sigma (* for a better reading of the following *) + +(* [templval] is the template which we are trying to fill out. + * [templtyp] is its type. + * [namenv] is a mapping from metavar numbers to names, for + * use in instanciating metavars by name. + * [env] is the mapping from metavar numbers to their types + * and values. + * [hook] is the pointer to the current walking context, for + * integrating existential vars and metavars. *) + +val collect_metas : constr -> metavariable list +val mk_clenv : 'a -> constr -> 'a clausenv +val mk_clenv_from : 'a -> constr * constr -> 'a clausenv +val mk_clenv_from_n : 'a -> int option -> constr * constr -> 'a clausenv +val mk_clenv_rename_from : wc -> constr * constr -> wc clausenv +val mk_clenv_rename_from_n : wc -> int option -> constr * constr -> wc clausenv +val mk_clenv_hnf_constr_type_of : wc -> constr -> wc clausenv +val mk_clenv_type_of : wc -> constr -> wc clausenv + +val subst_clenv : (substitution -> 'a -> 'a) -> + substitution -> 'a clausenv -> 'a clausenv +val clenv_wtactic : + (evar_map * meta_map -> evar_map * meta_map) -> wc clausenv -> wc clausenv + +val connect_clenv : evar_info sigma -> 'a clausenv -> wc clausenv +val clenv_assign : metavariable -> constr -> 'a clausenv -> 'a clausenv +val clenv_instance_term : wc clausenv -> constr -> constr +val clenv_pose : name * metavariable * constr -> 'a clausenv -> 'a clausenv +val clenv_template : 'a clausenv -> constr freelisted +val clenv_template_type : 'a clausenv -> constr freelisted +val clenv_instance_type : wc clausenv -> metavariable -> constr +val clenv_instance_template : wc clausenv -> constr +val clenv_instance_template_type : wc clausenv -> constr +val clenv_instance : 'a clausenv -> constr freelisted -> constr +val clenv_type_of : wc clausenv -> constr -> constr +val clenv_fchain : metavariable -> 'a clausenv -> wc clausenv -> wc clausenv +val clenv_bchain : metavariable -> 'a clausenv -> wc clausenv -> wc clausenv + +(* Unification with clenv *) +type arg_bindings = (int * constr) list + +val clenv_unify : + bool -> Reductionops.conv_pb -> constr -> constr -> + wc clausenv -> wc clausenv +val clenv_match_args : + constr Rawterm.explicit_bindings -> wc clausenv -> wc clausenv +val clenv_constrain_with_bindings : arg_bindings -> wc clausenv -> wc clausenv + +(* Bindings *) +val clenv_independent : wc clausenv -> metavariable list +val clenv_dependent : bool -> 'a clausenv -> metavariable list +val clenv_missing : 'a clausenv -> metavariable list +val clenv_constrain_missing_args : (* Used in user contrib Lannion *) + constr list -> wc clausenv -> wc clausenv +(* +val clenv_constrain_dep_args : constr list -> wc clausenv -> wc clausenv +*) +val clenv_lookup_name : 'a clausenv -> identifier -> metavariable +val clenv_unique_resolver : + bool -> wc clausenv -> evar_info sigma -> wc clausenv + +val make_clenv_binding_apply : + wc -> int -> constr * constr -> types Rawterm.bindings -> wc clausenv +val make_clenv_binding : + wc -> constr * constr -> types Rawterm.bindings -> wc clausenv + +(* Pretty-print *) +val pr_clenv : 'a clausenv -> Pp.std_ppcmds diff --git a/pretyping/pretype_errors.ml b/pretyping/pretype_errors.ml index d7407c5d1d..84fd4798b7 100644 --- a/pretyping/pretype_errors.ml +++ b/pretyping/pretype_errors.ml @@ -27,6 +27,7 @@ type pretype_error = | NotClean of existential_key * constr * hole_kind | UnsolvableImplicit of hole_kind | CannotUnify of constr * constr + | CannotUnifyBindingType of constr * constr | CannotGeneralize of constr | NoOccurrenceFound of constr (* Pretyping *) diff --git a/pretyping/pretype_errors.mli b/pretyping/pretype_errors.mli index 2f9b1dc46a..fadd3f338f 100644 --- a/pretyping/pretype_errors.mli +++ b/pretyping/pretype_errors.mli @@ -29,6 +29,7 @@ type pretype_error = | NotClean of existential_key * constr * hole_kind | UnsolvableImplicit of hole_kind | CannotUnify of constr * constr + | CannotUnifyBindingType of constr * constr | CannotGeneralize of constr | NoOccurrenceFound of constr (* Pretyping *) diff --git a/pretyping/unification.ml b/pretyping/unification.ml index 8c33a07465..359484997b 100644 --- a/pretyping/unification.ml +++ b/pretyping/unification.ml @@ -57,7 +57,7 @@ type maps = evar_map * meta_map * [c] is typed in the context of [sp] and evar context [evd] with * [sp] removed to avoid circular definitions. *) -let w_Define evd sp c = +let w_Define sp c evd = let sigma = evars_of evd in if Evd.is_defined sigma sp then error "Unify.w_Define: cannot define evar twice"; @@ -213,17 +213,17 @@ let is_mimick_head f = (Const _|Var _|Rel _|Construct _|Ind _) -> true | _ -> false -let mimick_evar env evd hdc nargs sp = +let mimick_evar env hdc nargs sp evd = let (sigma',c) = applyHead env (evars_of evd) nargs hdc in evars_reset_evd sigma' evd; - w_Define evd sp c + w_Define sp c evd (* [w_merge env sigma b metas evars] merges common instances in metas or in evars, possibly generating new unification problems; if [b] is true, unification of types of metas is required *) -let w_merge env (sigma,metamap) with_types metas evars = +let w_merge env with_types metas evars (sigma,metamap) = let evd = create_evar_defs sigma in let mmap = ref metamap in let ty_metas = ref [] in @@ -254,14 +254,14 @@ let w_merge env (sigma,metamap) with_types metas evars = match krhs with | App (f,cl) when is_mimick_head f -> (try - w_Define evd evn rhs'; + w_Define evn rhs' evd; w_merge_rec metas t with ex when precatchable_exception ex -> - mimick_evar env evd f (Array.length cl) evn; + mimick_evar env f (Array.length cl) evn evd; w_merge_rec metas evars) | _ -> (* ensure tail recursion in non-mimickable case! *) - w_Define evd evn rhs'; + w_Define evn rhs' evd; w_merge_rec metas t end @@ -306,12 +306,12 @@ let w_merge env (sigma,metamap) with_types metas evars = [clenv_typed_unify M N clenv] expects in addition that expected types of metavars are unifiable with the types of their instances *) -let w_unify_core_0 env evd with_types cv_pb m n = +let w_unify_core_0 env with_types cv_pb m n evd = let (mc,ec) = unify_0 env (fst evd) cv_pb m n in - w_merge env evd with_types mc ec + w_merge env with_types mc ec evd -let w_unify_0 env evd = w_unify_core_0 env evd false -let w_typed_unify env evd = w_unify_core_0 env evd true +let w_unify_0 env = w_unify_core_0 env false +let w_typed_unify env = w_unify_core_0 env true (* takes a substitution s, an open term op and a closed term cl @@ -335,7 +335,7 @@ let w_unify_to_subterm env (op,cl) evd = let cl = strip_outer_cast cl in (try if closed0 cl - then w_unify_0 env evd CONV op cl,cl + then w_unify_0 env CONV op cl evd,cl else error "Bound 1" with ex when precatchable_exception ex -> (match kind_of_term cl with @@ -409,30 +409,30 @@ let w_unify_to_subterm_list env allow_K oplist t evd = oplist (evd,[]) -let secondOrderAbstraction env evd allow_K typ (p, oplist) = +let secondOrderAbstraction env allow_K typ (p, oplist) evd = let sigma = fst evd in let (evd',cllist) = w_unify_to_subterm_list env allow_K oplist typ evd in let typp = meta_type (snd evd') p in let pred = abstract_list_all env sigma typp typ cllist in - w_unify_0 env evd' CONV (mkMeta p) pred + w_unify_0 env CONV (mkMeta p) pred evd' -let w_unify2 env evd allow_K cv_pb ty1 ty2 = +let w_unify2 env allow_K cv_pb ty1 ty2 evd = let c1, oplist1 = whd_stack ty1 in let c2, oplist2 = whd_stack ty2 in match kind_of_term c1, kind_of_term c2 with | Meta p1, _ -> (* Find the predicate *) let evd' = - secondOrderAbstraction env evd allow_K ty2 (p1,oplist1) in + secondOrderAbstraction env allow_K ty2 (p1,oplist1) evd in (* Resume first order unification *) - w_unify_0 env evd' cv_pb (nf_meta (snd evd') ty1) ty2 + w_unify_0 env cv_pb (nf_meta (snd evd') ty1) ty2 evd' | _, Meta p2 -> (* Find the predicate *) let evd' = - secondOrderAbstraction env evd allow_K ty1 (p2, oplist2) in + secondOrderAbstraction env allow_K ty1 (p2, oplist2) evd in (* Resume first order unification *) - w_unify_0 env evd' cv_pb ty1 (nf_meta (snd evd') ty2) + w_unify_0 env cv_pb ty1 (nf_meta (snd evd') ty2) evd' | _ -> error "w_unify2" @@ -464,10 +464,10 @@ let w_unify allow_K env cv_pb ty1 ty2 evd = | (Meta _, true, Lambda _, _ | Lambda _, _, Meta _, true) when List.length l1 = List.length l2 -> (try - w_typed_unify env evd cv_pb ty1 ty2 + w_typed_unify env cv_pb ty1 ty2 evd with ex when precatchable_exception ex -> try - w_unify2 env evd allow_K cv_pb ty1 ty2 + w_unify2 env allow_K cv_pb ty1 ty2 evd with PretypeError (env,NoOccurrenceFound c) as e -> raise e | ex when precatchable_exception ex -> error "Cannot solve a second-order unification problem") @@ -475,14 +475,14 @@ let w_unify allow_K env cv_pb ty1 ty2 evd = (* Second order case *) | (Meta _, true, _, _ | _, _, Meta _, true) -> (try - w_unify2 env evd allow_K cv_pb ty1 ty2 + w_unify2 env allow_K cv_pb ty1 ty2 evd with PretypeError (env,NoOccurrenceFound c) as e -> raise e | ex when precatchable_exception ex -> try - w_typed_unify env evd cv_pb ty1 ty2 + w_typed_unify env cv_pb ty1 ty2 evd with ex when precatchable_exception ex -> error "Cannot solve a second-order unification problem") (* General case: try first order *) - | _ -> w_unify_0 env evd cv_pb ty1 ty2 + | _ -> w_unify_0 env cv_pb ty1 ty2 evd diff --git a/pretyping/unification.mli b/pretyping/unification.mli index ae276b2a82..d05b8cb5a8 100644 --- a/pretyping/unification.mli +++ b/pretyping/unification.mli @@ -19,7 +19,7 @@ open Evd type maps = evar_map * meta_map -val w_Define : Evarutil.evar_defs -> evar -> constr -> unit +val w_Define : evar -> constr -> Evarutil.evar_defs -> unit (* The "unique" unification fonction *) val w_unify : diff --git a/proofs/clenv.ml b/proofs/clenv.ml deleted file mode 100644 index a327a09f87..0000000000 --- a/proofs/clenv.ml +++ /dev/null @@ -1,562 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* incr meta_ctr; !meta_ctr - -(* replaces a mapping of existentials into a mapping of metas. - Problem if an evar appears in the type of another one (pops anomaly) *) -let exist_to_meta sigma (emap, c) = - let metamap = ref [] in - let change_exist evar = - let ty = nf_betaiota (nf_evar emap (existential_type emap evar)) in - let n = new_meta() in - metamap := (n, ty) :: !metamap; - mkMeta n in - let rec replace c = - match kind_of_term c with - Evar (k,_ as ev) when not (Evd.in_dom sigma k) -> change_exist ev - | _ -> map_constr replace c in - (!metamap, replace c) - -(* collects all metavar occurences, in left-to-right order, preserving - * repetitions and all. *) - -let collect_metas c = - let rec collrec acc c = - match kind_of_term c with - | Meta mv -> mv::acc - | _ -> fold_constr collrec acc c - in - List.rev (collrec [] c) - -(* Clausal environments *) - -type 'a clausenv = { - templval : constr freelisted; - templtyp : constr freelisted; - namenv : identifier Metamap.t; - env : meta_map; - hook : 'a } - -type wc = named_context sigma - - -(* [mentions clenv mv0 mv1] is true if mv1 is defined and mentions - * mv0, or if one of the free vars on mv1's freelist mentions - * mv0 *) - -let mentions clenv mv0 = - let rec menrec mv1 = - try - (match Metamap.find mv1 clenv.env with - | Clval (b,_) -> - Metaset.mem mv0 b.freemetas || meta_exists menrec b.freemetas - | Cltyp _ -> false) - with Not_found -> - false - in - menrec - -(* Creates a new clause-environment, whose template has a given - * type, CTY. This is not all that useful, since not very often - * does one know the type of the clause - one usually only has - * a clause which one wants to backchain thru. *) - -let mk_clenv wc cty = - let mv = new_meta () in - let cty_fls = mk_freelisted cty in - { templval = mk_freelisted (mkMeta mv); - templtyp = cty_fls; - namenv = Metamap.empty; - env = Metamap.add mv (Cltyp cty_fls) Metamap.empty ; - hook = wc } - -let clenv_environments bound c = - let rec clrec (ne,e,metas) n c = - match n, kind_of_term c with - | (Some 0, _) -> (ne, e, List.rev metas, c) - | (n, Cast (c,_)) -> clrec (ne,e,metas) n c - | (n, Prod (na,c1,c2)) -> - let mv = new_meta () in - let dep = dependent (mkRel 1) c2 in - let ne' = - if dep then - match na with - | Anonymous -> ne - | Name id -> - if metamap_in_dom mv ne then begin - warning ("Cannot put metavar "^(string_of_meta mv)^ - " in name-environment twice"); - ne - end else - Metamap.add mv id ne - else - ne - in - let e' = Metamap.add mv (Cltyp (mk_freelisted c1)) e in - clrec (ne',e', (mkMeta mv)::metas) (option_app ((+) (-1)) n) - (if dep then (subst1 (mkMeta mv) c2) else c2) - | (n, LetIn (na,b,_,c)) -> - clrec (ne,e,metas) (option_app ((+) (-1)) n) (subst1 b c) - | (n, _) -> (ne, e, List.rev metas, c) - in - clrec (Metamap.empty,Metamap.empty,[]) bound c - -let mk_clenv_from_n wc n (c,cty) = - let (namenv,env,args,concl) = clenv_environments n cty in - { templval = mk_freelisted (match args with [] -> c | _ -> applist (c,args)); - templtyp = mk_freelisted concl; - namenv = namenv; - env = env; - hook = wc } - -let mk_clenv_from wc = mk_clenv_from_n wc None - -let subst_clenv f sub clenv = - { templval = map_fl (subst_mps sub) clenv.templval; - templtyp = map_fl (subst_mps sub) clenv.templtyp; - namenv = clenv.namenv; - env = Metamap.map (map_clb (subst_mps sub)) clenv.env; - hook = f sub clenv.hook } - -let connect_clenv gls clenv = - let wc = {it=gls.it.evar_hyps; sigma=gls.sigma} in - { clenv with hook = wc } - -let clenv_wtactic f clenv = - let (sigma',mmap') = f (clenv.hook.sigma, clenv.env) in - {clenv with env = mmap' ; hook = {it=clenv.hook.it; sigma=sigma'}} - -let mk_clenv_hnf_constr_type_of wc t = - mk_clenv_from wc (t,w_hnf_constr wc (w_type_of wc t)) - -let mk_clenv_rename_from wc (c,t) = - mk_clenv_from wc (c,rename_bound_var (w_env wc) [] t) - -let mk_clenv_rename_from_n wc n (c,t) = - mk_clenv_from_n wc n (c,rename_bound_var (w_env wc) [] t) - -let mk_clenv_rename_type_of wc t = - mk_clenv_from wc (t,rename_bound_var (w_env wc) [] (w_type_of wc t)) - -let mk_clenv_rename_hnf_constr_type_of wc t = - mk_clenv_from wc - (t,rename_bound_var (w_env wc) [] (w_hnf_constr wc (w_type_of wc t))) - -let mk_clenv_type_of wc t = mk_clenv_from wc (t,w_type_of wc t) - -let clenv_assign mv rhs clenv = - let rhs_fls = mk_freelisted rhs in - if meta_exists (mentions clenv mv) rhs_fls.freemetas then - error "clenv__assign: circularity in unification"; - try - (match Metamap.find mv clenv.env with - | Clval (fls,ty) -> - if not (eq_constr fls.rebus rhs) then - try - (* Streams are lazy, force evaluation of id to catch Not_found*) - let id = Metamap.find mv clenv.namenv in - errorlabstrm "clenv_assign" - (str "An incompatible instantiation has already been found for " ++ - pr_id id) - with Not_found -> - anomaly "clenv_assign: non dependent metavar already assigned" - else - clenv - | Cltyp bty -> - { templval = clenv.templval; - templtyp = clenv.templtyp; - namenv = clenv.namenv; - env = Metamap.add mv (Clval (rhs_fls,bty)) clenv.env; - hook = clenv.hook }) - with Not_found -> - error "clenv_assign" - -let clenv_val_of clenv mv = - let rec valrec mv = - try - (match Metamap.find mv clenv.env with - | Cltyp _ -> mkMeta mv - | Clval(b,_) -> - instance (List.map (fun mv' -> (mv',valrec mv')) - (Metaset.elements b.freemetas)) b.rebus) - with Not_found -> - mkMeta mv - in - valrec mv - -let clenv_instance clenv b = - let c_sigma = - List.map - (fun mv -> (mv,clenv_val_of clenv mv)) (Metaset.elements b.freemetas) - in - instance c_sigma b.rebus - -let clenv_instance_term clenv c = - clenv_instance clenv (mk_freelisted c) - -(* [clenv_pose (na,mv,cty) clenv] - * returns a new clausenv which has added to it the metavar MV, - * with type CTY. the name NA, if it is not ANONYMOUS, will - * be entered into the name-map, as a way of accessing the new - * metavar. *) - -let clenv_pose (na,mv,cty) clenv = - { templval = clenv.templval; - templtyp = clenv.templtyp; - env = Metamap.add mv (Cltyp (mk_freelisted cty)) clenv.env; - namenv = (match na with - | Anonymous -> clenv.namenv - | Name id -> Metamap.add mv id clenv.namenv); - hook = clenv.hook } - -let clenv_defined clenv mv = - match Metamap.find mv clenv.env with - | Clval _ -> true - | Cltyp _ -> false - -let clenv_value clenv mv = - match Metamap.find mv clenv.env with - | Clval(b,_) -> b - | Cltyp _ -> failwith "clenv_value" - -let clenv_type clenv mv = - match Metamap.find mv clenv.env with - | Cltyp b -> b - | Clval(_,b) -> b - -let clenv_template clenv = clenv.templval - -let clenv_template_type clenv = clenv.templtyp - -let clenv_instance_value clenv mv = - clenv_instance clenv (clenv_value clenv mv) - -let clenv_instance_type clenv mv = - clenv_instance clenv (clenv_type clenv mv) - -let clenv_instance_template clenv = - clenv_instance clenv (clenv_template clenv) - -let clenv_instance_template_type clenv = - clenv_instance clenv (clenv_template_type clenv) - -let clenv_type_of ce c = - let metamap = - List.map - (function - | (n,Clval(_,typ)) -> (n,typ.rebus) - | (n,Cltyp typ) -> (n,typ.rebus)) - (metamap_to_list ce.env) - in - Retyping.get_type_of_with_meta (w_env ce.hook) (w_Underlying ce.hook) metamap c - -let clenv_instance_type_of ce c = - clenv_instance ce (mk_freelisted (clenv_type_of ce c)) - -let clenv_unify allow_K cv_pb t1 t2 clenv = - let env = w_env clenv.hook in - clenv_wtactic (Unification.w_unify allow_K env cv_pb t1 t2) clenv - -let clenv_unique_resolver allow_K clause gl = - clenv_unify allow_K CUMUL - (clenv_instance_template_type clause) (pf_concl gl) clause - -(* [clenv_bchain mv clenv' clenv] - * - * Resolves the value of "mv" (which must be undefined) in clenv to be - * the template of clenv' be the value "c", applied to "n" fresh - * metavars, whose types are chosen by destructing "clf", which should - * be a clausale forme generated from the type of "c". The process of - * resolution can cause unification of already-existing metavars, and - * of the fresh ones which get created. This operation is a composite - * of operations which pose new metavars, perform unification on - * terms, and make bindings. *) - -let clenv_bchain mv subclenv clenv = - (* Add the metavars of [subclenv] to [clenv], with their name-environment *) - let clenv' = - { templval = clenv.templval; - templtyp = clenv.templtyp; - namenv = - List.fold_left (fun ne (mv,id) -> - if clenv_defined subclenv mv then - ne - else if metamap_in_dom mv ne then begin - warning ("Cannot put metavar "^(string_of_meta mv)^ - " in name-environment twice"); - ne - end else - Metamap.add mv id ne) - clenv.namenv (metamap_to_list subclenv.namenv); - env = List.fold_left (fun m (n,v) -> Metamap.add n v m) - clenv.env (metamap_to_list subclenv.env); - hook = clenv.hook } - in - (* unify the type of the template of [subclenv] with the type of [mv] *) - let clenv'' = - clenv_unify true CUMUL - (clenv_instance clenv' (clenv_template_type subclenv)) - (clenv_instance_type clenv' mv) - clenv' - in - (* assign the metavar *) - let clenv''' = - clenv_assign mv (clenv_instance clenv' (clenv_template subclenv)) clenv'' - in - clenv''' - - -(* swaps the "hooks" in [clenv1] and [clenv2], so we can then use - backchain to hook them together *) - -let clenv_swap clenv1 clenv2 = - let clenv1' = { templval = clenv1.templval; - templtyp = clenv1.templtyp; - namenv = clenv1.namenv; - env = clenv1.env; - hook = clenv2.hook} - and clenv2' = { templval = clenv2.templval; - templtyp = clenv2.templtyp; - namenv = clenv2.namenv; - env = clenv2.env; - hook = clenv1.hook} - in - (clenv1',clenv2') - -let clenv_fchain mv nextclenv clenv = - let (clenv',nextclenv') = clenv_swap clenv nextclenv in - clenv_bchain mv clenv' nextclenv' - -(* [clenv_metavars clenv mv] - * returns a list of the metavars which appear in the type of - * the metavar mv. The list is unordered. *) - -let clenv_metavars clenv mv = - match Metamap.find mv clenv.env with - | Clval(_,b) -> b.freemetas - | Cltyp b -> b.freemetas - -let clenv_template_metavars clenv = clenv.templval.freemetas - -(* [clenv_dependent hyps_only clenv] - * returns a list of the metavars which appear in the template of clenv, - * and which are dependent, This is computed by taking the metavars in cval, - * in right-to-left order, and collecting the metavars which appear - * in their types, and adding in all the metavars appearing in the - * type of clenv. - * If [hyps_only] then metavariables occurring in the type are _excluded_ *) - -let dependent_metas clenv mvs conclmetas = - List.fold_right - (fun mv deps -> - Metaset.union deps (clenv_metavars clenv mv)) - mvs conclmetas - -let clenv_dependent hyps_only clenv = - let mvs = collect_metas (clenv_instance_template clenv) in - let ctyp_mvs = (mk_freelisted (clenv_instance_template_type clenv)).freemetas in - let deps = dependent_metas clenv mvs ctyp_mvs in - List.filter - (fun mv -> Metaset.mem mv deps && not (hyps_only && Metaset.mem mv ctyp_mvs)) - mvs - -let clenv_missing c = clenv_dependent true c - -(* [clenv_independent clenv] - * returns a list of metavariables which appear in the term cval, - * and which are not dependent. That is, they do not appear in - * the types of other metavars which are in cval, nor in the type - * of cval, ctyp. *) - -let clenv_independent clenv = - let mvs = collect_metas (clenv_instance_template clenv) in - let ctyp_mvs = (mk_freelisted (clenv_instance_template_type clenv)).freemetas in - let deps = dependent_metas clenv mvs ctyp_mvs in - List.filter (fun mv -> not (Metaset.mem mv deps)) mvs - -let w_coerce wc c ctyp target = - let j = make_judge c ctyp in - let env = w_env wc in - let isevars = Evarutil.create_evar_defs (w_Underlying wc) in - let j' = Coercion.inh_conv_coerce_to dummy_loc env isevars j target in - (* faire quelque chose avec isevars ? *) - j'.uj_val - -let clenv_constrain_dep_args hyps_only clause = function - | [] -> clause - | mlist -> - let occlist = clenv_dependent hyps_only clause in - if List.length occlist = List.length mlist then - List.fold_left2 - (fun clenv k c -> - let wc = clause.hook in - try - let k_typ = w_hnf_constr wc (clenv_instance_type clause k) in - let c_typ = w_hnf_constr wc (w_type_of wc c) in - let c' = w_coerce wc c c_typ k_typ in - clenv_unify true CONV (mkMeta k) c' clenv - with _ -> - clenv_unify true CONV (mkMeta k) c clenv) - clause occlist mlist - else - error ("Not the right number of missing arguments (expected " - ^(string_of_int (List.length occlist))^")") - -let clenv_constrain_missing_args mlist clause = - clenv_constrain_dep_args true clause mlist - -let clenv_lookup_name clenv id = - match metamap_inv clenv.namenv id with - | [] -> - errorlabstrm "clenv_lookup_name" - (str"No such bound variable " ++ pr_id id) - | [n] -> - n - | _ -> - anomaly "clenv_lookup_name: a name occurs more than once in clause" - -let clenv_match_args s clause = - let mvs = clenv_independent clause in - let rec matchrec clause = function - | [] -> clause - | (loc,b,c)::t -> - let k = - match b with - | NamedHyp s -> - if List.exists (fun (_,b',_) -> b=b') t then - errorlabstrm "clenv_match_args" - (str "The variable " ++ pr_id s ++ - str " occurs more than once in binding") - else - clenv_lookup_name clause s - | AnonHyp n -> - if List.exists (fun (_,b',_) -> b=b') t then - errorlabstrm "clenv_match_args" - (str "The position " ++ int n ++ - str " occurs more than once in binding"); - try - List.nth mvs (n-1) - with (Failure _|Invalid_argument _) -> - errorlabstrm "clenv_match_args" (str "No such binder") - in - let k_typ = w_hnf_constr clause.hook (clenv_instance_type clause k) - (* nf_betaiota was before in type_of - useful to reduce types like *) - (* (x:A)([x]P u) *) - and c_typ = w_hnf_constr clause.hook - (nf_betaiota (w_type_of clause.hook c)) in - let cl = - (* Try to infer some Meta/Evar from the type of [c] *) - try - clenv_assign k c (clenv_unify true CUMUL c_typ k_typ clause) - with _ -> - (* Try to coerce to the type of [k]; cannot merge with the - previous case because Coercion does not handle Meta *) - let c' = w_coerce clause.hook c c_typ k_typ in - try clenv_unify true CONV (mkMeta k) c' clause - with Pretype_errors.PretypeError - (_,Pretype_errors.CannotUnify (m,n)) -> - Stdpp.raise_with_loc loc - (RefinerError (CannotUnifyBindingType (m,n))) - in matchrec cl t - in - matchrec clause s - -type arg_bindings = (int * constr) list - -let clenv_constrain_with_bindings bl clause = - if bl = [] then - clause - else - let all_mvs = collect_metas (clenv_template clause).rebus in - let rec matchrec clause = function - | [] -> clause - | (n,c)::t -> - let k = - (try - if n > 0 then - List.nth all_mvs (n-1) - else if n < 0 then - List.nth (List.rev all_mvs) (-n-1) - else error "clenv_constrain_with_bindings" - with Failure _ -> - errorlabstrm "clenv_constrain_with_bindings" - (str"Clause did not have " ++ int n ++ str"-th" ++ - str" absolute argument")) in - let env = Global.env () in - let sigma = Evd.empty in - let k_typ = nf_betaiota (clenv_instance_type clause k) in - let c_typ = nf_betaiota (w_type_of clause.hook c) in - matchrec - (clenv_assign k c (clenv_unify true CUMUL c_typ k_typ clause)) t - in - matchrec clause bl - - -(***************************) - -(* Clausal environment for an application *) - -let make_clenv_binding_gen n wc (c,t) = function - | ImplicitBindings largs -> - let clause = mk_clenv_from_n wc n (c,t) in - clenv_constrain_dep_args (n <> None) clause largs - | ExplicitBindings lbind -> - let clause = mk_clenv_rename_from_n wc n (c,t) in - clenv_match_args lbind clause - | NoBindings -> - mk_clenv_from_n wc n (c,t) - -let make_clenv_binding_apply wc n = make_clenv_binding_gen (Some n) wc -let make_clenv_binding = make_clenv_binding_gen None - -open Printer - -let pr_clenv clenv = - let pr_name mv = - try - let id = Metamap.find mv clenv.namenv in - (str"[" ++ pr_id id ++ str"]") - with Not_found -> (mt ()) - in - let pr_meta_binding = function - | (mv,Cltyp b) -> - hov 0 - (pr_meta mv ++ pr_name mv ++ str " : " ++ prterm b.rebus ++ fnl ()) - | (mv,Clval(b,_)) -> - hov 0 - (pr_meta mv ++ pr_name mv ++ str " := " ++ prterm b.rebus ++ fnl ()) - in - (str"TEMPL: " ++ prterm clenv.templval.rebus ++ - str" : " ++ prterm clenv.templtyp.rebus ++ fnl () ++ - (prlist pr_meta_binding (metamap_to_list clenv.env))) diff --git a/proofs/clenv.mli b/proofs/clenv.mli deleted file mode 100644 index 5ca846b06c..0000000000 --- a/proofs/clenv.mli +++ /dev/null @@ -1,104 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* metavariable - -(* [exist_to_meta] generates new metavariables for each existential - and performs the replacement in the given constr *) -val exist_to_meta : - Evd.evar_map -> Pretyping.open_constr -> (Termops.metamap * constr) - -(* The Type of Constructions clausale environments. *) - -type 'a clausenv = { - templval : constr freelisted; - templtyp : constr freelisted; - namenv : identifier Metamap.t; - env : meta_map; - hook : 'a } - -type wc = named_context sigma (* for a better reading of the following *) - -(* [templval] is the template which we are trying to fill out. - * [templtyp] is its type. - * [namenv] is a mapping from metavar numbers to names, for - * use in instanciating metavars by name. - * [env] is the mapping from metavar numbers to their types - * and values. - * [hook] is the pointer to the current walking context, for - * integrating existential vars and metavars. *) - -val collect_metas : constr -> metavariable list -val mk_clenv : 'a -> constr -> 'a clausenv -val mk_clenv_from : 'a -> constr * constr -> 'a clausenv -val mk_clenv_from_n : 'a -> int option -> constr * constr -> 'a clausenv -val mk_clenv_rename_from : wc -> constr * constr -> wc clausenv -val mk_clenv_rename_from_n : wc -> int option -> constr * constr -> wc clausenv -val mk_clenv_hnf_constr_type_of : wc -> constr -> wc clausenv -val mk_clenv_type_of : wc -> constr -> wc clausenv - -val subst_clenv : (substitution -> 'a -> 'a) -> - substitution -> 'a clausenv -> 'a clausenv -val clenv_wtactic : - (evar_map * meta_map -> evar_map * meta_map) -> wc clausenv -> wc clausenv - -val connect_clenv : goal sigma -> 'a clausenv -> wc clausenv -val clenv_assign : metavariable -> constr -> 'a clausenv -> 'a clausenv -val clenv_instance_term : wc clausenv -> constr -> constr -val clenv_pose : name * metavariable * constr -> 'a clausenv -> 'a clausenv -val clenv_template : 'a clausenv -> constr freelisted -val clenv_template_type : 'a clausenv -> constr freelisted -val clenv_instance_type : wc clausenv -> metavariable -> constr -val clenv_instance_template : wc clausenv -> constr -val clenv_instance_template_type : wc clausenv -> constr -val clenv_instance : 'a clausenv -> constr freelisted -> constr -val clenv_type_of : wc clausenv -> constr -> constr -val clenv_fchain : metavariable -> 'a clausenv -> wc clausenv -> wc clausenv -val clenv_bchain : metavariable -> 'a clausenv -> wc clausenv -> wc clausenv - -(* Unification with clenv *) -type arg_bindings = (int * constr) list - -val clenv_unify : - bool -> Reductionops.conv_pb -> constr -> constr -> - wc clausenv -> wc clausenv -val clenv_match_args : - constr Rawterm.explicit_bindings -> wc clausenv -> wc clausenv -val clenv_constrain_with_bindings : arg_bindings -> wc clausenv -> wc clausenv - -(* Bindings *) -val clenv_independent : wc clausenv -> metavariable list -val clenv_dependent : bool -> 'a clausenv -> metavariable list -val clenv_missing : 'a clausenv -> metavariable list -val clenv_constrain_missing_args : (* Used in user contrib Lannion *) - constr list -> wc clausenv -> wc clausenv -(* -val clenv_constrain_dep_args : constr list -> wc clausenv -> wc clausenv -*) -val clenv_lookup_name : 'a clausenv -> identifier -> metavariable -val clenv_unique_resolver : bool -> wc clausenv -> goal sigma -> wc clausenv - -val make_clenv_binding_apply : - wc -> int -> constr * constr -> types Rawterm.bindings -> wc clausenv -val make_clenv_binding : - wc -> constr * constr -> types Rawterm.bindings -> wc clausenv - -(* Pretty-print *) -val pr_clenv : 'a clausenv -> Pp.std_ppcmds diff --git a/proofs/logic.ml b/proofs/logic.ml index 314e3c5976..82994669b9 100644 --- a/proofs/logic.ml +++ b/proofs/logic.ml @@ -25,7 +25,6 @@ open Proof_trees open Proof_type open Typeops open Type_errors -open Coqast open Retyping open Evarutil @@ -40,7 +39,6 @@ type refiner_error = | NonLinearProof of constr (* Errors raised by the tactics *) - | CannotUnifyBindingType of constr * constr | IntroNeedsProduct | DoesNotOccurIn of constr * identifier @@ -51,8 +49,10 @@ open Pretype_errors let catchable_exception = function | Util.UserError _ | TypeError _ | RefinerError _ (* unification errors *) - | PretypeError(_,(CannotUnify _|CannotGeneralize _|NoOccurrenceFound _)) - | Stdpp.Exc_located(_,PretypeError(_,(CannotUnify _|CannotGeneralize _|NoOccurrenceFound _))) + | PretypeError(_,(CannotUnify _|CannotGeneralize _|NoOccurrenceFound _| + CannotUnifyBindingType _)) + | Stdpp.Exc_located(_,PretypeError(_,(CannotUnify _|CannotGeneralize _| + NoOccurrenceFound _ | CannotUnifyBindingType _))) | Stdpp.Exc_located(_,(Util.UserError _ | TypeError _ | RefinerError _ | Nametab.GlobalizationError _ | PretypeError (_,VarNotFound _))) -> true | _ -> false diff --git a/proofs/logic.mli b/proofs/logic.mli index 34e5b9e980..0a641e9751 100644 --- a/proofs/logic.mli +++ b/proofs/logic.mli @@ -54,7 +54,6 @@ type refiner_error = | NonLinearProof of constr (*i Errors raised by the tactics i*) - | CannotUnifyBindingType of constr * constr | IntroNeedsProduct | DoesNotOccurIn of constr * identifier diff --git a/proofs/refiner.ml b/proofs/refiner.ml index 248f6b40bc..a0053d8a1d 100644 --- a/proofs/refiner.ml +++ b/proofs/refiner.ml @@ -21,7 +21,6 @@ open Type_errors open Proof_trees open Proof_type open Logic -open Printer type transformation_tactic = proof_tree -> (goal list * validation) @@ -952,7 +951,7 @@ let rec print_proof sigma osign pf = ) let pr_change gl = - (str"Change " ++ prterm_env (Global.env()) gl.evar_concl ++ str".") + (str"Change " ++ Printer.prterm_env (Global.env()) gl.evar_concl ++ str".") let rec print_script nochange sigma osign pf = let {evar_hyps=sign; evar_concl=cl} = pf.goal in @@ -969,6 +968,7 @@ let rec print_script nochange sigma osign pf = prlist_with_sep pr_fnl (print_script nochange sigma sign) spfl) +(* printed by Show Script command *) let print_treescript nochange sigma _osign pf = let rec aux top pf = let {evar_hyps=sign; evar_concl=cl} = pf.goal in diff --git a/proofs/tacmach.ml b/proofs/tacmach.ml index 1b1e88e828..0ea076edd3 100644 --- a/proofs/tacmach.ml +++ b/proofs/tacmach.ml @@ -238,7 +238,6 @@ let rename_hyp id id' = with_check (rename_hyp_no_check id id') (* Pretty-printers *) open Pp -open Printer open Tacexpr open Rawterm diff --git a/proofs/tactic_debug.ml b/proofs/tactic_debug.ml index 1fa1101d66..cfa65119f3 100644 --- a/proofs/tactic_debug.ml +++ b/proofs/tactic_debug.ml @@ -6,7 +6,6 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open Ast open Names open Constrextern open Pp diff --git a/toplevel/himsg.ml b/toplevel/himsg.ml index d6f9a990c5..e032b9f00a 100644 --- a/toplevel/himsg.ml +++ b/toplevel/himsg.ml @@ -384,6 +384,12 @@ let explain_refiner_cannot_generalize ty = let explain_no_occurrence_found c = str "Found no subterm matching " ++ prterm c ++ str " in the current goal" +let explain_cannot_unify_binding_type m n = + let pm = prterm m in + let pn = prterm n in + str "This binding has type" ++ brk(1,1) ++ pm ++ spc () ++ + str "which should be unifiable with" ++ brk(1,1) ++ pn + let explain_type_error ctx err = let ctx = make_all_name_different ctx in match err with @@ -443,6 +449,7 @@ let explain_pretype_error ctx err = | CannotUnify (m,n) -> explain_cannot_unify m n | CannotGeneralize ty -> explain_refiner_cannot_generalize ty | NoOccurrenceFound c -> explain_no_occurrence_found c + | CannotUnifyBindingType (m,n) -> explain_cannot_unify_binding_type m n (* Refiner errors *) @@ -466,12 +473,6 @@ let explain_refiner_cannot_apply t harg = prterm t ++ spc () ++ str"could not be applied to" ++ brk(1,1) ++ prterm harg -let explain_cannot_unify_binding_type m n = - let pm = prterm m in - let pn = prterm n in - str "This binding has type" ++ brk(1,1) ++ pm ++ spc () ++ - str "which should be unifiable with" ++ brk(1,1) ++ pn - let explain_refiner_not_well_typed c = str"The term " ++ prterm c ++ str" is not well-typed" @@ -491,7 +492,6 @@ let explain_refiner_error = function | OccurMeta t -> explain_refiner_occur_meta t | OccurMetaGoal t -> explain_refiner_occur_meta_goal t | CannotApply (t,harg) -> explain_refiner_cannot_apply t harg - | CannotUnifyBindingType (m,n) -> explain_cannot_unify_binding_type m n | NotWellTyped c -> explain_refiner_not_well_typed c | IntroNeedsProduct -> explain_intro_needs_product () | DoesNotOccurIn (c,hyp) -> explain_does_not_occur_in c hyp -- cgit v1.2.3