From 420f78b2caeaaddc6fe484565b2d0e49c66888e5 Mon Sep 17 00:00:00 2001 From: Stephane Glondu Date: Sun, 27 Jul 2014 10:02:38 +0200 Subject: Imported Upstream version 8.4pl4dfsg --- CHANGES | 40 +++++++++++++ checker/check.ml | 2 +- checker/check_stat.ml | 2 +- checker/check_stat.mli | 2 +- checker/checker.ml | 2 +- checker/closure.ml | 2 +- checker/closure.mli | 2 +- checker/indtypes.ml | 2 +- checker/indtypes.mli | 2 +- checker/inductive.ml | 19 +++--- checker/inductive.mli | 2 +- checker/mod_checking.mli | 2 +- checker/modops.ml | 2 +- checker/modops.mli | 2 +- checker/reduction.ml | 2 +- checker/reduction.mli | 2 +- checker/safe_typing.ml | 2 +- checker/safe_typing.mli | 2 +- checker/subtyping.ml | 2 +- checker/subtyping.mli | 2 +- checker/term.ml | 2 +- checker/type_errors.ml | 2 +- checker/type_errors.mli | 2 +- checker/typeops.ml | 2 +- checker/typeops.mli | 2 +- checker/validate.ml | 2 +- config/coq_config.mli | 2 +- configure | 4 +- dev/db_printers.ml | 2 +- dev/header | 2 +- dev/top_printers.ml | 2 +- ide/command_windows.ml | 2 +- ide/command_windows.mli | 2 +- ide/config_lexer.mll | 2 +- ide/coq.ml | 8 ++- ide/coq.mli | 2 +- ide/coq_commands.ml | 2 +- ide/coq_lex.mll | 2 +- ide/coqide.ml | 2 +- ide/coqide.mli | 2 +- ide/coqide_main.ml4 | 2 +- ide/gtk_parsing.ml | 2 +- ide/ideproof.ml | 2 +- ide/ideutils.ml | 2 +- ide/ideutils.mli | 2 +- ide/preferences.ml | 2 +- ide/preferences.mli | 2 +- ide/tags.ml | 2 +- ide/tags.mli | 2 +- ide/typed_notebook.ml | 2 +- ide/undo.ml | 2 +- ide/undo_lablgtk_ge212.mli | 2 +- ide/undo_lablgtk_ge26.mli | 2 +- ide/undo_lablgtk_lt26.mli | 2 +- ide/utf8_convert.mll | 2 +- interp/constrextern.ml | 2 +- interp/constrextern.mli | 2 +- interp/constrintern.ml | 4 +- interp/constrintern.mli | 2 +- interp/coqlib.ml | 2 +- interp/coqlib.mli | 2 +- interp/dumpglob.ml | 2 +- interp/dumpglob.mli | 2 +- interp/genarg.ml | 26 +++++---- interp/genarg.mli | 14 +++-- interp/implicit_quantifiers.ml | 2 +- interp/implicit_quantifiers.mli | 2 +- interp/modintern.ml | 2 +- interp/modintern.mli | 2 +- interp/notation.ml | 2 +- interp/notation.mli | 2 +- interp/ppextend.ml | 2 +- interp/ppextend.mli | 2 +- interp/reserve.ml | 2 +- interp/reserve.mli | 2 +- interp/smartlocate.ml | 2 +- interp/smartlocate.mli | 2 +- interp/syntax_def.ml | 2 +- interp/syntax_def.mli | 2 +- interp/topconstr.ml | 2 +- interp/topconstr.mli | 2 +- kernel/cbytecodes.ml | 2 +- kernel/cbytecodes.mli | 2 +- kernel/cbytegen.ml | 2 +- kernel/cemitcodes.ml | 2 +- kernel/closure.ml | 2 +- kernel/closure.mli | 2 +- kernel/conv_oracle.ml | 2 +- kernel/conv_oracle.mli | 2 +- kernel/cooking.ml | 2 +- kernel/cooking.mli | 2 +- kernel/csymtable.ml | 2 +- kernel/csymtable.mli | 2 +- kernel/declarations.ml | 2 +- kernel/declarations.mli | 2 +- kernel/entries.ml | 2 +- kernel/entries.mli | 2 +- kernel/environ.ml | 2 +- kernel/environ.mli | 2 +- kernel/esubst.ml | 2 +- kernel/esubst.mli | 2 +- kernel/indtypes.ml | 2 +- kernel/indtypes.mli | 2 +- kernel/inductive.ml | 34 +++++------ kernel/inductive.mli | 2 +- kernel/mod_subst.ml | 2 +- kernel/mod_subst.mli | 2 +- kernel/mod_typing.ml | 2 +- kernel/mod_typing.mli | 2 +- kernel/modops.ml | 2 +- kernel/modops.mli | 2 +- kernel/names.ml | 2 +- kernel/names.mli | 2 +- kernel/pre_env.ml | 2 +- kernel/pre_env.mli | 2 +- kernel/reduction.ml | 2 +- kernel/reduction.mli | 2 +- kernel/retroknowledge.ml | 2 +- kernel/retroknowledge.mli | 2 +- kernel/safe_typing.ml | 4 +- kernel/safe_typing.mli | 2 +- kernel/sign.ml | 2 +- kernel/sign.mli | 2 +- kernel/subtyping.ml | 2 +- kernel/subtyping.mli | 2 +- kernel/term.ml | 2 +- kernel/term.mli | 2 +- kernel/term_typing.ml | 2 +- kernel/term_typing.mli | 2 +- kernel/type_errors.ml | 2 +- kernel/type_errors.mli | 2 +- kernel/typeops.ml | 2 +- kernel/typeops.mli | 2 +- kernel/univ.ml | 2 +- kernel/univ.mli | 2 +- kernel/vconv.mli | 2 +- kernel/vm.ml | 2 +- lib/bigint.ml | 2 +- lib/bigint.mli | 2 +- lib/compat.ml4 | 2 +- lib/dnet.ml | 2 +- lib/dnet.mli | 2 +- lib/dyn.ml | 2 +- lib/dyn.mli | 2 +- lib/envars.ml | 28 +++++---- lib/envars.mli | 2 +- lib/explore.ml | 2 +- lib/explore.mli | 2 +- lib/flags.ml | 2 +- lib/flags.mli | 2 +- lib/gmap.ml | 2 +- lib/gmap.mli | 2 +- lib/gmapl.ml | 2 +- lib/gmapl.mli | 2 +- lib/hashcons.ml | 2 +- lib/hashcons.mli | 2 +- lib/hashtbl_alt.ml | 2 +- lib/hashtbl_alt.mli | 2 +- lib/heap.ml | 2 +- lib/heap.mli | 2 +- lib/option.ml | 2 +- lib/option.mli | 2 +- lib/pp.ml4 | 2 +- lib/pp.mli | 2 +- lib/pp_control.ml | 2 +- lib/pp_control.mli | 2 +- lib/profile.ml | 2 +- lib/profile.mli | 2 +- lib/rtree.ml | 2 +- lib/rtree.mli | 2 +- lib/system.ml | 2 +- lib/system.mli | 2 +- lib/tries.ml | 2 +- lib/unionfind.ml | 2 +- lib/unionfind.mli | 2 +- lib/util.mli | 2 +- library/assumptions.ml | 2 +- library/assumptions.mli | 2 +- library/decl_kinds.ml | 2 +- library/decl_kinds.mli | 2 +- library/declare.ml | 2 +- library/declare.mli | 2 +- library/declaremods.ml | 2 +- library/declaremods.mli | 2 +- library/decls.ml | 2 +- library/decls.mli | 2 +- library/dischargedhypsmap.ml | 2 +- library/dischargedhypsmap.mli | 2 +- library/global.ml | 2 +- library/global.mli | 2 +- library/goptions.ml | 2 +- library/goptions.mli | 2 +- library/goptionstyp.mli | 2 +- library/heads.ml | 2 +- library/heads.mli | 2 +- library/impargs.ml | 2 +- library/impargs.mli | 2 +- library/lib.ml | 2 +- library/lib.mli | 2 +- library/libnames.ml | 2 +- library/libnames.mli | 2 +- library/libobject.ml | 2 +- library/libobject.mli | 2 +- library/library.ml | 2 +- library/library.mli | 2 +- library/nameops.ml | 2 +- library/nameops.mli | 2 +- library/nametab.ml | 2 +- library/nametab.mli | 2 +- library/states.ml | 2 +- library/states.mli | 2 +- library/summary.ml | 2 +- library/summary.mli | 2 +- parsing/argextend.ml4 | 8 +-- parsing/egrammar.ml | 2 +- parsing/egrammar.mli | 2 +- parsing/extend.ml | 2 +- parsing/extend.mli | 2 +- parsing/extrawit.ml | 2 +- parsing/extrawit.mli | 2 +- parsing/g_constr.ml4 | 2 +- parsing/g_ltac.ml4 | 2 +- parsing/g_prim.ml4 | 2 +- parsing/g_proofs.ml4 | 2 +- parsing/g_tactic.ml4 | 7 ++- parsing/g_vernac.ml4 | 5 +- parsing/g_xml.ml4 | 2 +- parsing/lexer.ml4 | 2 +- parsing/lexer.mli | 2 +- parsing/pcoq.ml4 | 8 ++- parsing/pcoq.mli | 3 +- parsing/ppconstr.ml | 2 +- parsing/ppconstr.mli | 2 +- parsing/pptactic.ml | 8 +-- parsing/pptactic.mli | 2 +- parsing/ppvernac.ml | 2 +- parsing/ppvernac.mli | 2 +- parsing/prettyp.ml | 2 +- parsing/prettyp.mli | 2 +- parsing/printer.ml | 10 ++-- parsing/printer.mli | 2 +- parsing/printmod.ml | 2 +- parsing/printmod.mli | 2 +- parsing/q_constr.ml4 | 2 +- parsing/q_coqast.ml4 | 4 +- parsing/q_util.ml4 | 2 +- parsing/q_util.mli | 2 +- parsing/tacextend.ml4 | 2 +- parsing/tactic_printer.ml | 2 +- parsing/tactic_printer.mli | 2 +- parsing/tok.ml | 2 +- parsing/tok.mli | 2 +- parsing/vernacextend.ml4 | 2 +- plugins/cc/ccalgo.ml | 2 +- plugins/cc/ccalgo.mli | 2 +- plugins/cc/ccproof.ml | 2 +- plugins/cc/ccproof.mli | 2 +- plugins/cc/cctac.ml | 2 +- plugins/cc/cctac.mli | 2 +- plugins/cc/g_congruence.ml4 | 2 +- plugins/decl_mode/decl_expr.mli | 2 +- plugins/decl_mode/decl_interp.ml | 2 +- plugins/decl_mode/decl_interp.mli | 2 +- plugins/decl_mode/decl_mode.ml | 2 +- plugins/decl_mode/decl_mode.mli | 2 +- plugins/decl_mode/decl_proof_instr.ml | 2 +- plugins/decl_mode/decl_proof_instr.mli | 2 +- plugins/decl_mode/g_decl_mode.ml4 | 2 +- plugins/decl_mode/ppdecl_proof.ml | 2 +- plugins/extraction/ExtrOcamlBasic.v | 2 +- plugins/extraction/ExtrOcamlBigIntConv.v | 2 +- plugins/extraction/ExtrOcamlIntConv.v | 2 +- plugins/extraction/ExtrOcamlNatBigInt.v | 2 +- plugins/extraction/ExtrOcamlNatInt.v | 2 +- plugins/extraction/ExtrOcamlString.v | 2 +- plugins/extraction/ExtrOcamlZBigInt.v | 2 +- plugins/extraction/ExtrOcamlZInt.v | 2 +- plugins/extraction/big.ml | 2 +- plugins/extraction/common.ml | 2 +- plugins/extraction/common.mli | 2 +- plugins/extraction/extract_env.ml | 2 +- plugins/extraction/extract_env.mli | 2 +- plugins/extraction/extraction.ml | 2 +- plugins/extraction/extraction.mli | 2 +- plugins/extraction/g_extraction.ml4 | 2 +- plugins/extraction/haskell.ml | 2 +- plugins/extraction/haskell.mli | 2 +- plugins/extraction/miniml.mli | 2 +- plugins/extraction/mlutil.ml | 2 +- plugins/extraction/mlutil.mli | 2 +- plugins/extraction/modutil.ml | 2 +- plugins/extraction/modutil.mli | 2 +- plugins/extraction/ocaml.ml | 2 +- plugins/extraction/ocaml.mli | 2 +- plugins/extraction/scheme.ml | 2 +- plugins/extraction/scheme.mli | 2 +- plugins/extraction/table.ml | 2 +- plugins/extraction/table.mli | 2 +- plugins/field/LegacyField.v | 2 +- plugins/field/LegacyField_Compl.v | 2 +- plugins/field/LegacyField_Tactic.v | 2 +- plugins/field/LegacyField_Theory.v | 2 +- plugins/field/field.ml4 | 2 +- plugins/firstorder/formula.ml | 2 +- plugins/firstorder/formula.mli | 2 +- plugins/firstorder/g_ground.ml4 | 2 +- plugins/firstorder/ground.ml | 2 +- plugins/firstorder/ground.mli | 2 +- plugins/firstorder/instances.ml | 2 +- plugins/firstorder/instances.mli | 2 +- plugins/firstorder/rules.ml | 2 +- plugins/firstorder/rules.mli | 2 +- plugins/firstorder/sequent.ml | 2 +- plugins/firstorder/sequent.mli | 2 +- plugins/firstorder/unify.ml | 2 +- plugins/firstorder/unify.mli | 2 +- plugins/fourier/Fourier.v | 2 +- plugins/fourier/Fourier_util.v | 2 +- plugins/fourier/fourier.ml | 2 +- plugins/fourier/fourierR.ml | 2 +- plugins/fourier/g_fourier.ml4 | 2 +- plugins/funind/Recdef.v | 2 +- plugins/funind/functional_principles_proofs.ml | 6 +- plugins/funind/g_indfun.ml4 | 2 +- plugins/funind/invfun.ml | 51 ++++++++-------- plugins/funind/merge.ml | 2 +- plugins/funind/recdef.ml | 4 +- plugins/micromega/CheckerMaker.v | 2 +- plugins/micromega/Env.v | 2 +- plugins/micromega/EnvRing.v | 2 +- plugins/micromega/MExtraction.v | 2 +- plugins/micromega/OrderedRing.v | 2 +- plugins/micromega/Psatz.v | 2 +- plugins/micromega/QMicromega.v | 2 +- plugins/micromega/RMicromega.v | 2 +- plugins/micromega/Refl.v | 2 +- plugins/micromega/RingMicromega.v | 2 +- plugins/micromega/Tauto.v | 2 +- plugins/micromega/VarMap.v | 2 +- plugins/micromega/ZCoeff.v | 2 +- plugins/micromega/ZMicromega.v | 2 +- plugins/micromega/certificate.ml | 2 +- plugins/micromega/coq_micromega.ml | 34 ++++++----- plugins/micromega/csdpcert.ml | 2 +- plugins/micromega/g_micromega.ml4 | 2 +- plugins/micromega/mutils.ml | 2 +- plugins/micromega/persistent_cache.ml | 2 +- plugins/micromega/polynomial.ml | 2 +- plugins/micromega/sos.mli | 2 +- plugins/micromega/sos_types.ml | 2 +- plugins/nsatz/Nsatz.v | 2 +- plugins/nsatz/ideal.ml | 2 +- plugins/nsatz/nsatz.ml4 | 2 +- plugins/nsatz/polynom.ml | 2 +- plugins/nsatz/polynom.mli | 2 +- plugins/omega/Omega.v | 2 +- plugins/omega/OmegaPlugin.v | 2 +- plugins/omega/PreOmega.v | 2 +- plugins/omega/coq_omega.ml | 67 +++++++++++++++++----- plugins/omega/g_omega.ml4 | 2 +- plugins/omega/omega.ml | 2 +- plugins/quote/Quote.v | 2 +- plugins/quote/g_quote.ml4 | 2 +- plugins/quote/quote.ml | 2 +- plugins/ring/LegacyArithRing.v | 2 +- plugins/ring/LegacyNArithRing.v | 2 +- plugins/ring/LegacyRing.v | 2 +- plugins/ring/LegacyRing_theory.v | 2 +- plugins/ring/LegacyZArithRing.v | 2 +- plugins/ring/Ring_abstract.v | 2 +- plugins/ring/Ring_normalize.v | 2 +- plugins/ring/Setoid_ring.v | 2 +- plugins/ring/Setoid_ring_normalize.v | 2 +- plugins/ring/Setoid_ring_theory.v | 2 +- plugins/ring/g_ring.ml4 | 2 +- plugins/ring/ring.ml | 2 +- plugins/rtauto/Bintree.v | 2 +- plugins/rtauto/Rtauto.v | 2 +- plugins/rtauto/g_rtauto.ml4 | 2 +- plugins/rtauto/proof_search.ml | 2 +- plugins/rtauto/proof_search.mli | 2 +- plugins/rtauto/refl_tauto.ml | 2 +- plugins/rtauto/refl_tauto.mli | 2 +- plugins/setoid_ring/ArithRing.v | 2 +- plugins/setoid_ring/BinList.v | 2 +- plugins/setoid_ring/Cring.v | 2 +- plugins/setoid_ring/Field.v | 2 +- plugins/setoid_ring/Field_tac.v | 2 +- plugins/setoid_ring/Field_theory.v | 2 +- plugins/setoid_ring/InitialRing.v | 2 +- plugins/setoid_ring/NArithRing.v | 2 +- plugins/setoid_ring/Ncring.v | 2 +- plugins/setoid_ring/Ncring_initial.v | 2 +- plugins/setoid_ring/Ncring_polynom.v | 2 +- plugins/setoid_ring/Ncring_tac.v | 2 +- plugins/setoid_ring/Ring.v | 2 +- plugins/setoid_ring/Ring_base.v | 2 +- plugins/setoid_ring/Ring_polynom.v | 2 +- plugins/setoid_ring/Ring_theory.v | 2 +- plugins/setoid_ring/ZArithRing.v | 2 +- plugins/setoid_ring/newring.ml4 | 2 +- plugins/subtac/eterm.mli | 2 +- plugins/subtac/g_subtac.ml4 | 2 +- plugins/subtac/subtac.ml | 2 +- plugins/subtac/subtac_cases.ml | 6 +- plugins/subtac/subtac_cases.mli | 2 +- plugins/subtac/subtac_classes.ml | 2 +- plugins/subtac/subtac_classes.mli | 2 +- plugins/subtac/subtac_coercion.ml | 8 +-- plugins/subtac/subtac_pretyping.ml | 4 +- plugins/subtac/subtac_pretyping_F.ml | 25 ++++---- plugins/syntax/nat_syntax.ml | 2 +- plugins/syntax/numbers_syntax.ml | 2 +- plugins/syntax/r_syntax.ml | 2 +- plugins/syntax/z_syntax.ml | 2 +- plugins/xml/dumptree.ml4 | 2 +- pretyping/arguments_renaming.ml | 2 +- pretyping/arguments_renaming.mli | 2 +- pretyping/cases.ml | 6 +- pretyping/cases.mli | 2 +- pretyping/cbv.ml | 2 +- pretyping/cbv.mli | 2 +- pretyping/classops.ml | 2 +- pretyping/classops.mli | 2 +- pretyping/coercion.ml | 24 ++++---- pretyping/coercion.mli | 20 ++++--- pretyping/detyping.ml | 2 +- pretyping/detyping.mli | 2 +- pretyping/evarconv.ml | 20 ++++++- pretyping/evarconv.mli | 2 +- pretyping/evarutil.ml | 37 ++++++++---- pretyping/evarutil.mli | 2 +- pretyping/evd.ml | 2 +- pretyping/evd.mli | 2 +- pretyping/glob_term.ml | 23 +------- pretyping/glob_term.mli | 2 +- pretyping/indrec.ml | 2 +- pretyping/indrec.mli | 2 +- pretyping/inductiveops.ml | 2 +- pretyping/inductiveops.mli | 2 +- pretyping/matching.ml | 2 +- pretyping/matching.mli | 2 +- pretyping/namegen.ml | 2 +- pretyping/namegen.mli | 2 +- pretyping/pattern.ml | 2 +- pretyping/pattern.mli | 2 +- pretyping/pretype_errors.ml | 2 +- pretyping/pretype_errors.mli | 2 +- pretyping/pretyping.ml | 43 ++++++++------ pretyping/pretyping.mli | 6 +- pretyping/recordops.ml | 2 +- pretyping/recordops.mli | 2 +- pretyping/reductionops.ml | 2 +- pretyping/reductionops.mli | 2 +- pretyping/retyping.ml | 2 +- pretyping/retyping.mli | 2 +- pretyping/tacred.ml | 2 +- pretyping/tacred.mli | 2 +- pretyping/term_dnet.ml | 2 +- pretyping/term_dnet.mli | 2 +- pretyping/termops.ml | 2 +- pretyping/termops.mli | 2 +- pretyping/typeclasses.ml | 2 +- pretyping/typeclasses.mli | 2 +- pretyping/typeclasses_errors.ml | 2 +- pretyping/typeclasses_errors.mli | 2 +- pretyping/typing.ml | 2 +- pretyping/typing.mli | 2 +- pretyping/unification.ml | 4 +- pretyping/unification.mli | 2 +- pretyping/vnorm.ml | 2 +- pretyping/vnorm.mli | 2 +- proofs/clenv.ml | 2 +- proofs/clenv.mli | 2 +- proofs/clenvtac.ml | 2 +- proofs/clenvtac.mli | 2 +- proofs/evar_refiner.ml | 2 +- proofs/evar_refiner.mli | 2 +- proofs/goal.ml | 4 +- proofs/goal.mli | 2 +- proofs/logic.ml | 2 +- proofs/logic.mli | 2 +- proofs/pfedit.ml | 2 +- proofs/pfedit.mli | 2 +- proofs/proof.ml | 2 +- proofs/proof.mli | 2 +- proofs/proof_global.ml | 2 +- proofs/proof_global.mli | 2 +- proofs/proof_type.ml | 2 +- proofs/proof_type.mli | 2 +- proofs/proofview.ml | 2 +- proofs/proofview.mli | 2 +- proofs/redexpr.ml | 2 +- proofs/redexpr.mli | 2 +- proofs/refiner.ml | 2 +- proofs/refiner.mli | 2 +- proofs/tacexpr.ml | 2 +- proofs/tacmach.ml | 2 +- proofs/tacmach.mli | 2 +- proofs/tactic_debug.ml | 2 +- proofs/tactic_debug.mli | 2 +- scripts/coqc.ml | 16 +++--- scripts/coqmktop.ml | 2 +- states/MakeInitial.v | 2 +- tactics/auto.ml | 10 +++- tactics/auto.mli | 2 +- tactics/autorewrite.ml | 2 +- tactics/autorewrite.mli | 2 +- tactics/btermdn.ml | 2 +- tactics/btermdn.mli | 2 +- tactics/class_tactics.ml4 | 2 +- tactics/contradiction.ml | 2 +- tactics/contradiction.mli | 2 +- tactics/eauto.ml4 | 2 +- tactics/eauto.mli | 2 +- tactics/elim.ml | 2 +- tactics/elim.mli | 2 +- tactics/elimschemes.ml | 2 +- tactics/elimschemes.mli | 2 +- tactics/eqdecide.ml4 | 2 +- tactics/eqschemes.ml | 2 +- tactics/eqschemes.mli | 2 +- tactics/equality.ml | 2 +- tactics/equality.mli | 2 +- tactics/evar_tactics.ml | 2 +- tactics/evar_tactics.mli | 2 +- tactics/extraargs.ml4 | 2 +- tactics/extraargs.mli | 2 +- tactics/extratactics.ml4 | 35 +++++++++-- tactics/extratactics.mli | 2 +- tactics/hiddentac.ml | 2 +- tactics/hiddentac.mli | 2 +- tactics/hipattern.ml4 | 2 +- tactics/hipattern.mli | 2 +- tactics/inv.ml | 2 +- tactics/inv.mli | 2 +- tactics/leminv.ml | 2 +- tactics/nbtermdn.ml | 2 +- tactics/nbtermdn.mli | 2 +- tactics/refine.ml | 2 +- tactics/refine.mli | 2 +- tactics/rewrite.ml4 | 4 +- tactics/tacinterp.ml | 59 ++++++++++--------- tactics/tacinterp.mli | 5 +- tactics/tactic_option.ml | 2 +- tactics/tactic_option.mli | 2 +- tactics/tacticals.ml | 2 +- tactics/tacticals.mli | 2 +- tactics/tactics.ml | 2 +- tactics/tactics.mli | 2 +- tactics/tauto.ml4 | 2 +- tactics/termdn.ml | 2 +- tactics/termdn.mli | 2 +- test-suite/bench/lists-100.v | 2 +- test-suite/bench/lists_100.v | 2 +- test-suite/failure/Tauto.v | 2 +- test-suite/failure/clash_cons.v | 2 +- test-suite/failure/fixpoint1.v | 2 +- test-suite/failure/guard.v | 2 +- test-suite/failure/illtype1.v | 2 +- test-suite/failure/positivity.v | 2 +- test-suite/failure/redef.v | 2 +- test-suite/failure/search.v | 2 +- test-suite/ideal-features/Apply.v | 2 +- test-suite/misc/berardi_test.v | 2 +- test-suite/output/Naming.out | 16 +++--- test-suite/success/Check.v | 2 +- test-suite/success/Field.v | 2 +- test-suite/success/LegacyField.v | 2 +- test-suite/success/Tauto.v | 2 +- test-suite/success/TestRefine.v | 2 +- test-suite/success/eauto.v | 2 +- test-suite/success/eqdecide.v | 2 +- test-suite/success/extraction.v | 2 +- test-suite/success/inds_type_sec.v | 2 +- test-suite/success/induct.v | 2 +- test-suite/success/mutual_ind.v | 2 +- test-suite/success/unfold.v | 2 +- test-suite/typeclasses/NewSetoid.v | 2 +- theories/Arith/Arith.v | 2 +- theories/Arith/Arith_base.v | 2 +- theories/Arith/Between.v | 2 +- theories/Arith/Bool_nat.v | 2 +- theories/Arith/Compare.v | 2 +- theories/Arith/Compare_dec.v | 2 +- theories/Arith/Div2.v | 2 +- theories/Arith/EqNat.v | 2 +- theories/Arith/Euclid.v | 2 +- theories/Arith/Even.v | 2 +- theories/Arith/Factorial.v | 2 +- theories/Arith/Gt.v | 2 +- theories/Arith/Le.v | 2 +- theories/Arith/Lt.v | 2 +- theories/Arith/Max.v | 2 +- theories/Arith/Min.v | 2 +- theories/Arith/Minus.v | 2 +- theories/Arith/Mult.v | 2 +- theories/Arith/Peano_dec.v | 2 +- theories/Arith/Wf_nat.v | 2 +- theories/Bool/Bool.v | 2 +- theories/Bool/BoolEq.v | 2 +- theories/Bool/Bvector.v | 2 +- theories/Bool/DecBool.v | 2 +- theories/Bool/IfProp.v | 2 +- theories/Bool/Sumbool.v | 2 +- theories/Bool/Zerob.v | 2 +- theories/Classes/EquivDec.v | 2 +- theories/Classes/Equivalence.v | 2 +- theories/Classes/Init.v | 2 +- theories/Classes/Morphisms.v | 2 +- theories/Classes/Morphisms_Prop.v | 2 +- theories/Classes/Morphisms_Relations.v | 2 +- theories/Classes/RelationClasses.v | 2 +- theories/Classes/SetoidClass.v | 2 +- theories/Classes/SetoidDec.v | 2 +- theories/Classes/SetoidTactics.v | 2 +- theories/Init/Datatypes.v | 2 +- theories/Init/Logic.v | 2 +- theories/Init/Logic_Type.v | 2 +- theories/Init/Notations.v | 2 +- theories/Init/Peano.v | 2 +- theories/Init/Prelude.v | 2 +- theories/Init/Specif.v | 2 +- theories/Init/Tactics.v | 2 +- theories/Init/Wf.v | 2 +- theories/Lists/List.v | 2 +- theories/Lists/ListSet.v | 2 +- theories/Lists/ListTactics.v | 2 +- theories/Lists/StreamMemo.v | 2 +- theories/Lists/Streams.v | 2 +- theories/Logic/Berardi.v | 2 +- theories/Logic/ChoiceFacts.v | 2 +- theories/Logic/Classical.v | 2 +- theories/Logic/ClassicalChoice.v | 2 +- theories/Logic/ClassicalDescription.v | 2 +- theories/Logic/ClassicalEpsilon.v | 2 +- theories/Logic/ClassicalFacts.v | 2 +- theories/Logic/ClassicalUniqueChoice.v | 2 +- theories/Logic/Classical_Pred_Set.v | 2 +- theories/Logic/Classical_Pred_Type.v | 2 +- theories/Logic/Classical_Prop.v | 2 +- theories/Logic/Classical_Type.v | 2 +- theories/Logic/ConstructiveEpsilon.v | 2 +- theories/Logic/Decidable.v | 2 +- theories/Logic/Description.v | 2 +- theories/Logic/Diaconescu.v | 2 +- theories/Logic/Epsilon.v | 2 +- theories/Logic/Eqdep.v | 2 +- theories/Logic/EqdepFacts.v | 2 +- theories/Logic/Eqdep_dec.v | 2 +- theories/Logic/ExtensionalityFacts.v | 2 +- theories/Logic/FunctionalExtensionality.v | 2 +- theories/Logic/Hurkens.v | 2 +- theories/Logic/IndefiniteDescription.v | 2 +- theories/Logic/JMeq.v | 2 +- theories/Logic/ProofIrrelevance.v | 2 +- theories/Logic/ProofIrrelevanceFacts.v | 2 +- theories/Logic/RelationalChoice.v | 2 +- theories/Logic/SetIsType.v | 2 +- theories/NArith/BinNat.v | 2 +- theories/NArith/BinNatDef.v | 2 +- theories/NArith/NArith.v | 2 +- theories/NArith/Ndec.v | 2 +- theories/NArith/Ndigits.v | 2 +- theories/NArith/Ndist.v | 2 +- theories/NArith/Ndiv_def.v | 2 +- theories/NArith/Ngcd_def.v | 2 +- theories/NArith/Nnat.v | 2 +- theories/NArith/Nsqrt_def.v | 2 +- theories/Numbers/BigNumPrelude.v | 2 +- theories/Numbers/BinNums.v | 2 +- theories/Numbers/Cyclic/Abstract/CyclicAxioms.v | 2 +- theories/Numbers/Cyclic/Abstract/NZCyclic.v | 2 +- theories/Numbers/Cyclic/DoubleCyclic/DoubleAdd.v | 2 +- theories/Numbers/Cyclic/DoubleCyclic/DoubleBase.v | 2 +- .../Numbers/Cyclic/DoubleCyclic/DoubleCyclic.v | 2 +- theories/Numbers/Cyclic/DoubleCyclic/DoubleDiv.v | 2 +- theories/Numbers/Cyclic/DoubleCyclic/DoubleDivn1.v | 2 +- theories/Numbers/Cyclic/DoubleCyclic/DoubleLift.v | 2 +- theories/Numbers/Cyclic/DoubleCyclic/DoubleMul.v | 2 +- theories/Numbers/Cyclic/DoubleCyclic/DoubleSqrt.v | 2 +- theories/Numbers/Cyclic/DoubleCyclic/DoubleSub.v | 2 +- theories/Numbers/Cyclic/DoubleCyclic/DoubleType.v | 2 +- theories/Numbers/Cyclic/Int31/Cyclic31.v | 2 +- theories/Numbers/Cyclic/Int31/Int31.v | 2 +- theories/Numbers/Cyclic/Int31/Ring31.v | 2 +- theories/Numbers/Cyclic/ZModulo/ZModulo.v | 2 +- theories/Numbers/Integer/Abstract/ZAdd.v | 2 +- theories/Numbers/Integer/Abstract/ZAddOrder.v | 2 +- theories/Numbers/Integer/Abstract/ZAxioms.v | 2 +- theories/Numbers/Integer/Abstract/ZBase.v | 2 +- theories/Numbers/Integer/Abstract/ZBits.v | 2 +- theories/Numbers/Integer/Abstract/ZDivEucl.v | 2 +- theories/Numbers/Integer/Abstract/ZDivFloor.v | 2 +- theories/Numbers/Integer/Abstract/ZDivTrunc.v | 2 +- theories/Numbers/Integer/Abstract/ZGcd.v | 2 +- theories/Numbers/Integer/Abstract/ZLcm.v | 2 +- theories/Numbers/Integer/Abstract/ZLt.v | 2 +- theories/Numbers/Integer/Abstract/ZMaxMin.v | 2 +- theories/Numbers/Integer/Abstract/ZMul.v | 2 +- theories/Numbers/Integer/Abstract/ZMulOrder.v | 2 +- theories/Numbers/Integer/Abstract/ZParity.v | 2 +- theories/Numbers/Integer/Abstract/ZPow.v | 2 +- theories/Numbers/Integer/Abstract/ZProperties.v | 2 +- theories/Numbers/Integer/Abstract/ZSgnAbs.v | 2 +- theories/Numbers/Integer/BigZ/BigZ.v | 2 +- theories/Numbers/Integer/BigZ/ZMake.v | 2 +- theories/Numbers/Integer/Binary/ZBinary.v | 2 +- theories/Numbers/Integer/NatPairs/ZNatPairs.v | 2 +- theories/Numbers/Integer/SpecViaZ/ZSig.v | 2 +- theories/Numbers/Integer/SpecViaZ/ZSigZAxioms.v | 2 +- theories/Numbers/NaryFunctions.v | 2 +- theories/Numbers/NatInt/NZAdd.v | 2 +- theories/Numbers/NatInt/NZAddOrder.v | 2 +- theories/Numbers/NatInt/NZAxioms.v | 2 +- theories/Numbers/NatInt/NZBase.v | 2 +- theories/Numbers/NatInt/NZBits.v | 2 +- theories/Numbers/NatInt/NZDiv.v | 2 +- theories/Numbers/NatInt/NZDomain.v | 2 +- theories/Numbers/NatInt/NZGcd.v | 2 +- theories/Numbers/NatInt/NZLog.v | 2 +- theories/Numbers/NatInt/NZMul.v | 2 +- theories/Numbers/NatInt/NZMulOrder.v | 2 +- theories/Numbers/NatInt/NZOrder.v | 2 +- theories/Numbers/NatInt/NZParity.v | 2 +- theories/Numbers/NatInt/NZPow.v | 2 +- theories/Numbers/NatInt/NZProperties.v | 2 +- theories/Numbers/NatInt/NZSqrt.v | 2 +- theories/Numbers/Natural/Abstract/NAdd.v | 2 +- theories/Numbers/Natural/Abstract/NAddOrder.v | 2 +- theories/Numbers/Natural/Abstract/NAxioms.v | 2 +- theories/Numbers/Natural/Abstract/NBase.v | 2 +- theories/Numbers/Natural/Abstract/NBits.v | 2 +- theories/Numbers/Natural/Abstract/NDefOps.v | 2 +- theories/Numbers/Natural/Abstract/NDiv.v | 2 +- theories/Numbers/Natural/Abstract/NGcd.v | 2 +- theories/Numbers/Natural/Abstract/NIso.v | 2 +- theories/Numbers/Natural/Abstract/NLcm.v | 2 +- theories/Numbers/Natural/Abstract/NLog.v | 2 +- theories/Numbers/Natural/Abstract/NMaxMin.v | 2 +- theories/Numbers/Natural/Abstract/NMulOrder.v | 2 +- theories/Numbers/Natural/Abstract/NOrder.v | 2 +- theories/Numbers/Natural/Abstract/NParity.v | 2 +- theories/Numbers/Natural/Abstract/NPow.v | 2 +- theories/Numbers/Natural/Abstract/NProperties.v | 2 +- theories/Numbers/Natural/Abstract/NSqrt.v | 2 +- theories/Numbers/Natural/Abstract/NStrongRec.v | 2 +- theories/Numbers/Natural/Abstract/NSub.v | 2 +- theories/Numbers/Natural/BigN/BigN.v | 2 +- theories/Numbers/Natural/BigN/NMake.v | 2 +- theories/Numbers/Natural/BigN/NMake_gen.ml | 2 +- theories/Numbers/Natural/BigN/Nbasic.v | 2 +- theories/Numbers/Natural/Binary/NBinary.v | 2 +- theories/Numbers/Natural/Peano/NPeano.v | 2 +- theories/Numbers/Natural/SpecViaZ/NSig.v | 2 +- theories/Numbers/Natural/SpecViaZ/NSigNAxioms.v | 2 +- theories/Numbers/NumPrelude.v | 2 +- theories/Numbers/Rational/BigQ/BigQ.v | 2 +- theories/Numbers/Rational/BigQ/QMake.v | 2 +- theories/Numbers/Rational/SpecViaQ/QSig.v | 2 +- theories/PArith/BinPos.v | 2 +- theories/PArith/BinPosDef.v | 2 +- theories/PArith/PArith.v | 2 +- theories/PArith/POrderedType.v | 2 +- theories/PArith/Pnat.v | 2 +- theories/Program/Basics.v | 2 +- theories/Program/Combinators.v | 2 +- theories/Program/Equality.v | 2 +- theories/Program/Program.v | 2 +- theories/Program/Subset.v | 2 +- theories/Program/Syntax.v | 2 +- theories/Program/Tactics.v | 2 +- theories/Program/Utils.v | 2 +- theories/Program/Wf.v | 2 +- theories/QArith/QArith.v | 2 +- theories/QArith/QArith_base.v | 2 +- theories/QArith/QOrderedType.v | 2 +- theories/QArith/Qabs.v | 2 +- theories/QArith/Qcanon.v | 2 +- theories/QArith/Qfield.v | 2 +- theories/QArith/Qminmax.v | 2 +- theories/QArith/Qpower.v | 2 +- theories/QArith/Qreals.v | 2 +- theories/QArith/Qreduction.v | 2 +- theories/QArith/Qring.v | 2 +- theories/QArith/Qround.v | 2 +- theories/Reals/Alembert.v | 2 +- theories/Reals/AltSeries.v | 2 +- theories/Reals/ArithProp.v | 2 +- theories/Reals/Binomial.v | 2 +- theories/Reals/Cauchy_prod.v | 2 +- theories/Reals/Cos_plus.v | 2 +- theories/Reals/Cos_rel.v | 2 +- theories/Reals/DiscrR.v | 2 +- theories/Reals/Exp_prop.v | 2 +- theories/Reals/Integration.v | 2 +- theories/Reals/LegacyRfield.v | 2 +- theories/Reals/MVT.v | 2 +- theories/Reals/Machin.v | 8 +++ theories/Reals/NewtonInt.v | 2 +- theories/Reals/PSeries_reg.v | 2 +- theories/Reals/PartSum.v | 2 +- theories/Reals/RIneq.v | 2 +- theories/Reals/RList.v | 2 +- theories/Reals/ROrderedType.v | 2 +- theories/Reals/R_Ifp.v | 2 +- theories/Reals/R_sqr.v | 2 +- theories/Reals/R_sqrt.v | 2 +- theories/Reals/Ranalysis.v | 2 +- theories/Reals/Ranalysis1.v | 2 +- theories/Reals/Ranalysis2.v | 2 +- theories/Reals/Ranalysis3.v | 2 +- theories/Reals/Ranalysis4.v | 2 +- theories/Reals/Ranalysis5.v | 10 +++- theories/Reals/Ranalysis_reg.v | 2 +- theories/Reals/Ratan.v | 8 +++ theories/Reals/Raxioms.v | 2 +- theories/Reals/Rbase.v | 2 +- theories/Reals/Rbasic_fun.v | 2 +- theories/Reals/Rcomplete.v | 2 +- theories/Reals/Rdefinitions.v | 2 +- theories/Reals/Rderiv.v | 2 +- theories/Reals/Reals.v | 2 +- theories/Reals/Rfunctions.v | 2 +- theories/Reals/Rgeom.v | 2 +- theories/Reals/RiemannInt.v | 2 +- theories/Reals/RiemannInt_SF.v | 2 +- theories/Reals/Rlimit.v | 2 +- theories/Reals/Rlogic.v | 2 +- theories/Reals/Rminmax.v | 2 +- theories/Reals/Rpow_def.v | 2 +- theories/Reals/Rpower.v | 2 +- theories/Reals/Rprod.v | 2 +- theories/Reals/Rseries.v | 2 +- theories/Reals/Rsigma.v | 2 +- theories/Reals/Rsqrt_def.v | 2 +- theories/Reals/Rtopology.v | 2 +- theories/Reals/Rtrigo.v | 2 +- theories/Reals/Rtrigo1.v | 2 +- theories/Reals/Rtrigo_alt.v | 2 +- theories/Reals/Rtrigo_calc.v | 2 +- theories/Reals/Rtrigo_def.v | 2 +- theories/Reals/Rtrigo_fun.v | 2 +- theories/Reals/Rtrigo_reg.v | 2 +- theories/Reals/SeqProp.v | 2 +- theories/Reals/SeqSeries.v | 2 +- theories/Reals/SplitAbsolu.v | 2 +- theories/Reals/SplitRmult.v | 2 +- theories/Reals/Sqrt_reg.v | 2 +- theories/Relations/Operators_Properties.v | 2 +- theories/Relations/Relation_Definitions.v | 2 +- theories/Relations/Relation_Operators.v | 2 +- theories/Relations/Relations.v | 2 +- theories/Setoids/Setoid.v | 2 +- theories/Sets/Classical_sets.v | 2 +- theories/Sets/Constructive_sets.v | 2 +- theories/Sets/Cpo.v | 2 +- theories/Sets/Ensembles.v | 2 +- theories/Sets/Finite_sets.v | 2 +- theories/Sets/Finite_sets_facts.v | 2 +- theories/Sets/Image.v | 2 +- theories/Sets/Infinite_sets.v | 2 +- theories/Sets/Integers.v | 2 +- theories/Sets/Multiset.v | 2 +- theories/Sets/Partial_Order.v | 2 +- theories/Sets/Permut.v | 2 +- theories/Sets/Powerset.v | 2 +- theories/Sets/Powerset_Classical_facts.v | 2 +- theories/Sets/Powerset_facts.v | 2 +- theories/Sets/Relations_1.v | 2 +- theories/Sets/Relations_1_facts.v | 2 +- theories/Sets/Relations_2.v | 2 +- theories/Sets/Relations_2_facts.v | 2 +- theories/Sets/Relations_3.v | 2 +- theories/Sets/Relations_3_facts.v | 2 +- theories/Sets/Uniset.v | 2 +- theories/Sorting/Heap.v | 2 +- theories/Sorting/Mergesort.v | 2 +- theories/Sorting/PermutEq.v | 2 +- theories/Sorting/PermutSetoid.v | 2 +- theories/Sorting/Permutation.v | 2 +- theories/Sorting/Sorted.v | 2 +- theories/Sorting/Sorting.v | 2 +- theories/Strings/Ascii.v | 2 +- theories/Strings/String.v | 2 +- theories/Unicode/Utf8.v | 2 +- theories/Unicode/Utf8_core.v | 2 +- theories/Wellfounded/Disjoint_Union.v | 2 +- theories/Wellfounded/Inclusion.v | 2 +- theories/Wellfounded/Inverse_Image.v | 2 +- .../Wellfounded/Lexicographic_Exponentiation.v | 2 +- theories/Wellfounded/Lexicographic_Product.v | 2 +- theories/Wellfounded/Transitive_Closure.v | 2 +- theories/Wellfounded/Union.v | 2 +- theories/Wellfounded/Well_Ordering.v | 2 +- theories/Wellfounded/Wellfounded.v | 2 +- theories/ZArith/BinInt.v | 2 +- theories/ZArith/BinIntDef.v | 2 +- theories/ZArith/Wf_Z.v | 2 +- theories/ZArith/ZArith.v | 2 +- theories/ZArith/ZArith_base.v | 2 +- theories/ZArith/ZArith_dec.v | 2 +- theories/ZArith/ZOdiv.v | 2 +- theories/ZArith/ZOdiv_def.v | 2 +- theories/ZArith/Zabs.v | 2 +- theories/ZArith/Zbool.v | 2 +- theories/ZArith/Zcompare.v | 2 +- theories/ZArith/Zcomplements.v | 2 +- theories/ZArith/Zdigits.v | 2 +- theories/ZArith/Zdiv.v | 2 +- theories/ZArith/Zeuclid.v | 2 +- theories/ZArith/Zeven.v | 2 +- theories/ZArith/Zgcd_alt.v | 2 +- theories/ZArith/Zhints.v | 2 +- theories/ZArith/Zlogarithm.v | 2 +- theories/ZArith/Zmax.v | 2 +- theories/ZArith/Zmin.v | 2 +- theories/ZArith/Zminmax.v | 2 +- theories/ZArith/Zmisc.v | 2 +- theories/ZArith/Znat.v | 2 +- theories/ZArith/Znumtheory.v | 2 +- theories/ZArith/Zorder.v | 2 +- theories/ZArith/Zpow_alt.v | 2 +- theories/ZArith/Zpow_def.v | 2 +- theories/ZArith/Zpow_facts.v | 2 +- theories/ZArith/Zpower.v | 2 +- theories/ZArith/Zquot.v | 2 +- theories/ZArith/Zsqrt_compat.v | 2 +- theories/ZArith/Zwf.v | 2 +- theories/ZArith/auxiliary.v | 2 +- tools/compat5.ml | 2 +- tools/compat5.mlp | 2 +- tools/compat5b.ml | 2 +- tools/compat5b.mlp | 2 +- tools/coq_makefile.ml | 2 +- tools/coq_tex.ml | 2 +- tools/coqdep.ml | 2 +- tools/coqdep_boot.ml | 2 +- tools/coqdep_common.ml | 2 +- tools/coqdep_common.mli | 2 +- tools/coqdep_lexer.mli | 2 +- tools/coqdep_lexer.mll | 2 +- tools/coqdoc/alpha.ml | 2 +- tools/coqdoc/alpha.mli | 2 +- tools/coqdoc/cdglobals.ml | 2 +- tools/coqdoc/cpretty.mli | 2 +- tools/coqdoc/cpretty.mll | 2 +- tools/coqdoc/index.ml | 2 +- tools/coqdoc/index.mli | 2 +- tools/coqdoc/main.ml | 2 +- tools/coqdoc/output.ml | 2 +- tools/coqdoc/output.mli | 2 +- tools/coqdoc/tokens.ml | 2 +- tools/coqdoc/tokens.mli | 2 +- tools/coqwc.mll | 2 +- tools/fake_ide.ml | 2 +- tools/gallina.ml | 2 +- tools/gallina_lexer.mll | 2 +- toplevel/auto_ind_decl.ml | 2 +- toplevel/auto_ind_decl.mli | 2 +- toplevel/autoinstance.ml | 2 +- toplevel/autoinstance.mli | 2 +- toplevel/backtrack.ml | 2 +- toplevel/backtrack.mli | 2 +- toplevel/cerrors.ml | 2 +- toplevel/cerrors.mli | 2 +- toplevel/class.ml | 2 +- toplevel/class.mli | 2 +- toplevel/classes.ml | 2 +- toplevel/classes.mli | 2 +- toplevel/command.ml | 2 +- toplevel/command.mli | 2 +- toplevel/coqinit.ml | 4 +- toplevel/coqinit.mli | 2 +- toplevel/coqtop.ml | 2 +- toplevel/coqtop.mli | 2 +- toplevel/discharge.ml | 2 +- toplevel/discharge.mli | 2 +- toplevel/himsg.ml | 2 +- toplevel/himsg.mli | 2 +- toplevel/ide_intf.ml | 2 +- toplevel/ide_intf.mli | 2 +- toplevel/ide_slave.ml | 2 +- toplevel/ide_slave.mli | 2 +- toplevel/ind_tables.ml | 2 +- toplevel/ind_tables.mli | 2 +- toplevel/indschemes.ml | 2 +- toplevel/indschemes.mli | 2 +- toplevel/interface.mli | 2 +- toplevel/lemmas.ml | 2 +- toplevel/lemmas.mli | 2 +- toplevel/libtypes.ml | 2 +- toplevel/libtypes.mli | 2 +- toplevel/metasyntax.ml | 2 +- toplevel/metasyntax.mli | 2 +- toplevel/mltop.ml4 | 2 +- toplevel/mltop.mli | 2 +- toplevel/record.ml | 2 +- toplevel/record.mli | 2 +- toplevel/search.ml | 2 +- toplevel/search.mli | 2 +- toplevel/toplevel.ml | 2 +- toplevel/toplevel.mli | 2 +- toplevel/usage.ml | 2 +- toplevel/usage.mli | 2 +- toplevel/vernac.ml | 2 +- toplevel/vernac.mli | 2 +- toplevel/vernacentries.ml | 2 +- toplevel/vernacentries.mli | 2 +- toplevel/vernacexpr.ml | 2 +- toplevel/vernacinterp.ml | 2 +- toplevel/vernacinterp.mli | 2 +- toplevel/whelp.ml4 | 2 +- toplevel/whelp.mli | 2 +- 1014 files changed, 1468 insertions(+), 1265 deletions(-) diff --git a/CHANGES b/CHANGES index 5df109a1..d13a15e6 100644 --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,43 @@ +Changes from V8.4pl3 to V8.4pl4 +=============================== + +WARNING: +The current logic of Coq is now known to be inconsistent with + Axiom prop_extensionality : forall A B:Prop, (A <-> B) -> A = B. +For more details, see: + https://gforge.inria.fr/plugins/scmgit/cgi-bin/gitweb.cgi?p=coq/coq.git;a=blob_plain;f=test-suite/failure/subterm2.v;hb=HEAD +or + https://gforge.inria.fr/plugins/scmgit/cgi-bin/gitweb.cgi?p=coq/coq.git;a=blob_plain;f=test-suite/failure/subterm3.v;hb=HEAD + +Kernel + +- Bug #3211: unsound check of elimination sort. +- Fix guard condition for nested cofixpoints. +- Bug #3243: Univ constraints of module subtyping were not propagated. + +Tactics + +- A new option "Set Stable Omega" ensures that repeated identical calls + to omega will produce identical proof terms. This option is off by default + for maximal compatibility, but should be pretty safe to activate. +- The interpretation of the open_constr tactic argument was erroneously + firing type classes resolution in some corner cases. This has been + fixed. The tactic argument type open_constr_wTC is provided for retro + compatibility purposes. +- Fixing bug #3228 (fixing precedence of ltac variables over variables in + env) introduces rare and justified tactic failure. + +Bug fixes + +- Solved bugs: + #3260, #2697, #3037, #3262, #2900, #3131, #3238, #3204, #1758, #1039, + #3144 +- micromega: solved an ambiguous symbol resolution. +- Coq always uses / as separator between directories on all platforms. +- remove trailing '\r' from file names returned by coqtop. +- bug correction in proving inversion principles for Function. +- ocamlbuild: minor fixes related to camlp4 and cross-compilation. + Changes from V8.4pl2 to V8.4pl3 =============================== diff --git a/checker/check.ml b/checker/check.ml index fb0dc12a..85ee28db 100644 --- a/checker/check.ml +++ b/checker/check.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* raise (LocalArity None)); srec (push_rel (na1,None,a1) env) t ar' - | Prod (_,a1,a2), [] -> (* whnf of t was not needed here! *) - let ksort = match (whd_betadeltaiota env a2) with - | Sort s -> family_of_sort s + | Prod (na1,a1,a2), [] -> (* whnf of t was not needed here! *) + let env' = push_rel (na1,None,a1) env in + let ksort = match (whd_betadeltaiota env' a2) with + | Sort s -> family_of_sort s | _ -> raise (LocalArity None) in let dep_ind = build_dependent_inductive ind specif params in (try conv env a1 dep_ind @@ -289,6 +290,8 @@ let is_correct_arity env c (p,pj) ind specif params = | Sort s', [] -> check_allowed_sort (family_of_sort s') specif; false + | _, (_,Some _,_ as d)::ar' -> + srec (push_rel d env) (lift 1 pt') ar' | _ -> raise (LocalArity None) in @@ -895,12 +898,12 @@ let check_one_cofix env nbfix def deftype = raise (CoFixGuardError (env,RecCallInTypeOfAbstraction a)) | CoFix (j,(_,varit,vdefs as recdef)) -> - if (List.for_all (noccur_with_meta n nbfix) args) + if List.for_all (noccur_with_meta n nbfix) args then - let nbfix = Array.length vdefs in - if (array_for_all (noccur_with_meta n nbfix) varit) then + if array_for_all (noccur_with_meta n nbfix) varit then + let nbfix = Array.length vdefs in let env' = push_rec_types recdef env in - (Array.iter (check_rec_call env' alreadygrd (n+1) vlra) vdefs; + (Array.iter (check_rec_call env' alreadygrd (n+nbfix) vlra) vdefs; List.iter (check_rec_call env alreadygrd n vlra) args) else raise (CoFixGuardError (env,RecCallInTypeOfDef c)) diff --git a/checker/inductive.mli b/checker/inductive.mli index d0040e3d..0c1117f5 100644 --- a/checker/inductive.mli +++ b/checker/inductive.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* [] diff --git a/ide/coq.mli b/ide/coq.mli index 0f40c61e..c255d08f 100644 --- a/ide/coq.mli +++ b/ide/coq.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* n then - user_err_loc (loc,"",str "Projection has not the right number of explicit parameters."); + user_err_loc (loc,"",str "Projection does not have the right number of explicit parameters."); with Not_found -> user_err_loc (loc,"",pr_global_env Idset.empty ref ++ str " is not a registered projection.")) diff --git a/interp/constrintern.mli b/interp/constrintern.mli index 7a4bba10..b8b3d995 100644 --- a/interp/constrintern.mli +++ b/interp/constrintern.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* (open_constr_expr,rlevel) abstract_argument_type -val globwit_open_constr_gen : bool -> (open_glob_constr,glevel) abstract_argument_type -val wit_open_constr_gen : bool -> (open_constr,tlevel) abstract_argument_type +val rawwit_open_constr_gen : bool * bool -> (open_constr_expr,rlevel) abstract_argument_type +val globwit_open_constr_gen : bool * bool -> (open_glob_constr,glevel) abstract_argument_type +val wit_open_constr_gen : bool * bool -> (open_constr,tlevel) abstract_argument_type val rawwit_open_constr : (open_constr_expr,rlevel) abstract_argument_type val globwit_open_constr : (open_glob_constr,glevel) abstract_argument_type @@ -195,6 +195,10 @@ val rawwit_casted_open_constr : (open_constr_expr,rlevel) abstract_argument_type val globwit_casted_open_constr : (open_glob_constr,glevel) abstract_argument_type val wit_casted_open_constr : (open_constr,tlevel) abstract_argument_type +val rawwit_open_constr_wTC : (open_constr_expr,rlevel) abstract_argument_type +val globwit_open_constr_wTC : (open_glob_constr,glevel) abstract_argument_type +val wit_open_constr_wTC : (open_constr,tlevel) abstract_argument_type + val rawwit_constr_with_bindings : (constr_expr with_bindings,rlevel) abstract_argument_type val globwit_constr_with_bindings : (glob_constr_and_expr with_bindings,glevel) abstract_argument_type val wit_constr_with_bindings : (constr with_bindings sigma,tlevel) abstract_argument_type @@ -280,7 +284,7 @@ type argument_type = | ConstrArgType | ConstrMayEvalArgType | QuantHypArgType - | OpenConstrArgType of bool + | OpenConstrArgType of bool * bool | ConstrWithBindingsArgType | BindingsArgType | RedExprArgType diff --git a/interp/implicit_quantifiers.ml b/interp/implicit_quantifiers.ml index 2c000258..1b0f1341 100644 --- a/interp/implicit_quantifiers.ml +++ b/interp/implicit_quantifiers.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* raise (LocalArity None) in srec (push_rel (na1,None,a1) env) t ar' (union_constraints u univ) - | Prod (_,a1,a2), [] -> (* whnf of t was not needed here! *) - let ksort = match kind_of_term (whd_betadeltaiota env a2) with - | Sort s -> family_of_sort s - | _ -> raise (LocalArity None) in - let dep_ind = build_dependent_inductive ind specif params in - let univ = - try conv env a1 dep_ind - with NotConvertible -> raise (LocalArity None) in - check_allowed_sort ksort specif; - union_constraints u univ + (* The last Prod domain is the type of the scrutinee *) + | Prod (na1,a1,a2), [] -> (* whnf of t was not needed here! *) + let env' = push_rel (na1,None,a1) env in + let ksort = match kind_of_term (whd_betadeltaiota env' a2) with + | Sort s -> family_of_sort s + | _ -> raise (LocalArity None) in + let dep_ind = build_dependent_inductive ind specif params in + let univ = + try conv env a1 dep_ind + with NotConvertible -> raise (LocalArity None) in + check_allowed_sort ksort specif; + union_constraints u univ | _, (_,Some _,_ as d)::ar' -> - srec (push_rel d env) (lift 1 pt') ar' u + srec (push_rel d env) (lift 1 pt') ar' u | _ -> raise (LocalArity None) in @@ -895,12 +897,12 @@ let check_one_cofix env nbfix def deftype = raise (CoFixGuardError (env,RecCallInTypeOfAbstraction a)) | CoFix (j,(_,varit,vdefs as recdef)) -> - if (List.for_all (noccur_with_meta n nbfix) args) + if List.for_all (noccur_with_meta n nbfix) args then - let nbfix = Array.length vdefs in - if (array_for_all (noccur_with_meta n nbfix) varit) then + if array_for_all (noccur_with_meta n nbfix) varit then + let nbfix = Array.length vdefs in let env' = push_rec_types recdef env in - (Array.iter (check_rec_call env' alreadygrd (n+1) vlra) vdefs; + (Array.iter (check_rec_call env' alreadygrd (n+nbfix) vlra) vdefs; List.iter (check_rec_call env alreadygrd n vlra) args) else raise (CoFixGuardError (env,RecCallInTypeOfDef c)) diff --git a/kernel/inductive.mli b/kernel/inductive.mli index 89ba7869..c507fe92 100644 --- a/kernel/inductive.mli +++ b/kernel/inductive.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* full_add_module mb env) diff --git a/kernel/safe_typing.mli b/kernel/safe_typing.mli index 34dc68d2..dada3001 100644 --- a/kernel/safe_typing.mli +++ b/kernel/safe_typing.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* coqlib | None -> coqroot in - if Sys.file_exists (Filename.concat coqlib file) + if Sys.file_exists (coqlib//file) then coqlib else Util.error "cannot guess a path for Coq libraries; please use -coqlib option") @@ -54,18 +56,14 @@ let path_to_list p = Util.split_string_at sep p let xdg_data_home = - Filename.concat - (System.getenv_else "XDG_DATA_HOME" (Filename.concat System.home ".local/share")) - "coq" + (System.getenv_else "XDG_DATA_HOME" (System.home//".local/share"))//"coq" let xdg_config_home = - Filename.concat - (System.getenv_else "XDG_CONFIG_HOME" (Filename.concat System.home ".config")) - "coq" + (System.getenv_else "XDG_CONFIG_HOME" (System.home//".config"))//"coq" let xdg_data_dirs = (try - List.map (fun dir -> Filename.concat dir "coq") (path_to_list (Sys.getenv "XDG_DATA_DIRS")) + List.map (fun dir -> dir//"coq") (path_to_list (Sys.getenv "XDG_DATA_DIRS")) with Not_found -> ["/usr/local/share/coq";"/usr/share/coq"]) @ (match Coq_config.datadir with |None -> [] |Some datadir -> [datadir]) @@ -84,7 +82,7 @@ let rec which l f = match l with | [] -> raise Not_found | p :: tl -> - if Sys.file_exists (Filename.concat p f) + if Sys.file_exists (p//f) then p else which tl f @@ -108,7 +106,7 @@ let camllib () = then Coq_config.camllib else let camlbin = camlbin () in - let com = (Filename.concat camlbin "ocamlc") ^ " -where" in + let com = (camlbin//"ocamlc") ^ " -where" in let _,res = System.run_command (fun x -> x) (fun _ -> ()) com in Util.strip res @@ -117,7 +115,7 @@ let camlp4bin () = if !Flags.boot then Coq_config.camlp4bin else try guess_camlp4bin () with e when e <> Sys.Break -> let cb = camlbin () in - if Sys.file_exists (Filename.concat cb (exe Coq_config.camlp4)) then cb + if Sys.file_exists (cb//(exe Coq_config.camlp4)) then cb else Coq_config.camlp4bin let camlp4lib () = @@ -125,7 +123,7 @@ let camlp4lib () = then Coq_config.camlp4lib else let camlp4bin = camlp4bin () in - let com = (Filename.concat camlp4bin Coq_config.camlp4) ^ " -where" in + let com = (camlp4bin//Coq_config.camlp4) ^ " -where" in let ex,res = System.run_command (fun x -> x) (fun _ -> ()) com in match ex with |Unix.WEXITED 0 -> Util.strip res diff --git a/lib/envars.mli b/lib/envars.mli index 9ec170db..023b54c0 100644 --- a/lib/envars.mli +++ b/lib/envars.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <:expr< Genarg.rawwit_constr_may_eval >> | QuantHypArgType -> <:expr< Genarg.rawwit_quant_hyp >> | RedExprArgType -> <:expr< Genarg.rawwit_red_expr >> - | OpenConstrArgType b -> <:expr< Genarg.rawwit_open_constr_gen $mlexpr_of_bool b$ >> + | OpenConstrArgType (b1,b2) -> <:expr< Genarg.rawwit_open_constr_gen ($mlexpr_of_bool b1$,$mlexpr_of_bool b2$) >> | ConstrWithBindingsArgType -> <:expr< Genarg.rawwit_constr_with_bindings >> | BindingsArgType -> <:expr< Genarg.rawwit_bindings >> | List0ArgType t -> <:expr< Genarg.wit_list0 $make_rawwit loc t$ >> @@ -62,7 +62,7 @@ let rec make_globwit loc = function | ConstrArgType -> <:expr< Genarg.globwit_constr >> | ConstrMayEvalArgType -> <:expr< Genarg.globwit_constr_may_eval >> | RedExprArgType -> <:expr< Genarg.globwit_red_expr >> - | OpenConstrArgType b -> <:expr< Genarg.globwit_open_constr_gen $mlexpr_of_bool b$ >> + | OpenConstrArgType (b1,b2) -> <:expr< Genarg.globwit_open_constr_gen ($mlexpr_of_bool b1$,$mlexpr_of_bool b2$) >> | ConstrWithBindingsArgType -> <:expr< Genarg.globwit_constr_with_bindings >> | BindingsArgType -> <:expr< Genarg.globwit_bindings >> | List0ArgType t -> <:expr< Genarg.wit_list0 $make_globwit loc t$ >> @@ -92,7 +92,7 @@ let rec make_wit loc = function | ConstrArgType -> <:expr< Genarg.wit_constr >> | ConstrMayEvalArgType -> <:expr< Genarg.wit_constr_may_eval >> | RedExprArgType -> <:expr< Genarg.wit_red_expr >> - | OpenConstrArgType b -> <:expr< Genarg.wit_open_constr_gen $mlexpr_of_bool b$ >> + | OpenConstrArgType (b1,b2) -> <:expr< Genarg.wit_open_constr_gen ($mlexpr_of_bool b1$,$mlexpr_of_bool b2$) >> | ConstrWithBindingsArgType -> <:expr< Genarg.wit_constr_with_bindings >> | BindingsArgType -> <:expr< Genarg.wit_bindings >> | List0ArgType t -> <:expr< Genarg.wit_list0 $make_wit loc t$ >> diff --git a/parsing/egrammar.ml b/parsing/egrammar.ml index 12359776..6deb7622 100644 --- a/parsing/egrammar.ml +++ b/parsing/egrammar.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* ((),c) ] ] ; + open_constr_wTC: + [ [ c = constr -> ((),c) ] ] + ; casted_open_constr: [ [ c = constr -> ((),c) ] ] ; diff --git a/parsing/g_vernac.ml4 b/parsing/g_vernac.ml4 index 301370e7..75cd7d67 100644 --- a/parsing/g_vernac.ml4 +++ b/parsing/g_vernac.ml4 @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* VernacImport (false,qidl) | IDENT "Export"; qidl = LIST1 global -> VernacImport (true,qidl) - | IDENT "Include"; e = module_expr_inl; l = LIST0 ext_module_expr -> + | IDENT "Include"; e = module_type_inl; l = LIST0 ext_module_expr -> VernacInclude(e::l) | IDENT "Include"; "Type"; e = module_type_inl; l = LIST0 ext_module_type -> Flags.if_verbose @@ -842,6 +842,7 @@ GEXTEND Gram -> PrintCoercionPaths (s,t) | IDENT "Canonical"; IDENT "Projections" -> PrintCanonicalConversions | IDENT "Tables" -> PrintTables + | IDENT "Options" -> PrintTables (* A Synonymous to Tables *) | IDENT "Hint" -> PrintHintGoal | IDENT "Hint"; qid = smart_global -> PrintHint qid | IDENT "Hint"; "*" -> PrintHintDb diff --git a/parsing/g_xml.ml4 b/parsing/g_xml.ml4 index 869674f4..6f5e378a 100644 --- a/parsing/g_xml.ml4 +++ b/parsing/g_xml.ml4 @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* Gram.entry table *) (* Typically for tactic user extensions *) let open_constr = - make_gen_entry utactic (rawwit_open_constr_gen false) "open_constr" + make_gen_entry utactic (rawwit_open_constr_gen (false,false)) "open_constr" let casted_open_constr = - make_gen_entry utactic (rawwit_open_constr_gen true) "casted_open_constr" + make_gen_entry utactic (rawwit_open_constr_gen (true,false)) "casted_open_constr" + let open_constr_wTC = + make_gen_entry utactic (rawwit_open_constr_gen (false,true)) "open_constr_wTC" let constr_with_bindings = make_gen_entry utactic rawwit_constr_with_bindings "constr_with_bindings" let bindings = diff --git a/parsing/pcoq.mli b/parsing/pcoq.mli index 53c317c0..1b04b117 100644 --- a/parsing/pcoq.mli +++ b/parsing/pcoq.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* pr_red_expr (prc,prlc,pr_or_by_notation prref,prpat) (out_gen rawwit_red_expr x) - | OpenConstrArgType b -> prc (snd (out_gen (rawwit_open_constr_gen b) x)) + | OpenConstrArgType (b1,b2) -> prc (snd (out_gen (rawwit_open_constr_gen (b1,b2)) x)) | ConstrWithBindingsArgType -> pr_with_bindings prc prlc (out_gen rawwit_constr_with_bindings x) | BindingsArgType -> @@ -195,7 +195,7 @@ let rec pr_glob_generic prc prlc prtac prpat x = pr_red_expr (prc,prlc,pr_or_var (pr_and_short_name pr_evaluable_reference),prpat) (out_gen globwit_red_expr x) - | OpenConstrArgType b -> prc (snd (out_gen (globwit_open_constr_gen b) x)) + | OpenConstrArgType (b1,b2) -> prc (snd (out_gen (globwit_open_constr_gen (b1,b2)) x)) | ConstrWithBindingsArgType -> pr_with_bindings prc prlc (out_gen globwit_constr_with_bindings x) | BindingsArgType -> @@ -236,7 +236,7 @@ let rec pr_generic prc prlc prtac prpat x = | RedExprArgType -> pr_red_expr (prc,prlc,pr_evaluable_reference,prpat) (out_gen wit_red_expr x) - | OpenConstrArgType b -> prc (snd (out_gen (wit_open_constr_gen b) x)) + | OpenConstrArgType (b1,b2) -> prc (snd (out_gen (wit_open_constr_gen (b1,b2)) x)) | ConstrWithBindingsArgType -> let (c,b) = (out_gen wit_constr_with_bindings x).Evd.it in pr_with_bindings prc prlc (c,b) diff --git a/parsing/pptactic.mli b/parsing/pptactic.mli index 0f82071d..c5953da1 100644 --- a/parsing/pptactic.mli +++ b/parsing/pptactic.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* (mt ()) | Some c -> (* Force evaluation *) - let pb = pr_lconstr_env env c in + let pb = pr_lconstr_core true env c in let pb = if isCast c then surround pb else pb in (str" := " ++ pb ++ cut () ) in - let pt = pr_ltype_env env typ in + let pt = pr_ltype_core true env typ in let ptyp = (str" : " ++ pt) in (pr_id id ++ hov 0 (pbody ++ ptyp)) @@ -217,10 +217,10 @@ let pr_rel_decl env (na,c,typ) = | None -> mt () | Some c -> (* Force evaluation *) - let pb = pr_lconstr_env env c in + let pb = pr_lconstr_core true env c in let pb = if isCast c then surround pb else pb in (str":=" ++ spc () ++ pb ++ spc ()) in - let ptyp = pr_ltype_env env typ in + let ptyp = pr_ltype_core true env typ in match na with | Anonymous -> hov 0 (str"<>" ++ spc () ++ pbody ++ str":" ++ spc () ++ ptyp) | Name id -> hov 0 (pr_id id ++ spc () ++ pbody ++ str":" ++ spc () ++ ptyp) diff --git a/parsing/printer.mli b/parsing/printer.mli index 3abe90e7..c0ef1932 100644 --- a/parsing/printer.mli +++ b/parsing/printer.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <:expr< Genarg.VarArgType >> | Genarg.StringArgType -> <:expr< Genarg.StringArgType >> | Genarg.QuantHypArgType -> <:expr< Genarg.QuantHypArgType >> - | Genarg.OpenConstrArgType b -> <:expr< Genarg.OpenConstrArgType $mlexpr_of_bool b$ >> + | Genarg.OpenConstrArgType (b1,b2) -> <:expr< Genarg.OpenConstrArgType ($mlexpr_of_bool b1$, $mlexpr_of_bool b2$) >> | Genarg.ConstrWithBindingsArgType -> <:expr< Genarg.ConstrWithBindingsArgType >> | Genarg.BindingsArgType -> <:expr< Genarg.BindingsArgType >> | Genarg.RedExprArgType -> <:expr< Genarg.RedExprArgType >> diff --git a/parsing/q_util.ml4 b/parsing/q_util.ml4 index 7fe5a3c4..947e7e54 100644 --- a/parsing/q_util.ml4 +++ b/parsing/q_util.ml4 @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* (t, l) | Construct _ -> (t,l) @@ -576,7 +576,7 @@ let treat_new_case ptes_infos nb_prod continue_tac term dyn_infos = onLastHypId (fun heq_id -> tclTHENLIST [ (* Then the new hypothesis *) tclMAP introduction_no_check dyn_infos.rec_hyps; - (* observe_tac "after_introduction" *)(fun g' -> + observe_tac "after_introduction" (fun g' -> (* We get infos on the equations introduced*) let new_term_value_eq = pf_type_of g' (mkVar heq_id) in (* compute the new value of the body *) @@ -603,7 +603,7 @@ let treat_new_case ptes_infos nb_prod continue_tac term dyn_infos = } in clean_goal_with_heq ptes_infos continue_tac new_infos g' - )]) + )]) ] g diff --git a/plugins/funind/g_indfun.ml4 b/plugins/funind/g_indfun.ml4 index 6b6e4838..ffaa2208 100644 --- a/plugins/funind/g_indfun.ml4 +++ b/plugins/funind/g_indfun.ml4 @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* + match pat with + | Genarg.IntroIdentifier id -> add id acc + | _ -> anomaly "Not an identifier" + ) + (List.nth intro_pats (pred i)) + empty + in let prove_branche i g = (* We get the identifiers of this branch *) - let this_branche_ids = - List.fold_right - (fun (_,pat) acc -> - match pat with - | Genarg.IntroIdentifier id -> Idset.add id acc - | _ -> anomaly "Not an identifier" - ) - (List.nth intro_pats (pred i)) - Idset.empty - in (* and get the real args of the branch by unfolding the defined constant *) let pre_args,pre_tac = List.fold_right (fun (id,b,t) (pre_args,pre_tac) -> - if Idset.mem id this_branche_ids + if Idset.mem id (this_branche_ids Idset.empty Idset.add i) then match b with - | None -> (id::pre_args,pre_tac) + | None -> + (id::pre_args,pre_tac) | Some b -> (pre_args, tclTHEN (h_reduce (Glob_term.Unfold([Glob_term.all_occurrences_expr,EvalVarRef id])) allHyps) pre_tac @@ -347,8 +351,8 @@ let prove_fun_correct functional_induction funs_constr graphs_constr schemes lem when (eq_constr eq eq_ind) && array_exists (eq_constr graph') graphs_constr -> - ((mkApp(mkVar hid,[|args.(2);(mkApp(eq_construct,[|args.(0);args.(2)|]))|])) - ::args.(2)::acc) + ((mkApp(mkVar hid,[|args.(2);(mkApp(eq_construct,[|args.(0);args.(2)|]))|])) + ::args.(2)::acc) | _ -> mkVar hid :: acc end | _ -> mkVar hid :: acc @@ -390,7 +394,7 @@ let prove_fun_correct functional_induction funs_constr graphs_constr schemes lem | [res;hres] -> res,hres | _ -> assert false in - observe (str "constructor := " ++ Printer.pr_lconstr_env (pf_env g) app_constructor); + observe_tac_msg (str "constructor := " ++ Printer.pr_lconstr_env (pf_env g) app_constructor) ( tclTHENSEQ [ @@ -455,11 +459,10 @@ let prove_fun_correct functional_induction funs_constr graphs_constr schemes lem fun g -> observe (pr_constr_with_binding (Printer.pr_lconstr_env (pf_env g)) (mkVar principle_id,bindings)); - functional_induction false (applist(funs_constr.(i),List.map mkVar args_names)) - (Some (mkVar principle_id,bindings)) - pat g + h_apply false false [dummy_loc,(mkVar principle_id,bindings)] g )) - (fun i g -> observe_tac ("proving branche "^string_of_int i) (prove_branche i) g ) + (fun i g -> observe_tac ("proving branche "^string_of_int i) + (tclTHEN (tclMAP h_intro (this_branche_ids [] (fun a b -> a::b) i)) (prove_branche i)) g ) ] g diff --git a/plugins/funind/merge.ml b/plugins/funind/merge.ml index bd1a1710..e1f10be2 100644 --- a/plugins/funind/merge.ml +++ b/plugins/funind/merge.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* let (f,_) = decompose_app t in eq_constr f (well_founded ()) - | _ -> assert false + | _ -> false in let compare t1 t2 = let b1,b2= is_well_founded t1,is_well_founded t2 in diff --git a/plugins/micromega/CheckerMaker.v b/plugins/micromega/CheckerMaker.v index fa780671..04336747 100644 --- a/plugins/micromega/CheckerMaker.v +++ b/plugins/micromega/CheckerMaker.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* = 8.5, this option is set by default. +*) + let read f () = !f let write f x = f:=x @@ -81,6 +98,14 @@ let _ = optread = read old_style_flag; optwrite = write old_style_flag } +let _ = + declare_bool_option + { optsync = true; + optdepr = false; + optname = "Omega automatic reset of generated names"; + optkey = ["Stable";"Omega"]; + optread = read reset_flag; + optwrite = write reset_flag } let all_time = timing "Omega " let solver_time = timing "Solver " @@ -89,30 +114,35 @@ let elim_time = timing "Elim " let simpl_time = timing "Simpl " let generalize_time = timing "Generalize" +let intref, reset_all_references = + let refs = ref [] in + (fun n -> let r = ref n in refs := (r,n) :: !refs; r), + (fun () -> List.iter (fun (r,n) -> r:=n) !refs) + let new_identifier = - let cpt = ref 0 in + let cpt = intref 0 in (fun () -> let s = "Omega" ^ string_of_int !cpt in incr cpt; id_of_string s) let new_identifier_state = - let cpt = ref 0 in + let cpt = intref 0 in (fun () -> let s = make_ident "State" (Some !cpt) in incr cpt; s) let new_identifier_var = - let cpt = ref 0 in + let cpt = intref 0 in (fun () -> let s = "Zvar" ^ string_of_int !cpt in incr cpt; id_of_string s) let new_id = - let cpt = ref 0 in fun () -> incr cpt; !cpt + let cpt = intref 0 in fun () -> incr cpt; !cpt let new_var_num = - let cpt = ref 1000 in (fun () -> incr cpt; !cpt) + let cpt = intref 1000 in (fun () -> incr cpt; !cpt) let new_var = - let cpt = ref 0 in fun () -> incr cpt; Nameops.make_ident "WW" (Some !cpt) + let cpt = intref 0 in fun () -> incr cpt; Nameops.make_ident "WW" (Some !cpt) let display_var i = Printf.sprintf "X%d" i -let intern_id,unintern_id = +let intern_id,unintern_id,reset_intern_tables = let cpt = ref 0 in let table = Hashtbl.create 7 and co_table = Hashtbl.create 7 in (fun (name : identifier) -> @@ -124,7 +154,8 @@ let intern_id,unintern_id = (fun idx -> try Hashtbl.find co_table idx with Not_found -> let v = new_var () in - Hashtbl.add table v idx; Hashtbl.add co_table idx v; v) + Hashtbl.add table v idx; Hashtbl.add co_table idx v; v), + (fun () -> cpt := 0; Hashtbl.clear table) let mk_then = tclTHENLIST @@ -141,19 +172,28 @@ let rev_assoc k = in loop -let tag_hypothesis,tag_of_hyp, hyp_of_tag = +let tag_hypothesis,tag_of_hyp, hyp_of_tag, clear_tags = let l = ref ([]:(identifier * int) list) in (fun h id -> l := (h,id):: !l), (fun h -> try List.assoc h !l with Not_found -> failwith "tag_hypothesis"), - (fun h -> try rev_assoc h !l with Not_found -> failwith "tag_hypothesis") + (fun h -> try rev_assoc h !l with Not_found -> failwith "tag_hypothesis"), + (fun () -> l := []) -let hide_constr,find_constr,clear_tables,dump_tables = +let hide_constr,find_constr,clear_constr_tables,dump_tables = let l = ref ([]:(constr * (identifier * identifier * bool)) list) in (fun h id eg b -> l := (h,(id,eg,b)):: !l), (fun h -> try list_assoc_f eq_constr h !l with Not_found -> failwith "find_contr"), (fun () -> l := []), (fun () -> !l) +let reset_all () = + if !reset_flag then begin + reset_all_references (); + reset_intern_tables (); + clear_tags (); + clear_constr_tables () + end + (* Lazy evaluation is used for Coq constants, because this code is evaluated before the compiled modules are loaded. To use the constant Zplus, one must type "Lazy.force coq_Zplus" @@ -1388,7 +1428,7 @@ let reintroduce id = tclTHEN (tclTRY (clear [id])) (intro_using id) let coq_omega gl = - clear_tables (); + clear_constr_tables (); let tactic_normalisation, system = List.fold_left (destructure_omega gl) ([],[]) (pf_hyps_types gl) in let prelude,sys = @@ -1814,6 +1854,7 @@ let destructure_goal = all_time (destructure_goal) let omega_solver gl = Coqlib.check_required_library ["Coq";"omega";"Omega"]; + reset_all (); let result = destructure_goal gl in (* if !display_time_flag then begin text_time (); flush Pervasives.stdout end; *) diff --git a/plugins/omega/g_omega.ml4 b/plugins/omega/g_omega.ml4 index 1542b60c..b2a5b5dc 100644 --- a/plugins/omega/g_omega.ml4 +++ b/plugins/omega/g_omega.ml4 @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* - let (evd',j) = Coercion.inh_conv_coerce_to loc env !isevars j p in + let (evd',j) = Coercion.inh_conv_coerce_to true loc env !isevars j p in isevars := evd'; j | None -> j diff --git a/plugins/subtac/subtac_cases.mli b/plugins/subtac/subtac_cases.mli index 91142067..5ef42b13 100644 --- a/plugins/subtac/subtac_cases.mli +++ b/plugins/subtac/subtac_cases.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* anomaly "apply_coercion" - let inh_app_fun env isevars j = + let inh_app_fun _ env isevars j = let isevars = ref isevars in let t = hnf env !isevars j.uj_type in match kind_of_term t with @@ -481,8 +481,8 @@ module Coercion = struct | Some (init, cur) -> (evd, cj) - let inh_conv_coerce_to = inh_conv_coerce_to_gen false - let inh_conv_coerce_rigid_to = inh_conv_coerce_to_gen true + let inh_conv_coerce_to _ = inh_conv_coerce_to_gen false + let inh_conv_coerce_rigid_to _ = inh_conv_coerce_to_gen true let inh_conv_coerces_to loc env isevars t ((abs, t') as _tycon) = let nabsinit, nabs = diff --git a/plugins/subtac/subtac_pretyping.ml b/plugins/subtac/subtac_pretyping.ml index fac6b567..68636574 100644 --- a/plugins/subtac/subtac_pretyping.ml +++ b/plugins/subtac/subtac_pretyping.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* j - | Some t -> evd_comb2 (Coercion.inh_conv_coerce_to loc env) evdref j t + | Some t -> evd_comb2 (Coercion.inh_conv_coerce_to resolve_tc loc env) evdref j t let push_rels vars env = List.fold_right push_rel vars env @@ -188,11 +188,14 @@ module SubtacPretyping_F (Coercion : Coercion.S) = struct (* [pretype tycon env evdref lvar lmeta cstr] attempts to type [cstr] *) (* in environment [env], with existential variables [( evdref)] and *) (* the type constraint tycon *) - let rec pretype (tycon : type_constraint) env evdref lvar c = + let rec pretype resolve_tc (tycon : type_constraint) env evdref lvar c = (* let _ = try Subtac_utils.trace (str "pretype " ++ Subtac_utils.my_print_glob_constr env c ++ *) (* str " with tycon " ++ Evarutil.pr_tycon env tycon) *) (* with _ -> () *) (* in *) + let pretype = pretype resolve_tc in + let pretype_type = pretype_type resolve_tc in + let inh_conv_coerce_to_tycon = inh_conv_coerce_to_tycon resolve_tc in match c with | GRef (loc,ref) -> inh_conv_coerce_to_tycon loc env evdref @@ -335,7 +338,7 @@ module SubtacPretyping_F (Coercion : Coercion.S) = struct | [] -> resj | c::rest -> let argloc = loc_of_glob_constr c in - let resj = evd_comb1 (Coercion.inh_app_fun env) evdref resj in + let resj = evd_comb1 (Coercion.inh_app_fun resolve_tc env) evdref resj in let resty = whd_betadeltaiota env !evdref resj.uj_type in match kind_of_term resty with | Prod (na,c1,c2) -> @@ -557,7 +560,7 @@ module SubtacPretyping_F (Coercion : Coercion.S) = struct inh_conv_coerce_to_tycon loc env evdref cj tycon (* [pretype_type valcon env evdref lvar c] coerces [c] into a type *) - and pretype_type valcon env evdref lvar = function + and pretype_type resolve_tc valcon env evdref lvar = function | GHole loc -> (match valcon with | Some v -> @@ -577,7 +580,7 @@ module SubtacPretyping_F (Coercion : Coercion.S) = struct { utj_val = e_new_evar evdref env ~src:loc (mkSort s); utj_type = s}) | c -> - let j = pretype empty_tycon env evdref lvar c in + let j = pretype resolve_tc empty_tycon env evdref lvar c in let loc = loc_of_glob_constr c in let tj = evd_comb1 (Coercion.inh_coerce_to_sort loc env) evdref j in match valcon with @@ -592,9 +595,9 @@ module SubtacPretyping_F (Coercion : Coercion.S) = struct let c' = match kind with | OfType exptyp -> let tycon = match exptyp with None -> empty_tycon | Some t -> mk_tycon t in - (pretype tycon env evdref lvar c).uj_val + (pretype resolve_classes tycon env evdref lvar c).uj_val | IsType -> - (pretype_type empty_valcon env evdref lvar c).utj_val + (pretype_type resolve_classes empty_valcon env evdref lvar c).utj_val in if resolve_classes then (try @@ -616,14 +619,14 @@ module SubtacPretyping_F (Coercion : Coercion.S) = struct let understand_judgment sigma env c = let evdref = ref (create_evar_defs sigma) in - let j = pretype empty_tycon env evdref ([],[]) c in + let j = pretype true empty_tycon env evdref ([],[]) c in let evd = consider_remaining_unif_problems env !evdref in let j = j_nf_evar evd j in check_evars env sigma evd (mkCast(j.uj_val,DEFAULTcast, j.uj_type)); j let understand_judgment_tcc evdref env c = - let j = pretype empty_tycon env evdref ([],[]) c in + let j = pretype true empty_tycon env evdref ([],[]) c in j_nf_evar !evdref j (* Raw calls to the unsafe inference machine: boolean says if we must diff --git a/plugins/syntax/nat_syntax.ml b/plugins/syntax/nat_syntax.ml index 63b44008..2899f17f 100644 --- a/plugins/syntax/nat_syntax.ml +++ b/plugins/syntax/nat_syntax.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* - let (evd',j) = Coercion.inh_conv_coerce_to loc env !evdref j p in + let (evd',j) = Coercion.inh_conv_coerce_to true loc env !evdref j p in evdref := evd'; j | None -> j diff --git a/pretyping/cases.mli b/pretyping/cases.mli index 566c172d..826d68a4 100644 --- a/pretyping/cases.mli +++ b/pretyping/cases.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* evar_map -> unsafe_judgment -> evar_map * unsafe_judgment + bool -> env -> evar_map -> unsafe_judgment -> evar_map * unsafe_judgment (* [inh_coerce_to_sort env evd j] coerces [j] to a type; i.e. it inserts a coercion into [j], if needed, in such a way it gets as @@ -57,10 +57,10 @@ module type S = sig (* [inh_conv_coerce_to loc env evd j t] coerces [j] to an object of type [t]; i.e. it inserts a coercion into [j], if needed, in such a way [t] and [j.uj_type] are convertible; it fails if no coercion is applicable *) - val inh_conv_coerce_to : loc -> + val inh_conv_coerce_to : bool -> loc -> env -> evar_map -> unsafe_judgment -> type_constraint_type -> evar_map * unsafe_judgment - val inh_conv_coerce_rigid_to : loc -> + val inh_conv_coerce_rigid_to : bool -> loc -> env -> evar_map -> unsafe_judgment -> type_constraint_type -> evar_map * unsafe_judgment (* [inh_conv_coerces_to loc env evd t t'] checks if an object of type [t] @@ -140,9 +140,11 @@ module Default = struct lookup_path_to_fun_from env evd j.uj_type in (evd,apply_coercion env evd p j t) - let inh_app_fun env evd j = + let inh_app_fun resolve_tc env evd j = try inh_app_fun env evd j - with Not_found -> + with + | Not_found when not resolve_tc -> (evd, j) + | Not_found -> try inh_app_fun env (saturate_evd env evd) j with Not_found -> (evd, j) @@ -221,13 +223,15 @@ module Default = struct | _ -> raise NoCoercion (* Look for cj' obtained from cj by inserting coercions, s.t. cj'.typ = t *) - let inh_conv_coerce_to_gen rigidonly loc env evd cj (n, t) = + let inh_conv_coerce_to_gen resolve_tc rigidonly loc env evd cj (n, t) = match n with None -> let (evd', val') = try inh_conv_coerce_to_fail loc env evd rigidonly (Some cj.uj_val) cj.uj_type t - with NoCoercion -> + with + | NoCoercion when not resolve_tc -> error_actual_type_loc loc env evd cj t + | NoCoercion -> let evd = saturate_evd env evd in try inh_conv_coerce_to_fail loc env evd rigidonly (Some cj.uj_val) cj.uj_type t @@ -238,8 +242,8 @@ module Default = struct (evd',{ uj_val = val'; uj_type = t }) | Some (init, cur) -> (evd, cj) - let inh_conv_coerce_to = inh_conv_coerce_to_gen false - let inh_conv_coerce_rigid_to = inh_conv_coerce_to_gen true + let inh_conv_coerce_to resolve_tc = inh_conv_coerce_to_gen resolve_tc false + let inh_conv_coerce_rigid_to resolve_tc = inh_conv_coerce_to_gen resolve_tc true let inh_conv_coerces_to loc env (evd : evar_map) t (abs, t') = diff --git a/pretyping/coercion.mli b/pretyping/coercion.mli index 4c4725b3..f06f58f4 100644 --- a/pretyping/coercion.mli +++ b/pretyping/coercion.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* evar_map -> unsafe_judgment -> evar_map * unsafe_judgment + bool -> env -> evar_map -> unsafe_judgment -> evar_map * unsafe_judgment (** [inh_coerce_to_sort env isevars j] coerces [j] to a type; i.e. it inserts a coercion into [j], if needed, in such a way it gets as @@ -40,13 +42,15 @@ module type S = sig val inh_coerce_to_prod : loc -> env -> evar_map -> type_constraint_type -> evar_map * type_constraint_type - (** [inh_conv_coerce_to loc env isevars j t] coerces [j] to an object of type + (** [inh_conv_coerce_to resolve_tc loc env isevars j t] coerces [j] to an object of type [t]; i.e. it inserts a coercion into [j], if needed, in such a way [t] and - [j.uj_type] are convertible; it fails if no coercion is applicable *) - val inh_conv_coerce_to : loc -> + [j.uj_type] are convertible; it fails if no coercion is applicable. + resolve_tc=false disables resolving type classes (as the last + resort before failing) *) + val inh_conv_coerce_to : bool -> loc -> env -> evar_map -> unsafe_judgment -> type_constraint_type -> evar_map * unsafe_judgment - val inh_conv_coerce_rigid_to : loc -> + val inh_conv_coerce_rigid_to : bool -> loc -> env -> evar_map -> unsafe_judgment -> type_constraint_type -> evar_map * unsafe_judgment (** [inh_conv_coerces_to loc env isevars t t'] checks if an object of type [t] diff --git a/pretyping/detyping.ml b/pretyping/detyping.ml index 1065aec9..9e808dd4 100644 --- a/pretyping/detyping.ml +++ b/pretyping/detyping.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* !debug_unification); + Goptions.optwrite = (fun a -> debug_unification:=a); +} + + type flex_kind_of_term = | Rigid of constr | PseudoRigid of constr (* approximated as rigid but not necessarily so *) @@ -210,6 +221,13 @@ and evar_eqappr_x ?(rhs_is_already_stuck = false) in (* Evar must be undefined since we have flushed evars *) + let () = if !debug_unification then + let open Pp in + let pr_state (tm,l) = + h 0 (Termops.print_constr tm ++ str "|" ++ cut () + ++ prlist_with_sep pr_semicolon + (fun x -> hov 1 (Termops.print_constr x)) l) in + pp (v 0 (pr_state appr1 ++ cut () ++ pr_state appr2 ++ cut ()) ++ fnl ()) in match (flex_kind_of_term term1 l1, flex_kind_of_term term2 l2) with | Flexible (sp1,al1 as ev1), Flexible (sp2,al2 as ev2) -> let f1 i = diff --git a/pretyping/evarconv.mli b/pretyping/evarconv.mli index dd68f16f..3a352d13 100644 --- a/pretyping/evarconv.mli +++ b/pretyping/evarconv.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* candidates + | Some filter -> + let ids = List.map pi1 (list_filter_with filter (evar_context evi)) in + List.filter (fun a -> list_subset (Idset.elements (collect_vars a)) ids) + candidates + +let filter_candidates evd evk filter candidates_update = let evi = Evd.find_undefined evd evk in - let candidates = match candidates with + let candidates = match candidates_update with | None -> evi.evar_candidates - | Some _ -> candidates in - match candidates,filter with - | None,_ | _, None -> candidates - | Some l, Some filter -> - let ids = List.map pi1 (list_filter_with filter (evar_context evi)) in - Some (List.filter (fun a -> - list_subset (Idset.elements (collect_vars a)) ids) l) + | Some _ -> candidates_update + in + match candidates with + | None -> None + | Some l -> + let l' = filter_effective_candidates evi filter l in + if List.length l = List.length l' && candidates_update = None then + None + else + Some l' let closure_of_filter evd evk filter = let evi = Evd.find_undefined evd evk in @@ -1530,6 +1541,7 @@ let solve_candidates conv_algo env evd (evk,argsv as ev) rhs = exception NotInvertibleUsingOurAlgorithm of constr exception NotEnoughInformationToProgress of (identifier * evar_projection) list +exception NotEnoughInformationEvarEvar of constr exception OccurCheckIn of evar_map * constr let rec invert_definition conv_algo choose env evd (evk,argsv as ev) rhs = @@ -1608,7 +1620,8 @@ let rec invert_definition conv_algo choose env evd (evk,argsv as ev) rhs = with | EvarSolvedOnTheFly (evd,t) -> evdref:=evd; imitate envk t | CannotProject filter' -> - assert !progress; + if not !progress then + raise (NotEnoughInformationEvarEvar t); (* Make the virtual left evar real *) let ty = get_type_of env' !evdref t in let (evd,evar'',ev'') = @@ -1714,6 +1727,8 @@ and evar_define conv_algo ?(choose=false) env evd (evk,argsv as ev) rhs = with | NotEnoughInformationToProgress sols -> postpone_non_unique_projection env evd ev sols rhs + | NotEnoughInformationEvarEvar t -> + add_conv_pb (Reduction.CONV,env,mkEvar ev,t) evd | NotInvertibleUsingOurAlgorithm t -> error_not_clean env evd evk t (evar_source evk evd) | OccurCheckIn (evd,rhs) -> diff --git a/pretyping/evarutil.mli b/pretyping/evarutil.mli index 591a008c..9269f138 100644 --- a/pretyping/evarutil.mli +++ b/pretyping/evarutil.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* Anonymous -> - (* Unable to manage the presence of both an alias and a variable *) - raise Not_found - | GVar (loc,id) -> PatVar (loc,Name id) - | GHole (loc,_) -> PatVar (loc,na) - | GRef (loc,ConstructRef cstr) -> - PatCstr (loc,cstr,[],na) - | GApp (loc,GRef (_,ConstructRef (ind,_ as cstr)),args) -> - let mib,_ = Global.lookup_inductive ind in - let nparams = mib.Declarations.mind_nparams in - if nparams > List.length args then - user_err_loc (loc,"",Pp.str "Invalid notation for pattern."); - let params,args = list_chop nparams args in - List.iter (function GHole _ -> () - | _ -> user_err_loc (loc,"",Pp.str"Invalid notation for pattern.")) - params; - let args = List.map (cases_pattern_of_glob_constr Anonymous) args in - PatCstr (loc,cstr,args,na) - | _ -> raise Not_found - let rec cases_pattern_of_glob_constr na = function | GVar (loc,id) when na<>Anonymous -> (* Unable to manage the presence of both an alias and a variable *) diff --git a/pretyping/glob_term.mli b/pretyping/glob_term.mli index 798a960f..09dd9203 100644 --- a/pretyping/glob_term.mli +++ b/pretyping/glob_term.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* env -> evar_map ref -> + bool -> type_constraint -> env -> evar_map ref -> ltac_var_map -> glob_constr -> unsafe_judgment val pretype_type : - val_constraint -> env -> evar_map ref -> + bool -> val_constraint -> env -> evar_map ref -> ltac_var_map -> glob_constr -> unsafe_type_judgment val pretype_gen : @@ -259,9 +259,9 @@ module Pretyping_F (Coercion : Coercion.S) = struct done (* coerce to tycon if any *) - let inh_conv_coerce_to_tycon loc env evdref j = function + let inh_conv_coerce_to_tycon resolve_tc loc env evdref j = function | None -> j - | Some t -> evd_comb2 (Coercion.inh_conv_coerce_to loc env) evdref j t + | Some t -> evd_comb2 (Coercion.inh_conv_coerce_to resolve_tc loc env) evdref j t let push_rels vars env = List.fold_right push_rel vars env @@ -297,18 +297,19 @@ module Pretyping_F (Coercion : Coercion.S) = struct let c = substl subst c in { uj_val = c; uj_type = protected_get_type_of env sigma c } with Not_found -> - (* Check if [id] is a section or goal variable *) - try - let (_,_,typ) = lookup_named id env in - { uj_val = mkVar id; uj_type = typ } - with Not_found -> - (* [id] not found, build nice error message if [id] yet known from ltac *) + (* if [id] an ltac variable not bound to a term *) + (* build a nice error message *) try match List.assoc id unbndltacvars with | None -> user_err_loc (loc,"", str "Variable " ++ pr_id id ++ str " should be bound to a term.") | Some id0 -> Pretype_errors.error_var_not_found_loc loc id0 with Not_found -> + (* Check if [id] is a section or goal variable *) + try + let (_,_,typ) = lookup_named id env in + { uj_val = mkVar id; uj_type = typ } + with Not_found -> (* [id] not found, standard error message *) error_var_not_found_loc loc id @@ -346,7 +347,11 @@ module Pretyping_F (Coercion : Coercion.S) = struct (* [pretype tycon env evdref lvar lmeta cstr] attempts to type [cstr] *) (* in environment [env], with existential variables [evdref] and *) (* the type constraint tycon *) - let rec pretype (tycon : type_constraint) env evdref lvar = function + let rec pretype resolve_tc (tycon : type_constraint) env evdref lvar t = + let pretype = pretype resolve_tc in + let pretype_type = pretype_type resolve_tc in + let inh_conv_coerce_to_tycon = inh_conv_coerce_to_tycon resolve_tc in + match t with | GRef (loc,ref) -> inh_conv_coerce_to_tycon loc env evdref (pretype_ref loc evdref env ref) @@ -459,7 +464,7 @@ module Pretyping_F (Coercion : Coercion.S) = struct | [] -> resj | c::rest -> let argloc = loc_of_glob_constr c in - let resj = evd_comb1 (Coercion.inh_app_fun env) evdref resj in + let resj = evd_comb1 (Coercion.inh_app_fun resolve_tc env) evdref resj in let resty = whd_betadeltaiota env !evdref resj.uj_type in match kind_of_term resty with | Prod (na,c1,c2) -> @@ -696,7 +701,7 @@ module Pretyping_F (Coercion : Coercion.S) = struct in inh_conv_coerce_to_tycon loc env evdref cj tycon (* [pretype_type valcon env evdref lvar c] coerces [c] into a type *) - and pretype_type valcon env evdref lvar = function + and pretype_type resolve_tc valcon env evdref lvar = function | GHole loc -> (match valcon with | Some v -> @@ -716,7 +721,7 @@ module Pretyping_F (Coercion : Coercion.S) = struct { utj_val = e_new_evar evdref env ~src:loc (mkSort s); utj_type = s}) | c -> - let j = pretype empty_tycon env evdref lvar c in + let j = pretype resolve_tc empty_tycon env evdref lvar c in let loc = loc_of_glob_constr c in let tj = evd_comb1 (Coercion.inh_coerce_to_sort loc env) evdref j in match valcon with @@ -731,9 +736,9 @@ module Pretyping_F (Coercion : Coercion.S) = struct let c' = match kind with | OfType exptyp -> let tycon = match exptyp with None -> empty_tycon | Some t -> mk_tycon t in - (pretype tycon env evdref lvar c).uj_val + (pretype resolve_classes tycon env evdref lvar c).uj_val | IsType -> - (pretype_type empty_valcon env evdref lvar c).utj_val + (pretype_type resolve_classes empty_valcon env evdref lvar c).utj_val in resolve_evars env evdref fail_evar resolve_classes; let c = if expand_evar then nf_evar !evdref c' else c' in @@ -747,14 +752,14 @@ module Pretyping_F (Coercion : Coercion.S) = struct let understand_judgment sigma env c = let evdref = ref sigma in - let j = pretype empty_tycon env evdref ([],[]) c in + let j = pretype true empty_tycon env evdref ([],[]) c in resolve_evars env evdref true true; let j = j_nf_evar !evdref j in check_evars env sigma !evdref (mkCast(j.uj_val,DEFAULTcast, j.uj_type)); j let understand_judgment_tcc evdref env c = - let j = pretype empty_tycon env evdref ([],[]) c in + let j = pretype true empty_tycon env evdref ([],[]) c in resolve_evars env evdref false true; j_nf_evar !evdref j diff --git a/pretyping/pretyping.mli b/pretyping/pretyping.mli index 761e1641..a785b432 100644 --- a/pretyping/pretyping.mli +++ b/pretyping/pretyping.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* env -> evar_map ref -> + bool -> type_constraint -> env -> evar_map ref -> ltac_var_map -> glob_constr -> unsafe_judgment val pretype_type : - val_constraint -> env -> evar_map ref -> + bool -> val_constraint -> env -> evar_map ref -> ltac_var_map -> glob_constr -> unsafe_type_judgment val pretype_gen : diff --git a/pretyping/recordops.ml b/pretyping/recordops.ml index 434fe80c..f9cd3501 100644 --- a/pretyping/recordops.ml +++ b/pretyping/recordops.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* [] | file :: fl -> - let dirname = Filename.dirname file in - let basename = Filename.basename file in - let modulename = - if Filename.check_suffix basename ".v" then - Filename.chop_suffix basename ".v" + let name_no_suffix = + if Filename.check_suffix file ".v" then + Filename.chop_suffix file ".v" else - basename + file in + let modulename = Filename.basename name_no_suffix in check_module_name modulename; - let file = Filename.concat dirname modulename in (if !verbose then "-compile-verbose" else "-compile") - :: file :: (make_compilation_args fl) + :: name_no_suffix :: (make_compilation_args fl) (* compilation of files [files] with command [command] and args [args] *) diff --git a/scripts/coqmktop.ml b/scripts/coqmktop.ml index b75984e3..eaecda5d 100644 --- a/scripts/coqmktop.ml +++ b/scripts/coqmktop.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* (str"unfold " ++ pr_evaluable_reference c) | Extern tac -> - (str "(*external*) " ++ Pptactic.pr_glob_tactic (Global.env()) tac) + let env = + try + let (_, env) = Pfedit.get_current_goal_context () in + env + with e when Errors.noncritical e -> Global.env () + in + (str "(*external*) " ++ Pptactic.pr_glob_tactic env tac) let pr_hint (id, v) = (pr_autotactic v.code ++ str"(level " ++ int v.pri ++ str", id " ++ int id ++ str ")" ++ spc ()) diff --git a/tactics/auto.mli b/tactics/auto.mli index 7daebb36..5ac2de87 100644 --- a/tactics/auto.mli +++ b/tactics/auto.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* [ admit_as_an_axiom ] END -let replace_in_clause_maybe_by (sigma1,c1) c2 in_hyp tac = + + +let classes_dirpath = + make_dirpath (List.map id_of_string ["Classes";"Coq"]) + +let init_setoid () = + if Libnames.is_dirpath_prefix_of classes_dirpath (Lib.cwd ()) then () + else Coqlib.check_required_library ["Coq";"Setoids";"Setoid"] + + +let occurrences_of occs = + let loccs = match occs with + | n::_ as nl when n < 0 -> (false,List.map (fun n -> ArgArg (abs n)) nl) + | nl -> + if List.exists (fun n -> n < 0) nl then + error "Illegal negative occurrence number."; + (true, List.map (fun n -> (ArgArg n)) nl) + in + init_setoid (); + {onhyps = Some []; concl_occs =loccs} + +let replace_in_clause_maybe_by (sigma1,c1) c2 cl tac = Refiner.tclWITHHOLES false - (replace_in_clause_maybe_by c1 c2 (glob_in_arg_hyp_to_clause in_hyp)) + (replace_in_clause_maybe_by c1 c2 cl) sigma1 (Option.map Tacinterp.eval_tactic tac) @@ -44,9 +65,15 @@ let replace_multi_term dir_opt (sigma,c) in_hyp = TACTIC EXTEND replace ["replace" open_constr(c1) "with" constr(c2) in_arg_hyp(in_hyp) by_arg_tac(tac) ] --> [ replace_in_clause_maybe_by c1 c2 in_hyp tac ] +-> [ replace_in_clause_maybe_by c1 c2 (glob_in_arg_hyp_to_clause in_hyp) tac ] END +TACTIC EXTEND replace_at + ["replace" open_constr(c1) "with" constr(c2) "at" occurrences(occs) by_arg_tac(tac) ] +-> [ replace_in_clause_maybe_by c1 c2 (occurrences_of occs) tac ] +END + + TACTIC EXTEND replace_term_left [ "replace" "->" open_constr(c) in_arg_hyp(in_hyp) ] -> [ replace_multi_term (Some true) c in_hyp] diff --git a/tactics/extratactics.mli b/tactics/extratactics.mli index 3f30ddb4..934d94fc 100644 --- a/tactics/extratactics.mli +++ b/tactics/extratactics.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* in_gen globwit_red_expr (intern_red_expr ist (out_gen rawwit_red_expr x)) - | OpenConstrArgType b -> - in_gen (globwit_open_constr_gen b) - ((),intern_constr ist (snd (out_gen (rawwit_open_constr_gen b) x))) + | OpenConstrArgType (b1,b2) -> + in_gen (globwit_open_constr_gen (b1,b2)) + ((),intern_constr ist (snd (out_gen (rawwit_open_constr_gen (b1,b2)) x))) | ConstrWithBindingsArgType -> in_gen globwit_constr_with_bindings (intern_constr_with_bindings ist (out_gen rawwit_constr_with_bindings x)) @@ -1290,8 +1290,11 @@ let interp_type = interp_constr_gen IsType let interp_open_constr_gen kind ist = interp_gen kind ist false true false false -let interp_open_constr ccl ist = - interp_gen (OfType ccl) ist false true false (ccl<>None) +(* wTC is for retrocompatibility: TC resolution started only if needed *) +let interp_open_constr ccl wTC ist e s t = + try interp_gen (OfType ccl) ist false true false (ccl<>None) e s t + with ex when Pretype_errors.precatchable_exception ex && ccl = None && wTC -> + interp_gen (OfType ccl) ist false true false true e s t let interp_pure_open_constr ist = interp_gen (OfType None) ist false false false false @@ -1333,7 +1336,7 @@ let interp_constr_list ist env sigma c = let interp_open_constr_list = interp_constr_in_compound_list (fun x -> x) (fun x -> x) - (interp_open_constr None) + (interp_open_constr None false) let interp_auto_lemmas ist env sigma lems = let local_sigma, lems = interp_open_constr_list ist env sigma lems in @@ -1526,7 +1529,7 @@ let interp_declared_or_quantified_hypothesis ist gl = function with Not_found -> NamedHyp id let interp_binding ist env sigma (loc,b,c) = - let sigma, c = interp_open_constr None ist env sigma c in + let sigma, c = interp_open_constr None false ist env sigma c in sigma, (loc,interp_binding_name ist b,c) let interp_bindings ist env sigma = function @@ -1541,12 +1544,12 @@ let interp_bindings ist env sigma = function let interp_constr_with_bindings ist env sigma (c,bl) = let sigma, bl = interp_bindings ist env sigma bl in - let sigma, c = interp_open_constr None ist env sigma c in + let sigma, c = interp_open_constr None false ist env sigma c in sigma, (c,bl) -let interp_open_constr_with_bindings ist env sigma (c,bl) = +let interp_open_constr_with_bindings wTC ist env sigma (c,bl) = let sigma, bl = interp_bindings ist env sigma bl in - let sigma, c = interp_open_constr None ist env sigma c in + let sigma, c = interp_open_constr None wTC ist env sigma c in sigma, (c, bl) let loc_of_bindings = function @@ -1554,11 +1557,11 @@ let loc_of_bindings = function | ImplicitBindings l -> loc_of_glob_constr (fst (list_last l)) | ExplicitBindings l -> pi1 (list_last l) -let interp_open_constr_with_bindings_loc ist env sigma ((c,_),bl as cb) = +let interp_open_constr_with_bindings_loc wTC ist env sigma ((c,_),bl as cb) = let loc1 = loc_of_glob_constr c in let loc2 = loc_of_bindings bl in let loc = if loc2 = dummy_loc then loc1 else join_loc loc1 loc2 in - let sigma, cb = interp_open_constr_with_bindings ist env sigma cb in + let sigma, cb = interp_open_constr_with_bindings wTC ist env sigma cb in sigma, (loc,cb) let interp_induction_arg ist gl arg = @@ -1754,8 +1757,8 @@ let apply_one_mhyp_context ist env gl lmatch (hypname,patv,pat) lhyps = let mk_constr_value ist gl c = let (sigma,c_interp) = pf_interp_constr ist gl c in sigma,VConstr ([],c_interp) -let mk_open_constr_value ist gl c = - let (sigma,c_interp) = pf_apply (interp_open_constr None ist) gl c in +let mk_open_constr_value wTC ist gl c = + let (sigma,c_interp) = pf_apply (interp_open_constr None wTC ist) gl c in sigma,VConstr ([],c_interp) let mk_hyp_value ist gl c = VConstr ([],mkVar (interp_hyp ist gl c)) let mk_int_or_var_value ist c = VInteger (interp_int_or_var ist c) @@ -2132,11 +2135,11 @@ and interp_genarg ist gl x = let (sigma,r_interp) = pf_interp_red_expr ist gl (out_gen globwit_red_expr x) in evdref := sigma; in_gen wit_red_expr r_interp - | OpenConstrArgType casted -> - in_gen (wit_open_constr_gen casted) - (interp_open_constr (if casted then Some (pf_concl gl) else None) + | OpenConstrArgType (casted,wTC) -> + in_gen (wit_open_constr_gen (casted,wTC)) + (interp_open_constr (if casted then Some (pf_concl gl) else None) wTC ist (pf_env gl) (project gl) - (snd (out_gen (globwit_open_constr_gen casted) x))) + (snd (out_gen (globwit_open_constr_gen (casted,wTC)) x))) | ConstrWithBindingsArgType -> in_gen wit_constr_with_bindings (pack_sigma (interp_constr_with_bindings ist (pf_env gl) (project gl) @@ -2332,7 +2335,7 @@ and interp_atomic ist gl tac = (h_vm_cast_no_check c_interp) | TacApply (a,ev,cb,cl) -> let sigma, l = - list_fold_map (interp_open_constr_with_bindings_loc ist env) sigma cb + list_fold_map (interp_open_constr_with_bindings_loc true ist env) sigma cb in let tac = match cl with | None -> h_apply a ev @@ -2547,7 +2550,7 @@ and interp_atomic ist gl tac = (* Equality and inversion *) | TacRewrite (ev,l,cl,by) -> let l = List.map (fun (b,m,c) -> - let f env sigma = interp_open_constr_with_bindings ist env sigma c in + let f env sigma = interp_open_constr_with_bindings false ist env sigma c in (b,m,f)) l in let cl = interp_clause ist gl cl in Equality.general_multi_multi_rewrite ev l cl @@ -2610,8 +2613,12 @@ and interp_atomic ist gl tac = let (sigma,v) = mk_constr_value ist gl (out_gen globwit_constr x) in evdref := sigma; v - | OpenConstrArgType false -> - let (sigma,v) = mk_open_constr_value ist gl (snd (out_gen globwit_open_constr x)) in + | OpenConstrArgType (false,true) -> + let (sigma,v) = mk_open_constr_value true ist gl (snd (out_gen globwit_open_constr_wTC x)) in + evdref := sigma; + v + | OpenConstrArgType (false,false) -> + let (sigma,v) = mk_open_constr_value false ist gl (snd (out_gen globwit_open_constr x)) in evdref := sigma; v | ConstrMayEvalArgType -> @@ -3013,9 +3020,9 @@ and subst_genarg subst (x:glob_generic_argument) = (out_gen globwit_quant_hyp x)) | RedExprArgType -> in_gen globwit_red_expr (subst_redexp subst (out_gen globwit_red_expr x)) - | OpenConstrArgType b -> - in_gen (globwit_open_constr_gen b) - ((),subst_glob_constr subst (snd (out_gen (globwit_open_constr_gen b) x))) + | OpenConstrArgType (b1,b2) -> + in_gen (globwit_open_constr_gen (b1,b2)) + ((),subst_glob_constr subst (snd (out_gen (globwit_open_constr_gen (b1,b2)) x))) | ConstrWithBindingsArgType -> in_gen globwit_constr_with_bindings (subst_glob_with_bindings subst (out_gen globwit_constr_with_bindings x)) diff --git a/tactics/tacinterp.mli b/tactics/tacinterp.mli index 573efb19..5df6a6cd 100644 --- a/tactics/tacinterp.mli +++ b/tactics/tacinterp.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* goal sigma -> identifier located -> identifier val interp_bindings : interp_sign -> Environ.env -> Evd.evar_map -> glob_constr_and_expr Glob_term.bindings -> Evd.evar_map * constr Glob_term.bindings -val interp_open_constr_with_bindings : interp_sign -> Environ.env -> Evd.evar_map -> +(* first arguments mean wTC (with type classes resolution) *) +val interp_open_constr_with_bindings : bool -> interp_sign -> Environ.env -> Evd.evar_map -> glob_constr_and_expr Glob_term.with_bindings -> Evd.evar_map * constr Glob_term.with_bindings (** Initial call for interpretation *) diff --git a/tactics/tactic_option.ml b/tactics/tactic_option.ml index b846c9eb..1ea8dbcb 100644 --- a/tactics/tactic_option.ml +++ b/tactics/tactic_option.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* - forall x0 x4 x5 S0 : nat, x0 + S0 = x4 + x5 + (S x + x1) + H : forall x5 x6 : nat, + x5 + x1 = x4 + x6 -> + forall x7 x8 x9 S : nat, x7 + S = x8 + x9 + (Datatypes.S x5 + x1) H0 : x + x1 = x4 + x0 ============================ forall x5 x6 x7 S : nat, x5 + S = x6 + x7 + Datatypes.S x @@ -64,9 +64,9 @@ x1 : nat x4 : nat x0 : nat - H : forall x x3 : nat, - x + x1 = x4 + x3 -> - forall x0 x4 x5 S0 : nat, x0 + S0 = x4 + x5 + (S x + x1) + H : forall x5 x6 : nat, + x5 + x1 = x4 + x6 -> + forall x7 x8 x9 S : nat, x7 + S = x8 + x9 + (Datatypes.S x5 + x1) H0 : x + x1 = x4 + x0 x5 : nat x6 : nat @@ -78,6 +78,6 @@ x3 : nat a : nat - H : a = 0 -> forall a : nat, a = 0 + H : a = 0 -> forall a0 : nat, a0 = 0 ============================ a = 0 diff --git a/test-suite/success/Check.v b/test-suite/success/Check.v index 21a9722d..49c54916 100644 --- a/test-suite/success/Check.v +++ b/test-suite/success/Check.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(*