diff options
416 files changed, 37009 insertions, 19462 deletions
@@ -1,873 +1,876 @@ ide/config_parser.cmi: lib/util.cmi -ide/coq.cmi: kernel/environ.cmi pretyping/evd.cmi kernel/names.cmi \ - kernel/term.cmi lib/util.cmi toplevel/vernacexpr.cmo -interp/constrextern.cmi: kernel/environ.cmi library/libnames.cmi \ - kernel/names.cmi library/nametab.cmi interp/notation.cmi \ - pretyping/pattern.cmi pretyping/rawterm.cmi kernel/sign.cmi \ - kernel/term.cmi pretyping/termops.cmi interp/topconstr.cmi lib/util.cmi -interp/constrintern.cmi: kernel/environ.cmi pretyping/evd.cmi \ - library/impargs.cmi library/libnames.cmi kernel/names.cmi \ - pretyping/pattern.cmi pretyping/pretyping.cmi pretyping/rawterm.cmi \ - kernel/sign.cmi kernel/term.cmi pretyping/termops.cmi \ - interp/topconstr.cmi -interp/coqlib.cmi: library/libnames.cmi kernel/names.cmi library/nametab.cmi \ - pretyping/pattern.cmi kernel/term.cmi -interp/genarg.cmi: pretyping/evd.cmi library/libnames.cmi kernel/names.cmi \ - lib/pp.cmi pretyping/rawterm.cmi kernel/term.cmi interp/topconstr.cmi \ - lib/util.cmi -interp/modintern.cmi: kernel/declarations.cmi kernel/entries.cmi \ - kernel/environ.cmi interp/topconstr.cmi -interp/notation.cmi: lib/bigint.cmi pretyping/classops.cmi \ - library/libnames.cmi kernel/names.cmi library/nametab.cmi lib/pp.cmi \ - interp/ppextend.cmi pretyping/rawterm.cmi kernel/term.cmi \ - interp/topconstr.cmi lib/util.cmi -interp/ppextend.cmi: kernel/names.cmi lib/pp.cmi -interp/reserve.cmi: kernel/names.cmi pretyping/rawterm.cmi lib/util.cmi -interp/syntax_def.cmi: library/libnames.cmi kernel/names.cmi \ - pretyping/rawterm.cmi interp/topconstr.cmi lib/util.cmi -interp/topconstr.cmi: lib/bigint.cmi lib/dyn.cmi pretyping/evd.cmi \ - library/libnames.cmi kernel/mod_subst.cmi kernel/names.cmi lib/pp.cmi \ - pretyping/rawterm.cmi kernel/term.cmi lib/util.cmi -kernel/cbytecodes.cmi: kernel/names.cmi kernel/term.cmi -kernel/cbytegen.cmi: kernel/cbytecodes.cmi kernel/cemitcodes.cmi \ - kernel/declarations.cmi kernel/names.cmi kernel/pre_env.cmi \ - kernel/term.cmi -kernel/cemitcodes.cmi: kernel/cbytecodes.cmi kernel/mod_subst.cmi \ - kernel/names.cmi -kernel/closure.cmi: kernel/environ.cmi kernel/esubst.cmi kernel/names.cmi \ - lib/pp.cmi kernel/term.cmi +ide/coq.cmi: toplevel/vernacexpr.cmo lib/util.cmi kernel/term.cmi \ + kernel/names.cmi pretyping/evd.cmi kernel/environ.cmi +interp/constrextern.cmi: lib/util.cmi interp/topconstr.cmi \ + pretyping/termops.cmi kernel/term.cmi kernel/sign.cmi \ + pretyping/rawterm.cmi pretyping/pattern.cmi interp/notation.cmi \ + library/nametab.cmi kernel/names.cmi library/libnames.cmi \ + kernel/environ.cmi +interp/constrintern.cmi: interp/topconstr.cmi pretyping/termops.cmi \ + kernel/term.cmi kernel/sign.cmi pretyping/rawterm.cmi \ + pretyping/pretyping.cmi pretyping/pattern.cmi kernel/names.cmi \ + library/libnames.cmi library/impargs.cmi pretyping/evd.cmi \ + kernel/environ.cmi +interp/coqlib.cmi: kernel/term.cmi pretyping/pattern.cmi library/nametab.cmi \ + kernel/names.cmi library/libnames.cmi +interp/genarg.cmi: lib/util.cmi interp/topconstr.cmi kernel/term.cmi \ + pretyping/rawterm.cmi lib/pp.cmi kernel/names.cmi library/libnames.cmi \ + pretyping/evd.cmi +interp/modintern.cmi: interp/topconstr.cmi kernel/environ.cmi \ + kernel/entries.cmi kernel/declarations.cmi +interp/notation.cmi: lib/util.cmi interp/topconstr.cmi kernel/term.cmi \ + pretyping/rawterm.cmi interp/ppextend.cmi lib/pp.cmi library/nametab.cmi \ + kernel/names.cmi library/libnames.cmi pretyping/classops.cmi \ + lib/bigint.cmi +interp/ppextend.cmi: lib/pp.cmi kernel/names.cmi +interp/reserve.cmi: lib/util.cmi pretyping/rawterm.cmi kernel/names.cmi +interp/syntax_def.cmi: lib/util.cmi interp/topconstr.cmi \ + pretyping/rawterm.cmi kernel/names.cmi library/libnames.cmi +interp/topconstr.cmi: lib/util.cmi kernel/term.cmi pretyping/rawterm.cmi \ + lib/pp.cmi kernel/names.cmi kernel/mod_subst.cmi library/libnames.cmi \ + pretyping/evd.cmi lib/dyn.cmi lib/bigint.cmi +kernel/cbytecodes.cmi: kernel/term.cmi kernel/names.cmi +kernel/cbytegen.cmi: kernel/term.cmi kernel/pre_env.cmi kernel/names.cmi \ + kernel/declarations.cmi kernel/cemitcodes.cmi kernel/cbytecodes.cmi +kernel/cemitcodes.cmi: kernel/names.cmi kernel/mod_subst.cmi \ + kernel/cbytecodes.cmi +kernel/closure.cmi: kernel/term.cmi lib/pp.cmi kernel/names.cmi \ + kernel/esubst.cmi kernel/environ.cmi kernel/conv_oracle.cmi: kernel/names.cmi -kernel/cooking.cmi: kernel/declarations.cmi kernel/environ.cmi \ - kernel/names.cmi kernel/sign.cmi kernel/term.cmi kernel/univ.cmi -kernel/csymtable.cmi: kernel/names.cmi kernel/pre_env.cmi kernel/term.cmi -kernel/declarations.cmi: kernel/cbytecodes.cmi kernel/cemitcodes.cmi \ - kernel/mod_subst.cmi kernel/names.cmi lib/rtree.cmi kernel/sign.cmi \ - kernel/term.cmi kernel/univ.cmi -kernel/entries.cmi: kernel/names.cmi kernel/sign.cmi kernel/term.cmi \ - kernel/univ.cmi -kernel/environ.cmi: kernel/cemitcodes.cmi kernel/declarations.cmi \ - kernel/names.cmi kernel/pre_env.cmi kernel/sign.cmi kernel/term.cmi \ - kernel/univ.cmi +kernel/cooking.cmi: kernel/univ.cmi kernel/term.cmi kernel/sign.cmi \ + kernel/names.cmi kernel/environ.cmi kernel/declarations.cmi +kernel/csymtable.cmi: kernel/term.cmi kernel/pre_env.cmi kernel/names.cmi +kernel/declarations.cmi: kernel/univ.cmi kernel/term.cmi kernel/sign.cmi \ + lib/rtree.cmi kernel/names.cmi kernel/mod_subst.cmi kernel/cemitcodes.cmi \ + kernel/cbytecodes.cmi +kernel/entries.cmi: kernel/univ.cmi kernel/term.cmi kernel/sign.cmi \ + kernel/names.cmi +kernel/environ.cmi: kernel/univ.cmi kernel/term.cmi kernel/sign.cmi \ + kernel/pre_env.cmi kernel/names.cmi kernel/declarations.cmi \ + kernel/cemitcodes.cmi kernel/esubst.cmi: lib/util.cmi -kernel/indtypes.cmi: kernel/declarations.cmi kernel/entries.cmi \ - kernel/environ.cmi kernel/names.cmi kernel/term.cmi kernel/typeops.cmi \ - kernel/univ.cmi -kernel/inductive.cmi: kernel/declarations.cmi kernel/environ.cmi \ - kernel/names.cmi kernel/term.cmi kernel/univ.cmi -kernel/modops.cmi: kernel/declarations.cmi kernel/entries.cmi \ - kernel/environ.cmi kernel/mod_subst.cmi kernel/names.cmi kernel/univ.cmi \ - lib/util.cmi -kernel/mod_subst.cmi: kernel/names.cmi lib/pp.cmi kernel/term.cmi -kernel/mod_typing.cmi: kernel/declarations.cmi kernel/entries.cmi \ +kernel/indtypes.cmi: kernel/univ.cmi kernel/typeops.cmi kernel/term.cmi \ + kernel/names.cmi kernel/environ.cmi kernel/entries.cmi \ + kernel/declarations.cmi +kernel/inductive.cmi: kernel/univ.cmi kernel/term.cmi kernel/sign.cmi \ + kernel/names.cmi kernel/environ.cmi kernel/declarations.cmi +kernel/modops.cmi: lib/util.cmi kernel/univ.cmi kernel/names.cmi \ + kernel/mod_subst.cmi kernel/environ.cmi kernel/entries.cmi \ + kernel/declarations.cmi +kernel/mod_subst.cmi: kernel/term.cmi lib/pp.cmi kernel/names.cmi +kernel/mod_typing.cmi: kernel/environ.cmi kernel/entries.cmi \ + kernel/declarations.cmi +kernel/names.cmi: lib/predicate.cmi lib/pp.cmi +kernel/pre_env.cmi: lib/util.cmi kernel/univ.cmi kernel/term.cmi \ + kernel/sign.cmi kernel/names.cmi kernel/declarations.cmi +kernel/reduction.cmi: kernel/univ.cmi kernel/term.cmi kernel/sign.cmi \ kernel/environ.cmi -kernel/names.cmi: lib/pp.cmi lib/predicate.cmi -kernel/pre_env.cmi: kernel/declarations.cmi kernel/names.cmi kernel/sign.cmi \ - kernel/term.cmi kernel/univ.cmi lib/util.cmi -kernel/reduction.cmi: kernel/environ.cmi kernel/sign.cmi kernel/term.cmi \ - kernel/univ.cmi -kernel/safe_typing.cmi: kernel/cooking.cmi kernel/declarations.cmi \ - kernel/entries.cmi kernel/environ.cmi kernel/names.cmi kernel/term.cmi \ - kernel/univ.cmi -kernel/sign.cmi: kernel/names.cmi kernel/term.cmi -kernel/subtyping.cmi: kernel/declarations.cmi kernel/environ.cmi \ - kernel/univ.cmi -kernel/term.cmi: kernel/esubst.cmi kernel/names.cmi kernel/univ.cmi -kernel/term_typing.cmi: kernel/cooking.cmi kernel/declarations.cmi \ - kernel/entries.cmi kernel/environ.cmi kernel/inductive.cmi \ - kernel/names.cmi kernel/term.cmi kernel/typeops.cmi kernel/univ.cmi -kernel/type_errors.cmi: kernel/environ.cmi kernel/names.cmi kernel/term.cmi -kernel/typeops.cmi: kernel/entries.cmi kernel/environ.cmi kernel/names.cmi \ - kernel/sign.cmi kernel/term.cmi kernel/univ.cmi -kernel/univ.cmi: kernel/names.cmi lib/pp.cmi -kernel/vconv.cmi: kernel/environ.cmi kernel/names.cmi kernel/reduction.cmi \ - kernel/term.cmi kernel/vm.cmi -kernel/vm.cmi: kernel/cbytecodes.cmi kernel/cemitcodes.cmi kernel/names.cmi \ - kernel/term.cmi +kernel/safe_typing.cmi: kernel/univ.cmi kernel/term.cmi kernel/names.cmi \ + kernel/environ.cmi kernel/entries.cmi kernel/declarations.cmi \ + kernel/cooking.cmi +kernel/sign.cmi: kernel/term.cmi kernel/names.cmi +kernel/subtyping.cmi: kernel/univ.cmi kernel/environ.cmi \ + kernel/declarations.cmi +kernel/term.cmi: kernel/univ.cmi kernel/names.cmi kernel/esubst.cmi +kernel/term_typing.cmi: kernel/univ.cmi kernel/typeops.cmi kernel/term.cmi \ + kernel/names.cmi kernel/inductive.cmi kernel/environ.cmi \ + kernel/entries.cmi kernel/declarations.cmi kernel/cooking.cmi +kernel/type_errors.cmi: kernel/term.cmi kernel/names.cmi kernel/environ.cmi +kernel/typeops.cmi: kernel/univ.cmi kernel/term.cmi kernel/sign.cmi \ + kernel/names.cmi kernel/environ.cmi kernel/entries.cmi +kernel/univ.cmi: lib/pp.cmi kernel/names.cmi +kernel/vconv.cmi: kernel/vm.cmi kernel/term.cmi kernel/reduction.cmi \ + kernel/names.cmi kernel/environ.cmi +kernel/vm.cmi: kernel/term.cmi kernel/names.cmi kernel/cemitcodes.cmi \ + kernel/cbytecodes.cmi lib/bigint.cmi: lib/pp.cmi lib/pp.cmi: lib/pp_control.cmi -library/declare.cmi: library/decl_kinds.cmo kernel/declarations.cmi \ - kernel/entries.cmi kernel/environ.cmi kernel/indtypes.cmi \ - library/libnames.cmi kernel/names.cmi library/nametab.cmi \ - kernel/safe_typing.cmi kernel/sign.cmi kernel/term.cmi -library/declaremods.cmi: kernel/entries.cmi kernel/environ.cmi \ - library/lib.cmi library/libnames.cmi library/libobject.cmi \ - kernel/names.cmi lib/pp.cmi kernel/safe_typing.cmi lib/util.cmi -library/dischargedhypsmap.cmi: kernel/environ.cmi library/libnames.cmi \ - library/nametab.cmi kernel/term.cmi -library/global.cmi: kernel/declarations.cmi kernel/entries.cmi \ - kernel/environ.cmi kernel/indtypes.cmi library/libnames.cmi \ - kernel/names.cmi kernel/safe_typing.cmi kernel/sign.cmi kernel/term.cmi \ - kernel/univ.cmi -library/goptions.cmi: library/libnames.cmi kernel/mod_subst.cmi \ - kernel/names.cmi library/nametab.cmi lib/pp.cmi kernel/term.cmi \ - lib/util.cmi -library/impargs.cmi: kernel/environ.cmi library/libnames.cmi kernel/names.cmi \ - library/nametab.cmi kernel/term.cmi interp/topconstr.cmi -library/lib.cmi: library/libnames.cmi library/libobject.cmi \ - kernel/mod_subst.cmi kernel/names.cmi kernel/sign.cmi library/summary.cmi \ - kernel/term.cmi lib/util.cmi -library/libnames.cmi: kernel/mod_subst.cmi kernel/names.cmi lib/pp.cmi \ - lib/predicate.cmi kernel/term.cmi lib/util.cmi -library/libobject.cmi: library/libnames.cmi kernel/mod_subst.cmi \ - kernel/names.cmi -library/library.cmi: library/libnames.cmi library/libobject.cmi \ - kernel/names.cmi lib/pp.cmi lib/system.cmi lib/util.cmi -library/nameops.cmi: kernel/names.cmi lib/pp.cmi kernel/term.cmi -library/nametab.cmi: library/libnames.cmi kernel/names.cmi lib/pp.cmi \ - lib/util.cmi +library/declare.cmi: kernel/term.cmi kernel/sign.cmi kernel/safe_typing.cmi \ + library/nametab.cmi kernel/names.cmi library/libnames.cmi \ + kernel/indtypes.cmi kernel/environ.cmi kernel/entries.cmi \ + kernel/declarations.cmi library/decl_kinds.cmo +library/declaremods.cmi: lib/util.cmi kernel/safe_typing.cmi lib/pp.cmi \ + kernel/names.cmi library/libobject.cmi library/libnames.cmi \ + library/lib.cmi kernel/environ.cmi kernel/entries.cmi +library/dischargedhypsmap.cmi: kernel/term.cmi library/nametab.cmi \ + library/libnames.cmi kernel/environ.cmi +library/global.cmi: kernel/univ.cmi kernel/term.cmi kernel/sign.cmi \ + kernel/safe_typing.cmi kernel/names.cmi library/libnames.cmi \ + kernel/indtypes.cmi kernel/environ.cmi kernel/entries.cmi \ + kernel/declarations.cmi +library/goptions.cmi: lib/util.cmi kernel/term.cmi lib/pp.cmi \ + library/nametab.cmi kernel/names.cmi kernel/mod_subst.cmi \ + library/libnames.cmi +library/impargs.cmi: interp/topconstr.cmi kernel/term.cmi library/nametab.cmi \ + kernel/names.cmi library/libnames.cmi kernel/environ.cmi +library/lib.cmi: lib/util.cmi kernel/term.cmi library/summary.cmi \ + kernel/sign.cmi kernel/names.cmi kernel/mod_subst.cmi \ + library/libobject.cmi library/libnames.cmi +library/libnames.cmi: lib/util.cmi kernel/term.cmi lib/predicate.cmi \ + lib/pp.cmi kernel/names.cmi kernel/mod_subst.cmi +library/libobject.cmi: kernel/names.cmi kernel/mod_subst.cmi \ + library/libnames.cmi +library/library.cmi: lib/util.cmi lib/system.cmi lib/pp.cmi kernel/names.cmi \ + library/libobject.cmi library/libnames.cmi +library/nameops.cmi: kernel/term.cmi lib/pp.cmi kernel/names.cmi +library/nametab.cmi: lib/util.cmi lib/pp.cmi kernel/names.cmi \ + library/libnames.cmi lib/rtree.cmi: lib/pp.cmi lib/system.cmi: lib/pp.cmi -lib/util.cmi: lib/compat.cmo lib/pp.cmi -parsing/egrammar.cmi: parsing/extend.cmi interp/genarg.cmi \ - kernel/mod_subst.cmi kernel/names.cmi parsing/pcoq.cmi \ - interp/ppextend.cmi pretyping/rawterm.cmi proofs/tacexpr.cmo \ - interp/topconstr.cmi lib/util.cmi toplevel/vernacexpr.cmo +lib/util.cmi: lib/pp.cmi lib/compat.cmo +parsing/egrammar.cmi: toplevel/vernacexpr.cmo lib/util.cmi \ + interp/topconstr.cmi proofs/tacexpr.cmo pretyping/rawterm.cmi \ + interp/ppextend.cmi parsing/pcoq.cmi kernel/names.cmi \ + kernel/mod_subst.cmi interp/genarg.cmi parsing/extend.cmi parsing/extend.cmi: lib/util.cmi -parsing/g_minicoq.cmi: kernel/environ.cmi kernel/names.cmi lib/pp.cmi \ - kernel/term.cmi -parsing/lexer.cmi: lib/pp.cmi lib/util.cmi -parsing/pcoq.cmi: lib/bigint.cmi library/decl_kinds.cmo parsing/extend.cmi \ - interp/genarg.cmi library/libnames.cmi kernel/names.cmi \ - pretyping/rawterm.cmi proofs/tacexpr.cmo interp/topconstr.cmi \ - lib/util.cmi toplevel/vernacexpr.cmo -parsing/ppconstr.cmi: kernel/environ.cmi interp/genarg.cmi \ - library/libnames.cmi kernel/names.cmi parsing/pcoq.cmi lib/pp.cmi \ - interp/ppextend.cmi pretyping/rawterm.cmi proofs/tacexpr.cmo \ - kernel/term.cmi interp/topconstr.cmi lib/util.cmi -parsing/pptactic.cmi: kernel/environ.cmi interp/genarg.cmi \ - library/libnames.cmi lib/pp.cmi interp/ppextend.cmi \ - pretyping/pretyping.cmi proofs/proof_type.cmi pretyping/rawterm.cmi \ - proofs/tacexpr.cmo kernel/term.cmi interp/topconstr.cmi -parsing/ppvernac.cmi: interp/genarg.cmi library/libnames.cmi \ - library/nameops.cmi kernel/names.cmi library/nametab.cmi parsing/pcoq.cmi \ - lib/pp.cmi parsing/ppconstr.cmi interp/ppextend.cmi parsing/pptactic.cmi \ - pretyping/rawterm.cmi interp/topconstr.cmi lib/util.cmi \ - toplevel/vernacexpr.cmo -parsing/prettyp.cmi: pretyping/classops.cmi kernel/environ.cmi \ - library/impargs.cmi library/lib.cmi library/libnames.cmi kernel/names.cmi \ - library/nametab.cmi lib/pp.cmi pretyping/reductionops.cmi \ - kernel/safe_typing.cmi kernel/sign.cmi kernel/term.cmi \ - pretyping/termops.cmi lib/util.cmi -parsing/printer.cmi: kernel/environ.cmi pretyping/evd.cmi \ - library/libnames.cmi kernel/names.cmi library/nametab.cmi \ - pretyping/pattern.cmi lib/pp.cmi proofs/proof_type.cmi \ - pretyping/rawterm.cmi kernel/sign.cmi kernel/term.cmi \ - pretyping/termops.cmi -parsing/printmod.cmi: kernel/names.cmi lib/pp.cmi -parsing/q_util.cmi: parsing/pcoq.cmi lib/util.cmi -parsing/search.cmi: kernel/environ.cmi library/libnames.cmi kernel/names.cmi \ - library/nametab.cmi pretyping/pattern.cmi lib/pp.cmi kernel/term.cmi -parsing/tactic_printer.cmi: pretyping/evd.cmi lib/pp.cmi \ - proofs/proof_type.cmi kernel/sign.cmi proofs/tacexpr.cmo -pretyping/cases.cmi: pretyping/coercion.cmi kernel/environ.cmi \ - pretyping/evarutil.cmi pretyping/evd.cmi pretyping/inductiveops.cmi \ - kernel/names.cmi pretyping/rawterm.cmi kernel/term.cmi lib/util.cmi -pretyping/cbv.cmi: kernel/closure.cmi kernel/environ.cmi kernel/esubst.cmi \ - kernel/names.cmi kernel/term.cmi -pretyping/classops.cmi: library/decl_kinds.cmo kernel/environ.cmi \ - pretyping/evd.cmi library/libnames.cmi kernel/mod_subst.cmi \ - kernel/names.cmi library/nametab.cmi lib/pp.cmi kernel/term.cmi -pretyping/clenv.cmi: kernel/environ.cmi pretyping/evarutil.cmi \ - pretyping/evd.cmi kernel/mod_subst.cmi kernel/names.cmi lib/pp.cmi \ - pretyping/rawterm.cmi kernel/sign.cmi kernel/term.cmi lib/util.cmi -pretyping/coercion.cmi: kernel/environ.cmi pretyping/evarutil.cmi \ - pretyping/evd.cmi kernel/names.cmi pretyping/rawterm.cmi kernel/sign.cmi \ - kernel/term.cmi lib/util.cmi -pretyping/detyping.cmi: kernel/environ.cmi kernel/mod_subst.cmi \ - kernel/names.cmi pretyping/rawterm.cmi kernel/sign.cmi kernel/term.cmi \ - pretyping/termops.cmi lib/util.cmi -pretyping/evarconv.cmi: kernel/environ.cmi pretyping/evd.cmi \ - pretyping/reductionops.cmi kernel/sign.cmi kernel/term.cmi -pretyping/evarutil.cmi: kernel/environ.cmi pretyping/evd.cmi kernel/names.cmi \ - pretyping/rawterm.cmi pretyping/reductionops.cmi kernel/sign.cmi \ - kernel/term.cmi lib/util.cmi -pretyping/evd.cmi: kernel/environ.cmi library/libnames.cmi \ - kernel/mod_subst.cmi kernel/names.cmi lib/pp.cmi kernel/reduction.cmi \ - kernel/sign.cmi kernel/term.cmi lib/util.cmi -pretyping/indrec.cmi: kernel/declarations.cmi kernel/environ.cmi \ - pretyping/evd.cmi pretyping/inductiveops.cmi kernel/names.cmi \ - kernel/term.cmi -pretyping/inductiveops.cmi: kernel/declarations.cmi kernel/environ.cmi \ - pretyping/evd.cmi kernel/mod_subst.cmi kernel/names.cmi kernel/sign.cmi \ - kernel/term.cmi -pretyping/matching.cmi: kernel/environ.cmi pretyping/evd.cmi kernel/names.cmi \ - pretyping/pattern.cmi kernel/term.cmi pretyping/termops.cmi -pretyping/pattern.cmi: kernel/environ.cmi library/libnames.cmi \ - kernel/mod_subst.cmi kernel/names.cmi library/nametab.cmi lib/pp.cmi \ - pretyping/rawterm.cmi kernel/sign.cmi kernel/term.cmi -pretyping/pretype_errors.cmi: kernel/environ.cmi pretyping/evd.cmi \ - pretyping/inductiveops.cmi kernel/names.cmi lib/pp.cmi \ - pretyping/rawterm.cmi kernel/sign.cmi kernel/term.cmi lib/util.cmi -pretyping/pretyping.cmi: pretyping/cases.cmi pretyping/coercion.cmi \ - lib/dyn.cmi kernel/environ.cmi pretyping/evarutil.cmi pretyping/evd.cmi \ - kernel/names.cmi pretyping/rawterm.cmi kernel/sign.cmi kernel/term.cmi -pretyping/rawterm.cmi: lib/dyn.cmi pretyping/evd.cmi library/libnames.cmi \ - kernel/names.cmi library/nametab.cmi kernel/sign.cmi kernel/term.cmi \ - kernel/univ.cmi lib/util.cmi -pretyping/recordops.cmi: pretyping/classops.cmi library/libnames.cmi \ - library/libobject.cmi library/library.cmi kernel/names.cmi \ - library/nametab.cmi kernel/term.cmi -pretyping/reductionops.cmi: kernel/closure.cmi kernel/environ.cmi \ - pretyping/evd.cmi kernel/names.cmi kernel/sign.cmi kernel/term.cmi \ - kernel/univ.cmi -pretyping/retyping.cmi: kernel/environ.cmi pretyping/evd.cmi kernel/term.cmi \ - pretyping/termops.cmi -pretyping/tacred.cmi: kernel/closure.cmi kernel/environ.cmi pretyping/evd.cmi \ - library/libnames.cmi kernel/names.cmi pretyping/rawterm.cmi \ - pretyping/reductionops.cmi kernel/term.cmi kernel/type_errors.cmi -pretyping/termops.cmi: kernel/environ.cmi kernel/names.cmi lib/pp.cmi \ - kernel/sign.cmi kernel/term.cmi kernel/univ.cmi lib/util.cmi -pretyping/typing.cmi: kernel/environ.cmi pretyping/evd.cmi kernel/term.cmi -pretyping/unification.cmi: kernel/environ.cmi pretyping/evd.cmi \ - kernel/term.cmi -proofs/clenvtac.cmi: pretyping/clenv.cmi pretyping/evd.cmi kernel/names.cmi \ - proofs/proof_type.cmi kernel/sign.cmi kernel/term.cmi lib/util.cmi -proofs/evar_refiner.cmi: kernel/environ.cmi pretyping/evd.cmi \ - kernel/names.cmi pretyping/rawterm.cmi proofs/refiner.cmi kernel/term.cmi \ - interp/topconstr.cmi -proofs/logic.cmi: kernel/environ.cmi pretyping/evd.cmi kernel/names.cmi \ - proofs/proof_type.cmi kernel/sign.cmi kernel/term.cmi -proofs/pfedit.cmi: library/decl_kinds.cmo kernel/entries.cmi \ - kernel/environ.cmi pretyping/evd.cmi kernel/names.cmi lib/pp.cmi \ - kernel/sign.cmi proofs/tacexpr.cmo proofs/tacmach.cmi kernel/term.cmi \ - interp/topconstr.cmi lib/util.cmi -proofs/proof_trees.cmi: kernel/environ.cmi pretyping/evd.cmi kernel/names.cmi \ - lib/pp.cmi proofs/proof_type.cmi kernel/sign.cmi kernel/term.cmi \ - lib/util.cmi -proofs/proof_type.cmi: kernel/environ.cmi pretyping/evd.cmi interp/genarg.cmi \ - library/libnames.cmi kernel/names.cmi library/nametab.cmi \ - pretyping/pattern.cmi pretyping/rawterm.cmi proofs/tacexpr.cmo \ - kernel/term.cmi lib/util.cmi -proofs/redexpr.cmi: kernel/closure.cmi kernel/names.cmi pretyping/rawterm.cmi \ - pretyping/reductionops.cmi kernel/term.cmi -proofs/refiner.cmi: kernel/environ.cmi pretyping/evd.cmi lib/pp.cmi \ - proofs/proof_trees.cmi proofs/proof_type.cmi kernel/sign.cmi \ - proofs/tacexpr.cmo kernel/term.cmi pretyping/termops.cmi -proofs/tacmach.cmi: kernel/environ.cmi pretyping/evd.cmi kernel/names.cmi \ - lib/pp.cmi proofs/proof_trees.cmi proofs/proof_type.cmi \ - pretyping/rawterm.cmi proofs/redexpr.cmi kernel/reduction.cmi \ - proofs/refiner.cmi kernel/sign.cmi proofs/tacexpr.cmo kernel/term.cmi \ - pretyping/termops.cmi interp/topconstr.cmi -proofs/tactic_debug.cmi: kernel/environ.cmi pretyping/evd.cmi \ - kernel/names.cmi pretyping/pattern.cmi lib/pp.cmi proofs/proof_type.cmi \ - proofs/tacexpr.cmo kernel/term.cmi -tactics/auto.cmi: tactics/btermdn.cmi pretyping/clenv.cmi kernel/environ.cmi \ - pretyping/evd.cmi library/libnames.cmi kernel/mod_subst.cmi \ - kernel/names.cmi pretyping/pattern.cmi lib/pp.cmi proofs/proof_type.cmi \ - pretyping/rawterm.cmi kernel/sign.cmi proofs/tacexpr.cmo \ - proofs/tacmach.cmi kernel/term.cmi lib/util.cmi toplevel/vernacexpr.cmo -tactics/autorewrite.cmi: kernel/names.cmi proofs/tacexpr.cmo \ - proofs/tacmach.cmi kernel/term.cmi -tactics/btermdn.cmi: pretyping/pattern.cmi kernel/term.cmi -tactics/contradiction.cmi: kernel/names.cmi proofs/proof_type.cmi \ - pretyping/rawterm.cmi kernel/term.cmi -tactics/dhyp.cmi: kernel/names.cmi proofs/tacexpr.cmo proofs/tacmach.cmi \ - interp/topconstr.cmi toplevel/vernacexpr.cmo -tactics/eauto.cmi: tactics/auto.cmi proofs/proof_type.cmi proofs/tacexpr.cmo \ - kernel/term.cmi interp/topconstr.cmi -tactics/elim.cmi: interp/genarg.cmi kernel/names.cmi proofs/proof_type.cmi \ - pretyping/rawterm.cmi proofs/tacmach.cmi tactics/tacticals.cmi \ - kernel/term.cmi -tactics/equality.cmi: kernel/environ.cmi pretyping/evd.cmi \ - tactics/hipattern.cmi kernel/names.cmi pretyping/pattern.cmi \ - proofs/proof_type.cmi pretyping/rawterm.cmi kernel/sign.cmi \ - proofs/tacexpr.cmo proofs/tacmach.cmi tactics/tacticals.cmi \ - tactics/tactics.cmi kernel/term.cmi -tactics/evar_tactics.cmi: kernel/names.cmi pretyping/rawterm.cmi \ - proofs/tacexpr.cmo proofs/tacmach.cmi kernel/term.cmi -tactics/extraargs.cmi: kernel/names.cmi parsing/pcoq.cmi \ - proofs/proof_type.cmi pretyping/rawterm.cmi tactics/setoid_replace.cmi \ - proofs/tacexpr.cmo kernel/term.cmi interp/topconstr.cmi lib/util.cmi -tactics/extratactics.cmi: interp/genarg.cmi kernel/names.cmi parsing/pcoq.cmi \ - proofs/proof_type.cmi pretyping/rawterm.cmi proofs/tacexpr.cmo \ - kernel/term.cmi interp/topconstr.cmi -tactics/hiddentac.cmi: interp/genarg.cmi kernel/names.cmi \ - proofs/proof_type.cmi pretyping/rawterm.cmi proofs/redexpr.cmi \ - proofs/tacexpr.cmo proofs/tacmach.cmi tactics/tacticals.cmi \ - kernel/term.cmi -tactics/hipattern.cmi: interp/coqlib.cmi pretyping/evd.cmi kernel/names.cmi \ - pretyping/pattern.cmi proofs/proof_trees.cmi proofs/proof_type.cmi \ - kernel/sign.cmi proofs/tacmach.cmi kernel/term.cmi lib/util.cmi -tactics/inv.cmi: interp/genarg.cmi kernel/names.cmi pretyping/rawterm.cmi \ - proofs/tacexpr.cmo proofs/tacmach.cmi kernel/term.cmi -tactics/leminv.cmi: kernel/names.cmi proofs/proof_type.cmi \ - pretyping/rawterm.cmi kernel/term.cmi interp/topconstr.cmi lib/util.cmi -tactics/nbtermdn.cmi: tactics/btermdn.cmi library/libnames.cmi \ - pretyping/pattern.cmi kernel/term.cmi -tactics/refine.cmi: pretyping/evd.cmi proofs/tacmach.cmi -tactics/setoid_replace.cmi: kernel/names.cmi lib/pp.cmi proofs/proof_type.cmi \ - kernel/term.cmi interp/topconstr.cmi -tactics/tacinterp.cmi: lib/dyn.cmi kernel/environ.cmi pretyping/evd.cmi \ - interp/genarg.cmi library/libnames.cmi kernel/mod_subst.cmi \ - kernel/names.cmi library/nametab.cmi lib/pp.cmi proofs/proof_type.cmi \ - proofs/redexpr.cmi proofs/tacexpr.cmo proofs/tacmach.cmi \ - proofs/tactic_debug.cmi kernel/term.cmi interp/topconstr.cmi lib/util.cmi -tactics/tacticals.cmi: pretyping/clenv.cmi interp/genarg.cmi kernel/names.cmi \ - pretyping/pattern.cmi lib/pp.cmi proofs/proof_type.cmi \ - kernel/reduction.cmi kernel/sign.cmi proofs/tacexpr.cmo \ - proofs/tacmach.cmi kernel/term.cmi -tactics/tactics.cmi: pretyping/clenv.cmi kernel/environ.cmi \ - proofs/evar_refiner.cmi pretyping/evd.cmi interp/genarg.cmi \ - library/libnames.cmi kernel/names.cmi library/nametab.cmi \ - proofs/proof_type.cmi pretyping/rawterm.cmi proofs/redexpr.cmi \ - kernel/reduction.cmi kernel/sign.cmi proofs/tacexpr.cmo \ - proofs/tacmach.cmi tactics/tacticals.cmi kernel/term.cmi \ - interp/topconstr.cmi -tactics/termdn.cmi: library/libnames.cmi pretyping/pattern.cmi \ - kernel/term.cmi -toplevel/cerrors.cmi: lib/pp.cmi lib/util.cmi -toplevel/class.cmi: pretyping/classops.cmi library/decl_kinds.cmo \ - library/declare.cmi library/libnames.cmi kernel/names.cmi \ - library/nametab.cmi proofs/tacexpr.cmo kernel/term.cmi -toplevel/command.cmi: library/decl_kinds.cmo library/declare.cmi \ - kernel/entries.cmi kernel/environ.cmi pretyping/evd.cmi \ - library/libnames.cmi library/library.cmi kernel/names.cmi \ - library/nametab.cmi pretyping/rawterm.cmi proofs/redexpr.cmi \ - proofs/tacexpr.cmo kernel/term.cmi interp/topconstr.cmi lib/util.cmi \ - toplevel/vernacexpr.cmo +parsing/g_minicoq.cmi: kernel/term.cmi lib/pp.cmi kernel/names.cmi \ + kernel/environ.cmi +parsing/lexer.cmi: lib/util.cmi lib/pp.cmi +parsing/pcoq.cmi: toplevel/vernacexpr.cmo lib/util.cmi interp/topconstr.cmi \ + proofs/tacexpr.cmo pretyping/rawterm.cmi kernel/names.cmi \ + library/libnames.cmi interp/genarg.cmi parsing/extend.cmi \ + library/decl_kinds.cmo lib/bigint.cmi +parsing/ppconstr.cmi: lib/util.cmi interp/topconstr.cmi kernel/term.cmi \ + proofs/tacexpr.cmo pretyping/rawterm.cmi interp/ppextend.cmi lib/pp.cmi \ + parsing/pcoq.cmi kernel/names.cmi library/libnames.cmi interp/genarg.cmi \ + kernel/environ.cmi +parsing/pptactic.cmi: interp/topconstr.cmi kernel/term.cmi proofs/tacexpr.cmo \ + pretyping/rawterm.cmi proofs/proof_type.cmi pretyping/pretyping.cmi \ + interp/ppextend.cmi lib/pp.cmi library/libnames.cmi interp/genarg.cmi \ + kernel/environ.cmi +parsing/ppvernac.cmi: toplevel/vernacexpr.cmo lib/util.cmi \ + interp/topconstr.cmi pretyping/rawterm.cmi parsing/pptactic.cmi \ + interp/ppextend.cmi parsing/ppconstr.cmi lib/pp.cmi parsing/pcoq.cmi \ + library/nametab.cmi kernel/names.cmi library/nameops.cmi \ + library/libnames.cmi interp/genarg.cmi +parsing/prettyp.cmi: lib/util.cmi pretyping/termops.cmi kernel/term.cmi \ + kernel/sign.cmi kernel/safe_typing.cmi pretyping/reductionops.cmi \ + lib/pp.cmi library/nametab.cmi kernel/names.cmi library/libnames.cmi \ + library/lib.cmi library/impargs.cmi kernel/environ.cmi \ + pretyping/classops.cmi +parsing/printer.cmi: pretyping/termops.cmi kernel/term.cmi kernel/sign.cmi \ + pretyping/rawterm.cmi proofs/proof_type.cmi lib/pp.cmi \ + pretyping/pattern.cmi library/nametab.cmi kernel/names.cmi \ + library/libnames.cmi pretyping/evd.cmi kernel/environ.cmi +parsing/printmod.cmi: lib/pp.cmi kernel/names.cmi +parsing/q_util.cmi: lib/util.cmi parsing/pcoq.cmi +parsing/search.cmi: kernel/term.cmi lib/pp.cmi pretyping/pattern.cmi \ + library/nametab.cmi kernel/names.cmi library/libnames.cmi \ + kernel/environ.cmi +parsing/tactic_printer.cmi: proofs/tacexpr.cmo kernel/sign.cmi \ + proofs/proof_type.cmi lib/pp.cmi pretyping/evd.cmi +pretyping/cases.cmi: lib/util.cmi kernel/term.cmi pretyping/rawterm.cmi \ + kernel/names.cmi pretyping/inductiveops.cmi pretyping/evd.cmi \ + pretyping/evarutil.cmi kernel/environ.cmi pretyping/coercion.cmi +pretyping/cbv.cmi: kernel/term.cmi kernel/names.cmi kernel/esubst.cmi \ + kernel/environ.cmi kernel/closure.cmi +pretyping/classops.cmi: kernel/term.cmi lib/pp.cmi library/nametab.cmi \ + kernel/names.cmi kernel/mod_subst.cmi library/libnames.cmi \ + pretyping/evd.cmi kernel/environ.cmi library/decl_kinds.cmo +pretyping/clenv.cmi: lib/util.cmi kernel/term.cmi kernel/sign.cmi \ + pretyping/rawterm.cmi lib/pp.cmi kernel/names.cmi kernel/mod_subst.cmi \ + pretyping/evd.cmi pretyping/evarutil.cmi kernel/environ.cmi +pretyping/coercion.cmi: lib/util.cmi kernel/term.cmi kernel/sign.cmi \ + pretyping/rawterm.cmi kernel/names.cmi pretyping/evd.cmi \ + pretyping/evarutil.cmi kernel/environ.cmi +pretyping/detyping.cmi: lib/util.cmi pretyping/termops.cmi kernel/term.cmi \ + kernel/sign.cmi pretyping/rawterm.cmi kernel/names.cmi \ + kernel/mod_subst.cmi kernel/environ.cmi +pretyping/evarconv.cmi: kernel/term.cmi kernel/sign.cmi \ + pretyping/reductionops.cmi pretyping/evd.cmi kernel/environ.cmi +pretyping/evarutil.cmi: lib/util.cmi kernel/term.cmi kernel/sign.cmi \ + pretyping/reductionops.cmi pretyping/rawterm.cmi lib/pp.cmi \ + kernel/names.cmi pretyping/evd.cmi kernel/environ.cmi +pretyping/evd.cmi: lib/util.cmi kernel/term.cmi kernel/sign.cmi \ + kernel/reduction.cmi lib/pp.cmi kernel/names.cmi kernel/mod_subst.cmi \ + library/libnames.cmi kernel/environ.cmi +pretyping/indrec.cmi: kernel/term.cmi kernel/names.cmi \ + pretyping/inductiveops.cmi pretyping/evd.cmi kernel/environ.cmi \ + kernel/declarations.cmi +pretyping/inductiveops.cmi: kernel/term.cmi kernel/sign.cmi kernel/names.cmi \ + kernel/mod_subst.cmi pretyping/evd.cmi kernel/environ.cmi \ + kernel/declarations.cmi +pretyping/matching.cmi: pretyping/termops.cmi kernel/term.cmi \ + pretyping/pattern.cmi kernel/names.cmi pretyping/evd.cmi \ + kernel/environ.cmi +pretyping/pattern.cmi: kernel/term.cmi kernel/sign.cmi pretyping/rawterm.cmi \ + lib/pp.cmi library/nametab.cmi kernel/names.cmi kernel/mod_subst.cmi \ + library/libnames.cmi kernel/environ.cmi +pretyping/pretype_errors.cmi: lib/util.cmi kernel/term.cmi kernel/sign.cmi \ + pretyping/rawterm.cmi lib/pp.cmi kernel/names.cmi \ + pretyping/inductiveops.cmi pretyping/evd.cmi kernel/environ.cmi +pretyping/pretyping.cmi: kernel/term.cmi kernel/sign.cmi \ + pretyping/rawterm.cmi kernel/names.cmi pretyping/evd.cmi \ + pretyping/evarutil.cmi kernel/environ.cmi lib/dyn.cmi \ + pretyping/coercion.cmi pretyping/cases.cmi +pretyping/rawterm.cmi: lib/util.cmi kernel/univ.cmi kernel/term.cmi \ + kernel/sign.cmi library/nametab.cmi kernel/names.cmi library/libnames.cmi \ + pretyping/evd.cmi lib/dyn.cmi +pretyping/recordops.cmi: kernel/term.cmi library/nametab.cmi kernel/names.cmi \ + library/library.cmi library/libobject.cmi library/libnames.cmi \ + pretyping/classops.cmi +pretyping/reductionops.cmi: kernel/univ.cmi kernel/term.cmi kernel/sign.cmi \ + kernel/names.cmi pretyping/evd.cmi kernel/environ.cmi kernel/closure.cmi +pretyping/retyping.cmi: pretyping/termops.cmi kernel/term.cmi \ + kernel/names.cmi pretyping/evd.cmi kernel/environ.cmi +pretyping/tacred.cmi: kernel/type_errors.cmi kernel/term.cmi \ + pretyping/reductionops.cmi pretyping/rawterm.cmi kernel/names.cmi \ + library/libnames.cmi pretyping/evd.cmi kernel/environ.cmi \ + kernel/closure.cmi +pretyping/termops.cmi: lib/util.cmi kernel/univ.cmi kernel/term.cmi \ + kernel/sign.cmi lib/pp.cmi kernel/names.cmi kernel/environ.cmi +pretyping/typing.cmi: kernel/term.cmi pretyping/evd.cmi kernel/environ.cmi +pretyping/unification.cmi: kernel/term.cmi pretyping/evd.cmi \ + kernel/environ.cmi +proofs/clenvtac.cmi: lib/util.cmi kernel/term.cmi kernel/sign.cmi \ + proofs/proof_type.cmi kernel/names.cmi pretyping/evd.cmi \ + pretyping/clenv.cmi +proofs/evar_refiner.cmi: interp/topconstr.cmi kernel/term.cmi \ + proofs/refiner.cmi pretyping/rawterm.cmi kernel/names.cmi \ + pretyping/evd.cmi kernel/environ.cmi +proofs/logic.cmi: kernel/term.cmi kernel/sign.cmi proofs/proof_type.cmi \ + kernel/names.cmi pretyping/evd.cmi kernel/environ.cmi +proofs/pfedit.cmi: lib/util.cmi interp/topconstr.cmi kernel/term.cmi \ + proofs/tacmach.cmi proofs/tacexpr.cmo kernel/sign.cmi lib/pp.cmi \ + kernel/names.cmi pretyping/evd.cmi kernel/environ.cmi kernel/entries.cmi \ + library/decl_kinds.cmo +proofs/proof_trees.cmi: lib/util.cmi kernel/term.cmi kernel/sign.cmi \ + proofs/proof_type.cmi lib/pp.cmi kernel/names.cmi pretyping/evd.cmi \ + kernel/environ.cmi +proofs/proof_type.cmi: lib/util.cmi kernel/term.cmi proofs/tacexpr.cmo \ + pretyping/rawterm.cmi pretyping/pattern.cmi library/nametab.cmi \ + kernel/names.cmi library/libnames.cmi interp/genarg.cmi pretyping/evd.cmi \ + kernel/environ.cmi +proofs/redexpr.cmi: kernel/term.cmi pretyping/reductionops.cmi \ + pretyping/rawterm.cmi kernel/names.cmi kernel/closure.cmi +proofs/refiner.cmi: pretyping/termops.cmi kernel/term.cmi proofs/tacexpr.cmo \ + kernel/sign.cmi proofs/proof_type.cmi proofs/proof_trees.cmi lib/pp.cmi \ + pretyping/evd.cmi kernel/environ.cmi +proofs/tacmach.cmi: interp/topconstr.cmi pretyping/termops.cmi \ + kernel/term.cmi proofs/tacexpr.cmo kernel/sign.cmi proofs/refiner.cmi \ + kernel/reduction.cmi proofs/redexpr.cmi pretyping/rawterm.cmi \ + proofs/proof_type.cmi proofs/proof_trees.cmi lib/pp.cmi kernel/names.cmi \ + pretyping/evd.cmi kernel/environ.cmi +proofs/tactic_debug.cmi: kernel/term.cmi proofs/tacexpr.cmo \ + proofs/proof_type.cmi lib/pp.cmi pretyping/pattern.cmi kernel/names.cmi \ + pretyping/evd.cmi kernel/environ.cmi +tactics/auto.cmi: toplevel/vernacexpr.cmo lib/util.cmi kernel/term.cmi \ + proofs/tacmach.cmi proofs/tacexpr.cmo kernel/sign.cmi \ + pretyping/rawterm.cmi proofs/proof_type.cmi lib/pp.cmi \ + pretyping/pattern.cmi kernel/names.cmi kernel/mod_subst.cmi \ + library/libnames.cmi pretyping/evd.cmi kernel/environ.cmi \ + pretyping/clenv.cmi tactics/btermdn.cmi +tactics/autorewrite.cmi: kernel/term.cmi proofs/tacmach.cmi \ + proofs/tacexpr.cmo kernel/names.cmi +tactics/btermdn.cmi: kernel/term.cmi pretyping/pattern.cmi +tactics/contradiction.cmi: kernel/term.cmi pretyping/rawterm.cmi \ + proofs/proof_type.cmi kernel/names.cmi +tactics/dhyp.cmi: toplevel/vernacexpr.cmo interp/topconstr.cmi \ + proofs/tacmach.cmi proofs/tacexpr.cmo kernel/names.cmi +tactics/eauto.cmi: interp/topconstr.cmi kernel/term.cmi proofs/tacexpr.cmo \ + proofs/proof_type.cmi tactics/auto.cmi +tactics/elim.cmi: kernel/term.cmi tactics/tacticals.cmi proofs/tacmach.cmi \ + pretyping/rawterm.cmi proofs/proof_type.cmi kernel/names.cmi \ + interp/genarg.cmi +tactics/equality.cmi: kernel/term.cmi tactics/tactics.cmi \ + tactics/tacticals.cmi proofs/tacmach.cmi proofs/tacexpr.cmo \ + kernel/sign.cmi pretyping/rawterm.cmi proofs/proof_type.cmi \ + pretyping/pattern.cmi kernel/names.cmi tactics/hipattern.cmi \ + pretyping/evd.cmi kernel/environ.cmi +tactics/evar_tactics.cmi: kernel/term.cmi proofs/tacmach.cmi \ + proofs/tacexpr.cmo pretyping/rawterm.cmi kernel/names.cmi +tactics/extraargs.cmi: lib/util.cmi interp/topconstr.cmi kernel/term.cmi \ + proofs/tacexpr.cmo tactics/setoid_replace.cmi pretyping/rawterm.cmi \ + proofs/proof_type.cmi parsing/pcoq.cmi kernel/names.cmi +tactics/extratactics.cmi: interp/topconstr.cmi kernel/term.cmi \ + proofs/tacexpr.cmo pretyping/rawterm.cmi proofs/proof_type.cmi \ + parsing/pcoq.cmi kernel/names.cmi interp/genarg.cmi +tactics/hiddentac.cmi: kernel/term.cmi tactics/tacticals.cmi \ + proofs/tacmach.cmi proofs/tacexpr.cmo proofs/redexpr.cmi \ + pretyping/rawterm.cmi proofs/proof_type.cmi kernel/names.cmi \ + interp/genarg.cmi +tactics/hipattern.cmi: lib/util.cmi kernel/term.cmi proofs/tacmach.cmi \ + kernel/sign.cmi proofs/proof_type.cmi proofs/proof_trees.cmi \ + pretyping/pattern.cmi kernel/names.cmi pretyping/evd.cmi \ + interp/coqlib.cmi +tactics/inv.cmi: kernel/term.cmi proofs/tacmach.cmi proofs/tacexpr.cmo \ + pretyping/rawterm.cmi kernel/names.cmi interp/genarg.cmi +tactics/leminv.cmi: lib/util.cmi interp/topconstr.cmi kernel/term.cmi \ + pretyping/rawterm.cmi proofs/proof_type.cmi kernel/names.cmi +tactics/nbtermdn.cmi: kernel/term.cmi pretyping/pattern.cmi \ + library/libnames.cmi tactics/btermdn.cmi +tactics/refine.cmi: proofs/tacmach.cmi pretyping/evd.cmi +tactics/setoid_replace.cmi: interp/topconstr.cmi kernel/term.cmi \ + proofs/proof_type.cmi lib/pp.cmi kernel/names.cmi +tactics/tacinterp.cmi: lib/util.cmi interp/topconstr.cmi kernel/term.cmi \ + proofs/tactic_debug.cmi proofs/tacmach.cmi proofs/tacexpr.cmo \ + proofs/redexpr.cmi proofs/proof_type.cmi lib/pp.cmi library/nametab.cmi \ + kernel/names.cmi kernel/mod_subst.cmi library/libnames.cmi \ + interp/genarg.cmi pretyping/evd.cmi kernel/environ.cmi lib/dyn.cmi +tactics/tacticals.cmi: kernel/term.cmi proofs/tacmach.cmi proofs/tacexpr.cmo \ + kernel/sign.cmi kernel/reduction.cmi proofs/proof_type.cmi lib/pp.cmi \ + pretyping/pattern.cmi kernel/names.cmi interp/genarg.cmi \ + pretyping/clenv.cmi +tactics/tactics.cmi: interp/topconstr.cmi kernel/term.cmi \ + tactics/tacticals.cmi proofs/tacmach.cmi proofs/tacexpr.cmo \ + kernel/sign.cmi kernel/reduction.cmi proofs/redexpr.cmi \ + pretyping/rawterm.cmi proofs/proof_type.cmi library/nametab.cmi \ + kernel/names.cmi library/libnames.cmi interp/genarg.cmi pretyping/evd.cmi \ + proofs/evar_refiner.cmi kernel/environ.cmi pretyping/clenv.cmi +tactics/termdn.cmi: kernel/term.cmi pretyping/pattern.cmi \ + library/libnames.cmi +toplevel/cerrors.cmi: lib/util.cmi lib/pp.cmi +toplevel/class.cmi: kernel/term.cmi proofs/tacexpr.cmo library/nametab.cmi \ + kernel/names.cmi library/libnames.cmi library/declare.cmi \ + library/decl_kinds.cmo pretyping/classops.cmi +toplevel/command.cmi: toplevel/vernacexpr.cmo lib/util.cmi \ + interp/topconstr.cmi kernel/term.cmi proofs/tacexpr.cmo \ + proofs/redexpr.cmi pretyping/rawterm.cmi library/nametab.cmi \ + kernel/names.cmi library/library.cmi library/libnames.cmi \ + pretyping/evd.cmi kernel/environ.cmi kernel/entries.cmi \ + library/declare.cmi library/decl_kinds.cmo toplevel/coqinit.cmi: kernel/names.cmi -toplevel/discharge.cmi: kernel/cooking.cmi kernel/declarations.cmi \ - kernel/entries.cmi kernel/sign.cmi -toplevel/fhimsg.cmi: kernel/environ.cmi kernel/names.cmi lib/pp.cmi \ - kernel/sign.cmi kernel/term.cmi kernel/type_errors.cmi -toplevel/himsg.cmi: pretyping/cases.cmi kernel/environ.cmi \ - pretyping/indrec.cmi kernel/indtypes.cmi proofs/logic.cmi \ - kernel/names.cmi lib/pp.cmi pretyping/pretype_errors.cmi \ - pretyping/tacred.cmi kernel/type_errors.cmi -toplevel/metasyntax.cmi: pretyping/classops.cmi interp/constrintern.cmi \ - parsing/extend.cmi library/libnames.cmi interp/notation.cmi \ - interp/ppextend.cmi proofs/tacexpr.cmo interp/topconstr.cmi lib/util.cmi \ - toplevel/vernacexpr.cmo -toplevel/mltop.cmi: library/libobject.cmi kernel/names.cmi +toplevel/discharge.cmi: kernel/sign.cmi kernel/entries.cmi \ + kernel/declarations.cmi kernel/cooking.cmi +toplevel/fhimsg.cmi: kernel/type_errors.cmi kernel/term.cmi kernel/sign.cmi \ + lib/pp.cmi kernel/names.cmi kernel/environ.cmi +toplevel/himsg.cmi: kernel/type_errors.cmi pretyping/tacred.cmi \ + pretyping/pretype_errors.cmi lib/pp.cmi kernel/names.cmi proofs/logic.cmi \ + kernel/indtypes.cmi pretyping/indrec.cmi kernel/environ.cmi \ + pretyping/cases.cmi +toplevel/metasyntax.cmi: toplevel/vernacexpr.cmo lib/util.cmi \ + interp/topconstr.cmi proofs/tacexpr.cmo interp/ppextend.cmi \ + interp/notation.cmi library/libnames.cmi parsing/extend.cmi \ + interp/constrintern.cmi pretyping/classops.cmi +toplevel/mltop.cmi: kernel/names.cmi library/libobject.cmi toplevel/protectedtoplevel.cmi: lib/pp.cmi -toplevel/record.cmi: kernel/names.cmi kernel/sign.cmi kernel/term.cmi \ - interp/topconstr.cmi toplevel/vernacexpr.cmo -toplevel/searchisos.cmi: library/libobject.cmi kernel/names.cmi \ - kernel/term.cmi -toplevel/toplevel.cmi: parsing/pcoq.cmi lib/pp.cmi -toplevel/vernacentries.cmi: kernel/environ.cmi pretyping/evd.cmi \ - library/libnames.cmi kernel/names.cmi kernel/term.cmi \ - interp/topconstr.cmi toplevel/vernacexpr.cmo toplevel/vernacinterp.cmi +toplevel/record.cmi: toplevel/vernacexpr.cmo interp/topconstr.cmi \ + kernel/term.cmi kernel/sign.cmi kernel/names.cmi +toplevel/searchisos.cmi: kernel/term.cmi kernel/names.cmi \ + library/libobject.cmi +toplevel/toplevel.cmi: lib/pp.cmi parsing/pcoq.cmi +toplevel/vernacentries.cmi: toplevel/vernacinterp.cmi toplevel/vernacexpr.cmo \ + lib/util.cmi interp/topconstr.cmi kernel/term.cmi kernel/names.cmi \ + library/libnames.cmi pretyping/evd.cmi kernel/environ.cmi toplevel/vernacinterp.cmi: proofs/tacexpr.cmo -toplevel/vernac.cmi: parsing/pcoq.cmi lib/util.cmi toplevel/vernacexpr.cmo -toplevel/whelp.cmi: kernel/environ.cmi kernel/names.cmi kernel/term.cmi \ - interp/topconstr.cmi -contrib/cc/ccalgo.cmi: kernel/names.cmi lib/pp.cmi kernel/term.cmi \ - lib/util.cmi -contrib/cc/ccproof.cmi: contrib/cc/ccalgo.cmi kernel/names.cmi -contrib/cc/cctac.cmi: proofs/proof_type.cmi kernel/term.cmi -contrib/correctness/past.cmi: kernel/names.cmi kernel/term.cmi \ - interp/topconstr.cmi lib/util.cmi -contrib/correctness/pcicenv.cmi: kernel/names.cmi kernel/sign.cmi \ - kernel/term.cmi +toplevel/vernac.cmi: toplevel/vernacexpr.cmo lib/util.cmi parsing/pcoq.cmi +toplevel/whelp.cmi: interp/topconstr.cmi kernel/term.cmi kernel/names.cmi \ + kernel/environ.cmi +contrib/cc/ccalgo.cmi: lib/util.cmi kernel/term.cmi lib/pp.cmi \ + kernel/names.cmi +contrib/cc/ccproof.cmi: kernel/names.cmi contrib/cc/ccalgo.cmi +contrib/cc/cctac.cmi: kernel/term.cmi proofs/proof_type.cmi +contrib/correctness/past.cmi: lib/util.cmi interp/topconstr.cmi \ + kernel/term.cmi kernel/names.cmi +contrib/correctness/pcicenv.cmi: kernel/term.cmi kernel/sign.cmi \ + kernel/names.cmi contrib/correctness/pcic.cmi: pretyping/rawterm.cmi contrib/correctness/pdb.cmi: kernel/names.cmi -contrib/correctness/peffect.cmi: kernel/names.cmi lib/pp.cmi -contrib/correctness/penv.cmi: library/libnames.cmi kernel/names.cmi \ - kernel/term.cmi -contrib/correctness/perror.cmi: kernel/names.cmi lib/pp.cmi lib/util.cmi +contrib/correctness/peffect.cmi: lib/pp.cmi kernel/names.cmi +contrib/correctness/penv.cmi: kernel/term.cmi kernel/names.cmi \ + library/libnames.cmi +contrib/correctness/perror.cmi: lib/util.cmi lib/pp.cmi kernel/names.cmi contrib/correctness/pextract.cmi: kernel/names.cmi -contrib/correctness/pmisc.cmi: kernel/names.cmi lib/pp.cmi kernel/term.cmi \ - interp/topconstr.cmi lib/util.cmi +contrib/correctness/pmisc.cmi: lib/util.cmi interp/topconstr.cmi \ + kernel/term.cmi lib/pp.cmi kernel/names.cmi contrib/correctness/pmlize.cmi: kernel/names.cmi -contrib/correctness/pmonad.cmi: kernel/names.cmi kernel/term.cmi +contrib/correctness/pmonad.cmi: kernel/term.cmi kernel/names.cmi contrib/correctness/pred.cmi: kernel/term.cmi -contrib/correctness/prename.cmi: kernel/names.cmi lib/pp.cmi -contrib/correctness/psyntax.cmi: parsing/pcoq.cmi interp/topconstr.cmi +contrib/correctness/prename.cmi: lib/pp.cmi kernel/names.cmi +contrib/correctness/psyntax.cmi: interp/topconstr.cmi parsing/pcoq.cmi contrib/correctness/ptactic.cmi: proofs/tacmach.cmi -contrib/correctness/ptype.cmi: kernel/names.cmi kernel/term.cmi -contrib/correctness/ptyping.cmi: kernel/names.cmi kernel/term.cmi \ - interp/topconstr.cmi -contrib/correctness/putil.cmi: kernel/names.cmi lib/pp.cmi kernel/term.cmi +contrib/correctness/ptype.cmi: kernel/term.cmi kernel/names.cmi +contrib/correctness/ptyping.cmi: interp/topconstr.cmi kernel/term.cmi \ + kernel/names.cmi +contrib/correctness/putil.cmi: kernel/term.cmi lib/pp.cmi kernel/names.cmi contrib/correctness/pwp.cmi: kernel/term.cmi contrib/dp/dp_cvcl.cmi: contrib/dp/fol.cmi -contrib/dp/dp.cmi: library/libnames.cmi proofs/proof_type.cmi +contrib/dp/dp.cmi: proofs/proof_type.cmi library/libnames.cmi contrib/dp/dp_simplify.cmi: contrib/dp/fol.cmi contrib/dp/dp_sorts.cmi: contrib/dp/fol.cmi contrib/dp/dp_zenon.cmi: contrib/dp/fol.cmi -contrib/extraction/common.cmi: contrib/extraction/miniml.cmi \ - contrib/extraction/mlutil.cmi kernel/names.cmi -contrib/extraction/extract_env.cmi: library/libnames.cmi kernel/names.cmi -contrib/extraction/extraction.cmi: kernel/declarations.cmi kernel/environ.cmi \ - library/libnames.cmi contrib/extraction/miniml.cmi kernel/names.cmi \ - kernel/term.cmi -contrib/extraction/haskell.cmi: contrib/extraction/miniml.cmi \ - kernel/names.cmi lib/pp.cmi -contrib/extraction/miniml.cmi: library/libnames.cmi kernel/names.cmi \ - lib/pp.cmi lib/util.cmi -contrib/extraction/mlutil.cmi: library/libnames.cmi \ - contrib/extraction/miniml.cmi kernel/names.cmi kernel/term.cmi \ - lib/util.cmi -contrib/extraction/modutil.cmi: kernel/declarations.cmi kernel/environ.cmi \ - library/libnames.cmi contrib/extraction/miniml.cmi kernel/mod_subst.cmi \ - kernel/names.cmi -contrib/extraction/ocaml.cmi: library/libnames.cmi \ - contrib/extraction/miniml.cmi kernel/names.cmi lib/pp.cmi -contrib/extraction/scheme.cmi: contrib/extraction/miniml.cmi kernel/names.cmi \ - lib/pp.cmi -contrib/extraction/table.cmi: kernel/environ.cmi library/libnames.cmi \ - contrib/extraction/miniml.cmi kernel/names.cmi kernel/term.cmi -contrib/first-order/formula.cmi: kernel/closure.cmi library/libnames.cmi \ - kernel/names.cmi proofs/proof_type.cmi kernel/sign.cmi proofs/tacmach.cmi \ - kernel/term.cmi -contrib/first-order/ground.cmi: proofs/proof_type.cmi \ - contrib/first-order/sequent.cmi proofs/tacmach.cmi -contrib/first-order/instances.cmi: contrib/first-order/formula.cmi \ - library/libnames.cmi kernel/names.cmi contrib/first-order/rules.cmi \ - contrib/first-order/sequent.cmi proofs/tacmach.cmi kernel/term.cmi \ - contrib/first-order/unify.cmi -contrib/first-order/rules.cmi: library/libnames.cmi kernel/names.cmi \ - contrib/first-order/sequent.cmi proofs/tacmach.cmi kernel/term.cmi -contrib/first-order/sequent.cmi: tactics/auto.cmi \ - contrib/first-order/formula.cmi lib/heap.cmi library/libnames.cmi \ - kernel/names.cmi proofs/proof_type.cmi proofs/tacmach.cmi kernel/term.cmi \ - lib/util.cmi +contrib/extraction/common.cmi: kernel/names.cmi contrib/extraction/mlutil.cmi \ + contrib/extraction/miniml.cmi +contrib/extraction/extract_env.cmi: kernel/names.cmi library/libnames.cmi +contrib/extraction/extraction.cmi: kernel/term.cmi kernel/names.cmi \ + contrib/extraction/miniml.cmi library/libnames.cmi kernel/environ.cmi \ + kernel/declarations.cmi +contrib/extraction/haskell.cmi: lib/pp.cmi kernel/names.cmi \ + contrib/extraction/miniml.cmi +contrib/extraction/miniml.cmi: lib/util.cmi lib/pp.cmi kernel/names.cmi \ + library/libnames.cmi +contrib/extraction/mlutil.cmi: lib/util.cmi kernel/term.cmi kernel/names.cmi \ + contrib/extraction/miniml.cmi library/libnames.cmi +contrib/extraction/modutil.cmi: kernel/names.cmi kernel/mod_subst.cmi \ + contrib/extraction/miniml.cmi library/libnames.cmi kernel/environ.cmi \ + kernel/declarations.cmi +contrib/extraction/ocaml.cmi: lib/pp.cmi kernel/names.cmi \ + contrib/extraction/miniml.cmi library/libnames.cmi +contrib/extraction/scheme.cmi: lib/pp.cmi kernel/names.cmi \ + contrib/extraction/miniml.cmi +contrib/extraction/table.cmi: kernel/term.cmi kernel/names.cmi \ + contrib/extraction/miniml.cmi library/libnames.cmi kernel/environ.cmi +contrib/first-order/formula.cmi: kernel/term.cmi proofs/tacmach.cmi \ + kernel/sign.cmi proofs/proof_type.cmi kernel/names.cmi \ + library/libnames.cmi kernel/closure.cmi +contrib/first-order/ground.cmi: proofs/tacmach.cmi \ + contrib/first-order/sequent.cmi proofs/proof_type.cmi +contrib/first-order/instances.cmi: contrib/first-order/unify.cmi \ + kernel/term.cmi proofs/tacmach.cmi contrib/first-order/sequent.cmi \ + contrib/first-order/rules.cmi kernel/names.cmi library/libnames.cmi \ + contrib/first-order/formula.cmi +contrib/first-order/rules.cmi: kernel/term.cmi proofs/tacmach.cmi \ + contrib/first-order/sequent.cmi kernel/names.cmi library/libnames.cmi +contrib/first-order/sequent.cmi: lib/util.cmi kernel/term.cmi \ + proofs/tacmach.cmi proofs/proof_type.cmi kernel/names.cmi \ + library/libnames.cmi lib/heap.cmi contrib/first-order/formula.cmi \ + tactics/auto.cmi contrib/first-order/unify.cmi: kernel/term.cmi -contrib/funind/indfun_common.cmi: library/libnames.cmi kernel/names.cmi \ - lib/pp.cmi pretyping/rawterm.cmi kernel/term.cmi -contrib/funind/new_arg_principle.cmi: kernel/names.cmi pretyping/rawterm.cmi \ - proofs/tacmach.cmi kernel/term.cmi -contrib/funind/rawtermops.cmi: library/libnames.cmi kernel/names.cmi \ - pretyping/rawterm.cmi lib/util.cmi -contrib/funind/rawterm_to_relation.cmi: kernel/names.cmi \ - pretyping/rawterm.cmi interp/topconstr.cmi -contrib/funind/tacinvutils.cmi: interp/coqlib.cmi tactics/equality.cmi \ - pretyping/evd.cmi pretyping/inductiveops.cmi kernel/names.cmi lib/pp.cmi \ - parsing/printer.cmi proofs/proof_type.cmi pretyping/reductionops.cmi \ - tactics/refine.cmi tactics/tacinterp.cmi proofs/tacmach.cmi \ - tactics/tacticals.cmi tactics/tactics.cmi kernel/term.cmi \ - pretyping/termops.cmi lib/util.cmi -contrib/interface/blast.cmi: proofs/proof_type.cmi proofs/tacexpr.cmo -contrib/interface/dad.cmi: proofs/proof_type.cmi proofs/tacexpr.cmo \ - proofs/tacmach.cmi interp/topconstr.cmi -contrib/interface/debug_tac.cmi: pretyping/evd.cmi proofs/proof_type.cmi \ - proofs/tacexpr.cmo proofs/tacmach.cmi -contrib/interface/name_to_ast.cmi: library/libnames.cmi \ - toplevel/vernacexpr.cmo -contrib/interface/pbp.cmi: kernel/names.cmi proofs/proof_type.cmi \ - proofs/tacexpr.cmo -contrib/interface/showproof.cmi: contrib/interface/ascent.cmi \ - pretyping/clenv.cmi kernel/declarations.cmi kernel/environ.cmi \ - pretyping/evd.cmi kernel/inductive.cmi kernel/names.cmi proofs/pfedit.cmi \ - lib/pp.cmi parsing/printer.cmi proofs/proof_trees.cmi \ - proofs/proof_type.cmi kernel/reduction.cmi \ - contrib/interface/showproof_ct.cmo kernel/sign.cmi kernel/term.cmi \ - pretyping/typing.cmi lib/util.cmi toplevel/vernacinterp.cmi -contrib/interface/translate.cmi: contrib/interface/ascent.cmi \ - kernel/environ.cmi pretyping/evd.cmi proofs/proof_type.cmi \ - kernel/term.cmi +contrib/funind/functional_principles_proofs.cmi: kernel/term.cmi \ + proofs/tacmach.cmi kernel/names.cmi +contrib/funind/functional_principles_types.cmi: kernel/term.cmi \ + proofs/tacmach.cmi pretyping/rawterm.cmi kernel/names.cmi +contrib/funind/indfun_common.cmi: kernel/term.cmi pretyping/rawterm.cmi \ + lib/pp.cmi kernel/names.cmi library/libnames.cmi +contrib/funind/rawtermops.cmi: lib/util.cmi pretyping/rawterm.cmi \ + kernel/names.cmi library/libnames.cmi +contrib/funind/rawterm_to_relation.cmi: interp/topconstr.cmi \ + pretyping/rawterm.cmi kernel/names.cmi +contrib/funind/tacinvutils.cmi: lib/util.cmi pretyping/termops.cmi \ + kernel/term.cmi tactics/tactics.cmi tactics/tacticals.cmi \ + proofs/tacmach.cmi tactics/tacinterp.cmi tactics/refine.cmi \ + pretyping/reductionops.cmi proofs/proof_type.cmi parsing/printer.cmi \ + lib/pp.cmi kernel/names.cmi pretyping/inductiveops.cmi pretyping/evd.cmi \ + tactics/equality.cmi interp/coqlib.cmi +contrib/interface/blast.cmi: proofs/tacexpr.cmo proofs/proof_type.cmi +contrib/interface/dad.cmi: interp/topconstr.cmi proofs/tacmach.cmi \ + proofs/tacexpr.cmo proofs/proof_type.cmi +contrib/interface/debug_tac.cmi: proofs/tacmach.cmi proofs/tacexpr.cmo \ + proofs/proof_type.cmi pretyping/evd.cmi +contrib/interface/name_to_ast.cmi: toplevel/vernacexpr.cmo \ + library/libnames.cmi +contrib/interface/pbp.cmi: proofs/tacexpr.cmo proofs/proof_type.cmi \ + kernel/names.cmi +contrib/interface/showproof.cmi: toplevel/vernacinterp.cmi lib/util.cmi \ + pretyping/typing.cmi kernel/term.cmi kernel/sign.cmi \ + contrib/interface/showproof_ct.cmo kernel/reduction.cmi \ + proofs/proof_type.cmi proofs/proof_trees.cmi parsing/printer.cmi \ + lib/pp.cmi proofs/pfedit.cmi kernel/names.cmi kernel/inductive.cmi \ + pretyping/evd.cmi kernel/environ.cmi kernel/declarations.cmi \ + pretyping/clenv.cmi contrib/interface/ascent.cmi +contrib/interface/translate.cmi: kernel/term.cmi proofs/proof_type.cmi \ + pretyping/evd.cmi kernel/environ.cmi contrib/interface/ascent.cmi contrib/interface/vtp.cmi: contrib/interface/ascent.cmi -contrib/interface/xlate.cmi: contrib/interface/ascent.cmi kernel/names.cmi \ - proofs/tacexpr.cmo interp/topconstr.cmi toplevel/vernacexpr.cmo -contrib/jprover/jall.cmi: contrib/jprover/jlogic.cmi \ - contrib/jprover/jterm.cmi contrib/jprover/opname.cmi +contrib/interface/xlate.cmi: toplevel/vernacexpr.cmo interp/topconstr.cmi \ + proofs/tacexpr.cmo kernel/names.cmi contrib/interface/ascent.cmi +contrib/jprover/jall.cmi: contrib/jprover/opname.cmi \ + contrib/jprover/jterm.cmi contrib/jprover/jlogic.cmi contrib/jprover/jlogic.cmi: contrib/jprover/jterm.cmi contrib/jprover/jterm.cmi: contrib/jprover/opname.cmi -contrib/rtauto/refl_tauto.cmi: kernel/names.cmi \ - contrib/rtauto/proof_search.cmi proofs/proof_type.cmi proofs/tacmach.cmi \ - kernel/term.cmi -contrib/subtac/context.cmi: kernel/names.cmi kernel/term.cmi -contrib/subtac/eterm.cmi: pretyping/evd.cmi proofs/tacmach.cmi +contrib/rtauto/refl_tauto.cmi: kernel/term.cmi proofs/tacmach.cmi \ + proofs/proof_type.cmi contrib/rtauto/proof_search.cmi kernel/names.cmi +contrib/subtac/context.cmi: kernel/term.cmi kernel/names.cmi +contrib/subtac/eterm.cmi: kernel/term.cmi proofs/tacmach.cmi kernel/names.cmi \ + pretyping/evd.cmi contrib/subtac/subtac_coercion.cmi: pretyping/coercion.cmi -contrib/subtac/subtac_command.cmi: interp/constrintern.cmi kernel/environ.cmi \ - pretyping/evarutil.cmi pretyping/evd.cmi library/libnames.cmi \ - kernel/names.cmi lib/pp.cmi pretyping/pretyping.cmi pretyping/rawterm.cmi \ - kernel/term.cmi interp/topconstr.cmi lib/util.cmi toplevel/vernacexpr.cmo -contrib/subtac/subtac_errors.cmi: lib/pp.cmi lib/util.cmi -contrib/subtac/subtac_interp_fixpoint.cmi: library/libnames.cmi \ - kernel/names.cmi lib/pp.cmi pretyping/rawterm.cmi interp/topconstr.cmi \ - lib/util.cmi -contrib/subtac/subtac.cmi: kernel/names.cmi interp/topconstr.cmi lib/util.cmi \ - toplevel/vernacexpr.cmo -contrib/subtac/subtac_pretyping.cmi: kernel/environ.cmi pretyping/evd.cmi \ - library/global.cmi kernel/names.cmi pretyping/pretyping.cmi \ - kernel/sign.cmi kernel/term.cmi interp/topconstr.cmi -contrib/subtac/subtac_utils.cmi: interp/coqlib.cmi library/decl_kinds.cmo \ - kernel/environ.cmi pretyping/evd.cmi library/libnames.cmi lib/pp.cmi \ - pretyping/rawterm.cmi kernel/term.cmi interp/topconstr.cmi lib/util.cmi -contrib/xml/doubleTypeInference.cmi: contrib/xml/acic.cmo kernel/environ.cmi \ - pretyping/evd.cmi kernel/names.cmi kernel/term.cmi -contrib/xml/xmlcommand.cmi: contrib/xml/acic.cmo pretyping/evd.cmi \ - library/libnames.cmi contrib/xml/proof2aproof.cmo proofs/proof_type.cmi \ - kernel/term.cmi contrib/xml/xml.cmi +contrib/subtac/subtac_command.cmi: toplevel/vernacexpr.cmo \ + interp/topconstr.cmi kernel/term.cmi pretyping/pretyping.cmi lib/pp.cmi \ + kernel/names.cmi library/libnames.cmi pretyping/evd.cmi \ + kernel/environ.cmi interp/constrintern.cmi +contrib/subtac/subtac_errors.cmi: lib/util.cmi lib/pp.cmi +contrib/subtac/subtac_interp_fixpoint.cmi: lib/util.cmi interp/topconstr.cmi \ + lib/pp.cmi kernel/names.cmi library/libnames.cmi +contrib/subtac/subtac.cmi: toplevel/vernacexpr.cmo lib/util.cmi \ + interp/topconstr.cmi kernel/names.cmi +contrib/subtac/subtac_pretyping.cmi: interp/topconstr.cmi kernel/term.cmi \ + kernel/sign.cmi pretyping/pretyping.cmi kernel/names.cmi \ + library/global.cmi pretyping/evd.cmi kernel/environ.cmi +contrib/subtac/subtac_utils.cmi: lib/util.cmi interp/topconstr.cmi \ + kernel/term.cmi proofs/tacexpr.cmo pretyping/rawterm.cmi \ + proofs/proof_type.cmi lib/pp.cmi kernel/names.cmi library/libnames.cmi \ + pretyping/evd.cmi pretyping/evarutil.cmi kernel/environ.cmi \ + library/decl_kinds.cmo interp/coqlib.cmi +contrib/xml/doubleTypeInference.cmi: kernel/term.cmi kernel/names.cmi \ + pretyping/evd.cmi kernel/environ.cmi contrib/xml/acic.cmo +contrib/xml/xmlcommand.cmi: contrib/xml/xml.cmi kernel/term.cmi \ + proofs/proof_type.cmi contrib/xml/proof2aproof.cmo library/libnames.cmi \ + pretyping/evd.cmi contrib/xml/acic.cmo ide/utils/configwin.cmi: ide/utils/config_file.cmi tools/coqdoc/index.cmi: tools/coqdoc/cdglobals.cmo -tools/coqdoc/output.cmi: tools/coqdoc/cdglobals.cmo tools/coqdoc/index.cmi -tools/coqdoc/pretty.cmi: tools/coqdoc/cdglobals.cmo tools/coqdoc/index.cmi +tools/coqdoc/output.cmi: tools/coqdoc/index.cmi tools/coqdoc/cdglobals.cmo +tools/coqdoc/pretty.cmi: tools/coqdoc/index.cmi tools/coqdoc/cdglobals.cmo config/coq_config.cmo: config/coq_config.cmi config/coq_config.cmx: config/coq_config.cmi -dev/db_printers.cmo: kernel/names.cmi lib/pp.cmi -dev/db_printers.cmx: kernel/names.cmx lib/pp.cmx -dev/top_printers.cmo: lib/bigint.cmi toplevel/cerrors.cmi pretyping/clenv.cmi \ - kernel/closure.cmi interp/constrextern.cmi interp/constrintern.cmi \ - kernel/declarations.cmi parsing/egrammar.cmi kernel/environ.cmi \ - pretyping/evd.cmi interp/genarg.cmi library/global.cmi \ - library/goptions.cmi library/libnames.cmi library/libobject.cmi \ - proofs/logic.cmi library/nameops.cmi kernel/names.cmi parsing/pcoq.cmi \ - proofs/pfedit.cmi lib/pp.cmi parsing/pptactic.cmi parsing/printer.cmi \ - proofs/proof_trees.cmi proofs/refiner.cmi kernel/sign.cmi lib/system.cmi \ - parsing/tactic_printer.cmi kernel/term.cmi pretyping/termops.cmi \ - kernel/univ.cmi lib/util.cmi toplevel/vernacinterp.cmi -dev/top_printers.cmx: lib/bigint.cmx toplevel/cerrors.cmx pretyping/clenv.cmx \ - kernel/closure.cmx interp/constrextern.cmx interp/constrintern.cmx \ - kernel/declarations.cmx parsing/egrammar.cmx kernel/environ.cmx \ - pretyping/evd.cmx interp/genarg.cmx library/global.cmx \ - library/goptions.cmx library/libnames.cmx library/libobject.cmx \ - proofs/logic.cmx library/nameops.cmx kernel/names.cmx parsing/pcoq.cmx \ - proofs/pfedit.cmx lib/pp.cmx parsing/pptactic.cmx parsing/printer.cmx \ - proofs/proof_trees.cmx proofs/refiner.cmx kernel/sign.cmx lib/system.cmx \ - parsing/tactic_printer.cmx kernel/term.cmx pretyping/termops.cmx \ - kernel/univ.cmx lib/util.cmx toplevel/vernacinterp.cmx -dev/vm_printers.cmo: kernel/cbytecodes.cmi kernel/cemitcodes.cmi \ - kernel/names.cmi kernel/term.cmi kernel/vm.cmi -dev/vm_printers.cmx: kernel/cbytecodes.cmx kernel/cemitcodes.cmx \ - kernel/names.cmx kernel/term.cmx kernel/vm.cmx -ide/blaster_window.cmo: ide/coq.cmi ide/ideutils.cmi -ide/blaster_window.cmx: ide/coq.cmx ide/ideutils.cmx -ide/command_windows.cmo: ide/coq.cmi ide/coq_commands.cmo ide/ideutils.cmi \ +dev/db_printers.cmo: lib/pp.cmi kernel/names.cmi +dev/db_printers.cmx: lib/pp.cmx kernel/names.cmx +dev/top_printers.cmo: toplevel/vernacinterp.cmi lib/util.cmi kernel/univ.cmi \ + pretyping/termops.cmi kernel/term.cmi parsing/tactic_printer.cmi \ + lib/system.cmi kernel/sign.cmi proofs/refiner.cmi proofs/proof_trees.cmi \ + parsing/printer.cmi parsing/pptactic.cmi lib/pp.cmi proofs/pfedit.cmi \ + parsing/pcoq.cmi kernel/names.cmi library/nameops.cmi proofs/logic.cmi \ + library/libobject.cmi library/libnames.cmi library/goptions.cmi \ + library/global.cmi interp/genarg.cmi pretyping/evd.cmi kernel/environ.cmi \ + parsing/egrammar.cmi kernel/declarations.cmi interp/constrintern.cmi \ + interp/constrextern.cmi kernel/closure.cmi pretyping/clenv.cmi \ + toplevel/cerrors.cmi lib/bigint.cmi +dev/top_printers.cmx: toplevel/vernacinterp.cmx lib/util.cmx kernel/univ.cmx \ + pretyping/termops.cmx kernel/term.cmx parsing/tactic_printer.cmx \ + lib/system.cmx kernel/sign.cmx proofs/refiner.cmx proofs/proof_trees.cmx \ + parsing/printer.cmx parsing/pptactic.cmx lib/pp.cmx proofs/pfedit.cmx \ + parsing/pcoq.cmx kernel/names.cmx library/nameops.cmx proofs/logic.cmx \ + library/libobject.cmx library/libnames.cmx library/goptions.cmx \ + library/global.cmx interp/genarg.cmx pretyping/evd.cmx kernel/environ.cmx \ + parsing/egrammar.cmx kernel/declarations.cmx interp/constrintern.cmx \ + interp/constrextern.cmx kernel/closure.cmx pretyping/clenv.cmx \ + toplevel/cerrors.cmx lib/bigint.cmx +dev/vm_printers.cmo: kernel/vm.cmi kernel/term.cmi kernel/names.cmi \ + kernel/cemitcodes.cmi kernel/cbytecodes.cmi +dev/vm_printers.cmx: kernel/vm.cmx kernel/term.cmx kernel/names.cmx \ + kernel/cemitcodes.cmx kernel/cbytecodes.cmx +ide/blaster_window.cmo: ide/ideutils.cmi ide/coq.cmi +ide/blaster_window.cmx: ide/ideutils.cmx ide/coq.cmx +ide/command_windows.cmo: ide/ideutils.cmi ide/coq_commands.cmo ide/coq.cmi \ ide/command_windows.cmi -ide/command_windows.cmx: ide/coq.cmx ide/coq_commands.cmx ide/ideutils.cmx \ +ide/command_windows.cmx: ide/ideutils.cmx ide/coq_commands.cmx ide/coq.cmx \ ide/command_windows.cmi -ide/config_lexer.cmo: ide/config_parser.cmi lib/util.cmi -ide/config_lexer.cmx: ide/config_parser.cmx lib/util.cmx +ide/config_lexer.cmo: lib/util.cmi ide/config_parser.cmi +ide/config_lexer.cmx: lib/util.cmx ide/config_parser.cmx ide/config_parser.cmo: lib/util.cmi ide/config_parser.cmi ide/config_parser.cmx: lib/util.cmx ide/config_parser.cmi -ide/coqide.cmo: ide/blaster_window.cmo ide/command_windows.cmi ide/coq.cmi \ - ide/coq_commands.cmo ide/find_phrase.cmo ide/highlight.cmo \ - ide/ideutils.cmi proofs/pfedit.cmi ide/preferences.cmi lib/system.cmi \ - ide/undo.cmi lib/util.cmi toplevel/vernacexpr.cmo ide/coqide.cmi -ide/coqide.cmx: ide/blaster_window.cmx ide/command_windows.cmx ide/coq.cmx \ - ide/coq_commands.cmx ide/find_phrase.cmx ide/highlight.cmx \ - ide/ideutils.cmx proofs/pfedit.cmx ide/preferences.cmx lib/system.cmx \ - ide/undo.cmx lib/util.cmx toplevel/vernacexpr.cmx ide/coqide.cmi -ide/coq.cmo: toplevel/cerrors.cmi config/coq_config.cmi toplevel/coqtop.cmi \ - kernel/declarations.cmi kernel/environ.cmi pretyping/evarutil.cmi \ - pretyping/evd.cmi library/global.cmi tactics/hipattern.cmi \ - ide/ideutils.cmi library/lib.cmi library/libnames.cmi library/library.cmi \ - toplevel/mltop.cmi kernel/names.cmi library/nametab.cmi lib/options.cmi \ - parsing/pcoq.cmi proofs/pfedit.cmi lib/pp.cmi parsing/printer.cmi \ - pretyping/reductionops.cmi proofs/refiner.cmi library/states.cmi \ - tactics/tacinterp.cmi proofs/tacmach.cmi kernel/term.cmi \ - pretyping/termops.cmi lib/util.cmi toplevel/vernac.cmi \ - toplevel/vernacentries.cmi toplevel/vernacexpr.cmo ide/coq.cmi -ide/coq.cmx: toplevel/cerrors.cmx config/coq_config.cmx toplevel/coqtop.cmx \ - kernel/declarations.cmx kernel/environ.cmx pretyping/evarutil.cmx \ - pretyping/evd.cmx library/global.cmx tactics/hipattern.cmx \ - ide/ideutils.cmx library/lib.cmx library/libnames.cmx library/library.cmx \ - toplevel/mltop.cmx kernel/names.cmx library/nametab.cmx lib/options.cmx \ - parsing/pcoq.cmx proofs/pfedit.cmx lib/pp.cmx parsing/printer.cmx \ - pretyping/reductionops.cmx proofs/refiner.cmx library/states.cmx \ - tactics/tacinterp.cmx proofs/tacmach.cmx kernel/term.cmx \ - pretyping/termops.cmx lib/util.cmx toplevel/vernac.cmx \ - toplevel/vernacentries.cmx toplevel/vernacexpr.cmx ide/coq.cmi +ide/coqide.cmo: toplevel/vernacexpr.cmo lib/util.cmi ide/undo.cmi \ + lib/system.cmi ide/preferences.cmi lib/pp.cmi proofs/pfedit.cmi \ + ide/ideutils.cmi ide/highlight.cmo ide/find_phrase.cmo \ + ide/coq_commands.cmo ide/coq.cmi ide/command_windows.cmi \ + ide/blaster_window.cmo ide/coqide.cmi +ide/coqide.cmx: toplevel/vernacexpr.cmx lib/util.cmx ide/undo.cmx \ + lib/system.cmx ide/preferences.cmx lib/pp.cmx proofs/pfedit.cmx \ + ide/ideutils.cmx ide/highlight.cmx ide/find_phrase.cmx \ + ide/coq_commands.cmx ide/coq.cmx ide/command_windows.cmx \ + ide/blaster_window.cmx ide/coqide.cmi +ide/coq.cmo: toplevel/vernacexpr.cmo toplevel/vernacentries.cmi \ + toplevel/vernac.cmi lib/util.cmi pretyping/termops.cmi kernel/term.cmi \ + proofs/tacmach.cmi tactics/tacinterp.cmi lib/system.cmi \ + library/states.cmi proofs/refiner.cmi pretyping/reductionops.cmi \ + parsing/printer.cmi lib/pp.cmi proofs/pfedit.cmi parsing/pcoq.cmi \ + lib/options.cmi library/nametab.cmi kernel/names.cmi toplevel/mltop.cmi \ + library/library.cmi library/libnames.cmi library/lib.cmi ide/ideutils.cmi \ + tactics/hipattern.cmi library/global.cmi pretyping/evd.cmi \ + pretyping/evarutil.cmi kernel/environ.cmi kernel/declarations.cmi \ + toplevel/coqtop.cmi config/coq_config.cmi toplevel/cerrors.cmi \ + ide/coq.cmi +ide/coq.cmx: toplevel/vernacexpr.cmx toplevel/vernacentries.cmx \ + toplevel/vernac.cmx lib/util.cmx pretyping/termops.cmx kernel/term.cmx \ + proofs/tacmach.cmx tactics/tacinterp.cmx lib/system.cmx \ + library/states.cmx proofs/refiner.cmx pretyping/reductionops.cmx \ + parsing/printer.cmx lib/pp.cmx proofs/pfedit.cmx parsing/pcoq.cmx \ + lib/options.cmx library/nametab.cmx kernel/names.cmx toplevel/mltop.cmx \ + library/library.cmx library/libnames.cmx library/lib.cmx ide/ideutils.cmx \ + tactics/hipattern.cmx library/global.cmx pretyping/evd.cmx \ + pretyping/evarutil.cmx kernel/environ.cmx kernel/declarations.cmx \ + toplevel/coqtop.cmx config/coq_config.cmx toplevel/cerrors.cmx \ + ide/coq.cmi ide/coq_tactics.cmo: ide/coq_tactics.cmi ide/coq_tactics.cmx: ide/coq_tactics.cmi ide/find_phrase.cmo: ide/ideutils.cmi ide/find_phrase.cmx: ide/ideutils.cmx ide/highlight.cmo: ide/ideutils.cmi ide/highlight.cmx: ide/ideutils.cmx -ide/ideutils.cmo: config/coq_config.cmi lib/options.cmi lib/pp_control.cmi \ - ide/preferences.cmi lib/system.cmi ide/utf8_convert.cmo ide/ideutils.cmi -ide/ideutils.cmx: config/coq_config.cmx lib/options.cmx lib/pp_control.cmx \ - ide/preferences.cmx lib/system.cmx ide/utf8_convert.cmx ide/ideutils.cmi -ide/preferences.cmo: ide/config_lexer.cmo ide/utils/configwin.cmi \ - lib/options.cmi lib/system.cmi lib/util.cmi ide/preferences.cmi -ide/preferences.cmx: ide/config_lexer.cmx ide/utils/configwin.cmx \ - lib/options.cmx lib/system.cmx lib/util.cmx ide/preferences.cmi +ide/ideutils.cmo: ide/utf8_convert.cmo lib/system.cmi ide/preferences.cmi \ + lib/pp_control.cmi lib/options.cmi config/coq_config.cmi ide/ideutils.cmi +ide/ideutils.cmx: ide/utf8_convert.cmx lib/system.cmx ide/preferences.cmx \ + lib/pp_control.cmx lib/options.cmx config/coq_config.cmx ide/ideutils.cmi +ide/preferences.cmo: lib/util.cmi lib/system.cmi lib/options.cmi \ + ide/utils/configwin.cmi ide/config_lexer.cmo ide/preferences.cmi +ide/preferences.cmx: lib/util.cmx lib/system.cmx lib/options.cmx \ + ide/utils/configwin.cmx ide/config_lexer.cmx ide/preferences.cmi ide/undo.cmo: ide/ideutils.cmi ide/undo.cmi ide/undo.cmx: ide/ideutils.cmx ide/undo.cmi -interp/constrextern.cmo: lib/bigint.cmi pretyping/classops.cmi \ - kernel/declarations.cmi pretyping/detyping.cmi kernel/environ.cmi \ - pretyping/evd.cmi library/global.cmi library/impargs.cmi \ - kernel/inductive.cmi library/libnames.cmi library/nameops.cmi \ - kernel/names.cmi library/nametab.cmi interp/notation.cmi lib/options.cmi \ - pretyping/pattern.cmi lib/pp.cmi pretyping/rawterm.cmi \ - pretyping/recordops.cmi interp/reserve.cmi kernel/sign.cmi \ - kernel/term.cmi pretyping/termops.cmi interp/topconstr.cmi \ - kernel/univ.cmi lib/util.cmi interp/constrextern.cmi -interp/constrextern.cmx: lib/bigint.cmx pretyping/classops.cmx \ - kernel/declarations.cmx pretyping/detyping.cmx kernel/environ.cmx \ - pretyping/evd.cmx library/global.cmx library/impargs.cmx \ - kernel/inductive.cmx library/libnames.cmx library/nameops.cmx \ - kernel/names.cmx library/nametab.cmx interp/notation.cmx lib/options.cmx \ - pretyping/pattern.cmx lib/pp.cmx pretyping/rawterm.cmx \ - pretyping/recordops.cmx interp/reserve.cmx kernel/sign.cmx \ - kernel/term.cmx pretyping/termops.cmx interp/topconstr.cmx \ - kernel/univ.cmx lib/util.cmx interp/constrextern.cmi -interp/constrintern.cmo: lib/bigint.cmi pretyping/cases.cmi \ - kernel/declarations.cmi kernel/environ.cmi pretyping/evd.cmi \ - library/global.cmi library/impargs.cmi kernel/inductive.cmi \ - pretyping/inductiveops.cmi parsing/lexer.cmi library/lib.cmi \ - library/libnames.cmi library/nameops.cmi kernel/names.cmi \ - library/nametab.cmi interp/notation.cmi lib/options.cmi \ - pretyping/pattern.cmi lib/pp.cmi pretyping/pretype_errors.cmi \ - pretyping/pretyping.cmi pretyping/rawterm.cmi pretyping/recordops.cmi \ - interp/reserve.cmi kernel/sign.cmi interp/syntax_def.cmi kernel/term.cmi \ - pretyping/termops.cmi interp/topconstr.cmi lib/util.cmi \ - interp/constrintern.cmi -interp/constrintern.cmx: lib/bigint.cmx pretyping/cases.cmx \ - kernel/declarations.cmx kernel/environ.cmx pretyping/evd.cmx \ - library/global.cmx library/impargs.cmx kernel/inductive.cmx \ - pretyping/inductiveops.cmx parsing/lexer.cmx library/lib.cmx \ - library/libnames.cmx library/nameops.cmx kernel/names.cmx \ - library/nametab.cmx interp/notation.cmx lib/options.cmx \ - pretyping/pattern.cmx lib/pp.cmx pretyping/pretype_errors.cmx \ - pretyping/pretyping.cmx pretyping/rawterm.cmx pretyping/recordops.cmx \ - interp/reserve.cmx kernel/sign.cmx interp/syntax_def.cmx kernel/term.cmx \ - pretyping/termops.cmx interp/topconstr.cmx lib/util.cmx \ - interp/constrintern.cmi -interp/coqlib.cmo: library/libnames.cmi library/library.cmi kernel/names.cmi \ - library/nametab.cmi pretyping/pattern.cmi lib/pp.cmi kernel/term.cmi \ - lib/util.cmi interp/coqlib.cmi -interp/coqlib.cmx: library/libnames.cmx library/library.cmx kernel/names.cmx \ - library/nametab.cmx pretyping/pattern.cmx lib/pp.cmx kernel/term.cmx \ - lib/util.cmx interp/coqlib.cmi -interp/genarg.cmo: pretyping/evd.cmi library/nameops.cmi kernel/names.cmi \ - library/nametab.cmi lib/pp.cmi pretyping/rawterm.cmi kernel/term.cmi \ - interp/topconstr.cmi lib/util.cmi interp/genarg.cmi -interp/genarg.cmx: pretyping/evd.cmx library/nameops.cmx kernel/names.cmx \ - library/nametab.cmx lib/pp.cmx pretyping/rawterm.cmx kernel/term.cmx \ - interp/topconstr.cmx lib/util.cmx interp/genarg.cmi -interp/modintern.cmo: interp/constrintern.cmi kernel/entries.cmi \ - pretyping/evd.cmi library/libnames.cmi kernel/modops.cmi kernel/names.cmi \ - library/nametab.cmi lib/pp.cmi interp/topconstr.cmi lib/util.cmi \ - interp/modintern.cmi -interp/modintern.cmx: interp/constrintern.cmx kernel/entries.cmx \ - pretyping/evd.cmx library/libnames.cmx kernel/modops.cmx kernel/names.cmx \ - library/nametab.cmx lib/pp.cmx interp/topconstr.cmx lib/util.cmx \ - interp/modintern.cmi -interp/notation.cmo: lib/bigint.cmi pretyping/classops.cmi library/global.cmi \ - lib/gmap.cmi lib/gmapl.cmi library/lib.cmi library/libnames.cmi \ - library/libobject.cmi kernel/names.cmi library/nametab.cmi \ - lib/options.cmi lib/pp.cmi interp/ppextend.cmi pretyping/rawterm.cmi \ - pretyping/reductionops.cmi library/summary.cmi kernel/term.cmi \ - interp/topconstr.cmi lib/util.cmi interp/notation.cmi -interp/notation.cmx: lib/bigint.cmx pretyping/classops.cmx library/global.cmx \ - lib/gmap.cmx lib/gmapl.cmx library/lib.cmx library/libnames.cmx \ - library/libobject.cmx kernel/names.cmx library/nametab.cmx \ - lib/options.cmx lib/pp.cmx interp/ppextend.cmx pretyping/rawterm.cmx \ - pretyping/reductionops.cmx library/summary.cmx kernel/term.cmx \ - interp/topconstr.cmx lib/util.cmx interp/notation.cmi -interp/ppextend.cmo: kernel/names.cmi lib/pp.cmi lib/util.cmi \ +interp/constrextern.cmo: lib/util.cmi kernel/univ.cmi interp/topconstr.cmi \ + pretyping/termops.cmi kernel/term.cmi kernel/sign.cmi interp/reserve.cmi \ + pretyping/recordops.cmi pretyping/rawterm.cmi lib/pp.cmi \ + pretyping/pattern.cmi lib/options.cmi interp/notation.cmi \ + library/nametab.cmi kernel/names.cmi library/nameops.cmi \ + library/libnames.cmi kernel/inductive.cmi library/impargs.cmi \ + library/global.cmi pretyping/evd.cmi kernel/environ.cmi \ + pretyping/detyping.cmi kernel/declarations.cmi pretyping/classops.cmi \ + lib/bigint.cmi interp/constrextern.cmi +interp/constrextern.cmx: lib/util.cmx kernel/univ.cmx interp/topconstr.cmx \ + pretyping/termops.cmx kernel/term.cmx kernel/sign.cmx interp/reserve.cmx \ + pretyping/recordops.cmx pretyping/rawterm.cmx lib/pp.cmx \ + pretyping/pattern.cmx lib/options.cmx interp/notation.cmx \ + library/nametab.cmx kernel/names.cmx library/nameops.cmx \ + library/libnames.cmx kernel/inductive.cmx library/impargs.cmx \ + library/global.cmx pretyping/evd.cmx kernel/environ.cmx \ + pretyping/detyping.cmx kernel/declarations.cmx pretyping/classops.cmx \ + lib/bigint.cmx interp/constrextern.cmi +interp/constrintern.cmo: lib/util.cmi interp/topconstr.cmi \ + pretyping/termops.cmi kernel/term.cmi interp/syntax_def.cmi \ + kernel/sign.cmi interp/reserve.cmi pretyping/recordops.cmi \ + pretyping/rawterm.cmi pretyping/pretyping.cmi \ + pretyping/pretype_errors.cmi lib/pp.cmi pretyping/pattern.cmi \ + lib/options.cmi interp/notation.cmi library/nametab.cmi kernel/names.cmi \ + library/nameops.cmi library/libnames.cmi library/lib.cmi \ + parsing/lexer.cmi pretyping/inductiveops.cmi kernel/inductive.cmi \ + library/impargs.cmi library/global.cmi pretyping/evd.cmi \ + kernel/environ.cmi kernel/declarations.cmi pretyping/cases.cmi \ + lib/bigint.cmi interp/constrintern.cmi +interp/constrintern.cmx: lib/util.cmx interp/topconstr.cmx \ + pretyping/termops.cmx kernel/term.cmx interp/syntax_def.cmx \ + kernel/sign.cmx interp/reserve.cmx pretyping/recordops.cmx \ + pretyping/rawterm.cmx pretyping/pretyping.cmx \ + pretyping/pretype_errors.cmx lib/pp.cmx pretyping/pattern.cmx \ + lib/options.cmx interp/notation.cmx library/nametab.cmx kernel/names.cmx \ + library/nameops.cmx library/libnames.cmx library/lib.cmx \ + parsing/lexer.cmx pretyping/inductiveops.cmx kernel/inductive.cmx \ + library/impargs.cmx library/global.cmx pretyping/evd.cmx \ + kernel/environ.cmx kernel/declarations.cmx pretyping/cases.cmx \ + lib/bigint.cmx interp/constrintern.cmi +interp/coqlib.cmo: lib/util.cmi kernel/term.cmi lib/pp.cmi \ + pretyping/pattern.cmi library/nametab.cmi kernel/names.cmi \ + library/library.cmi library/libnames.cmi interp/coqlib.cmi +interp/coqlib.cmx: lib/util.cmx kernel/term.cmx lib/pp.cmx \ + pretyping/pattern.cmx library/nametab.cmx kernel/names.cmx \ + library/library.cmx library/libnames.cmx interp/coqlib.cmi +interp/genarg.cmo: lib/util.cmi interp/topconstr.cmi kernel/term.cmi \ + pretyping/rawterm.cmi lib/pp.cmi library/nametab.cmi kernel/names.cmi \ + library/nameops.cmi pretyping/evd.cmi interp/genarg.cmi +interp/genarg.cmx: lib/util.cmx interp/topconstr.cmx kernel/term.cmx \ + pretyping/rawterm.cmx lib/pp.cmx library/nametab.cmx kernel/names.cmx \ + library/nameops.cmx pretyping/evd.cmx interp/genarg.cmi +interp/modintern.cmo: lib/util.cmi interp/topconstr.cmi lib/pp.cmi \ + library/nametab.cmi kernel/names.cmi kernel/modops.cmi \ + library/libnames.cmi pretyping/evd.cmi kernel/entries.cmi \ + interp/constrintern.cmi interp/modintern.cmi +interp/modintern.cmx: lib/util.cmx interp/topconstr.cmx lib/pp.cmx \ + library/nametab.cmx kernel/names.cmx kernel/modops.cmx \ + library/libnames.cmx pretyping/evd.cmx kernel/entries.cmx \ + interp/constrintern.cmx interp/modintern.cmi +interp/notation.cmo: lib/util.cmi interp/topconstr.cmi kernel/term.cmi \ + library/summary.cmi pretyping/reductionops.cmi pretyping/rawterm.cmi \ + interp/ppextend.cmi lib/pp.cmi lib/options.cmi library/nametab.cmi \ + kernel/names.cmi library/libobject.cmi library/libnames.cmi \ + library/lib.cmi lib/gmapl.cmi lib/gmap.cmi library/global.cmi \ + pretyping/classops.cmi lib/bigint.cmi interp/notation.cmi +interp/notation.cmx: lib/util.cmx interp/topconstr.cmx kernel/term.cmx \ + library/summary.cmx pretyping/reductionops.cmx pretyping/rawterm.cmx \ + interp/ppextend.cmx lib/pp.cmx lib/options.cmx library/nametab.cmx \ + kernel/names.cmx library/libobject.cmx library/libnames.cmx \ + library/lib.cmx lib/gmapl.cmx lib/gmap.cmx library/global.cmx \ + pretyping/classops.cmx lib/bigint.cmx interp/notation.cmi +interp/ppextend.cmo: lib/util.cmi lib/pp.cmi kernel/names.cmi \ interp/ppextend.cmi -interp/ppextend.cmx: kernel/names.cmx lib/pp.cmx lib/util.cmx \ +interp/ppextend.cmx: lib/util.cmx lib/pp.cmx kernel/names.cmx \ interp/ppextend.cmi -interp/reserve.cmo: pretyping/evd.cmi library/lib.cmi library/libobject.cmi \ - library/nameops.cmi kernel/names.cmi lib/pp.cmi pretyping/rawterm.cmi \ - library/summary.cmi lib/util.cmi interp/reserve.cmi -interp/reserve.cmx: pretyping/evd.cmx library/lib.cmx library/libobject.cmx \ - library/nameops.cmx kernel/names.cmx lib/pp.cmx pretyping/rawterm.cmx \ - library/summary.cmx lib/util.cmx interp/reserve.cmi -interp/syntax_def.cmo: library/lib.cmi library/libnames.cmi \ - library/libobject.cmi library/nameops.cmi kernel/names.cmi \ - library/nametab.cmi interp/notation.cmi lib/pp.cmi pretyping/rawterm.cmi \ - library/summary.cmi interp/topconstr.cmi lib/util.cmi \ - interp/syntax_def.cmi -interp/syntax_def.cmx: library/lib.cmx library/libnames.cmx \ - library/libobject.cmx library/nameops.cmx kernel/names.cmx \ - library/nametab.cmx interp/notation.cmx lib/pp.cmx pretyping/rawterm.cmx \ - library/summary.cmx interp/topconstr.cmx lib/util.cmx \ - interp/syntax_def.cmi -interp/topconstr.cmo: lib/bigint.cmi pretyping/detyping.cmi lib/dyn.cmi \ - pretyping/evd.cmi library/libnames.cmi kernel/mod_subst.cmi \ - library/nameops.cmi kernel/names.cmi lib/pp.cmi pretyping/rawterm.cmi \ - kernel/term.cmi lib/util.cmi interp/topconstr.cmi -interp/topconstr.cmx: lib/bigint.cmx pretyping/detyping.cmx lib/dyn.cmx \ - pretyping/evd.cmx library/libnames.cmx kernel/mod_subst.cmx \ - library/nameops.cmx kernel/names.cmx lib/pp.cmx pretyping/rawterm.cmx \ - kernel/term.cmx lib/util.cmx interp/topconstr.cmi -kernel/cbytecodes.cmo: kernel/names.cmi kernel/term.cmi kernel/cbytecodes.cmi -kernel/cbytecodes.cmx: kernel/names.cmx kernel/term.cmx kernel/cbytecodes.cmi -kernel/cbytegen.cmo: kernel/cbytecodes.cmi kernel/cemitcodes.cmi \ - kernel/declarations.cmi kernel/names.cmi kernel/pre_env.cmi \ - kernel/term.cmi lib/util.cmi kernel/cbytegen.cmi -kernel/cbytegen.cmx: kernel/cbytecodes.cmx kernel/cemitcodes.cmx \ - kernel/declarations.cmx kernel/names.cmx kernel/pre_env.cmx \ - kernel/term.cmx lib/util.cmx kernel/cbytegen.cmi -kernel/cemitcodes.cmo: kernel/cbytecodes.cmi kernel/copcodes.cmo \ - kernel/mod_subst.cmi kernel/names.cmi kernel/term.cmi \ - kernel/cemitcodes.cmi -kernel/cemitcodes.cmx: kernel/cbytecodes.cmx kernel/copcodes.cmx \ - kernel/mod_subst.cmx kernel/names.cmx kernel/term.cmx \ - kernel/cemitcodes.cmi -kernel/closure.cmo: kernel/declarations.cmi kernel/environ.cmi \ - kernel/esubst.cmi kernel/names.cmi lib/pp.cmi kernel/sign.cmi \ - kernel/term.cmi lib/util.cmi kernel/closure.cmi -kernel/closure.cmx: kernel/declarations.cmx kernel/environ.cmx \ - kernel/esubst.cmx kernel/names.cmx lib/pp.cmx kernel/sign.cmx \ - kernel/term.cmx lib/util.cmx kernel/closure.cmi +interp/reserve.cmo: lib/util.cmi library/summary.cmi pretyping/rawterm.cmi \ + lib/pp.cmi kernel/names.cmi library/nameops.cmi library/libobject.cmi \ + library/lib.cmi pretyping/evd.cmi interp/reserve.cmi +interp/reserve.cmx: lib/util.cmx library/summary.cmx pretyping/rawterm.cmx \ + lib/pp.cmx kernel/names.cmx library/nameops.cmx library/libobject.cmx \ + library/lib.cmx pretyping/evd.cmx interp/reserve.cmi +interp/syntax_def.cmo: lib/util.cmi interp/topconstr.cmi library/summary.cmi \ + pretyping/rawterm.cmi lib/pp.cmi interp/notation.cmi library/nametab.cmi \ + kernel/names.cmi library/nameops.cmi library/libobject.cmi \ + library/libnames.cmi library/lib.cmi interp/syntax_def.cmi +interp/syntax_def.cmx: lib/util.cmx interp/topconstr.cmx library/summary.cmx \ + pretyping/rawterm.cmx lib/pp.cmx interp/notation.cmx library/nametab.cmx \ + kernel/names.cmx library/nameops.cmx library/libobject.cmx \ + library/libnames.cmx library/lib.cmx interp/syntax_def.cmi +interp/topconstr.cmo: lib/util.cmi kernel/term.cmi pretyping/rawterm.cmi \ + lib/pp.cmi kernel/names.cmi library/nameops.cmi kernel/mod_subst.cmi \ + library/libnames.cmi pretyping/evd.cmi lib/dyn.cmi pretyping/detyping.cmi \ + lib/bigint.cmi interp/topconstr.cmi +interp/topconstr.cmx: lib/util.cmx kernel/term.cmx pretyping/rawterm.cmx \ + lib/pp.cmx kernel/names.cmx library/nameops.cmx kernel/mod_subst.cmx \ + library/libnames.cmx pretyping/evd.cmx lib/dyn.cmx pretyping/detyping.cmx \ + lib/bigint.cmx interp/topconstr.cmi +kernel/cbytecodes.cmo: kernel/term.cmi kernel/names.cmi kernel/cbytecodes.cmi +kernel/cbytecodes.cmx: kernel/term.cmx kernel/names.cmx kernel/cbytecodes.cmi +kernel/cbytegen.cmo: lib/util.cmi kernel/term.cmi kernel/pre_env.cmi \ + kernel/names.cmi kernel/declarations.cmi kernel/cemitcodes.cmi \ + kernel/cbytecodes.cmi kernel/cbytegen.cmi +kernel/cbytegen.cmx: lib/util.cmx kernel/term.cmx kernel/pre_env.cmx \ + kernel/names.cmx kernel/declarations.cmx kernel/cemitcodes.cmx \ + kernel/cbytecodes.cmx kernel/cbytegen.cmi +kernel/cemitcodes.cmo: kernel/term.cmi kernel/names.cmi kernel/mod_subst.cmi \ + kernel/copcodes.cmo kernel/cbytecodes.cmi kernel/cemitcodes.cmi +kernel/cemitcodes.cmx: kernel/term.cmx kernel/names.cmx kernel/mod_subst.cmx \ + kernel/copcodes.cmx kernel/cbytecodes.cmx kernel/cemitcodes.cmi +kernel/closure.cmo: lib/util.cmi kernel/term.cmi kernel/sign.cmi lib/pp.cmi \ + kernel/names.cmi kernel/esubst.cmi kernel/environ.cmi \ + kernel/declarations.cmi kernel/closure.cmi +kernel/closure.cmx: lib/util.cmx kernel/term.cmx kernel/sign.cmx lib/pp.cmx \ + kernel/names.cmx kernel/esubst.cmx kernel/environ.cmx \ + kernel/declarations.cmx kernel/closure.cmi kernel/conv_oracle.cmo: kernel/names.cmi kernel/conv_oracle.cmi kernel/conv_oracle.cmx: kernel/names.cmx kernel/conv_oracle.cmi -kernel/cooking.cmo: kernel/cemitcodes.cmi kernel/declarations.cmi \ - kernel/environ.cmi kernel/names.cmi lib/pp.cmi kernel/reduction.cmi \ - kernel/sign.cmi kernel/term.cmi lib/util.cmi kernel/cooking.cmi -kernel/cooking.cmx: kernel/cemitcodes.cmx kernel/declarations.cmx \ - kernel/environ.cmx kernel/names.cmx lib/pp.cmx kernel/reduction.cmx \ - kernel/sign.cmx kernel/term.cmx lib/util.cmx kernel/cooking.cmi -kernel/csymtable.cmo: kernel/cbytecodes.cmi kernel/cbytegen.cmi \ - kernel/cemitcodes.cmi kernel/declarations.cmi kernel/names.cmi \ - kernel/pre_env.cmi kernel/term.cmi kernel/vm.cmi kernel/csymtable.cmi -kernel/csymtable.cmx: kernel/cbytecodes.cmx kernel/cbytegen.cmx \ - kernel/cemitcodes.cmx kernel/declarations.cmx kernel/names.cmx \ - kernel/pre_env.cmx kernel/term.cmx kernel/vm.cmx kernel/csymtable.cmi -kernel/declarations.cmo: kernel/cbytecodes.cmi kernel/cemitcodes.cmi \ - kernel/mod_subst.cmi kernel/names.cmi lib/rtree.cmi kernel/sign.cmi \ - kernel/term.cmi kernel/univ.cmi lib/util.cmi kernel/declarations.cmi -kernel/declarations.cmx: kernel/cbytecodes.cmx kernel/cemitcodes.cmx \ - kernel/mod_subst.cmx kernel/names.cmx lib/rtree.cmx kernel/sign.cmx \ - kernel/term.cmx kernel/univ.cmx lib/util.cmx kernel/declarations.cmi -kernel/entries.cmo: kernel/names.cmi kernel/sign.cmi kernel/term.cmi \ - kernel/univ.cmi kernel/entries.cmi -kernel/entries.cmx: kernel/names.cmx kernel/sign.cmx kernel/term.cmx \ - kernel/univ.cmx kernel/entries.cmi -kernel/environ.cmo: kernel/cbytegen.cmi kernel/csymtable.cmi \ - kernel/declarations.cmi kernel/names.cmi kernel/pre_env.cmi \ - kernel/sign.cmi kernel/term.cmi kernel/univ.cmi lib/util.cmi \ +kernel/cooking.cmo: lib/util.cmi kernel/term.cmi kernel/sign.cmi \ + kernel/reduction.cmi lib/pp.cmi kernel/names.cmi kernel/environ.cmi \ + kernel/declarations.cmi kernel/cemitcodes.cmi kernel/cooking.cmi +kernel/cooking.cmx: lib/util.cmx kernel/term.cmx kernel/sign.cmx \ + kernel/reduction.cmx lib/pp.cmx kernel/names.cmx kernel/environ.cmx \ + kernel/declarations.cmx kernel/cemitcodes.cmx kernel/cooking.cmi +kernel/csymtable.cmo: kernel/vm.cmi kernel/term.cmi kernel/pre_env.cmi \ + kernel/names.cmi kernel/declarations.cmi kernel/cemitcodes.cmi \ + kernel/cbytegen.cmi kernel/cbytecodes.cmi kernel/csymtable.cmi +kernel/csymtable.cmx: kernel/vm.cmx kernel/term.cmx kernel/pre_env.cmx \ + kernel/names.cmx kernel/declarations.cmx kernel/cemitcodes.cmx \ + kernel/cbytegen.cmx kernel/cbytecodes.cmx kernel/csymtable.cmi +kernel/declarations.cmo: lib/util.cmi kernel/univ.cmi kernel/term.cmi \ + kernel/sign.cmi lib/rtree.cmi kernel/names.cmi kernel/mod_subst.cmi \ + kernel/cemitcodes.cmi kernel/cbytecodes.cmi kernel/declarations.cmi +kernel/declarations.cmx: lib/util.cmx kernel/univ.cmx kernel/term.cmx \ + kernel/sign.cmx lib/rtree.cmx kernel/names.cmx kernel/mod_subst.cmx \ + kernel/cemitcodes.cmx kernel/cbytecodes.cmx kernel/declarations.cmi +kernel/entries.cmo: kernel/univ.cmi kernel/term.cmi kernel/sign.cmi \ + kernel/names.cmi kernel/entries.cmi +kernel/entries.cmx: kernel/univ.cmx kernel/term.cmx kernel/sign.cmx \ + kernel/names.cmx kernel/entries.cmi +kernel/environ.cmo: lib/util.cmi kernel/univ.cmi kernel/term.cmi \ + kernel/sign.cmi kernel/pre_env.cmi kernel/names.cmi \ + kernel/declarations.cmi kernel/csymtable.cmi kernel/cbytegen.cmi \ kernel/environ.cmi -kernel/environ.cmx: kernel/cbytegen.cmx kernel/csymtable.cmx \ - kernel/declarations.cmx kernel/names.cmx kernel/pre_env.cmx \ - kernel/sign.cmx kernel/term.cmx kernel/univ.cmx lib/util.cmx \ +kernel/environ.cmx: lib/util.cmx kernel/univ.cmx kernel/term.cmx \ + kernel/sign.cmx kernel/pre_env.cmx kernel/names.cmx \ + kernel/declarations.cmx kernel/csymtable.cmx kernel/cbytegen.cmx \ kernel/environ.cmi kernel/esubst.cmo: lib/util.cmi kernel/esubst.cmi kernel/esubst.cmx: lib/util.cmx kernel/esubst.cmi -kernel/indtypes.cmo: kernel/declarations.cmi kernel/entries.cmi \ - kernel/environ.cmi kernel/inductive.cmi kernel/names.cmi \ - kernel/reduction.cmi lib/rtree.cmi kernel/sign.cmi kernel/term.cmi \ - kernel/typeops.cmi kernel/univ.cmi lib/util.cmi kernel/indtypes.cmi -kernel/indtypes.cmx: kernel/declarations.cmx kernel/entries.cmx \ - kernel/environ.cmx kernel/inductive.cmx kernel/names.cmx \ - kernel/reduction.cmx lib/rtree.cmx kernel/sign.cmx kernel/term.cmx \ - kernel/typeops.cmx kernel/univ.cmx lib/util.cmx kernel/indtypes.cmi -kernel/inductive.cmo: kernel/declarations.cmi kernel/environ.cmi \ - kernel/names.cmi kernel/reduction.cmi kernel/sign.cmi kernel/term.cmi \ - kernel/type_errors.cmi kernel/univ.cmi lib/util.cmi kernel/inductive.cmi -kernel/inductive.cmx: kernel/declarations.cmx kernel/environ.cmx \ - kernel/names.cmx kernel/reduction.cmx kernel/sign.cmx kernel/term.cmx \ - kernel/type_errors.cmx kernel/univ.cmx lib/util.cmx kernel/inductive.cmi -kernel/modops.cmo: kernel/cemitcodes.cmi kernel/declarations.cmi \ - kernel/entries.cmi kernel/environ.cmi kernel/mod_subst.cmi \ - kernel/names.cmi lib/pp.cmi kernel/term.cmi kernel/univ.cmi lib/util.cmi \ +kernel/indtypes.cmo: lib/util.cmi kernel/univ.cmi kernel/typeops.cmi \ + kernel/term.cmi kernel/sign.cmi lib/rtree.cmi kernel/reduction.cmi \ + kernel/names.cmi kernel/inductive.cmi kernel/environ.cmi \ + kernel/entries.cmi kernel/declarations.cmi kernel/indtypes.cmi +kernel/indtypes.cmx: lib/util.cmx kernel/univ.cmx kernel/typeops.cmx \ + kernel/term.cmx kernel/sign.cmx lib/rtree.cmx kernel/reduction.cmx \ + kernel/names.cmx kernel/inductive.cmx kernel/environ.cmx \ + kernel/entries.cmx kernel/declarations.cmx kernel/indtypes.cmi +kernel/inductive.cmo: lib/util.cmi kernel/univ.cmi kernel/type_errors.cmi \ + kernel/term.cmi kernel/sign.cmi kernel/reduction.cmi kernel/names.cmi \ + kernel/environ.cmi kernel/declarations.cmi kernel/inductive.cmi +kernel/inductive.cmx: lib/util.cmx kernel/univ.cmx kernel/type_errors.cmx \ + kernel/term.cmx kernel/sign.cmx kernel/reduction.cmx kernel/names.cmx \ + kernel/environ.cmx kernel/declarations.cmx kernel/inductive.cmi +kernel/modops.cmo: lib/util.cmi kernel/univ.cmi kernel/term.cmi lib/pp.cmi \ + kernel/names.cmi kernel/mod_subst.cmi kernel/environ.cmi \ + kernel/entries.cmi kernel/declarations.cmi kernel/cemitcodes.cmi \ kernel/modops.cmi -kernel/modops.cmx: kernel/cemitcodes.cmx kernel/declarations.cmx \ - kernel/entries.cmx kernel/environ.cmx kernel/mod_subst.cmx \ - kernel/names.cmx lib/pp.cmx kernel/term.cmx kernel/univ.cmx lib/util.cmx \ +kernel/modops.cmx: lib/util.cmx kernel/univ.cmx kernel/term.cmx lib/pp.cmx \ + kernel/names.cmx kernel/mod_subst.cmx kernel/environ.cmx \ + kernel/entries.cmx kernel/declarations.cmx kernel/cemitcodes.cmx \ kernel/modops.cmi -kernel/mod_subst.cmo: kernel/names.cmi lib/pp.cmi kernel/term.cmi \ - lib/util.cmi kernel/mod_subst.cmi -kernel/mod_subst.cmx: kernel/names.cmx lib/pp.cmx kernel/term.cmx \ - lib/util.cmx kernel/mod_subst.cmi -kernel/mod_typing.cmo: kernel/cemitcodes.cmi kernel/declarations.cmi \ - kernel/entries.cmi kernel/environ.cmi kernel/mod_subst.cmi \ - kernel/modops.cmi kernel/names.cmi kernel/reduction.cmi \ - kernel/subtyping.cmi kernel/term_typing.cmi kernel/typeops.cmi \ - kernel/univ.cmi lib/util.cmi kernel/mod_typing.cmi -kernel/mod_typing.cmx: kernel/cemitcodes.cmx kernel/declarations.cmx \ - kernel/entries.cmx kernel/environ.cmx kernel/mod_subst.cmx \ - kernel/modops.cmx kernel/names.cmx kernel/reduction.cmx \ - kernel/subtyping.cmx kernel/term_typing.cmx kernel/typeops.cmx \ - kernel/univ.cmx lib/util.cmx kernel/mod_typing.cmi -kernel/names.cmo: lib/hashcons.cmi lib/pp.cmi lib/predicate.cmi lib/util.cmi \ +kernel/mod_subst.cmo: lib/util.cmi kernel/term.cmi lib/pp.cmi \ + kernel/names.cmi kernel/mod_subst.cmi +kernel/mod_subst.cmx: lib/util.cmx kernel/term.cmx lib/pp.cmx \ + kernel/names.cmx kernel/mod_subst.cmi +kernel/mod_typing.cmo: lib/util.cmi kernel/univ.cmi kernel/typeops.cmi \ + kernel/term_typing.cmi kernel/subtyping.cmi kernel/reduction.cmi \ + kernel/names.cmi kernel/modops.cmi kernel/mod_subst.cmi \ + kernel/environ.cmi kernel/entries.cmi kernel/declarations.cmi \ + kernel/cemitcodes.cmi kernel/mod_typing.cmi +kernel/mod_typing.cmx: lib/util.cmx kernel/univ.cmx kernel/typeops.cmx \ + kernel/term_typing.cmx kernel/subtyping.cmx kernel/reduction.cmx \ + kernel/names.cmx kernel/modops.cmx kernel/mod_subst.cmx \ + kernel/environ.cmx kernel/entries.cmx kernel/declarations.cmx \ + kernel/cemitcodes.cmx kernel/mod_typing.cmi +kernel/names.cmo: lib/util.cmi lib/predicate.cmi lib/pp.cmi lib/hashcons.cmi \ kernel/names.cmi -kernel/names.cmx: lib/hashcons.cmx lib/pp.cmx lib/predicate.cmx lib/util.cmx \ +kernel/names.cmx: lib/util.cmx lib/predicate.cmx lib/pp.cmx lib/hashcons.cmx \ kernel/names.cmi -kernel/pre_env.cmo: kernel/declarations.cmi kernel/names.cmi kernel/sign.cmi \ - kernel/term.cmi kernel/univ.cmi lib/util.cmi kernel/pre_env.cmi -kernel/pre_env.cmx: kernel/declarations.cmx kernel/names.cmx kernel/sign.cmx \ - kernel/term.cmx kernel/univ.cmx lib/util.cmx kernel/pre_env.cmi -kernel/reduction.cmo: kernel/closure.cmi kernel/conv_oracle.cmi \ - kernel/declarations.cmi kernel/environ.cmi kernel/esubst.cmi \ - kernel/names.cmi kernel/sign.cmi kernel/term.cmi kernel/univ.cmi \ - lib/util.cmi kernel/reduction.cmi -kernel/reduction.cmx: kernel/closure.cmx kernel/conv_oracle.cmx \ - kernel/declarations.cmx kernel/environ.cmx kernel/esubst.cmx \ - kernel/names.cmx kernel/sign.cmx kernel/term.cmx kernel/univ.cmx \ - lib/util.cmx kernel/reduction.cmi -kernel/safe_typing.cmo: kernel/cooking.cmi kernel/declarations.cmi \ - kernel/entries.cmi kernel/environ.cmi kernel/indtypes.cmi \ - kernel/inductive.cmi kernel/mod_typing.cmi kernel/modops.cmi \ - kernel/names.cmi kernel/reduction.cmi kernel/sign.cmi \ - kernel/subtyping.cmi kernel/term.cmi kernel/term_typing.cmi \ - kernel/type_errors.cmi kernel/typeops.cmi kernel/univ.cmi lib/util.cmi \ +kernel/pre_env.cmo: lib/util.cmi kernel/univ.cmi kernel/term.cmi \ + kernel/sign.cmi kernel/names.cmi kernel/declarations.cmi \ + kernel/pre_env.cmi +kernel/pre_env.cmx: lib/util.cmx kernel/univ.cmx kernel/term.cmx \ + kernel/sign.cmx kernel/names.cmx kernel/declarations.cmx \ + kernel/pre_env.cmi +kernel/reduction.cmo: lib/util.cmi kernel/univ.cmi kernel/term.cmi \ + kernel/sign.cmi kernel/names.cmi kernel/esubst.cmi kernel/environ.cmi \ + kernel/declarations.cmi kernel/conv_oracle.cmi kernel/closure.cmi \ + kernel/reduction.cmi +kernel/reduction.cmx: lib/util.cmx kernel/univ.cmx kernel/term.cmx \ + kernel/sign.cmx kernel/names.cmx kernel/esubst.cmx kernel/environ.cmx \ + kernel/declarations.cmx kernel/conv_oracle.cmx kernel/closure.cmx \ + kernel/reduction.cmi +kernel/safe_typing.cmo: lib/util.cmi kernel/univ.cmi kernel/typeops.cmi \ + kernel/type_errors.cmi kernel/term_typing.cmi kernel/term.cmi \ + kernel/subtyping.cmi kernel/sign.cmi kernel/reduction.cmi \ + kernel/names.cmi kernel/modops.cmi kernel/mod_typing.cmi \ + kernel/inductive.cmi kernel/indtypes.cmi kernel/environ.cmi \ + kernel/entries.cmi kernel/declarations.cmi kernel/cooking.cmi \ kernel/safe_typing.cmi -kernel/safe_typing.cmx: kernel/cooking.cmx kernel/declarations.cmx \ - kernel/entries.cmx kernel/environ.cmx kernel/indtypes.cmx \ - kernel/inductive.cmx kernel/mod_typing.cmx kernel/modops.cmx \ - kernel/names.cmx kernel/reduction.cmx kernel/sign.cmx \ - kernel/subtyping.cmx kernel/term.cmx kernel/term_typing.cmx \ - kernel/type_errors.cmx kernel/typeops.cmx kernel/univ.cmx lib/util.cmx \ +kernel/safe_typing.cmx: lib/util.cmx kernel/univ.cmx kernel/typeops.cmx \ + kernel/type_errors.cmx kernel/term_typing.cmx kernel/term.cmx \ + kernel/subtyping.cmx kernel/sign.cmx kernel/reduction.cmx \ + kernel/names.cmx kernel/modops.cmx kernel/mod_typing.cmx \ + kernel/inductive.cmx kernel/indtypes.cmx kernel/environ.cmx \ + kernel/entries.cmx kernel/declarations.cmx kernel/cooking.cmx \ kernel/safe_typing.cmi -kernel/sign.cmo: kernel/names.cmi kernel/term.cmi lib/util.cmi \ +kernel/sign.cmo: lib/util.cmi kernel/term.cmi kernel/names.cmi \ kernel/sign.cmi -kernel/sign.cmx: kernel/names.cmx kernel/term.cmx lib/util.cmx \ +kernel/sign.cmx: lib/util.cmx kernel/term.cmx kernel/names.cmx \ kernel/sign.cmi -kernel/subtyping.cmo: kernel/declarations.cmi kernel/entries.cmi \ - kernel/environ.cmi kernel/inductive.cmi kernel/mod_subst.cmi \ - kernel/modops.cmi kernel/names.cmi kernel/reduction.cmi kernel/term.cmi \ - kernel/univ.cmi lib/util.cmi kernel/subtyping.cmi -kernel/subtyping.cmx: kernel/declarations.cmx kernel/entries.cmx \ - kernel/environ.cmx kernel/inductive.cmx kernel/mod_subst.cmx \ - kernel/modops.cmx kernel/names.cmx kernel/reduction.cmx kernel/term.cmx \ - kernel/univ.cmx lib/util.cmx kernel/subtyping.cmi -kernel/term.cmo: kernel/esubst.cmi lib/hashcons.cmi kernel/names.cmi \ - lib/pp.cmi kernel/univ.cmi lib/util.cmi kernel/term.cmi -kernel/term.cmx: kernel/esubst.cmx lib/hashcons.cmx kernel/names.cmx \ - lib/pp.cmx kernel/univ.cmx lib/util.cmx kernel/term.cmi -kernel/term_typing.cmo: kernel/cemitcodes.cmi kernel/cooking.cmi \ - kernel/declarations.cmi kernel/entries.cmi kernel/environ.cmi \ - kernel/indtypes.cmi kernel/inductive.cmi kernel/names.cmi \ - kernel/reduction.cmi kernel/sign.cmi kernel/term.cmi \ - kernel/type_errors.cmi kernel/typeops.cmi kernel/univ.cmi lib/util.cmi \ +kernel/subtyping.cmo: lib/util.cmi kernel/univ.cmi kernel/term.cmi \ + kernel/reduction.cmi kernel/names.cmi kernel/modops.cmi \ + kernel/mod_subst.cmi kernel/inductive.cmi kernel/environ.cmi \ + kernel/entries.cmi kernel/declarations.cmi kernel/subtyping.cmi +kernel/subtyping.cmx: lib/util.cmx kernel/univ.cmx kernel/term.cmx \ + kernel/reduction.cmx kernel/names.cmx kernel/modops.cmx \ + kernel/mod_subst.cmx kernel/inductive.cmx kernel/environ.cmx \ + kernel/entries.cmx kernel/declarations.cmx kernel/subtyping.cmi +kernel/term.cmo: lib/util.cmi kernel/univ.cmi lib/pp.cmi kernel/names.cmi \ + lib/hashcons.cmi kernel/esubst.cmi kernel/term.cmi +kernel/term.cmx: lib/util.cmx kernel/univ.cmx lib/pp.cmx kernel/names.cmx \ + lib/hashcons.cmx kernel/esubst.cmx kernel/term.cmi +kernel/term_typing.cmo: lib/util.cmi kernel/univ.cmi kernel/typeops.cmi \ + kernel/type_errors.cmi kernel/term.cmi kernel/sign.cmi \ + kernel/reduction.cmi kernel/names.cmi kernel/inductive.cmi \ + kernel/indtypes.cmi kernel/environ.cmi kernel/entries.cmi \ + kernel/declarations.cmi kernel/cooking.cmi kernel/cemitcodes.cmi \ kernel/term_typing.cmi -kernel/term_typing.cmx: kernel/cemitcodes.cmx kernel/cooking.cmx \ - kernel/declarations.cmx kernel/entries.cmx kernel/environ.cmx \ - kernel/indtypes.cmx kernel/inductive.cmx kernel/names.cmx \ - kernel/reduction.cmx kernel/sign.cmx kernel/term.cmx \ - kernel/type_errors.cmx kernel/typeops.cmx kernel/univ.cmx lib/util.cmx \ +kernel/term_typing.cmx: lib/util.cmx kernel/univ.cmx kernel/typeops.cmx \ + kernel/type_errors.cmx kernel/term.cmx kernel/sign.cmx \ + kernel/reduction.cmx kernel/names.cmx kernel/inductive.cmx \ + kernel/indtypes.cmx kernel/environ.cmx kernel/entries.cmx \ + kernel/declarations.cmx kernel/cooking.cmx kernel/cemitcodes.cmx \ kernel/term_typing.cmi -kernel/type_errors.cmo: kernel/environ.cmi kernel/names.cmi \ - kernel/reduction.cmi kernel/sign.cmi kernel/term.cmi \ - kernel/type_errors.cmi -kernel/type_errors.cmx: kernel/environ.cmx kernel/names.cmx \ - kernel/reduction.cmx kernel/sign.cmx kernel/term.cmx \ - kernel/type_errors.cmi -kernel/typeops.cmo: kernel/declarations.cmi kernel/entries.cmi \ - kernel/environ.cmi kernel/inductive.cmi kernel/names.cmi \ - kernel/reduction.cmi kernel/sign.cmi kernel/term.cmi \ - kernel/type_errors.cmi kernel/univ.cmi lib/util.cmi kernel/typeops.cmi -kernel/typeops.cmx: kernel/declarations.cmx kernel/entries.cmx \ - kernel/environ.cmx kernel/inductive.cmx kernel/names.cmx \ - kernel/reduction.cmx kernel/sign.cmx kernel/term.cmx \ - kernel/type_errors.cmx kernel/univ.cmx lib/util.cmx kernel/typeops.cmi -kernel/univ.cmo: lib/hashcons.cmi kernel/names.cmi lib/pp.cmi lib/util.cmi \ +kernel/type_errors.cmo: kernel/term.cmi kernel/sign.cmi kernel/reduction.cmi \ + kernel/names.cmi kernel/environ.cmi kernel/type_errors.cmi +kernel/type_errors.cmx: kernel/term.cmx kernel/sign.cmx kernel/reduction.cmx \ + kernel/names.cmx kernel/environ.cmx kernel/type_errors.cmi +kernel/typeops.cmo: lib/util.cmi kernel/univ.cmi kernel/type_errors.cmi \ + kernel/term.cmi kernel/sign.cmi kernel/reduction.cmi kernel/names.cmi \ + kernel/inductive.cmi kernel/environ.cmi kernel/entries.cmi \ + kernel/declarations.cmi kernel/typeops.cmi +kernel/typeops.cmx: lib/util.cmx kernel/univ.cmx kernel/type_errors.cmx \ + kernel/term.cmx kernel/sign.cmx kernel/reduction.cmx kernel/names.cmx \ + kernel/inductive.cmx kernel/environ.cmx kernel/entries.cmx \ + kernel/declarations.cmx kernel/typeops.cmi +kernel/univ.cmo: lib/util.cmi lib/pp.cmi kernel/names.cmi lib/hashcons.cmi \ kernel/univ.cmi -kernel/univ.cmx: lib/hashcons.cmx kernel/names.cmx lib/pp.cmx lib/util.cmx \ +kernel/univ.cmx: lib/util.cmx lib/pp.cmx kernel/names.cmx lib/hashcons.cmx \ kernel/univ.cmi -kernel/vconv.cmo: kernel/closure.cmi kernel/conv_oracle.cmi \ - kernel/csymtable.cmi kernel/declarations.cmi kernel/environ.cmi \ - kernel/inductive.cmi kernel/names.cmi kernel/reduction.cmi \ - kernel/term.cmi kernel/univ.cmi lib/util.cmi kernel/vm.cmi \ - kernel/vconv.cmi -kernel/vconv.cmx: kernel/closure.cmx kernel/conv_oracle.cmx \ - kernel/csymtable.cmx kernel/declarations.cmx kernel/environ.cmx \ - kernel/inductive.cmx kernel/names.cmx kernel/reduction.cmx \ - kernel/term.cmx kernel/univ.cmx lib/util.cmx kernel/vm.cmx \ - kernel/vconv.cmi -kernel/vm.cmo: kernel/cbytecodes.cmi kernel/conv_oracle.cmi kernel/names.cmi \ - kernel/term.cmi lib/util.cmi kernel/vm.cmi -kernel/vm.cmx: kernel/cbytecodes.cmx kernel/conv_oracle.cmx kernel/names.cmx \ - kernel/term.cmx lib/util.cmx kernel/vm.cmi +kernel/vconv.cmo: kernel/vm.cmi lib/util.cmi kernel/univ.cmi kernel/term.cmi \ + kernel/reduction.cmi kernel/names.cmi kernel/inductive.cmi \ + kernel/environ.cmi kernel/declarations.cmi kernel/csymtable.cmi \ + kernel/conv_oracle.cmi kernel/closure.cmi kernel/vconv.cmi +kernel/vconv.cmx: kernel/vm.cmx lib/util.cmx kernel/univ.cmx kernel/term.cmx \ + kernel/reduction.cmx kernel/names.cmx kernel/inductive.cmx \ + kernel/environ.cmx kernel/declarations.cmx kernel/csymtable.cmx \ + kernel/conv_oracle.cmx kernel/closure.cmx kernel/vconv.cmi +kernel/vm.cmo: lib/util.cmi kernel/term.cmi kernel/names.cmi \ + kernel/conv_oracle.cmi kernel/cbytecodes.cmi kernel/vm.cmi +kernel/vm.cmx: lib/util.cmx kernel/term.cmx kernel/names.cmx \ + kernel/conv_oracle.cmx kernel/cbytecodes.cmx kernel/vm.cmi lib/bigint.cmo: lib/pp.cmi lib/bigint.cmi lib/bigint.cmx: lib/pp.cmx lib/bigint.cmi lib/bstack.cmo: lib/util.cmi lib/bstack.cmi lib/bstack.cmx: lib/util.cmx lib/bstack.cmi lib/dyn.cmo: lib/util.cmi lib/dyn.cmi lib/dyn.cmx: lib/util.cmx lib/dyn.cmi -lib/edit.cmo: lib/bstack.cmi lib/pp.cmi lib/util.cmi lib/edit.cmi -lib/edit.cmx: lib/bstack.cmx lib/pp.cmx lib/util.cmx lib/edit.cmi +lib/edit.cmo: lib/util.cmi lib/pp.cmi lib/bstack.cmi lib/edit.cmi +lib/edit.cmx: lib/util.cmx lib/pp.cmx lib/bstack.cmx lib/edit.cmi lib/explore.cmo: lib/explore.cmi lib/explore.cmx: lib/explore.cmi -lib/gmapl.cmo: lib/gmap.cmi lib/util.cmi lib/gmapl.cmi -lib/gmapl.cmx: lib/gmap.cmx lib/util.cmx lib/gmapl.cmi +lib/gmapl.cmo: lib/util.cmi lib/gmap.cmi lib/gmapl.cmi +lib/gmapl.cmx: lib/util.cmx lib/gmap.cmx lib/gmapl.cmi lib/gmap.cmo: lib/gmap.cmi lib/gmap.cmx: lib/gmap.cmi lib/gset.cmo: lib/gset.cmi @@ -886,2199 +889,2255 @@ lib/predicate.cmo: lib/predicate.cmi lib/predicate.cmx: lib/predicate.cmi lib/profile.cmo: lib/profile.cmi lib/profile.cmx: lib/profile.cmi -library/declare.cmo: kernel/cooking.cmi library/decl_kinds.cmo \ - kernel/declarations.cmi toplevel/discharge.cmi \ - library/dischargedhypsmap.cmi kernel/entries.cmi kernel/environ.cmi \ - library/global.cmi library/impargs.cmi kernel/indtypes.cmi \ - kernel/inductive.cmi library/lib.cmi library/libnames.cmi \ - library/libobject.cmi library/nameops.cmi kernel/names.cmi \ - library/nametab.cmi interp/notation.cmi lib/options.cmi lib/pp.cmi \ - kernel/reduction.cmi kernel/safe_typing.cmi kernel/sign.cmi \ - library/summary.cmi kernel/term.cmi kernel/type_errors.cmi \ - kernel/typeops.cmi kernel/univ.cmi lib/util.cmi library/declare.cmi -library/declare.cmx: kernel/cooking.cmx library/decl_kinds.cmx \ - kernel/declarations.cmx toplevel/discharge.cmx \ - library/dischargedhypsmap.cmx kernel/entries.cmx kernel/environ.cmx \ - library/global.cmx library/impargs.cmx kernel/indtypes.cmx \ - kernel/inductive.cmx library/lib.cmx library/libnames.cmx \ - library/libobject.cmx library/nameops.cmx kernel/names.cmx \ - library/nametab.cmx interp/notation.cmx lib/options.cmx lib/pp.cmx \ - kernel/reduction.cmx kernel/safe_typing.cmx kernel/sign.cmx \ - library/summary.cmx kernel/term.cmx kernel/type_errors.cmx \ - kernel/typeops.cmx kernel/univ.cmx lib/util.cmx library/declare.cmi -library/declaremods.cmo: kernel/declarations.cmi kernel/entries.cmi \ - kernel/environ.cmi library/global.cmi library/lib.cmi \ - library/libnames.cmi library/libobject.cmi kernel/mod_subst.cmi \ - kernel/mod_typing.cmi kernel/modops.cmi kernel/names.cmi \ - library/nametab.cmi lib/pp.cmi kernel/subtyping.cmi library/summary.cmi \ - lib/util.cmi library/declaremods.cmi -library/declaremods.cmx: kernel/declarations.cmx kernel/entries.cmx \ - kernel/environ.cmx library/global.cmx library/lib.cmx \ - library/libnames.cmx library/libobject.cmx kernel/mod_subst.cmx \ - kernel/mod_typing.cmx kernel/modops.cmx kernel/names.cmx \ - library/nametab.cmx lib/pp.cmx kernel/subtyping.cmx library/summary.cmx \ - lib/util.cmx library/declaremods.cmi +library/declare.cmo: lib/util.cmi kernel/univ.cmi kernel/typeops.cmi \ + kernel/type_errors.cmi kernel/term.cmi library/summary.cmi \ + kernel/sign.cmi kernel/safe_typing.cmi kernel/reduction.cmi lib/pp.cmi \ + lib/options.cmi interp/notation.cmi library/nametab.cmi kernel/names.cmi \ + library/nameops.cmi library/libobject.cmi library/libnames.cmi \ + library/lib.cmi kernel/inductive.cmi kernel/indtypes.cmi \ + library/impargs.cmi library/global.cmi kernel/environ.cmi \ + kernel/entries.cmi library/dischargedhypsmap.cmi toplevel/discharge.cmi \ + kernel/declarations.cmi library/decl_kinds.cmo kernel/cooking.cmi \ + library/declare.cmi +library/declare.cmx: lib/util.cmx kernel/univ.cmx kernel/typeops.cmx \ + kernel/type_errors.cmx kernel/term.cmx library/summary.cmx \ + kernel/sign.cmx kernel/safe_typing.cmx kernel/reduction.cmx lib/pp.cmx \ + lib/options.cmx interp/notation.cmx library/nametab.cmx kernel/names.cmx \ + library/nameops.cmx library/libobject.cmx library/libnames.cmx \ + library/lib.cmx kernel/inductive.cmx kernel/indtypes.cmx \ + library/impargs.cmx library/global.cmx kernel/environ.cmx \ + kernel/entries.cmx library/dischargedhypsmap.cmx toplevel/discharge.cmx \ + kernel/declarations.cmx library/decl_kinds.cmx kernel/cooking.cmx \ + library/declare.cmi +library/declaremods.cmo: lib/util.cmi library/summary.cmi \ + kernel/subtyping.cmi lib/pp.cmi library/nametab.cmi kernel/names.cmi \ + kernel/modops.cmi kernel/mod_typing.cmi kernel/mod_subst.cmi \ + library/libobject.cmi library/libnames.cmi library/lib.cmi \ + library/global.cmi kernel/environ.cmi kernel/entries.cmi \ + kernel/declarations.cmi library/declaremods.cmi +library/declaremods.cmx: lib/util.cmx library/summary.cmx \ + kernel/subtyping.cmx lib/pp.cmx library/nametab.cmx kernel/names.cmx \ + kernel/modops.cmx kernel/mod_typing.cmx kernel/mod_subst.cmx \ + library/libobject.cmx library/libnames.cmx library/lib.cmx \ + library/global.cmx kernel/environ.cmx kernel/entries.cmx \ + kernel/declarations.cmx library/declaremods.cmi library/decl_kinds.cmo: lib/util.cmi library/decl_kinds.cmx: lib/util.cmx -library/dischargedhypsmap.cmo: kernel/declarations.cmi kernel/environ.cmi \ - kernel/inductive.cmi library/lib.cmi library/libnames.cmi \ - library/libobject.cmi kernel/names.cmi library/nametab.cmi \ - kernel/reduction.cmi library/summary.cmi kernel/term.cmi lib/util.cmi \ - library/dischargedhypsmap.cmi -library/dischargedhypsmap.cmx: kernel/declarations.cmx kernel/environ.cmx \ - kernel/inductive.cmx library/lib.cmx library/libnames.cmx \ - library/libobject.cmx kernel/names.cmx library/nametab.cmx \ - kernel/reduction.cmx library/summary.cmx kernel/term.cmx lib/util.cmx \ - library/dischargedhypsmap.cmi -library/global.cmo: kernel/environ.cmi kernel/inductive.cmi \ - library/libnames.cmi kernel/names.cmi kernel/safe_typing.cmi \ - kernel/sign.cmi library/summary.cmi kernel/term.cmi lib/util.cmi \ +library/dischargedhypsmap.cmo: lib/util.cmi kernel/term.cmi \ + library/summary.cmi kernel/reduction.cmi library/nametab.cmi \ + kernel/names.cmi library/libobject.cmi library/libnames.cmi \ + library/lib.cmi kernel/inductive.cmi kernel/environ.cmi \ + kernel/declarations.cmi library/dischargedhypsmap.cmi +library/dischargedhypsmap.cmx: lib/util.cmx kernel/term.cmx \ + library/summary.cmx kernel/reduction.cmx library/nametab.cmx \ + kernel/names.cmx library/libobject.cmx library/libnames.cmx \ + library/lib.cmx kernel/inductive.cmx kernel/environ.cmx \ + kernel/declarations.cmx library/dischargedhypsmap.cmi +library/global.cmo: lib/util.cmi kernel/term.cmi library/summary.cmi \ + kernel/sign.cmi kernel/safe_typing.cmi kernel/names.cmi \ + library/libnames.cmi kernel/inductive.cmi kernel/environ.cmi \ library/global.cmi -library/global.cmx: kernel/environ.cmx kernel/inductive.cmx \ - library/libnames.cmx kernel/names.cmx kernel/safe_typing.cmx \ - kernel/sign.cmx library/summary.cmx kernel/term.cmx lib/util.cmx \ +library/global.cmx: lib/util.cmx kernel/term.cmx library/summary.cmx \ + kernel/sign.cmx kernel/safe_typing.cmx kernel/names.cmx \ + library/libnames.cmx kernel/inductive.cmx kernel/environ.cmx \ library/global.cmi -library/goptions.cmo: library/lib.cmi library/libnames.cmi \ - library/libobject.cmi kernel/mod_subst.cmi kernel/names.cmi \ - library/nametab.cmi lib/pp.cmi library/summary.cmi kernel/term.cmi \ - lib/util.cmi library/goptions.cmi -library/goptions.cmx: library/lib.cmx library/libnames.cmx \ - library/libobject.cmx kernel/mod_subst.cmx kernel/names.cmx \ - library/nametab.cmx lib/pp.cmx library/summary.cmx kernel/term.cmx \ - lib/util.cmx library/goptions.cmi -library/impargs.cmo: kernel/declarations.cmi kernel/environ.cmi \ - library/global.cmi kernel/inductive.cmi library/lib.cmi \ - library/libnames.cmi library/libobject.cmi kernel/names.cmi \ - library/nametab.cmi lib/pp.cmi kernel/reduction.cmi library/summary.cmi \ - kernel/term.cmi pretyping/termops.cmi interp/topconstr.cmi lib/util.cmi \ +library/goptions.cmo: lib/util.cmi kernel/term.cmi library/summary.cmi \ + lib/pp.cmi library/nametab.cmi kernel/names.cmi kernel/mod_subst.cmi \ + library/libobject.cmi library/libnames.cmi library/lib.cmi \ + library/goptions.cmi +library/goptions.cmx: lib/util.cmx kernel/term.cmx library/summary.cmx \ + lib/pp.cmx library/nametab.cmx kernel/names.cmx kernel/mod_subst.cmx \ + library/libobject.cmx library/libnames.cmx library/lib.cmx \ + library/goptions.cmi +library/impargs.cmo: lib/util.cmi interp/topconstr.cmi pretyping/termops.cmi \ + kernel/term.cmi library/summary.cmi kernel/reduction.cmi lib/pp.cmi \ + library/nametab.cmi kernel/names.cmi library/libobject.cmi \ + library/libnames.cmi library/lib.cmi kernel/inductive.cmi \ + library/global.cmi kernel/environ.cmi kernel/declarations.cmi \ library/impargs.cmi -library/impargs.cmx: kernel/declarations.cmx kernel/environ.cmx \ - library/global.cmx kernel/inductive.cmx library/lib.cmx \ - library/libnames.cmx library/libobject.cmx kernel/names.cmx \ - library/nametab.cmx lib/pp.cmx kernel/reduction.cmx library/summary.cmx \ - kernel/term.cmx pretyping/termops.cmx interp/topconstr.cmx lib/util.cmx \ +library/impargs.cmx: lib/util.cmx interp/topconstr.cmx pretyping/termops.cmx \ + kernel/term.cmx library/summary.cmx kernel/reduction.cmx lib/pp.cmx \ + library/nametab.cmx kernel/names.cmx library/libobject.cmx \ + library/libnames.cmx library/lib.cmx kernel/inductive.cmx \ + library/global.cmx kernel/environ.cmx kernel/declarations.cmx \ library/impargs.cmi -library/lib.cmo: kernel/cooking.cmi library/libnames.cmi \ - library/libobject.cmi library/nameops.cmi kernel/names.cmi \ - library/nametab.cmi lib/options.cmi lib/pp.cmi kernel/sign.cmi \ - library/summary.cmi kernel/term.cmi lib/util.cmi library/lib.cmi -library/lib.cmx: kernel/cooking.cmx library/libnames.cmx \ - library/libobject.cmx library/nameops.cmx kernel/names.cmx \ - library/nametab.cmx lib/options.cmx lib/pp.cmx kernel/sign.cmx \ - library/summary.cmx kernel/term.cmx lib/util.cmx library/lib.cmi -library/libnames.cmo: kernel/mod_subst.cmi library/nameops.cmi \ - kernel/names.cmi lib/pp.cmi lib/predicate.cmi kernel/term.cmi \ - lib/util.cmi library/libnames.cmi -library/libnames.cmx: kernel/mod_subst.cmx library/nameops.cmx \ - kernel/names.cmx lib/pp.cmx lib/predicate.cmx kernel/term.cmx \ - lib/util.cmx library/libnames.cmi -library/libobject.cmo: lib/dyn.cmi library/libnames.cmi kernel/mod_subst.cmi \ - kernel/names.cmi lib/util.cmi library/libobject.cmi -library/libobject.cmx: lib/dyn.cmx library/libnames.cmx kernel/mod_subst.cmx \ - kernel/names.cmx lib/util.cmx library/libobject.cmi -library/library.cmo: library/declaremods.cmi library/lib.cmi \ - library/libnames.cmi library/libobject.cmi library/nameops.cmi \ - kernel/names.cmi library/nametab.cmi lib/options.cmi lib/pp.cmi \ - kernel/safe_typing.cmi library/summary.cmi lib/system.cmi lib/util.cmi \ +library/lib.cmo: lib/util.cmi kernel/term.cmi library/summary.cmi \ + kernel/sign.cmi lib/pp.cmi lib/options.cmi library/nametab.cmi \ + kernel/names.cmi library/nameops.cmi library/libobject.cmi \ + library/libnames.cmi kernel/cooking.cmi library/lib.cmi +library/lib.cmx: lib/util.cmx kernel/term.cmx library/summary.cmx \ + kernel/sign.cmx lib/pp.cmx lib/options.cmx library/nametab.cmx \ + kernel/names.cmx library/nameops.cmx library/libobject.cmx \ + library/libnames.cmx kernel/cooking.cmx library/lib.cmi +library/libnames.cmo: lib/util.cmi kernel/term.cmi lib/predicate.cmi \ + lib/pp.cmi kernel/names.cmi library/nameops.cmi kernel/mod_subst.cmi \ + library/libnames.cmi +library/libnames.cmx: lib/util.cmx kernel/term.cmx lib/predicate.cmx \ + lib/pp.cmx kernel/names.cmx library/nameops.cmx kernel/mod_subst.cmx \ + library/libnames.cmi +library/libobject.cmo: lib/util.cmi kernel/names.cmi kernel/mod_subst.cmi \ + library/libnames.cmi lib/dyn.cmi library/libobject.cmi +library/libobject.cmx: lib/util.cmx kernel/names.cmx kernel/mod_subst.cmx \ + library/libnames.cmx lib/dyn.cmx library/libobject.cmi +library/library.cmo: lib/util.cmi lib/system.cmi library/summary.cmi \ + kernel/safe_typing.cmi lib/pp.cmi lib/options.cmi library/nametab.cmi \ + kernel/names.cmi library/nameops.cmi library/libobject.cmi \ + library/libnames.cmi library/lib.cmi library/declaremods.cmi \ library/library.cmi -library/library.cmx: library/declaremods.cmx library/lib.cmx \ - library/libnames.cmx library/libobject.cmx library/nameops.cmx \ - kernel/names.cmx library/nametab.cmx lib/options.cmx lib/pp.cmx \ - kernel/safe_typing.cmx library/summary.cmx lib/system.cmx lib/util.cmx \ +library/library.cmx: lib/util.cmx lib/system.cmx library/summary.cmx \ + kernel/safe_typing.cmx lib/pp.cmx lib/options.cmx library/nametab.cmx \ + kernel/names.cmx library/nameops.cmx library/libobject.cmx \ + library/libnames.cmx library/lib.cmx library/declaremods.cmx \ library/library.cmi -library/nameops.cmo: kernel/names.cmi lib/pp.cmi lib/util.cmi \ +library/nameops.cmo: lib/util.cmi lib/pp.cmi kernel/names.cmi \ library/nameops.cmi -library/nameops.cmx: kernel/names.cmx lib/pp.cmx lib/util.cmx \ +library/nameops.cmx: lib/util.cmx lib/pp.cmx kernel/names.cmx \ library/nameops.cmi -library/nametab.cmo: kernel/declarations.cmi library/libnames.cmi \ - library/nameops.cmi kernel/names.cmi lib/pp.cmi library/summary.cmi \ - lib/util.cmi library/nametab.cmi -library/nametab.cmx: kernel/declarations.cmx library/libnames.cmx \ - library/nameops.cmx kernel/names.cmx lib/pp.cmx library/summary.cmx \ - lib/util.cmx library/nametab.cmi -library/states.cmo: library/lib.cmi library/library.cmi library/summary.cmi \ - lib/system.cmi library/states.cmi -library/states.cmx: library/lib.cmx library/library.cmx library/summary.cmx \ - lib/system.cmx library/states.cmi -library/summary.cmo: lib/dyn.cmi lib/pp.cmi lib/util.cmi library/summary.cmi -library/summary.cmx: lib/dyn.cmx lib/pp.cmx lib/util.cmx library/summary.cmi -lib/rtree.cmo: lib/pp.cmi lib/util.cmi lib/rtree.cmi -lib/rtree.cmx: lib/pp.cmx lib/util.cmx lib/rtree.cmi +library/nametab.cmo: lib/util.cmi library/summary.cmi lib/pp.cmi \ + kernel/names.cmi library/nameops.cmi library/libnames.cmi \ + kernel/declarations.cmi library/nametab.cmi +library/nametab.cmx: lib/util.cmx library/summary.cmx lib/pp.cmx \ + kernel/names.cmx library/nameops.cmx library/libnames.cmx \ + kernel/declarations.cmx library/nametab.cmi +library/states.cmo: lib/system.cmi library/summary.cmi library/library.cmi \ + library/lib.cmi library/states.cmi +library/states.cmx: lib/system.cmx library/summary.cmx library/library.cmx \ + library/lib.cmx library/states.cmi +library/summary.cmo: lib/util.cmi lib/pp.cmi lib/dyn.cmi library/summary.cmi +library/summary.cmx: lib/util.cmx lib/pp.cmx lib/dyn.cmx library/summary.cmi +lib/rtree.cmo: lib/util.cmi lib/pp.cmi lib/rtree.cmi +lib/rtree.cmx: lib/util.cmx lib/pp.cmx lib/rtree.cmi lib/stamps.cmo: lib/stamps.cmi lib/stamps.cmx: lib/stamps.cmi -lib/system.cmo: config/coq_config.cmi lib/pp.cmi lib/util.cmi lib/system.cmi -lib/system.cmx: config/coq_config.cmx lib/pp.cmx lib/util.cmx lib/system.cmi -lib/tlm.cmo: lib/gmap.cmi lib/gset.cmi lib/tlm.cmi -lib/tlm.cmx: lib/gmap.cmx lib/gset.cmx lib/tlm.cmi -lib/util.cmo: lib/compat.cmo lib/pp.cmi lib/util.cmi -lib/util.cmx: lib/compat.cmx lib/pp.cmx lib/util.cmi -parsing/argextend.cmo: interp/genarg.cmi parsing/pcoq.cmi \ - parsing/q_coqast.cmo parsing/q_util.cmi lib/util.cmi \ - toplevel/vernacexpr.cmo -parsing/argextend.cmx: interp/genarg.cmx parsing/pcoq.cmx \ - parsing/q_coqast.cmx parsing/q_util.cmx lib/util.cmx \ - toplevel/vernacexpr.cmx -parsing/egrammar.cmo: lib/bigint.cmi parsing/extend.cmi interp/genarg.cmi \ - parsing/lexer.cmi library/libnames.cmi library/nameops.cmi \ - kernel/names.cmi interp/notation.cmi parsing/pcoq.cmi lib/pp.cmi \ - library/summary.cmi proofs/tacexpr.cmo interp/topconstr.cmi lib/util.cmi \ - toplevel/vernacexpr.cmo parsing/egrammar.cmi -parsing/egrammar.cmx: lib/bigint.cmx parsing/extend.cmx interp/genarg.cmx \ - parsing/lexer.cmx library/libnames.cmx library/nameops.cmx \ - kernel/names.cmx interp/notation.cmx parsing/pcoq.cmx lib/pp.cmx \ - library/summary.cmx proofs/tacexpr.cmx interp/topconstr.cmx lib/util.cmx \ - toplevel/vernacexpr.cmx parsing/egrammar.cmi -parsing/extend.cmo: interp/genarg.cmi kernel/names.cmi lib/pp.cmi \ - interp/ppextend.cmi interp/topconstr.cmi lib/util.cmi parsing/extend.cmi -parsing/extend.cmx: interp/genarg.cmx kernel/names.cmx lib/pp.cmx \ - interp/ppextend.cmx interp/topconstr.cmx lib/util.cmx parsing/extend.cmi -parsing/g_ascii_syntax.cmo: lib/bigint.cmi interp/coqlib.cmi \ - library/libnames.cmi kernel/names.cmi interp/notation.cmi \ - parsing/pcoq.cmi lib/pp.cmi pretyping/rawterm.cmi interp/topconstr.cmi \ - lib/util.cmi -parsing/g_ascii_syntax.cmx: lib/bigint.cmx interp/coqlib.cmx \ - library/libnames.cmx kernel/names.cmx interp/notation.cmx \ - parsing/pcoq.cmx lib/pp.cmx pretyping/rawterm.cmx interp/topconstr.cmx \ - lib/util.cmx -parsing/g_constr.cmo: lib/bigint.cmi parsing/lexer.cmi library/libnames.cmi \ - kernel/names.cmi parsing/pcoq.cmi lib/pp.cmi pretyping/rawterm.cmi \ - kernel/term.cmi interp/topconstr.cmi lib/util.cmi -parsing/g_constr.cmx: lib/bigint.cmx parsing/lexer.cmx library/libnames.cmx \ - kernel/names.cmx parsing/pcoq.cmx lib/pp.cmx pretyping/rawterm.cmx \ - kernel/term.cmx interp/topconstr.cmx lib/util.cmx -parsing/g_ltac.cmo: interp/genarg.cmi kernel/names.cmi parsing/pcoq.cmi \ - lib/pp.cmi pretyping/rawterm.cmi proofs/tacexpr.cmo interp/topconstr.cmi \ - lib/util.cmi toplevel/vernacexpr.cmo -parsing/g_ltac.cmx: interp/genarg.cmx kernel/names.cmx parsing/pcoq.cmx \ - lib/pp.cmx pretyping/rawterm.cmx proofs/tacexpr.cmx interp/topconstr.cmx \ - lib/util.cmx toplevel/vernacexpr.cmx -parsing/g_minicoq.cmo: kernel/environ.cmi parsing/lexer.cmi kernel/names.cmi \ - lib/pp.cmi kernel/term.cmi kernel/univ.cmi lib/util.cmi \ +lib/system.cmo: lib/util.cmi lib/pp.cmi config/coq_config.cmi lib/system.cmi +lib/system.cmx: lib/util.cmx lib/pp.cmx config/coq_config.cmx lib/system.cmi +lib/tlm.cmo: lib/gset.cmi lib/gmap.cmi lib/tlm.cmi +lib/tlm.cmx: lib/gset.cmx lib/gmap.cmx lib/tlm.cmi +lib/util.cmo: lib/pp.cmi lib/compat.cmo lib/util.cmi +lib/util.cmx: lib/pp.cmx lib/compat.cmx lib/util.cmi +parsing/argextend.cmo: toplevel/vernacexpr.cmo lib/util.cmi \ + parsing/q_util.cmi parsing/q_coqast.cmo parsing/pcoq.cmi \ + interp/genarg.cmi +parsing/argextend.cmx: toplevel/vernacexpr.cmx lib/util.cmx \ + parsing/q_util.cmx parsing/q_coqast.cmx parsing/pcoq.cmx \ + interp/genarg.cmx +parsing/egrammar.cmo: toplevel/vernacexpr.cmo lib/util.cmi \ + interp/topconstr.cmi proofs/tacexpr.cmo library/summary.cmi lib/pp.cmi \ + parsing/pcoq.cmi interp/notation.cmi kernel/names.cmi library/nameops.cmi \ + library/libnames.cmi parsing/lexer.cmi interp/genarg.cmi \ + parsing/extend.cmi lib/bigint.cmi parsing/egrammar.cmi +parsing/egrammar.cmx: toplevel/vernacexpr.cmx lib/util.cmx \ + interp/topconstr.cmx proofs/tacexpr.cmx library/summary.cmx lib/pp.cmx \ + parsing/pcoq.cmx interp/notation.cmx kernel/names.cmx library/nameops.cmx \ + library/libnames.cmx parsing/lexer.cmx interp/genarg.cmx \ + parsing/extend.cmx lib/bigint.cmx parsing/egrammar.cmi +parsing/extend.cmo: lib/util.cmi interp/topconstr.cmi interp/ppextend.cmi \ + lib/pp.cmi kernel/names.cmi interp/genarg.cmi parsing/extend.cmi +parsing/extend.cmx: lib/util.cmx interp/topconstr.cmx interp/ppextend.cmx \ + lib/pp.cmx kernel/names.cmx interp/genarg.cmx parsing/extend.cmi +parsing/g_ascii_syntax.cmo: lib/util.cmi interp/topconstr.cmi \ + pretyping/rawterm.cmi lib/pp.cmi parsing/pcoq.cmi interp/notation.cmi \ + kernel/names.cmi library/libnames.cmi interp/coqlib.cmi lib/bigint.cmi +parsing/g_ascii_syntax.cmx: lib/util.cmx interp/topconstr.cmx \ + pretyping/rawterm.cmx lib/pp.cmx parsing/pcoq.cmx interp/notation.cmx \ + kernel/names.cmx library/libnames.cmx interp/coqlib.cmx lib/bigint.cmx +parsing/g_constr.cmo: lib/util.cmi interp/topconstr.cmi kernel/term.cmi \ + pretyping/rawterm.cmi lib/pp.cmi parsing/pcoq.cmi kernel/names.cmi \ + library/libnames.cmi parsing/lexer.cmi lib/bigint.cmi +parsing/g_constr.cmx: lib/util.cmx interp/topconstr.cmx kernel/term.cmx \ + pretyping/rawterm.cmx lib/pp.cmx parsing/pcoq.cmx kernel/names.cmx \ + library/libnames.cmx parsing/lexer.cmx lib/bigint.cmx +parsing/g_ltac.cmo: toplevel/vernacexpr.cmo lib/util.cmi interp/topconstr.cmi \ + proofs/tacexpr.cmo pretyping/rawterm.cmi lib/pp.cmi parsing/pcoq.cmi \ + kernel/names.cmi +parsing/g_ltac.cmx: toplevel/vernacexpr.cmx lib/util.cmx interp/topconstr.cmx \ + proofs/tacexpr.cmx pretyping/rawterm.cmx lib/pp.cmx parsing/pcoq.cmx \ + kernel/names.cmx +parsing/g_minicoq.cmo: lib/util.cmi kernel/univ.cmi kernel/term.cmi \ + lib/pp.cmi kernel/names.cmi parsing/lexer.cmi kernel/environ.cmi \ parsing/g_minicoq.cmi -parsing/g_minicoq.cmx: kernel/environ.cmx parsing/lexer.cmx kernel/names.cmx \ - lib/pp.cmx kernel/term.cmx kernel/univ.cmx lib/util.cmx \ +parsing/g_minicoq.cmx: lib/util.cmx kernel/univ.cmx kernel/term.cmx \ + lib/pp.cmx kernel/names.cmx parsing/lexer.cmx kernel/environ.cmx \ parsing/g_minicoq.cmi -parsing/g_natsyntax.cmo: lib/bigint.cmi interp/coqlib.cmi \ - library/libnames.cmi kernel/names.cmi interp/notation.cmi lib/options.cmi \ - parsing/pcoq.cmi lib/pp.cmi pretyping/rawterm.cmi lib/util.cmi \ +parsing/g_natsyntax.cmo: lib/util.cmi pretyping/rawterm.cmi lib/pp.cmi \ + parsing/pcoq.cmi lib/options.cmi interp/notation.cmi kernel/names.cmi \ + library/libnames.cmi interp/coqlib.cmi lib/bigint.cmi \ parsing/g_natsyntax.cmi -parsing/g_natsyntax.cmx: lib/bigint.cmx interp/coqlib.cmx \ - library/libnames.cmx kernel/names.cmx interp/notation.cmx lib/options.cmx \ - parsing/pcoq.cmx lib/pp.cmx pretyping/rawterm.cmx lib/util.cmx \ +parsing/g_natsyntax.cmx: lib/util.cmx pretyping/rawterm.cmx lib/pp.cmx \ + parsing/pcoq.cmx lib/options.cmx interp/notation.cmx kernel/names.cmx \ + library/libnames.cmx interp/coqlib.cmx lib/bigint.cmx \ parsing/g_natsyntax.cmi -parsing/g_prim.cmo: lib/bigint.cmi parsing/lexer.cmi library/libnames.cmi \ - kernel/names.cmi library/nametab.cmi parsing/pcoq.cmi lib/pp.cmi \ - interp/topconstr.cmi lib/util.cmi -parsing/g_prim.cmx: lib/bigint.cmx parsing/lexer.cmx library/libnames.cmx \ - kernel/names.cmx library/nametab.cmx parsing/pcoq.cmx lib/pp.cmx \ - interp/topconstr.cmx lib/util.cmx -parsing/g_proofs.cmo: parsing/g_vernac.cmo interp/genarg.cmi parsing/pcoq.cmi \ - lib/pp.cmi proofs/tacexpr.cmo kernel/term.cmi interp/topconstr.cmi \ - lib/util.cmi toplevel/vernacexpr.cmo -parsing/g_proofs.cmx: parsing/g_vernac.cmx interp/genarg.cmx parsing/pcoq.cmx \ - lib/pp.cmx proofs/tacexpr.cmx kernel/term.cmx interp/topconstr.cmx \ - lib/util.cmx toplevel/vernacexpr.cmx -parsing/g_rsyntax.cmo: lib/bigint.cmi library/libnames.cmi kernel/names.cmi \ - interp/notation.cmi parsing/pcoq.cmi lib/pp.cmi pretyping/rawterm.cmi \ - interp/topconstr.cmi lib/util.cmi -parsing/g_rsyntax.cmx: lib/bigint.cmx library/libnames.cmx kernel/names.cmx \ - interp/notation.cmx parsing/pcoq.cmx lib/pp.cmx pretyping/rawterm.cmx \ - interp/topconstr.cmx lib/util.cmx -parsing/g_string_syntax.cmo: interp/coqlib.cmi parsing/g_ascii_syntax.cmo \ - library/libnames.cmi kernel/names.cmi interp/notation.cmi \ - parsing/pcoq.cmi lib/pp.cmi pretyping/rawterm.cmi interp/topconstr.cmi \ - lib/util.cmi -parsing/g_string_syntax.cmx: interp/coqlib.cmx parsing/g_ascii_syntax.cmx \ - library/libnames.cmx kernel/names.cmx interp/notation.cmx \ - parsing/pcoq.cmx lib/pp.cmx pretyping/rawterm.cmx interp/topconstr.cmx \ - lib/util.cmx -parsing/g_tactic.cmo: interp/genarg.cmi parsing/lexer.cmi kernel/names.cmi \ - parsing/pcoq.cmi lib/pp.cmi pretyping/rawterm.cmi proofs/tacexpr.cmo \ - interp/topconstr.cmi lib/util.cmi -parsing/g_tactic.cmx: interp/genarg.cmx parsing/lexer.cmx kernel/names.cmx \ - parsing/pcoq.cmx lib/pp.cmx pretyping/rawterm.cmx proofs/tacexpr.cmx \ - interp/topconstr.cmx lib/util.cmx -parsing/g_vernac.cmo: toplevel/class.cmi library/decl_kinds.cmo \ - parsing/extend.cmi parsing/g_constr.cmo interp/genarg.cmi \ - library/goptions.cmi parsing/lexer.cmi library/nameops.cmi \ - kernel/names.cmi lib/options.cmi parsing/pcoq.cmi lib/pp.cmi \ - interp/ppextend.cmi pretyping/recordops.cmi interp/topconstr.cmi \ - lib/util.cmi toplevel/vernacexpr.cmo -parsing/g_vernac.cmx: toplevel/class.cmx library/decl_kinds.cmx \ - parsing/extend.cmx parsing/g_constr.cmx interp/genarg.cmx \ - library/goptions.cmx parsing/lexer.cmx library/nameops.cmx \ - kernel/names.cmx lib/options.cmx parsing/pcoq.cmx lib/pp.cmx \ - interp/ppextend.cmx pretyping/recordops.cmx interp/topconstr.cmx \ - lib/util.cmx toplevel/vernacexpr.cmx -parsing/g_xml.cmo: interp/genarg.cmi library/libnames.cmi kernel/names.cmi \ - library/nametab.cmi parsing/pcoq.cmi lib/pp.cmi pretyping/rawterm.cmi \ - proofs/tacexpr.cmo kernel/term.cmi lib/util.cmi -parsing/g_xml.cmx: interp/genarg.cmx library/libnames.cmx kernel/names.cmx \ - library/nametab.cmx parsing/pcoq.cmx lib/pp.cmx pretyping/rawterm.cmx \ - proofs/tacexpr.cmx kernel/term.cmx lib/util.cmx -parsing/g_zsyntax.cmo: lib/bigint.cmi library/libnames.cmi kernel/names.cmi \ - interp/notation.cmi parsing/pcoq.cmi lib/pp.cmi pretyping/rawterm.cmi \ - interp/topconstr.cmi lib/util.cmi parsing/g_zsyntax.cmi -parsing/g_zsyntax.cmx: lib/bigint.cmx library/libnames.cmx kernel/names.cmx \ - interp/notation.cmx parsing/pcoq.cmx lib/pp.cmx pretyping/rawterm.cmx \ - interp/topconstr.cmx lib/util.cmx parsing/g_zsyntax.cmi -parsing/lexer.cmo: lib/options.cmi lib/pp.cmi lib/util.cmi parsing/lexer.cmi -parsing/lexer.cmx: lib/options.cmx lib/pp.cmx lib/util.cmx parsing/lexer.cmi -parsing/pcoq.cmo: library/decl_kinds.cmo parsing/extend.cmi interp/genarg.cmi \ - parsing/lexer.cmi library/libnames.cmi kernel/names.cmi lib/options.cmi \ - lib/pp.cmi interp/ppextend.cmi pretyping/rawterm.cmi proofs/tacexpr.cmo \ - interp/topconstr.cmi lib/util.cmi parsing/pcoq.cmi -parsing/pcoq.cmx: library/decl_kinds.cmx parsing/extend.cmx interp/genarg.cmx \ - parsing/lexer.cmx library/libnames.cmx kernel/names.cmx lib/options.cmx \ - lib/pp.cmx interp/ppextend.cmx pretyping/rawterm.cmx proofs/tacexpr.cmx \ - interp/topconstr.cmx lib/util.cmx parsing/pcoq.cmi -parsing/ppconstr.cmo: lib/bigint.cmi interp/constrextern.cmi \ - pretyping/evd.cmi interp/genarg.cmi library/libnames.cmi \ - library/nameops.cmi kernel/names.cmi library/nametab.cmi \ - interp/notation.cmi lib/options.cmi pretyping/pattern.cmi lib/pp.cmi \ - interp/ppextend.cmi pretyping/rawterm.cmi kernel/term.cmi \ - pretyping/termops.cmi interp/topconstr.cmi kernel/univ.cmi lib/util.cmi \ +parsing/g_prim.cmo: lib/util.cmi interp/topconstr.cmi lib/pp.cmi \ + parsing/pcoq.cmi library/nametab.cmi kernel/names.cmi \ + library/libnames.cmi parsing/lexer.cmi lib/bigint.cmi +parsing/g_prim.cmx: lib/util.cmx interp/topconstr.cmx lib/pp.cmx \ + parsing/pcoq.cmx library/nametab.cmx kernel/names.cmx \ + library/libnames.cmx parsing/lexer.cmx lib/bigint.cmx +parsing/g_proofs.cmo: toplevel/vernacexpr.cmo lib/util.cmi \ + interp/topconstr.cmi kernel/term.cmi proofs/tacexpr.cmo \ + pretyping/rawterm.cmi lib/pp.cmi parsing/pcoq.cmi interp/genarg.cmi \ + parsing/g_vernac.cmo +parsing/g_proofs.cmx: toplevel/vernacexpr.cmx lib/util.cmx \ + interp/topconstr.cmx kernel/term.cmx proofs/tacexpr.cmx \ + pretyping/rawterm.cmx lib/pp.cmx parsing/pcoq.cmx interp/genarg.cmx \ + parsing/g_vernac.cmx +parsing/g_rsyntax.cmo: lib/util.cmi interp/topconstr.cmi \ + pretyping/rawterm.cmi lib/pp.cmi parsing/pcoq.cmi interp/notation.cmi \ + kernel/names.cmi library/libnames.cmi lib/bigint.cmi +parsing/g_rsyntax.cmx: lib/util.cmx interp/topconstr.cmx \ + pretyping/rawterm.cmx lib/pp.cmx parsing/pcoq.cmx interp/notation.cmx \ + kernel/names.cmx library/libnames.cmx lib/bigint.cmx +parsing/g_string_syntax.cmo: lib/util.cmi interp/topconstr.cmi \ + pretyping/rawterm.cmi lib/pp.cmi parsing/pcoq.cmi interp/notation.cmi \ + kernel/names.cmi library/libnames.cmi parsing/g_ascii_syntax.cmo \ + interp/coqlib.cmi +parsing/g_string_syntax.cmx: lib/util.cmx interp/topconstr.cmx \ + pretyping/rawterm.cmx lib/pp.cmx parsing/pcoq.cmx interp/notation.cmx \ + kernel/names.cmx library/libnames.cmx parsing/g_ascii_syntax.cmx \ + interp/coqlib.cmx +parsing/g_tactic.cmo: lib/util.cmi interp/topconstr.cmi proofs/tacexpr.cmo \ + pretyping/rawterm.cmi lib/pp.cmi parsing/pcoq.cmi kernel/names.cmi \ + parsing/lexer.cmi interp/genarg.cmi +parsing/g_tactic.cmx: lib/util.cmx interp/topconstr.cmx proofs/tacexpr.cmx \ + pretyping/rawterm.cmx lib/pp.cmx parsing/pcoq.cmx kernel/names.cmx \ + parsing/lexer.cmx interp/genarg.cmx +parsing/g_vernac.cmo: toplevel/vernacexpr.cmo lib/util.cmi \ + interp/topconstr.cmi pretyping/recordops.cmi interp/ppextend.cmi \ + lib/pp.cmi parsing/pcoq.cmi lib/options.cmi kernel/names.cmi \ + library/nameops.cmi parsing/lexer.cmi library/goptions.cmi \ + interp/genarg.cmi parsing/g_constr.cmo parsing/extend.cmi \ + library/decl_kinds.cmo toplevel/class.cmi +parsing/g_vernac.cmx: toplevel/vernacexpr.cmx lib/util.cmx \ + interp/topconstr.cmx pretyping/recordops.cmx interp/ppextend.cmx \ + lib/pp.cmx parsing/pcoq.cmx lib/options.cmx kernel/names.cmx \ + library/nameops.cmx parsing/lexer.cmx library/goptions.cmx \ + interp/genarg.cmx parsing/g_constr.cmx parsing/extend.cmx \ + library/decl_kinds.cmx toplevel/class.cmx +parsing/g_xml.cmo: lib/util.cmi kernel/term.cmi proofs/tacexpr.cmo \ + pretyping/rawterm.cmi lib/pp.cmi parsing/pcoq.cmi library/nametab.cmi \ + kernel/names.cmi library/libnames.cmi pretyping/inductiveops.cmi \ + kernel/inductive.cmi library/global.cmi interp/genarg.cmi \ + pretyping/detyping.cmi kernel/declarations.cmi +parsing/g_xml.cmx: lib/util.cmx kernel/term.cmx proofs/tacexpr.cmx \ + pretyping/rawterm.cmx lib/pp.cmx parsing/pcoq.cmx library/nametab.cmx \ + kernel/names.cmx library/libnames.cmx pretyping/inductiveops.cmx \ + kernel/inductive.cmx library/global.cmx interp/genarg.cmx \ + pretyping/detyping.cmx kernel/declarations.cmx +parsing/g_zsyntax.cmo: lib/util.cmi interp/topconstr.cmi \ + pretyping/rawterm.cmi lib/pp.cmi parsing/pcoq.cmi interp/notation.cmi \ + kernel/names.cmi library/libnames.cmi lib/bigint.cmi \ + parsing/g_zsyntax.cmi +parsing/g_zsyntax.cmx: lib/util.cmx interp/topconstr.cmx \ + pretyping/rawterm.cmx lib/pp.cmx parsing/pcoq.cmx interp/notation.cmx \ + kernel/names.cmx library/libnames.cmx lib/bigint.cmx \ + parsing/g_zsyntax.cmi +parsing/lexer.cmo: lib/util.cmi lib/pp.cmi lib/options.cmi parsing/lexer.cmi +parsing/lexer.cmx: lib/util.cmx lib/pp.cmx lib/options.cmx parsing/lexer.cmi +parsing/pcoq.cmo: lib/util.cmi interp/topconstr.cmi proofs/tacexpr.cmo \ + pretyping/rawterm.cmi interp/ppextend.cmi lib/pp.cmi lib/options.cmi \ + kernel/names.cmi library/libnames.cmi parsing/lexer.cmi interp/genarg.cmi \ + parsing/extend.cmi library/decl_kinds.cmo parsing/pcoq.cmi +parsing/pcoq.cmx: lib/util.cmx interp/topconstr.cmx proofs/tacexpr.cmx \ + pretyping/rawterm.cmx interp/ppextend.cmx lib/pp.cmx lib/options.cmx \ + kernel/names.cmx library/libnames.cmx parsing/lexer.cmx interp/genarg.cmx \ + parsing/extend.cmx library/decl_kinds.cmx parsing/pcoq.cmi +parsing/ppconstr.cmo: lib/util.cmi kernel/univ.cmi interp/topconstr.cmi \ + pretyping/termops.cmi kernel/term.cmi pretyping/rawterm.cmi \ + interp/ppextend.cmi lib/pp.cmi pretyping/pattern.cmi lib/options.cmi \ + interp/notation.cmi library/nametab.cmi kernel/names.cmi \ + library/nameops.cmi library/libnames.cmi interp/genarg.cmi \ + pretyping/evd.cmi interp/constrextern.cmi lib/bigint.cmi \ parsing/ppconstr.cmi -parsing/ppconstr.cmx: lib/bigint.cmx interp/constrextern.cmx \ - pretyping/evd.cmx interp/genarg.cmx library/libnames.cmx \ - library/nameops.cmx kernel/names.cmx library/nametab.cmx \ - interp/notation.cmx lib/options.cmx pretyping/pattern.cmx lib/pp.cmx \ - interp/ppextend.cmx pretyping/rawterm.cmx kernel/term.cmx \ - pretyping/termops.cmx interp/topconstr.cmx kernel/univ.cmx lib/util.cmx \ +parsing/ppconstr.cmx: lib/util.cmx kernel/univ.cmx interp/topconstr.cmx \ + pretyping/termops.cmx kernel/term.cmx pretyping/rawterm.cmx \ + interp/ppextend.cmx lib/pp.cmx pretyping/pattern.cmx lib/options.cmx \ + interp/notation.cmx library/nametab.cmx kernel/names.cmx \ + library/nameops.cmx library/libnames.cmx interp/genarg.cmx \ + pretyping/evd.cmx interp/constrextern.cmx lib/bigint.cmx \ parsing/ppconstr.cmi -parsing/pptactic.cmo: kernel/closure.cmi lib/dyn.cmi parsing/egrammar.cmi \ - kernel/environ.cmi interp/genarg.cmi library/global.cmi \ - library/libnames.cmi library/nameops.cmi kernel/names.cmi \ - library/nametab.cmi pretyping/pattern.cmi lib/pp.cmi parsing/ppconstr.cmi \ - interp/ppextend.cmi parsing/printer.cmi proofs/proof_type.cmi \ - pretyping/rawterm.cmi proofs/tacexpr.cmo proofs/tactic_debug.cmi \ - kernel/term.cmi pretyping/termops.cmi interp/topconstr.cmi lib/util.cmi \ - parsing/pptactic.cmi -parsing/pptactic.cmx: kernel/closure.cmx lib/dyn.cmx parsing/egrammar.cmx \ - kernel/environ.cmx interp/genarg.cmx library/global.cmx \ - library/libnames.cmx library/nameops.cmx kernel/names.cmx \ - library/nametab.cmx pretyping/pattern.cmx lib/pp.cmx parsing/ppconstr.cmx \ - interp/ppextend.cmx parsing/printer.cmx proofs/proof_type.cmx \ - pretyping/rawterm.cmx proofs/tacexpr.cmx proofs/tactic_debug.cmx \ - kernel/term.cmx pretyping/termops.cmx interp/topconstr.cmx lib/util.cmx \ - parsing/pptactic.cmi -parsing/ppvernac.cmo: library/decl_kinds.cmo library/declaremods.cmi \ - parsing/egrammar.cmi parsing/extend.cmi interp/genarg.cmi \ - library/global.cmi library/goptions.cmi library/impargs.cmi \ - library/lib.cmi library/libnames.cmi interp/modintern.cmi \ - library/nameops.cmi kernel/names.cmi library/nametab.cmi lib/options.cmi \ - parsing/pcoq.cmi proofs/pfedit.cmi lib/pp.cmi parsing/ppconstr.cmi \ - interp/ppextend.cmi parsing/pptactic.cmi pretyping/rawterm.cmi \ - proofs/tacexpr.cmo tactics/tacinterp.cmi interp/topconstr.cmi \ - lib/util.cmi toplevel/vernacexpr.cmo parsing/ppvernac.cmi -parsing/ppvernac.cmx: library/decl_kinds.cmx library/declaremods.cmx \ - parsing/egrammar.cmx parsing/extend.cmx interp/genarg.cmx \ - library/global.cmx library/goptions.cmx library/impargs.cmx \ - library/lib.cmx library/libnames.cmx interp/modintern.cmx \ - library/nameops.cmx kernel/names.cmx library/nametab.cmx lib/options.cmx \ - parsing/pcoq.cmx proofs/pfedit.cmx lib/pp.cmx parsing/ppconstr.cmx \ - interp/ppextend.cmx parsing/pptactic.cmx pretyping/rawterm.cmx \ - proofs/tacexpr.cmx tactics/tacinterp.cmx interp/topconstr.cmx \ - lib/util.cmx toplevel/vernacexpr.cmx parsing/ppvernac.cmi -parsing/prettyp.cmo: pretyping/classops.cmi interp/constrextern.cmi \ - kernel/conv_oracle.cmi kernel/declarations.cmi library/declare.cmi \ - kernel/environ.cmi pretyping/evd.cmi library/global.cmi \ - library/impargs.cmi kernel/inductive.cmi pretyping/inductiveops.cmi \ - library/lib.cmi library/libnames.cmi library/libobject.cmi \ - library/nameops.cmi kernel/names.cmi library/nametab.cmi \ - interp/notation.cmi lib/pp.cmi parsing/printer.cmi parsing/printmod.cmi \ - pretyping/recordops.cmi kernel/reduction.cmi pretyping/reductionops.cmi \ - kernel/safe_typing.cmi kernel/sign.cmi interp/syntax_def.cmi \ - kernel/term.cmi pretyping/termops.cmi lib/util.cmi parsing/prettyp.cmi -parsing/prettyp.cmx: pretyping/classops.cmx interp/constrextern.cmx \ - kernel/conv_oracle.cmx kernel/declarations.cmx library/declare.cmx \ - kernel/environ.cmx pretyping/evd.cmx library/global.cmx \ - library/impargs.cmx kernel/inductive.cmx pretyping/inductiveops.cmx \ - library/lib.cmx library/libnames.cmx library/libobject.cmx \ - library/nameops.cmx kernel/names.cmx library/nametab.cmx \ - interp/notation.cmx lib/pp.cmx parsing/printer.cmx parsing/printmod.cmx \ - pretyping/recordops.cmx kernel/reduction.cmx pretyping/reductionops.cmx \ - kernel/safe_typing.cmx kernel/sign.cmx interp/syntax_def.cmx \ - kernel/term.cmx pretyping/termops.cmx lib/util.cmx parsing/prettyp.cmi -parsing/printer.cmo: interp/constrextern.cmi library/declare.cmi \ - kernel/environ.cmi pretyping/evarutil.cmi pretyping/evd.cmi \ - library/global.cmi library/libnames.cmi library/nameops.cmi \ - kernel/names.cmi library/nametab.cmi lib/options.cmi proofs/pfedit.cmi \ - lib/pp.cmi parsing/ppconstr.cmi proofs/proof_type.cmi proofs/refiner.cmi \ - kernel/sign.cmi kernel/term.cmi pretyping/termops.cmi lib/util.cmi \ - parsing/printer.cmi -parsing/printer.cmx: interp/constrextern.cmx library/declare.cmx \ - kernel/environ.cmx pretyping/evarutil.cmx pretyping/evd.cmx \ - library/global.cmx library/libnames.cmx library/nameops.cmx \ - kernel/names.cmx library/nametab.cmx lib/options.cmx proofs/pfedit.cmx \ - lib/pp.cmx parsing/ppconstr.cmx proofs/proof_type.cmx proofs/refiner.cmx \ - kernel/sign.cmx kernel/term.cmx pretyping/termops.cmx lib/util.cmx \ - parsing/printer.cmi -parsing/printmod.cmo: kernel/declarations.cmi library/global.cmi \ - library/libnames.cmi library/nameops.cmi kernel/names.cmi \ - library/nametab.cmi lib/pp.cmi lib/util.cmi parsing/printmod.cmi -parsing/printmod.cmx: kernel/declarations.cmx library/global.cmx \ - library/libnames.cmx library/nameops.cmx kernel/names.cmx \ - library/nametab.cmx lib/pp.cmx lib/util.cmx parsing/printmod.cmi -parsing/q_constr.cmo: kernel/names.cmi pretyping/pattern.cmi \ - parsing/q_util.cmi pretyping/rawterm.cmi kernel/term.cmi lib/util.cmi -parsing/q_constr.cmx: kernel/names.cmx pretyping/pattern.cmx \ - parsing/q_util.cmx pretyping/rawterm.cmx kernel/term.cmx lib/util.cmx -parsing/q_coqast.cmo: interp/genarg.cmi library/libnames.cmi kernel/names.cmi \ - parsing/pcoq.cmi parsing/q_util.cmi pretyping/rawterm.cmi \ - proofs/tacexpr.cmo interp/topconstr.cmi lib/util.cmi -parsing/q_coqast.cmx: interp/genarg.cmx library/libnames.cmx kernel/names.cmx \ - parsing/pcoq.cmx parsing/q_util.cmx pretyping/rawterm.cmx \ - proofs/tacexpr.cmx interp/topconstr.cmx lib/util.cmx -parsing/q_util.cmo: interp/genarg.cmi parsing/pcoq.cmi lib/util.cmi \ - toplevel/vernacexpr.cmo parsing/q_util.cmi -parsing/q_util.cmx: interp/genarg.cmx parsing/pcoq.cmx lib/util.cmx \ - toplevel/vernacexpr.cmx parsing/q_util.cmi -parsing/search.cmo: interp/coqlib.cmi kernel/declarations.cmi \ - library/declare.cmi library/declaremods.cmi kernel/environ.cmi \ - pretyping/evd.cmi library/global.cmi pretyping/inductiveops.cmi \ - library/libnames.cmi library/libobject.cmi pretyping/matching.cmi \ - library/nameops.cmi kernel/names.cmi library/nametab.cmi \ - pretyping/pattern.cmi lib/pp.cmi parsing/printer.cmi \ - pretyping/rawterm.cmi kernel/term.cmi pretyping/termops.cmi \ - pretyping/typing.cmi lib/util.cmi parsing/search.cmi -parsing/search.cmx: interp/coqlib.cmx kernel/declarations.cmx \ - library/declare.cmx library/declaremods.cmx kernel/environ.cmx \ - pretyping/evd.cmx library/global.cmx pretyping/inductiveops.cmx \ - library/libnames.cmx library/libobject.cmx pretyping/matching.cmx \ - library/nameops.cmx kernel/names.cmx library/nametab.cmx \ - pretyping/pattern.cmx lib/pp.cmx parsing/printer.cmx \ - pretyping/rawterm.cmx kernel/term.cmx pretyping/termops.cmx \ - pretyping/typing.cmx lib/util.cmx parsing/search.cmi -parsing/tacextend.cmo: parsing/argextend.cmo interp/genarg.cmi lib/pp.cmi \ - lib/pp_control.cmi parsing/q_coqast.cmo parsing/q_util.cmi lib/util.cmi -parsing/tacextend.cmx: parsing/argextend.cmx interp/genarg.cmx lib/pp.cmx \ - lib/pp_control.cmx parsing/q_coqast.cmx parsing/q_util.cmx lib/util.cmx -parsing/tactic_printer.cmo: kernel/environ.cmi pretyping/evd.cmi \ - library/global.cmi proofs/logic.cmi lib/pp.cmi parsing/pptactic.cmi \ - parsing/printer.cmi proofs/proof_trees.cmi proofs/proof_type.cmi \ - proofs/refiner.cmi kernel/sign.cmi proofs/tacexpr.cmo lib/util.cmi \ +parsing/pptactic.cmo: lib/util.cmi interp/topconstr.cmi pretyping/termops.cmi \ + kernel/term.cmi proofs/tactic_debug.cmi proofs/tacexpr.cmo \ + pretyping/rawterm.cmi parsing/printer.cmi interp/ppextend.cmi \ + parsing/ppconstr.cmi lib/pp.cmi parsing/pcoq.cmi pretyping/pattern.cmi \ + library/nametab.cmi kernel/names.cmi library/nameops.cmi \ + library/libnames.cmi library/global.cmi interp/genarg.cmi \ + parsing/egrammar.cmi lib/dyn.cmi kernel/closure.cmi parsing/pptactic.cmi +parsing/pptactic.cmx: lib/util.cmx interp/topconstr.cmx pretyping/termops.cmx \ + kernel/term.cmx proofs/tactic_debug.cmx proofs/tacexpr.cmx \ + pretyping/rawterm.cmx parsing/printer.cmx interp/ppextend.cmx \ + parsing/ppconstr.cmx lib/pp.cmx parsing/pcoq.cmx pretyping/pattern.cmx \ + library/nametab.cmx kernel/names.cmx library/nameops.cmx \ + library/libnames.cmx library/global.cmx interp/genarg.cmx \ + parsing/egrammar.cmx lib/dyn.cmx kernel/closure.cmx parsing/pptactic.cmi +parsing/ppvernac.cmo: toplevel/vernacexpr.cmo lib/util.cmi \ + interp/topconstr.cmi tactics/tacinterp.cmi proofs/tacexpr.cmo \ + pretyping/rawterm.cmi parsing/pptactic.cmi interp/ppextend.cmi \ + parsing/ppconstr.cmi lib/pp.cmi proofs/pfedit.cmi parsing/pcoq.cmi \ + lib/options.cmi library/nametab.cmi kernel/names.cmi library/nameops.cmi \ + interp/modintern.cmi library/libnames.cmi library/lib.cmi \ + library/impargs.cmi library/goptions.cmi library/global.cmi \ + interp/genarg.cmi parsing/extend.cmi parsing/egrammar.cmi \ + library/declaremods.cmi library/decl_kinds.cmo parsing/ppvernac.cmi +parsing/ppvernac.cmx: toplevel/vernacexpr.cmx lib/util.cmx \ + interp/topconstr.cmx tactics/tacinterp.cmx proofs/tacexpr.cmx \ + pretyping/rawterm.cmx parsing/pptactic.cmx interp/ppextend.cmx \ + parsing/ppconstr.cmx lib/pp.cmx proofs/pfedit.cmx parsing/pcoq.cmx \ + lib/options.cmx library/nametab.cmx kernel/names.cmx library/nameops.cmx \ + interp/modintern.cmx library/libnames.cmx library/lib.cmx \ + library/impargs.cmx library/goptions.cmx library/global.cmx \ + interp/genarg.cmx parsing/extend.cmx parsing/egrammar.cmx \ + library/declaremods.cmx library/decl_kinds.cmx parsing/ppvernac.cmi +parsing/prettyp.cmo: lib/util.cmi pretyping/termops.cmi kernel/term.cmi \ + interp/syntax_def.cmi kernel/sign.cmi kernel/safe_typing.cmi \ + pretyping/reductionops.cmi kernel/reduction.cmi pretyping/recordops.cmi \ + parsing/printmod.cmi parsing/printer.cmi lib/pp.cmi interp/notation.cmi \ + library/nametab.cmi kernel/names.cmi library/nameops.cmi \ + library/libobject.cmi library/libnames.cmi library/lib.cmi \ + pretyping/inductiveops.cmi kernel/inductive.cmi library/impargs.cmi \ + library/global.cmi pretyping/evd.cmi kernel/environ.cmi \ + library/declare.cmi kernel/declarations.cmi kernel/conv_oracle.cmi \ + interp/constrextern.cmi pretyping/classops.cmi parsing/prettyp.cmi +parsing/prettyp.cmx: lib/util.cmx pretyping/termops.cmx kernel/term.cmx \ + interp/syntax_def.cmx kernel/sign.cmx kernel/safe_typing.cmx \ + pretyping/reductionops.cmx kernel/reduction.cmx pretyping/recordops.cmx \ + parsing/printmod.cmx parsing/printer.cmx lib/pp.cmx interp/notation.cmx \ + library/nametab.cmx kernel/names.cmx library/nameops.cmx \ + library/libobject.cmx library/libnames.cmx library/lib.cmx \ + pretyping/inductiveops.cmx kernel/inductive.cmx library/impargs.cmx \ + library/global.cmx pretyping/evd.cmx kernel/environ.cmx \ + library/declare.cmx kernel/declarations.cmx kernel/conv_oracle.cmx \ + interp/constrextern.cmx pretyping/classops.cmx parsing/prettyp.cmi +parsing/printer.cmo: lib/util.cmi pretyping/termops.cmi kernel/term.cmi \ + kernel/sign.cmi proofs/refiner.cmi proofs/proof_type.cmi \ + parsing/ppconstr.cmi lib/pp.cmi proofs/pfedit.cmi lib/options.cmi \ + library/nametab.cmi kernel/names.cmi library/nameops.cmi \ + library/libnames.cmi library/global.cmi pretyping/evd.cmi \ + pretyping/evarutil.cmi kernel/environ.cmi library/declare.cmi \ + interp/constrextern.cmi parsing/printer.cmi +parsing/printer.cmx: lib/util.cmx pretyping/termops.cmx kernel/term.cmx \ + kernel/sign.cmx proofs/refiner.cmx proofs/proof_type.cmx \ + parsing/ppconstr.cmx lib/pp.cmx proofs/pfedit.cmx lib/options.cmx \ + library/nametab.cmx kernel/names.cmx library/nameops.cmx \ + library/libnames.cmx library/global.cmx pretyping/evd.cmx \ + pretyping/evarutil.cmx kernel/environ.cmx library/declare.cmx \ + interp/constrextern.cmx parsing/printer.cmi +parsing/printmod.cmo: lib/util.cmi lib/pp.cmi library/nametab.cmi \ + kernel/names.cmi library/nameops.cmi library/libnames.cmi \ + library/global.cmi kernel/declarations.cmi parsing/printmod.cmi +parsing/printmod.cmx: lib/util.cmx lib/pp.cmx library/nametab.cmx \ + kernel/names.cmx library/nameops.cmx library/libnames.cmx \ + library/global.cmx kernel/declarations.cmx parsing/printmod.cmi +parsing/q_constr.cmo: lib/util.cmi kernel/term.cmi pretyping/rawterm.cmi \ + parsing/q_util.cmi pretyping/pattern.cmi kernel/names.cmi +parsing/q_constr.cmx: lib/util.cmx kernel/term.cmx pretyping/rawterm.cmx \ + parsing/q_util.cmx pretyping/pattern.cmx kernel/names.cmx +parsing/q_coqast.cmo: lib/util.cmi interp/topconstr.cmi proofs/tacexpr.cmo \ + pretyping/rawterm.cmi parsing/q_util.cmi parsing/pcoq.cmi \ + kernel/names.cmi library/libnames.cmi interp/genarg.cmi +parsing/q_coqast.cmx: lib/util.cmx interp/topconstr.cmx proofs/tacexpr.cmx \ + pretyping/rawterm.cmx parsing/q_util.cmx parsing/pcoq.cmx \ + kernel/names.cmx library/libnames.cmx interp/genarg.cmx +parsing/q_util.cmo: toplevel/vernacexpr.cmo lib/util.cmi parsing/pcoq.cmi \ + interp/genarg.cmi parsing/q_util.cmi +parsing/q_util.cmx: toplevel/vernacexpr.cmx lib/util.cmx parsing/pcoq.cmx \ + interp/genarg.cmx parsing/q_util.cmi +parsing/search.cmo: lib/util.cmi pretyping/typing.cmi pretyping/termops.cmi \ + kernel/term.cmi pretyping/rawterm.cmi parsing/printer.cmi lib/pp.cmi \ + pretyping/pattern.cmi library/nametab.cmi kernel/names.cmi \ + library/nameops.cmi pretyping/matching.cmi library/libobject.cmi \ + library/libnames.cmi pretyping/inductiveops.cmi library/global.cmi \ + pretyping/evd.cmi kernel/environ.cmi library/declaremods.cmi \ + library/declare.cmi kernel/declarations.cmi interp/coqlib.cmi \ + parsing/search.cmi +parsing/search.cmx: lib/util.cmx pretyping/typing.cmx pretyping/termops.cmx \ + kernel/term.cmx pretyping/rawterm.cmx parsing/printer.cmx lib/pp.cmx \ + pretyping/pattern.cmx library/nametab.cmx kernel/names.cmx \ + library/nameops.cmx pretyping/matching.cmx library/libobject.cmx \ + library/libnames.cmx pretyping/inductiveops.cmx library/global.cmx \ + pretyping/evd.cmx kernel/environ.cmx library/declaremods.cmx \ + library/declare.cmx kernel/declarations.cmx interp/coqlib.cmx \ + parsing/search.cmi +parsing/tacextend.cmo: lib/util.cmi parsing/q_util.cmi parsing/q_coqast.cmo \ + lib/pp_control.cmi lib/pp.cmi parsing/pcoq.cmi interp/genarg.cmi \ + parsing/argextend.cmo +parsing/tacextend.cmx: lib/util.cmx parsing/q_util.cmx parsing/q_coqast.cmx \ + lib/pp_control.cmx lib/pp.cmx parsing/pcoq.cmx interp/genarg.cmx \ + parsing/argextend.cmx +parsing/tactic_printer.cmo: lib/util.cmi proofs/tacexpr.cmo kernel/sign.cmi \ + proofs/refiner.cmi proofs/proof_type.cmi proofs/proof_trees.cmi \ + parsing/printer.cmi parsing/pptactic.cmi lib/pp.cmi proofs/logic.cmi \ + library/global.cmi pretyping/evd.cmi kernel/environ.cmi \ parsing/tactic_printer.cmi -parsing/tactic_printer.cmx: kernel/environ.cmx pretyping/evd.cmx \ - library/global.cmx proofs/logic.cmx lib/pp.cmx parsing/pptactic.cmx \ - parsing/printer.cmx proofs/proof_trees.cmx proofs/proof_type.cmx \ - proofs/refiner.cmx kernel/sign.cmx proofs/tacexpr.cmx lib/util.cmx \ +parsing/tactic_printer.cmx: lib/util.cmx proofs/tacexpr.cmx kernel/sign.cmx \ + proofs/refiner.cmx proofs/proof_type.cmx proofs/proof_trees.cmx \ + parsing/printer.cmx parsing/pptactic.cmx lib/pp.cmx proofs/logic.cmx \ + library/global.cmx pretyping/evd.cmx kernel/environ.cmx \ parsing/tactic_printer.cmi -parsing/vernacextend.cmo: parsing/argextend.cmo interp/genarg.cmi lib/pp.cmi \ - lib/pp_control.cmi parsing/q_coqast.cmo parsing/q_util.cmi lib/util.cmi -parsing/vernacextend.cmx: parsing/argextend.cmx interp/genarg.cmx lib/pp.cmx \ - lib/pp_control.cmx parsing/q_coqast.cmx parsing/q_util.cmx lib/util.cmx -pretyping/cases.cmo: pretyping/coercion.cmi kernel/declarations.cmi \ - kernel/environ.cmi pretyping/evarconv.cmi pretyping/evarutil.cmi \ - pretyping/evd.cmi library/global.cmi kernel/inductive.cmi \ - pretyping/inductiveops.cmi library/nameops.cmi kernel/names.cmi \ - lib/pp.cmi pretyping/pretype_errors.cmi pretyping/rawterm.cmi \ - pretyping/reductionops.cmi pretyping/retyping.cmi kernel/sign.cmi \ - kernel/term.cmi pretyping/termops.cmi kernel/type_errors.cmi \ - kernel/typeops.cmi lib/util.cmi pretyping/cases.cmi -pretyping/cases.cmx: pretyping/coercion.cmx kernel/declarations.cmx \ - kernel/environ.cmx pretyping/evarconv.cmx pretyping/evarutil.cmx \ - pretyping/evd.cmx library/global.cmx kernel/inductive.cmx \ - pretyping/inductiveops.cmx library/nameops.cmx kernel/names.cmx \ - lib/pp.cmx pretyping/pretype_errors.cmx pretyping/rawterm.cmx \ - pretyping/reductionops.cmx pretyping/retyping.cmx kernel/sign.cmx \ - kernel/term.cmx pretyping/termops.cmx kernel/type_errors.cmx \ - kernel/typeops.cmx lib/util.cmx pretyping/cases.cmi -pretyping/cbv.cmo: kernel/closure.cmi kernel/conv_oracle.cmi \ - kernel/environ.cmi kernel/esubst.cmi pretyping/evd.cmi kernel/names.cmi \ - lib/pp.cmi kernel/term.cmi kernel/univ.cmi lib/util.cmi pretyping/cbv.cmi -pretyping/cbv.cmx: kernel/closure.cmx kernel/conv_oracle.cmx \ - kernel/environ.cmx kernel/esubst.cmx pretyping/evd.cmx kernel/names.cmx \ - lib/pp.cmx kernel/term.cmx kernel/univ.cmx lib/util.cmx pretyping/cbv.cmi -pretyping/classops.cmo: library/decl_kinds.cmo kernel/environ.cmi \ - pretyping/evd.cmi library/global.cmi lib/gmap.cmi library/goptions.cmi \ - library/lib.cmi library/libnames.cmi library/libobject.cmi \ - library/library.cmi kernel/mod_subst.cmi kernel/names.cmi \ - library/nametab.cmi lib/options.cmi lib/pp.cmi pretyping/rawterm.cmi \ - pretyping/reductionops.cmi library/summary.cmi pretyping/tacred.cmi \ - kernel/term.cmi pretyping/termops.cmi lib/util.cmi pretyping/classops.cmi -pretyping/classops.cmx: library/decl_kinds.cmx kernel/environ.cmx \ - pretyping/evd.cmx library/global.cmx lib/gmap.cmx library/goptions.cmx \ - library/lib.cmx library/libnames.cmx library/libobject.cmx \ - library/library.cmx kernel/mod_subst.cmx kernel/names.cmx \ - library/nametab.cmx lib/options.cmx lib/pp.cmx pretyping/rawterm.cmx \ - pretyping/reductionops.cmx library/summary.cmx pretyping/tacred.cmx \ - kernel/term.cmx pretyping/termops.cmx lib/util.cmx pretyping/classops.cmi -pretyping/clenv.cmo: pretyping/coercion.cmi kernel/environ.cmi \ - pretyping/evarutil.cmi pretyping/evd.cmi library/global.cmi \ - kernel/mod_subst.cmi library/nameops.cmi kernel/names.cmi \ - pretyping/pattern.cmi lib/pp.cmi pretyping/pretype_errors.cmi \ - pretyping/rawterm.cmi kernel/reduction.cmi pretyping/reductionops.cmi \ - pretyping/retyping.cmi kernel/sign.cmi proofs/tacexpr.cmo \ - pretyping/tacred.cmi kernel/term.cmi pretyping/termops.cmi \ - pretyping/typing.cmi pretyping/unification.cmi lib/util.cmi \ +parsing/vernacextend.cmo: lib/util.cmi parsing/q_util.cmi \ + parsing/q_coqast.cmo lib/pp_control.cmi lib/pp.cmi interp/genarg.cmi \ + parsing/argextend.cmo +parsing/vernacextend.cmx: lib/util.cmx parsing/q_util.cmx \ + parsing/q_coqast.cmx lib/pp_control.cmx lib/pp.cmx interp/genarg.cmx \ + parsing/argextend.cmx +pretyping/cases.cmo: lib/util.cmi kernel/typeops.cmi kernel/type_errors.cmi \ + pretyping/termops.cmi kernel/term.cmi kernel/sign.cmi \ + pretyping/retyping.cmi pretyping/reductionops.cmi pretyping/rawterm.cmi \ + pretyping/pretype_errors.cmi lib/pp.cmi kernel/names.cmi \ + library/nameops.cmi pretyping/inductiveops.cmi kernel/inductive.cmi \ + library/global.cmi pretyping/evd.cmi pretyping/evarutil.cmi \ + pretyping/evarconv.cmi kernel/environ.cmi kernel/declarations.cmi \ + pretyping/coercion.cmi pretyping/cases.cmi +pretyping/cases.cmx: lib/util.cmx kernel/typeops.cmx kernel/type_errors.cmx \ + pretyping/termops.cmx kernel/term.cmx kernel/sign.cmx \ + pretyping/retyping.cmx pretyping/reductionops.cmx pretyping/rawterm.cmx \ + pretyping/pretype_errors.cmx lib/pp.cmx kernel/names.cmx \ + library/nameops.cmx pretyping/inductiveops.cmx kernel/inductive.cmx \ + library/global.cmx pretyping/evd.cmx pretyping/evarutil.cmx \ + pretyping/evarconv.cmx kernel/environ.cmx kernel/declarations.cmx \ + pretyping/coercion.cmx pretyping/cases.cmi +pretyping/cbv.cmo: lib/util.cmi kernel/univ.cmi kernel/term.cmi lib/pp.cmi \ + kernel/names.cmi pretyping/evd.cmi kernel/esubst.cmi kernel/environ.cmi \ + kernel/conv_oracle.cmi kernel/closure.cmi pretyping/cbv.cmi +pretyping/cbv.cmx: lib/util.cmx kernel/univ.cmx kernel/term.cmx lib/pp.cmx \ + kernel/names.cmx pretyping/evd.cmx kernel/esubst.cmx kernel/environ.cmx \ + kernel/conv_oracle.cmx kernel/closure.cmx pretyping/cbv.cmi +pretyping/classops.cmo: lib/util.cmi pretyping/termops.cmi kernel/term.cmi \ + pretyping/tacred.cmi library/summary.cmi pretyping/reductionops.cmi \ + pretyping/rawterm.cmi lib/pp.cmi lib/options.cmi library/nametab.cmi \ + kernel/names.cmi kernel/mod_subst.cmi library/library.cmi \ + library/libobject.cmi library/libnames.cmi library/lib.cmi \ + library/goptions.cmi lib/gmap.cmi library/global.cmi pretyping/evd.cmi \ + kernel/environ.cmi library/decl_kinds.cmo pretyping/classops.cmi +pretyping/classops.cmx: lib/util.cmx pretyping/termops.cmx kernel/term.cmx \ + pretyping/tacred.cmx library/summary.cmx pretyping/reductionops.cmx \ + pretyping/rawterm.cmx lib/pp.cmx lib/options.cmx library/nametab.cmx \ + kernel/names.cmx kernel/mod_subst.cmx library/library.cmx \ + library/libobject.cmx library/libnames.cmx library/lib.cmx \ + library/goptions.cmx lib/gmap.cmx library/global.cmx pretyping/evd.cmx \ + kernel/environ.cmx library/decl_kinds.cmx pretyping/classops.cmi +pretyping/clenv.cmo: lib/util.cmi pretyping/unification.cmi \ + pretyping/typing.cmi pretyping/termops.cmi kernel/term.cmi \ + pretyping/tacred.cmi proofs/tacexpr.cmo kernel/sign.cmi \ + pretyping/retyping.cmi pretyping/reductionops.cmi kernel/reduction.cmi \ + pretyping/rawterm.cmi pretyping/pretype_errors.cmi lib/pp.cmi \ + pretyping/pattern.cmi kernel/names.cmi library/nameops.cmi \ + kernel/mod_subst.cmi library/global.cmi pretyping/evd.cmi \ + pretyping/evarutil.cmi kernel/environ.cmi pretyping/coercion.cmi \ pretyping/clenv.cmi -pretyping/clenv.cmx: pretyping/coercion.cmx kernel/environ.cmx \ - pretyping/evarutil.cmx pretyping/evd.cmx library/global.cmx \ - kernel/mod_subst.cmx library/nameops.cmx kernel/names.cmx \ - pretyping/pattern.cmx lib/pp.cmx pretyping/pretype_errors.cmx \ - pretyping/rawterm.cmx kernel/reduction.cmx pretyping/reductionops.cmx \ - pretyping/retyping.cmx kernel/sign.cmx proofs/tacexpr.cmx \ - pretyping/tacred.cmx kernel/term.cmx pretyping/termops.cmx \ - pretyping/typing.cmx pretyping/unification.cmx lib/util.cmx \ +pretyping/clenv.cmx: lib/util.cmx pretyping/unification.cmx \ + pretyping/typing.cmx pretyping/termops.cmx kernel/term.cmx \ + pretyping/tacred.cmx proofs/tacexpr.cmx kernel/sign.cmx \ + pretyping/retyping.cmx pretyping/reductionops.cmx kernel/reduction.cmx \ + pretyping/rawterm.cmx pretyping/pretype_errors.cmx lib/pp.cmx \ + pretyping/pattern.cmx kernel/names.cmx library/nameops.cmx \ + kernel/mod_subst.cmx library/global.cmx pretyping/evd.cmx \ + pretyping/evarutil.cmx kernel/environ.cmx pretyping/coercion.cmx \ pretyping/clenv.cmi -pretyping/coercion.cmo: pretyping/classops.cmi kernel/environ.cmi \ - pretyping/evarconv.cmi pretyping/evarutil.cmi pretyping/evd.cmi \ - kernel/names.cmi pretyping/pretype_errors.cmi pretyping/rawterm.cmi \ - pretyping/recordops.cmi kernel/reduction.cmi pretyping/reductionops.cmi \ - pretyping/retyping.cmi kernel/term.cmi kernel/typeops.cmi lib/util.cmi \ - pretyping/coercion.cmi -pretyping/coercion.cmx: pretyping/classops.cmx kernel/environ.cmx \ - pretyping/evarconv.cmx pretyping/evarutil.cmx pretyping/evd.cmx \ - kernel/names.cmx pretyping/pretype_errors.cmx pretyping/rawterm.cmx \ - pretyping/recordops.cmx kernel/reduction.cmx pretyping/reductionops.cmx \ - pretyping/retyping.cmx kernel/term.cmx kernel/typeops.cmx lib/util.cmx \ - pretyping/coercion.cmi -pretyping/detyping.cmo: kernel/declarations.cmi kernel/environ.cmi \ - pretyping/evd.cmi library/global.cmi library/goptions.cmi \ - kernel/inductive.cmi pretyping/inductiveops.cmi library/libnames.cmi \ - kernel/mod_subst.cmi library/nameops.cmi kernel/names.cmi \ - library/nametab.cmi lib/options.cmi lib/pp.cmi pretyping/rawterm.cmi \ - kernel/sign.cmi kernel/term.cmi pretyping/termops.cmi kernel/univ.cmi \ - lib/util.cmi pretyping/detyping.cmi -pretyping/detyping.cmx: kernel/declarations.cmx kernel/environ.cmx \ - pretyping/evd.cmx library/global.cmx library/goptions.cmx \ - kernel/inductive.cmx pretyping/inductiveops.cmx library/libnames.cmx \ - kernel/mod_subst.cmx library/nameops.cmx kernel/names.cmx \ - library/nametab.cmx lib/options.cmx lib/pp.cmx pretyping/rawterm.cmx \ - kernel/sign.cmx kernel/term.cmx pretyping/termops.cmx kernel/univ.cmx \ - lib/util.cmx pretyping/detyping.cmi -pretyping/evarconv.cmo: pretyping/classops.cmi kernel/closure.cmi \ - kernel/environ.cmi pretyping/evarutil.cmi pretyping/evd.cmi \ - library/libnames.cmi kernel/names.cmi pretyping/recordops.cmi \ - kernel/reduction.cmi pretyping/reductionops.cmi kernel/term.cmi \ - pretyping/typing.cmi lib/util.cmi pretyping/evarconv.cmi -pretyping/evarconv.cmx: pretyping/classops.cmx kernel/closure.cmx \ - kernel/environ.cmx pretyping/evarutil.cmx pretyping/evd.cmx \ - library/libnames.cmx kernel/names.cmx pretyping/recordops.cmx \ - kernel/reduction.cmx pretyping/reductionops.cmx kernel/term.cmx \ - pretyping/typing.cmx lib/util.cmx pretyping/evarconv.cmi -pretyping/evarutil.cmo: kernel/environ.cmi pretyping/evd.cmi \ - library/nameops.cmi kernel/names.cmi lib/pp.cmi \ - pretyping/pretype_errors.cmi kernel/reduction.cmi \ - pretyping/reductionops.cmi kernel/sign.cmi kernel/term.cmi \ - pretyping/termops.cmi kernel/typeops.cmi pretyping/typing.cmi \ - kernel/univ.cmi lib/util.cmi pretyping/evarutil.cmi -pretyping/evarutil.cmx: kernel/environ.cmx pretyping/evd.cmx \ - library/nameops.cmx kernel/names.cmx lib/pp.cmx \ - pretyping/pretype_errors.cmx kernel/reduction.cmx \ - pretyping/reductionops.cmx kernel/sign.cmx kernel/term.cmx \ - pretyping/termops.cmx kernel/typeops.cmx pretyping/typing.cmx \ - kernel/univ.cmx lib/util.cmx pretyping/evarutil.cmi -pretyping/evd.cmo: kernel/environ.cmi library/global.cmi library/libnames.cmi \ - kernel/mod_subst.cmi library/nameops.cmi kernel/names.cmi lib/pp.cmi \ - kernel/reduction.cmi kernel/sign.cmi kernel/term.cmi \ - pretyping/termops.cmi kernel/univ.cmi lib/util.cmi pretyping/evd.cmi -pretyping/evd.cmx: kernel/environ.cmx library/global.cmx library/libnames.cmx \ - kernel/mod_subst.cmx library/nameops.cmx kernel/names.cmx lib/pp.cmx \ - kernel/reduction.cmx kernel/sign.cmx kernel/term.cmx \ - pretyping/termops.cmx kernel/univ.cmx lib/util.cmx pretyping/evd.cmi -pretyping/indrec.cmo: kernel/declarations.cmi kernel/entries.cmi \ - kernel/environ.cmi library/global.cmi kernel/inductive.cmi \ - pretyping/inductiveops.cmi library/libnames.cmi library/nameops.cmi \ - kernel/names.cmi library/nametab.cmi lib/options.cmi lib/pp.cmi \ - kernel/reduction.cmi pretyping/reductionops.cmi kernel/safe_typing.cmi \ - kernel/sign.cmi kernel/term.cmi pretyping/termops.cmi \ - kernel/type_errors.cmi kernel/typeops.cmi lib/util.cmi \ - pretyping/indrec.cmi -pretyping/indrec.cmx: kernel/declarations.cmx kernel/entries.cmx \ - kernel/environ.cmx library/global.cmx kernel/inductive.cmx \ - pretyping/inductiveops.cmx library/libnames.cmx library/nameops.cmx \ - kernel/names.cmx library/nametab.cmx lib/options.cmx lib/pp.cmx \ - kernel/reduction.cmx pretyping/reductionops.cmx kernel/safe_typing.cmx \ - kernel/sign.cmx kernel/term.cmx pretyping/termops.cmx \ - kernel/type_errors.cmx kernel/typeops.cmx lib/util.cmx \ - pretyping/indrec.cmi -pretyping/inductiveops.cmo: kernel/declarations.cmi kernel/environ.cmi \ - pretyping/evd.cmi library/global.cmi kernel/inductive.cmi \ - kernel/mod_subst.cmi kernel/names.cmi pretyping/reductionops.cmi \ - kernel/sign.cmi kernel/term.cmi pretyping/termops.cmi kernel/univ.cmi \ - lib/util.cmi pretyping/inductiveops.cmi -pretyping/inductiveops.cmx: kernel/declarations.cmx kernel/environ.cmx \ - pretyping/evd.cmx library/global.cmx kernel/inductive.cmx \ - kernel/mod_subst.cmx kernel/names.cmx pretyping/reductionops.cmx \ - kernel/sign.cmx kernel/term.cmx pretyping/termops.cmx kernel/univ.cmx \ - lib/util.cmx pretyping/inductiveops.cmi -pretyping/matching.cmo: kernel/environ.cmi library/libnames.cmi \ - library/nameops.cmi kernel/names.cmi pretyping/pattern.cmi \ - pretyping/rawterm.cmi pretyping/reductionops.cmi kernel/term.cmi \ - pretyping/termops.cmi lib/util.cmi pretyping/matching.cmi -pretyping/matching.cmx: kernel/environ.cmx library/libnames.cmx \ - library/nameops.cmx kernel/names.cmx pretyping/pattern.cmx \ - pretyping/rawterm.cmx pretyping/reductionops.cmx kernel/term.cmx \ - pretyping/termops.cmx lib/util.cmx pretyping/matching.cmi -pretyping/pattern.cmo: kernel/environ.cmi library/libnames.cmi \ - kernel/mod_subst.cmi library/nameops.cmi kernel/names.cmi \ - library/nametab.cmi lib/options.cmi lib/pp.cmi pretyping/rawterm.cmi \ - kernel/term.cmi lib/util.cmi pretyping/pattern.cmi -pretyping/pattern.cmx: kernel/environ.cmx library/libnames.cmx \ - kernel/mod_subst.cmx library/nameops.cmx kernel/names.cmx \ - library/nametab.cmx lib/options.cmx lib/pp.cmx pretyping/rawterm.cmx \ - kernel/term.cmx lib/util.cmx pretyping/pattern.cmi -pretyping/pretype_errors.cmo: kernel/environ.cmi pretyping/evd.cmi \ - pretyping/inductiveops.cmi kernel/names.cmi library/nametab.cmi \ - pretyping/rawterm.cmi kernel/reduction.cmi pretyping/reductionops.cmi \ - kernel/sign.cmi kernel/term.cmi pretyping/termops.cmi \ - kernel/type_errors.cmi lib/util.cmi pretyping/pretype_errors.cmi -pretyping/pretype_errors.cmx: kernel/environ.cmx pretyping/evd.cmx \ - pretyping/inductiveops.cmx kernel/names.cmx library/nametab.cmx \ - pretyping/rawterm.cmx kernel/reduction.cmx pretyping/reductionops.cmx \ - kernel/sign.cmx kernel/term.cmx pretyping/termops.cmx \ - kernel/type_errors.cmx lib/util.cmx pretyping/pretype_errors.cmi -pretyping/pretyping.cmo: pretyping/cases.cmi pretyping/classops.cmi \ - pretyping/coercion.cmi kernel/declarations.cmi lib/dyn.cmi \ - kernel/environ.cmi pretyping/evarconv.cmi pretyping/evarutil.cmi \ - pretyping/evd.cmi kernel/inductive.cmi pretyping/inductiveops.cmi \ - library/libnames.cmi library/nameops.cmi kernel/names.cmi \ - pretyping/pattern.cmi lib/pp.cmi pretyping/pretype_errors.cmi \ - pretyping/rawterm.cmi pretyping/recordops.cmi pretyping/reductionops.cmi \ - pretyping/retyping.cmi kernel/sign.cmi kernel/term.cmi \ - pretyping/termops.cmi kernel/type_errors.cmi kernel/typeops.cmi \ - lib/util.cmi pretyping/pretyping.cmi -pretyping/pretyping.cmx: pretyping/cases.cmx pretyping/classops.cmx \ - pretyping/coercion.cmx kernel/declarations.cmx lib/dyn.cmx \ - kernel/environ.cmx pretyping/evarconv.cmx pretyping/evarutil.cmx \ - pretyping/evd.cmx kernel/inductive.cmx pretyping/inductiveops.cmx \ - library/libnames.cmx library/nameops.cmx kernel/names.cmx \ - pretyping/pattern.cmx lib/pp.cmx pretyping/pretype_errors.cmx \ - pretyping/rawterm.cmx pretyping/recordops.cmx pretyping/reductionops.cmx \ - pretyping/retyping.cmx kernel/sign.cmx kernel/term.cmx \ - pretyping/termops.cmx kernel/type_errors.cmx kernel/typeops.cmx \ - lib/util.cmx pretyping/pretyping.cmi -pretyping/rawterm.cmo: lib/dyn.cmi pretyping/evd.cmi library/libnames.cmi \ - kernel/names.cmi library/nametab.cmi kernel/sign.cmi kernel/term.cmi \ - kernel/univ.cmi lib/util.cmi pretyping/rawterm.cmi -pretyping/rawterm.cmx: lib/dyn.cmx pretyping/evd.cmx library/libnames.cmx \ - kernel/names.cmx library/nametab.cmx kernel/sign.cmx kernel/term.cmx \ - kernel/univ.cmx lib/util.cmx pretyping/rawterm.cmi -pretyping/recordops.cmo: pretyping/classops.cmi kernel/declarations.cmi \ - kernel/environ.cmi pretyping/evd.cmi library/global.cmi \ - pretyping/inductiveops.cmi library/lib.cmi library/libnames.cmi \ - library/libobject.cmi library/library.cmi kernel/mod_subst.cmi \ - library/nameops.cmi kernel/names.cmi library/nametab.cmi lib/pp.cmi \ - pretyping/reductionops.cmi library/summary.cmi kernel/term.cmi \ - pretyping/termops.cmi kernel/typeops.cmi lib/util.cmi \ - pretyping/recordops.cmi -pretyping/recordops.cmx: pretyping/classops.cmx kernel/declarations.cmx \ - kernel/environ.cmx pretyping/evd.cmx library/global.cmx \ - pretyping/inductiveops.cmx library/lib.cmx library/libnames.cmx \ - library/libobject.cmx library/library.cmx kernel/mod_subst.cmx \ - library/nameops.cmx kernel/names.cmx library/nametab.cmx lib/pp.cmx \ - pretyping/reductionops.cmx library/summary.cmx kernel/term.cmx \ - pretyping/termops.cmx kernel/typeops.cmx lib/util.cmx \ - pretyping/recordops.cmi -pretyping/reductionops.cmo: kernel/closure.cmi kernel/declarations.cmi \ - kernel/environ.cmi kernel/esubst.cmi pretyping/evd.cmi kernel/names.cmi \ - lib/pp.cmi kernel/reduction.cmi kernel/sign.cmi kernel/term.cmi \ - pretyping/termops.cmi kernel/univ.cmi lib/util.cmi \ - pretyping/reductionops.cmi -pretyping/reductionops.cmx: kernel/closure.cmx kernel/declarations.cmx \ - kernel/environ.cmx kernel/esubst.cmx pretyping/evd.cmx kernel/names.cmx \ - lib/pp.cmx kernel/reduction.cmx kernel/sign.cmx kernel/term.cmx \ - pretyping/termops.cmx kernel/univ.cmx lib/util.cmx \ - pretyping/reductionops.cmi -pretyping/retyping.cmo: kernel/declarations.cmi kernel/environ.cmi \ - pretyping/evd.cmi kernel/inductive.cmi pretyping/inductiveops.cmi \ - kernel/names.cmi pretyping/reductionops.cmi kernel/term.cmi \ - kernel/typeops.cmi kernel/univ.cmi lib/util.cmi pretyping/retyping.cmi -pretyping/retyping.cmx: kernel/declarations.cmx kernel/environ.cmx \ - pretyping/evd.cmx kernel/inductive.cmx pretyping/inductiveops.cmx \ - kernel/names.cmx pretyping/reductionops.cmx kernel/term.cmx \ - kernel/typeops.cmx kernel/univ.cmx lib/util.cmx pretyping/retyping.cmi -pretyping/tacred.cmo: pretyping/cbv.cmi kernel/closure.cmi \ - kernel/conv_oracle.cmi kernel/declarations.cmi kernel/environ.cmi \ - pretyping/evd.cmi kernel/inductive.cmi library/libnames.cmi \ - library/nameops.cmi kernel/names.cmi library/nametab.cmi lib/pp.cmi \ - pretyping/rawterm.cmi pretyping/reductionops.cmi pretyping/retyping.cmi \ - library/summary.cmi kernel/term.cmi pretyping/termops.cmi \ - kernel/type_errors.cmi pretyping/typing.cmi lib/util.cmi \ +pretyping/coercion.cmo: lib/util.cmi kernel/typeops.cmi kernel/term.cmi \ + pretyping/retyping.cmi pretyping/reductionops.cmi kernel/reduction.cmi \ + pretyping/recordops.cmi pretyping/rawterm.cmi \ + pretyping/pretype_errors.cmi lib/pp.cmi kernel/names.cmi \ + pretyping/evd.cmi pretyping/evarutil.cmi pretyping/evarconv.cmi \ + kernel/environ.cmi pretyping/classops.cmi pretyping/coercion.cmi +pretyping/coercion.cmx: lib/util.cmx kernel/typeops.cmx kernel/term.cmx \ + pretyping/retyping.cmx pretyping/reductionops.cmx kernel/reduction.cmx \ + pretyping/recordops.cmx pretyping/rawterm.cmx \ + pretyping/pretype_errors.cmx lib/pp.cmx kernel/names.cmx \ + pretyping/evd.cmx pretyping/evarutil.cmx pretyping/evarconv.cmx \ + kernel/environ.cmx pretyping/classops.cmx pretyping/coercion.cmi +pretyping/detyping.cmo: lib/util.cmi kernel/univ.cmi pretyping/termops.cmi \ + kernel/term.cmi kernel/sign.cmi pretyping/rawterm.cmi lib/pp.cmi \ + lib/options.cmi library/nametab.cmi kernel/names.cmi library/nameops.cmi \ + kernel/mod_subst.cmi library/libnames.cmi pretyping/inductiveops.cmi \ + kernel/inductive.cmi library/goptions.cmi library/global.cmi \ + pretyping/evd.cmi kernel/environ.cmi kernel/declarations.cmi \ + pretyping/detyping.cmi +pretyping/detyping.cmx: lib/util.cmx kernel/univ.cmx pretyping/termops.cmx \ + kernel/term.cmx kernel/sign.cmx pretyping/rawterm.cmx lib/pp.cmx \ + lib/options.cmx library/nametab.cmx kernel/names.cmx library/nameops.cmx \ + kernel/mod_subst.cmx library/libnames.cmx pretyping/inductiveops.cmx \ + kernel/inductive.cmx library/goptions.cmx library/global.cmx \ + pretyping/evd.cmx kernel/environ.cmx kernel/declarations.cmx \ + pretyping/detyping.cmi +pretyping/evarconv.cmo: lib/util.cmi pretyping/typing.cmi kernel/term.cmi \ + pretyping/reductionops.cmi kernel/reduction.cmi pretyping/recordops.cmi \ + kernel/names.cmi library/libnames.cmi pretyping/evd.cmi \ + pretyping/evarutil.cmi kernel/environ.cmi kernel/closure.cmi \ + pretyping/classops.cmi pretyping/evarconv.cmi +pretyping/evarconv.cmx: lib/util.cmx pretyping/typing.cmx kernel/term.cmx \ + pretyping/reductionops.cmx kernel/reduction.cmx pretyping/recordops.cmx \ + kernel/names.cmx library/libnames.cmx pretyping/evd.cmx \ + pretyping/evarutil.cmx kernel/environ.cmx kernel/closure.cmx \ + pretyping/classops.cmx pretyping/evarconv.cmi +pretyping/evarutil.cmo: lib/util.cmi kernel/univ.cmi pretyping/typing.cmi \ + kernel/typeops.cmi pretyping/termops.cmi kernel/term.cmi kernel/sign.cmi \ + pretyping/reductionops.cmi kernel/reduction.cmi \ + pretyping/pretype_errors.cmi lib/pp.cmi kernel/names.cmi \ + library/nameops.cmi pretyping/evd.cmi kernel/environ.cmi \ + pretyping/evarutil.cmi +pretyping/evarutil.cmx: lib/util.cmx kernel/univ.cmx pretyping/typing.cmx \ + kernel/typeops.cmx pretyping/termops.cmx kernel/term.cmx kernel/sign.cmx \ + pretyping/reductionops.cmx kernel/reduction.cmx \ + pretyping/pretype_errors.cmx lib/pp.cmx kernel/names.cmx \ + library/nameops.cmx pretyping/evd.cmx kernel/environ.cmx \ + pretyping/evarutil.cmi +pretyping/evd.cmo: lib/util.cmi kernel/univ.cmi pretyping/termops.cmi \ + kernel/term.cmi kernel/sign.cmi kernel/reduction.cmi lib/pp.cmi \ + kernel/names.cmi library/nameops.cmi kernel/mod_subst.cmi \ + library/libnames.cmi library/global.cmi kernel/environ.cmi \ + pretyping/evd.cmi +pretyping/evd.cmx: lib/util.cmx kernel/univ.cmx pretyping/termops.cmx \ + kernel/term.cmx kernel/sign.cmx kernel/reduction.cmx lib/pp.cmx \ + kernel/names.cmx library/nameops.cmx kernel/mod_subst.cmx \ + library/libnames.cmx library/global.cmx kernel/environ.cmx \ + pretyping/evd.cmi +pretyping/indrec.cmo: lib/util.cmi kernel/typeops.cmi kernel/type_errors.cmi \ + pretyping/termops.cmi kernel/term.cmi kernel/sign.cmi \ + kernel/safe_typing.cmi pretyping/reductionops.cmi kernel/reduction.cmi \ + lib/pp.cmi lib/options.cmi library/nametab.cmi kernel/names.cmi \ + library/nameops.cmi library/libnames.cmi pretyping/inductiveops.cmi \ + kernel/inductive.cmi library/global.cmi kernel/environ.cmi \ + kernel/entries.cmi kernel/declarations.cmi pretyping/indrec.cmi +pretyping/indrec.cmx: lib/util.cmx kernel/typeops.cmx kernel/type_errors.cmx \ + pretyping/termops.cmx kernel/term.cmx kernel/sign.cmx \ + kernel/safe_typing.cmx pretyping/reductionops.cmx kernel/reduction.cmx \ + lib/pp.cmx lib/options.cmx library/nametab.cmx kernel/names.cmx \ + library/nameops.cmx library/libnames.cmx pretyping/inductiveops.cmx \ + kernel/inductive.cmx library/global.cmx kernel/environ.cmx \ + kernel/entries.cmx kernel/declarations.cmx pretyping/indrec.cmi +pretyping/inductiveops.cmo: lib/util.cmi kernel/univ.cmi \ + pretyping/termops.cmi kernel/term.cmi kernel/sign.cmi \ + pretyping/reductionops.cmi kernel/names.cmi kernel/mod_subst.cmi \ + kernel/inductive.cmi library/global.cmi pretyping/evd.cmi \ + kernel/environ.cmi kernel/declarations.cmi pretyping/inductiveops.cmi +pretyping/inductiveops.cmx: lib/util.cmx kernel/univ.cmx \ + pretyping/termops.cmx kernel/term.cmx kernel/sign.cmx \ + pretyping/reductionops.cmx kernel/names.cmx kernel/mod_subst.cmx \ + kernel/inductive.cmx library/global.cmx pretyping/evd.cmx \ + kernel/environ.cmx kernel/declarations.cmx pretyping/inductiveops.cmi +pretyping/matching.cmo: lib/util.cmi pretyping/termops.cmi kernel/term.cmi \ + kernel/sign.cmi pretyping/reductionops.cmi pretyping/rawterm.cmi \ + pretyping/pattern.cmi kernel/names.cmi library/nameops.cmi \ + library/libnames.cmi kernel/environ.cmi pretyping/matching.cmi +pretyping/matching.cmx: lib/util.cmx pretyping/termops.cmx kernel/term.cmx \ + kernel/sign.cmx pretyping/reductionops.cmx pretyping/rawterm.cmx \ + pretyping/pattern.cmx kernel/names.cmx library/nameops.cmx \ + library/libnames.cmx kernel/environ.cmx pretyping/matching.cmi +pretyping/pattern.cmo: lib/util.cmi kernel/term.cmi pretyping/rawterm.cmi \ + lib/pp.cmi lib/options.cmi library/nametab.cmi kernel/names.cmi \ + library/nameops.cmi kernel/mod_subst.cmi library/libnames.cmi \ + pretyping/inductiveops.cmi pretyping/evd.cmi kernel/environ.cmi \ + pretyping/pattern.cmi +pretyping/pattern.cmx: lib/util.cmx kernel/term.cmx pretyping/rawterm.cmx \ + lib/pp.cmx lib/options.cmx library/nametab.cmx kernel/names.cmx \ + library/nameops.cmx kernel/mod_subst.cmx library/libnames.cmx \ + pretyping/inductiveops.cmx pretyping/evd.cmx kernel/environ.cmx \ + pretyping/pattern.cmi +pretyping/pretype_errors.cmo: lib/util.cmi kernel/type_errors.cmi \ + pretyping/termops.cmi kernel/term.cmi kernel/sign.cmi \ + pretyping/reductionops.cmi kernel/reduction.cmi pretyping/rawterm.cmi \ + library/nametab.cmi kernel/names.cmi pretyping/inductiveops.cmi \ + pretyping/evd.cmi kernel/environ.cmi pretyping/pretype_errors.cmi +pretyping/pretype_errors.cmx: lib/util.cmx kernel/type_errors.cmx \ + pretyping/termops.cmx kernel/term.cmx kernel/sign.cmx \ + pretyping/reductionops.cmx kernel/reduction.cmx pretyping/rawterm.cmx \ + library/nametab.cmx kernel/names.cmx pretyping/inductiveops.cmx \ + pretyping/evd.cmx kernel/environ.cmx pretyping/pretype_errors.cmi +pretyping/pretyping.cmo: lib/util.cmi kernel/typeops.cmi \ + kernel/type_errors.cmi pretyping/termops.cmi kernel/term.cmi \ + kernel/sign.cmi pretyping/retyping.cmi pretyping/reductionops.cmi \ + pretyping/recordops.cmi pretyping/rawterm.cmi \ + pretyping/pretype_errors.cmi lib/pp.cmi pretyping/pattern.cmi \ + kernel/names.cmi library/nameops.cmi library/libnames.cmi \ + pretyping/inductiveops.cmi kernel/inductive.cmi pretyping/evd.cmi \ + pretyping/evarutil.cmi pretyping/evarconv.cmi kernel/environ.cmi \ + lib/dyn.cmi kernel/declarations.cmi pretyping/coercion.cmi \ + pretyping/classops.cmi pretyping/cases.cmi pretyping/pretyping.cmi +pretyping/pretyping.cmx: lib/util.cmx kernel/typeops.cmx \ + kernel/type_errors.cmx pretyping/termops.cmx kernel/term.cmx \ + kernel/sign.cmx pretyping/retyping.cmx pretyping/reductionops.cmx \ + pretyping/recordops.cmx pretyping/rawterm.cmx \ + pretyping/pretype_errors.cmx lib/pp.cmx pretyping/pattern.cmx \ + kernel/names.cmx library/nameops.cmx library/libnames.cmx \ + pretyping/inductiveops.cmx kernel/inductive.cmx pretyping/evd.cmx \ + pretyping/evarutil.cmx pretyping/evarconv.cmx kernel/environ.cmx \ + lib/dyn.cmx kernel/declarations.cmx pretyping/coercion.cmx \ + pretyping/classops.cmx pretyping/cases.cmx pretyping/pretyping.cmi +pretyping/rawterm.cmo: lib/util.cmi kernel/univ.cmi kernel/term.cmi \ + kernel/sign.cmi library/nametab.cmi kernel/names.cmi library/libnames.cmi \ + pretyping/evd.cmi lib/dyn.cmi pretyping/rawterm.cmi +pretyping/rawterm.cmx: lib/util.cmx kernel/univ.cmx kernel/term.cmx \ + kernel/sign.cmx library/nametab.cmx kernel/names.cmx library/libnames.cmx \ + pretyping/evd.cmx lib/dyn.cmx pretyping/rawterm.cmi +pretyping/recordops.cmo: lib/util.cmi kernel/typeops.cmi \ + pretyping/termops.cmi kernel/term.cmi library/summary.cmi \ + pretyping/reductionops.cmi lib/pp.cmi library/nametab.cmi \ + kernel/names.cmi library/nameops.cmi kernel/mod_subst.cmi \ + library/library.cmi library/libobject.cmi library/libnames.cmi \ + library/lib.cmi pretyping/inductiveops.cmi library/global.cmi \ + pretyping/evd.cmi kernel/environ.cmi kernel/declarations.cmi \ + pretyping/classops.cmi pretyping/recordops.cmi +pretyping/recordops.cmx: lib/util.cmx kernel/typeops.cmx \ + pretyping/termops.cmx kernel/term.cmx library/summary.cmx \ + pretyping/reductionops.cmx lib/pp.cmx library/nametab.cmx \ + kernel/names.cmx library/nameops.cmx kernel/mod_subst.cmx \ + library/library.cmx library/libobject.cmx library/libnames.cmx \ + library/lib.cmx pretyping/inductiveops.cmx library/global.cmx \ + pretyping/evd.cmx kernel/environ.cmx kernel/declarations.cmx \ + pretyping/classops.cmx pretyping/recordops.cmi +pretyping/reductionops.cmo: lib/util.cmi kernel/univ.cmi \ + pretyping/termops.cmi kernel/term.cmi kernel/sign.cmi \ + kernel/reduction.cmi lib/pp.cmi kernel/names.cmi pretyping/evd.cmi \ + kernel/esubst.cmi kernel/environ.cmi kernel/declarations.cmi \ + kernel/closure.cmi pretyping/reductionops.cmi +pretyping/reductionops.cmx: lib/util.cmx kernel/univ.cmx \ + pretyping/termops.cmx kernel/term.cmx kernel/sign.cmx \ + kernel/reduction.cmx lib/pp.cmx kernel/names.cmx pretyping/evd.cmx \ + kernel/esubst.cmx kernel/environ.cmx kernel/declarations.cmx \ + kernel/closure.cmx pretyping/reductionops.cmi +pretyping/retyping.cmo: lib/util.cmi kernel/univ.cmi kernel/typeops.cmi \ + kernel/term.cmi pretyping/reductionops.cmi kernel/names.cmi \ + pretyping/inductiveops.cmi kernel/inductive.cmi pretyping/evd.cmi \ + kernel/environ.cmi kernel/declarations.cmi pretyping/retyping.cmi +pretyping/retyping.cmx: lib/util.cmx kernel/univ.cmx kernel/typeops.cmx \ + kernel/term.cmx pretyping/reductionops.cmx kernel/names.cmx \ + pretyping/inductiveops.cmx kernel/inductive.cmx pretyping/evd.cmx \ + kernel/environ.cmx kernel/declarations.cmx pretyping/retyping.cmi +pretyping/tacred.cmo: lib/util.cmi pretyping/typing.cmi \ + kernel/type_errors.cmi pretyping/termops.cmi kernel/term.cmi \ + library/summary.cmi pretyping/retyping.cmi pretyping/reductionops.cmi \ + pretyping/rawterm.cmi lib/pp.cmi library/nametab.cmi kernel/names.cmi \ + library/nameops.cmi library/libnames.cmi kernel/inductive.cmi \ + pretyping/evd.cmi kernel/environ.cmi kernel/declarations.cmi \ + kernel/conv_oracle.cmi kernel/closure.cmi pretyping/cbv.cmi \ pretyping/tacred.cmi -pretyping/tacred.cmx: pretyping/cbv.cmx kernel/closure.cmx \ - kernel/conv_oracle.cmx kernel/declarations.cmx kernel/environ.cmx \ - pretyping/evd.cmx kernel/inductive.cmx library/libnames.cmx \ - library/nameops.cmx kernel/names.cmx library/nametab.cmx lib/pp.cmx \ - pretyping/rawterm.cmx pretyping/reductionops.cmx pretyping/retyping.cmx \ - library/summary.cmx kernel/term.cmx pretyping/termops.cmx \ - kernel/type_errors.cmx pretyping/typing.cmx lib/util.cmx \ +pretyping/tacred.cmx: lib/util.cmx pretyping/typing.cmx \ + kernel/type_errors.cmx pretyping/termops.cmx kernel/term.cmx \ + library/summary.cmx pretyping/retyping.cmx pretyping/reductionops.cmx \ + pretyping/rawterm.cmx lib/pp.cmx library/nametab.cmx kernel/names.cmx \ + library/nameops.cmx library/libnames.cmx kernel/inductive.cmx \ + pretyping/evd.cmx kernel/environ.cmx kernel/declarations.cmx \ + kernel/conv_oracle.cmx kernel/closure.cmx pretyping/cbv.cmx \ pretyping/tacred.cmi -pretyping/termops.cmo: kernel/environ.cmi library/global.cmi library/lib.cmi \ - library/libnames.cmi library/nameops.cmi kernel/names.cmi \ - library/nametab.cmi lib/pp.cmi kernel/sign.cmi kernel/term.cmi \ - kernel/univ.cmi lib/util.cmi pretyping/termops.cmi -pretyping/termops.cmx: kernel/environ.cmx library/global.cmx library/lib.cmx \ - library/libnames.cmx library/nameops.cmx kernel/names.cmx \ - library/nametab.cmx lib/pp.cmx kernel/sign.cmx kernel/term.cmx \ - kernel/univ.cmx lib/util.cmx pretyping/termops.cmi -pretyping/typing.cmo: kernel/environ.cmi pretyping/evd.cmi \ - kernel/inductive.cmi pretyping/inductiveops.cmi kernel/names.cmi \ - pretyping/pretype_errors.cmi pretyping/reductionops.cmi kernel/term.cmi \ - kernel/type_errors.cmi kernel/typeops.cmi lib/util.cmi \ - pretyping/typing.cmi -pretyping/typing.cmx: kernel/environ.cmx pretyping/evd.cmx \ - kernel/inductive.cmx pretyping/inductiveops.cmx kernel/names.cmx \ - pretyping/pretype_errors.cmx pretyping/reductionops.cmx kernel/term.cmx \ - kernel/type_errors.cmx kernel/typeops.cmx lib/util.cmx \ - pretyping/typing.cmi -pretyping/unification.cmo: kernel/environ.cmi pretyping/evarutil.cmi \ - pretyping/evd.cmi library/global.cmi library/nameops.cmi kernel/names.cmi \ - pretyping/pattern.cmi lib/pp.cmi pretyping/pretype_errors.cmi \ - pretyping/rawterm.cmi kernel/reduction.cmi pretyping/reductionops.cmi \ - pretyping/retyping.cmi kernel/sign.cmi kernel/term.cmi \ - pretyping/termops.cmi pretyping/typing.cmi lib/util.cmi \ - pretyping/unification.cmi -pretyping/unification.cmx: kernel/environ.cmx pretyping/evarutil.cmx \ - pretyping/evd.cmx library/global.cmx library/nameops.cmx kernel/names.cmx \ - pretyping/pattern.cmx lib/pp.cmx pretyping/pretype_errors.cmx \ - pretyping/rawterm.cmx kernel/reduction.cmx pretyping/reductionops.cmx \ - pretyping/retyping.cmx kernel/sign.cmx kernel/term.cmx \ - pretyping/termops.cmx pretyping/typing.cmx lib/util.cmx \ - pretyping/unification.cmi -proofs/clenvtac.cmo: pretyping/clenv.cmi kernel/environ.cmi \ - proofs/evar_refiner.cmi pretyping/evarutil.cmi pretyping/evd.cmi \ - proofs/logic.cmi library/nameops.cmi kernel/names.cmi \ - pretyping/pattern.cmi lib/pp.cmi proofs/proof_trees.cmi \ - proofs/proof_type.cmi pretyping/rawterm.cmi kernel/reduction.cmi \ - pretyping/reductionops.cmi proofs/refiner.cmi kernel/sign.cmi \ - proofs/tacexpr.cmo proofs/tacmach.cmi kernel/term.cmi \ - pretyping/termops.cmi pretyping/typing.cmi pretyping/unification.cmi \ - lib/util.cmi proofs/clenvtac.cmi -proofs/clenvtac.cmx: pretyping/clenv.cmx kernel/environ.cmx \ - proofs/evar_refiner.cmx pretyping/evarutil.cmx pretyping/evd.cmx \ - proofs/logic.cmx library/nameops.cmx kernel/names.cmx \ - pretyping/pattern.cmx lib/pp.cmx proofs/proof_trees.cmx \ - proofs/proof_type.cmx pretyping/rawterm.cmx kernel/reduction.cmx \ - pretyping/reductionops.cmx proofs/refiner.cmx kernel/sign.cmx \ - proofs/tacexpr.cmx proofs/tacmach.cmx kernel/term.cmx \ - pretyping/termops.cmx pretyping/typing.cmx pretyping/unification.cmx \ - lib/util.cmx proofs/clenvtac.cmi -proofs/evar_refiner.cmo: interp/constrintern.cmi pretyping/evarutil.cmi \ - pretyping/evd.cmi kernel/names.cmi pretyping/pretyping.cmi \ - proofs/proof_trees.cmi proofs/refiner.cmi kernel/sign.cmi kernel/term.cmi \ - lib/util.cmi proofs/evar_refiner.cmi -proofs/evar_refiner.cmx: interp/constrintern.cmx pretyping/evarutil.cmx \ - pretyping/evd.cmx kernel/names.cmx pretyping/pretyping.cmx \ - proofs/proof_trees.cmx proofs/refiner.cmx kernel/sign.cmx kernel/term.cmx \ - lib/util.cmx proofs/evar_refiner.cmi -proofs/logic.cmo: kernel/environ.cmi pretyping/evarutil.cmi pretyping/evd.cmi \ - library/global.cmi pretyping/indrec.cmi kernel/inductive.cmi \ - pretyping/inductiveops.cmi library/nameops.cmi kernel/names.cmi \ - library/nametab.cmi lib/options.cmi lib/pp.cmi \ - pretyping/pretype_errors.cmi proofs/proof_trees.cmi proofs/proof_type.cmi \ - pretyping/reductionops.cmi pretyping/retyping.cmi kernel/sign.cmi \ - kernel/term.cmi pretyping/termops.cmi kernel/type_errors.cmi \ - kernel/typeops.cmi pretyping/typing.cmi lib/util.cmi proofs/logic.cmi -proofs/logic.cmx: kernel/environ.cmx pretyping/evarutil.cmx pretyping/evd.cmx \ - library/global.cmx pretyping/indrec.cmx kernel/inductive.cmx \ - pretyping/inductiveops.cmx library/nameops.cmx kernel/names.cmx \ - library/nametab.cmx lib/options.cmx lib/pp.cmx \ - pretyping/pretype_errors.cmx proofs/proof_trees.cmx proofs/proof_type.cmx \ - pretyping/reductionops.cmx pretyping/retyping.cmx kernel/sign.cmx \ - kernel/term.cmx pretyping/termops.cmx kernel/type_errors.cmx \ - kernel/typeops.cmx pretyping/typing.cmx lib/util.cmx proofs/logic.cmi -proofs/pfedit.cmo: library/decl_kinds.cmo kernel/declarations.cmi \ - lib/edit.cmi kernel/entries.cmi kernel/environ.cmi \ - proofs/evar_refiner.cmi pretyping/evd.cmi library/lib.cmi \ - library/nameops.cmi kernel/names.cmi lib/pp.cmi proofs/proof_trees.cmi \ - proofs/proof_type.cmi proofs/refiner.cmi kernel/safe_typing.cmi \ - kernel/sign.cmi proofs/tacexpr.cmo kernel/term.cmi pretyping/typing.cmi \ - lib/util.cmi proofs/pfedit.cmi -proofs/pfedit.cmx: library/decl_kinds.cmx kernel/declarations.cmx \ - lib/edit.cmx kernel/entries.cmx kernel/environ.cmx \ - proofs/evar_refiner.cmx pretyping/evd.cmx library/lib.cmx \ - library/nameops.cmx kernel/names.cmx lib/pp.cmx proofs/proof_trees.cmx \ - proofs/proof_type.cmx proofs/refiner.cmx kernel/safe_typing.cmx \ - kernel/sign.cmx proofs/tacexpr.cmx kernel/term.cmx pretyping/typing.cmx \ - lib/util.cmx proofs/pfedit.cmi -proofs/proof_trees.cmo: kernel/closure.cmi pretyping/detyping.cmi \ - kernel/environ.cmi pretyping/evarutil.cmi pretyping/evd.cmi \ - library/libnames.cmi library/nameops.cmi kernel/names.cmi \ - library/nametab.cmi lib/pp.cmi proofs/proof_type.cmi kernel/sign.cmi \ - pretyping/tacred.cmi kernel/term.cmi pretyping/termops.cmi \ - pretyping/typing.cmi lib/util.cmi proofs/proof_trees.cmi -proofs/proof_trees.cmx: kernel/closure.cmx pretyping/detyping.cmx \ - kernel/environ.cmx pretyping/evarutil.cmx pretyping/evd.cmx \ - library/libnames.cmx library/nameops.cmx kernel/names.cmx \ - library/nametab.cmx lib/pp.cmx proofs/proof_type.cmx kernel/sign.cmx \ - pretyping/tacred.cmx kernel/term.cmx pretyping/termops.cmx \ - pretyping/typing.cmx lib/util.cmx proofs/proof_trees.cmi -proofs/proof_type.cmo: kernel/environ.cmi pretyping/evd.cmi interp/genarg.cmi \ - library/libnames.cmi kernel/names.cmi library/nametab.cmi \ - pretyping/pattern.cmi pretyping/rawterm.cmi proofs/tacexpr.cmo \ - kernel/term.cmi lib/util.cmi proofs/proof_type.cmi -proofs/proof_type.cmx: kernel/environ.cmx pretyping/evd.cmx interp/genarg.cmx \ - library/libnames.cmx kernel/names.cmx library/nametab.cmx \ - pretyping/pattern.cmx pretyping/rawterm.cmx proofs/tacexpr.cmx \ - kernel/term.cmx lib/util.cmx proofs/proof_type.cmi -proofs/redexpr.cmo: kernel/closure.cmi kernel/conv_oracle.cmi \ - kernel/csymtable.cmi kernel/declarations.cmi kernel/environ.cmi \ - library/global.cmi library/libnames.cmi kernel/names.cmi \ - library/nametab.cmi lib/pp.cmi pretyping/rawterm.cmi \ - pretyping/reductionops.cmi library/summary.cmi pretyping/tacred.cmi \ - kernel/term.cmi kernel/typeops.cmi lib/util.cmi kernel/vconv.cmi \ +pretyping/termops.cmo: lib/util.cmi kernel/univ.cmi kernel/term.cmi \ + kernel/sign.cmi lib/pp.cmi library/nametab.cmi kernel/names.cmi \ + library/nameops.cmi library/libnames.cmi library/lib.cmi \ + library/global.cmi kernel/environ.cmi pretyping/termops.cmi +pretyping/termops.cmx: lib/util.cmx kernel/univ.cmx kernel/term.cmx \ + kernel/sign.cmx lib/pp.cmx library/nametab.cmx kernel/names.cmx \ + library/nameops.cmx library/libnames.cmx library/lib.cmx \ + library/global.cmx kernel/environ.cmx pretyping/termops.cmi +pretyping/typing.cmo: lib/util.cmi kernel/typeops.cmi kernel/type_errors.cmi \ + kernel/term.cmi pretyping/reductionops.cmi pretyping/pretype_errors.cmi \ + kernel/names.cmi pretyping/inductiveops.cmi kernel/inductive.cmi \ + pretyping/evd.cmi kernel/environ.cmi pretyping/typing.cmi +pretyping/typing.cmx: lib/util.cmx kernel/typeops.cmx kernel/type_errors.cmx \ + kernel/term.cmx pretyping/reductionops.cmx pretyping/pretype_errors.cmx \ + kernel/names.cmx pretyping/inductiveops.cmx kernel/inductive.cmx \ + pretyping/evd.cmx kernel/environ.cmx pretyping/typing.cmi +pretyping/unification.cmo: lib/util.cmi pretyping/typing.cmi \ + pretyping/termops.cmi kernel/term.cmi kernel/sign.cmi \ + pretyping/retyping.cmi pretyping/reductionops.cmi kernel/reduction.cmi \ + pretyping/rawterm.cmi pretyping/pretype_errors.cmi lib/pp.cmi \ + pretyping/pattern.cmi kernel/names.cmi library/nameops.cmi \ + library/global.cmi pretyping/evd.cmi pretyping/evarutil.cmi \ + kernel/environ.cmi pretyping/unification.cmi +pretyping/unification.cmx: lib/util.cmx pretyping/typing.cmx \ + pretyping/termops.cmx kernel/term.cmx kernel/sign.cmx \ + pretyping/retyping.cmx pretyping/reductionops.cmx kernel/reduction.cmx \ + pretyping/rawterm.cmx pretyping/pretype_errors.cmx lib/pp.cmx \ + pretyping/pattern.cmx kernel/names.cmx library/nameops.cmx \ + library/global.cmx pretyping/evd.cmx pretyping/evarutil.cmx \ + kernel/environ.cmx pretyping/unification.cmi +proofs/clenvtac.cmo: lib/util.cmi pretyping/unification.cmi \ + pretyping/typing.cmi pretyping/termops.cmi kernel/term.cmi \ + proofs/tacmach.cmi proofs/tacexpr.cmo kernel/sign.cmi proofs/refiner.cmi \ + pretyping/reductionops.cmi kernel/reduction.cmi pretyping/rawterm.cmi \ + proofs/proof_type.cmi proofs/proof_trees.cmi lib/pp.cmi \ + pretyping/pattern.cmi kernel/names.cmi library/nameops.cmi \ + proofs/logic.cmi pretyping/evd.cmi pretyping/evarutil.cmi \ + proofs/evar_refiner.cmi kernel/environ.cmi pretyping/clenv.cmi \ + proofs/clenvtac.cmi +proofs/clenvtac.cmx: lib/util.cmx pretyping/unification.cmx \ + pretyping/typing.cmx pretyping/termops.cmx kernel/term.cmx \ + proofs/tacmach.cmx proofs/tacexpr.cmx kernel/sign.cmx proofs/refiner.cmx \ + pretyping/reductionops.cmx kernel/reduction.cmx pretyping/rawterm.cmx \ + proofs/proof_type.cmx proofs/proof_trees.cmx lib/pp.cmx \ + pretyping/pattern.cmx kernel/names.cmx library/nameops.cmx \ + proofs/logic.cmx pretyping/evd.cmx pretyping/evarutil.cmx \ + proofs/evar_refiner.cmx kernel/environ.cmx pretyping/clenv.cmx \ + proofs/clenvtac.cmi +proofs/evar_refiner.cmo: lib/util.cmi kernel/term.cmi kernel/sign.cmi \ + proofs/refiner.cmi proofs/proof_trees.cmi pretyping/pretyping.cmi \ + kernel/names.cmi pretyping/evd.cmi pretyping/evarutil.cmi \ + interp/constrintern.cmi proofs/evar_refiner.cmi +proofs/evar_refiner.cmx: lib/util.cmx kernel/term.cmx kernel/sign.cmx \ + proofs/refiner.cmx proofs/proof_trees.cmx pretyping/pretyping.cmx \ + kernel/names.cmx pretyping/evd.cmx pretyping/evarutil.cmx \ + interp/constrintern.cmx proofs/evar_refiner.cmi +proofs/logic.cmo: lib/util.cmi pretyping/typing.cmi kernel/typeops.cmi \ + kernel/type_errors.cmi pretyping/termops.cmi kernel/term.cmi \ + kernel/sign.cmi pretyping/retyping.cmi pretyping/reductionops.cmi \ + proofs/proof_type.cmi proofs/proof_trees.cmi pretyping/pretype_errors.cmi \ + lib/pp.cmi lib/options.cmi library/nametab.cmi kernel/names.cmi \ + library/nameops.cmi pretyping/inductiveops.cmi kernel/inductive.cmi \ + pretyping/indrec.cmi library/global.cmi pretyping/evd.cmi \ + pretyping/evarutil.cmi kernel/environ.cmi proofs/logic.cmi +proofs/logic.cmx: lib/util.cmx pretyping/typing.cmx kernel/typeops.cmx \ + kernel/type_errors.cmx pretyping/termops.cmx kernel/term.cmx \ + kernel/sign.cmx pretyping/retyping.cmx pretyping/reductionops.cmx \ + proofs/proof_type.cmx proofs/proof_trees.cmx pretyping/pretype_errors.cmx \ + lib/pp.cmx lib/options.cmx library/nametab.cmx kernel/names.cmx \ + library/nameops.cmx pretyping/inductiveops.cmx kernel/inductive.cmx \ + pretyping/indrec.cmx library/global.cmx pretyping/evd.cmx \ + pretyping/evarutil.cmx kernel/environ.cmx proofs/logic.cmi +proofs/pfedit.cmo: lib/util.cmi pretyping/typing.cmi kernel/term.cmi \ + proofs/tacexpr.cmo kernel/sign.cmi kernel/safe_typing.cmi \ + proofs/refiner.cmi proofs/proof_type.cmi proofs/proof_trees.cmi \ + lib/pp.cmi kernel/names.cmi library/nameops.cmi library/lib.cmi \ + pretyping/evd.cmi proofs/evar_refiner.cmi kernel/environ.cmi \ + kernel/entries.cmi lib/edit.cmi kernel/declarations.cmi \ + library/decl_kinds.cmo proofs/pfedit.cmi +proofs/pfedit.cmx: lib/util.cmx pretyping/typing.cmx kernel/term.cmx \ + proofs/tacexpr.cmx kernel/sign.cmx kernel/safe_typing.cmx \ + proofs/refiner.cmx proofs/proof_type.cmx proofs/proof_trees.cmx \ + lib/pp.cmx kernel/names.cmx library/nameops.cmx library/lib.cmx \ + pretyping/evd.cmx proofs/evar_refiner.cmx kernel/environ.cmx \ + kernel/entries.cmx lib/edit.cmx kernel/declarations.cmx \ + library/decl_kinds.cmx proofs/pfedit.cmi +proofs/proof_trees.cmo: lib/util.cmi pretyping/typing.cmi \ + pretyping/termops.cmi kernel/term.cmi pretyping/tacred.cmi \ + kernel/sign.cmi proofs/proof_type.cmi lib/pp.cmi library/nametab.cmi \ + kernel/names.cmi library/nameops.cmi library/libnames.cmi \ + pretyping/evd.cmi pretyping/evarutil.cmi kernel/environ.cmi \ + pretyping/detyping.cmi kernel/closure.cmi proofs/proof_trees.cmi +proofs/proof_trees.cmx: lib/util.cmx pretyping/typing.cmx \ + pretyping/termops.cmx kernel/term.cmx pretyping/tacred.cmx \ + kernel/sign.cmx proofs/proof_type.cmx lib/pp.cmx library/nametab.cmx \ + kernel/names.cmx library/nameops.cmx library/libnames.cmx \ + pretyping/evd.cmx pretyping/evarutil.cmx kernel/environ.cmx \ + pretyping/detyping.cmx kernel/closure.cmx proofs/proof_trees.cmi +proofs/proof_type.cmo: lib/util.cmi kernel/term.cmi proofs/tacexpr.cmo \ + pretyping/rawterm.cmi pretyping/pattern.cmi library/nametab.cmi \ + kernel/names.cmi library/libnames.cmi interp/genarg.cmi pretyping/evd.cmi \ + kernel/environ.cmi proofs/proof_type.cmi +proofs/proof_type.cmx: lib/util.cmx kernel/term.cmx proofs/tacexpr.cmx \ + pretyping/rawterm.cmx pretyping/pattern.cmx library/nametab.cmx \ + kernel/names.cmx library/libnames.cmx interp/genarg.cmx pretyping/evd.cmx \ + kernel/environ.cmx proofs/proof_type.cmi +proofs/redexpr.cmo: kernel/vconv.cmi lib/util.cmi kernel/typeops.cmi \ + kernel/term.cmi pretyping/tacred.cmi library/summary.cmi \ + pretyping/reductionops.cmi pretyping/rawterm.cmi lib/pp.cmi \ + library/nametab.cmi kernel/names.cmi library/libnames.cmi \ + library/global.cmi kernel/environ.cmi kernel/declarations.cmi \ + kernel/csymtable.cmi kernel/conv_oracle.cmi kernel/closure.cmi \ proofs/redexpr.cmi -proofs/redexpr.cmx: kernel/closure.cmx kernel/conv_oracle.cmx \ - kernel/csymtable.cmx kernel/declarations.cmx kernel/environ.cmx \ - library/global.cmx library/libnames.cmx kernel/names.cmx \ - library/nametab.cmx lib/pp.cmx pretyping/rawterm.cmx \ - pretyping/reductionops.cmx library/summary.cmx pretyping/tacred.cmx \ - kernel/term.cmx kernel/typeops.cmx lib/util.cmx kernel/vconv.cmx \ +proofs/redexpr.cmx: kernel/vconv.cmx lib/util.cmx kernel/typeops.cmx \ + kernel/term.cmx pretyping/tacred.cmx library/summary.cmx \ + pretyping/reductionops.cmx pretyping/rawterm.cmx lib/pp.cmx \ + library/nametab.cmx kernel/names.cmx library/libnames.cmx \ + library/global.cmx kernel/environ.cmx kernel/declarations.cmx \ + kernel/csymtable.cmx kernel/conv_oracle.cmx kernel/closure.cmx \ proofs/redexpr.cmi -proofs/refiner.cmo: kernel/environ.cmi pretyping/evarutil.cmi \ - pretyping/evd.cmi library/global.cmi proofs/logic.cmi lib/pp.cmi \ - proofs/proof_trees.cmi proofs/proof_type.cmi pretyping/reductionops.cmi \ - kernel/sign.cmi proofs/tacexpr.cmo kernel/term.cmi pretyping/termops.cmi \ - kernel/type_errors.cmi lib/util.cmi proofs/refiner.cmi -proofs/refiner.cmx: kernel/environ.cmx pretyping/evarutil.cmx \ - pretyping/evd.cmx library/global.cmx proofs/logic.cmx lib/pp.cmx \ - proofs/proof_trees.cmx proofs/proof_type.cmx pretyping/reductionops.cmx \ - kernel/sign.cmx proofs/tacexpr.cmx kernel/term.cmx pretyping/termops.cmx \ - kernel/type_errors.cmx lib/util.cmx proofs/refiner.cmi -proofs/tacexpr.cmo: library/decl_kinds.cmo lib/dyn.cmi interp/genarg.cmi \ - library/libnames.cmi kernel/names.cmi library/nametab.cmi \ - pretyping/pattern.cmi pretyping/rawterm.cmi kernel/term.cmi \ - interp/topconstr.cmi lib/util.cmi -proofs/tacexpr.cmx: library/decl_kinds.cmx lib/dyn.cmx interp/genarg.cmx \ - library/libnames.cmx kernel/names.cmx library/nametab.cmx \ - pretyping/pattern.cmx pretyping/rawterm.cmx kernel/term.cmx \ - interp/topconstr.cmx lib/util.cmx -proofs/tacmach.cmo: interp/constrintern.cmi kernel/environ.cmi \ - pretyping/evd.cmi library/global.cmi proofs/logic.cmi library/nameops.cmi \ - kernel/names.cmi lib/pp.cmi proofs/proof_trees.cmi proofs/proof_type.cmi \ - pretyping/rawterm.cmi proofs/redexpr.cmi pretyping/reductionops.cmi \ - proofs/refiner.cmi kernel/sign.cmi proofs/tacexpr.cmo \ - pretyping/tacred.cmi kernel/term.cmi pretyping/termops.cmi \ - pretyping/typing.cmi lib/util.cmi proofs/tacmach.cmi -proofs/tacmach.cmx: interp/constrintern.cmx kernel/environ.cmx \ - pretyping/evd.cmx library/global.cmx proofs/logic.cmx library/nameops.cmx \ - kernel/names.cmx lib/pp.cmx proofs/proof_trees.cmx proofs/proof_type.cmx \ - pretyping/rawterm.cmx proofs/redexpr.cmx pretyping/reductionops.cmx \ - proofs/refiner.cmx kernel/sign.cmx proofs/tacexpr.cmx \ - pretyping/tacred.cmx kernel/term.cmx pretyping/termops.cmx \ - pretyping/typing.cmx lib/util.cmx proofs/tacmach.cmi -proofs/tactic_debug.cmo: interp/constrextern.cmi proofs/logic.cmi \ - kernel/names.cmi lib/pp.cmi proofs/proof_trees.cmi proofs/refiner.cmi \ - proofs/tacexpr.cmo pretyping/termops.cmi proofs/tactic_debug.cmi -proofs/tactic_debug.cmx: interp/constrextern.cmx proofs/logic.cmx \ - kernel/names.cmx lib/pp.cmx proofs/proof_trees.cmx proofs/refiner.cmx \ - proofs/tacexpr.cmx pretyping/termops.cmx proofs/tactic_debug.cmi -scripts/coqc.cmo: config/coq_config.cmi toplevel/usage.cmi -scripts/coqc.cmx: config/coq_config.cmx toplevel/usage.cmx -scripts/coqmktop.cmo: config/coq_config.cmi scripts/tolink.cmo -scripts/coqmktop.cmx: config/coq_config.cmx scripts/tolink.cmx -tactics/auto.cmo: tactics/btermdn.cmi pretyping/clenv.cmi \ - interp/constrintern.cmi kernel/declarations.cmi tactics/dhyp.cmi \ - kernel/environ.cmi proofs/evar_refiner.cmi pretyping/evd.cmi \ - interp/genarg.cmi library/global.cmi lib/gmap.cmi tactics/hiddentac.cmi \ - tactics/hipattern.cmi kernel/inductive.cmi library/lib.cmi \ - library/libnames.cmi library/libobject.cmi library/library.cmi \ - proofs/logic.cmi pretyping/matching.cmi kernel/mod_subst.cmi \ - library/nameops.cmi kernel/names.cmi library/nametab.cmi lib/options.cmi \ - pretyping/pattern.cmi proofs/pfedit.cmi lib/pp.cmi parsing/pptactic.cmi \ - parsing/printer.cmi proofs/proof_type.cmi pretyping/rawterm.cmi \ - kernel/reduction.cmi proofs/refiner.cmi kernel/sign.cmi \ - library/summary.cmi proofs/tacexpr.cmo proofs/tacmach.cmi \ - pretyping/tacred.cmi tactics/tacticals.cmi tactics/tactics.cmi \ - kernel/term.cmi pretyping/termops.cmi pretyping/typing.cmi lib/util.cmi \ - toplevel/vernacexpr.cmo tactics/auto.cmi -tactics/auto.cmx: tactics/btermdn.cmx pretyping/clenv.cmx \ - interp/constrintern.cmx kernel/declarations.cmx tactics/dhyp.cmx \ - kernel/environ.cmx proofs/evar_refiner.cmx pretyping/evd.cmx \ - interp/genarg.cmx library/global.cmx lib/gmap.cmx tactics/hiddentac.cmx \ - tactics/hipattern.cmx kernel/inductive.cmx library/lib.cmx \ - library/libnames.cmx library/libobject.cmx library/library.cmx \ - proofs/logic.cmx pretyping/matching.cmx kernel/mod_subst.cmx \ - library/nameops.cmx kernel/names.cmx library/nametab.cmx lib/options.cmx \ - pretyping/pattern.cmx proofs/pfedit.cmx lib/pp.cmx parsing/pptactic.cmx \ - parsing/printer.cmx proofs/proof_type.cmx pretyping/rawterm.cmx \ - kernel/reduction.cmx proofs/refiner.cmx kernel/sign.cmx \ - library/summary.cmx proofs/tacexpr.cmx proofs/tacmach.cmx \ - pretyping/tacred.cmx tactics/tacticals.cmx tactics/tactics.cmx \ - kernel/term.cmx pretyping/termops.cmx pretyping/typing.cmx lib/util.cmx \ - toplevel/vernacexpr.cmx tactics/auto.cmi -tactics/autorewrite.cmo: kernel/environ.cmi tactics/equality.cmi \ - pretyping/evd.cmi library/global.cmi tactics/hipattern.cmi \ - library/lib.cmi library/libobject.cmi kernel/mod_subst.cmi \ - kernel/names.cmi lib/pp.cmi parsing/pptactic.cmi parsing/printer.cmi \ - proofs/proof_type.cmi library/summary.cmi proofs/tacexpr.cmo \ - tactics/tacinterp.cmi proofs/tacmach.cmi tactics/tacticals.cmi \ - tactics/tactics.cmi kernel/term.cmi pretyping/typing.cmi lib/util.cmi \ - toplevel/vernacinterp.cmi tactics/autorewrite.cmi -tactics/autorewrite.cmx: kernel/environ.cmx tactics/equality.cmx \ - pretyping/evd.cmx library/global.cmx tactics/hipattern.cmx \ - library/lib.cmx library/libobject.cmx kernel/mod_subst.cmx \ - kernel/names.cmx lib/pp.cmx parsing/pptactic.cmx parsing/printer.cmx \ - proofs/proof_type.cmx library/summary.cmx proofs/tacexpr.cmx \ - tactics/tacinterp.cmx proofs/tacmach.cmx tactics/tacticals.cmx \ - tactics/tactics.cmx kernel/term.cmx pretyping/typing.cmx lib/util.cmx \ - toplevel/vernacinterp.cmx tactics/autorewrite.cmi -tactics/btermdn.cmo: tactics/dn.cmi library/libnames.cmi \ - pretyping/pattern.cmi kernel/term.cmi tactics/termdn.cmi \ - tactics/btermdn.cmi -tactics/btermdn.cmx: tactics/dn.cmx library/libnames.cmx \ - pretyping/pattern.cmx kernel/term.cmx tactics/termdn.cmx \ - tactics/btermdn.cmi -tactics/contradiction.cmo: interp/coqlib.cmi tactics/hipattern.cmi \ - proofs/proof_type.cmi pretyping/rawterm.cmi pretyping/reductionops.cmi \ - proofs/tacmach.cmi tactics/tacticals.cmi tactics/tactics.cmi \ - kernel/term.cmi lib/util.cmi tactics/contradiction.cmi -tactics/contradiction.cmx: interp/coqlib.cmx tactics/hipattern.cmx \ - proofs/proof_type.cmx pretyping/rawterm.cmx pretyping/reductionops.cmx \ - proofs/tacmach.cmx tactics/tacticals.cmx tactics/tactics.cmx \ - kernel/term.cmx lib/util.cmx tactics/contradiction.cmi -tactics/dhyp.cmo: pretyping/clenv.cmi interp/constrintern.cmi \ - kernel/environ.cmi pretyping/evd.cmi library/global.cmi library/lib.cmi \ - library/libnames.cmi library/libobject.cmi library/library.cmi \ - pretyping/matching.cmi kernel/names.cmi tactics/nbtermdn.cmi \ - pretyping/pattern.cmi parsing/pcoq.cmi lib/pp.cmi proofs/proof_type.cmi \ - pretyping/rawterm.cmi kernel/reduction.cmi proofs/refiner.cmi \ - library/summary.cmi proofs/tacexpr.cmo proofs/tacmach.cmi \ - tactics/tacticals.cmi tactics/tactics.cmi kernel/term.cmi lib/util.cmi \ +proofs/refiner.cmo: lib/util.cmi kernel/type_errors.cmi pretyping/termops.cmi \ + kernel/term.cmi proofs/tacexpr.cmo kernel/sign.cmi \ + pretyping/reductionops.cmi proofs/proof_type.cmi proofs/proof_trees.cmi \ + lib/pp.cmi proofs/logic.cmi library/global.cmi pretyping/evd.cmi \ + pretyping/evarutil.cmi kernel/environ.cmi proofs/refiner.cmi +proofs/refiner.cmx: lib/util.cmx kernel/type_errors.cmx pretyping/termops.cmx \ + kernel/term.cmx proofs/tacexpr.cmx kernel/sign.cmx \ + pretyping/reductionops.cmx proofs/proof_type.cmx proofs/proof_trees.cmx \ + lib/pp.cmx proofs/logic.cmx library/global.cmx pretyping/evd.cmx \ + pretyping/evarutil.cmx kernel/environ.cmx proofs/refiner.cmi +proofs/tacexpr.cmo: lib/util.cmi interp/topconstr.cmi kernel/term.cmi \ + pretyping/rawterm.cmi pretyping/pattern.cmi library/nametab.cmi \ + kernel/names.cmi library/libnames.cmi interp/genarg.cmi lib/dyn.cmi \ + library/decl_kinds.cmo +proofs/tacexpr.cmx: lib/util.cmx interp/topconstr.cmx kernel/term.cmx \ + pretyping/rawterm.cmx pretyping/pattern.cmx library/nametab.cmx \ + kernel/names.cmx library/libnames.cmx interp/genarg.cmx lib/dyn.cmx \ + library/decl_kinds.cmx +proofs/tacmach.cmo: lib/util.cmi pretyping/typing.cmi pretyping/termops.cmi \ + kernel/term.cmi pretyping/tacred.cmi proofs/tacexpr.cmo kernel/sign.cmi \ + proofs/refiner.cmi pretyping/reductionops.cmi proofs/redexpr.cmi \ + pretyping/rawterm.cmi proofs/proof_type.cmi proofs/proof_trees.cmi \ + lib/pp.cmi kernel/names.cmi library/nameops.cmi proofs/logic.cmi \ + library/global.cmi pretyping/evd.cmi kernel/environ.cmi \ + interp/constrintern.cmi proofs/tacmach.cmi +proofs/tacmach.cmx: lib/util.cmx pretyping/typing.cmx pretyping/termops.cmx \ + kernel/term.cmx pretyping/tacred.cmx proofs/tacexpr.cmx kernel/sign.cmx \ + proofs/refiner.cmx pretyping/reductionops.cmx proofs/redexpr.cmx \ + pretyping/rawterm.cmx proofs/proof_type.cmx proofs/proof_trees.cmx \ + lib/pp.cmx kernel/names.cmx library/nameops.cmx proofs/logic.cmx \ + library/global.cmx pretyping/evd.cmx kernel/environ.cmx \ + interp/constrintern.cmx proofs/tacmach.cmi +proofs/tactic_debug.cmo: pretyping/termops.cmi proofs/tacexpr.cmo \ + proofs/refiner.cmi proofs/proof_trees.cmi lib/pp.cmi kernel/names.cmi \ + proofs/logic.cmi interp/constrextern.cmi proofs/tactic_debug.cmi +proofs/tactic_debug.cmx: pretyping/termops.cmx proofs/tacexpr.cmx \ + proofs/refiner.cmx proofs/proof_trees.cmx lib/pp.cmx kernel/names.cmx \ + proofs/logic.cmx interp/constrextern.cmx proofs/tactic_debug.cmi +scripts/coqc.cmo: toplevel/usage.cmi config/coq_config.cmi +scripts/coqc.cmx: toplevel/usage.cmx config/coq_config.cmx +scripts/coqmktop.cmo: scripts/tolink.cmo config/coq_config.cmi +scripts/coqmktop.cmx: scripts/tolink.cmx config/coq_config.cmx +tactics/auto.cmo: toplevel/vernacexpr.cmo lib/util.cmi pretyping/typing.cmi \ + pretyping/termops.cmi kernel/term.cmi tactics/tactics.cmi \ + tactics/tacticals.cmi pretyping/tacred.cmi proofs/tacmach.cmi \ + proofs/tacexpr.cmo library/summary.cmi kernel/sign.cmi proofs/refiner.cmi \ + kernel/reduction.cmi pretyping/rawterm.cmi proofs/proof_type.cmi \ + parsing/printer.cmi parsing/pptactic.cmi lib/pp.cmi proofs/pfedit.cmi \ + pretyping/pattern.cmi lib/options.cmi library/nametab.cmi \ + kernel/names.cmi library/nameops.cmi kernel/mod_subst.cmi \ + pretyping/matching.cmi proofs/logic.cmi library/library.cmi \ + library/libobject.cmi library/libnames.cmi library/lib.cmi \ + kernel/inductive.cmi tactics/hipattern.cmi tactics/hiddentac.cmi \ + lib/gmap.cmi library/global.cmi pretyping/evd.cmi proofs/evar_refiner.cmi \ + kernel/environ.cmi tactics/dhyp.cmi kernel/declarations.cmi \ + interp/constrintern.cmi pretyping/clenv.cmi tactics/btermdn.cmi \ + tactics/auto.cmi +tactics/auto.cmx: toplevel/vernacexpr.cmx lib/util.cmx pretyping/typing.cmx \ + pretyping/termops.cmx kernel/term.cmx tactics/tactics.cmx \ + tactics/tacticals.cmx pretyping/tacred.cmx proofs/tacmach.cmx \ + proofs/tacexpr.cmx library/summary.cmx kernel/sign.cmx proofs/refiner.cmx \ + kernel/reduction.cmx pretyping/rawterm.cmx proofs/proof_type.cmx \ + parsing/printer.cmx parsing/pptactic.cmx lib/pp.cmx proofs/pfedit.cmx \ + pretyping/pattern.cmx lib/options.cmx library/nametab.cmx \ + kernel/names.cmx library/nameops.cmx kernel/mod_subst.cmx \ + pretyping/matching.cmx proofs/logic.cmx library/library.cmx \ + library/libobject.cmx library/libnames.cmx library/lib.cmx \ + kernel/inductive.cmx tactics/hipattern.cmx tactics/hiddentac.cmx \ + lib/gmap.cmx library/global.cmx pretyping/evd.cmx proofs/evar_refiner.cmx \ + kernel/environ.cmx tactics/dhyp.cmx kernel/declarations.cmx \ + interp/constrintern.cmx pretyping/clenv.cmx tactics/btermdn.cmx \ + tactics/auto.cmi +tactics/autorewrite.cmo: toplevel/vernacinterp.cmi lib/util.cmi \ + pretyping/typing.cmi kernel/term.cmi tactics/tactics.cmi \ + tactics/tacticals.cmi proofs/tacmach.cmi tactics/tacinterp.cmi \ + proofs/tacexpr.cmo library/summary.cmi proofs/proof_type.cmi \ + parsing/printer.cmi parsing/pptactic.cmi lib/pp.cmi kernel/names.cmi \ + kernel/mod_subst.cmi library/libobject.cmi library/lib.cmi \ + tactics/hipattern.cmi library/global.cmi pretyping/evd.cmi \ + tactics/equality.cmi kernel/environ.cmi tactics/autorewrite.cmi +tactics/autorewrite.cmx: toplevel/vernacinterp.cmx lib/util.cmx \ + pretyping/typing.cmx kernel/term.cmx tactics/tactics.cmx \ + tactics/tacticals.cmx proofs/tacmach.cmx tactics/tacinterp.cmx \ + proofs/tacexpr.cmx library/summary.cmx proofs/proof_type.cmx \ + parsing/printer.cmx parsing/pptactic.cmx lib/pp.cmx kernel/names.cmx \ + kernel/mod_subst.cmx library/libobject.cmx library/lib.cmx \ + tactics/hipattern.cmx library/global.cmx pretyping/evd.cmx \ + tactics/equality.cmx kernel/environ.cmx tactics/autorewrite.cmi +tactics/btermdn.cmo: tactics/termdn.cmi kernel/term.cmi pretyping/pattern.cmi \ + library/libnames.cmi tactics/dn.cmi tactics/btermdn.cmi +tactics/btermdn.cmx: tactics/termdn.cmx kernel/term.cmx pretyping/pattern.cmx \ + library/libnames.cmx tactics/dn.cmx tactics/btermdn.cmi +tactics/contradiction.cmo: lib/util.cmi kernel/term.cmi tactics/tactics.cmi \ + tactics/tacticals.cmi proofs/tacmach.cmi pretyping/reductionops.cmi \ + pretyping/rawterm.cmi proofs/proof_type.cmi tactics/hipattern.cmi \ + interp/coqlib.cmi tactics/contradiction.cmi +tactics/contradiction.cmx: lib/util.cmx kernel/term.cmx tactics/tactics.cmx \ + tactics/tacticals.cmx proofs/tacmach.cmx pretyping/reductionops.cmx \ + pretyping/rawterm.cmx proofs/proof_type.cmx tactics/hipattern.cmx \ + interp/coqlib.cmx tactics/contradiction.cmi +tactics/dhyp.cmo: lib/util.cmi kernel/term.cmi tactics/tactics.cmi \ + tactics/tacticals.cmi proofs/tacmach.cmi proofs/tacexpr.cmo \ + library/summary.cmi proofs/refiner.cmi kernel/reduction.cmi \ + pretyping/rawterm.cmi proofs/proof_type.cmi lib/pp.cmi parsing/pcoq.cmi \ + pretyping/pattern.cmi tactics/nbtermdn.cmi kernel/names.cmi \ + pretyping/matching.cmi library/library.cmi library/libobject.cmi \ + library/libnames.cmi library/lib.cmi library/global.cmi pretyping/evd.cmi \ + kernel/environ.cmi interp/constrintern.cmi pretyping/clenv.cmi \ tactics/dhyp.cmi -tactics/dhyp.cmx: pretyping/clenv.cmx interp/constrintern.cmx \ - kernel/environ.cmx pretyping/evd.cmx library/global.cmx library/lib.cmx \ - library/libnames.cmx library/libobject.cmx library/library.cmx \ - pretyping/matching.cmx kernel/names.cmx tactics/nbtermdn.cmx \ - pretyping/pattern.cmx parsing/pcoq.cmx lib/pp.cmx proofs/proof_type.cmx \ - pretyping/rawterm.cmx kernel/reduction.cmx proofs/refiner.cmx \ - library/summary.cmx proofs/tacexpr.cmx proofs/tacmach.cmx \ - tactics/tacticals.cmx tactics/tactics.cmx kernel/term.cmx lib/util.cmx \ +tactics/dhyp.cmx: lib/util.cmx kernel/term.cmx tactics/tactics.cmx \ + tactics/tacticals.cmx proofs/tacmach.cmx proofs/tacexpr.cmx \ + library/summary.cmx proofs/refiner.cmx kernel/reduction.cmx \ + pretyping/rawterm.cmx proofs/proof_type.cmx lib/pp.cmx parsing/pcoq.cmx \ + pretyping/pattern.cmx tactics/nbtermdn.cmx kernel/names.cmx \ + pretyping/matching.cmx library/library.cmx library/libobject.cmx \ + library/libnames.cmx library/lib.cmx library/global.cmx pretyping/evd.cmx \ + kernel/environ.cmx interp/constrintern.cmx pretyping/clenv.cmx \ tactics/dhyp.cmi tactics/dn.cmo: lib/tlm.cmi tactics/dn.cmi tactics/dn.cmx: lib/tlm.cmx tactics/dn.cmi -tactics/eauto.cmo: tactics/auto.cmi toplevel/cerrors.cmi pretyping/clenv.cmi \ - proofs/clenvtac.cmi kernel/declarations.cmi parsing/egrammar.cmi \ - proofs/evar_refiner.cmi lib/explore.cmi interp/genarg.cmi \ - library/global.cmi parsing/lexer.cmi proofs/logic.cmi library/nameops.cmi \ - kernel/names.cmi pretyping/pattern.cmi parsing/pcoq.cmi lib/pp.cmi \ - parsing/pptactic.cmi proofs/proof_trees.cmi proofs/proof_type.cmi \ - pretyping/rawterm.cmi kernel/reduction.cmi proofs/refiner.cmi \ - kernel/sign.cmi proofs/tacexpr.cmo tactics/tacinterp.cmi \ - proofs/tacmach.cmi tactics/tacticals.cmi tactics/tactics.cmi \ - kernel/term.cmi pretyping/termops.cmi lib/util.cmi tactics/eauto.cmi -tactics/eauto.cmx: tactics/auto.cmx toplevel/cerrors.cmx pretyping/clenv.cmx \ - proofs/clenvtac.cmx kernel/declarations.cmx parsing/egrammar.cmx \ - proofs/evar_refiner.cmx lib/explore.cmx interp/genarg.cmx \ - library/global.cmx parsing/lexer.cmx proofs/logic.cmx library/nameops.cmx \ - kernel/names.cmx pretyping/pattern.cmx parsing/pcoq.cmx lib/pp.cmx \ - parsing/pptactic.cmx proofs/proof_trees.cmx proofs/proof_type.cmx \ - pretyping/rawterm.cmx kernel/reduction.cmx proofs/refiner.cmx \ - kernel/sign.cmx proofs/tacexpr.cmx tactics/tacinterp.cmx \ - proofs/tacmach.cmx tactics/tacticals.cmx tactics/tactics.cmx \ - kernel/term.cmx pretyping/termops.cmx lib/util.cmx tactics/eauto.cmi -tactics/elim.cmo: pretyping/clenv.cmi kernel/environ.cmi interp/genarg.cmi \ - tactics/hiddentac.cmi tactics/hipattern.cmi pretyping/inductiveops.cmi \ - library/libnames.cmi kernel/names.cmi lib/pp.cmi parsing/printer.cmi \ - proofs/proof_type.cmi kernel/reduction.cmi proofs/refiner.cmi \ - proofs/tacexpr.cmo proofs/tacmach.cmi tactics/tacticals.cmi \ - tactics/tactics.cmi kernel/term.cmi pretyping/termops.cmi lib/util.cmi \ - tactics/elim.cmi -tactics/elim.cmx: pretyping/clenv.cmx kernel/environ.cmx interp/genarg.cmx \ - tactics/hiddentac.cmx tactics/hipattern.cmx pretyping/inductiveops.cmx \ - library/libnames.cmx kernel/names.cmx lib/pp.cmx parsing/printer.cmx \ - proofs/proof_type.cmx kernel/reduction.cmx proofs/refiner.cmx \ - proofs/tacexpr.cmx proofs/tacmach.cmx tactics/tacticals.cmx \ - tactics/tactics.cmx kernel/term.cmx pretyping/termops.cmx lib/util.cmx \ - tactics/elim.cmi -tactics/eqdecide.cmo: tactics/auto.cmi toplevel/cerrors.cmi interp/coqlib.cmi \ - kernel/declarations.cmi parsing/egrammar.cmi tactics/equality.cmi \ - tactics/extratactics.cmi interp/genarg.cmi library/global.cmi \ - tactics/hiddentac.cmi tactics/hipattern.cmi pretyping/matching.cmi \ - library/nameops.cmi kernel/names.cmi pretyping/pattern.cmi \ - parsing/pcoq.cmi lib/pp.cmi parsing/pptactic.cmi proofs/proof_trees.cmi \ - proofs/proof_type.cmi pretyping/rawterm.cmi proofs/refiner.cmi \ - proofs/tacexpr.cmo tactics/tacinterp.cmi proofs/tacmach.cmi \ - tactics/tacticals.cmi tactics/tactics.cmi kernel/term.cmi lib/util.cmi -tactics/eqdecide.cmx: tactics/auto.cmx toplevel/cerrors.cmx interp/coqlib.cmx \ - kernel/declarations.cmx parsing/egrammar.cmx tactics/equality.cmx \ - tactics/extratactics.cmx interp/genarg.cmx library/global.cmx \ - tactics/hiddentac.cmx tactics/hipattern.cmx pretyping/matching.cmx \ - library/nameops.cmx kernel/names.cmx pretyping/pattern.cmx \ - parsing/pcoq.cmx lib/pp.cmx parsing/pptactic.cmx proofs/proof_trees.cmx \ - proofs/proof_type.cmx pretyping/rawterm.cmx proofs/refiner.cmx \ - proofs/tacexpr.cmx tactics/tacinterp.cmx proofs/tacmach.cmx \ - tactics/tacticals.cmx tactics/tactics.cmx kernel/term.cmx lib/util.cmx -tactics/equality.cmo: interp/coqlib.cmi kernel/declarations.cmi \ - kernel/environ.cmi proofs/evar_refiner.cmi pretyping/evarconv.cmi \ - pretyping/evarutil.cmi pretyping/evd.cmi tactics/hipattern.cmi \ - pretyping/indrec.cmi kernel/inductive.cmi pretyping/inductiveops.cmi \ - library/libnames.cmi proofs/logic.cmi pretyping/matching.cmi \ - library/nameops.cmi kernel/names.cmi pretyping/pattern.cmi lib/pp.cmi \ - proofs/proof_type.cmi pretyping/rawterm.cmi pretyping/reductionops.cmi \ - pretyping/retyping.cmi tactics/setoid_replace.cmi kernel/sign.cmi \ - proofs/tacexpr.cmo proofs/tacmach.cmi pretyping/tacred.cmi \ - tactics/tacticals.cmi tactics/tactics.cmi kernel/term.cmi \ - pretyping/termops.cmi kernel/typeops.cmi pretyping/typing.cmi \ - kernel/univ.cmi lib/util.cmi toplevel/vernacexpr.cmo tactics/equality.cmi -tactics/equality.cmx: interp/coqlib.cmx kernel/declarations.cmx \ - kernel/environ.cmx proofs/evar_refiner.cmx pretyping/evarconv.cmx \ - pretyping/evarutil.cmx pretyping/evd.cmx tactics/hipattern.cmx \ - pretyping/indrec.cmx kernel/inductive.cmx pretyping/inductiveops.cmx \ - library/libnames.cmx proofs/logic.cmx pretyping/matching.cmx \ - library/nameops.cmx kernel/names.cmx pretyping/pattern.cmx lib/pp.cmx \ - proofs/proof_type.cmx pretyping/rawterm.cmx pretyping/reductionops.cmx \ - pretyping/retyping.cmx tactics/setoid_replace.cmx kernel/sign.cmx \ - proofs/tacexpr.cmx proofs/tacmach.cmx pretyping/tacred.cmx \ - tactics/tacticals.cmx tactics/tactics.cmx kernel/term.cmx \ - pretyping/termops.cmx kernel/typeops.cmx pretyping/typing.cmx \ - kernel/univ.cmx lib/util.cmx toplevel/vernacexpr.cmx tactics/equality.cmi -tactics/evar_tactics.cmo: kernel/environ.cmi proofs/evar_refiner.cmi \ - pretyping/evarutil.cmi pretyping/evd.cmi proofs/proof_type.cmi \ - proofs/refiner.cmi kernel/sign.cmi proofs/tacexpr.cmo proofs/tacmach.cmi \ - tactics/tactics.cmi kernel/term.cmi pretyping/termops.cmi lib/util.cmi \ +tactics/eauto.cmo: lib/util.cmi pretyping/termops.cmi kernel/term.cmi \ + tactics/tactics.cmi tactics/tacticals.cmi proofs/tacmach.cmi \ + tactics/tacinterp.cmi proofs/tacexpr.cmo kernel/sign.cmi \ + proofs/refiner.cmi kernel/reduction.cmi pretyping/rawterm.cmi \ + proofs/proof_type.cmi proofs/proof_trees.cmi parsing/pptactic.cmi \ + lib/pp.cmi parsing/pcoq.cmi pretyping/pattern.cmi kernel/names.cmi \ + library/nameops.cmi proofs/logic.cmi parsing/lexer.cmi library/global.cmi \ + interp/genarg.cmi lib/explore.cmi proofs/evar_refiner.cmi \ + parsing/egrammar.cmi kernel/declarations.cmi proofs/clenvtac.cmi \ + pretyping/clenv.cmi toplevel/cerrors.cmi tactics/auto.cmi \ + tactics/eauto.cmi +tactics/eauto.cmx: lib/util.cmx pretyping/termops.cmx kernel/term.cmx \ + tactics/tactics.cmx tactics/tacticals.cmx proofs/tacmach.cmx \ + tactics/tacinterp.cmx proofs/tacexpr.cmx kernel/sign.cmx \ + proofs/refiner.cmx kernel/reduction.cmx pretyping/rawterm.cmx \ + proofs/proof_type.cmx proofs/proof_trees.cmx parsing/pptactic.cmx \ + lib/pp.cmx parsing/pcoq.cmx pretyping/pattern.cmx kernel/names.cmx \ + library/nameops.cmx proofs/logic.cmx parsing/lexer.cmx library/global.cmx \ + interp/genarg.cmx lib/explore.cmx proofs/evar_refiner.cmx \ + parsing/egrammar.cmx kernel/declarations.cmx proofs/clenvtac.cmx \ + pretyping/clenv.cmx toplevel/cerrors.cmx tactics/auto.cmx \ + tactics/eauto.cmi +tactics/elim.cmo: lib/util.cmi pretyping/termops.cmi kernel/term.cmi \ + tactics/tactics.cmi tactics/tacticals.cmi proofs/tacmach.cmi \ + proofs/tacexpr.cmo proofs/refiner.cmi kernel/reduction.cmi \ + proofs/proof_type.cmi parsing/printer.cmi lib/pp.cmi kernel/names.cmi \ + library/libnames.cmi pretyping/inductiveops.cmi tactics/hipattern.cmi \ + tactics/hiddentac.cmi interp/genarg.cmi kernel/environ.cmi \ + pretyping/clenv.cmi tactics/elim.cmi +tactics/elim.cmx: lib/util.cmx pretyping/termops.cmx kernel/term.cmx \ + tactics/tactics.cmx tactics/tacticals.cmx proofs/tacmach.cmx \ + proofs/tacexpr.cmx proofs/refiner.cmx kernel/reduction.cmx \ + proofs/proof_type.cmx parsing/printer.cmx lib/pp.cmx kernel/names.cmx \ + library/libnames.cmx pretyping/inductiveops.cmx tactics/hipattern.cmx \ + tactics/hiddentac.cmx interp/genarg.cmx kernel/environ.cmx \ + pretyping/clenv.cmx tactics/elim.cmi +tactics/eqdecide.cmo: lib/util.cmi kernel/term.cmi tactics/tactics.cmi \ + tactics/tacticals.cmi proofs/tacmach.cmi tactics/tacinterp.cmi \ + proofs/tacexpr.cmo proofs/refiner.cmi pretyping/rawterm.cmi \ + proofs/proof_type.cmi proofs/proof_trees.cmi parsing/pptactic.cmi \ + lib/pp.cmi parsing/pcoq.cmi pretyping/pattern.cmi kernel/names.cmi \ + library/nameops.cmi pretyping/matching.cmi tactics/hipattern.cmi \ + tactics/hiddentac.cmi library/global.cmi interp/genarg.cmi \ + tactics/extratactics.cmi tactics/equality.cmi parsing/egrammar.cmi \ + kernel/declarations.cmi interp/coqlib.cmi toplevel/cerrors.cmi \ + tactics/auto.cmi +tactics/eqdecide.cmx: lib/util.cmx kernel/term.cmx tactics/tactics.cmx \ + tactics/tacticals.cmx proofs/tacmach.cmx tactics/tacinterp.cmx \ + proofs/tacexpr.cmx proofs/refiner.cmx pretyping/rawterm.cmx \ + proofs/proof_type.cmx proofs/proof_trees.cmx parsing/pptactic.cmx \ + lib/pp.cmx parsing/pcoq.cmx pretyping/pattern.cmx kernel/names.cmx \ + library/nameops.cmx pretyping/matching.cmx tactics/hipattern.cmx \ + tactics/hiddentac.cmx library/global.cmx interp/genarg.cmx \ + tactics/extratactics.cmx tactics/equality.cmx parsing/egrammar.cmx \ + kernel/declarations.cmx interp/coqlib.cmx toplevel/cerrors.cmx \ + tactics/auto.cmx +tactics/equality.cmo: toplevel/vernacexpr.cmo lib/util.cmi kernel/univ.cmi \ + pretyping/typing.cmi kernel/typeops.cmi pretyping/termops.cmi \ + kernel/term.cmi tactics/tactics.cmi tactics/tacticals.cmi \ + pretyping/tacred.cmi proofs/tacmach.cmi proofs/tacexpr.cmo \ + kernel/sign.cmi tactics/setoid_replace.cmi pretyping/retyping.cmi \ + pretyping/reductionops.cmi pretyping/rawterm.cmi proofs/proof_type.cmi \ + lib/pp.cmi pretyping/pattern.cmi kernel/names.cmi library/nameops.cmi \ + pretyping/matching.cmi proofs/logic.cmi library/libnames.cmi \ + pretyping/inductiveops.cmi kernel/inductive.cmi pretyping/indrec.cmi \ + tactics/hipattern.cmi pretyping/evd.cmi pretyping/evarutil.cmi \ + pretyping/evarconv.cmi proofs/evar_refiner.cmi kernel/environ.cmi \ + kernel/declarations.cmi interp/coqlib.cmi tactics/equality.cmi +tactics/equality.cmx: toplevel/vernacexpr.cmx lib/util.cmx kernel/univ.cmx \ + pretyping/typing.cmx kernel/typeops.cmx pretyping/termops.cmx \ + kernel/term.cmx tactics/tactics.cmx tactics/tacticals.cmx \ + pretyping/tacred.cmx proofs/tacmach.cmx proofs/tacexpr.cmx \ + kernel/sign.cmx tactics/setoid_replace.cmx pretyping/retyping.cmx \ + pretyping/reductionops.cmx pretyping/rawterm.cmx proofs/proof_type.cmx \ + lib/pp.cmx pretyping/pattern.cmx kernel/names.cmx library/nameops.cmx \ + pretyping/matching.cmx proofs/logic.cmx library/libnames.cmx \ + pretyping/inductiveops.cmx kernel/inductive.cmx pretyping/indrec.cmx \ + tactics/hipattern.cmx pretyping/evd.cmx pretyping/evarutil.cmx \ + pretyping/evarconv.cmx proofs/evar_refiner.cmx kernel/environ.cmx \ + kernel/declarations.cmx interp/coqlib.cmx tactics/equality.cmi +tactics/evar_tactics.cmo: lib/util.cmi pretyping/termops.cmi kernel/term.cmi \ + tactics/tactics.cmi proofs/tacmach.cmi proofs/tacexpr.cmo kernel/sign.cmi \ + proofs/refiner.cmi proofs/proof_type.cmi pretyping/evd.cmi \ + pretyping/evarutil.cmi proofs/evar_refiner.cmi kernel/environ.cmi \ tactics/evar_tactics.cmi -tactics/evar_tactics.cmx: kernel/environ.cmx proofs/evar_refiner.cmx \ - pretyping/evarutil.cmx pretyping/evd.cmx proofs/proof_type.cmx \ - proofs/refiner.cmx kernel/sign.cmx proofs/tacexpr.cmx proofs/tacmach.cmx \ - tactics/tactics.cmx kernel/term.cmx pretyping/termops.cmx lib/util.cmx \ +tactics/evar_tactics.cmx: lib/util.cmx pretyping/termops.cmx kernel/term.cmx \ + tactics/tactics.cmx proofs/tacmach.cmx proofs/tacexpr.cmx kernel/sign.cmx \ + proofs/refiner.cmx proofs/proof_type.cmx pretyping/evd.cmx \ + pretyping/evarutil.cmx proofs/evar_refiner.cmx kernel/environ.cmx \ tactics/evar_tactics.cmi -tactics/extraargs.cmo: interp/genarg.cmi parsing/lexer.cmi \ - toplevel/metasyntax.cmi library/nameops.cmi kernel/names.cmi \ - parsing/pcoq.cmi lib/pp.cmi parsing/pptactic.cmi parsing/printer.cmi \ - tactics/setoid_replace.cmi proofs/tacexpr.cmo tactics/tacinterp.cmi \ - lib/util.cmi tactics/extraargs.cmi -tactics/extraargs.cmx: interp/genarg.cmx parsing/lexer.cmx \ - toplevel/metasyntax.cmx library/nameops.cmx kernel/names.cmx \ - parsing/pcoq.cmx lib/pp.cmx parsing/pptactic.cmx parsing/printer.cmx \ - tactics/setoid_replace.cmx proofs/tacexpr.cmx tactics/tacinterp.cmx \ - lib/util.cmx tactics/extraargs.cmi -tactics/extratactics.cmo: tactics/autorewrite.cmi toplevel/cerrors.cmi \ - interp/constrintern.cmi tactics/contradiction.cmi parsing/egrammar.cmi \ - tactics/equality.cmi tactics/evar_tactics.cmi pretyping/evd.cmi \ - tactics/extraargs.cmi interp/genarg.cmi library/global.cmi \ - tactics/inv.cmi tactics/leminv.cmi parsing/lexer.cmi library/lib.cmi \ - library/libnames.cmi library/libobject.cmi kernel/mod_subst.cmi \ - kernel/names.cmi parsing/pcoq.cmi lib/pp.cmi parsing/pptactic.cmi \ - pretyping/rawterm.cmi tactics/refine.cmi proofs/refiner.cmi \ - tactics/setoid_replace.cmi library/summary.cmi proofs/tacexpr.cmo \ - tactics/tacinterp.cmi tactics/tacticals.cmi tactics/tactics.cmi \ - kernel/term.cmi lib/util.cmi toplevel/vernacinterp.cmi \ - tactics/extratactics.cmi -tactics/extratactics.cmx: tactics/autorewrite.cmx toplevel/cerrors.cmx \ - interp/constrintern.cmx tactics/contradiction.cmx parsing/egrammar.cmx \ - tactics/equality.cmx tactics/evar_tactics.cmx pretyping/evd.cmx \ - tactics/extraargs.cmx interp/genarg.cmx library/global.cmx \ - tactics/inv.cmx tactics/leminv.cmx parsing/lexer.cmx library/lib.cmx \ - library/libnames.cmx library/libobject.cmx kernel/mod_subst.cmx \ - kernel/names.cmx parsing/pcoq.cmx lib/pp.cmx parsing/pptactic.cmx \ - pretyping/rawterm.cmx tactics/refine.cmx proofs/refiner.cmx \ - tactics/setoid_replace.cmx library/summary.cmx proofs/tacexpr.cmx \ - tactics/tacinterp.cmx tactics/tacticals.cmx tactics/tactics.cmx \ - kernel/term.cmx lib/util.cmx toplevel/vernacinterp.cmx \ - tactics/extratactics.cmi -tactics/hiddentac.cmo: tactics/evar_tactics.cmi interp/genarg.cmi \ - proofs/proof_type.cmi pretyping/rawterm.cmi proofs/refiner.cmi \ - proofs/tacexpr.cmo proofs/tacmach.cmi tactics/tactics.cmi kernel/term.cmi \ - lib/util.cmi tactics/hiddentac.cmi -tactics/hiddentac.cmx: tactics/evar_tactics.cmx interp/genarg.cmx \ - proofs/proof_type.cmx pretyping/rawterm.cmx proofs/refiner.cmx \ - proofs/tacexpr.cmx proofs/tacmach.cmx tactics/tactics.cmx kernel/term.cmx \ - lib/util.cmx tactics/hiddentac.cmi -tactics/hipattern.cmo: pretyping/clenv.cmi interp/coqlib.cmi \ - kernel/declarations.cmi kernel/environ.cmi pretyping/evd.cmi \ - library/global.cmi pretyping/inductiveops.cmi library/libnames.cmi \ - pretyping/matching.cmi library/nameops.cmi kernel/names.cmi \ - pretyping/pattern.cmi lib/pp.cmi proofs/proof_trees.cmi \ - pretyping/rawterm.cmi pretyping/reductionops.cmi proofs/tacmach.cmi \ - tactics/tacticals.cmi kernel/term.cmi pretyping/termops.cmi lib/util.cmi \ +tactics/extraargs.cmo: lib/util.cmi tactics/tacinterp.cmi proofs/tacexpr.cmo \ + tactics/setoid_replace.cmi parsing/printer.cmi parsing/pptactic.cmi \ + lib/pp.cmi parsing/pcoq.cmi kernel/names.cmi library/nameops.cmi \ + toplevel/metasyntax.cmi parsing/lexer.cmi interp/genarg.cmi \ + tactics/extraargs.cmi +tactics/extraargs.cmx: lib/util.cmx tactics/tacinterp.cmx proofs/tacexpr.cmx \ + tactics/setoid_replace.cmx parsing/printer.cmx parsing/pptactic.cmx \ + lib/pp.cmx parsing/pcoq.cmx kernel/names.cmx library/nameops.cmx \ + toplevel/metasyntax.cmx parsing/lexer.cmx interp/genarg.cmx \ + tactics/extraargs.cmi +tactics/extratactics.cmo: toplevel/vernacinterp.cmi lib/util.cmi \ + kernel/term.cmi tactics/tactics.cmi tactics/tacticals.cmi \ + tactics/tacinterp.cmi proofs/tacexpr.cmo library/summary.cmi \ + tactics/setoid_replace.cmi proofs/refiner.cmi tactics/refine.cmi \ + pretyping/rawterm.cmi parsing/pptactic.cmi interp/ppextend.cmi lib/pp.cmi \ + parsing/pcoq.cmi kernel/names.cmi library/nameops.cmi \ + kernel/mod_subst.cmi library/libobject.cmi library/libnames.cmi \ + library/lib.cmi parsing/lexer.cmi tactics/leminv.cmi tactics/inv.cmi \ + library/global.cmi interp/genarg.cmi tactics/extraargs.cmi \ + pretyping/evd.cmi tactics/evar_tactics.cmi tactics/equality.cmi \ + parsing/egrammar.cmi tactics/contradiction.cmi interp/constrintern.cmi \ + toplevel/cerrors.cmi tactics/autorewrite.cmi tactics/extratactics.cmi +tactics/extratactics.cmx: toplevel/vernacinterp.cmx lib/util.cmx \ + kernel/term.cmx tactics/tactics.cmx tactics/tacticals.cmx \ + tactics/tacinterp.cmx proofs/tacexpr.cmx library/summary.cmx \ + tactics/setoid_replace.cmx proofs/refiner.cmx tactics/refine.cmx \ + pretyping/rawterm.cmx parsing/pptactic.cmx interp/ppextend.cmx lib/pp.cmx \ + parsing/pcoq.cmx kernel/names.cmx library/nameops.cmx \ + kernel/mod_subst.cmx library/libobject.cmx library/libnames.cmx \ + library/lib.cmx parsing/lexer.cmx tactics/leminv.cmx tactics/inv.cmx \ + library/global.cmx interp/genarg.cmx tactics/extraargs.cmx \ + pretyping/evd.cmx tactics/evar_tactics.cmx tactics/equality.cmx \ + parsing/egrammar.cmx tactics/contradiction.cmx interp/constrintern.cmx \ + toplevel/cerrors.cmx tactics/autorewrite.cmx tactics/extratactics.cmi +tactics/hiddentac.cmo: lib/util.cmi kernel/term.cmi tactics/tactics.cmi \ + proofs/tacmach.cmi proofs/tacexpr.cmo proofs/refiner.cmi \ + proofs/redexpr.cmi pretyping/rawterm.cmi proofs/proof_type.cmi \ + interp/genarg.cmi tactics/evar_tactics.cmi tactics/hiddentac.cmi +tactics/hiddentac.cmx: lib/util.cmx kernel/term.cmx tactics/tactics.cmx \ + proofs/tacmach.cmx proofs/tacexpr.cmx proofs/refiner.cmx \ + proofs/redexpr.cmx pretyping/rawterm.cmx proofs/proof_type.cmx \ + interp/genarg.cmx tactics/evar_tactics.cmx tactics/hiddentac.cmi +tactics/hipattern.cmo: lib/util.cmi pretyping/termops.cmi kernel/term.cmi \ + tactics/tacticals.cmi proofs/tacmach.cmi pretyping/reductionops.cmi \ + pretyping/rawterm.cmi proofs/proof_trees.cmi lib/pp.cmi \ + pretyping/pattern.cmi kernel/names.cmi library/nameops.cmi \ + pretyping/matching.cmi library/libnames.cmi pretyping/inductiveops.cmi \ + library/global.cmi pretyping/evd.cmi kernel/environ.cmi \ + kernel/declarations.cmi interp/coqlib.cmi pretyping/clenv.cmi \ tactics/hipattern.cmi -tactics/hipattern.cmx: pretyping/clenv.cmx interp/coqlib.cmx \ - kernel/declarations.cmx kernel/environ.cmx pretyping/evd.cmx \ - library/global.cmx pretyping/inductiveops.cmx library/libnames.cmx \ - pretyping/matching.cmx library/nameops.cmx kernel/names.cmx \ - pretyping/pattern.cmx lib/pp.cmx proofs/proof_trees.cmx \ - pretyping/rawterm.cmx pretyping/reductionops.cmx proofs/tacmach.cmx \ - tactics/tacticals.cmx kernel/term.cmx pretyping/termops.cmx lib/util.cmx \ +tactics/hipattern.cmx: lib/util.cmx pretyping/termops.cmx kernel/term.cmx \ + tactics/tacticals.cmx proofs/tacmach.cmx pretyping/reductionops.cmx \ + pretyping/rawterm.cmx proofs/proof_trees.cmx lib/pp.cmx \ + pretyping/pattern.cmx kernel/names.cmx library/nameops.cmx \ + pretyping/matching.cmx library/libnames.cmx pretyping/inductiveops.cmx \ + library/global.cmx pretyping/evd.cmx kernel/environ.cmx \ + kernel/declarations.cmx interp/coqlib.cmx pretyping/clenv.cmx \ tactics/hipattern.cmi -tactics/inv.cmo: pretyping/clenv.cmi interp/coqlib.cmi tactics/elim.cmi \ - kernel/environ.cmi tactics/equality.cmi proofs/evar_refiner.cmi \ - pretyping/evarutil.cmi pretyping/evd.cmi interp/genarg.cmi \ - library/global.cmi tactics/hipattern.cmi pretyping/inductiveops.cmi \ - pretyping/matching.cmi library/nameops.cmi kernel/names.cmi \ - pretyping/pattern.cmi lib/pp.cmi parsing/printer.cmi \ - proofs/proof_type.cmi pretyping/rawterm.cmi kernel/reduction.cmi \ - pretyping/reductionops.cmi pretyping/retyping.cmi kernel/sign.cmi \ - proofs/tacexpr.cmo proofs/tacmach.cmi tactics/tacticals.cmi \ - tactics/tactics.cmi kernel/term.cmi pretyping/termops.cmi \ - pretyping/typing.cmi pretyping/unification.cmi lib/util.cmi \ - tactics/inv.cmi -tactics/inv.cmx: pretyping/clenv.cmx interp/coqlib.cmx tactics/elim.cmx \ - kernel/environ.cmx tactics/equality.cmx proofs/evar_refiner.cmx \ - pretyping/evarutil.cmx pretyping/evd.cmx interp/genarg.cmx \ - library/global.cmx tactics/hipattern.cmx pretyping/inductiveops.cmx \ - pretyping/matching.cmx library/nameops.cmx kernel/names.cmx \ - pretyping/pattern.cmx lib/pp.cmx parsing/printer.cmx \ - proofs/proof_type.cmx pretyping/rawterm.cmx kernel/reduction.cmx \ - pretyping/reductionops.cmx pretyping/retyping.cmx kernel/sign.cmx \ - proofs/tacexpr.cmx proofs/tacmach.cmx tactics/tacticals.cmx \ - tactics/tactics.cmx kernel/term.cmx pretyping/termops.cmx \ - pretyping/typing.cmx pretyping/unification.cmx lib/util.cmx \ - tactics/inv.cmi -tactics/leminv.cmo: pretyping/clenv.cmi proofs/clenvtac.cmi \ - interp/constrintern.cmi library/decl_kinds.cmo kernel/declarations.cmi \ - library/declare.cmi kernel/entries.cmi kernel/environ.cmi \ - proofs/evar_refiner.cmi pretyping/evd.cmi library/global.cmi \ - pretyping/inductiveops.cmi tactics/inv.cmi library/nameops.cmi \ - kernel/names.cmi lib/options.cmi proofs/pfedit.cmi lib/pp.cmi \ - pretyping/pretype_errors.cmi pretyping/pretyping.cmi parsing/printer.cmi \ - proofs/proof_trees.cmi proofs/proof_type.cmi pretyping/reductionops.cmi \ - kernel/safe_typing.cmi kernel/sign.cmi proofs/tacmach.cmi \ - tactics/tacticals.cmi tactics/tactics.cmi kernel/term.cmi \ - pretyping/termops.cmi lib/util.cmi toplevel/vernacexpr.cmo \ +tactics/inv.cmo: lib/util.cmi pretyping/unification.cmi pretyping/typing.cmi \ + pretyping/termops.cmi kernel/term.cmi tactics/tactics.cmi \ + tactics/tacticals.cmi proofs/tacmach.cmi proofs/tacexpr.cmo \ + kernel/sign.cmi pretyping/retyping.cmi pretyping/reductionops.cmi \ + kernel/reduction.cmi pretyping/rawterm.cmi proofs/proof_type.cmi \ + parsing/printer.cmi lib/pp.cmi pretyping/pattern.cmi kernel/names.cmi \ + library/nameops.cmi pretyping/matching.cmi pretyping/inductiveops.cmi \ + tactics/hipattern.cmi library/global.cmi interp/genarg.cmi \ + pretyping/evd.cmi pretyping/evarutil.cmi proofs/evar_refiner.cmi \ + tactics/equality.cmi kernel/environ.cmi tactics/elim.cmi \ + interp/coqlib.cmi pretyping/clenv.cmi tactics/inv.cmi +tactics/inv.cmx: lib/util.cmx pretyping/unification.cmx pretyping/typing.cmx \ + pretyping/termops.cmx kernel/term.cmx tactics/tactics.cmx \ + tactics/tacticals.cmx proofs/tacmach.cmx proofs/tacexpr.cmx \ + kernel/sign.cmx pretyping/retyping.cmx pretyping/reductionops.cmx \ + kernel/reduction.cmx pretyping/rawterm.cmx proofs/proof_type.cmx \ + parsing/printer.cmx lib/pp.cmx pretyping/pattern.cmx kernel/names.cmx \ + library/nameops.cmx pretyping/matching.cmx pretyping/inductiveops.cmx \ + tactics/hipattern.cmx library/global.cmx interp/genarg.cmx \ + pretyping/evd.cmx pretyping/evarutil.cmx proofs/evar_refiner.cmx \ + tactics/equality.cmx kernel/environ.cmx tactics/elim.cmx \ + interp/coqlib.cmx pretyping/clenv.cmx tactics/inv.cmi +tactics/leminv.cmo: toplevel/vernacexpr.cmo lib/util.cmi \ + pretyping/termops.cmi kernel/term.cmi tactics/tactics.cmi \ + tactics/tacticals.cmi proofs/tacmach.cmi kernel/sign.cmi \ + kernel/safe_typing.cmi pretyping/reductionops.cmi proofs/proof_type.cmi \ + proofs/proof_trees.cmi parsing/printer.cmi pretyping/pretyping.cmi \ + pretyping/pretype_errors.cmi lib/pp.cmi proofs/pfedit.cmi lib/options.cmi \ + kernel/names.cmi library/nameops.cmi tactics/inv.cmi \ + pretyping/inductiveops.cmi library/global.cmi pretyping/evd.cmi \ + proofs/evar_refiner.cmi kernel/environ.cmi kernel/entries.cmi \ + library/declare.cmi kernel/declarations.cmi library/decl_kinds.cmo \ + interp/constrintern.cmi proofs/clenvtac.cmi pretyping/clenv.cmi \ tactics/leminv.cmi -tactics/leminv.cmx: pretyping/clenv.cmx proofs/clenvtac.cmx \ - interp/constrintern.cmx library/decl_kinds.cmx kernel/declarations.cmx \ - library/declare.cmx kernel/entries.cmx kernel/environ.cmx \ - proofs/evar_refiner.cmx pretyping/evd.cmx library/global.cmx \ - pretyping/inductiveops.cmx tactics/inv.cmx library/nameops.cmx \ - kernel/names.cmx lib/options.cmx proofs/pfedit.cmx lib/pp.cmx \ - pretyping/pretype_errors.cmx pretyping/pretyping.cmx parsing/printer.cmx \ - proofs/proof_trees.cmx proofs/proof_type.cmx pretyping/reductionops.cmx \ - kernel/safe_typing.cmx kernel/sign.cmx proofs/tacmach.cmx \ - tactics/tacticals.cmx tactics/tactics.cmx kernel/term.cmx \ - pretyping/termops.cmx lib/util.cmx toplevel/vernacexpr.cmx \ +tactics/leminv.cmx: toplevel/vernacexpr.cmx lib/util.cmx \ + pretyping/termops.cmx kernel/term.cmx tactics/tactics.cmx \ + tactics/tacticals.cmx proofs/tacmach.cmx kernel/sign.cmx \ + kernel/safe_typing.cmx pretyping/reductionops.cmx proofs/proof_type.cmx \ + proofs/proof_trees.cmx parsing/printer.cmx pretyping/pretyping.cmx \ + pretyping/pretype_errors.cmx lib/pp.cmx proofs/pfedit.cmx lib/options.cmx \ + kernel/names.cmx library/nameops.cmx tactics/inv.cmx \ + pretyping/inductiveops.cmx library/global.cmx pretyping/evd.cmx \ + proofs/evar_refiner.cmx kernel/environ.cmx kernel/entries.cmx \ + library/declare.cmx kernel/declarations.cmx library/decl_kinds.cmx \ + interp/constrintern.cmx proofs/clenvtac.cmx pretyping/clenv.cmx \ tactics/leminv.cmi -tactics/nbtermdn.cmo: tactics/btermdn.cmi lib/gmap.cmi library/libnames.cmi \ - library/libobject.cmi library/library.cmi kernel/names.cmi \ - pretyping/pattern.cmi kernel/term.cmi tactics/termdn.cmi lib/util.cmi \ - tactics/nbtermdn.cmi -tactics/nbtermdn.cmx: tactics/btermdn.cmx lib/gmap.cmx library/libnames.cmx \ - library/libobject.cmx library/library.cmx kernel/names.cmx \ - pretyping/pattern.cmx kernel/term.cmx tactics/termdn.cmx lib/util.cmx \ - tactics/nbtermdn.cmi -tactics/refine.cmo: kernel/environ.cmi pretyping/evarutil.cmi \ - pretyping/evd.cmi kernel/names.cmi lib/pp.cmi parsing/printer.cmi \ - kernel/reduction.cmi proofs/refiner.cmi pretyping/retyping.cmi \ - kernel/sign.cmi proofs/tacmach.cmi tactics/tacticals.cmi \ - tactics/tactics.cmi kernel/term.cmi pretyping/termops.cmi \ - pretyping/typing.cmi lib/util.cmi tactics/refine.cmi -tactics/refine.cmx: kernel/environ.cmx pretyping/evarutil.cmx \ - pretyping/evd.cmx kernel/names.cmx lib/pp.cmx parsing/printer.cmx \ - kernel/reduction.cmx proofs/refiner.cmx pretyping/retyping.cmx \ - kernel/sign.cmx proofs/tacmach.cmx tactics/tacticals.cmx \ - tactics/tactics.cmx kernel/term.cmx pretyping/termops.cmx \ - pretyping/typing.cmx lib/util.cmx tactics/refine.cmi -tactics/setoid_replace.cmo: pretyping/clenv.cmi kernel/closure.cmi \ - interp/constrintern.cmi interp/coqlib.cmi library/decl_kinds.cmo \ - library/declare.cmi kernel/entries.cmi kernel/environ.cmi \ - pretyping/evarutil.cmi pretyping/evd.cmi library/global.cmi lib/gmap.cmi \ - library/lib.cmi library/libnames.cmi library/libobject.cmi \ - proofs/logic.cmi kernel/mod_subst.cmi library/nameops.cmi \ - kernel/names.cmi library/nametab.cmi lib/options.cmi proofs/pfedit.cmi \ - lib/pp.cmi parsing/ppconstr.cmi pretyping/pretype_errors.cmi \ - parsing/printer.cmi proofs/proof_type.cmi pretyping/rawterm.cmi \ - kernel/reduction.cmi pretyping/reductionops.cmi kernel/safe_typing.cmi \ - kernel/sign.cmi library/summary.cmi proofs/tacmach.cmi \ - pretyping/tacred.cmi tactics/tacticals.cmi tactics/tactics.cmi \ - kernel/term.cmi pretyping/termops.cmi interp/topconstr.cmi \ - pretyping/typing.cmi pretyping/unification.cmi lib/util.cmi \ - toplevel/vernacexpr.cmo tactics/setoid_replace.cmi -tactics/setoid_replace.cmx: pretyping/clenv.cmx kernel/closure.cmx \ - interp/constrintern.cmx interp/coqlib.cmx library/decl_kinds.cmx \ - library/declare.cmx kernel/entries.cmx kernel/environ.cmx \ - pretyping/evarutil.cmx pretyping/evd.cmx library/global.cmx lib/gmap.cmx \ - library/lib.cmx library/libnames.cmx library/libobject.cmx \ - proofs/logic.cmx kernel/mod_subst.cmx library/nameops.cmx \ - kernel/names.cmx library/nametab.cmx lib/options.cmx proofs/pfedit.cmx \ - lib/pp.cmx parsing/ppconstr.cmx pretyping/pretype_errors.cmx \ - parsing/printer.cmx proofs/proof_type.cmx pretyping/rawterm.cmx \ - kernel/reduction.cmx pretyping/reductionops.cmx kernel/safe_typing.cmx \ - kernel/sign.cmx library/summary.cmx proofs/tacmach.cmx \ - pretyping/tacred.cmx tactics/tacticals.cmx tactics/tactics.cmx \ - kernel/term.cmx pretyping/termops.cmx interp/topconstr.cmx \ - pretyping/typing.cmx pretyping/unification.cmx lib/util.cmx \ - toplevel/vernacexpr.cmx tactics/setoid_replace.cmi -tactics/tacinterp.cmo: tactics/auto.cmi kernel/closure.cmi \ - interp/constrintern.cmi library/decl_kinds.cmo kernel/declarations.cmi \ - pretyping/detyping.cmi tactics/dhyp.cmi lib/dyn.cmi tactics/elim.cmi \ - kernel/entries.cmi kernel/environ.cmi pretyping/evd.cmi parsing/g_xml.cmo \ - interp/genarg.cmi library/global.cmi lib/gmap.cmi tactics/hiddentac.cmi \ - pretyping/inductiveops.cmi tactics/inv.cmi tactics/leminv.cmi \ - library/lib.cmi library/libnames.cmi library/libobject.cmi \ - proofs/logic.cmi pretyping/matching.cmi kernel/mod_subst.cmi \ - library/nameops.cmi kernel/names.cmi library/nametab.cmi lib/options.cmi \ - pretyping/pattern.cmi proofs/pfedit.cmi lib/pp.cmi parsing/pptactic.cmi \ - pretyping/pretype_errors.cmi pretyping/pretyping.cmi parsing/printer.cmi \ - proofs/proof_type.cmi pretyping/rawterm.cmi pretyping/reductionops.cmi \ - proofs/refiner.cmi pretyping/retyping.cmi kernel/safe_typing.cmi \ - kernel/sign.cmi library/summary.cmi interp/syntax_def.cmi lib/system.cmi \ - proofs/tacexpr.cmo proofs/tacmach.cmi pretyping/tacred.cmi \ - proofs/tactic_debug.cmi tactics/tactics.cmi kernel/term.cmi \ - pretyping/termops.cmi interp/topconstr.cmi pretyping/typing.cmi \ - lib/util.cmi tactics/tacinterp.cmi -tactics/tacinterp.cmx: tactics/auto.cmx kernel/closure.cmx \ - interp/constrintern.cmx library/decl_kinds.cmx kernel/declarations.cmx \ - pretyping/detyping.cmx tactics/dhyp.cmx lib/dyn.cmx tactics/elim.cmx \ - kernel/entries.cmx kernel/environ.cmx pretyping/evd.cmx parsing/g_xml.cmx \ - interp/genarg.cmx library/global.cmx lib/gmap.cmx tactics/hiddentac.cmx \ - pretyping/inductiveops.cmx tactics/inv.cmx tactics/leminv.cmx \ - library/lib.cmx library/libnames.cmx library/libobject.cmx \ - proofs/logic.cmx pretyping/matching.cmx kernel/mod_subst.cmx \ - library/nameops.cmx kernel/names.cmx library/nametab.cmx lib/options.cmx \ - pretyping/pattern.cmx proofs/pfedit.cmx lib/pp.cmx parsing/pptactic.cmx \ - pretyping/pretype_errors.cmx pretyping/pretyping.cmx parsing/printer.cmx \ - proofs/proof_type.cmx pretyping/rawterm.cmx pretyping/reductionops.cmx \ - proofs/refiner.cmx pretyping/retyping.cmx kernel/safe_typing.cmx \ - kernel/sign.cmx library/summary.cmx interp/syntax_def.cmx lib/system.cmx \ - proofs/tacexpr.cmx proofs/tacmach.cmx pretyping/tacred.cmx \ - proofs/tactic_debug.cmx tactics/tactics.cmx kernel/term.cmx \ - pretyping/termops.cmx interp/topconstr.cmx pretyping/typing.cmx \ - lib/util.cmx tactics/tacinterp.cmi -tactics/tacticals.cmo: pretyping/clenv.cmi proofs/clenvtac.cmi \ - kernel/declarations.cmi kernel/environ.cmi proofs/evar_refiner.cmi \ - pretyping/evd.cmi interp/genarg.cmi library/global.cmi \ - pretyping/indrec.cmi kernel/inductive.cmi library/libnames.cmi \ - pretyping/matching.cmi kernel/names.cmi pretyping/pattern.cmi lib/pp.cmi \ - kernel/reduction.cmi proofs/refiner.cmi kernel/sign.cmi \ - proofs/tacexpr.cmo proofs/tacmach.cmi kernel/term.cmi \ - pretyping/termops.cmi lib/util.cmi tactics/tacticals.cmi -tactics/tacticals.cmx: pretyping/clenv.cmx proofs/clenvtac.cmx \ - kernel/declarations.cmx kernel/environ.cmx proofs/evar_refiner.cmx \ - pretyping/evd.cmx interp/genarg.cmx library/global.cmx \ - pretyping/indrec.cmx kernel/inductive.cmx library/libnames.cmx \ - pretyping/matching.cmx kernel/names.cmx pretyping/pattern.cmx lib/pp.cmx \ - kernel/reduction.cmx proofs/refiner.cmx kernel/sign.cmx \ - proofs/tacexpr.cmx proofs/tacmach.cmx kernel/term.cmx \ - pretyping/termops.cmx lib/util.cmx tactics/tacticals.cmi -tactics/tactics.cmo: pretyping/clenv.cmi proofs/clenvtac.cmi \ - interp/constrintern.cmi interp/coqlib.cmi library/decl_kinds.cmo \ - kernel/declarations.cmi library/declare.cmi kernel/entries.cmi \ - kernel/environ.cmi proofs/evar_refiner.cmi pretyping/evarutil.cmi \ - pretyping/evd.cmi interp/genarg.cmi library/global.cmi \ - tactics/hipattern.cmi pretyping/indrec.cmi kernel/inductive.cmi \ - pretyping/inductiveops.cmi library/libnames.cmi proofs/logic.cmi \ - library/nameops.cmi kernel/names.cmi library/nametab.cmi lib/options.cmi \ - proofs/pfedit.cmi lib/pp.cmi pretyping/pretype_errors.cmi \ - proofs/proof_trees.cmi proofs/proof_type.cmi pretyping/rawterm.cmi \ - proofs/redexpr.cmi kernel/reduction.cmi pretyping/reductionops.cmi \ - proofs/refiner.cmi kernel/sign.cmi proofs/tacexpr.cmo proofs/tacmach.cmi \ - pretyping/tacred.cmi tactics/tacticals.cmi kernel/term.cmi \ - pretyping/termops.cmi lib/util.cmi tactics/tactics.cmi -tactics/tactics.cmx: pretyping/clenv.cmx proofs/clenvtac.cmx \ - interp/constrintern.cmx interp/coqlib.cmx library/decl_kinds.cmx \ - kernel/declarations.cmx library/declare.cmx kernel/entries.cmx \ - kernel/environ.cmx proofs/evar_refiner.cmx pretyping/evarutil.cmx \ - pretyping/evd.cmx interp/genarg.cmx library/global.cmx \ - tactics/hipattern.cmx pretyping/indrec.cmx kernel/inductive.cmx \ - pretyping/inductiveops.cmx library/libnames.cmx proofs/logic.cmx \ - library/nameops.cmx kernel/names.cmx library/nametab.cmx lib/options.cmx \ - proofs/pfedit.cmx lib/pp.cmx pretyping/pretype_errors.cmx \ - proofs/proof_trees.cmx proofs/proof_type.cmx pretyping/rawterm.cmx \ - proofs/redexpr.cmx kernel/reduction.cmx pretyping/reductionops.cmx \ - proofs/refiner.cmx kernel/sign.cmx proofs/tacexpr.cmx proofs/tacmach.cmx \ - pretyping/tacred.cmx tactics/tacticals.cmx kernel/term.cmx \ - pretyping/termops.cmx lib/util.cmx tactics/tactics.cmi -tactics/tauto.cmo: toplevel/cerrors.cmi parsing/egrammar.cmi \ - interp/genarg.cmi tactics/hipattern.cmi library/libnames.cmi \ - kernel/names.cmi parsing/pcoq.cmi lib/pp.cmi parsing/pptactic.cmi \ - proofs/proof_type.cmi pretyping/rawterm.cmi proofs/refiner.cmi \ - proofs/tacexpr.cmo tactics/tacinterp.cmi tactics/tacticals.cmi \ - tactics/tactics.cmi interp/topconstr.cmi lib/util.cmi -tactics/tauto.cmx: toplevel/cerrors.cmx parsing/egrammar.cmx \ - interp/genarg.cmx tactics/hipattern.cmx library/libnames.cmx \ - kernel/names.cmx parsing/pcoq.cmx lib/pp.cmx parsing/pptactic.cmx \ - proofs/proof_type.cmx pretyping/rawterm.cmx proofs/refiner.cmx \ - proofs/tacexpr.cmx tactics/tacinterp.cmx tactics/tacticals.cmx \ - tactics/tactics.cmx interp/topconstr.cmx lib/util.cmx -tactics/termdn.cmo: tactics/dn.cmi library/libnames.cmi library/nameops.cmi \ - kernel/names.cmi library/nametab.cmi pretyping/pattern.cmi \ - pretyping/rawterm.cmi kernel/term.cmi lib/util.cmi tactics/termdn.cmi -tactics/termdn.cmx: tactics/dn.cmx library/libnames.cmx library/nameops.cmx \ - kernel/names.cmx library/nametab.cmx pretyping/pattern.cmx \ - pretyping/rawterm.cmx kernel/term.cmx lib/util.cmx tactics/termdn.cmi -tools/coqdep.cmo: config/coq_config.cmi tools/coqdep_lexer.cmo -tools/coqdep.cmx: config/coq_config.cmx tools/coqdep_lexer.cmx +tactics/nbtermdn.cmo: lib/util.cmi tactics/termdn.cmi kernel/term.cmi \ + pretyping/pattern.cmi kernel/names.cmi library/library.cmi \ + library/libobject.cmi library/libnames.cmi lib/gmap.cmi \ + tactics/btermdn.cmi tactics/nbtermdn.cmi +tactics/nbtermdn.cmx: lib/util.cmx tactics/termdn.cmx kernel/term.cmx \ + pretyping/pattern.cmx kernel/names.cmx library/library.cmx \ + library/libobject.cmx library/libnames.cmx lib/gmap.cmx \ + tactics/btermdn.cmx tactics/nbtermdn.cmi +tactics/refine.cmo: lib/util.cmi pretyping/typing.cmi pretyping/termops.cmi \ + kernel/term.cmi tactics/tactics.cmi tactics/tacticals.cmi \ + proofs/tacmach.cmi kernel/sign.cmi pretyping/retyping.cmi \ + proofs/refiner.cmi kernel/reduction.cmi parsing/printer.cmi lib/pp.cmi \ + kernel/names.cmi pretyping/evd.cmi pretyping/evarutil.cmi \ + kernel/environ.cmi tactics/refine.cmi +tactics/refine.cmx: lib/util.cmx pretyping/typing.cmx pretyping/termops.cmx \ + kernel/term.cmx tactics/tactics.cmx tactics/tacticals.cmx \ + proofs/tacmach.cmx kernel/sign.cmx pretyping/retyping.cmx \ + proofs/refiner.cmx kernel/reduction.cmx parsing/printer.cmx lib/pp.cmx \ + kernel/names.cmx pretyping/evd.cmx pretyping/evarutil.cmx \ + kernel/environ.cmx tactics/refine.cmi +tactics/setoid_replace.cmo: toplevel/vernacexpr.cmo lib/util.cmi \ + pretyping/unification.cmi pretyping/typing.cmi interp/topconstr.cmi \ + pretyping/termops.cmi kernel/term.cmi tactics/tactics.cmi \ + tactics/tacticals.cmi pretyping/tacred.cmi proofs/tacmach.cmi \ + library/summary.cmi kernel/sign.cmi kernel/safe_typing.cmi \ + pretyping/reductionops.cmi kernel/reduction.cmi pretyping/rawterm.cmi \ + proofs/proof_type.cmi parsing/printer.cmi pretyping/pretype_errors.cmi \ + parsing/ppconstr.cmi lib/pp.cmi proofs/pfedit.cmi lib/options.cmi \ + library/nametab.cmi kernel/names.cmi library/nameops.cmi \ + kernel/mod_subst.cmi proofs/logic.cmi library/libobject.cmi \ + library/libnames.cmi library/lib.cmi lib/gmap.cmi library/global.cmi \ + pretyping/evd.cmi pretyping/evarutil.cmi kernel/environ.cmi \ + kernel/entries.cmi library/declare.cmi library/decl_kinds.cmo \ + interp/coqlib.cmi interp/constrintern.cmi kernel/closure.cmi \ + pretyping/clenv.cmi tactics/setoid_replace.cmi +tactics/setoid_replace.cmx: toplevel/vernacexpr.cmx lib/util.cmx \ + pretyping/unification.cmx pretyping/typing.cmx interp/topconstr.cmx \ + pretyping/termops.cmx kernel/term.cmx tactics/tactics.cmx \ + tactics/tacticals.cmx pretyping/tacred.cmx proofs/tacmach.cmx \ + library/summary.cmx kernel/sign.cmx kernel/safe_typing.cmx \ + pretyping/reductionops.cmx kernel/reduction.cmx pretyping/rawterm.cmx \ + proofs/proof_type.cmx parsing/printer.cmx pretyping/pretype_errors.cmx \ + parsing/ppconstr.cmx lib/pp.cmx proofs/pfedit.cmx lib/options.cmx \ + library/nametab.cmx kernel/names.cmx library/nameops.cmx \ + kernel/mod_subst.cmx proofs/logic.cmx library/libobject.cmx \ + library/libnames.cmx library/lib.cmx lib/gmap.cmx library/global.cmx \ + pretyping/evd.cmx pretyping/evarutil.cmx kernel/environ.cmx \ + kernel/entries.cmx library/declare.cmx library/decl_kinds.cmx \ + interp/coqlib.cmx interp/constrintern.cmx kernel/closure.cmx \ + pretyping/clenv.cmx tactics/setoid_replace.cmi +tactics/tacinterp.cmo: lib/util.cmi pretyping/typing.cmi interp/topconstr.cmi \ + pretyping/termops.cmi kernel/term.cmi tactics/tactics.cmi \ + proofs/tactic_debug.cmi pretyping/tacred.cmi proofs/tacmach.cmi \ + proofs/tacexpr.cmo lib/system.cmi interp/syntax_def.cmi \ + library/summary.cmi kernel/sign.cmi kernel/safe_typing.cmi \ + pretyping/retyping.cmi proofs/refiner.cmi pretyping/reductionops.cmi \ + pretyping/rawterm.cmi proofs/proof_type.cmi parsing/printer.cmi \ + pretyping/pretyping.cmi pretyping/pretype_errors.cmi parsing/pptactic.cmi \ + lib/pp.cmi proofs/pfedit.cmi parsing/pcoq.cmi pretyping/pattern.cmi \ + lib/options.cmi library/nametab.cmi kernel/names.cmi library/nameops.cmi \ + kernel/mod_subst.cmi pretyping/matching.cmi proofs/logic.cmi \ + library/libobject.cmi library/libnames.cmi library/lib.cmi \ + tactics/leminv.cmi tactics/inv.cmi pretyping/inductiveops.cmi \ + tactics/hiddentac.cmi lib/gmap.cmi library/global.cmi interp/genarg.cmi \ + parsing/g_xml.cmo pretyping/evd.cmi tactics/equality.cmi \ + kernel/environ.cmi kernel/entries.cmi tactics/elim.cmi lib/dyn.cmi \ + tactics/dhyp.cmi pretyping/detyping.cmi kernel/declarations.cmi \ + library/decl_kinds.cmo interp/constrintern.cmi kernel/closure.cmi \ + tactics/auto.cmi tactics/tacinterp.cmi +tactics/tacinterp.cmx: lib/util.cmx pretyping/typing.cmx interp/topconstr.cmx \ + pretyping/termops.cmx kernel/term.cmx tactics/tactics.cmx \ + proofs/tactic_debug.cmx pretyping/tacred.cmx proofs/tacmach.cmx \ + proofs/tacexpr.cmx lib/system.cmx interp/syntax_def.cmx \ + library/summary.cmx kernel/sign.cmx kernel/safe_typing.cmx \ + pretyping/retyping.cmx proofs/refiner.cmx pretyping/reductionops.cmx \ + pretyping/rawterm.cmx proofs/proof_type.cmx parsing/printer.cmx \ + pretyping/pretyping.cmx pretyping/pretype_errors.cmx parsing/pptactic.cmx \ + lib/pp.cmx proofs/pfedit.cmx parsing/pcoq.cmx pretyping/pattern.cmx \ + lib/options.cmx library/nametab.cmx kernel/names.cmx library/nameops.cmx \ + kernel/mod_subst.cmx pretyping/matching.cmx proofs/logic.cmx \ + library/libobject.cmx library/libnames.cmx library/lib.cmx \ + tactics/leminv.cmx tactics/inv.cmx pretyping/inductiveops.cmx \ + tactics/hiddentac.cmx lib/gmap.cmx library/global.cmx interp/genarg.cmx \ + parsing/g_xml.cmx pretyping/evd.cmx tactics/equality.cmx \ + kernel/environ.cmx kernel/entries.cmx tactics/elim.cmx lib/dyn.cmx \ + tactics/dhyp.cmx pretyping/detyping.cmx kernel/declarations.cmx \ + library/decl_kinds.cmx interp/constrintern.cmx kernel/closure.cmx \ + tactics/auto.cmx tactics/tacinterp.cmi +tactics/tacticals.cmo: lib/util.cmi pretyping/termops.cmi kernel/term.cmi \ + proofs/tacmach.cmi proofs/tacexpr.cmo kernel/sign.cmi proofs/refiner.cmi \ + kernel/reduction.cmi lib/pp.cmi pretyping/pattern.cmi kernel/names.cmi \ + pretyping/matching.cmi library/libnames.cmi kernel/inductive.cmi \ + pretyping/indrec.cmi library/global.cmi interp/genarg.cmi \ + pretyping/evd.cmi proofs/evar_refiner.cmi kernel/environ.cmi \ + kernel/declarations.cmi proofs/clenvtac.cmi pretyping/clenv.cmi \ + tactics/tacticals.cmi +tactics/tacticals.cmx: lib/util.cmx pretyping/termops.cmx kernel/term.cmx \ + proofs/tacmach.cmx proofs/tacexpr.cmx kernel/sign.cmx proofs/refiner.cmx \ + kernel/reduction.cmx lib/pp.cmx pretyping/pattern.cmx kernel/names.cmx \ + pretyping/matching.cmx library/libnames.cmx kernel/inductive.cmx \ + pretyping/indrec.cmx library/global.cmx interp/genarg.cmx \ + pretyping/evd.cmx proofs/evar_refiner.cmx kernel/environ.cmx \ + kernel/declarations.cmx proofs/clenvtac.cmx pretyping/clenv.cmx \ + tactics/tacticals.cmi +tactics/tactics.cmo: lib/util.cmi pretyping/termops.cmi kernel/term.cmi \ + tactics/tacticals.cmi pretyping/tacred.cmi proofs/tacmach.cmi \ + proofs/tacexpr.cmo kernel/sign.cmi proofs/refiner.cmi \ + pretyping/reductionops.cmi kernel/reduction.cmi proofs/redexpr.cmi \ + pretyping/rawterm.cmi proofs/proof_type.cmi proofs/proof_trees.cmi \ + pretyping/pretype_errors.cmi lib/pp.cmi proofs/pfedit.cmi lib/options.cmi \ + library/nametab.cmi kernel/names.cmi library/nameops.cmi proofs/logic.cmi \ + library/libnames.cmi pretyping/inductiveops.cmi kernel/inductive.cmi \ + pretyping/indrec.cmi tactics/hipattern.cmi library/global.cmi \ + interp/genarg.cmi pretyping/evd.cmi pretyping/evarutil.cmi \ + proofs/evar_refiner.cmi kernel/environ.cmi kernel/entries.cmi \ + library/declare.cmi kernel/declarations.cmi library/decl_kinds.cmo \ + interp/coqlib.cmi interp/constrintern.cmi proofs/clenvtac.cmi \ + pretyping/clenv.cmi tactics/tactics.cmi +tactics/tactics.cmx: lib/util.cmx pretyping/termops.cmx kernel/term.cmx \ + tactics/tacticals.cmx pretyping/tacred.cmx proofs/tacmach.cmx \ + proofs/tacexpr.cmx kernel/sign.cmx proofs/refiner.cmx \ + pretyping/reductionops.cmx kernel/reduction.cmx proofs/redexpr.cmx \ + pretyping/rawterm.cmx proofs/proof_type.cmx proofs/proof_trees.cmx \ + pretyping/pretype_errors.cmx lib/pp.cmx proofs/pfedit.cmx lib/options.cmx \ + library/nametab.cmx kernel/names.cmx library/nameops.cmx proofs/logic.cmx \ + library/libnames.cmx pretyping/inductiveops.cmx kernel/inductive.cmx \ + pretyping/indrec.cmx tactics/hipattern.cmx library/global.cmx \ + interp/genarg.cmx pretyping/evd.cmx pretyping/evarutil.cmx \ + proofs/evar_refiner.cmx kernel/environ.cmx kernel/entries.cmx \ + library/declare.cmx kernel/declarations.cmx library/decl_kinds.cmx \ + interp/coqlib.cmx interp/constrintern.cmx proofs/clenvtac.cmx \ + pretyping/clenv.cmx tactics/tactics.cmi +tactics/tauto.cmo: lib/util.cmi interp/topconstr.cmi tactics/tactics.cmi \ + tactics/tacticals.cmi tactics/tacinterp.cmi proofs/tacexpr.cmo \ + proofs/refiner.cmi pretyping/rawterm.cmi proofs/proof_type.cmi \ + parsing/pptactic.cmi lib/pp.cmi parsing/pcoq.cmi kernel/names.cmi \ + library/libnames.cmi tactics/hipattern.cmi interp/genarg.cmi \ + parsing/egrammar.cmi toplevel/cerrors.cmi +tactics/tauto.cmx: lib/util.cmx interp/topconstr.cmx tactics/tactics.cmx \ + tactics/tacticals.cmx tactics/tacinterp.cmx proofs/tacexpr.cmx \ + proofs/refiner.cmx pretyping/rawterm.cmx proofs/proof_type.cmx \ + parsing/pptactic.cmx lib/pp.cmx parsing/pcoq.cmx kernel/names.cmx \ + library/libnames.cmx tactics/hipattern.cmx interp/genarg.cmx \ + parsing/egrammar.cmx toplevel/cerrors.cmx +tactics/termdn.cmo: lib/util.cmi kernel/term.cmi pretyping/rawterm.cmi \ + pretyping/pattern.cmi library/nametab.cmi kernel/names.cmi \ + library/nameops.cmi library/libnames.cmi tactics/dn.cmi \ + tactics/termdn.cmi +tactics/termdn.cmx: lib/util.cmx kernel/term.cmx pretyping/rawterm.cmx \ + pretyping/pattern.cmx library/nametab.cmx kernel/names.cmx \ + library/nameops.cmx library/libnames.cmx tactics/dn.cmx \ + tactics/termdn.cmi +tools/coqdep.cmo: tools/coqdep_lexer.cmo config/coq_config.cmi +tools/coqdep.cmx: tools/coqdep_lexer.cmx config/coq_config.cmx tools/gallina.cmo: tools/gallina_lexer.cmo tools/gallina.cmx: tools/gallina_lexer.cmx -toplevel/cerrors.cmo: pretyping/cases.cmi toplevel/himsg.cmi \ - pretyping/indrec.cmi kernel/indtypes.cmi parsing/lexer.cmi \ - library/libnames.cmi proofs/logic.cmi library/nametab.cmi lib/options.cmi \ - lib/pp.cmi pretyping/pretype_errors.cmi proofs/refiner.cmi \ - pretyping/tacred.cmi proofs/tactic_debug.cmi kernel/type_errors.cmi \ - kernel/univ.cmi lib/util.cmi toplevel/cerrors.cmi -toplevel/cerrors.cmx: pretyping/cases.cmx toplevel/himsg.cmx \ - pretyping/indrec.cmx kernel/indtypes.cmx parsing/lexer.cmx \ - library/libnames.cmx proofs/logic.cmx library/nametab.cmx lib/options.cmx \ - lib/pp.cmx pretyping/pretype_errors.cmx proofs/refiner.cmx \ - pretyping/tacred.cmx proofs/tactic_debug.cmx kernel/type_errors.cmx \ - kernel/univ.cmx lib/util.cmx toplevel/cerrors.cmi -toplevel/class.cmo: pretyping/classops.cmi library/decl_kinds.cmo \ - kernel/declarations.cmi library/declare.cmi kernel/entries.cmi \ - kernel/environ.cmi pretyping/evd.cmi library/global.cmi \ - kernel/inductive.cmi library/lib.cmi library/libnames.cmi \ - library/nameops.cmi kernel/names.cmi library/nametab.cmi lib/options.cmi \ - lib/pp.cmi parsing/printer.cmi pretyping/reductionops.cmi \ - kernel/safe_typing.cmi kernel/sign.cmi kernel/term.cmi \ - pretyping/termops.cmi pretyping/typing.cmi lib/util.cmi \ - toplevel/class.cmi -toplevel/class.cmx: pretyping/classops.cmx library/decl_kinds.cmx \ - kernel/declarations.cmx library/declare.cmx kernel/entries.cmx \ - kernel/environ.cmx pretyping/evd.cmx library/global.cmx \ - kernel/inductive.cmx library/lib.cmx library/libnames.cmx \ - library/nameops.cmx kernel/names.cmx library/nametab.cmx lib/options.cmx \ - lib/pp.cmx parsing/printer.cmx pretyping/reductionops.cmx \ - kernel/safe_typing.cmx kernel/sign.cmx kernel/term.cmx \ - pretyping/termops.cmx pretyping/typing.cmx lib/util.cmx \ - toplevel/class.cmi -toplevel/command.cmo: toplevel/class.cmi interp/constrextern.cmi \ - interp/constrintern.cmi library/decl_kinds.cmo kernel/declarations.cmi \ - library/declare.cmi kernel/entries.cmi kernel/environ.cmi \ - pretyping/evd.cmi library/global.cmi library/impargs.cmi \ - pretyping/indrec.cmi kernel/indtypes.cmi kernel/inductive.cmi \ - library/lib.cmi library/libnames.cmi library/libobject.cmi \ - library/library.cmi proofs/logic.cmi toplevel/metasyntax.cmi \ - library/nameops.cmi kernel/names.cmi library/nametab.cmi \ - interp/notation.cmi lib/options.cmi proofs/pfedit.cmi lib/pp.cmi \ - pretyping/pretyping.cmi parsing/printer.cmi proofs/proof_type.cmi \ - proofs/redexpr.cmi kernel/reduction.cmi pretyping/reductionops.cmi \ - pretyping/retyping.cmi kernel/safe_typing.cmi library/states.cmi \ - interp/syntax_def.cmi proofs/tacmach.cmi kernel/term.cmi \ - pretyping/termops.cmi interp/topconstr.cmi kernel/typeops.cmi \ - lib/util.cmi toplevel/vernacexpr.cmo toplevel/command.cmi -toplevel/command.cmx: toplevel/class.cmx interp/constrextern.cmx \ - interp/constrintern.cmx library/decl_kinds.cmx kernel/declarations.cmx \ - library/declare.cmx kernel/entries.cmx kernel/environ.cmx \ - pretyping/evd.cmx library/global.cmx library/impargs.cmx \ - pretyping/indrec.cmx kernel/indtypes.cmx kernel/inductive.cmx \ - library/lib.cmx library/libnames.cmx library/libobject.cmx \ - library/library.cmx proofs/logic.cmx toplevel/metasyntax.cmx \ - library/nameops.cmx kernel/names.cmx library/nametab.cmx \ - interp/notation.cmx lib/options.cmx proofs/pfedit.cmx lib/pp.cmx \ - pretyping/pretyping.cmx parsing/printer.cmx proofs/proof_type.cmx \ - proofs/redexpr.cmx kernel/reduction.cmx pretyping/reductionops.cmx \ - pretyping/retyping.cmx kernel/safe_typing.cmx library/states.cmx \ - interp/syntax_def.cmx proofs/tacmach.cmx kernel/term.cmx \ - pretyping/termops.cmx interp/topconstr.cmx kernel/typeops.cmx \ - lib/util.cmx toplevel/vernacexpr.cmx toplevel/command.cmi -toplevel/coqinit.cmo: config/coq_config.cmi toplevel/mltop.cmi \ - library/nameops.cmi kernel/names.cmi lib/options.cmi lib/pp.cmi \ - lib/system.cmi toplevel/toplevel.cmi toplevel/vernac.cmi \ +toplevel/cerrors.cmo: lib/util.cmi kernel/univ.cmi kernel/type_errors.cmi \ + proofs/tactic_debug.cmi pretyping/tacred.cmi proofs/refiner.cmi \ + pretyping/pretype_errors.cmi lib/pp.cmi lib/options.cmi \ + library/nametab.cmi proofs/logic.cmi library/libnames.cmi \ + parsing/lexer.cmi kernel/indtypes.cmi pretyping/indrec.cmi \ + toplevel/himsg.cmi pretyping/cases.cmi toplevel/cerrors.cmi +toplevel/cerrors.cmx: lib/util.cmx kernel/univ.cmx kernel/type_errors.cmx \ + proofs/tactic_debug.cmx pretyping/tacred.cmx proofs/refiner.cmx \ + pretyping/pretype_errors.cmx lib/pp.cmx lib/options.cmx \ + library/nametab.cmx proofs/logic.cmx library/libnames.cmx \ + parsing/lexer.cmx kernel/indtypes.cmx pretyping/indrec.cmx \ + toplevel/himsg.cmx pretyping/cases.cmx toplevel/cerrors.cmi +toplevel/class.cmo: lib/util.cmi pretyping/typing.cmi pretyping/termops.cmi \ + kernel/term.cmi kernel/sign.cmi kernel/safe_typing.cmi \ + pretyping/reductionops.cmi parsing/printer.cmi lib/pp.cmi lib/options.cmi \ + library/nametab.cmi kernel/names.cmi library/nameops.cmi \ + library/libnames.cmi library/lib.cmi kernel/inductive.cmi \ + library/global.cmi pretyping/evd.cmi kernel/environ.cmi \ + kernel/entries.cmi library/declare.cmi kernel/declarations.cmi \ + library/decl_kinds.cmo pretyping/classops.cmi toplevel/class.cmi +toplevel/class.cmx: lib/util.cmx pretyping/typing.cmx pretyping/termops.cmx \ + kernel/term.cmx kernel/sign.cmx kernel/safe_typing.cmx \ + pretyping/reductionops.cmx parsing/printer.cmx lib/pp.cmx lib/options.cmx \ + library/nametab.cmx kernel/names.cmx library/nameops.cmx \ + library/libnames.cmx library/lib.cmx kernel/inductive.cmx \ + library/global.cmx pretyping/evd.cmx kernel/environ.cmx \ + kernel/entries.cmx library/declare.cmx kernel/declarations.cmx \ + library/decl_kinds.cmx pretyping/classops.cmx toplevel/class.cmi +toplevel/command.cmo: toplevel/vernacexpr.cmo lib/util.cmi kernel/typeops.cmi \ + interp/topconstr.cmi pretyping/termops.cmi kernel/term.cmi \ + proofs/tacmach.cmi interp/syntax_def.cmi library/states.cmi \ + kernel/safe_typing.cmi pretyping/retyping.cmi pretyping/reductionops.cmi \ + kernel/reduction.cmi proofs/redexpr.cmi pretyping/rawterm.cmi \ + proofs/proof_type.cmi parsing/printer.cmi pretyping/pretyping.cmi \ + lib/pp.cmi proofs/pfedit.cmi lib/options.cmi interp/notation.cmi \ + library/nametab.cmi kernel/names.cmi library/nameops.cmi \ + toplevel/metasyntax.cmi proofs/logic.cmi library/library.cmi \ + library/libobject.cmi library/libnames.cmi library/lib.cmi \ + kernel/inductive.cmi kernel/indtypes.cmi pretyping/indrec.cmi \ + library/impargs.cmi library/global.cmi pretyping/evd.cmi \ + kernel/environ.cmi kernel/entries.cmi library/declare.cmi \ + kernel/declarations.cmi library/decl_kinds.cmo interp/constrintern.cmi \ + interp/constrextern.cmi toplevel/class.cmi toplevel/command.cmi +toplevel/command.cmx: toplevel/vernacexpr.cmx lib/util.cmx kernel/typeops.cmx \ + interp/topconstr.cmx pretyping/termops.cmx kernel/term.cmx \ + proofs/tacmach.cmx interp/syntax_def.cmx library/states.cmx \ + kernel/safe_typing.cmx pretyping/retyping.cmx pretyping/reductionops.cmx \ + kernel/reduction.cmx proofs/redexpr.cmx pretyping/rawterm.cmx \ + proofs/proof_type.cmx parsing/printer.cmx pretyping/pretyping.cmx \ + lib/pp.cmx proofs/pfedit.cmx lib/options.cmx interp/notation.cmx \ + library/nametab.cmx kernel/names.cmx library/nameops.cmx \ + toplevel/metasyntax.cmx proofs/logic.cmx library/library.cmx \ + library/libobject.cmx library/libnames.cmx library/lib.cmx \ + kernel/inductive.cmx kernel/indtypes.cmx pretyping/indrec.cmx \ + library/impargs.cmx library/global.cmx pretyping/evd.cmx \ + kernel/environ.cmx kernel/entries.cmx library/declare.cmx \ + kernel/declarations.cmx library/decl_kinds.cmx interp/constrintern.cmx \ + interp/constrextern.cmx toplevel/class.cmx toplevel/command.cmi +toplevel/coqinit.cmo: toplevel/vernac.cmi toplevel/toplevel.cmi \ + lib/system.cmi lib/pp.cmi lib/options.cmi kernel/names.cmi \ + library/nameops.cmi toplevel/mltop.cmi config/coq_config.cmi \ toplevel/coqinit.cmi -toplevel/coqinit.cmx: config/coq_config.cmx toplevel/mltop.cmx \ - library/nameops.cmx kernel/names.cmx lib/options.cmx lib/pp.cmx \ - lib/system.cmx toplevel/toplevel.cmx toplevel/vernac.cmx \ +toplevel/coqinit.cmx: toplevel/vernac.cmx toplevel/toplevel.cmx \ + lib/system.cmx lib/pp.cmx lib/options.cmx kernel/names.cmx \ + library/nameops.cmx toplevel/mltop.cmx config/coq_config.cmx \ toplevel/coqinit.cmi -toplevel/coqtop.cmo: toplevel/cerrors.cmi config/coq_config.cmi \ - toplevel/coqinit.cmi kernel/declarations.cmi library/declaremods.cmi \ - library/global.cmi library/lib.cmi library/libnames.cmi \ - library/library.cmi toplevel/mltop.cmi library/nameops.cmi \ - kernel/names.cmi lib/options.cmi lib/pp.cmi lib/profile.cmi \ - library/states.cmi lib/system.cmi toplevel/toplevel.cmi \ - toplevel/usage.cmi lib/util.cmi kernel/vconv.cmi toplevel/vernac.cmi \ - kernel/vm.cmi toplevel/coqtop.cmi -toplevel/coqtop.cmx: toplevel/cerrors.cmx config/coq_config.cmx \ - toplevel/coqinit.cmx kernel/declarations.cmx library/declaremods.cmx \ - library/global.cmx library/lib.cmx library/libnames.cmx \ - library/library.cmx toplevel/mltop.cmx library/nameops.cmx \ - kernel/names.cmx lib/options.cmx lib/pp.cmx lib/profile.cmx \ - library/states.cmx lib/system.cmx toplevel/toplevel.cmx \ - toplevel/usage.cmx lib/util.cmx kernel/vconv.cmx toplevel/vernac.cmx \ - kernel/vm.cmx toplevel/coqtop.cmi -toplevel/discharge.cmo: kernel/cooking.cmi kernel/declarations.cmi \ - kernel/entries.cmi kernel/names.cmi kernel/sign.cmi kernel/term.cmi \ - pretyping/termops.cmi lib/util.cmi toplevel/discharge.cmi -toplevel/discharge.cmx: kernel/cooking.cmx kernel/declarations.cmx \ - kernel/entries.cmx kernel/names.cmx kernel/sign.cmx kernel/term.cmx \ - pretyping/termops.cmx lib/util.cmx toplevel/discharge.cmi -toplevel/fhimsg.cmo: kernel/environ.cmi parsing/g_minicoq.cmi \ - kernel/names.cmi lib/pp.cmi kernel/reduction.cmi kernel/sign.cmi \ - kernel/term.cmi kernel/type_errors.cmi lib/util.cmi toplevel/fhimsg.cmi -toplevel/fhimsg.cmx: kernel/environ.cmx parsing/g_minicoq.cmx \ - kernel/names.cmx lib/pp.cmx kernel/reduction.cmx kernel/sign.cmx \ - kernel/term.cmx kernel/type_errors.cmx lib/util.cmx toplevel/fhimsg.cmi -toplevel/himsg.cmo: pretyping/cases.cmi kernel/environ.cmi pretyping/evd.cmi \ - library/global.cmi pretyping/indrec.cmi kernel/indtypes.cmi \ - kernel/inductive.cmi proofs/logic.cmi library/nameops.cmi \ - kernel/names.cmi library/nametab.cmi lib/options.cmi lib/pp.cmi \ - pretyping/pretype_errors.cmi parsing/printer.cmi pretyping/rawterm.cmi \ - kernel/reduction.cmi kernel/sign.cmi pretyping/tacred.cmi kernel/term.cmi \ - pretyping/termops.cmi kernel/type_errors.cmi lib/util.cmi \ +toplevel/coqtop.cmo: kernel/vm.cmi toplevel/vernac.cmi kernel/vconv.cmi \ + lib/util.cmi toplevel/usage.cmi toplevel/toplevel.cmi lib/system.cmi \ + library/states.cmi lib/profile.cmi lib/pp.cmi lib/options.cmi \ + kernel/names.cmi library/nameops.cmi toplevel/mltop.cmi \ + library/library.cmi library/libnames.cmi library/lib.cmi \ + library/global.cmi library/declaremods.cmi kernel/declarations.cmi \ + toplevel/coqinit.cmi config/coq_config.cmi toplevel/cerrors.cmi \ + toplevel/coqtop.cmi +toplevel/coqtop.cmx: kernel/vm.cmx toplevel/vernac.cmx kernel/vconv.cmx \ + lib/util.cmx toplevel/usage.cmx toplevel/toplevel.cmx lib/system.cmx \ + library/states.cmx lib/profile.cmx lib/pp.cmx lib/options.cmx \ + kernel/names.cmx library/nameops.cmx toplevel/mltop.cmx \ + library/library.cmx library/libnames.cmx library/lib.cmx \ + library/global.cmx library/declaremods.cmx kernel/declarations.cmx \ + toplevel/coqinit.cmx config/coq_config.cmx toplevel/cerrors.cmx \ + toplevel/coqtop.cmi +toplevel/discharge.cmo: lib/util.cmi pretyping/termops.cmi kernel/term.cmi \ + kernel/sign.cmi kernel/names.cmi kernel/inductive.cmi kernel/entries.cmi \ + kernel/declarations.cmi kernel/cooking.cmi toplevel/discharge.cmi +toplevel/discharge.cmx: lib/util.cmx pretyping/termops.cmx kernel/term.cmx \ + kernel/sign.cmx kernel/names.cmx kernel/inductive.cmx kernel/entries.cmx \ + kernel/declarations.cmx kernel/cooking.cmx toplevel/discharge.cmi +toplevel/fhimsg.cmo: lib/util.cmi kernel/type_errors.cmi kernel/term.cmi \ + kernel/sign.cmi kernel/reduction.cmi lib/pp.cmi kernel/names.cmi \ + parsing/g_minicoq.cmi kernel/environ.cmi toplevel/fhimsg.cmi +toplevel/fhimsg.cmx: lib/util.cmx kernel/type_errors.cmx kernel/term.cmx \ + kernel/sign.cmx kernel/reduction.cmx lib/pp.cmx kernel/names.cmx \ + parsing/g_minicoq.cmx kernel/environ.cmx toplevel/fhimsg.cmi +toplevel/himsg.cmo: lib/util.cmi kernel/type_errors.cmi pretyping/termops.cmi \ + kernel/term.cmi pretyping/tacred.cmi kernel/sign.cmi kernel/reduction.cmi \ + pretyping/rawterm.cmi parsing/printer.cmi pretyping/pretype_errors.cmi \ + lib/pp.cmi lib/options.cmi library/nametab.cmi kernel/names.cmi \ + library/nameops.cmi proofs/logic.cmi kernel/inductive.cmi \ + kernel/indtypes.cmi pretyping/indrec.cmi library/global.cmi \ + pretyping/evd.cmi kernel/environ.cmi pretyping/cases.cmi \ toplevel/himsg.cmi -toplevel/himsg.cmx: pretyping/cases.cmx kernel/environ.cmx pretyping/evd.cmx \ - library/global.cmx pretyping/indrec.cmx kernel/indtypes.cmx \ - kernel/inductive.cmx proofs/logic.cmx library/nameops.cmx \ - kernel/names.cmx library/nametab.cmx lib/options.cmx lib/pp.cmx \ - pretyping/pretype_errors.cmx parsing/printer.cmx pretyping/rawterm.cmx \ - kernel/reduction.cmx kernel/sign.cmx pretyping/tacred.cmx kernel/term.cmx \ - pretyping/termops.cmx kernel/type_errors.cmx lib/util.cmx \ +toplevel/himsg.cmx: lib/util.cmx kernel/type_errors.cmx pretyping/termops.cmx \ + kernel/term.cmx pretyping/tacred.cmx kernel/sign.cmx kernel/reduction.cmx \ + pretyping/rawterm.cmx parsing/printer.cmx pretyping/pretype_errors.cmx \ + lib/pp.cmx lib/options.cmx library/nametab.cmx kernel/names.cmx \ + library/nameops.cmx proofs/logic.cmx kernel/inductive.cmx \ + kernel/indtypes.cmx pretyping/indrec.cmx library/global.cmx \ + pretyping/evd.cmx kernel/environ.cmx pretyping/cases.cmx \ toplevel/himsg.cmi toplevel/line_oriented_parser.cmo: toplevel/line_oriented_parser.cmi toplevel/line_oriented_parser.cmx: toplevel/line_oriented_parser.cmi -toplevel/metasyntax.cmo: lib/bigint.cmi pretyping/classops.cmi \ - interp/constrintern.cmi parsing/egrammar.cmi parsing/extend.cmi \ - library/global.cmi parsing/lexer.cmi library/lib.cmi library/libnames.cmi \ - library/libobject.cmi kernel/names.cmi interp/notation.cmi \ - lib/options.cmi parsing/pcoq.cmi lib/pp.cmi interp/ppextend.cmi \ - parsing/pptactic.cmi pretyping/rawterm.cmi library/summary.cmi \ - tactics/tacinterp.cmi interp/topconstr.cmi lib/util.cmi \ - toplevel/vernacexpr.cmo toplevel/metasyntax.cmi -toplevel/metasyntax.cmx: lib/bigint.cmx pretyping/classops.cmx \ - interp/constrintern.cmx parsing/egrammar.cmx parsing/extend.cmx \ - library/global.cmx parsing/lexer.cmx library/lib.cmx library/libnames.cmx \ - library/libobject.cmx kernel/names.cmx interp/notation.cmx \ - lib/options.cmx parsing/pcoq.cmx lib/pp.cmx interp/ppextend.cmx \ - parsing/pptactic.cmx pretyping/rawterm.cmx library/summary.cmx \ - tactics/tacinterp.cmx interp/topconstr.cmx lib/util.cmx \ - toplevel/vernacexpr.cmx toplevel/metasyntax.cmi -toplevel/minicoq.cmo: kernel/declarations.cmi toplevel/fhimsg.cmi \ - parsing/g_minicoq.cmi kernel/inductive.cmi kernel/names.cmi lib/pp.cmi \ - kernel/safe_typing.cmi kernel/sign.cmi kernel/term.cmi \ - kernel/type_errors.cmi lib/util.cmi -toplevel/minicoq.cmx: kernel/declarations.cmx toplevel/fhimsg.cmx \ - parsing/g_minicoq.cmx kernel/inductive.cmx kernel/names.cmx lib/pp.cmx \ - kernel/safe_typing.cmx kernel/sign.cmx kernel/term.cmx \ - kernel/type_errors.cmx lib/util.cmx -toplevel/mltop.cmo: library/lib.cmi library/libobject.cmi library/library.cmi \ - kernel/names.cmi lib/options.cmi lib/pp.cmi library/summary.cmi \ - lib/system.cmi lib/util.cmi toplevel/vernacinterp.cmi toplevel/mltop.cmi -toplevel/mltop.cmx: library/lib.cmx library/libobject.cmx library/library.cmx \ - kernel/names.cmx lib/options.cmx lib/pp.cmx library/summary.cmx \ - lib/system.cmx lib/util.cmx toplevel/vernacinterp.cmx toplevel/mltop.cmi -toplevel/protectedtoplevel.cmo: toplevel/cerrors.cmi \ - toplevel/line_oriented_parser.cmi parsing/pcoq.cmi lib/pp.cmi \ - toplevel/vernac.cmi toplevel/vernacexpr.cmo \ - toplevel/protectedtoplevel.cmi -toplevel/protectedtoplevel.cmx: toplevel/cerrors.cmx \ - toplevel/line_oriented_parser.cmx parsing/pcoq.cmx lib/pp.cmx \ - toplevel/vernac.cmx toplevel/vernacexpr.cmx \ - toplevel/protectedtoplevel.cmi -toplevel/record.cmo: toplevel/class.cmi toplevel/command.cmi \ - interp/constrintern.cmi library/decl_kinds.cmo kernel/declarations.cmi \ - library/declare.cmi kernel/entries.cmi kernel/environ.cmi \ - pretyping/evd.cmi library/global.cmi kernel/indtypes.cmi \ - kernel/inductive.cmi pretyping/inductiveops.cmi library/libnames.cmi \ - library/nameops.cmi kernel/names.cmi library/nametab.cmi lib/options.cmi \ - lib/pp.cmi parsing/printer.cmi pretyping/recordops.cmi \ - kernel/safe_typing.cmi kernel/term.cmi pretyping/termops.cmi \ - interp/topconstr.cmi kernel/type_errors.cmi lib/util.cmi \ - toplevel/vernacexpr.cmo toplevel/record.cmi -toplevel/record.cmx: toplevel/class.cmx toplevel/command.cmx \ - interp/constrintern.cmx library/decl_kinds.cmx kernel/declarations.cmx \ - library/declare.cmx kernel/entries.cmx kernel/environ.cmx \ - pretyping/evd.cmx library/global.cmx kernel/indtypes.cmx \ - kernel/inductive.cmx pretyping/inductiveops.cmx library/libnames.cmx \ - library/nameops.cmx kernel/names.cmx library/nametab.cmx lib/options.cmx \ - lib/pp.cmx parsing/printer.cmx pretyping/recordops.cmx \ - kernel/safe_typing.cmx kernel/term.cmx pretyping/termops.cmx \ - interp/topconstr.cmx kernel/type_errors.cmx lib/util.cmx \ - toplevel/vernacexpr.cmx toplevel/record.cmi -toplevel/toplevel.cmo: toplevel/cerrors.cmi library/lib.cmi \ - toplevel/mltop.cmi kernel/names.cmi lib/options.cmi parsing/pcoq.cmi \ - proofs/pfedit.cmi lib/pp.cmi parsing/printer.cmi \ - toplevel/protectedtoplevel.cmi lib/util.cmi toplevel/vernac.cmi \ - toplevel/vernacexpr.cmo toplevel/toplevel.cmi -toplevel/toplevel.cmx: toplevel/cerrors.cmx library/lib.cmx \ - toplevel/mltop.cmx kernel/names.cmx lib/options.cmx parsing/pcoq.cmx \ - proofs/pfedit.cmx lib/pp.cmx parsing/printer.cmx \ - toplevel/protectedtoplevel.cmx lib/util.cmx toplevel/vernac.cmx \ - toplevel/vernacexpr.cmx toplevel/toplevel.cmi +toplevel/metasyntax.cmo: toplevel/vernacexpr.cmo lib/util.cmi \ + interp/topconstr.cmi tactics/tacinterp.cmi library/summary.cmi \ + pretyping/rawterm.cmi parsing/pptactic.cmi interp/ppextend.cmi lib/pp.cmi \ + parsing/pcoq.cmi lib/options.cmi interp/notation.cmi kernel/names.cmi \ + library/libobject.cmi library/libnames.cmi library/lib.cmi \ + parsing/lexer.cmi library/global.cmi parsing/extend.cmi \ + parsing/egrammar.cmi interp/constrintern.cmi pretyping/classops.cmi \ + lib/bigint.cmi toplevel/metasyntax.cmi +toplevel/metasyntax.cmx: toplevel/vernacexpr.cmx lib/util.cmx \ + interp/topconstr.cmx tactics/tacinterp.cmx library/summary.cmx \ + pretyping/rawterm.cmx parsing/pptactic.cmx interp/ppextend.cmx lib/pp.cmx \ + parsing/pcoq.cmx lib/options.cmx interp/notation.cmx kernel/names.cmx \ + library/libobject.cmx library/libnames.cmx library/lib.cmx \ + parsing/lexer.cmx library/global.cmx parsing/extend.cmx \ + parsing/egrammar.cmx interp/constrintern.cmx pretyping/classops.cmx \ + lib/bigint.cmx toplevel/metasyntax.cmi +toplevel/minicoq.cmo: lib/util.cmi kernel/type_errors.cmi kernel/term.cmi \ + kernel/sign.cmi kernel/safe_typing.cmi lib/pp.cmi kernel/names.cmi \ + kernel/inductive.cmi parsing/g_minicoq.cmi toplevel/fhimsg.cmi \ + kernel/declarations.cmi +toplevel/minicoq.cmx: lib/util.cmx kernel/type_errors.cmx kernel/term.cmx \ + kernel/sign.cmx kernel/safe_typing.cmx lib/pp.cmx kernel/names.cmx \ + kernel/inductive.cmx parsing/g_minicoq.cmx toplevel/fhimsg.cmx \ + kernel/declarations.cmx +toplevel/mltop.cmo: toplevel/vernacinterp.cmi lib/util.cmi lib/system.cmi \ + library/summary.cmi lib/pp.cmi lib/options.cmi kernel/names.cmi \ + library/library.cmi library/libobject.cmi library/lib.cmi \ + toplevel/mltop.cmi +toplevel/mltop.cmx: toplevel/vernacinterp.cmx lib/util.cmx lib/system.cmx \ + library/summary.cmx lib/pp.cmx lib/options.cmx kernel/names.cmx \ + library/library.cmx library/libobject.cmx library/lib.cmx \ + toplevel/mltop.cmi +toplevel/protectedtoplevel.cmo: toplevel/vernacexpr.cmo toplevel/vernac.cmi \ + lib/pp.cmi parsing/pcoq.cmi toplevel/line_oriented_parser.cmi \ + toplevel/cerrors.cmi toplevel/protectedtoplevel.cmi +toplevel/protectedtoplevel.cmx: toplevel/vernacexpr.cmx toplevel/vernac.cmx \ + lib/pp.cmx parsing/pcoq.cmx toplevel/line_oriented_parser.cmx \ + toplevel/cerrors.cmx toplevel/protectedtoplevel.cmi +toplevel/record.cmo: toplevel/vernacexpr.cmo lib/util.cmi \ + kernel/type_errors.cmi interp/topconstr.cmi pretyping/termops.cmi \ + kernel/term.cmi kernel/safe_typing.cmi pretyping/recordops.cmi \ + pretyping/rawterm.cmi parsing/printer.cmi lib/pp.cmi lib/options.cmi \ + library/nametab.cmi kernel/names.cmi library/nameops.cmi \ + library/libnames.cmi pretyping/inductiveops.cmi kernel/inductive.cmi \ + kernel/indtypes.cmi library/global.cmi pretyping/evd.cmi \ + kernel/environ.cmi kernel/entries.cmi library/declare.cmi \ + kernel/declarations.cmi library/decl_kinds.cmo interp/constrintern.cmi \ + toplevel/command.cmi toplevel/class.cmi toplevel/record.cmi +toplevel/record.cmx: toplevel/vernacexpr.cmx lib/util.cmx \ + kernel/type_errors.cmx interp/topconstr.cmx pretyping/termops.cmx \ + kernel/term.cmx kernel/safe_typing.cmx pretyping/recordops.cmx \ + pretyping/rawterm.cmx parsing/printer.cmx lib/pp.cmx lib/options.cmx \ + library/nametab.cmx kernel/names.cmx library/nameops.cmx \ + library/libnames.cmx pretyping/inductiveops.cmx kernel/inductive.cmx \ + kernel/indtypes.cmx library/global.cmx pretyping/evd.cmx \ + kernel/environ.cmx kernel/entries.cmx library/declare.cmx \ + kernel/declarations.cmx library/decl_kinds.cmx interp/constrintern.cmx \ + toplevel/command.cmx toplevel/class.cmx toplevel/record.cmi +toplevel/toplevel.cmo: toplevel/vernacexpr.cmo toplevel/vernac.cmi \ + lib/util.cmi toplevel/protectedtoplevel.cmi parsing/printer.cmi \ + lib/pp.cmi proofs/pfedit.cmi parsing/pcoq.cmi lib/options.cmi \ + kernel/names.cmi toplevel/mltop.cmi library/lib.cmi toplevel/cerrors.cmi \ + toplevel/toplevel.cmi +toplevel/toplevel.cmx: toplevel/vernacexpr.cmx toplevel/vernac.cmx \ + lib/util.cmx toplevel/protectedtoplevel.cmx parsing/printer.cmx \ + lib/pp.cmx proofs/pfedit.cmx parsing/pcoq.cmx lib/options.cmx \ + kernel/names.cmx toplevel/mltop.cmx library/lib.cmx toplevel/cerrors.cmx \ + toplevel/toplevel.cmi toplevel/usage.cmo: config/coq_config.cmi toplevel/usage.cmi toplevel/usage.cmx: config/coq_config.cmx toplevel/usage.cmi -toplevel/vernacentries.cmo: tactics/auto.cmi tactics/autorewrite.cmi \ - toplevel/class.cmi pretyping/classops.cmi toplevel/command.cmi \ - interp/constrextern.cmi interp/constrintern.cmi library/decl_kinds.cmo \ - kernel/declarations.cmi library/declaremods.cmi pretyping/detyping.cmi \ - kernel/entries.cmi kernel/environ.cmi pretyping/evarutil.cmi \ - pretyping/evd.cmi library/global.cmi library/goptions.cmi \ - library/impargs.cmi pretyping/inductiveops.cmi library/lib.cmi \ - library/libnames.cmi library/library.cmi toplevel/metasyntax.cmi \ - toplevel/mltop.cmi interp/modintern.cmi library/nameops.cmi \ - kernel/names.cmi library/nametab.cmi interp/notation.cmi lib/options.cmi \ - proofs/pfedit.cmi lib/pp.cmi lib/pp_control.cmi parsing/prettyp.cmi \ - pretyping/pretyping.cmi parsing/printer.cmi parsing/printmod.cmi \ - proofs/proof_trees.cmi proofs/proof_type.cmi pretyping/rawterm.cmi \ - toplevel/record.cmi pretyping/recordops.cmi proofs/redexpr.cmi \ - pretyping/reductionops.cmi interp/reserve.cmi kernel/safe_typing.cmi \ - parsing/search.cmi tactics/setoid_replace.cmi library/states.cmi \ - interp/syntax_def.cmi lib/system.cmi proofs/tacexpr.cmo \ - tactics/tacinterp.cmi proofs/tacmach.cmi proofs/tactic_debug.cmi \ - parsing/tactic_printer.cmi tactics/tactics.cmi kernel/term.cmi \ - pretyping/termops.cmi interp/topconstr.cmi kernel/typeops.cmi \ - kernel/univ.cmi lib/util.cmi kernel/vconv.cmi toplevel/vernacexpr.cmo \ - toplevel/vernacinterp.cmi kernel/vm.cmi toplevel/vernacentries.cmi -toplevel/vernacentries.cmx: tactics/auto.cmx tactics/autorewrite.cmx \ - toplevel/class.cmx pretyping/classops.cmx toplevel/command.cmx \ - interp/constrextern.cmx interp/constrintern.cmx library/decl_kinds.cmx \ - kernel/declarations.cmx library/declaremods.cmx pretyping/detyping.cmx \ - kernel/entries.cmx kernel/environ.cmx pretyping/evarutil.cmx \ - pretyping/evd.cmx library/global.cmx library/goptions.cmx \ - library/impargs.cmx pretyping/inductiveops.cmx library/lib.cmx \ - library/libnames.cmx library/library.cmx toplevel/metasyntax.cmx \ - toplevel/mltop.cmx interp/modintern.cmx library/nameops.cmx \ - kernel/names.cmx library/nametab.cmx interp/notation.cmx lib/options.cmx \ - proofs/pfedit.cmx lib/pp.cmx lib/pp_control.cmx parsing/prettyp.cmx \ - pretyping/pretyping.cmx parsing/printer.cmx parsing/printmod.cmx \ - proofs/proof_trees.cmx proofs/proof_type.cmx pretyping/rawterm.cmx \ - toplevel/record.cmx pretyping/recordops.cmx proofs/redexpr.cmx \ - pretyping/reductionops.cmx interp/reserve.cmx kernel/safe_typing.cmx \ - parsing/search.cmx tactics/setoid_replace.cmx library/states.cmx \ - interp/syntax_def.cmx lib/system.cmx proofs/tacexpr.cmx \ - tactics/tacinterp.cmx proofs/tacmach.cmx proofs/tactic_debug.cmx \ - parsing/tactic_printer.cmx tactics/tactics.cmx kernel/term.cmx \ - pretyping/termops.cmx interp/topconstr.cmx kernel/typeops.cmx \ - kernel/univ.cmx lib/util.cmx kernel/vconv.cmx toplevel/vernacexpr.cmx \ - toplevel/vernacinterp.cmx kernel/vm.cmx toplevel/vernacentries.cmi -toplevel/vernacexpr.cmo: library/decl_kinds.cmo parsing/extend.cmi \ - interp/genarg.cmi library/goptions.cmi library/libnames.cmi \ - kernel/names.cmi library/nametab.cmi interp/ppextend.cmi \ - pretyping/rawterm.cmi proofs/tacexpr.cmo interp/topconstr.cmi \ - lib/util.cmi -toplevel/vernacexpr.cmx: library/decl_kinds.cmx parsing/extend.cmx \ - interp/genarg.cmx library/goptions.cmx library/libnames.cmx \ - kernel/names.cmx library/nametab.cmx interp/ppextend.cmx \ - pretyping/rawterm.cmx proofs/tacexpr.cmx interp/topconstr.cmx \ - lib/util.cmx -toplevel/vernacinterp.cmo: toplevel/himsg.cmi library/libnames.cmi \ - kernel/names.cmi lib/options.cmi lib/pp.cmi proofs/proof_type.cmi \ - proofs/tacexpr.cmo tactics/tacinterp.cmi lib/util.cmi \ - toplevel/vernacexpr.cmo toplevel/vernacinterp.cmi -toplevel/vernacinterp.cmx: toplevel/himsg.cmx library/libnames.cmx \ - kernel/names.cmx lib/options.cmx lib/pp.cmx proofs/proof_type.cmx \ - proofs/tacexpr.cmx tactics/tacinterp.cmx lib/util.cmx \ - toplevel/vernacexpr.cmx toplevel/vernacinterp.cmi -toplevel/vernac.cmo: interp/constrintern.cmi parsing/lexer.cmi \ - library/lib.cmi library/library.cmi kernel/names.cmi lib/options.cmi \ - parsing/pcoq.cmi proofs/pfedit.cmi lib/pp.cmi parsing/ppvernac.cmi \ - library/states.cmi lib/system.cmi lib/util.cmi toplevel/vernacentries.cmi \ - toplevel/vernacexpr.cmo toplevel/vernacinterp.cmi toplevel/vernac.cmi -toplevel/vernac.cmx: interp/constrintern.cmx parsing/lexer.cmx \ - library/lib.cmx library/library.cmx kernel/names.cmx lib/options.cmx \ - parsing/pcoq.cmx proofs/pfedit.cmx lib/pp.cmx parsing/ppvernac.cmx \ - library/states.cmx lib/system.cmx lib/util.cmx toplevel/vernacentries.cmx \ - toplevel/vernacexpr.cmx toplevel/vernacinterp.cmx toplevel/vernac.cmi -toplevel/whelp.cmo: toplevel/cerrors.cmi toplevel/command.cmi \ - interp/constrintern.cmi pretyping/detyping.cmi \ - library/dischargedhypsmap.cmi parsing/egrammar.cmi kernel/environ.cmi \ - interp/genarg.cmi parsing/lexer.cmi library/libnames.cmi kernel/names.cmi \ - library/nametab.cmi lib/options.cmi parsing/pcoq.cmi proofs/pfedit.cmi \ - lib/pp.cmi pretyping/rawterm.cmi proofs/refiner.cmi interp/syntax_def.cmi \ - lib/system.cmi proofs/tacmach.cmi kernel/term.cmi pretyping/termops.cmi \ - lib/util.cmi toplevel/vernacinterp.cmi toplevel/whelp.cmi -toplevel/whelp.cmx: toplevel/cerrors.cmx toplevel/command.cmx \ - interp/constrintern.cmx pretyping/detyping.cmx \ - library/dischargedhypsmap.cmx parsing/egrammar.cmx kernel/environ.cmx \ - interp/genarg.cmx parsing/lexer.cmx library/libnames.cmx kernel/names.cmx \ - library/nametab.cmx lib/options.cmx parsing/pcoq.cmx proofs/pfedit.cmx \ - lib/pp.cmx pretyping/rawterm.cmx proofs/refiner.cmx interp/syntax_def.cmx \ - lib/system.cmx proofs/tacmach.cmx kernel/term.cmx pretyping/termops.cmx \ - lib/util.cmx toplevel/vernacinterp.cmx toplevel/whelp.cmi -contrib/cc/ccalgo.cmo: library/goptions.cmi kernel/names.cmi lib/pp.cmi \ - kernel/term.cmi lib/util.cmi contrib/cc/ccalgo.cmi -contrib/cc/ccalgo.cmx: library/goptions.cmx kernel/names.cmx lib/pp.cmx \ - kernel/term.cmx lib/util.cmx contrib/cc/ccalgo.cmi -contrib/cc/ccproof.cmo: contrib/cc/ccalgo.cmi kernel/names.cmi lib/util.cmi \ +toplevel/vernacentries.cmo: kernel/vm.cmi toplevel/vernacinterp.cmi \ + toplevel/vernacexpr.cmo kernel/vconv.cmi lib/util.cmi kernel/univ.cmi \ + kernel/typeops.cmi interp/topconstr.cmi pretyping/termops.cmi \ + kernel/term.cmi tactics/tactics.cmi parsing/tactic_printer.cmi \ + proofs/tactic_debug.cmi proofs/tacmach.cmi tactics/tacinterp.cmi \ + proofs/tacexpr.cmo lib/system.cmi interp/syntax_def.cmi \ + library/states.cmi tactics/setoid_replace.cmi parsing/search.cmi \ + kernel/safe_typing.cmi interp/reserve.cmi pretyping/reductionops.cmi \ + proofs/redexpr.cmi pretyping/recordops.cmi toplevel/record.cmi \ + pretyping/rawterm.cmi proofs/proof_type.cmi proofs/proof_trees.cmi \ + parsing/printmod.cmi parsing/printer.cmi pretyping/pretyping.cmi \ + parsing/prettyp.cmi lib/pp_control.cmi lib/pp.cmi proofs/pfedit.cmi \ + lib/options.cmi interp/notation.cmi library/nametab.cmi kernel/names.cmi \ + library/nameops.cmi interp/modintern.cmi toplevel/mltop.cmi \ + toplevel/metasyntax.cmi library/library.cmi library/libnames.cmi \ + library/lib.cmi pretyping/inductiveops.cmi library/impargs.cmi \ + library/goptions.cmi library/global.cmi pretyping/evd.cmi \ + pretyping/evarutil.cmi kernel/environ.cmi kernel/entries.cmi \ + pretyping/detyping.cmi library/declaremods.cmi kernel/declarations.cmi \ + library/decl_kinds.cmo interp/constrintern.cmi interp/constrextern.cmi \ + toplevel/command.cmi pretyping/classops.cmi toplevel/class.cmi \ + tactics/autorewrite.cmi tactics/auto.cmi toplevel/vernacentries.cmi +toplevel/vernacentries.cmx: kernel/vm.cmx toplevel/vernacinterp.cmx \ + toplevel/vernacexpr.cmx kernel/vconv.cmx lib/util.cmx kernel/univ.cmx \ + kernel/typeops.cmx interp/topconstr.cmx pretyping/termops.cmx \ + kernel/term.cmx tactics/tactics.cmx parsing/tactic_printer.cmx \ + proofs/tactic_debug.cmx proofs/tacmach.cmx tactics/tacinterp.cmx \ + proofs/tacexpr.cmx lib/system.cmx interp/syntax_def.cmx \ + library/states.cmx tactics/setoid_replace.cmx parsing/search.cmx \ + kernel/safe_typing.cmx interp/reserve.cmx pretyping/reductionops.cmx \ + proofs/redexpr.cmx pretyping/recordops.cmx toplevel/record.cmx \ + pretyping/rawterm.cmx proofs/proof_type.cmx proofs/proof_trees.cmx \ + parsing/printmod.cmx parsing/printer.cmx pretyping/pretyping.cmx \ + parsing/prettyp.cmx lib/pp_control.cmx lib/pp.cmx proofs/pfedit.cmx \ + lib/options.cmx interp/notation.cmx library/nametab.cmx kernel/names.cmx \ + library/nameops.cmx interp/modintern.cmx toplevel/mltop.cmx \ + toplevel/metasyntax.cmx library/library.cmx library/libnames.cmx \ + library/lib.cmx pretyping/inductiveops.cmx library/impargs.cmx \ + library/goptions.cmx library/global.cmx pretyping/evd.cmx \ + pretyping/evarutil.cmx kernel/environ.cmx kernel/entries.cmx \ + pretyping/detyping.cmx library/declaremods.cmx kernel/declarations.cmx \ + library/decl_kinds.cmx interp/constrintern.cmx interp/constrextern.cmx \ + toplevel/command.cmx pretyping/classops.cmx toplevel/class.cmx \ + tactics/autorewrite.cmx tactics/auto.cmx toplevel/vernacentries.cmi +toplevel/vernacexpr.cmo: lib/util.cmi interp/topconstr.cmi proofs/tacexpr.cmo \ + pretyping/rawterm.cmi interp/ppextend.cmi library/nametab.cmi \ + kernel/names.cmi library/libnames.cmi library/goptions.cmi \ + interp/genarg.cmi parsing/extend.cmi library/decl_kinds.cmo +toplevel/vernacexpr.cmx: lib/util.cmx interp/topconstr.cmx proofs/tacexpr.cmx \ + pretyping/rawterm.cmx interp/ppextend.cmx library/nametab.cmx \ + kernel/names.cmx library/libnames.cmx library/goptions.cmx \ + interp/genarg.cmx parsing/extend.cmx library/decl_kinds.cmx +toplevel/vernacinterp.cmo: toplevel/vernacexpr.cmo lib/util.cmi \ + tactics/tacinterp.cmi proofs/tacexpr.cmo proofs/proof_type.cmi lib/pp.cmi \ + lib/options.cmi kernel/names.cmi library/libnames.cmi toplevel/himsg.cmi \ + toplevel/vernacinterp.cmi +toplevel/vernacinterp.cmx: toplevel/vernacexpr.cmx lib/util.cmx \ + tactics/tacinterp.cmx proofs/tacexpr.cmx proofs/proof_type.cmx lib/pp.cmx \ + lib/options.cmx kernel/names.cmx library/libnames.cmx toplevel/himsg.cmx \ + toplevel/vernacinterp.cmi +toplevel/vernac.cmo: toplevel/vernacinterp.cmi toplevel/vernacexpr.cmo \ + toplevel/vernacentries.cmi lib/util.cmi lib/system.cmi library/states.cmi \ + parsing/ppvernac.cmi lib/pp.cmi proofs/pfedit.cmi parsing/pcoq.cmi \ + lib/options.cmi kernel/names.cmi library/library.cmi library/lib.cmi \ + parsing/lexer.cmi interp/constrintern.cmi toplevel/vernac.cmi +toplevel/vernac.cmx: toplevel/vernacinterp.cmx toplevel/vernacexpr.cmx \ + toplevel/vernacentries.cmx lib/util.cmx lib/system.cmx library/states.cmx \ + parsing/ppvernac.cmx lib/pp.cmx proofs/pfedit.cmx parsing/pcoq.cmx \ + lib/options.cmx kernel/names.cmx library/library.cmx library/lib.cmx \ + parsing/lexer.cmx interp/constrintern.cmx toplevel/vernac.cmi +toplevel/whelp.cmo: toplevel/vernacinterp.cmi lib/util.cmi \ + pretyping/termops.cmi kernel/term.cmi proofs/tacmach.cmi lib/system.cmi \ + interp/syntax_def.cmi proofs/refiner.cmi pretyping/rawterm.cmi lib/pp.cmi \ + proofs/pfedit.cmi parsing/pcoq.cmi lib/options.cmi library/nametab.cmi \ + kernel/names.cmi library/libnames.cmi parsing/lexer.cmi interp/genarg.cmi \ + kernel/environ.cmi parsing/egrammar.cmi library/dischargedhypsmap.cmi \ + pretyping/detyping.cmi interp/constrintern.cmi toplevel/command.cmi \ + toplevel/cerrors.cmi toplevel/whelp.cmi +toplevel/whelp.cmx: toplevel/vernacinterp.cmx lib/util.cmx \ + pretyping/termops.cmx kernel/term.cmx proofs/tacmach.cmx lib/system.cmx \ + interp/syntax_def.cmx proofs/refiner.cmx pretyping/rawterm.cmx lib/pp.cmx \ + proofs/pfedit.cmx parsing/pcoq.cmx lib/options.cmx library/nametab.cmx \ + kernel/names.cmx library/libnames.cmx parsing/lexer.cmx interp/genarg.cmx \ + kernel/environ.cmx parsing/egrammar.cmx library/dischargedhypsmap.cmx \ + pretyping/detyping.cmx interp/constrintern.cmx toplevel/command.cmx \ + toplevel/cerrors.cmx toplevel/whelp.cmi +contrib/cc/ccalgo.cmo: lib/util.cmi kernel/term.cmi lib/pp.cmi \ + kernel/names.cmi library/goptions.cmi contrib/cc/ccalgo.cmi +contrib/cc/ccalgo.cmx: lib/util.cmx kernel/term.cmx lib/pp.cmx \ + kernel/names.cmx library/goptions.cmx contrib/cc/ccalgo.cmi +contrib/cc/ccproof.cmo: lib/util.cmi kernel/names.cmi contrib/cc/ccalgo.cmi \ contrib/cc/ccproof.cmi -contrib/cc/ccproof.cmx: contrib/cc/ccalgo.cmx kernel/names.cmx lib/util.cmx \ +contrib/cc/ccproof.cmx: lib/util.cmx kernel/names.cmx contrib/cc/ccalgo.cmx \ contrib/cc/ccproof.cmi -contrib/cc/cctac.cmo: contrib/cc/ccalgo.cmi contrib/cc/ccproof.cmi \ - kernel/closure.cmi interp/coqlib.cmi kernel/declarations.cmi \ - kernel/environ.cmi pretyping/evd.cmi library/global.cmi \ - pretyping/inductiveops.cmi library/libnames.cmi library/nameops.cmi \ - kernel/names.cmi lib/pp.cmi proofs/proof_type.cmi kernel/sign.cmi \ - tactics/tacinterp.cmi proofs/tacmach.cmi tactics/tacticals.cmi \ - tactics/tactics.cmi kernel/term.cmi pretyping/termops.cmi lib/util.cmi \ +contrib/cc/cctac.cmo: lib/util.cmi pretyping/termops.cmi kernel/term.cmi \ + tactics/tactics.cmi tactics/tacticals.cmi proofs/tacmach.cmi \ + tactics/tacinterp.cmi kernel/sign.cmi proofs/proof_type.cmi lib/pp.cmi \ + kernel/names.cmi library/nameops.cmi library/libnames.cmi \ + pretyping/inductiveops.cmi library/global.cmi pretyping/evd.cmi \ + kernel/environ.cmi kernel/declarations.cmi interp/coqlib.cmi \ + kernel/closure.cmi contrib/cc/ccproof.cmi contrib/cc/ccalgo.cmi \ + contrib/cc/cctac.cmi +contrib/cc/cctac.cmx: lib/util.cmx pretyping/termops.cmx kernel/term.cmx \ + tactics/tactics.cmx tactics/tacticals.cmx proofs/tacmach.cmx \ + tactics/tacinterp.cmx kernel/sign.cmx proofs/proof_type.cmx lib/pp.cmx \ + kernel/names.cmx library/nameops.cmx library/libnames.cmx \ + pretyping/inductiveops.cmx library/global.cmx pretyping/evd.cmx \ + kernel/environ.cmx kernel/declarations.cmx interp/coqlib.cmx \ + kernel/closure.cmx contrib/cc/ccproof.cmx contrib/cc/ccalgo.cmx \ contrib/cc/cctac.cmi -contrib/cc/cctac.cmx: contrib/cc/ccalgo.cmx contrib/cc/ccproof.cmx \ - kernel/closure.cmx interp/coqlib.cmx kernel/declarations.cmx \ - kernel/environ.cmx pretyping/evd.cmx library/global.cmx \ - pretyping/inductiveops.cmx library/libnames.cmx library/nameops.cmx \ - kernel/names.cmx lib/pp.cmx proofs/proof_type.cmx kernel/sign.cmx \ - tactics/tacinterp.cmx proofs/tacmach.cmx tactics/tacticals.cmx \ - tactics/tactics.cmx kernel/term.cmx pretyping/termops.cmx lib/util.cmx \ +contrib/cc/g_congruence.cmo: lib/util.cmi tactics/tactics.cmi \ + tactics/tacticals.cmi tactics/tacinterp.cmi proofs/tacexpr.cmo \ + proofs/refiner.cmi parsing/pptactic.cmi lib/pp.cmi parsing/pcoq.cmi \ + interp/genarg.cmi parsing/egrammar.cmi toplevel/cerrors.cmi \ contrib/cc/cctac.cmi -contrib/cc/g_congruence.cmo: contrib/cc/cctac.cmi toplevel/cerrors.cmi \ - parsing/egrammar.cmi interp/genarg.cmi parsing/pcoq.cmi lib/pp.cmi \ - parsing/pptactic.cmi proofs/refiner.cmi proofs/tacexpr.cmo \ - tactics/tacinterp.cmi tactics/tacticals.cmi tactics/tactics.cmi \ - lib/util.cmi -contrib/cc/g_congruence.cmx: contrib/cc/cctac.cmx toplevel/cerrors.cmx \ - parsing/egrammar.cmx interp/genarg.cmx parsing/pcoq.cmx lib/pp.cmx \ - parsing/pptactic.cmx proofs/refiner.cmx proofs/tacexpr.cmx \ - tactics/tacinterp.cmx tactics/tacticals.cmx tactics/tactics.cmx \ - lib/util.cmx -contrib/correctness/pcicenv.cmo: library/global.cmi kernel/names.cmi \ - kernel/sign.cmi kernel/term.cmi kernel/univ.cmi \ +contrib/cc/g_congruence.cmx: lib/util.cmx tactics/tactics.cmx \ + tactics/tacticals.cmx tactics/tacinterp.cmx proofs/tacexpr.cmx \ + proofs/refiner.cmx parsing/pptactic.cmx lib/pp.cmx parsing/pcoq.cmx \ + interp/genarg.cmx parsing/egrammar.cmx toplevel/cerrors.cmx \ + contrib/cc/cctac.cmx +contrib/correctness/pcicenv.cmo: kernel/univ.cmi kernel/term.cmi \ + kernel/sign.cmi kernel/names.cmi library/global.cmi \ contrib/correctness/pcicenv.cmi -contrib/correctness/pcicenv.cmx: library/global.cmx kernel/names.cmx \ - kernel/sign.cmx kernel/term.cmx kernel/univ.cmx \ +contrib/correctness/pcicenv.cmx: kernel/univ.cmx kernel/term.cmx \ + kernel/sign.cmx kernel/names.cmx library/global.cmx \ contrib/correctness/pcicenv.cmi -contrib/correctness/pcic.cmo: kernel/declarations.cmi library/declare.cmi \ - pretyping/detyping.cmi kernel/entries.cmi library/global.cmi \ - kernel/indtypes.cmi library/libnames.cmi library/nameops.cmi \ - kernel/names.cmi library/nametab.cmi pretyping/rawterm.cmi \ - toplevel/record.cmi kernel/sign.cmi kernel/term.cmi pretyping/termops.cmi \ - interp/topconstr.cmi kernel/typeops.cmi lib/util.cmi \ - toplevel/vernacexpr.cmo contrib/correctness/pcic.cmi -contrib/correctness/pcic.cmx: kernel/declarations.cmx library/declare.cmx \ - pretyping/detyping.cmx kernel/entries.cmx library/global.cmx \ - kernel/indtypes.cmx library/libnames.cmx library/nameops.cmx \ - kernel/names.cmx library/nametab.cmx pretyping/rawterm.cmx \ - toplevel/record.cmx kernel/sign.cmx kernel/term.cmx pretyping/termops.cmx \ - interp/topconstr.cmx kernel/typeops.cmx lib/util.cmx \ - toplevel/vernacexpr.cmx contrib/correctness/pcic.cmi -contrib/correctness/pdb.cmo: interp/constrintern.cmi library/global.cmi \ - kernel/names.cmi library/nametab.cmi kernel/term.cmi \ - pretyping/termops.cmi contrib/correctness/pdb.cmi -contrib/correctness/pdb.cmx: interp/constrintern.cmx library/global.cmx \ - kernel/names.cmx library/nametab.cmx kernel/term.cmx \ - pretyping/termops.cmx contrib/correctness/pdb.cmi -contrib/correctness/peffect.cmo: toplevel/himsg.cmi library/nameops.cmi \ - kernel/names.cmi lib/pp.cmi lib/util.cmi contrib/correctness/peffect.cmi -contrib/correctness/peffect.cmx: toplevel/himsg.cmx library/nameops.cmx \ - kernel/names.cmx lib/pp.cmx lib/util.cmx contrib/correctness/peffect.cmi -contrib/correctness/penv.cmo: toplevel/himsg.cmi library/lib.cmi \ - library/libobject.cmi library/library.cmi library/nameops.cmi \ - kernel/names.cmi lib/options.cmi lib/pp.cmi library/summary.cmi \ - kernel/term.cmi contrib/correctness/penv.cmi -contrib/correctness/penv.cmx: toplevel/himsg.cmx library/lib.cmx \ - library/libobject.cmx library/library.cmx library/nameops.cmx \ - kernel/names.cmx lib/options.cmx lib/pp.cmx library/summary.cmx \ - kernel/term.cmx contrib/correctness/penv.cmi -contrib/correctness/perror.cmo: interp/constrintern.cmi pretyping/evd.cmi \ - library/global.cmi toplevel/himsg.cmi library/nameops.cmi \ - kernel/names.cmi lib/pp.cmi pretyping/reductionops.cmi kernel/term.cmi \ - lib/util.cmi contrib/correctness/perror.cmi -contrib/correctness/perror.cmx: interp/constrintern.cmx pretyping/evd.cmx \ - library/global.cmx toplevel/himsg.cmx library/nameops.cmx \ - kernel/names.cmx lib/pp.cmx pretyping/reductionops.cmx kernel/term.cmx \ - lib/util.cmx contrib/correctness/perror.cmi -contrib/correctness/pextract.cmo: pretyping/evd.cmi toplevel/himsg.cmi \ - library/library.cmi kernel/names.cmi library/nametab.cmi \ - contrib/extraction/ocaml.cmi lib/pp.cmi lib/pp_control.cmi \ - kernel/reduction.cmi pretyping/reductionops.cmi lib/system.cmi \ - kernel/term.cmi lib/util.cmi toplevel/vernacinterp.cmi \ +contrib/correctness/pcic.cmo: toplevel/vernacexpr.cmo lib/util.cmi \ + kernel/typeops.cmi interp/topconstr.cmi pretyping/termops.cmi \ + kernel/term.cmi kernel/sign.cmi toplevel/record.cmi pretyping/rawterm.cmi \ + library/nametab.cmi kernel/names.cmi library/nameops.cmi \ + library/libnames.cmi kernel/indtypes.cmi library/global.cmi \ + kernel/entries.cmi pretyping/detyping.cmi library/declare.cmi \ + kernel/declarations.cmi contrib/correctness/pcic.cmi +contrib/correctness/pcic.cmx: toplevel/vernacexpr.cmx lib/util.cmx \ + kernel/typeops.cmx interp/topconstr.cmx pretyping/termops.cmx \ + kernel/term.cmx kernel/sign.cmx toplevel/record.cmx pretyping/rawterm.cmx \ + library/nametab.cmx kernel/names.cmx library/nameops.cmx \ + library/libnames.cmx kernel/indtypes.cmx library/global.cmx \ + kernel/entries.cmx pretyping/detyping.cmx library/declare.cmx \ + kernel/declarations.cmx contrib/correctness/pcic.cmi +contrib/correctness/pdb.cmo: pretyping/termops.cmi kernel/term.cmi \ + library/nametab.cmi kernel/names.cmi library/global.cmi \ + interp/constrintern.cmi contrib/correctness/pdb.cmi +contrib/correctness/pdb.cmx: pretyping/termops.cmx kernel/term.cmx \ + library/nametab.cmx kernel/names.cmx library/global.cmx \ + interp/constrintern.cmx contrib/correctness/pdb.cmi +contrib/correctness/peffect.cmo: lib/util.cmi lib/pp.cmi kernel/names.cmi \ + library/nameops.cmi toplevel/himsg.cmi contrib/correctness/peffect.cmi +contrib/correctness/peffect.cmx: lib/util.cmx lib/pp.cmx kernel/names.cmx \ + library/nameops.cmx toplevel/himsg.cmx contrib/correctness/peffect.cmi +contrib/correctness/penv.cmo: kernel/term.cmi library/summary.cmi lib/pp.cmi \ + lib/options.cmi kernel/names.cmi library/nameops.cmi library/library.cmi \ + library/libobject.cmi library/lib.cmi toplevel/himsg.cmi \ + contrib/correctness/penv.cmi +contrib/correctness/penv.cmx: kernel/term.cmx library/summary.cmx lib/pp.cmx \ + lib/options.cmx kernel/names.cmx library/nameops.cmx library/library.cmx \ + library/libobject.cmx library/lib.cmx toplevel/himsg.cmx \ + contrib/correctness/penv.cmi +contrib/correctness/perror.cmo: lib/util.cmi kernel/term.cmi \ + pretyping/reductionops.cmi lib/pp.cmi kernel/names.cmi \ + library/nameops.cmi toplevel/himsg.cmi library/global.cmi \ + pretyping/evd.cmi interp/constrintern.cmi contrib/correctness/perror.cmi +contrib/correctness/perror.cmx: lib/util.cmx kernel/term.cmx \ + pretyping/reductionops.cmx lib/pp.cmx kernel/names.cmx \ + library/nameops.cmx toplevel/himsg.cmx library/global.cmx \ + pretyping/evd.cmx interp/constrintern.cmx contrib/correctness/perror.cmi +contrib/correctness/pextract.cmo: toplevel/vernacinterp.cmi lib/util.cmi \ + kernel/term.cmi lib/system.cmi pretyping/reductionops.cmi \ + kernel/reduction.cmi lib/pp_control.cmi lib/pp.cmi \ + contrib/extraction/ocaml.cmi library/nametab.cmi kernel/names.cmi \ + library/library.cmi toplevel/himsg.cmi pretyping/evd.cmi \ contrib/correctness/pextract.cmi -contrib/correctness/pextract.cmx: pretyping/evd.cmx toplevel/himsg.cmx \ - library/library.cmx kernel/names.cmx library/nametab.cmx \ - contrib/extraction/ocaml.cmx lib/pp.cmx lib/pp_control.cmx \ - kernel/reduction.cmx pretyping/reductionops.cmx lib/system.cmx \ - kernel/term.cmx lib/util.cmx toplevel/vernacinterp.cmx \ +contrib/correctness/pextract.cmx: toplevel/vernacinterp.cmx lib/util.cmx \ + kernel/term.cmx lib/system.cmx pretyping/reductionops.cmx \ + kernel/reduction.cmx lib/pp_control.cmx lib/pp.cmx \ + contrib/extraction/ocaml.cmx library/nametab.cmx kernel/names.cmx \ + library/library.cmx toplevel/himsg.cmx pretyping/evd.cmx \ contrib/correctness/pextract.cmi -contrib/correctness/pmisc.cmo: interp/constrextern.cmi \ - interp/constrintern.cmi pretyping/evarutil.cmi library/global.cmi \ - library/libnames.cmi library/nameops.cmi kernel/names.cmi lib/options.cmi \ - lib/pp.cmi kernel/term.cmi interp/topconstr.cmi lib/util.cmi \ +contrib/correctness/pmisc.cmo: lib/util.cmi interp/topconstr.cmi \ + kernel/term.cmi lib/pp.cmi lib/options.cmi kernel/names.cmi \ + library/nameops.cmi library/libnames.cmi library/global.cmi \ + pretyping/evarutil.cmi interp/constrintern.cmi interp/constrextern.cmi \ contrib/correctness/pmisc.cmi -contrib/correctness/pmisc.cmx: interp/constrextern.cmx \ - interp/constrintern.cmx pretyping/evarutil.cmx library/global.cmx \ - library/libnames.cmx library/nameops.cmx kernel/names.cmx lib/options.cmx \ - lib/pp.cmx kernel/term.cmx interp/topconstr.cmx lib/util.cmx \ +contrib/correctness/pmisc.cmx: lib/util.cmx interp/topconstr.cmx \ + kernel/term.cmx lib/pp.cmx lib/options.cmx kernel/names.cmx \ + library/nameops.cmx library/libnames.cmx library/global.cmx \ + pretyping/evarutil.cmx interp/constrintern.cmx interp/constrextern.cmx \ contrib/correctness/pmisc.cmi -contrib/correctness/pmlize.cmo: pretyping/evd.cmi library/global.cmi \ - tactics/hipattern.cmi pretyping/matching.cmi kernel/names.cmi \ - pretyping/pattern.cmi pretyping/reductionops.cmi kernel/term.cmi \ - pretyping/typing.cmi lib/util.cmi contrib/correctness/pmlize.cmi -contrib/correctness/pmlize.cmx: pretyping/evd.cmx library/global.cmx \ - tactics/hipattern.cmx pretyping/matching.cmx kernel/names.cmx \ - pretyping/pattern.cmx pretyping/reductionops.cmx kernel/term.cmx \ - pretyping/typing.cmx lib/util.cmx contrib/correctness/pmlize.cmi -contrib/correctness/pmonad.cmo: kernel/names.cmi kernel/term.cmi lib/util.cmi \ +contrib/correctness/pmlize.cmo: lib/util.cmi pretyping/typing.cmi \ + kernel/term.cmi pretyping/reductionops.cmi pretyping/pattern.cmi \ + kernel/names.cmi pretyping/matching.cmi tactics/hipattern.cmi \ + library/global.cmi pretyping/evd.cmi contrib/correctness/pmlize.cmi +contrib/correctness/pmlize.cmx: lib/util.cmx pretyping/typing.cmx \ + kernel/term.cmx pretyping/reductionops.cmx pretyping/pattern.cmx \ + kernel/names.cmx pretyping/matching.cmx tactics/hipattern.cmx \ + library/global.cmx pretyping/evd.cmx contrib/correctness/pmlize.cmi +contrib/correctness/pmonad.cmo: lib/util.cmi kernel/term.cmi kernel/names.cmi \ contrib/correctness/pmonad.cmi -contrib/correctness/pmonad.cmx: kernel/names.cmx kernel/term.cmx lib/util.cmx \ +contrib/correctness/pmonad.cmx: lib/util.cmx kernel/term.cmx kernel/names.cmx \ contrib/correctness/pmonad.cmi -contrib/correctness/pred.cmo: pretyping/evd.cmi library/global.cmi lib/pp.cmi \ - pretyping/reductionops.cmi kernel/term.cmi contrib/correctness/pred.cmi -contrib/correctness/pred.cmx: pretyping/evd.cmx library/global.cmx lib/pp.cmx \ - pretyping/reductionops.cmx kernel/term.cmx contrib/correctness/pred.cmi -contrib/correctness/prename.cmo: toplevel/himsg.cmi library/nameops.cmi \ - kernel/names.cmi lib/pp.cmi lib/util.cmi contrib/correctness/prename.cmi -contrib/correctness/prename.cmx: toplevel/himsg.cmx library/nameops.cmx \ - kernel/names.cmx lib/pp.cmx lib/util.cmx contrib/correctness/prename.cmi -contrib/correctness/ptactic.cmo: interp/coqlib.cmi library/decl_kinds.cmo \ - tactics/equality.cmi pretyping/evd.cmi tactics/extratactics.cmi \ - library/global.cmi library/libnames.cmi library/nameops.cmi \ - kernel/names.cmi library/nametab.cmi lib/options.cmi \ - pretyping/pattern.cmi proofs/pfedit.cmi lib/pp.cmi \ - pretyping/pretyping.cmi parsing/printer.cmi kernel/reduction.cmi \ - proofs/tacmach.cmi tactics/tacticals.cmi tactics/tactics.cmi \ - kernel/term.cmi pretyping/termops.cmi lib/util.cmi \ - toplevel/vernacentries.cmi contrib/correctness/ptactic.cmi -contrib/correctness/ptactic.cmx: interp/coqlib.cmx library/decl_kinds.cmx \ - tactics/equality.cmx pretyping/evd.cmx tactics/extratactics.cmx \ - library/global.cmx library/libnames.cmx library/nameops.cmx \ - kernel/names.cmx library/nametab.cmx lib/options.cmx \ - pretyping/pattern.cmx proofs/pfedit.cmx lib/pp.cmx \ - pretyping/pretyping.cmx parsing/printer.cmx kernel/reduction.cmx \ - proofs/tacmach.cmx tactics/tacticals.cmx tactics/tactics.cmx \ - kernel/term.cmx pretyping/termops.cmx lib/util.cmx \ - toplevel/vernacentries.cmx contrib/correctness/ptactic.cmi -contrib/correctness/ptyping.cmo: interp/constrintern.cmi kernel/environ.cmi \ - pretyping/evd.cmi library/global.cmi toplevel/himsg.cmi kernel/names.cmi \ - lib/pp.cmi proofs/proof_trees.cmi pretyping/reductionops.cmi \ - kernel/term.cmi pretyping/termops.cmi interp/topconstr.cmi \ - pretyping/typing.cmi lib/util.cmi contrib/correctness/ptyping.cmi -contrib/correctness/ptyping.cmx: interp/constrintern.cmx kernel/environ.cmx \ - pretyping/evd.cmx library/global.cmx toplevel/himsg.cmx kernel/names.cmx \ - lib/pp.cmx proofs/proof_trees.cmx pretyping/reductionops.cmx \ - kernel/term.cmx pretyping/termops.cmx interp/topconstr.cmx \ - pretyping/typing.cmx lib/util.cmx contrib/correctness/ptyping.cmi -contrib/correctness/putil.cmo: kernel/environ.cmi library/global.cmi \ - tactics/hipattern.cmi pretyping/matching.cmi library/nameops.cmi \ - kernel/names.cmi pretyping/pattern.cmi lib/pp.cmi parsing/printer.cmi \ - kernel/term.cmi pretyping/termops.cmi lib/util.cmi \ +contrib/correctness/pred.cmo: kernel/term.cmi pretyping/reductionops.cmi \ + lib/pp.cmi library/global.cmi pretyping/evd.cmi \ + contrib/correctness/pred.cmi +contrib/correctness/pred.cmx: kernel/term.cmx pretyping/reductionops.cmx \ + lib/pp.cmx library/global.cmx pretyping/evd.cmx \ + contrib/correctness/pred.cmi +contrib/correctness/prename.cmo: lib/util.cmi lib/pp.cmi kernel/names.cmi \ + library/nameops.cmi toplevel/himsg.cmi contrib/correctness/prename.cmi +contrib/correctness/prename.cmx: lib/util.cmx lib/pp.cmx kernel/names.cmx \ + library/nameops.cmx toplevel/himsg.cmx contrib/correctness/prename.cmi +contrib/correctness/ptactic.cmo: toplevel/vernacentries.cmi lib/util.cmi \ + pretyping/termops.cmi kernel/term.cmi tactics/tactics.cmi \ + tactics/tacticals.cmi proofs/tacmach.cmi kernel/reduction.cmi \ + parsing/printer.cmi pretyping/pretyping.cmi lib/pp.cmi proofs/pfedit.cmi \ + pretyping/pattern.cmi lib/options.cmi library/nametab.cmi \ + kernel/names.cmi library/nameops.cmi library/libnames.cmi \ + library/global.cmi tactics/extratactics.cmi pretyping/evd.cmi \ + tactics/equality.cmi library/decl_kinds.cmo interp/coqlib.cmi \ + contrib/correctness/ptactic.cmi +contrib/correctness/ptactic.cmx: toplevel/vernacentries.cmx lib/util.cmx \ + pretyping/termops.cmx kernel/term.cmx tactics/tactics.cmx \ + tactics/tacticals.cmx proofs/tacmach.cmx kernel/reduction.cmx \ + parsing/printer.cmx pretyping/pretyping.cmx lib/pp.cmx proofs/pfedit.cmx \ + pretyping/pattern.cmx lib/options.cmx library/nametab.cmx \ + kernel/names.cmx library/nameops.cmx library/libnames.cmx \ + library/global.cmx tactics/extratactics.cmx pretyping/evd.cmx \ + tactics/equality.cmx library/decl_kinds.cmx interp/coqlib.cmx \ + contrib/correctness/ptactic.cmi +contrib/correctness/ptyping.cmo: lib/util.cmi pretyping/typing.cmi \ + interp/topconstr.cmi pretyping/termops.cmi kernel/term.cmi \ + pretyping/reductionops.cmi proofs/proof_trees.cmi lib/pp.cmi \ + kernel/names.cmi toplevel/himsg.cmi library/global.cmi pretyping/evd.cmi \ + kernel/environ.cmi interp/constrintern.cmi \ + contrib/correctness/ptyping.cmi +contrib/correctness/ptyping.cmx: lib/util.cmx pretyping/typing.cmx \ + interp/topconstr.cmx pretyping/termops.cmx kernel/term.cmx \ + pretyping/reductionops.cmx proofs/proof_trees.cmx lib/pp.cmx \ + kernel/names.cmx toplevel/himsg.cmx library/global.cmx pretyping/evd.cmx \ + kernel/environ.cmx interp/constrintern.cmx \ + contrib/correctness/ptyping.cmi +contrib/correctness/putil.cmo: lib/util.cmi pretyping/termops.cmi \ + kernel/term.cmi parsing/printer.cmi lib/pp.cmi pretyping/pattern.cmi \ + kernel/names.cmi library/nameops.cmi pretyping/matching.cmi \ + tactics/hipattern.cmi library/global.cmi kernel/environ.cmi \ contrib/correctness/putil.cmi -contrib/correctness/putil.cmx: kernel/environ.cmx library/global.cmx \ - tactics/hipattern.cmx pretyping/matching.cmx library/nameops.cmx \ - kernel/names.cmx pretyping/pattern.cmx lib/pp.cmx parsing/printer.cmx \ - kernel/term.cmx pretyping/termops.cmx lib/util.cmx \ +contrib/correctness/putil.cmx: lib/util.cmx pretyping/termops.cmx \ + kernel/term.cmx parsing/printer.cmx lib/pp.cmx pretyping/pattern.cmx \ + kernel/names.cmx library/nameops.cmx pretyping/matching.cmx \ + tactics/hipattern.cmx library/global.cmx kernel/environ.cmx \ contrib/correctness/putil.cmi -contrib/correctness/pwp.cmo: kernel/environ.cmi library/global.cmi \ - tactics/hipattern.cmi library/libnames.cmi kernel/names.cmi \ - library/nametab.cmi kernel/reduction.cmi pretyping/reductionops.cmi \ - kernel/term.cmi pretyping/termops.cmi lib/util.cmi \ +contrib/correctness/pwp.cmo: lib/util.cmi pretyping/termops.cmi \ + kernel/term.cmi pretyping/reductionops.cmi kernel/reduction.cmi \ + library/nametab.cmi kernel/names.cmi library/libnames.cmi \ + tactics/hipattern.cmi library/global.cmi kernel/environ.cmi \ contrib/correctness/pwp.cmi -contrib/correctness/pwp.cmx: kernel/environ.cmx library/global.cmx \ - tactics/hipattern.cmx library/libnames.cmx kernel/names.cmx \ - library/nametab.cmx kernel/reduction.cmx pretyping/reductionops.cmx \ - kernel/term.cmx pretyping/termops.cmx lib/util.cmx \ +contrib/correctness/pwp.cmx: lib/util.cmx pretyping/termops.cmx \ + kernel/term.cmx pretyping/reductionops.cmx kernel/reduction.cmx \ + library/nametab.cmx kernel/names.cmx library/libnames.cmx \ + tactics/hipattern.cmx library/global.cmx kernel/environ.cmx \ contrib/correctness/pwp.cmi contrib/dp/dp_cvcl.cmo: contrib/dp/fol.cmi contrib/dp/dp_cvcl.cmi contrib/dp/dp_cvcl.cmx: contrib/dp/fol.cmi contrib/dp/dp_cvcl.cmi -contrib/dp/dp.cmo: interp/coqlib.cmi kernel/declarations.cmi \ - contrib/dp/dp_why.cmo kernel/environ.cmi pretyping/evd.cmi \ - contrib/dp/fol.cmi library/global.cmi tactics/hipattern.cmi \ - library/libnames.cmi library/nameops.cmi kernel/names.cmi \ - library/nametab.cmi lib/pp.cmi parsing/printer.cmi \ - pretyping/reductionops.cmi library/summary.cmi proofs/tacmach.cmi \ - tactics/tacticals.cmi tactics/tactics.cmi kernel/term.cmi \ - pretyping/termops.cmi pretyping/typing.cmi lib/util.cmi contrib/dp/dp.cmi -contrib/dp/dp.cmx: interp/coqlib.cmx kernel/declarations.cmx \ - contrib/dp/dp_why.cmx kernel/environ.cmx pretyping/evd.cmx \ - contrib/dp/fol.cmi library/global.cmx tactics/hipattern.cmx \ - library/libnames.cmx library/nameops.cmx kernel/names.cmx \ - library/nametab.cmx lib/pp.cmx parsing/printer.cmx \ - pretyping/reductionops.cmx library/summary.cmx proofs/tacmach.cmx \ - tactics/tacticals.cmx tactics/tactics.cmx kernel/term.cmx \ - pretyping/termops.cmx pretyping/typing.cmx lib/util.cmx contrib/dp/dp.cmi +contrib/dp/dp.cmo: lib/util.cmi pretyping/typing.cmi pretyping/termops.cmi \ + kernel/term.cmi tactics/tactics.cmi tactics/tacticals.cmi \ + proofs/tacmach.cmi library/summary.cmi pretyping/reductionops.cmi \ + parsing/printer.cmi lib/pp.cmi library/nametab.cmi kernel/names.cmi \ + library/nameops.cmi library/libnames.cmi tactics/hipattern.cmi \ + library/global.cmi contrib/dp/fol.cmi pretyping/evd.cmi \ + kernel/environ.cmi contrib/dp/dp_why.cmo kernel/declarations.cmi \ + interp/coqlib.cmi contrib/dp/dp.cmi +contrib/dp/dp.cmx: lib/util.cmx pretyping/typing.cmx pretyping/termops.cmx \ + kernel/term.cmx tactics/tactics.cmx tactics/tacticals.cmx \ + proofs/tacmach.cmx library/summary.cmx pretyping/reductionops.cmx \ + parsing/printer.cmx lib/pp.cmx library/nametab.cmx kernel/names.cmx \ + library/nameops.cmx library/libnames.cmx tactics/hipattern.cmx \ + library/global.cmx contrib/dp/fol.cmi pretyping/evd.cmx \ + kernel/environ.cmx contrib/dp/dp_why.cmx kernel/declarations.cmx \ + interp/coqlib.cmx contrib/dp/dp.cmi contrib/dp/dp_simplify.cmo: contrib/dp/fol.cmi contrib/dp/dp_simplify.cmi contrib/dp/dp_simplify.cmx: contrib/dp/fol.cmi contrib/dp/dp_simplify.cmi contrib/dp/dp_sorts.cmo: contrib/dp/fol.cmi contrib/dp/dp_sorts.cmi contrib/dp/dp_sorts.cmx: contrib/dp/fol.cmi contrib/dp/dp_sorts.cmi contrib/dp/dp_why.cmo: contrib/dp/fol.cmi contrib/dp/dp_why.cmx: contrib/dp/fol.cmi -contrib/dp/dp_zenon.cmo: contrib/dp/fol.cmi lib/util.cmi \ +contrib/dp/dp_zenon.cmo: lib/util.cmi contrib/dp/fol.cmi \ contrib/dp/dp_zenon.cmi -contrib/dp/dp_zenon.cmx: contrib/dp/fol.cmi lib/util.cmx \ +contrib/dp/dp_zenon.cmx: lib/util.cmx contrib/dp/fol.cmi \ contrib/dp/dp_zenon.cmi -contrib/dp/g_dp.cmo: toplevel/cerrors.cmi contrib/dp/dp.cmi \ - parsing/egrammar.cmi interp/genarg.cmi parsing/pcoq.cmi lib/pp.cmi \ - parsing/pptactic.cmi proofs/refiner.cmi proofs/tacexpr.cmo \ - tactics/tacinterp.cmi tactics/tactics.cmi lib/util.cmi \ - toplevel/vernacinterp.cmi -contrib/dp/g_dp.cmx: toplevel/cerrors.cmx contrib/dp/dp.cmx \ - parsing/egrammar.cmx interp/genarg.cmx parsing/pcoq.cmx lib/pp.cmx \ - parsing/pptactic.cmx proofs/refiner.cmx proofs/tacexpr.cmx \ - tactics/tacinterp.cmx tactics/tactics.cmx lib/util.cmx \ - toplevel/vernacinterp.cmx -contrib/extraction/common.cmo: kernel/declarations.cmi \ - contrib/extraction/extraction.cmi library/global.cmi lib/gset.cmi \ - contrib/extraction/haskell.cmi library/libnames.cmi \ - contrib/extraction/miniml.cmi kernel/modops.cmi \ - contrib/extraction/modutil.cmi library/nameops.cmi kernel/names.cmi \ - contrib/extraction/ocaml.cmi lib/options.cmi lib/pp.cmi \ - lib/pp_control.cmi contrib/extraction/scheme.cmi \ - contrib/extraction/table.cmi kernel/term.cmi lib/util.cmi \ - contrib/extraction/common.cmi -contrib/extraction/common.cmx: kernel/declarations.cmx \ - contrib/extraction/extraction.cmx library/global.cmx lib/gset.cmx \ - contrib/extraction/haskell.cmx library/libnames.cmx \ - contrib/extraction/miniml.cmi kernel/modops.cmx \ - contrib/extraction/modutil.cmx library/nameops.cmx kernel/names.cmx \ - contrib/extraction/ocaml.cmx lib/options.cmx lib/pp.cmx \ - lib/pp_control.cmx contrib/extraction/scheme.cmx \ - contrib/extraction/table.cmx kernel/term.cmx lib/util.cmx \ - contrib/extraction/common.cmi -contrib/extraction/extract_env.cmo: contrib/extraction/common.cmi \ - kernel/declarations.cmi contrib/extraction/extraction.cmi \ - library/global.cmi library/lib.cmi library/libnames.cmi \ - library/libobject.cmi library/library.cmi contrib/extraction/miniml.cmi \ - kernel/mod_subst.cmi kernel/modops.cmi contrib/extraction/modutil.cmi \ - kernel/names.cmi library/nametab.cmi lib/pp.cmi kernel/reduction.cmi \ - contrib/extraction/table.cmi kernel/term.cmi lib/util.cmi \ +contrib/dp/g_dp.cmo: toplevel/vernacinterp.cmi lib/util.cmi \ + tactics/tactics.cmi tactics/tacinterp.cmi proofs/tacexpr.cmo \ + proofs/refiner.cmi parsing/pptactic.cmi lib/pp.cmi parsing/pcoq.cmi \ + interp/genarg.cmi parsing/egrammar.cmi contrib/dp/dp.cmi \ + toplevel/cerrors.cmi +contrib/dp/g_dp.cmx: toplevel/vernacinterp.cmx lib/util.cmx \ + tactics/tactics.cmx tactics/tacinterp.cmx proofs/tacexpr.cmx \ + proofs/refiner.cmx parsing/pptactic.cmx lib/pp.cmx parsing/pcoq.cmx \ + interp/genarg.cmx parsing/egrammar.cmx contrib/dp/dp.cmx \ + toplevel/cerrors.cmx +contrib/extraction/common.cmo: lib/util.cmi kernel/term.cmi \ + contrib/extraction/table.cmi contrib/extraction/scheme.cmi \ + lib/pp_control.cmi lib/pp.cmi lib/options.cmi \ + contrib/extraction/ocaml.cmi kernel/names.cmi library/nameops.cmi \ + contrib/extraction/modutil.cmi kernel/modops.cmi \ + contrib/extraction/mlutil.cmi contrib/extraction/miniml.cmi \ + library/libnames.cmi kernel/inductive.cmi contrib/extraction/haskell.cmi \ + lib/gset.cmi library/global.cmi contrib/extraction/extraction.cmi \ + kernel/declarations.cmi contrib/extraction/common.cmi +contrib/extraction/common.cmx: lib/util.cmx kernel/term.cmx \ + contrib/extraction/table.cmx contrib/extraction/scheme.cmx \ + lib/pp_control.cmx lib/pp.cmx lib/options.cmx \ + contrib/extraction/ocaml.cmx kernel/names.cmx library/nameops.cmx \ + contrib/extraction/modutil.cmx kernel/modops.cmx \ + contrib/extraction/mlutil.cmx contrib/extraction/miniml.cmi \ + library/libnames.cmx kernel/inductive.cmx contrib/extraction/haskell.cmx \ + lib/gset.cmx library/global.cmx contrib/extraction/extraction.cmx \ + kernel/declarations.cmx contrib/extraction/common.cmi +contrib/extraction/extract_env.cmo: lib/util.cmi kernel/term.cmi \ + contrib/extraction/table.cmi kernel/reduction.cmi lib/pp.cmi \ + library/nametab.cmi kernel/names.cmi contrib/extraction/modutil.cmi \ + kernel/modops.cmi kernel/mod_subst.cmi contrib/extraction/miniml.cmi \ + library/library.cmi library/libobject.cmi library/libnames.cmi \ + library/lib.cmi library/global.cmi contrib/extraction/extraction.cmi \ + kernel/declarations.cmi contrib/extraction/common.cmi \ contrib/extraction/extract_env.cmi -contrib/extraction/extract_env.cmx: contrib/extraction/common.cmx \ - kernel/declarations.cmx contrib/extraction/extraction.cmx \ - library/global.cmx library/lib.cmx library/libnames.cmx \ - library/libobject.cmx library/library.cmx contrib/extraction/miniml.cmi \ - kernel/mod_subst.cmx kernel/modops.cmx contrib/extraction/modutil.cmx \ - kernel/names.cmx library/nametab.cmx lib/pp.cmx kernel/reduction.cmx \ - contrib/extraction/table.cmx kernel/term.cmx lib/util.cmx \ +contrib/extraction/extract_env.cmx: lib/util.cmx kernel/term.cmx \ + contrib/extraction/table.cmx kernel/reduction.cmx lib/pp.cmx \ + library/nametab.cmx kernel/names.cmx contrib/extraction/modutil.cmx \ + kernel/modops.cmx kernel/mod_subst.cmx contrib/extraction/miniml.cmi \ + library/library.cmx library/libobject.cmx library/libnames.cmx \ + library/lib.cmx library/global.cmx contrib/extraction/extraction.cmx \ + kernel/declarations.cmx contrib/extraction/common.cmx \ contrib/extraction/extract_env.cmi -contrib/extraction/extraction.cmo: kernel/declarations.cmi kernel/environ.cmi \ - pretyping/evd.cmi kernel/inductive.cmi pretyping/inductiveops.cmi \ - library/libnames.cmi contrib/extraction/miniml.cmi \ - contrib/extraction/mlutil.cmi library/nameops.cmi kernel/names.cmi \ - library/nametab.cmi pretyping/recordops.cmi kernel/reduction.cmi \ - pretyping/reductionops.cmi pretyping/retyping.cmi library/summary.cmi \ - contrib/extraction/table.cmi kernel/term.cmi pretyping/termops.cmi \ - lib/util.cmi contrib/extraction/extraction.cmi -contrib/extraction/extraction.cmx: kernel/declarations.cmx kernel/environ.cmx \ - pretyping/evd.cmx kernel/inductive.cmx pretyping/inductiveops.cmx \ - library/libnames.cmx contrib/extraction/miniml.cmi \ - contrib/extraction/mlutil.cmx library/nameops.cmx kernel/names.cmx \ - library/nametab.cmx pretyping/recordops.cmx kernel/reduction.cmx \ - pretyping/reductionops.cmx pretyping/retyping.cmx library/summary.cmx \ - contrib/extraction/table.cmx kernel/term.cmx pretyping/termops.cmx \ - lib/util.cmx contrib/extraction/extraction.cmi -contrib/extraction/g_extraction.cmo: toplevel/cerrors.cmi \ - parsing/egrammar.cmi contrib/extraction/extract_env.cmi interp/genarg.cmi \ - parsing/lexer.cmi parsing/pcoq.cmi lib/pp.cmi parsing/pptactic.cmi \ - contrib/extraction/table.cmi tactics/tacinterp.cmi lib/util.cmi \ - toplevel/vernacexpr.cmo toplevel/vernacinterp.cmi -contrib/extraction/g_extraction.cmx: toplevel/cerrors.cmx \ - parsing/egrammar.cmx contrib/extraction/extract_env.cmx interp/genarg.cmx \ - parsing/lexer.cmx parsing/pcoq.cmx lib/pp.cmx parsing/pptactic.cmx \ - contrib/extraction/table.cmx tactics/tacinterp.cmx lib/util.cmx \ - toplevel/vernacexpr.cmx toplevel/vernacinterp.cmx -contrib/extraction/haskell.cmo: library/libnames.cmi \ - contrib/extraction/miniml.cmi contrib/extraction/mlutil.cmi \ - library/nameops.cmi kernel/names.cmi contrib/extraction/ocaml.cmi \ - lib/pp.cmi contrib/extraction/table.cmi lib/util.cmi \ +contrib/extraction/extraction.cmo: lib/util.cmi pretyping/termops.cmi \ + kernel/term.cmi contrib/extraction/table.cmi library/summary.cmi \ + pretyping/retyping.cmi pretyping/reductionops.cmi kernel/reduction.cmi \ + pretyping/recordops.cmi library/nametab.cmi kernel/names.cmi \ + library/nameops.cmi contrib/extraction/mlutil.cmi \ + contrib/extraction/miniml.cmi library/libnames.cmi \ + pretyping/inductiveops.cmi kernel/inductive.cmi pretyping/evd.cmi \ + kernel/environ.cmi kernel/declarations.cmi \ + contrib/extraction/extraction.cmi +contrib/extraction/extraction.cmx: lib/util.cmx pretyping/termops.cmx \ + kernel/term.cmx contrib/extraction/table.cmx library/summary.cmx \ + pretyping/retyping.cmx pretyping/reductionops.cmx kernel/reduction.cmx \ + pretyping/recordops.cmx library/nametab.cmx kernel/names.cmx \ + library/nameops.cmx contrib/extraction/mlutil.cmx \ + contrib/extraction/miniml.cmi library/libnames.cmx \ + pretyping/inductiveops.cmx kernel/inductive.cmx pretyping/evd.cmx \ + kernel/environ.cmx kernel/declarations.cmx \ + contrib/extraction/extraction.cmi +contrib/extraction/g_extraction.cmo: toplevel/vernacinterp.cmi \ + toplevel/vernacexpr.cmo lib/util.cmi tactics/tacinterp.cmi \ + contrib/extraction/table.cmi parsing/pptactic.cmi lib/pp.cmi \ + parsing/pcoq.cmi parsing/lexer.cmi interp/genarg.cmi \ + contrib/extraction/extract_env.cmi parsing/egrammar.cmi \ + toplevel/cerrors.cmi +contrib/extraction/g_extraction.cmx: toplevel/vernacinterp.cmx \ + toplevel/vernacexpr.cmx lib/util.cmx tactics/tacinterp.cmx \ + contrib/extraction/table.cmx parsing/pptactic.cmx lib/pp.cmx \ + parsing/pcoq.cmx parsing/lexer.cmx interp/genarg.cmx \ + contrib/extraction/extract_env.cmx parsing/egrammar.cmx \ + toplevel/cerrors.cmx +contrib/extraction/haskell.cmo: lib/util.cmi contrib/extraction/table.cmi \ + lib/pp.cmi contrib/extraction/ocaml.cmi kernel/names.cmi \ + library/nameops.cmi contrib/extraction/mlutil.cmi \ + contrib/extraction/miniml.cmi library/libnames.cmi \ contrib/extraction/haskell.cmi -contrib/extraction/haskell.cmx: library/libnames.cmx \ - contrib/extraction/miniml.cmi contrib/extraction/mlutil.cmx \ - library/nameops.cmx kernel/names.cmx contrib/extraction/ocaml.cmx \ - lib/pp.cmx contrib/extraction/table.cmx lib/util.cmx \ +contrib/extraction/haskell.cmx: lib/util.cmx contrib/extraction/table.cmx \ + lib/pp.cmx contrib/extraction/ocaml.cmx kernel/names.cmx \ + library/nameops.cmx contrib/extraction/mlutil.cmx \ + contrib/extraction/miniml.cmi library/libnames.cmx \ contrib/extraction/haskell.cmi -contrib/extraction/mlutil.cmo: library/libnames.cmi \ - contrib/extraction/miniml.cmi kernel/names.cmi library/nametab.cmi \ - lib/pp.cmi contrib/extraction/table.cmi lib/util.cmi \ +contrib/extraction/mlutil.cmo: lib/util.cmi contrib/extraction/table.cmi \ + lib/pp.cmi library/nametab.cmi kernel/names.cmi \ + contrib/extraction/miniml.cmi library/libnames.cmi \ contrib/extraction/mlutil.cmi -contrib/extraction/mlutil.cmx: library/libnames.cmx \ - contrib/extraction/miniml.cmi kernel/names.cmx library/nametab.cmx \ - lib/pp.cmx contrib/extraction/table.cmx lib/util.cmx \ +contrib/extraction/mlutil.cmx: lib/util.cmx contrib/extraction/table.cmx \ + lib/pp.cmx library/nametab.cmx kernel/names.cmx \ + contrib/extraction/miniml.cmi library/libnames.cmx \ contrib/extraction/mlutil.cmi -contrib/extraction/modutil.cmo: kernel/declarations.cmi kernel/environ.cmi \ - library/libnames.cmi contrib/extraction/miniml.cmi \ - contrib/extraction/mlutil.cmi kernel/mod_subst.cmi kernel/modops.cmi \ - kernel/names.cmi contrib/extraction/table.cmi lib/util.cmi \ +contrib/extraction/modutil.cmo: lib/util.cmi contrib/extraction/table.cmi \ + kernel/names.cmi kernel/modops.cmi kernel/mod_subst.cmi \ + contrib/extraction/mlutil.cmi contrib/extraction/miniml.cmi \ + library/libnames.cmi kernel/environ.cmi kernel/declarations.cmi \ contrib/extraction/modutil.cmi -contrib/extraction/modutil.cmx: kernel/declarations.cmx kernel/environ.cmx \ - library/libnames.cmx contrib/extraction/miniml.cmi \ - contrib/extraction/mlutil.cmx kernel/mod_subst.cmx kernel/modops.cmx \ - kernel/names.cmx contrib/extraction/table.cmx lib/util.cmx \ +contrib/extraction/modutil.cmx: lib/util.cmx contrib/extraction/table.cmx \ + kernel/names.cmx kernel/modops.cmx kernel/mod_subst.cmx \ + contrib/extraction/mlutil.cmx contrib/extraction/miniml.cmi \ + library/libnames.cmx kernel/environ.cmx kernel/declarations.cmx \ contrib/extraction/modutil.cmi -contrib/extraction/ocaml.cmo: library/libnames.cmi \ - contrib/extraction/miniml.cmi contrib/extraction/mlutil.cmi \ - contrib/extraction/modutil.cmi library/nameops.cmi kernel/names.cmi \ - lib/pp.cmi contrib/extraction/table.cmi lib/util.cmi \ +contrib/extraction/ocaml.cmo: lib/util.cmi contrib/extraction/table.cmi \ + lib/pp.cmi kernel/names.cmi library/nameops.cmi \ + contrib/extraction/modutil.cmi contrib/extraction/mlutil.cmi \ + contrib/extraction/miniml.cmi library/libnames.cmi \ contrib/extraction/ocaml.cmi -contrib/extraction/ocaml.cmx: library/libnames.cmx \ - contrib/extraction/miniml.cmi contrib/extraction/mlutil.cmx \ - contrib/extraction/modutil.cmx library/nameops.cmx kernel/names.cmx \ - lib/pp.cmx contrib/extraction/table.cmx lib/util.cmx \ +contrib/extraction/ocaml.cmx: lib/util.cmx contrib/extraction/table.cmx \ + lib/pp.cmx kernel/names.cmx library/nameops.cmx \ + contrib/extraction/modutil.cmx contrib/extraction/mlutil.cmx \ + contrib/extraction/miniml.cmi library/libnames.cmx \ contrib/extraction/ocaml.cmi -contrib/extraction/scheme.cmo: library/libnames.cmi \ - contrib/extraction/miniml.cmi contrib/extraction/mlutil.cmi \ - library/nameops.cmi kernel/names.cmi contrib/extraction/ocaml.cmi \ - lib/pp.cmi contrib/extraction/table.cmi lib/util.cmi \ +contrib/extraction/scheme.cmo: lib/util.cmi contrib/extraction/table.cmi \ + lib/pp.cmi contrib/extraction/ocaml.cmi kernel/names.cmi \ + library/nameops.cmi contrib/extraction/mlutil.cmi \ + contrib/extraction/miniml.cmi library/libnames.cmi \ contrib/extraction/scheme.cmi -contrib/extraction/scheme.cmx: library/libnames.cmx \ - contrib/extraction/miniml.cmi contrib/extraction/mlutil.cmx \ - library/nameops.cmx kernel/names.cmx contrib/extraction/ocaml.cmx \ - lib/pp.cmx contrib/extraction/table.cmx lib/util.cmx \ +contrib/extraction/scheme.cmx: lib/util.cmx contrib/extraction/table.cmx \ + lib/pp.cmx contrib/extraction/ocaml.cmx kernel/names.cmx \ + library/nameops.cmx contrib/extraction/mlutil.cmx \ + contrib/extraction/miniml.cmi library/libnames.cmx \ contrib/extraction/scheme.cmi -contrib/extraction/table.cmo: kernel/declarations.cmi kernel/environ.cmi \ - library/global.cmi library/goptions.cmi library/lib.cmi \ - library/libnames.cmi library/libobject.cmi contrib/extraction/miniml.cmi \ - library/nameops.cmi kernel/names.cmi library/nametab.cmi lib/options.cmi \ - lib/pp.cmi parsing/printer.cmi kernel/reduction.cmi library/summary.cmi \ - kernel/term.cmi lib/util.cmi contrib/extraction/table.cmi -contrib/extraction/table.cmx: kernel/declarations.cmx kernel/environ.cmx \ - library/global.cmx library/goptions.cmx library/lib.cmx \ - library/libnames.cmx library/libobject.cmx contrib/extraction/miniml.cmi \ - library/nameops.cmx kernel/names.cmx library/nametab.cmx lib/options.cmx \ - lib/pp.cmx parsing/printer.cmx kernel/reduction.cmx library/summary.cmx \ - kernel/term.cmx lib/util.cmx contrib/extraction/table.cmi -contrib/field/field.cmo: toplevel/cerrors.cmi interp/constrintern.cmi \ - interp/coqlib.cmi parsing/egrammar.cmi pretyping/evd.cmi \ - parsing/extend.cmi interp/genarg.cmi library/global.cmi lib/gmap.cmi \ - tactics/hipattern.cmi parsing/lexer.cmi library/lib.cmi \ - library/libnames.cmi library/libobject.cmi kernel/mod_subst.cmi \ - kernel/names.cmi parsing/pcoq.cmi lib/pp.cmi parsing/ppconstr.cmi \ - parsing/pptactic.cmi parsing/printer.cmi proofs/proof_type.cmi \ - contrib/ring/quote.cmo pretyping/reductionops.cmi proofs/refiner.cmi \ - contrib/ring/ring.cmo library/summary.cmi proofs/tacexpr.cmo \ - tactics/tacinterp.cmi proofs/tacmach.cmi tactics/tacticals.cmi \ - kernel/term.cmi interp/topconstr.cmi pretyping/typing.cmi lib/util.cmi \ - toplevel/vernacexpr.cmo toplevel/vernacinterp.cmi -contrib/field/field.cmx: toplevel/cerrors.cmx interp/constrintern.cmx \ - interp/coqlib.cmx parsing/egrammar.cmx pretyping/evd.cmx \ - parsing/extend.cmx interp/genarg.cmx library/global.cmx lib/gmap.cmx \ - tactics/hipattern.cmx parsing/lexer.cmx library/lib.cmx \ - library/libnames.cmx library/libobject.cmx kernel/mod_subst.cmx \ - kernel/names.cmx parsing/pcoq.cmx lib/pp.cmx parsing/ppconstr.cmx \ - parsing/pptactic.cmx parsing/printer.cmx proofs/proof_type.cmx \ - contrib/ring/quote.cmx pretyping/reductionops.cmx proofs/refiner.cmx \ - contrib/ring/ring.cmx library/summary.cmx proofs/tacexpr.cmx \ - tactics/tacinterp.cmx proofs/tacmach.cmx tactics/tacticals.cmx \ - kernel/term.cmx interp/topconstr.cmx pretyping/typing.cmx lib/util.cmx \ - toplevel/vernacexpr.cmx toplevel/vernacinterp.cmx -contrib/first-order/formula.cmo: kernel/closure.cmi kernel/declarations.cmi \ - library/global.cmi tactics/hipattern.cmi pretyping/inductiveops.cmi \ - library/libnames.cmi kernel/names.cmi pretyping/reductionops.cmi \ - kernel/sign.cmi proofs/tacmach.cmi kernel/term.cmi pretyping/termops.cmi \ - lib/util.cmi contrib/first-order/formula.cmi -contrib/first-order/formula.cmx: kernel/closure.cmx kernel/declarations.cmx \ - library/global.cmx tactics/hipattern.cmx pretyping/inductiveops.cmx \ - library/libnames.cmx kernel/names.cmx pretyping/reductionops.cmx \ - kernel/sign.cmx proofs/tacmach.cmx kernel/term.cmx pretyping/termops.cmx \ - lib/util.cmx contrib/first-order/formula.cmi -contrib/first-order/g_ground.cmo: tactics/auto.cmi toplevel/cerrors.cmi \ - parsing/egrammar.cmi contrib/first-order/formula.cmi interp/genarg.cmi \ - library/goptions.cmi contrib/first-order/ground.cmi library/libnames.cmi \ - kernel/names.cmi parsing/pcoq.cmi lib/pp.cmi parsing/pptactic.cmi \ - proofs/refiner.cmi contrib/first-order/sequent.cmi proofs/tacexpr.cmo \ - tactics/tacinterp.cmi tactics/tacticals.cmi tactics/tactics.cmi \ - kernel/term.cmi lib/util.cmi -contrib/first-order/g_ground.cmx: tactics/auto.cmx toplevel/cerrors.cmx \ - parsing/egrammar.cmx contrib/first-order/formula.cmx interp/genarg.cmx \ - library/goptions.cmx contrib/first-order/ground.cmx library/libnames.cmx \ - kernel/names.cmx parsing/pcoq.cmx lib/pp.cmx parsing/pptactic.cmx \ - proofs/refiner.cmx contrib/first-order/sequent.cmx proofs/tacexpr.cmx \ - tactics/tacinterp.cmx tactics/tacticals.cmx tactics/tactics.cmx \ - kernel/term.cmx lib/util.cmx -contrib/first-order/ground.cmo: pretyping/classops.cmi kernel/closure.cmi \ - contrib/first-order/formula.cmi lib/heap.cmi \ - contrib/first-order/instances.cmi library/libnames.cmi kernel/names.cmi \ - lib/pp.cmi parsing/printer.cmi contrib/first-order/rules.cmi \ - contrib/first-order/sequent.cmi tactics/tacinterp.cmi proofs/tacmach.cmi \ - proofs/tactic_debug.cmi tactics/tacticals.cmi tactics/tactics.cmi \ - kernel/term.cmi contrib/first-order/ground.cmi -contrib/first-order/ground.cmx: pretyping/classops.cmx kernel/closure.cmx \ - contrib/first-order/formula.cmx lib/heap.cmx \ - contrib/first-order/instances.cmx library/libnames.cmx kernel/names.cmx \ - lib/pp.cmx parsing/printer.cmx contrib/first-order/rules.cmx \ - contrib/first-order/sequent.cmx tactics/tacinterp.cmx proofs/tacmach.cmx \ - proofs/tactic_debug.cmx tactics/tacticals.cmx tactics/tactics.cmx \ - kernel/term.cmx contrib/first-order/ground.cmi -contrib/first-order/instances.cmo: kernel/declarations.cmi \ - pretyping/detyping.cmi pretyping/evd.cmi contrib/first-order/formula.cmi \ - lib/heap.cmi library/libnames.cmi kernel/names.cmi lib/pp.cmi \ - pretyping/pretyping.cmi pretyping/rawterm.cmi pretyping/reductionops.cmi \ - proofs/refiner.cmi contrib/first-order/rules.cmi \ - contrib/first-order/sequent.cmi kernel/sign.cmi proofs/tacmach.cmi \ - tactics/tacticals.cmi tactics/tactics.cmi kernel/term.cmi \ - pretyping/termops.cmi contrib/first-order/unify.cmi lib/util.cmi \ +contrib/extraction/table.cmo: lib/util.cmi kernel/term.cmi \ + library/summary.cmi kernel/reduction.cmi parsing/printer.cmi lib/pp.cmi \ + lib/options.cmi library/nametab.cmi kernel/names.cmi library/nameops.cmi \ + contrib/extraction/miniml.cmi library/libobject.cmi library/libnames.cmi \ + library/lib.cmi library/goptions.cmi library/global.cmi \ + kernel/environ.cmi kernel/declarations.cmi contrib/extraction/table.cmi +contrib/extraction/table.cmx: lib/util.cmx kernel/term.cmx \ + library/summary.cmx kernel/reduction.cmx parsing/printer.cmx lib/pp.cmx \ + lib/options.cmx library/nametab.cmx kernel/names.cmx library/nameops.cmx \ + contrib/extraction/miniml.cmi library/libobject.cmx library/libnames.cmx \ + library/lib.cmx library/goptions.cmx library/global.cmx \ + kernel/environ.cmx kernel/declarations.cmx contrib/extraction/table.cmi +contrib/field/field.cmo: toplevel/vernacinterp.cmi toplevel/vernacexpr.cmo \ + lib/util.cmi pretyping/typing.cmi interp/topconstr.cmi kernel/term.cmi \ + tactics/tacticals.cmi proofs/tacmach.cmi tactics/tacinterp.cmi \ + proofs/tacexpr.cmo library/summary.cmi contrib/ring/ring.cmo \ + proofs/refiner.cmi pretyping/reductionops.cmi contrib/ring/quote.cmo \ + proofs/proof_type.cmi parsing/printer.cmi parsing/pptactic.cmi \ + parsing/ppconstr.cmi lib/pp.cmi parsing/pcoq.cmi kernel/names.cmi \ + kernel/mod_subst.cmi library/libobject.cmi library/libnames.cmi \ + library/lib.cmi parsing/lexer.cmi tactics/hipattern.cmi lib/gmap.cmi \ + library/global.cmi interp/genarg.cmi parsing/extend.cmi pretyping/evd.cmi \ + parsing/egrammar.cmi interp/coqlib.cmi interp/constrintern.cmi \ + toplevel/cerrors.cmi +contrib/field/field.cmx: toplevel/vernacinterp.cmx toplevel/vernacexpr.cmx \ + lib/util.cmx pretyping/typing.cmx interp/topconstr.cmx kernel/term.cmx \ + tactics/tacticals.cmx proofs/tacmach.cmx tactics/tacinterp.cmx \ + proofs/tacexpr.cmx library/summary.cmx contrib/ring/ring.cmx \ + proofs/refiner.cmx pretyping/reductionops.cmx contrib/ring/quote.cmx \ + proofs/proof_type.cmx parsing/printer.cmx parsing/pptactic.cmx \ + parsing/ppconstr.cmx lib/pp.cmx parsing/pcoq.cmx kernel/names.cmx \ + kernel/mod_subst.cmx library/libobject.cmx library/libnames.cmx \ + library/lib.cmx parsing/lexer.cmx tactics/hipattern.cmx lib/gmap.cmx \ + library/global.cmx interp/genarg.cmx parsing/extend.cmx pretyping/evd.cmx \ + parsing/egrammar.cmx interp/coqlib.cmx interp/constrintern.cmx \ + toplevel/cerrors.cmx +contrib/first-order/formula.cmo: lib/util.cmi pretyping/termops.cmi \ + kernel/term.cmi proofs/tacmach.cmi kernel/sign.cmi \ + pretyping/reductionops.cmi kernel/names.cmi library/libnames.cmi \ + pretyping/inductiveops.cmi tactics/hipattern.cmi library/global.cmi \ + kernel/declarations.cmi kernel/closure.cmi \ + contrib/first-order/formula.cmi +contrib/first-order/formula.cmx: lib/util.cmx pretyping/termops.cmx \ + kernel/term.cmx proofs/tacmach.cmx kernel/sign.cmx \ + pretyping/reductionops.cmx kernel/names.cmx library/libnames.cmx \ + pretyping/inductiveops.cmx tactics/hipattern.cmx library/global.cmx \ + kernel/declarations.cmx kernel/closure.cmx \ + contrib/first-order/formula.cmi +contrib/first-order/g_ground.cmo: lib/util.cmi kernel/term.cmi \ + tactics/tactics.cmi tactics/tacticals.cmi tactics/tacinterp.cmi \ + proofs/tacexpr.cmo contrib/first-order/sequent.cmi proofs/refiner.cmi \ + parsing/pptactic.cmi lib/pp.cmi parsing/pcoq.cmi kernel/names.cmi \ + library/libnames.cmi contrib/first-order/ground.cmi library/goptions.cmi \ + interp/genarg.cmi contrib/first-order/formula.cmi parsing/egrammar.cmi \ + toplevel/cerrors.cmi tactics/auto.cmi +contrib/first-order/g_ground.cmx: lib/util.cmx kernel/term.cmx \ + tactics/tactics.cmx tactics/tacticals.cmx tactics/tacinterp.cmx \ + proofs/tacexpr.cmx contrib/first-order/sequent.cmx proofs/refiner.cmx \ + parsing/pptactic.cmx lib/pp.cmx parsing/pcoq.cmx kernel/names.cmx \ + library/libnames.cmx contrib/first-order/ground.cmx library/goptions.cmx \ + interp/genarg.cmx contrib/first-order/formula.cmx parsing/egrammar.cmx \ + toplevel/cerrors.cmx tactics/auto.cmx +contrib/first-order/ground.cmo: kernel/term.cmi tactics/tactics.cmi \ + tactics/tacticals.cmi proofs/tactic_debug.cmi proofs/tacmach.cmi \ + tactics/tacinterp.cmi contrib/first-order/sequent.cmi \ + contrib/first-order/rules.cmi parsing/printer.cmi lib/pp.cmi \ + kernel/names.cmi library/libnames.cmi contrib/first-order/instances.cmi \ + lib/heap.cmi contrib/first-order/formula.cmi kernel/closure.cmi \ + pretyping/classops.cmi contrib/first-order/ground.cmi +contrib/first-order/ground.cmx: kernel/term.cmx tactics/tactics.cmx \ + tactics/tacticals.cmx proofs/tactic_debug.cmx proofs/tacmach.cmx \ + tactics/tacinterp.cmx contrib/first-order/sequent.cmx \ + contrib/first-order/rules.cmx parsing/printer.cmx lib/pp.cmx \ + kernel/names.cmx library/libnames.cmx contrib/first-order/instances.cmx \ + lib/heap.cmx contrib/first-order/formula.cmx kernel/closure.cmx \ + pretyping/classops.cmx contrib/first-order/ground.cmi +contrib/first-order/instances.cmo: lib/util.cmi contrib/first-order/unify.cmi \ + pretyping/termops.cmi kernel/term.cmi tactics/tactics.cmi \ + tactics/tacticals.cmi proofs/tacmach.cmi kernel/sign.cmi \ + contrib/first-order/sequent.cmi contrib/first-order/rules.cmi \ + proofs/refiner.cmi pretyping/reductionops.cmi pretyping/rawterm.cmi \ + pretyping/pretyping.cmi lib/pp.cmi kernel/names.cmi library/libnames.cmi \ + lib/heap.cmi contrib/first-order/formula.cmi pretyping/evd.cmi \ + pretyping/detyping.cmi kernel/declarations.cmi \ contrib/first-order/instances.cmi -contrib/first-order/instances.cmx: kernel/declarations.cmx \ - pretyping/detyping.cmx pretyping/evd.cmx contrib/first-order/formula.cmx \ - lib/heap.cmx library/libnames.cmx kernel/names.cmx lib/pp.cmx \ - pretyping/pretyping.cmx pretyping/rawterm.cmx pretyping/reductionops.cmx \ - proofs/refiner.cmx contrib/first-order/rules.cmx \ - contrib/first-order/sequent.cmx kernel/sign.cmx proofs/tacmach.cmx \ - tactics/tacticals.cmx tactics/tactics.cmx kernel/term.cmx \ - pretyping/termops.cmx contrib/first-order/unify.cmx lib/util.cmx \ +contrib/first-order/instances.cmx: lib/util.cmx contrib/first-order/unify.cmx \ + pretyping/termops.cmx kernel/term.cmx tactics/tactics.cmx \ + tactics/tacticals.cmx proofs/tacmach.cmx kernel/sign.cmx \ + contrib/first-order/sequent.cmx contrib/first-order/rules.cmx \ + proofs/refiner.cmx pretyping/reductionops.cmx pretyping/rawterm.cmx \ + pretyping/pretyping.cmx lib/pp.cmx kernel/names.cmx library/libnames.cmx \ + lib/heap.cmx contrib/first-order/formula.cmx pretyping/evd.cmx \ + pretyping/detyping.cmx kernel/declarations.cmx \ contrib/first-order/instances.cmi -contrib/first-order/rules.cmo: interp/coqlib.cmi kernel/declarations.cmi \ - contrib/first-order/formula.cmi library/libnames.cmi kernel/names.cmi \ - lib/pp.cmi contrib/first-order/sequent.cmi kernel/sign.cmi \ - proofs/tacexpr.cmo proofs/tacmach.cmi tactics/tacticals.cmi \ - tactics/tactics.cmi kernel/term.cmi pretyping/termops.cmi lib/util.cmi \ - contrib/first-order/rules.cmi -contrib/first-order/rules.cmx: interp/coqlib.cmx kernel/declarations.cmx \ - contrib/first-order/formula.cmx library/libnames.cmx kernel/names.cmx \ - lib/pp.cmx contrib/first-order/sequent.cmx kernel/sign.cmx \ - proofs/tacexpr.cmx proofs/tacmach.cmx tactics/tacticals.cmx \ - tactics/tactics.cmx kernel/term.cmx pretyping/termops.cmx lib/util.cmx \ - contrib/first-order/rules.cmi -contrib/first-order/sequent.cmo: tactics/auto.cmi interp/constrextern.cmi \ - contrib/first-order/formula.cmi library/global.cmi lib/heap.cmi \ - library/libnames.cmi kernel/names.cmi lib/pp.cmi parsing/ppconstr.cmi \ - parsing/printer.cmi proofs/tacmach.cmi kernel/term.cmi \ - contrib/first-order/unify.cmi lib/util.cmi \ - contrib/first-order/sequent.cmi -contrib/first-order/sequent.cmx: tactics/auto.cmx interp/constrextern.cmx \ - contrib/first-order/formula.cmx library/global.cmx lib/heap.cmx \ - library/libnames.cmx kernel/names.cmx lib/pp.cmx parsing/ppconstr.cmx \ - parsing/printer.cmx proofs/tacmach.cmx kernel/term.cmx \ - contrib/first-order/unify.cmx lib/util.cmx \ - contrib/first-order/sequent.cmi -contrib/first-order/unify.cmo: contrib/first-order/formula.cmi \ - kernel/names.cmi pretyping/reductionops.cmi proofs/tacmach.cmi \ - kernel/term.cmi pretyping/termops.cmi lib/util.cmi \ +contrib/first-order/rules.cmo: lib/util.cmi pretyping/termops.cmi \ + kernel/term.cmi tactics/tactics.cmi tactics/tacticals.cmi \ + proofs/tacmach.cmi proofs/tacexpr.cmo kernel/sign.cmi \ + contrib/first-order/sequent.cmi lib/pp.cmi kernel/names.cmi \ + library/libnames.cmi contrib/first-order/formula.cmi \ + kernel/declarations.cmi interp/coqlib.cmi contrib/first-order/rules.cmi +contrib/first-order/rules.cmx: lib/util.cmx pretyping/termops.cmx \ + kernel/term.cmx tactics/tactics.cmx tactics/tacticals.cmx \ + proofs/tacmach.cmx proofs/tacexpr.cmx kernel/sign.cmx \ + contrib/first-order/sequent.cmx lib/pp.cmx kernel/names.cmx \ + library/libnames.cmx contrib/first-order/formula.cmx \ + kernel/declarations.cmx interp/coqlib.cmx contrib/first-order/rules.cmi +contrib/first-order/sequent.cmo: lib/util.cmi contrib/first-order/unify.cmi \ + kernel/term.cmi proofs/tacmach.cmi parsing/printer.cmi \ + parsing/ppconstr.cmi lib/pp.cmi kernel/names.cmi library/libnames.cmi \ + lib/heap.cmi library/global.cmi contrib/first-order/formula.cmi \ + interp/constrextern.cmi tactics/auto.cmi contrib/first-order/sequent.cmi +contrib/first-order/sequent.cmx: lib/util.cmx contrib/first-order/unify.cmx \ + kernel/term.cmx proofs/tacmach.cmx parsing/printer.cmx \ + parsing/ppconstr.cmx lib/pp.cmx kernel/names.cmx library/libnames.cmx \ + lib/heap.cmx library/global.cmx contrib/first-order/formula.cmx \ + interp/constrextern.cmx tactics/auto.cmx contrib/first-order/sequent.cmi +contrib/first-order/unify.cmo: lib/util.cmi pretyping/termops.cmi \ + kernel/term.cmi proofs/tacmach.cmi pretyping/reductionops.cmi \ + kernel/names.cmi contrib/first-order/formula.cmi \ contrib/first-order/unify.cmi -contrib/first-order/unify.cmx: contrib/first-order/formula.cmx \ - kernel/names.cmx pretyping/reductionops.cmx proofs/tacmach.cmx \ - kernel/term.cmx pretyping/termops.cmx lib/util.cmx \ +contrib/first-order/unify.cmx: lib/util.cmx pretyping/termops.cmx \ + kernel/term.cmx proofs/tacmach.cmx pretyping/reductionops.cmx \ + kernel/names.cmx contrib/first-order/formula.cmx \ contrib/first-order/unify.cmi -contrib/fourier/fourierR.cmo: pretyping/clenv.cmi tactics/contradiction.cmi \ - interp/coqlib.cmi tactics/equality.cmi pretyping/evarutil.cmi \ - contrib/fourier/fourier.cmo library/libnames.cmi kernel/names.cmi \ - contrib/ring/ring.cmo proofs/tacmach.cmi tactics/tacticals.cmi \ - tactics/tactics.cmi kernel/term.cmi lib/util.cmi toplevel/vernacexpr.cmo -contrib/fourier/fourierR.cmx: pretyping/clenv.cmx tactics/contradiction.cmx \ - interp/coqlib.cmx tactics/equality.cmx pretyping/evarutil.cmx \ - contrib/fourier/fourier.cmx library/libnames.cmx kernel/names.cmx \ - contrib/ring/ring.cmx proofs/tacmach.cmx tactics/tacticals.cmx \ - tactics/tactics.cmx kernel/term.cmx lib/util.cmx toplevel/vernacexpr.cmx -contrib/fourier/g_fourier.cmo: toplevel/cerrors.cmi parsing/egrammar.cmi \ - contrib/fourier/fourierR.cmo parsing/pcoq.cmi lib/pp.cmi \ - parsing/pptactic.cmi proofs/refiner.cmi proofs/tacexpr.cmo \ - tactics/tacinterp.cmi lib/util.cmi -contrib/fourier/g_fourier.cmx: toplevel/cerrors.cmx parsing/egrammar.cmx \ - contrib/fourier/fourierR.cmx parsing/pcoq.cmx lib/pp.cmx \ - parsing/pptactic.cmx proofs/refiner.cmx proofs/tacexpr.cmx \ - tactics/tacinterp.cmx lib/util.cmx -contrib/funind/indfun_common.cmo: interp/coqlib.cmi kernel/declarations.cmi \ - library/global.cmi library/libnames.cmi kernel/names.cmi \ - library/nametab.cmi lib/pp.cmi pretyping/rawterm.cmi kernel/term.cmi \ - pretyping/termops.cmi lib/util.cmi contrib/funind/indfun_common.cmi -contrib/funind/indfun_common.cmx: interp/coqlib.cmx kernel/declarations.cmx \ - library/global.cmx library/libnames.cmx kernel/names.cmx \ - library/nametab.cmx lib/pp.cmx pretyping/rawterm.cmx kernel/term.cmx \ - pretyping/termops.cmx lib/util.cmx contrib/funind/indfun_common.cmi -contrib/funind/indfun_main.cmo: toplevel/cerrors.cmi parsing/egrammar.cmi \ - interp/genarg.cmi contrib/funind/indfun.cmo \ - contrib/funind/indfun_common.cmi pretyping/indrec.cmi \ - contrib/funind/invfun.cmo parsing/lexer.cmi library/nameops.cmi \ - kernel/names.cmi contrib/funind/new_arg_principle.cmi parsing/pcoq.cmi \ - lib/pp.cmi parsing/pptactic.cmi pretyping/rawterm.cmi proofs/refiner.cmi \ - proofs/tacexpr.cmo tactics/tacinterp.cmi tactics/tacticals.cmi \ - tactics/tactics.cmi kernel/term.cmi interp/topconstr.cmi lib/util.cmi \ - toplevel/vernacinterp.cmi -contrib/funind/indfun_main.cmx: toplevel/cerrors.cmx parsing/egrammar.cmx \ - interp/genarg.cmx contrib/funind/indfun.cmx \ - contrib/funind/indfun_common.cmx pretyping/indrec.cmx \ - contrib/funind/invfun.cmx parsing/lexer.cmx library/nameops.cmx \ - kernel/names.cmx contrib/funind/new_arg_principle.cmx parsing/pcoq.cmx \ - lib/pp.cmx parsing/pptactic.cmx pretyping/rawterm.cmx proofs/refiner.cmx \ - proofs/tacexpr.cmx tactics/tacinterp.cmx tactics/tacticals.cmx \ - tactics/tactics.cmx kernel/term.cmx interp/topconstr.cmx lib/util.cmx \ - toplevel/vernacinterp.cmx -contrib/funind/indfun.cmo: toplevel/command.cmi interp/constrintern.cmi \ - library/decl_kinds.cmo kernel/declarations.cmi kernel/environ.cmi \ - pretyping/evd.cmi library/global.cmi library/impargs.cmi \ - contrib/funind/indfun_common.cmi pretyping/indrec.cmi \ - library/libnames.cmi kernel/names.cmi \ - contrib/funind/new_arg_principle.cmi interp/notation.cmi lib/options.cmi \ - lib/pp.cmi pretyping/rawterm.cmi contrib/funind/rawterm_to_relation.cmi \ - contrib/recdef/recdef.cmo library/states.cmi proofs/tacmach.cmi \ - kernel/term.cmi interp/topconstr.cmi lib/util.cmi toplevel/vernacexpr.cmo -contrib/funind/indfun.cmx: toplevel/command.cmx interp/constrintern.cmx \ - library/decl_kinds.cmx kernel/declarations.cmx kernel/environ.cmx \ - pretyping/evd.cmx library/global.cmx library/impargs.cmx \ - contrib/funind/indfun_common.cmx pretyping/indrec.cmx \ - library/libnames.cmx kernel/names.cmx \ - contrib/funind/new_arg_principle.cmx interp/notation.cmx lib/options.cmx \ - lib/pp.cmx pretyping/rawterm.cmx contrib/funind/rawterm_to_relation.cmx \ - contrib/recdef/recdef.cmx library/states.cmx proofs/tacmach.cmx \ - kernel/term.cmx interp/topconstr.cmx lib/util.cmx toplevel/vernacexpr.cmx -contrib/funind/invfun.cmo: kernel/declarations.cmi tactics/equality.cmi \ - tactics/extratactics.cmi library/global.cmi tactics/hiddentac.cmi \ - contrib/funind/indfun_common.cmi pretyping/indrec.cmi \ - library/libnames.cmi kernel/names.cmi lib/pp.cmi pretyping/rawterm.cmi \ - kernel/sign.cmi contrib/funind/tacinvutils.cmi proofs/tacmach.cmi \ - tactics/tacticals.cmi tactics/tactics.cmi kernel/term.cmi lib/util.cmi -contrib/funind/invfun.cmx: kernel/declarations.cmx tactics/equality.cmx \ - tactics/extratactics.cmx library/global.cmx tactics/hiddentac.cmx \ - contrib/funind/indfun_common.cmx pretyping/indrec.cmx \ - library/libnames.cmx kernel/names.cmx lib/pp.cmx pretyping/rawterm.cmx \ - kernel/sign.cmx contrib/funind/tacinvutils.cmx proofs/tacmach.cmx \ - tactics/tacticals.cmx tactics/tactics.cmx kernel/term.cmx lib/util.cmx -contrib/funind/new_arg_principle.cmo: toplevel/cerrors.cmi \ - pretyping/clenv.cmi kernel/closure.cmi toplevel/command.cmi \ - interp/coqlib.cmi library/decl_kinds.cmo kernel/declarations.cmi \ - library/declare.cmi tactics/eauto.cmi kernel/entries.cmi \ - kernel/environ.cmi tactics/equality.cmi pretyping/evd.cmi \ - interp/genarg.cmi library/global.cmi tactics/hiddentac.cmi \ - contrib/funind/indfun_common.cmi pretyping/indrec.cmi \ - library/libnames.cmi kernel/names.cmi lib/options.cmi proofs/pfedit.cmi \ - lib/pp.cmi parsing/ppconstr.cmi pretyping/pretyping.cmi \ - parsing/printer.cmi proofs/proof_type.cmi pretyping/rawterm.cmi \ - contrib/recdef/recdef.cmo pretyping/reductionops.cmi \ - tactics/tacinterp.cmi proofs/tacmach.cmi pretyping/tacred.cmi \ - proofs/tactic_debug.cmi tactics/tacticals.cmi tactics/tactics.cmi \ - kernel/term.cmi pretyping/termops.cmi pretyping/typing.cmi \ - pretyping/unification.cmi lib/util.cmi toplevel/vernacentries.cmi \ - toplevel/vernacexpr.cmo contrib/funind/new_arg_principle.cmi -contrib/funind/new_arg_principle.cmx: toplevel/cerrors.cmx \ - pretyping/clenv.cmx kernel/closure.cmx toplevel/command.cmx \ - interp/coqlib.cmx library/decl_kinds.cmx kernel/declarations.cmx \ - library/declare.cmx tactics/eauto.cmx kernel/entries.cmx \ - kernel/environ.cmx tactics/equality.cmx pretyping/evd.cmx \ - interp/genarg.cmx library/global.cmx tactics/hiddentac.cmx \ - contrib/funind/indfun_common.cmx pretyping/indrec.cmx \ - library/libnames.cmx kernel/names.cmx lib/options.cmx proofs/pfedit.cmx \ - lib/pp.cmx parsing/ppconstr.cmx pretyping/pretyping.cmx \ - parsing/printer.cmx proofs/proof_type.cmx pretyping/rawterm.cmx \ - contrib/recdef/recdef.cmx pretyping/reductionops.cmx \ - tactics/tacinterp.cmx proofs/tacmach.cmx pretyping/tacred.cmx \ - proofs/tactic_debug.cmx tactics/tacticals.cmx tactics/tactics.cmx \ - kernel/term.cmx pretyping/termops.cmx pretyping/typing.cmx \ - pretyping/unification.cmx lib/util.cmx toplevel/vernacentries.cmx \ - toplevel/vernacexpr.cmx contrib/funind/new_arg_principle.cmi -contrib/funind/rawtermops.cmo: interp/coqlib.cmi pretyping/evd.cmi \ - library/global.cmi contrib/funind/indfun_common.cmi \ - pretyping/inductiveops.cmi library/libnames.cmi library/nameops.cmi \ - kernel/names.cmi lib/pp.cmi parsing/ppconstr.cmi parsing/printer.cmi \ - pretyping/rawterm.cmi tactics/tacinterp.cmi proofs/tactic_debug.cmi \ - lib/util.cmi contrib/funind/rawtermops.cmi -contrib/funind/rawtermops.cmx: interp/coqlib.cmx pretyping/evd.cmx \ - library/global.cmx contrib/funind/indfun_common.cmx \ - pretyping/inductiveops.cmx library/libnames.cmx library/nameops.cmx \ - kernel/names.cmx lib/pp.cmx parsing/ppconstr.cmx parsing/printer.cmx \ - pretyping/rawterm.cmx tactics/tacinterp.cmx proofs/tactic_debug.cmx \ - lib/util.cmx contrib/funind/rawtermops.cmi -contrib/funind/rawterm_to_relation.cmo: toplevel/cerrors.cmi \ - toplevel/command.cmi interp/constrextern.cmi interp/coqlib.cmi \ - library/impargs.cmi contrib/funind/indfun_common.cmi library/libnames.cmi \ - library/nameops.cmi kernel/names.cmi lib/options.cmi lib/pp.cmi \ - parsing/ppvernac.cmi parsing/printer.cmi pretyping/rawterm.cmi \ - contrib/funind/rawtermops.cmi kernel/term.cmi interp/topconstr.cmi \ - lib/util.cmi toplevel/vernacexpr.cmo \ +contrib/fourier/fourierR.cmo: toplevel/vernacexpr.cmo lib/util.cmi \ + kernel/term.cmi tactics/tactics.cmi tactics/tacticals.cmi \ + proofs/tacmach.cmi contrib/ring/ring.cmo kernel/names.cmi \ + library/libnames.cmi contrib/fourier/fourier.cmo pretyping/evarutil.cmi \ + tactics/equality.cmi interp/coqlib.cmi tactics/contradiction.cmi \ + pretyping/clenv.cmi +contrib/fourier/fourierR.cmx: toplevel/vernacexpr.cmx lib/util.cmx \ + kernel/term.cmx tactics/tactics.cmx tactics/tacticals.cmx \ + proofs/tacmach.cmx contrib/ring/ring.cmx kernel/names.cmx \ + library/libnames.cmx contrib/fourier/fourier.cmx pretyping/evarutil.cmx \ + tactics/equality.cmx interp/coqlib.cmx tactics/contradiction.cmx \ + pretyping/clenv.cmx +contrib/fourier/g_fourier.cmo: lib/util.cmi tactics/tacinterp.cmi \ + proofs/tacexpr.cmo proofs/refiner.cmi parsing/pptactic.cmi lib/pp.cmi \ + parsing/pcoq.cmi contrib/fourier/fourierR.cmo parsing/egrammar.cmi \ + toplevel/cerrors.cmi +contrib/fourier/g_fourier.cmx: lib/util.cmx tactics/tacinterp.cmx \ + proofs/tacexpr.cmx proofs/refiner.cmx parsing/pptactic.cmx lib/pp.cmx \ + parsing/pcoq.cmx contrib/fourier/fourierR.cmx parsing/egrammar.cmx \ + toplevel/cerrors.cmx +contrib/funind/functional_principles_proofs.cmo: lib/util.cmi \ + pretyping/typing.cmi pretyping/termops.cmi kernel/term.cmi \ + tactics/tactics.cmi tactics/tacticals.cmi proofs/tactic_debug.cmi \ + pretyping/tacred.cmi proofs/tacmach.cmi tactics/tacinterp.cmi \ + kernel/sign.cmi pretyping/reductionops.cmi contrib/recdef/recdef.cmo \ + pretyping/rawterm.cmi proofs/proof_type.cmi parsing/printer.cmi \ + lib/pp.cmi lib/options.cmi kernel/names.cmi library/nameops.cmi \ + library/libnames.cmi contrib/funind/indfun_common.cmi \ + tactics/hiddentac.cmi library/global.cmi interp/genarg.cmi \ + pretyping/evd.cmi tactics/equality.cmi kernel/environ.cmi \ + kernel/entries.cmi tactics/elim.cmi tactics/eauto.cmi \ + kernel/declarations.cmi interp/coqlib.cmi kernel/closure.cmi \ + toplevel/cerrors.cmi contrib/funind/functional_principles_proofs.cmi +contrib/funind/functional_principles_proofs.cmx: lib/util.cmx \ + pretyping/typing.cmx pretyping/termops.cmx kernel/term.cmx \ + tactics/tactics.cmx tactics/tacticals.cmx proofs/tactic_debug.cmx \ + pretyping/tacred.cmx proofs/tacmach.cmx tactics/tacinterp.cmx \ + kernel/sign.cmx pretyping/reductionops.cmx contrib/recdef/recdef.cmx \ + pretyping/rawterm.cmx proofs/proof_type.cmx parsing/printer.cmx \ + lib/pp.cmx lib/options.cmx kernel/names.cmx library/nameops.cmx \ + library/libnames.cmx contrib/funind/indfun_common.cmx \ + tactics/hiddentac.cmx library/global.cmx interp/genarg.cmx \ + pretyping/evd.cmx tactics/equality.cmx kernel/environ.cmx \ + kernel/entries.cmx tactics/elim.cmx tactics/eauto.cmx \ + kernel/declarations.cmx interp/coqlib.cmx kernel/closure.cmx \ + toplevel/cerrors.cmx contrib/funind/functional_principles_proofs.cmi +contrib/funind/functional_principles_types.cmo: toplevel/vernacexpr.cmo \ + toplevel/vernacentries.cmi lib/util.cmi pretyping/typing.cmi \ + pretyping/termops.cmi kernel/term.cmi tactics/tactics.cmi \ + tactics/tacticals.cmi pretyping/tacred.cmi proofs/tacmach.cmi \ + tactics/tacinterp.cmi lib/system.cmi proofs/proof_type.cmi \ + parsing/printer.cmi pretyping/pretyping.cmi parsing/ppconstr.cmi \ + lib/pp.cmi proofs/pfedit.cmi lib/options.cmi kernel/names.cmi \ + library/libnames.cmi pretyping/indrec.cmi \ + contrib/funind/indfun_common.cmi tactics/hiddentac.cmi library/global.cmi \ + contrib/funind/functional_principles_proofs.cmi pretyping/evd.cmi \ + kernel/environ.cmi kernel/entries.cmi library/declare.cmi \ + kernel/declarations.cmi library/decl_kinds.cmo toplevel/command.cmi \ + kernel/closure.cmi toplevel/cerrors.cmi \ + contrib/funind/functional_principles_types.cmi +contrib/funind/functional_principles_types.cmx: toplevel/vernacexpr.cmx \ + toplevel/vernacentries.cmx lib/util.cmx pretyping/typing.cmx \ + pretyping/termops.cmx kernel/term.cmx tactics/tactics.cmx \ + tactics/tacticals.cmx pretyping/tacred.cmx proofs/tacmach.cmx \ + tactics/tacinterp.cmx lib/system.cmx proofs/proof_type.cmx \ + parsing/printer.cmx pretyping/pretyping.cmx parsing/ppconstr.cmx \ + lib/pp.cmx proofs/pfedit.cmx lib/options.cmx kernel/names.cmx \ + library/libnames.cmx pretyping/indrec.cmx \ + contrib/funind/indfun_common.cmx tactics/hiddentac.cmx library/global.cmx \ + contrib/funind/functional_principles_proofs.cmx pretyping/evd.cmx \ + kernel/environ.cmx kernel/entries.cmx library/declare.cmx \ + kernel/declarations.cmx library/decl_kinds.cmx toplevel/command.cmx \ + kernel/closure.cmx toplevel/cerrors.cmx \ + contrib/funind/functional_principles_types.cmi +contrib/funind/indfun_common.cmo: lib/util.cmi pretyping/termops.cmi \ + kernel/term.cmi pretyping/rawterm.cmi lib/pp.cmi library/nametab.cmi \ + kernel/names.cmi library/libnames.cmi library/global.cmi \ + kernel/declarations.cmi interp/coqlib.cmi \ + contrib/funind/indfun_common.cmi +contrib/funind/indfun_common.cmx: lib/util.cmx pretyping/termops.cmx \ + kernel/term.cmx pretyping/rawterm.cmx lib/pp.cmx library/nametab.cmx \ + kernel/names.cmx library/libnames.cmx library/global.cmx \ + kernel/declarations.cmx interp/coqlib.cmx \ + contrib/funind/indfun_common.cmi +contrib/funind/indfun_main.cmo: toplevel/vernacinterp.cmi lib/util.cmi \ + interp/topconstr.cmi pretyping/termops.cmi kernel/term.cmi \ + tactics/tactics.cmi tactics/tacticals.cmi proofs/tacmach.cmi \ + tactics/tacinterp.cmi proofs/tacexpr.cmo kernel/sign.cmi \ + proofs/refiner.cmi pretyping/rawterm.cmi parsing/pptactic.cmi \ + parsing/ppconstr.cmi lib/pp.cmi parsing/pcoq.cmi kernel/names.cmi \ + library/nameops.cmi parsing/lexer.cmi contrib/funind/invfun.cmo \ + pretyping/indrec.cmi contrib/funind/indfun_common.cmi \ + contrib/funind/indfun.cmo tactics/hiddentac.cmi interp/genarg.cmi \ + contrib/funind/functional_principles_types.cmi tactics/equality.cmi \ + parsing/egrammar.cmi toplevel/cerrors.cmi +contrib/funind/indfun_main.cmx: toplevel/vernacinterp.cmx lib/util.cmx \ + interp/topconstr.cmx pretyping/termops.cmx kernel/term.cmx \ + tactics/tactics.cmx tactics/tacticals.cmx proofs/tacmach.cmx \ + tactics/tacinterp.cmx proofs/tacexpr.cmx kernel/sign.cmx \ + proofs/refiner.cmx pretyping/rawterm.cmx parsing/pptactic.cmx \ + parsing/ppconstr.cmx lib/pp.cmx parsing/pcoq.cmx kernel/names.cmx \ + library/nameops.cmx parsing/lexer.cmx contrib/funind/invfun.cmx \ + pretyping/indrec.cmx contrib/funind/indfun_common.cmx \ + contrib/funind/indfun.cmx tactics/hiddentac.cmx interp/genarg.cmx \ + contrib/funind/functional_principles_types.cmx tactics/equality.cmx \ + parsing/egrammar.cmx toplevel/cerrors.cmx +contrib/funind/indfun.cmo: toplevel/vernacexpr.cmo lib/util.cmi \ + interp/topconstr.cmi kernel/term.cmi proofs/tacmach.cmi \ + library/states.cmi contrib/recdef/recdef.cmo \ + contrib/funind/rawterm_to_relation.cmi pretyping/rawterm.cmi \ + parsing/ppconstr.cmi lib/pp.cmi lib/options.cmi interp/notation.cmi \ + kernel/names.cmi library/nameops.cmi library/libnames.cmi \ + pretyping/indrec.cmi contrib/funind/indfun_common.cmi library/impargs.cmi \ + library/global.cmi contrib/funind/functional_principles_types.cmi \ + contrib/funind/functional_principles_proofs.cmi pretyping/evd.cmi \ + kernel/environ.cmi kernel/declarations.cmi library/decl_kinds.cmo \ + interp/constrintern.cmi interp/constrextern.cmi toplevel/command.cmi \ + toplevel/cerrors.cmi +contrib/funind/indfun.cmx: toplevel/vernacexpr.cmx lib/util.cmx \ + interp/topconstr.cmx kernel/term.cmx proofs/tacmach.cmx \ + library/states.cmx contrib/recdef/recdef.cmx \ + contrib/funind/rawterm_to_relation.cmx pretyping/rawterm.cmx \ + parsing/ppconstr.cmx lib/pp.cmx lib/options.cmx interp/notation.cmx \ + kernel/names.cmx library/nameops.cmx library/libnames.cmx \ + pretyping/indrec.cmx contrib/funind/indfun_common.cmx library/impargs.cmx \ + library/global.cmx contrib/funind/functional_principles_types.cmx \ + contrib/funind/functional_principles_proofs.cmx pretyping/evd.cmx \ + kernel/environ.cmx kernel/declarations.cmx library/decl_kinds.cmx \ + interp/constrintern.cmx interp/constrextern.cmx toplevel/command.cmx \ + toplevel/cerrors.cmx +contrib/funind/invfun.cmo: lib/util.cmi kernel/term.cmi tactics/tactics.cmi \ + tactics/tacticals.cmi proofs/tacmach.cmi contrib/funind/tacinvutils.cmi \ + kernel/sign.cmi pretyping/rawterm.cmi lib/pp.cmi kernel/names.cmi \ + library/libnames.cmi contrib/funind/indfun_common.cmi \ + tactics/hiddentac.cmi library/global.cmi tactics/extratactics.cmi \ + tactics/equality.cmi kernel/declarations.cmi +contrib/funind/invfun.cmx: lib/util.cmx kernel/term.cmx tactics/tactics.cmx \ + tactics/tacticals.cmx proofs/tacmach.cmx contrib/funind/tacinvutils.cmx \ + kernel/sign.cmx pretyping/rawterm.cmx lib/pp.cmx kernel/names.cmx \ + library/libnames.cmx contrib/funind/indfun_common.cmx \ + tactics/hiddentac.cmx library/global.cmx tactics/extratactics.cmx \ + tactics/equality.cmx kernel/declarations.cmx +contrib/funind/rawtermops.cmo: lib/util.cmi proofs/tactic_debug.cmi \ + tactics/tacinterp.cmi pretyping/rawterm.cmi parsing/printer.cmi \ + parsing/ppconstr.cmi lib/pp.cmi kernel/names.cmi library/nameops.cmi \ + library/libnames.cmi pretyping/inductiveops.cmi \ + contrib/funind/indfun_common.cmi library/global.cmi pretyping/evd.cmi \ + interp/coqlib.cmi contrib/funind/rawtermops.cmi +contrib/funind/rawtermops.cmx: lib/util.cmx proofs/tactic_debug.cmx \ + tactics/tacinterp.cmx pretyping/rawterm.cmx parsing/printer.cmx \ + parsing/ppconstr.cmx lib/pp.cmx kernel/names.cmx library/nameops.cmx \ + library/libnames.cmx pretyping/inductiveops.cmx \ + contrib/funind/indfun_common.cmx library/global.cmx pretyping/evd.cmx \ + interp/coqlib.cmx contrib/funind/rawtermops.cmi +contrib/funind/rawterm_to_relation.cmo: toplevel/vernacexpr.cmo lib/util.cmi \ + pretyping/typing.cmi interp/topconstr.cmi kernel/term.cmi \ + proofs/tactic_debug.cmi tactics/tacinterp.cmi lib/system.cmi \ + kernel/reduction.cmi contrib/funind/rawtermops.cmi pretyping/rawterm.cmi \ + parsing/printer.cmi parsing/ppvernac.cmi parsing/ppconstr.cmi lib/pp.cmi \ + lib/options.cmi kernel/names.cmi library/nameops.cmi library/libnames.cmi \ + pretyping/inductiveops.cmi kernel/inductive.cmi \ + contrib/funind/indfun_common.cmi library/impargs.cmi library/global.cmi \ + pretyping/evd.cmi kernel/declarations.cmi interp/coqlib.cmi \ + interp/constrextern.cmi toplevel/command.cmi toplevel/cerrors.cmi \ contrib/funind/rawterm_to_relation.cmi -contrib/funind/rawterm_to_relation.cmx: toplevel/cerrors.cmx \ - toplevel/command.cmx interp/constrextern.cmx interp/coqlib.cmx \ - library/impargs.cmx contrib/funind/indfun_common.cmx library/libnames.cmx \ - library/nameops.cmx kernel/names.cmx lib/options.cmx lib/pp.cmx \ - parsing/ppvernac.cmx parsing/printer.cmx pretyping/rawterm.cmx \ - contrib/funind/rawtermops.cmx kernel/term.cmx interp/topconstr.cmx \ - lib/util.cmx toplevel/vernacexpr.cmx \ +contrib/funind/rawterm_to_relation.cmx: toplevel/vernacexpr.cmx lib/util.cmx \ + pretyping/typing.cmx interp/topconstr.cmx kernel/term.cmx \ + proofs/tactic_debug.cmx tactics/tacinterp.cmx lib/system.cmx \ + kernel/reduction.cmx contrib/funind/rawtermops.cmx pretyping/rawterm.cmx \ + parsing/printer.cmx parsing/ppvernac.cmx parsing/ppconstr.cmx lib/pp.cmx \ + lib/options.cmx kernel/names.cmx library/nameops.cmx library/libnames.cmx \ + pretyping/inductiveops.cmx kernel/inductive.cmx \ + contrib/funind/indfun_common.cmx library/impargs.cmx library/global.cmx \ + pretyping/evd.cmx kernel/declarations.cmx interp/coqlib.cmx \ + interp/constrextern.cmx toplevel/command.cmx toplevel/cerrors.cmx \ contrib/funind/rawterm_to_relation.cmi -contrib/funind/tacinv.cmo: toplevel/cerrors.cmi interp/constrintern.cmi \ - interp/coqlib.cmi library/decl_kinds.cmo library/declare.cmi \ - parsing/egrammar.cmi kernel/entries.cmi kernel/environ.cmi \ - tactics/equality.cmi pretyping/evd.cmi interp/genarg.cmi \ - library/global.cmi pretyping/inductiveops.cmi kernel/names.cmi \ - parsing/pcoq.cmi lib/pp.cmi parsing/pptactic.cmi parsing/printer.cmi \ - proofs/proof_type.cmi pretyping/reductionops.cmi tactics/refine.cmi \ - proofs/refiner.cmi kernel/safe_typing.cmi tactics/setoid_replace.cmi \ - proofs/tacexpr.cmo tactics/tacinterp.cmi contrib/funind/tacinvutils.cmi \ - proofs/tacmach.cmi pretyping/tacred.cmi tactics/tacticals.cmi \ - tactics/tactics.cmi kernel/term.cmi pretyping/termops.cmi \ - pretyping/typing.cmi lib/util.cmi toplevel/vernacinterp.cmi -contrib/funind/tacinv.cmx: toplevel/cerrors.cmx interp/constrintern.cmx \ - interp/coqlib.cmx library/decl_kinds.cmx library/declare.cmx \ - parsing/egrammar.cmx kernel/entries.cmx kernel/environ.cmx \ - tactics/equality.cmx pretyping/evd.cmx interp/genarg.cmx \ - library/global.cmx pretyping/inductiveops.cmx kernel/names.cmx \ - parsing/pcoq.cmx lib/pp.cmx parsing/pptactic.cmx parsing/printer.cmx \ - proofs/proof_type.cmx pretyping/reductionops.cmx tactics/refine.cmx \ - proofs/refiner.cmx kernel/safe_typing.cmx tactics/setoid_replace.cmx \ - proofs/tacexpr.cmx tactics/tacinterp.cmx contrib/funind/tacinvutils.cmx \ - proofs/tacmach.cmx pretyping/tacred.cmx tactics/tacticals.cmx \ - tactics/tactics.cmx kernel/term.cmx pretyping/termops.cmx \ - pretyping/typing.cmx lib/util.cmx toplevel/vernacinterp.cmx -contrib/funind/tacinvutils.cmo: interp/coqlib.cmi kernel/declarations.cmi \ - kernel/environ.cmi pretyping/evd.cmi library/global.cmi \ - pretyping/inductiveops.cmi library/nameops.cmi kernel/names.cmi \ - lib/pp.cmi parsing/printer.cmi pretyping/reductionops.cmi kernel/sign.cmi \ - kernel/term.cmi pretyping/termops.cmi lib/util.cmi \ +contrib/funind/tacinv.cmo: toplevel/vernacinterp.cmi lib/util.cmi \ + pretyping/typing.cmi pretyping/termops.cmi kernel/term.cmi \ + tactics/tactics.cmi tactics/tacticals.cmi pretyping/tacred.cmi \ + proofs/tacmach.cmi contrib/funind/tacinvutils.cmi tactics/tacinterp.cmi \ + proofs/tacexpr.cmo tactics/setoid_replace.cmi kernel/safe_typing.cmi \ + proofs/refiner.cmi tactics/refine.cmi pretyping/reductionops.cmi \ + proofs/proof_type.cmi parsing/printer.cmi parsing/pptactic.cmi lib/pp.cmi \ + parsing/pcoq.cmi kernel/names.cmi pretyping/inductiveops.cmi \ + library/global.cmi interp/genarg.cmi pretyping/evd.cmi \ + tactics/equality.cmi kernel/environ.cmi kernel/entries.cmi \ + parsing/egrammar.cmi library/declare.cmi library/decl_kinds.cmo \ + interp/coqlib.cmi interp/constrintern.cmi toplevel/cerrors.cmi +contrib/funind/tacinv.cmx: toplevel/vernacinterp.cmx lib/util.cmx \ + pretyping/typing.cmx pretyping/termops.cmx kernel/term.cmx \ + tactics/tactics.cmx tactics/tacticals.cmx pretyping/tacred.cmx \ + proofs/tacmach.cmx contrib/funind/tacinvutils.cmx tactics/tacinterp.cmx \ + proofs/tacexpr.cmx tactics/setoid_replace.cmx kernel/safe_typing.cmx \ + proofs/refiner.cmx tactics/refine.cmx pretyping/reductionops.cmx \ + proofs/proof_type.cmx parsing/printer.cmx parsing/pptactic.cmx lib/pp.cmx \ + parsing/pcoq.cmx kernel/names.cmx pretyping/inductiveops.cmx \ + library/global.cmx interp/genarg.cmx pretyping/evd.cmx \ + tactics/equality.cmx kernel/environ.cmx kernel/entries.cmx \ + parsing/egrammar.cmx library/declare.cmx library/decl_kinds.cmx \ + interp/coqlib.cmx interp/constrintern.cmx toplevel/cerrors.cmx +contrib/funind/tacinvutils.cmo: lib/util.cmi pretyping/termops.cmi \ + kernel/term.cmi kernel/sign.cmi pretyping/reductionops.cmi \ + parsing/printer.cmi lib/pp.cmi kernel/names.cmi library/nameops.cmi \ + pretyping/inductiveops.cmi library/global.cmi pretyping/evd.cmi \ + kernel/environ.cmi kernel/declarations.cmi interp/coqlib.cmi \ contrib/funind/tacinvutils.cmi -contrib/funind/tacinvutils.cmx: interp/coqlib.cmx kernel/declarations.cmx \ - kernel/environ.cmx pretyping/evd.cmx library/global.cmx \ - pretyping/inductiveops.cmx library/nameops.cmx kernel/names.cmx \ - lib/pp.cmx parsing/printer.cmx pretyping/reductionops.cmx kernel/sign.cmx \ - kernel/term.cmx pretyping/termops.cmx lib/util.cmx \ +contrib/funind/tacinvutils.cmx: lib/util.cmx pretyping/termops.cmx \ + kernel/term.cmx kernel/sign.cmx pretyping/reductionops.cmx \ + parsing/printer.cmx lib/pp.cmx kernel/names.cmx library/nameops.cmx \ + pretyping/inductiveops.cmx library/global.cmx pretyping/evd.cmx \ + kernel/environ.cmx kernel/declarations.cmx interp/coqlib.cmx \ contrib/funind/tacinvutils.cmi -contrib/interface/blast.cmo: tactics/auto.cmi pretyping/clenv.cmi \ - toplevel/command.cmi kernel/declarations.cmi library/declare.cmi \ - tactics/eauto.cmi kernel/environ.cmi tactics/equality.cmi \ - pretyping/evd.cmi lib/explore.cmi library/global.cmi \ - tactics/hipattern.cmi kernel/inductive.cmi proofs/logic.cmi \ - library/nameops.cmi kernel/names.cmi pretyping/pattern.cmi \ - contrib/interface/pbp.cmi parsing/pcoq.cmi proofs/pfedit.cmi lib/pp.cmi \ - parsing/pptactic.cmi parsing/printer.cmi proofs/proof_trees.cmi \ - proofs/proof_type.cmi pretyping/rawterm.cmi kernel/reduction.cmi \ - proofs/refiner.cmi kernel/sign.cmi tactics/tacinterp.cmi \ - proofs/tacmach.cmi pretyping/tacred.cmi parsing/tactic_printer.cmi \ - tactics/tacticals.cmi tactics/tactics.cmi kernel/term.cmi \ - pretyping/termops.cmi pretyping/typing.cmi lib/util.cmi \ - toplevel/vernacentries.cmi toplevel/vernacinterp.cmi \ +contrib/interface/blast.cmo: toplevel/vernacinterp.cmi \ + toplevel/vernacentries.cmi lib/util.cmi pretyping/typing.cmi \ + pretyping/termops.cmi kernel/term.cmi tactics/tactics.cmi \ + tactics/tacticals.cmi parsing/tactic_printer.cmi pretyping/tacred.cmi \ + proofs/tacmach.cmi tactics/tacinterp.cmi kernel/sign.cmi \ + proofs/refiner.cmi kernel/reduction.cmi pretyping/rawterm.cmi \ + proofs/proof_type.cmi proofs/proof_trees.cmi parsing/printer.cmi \ + parsing/pptactic.cmi lib/pp.cmi proofs/pfedit.cmi parsing/pcoq.cmi \ + contrib/interface/pbp.cmi pretyping/pattern.cmi kernel/names.cmi \ + library/nameops.cmi proofs/logic.cmi kernel/inductive.cmi \ + tactics/hipattern.cmi library/global.cmi lib/explore.cmi \ + pretyping/evd.cmi tactics/equality.cmi kernel/environ.cmi \ + tactics/eauto.cmi library/declare.cmi kernel/declarations.cmi \ + toplevel/command.cmi pretyping/clenv.cmi tactics/auto.cmi \ contrib/interface/blast.cmi -contrib/interface/blast.cmx: tactics/auto.cmx pretyping/clenv.cmx \ - toplevel/command.cmx kernel/declarations.cmx library/declare.cmx \ - tactics/eauto.cmx kernel/environ.cmx tactics/equality.cmx \ - pretyping/evd.cmx lib/explore.cmx library/global.cmx \ - tactics/hipattern.cmx kernel/inductive.cmx proofs/logic.cmx \ - library/nameops.cmx kernel/names.cmx pretyping/pattern.cmx \ - contrib/interface/pbp.cmx parsing/pcoq.cmx proofs/pfedit.cmx lib/pp.cmx \ - parsing/pptactic.cmx parsing/printer.cmx proofs/proof_trees.cmx \ - proofs/proof_type.cmx pretyping/rawterm.cmx kernel/reduction.cmx \ - proofs/refiner.cmx kernel/sign.cmx tactics/tacinterp.cmx \ - proofs/tacmach.cmx pretyping/tacred.cmx parsing/tactic_printer.cmx \ - tactics/tacticals.cmx tactics/tactics.cmx kernel/term.cmx \ - pretyping/termops.cmx pretyping/typing.cmx lib/util.cmx \ - toplevel/vernacentries.cmx toplevel/vernacinterp.cmx \ +contrib/interface/blast.cmx: toplevel/vernacinterp.cmx \ + toplevel/vernacentries.cmx lib/util.cmx pretyping/typing.cmx \ + pretyping/termops.cmx kernel/term.cmx tactics/tactics.cmx \ + tactics/tacticals.cmx parsing/tactic_printer.cmx pretyping/tacred.cmx \ + proofs/tacmach.cmx tactics/tacinterp.cmx kernel/sign.cmx \ + proofs/refiner.cmx kernel/reduction.cmx pretyping/rawterm.cmx \ + proofs/proof_type.cmx proofs/proof_trees.cmx parsing/printer.cmx \ + parsing/pptactic.cmx lib/pp.cmx proofs/pfedit.cmx parsing/pcoq.cmx \ + contrib/interface/pbp.cmx pretyping/pattern.cmx kernel/names.cmx \ + library/nameops.cmx proofs/logic.cmx kernel/inductive.cmx \ + tactics/hipattern.cmx library/global.cmx lib/explore.cmx \ + pretyping/evd.cmx tactics/equality.cmx kernel/environ.cmx \ + tactics/eauto.cmx library/declare.cmx kernel/declarations.cmx \ + toplevel/command.cmx pretyping/clenv.cmx tactics/auto.cmx \ contrib/interface/blast.cmi -contrib/interface/centaur.cmo: contrib/interface/ascent.cmi \ - contrib/interface/blast.cmi toplevel/cerrors.cmi pretyping/classops.cmi \ - toplevel/command.cmi interp/constrintern.cmi \ - contrib/interface/debug_tac.cmi kernel/declarations.cmi \ - library/declare.cmi parsing/egrammar.cmi kernel/environ.cmi \ - pretyping/evd.cmi interp/genarg.cmi library/global.cmi \ - contrib/interface/history.cmi parsing/lexer.cmi library/lib.cmi \ - library/libnames.cmi library/libobject.cmi library/library.cmi \ - toplevel/line_oriented_parser.cmi pretyping/matching.cmi \ - contrib/interface/name_to_ast.cmi library/nameops.cmi kernel/names.cmi \ - library/nametab.cmi contrib/interface/pbp.cmi parsing/pcoq.cmi \ - proofs/pfedit.cmi lib/pp.cmi parsing/pptactic.cmi pretyping/pretyping.cmi \ - parsing/printer.cmi proofs/proof_trees.cmi proofs/proof_type.cmi \ - toplevel/protectedtoplevel.cmi pretyping/rawterm.cmi kernel/reduction.cmi \ - proofs/refiner.cmi parsing/search.cmi contrib/interface/showproof.cmi \ - contrib/interface/showproof_ct.cmo proofs/tacexpr.cmo \ - tactics/tacinterp.cmi proofs/tacmach.cmi kernel/term.cmi \ - contrib/interface/translate.cmi lib/util.cmi toplevel/vernac.cmi \ - toplevel/vernacentries.cmi toplevel/vernacexpr.cmo \ - toplevel/vernacinterp.cmi contrib/interface/vtp.cmi \ - contrib/interface/xlate.cmi -contrib/interface/centaur.cmx: contrib/interface/ascent.cmi \ - contrib/interface/blast.cmx toplevel/cerrors.cmx pretyping/classops.cmx \ - toplevel/command.cmx interp/constrintern.cmx \ - contrib/interface/debug_tac.cmx kernel/declarations.cmx \ - library/declare.cmx parsing/egrammar.cmx kernel/environ.cmx \ - pretyping/evd.cmx interp/genarg.cmx library/global.cmx \ - contrib/interface/history.cmx parsing/lexer.cmx library/lib.cmx \ - library/libnames.cmx library/libobject.cmx library/library.cmx \ - toplevel/line_oriented_parser.cmx pretyping/matching.cmx \ - contrib/interface/name_to_ast.cmx library/nameops.cmx kernel/names.cmx \ - library/nametab.cmx contrib/interface/pbp.cmx parsing/pcoq.cmx \ - proofs/pfedit.cmx lib/pp.cmx parsing/pptactic.cmx pretyping/pretyping.cmx \ - parsing/printer.cmx proofs/proof_trees.cmx proofs/proof_type.cmx \ - toplevel/protectedtoplevel.cmx pretyping/rawterm.cmx kernel/reduction.cmx \ - proofs/refiner.cmx parsing/search.cmx contrib/interface/showproof.cmx \ - contrib/interface/showproof_ct.cmx proofs/tacexpr.cmx \ - tactics/tacinterp.cmx proofs/tacmach.cmx kernel/term.cmx \ - contrib/interface/translate.cmx lib/util.cmx toplevel/vernac.cmx \ - toplevel/vernacentries.cmx toplevel/vernacexpr.cmx \ - toplevel/vernacinterp.cmx contrib/interface/vtp.cmx \ - contrib/interface/xlate.cmx -contrib/interface/dad.cmo: interp/constrextern.cmi interp/constrintern.cmi \ - kernel/environ.cmi pretyping/evd.cmi interp/genarg.cmi library/global.cmi \ - library/libnames.cmi pretyping/matching.cmi library/nameops.cmi \ - kernel/names.cmi library/nametab.cmi contrib/interface/paths.cmi \ - pretyping/pattern.cmi lib/pp.cmi proofs/proof_trees.cmi \ - proofs/proof_type.cmi pretyping/rawterm.cmi kernel/reduction.cmi \ - proofs/tacexpr.cmo proofs/tacmach.cmi tactics/tacticals.cmi \ - tactics/tactics.cmi kernel/term.cmi interp/topconstr.cmi \ - pretyping/typing.cmi lib/util.cmi toplevel/vernacexpr.cmo \ - toplevel/vernacinterp.cmi contrib/interface/dad.cmi -contrib/interface/dad.cmx: interp/constrextern.cmx interp/constrintern.cmx \ - kernel/environ.cmx pretyping/evd.cmx interp/genarg.cmx library/global.cmx \ - library/libnames.cmx pretyping/matching.cmx library/nameops.cmx \ - kernel/names.cmx library/nametab.cmx contrib/interface/paths.cmx \ - pretyping/pattern.cmx lib/pp.cmx proofs/proof_trees.cmx \ - proofs/proof_type.cmx pretyping/rawterm.cmx kernel/reduction.cmx \ - proofs/tacexpr.cmx proofs/tacmach.cmx tactics/tacticals.cmx \ - tactics/tactics.cmx kernel/term.cmx interp/topconstr.cmx \ - pretyping/typing.cmx lib/util.cmx toplevel/vernacexpr.cmx \ - toplevel/vernacinterp.cmx contrib/interface/dad.cmi -contrib/interface/debug_tac.cmo: toplevel/cerrors.cmi interp/genarg.cmi \ - library/global.cmi parsing/pcoq.cmi lib/pp.cmi parsing/pptactic.cmi \ - parsing/printer.cmi proofs/proof_trees.cmi proofs/proof_type.cmi \ - proofs/refiner.cmi proofs/tacexpr.cmo tactics/tacinterp.cmi \ - proofs/tacmach.cmi tactics/tacticals.cmi lib/util.cmi \ +contrib/interface/centaur.cmo: contrib/interface/xlate.cmi \ + contrib/interface/vtp.cmi toplevel/vernacinterp.cmi \ + toplevel/vernacexpr.cmo toplevel/vernacentries.cmi toplevel/vernac.cmi \ + lib/util.cmi contrib/interface/translate.cmi kernel/term.cmi \ + proofs/tacmach.cmi tactics/tacinterp.cmi proofs/tacexpr.cmo \ + contrib/interface/showproof_ct.cmo contrib/interface/showproof.cmi \ + parsing/search.cmi proofs/refiner.cmi kernel/reduction.cmi \ + pretyping/rawterm.cmi toplevel/protectedtoplevel.cmi \ + proofs/proof_type.cmi proofs/proof_trees.cmi parsing/printer.cmi \ + pretyping/pretyping.cmi parsing/pptactic.cmi lib/pp.cmi proofs/pfedit.cmi \ + parsing/pcoq.cmi contrib/interface/pbp.cmi library/nametab.cmi \ + kernel/names.cmi library/nameops.cmi contrib/interface/name_to_ast.cmi \ + pretyping/matching.cmi toplevel/line_oriented_parser.cmi \ + library/library.cmi library/libobject.cmi library/libnames.cmi \ + library/lib.cmi parsing/lexer.cmi contrib/interface/history.cmi \ + library/global.cmi interp/genarg.cmi pretyping/evd.cmi kernel/environ.cmi \ + parsing/egrammar.cmi library/declare.cmi kernel/declarations.cmi \ + contrib/interface/debug_tac.cmi interp/constrintern.cmi \ + toplevel/command.cmi pretyping/classops.cmi toplevel/cerrors.cmi \ + contrib/interface/blast.cmi contrib/interface/ascent.cmi +contrib/interface/centaur.cmx: contrib/interface/xlate.cmx \ + contrib/interface/vtp.cmx toplevel/vernacinterp.cmx \ + toplevel/vernacexpr.cmx toplevel/vernacentries.cmx toplevel/vernac.cmx \ + lib/util.cmx contrib/interface/translate.cmx kernel/term.cmx \ + proofs/tacmach.cmx tactics/tacinterp.cmx proofs/tacexpr.cmx \ + contrib/interface/showproof_ct.cmx contrib/interface/showproof.cmx \ + parsing/search.cmx proofs/refiner.cmx kernel/reduction.cmx \ + pretyping/rawterm.cmx toplevel/protectedtoplevel.cmx \ + proofs/proof_type.cmx proofs/proof_trees.cmx parsing/printer.cmx \ + pretyping/pretyping.cmx parsing/pptactic.cmx lib/pp.cmx proofs/pfedit.cmx \ + parsing/pcoq.cmx contrib/interface/pbp.cmx library/nametab.cmx \ + kernel/names.cmx library/nameops.cmx contrib/interface/name_to_ast.cmx \ + pretyping/matching.cmx toplevel/line_oriented_parser.cmx \ + library/library.cmx library/libobject.cmx library/libnames.cmx \ + library/lib.cmx parsing/lexer.cmx contrib/interface/history.cmx \ + library/global.cmx interp/genarg.cmx pretyping/evd.cmx kernel/environ.cmx \ + parsing/egrammar.cmx library/declare.cmx kernel/declarations.cmx \ + contrib/interface/debug_tac.cmx interp/constrintern.cmx \ + toplevel/command.cmx pretyping/classops.cmx toplevel/cerrors.cmx \ + contrib/interface/blast.cmx contrib/interface/ascent.cmi +contrib/interface/dad.cmo: toplevel/vernacinterp.cmi toplevel/vernacexpr.cmo \ + lib/util.cmi pretyping/typing.cmi interp/topconstr.cmi kernel/term.cmi \ + tactics/tactics.cmi tactics/tacticals.cmi proofs/tacmach.cmi \ + proofs/tacexpr.cmo kernel/reduction.cmi pretyping/rawterm.cmi \ + proofs/proof_type.cmi proofs/proof_trees.cmi lib/pp.cmi \ + pretyping/pattern.cmi contrib/interface/paths.cmi library/nametab.cmi \ + kernel/names.cmi library/nameops.cmi pretyping/matching.cmi \ + library/libnames.cmi library/global.cmi interp/genarg.cmi \ + pretyping/evd.cmi kernel/environ.cmi interp/constrintern.cmi \ + interp/constrextern.cmi contrib/interface/dad.cmi +contrib/interface/dad.cmx: toplevel/vernacinterp.cmx toplevel/vernacexpr.cmx \ + lib/util.cmx pretyping/typing.cmx interp/topconstr.cmx kernel/term.cmx \ + tactics/tactics.cmx tactics/tacticals.cmx proofs/tacmach.cmx \ + proofs/tacexpr.cmx kernel/reduction.cmx pretyping/rawterm.cmx \ + proofs/proof_type.cmx proofs/proof_trees.cmx lib/pp.cmx \ + pretyping/pattern.cmx contrib/interface/paths.cmx library/nametab.cmx \ + kernel/names.cmx library/nameops.cmx pretyping/matching.cmx \ + library/libnames.cmx library/global.cmx interp/genarg.cmx \ + pretyping/evd.cmx kernel/environ.cmx interp/constrintern.cmx \ + interp/constrextern.cmx contrib/interface/dad.cmi +contrib/interface/debug_tac.cmo: lib/util.cmi tactics/tacticals.cmi \ + proofs/tacmach.cmi tactics/tacinterp.cmi proofs/tacexpr.cmo \ + proofs/refiner.cmi proofs/proof_type.cmi proofs/proof_trees.cmi \ + parsing/printer.cmi parsing/pptactic.cmi lib/pp.cmi parsing/pcoq.cmi \ + library/global.cmi interp/genarg.cmi toplevel/cerrors.cmi \ contrib/interface/debug_tac.cmi -contrib/interface/debug_tac.cmx: toplevel/cerrors.cmx interp/genarg.cmx \ - library/global.cmx parsing/pcoq.cmx lib/pp.cmx parsing/pptactic.cmx \ - parsing/printer.cmx proofs/proof_trees.cmx proofs/proof_type.cmx \ - proofs/refiner.cmx proofs/tacexpr.cmx tactics/tacinterp.cmx \ - proofs/tacmach.cmx tactics/tacticals.cmx lib/util.cmx \ +contrib/interface/debug_tac.cmx: lib/util.cmx tactics/tacticals.cmx \ + proofs/tacmach.cmx tactics/tacinterp.cmx proofs/tacexpr.cmx \ + proofs/refiner.cmx proofs/proof_type.cmx proofs/proof_trees.cmx \ + parsing/printer.cmx parsing/pptactic.cmx lib/pp.cmx parsing/pcoq.cmx \ + library/global.cmx interp/genarg.cmx toplevel/cerrors.cmx \ contrib/interface/debug_tac.cmi contrib/interface/history.cmo: contrib/interface/paths.cmi \ contrib/interface/history.cmi @@ -3086,154 +3145,152 @@ contrib/interface/history.cmx: contrib/interface/paths.cmx \ contrib/interface/history.cmi contrib/interface/line_parser.cmo: contrib/interface/line_parser.cmi contrib/interface/line_parser.cmx: contrib/interface/line_parser.cmi -contrib/interface/name_to_ast.cmo: pretyping/classops.cmi \ - interp/constrextern.cmi library/decl_kinds.cmo kernel/declarations.cmi \ - library/declare.cmi kernel/environ.cmi library/global.cmi \ - library/impargs.cmi kernel/inductive.cmi library/lib.cmi \ - library/libnames.cmi library/libobject.cmi library/nameops.cmi \ - kernel/names.cmi library/nametab.cmi lib/pp.cmi parsing/prettyp.cmi \ - kernel/reduction.cmi kernel/sign.cmi kernel/term.cmi interp/topconstr.cmi \ - lib/util.cmi toplevel/vernacexpr.cmo contrib/interface/name_to_ast.cmi -contrib/interface/name_to_ast.cmx: pretyping/classops.cmx \ - interp/constrextern.cmx library/decl_kinds.cmx kernel/declarations.cmx \ - library/declare.cmx kernel/environ.cmx library/global.cmx \ - library/impargs.cmx kernel/inductive.cmx library/lib.cmx \ - library/libnames.cmx library/libobject.cmx library/nameops.cmx \ - kernel/names.cmx library/nametab.cmx lib/pp.cmx parsing/prettyp.cmx \ - kernel/reduction.cmx kernel/sign.cmx kernel/term.cmx interp/topconstr.cmx \ - lib/util.cmx toplevel/vernacexpr.cmx contrib/interface/name_to_ast.cmi -contrib/interface/parse.cmo: contrib/interface/ascent.cmi \ - toplevel/cerrors.cmi config/coq_config.cmi library/declaremods.cmi \ - library/libnames.cmi library/libobject.cmi library/library.cmi \ - contrib/interface/line_parser.cmi toplevel/mltop.cmi library/nameops.cmi \ - kernel/names.cmi library/nametab.cmi parsing/pcoq.cmi lib/pp.cmi \ - lib/system.cmi lib/util.cmi toplevel/vernacentries.cmi \ - toplevel/vernacexpr.cmo contrib/interface/vtp.cmi \ - contrib/interface/xlate.cmi -contrib/interface/parse.cmx: contrib/interface/ascent.cmi \ - toplevel/cerrors.cmx config/coq_config.cmx library/declaremods.cmx \ - library/libnames.cmx library/libobject.cmx library/library.cmx \ - contrib/interface/line_parser.cmx toplevel/mltop.cmx library/nameops.cmx \ - kernel/names.cmx library/nametab.cmx parsing/pcoq.cmx lib/pp.cmx \ - lib/system.cmx lib/util.cmx toplevel/vernacentries.cmx \ - toplevel/vernacexpr.cmx contrib/interface/vtp.cmx \ - contrib/interface/xlate.cmx +contrib/interface/name_to_ast.cmo: toplevel/vernacexpr.cmo lib/util.cmi \ + interp/topconstr.cmi kernel/term.cmi kernel/sign.cmi kernel/reduction.cmi \ + parsing/prettyp.cmi lib/pp.cmi library/nametab.cmi kernel/names.cmi \ + library/nameops.cmi library/libobject.cmi library/libnames.cmi \ + library/lib.cmi kernel/inductive.cmi library/impargs.cmi \ + library/global.cmi kernel/environ.cmi library/declare.cmi \ + kernel/declarations.cmi library/decl_kinds.cmo interp/constrextern.cmi \ + pretyping/classops.cmi contrib/interface/name_to_ast.cmi +contrib/interface/name_to_ast.cmx: toplevel/vernacexpr.cmx lib/util.cmx \ + interp/topconstr.cmx kernel/term.cmx kernel/sign.cmx kernel/reduction.cmx \ + parsing/prettyp.cmx lib/pp.cmx library/nametab.cmx kernel/names.cmx \ + library/nameops.cmx library/libobject.cmx library/libnames.cmx \ + library/lib.cmx kernel/inductive.cmx library/impargs.cmx \ + library/global.cmx kernel/environ.cmx library/declare.cmx \ + kernel/declarations.cmx library/decl_kinds.cmx interp/constrextern.cmx \ + pretyping/classops.cmx contrib/interface/name_to_ast.cmi +contrib/interface/parse.cmo: contrib/interface/xlate.cmi \ + contrib/interface/vtp.cmi toplevel/vernacexpr.cmo \ + toplevel/vernacentries.cmi lib/util.cmi lib/system.cmi lib/pp.cmi \ + parsing/pcoq.cmi library/nametab.cmi kernel/names.cmi library/nameops.cmi \ + toplevel/mltop.cmi contrib/interface/line_parser.cmi library/library.cmi \ + library/libobject.cmi library/libnames.cmi library/declaremods.cmi \ + config/coq_config.cmi toplevel/cerrors.cmi contrib/interface/ascent.cmi +contrib/interface/parse.cmx: contrib/interface/xlate.cmx \ + contrib/interface/vtp.cmx toplevel/vernacexpr.cmx \ + toplevel/vernacentries.cmx lib/util.cmx lib/system.cmx lib/pp.cmx \ + parsing/pcoq.cmx library/nametab.cmx kernel/names.cmx library/nameops.cmx \ + toplevel/mltop.cmx contrib/interface/line_parser.cmx library/library.cmx \ + library/libobject.cmx library/libnames.cmx library/declaremods.cmx \ + config/coq_config.cmx toplevel/cerrors.cmx contrib/interface/ascent.cmi contrib/interface/paths.cmo: contrib/interface/paths.cmi contrib/interface/paths.cmx: contrib/interface/paths.cmi -contrib/interface/pbp.cmo: interp/coqlib.cmi kernel/environ.cmi \ - pretyping/evd.cmi interp/genarg.cmi library/global.cmi \ - tactics/hipattern.cmi library/libnames.cmi proofs/logic.cmi \ - pretyping/matching.cmi kernel/names.cmi library/nametab.cmi \ - pretyping/pattern.cmi lib/pp.cmi pretyping/pretyping.cmi \ - proofs/proof_trees.cmi proofs/proof_type.cmi pretyping/rawterm.cmi \ - kernel/reduction.cmi proofs/tacexpr.cmo tactics/tacinterp.cmi \ - proofs/tacmach.cmi tactics/tacticals.cmi tactics/tactics.cmi \ - kernel/term.cmi pretyping/termops.cmi interp/topconstr.cmi \ - pretyping/typing.cmi lib/util.cmi contrib/interface/pbp.cmi -contrib/interface/pbp.cmx: interp/coqlib.cmx kernel/environ.cmx \ - pretyping/evd.cmx interp/genarg.cmx library/global.cmx \ - tactics/hipattern.cmx library/libnames.cmx proofs/logic.cmx \ - pretyping/matching.cmx kernel/names.cmx library/nametab.cmx \ - pretyping/pattern.cmx lib/pp.cmx pretyping/pretyping.cmx \ - proofs/proof_trees.cmx proofs/proof_type.cmx pretyping/rawterm.cmx \ - kernel/reduction.cmx proofs/tacexpr.cmx tactics/tacinterp.cmx \ - proofs/tacmach.cmx tactics/tacticals.cmx tactics/tactics.cmx \ - kernel/term.cmx pretyping/termops.cmx interp/topconstr.cmx \ - pretyping/typing.cmx lib/util.cmx contrib/interface/pbp.cmi -contrib/interface/showproof_ct.cmo: contrib/interface/ascent.cmi \ - library/global.cmi toplevel/metasyntax.cmi lib/pp.cmi parsing/printer.cmi \ - contrib/interface/translate.cmi contrib/interface/vtp.cmi \ - contrib/interface/xlate.cmi -contrib/interface/showproof_ct.cmx: contrib/interface/ascent.cmi \ - library/global.cmx toplevel/metasyntax.cmx lib/pp.cmx parsing/printer.cmx \ - contrib/interface/translate.cmx contrib/interface/vtp.cmx \ - contrib/interface/xlate.cmx -contrib/interface/showproof.cmo: pretyping/clenv.cmi interp/constrintern.cmi \ - kernel/declarations.cmi kernel/environ.cmi pretyping/evd.cmi \ - interp/genarg.cmi library/global.cmi kernel/inductive.cmi \ - pretyping/inductiveops.cmi library/libnames.cmi library/nameops.cmi \ - kernel/names.cmi proofs/pfedit.cmi lib/pp.cmi parsing/printer.cmi \ - proofs/proof_trees.cmi proofs/proof_type.cmi pretyping/rawterm.cmi \ - pretyping/reductionops.cmi contrib/interface/showproof_ct.cmo \ - kernel/sign.cmi proofs/tacexpr.cmo proofs/tacmach.cmi kernel/term.cmi \ - pretyping/termops.cmi contrib/interface/translate.cmi \ - pretyping/typing.cmi lib/util.cmi toplevel/vernacinterp.cmi \ +contrib/interface/pbp.cmo: lib/util.cmi pretyping/typing.cmi \ + interp/topconstr.cmi pretyping/termops.cmi kernel/term.cmi \ + tactics/tactics.cmi tactics/tacticals.cmi proofs/tacmach.cmi \ + tactics/tacinterp.cmi proofs/tacexpr.cmo kernel/reduction.cmi \ + pretyping/rawterm.cmi proofs/proof_type.cmi proofs/proof_trees.cmi \ + pretyping/pretyping.cmi lib/pp.cmi pretyping/pattern.cmi \ + library/nametab.cmi kernel/names.cmi pretyping/matching.cmi \ + proofs/logic.cmi library/libnames.cmi tactics/hipattern.cmi \ + library/global.cmi interp/genarg.cmi pretyping/evd.cmi kernel/environ.cmi \ + interp/coqlib.cmi contrib/interface/pbp.cmi +contrib/interface/pbp.cmx: lib/util.cmx pretyping/typing.cmx \ + interp/topconstr.cmx pretyping/termops.cmx kernel/term.cmx \ + tactics/tactics.cmx tactics/tacticals.cmx proofs/tacmach.cmx \ + tactics/tacinterp.cmx proofs/tacexpr.cmx kernel/reduction.cmx \ + pretyping/rawterm.cmx proofs/proof_type.cmx proofs/proof_trees.cmx \ + pretyping/pretyping.cmx lib/pp.cmx pretyping/pattern.cmx \ + library/nametab.cmx kernel/names.cmx pretyping/matching.cmx \ + proofs/logic.cmx library/libnames.cmx tactics/hipattern.cmx \ + library/global.cmx interp/genarg.cmx pretyping/evd.cmx kernel/environ.cmx \ + interp/coqlib.cmx contrib/interface/pbp.cmi +contrib/interface/showproof_ct.cmo: contrib/interface/xlate.cmi \ + contrib/interface/vtp.cmi contrib/interface/translate.cmi \ + parsing/printer.cmi lib/pp.cmi toplevel/metasyntax.cmi library/global.cmi \ + contrib/interface/ascent.cmi +contrib/interface/showproof_ct.cmx: contrib/interface/xlate.cmx \ + contrib/interface/vtp.cmx contrib/interface/translate.cmx \ + parsing/printer.cmx lib/pp.cmx toplevel/metasyntax.cmx library/global.cmx \ + contrib/interface/ascent.cmi +contrib/interface/showproof.cmo: toplevel/vernacinterp.cmi lib/util.cmi \ + pretyping/typing.cmi contrib/interface/translate.cmi \ + pretyping/termops.cmi kernel/term.cmi proofs/tacmach.cmi \ + proofs/tacexpr.cmo kernel/sign.cmi contrib/interface/showproof_ct.cmo \ + pretyping/reductionops.cmi pretyping/rawterm.cmi proofs/proof_type.cmi \ + proofs/proof_trees.cmi parsing/printer.cmi lib/pp.cmi proofs/pfedit.cmi \ + kernel/names.cmi library/nameops.cmi library/libnames.cmi \ + pretyping/inductiveops.cmi kernel/inductive.cmi library/global.cmi \ + interp/genarg.cmi pretyping/evd.cmi kernel/environ.cmi \ + kernel/declarations.cmi interp/constrintern.cmi pretyping/clenv.cmi \ contrib/interface/showproof.cmi -contrib/interface/showproof.cmx: pretyping/clenv.cmx interp/constrintern.cmx \ - kernel/declarations.cmx kernel/environ.cmx pretyping/evd.cmx \ - interp/genarg.cmx library/global.cmx kernel/inductive.cmx \ - pretyping/inductiveops.cmx library/libnames.cmx library/nameops.cmx \ - kernel/names.cmx proofs/pfedit.cmx lib/pp.cmx parsing/printer.cmx \ - proofs/proof_trees.cmx proofs/proof_type.cmx pretyping/rawterm.cmx \ - pretyping/reductionops.cmx contrib/interface/showproof_ct.cmx \ - kernel/sign.cmx proofs/tacexpr.cmx proofs/tacmach.cmx kernel/term.cmx \ - pretyping/termops.cmx contrib/interface/translate.cmx \ - pretyping/typing.cmx lib/util.cmx toplevel/vernacinterp.cmx \ +contrib/interface/showproof.cmx: toplevel/vernacinterp.cmx lib/util.cmx \ + pretyping/typing.cmx contrib/interface/translate.cmx \ + pretyping/termops.cmx kernel/term.cmx proofs/tacmach.cmx \ + proofs/tacexpr.cmx kernel/sign.cmx contrib/interface/showproof_ct.cmx \ + pretyping/reductionops.cmx pretyping/rawterm.cmx proofs/proof_type.cmx \ + proofs/proof_trees.cmx parsing/printer.cmx lib/pp.cmx proofs/pfedit.cmx \ + kernel/names.cmx library/nameops.cmx library/libnames.cmx \ + pretyping/inductiveops.cmx kernel/inductive.cmx library/global.cmx \ + interp/genarg.cmx pretyping/evd.cmx kernel/environ.cmx \ + kernel/declarations.cmx interp/constrintern.cmx pretyping/clenv.cmx \ contrib/interface/showproof.cmi -contrib/interface/translate.cmo: contrib/interface/ascent.cmi \ - interp/constrextern.cmi kernel/environ.cmi pretyping/evarutil.cmi \ - pretyping/evd.cmi library/libobject.cmi library/library.cmi \ - kernel/names.cmi proofs/pfedit.cmi lib/pp.cmi proofs/proof_type.cmi \ - kernel/sign.cmi proofs/tacmach.cmi kernel/term.cmi lib/util.cmi \ - toplevel/vernacinterp.cmi contrib/interface/vtp.cmi \ - contrib/interface/xlate.cmi contrib/interface/translate.cmi -contrib/interface/translate.cmx: contrib/interface/ascent.cmi \ - interp/constrextern.cmx kernel/environ.cmx pretyping/evarutil.cmx \ - pretyping/evd.cmx library/libobject.cmx library/library.cmx \ - kernel/names.cmx proofs/pfedit.cmx lib/pp.cmx proofs/proof_type.cmx \ - kernel/sign.cmx proofs/tacmach.cmx kernel/term.cmx lib/util.cmx \ - toplevel/vernacinterp.cmx contrib/interface/vtp.cmx \ - contrib/interface/xlate.cmx contrib/interface/translate.cmi +contrib/interface/translate.cmo: contrib/interface/xlate.cmi \ + contrib/interface/vtp.cmi toplevel/vernacinterp.cmi lib/util.cmi \ + kernel/term.cmi proofs/tacmach.cmi kernel/sign.cmi proofs/proof_type.cmi \ + lib/pp.cmi proofs/pfedit.cmi kernel/names.cmi library/library.cmi \ + library/libobject.cmi pretyping/evd.cmi pretyping/evarutil.cmi \ + kernel/environ.cmi interp/constrextern.cmi contrib/interface/ascent.cmi \ + contrib/interface/translate.cmi +contrib/interface/translate.cmx: contrib/interface/xlate.cmx \ + contrib/interface/vtp.cmx toplevel/vernacinterp.cmx lib/util.cmx \ + kernel/term.cmx proofs/tacmach.cmx kernel/sign.cmx proofs/proof_type.cmx \ + lib/pp.cmx proofs/pfedit.cmx kernel/names.cmx library/library.cmx \ + library/libobject.cmx pretyping/evd.cmx pretyping/evarutil.cmx \ + kernel/environ.cmx interp/constrextern.cmx contrib/interface/ascent.cmi \ + contrib/interface/translate.cmi contrib/interface/vtp.cmo: contrib/interface/ascent.cmi \ contrib/interface/vtp.cmi contrib/interface/vtp.cmx: contrib/interface/ascent.cmi \ contrib/interface/vtp.cmi -contrib/interface/xlate.cmo: contrib/interface/ascent.cmi lib/bigint.cmi \ - library/decl_kinds.cmo tactics/eauto.cmi parsing/extend.cmi \ - tactics/extraargs.cmi tactics/extratactics.cmi contrib/field/field.cmo \ - interp/genarg.cmi library/goptions.cmi library/libnames.cmi \ - kernel/names.cmi parsing/pcoq.cmi parsing/ppconstr.cmi \ - pretyping/rawterm.cmi proofs/tacexpr.cmo kernel/term.cmi \ - interp/topconstr.cmi lib/util.cmi toplevel/vernacexpr.cmo \ +contrib/interface/xlate.cmo: toplevel/vernacexpr.cmo lib/util.cmi \ + interp/topconstr.cmi kernel/term.cmi proofs/tacexpr.cmo \ + pretyping/rawterm.cmi parsing/ppconstr.cmi parsing/pcoq.cmi \ + kernel/names.cmi library/libnames.cmi library/goptions.cmi \ + interp/genarg.cmi contrib/field/field.cmo tactics/extratactics.cmi \ + tactics/extraargs.cmi parsing/extend.cmi tactics/eauto.cmi \ + library/decl_kinds.cmo lib/bigint.cmi contrib/interface/ascent.cmi \ contrib/interface/xlate.cmi -contrib/interface/xlate.cmx: contrib/interface/ascent.cmi lib/bigint.cmx \ - library/decl_kinds.cmx tactics/eauto.cmx parsing/extend.cmx \ - tactics/extraargs.cmx tactics/extratactics.cmx contrib/field/field.cmx \ - interp/genarg.cmx library/goptions.cmx library/libnames.cmx \ - kernel/names.cmx parsing/pcoq.cmx parsing/ppconstr.cmx \ - pretyping/rawterm.cmx proofs/tacexpr.cmx kernel/term.cmx \ - interp/topconstr.cmx lib/util.cmx toplevel/vernacexpr.cmx \ +contrib/interface/xlate.cmx: toplevel/vernacexpr.cmx lib/util.cmx \ + interp/topconstr.cmx kernel/term.cmx proofs/tacexpr.cmx \ + pretyping/rawterm.cmx parsing/ppconstr.cmx parsing/pcoq.cmx \ + kernel/names.cmx library/libnames.cmx library/goptions.cmx \ + interp/genarg.cmx contrib/field/field.cmx tactics/extratactics.cmx \ + tactics/extraargs.cmx parsing/extend.cmx tactics/eauto.cmx \ + library/decl_kinds.cmx lib/bigint.cmx contrib/interface/ascent.cmi \ contrib/interface/xlate.cmi -contrib/jprover/jall.cmo: contrib/jprover/jlogic.cmi \ - contrib/jprover/jterm.cmi contrib/jprover/jtunify.cmi \ - contrib/jprover/opname.cmi lib/pp.cmi contrib/jprover/jall.cmi -contrib/jprover/jall.cmx: contrib/jprover/jlogic.cmx \ - contrib/jprover/jterm.cmx contrib/jprover/jtunify.cmx \ - contrib/jprover/opname.cmx lib/pp.cmx contrib/jprover/jall.cmi -contrib/jprover/jlogic.cmo: contrib/jprover/jterm.cmi \ - contrib/jprover/opname.cmi contrib/jprover/jlogic.cmi -contrib/jprover/jlogic.cmx: contrib/jprover/jterm.cmx \ - contrib/jprover/opname.cmx contrib/jprover/jlogic.cmi -contrib/jprover/jprover.cmo: toplevel/cerrors.cmi parsing/egrammar.cmi \ - pretyping/evarutil.cmi interp/genarg.cmi library/global.cmi \ - tactics/hiddentac.cmi tactics/hipattern.cmi contrib/jprover/jall.cmi \ - contrib/jprover/jlogic.cmi contrib/jprover/jterm.cmi kernel/names.cmi \ - pretyping/pattern.cmi parsing/pcoq.cmi lib/pp.cmi parsing/pptactic.cmi \ - parsing/printer.cmi proofs/proof_type.cmi pretyping/rawterm.cmi \ - kernel/reduction.cmi pretyping/reductionops.cmi proofs/refiner.cmi \ - proofs/tacexpr.cmo tactics/tacinterp.cmi proofs/tacmach.cmi \ - tactics/tacticals.cmi tactics/tactics.cmi kernel/term.cmi \ - pretyping/termops.cmi lib/util.cmi -contrib/jprover/jprover.cmx: toplevel/cerrors.cmx parsing/egrammar.cmx \ - pretyping/evarutil.cmx interp/genarg.cmx library/global.cmx \ - tactics/hiddentac.cmx tactics/hipattern.cmx contrib/jprover/jall.cmx \ - contrib/jprover/jlogic.cmx contrib/jprover/jterm.cmx kernel/names.cmx \ - pretyping/pattern.cmx parsing/pcoq.cmx lib/pp.cmx parsing/pptactic.cmx \ - parsing/printer.cmx proofs/proof_type.cmx pretyping/rawterm.cmx \ - kernel/reduction.cmx pretyping/reductionops.cmx proofs/refiner.cmx \ - proofs/tacexpr.cmx tactics/tacinterp.cmx proofs/tacmach.cmx \ - tactics/tacticals.cmx tactics/tactics.cmx kernel/term.cmx \ - pretyping/termops.cmx lib/util.cmx +contrib/jprover/jall.cmo: lib/pp.cmi contrib/jprover/opname.cmi \ + contrib/jprover/jtunify.cmi contrib/jprover/jterm.cmi \ + contrib/jprover/jlogic.cmi contrib/jprover/jall.cmi +contrib/jprover/jall.cmx: lib/pp.cmx contrib/jprover/opname.cmx \ + contrib/jprover/jtunify.cmx contrib/jprover/jterm.cmx \ + contrib/jprover/jlogic.cmx contrib/jprover/jall.cmi +contrib/jprover/jlogic.cmo: contrib/jprover/opname.cmi \ + contrib/jprover/jterm.cmi contrib/jprover/jlogic.cmi +contrib/jprover/jlogic.cmx: contrib/jprover/opname.cmx \ + contrib/jprover/jterm.cmx contrib/jprover/jlogic.cmi +contrib/jprover/jprover.cmo: lib/util.cmi pretyping/termops.cmi \ + kernel/term.cmi tactics/tactics.cmi tactics/tacticals.cmi \ + proofs/tacmach.cmi tactics/tacinterp.cmi proofs/tacexpr.cmo \ + proofs/refiner.cmi pretyping/reductionops.cmi kernel/reduction.cmi \ + pretyping/rawterm.cmi proofs/proof_type.cmi parsing/printer.cmi \ + parsing/pptactic.cmi lib/pp.cmi parsing/pcoq.cmi pretyping/pattern.cmi \ + kernel/names.cmi contrib/jprover/jterm.cmi contrib/jprover/jlogic.cmi \ + contrib/jprover/jall.cmi tactics/hipattern.cmi tactics/hiddentac.cmi \ + library/global.cmi interp/genarg.cmi pretyping/evarutil.cmi \ + parsing/egrammar.cmi toplevel/cerrors.cmi +contrib/jprover/jprover.cmx: lib/util.cmx pretyping/termops.cmx \ + kernel/term.cmx tactics/tactics.cmx tactics/tacticals.cmx \ + proofs/tacmach.cmx tactics/tacinterp.cmx proofs/tacexpr.cmx \ + proofs/refiner.cmx pretyping/reductionops.cmx kernel/reduction.cmx \ + pretyping/rawterm.cmx proofs/proof_type.cmx parsing/printer.cmx \ + parsing/pptactic.cmx lib/pp.cmx parsing/pcoq.cmx pretyping/pattern.cmx \ + kernel/names.cmx contrib/jprover/jterm.cmx contrib/jprover/jlogic.cmx \ + contrib/jprover/jall.cmx tactics/hipattern.cmx tactics/hiddentac.cmx \ + library/global.cmx interp/genarg.cmx pretyping/evarutil.cmx \ + parsing/egrammar.cmx toplevel/cerrors.cmx contrib/jprover/jterm.cmo: contrib/jprover/opname.cmi \ contrib/jprover/jterm.cmi contrib/jprover/jterm.cmx: contrib/jprover/opname.cmx \ @@ -3242,524 +3299,564 @@ contrib/jprover/jtunify.cmo: contrib/jprover/jtunify.cmi contrib/jprover/jtunify.cmx: contrib/jprover/jtunify.cmi contrib/jprover/opname.cmo: contrib/jprover/opname.cmi contrib/jprover/opname.cmx: contrib/jprover/opname.cmi -contrib/omega/coq_omega.cmo: lib/bigint.cmi pretyping/clenv.cmi \ - kernel/closure.cmi tactics/contradiction.cmi interp/coqlib.cmi \ - kernel/declarations.cmi kernel/environ.cmi tactics/equality.cmi \ - proofs/evar_refiner.cmi pretyping/evarutil.cmi library/global.cmi \ - library/goptions.cmi kernel/inductive.cmi library/libnames.cmi \ - proofs/logic.cmi library/nameops.cmi kernel/names.cmi library/nametab.cmi \ - contrib/omega/omega.cmo lib/pp.cmi parsing/printer.cmi \ - proofs/proof_type.cmi pretyping/rawterm.cmi kernel/reduction.cmi \ - kernel/sign.cmi proofs/tacmach.cmi pretyping/tacred.cmi \ - tactics/tacticals.cmi tactics/tactics.cmi kernel/term.cmi \ - pretyping/termops.cmi lib/util.cmi -contrib/omega/coq_omega.cmx: lib/bigint.cmx pretyping/clenv.cmx \ - kernel/closure.cmx tactics/contradiction.cmx interp/coqlib.cmx \ - kernel/declarations.cmx kernel/environ.cmx tactics/equality.cmx \ - proofs/evar_refiner.cmx pretyping/evarutil.cmx library/global.cmx \ - library/goptions.cmx kernel/inductive.cmx library/libnames.cmx \ - proofs/logic.cmx library/nameops.cmx kernel/names.cmx library/nametab.cmx \ - contrib/omega/omega.cmx lib/pp.cmx parsing/printer.cmx \ - proofs/proof_type.cmx pretyping/rawterm.cmx kernel/reduction.cmx \ - kernel/sign.cmx proofs/tacmach.cmx pretyping/tacred.cmx \ - tactics/tacticals.cmx tactics/tactics.cmx kernel/term.cmx \ - pretyping/termops.cmx lib/util.cmx -contrib/omega/g_omega.cmo: toplevel/cerrors.cmi contrib/omega/coq_omega.cmo \ - parsing/egrammar.cmi parsing/pcoq.cmi lib/pp.cmi parsing/pptactic.cmi \ - proofs/refiner.cmi proofs/tacexpr.cmo tactics/tacinterp.cmi lib/util.cmi -contrib/omega/g_omega.cmx: toplevel/cerrors.cmx contrib/omega/coq_omega.cmx \ - parsing/egrammar.cmx parsing/pcoq.cmx lib/pp.cmx parsing/pptactic.cmx \ - proofs/refiner.cmx proofs/tacexpr.cmx tactics/tacinterp.cmx lib/util.cmx -contrib/omega/omega.cmo: kernel/names.cmi lib/util.cmi -contrib/omega/omega.cmx: kernel/names.cmx lib/util.cmx -contrib/recdef/recdef.cmo: tactics/auto.cmi toplevel/cerrors.cmi \ - kernel/closure.cmi toplevel/command.cmi interp/constrintern.cmi \ - interp/coqlib.cmi library/decl_kinds.cmo kernel/declarations.cmi \ - library/declare.cmi tactics/eauto.cmi parsing/egrammar.cmi \ - tactics/elim.cmi kernel/entries.cmi kernel/environ.cmi \ - tactics/equality.cmi pretyping/evd.cmi interp/genarg.cmi \ - library/global.cmi tactics/hiddentac.cmi library/lib.cmi \ - library/libnames.cmi library/nameops.cmi kernel/names.cmi \ - library/nametab.cmi lib/options.cmi parsing/pcoq.cmi proofs/pfedit.cmi \ - lib/pp.cmi pretyping/pretyping.cmi parsing/printer.cmi \ - proofs/proof_type.cmi pretyping/rawterm.cmi kernel/safe_typing.cmi \ - proofs/tacmach.cmi pretyping/tacred.cmi tactics/tacticals.cmi \ - tactics/tactics.cmi kernel/term.cmi pretyping/termops.cmi \ - interp/topconstr.cmi pretyping/typing.cmi lib/util.cmi \ - toplevel/vernacinterp.cmi -contrib/recdef/recdef.cmx: tactics/auto.cmx toplevel/cerrors.cmx \ - kernel/closure.cmx toplevel/command.cmx interp/constrintern.cmx \ - interp/coqlib.cmx library/decl_kinds.cmx kernel/declarations.cmx \ - library/declare.cmx tactics/eauto.cmx parsing/egrammar.cmx \ - tactics/elim.cmx kernel/entries.cmx kernel/environ.cmx \ - tactics/equality.cmx pretyping/evd.cmx interp/genarg.cmx \ - library/global.cmx tactics/hiddentac.cmx library/lib.cmx \ - library/libnames.cmx library/nameops.cmx kernel/names.cmx \ - library/nametab.cmx lib/options.cmx parsing/pcoq.cmx proofs/pfedit.cmx \ - lib/pp.cmx pretyping/pretyping.cmx parsing/printer.cmx \ - proofs/proof_type.cmx pretyping/rawterm.cmx kernel/safe_typing.cmx \ - proofs/tacmach.cmx pretyping/tacred.cmx tactics/tacticals.cmx \ - tactics/tactics.cmx kernel/term.cmx pretyping/termops.cmx \ - interp/topconstr.cmx pretyping/typing.cmx lib/util.cmx \ - toplevel/vernacinterp.cmx -contrib/ring/g_quote.cmo: toplevel/cerrors.cmi parsing/egrammar.cmi \ - interp/genarg.cmi parsing/pcoq.cmi lib/pp.cmi parsing/pptactic.cmi \ - contrib/ring/quote.cmo proofs/refiner.cmi proofs/tacexpr.cmo \ - tactics/tacinterp.cmi lib/util.cmi -contrib/ring/g_quote.cmx: toplevel/cerrors.cmx parsing/egrammar.cmx \ - interp/genarg.cmx parsing/pcoq.cmx lib/pp.cmx parsing/pptactic.cmx \ - contrib/ring/quote.cmx proofs/refiner.cmx proofs/tacexpr.cmx \ - tactics/tacinterp.cmx lib/util.cmx -contrib/ring/g_ring.cmo: toplevel/cerrors.cmi parsing/egrammar.cmi \ - interp/genarg.cmi parsing/pcoq.cmi lib/pp.cmi parsing/pptactic.cmi \ - contrib/ring/quote.cmo proofs/refiner.cmi contrib/ring/ring.cmo \ - proofs/tacexpr.cmo tactics/tacinterp.cmi lib/util.cmi \ - toplevel/vernacinterp.cmi -contrib/ring/g_ring.cmx: toplevel/cerrors.cmx parsing/egrammar.cmx \ - interp/genarg.cmx parsing/pcoq.cmx lib/pp.cmx parsing/pptactic.cmx \ - contrib/ring/quote.cmx proofs/refiner.cmx contrib/ring/ring.cmx \ - proofs/tacexpr.cmx tactics/tacinterp.cmx lib/util.cmx \ - toplevel/vernacinterp.cmx -contrib/ring/quote.cmo: interp/coqlib.cmi kernel/environ.cmi \ - library/global.cmi pretyping/matching.cmi kernel/names.cmi \ - pretyping/pattern.cmi lib/pp.cmi proofs/proof_trees.cmi \ - proofs/tacexpr.cmo proofs/tacmach.cmi tactics/tactics.cmi kernel/term.cmi \ - pretyping/termops.cmi lib/util.cmi -contrib/ring/quote.cmx: interp/coqlib.cmx kernel/environ.cmx \ - library/global.cmx pretyping/matching.cmx kernel/names.cmx \ - pretyping/pattern.cmx lib/pp.cmx proofs/proof_trees.cmx \ - proofs/tacexpr.cmx proofs/tacmach.cmx tactics/tactics.cmx kernel/term.cmx \ - pretyping/termops.cmx lib/util.cmx -contrib/ring/ring.cmo: kernel/closure.cmi interp/constrintern.cmi \ - interp/coqlib.cmi tactics/equality.cmi pretyping/evd.cmi \ - library/global.cmi tactics/hiddentac.cmi tactics/hipattern.cmi \ - library/lib.cmi library/libnames.cmi library/libobject.cmi \ - kernel/mod_subst.cmi library/nameops.cmi kernel/names.cmi \ - library/nametab.cmi lib/options.cmi pretyping/pattern.cmi lib/pp.cmi \ - parsing/printer.cmi proofs/proof_trees.cmi contrib/ring/quote.cmo \ - pretyping/reductionops.cmi tactics/setoid_replace.cmi library/summary.cmi \ - proofs/tacexpr.cmo proofs/tacmach.cmi pretyping/tacred.cmi \ - tactics/tacticals.cmi tactics/tactics.cmi kernel/term.cmi \ - pretyping/typing.cmi lib/util.cmi toplevel/vernacexpr.cmo \ - toplevel/vernacinterp.cmi -contrib/ring/ring.cmx: kernel/closure.cmx interp/constrintern.cmx \ - interp/coqlib.cmx tactics/equality.cmx pretyping/evd.cmx \ - library/global.cmx tactics/hiddentac.cmx tactics/hipattern.cmx \ - library/lib.cmx library/libnames.cmx library/libobject.cmx \ - kernel/mod_subst.cmx library/nameops.cmx kernel/names.cmx \ - library/nametab.cmx lib/options.cmx pretyping/pattern.cmx lib/pp.cmx \ - parsing/printer.cmx proofs/proof_trees.cmx contrib/ring/quote.cmx \ - pretyping/reductionops.cmx tactics/setoid_replace.cmx library/summary.cmx \ - proofs/tacexpr.cmx proofs/tacmach.cmx pretyping/tacred.cmx \ - tactics/tacticals.cmx tactics/tactics.cmx kernel/term.cmx \ - pretyping/typing.cmx lib/util.cmx toplevel/vernacexpr.cmx \ - toplevel/vernacinterp.cmx -contrib/romega/const_omega.cmo: lib/bigint.cmi interp/coqlib.cmi \ - library/libnames.cmi kernel/names.cmi library/nametab.cmi kernel/term.cmi \ - lib/util.cmi -contrib/romega/const_omega.cmx: lib/bigint.cmx interp/coqlib.cmx \ - library/libnames.cmx kernel/names.cmx library/nametab.cmx kernel/term.cmx \ - lib/util.cmx -contrib/romega/g_romega.cmo: toplevel/cerrors.cmi parsing/egrammar.cmi \ - parsing/pcoq.cmi lib/pp.cmi parsing/pptactic.cmi proofs/refiner.cmi \ - contrib/romega/refl_omega.cmo proofs/tacexpr.cmo tactics/tacinterp.cmi \ - lib/util.cmi -contrib/romega/g_romega.cmx: toplevel/cerrors.cmx parsing/egrammar.cmx \ - parsing/pcoq.cmx lib/pp.cmx parsing/pptactic.cmx proofs/refiner.cmx \ - contrib/romega/refl_omega.cmx proofs/tacexpr.cmx tactics/tacinterp.cmx \ - lib/util.cmx -contrib/romega/refl_omega.cmo: lib/bigint.cmi contrib/romega/const_omega.cmo \ - interp/coqlib.cmi proofs/logic.cmi kernel/names.cmi \ - contrib/omega/omega.cmo lib/pp.cmi parsing/printer.cmi proofs/tacmach.cmi \ - tactics/tacticals.cmi tactics/tactics.cmi kernel/term.cmi lib/util.cmi -contrib/romega/refl_omega.cmx: lib/bigint.cmx contrib/romega/const_omega.cmx \ - interp/coqlib.cmx proofs/logic.cmx kernel/names.cmx \ - contrib/omega/omega.cmx lib/pp.cmx parsing/printer.cmx proofs/tacmach.cmx \ - tactics/tacticals.cmx tactics/tactics.cmx kernel/term.cmx lib/util.cmx -contrib/rtauto/g_rtauto.cmo: toplevel/cerrors.cmi parsing/egrammar.cmi \ - parsing/pcoq.cmi lib/pp.cmi parsing/pptactic.cmi proofs/refiner.cmi \ - contrib/rtauto/refl_tauto.cmi proofs/tacexpr.cmo tactics/tacinterp.cmi \ - lib/util.cmi -contrib/rtauto/g_rtauto.cmx: toplevel/cerrors.cmx parsing/egrammar.cmx \ - parsing/pcoq.cmx lib/pp.cmx parsing/pptactic.cmx proofs/refiner.cmx \ - contrib/rtauto/refl_tauto.cmx proofs/tacexpr.cmx tactics/tacinterp.cmx \ - lib/util.cmx -contrib/rtauto/proof_search.cmo: library/goptions.cmi lib/pp.cmi \ - kernel/term.cmi lib/util.cmi contrib/rtauto/proof_search.cmi -contrib/rtauto/proof_search.cmx: library/goptions.cmx lib/pp.cmx \ - kernel/term.cmx lib/util.cmx contrib/rtauto/proof_search.cmi -contrib/rtauto/refl_tauto.cmo: kernel/closure.cmi interp/coqlib.cmi \ - kernel/environ.cmi pretyping/evd.cmi lib/explore.cmi library/goptions.cmi \ - kernel/names.cmi lib/pp.cmi contrib/rtauto/proof_search.cmi \ - pretyping/retyping.cmi lib/system.cmi tactics/tacinterp.cmi \ - proofs/tacmach.cmi proofs/tactic_debug.cmi tactics/tactics.cmi \ - kernel/term.cmi pretyping/termops.cmi lib/util.cmi \ +contrib/omega/coq_omega.cmo: lib/util.cmi pretyping/termops.cmi \ + kernel/term.cmi tactics/tactics.cmi tactics/tacticals.cmi \ + pretyping/tacred.cmi proofs/tacmach.cmi kernel/sign.cmi \ + kernel/reduction.cmi pretyping/rawterm.cmi proofs/proof_type.cmi \ + parsing/printer.cmi lib/pp.cmi contrib/omega/omega.cmo \ + library/nametab.cmi kernel/names.cmi library/nameops.cmi proofs/logic.cmi \ + library/libnames.cmi kernel/inductive.cmi library/goptions.cmi \ + library/global.cmi pretyping/evarutil.cmi proofs/evar_refiner.cmi \ + tactics/equality.cmi kernel/environ.cmi kernel/declarations.cmi \ + interp/coqlib.cmi tactics/contradiction.cmi kernel/closure.cmi \ + pretyping/clenv.cmi lib/bigint.cmi +contrib/omega/coq_omega.cmx: lib/util.cmx pretyping/termops.cmx \ + kernel/term.cmx tactics/tactics.cmx tactics/tacticals.cmx \ + pretyping/tacred.cmx proofs/tacmach.cmx kernel/sign.cmx \ + kernel/reduction.cmx pretyping/rawterm.cmx proofs/proof_type.cmx \ + parsing/printer.cmx lib/pp.cmx contrib/omega/omega.cmx \ + library/nametab.cmx kernel/names.cmx library/nameops.cmx proofs/logic.cmx \ + library/libnames.cmx kernel/inductive.cmx library/goptions.cmx \ + library/global.cmx pretyping/evarutil.cmx proofs/evar_refiner.cmx \ + tactics/equality.cmx kernel/environ.cmx kernel/declarations.cmx \ + interp/coqlib.cmx tactics/contradiction.cmx kernel/closure.cmx \ + pretyping/clenv.cmx lib/bigint.cmx +contrib/omega/g_omega.cmo: lib/util.cmi tactics/tacinterp.cmi \ + proofs/tacexpr.cmo proofs/refiner.cmi parsing/pptactic.cmi lib/pp.cmi \ + parsing/pcoq.cmi parsing/egrammar.cmi contrib/omega/coq_omega.cmo \ + toplevel/cerrors.cmi +contrib/omega/g_omega.cmx: lib/util.cmx tactics/tacinterp.cmx \ + proofs/tacexpr.cmx proofs/refiner.cmx parsing/pptactic.cmx lib/pp.cmx \ + parsing/pcoq.cmx parsing/egrammar.cmx contrib/omega/coq_omega.cmx \ + toplevel/cerrors.cmx +contrib/omega/omega.cmo: lib/util.cmi kernel/names.cmi +contrib/omega/omega.cmx: lib/util.cmx kernel/names.cmx +contrib/recdef/recdef.cmo: toplevel/vernacinterp.cmi \ + toplevel/vernacentries.cmi lib/util.cmi pretyping/typing.cmi \ + interp/topconstr.cmi pretyping/termops.cmi kernel/term.cmi \ + tactics/tactics.cmi tactics/tacticals.cmi proofs/tactic_debug.cmi \ + pretyping/tacred.cmi proofs/tacmach.cmi tactics/tacinterp.cmi \ + kernel/safe_typing.cmi pretyping/rawterm.cmi proofs/proof_type.cmi \ + parsing/printer.cmi pretyping/pretyping.cmi parsing/ppconstr.cmi \ + lib/pp.cmi proofs/pfedit.cmi parsing/pcoq.cmi lib/options.cmi \ + library/nametab.cmi kernel/names.cmi library/nameops.cmi \ + library/libnames.cmi library/lib.cmi tactics/hiddentac.cmi \ + library/global.cmi interp/genarg.cmi pretyping/evd.cmi \ + tactics/equality.cmi kernel/environ.cmi kernel/entries.cmi \ + tactics/elim.cmi parsing/egrammar.cmi tactics/eauto.cmi \ + library/declare.cmi kernel/declarations.cmi library/decl_kinds.cmo \ + interp/coqlib.cmi interp/constrintern.cmi toplevel/command.cmi \ + kernel/closure.cmi toplevel/cerrors.cmi tactics/auto.cmi +contrib/recdef/recdef.cmx: toplevel/vernacinterp.cmx \ + toplevel/vernacentries.cmx lib/util.cmx pretyping/typing.cmx \ + interp/topconstr.cmx pretyping/termops.cmx kernel/term.cmx \ + tactics/tactics.cmx tactics/tacticals.cmx proofs/tactic_debug.cmx \ + pretyping/tacred.cmx proofs/tacmach.cmx tactics/tacinterp.cmx \ + kernel/safe_typing.cmx pretyping/rawterm.cmx proofs/proof_type.cmx \ + parsing/printer.cmx pretyping/pretyping.cmx parsing/ppconstr.cmx \ + lib/pp.cmx proofs/pfedit.cmx parsing/pcoq.cmx lib/options.cmx \ + library/nametab.cmx kernel/names.cmx library/nameops.cmx \ + library/libnames.cmx library/lib.cmx tactics/hiddentac.cmx \ + library/global.cmx interp/genarg.cmx pretyping/evd.cmx \ + tactics/equality.cmx kernel/environ.cmx kernel/entries.cmx \ + tactics/elim.cmx parsing/egrammar.cmx tactics/eauto.cmx \ + library/declare.cmx kernel/declarations.cmx library/decl_kinds.cmx \ + interp/coqlib.cmx interp/constrintern.cmx toplevel/command.cmx \ + kernel/closure.cmx toplevel/cerrors.cmx tactics/auto.cmx +contrib/ring/g_quote.cmo: lib/util.cmi tactics/tacinterp.cmi \ + proofs/tacexpr.cmo proofs/refiner.cmi contrib/ring/quote.cmo \ + parsing/pptactic.cmi lib/pp.cmi parsing/pcoq.cmi interp/genarg.cmi \ + parsing/egrammar.cmi toplevel/cerrors.cmi +contrib/ring/g_quote.cmx: lib/util.cmx tactics/tacinterp.cmx \ + proofs/tacexpr.cmx proofs/refiner.cmx contrib/ring/quote.cmx \ + parsing/pptactic.cmx lib/pp.cmx parsing/pcoq.cmx interp/genarg.cmx \ + parsing/egrammar.cmx toplevel/cerrors.cmx +contrib/ring/g_ring.cmo: toplevel/vernacinterp.cmi lib/util.cmi \ + tactics/tacinterp.cmi proofs/tacexpr.cmo contrib/ring/ring.cmo \ + proofs/refiner.cmi contrib/ring/quote.cmo parsing/pptactic.cmi lib/pp.cmi \ + parsing/pcoq.cmi interp/genarg.cmi parsing/egrammar.cmi \ + toplevel/cerrors.cmi +contrib/ring/g_ring.cmx: toplevel/vernacinterp.cmx lib/util.cmx \ + tactics/tacinterp.cmx proofs/tacexpr.cmx contrib/ring/ring.cmx \ + proofs/refiner.cmx contrib/ring/quote.cmx parsing/pptactic.cmx lib/pp.cmx \ + parsing/pcoq.cmx interp/genarg.cmx parsing/egrammar.cmx \ + toplevel/cerrors.cmx +contrib/ring/quote.cmo: lib/util.cmi pretyping/termops.cmi kernel/term.cmi \ + tactics/tactics.cmi proofs/tacmach.cmi proofs/tacexpr.cmo \ + proofs/proof_trees.cmi lib/pp.cmi pretyping/pattern.cmi kernel/names.cmi \ + pretyping/matching.cmi library/global.cmi kernel/environ.cmi \ + interp/coqlib.cmi +contrib/ring/quote.cmx: lib/util.cmx pretyping/termops.cmx kernel/term.cmx \ + tactics/tactics.cmx proofs/tacmach.cmx proofs/tacexpr.cmx \ + proofs/proof_trees.cmx lib/pp.cmx pretyping/pattern.cmx kernel/names.cmx \ + pretyping/matching.cmx library/global.cmx kernel/environ.cmx \ + interp/coqlib.cmx +contrib/ring/ring.cmo: toplevel/vernacinterp.cmi toplevel/vernacexpr.cmo \ + lib/util.cmi pretyping/typing.cmi kernel/term.cmi tactics/tactics.cmi \ + tactics/tacticals.cmi pretyping/tacred.cmi proofs/tacmach.cmi \ + proofs/tacexpr.cmo library/summary.cmi tactics/setoid_replace.cmi \ + pretyping/reductionops.cmi contrib/ring/quote.cmo proofs/proof_trees.cmi \ + parsing/printer.cmi lib/pp.cmi pretyping/pattern.cmi lib/options.cmi \ + library/nametab.cmi kernel/names.cmi library/nameops.cmi \ + kernel/mod_subst.cmi library/libobject.cmi library/libnames.cmi \ + library/lib.cmi tactics/hipattern.cmi tactics/hiddentac.cmi \ + library/global.cmi pretyping/evd.cmi tactics/equality.cmi \ + interp/coqlib.cmi interp/constrintern.cmi kernel/closure.cmi +contrib/ring/ring.cmx: toplevel/vernacinterp.cmx toplevel/vernacexpr.cmx \ + lib/util.cmx pretyping/typing.cmx kernel/term.cmx tactics/tactics.cmx \ + tactics/tacticals.cmx pretyping/tacred.cmx proofs/tacmach.cmx \ + proofs/tacexpr.cmx library/summary.cmx tactics/setoid_replace.cmx \ + pretyping/reductionops.cmx contrib/ring/quote.cmx proofs/proof_trees.cmx \ + parsing/printer.cmx lib/pp.cmx pretyping/pattern.cmx lib/options.cmx \ + library/nametab.cmx kernel/names.cmx library/nameops.cmx \ + kernel/mod_subst.cmx library/libobject.cmx library/libnames.cmx \ + library/lib.cmx tactics/hipattern.cmx tactics/hiddentac.cmx \ + library/global.cmx pretyping/evd.cmx tactics/equality.cmx \ + interp/coqlib.cmx interp/constrintern.cmx kernel/closure.cmx +contrib/romega/const_omega.cmo: lib/util.cmi kernel/term.cmi \ + library/nametab.cmi kernel/names.cmi library/libnames.cmi \ + interp/coqlib.cmi lib/bigint.cmi +contrib/romega/const_omega.cmx: lib/util.cmx kernel/term.cmx \ + library/nametab.cmx kernel/names.cmx library/libnames.cmx \ + interp/coqlib.cmx lib/bigint.cmx +contrib/romega/g_romega.cmo: lib/util.cmi tactics/tacinterp.cmi \ + proofs/tacexpr.cmo contrib/romega/refl_omega.cmo proofs/refiner.cmi \ + parsing/pptactic.cmi lib/pp.cmi parsing/pcoq.cmi parsing/egrammar.cmi \ + toplevel/cerrors.cmi +contrib/romega/g_romega.cmx: lib/util.cmx tactics/tacinterp.cmx \ + proofs/tacexpr.cmx contrib/romega/refl_omega.cmx proofs/refiner.cmx \ + parsing/pptactic.cmx lib/pp.cmx parsing/pcoq.cmx parsing/egrammar.cmx \ + toplevel/cerrors.cmx +contrib/romega/refl_omega.cmo: lib/util.cmi kernel/term.cmi \ + tactics/tactics.cmi tactics/tacticals.cmi proofs/tacmach.cmi \ + parsing/printer.cmi lib/pp.cmi contrib/omega/omega.cmo kernel/names.cmi \ + proofs/logic.cmi interp/coqlib.cmi contrib/romega/const_omega.cmo \ + lib/bigint.cmi +contrib/romega/refl_omega.cmx: lib/util.cmx kernel/term.cmx \ + tactics/tactics.cmx tactics/tacticals.cmx proofs/tacmach.cmx \ + parsing/printer.cmx lib/pp.cmx contrib/omega/omega.cmx kernel/names.cmx \ + proofs/logic.cmx interp/coqlib.cmx contrib/romega/const_omega.cmx \ + lib/bigint.cmx +contrib/rtauto/g_rtauto.cmo: lib/util.cmi tactics/tacinterp.cmi \ + proofs/tacexpr.cmo contrib/rtauto/refl_tauto.cmi proofs/refiner.cmi \ + parsing/pptactic.cmi lib/pp.cmi parsing/pcoq.cmi parsing/egrammar.cmi \ + toplevel/cerrors.cmi +contrib/rtauto/g_rtauto.cmx: lib/util.cmx tactics/tacinterp.cmx \ + proofs/tacexpr.cmx contrib/rtauto/refl_tauto.cmx proofs/refiner.cmx \ + parsing/pptactic.cmx lib/pp.cmx parsing/pcoq.cmx parsing/egrammar.cmx \ + toplevel/cerrors.cmx +contrib/rtauto/proof_search.cmo: lib/util.cmi kernel/term.cmi lib/pp.cmi \ + library/goptions.cmi contrib/rtauto/proof_search.cmi +contrib/rtauto/proof_search.cmx: lib/util.cmx kernel/term.cmx lib/pp.cmx \ + library/goptions.cmx contrib/rtauto/proof_search.cmi +contrib/rtauto/refl_tauto.cmo: lib/util.cmi pretyping/termops.cmi \ + kernel/term.cmi tactics/tactics.cmi proofs/tactic_debug.cmi \ + proofs/tacmach.cmi tactics/tacinterp.cmi lib/system.cmi \ + pretyping/retyping.cmi contrib/rtauto/proof_search.cmi lib/pp.cmi \ + kernel/names.cmi library/goptions.cmi lib/explore.cmi pretyping/evd.cmi \ + kernel/environ.cmi interp/coqlib.cmi kernel/closure.cmi \ contrib/rtauto/refl_tauto.cmi -contrib/rtauto/refl_tauto.cmx: kernel/closure.cmx interp/coqlib.cmx \ - kernel/environ.cmx pretyping/evd.cmx lib/explore.cmx library/goptions.cmx \ - kernel/names.cmx lib/pp.cmx contrib/rtauto/proof_search.cmx \ - pretyping/retyping.cmx lib/system.cmx tactics/tacinterp.cmx \ - proofs/tacmach.cmx proofs/tactic_debug.cmx tactics/tactics.cmx \ - kernel/term.cmx pretyping/termops.cmx lib/util.cmx \ +contrib/rtauto/refl_tauto.cmx: lib/util.cmx pretyping/termops.cmx \ + kernel/term.cmx tactics/tactics.cmx proofs/tactic_debug.cmx \ + proofs/tacmach.cmx tactics/tacinterp.cmx lib/system.cmx \ + pretyping/retyping.cmx contrib/rtauto/proof_search.cmx lib/pp.cmx \ + kernel/names.cmx library/goptions.cmx lib/explore.cmx pretyping/evd.cmx \ + kernel/environ.cmx interp/coqlib.cmx kernel/closure.cmx \ contrib/rtauto/refl_tauto.cmi -contrib/setoid_ring/newring.cmo: toplevel/cerrors.cmi kernel/closure.cmi \ - interp/constrintern.cmi interp/coqlib.cmi parsing/egrammar.cmi \ - kernel/environ.cmi kernel/esubst.cmi pretyping/evd.cmi interp/genarg.cmi \ - library/global.cmi parsing/lexer.cmi library/lib.cmi \ - library/libobject.cmi kernel/mod_subst.cmi kernel/names.cmi \ - parsing/pcoq.cmi lib/pp.cmi parsing/ppconstr.cmi parsing/pptactic.cmi \ - pretyping/pretyping.cmi parsing/printer.cmi proofs/proof_type.cmi \ - pretyping/rawterm.cmi proofs/refiner.cmi pretyping/retyping.cmi \ - tactics/setoid_replace.cmi library/summary.cmi proofs/tacexpr.cmo \ - tactics/tacinterp.cmi proofs/tacmach.cmi tactics/tacticals.cmi \ - tactics/tactics.cmi kernel/term.cmi pretyping/typing.cmi lib/util.cmi \ - toplevel/vernacinterp.cmi -contrib/setoid_ring/newring.cmx: toplevel/cerrors.cmx kernel/closure.cmx \ - interp/constrintern.cmx interp/coqlib.cmx parsing/egrammar.cmx \ - kernel/environ.cmx kernel/esubst.cmx pretyping/evd.cmx interp/genarg.cmx \ - library/global.cmx parsing/lexer.cmx library/lib.cmx \ - library/libobject.cmx kernel/mod_subst.cmx kernel/names.cmx \ - parsing/pcoq.cmx lib/pp.cmx parsing/ppconstr.cmx parsing/pptactic.cmx \ - pretyping/pretyping.cmx parsing/printer.cmx proofs/proof_type.cmx \ - pretyping/rawterm.cmx proofs/refiner.cmx pretyping/retyping.cmx \ - tactics/setoid_replace.cmx library/summary.cmx proofs/tacexpr.cmx \ - tactics/tacinterp.cmx proofs/tacmach.cmx tactics/tacticals.cmx \ - tactics/tactics.cmx kernel/term.cmx pretyping/typing.cmx lib/util.cmx \ - toplevel/vernacinterp.cmx -contrib/subtac/context.cmo: kernel/names.cmi kernel/term.cmi \ +contrib/setoid_ring/newring.cmo: toplevel/vernacinterp.cmi lib/util.cmi \ + pretyping/typing.cmi kernel/term.cmi tactics/tactics.cmi \ + tactics/tacticals.cmi proofs/tacmach.cmi tactics/tacinterp.cmi \ + proofs/tacexpr.cmo library/summary.cmi tactics/setoid_replace.cmi \ + pretyping/retyping.cmi proofs/refiner.cmi pretyping/rawterm.cmi \ + proofs/proof_type.cmi parsing/printer.cmi pretyping/pretyping.cmi \ + parsing/pptactic.cmi parsing/ppconstr.cmi lib/pp.cmi parsing/pcoq.cmi \ + kernel/names.cmi kernel/mod_subst.cmi library/libobject.cmi \ + library/lib.cmi parsing/lexer.cmi library/global.cmi interp/genarg.cmi \ + pretyping/evd.cmi kernel/esubst.cmi kernel/environ.cmi \ + parsing/egrammar.cmi interp/coqlib.cmi interp/constrintern.cmi \ + kernel/closure.cmi toplevel/cerrors.cmi +contrib/setoid_ring/newring.cmx: toplevel/vernacinterp.cmx lib/util.cmx \ + pretyping/typing.cmx kernel/term.cmx tactics/tactics.cmx \ + tactics/tacticals.cmx proofs/tacmach.cmx tactics/tacinterp.cmx \ + proofs/tacexpr.cmx library/summary.cmx tactics/setoid_replace.cmx \ + pretyping/retyping.cmx proofs/refiner.cmx pretyping/rawterm.cmx \ + proofs/proof_type.cmx parsing/printer.cmx pretyping/pretyping.cmx \ + parsing/pptactic.cmx parsing/ppconstr.cmx lib/pp.cmx parsing/pcoq.cmx \ + kernel/names.cmx kernel/mod_subst.cmx library/libobject.cmx \ + library/lib.cmx parsing/lexer.cmx library/global.cmx interp/genarg.cmx \ + pretyping/evd.cmx kernel/esubst.cmx kernel/environ.cmx \ + parsing/egrammar.cmx interp/coqlib.cmx interp/constrintern.cmx \ + kernel/closure.cmx toplevel/cerrors.cmx +contrib/subtac/context.cmo: kernel/term.cmi kernel/names.cmi \ contrib/subtac/context.cmi -contrib/subtac/context.cmx: kernel/names.cmx kernel/term.cmx \ +contrib/subtac/context.cmx: kernel/term.cmx kernel/names.cmx \ contrib/subtac/context.cmi -contrib/subtac/eterm.cmo: library/decl_kinds.cmo library/declare.cmi \ - kernel/environ.cmi pretyping/evarutil.cmi pretyping/evd.cmi \ - library/global.cmi kernel/names.cmi lib/pp.cmi proofs/tacmach.cmi \ - tactics/tacticals.cmi tactics/tactics.cmi kernel/term.cmi \ - pretyping/termops.cmi contrib/subtac/eterm.cmi -contrib/subtac/eterm.cmx: library/decl_kinds.cmx library/declare.cmx \ - kernel/environ.cmx pretyping/evarutil.cmx pretyping/evd.cmx \ - library/global.cmx kernel/names.cmx lib/pp.cmx proofs/tacmach.cmx \ - tactics/tacticals.cmx tactics/tactics.cmx kernel/term.cmx \ - pretyping/termops.cmx contrib/subtac/eterm.cmi -contrib/subtac/g_eterm.cmo: toplevel/cerrors.cmi parsing/egrammar.cmi \ - contrib/subtac/eterm.cmi parsing/pcoq.cmi lib/pp.cmi parsing/pptactic.cmi \ - proofs/refiner.cmi proofs/tacexpr.cmo tactics/tacinterp.cmi \ - proofs/tacmach.cmi lib/util.cmi -contrib/subtac/g_eterm.cmx: toplevel/cerrors.cmx parsing/egrammar.cmx \ - contrib/subtac/eterm.cmx parsing/pcoq.cmx lib/pp.cmx parsing/pptactic.cmx \ - proofs/refiner.cmx proofs/tacexpr.cmx tactics/tacinterp.cmx \ - proofs/tacmach.cmx lib/util.cmx -contrib/subtac/g_subtac.cmo: toplevel/cerrors.cmi parsing/egrammar.cmi \ - interp/genarg.cmi library/libnames.cmi library/nameops.cmi \ - kernel/names.cmi lib/options.cmi parsing/pcoq.cmi lib/pp.cmi \ - kernel/reduction.cmi contrib/subtac/subtac.cmi proofs/tacexpr.cmo \ - kernel/term.cmi interp/topconstr.cmi lib/util.cmi \ - toplevel/vernacentries.cmi toplevel/vernacexpr.cmo \ - toplevel/vernacinterp.cmi -contrib/subtac/g_subtac.cmx: toplevel/cerrors.cmx parsing/egrammar.cmx \ - interp/genarg.cmx library/libnames.cmx library/nameops.cmx \ - kernel/names.cmx lib/options.cmx parsing/pcoq.cmx lib/pp.cmx \ - kernel/reduction.cmx contrib/subtac/subtac.cmx proofs/tacexpr.cmx \ - kernel/term.cmx interp/topconstr.cmx lib/util.cmx \ - toplevel/vernacentries.cmx toplevel/vernacexpr.cmx \ - toplevel/vernacinterp.cmx -contrib/subtac/subtac_coercion.cmo: pretyping/classops.cmi \ - contrib/subtac/context.cmi interp/coqlib.cmi kernel/environ.cmi \ - contrib/subtac/eterm.cmi pretyping/evarconv.cmi pretyping/evarutil.cmi \ - pretyping/evd.cmi library/global.cmi kernel/names.cmi lib/pp.cmi \ - pretyping/pretype_errors.cmi parsing/printer.cmi pretyping/rawterm.cmi \ - pretyping/recordops.cmi kernel/reduction.cmi pretyping/reductionops.cmi \ - pretyping/retyping.cmi contrib/subtac/subtac_errors.cmi \ - contrib/subtac/subtac_utils.cmi kernel/term.cmi kernel/typeops.cmi \ - lib/util.cmi contrib/subtac/subtac_coercion.cmi -contrib/subtac/subtac_coercion.cmx: pretyping/classops.cmx \ - contrib/subtac/context.cmx interp/coqlib.cmx kernel/environ.cmx \ - contrib/subtac/eterm.cmx pretyping/evarconv.cmx pretyping/evarutil.cmx \ - pretyping/evd.cmx library/global.cmx kernel/names.cmx lib/pp.cmx \ - pretyping/pretype_errors.cmx parsing/printer.cmx pretyping/rawterm.cmx \ - pretyping/recordops.cmx kernel/reduction.cmx pretyping/reductionops.cmx \ - pretyping/retyping.cmx contrib/subtac/subtac_errors.cmx \ - contrib/subtac/subtac_utils.cmx kernel/term.cmx kernel/typeops.cmx \ - lib/util.cmx contrib/subtac/subtac_coercion.cmi -contrib/subtac/subtac_command.cmo: kernel/closure.cmi toplevel/command.cmi \ - interp/constrintern.cmi library/decl_kinds.cmo kernel/declarations.cmi \ - library/declare.cmi lib/dyn.cmi kernel/entries.cmi kernel/environ.cmi \ - contrib/subtac/eterm.cmi pretyping/evd.cmi interp/genarg.cmi \ - library/global.cmi tactics/hiddentac.cmi library/impargs.cmi \ - pretyping/inductiveops.cmi library/libnames.cmi library/libobject.cmi \ - pretyping/matching.cmi toplevel/metasyntax.cmi kernel/mod_subst.cmi \ - library/nameops.cmi kernel/names.cmi library/nametab.cmi \ - interp/notation.cmi lib/options.cmi pretyping/pattern.cmi \ - proofs/pfedit.cmi lib/pp.cmi pretyping/pretyping.cmi parsing/printer.cmi \ - proofs/proof_type.cmi pretyping/rawterm.cmi proofs/refiner.cmi \ - kernel/safe_typing.cmi kernel/sign.cmi library/states.cmi \ - contrib/subtac/subtac_interp_fixpoint.cmi \ - contrib/subtac/subtac_pretyping.cmi contrib/subtac/subtac_utils.cmi \ - interp/syntax_def.cmi proofs/tacexpr.cmo tactics/tacinterp.cmi \ - proofs/tacmach.cmi pretyping/tacred.cmi proofs/tactic_debug.cmi \ - kernel/term.cmi pretyping/termops.cmi interp/topconstr.cmi \ - pretyping/typing.cmi lib/util.cmi toplevel/vernacexpr.cmo \ - contrib/subtac/subtac_command.cmi -contrib/subtac/subtac_command.cmx: kernel/closure.cmx toplevel/command.cmx \ - interp/constrintern.cmx library/decl_kinds.cmx kernel/declarations.cmx \ - library/declare.cmx lib/dyn.cmx kernel/entries.cmx kernel/environ.cmx \ - contrib/subtac/eterm.cmx pretyping/evd.cmx interp/genarg.cmx \ - library/global.cmx tactics/hiddentac.cmx library/impargs.cmx \ - pretyping/inductiveops.cmx library/libnames.cmx library/libobject.cmx \ - pretyping/matching.cmx toplevel/metasyntax.cmx kernel/mod_subst.cmx \ - library/nameops.cmx kernel/names.cmx library/nametab.cmx \ - interp/notation.cmx lib/options.cmx pretyping/pattern.cmx \ - proofs/pfedit.cmx lib/pp.cmx pretyping/pretyping.cmx parsing/printer.cmx \ - proofs/proof_type.cmx pretyping/rawterm.cmx proofs/refiner.cmx \ - kernel/safe_typing.cmx kernel/sign.cmx library/states.cmx \ - contrib/subtac/subtac_interp_fixpoint.cmx \ - contrib/subtac/subtac_pretyping.cmx contrib/subtac/subtac_utils.cmx \ - interp/syntax_def.cmx proofs/tacexpr.cmx tactics/tacinterp.cmx \ - proofs/tacmach.cmx pretyping/tacred.cmx proofs/tactic_debug.cmx \ - kernel/term.cmx pretyping/termops.cmx interp/topconstr.cmx \ - pretyping/typing.cmx lib/util.cmx toplevel/vernacexpr.cmx \ - contrib/subtac/subtac_command.cmi -contrib/subtac/subtac_errors.cmo: lib/pp.cmi parsing/printer.cmi lib/util.cmi \ +contrib/subtac/eterm.cmo: lib/util.cmi pretyping/termops.cmi kernel/term.cmi \ + tactics/tactics.cmi tactics/tacticals.cmi proofs/tacmach.cmi lib/pp.cmi \ + lib/options.cmi kernel/names.cmi library/global.cmi pretyping/evd.cmi \ + pretyping/evarutil.cmi kernel/environ.cmi library/declare.cmi \ + library/decl_kinds.cmo contrib/subtac/eterm.cmi +contrib/subtac/eterm.cmx: lib/util.cmx pretyping/termops.cmx kernel/term.cmx \ + tactics/tactics.cmx tactics/tacticals.cmx proofs/tacmach.cmx lib/pp.cmx \ + lib/options.cmx kernel/names.cmx library/global.cmx pretyping/evd.cmx \ + pretyping/evarutil.cmx kernel/environ.cmx library/declare.cmx \ + library/decl_kinds.cmx contrib/subtac/eterm.cmi +contrib/subtac/g_eterm.cmo: lib/util.cmi proofs/tacmach.cmi \ + tactics/tacinterp.cmi proofs/tacexpr.cmo proofs/refiner.cmi \ + parsing/pptactic.cmi lib/pp.cmi parsing/pcoq.cmi contrib/subtac/eterm.cmi \ + parsing/egrammar.cmi toplevel/cerrors.cmi +contrib/subtac/g_eterm.cmx: lib/util.cmx proofs/tacmach.cmx \ + tactics/tacinterp.cmx proofs/tacexpr.cmx proofs/refiner.cmx \ + parsing/pptactic.cmx lib/pp.cmx parsing/pcoq.cmx contrib/subtac/eterm.cmx \ + parsing/egrammar.cmx toplevel/cerrors.cmx +contrib/subtac/g_subtac.cmo: toplevel/vernacinterp.cmi \ + toplevel/vernacexpr.cmo toplevel/vernacentries.cmi lib/util.cmi \ + interp/topconstr.cmi kernel/term.cmi proofs/tacexpr.cmo \ + contrib/subtac/subtac.cmi kernel/reduction.cmi proofs/proof_type.cmi \ + lib/pp.cmi parsing/pcoq.cmi lib/options.cmi kernel/names.cmi \ + library/nameops.cmi library/libnames.cmi interp/genarg.cmi \ + parsing/egrammar.cmi toplevel/cerrors.cmi +contrib/subtac/g_subtac.cmx: toplevel/vernacinterp.cmx \ + toplevel/vernacexpr.cmx toplevel/vernacentries.cmx lib/util.cmx \ + interp/topconstr.cmx kernel/term.cmx proofs/tacexpr.cmx \ + contrib/subtac/subtac.cmx kernel/reduction.cmx proofs/proof_type.cmx \ + lib/pp.cmx parsing/pcoq.cmx lib/options.cmx kernel/names.cmx \ + library/nameops.cmx library/libnames.cmx interp/genarg.cmx \ + parsing/egrammar.cmx toplevel/cerrors.cmx +contrib/subtac/subtac_coercion.cmo: lib/util.cmi kernel/typeops.cmi \ + pretyping/termops.cmi kernel/term.cmi contrib/subtac/subtac_utils.cmi \ + contrib/subtac/subtac_errors.cmi pretyping/retyping.cmi \ + pretyping/reductionops.cmi kernel/reduction.cmi pretyping/recordops.cmi \ + pretyping/rawterm.cmi parsing/printer.cmi pretyping/pretype_errors.cmi \ + lib/pp.cmi kernel/names.cmi library/global.cmi pretyping/evd.cmi \ + pretyping/evarutil.cmi pretyping/evarconv.cmi contrib/subtac/eterm.cmi \ + kernel/environ.cmi interp/coqlib.cmi contrib/subtac/context.cmi \ + pretyping/classops.cmi contrib/subtac/subtac_coercion.cmi +contrib/subtac/subtac_coercion.cmx: lib/util.cmx kernel/typeops.cmx \ + pretyping/termops.cmx kernel/term.cmx contrib/subtac/subtac_utils.cmx \ + contrib/subtac/subtac_errors.cmx pretyping/retyping.cmx \ + pretyping/reductionops.cmx kernel/reduction.cmx pretyping/recordops.cmx \ + pretyping/rawterm.cmx parsing/printer.cmx pretyping/pretype_errors.cmx \ + lib/pp.cmx kernel/names.cmx library/global.cmx pretyping/evd.cmx \ + pretyping/evarutil.cmx pretyping/evarconv.cmx contrib/subtac/eterm.cmx \ + kernel/environ.cmx interp/coqlib.cmx contrib/subtac/context.cmx \ + pretyping/classops.cmx contrib/subtac/subtac_coercion.cmi +contrib/subtac/subtac_command.cmo: toplevel/vernacexpr.cmo lib/util.cmi \ + pretyping/typing.cmi interp/topconstr.cmi pretyping/termops.cmi \ + kernel/term.cmi tactics/tactics.cmi tactics/tacticals.cmi \ + proofs/tactic_debug.cmi pretyping/tacred.cmi proofs/tacmach.cmi \ + tactics/tacinterp.cmi proofs/tacexpr.cmo interp/syntax_def.cmi \ + contrib/subtac/subtac_utils.cmi contrib/subtac/subtac_pretyping.cmi \ + library/states.cmi kernel/sign.cmi kernel/safe_typing.cmi \ + interp/reserve.cmi proofs/refiner.cmi pretyping/reductionops.cmi \ + pretyping/rawterm.cmi proofs/proof_type.cmi parsing/printer.cmi \ + pretyping/pretyping.cmi parsing/ppconstr.cmi lib/pp.cmi proofs/pfedit.cmi \ + pretyping/pattern.cmi lib/options.cmi interp/notation.cmi \ + library/nametab.cmi kernel/names.cmi library/nameops.cmi \ + kernel/mod_subst.cmi toplevel/metasyntax.cmi pretyping/matching.cmi \ + library/libobject.cmi library/libnames.cmi pretyping/inductiveops.cmi \ + library/impargs.cmi tactics/hiddentac.cmi library/global.cmi \ + interp/genarg.cmi pretyping/evd.cmi pretyping/evarutil.cmi \ + contrib/subtac/eterm.cmi kernel/environ.cmi kernel/entries.cmi \ + lib/dyn.cmi library/declare.cmi kernel/declarations.cmi \ + library/decl_kinds.cmo interp/constrintern.cmi toplevel/command.cmi \ + kernel/closure.cmi contrib/subtac/subtac_command.cmi +contrib/subtac/subtac_command.cmx: toplevel/vernacexpr.cmx lib/util.cmx \ + pretyping/typing.cmx interp/topconstr.cmx pretyping/termops.cmx \ + kernel/term.cmx tactics/tactics.cmx tactics/tacticals.cmx \ + proofs/tactic_debug.cmx pretyping/tacred.cmx proofs/tacmach.cmx \ + tactics/tacinterp.cmx proofs/tacexpr.cmx interp/syntax_def.cmx \ + contrib/subtac/subtac_utils.cmx contrib/subtac/subtac_pretyping.cmx \ + library/states.cmx kernel/sign.cmx kernel/safe_typing.cmx \ + interp/reserve.cmx proofs/refiner.cmx pretyping/reductionops.cmx \ + pretyping/rawterm.cmx proofs/proof_type.cmx parsing/printer.cmx \ + pretyping/pretyping.cmx parsing/ppconstr.cmx lib/pp.cmx proofs/pfedit.cmx \ + pretyping/pattern.cmx lib/options.cmx interp/notation.cmx \ + library/nametab.cmx kernel/names.cmx library/nameops.cmx \ + kernel/mod_subst.cmx toplevel/metasyntax.cmx pretyping/matching.cmx \ + library/libobject.cmx library/libnames.cmx pretyping/inductiveops.cmx \ + library/impargs.cmx tactics/hiddentac.cmx library/global.cmx \ + interp/genarg.cmx pretyping/evd.cmx pretyping/evarutil.cmx \ + contrib/subtac/eterm.cmx kernel/environ.cmx kernel/entries.cmx \ + lib/dyn.cmx library/declare.cmx kernel/declarations.cmx \ + library/decl_kinds.cmx interp/constrintern.cmx toplevel/command.cmx \ + kernel/closure.cmx contrib/subtac/subtac_command.cmi +contrib/subtac/subtac_errors.cmo: lib/util.cmi parsing/printer.cmi lib/pp.cmi \ contrib/subtac/subtac_errors.cmi -contrib/subtac/subtac_errors.cmx: lib/pp.cmx parsing/printer.cmx lib/util.cmx \ +contrib/subtac/subtac_errors.cmx: lib/util.cmx parsing/printer.cmx lib/pp.cmx \ contrib/subtac/subtac_errors.cmi -contrib/subtac/subtac_interp_fixpoint.cmo: pretyping/classops.cmi \ - contrib/subtac/context.cmi interp/coqlib.cmi lib/dyn.cmi \ - kernel/environ.cmi contrib/subtac/eterm.cmi pretyping/evarconv.cmi \ - pretyping/evarutil.cmi pretyping/evd.cmi library/global.cmi \ - library/libnames.cmi library/nameops.cmi kernel/names.cmi \ - pretyping/pattern.cmi lib/pp.cmi parsing/ppconstr.cmi \ - pretyping/pretype_errors.cmi parsing/printer.cmi pretyping/rawterm.cmi \ - pretyping/recordops.cmi pretyping/reductionops.cmi kernel/sign.cmi \ - contrib/subtac/subtac_coercion.cmi contrib/subtac/subtac_errors.cmi \ - contrib/subtac/subtac_utils.cmi kernel/term.cmi pretyping/termops.cmi \ - interp/topconstr.cmi kernel/type_errors.cmi kernel/typeops.cmi \ - lib/util.cmi contrib/subtac/subtac_interp_fixpoint.cmi -contrib/subtac/subtac_interp_fixpoint.cmx: pretyping/classops.cmx \ - contrib/subtac/context.cmx interp/coqlib.cmx lib/dyn.cmx \ - kernel/environ.cmx contrib/subtac/eterm.cmx pretyping/evarconv.cmx \ - pretyping/evarutil.cmx pretyping/evd.cmx library/global.cmx \ - library/libnames.cmx library/nameops.cmx kernel/names.cmx \ - pretyping/pattern.cmx lib/pp.cmx parsing/ppconstr.cmx \ - pretyping/pretype_errors.cmx parsing/printer.cmx pretyping/rawterm.cmx \ - pretyping/recordops.cmx pretyping/reductionops.cmx kernel/sign.cmx \ - contrib/subtac/subtac_coercion.cmx contrib/subtac/subtac_errors.cmx \ - contrib/subtac/subtac_utils.cmx kernel/term.cmx pretyping/termops.cmx \ - interp/topconstr.cmx kernel/type_errors.cmx kernel/typeops.cmx \ - lib/util.cmx contrib/subtac/subtac_interp_fixpoint.cmi -contrib/subtac/subtac.cmo: toplevel/cerrors.cmi pretyping/classops.cmi \ - toplevel/command.cmi contrib/subtac/context.cmi interp/coqlib.cmi \ - lib/dyn.cmi kernel/environ.cmi contrib/subtac/eterm.cmi \ - pretyping/evarconv.cmi pretyping/evarutil.cmi pretyping/evd.cmi \ - library/global.cmi toplevel/himsg.cmi library/libnames.cmi \ - library/library.cmi kernel/names.cmi pretyping/pattern.cmi \ - proofs/pfedit.cmi lib/pp.cmi parsing/ppconstr.cmi \ - pretyping/pretype_errors.cmi parsing/printer.cmi pretyping/rawterm.cmi \ - pretyping/recordops.cmi pretyping/reductionops.cmi kernel/sign.cmi \ - contrib/subtac/subtac_coercion.cmi contrib/subtac/subtac_command.cmi \ - contrib/subtac/subtac_errors.cmi \ +contrib/subtac/subtac_interp_fixpoint.cmo: lib/util.cmi kernel/typeops.cmi \ + kernel/type_errors.cmi interp/topconstr.cmi pretyping/termops.cmi \ + kernel/term.cmi contrib/subtac/subtac_utils.cmi \ + contrib/subtac/subtac_errors.cmi contrib/subtac/subtac_coercion.cmi \ + kernel/sign.cmi pretyping/reductionops.cmi pretyping/recordops.cmi \ + pretyping/rawterm.cmi parsing/printer.cmi pretyping/pretype_errors.cmi \ + parsing/ppconstr.cmi lib/pp.cmi pretyping/pattern.cmi kernel/names.cmi \ + library/nameops.cmi library/libnames.cmi library/global.cmi \ + pretyping/evd.cmi pretyping/evarutil.cmi pretyping/evarconv.cmi \ + contrib/subtac/eterm.cmi kernel/environ.cmi lib/dyn.cmi interp/coqlib.cmi \ + contrib/subtac/context.cmi pretyping/classops.cmi \ + contrib/subtac/subtac_interp_fixpoint.cmi +contrib/subtac/subtac_interp_fixpoint.cmx: lib/util.cmx kernel/typeops.cmx \ + kernel/type_errors.cmx interp/topconstr.cmx pretyping/termops.cmx \ + kernel/term.cmx contrib/subtac/subtac_utils.cmx \ + contrib/subtac/subtac_errors.cmx contrib/subtac/subtac_coercion.cmx \ + kernel/sign.cmx pretyping/reductionops.cmx pretyping/recordops.cmx \ + pretyping/rawterm.cmx parsing/printer.cmx pretyping/pretype_errors.cmx \ + parsing/ppconstr.cmx lib/pp.cmx pretyping/pattern.cmx kernel/names.cmx \ + library/nameops.cmx library/libnames.cmx library/global.cmx \ + pretyping/evd.cmx pretyping/evarutil.cmx pretyping/evarconv.cmx \ + contrib/subtac/eterm.cmx kernel/environ.cmx lib/dyn.cmx interp/coqlib.cmx \ + contrib/subtac/context.cmx pretyping/classops.cmx \ + contrib/subtac/subtac_interp_fixpoint.cmi +contrib/subtac/subtac.cmo: toplevel/vernacexpr.cmo lib/util.cmi \ + kernel/typeops.cmi kernel/type_errors.cmi pretyping/termops.cmi \ + kernel/term.cmi contrib/subtac/subtac_utils.cmi \ + contrib/subtac/subtac_pretyping.cmi \ contrib/subtac/subtac_interp_fixpoint.cmi \ - contrib/subtac/subtac_pretyping.cmi contrib/subtac/subtac_utils.cmi \ - kernel/term.cmi pretyping/termops.cmi kernel/type_errors.cmi \ - kernel/typeops.cmi lib/util.cmi toplevel/vernacexpr.cmo \ - contrib/subtac/subtac.cmi -contrib/subtac/subtac.cmx: toplevel/cerrors.cmx pretyping/classops.cmx \ - toplevel/command.cmx contrib/subtac/context.cmx interp/coqlib.cmx \ - lib/dyn.cmx kernel/environ.cmx contrib/subtac/eterm.cmx \ - pretyping/evarconv.cmx pretyping/evarutil.cmx pretyping/evd.cmx \ - library/global.cmx toplevel/himsg.cmx library/libnames.cmx \ - library/library.cmx kernel/names.cmx pretyping/pattern.cmx \ - proofs/pfedit.cmx lib/pp.cmx parsing/ppconstr.cmx \ - pretyping/pretype_errors.cmx parsing/printer.cmx pretyping/rawterm.cmx \ - pretyping/recordops.cmx pretyping/reductionops.cmx kernel/sign.cmx \ - contrib/subtac/subtac_coercion.cmx contrib/subtac/subtac_command.cmx \ - contrib/subtac/subtac_errors.cmx \ + contrib/subtac/subtac_errors.cmi contrib/subtac/subtac_command.cmi \ + contrib/subtac/subtac_coercion.cmi kernel/sign.cmi \ + pretyping/reductionops.cmi pretyping/recordops.cmi pretyping/rawterm.cmi \ + parsing/printer.cmi pretyping/pretype_errors.cmi parsing/ppconstr.cmi \ + lib/pp.cmi proofs/pfedit.cmi pretyping/pattern.cmi lib/options.cmi \ + library/nametab.cmi kernel/names.cmi library/library.cmi \ + library/libnames.cmi library/lib.cmi toplevel/himsg.cmi \ + library/global.cmi pretyping/evd.cmi pretyping/evarutil.cmi \ + pretyping/evarconv.cmi contrib/subtac/eterm.cmi kernel/environ.cmi \ + lib/dyn.cmi library/decl_kinds.cmo interp/coqlib.cmi \ + contrib/subtac/context.cmi toplevel/command.cmi pretyping/classops.cmi \ + toplevel/cerrors.cmi contrib/subtac/subtac.cmi +contrib/subtac/subtac.cmx: toplevel/vernacexpr.cmx lib/util.cmx \ + kernel/typeops.cmx kernel/type_errors.cmx pretyping/termops.cmx \ + kernel/term.cmx contrib/subtac/subtac_utils.cmx \ + contrib/subtac/subtac_pretyping.cmx \ contrib/subtac/subtac_interp_fixpoint.cmx \ - contrib/subtac/subtac_pretyping.cmx contrib/subtac/subtac_utils.cmx \ - kernel/term.cmx pretyping/termops.cmx kernel/type_errors.cmx \ - kernel/typeops.cmx lib/util.cmx toplevel/vernacexpr.cmx \ - contrib/subtac/subtac.cmi -contrib/subtac/subtac_pretyping.cmo: pretyping/classops.cmi \ - interp/constrintern.cmi contrib/subtac/context.cmi interp/coqlib.cmi \ - lib/dyn.cmi kernel/environ.cmi contrib/subtac/eterm.cmi \ - pretyping/evarconv.cmi pretyping/evarutil.cmi pretyping/evd.cmi \ - library/global.cmi library/libnames.cmi library/nameops.cmi \ - kernel/names.cmi pretyping/pattern.cmi lib/pp.cmi \ - pretyping/pretype_errors.cmi pretyping/pretyping.cmi parsing/printer.cmi \ - pretyping/rawterm.cmi pretyping/recordops.cmi pretyping/reductionops.cmi \ - kernel/sign.cmi contrib/subtac/subtac_coercion.cmi \ - contrib/subtac/subtac_errors.cmi contrib/subtac/subtac_utils.cmi \ - kernel/term.cmi pretyping/termops.cmi interp/topconstr.cmi \ - kernel/type_errors.cmi kernel/typeops.cmi lib/util.cmi \ - toplevel/vernacexpr.cmo contrib/subtac/subtac_pretyping.cmi -contrib/subtac/subtac_pretyping.cmx: pretyping/classops.cmx \ - interp/constrintern.cmx contrib/subtac/context.cmx interp/coqlib.cmx \ - lib/dyn.cmx kernel/environ.cmx contrib/subtac/eterm.cmx \ - pretyping/evarconv.cmx pretyping/evarutil.cmx pretyping/evd.cmx \ - library/global.cmx library/libnames.cmx library/nameops.cmx \ - kernel/names.cmx pretyping/pattern.cmx lib/pp.cmx \ - pretyping/pretype_errors.cmx pretyping/pretyping.cmx parsing/printer.cmx \ - pretyping/rawterm.cmx pretyping/recordops.cmx pretyping/reductionops.cmx \ - kernel/sign.cmx contrib/subtac/subtac_coercion.cmx \ - contrib/subtac/subtac_errors.cmx contrib/subtac/subtac_utils.cmx \ - kernel/term.cmx pretyping/termops.cmx interp/topconstr.cmx \ - kernel/type_errors.cmx kernel/typeops.cmx lib/util.cmx \ - toplevel/vernacexpr.cmx contrib/subtac/subtac_pretyping.cmi -contrib/subtac/subtac_utils.cmo: interp/constrextern.cmi interp/coqlib.cmi \ - library/decl_kinds.cmo pretyping/evarutil.cmi pretyping/evd.cmi \ - library/global.cmi library/libnames.cmi kernel/names.cmi lib/pp.cmi \ - pretyping/pretype_errors.cmi parsing/printer.cmi kernel/term.cmi \ - pretyping/termops.cmi interp/topconstr.cmi lib/util.cmi \ + contrib/subtac/subtac_errors.cmx contrib/subtac/subtac_command.cmx \ + contrib/subtac/subtac_coercion.cmx kernel/sign.cmx \ + pretyping/reductionops.cmx pretyping/recordops.cmx pretyping/rawterm.cmx \ + parsing/printer.cmx pretyping/pretype_errors.cmx parsing/ppconstr.cmx \ + lib/pp.cmx proofs/pfedit.cmx pretyping/pattern.cmx lib/options.cmx \ + library/nametab.cmx kernel/names.cmx library/library.cmx \ + library/libnames.cmx library/lib.cmx toplevel/himsg.cmx \ + library/global.cmx pretyping/evd.cmx pretyping/evarutil.cmx \ + pretyping/evarconv.cmx contrib/subtac/eterm.cmx kernel/environ.cmx \ + lib/dyn.cmx library/decl_kinds.cmx interp/coqlib.cmx \ + contrib/subtac/context.cmx toplevel/command.cmx pretyping/classops.cmx \ + toplevel/cerrors.cmx contrib/subtac/subtac.cmi +contrib/subtac/subtac_pretyping_F.cmo: lib/util.cmi kernel/typeops.cmi \ + kernel/type_errors.cmi pretyping/termops.cmi kernel/term.cmi \ + kernel/sign.cmi pretyping/retyping.cmi pretyping/reductionops.cmi \ + pretyping/recordops.cmi pretyping/rawterm.cmi pretyping/pretyping.cmi \ + pretyping/pretype_errors.cmi lib/pp.cmi pretyping/pattern.cmi \ + kernel/names.cmi library/nameops.cmi library/libnames.cmi \ + pretyping/inductiveops.cmi kernel/inductive.cmi pretyping/evd.cmi \ + pretyping/evarutil.cmi pretyping/evarconv.cmi kernel/environ.cmi \ + lib/dyn.cmi kernel/declarations.cmi pretyping/coercion.cmi \ + pretyping/classops.cmi pretyping/cases.cmi +contrib/subtac/subtac_pretyping_F.cmx: lib/util.cmx kernel/typeops.cmx \ + kernel/type_errors.cmx pretyping/termops.cmx kernel/term.cmx \ + kernel/sign.cmx pretyping/retyping.cmx pretyping/reductionops.cmx \ + pretyping/recordops.cmx pretyping/rawterm.cmx pretyping/pretyping.cmx \ + pretyping/pretype_errors.cmx lib/pp.cmx pretyping/pattern.cmx \ + kernel/names.cmx library/nameops.cmx library/libnames.cmx \ + pretyping/inductiveops.cmx kernel/inductive.cmx pretyping/evd.cmx \ + pretyping/evarutil.cmx pretyping/evarconv.cmx kernel/environ.cmx \ + lib/dyn.cmx kernel/declarations.cmx pretyping/coercion.cmx \ + pretyping/classops.cmx pretyping/cases.cmx +contrib/subtac/subtac_pretyping.cmo: toplevel/vernacexpr.cmo lib/util.cmi \ + kernel/typeops.cmi kernel/type_errors.cmi interp/topconstr.cmi \ + pretyping/termops.cmi kernel/term.cmi contrib/subtac/subtac_utils.cmi \ + contrib/subtac/subtac_pretyping_F.cmo contrib/subtac/subtac_errors.cmi \ + contrib/subtac/subtac_coercion.cmi kernel/sign.cmi \ + pretyping/reductionops.cmi pretyping/recordops.cmi pretyping/rawterm.cmi \ + parsing/printer.cmi pretyping/pretype_errors.cmi lib/pp.cmi \ + pretyping/pattern.cmi kernel/names.cmi library/nameops.cmi \ + library/libnames.cmi library/global.cmi pretyping/evd.cmi \ + pretyping/evarutil.cmi pretyping/evarconv.cmi contrib/subtac/eterm.cmi \ + kernel/environ.cmi lib/dyn.cmi interp/coqlib.cmi \ + contrib/subtac/context.cmi interp/constrintern.cmi pretyping/classops.cmi \ + contrib/subtac/subtac_pretyping.cmi +contrib/subtac/subtac_pretyping.cmx: toplevel/vernacexpr.cmx lib/util.cmx \ + kernel/typeops.cmx kernel/type_errors.cmx interp/topconstr.cmx \ + pretyping/termops.cmx kernel/term.cmx contrib/subtac/subtac_utils.cmx \ + contrib/subtac/subtac_pretyping_F.cmx contrib/subtac/subtac_errors.cmx \ + contrib/subtac/subtac_coercion.cmx kernel/sign.cmx \ + pretyping/reductionops.cmx pretyping/recordops.cmx pretyping/rawterm.cmx \ + parsing/printer.cmx pretyping/pretype_errors.cmx lib/pp.cmx \ + pretyping/pattern.cmx kernel/names.cmx library/nameops.cmx \ + library/libnames.cmx library/global.cmx pretyping/evd.cmx \ + pretyping/evarutil.cmx pretyping/evarconv.cmx contrib/subtac/eterm.cmx \ + kernel/environ.cmx lib/dyn.cmx interp/coqlib.cmx \ + contrib/subtac/context.cmx interp/constrintern.cmx pretyping/classops.cmx \ + contrib/subtac/subtac_pretyping.cmi +contrib/subtac/subtac_utils.cmo: lib/util.cmi interp/topconstr.cmi \ + pretyping/termops.cmi kernel/term.cmi tactics/tactics.cmi \ + tactics/tacticals.cmi proofs/tacexpr.cmo pretyping/rawterm.cmi \ + proofs/proof_type.cmi parsing/printer.cmi pretyping/pretype_errors.cmi \ + parsing/ppconstr.cmi lib/pp.cmi proofs/pfedit.cmi lib/options.cmi \ + kernel/names.cmi library/libnames.cmi library/global.cmi \ + pretyping/evd.cmi pretyping/evarutil.cmi library/decl_kinds.cmo \ + interp/coqlib.cmi interp/constrextern.cmi toplevel/command.cmi \ contrib/subtac/subtac_utils.cmi -contrib/subtac/subtac_utils.cmx: interp/constrextern.cmx interp/coqlib.cmx \ - library/decl_kinds.cmx pretyping/evarutil.cmx pretyping/evd.cmx \ - library/global.cmx library/libnames.cmx kernel/names.cmx lib/pp.cmx \ - pretyping/pretype_errors.cmx parsing/printer.cmx kernel/term.cmx \ - pretyping/termops.cmx interp/topconstr.cmx lib/util.cmx \ +contrib/subtac/subtac_utils.cmx: lib/util.cmx interp/topconstr.cmx \ + pretyping/termops.cmx kernel/term.cmx tactics/tactics.cmx \ + tactics/tacticals.cmx proofs/tacexpr.cmx pretyping/rawterm.cmx \ + proofs/proof_type.cmx parsing/printer.cmx pretyping/pretype_errors.cmx \ + parsing/ppconstr.cmx lib/pp.cmx proofs/pfedit.cmx lib/options.cmx \ + kernel/names.cmx library/libnames.cmx library/global.cmx \ + pretyping/evd.cmx pretyping/evarutil.cmx library/decl_kinds.cmx \ + interp/coqlib.cmx interp/constrextern.cmx toplevel/command.cmx \ contrib/subtac/subtac_utils.cmi -contrib/xml/acic2Xml.cmo: contrib/xml/acic.cmo contrib/xml/cic2acic.cmo \ - kernel/names.cmi kernel/term.cmi lib/util.cmi contrib/xml/xml.cmi -contrib/xml/acic2Xml.cmx: contrib/xml/acic.cmx contrib/xml/cic2acic.cmx \ - kernel/names.cmx kernel/term.cmx lib/util.cmx contrib/xml/xml.cmx -contrib/xml/acic.cmo: kernel/names.cmi kernel/term.cmi -contrib/xml/acic.cmx: kernel/names.cmx kernel/term.cmx -contrib/xml/cic2acic.cmo: contrib/xml/acic.cmo kernel/declarations.cmi \ - library/declare.cmi library/dischargedhypsmap.cmi \ - contrib/xml/doubleTypeInference.cmi kernel/environ.cmi pretyping/evd.cmi \ - library/global.cmi pretyping/inductiveops.cmi library/lib.cmi \ - library/libnames.cmi library/library.cmi library/nameops.cmi \ - kernel/names.cmi library/nametab.cmi lib/pp.cmi parsing/printer.cmi \ - pretyping/reductionops.cmi kernel/term.cmi pretyping/termops.cmi \ - kernel/univ.cmi contrib/xml/unshare.cmi lib/util.cmi -contrib/xml/cic2acic.cmx: contrib/xml/acic.cmx kernel/declarations.cmx \ - library/declare.cmx library/dischargedhypsmap.cmx \ - contrib/xml/doubleTypeInference.cmx kernel/environ.cmx pretyping/evd.cmx \ - library/global.cmx pretyping/inductiveops.cmx library/lib.cmx \ - library/libnames.cmx library/library.cmx library/nameops.cmx \ - kernel/names.cmx library/nametab.cmx lib/pp.cmx parsing/printer.cmx \ - pretyping/reductionops.cmx kernel/term.cmx pretyping/termops.cmx \ - kernel/univ.cmx contrib/xml/unshare.cmx lib/util.cmx -contrib/xml/cic2Xml.cmo: contrib/xml/acic.cmo contrib/xml/acic2Xml.cmo \ - contrib/xml/cic2acic.cmo tactics/tacinterp.cmi contrib/xml/unshare.cmi \ - contrib/xml/xml.cmi -contrib/xml/cic2Xml.cmx: contrib/xml/acic.cmx contrib/xml/acic2Xml.cmx \ - contrib/xml/cic2acic.cmx tactics/tacinterp.cmx contrib/xml/unshare.cmx \ - contrib/xml/xml.cmx -contrib/xml/doubleTypeInference.cmo: contrib/xml/acic.cmo \ - kernel/conv_oracle.cmi kernel/environ.cmi pretyping/evarutil.cmi \ - pretyping/evd.cmi kernel/inductive.cmi pretyping/inductiveops.cmi \ - library/libnames.cmi kernel/names.cmi lib/pp.cmi parsing/printer.cmi \ - pretyping/rawterm.cmi proofs/redexpr.cmi kernel/reduction.cmi \ - pretyping/reductionops.cmi pretyping/retyping.cmi kernel/term.cmi \ - pretyping/termops.cmi kernel/typeops.cmi contrib/xml/unshare.cmi \ - lib/util.cmi contrib/xml/doubleTypeInference.cmi -contrib/xml/doubleTypeInference.cmx: contrib/xml/acic.cmx \ - kernel/conv_oracle.cmx kernel/environ.cmx pretyping/evarutil.cmx \ - pretyping/evd.cmx kernel/inductive.cmx pretyping/inductiveops.cmx \ - library/libnames.cmx kernel/names.cmx lib/pp.cmx parsing/printer.cmx \ - pretyping/rawterm.cmx proofs/redexpr.cmx kernel/reduction.cmx \ - pretyping/reductionops.cmx pretyping/retyping.cmx kernel/term.cmx \ - pretyping/termops.cmx kernel/typeops.cmx contrib/xml/unshare.cmx \ - lib/util.cmx contrib/xml/doubleTypeInference.cmi -contrib/xml/proof2aproof.cmo: kernel/environ.cmi pretyping/evarutil.cmi \ - pretyping/evd.cmi proofs/logic.cmi lib/pp.cmi proofs/proof_type.cmi \ - proofs/refiner.cmi kernel/sign.cmi proofs/tacmach.cmi \ - parsing/tactic_printer.cmi kernel/term.cmi pretyping/termops.cmi \ - contrib/xml/unshare.cmi lib/util.cmi -contrib/xml/proof2aproof.cmx: kernel/environ.cmx pretyping/evarutil.cmx \ - pretyping/evd.cmx proofs/logic.cmx lib/pp.cmx proofs/proof_type.cmx \ - proofs/refiner.cmx kernel/sign.cmx proofs/tacmach.cmx \ - parsing/tactic_printer.cmx kernel/term.cmx pretyping/termops.cmx \ - contrib/xml/unshare.cmx lib/util.cmx -contrib/xml/proofTree2Xml.cmo: contrib/xml/acic.cmo contrib/xml/acic2Xml.cmo \ - contrib/xml/cic2acic.cmo kernel/environ.cmi pretyping/evd.cmi \ - library/global.cmi proofs/logic.cmi kernel/names.cmi lib/pp.cmi \ - parsing/pptactic.cmi parsing/printer.cmi contrib/xml/proof2aproof.cmo \ - proofs/proof_type.cmi kernel/sign.cmi proofs/tacexpr.cmo kernel/term.cmi \ - contrib/xml/unshare.cmi lib/util.cmi contrib/xml/xml.cmi -contrib/xml/proofTree2Xml.cmx: contrib/xml/acic.cmx contrib/xml/acic2Xml.cmx \ - contrib/xml/cic2acic.cmx kernel/environ.cmx pretyping/evd.cmx \ - library/global.cmx proofs/logic.cmx kernel/names.cmx lib/pp.cmx \ - parsing/pptactic.cmx parsing/printer.cmx contrib/xml/proof2aproof.cmx \ - proofs/proof_type.cmx kernel/sign.cmx proofs/tacexpr.cmx kernel/term.cmx \ - contrib/xml/unshare.cmx lib/util.cmx contrib/xml/xml.cmx +contrib/xml/acic2Xml.cmo: contrib/xml/xml.cmi lib/util.cmi kernel/term.cmi \ + kernel/names.cmi contrib/xml/cic2acic.cmo contrib/xml/acic.cmo +contrib/xml/acic2Xml.cmx: contrib/xml/xml.cmx lib/util.cmx kernel/term.cmx \ + kernel/names.cmx contrib/xml/cic2acic.cmx contrib/xml/acic.cmx +contrib/xml/acic.cmo: kernel/term.cmi kernel/names.cmi +contrib/xml/acic.cmx: kernel/term.cmx kernel/names.cmx +contrib/xml/cic2acic.cmo: lib/util.cmi contrib/xml/unshare.cmi \ + kernel/univ.cmi pretyping/termops.cmi kernel/term.cmi \ + pretyping/reductionops.cmi parsing/printer.cmi lib/pp.cmi \ + library/nametab.cmi kernel/names.cmi library/nameops.cmi \ + library/library.cmi library/libnames.cmi library/lib.cmi \ + pretyping/inductiveops.cmi library/global.cmi pretyping/evd.cmi \ + kernel/environ.cmi contrib/xml/doubleTypeInference.cmi \ + library/dischargedhypsmap.cmi library/declare.cmi kernel/declarations.cmi \ + contrib/xml/acic.cmo +contrib/xml/cic2acic.cmx: lib/util.cmx contrib/xml/unshare.cmx \ + kernel/univ.cmx pretyping/termops.cmx kernel/term.cmx \ + pretyping/reductionops.cmx parsing/printer.cmx lib/pp.cmx \ + library/nametab.cmx kernel/names.cmx library/nameops.cmx \ + library/library.cmx library/libnames.cmx library/lib.cmx \ + pretyping/inductiveops.cmx library/global.cmx pretyping/evd.cmx \ + kernel/environ.cmx contrib/xml/doubleTypeInference.cmx \ + library/dischargedhypsmap.cmx library/declare.cmx kernel/declarations.cmx \ + contrib/xml/acic.cmx +contrib/xml/cic2Xml.cmo: contrib/xml/xml.cmi contrib/xml/unshare.cmi \ + tactics/tacinterp.cmi contrib/xml/cic2acic.cmo contrib/xml/acic2Xml.cmo \ + contrib/xml/acic.cmo +contrib/xml/cic2Xml.cmx: contrib/xml/xml.cmx contrib/xml/unshare.cmx \ + tactics/tacinterp.cmx contrib/xml/cic2acic.cmx contrib/xml/acic2Xml.cmx \ + contrib/xml/acic.cmx +contrib/xml/doubleTypeInference.cmo: lib/util.cmi contrib/xml/unshare.cmi \ + kernel/typeops.cmi pretyping/termops.cmi kernel/term.cmi \ + pretyping/retyping.cmi pretyping/reductionops.cmi kernel/reduction.cmi \ + proofs/redexpr.cmi pretyping/rawterm.cmi parsing/printer.cmi lib/pp.cmi \ + kernel/names.cmi library/libnames.cmi pretyping/inductiveops.cmi \ + kernel/inductive.cmi pretyping/evd.cmi pretyping/evarutil.cmi \ + kernel/environ.cmi kernel/conv_oracle.cmi contrib/xml/acic.cmo \ + contrib/xml/doubleTypeInference.cmi +contrib/xml/doubleTypeInference.cmx: lib/util.cmx contrib/xml/unshare.cmx \ + kernel/typeops.cmx pretyping/termops.cmx kernel/term.cmx \ + pretyping/retyping.cmx pretyping/reductionops.cmx kernel/reduction.cmx \ + proofs/redexpr.cmx pretyping/rawterm.cmx parsing/printer.cmx lib/pp.cmx \ + kernel/names.cmx library/libnames.cmx pretyping/inductiveops.cmx \ + kernel/inductive.cmx pretyping/evd.cmx pretyping/evarutil.cmx \ + kernel/environ.cmx kernel/conv_oracle.cmx contrib/xml/acic.cmx \ + contrib/xml/doubleTypeInference.cmi +contrib/xml/proof2aproof.cmo: lib/util.cmi contrib/xml/unshare.cmi \ + pretyping/termops.cmi kernel/term.cmi parsing/tactic_printer.cmi \ + proofs/tacmach.cmi kernel/sign.cmi proofs/refiner.cmi \ + proofs/proof_type.cmi lib/pp.cmi proofs/logic.cmi pretyping/evd.cmi \ + pretyping/evarutil.cmi kernel/environ.cmi +contrib/xml/proof2aproof.cmx: lib/util.cmx contrib/xml/unshare.cmx \ + pretyping/termops.cmx kernel/term.cmx parsing/tactic_printer.cmx \ + proofs/tacmach.cmx kernel/sign.cmx proofs/refiner.cmx \ + proofs/proof_type.cmx lib/pp.cmx proofs/logic.cmx pretyping/evd.cmx \ + pretyping/evarutil.cmx kernel/environ.cmx +contrib/xml/proofTree2Xml.cmo: contrib/xml/xml.cmi lib/util.cmi \ + contrib/xml/unshare.cmi kernel/term.cmi proofs/tacexpr.cmo \ + kernel/sign.cmi proofs/proof_type.cmi contrib/xml/proof2aproof.cmo \ + parsing/printer.cmi parsing/pptactic.cmi lib/pp.cmi kernel/names.cmi \ + proofs/logic.cmi library/global.cmi pretyping/evd.cmi kernel/environ.cmi \ + contrib/xml/cic2acic.cmo contrib/xml/acic2Xml.cmo contrib/xml/acic.cmo +contrib/xml/proofTree2Xml.cmx: contrib/xml/xml.cmx lib/util.cmx \ + contrib/xml/unshare.cmx kernel/term.cmx proofs/tacexpr.cmx \ + kernel/sign.cmx proofs/proof_type.cmx contrib/xml/proof2aproof.cmx \ + parsing/printer.cmx parsing/pptactic.cmx lib/pp.cmx kernel/names.cmx \ + proofs/logic.cmx library/global.cmx pretyping/evd.cmx kernel/environ.cmx \ + contrib/xml/cic2acic.cmx contrib/xml/acic2Xml.cmx contrib/xml/acic.cmx contrib/xml/unshare.cmo: contrib/xml/unshare.cmi contrib/xml/unshare.cmx: contrib/xml/unshare.cmi -contrib/xml/xmlcommand.cmo: contrib/xml/acic.cmo contrib/xml/acic2Xml.cmo \ - contrib/xml/cic2acic.cmo config/coq_config.cmi library/decl_kinds.cmo \ - kernel/declarations.cmi library/declare.cmi kernel/environ.cmi \ - pretyping/evarutil.cmi pretyping/evd.cmi library/global.cmi \ - pretyping/inductiveops.cmi parsing/lexer.cmi library/lib.cmi \ - library/libnames.cmi library/libobject.cmi library/library.cmi \ - kernel/names.cmi library/nametab.cmi proofs/pfedit.cmi \ - contrib/xml/proof2aproof.cmo proofs/proof_trees.cmi \ - pretyping/recordops.cmi proofs/tacmach.cmi kernel/term.cmi \ - contrib/xml/unshare.cmi lib/util.cmi toplevel/vernac.cmi \ - contrib/xml/xml.cmi contrib/xml/xmlcommand.cmi -contrib/xml/xmlcommand.cmx: contrib/xml/acic.cmx contrib/xml/acic2Xml.cmx \ - contrib/xml/cic2acic.cmx config/coq_config.cmx library/decl_kinds.cmx \ - kernel/declarations.cmx library/declare.cmx kernel/environ.cmx \ - pretyping/evarutil.cmx pretyping/evd.cmx library/global.cmx \ - pretyping/inductiveops.cmx parsing/lexer.cmx library/lib.cmx \ - library/libnames.cmx library/libobject.cmx library/library.cmx \ - kernel/names.cmx library/nametab.cmx proofs/pfedit.cmx \ - contrib/xml/proof2aproof.cmx proofs/proof_trees.cmx \ - pretyping/recordops.cmx proofs/tacmach.cmx kernel/term.cmx \ - contrib/xml/unshare.cmx lib/util.cmx toplevel/vernac.cmx \ - contrib/xml/xml.cmx contrib/xml/xmlcommand.cmi -contrib/xml/xmlentries.cmo: toplevel/cerrors.cmi parsing/egrammar.cmi \ - parsing/extend.cmi interp/genarg.cmi parsing/lexer.cmi parsing/pcoq.cmi \ - lib/pp.cmi lib/util.cmi toplevel/vernacinterp.cmi \ - contrib/xml/xmlcommand.cmi -contrib/xml/xmlentries.cmx: toplevel/cerrors.cmx parsing/egrammar.cmx \ - parsing/extend.cmx interp/genarg.cmx parsing/lexer.cmx parsing/pcoq.cmx \ - lib/pp.cmx lib/util.cmx toplevel/vernacinterp.cmx \ - contrib/xml/xmlcommand.cmx +contrib/xml/xmlcommand.cmo: contrib/xml/xml.cmi toplevel/vernac.cmi \ + lib/util.cmi contrib/xml/unshare.cmi kernel/term.cmi proofs/tacmach.cmi \ + pretyping/recordops.cmi proofs/proof_trees.cmi \ + contrib/xml/proof2aproof.cmo proofs/pfedit.cmi library/nametab.cmi \ + kernel/names.cmi library/library.cmi library/libobject.cmi \ + library/libnames.cmi library/lib.cmi parsing/lexer.cmi \ + pretyping/inductiveops.cmi kernel/inductive.cmi library/global.cmi \ + pretyping/evd.cmi pretyping/evarutil.cmi kernel/environ.cmi \ + library/declare.cmi kernel/declarations.cmi library/decl_kinds.cmo \ + config/coq_config.cmi contrib/xml/cic2acic.cmo contrib/xml/acic2Xml.cmo \ + contrib/xml/acic.cmo contrib/xml/xmlcommand.cmi +contrib/xml/xmlcommand.cmx: contrib/xml/xml.cmx toplevel/vernac.cmx \ + lib/util.cmx contrib/xml/unshare.cmx kernel/term.cmx proofs/tacmach.cmx \ + pretyping/recordops.cmx proofs/proof_trees.cmx \ + contrib/xml/proof2aproof.cmx proofs/pfedit.cmx library/nametab.cmx \ + kernel/names.cmx library/library.cmx library/libobject.cmx \ + library/libnames.cmx library/lib.cmx parsing/lexer.cmx \ + pretyping/inductiveops.cmx kernel/inductive.cmx library/global.cmx \ + pretyping/evd.cmx pretyping/evarutil.cmx kernel/environ.cmx \ + library/declare.cmx kernel/declarations.cmx library/decl_kinds.cmx \ + config/coq_config.cmx contrib/xml/cic2acic.cmx contrib/xml/acic2Xml.cmx \ + contrib/xml/acic.cmx contrib/xml/xmlcommand.cmi +contrib/xml/xmlentries.cmo: contrib/xml/xmlcommand.cmi \ + toplevel/vernacinterp.cmi lib/util.cmi lib/pp.cmi parsing/pcoq.cmi \ + parsing/lexer.cmi interp/genarg.cmi parsing/extend.cmi \ + parsing/egrammar.cmi toplevel/cerrors.cmi +contrib/xml/xmlentries.cmx: contrib/xml/xmlcommand.cmx \ + toplevel/vernacinterp.cmx lib/util.cmx lib/pp.cmx parsing/pcoq.cmx \ + parsing/lexer.cmx interp/genarg.cmx parsing/extend.cmx \ + parsing/egrammar.cmx toplevel/cerrors.cmx contrib/xml/xml.cmo: contrib/xml/xml.cmi contrib/xml/xml.cmx: contrib/xml/xml.cmi +doc/refman/euclid.cmo: doc/refman/euclid.cmi +doc/refman/euclid.cmx: doc/refman/euclid.cmi +doc/refman/heapsort.cmo: doc/refman/heapsort.cmi +doc/refman/heapsort.cmx: doc/refman/heapsort.cmi ide/utils/config_file.cmo: ide/utils/config_file.cmi ide/utils/config_file.cmx: ide/utils/config_file.cmi -ide/utils/configwin_html_config.cmo: ide/utils/config_file.cmi \ - ide/utils/configwin_ihm.cmo ide/utils/configwin_messages.cmo \ - ide/utils/configwin_types.cmo -ide/utils/configwin_html_config.cmx: ide/utils/config_file.cmx \ - ide/utils/configwin_ihm.cmx ide/utils/configwin_messages.cmx \ - ide/utils/configwin_types.cmx -ide/utils/configwin_ihm.cmo: ide/utils/config_file.cmi \ - ide/utils/configwin_messages.cmo ide/utils/configwin_types.cmo \ - ide/utils/okey.cmi -ide/utils/configwin_ihm.cmx: ide/utils/config_file.cmx \ - ide/utils/configwin_messages.cmx ide/utils/configwin_types.cmx \ - ide/utils/okey.cmx -ide/utils/configwin.cmo: ide/utils/configwin_ihm.cmo \ - ide/utils/configwin_types.cmo ide/utils/configwin.cmi -ide/utils/configwin.cmx: ide/utils/configwin_ihm.cmx \ - ide/utils/configwin_types.cmx ide/utils/configwin.cmi -ide/utils/configwin_types.cmo: ide/utils/config_file.cmi \ - ide/utils/configwin_keys.cmo -ide/utils/configwin_types.cmx: ide/utils/config_file.cmx \ - ide/utils/configwin_keys.cmx +ide/utils/configwin_html_config.cmo: ide/utils/configwin_types.cmo \ + ide/utils/configwin_messages.cmo ide/utils/configwin_ihm.cmo \ + ide/utils/config_file.cmi +ide/utils/configwin_html_config.cmx: ide/utils/configwin_types.cmx \ + ide/utils/configwin_messages.cmx ide/utils/configwin_ihm.cmx \ + ide/utils/config_file.cmx +ide/utils/configwin_ihm.cmo: ide/utils/okey.cmi ide/utils/configwin_types.cmo \ + ide/utils/configwin_messages.cmo ide/utils/config_file.cmi +ide/utils/configwin_ihm.cmx: ide/utils/okey.cmx ide/utils/configwin_types.cmx \ + ide/utils/configwin_messages.cmx ide/utils/config_file.cmx +ide/utils/configwin.cmo: ide/utils/configwin_types.cmo \ + ide/utils/configwin_ihm.cmo ide/utils/configwin.cmi +ide/utils/configwin.cmx: ide/utils/configwin_types.cmx \ + ide/utils/configwin_ihm.cmx ide/utils/configwin.cmi +ide/utils/configwin_types.cmo: ide/utils/configwin_keys.cmo \ + ide/utils/config_file.cmi +ide/utils/configwin_types.cmx: ide/utils/configwin_keys.cmx \ + ide/utils/config_file.cmx ide/utils/okey.cmo: ide/utils/okey.cmi ide/utils/okey.cmx: ide/utils/okey.cmi ide/utils/uoptions.cmo: ide/utils/uoptions.cmi ide/utils/uoptions.cmx: ide/utils/uoptions.cmi tools/coqdoc/alpha.cmo: tools/coqdoc/alpha.cmi tools/coqdoc/alpha.cmx: tools/coqdoc/alpha.cmi -tools/coqdoc/index.cmo: tools/coqdoc/alpha.cmi tools/coqdoc/cdglobals.cmo \ +tools/coqdoc/cdglobals.cmo: config/coq_config.cmi +tools/coqdoc/cdglobals.cmx: config/coq_config.cmx +tools/coqdoc/index.cmo: tools/coqdoc/cdglobals.cmo tools/coqdoc/alpha.cmi \ tools/coqdoc/index.cmi -tools/coqdoc/index.cmx: tools/coqdoc/alpha.cmx tools/coqdoc/cdglobals.cmx \ +tools/coqdoc/index.cmx: tools/coqdoc/cdglobals.cmx tools/coqdoc/alpha.cmx \ tools/coqdoc/index.cmi -tools/coqdoc/main.cmo: tools/coqdoc/cdglobals.cmo config/coq_config.cmi \ - tools/coqdoc/index.cmi tools/coqdoc/output.cmi tools/coqdoc/pretty.cmi -tools/coqdoc/main.cmx: tools/coqdoc/cdglobals.cmx config/coq_config.cmx \ - tools/coqdoc/index.cmx tools/coqdoc/output.cmx tools/coqdoc/pretty.cmx -tools/coqdoc/output.cmo: tools/coqdoc/cdglobals.cmo tools/coqdoc/index.cmi \ +tools/coqdoc/main.cmo: tools/coqdoc/pretty.cmi tools/coqdoc/output.cmi \ + tools/coqdoc/index.cmi config/coq_config.cmi tools/coqdoc/cdglobals.cmo +tools/coqdoc/main.cmx: tools/coqdoc/pretty.cmx tools/coqdoc/output.cmx \ + tools/coqdoc/index.cmx config/coq_config.cmx tools/coqdoc/cdglobals.cmx +tools/coqdoc/output.cmo: tools/coqdoc/index.cmi tools/coqdoc/cdglobals.cmo \ tools/coqdoc/output.cmi -tools/coqdoc/output.cmx: tools/coqdoc/cdglobals.cmx tools/coqdoc/index.cmx \ +tools/coqdoc/output.cmx: tools/coqdoc/index.cmx tools/coqdoc/cdglobals.cmx \ tools/coqdoc/output.cmi -tools/coqdoc/pretty.cmo: tools/coqdoc/cdglobals.cmo tools/coqdoc/index.cmi \ - tools/coqdoc/output.cmi tools/coqdoc/pretty.cmi -tools/coqdoc/pretty.cmx: tools/coqdoc/cdglobals.cmx tools/coqdoc/index.cmx \ - tools/coqdoc/output.cmx tools/coqdoc/pretty.cmi +tools/coqdoc/pretty.cmo: tools/coqdoc/output.cmi tools/coqdoc/index.cmi \ + tools/coqdoc/cdglobals.cmo tools/coqdoc/pretty.cmi +tools/coqdoc/pretty.cmx: tools/coqdoc/output.cmx tools/coqdoc/index.cmx \ + tools/coqdoc/cdglobals.cmx tools/coqdoc/pretty.cmi tactics/tauto.cmo: parsing/grammar.cma tactics/tauto.cmx: parsing/grammar.cma tactics/eqdecide.cmo: parsing/grammar.cma @@ -3867,50 +3964,58 @@ tools/coq_makefile.cmx: tools/coq-tex.cmo: tools/coq-tex.cmx: coq_fix_code.o: kernel/byterun/coq_fix_code.c \ - /usr/lib/ocaml/caml/config.h /usr/lib/ocaml/caml/compatibility.h \ - /usr/lib/ocaml/caml/misc.h /usr/lib/ocaml/caml/mlvalues.h \ - /usr/lib/ocaml/caml/fail.h /usr/lib/ocaml/caml/memory.h \ + /usr/local/lib/ocaml/caml/config.h \ + /usr/local/lib/ocaml/caml/compatibility.h \ + /usr/local/lib/ocaml/caml/misc.h /usr/local/lib/ocaml/caml/mlvalues.h \ + /usr/local/lib/ocaml/caml/fail.h /usr/local/lib/ocaml/caml/memory.h \ kernel/byterun/coq_instruct.h kernel/byterun/coq_fix_code.h coq_interp.o: kernel/byterun/coq_interp.c kernel/byterun/coq_gc.h \ - /usr/lib/ocaml/caml/mlvalues.h /usr/lib/ocaml/caml/compatibility.h \ - /usr/lib/ocaml/caml/config.h /usr/lib/ocaml/caml/misc.h \ - /usr/lib/ocaml/caml/alloc.h kernel/byterun/coq_instruct.h \ + /usr/local/lib/ocaml/caml/mlvalues.h \ + /usr/local/lib/ocaml/caml/compatibility.h \ + /usr/local/lib/ocaml/caml/config.h /usr/local/lib/ocaml/caml/misc.h \ + /usr/local/lib/ocaml/caml/alloc.h kernel/byterun/coq_instruct.h \ kernel/byterun/coq_fix_code.h kernel/byterun/coq_memory.h \ - /usr/lib/ocaml/caml/fail.h /usr/lib/ocaml/caml/memory.h \ + /usr/local/lib/ocaml/caml/fail.h /usr/local/lib/ocaml/caml/memory.h \ kernel/byterun/coq_values.h kernel/byterun/coq_jumptbl.h coq_memory.o: kernel/byterun/coq_memory.c kernel/byterun/coq_gc.h \ - /usr/lib/ocaml/caml/mlvalues.h /usr/lib/ocaml/caml/compatibility.h \ - /usr/lib/ocaml/caml/config.h /usr/lib/ocaml/caml/misc.h \ - /usr/lib/ocaml/caml/alloc.h kernel/byterun/coq_instruct.h \ + /usr/local/lib/ocaml/caml/mlvalues.h \ + /usr/local/lib/ocaml/caml/compatibility.h \ + /usr/local/lib/ocaml/caml/config.h /usr/local/lib/ocaml/caml/misc.h \ + /usr/local/lib/ocaml/caml/alloc.h kernel/byterun/coq_instruct.h \ kernel/byterun/coq_fix_code.h kernel/byterun/coq_memory.h \ - /usr/lib/ocaml/caml/fail.h /usr/lib/ocaml/caml/memory.h + /usr/local/lib/ocaml/caml/fail.h /usr/local/lib/ocaml/caml/memory.h coq_values.o: kernel/byterun/coq_values.c kernel/byterun/coq_fix_code.h \ - /usr/lib/ocaml/caml/mlvalues.h /usr/lib/ocaml/caml/compatibility.h \ - /usr/lib/ocaml/caml/config.h /usr/lib/ocaml/caml/misc.h \ + /usr/local/lib/ocaml/caml/mlvalues.h \ + /usr/local/lib/ocaml/caml/compatibility.h \ + /usr/local/lib/ocaml/caml/config.h /usr/local/lib/ocaml/caml/misc.h \ kernel/byterun/coq_instruct.h kernel/byterun/coq_memory.h \ - /usr/lib/ocaml/caml/fail.h /usr/lib/ocaml/caml/memory.h \ - kernel/byterun/coq_values.h /usr/lib/ocaml/caml/alloc.h + /usr/local/lib/ocaml/caml/fail.h /usr/local/lib/ocaml/caml/memory.h \ + kernel/byterun/coq_values.h /usr/local/lib/ocaml/caml/alloc.h coq_fix_code.d.o: kernel/byterun/coq_fix_code.c \ - /usr/lib/ocaml/caml/config.h /usr/lib/ocaml/caml/compatibility.h \ - /usr/lib/ocaml/caml/misc.h /usr/lib/ocaml/caml/mlvalues.h \ - /usr/lib/ocaml/caml/fail.h /usr/lib/ocaml/caml/memory.h \ + /usr/local/lib/ocaml/caml/config.h \ + /usr/local/lib/ocaml/caml/compatibility.h \ + /usr/local/lib/ocaml/caml/misc.h /usr/local/lib/ocaml/caml/mlvalues.h \ + /usr/local/lib/ocaml/caml/fail.h /usr/local/lib/ocaml/caml/memory.h \ kernel/byterun/coq_instruct.h kernel/byterun/coq_fix_code.h coq_interp.d.o: kernel/byterun/coq_interp.c kernel/byterun/coq_gc.h \ - /usr/lib/ocaml/caml/mlvalues.h /usr/lib/ocaml/caml/compatibility.h \ - /usr/lib/ocaml/caml/config.h /usr/lib/ocaml/caml/misc.h \ - /usr/lib/ocaml/caml/alloc.h kernel/byterun/coq_instruct.h \ + /usr/local/lib/ocaml/caml/mlvalues.h \ + /usr/local/lib/ocaml/caml/compatibility.h \ + /usr/local/lib/ocaml/caml/config.h /usr/local/lib/ocaml/caml/misc.h \ + /usr/local/lib/ocaml/caml/alloc.h kernel/byterun/coq_instruct.h \ kernel/byterun/coq_fix_code.h kernel/byterun/coq_memory.h \ - /usr/lib/ocaml/caml/fail.h /usr/lib/ocaml/caml/memory.h \ + /usr/local/lib/ocaml/caml/fail.h /usr/local/lib/ocaml/caml/memory.h \ kernel/byterun/coq_values.h kernel/byterun/coq_jumptbl.h coq_memory.d.o: kernel/byterun/coq_memory.c kernel/byterun/coq_gc.h \ - /usr/lib/ocaml/caml/mlvalues.h /usr/lib/ocaml/caml/compatibility.h \ - /usr/lib/ocaml/caml/config.h /usr/lib/ocaml/caml/misc.h \ - /usr/lib/ocaml/caml/alloc.h kernel/byterun/coq_instruct.h \ + /usr/local/lib/ocaml/caml/mlvalues.h \ + /usr/local/lib/ocaml/caml/compatibility.h \ + /usr/local/lib/ocaml/caml/config.h /usr/local/lib/ocaml/caml/misc.h \ + /usr/local/lib/ocaml/caml/alloc.h kernel/byterun/coq_instruct.h \ kernel/byterun/coq_fix_code.h kernel/byterun/coq_memory.h \ - /usr/lib/ocaml/caml/fail.h /usr/lib/ocaml/caml/memory.h + /usr/local/lib/ocaml/caml/fail.h /usr/local/lib/ocaml/caml/memory.h coq_values.d.o: kernel/byterun/coq_values.c kernel/byterun/coq_fix_code.h \ - /usr/lib/ocaml/caml/mlvalues.h /usr/lib/ocaml/caml/compatibility.h \ - /usr/lib/ocaml/caml/config.h /usr/lib/ocaml/caml/misc.h \ + /usr/local/lib/ocaml/caml/mlvalues.h \ + /usr/local/lib/ocaml/caml/compatibility.h \ + /usr/local/lib/ocaml/caml/config.h /usr/local/lib/ocaml/caml/misc.h \ kernel/byterun/coq_instruct.h kernel/byterun/coq_memory.h \ - /usr/lib/ocaml/caml/fail.h /usr/lib/ocaml/caml/memory.h \ - kernel/byterun/coq_values.h /usr/lib/ocaml/caml/alloc.h + /usr/local/lib/ocaml/caml/fail.h /usr/local/lib/ocaml/caml/memory.h \ + kernel/byterun/coq_values.h /usr/local/lib/ocaml/caml/alloc.h diff --git a/.depend.coq b/.depend.coq index 9f5a2674..949cc501 100644 --- a/.depend.coq +++ b/.depend.coq @@ -1,3 +1,31 @@ +theories/FSets/OrderedType.vo: theories/FSets/OrderedType.v theories/Lists/SetoidList.vo +theories/FSets/OrderedTypeEx.vo: theories/FSets/OrderedTypeEx.v theories/FSets/OrderedType.vo theories/ZArith/ZArith.vo contrib/omega/Omega.vo theories/NArith/NArith.vo theories/NArith/Ndec.vo theories/Arith/Compare_dec.vo +theories/FSets/OrderedTypeAlt.vo: theories/FSets/OrderedTypeAlt.v theories/FSets/OrderedType.vo +theories/FSets/FSetInterface.vo: theories/FSets/FSetInterface.v theories/Bool/Bool.vo theories/FSets/OrderedType.vo +theories/FSets/FSetList.vo: theories/FSets/FSetList.v theories/FSets/FSetInterface.vo +theories/FSets/FSetBridge.vo: theories/FSets/FSetBridge.v theories/FSets/FSetInterface.vo +theories/FSets/FSetFacts.vo: theories/FSets/FSetFacts.v theories/FSets/FSetInterface.vo +theories/FSets/FSetProperties.vo: theories/FSets/FSetProperties.v theories/FSets/FSetInterface.vo theories/FSets/FSetFacts.vo +theories/FSets/FSetEqProperties.vo: theories/FSets/FSetEqProperties.v theories/FSets/FSetProperties.vo theories/Bool/Zerob.vo theories/Bool/Sumbool.vo contrib/omega/Omega.vo +theories/FSets/FSets.vo: theories/FSets/FSets.v theories/FSets/OrderedType.vo theories/FSets/OrderedTypeEx.vo theories/FSets/OrderedTypeAlt.vo theories/FSets/FSetInterface.vo theories/FSets/FSetBridge.vo theories/FSets/FSetProperties.vo theories/FSets/FSetEqProperties.vo theories/FSets/FSetList.vo +theories/FSets/FSetWeakProperties.vo: theories/FSets/FSetWeakProperties.v theories/FSets/FSetWeakInterface.vo theories/FSets/FSetWeakFacts.vo +theories/FSets/FSetWeakInterface.vo: theories/FSets/FSetWeakInterface.v theories/Bool/Bool.vo theories/Logic/DecidableType.vo +theories/FSets/FSetWeakList.vo: theories/FSets/FSetWeakList.v theories/FSets/FSetWeakInterface.vo +theories/FSets/FSetWeakFacts.vo: theories/FSets/FSetWeakFacts.v theories/FSets/FSetWeakInterface.vo +theories/FSets/FSetWeak.vo: theories/FSets/FSetWeak.v theories/Logic/DecidableType.vo theories/Logic/DecidableTypeEx.vo theories/FSets/FSetWeakInterface.vo theories/FSets/FSetFacts.vo theories/FSets/FSetProperties.vo theories/FSets/FSetWeakList.vo +theories/FSets/FMapInterface.vo: theories/FSets/FMapInterface.v theories/FSets/FSetInterface.vo +theories/FSets/FMapList.vo: theories/FSets/FMapList.v theories/FSets/FSetInterface.vo theories/FSets/FMapInterface.vo +theories/FSets/FMaps.vo: theories/FSets/FMaps.v theories/FSets/OrderedType.vo theories/FSets/OrderedTypeEx.vo theories/FSets/OrderedTypeAlt.vo theories/FSets/FMapInterface.vo theories/FSets/FMapList.vo theories/FSets/FMapPositive.vo theories/FSets/FMapIntMap.vo theories/FSets/FMapFacts.vo +theories/FSets/FMapFacts.vo: theories/FSets/FMapFacts.v theories/Bool/Bool.vo theories/FSets/OrderedType.vo theories/FSets/FMapInterface.vo +theories/FSets/FMapWeakFacts.vo: theories/FSets/FMapWeakFacts.v theories/Bool/Bool.vo theories/FSets/OrderedType.vo theories/FSets/FMapWeakInterface.vo +theories/FSets/FMapWeakInterface.vo: theories/FSets/FMapWeakInterface.v theories/FSets/FSetInterface.vo theories/FSets/FSetWeakInterface.vo +theories/FSets/FMapWeakList.vo: theories/FSets/FMapWeakList.v theories/FSets/FSetInterface.vo theories/FSets/FSetWeakInterface.vo theories/FSets/FMapWeakInterface.vo +theories/FSets/FMapWeak.vo: theories/FSets/FMapWeak.v theories/Logic/DecidableType.vo theories/Logic/DecidableTypeEx.vo theories/FSets/FMapWeakInterface.vo theories/FSets/FMapWeakList.vo theories/FSets/FMapWeakFacts.vo +theories/FSets/FMapPositive.vo: theories/FSets/FMapPositive.v theories/ZArith/ZArith.vo theories/FSets/OrderedType.vo theories/FSets/FMapInterface.vo +theories/FSets/FMapIntMap.vo: theories/FSets/FMapIntMap.v theories/Bool/Bool.vo theories/NArith/NArith.vo theories/NArith/Ndigits.vo theories/NArith/Ndec.vo theories/NArith/Nnat.vo theories/IntMap/Allmaps.vo theories/FSets/OrderedType.vo theories/FSets/OrderedTypeEx.vo theories/FSets/FMapInterface.vo theories/FSets/FMapList.vo +theories/FSets/FSetToFiniteSet.vo: theories/FSets/FSetToFiniteSet.v theories/Sets/Ensembles.vo theories/Sets/Finite_sets.vo theories/FSets/FSetInterface.vo theories/FSets/FSetProperties.vo theories/FSets/OrderedTypeEx.vo +theories/FSets/FMapAVL.vo: theories/FSets/FMapAVL.v theories/FSets/FSetInterface.vo theories/FSets/FMapInterface.vo theories/FSets/FMapList.vo theories/ZArith/ZArith.vo theories/ZArith/Int.vo +theories/FSets/FSetAVL.vo: theories/FSets/FSetAVL.v theories/FSets/FSetInterface.vo theories/FSets/FSetList.vo theories/ZArith/ZArith.vo theories/ZArith/Int.vo theories/Reals/Rdefinitions.vo: theories/Reals/Rdefinitions.v theories/ZArith/ZArith_base.vo theories/Reals/Raxioms.vo: theories/Reals/Raxioms.v theories/ZArith/ZArith_base.vo theories/Reals/Rdefinitions.vo theories/Reals/RIneq.vo: theories/Reals/RIneq.v theories/Reals/Raxioms.vo contrib/ring/ZArithRing.vo contrib/omega/Omega.vo contrib/field/Field.vo @@ -75,20 +103,24 @@ theories/Logic/Classical.vo: theories/Logic/Classical.v theories/Logic/Classical theories/Logic/Classical_Type.vo: theories/Logic/Classical_Type.v theories/Logic/Classical_Prop.vo theories/Logic/Classical_Pred_Type.vo theories/Logic/Classical_Pred_Set.vo: theories/Logic/Classical_Pred_Set.v theories/Logic/Classical_Pred_Type.vo theories/Logic/Eqdep.vo: theories/Logic/Eqdep.v theories/Logic/EqdepFacts.vo -theories/Logic/Classical_Pred_Type.vo: theories/Logic/Classical_Pred_Type.v theories/Logic/Classical_Prop.vo theories/Logic/Classical_Prop.vo: theories/Logic/Classical_Prop.v theories/Logic/ClassicalFacts.vo theories/Logic/EqdepFacts.vo +theories/Logic/Classical_Pred_Type.vo: theories/Logic/Classical_Pred_Type.v theories/Logic/Classical_Prop.vo theories/Logic/ClassicalFacts.vo: theories/Logic/ClassicalFacts.v theories/Logic/Hurkens.vo -theories/Logic/ChoiceFacts.vo: theories/Logic/ChoiceFacts.v theories/Arith/Wf_nat.vo theories/Arith/Compare_dec.vo theories/Logic/Decidable.vo theories/Arith/Arith.vo +theories/Logic/ChoiceFacts.vo: theories/Logic/ChoiceFacts.v theories/Arith/Wf_nat.vo theories/Arith/Compare_dec.vo theories/Logic/Decidable.vo theories/Arith/Arith.vo theories/Setoids/Setoid.vo theories/Logic/Berardi.vo: theories/Logic/Berardi.v theories/Logic/Eqdep_dec.vo: theories/Logic/Eqdep_dec.v theories/Logic/EqdepFacts.vo theories/Logic/Decidable.vo: theories/Logic/Decidable.v theories/Logic/JMeq.vo: theories/Logic/JMeq.v theories/Logic/Eqdep.vo -theories/Logic/ClassicalDescription.vo: theories/Logic/ClassicalDescription.v theories/Logic/Classical.vo -theories/Logic/ClassicalChoice.vo: theories/Logic/ClassicalChoice.v theories/Logic/ClassicalDescription.vo theories/Logic/RelationalChoice.vo theories/Logic/ChoiceFacts.vo +theories/Logic/ClassicalChoice.vo: theories/Logic/ClassicalChoice.v theories/Logic/ClassicalUniqueChoice.vo theories/Logic/RelationalChoice.vo theories/Logic/ChoiceFacts.vo +theories/Logic/ClassicalDescription.vo: theories/Logic/ClassicalDescription.v theories/Logic/Classical.vo theories/Logic/ChoiceFacts.vo theories/Setoids/Setoid.vo theories/Logic/RelationalChoice.vo: theories/Logic/RelationalChoice.v theories/Logic/Diaconescu.vo: theories/Logic/Diaconescu.v theories/Logic/ClassicalFacts.vo theories/Logic/ChoiceFacts.vo theories/Bool/Bool.vo theories/Logic/EqdepFacts.vo: theories/Logic/EqdepFacts.v theories/Logic/ProofIrrelevanceFacts.vo: theories/Logic/ProofIrrelevanceFacts.v theories/Logic/EqdepFacts.vo +theories/Logic/ClassicalEpsilon.vo: theories/Logic/ClassicalEpsilon.v theories/Logic/Classical.vo theories/Logic/ChoiceFacts.vo +theories/Logic/ClassicalUniqueChoice.vo: theories/Logic/ClassicalUniqueChoice.v theories/Logic/Classical.vo theories/Setoids/Setoid.vo +theories/Logic/DecidableType.vo: theories/Logic/DecidableType.v theories/Lists/SetoidList.vo +theories/Logic/DecidableTypeEx.vo: theories/Logic/DecidableTypeEx.v theories/Logic/DecidableType.vo theories/FSets/OrderedType.vo theories/FSets/OrderedTypeEx.vo theories/Arith/Arith.vo: theories/Arith/Arith.v theories/Arith/Le.vo theories/Arith/Lt.vo theories/Arith/Plus.vo theories/Arith/Gt.vo theories/Arith/Minus.vo theories/Arith/Mult.vo theories/Arith/Between.vo theories/Arith/Peano_dec.vo theories/Arith/Compare_dec.vo theories/Arith/Factorial.vo theories/Arith/Gt.vo: theories/Arith/Gt.v theories/Arith/Le.vo theories/Arith/Lt.vo theories/Arith/Plus.vo theories/Arith/Between.vo: theories/Arith/Between.v theories/Arith/Le.vo theories/Arith/Lt.vo @@ -120,6 +152,10 @@ theories/NArith/BinPos.vo: theories/NArith/BinPos.v theories/NArith/Pnat.vo: theories/NArith/Pnat.v theories/NArith/BinPos.vo theories/Arith/Le.vo theories/Arith/Lt.vo theories/Arith/Gt.vo theories/Arith/Plus.vo theories/Arith/Mult.vo theories/Arith/Minus.vo theories/NArith/BinNat.vo: theories/NArith/BinNat.v theories/NArith/BinPos.vo theories/NArith/NArith.vo: theories/NArith/NArith.v theories/NArith/BinPos.vo theories/NArith/BinNat.vo +theories/NArith/Nnat.vo: theories/NArith/Nnat.v theories/Arith/Arith.vo theories/Arith/Compare_dec.vo theories/Bool/Sumbool.vo theories/Arith/Div2.vo theories/NArith/BinPos.vo theories/NArith/BinNat.vo theories/NArith/Pnat.vo +theories/NArith/Ndigits.vo: theories/NArith/Ndigits.v theories/Bool/Bool.vo theories/Bool/Bvector.vo theories/NArith/BinPos.vo theories/NArith/BinNat.vo +theories/NArith/Ndec.vo: theories/NArith/Ndec.v theories/Bool/Bool.vo theories/Bool/Sumbool.vo theories/Arith/Arith.vo theories/NArith/BinPos.vo theories/NArith/BinNat.vo theories/NArith/Pnat.vo theories/NArith/Nnat.vo theories/NArith/Ndigits.vo +theories/NArith/Ndist.vo: theories/NArith/Ndist.v theories/Arith/Arith.vo theories/Arith/Min.vo theories/NArith/BinPos.vo theories/NArith/BinNat.vo theories/NArith/Ndigits.vo theories/ZArith/BinInt.vo: theories/ZArith/BinInt.v theories/NArith/BinPos.vo theories/NArith/Pnat.vo theories/NArith/BinNat.vo theories/Arith/Plus.vo theories/Arith/Mult.vo theories/ZArith/Wf_Z.vo: theories/ZArith/Wf_Z.v theories/ZArith/BinInt.vo theories/ZArith/Zcompare.vo theories/ZArith/Zorder.vo theories/ZArith/Znat.vo theories/ZArith/Zmisc.vo theories/Arith/Wf_nat.vo theories/ZArith/ZArith.vo: theories/ZArith/ZArith.v theories/ZArith/ZArith_base.vo theories/ZArith/Zcomplements.vo theories/ZArith/Zsqrt.vo theories/ZArith/Zpower.vo theories/ZArith/Zdiv.vo theories/ZArith/Zlogarithm.vo @@ -132,7 +168,7 @@ theories/ZArith/Zorder.vo: theories/ZArith/Zorder.v theories/NArith/BinPos.vo th theories/ZArith/Zabs.vo: theories/ZArith/Zabs.v theories/Arith/Arith.vo theories/NArith/BinPos.vo theories/ZArith/BinInt.vo theories/ZArith/Zorder.vo theories/ZArith/ZArith_dec.vo theories/ZArith/Zmin.vo: theories/ZArith/Zmin.v theories/Arith/Arith.vo theories/ZArith/BinInt.vo theories/ZArith/Zcompare.vo theories/ZArith/Zorder.vo theories/ZArith/Zmax.vo: theories/ZArith/Zmax.v theories/Arith/Arith.vo theories/ZArith/BinInt.vo theories/ZArith/Zcompare.vo theories/ZArith/Zorder.vo -theories/ZArith/Zminmax.vo: theories/ZArith/Zminmax.v theories/ZArith/Zmin.vo theories/ZArith/BinInt.vo +theories/ZArith/Zminmax.vo: theories/ZArith/Zminmax.v theories/ZArith/Zmin.vo theories/ZArith/Zmax.vo theories/ZArith/BinInt.vo theories/ZArith/Zorder.vo theories/ZArith/Zeven.vo: theories/ZArith/Zeven.v theories/ZArith/BinInt.vo theories/ZArith/Zhints.vo: theories/ZArith/Zhints.v theories/ZArith/BinInt.vo theories/ZArith/Zorder.vo theories/ZArith/Zmin.vo theories/ZArith/Zabs.vo theories/ZArith/Zcompare.vo theories/ZArith/Znat.vo theories/ZArith/auxiliary.vo theories/ZArith/Zmisc.vo theories/ZArith/Wf_Z.vo theories/ZArith/Zlogarithm.vo: theories/ZArith/Zlogarithm.v theories/ZArith/ZArith_base.vo contrib/omega/Omega.vo theories/ZArith/Zcomplements.vo theories/ZArith/Zpower.vo @@ -145,11 +181,13 @@ theories/ZArith/ZArith_base.vo: theories/ZArith/ZArith_base.v theories/NArith/Bi theories/ZArith/Zbool.vo: theories/ZArith/Zbool.v theories/ZArith/BinInt.vo theories/ZArith/Zeven.vo theories/ZArith/Zorder.vo theories/ZArith/Zcompare.vo theories/ZArith/ZArith_dec.vo theories/Bool/Sumbool.vo theories/ZArith/Zbinary.vo: theories/ZArith/Zbinary.v theories/Bool/Bvector.vo theories/ZArith/ZArith.vo theories/ZArith/Zpower.vo contrib/omega/Omega.vo theories/ZArith/Znumtheory.vo: theories/ZArith/Znumtheory.v theories/ZArith/ZArith_base.vo contrib/ring/ZArithRing.vo theories/ZArith/Zcomplements.vo theories/ZArith/Zdiv.vo +theories/ZArith/Int.vo: theories/ZArith/Int.v theories/ZArith/ZArith.vo contrib/romega/ROmega.vo +theories/Setoids/Setoid.vo: theories/Setoids/Setoid.v theories/Relations/Relation_Definitions.vo theories/Lists/MonoList.vo: theories/Lists/MonoList.v theories/Arith/Le.vo theories/Lists/ListSet.vo: theories/Lists/ListSet.v theories/Lists/List.vo theories/Lists/Streams.vo: theories/Lists/Streams.v theories/Lists/TheoryList.vo: theories/Lists/TheoryList.v theories/Lists/List.vo theories/Arith/Le.vo theories/Arith/Lt.vo theories/Arith/Minus.vo theories/Bool/DecBool.vo -theories/Lists/List.vo: theories/Lists/List.v theories/Arith/Le.vo +theories/Lists/List.vo: theories/Lists/List.v theories/Arith/Le.vo theories/Arith/Gt.vo theories/Arith/Minus.vo theories/Arith/Min.vo theories/Bool/Bool.vo theories/Setoids/Setoid.vo theories/Lists/SetoidList.vo: theories/Lists/SetoidList.v theories/Lists/List.vo theories/Sorting/Sorting.vo theories/Setoids/Setoid.vo theories/Strings/Ascii.vo: theories/Strings/Ascii.v theories/Bool/Bool.vo theories/NArith/BinPos.vo theories/Strings/String.vo: theories/Strings/String.v theories/Arith/Arith.vo theories/Strings/Ascii.vo @@ -175,41 +213,47 @@ theories/Sets/Multiset.vo: theories/Sets/Multiset.v theories/Sets/Permut.vo theo theories/Sets/Relations_3_facts.vo: theories/Sets/Relations_3_facts.v theories/Sets/Relations_1.vo theories/Sets/Relations_1_facts.vo theories/Sets/Relations_2.vo theories/Sets/Relations_2_facts.vo theories/Sets/Relations_3.vo theories/Sets/Partial_Order.vo: theories/Sets/Partial_Order.v theories/Sets/Ensembles.vo theories/Sets/Relations_1.vo theories/Sets/Uniset.vo: theories/Sets/Uniset.v theories/Bool/Bool.vo theories/Sets/Permut.vo -theories/FSets/DecidableType.vo: theories/FSets/DecidableType.v theories/Lists/SetoidList.vo theories/FSets/OrderedType.vo: theories/FSets/OrderedType.v theories/Lists/SetoidList.vo +theories/FSets/OrderedTypeEx.vo: theories/FSets/OrderedTypeEx.v theories/FSets/OrderedType.vo theories/ZArith/ZArith.vo contrib/omega/Omega.vo theories/NArith/NArith.vo theories/NArith/Ndec.vo theories/Arith/Compare_dec.vo +theories/FSets/OrderedTypeAlt.vo: theories/FSets/OrderedTypeAlt.v theories/FSets/OrderedType.vo theories/FSets/FSetInterface.vo: theories/FSets/FSetInterface.v theories/Bool/Bool.vo theories/FSets/OrderedType.vo theories/FSets/FSetList.vo: theories/FSets/FSetList.v theories/FSets/FSetInterface.vo theories/FSets/FSetBridge.vo: theories/FSets/FSetBridge.v theories/FSets/FSetInterface.vo theories/FSets/FSetFacts.vo: theories/FSets/FSetFacts.v theories/FSets/FSetInterface.vo theories/FSets/FSetProperties.vo: theories/FSets/FSetProperties.v theories/FSets/FSetInterface.vo theories/FSets/FSetFacts.vo theories/FSets/FSetEqProperties.vo: theories/FSets/FSetEqProperties.v theories/FSets/FSetProperties.vo theories/Bool/Zerob.vo theories/Bool/Sumbool.vo contrib/omega/Omega.vo -theories/FSets/FSets.vo: theories/FSets/FSets.v theories/FSets/OrderedType.vo theories/FSets/FSetInterface.vo theories/FSets/FSetBridge.vo theories/FSets/FSetProperties.vo theories/FSets/FSetEqProperties.vo theories/FSets/FSetList.vo -theories/FSets/FSetWeakInterface.vo: theories/FSets/FSetWeakInterface.v theories/Bool/Bool.vo theories/FSets/DecidableType.vo +theories/FSets/FSets.vo: theories/FSets/FSets.v theories/FSets/OrderedType.vo theories/FSets/OrderedTypeEx.vo theories/FSets/OrderedTypeAlt.vo theories/FSets/FSetInterface.vo theories/FSets/FSetBridge.vo theories/FSets/FSetProperties.vo theories/FSets/FSetEqProperties.vo theories/FSets/FSetList.vo +theories/FSets/FSetWeakProperties.vo: theories/FSets/FSetWeakProperties.v theories/FSets/FSetWeakInterface.vo theories/FSets/FSetWeakFacts.vo +theories/FSets/FSetWeakInterface.vo: theories/FSets/FSetWeakInterface.v theories/Bool/Bool.vo theories/Logic/DecidableType.vo theories/FSets/FSetWeakList.vo: theories/FSets/FSetWeakList.v theories/FSets/FSetWeakInterface.vo theories/FSets/FSetWeakFacts.vo: theories/FSets/FSetWeakFacts.v theories/FSets/FSetWeakInterface.vo -theories/FSets/FSetWeak.vo: theories/FSets/FSetWeak.v theories/FSets/DecidableType.vo theories/FSets/FSetWeakInterface.vo theories/FSets/FSetFacts.vo theories/FSets/FSetWeakList.vo +theories/FSets/FSetWeak.vo: theories/FSets/FSetWeak.v theories/Logic/DecidableType.vo theories/Logic/DecidableTypeEx.vo theories/FSets/FSetWeakInterface.vo theories/FSets/FSetFacts.vo theories/FSets/FSetProperties.vo theories/FSets/FSetWeakList.vo theories/FSets/FMapInterface.vo: theories/FSets/FMapInterface.v theories/FSets/FSetInterface.vo theories/FSets/FMapList.vo: theories/FSets/FMapList.v theories/FSets/FSetInterface.vo theories/FSets/FMapInterface.vo -theories/FSets/FMaps.vo: theories/FSets/FMaps.v theories/FSets/FMapInterface.vo theories/FSets/FMapList.vo +theories/FSets/FMaps.vo: theories/FSets/FMaps.v theories/FSets/OrderedType.vo theories/FSets/OrderedTypeEx.vo theories/FSets/OrderedTypeAlt.vo theories/FSets/FMapInterface.vo theories/FSets/FMapList.vo theories/FSets/FMapPositive.vo theories/FSets/FMapIntMap.vo theories/FSets/FMapFacts.vo +theories/FSets/FMapFacts.vo: theories/FSets/FMapFacts.v theories/Bool/Bool.vo theories/FSets/OrderedType.vo theories/FSets/FMapInterface.vo +theories/FSets/FMapWeakFacts.vo: theories/FSets/FMapWeakFacts.v theories/Bool/Bool.vo theories/FSets/OrderedType.vo theories/FSets/FMapWeakInterface.vo theories/FSets/FMapWeakInterface.vo: theories/FSets/FMapWeakInterface.v theories/FSets/FSetInterface.vo theories/FSets/FSetWeakInterface.vo theories/FSets/FMapWeakList.vo: theories/FSets/FMapWeakList.v theories/FSets/FSetInterface.vo theories/FSets/FSetWeakInterface.vo theories/FSets/FMapWeakInterface.vo -theories/FSets/FMapWeak.vo: theories/FSets/FMapWeak.v theories/FSets/FMapWeakInterface.vo theories/FSets/FMapWeakList.vo -theories/IntMap/Adalloc.vo: theories/IntMap/Adalloc.v theories/Bool/Bool.vo theories/Bool/Sumbool.vo theories/ZArith/ZArith.vo theories/Arith/Arith.vo theories/IntMap/Addr.vo theories/IntMap/Adist.vo theories/IntMap/Addec.vo theories/IntMap/Map.vo theories/IntMap/Fset.vo -theories/IntMap/Mapcanon.vo: theories/IntMap/Mapcanon.v theories/Bool/Bool.vo theories/Bool/Sumbool.vo theories/Arith/Arith.vo theories/ZArith/ZArith.vo theories/IntMap/Addr.vo theories/IntMap/Adist.vo theories/IntMap/Addec.vo theories/IntMap/Map.vo theories/IntMap/Mapaxioms.vo theories/IntMap/Mapiter.vo theories/IntMap/Fset.vo theories/Lists/List.vo theories/IntMap/Lsort.vo theories/IntMap/Mapsubset.vo theories/IntMap/Mapcard.vo -theories/IntMap/Addec.vo: theories/IntMap/Addec.v theories/Bool/Bool.vo theories/Bool/Sumbool.vo theories/ZArith/ZArith.vo theories/IntMap/Addr.vo -theories/IntMap/Mapcard.vo: theories/IntMap/Mapcard.v theories/Bool/Bool.vo theories/Bool/Sumbool.vo theories/Arith/Arith.vo theories/ZArith/ZArith.vo theories/IntMap/Addr.vo theories/IntMap/Adist.vo theories/IntMap/Addec.vo theories/IntMap/Map.vo theories/IntMap/Mapaxioms.vo theories/IntMap/Mapiter.vo theories/IntMap/Fset.vo theories/IntMap/Mapsubset.vo theories/Lists/List.vo theories/IntMap/Lsort.vo theories/Arith/Peano_dec.vo -theories/IntMap/Addr.vo: theories/IntMap/Addr.v theories/Bool/Bool.vo theories/NArith/NArith.vo theories/ZArith/ZArith.vo -theories/IntMap/Mapc.vo: theories/IntMap/Mapc.v theories/Bool/Bool.vo theories/Bool/Sumbool.vo theories/Arith/Arith.vo theories/ZArith/ZArith.vo theories/IntMap/Addr.vo theories/IntMap/Adist.vo theories/IntMap/Addec.vo theories/IntMap/Map.vo theories/IntMap/Mapaxioms.vo theories/IntMap/Fset.vo theories/IntMap/Mapiter.vo theories/IntMap/Mapsubset.vo theories/Lists/List.vo theories/IntMap/Lsort.vo theories/IntMap/Mapcard.vo theories/IntMap/Mapcanon.vo -theories/IntMap/Adist.vo: theories/IntMap/Adist.v theories/Bool/Bool.vo theories/ZArith/ZArith.vo theories/Arith/Arith.vo theories/Arith/Min.vo theories/IntMap/Addr.vo -theories/IntMap/Mapfold.vo: theories/IntMap/Mapfold.v theories/Bool/Bool.vo theories/Bool/Sumbool.vo theories/ZArith/ZArith.vo theories/IntMap/Addr.vo theories/IntMap/Adist.vo theories/IntMap/Addec.vo theories/IntMap/Map.vo theories/IntMap/Fset.vo theories/IntMap/Mapaxioms.vo theories/IntMap/Mapiter.vo theories/IntMap/Lsort.vo theories/IntMap/Mapsubset.vo theories/Lists/List.vo -theories/IntMap/Allmaps.vo: theories/IntMap/Allmaps.v theories/IntMap/Addr.vo theories/IntMap/Adist.vo theories/IntMap/Addec.vo theories/IntMap/Map.vo theories/IntMap/Fset.vo theories/IntMap/Mapaxioms.vo theories/IntMap/Mapiter.vo theories/IntMap/Mapsubset.vo theories/IntMap/Lsort.vo theories/IntMap/Mapfold.vo theories/IntMap/Mapcard.vo theories/IntMap/Mapcanon.vo theories/IntMap/Mapc.vo theories/IntMap/Maplists.vo theories/IntMap/Adalloc.vo -theories/IntMap/Mapiter.vo: theories/IntMap/Mapiter.v theories/Bool/Bool.vo theories/Bool/Sumbool.vo theories/ZArith/ZArith.vo theories/IntMap/Addr.vo theories/IntMap/Adist.vo theories/IntMap/Addec.vo theories/IntMap/Map.vo theories/IntMap/Mapaxioms.vo theories/IntMap/Fset.vo theories/Lists/List.vo -theories/IntMap/Fset.vo: theories/IntMap/Fset.v theories/Bool/Bool.vo theories/Bool/Sumbool.vo theories/ZArith/ZArith.vo theories/IntMap/Addr.vo theories/IntMap/Adist.vo theories/IntMap/Addec.vo theories/IntMap/Map.vo -theories/IntMap/Maplists.vo: theories/IntMap/Maplists.v theories/IntMap/Addr.vo theories/IntMap/Addec.vo theories/IntMap/Map.vo theories/IntMap/Fset.vo theories/IntMap/Mapaxioms.vo theories/IntMap/Mapsubset.vo theories/IntMap/Mapcard.vo theories/IntMap/Mapcanon.vo theories/IntMap/Mapc.vo theories/Bool/Bool.vo theories/Bool/Sumbool.vo theories/Lists/List.vo theories/Arith/Arith.vo theories/IntMap/Mapiter.vo theories/IntMap/Mapfold.vo -theories/IntMap/Lsort.vo: theories/IntMap/Lsort.v theories/Bool/Bool.vo theories/Bool/Sumbool.vo theories/Arith/Arith.vo theories/ZArith/ZArith.vo theories/IntMap/Addr.vo theories/IntMap/Adist.vo theories/IntMap/Addec.vo theories/IntMap/Map.vo theories/Lists/List.vo theories/IntMap/Mapiter.vo -theories/IntMap/Mapsubset.vo: theories/IntMap/Mapsubset.v theories/Bool/Bool.vo theories/Bool/Sumbool.vo theories/Arith/Arith.vo theories/ZArith/ZArith.vo theories/IntMap/Addr.vo theories/IntMap/Adist.vo theories/IntMap/Addec.vo theories/IntMap/Map.vo theories/IntMap/Fset.vo theories/IntMap/Mapaxioms.vo theories/IntMap/Mapiter.vo -theories/IntMap/Mapaxioms.vo: theories/IntMap/Mapaxioms.v theories/Bool/Bool.vo theories/Bool/Sumbool.vo theories/ZArith/ZArith.vo theories/IntMap/Addr.vo theories/IntMap/Adist.vo theories/IntMap/Addec.vo theories/IntMap/Map.vo theories/IntMap/Fset.vo -theories/IntMap/Map.vo: theories/IntMap/Map.v theories/Bool/Bool.vo theories/Bool/Sumbool.vo theories/ZArith/ZArith.vo theories/IntMap/Addr.vo theories/IntMap/Adist.vo theories/IntMap/Addec.vo +theories/FSets/FMapWeak.vo: theories/FSets/FMapWeak.v theories/Logic/DecidableType.vo theories/Logic/DecidableTypeEx.vo theories/FSets/FMapWeakInterface.vo theories/FSets/FMapWeakList.vo theories/FSets/FMapWeakFacts.vo +theories/FSets/FMapPositive.vo: theories/FSets/FMapPositive.v theories/ZArith/ZArith.vo theories/FSets/OrderedType.vo theories/FSets/FMapInterface.vo +theories/FSets/FMapIntMap.vo: theories/FSets/FMapIntMap.v theories/Bool/Bool.vo theories/NArith/NArith.vo theories/NArith/Ndigits.vo theories/NArith/Ndec.vo theories/NArith/Nnat.vo theories/IntMap/Allmaps.vo theories/FSets/OrderedType.vo theories/FSets/OrderedTypeEx.vo theories/FSets/FMapInterface.vo theories/FSets/FMapList.vo +theories/FSets/FSetToFiniteSet.vo: theories/FSets/FSetToFiniteSet.v theories/Sets/Ensembles.vo theories/Sets/Finite_sets.vo theories/FSets/FSetInterface.vo theories/FSets/FSetProperties.vo theories/FSets/OrderedTypeEx.vo +theories/FSets/FMapAVL.vo: theories/FSets/FMapAVL.v theories/FSets/FSetInterface.vo theories/FSets/FMapInterface.vo theories/FSets/FMapList.vo theories/ZArith/ZArith.vo theories/ZArith/Int.vo +theories/FSets/FSetAVL.vo: theories/FSets/FSetAVL.v theories/FSets/FSetInterface.vo theories/FSets/FSetList.vo theories/ZArith/ZArith.vo theories/ZArith/Int.vo +theories/IntMap/Adalloc.vo: theories/IntMap/Adalloc.v theories/Bool/Bool.vo theories/Bool/Sumbool.vo theories/Arith/Arith.vo theories/NArith/NArith.vo theories/NArith/Ndigits.vo theories/NArith/Ndec.vo theories/NArith/Nnat.vo theories/IntMap/Map.vo theories/IntMap/Fset.vo +theories/IntMap/Mapcanon.vo: theories/IntMap/Mapcanon.v theories/Bool/Bool.vo theories/Bool/Sumbool.vo theories/Arith/Arith.vo theories/NArith/NArith.vo theories/NArith/Ndigits.vo theories/NArith/Ndec.vo theories/IntMap/Map.vo theories/IntMap/Mapaxioms.vo theories/IntMap/Mapiter.vo theories/IntMap/Fset.vo theories/Lists/List.vo theories/IntMap/Lsort.vo theories/IntMap/Mapsubset.vo theories/IntMap/Mapcard.vo +theories/IntMap/Mapfold.vo: theories/IntMap/Mapfold.v theories/Bool/Bool.vo theories/Bool/Sumbool.vo theories/NArith/NArith.vo theories/NArith/Ndigits.vo theories/NArith/Ndec.vo theories/IntMap/Map.vo theories/IntMap/Fset.vo theories/IntMap/Mapaxioms.vo theories/IntMap/Mapiter.vo theories/IntMap/Lsort.vo theories/IntMap/Mapsubset.vo theories/Lists/List.vo +theories/IntMap/Mapcard.vo: theories/IntMap/Mapcard.v theories/Bool/Bool.vo theories/Bool/Sumbool.vo theories/Arith/Arith.vo theories/NArith/NArith.vo theories/NArith/Ndigits.vo theories/NArith/Ndec.vo theories/IntMap/Map.vo theories/IntMap/Mapaxioms.vo theories/IntMap/Mapiter.vo theories/IntMap/Fset.vo theories/IntMap/Mapsubset.vo theories/Lists/List.vo theories/IntMap/Lsort.vo theories/Arith/Peano_dec.vo +theories/IntMap/Mapc.vo: theories/IntMap/Mapc.v theories/Bool/Bool.vo theories/Bool/Sumbool.vo theories/Arith/Arith.vo theories/NArith/NArith.vo theories/IntMap/Map.vo theories/IntMap/Mapaxioms.vo theories/IntMap/Fset.vo theories/IntMap/Mapiter.vo theories/IntMap/Mapsubset.vo theories/Lists/List.vo theories/IntMap/Lsort.vo theories/IntMap/Mapcard.vo theories/IntMap/Mapcanon.vo +theories/IntMap/Allmaps.vo: theories/IntMap/Allmaps.v theories/IntMap/Map.vo theories/IntMap/Fset.vo theories/IntMap/Mapaxioms.vo theories/IntMap/Mapiter.vo theories/IntMap/Mapsubset.vo theories/IntMap/Lsort.vo theories/IntMap/Mapfold.vo theories/IntMap/Mapcard.vo theories/IntMap/Mapcanon.vo theories/IntMap/Mapc.vo theories/IntMap/Maplists.vo theories/IntMap/Adalloc.vo +theories/IntMap/Mapiter.vo: theories/IntMap/Mapiter.v theories/Bool/Bool.vo theories/Bool/Sumbool.vo theories/NArith/NArith.vo theories/NArith/Ndigits.vo theories/NArith/Ndec.vo theories/IntMap/Map.vo theories/IntMap/Mapaxioms.vo theories/IntMap/Fset.vo theories/Lists/List.vo +theories/IntMap/Fset.vo: theories/IntMap/Fset.v theories/Bool/Bool.vo theories/Bool/Sumbool.vo theories/NArith/NArith.vo theories/NArith/Ndigits.vo theories/NArith/Ndec.vo theories/IntMap/Map.vo +theories/IntMap/Maplists.vo: theories/IntMap/Maplists.v theories/NArith/BinNat.vo theories/NArith/Ndigits.vo theories/NArith/Ndec.vo theories/IntMap/Map.vo theories/IntMap/Fset.vo theories/IntMap/Mapaxioms.vo theories/IntMap/Mapsubset.vo theories/IntMap/Mapcard.vo theories/IntMap/Mapcanon.vo theories/IntMap/Mapc.vo theories/Bool/Bool.vo theories/Bool/Sumbool.vo theories/Lists/List.vo theories/Arith/Arith.vo theories/IntMap/Mapiter.vo theories/IntMap/Mapfold.vo +theories/IntMap/Lsort.vo: theories/IntMap/Lsort.v theories/Bool/Bool.vo theories/Bool/Sumbool.vo theories/Arith/Arith.vo theories/NArith/NArith.vo theories/NArith/Ndigits.vo theories/NArith/Ndec.vo theories/IntMap/Map.vo theories/Lists/List.vo theories/IntMap/Mapiter.vo +theories/IntMap/Mapsubset.vo: theories/IntMap/Mapsubset.v theories/Bool/Bool.vo theories/Bool/Sumbool.vo theories/Arith/Arith.vo theories/NArith/NArith.vo theories/NArith/Ndigits.vo theories/NArith/Ndec.vo theories/IntMap/Map.vo theories/IntMap/Fset.vo theories/IntMap/Mapaxioms.vo theories/IntMap/Mapiter.vo +theories/IntMap/Mapaxioms.vo: theories/IntMap/Mapaxioms.v theories/Bool/Bool.vo theories/Bool/Sumbool.vo theories/NArith/NArith.vo theories/NArith/Ndigits.vo theories/NArith/Ndec.vo theories/IntMap/Map.vo theories/IntMap/Fset.vo +theories/IntMap/Map.vo: theories/IntMap/Map.v theories/Bool/Bool.vo theories/Bool/Sumbool.vo theories/NArith/NArith.vo theories/NArith/Ndigits.vo theories/NArith/Ndec.vo theories/Relations/Newman.vo: theories/Relations/Newman.v theories/Relations/Rstar.vo theories/Relations/Operators_Properties.vo: theories/Relations/Operators_Properties.v theories/Relations/Relation_Definitions.vo theories/Relations/Relation_Operators.vo theories/Relations/Relation_Definitions.vo: theories/Relations/Relation_Definitions.v @@ -230,10 +274,64 @@ theories/Reals/Raxioms.vo: theories/Reals/Raxioms.v theories/ZArith/ZArith_base. theories/Reals/RIneq.vo: theories/Reals/RIneq.v theories/Reals/Raxioms.vo contrib/ring/ZArithRing.vo contrib/omega/Omega.vo contrib/field/Field.vo theories/Reals/DiscrR.vo: theories/Reals/DiscrR.v theories/Reals/RIneq.vo contrib/omega/Omega.vo theories/Reals/Rbase.vo: theories/Reals/Rbase.v theories/Reals/Rdefinitions.vo theories/Reals/Raxioms.vo theories/Reals/RIneq.vo theories/Reals/DiscrR.vo -theories/Setoids/Setoid.vo: theories/Setoids/Setoid.v theories/Relations/Relation_Definitions.vo +theories/Reals/R_Ifp.vo: theories/Reals/R_Ifp.v theories/Reals/Rbase.vo contrib/omega/Omega.vo +theories/Reals/Rbasic_fun.vo: theories/Reals/Rbasic_fun.v theories/Reals/Rbase.vo theories/Reals/R_Ifp.vo contrib/fourier/Fourier.vo +theories/Reals/R_sqr.vo: theories/Reals/R_sqr.v theories/Reals/Rbase.vo theories/Reals/Rbasic_fun.vo +theories/Reals/SplitAbsolu.vo: theories/Reals/SplitAbsolu.v theories/Reals/Rbasic_fun.vo +theories/Reals/SplitRmult.vo: theories/Reals/SplitRmult.v theories/Reals/Rbase.vo +theories/Reals/ArithProp.vo: theories/Reals/ArithProp.v theories/Reals/Rbase.vo theories/Reals/Rbasic_fun.vo theories/Arith/Even.vo theories/Arith/Div2.vo +theories/Reals/Rfunctions.vo: theories/Reals/Rfunctions.v theories/Reals/Rbase.vo theories/Reals/R_Ifp.vo theories/Reals/Rbasic_fun.vo theories/Reals/R_sqr.vo theories/Reals/SplitAbsolu.vo theories/Reals/SplitRmult.vo theories/Reals/ArithProp.vo contrib/omega/Omega.vo theories/ZArith/Zpower.vo +theories/Reals/Rseries.vo: theories/Reals/Rseries.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Logic/Classical.vo theories/Arith/Compare.vo +theories/Reals/SeqProp.vo: theories/Reals/SeqProp.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/Rseries.vo theories/Logic/Classical.vo theories/Arith/Max.vo +theories/Reals/Rcomplete.vo: theories/Reals/Rcomplete.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/Rseries.vo theories/Reals/SeqProp.vo theories/Arith/Max.vo +theories/Reals/PartSum.vo: theories/Reals/PartSum.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/Rseries.vo theories/Reals/Rcomplete.vo theories/Arith/Max.vo +theories/Reals/AltSeries.vo: theories/Reals/AltSeries.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/Rseries.vo theories/Reals/SeqProp.vo theories/Reals/PartSum.vo theories/Arith/Max.vo +theories/Reals/Binomial.vo: theories/Reals/Binomial.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/PartSum.vo +theories/Reals/Rsigma.vo: theories/Reals/Rsigma.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/Rseries.vo theories/Reals/PartSum.vo +theories/Reals/Rprod.vo: theories/Reals/Rprod.v theories/Arith/Compare.vo theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/Rseries.vo theories/Reals/PartSum.vo theories/Reals/Binomial.vo +theories/Reals/Cauchy_prod.vo: theories/Reals/Cauchy_prod.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/Rseries.vo theories/Reals/PartSum.vo +theories/Reals/Alembert.vo: theories/Reals/Alembert.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/Rseries.vo theories/Reals/SeqProp.vo theories/Reals/PartSum.vo theories/Arith/Max.vo +theories/Reals/SeqSeries.vo: theories/Reals/SeqSeries.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Arith/Max.vo theories/Reals/Rseries.vo theories/Reals/SeqProp.vo theories/Reals/Rcomplete.vo theories/Reals/PartSum.vo theories/Reals/AltSeries.vo theories/Reals/Binomial.vo theories/Reals/Rsigma.vo theories/Reals/Rprod.vo theories/Reals/Cauchy_prod.vo theories/Reals/Alembert.vo +theories/Reals/Rtrigo_fun.vo: theories/Reals/Rtrigo_fun.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/SeqSeries.vo +theories/Reals/Rtrigo_def.vo: theories/Reals/Rtrigo_def.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/SeqSeries.vo theories/Reals/Rtrigo_fun.vo theories/Arith/Max.vo +theories/Reals/Rtrigo_alt.vo: theories/Reals/Rtrigo_alt.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/SeqSeries.vo theories/Reals/Rtrigo_def.vo +theories/Reals/Cos_rel.vo: theories/Reals/Cos_rel.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/SeqSeries.vo theories/Reals/Rtrigo_def.vo +theories/Reals/Cos_plus.vo: theories/Reals/Cos_plus.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/SeqSeries.vo theories/Reals/Rtrigo_def.vo theories/Reals/Cos_rel.vo theories/Arith/Max.vo +theories/Reals/Rtrigo.vo: theories/Reals/Rtrigo.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/SeqSeries.vo theories/Reals/Rtrigo_fun.vo theories/Reals/Rtrigo_def.vo theories/Reals/Rtrigo_alt.vo theories/Reals/Cos_rel.vo theories/Reals/Cos_plus.vo theories/ZArith/ZArith_base.vo theories/ZArith/Zcomplements.vo theories/Logic/Classical_Prop.vo +theories/Reals/Rlimit.vo: theories/Reals/Rlimit.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Logic/Classical_Prop.vo contrib/fourier/Fourier.vo +theories/Reals/Rderiv.vo: theories/Reals/Rderiv.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/Rlimit.vo contrib/fourier/Fourier.vo theories/Logic/Classical_Prop.vo theories/Logic/Classical_Pred_Type.vo contrib/omega/Omega.vo +theories/Reals/RList.vo: theories/Reals/RList.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo +theories/Reals/Ranalysis1.vo: theories/Reals/Ranalysis1.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/Rlimit.vo theories/Reals/Rderiv.vo +theories/Reals/Ranalysis2.vo: theories/Reals/Ranalysis2.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/Ranalysis1.vo +theories/Reals/Ranalysis3.vo: theories/Reals/Ranalysis3.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/Ranalysis1.vo theories/Reals/Ranalysis2.vo +theories/Reals/Rtopology.vo: theories/Reals/Rtopology.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/Ranalysis1.vo theories/Reals/RList.vo theories/Logic/Classical_Prop.vo theories/Logic/Classical_Pred_Type.vo +theories/Reals/MVT.vo: theories/Reals/MVT.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/Ranalysis1.vo theories/Reals/Rtopology.vo +theories/Reals/PSeries_reg.vo: theories/Reals/PSeries_reg.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/SeqSeries.vo theories/Reals/Ranalysis1.vo theories/Arith/Max.vo theories/Arith/Even.vo +theories/Reals/Exp_prop.vo: theories/Reals/Exp_prop.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/SeqSeries.vo theories/Reals/Rtrigo.vo theories/Reals/Ranalysis1.vo theories/Reals/PSeries_reg.vo theories/Arith/Div2.vo theories/Arith/Even.vo theories/Arith/Max.vo +theories/Reals/Rtrigo_reg.vo: theories/Reals/Rtrigo_reg.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/SeqSeries.vo theories/Reals/Rtrigo.vo theories/Reals/Ranalysis1.vo theories/Reals/PSeries_reg.vo +theories/Reals/Rsqrt_def.vo: theories/Reals/Rsqrt_def.v theories/Bool/Sumbool.vo theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/SeqSeries.vo theories/Reals/Ranalysis1.vo +theories/Reals/R_sqrt.vo: theories/Reals/R_sqrt.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/Rsqrt_def.vo +theories/Reals/Rtrigo_calc.vo: theories/Reals/Rtrigo_calc.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/SeqSeries.vo theories/Reals/Rtrigo.vo theories/Reals/R_sqrt.vo +theories/Reals/Rgeom.vo: theories/Reals/Rgeom.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/SeqSeries.vo theories/Reals/Rtrigo.vo theories/Reals/R_sqrt.vo +theories/Reals/Sqrt_reg.vo: theories/Reals/Sqrt_reg.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/Ranalysis1.vo theories/Reals/R_sqrt.vo +theories/Reals/Ranalysis4.vo: theories/Reals/Ranalysis4.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/SeqSeries.vo theories/Reals/Rtrigo.vo theories/Reals/Ranalysis1.vo theories/Reals/Ranalysis3.vo theories/Reals/Exp_prop.vo +theories/Reals/Rpower.vo: theories/Reals/Rpower.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/SeqSeries.vo theories/Reals/Rtrigo.vo theories/Reals/Ranalysis1.vo theories/Reals/Exp_prop.vo theories/Reals/Rsqrt_def.vo theories/Reals/R_sqrt.vo theories/Reals/MVT.vo theories/Reals/Ranalysis4.vo +theories/Reals/Ranalysis.vo: theories/Reals/Ranalysis.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/Rtrigo.vo theories/Reals/SeqSeries.vo theories/Reals/Ranalysis1.vo theories/Reals/Ranalysis2.vo theories/Reals/Ranalysis3.vo theories/Reals/Rtopology.vo theories/Reals/MVT.vo theories/Reals/PSeries_reg.vo theories/Reals/Exp_prop.vo theories/Reals/Rtrigo_reg.vo theories/Reals/Rsqrt_def.vo theories/Reals/R_sqrt.vo theories/Reals/Rtrigo_calc.vo theories/Reals/Rgeom.vo theories/Reals/RList.vo theories/Reals/Sqrt_reg.vo theories/Reals/Ranalysis4.vo theories/Reals/Rpower.vo +theories/Reals/NewtonInt.vo: theories/Reals/NewtonInt.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/SeqSeries.vo theories/Reals/Rtrigo.vo theories/Reals/Ranalysis.vo +theories/Reals/RiemannInt_SF.vo: theories/Reals/RiemannInt_SF.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/Ranalysis.vo theories/Logic/Classical_Prop.vo +theories/Reals/RiemannInt.vo: theories/Reals/RiemannInt.v theories/Reals/Rfunctions.vo theories/Reals/SeqSeries.vo theories/Reals/Ranalysis.vo theories/Reals/Rbase.vo theories/Reals/RiemannInt_SF.vo theories/Logic/Classical_Prop.vo theories/Logic/Classical_Pred_Type.vo theories/Arith/Max.vo +theories/Reals/Integration.vo: theories/Reals/Integration.v theories/Reals/NewtonInt.vo theories/Reals/RiemannInt_SF.vo theories/Reals/RiemannInt.vo +theories/Reals/Reals.vo: theories/Reals/Reals.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/SeqSeries.vo theories/Reals/Rtrigo.vo theories/Reals/Ranalysis.vo theories/Reals/Integration.vo theories/Sorting/Heap.vo: theories/Sorting/Heap.v theories/Lists/List.vo theories/Sets/Multiset.vo theories/Sorting/Permutation.vo theories/Relations/Relations.vo theories/Sorting/Sorting.vo -theories/Sorting/Permutation.vo: theories/Sorting/Permutation.v theories/Relations/Relations.vo theories/Lists/List.vo theories/Sets/Multiset.vo +theories/Sorting/Permutation.vo: theories/Sorting/Permutation.v theories/Relations/Relations.vo theories/Lists/List.vo theories/Sets/Multiset.vo theories/Arith/Arith.vo theories/Sorting/Sorting.vo: theories/Sorting/Sorting.v theories/Lists/List.vo theories/Sets/Multiset.vo theories/Sorting/Permutation.vo theories/Relations/Relations.vo +theories/Sorting/PermutSetoid.vo: theories/Sorting/PermutSetoid.v contrib/omega/Omega.vo theories/Relations/Relations.vo theories/Lists/List.vo theories/Sets/Multiset.vo theories/Sorting/Permutation.vo theories/Lists/SetoidList.vo +theories/Sorting/PermutEq.vo: theories/Sorting/PermutEq.v contrib/omega/Omega.vo theories/Relations/Relations.vo theories/Setoids/Setoid.vo theories/Lists/List.vo theories/Sets/Multiset.vo theories/Sorting/Permutation.vo +theories/QArith/QArith_base.vo: theories/QArith/QArith_base.v theories/ZArith/ZArith.vo contrib/ring/ZArithRing.vo theories/Setoids/Setoid.vo +theories/QArith/Qreduction.vo: theories/QArith/Qreduction.v theories/QArith/QArith_base.vo theories/ZArith/Znumtheory.vo +theories/QArith/Qring.vo: theories/QArith/Qring.v contrib/ring/Ring.vo contrib/ring/Setoid_ring.vo theories/QArith/QArith_base.vo +theories/QArith/Qreals.vo: theories/QArith/Qreals.v theories/Reals/Rbase.vo theories/QArith/QArith_base.vo +theories/QArith/QArith.vo: theories/QArith/QArith.v theories/QArith/QArith_base.vo theories/QArith/Qring.vo theories/QArith/Qreduction.vo contrib/omega/OmegaLemmas.vo: contrib/omega/OmegaLemmas.v theories/ZArith/ZArith_base.vo contrib/omega/Omega.vo: contrib/omega/Omega.v theories/ZArith/ZArith_base.vo contrib/omega/OmegaLemmas.vo theories/ZArith/Zhints.vo contrib/romega/ReflOmegaCore.vo: contrib/romega/ReflOmegaCore.v theories/Arith/Arith.vo theories/Lists/List.vo theories/Bool/Bool.vo theories/ZArith/ZArith_base.vo contrib/omega/OmegaLemmas.vo theories/Logic/Decidable.vo @@ -249,13 +347,14 @@ contrib/ring/Quote.vo: contrib/ring/Quote.v contrib/ring/Setoid_ring_normalize.vo: contrib/ring/Setoid_ring_normalize.v contrib/ring/Setoid_ring_theory.vo contrib/ring/Quote.vo contrib/ring/Setoid_ring.vo: contrib/ring/Setoid_ring.v contrib/ring/Setoid_ring_theory.vo contrib/ring/Quote.vo contrib/ring/Setoid_ring_normalize.vo contrib/ring/Setoid_ring_theory.vo: contrib/ring/Setoid_ring_theory.v theories/Bool/Bool.vo theories/Setoids/Setoid.vo -contrib/field/Field_Compl.vo: contrib/field/Field_Compl.v -contrib/field/Field_Theory.vo: contrib/field/Field_Theory.v theories/Arith/Peano_dec.vo contrib/ring/Ring.vo contrib/field/Field_Compl.vo -contrib/field/Field_Tactic.vo: contrib/field/Field_Tactic.v contrib/ring/Ring.vo contrib/field/Field_Compl.vo contrib/field/Field_Theory.vo +contrib/field/Field_Compl.vo: contrib/field/Field_Compl.v theories/Lists/List.vo +contrib/field/Field_Theory.vo: contrib/field/Field_Theory.v theories/Lists/List.vo theories/Arith/Peano_dec.vo contrib/ring/Ring.vo contrib/field/Field_Compl.vo +contrib/field/Field_Tactic.vo: contrib/field/Field_Tactic.v theories/Lists/List.vo contrib/ring/Ring.vo contrib/field/Field_Compl.vo contrib/field/Field_Theory.vo contrib/field/Field.vo: contrib/field/Field.v contrib/field/Field_Compl.vo contrib/field/Field_Theory.vo contrib/field/Field_Tactic.vo contrib/fourier/Fourier_util.vo: contrib/fourier/Fourier_util.v theories/Reals/Rbase.vo contrib/fourier/Fourier.vo: contrib/fourier/Fourier.v contrib/ring/quote.cmo contrib/ring/ring.cmo contrib/fourier/fourier.cmo contrib/fourier/fourierR.cmo contrib/field/field.cmo contrib/fourier/Fourier_util.vo contrib/field/Field.vo theories/Reals/DiscrR.vo contrib/subtac/FixSub.vo: contrib/subtac/FixSub.v theories/Init/Wf.vo +contrib/subtac/Utils.vo: contrib/subtac/Utils.v contrib/rtauto/Bintree.vo: contrib/rtauto/Bintree.v theories/Lists/List.vo theories/NArith/BinPos.vo contrib/rtauto/Rtauto.vo: contrib/rtauto/Rtauto.v theories/Lists/List.vo contrib/rtauto/Bintree.vo theories/Bool/Bool.vo theories/NArith/BinPos.vo contrib/recdef/Recdef.vo: contrib/recdef/Recdef.v theories/Arith/Compare_dec.vo theories/Arith/Wf_nat.vo diff --git a/ANNONCE b/ANNONCE deleted file mode 100644 index 5e634f2c..00000000 --- a/ANNONCE +++ /dev/null @@ -1,27 +0,0 @@ -The main features of Coq version 8.1 are - -- the implementation of an alternative algorithm for checking the - convertibility of types, specially dedicated to fast type-checking - of reflexion-based proofs, and more generally to intensive - computation - -- richer inductive types - - - support for recursively non uniform parameters - - support for a strong form of sort-polymorphism - -- improved tactics - - - new implementation of setoid rewrite (contributed by C. Sacerdoti Coen) - - new implementation of ring (contributed by B. Grégoire and A. Mahboubi) - - and several other new tactic features - -- new libraries - - - finite sets and finite maps (by J.-C. Filliâtre and P. Letouzey) - - strings (by L. Théry) - - significative extensions of the library on lists - - a few other extensions - -- improved module system - @@ -1,17 +1,19 @@ -Changes from V8.0 -================= +Changes from V8.0 to V8.1 +========================= -Syntax +Logic -- No more support for version 7 syntax and for translation to version 8 syntax. -- Support for primitive interpretation of string literals -- Extended support for Unicode ranges (Unicode doc TODO) +- Added sort-polymorphism on inductive families +- Allowance for recursively non uniform parameters in inductive types -Environment variables +Syntax -- COQREMOTEBROWSER to set the command invoked to start the remote browser - both in Coq and coqide. Standard syntax: "%s" is the placeholder for the - URL (doc TODO) +- No more support for version 7 syntax and for translation to version 8 syntax. +- In fixpoints, the { struct ... } annotation is not mandatory any more when + only one of the arguments has an inductive type (doc TODO) +- Added disjunctive patterns in match-with patterns (doc TODO) +- Support for primitive interpretation of string literals (doc TODO) +- Extended support for Unicode ranges (doc TODO) Vernacular commands @@ -19,101 +21,156 @@ Vernacular commands - Added "Print Rewrite HintDb" to print the content of a DB used by autorewrite (doc TODO) - Added "Print Canonical Projections" (doc TODO) -- Added "Example" as synonym of "Definition" +- Added "Example" as synonym of "Definition" (doc TODO) - Added "Property", "Proposition" and "Corollary" as extra synonyms of "Lemma" + (doc TODO) +- New command "Whelp" to send requests to the Helm database of proofs + formalized in the Calculus of Inductive Constructions (doc TODO) +- Command "functional induction" has been re-implemented from the new + "definition" command. -Gallina - -- Added disjunctive patterns in match-with patterns - -Ltac +Ltac and tactic syntactic extensions - New primitive "external" for communication with tool external to Coq -- Semantics of "match t with" changed: if a clause returns a + (doc TODO). +- New semantics for "match t with": if a clause returns a tactic, it is now applied to the current goal. If it fails, the next clause or next matching subterm is tried (i.e. it behaves as "match - goal with"). -- New modifier "lazy" (TODO) for "match t with" and "match goal with" telling - to delay the evaluation of tactic expression. -- Hint base name can be parametric in auto and trivial. + goal with" does) (doc TODO). +- Hint base names can be parametric in auto and trivial. +- Occurrence values can be parametric in unfold, pattern, etc. +- Added entry constr_may_eval for tactic extensions. +- Low-priority term printer made available in ML-written tactic extensions. +- "Tactic Notation" extended to allow notations of tacticals (doc TODO). Tactics - New implementation and generalization of [setoid_]* (setoid_rewrite, setoid_symmetry, setoid_transitivity, setoid_reflexivity and autorewite). New syntax for declaring relations and morphisms (old syntax still working - with minor modifications, but deprecated) (doc TODO) -- Added "clear - id" to clear all hypotheses except the ones depending in id. + with minor modifications, but deprecated). +- When rewriting H where H is not directly a Coq equality, search first H for + a registered setoid equality before starting to reduce in H. This is unlikely + to break any script. Should this happen nonetheless, one can insert manually + some "unfold ... in H" before rewriting. +- Fixed various bugs about (setoid) rewrite ... in ... (in particular #1101) +- "rewrite ... in" now accepts a clause as place where to rewrite instead of + juste a simple hypothesis name. For instance: + rewrite H in H1,H2 |- * means rewrite H in H1; rewrite H in H2; rewrite H + rewrite H in * |- will do try rewrite H in Hi for all hypothesis Hi <> H + (doc TODO). +- Added "clear - id" to clear all hypotheses except the ones depending in id + (doc TODO). - Added "dependent rewrite term" and "dependent rewrite term in hyp" (doc TODO) - The argument of Declare Left Step and Declare Right Step is now a term - (it used to be a reference) (doc TODO) -- Omega now handles arbitrary precision integers + (it used to be a reference) (doc TODO). +- Omega now handles arbitrary precision integers. +- Several bug fixes in Reflexive Omega (romega). - Idtac can now be left implicit in a [...|...] construct: for instance, - [ foo | | bar ] stands for [ foo | idtac | bar ]. (doc TODO). -- "Tactic Notation" extended to allow notations of tacticals (doc TODO). + [ foo | | bar ] stands for [ foo | idtac | bar ] (doc TODO). - Added "autorewrite with ... in hyp [using ...]" (doc TODO). -- Added entry constr_may_eval for tactic extensions (new syntax). -- Fixed a "fold" bug (non critical and possible source of incompatibilities). +- Fixed a "fold" bug (non critical but possible source of incompatibilities). - Added classical_left and classical_right which transforms |- A \/ B into ~B |- A and ~A |- B respectively. - Added command "Declare Implicit Tactic" to set up a default tactic to be - used to solve unresolved subterms of term arguments of tactics. -- Better support for coercions to Sortclass in tactics expecting type arguments -- Low-priority term printer made available in ML-written tactic extensions + used to solve unresolved subterms of term arguments of tactics (doc TODO). +- Better support for coercions to Sortclass in tactics expecting type + arguments. - Tactic "assert" now accepts "as" intro patterns and "by" tactic clauses + (doc TODO). +- Tactic "replace" now accepts a "by" tactic clause (doc TODO). - New tactic "pose proof" that generalizes "assert (id:=p)" with intro patterns -- New introduction pattern "?" for letting Coq choose a name -- Added "eassumption" -- Added option 'using lemmas' to auto, trivial and eauto + (doc TODO). +- New introduction pattern "?" for letting Coq choose a name (doc TODO). +- Added "eassumption" (doc TODO). +- Added option 'using lemmas' to auto, trivial and eauto (doc TODO). - Numbering of "pattern", "unfold", "simpl", ... occurrences in "match with" made consistent with the printing of the return clause after the term to match in the "match-with" construct (use "Set Printing All" to see hidden occurrences). -- New definition command: "GenFixpoint" (TODO) (doc) -- functional induction has been re-implemented from the new definition - command (doc TODO) -- Genralisation of induction "induction x1...xn using scheme" where +- Generalization of induction "induction x1...xn using scheme" where scheme is an induction principle with complex predicates (like the ones generated by function induction) (doc TODO). +- Some small Ltac tactics has been added to the standard library + (file Tactics.v): + * f_equal : instead of using the different f_equalX lemmas + * case_eq : a "case" without loss of information. An equality + stating the current situation is generated in every sub-cases. + * swap : for a negated goal ~B and a negated hypothesis H:~A, + swap H asks you to prove A from hypothesis B + * revert : revert H is generalize H; clear H. +Extraction + +- All type parts should now disappear instead of sometimes producing _ + (for instance in Map.empty). +- Haskell extraction: types of functions are now printed, better + unsafeCoerce mechanism, both for hugs and ghc. +- Scheme extraction improved, see http://www.pps.jussieu.fr/~letouzey/scheme. +- Many bug fixes. Modules -- Added "Locate Module qualid" to get the full path of a module. -- Module/Declare Module syntax made more uniform (doc TODO) +- Added "Locate Module qualid" to get the full path of a module (TODO doc). +- Module/Declare Module syntax made more uniform (doc TODO). - Added syntactic sugar "Declare Module Export/Import" and - "Module Export/Import" (doc TODO) + "Module Export/Import" (doc TODO). - Added syntactic sugar "Module M(Export/Import X Y: T)" and "Module Type M(Export/Import X Y: T)" (only for interactive definitions) (doc TODO) - Construct "with" generalized to module paths: - T with (Definition|Module) M1.M2....Mn.l := l'. (doc TODO) + T with (Definition|Module) M1.M2....Mn.l := l' (doc TODO). Notations -- "format" option aware of recursive notations. -- added insertion of spaces by default in recursive notations w/o separators. -- no more automatic printing box in case of user-provided printing "format". -- new notation "exists! x:A, P" for unique existence. +- Option "format" aware of recursive notations. +- Added insertion of spaces by default in recursive notations w/o separators. +- No more automatic printing box in case of user-provided printing "format". +- New notation "exists! x:A, P" for unique existence. -Library +Libraries -- Small extension of Zmin.V, new Zmax.v, new Zminmax.v -- New library on String and Ascii characters (contributed by L. Thery) +- New library on String and Ascii characters (contributed by L. Thery). +- New library FSets+FMaps of finite sets and maps. +- New library QArith on rational numbers. +- Small extension of Zmin.V, new Zmax.v, new Zminmax.v. +- Reworking of the files on classical logic and description principles + (possible incompatibilities). - Few other improvements in ZArith potentially exceptionally breaking the compatibility (useless hypothesys of Zgt_square_simpl and Zlt_square_simpl removed; fixed names mentioning letter O instead of - digit 0; weaken premises in Z_lt_induction) -- More lemmas stated on Type in Wf.v, removal of redundant Fix_F + digit 0; weaken premises in Z_lt_induction). +- Restructuration of Eqdep_dec.v and Eqdep.v: more lemmas in Type. +- Znumtheory now contains a gcd function that can compute within Coq. +- More lemmas stated on Type in Wf.v, removal of redundant Fix_F. +- Change of the internal names of lemmas in OmegaLemmas. - Coq.List.In_dec has been set transparent (this may exceptionally break - proof scripts, set it locally opaque for compatibility) -- Change of the internal names of lemmas in OmegaLemmas + proof scripts, set it locally opaque for compatibility). +- More on permutations of lists in List.v and Permutation.v. +- List.v has been much expanded. +- New file SetoidList.v now contains results about lists seen with + respect to a setoid equality. +- Library NArith has been expanded, mostly with results coming from + Intmap (for instance a bitwise xor), plus also a bridge between N and + Bitvector. +- Intmap has been reorganized. In particular its address type "addr" is + now N. User contributions known to use Intmap have been adapted + accordingly. If you're using this library please contact us. + A wrapper FMapIntMap now presents Intmap as a particular implementation + of FMaps. New developments are strongly encouraged to use either this + wrapper or any other implementations of FMap instead of using directly + this obsolete Intmap. Tools - New semantics for coqtop options ("-batch" expects option "-top dir" for loading vernac file that contains definitions). -- coq_makefile now removes custom targets that are file names in "make clean" +- Tool coq_makefile now removes custom targets that are file names in + "make clean" +- New environment variable COQREMOTEBROWSER to set the command invoked + to start the remote browser both in Coq and coqide. Standard syntax: + "%s" is the placeholder for the URL (doc TODO) + Changes from V8.0beta to V8.0 ============================= @@ -294,13 +351,16 @@ Implicit arguments Grammar extensions -- UTF-8 encoded unicode blocks 0380-03FF (greek letters) and 2100-214F - (letter-like, including aleph and double N,Z,Q,R) are supported - identifiers; UTF-8 unicode blocs 2200-22FF (mathematical operators), - 2A00-2AFF (supplemental mathematical operators) 2300-23FF - (miscellaneous technical, including sqrt symbol), 2600-26FF - (miscellaneous symbols) 2190-21FF (arrows A) and 2900-297F (arrows B) - are supported symbols +- Many newly supported UTF-8 encoded unicode blocks + - Greek letters (0380-03FF), Hebrew letters (U05D0-05EF), letter-like + symbols (2100-214F, that includes double N,Z,Q,R), prime + signs (from 2080-2089) and characters from many written languages + are valid in identifiers + - mathematical operators (2200-22FF), supplemental mathematical + operators (2A00-2AFF), miscellaneous technical (2300-23FF that + includes sqrt symbol), miscellaneous symbols (2600-26FF), arrows + (2190-21FF and 2900-297F), invisible mathematical operators (from + 2080-2089), ... are valid symbols Library @@ -85,7 +85,7 @@ Intensive users suggested improvements of the system : Y. Bertot, L. Pottier, L. Théry (INRIA-Lemme projects), C. Alvarado, P. Crégut, J.-F. Monin (France Telecom R&D), P. Castéran (University Bordeaux 1), - The Foundations Group (Radbout University, Nijmegen, The Netherlands), + The Foundations Group (Radboub University, Nijmegen, The Netherlands), Laboratoire J.-A. Dieudonné (University of Nice-Sophia Antipolis). The following people have contributed to the development of different versions diff --git a/KNOWN-BUGS b/KNOWN-BUGS new file mode 100644 index 00000000..774d181c --- /dev/null +++ b/KNOWN-BUGS @@ -0,0 +1,20 @@ + THIS IS A LIST OF KNOWN BUGS OF COQ V7.0 + +- Realizer and Program/Program_all are not available + +- Local definitions in Record/Structure are not allowed + +- Alias of pattern with dependent types are not supported + +- Tokens with both symbols and letters are not supported + +- No consistency check is done when requiring a module (that is, a + module can be compiled with logical name Mycontrib.Arith.Plus but + required with name HisContrib.Zarith.Plus). + +- The syntax "Specialize num ident" is temporarily not accepted + outside "Tactic Definition". Syntax "Specialize ident" is OK. + +- New Induction fails for mutual inductive elimination + +- Elim fails with eliminators not imported
\ No newline at end of file @@ -6,7 +6,7 @@ # # GNU Lesser General Public License Version 2.1 # ####################################################################### -# $Id: Makefile 8688 2006-04-07 15:08:12Z msozeau $ +# $Id: Makefile 8933 2006-06-09 14:08:38Z herbelin $ # Makefile for Coq @@ -73,8 +73,8 @@ LOCALINCLUDES=-I config -I tools -I tools/coqdoc \ MLINCLUDES=$(LOCALINCLUDES) -I $(MYCAMLP4LIB) -BYTEFLAGS=$(MLINCLUDES) $(CAMLDEBUG) -OPTFLAGS=$(MLINCLUDES) $(CAMLTIMEPROF) -noassert +BYTEFLAGS=$(MLINCLUDES) $(CAMLDEBUG) $(USERFLAGS) +OPTFLAGS=$(MLINCLUDES) $(CAMLTIMEPROF) $(USERFLAGS) -noassert OCAMLDEP=ocamldep DEPFLAGS=$(LOCALINCLUDES) @@ -276,7 +276,9 @@ JPROVERCMO=\ FUNINDCMO=\ contrib/funind/tacinvutils.cmo contrib/funind/tacinv.cmo \ contrib/funind/indfun_common.cmo contrib/funind/rawtermops.cmo \ - contrib/funind/rawterm_to_relation.cmo contrib/funind/new_arg_principle.cmo \ + contrib/funind/rawterm_to_relation.cmo \ + contrib/funind/functional_principles_proofs.cmo \ + contrib/funind/functional_principles_types.cmo \ contrib/funind/invfun.cmo contrib/funind/indfun.cmo \ contrib/funind/indfun_main.cmo @@ -299,6 +301,7 @@ SUBTACCMO=\ contrib/subtac/context.cmo \ contrib/subtac/subtac_errors.cmo \ contrib/subtac/subtac_coercion.cmo \ + contrib/subtac/subtac_pretyping_F.cmo \ contrib/subtac/subtac_pretyping.cmo \ contrib/subtac/subtac_interp_fixpoint.cmo \ contrib/subtac/subtac_command.cmo \ @@ -379,7 +382,13 @@ clean :: # Main targets (coqmktop, coqtop.opt, coqtop.byte) ########################################################################### +COQMKTOPBYTE=bin/coqmktop.byte$(EXE) +COQMKTOPOPT=bin/coqmktop.opt$(EXE) +BESTCOQMKTOP=bin/coqmktop.$(BEST)$(EXE) COQMKTOP=bin/coqmktop$(EXE) +COQCBYTE=bin/coqc.byte$(EXE) +COQCOPT=bin/coqc.opt$(EXE) +BESTCOQC=bin/coqc.$(BEST)$(EXE) COQC=bin/coqc$(EXE) COQTOPBYTE=bin/coqtop.byte$(EXE) COQTOPOPT=bin/coqtop.opt$(EXE) @@ -413,12 +422,21 @@ $(COQTOP): # coqmktop COQMKTOPCMO=$(CONFIG) scripts/tolink.cmo scripts/coqmktop.cmo +COQMKTOPCMX=config/coq_config.cmx scripts/tolink.cmx scripts/coqmktop.cmx -$(COQMKTOP): $(COQMKTOPCMO) +$(COQMKTOPBYTE): $(COQMKTOPCMO) $(SHOW)'OCAMLC -o $@' $(HIDE)$(OCAMLC) $(BYTEFLAGS) -o $@ -custom str.cma unix.cma \ $(COQMKTOPCMO) $(OSDEPLIBS) +$(COQMKTOPOPT): $(COQMKTOPCMX) + $(SHOW)'OCAMLOPT -o $@' + $(HIDE)$(OCAMLOPT) $(OPTFLAGS) -o $@ str.cmxa unix.cmxa \ + $(COQMKTOPCMX) $(OSDEPLIBS) + +$(COQMKTOP): $(BESTCOQMKTOP) + cd bin; ln -sf coqmktop.$(BEST)$(EXE) coqmktop$(EXE) + scripts/tolink.ml: Makefile $(SHOW)"ECHO... >" $@ @@ -432,11 +450,20 @@ beforedepend:: scripts/tolink.ml # coqc COQCCMO=$(CONFIG) toplevel/usage.cmo scripts/coqc.cmo +COQCCMX=config/coq_config.cmx toplevel/usage.cmx scripts/coqc.cmx -$(COQC): $(COQCCMO) $(COQTOPBYTE) $(BESTCOQTOP) +$(COQCBYTE): $(COQCCMO) $(COQTOPBYTE) $(BESTCOQTOP) $(SHOW)'OCAMLC -o $@' $(HIDE)$(OCAMLC) $(BYTEFLAGS) -o $@ -custom unix.cma $(COQCCMO) $(OSDEPLIBS) +$(COQCOPT): $(COQCCMX) $(COQTOPOPT) $(BESTCOQTOP) + $(SHOW)'OCAMLOPT -o $@' + $(HIDE)$(OCAMLOPT) $(OPTFLAGS) -o $@ unix.cmxa $(COQCCMX) $(OSDEPLIBS) + +$(COQC): $(BESTCOQC) + cd bin; ln -sf coqc.$(BEST)$(EXE) coqc$(EXE) + + clean:: rm -f scripts/tolink.ml @@ -786,16 +813,18 @@ INITVO=\ init: $(INITVO) LOGICVO=\ - theories/Logic/Hurkens.vo theories/Logic/ProofIrrelevance.vo\ - theories/Logic/Classical.vo theories/Logic/Classical_Type.vo \ - theories/Logic/Classical_Pred_Set.vo theories/Logic/Eqdep.vo \ - theories/Logic/Classical_Pred_Type.vo theories/Logic/Classical_Prop.vo \ - theories/Logic/ClassicalFacts.vo theories/Logic/ChoiceFacts.vo \ - theories/Logic/Berardi.vo theories/Logic/Eqdep_dec.vo \ - theories/Logic/Decidable.vo theories/Logic/JMeq.vo \ - theories/Logic/ClassicalDescription.vo theories/Logic/ClassicalChoice.vo \ - theories/Logic/RelationalChoice.vo theories/Logic/Diaconescu.vo \ - theories/Logic/EqdepFacts.vo theories/Logic/ProofIrrelevanceFacts.vo + theories/Logic/Hurkens.vo theories/Logic/ProofIrrelevance.vo\ + theories/Logic/Classical.vo theories/Logic/Classical_Type.vo \ + theories/Logic/Classical_Pred_Set.vo theories/Logic/Eqdep.vo \ + theories/Logic/Classical_Prop.vo theories/Logic/Classical_Pred_Type.vo \ + theories/Logic/ClassicalFacts.vo theories/Logic/ChoiceFacts.vo \ + theories/Logic/Berardi.vo theories/Logic/Eqdep_dec.vo \ + theories/Logic/Decidable.vo theories/Logic/JMeq.vo \ + theories/Logic/ClassicalChoice.vo theories/Logic/ClassicalDescription.vo \ + theories/Logic/RelationalChoice.vo theories/Logic/Diaconescu.vo \ + theories/Logic/EqdepFacts.vo theories/Logic/ProofIrrelevanceFacts.vo \ + theories/Logic/ClassicalEpsilon.vo theories/Logic/ClassicalUniqueChoice.vo \ + theories/Logic/DecidableType.vo theories/Logic/DecidableTypeEx.vo ARITHVO=\ theories/Arith/Arith.vo theories/Arith/Gt.vo \ @@ -812,7 +841,8 @@ ARITHVO=\ SORTINGVO=\ theories/Sorting/Heap.vo theories/Sorting/Permutation.vo \ - theories/Sorting/Sorting.vo + theories/Sorting/Sorting.vo theories/Sorting/PermutSetoid.vo \ + theories/Sorting/PermutEq.vo BOOLVO=\ theories/Bool/Bool.vo theories/Bool/IfProp.vo \ @@ -822,7 +852,9 @@ BOOLVO=\ NARITHVO=\ theories/NArith/BinPos.vo theories/NArith/Pnat.vo \ - theories/NArith/BinNat.vo theories/NArith/NArith.vo + theories/NArith/BinNat.vo theories/NArith/NArith.vo \ + theories/NArith/Nnat.vo theories/NArith/Ndigits.vo \ + theories/NArith/Ndec.vo theories/NArith/Ndist.vo ZARITHVO=\ theories/ZArith/BinInt.vo theories/ZArith/Wf_Z.vo \ @@ -837,7 +869,12 @@ ZARITHVO=\ theories/ZArith/Zdiv.vo theories/ZArith/Zsqrt.vo \ theories/ZArith/Zwf.vo theories/ZArith/ZArith_base.vo \ theories/ZArith/Zbool.vo theories/ZArith/Zbinary.vo \ - theories/ZArith/Znumtheory.vo + theories/ZArith/Znumtheory.vo theories/ZArith/Int.vo + +QARITHVO=\ + theories/QArith/QArith_base.vo theories/QArith/Qreduction.vo \ + theories/QArith/Qring.vo theories/QArith/Qreals.vo \ + theories/QArith/QArith.vo LISTSVO=\ theories/Lists/MonoList.vo \ @@ -861,24 +898,35 @@ SETSVO=\ theories/Sets/Multiset.vo theories/Sets/Relations_3_facts.vo \ theories/Sets/Partial_Order.vo theories/Sets/Uniset.vo -FSETSVO=\ - theories/FSets/DecidableType.vo theories/FSets/OrderedType.vo \ +FSETSBASEVO=\ + theories/FSets/OrderedType.vo \ + theories/FSets/OrderedTypeEx.vo theories/FSets/OrderedTypeAlt.vo \ theories/FSets/FSetInterface.vo theories/FSets/FSetList.vo \ theories/FSets/FSetBridge.vo theories/FSets/FSetFacts.vo \ theories/FSets/FSetProperties.vo theories/FSets/FSetEqProperties.vo \ - theories/FSets/FSets.vo \ + theories/FSets/FSets.vo theories/FSets/FSetWeakProperties.vo \ theories/FSets/FSetWeakInterface.vo theories/FSets/FSetWeakList.vo \ theories/FSets/FSetWeakFacts.vo theories/FSets/FSetWeak.vo \ theories/FSets/FMapInterface.vo theories/FSets/FMapList.vo \ - theories/FSets/FMaps.vo \ + theories/FSets/FMaps.vo theories/FSets/FMapFacts.vo \ + theories/FSets/FMapWeakFacts.vo \ theories/FSets/FMapWeakInterface.vo theories/FSets/FMapWeakList.vo \ - theories/FSets/FMapWeak.vo + theories/FSets/FMapWeak.vo theories/FSets/FMapPositive.vo \ + theories/FSets/FMapIntMap.vo theories/FSets/FSetToFiniteSet.vo + +FSETS_basic= + +FSETS_all=\ + theories/FSets/FMapAVL.vo theories/FSets/FSetAVL.vo \ + +FSETSVO=$(FSETSBASEVO) $(FSETS_$(FSETS)) + +ALLFSETS=$(FSETSBASEVO) $(FSETS_all) INTMAPVO=\ theories/IntMap/Adalloc.vo theories/IntMap/Mapcanon.vo \ - theories/IntMap/Addec.vo theories/IntMap/Mapcard.vo \ - theories/IntMap/Addr.vo theories/IntMap/Mapc.vo \ - theories/IntMap/Adist.vo theories/IntMap/Mapfold.vo \ + theories/IntMap/Mapfold.vo \ + theories/IntMap/Mapcard.vo theories/IntMap/Mapc.vo \ theories/IntMap/Allmaps.vo theories/IntMap/Mapiter.vo \ theories/IntMap/Fset.vo theories/IntMap/Maplists.vo \ theories/IntMap/Lsort.vo theories/IntMap/Mapsubset.vo \ @@ -945,8 +993,8 @@ SETOIDSVO=theories/Setoids/Setoid.vo THEORIESVO =\ $(INITVO) $(LOGICVO) $(ARITHVO) $(BOOLVO) $(NARITHVO) $(ZARITHVO) \ - $(LISTSVO) $(STRINGSVO) $(SETSVO) $(FSETSVO) $(INTMAPVO) $(RELATIONSVO) \ - $(WELLFOUNDEDVO) $(REALSVO) $(SETOIDSVO) $(SORTINGVO) + $(SETOIDSVO) $(LISTSVO) $(STRINGSVO) $(SETSVO) $(FSETSVO) $(INTMAPVO) \ + $(RELATIONSVO) $(WELLFOUNDEDVO) $(REALSVO) $(SORTINGVO) $(QARITHVO) THEORIESLIGHTVO = $(INITVO) $(LOGICVO) $(ARITHVO) @@ -958,10 +1006,12 @@ arith: $(ARITHVO) bool: $(BOOLVO) narith: $(NARITHVO) zarith: $(ZARITHVO) +qarith: $(QARITHVO) lists: $(LISTSVO) strings: $(STRINGSVO) sets: $(SETSVO) fsets: $(FSETSVO) +allfsets: $(ALLFSETS) intmap: $(INTMAPVO) relations: $(RELATIONSVO) wellfounded: $(WELLFOUNDEDVO) @@ -971,8 +1021,8 @@ allreals: $(ALLREALS) setoids: $(SETOIDSVO) sorting: $(SORTINGVO) -noreal: logic arith bool zarith lists sets fsets intmap relations wellfounded \ - setoids sorting +noreal: logic arith bool zarith qarith lists sets fsets intmap relations \ + wellfounded setoids sorting ########################################################################### # contribs (interface not included) @@ -1256,7 +1306,7 @@ install-latex: # Literate programming (with ocamlweb) ########################################################################### -.PHONY: doc devdoc +.PHONY: doc doc: glob.dump (cd doc; make all) @@ -1264,18 +1314,6 @@ doc: glob.dump clean:: (cd doc; make clean) -devdoc: dev/doc/coq.tex - $(MAKE) -C dev/doc coq.ps minicoq.dvi - -dev/doc/coq.tex: - ocamlweb -p "\usepackage{epsfig}" \ - dev/doc/macros.tex dev/doc/intro.tex \ - lib/{doc.tex,*.mli} kernel/{doc.tex,*.mli} library/{doc.tex,*.mli} \ - pretyping/{doc.tex,*.mli} interp/{doc.tex,*.mli} \ - parsing/{doc.tex,*.mli} proofs/{doc.tex,*.mli} \ - tactics/{doc.tex,*.mli} toplevel/{doc.tex,*.mli} \ - -o dev/doc/coq.tex - clean:: rm -f doc/coq.tex @@ -1385,9 +1423,9 @@ PRINTERSCMO=\ proofs/proof_trees.cmo proofs/logic.cmo proofs/refiner.cmo \ proofs/tacexpr.cmo \ proofs/evar_refiner.cmo proofs/pfedit.cmo proofs/tactic_debug.cmo \ - parsing/ppconstr.cmo parsing/extend.cmo \ + parsing/ppconstr.cmo parsing/extend.cmo parsing/pcoq.cmo \ parsing/printer.cmo parsing/pptactic.cmo parsing/tactic_printer.cmo \ - parsing/pcoq.cmo parsing/egrammar.cmo toplevel/himsg.cmo \ + parsing/egrammar.cmo toplevel/himsg.cmo \ toplevel/cerrors.cmo toplevel/vernacexpr.cmo toplevel/vernacinterp.cmo \ dev/top_printers.cmo @@ -1621,7 +1659,7 @@ alldepend: depend dependcoq dependcoq:: beforedepend $(COQDEP) -coqlib . -R theories Coq -R contrib Coq $(COQINCLUDES) \ - $(ALLREALS:.vo=.v) $(ALLVO:.vo=.v) > .depend.coq + $(ALLFSETS:.vo=.v) $(ALLREALS:.vo=.v) $(ALLVO:.vo=.v) > .depend.coq # Build dependencies ignoring failures in building ml files from ml4 files # This is useful to rebuild dependencies when they are strongly corrupted: @@ -1692,5 +1730,6 @@ devel: clean:: find . -name "\.#*" -exec rm -f {} \; find . -name "*~" -exec rm -f {} \; + find . -name "*.annot" -exec rm -f {} \; ########################################################################### diff --git a/Tutorial.tex b/Tutorial.tex deleted file mode 100755 index 73d833c4..00000000 --- a/Tutorial.tex +++ /dev/null @@ -1,1555 +0,0 @@ -\documentclass[11pt,a4paper]{book} -\usepackage[T1]{fontenc} -\usepackage[latin1]{inputenc} -\usepackage{pslatex} - -\input{../common/version.tex} -\input{../common/macros.tex} -\input{../common/title.tex} - -%\makeindex - -\begin{document} -\coverpage{A Tutorial}{Gérard Huet, Gilles Kahn and Christine Paulin-Mohring}{} - -%\tableofcontents - -\chapter*{Getting started} - -\Coq\ is a Proof Assistant for a Logical Framework known as the Calculus -of Inductive Constructions. It allows the interactive construction of -formal proofs, and also the manipulation of functional programs -consistently with their specifications. It runs as a computer program -on many architectures. -%, and mainly on Unix machines. -It is available with a variety of user interfaces. The present -document does not attempt to present a comprehensive view of all the -possibilities of \Coq, but rather to present in the most elementary -manner a tutorial on the basic specification language, called Gallina, -in which formal axiomatisations may be developed, and on the main -proof tools. For more advanced information, the reader could refer to -the \Coq{} Reference Manual or the \textit{Coq'Art}, a new book by Y. -Bertot and P. Castéran on practical uses of the \Coq{} system. - -We assume here that the potential user has installed \Coq~ on his workstation, -that he calls \Coq~ from a standard teletype-like shell window, and that -he does not use any special interface. -Instructions on installation procedures, as well as more comprehensive -documentation, may be found in the standard distribution of \Coq, -which may be obtained from \Coq{} web site \texttt{http://coq.inria.fr}. - -In the following, all examples preceded by the prompting sequence -\verb:Coq < : represent user input, terminated by a period. The -following lines usually show \Coq's answer as it appears on the users -screen. The sequence of such examples is a valid \Coq~ session, unless -otherwise specified. This version of the tutorial has been prepared -on a PC workstation running Linux. -The standard invocation of \Coq\ delivers a message such as: - -\begin{small} -\begin{flushleft} -\begin{verbatim} -unix:~> coqtop -Welcome to Coq 8.0 (Mar 2004) - -Coq < -\end{verbatim} -\end{flushleft} -\end{small} - -The first line gives a banner stating the precise version of \Coq~ -used. You should always return this banner when you report an -anomaly to our hot-line \verb:coq-bugs@pauillac.inria.fr: or on our -bug-tracking system~:\verb:http://coq.inria.fr/bin/coq-bugs: - -\chapter{Basic Predicate Calculus} - -\section{An overview of the specification language Gallina} - -A formal development in Gallina consists in a sequence of {\sl declarations} -and {\sl definitions}. You may also send \Coq~ {\sl commands} which are -not really part of the formal development, but correspond to information -requests, or service routine invocations. For instance, the command: -\begin{verbatim} -Coq < Quit. -\end{verbatim} -terminates the current session. - -\subsection{Declarations} - -A declaration associates a {\sl name} with -a {\sl specification}. -A name corresponds roughly to an identifier in a programming -language, i.e. to a string of letters, digits, and a few ASCII symbols like -underscore (\verb"_") and prime (\verb"'"), starting with a letter. -We use case distinction, so that the names \verb"A" and \verb"a" are distinct. -Certain strings are reserved as key-words of \Coq, and thus are forbidden -as user identifiers. - -A specification is a formal expression which classifies the notion which is -being declared. There are basically three kinds of specifications: -{\sl logical propositions}, {\sl mathematical collections}, and -{\sl abstract types}. They are classified by the three basic sorts -of the system, called respectively \verb:Prop:, \verb:Set:, and -\verb:Type:, which are themselves atomic abstract types. - -Every valid expression $e$ in Gallina is associated with a specification, -itself a valid expression, called its {\sl type} $\tau(E)$. We write -$e:\tau(E)$ for the judgment that $e$ is of type $E$. -You may request \Coq~ to return to you the type of a valid expression by using -the command \verb:Check:: - -\begin{coq_example} -Check O. -\end{coq_example} - -Thus we know that the identifier \verb:O: (the name `O', not to be -confused with the numeral `0' which is not a proper identifier!) is -known in the current context, and that its type is the specification -\verb:nat:. This specification is itself classified as a mathematical -collection, as we may readily check: - -\begin{coq_example} -Check nat. -\end{coq_example} - -The specification \verb:Set: is an abstract type, one of the basic -sorts of the Gallina language, whereas the notions $nat$ and $O$ are -notions which are defined in the arithmetic prelude, -automatically loaded when running the \Coq\ system. - -We start by introducing a so-called section name. The role of sections -is to structure the modelisation by limiting the scope of parameters, -hypotheses and definitions. It will also give a convenient way to -reset part of the development. - -\begin{coq_example} -Section Declaration. -\end{coq_example} -With what we already know, we may now enter in the system a declaration, -corresponding to the informal mathematics {\sl let n be a natural - number}. - -\begin{coq_example} -Variable n : nat. -\end{coq_example} - -If we want to translate a more precise statement, such as -{\sl let n be a positive natural number}, -we have to add another declaration, which will declare explicitly the -hypothesis \verb:Pos_n:, with specification the proper logical -proposition: -\begin{coq_example} -Hypothesis Pos_n : (gt n 0). -\end{coq_example} - -Indeed we may check that the relation \verb:gt: is known with the right type -in the current context: - -\begin{coq_example} -Check gt. -\end{coq_example} - -which tells us that \verb:gt: is a function expecting two arguments of -type \verb:nat: in order to build a logical proposition. -What happens here is similar to what we are used to in a functional -programming language: we may compose the (specification) type \verb:nat: -with the (abstract) type \verb:Prop: of logical propositions through the -arrow function constructor, in order to get a functional type -\verb:nat->Prop:: -\begin{coq_example} -Check (nat -> Prop). -\end{coq_example} -which may be composed again with \verb:nat: in order to obtain the -type \verb:nat->nat->Prop: of binary relations over natural numbers. -Actually \verb:nat->nat->Prop: is an abbreviation for -\verb:nat->(nat->Prop):. - -Functional notions may be composed in the usual way. An expression $f$ -of type $A\ra B$ may be applied to an expression $e$ of type $A$ in order -to form the expression $(f~e)$ of type $B$. Here we get that -the expression \verb:(gt n): is well-formed of type \verb:nat->Prop:, -and thus that the expression \verb:(gt n O):, which abbreviates -\verb:((gt n) O):, is a well-formed proposition. -\begin{coq_example} -Check gt n O. -\end{coq_example} - -\subsection{Definitions} - -The initial prelude contains a few arithmetic definitions: -\verb:nat: is defined as a mathematical collection (type \verb:Set:), constants -\verb:O:, \verb:S:, \verb:plus:, are defined as objects of types -respectively \verb:nat:, \verb:nat->nat:, and \verb:nat->nat->nat:. -You may introduce new definitions, which link a name to a well-typed value. -For instance, we may introduce the constant \verb:one: as being defined -to be equal to the successor of zero: -\begin{coq_example} -Definition one := (S O). -\end{coq_example} -We may optionally indicate the required type: -\begin{coq_example} -Definition two : nat := S one. -\end{coq_example} - -Actually \Coq~ allows several possible syntaxes: -\begin{coq_example} -Definition three : nat := S two. -\end{coq_example} - -Here is a way to define the doubling function, which expects an -argument \verb:m: of type \verb:nat: in order to build its result as -\verb:(plus m m):: - -\begin{coq_example} -Definition double (m:nat) := plus m m. -\end{coq_example} -This definition introduces the constant \texttt{double} defined as the -expression \texttt{fun m:nat => plus m m}. -The abstraction introduced by \texttt{fun} is explained as follows. The expression -\verb+fun x:A => e+ is well formed of type \verb+A->B+ in a context -whenever the expression \verb+e+ is well-formed of type \verb+B+ in -the given context to which we add the declaration that \verb+x+ -is of type \verb+A+. Here \verb+x+ is a bound, or dummy variable in -the expression \verb+fun x:A => e+. For instance we could as well have -defined \verb:double: as \verb+fun n:nat => (plus n n)+. - -Bound (local) variables and free (global) variables may be mixed. -For instance, we may define the function which adds the constant \verb:n: -to its argument as -\begin{coq_example} -Definition add_n (m:nat) := plus m n. -\end{coq_example} -However, note that here we may not rename the formal argument $m$ into $n$ -without capturing the free occurrence of $n$, and thus changing the meaning -of the defined notion. - -Binding operations are well known for instance in logic, where they -are called quantifiers. Thus we may universally quantify a -proposition such as $m>0$ in order to get a universal proposition -$\forall m\cdot m>0$. Indeed this operator is available in \Coq, with -the following syntax: \verb+forall m:nat, gt m O+. Similarly to the -case of the functional abstraction binding, we are obliged to declare -explicitly the type of the quantified variable. We check: -\begin{coq_example} -Check (forall m:nat, gt m 0). -\end{coq_example} -We may clean-up the development by removing the contents of the -current section: -\begin{coq_example} -Reset Declaration. -\end{coq_example} - -\section{Introduction to the proof engine: Minimal Logic} - -In the following, we are going to consider various propositions, built -from atomic propositions $A, B, C$. This may be done easily, by -introducing these atoms as global variables declared of type \verb:Prop:. -It is easy to declare several names with the same specification: -\begin{coq_example} -Section Minimal_Logic. -Variables A B C : Prop. -\end{coq_example} - -We shall consider simple implications, such as $A\ra B$, read as -``$A$ implies $B$''. Remark that we overload the arrow symbol, which -has been used above as the functionality type constructor, and which -may be used as well as propositional connective: -\begin{coq_example} -Check (A -> B). -\end{coq_example} - -Let us now embark on a simple proof. We want to prove the easy tautology -$((A\ra (B\ra C))\ra (A\ra B)\ra (A\ra C)$. -We enter the proof engine by the command -\verb:Goal:, followed by the conjecture we want to verify: -\begin{coq_example} -Goal (A -> B -> C) -> (A -> B) -> A -> C. -\end{coq_example} - -The system displays the current goal below a double line, local hypotheses -(there are none initially) being displayed above the line. We call -the combination of local hypotheses with a goal a {\sl judgment}. -We are now in an inner -loop of the system, in proof mode. -New commands are available in this -mode, such as {\sl tactics}, which are proof combining primitives. -A tactic operates on the current goal by attempting to construct a proof -of the corresponding judgment, possibly from proofs of some -hypothetical judgments, which are then added to the current -list of conjectured judgments. -For instance, the \verb:intro: tactic is applicable to any judgment -whose goal is an implication, by moving the proposition to the left -of the application to the list of local hypotheses: -\begin{coq_example} -intro H. -\end{coq_example} - -Several introductions may be done in one step: -\begin{coq_example} -intros H' HA. -\end{coq_example} - -We notice that $C$, the current goal, may be obtained from hypothesis -\verb:H:, provided the truth of $A$ and $B$ are established. -The tactic \verb:apply: implements this piece of reasoning: -\begin{coq_example} -apply H. -\end{coq_example} - -We are now in the situation where we have two judgments as conjectures -that remain to be proved. Only the first is listed in full, for the -others the system displays only the corresponding subgoal, without its -local hypotheses list. Remark that \verb:apply: has kept the local -hypotheses of its father judgment, which are still available for -the judgments it generated. - -In order to solve the current goal, we just have to notice that it is -exactly available as hypothesis $HA$: -\begin{coq_example} -exact HA. -\end{coq_example} - -Now $H'$ applies: -\begin{coq_example} -apply H'. -\end{coq_example} - -And we may now conclude the proof as before, with \verb:exact HA.: -Actually, we may not bother with the name \verb:HA:, and just state that -the current goal is solvable from the current local assumptions: -\begin{coq_example} -assumption. -\end{coq_example} - -The proof is now finished. We may either discard it, by using the -command \verb:Abort: which returns to the standard \Coq~ toplevel loop -without further ado, or else save it as a lemma in the current context, -under name say \verb:trivial_lemma:: -\begin{coq_example} -Save trivial_lemma. -\end{coq_example} - -As a comment, the system shows the proof script listing all tactic -commands used in the proof. - -Let us redo the same proof with a few variations. First of all we may name -the initial goal as a conjectured lemma: -\begin{coq_example} -Lemma distr_impl : (A -> B -> C) -> (A -> B) -> A -> C. -\end{coq_example} - -Next, we may omit the names of local assumptions created by the introduction -tactics, they can be automatically created by the proof engine as new -non-clashing names. -\begin{coq_example} -intros. -\end{coq_example} - -The \verb:intros: tactic, with no arguments, effects as many individual -applications of \verb:intro: as is legal. - -Then, we may compose several tactics together in sequence, or in parallel, -through {\sl tacticals}, that is tactic combinators. The main constructions -are the following: -\begin{itemize} -\item $T_1 ; T_2$ (read $T_1$ then $T_2$) applies tactic $T_1$ to the current -goal, and then tactic $T_2$ to all the subgoals generated by $T_1$. -\item $T; [T_1 | T_2 | ... | T_n]$ applies tactic $T$ to the current -goal, and then tactic $T_1$ to the first newly generated subgoal, -..., $T_n$ to the nth. -\end{itemize} - -We may thus complete the proof of \verb:distr_impl: with one composite tactic: -\begin{coq_example} -apply H; [ assumption | apply H0; assumption ]. -\end{coq_example} - -Let us now save lemma \verb:distr_impl:: -\begin{coq_example} -Save. -\end{coq_example} - -Here \verb:Save: needs no argument, since we gave the name \verb:distr_impl: -in advance; -it is however possible to override the given name by giving a different -argument to command \verb:Save:. - -Actually, such an easy combination of tactics \verb:intro:, \verb:apply: -and \verb:assumption: may be found completely automatically by an automatic -tactic, called \verb:auto:, without user guidance: -\begin{coq_example} -Lemma distr_imp : (A -> B -> C) -> (A -> B) -> A -> C. -auto. -\end{coq_example} - -This time, we do not save the proof, we just discard it with the \verb:Abort: -command: - -\begin{coq_example} -Abort. -\end{coq_example} - -At any point during a proof, we may use \verb:Abort: to exit the proof mode -and go back to Coq's main loop. We may also use \verb:Restart: to restart -from scratch the proof of the same lemma. We may also use \verb:Undo: to -backtrack one step, and more generally \verb:Undo n: to -backtrack n steps. - -We end this section by showing a useful command, \verb:Inspect n.:, -which inspects the global \Coq~ environment, showing the last \verb:n: declared -notions: -\begin{coq_example} -Inspect 3. -\end{coq_example} - -The declarations, whether global parameters or axioms, are shown preceded by -\verb:***:; definitions and lemmas are stated with their specification, but -their value (or proof-term) is omitted. - -\section{Propositional Calculus} - -\subsection{Conjunction} - -We have seen how \verb:intro: and \verb:apply: tactics could be combined -in order to prove implicational statements. More generally, \Coq~ favors a style -of reasoning, called {\sl Natural Deduction}, which decomposes reasoning into -so called {\sl introduction rules}, which tell how to prove a goal whose main -operator is a given propositional connective, and {\sl elimination rules}, -which tell how to use an hypothesis whose main operator is the propositional -connective. Let us show how to use these ideas for the propositional connectives -\verb:/\: and \verb:\/:. - -\begin{coq_example} -Lemma and_commutative : A /\ B -> B /\ A. -intro. -\end{coq_example} - -We make use of the conjunctive hypothesis \verb:H: with the \verb:elim: tactic, -which breaks it into its components: -\begin{coq_example} -elim H. -\end{coq_example} - -We now use the conjunction introduction tactic \verb:split:, which splits the -conjunctive goal into the two subgoals: -\begin{coq_example} -split. -\end{coq_example} - -and the proof is now trivial. Indeed, the whole proof is obtainable as follows: -\begin{coq_example} -Restart. -intro H; elim H; auto. -Qed. -\end{coq_example} - -The tactic \verb:auto: succeeded here because it knows as a hint the -conjunction introduction operator \verb+conj+ -\begin{coq_example} -Check conj. -\end{coq_example} - -Actually, the tactic \verb+Split+ is just an abbreviation for \verb+apply conj.+ - -What we have just seen is that the \verb:auto: tactic is more powerful than -just a simple application of local hypotheses; it tries to apply as well -lemmas which have been specified as hints. A -\verb:Hint Resolve: command registers a -lemma as a hint to be used from now on by the \verb:auto: tactic, whose power -may thus be incrementally augmented. - -\subsection{Disjunction} - -In a similar fashion, let us consider disjunction: - -\begin{coq_example} -Lemma or_commutative : A \/ B -> B \/ A. -intro H; elim H. -\end{coq_example} - -Let us prove the first subgoal in detail. We use \verb:intro: in order to -be left to prove \verb:B\/A: from \verb:A:: - -\begin{coq_example} -intro HA. -\end{coq_example} - -Here the hypothesis \verb:H: is not needed anymore. We could choose to -actually erase it with the tactic \verb:clear:; in this simple proof it -does not really matter, but in bigger proof developments it is useful to -clear away unnecessary hypotheses which may clutter your screen. -\begin{coq_example} -clear H. -\end{coq_example} - -The disjunction connective has two introduction rules, since \verb:P\/Q: -may be obtained from \verb:P: or from \verb:Q:; the two corresponding -proof constructors are called respectively \verb:or_introl: and -\verb:or_intror:; they are applied to the current goal by tactics -\verb:left: and \verb:right: respectively. For instance: -\begin{coq_example} -right. -trivial. -\end{coq_example} -The tactic \verb:trivial: works like \verb:auto: with the hints -database, but it only tries those tactics that can solve the goal in one -step. - -As before, all these tedious elementary steps may be performed automatically, -as shown for the second symmetric case: - -\begin{coq_example} -auto. -\end{coq_example} - -However, \verb:auto: alone does not succeed in proving the full lemma, because -it does not try any elimination step. -It is a bit disappointing that \verb:auto: is not able to prove automatically -such a simple tautology. The reason is that we want to keep -\verb:auto: efficient, so that it is always effective to use. - -\subsection{Tauto} - -A complete tactic for propositional -tautologies is indeed available in \Coq~ as the \verb:tauto: tactic. -\begin{coq_example} -Restart. -tauto. -Qed. -\end{coq_example} - -It is possible to inspect the actual proof tree constructed by \verb:tauto:, -using a standard command of the system, which prints the value of any notion -currently defined in the context: -\begin{coq_example} -Print or_commutative. -\end{coq_example} - -It is not easy to understand the notation for proof terms without a few -explanations. The \texttt{fun} prefix, such as \verb+fun H:A\/B =>+, -corresponds -to \verb:intro H:, whereas a subterm such as -\verb:(or_intror: \verb:B H0): -corresponds to the sequence \verb:apply or_intror; exact H0:. -The generic combinator \verb:or_intror: needs to be instantiated by -the two properties \verb:B: and \verb:A:. Because \verb:A: can be -deduced from the type of \verb:H0:, only \verb:B: is printed. -The two instantiations are effected automatically by the tactic -\verb:apply: when pattern-matching a goal. The specialist will of course -recognize our proof term as a $\lambda$-term, used as notation for the -natural deduction proof term through the Curry-Howard isomorphism. The -naive user of \Coq~ may safely ignore these formal details. - -Let us exercise the \verb:tauto: tactic on a more complex example: -\begin{coq_example} -Lemma distr_and : A -> B /\ C -> (A -> B) /\ (A -> C). -tauto. -Qed. -\end{coq_example} - -\subsection{Classical reasoning} - -\verb:tauto: always comes back with an answer. Here is an example where it -fails: -\begin{coq_example} -Lemma Peirce : ((A -> B) -> A) -> A. -try tauto. -\end{coq_example} - -Note the use of the \verb:Try: tactical, which does nothing if its tactic -argument fails. - -This may come as a surprise to someone familiar with classical reasoning. -Peirce's lemma is true in Boolean logic, i.e. it evaluates to \verb:true: for -every truth-assignment to \verb:A: and \verb:B:. Indeed the double negation -of Peirce's law may be proved in \Coq~ using \verb:tauto:: -\begin{coq_example} -Abort. -Lemma NNPeirce : ~ ~ (((A -> B) -> A) -> A). -tauto. -Qed. -\end{coq_example} - -In classical logic, the double negation of a proposition is equivalent to this -proposition, but in the constructive logic of \Coq~ this is not so. If you -want to use classical logic in \Coq, you have to import explicitly the -\verb:Classical: module, which will declare the axiom \verb:classic: -of excluded middle, and classical tautologies such as de Morgan's laws. -The \verb:Require: command is used to import a module from \Coq's library: -\begin{coq_example} -Require Import Classical. -Check NNPP. -\end{coq_example} - -and it is now easy (although admittedly not the most direct way) to prove -a classical law such as Peirce's: -\begin{coq_example} -Lemma Peirce : ((A -> B) -> A) -> A. -apply NNPP; tauto. -Qed. -\end{coq_example} - -Here is one more example of propositional reasoning, in the shape of -a Scottish puzzle. A private club has the following rules: -\begin{enumerate} -\item Every non-scottish member wears red socks -\item Every member wears a kilt or doesn't wear red socks -\item The married members don't go out on Sunday -\item A member goes out on Sunday if and only if he is Scottish -\item Every member who wears a kilt is Scottish and married -\item Every scottish member wears a kilt -\end{enumerate} -Now, we show that these rules are so strict that no one can be accepted. -\begin{coq_example} -Section club. -Variables Scottish RedSocks WearKilt Married GoOutSunday : Prop. -Hypothesis rule1 : ~ Scottish -> RedSocks. -Hypothesis rule2 : WearKilt \/ ~ RedSocks. -Hypothesis rule3 : Married -> ~ GoOutSunday. -Hypothesis rule4 : GoOutSunday <-> Scottish. -Hypothesis rule5 : WearKilt -> Scottish /\ Married. -Hypothesis rule6 : Scottish -> WearKilt. -Lemma NoMember : False. -tauto. -Qed. -\end{coq_example} -At that point \verb:NoMember: is a proof of the absurdity depending on -hypotheses. -We may end the section, in that case, the variables and hypotheses -will be discharged, and the type of \verb:NoMember: will be -generalised. - -\begin{coq_example} -End club. -Check NoMember. -\end{coq_example} - -\section{Predicate Calculus} - -Let us now move into predicate logic, and first of all into first-order -predicate calculus. The essence of predicate calculus is that to try to prove -theorems in the most abstract possible way, without using the definitions of -the mathematical notions, but by formal manipulations of uninterpreted -function and predicate symbols. - -\subsection{Sections and signatures} - -Usually one works in some domain of discourse, over which range the individual -variables and function symbols. In \Coq~ we speak in a language with a rich -variety of types, so me may mix several domains of discourse, in our -multi-sorted language. For the moment, we just do a few exercises, over a -domain of discourse \verb:D: axiomatised as a \verb:Set:, and we consider two -predicate symbols \verb:P: and \verb:R: over \verb:D:, of arities -respectively 1 and 2. Such abstract entities may be entered in the context -as global variables. But we must be careful about the pollution of our -global environment by such declarations. For instance, we have already -polluted our \Coq~ session by declaring the variables -\verb:n:, \verb:Pos_n:, \verb:A:, \verb:B:, and \verb:C:. If we want to revert to the clean state of -our initial session, we may use the \Coq~ \verb:Reset: command, which returns -to the state just prior the given global notion as we did before to -remove a section, or we may return to the initial state using~: -\begin{coq_example} -Reset Initial. -\end{coq_example} - -We shall now declare a new \verb:Section:, which will allow us to define -notions local to a well-delimited scope. We start by assuming a domain of -discourse \verb:D:, and a binary relation \verb:R: over \verb:D:: -\begin{coq_example} -Section Predicate_calculus. -Variable D : Set. -Variable R : D -> D -> Prop. -\end{coq_example} - -As a simple example of predicate calculus reasoning, let us assume -that relation \verb:R: is symmetric and transitive, and let us show that -\verb:R: is reflexive in any point \verb:x: which has an \verb:R: successor. -Since we do not want to make the assumptions about \verb:R: global axioms of -a theory, but rather local hypotheses to a theorem, we open a specific -section to this effect. -\begin{coq_example} -Section R_sym_trans. -Hypothesis R_symmetric : forall x y:D, R x y -> R y x. -Hypothesis R_transitive : forall x y z:D, R x y -> R y z -> R x z. -\end{coq_example} - -Remark the syntax \verb+forall x:D,+ which stands for universal quantification -$\forall x : D$. - -\subsection{Existential quantification} - -We now state our lemma, and enter proof mode. -\begin{coq_example} -Lemma refl_if : forall x:D, (exists y, R x y) -> R x x. -\end{coq_example} - -Remark that the hypotheses which are local to the currently opened sections -are listed as local hypotheses to the current goals. -The rationale is that these hypotheses are going to be discharged, as we -shall see, when we shall close the corresponding sections. - -Note the functional syntax for existential quantification. The existential -quantifier is built from the operator \verb:ex:, which expects a -predicate as argument: -\begin{coq_example} -Check ex. -\end{coq_example} -and the notation \verb+(exists x:D, P x)+ is just concrete syntax for -\verb+(ex D (fun x:D => P x))+. -Existential quantification is handled in \Coq~ in a similar -fashion to the connectives \verb:/\: and \verb:\/: : it is introduced by -the proof combinator \verb:ex_intro:, which is invoked by the specific -tactic \verb:Exists:, and its elimination provides a witness \verb+a:D+ to -\verb:P:, together with an assumption \verb+h:(P a)+ that indeed \verb+a+ -verifies \verb:P:. Let us see how this works on this simple example. -\begin{coq_example} -intros x x_Rlinked. -\end{coq_example} - -Remark that \verb:intros: treats universal quantification in the same way -as the premises of implications. Renaming of bound variables occurs -when it is needed; for instance, had we started with \verb:intro y:, -we would have obtained the goal: -\begin{coq_eval} -Undo. -\end{coq_eval} -\begin{coq_example} -intro y. -\end{coq_example} -\begin{coq_eval} -Undo. -intros x x_Rlinked. -\end{coq_eval} - -Let us now use the existential hypothesis \verb:x_Rlinked: to -exhibit an R-successor y of x. This is done in two steps, first with -\verb:elim:, then with \verb:intros: - -\begin{coq_example} -elim x_Rlinked. -intros y Rxy. -\end{coq_example} - -Now we want to use \verb:R_transitive:. The \verb:apply: tactic will know -how to match \verb:x: with \verb:x:, and \verb:z: with \verb:x:, but needs -help on how to instantiate \verb:y:, which appear in the hypotheses of -\verb:R_transitive:, but not in its conclusion. We give the proper hint -to \verb:apply: in a \verb:with: clause, as follows: -\begin{coq_example} -apply R_transitive with y. -\end{coq_example} - -The rest of the proof is routine: -\begin{coq_example} -assumption. -apply R_symmetric; assumption. -\end{coq_example} -\begin{coq_example*} -Qed. -\end{coq_example*} - -Let us now close the current section. -\begin{coq_example} -End R_sym_trans. -\end{coq_example} - -Here \Coq's printout is a warning that all local hypotheses have been -discharged in the statement of \verb:refl_if:, which now becomes a general -theorem in the first-order language declared in section -\verb:Predicate_calculus:. In this particular example, the use of section -\verb:R_sym_trans: has not been really significant, since we could have -instead stated theorem \verb:refl_if: in its general form, and done -basically the same proof, obtaining \verb:R_symmetric: and -\verb:R_transitive: as local hypotheses by initial \verb:intros: rather -than as global hypotheses in the context. But if we had pursued the -theory by proving more theorems about relation \verb:R:, -we would have obtained all general statements at the closing of the section, -with minimal dependencies on the hypotheses of symmetry and transitivity. - -\subsection{Paradoxes of classical predicate calculus} - -Let us illustrate this feature by pursuing our \verb:Predicate_calculus: -section with an enrichment of our language: we declare a unary predicate -\verb:P: and a constant \verb:d:: -\begin{coq_example} -Variable P : D -> Prop. -Variable d : D. -\end{coq_example} - -We shall now prove a well-known fact from first-order logic: a universal -predicate is non-empty, or in other terms existential quantification -follows from universal quantification. -\begin{coq_example} -Lemma weird : (forall x:D, P x) -> exists a, P a. - intro UnivP. -\end{coq_example} - -First of all, notice the pair of parentheses around -\verb+forall x:D, P x+ in -the statement of lemma \verb:weird:. -If we had omitted them, \Coq's parser would have interpreted the -statement as a truly trivial fact, since we would -postulate an \verb:x: verifying \verb:(P x):. Here the situation is indeed -more problematic. If we have some element in \verb:Set: \verb:D:, we may -apply \verb:UnivP: to it and conclude, otherwise we are stuck. Indeed -such an element \verb:d: exists, but this is just by virtue of our -new signature. This points out a subtle difference between standard -predicate calculus and \Coq. In standard first-order logic, -the equivalent of lemma \verb:weird: always holds, -because such a rule is wired in the inference rules for quantifiers, the -semantic justification being that the interpretation domain is assumed to -be non-empty. Whereas in \Coq, where types are not assumed to be -systematically inhabited, lemma \verb:weird: only holds in signatures -which allow the explicit construction of an element in the domain of -the predicate. - -Let us conclude the proof, in order to show the use of the \verb:Exists: -tactic: -\begin{coq_example} -exists d; trivial. -Qed. -\end{coq_example} - -Another fact which illustrates the sometimes disconcerting rules of -classical -predicate calculus is Smullyan's drinkers' paradox: ``In any non-empty -bar, there is a person such that if she drinks, then everyone drinks''. -We modelize the bar by Set \verb:D:, drinking by predicate \verb:P:. -We shall need classical reasoning. Instead of loading the \verb:Classical: -module as we did above, we just state the law of excluded middle as a -local hypothesis schema at this point: -\begin{coq_example} -Hypothesis EM : forall A:Prop, A \/ ~ A. -Lemma drinker : exists x:D, P x -> forall x:D, P x. -\end{coq_example} -The proof goes by cases on whether or not -there is someone who does not drink. Such reasoning by cases proceeds -by invoking the excluded middle principle, via \verb:elim: of the -proper instance of \verb:EM:: -\begin{coq_example} -elim (EM (exists x, ~ P x)). -\end{coq_example} - -We first look at the first case. Let Tom be the non-drinker: -\begin{coq_example} -intro Non_drinker; elim Non_drinker; intros Tom Tom_does_not_drink. -\end{coq_example} - -We conclude in that case by considering Tom, since his drinking leads to -a contradiction: -\begin{coq_example} -exists Tom; intro Tom_drinks. -\end{coq_example} - -There are several ways in which we may eliminate a contradictory case; -a simple one is to use the \verb:absurd: tactic as follows: -\begin{coq_example} -absurd (P Tom); trivial. -\end{coq_example} - -We now proceed with the second case, in which actually any person will do; -such a John Doe is given by the non-emptiness witness \verb:d:: -\begin{coq_example} -intro No_nondrinker; exists d; intro d_drinks. -\end{coq_example} - -Now we consider any Dick in the bar, and reason by cases according to its -drinking or not: -\begin{coq_example} -intro Dick; elim (EM (P Dick)); trivial. -\end{coq_example} - -The only non-trivial case is again treated by contradiction: -\begin{coq_example} -intro Dick_does_not_drink; absurd (exists x, ~ P x); trivial. -exists Dick; trivial. -Qed. -\end{coq_example} - -Now, let us close the main section and look at the complete statements -we proved: -\begin{coq_example} -End Predicate_calculus. -Check refl_if. -Check weird. -Check drinker. -\end{coq_example} - -Remark how the three theorems are completely generic in the most general -fashion; -the domain \verb:D: is discharged in all of them, \verb:R: is discharged in -\verb:refl_if: only, \verb:P: is discharged only in \verb:weird: and -\verb:drinker:, along with the hypothesis that \verb:D: is inhabited. -Finally, the excluded middle hypothesis is discharged only in -\verb:drinker:. - -Note that the name \verb:d: has vanished as well from -the statements of \verb:weird: and \verb:drinker:, -since \Coq's pretty-printer replaces -systematically a quantification such as \verb+forall d:D, E+, where \verb:d: -does not occur in \verb:E:, by the functional notation \verb:D->E:. -Similarly the name \verb:EM: does not appear in \verb:drinker:. - -Actually, universal quantification, implication, -as well as function formation, are -all special cases of one general construct of type theory called -{\sl dependent product}. This is the mathematical construction -corresponding to an indexed family of functions. A function -$f\in \Pi x:D\cdot Cx$ maps an element $x$ of its domain $D$ to its -(indexed) codomain $Cx$. Thus a proof of $\forall x:D\cdot Px$ is -a function mapping an element $x$ of $D$ to a proof of proposition $Px$. - - -\subsection{Flexible use of local assumptions} - -Very often during the course of a proof we want to retrieve a local -assumption and reintroduce it explicitly in the goal, for instance -in order to get a more general induction hypothesis. The tactic -\verb:generalize: is what is needed here: - -\begin{coq_example} -Section Predicate_Calculus. -Variables P Q : nat -> Prop. -Variable R : nat -> nat -> Prop. -Lemma PQR : - forall x y:nat, (R x x -> P x -> Q x) -> P x -> R x y -> Q x. -intros. -generalize H0. -\end{coq_example} - -Sometimes it may be convenient to use a lemma, although we do not have -a direct way to appeal to such an already proven fact. The tactic \verb:cut: -permits to use the lemma at this point, keeping the corresponding proof -obligation as a new subgoal: -\begin{coq_example} -cut (R x x); trivial. -\end{coq_example} -We clean the goal by doing an \verb:Abort: command. -\begin{coq_example*} -Abort. -\end{coq_example*} - - -\subsection{Equality} - -The basic equality provided in \Coq~ is Leibniz equality, noted infix like -\verb+x=y+, when \verb:x: and \verb:y: are two expressions of -type the same Set. The replacement of \verb:x: by \verb:y: in any -term is effected by a variety of tactics, such as \verb:rewrite: -and \verb:replace:. - -Let us give a few examples of equality replacement. Let us assume that -some arithmetic function \verb:f: is null in zero: -\begin{coq_example} -Variable f : nat -> nat. -Hypothesis foo : f 0 = 0. -\end{coq_example} - -We want to prove the following conditional equality: -\begin{coq_example*} -Lemma L1 : forall k:nat, k = 0 -> f k = k. -\end{coq_example*} - -As usual, we first get rid of local assumptions with \verb:intro:: -\begin{coq_example} -intros k E. -\end{coq_example} - -Let us now use equation \verb:E: as a left-to-right rewriting: -\begin{coq_example} -rewrite E. -\end{coq_example} -This replaced both occurrences of \verb:k: by \verb:O:. - -Now \verb:apply foo: will finish the proof: - -\begin{coq_example} -apply foo. -Qed. -\end{coq_example} - -When one wants to rewrite an equality in a right to left fashion, we should -use \verb:rewrite <- E: rather than \verb:rewrite E: or the equivalent -\verb:rewrite -> E:. -Let us now illustrate the tactic \verb:replace:. -\begin{coq_example} -Hypothesis f10 : f 1 = f 0. -Lemma L2 : f (f 1) = 0. -replace (f 1) with 0. -\end{coq_example} -What happened here is that the replacement left the first subgoal to be -proved, but another proof obligation was generated by the \verb:replace: -tactic, as the second subgoal. The first subgoal is solved immediately -by applying lemma \verb:foo:; the second one transitivity and then -symmetry of equality, for instance with tactics \verb:transitivity: and -\verb:symmetry:: -\begin{coq_example} -apply foo. -transitivity (f 0); symmetry; trivial. -\end{coq_example} -In case the equality $t=u$ generated by \verb:replace: $u$ \verb:with: -$t$ is an assumption -(possibly modulo symmetry), it will be automatically proved and the -corresponding goal will not appear. For instance: -\begin{coq_example} -Restart. -replace (f 0) with 0. -rewrite f10; rewrite foo; trivial. -Qed. -\end{coq_example} - -\section{Using definitions} - -The development of mathematics does not simply proceed by logical -argumentation from first principles: definitions are used in an essential way. -A formal development proceeds by a dual process of abstraction, where one -proves abstract statements in predicate calculus, and use of definitions, -which in the contrary one instantiates general statements with particular -notions in order to use the structure of mathematical values for the proof of -more specialised properties. - -\subsection{Unfolding definitions} - -Assume that we want to develop the theory of sets represented as characteristic -predicates over some universe \verb:U:. For instance: -\begin{coq_example} -Variable U : Type. -Definition set := U -> Prop. -Definition element (x:U) (S:set) := S x. -Definition subset (A B:set) := forall x:U, element x A -> element x B. -\end{coq_example} - -Now, assume that we have loaded a module of general properties about -relations over some abstract type \verb:T:, such as transitivity: - -\begin{coq_example} -Definition transitive (T:Type) (R:T -> T -> Prop) := - forall x y z:T, R x y -> R y z -> R x z. -\end{coq_example} - -Now, assume that we want to prove that \verb:subset: is a \verb:transitive: -relation. -\begin{coq_example} -Lemma subset_transitive : transitive set subset. -\end{coq_example} - -In order to make any progress, one needs to use the definition of -\verb:transitive:. The \verb:unfold: tactic, which replaces all -occurrences of a defined notion by its definition in the current goal, -may be used here. -\begin{coq_example} -unfold transitive. -\end{coq_example} - -Now, we must unfold \verb:subset:: -\begin{coq_example} -unfold subset. -\end{coq_example} -Now, unfolding \verb:element: would be a mistake, because indeed a simple proof -can be found by \verb:auto:, keeping \verb:element: an abstract predicate: -\begin{coq_example} -auto. -\end{coq_example} - -Many variations on \verb:unfold: are provided in \Coq. For instance, -we may selectively unfold one designated occurrence: -\begin{coq_example} -Undo 2. -unfold subset at 2. -\end{coq_example} - -One may also unfold a definition in a given local hypothesis, using the -\verb:in: notation: -\begin{coq_example} -intros. -unfold subset in H. -\end{coq_example} - -Finally, the tactic \verb:red: does only unfolding of the head occurrence -of the current goal: -\begin{coq_example} -red. -auto. -Qed. -\end{coq_example} - - -\subsection{Principle of proof irrelevance} - -Even though in principle the proof term associated with a verified lemma -corresponds to a defined value of the corresponding specification, such -definitions cannot be unfolded in \Coq: a lemma is considered an {\sl opaque} -definition. This conforms to the mathematical tradition of {\sl proof -irrelevance}: the proof of a logical proposition does not matter, and the -mathematical justification of a logical development relies only on -{\sl provability} of the lemmas used in the formal proof. - -Conversely, ordinary mathematical definitions can be unfolded at will, they -are {\sl transparent}. -\chapter{Induction} - -\section{Data Types as Inductively Defined Mathematical Collections} - -All the notions which were studied until now pertain to traditional -mathematical logic. Specifications of objects were abstract properties -used in reasoning more or less constructively; we are now entering -the realm of inductive types, which specify the existence of concrete -mathematical constructions. - -\subsection{Booleans} - -Let us start with the collection of booleans, as they are specified -in the \Coq's \verb:Prelude: module: -\begin{coq_example} -Inductive bool : Set := true | false. -\end{coq_example} - -Such a declaration defines several objects at once. First, a new -\verb:Set: is declared, with name \verb:bool:. Then the {\sl constructors} -of this \verb:Set: are declared, called \verb:true: and \verb:false:. -Those are analogous to introduction rules of the new Set \verb:bool:. -Finally, a specific elimination rule for \verb:bool: is now available, which -permits to reason by cases on \verb:bool: values. Three instances are -indeed defined as new combinators in the global context: \verb:bool_ind:, -a proof combinator corresponding to reasoning by cases, -\verb:bool_rec:, an if-then-else programming construct, -and \verb:bool_rect:, a similar combinator at the level of types. -Indeed: -\begin{coq_example} -Check bool_ind. -Check bool_rec. -Check bool_rect. -\end{coq_example} - -Let us for instance prove that every Boolean is true or false. -\begin{coq_example} -Lemma duality : forall b:bool, b = true \/ b = false. -intro b. -\end{coq_example} - -We use the knowledge that \verb:b: is a \verb:bool: by calling tactic -\verb:elim:, which is this case will appeal to combinator \verb:bool_ind: -in order to split the proof according to the two cases: -\begin{coq_example} -elim b. -\end{coq_example} - -It is easy to conclude in each case: -\begin{coq_example} -left; trivial. -right; trivial. -\end{coq_example} - -Indeed, the whole proof can be done with the combination of the -\verb:simple induction: tactic, which combines \verb:intro: and \verb:elim:, -with good old \verb:auto:: -\begin{coq_example} -Restart. -simple induction b; auto. -Qed. -\end{coq_example} - -\subsection{Natural numbers} - -Similarly to Booleans, natural numbers are defined in the \verb:Prelude: -module with constructors \verb:S: and \verb:O:: -\begin{coq_example} -Inductive nat : Set := - | O : nat - | S : nat -> nat. -\end{coq_example} - -The elimination principles which are automatically generated are Peano's -induction principle, and a recursion operator: -\begin{coq_example} -Check nat_ind. -Check nat_rec. -\end{coq_example} - -Let us start by showing how to program the standard primitive recursion -operator \verb:prim_rec: from the more general \verb:nat_rec:: -\begin{coq_example} -Definition prim_rec := nat_rec (fun i:nat => nat). -\end{coq_example} - -That is, instead of computing for natural \verb:i: an element of the indexed -\verb:Set: \verb:(P i):, \verb:prim_rec: computes uniformly an element of -\verb:nat:. Let us check the type of \verb:prim_rec:: -\begin{coq_example} -Check prim_rec. -\end{coq_example} - -Oops! Instead of the expected type \verb+nat->(nat->nat->nat)->nat->nat+ we -get an apparently more complicated expression. Indeed the type of -\verb:prim_rec: is equivalent by rule $\beta$ to its expected type; this may -be checked in \Coq~ by command \verb:Eval Cbv Beta:, which $\beta$-reduces -an expression to its {\sl normal form}: -\begin{coq_example} -Eval cbv beta in - ((fun _:nat => nat) O -> - (forall y:nat, (fun _:nat => nat) y -> (fun _:nat => nat) (S y)) -> - forall n:nat, (fun _:nat => nat) n). -\end{coq_example} - -Let us now show how to program addition with primitive recursion: -\begin{coq_example} -Definition addition (n m:nat) := prim_rec m (fun p rec:nat => S rec) n. -\end{coq_example} - -That is, we specify that \verb+(addition n m)+ computes by cases on \verb:n: -according to its main constructor; when \verb:n = O:, we get \verb:m:; - when \verb:n = S p:, we get \verb:(S rec):, where \verb:rec: is the result -of the recursive computation \verb+(addition p m)+. Let us verify it by -asking \Coq~to compute for us say $2+3$: -\begin{coq_example} -Eval compute in (addition (S (S O)) (S (S (S O)))). -\end{coq_example} - -Actually, we do not have to do all explicitly. {\Coq} provides a -special syntax {\tt Fixpoint/match} for generic primitive recursion, -and we could thus have defined directly addition as: - -\begin{coq_example} -Fixpoint plus (n m:nat) {struct n} : nat := - match n with - | O => m - | S p => S (plus p m) - end. -\end{coq_example} - -For the rest of the session, we shall clean up what we did so far with -types \verb:bool: and \verb:nat:, in order to use the initial definitions -given in \Coq's \verb:Prelude: module, and not to get confusing error -messages due to our redefinitions. We thus revert to the state before -our definition of \verb:bool: with the \verb:Reset: command: -\begin{coq_example} -Reset bool. -\end{coq_example} - - -\subsection{Simple proofs by induction} - -\begin{coq_eval} -Reset Initial. -\end{coq_eval} - -Let us now show how to do proofs by structural induction. We start with easy -properties of the \verb:plus: function we just defined. Let us first -show that $n=n+0$. -\begin{coq_example} -Lemma plus_n_O : forall n:nat, n = n + 0. -intro n; elim n. -\end{coq_example} - -What happened was that \verb:elim n:, in order to construct a \verb:Prop: -(the initial goal) from a \verb:nat: (i.e. \verb:n:), appealed to the -corresponding induction principle \verb:nat_ind: which we saw was indeed -exactly Peano's induction scheme. Pattern-matching instantiated the -corresponding predicate \verb:P: to \verb+fun n:nat => n = n + 0+, and we get -as subgoals the corresponding instantiations of the base case \verb:(P O): , -and of the inductive step \verb+forall y:nat, P y -> P (S y)+. -In each case we get an instance of function \verb:plus: in which its second -argument starts with a constructor, and is thus amenable to simplification -by primitive recursion. The \Coq~tactic \verb:simpl: can be used for -this purpose: -\begin{coq_example} -simpl. -auto. -\end{coq_example} - -We proceed in the same way for the base step: -\begin{coq_example} -simpl; auto. -Qed. -\end{coq_example} - -Here \verb:auto: succeeded, because it used as a hint lemma \verb:eq_S:, -which say that successor preserves equality: -\begin{coq_example} -Check eq_S. -\end{coq_example} - -Actually, let us see how to declare our lemma \verb:plus_n_O: as a hint -to be used by \verb:auto:: -\begin{coq_example} -Hint Resolve plus_n_O . -\end{coq_example} - -We now proceed to the similar property concerning the other constructor -\verb:S:: -\begin{coq_example} -Lemma plus_n_S : forall n m:nat, S (n + m) = n + S m. -\end{coq_example} - -We now go faster, remembering that tactic \verb:simple induction: does the -necessary \verb:intros: before applying \verb:elim:. Factoring simplification -and automation in both cases thanks to tactic composition, we prove this -lemma in one line: -\begin{coq_example} -simple induction n; simpl; auto. -Qed. -Hint Resolve plus_n_S . -\end{coq_example} - -Let us end this exercise with the commutativity of \verb:plus:: - -\begin{coq_example} -Lemma plus_com : forall n m:nat, n + m = m + n. -\end{coq_example} - -Here we have a choice on doing an induction on \verb:n: or on \verb:m:, the -situation being symmetric. For instance: -\begin{coq_example} -simple induction m; simpl; auto. -\end{coq_example} - -Here \verb:auto: succeeded on the base case, thanks to our hint -\verb:plus_n_O:, but the induction step requires rewriting, which -\verb:auto: does not handle: - -\begin{coq_example} -intros m' E; rewrite <- E; auto. -Qed. -\end{coq_example} - -\subsection{Discriminate} - -It is also possible to define new propositions by primitive recursion. -Let us for instance define the predicate which discriminates between -the constructors \verb:O: and \verb:S:: it computes to \verb:False: -when its argument is \verb:O:, and to \verb:True: when its argument is -of the form \verb:(S n):: -\begin{coq_example} -Definition Is_S (n:nat) := match n with - | O => False - | S p => True - end. -\end{coq_example} - -Now we may use the computational power of \verb:Is_S: in order to prove -trivially that \verb:(Is_S (S n)):: -\begin{coq_example} -Lemma S_Is_S : forall n:nat, Is_S (S n). -simpl; trivial. -Qed. -\end{coq_example} - -But we may also use it to transform a \verb:False: goal into -\verb:(Is_S O):. Let us show a particularly important use of this feature; -we want to prove that \verb:O: and \verb:S: construct different values, one -of Peano's axioms: -\begin{coq_example} -Lemma no_confusion : forall n:nat, 0 <> S n. -\end{coq_example} - -First of all, we replace negation by its definition, by reducing the -goal with tactic \verb:red:; then we get contradiction by successive -\verb:intros:: -\begin{coq_example} -red; intros n H. -\end{coq_example} - -Now we use our trick: -\begin{coq_example} -change (Is_S 0). -\end{coq_example} - -Now we use equality in order to get a subgoal which computes out to -\verb:True:, which finishes the proof: -\begin{coq_example} -rewrite H; trivial. -simpl; trivial. -\end{coq_example} - -Actually, a specific tactic \verb:discriminate: is provided -to produce mechanically such proofs, without the need for the user to define -explicitly the relevant discrimination predicates: - -\begin{coq_example} -Restart. -intro n; discriminate. -Qed. -\end{coq_example} - - -\section{Logic programming} - -In the same way as we defined standard data-types above, we -may define inductive families, and for instance inductive predicates. -Here is the definition of predicate $\le$ over type \verb:nat:, as -given in \Coq's \verb:Prelude: module: -\begin{coq_example*} -Inductive le (n:nat) : nat -> Prop := - | le_n : le n n - | le_S : forall m:nat, le n m -> le n (S m). -\end{coq_example*} - -This definition introduces a new predicate \verb+le:nat->nat->Prop+, -and the two constructors \verb:le_n: and \verb:le_S:, which are the -defining clauses of \verb:le:. That is, we get not only the ``axioms'' -\verb:le_n: and \verb:le_S:, but also the converse property, that -\verb:(le n m): if and only if this statement can be obtained as a -consequence of these defining clauses; that is, \verb:le: is the -minimal predicate verifying clauses \verb:le_n: and \verb:le_S:. This is -insured, as in the case of inductive data types, by an elimination principle, -which here amounts to an induction principle \verb:le_ind:, stating this -minimality property: -\begin{coq_example} -Check le. -Check le_ind. -\end{coq_example} - -Let us show how proofs may be conducted with this principle. -First we show that $n\le m \Rightarrow n+1\le m+1$: -\begin{coq_example} -Lemma le_n_S : forall n m:nat, le n m -> le (S n) (S m). -intros n m n_le_m. -elim n_le_m. -\end{coq_example} - -What happens here is similar to the behaviour of \verb:elim: on natural -numbers: it appeals to the relevant induction principle, here \verb:le_ind:, -which generates the two subgoals, which may then be solved easily -with the help of the defining clauses of \verb:le:. -\begin{coq_example} -apply le_n; trivial. -intros; apply le_S; trivial. -\end{coq_example} - -Now we know that it is a good idea to give the defining clauses as hints, -so that the proof may proceed with a simple combination of -\verb:induction: and \verb:auto:. -\begin{coq_example} -Restart. -Hint Resolve le_n le_S . -\end{coq_example} - -We have a slight problem however. We want to say ``Do an induction on -hypothesis \verb:(le n m):'', but we have no explicit name for it. What we -do in this case is to say ``Do an induction on the first unnamed hypothesis'', -as follows. -\begin{coq_example} -simple induction 1; auto. -Qed. -\end{coq_example} - -Here is a more tricky problem. Assume we want to show that -$n\le 0 \Rightarrow n=0$. This reasoning ought to follow simply from the -fact that only the first defining clause of \verb:le: applies. -\begin{coq_example} -Lemma tricky : forall n:nat, le n 0 -> n = 0. -\end{coq_example} - -However, here trying something like \verb:induction 1: would lead -nowhere (try it and see what happens). -An induction on \verb:n: would not be convenient either. -What we must do here is analyse the definition of \verb"le" in order -to match hypothesis \verb:(le n O): with the defining clauses, to find -that only \verb:le_n: applies, whence the result. -This analysis may be performed by the ``inversion'' tactic -\verb:inversion_clear: as follows: -\begin{coq_example} -intros n H; inversion_clear H. -trivial. -Qed. -\end{coq_example} - -\chapter{Modules} - -\section{Opening library modules} - -When you start \Coq~ without further requirements in the command line, -you get a bare system with few libraries loaded. As we saw, a standard -prelude module provides the standard logic connectives, and a few -arithmetic notions. If you want to load and open other modules from -the library, you have to use the \verb"Require" command, as we saw for -classical logic above. For instance, if you want more arithmetic -constructions, you should request: -\begin{coq_example*} -Require Import Arith. -\end{coq_example*} - -Such a command looks for a (compiled) module file \verb:Arith.vo: in -the libraries registered by \Coq. Libraries inherit the structure of -the file system of the operating system and are registered with the -command \verb:Add LoadPath:. Physical directories are mapped to -logical directories. Especially the standard library of \Coq~ is -pre-registered as a library of name \verb=Coq=. Modules have absolute -unique names denoting their place in \Coq~ libraries. An absolute -name is a sequence of single identifiers separated by dots. E.g. the -module \verb=Arith= has full name \verb=Coq.Arith.Arith= and because -it resides in eponym subdirectory \verb=Arith= of the standard -library, it can be as well required by the command - -\begin{coq_example*} -Require Import Coq.Arith.Arith. -\end{coq_example*} - -This may be useful to avoid ambiguities if somewhere, in another branch -of the libraries known by Coq, another module is also called -\verb=Arith=. Notice that by default, when a library is registered, -all its contents, and all the contents of its subdirectories recursively are -visible and accessible by a short (relative) name as \verb=Arith=. -Notice also that modules or definitions not explicitly registered in -a library are put in a default library called \verb=Top=. - -The loading of a compiled file is quick, because the corresponding -development is not type-checked again. - -\section{Creating your own modules} - -You may create your own modules, by writing \Coq~ commands in a file, -say \verb:my_module.v:. Such a module may be simply loaded in the current -context, with command \verb:Load my_module:. It may also be compiled, -in ``batch'' mode, using the UNIX command -\verb:coqc:. Compiling the module \verb:my_module.v: creates a -file \verb:my_module.vo:{} that can be reloaded with command -\verb:Require Import my_module:. - -If a required module depends on other modules then the latters are -automatically required beforehand. However their contents is not -automatically visible. If you want a module \verb=M= required in a -module \verb=N= to be automatically visible when \verb=N= is required, -you should use \verb:Require Export M: in your module \verb:N:. - -\section{Managing the context} - -It is often difficult to remember the names of all lemmas and -definitions available in the current context, especially if large -libraries have been loaded. A convenient \verb:SearchAbout: command -is available to lookup all known facts -concerning a given predicate. For instance, if you want to know all the -known lemmas about the less or equal relation, just ask: -\begin{coq_example} -SearchAbout le. -\end{coq_example} -Another command \verb:Search: displays only lemmas where the searched -predicate appears at the head position in the conclusion. -\begin{coq_example} -Search le. -\end{coq_example} - -A new and more convenient search tool is \textsf{SearchPattern} -developed by Yves Bertot. It allows to find the theorems with a -conclusion matching a given pattern, where \verb:\_: can be used in -place of an arbitrary term. We remark in this example, that \Coq{} -provides usual infix notations for arithmetic operators. - -\begin{coq_example} -SearchPattern (_ + _ = _). -\end{coq_example} - -\section{Now you are on your own} - -This tutorial is necessarily incomplete. If you wish to pursue serious -proving in \Coq, you should now get your hands on \Coq's Reference Manual, -which contains a complete description of all the tactics we saw, -plus many more. -You also should look in the library of developed theories which is distributed -with \Coq, in order to acquaint yourself with various proof techniques. - - -\end{document} - -% $Id: Tutorial.tex 8715 2006-04-14 12:43:23Z cpaulin $ diff --git a/config/Makefile.template b/config/Makefile.template index 9432a884..aa7f2d62 100644 --- a/config/Makefile.template +++ b/config/Makefile.template @@ -60,6 +60,9 @@ CAMLMKTOP=ocamlmktop # Compilation debug flag CAMLDEBUG=COQDEBUGFLAG +# User compilation flag +USERFLAGS= + # Compilation profile flag CAMLTIMEPROF=COQPROFILEFLAG @@ -101,6 +104,9 @@ COQDOCDIR=COQDOCDIRECTORY # Win32 systems: true (actually strip is bogus) STRIP=STRIPCOMMAND +# Options for fsets (all/basic) +FSETS=FSETSOPT + # Options for reals (all/basic) REALS=REALSOPT diff --git a/config/coq_config.mli b/config/coq_config.mli index 099db808..29ee7f9d 100644 --- a/config/coq_config.mli +++ b/config/coq_config.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: coq_config.mli 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: coq_config.mli 8932 2006-06-09 09:29:03Z notin $ i*) val local : bool (* local use (no installation) *) @@ -34,3 +34,4 @@ val theories_dirs : string list val contrib_dirs : string list val exec_extension : string (* "" under Unix, ".exe" under MS-windows *) +val with_geoproof : bool ref (* to (de)activate functions specific to Geoproof with Coqide *) @@ -6,8 +6,8 @@ # ################################## -VERSION=8.1-alpha -DATE="Mar 2006" +VERSION=8.1beta +DATE="Jun 2006" # a local which command for sh which () { @@ -36,10 +36,13 @@ mandir_spec=no emacslib_spec=no emacs_spec=no coqdocdir_spec=no +fsets_opt=no +fsets=all reals_opt=no reals=all arch_spec=no coqide_spec=no +with_geoproof=true COQTOP=`pwd` @@ -69,6 +72,8 @@ while : ; do emacslib=$COQTOP/tools/emacs coqdocdir_spec=yes coqdocdir=$COQTOP/tools/coqdoc + fsets_opt=yes + fsets=all reals_opt=yes reals=all;; -src|--src) COQTOP=$2 @@ -97,12 +102,21 @@ while : ; do -opt|--opt) bytecamlc=ocamlc.opt camlp4o=camlp4o # can't add .opt since dyn load'll be required nativecamlc=ocamlopt.opt;; + -fsets|--fsets) fsets_opt=yes + fsets=$2 + shift;; -reals|--reals) reals_opt=yes reals=$2 shift;; -coqide|--coqide) coqide_spec=yes COQIDE=$2 shift;; + -with-geoproof|--with-geoproof) + case $2 in + yes) with_geoproof=true;; + no) with_geoproof=false;; + esac + shift;; -byte-only|-byteonly|--byteonly|--byte-only) best_compiler=byte;; -debug|--debug) coq_debug_flag=-g;; -profile|--profile) coq_profile_flag=-p;; @@ -219,6 +233,18 @@ case $coqdocdir_spec in yes) COQDOCDIR=$coqdocdir;; esac +case $fsets_opt in + no) echo "Should I compile the complete theory of finite sets [Y/N, default is Y] ?" + read fsets_ans + + case $fsets_ans in + "N"|"n"|"No"|"NO"|"no") + fsets=basic;; + *) fsets=all;; + esac;; + yes) true;; +esac + case $reals_opt in no) echo "Should I compile the complete theory of real analysis [Y/N, default is Y] ?" read reals_ans @@ -410,6 +436,11 @@ echo " Objective-Caml/Camlp4 version : $CAMLVERSION" echo " Objective-Caml/Camlp4 binaries in : $CAMLBIN" echo " Objective-Caml library in : $CAMLLIB" echo " Camlp4 library in : $CAMLP4LIB" +if test "$fsets" = "all"; then +echo " FSets theory : All" +else +echo " FSets theory : Basic" +fi if test "$reals" = "all"; then echo " Reals theory : All" else @@ -459,6 +490,7 @@ let versionsi = "$VERSIONSI" let date = "$DATE" let compile_date = "$COMPILEDATE" let exec_extension = "$EXE" +let with_geoproof = ref $with_geoproof END_OF_COQ_CONFIG @@ -523,6 +555,7 @@ sed -e "s|LOCALINSTALLATION|$local|" \ -e "s|BYTECAMLC|$bytecamlc|" \ -e "s|NATIVECAMLC|$nativecamlc|" \ -e "s|STRIPCOMMAND|$STRIPCOMMAND|" \ + -e "s|FSETSOPT|$fsets|" \ -e "s|REALSOPT|$reals|" \ -e "s|COQIDEOPT|$COQIDE|" \ $COQTOP/config/Makefile.template > $COQTOP/config/Makefile @@ -550,11 +583,6 @@ if test "$coq_debug_flag" = "-g" ; then chmod a-w,a+x $OCAMLDEBUGCOQ fi -# Compatibility with previous name -if [ ! -f $COQTOP/dev/ocamldebug-v7 ] ; then - ln -s `basename $OCAMLDEBUGCOQ` $COQTOP/dev/ocamldebug-v7 -fi - ################################################## # Fixing lablgtk types #################################################### @@ -574,4 +602,4 @@ echo echo "*Warning* To compile the system for a new architecture" echo " don't forget to do a 'make archclean' before './configure'." -# $Id: configure 8712 2006-04-14 10:34:47Z notin $ +# $Id: configure 8932 2006-06-09 09:29:03Z notin $ diff --git a/contrib/correctness/pmisc.ml b/contrib/correctness/pmisc.ml index 29d8fdcf..076b11cd 100644 --- a/contrib/correctness/pmisc.ml +++ b/contrib/correctness/pmisc.ml @@ -8,7 +8,7 @@ (* Certification of Imperative Programs / Jean-Christophe Filliâtre *) -(* $Id: pmisc.ml 5920 2004-07-16 20:01:26Z herbelin $ *) +(* $Id: pmisc.ml 8752 2006-04-27 19:37:33Z herbelin $ *) open Pp open Util @@ -216,7 +216,7 @@ let rec type_v_knsubst s = function and type_c_knsubst s ((id,v),e,pl,q) = ((id, type_v_knsubst s v), e, List.map (fun p -> { p with p_value = subst_mps s p.p_value }) pl, - option_app (fun q -> { q with a_value = subst_mps s q.a_value }) q) + option_map (fun q -> { q with a_value = subst_mps s q.a_value }) q) and binder_knsubst s (id,b) = (id, match b with BindType v -> BindType (type_v_knsubst s v) | _ -> b) diff --git a/contrib/correctness/pmonad.ml b/contrib/correctness/pmonad.ml index 31effc1b..8f1b5946 100644 --- a/contrib/correctness/pmonad.ml +++ b/contrib/correctness/pmonad.ml @@ -8,7 +8,7 @@ (* Certification of Imperative Programs / Jean-Christophe Filliâtre *) -(* $Id: pmonad.ml 5920 2004-07-16 20:01:26Z herbelin $ *) +(* $Id: pmonad.ml 8752 2006-04-27 19:37:33Z herbelin $ *) open Util open Names @@ -76,9 +76,9 @@ let rec abstract_post ren env (e,q) = let after_id id = id_of_string ((string_of_id id) ^ "'") in let (_,go) = Peffect.get_repr e in let al = List.map (fun id -> (id,after_id id)) go in - let q = option_app (named_app (subst_in_constr al)) q in + let q = option_map (named_app (subst_in_constr al)) q in let tgo = List.map (fun (id,aid) -> (aid, trad_type_in_env ren env id)) al in - option_app (named_app (abstract tgo)) q + option_map (named_app (abstract tgo)) q (* Translation of effects types in cic types. * @@ -365,7 +365,7 @@ let make_app env ren args ren' (tf,cf) ((bl,cb),s,capp) c = @(eq_phi ren'' env s svi tf) @(List.map (fun c -> CC_hole c) holes)) in - let qapp' = option_app (named_app (subst_in_constr svi)) qapp in + let qapp' = option_map (named_app (subst_in_constr svi)) qapp in let t = make_let_in ren'' env fe [] (current_vars ren''' outf,qapp') (res,tyres) (t,ty) diff --git a/contrib/correctness/psyntax.ml4 b/contrib/correctness/psyntax.ml4 index eeec28a5..98d43112 100644 --- a/contrib/correctness/psyntax.ml4 +++ b/contrib/correctness/psyntax.ml4 @@ -8,7 +8,7 @@ (* Certification of Imperative Programs / Jean-Christophe Filliâtre *) -(* $Id: psyntax.ml4 7740 2005-12-26 20:07:21Z herbelin $ *) +(* $Id: psyntax.ml4 8752 2006-04-27 19:37:33Z herbelin $ *) (*i camlp4deps: "parsing/grammar.cma" i*) @@ -786,7 +786,7 @@ END VERNAC COMMAND EXTEND Correctness [ "Correctness" preident(str) program(pgm) then_tac(tac) ] - -> [ Ptactic.correctness str pgm (option_app Tacinterp.interp tac) ] + -> [ Ptactic.correctness str pgm (option_map Tacinterp.interp tac) ] END (* Show Programs *) diff --git a/contrib/correctness/ptactic.ml b/contrib/correctness/ptactic.ml index e5347670..babc607d 100644 --- a/contrib/correctness/ptactic.ml +++ b/contrib/correctness/ptactic.ml @@ -8,7 +8,7 @@ (* Certification of Imperative Programs / Jean-Christophe Filliâtre *) -(* $Id: ptactic.ml 7837 2006-01-11 09:47:32Z herbelin $ *) +(* $Id: ptactic.ml 8759 2006-04-28 12:24:14Z herbelin $ *) open Pp open Options @@ -208,8 +208,8 @@ let reduce_open_constr (em0,c) = | Cast (c',t) -> (match kind_of_term c' with | Evar (ev,_) -> - if not (Evd.in_dom em ev) then - Evd.add em ev (Evd.map em0 ev) + if not (Evd.mem em ev) then + Evd.add em ev (Evd.find em0 ev) else em | _ -> fold_constr collect em c) diff --git a/contrib/correctness/putil.ml b/contrib/correctness/putil.ml index 0eb8806c..18c3ba35 100644 --- a/contrib/correctness/putil.ml +++ b/contrib/correctness/putil.ml @@ -8,7 +8,7 @@ (* Certification of Imperative Programs / Jean-Christophe Filliâtre *) -(* $Id: putil.ml 7837 2006-01-11 09:47:32Z herbelin $ *) +(* $Id: putil.ml 8752 2006-04-27 19:37:33Z herbelin $ *) open Util open Names @@ -41,7 +41,7 @@ let anonymous x = { a_name = Anonymous; a_value = x } let anonymous_pre b x = { p_assert = b; p_name = Anonymous; p_value = x } let force_name f x = - option_app (fun q -> { a_name = Name (f q.a_name); a_value = q.a_value }) x + option_map (fun q -> { a_name = Name (f q.a_name); a_value = q.a_value }) x let force_post_name x = force_name post_name x @@ -143,7 +143,7 @@ let rec type_c_subst s ((id,t),e,p,q) = let s' = s @ List.map (fun (x,x') -> (at_id x "", at_id x' "")) s in (id, type_v_subst s t), Peffect.subst s e, List.map (pre_app (subst_in_constr s)) p, - option_app (post_app (subst_in_constr s')) q + option_map (post_app (subst_in_constr s')) q and type_v_subst s = function Ref v -> Ref (type_v_subst s v) @@ -160,7 +160,7 @@ and binder_subst s = function let rec type_c_rsubst s ((id,t),e,p,q) = (id, type_v_rsubst s t), e, List.map (pre_app (real_subst_in_constr s)) p, - option_app (post_app (real_subst_in_constr s)) q + option_map (post_app (real_subst_in_constr s)) q and type_v_rsubst s = function Ref v -> Ref (type_v_rsubst s v) diff --git a/contrib/correctness/pwp.ml b/contrib/correctness/pwp.ml index 1e485180..f422c5cd 100644 --- a/contrib/correctness/pwp.ml +++ b/contrib/correctness/pwp.ml @@ -8,7 +8,7 @@ (* Certification of Imperative Programs / Jean-Christophe Filliâtre *) -(* $Id: pwp.ml 5920 2004-07-16 20:01:26Z herbelin $ *) +(* $Id: pwp.ml 8752 2006-04-27 19:37:33Z herbelin $ *) open Util open Names @@ -64,7 +64,7 @@ let update_post env top ef c = let force_post up env top q e = let (res,ef,p,_) = e.info.kappa in let q' = - if up then option_app (named_app (update_post env top ef)) q else q + if up then option_map (named_app (update_post env top ef)) q else q in let i = { env = e.info.env; kappa = (res,ef,p,q') } in { desc = e.desc; pre = e.pre; post = q'; loc = e.loc; info = i } @@ -260,7 +260,7 @@ and propagate ren p = | Apply (f,l) -> let _,(_,so,ok),(_,_,_,qapp) = effect_app ren env f l in if ok then - let q = option_app (named_app (real_subst_in_constr so)) qapp in + let q = option_map (named_app (real_subst_in_constr so)) qapp in post_if_none env q p else p @@ -285,7 +285,7 @@ and propagate ren p = None -> Some (anonymous s) | Some i -> Some { a_value = conj i.a_value s; a_name = i.a_name } in - let q = option_app (named_app abstract_unit) q in + let q = option_map (named_app abstract_unit) q in post_if_none env q p | SApp ([Variable id], [e1;e2]) diff --git a/contrib/extraction/common.ml b/contrib/extraction/common.ml index 8d8438dc..346201ec 100644 --- a/contrib/extraction/common.ml +++ b/contrib/extraction/common.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: common.ml 7651 2005-12-16 03:19:20Z letouzey $ i*) +(*i $Id: common.ml 8930 2006-06-09 02:14:34Z letouzey $ i*) open Pp open Util @@ -112,7 +112,8 @@ let contents_first_level mp = | Extraction.Term -> add false (id_of_label l)) | (_, SPBmind mib) -> Array.iter - (fun mip -> if mip.mind_sort <> (Prop Null) then begin + (fun mip -> if snd (Inductive.mind_arity mip) <> InProp + then begin add upper_type mip.mind_typename; Array.iter (add true) mip.mind_consnames end) @@ -267,8 +268,6 @@ module StdParams = struct let globals () = !global_ids - (* TODO: remettre des conditions [lang () = Haskell] disant de qualifier. *) - let unquote s = if lang () <> Scheme then s else @@ -288,23 +287,31 @@ module StdParams = struct let mp = modpath_of_r r in let ls = if mp = List.hd mpl then [s] (* simpliest situation *) - else - try (* has [mp] something in common with one of those in [mpl] ? *) - let pref = common_prefix_from_list mp mpl in - (*i TODO: possibilité de clash i*) - list_firstn ((mp_length mp)-(mp_length pref)+1) ls - with Not_found -> (* [mp] is othogonal with every element of [mp]. *) - let base = base_mp mp in - if !modular && - (at_toplevel mp) && - not (Refset.mem r !to_qualify) && - not (clash base [] s mpl) - then snd (list_sep_last ls) - else ls + else match lang () with + | Scheme -> [s] (* no modular Scheme extraction... *) + | Toplevel -> [s] (* idem *) + | Haskell -> + if !modular then + ls (* for the moment we always qualify in modular Haskell *) + else [s] + | Ocaml -> + try (* has [mp] something in common with one of those in [mpl] ? *) + let pref = common_prefix_from_list mp mpl in + (*i TODO: possibilité de clash i*) + list_firstn ((mp_length mp)-(mp_length pref)+1) ls + with Not_found -> (* [mp] is othogonal with every element of [mp]. *) + let base = base_mp mp in + if !modular && + (at_toplevel mp) && + not (Refset.mem r !to_qualify) && + not (clash base [] s mpl) + then snd (list_sep_last ls) + else ls in add_module_contents mp s; (* update the visible environment *) str (dottify ls) + (* The next function is used only in Ocaml extraction...*) let pp_module mpl mp = let ls = if !modular @@ -393,15 +400,15 @@ let print_structure_to_file f prm struc = in let print_dummys = (struct_ast_search ((=) MLdummy) struc, - struct_type_search Tdummy struc, - struct_type_search Tunknown struc) + struct_type_search Mlutil.isDummy struc, + struct_type_search ((=) Tunknown) struc) in let print_magic = if lang () <> Haskell then false else struct_ast_search (function MLmagic _ -> true | _ -> false) struc in (* print the implementation *) - let cout = option_app (fun (f,_) -> open_out f) f in + let cout = option_map (fun (f,_) -> open_out f) f in let ft = match cout with | None -> !Pp_control.std_ft | Some cout -> Pp_control.with_output_to cout in diff --git a/contrib/extraction/extraction.ml b/contrib/extraction/extraction.ml index a4bf973d..e97df539 100644 --- a/contrib/extraction/extraction.ml +++ b/contrib/extraction/extraction.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: extraction.ml 7639 2005-12-02 10:01:15Z gregoire $ i*) +(*i $Id: extraction.ml 8931 2006-06-09 07:43:37Z letouzey $ i*) (*i*) open Util @@ -35,6 +35,9 @@ exception I of inductive_info to avoid loops in [extract_inductive] *) let internal_call = ref KNset.empty +(* A set of all fixpoint functions currently being extracted *) +let current_fixpoints = ref ([] : constant list) + let none = Evd.empty let type_of env c = Retyping.get_type_of env none (strip_outer_cast c) @@ -80,6 +83,14 @@ let rec flag_of_type env t = let is_default env t = (flag_of_type env t = (Info, Default)) +exception NotDefault of kill_reason + +let check_default env t = + match flag_of_type env t with + | _,TypeScheme -> raise (NotDefault Ktype) + | Logic,_ -> raise (NotDefault Kother) + | _ -> () + let is_info_scheme env t = (flag_of_type env t = (Info, TypeScheme)) (*s [type_sign] gernerates a signature aimed at treating a type application. *) @@ -87,7 +98,8 @@ let is_info_scheme env t = (flag_of_type env t = (Info, TypeScheme)) let rec type_sign env c = match kind_of_term (whd_betadeltaiota env none c) with | Prod (n,t,d) -> - (is_info_scheme env t)::(type_sign (push_rel_assum (n,t) env) d) + (if is_info_scheme env t then Keep else Kill Kother) + :: (type_sign (push_rel_assum (n,t) env) d) | _ -> [] let rec type_scheme_nb_args env c = @@ -105,8 +117,8 @@ let rec type_sign_vl env c = match kind_of_term (whd_betadeltaiota env none c) with | Prod (n,t,d) -> let s,vl = type_sign_vl (push_rel_assum (n,t) env) d in - if not (is_info_scheme env t) then false::s, vl - else true::s, (next_ident_away (id_of_name n) vl) :: vl + if not (is_info_scheme env t) then Kill Kother::s, vl + else Keep::s, (next_ident_away (id_of_name n) vl) :: vl | _ -> [],[] let rec nb_default_params env c = @@ -126,8 +138,8 @@ let rec nb_default_params env c = let db_from_sign s = let rec make i acc = function | [] -> acc - | true :: l -> make (i+1) (i::acc) l - | false :: l -> make i (0::acc) l + | Keep :: l -> make (i+1) (i::acc) l + | Kill _ :: l -> make i (0::acc) l in make 1 [] s (*s Create a type variable context from indications taken from @@ -150,8 +162,8 @@ let rec db_from_ind dbmap i = let parse_ind_args si args relmax = let rec parse i j = function | [] -> Intmap.empty - | false :: s -> parse (i+1) j s - | true :: s -> + | Kill _ :: s -> parse (i+1) j s + | Keep :: s -> (match kind_of_term args.(i-1) with | Rel k -> Intmap.add (relmax+1-k) j (parse (i+1) (j+1) s) | _ -> parse (i+1) (j+1) s) @@ -167,6 +179,7 @@ let parse_ind_args si args relmax = (* [j] stands for the next ML type var. [j=0] means we do not generate ML type var anymore (in subterms for example). *) + let rec extract_type env db j c args = match kind_of_term (whd_betaiotazeta c) with | App (d, args') -> @@ -183,19 +196,24 @@ let rec extract_type env db j c args = | (Info, Default) -> (* Standard case: two [extract_type] ... *) let mld = extract_type env' (0::db) j d [] in - if type_eq (mlt_env env) mld Tdummy then Tdummy - else Tarr (extract_type env db 0 t [], mld) + (match expand env mld with + | Tdummy d -> Tdummy d + | _ -> Tarr (extract_type env db 0 t [], mld)) | (Info, TypeScheme) when j > 0 -> (* A new type var. *) let mld = extract_type env' (j::db) (j+1) d [] in - if type_eq (mlt_env env) mld Tdummy then Tdummy - else Tarr (Tdummy, mld) - | _ -> + (match expand env mld with + | Tdummy d -> Tdummy d + | _ -> Tarr (Tdummy Ktype, mld)) + | _,lvl -> let mld = extract_type env' (0::db) j d [] in - if type_eq (mlt_env env) mld Tdummy then Tdummy - else Tarr (Tdummy, mld)) - | Sort _ -> Tdummy (* The two logical cases. *) - | _ when sort_of env (applist (c, args)) = InProp -> Tdummy + (match expand env mld with + | Tdummy d -> Tdummy d + | _ -> + let reason = if lvl=TypeScheme then Ktype else Kother in + Tarr (Tdummy reason, mld))) + | Sort _ -> Tdummy Ktype (* The two logical cases. *) + | _ when sort_of env (applist (c, args)) = InProp -> Tdummy Kother | Rel n -> (match lookup_rel n env with | (_,Some t,_) -> extract_type env db j (lift n t) args @@ -222,7 +240,7 @@ let rec extract_type env db j c args = (* The more precise is [mlt'], extracted after reduction *) (* The shortest is [mlt], which use abbreviations *) (* If possible, we take [mlt], otherwise [mlt']. *) - if type_eq (mlt_env env) mlt mlt' then mlt else mlt') + if expand env mlt = expand env mlt' then mlt else mlt') | _ -> (* only other case here: Info, Default, i.e. not an ML type *) (match cb.const_body with | None -> Tunknown (* Brutal approximation ... *) @@ -242,7 +260,7 @@ let rec extract_type env db j c args = and extract_maybe_type env db c = let t = whd_betadeltaiota env none (type_of env c) in if isSort t then extract_type env db 0 c [] - else if sort_of env t = InProp then Tdummy else Tunknown + else if sort_of env t = InProp then Tdummy Kother else Tunknown (*s Auxiliary function dealing with type application. Precondition: [r] is a type scheme represented by the signature [s], @@ -251,7 +269,7 @@ and extract_maybe_type env db c = and extract_type_app env db (r,s) args = let ml_args = List.fold_right - (fun (b,c) a -> if b then + (fun (b,c) a -> if b=Keep then let p = List.length (fst (splay_prod env none (type_of env c))) in let db = iterate (fun l -> 0 :: l) p db in (extract_type_scheme env db c p) :: a @@ -301,9 +319,10 @@ and extract_ind env kn = (* kn is supposed to be in long form *) (* their type var list. *) let packets = Array.map - (fun mip -> - let b = mip.mind_sort <> (Prop Null) in - let s,v = if b then type_sign_vl env mip.mind_nf_arity else [],[] in + (fun mip -> + let b = snd (mind_arity mip) <> InProp in + let ar = Inductive.type_of_inductive (mib,mip) in + let s,v = if b then type_sign_vl env ar else [],[] in let t = Array.make (Array.length mip.mind_nf_lc) [] in { ip_typename = mip.mind_typename; ip_consnames = mip.mind_consnames; @@ -341,7 +360,7 @@ and extract_ind env kn = (* kn is supposed to be in long form *) if p.ip_logical then raise (I Standard); if Array.length p.ip_types <> 1 then raise (I Standard); let typ = p.ip_types.(0) in - let l = List.filter (type_neq (mlt_env env) Tdummy) typ in + let l = List.filter (fun t -> not (isDummy (expand env t))) typ in if List.length l = 1 && not (type_mem_kn kn (List.hd l)) then raise (I Singleton); if l = [] then raise (I Standard); @@ -365,14 +384,15 @@ and extract_ind env kn = (* kn is supposed to be in long form *) let rec select_fields l typs = match l,typs with | [],[] -> [] | (Name id)::l, typ::typs -> - if type_eq (mlt_env env) Tdummy typ then select_fields l typs + if isDummy (expand env typ) then select_fields l typs else let knp = make_con mp d (label_of_id id) in - if not (List.mem false (type_to_sign (mlt_env env) typ)) then + if not (List.exists isKill (type2signature env typ)) + then projs := Cset.add knp !projs; (ConstRef knp) :: (select_fields l typs) | Anonymous::l, typ::typs -> - if type_eq (mlt_env env) Tdummy typ then select_fields l typs + if isDummy (expand env typ) then select_fields l typs else error_record r | _ -> assert false in @@ -381,7 +401,8 @@ and extract_ind env kn = (* kn is supposed to be in long form *) (* Is this record officially declared with its projections ? *) (* If so, we use this information. *) begin try - let n = nb_default_params env mip0.mind_nf_arity in + let n = nb_default_params env (Inductive.type_of_inductive(mib,mip0)) + in List.iter (option_iter (fun kn -> if Cset.mem kn !projs then add_projection n kn)) @@ -439,9 +460,9 @@ and mlt_env env r = match r with | _ -> None)) | _ -> None -let type_expand env = type_expand (mlt_env env) -let type_neq env = type_neq (mlt_env env) -let type_to_sign env = type_to_sign (mlt_env env) +and expand env = type_expand (mlt_env env) +and type2signature env = type_to_signature (mlt_env env) +let type2sign env = type_to_sign (mlt_env env) let type_expunge env = type_expunge (mlt_env env) (*s Extraction of the type of a constant. *) @@ -478,10 +499,9 @@ let rec extract_term env mle mlt c args = in extract_term env mle mlt d' [] | [] -> let env' = push_rel_assum (Name id, t) env in - let id, a = - if is_default env t - then id, new_meta () - else dummy_name, Tdummy in + let id, a = try check_default env t; id, new_meta() + with NotDefault d -> dummy_name, Tdummy d + in let b = new_meta () in (* If [mlt] cannot be unified with an arrow type, then magic! *) let magic = needs_magic (mlt, Tarr (a, b)) in @@ -491,15 +511,16 @@ let rec extract_term env mle mlt c args = let id = id_of_name n in let env' = push_rel (Name id, Some c1, t1) env in let args' = List.map (lift 1) args in - if is_default env t1 then + (try + check_default env t1; let a = new_meta () in let c1' = extract_term env mle a c1 [] in (* The type of [c1'] is generalized and stored in [mle]. *) let mle' = Mlenv.push_gen mle a in MLletin (id, c1', extract_term env' mle' mlt c2 args') - else - let mle' = Mlenv.push_std_type mle Tdummy in - ast_pop (extract_term env' mle' mlt c2 args') + with NotDefault d -> + let mle' = Mlenv.push_std_type mle (Tdummy d) in + ast_pop (extract_term env' mle' mlt c2 args')) | Const kn -> extract_cst_app env mle mlt kn args | Construct cp -> @@ -521,8 +542,10 @@ let rec extract_term env mle mlt c args = (*s [extract_maybe_term] is [extract_term] for usual terms, else [MLdummy] *) and extract_maybe_term env mle mlt c = - if is_default env (type_of env c) then extract_term env mle mlt c [] - else put_magic (mlt, Tdummy) MLdummy + try check_default env (type_of env c); + extract_term env mle mlt c [] + with NotDefault d -> + put_magic (mlt, Tdummy d) MLdummy (*s Generic way to deal with an application. *) @@ -540,7 +563,7 @@ and extract_app env mle mlt mk_head args = and make_mlargs env e s args typs = let l = ref s in - let keep () = match !l with [] -> true | b :: s -> l:=s; b in + let keep () = match !l with [] -> true | b :: s -> l:=s; b=Keep in let rec f = function | [], [] -> [] | a::la, t::lt when keep() -> extract_maybe_term env e t a :: (f (la,lt)) @@ -553,19 +576,25 @@ and make_mlargs env e s args typs = and extract_cst_app env mle mlt kn args = (* First, the [ml_schema] of the constant, in expanded version. *) let nb,t = record_constant_type env kn None in - let schema = nb, type_expand env t in + let schema = nb, expand env t in + (* Can we instantiate types variables for this constant ? *) + (* In Ocaml, inside the definition of this constant, the answer is no. *) + let instantiated = + if lang () = Ocaml && List.mem kn !current_fixpoints then var2var' (snd schema) + else instantiation schema + in (* Then the expected type of this constant. *) - let metas = List.map new_meta args in + let a = new_meta () in (* We compare stored and expected types in two steps. *) (* First, can [kn] be applied to all args ? *) - let a = new_meta () in - let magic1 = needs_magic (type_recomp (metas, a), instantiation schema) in + let metas = List.map new_meta args in + let magic1 = needs_magic (type_recomp (metas, a), instantiated) in (* Second, is the resulting type compatible with the expected type [mlt] ? *) let magic2 = needs_magic (a, mlt) in (* The internal head receives a magic if [magic1] *) let head = put_magic_if magic1 (MLglob (ConstRef kn)) in (* Now, the extraction of the arguments. *) - let s = type_to_sign env (snd schema) in + let s = type2signature env (snd schema) in let ls = List.length s in let la = List.length args in let mla = make_mlargs env mle s args metas in @@ -580,8 +609,8 @@ and extract_cst_app env mle mlt kn args = in (* Different situations depending of the number of arguments: *) if ls = 0 then put_magic_if magic2 head - else if List.mem true s then - if la >= ls || not (List.mem false s) + else if List.mem Keep s then + if la >= ls || not (List.exists isKill s) then put_magic_if (magic2 && not magic1) (MLapp (head, mla)) else @@ -590,12 +619,17 @@ and extract_cst_app env mle mlt kn args = let s' = list_lastn ls' s in let mla = (List.map (ast_lift ls') mla) @ (eta_args_sign ls' s') in put_magic_if magic2 (anonym_or_dummy_lams (MLapp (head, mla)) s') - else + else if List.mem (Kill Kother) s then (* In the special case of always false signature, one dummy lam is left. *) (* So a [MLdummy] is left accordingly. *) if la >= ls then put_magic_if (magic2 && not magic1) (MLapp (head, MLdummy :: mla)) else put_magic_if magic2 (dummy_lams head (ls-la-1)) + else (* s is made only of [Kill Ktype] *) + if la >= ls + then put_magic_if (magic2 && not magic1) (MLapp (head, mla)) + else put_magic_if magic2 (dummy_lams head (ls-la)) + (*s Extraction of an inductive constructor applied to arguments. *) @@ -613,12 +647,12 @@ and extract_cons_app env mle mlt (((kn,i) as ip,j) as cp) args = let params_nb = mi.ind_nparams in let oi = mi.ind_packets.(i) in let nb_tvars = List.length oi.ip_vars - and types = List.map (type_expand env) oi.ip_types.(j-1) in + and types = List.map (expand env) oi.ip_types.(j-1) in let list_tvar = List.map (fun i -> Tvar i) (interval 1 nb_tvars) in let type_cons = type_recomp (types, Tglob (IndRef ip, list_tvar)) in let type_cons = instantiation (nb_tvars, type_cons) in (* Then, the usual variables [s], [ls], [la], ... *) - let s = List.map (type_neq env Tdummy) types in + let s = List.map (type2sign env) types in let ls = List.length s in let la = List.length args in assert (la <= ls + params_nb); @@ -671,8 +705,8 @@ and extract_case env mle ((kn,i) as ip,c,br) mlt = (* Logical singleton case: *) (* [match c with C i j k -> t] becomes [t'] *) assert (br_size = 1); - let s = iterate (fun l -> false :: l) ni.(0) [] in - let mlt = iterate (fun t -> Tarr (Tdummy, t)) ni.(0) mlt in + let s = iterate (fun l -> Kill Kother :: l) ni.(0) [] in + let mlt = iterate (fun t -> Tarr (Tdummy Kother, t)) ni.(0) mlt in let e = extract_maybe_term env mle mlt br.(0) in snd (case_expunge s e) end @@ -686,10 +720,10 @@ and extract_case env mle ((kn,i) as ip,c,br) mlt = (* The extraction of each branch. *) let extract_branch i = (* The types of the arguments of the corresponding constructor. *) - let f t = type_subst_vect metas (type_expand env t) in + let f t = type_subst_vect metas (expand env t) in let l = List.map f oi.ip_types.(i) in (* the corresponding signature *) - let s = List.map (type_neq env Tdummy) oi.ip_types.(i) in + let s = List.map (type2sign env) oi.ip_types.(i) in (* Extraction of the branch (in functional form). *) let e = extract_maybe_term env mle (type_recomp (l,mlt)) br.(i) in (* We suppress dummy arguments according to signature. *) @@ -745,8 +779,8 @@ let extract_std_constant env kn body typ = let t = snd (record_constant_type env kn (Some typ)) in (* The real type [t']: without head lambdas, expanded, *) (* and with [Tvar] translated to [Tvar'] (not instantiable). *) - let l,t' = type_decomp (type_expand env (var2var' t)) in - let s = List.map (type_neq env Tdummy) l in + let l,t' = type_decomp (expand env (var2var' t)) in + let s = List.map (type2sign env) l in (* The initial ML environment. *) let mle = List.fold_left Mlenv.push_std_type Mlenv.empty l in (* Decomposing the top level lambdas of [body]. *) @@ -762,10 +796,12 @@ let extract_std_constant env kn body typ = let extract_fixpoint env vkn (fi,ti,ci) = let n = Array.length vkn in - let types = Array.make n Tdummy + let types = Array.make n (Tdummy Kother) and terms = Array.make n MLdummy in + let kns = Array.to_list vkn in + current_fixpoints := kns; (* for replacing recursive calls [Rel ..] by the corresponding [Const]: *) - let sub = List.rev_map mkConst (Array.to_list vkn) in + let sub = List.rev_map mkConst kns in for i = 0 to n-1 do if sort_of env ti.(i) <> InProp then begin let e,t = extract_std_constant env vkn.(i) (substl sub ci.(i)) ti.(i) in @@ -773,6 +809,7 @@ let extract_fixpoint env vkn (fi,ti,ci) = types.(i) <- t; end done; + current_fixpoints := []; Dfix (Array.map (fun kn -> ConstRef kn) vkn, terms, types) let extract_constant env kn cb = @@ -790,12 +827,14 @@ let extract_constant env kn cb = if not (is_custom r) then warning_info_ax r; let t = snd (record_constant_type env kn (Some typ)) in Dterm (r, MLaxiom, type_expunge env t) - | (Logic,TypeScheme) -> warning_log_ax r; Dtype (r, [], Tdummy) - | (Logic,Default) -> warning_log_ax r; Dterm (r, MLdummy, Tdummy)) + | (Logic,TypeScheme) -> + warning_log_ax r; Dtype (r, [], Tdummy Ktype) + | (Logic,Default) -> + warning_log_ax r; Dterm (r, MLdummy, Tdummy Kother)) | Some body -> (match flag_of_type env typ with - | (Logic, Default) -> Dterm (r, MLdummy, Tdummy) - | (Logic, TypeScheme) -> Dtype (r, [], Tdummy) + | (Logic, Default) -> Dterm (r, MLdummy, Tdummy Kother) + | (Logic, TypeScheme) -> Dtype (r, [], Tdummy Ktype) | (Info, Default) -> let e,t = extract_std_constant env kn (force body) typ in Dterm (r,e,t) @@ -809,8 +848,8 @@ let extract_constant_spec env kn cb = let r = ConstRef kn in let typ = cb.const_type in match flag_of_type env typ with - | (Logic, TypeScheme) -> Stype (r, [], Some Tdummy) - | (Logic, Default) -> Sval (r, Tdummy) + | (Logic, TypeScheme) -> Stype (r, [], Some (Tdummy Ktype)) + | (Logic, Default) -> Sval (r, Tdummy Kother) | (Info, TypeScheme) -> let s,vl = type_sign_vl env typ in (match cb.const_body with @@ -826,7 +865,7 @@ let extract_constant_spec env kn cb = let extract_inductive env kn = let ind = extract_ind env kn in add_recursors env kn; - let f l = List.filter (type_neq env Tdummy) l in + let f l = List.filter (fun t -> not (isDummy (expand env t))) l in let packets = Array.map (fun p -> { p with ip_types = Array.map f p.ip_types }) ind.ind_packets @@ -853,19 +892,19 @@ let constant_kind env cb = (*s Is a [ml_decl] logical ? *) let logical_decl = function - | Dterm (_,MLdummy,Tdummy) -> true - | Dtype (_,[],Tdummy) -> true + | Dterm (_,MLdummy,Tdummy _) -> true + | Dtype (_,[],Tdummy _) -> true | Dfix (_,av,tv) -> (array_for_all ((=) MLdummy) av) && - (array_for_all ((=) Tdummy) tv) + (array_for_all isDummy tv) | Dind (_,i) -> array_for_all (fun ip -> ip.ip_logical) i.ind_packets | _ -> false (*s Is a [ml_spec] logical ? *) let logical_spec = function - | Stype (_, [], Some Tdummy) -> true - | Sval (_,Tdummy) -> true + | Stype (_, [], Some (Tdummy _)) -> true + | Sval (_,Tdummy _) -> true | Sind (_,i) -> array_for_all (fun ip -> ip.ip_logical) i.ind_packets | _ -> false diff --git a/contrib/extraction/haskell.ml b/contrib/extraction/haskell.ml index c4ed364a..f924396c 100644 --- a/contrib/extraction/haskell.ml +++ b/contrib/extraction/haskell.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: haskell.ml 7653 2005-12-16 04:12:26Z letouzey $ i*) +(*i $Id: haskell.ml 8930 2006-06-09 02:14:34Z letouzey $ i*) (*s Production of Haskell syntax. *) @@ -106,7 +106,7 @@ let rec pp_type par vl t = | Tarr (t1,t2) -> pp_par par (pp_rec true t1 ++ spc () ++ str "->" ++ spc () ++ pp_rec false t2) - | Tdummy -> str "()" + | Tdummy _ -> str "()" | Tunknown -> str "()" | Taxiom -> str "() -- AXIOM TO BE REALIZED\n" in @@ -210,7 +210,7 @@ and pp_function env f t = (f ++ pr_binding (List.rev bl) ++ str " =" ++ fnl () ++ str " " ++ hov 2 (pp_expr false env' [] t')) - + (*s Pretty-printing of inductive types declaration. *) let pp_comment s = str "-- " ++ s ++ fnl () @@ -289,12 +289,16 @@ let pp_decl mpl = else str "=" ++ spc () ++ pp_type false l t in hov 2 (str "type " ++ pp_global r ++ spc () ++ st) ++ fnl () ++ fnl () - | Dfix (rv, defs,_) -> - let ppv = Array.map pp_global rv in - prlist_with_sep (fun () -> fnl () ++ fnl ()) - (fun (pi,ti) -> pp_function (empty_env ()) pi ti) - (List.combine (Array.to_list ppv) (Array.to_list defs)) - ++ fnl () ++ fnl () + | Dfix (rv, defs, typs) -> + let max = Array.length rv in + let rec iter i = + if i = max then mt () + else + let e = pp_global rv.(i) in + e ++ str " :: " ++ pp_type false [] typs.(i) ++ fnl () + ++ pp_function (empty_env ()) e defs.(i) ++ fnl () ++ fnl () + ++ iter (i+1) + in iter 0 | Dterm (r, a, t) -> if is_inline_custom r then mt () else diff --git a/contrib/extraction/miniml.mli b/contrib/extraction/miniml.mli index cf722e4e..e34abe02 100644 --- a/contrib/extraction/miniml.mli +++ b/contrib/extraction/miniml.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: miniml.mli 6064 2004-09-06 07:49:51Z letouzey $ i*) +(*i $Id: miniml.mli 8724 2006-04-20 09:57:01Z letouzey $ i*) (*s Target language for extraction: a core ML called MiniML. *) @@ -18,11 +18,18 @@ open Libnames (* The [signature] type is used to know how many arguments a CIC object expects, and what these arguments will become in the ML object. *) + +(* We eliminate from terms: 1) types 2) logical parts. + [Kother] stands both for logical or unknown reason. *) + +type kill_reason = Ktype | Kother + +type sign = Keep | Kill of kill_reason + -(* Convention: outmost lambda/product gives the head of the list, - and [true] means that the argument is to be kept. *) +(* Convention: outmost lambda/product gives the head of the list. *) -type signature = bool list +type signature = sign list (*s ML type expressions. *) @@ -32,7 +39,7 @@ type ml_type = | Tvar of int | Tvar' of int (* same as Tvar, used to avoid clash *) | Tmeta of ml_meta (* used during ML type reconstruction *) - | Tdummy + | Tdummy of kill_reason | Tunknown | Taxiom diff --git a/contrib/extraction/mlutil.ml b/contrib/extraction/mlutil.ml index facab18e..6bfedce5 100644 --- a/contrib/extraction/mlutil.ml +++ b/contrib/extraction/mlutil.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: mlutil.ml 7574 2005-11-17 15:48:45Z letouzey $ i*) +(*i $Id: mlutil.ml 8886 2006-06-01 13:53:45Z letouzey $ i*) (*i*) open Pp @@ -111,7 +111,7 @@ let rec mgu = function List.iter mgu (List.combine l l') | Tvar i, Tvar j when i = j -> () | Tvar' i, Tvar' j when i = j -> () - | Tdummy, Tdummy -> () + | Tdummy _, Tdummy _ -> () | Tunknown, Tunknown -> () | _ -> raise Impossible @@ -252,7 +252,6 @@ type abbrev_map = global_reference -> ml_type option (*s Delta-reduction of type constants everywhere in a ML type [t]. [env] is a function of type [ml_type_env]. *) - let type_expand env t = let rec expand = function | Tmeta {contents = Some t} -> expand t @@ -281,34 +280,39 @@ let type_weak_expand env t = | a -> a in expand t -(*s Equality over ML types modulo delta-reduction *) - -let type_eq env t t' = (type_expand env t = type_expand env t') - -let type_neq env t t' = (type_expand env t <> type_expand env t') - (*s Generating a signature from a ML type. *) -let type_to_sign env t = +let type_to_sign env t = match type_expand env t with + | Tdummy d -> Kill d + | _ -> Keep + +let type_to_signature env t = let rec f = function | Tmeta {contents = Some t} -> f t - | Tarr (a,b) -> (Tdummy <> a) :: (f b) + | Tarr (Tdummy d, b) -> Kill d :: f b + | Tarr (_, b) -> Keep :: f b | _ -> [] in f (type_expand env t) +let isKill = function Kill _ -> true | _ -> false + +let isDummy = function Tdummy _ -> true | _ -> false + +let sign_of_id i = if i = dummy_name then Kill Kother else Keep + (*s Removing [Tdummy] from the top level of a ML type. *) let type_expunge env t = - let s = type_to_sign env t in + let s = type_to_signature env t in if s = [] then t - else if List.mem true s then + else if List.mem Keep s then let rec f t s = - if List.mem false s then + if List.exists isKill s then match t with | Tmeta {contents = Some t} -> f t s | Tarr (a,b) -> let t = f b (List.tl s) in - if List.hd s then Tarr (a, t) else t + if List.hd s = Keep then Tarr (a, t) else t | Tglob (r,l) -> (match env r with | Some mlt -> f (type_subst_list l mlt) s @@ -316,7 +320,9 @@ let type_expunge env t = | _ -> assert false else t in f t s - else Tarr (Tdummy, snd (type_decomp (type_weak_expand env t))) + else if List.mem (Kill Kother) s then + Tarr (Tdummy Kother, snd (type_decomp (type_weak_expand env t))) + else snd (type_decomp (type_weak_expand env t)) (*S Generic functions over ML ast terms. *) @@ -536,8 +542,8 @@ let rec dummy_lams a = function let rec anonym_or_dummy_lams a = function | [] -> a - | true :: s -> MLlam(anonymous, anonym_or_dummy_lams a s) - | false :: s -> MLlam(dummy_name, anonym_or_dummy_lams a s) + | Keep :: s -> MLlam(anonymous, anonym_or_dummy_lams a s) + | Kill _ :: s -> MLlam(dummy_name, anonym_or_dummy_lams a s) (*S Operations concerning eta. *) @@ -550,8 +556,8 @@ let rec eta_args n = let rec eta_args_sign n = function | [] -> [] - | true :: s -> (MLrel n) :: (eta_args_sign (n-1) s) - | false :: s -> eta_args_sign (n-1) s + | Keep :: s -> (MLrel n) :: (eta_args_sign (n-1) s) + | Kill _ :: s -> eta_args_sign (n-1) s (*s This one tests [MLrel (n+k); ... ;MLrel (1+k)] *) @@ -820,33 +826,33 @@ let rec post_simpl = function (*S Local prop elimination. *) (* We try to eliminate as many [prop] as possible inside an [ml_ast]. *) -(*s In a list, it selects only the elements corresponding to a [true] +(*s In a list, it selects only the elements corresponding to a [Keep] in the boolean list [l]. *) let rec select_via_bl l args = match l,args with | [],_ -> args - | true::l,a::args -> a :: (select_via_bl l args) - | false::l,a::args -> select_via_bl l args + | Keep::l,a::args -> a :: (select_via_bl l args) + | Kill _::l,a::args -> select_via_bl l args | _ -> assert false -(*s [kill_some_lams] removes some head lambdas according to the bool list [bl]. +(*s [kill_some_lams] removes some head lambdas according to the signature [bl]. This list is build on the identifier list model: outermost lambda - is on the right. [true] means "to keep" and [false] means "to eliminate". + is on the right. [Rels] corresponding to removed lambdas are supposed not to occur, and the other [Rels] are made correct via a [gen_subst]. Output is not directly a [ml_ast], compose with [named_lams] if needed. *) let kill_some_lams bl (ids,c) = let n = List.length bl in - let n' = List.fold_left (fun n b -> if b then (n+1) else n) 0 bl in + let n' = List.fold_left (fun n b -> if b=Keep then (n+1) else n) 0 bl in if n = n' then ids,c else if n' = 0 then [],ast_lift (-n) c else begin let v = Array.make n MLdummy in let rec parse_ids i j = function | [] -> () - | true :: l -> v.(i) <- MLrel j; parse_ids (i+1) (j+1) l - | false :: l -> parse_ids (i+1) j l + | Keep :: l -> v.(i) <- MLrel j; parse_ids (i+1) (j+1) l + | Kill _ :: l -> parse_ids (i+1) j l in parse_ids 0 1 bl ; select_via_bl bl ids, gen_subst v (n'-n) c end @@ -857,8 +863,8 @@ let kill_some_lams bl (ids,c) = let kill_dummy_lams c = let ids,c = collect_lams c in - let bl = List.map ((<>) dummy_name) ids in - if (List.mem true bl) && (List.mem false bl) then + let bl = List.map sign_of_id ids in + if (List.mem Keep bl) && (List.exists isKill bl) then let ids',c = kill_some_lams bl (ids,c) in ids, named_lams ids' c else raise Impossible @@ -866,7 +872,7 @@ let kill_dummy_lams c = (*s [eta_expansion_sign] takes a function [fun idn ... id1 -> c] and a signature [s] and builds a eta-long version. *) -(* For example, if [s = [true;true;false;true]] then the output is : +(* For example, if [s = [Keep;Keep;Kill Prop;Keep]] then the output is : [fun idn ... id1 x x _ x -> (c' 4 3 __ 1)] with [c' = lift 4 c] *) let eta_expansion_sign s (ids,c) = @@ -874,13 +880,13 @@ let eta_expansion_sign s (ids,c) = | [] -> let a = List.rev_map (function MLrel x -> MLrel (i-x) | a -> a) rels in ids, MLapp (ast_lift (i-1) c, a) - | true :: l -> abs (anonymous :: ids) (MLrel i :: rels) (i+1) l - | false :: l -> abs (dummy_name :: ids) (MLdummy :: rels) (i+1) l + | Keep :: l -> abs (anonymous :: ids) (MLrel i :: rels) (i+1) l + | Kill _ :: l -> abs (dummy_name :: ids) (MLdummy :: rels) (i+1) l in abs ids [] 1 s (*s If [s = [b1; ... ; bn]] then [case_expunge] decomposes [e] in [n] lambdas (with eta-expansion if needed) and removes all dummy lambdas - corresponding to [false] in [s]. *) + corresponding to [Del] in [s]. *) let case_expunge s e = let m = List.length s in @@ -892,13 +898,14 @@ let case_expunge s e = (*s [term_expunge] takes a function [fun idn ... id1 -> c] and a signature [s] and remove dummy lams. The difference with [case_expunge] is that we here leave one dummy lambda - if all lambdas are dummy. *) + if all lambdas are logical dummy. *) let term_expunge s (ids,c) = if s = [] then c else let ids,c = kill_some_lams (List.rev s) (ids,c) in - if ids = [] then MLlam (dummy_name, ast_lift 1 c) + if ids = [] && List.mem (Kill Kother) s then + MLlam (dummy_name, ast_lift 1 c) else named_lams ids c (*s [kill_dummy_args ids t0 t] looks for occurences of [t0] in [t] and @@ -907,7 +914,7 @@ let term_expunge s (ids,c) = let kill_dummy_args ids t0 t = let m = List.length ids in - let bl = List.rev_map ((<>) dummy_name) ids in + let bl = List.rev_map sign_of_id ids in let rec killrec n = function | MLapp(e, a) when e = ast_lift n t0 -> let k = max 0 (m - (List.length a)) in @@ -974,7 +981,8 @@ let general_optimize_fix f ids n args m c = let v = Array.make n 0 in for i=0 to (n-1) do v.(i)<-i done; let aux i = function - | MLrel j when v.(j-1)>=0 -> v.(j-1)<-(-i-1) + | MLrel j when v.(j-1)>=0 -> + if ast_occurs (j+1) c then raise Impossible else v.(j-1)<-(-i-1) | _ -> raise Impossible in list_iter_i aux args; let args_f = List.rev_map (fun i -> MLrel (i+m+1)) (Array.to_list v) in @@ -1001,8 +1009,7 @@ let optimize_fix a = -> a' | MLfix(_,[|f|],[|c|]) -> (try general_optimize_fix f ids n args m c - with Impossible -> - named_lams ids (MLapp (MLfix (0,[|f|],[|c|]),args))) + with Impossible -> a) | _ -> a) | _ -> a diff --git a/contrib/extraction/mlutil.mli b/contrib/extraction/mlutil.mli index 1ba1df64..a55caaf2 100644 --- a/contrib/extraction/mlutil.mli +++ b/contrib/extraction/mlutil.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: mlutil.mli 6303 2004-11-16 12:37:40Z sacerdot $ i*) +(*i $Id: mlutil.mli 8724 2006-04-20 09:57:01Z letouzey $ i*) open Util open Names @@ -62,13 +62,15 @@ val var2var' : ml_type -> ml_type type abbrev_map = global_reference -> ml_type option val type_expand : abbrev_map -> ml_type -> ml_type -val type_eq : abbrev_map -> ml_type -> ml_type -> bool -val type_neq : abbrev_map -> ml_type -> ml_type -> bool -val type_to_sign : abbrev_map -> ml_type -> bool list +val type_to_sign : abbrev_map -> ml_type -> sign +val type_to_signature : abbrev_map -> ml_type -> signature val type_expunge : abbrev_map -> ml_type -> ml_type -val case_expunge : bool list -> ml_ast -> identifier list * ml_ast -val term_expunge : bool list -> identifier list * ml_ast -> ml_ast +val isDummy : ml_type -> bool +val isKill : sign -> bool + +val case_expunge : signature -> ml_ast -> identifier list * ml_ast +val term_expunge : signature -> identifier list * ml_ast -> ml_ast (*s Special identifiers. [dummy_name] is to be used for dead code @@ -86,9 +88,9 @@ val collect_n_lams : int -> ml_ast -> identifier list * ml_ast val nb_lams : ml_ast -> int val dummy_lams : ml_ast -> int -> ml_ast -val anonym_or_dummy_lams : ml_ast -> bool list -> ml_ast +val anonym_or_dummy_lams : ml_ast -> signature -> ml_ast -val eta_args_sign : int -> bool list -> ml_ast list +val eta_args_sign : int -> signature -> ml_ast list (*s Utility functions over ML terms. *) diff --git a/contrib/extraction/modutil.ml b/contrib/extraction/modutil.ml index ff8daf46..46d4a5a6 100644 --- a/contrib/extraction/modutil.ml +++ b/contrib/extraction/modutil.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: modutil.ml 7632 2005-12-01 14:35:21Z letouzey $ i*) +(*i $Id: modutil.ml 8724 2006-04-20 09:57:01Z letouzey $ i*) open Names open Declarations @@ -252,40 +252,40 @@ let struct_get_references_list struc = exception Found -let rec ast_search t a = - if t a then raise Found else ast_iter (ast_search t) a +let rec ast_search f a = + if f a then raise Found else ast_iter (ast_search f) a -let decl_ast_search t = function - | Dterm (_,a,_) -> ast_search t a - | Dfix (_,c,_) -> Array.iter (ast_search t) c +let decl_ast_search f = function + | Dterm (_,a,_) -> ast_search f a + | Dfix (_,c,_) -> Array.iter (ast_search f) c | _ -> () -let struct_ast_search t s = - try struct_iter (decl_ast_search t) (fun _ -> ()) s; false +let struct_ast_search f s = + try struct_iter (decl_ast_search f) (fun _ -> ()) s; false with Found -> true -let rec type_search t = function - | Tarr (a,b) -> type_search t a; type_search t b - | Tglob (r,l) -> List.iter (type_search t) l - | u -> if t = u then raise Found +let rec type_search f = function + | Tarr (a,b) -> type_search f a; type_search f b + | Tglob (r,l) -> List.iter (type_search f) l + | u -> if f u then raise Found -let decl_type_search t = function +let decl_type_search f = function | Dind (_,{ind_packets=p}) -> Array.iter - (fun {ip_types=v} -> Array.iter (List.iter (type_search t)) v) p - | Dterm (_,_,u) -> type_search t u - | Dfix (_,_,v) -> Array.iter (type_search t) v - | Dtype (_,_,u) -> type_search t u + (fun {ip_types=v} -> Array.iter (List.iter (type_search f)) v) p + | Dterm (_,_,u) -> type_search f u + | Dfix (_,_,v) -> Array.iter (type_search f) v + | Dtype (_,_,u) -> type_search f u -let spec_type_search t = function +let spec_type_search f = function | Sind (_,{ind_packets=p}) -> Array.iter - (fun {ip_types=v} -> Array.iter (List.iter (type_search t)) v) p - | Stype (_,_,ot) -> option_iter (type_search t) ot - | Sval (_,u) -> type_search t u + (fun {ip_types=v} -> Array.iter (List.iter (type_search f)) v) p + | Stype (_,_,ot) -> option_iter (type_search f) ot + | Sval (_,u) -> type_search f u -let struct_type_search t s = - try struct_iter (decl_type_search t) (spec_type_search t) s; false +let struct_type_search f s = + try struct_iter (decl_type_search f) (spec_type_search f) s; false with Found -> true @@ -359,7 +359,7 @@ let dfix_to_mlfix rv av i = let rec optim prm s = function | [] -> [] - | (Dtype (r,_,Tdummy) | Dterm(r,MLdummy,_)) as d :: l -> + | (Dtype (r,_,Tdummy _) | Dterm(r,MLdummy,_)) as d :: l -> if List.mem r prm.to_appear then d :: (optim prm s l) else optim prm s l | Dterm (r,t,typ) :: l -> let t = normalize (ast_glob_subst !s t) in diff --git a/contrib/extraction/modutil.mli b/contrib/extraction/modutil.mli index f5208c0d..115a42ca 100644 --- a/contrib/extraction/modutil.mli +++ b/contrib/extraction/modutil.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: modutil.mli 7632 2005-12-01 14:35:21Z letouzey $ i*) +(*i $Id: modutil.mli 8724 2006-04-20 09:57:01Z letouzey $ i*) open Names open Declarations @@ -44,7 +44,7 @@ val add_labels_mp : module_path -> label list -> module_path (*s Functions upon ML modules. *) val struct_ast_search : (ml_ast -> bool) -> ml_structure -> bool -val struct_type_search : ml_type -> ml_structure -> bool +val struct_type_search : (ml_type -> bool) -> ml_structure -> bool type do_ref = global_reference -> unit diff --git a/contrib/extraction/ocaml.ml b/contrib/extraction/ocaml.ml index a0620d72..483da236 100644 --- a/contrib/extraction/ocaml.ml +++ b/contrib/extraction/ocaml.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: ocaml.ml 7632 2005-12-01 14:35:21Z letouzey $ i*) +(*i $Id: ocaml.ml 8930 2006-06-09 02:14:34Z letouzey $ i*) (*s Production of Ocaml syntax. *) @@ -196,7 +196,7 @@ let rec pp_type par vl t = | Tarr (t1,t2) -> pp_par par (pp_rec true t1 ++ spc () ++ str "->" ++ spc () ++ pp_rec false t2) - | Tdummy -> str "__" + | Tdummy _ -> str "__" | Tunknown -> str "__" in hov 0 (pp_rec par t) @@ -343,13 +343,9 @@ and pp_pat env i pv = and pp_function env f t = let bl,t' = collect_lams t in let bl,env' = push_vars bl env in - let is_function pv = - let ktl = array_map_to_list (fun (_,l,t0) -> (List.length l,t0)) pv in - not (List.exists (fun (k,t0) -> ast_occurs (k+1) t0) ktl) - in match t' with - | MLcase(i,MLrel 1,pv) when i=Standard -> - if is_function pv then + | MLcase(i,MLrel 1,pv) when i=Standard -> + if not (ast_occurs 1 (MLcase(i,MLdummy,pv))) then (f ++ pr_binding (List.rev (List.tl bl)) ++ str " = function" ++ fnl () ++ v 0 (str " | " ++ pp_pat env' i pv)) @@ -358,7 +354,6 @@ and pp_function env f t = str " = match " ++ pr_id (List.hd bl) ++ str " with" ++ fnl () ++ v 0 (str " | " ++ pp_pat env' i pv)) - | _ -> (f ++ pr_binding (List.rev bl) ++ str " =" ++ fnl () ++ str " " ++ hov 2 (pp_expr false env' [] t')) diff --git a/contrib/extraction/test/.depend b/contrib/extraction/test/.depend index 641b50a7..31d46eeb 100644 --- a/contrib/extraction/test/.depend +++ b/contrib/extraction/test/.depend @@ -2,110 +2,318 @@ theories/Arith/arith.cmo: theories/Arith/arith.cmi theories/Arith/arith.cmx: theories/Arith/arith.cmi theories/Arith/between.cmo: theories/Arith/between.cmi theories/Arith/between.cmx: theories/Arith/between.cmi -theories/Arith/bool_nat.cmo: theories/Arith/compare_dec.cmi \ - theories/Init/datatypes.cmi theories/Arith/peano_dec.cmi \ - theories/Init/specif.cmi theories/Bool/sumbool.cmi \ +theories/Arith/bool_nat.cmo: theories/Bool/sumbool.cmi \ + theories/Init/specif.cmi theories/Arith/peano_dec.cmi \ + theories/Init/datatypes.cmi theories/Arith/compare_dec.cmi \ theories/Arith/bool_nat.cmi -theories/Arith/bool_nat.cmx: theories/Arith/compare_dec.cmx \ - theories/Init/datatypes.cmx theories/Arith/peano_dec.cmx \ - theories/Init/specif.cmx theories/Bool/sumbool.cmx \ +theories/Arith/bool_nat.cmx: theories/Bool/sumbool.cmx \ + theories/Init/specif.cmx theories/Arith/peano_dec.cmx \ + theories/Init/datatypes.cmx theories/Arith/compare_dec.cmx \ theories/Arith/bool_nat.cmi -theories/Arith/compare_dec.cmo: theories/Init/datatypes.cmi \ - theories/Init/specif.cmi theories/Arith/compare_dec.cmi -theories/Arith/compare_dec.cmx: theories/Init/datatypes.cmx \ - theories/Init/specif.cmx theories/Arith/compare_dec.cmi -theories/Arith/compare.cmo: theories/Arith/compare_dec.cmi \ - theories/Init/datatypes.cmi theories/Init/specif.cmi \ +theories/Arith/compare_dec.cmo: theories/Init/specif.cmi \ + theories/Init/datatypes.cmi theories/Arith/compare_dec.cmi +theories/Arith/compare_dec.cmx: theories/Init/specif.cmx \ + theories/Init/datatypes.cmx theories/Arith/compare_dec.cmi +theories/Arith/compare.cmo: theories/Init/specif.cmi \ + theories/Init/datatypes.cmi theories/Arith/compare_dec.cmi \ theories/Arith/compare.cmi -theories/Arith/compare.cmx: theories/Arith/compare_dec.cmx \ - theories/Init/datatypes.cmx theories/Init/specif.cmx \ +theories/Arith/compare.cmx: theories/Init/specif.cmx \ + theories/Init/datatypes.cmx theories/Arith/compare_dec.cmx \ theories/Arith/compare.cmi -theories/Arith/div2.cmo: theories/Init/datatypes.cmi theories/Init/peano.cmi \ - theories/Init/specif.cmi theories/Arith/div2.cmi -theories/Arith/div2.cmx: theories/Init/datatypes.cmx theories/Init/peano.cmx \ - theories/Init/specif.cmx theories/Arith/div2.cmi -theories/Arith/eqNat.cmo: theories/Init/datatypes.cmi \ - theories/Init/specif.cmi theories/Arith/eqNat.cmi -theories/Arith/eqNat.cmx: theories/Init/datatypes.cmx \ - theories/Init/specif.cmx theories/Arith/eqNat.cmi -theories/Arith/euclid.cmo: theories/Arith/compare_dec.cmi \ - theories/Init/datatypes.cmi theories/Init/specif.cmi \ +theories/Arith/div2.cmo: theories/Init/specif.cmi theories/Init/peano.cmi \ + theories/Init/datatypes.cmi theories/Arith/div2.cmi +theories/Arith/div2.cmx: theories/Init/specif.cmx theories/Init/peano.cmx \ + theories/Init/datatypes.cmx theories/Arith/div2.cmi +theories/Arith/eqNat.cmo: theories/Init/specif.cmi \ + theories/Init/datatypes.cmi theories/Arith/eqNat.cmi +theories/Arith/eqNat.cmx: theories/Init/specif.cmx \ + theories/Init/datatypes.cmx theories/Arith/eqNat.cmi +theories/Arith/euclid.cmo: theories/Init/specif.cmi theories/Init/peano.cmi \ + theories/Init/datatypes.cmi theories/Arith/compare_dec.cmi \ theories/Arith/euclid.cmi -theories/Arith/euclid.cmx: theories/Arith/compare_dec.cmx \ - theories/Init/datatypes.cmx theories/Init/specif.cmx \ +theories/Arith/euclid.cmx: theories/Init/specif.cmx theories/Init/peano.cmx \ + theories/Init/datatypes.cmx theories/Arith/compare_dec.cmx \ theories/Arith/euclid.cmi -theories/Arith/even.cmo: theories/Init/datatypes.cmi theories/Init/specif.cmi \ +theories/Arith/even.cmo: theories/Init/specif.cmi theories/Init/datatypes.cmi \ theories/Arith/even.cmi -theories/Arith/even.cmx: theories/Init/datatypes.cmx theories/Init/specif.cmx \ +theories/Arith/even.cmx: theories/Init/specif.cmx theories/Init/datatypes.cmx \ theories/Arith/even.cmi -theories/Arith/factorial.cmo: theories/Init/datatypes.cmi \ - theories/Init/peano.cmi theories/Arith/factorial.cmi -theories/Arith/factorial.cmx: theories/Init/datatypes.cmx \ - theories/Init/peano.cmx theories/Arith/factorial.cmi +theories/Arith/factorial.cmo: theories/Init/peano.cmi \ + theories/Init/datatypes.cmi theories/Arith/factorial.cmi +theories/Arith/factorial.cmx: theories/Init/peano.cmx \ + theories/Init/datatypes.cmx theories/Arith/factorial.cmi theories/Arith/gt.cmo: theories/Arith/gt.cmi theories/Arith/gt.cmx: theories/Arith/gt.cmi theories/Arith/le.cmo: theories/Arith/le.cmi theories/Arith/le.cmx: theories/Arith/le.cmi theories/Arith/lt.cmo: theories/Arith/lt.cmi theories/Arith/lt.cmx: theories/Arith/lt.cmi -theories/Arith/max.cmo: theories/Init/datatypes.cmi theories/Init/specif.cmi \ +theories/Arith/max.cmo: theories/Init/specif.cmi theories/Init/datatypes.cmi \ theories/Arith/max.cmi -theories/Arith/max.cmx: theories/Init/datatypes.cmx theories/Init/specif.cmx \ +theories/Arith/max.cmx: theories/Init/specif.cmx theories/Init/datatypes.cmx \ theories/Arith/max.cmi -theories/Arith/min.cmo: theories/Init/datatypes.cmi theories/Init/specif.cmi \ +theories/Arith/min.cmo: theories/Init/specif.cmi theories/Init/datatypes.cmi \ theories/Arith/min.cmi -theories/Arith/min.cmx: theories/Init/datatypes.cmx theories/Init/specif.cmx \ +theories/Arith/min.cmx: theories/Init/specif.cmx theories/Init/datatypes.cmx \ theories/Arith/min.cmi theories/Arith/minus.cmo: theories/Arith/minus.cmi theories/Arith/minus.cmx: theories/Arith/minus.cmi -theories/Arith/mult.cmo: theories/Init/datatypes.cmi theories/Arith/plus.cmi \ +theories/Arith/mult.cmo: theories/Arith/plus.cmi theories/Init/datatypes.cmi \ theories/Arith/mult.cmi -theories/Arith/mult.cmx: theories/Init/datatypes.cmx theories/Arith/plus.cmx \ +theories/Arith/mult.cmx: theories/Arith/plus.cmx theories/Init/datatypes.cmx \ theories/Arith/mult.cmi -theories/Arith/peano_dec.cmo: theories/Init/datatypes.cmi \ - theories/Init/specif.cmi theories/Arith/peano_dec.cmi -theories/Arith/peano_dec.cmx: theories/Init/datatypes.cmx \ - theories/Init/specif.cmx theories/Arith/peano_dec.cmi -theories/Arith/plus.cmo: theories/Init/datatypes.cmi theories/Init/specif.cmi \ +theories/Arith/peano_dec.cmo: theories/Init/specif.cmi \ + theories/Init/datatypes.cmi theories/Arith/peano_dec.cmi +theories/Arith/peano_dec.cmx: theories/Init/specif.cmx \ + theories/Init/datatypes.cmx theories/Arith/peano_dec.cmi +theories/Arith/plus.cmo: theories/Init/specif.cmi theories/Init/datatypes.cmi \ theories/Arith/plus.cmi -theories/Arith/plus.cmx: theories/Init/datatypes.cmx theories/Init/specif.cmx \ +theories/Arith/plus.cmx: theories/Init/specif.cmx theories/Init/datatypes.cmx \ theories/Arith/plus.cmi theories/Arith/wf_nat.cmo: theories/Init/datatypes.cmi \ theories/Arith/wf_nat.cmi theories/Arith/wf_nat.cmx: theories/Init/datatypes.cmx \ theories/Arith/wf_nat.cmi -theories/Bool/boolEq.cmo: theories/Init/datatypes.cmi \ - theories/Init/specif.cmi theories/Bool/boolEq.cmi -theories/Bool/boolEq.cmx: theories/Init/datatypes.cmx \ - theories/Init/specif.cmx theories/Bool/boolEq.cmi -theories/Bool/bool.cmo: theories/Init/datatypes.cmi theories/Init/specif.cmi \ +theories/Bool/boolEq.cmo: theories/Init/specif.cmi \ + theories/Init/datatypes.cmi theories/Bool/boolEq.cmi +theories/Bool/boolEq.cmx: theories/Init/specif.cmx \ + theories/Init/datatypes.cmx theories/Bool/boolEq.cmi +theories/Bool/bool.cmo: theories/Init/specif.cmi theories/Init/datatypes.cmi \ theories/Bool/bool.cmi -theories/Bool/bool.cmx: theories/Init/datatypes.cmx theories/Init/specif.cmx \ +theories/Bool/bool.cmx: theories/Init/specif.cmx theories/Init/datatypes.cmx \ theories/Bool/bool.cmi -theories/Bool/bvector.cmo: theories/Bool/bool.cmi theories/Init/datatypes.cmi \ - theories/Init/peano.cmi theories/Bool/bvector.cmi -theories/Bool/bvector.cmx: theories/Bool/bool.cmx theories/Init/datatypes.cmx \ - theories/Init/peano.cmx theories/Bool/bvector.cmi +theories/Bool/bvector.cmo: theories/Init/peano.cmi \ + theories/Init/datatypes.cmi theories/Bool/bool.cmi \ + theories/Bool/bvector.cmi +theories/Bool/bvector.cmx: theories/Init/peano.cmx \ + theories/Init/datatypes.cmx theories/Bool/bool.cmx \ + theories/Bool/bvector.cmi theories/Bool/decBool.cmo: theories/Init/specif.cmi theories/Bool/decBool.cmi theories/Bool/decBool.cmx: theories/Init/specif.cmx theories/Bool/decBool.cmi -theories/Bool/ifProp.cmo: theories/Init/datatypes.cmi \ - theories/Init/specif.cmi theories/Bool/ifProp.cmi -theories/Bool/ifProp.cmx: theories/Init/datatypes.cmx \ - theories/Init/specif.cmx theories/Bool/ifProp.cmi -theories/Bool/sumbool.cmo: theories/Init/datatypes.cmi \ - theories/Init/specif.cmi theories/Bool/sumbool.cmi -theories/Bool/sumbool.cmx: theories/Init/datatypes.cmx \ - theories/Init/specif.cmx theories/Bool/sumbool.cmi +theories/Bool/ifProp.cmo: theories/Init/specif.cmi \ + theories/Init/datatypes.cmi theories/Bool/ifProp.cmi +theories/Bool/ifProp.cmx: theories/Init/specif.cmx \ + theories/Init/datatypes.cmx theories/Bool/ifProp.cmi +theories/Bool/sumbool.cmo: theories/Init/specif.cmi \ + theories/Init/datatypes.cmi theories/Bool/sumbool.cmi +theories/Bool/sumbool.cmx: theories/Init/specif.cmx \ + theories/Init/datatypes.cmx theories/Bool/sumbool.cmi theories/Bool/zerob.cmo: theories/Init/datatypes.cmi theories/Bool/zerob.cmi theories/Bool/zerob.cmx: theories/Init/datatypes.cmx theories/Bool/zerob.cmi +theories/FSets/decidableTypeEx.cmo: theories/Init/specif.cmi \ + theories/FSets/orderedTypeEx.cmi theories/FSets/orderedType.cmi \ + theories/Init/datatypes.cmi theories/FSets/decidableTypeEx.cmi +theories/FSets/decidableTypeEx.cmx: theories/Init/specif.cmx \ + theories/FSets/orderedTypeEx.cmx theories/FSets/orderedType.cmx \ + theories/Init/datatypes.cmx theories/FSets/decidableTypeEx.cmi +theories/FSets/decidableType.cmo: theories/Init/specif.cmi \ + theories/FSets/decidableType.cmi +theories/FSets/decidableType.cmx: theories/Init/specif.cmx \ + theories/FSets/decidableType.cmi +theories/FSets/fMapAVL.cmo: theories/Init/wf.cmi theories/Init/specif.cmi \ + theories/FSets/orderedType.cmi theories/Lists/list.cmi \ + theories/FSets/int.cmi theories/FSets/fMapList.cmi \ + theories/Init/datatypes.cmi theories/NArith/binPos.cmi \ + theories/ZArith/binInt.cmi theories/FSets/fMapAVL.cmi +theories/FSets/fMapAVL.cmx: theories/Init/wf.cmx theories/Init/specif.cmx \ + theories/FSets/orderedType.cmx theories/Lists/list.cmx \ + theories/FSets/int.cmx theories/FSets/fMapList.cmx \ + theories/Init/datatypes.cmx theories/NArith/binPos.cmx \ + theories/ZArith/binInt.cmx theories/FSets/fMapAVL.cmi +theories/FSets/fMapFacts.cmo: theories/Init/specif.cmi \ + theories/FSets/orderedType.cmi theories/FSets/fMapInterface.cmi \ + theories/Init/datatypes.cmi theories/FSets/fMapFacts.cmi +theories/FSets/fMapFacts.cmx: theories/Init/specif.cmx \ + theories/FSets/orderedType.cmx theories/FSets/fMapInterface.cmx \ + theories/Init/datatypes.cmx theories/FSets/fMapFacts.cmi +theories/FSets/fMapInterface.cmo: theories/FSets/orderedType.cmi \ + theories/Lists/list.cmi theories/Init/datatypes.cmi \ + theories/FSets/fMapInterface.cmi +theories/FSets/fMapInterface.cmx: theories/FSets/orderedType.cmx \ + theories/Lists/list.cmx theories/Init/datatypes.cmx \ + theories/FSets/fMapInterface.cmi +theories/FSets/fMapIntMap.cmo: theories/Init/specif.cmi \ + theories/FSets/orderedType.cmi theories/NArith/ndigits.cmi \ + theories/IntMap/mapiter.cmi theories/IntMap/mapcanon.cmi \ + theories/IntMap/map.cmi theories/Lists/list.cmi \ + theories/FSets/fMapList.cmi theories/Init/datatypes.cmi \ + theories/NArith/binNat.cmi theories/FSets/fMapIntMap.cmi +theories/FSets/fMapIntMap.cmx: theories/Init/specif.cmx \ + theories/FSets/orderedType.cmx theories/NArith/ndigits.cmx \ + theories/IntMap/mapiter.cmx theories/IntMap/mapcanon.cmx \ + theories/IntMap/map.cmx theories/Lists/list.cmx \ + theories/FSets/fMapList.cmx theories/Init/datatypes.cmx \ + theories/NArith/binNat.cmx theories/FSets/fMapIntMap.cmi +theories/FSets/fMapList.cmo: theories/Init/specif.cmi \ + theories/FSets/orderedType.cmi theories/Lists/list.cmi \ + theories/Init/datatypes.cmi theories/FSets/fMapList.cmi +theories/FSets/fMapList.cmx: theories/Init/specif.cmx \ + theories/FSets/orderedType.cmx theories/Lists/list.cmx \ + theories/Init/datatypes.cmx theories/FSets/fMapList.cmi +theories/FSets/fMapPositive.cmo: theories/Init/specif.cmi \ + theories/FSets/orderedType.cmi theories/Lists/list.cmi \ + theories/Init/datatypes.cmi theories/NArith/binPos.cmi \ + theories/FSets/fMapPositive.cmi +theories/FSets/fMapPositive.cmx: theories/Init/specif.cmx \ + theories/FSets/orderedType.cmx theories/Lists/list.cmx \ + theories/Init/datatypes.cmx theories/NArith/binPos.cmx \ + theories/FSets/fMapPositive.cmi +theories/FSets/fMaps.cmo: theories/FSets/fMaps.cmi +theories/FSets/fMaps.cmx: theories/FSets/fMaps.cmi +theories/FSets/fMapWeakFacts.cmo: theories/Init/specif.cmi \ + theories/Lists/list.cmi theories/FSets/fMapWeakInterface.cmi \ + theories/Init/datatypes.cmi theories/FSets/fMapWeakFacts.cmi +theories/FSets/fMapWeakFacts.cmx: theories/Init/specif.cmx \ + theories/Lists/list.cmx theories/FSets/fMapWeakInterface.cmx \ + theories/Init/datatypes.cmx theories/FSets/fMapWeakFacts.cmi +theories/FSets/fMapWeakInterface.cmo: theories/Lists/list.cmi \ + theories/FSets/decidableType.cmi theories/Init/datatypes.cmi \ + theories/FSets/fMapWeakInterface.cmi +theories/FSets/fMapWeakInterface.cmx: theories/Lists/list.cmx \ + theories/FSets/decidableType.cmx theories/Init/datatypes.cmx \ + theories/FSets/fMapWeakInterface.cmi +theories/FSets/fMapWeakList.cmo: theories/Init/specif.cmi \ + theories/Lists/list.cmi theories/FSets/decidableType.cmi \ + theories/Init/datatypes.cmi theories/FSets/fMapWeakList.cmi +theories/FSets/fMapWeakList.cmx: theories/Init/specif.cmx \ + theories/Lists/list.cmx theories/FSets/decidableType.cmx \ + theories/Init/datatypes.cmx theories/FSets/fMapWeakList.cmi +theories/FSets/fMapWeak.cmo: theories/FSets/fMapWeak.cmi +theories/FSets/fMapWeak.cmx: theories/FSets/fMapWeak.cmi +theories/FSets/fSetAVL.cmo: theories/Init/wf.cmi theories/Init/specif.cmi \ + theories/Init/peano.cmi theories/FSets/orderedType.cmi \ + theories/Lists/list.cmi theories/FSets/int.cmi \ + theories/FSets/fSetList.cmi theories/Init/datatypes.cmi \ + theories/NArith/binPos.cmi theories/ZArith/binInt.cmi \ + theories/FSets/fSetAVL.cmi +theories/FSets/fSetAVL.cmx: theories/Init/wf.cmx theories/Init/specif.cmx \ + theories/Init/peano.cmx theories/FSets/orderedType.cmx \ + theories/Lists/list.cmx theories/FSets/int.cmx \ + theories/FSets/fSetList.cmx theories/Init/datatypes.cmx \ + theories/NArith/binPos.cmx theories/ZArith/binInt.cmx \ + theories/FSets/fSetAVL.cmi +theories/FSets/fSetBridge.cmo: theories/Init/specif.cmi \ + theories/FSets/orderedType.cmi theories/Lists/list.cmi \ + theories/FSets/fSetInterface.cmi theories/Init/datatypes.cmi \ + theories/FSets/fSetBridge.cmi +theories/FSets/fSetBridge.cmx: theories/Init/specif.cmx \ + theories/FSets/orderedType.cmx theories/Lists/list.cmx \ + theories/FSets/fSetInterface.cmx theories/Init/datatypes.cmx \ + theories/FSets/fSetBridge.cmi +theories/FSets/fSetEqProperties.cmo: theories/Init/specif.cmi \ + theories/Setoids/setoid.cmi theories/Init/peano.cmi \ + theories/FSets/orderedType.cmi theories/FSets/fSetProperties.cmi \ + theories/FSets/fSetInterface.cmi theories/Init/datatypes.cmi \ + theories/Bool/bool.cmi theories/FSets/fSetEqProperties.cmi +theories/FSets/fSetEqProperties.cmx: theories/Init/specif.cmx \ + theories/Setoids/setoid.cmx theories/Init/peano.cmx \ + theories/FSets/orderedType.cmx theories/FSets/fSetProperties.cmx \ + theories/FSets/fSetInterface.cmx theories/Init/datatypes.cmx \ + theories/Bool/bool.cmx theories/FSets/fSetEqProperties.cmi +theories/FSets/fSetFacts.cmo: theories/Init/specif.cmi \ + theories/Setoids/setoid.cmi theories/FSets/orderedType.cmi \ + theories/FSets/fSetInterface.cmi theories/Init/datatypes.cmi \ + theories/FSets/fSetFacts.cmi +theories/FSets/fSetFacts.cmx: theories/Init/specif.cmx \ + theories/Setoids/setoid.cmx theories/FSets/orderedType.cmx \ + theories/FSets/fSetInterface.cmx theories/Init/datatypes.cmx \ + theories/FSets/fSetFacts.cmi +theories/FSets/fSetInterface.cmo: theories/Init/specif.cmi \ + theories/FSets/orderedType.cmi theories/Lists/list.cmi \ + theories/Init/datatypes.cmi theories/FSets/fSetInterface.cmi +theories/FSets/fSetInterface.cmx: theories/Init/specif.cmx \ + theories/FSets/orderedType.cmx theories/Lists/list.cmx \ + theories/Init/datatypes.cmx theories/FSets/fSetInterface.cmi +theories/FSets/fSetList.cmo: theories/Init/specif.cmi \ + theories/FSets/orderedType.cmi theories/Lists/list.cmi \ + theories/Init/datatypes.cmi theories/FSets/fSetList.cmi +theories/FSets/fSetList.cmx: theories/Init/specif.cmx \ + theories/FSets/orderedType.cmx theories/Lists/list.cmx \ + theories/Init/datatypes.cmx theories/FSets/fSetList.cmi +theories/FSets/fSetProperties.cmo: theories/Init/specif.cmi \ + theories/Setoids/setoid.cmi theories/FSets/orderedType.cmi \ + theories/Lists/list.cmi theories/FSets/fSetInterface.cmi \ + theories/FSets/fSetFacts.cmi theories/Init/datatypes.cmi \ + theories/FSets/fSetProperties.cmi +theories/FSets/fSetProperties.cmx: theories/Init/specif.cmx \ + theories/Setoids/setoid.cmx theories/FSets/orderedType.cmx \ + theories/Lists/list.cmx theories/FSets/fSetInterface.cmx \ + theories/FSets/fSetFacts.cmx theories/Init/datatypes.cmx \ + theories/FSets/fSetProperties.cmi +theories/FSets/fSets.cmo: theories/FSets/fSets.cmi +theories/FSets/fSets.cmx: theories/FSets/fSets.cmi +theories/FSets/fSetToFiniteSet.cmo: theories/Init/specif.cmi \ + theories/Setoids/setoid.cmi theories/FSets/orderedTypeEx.cmi \ + theories/FSets/orderedType.cmi theories/Lists/list.cmi \ + theories/FSets/fSetProperties.cmi theories/Init/datatypes.cmi \ + theories/FSets/fSetToFiniteSet.cmi +theories/FSets/fSetToFiniteSet.cmx: theories/Init/specif.cmx \ + theories/Setoids/setoid.cmx theories/FSets/orderedTypeEx.cmx \ + theories/FSets/orderedType.cmx theories/Lists/list.cmx \ + theories/FSets/fSetProperties.cmx theories/Init/datatypes.cmx \ + theories/FSets/fSetToFiniteSet.cmi +theories/FSets/fSetWeakFacts.cmo: theories/Init/specif.cmi \ + theories/Setoids/setoid.cmi theories/FSets/fSetWeakInterface.cmi \ + theories/Init/datatypes.cmi theories/FSets/fSetWeakFacts.cmi +theories/FSets/fSetWeakFacts.cmx: theories/Init/specif.cmx \ + theories/Setoids/setoid.cmx theories/FSets/fSetWeakInterface.cmx \ + theories/Init/datatypes.cmx theories/FSets/fSetWeakFacts.cmi +theories/FSets/fSetWeakInterface.cmo: theories/Lists/list.cmi \ + theories/FSets/decidableType.cmi theories/Init/datatypes.cmi \ + theories/FSets/fSetWeakInterface.cmi +theories/FSets/fSetWeakInterface.cmx: theories/Lists/list.cmx \ + theories/FSets/decidableType.cmx theories/Init/datatypes.cmx \ + theories/FSets/fSetWeakInterface.cmi +theories/FSets/fSetWeakList.cmo: theories/Init/specif.cmi \ + theories/Lists/list.cmi theories/FSets/decidableType.cmi \ + theories/Init/datatypes.cmi theories/FSets/fSetWeakList.cmi +theories/FSets/fSetWeakList.cmx: theories/Init/specif.cmx \ + theories/Lists/list.cmx theories/FSets/decidableType.cmx \ + theories/Init/datatypes.cmx theories/FSets/fSetWeakList.cmi +theories/FSets/fSetWeak.cmo: theories/FSets/fSetWeak.cmi +theories/FSets/fSetWeak.cmx: theories/FSets/fSetWeak.cmi +theories/FSets/fSetWeakProperties.cmo: theories/Init/specif.cmi \ + theories/Setoids/setoid.cmi theories/Lists/list.cmi \ + theories/FSets/fSetWeakInterface.cmi theories/FSets/fSetWeakFacts.cmi \ + theories/Init/datatypes.cmi theories/FSets/fSetWeakProperties.cmi +theories/FSets/fSetWeakProperties.cmx: theories/Init/specif.cmx \ + theories/Setoids/setoid.cmx theories/Lists/list.cmx \ + theories/FSets/fSetWeakInterface.cmx theories/FSets/fSetWeakFacts.cmx \ + theories/Init/datatypes.cmx theories/FSets/fSetWeakProperties.cmi +theories/FSets/int.cmo: theories/ZArith/zmax.cmi \ + theories/ZArith/zArith_dec.cmi theories/Init/specif.cmi \ + theories/NArith/binPos.cmi theories/ZArith/binInt.cmi \ + theories/FSets/int.cmi +theories/FSets/int.cmx: theories/ZArith/zmax.cmx \ + theories/ZArith/zArith_dec.cmx theories/Init/specif.cmx \ + theories/NArith/binPos.cmx theories/ZArith/binInt.cmx \ + theories/FSets/int.cmi +theories/FSets/orderedTypeAlt.cmo: theories/Init/specif.cmi \ + theories/FSets/orderedType.cmi theories/Init/datatypes.cmi \ + theories/FSets/orderedTypeAlt.cmi +theories/FSets/orderedTypeAlt.cmx: theories/Init/specif.cmx \ + theories/FSets/orderedType.cmx theories/Init/datatypes.cmx \ + theories/FSets/orderedTypeAlt.cmi +theories/FSets/orderedTypeEx.cmo: theories/Init/specif.cmi \ + theories/FSets/orderedType.cmi theories/Init/datatypes.cmi \ + theories/Arith/compare_dec.cmi theories/NArith/binPos.cmi \ + theories/NArith/binNat.cmi theories/ZArith/binInt.cmi \ + theories/FSets/orderedTypeEx.cmi +theories/FSets/orderedTypeEx.cmx: theories/Init/specif.cmx \ + theories/FSets/orderedType.cmx theories/Init/datatypes.cmx \ + theories/Arith/compare_dec.cmx theories/NArith/binPos.cmx \ + theories/NArith/binNat.cmx theories/ZArith/binInt.cmx \ + theories/FSets/orderedTypeEx.cmi +theories/FSets/orderedType.cmo: theories/Init/specif.cmi \ + theories/Init/datatypes.cmi theories/FSets/orderedType.cmi +theories/FSets/orderedType.cmx: theories/Init/specif.cmx \ + theories/Init/datatypes.cmx theories/FSets/orderedType.cmi theories/Init/datatypes.cmo: theories/Init/datatypes.cmi theories/Init/datatypes.cmx: theories/Init/datatypes.cmi theories/Init/logic.cmo: theories/Init/logic.cmi theories/Init/logic.cmx: theories/Init/logic.cmi -theories/Init/logic_Type.cmo: theories/Init/datatypes.cmi \ - theories/Init/logic_Type.cmi -theories/Init/logic_Type.cmx: theories/Init/datatypes.cmx \ - theories/Init/logic_Type.cmi +theories/Init/logic_Type.cmo: theories/Init/logic_Type.cmi +theories/Init/logic_Type.cmx: theories/Init/logic_Type.cmi theories/Init/notations.cmo: theories/Init/notations.cmi theories/Init/notations.cmx: theories/Init/notations.cmi theories/Init/peano.cmo: theories/Init/datatypes.cmi theories/Init/peano.cmi @@ -116,152 +324,146 @@ theories/Init/specif.cmo: theories/Init/datatypes.cmi \ theories/Init/specif.cmi theories/Init/specif.cmx: theories/Init/datatypes.cmx \ theories/Init/specif.cmi +theories/Init/tactics.cmo: theories/Init/tactics.cmi +theories/Init/tactics.cmx: theories/Init/tactics.cmi theories/Init/wf.cmo: theories/Init/wf.cmi theories/Init/wf.cmx: theories/Init/wf.cmi -theories/IntMap/adalloc.cmo: theories/IntMap/addec.cmi \ - theories/IntMap/addr.cmi theories/NArith/binPos.cmi \ - theories/Init/datatypes.cmi theories/IntMap/map.cmi \ - theories/Init/specif.cmi theories/Bool/sumbool.cmi \ - theories/IntMap/adalloc.cmi -theories/IntMap/adalloc.cmx: theories/IntMap/addec.cmx \ - theories/IntMap/addr.cmx theories/NArith/binPos.cmx \ - theories/Init/datatypes.cmx theories/IntMap/map.cmx \ - theories/Init/specif.cmx theories/Bool/sumbool.cmx \ - theories/IntMap/adalloc.cmi -theories/IntMap/addec.cmo: theories/IntMap/addr.cmi \ - theories/NArith/binPos.cmi theories/Init/datatypes.cmi \ - theories/Init/specif.cmi theories/Bool/sumbool.cmi \ - theories/IntMap/addec.cmi -theories/IntMap/addec.cmx: theories/IntMap/addr.cmx \ - theories/NArith/binPos.cmx theories/Init/datatypes.cmx \ - theories/Init/specif.cmx theories/Bool/sumbool.cmx \ - theories/IntMap/addec.cmi -theories/IntMap/addr.cmo: theories/NArith/binPos.cmi theories/Bool/bool.cmi \ - theories/Init/datatypes.cmi theories/Init/specif.cmi \ - theories/IntMap/addr.cmi -theories/IntMap/addr.cmx: theories/NArith/binPos.cmx theories/Bool/bool.cmx \ - theories/Init/datatypes.cmx theories/Init/specif.cmx \ - theories/IntMap/addr.cmi -theories/IntMap/adist.cmo: theories/IntMap/addr.cmi \ - theories/NArith/binPos.cmi theories/Init/datatypes.cmi \ - theories/IntMap/adist.cmi -theories/IntMap/adist.cmx: theories/IntMap/addr.cmx \ - theories/NArith/binPos.cmx theories/Init/datatypes.cmx \ - theories/IntMap/adist.cmi +theories/IntMap/adalloc.cmo: theories/Bool/sumbool.cmi \ + theories/Init/specif.cmi theories/NArith/ndec.cmi theories/IntMap/map.cmi \ + theories/Init/datatypes.cmi theories/NArith/binPos.cmi \ + theories/NArith/binNat.cmi theories/IntMap/adalloc.cmi +theories/IntMap/adalloc.cmx: theories/Bool/sumbool.cmx \ + theories/Init/specif.cmx theories/NArith/ndec.cmx theories/IntMap/map.cmx \ + theories/Init/datatypes.cmx theories/NArith/binPos.cmx \ + theories/NArith/binNat.cmx theories/IntMap/adalloc.cmi theories/IntMap/allmaps.cmo: theories/IntMap/allmaps.cmi theories/IntMap/allmaps.cmx: theories/IntMap/allmaps.cmi -theories/IntMap/fset.cmo: theories/IntMap/addec.cmi theories/IntMap/addr.cmi \ - theories/Init/datatypes.cmi theories/IntMap/map.cmi \ - theories/Init/specif.cmi theories/IntMap/fset.cmi -theories/IntMap/fset.cmx: theories/IntMap/addec.cmx theories/IntMap/addr.cmx \ - theories/Init/datatypes.cmx theories/IntMap/map.cmx \ - theories/Init/specif.cmx theories/IntMap/fset.cmi -theories/IntMap/lsort.cmo: theories/IntMap/addec.cmi theories/IntMap/addr.cmi \ - theories/NArith/binPos.cmi theories/Bool/bool.cmi \ - theories/Init/datatypes.cmi theories/Lists/list.cmi \ - theories/IntMap/map.cmi theories/IntMap/mapiter.cmi \ - theories/Init/specif.cmi theories/Bool/sumbool.cmi \ - theories/IntMap/lsort.cmi -theories/IntMap/lsort.cmx: theories/IntMap/addec.cmx theories/IntMap/addr.cmx \ - theories/NArith/binPos.cmx theories/Bool/bool.cmx \ - theories/Init/datatypes.cmx theories/Lists/list.cmx \ - theories/IntMap/map.cmx theories/IntMap/mapiter.cmx \ - theories/Init/specif.cmx theories/Bool/sumbool.cmx \ - theories/IntMap/lsort.cmi +theories/IntMap/fset.cmo: theories/Init/specif.cmi \ + theories/NArith/ndigits.cmi theories/NArith/ndec.cmi \ + theories/IntMap/map.cmi theories/Init/datatypes.cmi \ + theories/NArith/binNat.cmi theories/IntMap/fset.cmi +theories/IntMap/fset.cmx: theories/Init/specif.cmx \ + theories/NArith/ndigits.cmx theories/NArith/ndec.cmx \ + theories/IntMap/map.cmx theories/Init/datatypes.cmx \ + theories/NArith/binNat.cmx theories/IntMap/fset.cmi +theories/IntMap/lsort.cmo: theories/Bool/sumbool.cmi theories/Init/specif.cmi \ + theories/NArith/ndigits.cmi theories/NArith/ndec.cmi \ + theories/IntMap/mapiter.cmi theories/IntMap/map.cmi \ + theories/Lists/list.cmi theories/Init/datatypes.cmi \ + theories/NArith/binNat.cmi theories/IntMap/lsort.cmi +theories/IntMap/lsort.cmx: theories/Bool/sumbool.cmx theories/Init/specif.cmx \ + theories/NArith/ndigits.cmx theories/NArith/ndec.cmx \ + theories/IntMap/mapiter.cmx theories/IntMap/map.cmx \ + theories/Lists/list.cmx theories/Init/datatypes.cmx \ + theories/NArith/binNat.cmx theories/IntMap/lsort.cmi theories/IntMap/mapaxioms.cmo: theories/IntMap/mapaxioms.cmi theories/IntMap/mapaxioms.cmx: theories/IntMap/mapaxioms.cmi -theories/IntMap/mapcanon.cmo: theories/IntMap/map.cmi \ - theories/Init/specif.cmi theories/IntMap/mapcanon.cmi -theories/IntMap/mapcanon.cmx: theories/IntMap/map.cmx \ - theories/Init/specif.cmx theories/IntMap/mapcanon.cmi -theories/IntMap/mapcard.cmo: theories/IntMap/addec.cmi \ - theories/IntMap/addr.cmi theories/Init/datatypes.cmi \ - theories/IntMap/map.cmi theories/Init/peano.cmi \ - theories/Arith/peano_dec.cmi theories/Arith/plus.cmi \ - theories/Init/specif.cmi theories/Bool/sumbool.cmi \ - theories/IntMap/mapcard.cmi -theories/IntMap/mapcard.cmx: theories/IntMap/addec.cmx \ - theories/IntMap/addr.cmx theories/Init/datatypes.cmx \ - theories/IntMap/map.cmx theories/Init/peano.cmx \ - theories/Arith/peano_dec.cmx theories/Arith/plus.cmx \ - theories/Init/specif.cmx theories/Bool/sumbool.cmx \ - theories/IntMap/mapcard.cmi +theories/IntMap/mapcanon.cmo: theories/Init/specif.cmi \ + theories/IntMap/map.cmi theories/IntMap/mapcanon.cmi +theories/IntMap/mapcanon.cmx: theories/Init/specif.cmx \ + theories/IntMap/map.cmx theories/IntMap/mapcanon.cmi +theories/IntMap/mapcard.cmo: theories/Bool/sumbool.cmi \ + theories/Init/specif.cmi theories/Arith/plus.cmi \ + theories/Arith/peano_dec.cmi theories/Init/peano.cmi \ + theories/NArith/ndigits.cmi theories/NArith/ndec.cmi \ + theories/IntMap/map.cmi theories/Init/datatypes.cmi \ + theories/NArith/binNat.cmi theories/IntMap/mapcard.cmi +theories/IntMap/mapcard.cmx: theories/Bool/sumbool.cmx \ + theories/Init/specif.cmx theories/Arith/plus.cmx \ + theories/Arith/peano_dec.cmx theories/Init/peano.cmx \ + theories/NArith/ndigits.cmx theories/NArith/ndec.cmx \ + theories/IntMap/map.cmx theories/Init/datatypes.cmx \ + theories/NArith/binNat.cmx theories/IntMap/mapcard.cmi theories/IntMap/mapc.cmo: theories/IntMap/mapc.cmi theories/IntMap/mapc.cmx: theories/IntMap/mapc.cmi -theories/IntMap/mapfold.cmo: theories/IntMap/addr.cmi \ - theories/Init/datatypes.cmi theories/IntMap/fset.cmi \ - theories/IntMap/map.cmi theories/IntMap/mapiter.cmi \ - theories/Init/specif.cmi theories/IntMap/mapfold.cmi -theories/IntMap/mapfold.cmx: theories/IntMap/addr.cmx \ - theories/Init/datatypes.cmx theories/IntMap/fset.cmx \ - theories/IntMap/map.cmx theories/IntMap/mapiter.cmx \ - theories/Init/specif.cmx theories/IntMap/mapfold.cmi -theories/IntMap/mapiter.cmo: theories/IntMap/addec.cmi \ - theories/IntMap/addr.cmi theories/Init/datatypes.cmi \ - theories/Lists/list.cmi theories/IntMap/map.cmi theories/Init/specif.cmi \ - theories/Bool/sumbool.cmi theories/IntMap/mapiter.cmi -theories/IntMap/mapiter.cmx: theories/IntMap/addec.cmx \ - theories/IntMap/addr.cmx theories/Init/datatypes.cmx \ - theories/Lists/list.cmx theories/IntMap/map.cmx theories/Init/specif.cmx \ - theories/Bool/sumbool.cmx theories/IntMap/mapiter.cmi -theories/IntMap/maplists.cmo: theories/IntMap/addec.cmi \ - theories/IntMap/addr.cmi theories/Init/datatypes.cmi \ - theories/IntMap/fset.cmi theories/Lists/list.cmi theories/IntMap/map.cmi \ - theories/IntMap/mapiter.cmi theories/Init/specif.cmi \ - theories/Bool/sumbool.cmi theories/IntMap/maplists.cmi -theories/IntMap/maplists.cmx: theories/IntMap/addec.cmx \ - theories/IntMap/addr.cmx theories/Init/datatypes.cmx \ - theories/IntMap/fset.cmx theories/Lists/list.cmx theories/IntMap/map.cmx \ - theories/IntMap/mapiter.cmx theories/Init/specif.cmx \ - theories/Bool/sumbool.cmx theories/IntMap/maplists.cmi -theories/IntMap/map.cmo: theories/IntMap/addec.cmi theories/IntMap/addr.cmi \ - theories/NArith/binPos.cmi theories/Init/datatypes.cmi \ - theories/Init/peano.cmi theories/Init/specif.cmi theories/IntMap/map.cmi -theories/IntMap/map.cmx: theories/IntMap/addec.cmx theories/IntMap/addr.cmx \ - theories/NArith/binPos.cmx theories/Init/datatypes.cmx \ - theories/Init/peano.cmx theories/Init/specif.cmx theories/IntMap/map.cmi -theories/IntMap/mapsubset.cmo: theories/Bool/bool.cmi \ - theories/Init/datatypes.cmi theories/IntMap/fset.cmi \ - theories/IntMap/map.cmi theories/IntMap/mapiter.cmi \ +theories/IntMap/mapfold.cmo: theories/Init/specif.cmi \ + theories/IntMap/mapiter.cmi theories/IntMap/map.cmi \ + theories/IntMap/fset.cmi theories/Init/datatypes.cmi \ + theories/IntMap/mapfold.cmi +theories/IntMap/mapfold.cmx: theories/Init/specif.cmx \ + theories/IntMap/mapiter.cmx theories/IntMap/map.cmx \ + theories/IntMap/fset.cmx theories/Init/datatypes.cmx \ + theories/IntMap/mapfold.cmi +theories/IntMap/mapiter.cmo: theories/Bool/sumbool.cmi \ + theories/Init/specif.cmi theories/NArith/ndigits.cmi \ + theories/NArith/ndec.cmi theories/IntMap/map.cmi theories/Lists/list.cmi \ + theories/Init/datatypes.cmi theories/NArith/binNat.cmi \ + theories/IntMap/mapiter.cmi +theories/IntMap/mapiter.cmx: theories/Bool/sumbool.cmx \ + theories/Init/specif.cmx theories/NArith/ndigits.cmx \ + theories/NArith/ndec.cmx theories/IntMap/map.cmx theories/Lists/list.cmx \ + theories/Init/datatypes.cmx theories/NArith/binNat.cmx \ + theories/IntMap/mapiter.cmi +theories/IntMap/maplists.cmo: theories/Bool/sumbool.cmi \ + theories/Init/specif.cmi theories/NArith/ndec.cmi \ + theories/IntMap/mapiter.cmi theories/IntMap/map.cmi \ + theories/Lists/list.cmi theories/IntMap/fset.cmi \ + theories/Init/datatypes.cmi theories/IntMap/maplists.cmi +theories/IntMap/maplists.cmx: theories/Bool/sumbool.cmx \ + theories/Init/specif.cmx theories/NArith/ndec.cmx \ + theories/IntMap/mapiter.cmx theories/IntMap/map.cmx \ + theories/Lists/list.cmx theories/IntMap/fset.cmx \ + theories/Init/datatypes.cmx theories/IntMap/maplists.cmi +theories/IntMap/map.cmo: theories/Init/specif.cmi theories/Init/peano.cmi \ + theories/NArith/ndigits.cmi theories/NArith/ndec.cmi \ + theories/Init/datatypes.cmi theories/NArith/binPos.cmi \ + theories/NArith/binNat.cmi theories/IntMap/map.cmi +theories/IntMap/map.cmx: theories/Init/specif.cmx theories/Init/peano.cmx \ + theories/NArith/ndigits.cmx theories/NArith/ndec.cmx \ + theories/Init/datatypes.cmx theories/NArith/binPos.cmx \ + theories/NArith/binNat.cmx theories/IntMap/map.cmi +theories/IntMap/mapsubset.cmo: theories/IntMap/mapiter.cmi \ + theories/IntMap/map.cmi theories/IntMap/fset.cmi \ + theories/Init/datatypes.cmi theories/Bool/bool.cmi \ theories/IntMap/mapsubset.cmi -theories/IntMap/mapsubset.cmx: theories/Bool/bool.cmx \ - theories/Init/datatypes.cmx theories/IntMap/fset.cmx \ - theories/IntMap/map.cmx theories/IntMap/mapiter.cmx \ +theories/IntMap/mapsubset.cmx: theories/IntMap/mapiter.cmx \ + theories/IntMap/map.cmx theories/IntMap/fset.cmx \ + theories/Init/datatypes.cmx theories/Bool/bool.cmx \ theories/IntMap/mapsubset.cmi -theories/Lists/list.cmo: theories/Init/datatypes.cmi theories/Init/specif.cmi \ +theories/Lists/list.cmo: theories/Init/specif.cmi theories/Init/datatypes.cmi \ theories/Lists/list.cmi -theories/Lists/list.cmx: theories/Init/datatypes.cmx theories/Init/specif.cmx \ +theories/Lists/list.cmx: theories/Init/specif.cmx theories/Init/datatypes.cmx \ theories/Lists/list.cmi -theories/Lists/listSet.cmo: theories/Init/datatypes.cmi \ - theories/Lists/list.cmi theories/Init/specif.cmi \ - theories/Lists/listSet.cmi -theories/Lists/listSet.cmx: theories/Init/datatypes.cmx \ - theories/Lists/list.cmx theories/Init/specif.cmx \ - theories/Lists/listSet.cmi +theories/Lists/listSet.cmo: theories/Init/specif.cmi theories/Lists/list.cmi \ + theories/Init/datatypes.cmi theories/Lists/listSet.cmi +theories/Lists/listSet.cmx: theories/Init/specif.cmx theories/Lists/list.cmx \ + theories/Init/datatypes.cmx theories/Lists/listSet.cmi theories/Lists/monoList.cmo: theories/Init/datatypes.cmi \ theories/Lists/monoList.cmi theories/Lists/monoList.cmx: theories/Init/datatypes.cmx \ theories/Lists/monoList.cmi +theories/Lists/setoidList.cmo: theories/Init/specif.cmi \ + theories/Lists/list.cmi theories/Init/datatypes.cmi \ + theories/Lists/setoidList.cmi +theories/Lists/setoidList.cmx: theories/Init/specif.cmx \ + theories/Lists/list.cmx theories/Init/datatypes.cmx \ + theories/Lists/setoidList.cmi theories/Lists/streams.cmo: theories/Init/datatypes.cmi \ theories/Lists/streams.cmi theories/Lists/streams.cmx: theories/Init/datatypes.cmx \ theories/Lists/streams.cmi -theories/Lists/theoryList.cmo: theories/Init/datatypes.cmi \ - theories/Lists/list.cmi theories/Init/specif.cmi \ +theories/Lists/theoryList.cmo: theories/Init/specif.cmi \ + theories/Lists/list.cmi theories/Init/datatypes.cmi \ theories/Lists/theoryList.cmi -theories/Lists/theoryList.cmx: theories/Init/datatypes.cmx \ - theories/Lists/list.cmx theories/Init/specif.cmx \ +theories/Lists/theoryList.cmx: theories/Init/specif.cmx \ + theories/Lists/list.cmx theories/Init/datatypes.cmx \ theories/Lists/theoryList.cmi theories/Logic/berardi.cmo: theories/Logic/berardi.cmi theories/Logic/berardi.cmx: theories/Logic/berardi.cmi -theories/Logic/choiceFacts.cmo: theories/Logic/choiceFacts.cmi -theories/Logic/choiceFacts.cmx: theories/Logic/choiceFacts.cmi +theories/Logic/choiceFacts.cmo: theories/Init/specif.cmi \ + theories/Init/datatypes.cmi theories/Logic/choiceFacts.cmi +theories/Logic/choiceFacts.cmx: theories/Init/specif.cmx \ + theories/Init/datatypes.cmx theories/Logic/choiceFacts.cmi theories/Logic/classicalChoice.cmo: theories/Logic/classicalChoice.cmi theories/Logic/classicalChoice.cmx: theories/Logic/classicalChoice.cmi -theories/Logic/classicalDescription.cmo: \ - theories/Logic/classicalDescription.cmi -theories/Logic/classicalDescription.cmx: \ - theories/Logic/classicalDescription.cmi +theories/Logic/classicalDescription.cmo: theories/Init/specif.cmi \ + theories/Logic/choiceFacts.cmi theories/Logic/classicalDescription.cmi +theories/Logic/classicalDescription.cmx: theories/Init/specif.cmx \ + theories/Logic/choiceFacts.cmx theories/Logic/classicalDescription.cmi +theories/Logic/classicalEpsilon.cmo: theories/Init/specif.cmi \ + theories/Logic/choiceFacts.cmi theories/Logic/classicalEpsilon.cmi +theories/Logic/classicalEpsilon.cmx: theories/Init/specif.cmx \ + theories/Logic/choiceFacts.cmx theories/Logic/classicalEpsilon.cmi theories/Logic/classicalFacts.cmo: theories/Logic/classicalFacts.cmi theories/Logic/classicalFacts.cmx: theories/Logic/classicalFacts.cmi theories/Logic/classical.cmo: theories/Logic/classical.cmi @@ -272,38 +474,118 @@ theories/Logic/classical_Pred_Type.cmo: \ theories/Logic/classical_Pred_Type.cmi theories/Logic/classical_Pred_Type.cmx: \ theories/Logic/classical_Pred_Type.cmi -theories/Logic/classical_Prop.cmo: theories/Logic/classical_Prop.cmi -theories/Logic/classical_Prop.cmx: theories/Logic/classical_Prop.cmi +theories/Logic/classical_Prop.cmo: theories/Logic/eqdepFacts.cmi \ + theories/Logic/classical_Prop.cmi +theories/Logic/classical_Prop.cmx: theories/Logic/eqdepFacts.cmx \ + theories/Logic/classical_Prop.cmi theories/Logic/classical_Type.cmo: theories/Logic/classical_Type.cmi theories/Logic/classical_Type.cmx: theories/Logic/classical_Type.cmi +theories/Logic/classicalUniqueChoice.cmo: \ + theories/Logic/classicalUniqueChoice.cmi +theories/Logic/classicalUniqueChoice.cmx: \ + theories/Logic/classicalUniqueChoice.cmi theories/Logic/decidable.cmo: theories/Logic/decidable.cmi theories/Logic/decidable.cmx: theories/Logic/decidable.cmi -theories/Logic/diaconescu.cmo: theories/Logic/diaconescu.cmi -theories/Logic/diaconescu.cmx: theories/Logic/diaconescu.cmi -theories/Logic/eqdep_dec.cmo: theories/Logic/eqdep_dec.cmi -theories/Logic/eqdep_dec.cmx: theories/Logic/eqdep_dec.cmi -theories/Logic/eqdep.cmo: theories/Logic/eqdep.cmi -theories/Logic/eqdep.cmx: theories/Logic/eqdep.cmi +theories/Logic/diaconescu.cmo: theories/Init/specif.cmi \ + theories/Logic/diaconescu.cmi +theories/Logic/diaconescu.cmx: theories/Init/specif.cmx \ + theories/Logic/diaconescu.cmi +theories/Logic/eqdep_dec.cmo: theories/Init/specif.cmi \ + theories/Logic/eqdep_dec.cmi +theories/Logic/eqdep_dec.cmx: theories/Init/specif.cmx \ + theories/Logic/eqdep_dec.cmi +theories/Logic/eqdepFacts.cmo: theories/Logic/eqdepFacts.cmi +theories/Logic/eqdepFacts.cmx: theories/Logic/eqdepFacts.cmi +theories/Logic/eqdep.cmo: theories/Logic/eqdepFacts.cmi \ + theories/Logic/eqdep.cmi +theories/Logic/eqdep.cmx: theories/Logic/eqdepFacts.cmx \ + theories/Logic/eqdep.cmi theories/Logic/hurkens.cmo: theories/Logic/hurkens.cmi theories/Logic/hurkens.cmx: theories/Logic/hurkens.cmi theories/Logic/jMeq.cmo: theories/Logic/jMeq.cmi theories/Logic/jMeq.cmx: theories/Logic/jMeq.cmi -theories/Logic/proofIrrelevance.cmo: theories/Logic/proofIrrelevance.cmi -theories/Logic/proofIrrelevance.cmx: theories/Logic/proofIrrelevance.cmi +theories/Logic/proofIrrelevanceFacts.cmo: theories/Logic/eqdepFacts.cmi \ + theories/Logic/proofIrrelevanceFacts.cmi +theories/Logic/proofIrrelevanceFacts.cmx: theories/Logic/eqdepFacts.cmx \ + theories/Logic/proofIrrelevanceFacts.cmi +theories/Logic/proofIrrelevance.cmo: theories/Logic/proofIrrelevanceFacts.cmi \ + theories/Logic/proofIrrelevance.cmi +theories/Logic/proofIrrelevance.cmx: theories/Logic/proofIrrelevanceFacts.cmx \ + theories/Logic/proofIrrelevance.cmi theories/Logic/relationalChoice.cmo: theories/Logic/relationalChoice.cmi theories/Logic/relationalChoice.cmx: theories/Logic/relationalChoice.cmi -theories/NArith/binNat.cmo: theories/NArith/binPos.cmi \ - theories/Init/datatypes.cmi theories/NArith/binNat.cmi -theories/NArith/binNat.cmx: theories/NArith/binPos.cmx \ - theories/Init/datatypes.cmx theories/NArith/binNat.cmi -theories/NArith/binPos.cmo: theories/Init/datatypes.cmi \ - theories/Init/peano.cmi theories/NArith/binPos.cmi -theories/NArith/binPos.cmx: theories/Init/datatypes.cmx \ - theories/Init/peano.cmx theories/NArith/binPos.cmi +theories/NArith/binNat.cmo: theories/Init/specif.cmi \ + theories/Init/datatypes.cmi theories/NArith/binPos.cmi \ + theories/NArith/binNat.cmi +theories/NArith/binNat.cmx: theories/Init/specif.cmx \ + theories/Init/datatypes.cmx theories/NArith/binPos.cmx \ + theories/NArith/binNat.cmi +theories/NArith/binPos.cmo: theories/Init/peano.cmi \ + theories/Init/datatypes.cmi theories/NArith/binPos.cmi +theories/NArith/binPos.cmx: theories/Init/peano.cmx \ + theories/Init/datatypes.cmx theories/NArith/binPos.cmi theories/NArith/nArith.cmo: theories/NArith/nArith.cmi theories/NArith/nArith.cmx: theories/NArith/nArith.cmi +theories/NArith/ndec.cmo: theories/Bool/sumbool.cmi theories/Init/specif.cmi \ + theories/NArith/nnat.cmi theories/NArith/ndigits.cmi \ + theories/Init/datatypes.cmi theories/Arith/compare_dec.cmi \ + theories/NArith/binPos.cmi theories/NArith/binNat.cmi \ + theories/NArith/ndec.cmi +theories/NArith/ndec.cmx: theories/Bool/sumbool.cmx theories/Init/specif.cmx \ + theories/NArith/nnat.cmx theories/NArith/ndigits.cmx \ + theories/Init/datatypes.cmx theories/Arith/compare_dec.cmx \ + theories/NArith/binPos.cmx theories/NArith/binNat.cmx \ + theories/NArith/ndec.cmi +theories/NArith/ndigits.cmo: theories/Init/specif.cmi \ + theories/Init/datatypes.cmi theories/Bool/bvector.cmi \ + theories/Bool/bool.cmi theories/NArith/binPos.cmi \ + theories/NArith/binNat.cmi theories/NArith/ndigits.cmi +theories/NArith/ndigits.cmx: theories/Init/specif.cmx \ + theories/Init/datatypes.cmx theories/Bool/bvector.cmx \ + theories/Bool/bool.cmx theories/NArith/binPos.cmx \ + theories/NArith/binNat.cmx theories/NArith/ndigits.cmi +theories/NArith/ndist.cmo: theories/NArith/ndigits.cmi theories/Arith/min.cmi \ + theories/Init/datatypes.cmi theories/NArith/binPos.cmi \ + theories/NArith/binNat.cmi theories/NArith/ndist.cmi +theories/NArith/ndist.cmx: theories/NArith/ndigits.cmx theories/Arith/min.cmx \ + theories/Init/datatypes.cmx theories/NArith/binPos.cmx \ + theories/NArith/binNat.cmx theories/NArith/ndist.cmi +theories/NArith/nnat.cmo: theories/Init/datatypes.cmi \ + theories/NArith/binPos.cmi theories/NArith/binNat.cmi \ + theories/NArith/nnat.cmi +theories/NArith/nnat.cmx: theories/Init/datatypes.cmx \ + theories/NArith/binPos.cmx theories/NArith/binNat.cmx \ + theories/NArith/nnat.cmi theories/NArith/pnat.cmo: theories/NArith/pnat.cmi theories/NArith/pnat.cmx: theories/NArith/pnat.cmi +theories/QArith/qArith_base.cmo: theories/ZArith/zArith_dec.cmi \ + theories/Init/specif.cmi theories/Setoids/setoid.cmi \ + theories/Init/datatypes.cmi theories/NArith/binPos.cmi \ + theories/ZArith/binInt.cmi theories/QArith/qArith_base.cmi +theories/QArith/qArith_base.cmx: theories/ZArith/zArith_dec.cmx \ + theories/Init/specif.cmx theories/Setoids/setoid.cmx \ + theories/Init/datatypes.cmx theories/NArith/binPos.cmx \ + theories/ZArith/binInt.cmx theories/QArith/qArith_base.cmi +theories/QArith/qArith.cmo: theories/QArith/qArith.cmi +theories/QArith/qArith.cmx: theories/QArith/qArith.cmi +theories/QArith/qreals.cmo: theories/QArith/qArith_base.cmi \ + theories/ZArith/binInt.cmi theories/QArith/qreals.cmi +theories/QArith/qreals.cmx: theories/QArith/qArith_base.cmx \ + theories/ZArith/binInt.cmx theories/QArith/qreals.cmi +theories/QArith/qreduction.cmo: theories/ZArith/znumtheory.cmi \ + theories/Setoids/setoid.cmi theories/QArith/qArith_base.cmi \ + theories/Init/datatypes.cmi theories/NArith/binPos.cmi \ + theories/ZArith/binInt.cmi theories/QArith/qreduction.cmi +theories/QArith/qreduction.cmx: theories/ZArith/znumtheory.cmx \ + theories/Setoids/setoid.cmx theories/QArith/qArith_base.cmx \ + theories/Init/datatypes.cmx theories/NArith/binPos.cmx \ + theories/ZArith/binInt.cmx theories/QArith/qreduction.cmi +theories/QArith/qring.cmo: theories/Init/specif.cmi \ + theories/QArith/qArith_base.cmi theories/Init/datatypes.cmi \ + theories/QArith/qring.cmi +theories/QArith/qring.cmx: theories/Init/specif.cmx \ + theories/QArith/qArith_base.cmx theories/Init/datatypes.cmx \ + theories/QArith/qring.cmi theories/Relations/newman.cmo: theories/Relations/newman.cmi theories/Relations/newman.cmx: theories/Relations/newman.cmi theories/Relations/operators_Properties.cmo: \ @@ -314,16 +596,18 @@ theories/Relations/relation_Definitions.cmo: \ theories/Relations/relation_Definitions.cmi theories/Relations/relation_Definitions.cmx: \ theories/Relations/relation_Definitions.cmi -theories/Relations/relation_Operators.cmo: theories/Lists/list.cmi \ - theories/Init/specif.cmi theories/Relations/relation_Operators.cmi -theories/Relations/relation_Operators.cmx: theories/Lists/list.cmx \ - theories/Init/specif.cmx theories/Relations/relation_Operators.cmi +theories/Relations/relation_Operators.cmo: theories/Init/specif.cmi \ + theories/Lists/list.cmi theories/Relations/relation_Operators.cmi +theories/Relations/relation_Operators.cmx: theories/Init/specif.cmx \ + theories/Lists/list.cmx theories/Relations/relation_Operators.cmi theories/Relations/relations.cmo: theories/Relations/relations.cmi theories/Relations/relations.cmx: theories/Relations/relations.cmi theories/Relations/rstar.cmo: theories/Relations/rstar.cmi theories/Relations/rstar.cmx: theories/Relations/rstar.cmi -theories/Setoids/setoid.cmo: theories/Setoids/setoid.cmi -theories/Setoids/setoid.cmx: theories/Setoids/setoid.cmi +theories/Setoids/setoid.cmo: theories/Init/datatypes.cmi \ + theories/Setoids/setoid.cmi +theories/Setoids/setoid.cmx: theories/Init/datatypes.cmx \ + theories/Setoids/setoid.cmi theories/Sets/classical_sets.cmo: theories/Sets/classical_sets.cmi theories/Sets/classical_sets.cmx: theories/Sets/classical_sets.cmi theories/Sets/constructive_sets.cmo: theories/Sets/constructive_sets.cmi @@ -340,20 +624,18 @@ theories/Sets/image.cmo: theories/Sets/image.cmi theories/Sets/image.cmx: theories/Sets/image.cmi theories/Sets/infinite_sets.cmo: theories/Sets/infinite_sets.cmi theories/Sets/infinite_sets.cmx: theories/Sets/infinite_sets.cmi -theories/Sets/integers.cmo: theories/Init/datatypes.cmi \ - theories/Sets/partial_Order.cmi theories/Sets/integers.cmi -theories/Sets/integers.cmx: theories/Init/datatypes.cmx \ - theories/Sets/partial_Order.cmx theories/Sets/integers.cmi -theories/Sets/multiset.cmo: theories/Init/datatypes.cmi \ - theories/Init/peano.cmi theories/Init/specif.cmi \ - theories/Sets/multiset.cmi -theories/Sets/multiset.cmx: theories/Init/datatypes.cmx \ - theories/Init/peano.cmx theories/Init/specif.cmx \ - theories/Sets/multiset.cmi -theories/Sets/partial_Order.cmo: theories/Sets/ensembles.cmi \ - theories/Sets/relations_1.cmi theories/Sets/partial_Order.cmi -theories/Sets/partial_Order.cmx: theories/Sets/ensembles.cmx \ - theories/Sets/relations_1.cmx theories/Sets/partial_Order.cmi +theories/Sets/integers.cmo: theories/Sets/partial_Order.cmi \ + theories/Init/datatypes.cmi theories/Sets/integers.cmi +theories/Sets/integers.cmx: theories/Sets/partial_Order.cmx \ + theories/Init/datatypes.cmx theories/Sets/integers.cmi +theories/Sets/multiset.cmo: theories/Init/specif.cmi theories/Init/peano.cmi \ + theories/Init/datatypes.cmi theories/Sets/multiset.cmi +theories/Sets/multiset.cmx: theories/Init/specif.cmx theories/Init/peano.cmx \ + theories/Init/datatypes.cmx theories/Sets/multiset.cmi +theories/Sets/partial_Order.cmo: theories/Sets/relations_1.cmi \ + theories/Sets/ensembles.cmi theories/Sets/partial_Order.cmi +theories/Sets/partial_Order.cmx: theories/Sets/relations_1.cmx \ + theories/Sets/ensembles.cmx theories/Sets/partial_Order.cmi theories/Sets/permut.cmo: theories/Sets/permut.cmi theories/Sets/permut.cmx: theories/Sets/permut.cmi theories/Sets/powerset_Classical_facts.cmo: \ @@ -362,10 +644,10 @@ theories/Sets/powerset_Classical_facts.cmx: \ theories/Sets/powerset_Classical_facts.cmi theories/Sets/powerset_facts.cmo: theories/Sets/powerset_facts.cmi theories/Sets/powerset_facts.cmx: theories/Sets/powerset_facts.cmi -theories/Sets/powerset.cmo: theories/Sets/ensembles.cmi \ - theories/Sets/partial_Order.cmi theories/Sets/powerset.cmi -theories/Sets/powerset.cmx: theories/Sets/ensembles.cmx \ - theories/Sets/partial_Order.cmx theories/Sets/powerset.cmi +theories/Sets/powerset.cmo: theories/Sets/partial_Order.cmi \ + theories/Sets/ensembles.cmi theories/Sets/powerset.cmi +theories/Sets/powerset.cmx: theories/Sets/partial_Order.cmx \ + theories/Sets/ensembles.cmx theories/Sets/powerset.cmi theories/Sets/relations_1_facts.cmo: theories/Sets/relations_1_facts.cmi theories/Sets/relations_1_facts.cmx: theories/Sets/relations_1_facts.cmi theories/Sets/relations_1.cmo: theories/Sets/relations_1.cmi @@ -378,30 +660,46 @@ theories/Sets/relations_3_facts.cmo: theories/Sets/relations_3_facts.cmi theories/Sets/relations_3_facts.cmx: theories/Sets/relations_3_facts.cmi theories/Sets/relations_3.cmo: theories/Sets/relations_3.cmi theories/Sets/relations_3.cmx: theories/Sets/relations_3.cmi -theories/Sets/uniset.cmo: theories/Init/datatypes.cmi \ - theories/Init/specif.cmi theories/Sets/uniset.cmi -theories/Sets/uniset.cmx: theories/Init/datatypes.cmx \ - theories/Init/specif.cmx theories/Sets/uniset.cmi -theories/Sorting/heap.cmo: theories/Init/datatypes.cmi \ - theories/Lists/list.cmi theories/Sets/multiset.cmi \ - theories/Init/peano.cmi theories/Sorting/sorting.cmi \ - theories/Init/specif.cmi theories/Sorting/heap.cmi -theories/Sorting/heap.cmx: theories/Init/datatypes.cmx \ - theories/Lists/list.cmx theories/Sets/multiset.cmx \ - theories/Init/peano.cmx theories/Sorting/sorting.cmx \ - theories/Init/specif.cmx theories/Sorting/heap.cmi -theories/Sorting/permutation.cmo: theories/Init/datatypes.cmi \ - theories/Lists/list.cmi theories/Sets/multiset.cmi \ - theories/Init/peano.cmi theories/Init/specif.cmi \ +theories/Sets/uniset.cmo: theories/Init/specif.cmi \ + theories/Init/datatypes.cmi theories/Sets/uniset.cmi +theories/Sets/uniset.cmx: theories/Init/specif.cmx \ + theories/Init/datatypes.cmx theories/Sets/uniset.cmi +theories/Sorting/heap.cmo: theories/Init/specif.cmi \ + theories/Sorting/sorting.cmi theories/Init/peano.cmi \ + theories/Sets/multiset.cmi theories/Lists/list.cmi \ + theories/Init/datatypes.cmi theories/Sorting/heap.cmi +theories/Sorting/heap.cmx: theories/Init/specif.cmx \ + theories/Sorting/sorting.cmx theories/Init/peano.cmx \ + theories/Sets/multiset.cmx theories/Lists/list.cmx \ + theories/Init/datatypes.cmx theories/Sorting/heap.cmi +theories/Sorting/permutation.cmo: theories/Init/specif.cmi \ + theories/Init/peano.cmi theories/Sets/multiset.cmi \ + theories/Lists/list.cmi theories/Init/datatypes.cmi \ theories/Sorting/permutation.cmi -theories/Sorting/permutation.cmx: theories/Init/datatypes.cmx \ - theories/Lists/list.cmx theories/Sets/multiset.cmx \ - theories/Init/peano.cmx theories/Init/specif.cmx \ +theories/Sorting/permutation.cmx: theories/Init/specif.cmx \ + theories/Init/peano.cmx theories/Sets/multiset.cmx \ + theories/Lists/list.cmx theories/Init/datatypes.cmx \ theories/Sorting/permutation.cmi -theories/Sorting/sorting.cmo: theories/Lists/list.cmi \ - theories/Init/specif.cmi theories/Sorting/sorting.cmi -theories/Sorting/sorting.cmx: theories/Lists/list.cmx \ - theories/Init/specif.cmx theories/Sorting/sorting.cmi +theories/Sorting/permutEq.cmo: theories/Sorting/permutEq.cmi +theories/Sorting/permutEq.cmx: theories/Sorting/permutEq.cmi +theories/Sorting/permutSetoid.cmo: theories/Sorting/permutSetoid.cmi +theories/Sorting/permutSetoid.cmx: theories/Sorting/permutSetoid.cmi +theories/Sorting/sorting.cmo: theories/Init/specif.cmi \ + theories/Lists/list.cmi theories/Sorting/sorting.cmi +theories/Sorting/sorting.cmx: theories/Init/specif.cmx \ + theories/Lists/list.cmx theories/Sorting/sorting.cmi +theories/Strings/ascii.cmo: theories/Init/specif.cmi theories/Init/peano.cmi \ + theories/Init/datatypes.cmi theories/Bool/bool.cmi \ + theories/NArith/binPos.cmi theories/Strings/ascii.cmi +theories/Strings/ascii.cmx: theories/Init/specif.cmx theories/Init/peano.cmx \ + theories/Init/datatypes.cmx theories/Bool/bool.cmx \ + theories/NArith/binPos.cmx theories/Strings/ascii.cmi +theories/Strings/string.cmo: theories/Init/specif.cmi \ + theories/Init/datatypes.cmi theories/Strings/ascii.cmi \ + theories/Strings/string.cmi +theories/Strings/string.cmx: theories/Init/specif.cmx \ + theories/Init/datatypes.cmx theories/Strings/ascii.cmx \ + theories/Strings/string.cmi theories/Wellfounded/disjoint_Union.cmo: \ theories/Wellfounded/disjoint_Union.cmi theories/Wellfounded/disjoint_Union.cmx: \ @@ -434,280 +732,405 @@ theories/Wellfounded/well_Ordering.cmx: theories/Init/specif.cmx \ theories/Wellfounded/well_Ordering.cmi theories/ZArith/auxiliary.cmo: theories/ZArith/auxiliary.cmi theories/ZArith/auxiliary.cmx: theories/ZArith/auxiliary.cmi -theories/ZArith/binInt.cmo: theories/NArith/binNat.cmi \ - theories/NArith/binPos.cmi theories/Init/datatypes.cmi \ +theories/ZArith/binInt.cmo: theories/Init/datatypes.cmi \ + theories/NArith/binPos.cmi theories/NArith/binNat.cmi \ theories/ZArith/binInt.cmi -theories/ZArith/binInt.cmx: theories/NArith/binNat.cmx \ - theories/NArith/binPos.cmx theories/Init/datatypes.cmx \ +theories/ZArith/binInt.cmx: theories/Init/datatypes.cmx \ + theories/NArith/binPos.cmx theories/NArith/binNat.cmx \ theories/ZArith/binInt.cmi -theories/ZArith/wf_Z.cmo: theories/ZArith/binInt.cmi \ - theories/NArith/binPos.cmi theories/Init/datatypes.cmi \ - theories/Init/peano.cmi theories/Init/specif.cmi theories/ZArith/wf_Z.cmi -theories/ZArith/wf_Z.cmx: theories/ZArith/binInt.cmx \ - theories/NArith/binPos.cmx theories/Init/datatypes.cmx \ - theories/Init/peano.cmx theories/Init/specif.cmx theories/ZArith/wf_Z.cmi -theories/ZArith/zabs.cmo: theories/ZArith/binInt.cmi theories/Init/specif.cmi \ - theories/Bool/sumbool.cmi theories/ZArith/zabs.cmi -theories/ZArith/zabs.cmx: theories/ZArith/binInt.cmx theories/Init/specif.cmx \ - theories/Bool/sumbool.cmx theories/ZArith/zabs.cmi +theories/ZArith/wf_Z.cmo: theories/Init/specif.cmi theories/Init/peano.cmi \ + theories/Init/datatypes.cmi theories/NArith/binPos.cmi \ + theories/ZArith/binInt.cmi theories/ZArith/wf_Z.cmi +theories/ZArith/wf_Z.cmx: theories/Init/specif.cmx theories/Init/peano.cmx \ + theories/Init/datatypes.cmx theories/NArith/binPos.cmx \ + theories/ZArith/binInt.cmx theories/ZArith/wf_Z.cmi +theories/ZArith/zabs.cmo: theories/Init/specif.cmi theories/ZArith/binInt.cmi \ + theories/ZArith/zabs.cmi +theories/ZArith/zabs.cmx: theories/Init/specif.cmx theories/ZArith/binInt.cmx \ + theories/ZArith/zabs.cmi theories/ZArith/zArith_base.cmo: theories/ZArith/zArith_base.cmi theories/ZArith/zArith_base.cmx: theories/ZArith/zArith_base.cmi -theories/ZArith/zArith_dec.cmo: theories/ZArith/binInt.cmi \ - theories/Init/datatypes.cmi theories/Init/specif.cmi \ - theories/Bool/sumbool.cmi theories/ZArith/zArith_dec.cmi -theories/ZArith/zArith_dec.cmx: theories/ZArith/binInt.cmx \ - theories/Init/datatypes.cmx theories/Init/specif.cmx \ - theories/Bool/sumbool.cmx theories/ZArith/zArith_dec.cmi +theories/ZArith/zArith_dec.cmo: theories/Bool/sumbool.cmi \ + theories/Init/specif.cmi theories/Init/datatypes.cmi \ + theories/ZArith/binInt.cmi theories/ZArith/zArith_dec.cmi +theories/ZArith/zArith_dec.cmx: theories/Bool/sumbool.cmx \ + theories/Init/specif.cmx theories/Init/datatypes.cmx \ + theories/ZArith/binInt.cmx theories/ZArith/zArith_dec.cmi theories/ZArith/zArith.cmo: theories/ZArith/zArith.cmi theories/ZArith/zArith.cmx: theories/ZArith/zArith.cmi -theories/ZArith/zbinary.cmo: theories/ZArith/binInt.cmi \ - theories/NArith/binPos.cmi theories/Bool/bvector.cmi \ - theories/Init/datatypes.cmi theories/ZArith/zeven.cmi \ +theories/ZArith/zbinary.cmo: theories/ZArith/zeven.cmi \ + theories/Init/datatypes.cmi theories/Bool/bvector.cmi \ + theories/NArith/binPos.cmi theories/ZArith/binInt.cmi \ theories/ZArith/zbinary.cmi -theories/ZArith/zbinary.cmx: theories/ZArith/binInt.cmx \ - theories/NArith/binPos.cmx theories/Bool/bvector.cmx \ - theories/Init/datatypes.cmx theories/ZArith/zeven.cmx \ +theories/ZArith/zbinary.cmx: theories/ZArith/zeven.cmx \ + theories/Init/datatypes.cmx theories/Bool/bvector.cmx \ + theories/NArith/binPos.cmx theories/ZArith/binInt.cmx \ theories/ZArith/zbinary.cmi -theories/ZArith/zbool.cmo: theories/ZArith/binInt.cmi \ - theories/Init/datatypes.cmi theories/Init/specif.cmi \ - theories/Bool/sumbool.cmi theories/ZArith/zArith_dec.cmi \ - theories/ZArith/zeven.cmi theories/ZArith/zbool.cmi -theories/ZArith/zbool.cmx: theories/ZArith/binInt.cmx \ - theories/Init/datatypes.cmx theories/Init/specif.cmx \ - theories/Bool/sumbool.cmx theories/ZArith/zArith_dec.cmx \ - theories/ZArith/zeven.cmx theories/ZArith/zbool.cmi +theories/ZArith/zbool.cmo: theories/ZArith/zeven.cmi \ + theories/ZArith/zArith_dec.cmi theories/Bool/sumbool.cmi \ + theories/Init/specif.cmi theories/Init/datatypes.cmi \ + theories/ZArith/binInt.cmi theories/ZArith/zbool.cmi +theories/ZArith/zbool.cmx: theories/ZArith/zeven.cmx \ + theories/ZArith/zArith_dec.cmx theories/Bool/sumbool.cmx \ + theories/Init/specif.cmx theories/Init/datatypes.cmx \ + theories/ZArith/binInt.cmx theories/ZArith/zbool.cmi theories/ZArith/zcompare.cmo: theories/ZArith/zcompare.cmi theories/ZArith/zcompare.cmx: theories/ZArith/zcompare.cmi -theories/ZArith/zcomplements.cmo: theories/ZArith/binInt.cmi \ - theories/NArith/binPos.cmi theories/Init/datatypes.cmi \ - theories/Lists/list.cmi theories/Init/specif.cmi theories/ZArith/wf_Z.cmi \ - theories/ZArith/zabs.cmi theories/ZArith/zcomplements.cmi -theories/ZArith/zcomplements.cmx: theories/ZArith/binInt.cmx \ - theories/NArith/binPos.cmx theories/Init/datatypes.cmx \ - theories/Lists/list.cmx theories/Init/specif.cmx theories/ZArith/wf_Z.cmx \ - theories/ZArith/zabs.cmx theories/ZArith/zcomplements.cmi -theories/ZArith/zdiv.cmo: theories/ZArith/binInt.cmi \ - theories/NArith/binPos.cmi theories/Init/datatypes.cmi \ - theories/Init/specif.cmi theories/ZArith/zArith_dec.cmi \ - theories/ZArith/zbool.cmi theories/ZArith/zdiv.cmi -theories/ZArith/zdiv.cmx: theories/ZArith/binInt.cmx \ - theories/NArith/binPos.cmx theories/Init/datatypes.cmx \ - theories/Init/specif.cmx theories/ZArith/zArith_dec.cmx \ - theories/ZArith/zbool.cmx theories/ZArith/zdiv.cmi -theories/ZArith/zeven.cmo: theories/ZArith/binInt.cmi \ - theories/NArith/binPos.cmi theories/Init/datatypes.cmi \ - theories/Init/specif.cmi theories/ZArith/zeven.cmi -theories/ZArith/zeven.cmx: theories/ZArith/binInt.cmx \ - theories/NArith/binPos.cmx theories/Init/datatypes.cmx \ - theories/Init/specif.cmx theories/ZArith/zeven.cmi +theories/ZArith/zcomplements.cmo: theories/ZArith/zabs.cmi \ + theories/ZArith/wf_Z.cmi theories/Init/specif.cmi theories/Lists/list.cmi \ + theories/Init/datatypes.cmi theories/NArith/binPos.cmi \ + theories/ZArith/binInt.cmi theories/ZArith/zcomplements.cmi +theories/ZArith/zcomplements.cmx: theories/ZArith/zabs.cmx \ + theories/ZArith/wf_Z.cmx theories/Init/specif.cmx theories/Lists/list.cmx \ + theories/Init/datatypes.cmx theories/NArith/binPos.cmx \ + theories/ZArith/binInt.cmx theories/ZArith/zcomplements.cmi +theories/ZArith/zdiv.cmo: theories/ZArith/zbool.cmi \ + theories/ZArith/zArith_dec.cmi theories/Init/specif.cmi \ + theories/Init/datatypes.cmi theories/NArith/binPos.cmi \ + theories/ZArith/binInt.cmi theories/ZArith/zdiv.cmi +theories/ZArith/zdiv.cmx: theories/ZArith/zbool.cmx \ + theories/ZArith/zArith_dec.cmx theories/Init/specif.cmx \ + theories/Init/datatypes.cmx theories/NArith/binPos.cmx \ + theories/ZArith/binInt.cmx theories/ZArith/zdiv.cmi +theories/ZArith/zeven.cmo: theories/Init/specif.cmi \ + theories/Init/datatypes.cmi theories/NArith/binPos.cmi \ + theories/ZArith/binInt.cmi theories/ZArith/zeven.cmi +theories/ZArith/zeven.cmx: theories/Init/specif.cmx \ + theories/Init/datatypes.cmx theories/NArith/binPos.cmx \ + theories/ZArith/binInt.cmx theories/ZArith/zeven.cmi theories/ZArith/zhints.cmo: theories/ZArith/zhints.cmi theories/ZArith/zhints.cmx: theories/ZArith/zhints.cmi -theories/ZArith/zlogarithm.cmo: theories/ZArith/binInt.cmi \ - theories/NArith/binPos.cmi theories/ZArith/zlogarithm.cmi -theories/ZArith/zlogarithm.cmx: theories/ZArith/binInt.cmx \ - theories/NArith/binPos.cmx theories/ZArith/zlogarithm.cmi -theories/ZArith/zmin.cmo: theories/ZArith/binInt.cmi \ - theories/Init/datatypes.cmi theories/ZArith/zmin.cmi -theories/ZArith/zmin.cmx: theories/ZArith/binInt.cmx \ - theories/Init/datatypes.cmx theories/ZArith/zmin.cmi -theories/ZArith/zmisc.cmo: theories/ZArith/binInt.cmi \ - theories/NArith/binPos.cmi theories/Init/datatypes.cmi \ +theories/ZArith/zlogarithm.cmo: theories/NArith/binPos.cmi \ + theories/ZArith/binInt.cmi theories/ZArith/zlogarithm.cmi +theories/ZArith/zlogarithm.cmx: theories/NArith/binPos.cmx \ + theories/ZArith/binInt.cmx theories/ZArith/zlogarithm.cmi +theories/ZArith/zmax.cmo: theories/Init/datatypes.cmi \ + theories/ZArith/binInt.cmi theories/ZArith/zmax.cmi +theories/ZArith/zmax.cmx: theories/Init/datatypes.cmx \ + theories/ZArith/binInt.cmx theories/ZArith/zmax.cmi +theories/ZArith/zminmax.cmo: theories/ZArith/zminmax.cmi +theories/ZArith/zminmax.cmx: theories/ZArith/zminmax.cmi +theories/ZArith/zmin.cmo: theories/Init/specif.cmi \ + theories/Init/datatypes.cmi theories/ZArith/binInt.cmi \ + theories/ZArith/zmin.cmi +theories/ZArith/zmin.cmx: theories/Init/specif.cmx \ + theories/Init/datatypes.cmx theories/ZArith/binInt.cmx \ + theories/ZArith/zmin.cmi +theories/ZArith/zmisc.cmo: theories/Init/datatypes.cmi \ + theories/NArith/binPos.cmi theories/ZArith/binInt.cmi \ theories/ZArith/zmisc.cmi -theories/ZArith/zmisc.cmx: theories/ZArith/binInt.cmx \ - theories/NArith/binPos.cmx theories/Init/datatypes.cmx \ +theories/ZArith/zmisc.cmx: theories/Init/datatypes.cmx \ + theories/NArith/binPos.cmx theories/ZArith/binInt.cmx \ theories/ZArith/zmisc.cmi theories/ZArith/znat.cmo: theories/ZArith/znat.cmi theories/ZArith/znat.cmx: theories/ZArith/znat.cmi -theories/ZArith/znumtheory.cmo: theories/ZArith/binInt.cmi \ - theories/NArith/binPos.cmi theories/Init/datatypes.cmi \ - theories/Init/specif.cmi theories/ZArith/wf_Z.cmi \ - theories/ZArith/zArith_dec.cmi theories/ZArith/zdiv.cmi \ - theories/ZArith/zorder.cmi theories/ZArith/znumtheory.cmi -theories/ZArith/znumtheory.cmx: theories/ZArith/binInt.cmx \ - theories/NArith/binPos.cmx theories/Init/datatypes.cmx \ - theories/Init/specif.cmx theories/ZArith/wf_Z.cmx \ - theories/ZArith/zArith_dec.cmx theories/ZArith/zdiv.cmx \ - theories/ZArith/zorder.cmx theories/ZArith/znumtheory.cmi -theories/ZArith/zorder.cmo: theories/ZArith/binInt.cmi \ - theories/Init/datatypes.cmi theories/Init/specif.cmi \ +theories/ZArith/znumtheory.cmo: theories/ZArith/zorder.cmi \ + theories/ZArith/zdiv.cmi theories/ZArith/zArith_dec.cmi \ + theories/ZArith/wf_Z.cmi theories/Init/specif.cmi theories/Init/peano.cmi \ + theories/Init/datatypes.cmi theories/NArith/binPos.cmi \ + theories/ZArith/binInt.cmi theories/ZArith/znumtheory.cmi +theories/ZArith/znumtheory.cmx: theories/ZArith/zorder.cmx \ + theories/ZArith/zdiv.cmx theories/ZArith/zArith_dec.cmx \ + theories/ZArith/wf_Z.cmx theories/Init/specif.cmx theories/Init/peano.cmx \ + theories/Init/datatypes.cmx theories/NArith/binPos.cmx \ + theories/ZArith/binInt.cmx theories/ZArith/znumtheory.cmi +theories/ZArith/zorder.cmo: theories/Init/specif.cmi \ + theories/Init/datatypes.cmi theories/ZArith/binInt.cmi \ theories/ZArith/zorder.cmi -theories/ZArith/zorder.cmx: theories/ZArith/binInt.cmx \ - theories/Init/datatypes.cmx theories/Init/specif.cmx \ +theories/ZArith/zorder.cmx: theories/Init/specif.cmx \ + theories/Init/datatypes.cmx theories/ZArith/binInt.cmx \ theories/ZArith/zorder.cmi -theories/ZArith/zpower.cmo: theories/ZArith/binInt.cmi \ - theories/NArith/binPos.cmi theories/Init/datatypes.cmi \ - theories/ZArith/zmisc.cmi theories/ZArith/zpower.cmi -theories/ZArith/zpower.cmx: theories/ZArith/binInt.cmx \ - theories/NArith/binPos.cmx theories/Init/datatypes.cmx \ - theories/ZArith/zmisc.cmx theories/ZArith/zpower.cmi -theories/ZArith/zsqrt.cmo: theories/ZArith/binInt.cmi \ - theories/NArith/binPos.cmi theories/Init/specif.cmi \ - theories/ZArith/zArith_dec.cmi theories/ZArith/zsqrt.cmi -theories/ZArith/zsqrt.cmx: theories/ZArith/binInt.cmx \ - theories/NArith/binPos.cmx theories/Init/specif.cmx \ - theories/ZArith/zArith_dec.cmx theories/ZArith/zsqrt.cmi +theories/ZArith/zpower.cmo: theories/ZArith/zmisc.cmi \ + theories/Init/datatypes.cmi theories/NArith/binPos.cmi \ + theories/ZArith/binInt.cmi theories/ZArith/zpower.cmi +theories/ZArith/zpower.cmx: theories/ZArith/zmisc.cmx \ + theories/Init/datatypes.cmx theories/NArith/binPos.cmx \ + theories/ZArith/binInt.cmx theories/ZArith/zpower.cmi +theories/ZArith/zsqrt.cmo: theories/ZArith/zArith_dec.cmi \ + theories/Init/specif.cmi theories/NArith/binPos.cmi \ + theories/ZArith/binInt.cmi theories/ZArith/zsqrt.cmi +theories/ZArith/zsqrt.cmx: theories/ZArith/zArith_dec.cmx \ + theories/Init/specif.cmx theories/NArith/binPos.cmx \ + theories/ZArith/binInt.cmx theories/ZArith/zsqrt.cmi theories/ZArith/zwf.cmo: theories/ZArith/zwf.cmi theories/ZArith/zwf.cmx: theories/ZArith/zwf.cmi -theories/Arith/bool_nat.cmi: theories/Arith/compare_dec.cmi \ - theories/Init/datatypes.cmi theories/Arith/peano_dec.cmi \ - theories/Init/specif.cmi theories/Bool/sumbool.cmi -theories/Arith/compare_dec.cmi: theories/Init/datatypes.cmi \ - theories/Init/specif.cmi -theories/Arith/compare.cmi: theories/Arith/compare_dec.cmi \ - theories/Init/datatypes.cmi theories/Init/specif.cmi -theories/Arith/div2.cmi: theories/Init/datatypes.cmi theories/Init/peano.cmi \ - theories/Init/specif.cmi -theories/Arith/eqNat.cmi: theories/Init/datatypes.cmi \ - theories/Init/specif.cmi -theories/Arith/euclid.cmi: theories/Arith/compare_dec.cmi \ - theories/Init/datatypes.cmi theories/Init/specif.cmi -theories/Arith/even.cmi: theories/Init/datatypes.cmi theories/Init/specif.cmi -theories/Arith/factorial.cmi: theories/Init/datatypes.cmi \ - theories/Init/peano.cmi -theories/Arith/max.cmi: theories/Init/datatypes.cmi theories/Init/specif.cmi -theories/Arith/min.cmi: theories/Init/datatypes.cmi theories/Init/specif.cmi -theories/Arith/mult.cmi: theories/Init/datatypes.cmi theories/Arith/plus.cmi -theories/Arith/peano_dec.cmi: theories/Init/datatypes.cmi \ - theories/Init/specif.cmi -theories/Arith/plus.cmi: theories/Init/datatypes.cmi theories/Init/specif.cmi +theories/Arith/bool_nat.cmi: theories/Bool/sumbool.cmi \ + theories/Init/specif.cmi theories/Arith/peano_dec.cmi \ + theories/Init/datatypes.cmi theories/Arith/compare_dec.cmi +theories/Arith/compare_dec.cmi: theories/Init/specif.cmi \ + theories/Init/datatypes.cmi +theories/Arith/compare.cmi: theories/Init/specif.cmi \ + theories/Init/datatypes.cmi theories/Arith/compare_dec.cmi +theories/Arith/div2.cmi: theories/Init/specif.cmi theories/Init/peano.cmi \ + theories/Init/datatypes.cmi +theories/Arith/eqNat.cmi: theories/Init/specif.cmi \ + theories/Init/datatypes.cmi +theories/Arith/euclid.cmi: theories/Init/specif.cmi theories/Init/peano.cmi \ + theories/Init/datatypes.cmi theories/Arith/compare_dec.cmi +theories/Arith/even.cmi: theories/Init/specif.cmi theories/Init/datatypes.cmi +theories/Arith/factorial.cmi: theories/Init/peano.cmi \ + theories/Init/datatypes.cmi +theories/Arith/max.cmi: theories/Init/specif.cmi theories/Init/datatypes.cmi +theories/Arith/min.cmi: theories/Init/specif.cmi theories/Init/datatypes.cmi +theories/Arith/mult.cmi: theories/Arith/plus.cmi theories/Init/datatypes.cmi +theories/Arith/peano_dec.cmi: theories/Init/specif.cmi \ + theories/Init/datatypes.cmi +theories/Arith/plus.cmi: theories/Init/specif.cmi theories/Init/datatypes.cmi theories/Arith/wf_nat.cmi: theories/Init/datatypes.cmi -theories/Bool/boolEq.cmi: theories/Init/datatypes.cmi \ - theories/Init/specif.cmi -theories/Bool/bool.cmi: theories/Init/datatypes.cmi theories/Init/specif.cmi -theories/Bool/bvector.cmi: theories/Bool/bool.cmi theories/Init/datatypes.cmi \ - theories/Init/peano.cmi +theories/Bool/boolEq.cmi: theories/Init/specif.cmi \ + theories/Init/datatypes.cmi +theories/Bool/bool.cmi: theories/Init/specif.cmi theories/Init/datatypes.cmi +theories/Bool/bvector.cmi: theories/Init/peano.cmi \ + theories/Init/datatypes.cmi theories/Bool/bool.cmi theories/Bool/decBool.cmi: theories/Init/specif.cmi -theories/Bool/ifProp.cmi: theories/Init/datatypes.cmi \ - theories/Init/specif.cmi -theories/Bool/sumbool.cmi: theories/Init/datatypes.cmi \ - theories/Init/specif.cmi +theories/Bool/ifProp.cmi: theories/Init/specif.cmi \ + theories/Init/datatypes.cmi +theories/Bool/sumbool.cmi: theories/Init/specif.cmi \ + theories/Init/datatypes.cmi theories/Bool/zerob.cmi: theories/Init/datatypes.cmi -theories/Init/logic_Type.cmi: theories/Init/datatypes.cmi +theories/FSets/decidableTypeEx.cmi: theories/Init/specif.cmi \ + theories/FSets/orderedTypeEx.cmi theories/FSets/orderedType.cmi \ + theories/Init/datatypes.cmi +theories/FSets/decidableType.cmi: theories/Init/specif.cmi +theories/FSets/fMapAVL.cmi: theories/Init/wf.cmi theories/Init/specif.cmi \ + theories/FSets/orderedType.cmi theories/Lists/list.cmi \ + theories/FSets/int.cmi theories/Init/datatypes.cmi \ + theories/NArith/binPos.cmi theories/ZArith/binInt.cmi +theories/FSets/fMapFacts.cmi: theories/Init/specif.cmi \ + theories/FSets/fMapInterface.cmi theories/Init/datatypes.cmi +theories/FSets/fMapInterface.cmi: theories/FSets/orderedType.cmi \ + theories/Lists/list.cmi theories/Init/datatypes.cmi +theories/FSets/fMapIntMap.cmi: theories/Init/specif.cmi \ + theories/FSets/orderedType.cmi theories/NArith/ndigits.cmi \ + theories/IntMap/mapiter.cmi theories/IntMap/mapcanon.cmi \ + theories/IntMap/map.cmi theories/Lists/list.cmi \ + theories/Init/datatypes.cmi theories/NArith/binNat.cmi +theories/FSets/fMapList.cmi: theories/Init/specif.cmi \ + theories/FSets/orderedType.cmi theories/Lists/list.cmi \ + theories/Init/datatypes.cmi +theories/FSets/fMapPositive.cmi: theories/Init/specif.cmi \ + theories/FSets/orderedType.cmi theories/Lists/list.cmi \ + theories/Init/datatypes.cmi theories/NArith/binPos.cmi +theories/FSets/fMapWeakFacts.cmi: theories/Init/specif.cmi \ + theories/Lists/list.cmi theories/FSets/fMapWeakInterface.cmi \ + theories/Init/datatypes.cmi +theories/FSets/fMapWeakInterface.cmi: theories/Lists/list.cmi \ + theories/FSets/decidableType.cmi theories/Init/datatypes.cmi +theories/FSets/fMapWeakList.cmi: theories/Init/specif.cmi \ + theories/Lists/list.cmi theories/FSets/decidableType.cmi \ + theories/Init/datatypes.cmi +theories/FSets/fSetAVL.cmi: theories/Init/wf.cmi theories/Init/specif.cmi \ + theories/Init/peano.cmi theories/FSets/orderedType.cmi \ + theories/Lists/list.cmi theories/FSets/int.cmi \ + theories/Init/datatypes.cmi theories/NArith/binPos.cmi \ + theories/ZArith/binInt.cmi +theories/FSets/fSetBridge.cmi: theories/Init/specif.cmi \ + theories/FSets/orderedType.cmi theories/Lists/list.cmi \ + theories/FSets/fSetInterface.cmi theories/Init/datatypes.cmi +theories/FSets/fSetEqProperties.cmi: theories/Init/specif.cmi \ + theories/Setoids/setoid.cmi theories/Init/peano.cmi \ + theories/FSets/fSetInterface.cmi theories/Init/datatypes.cmi \ + theories/Bool/bool.cmi +theories/FSets/fSetFacts.cmi: theories/Init/specif.cmi \ + theories/Setoids/setoid.cmi theories/FSets/fSetInterface.cmi \ + theories/Init/datatypes.cmi +theories/FSets/fSetInterface.cmi: theories/Init/specif.cmi \ + theories/FSets/orderedType.cmi theories/Lists/list.cmi \ + theories/Init/datatypes.cmi +theories/FSets/fSetList.cmi: theories/Init/specif.cmi \ + theories/FSets/orderedType.cmi theories/Lists/list.cmi \ + theories/Init/datatypes.cmi +theories/FSets/fSetProperties.cmi: theories/Init/specif.cmi \ + theories/Setoids/setoid.cmi theories/Lists/list.cmi \ + theories/FSets/fSetInterface.cmi theories/Init/datatypes.cmi +theories/FSets/fSetToFiniteSet.cmi: theories/Init/specif.cmi \ + theories/Setoids/setoid.cmi theories/FSets/orderedTypeEx.cmi \ + theories/FSets/orderedType.cmi theories/Lists/list.cmi \ + theories/Init/datatypes.cmi +theories/FSets/fSetWeakFacts.cmi: theories/Init/specif.cmi \ + theories/Setoids/setoid.cmi theories/FSets/fSetWeakInterface.cmi \ + theories/Init/datatypes.cmi +theories/FSets/fSetWeakInterface.cmi: theories/Lists/list.cmi \ + theories/FSets/decidableType.cmi theories/Init/datatypes.cmi +theories/FSets/fSetWeakList.cmi: theories/Init/specif.cmi \ + theories/Lists/list.cmi theories/FSets/decidableType.cmi \ + theories/Init/datatypes.cmi +theories/FSets/fSetWeakProperties.cmi: theories/Init/specif.cmi \ + theories/Setoids/setoid.cmi theories/Lists/list.cmi \ + theories/FSets/fSetWeakInterface.cmi theories/Init/datatypes.cmi +theories/FSets/int.cmi: theories/ZArith/zmax.cmi \ + theories/ZArith/zArith_dec.cmi theories/Init/specif.cmi \ + theories/NArith/binPos.cmi theories/ZArith/binInt.cmi +theories/FSets/orderedTypeAlt.cmi: theories/Init/specif.cmi \ + theories/FSets/orderedType.cmi theories/Init/datatypes.cmi +theories/FSets/orderedTypeEx.cmi: theories/Init/specif.cmi \ + theories/FSets/orderedType.cmi theories/Init/datatypes.cmi \ + theories/Arith/compare_dec.cmi theories/NArith/binPos.cmi \ + theories/NArith/binNat.cmi theories/ZArith/binInt.cmi +theories/FSets/orderedType.cmi: theories/Init/specif.cmi \ + theories/Init/datatypes.cmi theories/Init/peano.cmi: theories/Init/datatypes.cmi theories/Init/specif.cmi: theories/Init/datatypes.cmi -theories/IntMap/adalloc.cmi: theories/IntMap/addec.cmi \ - theories/IntMap/addr.cmi theories/NArith/binPos.cmi \ - theories/Init/datatypes.cmi theories/IntMap/map.cmi \ - theories/Init/specif.cmi theories/Bool/sumbool.cmi -theories/IntMap/addec.cmi: theories/IntMap/addr.cmi \ - theories/NArith/binPos.cmi theories/Init/datatypes.cmi \ - theories/Init/specif.cmi theories/Bool/sumbool.cmi -theories/IntMap/addr.cmi: theories/NArith/binPos.cmi theories/Bool/bool.cmi \ - theories/Init/datatypes.cmi theories/Init/specif.cmi -theories/IntMap/adist.cmi: theories/IntMap/addr.cmi \ - theories/NArith/binPos.cmi theories/Init/datatypes.cmi -theories/IntMap/fset.cmi: theories/IntMap/addec.cmi theories/IntMap/addr.cmi \ - theories/Init/datatypes.cmi theories/IntMap/map.cmi \ - theories/Init/specif.cmi -theories/IntMap/lsort.cmi: theories/IntMap/addec.cmi theories/IntMap/addr.cmi \ - theories/NArith/binPos.cmi theories/Bool/bool.cmi \ - theories/Init/datatypes.cmi theories/Lists/list.cmi \ - theories/IntMap/map.cmi theories/IntMap/mapiter.cmi \ - theories/Init/specif.cmi theories/Bool/sumbool.cmi -theories/IntMap/mapcanon.cmi: theories/IntMap/map.cmi \ - theories/Init/specif.cmi -theories/IntMap/mapcard.cmi: theories/IntMap/addec.cmi \ - theories/IntMap/addr.cmi theories/Init/datatypes.cmi \ - theories/IntMap/map.cmi theories/Init/peano.cmi \ - theories/Arith/peano_dec.cmi theories/Arith/plus.cmi \ - theories/Init/specif.cmi theories/Bool/sumbool.cmi -theories/IntMap/mapfold.cmi: theories/IntMap/addr.cmi \ - theories/Init/datatypes.cmi theories/IntMap/fset.cmi \ - theories/IntMap/map.cmi theories/IntMap/mapiter.cmi \ - theories/Init/specif.cmi -theories/IntMap/mapiter.cmi: theories/IntMap/addec.cmi \ - theories/IntMap/addr.cmi theories/Init/datatypes.cmi \ - theories/Lists/list.cmi theories/IntMap/map.cmi theories/Init/specif.cmi \ - theories/Bool/sumbool.cmi -theories/IntMap/maplists.cmi: theories/IntMap/addec.cmi \ - theories/IntMap/addr.cmi theories/Init/datatypes.cmi \ - theories/IntMap/fset.cmi theories/Lists/list.cmi theories/IntMap/map.cmi \ - theories/IntMap/mapiter.cmi theories/Init/specif.cmi \ - theories/Bool/sumbool.cmi -theories/IntMap/map.cmi: theories/IntMap/addec.cmi theories/IntMap/addr.cmi \ - theories/NArith/binPos.cmi theories/Init/datatypes.cmi \ - theories/Init/peano.cmi theories/Init/specif.cmi -theories/IntMap/mapsubset.cmi: theories/Bool/bool.cmi \ - theories/Init/datatypes.cmi theories/IntMap/fset.cmi \ - theories/IntMap/map.cmi theories/IntMap/mapiter.cmi -theories/Lists/list.cmi: theories/Init/datatypes.cmi theories/Init/specif.cmi -theories/Lists/listSet.cmi: theories/Init/datatypes.cmi \ - theories/Lists/list.cmi theories/Init/specif.cmi +theories/IntMap/adalloc.cmi: theories/Bool/sumbool.cmi \ + theories/Init/specif.cmi theories/NArith/ndec.cmi theories/IntMap/map.cmi \ + theories/Init/datatypes.cmi theories/NArith/binPos.cmi \ + theories/NArith/binNat.cmi +theories/IntMap/fset.cmi: theories/Init/specif.cmi \ + theories/NArith/ndigits.cmi theories/NArith/ndec.cmi \ + theories/IntMap/map.cmi theories/Init/datatypes.cmi \ + theories/NArith/binNat.cmi +theories/IntMap/lsort.cmi: theories/Bool/sumbool.cmi theories/Init/specif.cmi \ + theories/NArith/ndigits.cmi theories/NArith/ndec.cmi \ + theories/IntMap/mapiter.cmi theories/IntMap/map.cmi \ + theories/Lists/list.cmi theories/Init/datatypes.cmi \ + theories/NArith/binNat.cmi +theories/IntMap/mapcanon.cmi: theories/Init/specif.cmi \ + theories/IntMap/map.cmi +theories/IntMap/mapcard.cmi: theories/Bool/sumbool.cmi \ + theories/Init/specif.cmi theories/Arith/plus.cmi \ + theories/Arith/peano_dec.cmi theories/Init/peano.cmi \ + theories/NArith/ndigits.cmi theories/NArith/ndec.cmi \ + theories/IntMap/map.cmi theories/Init/datatypes.cmi \ + theories/NArith/binNat.cmi +theories/IntMap/mapfold.cmi: theories/Init/specif.cmi \ + theories/IntMap/mapiter.cmi theories/IntMap/map.cmi \ + theories/IntMap/fset.cmi theories/Init/datatypes.cmi +theories/IntMap/mapiter.cmi: theories/Bool/sumbool.cmi \ + theories/Init/specif.cmi theories/NArith/ndigits.cmi \ + theories/NArith/ndec.cmi theories/IntMap/map.cmi theories/Lists/list.cmi \ + theories/Init/datatypes.cmi theories/NArith/binNat.cmi +theories/IntMap/maplists.cmi: theories/Bool/sumbool.cmi \ + theories/Init/specif.cmi theories/NArith/ndec.cmi \ + theories/IntMap/mapiter.cmi theories/IntMap/map.cmi \ + theories/Lists/list.cmi theories/IntMap/fset.cmi \ + theories/Init/datatypes.cmi +theories/IntMap/map.cmi: theories/Init/specif.cmi theories/Init/peano.cmi \ + theories/NArith/ndigits.cmi theories/NArith/ndec.cmi \ + theories/Init/datatypes.cmi theories/NArith/binPos.cmi \ + theories/NArith/binNat.cmi +theories/IntMap/mapsubset.cmi: theories/IntMap/mapiter.cmi \ + theories/IntMap/map.cmi theories/IntMap/fset.cmi \ + theories/Init/datatypes.cmi theories/Bool/bool.cmi +theories/Lists/list.cmi: theories/Init/specif.cmi theories/Init/datatypes.cmi +theories/Lists/listSet.cmi: theories/Init/specif.cmi theories/Lists/list.cmi \ + theories/Init/datatypes.cmi theories/Lists/monoList.cmi: theories/Init/datatypes.cmi +theories/Lists/setoidList.cmi: theories/Init/specif.cmi \ + theories/Lists/list.cmi theories/Init/datatypes.cmi theories/Lists/streams.cmi: theories/Init/datatypes.cmi -theories/Lists/theoryList.cmi: theories/Init/datatypes.cmi \ - theories/Lists/list.cmi theories/Init/specif.cmi -theories/NArith/binNat.cmi: theories/NArith/binPos.cmi \ +theories/Lists/theoryList.cmi: theories/Init/specif.cmi \ + theories/Lists/list.cmi theories/Init/datatypes.cmi +theories/Logic/choiceFacts.cmi: theories/Init/specif.cmi \ theories/Init/datatypes.cmi -theories/NArith/binPos.cmi: theories/Init/datatypes.cmi \ - theories/Init/peano.cmi -theories/Relations/relation_Operators.cmi: theories/Lists/list.cmi \ - theories/Init/specif.cmi +theories/Logic/classicalDescription.cmi: theories/Init/specif.cmi \ + theories/Logic/choiceFacts.cmi +theories/Logic/classicalEpsilon.cmi: theories/Init/specif.cmi \ + theories/Logic/choiceFacts.cmi +theories/Logic/diaconescu.cmi: theories/Init/specif.cmi +theories/Logic/eqdep_dec.cmi: theories/Init/specif.cmi +theories/NArith/binNat.cmi: theories/Init/specif.cmi \ + theories/Init/datatypes.cmi theories/NArith/binPos.cmi +theories/NArith/binPos.cmi: theories/Init/peano.cmi \ + theories/Init/datatypes.cmi +theories/NArith/ndec.cmi: theories/Bool/sumbool.cmi theories/Init/specif.cmi \ + theories/NArith/nnat.cmi theories/NArith/ndigits.cmi \ + theories/Init/datatypes.cmi theories/Arith/compare_dec.cmi \ + theories/NArith/binPos.cmi theories/NArith/binNat.cmi +theories/NArith/ndigits.cmi: theories/Init/specif.cmi \ + theories/Init/datatypes.cmi theories/Bool/bvector.cmi \ + theories/Bool/bool.cmi theories/NArith/binPos.cmi \ + theories/NArith/binNat.cmi +theories/NArith/ndist.cmi: theories/NArith/ndigits.cmi theories/Arith/min.cmi \ + theories/Init/datatypes.cmi theories/NArith/binPos.cmi \ + theories/NArith/binNat.cmi +theories/NArith/nnat.cmi: theories/Init/datatypes.cmi \ + theories/NArith/binPos.cmi theories/NArith/binNat.cmi +theories/QArith/qArith_base.cmi: theories/ZArith/zArith_dec.cmi \ + theories/Init/specif.cmi theories/Setoids/setoid.cmi \ + theories/Init/datatypes.cmi theories/NArith/binPos.cmi \ + theories/ZArith/binInt.cmi +theories/QArith/qreals.cmi: theories/QArith/qArith_base.cmi \ + theories/ZArith/binInt.cmi +theories/QArith/qreduction.cmi: theories/ZArith/znumtheory.cmi \ + theories/Setoids/setoid.cmi theories/QArith/qArith_base.cmi \ + theories/Init/datatypes.cmi theories/NArith/binPos.cmi \ + theories/ZArith/binInt.cmi +theories/QArith/qring.cmi: theories/Init/specif.cmi \ + theories/QArith/qArith_base.cmi theories/Init/datatypes.cmi +theories/Relations/relation_Operators.cmi: theories/Init/specif.cmi \ + theories/Lists/list.cmi +theories/Setoids/setoid.cmi: theories/Init/datatypes.cmi theories/Sets/cpo.cmi: theories/Sets/partial_Order.cmi -theories/Sets/integers.cmi: theories/Init/datatypes.cmi \ - theories/Sets/partial_Order.cmi -theories/Sets/multiset.cmi: theories/Init/datatypes.cmi \ - theories/Init/peano.cmi theories/Init/specif.cmi -theories/Sets/partial_Order.cmi: theories/Sets/ensembles.cmi \ - theories/Sets/relations_1.cmi -theories/Sets/powerset.cmi: theories/Sets/ensembles.cmi \ - theories/Sets/partial_Order.cmi -theories/Sets/uniset.cmi: theories/Init/datatypes.cmi \ - theories/Init/specif.cmi -theories/Sorting/heap.cmi: theories/Init/datatypes.cmi \ - theories/Lists/list.cmi theories/Sets/multiset.cmi \ - theories/Init/peano.cmi theories/Sorting/sorting.cmi \ - theories/Init/specif.cmi -theories/Sorting/permutation.cmi: theories/Init/datatypes.cmi \ - theories/Lists/list.cmi theories/Sets/multiset.cmi \ - theories/Init/peano.cmi theories/Init/specif.cmi -theories/Sorting/sorting.cmi: theories/Lists/list.cmi \ - theories/Init/specif.cmi -theories/Wellfounded/well_Ordering.cmi: theories/Init/specif.cmi -theories/ZArith/binInt.cmi: theories/NArith/binNat.cmi \ - theories/NArith/binPos.cmi theories/Init/datatypes.cmi -theories/ZArith/wf_Z.cmi: theories/ZArith/binInt.cmi \ - theories/NArith/binPos.cmi theories/Init/datatypes.cmi \ - theories/Init/peano.cmi theories/Init/specif.cmi -theories/ZArith/zabs.cmi: theories/ZArith/binInt.cmi theories/Init/specif.cmi \ - theories/Bool/sumbool.cmi -theories/ZArith/zArith_dec.cmi: theories/ZArith/binInt.cmi \ - theories/Init/datatypes.cmi theories/Init/specif.cmi \ - theories/Bool/sumbool.cmi -theories/ZArith/zbinary.cmi: theories/ZArith/binInt.cmi \ - theories/NArith/binPos.cmi theories/Bool/bvector.cmi \ - theories/Init/datatypes.cmi theories/ZArith/zeven.cmi -theories/ZArith/zbool.cmi: theories/ZArith/binInt.cmi \ - theories/Init/datatypes.cmi theories/Init/specif.cmi \ - theories/Bool/sumbool.cmi theories/ZArith/zArith_dec.cmi \ - theories/ZArith/zeven.cmi -theories/ZArith/zcomplements.cmi: theories/ZArith/binInt.cmi \ - theories/NArith/binPos.cmi theories/Init/datatypes.cmi \ - theories/Lists/list.cmi theories/Init/specif.cmi theories/ZArith/wf_Z.cmi \ - theories/ZArith/zabs.cmi -theories/ZArith/zdiv.cmi: theories/ZArith/binInt.cmi \ - theories/NArith/binPos.cmi theories/Init/datatypes.cmi \ - theories/Init/specif.cmi theories/ZArith/zArith_dec.cmi \ - theories/ZArith/zbool.cmi -theories/ZArith/zeven.cmi: theories/ZArith/binInt.cmi \ - theories/NArith/binPos.cmi theories/Init/datatypes.cmi \ - theories/Init/specif.cmi -theories/ZArith/zlogarithm.cmi: theories/ZArith/binInt.cmi \ - theories/NArith/binPos.cmi -theories/ZArith/zmin.cmi: theories/ZArith/binInt.cmi \ +theories/Sets/integers.cmi: theories/Sets/partial_Order.cmi \ theories/Init/datatypes.cmi -theories/ZArith/zmisc.cmi: theories/ZArith/binInt.cmi \ - theories/NArith/binPos.cmi theories/Init/datatypes.cmi -theories/ZArith/znumtheory.cmi: theories/ZArith/binInt.cmi \ - theories/NArith/binPos.cmi theories/Init/datatypes.cmi \ - theories/Init/specif.cmi theories/ZArith/wf_Z.cmi \ - theories/ZArith/zArith_dec.cmi theories/ZArith/zdiv.cmi \ - theories/ZArith/zorder.cmi -theories/ZArith/zorder.cmi: theories/ZArith/binInt.cmi \ - theories/Init/datatypes.cmi theories/Init/specif.cmi -theories/ZArith/zpower.cmi: theories/ZArith/binInt.cmi \ - theories/NArith/binPos.cmi theories/Init/datatypes.cmi \ - theories/ZArith/zmisc.cmi -theories/ZArith/zsqrt.cmi: theories/ZArith/binInt.cmi \ - theories/NArith/binPos.cmi theories/Init/specif.cmi \ - theories/ZArith/zArith_dec.cmi +theories/Sets/multiset.cmi: theories/Init/specif.cmi theories/Init/peano.cmi \ + theories/Init/datatypes.cmi +theories/Sets/partial_Order.cmi: theories/Sets/relations_1.cmi \ + theories/Sets/ensembles.cmi +theories/Sets/powerset.cmi: theories/Sets/partial_Order.cmi \ + theories/Sets/ensembles.cmi +theories/Sets/uniset.cmi: theories/Init/specif.cmi \ + theories/Init/datatypes.cmi +theories/Sorting/heap.cmi: theories/Init/specif.cmi \ + theories/Sorting/sorting.cmi theories/Init/peano.cmi \ + theories/Sets/multiset.cmi theories/Lists/list.cmi \ + theories/Init/datatypes.cmi +theories/Sorting/permutation.cmi: theories/Init/specif.cmi \ + theories/Init/peano.cmi theories/Sets/multiset.cmi \ + theories/Lists/list.cmi theories/Init/datatypes.cmi +theories/Sorting/sorting.cmi: theories/Init/specif.cmi \ + theories/Lists/list.cmi +theories/Strings/ascii.cmi: theories/Init/specif.cmi theories/Init/peano.cmi \ + theories/Init/datatypes.cmi theories/Bool/bool.cmi \ + theories/NArith/binPos.cmi +theories/Strings/string.cmi: theories/Init/specif.cmi \ + theories/Init/datatypes.cmi theories/Strings/ascii.cmi +theories/Wellfounded/well_Ordering.cmi: theories/Init/specif.cmi +theories/ZArith/binInt.cmi: theories/Init/datatypes.cmi \ + theories/NArith/binPos.cmi theories/NArith/binNat.cmi +theories/ZArith/wf_Z.cmi: theories/Init/specif.cmi theories/Init/peano.cmi \ + theories/Init/datatypes.cmi theories/NArith/binPos.cmi \ + theories/ZArith/binInt.cmi +theories/ZArith/zabs.cmi: theories/Init/specif.cmi theories/ZArith/binInt.cmi +theories/ZArith/zArith_dec.cmi: theories/Bool/sumbool.cmi \ + theories/Init/specif.cmi theories/Init/datatypes.cmi \ + theories/ZArith/binInt.cmi +theories/ZArith/zbinary.cmi: theories/ZArith/zeven.cmi \ + theories/Init/datatypes.cmi theories/Bool/bvector.cmi \ + theories/NArith/binPos.cmi theories/ZArith/binInt.cmi +theories/ZArith/zbool.cmi: theories/ZArith/zeven.cmi \ + theories/ZArith/zArith_dec.cmi theories/Bool/sumbool.cmi \ + theories/Init/specif.cmi theories/Init/datatypes.cmi \ + theories/ZArith/binInt.cmi +theories/ZArith/zcomplements.cmi: theories/ZArith/zabs.cmi \ + theories/ZArith/wf_Z.cmi theories/Init/specif.cmi theories/Lists/list.cmi \ + theories/Init/datatypes.cmi theories/NArith/binPos.cmi \ + theories/ZArith/binInt.cmi +theories/ZArith/zdiv.cmi: theories/ZArith/zbool.cmi \ + theories/ZArith/zArith_dec.cmi theories/Init/specif.cmi \ + theories/Init/datatypes.cmi theories/NArith/binPos.cmi \ + theories/ZArith/binInt.cmi +theories/ZArith/zeven.cmi: theories/Init/specif.cmi \ + theories/Init/datatypes.cmi theories/NArith/binPos.cmi \ + theories/ZArith/binInt.cmi +theories/ZArith/zlogarithm.cmi: theories/NArith/binPos.cmi \ + theories/ZArith/binInt.cmi +theories/ZArith/zmax.cmi: theories/Init/datatypes.cmi \ + theories/ZArith/binInt.cmi +theories/ZArith/zmin.cmi: theories/Init/specif.cmi \ + theories/Init/datatypes.cmi theories/ZArith/binInt.cmi +theories/ZArith/zmisc.cmi: theories/Init/datatypes.cmi \ + theories/NArith/binPos.cmi theories/ZArith/binInt.cmi +theories/ZArith/znumtheory.cmi: theories/ZArith/zorder.cmi \ + theories/ZArith/zdiv.cmi theories/ZArith/zArith_dec.cmi \ + theories/ZArith/wf_Z.cmi theories/Init/specif.cmi theories/Init/peano.cmi \ + theories/Init/datatypes.cmi theories/NArith/binPos.cmi \ + theories/ZArith/binInt.cmi +theories/ZArith/zorder.cmi: theories/Init/specif.cmi \ + theories/Init/datatypes.cmi theories/ZArith/binInt.cmi +theories/ZArith/zpower.cmi: theories/ZArith/zmisc.cmi \ + theories/Init/datatypes.cmi theories/NArith/binPos.cmi \ + theories/ZArith/binInt.cmi +theories/ZArith/zsqrt.cmi: theories/ZArith/zArith_dec.cmi \ + theories/Init/specif.cmi theories/NArith/binPos.cmi \ + theories/ZArith/binInt.cmi diff --git a/contrib/extraction/test/Makefile b/contrib/extraction/test/Makefile index c9bb5623..65a54090 100644 --- a/contrib/extraction/test/Makefile +++ b/contrib/extraction/test/Makefile @@ -10,7 +10,7 @@ AXIOMSVO:= \ theories/Reals/% \ theories/Num/% -DIRS:= $(shell (cd $(TOPDIR);find theories -type d ! -name CVS)) +DIRS:= $(shell (cd $(TOPDIR);find theories -type d ! -path \*.svn\*)) INCL:= $(patsubst %,-I %,$(DIRS)) @@ -34,7 +34,7 @@ all: v2ml ml $(MLI) $(CMO) ml: $(ML) -depend: $(ML) +depend: #$(ML) rm -f .depend; ocamldep $(INCL) theories/*/*.ml theories/*/*.mli > .depend tree: diff --git a/contrib/extraction/test/custom/Adalloc b/contrib/extraction/test/custom/Adalloc index 0fb556aa..e7204838 100644 --- a/contrib/extraction/test/custom/Adalloc +++ b/contrib/extraction/test/custom/Adalloc @@ -1,2 +1,2 @@ -Require Import Addr. -Extraction NoInline ad_double ad_double_plus_un. +Require Import BinNat. +Extraction NoInline Ndouble Ndouble_plus_one. diff --git a/contrib/extraction/test/custom/Lsort b/contrib/extraction/test/custom/Lsort index 6a185683..22ab18e3 100644 --- a/contrib/extraction/test/custom/Lsort +++ b/contrib/extraction/test/custom/Lsort @@ -1,2 +1,2 @@ -Require Import Addr. -Extraction NoInline ad_double ad_double_plus_un. +Require Import BinNat. +Extraction NoInline Ndouble Ndouble_plus_one. diff --git a/contrib/extraction/test/custom/Map b/contrib/extraction/test/custom/Map index 3e464e39..f024dbd7 100644 --- a/contrib/extraction/test/custom/Map +++ b/contrib/extraction/test/custom/Map @@ -1,3 +1,3 @@ -Require Import Addr. -Extraction NoInline ad_double ad_double_plus_un. +Require Import BinNat. +Extraction NoInline Ndouble Ndouble_plus_one. diff --git a/contrib/extraction/test/custom/Mapcard b/contrib/extraction/test/custom/Mapcard index ca555aa3..5932cf7b 100644 --- a/contrib/extraction/test/custom/Mapcard +++ b/contrib/extraction/test/custom/Mapcard @@ -1,4 +1,4 @@ Require Import Plus. Extraction NoInline plus_is_one. -Require Import Addr. -Extraction NoInline ad_double ad_double_plus_un. +Require Import BinNat. +Extraction NoInline Ndouble Ndouble_plus_one. diff --git a/contrib/extraction/test/custom/Mapiter b/contrib/extraction/test/custom/Mapiter index 6a185683..22ab18e3 100644 --- a/contrib/extraction/test/custom/Mapiter +++ b/contrib/extraction/test/custom/Mapiter @@ -1,2 +1,2 @@ -Require Import Addr. -Extraction NoInline ad_double ad_double_plus_un. +Require Import BinNat. +Extraction NoInline Ndouble Ndouble_plus_one. diff --git a/contrib/field/Field_Compl.v b/contrib/field/Field_Compl.v index 774b3084..f018359e 100644 --- a/contrib/field/Field_Compl.v +++ b/contrib/field/Field_Compl.v @@ -6,56 +6,33 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: Field_Compl.v 5920 2004-07-16 20:01:26Z herbelin $ *) +(* $Id: Field_Compl.v 8866 2006-05-28 16:21:04Z herbelin $ *) -Inductive listT (A:Type) : Type := - | nilT : listT A - | consT : A -> listT A -> listT A. - -Fixpoint appT (A:Type) (l m:listT A) {struct l} : listT A := - match l with - | nilT => m - | consT a l1 => consT A a (appT A l1 m) - end. - -Inductive prodT (A B:Type) : Type := - pairT : A -> B -> prodT A B. +Require Import List. Definition assoc_2nd := (fix assoc_2nd_rec (A:Type) (B:Set) (eq_dec:forall e1 e2:B, {e1 = e2} + {e1 <> e2}) - (lst:listT (prodT A B)) {struct lst} : + (lst:list (prod A B)) {struct lst} : B -> A -> A := fun (key:B) (default:A) => match lst with - | nilT => default - | consT (pairT v e) l => + | nil => default + | (v,e) :: l => match eq_dec e key with | left _ => v | right _ => assoc_2nd_rec A B eq_dec l key default end end). -Definition fstT (A B:Type) (c:prodT A B) := match c with - | pairT a _ => a - end. - -Definition sndT (A B:Type) (c:prodT A B) := match c with - | pairT _ a => a - end. - Definition mem := (fix mem (A:Set) (eq_dec:forall e1 e2:A, {e1 = e2} + {e1 <> e2}) - (a:A) (l:listT A) {struct l} : bool := + (a:A) (l:list A) {struct l} : bool := match l with - | nilT => false - | consT a1 l1 => + | nil => false + | a1 :: l1 => match eq_dec a a1 with | left _ => true | right _ => mem A eq_dec a l1 end end). - -Inductive field_rel_option (A:Type) : Type := - | Field_None : field_rel_option A - | Field_Some : (A -> A -> A) -> field_rel_option A.
\ No newline at end of file diff --git a/contrib/field/Field_Tactic.v b/contrib/field/Field_Tactic.v index afa0a814..8d727536 100644 --- a/contrib/field/Field_Tactic.v +++ b/contrib/field/Field_Tactic.v @@ -6,8 +6,9 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: Field_Tactic.v 8134 2006-03-05 16:39:17Z herbelin $ *) +(* $Id: Field_Tactic.v 8866 2006-05-28 16:21:04Z herbelin $ *) +Require Import List. Require Import Ring. Require Export Field_Compl. Require Export Field_Theory. @@ -20,8 +21,8 @@ Ltac body_of s := eval cbv beta iota delta [s] in s. Ltac mem_assoc var lvar := match constr:lvar with - | (nilT _) => constr:false - | (consT _ ?X1 ?X2) => + | nil => constr:false + | ?X1 :: ?X2 => match constr:(X1 = var) with | (?X1 = ?X1) => constr:true | _ => mem_assoc var X2 @@ -31,10 +32,10 @@ Ltac mem_assoc var lvar := Ltac number lvar := let rec number_aux lvar cpt := match constr:lvar with - | (nilT ?X1) => constr:(nilT (prodT X1 nat)) - | (consT ?X1 ?X2 ?X3) => + | (@nil ?X1) => constr:(@nil (prod X1 nat)) + | ?X2 :: ?X3 => let l2 := number_aux X3 (S cpt) in - constr:(consT (prodT X1 nat) (pairT X1 nat X2 cpt) l2) + constr:((X2,cpt) :: l2) end in number_aux lvar 0. @@ -62,17 +63,17 @@ Ltac build_varlist FT trm := let res := mem_assoc X1 lvar in match constr:res with | true => lvar - | false => constr:(consT AT X1 lvar) + | false => constr:(X1 :: lvar) end end in let AT := get_component A FT in - let lvar := seek_var (nilT AT) trm in + let lvar := seek_var (@nil AT) trm in number lvar. Ltac assoc elt lst := match constr:lst with - | (nilT _) => fail - | (consT (prodT _ nat) (pairT _ nat ?X1 ?X2) ?X3) => + | nil => fail + | (?X1,?X2) :: ?X3 => match constr:(elt = X1) with | (?X1 = ?X1) => constr:X2 | _ => assoc elt X3 @@ -113,32 +114,31 @@ Ltac interp_A FT lvar trm := Ltac remove e l := match constr:l with - | (nilT _) => l - | (consT ?X1 e ?X2) => constr:X2 - | (consT ?X1 ?X2 ?X3) => let nl := remove e X3 in - constr:(consT X1 X2 nl) + | nil => l + | e :: ?X2 => constr:X2 + | ?X2 :: ?X3 => let nl := remove e X3 in constr:(X2 :: nl) end. Ltac union l1 l2 := match constr:l1 with - | (nilT _) => l2 - | (consT ?X1 ?X2 ?X3) => + | nil => l2 + | ?X2 :: ?X3 => let nl2 := remove X2 l2 in let nl := union X3 nl2 in - constr:(consT X1 X2 nl) + constr:(X2 :: nl) end. Ltac raw_give_mult trm := match constr:trm with - | (EAinv ?X1) => constr:(consT ExprA X1 (nilT ExprA)) + | (EAinv ?X1) => constr:(X1 :: nil) | (EAopp ?X1) => raw_give_mult X1 | (EAplus ?X1 ?X2) => let l1 := raw_give_mult X1 with l2 := raw_give_mult X2 in union l1 l2 | (EAmult ?X1 ?X2) => let l1 := raw_give_mult X1 with l2 := raw_give_mult X2 in - eval compute in (appT ExprA l1 l2) - | _ => constr:(nilT ExprA) + eval compute in (app l1 l2) + | _ => constr:(@nil ExprA) end. Ltac give_mult trm := @@ -254,13 +254,13 @@ Ltac apply_simplif sfun := Ltac unfolds FT := match get_component Aminus FT with - | (Field_Some _ ?X1) => unfold X1 in |- * + | Some ?X1 => unfold X1 in |- * | _ => idtac end; - match get_component Adiv FT with - | (Field_Some _ ?X1) => unfold X1 in |- * - | _ => idtac - end. + match get_component Adiv FT with + | Some ?X1 => unfold X1 in |- * + | _ => idtac + end. Ltac reduce FT := let AzeroT := get_component Azero FT @@ -304,11 +304,11 @@ Ltac field_gen FT := unfolds FT; (inverse_test FT; ring) || field_gen_aux FT. Ltac init_exp FT trm := let e := (match get_component Aminus FT with - | (Field_Some _ ?X1) => eval cbv beta delta [X1] in trm + | Some ?X1 => eval cbv beta delta [X1] in trm | _ => trm end) in match get_component Adiv FT with - | (Field_Some _ ?X1) => eval cbv beta delta [X1] in e + | Some ?X1 => eval cbv beta delta [X1] in e | _ => e end. @@ -341,21 +341,21 @@ Ltac simpl_inv trm := Ltac map_tactic fcn lst := match constr:lst with - | (nilT _) => lst - | (consT ?X1 ?X2 ?X3) => + | nil => lst + | ?X2 :: ?X3 => let r := fcn X2 with t := map_tactic fcn X3 in - constr:(consT X1 r t) + constr:(r :: t) end. Ltac build_monom_aux lst trm := match constr:lst with - | (nilT _) => eval compute in (assoc trm) - | (consT _ ?X1 ?X2) => build_monom_aux X2 (EAmult trm X1) + | nil => eval compute in (assoc trm) + | ?X1 :: ?X2 => build_monom_aux X2 (EAmult trm X1) end. Ltac build_monom lnum lden := let ildn := map_tactic ltac:(fun e => constr:(EAinv e)) lden in - let ltot := eval compute in (appT ExprA lnum ildn) in + let ltot := eval compute in (app lnum ildn) in let trm := build_monom_aux ltot EAone in match constr:trm with | (EAmult _ ?X1) => constr:X1 @@ -370,7 +370,7 @@ Ltac simpl_monom_aux lnum lden trm := | true => let newlnum := remove X1 lnum in simpl_monom_aux newlnum lden X2 - | false => simpl_monom_aux lnum (consT ExprA X1 lden) X2 + | false => simpl_monom_aux lnum (X1 :: lden) X2 end | (EAmult ?X1 ?X2) => let mma := mem_assoc X1 lden in @@ -378,7 +378,7 @@ Ltac simpl_monom_aux lnum lden trm := | true => let newlden := remove X1 lden in simpl_monom_aux lnum newlden X2 - | false => simpl_monom_aux (consT ExprA X1 lnum) lden X2 + | false => simpl_monom_aux (X1 :: lnum) lden X2 end | (EAinv ?X1) => let mma := mem_assoc X1 lnum in @@ -386,7 +386,7 @@ Ltac simpl_monom_aux lnum lden trm := | true => let newlnum := remove X1 lnum in build_monom newlnum lden - | false => build_monom lnum (consT ExprA X1 lden) + | false => build_monom lnum (X1 :: lden) end | ?X1 => let mma := mem_assoc X1 lden in @@ -394,11 +394,11 @@ Ltac simpl_monom_aux lnum lden trm := | true => let newlden := remove X1 lden in build_monom lnum newlden - | false => build_monom (consT ExprA X1 lnum) lden + | false => build_monom (X1 :: lnum) lden end end. -Ltac simpl_monom trm := simpl_monom_aux (nilT ExprA) (nilT ExprA) trm. +Ltac simpl_monom trm := simpl_monom_aux (@nil ExprA) (@nil ExprA) trm. Ltac simpl_all_monomials trm := match constr:trm with diff --git a/contrib/field/Field_Theory.v b/contrib/field/Field_Theory.v index 2c954652..fff3c414 100644 --- a/contrib/field/Field_Theory.v +++ b/contrib/field/Field_Theory.v @@ -6,8 +6,9 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: Field_Theory.v 5920 2004-07-16 20:01:26Z herbelin $ *) +(* $Id: Field_Theory.v 8866 2006-05-28 16:21:04Z herbelin $ *) +Require Import List. Require Import Peano_dec. Require Import Ring. Require Import Field_Compl. @@ -21,8 +22,8 @@ Record Field_Theory : Type := Aopp : A -> A; Aeq : A -> A -> bool; Ainv : A -> A; - Aminus : field_rel_option A; - Adiv : field_rel_option A; + Aminus : option (A -> A -> A); + Adiv : option (A -> A -> A); RT : Ring_Theory Aplus Amult Aone Azero Aopp Aeq; Th_inv_def : forall n:A, n <> Azero -> Amult (Ainv n) n = Aone}. @@ -66,10 +67,10 @@ Definition eqExprA := Eval compute in eqExprA_O. (**** Generation of the multiplier ****) -Fixpoint mult_of_list (e:listT ExprA) : ExprA := +Fixpoint mult_of_list (e:list ExprA) : ExprA := match e with - | nilT => EAone - | consT e1 l1 => EAmult e1 (mult_of_list l1) + | nil => EAone + | e1 :: l1 => EAmult e1 (mult_of_list l1) end. Section Theory_of_fields. @@ -191,7 +192,7 @@ Qed. (**** ExprA --> A ****) -Fixpoint interp_ExprA (lvar:listT (prodT AT nat)) (e:ExprA) {struct e} : +Fixpoint interp_ExprA (lvar:list (AT * nat)) (e:ExprA) {struct e} : AT := match e with | EAzero => AzeroT @@ -257,7 +258,7 @@ Fixpoint assoc (e:ExprA) : ExprA := end. Lemma merge_mult_correct1 : - forall (e1 e2 e3:ExprA) (lvar:listT (prodT AT nat)), + forall (e1 e2 e3:ExprA) (lvar:list (AT * nat)), interp_ExprA lvar (merge_mult (EAmult e1 e2) e3) = interp_ExprA lvar (EAmult e1 (merge_mult e2 e3)). Proof. @@ -271,7 +272,7 @@ unfold merge_mult at 1 in |- *; fold merge_mult in |- *; Qed. Lemma merge_mult_correct : - forall (e1 e2:ExprA) (lvar:listT (prodT AT nat)), + forall (e1 e2:ExprA) (lvar:list (AT * nat)), interp_ExprA lvar (merge_mult e1 e2) = interp_ExprA lvar (EAmult e1 e2). Proof. simple induction e1; auto; intros. @@ -290,7 +291,7 @@ ring. Qed. Lemma assoc_mult_correct1 : - forall (e1 e2:ExprA) (lvar:listT (prodT AT nat)), + forall (e1 e2:ExprA) (lvar:list (AT * nat)), AmultT (interp_ExprA lvar (assoc_mult e1)) (interp_ExprA lvar (assoc_mult e2)) = interp_ExprA lvar (assoc_mult (EAmult e1 e2)). @@ -302,7 +303,7 @@ rewrite <- (H e0 lvar); simpl in |- *; rewrite merge_mult_correct; Qed. Lemma assoc_mult_correct : - forall (e:ExprA) (lvar:listT (prodT AT nat)), + forall (e:ExprA) (lvar:list (AT * nat)), interp_ExprA lvar (assoc_mult e) = interp_ExprA lvar e. Proof. simple induction e; auto; intros. @@ -325,7 +326,7 @@ simpl in |- *; rewrite (H0 lvar); auto. Qed. Lemma merge_plus_correct1 : - forall (e1 e2 e3:ExprA) (lvar:listT (prodT AT nat)), + forall (e1 e2 e3:ExprA) (lvar:list (AT * nat)), interp_ExprA lvar (merge_plus (EAplus e1 e2) e3) = interp_ExprA lvar (EAplus e1 (merge_plus e2 e3)). Proof. @@ -339,7 +340,7 @@ unfold merge_plus at 1 in |- *; fold merge_plus in |- *; Qed. Lemma merge_plus_correct : - forall (e1 e2:ExprA) (lvar:listT (prodT AT nat)), + forall (e1 e2:ExprA) (lvar:list (AT * nat)), interp_ExprA lvar (merge_plus e1 e2) = interp_ExprA lvar (EAplus e1 e2). Proof. simple induction e1; auto; intros. @@ -358,7 +359,7 @@ ring. Qed. Lemma assoc_plus_correct : - forall (e1 e2:ExprA) (lvar:listT (prodT AT nat)), + forall (e1 e2:ExprA) (lvar:list (AT * nat)), AplusT (interp_ExprA lvar (assoc e1)) (interp_ExprA lvar (assoc e2)) = interp_ExprA lvar (assoc (EAplus e1 e2)). Proof. @@ -369,7 +370,7 @@ rewrite <- (H e0 lvar); simpl in |- *; rewrite merge_plus_correct; Qed. Lemma assoc_correct : - forall (e:ExprA) (lvar:listT (prodT AT nat)), + forall (e:ExprA) (lvar:list (AT * nat)), interp_ExprA lvar (assoc e) = interp_ExprA lvar e. Proof. simple induction e; auto; intros. @@ -448,7 +449,7 @@ Fixpoint distrib_main (e:ExprA) : ExprA := Definition distrib (e:ExprA) : ExprA := distrib_main (distrib_EAopp e). Lemma distrib_mult_right_correct : - forall (e1 e2:ExprA) (lvar:listT (prodT AT nat)), + forall (e1 e2:ExprA) (lvar:list (AT * nat)), interp_ExprA lvar (distrib_mult_right e1 e2) = AmultT (interp_ExprA lvar e1) (interp_ExprA lvar e2). Proof. @@ -458,7 +459,7 @@ rewrite AmultT_sym; rewrite AmultT_AplusT_distr; rewrite (H e2 lvar); Qed. Lemma distrib_mult_left_correct : - forall (e1 e2:ExprA) (lvar:listT (prodT AT nat)), + forall (e1 e2:ExprA) (lvar:list (AT * nat)), interp_ExprA lvar (distrib_mult_left e1 e2) = AmultT (interp_ExprA lvar e1) (interp_ExprA lvar e2). Proof. @@ -480,7 +481,7 @@ rewrite distrib_mult_right_correct; simpl in |- *; apply AmultT_sym. Qed. Lemma distrib_correct : - forall (e:ExprA) (lvar:listT (prodT AT nat)), + forall (e:ExprA) (lvar:list (AT * nat)), interp_ExprA lvar (distrib e) = interp_ExprA lvar e. Proof. simple induction e; intros; auto. @@ -496,7 +497,7 @@ Qed. (**** Multiplication by the inverse product ****) Lemma mult_eq : - forall (e1 e2 a:ExprA) (lvar:listT (prodT AT nat)), + forall (e1 e2 a:ExprA) (lvar:list (AT * nat)), interp_ExprA lvar a <> AzeroT -> interp_ExprA lvar (EAmult a e1) = interp_ExprA lvar (EAmult a e2) -> interp_ExprA lvar e1 = interp_ExprA lvar e2. @@ -520,7 +521,7 @@ Definition multiply (e:ExprA) : ExprA := end. Lemma multiply_aux_correct : - forall (a e:ExprA) (lvar:listT (prodT AT nat)), + forall (a e:ExprA) (lvar:list (AT * nat)), interp_ExprA lvar (multiply_aux a e) = AmultT (interp_ExprA lvar a) (interp_ExprA lvar e). Proof. @@ -530,7 +531,7 @@ simple induction e; simpl in |- *; intros; try rewrite merge_mult_correct; Qed. Lemma multiply_correct : - forall (e:ExprA) (lvar:listT (prodT AT nat)), + forall (e:ExprA) (lvar:list (AT * nat)), interp_ExprA lvar (multiply e) = interp_ExprA lvar e. Proof. simple induction e; simpl in |- *; auto. @@ -578,7 +579,7 @@ Fixpoint inverse_simplif (a e:ExprA) {struct e} : ExprA := end. Lemma monom_remove_correct : - forall (e a:ExprA) (lvar:listT (prodT AT nat)), + forall (e a:ExprA) (lvar:list (AT * nat)), interp_ExprA lvar a <> AzeroT -> interp_ExprA lvar (monom_remove a e) = AmultT (interp_ExprA lvar a) (interp_ExprA lvar e). @@ -608,7 +609,7 @@ unfold monom_remove in |- *; case (eqExprA (EAvar n) (EAinv a)); intros; Qed. Lemma monom_simplif_rem_correct : - forall (a e:ExprA) (lvar:listT (prodT AT nat)), + forall (a e:ExprA) (lvar:list (AT * nat)), interp_ExprA lvar a <> AzeroT -> interp_ExprA lvar (monom_simplif_rem a e) = AmultT (interp_ExprA lvar a) (interp_ExprA lvar e). @@ -622,7 +623,7 @@ ring. Qed. Lemma monom_simplif_correct : - forall (e a:ExprA) (lvar:listT (prodT AT nat)), + forall (e a:ExprA) (lvar:list (AT * nat)), interp_ExprA lvar a <> AzeroT -> interp_ExprA lvar (monom_simplif a e) = interp_ExprA lvar e. Proof. @@ -633,7 +634,7 @@ simpl in |- *; trivial. Qed. Lemma inverse_correct : - forall (e a:ExprA) (lvar:listT (prodT AT nat)), + forall (e a:ExprA) (lvar:list (AT * nat)), interp_ExprA lvar a <> AzeroT -> interp_ExprA lvar (inverse_simplif a e) = interp_ExprA lvar e. Proof. @@ -642,4 +643,4 @@ simpl in |- *; rewrite (H0 a lvar H1); rewrite monom_simplif_correct; auto. unfold inverse_simplif in |- *; rewrite monom_simplif_correct; auto. Qed. -End Theory_of_fields.
\ No newline at end of file +End Theory_of_fields. diff --git a/contrib/field/field.ml4 b/contrib/field/field.ml4 index 35591f23..47e583fd 100644 --- a/contrib/field/field.ml4 +++ b/contrib/field/field.ml4 @@ -8,7 +8,7 @@ (*i camlp4deps: "parsing/grammar.cma" i*) -(* $Id: field.ml4 7837 2006-01-11 09:47:32Z herbelin $ *) +(* $Id: field.ml4 8866 2006-05-28 16:21:04Z herbelin $ *) open Names open Pp @@ -22,19 +22,22 @@ open Vernacinterp open Vernacexpr open Tacexpr open Mod_subst +open Coqlib (* Interpretation of constr's *) let constr_of c = Constrintern.interp_constr Evd.empty (Global.env()) c (* Construction of constants *) -let constant dir s = Coqlib.gen_constant "Field" ("field"::dir) s +let constant dir s = gen_constant "Field" ("field"::dir) s +let init_constant s = gen_constant_in_modules "Field" init_modules s (* To deal with the optional arguments *) let constr_of_opt a opt = let ac = constr_of a in + let ac3 = mkArrow ac (mkArrow ac ac) in match opt with - | None -> mkApp ((constant ["Field_Compl"] "Field_None"),[|ac|]) - | Some f -> mkApp ((constant ["Field_Compl"] "Field_Some"),[|ac;constr_of f|]) + | None -> mkApp (init_constant "None",[|ac3|]) + | Some f -> mkApp (init_constant "Some",[|ac3;constr_of f|]) (* Table of theories *) let th_tab = ref (Gmap.empty : (constr,constr) Gmap.t) diff --git a/contrib/first-order/g_ground.ml4 b/contrib/first-order/g_ground.ml4 index 0970d5db..f9c4cea2 100644 --- a/contrib/first-order/g_ground.ml4 +++ b/contrib/first-order/g_ground.ml4 @@ -8,7 +8,7 @@ (*i camlp4deps: "parsing/grammar.cma" i*) -(* $Id: g_ground.ml4 7909 2006-01-21 11:09:18Z herbelin $ *) +(* $Id: g_ground.ml4 8752 2006-04-27 19:37:33Z herbelin $ *) open Formula open Sequent @@ -83,14 +83,14 @@ let normalize_evaluables= TACTIC EXTEND firstorder [ "firstorder" tactic_opt(t) "with" ne_reference_list(l) ] -> - [ gen_ground_tac true (option_app eval_tactic t) (Ids l) ] + [ gen_ground_tac true (option_map eval_tactic t) (Ids l) ] | [ "firstorder" tactic_opt(t) "using" ne_preident_list(l) ] -> - [ gen_ground_tac true (option_app eval_tactic t) (Bases l) ] + [ gen_ground_tac true (option_map eval_tactic t) (Bases l) ] | [ "firstorder" tactic_opt(t) ] -> - [ gen_ground_tac true (option_app eval_tactic t) Void ] + [ gen_ground_tac true (option_map eval_tactic t) Void ] END TACTIC EXTEND gintuition [ "gintuition" tactic_opt(t) ] -> - [ gen_ground_tac false (option_app eval_tactic t) Void ] + [ gen_ground_tac false (option_map eval_tactic t) Void ] END diff --git a/contrib/first-order/rules.ml b/contrib/first-order/rules.ml index f6653b82..6c51eda3 100644 --- a/contrib/first-order/rules.ml +++ b/contrib/first-order/rules.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: rules.ml 7909 2006-01-21 11:09:18Z herbelin $ *) +(* $Id: rules.ml 8878 2006-05-30 16:44:25Z herbelin $ *) open Util open Names @@ -211,6 +211,6 @@ let normalize_evaluables= onAllClauses (function None->unfold_in_concl (Lazy.force defined_connectives) - | Some (id,_,_)-> + | Some ((_,id),_)-> unfold_in_hyp (Lazy.force defined_connectives) - (id,[],Tacexpr.InHypTypeOnly)) + (([],id),Tacexpr.InHypTypeOnly)) diff --git a/contrib/funind/functional_principles_proofs.ml b/contrib/funind/functional_principles_proofs.ml new file mode 100644 index 00000000..f0e986fb --- /dev/null +++ b/contrib/funind/functional_principles_proofs.ml @@ -0,0 +1,1538 @@ +open Printer +open Util +open Term +open Termops +open Names +open Declarations +open Pp +open Entries +open Hiddentac +open Evd +open Tacmach +open Proof_type +open Tacticals +open Tactics +open Indfun_common +open Libnames + +let msgnl = Pp.msgnl + +let do_observe () = + Tacinterp.get_debug () <> Tactic_debug.DebugOff + + +let observe strm = + if do_observe () + then Pp.msgnl strm + else () + +let observennl strm = + if do_observe () + then begin Pp.msg strm;Pp.pp_flush () end + else () + + + + +let do_observe_tac s tac g = + try let v = tac g in (* msgnl (goal ++ fnl () ++ (str s)++(str " ")++(str "finished")); *) v + with e -> + let goal = begin try (Printer.pr_goal (sig_it g)) with _ -> assert false end in + msgnl (str "observation "++ s++str " raised exception " ++ + Cerrors.explain_exn e ++ str " on goal " ++ goal ); + raise e;; + + +let observe_tac s tac g = + if do_observe () + then do_observe_tac (str s) tac g + else tac g + + +let tclTRYD tac = + if !Options.debug || do_observe () + then (fun g -> try (* do_observe_tac "" *)tac g with _ -> tclIDTAC g) + else tac + + +let list_chop ?(msg="") n l = + try + list_chop n l + with Failure (msg') -> + failwith (msg ^ msg') + + +let make_refl_eq type_of_t t = + let refl_equal_term = Lazy.force refl_equal in + mkApp(refl_equal_term,[|type_of_t;t|]) + + +type pte_info = + { + proving_tac : (identifier list -> Tacmach.tactic); + is_valid : constr -> bool + } + +type ptes_info = pte_info Idmap.t + +type 'a dynamic_info = + { + nb_rec_hyps : int; + rec_hyps : identifier list ; + eq_hyps : identifier list; + info : 'a + } + +type body_info = constr dynamic_info + + +let finish_proof dynamic_infos g = + observe_tac "finish" + ( h_assumption) + g + + +let refine c = + Tacmach.refine_no_check c + +let thin l = + Tacmach.thin_no_check l + + +let cut_replacing id t tac :tactic= + tclTHENS (cut t) + [ tclTHEN (thin_no_check [id]) (introduction_no_check id); + tac + ] + +let intro_erasing id = tclTHEN (thin [id]) (introduction id) + + + +let rec_hyp_id = id_of_string "rec_hyp" + +let is_trivial_eq t = + match kind_of_term t with + | App(f,[|_;t1;t2|]) when eq_constr f (Lazy.force eq) -> + eq_constr t1 t2 + | _ -> false + + +let rec incompatible_constructor_terms t1 t2 = + let c1,arg1 = decompose_app t1 + and c2,arg2 = decompose_app t2 + in + (not (eq_constr t1 t2)) && + isConstruct c1 && isConstruct c2 && + ( + not (eq_constr c1 c2) || + List.exists2 incompatible_constructor_terms arg1 arg2 + ) + +let is_incompatible_eq t = + match kind_of_term t with + | App(f,[|_;t1;t2|]) when eq_constr f (Lazy.force eq) -> + incompatible_constructor_terms t1 t2 + | _ -> false + +let change_hyp_with_using msg hyp_id t tac : tactic = + fun g -> + let prov_id = pf_get_new_id hyp_id g in + tclTHENS + (observe_tac msg (forward (Some (tclCOMPLETE tac)) (Genarg.IntroIdentifier prov_id) t)) + [tclTHENLIST + [ + observe_tac "change_hyp_with_using thin" (thin [hyp_id]); + observe_tac "change_hyp_with_using rename " (h_rename prov_id hyp_id) + ]] g + +exception TOREMOVE + + +let prove_trivial_eq h_id context (type_of_term,term) = + let nb_intros = List.length context in + tclTHENLIST + [ + tclDO nb_intros intro; (* introducing context *) + (fun g -> + let context_hyps = + fst (list_chop ~msg:"prove_trivial_eq : " nb_intros (pf_ids_of_hyps g)) + in + let context_hyps' = + (mkApp(Lazy.force refl_equal,[|type_of_term;term|])):: + (List.map mkVar context_hyps) + in + let to_refine = applist(mkVar h_id,List.rev context_hyps') in + refine to_refine g + ) + ] + + +let isAppConstruct t = + if isApp t + then isConstruct (fst (destApp t)) + else false + + +let nf_betaiotazeta = Reductionops.local_strong Reductionops.whd_betaiotazeta + + +let change_eq env sigma hyp_id (context:Sign.rel_context) x t end_of_type = + let nochange msg = + begin +(* observe (str ("Not treating ( "^msg^" )") ++ pr_lconstr t ); *) + failwith "NoChange"; + end + in + if not (noccurn 1 end_of_type) + then nochange "dependent"; (* if end_of_type depends on this term we don't touch it *) + if not (isApp t) then nochange "not an equality"; + let f_eq,args = destApp t in + if not (eq_constr f_eq (Lazy.force eq)) then nochange "not an equality"; + let t1 = args.(1) + and t2 = args.(2) + and t1_typ = args.(0) + in + if not (closed0 t1) then nochange "not a closed lhs"; + let rec compute_substitution sub t1 t2 = + if isRel t2 + then + let t2 = destRel t2 in + begin + try + let t1' = Intmap.find t2 sub in + if not (eq_constr t1 t1') then nochange "twice bound variable"; + sub + with Not_found -> + assert (closed0 t1); + Intmap.add t2 t1 sub + end + else if isAppConstruct t1 && isAppConstruct t2 + then + begin + let c1,args1 = destApp t1 + and c2,args2 = destApp t2 + in + if not (eq_constr c1 c2) then anomaly "deconstructing equation"; + array_fold_left2 compute_substitution sub args1 args2 + end + else + if (eq_constr t1 t2) then sub else nochange "cannot solve" + in + let sub = compute_substitution Intmap.empty t1 t2 in + let end_of_type_with_pop = pop end_of_type in (*the equation will be removed *) + let new_end_of_type = + (* Ugly hack to prevent Map.fold order change between ocaml-3.08.3 and ocaml-3.08.4 + Can be safely replaced by the next comment for Ocaml >= 3.08.4 + *) + let sub' = Intmap.fold (fun i t acc -> (i,t)::acc) sub [] in + let sub'' = List.sort (fun (x,_) (y,_) -> Pervasives.compare x y) sub' in + List.fold_left (fun end_of_type (i,t) -> lift 1 (substnl [t] (i-1) end_of_type)) + end_of_type_with_pop + sub'' + in + (* let new_end_of_type = *) + (* Intmap.fold *) + (* (fun i t end_of_type -> lift 1 (substnl [t] (i-1) end_of_type)) *) + (* sub *) + (* end_of_type_with_pop *) + (* in *) + let old_context_length = List.length context + 1 in + let witness_fun = + mkLetIn(Anonymous,make_refl_eq t1_typ t1,t, + mkApp(mkVar hyp_id,Array.init old_context_length (fun i -> mkRel (old_context_length - i))) + ) + in + let new_type_of_hyp,ctxt_size,witness_fun = + list_fold_left_i + (fun i (end_of_type,ctxt_size,witness_fun) ((x',b',t') as decl) -> + try + let witness = Intmap.find i sub in + if b' <> None then anomaly "can not redefine a rel!"; + (pop end_of_type,ctxt_size,mkLetIn(x',witness,t',witness_fun)) + with Not_found -> + (mkProd_or_LetIn decl end_of_type, ctxt_size + 1, mkLambda_or_LetIn decl witness_fun) + ) + 1 + (new_end_of_type,0,witness_fun) + context + in + let new_type_of_hyp = Reductionops.nf_betaiota new_type_of_hyp in + let new_ctxt,new_end_of_type = + Sign.decompose_prod_n_assum ctxt_size new_type_of_hyp + in + let prove_new_hyp : tactic = + tclTHEN + (tclDO ctxt_size intro) + (fun g -> + let all_ids = pf_ids_of_hyps g in + let new_ids,_ = list_chop ctxt_size all_ids in + let to_refine = applist(witness_fun,List.rev_map mkVar new_ids) in + refine to_refine g + ) + in + let simpl_eq_tac = + change_hyp_with_using "prove_pattern_simplification" hyp_id new_type_of_hyp prove_new_hyp + in +(* observe (str "In " ++ Ppconstr.pr_id hyp_id ++ *) +(* str "removing an equation " ++ fnl ()++ *) +(* str "old_typ_of_hyp :=" ++ *) +(* Printer.pr_lconstr_env *) +(* env *) +(* (it_mkProd_or_LetIn ~init:end_of_type ((x,None,t)::context)) *) +(* ++ fnl () ++ *) +(* str "new_typ_of_hyp := "++ *) +(* Printer.pr_lconstr_env env new_type_of_hyp ++ fnl () *) +(* ++ str "old context := " ++ pr_rel_context env context ++ fnl () *) +(* ++ str "new context := " ++ pr_rel_context env new_ctxt ++ fnl () *) +(* ++ str "old type := " ++ pr_lconstr end_of_type ++ fnl () *) +(* ++ str "new type := " ++ pr_lconstr new_end_of_type ++ fnl () *) +(* ); *) + new_ctxt,new_end_of_type,simpl_eq_tac + + +let is_property ptes_info t_x full_type_of_hyp = + if isApp t_x + then + let pte,args = destApp t_x in + if isVar pte && array_for_all closed0 args + then + try + let info = Idmap.find (destVar pte) ptes_info in + info.is_valid full_type_of_hyp + with Not_found -> false + else false + else false + +let isLetIn t = + match kind_of_term t with + | LetIn _ -> true + | _ -> false + + +let h_reduce_with_zeta = + h_reduce + (Rawterm.Cbv + {Rawterm.all_flags + with Rawterm.rDelta = false; + }) + + + +let rewrite_until_var arg_num eq_ids : tactic = + let test_var g = + let _,args = destApp (pf_concl g) in + not (isConstruct args.(arg_num)) + in + let rec do_rewrite eq_ids g = + if test_var g + then tclIDTAC g + else + match eq_ids with + | [] -> anomaly "Cannot find a way to prove recursive property"; + | eq_id::eq_ids -> + tclTHEN + (tclTRY (Equality.rewriteRL (mkVar eq_id))) + (do_rewrite eq_ids) + g + in + do_rewrite eq_ids + + +let rec_pte_id = id_of_string "Hrec" +let clean_hyp_with_heq ptes_infos eq_hyps hyp_id env sigma = + let coq_False = Coqlib.build_coq_False () in + let coq_True = Coqlib.build_coq_True () in + let coq_I = Coqlib.build_coq_I () in + let rec scan_type context type_of_hyp : tactic = + if isLetIn type_of_hyp then + let real_type_of_hyp = it_mkProd_or_LetIn ~init:type_of_hyp context in + let reduced_type_of_hyp = nf_betaiotazeta real_type_of_hyp in + (* length of context didn't change ? *) + let new_context,new_typ_of_hyp = + Sign.decompose_prod_n_assum (List.length context) reduced_type_of_hyp + in + tclTHENLIST + [ + h_reduce_with_zeta + (Tacticals.onHyp hyp_id) + ; + scan_type new_context new_typ_of_hyp + + ] + else if isProd type_of_hyp + then + begin + let (x,t_x,t') = destProd type_of_hyp in + let actual_real_type_of_hyp = it_mkProd_or_LetIn ~init:t' context in + if is_property ptes_infos t_x actual_real_type_of_hyp then + begin + let pte,pte_args = (destApp t_x) in + let (* fix_info *) prove_rec_hyp = (Idmap.find (destVar pte) ptes_infos).proving_tac in + let popped_t' = pop t' in + let real_type_of_hyp = it_mkProd_or_LetIn ~init:popped_t' context in + let prove_new_type_of_hyp = + let context_length = List.length context in + tclTHENLIST + [ + tclDO context_length intro; + (fun g -> + let context_hyps_ids = + fst (list_chop ~msg:"rec hyp : context_hyps" + context_length (pf_ids_of_hyps g)) + in + let rec_pte_id = pf_get_new_id rec_pte_id g in + let to_refine = + applist(mkVar hyp_id, + List.rev_map mkVar (rec_pte_id::context_hyps_ids) + ) + in + observe_tac "rec hyp " + (tclTHENS + (assert_as true (Genarg.IntroIdentifier rec_pte_id) t_x) + [observe_tac "prove rec hyp" (prove_rec_hyp eq_hyps); + observe_tac "prove rec hyp" + (refine to_refine) + ]) + g + ) + ] + in + tclTHENLIST + [ + observe_tac "hyp rec" + (change_hyp_with_using "rec_hyp_tac" hyp_id real_type_of_hyp prove_new_type_of_hyp); + scan_type context popped_t' + ] + end + else if eq_constr t_x coq_False then + begin +(* observe (str "Removing : "++ Ppconstr.pr_id hyp_id++ *) +(* str " since it has False in its preconds " *) +(* ); *) + raise TOREMOVE; (* False -> .. useless *) + end + else if is_incompatible_eq t_x then raise TOREMOVE (* t_x := C1 ... = C2 ... *) + else if eq_constr t_x coq_True (* Trivial => we remove this precons *) + then +(* observe (str "In "++Ppconstr.pr_id hyp_id++ *) +(* str " removing useless precond True" *) +(* ); *) + let popped_t' = pop t' in + let real_type_of_hyp = + it_mkProd_or_LetIn ~init:popped_t' context + in + let prove_trivial = + let nb_intro = List.length context in + tclTHENLIST [ + tclDO nb_intro intro; + (fun g -> + let context_hyps = + fst (list_chop ~msg:"removing True : context_hyps "nb_intro (pf_ids_of_hyps g)) + in + let to_refine = + applist (mkVar hyp_id, + List.rev (coq_I::List.map mkVar context_hyps) + ) + in + refine to_refine g + ) + ] + in + tclTHENLIST[ + change_hyp_with_using "prove_trivial" hyp_id real_type_of_hyp + (observe_tac "prove_trivial" prove_trivial); + scan_type context popped_t' + ] + else if is_trivial_eq t_x + then (* t_x := t = t => we remove this precond *) + let popped_t' = pop t' in + let real_type_of_hyp = + it_mkProd_or_LetIn ~init:popped_t' context + in + let _,args = destApp t_x in + tclTHENLIST + [ + change_hyp_with_using + "prove_trivial_eq" + hyp_id + real_type_of_hyp + (observe_tac "prove_trivial_eq" (prove_trivial_eq hyp_id context (args.(0),args.(1)))); + scan_type context popped_t' + ] + else + begin + try + let new_context,new_t',tac = change_eq env sigma hyp_id context x t_x t' in + tclTHEN + tac + (scan_type new_context new_t') + with Failure "NoChange" -> + (* Last thing todo : push the rel in the context and continue *) + scan_type ((x,None,t_x)::context) t' + end + end + else + tclIDTAC + in + try + scan_type [] (Typing.type_of env sigma (mkVar hyp_id)), [hyp_id] + with TOREMOVE -> + thin [hyp_id],[] + + +let clean_goal_with_heq ptes_infos continue_tac dyn_infos = + fun g -> + let env = pf_env g + and sigma = project g + in + let tac,new_hyps = + List.fold_left ( + fun (hyps_tac,new_hyps) hyp_id -> + let hyp_tac,new_hyp = + clean_hyp_with_heq ptes_infos dyn_infos.eq_hyps hyp_id env sigma + in + (tclTHEN hyp_tac hyps_tac),new_hyp@new_hyps + ) + (tclIDTAC,[]) + dyn_infos.rec_hyps + in + let new_infos = + { dyn_infos with + rec_hyps = new_hyps; + nb_rec_hyps = List.length new_hyps + } + in + tclTHENLIST + [ + tac ; + (continue_tac new_infos) + ] + g + +let heq_id = id_of_string "Heq" + +let treat_new_case ptes_infos nb_prod continue_tac term dyn_infos = + fun g -> + let heq_id = pf_get_new_id heq_id g in + let nb_first_intro = nb_prod - 1 - dyn_infos.nb_rec_hyps in + tclTHENLIST + [ + (* We first introduce the variables *) + tclDO nb_first_intro (intro_avoiding dyn_infos.rec_hyps); + (* Then the equation itself *) + introduction_no_check heq_id; + (* Then the new hypothesis *) + tclMAP introduction_no_check dyn_infos.rec_hyps; + 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 *) + let new_term_value = + match kind_of_term new_term_value_eq with + | App(f,[| _;_;args2 |]) -> args2 + | _ -> + observe (str "cannot compute new term value : " ++ pr_gls g' ++ fnl () ++ str "last hyp is" ++ + pr_lconstr_env (pf_env g') new_term_value_eq + ); + anomaly "cannot compute new term value" + in + let fun_body = + mkLambda(Anonymous, + pf_type_of g' term, + replace_term term (mkRel 1) dyn_infos.info + ) + in + let new_body = pf_nf_betaiota g' (mkApp(fun_body,[| new_term_value |])) in + let new_infos = + {dyn_infos with + info = new_body; + eq_hyps = heq_id::dyn_infos.eq_hyps + } + in + clean_goal_with_heq ptes_infos continue_tac new_infos g' + ) + ] + g + + +let instanciate_hyps_with_args (do_prove:identifier list -> tactic) hyps args_id = + let args = Array.of_list (List.map mkVar args_id) in + let instanciate_one_hyp hid = + tclORELSE + ( (* we instanciate the hyp if possible *) + fun g -> + let prov_hid = pf_get_new_id hid g in + tclTHENLIST[ + forward None (Genarg.IntroIdentifier prov_hid) (mkApp(mkVar hid,args)); + thin [hid]; + h_rename prov_hid hid + ] g + ) + ( (* + if not then we are in a mutual function block + and this hyp is a recursive hyp on an other function. + + We are not supposed to use it while proving this + principle so that we can trash it + + *) + (fun g -> +(* observe (str "Instanciation: removing hyp " ++ Ppconstr.pr_id hid); *) + thin [hid] g + ) + ) + in + if args_id = [] + then + tclTHENLIST [ + tclMAP (fun hyp_id -> h_reduce_with_zeta (Tacticals.onHyp hyp_id)) hyps; + do_prove hyps + ] + else + tclTHENLIST + [ + tclMAP (fun hyp_id -> h_reduce_with_zeta (Tacticals.onHyp hyp_id)) hyps; + tclMAP instanciate_one_hyp hyps; + (fun g -> + let all_g_hyps_id = + List.fold_right Idset.add (pf_ids_of_hyps g) Idset.empty + in + let remaining_hyps = + List.filter (fun id -> Idset.mem id all_g_hyps_id) hyps + in + do_prove remaining_hyps g + ) + ] + +let build_proof + (interactive_proof:bool) + (fnames:constant list) + ptes_infos + dyn_infos + : tactic = + let rec build_proof_aux do_finalize dyn_infos : tactic = + fun g -> + +(* observe (str "proving on " ++ Printer.pr_lconstr_env (pf_env g) term);*) + match kind_of_term dyn_infos.info with + | Case(_,_,t,_) -> + let g_nb_prod = nb_prod (pf_concl g) in + let type_of_term = pf_type_of g t in + let term_eq = + make_refl_eq type_of_term t + in + tclTHENSEQ + [ + h_generalize (term_eq::(List.map mkVar dyn_infos.rec_hyps)); + thin dyn_infos.rec_hyps; + pattern_option [[-1],t] None; + h_simplest_case t; + (fun g' -> + let g'_nb_prod = nb_prod (pf_concl g') in + let nb_instanciate_partial = g'_nb_prod - g_nb_prod in + observe_tac "treat_new_case" + (treat_new_case + ptes_infos + nb_instanciate_partial + (build_proof do_finalize) + t + dyn_infos) + g' + ) + + ] g + | Lambda(n,t,b) -> + begin + match kind_of_term( pf_concl g) with + | Prod _ -> + tclTHEN + intro + (fun g' -> + let (id,_,_) = pf_last_hyp g' in + let new_term = + pf_nf_betaiota g' + (mkApp(dyn_infos.info,[|mkVar id|])) + in + let new_infos = {dyn_infos with info = new_term} in + let do_prove new_hyps = + build_proof do_finalize + {new_infos with + rec_hyps = new_hyps; + nb_rec_hyps = List.length new_hyps + } + in + observe_tac "Lambda" (instanciate_hyps_with_args do_prove new_infos.rec_hyps [id]) g' + (* build_proof do_finalize new_infos g' *) + ) g + | _ -> + do_finalize dyn_infos g + end + | Cast(t,_,_) -> + build_proof do_finalize {dyn_infos with info = t} g + | Const _ | Var _ | Meta _ | Evar _ | Sort _ | Construct _ | Ind _ -> + do_finalize dyn_infos g + | App(_,_) -> + let f,args = decompose_app dyn_infos.info in + begin + match kind_of_term f with + | App _ -> assert false (* we have collected all the app in decompose_app *) + | Var _ | Construct _ | Rel _ | Evar _ | Meta _ | Ind _ | Sort _ | Prod _ -> + let new_infos = + { dyn_infos with + info = (f,args) + } + in + build_proof_args do_finalize new_infos g + | Const c when not (List.mem c fnames) -> + let new_infos = + { dyn_infos with + info = (f,args) + } + in +(* Pp.msgnl (str "proving in " ++ pr_lconstr_env (pf_env g) dyn_infos.info); *) + build_proof_args do_finalize new_infos g + | Const _ -> + do_finalize dyn_infos g + | Lambda _ -> + let new_term = Reductionops.nf_beta dyn_infos.info in + build_proof do_finalize {dyn_infos with info = new_term} + g + | LetIn _ -> + let new_infos = + { dyn_infos with info = nf_betaiotazeta dyn_infos.info } + in + + tclTHENLIST + [tclMAP + (fun hyp_id -> h_reduce_with_zeta (Tacticals.onHyp hyp_id)) + dyn_infos.rec_hyps; + h_reduce_with_zeta Tacticals.onConcl; + build_proof do_finalize new_infos + ] + g + | Cast(b,_,_) -> + build_proof do_finalize {dyn_infos with info = b } g + | Case _ | Fix _ | CoFix _ -> + let new_finalize dyn_infos = + let new_infos = + { dyn_infos with + info = dyn_infos.info,args + } + in + build_proof_args do_finalize new_infos + in + build_proof new_finalize {dyn_infos with info = f } g + end + | Fix _ | CoFix _ -> + error ( "Anonymous local (co)fixpoints are not handled yet") + + | Prod _ -> error "Prod" + | LetIn _ -> + let new_infos = + { dyn_infos with + info = nf_betaiotazeta dyn_infos.info + } + in + + tclTHENLIST + [tclMAP + (fun hyp_id -> h_reduce_with_zeta (Tacticals.onHyp hyp_id)) + dyn_infos.rec_hyps; + h_reduce_with_zeta Tacticals.onConcl; + build_proof do_finalize new_infos + ] g + | Rel _ -> anomaly "Free var in goal conclusion !" + and build_proof do_finalize dyn_infos g = +(* observe (str "proving with "++Printer.pr_lconstr dyn_infos.info++ str " on goal " ++ pr_gls g); *) + (build_proof_aux do_finalize dyn_infos) g + and build_proof_args do_finalize dyn_infos (* f_args' args *) :tactic = + fun g -> +(* if Tacinterp.get_debug () <> Tactic_debug.DebugOff *) +(* then msgnl (str "build_proof_args with " ++ *) +(* pr_lconstr_env (pf_env g) f_args' *) +(* ); *) + let (f_args',args) = dyn_infos.info in + let tac : tactic = + fun g -> + match args with + | [] -> + do_finalize {dyn_infos with info = f_args'} g + | arg::args -> +(* observe (str "build_proof_args with arg := "++ pr_lconstr_env (pf_env g) arg++ *) +(* fnl () ++ *) +(* pr_goal (Tacmach.sig_it g) *) +(* ); *) + let do_finalize dyn_infos = + let new_arg = dyn_infos.info in + (* tclTRYD *) + (build_proof_args + do_finalize + {dyn_infos with info = (mkApp(f_args',[|new_arg|])), args} + ) + in + build_proof do_finalize + {dyn_infos with info = arg } + g + in + observe_tac "build_proof_args" (tac ) g + in + let do_finish_proof dyn_infos = + (* tclTRYD *) (clean_goal_with_heq + ptes_infos + finish_proof dyn_infos) + in + observe_tac "build_proof" + (build_proof do_finish_proof dyn_infos) + + + + + + + + + + + + +(* Proof of principles from structural functions *) +let is_pte_type t = + isSort (snd (decompose_prod t)) + +let is_pte (_,_,t) = is_pte_type t + + + + +type static_fix_info = + { + idx : int; + name : identifier; + types : types; + offset : int; + nb_realargs : int; + body_with_param : constr + } + + + +let prove_rec_hyp_for_struct fix_info = + (fun eq_hyps -> tclTHEN + (rewrite_until_var (fix_info.idx) eq_hyps) + (fun g -> + let _,pte_args = destApp (pf_concl g) in + let rec_hyp_proof = + mkApp(mkVar fix_info.name,array_get_start pte_args) + in + refine rec_hyp_proof g + )) + +let prove_rec_hyp fix_info = + { proving_tac = prove_rec_hyp_for_struct fix_info + ; + is_valid = fun _ -> true + } + + +exception Not_Rec + +let generalize_non_dep hyp g = + let hyps = [hyp] in + let env = Global.env () in + let hyp_typ = pf_type_of g (mkVar hyp) in + let to_revert,_ = + Environ. fold_named_context_reverse (fun (clear,keep) (hyp,_,_ as decl) -> + if List.mem hyp hyps + or List.exists (occur_var_in_decl env hyp) keep + or occur_var env hyp hyp_typ + or Termops.is_section_variable hyp (* should be dangerous *) + then (clear,decl::keep) + else (hyp::clear,keep)) + ~init:([],[]) (pf_env g) + in +(* observe (str "to_revert := " ++ prlist_with_sep spc Ppconstr.pr_id to_revert); *) + tclTHEN + (observe_tac "h_generalize" (h_generalize (List.map mkVar to_revert))) + (observe_tac "thin" (thin to_revert)) + g + +let id_of_decl (na,_,_) = (Nameops.out_name na) +let var_of_decl decl = mkVar (id_of_decl decl) +let revert idl = + tclTHEN + (generalize (List.map mkVar idl)) + (thin idl) + + +let do_replace params rec_arg_num rev_args_id fun_to_replace body = + fun g -> + let nb_intro_to_do = nb_prod (pf_concl g) in + tclTHEN + (tclDO nb_intro_to_do intro) + ( + fun g' -> + let just_introduced = nLastHyps nb_intro_to_do g' in + let just_introduced_id = List.map (fun (id,_,_) -> id) just_introduced in + let old_rev_args_id = rev_args_id in + let rev_args_id = just_introduced_id@rev_args_id in + let to_replace = + Reductionops.nf_betaiota (substl (List.map mkVar rev_args_id) fun_to_replace ) + and by = + Reductionops.nf_betaiota (applist(body,List.rev_map mkVar rev_args_id)) + in +(* observe (str "to_replace := " ++ pr_lconstr_env (pf_env g') to_replace); *) +(* observe (str "by := " ++ pr_lconstr_env (pf_env g') by); *) + let prove_replacement = + let rec_id = List.nth (List.rev old_rev_args_id) (rec_arg_num) in + observe_tac "prove_replacement" + (tclTHENSEQ + [ + revert just_introduced_id; + keep ((List.map id_of_decl params)@ old_rev_args_id); + generalize_non_dep rec_id; + observe_tac "h_case" (h_case(mkVar rec_id,Rawterm.NoBindings)); + intros_reflexivity + ] + ) + in + tclTHENS + (observe_tac "replacement" (Equality.replace to_replace by)) + [ revert just_introduced_id; + tclSOLVE [prove_replacement]] + g' + ) + g + + + +let prove_princ_for_struct interactive_proof fun_num fnames all_funs _nparams : tactic = + fun g -> + let princ_type = pf_concl g in + let princ_info = compute_elim_sig princ_type in + let fresh_id = + let avoid = ref (pf_ids_of_hyps g) in + (fun na -> + let new_id = + match na with + Name id -> fresh_id !avoid (string_of_id id) + | Anonymous -> fresh_id !avoid "H" + in + avoid := new_id :: !avoid; + (Name new_id) + ) + in + let fresh_decl = + (fun (na,b,t) -> + (fresh_id na,b,t) + ) + in + let princ_info : elim_scheme = + { princ_info with + params = List.map fresh_decl princ_info.params; + predicates = List.map fresh_decl princ_info.predicates; + branches = List.map fresh_decl princ_info.branches; + args = List.map fresh_decl princ_info.args + } + in + let get_body const = + match (Global.lookup_constant const ).const_body with + | Some b -> + let body = force b in + Tacred.cbv_norm_flags + (Closure.RedFlags.mkflags [Closure.RedFlags.fZETA]) + (Global.env ()) + (Evd.empty) + body + | None -> error ( "Cannot define a principle over an axiom ") + in + let fbody = get_body fnames.(fun_num) in + let f_ctxt,f_body = decompose_lam fbody in + let f_ctxt_length = List.length f_ctxt in + let diff_params = princ_info.nparams - f_ctxt_length in + let full_params,princ_params,fbody_with_full_params = + if diff_params > 0 + then + let princ_params,full_params = + list_chop diff_params princ_info.params + in + (full_params, (* real params *) + princ_params, (* the params of the principle which are not params of the function *) + substl (* function instanciated with real params *) + (List.map var_of_decl full_params) + f_body + ) + else + let f_ctxt_other,f_ctxt_params = + list_chop (- diff_params) f_ctxt in + let f_body = compose_lam f_ctxt_other f_body in + (princ_info.params, (* real params *) + [],(* all params are full params *) + substl (* function instanciated with real params *) + (List.map var_of_decl princ_info.params) + f_body + ) + in +(* observe (str "full_params := " ++ *) +(* prlist_with_sep spc (fun (na,_,_) -> Ppconstr.pr_id (Nameops.out_name na)) *) +(* full_params *) +(* ); *) +(* observe (str "princ_params := " ++ *) +(* prlist_with_sep spc (fun (na,_,_) -> Ppconstr.pr_id (Nameops.out_name na)) *) +(* princ_params *) +(* ); *) +(* observe (str "fbody_with_full_params := " ++ *) +(* pr_lconstr fbody_with_full_params *) +(* ); *) + let all_funs_with_full_params = + Array.map (fun f -> applist(f, List.rev_map var_of_decl full_params)) all_funs + in + let fix_offset = List.length princ_params in + let ptes_to_fix,infos = + match kind_of_term fbody_with_full_params with + | Fix((idxs,i),(names,typess,bodies)) -> + let bodies_with_all_params = + Array.map + (fun body -> + Reductionops.nf_betaiota + (applist(substl (List.rev (Array.to_list all_funs_with_full_params)) body, + List.rev_map var_of_decl princ_params)) + ) + bodies + in + let info_array = + Array.mapi + (fun i types -> + let types = prod_applist types (List.rev_map var_of_decl princ_params) in + { idx = idxs.(i) - fix_offset; + name = Nameops.out_name (fresh_id names.(i)); + types = types; + offset = fix_offset; + nb_realargs = + List.length + (fst (decompose_lam bodies.(i))) - fix_offset; + body_with_param = bodies_with_all_params.(i) + } + ) + typess + in + let pte_to_fix,rev_info = + list_fold_left_i + (fun i (acc_map,acc_info) (pte,_,_) -> + let infos = info_array.(i) in + let type_args,_ = decompose_prod infos.types in + let nargs = List.length type_args in + let f = applist(mkConst fnames.(i), List.rev_map var_of_decl princ_info.params) in + let first_args = Array.init nargs (fun i -> mkRel (nargs -i)) in + let app_f = mkApp(f,first_args) in + let pte_args = (Array.to_list first_args)@[app_f] in + let app_pte = applist(mkVar (Nameops.out_name pte),pte_args) in + let body_with_param = + let body = get_body fnames.(i) in + let body_with_full_params = + Reductionops.nf_betaiota ( + applist(body,List.rev_map var_of_decl full_params)) + in + match kind_of_term body_with_full_params with + | Fix((_,num),(_,_,bs)) -> + Reductionops.nf_betaiota + ( + (applist + (substl + (List.rev + (Array.to_list all_funs_with_full_params)) + bs.(num), + List.rev_map var_of_decl princ_params)) + ) + | _ -> error "Not a mutual block" + in + let info = + {infos with + types = compose_prod type_args app_pte; + body_with_param = body_with_param + } + in +(* observe (str "binding " ++ Ppconstr.pr_id (Nameops.out_name pte) ++ *) +(* str " to " ++ Ppconstr.pr_id info.name); *) + (Idmap.add (Nameops.out_name pte) info acc_map,info::acc_info) + ) + 0 + (Idmap.empty,[]) + (List.rev princ_info.predicates) + in + pte_to_fix,List.rev rev_info + | _ -> Idmap.empty,[] + in + let mk_fixes : tactic = + let pre_info,infos = list_chop fun_num infos in + match pre_info,infos with + | [],[] -> tclIDTAC + | _, this_fix_info::others_infos -> + let other_fix_infos = + List.map + (fun fi -> fi.name,fi.idx + 1 ,fi.types) + (pre_info@others_infos) + in + if other_fix_infos = [] + then + observe_tac ("h_fix") (h_fix (Some this_fix_info.name) (this_fix_info.idx +1)) + else + h_mutual_fix this_fix_info.name (this_fix_info.idx + 1) + other_fix_infos + | _ -> anomaly "Not a valid information" + in + let first_tac : tactic = (* every operations until fix creations *) + tclTHENSEQ + [ observe_tac "introducing params" (intros_using (List.rev_map id_of_decl princ_info.params)); + observe_tac "introducing predictes" (intros_using (List.rev_map id_of_decl princ_info.predicates)); + observe_tac "introducing branches" (intros_using (List.rev_map id_of_decl princ_info.branches)); + observe_tac "building fixes" mk_fixes; + ] + in + let intros_after_fixes : tactic = + fun gl -> + let ctxt,pte_app = (Sign.decompose_prod_assum (pf_concl gl)) in + let pte,pte_args = (decompose_app pte_app) in + try + let pte = try destVar pte with _ -> anomaly "Property is not a variable" in + let fix_info = Idmap.find pte ptes_to_fix in + let nb_args = fix_info.nb_realargs in + tclTHENSEQ + [ + observe_tac ("introducing args") (tclDO nb_args intro); + (fun g -> (* replacement of the function by its body *) + let args = nLastHyps nb_args g in + let fix_body = fix_info.body_with_param in +(* observe (str "fix_body := "++ pr_lconstr_env (pf_env gl) fix_body); *) + let args_id = List.map (fun (id,_,_) -> id) args in + let dyn_infos = + { + nb_rec_hyps = -100; + rec_hyps = []; + info = + Reductionops.nf_betaiota + (applist(fix_body,List.rev_map mkVar args_id)); + eq_hyps = [] + } + in + tclTHENSEQ + [ + observe_tac "do_replace" + (do_replace princ_info.params fix_info.idx args_id + (List.hd (List.rev pte_args)) fix_body); + let do_prove = + build_proof + interactive_proof + (Array.to_list fnames) + (Idmap.map prove_rec_hyp ptes_to_fix) + in + let prove_tac branches = + let dyn_infos = + {dyn_infos with + rec_hyps = branches; + nb_rec_hyps = List.length branches + } + in + clean_goal_with_heq + (Idmap.map prove_rec_hyp ptes_to_fix) + do_prove + dyn_infos + in +(* observe (str "branches := " ++ *) +(* prlist_with_sep spc (fun decl -> Ppconstr.pr_id (id_of_decl decl)) princ_info.branches); *) + observe_tac "instancing" (instanciate_hyps_with_args prove_tac + (List.rev_map id_of_decl princ_info.branches) + (List.rev args_id)) + ] + g + ); + ] gl + with Not_found -> + let nb_args = min (princ_info.nargs) (List.length ctxt) in + tclTHENSEQ + [ + tclDO nb_args intro; + (fun g -> (* replacement of the function by its body *) + let args = nLastHyps nb_args g in + let args_id = List.map (fun (id,_,_) -> id) args in + let dyn_infos = + { + nb_rec_hyps = -100; + rec_hyps = []; + info = + Reductionops.nf_betaiota + (applist(fbody_with_full_params, + (List.rev_map var_of_decl princ_params)@ + (List.rev_map mkVar args_id) + )); + eq_hyps = [] + } + in + let fname = destConst (fst (decompose_app (List.hd (List.rev pte_args)))) in + tclTHENSEQ + [unfold_in_concl [([],Names.EvalConstRef fname)]; + let do_prove = + build_proof + interactive_proof + (Array.to_list fnames) + (Idmap.map prove_rec_hyp ptes_to_fix) + in + let prove_tac branches = + let dyn_infos = + {dyn_infos with + rec_hyps = branches; + nb_rec_hyps = List.length branches + } + in + clean_goal_with_heq + (Idmap.map prove_rec_hyp ptes_to_fix) + do_prove + dyn_infos + in + instanciate_hyps_with_args prove_tac + (List.rev_map id_of_decl princ_info.branches) + (List.rev args_id) + ] + g + ) + ] + gl + in + tclTHEN + first_tac + intros_after_fixes + g + + + + + + +(* Proof of principles of general functions *) +let h_id = Recdef.h_id +and hrec_id = Recdef.hrec_id +and acc_inv_id = Recdef.acc_inv_id +and ltof_ref = Recdef.ltof_ref +and acc_rel = Recdef.acc_rel +and well_founded = Recdef.well_founded +and delayed_force = Recdef.delayed_force +and h_intros = Recdef.h_intros +and list_rewrite = Recdef.list_rewrite +and evaluable_of_global_reference = Recdef.evaluable_of_global_reference + +let prove_with_tcc tcc_lemma_constr eqs : tactic = + match !tcc_lemma_constr with + | None -> anomaly "No tcc proof !!" + | Some lemma -> + fun gls -> + let hid = next_global_ident_away true h_id (pf_ids_of_hyps gls) in + tclTHENSEQ + [ + generalize [lemma]; + h_intro hid; + Elim.h_decompose_and (mkVar hid); + tclTRY(list_rewrite true eqs); + Eauto.gen_eauto false (false,5) [] (Some []) + ] + gls + + +let backtrack_eqs_until_hrec hrec eqs : tactic = + fun gls -> + let rewrite = + tclFIRST (List.map Equality.rewriteRL eqs ) + in + let _,hrec_concl = decompose_prod (pf_type_of gls (mkVar hrec)) in + let f_app = array_last (snd (destApp hrec_concl)) in + let f = (fst (destApp f_app)) in + let rec backtrack : tactic = + fun g -> + let f_app = array_last (snd (destApp (pf_concl g))) in + match kind_of_term f_app with + | App(f',_) when eq_constr f' f -> tclIDTAC g + | _ -> tclTHEN rewrite backtrack g + in + backtrack gls + + + + + +let new_prove_with_tcc is_mes acc_inv hrec tcc_lemma_constr eqs : tactic = + match !tcc_lemma_constr with + | None -> tclIDTAC_MESSAGE (str "No tcc proof !!") + | Some lemma -> + fun gls -> + let hid = next_global_ident_away true Recdef.h_id (pf_ids_of_hyps gls) in + (tclTHENSEQ + [ + generalize [lemma]; + h_intro hid; + Elim.h_decompose_and (mkVar hid); + backtrack_eqs_until_hrec hrec eqs; + tclCOMPLETE (tclTHENS (* We must have exactly ONE subgoal !*) + (apply (mkVar hrec)) + [ tclTHENSEQ + [ + thin [hrec]; + apply (Lazy.force acc_inv); + (fun g -> + if is_mes + then + unfold_in_concl [([], evaluable_of_global_reference (delayed_force ltof_ref))] g + else tclIDTAC g + ); + tclTRY(Recdef.list_rewrite true eqs); + observe_tac "finishing" (tclCOMPLETE (Eauto.gen_eauto false (false,5) [] (Some []))) + ] + ] + ) + ]) + gls + + +let is_valid_hypothesis predicates_name = + let predicates_name = List.fold_right Idset.add predicates_name Idset.empty in + let is_pte typ = + if isApp typ + then + let pte,_ = destApp typ in + if isVar pte + then Idset.mem (destVar pte) predicates_name + else false + else false + in + let rec is_valid_hypothesis typ = + is_pte typ || + match kind_of_term typ with + | Prod(_,pte,typ') -> is_pte pte && is_valid_hypothesis typ' + | _ -> false + in + is_valid_hypothesis + +let fresh_id avoid na = + let id = + match na with + | Name id -> id + | Anonymous -> h_id + in + next_global_ident_away true id avoid + + +let prove_principle_for_gen + (f_ref,functional_ref,eq_ref) tcc_lemma_ref is_mes + rec_arg_num rec_arg_type relation = + fun g -> + let type_of_goal = pf_concl g in + let goal_ids = pf_ids_of_hyps g in + let goal_elim_infos = compute_elim_sig type_of_goal in + let params_names,ids = List.fold_left + (fun (params_names,avoid) (na,_,_) -> + let new_id = fresh_id avoid na in + (new_id::params_names,new_id::avoid) + ) + ([],goal_ids) + goal_elim_infos.params + in + let predicates_names,ids = + List.fold_left + (fun (predicates_names,avoid) (na,_,_) -> + let new_id = fresh_id avoid na in + (new_id::predicates_names,new_id::avoid) + ) + ([],ids) + goal_elim_infos.predicates + in + let branches_names,ids = + List.fold_left + (fun (branches_names,avoid) (na,_,_) -> + let new_id = fresh_id avoid na in + (new_id::branches_names,new_id::avoid) + ) + ([],ids) + goal_elim_infos.branches + in + let to_intro = params_names@predicates_names@branches_names in + let nparams = List.length params_names in + let rec_arg_num = rec_arg_num - nparams in + let tac_intro_static = h_intros to_intro in + let args_info = ref None in + let arg_tac g = (* introducing args *) + let ids = pf_ids_of_hyps g in + let func_body = def_of_const (mkConst functional_ref) in + (* let _ = Pp.msgnl (Printer.pr_lconstr func_body) in *) + let (f_name, _, body1) = destLambda func_body in + let f_id = + match f_name with + | Name f_id -> next_global_ident_away true f_id ids + | Anonymous -> anomaly "anonymous function" + in + let n_names_types,_ = decompose_lam body1 in + let n_ids,ids = + List.fold_left + (fun (n_ids,ids) (n_name,_) -> + match n_name with + | Name id -> + let n_id = next_global_ident_away true id ids in + n_id::n_ids,n_id::ids + | _ -> anomaly "anonymous argument" + ) + ([],(f_id::ids)) + n_names_types + in + let rec_arg_id = List.nth n_ids (rec_arg_num - 1 ) in + let args_ids = snd (list_chop nparams n_ids) in + args_info := Some (ids,args_ids,rec_arg_id); + h_intros args_ids g + in + let wf_tac = + if is_mes + then + Recdef.tclUSER_if_not_mes + else fun _ -> prove_with_tcc tcc_lemma_ref [] + in + let start_tac g = + let ids,args_ids,rec_arg_id = out_some !args_info in + let nargs = List.length args_ids in + let pre_rec_arg = + List.rev_map + mkVar + (fst (list_chop (rec_arg_num - 1) args_ids)) + in + let args_before_rec = pre_rec_arg@(List.map mkVar params_names) in + let relation = substl args_before_rec relation in + let input_type = substl args_before_rec rec_arg_type in + let wf_thm = next_global_ident_away true (id_of_string ("wf_R")) ids in + let wf_rec_arg = + next_global_ident_away true + (id_of_string ("Acc_"^(string_of_id rec_arg_id))) + (wf_thm::ids) + in + let hrec = next_global_ident_away true hrec_id (wf_rec_arg::wf_thm::ids) in + let acc_inv = + lazy ( + mkApp ( + delayed_force acc_inv_id, + [|input_type;relation;mkVar rec_arg_id|] + ) + ) + in + (tclTHENS + (observe_tac + "first assert" + (assert_tac + true (* the assert thm is in first subgoal *) + (Name wf_rec_arg) + (mkApp (delayed_force acc_rel, + [|input_type;relation;mkVar rec_arg_id|]) + ) + ) + ) + [ + (* accesibility proof *) + tclTHENS + (observe_tac + "second assert" + (assert_tac + true + (Name wf_thm) + (mkApp (delayed_force well_founded,[|input_type;relation|])) + ) + ) + [ + (* interactive proof of the well_foundness of the relation *) + wf_tac is_mes; + (* well_foundness -> Acc for any element *) + observe_tac + "apply wf_thm" + (h_apply ((mkApp(mkVar wf_thm, + [|mkVar rec_arg_id |])),Rawterm.NoBindings) + ) + ] + ; + (* rest of the proof *) + tclTHENSEQ + [ + observe_tac "generalize" (fun g -> + let to_thin = + fst (list_chop ( nargs + 1) (pf_ids_of_hyps g)) + in + let to_thin_c = List.rev_map mkVar to_thin in + tclTHEN (generalize to_thin_c) (observe_tac "thin" (h_clear false to_thin)) g + ); + observe_tac "h_fix" (h_fix (Some hrec) (nargs+1)); + h_intros args_ids; + h_intro wf_rec_arg; + Equality.rewriteLR (mkConst eq_ref); + (fun g' -> + let body = + let _,args = destApp (pf_concl g') in + array_last args + in + let body_info rec_hyps = + { + nb_rec_hyps = List.length rec_hyps; + rec_hyps = rec_hyps; + eq_hyps = []; + info = body + } + in + let acc_inv = lazy (mkApp(Lazy.force acc_inv, [|mkVar wf_rec_arg|]) ) in + let pte_info = + { proving_tac = + (fun eqs -> + observe_tac "prove_with_tcc" + (new_prove_with_tcc is_mes acc_inv hrec tcc_lemma_ref (List.map mkVar eqs)) + ); + is_valid = is_valid_hypothesis predicates_names + } + in + let ptes_info : pte_info Idmap.t = + List.fold_left + (fun map pte_id -> + Idmap.add pte_id + pte_info + map + ) + Idmap.empty + predicates_names + in + let make_proof rec_hyps = + build_proof + false + [f_ref] + ptes_info + (body_info rec_hyps) + in + instanciate_hyps_with_args + make_proof + branches_names + args_ids + g' + + ) + ] + ] + g + ) + in + tclTHENSEQ + [tac_intro_static; + arg_tac; + start_tac + ] g + + + + + + + + + + + + + + + diff --git a/contrib/funind/functional_principles_proofs.mli b/contrib/funind/functional_principles_proofs.mli new file mode 100644 index 00000000..35da5d50 --- /dev/null +++ b/contrib/funind/functional_principles_proofs.mli @@ -0,0 +1,20 @@ +open Names +open Term + +val prove_princ_for_struct : + bool -> + int -> constant array -> constr array -> int -> Tacmach.tactic + + +val prove_principle_for_gen : + constant*constant*constant -> (* name of the function, the fonctionnal and the fixpoint equation *) + constr option ref -> (* a pointer to the obligation proofs lemma *) + bool -> (* is that function uses measure *) + int -> (* the number of recursive argument *) + types -> (* the type of the recursive argument *) + constr -> (* the wf relation used to prove the function *) + Tacmach.tactic + + +val is_pte : rel_declaration -> bool +val do_observe : unit -> bool diff --git a/contrib/funind/functional_principles_types.ml b/contrib/funind/functional_principles_types.ml new file mode 100644 index 00000000..8ef13264 --- /dev/null +++ b/contrib/funind/functional_principles_types.ml @@ -0,0 +1,562 @@ +open Printer +open Util +open Term +open Termops +open Names +open Declarations +open Pp +open Entries +open Hiddentac +open Evd +open Tacmach +open Proof_type +open Tacticals +open Tactics +open Indfun_common +open Functional_principles_proofs + +exception Toberemoved_with_rel of int*constr +exception Toberemoved + + + + + +(* + Transform an inductive induction principle into + a functional one +*) +let compute_new_princ_type_from_rel rel_to_fun sorts princ_type = + let princ_type_info = compute_elim_sig princ_type in + let env = Global.env () in + let change_predicate_sort i (x,_,t) = + let new_sort = sorts.(i) in + let args,_ = decompose_prod t in + let real_args = + if princ_type_info.indarg_in_concl + then List.tl args + else args + in + x,None,compose_prod real_args (mkSort new_sort) + in + let new_predicates = + list_map_i + change_predicate_sort + 0 + princ_type_info.predicates + in + let env_with_params_and_predicates = + Environ.push_rel_context + new_predicates + (Environ.push_rel_context + princ_type_info.params + env + ) + in + let rel_as_kn = + fst (match princ_type_info.indref with + | Some (Libnames.IndRef ind) -> ind + | _ -> failwith "Not a valid predicate" + ) + in + let pre_princ = + it_mkProd_or_LetIn + ~init: + (it_mkProd_or_LetIn + ~init:(option_fold_right + mkProd_or_LetIn + princ_type_info.indarg + princ_type_info.concl + ) + princ_type_info.args + ) + princ_type_info.branches + in + let is_dom c = + match kind_of_term c with + | Ind((u,_)) -> u = rel_as_kn + | Construct((u,_),_) -> u = rel_as_kn + | _ -> false + in + let get_fun_num c = + match kind_of_term c with + | Ind(_,num) -> num + | Construct((_,num),_) -> num + | _ -> assert false + in + let dummy_var = mkVar (id_of_string "________") in + let mk_replacement c i args = + let res = mkApp(rel_to_fun.(i),Array.map pop (array_get_start args)) in +(* observe (str "replacing " ++ pr_lconstr c ++ str " by " ++ pr_lconstr res); *) + res + in + let rec has_dummy_var t = + fold_constr + (fun b t -> b || (eq_constr t dummy_var) || (has_dummy_var t)) + false + t + in + let rec compute_new_princ_type remove env pre_princ : types*(constr list) = + let (new_princ_type,_) as res = + match kind_of_term pre_princ with + | Rel n -> + begin + try match Environ.lookup_rel n env with + | _,_,t when is_dom t -> raise Toberemoved + | _ -> pre_princ,[] with Not_found -> assert false + end + | Prod(x,t,b) -> + compute_new_princ_type_for_binder remove mkProd env x t b + | Lambda(x,t,b) -> + compute_new_princ_type_for_binder remove mkLambda env x t b + | Ind _ | Construct _ when is_dom pre_princ -> raise Toberemoved + | App(f,args) when is_dom f -> + let var_to_be_removed = destRel (array_last args) in + let num = get_fun_num f in + raise (Toberemoved_with_rel (var_to_be_removed,mk_replacement pre_princ num args)) + | App(f,args) -> + let is_pte = + match kind_of_term f with + | Rel n -> + is_pte (Environ.lookup_rel n env) + | _ -> false + in + let args = + if is_pte && remove + then array_get_start args + else args + in + let new_args,binders_to_remove = + Array.fold_right (compute_new_princ_type_with_acc remove env) + args + ([],[]) + in + let new_f,binders_to_remove_from_f = compute_new_princ_type remove env f in + applist(new_f, new_args), + list_union_eq eq_constr binders_to_remove_from_f binders_to_remove + | LetIn(x,v,t,b) -> + compute_new_princ_type_for_letin remove env x v t b + | _ -> pre_princ,[] + in +(* observennl ( *) +(* match kind_of_term pre_princ with *) +(* | Prod _ -> *) +(* str "compute_new_princ_type for "++ *) +(* pr_lconstr_env env pre_princ ++ *) +(* str" is "++ *) +(* pr_lconstr_env env new_princ_type ++ fnl () *) +(* | _ -> str "" *) +(* ); *) + res + + and compute_new_princ_type_for_binder remove bind_fun env x t b = + begin + try + let new_t,binders_to_remove_from_t = compute_new_princ_type remove env t in + let new_x : name = get_name (ids_of_context env) x in + let new_env = Environ.push_rel (x,None,t) env in + let new_b,binders_to_remove_from_b = compute_new_princ_type remove new_env b in + if List.exists (eq_constr (mkRel 1)) binders_to_remove_from_b + then (pop new_b),filter_map (eq_constr (mkRel 1)) pop binders_to_remove_from_b + else + ( + bind_fun(new_x,new_t,new_b), + list_union_eq + eq_constr + binders_to_remove_from_t + (List.map pop binders_to_remove_from_b) + ) + + with + | Toberemoved -> +(* msgnl (str "Decl of "++Ppconstr.pr_name x ++ str " is removed "); *) + let new_b,binders_to_remove_from_b = compute_new_princ_type remove env (substnl [dummy_var] 1 b) in + new_b, List.map pop binders_to_remove_from_b + | Toberemoved_with_rel (n,c) -> +(* msgnl (str "Decl of "++Ppconstr.pr_name x ++ str " is removed "); *) + let new_b,binders_to_remove_from_b = compute_new_princ_type remove env (substnl [c] n b) in + new_b, list_add_set_eq eq_constr (mkRel n) (List.map pop binders_to_remove_from_b) + end + and compute_new_princ_type_for_letin remove env x v t b = + begin + try + let new_t,binders_to_remove_from_t = compute_new_princ_type remove env t in + let new_v,binders_to_remove_from_v = compute_new_princ_type remove env v in + let new_x : name = get_name (ids_of_context env) x in + let new_env = Environ.push_rel (x,Some v,t) env in + let new_b,binders_to_remove_from_b = compute_new_princ_type remove new_env b in + if List.exists (eq_constr (mkRel 1)) binders_to_remove_from_b + then (pop new_b),filter_map (eq_constr (mkRel 1)) pop binders_to_remove_from_b + else + ( + mkLetIn(new_x,new_v,new_t,new_b), + list_union_eq + eq_constr + (list_union_eq eq_constr binders_to_remove_from_t binders_to_remove_from_v) + (List.map pop binders_to_remove_from_b) + ) + + with + | Toberemoved -> +(* msgnl (str "Decl of "++Ppconstr.pr_name x ++ str " is removed "); *) + let new_b,binders_to_remove_from_b = compute_new_princ_type remove env (substnl [dummy_var] 1 b) in + new_b, List.map pop binders_to_remove_from_b + | Toberemoved_with_rel (n,c) -> +(* msgnl (str "Decl of "++Ppconstr.pr_name x ++ str " is removed "); *) + let new_b,binders_to_remove_from_b = compute_new_princ_type remove env (substnl [c] n b) in + new_b, list_add_set_eq eq_constr (mkRel n) (List.map pop binders_to_remove_from_b) + end + and compute_new_princ_type_with_acc remove env e (c_acc,to_remove_acc) = + let new_e,to_remove_from_e = compute_new_princ_type remove env e + in + new_e::c_acc,list_union_eq eq_constr to_remove_from_e to_remove_acc + in +(* observe (str "Computing new principe from " ++ pr_lconstr_env env_with_params_and_predicates pre_princ); *) + let pre_res,_ = + compute_new_princ_type princ_type_info.indarg_in_concl env_with_params_and_predicates pre_princ in + it_mkProd_or_LetIn + ~init:(it_mkProd_or_LetIn ~init:pre_res new_predicates) + princ_type_info.params + + + +let change_property_sort toSort princ princName = + let princ_info = compute_elim_sig princ in + let change_sort_in_predicate (x,v,t) = + (x,None, + let args,_ = decompose_prod t in + compose_prod args (mkSort toSort) + ) + in + let princName_as_constr = Tacinterp.constr_of_id (Global.env ()) princName in + let init = + let nargs = (princ_info.nparams + (List.length princ_info.predicates)) in + mkApp(princName_as_constr, + Array.init nargs + (fun i -> mkRel (nargs - i ))) + in + it_mkLambda_or_LetIn + ~init: + (it_mkLambda_or_LetIn ~init + (List.map change_sort_in_predicate princ_info.predicates) + ) + princ_info.params + + +let pp_dur time time' = + str (string_of_float (System.time_difference time time')) + +(* End of things to be removed latter : just here to compare + saving proof with and without normalizing the proof +*) + +let qed () = Command.save_named true +let defined () = Command.save_named false +let generate_functional_principle + interactive_proof + old_princ_type sorts new_princ_name funs i proof_tac + = + let f = funs.(i) in + let type_sort = Termops.new_sort_in_family InType in + let new_sorts = + match sorts with + | None -> Array.make (Array.length funs) (type_sort) + | Some a -> a + in + (* First we get the type of the old graph principle *) + let mutr_nparams = (compute_elim_sig old_princ_type).nparams in + (* First we get the type of the old graph principle *) + let new_principle_type = + compute_new_princ_type_from_rel + (Array.map mkConst funs) + new_sorts + old_princ_type + in +(* observe (str "new_principle_type : " ++ pr_lconstr new_principle_type); *) + let base_new_princ_name,new_princ_name = + match new_princ_name with + | Some (id) -> id,id + | None -> + let id_of_f = id_of_label (con_label f) in + id_of_f,Indrec.make_elimination_ident id_of_f (family_of_sort type_sort) + in + let names = ref [new_princ_name] in + let hook _ _ = + if sorts = None + then +(* let id_of_f = id_of_label (con_label f) in *) + let register_with_sort fam_sort = + let s = Termops.new_sort_in_family fam_sort in + let name = Indrec.make_elimination_ident base_new_princ_name fam_sort in + let value = + change_property_sort s new_principle_type new_princ_name + in +(* Pp.msgnl (str "new principle := " ++ pr_lconstr value); *) + let ce = + { const_entry_body = value; + const_entry_type = None; + const_entry_opaque = false; + const_entry_boxed = Options.boxed_definitions() + } + in + ignore( + Declare.declare_constant + name + (Entries.DefinitionEntry ce, + Decl_kinds.IsDefinition (Decl_kinds.Scheme) + ) + ); + names := name :: !names + in + register_with_sort InProp; + register_with_sort InSet + in + begin + Command.start_proof + new_princ_name + (Decl_kinds.Global,(Decl_kinds.Proof Decl_kinds.Theorem)) + new_principle_type + hook + ; + try + let _tim1 = System.get_time () in + Pfedit.by (proof_tac (Array.map mkConst funs) mutr_nparams); + let _tim2 = System.get_time () in +(* begin *) +(* let dur1 = System.time_difference tim1 tim2 in *) +(* Pp.msgnl (str ("Time to compute proof: ") ++ str (string_of_float dur1)); *) +(* end; *) + let do_save = not (do_observe ()) && not interactive_proof in + let _ = + try +(* Vernacentries.show_script (); *) + Options.silently defined (); + let _dur2 = System.time_difference _tim2 (System.get_time ()) in +(* Pp.msgnl (str ("Time to check proof: ") ++ str (string_of_float dur2)); *) + Options.if_verbose + (fun () -> + Pp.msgnl ( + prlist_with_sep + (fun () -> str" is defined " ++ fnl ()) + Ppconstr.pr_id + (List.rev !names) ++ str" is defined " + ) + ) + () + with e when do_save -> + msg_warning + ( + Cerrors.explain_exn e + ); + if not (do_observe ()) + then begin Vernacentries.interp (Vernacexpr.VernacAbort None);raise e end + in + () + +(* let tim3 = Sys.time () in *) +(* Pp.msgnl (str ("Time to save proof: ") ++ str (string_of_float (tim3 -. tim2))); *) + + with + | e -> + msg_warning + ( + Cerrors.explain_exn e + ); + if not ( do_observe ()) + then begin Vernacentries.interp (Vernacexpr.VernacAbort None);raise e end + end + + + + +exception Not_Rec + +let get_funs_constant mp dp = + let rec get_funs_constant const e : (Names.constant*int) array = + match kind_of_term (snd (decompose_lam e)) with + | Fix((_,(na,_,_))) -> + Array.mapi + (fun i na -> + match na with + | Name id -> + let const = make_con mp dp (label_of_id id) in + const,i + | Anonymous -> + anomaly "Anonymous fix" + ) + na + | _ -> [|const,0|] + in + function const -> + let find_constant_body const = + match (Global.lookup_constant const ).const_body with + | Some b -> + let body = force b in + let body = Tacred.cbv_norm_flags + (Closure.RedFlags.mkflags [Closure.RedFlags.fZETA]) + (Global.env ()) + (Evd.empty) + body + in + body + | None -> error ( "Cannot define a principle over an axiom ") + in + let f = find_constant_body const in + let l_const = get_funs_constant const f in + (* + We need to check that all the functions found are in the same block + to prevent Reset stange thing + *) + let l_bodies = List.map find_constant_body (Array.to_list (Array.map fst l_const)) in + let l_params,l_fixes = List.split (List.map decompose_lam l_bodies) in + (* all the paremeter must be equal*) + let _check_params = + let first_params = List.hd l_params in + List.iter + (fun params -> + if not ((=) first_params params) + then error "Not a mutal recursive block" + ) + l_params + in + (* The bodies has to be very similar *) + let _check_bodies = + try + let extract_info is_first body = + match kind_of_term body with + | Fix((idxs,_),(na,ta,ca)) -> (idxs,na,ta,ca) + | _ -> + if is_first && (List.length l_bodies = 1) + then raise Not_Rec + else error "Not a mutal recursive block" + in + let first_infos = extract_info true (List.hd l_bodies) in + let check body = (* Hope this is correct *) + if not (first_infos = (extract_info false body)) + then error "Not a mutal recursive block" + in + List.iter check l_bodies + with Not_Rec -> () + in + l_const + +exception No_graph_found + +let make_scheme fas = + let env = Global.env () + and sigma = Evd.empty in + let id_to_constr id = + Tacinterp.constr_of_id env id + in + let funs = + List.map + (fun (_,f,_) -> + try id_to_constr f + with Not_found -> + Util.error ("Cannot find "^ string_of_id f) + ) + fas + in + let first_fun = destConst (List.hd funs) in + let funs_mp,funs_dp,first_fun_id = Names.repr_con first_fun in + let first_fun_rel_id = mk_rel_id (id_of_label first_fun_id) in + let first_fun_kn = + try + (* Fixme: take into account funs_mp and funs_dp *) + fst (destInd (id_to_constr first_fun_rel_id)) + with Not_found -> raise No_graph_found + in + let this_block_funs_indexes = get_funs_constant funs_mp funs_dp first_fun in + let this_block_funs = Array.map fst this_block_funs_indexes in + let prop_sort = InProp in + let funs_indexes = + let this_block_funs_indexes = Array.to_list this_block_funs_indexes in + List.map + (function const -> List.assoc (destConst const) this_block_funs_indexes) + funs + in + let ind_list = + List.map + (fun (idx) -> + let ind = first_fun_kn,idx in + let (mib,mip) = Global.lookup_inductive ind in + ind,mib,mip,true,prop_sort + ) + funs_indexes + in + let l_schemes = List.map (Typing.type_of env sigma ) (Indrec.build_mutual_indrec env sigma ind_list) in + let i = ref (-1) in + let sorts = + List.rev_map (fun (_,_,x) -> + Termops.new_sort_in_family (Pretyping.interp_elimination_sort x) + ) + fas + in + let princ_names = List.map (fun (x,_,_) -> x) fas in + let _ = List.map2 + (fun princ_name scheme_type -> + incr i; +(* observe (str "Generating " ++ Ppconstr.pr_id princ_name ++str " with " ++ *) +(* pr_lconstr scheme_type ++ str " and " ++ (fun a -> prlist_with_sep spc (fun c -> pr_lconstr (mkConst c)) (Array.to_list a)) this_block_funs *) +(* ); *) + generate_functional_principle + false + scheme_type + (Some (Array.of_list sorts)) + (Some princ_name) + this_block_funs + !i + (prove_princ_for_struct false !i (Array.of_list (List.map destConst funs))) + ) + princ_names + l_schemes + in + () + +let make_case_scheme fa = + let env = Global.env () + and sigma = Evd.empty in + let id_to_constr id = + Tacinterp.constr_of_id env id + in + let funs = (fun (_,f,_) -> id_to_constr f) fa in + let first_fun = destConst funs in + let funs_mp,funs_dp,first_fun_id = Names.repr_con first_fun in + let first_fun_rel_id = mk_rel_id (id_of_label first_fun_id) in + let first_fun_kn = + (* Fixme: take into accour funs_mp and funs_dp *) + fst (destInd (id_to_constr first_fun_rel_id)) + in + let this_block_funs_indexes = get_funs_constant funs_mp funs_dp first_fun in + let this_block_funs = Array.map fst this_block_funs_indexes in + let prop_sort = InProp in + let funs_indexes = + let this_block_funs_indexes = Array.to_list this_block_funs_indexes in + List.assoc (destConst funs) this_block_funs_indexes + in + let ind_fun = + let ind = first_fun_kn,funs_indexes in + ind,prop_sort + in + let scheme_type = (Typing.type_of env sigma ) ((fun (ind,sf) -> Indrec.make_case_gen env sigma ind sf) ind_fun) in + let sorts = + (fun (_,_,x) -> + Termops.new_sort_in_family (Pretyping.interp_elimination_sort x) + ) + fa + in + let princ_name = (fun (x,_,_) -> x) fa in + let _ = +(* observe (str "Generating " ++ Ppconstr.pr_id princ_name ++str " with " ++ *) +(* pr_lconstr scheme_type ++ str " and " ++ (fun a -> prlist_with_sep spc (fun c -> pr_lconstr (mkConst c)) (Array.to_list a)) this_block_funs *) +(* ); *) + generate_functional_principle + false + scheme_type + (Some ([|sorts|])) + (Some princ_name) + this_block_funs + 0 + (prove_princ_for_struct false 0 [|destConst funs|]) + in + () diff --git a/contrib/funind/functional_principles_types.mli b/contrib/funind/functional_principles_types.mli new file mode 100644 index 00000000..8b4faaf4 --- /dev/null +++ b/contrib/funind/functional_principles_types.mli @@ -0,0 +1,31 @@ +open Names +open Term +val generate_functional_principle : + (* do we accept interactive proving *) + bool -> + (* induction principle on rel *) + types -> + (* *) + sorts array option -> + (* Name of the new principle *) + (identifier) option -> + (* the compute functions to use *) + constant array -> + (* We prove the nth- principle *) + int -> + (* The tactic to use to make the proof w.r + the number of params + *) + (constr array -> int -> Tacmach.tactic) -> + unit + + + +val compute_new_princ_type_from_rel : constr array -> sorts array -> + types -> types + + +exception No_graph_found + +val make_scheme : (identifier*identifier*Rawterm.rawsort) list -> unit +val make_case_scheme : (identifier*identifier*Rawterm.rawsort) -> unit diff --git a/contrib/funind/indfun.ml b/contrib/funind/indfun.ml index 2fcdd3a7..f6d554a8 100644 --- a/contrib/funind/indfun.ml +++ b/contrib/funind/indfun.ml @@ -1,7 +1,6 @@ open Util open Names open Term - open Pp open Indfun_common open Libnames @@ -29,6 +28,11 @@ let interp_casted_constr_with_implicits sigma env impls c = Constrintern.intern_gen false sigma env ~impls:([],impls) ~allow_soapp:false ~ltacvars:([],[]) c + +(* + Construct a fixpoint as a Rawterm + and not as a constr +*) let build_newrecursive (lnameargsardef) = let env0 = Global.env() @@ -71,31 +75,43 @@ let compute_annot (name,annot,args,types,body) = | None -> if List.length names > 1 then user_err_loc - (dummy_loc,"GenFixpoint", + (dummy_loc,"Function", Pp.str "the recursive argument needs to be specified"); let new_annot = (id_of_name (List.hd names)) in (name,Struct new_annot,args,types,body) | Some r -> (name,r,args,types,body) - +(* Checks whether or not the mutual bloc is recursive *) let rec is_rec names = let names = List.fold_right Idset.add names Idset.empty in - let check_id id = Idset.mem id names in - let rec lookup = function - | RVar(_,id) -> check_id id + let check_id id names = Idset.mem id names in + let rec lookup names = function + | RVar(_,id) -> check_id id names | RRef _ | REvar _ | RPatVar _ | RSort _ | RHole _ | RDynamic _ -> false - | RCast(_,b,_,_) -> lookup b - | RRec _ -> assert false - | RIf _ -> failwith "Rif not implemented" - | RLetIn(_,_,t,b) | RLambda(_,_,t,b) | RProd(_,_,t,b) | RLetTuple(_,_,_,t,b) -> - lookup t || lookup b - | RApp(_,f,args) -> List.exists lookup (f::args) + | RCast(_,b,_,_) -> lookup names b + | RRec _ -> error "RRec not handled" + | RIf(_,b,_,lhs,rhs) -> + (lookup names b) || (lookup names lhs) || (lookup names rhs) + | RLetIn(_,na,t,b) | RLambda(_,na,t,b) | RProd(_,na,t,b) -> + lookup names t || lookup (Nameops.name_fold Idset.remove na names) b + | RLetTuple(_,nal,_,t,b) -> lookup names t || + lookup + (List.fold_left + (fun acc na -> Nameops.name_fold Idset.remove na acc) + names + nal + ) + b + | RApp(_,f,args) -> List.exists (lookup names) (f::args) | RCases(_,_,el,brl) -> - List.exists (fun (e,_) -> lookup e) el || - List.exists (fun (_,_,_,ret)-> lookup ret) brl + List.exists (fun (e,_) -> lookup names e) el || + List.exists (lookup_br names) brl + and lookup_br names (_,idl,_,rt) = + let new_names = List.fold_right Idset.remove idl names in + lookup new_names rt in - lookup + lookup names let prepare_body (name,annot,args,types,body) rt = let n = (Topconstr.local_binders_length args) in @@ -139,7 +155,7 @@ let generate_principle let princ_type = (Global.lookup_constant princ).Declarations.const_type in - New_arg_principle.generate_functional_principle + Functional_principles_types.generate_functional_principle interactive_proof princ_type None @@ -171,12 +187,12 @@ let register_struct is_rec fixpoint_exprl = | _ -> Command.build_recursive fixpoint_exprl (Options.boxed_definitions()) - -let generate_correction_proof_wf tcc_lemma_ref - is_mes f_ref eq_ref rec_arg_num rec_arg_type nb_args relation +let generate_correction_proof_wf f_ref tcc_lemma_ref + is_mes functional_ref eq_ref rec_arg_num rec_arg_type nb_args relation (_: int) (_:Names.constant array) (_:Term.constr array) (_:int) : Tacmach.tactic = - Recdef.prove_principle tcc_lemma_ref - is_mes f_ref eq_ref rec_arg_num rec_arg_type nb_args relation + Functional_principles_proofs.prove_principle_for_gen + (f_ref,functional_ref,eq_ref) + tcc_lemma_ref is_mes rec_arg_num rec_arg_type relation let register_wf ?(is_mes=false) fname wf_rel_expr wf_arg args ret_type body @@ -214,11 +230,11 @@ let register_wf ?(is_mes=false) fname wf_rel_expr wf_arg args ret_type body [(f_app_args,None);(body,None)]) in let eq = Command.generalize_constr_expr unbounded_eq args in - let hook tcc_lemma_ref f_ref eq_ref rec_arg_num rec_arg_type nb_args relation = + let hook f_ref tcc_lemma_ref functional_ref eq_ref rec_arg_num rec_arg_type nb_args relation = try pre_hook - (generate_correction_proof_wf tcc_lemma_ref is_mes - f_ref eq_ref rec_arg_num rec_arg_type nb_args relation + (generate_correction_proof_wf f_ref tcc_lemma_ref is_mes + functional_ref eq_ref rec_arg_num rec_arg_type nb_args relation ); Command.save_named true with e -> @@ -317,7 +333,7 @@ let do_generate_principle register_built interactive_proof fixpoint_exprl = (Topconstr.names_of_local_assums args) in let annot = - try Util.list_index (Name id) names - 1, Topconstr.CStructRec + try Some (Util.list_index (Name id) names - 1), Topconstr.CStructRec with Not_found -> raise (UserError("",str "Cannot find argument " ++ Ppconstr.pr_id id)) in (name,annot,args,types,body),(None:Vernacexpr.decl_notation) @@ -325,10 +341,10 @@ let do_generate_principle register_built interactive_proof fixpoint_exprl = let names = (Topconstr.names_of_local_assums args) in if is_one_rec recdef && List.length names > 1 then Util.user_err_loc - (Util.dummy_loc,"GenFixpoint", - Pp.str "the recursive argument needs to be specified") + (Util.dummy_loc,"Function", + Pp.str "the recursive argument needs to be specified in Function") else - (name,(0, Topconstr.CStructRec),args,types,body),(None:Vernacexpr.decl_notation) + (name,(Some 0, Topconstr.CStructRec),args,types,body),(None:Vernacexpr.decl_notation) | (_,Some (Wf _),_,_,_),_ | (_,Some (Mes _),_,_,_),_-> error ("Cannot use mutual definition with well-founded recursion") @@ -347,12 +363,69 @@ let do_generate_principle register_built interactive_proof fixpoint_exprl = recdefs interactive_proof true - (New_arg_principle.prove_princ_for_struct interactive_proof); + (Functional_principles_proofs.prove_princ_for_struct interactive_proof); true in () +open Topconstr +let rec add_args id new_args b = + match b with + | CRef r -> + begin match r with + | Libnames.Ident(loc,fname) when fname = id -> + CAppExpl(dummy_loc,(None,r),new_args) + | _ -> b + end + | CFix _ | CCoFix _ -> anomaly "add_args : todo" + | CArrow(loc,b1,b2) -> + CArrow(loc,add_args id new_args b1, add_args id new_args b2) + | CProdN(loc,nal,b1) -> + CProdN(loc,List.map (fun (nal,b2) -> (nal,add_args id new_args b2)) nal, add_args id new_args b1) + | CLambdaN(loc,nal,b1) -> + CLambdaN(loc,List.map (fun (nal,b2) -> (nal,add_args id new_args b2)) nal, add_args id new_args b1) + | CLetIn(loc,na,b1,b2) -> + CLetIn(loc,na,add_args id new_args b1,add_args id new_args b2) + | CAppExpl(loc,(pf,r),exprl) -> + begin + match r with + | Libnames.Ident(loc,fname) when fname = id -> + CAppExpl(loc,(pf,r),new_args@(List.map (add_args id new_args) exprl)) + | _ -> CAppExpl(loc,(pf,r),List.map (add_args id new_args) exprl) + end + | CApp(loc,(pf,b),bl) -> + CApp(loc,(pf,add_args id new_args b), List.map (fun (e,o) -> add_args id new_args e,o) bl) + | CCases(loc,b_option,cel,cal) -> + CCases(loc,Util.option_map (add_args id new_args) b_option, + List.map (fun (b,(na,b_option)) -> add_args id new_args b,(na,Util.option_map (add_args id new_args) b_option)) cel, + List.map (fun (loc,cpl,e) -> (loc,cpl,add_args id new_args e)) cal + ) + | CLetTuple(loc,nal,(na,b_option),b1,b2) -> + CLetTuple(loc,nal,(na,Util.option_map (add_args id new_args) b_option), + add_args id new_args b1, + add_args id new_args b2 + ) + + | CIf(loc,b1,(na,b_option),b2,b3) -> + CIf(loc,add_args id new_args b1, + (na,Util.option_map (add_args id new_args) b_option), + add_args id new_args b2, + add_args id new_args b3 + ) + | CHole _ -> b + | CPatVar _ -> b + | CEvar _ -> b + | CSort _ -> b + | CCast(loc,b1,ck,b2) -> + CCast(loc,add_args id new_args b1,ck,add_args id new_args b2) + | CNotation _ -> anomaly "add_args : CNotation" + | CPrim _ -> b + | CDelimiters _ -> anomaly "add_args : CDelimiters" + | CDynamic _ -> anomaly "add_args : CDynamic" + + + let make_graph (id:identifier) = let c_body = try @@ -367,8 +440,6 @@ let make_graph (id:identifier) = | Some b -> let env = Global.env () in let body = (force b) in - - let extern_body,extern_type = let old_implicit_args = Impargs.is_implicit_args () and old_strict_implicit_args = Impargs.is_strict_implicit_args () @@ -400,68 +471,102 @@ let make_graph (id:identifier) = Options.raw_print := old_rawprint; raise e in + let rec get_args b t : Topconstr.local_binder list * + Topconstr.constr_expr * Topconstr.constr_expr = +(* Pp.msgnl (str "body: " ++Ppconstr.pr_lconstr_expr b); *) +(* Pp.msgnl (str "type: " ++ Ppconstr.pr_lconstr_expr t); *) +(* Pp.msgnl (fnl ()); *) + match b with + | Topconstr.CLambdaN (loc, (nal_ta), b') -> + begin + let n = + (List.fold_left (fun n (nal,_) -> + n+List.length nal) 0 nal_ta ) + in + let rec chop_n_arrow n t = + if n > 0 + then + match t with + | Topconstr.CArrow(_,_,t) -> chop_n_arrow (n-1) t + | Topconstr.CProdN(_,nal_ta',t') -> + let n' = + List.fold_left + (fun n (nal,t'') -> + n+List.length nal) n nal_ta' + in + assert (n'<= n); + chop_n_arrow (n - n') t' + | _ -> anomaly "Not enough products" + else t + in + let nal_tas,b'',t'' = get_args b' (chop_n_arrow n t) in + (List.map (fun (nal,ta) -> (Topconstr.LocalRawAssum (nal,ta))) nal_ta)@nal_tas, b'',t'' + end + | _ -> [],b,t + in + let (nal_tas,b,t) = get_args extern_body extern_type in let expr_list = - match extern_body with + match b with | Topconstr.CFix(loc,l_id,fixexprl) -> - let l = - List.map - (fun (id,(n,recexp),bl,t,b) -> - let nal = - List.flatten - (List.map - (function - | Topconstr.LocalRawDef (na,_)-> [] - | Topconstr.LocalRawAssum (nal,_) -> nal - ) - bl - ) - in - let rec_id = - match List.nth nal n with |(_,Name id) -> id | _ -> anomaly "" - in - (id, Some (Struct rec_id),bl,t,b) - ) - fixexprl - in - l - | _ -> - let rec get_args b t : Topconstr.local_binder list * - Topconstr.constr_expr * Topconstr.constr_expr = -(* Pp.msgnl (str "body: " ++Ppconstr.pr_lconstr_expr b); *) -(* Pp.msgnl (str "type: " ++ Ppconstr.pr_lconstr_expr t); *) -(* Pp.msgnl (fnl ()); *) - match b with - | Topconstr.CLambdaN (loc, (nal_ta), b') -> - begin - let n = - (List.fold_left (fun n (nal,_) -> - n+List.length nal) 0 nal_ta ) - in - let rec chop_n_arrow n t = - if n > 0 - then - match t with - | Topconstr.CArrow(_,_,t) -> chop_n_arrow (n-1) t - | Topconstr.CProdN(_,nal_ta',t') -> - let n' = - List.fold_left - (fun n (nal,t'') -> - n+List.length nal) n nal_ta' - in - assert (n'<= n); - chop_n_arrow (n - n') t' - | _ -> anomaly "Not enough products" - else t - in - let nal_tas,b'',t'' = get_args b' (chop_n_arrow n t) in - (List.map (fun (nal,ta) -> (Topconstr.LocalRawAssum (nal,ta))) nal_ta)@nal_tas, b'',t'' - end - | _ -> [],b,t + let l = + List.map + (fun (id,(n,recexp),bl,t,b) -> +(* let nal = *) +(* List.flatten *) +(* (List.map *) +(* (function *) +(* | Topconstr.LocalRawDef (na,_)-> [] *) +(* | Topconstr.LocalRawAssum (nal,_) -> nal *) +(* ) *) +(* (nal_tas@bl) *) +(* ) *) +(* in *) + let bl' = + List.flatten + (List.map + (function + | Topconstr.LocalRawDef (na,_)-> [] + | Topconstr.LocalRawAssum (nal,_) -> nal + ) + bl + ) + in + let rec_id = + match List.nth bl' (out_some n) with |(_,Name id) -> id | _ -> anomaly "" + in + let new_args = + List.flatten + (List.map + (function + | Topconstr.LocalRawDef (na,_)-> [] + | Topconstr.LocalRawAssum (nal,_) -> List.map (fun (loc,n) -> CRef(Libnames.Ident(loc, Nameops.out_name n))) nal + ) + nal_tas + ) + in + let b' = add_args id new_args b in + (id, Some (Struct rec_id),nal_tas@bl,t,b') + ) + fixexprl in - let nal_tas,b,t = get_args extern_body extern_type in + l + | _ -> [(id,None,nal_tas,t,b)] - in +(* List.iter (fun (id,rec_arg,bl,t,b) -> *) +(* Pp.msgnl *) +(* (Ppconstr.pr_id id ++ *) +(* Ppconstr.pr_binders bl ++ *) +(* begin match rec_arg with *) +(* | Some (Struct id) -> str " { struct " ++ Ppconstr.pr_id id ++ str " }" *) +(* | _ -> (mt ()) *) +(* end ++ *) +(* str " : " ++ Ppconstr.pr_lconstr_expr t ++ *) +(* str " := " ++ *) +(* Ppconstr.pr_lconstr_expr b *) +(* ) *) +(* ) *) +(* expr_list; *) do_generate_principle false false expr_list (* let make_graph _ = assert false *) diff --git a/contrib/funind/indfun_main.ml4 b/contrib/funind/indfun_main.ml4 index 7b3d8cbd..61f26d30 100644 --- a/contrib/funind/indfun_main.ml4 +++ b/contrib/funind/indfun_main.ml4 @@ -13,37 +13,72 @@ open Topconstr open Indfun_common open Indfun open Genarg +open Pcoq -TACTIC EXTEND newfuninv - [ "functional" "inversion" ident(hyp) ident(fname) ] -> - [ - Invfun.invfun hyp fname - ] -END +let pr_binding prc = function + | loc, Rawterm.NamedHyp id, c -> hov 1 (Ppconstr.pr_id id ++ str " := " ++ cut () ++ prc c) + | loc, Rawterm.AnonHyp n, c -> hov 1 (int n ++ str " := " ++ cut () ++ prc c) + +let pr_bindings prc prlc = function + | Rawterm.ImplicitBindings l -> + brk (1,1) ++ str "with" ++ brk (1,1) ++ + Util.prlist_with_sep spc prc l + | Rawterm.ExplicitBindings l -> + brk (1,1) ++ str "with" ++ brk (1,1) ++ + Util.prlist_with_sep spc (fun b -> str"(" ++ pr_binding prlc b ++ str")") l + | Rawterm.NoBindings -> mt () + + +let pr_with_bindings prc prlc (c,bl) = + prc c ++ hv 0 (pr_bindings prc prlc bl) -let pr_fun_ind_using prc _ _ opt_c = - match opt_c with +let pr_fun_ind_using prc prlc _ opt_c = + match opt_c with | None -> mt () - | Some c -> spc () ++ hov 2 (str "using" ++ spc () ++ prc c) + | Some c -> spc () ++ hov 2 (str "using" ++ spc () ++ pr_with_bindings prc prlc c) ARGUMENT EXTEND fun_ind_using - TYPED AS constr_opt + TYPED AS constr_with_bindings_opt PRINTED BY pr_fun_ind_using -| [ "using" constr(c) ] -> [ Some c ] +| [ "using" constr_with_bindings(c) ] -> [ Some c ] | [ ] -> [ None ] END -let pr_intro_as_pat prc _ _ pat = - str "as" ++ spc () ++ pr_intro_pattern pat +TACTIC EXTEND newfuninv + [ "functional" "inversion" ident(hyp) ident(fname) fun_ind_using(princl)] -> + [ + fun g -> + let fconst = const_of_id fname in + let princ = + match princl with + | None -> + let f_ind_id = + ( + Indrec.make_elimination_ident + fname + (Tacticals.elimination_sort_of_goal g) + ) + in + let princ = const_of_id f_ind_id in + princ + | Some princ -> destConst (fst princ) + in + Invfun.invfun hyp fconst princ g + ] +END +let pr_intro_as_pat prc _ _ pat = + match pat with + | Some pat -> spc () ++ str "as" ++ spc () ++ pr_intro_pattern pat + | None -> mt () -ARGUMENT EXTEND with_names TYPED AS intro_pattern PRINTED BY pr_intro_as_pat -| [ "as" simple_intropattern(ipat) ] -> [ ipat ] -| [] ->[ IntroAnonymous ] +ARGUMENT EXTEND with_names TYPED AS intro_pattern_opt PRINTED BY pr_intro_as_pat +| [ "as" simple_intropattern(ipat) ] -> [ Some ipat ] +| [] ->[ None ] END @@ -61,16 +96,25 @@ let is_rec scheme_info = let choose_dest_or_ind scheme_info = if is_rec scheme_info then Tactics.new_induct - else - Tactics.new_destruct + else Tactics.new_destruct TACTIC EXTEND newfunind - ["new" "functional" "induction" constr(c) fun_ind_using(princl) with_names(pat)] -> + ["functional" "induction" ne_constr_list(cl) fun_ind_using(princl) with_names(pat)] -> [ + let pat = + match pat with + | None -> IntroAnonymous + | Some pat -> pat + in + let c = match cl with + | [] -> assert false + | [c] -> c + | c::cl -> applist(c,cl) + in let f,args = decompose_app c in fun g -> - let princ = + let princ,bindings = match princl with | None -> (* No principle is given let's find the good one *) let fname = @@ -86,7 +130,7 @@ TACTIC EXTEND newfunind (Tacticals.elimination_sort_of_goal g) ) in - mkConst(const_of_id princ_name ) + mkConst(const_of_id princ_name ),Rawterm.NoBindings | Some princ -> princ in let princ_type = Tacmach.pf_type_of g princ in @@ -98,12 +142,46 @@ TACTIC EXTEND newfunind in List.map (fun c -> Tacexpr.ElimOnConstr c) (args@c_list) in - let princ' = Some (princ,Rawterm.NoBindings) in - choose_dest_or_ind + let princ' = Some (princ,bindings) in + let princ_vars = + List.fold_right + (fun a acc -> + try Idset.add (destVar a) acc + with _ -> acc + ) + args + Idset.empty + in + let old_idl = List.fold_right Idset.add (Tacmach.pf_ids_of_hyps g) Idset.empty in + let old_idl = Idset.diff old_idl princ_vars in + let subst_and_reduce g = + let idl = + Util.map_succeed + (fun id -> + if Idset.mem id old_idl then failwith ""; + id + ) + (Tacmach.pf_ids_of_hyps g) + in + let flag = + Rawterm.Cbv + {Rawterm.all_flags + with Rawterm.rDelta = false; + } + in + Tacticals.tclTHEN + (Tacticals.tclMAP (fun id -> Tacticals.tclTRY (Equality.subst [id])) idl ) + (Hiddentac.h_reduce flag Tacticals.allClauses) + g + in + Tacticals.tclTHEN + (choose_dest_or_ind princ_infos args_as_induction_constr princ' - pat g + pat) + subst_and_reduce + g ] END @@ -111,7 +189,7 @@ END VERNAC ARGUMENT EXTEND rec_annotation2 [ "{" "struct" ident(id) "}"] -> [ Struct id ] | [ "{" "wf" constr(r) ident_opt(id) "}" ] -> [ Wf(r,id) ] -| [ "{" "mes" constr(r) ident_opt(id) "}" ] -> [ Mes(r,id) ] +| [ "{" "measure" constr(r) ident_opt(id) "}" ] -> [ Mes(r,id) ] END @@ -130,7 +208,7 @@ VERNAC ARGUMENT EXTEND rec_definition2 let check_one_name () = if List.length names > 1 then Util.user_err_loc - (Util.dummy_loc,"GenFixpoint", + (Util.dummy_loc,"Function", Pp.str "the recursive argument needs to be specified"); in let check_exists_args an = @@ -138,7 +216,7 @@ VERNAC ARGUMENT EXTEND rec_definition2 let id = match an with Struct id -> id | Wf(_,Some id) -> id | Mes(_,Some id) -> id | Wf(_,None) | Mes(_,None) -> failwith "check_exists_args" in (try ignore(Util.list_index (Name id) names - 1); annot with Not_found -> Util.user_err_loc - (Util.dummy_loc,"GenFixpoint", + (Util.dummy_loc,"Function", Pp.str "No argument named " ++ Nameops.pr_id id) ) with Failure "check_exists_args" -> check_one_name ();annot @@ -160,16 +238,11 @@ VERNAC ARGUMENT EXTEND rec_definitions2 END -VERNAC COMMAND EXTEND GenFixpoint - ["GenFixpoint" rec_definitions2(recsl)] -> +VERNAC COMMAND EXTEND Function + ["Function" rec_definitions2(recsl)] -> [ do_generate_principle false recsl] END -VERNAC COMMAND EXTEND IGenFixpoint - ["IGenFixpoint" rec_definitions2(recsl)] -> - [ do_generate_principle true recsl] -END - VERNAC ARGUMENT EXTEND fun_scheme_arg | [ ident(princ_name) ":=" "Induction" "for" ident(fun_name) "Sort" sort(s) ] -> [ (princ_name,fun_name,s) ] @@ -181,17 +254,28 @@ VERNAC ARGUMENT EXTEND fun_scheme_args END VERNAC COMMAND EXTEND NewFunctionalScheme - ["New" "Functional" "Scheme" fun_scheme_args(fas) ] -> + ["Functional" "Scheme" fun_scheme_args(fas) ] -> [ - New_arg_principle.make_scheme fas + try + Functional_principles_types.make_scheme fas + with Functional_principles_types.No_graph_found -> + match fas with + | (_,fun_name,_)::_ -> + begin + make_graph fun_name; + try Functional_principles_types.make_scheme fas + with Functional_principles_types.No_graph_found -> + Util.error ("Cannot generate induction principle(s)") + end + | _ -> assert false (* we can only have non empty list *) ] END VERNAC COMMAND EXTEND NewFunctionalCase - ["New" "Functional" "Case" fun_scheme_arg(fas) ] -> + ["Functional" "Case" fun_scheme_arg(fas) ] -> [ - New_arg_principle.make_case_scheme fas + Functional_principles_types.make_case_scheme fas ] END diff --git a/contrib/funind/invfun.ml b/contrib/funind/invfun.ml index 1f711297..2e5616f0 100644 --- a/contrib/funind/invfun.ml +++ b/contrib/funind/invfun.ml @@ -88,18 +88,9 @@ let gen_fargs fargs : tactic = g -let invfun (hypname:identifier) (fid:identifier) : tactic= +let invfun (hypname:identifier) fname princ : tactic= fun g -> let nprod_goal = nb_prod (pf_concl g) in - let f_ind_id = - ( - Indrec.make_elimination_ident - fid - (Tacticals.elimination_sort_of_goal g) - ) - in - let fname = const_of_id fid in - let princ = const_of_id f_ind_id in let princ_info = let princ_type = (try (match (Global.lookup_constant princ) with @@ -114,7 +105,7 @@ let invfun (hypname:identifier) (fid:identifier) : tactic= let frealargs = (snd (array_chop (List.length princ_info.params) fargs)) in let pat_args = - (List.map (fun e -> ([-1],e)) (Array.to_list frealargs)) @ [[],appf] + (List.map (fun e -> ([Rawterm.ArgArg (-1)],e)) (Array.to_list frealargs)) @ [[],appf] in tclTHENSEQ [ diff --git a/contrib/funind/new_arg_principle.ml b/contrib/funind/new_arg_principle.ml deleted file mode 100644 index 8ef23c48..00000000 --- a/contrib/funind/new_arg_principle.ml +++ /dev/null @@ -1,1770 +0,0 @@ -open Printer -open Util -open Term -open Termops -open Names -open Declarations -open Pp -open Entries -open Hiddentac -open Evd -open Tacmach -open Proof_type -open Tacticals -open Tactics -open Indfun_common - - -let msgnl = Pp.msgnl - -let do_observe () = - Tacinterp.get_debug () <> Tactic_debug.DebugOff - - -let observe strm = - if do_observe () - then Pp.msgnl strm - else () - -let observennl strm = - if do_observe () - then begin Pp.msg strm;Pp.pp_flush () end - else () - - - - -let do_observe_tac s tac g = - try let v = tac g in (* msgnl (goal ++ fnl () ++ (str s)++(str " ")++(str "finished")); *) v - with e -> - let goal = begin try (Printer.pr_goal (sig_it g)) with _ -> assert false end in - msgnl (str "observation "++str s++str " raised exception " ++ - Cerrors.explain_exn e ++ str "on goal " ++ goal ); - raise e;; - - -let observe_tac s tac g = - if do_observe () - then do_observe_tac s tac g - else tac g - - -let tclTRYD tac = - if !Options.debug || do_observe () - then (fun g -> try do_observe_tac "" tac g with _ -> tclIDTAC g) - else tac - - -let list_chop ?(msg="") n l = - try - list_chop n l - with Failure (msg') -> - failwith (msg ^ msg') - - -let make_refl_eq type_of_t t = - let refl_equal_term = Lazy.force refl_equal in - mkApp(refl_equal_term,[|type_of_t;t|]) - - -type static_fix_info = - { - idx : int; - name : identifier; - types : types - } - -type static_infos = - { - fixes_ids : identifier list; - ptes_to_fixes : static_fix_info Idmap.t - } - -type 'a dynamic_info = - { - nb_rec_hyps : int; - rec_hyps : identifier list ; - eq_hyps : identifier list; - info : 'a - } - -let finish_proof dynamic_infos g = - observe_tac "finish" - h_assumption - g - - -let refine c = - Tacmach.refine_no_check c - -let thin l = - Tacmach.thin_no_check l - - -let cut_replacing id t tac :tactic= - tclTHENS (cut t) - [ tclTHEN (thin_no_check [id]) (introduction_no_check id); - tac - ] - -let intro_erasing id = tclTHEN (thin [id]) (introduction id) - - - -let rec_hyp_id = id_of_string "rec_hyp" - -let is_trivial_eq t = - match kind_of_term t with - | App(f,[|_;t1;t2|]) when eq_constr f (Lazy.force eq) -> - eq_constr t1 t2 - | _ -> false - - -let rec incompatible_constructor_terms t1 t2 = - let c1,arg1 = decompose_app t1 - and c2,arg2 = decompose_app t2 - in - (not (eq_constr t1 t2)) && - isConstruct c1 && isConstruct c2 && - ( - not (eq_constr c1 c2) || - List.exists2 incompatible_constructor_terms arg1 arg2 - ) - -let is_incompatible_eq t = - match kind_of_term t with - | App(f,[|_;t1;t2|]) when eq_constr f (Lazy.force eq) -> - incompatible_constructor_terms t1 t2 - | _ -> false - -let change_hyp_with_using hyp_id t tac = - fun g -> - let prov_id = pf_get_new_id hyp_id g in - tclTHENLIST - [ - forward (Some tac) (Genarg.IntroIdentifier prov_id) t; - thin [hyp_id]; - h_rename prov_id hyp_id - ] g - -exception TOREMOVE - - -let prove_trivial_eq h_id context (type_of_term,term) = - let nb_intros = List.length context in - tclTHENLIST - [ - tclDO nb_intros intro; (* introducing context *) - (fun g -> - let context_hyps = - fst (list_chop ~msg:"prove_trivial_eq : " nb_intros (pf_ids_of_hyps g)) - in - let context_hyps' = - (mkApp(Lazy.force refl_equal,[|type_of_term;term|])):: - (List.map mkVar context_hyps) - in - let to_refine = applist(mkVar h_id,List.rev context_hyps') in - refine to_refine g - ) - ] - - -let isAppConstruct t = - if isApp t - then isConstruct (fst (destApp t)) - else false - - -let nf_betaoiotazeta = Reductionops.local_strong Reductionops.whd_betaiotazeta - -let remove_useless_rel env sigma hyp_id (context:Sign.rel_context) t end_of_type t1 t2 = - let rel_num = destRel t2 in - - let nb_kept = List.length context - rel_num - and nb_popped = rel_num - 1 - in - - (* We remove the equation *) - let new_end_of_type = pop end_of_type in - - let lt_relnum,ge_relnum = - list_chop - ~msg:("removing useless variable "^(string_of_int rel_num)^" :") - nb_popped - context - in - (* we rebuilt the type of hypothesis after the rel to remove *) - let hyp_type_lt_relnum = - it_mkProd_or_LetIn ~init:new_end_of_type lt_relnum - in - (* we replace Rel 1 by t1 *) - let new_hyp_type_lt_relnum = subst1 t1 hyp_type_lt_relnum in - (* we resplit the type of hyp_type *) - let new_lt_relnum,new_end_of_type = - Sign.decompose_prod_n_assum nb_popped new_hyp_type_lt_relnum - in - (* and rebuilt new context of hyp *) - let new_context = new_lt_relnum@(List.tl ge_relnum) in - let new_typ_of_hyp = - nf_betaoiotazeta (it_mkProd_or_LetIn ~init:new_end_of_type new_context) - in - let prove_simpl_eq = - tclTHENLIST - [ - tclDO (nb_popped + nb_kept) intro; - (fun g' -> - let new_hyps_ids = pf_ids_of_hyps g' in - let popped_ids,others = - list_chop ~msg:"removing useless variable pop :" - nb_popped new_hyps_ids in - let kept_ids,_ = - list_chop ~msg: " removing useless variable kept : " - nb_kept others - in - let rev_to_apply = - (mkApp(Lazy.force refl_equal,[|Typing.type_of env sigma t1;t1|])):: - ((List.map mkVar popped_ids)@ - (t1:: - (List.map mkVar kept_ids))) - in - let to_refine = applist(mkVar hyp_id,List.rev rev_to_apply) in - refine to_refine g' - ) - ] - in - let simpl_eq_tac = change_hyp_with_using hyp_id new_typ_of_hyp - (observe_tac "prove_simpl_eq" prove_simpl_eq) - in - let new_end_of_type = nf_betaoiotazeta new_end_of_type in - (new_context,new_end_of_type,simpl_eq_tac),new_typ_of_hyp, - (str " removing useless variable " ++ str (string_of_int rel_num) ) - - -let decompose_eq env sigma hyp_id (context:Sign.rel_context) t end_of_type t1 t2 = - let c1,args1 = destApp t1 - and c2,args2 = destApp t2 - in - (* This tactic must be used after is_incompatible_eq *) - assert (eq_constr c1 c2); - (* we remove this equation *) - let new_end_of_type = pop end_of_type in - let new_eqs = - array_map2_i - (fun i arg1 arg2 -> - let new_eq = - let type_of_arg = Typing.type_of env sigma arg1 in - mkApp(Lazy.force eq,[|type_of_arg;arg1;arg2|]) - in - Anonymous,None,lift i new_eq - ) - args1 - args2 - in - let nb_new_eqs = Array.length new_eqs in - (* we add the new equation *) - let new_end_of_type = lift nb_new_eqs new_end_of_type in - let local_context = - List.rev (Array.to_list new_eqs) in - let new_end_of_type = it_mkProd_or_LetIn ~init:new_end_of_type local_context in - let new_typ_of_hyp = - nf_betaoiotazeta (it_mkProd_or_LetIn ~init:new_end_of_type context) - in - let prove_pattern_simplification = - let context_length = List.length context in - tclTHENLIST - [ - tclDO (context_length + nb_new_eqs) intro ; - (fun g -> - let new_eqs,others = - list_chop ~msg:"simplifying pattern : new_eqs" nb_new_eqs (pf_hyps g) - in - let context_hyps,_ = list_chop ~msg:"simplifying pattern : context_hyps" - context_length others in - let eq_args = - List.rev_map - (fun (_,_, eq) -> let _,args = destApp eq in args.(1),args.(2)) - new_eqs - in - let lhs_args,rhs_args = List.split eq_args in - let lhs_eq = applist(c1,lhs_args) - and rhs_eq = applist(c1,rhs_args) - in - let type_of_eq = pf_type_of g lhs_eq in - let eq_to_assert = - mkApp(Lazy.force eq,[|type_of_eq;lhs_eq;rhs_eq|]) - in - let prove_new_eq = - tclTHENLIST [ - tclMAP - (fun (id,_,_) -> - (* The tclTRY here is used when trying to rewrite - on Set - eg (@cons A x l)=(@cons A x' l') generates 3 eqs - A=A -> x=x' -> l = l' ... - - *) - tclTRY (Equality.rewriteLR (mkVar id)) - ) - new_eqs; - reflexivity - ] - in - let new_eq_id = pf_get_new_id (id_of_string "H") g in - let create_new_eq = - forward - (Some (observe_tac "prove_new_eq" (prove_new_eq))) - (Genarg.IntroIdentifier new_eq_id) - eq_to_assert - in - let to_refine = - applist ( - mkVar hyp_id, - List.rev ((mkVar new_eq_id):: - (List.map (fun (id,_,_) -> mkVar id) context_hyps))) - in - tclTHEN - (observe_tac "create_new_eq" create_new_eq ) - (observe_tac "refine in decompose_eq " (refine to_refine)) - g - ) - ] - in - let simpl_eq_tac = - change_hyp_with_using hyp_id new_typ_of_hyp (observe_tac "prove_pattern_simplification " prove_pattern_simplification) - in - (context,nf_betaoiotazeta new_end_of_type,simpl_eq_tac),new_typ_of_hyp, - str "simplifying an equation " - -let change_eq env sigma hyp_id (context:Sign.rel_context) x t end_of_type = - if not (noccurn 1 end_of_type) - then (* if end_of_type depends on this term we don't touch it *) - begin - observe (str "Not treating " ++ pr_lconstr t ); - failwith "NoChange"; - end; - let res,new_typ_of_hyp,msg = - if not (isApp t) then failwith "NoChange"; - let f,args = destApp t in - if not (eq_constr f (Lazy.force eq)) then failwith "NoChange"; - let t1 = args.(1) - and t2 = args.(2) - in - if isRel t2 && closed0 t1 then (* closed_term = x with x bound in context *) - begin - remove_useless_rel env sigma hyp_id (context:Sign.rel_context) t end_of_type t1 t2 - end - else if isAppConstruct t1 && isAppConstruct t2 (* C .... = C .... *) - then decompose_eq env sigma hyp_id context t end_of_type t1 t2 - else failwith "NoChange" - in - observe (str "In " ++ Ppconstr.pr_id hyp_id ++ - msg ++ fnl ()++ - str "old_typ_of_hyp :=" ++ - Printer.pr_lconstr_env - env - (it_mkProd_or_LetIn ~init:end_of_type ((x,None,t)::context)) - ++ fnl () ++ - str "new_typ_of_hyp := "++ - Printer.pr_lconstr_env env new_typ_of_hyp ++ fnl ()); - (res:'a*'b*'c) - - - - -let is_property static_info t_x = - if isApp t_x - then - let pte,args = destApp t_x in - if isVar pte && array_for_all closed0 args - then Idmap.mem (destVar pte) static_info.ptes_to_fixes - else false - else false - -let isLetIn t = - match kind_of_term t with - | LetIn _ -> true - | _ -> false - - -let h_reduce_with_zeta = - h_reduce - (Rawterm.Cbv - {Rawterm.all_flags - with Rawterm.rDelta = false; - }) - -(* -let rewrite_until_var arg_num : tactic = - let constr_eq = Lazy.force eq in - let replace_if_unify arg (pat,cl,id,lhs) : tactic = - fun g -> - try - let (evd,matched) = - Unification.w_unify_to_subterm - (pf_env g) ~mod_delta:false (pat,arg) cl.Clenv.env - in - let cl' = {cl with Clenv.env = evd } in - let c2 = Clenv.clenv_nf_meta cl' lhs in - (Equality.replace matched c2) g - with _ -> tclFAIL 0 (str "") g - in - let rewrite_on_step equalities : tactic = - fun g -> - match kind_of_term (pf_concl g) with - | App(_,args) when (not (test_var args arg_num)) -> -(* tclFIRST (List.map (fun a -> observe_tac (str "replace_if_unify") (replace_if_unify args.(arg_num) a)) equalities) g *) - tclFIRST (List.map (replace_if_unify args.(arg_num)) equalities) g - | _ -> - raise (Util.UserError("", (str "No more rewrite" ++ - pr_lconstr_env (pf_env g) (pf_concl g)))) - in - fun g -> - let equalities = - List.filter - ( - fun (_,_,id_t) -> - match kind_of_term id_t with - | App(f,_) -> eq_constr f constr_eq - | _ -> false - ) - (pf_hyps g) - in - let f (id,_,ctype) = - let c = mkVar id in - let eqclause = Clenv.make_clenv_binding g (c,ctype) Rawterm.NoBindings in - let clause_type = Clenv.clenv_type eqclause in - let f,args = decompose_app (clause_type) in - let rec split_last_two = function - | [c1;c2] -> (c1, c2) - | x::y::z -> - split_last_two (y::z) - | _ -> - error ("The term provided is not an equivalence") - in - let (c1,c2) = split_last_two args in - (c2,eqclause,id,c1) - in - let matching_hyps = List.map f equalities in - tclTRY (tclREPEAT (tclPROGRESS (rewrite_on_step matching_hyps))) g - -*) - - -let rewrite_until_var arg_num eq_ids : tactic = - let test_var g = - let _,args = destApp (pf_concl g) in - isVar args.(arg_num) - in - let rec do_rewrite eq_ids g = - if test_var g - then tclIDTAC g - else - match eq_ids with - | [] -> anomaly "Cannot find a way to prove recursive property"; - | eq_id::eq_ids -> - tclTHEN - (tclTRY (Equality.rewriteRL (mkVar eq_id))) - (do_rewrite eq_ids) - g - in - do_rewrite eq_ids - -let prove_rec_hyp eq_hyps fix_info = - tclTHEN - (rewrite_until_var (fix_info.idx - 1) eq_hyps) - (fun g -> - let _,pte_args = destApp (pf_concl g) in - let rec_hyp_proof = - mkApp(mkVar fix_info.name,array_get_start pte_args) - in - refine rec_hyp_proof g - ) - - - - - -let rec_pte_id = id_of_string "Hrec" -let clean_hyp_with_heq static_infos eq_hyps hyp_id env sigma = - let coq_False = Coqlib.build_coq_False () in - let coq_True = Coqlib.build_coq_True () in - let coq_I = Coqlib.build_coq_I () in - let rec scan_type context type_of_hyp : tactic = - if isLetIn type_of_hyp then - let real_type_of_hyp = it_mkProd_or_LetIn ~init:type_of_hyp context in - let reduced_type_of_hyp = nf_betaoiotazeta real_type_of_hyp in - (* length of context didn't change ? *) - let new_context,new_typ_of_hyp = - Sign.decompose_prod_n_assum (List.length context) reduced_type_of_hyp - in - tclTHENLIST - [ - h_reduce_with_zeta - (Tacticals.onHyp hyp_id) - ; - scan_type new_context new_typ_of_hyp - - ] - else if isProd type_of_hyp - then - begin - let (x,t_x,t') = destProd type_of_hyp in - if is_property static_infos t_x then - begin - let pte,pte_args = (destApp t_x) in - let fix_info = Idmap.find (destVar pte) static_infos.ptes_to_fixes in - let popped_t' = pop t' in - let real_type_of_hyp = it_mkProd_or_LetIn ~init:popped_t' context in - let prove_new_type_of_hyp = - let context_length = List.length context in - tclTHENLIST - [ - tclDO context_length intro; - (fun g -> - let context_hyps_ids = - fst (list_chop ~msg:"rec hyp : context_hyps" - context_length (pf_ids_of_hyps g)) - in - let rec_pte_id = pf_get_new_id rec_pte_id g in - let to_refine = - applist(mkVar hyp_id, - List.rev_map mkVar (rec_pte_id::context_hyps_ids) - ) - in - tclTHENLIST - [ - forward - (Some (prove_rec_hyp eq_hyps fix_info)) - (Genarg.IntroIdentifier rec_pte_id) - t_x; - refine to_refine - ] - g - ) - ] - in - tclTHENLIST - [ - observe_tac "hyp rec" - (change_hyp_with_using hyp_id real_type_of_hyp prove_new_type_of_hyp); - scan_type context popped_t' - ] - end - else if eq_constr t_x coq_False then - begin - observe (str "Removing : "++ Ppconstr.pr_id hyp_id++ - str " since it has False in its preconds " - ); - raise TOREMOVE; (* False -> .. useless *) - end - else if is_incompatible_eq t_x then raise TOREMOVE (* t_x := C1 ... = C2 ... *) - else if eq_constr t_x coq_True (* Trivial => we remove this precons *) - then - let _ = - observe (str "In "++Ppconstr.pr_id hyp_id++ - str " removing useless precond True" - ) - in - let popped_t' = pop t' in - let real_type_of_hyp = - it_mkProd_or_LetIn ~init:popped_t' context - in - let prove_trivial = - let nb_intro = List.length context in - tclTHENLIST [ - tclDO nb_intro intro; - (fun g -> - let context_hyps = - fst (list_chop ~msg:"removing True : context_hyps "nb_intro (pf_ids_of_hyps g)) - in - let to_refine = - applist (mkVar hyp_id, - List.rev (coq_I::List.map mkVar context_hyps) - ) - in - refine to_refine g - ) - ] - in - tclTHENLIST[ - change_hyp_with_using hyp_id real_type_of_hyp (observe_tac "prove_trivial" prove_trivial); - scan_type context popped_t' - ] - else if is_trivial_eq t_x - then (* t_x := t = t => we remove this precond *) - let popped_t' = pop t' in - let real_type_of_hyp = - it_mkProd_or_LetIn ~init:popped_t' context - in - let _,args = destApp t_x in - tclTHENLIST - [ - change_hyp_with_using - hyp_id - real_type_of_hyp - (observe_tac "prove_trivial_eq" (prove_trivial_eq hyp_id context (args.(0),args.(1)))); - scan_type context popped_t' - ] - else - begin - try - let new_context,new_t',tac = change_eq env sigma hyp_id context x t_x t' in - tclTHEN - tac - (scan_type new_context new_t') - with Failure "NoChange" -> - (* Last thing todo : push the rel in the context and continue *) - scan_type ((x,None,t_x)::context) t' - end - end - else - tclIDTAC - in - try - scan_type [] (Typing.type_of env sigma (mkVar hyp_id)), [hyp_id] - with TOREMOVE -> - thin [hyp_id],[] - - -let clean_goal_with_heq static_infos continue_tac dyn_infos = - fun g -> - let env = pf_env g - and sigma = project g - in - let tac,new_hyps = - List.fold_left ( - fun (hyps_tac,new_hyps) hyp_id -> - let hyp_tac,new_hyp = - clean_hyp_with_heq static_infos dyn_infos.eq_hyps hyp_id env sigma - in - (tclTHEN hyp_tac hyps_tac),new_hyp@new_hyps - ) - (tclIDTAC,[]) - dyn_infos.rec_hyps - in - let new_infos = - { dyn_infos with - rec_hyps = new_hyps; - nb_rec_hyps = List.length new_hyps - } - in - tclTHENLIST - [ - tac ; - (continue_tac new_infos) - ] - g - -let heq_id = id_of_string "Heq" - -let treat_new_case static_infos nb_prod continue_tac term dyn_infos = - fun g -> - let heq_id = pf_get_new_id heq_id g in - let nb_first_intro = nb_prod - 1 - dyn_infos.nb_rec_hyps in - tclTHENLIST - [ - (* We first introduce the variables *) - tclDO nb_first_intro (intro_avoiding dyn_infos.rec_hyps); - (* Then the equation itself *) - introduction_no_check heq_id; - (* Then the new hypothesis *) - tclMAP introduction_no_check dyn_infos.rec_hyps; - 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 *) - let new_term_value = - match kind_of_term new_term_value_eq with - | App(f,[| _;_;args2 |]) -> args2 - | _ -> - observe (pr_gls g' ++ fnl () ++ str "last hyp is" ++ - pr_lconstr_env (pf_env g') new_term_value_eq - ); - assert false - in - let fun_body = - mkLambda(Anonymous, - pf_type_of g' term, - replace_term term (mkRel 1) dyn_infos.info - ) - in - let new_body = pf_nf_betaiota g' (mkApp(fun_body,[| new_term_value |])) in - let new_infos = - {dyn_infos with - info = new_body; - eq_hyps = heq_id::dyn_infos.eq_hyps - } - in - clean_goal_with_heq static_infos continue_tac new_infos g' - ) - ] - g - -let do_prove_princ_for_struct - (interactive_proof:bool) - (fnames:constant list) - static_infos -(* (ptes:identifier list) *) -(* (fixes:(int*constr*identifier*constr) Idmap.t) *) -(* (hyps: identifier list) *) -(* (term:constr) *) - dyn_infos - : tactic = -(* let fixes_ids = Idmap.fold (fun _ (_,_,id,_) acc -> id::acc) fixes [] in *) - let rec do_prove_princ_for_struct_aux do_finalize dyn_infos : tactic = - fun g -> -(* observe (str "proving on " ++ Printer.pr_lconstr_env (pf_env g) term);*) - match kind_of_term dyn_infos.info with - | Case(_,_,t,_) -> - let g_nb_prod = nb_prod (pf_concl g) in - let type_of_term = pf_type_of g t in - let term_eq = - make_refl_eq type_of_term t - in - tclTHENSEQ - [ - h_generalize (term_eq::List.map mkVar dyn_infos.rec_hyps); - thin dyn_infos.rec_hyps; - pattern_option [[-1],t] None; - h_simplest_case t; - (fun g' -> - let g'_nb_prod = nb_prod (pf_concl g') in - let nb_instanciate_partial = g'_nb_prod - g_nb_prod in - observe_tac "treat_new_case" - (treat_new_case - static_infos - nb_instanciate_partial - (do_prove_princ_for_struct do_finalize) - t - dyn_infos) - g' - ) - - ] g - | Lambda(n,t,b) -> - begin - match kind_of_term( pf_concl g) with - | Prod _ -> - tclTHEN - intro - (fun g' -> - let (id,_,_) = pf_last_hyp g' in - let new_term = - pf_nf_betaiota g' - (mkApp(dyn_infos.info,[|mkVar id|])) - in - let new_infos = {dyn_infos with info = new_term} in - do_prove_princ_for_struct do_finalize new_infos g' - ) g - | _ -> - do_finalize dyn_infos g - end - | Cast(t,_,_) -> - do_prove_princ_for_struct do_finalize {dyn_infos with info = t} g - | Const _ | Var _ | Meta _ | Evar _ | Sort _ | Construct _ | Ind _ -> - do_finalize dyn_infos g - | App(_,_) -> - let f,args = decompose_app dyn_infos.info in - begin - match kind_of_term f with - | Var _ | Construct _ | Rel _ | Evar _ | Meta _ | Ind _ -> - let new_infos = - { dyn_infos with - info = (f,args) - } - in - do_prove_princ_for_struct_args do_finalize new_infos g - | Const c when not (List.mem c fnames) -> - let new_infos = - { dyn_infos with - info = (f,args) - } - in - do_prove_princ_for_struct_args do_finalize new_infos g - | Const _ -> - do_finalize dyn_infos g - | _ -> -(* observe *) -(* (str "Applied binders not yet implemented: in "++ fnl () ++ *) -(* pr_lconstr_env (pf_env g) term ++ fnl () ++ *) -(* pr_lconstr_env (pf_env g) f ++ spc () ++ str "is applied") ; *) - tclFAIL 0 (str "TODO : Applied binders not yet implemented") g - end - | Fix _ | CoFix _ -> - error ( "Anonymous local (co)fixpoints are not handled yet") - - | Prod _ -> assert false - | LetIn _ -> - let new_infos = - { dyn_infos with - info = nf_betaoiotazeta dyn_infos.info - } - in - - tclTHENLIST - [tclMAP - (fun hyp_id -> h_reduce_with_zeta (Tacticals.onHyp hyp_id)) - dyn_infos.rec_hyps; - h_reduce_with_zeta Tacticals.onConcl; - do_prove_princ_for_struct do_finalize new_infos - ] g - | _ -> - errorlabstrm "" (str "in do_prove_princ_for_struct found : "(* ++ *) -(* pr_lconstr_env (pf_env g) term *) - ) - and do_prove_princ_for_struct do_finalize dyn_infos g = -(* observe (str "proving with "++Printer.pr_lconstr term++ str " on goal " ++ pr_gls g); *) - do_prove_princ_for_struct_aux do_finalize dyn_infos g - and do_prove_princ_for_struct_args do_finalize dyn_infos (* f_args' args *) :tactic = - fun g -> -(* if Tacinterp.get_debug () <> Tactic_debug.DebugOff *) -(* then msgnl (str "do_prove_princ_for_struct_args with " ++ *) -(* pr_lconstr_env (pf_env g) f_args' *) -(* ); *) - let (f_args',args) = dyn_infos.info in - let tac = - match args with - | [] -> - do_finalize {dyn_infos with info = f_args'} - | arg::args -> - let do_finalize dyn_infos = - let new_arg = dyn_infos.info in - tclTRYD - (do_prove_princ_for_struct_args - do_finalize - {dyn_infos with info = (mkApp(f_args',[|new_arg|])), args} - ) - in - do_prove_princ_for_struct do_finalize - {dyn_infos with info = arg } - in - tclTRYD(tac ) g - in - let do_finish_proof dyn_infos = - clean_goal_with_heq - static_infos - finish_proof dyn_infos - in - observe_tac "do_prove_princ_for_struct" - (do_prove_princ_for_struct do_finish_proof dyn_infos) - -let is_pte_type t = - isSort (snd (decompose_prod t)) - -let is_pte (_,_,t) = is_pte_type t - -exception Not_Rec - - - -let instanciate_hyps_with_args (do_prove:identifier list -> tactic) hyps args_id = - let args = Array.of_list (List.map mkVar args_id) in - let instanciate_one_hyp hid = - tclORELSE - ( (* we instanciate the hyp if possible *) -(* tclTHENLIST *) -(* [h_generalize [mkApp(mkVar hid,args)]; *) -(* intro_erasing hid] *) - fun g -> - let prov_hid = pf_get_new_id hid g in - tclTHENLIST[ - forward None (Genarg.IntroIdentifier prov_hid) (mkApp(mkVar hid,args)); - thin [hid]; - h_rename prov_hid hid - ] g - ) - ( (* - if not then we are in a mutual function block - and this hyp is a recursive hyp on an other function. - - We are not supposed to use it while proving this - principle so that we can trash it - - *) - (fun g -> - observe (str "Instanciation: removing hyp " ++ Ppconstr.pr_id hid); - thin [hid] g - ) - ) - in - (* if no args then no instanciation ! *) - if args_id = [] - then - tclTHENLIST [ - tclMAP (fun hyp_id -> h_reduce_with_zeta (Tacticals.onHyp hyp_id)) hyps; - do_prove hyps - ] - else - tclTHENLIST - [ - tclMAP (fun hyp_id -> h_reduce_with_zeta (Tacticals.onHyp hyp_id)) hyps; - tclMAP instanciate_one_hyp hyps; - (fun g -> - let all_g_hyps_id = - List.fold_right Idset.add (pf_ids_of_hyps g) Idset.empty - in - let remaining_hyps = - List.filter (fun id -> Idset.mem id all_g_hyps_id) hyps - in - do_prove remaining_hyps g - ) - ] - - -let prove_princ_for_struct interactive_proof fun_num fnames all_funs _naprams : tactic = - fun goal -> -(* observe (str "Proving principle for "++ str (string_of_int fun_num) ++ str "th function : " ++ *) -(* pr_lconstr (mkConst fnames.(fun_num))); *) - let princ_type = pf_concl goal in - let princ_info = compute_elim_sig princ_type in - let get_body const = - match (Global.lookup_constant const ).const_body with - | Some b -> - let body = force b in - Tacred.cbv_norm_flags - (Closure.RedFlags.mkflags [Closure.RedFlags.fZETA]) - (Global.env ()) - (Evd.empty) - body - | None -> error ( "Cannot define a principle over an axiom ") - in - let fbody = get_body fnames.(fun_num) in - let params : identifier list ref = ref [] in - let predicates : identifier list ref = ref [] in - let args : identifier list ref = ref [] in - let branches : identifier list ref = ref [] in - let pte_to_fix = ref Idmap.empty in - let fbody_with_params = ref None in - let intro_with_remembrance ref number : tactic = - tclTHEN - ( tclDO number intro ) - (fun g -> - let last_n = list_chop number (pf_hyps g) in - ref := List.map (fun (id,_,_) -> id) (fst last_n)@ !ref; - tclIDTAC g - ) - in - let rec partial_combine body params = - match kind_of_term body,params with - | Lambda (x,t,b),param::params -> - partial_combine (subst1 param b) params - | Fix(infos),_ -> - body,params, Some (infos) - | _ -> body,params,None - in - let build_pte_to_fix (offset:int) params predicates - ((idxs,fix_num),(na,typearray,ca)) (avoid,_) = -(* let true_params,_ = list_chop offset params in *) - let true_params = List.rev params in - let avoid = ref avoid in - let res = list_fold_left_i - (fun i acc pte_id -> - let this_fix_id = fresh_id !avoid "fix___" in - avoid := this_fix_id::!avoid; -(* let this_body = substl (List.rev fnames_as_constr) ca.(i) in *) - let new_type = prod_applist typearray.(i) true_params in - let new_type_args,_ = decompose_prod new_type in - let nargs = List.length new_type_args in - let pte_args = - (* let rev_args = List.rev_map (fun (id,_,_) -> mkVar id) new_type_args in *) - let f = applist((* all_funs *)mkConst fnames.(i),true_params) in - let app_f = mkApp(f,Array.init nargs (fun i -> mkRel(nargs - i))) in - (Array.to_list (Array.init nargs (fun i -> mkRel(nargs - i))))@[app_f] - in - let app_pte = applist(mkVar pte_id,pte_args) in - let new_type = compose_prod new_type_args app_pte in - let fix_info = - { - idx = idxs.(i) - offset + 1; - name = this_fix_id; - types = new_type - } - in - pte_to_fix := Idmap.add pte_id fix_info !pte_to_fix; - fix_info::acc - ) - 0 - [] - predicates - in - !avoid,List.rev res - in - let mk_fixes : tactic = - fun g -> - let body_p,params',fix_infos = - partial_combine fbody (List.rev_map mkVar !params) - in - fbody_with_params := Some body_p; - let offset = List.length params' in - let not_real_param,true_params = - list_chop - ((List.length !params ) - offset) - !params - in - params := true_params; args := not_real_param; -(* observe (str "mk_fixes : params are "++ *) -(* prlist_with_sep spc *) -(* (fun id -> pr_lconstr (mkVar id)) *) -(* !params *) -(* ); *) - let new_avoid,infos = - option_fold_right - (build_pte_to_fix - offset - (List.map mkVar !params) - (List.rev !predicates) - ) - fix_infos - ((pf_ids_of_hyps g),[]) - in - let pre_info,infos = list_chop fun_num infos in - match pre_info,infos with - | [],[] -> tclIDTAC g - | _,this_fix_info::infos' -> - let other_fix_info = - List.map - (fun fix_info -> fix_info.name,fix_info.idx,fix_info.types) - (pre_info@infos') - in - tclORELSE - (h_mutual_fix this_fix_info.name this_fix_info.idx other_fix_info) - (tclFAIL 1000 (str "bad index" ++ - str (string_of_int this_fix_info.idx) ++ - str "offset := " ++ - (str (string_of_int offset)))) - g - | _,[] -> anomaly "Not a valid information" - in - let do_prove ptes_to_fixes args branches : tactic = - fun g -> - let static_infos = - { - ptes_to_fixes = ptes_to_fixes; - fixes_ids = - Idmap.fold - (fun _ fix_info acc -> fix_info.name::acc) - ptes_to_fixes [] - } - in - match kind_of_term (pf_concl g) with - | App(pte,pte_args) when isVar pte -> - begin - let pte = destVar pte in - try - if not (Idmap.mem pte ptes_to_fixes) then raise Not_Rec; - let nparams = List.length !params in - let args_as_constr = List.map mkVar args in - let rec_num,new_body = - let idx' = list_index pte (List.rev !predicates) - 1 in - let f = fnames.(idx') in - let body_with_params = match !fbody_with_params with Some f -> f | _ -> anomaly "" - in - let name_of_f = Name ( id_of_label (con_label f)) in - let ((rec_nums,_),(na,_,bodies)) = destFix body_with_params in - let idx'' = list_index name_of_f (Array.to_list na) - 1 in - let body = substl (List.rev (Array.to_list all_funs)) bodies.(idx'') in - let body = Reductionops.nf_beta (applist(body,(List.rev_map mkVar !params))) in - rec_nums.(idx'') - nparams ,body - in - let applied_body = - Reductionops.nf_beta - (applist(new_body,List.rev args_as_constr)) - in - let do_prove branches applied_body = - do_prove_princ_for_struct - interactive_proof - (Array.to_list fnames) - static_infos - branches - applied_body - in - let replace_and_prove = - tclTHENS - (fun g -> -(* observe (str "replacing " ++ *) -(* pr_lconstr_env (pf_env g) (array_last pte_args) ++ *) -(* str " with " ++ *) -(* pr_lconstr_env (pf_env g) applied_body ++ *) -(* str " rec_arg_num is " ++ str (string_of_int rec_num) *) -(* ); *) - (Equality.replace (array_last pte_args) applied_body) g - ) - [ - clean_goal_with_heq - static_infos do_prove - { - nb_rec_hyps = List.length branches; - rec_hyps = branches; - info = applied_body; - eq_hyps = []; - } ; - try - let id = List.nth (List.rev args_as_constr) (rec_num) in - (* observe (str "choosen var := "++ pr_lconstr id); *) - (tclTHENSEQ - [(h_simplest_case id); - Tactics.intros_reflexivity - ]) - with _ -> tclIDTAC - - ] - in - (observe_tac "doing replacement" ( replace_and_prove)) g - with Not_Rec -> - let fname = destConst (fst (decompose_app (array_last pte_args))) in - tclTHEN - (unfold_in_concl [([],Names.EvalConstRef fname)]) - (observe_tac "" - (fun g' -> - let body = array_last (snd (destApp (pf_concl g'))) in - let dyn_infos = - { nb_rec_hyps = List.length branches; - rec_hyps = branches; - info = body; - eq_hyps = [] - } - in - let do_prove = - do_prove_princ_for_struct - interactive_proof - (Array.to_list fnames) - static_infos - in - clean_goal_with_heq static_infos - do_prove dyn_infos g' - ) - ) - g - end - | _ -> assert false - in - tclTHENSEQ - [ - (fun g -> observe_tac "introducing params" (intro_with_remembrance params princ_info.nparams) g); - (fun g -> observe_tac "introducing predicate" (intro_with_remembrance predicates princ_info.npredicates) g); - (fun g -> observe_tac "introducing branches" (intro_with_remembrance branches princ_info.nbranches) g); - (fun g -> observe_tac "declaring fix(es)" mk_fixes g); - (fun g -> - let nb_prod_g = nb_prod (pf_concl g) in - tclTHENLIST [ - tclDO nb_prod_g intro; - (fun g' -> - let args = - fst (list_chop ~msg:"args" nb_prod_g (pf_ids_of_hyps g')) - in - let do_prove_on_branches branches : tactic = - observe_tac "proving" (do_prove !pte_to_fix args branches) - in - observe_tac "instanciating rec hyps" - (instanciate_hyps_with_args do_prove_on_branches !branches (List.rev args)) - g' - ) - ] - g - ) - ] - goal - - - - - - - - - - - - - - - - - - - - - - - -exception Toberemoved_with_rel of int*constr -exception Toberemoved - -let compute_new_princ_type_from_rel rel_to_fun sorts princ_type = - let princ_type_info = compute_elim_sig princ_type in - let env = Global.env () in -(* let type_sort = (Termops.new_sort_in_family InType) in *) - let change_predicate_sort i (x,_,t) = - let new_sort = sorts.(i) in - let args,_ = decompose_prod t in - let real_args = - if princ_type_info.indarg_in_concl - then List.tl args - else args - in - x,None,compose_prod real_args (mkSort new_sort) - in - let new_predicates = - list_map_i - change_predicate_sort - 0 - princ_type_info.predicates - in - let env_with_params_and_predicates = - Environ.push_rel_context - new_predicates - (Environ.push_rel_context - princ_type_info.params - env - ) - in - let rel_as_kn = - fst (match princ_type_info.indref with - | Some (Libnames.IndRef ind) -> ind - | _ -> failwith "Not a valid predicate" - ) - in - let pre_princ = - it_mkProd_or_LetIn - ~init: - (it_mkProd_or_LetIn - ~init:(option_fold_right - mkProd_or_LetIn - princ_type_info.indarg - princ_type_info.concl - ) - princ_type_info.args - ) - princ_type_info.branches - in - let is_dom c = - match kind_of_term c with - | Ind((u,_)) -> u = rel_as_kn - | Construct((u,_),_) -> u = rel_as_kn - | _ -> false - in - let get_fun_num c = - match kind_of_term c with - | Ind(_,num) -> num - | Construct((_,num),_) -> num - | _ -> assert false - in - let dummy_var = mkVar (id_of_string "________") in - let mk_replacement c i args = - let res = mkApp(rel_to_fun.(i),Array.map pop (array_get_start args)) in -(* observe (str "replacing " ++ pr_lconstr c ++ str " by " ++ pr_lconstr res); *) - res - in - let rec has_dummy_var t = - fold_constr - (fun b t -> b || (eq_constr t dummy_var) || (has_dummy_var t)) - false - t - in - let rec compute_new_princ_type remove env pre_princ : types*(constr list) = - let (new_princ_type,_) as res = - match kind_of_term pre_princ with - | Rel n -> - begin - try match Environ.lookup_rel n env with - | _,_,t when is_dom t -> raise Toberemoved - | _ -> pre_princ,[] with Not_found -> assert false - end - | Prod(x,t,b) -> - compute_new_princ_type_for_binder remove mkProd env x t b - | Lambda(x,t,b) -> - compute_new_princ_type_for_binder remove mkLambda env x t b - | Ind _ | Construct _ when is_dom pre_princ -> raise Toberemoved - | App(f,args) when is_dom f -> - let var_to_be_removed = destRel (array_last args) in - let num = get_fun_num f in - raise (Toberemoved_with_rel (var_to_be_removed,mk_replacement pre_princ num args)) - | App(f,args) -> - let is_pte = - match kind_of_term f with - | Rel n -> - is_pte (Environ.lookup_rel n env) - | _ -> false - in - let args = - if is_pte && remove - then array_get_start args - else args - in - let new_args,binders_to_remove = - Array.fold_right (compute_new_princ_type_with_acc remove env) - args - ([],[]) - in - let new_f,binders_to_remove_from_f = compute_new_princ_type remove env f in - applist(new_f, new_args), - list_union_eq eq_constr binders_to_remove_from_f binders_to_remove - | LetIn(x,v,t,b) -> - compute_new_princ_type_for_letin remove env x v t b - | _ -> pre_princ,[] - in -(* observennl ( *) -(* match kind_of_term pre_princ with *) -(* | Prod _ -> *) -(* str "compute_new_princ_type for "++ *) -(* pr_lconstr_env env pre_princ ++ *) -(* str" is "++ *) -(* pr_lconstr_env env new_princ_type ++ fnl () *) -(* | _ -> str "" *) -(* ); *) - res - - and compute_new_princ_type_for_binder remove bind_fun env x t b = - begin - try - let new_t,binders_to_remove_from_t = compute_new_princ_type remove env t in - let new_x : name = get_name (ids_of_context env) x in - let new_env = Environ.push_rel (x,None,t) env in - let new_b,binders_to_remove_from_b = compute_new_princ_type remove new_env b in - if List.exists (eq_constr (mkRel 1)) binders_to_remove_from_b - then (pop new_b),filter_map (eq_constr (mkRel 1)) pop binders_to_remove_from_b - else - ( - bind_fun(new_x,new_t,new_b), - list_union_eq - eq_constr - binders_to_remove_from_t - (List.map pop binders_to_remove_from_b) - ) - - with - | Toberemoved -> -(* msgnl (str "Decl of "++Ppconstr.pr_name x ++ str " is removed "); *) - let new_b,binders_to_remove_from_b = compute_new_princ_type remove env (substnl [dummy_var] 1 b) in - new_b, List.map pop binders_to_remove_from_b - | Toberemoved_with_rel (n,c) -> -(* msgnl (str "Decl of "++Ppconstr.pr_name x ++ str " is removed "); *) - let new_b,binders_to_remove_from_b = compute_new_princ_type remove env (substnl [c] n b) in - new_b, list_add_set_eq eq_constr (mkRel n) (List.map pop binders_to_remove_from_b) - end - and compute_new_princ_type_for_letin remove env x v t b = - begin - try - let new_t,binders_to_remove_from_t = compute_new_princ_type remove env t in - let new_v,binders_to_remove_from_v = compute_new_princ_type remove env v in - let new_x : name = get_name (ids_of_context env) x in - let new_env = Environ.push_rel (x,Some v,t) env in - let new_b,binders_to_remove_from_b = compute_new_princ_type remove new_env b in - if List.exists (eq_constr (mkRel 1)) binders_to_remove_from_b - then (pop new_b),filter_map (eq_constr (mkRel 1)) pop binders_to_remove_from_b - else - ( - mkLetIn(new_x,new_v,new_t,new_b), - list_union_eq - eq_constr - (list_union_eq eq_constr binders_to_remove_from_t binders_to_remove_from_v) - (List.map pop binders_to_remove_from_b) - ) - - with - | Toberemoved -> -(* msgnl (str "Decl of "++Ppconstr.pr_name x ++ str " is removed "); *) - let new_b,binders_to_remove_from_b = compute_new_princ_type remove env (substnl [dummy_var] 1 b) in - new_b, List.map pop binders_to_remove_from_b - | Toberemoved_with_rel (n,c) -> -(* msgnl (str "Decl of "++Ppconstr.pr_name x ++ str " is removed "); *) - let new_b,binders_to_remove_from_b = compute_new_princ_type remove env (substnl [c] n b) in - new_b, list_add_set_eq eq_constr (mkRel n) (List.map pop binders_to_remove_from_b) - end - and compute_new_princ_type_with_acc remove env e (c_acc,to_remove_acc) = - let new_e,to_remove_from_e = compute_new_princ_type remove env e - in - new_e::c_acc,list_union_eq eq_constr to_remove_from_e to_remove_acc - in -(* observe (str "Computing new principe from " ++ pr_lconstr_env env_with_params_and_predicates pre_princ); *) - let pre_res,_ = - compute_new_princ_type princ_type_info.indarg_in_concl env_with_params_and_predicates pre_princ in - it_mkProd_or_LetIn - ~init:(it_mkProd_or_LetIn ~init:pre_res new_predicates) - princ_type_info.params - - - -let change_property_sort toSort princ princName = - let princ_info = compute_elim_sig princ in - let change_sort_in_predicate (x,v,t) = - (x,None, - let args,_ = decompose_prod t in - compose_prod args (mkSort toSort) - ) - in - let princName_as_constr = Tacinterp.constr_of_id (Global.env ()) princName in - let init = - let nargs = (princ_info.nparams + (List.length princ_info.predicates)) in - mkApp(princName_as_constr, - Array.init nargs - (fun i -> mkRel (nargs - i ))) - in - it_mkLambda_or_LetIn - ~init: - (it_mkLambda_or_LetIn ~init - (List.map change_sort_in_predicate princ_info.predicates) - ) - princ_info.params - - -let pp_dur time time' = - str (string_of_float (System.time_difference time time')) - -(* Things to be removed latter : just here to compare - saving proof with and without normalizing the proof -*) -let new_save id const (locality,kind) hook = - let {const_entry_body = pft; - const_entry_type = tpo; - const_entry_opaque = opacity } = const in - let l,r = match locality with - | Decl_kinds.Local when Lib.sections_are_opened () -> - let k = Decl_kinds.logical_kind_of_goal_kind kind in - let c = Declare.SectionLocalDef (pft, tpo, opacity) in - let _ = Declare.declare_variable id (Lib.cwd(), c, k) in - (Decl_kinds.Local, Libnames.VarRef id) - | Decl_kinds.Local -> - let k = Decl_kinds.logical_kind_of_goal_kind kind in - let kn = Declare.declare_constant id (DefinitionEntry const, k) in - (Decl_kinds.Global, Libnames.ConstRef kn) - | Decl_kinds.Global -> - let k = Decl_kinds.logical_kind_of_goal_kind kind in - let kn = Declare.declare_constant id (DefinitionEntry const, k) in - (Decl_kinds.Global, Libnames.ConstRef kn) in - let time1 = System.get_time () in - Pfedit.delete_current_proof (); - let time2 = System.get_time () in - hook l r; - time1,time2 -(* definition_message id *) - - - - - -let new_save_named opacity = -(* if do_observe () *) -(* then *) - let time1 = System.get_time () in - let id,(const,persistence,hook) = Pfedit.cook_proof () in - let time2 = System.get_time () in - let const = - { const with - const_entry_body = (* nf_betaoiotazeta *)const.const_entry_body ; - const_entry_opaque = opacity - } - in - let time3 = System.get_time () in - let time4,time5 = new_save id const persistence hook in - let time6 = System.get_time () in - Pp.msgnl - (str "cooking proof time : " ++ pp_dur time1 time2 ++ fnl () ++ - str "reducing proof time : " ++ pp_dur time2 time3 ++ fnl () ++ - str "saving proof time : " ++ pp_dur time3 time4 ++fnl () ++ - str "deleting proof time : " ++ pp_dur time4 time5 ++fnl () ++ - str "hook time :" ++ pp_dur time5 time6 - ) - -;; - -(* End of things to be removed latter : just here to compare - saving proof with and without normalizing the proof -*) - - -let generate_functional_principle - interactive_proof - old_princ_type sorts new_princ_name funs i proof_tac - = - let f = funs.(i) in - let type_sort = Termops.new_sort_in_family InType in - let new_sorts = - match sorts with - | None -> Array.make (Array.length funs) (type_sort) - | Some a -> a - in - (* First we get the type of the old graph principle *) - let mutr_nparams = (compute_elim_sig old_princ_type).nparams in - (* First we get the type of the old graph principle *) - let new_principle_type = - compute_new_princ_type_from_rel - (Array.map mkConst funs) - new_sorts - old_princ_type - in -(* observe (str "new_principle_type : " ++ pr_lconstr new_principle_type); *) - let base_new_princ_name,new_princ_name = - match new_princ_name with - | Some (id) -> id,id - | None -> - let id_of_f = id_of_label (con_label f) in - id_of_f,Indrec.make_elimination_ident id_of_f (family_of_sort type_sort) - in - let names = ref [new_princ_name] in - let hook _ _ = - if sorts = None - then -(* let id_of_f = id_of_label (con_label f) in *) - let register_with_sort fam_sort = - let s = Termops.new_sort_in_family fam_sort in - let name = Indrec.make_elimination_ident base_new_princ_name fam_sort in - let value = - change_property_sort s new_principle_type new_princ_name - in -(* Pp.msgnl (str "new principle := " ++ pr_lconstr value); *) - let ce = - { const_entry_body = value; - const_entry_type = None; - const_entry_opaque = false; - const_entry_boxed = Options.boxed_definitions() - } - in - ignore( - Declare.declare_constant - name - (Entries.DefinitionEntry ce, - Decl_kinds.IsDefinition (Decl_kinds.Scheme) - ) - ); - names := name :: !names - in - register_with_sort InProp; - register_with_sort InSet - in - begin - Command.start_proof - new_princ_name - (Decl_kinds.Global,(Decl_kinds.Proof Decl_kinds.Theorem)) - new_principle_type - hook - ; - try - let _tim1 = System.get_time () in - Pfedit.by (proof_tac (Array.map mkConst funs) mutr_nparams); - let _tim2 = System.get_time () in -(* begin *) -(* let dur1 = System.time_difference tim1 tim2 in *) -(* Pp.msgnl (str ("Time to compute proof: ") ++ str (string_of_float dur1)); *) -(* end; *) - let do_save = not (do_observe ()) && not interactive_proof in - let _ = - try - Options.silently Command.save_named true; - let _dur2 = System.time_difference _tim2 (System.get_time ()) in -(* Pp.msgnl (str ("Time to check proof: ") ++ str (string_of_float dur2)); *) - Options.if_verbose - (fun () -> - Pp.msgnl ( - prlist_with_sep - (fun () -> str" is defined " ++ fnl ()) - Ppconstr.pr_id - (List.rev !names) ++ str" is defined " - ) - ) - () - with e when do_save -> - msg_warning - ( - Cerrors.explain_exn e - ); - if not (do_observe ()) - then begin Vernacentries.interp (Vernacexpr.VernacAbort None);raise e end - in - () - -(* let tim3 = Sys.time () in *) -(* Pp.msgnl (str ("Time to save proof: ") ++ str (string_of_float (tim3 -. tim2))); *) - - with - | e -> - msg_warning - ( - Cerrors.explain_exn e - ); - if not ( do_observe ()) - then begin Vernacentries.interp (Vernacexpr.VernacAbort None);raise e end - end - - - - - - -let get_funs_constant mp dp = - let rec get_funs_constant const e : (Names.constant*int) array = - match kind_of_term (snd (decompose_lam e)) with - | Fix((_,(na,_,_))) -> - Array.mapi - (fun i na -> - match na with - | Name id -> - let const = make_con mp dp (label_of_id id) in - const,i - | Anonymous -> - anomaly "Anonymous fix" - ) - na - | _ -> [|const,0|] - in - function const -> - let find_constant_body const = - match (Global.lookup_constant const ).const_body with - | Some b -> - let body = force b in - let body = Tacred.cbv_norm_flags - (Closure.RedFlags.mkflags [Closure.RedFlags.fZETA]) - (Global.env ()) - (Evd.empty) - body - in - body - | None -> error ( "Cannot define a principle over an axiom ") - in - let f = find_constant_body const in - let l_const = get_funs_constant const f in - (* - We need to check that all the functions found are in the same block - to prevent Reset stange thing - *) - let l_bodies = List.map find_constant_body (Array.to_list (Array.map fst l_const)) in - let l_params,l_fixes = List.split (List.map decompose_lam l_bodies) in - (* all the paremeter must be equal*) - let _check_params = - let first_params = List.hd l_params in - List.iter - (fun params -> - if not ((=) first_params params) - then error "Not a mutal recursive block" - ) - l_params - in - (* The bodies has to be very similar *) - let _check_bodies = - try - let extract_info is_first body = - match kind_of_term body with - | Fix((idxs,_),(na,ta,ca)) -> (idxs,na,ta,ca) - | _ -> - if is_first && (List.length l_bodies = 1) - then raise Not_Rec - else error "Not a mutal recursive block" - in - let first_infos = extract_info true (List.hd l_bodies) in - let check body = (* Hope this is correct *) - if not (first_infos = (extract_info false body)) - then error "Not a mutal recursive block" - in - List.iter check l_bodies - with Not_Rec -> () - in - l_const - -let make_scheme fas = - let env = Global.env () - and sigma = Evd.empty in - let id_to_constr id = - Tacinterp.constr_of_id env id - in - let funs = List.map (fun (_,f,_) -> id_to_constr f) fas in - let first_fun = destConst (List.hd funs) in - let funs_mp,funs_dp,first_fun_id = Names.repr_con first_fun in - let first_fun_rel_id = mk_rel_id (id_of_label first_fun_id) in - let first_fun_kn = - (* Fixme: take into accour funs_mp and funs_dp *) - fst (destInd (id_to_constr first_fun_rel_id)) - in - let this_block_funs_indexes = get_funs_constant funs_mp funs_dp first_fun in - let this_block_funs = Array.map fst this_block_funs_indexes in - let prop_sort = InProp in - let funs_indexes = - let this_block_funs_indexes = Array.to_list this_block_funs_indexes in - List.map - (function const -> List.assoc (destConst const) this_block_funs_indexes) - funs - in - let ind_list = - List.map - (fun (idx) -> - let ind = first_fun_kn,idx in - let (mib,mip) = Global.lookup_inductive ind in - ind,mib,mip,true,prop_sort - ) - funs_indexes - in - let l_schemes = List.map (Typing.type_of env sigma ) (Indrec.build_mutual_indrec env sigma ind_list) in - let i = ref (-1) in - let sorts = - List.rev_map (fun (_,_,x) -> - Termops.new_sort_in_family (Pretyping.interp_elimination_sort x) - ) - fas - in - let princ_names = List.map (fun (x,_,_) -> x) fas in - let _ = List.map2 - (fun princ_name scheme_type -> - incr i; -(* observe (str "Generating " ++ Ppconstr.pr_id princ_name ++str " with " ++ *) -(* pr_lconstr scheme_type ++ str " and " ++ (fun a -> prlist_with_sep spc (fun c -> pr_lconstr (mkConst c)) (Array.to_list a)) this_block_funs *) -(* ); *) - generate_functional_principle - false - scheme_type - (Some (Array.of_list sorts)) - (Some princ_name) - this_block_funs - !i - (prove_princ_for_struct false !i (Array.of_list (List.map destConst funs))) - ) - princ_names - l_schemes - in - () - -let make_case_scheme fa = - let env = Global.env () - and sigma = Evd.empty in - let id_to_constr id = - Tacinterp.constr_of_id env id - in - let funs = (fun (_,f,_) -> id_to_constr f) fa in - let first_fun = destConst funs in - let funs_mp,funs_dp,first_fun_id = Names.repr_con first_fun in - let first_fun_rel_id = mk_rel_id (id_of_label first_fun_id) in - let first_fun_kn = - (* Fixme: take into accour funs_mp and funs_dp *) - fst (destInd (id_to_constr first_fun_rel_id)) - in - let this_block_funs_indexes = get_funs_constant funs_mp funs_dp first_fun in - let this_block_funs = Array.map fst this_block_funs_indexes in - let prop_sort = InProp in - let funs_indexes = - let this_block_funs_indexes = Array.to_list this_block_funs_indexes in - List.assoc (destConst funs) this_block_funs_indexes - in - let ind_fun = - let ind = first_fun_kn,funs_indexes in - ind,prop_sort - in - let scheme_type = (Typing.type_of env sigma ) ((fun (ind,sf) -> Indrec.make_case_gen env sigma ind sf) ind_fun) in - let sorts = - (fun (_,_,x) -> - Termops.new_sort_in_family (Pretyping.interp_elimination_sort x) - ) - fa - in - let princ_name = (fun (x,_,_) -> x) fa in - let _ = -(* observe (str "Generating " ++ Ppconstr.pr_id princ_name ++str " with " ++ *) -(* pr_lconstr scheme_type ++ str " and " ++ (fun a -> prlist_with_sep spc (fun c -> pr_lconstr (mkConst c)) (Array.to_list a)) this_block_funs *) -(* ); *) - generate_functional_principle - false - scheme_type - (Some ([|sorts|])) - (Some princ_name) - this_block_funs - 0 - (prove_princ_for_struct false 0 [|destConst funs|]) - in - () diff --git a/contrib/funind/new_arg_principle.mli b/contrib/funind/new_arg_principle.mli deleted file mode 100644 index cad68da6..00000000 --- a/contrib/funind/new_arg_principle.mli +++ /dev/null @@ -1,34 +0,0 @@ - -val generate_functional_principle : - (* do we accept interactive proving *) - bool -> - (* induction principle on rel *) - Term.types -> - (* *) - Term.sorts array option -> - (* Name of the new principle *) - (Names.identifier) option -> - (* the compute functions to use *) - Names.constant array -> - (* We prove the nth- principle *) - int -> - (* The tactic to use to make the proof w.r - the number of params - *) - (Term.constr array -> int -> Tacmach.tactic) -> - unit - - - -(* val my_reflexivity : Tacmach.tactic *) - -val prove_princ_for_struct : - bool -> - int -> Names.constant array -> Term.constr array -> int -> Tacmach.tactic - - -val compute_new_princ_type_from_rel : Term.constr array -> Term.sorts array -> - Term.types -> Term.types - -val make_scheme : (Names.identifier*Names.identifier*Rawterm.rawsort) list -> unit -val make_case_scheme : (Names.identifier*Names.identifier*Rawterm.rawsort) -> unit diff --git a/contrib/funind/rawterm_to_relation.ml b/contrib/funind/rawterm_to_relation.ml index 327198b9..b6f26dfd 100644 --- a/contrib/funind/rawterm_to_relation.ml +++ b/contrib/funind/rawterm_to_relation.ml @@ -17,18 +17,11 @@ let observennl strm = then Pp.msg strm else () -(* type binder_type = *) -(* | Lambda *) -(* | Prod *) -(* | LetIn *) - -(* type raw_context = (binder_type*name*rawconstr) list *) type binder_type = | Lambda of name | Prod of name | LetIn of name -(* | LetTuple of name list * name *) type raw_context = (binder_type*rawconstr) list @@ -44,8 +37,6 @@ let compose_raw_context = | Lambda n -> mkRLambda(n,t,acc) | Prod n -> mkRProd(n,t,acc) | LetIn n -> mkRLetIn(n,t,acc) -(* | LetTuple (nal,na) -> *) -(* RLetTuple(dummy_loc,nal,(na,None),t,acc) *) in List.fold_right compose_binder @@ -145,37 +136,6 @@ let rec replace_var_by_term_in_binder x_id term = function let add_bt_names bt = List.append (ids_of_binder bt) -(* let rec replace_var_by_term_in_binder x_id term = function *) -(* | [] -> [] *) -(* | (bt,Name id,t)::l when id_ord id x_id = 0 -> *) -(* (bt,Name id,replace_var_by_term x_id term t)::l *) -(* | (bt,na,t)::l -> *) -(* (bt,na,replace_var_by_term x_id term t)::(replace_var_by_term_in_binder x_id term l) *) - -(* let rec change_vars_in_binder mapping = function *) -(* | [] -> [] *) -(* | (bt,(Name id as na),t)::l when Idmap.mem id mapping -> *) -(* (bt,na,change_vars mapping t):: l *) -(* | (bt,na,t)::l -> *) -(* (bt,na,change_vars mapping t):: *) -(* (change_vars_in_binder mapping l) *) - - -(* let alpha_ctxt avoid b = *) -(* let rec alpha_ctxt = function *) -(* | [] -> [],b *) -(* | (bt,n,t)::ctxt -> *) -(* let new_ctxt,new_b = alpha_ctxt ctxt in *) -(* match n with *) -(* | Name id when List.mem id avoid -> *) -(* let new_id = Nameops.next_ident_away id avoid in *) -(* let mapping = Idmap.add id new_id Idmap.empty in *) -(* (bt,Name new_id,t):: *) -(* (change_vars_in_binder mapping new_ctxt), *) -(* change_vars mapping new_b *) -(* | _ -> (bt,n,t)::new_ctxt,new_b *) -(* in *) -(* alpha_ctxt *) let apply_args ctxt body args = let need_convert_id avoid id = List.exists (is_free_in id) args || List.mem id avoid @@ -183,11 +143,6 @@ let apply_args ctxt body args = let need_convert avoid bt = List.exists (need_convert_id avoid) (ids_of_binder bt) in -(* let add_name na avoid = *) -(* match na with *) -(* | Anonymous -> avoid *) -(* | Name id -> id::avoid *) -(* in *) let next_name_away (na:name) (mapping: identifier Idmap.t) (avoid: identifier list) = match na with | Name id when List.mem id avoid -> @@ -206,17 +161,6 @@ let apply_args ctxt body args = | Lambda na -> let new_na,mapping,new_avoid = next_name_away na Idmap.empty avoid in Lambda new_na,mapping,new_avoid -(* | LetTuple (nal,na) -> *) -(* let rev_new_nal,mapping,new_avoid = *) -(* List.fold_left *) -(* (fun (nal,mapping,(avoid:identifier list)) na -> *) -(* let new_na,new_mapping,new_avoid = next_name_away na mapping avoid in *) -(* (new_na::nal,new_mapping,new_avoid) *) -(* ) *) -(* ([],Idmap.empty,avoid) *) -(* nal *) -(* in *) -(* (LetTuple(List.rev rev_new_nal,na),mapping,new_avoid) *) in let rec do_apply avoid ctxt body args = match ctxt,args with @@ -292,11 +236,6 @@ let combine_prod n t b = let combine_letin n t b = { context = t.context@((LetIn n,t.value)::b.context); value = b.value} -(* let combine_tuple nal na b in_e = *) -(* { *) -(* context = b.context@(LetTuple(nal,na),b.value)::in_e.context; *) -(* value = in_e.value *) -(* } *) let mk_result ctxt value avoid = { @@ -402,6 +341,77 @@ let make_pattern_eq_precond id e pat = res +let build_constructors_of_type msg ind' argl = + let (mib,ind) = Inductive.lookup_mind_specif (Global.env()) ind' in + let npar = mib.Declarations.mind_nparams in + Array.mapi (fun i _ -> + let construct = ind',i+1 in + let constructref = ConstructRef(construct) in + let _implicit_positions_of_cst = + Impargs.implicits_of_global constructref + in + let cst_narg = + Inductiveops.mis_constructor_nargs_env + (Global.env ()) + construct + in + let argl = + if argl = [] + then + Array.to_list + (Array.init (cst_narg - npar) (fun _ -> mkRHole ()) + ) + else argl + in + let pat_as_term = + mkRApp(mkRRef (ConstructRef(ind',i+1)),argl) + in +(* Pp.msgnl (str "new constructor := " ++ Printer.pr_rawconstr pat_as_term); *) + cases_pattern_of_rawconstr Anonymous pat_as_term + ) + ind.Declarations.mind_consnames + +let find_constructors_of_raw_type msg t argl : Rawterm.cases_pattern array = + let ind,args = raw_decompose_app t in + match ind with + | RRef(_,IndRef ind') -> +(* let _,ind = Global.lookup_inductive ind' in *) + build_constructors_of_type msg ind' argl + | _ -> error msg + + + +let rec find_type_of nb b = + let f,_ = raw_decompose_app b in + match f with + | RRef(_,ref) -> + begin + let ind_type = + match ref with + | VarRef _ | ConstRef _ -> + let constr_of_ref = constr_of_global ref in + let type_of_ref = Typing.type_of (Global.env ()) Evd.empty constr_of_ref in + let (_,ret_type) = Reduction.dest_prod (Global.env ()) type_of_ref in + let ret_type,_ = decompose_app ret_type in + if not (isInd ret_type) then + begin +(* Pp.msgnl (str "not an inductive" ++ pr_lconstr ret_type); *) + raise (Invalid_argument "not an inductive") + end; + destInd ret_type + | IndRef ind -> ind + | ConstructRef c -> fst c + in + let _,ind_type_info = Inductive.lookup_mind_specif (Global.env()) ind_type in + if not (Array.length ind_type_info.Declarations.mind_consnames = nb ) + then raise (Invalid_argument "find_type_of : not a valid inductive"); + ind_type + end + | RCast(_,b,_,_) -> find_type_of nb b + | RApp _ -> assert false (* we have decomposed any application via raw_decompose_app *) + | _ -> raise (Invalid_argument "not a ref") + + let rec build_entry_lc funnames avoid rt : rawconstr build_entry_return = (* Pp.msgnl (str " Entering : " ++ Printer.pr_rawconstr rt); *) match rt with @@ -466,14 +476,13 @@ let rec build_entry_lc funnames avoid rt : rawconstr build_entry_return = funnames avoid (mkRLetIn(new_n,t,mkRApp(new_b,args))) - | RCases _ | RLambda _ -> + | RCases _ | RLambda _ | RIf _ | RLetTuple _ -> let f_res = build_entry_lc funnames args_res.to_avoid f in combine_results combine_app f_res args_res | RDynamic _ ->error "Not handled RDynamic" - | RCast _ -> error "Not handled RCast" + | RCast(_,b,_,_) -> + build_entry_lc funnames avoid (mkRApp(b,args)) | RRec _ -> error "Not handled RRec" - | RIf _ -> error "Not handled RIf" - | RLetTuple _ -> error "Not handled RLetTuple" | RProd _ -> error "Cannot apply a type" end | RLambda(_,n,t,b) -> @@ -496,16 +505,88 @@ let rec build_entry_lc funnames avoid rt : rawconstr build_entry_return = | RCases(_,_,el,brl) -> let make_discr = make_discr_match brl in build_entry_lc_from_case funnames make_discr el brl avoid - | RIf _ -> error "Not handled RIf" - | RLetTuple _ -> error "Not handled RLetTuple" + | RIf(_,b,(na,e_option),lhs,rhs) -> + begin + match b with + | RCast(_,b,_,t) -> + let msg = "If construction must be used with cast" in + let case_pat = find_constructors_of_raw_type msg t [] in + assert (Array.length case_pat = 2); + let brl = + list_map_i + (fun i x -> (dummy_loc,[],[case_pat.(i)],x)) + 0 + [lhs;rhs] + in + let match_expr = + mkRCases(None,[(b,(Anonymous,None))],brl) + in +(* Pp.msgnl (str "new case := " ++ Printer.pr_rawconstr match_expr); *) + build_entry_lc funnames avoid match_expr + | _ -> + try + let ind = find_type_of 2 b in + let case_pat = build_constructors_of_type (str "") ind [] in + let brl = + list_map_i + (fun i x -> (dummy_loc,[],[case_pat.(i)],x)) + 0 + [lhs;rhs] + in + let match_expr = + mkRCases(None,[(b,(Anonymous,None))],brl) + in + (* Pp.msgnl (str "new case := " ++ Printer.pr_rawconstr match_expr); *) + build_entry_lc funnames avoid match_expr + with Invalid_argument s -> + let msg = "If construction must be used with cast : "^ s in + error msg + + end + | RLetTuple(_,nal,_,b,e) -> + begin + let nal_as_rawconstr = + List.map + (function + Name id -> mkRVar id + | Anonymous -> mkRHole () + ) + nal + in + match b with + | RCast(_,b,_,t) -> + let case_pat = + find_constructors_of_raw_type + "LetTuple construction must be used with cast" t nal_as_rawconstr in + assert (Array.length case_pat = 1); + let br = + (dummy_loc,[],[case_pat.(0)],e) + in + let match_expr = mkRCases(None,[b,(Anonymous,None)],[br]) in + build_entry_lc funnames avoid match_expr + | _ -> + try + let ind = find_type_of 1 b in + let case_pat = + build_constructors_of_type + (str "LetTuple construction must be used with cast") ind nal_as_rawconstr in + let br = + (dummy_loc,[],[case_pat.(0)],e) + in + let match_expr = mkRCases(None,[b,(Anonymous,None)],[br]) in + build_entry_lc funnames avoid match_expr + with Invalid_argument s -> + let msg = "LetTuple construction must be used with cast : "^ s in + error msg + + end | RRec _ -> error "Not handled RRec" - | RCast _ -> error "Not handled RCast" + | RCast(_,b,_,_) -> + build_entry_lc funnames avoid b | RDynamic _ -> error "Not handled RDynamic" and build_entry_lc_from_case funname make_discr - (el:(Rawterm.rawconstr * - (Names.name * (loc * Names.inductive * Names.name list) option) ) - list) - (brl:(loc * identifier list * cases_pattern list * rawconstr) list) avoid : + (el:tomatch_tuple) + (brl:Rawterm.cases_clauses) avoid : rawconstr build_entry_return = match el with | [] -> assert false (* matched on Nothing !*) @@ -521,7 +602,7 @@ and build_entry_lc_from_case funname make_discr in let results = List.map - (build_entry_lc_from_case_term funname make_discr [] brl case_resl.to_avoid) + (build_entry_lc_from_case_term funname (make_discr (List.map fst el)) [] brl case_resl.to_avoid) case_resl.result in { @@ -567,7 +648,6 @@ and build_entry_lc_from_case_term funname make_discr patterns_to_prevent brl avo avoid matched_expr in -(* let ids = List.map (fun id -> Prod (Name id),mkRHole ()) idl in *) let those_pattern_preconds = ( List.flatten ( @@ -597,7 +677,7 @@ and build_entry_lc_from_case_term funname make_discr patterns_to_prevent brl avo List.for_all (fun x -> x) unif) patterns_to_prevent then let i = List.length patterns_to_prevent in - [(Prod Anonymous,make_discr (List.map pattern_to_term patl) i )] + [(Prod Anonymous,make_discr i )] else [] ) @@ -839,6 +919,7 @@ let rec rebuild_return_type rt = let build_inductive parametrize funnames (funsargs: (Names.name * rawconstr * bool) list list) returned_types (rtl:rawconstr list) = + let _time1 = System.get_time () in (* Pp.msgnl (prlist_with_sep fnl Printer.pr_rawconstr rtl); *) let funnames_as_set = List.fold_right Idset.add funnames Idset.empty in let funnames = Array.of_list funnames in @@ -975,14 +1056,25 @@ let build_inductive parametrize funnames (funsargs: (Names.name * rawconstr * bo Impargs.make_implicit_args false; Impargs.make_strict_implicit_args false; Impargs.make_contextual_implicit_args false; + let _time2 = System.get_time () in +(* Pp.msgnl (str "Bulding Inductive : " ++ str (string_of_float (System.time_difference time1 time2))); *) try Options.silently (Command.build_mutual rel_inds) true; + let _time3 = System.get_time () in +(* Pp.msgnl (str "Bulding Done: "++ str (string_of_float (System.time_difference time2 time3))); *) +(* let msg = *) +(* str "while trying to define"++ spc () ++ *) +(* Ppvernac.pr_vernac (Vernacexpr.VernacInductive(true,rel_inds)) ++ fnl () *) +(* in *) +(* Pp.msgnl msg; *) Impargs.make_implicit_args old_implicit_args; Impargs.make_strict_implicit_args old_strict_implicit_args; Impargs.make_contextual_implicit_args old_contextual_implicit_args; Options.raw_print := old_rawprint; with - | UserError(s,msg) -> + | UserError(s,msg) -> + let _time3 = System.get_time () in +(* Pp.msgnl (str "error : "++ str (string_of_float (System.time_difference time2 time3))); *) Impargs.make_implicit_args old_implicit_args; Impargs.make_strict_implicit_args old_strict_implicit_args; Impargs.make_contextual_implicit_args old_contextual_implicit_args; @@ -996,6 +1088,8 @@ let build_inductive parametrize funnames (funsargs: (Names.name * rawconstr * bo raise (UserError(s, msg)) | e -> + let _time3 = System.get_time () in +(* Pp.msgnl (str "error : "++ str (string_of_float (System.time_difference time2 time3))); *) Impargs.make_implicit_args old_implicit_args; Impargs.make_strict_implicit_args old_strict_implicit_args; Impargs.make_contextual_implicit_args old_contextual_implicit_args; @@ -1010,3 +1104,4 @@ let build_inductive parametrize funnames (funsargs: (Names.name * rawconstr * bo (UserError("",msg)) + diff --git a/contrib/funind/rawtermops.ml b/contrib/funind/rawtermops.ml index 99bf2bf1..c6406468 100644 --- a/contrib/funind/rawtermops.ml +++ b/contrib/funind/rawtermops.ml @@ -68,7 +68,10 @@ let rec raw_make_or_list = function | e::l -> raw_make_or e (raw_make_or_list l) - +let remove_name_from_mapping mapping na = + match na with + | Anonymous -> mapping + | Name id -> Idmap.remove id mapping let change_vars = let rec change_vars mapping rt = @@ -88,34 +91,31 @@ let change_vars = change_vars mapping rt', List.map (change_vars mapping) rtl ) - | RLambda(_,Name id,_,_) when Idmap.mem id mapping -> rt | RLambda(loc,name,t,b) -> RLambda(loc, name, change_vars mapping t, - change_vars mapping b + change_vars (remove_name_from_mapping mapping name) b ) - | RProd(_,Name id,_,_) when Idmap.mem id mapping -> rt | RProd(loc,name,t,b) -> RProd(loc, name, change_vars mapping t, - change_vars mapping b + change_vars (remove_name_from_mapping mapping name) b ) - | RLetIn(_,Name id,_,_) when Idmap.mem id mapping -> rt | RLetIn(loc,name,def,b) -> RLetIn(loc, name, change_vars mapping def, - change_vars mapping b + change_vars (remove_name_from_mapping mapping name) b ) - | RLetTuple(_,nal,(na,_),_,_) when List.exists (function Name id -> Idmap.mem id mapping | _ -> false) (na::nal) -> rt | RLetTuple(loc,nal,(na,rto),b,e) -> + let new_mapping = List.fold_left remove_name_from_mapping mapping nal in RLetTuple(loc, - nal, - (na, option_app (change_vars mapping) rto), - change_vars mapping b, - change_vars mapping e + nal, + (na, option_map (change_vars mapping) rto), + change_vars mapping b, + change_vars new_mapping e ) | RCases(loc,infos,el,brl) -> RCases(loc, @@ -123,8 +123,14 @@ let change_vars = List.map (fun (e,x) -> (change_vars mapping e,x)) el, List.map (change_vars_br mapping) brl ) - | RIf _ -> error "Not handled RIf" - | RRec _ -> error "Not handled RRec" + | RIf(loc,b,(na,e_option),lhs,rhs) -> + RIf(loc, + change_vars mapping b, + (na,option_map (change_vars mapping) e_option), + change_vars mapping lhs, + change_vars mapping rhs + ) + | RRec _ -> error "Local (co)fixes are not supported" | RSort _ -> rt | RHole _ -> rt | RCast(loc,b,k,t) -> @@ -230,7 +236,7 @@ let rec alpha_rt excluded rt = then t,b else let replace = change_vars (Idmap.add id new_id Idmap.empty) in - (replace t,replace b) + (t,replace b) in let new_excluded = new_id::excluded in let new_t = alpha_rt new_excluded t in @@ -244,7 +250,7 @@ let rec alpha_rt excluded rt = then t,b else let replace = change_vars (Idmap.add id new_id Idmap.empty) in - (replace t,replace b) + (t,replace b) in let new_t = alpha_rt new_excluded t in let new_b = alpha_rt new_excluded b in @@ -256,7 +262,7 @@ let rec alpha_rt excluded rt = then t,b else let replace = change_vars (Idmap.add id new_id Idmap.empty) in - (replace t,replace b) + (t,replace b) in let new_excluded = new_id::excluded in let new_t = alpha_rt new_excluded t in @@ -286,18 +292,23 @@ let rec alpha_rt excluded rt = if idmap_is_empty mapping then rto,t,b else let replace = change_vars mapping in - (option_app replace rto,replace t,replace b) + (option_map replace rto, t,replace b) in let new_t = alpha_rt new_excluded new_t in let new_b = alpha_rt new_excluded new_b in - let new_rto = option_app (alpha_rt new_excluded) new_rto in + let new_rto = option_map (alpha_rt new_excluded) new_rto in RLetTuple(loc,new_nal,(na,new_rto),new_t,new_b) | RCases(loc,infos,el,brl) -> let new_el = List.map (function (rt,i) -> alpha_rt excluded rt, i) el in RCases(loc,infos,new_el,List.map (alpha_br excluded) brl) - | RIf _ -> error "Not handled RIf" + | RIf(loc,b,(na,e_o),lhs,rhs) -> + RIf(loc,alpha_rt excluded b, + (na,option_map (alpha_rt excluded) e_o), + alpha_rt excluded lhs, + alpha_rt excluded rhs + ) | RRec _ -> error "Not handled RRec" | RSort _ -> rt | RHole _ -> rt @@ -439,7 +450,7 @@ let replace_var_by_term x_id term = | RLetTuple(loc,nal,(na,rto),def,b) -> RLetTuple(loc, nal, - (na,option_app replace_var_by_pattern rto), + (na,option_map replace_var_by_pattern rto), replace_var_by_pattern def, replace_var_by_pattern b ) @@ -449,7 +460,12 @@ let replace_var_by_term x_id term = List.map (fun (e,x) -> (replace_var_by_pattern e,x)) el, List.map replace_var_by_pattern_br brl ) - | RIf _ -> raise (UserError("",str "Not handled RIf")) + | RIf(loc,b,(na,e_option),lhs,rhs) -> + RIf(loc, replace_var_by_pattern b, + (na,option_map replace_var_by_pattern e_option), + replace_var_by_pattern lhs, + replace_var_by_pattern rhs + ) | RRec _ -> raise (UserError("",str "Not handled RRec")) | RSort _ -> rt | RHole _ -> rt diff --git a/contrib/funind/rawtermops.mli b/contrib/funind/rawtermops.mli index 92df0ec6..5dcdb15c 100644 --- a/contrib/funind/rawtermops.mli +++ b/contrib/funind/rawtermops.mli @@ -22,10 +22,7 @@ val mkRApp : rawconstr*(rawconstr list) -> rawconstr val mkRLambda : Names.name*rawconstr*rawconstr -> rawconstr val mkRProd : Names.name*rawconstr*rawconstr -> rawconstr val mkRLetIn : Names.name*rawconstr*rawconstr -> rawconstr -val mkRCases : rawconstr option * - (rawconstr * (Names.name * (Util.loc * Names.inductive * Names.name list) option)) list * - (Util.loc * Names.identifier list * cases_pattern list * rawconstr) list -> - rawconstr +val mkRCases : rawconstr option * tomatch_tuple * cases_clauses -> rawconstr val mkRSort : rawsort -> rawconstr val mkRHole : unit -> rawconstr (* we only build Evd.BinderType Anonymous holes *) diff --git a/contrib/funind/tacinv.ml4 b/contrib/funind/tacinv.ml4 index c2410d55..2c7e4d33 100644 --- a/contrib/funind/tacinv.ml4 +++ b/contrib/funind/tacinv.ml4 @@ -378,7 +378,7 @@ let rec proofPrinc mi: constr funind = (* <pcase> Cases b of arrPt end.*) | Case (cinfo, pcase, b, arrPt) -> let prod_pcase,_ = decompose_lam pcase in - let nmeb,_ = List.hd prod_pcase in + let _nmeb,_ = List.hd prod_pcase in let newb'= apply_leqtrpl_t b mi.lst_eqs in let type_of_b = Typing.type_of mi.env mi.sigma b in (* Replace the recursive calls to the function by calls to the constant *) @@ -428,7 +428,7 @@ let rec proofPrinc mi: constr funind = let varnames = List.map snd mi.lst_vars in let nb_vars = List.length varnames in let nb_eqs = List.length mi.lst_eqs in - let eqrels = List.map fst mi.lst_eqs in + let _eqrels = List.map fst mi.lst_eqs in (* [terms_recs]: appel rec du fixpoint, On concatène les appels recs trouvés dans les let in et les Cases avec ceux trouves dans u (ie mi.mimick). *) @@ -772,11 +772,6 @@ let invfun_verif c l dorew gl = else error "wrong number of arguments for the function" -TACTIC EXTEND functional_induction - [ "functional" "induction" constr(c) ne_constr_list(l) ] - -> [ invfun_verif c l true ] -END - (* Construction of the functional scheme. *) @@ -847,15 +842,20 @@ let declareFunScheme f fname mutflist = +TACTIC EXTEND functional_induction + [ "old" "functional" "induction" constr(c) ne_constr_list(l) ] + -> [ invfun_verif c l true ] +END + VERNAC COMMAND EXTEND FunctionalScheme - [ "Functional" "Scheme" ident(na) ":=" "Induction" "for" + [ "Old" "Functional" "Scheme" ident(na) ":=" "Induction" "for" ident(c) "with" ne_ident_list(l) ] -> [ declareFunScheme c na l ] -| [ "Functional" "Scheme" ident(na) ":=" "Induction" "for" ident (c) ] +| [ "Old" "Functional" "Scheme" ident(na) ":=" "Induction" "for" ident (c) ] -> [ declareFunScheme c na [] ] END - + diff --git a/contrib/interface/ascent.mli b/contrib/interface/ascent.mli index fb71288a..8f880a76 100644 --- a/contrib/interface/ascent.mli +++ b/contrib/interface/ascent.mli @@ -685,8 +685,8 @@ and ct_TACTIC_COM = | CT_rename of ct_ID * ct_ID | CT_repeat of ct_TACTIC_COM | CT_replace_with of ct_FORMULA * ct_FORMULA * ct_ID_OPT * ct_TACTIC_OPT - | CT_rewrite_lr of ct_FORMULA * ct_SPEC_LIST * ct_ID_OPT - | CT_rewrite_rl of ct_FORMULA * ct_SPEC_LIST * ct_ID_OPT + | CT_rewrite_lr of ct_FORMULA * ct_SPEC_LIST * ct_CLAUSE + | CT_rewrite_rl of ct_FORMULA * ct_SPEC_LIST * ct_CLAUSE | CT_right of ct_SPEC_LIST | CT_ring of ct_FORMULA_LIST | CT_simple_user_tac of ct_ID * ct_TACTIC_ARG_LIST diff --git a/contrib/interface/blast.ml b/contrib/interface/blast.ml index 21f977f1..9e450068 100644 --- a/contrib/interface/blast.ml +++ b/contrib/interface/blast.ml @@ -86,7 +86,7 @@ let rec def_const_in_term_rec vl x = | Sort(c) -> c | Ind(ind) -> let (mib, mip) = Global.lookup_inductive ind in - mip.mind_sort + new_sort_in_family (inductive_sort_family mip) | Construct(c) -> def_const_in_term_rec vl (mkInd (inductive_of_constructor c)) | Case(_,x,t,a) diff --git a/contrib/interface/debug_tac.ml4 b/contrib/interface/debug_tac.ml4 index 56abfb82..e1b8e712 100644 --- a/contrib/interface/debug_tac.ml4 +++ b/contrib/interface/debug_tac.ml4 @@ -239,9 +239,9 @@ and checked_then: report_holder -> glob_tactic_expr -> glob_tactic_expr -> tacti by the list of integers given as extra arguments. *) -let rawwit_main_tactic = rawwit_tactic Pcoq.Tactic.tactic_main_level -let globwit_main_tactic = globwit_tactic Pcoq.Tactic.tactic_main_level -let wit_main_tactic = wit_tactic Pcoq.Tactic.tactic_main_level +let rawwit_main_tactic = Pcoq.rawwit_tactic Pcoq.tactic_main_level +let globwit_main_tactic = Pcoq.globwit_tactic Pcoq.tactic_main_level +let wit_main_tactic = Pcoq.wit_tactic Pcoq.tactic_main_level let on_then = function [t1;t2;l] -> diff --git a/contrib/interface/showproof.ml b/contrib/interface/showproof.ml index b7da5c1b..ce2ee1e7 100644 --- a/contrib/interface/showproof.ml +++ b/contrib/interface/showproof.ml @@ -719,7 +719,7 @@ let rec nsortrec vl x = | Sort(c) -> c | Ind(ind) -> let (mib,mip) = lookup_mind_specif vl ind in - mip.mind_sort + new_sort_in_family (inductive_sort_family mip) | Construct(c) -> nsortrec vl (mkInd (inductive_of_constructor c)) | Case(_,x,t,a) diff --git a/contrib/interface/vtp.ml b/contrib/interface/vtp.ml index 5a7ccc26..064d20ab 100644 --- a/contrib/interface/vtp.ml +++ b/contrib/interface/vtp.ml @@ -1717,12 +1717,12 @@ and fTACTIC_COM = function | CT_rewrite_lr(x1, x2, x3) -> fFORMULA x1; fSPEC_LIST x2; - fID_OPT x3; + fCLAUSE x3; fNODE "rewrite_lr" 3 | CT_rewrite_rl(x1, x2, x3) -> fFORMULA x1; fSPEC_LIST x2; - fID_OPT x3; + fCLAUSE x3; fNODE "rewrite_rl" 3 | CT_right(x1) -> fSPEC_LIST x1; diff --git a/contrib/interface/xlate.ml b/contrib/interface/xlate.ml index da87086e..ecb04e07 100644 --- a/contrib/interface/xlate.ml +++ b/contrib/interface/xlate.ml @@ -113,8 +113,16 @@ let nums_to_int_list_aux l = List.map (fun x -> CT_int x) l;; let nums_to_int_list l = CT_int_list(nums_to_int_list_aux l);; -let nums_to_int_ne_list n l = - CT_int_ne_list(CT_int n, nums_to_int_list_aux l);; +let num_or_var_to_int = function + | ArgArg x -> CT_int x + | _ -> xlate_error "TODO: nums_to_int_list_aux ArgVar";; + +let nums_or_var_to_int_list_aux l = List.map num_or_var_to_int l;; + +let nums_or_var_to_int_list l = CT_int_list(nums_or_var_to_int_list_aux l);; + +let nums_or_var_to_int_ne_list n l = + CT_int_ne_list(num_or_var_to_int n, nums_or_var_to_int_list_aux l);; type iTARG = Targ_command of ct_FORMULA | Targ_intropatt of ct_INTRO_PATT_LIST @@ -298,9 +306,11 @@ let rec decompose_last = function let make_fix_struct (n,bl) = let names = names_of_local_assums bl in let nn = List.length names in - if nn = 1 then ctv_ID_OPT_NONE - else if n < nn then xlate_id_opt(List.nth names n) - else xlate_error "unexpected result of parsing for Fixpoint";; + if nn = 1 || n = None then ctv_ID_OPT_NONE + else + let n = out_some n in + if n < nn then xlate_id_opt(List.nth names n) + else xlate_error "unexpected result of parsing for Fixpoint";; let rec xlate_binder = function @@ -417,7 +427,10 @@ and (xlate_formula:Topconstr.constr_expr -> Ascent.ct_FORMULA) = function | CFix (_, (_, id), lm::lmi) -> let strip_mutrec (fid, (n, ro), bl, arf, ardef) = let (struct_arg,bl,arf,ardef) = + (* Pierre L: could the case [n=None && bl=[]] happen ? Normally not *) + (* By the way, how could [bl = []] happen in V8 syntax ? *) if bl = [] then + let n = out_some n in let (bl,arf,ardef) = Ppconstr.split_fix (n+1) arf ardef in (xlate_id_opt(List.nth (names_of_local_assums bl) n),bl,arf,ardef) else (make_fix_struct (n, bl),bl,arf,ardef) in @@ -469,18 +482,19 @@ let xlate_hyp = function let xlate_hyp_location = function - | AI (_,id), nums, InHypTypeOnly -> - CT_intype(xlate_ident id, nums_to_int_list nums) - | AI (_,id), nums, InHypValueOnly -> - CT_invalue(xlate_ident id, nums_to_int_list nums) - | AI (_,id), [], InHyp -> + | (nums, AI (_,id)), InHypTypeOnly -> + CT_intype(xlate_ident id, nums_or_var_to_int_list nums) + | (nums, AI (_,id)), InHypValueOnly -> + CT_invalue(xlate_ident id, nums_or_var_to_int_list nums) + | ([], AI (_,id)), InHyp -> CT_coerce_UNFOLD_to_HYP_LOCATION (CT_coerce_ID_to_UNFOLD (xlate_ident id)) - | AI (_,id), a::l, InHyp -> + | (a::l, AI (_,id)), InHyp -> CT_coerce_UNFOLD_to_HYP_LOCATION (CT_unfold_occ (xlate_ident id, - CT_int_ne_list(CT_int a, nums_to_int_list_aux l))) - | MetaId _, _,_ -> + CT_int_ne_list(num_or_var_to_int a, + nums_or_var_to_int_list_aux l))) + | (_, MetaId _),_ -> xlate_error "MetaId not supported in xlate_hyp_location (should occur only in quotations)" let xlate_clause cls = @@ -661,13 +675,14 @@ let xlate_using = function let xlate_one_unfold_block = function ([],qid) -> CT_coerce_ID_to_UNFOLD(tac_qualid_to_ct_ID qid) | (n::nums, qid) -> - CT_unfold_occ(tac_qualid_to_ct_ID qid, nums_to_int_ne_list n nums);; + CT_unfold_occ(tac_qualid_to_ct_ID qid, nums_or_var_to_int_ne_list n nums) +;; let xlate_with_names = function IntroAnonymous -> CT_coerce_ID_OPT_to_INTRO_PATT_OPT ctv_ID_OPT_NONE | fp -> CT_coerce_INTRO_PATT_to_INTRO_PATT_OPT (xlate_intro_pattern fp) -let rawwit_main_tactic = rawwit_tactic Pcoq.Tactic.tactic_main_level +let rawwit_main_tactic = Pcoq.rawwit_tactic Pcoq.tactic_main_level let rec (xlate_tacarg:raw_tactic_arg -> ct_TACTIC_ARG) = function @@ -723,7 +738,7 @@ and xlate_red_tactic = CT_simpl (CT_coerce_PATTERN_to_PATTERN_OPT (CT_pattern_occ - (CT_int_list(List.map (fun n -> CT_int n) l), xlate_formula c))) + (CT_int_list(nums_or_var_to_int_list_aux l), xlate_formula c))) | Cbv flag_list -> let conv_flags, red_ids = get_flag flag_list in CT_cbv (CT_conversion_flag_list conv_flags, red_ids) @@ -740,7 +755,7 @@ and xlate_red_tactic = | Pattern l -> let pat_list = List.map (fun (nums,c) -> CT_pattern_occ - (CT_int_list (List.map (fun x -> CT_int x) nums), + (CT_int_list (nums_or_var_to_int_list_aux nums), xlate_formula c)) l in (match pat_list with | first :: others -> CT_pattern (CT_pattern_ne_list (first, others)) @@ -898,7 +913,7 @@ and xlate_tac = | TacChange (Some(l,c), f, b) -> (* TODO LATER: combine with other constructions of pattern_occ *) CT_change_local( - CT_pattern_occ(CT_int_list(List.map (fun n -> CT_int n) l), + CT_pattern_occ(CT_int_list(nums_or_var_to_int_list_aux l), xlate_formula c), xlate_formula f, xlate_clause b) @@ -973,19 +988,12 @@ and xlate_tac = CT_coerce_TACTIC_COM_to_TACTIC_OPT tac in CT_replace_with (c1, c2,id_opt,tac_opt) - | TacExtend (_,"rewrite", [b; cbindl]) -> - let b = out_gen Extraargs.rawwit_orient b in - let (c,bindl) = out_gen rawwit_constr_with_bindings cbindl in - let c = xlate_formula c and bindl = xlate_bindings bindl in - if b then CT_rewrite_lr (c, bindl, ctv_ID_OPT_NONE) - else CT_rewrite_rl (c, bindl, ctv_ID_OPT_NONE) - | TacExtend (_,"rewrite_in", [b; cbindl; id]) -> - let b = out_gen Extraargs.rawwit_orient b in - let (c,bindl) = out_gen rawwit_constr_with_bindings cbindl in - let c = xlate_formula c and bindl = xlate_bindings bindl in - let id = ctf_ID_OPT_SOME (xlate_ident (snd (out_gen rawwit_var id))) in - if b then CT_rewrite_lr (c, bindl, id) - else CT_rewrite_rl (c, bindl, id) + | TacRewrite(b,cbindl,cl) -> + let cl = xlate_clause cl + and c = xlate_formula (fst cbindl) + and bindl = xlate_bindings (snd cbindl) in + if b then CT_rewrite_lr (c, bindl, cl) + else CT_rewrite_rl (c, bindl, cl) | TacExtend (_,"conditional_rewrite", [t; b; cbindl]) -> let t = out_gen rawwit_main_tactic t in let b = out_gen Extraargs.rawwit_orient b in @@ -1094,7 +1102,7 @@ and xlate_tac = List.map (fun x -> CT_ident x) l)))) | TacExtend (_,"prolog", [cl; n]) -> let cl = List.map xlate_formula (out_gen (wit_list0 rawwit_constr) cl) in - (match out_gen wit_int_or_var n with + (match out_gen rawwit_int_or_var n with | ArgVar _ -> xlate_error "" | ArgArg n -> CT_prolog (CT_formula_list cl, CT_int n)) | TacExtend (_,"eapply", [cbindl]) -> @@ -1263,14 +1271,15 @@ and coerce_genarg_to_TARG x = (CT_coerce_FORMULA_to_SCOMMENT_CONTENT (xlate_formula (out_gen rawwit_constr x))) | ConstrMayEvalArgType -> xlate_error"TODO: generic constr-may-eval argument" | QuantHypArgType ->xlate_error"TODO: generic quantified hypothesis argument" - | TacticArgType n -> - let t = xlate_tactic (out_gen (rawwit_tactic n) x) in - CT_coerce_TACTIC_COM_to_TARG t | OpenConstrArgType b -> CT_coerce_SCOMMENT_CONTENT_to_TARG (CT_coerce_FORMULA_to_SCOMMENT_CONTENT(xlate_formula (snd (out_gen (rawwit_open_constr_gen b) x)))) + | ExtraArgType s as y when Pcoq.is_tactic_genarg y -> + let n = out_some (Pcoq.tactic_genarg_level s) in + let t = xlate_tactic (out_gen (Pcoq.rawwit_tactic n) x) in + CT_coerce_TACTIC_COM_to_TARG t | ConstrWithBindingsArgType -> xlate_error "TODO: generic constr with bindings" | BindingsArgType -> xlate_error "TODO: generic with bindings" | RedExprArgType -> xlate_error "TODO: generic red expr" @@ -1360,8 +1369,9 @@ let coerce_genarg_to_VARG x = (CT_coerce_FORMULA_to_FORMULA_OPT (xlate_formula (out_gen rawwit_constr x))) | ConstrMayEvalArgType -> xlate_error"TODO: generic constr-may-eval argument" | QuantHypArgType ->xlate_error"TODO: generic quantified hypothesis argument" - | TacticArgType n -> - let t = xlate_tactic (out_gen (rawwit_tactic n) x) in + | ExtraArgType s as y when Pcoq.is_tactic_genarg y -> + let n = out_some (Pcoq.tactic_genarg_level s) in + let t = xlate_tactic (out_gen (Pcoq.rawwit_tactic n) x) in CT_coerce_TACTIC_OPT_to_VARG (CT_coerce_TACTIC_COM_to_TACTIC_OPT t) | OpenConstrArgType _ -> xlate_error "TODO: generic open constr" | ConstrWithBindingsArgType -> xlate_error "TODO: generic constr with bindings" @@ -1813,7 +1823,7 @@ let rec xlate_vernac = CT_theorem_goal (CT_coerce_THM_to_DEFN_OR_THM (xlate_thm k), xlate_ident s, xlate_binder_list bl, xlate_formula c)) | VernacSuspend -> CT_suspend - | VernacResume idopt -> CT_resume (xlate_ident_opt (option_app snd idopt)) + | VernacResume idopt -> CT_resume (xlate_ident_opt (option_map snd idopt)) | VernacDefinition (k,(_,s),ProveBody (bl,typ),_) -> CT_coerce_THEOREM_GOAL_to_COMMAND (CT_theorem_goal @@ -1855,7 +1865,7 @@ let rec xlate_vernac = (_, (add_coercion, (_,s)), binders, c1, rec_constructor_or_none, field_list) -> let record_constructor = - xlate_ident_opt (option_app snd rec_constructor_or_none) in + xlate_ident_opt (option_map snd rec_constructor_or_none) in CT_record ((if add_coercion then CT_coercion_atm else CT_coerce_NONE_to_COERCION_OPT(CT_none)), @@ -1875,7 +1885,10 @@ let rec xlate_vernac = | VernacFixpoint ((lm :: lmi),boxed) -> let strip_mutrec ((fid, (n, ro), bl, arf, ardef), ntn) = let (struct_arg,bl,arf,ardef) = + (* Pierre L: could the case [n=None && bl=[]] happen ? Normally not *) + (* By the way, how could [bl = []] happen in V8 syntax ? *) if bl = [] then + let n = out_some n in let (bl,arf,ardef) = Ppconstr.split_fix (n+1) arf ardef in (xlate_id_opt(List.nth (names_of_local_assums bl) n),bl,arf,ardef) else (make_fix_struct (n, bl),bl,arf,ardef) in diff --git a/contrib/omega/coq_omega.ml b/contrib/omega/coq_omega.ml index ee3301d7..da0817d1 100644 --- a/contrib/omega/coq_omega.ml +++ b/contrib/omega/coq_omega.ml @@ -13,7 +13,7 @@ (* *) (**************************************************************************) -(* $Id: coq_omega.ml 7837 2006-01-11 09:47:32Z herbelin $ *) +(* $Id: coq_omega.ml 8934 2006-06-09 14:30:12Z herbelin $ *) open Util open Pp @@ -162,10 +162,12 @@ let hide_constr,find_constr,clear_tables,dump_tables = open Coqlib let logic_dir = ["Coq";"Logic";"Decidable"] +let init_arith_modules = init_modules @ arith_modules let coq_modules = - init_modules @ [logic_dir] @ arith_modules @ zarith_base_modules + init_arith_modules @ [logic_dir] @ zarith_base_modules @ [["Coq"; "omega"; "OmegaLemmas"]] +let init_arith_constant = gen_constant_in_modules "Omega" init_arith_modules let constant = gen_constant_in_modules "Omega" coq_modules (* Zarith *) @@ -268,17 +270,17 @@ let coq_Zge = lazy (constant "Zge") let coq_Zlt = lazy (constant "Zlt") (* Peano/Datatypes *) -let coq_le = lazy (constant "le") -let coq_lt = lazy (constant "lt") -let coq_ge = lazy (constant "ge") -let coq_gt = lazy (constant "gt") -let coq_minus = lazy (constant "minus") -let coq_plus = lazy (constant "plus") -let coq_mult = lazy (constant "mult") -let coq_pred = lazy (constant "pred") -let coq_nat = lazy (constant "nat") -let coq_S = lazy (constant "S") -let coq_O = lazy (constant "O") +let coq_le = lazy (init_arith_constant "le") +let coq_lt = lazy (init_arith_constant "lt") +let coq_ge = lazy (init_arith_constant "ge") +let coq_gt = lazy (init_arith_constant "gt") +let coq_minus = lazy (init_arith_constant "minus") +let coq_plus = lazy (init_arith_constant "plus") +let coq_mult = lazy (init_arith_constant "mult") +let coq_pred = lazy (init_arith_constant "pred") +let coq_nat = lazy (init_arith_constant "nat") +let coq_S = lazy (init_arith_constant "S") +let coq_O = lazy (init_arith_constant "O") (* Compare_dec/Peano_dec/Minus *) let coq_pred_of_minus = lazy (constant "pred_of_minus") diff --git a/contrib/recdef/recdef.ml4 b/contrib/recdef/recdef.ml4 index cf09e63a..ed2e5b5f 100644 --- a/contrib/recdef/recdef.ml4 +++ b/contrib/recdef/recdef.ml4 @@ -46,20 +46,35 @@ open Eauto open Genarg +let qed () = Command.save_named true +let defined () = Command.save_named false + +let pf_get_new_ids idl g = + let ids = pf_ids_of_hyps g in + List.fold_right + (fun id acc -> next_global_ident_away false id (acc@ids)::acc) + idl + [] + +let pf_get_new_id id g = + List.hd (pf_get_new_ids [id] g) + let h_intros l = tclMAP h_intro l let do_observe_tac s tac g = - let goal = begin try (Printer.pr_goal (sig_it g)) with _ -> assert false end in + let goal = begin (Printer.pr_goal (sig_it g)) end in try let v = tac g in msgnl (goal ++ fnl () ++ (str s)++(str " ")++(str "finished")); v with e -> msgnl (str "observation "++str s++str " raised exception " ++ - Cerrors.explain_exn e ++ str "on goal " ++ goal ); + Cerrors.explain_exn e ++ str " on goal " ++ goal ); raise e;; -let observe_tac s tac g = tac g - +let observe_tac s tac g = + if Tacinterp.get_debug () <> Tactic_debug.DebugOff + then do_observe_tac s tac g + else tac g let hyp_ids = List.map id_of_string ["x";"v";"k";"def";"p";"h";"n";"h'"; "anonymous"; "teq"; "rec_res"; @@ -96,8 +111,11 @@ let def_of_const t = (try (match (Global.lookup_constant sp) with {const_body=Some c} -> Declarations.force c |_ -> assert false) - with _ -> anomaly ("Cannot find definition of constant "^(string_of_id (id_of_label (con_label sp))))) - |_ -> assert false + with _ -> + anomaly ("Cannot find definition of constant "^ + (string_of_id (id_of_label (con_label sp)))) + ) + |_ -> assert false let type_of_const t = match (kind_of_term t) with @@ -121,7 +139,6 @@ let rec (find_call_occs: fun f expr -> match (kind_of_term expr) with App (g, args) when g = f -> - (* For now we suppose that the function takes only one argument. *) (fun l -> List.hd l), [Array.to_list args] | App (g, args) -> let (largs: constr list) = Array.to_list args in @@ -222,8 +239,8 @@ let lt = function () -> (coq_constant "lt") let mkCaseEq a : tactic = (fun g -> -(* commentaire de Yves: on pourra avoir des problemes si - a n'est pas bien type dans l'environnement du but *) + (* commentaire de Yves: on pourra avoir des problemes si + a n'est pas bien type dans l'environnement du but *) let type_of_a = pf_type_of g a in (tclTHEN (generalize [mkApp(delayed_force refl_equal, [| type_of_a; a|])]) (tclTHEN @@ -235,7 +252,6 @@ let mkCaseEq a : tactic = let rec mk_intros_and_continue (extra_eqn:bool) cont_function (eqs:constr list) (expr:constr) g = - let ids = pf_ids_of_hyps g in match kind_of_term expr with | Lambda (n, _, b) -> let n1 = @@ -243,15 +259,19 @@ let rec mk_intros_and_continue (extra_eqn:bool) Name x -> x | Anonymous -> ano_id in - let new_n = next_global_ident_away true n1 ids in + let new_n = pf_get_new_id n1 g in tclTHEN (h_intro new_n) (mk_intros_and_continue extra_eqn cont_function eqs (subst1 (mkVar new_n) b)) g | _ -> if extra_eqn then - let teq = next_global_ident_away true teq_id ids in - tclTHEN (h_intro teq) - (cont_function (mkVar teq::eqs) expr) g + let teq = pf_get_new_id teq_id g in + tclTHENLIST + [ h_intro teq; + tclMAP (fun eq -> tclTRY (Equality.general_rewrite_in true teq eq)) (List.rev eqs); + cont_function (mkVar teq::eqs) expr + ] + g else cont_function eqs expr g @@ -291,13 +311,15 @@ let list_rewrite (rev:bool) (eqs: constr list) = let base_leaf_terminate (func:global_reference) eqs expr = (* let _ = msgnl (str "entering base_leaf") in *) (fun g -> - let ids = pf_ids_of_hyps g in - let k' = next_global_ident_away true k_id ids in - let h = next_global_ident_away true h_id (k'::ids) in - tclTHENLIST [observe_tac "first split" (split (ImplicitBindings [expr])); - observe_tac "second split" (split (ImplicitBindings [delayed_force coq_O])); - observe_tac "intro k" (h_intro k'); - observe_tac "case on k" + let k',h = + match pf_get_new_ids [k_id;h_id] g with + [k';h] -> k',h + | _ -> assert false + in + tclTHENLIST [observe_tac "first split" (split (ImplicitBindings [expr])); + observe_tac "second split" (split (ImplicitBindings [delayed_force coq_O])); + observe_tac "intro k" (h_intro k'); + observe_tac "case on k" (tclTHENS (simplest_case (mkVar k')) [(tclTHEN (h_intro h) @@ -305,17 +327,17 @@ let base_leaf_terminate (func:global_reference) eqs expr = (mkApp (delayed_force gt_antirefl, [| delayed_force coq_O |]))) default_auto)); tclIDTAC ]); - intros; - - simpl_iter(); - unfold_constr func; - list_rewrite true eqs; - default_auto ] g);; + intros; + simpl_iter(); + unfold_constr func; + list_rewrite true eqs; + default_auto ] g);; (* La fonction est donnee en premier argument a la fonctionnelle suivie d'autres Lambdas et de Case ... Pour recuperer la fonction f a partir de la fonctionnelle *) + let get_f foncl = match (kind_of_term (def_of_const foncl)) with Lambda (Name f, _, _) -> f @@ -345,14 +367,15 @@ let rec list_cond_rewrite k def pmax cond_eqs le_proofs = match cond_eqs with [] -> tclIDTAC | eq::eqs -> - tclTHENS - (general_rewrite_bindings false - (mkVar eq, - ExplicitBindings[dummy_loc, NamedHyp k_id, mkVar k; - dummy_loc, NamedHyp def_id, mkVar def])) - [list_cond_rewrite k def pmax eqs le_proofs; - make_lt_proof pmax le_proofs];; - + (fun g -> + tclTHENS + (general_rewrite_bindings false + (mkVar eq, + ExplicitBindings[dummy_loc, NamedHyp k_id, mkVar k; + dummy_loc, NamedHyp def_id, mkVar def])) + [list_cond_rewrite k def pmax eqs le_proofs; + make_lt_proof pmax le_proofs] g + ) let rec introduce_all_equalities func eqs values specs bound le_proofs cond_eqs = @@ -371,16 +394,21 @@ let rec introduce_all_equalities func eqs values specs bound le_proofs observe_tac "introduce_all_equalities_final intro k" (h_intro k); tclTHENS (observe_tac "introduce_all_equalities_final case k" (simplest_case (mkVar k))) - [tclTHENLIST[h_intro h'; - simplest_elim(mkApp(delayed_force lt_n_O,[|s_max|])); - default_full_auto]; tclIDTAC]; + [ + tclTHENLIST[h_intro h'; + simplest_elim(mkApp(delayed_force lt_n_O,[|s_max|])); + default_full_auto]; + tclIDTAC + ]; observe_tac "clearing k " (clear [k]); - h_intros [k;h';def]; - simpl_iter(); - unfold_in_concl[([1],evaluable_of_global_reference func)]; - list_rewrite true eqs; - list_cond_rewrite k def bound cond_eqs le_proofs; - apply (delayed_force refl_equal)] g + observe_tac "intros k h' def" (h_intros [k;h';def]); + observe_tac "simple_iter" (simpl_iter()); + observe_tac "unfold functional" + (unfold_in_concl[([1],evaluable_of_global_reference func)]); + observe_tac "rewriting equations" + (list_rewrite true eqs); + observe_tac "cond rewrite" (list_cond_rewrite k def bound cond_eqs le_proofs); + observe_tac "refl equal" (apply (delayed_force refl_equal))] g | spec1::specs -> fun g -> let ids = ids_of_named_context (pf_hyps g) in @@ -406,19 +434,15 @@ let rec introduce_all_equalities func eqs values specs bound le_proofs let string_match s = try for i = 0 to 3 do - if String.get s i <> String.get "Acc_" i then failwith "" + if String.get s i <> String.get "Acc_" i then failwith "string_match" done; - with Invalid_argument _ -> failwith "" + with Invalid_argument _ -> failwith "string_match" let retrieve_acc_var g = (* Julien: I don't like this version .... *) let hyps = pf_ids_of_hyps g in map_succeed - (fun id -> - try - string_match (string_of_id id); - id - with _ -> failwith "") + (fun id -> string_match (string_of_id id);id) hyps let rec introduce_all_values is_mes acc_inv func context_fn @@ -426,8 +450,8 @@ let rec introduce_all_values is_mes acc_inv func context_fn (match args with [] -> tclTHENLIST - [split(ImplicitBindings - [context_fn (List.map mkVar (List.rev values))]); + [observe_tac "split" (split(ImplicitBindings + [context_fn (List.map mkVar (List.rev values))])); observe_tac "introduce_all_equalities" (introduce_all_equalities func eqs (List.rev values) (List.rev specs) (delayed_force coq_O) [] [])] | arg::args -> @@ -436,23 +460,25 @@ let rec introduce_all_values is_mes acc_inv func context_fn let rec_res = next_global_ident_away true rec_res_id ids in let ids = rec_res::ids in let hspec = next_global_ident_away true hspec_id ids in - let tac = introduce_all_values is_mes acc_inv func context_fn eqs - hrec args - (rec_res::values)(hspec::specs) in + let tac = + observe_tac "introduce_all_values" ( + introduce_all_values is_mes acc_inv func context_fn eqs + hrec args + (rec_res::values)(hspec::specs)) in (tclTHENS - (simplest_elim (mkApp(mkVar hrec, Array.of_list arg))) + (observe_tac "elim h_rec" (simplest_elim (mkApp(mkVar hrec, Array.of_list arg)))) [tclTHENLIST [h_intros [rec_res; hspec]; tac]; (tclTHENS - (apply (Lazy.force acc_inv)) - [ h_assumption + (observe_tac "acc_inv" (apply (Lazy.force acc_inv))) + [ observe_tac "h_assumption" h_assumption ; - (fun g -> - tclUSER - is_mes - (Some (hrec::hspec::(retrieve_acc_var g)@specs)) - g - ) + observe_tac "user proof" (fun g -> + tclUSER + is_mes + (Some (hrec::hspec::(retrieve_acc_var g)@specs)) + g + ) ] ) ]) g) @@ -466,48 +492,6 @@ let rec_leaf_terminate is_mes acc_inv hrec (func:global_reference) eqs expr = observe_tac "introduce_all_values" (introduce_all_values is_mes acc_inv func context_fn eqs hrec args [] []) -(* -let rec proveterminate is_mes acc_inv (hrec:identifier) - (f_constr:constr) (func:global_reference) (eqs:constr list) (expr:constr) = -try -(* let _ = msgnl (str "entering proveterminate") in *) - let v = - match (kind_of_term expr) with - Case (_, t, a, l) -> - (match find_call_occs f_constr a with - _,[] -> - tclTHENS (fun g -> -(* let _ = msgnl(str "entering mkCaseEq") in *) - let v = (mkCaseEq a) g in -(* let _ = msgnl (str "exiting mkCaseEq") in *) - v - ) - (List.map (mk_intros_and_continue true - (proveterminate is_mes acc_inv hrec f_constr func) - eqs) - (Array.to_list l)) - | _, _::_ -> - ( - match find_call_occs f_constr expr with - _,[] -> observe_tac "base_leaf" (base_leaf func eqs expr) - | _, _:: _ -> - observe_tac "rec_leaf" (rec_leaf is_mes acc_inv hrec func eqs expr) - ) - ) - | _ -> (match find_call_occs f_constr expr with - _,[] -> - (try - observe_tac "base_leaf" (base_leaf func eqs expr) - with e -> (msgerrnl (str "failure in base case");raise e )) - | _, _::_ -> - observe_tac "rec_leaf" (rec_leaf is_mes acc_inv hrec func eqs expr) - ) in - (* let _ = msgnl(str "exiting proveterminate") in *) - v -with e -> - msgerrnl(str "failure in proveterminate"); - raise e -*) let proveterminate is_mes acc_inv (hrec:identifier) (f_constr:constr) (func:global_reference) base_leaf rec_leaf = let rec proveterminate (eqs:constr list) (expr:constr) = @@ -551,8 +535,10 @@ let proveterminate is_mes acc_inv (hrec:identifier) (* let _ = msgnl(str "exiting proveterminate") in *) v with e -> - msgerrnl(str "failure in proveterminate"); - raise e + begin + msgerrnl(str "failure in proveterminate"); + raise e + end in proveterminate @@ -691,7 +677,7 @@ let whole_start is_mes func input_type relation rec_arg_num : tactic = let f_id = match f_name with | Name f_id -> next_global_ident_away true f_id ids - | Anonymous -> assert false + | Anonymous -> anomaly "Anonymous function" in let n_names_types,_ = decompose_lam body1 in let n_ids,ids = @@ -701,7 +687,7 @@ let whole_start is_mes func input_type relation rec_arg_num : tactic = | Name id -> let n_id = next_global_ident_away true id ids in n_id::n_ids,n_id::ids - | _ -> assert false + | _ -> anomaly "anonymous argument" ) ([],(f_id::ids)) n_names_types @@ -747,7 +733,7 @@ let build_and_l l = let mk_and p1 p2 = Term.mkApp(and_constr,[|p1;p2|]) in let rec f = function - | [] -> assert false + | [] -> failwith "empty list of subgoals!" | [p] -> p,tclIDTAC,1 | p1::pl -> let c,tac,nb = f pl in @@ -765,43 +751,6 @@ let build_new_goal_type () = res - -let interpretable_as_section_decl d1 d2 = match d1,d2 with - | (_,Some _,_), (_,None,_) -> false - | (_,Some b1,t1), (_,Some b2,t2) -> eq_constr b1 b2 & eq_constr t1 t2 - | (_,None,t1), (_,_,t2) -> eq_constr t1 t2 - - - - -(* let final_decompose lemma n : tactic = *) -(* fun gls -> *) -(* let hid = next_global_ident_away true h_id (pf_ids_of_hyps gls) in *) -(* tclTHENSEQ *) -(* [ *) -(* generalize [lemma]; *) -(* tclDO *) -(* n *) -(* (tclTHENSEQ *) -(* [h_intro hid; *) -(* h_case (mkVar hid,Rawterm.NoBindings); *) -(* clear [hid]; *) -(* intro_patterns [Genarg.IntroWildcard] *) -(* ] *) -(* ); *) -(* h_intro hid; *) -(* tclTRY *) -(* (tclTHENSEQ [h_case (mkVar hid,Rawterm.NoBindings); *) -(* clear [hid]; *) -(* h_intro hid; *) -(* intro_patterns [Genarg.IntroWildcard] *) -(* ]); *) -(* e_resolve_constr (mkVar hid); *) -(* e_assumption *) -(* ] *) -(* gls *) - - let prove_with_tcc lemma _ : tactic = fun gls -> @@ -823,25 +772,19 @@ let open_new_goal ref goal_name (gls_type,decompose_and_tac,nb_goal) = let name = match goal_name with | Some s -> s | None -> - try (add_suffix current_proof_name "_subproof") with _ -> assert false - + try (add_suffix current_proof_name "_subproof") + with _ -> anomaly "open_new_goal with an unamed theorem" in let sign = Global.named_context () in let sign = clear_proofs sign in let na = next_global_ident_away false name [] in if occur_existential gls_type then Util.error "\"abstract\" cannot handle existentials"; - (* let v = let lemme = mkConst (Lib.make_con na) in *) -(* Tactics.exact_no_check *) -(* (applist (lemme, *) -(* List.rev (Array.to_list (Sign.instance_from_named_context sign)))) *) -(* gls in *) - let hook _ _ = let lemma = mkConst (Lib.make_con na) in Array.iteri (fun i _ -> by (observe_tac "tac" (prove_with_tcc lemma i))) (Array.make nb_goal ()); ref := Some lemma ; - Command.save_named true; + defined (); in start_proof na @@ -850,9 +793,17 @@ let open_new_goal ref goal_name (gls_type,decompose_and_tac,nb_goal) = gls_type hook ; by (decompose_and_tac); - () + if Options.is_verbose () then (pp (Printer.pr_open_subgoals())) + -let com_terminate ref is_mes fonctional_ref input_type relation rec_arg_num +let com_terminate + tcc_lemma_name + tcc_lemma_ref + is_mes + fonctional_ref + input_type + relation + rec_arg_num thm_name hook = let (evmap, env) = Command.get_current_context() in start_proof thm_name @@ -860,10 +811,14 @@ let com_terminate ref is_mes fonctional_ref input_type relation rec_arg_num (hyp_terminates fonctional_ref) hook; by (observe_tac "whole_start" (whole_start is_mes fonctional_ref input_type relation rec_arg_num )); - open_new_goal ref - None - (build_new_goal_type ()) - + try + let new_goal_type = build_new_goal_type () in + open_new_goal tcc_lemma_ref + (Some tcc_lemma_name) + (new_goal_type) + with Failure "empty list of subgoals!" -> + (* a non recursive function declared with measure ! *) + defined () @@ -1111,13 +1066,14 @@ let (com_eqn : identifier -> ) ) ); - Command.save_named true);; + defined (); + );; -let recursive_definition is_mes f type_of_f r rec_arg_num eq +let recursive_definition is_mes function_name type_of_f r rec_arg_num eq generate_induction_principle : unit = let function_type = interp_constr Evd.empty (Global.env()) type_of_f in - let env = push_rel (Name f,None,function_type) (Global.env()) in + let env = push_rel (Name function_name,None,function_type) (Global.env()) in let res_vars,eq' = decompose_prod (interp_constr Evd.empty env eq) in let res = (* Pp.msgnl (str "res_var :=" ++ Printer.pr_lconstr_env (push_rel_context (List.map (function (x,t) -> (x,None,t)) res_vars) env) eq'); *) @@ -1125,17 +1081,16 @@ let recursive_definition is_mes f type_of_f r rec_arg_num eq (* Pp.msgnl (str "eq' := " ++ str (string_of_int rec_arg_num)); *) match kind_of_term eq' with | App(e,[|_;_;eq_fix|]) -> - mkLambda (Name f,function_type,compose_lam res_vars eq_fix) + mkLambda (Name function_name,function_type,compose_lam res_vars eq_fix) | _ -> failwith "Recursive Definition (res not eq)" in let pre_rec_args,function_type_before_rec_arg = decompose_prod_n (rec_arg_num - 1) function_type in let (_, rec_arg_type, _) = destProd function_type_before_rec_arg in let arg_types = List.rev_map snd (fst (decompose_prod_n (List.length res_vars) function_type)) in - let equation_id = add_suffix f "_equation" in - let functional_id = add_suffix f "_F" in - let term_id = add_suffix f "_terminate" in + let equation_id = add_suffix function_name "_equation" in + let functional_id = add_suffix function_name "_F" in + let term_id = add_suffix function_name "_terminate" in let functional_ref = declare_fun functional_id (IsDefinition Definition) res in -(* let _ = Pp.msgnl (str "res := " ++ Printer.pr_lconstr res) in *) let env_with_pre_rec_args = push_rel_context(List.map (function (x,t) -> (x,None,t)) pre_rec_args) env in let relation = interp_constr @@ -1143,242 +1098,66 @@ let recursive_definition is_mes f type_of_f r rec_arg_num eq env_with_pre_rec_args r in + let tcc_lemma_name = add_suffix function_name "_tcc" in let tcc_lemma_constr = ref None in (* let _ = Pp.msgnl (str "relation := " ++ Printer.pr_lconstr_env env_with_pre_rec_args relation) in *) let hook _ _ = let term_ref = Nametab.locate (make_short_qualid term_id) in - let f_ref = declare_f f (IsProof Lemma) arg_types term_ref in -(* let _ = message "start second proof" in *) - com_eqn equation_id functional_ref f_ref term_ref eq; - let eq_ref = Nametab.locate (make_short_qualid equation_id ) in - generate_induction_principle tcc_lemma_constr - functional_ref eq_ref rec_arg_num rec_arg_type (nb_prod res) relation; - () - - in - com_terminate - tcc_lemma_constr - is_mes functional_ref - rec_arg_type - relation rec_arg_num - term_id - hook -;; - - - -(* let observe_tac = do_observe_tac *) - -let base_leaf_princ eq_cst functional_ref eqs expr = - tclTHENSEQ - [rewriteLR (mkConst eq_cst); - tclTRY (list_rewrite true eqs); - gen_eauto(* default_eauto *) false (false,5) [] (Some []) - ] - - - -let prove_with_tcc tcc_lemma_constr eqs : tactic = - match !tcc_lemma_constr with - | None -> tclIDTAC_MESSAGE (str "No tcc proof !!") - | Some lemma -> - fun gls -> - let hid = next_global_ident_away true h_id (pf_ids_of_hyps gls) in - tclTHENSEQ - [ - generalize [lemma]; - h_intro hid; - Elim.h_decompose_and (mkVar hid); - tclTRY(list_rewrite true eqs); - gen_eauto(* default_eauto *) false (false,5) [] (Some []) - (* default_auto *) - ] - gls - - - -let finalize_rec_leaf_princ_with tcc_lemma_constr is_mes hrec acc_inv eqs br = - fun g -> - tclTHENSEQ [ - Eauto.e_resolve_constr (mkVar br); - tclFIRST - [ - e_assumption; - reflexivity; - tclTHEN (apply (mkVar hrec)) - (tclTHENS - (* (try *) (observe_tac "applying inversion" (apply (Lazy.force acc_inv))) -(* with e -> Pp.msgnl (Printer.pr_lconstr (Lazy.force acc_inv));raise e *) -(* ) *) - [ h_assumption - ; - tclTHEN - (fun g -> - tclUSER - is_mes - (Some (hrec::(retrieve_acc_var g))) - g - ) - (fun g -> prove_with_tcc tcc_lemma_constr eqs g) - ] - ); - gen_eauto(* default_eauto *) false (false,5) [] (Some []); - (fun g -> tclIDTAC_MESSAGE (str "here" ++ Printer.pr_goal (sig_it g)) g) - ] - ] - g - -let rec_leaf_princ - tcc_lemma_constr - eq_cst - branches_names - is_mes - acc_inv - hrec - (functional_ref:global_reference) - eqs - expr - = - fun g -> - tclTHENSEQ - [ rewriteLR (mkConst eq_cst); - list_rewrite true eqs; - tclFIRST - (List.map (finalize_rec_leaf_princ_with tcc_lemma_constr is_mes hrec acc_inv eqs) branches_names) - ] - g - -let fresh_id avoid na = - let id = - match na with - | Name id -> id - | Anonymous -> h_id - in - next_global_ident_away true id avoid - - - -let prove_principle tcc_lemma_ref is_mes functional_ref - eq_ref rec_arg_num rec_arg_type nb_args relation = -(* f_ref eq_ref rec_arg_num rec_arg_type nb_args relation *) - let eq_cst = - match eq_ref with - ConstRef sp -> sp - | _ -> assert false - in - fun g -> - let type_of_goal = pf_concl g in - let goal_ids = pf_ids_of_hyps g in - let goal_elim_infos = compute_elim_sig type_of_goal in - let params_names,ids = List.fold_left - (fun (params_names,avoid) (na,_,_) -> - let new_id = fresh_id avoid na in - (new_id::params_names,new_id::avoid) - ) - ([],goal_ids) - goal_elim_infos.params - in - let predicates_names,ids = - List.fold_left - (fun (predicates_names,avoid) (na,_,_) -> - let new_id = fresh_id avoid na in - (new_id::predicates_names,new_id::avoid) - ) - ([],ids) - goal_elim_infos.predicates - in - let branches_names,ids = - List.fold_left - (fun (branches_names,avoid) (na,_,_) -> - let new_id = fresh_id avoid na in - (new_id::branches_names,new_id::avoid) - ) - ([],ids) - goal_elim_infos.branches - in - let to_intro = params_names@predicates_names@branches_names in - let nparams = List.length params_names in - let rec_arg_num = rec_arg_num - nparams in + let f_ref = declare_f function_name (IsProof Lemma) arg_types term_ref in +(* message "start second proof"; *) begin - tclTHEN - (h_intros to_intro) - (observe_tac (string_of_int (rec_arg_num)) - (fun g -> - let ids = ids_of_named_context (pf_hyps g) in - let func_body = (def_of_const (constr_of_reference functional_ref)) in -(* let _ = Pp.msgnl (Printer.pr_lconstr func_body) in *) - let (f_name, _, body1) = destLambda func_body in - let f_id = - match f_name with - | Name f_id -> next_global_ident_away true f_id ids - | Anonymous -> assert false - in - let n_names_types,_ = decompose_lam body1 in - let n_ids,ids = - List.fold_left - (fun (n_ids,ids) (n_name,_) -> - match n_name with - | Name id -> - let n_id = next_global_ident_away true id ids in - n_id::n_ids,n_id::ids - | _ -> assert false + try com_eqn equation_id functional_ref f_ref term_ref eq + with e -> + begin + ignore(try Vernacentries.vernac_reset_name (Util.dummy_loc,functional_id) with _ -> ()); + anomaly "Cannot create equation Lemma" + end + end; + let eq_ref = Nametab.locate (make_short_qualid equation_id ) in + let f_ref = destConst (constr_of_reference f_ref) + and functional_ref = destConst (constr_of_reference functional_ref) + and eq_ref = destConst (constr_of_reference eq_ref) in + generate_induction_principle f_ref tcc_lemma_constr + functional_ref eq_ref rec_arg_num rec_arg_type (nb_prod res) relation; + if Options.is_verbose () + then msgnl (h 1 (Ppconstr.pr_id function_name ++ + spc () ++ str"is defined" )++ fnl () ++ + h 1 (Ppconstr.pr_id equation_id ++ + spc () ++ str"is defined" ) ) - ([],(f_id::ids)) - n_names_types - in - let rec_arg_id = List.nth n_ids (rec_arg_num - 1 ) in - let expr = - instantiate_lambda func_body - (mkVar f_id::(List.map mkVar n_ids)) - in - start - is_mes - rec_arg_type - ids - (snd (list_chop nparams n_ids)) - (substl (List.map mkVar params_names) relation) - (rec_arg_num) - rec_arg_id - (fun hrec acc_inv g -> - (proveterminate - is_mes - acc_inv - hrec - (mkVar f_id) - functional_ref - (base_leaf_princ eq_cst) - (rec_leaf_princ tcc_lemma_ref eq_cst branches_names) - [] - expr - ) - g - ) - (if is_mes - then - tclUSER_if_not_mes - else fun _ -> prove_with_tcc tcc_lemma_ref []) - - g - ) - ) + in + try + com_terminate + tcc_lemma_name + tcc_lemma_constr + is_mes functional_ref + rec_arg_type + relation rec_arg_num + term_id + hook + with e -> + begin + ignore(try Vernacentries.vernac_reset_name (Util.dummy_loc,functional_id) with _ -> ()); +(* anomaly "Cannot create termination Lemma" *) + raise e end - g - VERNAC COMMAND EXTEND RecursiveDefinition [ "Recursive" "Definition" ident(f) constr(type_of_f) constr(r) constr(wf) constr(proof) integer_opt(rec_arg_num) constr(eq) ] -> - [ ignore(proof);ignore(wf); + [ + warning "Recursive Definition is obsolete. Use Function instead"; + ignore(proof);ignore(wf); let rec_arg_num = match rec_arg_num with | None -> 1 | Some n -> n in - recursive_definition false f type_of_f r rec_arg_num eq (fun _ _ _ _ _ _ _ -> ())] + recursive_definition false f type_of_f r rec_arg_num eq (fun _ _ _ _ _ _ _ _ -> ())] | [ "Recursive" "Definition" ident(f) constr(type_of_f) constr(r) constr(wf) "[" ne_constr_list(proof) "]" constr(eq) ] -> - [ ignore(proof);ignore(wf);recursive_definition false f type_of_f r 1 eq (fun _ _ _ _ _ _ _ -> ())] + [ ignore(proof);ignore(wf);recursive_definition false f type_of_f r 1 eq (fun _ _ _ _ _ _ _ _ -> ())] END diff --git a/contrib/rtauto/Bintree.v b/contrib/rtauto/Bintree.v index 97d80a92..f4b24d4b 100644 --- a/contrib/rtauto/Bintree.v +++ b/contrib/rtauto/Bintree.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: Bintree.v 7233 2005-07-15 12:34:56Z corbinea $ *) +(* $Id: Bintree.v 8881 2006-05-31 18:16:34Z jforest $ *) Require Export List. Require Export BinPos. @@ -18,7 +18,7 @@ Open Scope positive_scope. Ltac clean := try (simpl; congruence). Ltac caseq t := generalize (refl_equal t); pattern t at -1; case t. -Functional Scheme Pcompare_ind := Induction for Pcompare. +Functional Scheme Pcompare_ind := Induction for Pcompare Sort Prop. Lemma Prect : forall P : positive -> Type, P 1 -> @@ -31,13 +31,13 @@ Qed. Lemma Gt_Eq_Gt : forall p q cmp, (p ?= q) Eq = Gt -> (p ?= q) cmp = Gt. -apply (Pcompare_ind (fun p q cmp => (p ?= q) Eq = Gt -> (p ?= q) cmp = Gt)); +apply (Pcompare_ind (fun p q cmp _ => (p ?= q) Eq = Gt -> (p ?= q) cmp = Gt)); simpl;auto;congruence. Qed. Lemma Gt_Lt_Gt : forall p q cmp, (p ?= q) Lt = Gt -> (p ?= q) cmp = Gt. -apply (Pcompare_ind (fun p q cmp => (p ?= q) Lt = Gt -> (p ?= q) cmp = Gt)); +apply (Pcompare_ind (fun p q cmp _ => (p ?= q) Lt = Gt -> (p ?= q) cmp = Gt)); simpl;auto;congruence. Qed. diff --git a/contrib/setoid_ring/newring.ml4 b/contrib/setoid_ring/newring.ml4 index 7041d7e8..bc2bcb0c 100644 --- a/contrib/setoid_ring/newring.ml4 +++ b/contrib/setoid_ring/newring.ml4 @@ -8,7 +8,7 @@ (*i camlp4deps: "parsing/grammar.cma" i*) -(*i $Id: newring.ml4 7974 2006-02-01 19:02:09Z barras $ i*) +(*i $Id: newring.ml4 8878 2006-05-30 16:44:25Z herbelin $ i*) open Pp open Util @@ -204,7 +204,7 @@ let protect_tac = Tactics.reduct_option (protect_red,DEFAULTcast) None ;; let protect_tac_in id = - Tactics.reduct_option (protect_red,DEFAULTcast) (Some(id,[],InHyp));; + Tactics.reduct_option (protect_red,DEFAULTcast) (Some(([],id),InHyp));; TACTIC EXTEND protect_fv @@ -442,10 +442,10 @@ let add_theory name rth eqth morphth cst_tac = | None -> (match kind with Some true -> - let t = Genarg.ArgArg(dummy_loc,Lazy.force ltac_inv_morphN) in + let t = ArgArg(dummy_loc,Lazy.force ltac_inv_morphN) in TacArg(TacCall(dummy_loc,t,List.map carg [zero;one;add;mul])) | Some false -> - let t = Genarg.ArgArg(dummy_loc, Lazy.force ltac_inv_morphZ) in + let t = ArgArg(dummy_loc, Lazy.force ltac_inv_morphZ) in TacArg(TacCall(dummy_loc,t,List.map carg [zero;one;add;mul;opp])) | _ -> error"a tactic must be specified for an almost_ring") in let _ = @@ -495,7 +495,7 @@ let ring gl = spc()++str"\""++pr_constr req++str"\"") in Tacinterp.eval_tactic (TacArg(TacCall(dummy_loc, - Genarg.ArgArg(dummy_loc, Lazy.force ltac_setoid_ring), + ArgArg(dummy_loc, Lazy.force ltac_setoid_ring), Tacexp e.ring_cst_tac:: List.map carg [e.ring_lemma1;e.ring_lemma2;e.ring_req]))) gl @@ -512,7 +512,7 @@ let ring_rewrite rl = (lapp coq_nil [|ty|]) in Tacinterp.eval_tactic (TacArg(TacCall(dummy_loc, - Genarg.ArgArg(dummy_loc, Lazy.force ltac_setoid_ring_rewrite), + ArgArg(dummy_loc, Lazy.force ltac_setoid_ring_rewrite), Tacexp e.ring_cst_tac::List.map carg [e.ring_lemma2;e.ring_req;rl]))) let setoid_ring = function diff --git a/contrib/subtac/Utils.v b/contrib/subtac/Utils.v index 9acb10ae..db10cb2a 100644 --- a/contrib/subtac/Utils.v +++ b/contrib/subtac/Utils.v @@ -1,20 +1,17 @@ Set Implicit Arguments. +Notation "'fun' { x : A | P } => Q" := + (fun x:{x:A|P} => Q) + (at level 200, x ident, right associativity). + +Notation "( x & y )" := (@existS _ _ x y) : core_scope. + Definition ex_pi1 (A : Prop) (P : A -> Prop) (t : ex P) : A. intros. induction t. exact x. Defined. -Check proj1_sig. -Lemma subset_simpl : forall (A : Set) (P : A -> Prop) - (t : sig P), P (proj1_sig t). -Proof. -intros. -induction t. - simpl ; auto. -Qed. - Lemma ex_pi2 : forall (A : Prop) (P : A -> Prop) (t : ex P), P (ex_pi1 t). intros A P. @@ -23,12 +20,17 @@ simpl. exact p. Defined. + +Notation "` t" := (proj1_sig t) (at level 100) : core_scope. Notation "'forall' { x : A | P } , Q" := (forall x:{x:A|P}, Q) (at level 200, x ident, right associativity). -Notation "'fun' { x : A | P } => Q" := - (fun x:{x:A|P} => Q) - (at level 200, x ident, right associativity). +Lemma subset_simpl : forall (A : Set) (P : A -> Prop) + (t : sig P), P (` t). +Proof. +intros. +induction t. + simpl ; auto. +Qed. -Notation "( x & y )" := (@existS _ _ x y) : core_scope. diff --git a/contrib/subtac/eterm.ml b/contrib/subtac/eterm.ml index 5703c0ef..382ae2d5 100644 --- a/contrib/subtac/eterm.ml +++ b/contrib/subtac/eterm.ml @@ -47,9 +47,9 @@ let subst_evars evs n t = | Evar (k, args) -> (try let index, hyps = evar_info k in - trace (str "Evar " ++ int k ++ str " found, applied to " ++ int (Array.length args) ++ str "arguments," ++ - int (List.length hyps) ++ str " hypotheses"); - + (try trace (str "Evar " ++ int k ++ str " found, applied to " ++ int (Array.length args) ++ str "arguments," ++ + int (List.length hyps) ++ str " hypotheses"); with _ -> () ); + let ex = mkRel (index + depth) in (* Evar arguments are created in inverse order, and we must not apply to defined ones (i.e. LetIn's) @@ -128,7 +128,7 @@ let eterm_term evm t tycon = let anon_evar_bl = List.map (fun (_, x, y) -> (Anonymous, x, y)) evar_bl in (* Generalize over the existential variables *) let t'' = Termops.it_mkLambda_or_LetIn t' evar_bl - and tycon = option_app + and tycon = option_map (fun typ -> Termops.it_mkProd_wo_LetIn typ anon_evar_bl) tycon in let _declare_evar (id, c) = @@ -140,15 +140,17 @@ let eterm_term evm t tycon = let id = id_of_string ("Evar" ^ string_of_int id) in tclTHEN acc (Tactics.assert_tac false (Name id) c) in - trace (str "Term given to eterm" ++ spc () ++ - Termops.print_constr_env (Global.env ()) t); - trace (str "Term constructed in eterm" ++ spc () ++ - Termops.print_constr_env (Global.env ()) t''); - ignore(option_app - (fun typ -> - trace (str "Type :" ++ spc () ++ - Termops.print_constr_env (Global.env ()) typ)) - tycon); + (try + trace (str "Term given to eterm" ++ spc () ++ + Termops.print_constr_env (Global.env ()) t); + trace (str "Term constructed in eterm" ++ spc () ++ + Termops.print_constr_env (Global.env ()) t''); + ignore(option_map + (fun typ -> + trace (str "Type :" ++ spc () ++ + Termops.print_constr_env (Global.env ()) typ)) + tycon); + with _ -> ()); t'', tycon, evar_names let mkMetas n = diff --git a/contrib/subtac/g_subtac.ml4 b/contrib/subtac/g_subtac.ml4 index c3f2a24d..b56ecc3d 100644 --- a/contrib/subtac/g_subtac.ml4 +++ b/contrib/subtac/g_subtac.ml4 @@ -10,7 +10,7 @@ Syntax for the subtac terms and types. Elaborated from correctness/psyntax.ml4 by Jean-Christophe Filliâtre *) -(* $Id: g_subtac.ml4 8688 2006-04-07 15:08:12Z msozeau $ *) +(* $Id: g_subtac.ml4 8917 2006-06-07 16:59:05Z herbelin $ *) (*i camlp4deps: "parsing/grammar.cma" i*) @@ -49,11 +49,11 @@ GEXTEND Gram ; END -type gallina_loc_argtype = (Vernacexpr.vernac_expr located, constr_expr, Tacexpr.raw_tactic_expr) Genarg.abstract_argument_type +type ('a,'b) gallina_loc_argtype = (Vernacexpr.vernac_expr located, 'a, 'b) Genarg.abstract_argument_type -let (wit_subtac_gallina_loc : gallina_loc_argtype), - (globwit_subtac_gallina_loc : gallina_loc_argtype), - (rawwit_subtac_gallina_loc : gallina_loc_argtype) = +let (wit_subtac_gallina_loc : (Genarg.tlevel, Proof_type.tactic) gallina_loc_argtype), + (globwit_subtac_gallina_loc : (Genarg.glevel, Tacexpr.glob_tactic_expr) gallina_loc_argtype), + (rawwit_subtac_gallina_loc : (Genarg.rlevel, Tacexpr.raw_tactic_expr) gallina_loc_argtype) = Genarg.create_arg "subtac_gallina_loc" VERNAC COMMAND EXTEND Subtac diff --git a/contrib/subtac/subtac.ml b/contrib/subtac/subtac.ml index 84b7d39b..cd2e7c43 100644 --- a/contrib/subtac/subtac.ml +++ b/contrib/subtac/subtac.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: subtac.ml 8688 2006-04-07 15:08:12Z msozeau $ *) +(* $Id: subtac.ml 8889 2006-06-01 20:23:56Z msozeau $ *) open Global open Pp @@ -48,8 +48,10 @@ let subtac_one_fixpoint env isevars (f, decl) = let ((id, n, bl, typ, body), decl) = Subtac_interp_fixpoint.rewrite_fixpoint env [] (f, decl) in - let _ = trace (str "Working on a single fixpoint rewritten as: " ++ spc () ++ - Ppconstr.pr_constr_expr body) + let _ = + try trace (str "Working on a single fixpoint rewritten as: " ++ spc () ++ + Ppconstr.pr_constr_expr body) + with _ -> () in ((id, n, bl, typ, body), decl) @@ -115,16 +117,44 @@ let subtac_end_proof = function *) +open Pp +open Ppconstr +open Decl_kinds + +let start_proof_com env isevars sopt kind (bl,t) hook = + let id = match sopt with + | Some id -> + (* We check existence here: it's a bit late at Qed time *) + if Nametab.exists_cci (Lib.make_path id) or is_section_variable id then + errorlabstrm "start_proof" (pr_id id ++ str " already exists"); + id + | None -> + next_global_ident_away false (id_of_string "Unnamed_thm") + (Pfedit.get_all_proof_names ()) + in + let evm, c, typ = + Subtac_pretyping.subtac_process env isevars id [] (Command.generalize_constr_expr t bl) None + in + let _ = Typeops.infer_type env c in + Command.start_proof id kind c hook + +let print_subgoals () = Options.if_verbose (fun () -> msg (Printer.pr_open_subgoals ())) () + +let start_proof_and_print env isevars idopt k t hook = + start_proof_com env isevars idopt k t hook; + print_subgoals () + (*if !pcoq <> None then (out_some !pcoq).start_proof ()*) + let subtac (loc, command) = check_required_library ["Coq";"Init";"Datatypes"]; check_required_library ["Coq";"Init";"Specif"]; require_library "Coq.subtac.FixSub"; require_library "Coq.subtac.Utils"; + let env = Global.env () in + let isevars = ref (create_evar_defs Evd.empty) in try match command with VernacDefinition (defkind, (locid, id), expr, hook) -> - let env = Global.env () in - let isevars = ref (create_evar_defs Evd.empty) in (match expr with ProveBody (bl, c) -> let evm, c, ctyp = Subtac_pretyping.subtac_process env isevars id bl c None in @@ -142,6 +172,19 @@ let subtac (loc, command) = | VernacFixpoint (l, b) -> let _ = trace (str "Building fixpoint") in ignore(Subtac_command.build_recursive l b) + + | VernacStartTheoremProof (thkind, (locid, id), (bl, t), lettop, hook) -> + if not(Pfedit.refining ()) then + if lettop then + errorlabstrm "Subtac_command.StartProof" + (str "Let declarations can only be used in proof editing mode"); + if Lib.is_modtype () then + errorlabstrm "Subtac_command.StartProof" + (str "Proof editing mode not supported in module types"); + start_proof_and_print env isevars (Some id) (Global, Proof thkind) (bl,t) hook + + + (*| VernacEndProof e -> subtac_end_proof e*) diff --git a/contrib/subtac/subtac_coercion.ml b/contrib/subtac/subtac_coercion.ml index 7c8ea2d6..7428e1ed 100644 --- a/contrib/subtac/subtac_coercion.ml +++ b/contrib/subtac/subtac_coercion.ml @@ -5,7 +5,7 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: subtac_coercion.ml 8695 2006-04-10 16:33:52Z msozeau $ *) +(* $Id: subtac_coercion.ml 8889 2006-06-01 20:23:56Z msozeau $ *) open Util open Names @@ -53,7 +53,8 @@ module Coercion = struct | _ -> None and disc_exist env x = - trace (str "Disc_exist: " ++ my_print_constr env x); + (try trace (str "Disc_exist: " ++ my_print_constr env x) + with _ -> ()); match kind_of_term x with | App (c, l) -> (match kind_of_term c with @@ -66,7 +67,8 @@ module Coercion = struct let disc_proj_exist env x = - trace (str "disc_proj_exist: " ++ my_print_constr env x); + (try trace (str "disc_proj_exist: " ++ my_print_constr env x); + with _ -> ()); match kind_of_term x with | App (c, l) -> (if Term.eq_constr c (Lazy.force sig_).proj1 @@ -97,30 +99,34 @@ module Coercion = struct app_opt f (mkApp ((Lazy.force sig_).proj1, [| u; p; x |]))), ct) - | None -> (None, t) + | None -> (None, v) in aux t and coerce loc env isevars (x : Term.constr) (y : Term.constr) : (Term.constr -> Term.constr) option = let x = nf_evar (evars_of !isevars) x and y = nf_evar (evars_of !isevars) y in - trace (str "Coerce called for " ++ (my_print_constr env x) ++ - str " and "++ my_print_constr env y ++ - str " with evars: " ++ spc () ++ - my_print_evardefs !isevars); + (try trace (str "Coerce called for " ++ (my_print_constr env x) ++ + str " and "++ my_print_constr env y ++ + str " with evars: " ++ spc () ++ + my_print_evardefs !isevars); + with _ -> ()); let rec coerce_unify env x y = - trace (str "coerce_unify from " ++ (my_print_constr env x) ++ - str " to "++ my_print_constr env y); + (try trace (str "coerce_unify from " ++ (my_print_constr env x) ++ + str " to "++ my_print_constr env y) + with _ -> ()); try isevars := the_conv_x_leq env x y !isevars; - trace (str "Unified " ++ (my_print_constr env x) ++ - str " and "++ my_print_constr env y); + (try (trace (str "Unified " ++ (my_print_constr env x) ++ + str " and "++ my_print_constr env y)); + with _ -> ()); None with Reduction.NotConvertible -> coerce' env (hnf env isevars x) (hnf env isevars y) and coerce' env x y : (Term.constr -> Term.constr) option = let subco () = subset_coerce env isevars x y in - trace (str "coerce' from " ++ (my_print_constr env x) ++ - str " to "++ my_print_constr env y); + (try trace (str "coerce' from " ++ (my_print_constr env x) ++ + str " to "++ my_print_constr env y); + with _ -> ()); match (kind_of_term x, kind_of_term y) with | Sort s, Sort s' -> (match s, s' with @@ -153,7 +159,7 @@ module Coercion = struct if i = Term.destInd existS.typ then begin - debug 1 (str "In coerce sigma types"); + trace (str "In coerce sigma types"); let (a, pb), (a', pb') = pair_of_array l, pair_of_array l' in @@ -244,7 +250,7 @@ module Coercion = struct let coerce_itf loc env isevars v t c1 = let evars = ref isevars in let coercion = coerce loc env evars t c1 in - !evars, option_app (app_opt coercion) v, t + !evars, option_map (app_opt coercion) v, t (* Taken from pretyping/coercion.ml *) @@ -339,6 +345,13 @@ module Coercion = struct | _ -> inh_tosort_force loc env isevars j + let inh_coerce_to_base loc env isevars j = + let typ = whd_betadeltaiota env (evars_of isevars) j.uj_type in + let ct, typ' = mu env isevars typ in + isevars, { uj_val = app_opt ct j.uj_val; + uj_type = typ' } + + let inh_coerce_to_fail env isevars c1 v t = let v', t' = try @@ -371,7 +384,7 @@ module Coercion = struct (match kind_of_term (whd_betadeltaiota env (evars_of isevars) t), kind_of_term (whd_betadeltaiota env (evars_of isevars) c1) with | Prod (_,t1,t2), Prod (name,u1,u2) -> - let v' = option_app (whd_betadeltaiota env (evars_of isevars)) v in + let v' = option_map (whd_betadeltaiota env (evars_of isevars)) v in let (evd',b) = match v' with Some v' -> @@ -387,7 +400,7 @@ module Coercion = struct let env1 = push_rel (x,None,v1) env in let (evd'', v2', t2') = inh_conv_coerce_to_fail loc env1 evd' (Some v2) t2 u2 in - (evd'', option_app (fun v2' -> mkLambda (x, v1, v2')) v2', + (evd'', option_map (fun v2' -> mkLambda (x, v1, v2')) v2', mkProd (x, v1, t2')) | None -> (* Mismatch on t1 and u1 or not a lambda: we eta-expand *) @@ -404,7 +417,7 @@ module Coercion = struct let (evd'', v2', t2') = let v2 = match v with - Some v -> option_app (fun v1' -> mkApp (lift 1 v, [|v1'|])) v1' + Some v -> option_map (fun v1' -> mkApp (lift 1 v, [|v1'|])) v1' | None -> None and evd', t2 = match v1' with @@ -415,7 +428,7 @@ module Coercion = struct in inh_conv_coerce_to_fail loc env1 evd' v2 t2 u2 in - (evd'', option_app (fun v2' -> mkLambda (name, u1, v2')) v2', + (evd'', option_map (fun v2' -> mkLambda (name, u1, v2')) v2', mkProd (name, u1, t2'))) | _ -> raise NoCoercion)) diff --git a/contrib/subtac/subtac_command.ml b/contrib/subtac/subtac_command.ml index 1b92c691..b09228c0 100644 --- a/contrib/subtac/subtac_command.ml +++ b/contrib/subtac/subtac_command.ml @@ -55,8 +55,8 @@ let interp_gen kind isevars env ?(impls=([],[])) ?(allow_soapp=false) ?(ltacvars=([],[])) c = let c' = Constrintern.intern_gen (kind=IsType) ~impls ~allow_soapp ~ltacvars (Evd.evars_of !isevars) env c in - let c' = Subtac_interp_fixpoint.rewrite_cases env c' in - msgnl (str "Pretyping " ++ my_print_constr_expr c); + let c' = Subtac_utils.rewrite_cases env c' in + (try trace (str "Pretyping " ++ my_print_constr_expr c) with _ -> ()); let c' = SPretyping.pretype_gen isevars env ([],[]) kind c' in evar_nf isevars c' @@ -200,15 +200,18 @@ let build_recursive (lnameargsardef:(fixpoint_expr * decl_notation) list) boxed let impls' =(recname,([],impl,compute_arguments_scope arity))::impls in (Environ.push_named (recname,None,arity) env, impls', (isevars, None, arity)::arl) | CWfRec r -> - let _ = trace (str "Rewriting fixpoint: " ++ Ppconstr.pr_id recname ++ - Ppconstr.pr_binders bl ++ str " : " ++ - Ppconstr.pr_constr_expr arityc ++ str " := " ++ spc () ++ - Ppconstr.pr_constr_expr body) + let n = out_some n in + let _ = + try trace (str "Rewriting fixpoint: " ++ Ppconstr.pr_id recname ++ + Ppconstr.pr_binders bl ++ str " : " ++ + Ppconstr.pr_constr_expr arityc ++ str " := " ++ spc () ++ + Ppconstr.pr_constr_expr body) + with _ -> () in let env', binders_rel = interp_context isevars env0 bl in let after, ((argname, _, argtyp) as arg), before = list_chop_hd n binders_rel in let argid = match argname with Name n -> n | _ -> assert(false) in - let after' = List.map (fun (n, c, t) -> (n, option_app (lift 1) c, lift 1 t)) after in + let after' = List.map (fun (n, c, t) -> (n, option_map (lift 1) c, lift 1 t)) after in let envwf = push_rel_context before env0 in let wf_rel = interp_constr isevars envwf r in let accarg_id = id_of_string ("Acc_" ^ string_of_id argid) in @@ -233,10 +236,11 @@ let build_recursive (lnameargsardef:(fixpoint_expr * decl_notation) list) boxed let _ = let pr c = my_print_constr env c in let prr = Printer.pr_rel_context env in - trace (str "Fun bl: " ++ prr fun_bl ++ spc () ++ - str "Intern bl" ++ prr intern_bl ++ spc () ++ - str "Extern bl" ++ prr new_bl ++ spc () ++ - str "Intern arity: " ++ pr intern_arity) + try trace (str "Fun bl: " ++ prr fun_bl ++ spc () ++ + str "Intern bl" ++ prr intern_bl ++ spc () ++ + str "Extern bl" ++ prr new_bl ++ spc () ++ + str "Intern arity: " ++ pr intern_arity) + with _ -> () in let impl = if Impargs.is_implicit_args() @@ -279,14 +283,15 @@ let build_recursive (lnameargsardef:(fixpoint_expr * decl_notation) list) boxed let (lnonrec,(namerec,defrec,arrec,nvrec)) = collect_non_rec env0 lrecnames recdef arityl nv in - let nvrec' = Array.map fst nvrec in(* ignore rec order *) + let nvrec' = Array.map (function (Some n,_) -> n | _ -> 0) nvrec in(* ignore rec order *) let declare arrec defrec = let recvec = Array.map (subst_vars (List.rev (Array.to_list namerec))) defrec in let recdecls = (Array.map (fun id -> Name id) namerec, arrec, recvec) in let rec declare i fi = - trace (str "Declaring: " ++ pr_id fi ++ spc () ++ - my_print_constr env0 (recvec.(i))); + (try trace (str "Declaring: " ++ pr_id fi ++ spc () ++ + my_print_constr env0 (recvec.(i))); + with _ -> ()); let ce = { const_entry_body = mkFix ((nvrec',i),recdecls); const_entry_type = Some arrec.(i); @@ -331,20 +336,20 @@ let build_recursive (lnameargsardef:(fixpoint_expr * decl_notation) list) boxed let rec collect_evars i acc = if i < recdefs then let (isevars, info, def) = defrec.(i) in - let _ = trace (str "In solve evars, isevars is: " ++ Evd.pr_evar_defs !isevars) in + let _ = try trace (str "In solve evars, isevars is: " ++ Evd.pr_evar_defs !isevars) with _ -> () in let def = evar_nf isevars def in let isevars = Evd.undefined_evars !isevars in - let _ = trace (str "In solve evars, undefined is: " ++ Evd.pr_evar_defs isevars) in + let _ = try trace (str "In solve evars, undefined is: " ++ Evd.pr_evar_defs isevars) with _ -> () in let evm = Evd.evars_of isevars in let _, _, typ = arrec.(i) in let id = namerec.(i) in - let evars_def, evars_typ, evars = Eterm.eterm_term evm def (Some typ) in (* Generalize by the recursive prototypes *) let def = Termops.it_mkNamedLambda_or_LetIn def (Environ.named_context rec_sign) and typ = Termops.it_mkNamedProd_or_LetIn typ (Environ.named_context rec_sign) in + let evars_def, evars_typ, evars = Eterm.eterm_term evm def (Some typ) in (*let evars_typ = match evars_typ with Some t -> t | None -> assert(false) in*) (*let fi = id_of_string (string_of_id id ^ "_evars") in*) (*let ce = @@ -357,10 +362,16 @@ let build_recursive (lnameargsardef:(fixpoint_expr * decl_notation) list) boxed trace (str (string_of_id fi) ++ str " is defined");*) let evar_sum = if evars = [] then None - else + else ( + (try trace (str "Building evars sum for : "); + List.iter + (fun (n, t) -> trace (str "Evar " ++ str (string_of_id n) ++ spc () ++ my_print_constr env0 t)) + evars; + with _ -> ()); let sum = Subtac_utils.build_dependent_sum evars in - trace (str "Evars sum: " ++ my_print_constr env0 (pi1 sum)); - Some sum + (try trace (str "Evars sum: " ++ my_print_constr env0 (snd sum)); + with _ -> ()); + Some sum) in collect_evars (succ i) ((id, evars_def, evar_sum) :: acc) else acc @@ -370,32 +381,34 @@ let build_recursive (lnameargsardef:(fixpoint_expr * decl_notation) list) boxed (* Solve evars then create the definitions *) let real_evars = filter_map (fun (id, kn, sum) -> - match sum with Some (sumg, sumtac, _) -> Some (id, kn, sumg, sumtac) | None -> None) + match sum with Some (sumtac, sumg) -> Some (id, kn, sumg, sumtac) | None -> None) defs in Subtac_utils.and_tac real_evars (fun f _ gr -> - let _ = trace (str "Got a proof of: " ++ pr_global gr) in + let _ = trace (str "Got a proof of: " ++ pr_global gr ++ + str "type: " ++ my_print_constr (Global.env ()) (Global.type_of_global gr)) in let constant = match gr with Libnames.ConstRef c -> c | _ -> assert(false) in try (*let value = Environ.constant_value (Global.env ()) constant in*) let pis = f (mkConst constant) in - trace (str "Accessors: " ++ - List.fold_right (fun (_, _, _, c) acc -> my_print_constr env0 c ++ spc () ++ acc) - pis (mt())); - trace (str "Applied existentials: " ++ - (List.fold_right - (fun (id, kn, sumg, pi) acc -> - let args = Subtac_utils.destruct_ex pi sumg in - my_print_constr env0 (mkApp (kn, Array.of_list args))) - pis (mt ()))); + (try (trace (str "Accessors: " ++ + List.fold_right (fun (_, _, _, c) acc -> my_print_constr env0 c ++ spc () ++ acc) + pis (mt())); + trace (str "Applied existentials: " ++ + (List.fold_right + (fun (id, kn, sumg, pi) acc -> + let args = Subtac_utils.destruct_ex pi sumg in + my_print_constr env0 (mkApp (kn, Array.of_list args))) + pis (mt ())))) + with _ -> ()); let rec aux pis acc = function (id, kn, sum) :: tl -> (match sum with None -> aux pis (kn :: acc) tl - | Some (sumg, _, _) -> + | Some (_, sumg) -> let (id, kn, sumg, pi), pis = List.hd pis, List.tl pis in let args = Subtac_utils.destruct_ex pi sumg in let args = diff --git a/contrib/subtac/subtac_interp_fixpoint.ml b/contrib/subtac/subtac_interp_fixpoint.ml index 599dbe39..858fad1a 100644 --- a/contrib/subtac/subtac_interp_fixpoint.ml +++ b/contrib/subtac/subtac_interp_fixpoint.ml @@ -110,7 +110,7 @@ let rewrite_fixpoint env l (f, decl) = let body = (* cast or we will loose some info at pretyping time as body is a function *) - CCast (dummy_loc, body, DEFAULTcast, typ) + CCast (dummy_loc, body, CastConv DEFAULTcast, typ) in let body' = (* body abstracted by rec call *) mkLambdaC ([(dummy_loc, Name id)], internal_type, body) @@ -151,69 +151,3 @@ let rewrite_fixpoint env l (f, decl) = Ppconstr.pr_constr_expr body') in (id, (succ n, ro), bl', typ, body'), decl -let list_mapi f = - let rec aux i = function - hd :: tl -> f i hd :: aux (succ i) tl - | [] -> [] - in aux 0 - -let rewrite_cases_aux (loc, po, tml, eqns) = - let tml = list_mapi (fun i (c, (n, opt)) -> c, - ((match n with - Name id -> (match c with - | RVar (_, id') when id = id' -> - Name (id_of_string (string_of_id id ^ "'")) - | _ -> n) - | Anonymous -> Name (id_of_string ("x" ^ string_of_int i))), - opt)) tml - in - let mkHole = RHole (dummy_loc, InternalHole) in - let mkeq c n = RApp (dummy_loc, RRef (dummy_loc, (Lazy.force eqind_ref)), - [mkHole; c; n]) - in - let eqs_types = - List.map - (fun (c, (n, _)) -> - let id = match n with Name id -> id | _ -> assert false in - let heqid = id_of_string ("Heq" ^ string_of_id id) in - Name heqid, mkeq c (RVar (dummy_loc, id))) - tml - in - let po = - List.fold_right - (fun (n,t) acc -> - RProd (dummy_loc, Anonymous, t, acc)) - eqs_types (match po with - Some e -> e - | None -> mkHole) - in - let eqns = - List.map (fun (loc, idl, cpl, c) -> - let c' = - List.fold_left - (fun acc (n, t) -> - RLambda (dummy_loc, n, mkHole, acc)) - c eqs_types - in (loc, idl, cpl, c')) - eqns - in - let mk_refl_equal c = RApp (dummy_loc, RRef (dummy_loc, Lazy.force refl_equal_ref), - [mkHole; c]) - in - let refls = List.map (fun (c, _) -> mk_refl_equal c) tml in - let case = RCases (loc,Some po,tml,eqns) in - let app = RApp (dummy_loc, case, refls) in - app - -let rec rewrite_cases c = - match c with - RCases _ -> let c' = map_rawconstr rewrite_cases c in - (match c' with - | RCases (x, y, z, w) -> rewrite_cases_aux (x,y,z,w) - | _ -> assert(false)) - | _ -> map_rawconstr rewrite_cases c - -let rewrite_cases env c = - let c' = rewrite_cases c in - let _ = trace (str "Rewrote cases: " ++ spc () ++ my_print_rawconstr env c') in - c' diff --git a/contrib/subtac/subtac_interp_fixpoint.mli b/contrib/subtac/subtac_interp_fixpoint.mli index b0de0641..fafbb2da 100644 --- a/contrib/subtac/subtac_interp_fixpoint.mli +++ b/contrib/subtac/subtac_interp_fixpoint.mli @@ -26,14 +26,3 @@ val rewrite_fixpoint : Topconstr.local_binder list * Topconstr.constr_expr * Topconstr.constr_expr) * 'c -val list_mapi : (int -> 'a -> 'b) -> 'a list -> 'b list -val rewrite_cases_aux : - Util.loc * Rawterm.rawconstr option * - (Rawterm.rawconstr * - (Names.name * (Util.loc * Names.inductive * Names.name list) option)) - list * - (Util.loc * Names.identifier list * Rawterm.cases_pattern list * - Rawterm.rawconstr) - list -> Rawterm.rawconstr - -val rewrite_cases : Environ.env -> Rawterm.rawconstr -> Rawterm.rawconstr diff --git a/contrib/subtac/subtac_pretyping.ml b/contrib/subtac/subtac_pretyping.ml index 104a0a58..261e0c5b 100644 --- a/contrib/subtac/subtac_pretyping.ml +++ b/contrib/subtac/subtac_pretyping.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: subtac_pretyping.ml 8688 2006-04-07 15:08:12Z msozeau $ *) +(* $Id: subtac_pretyping.ml 8889 2006-06-01 20:23:56Z msozeau $ *) open Global open Pp @@ -39,7 +39,7 @@ open Subtac_errors open Context open Eterm -module Pretyping = Pretyping.Pretyping_F(Subtac_coercion.Coercion) +module Pretyping = Subtac_pretyping_F.SubtacPretyping_F(Subtac_coercion.Coercion) open Pretyping @@ -116,24 +116,26 @@ let subtac_process env isevars id l c tycon = let evars () = evars_of !isevars in let _ = trace (str "Creating env with binders") in let env_binders, binders_rel = env_with_binders env isevars l in - let _ = trace (str "New env created:" ++ my_print_context env_binders) in + let _ = try (trace (str "New env created:" ++ my_print_context env_binders)) with _ -> () in let tycon = match tycon with None -> empty_tycon | Some t -> let t = coqintern !isevars env_binders t in - let _ = trace (str "Internalized specification: " ++ my_print_rawconstr env_binders t) in + let _ = try trace (str "Internalized specification: " ++ my_print_rawconstr env_binders t) with _ -> () in let coqt, ttyp = interp env_binders isevars t empty_tycon in - let _ = trace (str "Interpreted type: " ++ my_print_constr env_binders coqt) in + let _ = try trace (str "Interpreted type: " ++ my_print_constr env_binders coqt) with _ -> () in mk_tycon coqt in let c = coqintern !isevars env_binders c in - let _ = trace (str "Internalized term: " ++ my_print_rawconstr env c) in + let c = Subtac_utils.rewrite_cases env c in + let _ = try trace (str "Internalized term: " ++ my_print_rawconstr env c) with _ -> () in let coqc, ctyp = interp env_binders isevars c tycon in - let _ = trace (str "Interpreted term: " ++ my_print_constr env_binders coqc ++ spc () ++ + let _ = try trace (str "Interpreted term: " ++ my_print_constr env_binders coqc ++ spc () ++ str "Coq type: " ++ my_print_constr env_binders ctyp) + with _ -> () in - let _ = trace (str "Original evar map: " ++ Evd.pr_evar_map (evars ())) in + let _ = try trace (str "Original evar map: " ++ Evd.pr_evar_map (evars ())) with _ -> () in let fullcoqc = it_mkLambda_or_LetIn coqc binders_rel and fullctyp = it_mkProd_or_LetIn ctyp binders_rel @@ -141,10 +143,11 @@ let subtac_process env isevars id l c tycon = let fullcoqc = Evarutil.nf_evar (evars_of !isevars) fullcoqc in let fullctyp = Evarutil.nf_evar (evars_of !isevars) fullctyp in - let _ = trace (str "After evar normalization: " ++ spc () ++ + let _ = try trace (str "After evar normalization: " ++ spc () ++ str "Coq term: " ++ my_print_constr env fullcoqc ++ spc () ++ str "Coq type: " ++ my_print_constr env fullctyp) + with _ -> () in let evm = non_instanciated_map env isevars in - let _ = trace (str "Non instanciated evars map: " ++ Evd.pr_evar_map evm) in + let _ = try trace (str "Non instanciated evars map: " ++ Evd.pr_evar_map evm) with _ -> () in evm, fullcoqc, fullctyp diff --git a/contrib/subtac/subtac_pretyping_F.ml b/contrib/subtac/subtac_pretyping_F.ml new file mode 100644 index 00000000..65952750 --- /dev/null +++ b/contrib/subtac/subtac_pretyping_F.ml @@ -0,0 +1,639 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(* $Id: subtac_pretyping_F.ml 8889 2006-06-01 20:23:56Z msozeau $ *) + +open Pp +open Util +open Names +open Sign +open Evd +open Term +open Termops +open Reductionops +open Environ +open Type_errors +open Typeops +open Libnames +open Nameops +open Classops +open List +open Recordops +open Evarutil +open Pretype_errors +open Rawterm +open Evarconv +open Pattern +open Dyn +open Pretyping + +(************************************************************************) +(* This concerns Cases *) +open Declarations +open Inductive +open Inductiveops + +module SubtacPretyping_F (Coercion : Coercion.S) = struct + + module Cases = Cases.Cases_F(Coercion) + + (* Allow references to syntaxically inexistent variables (i.e., if applied on an inductive) *) + let allow_anonymous_refs = ref true + + let evd_comb0 f isevars = + let (evd',x) = f !isevars in + isevars := evd'; + x + + let evd_comb1 f isevars x = + let (evd',y) = f !isevars x in + isevars := evd'; + y + + let evd_comb2 f isevars x y = + let (evd',z) = f !isevars x y in + isevars := evd'; + z + + let evd_comb3 f isevars x y z = + let (evd',t) = f !isevars x y z in + isevars := evd'; + t + + let mt_evd = Evd.empty + + let vect_lift_type = Array.mapi (fun i t -> type_app (lift i) t) + + (* Utilisé pour inférer le prédicat des Cases *) + (* Semble exagérement fort *) + (* Faudra préférer une unification entre les types de toutes les clauses *) + (* et autoriser des ? à rester dans le résultat de l'unification *) + + let evar_type_fixpoint loc env isevars lna lar vdefj = + let lt = Array.length vdefj in + if Array.length lar = lt then + for i = 0 to lt-1 do + if not (e_cumul env isevars (vdefj.(i)).uj_type + (lift lt lar.(i))) then + error_ill_typed_rec_body_loc loc env (evars_of !isevars) + i lna vdefj lar + done + + let check_branches_message loc env isevars c (explft,lft) = + for i = 0 to Array.length explft - 1 do + if not (e_cumul env isevars lft.(i) explft.(i)) then + let sigma = evars_of !isevars in + error_ill_formed_branch_loc loc env sigma c i lft.(i) explft.(i) + done + + (* coerce to tycon if any *) + let inh_conv_coerce_to_tycon loc env isevars j = function + | None -> j + | Some t -> evd_comb2 (Coercion.inh_conv_coerce_to loc env) isevars j t + + let push_rels vars env = List.fold_right push_rel vars env + + (* + let evar_type_case isevars env ct pt lft p c = + let (mind,bty,rslty) = type_case_branches env (evars_of isevars) ct pt p c + in check_branches_message isevars env (c,ct) (bty,lft); (mind,rslty) + *) + + let strip_meta id = (* For Grammar v7 compatibility *) + let s = string_of_id id in + if s.[0]='$' then id_of_string (String.sub s 1 (String.length s - 1)) + else id + + let pretype_id loc env (lvar,unbndltacvars) id = + let id = strip_meta id in (* May happen in tactics defined by Grammar *) + try + let (n,typ) = lookup_rel_id id (rel_context env) in + { uj_val = mkRel n; uj_type = type_app (lift n) typ } + with Not_found -> + try + List.assoc id lvar + with Not_found -> + try + let (_,_,typ) = lookup_named id env in + { uj_val = mkVar id; uj_type = typ } + with Not_found -> + try (* To build a nicer ltac error message *) + 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 -> + error_var_not_found_loc loc id + + (* make a dependent predicate from an undependent one *) + + let make_dep_of_undep env (IndType (indf,realargs)) pj = + let n = List.length realargs in + let rec decomp n p = + if n=0 then p else + match kind_of_term p with + | Lambda (_,_,c) -> decomp (n-1) c + | _ -> decomp (n-1) (applist (lift 1 p, [mkRel 1])) + in + let sign,s = decompose_prod_n n pj.uj_type in + let ind = build_dependent_inductive env indf in + let s' = mkProd (Anonymous, ind, s) in + let ccl = lift 1 (decomp n pj.uj_val) in + let ccl' = mkLambda (Anonymous, ind, ccl) in + {uj_val=lam_it ccl' sign; uj_type=prod_it s' sign} + + (*************************************************************************) + (* Main pretyping function *) + + let pretype_ref isevars env ref = + let c = constr_of_global ref in + make_judge c (Retyping.get_type_of env Evd.empty c) + + let pretype_sort = function + | RProp c -> judge_of_prop_contents c + | RType _ -> judge_of_new_Type () + + (* [pretype tycon env isevars lvar lmeta cstr] attempts to type [cstr] *) + (* in environment [env], with existential variables [(evars_of isevars)] and *) + (* the type constraint tycon *) + let rec pretype (tycon : type_constraint) env isevars lvar = function + | RRef (loc,ref) -> + inh_conv_coerce_to_tycon loc env isevars + (pretype_ref isevars env ref) + tycon + + | RVar (loc, id) -> + inh_conv_coerce_to_tycon loc env isevars + (pretype_id loc env lvar id) + tycon + + | REvar (loc, ev, instopt) -> + (* Ne faudrait-il pas s'assurer que hyps est bien un + sous-contexte du contexte courant, et qu'il n'y a pas de Rel "caché" *) + let hyps = evar_context (Evd.find (evars_of !isevars) ev) in + let args = match instopt with + | None -> instance_from_named_context hyps + | Some inst -> failwith "Evar subtitutions not implemented" in + let c = mkEvar (ev, args) in + let j = (Retyping.get_judgment_of env (evars_of !isevars) c) in + inh_conv_coerce_to_tycon loc env isevars j tycon + + | RPatVar (loc,(someta,n)) -> + anomaly "Found a pattern variable in a rawterm to type" + + | RHole (loc,k) -> + let ty = + match tycon with + | Some (None, ty) -> ty + | None | Some _ -> + e_new_evar isevars env ~src:(loc,InternalHole) (new_Type ()) in + { uj_val = e_new_evar isevars env ~src:(loc,k) ty; uj_type = ty } + + | RRec (loc,fixkind,names,bl,lar,vdef) -> + let rec type_bl env ctxt = function + [] -> ctxt + | (na,None,ty)::bl -> + let ty' = pretype_type empty_valcon env isevars lvar ty in + let dcl = (na,None,ty'.utj_val) in + type_bl (push_rel dcl env) (add_rel_decl dcl ctxt) bl + | (na,Some bd,ty)::bl -> + let ty' = pretype_type empty_valcon env isevars lvar ty in + let bd' = pretype (mk_tycon ty'.utj_val) env isevars lvar ty in + let dcl = (na,Some bd'.uj_val,ty'.utj_val) in + type_bl (push_rel dcl env) (add_rel_decl dcl ctxt) bl in + let ctxtv = Array.map (type_bl env empty_rel_context) bl in + let larj = + array_map2 + (fun e ar -> + pretype_type empty_valcon (push_rel_context e env) isevars lvar ar) + ctxtv lar in + let lara = Array.map (fun a -> a.utj_val) larj in + let ftys = array_map2 (fun e a -> it_mkProd_or_LetIn a e) ctxtv lara in + let nbfix = Array.length lar in + let names = Array.map (fun id -> Name id) names in + (* Note: bodies are not used by push_rec_types, so [||] is safe *) + let newenv = push_rec_types (names,ftys,[||]) env in + let vdefj = + array_map2_i + (fun i ctxt def -> + (* we lift nbfix times the type in tycon, because of + * the nbfix variables pushed to newenv *) + let (ctxt,ty) = + decompose_prod_n_assum (rel_context_length ctxt) + (lift nbfix ftys.(i)) in + let nenv = push_rel_context ctxt newenv in + let j = pretype (mk_tycon ty) nenv isevars lvar def in + { uj_val = it_mkLambda_or_LetIn j.uj_val ctxt; + uj_type = it_mkProd_or_LetIn j.uj_type ctxt }) + ctxtv vdef in + evar_type_fixpoint loc env isevars names ftys vdefj; + let fixj = match fixkind with + | RFix (vn,i) -> + let guard_indexes = Array.mapi + (fun i (n,_) -> match n with + | Some n -> n + | None -> + (* Recursive argument was not given by the user : We + check that there is only one inductive argument *) + let ctx = ctxtv.(i) in + let isIndApp t = + isInd (fst (decompose_app (strip_head_cast t))) in + (* This could be more precise (e.g. do some delta) *) + let lb = List.rev_map (fun (_,_,t) -> isIndApp t) ctx in + try (list_unique_index true lb) - 1 + with Not_found -> + Util.user_err_loc + (loc,"pretype", + Pp.str "cannot guess decreasing argument of fix")) + vn + in + let fix = ((guard_indexes, i),(names,ftys,Array.map j_val vdefj)) in + (try check_fix env fix with e -> Stdpp.raise_with_loc loc e); + make_judge (mkFix fix) ftys.(i) + | RCoFix i -> + let cofix = (i,(names,ftys,Array.map j_val vdefj)) in + (try check_cofix env cofix with e -> Stdpp.raise_with_loc loc e); + make_judge (mkCoFix cofix) ftys.(i) in + inh_conv_coerce_to_tycon loc env isevars fixj tycon + + | RSort (loc,s) -> + inh_conv_coerce_to_tycon loc env isevars (pretype_sort s) tycon + + | RApp (loc,f,args) -> + let length = List.length args in + let ftycon = + match tycon with + None -> None + | Some (None, ty) -> mk_abstr_tycon length ty + | Some (Some (init, cur), ty) -> + Some (Some (length + init, length + cur), ty) + in + let fj = pretype ftycon env isevars lvar f in + let floc = loc_of_rawconstr f in + let rec apply_rec env n resj tycon = function + | [] -> resj + | c::rest -> + let argloc = loc_of_rawconstr c in + let resj = evd_comb1 (Coercion.inh_app_fun env) isevars resj in + let resty = whd_betadeltaiota env (evars_of !isevars) resj.uj_type in + match kind_of_term resty with + | Prod (na,c1,c2) -> + let hj = pretype (mk_tycon c1) env isevars lvar c in + let value, typ = applist (j_val resj, [j_val hj]), subst1 hj.uj_val c2 in + let typ' = nf_isevar !isevars typ in + let tycon = + option_map + (fun (abs, ty) -> + match abs with + None -> + isevars := Coercion.inh_conv_coerces_to loc env !isevars typ' + (abs, ty); + (abs, ty) + | Some (init, cur) -> + isevars := Coercion.inh_conv_coerces_to loc env !isevars typ' + (abs, ty); + (Some (init, pred cur), ty)) + tycon + in + apply_rec env (n+1) + { uj_val = nf_isevar !isevars value; + uj_type = nf_isevar !isevars typ' } + (option_map (fun (abs, c) -> abs, nf_isevar !isevars c) tycon) rest + + | _ -> + let hj = pretype empty_tycon env isevars lvar c in + error_cant_apply_not_functional_loc + (join_loc floc argloc) env (evars_of !isevars) + resj [hj] + in + let ftycon = option_map (lift_abstr_tycon_type (-1)) ftycon in + let resj = j_nf_evar (evars_of !isevars) (apply_rec env 1 fj ftycon args) in + let resj = + match kind_of_term resj.uj_val with + | App (f,args) when isInd f -> + let sigma = evars_of !isevars in + let t = Retyping.type_of_inductive_knowing_parameters env sigma (destInd f) args in + let s = snd (splay_arity env sigma t) in + on_judgment_type (set_inductive_level env s) resj + (* Rem: no need to send sigma: no head evar, it's an arity *) + | _ -> resj in + inh_conv_coerce_to_tycon loc env isevars resj tycon + + | RLambda(loc,name,c1,c2) -> + let (name',dom,rng) = evd_comb1 (split_tycon loc env) isevars tycon in + let dom_valcon = valcon_of_tycon dom in + let j = pretype_type dom_valcon env isevars lvar c1 in + let var = (name,None,j.utj_val) in + let j' = pretype rng (push_rel var env) isevars lvar c2 in + judge_of_abstraction env name j j' + + | RProd(loc,name,c1,c2) -> + let j = pretype_type empty_valcon env isevars lvar c1 in + let var = (name,j.utj_val) in + let env' = push_rel_assum var env in + let j' = pretype_type empty_valcon env' isevars lvar c2 in + let resj = + try judge_of_product env name j j' + with TypeError _ as e -> Stdpp.raise_with_loc loc e in + inh_conv_coerce_to_tycon loc env isevars resj tycon + + | RLetIn(loc,name,c1,c2) -> + let j = pretype empty_tycon env isevars lvar c1 in + let t = refresh_universes j.uj_type in + let var = (name,Some j.uj_val,t) in + let tycon = lift_tycon 1 tycon in + let j' = pretype tycon (push_rel var env) isevars lvar c2 in + { uj_val = mkLetIn (name, j.uj_val, t, j'.uj_val) ; + uj_type = subst1 j.uj_val j'.uj_type } + + | RLetTuple (loc,nal,(na,po),c,d) -> + let cj = pretype empty_tycon env isevars lvar c in + let (IndType (indf,realargs)) = + try find_rectype env (evars_of !isevars) cj.uj_type + with Not_found -> + let cloc = loc_of_rawconstr c in + error_case_not_inductive_loc cloc env (evars_of !isevars) cj + in + let cstrs = get_constructors env indf in + if Array.length cstrs <> 1 then + user_err_loc (loc,"",str "Destructing let is only for inductive types with one constructor"); + let cs = cstrs.(0) in + if List.length nal <> cs.cs_nargs then + user_err_loc (loc,"", str "Destructing let on this type expects " ++ int cs.cs_nargs ++ str " variables"); + let fsign = List.map2 (fun na (_,c,t) -> (na,c,t)) + (List.rev nal) cs.cs_args in + let env_f = push_rels fsign env in + (* Make dependencies from arity signature impossible *) + let arsgn = + let arsgn,_ = get_arity env indf in + if not !allow_anonymous_refs then + List.map (fun (_,b,t) -> (Anonymous,b,t)) arsgn + else arsgn + in + let psign = (na,None,build_dependent_inductive env indf)::arsgn in + let nar = List.length arsgn in + (match po with + | Some p -> + let env_p = push_rels psign env in + let pj = pretype_type empty_valcon env_p isevars lvar p in + let ccl = nf_evar (evars_of !isevars) pj.utj_val in + let psign = make_arity_signature env true indf in (* with names *) + let p = it_mkLambda_or_LetIn ccl psign in + let inst = + (Array.to_list cs.cs_concl_realargs) + @[build_dependent_constructor cs] in + let lp = lift cs.cs_nargs p in + let fty = hnf_lam_applist env (evars_of !isevars) lp inst in + let fj = pretype (mk_tycon fty) env_f isevars lvar d in + let f = it_mkLambda_or_LetIn fj.uj_val fsign in + let v = + let mis,_ = dest_ind_family indf in + let ci = make_default_case_info env LetStyle mis in + mkCase (ci, p, cj.uj_val,[|f|]) in + { uj_val = v; uj_type = substl (realargs@[cj.uj_val]) ccl } + + | None -> + let tycon = lift_tycon cs.cs_nargs tycon in + let fj = pretype tycon env_f isevars lvar d in + let f = it_mkLambda_or_LetIn fj.uj_val fsign in + let ccl = nf_evar (evars_of !isevars) fj.uj_type in + let ccl = + if noccur_between 1 cs.cs_nargs ccl then + lift (- cs.cs_nargs) ccl + else + error_cant_find_case_type_loc loc env (evars_of !isevars) + cj.uj_val in + let p = it_mkLambda_or_LetIn (lift (nar+1) ccl) psign in + let v = + let mis,_ = dest_ind_family indf in + let ci = make_default_case_info env LetStyle mis in + mkCase (ci, p, cj.uj_val,[|f|] ) + in + { uj_val = v; uj_type = ccl }) + + | RIf (loc,c,(na,po),b1,b2) -> + let cj = pretype empty_tycon env isevars lvar c in + let (IndType (indf,realargs)) = + try find_rectype env (evars_of !isevars) cj.uj_type + with Not_found -> + let cloc = loc_of_rawconstr c in + error_case_not_inductive_loc cloc env (evars_of !isevars) cj in + let cstrs = get_constructors env indf in + if Array.length cstrs <> 2 then + user_err_loc (loc,"", + str "If is only for inductive types with two constructors"); + + let arsgn = + let arsgn,_ = get_arity env indf in + if not !allow_anonymous_refs then + (* Make dependencies from arity signature impossible *) + List.map (fun (_,b,t) -> (Anonymous,b,t)) arsgn + else arsgn + in + let nar = List.length arsgn in + let psign = (na,None,build_dependent_inductive env indf)::arsgn in + let pred,p = match po with + | Some p -> + let env_p = push_rels psign env in + let pj = pretype_type empty_valcon env_p isevars lvar p in + let ccl = nf_evar (evars_of !isevars) pj.utj_val in + let pred = it_mkLambda_or_LetIn ccl psign in + let typ = lift (- nar) (beta_applist (pred,[cj.uj_val])) in + let jtyp = inh_conv_coerce_to_tycon loc env isevars {uj_val = pred; + uj_type = typ} tycon + in + jtyp.uj_val, jtyp.uj_type + | None -> + let p = match tycon with + | Some (None, ty) -> ty + | None | Some _ -> + e_new_evar isevars env ~src:(loc,InternalHole) (new_Type ()) + in + it_mkLambda_or_LetIn (lift (nar+1) p) psign, p in + let pred = nf_evar (evars_of !isevars) pred in + let p = nf_evar (evars_of !isevars) p in + (* msgnl (str "Pred is: " ++ Termops.print_constr_env env pred);*) + let f cs b = + let n = rel_context_length cs.cs_args in + let pi = lift n pred in (* liftn n 2 pred ? *) + let pi = beta_applist (pi, [build_dependent_constructor cs]) in + let csgn = + if not !allow_anonymous_refs then + List.map (fun (_,b,t) -> (Anonymous,b,t)) cs.cs_args + else + List.map + (fun (n, b, t) -> + match n with + Name _ -> (n, b, t) + | Anonymous -> (Name (id_of_string "H"), b, t)) + cs.cs_args + in + let env_c = push_rels csgn env in +(* msgnl (str "Pi is: " ++ Termops.print_constr_env env_c pi); *) + let bj = pretype (mk_tycon pi) env_c isevars lvar b in + it_mkLambda_or_LetIn bj.uj_val cs.cs_args in + let b1 = f cstrs.(0) b1 in + let b2 = f cstrs.(1) b2 in + let v = + let mis,_ = dest_ind_family indf in + let ci = make_default_case_info env IfStyle mis in + mkCase (ci, pred, cj.uj_val, [|b1;b2|]) + in + { uj_val = v; uj_type = p } + + | RCases (loc,po,tml,eqns) -> + Cases.compile_cases loc + ((fun vtyc env -> pretype vtyc env isevars lvar),isevars) + tycon env (* loc *) (po,tml,eqns) + + | RCast(loc,c,k,t) -> + let cj = + match k with + CastCoerce -> + let cj = pretype empty_tycon env isevars lvar c in + evd_comb1 (Coercion.inh_coerce_to_base loc env) isevars cj + | CastConv k -> + let tj = pretype_type empty_valcon env isevars lvar t in + let cj = pretype (mk_tycon tj.utj_val) env isevars lvar c in + (* User Casts are for helping pretyping, experimentally not to be kept*) + (* ... except for Correctness *) + let v = mkCast (cj.uj_val, k, tj.utj_val) in + { uj_val = v; uj_type = tj.utj_val } + in + inh_conv_coerce_to_tycon loc env isevars cj tycon + + | RDynamic (loc,d) -> + if (tag d) = "constr" then + let c = constr_out d in + let j = (Retyping.get_judgment_of env (evars_of !isevars) c) in + j + (*inh_conv_coerce_to_tycon loc env isevars j tycon*) + else + user_err_loc (loc,"pretype",(str "Not a constr tagged Dynamic")) + + (* [pretype_type valcon env isevars lvar c] coerces [c] into a type *) + and pretype_type valcon env isevars lvar = function + | RHole loc -> + (match valcon with + | Some v -> + let s = + let sigma = evars_of !isevars in + let t = Retyping.get_type_of env sigma v in + match kind_of_term (whd_betadeltaiota env sigma t) with + | Sort s -> s + | Evar v when is_Type (existential_type sigma v) -> + evd_comb1 (define_evar_as_sort) isevars v + | _ -> anomaly "Found a type constraint which is not a type" + in + { utj_val = v; + utj_type = s } + | None -> + let s = new_Type_sort () in + { utj_val = e_new_evar isevars env ~src:loc (mkSort s); + utj_type = s}) + | c -> + let j = pretype empty_tycon env isevars lvar c in + let loc = loc_of_rawconstr c in + let tj = evd_comb1 (Coercion.inh_coerce_to_sort loc env) isevars j in + match valcon with + | None -> tj + | Some v -> + if e_cumul env isevars v tj.utj_val then tj + else + error_unexpected_type_loc + (loc_of_rawconstr c) env (evars_of !isevars) tj.utj_val v + + let pretype_gen isevars env lvar kind c = + let c' = match kind with + | OfType exptyp -> + let tycon = match exptyp with None -> empty_tycon | Some t -> mk_tycon t in + (pretype tycon env isevars lvar c).uj_val + | IsType -> + (pretype_type empty_valcon env isevars lvar c).utj_val in + nf_evar (evars_of !isevars) c' + + (* [check_evars] fails if some unresolved evar remains *) + (* it assumes that the defined existentials have already been substituted + (should be done in unsafe_infer and unsafe_infer_type) *) + + let check_evars env initial_sigma isevars c = + let sigma = evars_of !isevars in + let rec proc_rec c = + match kind_of_term c with + | Evar (ev,args) -> + assert (Evd.mem sigma ev); + if not (Evd.mem initial_sigma ev) then + let (loc,k) = evar_source ev !isevars in + error_unsolvable_implicit loc env sigma k + | _ -> iter_constr proc_rec c + in + proc_rec c(*; + let (_,pbs) = get_conv_pbs !isevars (fun _ -> true) in + if pbs <> [] then begin + pperrnl + (str"TYPING OF "++Termops.print_constr_env env c++fnl()++ + prlist_with_sep fnl + (fun (pb,c1,c2) -> + Termops.print_constr c1 ++ + (if pb=Reduction.CUMUL then str " <="++ spc() + else str" =="++spc()) ++ + Termops.print_constr c2) + pbs ++ fnl()) + end*) + + (* TODO: comment faire remonter l'information si le typage a resolu des + variables du sigma original. il faudrait que la fonction de typage + retourne aussi le nouveau sigma... + *) + + let understand_judgment sigma env c = + let isevars = ref (create_evar_defs sigma) in + let j = pretype empty_tycon env isevars ([],[]) c in + let j = j_nf_evar (evars_of !isevars) j in + check_evars env sigma isevars (mkCast(j.uj_val,DEFAULTcast, j.uj_type)); + j + + let understand_judgment_tcc isevars env c = + let j = pretype empty_tycon env isevars ([],[]) c in + let sigma = evars_of !isevars in + let j = j_nf_evar sigma j in + j + + (* Raw calls to the unsafe inference machine: boolean says if we must + fail on unresolved evars; the unsafe_judgment list allows us to + extend env with some bindings *) + + let ise_pretype_gen fail_evar sigma env lvar kind c = + let isevars = ref (Evd.create_evar_defs sigma) in + let c = pretype_gen isevars env lvar kind c in + if fail_evar then check_evars env sigma isevars c; + !isevars, c + + (** Entry points of the high-level type synthesis algorithm *) + + let understand_gen kind sigma env c = + snd (ise_pretype_gen true sigma env ([],[]) kind c) + + let understand sigma env ?expected_type:exptyp c = + snd (ise_pretype_gen true sigma env ([],[]) (OfType exptyp) c) + + let understand_type sigma env c = + snd (ise_pretype_gen true sigma env ([],[]) IsType c) + + let understand_ltac sigma env lvar kind c = + ise_pretype_gen false sigma env lvar kind c + + let understand_tcc_evars isevars env kind c = + pretype_gen isevars env ([],[]) kind c + + let understand_tcc sigma env ?expected_type:exptyp c = + let ev, t = ise_pretype_gen false sigma env ([],[]) (OfType exptyp) c in + Evd.evars_of ev, t +end + +module Default : S = SubtacPretyping_F(Coercion.Default) diff --git a/contrib/subtac/subtac_utils.ml b/contrib/subtac/subtac_utils.ml index 6c165dad..59c858a6 100644 --- a/contrib/subtac/subtac_utils.ml +++ b/contrib/subtac/subtac_utils.ml @@ -57,7 +57,7 @@ let natind = lazy (init_constant ["Init"; "Datatypes"] "nat") let intind = lazy (init_constant ["ZArith"; "binint"] "Z") let existSind = lazy (init_constant ["Init"; "Specif"] "sigS") -let existS = lazy (build_sigma_set ()) +let existS = lazy (build_sigma_type ()) let prod = lazy (build_prod ()) @@ -118,8 +118,8 @@ let print_args env args = let make_existential loc env isevars c = let evar = Evarutil.e_new_evar isevars env ~src:(loc, QuestionMark) c in let (key, args) = destEvar evar in - debug 2 (str "Constructed evar " ++ int key ++ str " applied to args: " ++ - print_args env args); + (try debug 2 (str "Constructed evar " ++ int key ++ str " applied to args: " ++ + print_args env args) with _ -> ()); evar let make_existential_expr loc env c = @@ -160,26 +160,27 @@ open Tactics open Tacticals let build_dependent_sum l = - let rec aux (acc, tac, typ) = function + let rec aux (tac, typ) = function (n, t) :: tl -> let t' = mkLambda (Name n, t, typ) in - trace (str ("treating " ^ string_of_id n) ++ - str "assert: " ++ my_print_constr (Global.env ()) t); + trace (spc () ++ str ("treating evar " ^ string_of_id n)); + (try trace (str " assert: " ++ my_print_constr (Global.env ()) t) + with _ -> ()); let tac' = - tclTHEN (assert_tac true (Name n) t) - (tclTHENLIST - [intros; - (tclTHENSEQ - [tclTRY (constructor_tac (Some 1) 1 - (Rawterm.ImplicitBindings [mkVar n])); - tac]); - ]) + tclTHENS (assert_tac true (Name n) t) + ([intros; + (tclTHENSEQ + [constructor_tac (Some 1) 1 + (Rawterm.ImplicitBindings [mkVar n]); + tac]); + ]) in - aux (mkApp (Lazy.force ex_ind, [| t; t'; |]), tac', t') tl - | [] -> acc, tac, typ + let newt = mkApp (Lazy.force ex_ind, [| t; t'; |]) in + aux (tac', newt) tl + | [] -> tac, typ in match l with - (_, hd) :: tl -> aux (hd, intros, hd) tl + (_, hd) :: tl -> aux (intros, hd) tl | [] -> raise (Invalid_argument "build_dependent_sum") open Proof_type @@ -218,7 +219,8 @@ let and_tac l hook = let and_proof_id, and_goal, and_tac, and_extract = match l with | [] -> raise (Invalid_argument "and_tac: empty list of goals") - | (hdid, x, hdg, hdt) :: tl -> aux (string_of_id hdid, hdg, hdt, [hdid, x, hdg, (fun c -> c)]) tl + | (hdid, x, hdg, hdt) :: tl -> + aux (string_of_id hdid, hdg, hdt, [hdid, x, hdg, (fun c -> c)]) tl in let and_proofid = id_of_string (and_proof_id ^ "_and_proof") in Command.start_proof and_proofid goal_kind and_goal @@ -238,9 +240,91 @@ let destruct_ex ext ex = try (args.(0), args.(1)) with _ -> assert(false) in - (mk_ex_pi1 dom rng acc) :: aux rng (mk_ex_pi2 dom rng acc) + let pi1 = (mk_ex_pi1 dom rng acc) in + let rng_body = + match kind_of_term rng with + Lambda (_, _, t) -> subst1 pi1 t + | t -> rng + in + pi1 :: aux rng_body (mk_ex_pi2 dom rng acc) | _ -> [acc]) | _ -> [acc] in aux ex ext +let list_mapi f = + let rec aux i = function + hd :: tl -> f i hd :: aux (succ i) tl + | [] -> [] + in aux 0 + +open Rawterm + +let rewrite_cases_aux (loc, po, tml, eqns) = + let tml' = list_mapi (fun i (c, (n, opt)) -> c, + ((match n with + Name id -> (match c with + | RVar (_, id') when id = id' -> + id, (id_of_string (string_of_id id ^ "Heq_id")) + | RVar (_, id') -> + id', id + | _ -> id_of_string (string_of_id id ^ "Heq_id"), id) + | Anonymous -> + let str = "Heq_id" ^ string_of_int i in + id_of_string str, id_of_string (str ^ "'")), + opt)) tml + in + let mkHole = RHole (dummy_loc, InternalHole) in + let mkCoerceCast c = RCast (dummy_loc, c, CastCoerce, mkHole) in + let mkeq c n = RApp (dummy_loc, RRef (dummy_loc, (Lazy.force eqind_ref)), + [mkHole; c; n]) + in + let eqs_types = + List.map + (fun (c, ((id, id'), _)) -> + let heqid = id_of_string ("Heq" ^ string_of_id id) in + Name heqid, mkeq (RVar (dummy_loc, id')) c) + tml' + in + let po = + List.fold_right + (fun (n,t) acc -> + RProd (dummy_loc, Anonymous, t, acc)) + eqs_types (match po with + Some e -> e + | None -> mkHole) + in + let eqns = + List.map (fun (loc, idl, cpl, c) -> + let c' = + List.fold_left + (fun acc (n, t) -> + RLambda (dummy_loc, n, mkHole, acc)) + c eqs_types + in (loc, idl, cpl, c')) + eqns + in + let mk_refl_equal c = RApp (dummy_loc, RRef (dummy_loc, Lazy.force refl_equal_ref), + [mkHole; c]) + in + let refls = List.map (fun (c, ((id, _), _)) -> mk_refl_equal (mkCoerceCast c)) tml' in + let tml'' = List.map (fun (c, ((id, id'), opt)) -> c, (Name id', opt)) tml' in + let case = RCases (loc,Some po,tml'',eqns) in + let app = RApp (dummy_loc, case, refls) in +(* let letapp = List.fold_left (fun acc (c, ((id, id'), opt)) -> RLetIn (dummy_loc, Name id, c, acc)) *) +(* app tml' *) +(* in *) + app + +let rec rewrite_cases c = + match c with + RCases _ -> let c' = map_rawconstr rewrite_cases c in + (match c' with + | RCases (x, y, z, w) -> rewrite_cases_aux (x,y,z,w) + | _ -> assert(false)) + | _ -> map_rawconstr rewrite_cases c + +let rewrite_cases env c = + let c' = rewrite_cases c in + let _ = trace (str "Rewrote cases: " ++ spc () ++ my_print_rawconstr env c') in + c' diff --git a/contrib/subtac/subtac_utils.mli b/contrib/subtac/subtac_utils.mli index 92a995c8..a90f281f 100644 --- a/contrib/subtac/subtac_utils.mli +++ b/contrib/subtac/subtac_utils.mli @@ -78,8 +78,10 @@ val mkProj1 : constr -> constr -> constr -> constr val mk_ex_pi1 : constr -> constr -> constr -> constr val mk_ex_pi1 : constr -> constr -> constr -> constr -val build_dependent_sum : (identifier * types) list -> constr * Proof_type.tactic * types +val build_dependent_sum : (identifier * types) list -> Proof_type.tactic * types val and_tac : (identifier * 'a * constr * Proof_type.tactic) list -> ((constr -> (identifier * 'a * constr * constr) list) -> Tacexpr.declaration_hook) -> unit val destruct_ex : constr -> constr -> constr list + +val rewrite_cases : Environ.env -> Rawterm.rawconstr -> Rawterm.rawconstr diff --git a/contrib/subtac/test/ListsTest.v b/contrib/subtac/test/ListsTest.v new file mode 100644 index 00000000..a29cd039 --- /dev/null +++ b/contrib/subtac/test/ListsTest.v @@ -0,0 +1,95 @@ +Require Import Coq.subtac.Utils. +Require Import List. + +Variable A : Set. + +Program Definition myhd : forall { l : list A | length l <> 0 }, A := + fun l => + match l with + | nil => _ + | hd :: tl => hd + end. +Proof. + destruct l ; simpl ; intro H ; rewrite <- H in n ; intuition. +Defined. + + +Extraction myhd. +Extraction Inline proj1_sig. + +Program Definition mytail : forall { l : list A | length l <> 0 }, list A := + fun l => + match l with + | nil => _ + | hd :: tl => tl + end. +Proof. +destruct l ; simpl ; intro H ; rewrite <- H in n ; intuition. +Defined. + +Extraction mytail. + +Variable a : A. + +Program Definition test_hd : A := myhd (cons a nil). +Proof. +simpl ; auto. +Defined. + +Extraction test_hd. + +(*Program Definition test_tail : list A := mytail nil.*) + + + + + +Program Fixpoint append (l : list A) (l' : list A) { struct l } : + { r : list A | length r = length l + length l' } := + match l with + | nil => l' + | hd :: tl => hd :: (append tl l') + end. +simpl. +subst ; auto. +simpl ; rewrite (subset_simpl (append tl0 l')). +simpl ; subst. +simpl ; auto. +Defined. + +Extraction append. + + +Program Lemma append_app' : forall l : list A, l = append nil l. +Proof. +simpl ; auto. +Qed. + +Program Lemma append_app : forall l : list A, l = append l nil. +Proof. +intros. +induction l ; simpl ; auto. +simpl in IHl. +rewrite <- IHl. +reflexivity. +Qed. + + + + + + + + + + + + + + + + + + + + diff --git a/contrib/subtac/test/Mutind.v b/contrib/subtac/test/Mutind.v new file mode 100644 index 00000000..ab200354 --- /dev/null +++ b/contrib/subtac/test/Mutind.v @@ -0,0 +1,7 @@ +Fixpoint f (a : nat) : nat := match a with 0 => 0 +| S a' => g a a' + end +with g (a b : nat) { struct b } : nat := + match b with 0 => 0 + | S b' => f b' + end.
\ No newline at end of file diff --git a/contrib/subtac/test/Test1.v b/contrib/subtac/test/Test1.v new file mode 100644 index 00000000..14b80854 --- /dev/null +++ b/contrib/subtac/test/Test1.v @@ -0,0 +1,16 @@ +Program Definition test (a b : nat) : { x : nat | x = a + b } := + ((a + b) : { x : nat | x = a + b }). +Proof. +intros. +reflexivity. +Qed. + +Print test. + +Require Import List. + +Program hd_opt (l : list nat) : { x : nat | x <> 0 } := + match l with + nil => 1 + | a :: l => a + end. diff --git a/contrib/subtac/test/euclid.v b/contrib/subtac/test/euclid.v new file mode 100644 index 00000000..481b6708 --- /dev/null +++ b/contrib/subtac/test/euclid.v @@ -0,0 +1,66 @@ + +Notation "( x & y )" := (@existS _ _ x y) : core_scope. +Unset Printing All. + +Definition t := fun (Evar46 : forall a : nat, (fun y : nat => @eq nat a y) a) (a : nat) => +@existS nat (fun x : nat => @sig nat (fun y : nat => @eq nat x y)) a + (@exist nat (fun y : nat => @eq nat a y) a (Evar46 a)). + +Program Definition testsig (a : nat) : { x : nat & { y : nat | x = y } } := + (a & a). +reflexivity. +Defined. + +Extraction testsig. +Extraction sigS. +Extract Inductive sigS => "" [ "" ]. +Extraction testsig. + +Require Import Coq.Arith.Compare_dec. + +Require Import Omega. + +Lemma minus_eq_add : forall x y z w, y <= x -> x - y = y * z + w -> x = y * S z + w. +intros. +assert(y * S z = y * z + y). +auto. +rewrite H1. +omega. +Qed. + +Program Fixpoint euclid (a : nat) (b : { b : nat | b <> O }) {wf a lt} : + { q : nat & { r : nat | a = b * q + r /\ r < b } } := + if le_lt_dec b a then let (q', r) := euclid (a - b) b in + (S q' & r) + else (O & a). +intro euclid. +simpl ; intros. +Print euclid_evars. +eapply euclid_evars with euclid. +refine (euclid_evars _ _ _ euclid a Acc_a b). +; simpl ; intros. +Show Existentials. + +induction b0 ; induction r. +simpl in H. +simpl. +simpl in p0. +destruct p0. +split. + +apply minus_eq_add. +omega. +auto with arith. +auto. +simpl. +induction b0 ; simpl. +split ; auto. +omega. +exact (euclid a0 Acc_a0 b0). + +exact (Acc_a). +auto. +auto. +Focus 1. + + diff --git a/contrib/subtac/test/id.v b/contrib/subtac/test/id.v new file mode 100644 index 00000000..9ae11088 --- /dev/null +++ b/contrib/subtac/test/id.v @@ -0,0 +1,46 @@ +Require Coq.Arith.Arith. + +Require Import Coq.subtac.Utils. +Program Fixpoint id (n : nat) : { x : nat | x = n } := + match n with + | O => O + | S p => S (id p) + end. +intros ; auto. + +pose (subset_simpl (id p)). +simpl in e. +unfold p0. +rewrite e. +auto. +Defined. + +Check id. +Print id. +Extraction id. + +Axiom le_gt_dec : forall n m, { n <= m } + { n > m }. +Require Import Omega. + +Program Fixpoint id_if (n : nat) { wf n lt }: { x : nat | x = n } := + if le_gt_dec n 0 then 0 + else S (id_if (pred n)). +intros. +auto with arith. +intros. +pose (subset_simpl (id_if (pred n))). +simpl in e. +rewrite e. +induction n ; auto with arith. +Defined. + +Print id_if_instance. +Extraction id_if_instance. + +Notation "( x & y )" := (@existS _ _ x y) : core_scope. + +Program Definition testsig ( a : nat ) : { x : nat & { y : nat | x = y }} := + (a & a). +intros. +auto. +Qed. diff --git a/contrib/subtac/test/rec.v b/contrib/subtac/test/rec.v new file mode 100644 index 00000000..aaefd8cc --- /dev/null +++ b/contrib/subtac/test/rec.v @@ -0,0 +1,65 @@ +Require Import Coq.Arith.Arith. +Require Import Lt. +Require Import Omega. + +Axiom lt_ge_dec : forall x y : nat, { x < y } + { x >= y }. +(*Proof. + intros. + elim (le_lt_dec y x) ; intros ; auto with arith. +Defined. +*) +Require Import Coq.subtac.FixSub. +Require Import Wf_nat. + +Lemma preda_lt_a : forall a, 0 < a -> pred a < a. +auto with arith. +Qed. + +Program Fixpoint id_struct (a : nat) : nat := + match a with + 0 => 0 + | S n => S (id_struct n) + end. + +Check struct_rec. + + if (lt_ge_dec O a) + then S (wfrec (pred a)) + else O. + +Program Fixpoint wfrec (a : nat) { wf a lt } : nat := + if (lt_ge_dec O a) + then S (wfrec (pred a)) + else O. +intros. +apply preda_lt_a ; auto. + +Defined. + +Extraction wfrec. +Extraction Inline proj1_sig. +Extract Inductive bool => "bool" [ "true" "false" ]. +Extract Inductive sumbool => "bool" [ "true" "false" ]. +Extract Inlined Constant lt_ge_dec => "<". + +Extraction wfrec. +Extraction Inline lt_ge_dec le_lt_dec. +Extraction wfrec. + + +Program Fixpoint structrec (a : nat) { wf a lt } : nat := + match a with + S n => S (structrec n) + | 0 => 0 + end. +intros. +unfold n0. +omega. +Defined. + +Print structrec. +Extraction structrec. +Extraction structrec. + +Definition structrec_fun (a : nat) : nat := structrec a (lt_wf a). +Print structrec_fun. diff --git a/contrib/xml/cic2acic.ml b/contrib/xml/cic2acic.ml index bac7ad7c..f217b037 100644 --- a/contrib/xml/cic2acic.ml +++ b/contrib/xml/cic2acic.ml @@ -64,7 +64,7 @@ let get_uri_of_var v pvars = in let rec search_in_open_sections = function - [] -> Util.error "Variable not found" + [] -> Util.error ("Variable "^v^" not found") | he::tl as modules -> let dirpath = N.make_dirpath modules in if List.mem (N.id_of_string v) (D.last_section_hyps dirpath) then @@ -167,10 +167,10 @@ let token_list_of_kernel_name tag = N.id_of_label (N.label kn), Lib.cwd () | Constant con -> N.id_of_label (N.con_label con), - Lib.library_part (LN.ConstRef con) + Lib.remove_section_part (LN.ConstRef con) | Inductive kn -> N.id_of_label (N.label kn), - Lib.library_part (LN.IndRef (kn,0)) + Lib.remove_section_part (LN.IndRef (kn,0)) in token_list_of_path dir id (etag_of_tag tag) ;; diff --git a/contrib/xml/doubleTypeInference.ml b/contrib/xml/doubleTypeInference.ml index 518f6c11..a3336817 100644 --- a/contrib/xml/doubleTypeInference.ml +++ b/contrib/xml/doubleTypeInference.ml @@ -93,7 +93,7 @@ let double_type_of env sigma cstr expectedty subterms_to_types = let jty = execute env sigma ty None in let jty = assumption_of_judgment env sigma jty in let evar_context = - E.named_context_of_val (Evd.map sigma n).Evd.evar_hyps in + E.named_context_of_val (Evd.find sigma n).Evd.evar_hyps in let rec iter actual_args evar_context = match actual_args,evar_context with [],[] -> () diff --git a/contrib/xml/proof2aproof.ml b/contrib/xml/proof2aproof.ml index dff546c9..678b650c 100644 --- a/contrib/xml/proof2aproof.ml +++ b/contrib/xml/proof2aproof.ml @@ -47,7 +47,7 @@ let nf_evar sigma ~preserve = | _ -> T.mkApp (c', l') ) | _ -> T.mkApp (c', l')) - | T.Evar (e,l) when Evd.in_dom sigma e & Evd.is_defined sigma e -> + | T.Evar (e,l) when Evd.mem sigma e & Evd.is_defined sigma e -> aux (Evd.existential_value sigma (e,l)) | T.Evar (e,l) -> T.mkEvar (e, Array.map aux l) | T.Case (ci,p,c,bl) -> T.mkCase (ci, aux p, aux c, Array.map aux bl) diff --git a/contrib/xml/xmlcommand.ml b/contrib/xml/xmlcommand.ml index 871a7f15..2235be4a 100644 --- a/contrib/xml/xmlcommand.ml +++ b/contrib/xml/xmlcommand.ml @@ -395,7 +395,7 @@ let mk_constant_obj id bo ty variables hyps = ty,params) ;; -let mk_inductive_obj sp packs variables nparams hyps finite = +let mk_inductive_obj sp mib packs variables nparams hyps finite = let module D = Declarations in let hyps = string_list_of_named_context_list hyps in let params = filter_params variables hyps in @@ -406,9 +406,9 @@ let mk_inductive_obj sp packs variables nparams hyps finite = (fun p i -> decr tyno ; let {D.mind_consnames=consnames ; - D.mind_typename=typename ; - D.mind_nf_arity=arity} = p + D.mind_typename=typename } = p in + let arity = Inductive.type_of_inductive (mib,p) in let lc = Inductiveops.arities_of_constructors (Global.env ()) (sp,!tyno) in let cons = (Array.fold_right (fun (name,lc) i -> (name,lc)::i) @@ -524,11 +524,12 @@ let print internal glob_ref kind xml_library_root = G.lookup_constant kn in Cic2acic.Constant kn,mk_constant_obj id val0 typ variables hyps | Ln.IndRef (kn,_) -> + let mib = G.lookup_mind kn in let {D.mind_nparams=nparams; D.mind_packets=packs ; D.mind_hyps=hyps; - D.mind_finite=finite} = G.lookup_mind kn in - Cic2acic.Inductive kn,mk_inductive_obj kn packs variables nparams hyps finite + D.mind_finite=finite} = mib in + Cic2acic.Inductive kn,mk_inductive_obj kn mib packs variables nparams hyps finite | Ln.ConstructRef _ -> Util.anomaly ("print: this should not happen") in @@ -1,21 +1,49 @@ -This directory contains informations and tools to help developping the -Coq system +This directory contains informations and tools to help developing the + Coq system + ====================== -TODO -changements.txt -header -lisezmoi.txt -style.txt +Debugging and profiling (in current directory - see doc/debugging.txt) +----------------------- -Debugging and profiling -======================= +ocamldebug-coq: to launch ocaml debugger -debugging.txt: help for debugging or profiling -db: to install pretty-printers from ocaml debugger +db: to install pretty-printers from ocaml debugger base_db: to install raw pretty-printers from ocaml debugger -ocamldebug-v7: to launch ocaml debugger -include: to install pretty-printers from ocaml toplevel + +include: to install pretty-printers from ocaml toplevel base_include: to install raw pretty-printers from ocaml toplevel + +vm_printers.ml, dev_printers.ml: ML pretty-printers for debugging + + +Miscellaneous informations about the code (directory doc) +----------------------------------------- + +changes.txt: (partial) per-version summary of the evolutions of Coq ML source +style.txt: a few style recommendations for writing Coq ML files +debugging.txt: help for debugging or profiling universes.txt: help to debug universes +translate.txt: help to use coq translator +extensions.txt: some help about TACTIC EXTEND + +header: standard header for Coq ML files +perf-analysis: analysis of perfs measured on the compilation of user contribs +cic.dtd: official dtd of the calc. of ind. constr. for im/ex-portation + + +Documentation of ML interfaces using tex (directory ocamlweb-doc) +---------------------------------------- + +go in directory and call "make" + + +Other development tools (directory tools) +----------------------- + univdot: produces a graph of CIC universes +Makefile.dir: makefile dedicated to intensive work in a given directory +Makefile.subdir: makefile dedicated to intensive work in a given subdirectory +Makefile.devel: utilities to automatically launch coq in various states +Makefile.common: used by other Makefiles +objects.el: various development utilities at emacs level diff --git a/dev/base_include b/dev/base_include index 30a6ed96..b7fa38ea 100644 --- a/dev/base_include +++ b/dev/base_include @@ -39,6 +39,108 @@ #install_printer (* bigint *) ppbigint;; #install_printer (* loc *) pploc;; +(* Open main files *) + +open Names +open Term +open Typeops +open Univ +open Inductive +open Indtypes +open Cooking +open Closure +open Reduction +open Safe_typing +open Declare +open Declaremods +open Impargs +open Libnames +open Nametab +open Library + +open Cases +open Pattern +open Cbv +open Classops +open Pretyping +open Cbv +open Classops +open Pretyping +open Clenv +open Rawterm +open Coercion +open Recordops +open Detyping +open Reductionops +open Evarconv +open Retyping +open Evarutil +open Tacred +open Evd +open Termops +open Indrec +open Typing +open Inductiveops +open Unification + +open Constrextern +open Constrintern +open Coqlib +open Genarg +open Modintern +open Notation +open Ppextend +open Reserve +open Syntax_def +open Topconstr + +open Clenvtac +open Evar_refiner +open Logic +open Pfedit +open Proof_trees +open Proof_type +open Redexpr +open Refiner +open Tacmach + +open Auto +open Autorewrite +open Contradiction +open Dhyp +open Eauto +open Elim +open Equality +open Evar_tactics +open Extraargs +open Extratactics +open Hiddentac +open Hipattern +open Inv +open Leminv +open Refine +open Setoid_replace +open Tacinterp +open Tacticals +open Tactics + +open Cerrors +open Class +open Command +open Coqinit +open Coqtop +open Discharge +open Himsg +open Metasyntax +open Mltop +open Record +open Toplevel +open Vernacentries +open Vernacinterp +open Vernac + +(* Various utilities *) + let qid = Libnames.qualid_of_string;; (* parsing of terms *) @@ -28,6 +28,7 @@ install_printer Top_printers.ppgoal install_printer Top_printers.ppsigmagoal install_printer Top_printers.pproof install_printer Top_printers.ppevd +install_printer Top_printers.ppevm install_printer Top_printers.ppclenv install_printer Top_printers.pptac diff --git a/dev/changements.txt b/dev/doc/changes.txt index d1df2a81..f60e3203 100644 --- a/dev/changements.txt +++ b/dev/doc/changes.txt @@ -1,3 +1,49 @@ +========================================= += CHANGES BETWEEN COQ V8.0 AND COQ V8.1 = +========================================= + +A few differences in Coq ML interfaces between Coq V8.0 and V8.1 +================================================================ + +** Functions + +Util: option_app -> option_map +Term: substl_decl -> subst_named_decl +Lib: library_part -> remove_section_part +Printer: prterm -> pr_lconstr +Printer: prterm_env -> pr_lconstr_env +Ppconstr: pr_sort -> pr_rawsort + +** Constructors + +Declarations: mind_consnrealargs -> mind_consnrealdecls +NoRedun -> NoDup + +** Modules + +module Decl_kinds: new interface +module Bigint: new interface +module Tacred spawned module Redexpr +module Symbols -> Notation +module Coqast, Ast, Esyntax, Termast, and all other modules related to old + syntax are removed + +** Internal names + +OBJDEF and OBJDEF1 -> CANONICAL-STRUCTURE + + +========================================= += CHANGES BETWEEN COQ V7.4 AND COQ V8.0 = +========================================= + +See files in dev/syntax-v8 + + +============================================== += MAIN CHANGES BETWEEN COQ V7.3 AND COQ V7.4 = +============================================== + CHANGES DUE TO INTRODUCTION OF MODULES ====================================== @@ -183,8 +229,8 @@ Uses Declaremods to actually communicate with Global and to register objects. -MAIN CHANGES FROM COQ V7.3 -========================== +OTHER CHANGES +============= Internal representation of tactics bindings has changed (see type Rawterm.substitution). @@ -228,8 +274,10 @@ Tactics about False and not now in tactics/contradiction.ml Tactics depending on Init now tactics/*.ml4 (no longer in tactics/*.v) File tacinterp.ml moved from proofs to directory tactics -MAIN CHANGES FROM COQ V7.1 TO COQ V7.2 -====================================== + +========================================== += MAIN CHANGES FROM COQ V7.1 TO COQ V7.2 = +========================================== The core of Coq (kernel) has meen minimized with the following effects: @@ -242,8 +290,9 @@ the prefixes "Is" ans "IsMut" have been dropped from kind_of_term constructors, e.g. IsRel is now Rel, IsMutCase is now Case, etc. -PRINCIPAUX CHANGEMENTS ENTRE COQ V6.3.1 ET COQ V7.0 -=================================================== +======================================================= += PRINCIPAUX CHANGEMENTS ENTRE COQ V6.3.1 ET COQ V7.0 = +======================================================= Changements d'organisation / modules : -------------------------------------- diff --git a/dev/doc/cic.dtd b/dev/doc/cic.dtd new file mode 100644 index 00000000..f2314e22 --- /dev/null +++ b/dev/doc/cic.dtd @@ -0,0 +1,231 @@ +<?xml encoding="ISO-8859-1"?> + +<!-- DTD FOR CIC OBJECTS: --> + +<!-- CIC term declaration --> + +<!ENTITY % term '(LAMBDA|CAST|PROD|REL|SORT|APPLY|VAR|META|IMPLICIT|CONST| + LETIN|MUTIND|MUTCONSTRUCT|MUTCASE|FIX|COFIX|instantiate)'> + +<!-- CIC sorts --> + +<!ENTITY % sort '(Prop|Set|Type)'> + +<!-- CIC sequents --> + +<!ENTITY % sequent '((Decl|Def|Hidden)*,Goal)'> + +<!-- CIC objects: --> + +<!ELEMENT ConstantType %term;> +<!ATTLIST ConstantType + name CDATA #REQUIRED + id ID #REQUIRED> + +<!ELEMENT ConstantBody %term;> +<!ATTLIST ConstantBody + for CDATA #REQUIRED + params CDATA #REQUIRED + id ID #REQUIRED> + +<!ELEMENT CurrentProof (Conjecture*,body)> +<!ATTLIST CurrentProof + of CDATA #REQUIRED + id ID #REQUIRED> + +<!ELEMENT InductiveDefinition (InductiveType+)> +<!ATTLIST InductiveDefinition + noParams NMTOKEN #REQUIRED + params CDATA #REQUIRED + id ID #REQUIRED> + +<!ELEMENT Variable (body?,type)> +<!ATTLIST Variable + name CDATA #REQUIRED + id ID #REQUIRED> + +<!ELEMENT Sequent %sequent;> +<!ATTLIST Sequent + no NMTOKEN #REQUIRED + id ID #REQUIRED> + +<!-- Elements used in CIC objects, which are not terms: --> + +<!ELEMENT InductiveType (arity,Constructor*)> +<!ATTLIST InductiveType + name CDATA #REQUIRED + inductive (true|false) #REQUIRED> + +<!ELEMENT Conjecture %sequent;> +<!ATTLIST Conjecture + no NMTOKEN #REQUIRED + id ID #REQUIRED> + +<!ELEMENT Constructor %term;> +<!ATTLIST Constructor + name CDATA #REQUIRED> + +<!ELEMENT Decl %term;> +<!ATTLIST Decl + name CDATA #IMPLIED + id ID #REQUIRED> + +<!ELEMENT Def %term;> +<!ATTLIST Def + name CDATA #IMPLIED + id ID #REQUIRED> + +<!ELEMENT Hidden EMPTY> +<!ATTLIST Hidden + id ID #REQUIRED> + +<!ELEMENT Goal %term;> + +<!-- CIC terms: --> + +<!ELEMENT LAMBDA (decl*,target)> +<!ATTLIST LAMBDA + sort %sort; #REQUIRED> + +<!ELEMENT LETIN (def*,target)> +<!ATTLIST LETIN + id ID #REQUIRED + sort %sort; #REQUIRED> + +<!ELEMENT PROD (decl*,target)> +<!ATTLIST PROD + type %sort; #REQUIRED> + +<!ELEMENT CAST (term,type)> +<!ATTLIST CAST + id ID #REQUIRED + sort %sort; #REQUIRED> + +<!ELEMENT REL EMPTY> +<!ATTLIST REL + value NMTOKEN #REQUIRED + binder CDATA #REQUIRED + id ID #REQUIRED + idref IDREF #REQUIRED + sort %sort; #REQUIRED> + +<!ELEMENT SORT EMPTY> +<!ATTLIST SORT + value CDATA #REQUIRED + id ID #REQUIRED> + +<!ELEMENT APPLY (%term;)+> +<!ATTLIST APPLY + id ID #REQUIRED + sort %sort; #REQUIRED> + +<!ELEMENT VAR EMPTY> +<!ATTLIST VAR + relUri CDATA #REQUIRED + id ID #REQUIRED + sort %sort; #REQUIRED> + +<!-- The substitutions are ordered by increasing DeBrujin --> +<!-- index. An empty substitution means that that index is --> +<!-- not accessible. --> +<!ELEMENT META (substitution*)> +<!ATTLIST META + no NMTOKEN #REQUIRED + id ID #REQUIRED + sort %sort; #REQUIRED> + +<!ELEMENT IMPLICIT EMPTY> +<!ATTLIST IMPLICIT + id ID #REQUIRED> + +<!ELEMENT CONST EMPTY> +<!ATTLIST CONST + uri CDATA #REQUIRED + id ID #REQUIRED + sort %sort; #REQUIRED> + +<!ELEMENT MUTIND EMPTY> +<!ATTLIST MUTIND + uri CDATA #REQUIRED + noType NMTOKEN #REQUIRED + id ID #REQUIRED> + +<!ELEMENT MUTCONSTRUCT EMPTY> +<!ATTLIST MUTCONSTRUCT + uri CDATA #REQUIRED + noType NMTOKEN #REQUIRED + noConstr NMTOKEN #REQUIRED + id ID #REQUIRED + sort %sort; #REQUIRED> + +<!ELEMENT MUTCASE (patternsType,inductiveTerm,pattern*)> +<!ATTLIST MUTCASE + uriType CDATA #REQUIRED + noType NMTOKEN #REQUIRED + id ID #REQUIRED + sort %sort; #REQUIRED> + +<!ELEMENT FIX (FixFunction+)> +<!ATTLIST FIX + noFun NMTOKEN #REQUIRED + id ID #REQUIRED + sort %sort; #REQUIRED> + +<!ELEMENT COFIX (CofixFunction+)> +<!ATTLIST COFIX + noFun NMTOKEN #REQUIRED + id ID #REQUIRED + sort %sort; #REQUIRED> + +<!-- Elements used in CIC terms: --> + +<!ELEMENT FixFunction (type,body)> +<!ATTLIST FixFunction + name CDATA #REQUIRED + recIndex NMTOKEN #REQUIRED> + +<!ELEMENT CofixFunction (type,body)> +<!ATTLIST CofixFunction + name CDATA #REQUIRED> + +<!ELEMENT substitution ((%term;)?)> + +<!-- Explicit named substitutions: --> + +<!ELEMENT instantiate ((CONST|MUTIND|MUTCONSTRUCT),arg+)> +<!ATTLIST instantiate + id ID #IMPLIED> + +<!-- Sintactic sugar for CIC terms and for CIC objects: --> + +<!ELEMENT arg %term;> +<!ATTLIST arg + relUri CDATA #REQUIRED> + +<!ELEMENT decl %term;> +<!ATTLIST decl + id ID #REQUIRED + type %sort; #REQUIRED + binder CDATA #IMPLIED> + +<!ELEMENT def %term;> +<!ATTLIST def + id ID #REQUIRED + sort %sort; #REQUIRED + binder CDATA #IMPLIED> + +<!ELEMENT target %term;> + +<!ELEMENT term %term;> + +<!ELEMENT type %term;> + +<!ELEMENT arity %term;> + +<!ELEMENT patternsType %term;> + +<!ELEMENT inductiveTerm %term;> + +<!ELEMENT pattern %term;> + +<!ELEMENT body %term;> diff --git a/dev/debugging.txt b/dev/doc/debugging.txt index 4c04c42f..e5c83139 100644 --- a/dev/debugging.txt +++ b/dev/doc/debugging.txt @@ -1,4 +1,3 @@ - Debugging from Coq toplevel using Caml trace mechanism ====================================================== @@ -19,7 +18,6 @@ Debugging from Coq toplevel using Caml trace mechanism Debugging from Caml debugger ============================ - Preferably use ocaml 3.06 (pretty-printing is broken with ocaml 3.07/3.08) Needs tuareg mode in Emacs Coq must be configured with -debug and -local (./configure -debug -local) @@ -44,13 +42,30 @@ Debugging from Caml debugger Vernac.vernac_com at the with clause of the "try ... interp com with ..." block, then go "back" a few steps to find where the failure/error/anomaly has been raised - - If "source db" fails, first recompile top_printers.ml with - "make dev/top_printers.cmo" + - Alternatively, for an error or an anomaly, add breakpoints in the middle + of each of error* functions or anomaly* functions in lib/util.ml + - If "source db" fails, recompile printers.cma with + "make dev/printers.cma" and try again -Profiling -========= +Global gprof-based profiling +============================ Coq must be configured with option -profile 1. Run native Coq which must end normally (use Quit or option -batch) 2. gprof ./coqtop gmon.out + +Per function profiling +====================== + + 1. To profile function foo in file bar.ml, add the following lines, just + after the definition of the function: + + let fookey = Profile.declare_profile "foo";; + let foo a b c = Profile.profile3 fookey foo a b c;; + + where foo is assumed to have three arguments (adapt using + Profile.profile1, Profile. profile2, etc). + + This has the effect to cumulate the time passed in foo under a + line of name "foo" which is displayed at the time coqtop exits. diff --git a/dev/doc/extensions.txt b/dev/doc/extensions.txt new file mode 100644 index 00000000..eb4d2659 --- /dev/null +++ b/dev/doc/extensions.txt @@ -0,0 +1,19 @@ +Comment ajouter une nouvelle entrée primitive pour les TACTIC EXTEND ? +====================================================================== + +Exemple de l'ajout de l'entrée "clause": + +- ajouter un type ClauseArgType dans interp/genarg.ml{,i}, avec les + wit_, rawwit_, et globwit_ correspondants + +- ajouter partout où Genarg.argument_type est filtré le cas traitant de + ce nouveau ClauseArgType + +- utiliser le rawwit_clause pour définir une entrée clause du bon + type et du bon nom dans le module Tactic de pcoq.ml4 + +- il faut aussi exporter la règle hors de g_tactic.ml4. Pour cela, il + faut rejouter clause dans le GLOBAL du GEXTEND + +- seulement après, le nom clause sera accessible dans les TACTIC EXTEND ! + diff --git a/dev/header b/dev/doc/header index 57945e47..57945e47 100644 --- a/dev/header +++ b/dev/doc/header diff --git a/dev/perf-analysis b/dev/doc/perf-analysis index 23259156..23259156 100644 --- a/dev/perf-analysis +++ b/dev/doc/perf-analysis diff --git a/dev/style.txt b/dev/doc/style.txt index 2e597dc4..2e597dc4 100644 --- a/dev/style.txt +++ b/dev/doc/style.txt diff --git a/dev/translate.txt b/dev/doc/translate.txt index 5b372c96..5b372c96 100644 --- a/dev/translate.txt +++ b/dev/doc/translate.txt diff --git a/dev/universes.txt b/dev/doc/universes.txt index 65c1e522..65c1e522 100644 --- a/dev/universes.txt +++ b/dev/doc/universes.txt diff --git a/dev/ocamldebug-coq.template b/dev/ocamldebug-coq.template index 30224216..5c4c4475 100644 --- a/dev/ocamldebug-coq.template +++ b/dev/ocamldebug-coq.template @@ -36,7 +36,7 @@ case $coqdebug in -I $COQTOP/contrib/interface -I $COQTOP/contrib/jprover \ -I $COQTOP/contrib/omega -I $COQTOP/contrib/romega \ -I $COQTOP/contrib/ring -I $COQTOP/contrib/xml \ - -I $COQTOP/contrib/subtac \ + -I $COQTOP/contrib/subtac -I $COQTOP/contrib/funind \ $* $args;; *) exec $OCAMLDEBUG $*;; esac diff --git a/dev/doc/Makefile b/dev/ocamlweb-doc/Makefile index a0bef897..96491017 100644 --- a/dev/doc/Makefile +++ b/dev/ocamlweb-doc/Makefile @@ -1,7 +1,7 @@ # Makefile for doc/ -all:: newparse +all:: newparse coq.ps minicop.ps #newsyntax.dvi minicoq.dvi @@ -10,19 +10,19 @@ OBJS=lex.cmo ast.cmo parse.cmo syntax.cmo newparse: $(OBJS) syntax.mli lex.ml syntax.ml ocamlc -o newparse $(OBJS) -.ml.cmo: +%.cmo: %.ml ocamlc -c $< -.mli.cmi: +%.cmi: %.mli ocamlc -c $< -.mll.ml: +%.ml: %.mll ocamllex $< -.mly.ml: +%.ml: %.mly ocamlyacc -v $< -.mly.mli: +%.mli: %.mly ocamlyacc -v $< clean:: @@ -43,7 +43,14 @@ coq.dvi: coq.tex latex coq coq.tex:: - make -C .. doc/coq.tex + ocamlweb -p "\usepackage{epsfig}" \ + macros.tex intro.tex \ + ../../lib/{doc.tex,*.mli} ../../kernel/{doc.tex,*.mli} ../../library/{doc.tex,*.mli} \ + ../../pretyping/{doc.tex,*.mli} ../../interp/{doc.tex,*.mli} \ + ../../parsing/{doc.tex,*.mli} ../../proofs/{doc.tex,*.mli} \ + ../../tactics/{doc.tex,*.mli} ../../toplevel/{doc.tex,*.mli} \ + -o coq.tex + depend:: kernel.dep.ps library.dep.ps pretyping.dep.ps parsing.dep.ps \ proofs.dep.ps tactics.dep.ps toplevel.dep.ps interp.dep.ps @@ -59,9 +66,10 @@ clean:: .SUFFIXES: .tex .dvi .ps .cmo .cmi .mli .ml .mll .mly -.tex.dvi: +%.dvi: %.tex latex $< && latex $< -.dvi.ps: +%.ps: %.dvi dvips $< -o $@ + diff --git a/dev/doc/ast.ml b/dev/ocamlweb-doc/ast.ml index 2153ef47..2153ef47 100644 --- a/dev/doc/ast.ml +++ b/dev/ocamlweb-doc/ast.ml diff --git a/dev/doc/interp.dep.ps b/dev/ocamlweb-doc/interp.dep.ps index b0554481..b0554481 100644 --- a/dev/doc/interp.dep.ps +++ b/dev/ocamlweb-doc/interp.dep.ps diff --git a/dev/doc/intro.tex b/dev/ocamlweb-doc/intro.tex index 4cec8673..4cec8673 100644 --- a/dev/doc/intro.tex +++ b/dev/ocamlweb-doc/intro.tex diff --git a/dev/doc/kernel.dep.ps b/dev/ocamlweb-doc/kernel.dep.ps index 3c00121e..3c00121e 100644 --- a/dev/doc/kernel.dep.ps +++ b/dev/ocamlweb-doc/kernel.dep.ps diff --git a/dev/doc/lex.mll b/dev/ocamlweb-doc/lex.mll index 617163e7..617163e7 100644 --- a/dev/doc/lex.mll +++ b/dev/ocamlweb-doc/lex.mll diff --git a/dev/doc/library.dep.ps b/dev/ocamlweb-doc/library.dep.ps index 1c68240e..1c68240e 100644 --- a/dev/doc/library.dep.ps +++ b/dev/ocamlweb-doc/library.dep.ps diff --git a/dev/doc/macros.tex b/dev/ocamlweb-doc/macros.tex index 6beacf7b..6beacf7b 100644 --- a/dev/doc/macros.tex +++ b/dev/ocamlweb-doc/macros.tex diff --git a/dev/doc/parse.ml b/dev/ocamlweb-doc/parse.ml index e537b1f2..e537b1f2 100644 --- a/dev/doc/parse.ml +++ b/dev/ocamlweb-doc/parse.ml diff --git a/dev/doc/parsing.dep.ps b/dev/ocamlweb-doc/parsing.dep.ps index 723d8c69..723d8c69 100644 --- a/dev/doc/parsing.dep.ps +++ b/dev/ocamlweb-doc/parsing.dep.ps diff --git a/dev/doc/preamble.tex b/dev/ocamlweb-doc/preamble.tex index 2cd21f02..2cd21f02 100644 --- a/dev/doc/preamble.tex +++ b/dev/ocamlweb-doc/preamble.tex diff --git a/dev/doc/pretyping.dep.ps b/dev/ocamlweb-doc/pretyping.dep.ps index 02d1b8b5..02d1b8b5 100644 --- a/dev/doc/pretyping.dep.ps +++ b/dev/ocamlweb-doc/pretyping.dep.ps diff --git a/dev/doc/proofs.dep.ps b/dev/ocamlweb-doc/proofs.dep.ps index 0e78f422..0e78f422 100644 --- a/dev/doc/proofs.dep.ps +++ b/dev/ocamlweb-doc/proofs.dep.ps diff --git a/dev/doc/syntax.mly b/dev/ocamlweb-doc/syntax.mly index bfc7d5cc..bfc7d5cc 100644 --- a/dev/doc/syntax.mly +++ b/dev/ocamlweb-doc/syntax.mly diff --git a/dev/doc/tactics.dep.ps b/dev/ocamlweb-doc/tactics.dep.ps index f4de22b7..f4de22b7 100644 --- a/dev/doc/tactics.dep.ps +++ b/dev/ocamlweb-doc/tactics.dep.ps diff --git a/dev/doc/toplevel.dep.ps b/dev/ocamlweb-doc/toplevel.dep.ps index e0355aac..e0355aac 100644 --- a/dev/doc/toplevel.dep.ps +++ b/dev/ocamlweb-doc/toplevel.dep.ps diff --git a/dev/Makefile.common b/dev/tools/Makefile.common index 1ff5cf79..1ff5cf79 100644 --- a/dev/Makefile.common +++ b/dev/tools/Makefile.common diff --git a/dev/Makefile.devel b/dev/tools/Makefile.devel index f3abb62d..f3abb62d 100644 --- a/dev/Makefile.devel +++ b/dev/tools/Makefile.devel diff --git a/dev/Makefile.dir b/dev/tools/Makefile.dir index 54f7bfe9..68c917ac 100644 --- a/dev/Makefile.dir +++ b/dev/tools/Makefile.dir @@ -17,7 +17,7 @@ test-dir: @echo TOPDIR=$(TOPDIR) @echo BASEDIR=$(BASEDIR) -include $(TOPDIR)/dev/Makefile.common +include $(TOPDIR)/dev/tools/Makefile.common # make this directory dir: diff --git a/dev/Makefile.subdir b/dev/tools/Makefile.subdir index 45358c42..ff1f3077 100644 --- a/dev/Makefile.subdir +++ b/dev/tools/Makefile.subdir @@ -4,4 +4,4 @@ # in order to have all the facilities of dev/Makefile.dir TOPDIR=../.. -include $(TOPDIR)/dev/Makefile.dir +include $(TOPDIR)/dev/tools/Makefile.dir diff --git a/dev/objects.el b/dev/tools/objects.el index b3a2694d..b3a2694d 100644 --- a/dev/objects.el +++ b/dev/tools/objects.el diff --git a/dev/univdot b/dev/tools/univdot index bb0dd2c8..bb0dd2c8 100755 --- a/dev/univdot +++ b/dev/tools/univdot diff --git a/dev/doc/check-grammar b/dev/v8-syntax/check-grammar index 67da1bc5..67da1bc5 100755 --- a/dev/doc/check-grammar +++ b/dev/v8-syntax/check-grammar diff --git a/dev/doc/memo-v8.tex b/dev/v8-syntax/memo-v8.tex index 8d116de2..8d116de2 100644 --- a/dev/doc/memo-v8.tex +++ b/dev/v8-syntax/memo-v8.tex diff --git a/dev/doc/syntax-v8.tex b/dev/v8-syntax/syntax-v8.tex index 97973df2..97973df2 100644 --- a/dev/doc/syntax-v8.tex +++ b/dev/v8-syntax/syntax-v8.tex diff --git a/doc/Makefile b/doc/Makefile index 07b13039..fd508e07 100644 --- a/doc/Makefile +++ b/doc/Makefile @@ -207,7 +207,7 @@ faq/html/index.html: faq/FAQ.v.html GLOBDUMP=$(COQTOP)/glob.dump -LIBDIRS= Logic Bool Arith ZArith Reals Lists Sets Relations Sorting Wellfounded IntMap FSets +LIBDIRS= Logic Bool Arith ZArith QArith Reals Lists Sets Relations Sorting Wellfounded IntMap FSets ### Standard library (browsable html format) @@ -232,6 +232,7 @@ stdlib/html/index.html: stdlib/index-list.html stdlib/index-body.html stdlib/ind stdlib/Library.coqdoc.tex: (for dir in $(LIBDIRS) ; do \ $(COQDOC) -q --gallina --body-only --latex --stdout \ + --coqlib_path $(COQTOP) \ -R $(COQTOP)/theories Coq "$(COQTOP)/theories/$$dir/"*.v >> $@ ; done) stdlib/Library.dvi: $(COMMON) stdlib/Library.coqdoc.tex stdlib/Library.tex diff --git a/doc/refman/Cases.tex b/doc/refman/Cases.tex index 95411afa..a05231cd 100644 --- a/doc/refman/Cases.tex +++ b/doc/refman/Cases.tex @@ -444,7 +444,7 @@ Inductive LE : nat -> nat -> Prop := \end{coq_example} We can use multiple patterns to write the proof of the lemma - \texttt{(n,m:nat) (LE n m)}\verb=\/=\texttt{(LE m n)}: + \texttt{forall (n m:nat), (LE n m)}\verb=\/=\texttt{(LE m n)}: \begin{coq_example} Fixpoint dec (n m:nat) {struct n} : LE n m \/ LE m n := diff --git a/doc/refman/Program.tex b/doc/refman/Program.tex index ed1e6e63..48ce6bd9 100644 --- a/doc/refman/Program.tex +++ b/doc/refman/Program.tex @@ -1,36 +1,87 @@ \def\Program{\textsc{Program}} -\def\Russel{\textsc{Russel}} +\def\Russell{\textsc{Russell}} +\def\PVS{\textsc{PVS}} -\achapter{The \Program{} tactic} +\achapter{\Program{}} \label{Program} \aauthor{Matthieu Sozeau} \index{Program} \begin{flushleft} - \em The status of \Program is experimental. + \em The status of \Program\ is experimental. \end{flushleft} -We present here the \Coq\ \Program tactic commands, used to build certified -\Coq programs, elaborating them from their algorithmic skeleton and a -rich specification. It can be sought of as a dual of extraction \ref{Extraction}. +We present here the new \Program\ tactic commands, used to build certified +\Coq\ programs, elaborating them from their algorithmic skeleton and a +rich specification. It can be sought of as a dual of extraction +(chapter \ref{Extraction}). The goal of \Program~is to program as in a regular +functional programming language whilst using as rich a specification as +desired and proving that the code meets the specification using the whole \Coq{} proof +apparatus. This is done using a technique originating from the +``Predicate subtyping'' mechanism of \PVS \cite{Rushby98}, which generates type-checking +conditions while typing a term constrained to a particular type. +Here we insert existential variables in the term, which must be filled +with proofs to get a complete \Coq\ term. \Program\ replaces the +\Program\ tactic by Catherine Parent \cite{Parent95b} which had a similar goal but is no longer +maintained. + The languages available as input are currently restricted to \Coq's term language, but may be extended to \ocaml{}, \textsc{Haskell} and others -in the future. Input terms and types are typed in an extended system (\Russel) and +in the future. We use the same syntax as \Coq\ and permit to use implicit +arguments and the existing coercion mechanism. +Input terms and types are typed in an extended system (\Russell) and interpreted into \Coq\ terms. The interpretation process may produce some proof obligations which need to be resolved to create the final term. \asection{Elaborating programs} -\comindex{Program Fixpoint} +The main difference from \Coq\ is that an object in a type $T : \Set$ +can be considered as an object of type $\{ x : T~|~P\}$ for any +wellformed $P : \Prop$. +If we go from $T$ to the subset of $T$ verifying property $P$, we must +prove that the object under consideration verifies it. \Russell\ will +generate an obligation for every such coercion. In the other direction, +\Russell\ will automatically insert a projection. + +Another distinction is the treatment of pattern-matching. Apart from the +following differences, it is equivalent to the standard {\tt match} +operation (section \ref{Caseexpr}). +\begin{itemize} +\item Generation of equalities. A {\tt match} expression is always + generalized by the corresponding equality. As an example, + the expression: + +\begin{coq_example*} + match x with + | 0 => t + | S n => u + end. +\end{coq_example*} +will be first rewrote to: +\begin{coq_example*} + (match x as y return (x = y -> _) with + | 0 => fun H : x = 0 -> t + | S n => fun H : x = S n -> u + end) (refl_equal n). +\end{coq_example*} + + This permits to get the proper equalities in the context of proof + obligations inside clauses, without which reasoning is very limited. + +\item Coercion. If the object being matched is coercible to an inductive + type, the corresponding coercion will be automatically inserted. This also + works with the previous mechanism. +\end{itemize} -The next two commands are similar to they standard counterparts -\ref{Simpl-definitions} and \ref{Fixpoint} in that +The next two commands are similar to their standard counterparts +Definition (section \ref{Simpl-definitions}) and Fixpoint (section \ref{Fixpoint}) in that they define constants. However, they may require the user to prove some -goals to construct the final definitions. +goals to construct the final definitions. {\em Note:} every subtac +definition must end with the {\tt Defined} vernacular. -\section{\tt Program Definition {\ident} := {\term}. +\subsection{\tt Program Definition {\ident} := {\term}. \comindex{Program Definition}\label{ProgramDefinition}} -This command types the value {\term} in \Russel and generate subgoals +This command types the value {\term} in \Russell\ and generate subgoals corresponding to proof obligations. Once solved, it binds the final \Coq\ term to the name {\ident} in the environment. @@ -65,63 +116,36 @@ corresponding to proof obligations. Once solved, it binds the final \SeeAlso Sections \ref{Opaque}, \ref{Transparent}, \ref{unfold} -\section{\tt Program Fixpoint {\ident} {\params} {\tt \{order\}} : type$_0$ := \term$_0$ +\subsection{\tt Program Fixpoint {\ident} {\params} {\tt \{order\}} : type := \term \comindex{Program Fixpoint} \label{ProgramFixpoint}} -This command allows to define objects using a fixed point -construction. The meaning of this declaration is to define {\it ident} -a recursive function with arguments specified by -{\binder$_1$}\ldots{\binder$_n$} such that {\it ident} applied to -arguments corresponding to these binders has type \type$_0$, and is -equivalent to the expression \term$_0$. The type of the {\ident} is -consequently {\tt forall {\params} {\tt,} \type$_0$} -and the value is equivalent to {\tt fun {\params} {\tt =>} \term$_0$}. - -There are two ways to define fixpoints with \Program{}, structural and -well-founded recursion. - -\subsection{\tt Program Fixpoint {\ident} {\params} {\tt \{struct} - \ident$_0$ {\tt \}} : type$_0$ := \term$_0$ - \comindex{Program Fixpoint Struct} - \label{ProgramFixpointStruct}} - -To be accepted, a structural {\tt Fixpoint} definition has to satisfy some -syntactical constraints on a special argument called the decreasing -argument. They are needed to ensure that the {\tt Fixpoint} definition -always terminates. The point of the {\tt \{struct \ident {\tt \}}} -annotation is to let the user tell the system which argument decreases -along the recursive calls. This annotation may be left implicit for -fixpoints with one argument. For instance, one can define the identity -function on naturals as : +The structural fixpoint operator behaves just like the one of Coq +(section \ref{Fixpoint}), except it may also generate obligations. \begin{coq_example} -Program Fixpoint id (n : nat) : { x : nat | x = n } := +Program Fixpoint div2 (n : nat) : { x : nat | n = 2 * x \/ n = 2 * x + 1 } := match n with - | O => O - | S p => S (id p) + | S (S p) => S (div2 p) + | _ => O end. \end{coq_example} -The {\tt match} operator matches a value (here \verb:n:) with the -various constructors of its (inductive) type. The remaining arguments -give the respective values to be returned, as functions of the -parameters of the corresponding constructor. Thus here when \verb:n: -equals \verb:O: we return \verb:0:, and when \verb:n: equals -\verb:(S p): we return \verb:(S (id p)):. - -The {\tt match} operator is formally described -in detail in Section~\ref{Caseexpr}. The system recognizes that in -the inductive call {\tt (id p)} the argument actually -decreases because it is a {\em pattern variable} coming from {\tt match - n with}. - -Here again, proof obligations may be generated. In our example, we would -have one for each branch: +Here we have one obligation for each branch (branches for \verb:0: and \verb:(S 0): are +automatically generated by the pattern-matching compilation algorithm): \begin{coq_example} -Show. + Show. \end{coq_example} +\subsection{\tt Program Lemma {\ident} : type. + \comindex{Program Lemma} + \label{ProgramLemma}} + +The \Russell\ language can also be used to type statements of logical +properties. It will currently fail if the traduction to \Coq\ +generates obligations though it can be useful to insert automatic coercions. + + % \subsection{\tt Program Fixpoint {\ident} {(\ident_$_0$ : \type_$_0$) % \cdots (\ident_$_n$ : \type_$_n$)} {\tt \{wf} % \ident$_i$ \term_{wf} {\tt \}} : type$_t$ := \term$_0$ @@ -483,7 +507,7 @@ Show. % After compilation those two examples run nonetheless, % thanks to the correction of the extraction~\cite{Let02}. -% $Id: Program.tex 8688 2006-04-07 15:08:12Z msozeau $ +% $Id: Program.tex 8890 2006-06-01 21:33:26Z msozeau $ %%% Local Variables: %%% mode: latex diff --git a/doc/refman/RefMan-cic.tex b/doc/refman/RefMan-cic.tex index 18b6ed9c..e288cdfb 100644 --- a/doc/refman/RefMan-cic.tex +++ b/doc/refman/RefMan-cic.tex @@ -223,8 +223,8 @@ either $x:T$ is an assumption in $\Gamma$ or that there exists some $t$ such that $x:=t:T$ is a definition in $\Gamma$. If $\Gamma$ defines some $x:=t:T$, we also write $(x:=t:T)\in\Gamma$. Contexts must be themselves {\em well formed}. For the rest of the chapter, the -notation $\Gamma::(y:T)$ (resp $\Gamma::(y:=t:T)$) denotes the context -$\Gamma$ enriched with the declaration $y:T$ (resp $y:=t:T$). The +notation $\Gamma::(y:T)$ (resp. $\Gamma::(y:=t:T)$) denotes the context +$\Gamma$ enriched with the declaration $y:T$ (resp. $y:=t:T$). The notation $[]$ denotes the empty context. \index{Context} % Does not seem to be used further... @@ -579,46 +579,95 @@ inductively as being an inductive family of type $\Set\ra\Set$: \[\NInd{}{\List:\Set\ra\Set}{\Nil:(A:\Set)(\List~A),\cons : (A:\Set)A \ra (\List~A) \ra (\List~A)}\] There are drawbacks to this point of view. The -information which says that $(\List~\nat)$ is an inductively defined +information which says that for any $A$, $(\List~A)$ is an inductively defined \Set\ has been lost. +So we introduce two important definitions. + +\paragraph{Inductive parameters, real arguments.} +An inductive definition $\NInd{\Gamma}{\Gamma_I}{\Gamma_C}$ admits +$r$ inductive parameters if each type of constructors $(c:C)$ in +$\Gamma_C$ is such that +\[C\equiv \forall +p_1:P_1,\ldots,\forall p_r:P_r,\forall a_1:A_1, \ldots \forall a_n:A_n, +(I~p_1~\ldots p_r~t_1\ldots t_q)\] +with $I$ one of the inductive definitions in $\Gamma_I$. +We say that $n$ is the number of real arguments of the constructor +$c$. +\paragraph{Context of parameters} +If an inductive definition $\NInd{\Gamma}{\Gamma_I}{\Gamma_C}$ admits +$r$ inductive parameters, then there exists a context $\Gamma_P$ of +size $r$, such that $\Gamma_P=p_1:P_1;\ldots;\forall p_r:P_r$ and +if $(t:A)\in\Gamma_I,\Gamma_C$ then $A$ can be written as +$\forall p_1:P_1,\ldots \forall p_r:P_r,A'$. +We call $\Gamma_P$ the context of parameters of the inductive +definition and use the notation $\forall \Gamma_P,A'$ for the term $A$. +\paragraph{Remark.} +If we have a term $t$ in an instance of an +inductive definition $I$ which starts with a constructor $c$, then the +$r$ first arguments of $c$ (the parameters) can be deduced from the +type $T$ of $t$: these are exactly the $r$ first arguments of $I$ in +the head normal form of $T$. +\paragraph{Examples.} +The \List{} definition has $1$ parameter: +\[\NInd{}{\List:\Set\ra\Set}{\Nil:(A:\Set)(\List~A),\cons : (A:\Set)A + \ra (\List~A) \ra (\List~A)}\] +This is also the case for this more complex definition where there is +a recursive argument on a different instance of \List: +\[\NInd{}{\List:\Set\ra\Set}{\Nil:(A:\Set)(\List~A),\cons : (A:\Set)A + \ra (\List~A\ra A) \ra (\List~A)}\] +But the following definition has $0$ parameters: +\[\NInd{}{\List:\Set\ra\Set}{\Nil:(A:\Set)(\List~A),\cons : (A:\Set)A + \ra (\List~A) \ra (\List~A*A)}\] + %\footnote{ -%The interested reader may look at the compare the above definition with the two +%The interested reader may compare the above definition with the two %following ones which have very different logical meaning:\\ %$\NInd{}{\List:\Set}{\Nil:\List,\cons : (A:\Set)A % \ra \List \ra \List}$ \\ %$\NInd{}{\List:\Set\ra\Set}{\Nil:(A:\Set)(\List~A),\cons : (A:\Set)A % \ra (\List~A\ra A) \ra (\List~A)}$.} - -In the system, we keep track in the syntax of the context of -parameters. The idea of these parameters is that they can be -instantiated and still we have an inductive definition for which we -know the specification. +\paragraph{Concrete syntax.} +In the Coq system, the context of parameters is given explicitly +after the name of the inductive definitions and is shared between the +arities and the type of constructors. +% The vernacular declaration of polymorphic trees and forests will be:\\ +% \begin{coq_example*} +% Inductive Tree (A:Set) : Set := +% Node : A -> Forest A -> Tree A +% with Forest (A : Set) : Set := +% Empty : Forest A +% | Cons : Tree A -> Forest A -> Forest A +% \end{coq_example*} +% will correspond in our formalism to: +% \[\NInd{}{{\tt Tree}:\Set\ra\Set;{\tt Forest}:\Set\ra \Set} +% {{\tt Node} : \forall A:\Set, A \ra {\tt Forest}~A \ra {\tt Tree}~A, +% {\tt Empty} : \forall A:\Set, {\tt Forest}~A, +% {\tt Cons} : \forall A:\Set, {\tt Tree}~A \ra {\tt Forest}~A \ra +% {\tt Forest}~A}\] +We keep track in the syntax of the number of +parameters. Formally the representation of an inductive declaration will be -\Ind{\Gamma}{\Gamma_P}{\Gamma_I}{\Gamma_C} for an inductive -definition valid in a context $\Gamma$ with parameters $\Gamma_P$, a +\Ind{\Gamma}{p}{\Gamma_I}{\Gamma_C} for an inductive +definition valid in a context $\Gamma$ with $p$ parameters, a context of definitions $\Gamma_I$ and a context of constructors $\Gamma_C$. -The occurrences of the variables of $\Gamma_P$ in the contexts -$\Gamma_I$ and $\Gamma_C$ are bound. -The definition \Ind{\Gamma}{\Gamma_P}{\Gamma_I}{\Gamma_C} will be -well-formed exactly when \NInd{\Gamma,\Gamma_P}{\Gamma_I}{\Gamma_C} is. -If $\Gamma_P$ is $[p_1:P_1;\ldots;p_r:P_r]$, an object in -\Ind{\Gamma}{\Gamma_P}{\Gamma_I}{\Gamma_C} applied to $q_1,\ldots,q_r$ -will behave as the corresponding object of -\NInd{\Gamma}{\substs{\Gamma_I}{p_i}{q_i}{i=1..r}}{\substs{\Gamma_C}{p_i}{q_i}{i=1..r}}. +The definition \Ind{\Gamma}{p}{\Gamma_I}{\Gamma_C} will be +well-formed exactly when \NInd{\Gamma}{\Gamma_I}{\Gamma_C} is and +when $p$ is (less or equal than) the number of parameters in +\NInd{\Gamma}{\Gamma_I}{\Gamma_C}. \paragraph{Examples} The declaration for parameterized lists is: -\[\Ind{}{A:\Set}{\List:\Set}{\Nil:\List,\cons : A \ra \List \ra - \List}\] +\[\Ind{}{1}{\List:\Set\ra\Set}{\Nil:\forall A:\Set,\List~A,\cons : \forall + A:\Set, A \ra \List~A \ra \List~A}\] The declaration for the length of lists is: -\[\Ind{}{A:\Set}{\Length:(\List~A)\ra \nat\ra\Prop} - {\LNil:(\Length~(\Nil~A)~\nO),\\ - \LCons :\forall a:A, \forall l:(\List~A),\forall n:\nat, (\Length~l~n)\ra (\Length~(\cons~A~a~l)~(\nS~n))}\] +\[\Ind{}{1}{\Length:\forall A:\Set, (\List~A)\ra \nat\ra\Prop} + {\LNil:\forall A:\Set, \Length~A~(\Nil~A)~\nO,\\ + \LCons :\forall A:\Set,\forall a:A, \forall l:(\List~A),\forall n:\nat, (\Length~A~l~n)\ra (\Length~A~(\cons~A~a~l)~(\nS~n))}\] The declaration for a mutual inductive definition of forests and trees is: \[\NInd{}{\tree:\Set,\forest:\Set} @@ -647,14 +696,17 @@ with forest : Set := | emptyf : forest | consf : tree -> forest -> forest. \end{coq_example*} -The inductive declaration in \Coq\ is slightly different from the one -we described theoretically. The difference is that in the type of -constructors the inductive definition is explicitly applied to the -parameters variables. The \Coq\ type-checker verifies that all -parameters are applied in the correct manner in each recursive call. +% The inductive declaration in \Coq\ is slightly different from the one +% we described theoretically. The difference is that in the type of +% constructors the inductive definition is explicitly applied to the +% parameters variables. +The \Coq\ type-checker verifies that all +parameters are applied in the correct manner in the conclusion of the +type of each constructors~: + In particular, the following definition will not be accepted because there is an occurrence of \List\ which is not applied to the parameter -variable: +variable in the conclusion of the type of {\tt cons'}: \begin{coq_eval} Set Printing Depth 50. (********** The following is not correct and should produce **********) @@ -663,25 +715,33 @@ Set Printing Depth 50. \begin{coq_example} Inductive list' (A:Set) : Set := | nil' : list' A - | cons' : A -> list' (A -> A) -> list' A. + | cons' : A -> list' A -> list' (A*A). +\end{coq_example} +Since \Coq{} version 8.1, there is no restriction about parameters in +the types of arguments of constructors. The following definition is +valid: +\begin{coq_example} +Inductive list' (A:Set) : Set := + | nil' : list' A + | cons' : A -> list' (A->A) -> list' A. \end{coq_example} + \subsection{Types of inductive objects} We have to give the type of constants in an environment $E$ which contains an inductive declaration. \begin{description} -\item[Ind-Const] Assuming $\Gamma_P$ is $[p_1:P_1;\ldots;p_r:P_r]$, +\item[Ind-Const] Assuming $\Gamma_I$ is $[I_1:A_1;\ldots;I_k:A_k]$, and $\Gamma_C$ is $[c_1:C_1;\ldots;c_n:C_n]$, -\inference{\frac{\Ind{\Gamma}{\Gamma_P}{\Gamma_I}{\Gamma_C} \in E - ~~j=1\ldots k}{(I_j:\forall~p_1:P_1,\ldots\forall p_r:P_r,A_j) \in E}} +\inference{\frac{\Ind{\Gamma}{p}{\Gamma_I}{\Gamma_C} \in E + ~~j=1\ldots k}{(I_j:A_j) \in E}} -\inference{\frac{\Ind{\Gamma}{\Gamma_P}{\Gamma_I}{\Gamma_C} \in E +\inference{\frac{\Ind{\Gamma}{p}{\Gamma_I}{\Gamma_C} \in E ~~~~i=1.. n} - {(c_i:\forall~p_1:P_1,\ldots \forall p_r:P_r,\subst{C_i}{I_j}{(I_j~p_1\ldots - p_r)}_{j=1\ldots k})\in E}} + {(c_i:C_i)\in E}} \end{description} \paragraph{Example.} @@ -745,10 +805,13 @@ following cases: type $U$ but occurs strictly positively in type $V$ \item $T$ converts to $(I~a_1 \ldots ~a_m ~ t_1 \ldots ~t_p)$ where $I$ is the name of an inductive declaration of the form - $\Ind{\Gamma}{p_1:P_1;\ldots;p_m:P_m}{I:A}{c_1:C_1;\ldots;c_n:C_n}$ + $\Ind{\Gamma}{m}{I:A}{c_1:\forall p_1:P_1,\ldots \forall + p_m:P_m,C_1;\ldots;c_n:\forall p_1:P_1,\ldots \forall + p_m:P_m,C_n}$ (in particular, it is not mutually defined and it has $m$ parameters) and $X$ does not occur in any of the $t_i$, and the - types of constructor $C_i\{p_j/a_j\}_{j=1\ldots m}$ of $I$ satisfy + (instantiated) types of constructor $C_i\{p_j/a_j\}_{j=1\ldots m}$ + of $I$ satisfy the nested positivity condition for $X$ %\item more generally, when $T$ is not a type, $X$ occurs strictly %positively in $T[x:U]u$ if $X$ does not occur in $U$ but occurs @@ -760,15 +823,16 @@ positivity condition} for a constant $X$ in the following cases: \begin{itemize} -\item $T=(I~t_1\ldots ~t_n)$ and $X$ does not occur in -any $t_i$ +\item $T=(I~b_1\ldots b_m~u_1\ldots ~u_{p})$, $I$ is an inductive + definition with $m$ parameters and $X$ does not occur in +any $u_i$ \item $T=\forall~x:U,V$ and $X$ occurs only strictly positively in $U$ and the type $V$ satisfies the nested positivity condition for $X$ \end{itemize} \paragraph{Example} -$X$ occurs strictly positively in $A\ra X$ or $X*A$ or $({\tt list} +$X$ occurs strictly positively in $A\ra X$ or $X*A$ or $({\tt list}~ X)$ but not in $X \ra A$ or $(X \ra A)\ra A$ nor $({\tt neg}~A)$ assuming the notion of product and lists were already defined and {\tt neg} is an inductive definition with declaration \Ind{}{A:\Set}{{\tt @@ -784,17 +848,20 @@ inductive definition. \begin{description} \item[W-Ind] Let $E$ be an environment and $\Gamma,\Gamma_P,\Gamma_I,\Gamma_C$ are contexts such that - $\Gamma_I$ is $[I_1:A_1;\ldots;I_k:A_k]$ and $\Gamma_C$ is - $[c_1:C_1;\ldots;c_n:C_n]$. + $\Gamma_I$ is $[I_1:\forall \Gamma_p,A_1;\ldots;I_k:\forall + \Gamma_P,A_k]$ and $\Gamma_C$ is + $[c_1:\forall \Gamma_p,C_1;\ldots;c_n:\forall \Gamma_p,C_n]$. \inference{ \frac{ (\WTE{\Gamma;\Gamma_P}{A_j}{s'_j})_{j=1\ldots k} - ~~ (\WTE{\Gamma;\Gamma_P;\Gamma_I}{C_i}{s_{p_i}})_{i=1\ldots n} + ~~ (\WTE{\Gamma;\Gamma_I;\Gamma_P}{C_i}{s_{p_i}})_{i=1\ldots n} } - {\WF{E;\Ind{\Gamma}{\Gamma_P}{\Gamma_I}{\Gamma_C}}{\Gamma}}} + {\WF{E;\Ind{\Gamma}{p}{\Gamma_I}{\Gamma_C}}{\Gamma}}} providing the following side conditions hold: \begin{itemize} \item $k>0$, $I_j$, $c_i$ are different names for $j=1\ldots k$ and $i=1\ldots n$, +\item $p$ is the number of parameters of \NInd{\Gamma}{\Gamma_I}{\Gamma_C} + and $\Gamma_P$ is the context of parameters, \item for $j=1\ldots k$ we have $A_j$ is an arity of sort $s_j$ and $I_j \notin \Gamma \cup E$, \item for $i=1\ldots n$ we have $C_i$ is a type of constructor of @@ -809,7 +876,7 @@ constructors which will always be satisfied for the impredicative sort on sort \Set{} and generate constraints between universes for inductive definitions in types. -\paragraph{Examples} +\paragraph{Examples.} It is well known that existential quantifier can be encoded as an inductive definition. The following declaration introduces the second-order existential @@ -862,7 +929,7 @@ ourselves to primitive recursive functions and functionals. For instance, assuming a parameter $A:\Set$ exists in the context, we want to build a function \length\ of type $\ListA\ra \nat$ which -computes the length of the list, so such that $(\length~\Nil) = \nO$ +computes the length of the list, so such that $(\length~(\Nil~A)) = \nO$ and $(\length~(\cons~A~a~l)) = (\nS~(\length~l))$. We want these equalities to be recognized implicitly and taken into account in the conversion rule. @@ -883,7 +950,7 @@ principles. For instance, in order to prove $\forall l:\ListA,(\LengthA~l~(\length~l))$ it is enough to prove: -\noindent $(\LengthA~\Nil~(\length~\Nil))$ and +\noindent $(\LengthA~(\Nil~A)~(\length~(\Nil~A)))$ and \smallskip $\forall a:A, \forall l:\ListA, (\LengthA~l~(\length~l)) \ra @@ -892,7 +959,7 @@ $\forall a:A, \forall l:\ListA, (\LengthA~l~(\length~l)) \ra \noindent which given the conversion equalities satisfied by \length\ is the same as proving: -$(\LengthA~\Nil~\nO)$ and $\forall a:A, \forall l:\ListA, +$(\LengthA~(\Nil~A)~\nO)$ and $\forall a:A, \forall l:\ListA, (\LengthA~l~(\length~l)) \ra (\LengthA~(\cons~A~a~l)~(\nS~(\length~l)))$. @@ -928,35 +995,51 @@ by the $u_1\ldots u_p$ according to the $\iota$-reduction. Actually, for type-checking a \kw{match\ldots with\ldots end} expression we also need to know the predicate $P$ to be proved by case -analysis. \Coq{} can sometimes infer this predicate but sometimes -not. The concrete syntax for describing this predicate uses the -\kw{as\ldots return} construction. -The predicate is made explicit using the syntax~: -\[\kw{match}~m~\kw{as}~ x~ \kw{return}~ (P~ x) ~\kw{with}~ (c_1~x_{11}~...~x_{1p_1}) \Ra f_1 ~|~\ldots~|~ +analysis. In the general case where $I$ is an inductively defined +$n$-ary relation, $P$ is a $n+1$-ary relation: the $n$ first arguments +correspond to the arguments of $I$ (parameters excluded), and the last +one corresponds to object $m$. \Coq{} can sometimes infer this +predicate but sometimes not. The concrete syntax for describing this +predicate uses the \kw{as\ldots in\ldots return} construction. For +instance, let us assume that $I$ is an unary predicate with one +parameter. The predicate is made explicit using the syntax~: +\[\kw{match}~m~\kw{as}~ x~ \kw{in}~ I~\verb!_!~a~ \kw{return}~ (P~ x) + ~\kw{with}~ (c_1~x_{11}~...~x_{1p_1}) \Ra f_1 ~|~\ldots~|~ (c_n~x_{n1}...x_{np_n}) \Ra f_n \kw{end}\] +The \kw{as} part can be omitted if either the result type does not +depend on $m$ (non-dependent elimination) or $m$ is a variable (in +this case, the result type can depend on $m$). The \kw{in} part can be +omitted if the result type does not depend on the arguments of +$I$. Note that the arguments of $I$ corresponding to parameters +\emph{must} be \verb!_!, because the result type is not generalized to +all possible values of the parameters. The expression after \kw{in} +must be seen as an \emph{inductive type pattern}. As a final remark, +expansion of implicit arguments and notations apply to this pattern. + For the purpose of presenting the inference rules, we use a more compact notation~: -\[ \Case{(\lb x \mto P)}{m}{ \lb x_{11}~...~x_{1p_1} \mto f_1 ~|~\ldots~|~ +\[ \Case{(\lb a x \mto P)}{m}{ \lb x_{11}~...~x_{1p_1} \mto f_1 ~|~\ldots~|~ \lb x_{n1}...x_{np_n} \mto f_n}\] -This is the basic idea which is generalized to the case where $I$ is -an inductively defined $n$-ary relation (in which case the property -$P$ to be proved will be a $n+1$-ary relation). - - -\paragraph{Non-dependent elimination.} -When defining a function by case analysis, we build an object of type $I -\ra C$ and the minimality principle on an inductively defined logical -predicate of type $A \ra \Prop$ is often used to prove a property -$\forall x:A,(I~x)\ra (C~x)$. This is a particular case of the dependent -principle that we stated before with a predicate which does not depend -explicitly on the object in the inductive definition. - -For instance, a function testing whether a list is empty -can be -defined as: - -\[\lb~l:\ListA \mto\Case{\bool}{l}{\Nil~ \Ra~\true~ |~ (\cons~a~m)~ \Ra~\false}\] +%% CP 06/06 Obsolete avec la nouvelle syntaxe et incompatible avec la +%% presentation theorique qui suit +% \paragraph{Non-dependent elimination.} +% +% When defining a function of codomain $C$ by case analysis over an +% object in an inductive type $I$, we build an object of type $I +% \ra C$. The minimality principle on an inductively defined logical +% predicate $I$ of type $A \ra \Prop$ is often used to prove a property +% $\forall x:A,(I~x)\ra (C~x)$. These are particular cases of the dependent +% principle that we stated before with a predicate which does not depend +% explicitly on the object in the inductive definition. + +% For instance, a function testing whether a list is empty +% can be +% defined as: +% \[\kw{fun} l:\ListA \Ra \kw{match}~l~\kw{with}~ \Nil \Ra \true~ +% |~(\cons~a~m) \Ra \false \kw{end}\] +% represented by +% \[\lb~l:\ListA \mto\Case{\bool}{l}{\true~ |~ \lb a~m,~\false}\] %\noindent {\bf Remark. } % In the system \Coq\ the expression above, can be @@ -973,9 +1056,9 @@ what can be the type of $P$ with respect to the type of the inductive definitions. We define now a relation \compat{I:A}{B} between an inductive -definition $I$ of type $A$, an arity $B$ which says that an object in -the inductive definition $I$ can be eliminated for proving a property -$P$ of type $B$. +definition $I$ of type $A$ and an arity $B$. This relation states that +an object in the inductive definition $I$ can be eliminated for +proving a property $P$ of type $B$. The case of inductive definitions in sorts \Set\ or \Type{} is simple. There is no restriction on the sort of the predicate to be @@ -995,7 +1078,7 @@ $I$. s_2 \in \Sort}{\compat{I:s_1}{I\ra s_2}}} \end{description} -The case of Inductive Definitions of sort \Prop{} is a bit more +The case of Inductive definitions of sort \Prop{} is a bit more complicated, because of our interpretation of this sort. The only harmless allowed elimination, is the one when predicate $P$ is also of sort \Prop. @@ -1161,10 +1244,10 @@ following typing rule \WTEG{P}{B}~~\compat{(I~q_1\ldots q_r)}{B} ~~ (\WTEG{f_i}{\CI{(c_{p_i}~q_1\ldots q_r)}{P}})_{i=1\ldots l}} -{\WTEG{\Case{P}{c}{f_1\ldots f_l}}{(P\ t_1\ldots t_s\ c)}}}%\\[3mm] +{\WTEG{\Case{P}{c}{f_1|\ldots |f_l}}{(P\ t_1\ldots t_s\ c)}}}%\\[3mm] provided $I$ is an inductive type in a declaration -\Ind{\Delta}{\Gamma_P}{\Gamma_I}{\Gamma_C} with $|\Gamma_P| = r$, +\Ind{\Delta}{r}{\Gamma_I}{\Gamma_C} with $\Gamma_C = [c_1:C_1;\ldots;c_n:C_n]$ and $c_{p_1}\ldots c_{p_l}$ are the only constructors of $I$. \end{description} @@ -1176,7 +1259,7 @@ context being the same in all the judgments). \[\frac{l:\ListA~~P:\ListA\ra s~~~f_1:(P~(\Nil~A))~~ f_2:\forall a:A, \forall l:\ListA, (P~(\cons~A~a~l))} - {\Case{P}{l}{f_1~f_2}:(P~l)}\] + {\Case{P}{l}{f_1~|~f_2}:(P~l)}\] \[\frac{ \begin{array}[b]{@{}c@{}} @@ -1186,21 +1269,21 @@ H:(\LengthA~L~N) \\ P:\forall l:\ListA, \forall n:\nat, (\LengthA~l~n)\ra f_2:\forall a:A, \forall l:\ListA, \forall n:\nat, \forall h:(\LengthA~l~n), (P~(\cons~A~a~n)~(\nS~n)~(\LCons~A~a~l~n~h)) \end{array}} - {\Case{P}{H}{f_1~f_2}:(P~L~N~H)}\] + {\Case{P}{H}{f_1~|~f_2}:(P~L~N~H)}\] \paragraph{Definition of $\iota$-reduction.}\label{iotared} \index{iota-reduction@$\iota$-reduction} We still have to define the $\iota$-reduction in the general case. A $\iota$-redex is a term of the following form: -\[\Case{P}{(c_{p_i}~q_1\ldots q_r~a_1\ldots a_m)}{f_1\ldots +\[\Case{P}{(c_{p_i}~q_1\ldots q_r~a_1\ldots a_m)}{f_1|\ldots | f_l}\] with $c_{p_i}$ the $i$-th constructor of the inductive type $I$ with $r$ parameters. The $\iota$-contraction of this term is $(f_i~a_1\ldots a_m)$ leading to the general reduction rule: -\[ \Case{P}{(c_{p_i}~q_1\ldots q_r~a_1\ldots a_m)}{f_1\ldots +\[ \Case{P}{(c_{p_i}~q_1\ldots q_r~a_1\ldots a_m)}{f_1|\ldots | f_n} \triangleright_{\iota} (f_i~a_1\ldots a_m) \] \subsection{Fixpoint definitions} @@ -1245,13 +1328,13 @@ calls are done on variables coming from patterns and representing subterms. For instance in the case of natural numbers, a proof of the induction principle of type -\[\forall P:\nat\ra\Prop, (P~\nO)\ra((n:\nat)(P~n)\ra(P~(\nS~n)))\ra +\[\forall P:\nat\ra\Prop, (P~\nO)\ra(\forall n:\nat, (P~n)\ra(P~(\nS~n)))\ra \forall n:\nat, (P~n)\] can be represented by the term: \[\begin{array}{l} \lb P:\nat\ra\Prop\mto\lb f:(P~\nO)\mto \lb g:(\forall n:\nat, (P~n)\ra(P~(\nS~n))) \mto\\ -\Fix{h}{h:\forall n:\nat, (P~n):=\lb n:\nat\mto \Case{P}{n}{f~\lb +\Fix{h}{h:\forall n:\nat, (P~n):=\lb n:\nat\mto \Case{P}{n}{f~|~\lb p:\nat\mto (g~p~(h~p))}} \end{array} \] @@ -1280,8 +1363,8 @@ syntactically recognized as structurally smaller than $y_{k_i}$ The definition of being structurally smaller is a bit technical. One needs first to define the notion of {\em recursive arguments of a constructor}\index{Recursive arguments}. -For an inductive definition \Ind{\Gamma}{\Gamma_P}{\Gamma_I}{\Gamma_C}, -the type of a constructor $c$ have the form +For an inductive definition \Ind{\Gamma}{r}{\Gamma_I}{\Gamma_C}, +the type of a constructor $c$ has the form $\forall p_1:P_1,\ldots \forall p_r:P_r, \forall x_1:T_1, \ldots \forall x_r:T_r, (I_j~p_1\ldots p_r~t_1\ldots t_s)$ the recursive arguments will correspond to $T_i$ in @@ -1291,7 +1374,7 @@ which one of the $I_l$ occurs. The main rules for being structurally smaller are the following:\\ Given a variable $y$ of type an inductive definition in a declaration -\Ind{\Gamma}{\Gamma_P}{\Gamma_I}{\Gamma_C} +\Ind{\Gamma}{r}{\Gamma_I}{\Gamma_C} where $\Gamma_I$ is $[I_1:A_1;\ldots;I_k:A_k]$, and $\Gamma_C$ is $[c_1:C_1;\ldots;c_n:C_n]$. The terms structurally smaller than $y$ are: @@ -1303,7 +1386,7 @@ The terms structurally smaller than $y$ are: definition $I_p$ part of the inductive declaration corresponding to $y$. Each $f_i$ corresponds to a type of constructor $C_q \equiv - \forall y_1:B_1, \ldots \forall y_k:B_k, (I~a_1\ldots a_k)$ + \forall p_1:P_1,\ldots,\forall p_r:P_r, \forall y_1:B_1, \ldots \forall y_k:B_k, (I~a_1\ldots a_k)$ and can consequently be written $\lb y_1:B'_1\mto \ldots \lb y_k:B'_k\mto g_i$. ($B'_i$ is obtained from $B_i$ by substituting parameters variables) @@ -1420,7 +1503,7 @@ The implementation contains also coinductive definitions, which are types inhabited by infinite objects. More information on coinductive definitions can be found in~\cite{Gimenez95b,Gim98}. -%They are described inchapter~\ref{Coinductives}. +%They are described in chapter~\ref{Coinductives}. \section{\iCIC : the Calculus of Inductive Construction with impredicative \Set}\label{impredicativity} @@ -1470,7 +1553,7 @@ impredicative system for sort \Set{} become~: -% $Id: RefMan-cic.tex 8609 2006-02-24 13:32:57Z notin,no-port-forwarding,no-agent-forwarding,no-X11-forwarding,no-pty $ +% $Id: RefMan-cic.tex 8914 2006-06-07 14:57:22Z cpaulin $ %%% Local Variables: %%% mode: latex diff --git a/doc/refman/RefMan-gal.tex b/doc/refman/RefMan-gal.tex index ce2b75b8..2214864a 100644 --- a/doc/refman/RefMan-gal.tex +++ b/doc/refman/RefMan-gal.tex @@ -851,7 +851,8 @@ The type {\tt nat} is defined as the least \verb:Set: containing {\tt O} and closed by the {\tt S} constructor. The constants {\tt nat}, {\tt O} and {\tt S} are added to the environment. -Now let us have a look at the elimination principles. They are three : +Now let us have a look at the elimination principles. They are three +of them: {\tt nat\_ind}, {\tt nat\_rec} and {\tt nat\_rect}. The type of {\tt nat\_ind} is: \begin{coq_example} @@ -880,8 +881,9 @@ Reset Initial. Inductive nat : Set := O | S (_:nat). \end{coq_example*} In the case where inductive types have no annotations (next section -gives an example of such annotations), the positivity condition -implies that a constructor can be defined by only giving the type of +gives an example of such annotations), +%the positivity condition implies that +a constructor can be defined by only giving the type of its arguments. \end{Variants} @@ -910,13 +912,13 @@ Check even_ind. \end{coq_example} From a mathematical point of view it asserts that the natural numbers -satisfying the predicate {\tt even} are exactly the naturals satisfying -the clauses {\tt even\_0} or {\tt even\_SS}. This is why, when we want -to prove any predicate {\tt P} over elements of {\tt even}, it is -enough to prove it for {\tt O} and to prove that if any natural number -{\tt n} satisfies {\tt P} its double successor {\tt (S (S n))} -satisfies also {\tt P}. This is indeed analogous to the structural -induction principle we got for {\tt nat}. +satisfying the predicate {\tt even} are exactly in the smallest set of +naturals satisfying the clauses {\tt even\_0} or {\tt even\_SS}. This +is why, when we want to prove any predicate {\tt P} over elements of +{\tt even}, it is enough to prove it for {\tt O} and to prove that if +any natural number {\tt n} satisfies {\tt P} its double successor {\tt + (S (S n))} satisfies also {\tt P}. This is indeed analogous to the +structural induction principle we got for {\tt nat}. \begin{ErrMsgs} \item \errindex{Non strictly positive occurrence of {\ident} in {\type}} @@ -925,11 +927,17 @@ built from {\ident}} \end{ErrMsgs} \subsubsection{Parameterized inductive types} - -Inductive types may be parameterized. Parameters differ from inductive -type annotations in the fact that recursive invokations of inductive -types must always be done with the same values of parameters as its -specification. +In the previous example, each constructor introduces a +different instance of the predicate {\tt even}. In some cases, +all the constructors introduces the same generic instance of the +inductive definition, in which case, instead of an annotation, we use +a context of parameters which are binders shared by all the +constructors of the definition. + +% Inductive types may be parameterized. Parameters differ from inductive +% type annotations in the fact that recursive invokations of inductive +% types must always be done with the same values of parameters as its +% specification. The general scheme is: \begin{center} @@ -937,6 +945,11 @@ The general scheme is: {\ident$_1$}: {\term$_1$} | {\ldots} | {\ident$_n$}: \term$_n$ {\tt .} \end{center} +Parameters differ from inductive type annotations in the fact that the +conclusion of each type of constructor {\term$_i$} invoke the inductive +type with the same values of parameters as its specification. + + A typical example is the definition of polymorphic lists: \begin{coq_example*} @@ -972,7 +985,39 @@ arguments of the constructors rather than their full type. \item \errindex{The {\num}th argument of {\ident} must be {\ident'} in {\type}} \end{ErrMsgs} -\SeeAlso Sections~\ref{Cic-inductive-definitions} and~\ref{elim}. +\paragraph{New from \Coq{} V8.1} The condition on parameters for +inductive definitions has been relaxed since \Coq{} V8.1. It is now +possible in the type of a constructor, to invoke recursively the +inductive definition on an argument which is not the parameter itself. + +One can define~: +\begin{coq_example} +Inductive list2 (A:Set) : Set := + | nil2 : list2 A + | cons2 : A -> list2 (A*A) -> list2 A. +\end{coq_example} +\begin{coq_eval} +Reset list2. +\end{coq_eval} +that can also be written by specifying only the type of the arguments: +\begin{coq_example*} +Inductive list2 (A:Set) : Set := nil2 | cons2 (_:A) (_:list2 (A*A)). +\end{coq_example*} +But the following definition will give an error: +\begin{coq_example} +Inductive listw (A:Set) : Set := + | nilw : listw (A*A) + | consw : A -> listw (A*A) -> listw (A*A). +\end{coq_example} +Because the conclusion of the type of constructors should be {\tt + listw A} in both cases. + +A parameterized inductive definition can be defined using +annotations instead of parameters but it will sometimes give a +different (bigger) sort for the inductive definition and will produce +a less convenient rule for case elimination. + +\SeeAlso Sections~\ref{Cic-inductive-definitions} and~\ref{Tac-induction}. \subsubsection{Mutually defined inductive types @@ -1091,7 +1136,7 @@ definition. The objects of an inductive type are well-founded with respect to the constructors of the type. In other words, such objects contain only a -{\it finite} number constructors. Co-inductive types arise from +{\it finite} number of constructors. Co-inductive types arise from relaxing this condition, and admitting types whose objects contain an infinity of constructors. Infinite objects are introduced by a non-ending (but effective) process of construction, defined in terms @@ -1130,7 +1175,7 @@ CoInductive EqSt : Stream -> Stream -> Prop := \end{coq_example} In order to prove the extensionally equality of two streams $s_1$ and -$s_2$ we have to construct and infinite proof of equality, that is, +$s_2$ we have to construct an infinite proof of equality, that is, an infinite object of type $(\texttt{EqSt}\;s_1\;s_2)$. We will see how to introduce infinite objects in Section~\ref{CoFixpoint}. @@ -1146,8 +1191,9 @@ how to introduce infinite objects in Section~\ref{CoFixpoint}. This command allows to define inductive objects using a fixed point construction. The meaning of this declaration is to define {\it ident} -a recursive function with arguments specified by -{\binder$_1$}\ldots{\binder$_n$} such that {\it ident} applied to +a recursive function with arguments specified by the binders in +\params{} % {\binder$_1$}\ldots{\binder$_n$} +such that {\it ident} applied to arguments corresponding to these binders has type \type$_0$, and is equivalent to the expression \term$_0$. The type of the {\ident} is consequently {\tt forall {\params} {\tt,} \type$_0$} @@ -1277,6 +1323,196 @@ Fixpoint tree_size (t:tree) : nat := A generic command {\tt Scheme} is useful to build automatically various mutual induction principles. It is described in Section~\ref{Scheme}. +\subsubsection{\tt Function {\ident} {\binder$_1$}\ldots{\binder$_n$} + {\tt \{}decrease\_annot{\tt\}} : type$_0$ := \term$_0$. +} +\comindex{Function} +\label{Function} + +This \emph{experimental} command can be seen as a generalization of +{\tt Fixpoint}. It is actually a wrapper for several ways of defining +a function \emph{and other useful related objects}, namely: an +induction principle that reflects the recursive structure of the +function (see \ref{FunInduction}), and its fixpoint equality (not +always, see below). The meaning of this declaration is to define a +function {\it ident}, similarly to {\tt Fixpoint}. Like in {\tt +Fixpoint}, the decreasing argument must be given (unless the function +is not recursive), but it must not necessary be \emph{structurally} +decreasing. The point of the {\tt +\{\}} annotation is to name the decreasing argument \emph{and} to +describe which kind of decreasing criteria must be used to ensure +termination of recursive calls. + +The {\tt Function} construction enjoys also the {\tt with} extension +to define mutually recursive definitions. However, this feature does +not work for non structural recursive functions. % VRAI?? + +See the documentation of {\tt functional induction} (section +\ref{FunInduction}) and {\tt Functional Scheme} (section +\ref{FunScheme} and \ref{FunScheme-examples}) for how to use the +induction principle to easily reason about the function. + +\noindent {\bf Remark: } To obtain the right principle, it is better +to put rigid parameters of the function as first arguments. For +example it is better to define plus like this: + +\begin{coq_example*} +Function plus (m n : nat) {struct n} : nat := + match n with + | 0 => m + | S p => S (plus m p) + end. +\end{coq_example*} +\noindent than like this: +\begin{coq_eval} +Reset plus. +\end{coq_eval} +\begin{coq_example*} +Function plus (n m : nat) {struct n} : nat := + match n with + | 0 => m + | S p => S (plus p m) + end. +\end{coq_example*} + +\paragraph{Limitations} +\label{sec:Function-limitations} +\term$_0$ must be build as a \emph{pure pattern-matching tree} +(\texttt{match...with}) with $\lambda$-abstractions and applications only +\emph{at the end} of each branch. For now dependent cases are not +treated. + +\paragraph{Difference with \texttt{Functional Scheme}} +There is a difference between obtaining an induction scheme for a +function by using \texttt{Function} (section~\ref{Function}) and +by using \texttt{Functional Scheme} after a usual definition using +\texttt{Fixpoint} or \texttt{Definition}. Indeed \texttt{Function} +generally produces smaller principles, closer to the definition +written by the user. This is because \texttt{Functional Scheme} works +by analyzing the term \texttt{div2} after the compilation of pattern +matching into exhaustive expanded ones, whereas \texttt{Function} +analyzes the pseudo-term \emph{before} pattern matching expansion. + + +\ErrMsg + +\errindex{while trying to define Inductive R\_\ident ...} + +The generation of the graph relation \texttt{(R\_\ident)} used to +compute the induction scheme of \ident\ raised a typing error, the +definition of \ident\ was aborted. You can use \texttt{Fixpoint} +instead of \texttt{Function}, but the scheme will not be generated. + +This error happens generally when: + +\begin{itemize} +\item the definition uses pattern matching on dependent types, which + \texttt{Function} cannot deal with yet. +\item the definition is not a \emph{pattern-matching tree} as + explained above. +\end{itemize} + + + +\SeeAlso{\ref{FunScheme},\ref{FunScheme-examples},\ref{FunInduction}} + +Depending on the {\tt \{\}} annotation, different definition +mechanisms are used by {\tt Function}. More precise description +given below. + + + +\subsubsection{\tt Function {\ident} {\binder$_1$}\ldots{\binder$_n$} + : type$_0$ := \term$_0$. +\comindex{Function} +} + +Defines the not recursive function \ident\ as if declared with +\texttt{Definition}. Three elimination schemes {\tt\ident\_rect}, +{\tt\ident\_rec} and {\tt\ident\_ind} are generated (see the +documentation of {\tt Inductive} \ref{Inductive}), which reflect the +pattern matching structure of \term$_0$. + + +\subsubsection{\tt Function {\ident} {\binder$_1$}\ldots{\binder$_n$} + {\tt \{}{\tt struct} \ident$_0${\tt\}} : type$_0$ := \term$_0$. +\comindex{Function} +} + +Defines the structural recursive function \ident\ as if declared with +\texttt{Fixpoint} . Three induction schemes {\tt\ident\_rect}, +{\tt\ident\_rec} and {\tt\ident\_ind} are generated (see the +documentation of {\tt Inductive} \ref{Inductive}), which reflect the +recursive structure of \term$_0$. When there is only one parameter, +{\tt \{struct} \ident$_0${\tt\}} can be omitted. + +\subsubsection{\tt Function {\ident} {\binder$_1$}\ldots{\binder$_n$} + {\tt \{}{\tt measure \term$_1$} \ident$_0${\tt\}} : type$_0$ := \term$_0$. +\comindex{Function}} + +\subsubsection{\tt Function {\ident} {\binder$_1$}\ldots{\binder$_n$} + {\tt \{}{\tt wf \term$_1$} \ident$_0${\tt\}} : type$_0$ := \term$_0$. +\comindex{Function}} + +Defines a recursive function by well founded recursion. \textbf{The +module \texttt{Recdef} of the standard library must be loaded for this +feature}. The {\tt \{\}} annotation is mandatory and must be one of +the following: +\begin{itemize} +\item {\tt \{measure} \term$_1$ \ident$_0${\tt\}} with \ident$_0$ + being the decreasing argument and \term$_1$ being a function + from type of \ident$_0$ to \texttt{nat} for which value on the + decreasing argument decreases (for the {\tt lt} order on {\tt + nat}) at each recursive call of \term$_0$, parameters of the + function are bound in \term$_0$; +\item {\tt \{wf} \term$_1$ \ident$_0${\tt\}} with \ident$_0$ being + the decreasing argument and \term$_1$ an ordering relation on + the type of \ident$_0$ (i.e. of type T$_{\ident_0}$ + $\to$ T$_{\ident_0}$ $\to$ {\tt Prop}) for which + the decreasing argument decreases at each recursive call of + \term$_0$. The order must be well founded. parameters of the + function are bound in \term$_0$. +\end{itemize} + +Depending on the annotation, the user is left with some proof +obligations that will be used to define the function. These proofs +are: proofs that each recursive call is actually decreasing with +respect to the given criteria, and (if the criteria is \texttt{wf}) a +proof that the ordering relation is well founded. + +%Completer sur measure et wf + +The fixpoint equality \texttt{\ident\_equation}, which is not trivial +to prove in this case, is automatically generated and proved, together +with three induction schemes {\tt\ident\_rect}, {\tt\ident\_rec} and +{\tt\ident\_ind} as explained above (see the documentation of {\tt + Inductive} \ref{Inductive}), which reflect the recursive structure +of \term$_0$. + + + +%Complete!! +The way this recursive function is defined is the subject of several +papers by Yves Bertot, Julien Forest, David Pichardie. + +%Exemples ok ici + +\bigskip + +\noindent {\bf Remark: } Proof obligations are presented as several +subgoals belonging to a Lemma {\ident}{\tt\_tcc}. % These subgoals are independent which means that in order to +% abort them you will have to abort each separately. + + + +%The decreasing argument cannot be dependent of another?? + +%Exemples faux ici + + + + + \subsubsection{\tt CoFixpoint {\ident} : \type$_0$ := \term$_0$. \comindex{CoFixpoint} \label{CoFixpoint}} @@ -1448,4 +1684,4 @@ To be able to unfold a proof, you should end the proof by {\tt Defined} % TeX-master: "Reference-Manual" % End: -% $Id: RefMan-gal.tex 8606 2006-02-23 13:58:10Z herbelin $ +% $Id: RefMan-gal.tex 8915 2006-06-07 15:17:13Z courtieu $ diff --git a/doc/refman/RefMan-ltac.tex b/doc/refman/RefMan-ltac.tex index eced8099..de9897c4 100644 --- a/doc/refman/RefMan-ltac.tex +++ b/doc/refman/RefMan-ltac.tex @@ -539,8 +539,8 @@ is applied. \ErrMsg \errindex{No matching clauses for match goal} - No goal pattern can be used and, in particular, there is no {\tt - \_} goal pattern. +No clause succeeds, i.e. all matching patterns, if any, +fail at the application of the right-hand-side. \medskip diff --git a/doc/refman/RefMan-pre.tex b/doc/refman/RefMan-pre.tex index f8a9622c..2f79e5f0 100644 --- a/doc/refman/RefMan-pre.tex +++ b/doc/refman/RefMan-pre.tex @@ -536,8 +536,8 @@ Benjamin Grégoire, Assia Mahboubi and Bruno Barras developed a new more efficient and more general simplification algorithm on rings and semi-rings. -Hugo Herbelin, Pierre Letouzey and Claudio Sacerdoti Coen added new -tactic features. +Hugo Herbelin, Pierre Letouzey, Julien Forest, Julien Narboux and +Claudio Sacerdoti Coen added new tactic features. Hugo Herbelin implemented matching on disjunctive patterns. @@ -547,7 +547,8 @@ connections with the provers {\sc cvcl}, {\sc Simplify} and {\sc zenon}. Hugo Herbelin implemented an experimental protocol for calling external tools from the tactic language. -%Matthieu Sozeau developed an experimental language to reason over subtypes. +Matthieu Sozeau developed \textsc{Russell}, an experimental language +to specify the behavior of programs with subtypes. A mechanism to automatically use some specific tactic to solve unresolved implicit has been implemented by Hugo Herbelin. @@ -556,13 +557,15 @@ Laurent Théry's contribution on strings and Pierre Letouzey and Jean-Christophe Filliâtre's contribution on finite maps have been integrated to the {\Coq} standard library. Pierre Letouzey developed a library about finite sets ``à la Objective Caml'' and extended the -lists library. +lists library. Pierre Letouzey's contribution on rational numbers +has been integrated too. Pierre Corbineau extended his tactic for solving first-order statements. He wrote a reflexion-based intuitionistic tautology solver. -Jean-Marc Notin took care of the general maintenance of the system. +Jean-Marc Notin took care of {\textsf{coqdoc}} and of the general +maintenance of the system. \begin{flushright} Palaiseau, Apr. 2006\\ @@ -574,7 +577,7 @@ Hugo Herbelin % Integration of ZArith lemmas from Sophia and Nijmegen. -% $Id: RefMan-pre.tex 8707 2006-04-13 18:23:35Z herbelin $ +% $Id: RefMan-pre.tex 8941 2006-06-09 16:43:42Z herbelin $ %%% Local Variables: %%% mode: latex diff --git a/doc/refman/RefMan-tac.tex b/doc/refman/RefMan-tac.tex index 72df6005..f034df41 100644 --- a/doc/refman/RefMan-tac.tex +++ b/doc/refman/RefMan-tac.tex @@ -1015,7 +1015,7 @@ equivalent to {\tt intros; apply ci}. \end{Variants} \section{Eliminations (Induction and Case Analysis)} - +\label{Tac-induction} Elimination tactics are useful to prove statements by induction or case analysis. Indeed, they make use of the elimination (or induction) principles generated with inductive definitions (see @@ -1387,42 +1387,83 @@ Qed. \end{Variants} -\subsection{\tt functional induction \ident\ \term$_1$ \dots\ \term$_n$. +\subsection{\tt functional induction (\ident\ \term$_1$ \dots\ \term$_n$). \tacindex{functional induction} \label{FunInduction}} -The \emph{experimental} tactic \texttt{functional induction} -performs case analysis and induction following the definition of -a (not mutually recursive) function. +The \emph{experimental} tactic \texttt{functional induction} performs +case analysis and induction following the definition of a function. It +makes use of a principle generated by \texttt{Function} +(section~\ref{Function}) or \texttt{Functional Scheme} +(section~\ref{FunScheme}). This principle is named \ident\_ind by +default but you can give it explicitly, see variants below. \begin{coq_eval} Reset Initial. \end{coq_eval} \begin{coq_example} +Functional Scheme minus_ind := Induction for minus Sort Prop. + Lemma le_minus : forall n m:nat, (n - m <= n). intros n m. -functional induction minus n m; simpl; auto. +functional induction (minus n m); simpl; auto. \end{coq_example} \begin{coq_example*} Qed. \end{coq_example*} -\texttt{functional induction} is a shorthand for the more general -command \texttt{Functional Scheme} which builds induction -principles following the recursive structure of (possibly -mutually recursive) -functions. \SeeAlso{\ref{FunScheme-examples}} for the difference -between using one or the other. +\Rem \texttt{(\ident\ \term$_1$ \dots\ \term$_n$)} must be a correct +full application of \ident. In particular, the rules for implicit +arguments are the same as usual. For example use \texttt{@\ident} if +you want to write implicit arguments explicitly. + +\Rem Parenthesis over \ident \dots \term$_n$ are not mandatory, but if +there are not written then implicit arguments must be given. + +\Rem \texttt{functional induction (f x1 x2 x3)} is actually a +shorthand for \texttt{induction x1 x2 x3 (f x1 x2 x3) using f\_ind}. +\texttt{f\_ind} being an induction scheme computed by the +\texttt{Function} (section~\ref{Function}) or \texttt{Functional + Scheme} (section~\ref{FunScheme}) command . Therefore +\texttt{functional induction} may fail if the induction scheme +(\texttt{f\_ind}) is not defined. See also section~\ref{Function} for +the function terms accepted by \texttt{Function}. + +\Rem There is a difference between obtaining an induction scheme for a +function by using \texttt{Function} (section~\ref{Function}) and by +using \texttt{Functional Scheme} after a normal definition using +\texttt{Fixpoint} or \texttt{Definition}. See \ref{Function} for +details. + +\SeeAlso{\ref{Function},\ref{FunScheme},\ref{FunScheme-examples}} + +\ErrMsg + +\errindex{The reference \ident\_ind was not found in the current +environment} + +~ -\Rem \texttt{functional induction} may fail on functions built by -tactics. In particular case analysis of a function are considered -only if they are not inside an application. +\errindex{Not the right number of induction arguments} + + +\begin{Variants} +\item {\tt functional induction (\ident\ \term$_1$ \dots\ \term$_n$) + using \term$_{m+1}$ with {\term$_{n+1}$} \dots {\term$_m$}} -\Rem Arguments of the function must be given, including the -implicit ones. If the function is recursive, arguments must be -variables, otherwise they may be any term. + Similar to \texttt{Induction} and \texttt{elim} + (section~\ref{Tac-induction}), allows to give explicitly the + induction principle and the values of dependent premises of the + elimination scheme, including \emph{predicates} for mutual induction + when \ident is mutually recursive. -\SeeAlso{\ref{FunScheme},\ref{FunScheme-examples}} +\item {\tt functional induction (\ident\ \term$_1$ \dots\ \term$_n$) + using \term$_{m+1}$ with {\vref$_1$} := {\term$_{n+1}$} \dots\ + {\vref$_m$} := {\term$_n$}} + + Similar to \texttt{induction} and \texttt{elim} + (section~\ref{Tac-induction}). +\end{Variants} \section{Equality} @@ -2067,6 +2108,17 @@ datatype: see~\ref{quote-examples} for the full details. % En attente d'un moyen de valoriser les fichiers de demos % \SeeAlso file \texttt{theories/DEMOS/DemoQuote.v} in the distribution +\section{Classical tactics} +\label{ClassicalTactics} + +In order to ease the proving process, when the {\tt Classical} module is loaded. A few more tactics are available. Make sure to load the module using the \texttt{Require Import} command. + +\subsection{{\tt classical\_left, classical\_right} \tacindex{classical\_left} \tacindex{classical\_right}} + +The tactics \texttt{classical\_left} and \texttt{classical\_right} are the analog of the \texttt{left} and \texttt{right} but using classical logic. They can only be used for disjunctions. +Use \texttt{classical\_left} to prove the left part of the disjunction with the assumption that the negation of right part holds. +Use \texttt{classical\_left} to prove the right part of the disjunction with the assumption that the negation of left part holds. + \section{Automatizing \label{Automatizing}} @@ -3087,7 +3139,7 @@ The chapter~\ref{TacticLanguage} gives examples of more complex user-defined tactics. -% $Id: RefMan-tac.tex 8606 2006-02-23 13:58:10Z herbelin $ +% $Id: RefMan-tac.tex 8938 2006-06-09 16:29:01Z jnarboux $ %%% Local Variables: %%% mode: latex diff --git a/doc/refman/RefMan-tacex.tex b/doc/refman/RefMan-tacex.tex index ecd54f44..57155d21 100644 --- a/doc/refman/RefMan-tacex.tex +++ b/doc/refman/RefMan-tacex.tex @@ -289,10 +289,8 @@ Require Import Arith. Fixpoint div2 (n:nat) : nat := match n with | O => 0 - | S n0 => match n0 with - | O => 0 - | S n' => S (div2 n') - end + | S O => 0 + | S (S n') => S (div2 n') end. \end{coq_example*} @@ -300,7 +298,7 @@ The definition of a principle of induction corresponding to the recursive structure of \texttt{div2} is defined by the command: \begin{coq_example} -Functional Scheme div2_ind := Induction for div2. +Functional Scheme div2_ind := Induction for div2 Sort Prop. \end{coq_example} You may now look at the type of {\tt div2\_ind}: @@ -315,7 +313,7 @@ We can now prove the following lemma using this principle: \begin{coq_example*} Lemma div2_le' : forall n:nat, div2 n <= n. intro n. - pattern n. + pattern n , (div2 n). \end{coq_example*} @@ -330,18 +328,17 @@ simpl; auto with arith. Qed. \end{coq_example*} -Since \texttt{div2} is not mutually recursive, we can use -directly the \texttt{functional induction} tactic instead of -building the principle: +We can use directly the \texttt{functional induction} +(\ref{FunInduction}) tactic instead of the pattern/apply trick: \begin{coq_example*} -Reset div2_ind. +Reset div2_le'. Lemma div2_le : forall n:nat, div2 n <= n. intro n. \end{coq_example*} \begin{coq_example} -functional induction div2 n. +functional induction (div2 n). \end{coq_example} \begin{coq_example*} @@ -351,14 +348,11 @@ auto with arith. Qed. \end{coq_example*} -\paragraph{remark:} \texttt{functional induction} makes no use of -an induction principle, so be warned that each time it is -applied, a term mimicking the structure of \texttt{div2} (roughly -the size of {\tt div2\_ind}) is built. Using \texttt{Functional - Scheme} is generally faster and less memory consuming. On the -other hand \texttt{functional induction} performs some extra -simplifications that \texttt{Functional Scheme} does not, and as -it is a tactic it can be used in tactic definitions. +\Rem There is a difference between obtaining an induction scheme for a +function by using \texttt{Function} (section~\ref{Function}) and by +using \texttt{Functional Scheme} after a normal definition using +\texttt{Fixpoint} or \texttt{Definition}. See \ref{Function} for +details. \example{Induction scheme for \texttt{tree\_size}} @@ -398,14 +392,14 @@ recursive structure of \texttt{tree\_size} is defined by the command: \begin{coq_example*} -Functional Scheme treeInd := Induction for tree_size - with tree_size forest_size. +Functional Scheme tree_size_ind := Induction for tree_size Sort Prop +with forest_size_ind := Induction for forest_size Sort Prop. \end{coq_example*} -You may now look at the type of {\tt treeInd}: +You may now look at the type of {\tt tree\_size\_ind}: \begin{coq_example} -Check treeInd. +Check tree_size_ind. \end{coq_example} @@ -706,7 +700,7 @@ theorem \texttt{simplify\_ok: (f:formula)(interp\_f (simplify f)) -> \end{verbatim} But there is a problem with leafs: in the example above one cannot write a function that implements, for example, the logical simplifications -$A \wedge A \ra A$ or $A \wedge \neg A \ra \texttt{False}$. This is +$A \land A \ra A$ or $A \land \lnot A \ra \texttt{False}$. This is because the \Prop{} is impredicative. It is better to use that type of formulas: @@ -724,7 +718,7 @@ Inductive formula : Set := \end{coq_example*} \texttt{index} is defined in module \texttt{quote}. Equality on that -type is decidable so we are able to simplify $A \wedge A$ into $A$ at +type is decidable so we are able to simplify $A \land A$ into $A$ at the abstract level. When there are variables, there are bindings, and \texttt{quote} diff --git a/doc/refman/Setoid.tex b/doc/refman/Setoid.tex index 867d6036..10cd5b3e 100644 --- a/doc/refman/Setoid.tex +++ b/doc/refman/Setoid.tex @@ -1,156 +1,555 @@ -\achapter{\protect{The \texttt{setoid$\_$replace} tactic}} -\aauthor{Cl\'ement Renard} +\newtheorem{cscexample}{Example} + +\achapter{\protect{User defined equalities and relations}} +\aauthor{Claudio Sacerdoti Coen\footnote{Based on previous work by +Cl\'ement Renard}} \label{setoid_replace} \tacindex{setoid\_replace} -This chapter presents the \texttt{setoid\_replace} tactic. - -\asection{Description of \texttt{setoid$\_$replace}} - -Working on user-defined structures in \Coq\ is not very easy if -Leibniz equality does not denote the intended equality. For example -using lists to denote finite sets drive to difficulties since two -non convertible terms can denote the same set. - -We present here a \Coq\ module, {\tt setoid\_replace}, which allows to -structure and automate some parts of the work. In particular, if -everything has been registered a simple -tactic can do replacement just as if the two terms were equal. - -\asection{Adding new setoid or morphisms} - -Under the toplevel -load the \texttt{setoid\_replace} files with the command: - -\begin{coq_example*} - Require Setoid. -\end{coq_example*} +This chapter presents the extension of several equality related tactics to +work over user-defined structures (called setoids) that are equipped with +ad-hoc equivalence relations meant to behave as equalities. +Actually, the tactics have also been generalized to relations weaker then +equivalences (e.g. rewriting systems). + +The work generalizes, and is partially based on, a previous implementation of +the \texttt{setoid\_replace} tactic by Cl\'ement Renard. + +\asection{Relations and morphisms} + +A parametric \emph{relation} \texttt{R} is any term of type +\texttt{forall ($x_1$:$T_1$) \ldots ($x_n$:$T_n$), relation $A$}. The +expression $A$, which depends on $x_1$ \ldots $x_n$, is called the +\emph{carrier} of the relation and \texttt{R} is +said to be a relation over \texttt{A}; the list $x_1,\ldots,x_n$ +is the (possibly empty) list of parameters of the relation. + +\firstexample +\begin{cscexample}[Parametric relation] +It is possible to implement finite sets of elements of type \texttt{A} +as unordered list of elements of type \texttt{A}. The function +\texttt{set\_eq: forall (A: Type), relation (list A)} satisfied by two lists +with the same elements is a parametric relation over \texttt{(list A)} with +one parameter \texttt{A}. The type of \texttt{set\_eq} is convertible with +\texttt{forall (A: Type), list A -> list A -> Prop}. +\end{cscexample} + +An \emph{instance} of a parametric relation \texttt{R} with $n$ parameters +is any term \texttt{(R $t_1$ \ldots $t_n$)}. + +Let \texttt{R} be a relation over \texttt{A} with $n$ parameters. +A term is a parametric proof of reflexivity for \texttt{R} if it has type +\texttt{forall ($x_1$:$T_1$) \ldots ($x_n$:$T_n$), + reflexive (R $x_1$ \ldots $x_n$)}. Similar definitions are given for +parametric proofs of symmetry and transitivity. + +\begin{cscexample}[Parametric relation (cont.)] +The \texttt{set\_eq} relation of the previous example can be proved to be +reflexive, symmetric and transitive. +\end{cscexample} + +A parametric unary function $f$ of type +\texttt{forall ($x_1$:$T_1$) \ldots ($x_n$:$T_n$), $A_1$ -> $A_2$} +covariantly respects two parametric relation instances $R_1$ and $R_2$ if, +whenever $m, n$ satisfy $R_1~x~y$, their images $(f~x)$ and $(f~y)$ +satisfy $R_2~(f~x)~(f~y)$ . An $f$ that respects its input and output relations +will be called a unary covariant \emph{morphism}. We can also say that $f$ is +a monotone function with respect to $R_1$ and $R_2$. The sequence $x_1,\ldots x_n$ represents the parameters of the morphism. + +Let $R_1$ and $R_2$ be two parametric relations. +The \emph{signature} of a parametric morphism of type +\texttt{forall ($x_1$:$T_1$) \ldots ($x_n$:$T_n$), $A_1$ -> $A_2$} that +covariantly respects two parametric relations that are instances of +$R_1$ and $R_2$ is written $R_1 \texttt{++>} R_2$. +Notice that the special arrow \texttt{++>}, which reminds the reader +of covariance, is placed between the two parametric relations, not +between the two carriers or the two relation instances. + +The previous definitions are extended straightforwardly to $n$-ary morphisms, +that are required to be simultaneously monotone on every argument. + +Morphisms can also be contravariant in one or more of their arguments. +A morphism is contravariant on an argument associated to the relation instance +$R$ if it is covariant on the same argument when the inverse relation +$R^{-1}$ is considered. The special arrow \texttt{-{}->} is used in signatures +for contravariant morphisms. + +Functions having arguments related by symmetric relations instances are both +covariant and contravariant in those arguments. The special arrow +\texttt{==>} is used in signatures for morphisms that are both covariant +and contravariant. + +An instance of a parametric morphism $f$ with $n$ parameters is any term +\texttt{f $t_1$ \ldots $t_n$}. + +\begin{cscexample}[Morphisms] +Continuing the previous example, let +\texttt{union: forall (A: Type), list A -> list A -> list A} perform the union +of two sets by appending one list to the other. \texttt{union} is a binary +morphism parametric over \texttt{A} that respects the relation instance +\texttt{(set\_eq A)}. The latter condition is proved by showing +\texttt{forall (A: Type) (S1 S1' S2 S2': list A), set\_eq A S1 S1' -> + set\_eq A S2 S2' -> set\_eq A (union A S1 S2) (union A S1' S2')}. + +The signature of the function \texttt{union} is +\texttt{set\_eq ==> set\_eq ==> set\_eq}. +\end{cscexample} + +\begin{cscexample}[Contravariant morphism] +The division function \texttt{Rdiv: R -> R -> R} is a morphism of +signature \texttt{le ++> le -{}-> le} where \texttt{le} is +the usual order relation over real numbers. Notice that division is +covariant in its first argument and contravariant in its second +argument. +\end{cscexample} + +Notice that Leibniz equality is a relation and that every function is a +morphism that respects Leibniz equality. Unfortunately, Leibniz equality +is not always the intended equality for a given structure. + +In the next section we will describe the commands to register terms as +parametric relations and morphisms. Several tactics that deal with equality +in \Coq\ can also work with the registered relations. +The exact list of tactic will be given in Sect.~\ref{setoidtactics}. +For instance, the +tactic \texttt{reflexivity} can be used to close a goal $R~n~n$ whenever +$R$ is an instance of a registered reflexive relation. However, the tactics +that replace in a context $C[]$ one term with another one related by $R$ +must verify that $C[]$ is a morphism that respects the intended relation. +Currently the verification consists in checking whether $C[]$ is a syntactic +composition of morphism instances that respects some obvious +compatibility constraints. + +\begin{cscexample}[Rewriting] +Continuing the previous examples, suppose that the user must prove +\texttt{set\_eq int (union int (union int S1 S2) S2) (f S1 S2)} under the +hypothesis \texttt{H: set\_eq int S2 (nil int)}. It is possible to +use the \texttt{rewrite} tactic to replace the first two occurrences of +\texttt{S2} with \texttt{nil int} in the goal since the context +\texttt{set\_eq int (union int (union int S1 nil) nil) (f S1 S2)}, being +a composition of morphisms instances, is a morphism. However the tactic +will fail replacing the third occurrence of \texttt{S2} unless \texttt{f} +has also been declared as a morphism. +\end{cscexample} + +\asection{Adding new relations and morphisms} +A parametric relation +\textit{Aeq}\texttt{: forall ($x_1$:$T_1$) \ldots ($x_n$:$T_n$), + relation (A $x_1$ \ldots $x_n$)} over \textit{(A $x_1$ \ldots $x_n$)} +can be declared with the following command + +\comindex{Add Relation} +\begin{verse} + \texttt{Add Relation} \textit{A Aeq}\\ + ~\zeroone{\texttt{reflexivity proved by} \textit{refl}}\\ + ~\zeroone{\texttt{symmetry proved by} \textit{sym}}\\ + ~\zeroone{\texttt{transitivity proved by} \textit{trans}}\\ + \texttt{~as} \textit{id}. +\end{verse} +after having required the \texttt{Setoid} module with the +\texttt{Require Setoid} command. + +The identifier \textit{id} gives a unique name to the morphism and it is +used by the command to generate fresh names for automatically provided lemmas +used internally. + +Notice that \textit{A} is required to be a term having the same parameters +of \textit{Aeq}. This is a limitation of the tactic that is often unproblematic +in practice. + +The proofs of reflexivity, symmetry and transitivity can be omitted if the +relation is not an equivalence relation. + +If \textit{Aeq} is a transitive relation, then the command also generates +a lemma of type: +\begin{quote} +\texttt{forall ($x_1$:$T_1$)\ldots($x_n$:$T_n$) + (x y x' y': (A $x_1$ \ldots $x_n$))\\ + Aeq $x_1$ \ldots $x_n$ x' x -> Aeq $x_1$ \ldots $x_n$ y y' ->\\ + (Aeq $x_1$ \ldots $x_n$ x y -> Aeq $x_1$ \ldots $x_n$ x' y')} +\end{quote} +that is used to declare \textit{Aeq} as a parametric morphism of signature +\texttt{Aeq -{}-> Aeq ++> impl} where \texttt{impl} is logical implication +seen as a parametric relation over \texttt{Aeq}. + +Some tactics +(\texttt{reflexivity}, \texttt{symmetry}, \texttt{transitivity}) work only +on relations that respect the expected properties. The remaining tactics +(\texttt{replace}, \texttt{rewrite} and derived tactics such as +\texttt{autorewrite}) do not require any properties over the relation. +However, they are able to replace terms with related ones only in contexts +that are syntactic compositions of parametric morphism instances declared with +the following command. -A setoid is just a type \verb+A+ and an equivalence relation on \verb+A+. +\comindex{Add Morphism} +\begin{verse} + \texttt{Add Morphism} \textit{f}\\ + \texttt{~with signature} \textit{sig}\\ + \texttt{~as id}.\\ + \texttt{Proof}\\ + ~\ldots\\ + \texttt{Qed} +\end{verse} + +The command declares \textit{f} as a parametric morphism of signature +\textit{sig}. The identifier \textit{id} gives a unique name to the morphism +and it is used by the command to generate fresh names for automatically +provided lemmas used internally. The number of parameters for \textit{f} +is inferred by comparing its type with the provided signature. +The command asks the user to prove interactively that \textit{f} respects +the relations identified from the signature. + +\begin{cscexample} +We start the example by assuming a small theory over homogeneous sets and +we declare set equality as a parametric equivalence relation and +union of two sets as a parametric morphism. +\begin{verbatim} +Require Export Relation_Definitions. +Require Export Setoid. +Set Implicit Arguments. +Set Contextual Implicit. +Parameter set: Type -> Type. +Parameter empty: forall A, set A. +Parameter eq_set: forall A, set A -> set A -> Prop. +Parameter union: forall A, set A -> set A -> set A. +Axiom eq_set_refl: forall A, reflexive _ (eq_set (A:=A)). +Axiom eq_set_sym: forall A, symmetric _ (eq_set (A:=A)). +Axiom eq_set_trans: forall A, transitive _ (eq_set (A:=A)). +Axiom empty_neutral: forall A (S: set A), eq_set (union S empty) S. +Axiom union_compat: + forall (A : Type), + forall x x' : set A, eq_set x x' -> + forall y y' : set A, eq_set y y' -> + eq_set (union x y) (union x' y'). + +Add Relation set eq_set + reflexivity proved by (@eq_set_refl) + symmetry proved by (@eq_set_sym) + transitivity proved by (@eq_set_trans) + as eq_set_rel. + +Add Morphism union + with signature eq_set ==> eq_set ==> eq_set + as union_mor. +Proof. + exact union_compat. +Qed. +\end{verbatim} -The specification of a setoid can be found in the file +We proceed now by proving a simple lemma performing a rewrite step +and then applying reflexivity, as we would do working with Leibniz +equality. Both tactic applications are accepted +since the required properties over \texttt{eq\_set} and +\texttt{union} can be established from the two declarations above. -\begin{quotation} \begin{verbatim} -theories/Setoids/Setoid.v +Goal forall (S: set nat), + eq_set (union (union S empty) S) (union S S). +Proof. + intros. + rewrite (@empty_neutral). + reflexivity. +Qed. \end{verbatim} -\end{quotation} - -It looks like : -\begin{small} -\begin{flushleft} +\end{cscexample} + +The tables of relations and morphisms are compatible with the \Coq\ +sectioning mechanism. If you declare a relation or a morphism inside a section, +the declaration will be thrown away when closing the section. +And when you load a compiled file, all the declarations +of this file that were not inside a section will be loaded. + +\asection{Rewriting and non reflexive relations} +To replace only one argument of an n-ary morphism it is necessary to prove +that all the other arguments are related to themselves by the respective +relation instances. + +\begin{cscexample} +To replace \texttt{(union S empty)} with \texttt{S} in +\texttt{(union (union S empty) S) (union S S)} the rewrite tactic must +exploit the monotony of \texttt{union} (axiom \texttt{union\_compat} in +the previous example). Applying \texttt{union\_compat} by hand we are left +with the goal \texttt{eq\_set (union S S) (union S S)}. +\end{cscexample} + +When the relations associated to some arguments are not reflexive, the tactic +cannot automatically prove the reflexivity goals, that are left to the user. + +Setoids whose relation are partial equivalence relations (PER) +are useful to deal with partial functions. Let \texttt{R} be a PER. We say +that an element \texttt{x} is defined if \texttt{R x x}. A partial function +whose domain comprises all the defined elements only is declared as a +morphism that respects \texttt{R}. Every time a rewriting step is performed +the user must prove that the argument of the morphism is defined. + +\begin{cscexample} +Let \texttt{eqO} be \texttt{fun x y => x = y $\land$ ~x$\neq$ 0} (the smaller PER over +non zero elements). Division can be declared as a morphism of signature +\texttt{eq ==> eq0 ==> eq}. Replace \texttt{x} with \texttt{y} in +\texttt{div x n = div y n} opens the additional goal \texttt{eq0 n n} that +is equivalent to \texttt{n=n $\land$ n$\neq$0}. +\end{cscexample} + +\asection{Rewriting and non symmetric relations} +When the user works up to relations that are not symmetric, it is no longer +the case that any covariant morphism argument is also contravariant. As a +result it is no longer possible to replace a term with a related one in +every context, since the obtained goal implies the previous one if and +only if the replacement has been performed in a contravariant position. +In a similar way, replacement in an hypothesis can be performed only if +the replaced term occurs in a covariant position. + +\begin{cscexample}[Covariance and contravariance] +Suppose that division over real numbers has been defined as a +morphism of signature \texttt{Zdiv: Zlt ++> Zlt -{}-> Zlt} (i.e. +\texttt{Zdiv} is increasing in its first argument, but decreasing on the +second one). Let \texttt{<} denotes \texttt{Zlt}. +Under the hypothesis \texttt{H: x < y} we have +\texttt{k < x / y -> k < x / x}, but not +\texttt{k < y / x -> k < x / x}. +Dually, under the same hypothesis \texttt{k < x / y -> k < y / y} holds, +but \texttt{k < y / x -> k < y / y} does not. +Thus, if the current goal is \texttt{k < x / x}, it is possible to replace +only the second occurrence of \texttt{x} (in contravariant position) +with \texttt{y} since the obtained goal must imply the current one. +On the contrary, if \texttt{k < x / x} is +an hypothesis, it is possible to replace only the first occurrence of +\texttt{x} (in covariant position) with \texttt{y} since +the current hypothesis must imply the obtained one. +\end{cscexample} + +An error message will be raised by the \texttt{rewrite} and \texttt{replace} +tactics when the user is trying to replace a term that occurs in the +wrong position. + +As expected, composing morphisms together propagates the variance annotations by +switching the variance every time a contravariant position is traversed. +\begin{cscexample} +Let us continue the previous example and let us consider the goal +\texttt{x / (x / x) < k}. The first and third occurrences of \texttt{x} are +in a contravariant position, while the second one is in covariant position. +More in detail, the second occurrence of \texttt{x} occurs +covariantly in \texttt{(x / x)} (since division is covariant in its first +argument), and thus contravariantly in \texttt{x / (x / x)} (since division +is contravariant in its second argument), and finally covariantly in +\texttt{x / (x / x) < k} (since \texttt{<}, as every transitive relation, +is contravariant in its first argument with respect to the relation itself). +\end{cscexample} + +\asection{Rewriting in ambiguous setoid contexts} +One function can respect several different relations and thus it can be +declared as a morphism having multiple signatures. + +\begin{cscexample} +Union over homogeneous lists can be given all the following signatures: +\texttt{eq ==> eq ==> eq} (\texttt{eq} being the equality over ordered lists) +\texttt{set\_eq ==> set\_eq ==> set\_eq} (\texttt{set\_eq} being the equality +over unordered lists up to duplicates), +\texttt{multiset\_eq ==> multiset\_eq ==> multiset\_eq} (\texttt{multiset\_eq} +being the equality over unordered lists). +\end{cscexample} + +To declare multiple signatures for a morphism, repeat the \texttt{Add Morphism} +command. + +When morphisms have multiple signatures it can be the case that a rewrite +request is ambiguous, since it is unclear what relations should be used to +perform the rewriting. When non reflexive relations are involved, different +choices lead to different sets of new goals to prove. In this case the +tactic automatically picks one choice, but raises a warning describing the +set of alternative new goals. To force one particular choice, the user +can switch to the following alternative syntax for rewriting: + +\comindex{setoid\_rewrite} +\begin{verse} + \texttt{setoid\_rewrite} \zeroone{\textit{orientation}} \textit{term} + \zeroone{\texttt{in} \textit{ident}}\\ + \texttt{~generate side conditions} + \textit{term}$_1$ \ldots \textit{term}$_n$\\ +\end{verse} +Up to the \texttt{generate side conditions} part, the syntax is +equivalent to the +one of the \texttt{rewrite} tactic. Additionally, the user can specify a list +of new goals that the tactic must generate. The tactic will prune out from +the alternative choices those choices that do not open at least the user +proposed goals. Thus, providing enough side conditions, the user can restrict +the tactic to at most one choice. + +\begin{cscexample} +Let \texttt{[=]+} and \texttt{[=]-} be the smaller partial equivalence +relations over positive (resp. negative) integers. Integer multiplication +can be declared as a morphism with the following signatures: +\texttt{Zmult: Zlt ++> [=]+ ==> Zlt} (multiplication with a positive number +is increasing) and +\texttt{Zmult: Zlt -{}-> [=]- ==> Zlt} (multiplication with a negative number +is decreasing). +Given the hypothesis \texttt{H: x < y} and the goal +\texttt{(x * n) * m < 0} the tactic \texttt{rewrite H} proposes +two alternative sets of goals that correspond to proving that \texttt{n} +and \texttt{m} are both positive or both negative. +\begin{itemize} + \item \texttt{\ldots $\vdash$ (y * n) * m < 0}\\ + \texttt{\ldots $\vdash$ n [=]+ n}\\ + \texttt{\ldots $\vdash$ m [=]+ m}\\ + \item \texttt{\ldots $\vdash$ (y * n) * m < 0}\\ + \texttt{\ldots $\vdash$ n [=]- n} \\ + \texttt{\ldots $\vdash$ m [=]- m} +\end{itemize} +Remember that \texttt{n [=]+ n} is equivalent to \texttt{n=n $\land$ n > 0}. + +To pick the second set of goals it is sufficient to use +\texttt{setoid\_rewrite H generate side conditions (m [=]- m)} +since the side condition \texttt{m [=]- m} is contained only in the second set +of goals. +\end{cscexample} + +\asection{First class setoids and morphisms} +First class setoids and morphisms can also be handled by encoding them +as records. The projections of the setoid relation and of the morphism +function can be registered as parametric relations and morphisms, as +illustrated by the following example. +\begin{cscexample}[First class setoids] \begin{verbatim} -Section Setoid. +Require Export Relation_Definitions. +Require Setoid. + +Record Setoid: Type := +{ car:Type; + eq:car->car->Prop; + refl: reflexive _ eq; + sym: symmetric _ eq; + trans: transitive _ eq +}. -Variable A : Type. -Variable Aeq : A -> A -> Prop. +Add Relation car eq + reflexivity proved by refl + symmetry proved by symm + transitivity proved by trans +as eq_rel. -Record Setoid_Theory : Prop := -{ Seq_refl : (x:A) (Aeq x x); - Seq_sym : (x,y:A) (Aeq x y) -> (Aeq y x); - Seq_trans : (x,y,z:A) (Aeq x y) -> (Aeq y z) -> (Aeq x z) +Record Morphism (S1 S2:Setoid): Type := +{ f:car S1 ->car S2; + compat: forall (x1 x2: car S1), eq S1 x1 x2 -> eq S2 (f x1) (f x2) }. -\end{verbatim} -\end{flushleft} -\end{small} - -To define a setoid structure on \verb+A+, you must provide a relation -\verb|Aeq| on \verb+A+ and prove that \verb|Aeq| is an equivalence -relation. That is, you have to define an object of type -\verb|(Setoid_Theory A Aeq)|. -Finally to register a setoid the syntax is: +Add Morphism f with signature eq ==> eq as apply_mor. +Proof. + intros S1 S2 m. + apply (compat S1 S2 m). +Qed. + +Lemma test: forall (S1 S2:Setoid) (m: Morphism S1 S2) + (x y: car S1), eq S1 x y -> eq S2 (f _ _ m x) (f _ _ m y). +Proof. + intros. + rewrite H. + reflexivity. +Qed. +\end{verbatim} +\end{cscexample} + +\asection{Tactics enabled on user provided relations} +\label{setoidtactics} +The following tactics, all prefixed by \texttt{setoid\_}, +deal with arbitrary +registered relations and morphisms. Moreover, all the corresponding unprefixed +tactics (i.e. \texttt{reflexivity, symmetry, transitivity, replace, rewrite}) +have been extended to fall back to their prefixed counterparts when +the relation involved is not Leibniz equality. Notice, however, that using +the prefixed tactics it is possible to pass additional arguments such as +\texttt{generate side conditions} or \texttt{using relation}. + +\comindex{setoid\_reflexivity} +\begin{verse} + \texttt{setoid\_reflexivity} +\end{verse} + +\comindex{setoid\_symmetry} +\begin{verse} + \texttt{setoid\_symmetry} + \zeroone{\texttt{in} \textit{ident}}\\ +\end{verse} + +\comindex{setoid\_transitivity} +\begin{verse} + \texttt{setoid\_transitivity} +\end{verse} + +\comindex{setoid\_rewrite} +\begin{verse} + \texttt{setoid\_rewrite} \zeroone{\textit{orientation}} \textit{term}\\ + ~\zeroone{\texttt{in} \textit{ident}}\\ + ~\zeroone{\texttt{generate side conditions} + \textit{term}$_1$ \ldots \textit{term}$_n$}\\ +\end{verse} + +The \texttt{generate side conditions} argument cannot be passed to the +unprefixed form. + +\comindex{setoid\_replace} +\begin{verse} + \texttt{setoid\_replace} \textit{term} \texttt{with} \textit{term} + ~\zeroone{\texttt{in} \textit{ident}}\\ + ~\zeroone{\texttt{using relation} \textit{term}}\\ + ~\zeroone{\texttt{generate side conditions} + \textit{term}$_1$ \ldots \textit{term}$_n$}\\ +\end{verse} + +The \texttt{generate side conditions} and \texttt{using relation} arguments cannot be +passed to the unprefixed form. The latter argument tells the tactic what +parametric relation should be used to replace the first tactic argument +with the second one. If omitted, it defaults to Leibniz equality. + +Every derived tactic that is based on the unprefixed forms of the tactics +considered above will also work up to user defined relations. For instance, +it is possible to register hints for \texttt{autorewrite} that are +not proof of Leibniz equalities. In particular it is possible to exploit +\texttt{autorewrite} to simulate normalization in a term rewriting system +up to user defined equalities. + +\asection{Printing relations and morphisms} +The \texttt{Print Setoids} command shows the list of currently registered +parametric relations and morphisms. For each morphism its signature is also +given. When the rewriting tactics refuse to replace a term in a context +because the latter is not a composition of morphisms, the \texttt{Print Setoids} +command is useful to understand what additional morphisms should be registered. + +\asection{Deprecated syntax and backward incompatibilities} +Due to backward compatibility reasons, the following syntax for the +declaration of setoids and morphisms is also accepted. \comindex{Add Setoid} -\begin{quotation} - \texttt{Add Setoid} \textit{ A Aeq ST} -\end{quotation} - -\noindent where \textit{Aeq} is a term of type \texttt{A->A->Prop} and -\textit{ST} is a term of type -\texttt{(Setoid\_Theory }\textit{A Aeq}\texttt{)}. - -\begin{ErrMsgs} -\item \errindex{Not a valid setoid theory}.\\ - That happens when the typing condition does not hold. -\item \errindex{A Setoid Theory is already declared for \textit{A}}.\\ - That happens when you try to declare a second setoid theory for the - same type. -\end{ErrMsgs} - -Currently, only one setoid structure -may be declared for a given type. -This allows automatic detection of the theory used to achieve the -replacement. - -The table of setoid theories is compatible with the \Coq\ -sectioning mechanism. If you declare a setoid inside a section, the -declaration will be thrown away when closing the section. -And when you load a compiled file, all the \texttt{Add Setoid} -commands of this file that are not inside a section will be loaded. - -\Warning Only the setoid on \texttt{Prop} is loaded by default with the -\texttt{setoid\_replace} module. The equivalence relation used is -\texttt{iff} {\it i.e.} the logical equivalence. - -\asection{Adding new morphisms} - -A morphism is nothing else than a function compatible with the -equivalence relation. -You can only replace a term by an equivalent in position of argument -of a morphism. That's why each morphism has to be -declared to the system, which will ask you to prove the accurate -compatibility lemma. - -The syntax is the following : -\comindex{Add Morphism} -\begin{quotation} - \texttt{Add Morphism} \textit{ f }:\textit{ ident} -\end{quotation} - -\noindent where f is the name of a term which type is a non dependent -product (the term you want to declare as a morphism) and -\textit{ident} is a new identifier which will denote the -compatibility lemma. - -\begin{ErrMsgs} -\item \errindex{The term \term \ is already declared as a morphism} -\item \errindex{The term \term \ is not a product} -\item \errindex{The term \term \ should not be a dependent product} -\end{ErrMsgs} - -The compatibility lemma generated depends on the setoids already -declared. - -\asection{The tactic itself} -\tacindex{setoid\_replace} -\tacindex{setoid\_rewrite} +\begin{verse} + \texttt{Add Setoid} \textit{A Aeq ST} \texttt{as} \textit{ident} +\end{verse} +where \textit{Aeq} is a congruence relation without parameters, +\textit{A} is its carrier and \textit{ST} is an object of type +\verb|(Setoid_Theory A Aeq)| (i.e. a record packing together the reflexivity, +symmetry and transitivity lemmas). Notice that the syntax is not completely +backward compatible since the identifier was not required. -After having registered all the setoids and morphisms you need, you can -use the tactic called \texttt{setoid\_replace}. The syntax is - -\begin{quotation} -\texttt{setoid\_replace} $ term_1$ with $term_2$ -\end{quotation} - -The effect is similar to the one of \texttt{replace}. - -You also have a tactic called \texttt{setoid\_rewrite} which is the -equivalent of \texttt{rewrite} for setoids. The syntax is - -\begin{quotation} -\texttt{setoid\_rewrite} \term -\end{quotation} - -\begin{Variants} - \item \texttt{setoid\_rewrite ->} \term - \item \texttt{setoid\_rewrite <-} \term -\end{Variants} - -The arrow tells the system in which direction the rewriting has to be -done. Moreover, you can use \texttt{rewrite} for setoid -rewriting. In that case the system will check if the term you give is -an equality or a setoid equivalence and do the appropriate work. +\comindex{Add Morphism} +\begin{verse} + \texttt{Add Morphism} \textit{ f }:\textit{ ident}.\\ + Proof.\\ + \ldots\\ + Qed. +\end{verse} + +The latter command is restricted to the declaration of morphisms without +parameters. It is not fully backward compatible since the property the user +is asked to prove is slightly different: for $n$-ary morphisms the hypotheses +of the property are permuted; moreover, when the morphism returns a +proposition, the property is now stated using a bi-implication in place of +a simple implication. In practice, porting an old development to the new +semantics is usually quite simple. + +Notice that several limitations of the old implementation have been lifted. +In particular, it is now possible to declare several relations with the +same carrier and several signatures for the same morphism. Moreover, it is +now also possible to declare several morphisms having the same signature. +Finally, the replace and rewrite tactics can be used to replace terms in +contexts that were refused by the old implementation. %%% Local Variables: %%% mode: latex diff --git a/doc/refman/biblio.bib b/doc/refman/biblio.bib index 378936d9..b9a3a2c5 100644 --- a/doc/refman/biblio.bib +++ b/doc/refman/biblio.bib @@ -974,6 +974,18 @@ the Calculus of Inductive Constructions}}, YEAR = {1992} } +@article{Rushby98, + TITLE = {Subtypes for Specifications: Predicate Subtyping in + {PVS}}, + AUTHOR = {John Rushby and Sam Owre and N. Shankar}, + JOURNAL = {IEEE Transactions on Software Engineering}, + PAGES = {709--720}, + VOLUME = 24, + NUMBER = 9, + MONTH = sep, + YEAR = 1998 +} + @TECHREPORT{Saibi94, AUTHOR = {A. Sa\"{\i}bi}, INSTITUTION = {INRIA}, diff --git a/doc/refman/coqdoc.tex b/doc/refman/coqdoc.tex index 7862c5c3..f2630da0 100644 --- a/doc/refman/coqdoc.tex +++ b/doc/refman/coqdoc.tex @@ -264,6 +264,10 @@ suffix \verb!.tex!. Select a \texmacs\ output. +\item[\texttt{--stdout}] ~\par + + Write output to stdout. + \item[\texttt{-o }\textit{file}, \texttt{\mm{}output }\textit{file}] ~\par Redirect the output into the file `\textit{file}' (meaningless with diff --git a/doc/stdlib/index-list.html.template b/doc/stdlib/index-list.html.template index cbb8580d..10744fe4 100644 --- a/doc/stdlib/index-list.html.template +++ b/doc/stdlib/index-list.html.template @@ -41,16 +41,20 @@ through the <tt>Require Import</tt> command.</p> theories/Logic/Classical_Prop.v theories/Logic/Classical_Type.v (theories/Logic/Classical.v) + theories/Logic/ClassicalFacts.v theories/Logic/Decidable.v + theories/Logic/DecidableType.v + theories/Logic/DecidableTypeEx.v theories/Logic/Eqdep_dec.v theories/Logic/EqdepFacts.v theories/Logic/Eqdep.v theories/Logic/JMeq.v + theories/Logic/ChoiceFacts.v theories/Logic/RelationalChoice.v theories/Logic/ClassicalChoice.v - theories/Logic/ChoiceFacts.v theories/Logic/ClassicalDescription.v - theories/Logic/ClassicalFacts.v + theories/Logic/ClassicalEpsilon.v + theories/Logic/ClassicalUniqueChoice.v theories/Logic/Berardi.v theories/Logic/Diaconescu.v theories/Logic/Hurkens.v @@ -93,7 +97,11 @@ through the <tt>Require Import</tt> command.</p> theories/NArith/BinNat.v (theories/NArith/NArith.v) theories/NArith/Pnat.v - </dd> + theories/NArith/Nnat.v + theories/NArith/Ndigits.v + theories/NArith/Ndist.v + theories/NArith/Ndec.v +. </dd> <dt> <b>ZArith</b>: Binary integers @@ -124,6 +132,18 @@ through the <tt>Require Import</tt> command.</p> theories/ZArith/Zwf.v theories/ZArith/Zbinary.v theories/ZArith/Znumtheory.v + theories/ZArith/Int.v + </dd> + + <dt> <b>Reals</b>: + Rational numbers + </dt> + <dd> + theories/QArith/QArith_base.v + theories/QArith/Qreduction.v + theories/QArith/Qring.v + (theories/QArith/QArith.v) + theories/QArith/Qreals.v </dd> <dt> <b>Reals</b>: @@ -185,32 +205,6 @@ through the <tt>Require Import</tt> command.</p> (theories/Reals/Reals.v) </dd> - <dt> <b>Bool</b>: - Booleans (basic functions and results) - </dt> - <dd> - theories/Bool/Bool.v - theories/Bool/BoolEq.v - theories/Bool/DecBool.v - theories/Bool/IfProp.v - theories/Bool/Sumbool.v - theories/Bool/Zerob.v - theories/Bool/Bvector.v - </dd> - - <dt> <b>Lists</b>: - Polymorphic lists, Streams (infinite sequences) - </dt> - <dd> - theories/Lists/List.v - theories/Lists/ListSet.v - theories/Lists/MonoList.v - theories/Lists/MoreList.v - theories/Lists/SetoidList.v - theories/Lists/Streams.v - theories/Lists/TheoryList.v - </dd> - <dt> <b>Sets</b>: Sets (classical, constructive, finite, infinite, powerset, etc.) </dt> @@ -266,67 +260,89 @@ through the <tt>Require Import</tt> command.</p> theories/Wellfounded/Well_Ordering.v </dd> - <dt> <b>Sorting</b>: - Axiomatizations of sorts - </dt> - <dd> - theories/Sorting/Heap.v - theories/Sorting/Permutation.v - theories/Sorting/Sorting.v - </dd> - <dt> <b>Setoids</b>: <dd> theories/Setoids/Setoid.v </dd> - <dt> <b>IntMap</b>: - Finite sets/maps as trees indexed by addresses + <dt> <b>Bool</b>: + Booleans (basic functions and results) </dt> <dd> - theories/IntMap/Addr.v - theories/IntMap/Adist.v - theories/IntMap/Addec.v - theories/IntMap/Adalloc.v - theories/IntMap/Map.v - theories/IntMap/Fset.v - theories/IntMap/Mapaxioms.v - theories/IntMap/Mapiter.v - theories/IntMap/Mapcanon.v - theories/IntMap/Mapsubset.v - theories/IntMap/Lsort.v - theories/IntMap/Mapfold.v - theories/IntMap/Mapcard.v - theories/IntMap/Mapc.v - theories/IntMap/Maplists.v - theories/IntMap/Allmaps.v + theories/Bool/Bool.v + theories/Bool/BoolEq.v + theories/Bool/DecBool.v + theories/Bool/IfProp.v + theories/Bool/Sumbool.v + theories/Bool/Zerob.v + theories/Bool/Bvector.v </dd> + <dt> <b>Lists</b>: + Polymorphic lists, Streams (infinite sequences) + </dt> + <dd> + theories/Lists/List.v + theories/Lists/ListSet.v + theories/Lists/MonoList.v + theories/Lists/SetoidList.v + theories/Lists/Streams.v + theories/Lists/TheoryList.v + </dd> + <dt> <b>FSets</b>: Modular implementation of finite sets/maps using lists </dt> <dd> - theories/FSets/DecidableType.v theories/FSets/OrderedType.v + theories/FSets/OrderedTypeAlt.v + theories/FSets/OrderedTypeEx.v theories/FSets/FSetInterface.v theories/FSets/FSetBridge.v theories/FSets/FSetProperties.v theories/FSets/FSetEqProperties.v - theories/FSets/FSetFacts.v theories/FSets/FSetList.v - theories/FSets/FSet.v - theories/FSets/FMapInterface.v - theories/FSets/FMapList.v - theories/FSets/FMap.v + (theories/FSets/FSets.v) + theories/FSets/FSetFacts.v + theories/FSets/FSetAVL.v + theories/FSets/FSetToFiniteSet.v + theories/FSets/FSetWeakProperties.v theories/FSets/FSetWeakInterface.v theories/FSets/FSetWeakFacts.v theories/FSets/FSetWeakList.v theories/FSets/FSetWeak.v + theories/FSets/FMapInterface.v + theories/FSets/FMapList.v + theories/FSets/FMapPositive.v + theories/FSets/FMapIntMap.v + theories/FSets/FMapFacts.v + (theories/FSets/FMaps.v) + theories/FSets/FMapAVL.v theories/FSets/FMapWeakInterface.v theories/FSets/FMapWeakList.v theories/FSets/FMapWeak.v + theories/FSets/FMapWeakFacts.v </dd> + <dt> <b>IntMap</b>: + An implementation of finite sets/maps as trees indexed by addresses + </dt> + <dd> + theories/IntMap/Adalloc.v + theories/IntMap/Map.v + theories/IntMap/Fset.v + theories/IntMap/Mapaxioms.v + theories/IntMap/Mapiter.v + theories/IntMap/Mapcanon.v + theories/IntMap/Mapsubset.v + theories/IntMap/Lsort.v + theories/IntMap/Mapfold.v + theories/IntMap/Mapcard.v + theories/IntMap/Mapc.v + theories/IntMap/Maplists.v + theories/IntMap/Allmaps.v + </dd> + <dt> <b>Strings</b> Implementation of string as list of ascii characters </dt> @@ -335,5 +351,15 @@ through the <tt>Require Import</tt> command.</p> theories/Strings/String.v </dd> + <dt> <b>Sorting</b>: + Axiomatizations of sorts + </dt> + <dd> + theories/Sorting/Heap.v + theories/Sorting/Permutation.v + theories/Sorting/Sorting.v + theories/Sorting/PermutEq.v + theories/Sorting/PermutSetoid.v </dd> + </dl> diff --git a/doc/tutorial/Tutorial.tex b/doc/tutorial/Tutorial.tex index 7c840509..73d833c4 100755 --- a/doc/tutorial/Tutorial.tex +++ b/doc/tutorial/Tutorial.tex @@ -96,7 +96,6 @@ of the system, called respectively \verb:Prop:, \verb:Set:, and Every valid expression $e$ in Gallina is associated with a specification, itself a valid expression, called its {\sl type} $\tau(E)$. We write $e:\tau(E)$ for the judgment that $e$ is of type $E$. -%CP Le role de \tau n'est pas clair. You may request \Coq~ to return to you the type of a valid expression by using the command \verb:Check:: @@ -271,7 +270,6 @@ Goal (A -> B -> C) -> (A -> B) -> A -> C. The system displays the current goal below a double line, local hypotheses (there are none initially) being displayed above the line. We call the combination of local hypotheses with a goal a {\sl judgment}. -%The new prompt \verb:Unnamed_thm <: indicates that. We are now in an inner loop of the system, in proof mode. New commands are available in this @@ -287,10 +285,6 @@ of the application to the list of local hypotheses: intro H. \end{coq_example} -%{\bf Warning} to users of \Coq~ previous versions: The display of a sequent in -%older versions of \Coq~ is inverse of this convention: the goal is displayed -%above the double line, the hypotheses below. - Several introductions may be done in one step: \begin{coq_example} intros H' HA. @@ -337,7 +331,7 @@ Save trivial_lemma. \end{coq_example} As a comment, the system shows the proof script listing all tactic -commands used in the proof. % ligne blanche apres exact HA?? +commands used in the proof. Let us redo the same proof with a few variations. First of all we may name the initial goal as a conjectured lemma: @@ -345,9 +339,6 @@ the initial goal as a conjectured lemma: Lemma distr_impl : (A -> B -> C) -> (A -> B) -> A -> C. \end{coq_example} -%{\bf Warning} to users of \Coq~ older versions: In order to enter the proof -%engine, at this point a dummy \verb:Goal.: command had to be typed in. - Next, we may omit the names of local assumptions created by the introduction tactics, they can be automatically created by the proof engine as new non-clashing names. @@ -407,7 +398,7 @@ backtrack n steps. We end this section by showing a useful command, \verb:Inspect n.:, which inspects the global \Coq~ environment, showing the last \verb:n: declared -notions: % Attention ici ?? +notions: \begin{coq_example} Inspect 3. \end{coq_example} @@ -522,8 +513,6 @@ such a simple tautology. The reason is that we want to keep A complete tactic for propositional tautologies is indeed available in \Coq~ as the \verb:tauto: tactic. -%In order to get this facility, we have to import a library module -%called ``Dyckhoff'': \begin{coq_example} Restart. tauto. @@ -1024,7 +1013,6 @@ more specialised properties. Assume that we want to develop the theory of sets represented as characteristic predicates over some universe \verb:U:. For instance: -%CP Une petite explication pour le codage de element ? \begin{coq_example} Variable U : Type. Definition set := U -> Prop. @@ -1099,9 +1087,6 @@ mathematical justification of a logical development relies only on Conversely, ordinary mathematical definitions can be unfolded at will, they are {\sl transparent}. -%It is possible to enforce the reverse convention by -%declaring a definition as {\sl opaque} or a lemma as {\sl transparent}. - \chapter{Induction} \section{Data Types as Inductively Defined Mathematical Collections} @@ -1244,8 +1229,7 @@ Reset bool. \subsection{Simple proofs by induction} -%CP Pourquoi ne pas commencer par des preuves d'egalite entre termes -% convertibles. + \begin{coq_eval} Reset Initial. \end{coq_eval} @@ -1427,7 +1411,6 @@ elim n_le_m. What happens here is similar to the behaviour of \verb:elim: on natural numbers: it appeals to the relevant induction principle, here \verb:le_ind:, which generates the two subgoals, which may then be solved easily -%as if ``backchaining'' the current goal with the help of the defining clauses of \verb:le:. \begin{coq_example} apply le_n; trivial. @@ -1519,8 +1502,6 @@ development is not type-checked again. You may create your own modules, by writing \Coq~ commands in a file, say \verb:my_module.v:. Such a module may be simply loaded in the current context, with command \verb:Load my_module:. It may also be compiled, -%using the command \verb:Compile Module my_module: directly at the -%\Coq~ toplevel, or else in ``batch'' mode, using the UNIX command \verb:coqc:. Compiling the module \verb:my_module.v: creates a file \verb:my_module.vo:{} that can be reloaded with command @@ -1559,16 +1540,6 @@ provides usual infix notations for arithmetic operators. SearchPattern (_ + _ = _). \end{coq_example} -% The argument to give is a type and it searches in the current context all -% constants having the same type modulo certain notion of -% \textit{isomorphism}. For example~: - -% \begin{coq_example} -% Require Arith. -% SearchIsos nat -> nat -> Prop. -% SearchIsos (x,y,z:nat)(le x y) -> (le y z) -> (le x z). -% \end{coq_example} - \section{Now you are on your own} This tutorial is necessarily incomplete. If you wish to pursue serious @@ -1581,4 +1552,4 @@ with \Coq, in order to acquaint yourself with various proof techniques. \end{document} -% $Id: Tutorial.tex 8607 2006-02-23 14:21:14Z herbelin $ +% $Id: Tutorial.tex 8715 2006-04-14 12:43:23Z cpaulin $ diff --git a/ide/blaster_window.ml b/ide/blaster_window.ml index 1b018015..f3cb1e60 100644 --- a/ide/blaster_window.ml +++ b/ide/blaster_window.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: blaster_window.ml 5920 2004-07-16 20:01:26Z herbelin $ *) +(* $Id: blaster_window.ml 8912 2006-06-07 11:20:58Z notin $ *) open Gobject.Data open Ideutils @@ -77,22 +77,17 @@ object(self) val blaster_killed = Condition.create () method blaster_killed = blaster_killed method window = window - method set - root - name - (compute:unit -> Coq.tried_tactic) - (on_click:unit -> unit) - = + method set root name (compute:unit -> Coq.tried_tactic) (on_click:unit -> unit) = let root_iter = try Hashtbl.find roots root with Not_found -> let nr = new_arg root in - Hashtbl.add roots root nr; - nr + Hashtbl.add roots root nr; + nr in let nt = new_tac root_iter name in let old_val = try MyMap.find root tbl with Not_found -> MyMap.empty in - tbl <- MyMap.add root (MyMap.add name (nt,compute,on_click) old_val) tbl + tbl <- MyMap.add root (MyMap.add name (nt,compute,on_click) old_val) tbl method clear () = model#clear (); @@ -107,20 +102,20 @@ object(self) MyMap.iter (fun name (nt,compute,on_click) -> match compute () with - | Coq.Interrupted -> - prerr_endline "Interrupted"; - raise Stop - | Coq.Failed -> - prerr_endline "Failed"; - ignore (model#remove nt) - (* model#set ~row:nt ~column:status false; + | Coq.Interrupted -> + prerr_endline "Interrupted"; + raise Stop + | Coq.Failed -> + prerr_endline "Failed"; + ignore (model#remove nt) + (* model#set ~row:nt ~column:status false; model#set ~row:nt ~column:nb_goals "N/A" - *) - | Coq.Success n -> - prerr_endline "Success"; - model#set ~row:nt ~column:status true; - model#set ~row:nt ~column:nb_goals (string_of_int n); - if n= -1 then raise Done + *) + | Coq.Success n -> + prerr_endline "Success"; + model#set ~row:nt ~column:status true; + model#set ~row:nt ~column:nb_goals (string_of_int n); + if n= -1 then raise Done ) l with Done -> ()) @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: coq.ml 7837 2006-01-11 09:47:32Z herbelin $ *) +(* $Id: coq.ml 8912 2006-06-07 11:20:58Z notin $ *) open Vernac open Vernacexpr @@ -72,23 +72,25 @@ let is_in_coq_lib dir = prerr_endline ("Is it a coq theory ? : "^dir); try let stat = Unix.stat dir in - List.exists - (fun s -> - try - let fdir = Filename.concat - Coq_config.coqlib - (Filename.concat "theories" s) - in - prerr_endline (" Comparing to: "^fdir); - let fstat = Unix.stat fdir in - (fstat.Unix.st_dev = stat.Unix.st_dev) && - (fstat.Unix.st_ino = stat.Unix.st_ino) && - (prerr_endline " YES";true) - with _ -> prerr_endline " No(because of a local exn)";false - ) - Coq_config.theories_dirs + List.exists + (fun s -> + try + let fdir = Filename.concat + Coq_config.coqlib + (Filename.concat "theories" s) + in + prerr_endline (" Comparing to: "^fdir); + let fstat = Unix.stat fdir in + (fstat.Unix.st_dev = stat.Unix.st_dev) && + (fstat.Unix.st_ino = stat.Unix.st_ino) && + (prerr_endline " YES";true) + with _ -> prerr_endline " No(because of a local exn)";false + ) + Coq_config.theories_dirs with _ -> prerr_endline " No(because of a global exn)";false +let is_in_loadpath dir = Library.is_in_load_paths (System.physical_path_of_string dir) + let is_in_coq_path f = try let base = Filename.chop_extension (Filename.basename f) in diff --git a/ide/coq.mli b/ide/coq.mli index eaa32068..666a5397 100644 --- a/ide/coq.mli +++ b/ide/coq.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: coq.mli 6621 2005-01-21 17:24:37Z herbelin $ i*) +(*i $Id: coq.mli 8877 2006-05-30 16:37:04Z notin $ i*) open Names open Term @@ -50,6 +50,7 @@ val concl_menu : concl -> (string * string) list val is_in_coq_lib : string -> bool val is_in_coq_path : string -> bool +val is_in_loadpath : string -> bool val make_cases : string -> string list list diff --git a/ide/coqide.ml b/ide/coqide.ml index d79ee950..cfde925d 100644 --- a/ide/coqide.ml +++ b/ide/coqide.ml @@ -6,82 +6,82 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: coqide.ml 7644 2005-12-13 14:18:13Z narboux $ *) +(* $Id: coqide.ml 8932 2006-06-09 09:29:03Z notin $ *) open Preferences open Vernacexpr open Coq open Ideutils - + let out_some s = match s with | None -> failwith "Internal error in out_some" | Some f -> f - + let cb_ = ref None let cb () = ((out_some !cb_):GData.clipboard) let last_cb_content = ref "" - + let (message_view:GText.view option ref) = ref None let (proof_view:GText.view option ref) = ref None - + let (_notebook:GPack.notebook option ref) = ref None let notebook () = out_some !_notebook - + (* Tabs contain the name of the edited file and 2 status informations: Saved state + Focused proof buffer *) let decompose_tab w = let vbox = new GPack.box ((Gobject.try_cast w "GtkBox"):Gtk.box Gtk.obj) in let l = vbox#children in - match l with - | [img;lbl] -> - let img = new GMisc.image - ((Gobject.try_cast img#as_widget "GtkImage"): - Gtk.image Gtk.obj) - in - let lbl = GMisc.label_cast lbl in - vbox,img,lbl - | _ -> assert false - + match l with + | [img;lbl] -> + let img = new GMisc.image + ((Gobject.try_cast img#as_widget "GtkImage"): + Gtk.image Gtk.obj) + in + let lbl = GMisc.label_cast lbl in + vbox,img,lbl + | _ -> assert false + let set_tab_label i n = let nb = notebook () in let _,_,lbl = decompose_tab (nb#get_tab_label(nb#get_nth_page i))#as_widget in - lbl#set_use_markup true; - (* lbl#set_text n *) lbl#set_label n - - + lbl#set_use_markup true; + (* lbl#set_text n *) lbl#set_label n + + let set_tab_image ~icon i = let nb = notebook () in let _,img,_ = decompose_tab (nb#get_tab_label(nb#get_nth_page i))#as_widget in - img#set_icon_size `SMALL_TOOLBAR; - img#set_stock icon - + img#set_icon_size `SMALL_TOOLBAR; + img#set_stock icon + let set_current_tab_image ~icon = set_tab_image ~icon (notebook())#current_page let set_current_tab_label n = set_tab_label (notebook())#current_page n - + let get_tab_label i = let nb = notebook () in let _,_,lbl = decompose_tab (nb#get_tab_label(nb#get_nth_page i))#as_widget in - lbl#text - + lbl#text + let get_full_tab_label i = let nb = notebook () in let _,_,lbl = decompose_tab (nb#get_tab_label(nb#get_nth_page i))#as_widget in - lbl - + lbl + let get_current_tab_label () = get_tab_label (notebook())#current_page - + let get_current_page () = let i = (notebook())#current_page in - (notebook())#get_nth_page i - + (notebook())#get_nth_page i + (* This function must remove "focused proof" decoration *) let reset_tab_label i = set_tab_label i (get_tab_label i) - + let to_do_on_page_switch = ref [] module Vector = struct @@ -96,14 +96,14 @@ module Vector = struct let iter f t = Array.iter (function | None -> () | Some x -> f x) !t let find_or_fail f t = let test i = function | None -> () | Some e -> if f e then raise (Found i) in - Array.iteri test t + Array.iteri test t let exists f t = let l = Array.length !t in let rec test i = (i < l) && (((!t.(i) <> None) && f (out_some !t.(i))) || test (i+1)) in - test 0 + test 0 end type 'a viewable_script = @@ -114,107 +114,107 @@ type 'a viewable_script = class type analyzed_views= object('self) - val mutable act_id : GtkSignal.id option - val current_all : 'self viewable_script - val mutable deact_id : GtkSignal.id option - val input_buffer : GText.buffer - val input_view : Undo.undoable_view - val last_array : string array - val mutable last_index : bool - val message_buffer : GText.buffer - val message_view : GText.view - val proof_buffer : GText.buffer - val proof_view : GText.view - val mutable is_active : bool - val mutable read_only : bool - val mutable filename : string option - val mutable stats : Unix.stats option - val mutable detached_views : GWindow.window list - method without_auto_complete : 'a 'b. ('a -> 'b) -> 'a -> 'b - method set_auto_complete : bool -> unit - - method kill_detached_views : unit -> unit - method add_detached_view : GWindow.window -> unit - method remove_detached_view : GWindow.window -> unit - - method view : Undo.undoable_view - method filename : string option - method stats : Unix.stats option - method set_filename : string option -> unit - method update_stats : unit - method revert : unit - method auto_save : unit - method save : string -> bool - method save_as : string -> bool - method read_only : bool - method set_read_only : bool -> unit - method is_active : bool - method activate : unit -> unit - method active_keypress_handler : GdkEvent.Key.t -> bool - method backtrack_to : GText.iter -> unit - method backtrack_to_no_lock : GText.iter -> unit - method clear_message : unit - method deactivate : unit -> unit - method disconnected_keypress_handler : GdkEvent.Key.t -> bool - method electric_handler : GtkSignal.id - method find_phrase_starting_at : - GText.iter -> (GText.iter * GText.iter) option - method get_insert : GText.iter - method get_start_of_input : GText.iter - method go_to_insert : unit - method indent_current_line : unit - method insert_command : string -> string -> unit - method tactic_wizard : string list -> unit - method insert_message : string -> unit - method insert_this_phrase_on_success : - bool -> bool -> bool -> string -> string -> bool - method process_next_phrase : bool -> bool -> bool -> bool - method process_until_iter_or_error : GText.iter -> unit - method process_until_end_or_error : unit - method recenter_insert : unit - method reset_initial : unit - method send_to_coq : - bool -> bool -> string -> - bool -> bool -> bool -> (Util.loc * Vernacexpr.vernac_expr) option - method set_message : string -> unit - method show_goals : unit - method show_goals_full : unit - method undo_last_step : unit - method help_for_keyword : unit -> unit - method complete_at_offset : int -> bool - - method blaster : unit -> unit + val mutable act_id : GtkSignal.id option + val current_all : 'self viewable_script + val mutable deact_id : GtkSignal.id option + val input_buffer : GText.buffer + val input_view : Undo.undoable_view + val last_array : string array + val mutable last_index : bool + val message_buffer : GText.buffer + val message_view : GText.view + val proof_buffer : GText.buffer + val proof_view : GText.view + val mutable is_active : bool + val mutable read_only : bool + val mutable filename : string option + val mutable stats : Unix.stats option + val mutable detached_views : GWindow.window list + method without_auto_complete : 'a 'b. ('a -> 'b) -> 'a -> 'b + method set_auto_complete : bool -> unit + + method kill_detached_views : unit -> unit + method add_detached_view : GWindow.window -> unit + method remove_detached_view : GWindow.window -> unit + + method view : Undo.undoable_view + method filename : string option + method stats : Unix.stats option + method set_filename : string option -> unit + method update_stats : unit + method revert : unit + method auto_save : unit + method save : string -> bool + method save_as : string -> bool + method read_only : bool + method set_read_only : bool -> unit + method is_active : bool + method activate : unit -> unit + method active_keypress_handler : GdkEvent.Key.t -> bool + method backtrack_to : GText.iter -> unit + method backtrack_to_no_lock : GText.iter -> unit + method clear_message : unit + method deactivate : unit -> unit + method disconnected_keypress_handler : GdkEvent.Key.t -> bool + method electric_handler : GtkSignal.id + method find_phrase_starting_at : + GText.iter -> (GText.iter * GText.iter) option + method get_insert : GText.iter + method get_start_of_input : GText.iter + method go_to_insert : unit + method indent_current_line : unit + method insert_command : string -> string -> unit + method tactic_wizard : string list -> unit + method insert_message : string -> unit + method insert_this_phrase_on_success : + bool -> bool -> bool -> string -> string -> bool + method process_next_phrase : bool -> bool -> bool -> bool + method process_until_iter_or_error : GText.iter -> unit + method process_until_end_or_error : unit + method recenter_insert : unit + method reset_initial : unit + method send_to_coq : + bool -> bool -> string -> + bool -> bool -> bool -> (Util.loc * Vernacexpr.vernac_expr) option + method set_message : string -> unit + method show_goals : unit + method show_goals_full : unit + method undo_last_step : unit + method help_for_keyword : unit -> unit + method complete_at_offset : int -> bool + + method blaster : unit -> unit end let (input_views:analyzed_views viewable_script Vector.t) = Vector.create () let signals_to_crash = [Sys.sigabrt; Sys.sigalrm; Sys.sigfpe; Sys.sighup; - Sys.sigill; Sys.sigpipe; Sys.sigquit; - (* Sys.sigsegv; Sys.sigterm;*) Sys.sigusr2] + Sys.sigill; Sys.sigpipe; Sys.sigquit; + (* Sys.sigsegv; Sys.sigterm;*) Sys.sigusr2] let crash_save i = -(* ignore (Unix.sigprocmask Unix.SIG_BLOCK signals_to_crash);*) + (* ignore (Unix.sigprocmask Unix.SIG_BLOCK signals_to_crash);*) Pervasives.prerr_endline "Trying to save all buffers in .crashcoqide files"; let count = ref 0 in - Vector.iter - (function {view=view; analyzed_view = Some av } -> - (let filename = match av#filename with - | None -> - incr count; - "Unnamed_coqscript_"^(string_of_int !count)^".crashcoqide" - | Some f -> f^".crashcoqide" - in - try - if try_export filename (view#buffer#get_text ()) then - Pervasives.prerr_endline ("Saved "^filename) - else Pervasives.prerr_endline ("Could not save "^filename) - with _ -> Pervasives.prerr_endline ("Could not save "^filename)) - | _ -> Pervasives.prerr_endline "Unanalyzed view found. Please report." - ) - input_views; - Pervasives.prerr_endline "Done. Please report."; - if i <> 127 then exit i + Vector.iter + (function {view=view; analyzed_view = Some av } -> + (let filename = match av#filename with + | None -> + incr count; + "Unnamed_coqscript_"^(string_of_int !count)^".crashcoqide" + | Some f -> f^".crashcoqide" + in + try + if try_export filename (view#buffer#get_text ()) then + Pervasives.prerr_endline ("Saved "^filename) + else Pervasives.prerr_endline ("Could not save "^filename) + with _ -> Pervasives.prerr_endline ("Could not save "^filename)) + | _ -> Pervasives.prerr_endline "Unanalyzed view found. Please report." + ) + input_views; + Pervasives.prerr_endline "Done. Please report."; + if i <> 127 then exit i let ignore_break () = List.iter @@ -236,15 +236,15 @@ let break () = begin prerr_endline " trying to stop computation:"; if Mutex.try_lock coq_may_stop then begin - Util.interrupt := true; - prerr_endline " interrupt flag set. Computation should stop soon..."; - Mutex.unlock coq_may_stop - end else prerr_endline " interruption refused (may not stop now)"; + Util.interrupt := true; + prerr_endline " interrupt flag set. Computation should stop soon..."; + Mutex.unlock coq_may_stop + end else prerr_endline " interruption refused (may not stop now)"; end else begin - Mutex.unlock coq_computing; - prerr_endline " ignored (not computing)" - end + Mutex.unlock coq_computing; + prerr_endline " ignored (not computing)" + end let do_if_not_computing text f x = let threaded_task () = @@ -252,37 +252,41 @@ let do_if_not_computing text f x = then begin let w = Blaster_window.blaster_window () in - if not (Mutex.try_lock w#lock) then begin - break (); - let lck = Mutex.create () in - Mutex.lock lck; - prerr_endline "Waiting on blaster..."; - Condition.wait w#blaster_killed lck; - prerr_endline "Waiting on blaster ok"; - Mutex.unlock lck - end else Mutex.unlock w#lock; - let idle = - Glib.Timeout.add ~ms:300 - ~callback:(fun () -> async !pulse ();true) in - begin - prerr_endline "Getting lock"; - try - f x; - Glib.Timeout.remove idle; - prerr_endline "Releasing lock"; - Mutex.unlock coq_computing; - with e -> - Glib.Timeout.remove idle; - prerr_endline "Releasing lock (on error)"; - Mutex.unlock coq_computing; - raise e - end + if not (Mutex.try_lock w#lock) then + begin + break (); + let lck = Mutex.create () in + Mutex.lock lck; + prerr_endline "Waiting on blaster..."; + Condition.wait w#blaster_killed lck; + prerr_endline "Waiting on blaster ok"; + Mutex.unlock lck + end + else + Mutex.unlock w#lock; + let idle = + Glib.Timeout.add ~ms:300 + ~callback:(fun () -> async !pulse ();true) in + begin + prerr_endline "Getting lock"; + try + f x; + Glib.Timeout.remove idle; + prerr_endline "Releasing lock"; + Mutex.unlock coq_computing; + with e -> + Glib.Timeout.remove idle; + prerr_endline "Releasing lock (on error)"; + Mutex.unlock coq_computing; + raise e + end end else prerr_endline - "Discarded order (computations are ongoing)" in - prerr_endline ("Launching thread " ^ text); - ignore (Thread.create threaded_task ()) + "Discarded order (computations are ongoing)" + in + prerr_endline ("Launching thread " ^ text); + ignore (Thread.create threaded_task ()) let add_input_view tv = Vector.append input_views tv @@ -302,26 +306,26 @@ let set_active_view i = reset_tab_label i); (notebook ())#goto_page i; let txt = get_current_tab_label () in - set_current_tab_label ("<span background=\"light green\">"^txt^"</span>"); - active_view := Some i + set_current_tab_label ("<span background=\"light green\">"^txt^"</span>"); + active_view := Some i let set_current_view i = (notebook ())#goto_page i let kill_input_view i = let v = Vector.get input_views i in - (match v.analyzed_view with - | Some v -> v#kill_detached_views () - | None -> ()); - v.view#destroy (); - v.analyzed_view <- None; - Vector.remove input_views i + (match v.analyzed_view with + | Some v -> v#kill_detached_views () + | None -> ()); + v.view#destroy (); + v.analyzed_view <- None; + Vector.remove input_views i let get_current_view_page () = (notebook ())#current_page let get_current_view () = Vector.get input_views (notebook ())#current_page let remove_current_view_page () = let c = (notebook ())#current_page in - kill_input_view c; - ((notebook ())#get_nth_page c)#misc#hide () + kill_input_view c; + ((notebook ())#get_nth_page c)#misc#hide () let is_word_char c = @@ -330,20 +334,20 @@ let is_word_char c = let starts_word it = prerr_endline ("Starts word ? '"^(Glib.Utf8.from_unichar it#char)^"'"); (not it#copy#nocopy#backward_char || - (let c = it#backward_char#char in - not (is_word_char c))) + (let c = it#backward_char#char in + not (is_word_char c))) let ends_word it = (not it#copy#nocopy#forward_char || - let c = it#forward_char#char in - not (Glib.Unichar.isalnum c || c = underscore || c = prime || c = arobase) + let c = it#forward_char#char in + not (Glib.Unichar.isalnum c || c = underscore || c = prime || c = arobase) ) let inside_word it = let c = it#char in - not (starts_word it) && - not (ends_word it) && - (Glib.Unichar.isalnum c || c = underscore || c = prime || c = arobase) + not (starts_word it) && + not (ends_word it) && + (Glib.Unichar.isalnum c || c = underscore || c = prime || c = arobase) let is_on_word_limit it = inside_word it || ends_word it @@ -361,31 +365,31 @@ let rec find_word_end it = prerr_endline "Find word end"; if let c = it#char in c<>0 && is_word_char c then begin - ignore (it#nocopy#forward_char); - find_word_end it - end else (prerr_endline ("Word end at: "^(string_of_int it#offset));it) + ignore (it#nocopy#forward_char); + find_word_end it + end else (prerr_endline ("Word end at: "^(string_of_int it#offset));it) let find_word_end it = find_word_end it#copy let get_word_around it = let start = find_word_start it in let stop = find_word_end it in - start,stop + start,stop let rec complete_backward w (it:GText.iter) = prerr_endline "Complete backward..."; - match it#backward_search w with - | None -> (prerr_endline "backward_search failed";None) - | Some (start,stop) -> - prerr_endline ("complete_backward got a match:"^(string_of_int start#offset)^(string_of_int stop#offset)); - if starts_word start then - let ne = find_word_end stop in - if ne#compare stop = 0 - then complete_backward w start - else Some (start,stop,ne) - else complete_backward w start - + match it#backward_search w with + | None -> (prerr_endline "backward_search failed";None) + | Some (start,stop) -> + prerr_endline ("complete_backward got a match:"^(string_of_int start#offset)^(string_of_int stop#offset)); + if starts_word start then + let ne = find_word_end stop in + if ne#compare stop = 0 + then complete_backward w start + else Some (start,stop,ne) + else complete_backward w start + let rec complete_forward w (it:GText.iter) = prerr_endline "Complete forward..."; match it#forward_search w with @@ -393,16 +397,16 @@ let rec complete_forward w (it:GText.iter) = | Some (start,stop) -> if starts_word start then let ne = find_word_end stop in - if ne#compare stop = 0 then - complete_forward w stop - else Some (stop,stop,ne) + if ne#compare stop = 0 then + complete_forward w stop + else Some (stop,stop,ne) else complete_forward w stop (* Reset this to None on page change ! *) let (last_completion:(string*int*int*bool) option ref) = ref None let () = to_do_on_page_switch := - (fun i -> last_completion := None)::!to_do_on_page_switch + (fun i -> last_completion := None)::!to_do_on_page_switch let rec complete input_buffer w (offset:int) = match !last_completion with @@ -410,68 +414,68 @@ let rec complete input_buffer w (offset:int) = when lw=w && loffset=offset -> begin let iter = input_buffer#get_iter (`OFFSET lpos) in - if backward then - match complete_backward w iter with - | None -> - last_completion := - Some (lw,loffset, - (find_word_end - (input_buffer#get_iter (`OFFSET loffset)))#offset , - false); - None - | Some (ss,start,stop) as result -> - last_completion := - Some (w,offset,ss#offset,true); - result - else - match complete_forward w iter with - | None -> - last_completion := None; - None - | Some (ss,start,stop) as result -> - last_completion := - Some (w,offset,ss#offset,false); - result + if backward then + match complete_backward w iter with + | None -> + last_completion := + Some (lw,loffset, + (find_word_end + (input_buffer#get_iter (`OFFSET loffset)))#offset , + false); + None + | Some (ss,start,stop) as result -> + last_completion := + Some (w,offset,ss#offset,true); + result + else + match complete_forward w iter with + | None -> + last_completion := None; + None + | Some (ss,start,stop) as result -> + last_completion := + Some (w,offset,ss#offset,false); + result end | _ -> begin - match complete_backward w (input_buffer#get_iter (`OFFSET offset)) with - | None -> - last_completion := - Some (w,offset,(find_word_end (input_buffer#get_iter - (`OFFSET offset)))#offset,false); - complete input_buffer w offset - | Some (ss,start,stop) as result -> - last_completion := Some (w,offset,ss#offset,true); - result + match complete_backward w (input_buffer#get_iter (`OFFSET offset)) with + | None -> + last_completion := + Some (w,offset,(find_word_end (input_buffer#get_iter + (`OFFSET offset)))#offset,false); + complete input_buffer w offset + | Some (ss,start,stop) as result -> + last_completion := Some (w,offset,ss#offset,true); + result end - + let get_current_word () = let av = out_some ((get_current_view ()).analyzed_view) in - match GtkBase.Clipboard.wait_for_text (cb ())#as_clipboard with - | None -> - prerr_endline "None selected"; - let it = av#get_insert in - let start = find_word_start it in - let stop = find_word_end start in - av#view#buffer#move_mark `SEL_BOUND start; - av#view#buffer#move_mark `INSERT stop; - av#view#buffer#get_text ~slice:true ~start ~stop () - | Some t -> - prerr_endline "Some selected"; - prerr_endline t; - t - + match GtkBase.Clipboard.wait_for_text (cb ())#as_clipboard with + | None -> + prerr_endline "None selected"; + let it = av#get_insert in + let start = find_word_start it in + let stop = find_word_end start in + av#view#buffer#move_mark `SEL_BOUND start; + av#view#buffer#move_mark `INSERT stop; + av#view#buffer#get_text ~slice:true ~start ~stop () + | Some t -> + prerr_endline "Some selected"; + prerr_endline t; + t + let input_channel b ic = let buf = String.create 1024 and len = ref 0 in - while len := input ic buf 0 1024; !len > 0 do - Buffer.add_substring b buf 0 !len - done + while len := input ic buf 0 1024; !len > 0 do + Buffer.add_substring b buf 0 !len + done let with_file name ~f = let ic = open_in_gen [Open_rdonly;Open_creat] 0o644 name in - try f ic; close_in ic with exn -> - close_in ic; !flash_info ("Error: "^Printexc.to_string exn) + try f ic; close_in ic with exn -> + close_in ic; !flash_info ("Error: "^Printexc.to_string exn) type info = {start:GText.mark; stop:GText.mark; @@ -491,34 +495,34 @@ let is_empty () = Stack.is_empty processed_stack let update_on_end_of_proof id = let lookup_lemma = function - | { ast = _, ( VernacDefinition (_, _, ProveBody _, _) - | VernacDeclareTacticDefinition _ - | VernacStartTheoremProof _) ; - reset_info = Reset (_, r) } -> - if not !r then begin - prerr_endline "Toggling Reset info to true"; - r := true; raise Exit end - else begin - prerr_endline "Toggling Changing Reset id"; - r := false - end - | { ast = _, (VernacAbort _ | VernacAbortAll | VernacGoal _) } -> raise Exit - | _ -> () + | { ast = _, ( VernacDefinition (_, _, ProveBody _, _) + | VernacDeclareTacticDefinition _ + | VernacStartTheoremProof _) ; + reset_info = Reset (_, r) } -> + if not !r then begin + prerr_endline "Toggling Reset info to true"; + r := true; raise Exit end + else begin + prerr_endline "Toggling Changing Reset id"; + r := false + end + | { ast = _, (VernacAbort _ | VernacAbortAll | VernacGoal _) } -> raise Exit + | _ -> () in - try Stack.iter lookup_lemma processed_stack with Exit -> () + try Stack.iter lookup_lemma processed_stack with Exit -> () let update_on_end_of_segment id = let lookup_section = function | { ast = _, ( VernacBeginSection id' - | VernacDefineModule (_,id',_,_,None) - | VernacDeclareModule (_,id',_,_) - | VernacDeclareModuleType (id',_,None)); + | VernacDefineModule (_,id',_,_,None) + | VernacDeclareModule (_,id',_,_) + | VernacDeclareModuleType (id',_,None)); reset_info = Reset (_, r) } - when id = id' -> raise Exit + when id = id' -> raise Exit | { reset_info = Reset (_, r) } -> r := false | _ -> () in - try Stack.iter lookup_section processed_stack with Exit -> () + try Stack.iter lookup_section processed_stack with Exit -> () let push_phrase start_of_phrase_mark end_of_phrase_mark ast = let x = {start = start_of_phrase_mark; @@ -527,19 +531,19 @@ let push_phrase start_of_phrase_mark end_of_phrase_mark ast = reset_info = Coq.compute_reset_info (snd ast) } in - push x; - match snd ast with - | VernacEndProof (Proved (_, None)) -> update_on_end_of_proof () - | VernacEndSegment id -> update_on_end_of_segment id - | _ -> () + push x; + match snd ast with + | VernacEndProof (Proved (_, None)) -> update_on_end_of_proof () + | VernacEndSegment id -> update_on_end_of_segment id + | _ -> () let repush_phrase x = let x = { x with reset_info = Coq.compute_reset_info (snd x.ast) } in - push x; - match snd x.ast with - | VernacEndProof (Proved (_, None)) -> update_on_end_of_proof () - | VernacEndSegment id -> update_on_end_of_segment id - | _ -> () + push x; + match snd x.ast with + | VernacEndProof (Proved (_, None)) -> update_on_end_of_proof () + | VernacEndSegment id -> update_on_end_of_segment id + | _ -> () (* For electric handlers *) exception Found @@ -552,19 +556,19 @@ let activate_input i = | None -> () | Some n -> let a_v = out_some (Vector.get input_views n).analyzed_view in - a_v#deactivate (); - a_v#reset_initial + a_v#deactivate (); + a_v#reset_initial ); let activate_function = (out_some (Vector.get input_views i).analyzed_view)#activate in - activate_function (); - set_active_view i + activate_function (); + set_active_view i let warning msg = GToolbox.message_box ~title:"Warning" ~icon:(let img = GMisc.image () in - img#set_stock `DIALOG_WARNING; - img#set_icon_size `DIALOG; - img#coerce) + img#set_stock `DIALOG_WARNING; + img#set_icon_size `DIALOG; + img#coerce) msg @@ -595,10 +599,10 @@ object(self) method set_auto_complete t = auto_complete_on <- t method without_auto_complete : 'a 'b. ('a -> 'b) -> 'a -> 'b = fun f x -> let old = auto_complete_on in - self#set_auto_complete false; - let y = f x in - self#set_auto_complete old; - y + self#set_auto_complete false; + let y = f x in + self#set_auto_complete old; + y method add_detached_view (w:GWindow.window) = detached_views <- w::detached_views method remove_detached_view (w:GWindow.window) = @@ -614,99 +618,99 @@ object(self) method set_filename f = filename <- f; match f with - | Some f -> stats <- my_stat f - | None -> () + | Some f -> stats <- my_stat f + | None -> () method update_stats = match filename with - | Some f -> stats <- my_stat f - | _ -> () + | Some f -> stats <- my_stat f + | _ -> () method revert = match filename with - | Some f -> begin - let do_revert () = begin - !push_info "Reverting buffer"; - try - if is_active then self#reset_initial; - let b = Buffer.create 1024 in - with_file f ~f:(input_channel b); - let s = try_convert (Buffer.contents b) in - input_buffer#set_text s; - self#update_stats; - input_buffer#place_cursor input_buffer#start_iter; - input_buffer#set_modified false; - !pop_info (); - !flash_info "Buffer reverted"; - Highlight.highlight_all input_buffer; - with _ -> - !pop_info (); - !flash_info "Warning: could not revert buffer"; + | Some f -> begin + let do_revert () = begin + !push_info "Reverting buffer"; + try + if is_active then self#reset_initial; + let b = Buffer.create 1024 in + with_file f ~f:(input_channel b); + let s = try_convert (Buffer.contents b) in + input_buffer#set_text s; + self#update_stats; + input_buffer#place_cursor input_buffer#start_iter; + input_buffer#set_modified false; + !pop_info (); + !flash_info "Buffer reverted"; + Highlight.highlight_all input_buffer; + with _ -> + !pop_info (); + !flash_info "Warning: could not revert buffer"; + end + in + if input_buffer#modified then + match (GToolbox.question_box + ~title:"Modified buffer changed on disk" + ~buttons:["Revert from File"; + "Overwrite File"; + "Disable Auto Revert"] + ~default:0 + ~icon:(stock_to_widget `DIALOG_WARNING) + "Some unsaved buffers changed on disk" + ) + with 1 -> do_revert () + | 2 -> if self#save f then !flash_info "Overwritten" else + !flash_info "Could not overwrite file" + | _ -> + prerr_endline "Auto revert set to false"; + !current.global_auto_revert <- false; + disconnect_revert_timer () + else do_revert () end - in - if input_buffer#modified then - match (GToolbox.question_box - ~title:"Modified buffer changed on disk" - ~buttons:["Revert from File"; - "Overwrite File"; - "Disable Auto Revert"] - ~default:0 - ~icon:(stock_to_widget `DIALOG_WARNING) - "Some unsaved buffers changed on disk" - ) - with 1 -> do_revert () - | 2 -> if self#save f then !flash_info "Overwritten" else - !flash_info "Could not overwrite file" - | _ -> - prerr_endline "Auto revert set to false"; - !current.global_auto_revert <- false; - disconnect_revert_timer () - else do_revert () - end - | None -> () - + | None -> () + method save f = if try_export f (input_buffer#get_text ()) then begin - filename <- Some f; - input_buffer#set_modified false; - stats <- my_stat f; - (match self#auto_save_name with - | None -> () - | Some fn -> try Sys.remove fn with _ -> ()); - true - end + filename <- Some f; + input_buffer#set_modified false; + stats <- my_stat f; + (match self#auto_save_name with + | None -> () + | Some fn -> try Sys.remove fn with _ -> ()); + true + end else false method private auto_save_name = match filename with - | None -> None - | Some f -> - let dir = Filename.dirname f in - let base = (fst !current.auto_save_name) ^ - (Filename.basename f) ^ - (snd !current.auto_save_name) - in Some (Filename.concat dir base) - + | None -> None + | Some f -> + let dir = Filename.dirname f in + let base = (fst !current.auto_save_name) ^ + (Filename.basename f) ^ + (snd !current.auto_save_name) + in Some (Filename.concat dir base) + method private need_auto_save = input_buffer#modified && - last_modification_time > last_auto_save_time + last_modification_time > last_auto_save_time method auto_save = if self#need_auto_save then begin - match self#auto_save_name with - | None -> () - | Some fn -> - try - last_auto_save_time <- Unix.time(); - prerr_endline ("Autosave time : "^(string_of_float (Unix.time()))); - if try_export fn (input_buffer#get_text ()) then begin - !flash_info ~delay:1000 "Autosaved" - end - else warning - ("Autosave failed (check if " ^ fn ^ " is writable)") - with _ -> - warning ("Autosave: unexpected error while writing "^fn) - end + match self#auto_save_name with + | None -> () + | Some fn -> + try + last_auto_save_time <- Unix.time(); + prerr_endline ("Autosave time : "^(string_of_float (Unix.time()))); + if try_export fn (input_buffer#get_text ()) then begin + !flash_info ~delay:1000 "Autosaved" + end + else warning + ("Autosave failed (check if " ^ fn ^ " is writable)") + with _ -> + warning ("Autosave: unexpected error while writing "^fn) + end method save_as f = if Sys.file_exists f then @@ -716,13 +720,13 @@ object(self) ~default:1 ~icon: (let img = GMisc.image () in - img#set_stock `DIALOG_WARNING; - img#set_icon_size `DIALOG; - img#coerce) + img#set_stock `DIALOG_WARNING; + img#set_icon_size `DIALOG; + img#coerce) ("File "^f^"already exists") ) with 1 -> self#save f - | _ -> false + | _ -> false else self#save f method set_read_only b = read_only<-b @@ -749,10 +753,10 @@ object(self) PLUS : GTK BUG ??? Cannot be called from a thread... ADDITION: using sync instead of async causes deadlock...*) ignore (GtkThread.async ( - input_view#scroll_to_mark - ~use_align:false - ~yalign:0.75 - ~within_margin:0.25) + input_view#scroll_to_mark + ~use_align:false + ~yalign:0.75 + ~within_margin:0.25) `INSERT) @@ -761,73 +765,73 @@ object(self) let it = it#copy in let nb_sep = ref 0 in let continue = ref true in - while !continue do - if it#char = space then begin - incr nb_sep; - if not it#nocopy#forward_char then continue := false; - end else continue := false - done; - !nb_sep + while !continue do + if it#char = space then begin + incr nb_sep; + if not it#nocopy#forward_char then continue := false; + end else continue := false + done; + !nb_sep in let previous_line = self#get_insert in - if previous_line#nocopy#backward_line then begin - let previous_line_spaces = get_nb_space previous_line in - let current_line_start = self#get_insert#set_line_offset 0 in - let current_line_spaces = get_nb_space current_line_start in - if input_buffer#delete_interactive - ~start:current_line_start - ~stop:(current_line_start#forward_chars current_line_spaces) - () - then - let current_line_start = self#get_insert#set_line_offset 0 in - input_buffer#insert - ~iter:current_line_start - (String.make previous_line_spaces ' ') - end + if previous_line#nocopy#backward_line then begin + let previous_line_spaces = get_nb_space previous_line in + let current_line_start = self#get_insert#set_line_offset 0 in + let current_line_spaces = get_nb_space current_line_start in + if input_buffer#delete_interactive + ~start:current_line_start + ~stop:(current_line_start#forward_chars current_line_spaces) + () + then + let current_line_start = self#get_insert#set_line_offset 0 in + input_buffer#insert + ~iter:current_line_start + (String.make previous_line_spaces ' ') + end method show_goals = try proof_view#buffer#set_text ""; let s = Coq.get_current_goals () in - match s with - | [] -> proof_buffer#insert (Coq.print_no_goal ()) - | (hyps,concl)::r -> - let goal_nb = List.length s in - proof_buffer#insert (Printf.sprintf "%d subgoal%s\n" - goal_nb - (if goal_nb<=1 then "" else "s")); - List.iter - (fun ((_,_,_,(s,_)) as _hyp) -> - proof_buffer#insert (s^"\n")) - hyps; - proof_buffer#insert (String.make 38 '_' ^ "(1/"^ - (string_of_int goal_nb)^ - ")\n") - ; - let _,_,_,sconcl = concl in - proof_buffer#insert sconcl; - proof_buffer#insert "\n"; - let my_mark = `NAME "end_of_conclusion" in - proof_buffer#move_mark - ~where:((proof_buffer#get_iter_at_mark `INSERT)) my_mark; - proof_buffer#insert "\n\n"; - let i = ref 1 in - List.iter - (function (_,(_,_,_,concl)) -> - incr i; - proof_buffer#insert (String.make 38 '_' ^"("^ - (string_of_int !i)^ - "/"^ - (string_of_int goal_nb)^ - ")\n"); - proof_buffer#insert concl; - proof_buffer#insert "\n\n"; - ) - r; - ignore (proof_view#scroll_to_mark my_mark) - with e -> prerr_endline ("Don't worry be happy despite: "^Printexc.to_string e) - + match s with + | [] -> proof_buffer#insert (Coq.print_no_goal ()) + | (hyps,concl)::r -> + let goal_nb = List.length s in + proof_buffer#insert (Printf.sprintf "%d subgoal%s\n" + goal_nb + (if goal_nb<=1 then "" else "s")); + List.iter + (fun ((_,_,_,(s,_)) as _hyp) -> + proof_buffer#insert (s^"\n")) + hyps; + proof_buffer#insert (String.make 38 '_' ^ "(1/"^ + (string_of_int goal_nb)^ + ")\n") + ; + let _,_,_,sconcl = concl in + proof_buffer#insert sconcl; + proof_buffer#insert "\n"; + let my_mark = `NAME "end_of_conclusion" in + proof_buffer#move_mark + ~where:((proof_buffer#get_iter_at_mark `INSERT)) my_mark; + proof_buffer#insert "\n\n"; + let i = ref 1 in + List.iter + (function (_,(_,_,_,concl)) -> + incr i; + proof_buffer#insert (String.make 38 '_' ^"("^ + (string_of_int !i)^ + "/"^ + (string_of_int goal_nb)^ + ")\n"); + proof_buffer#insert concl; + proof_buffer#insert "\n\n"; + ) + r; + ignore (proof_view#scroll_to_mark my_mark) + with e -> prerr_endline ("Don't worry be happy despite: "^Printexc.to_string e) + val mutable full_goal_done = true @@ -839,145 +843,145 @@ object(self) let s = Coq.get_current_goals () in let last_shown_area = proof_buffer#create_tag [`BACKGROUND "light green"] in - match s with - | [] -> proof_buffer#insert (Coq.print_no_goal ()) - | (hyps,concl)::r -> - let goal_nb = List.length s in - proof_buffer#insert (Printf.sprintf "%d subgoal%s\n" - goal_nb - (if goal_nb<=1 then "" else "s")); - let coq_menu commands = - let tag = proof_buffer#create_tag [] - in - ignore - (tag#connect#event ~callback: - (fun ~origin ev it -> - begin match GdkEvent.get_type ev with - | `BUTTON_PRESS -> - let ev = (GdkEvent.Button.cast ev) in - if (GdkEvent.Button.button ev) = 3 - then begin - let loc_menu = GMenu.menu () in - let factory = new GMenu.factory loc_menu in - let add_coq_command (cp,ip) = - ignore - (factory#add_item cp - ~callback: - (fun () -> ignore - (self#insert_this_phrase_on_success - true - true - false - ("progress "^ip^"\n") - (ip^"\n")) - ) - ) - in - List.iter add_coq_command commands; - loc_menu#popup - ~button:3 - ~time:(GdkEvent.Button.time ev); - end - | `MOTION_NOTIFY -> - proof_buffer#remove_tag - ~start:proof_buffer#start_iter - ~stop:proof_buffer#end_iter - last_shown_area; - prerr_endline "Before find_tag_limits"; - - let s,e = find_tag_limits tag + match s with + | [] -> proof_buffer#insert (Coq.print_no_goal ()) + | (hyps,concl)::r -> + let goal_nb = List.length s in + proof_buffer#insert (Printf.sprintf "%d subgoal%s\n" + goal_nb + (if goal_nb<=1 then "" else "s")); + let coq_menu commands = + let tag = proof_buffer#create_tag [] + in + ignore + (tag#connect#event ~callback: + (fun ~origin ev it -> + begin match GdkEvent.get_type ev with + | `BUTTON_PRESS -> + let ev = (GdkEvent.Button.cast ev) in + if (GdkEvent.Button.button ev) = 3 + then begin + let loc_menu = GMenu.menu () in + let factory = new GMenu.factory loc_menu in + let add_coq_command (cp,ip) = + ignore + (factory#add_item cp + ~callback: + (fun () -> ignore + (self#insert_this_phrase_on_success + true + true + false + ("progress "^ip^"\n") + (ip^"\n")) + ) + ) + in + List.iter add_coq_command commands; + loc_menu#popup + ~button:3 + ~time:(GdkEvent.Button.time ev); + end + | `MOTION_NOTIFY -> + proof_buffer#remove_tag + ~start:proof_buffer#start_iter + ~stop:proof_buffer#end_iter + last_shown_area; + prerr_endline "Before find_tag_limits"; + + let s,e = find_tag_limits tag (new GText.iter it) - in - prerr_endline "After find_tag_limits"; - proof_buffer#apply_tag - ~start:s - ~stop:e - last_shown_area; - - prerr_endline "Applied tag"; - () - | _ -> () - end;false - ) - ); - tag - in - List.iter - (fun ((_,_,_,(s,_)) as hyp) -> - let tag = coq_menu (hyp_menu hyp) in - proof_buffer#insert ~tags:[tag] (s^"\n")) - hyps; - proof_buffer#insert - (String.make 38 '_' ^"(1/"^ - (string_of_int goal_nb)^ - ")\n") - ; - let tag = coq_menu (concl_menu concl) in - let _,_,_,sconcl = concl in - proof_buffer#insert ~tags:[tag] sconcl; - proof_buffer#insert "\n"; - let my_mark = `NAME "end_of_conclusion" in - proof_buffer#move_mark - ~where:((proof_buffer#get_iter_at_mark `INSERT)) my_mark; - proof_buffer#insert "\n\n"; - let i = ref 1 in - List.iter - (function (_,(_,_,_,concl)) -> - incr i; - proof_buffer#insert - (String.make 38 '_' ^"("^ - (string_of_int !i)^ - "/"^ - (string_of_int goal_nb)^ - ")\n"); - proof_buffer#insert concl; - proof_buffer#insert "\n\n"; - ) - r; - ignore (proof_view#scroll_to_mark my_mark) ; - full_goal_done <- true; - with e -> prerr_endline (Printexc.to_string e) + in + prerr_endline "After find_tag_limits"; + proof_buffer#apply_tag + ~start:s + ~stop:e + last_shown_area; + + prerr_endline "Applied tag"; + () + | _ -> () + end;false + ) + ); + tag + in + List.iter + (fun ((_,_,_,(s,_)) as hyp) -> + let tag = coq_menu (hyp_menu hyp) in + proof_buffer#insert ~tags:[tag] (s^"\n")) + hyps; + proof_buffer#insert + (String.make 38 '_' ^"(1/"^ + (string_of_int goal_nb)^ + ")\n") + ; + let tag = coq_menu (concl_menu concl) in + let _,_,_,sconcl = concl in + proof_buffer#insert ~tags:[tag] sconcl; + proof_buffer#insert "\n"; + let my_mark = `NAME "end_of_conclusion" in + proof_buffer#move_mark + ~where:((proof_buffer#get_iter_at_mark `INSERT)) my_mark; + proof_buffer#insert "\n\n"; + let i = ref 1 in + List.iter + (function (_,(_,_,_,concl)) -> + incr i; + proof_buffer#insert + (String.make 38 '_' ^"("^ + (string_of_int !i)^ + "/"^ + (string_of_int goal_nb)^ + ")\n"); + proof_buffer#insert concl; + proof_buffer#insert "\n\n"; + ) + r; + ignore (proof_view#scroll_to_mark my_mark) ; + full_goal_done <- true; + with e -> prerr_endline (Printexc.to_string e) end - + method send_to_coq verbosely replace phrase show_output show_error localize = let display_output msg = self#insert_message (if show_output then msg else "") in let display_error e = let (s,loc) = Coq.process_exn e in - assert (Glib.Utf8.validate s); - self#insert_message s; - message_view#misc#draw None; - if localize then - (match Util.option_app Util.unloc loc with - | None -> () - | Some (start,stop) -> - let convert_pos = byte_offset_to_char_offset phrase in - let start = convert_pos start in - let stop = convert_pos stop in - let i = self#get_start_of_input in - let starti = i#forward_chars start in - let stopi = i#forward_chars stop in - input_buffer#apply_tag_by_name "error" - ~start:starti - ~stop:stopi; - input_buffer#place_cursor starti) in - try - full_goal_done <- false; - prerr_endline "Send_to_coq starting now"; - if replace then begin - let r,info = Coq.interp_and_replace ("info " ^ phrase) in - let msg = read_stdout () in - sync display_output msg; - Some r - end else begin - let r = Coq.interp verbosely phrase in - let msg = read_stdout () in - sync display_output msg; - Some r - end - with e -> - if show_error then sync display_error e; - None + assert (Glib.Utf8.validate s); + self#insert_message s; + message_view#misc#draw None; + if localize then + (match Util.option_map Util.unloc loc with + | None -> () + | Some (start,stop) -> + let convert_pos = byte_offset_to_char_offset phrase in + let start = convert_pos start in + let stop = convert_pos stop in + let i = self#get_start_of_input in + let starti = i#forward_chars start in + let stopi = i#forward_chars stop in + input_buffer#apply_tag_by_name "error" + ~start:starti + ~stop:stopi; + input_buffer#place_cursor starti) in + try + full_goal_done <- false; + prerr_endline "Send_to_coq starting now"; + if replace then begin + let r,info = Coq.interp_and_replace ("info " ^ phrase) in + let msg = read_stdout () in + sync display_output msg; + Some r + end else begin + let r = Coq.interp verbosely phrase in + let msg = read_stdout () in + sync display_output msg; + Some r + end + with e -> + if show_error then sync display_error e; + None method find_phrase_starting_at (start:GText.iter) = prerr_endline "find_phrase_starting_at starting now"; @@ -986,107 +990,107 @@ object(self) let lexbuf_function s count = let i = ref 0 in let n_trash = String.length !trash_bytes in - String.blit !trash_bytes 0 s 0 n_trash; - i := n_trash; - try - while !i <= count - 1 do - let c = end_iter#char in - if c = 0 then raise (Stop !i); - let c' = Glib.Utf8.from_unichar c in - let n = String.length c' in - if (n<=0) then exit (-2); - if n > count - !i then - begin - let ri = count - !i in - String.blit c' 0 s !i ri; - trash_bytes := String.sub c' ri (n-ri); - i := count ; - end else begin - String.blit c' 0 s !i n; - i:= !i + n - end; - if not end_iter#nocopy#forward_char then - raise (Stop !i) - done; - count - with Stop x -> - x + String.blit !trash_bytes 0 s 0 n_trash; + i := n_trash; + try + while !i <= count - 1 do + let c = end_iter#char in + if c = 0 then raise (Stop !i); + let c' = Glib.Utf8.from_unichar c in + let n = String.length c' in + if (n<=0) then exit (-2); + if n > count - !i then + begin + let ri = count - !i in + String.blit c' 0 s !i ri; + trash_bytes := String.sub c' ri (n-ri); + i := count ; + end else begin + String.blit c' 0 s !i n; + i:= !i + n + end; + if not end_iter#nocopy#forward_char then + raise (Stop !i) + done; + count + with Stop x -> + x in - try - trash_bytes := ""; - let phrase = Find_phrase.get (Lexing.from_function lexbuf_function) - in - end_iter#nocopy#set_offset (start#offset + !Find_phrase.length); - Some (start,end_iter) - with -(* - | Find_phrase.EOF s -> - (* Phrase is at the end of the buffer*) - let si = start#offset in - let ei = si + !Find_phrase.length in - end_iter#nocopy#set_offset (ei - 1); - input_buffer#insert ~iter:end_iter "\n"; - Some (input_buffer#get_iter (`OFFSET si), - input_buffer#get_iter (`OFFSET ei)) -*) - | _ -> None + try + trash_bytes := ""; + let phrase = Find_phrase.get (Lexing.from_function lexbuf_function) + in + end_iter#nocopy#set_offset (start#offset + !Find_phrase.length); + Some (start,end_iter) + with + (* + | Find_phrase.EOF s -> + (* Phrase is at the end of the buffer*) + let si = start#offset in + let ei = si + !Find_phrase.length in + end_iter#nocopy#set_offset (ei - 1); + input_buffer#insert ~iter:end_iter "\n"; + Some (input_buffer#get_iter (`OFFSET si), + input_buffer#get_iter (`OFFSET ei)) + *) + | _ -> None method complete_at_offset (offset:int) = prerr_endline ("Completion at offset : " ^ string_of_int offset); let it () = input_buffer#get_iter (`OFFSET offset) in let iit = it () in let start = find_word_start iit in - if ends_word iit then - let w = input_buffer#get_text - ~start - ~stop:iit - () - in - if String.length w <> 0 then begin - prerr_endline ("Completion of prefix : '" ^ w^"'"); - match complete input_buffer w start#offset with - | None -> false - | Some (ss,start,stop) -> - let completion = input_buffer#get_text ~start ~stop () in - ignore (input_buffer#delete_selection ()); - ignore (input_buffer#insert_interactive completion); - input_buffer#move_mark `SEL_BOUND (it())#backward_char; - true - end else false - else false + if ends_word iit then + let w = input_buffer#get_text + ~start + ~stop:iit + () + in + if String.length w <> 0 then begin + prerr_endline ("Completion of prefix : '" ^ w^"'"); + match complete input_buffer w start#offset with + | None -> false + | Some (ss,start,stop) -> + let completion = input_buffer#get_text ~start ~stop () in + ignore (input_buffer#delete_selection ()); + ignore (input_buffer#insert_interactive completion); + input_buffer#move_mark `SEL_BOUND (it())#backward_char; + true + end else false + else false - + method process_next_phrase verbosely display_goals do_highlight = let get_next_phrase () = self#clear_message; prerr_endline "process_next_phrase starting now"; if do_highlight then begin - !push_info "Coq is computing"; - input_view#set_editable false; - end; + !push_info "Coq is computing"; + input_view#set_editable false; + end; match self#find_phrase_starting_at self#get_start_of_input with | None -> if do_highlight then begin - input_view#set_editable true; - !pop_info (); - end; + input_view#set_editable true; + !pop_info (); + end; None | Some(start,stop) -> prerr_endline "process_next_phrase : to_process highlight"; if do_highlight then begin - input_buffer#apply_tag_by_name ~start ~stop "to_process"; - prerr_endline "process_next_phrase : to_process applied"; - end; + input_buffer#apply_tag_by_name ~start ~stop "to_process"; + prerr_endline "process_next_phrase : to_process applied"; + end; prerr_endline "process_next_phrase : getting phrase"; Some((start,stop),start#get_slice ~stop) in - let remove_tag (start,stop) = - if do_highlight then begin + let remove_tag (start,stop) = + if do_highlight then begin input_buffer#remove_tag_by_name ~start ~stop "to_process" ; input_view#set_editable true; !pop_info (); end in - let mark_processed (start,stop) ast = - let b = input_buffer in + let mark_processed (start,stop) ast = + let b = input_buffer in b#move_mark ~where:stop (`NAME "start_of_input"); b#apply_tag_by_name "processed" ~start ~stop; if (self#get_insert#compare) stop <= 0 then @@ -1096,109 +1100,109 @@ object(self) end; let start_of_phrase_mark = `MARK (b#create_mark start) in let end_of_phrase_mark = `MARK (b#create_mark stop) in - push_phrase - start_of_phrase_mark - end_of_phrase_mark ast; - if display_goals then self#show_goals; - remove_tag (start,stop) in + push_phrase + start_of_phrase_mark + end_of_phrase_mark ast; + if display_goals then self#show_goals; + remove_tag (start,stop) in begin match sync get_next_phrase () with None -> false | Some (loc,phrase) -> - (match self#send_to_coq verbosely false phrase true true true with - | Some ast -> sync (mark_processed loc) ast; true - | None -> sync remove_tag loc; false) + (match self#send_to_coq verbosely false phrase true true true with + | Some ast -> sync (mark_processed loc) ast; true + | None -> sync remove_tag loc; false) end - + method insert_this_phrase_on_success show_output show_msg localize coqphrase insertphrase = let mark_processed ast = let stop = self#get_start_of_input in - if stop#starts_line then - input_buffer#insert ~iter:stop insertphrase - else input_buffer#insert ~iter:stop ("\n"^insertphrase); - let start = self#get_start_of_input in - input_buffer#move_mark ~where:stop (`NAME "start_of_input"); - input_buffer#apply_tag_by_name "processed" ~start ~stop; - if (self#get_insert#compare) stop <= 0 then - input_buffer#place_cursor stop; - let start_of_phrase_mark = `MARK (input_buffer#create_mark start) in - let end_of_phrase_mark = `MARK (input_buffer#create_mark stop) in - push_phrase start_of_phrase_mark end_of_phrase_mark ast; - self#show_goals; - (*Auto insert save on success... - try (match Coq.get_current_goals () with - | [] -> - (match self#send_to_coq "Save.\n" true true true with + if stop#starts_line then + input_buffer#insert ~iter:stop insertphrase + else input_buffer#insert ~iter:stop ("\n"^insertphrase); + let start = self#get_start_of_input in + input_buffer#move_mark ~where:stop (`NAME "start_of_input"); + input_buffer#apply_tag_by_name "processed" ~start ~stop; + if (self#get_insert#compare) stop <= 0 then + input_buffer#place_cursor stop; + let start_of_phrase_mark = `MARK (input_buffer#create_mark start) in + let end_of_phrase_mark = `MARK (input_buffer#create_mark stop) in + push_phrase start_of_phrase_mark end_of_phrase_mark ast; + self#show_goals; + (*Auto insert save on success... + try (match Coq.get_current_goals () with + | [] -> + (match self#send_to_coq "Save.\n" true true true with | Some ast -> - begin - let stop = self#get_start_of_input in - if stop#starts_line then - input_buffer#insert ~iter:stop "Save.\n" - else input_buffer#insert ~iter:stop "\nSave.\n"; - let start = self#get_start_of_input in - input_buffer#move_mark ~where:stop (`NAME"start_of_input"); - input_buffer#apply_tag_by_name "processed" ~start ~stop; - if (self#get_insert#compare) stop <= 0 then - input_buffer#place_cursor stop; - let start_of_phrase_mark = - `MARK (input_buffer#create_mark start) in - let end_of_phrase_mark = - `MARK (input_buffer#create_mark stop) in - push_phrase start_of_phrase_mark end_of_phrase_mark ast - end + begin + let stop = self#get_start_of_input in + if stop#starts_line then + input_buffer#insert ~iter:stop "Save.\n" + else input_buffer#insert ~iter:stop "\nSave.\n"; + let start = self#get_start_of_input in + input_buffer#move_mark ~where:stop (`NAME"start_of_input"); + input_buffer#apply_tag_by_name "processed" ~start ~stop; + if (self#get_insert#compare) stop <= 0 then + input_buffer#place_cursor stop; + let start_of_phrase_mark = + `MARK (input_buffer#create_mark start) in + let end_of_phrase_mark = + `MARK (input_buffer#create_mark stop) in + push_phrase start_of_phrase_mark end_of_phrase_mark ast + end | None -> ()) - | _ -> ()) - with _ -> ()*) in - match self#send_to_coq false false coqphrase show_output show_msg localize with - | Some ast -> sync mark_processed ast; true - | None -> - sync - (fun _ -> self#insert_message ("Unsuccessfully tried: "^coqphrase)) - (); - false + | _ -> ()) + with _ -> ()*) in + match self#send_to_coq false false coqphrase show_output show_msg localize with + | Some ast -> sync mark_processed ast; true + | None -> + sync + (fun _ -> self#insert_message ("Unsuccessfully tried: "^coqphrase)) + (); + false method process_until_iter_or_error stop = let stop' = `OFFSET stop#offset in let start = self#get_start_of_input#copy in let start' = `OFFSET start#offset in - sync (fun _ -> - input_buffer#apply_tag_by_name ~start ~stop "to_process"; - input_view#set_editable false) (); - !push_info "Coq is computing"; - (try - while ((stop#compare self#get_start_of_input>=0) - && (self#process_next_phrase false false false)) - do Util.check_for_interrupt () done - with Sys.Break -> - prerr_endline "Interrupted during process_until_iter_or_error"); - sync (fun _ -> - self#show_goals; - (* Start and stop might be invalid if an eol was added at eof *) - let start = input_buffer#get_iter start' in - let stop = input_buffer#get_iter stop' in - input_buffer#remove_tag_by_name ~start ~stop "to_process" ; - input_view#set_editable true) (); - !pop_info() + sync (fun _ -> + input_buffer#apply_tag_by_name ~start ~stop "to_process"; + input_view#set_editable false) (); + !push_info "Coq is computing"; + (try + while ((stop#compare self#get_start_of_input>=0) + && (self#process_next_phrase false false false)) + do Util.check_for_interrupt () done + with Sys.Break -> + prerr_endline "Interrupted during process_until_iter_or_error"); + sync (fun _ -> + self#show_goals; + (* Start and stop might be invalid if an eol was added at eof *) + let start = input_buffer#get_iter start' in + let stop = input_buffer#get_iter stop' in + input_buffer#remove_tag_by_name ~start ~stop "to_process" ; + input_view#set_editable true) (); + !pop_info() method process_until_end_or_error = self#process_until_iter_or_error input_buffer#end_iter method reset_initial = sync (fun _ -> - Stack.iter - (function inf -> - let start = input_buffer#get_iter_at_mark inf.start in - let stop = input_buffer#get_iter_at_mark inf.stop in - input_buffer#move_mark ~where:start (`NAME "start_of_input"); - input_buffer#remove_tag_by_name "processed" ~start ~stop; - input_buffer#delete_mark inf.start; - input_buffer#delete_mark inf.stop; - ) - processed_stack; - Stack.clear processed_stack; - self#clear_message)(); - Coq.reset_initial () + Stack.iter + (function inf -> + let start = input_buffer#get_iter_at_mark inf.start in + let stop = input_buffer#get_iter_at_mark inf.stop in + input_buffer#move_mark ~where:start (`NAME "start_of_input"); + input_buffer#remove_tag_by_name "processed" ~start ~stop; + input_buffer#delete_mark inf.start; + input_buffer#delete_mark inf.stop; + ) + processed_stack; + Stack.clear processed_stack; + self#clear_message)(); + Coq.reset_initial () (* backtrack Coq to the phrase preceding iterator [i] *) @@ -1209,65 +1213,65 @@ object(self) if is_empty () then Coq.reset_initial () else begin - let t = pop () in - begin match t.reset_info with - | Reset (id, ({contents=true} as v)) -> v:=false; - (match snd t.ast with - | VernacBeginSection _ | VernacDefineModule _ - | VernacDeclareModule _ | VernacDeclareModuleType _ - | VernacEndSegment _ - -> reset_to_mod id - | _ -> reset_to id) - | _ -> synchro () - end; - interp_last t.ast; - repush_phrase t - end + let t = pop () in + begin match t.reset_info with + | Reset (id, ({contents=true} as v)) -> v:=false; + (match snd t.ast with + | VernacBeginSection _ | VernacDefineModule _ + | VernacDeclareModule _ | VernacDeclareModuleType _ + | VernacEndSegment _ + -> reset_to_mod id + | _ -> reset_to id) + | _ -> synchro () + end; + interp_last t.ast; + repush_phrase t + end in let add_undo t = match t with | Some n -> Some (succ n) | None -> None in - (* pop Coq commands until we reach iterator [i] *) + (* pop Coq commands until we reach iterator [i] *) let rec pop_commands done_smthg undos = if is_empty () then done_smthg, undos else let t = top () in - if i#compare (input_buffer#get_iter_at_mark t.stop) < 0 then begin - ignore (pop ()); - let undos = if is_tactic (snd t.ast) then add_undo undos else None in - pop_commands true undos - end else - done_smthg, undos + if i#compare (input_buffer#get_iter_at_mark t.stop) < 0 then begin + ignore (pop ()); + let undos = if is_tactic (snd t.ast) then add_undo undos else None in + pop_commands true undos + end else + done_smthg, undos in let done_smthg, undos = pop_commands false (Some 0) in - prerr_endline "Popped commands"; - if done_smthg then - begin - try - (match undos with - | None -> synchro () - | Some n -> try Pfedit.undo n with _ -> synchro ()); - sync (fun _ -> - let start = - if is_empty () then input_buffer#start_iter - else input_buffer#get_iter_at_mark (top ()).stop in - prerr_endline "Removing (long) processed tag..."; - input_buffer#remove_tag_by_name - ~start - ~stop:self#get_start_of_input - "processed"; - prerr_endline "Moving (long) start_of_input..."; - input_buffer#move_mark ~where:start (`NAME "start_of_input"); - self#show_goals; - clear_stdout (); - self#clear_message) - (); - with _ -> - !push_info "WARNING: undo failed badly -> Coq might be in an inconsistent state. + prerr_endline "Popped commands"; + if done_smthg then + begin + try + (match undos with + | None -> synchro () + | Some n -> try Pfedit.undo n with _ -> synchro ()); + sync (fun _ -> + let start = + if is_empty () then input_buffer#start_iter + else input_buffer#get_iter_at_mark (top ()).stop in + prerr_endline "Removing (long) processed tag..."; + input_buffer#remove_tag_by_name + ~start + ~stop:self#get_start_of_input + "processed"; + prerr_endline "Moving (long) start_of_input..."; + input_buffer#move_mark ~where:start (`NAME "start_of_input"); + self#show_goals; + clear_stdout (); + self#clear_message) + (); + with _ -> + !push_info "WARNING: undo failed badly -> Coq might be in an inconsistent state. Please restart and report NOW."; - end - else prerr_endline "backtrack_to : discarded (...)" - + end + else prerr_endline "backtrack_to : discarded (...)" + method backtrack_to i = if Mutex.try_lock coq_may_stop then (!push_info "Undoing...";self#backtrack_to_no_lock i ; Mutex.unlock coq_may_stop; @@ -1276,68 +1280,68 @@ Please restart and report NOW."; method go_to_insert = let point = self#get_insert in - if point#compare self#get_start_of_input>=0 - then self#process_until_iter_or_error point - else self#backtrack_to point + if point#compare self#get_start_of_input>=0 + then self#process_until_iter_or_error point + else self#backtrack_to point method undo_last_step = if Mutex.try_lock coq_may_stop then (!push_info "Undoing last step..."; (try - let last_command = top () in - let start = input_buffer#get_iter_at_mark last_command.start in - let update_input () = - prerr_endline "Removing processed tag..."; - input_buffer#remove_tag_by_name - ~start - ~stop:(input_buffer#get_iter_at_mark last_command.stop) - "processed"; - prerr_endline "Moving start_of_input"; - input_buffer#move_mark - ~where:start - (`NAME "start_of_input"); - input_buffer#place_cursor start; - self#recenter_insert; - self#show_goals; - self#clear_message - in - begin match last_command with - | {ast=_, (VernacSolve _ | VernacTime (VernacSolve _))} -> - begin - try Pfedit.undo 1; ignore (pop ()); sync update_input () - with _ -> self#backtrack_to_no_lock start - end - | {ast=_,t;reset_info=Reset (id, {contents=true})} -> - ignore (pop ()); - (match t with - | VernacBeginSection _ | VernacDefineModule _ - | VernacDeclareModule _ | VernacDeclareModuleType _ - | VernacEndSegment _ - -> reset_to_mod id - | _ -> reset_to id); - sync update_input () - | { ast = _, ( VernacStartTheoremProof _ - | VernacGoal _ - | VernacDeclareTacticDefinition _ - | VernacDefinition (_,_,ProveBody _,_)); - reset_info=Reset(id,{contents=false})} -> - ignore (pop ()); - (try - Pfedit.delete_current_proof () - with e -> - begin - prerr_endline "WARNING : found a closed environment"; - raise e - end); - sync update_input () - | { ast = (_, a) } when is_state_preserving a -> - ignore (pop ()); - sync update_input () - | _ -> - self#backtrack_to_no_lock start - end; + let last_command = top () in + let start = input_buffer#get_iter_at_mark last_command.start in + let update_input () = + prerr_endline "Removing processed tag..."; + input_buffer#remove_tag_by_name + ~start + ~stop:(input_buffer#get_iter_at_mark last_command.stop) + "processed"; + prerr_endline "Moving start_of_input"; + input_buffer#move_mark + ~where:start + (`NAME "start_of_input"); + input_buffer#place_cursor start; + self#recenter_insert; + self#show_goals; + self#clear_message + in + begin match last_command with + | {ast=_, (VernacSolve _ | VernacTime (VernacSolve _))} -> + begin + try Pfedit.undo 1; ignore (pop ()); sync update_input () + with _ -> self#backtrack_to_no_lock start + end + | {ast=_,t;reset_info=Reset (id, {contents=true})} -> + ignore (pop ()); + (match t with + | VernacBeginSection _ | VernacDefineModule _ + | VernacDeclareModule _ | VernacDeclareModuleType _ + | VernacEndSegment _ + -> reset_to_mod id + | _ -> reset_to id); + sync update_input () + | { ast = _, ( VernacStartTheoremProof _ + | VernacGoal _ + | VernacDeclareTacticDefinition _ + | VernacDefinition (_,_,ProveBody _,_)); + reset_info=Reset(id,{contents=false})} -> + ignore (pop ()); + (try + Pfedit.delete_current_proof () + with e -> + begin + prerr_endline "WARNING : found a closed environment"; + raise e + end); + sync update_input () + | { ast = (_, a) } when is_state_preserving a -> + ignore (pop ()); + sync update_input () + | _ -> + self#backtrack_to_no_lock start + end; with - | Size 0 -> (* !flash_info "Nothing to Undo"*)() + | Size 0 -> (* !flash_info "Nothing to Undo"*)() ); !pop_info (); Mutex.unlock coq_may_stop) @@ -1350,46 +1354,46 @@ Please restart and report NOW."; (fun () -> prerr_endline "Blaster called"; let c = Blaster_window.present_blaster_window () in - if Mutex.try_lock c#lock then begin - c#clear (); - let current_gls = try get_current_goals () with _ -> [] in - - let set_goal i (s,t) = - let gnb = string_of_int i in - let s = gnb ^":"^s in - let t' = gnb ^": progress "^t in - let t'' = gnb ^": "^t in - c#set - ("Goal "^gnb) - s - (fun () -> try_interptac t') - (sync(fun () -> self#insert_command t'' t'')) - in - let set_current_goal (s,t) = - c#set - "Goal 1" - s - (fun () -> try_interptac ("progress "^t)) - (sync(fun () -> self#insert_command t t)) - in - begin match current_gls with - | [] -> () - | (hyp_l,current_gl)::r -> - List.iter set_current_goal (concl_menu current_gl); - List.iter - (fun hyp -> - List.iter set_current_goal (hyp_menu hyp)) - hyp_l; - let i = ref 2 in - List.iter - (fun (hyp_l,gl) -> - List.iter (set_goal !i) (concl_menu gl); - incr i) - r - end; - let _ = c#blaster () in - Mutex.unlock c#lock - end else prerr_endline "Blaster discarded") + if Mutex.try_lock c#lock then begin + c#clear (); + let current_gls = try get_current_goals () with _ -> [] in + + let set_goal i (s,t) = + let gnb = string_of_int i in + let s = gnb ^":"^s in + let t' = gnb ^": progress "^t in + let t'' = gnb ^": "^t in + c#set + ("Goal "^gnb) + s + (fun () -> try_interptac t') + (sync(fun () -> self#insert_command t'' t'')) + in + let set_current_goal (s,t) = + c#set + "Goal 1" + s + (fun () -> try_interptac ("progress "^t)) + (sync(fun () -> self#insert_command t t)) + in + begin match current_gls with + | [] -> () + | (hyp_l,current_gl)::r -> + List.iter set_current_goal (concl_menu current_gl); + List.iter + (fun hyp -> + List.iter set_current_goal (hyp_menu hyp)) + hyp_l; + let i = ref 2 in + List.iter + (fun (hyp_l,gl) -> + List.iter (set_goal !i) (concl_menu gl); + incr i) + r + end; + let _ = c#blaster () in + Mutex.unlock c#lock + end else prerr_endline "Blaster discarded") ()) method insert_command cp ip = @@ -1403,43 +1407,43 @@ Please restart and report NOW."; (fun p -> self#insert_this_phrase_on_success true false false ("progress "^p^".\n") (p^".\n")) l) - + method active_keypress_handler k = let state = GdkEvent.Key.state k in - begin - match state with - | l when List.mem `MOD1 l -> - let k = GdkEvent.Key.keyval k in - if GdkKeysyms._Return=k - then ignore( - if (input_buffer#insert_interactive "\n") then - begin - let i= self#get_insert#backward_word_start in - prerr_endline "active_kp_hf: Placing cursor"; - self#process_until_iter_or_error i - end); - true - | l when List.mem `CONTROL l -> - let k = GdkEvent.Key.keyval k in - if GdkKeysyms._Break=k - then break (); - false - | l -> - if GdkEvent.Key.keyval k = GdkKeysyms._Tab then begin - prerr_endline "active_kp_handler for Tab"; - self#indent_current_line; - true - end else false - end + begin + match state with + | l when List.mem `MOD1 l -> + let k = GdkEvent.Key.keyval k in + if GdkKeysyms._Return=k + then ignore( + if (input_buffer#insert_interactive "\n") then + begin + let i= self#get_insert#backward_word_start in + prerr_endline "active_kp_hf: Placing cursor"; + self#process_until_iter_or_error i + end); + true + | l when List.mem `CONTROL l -> + let k = GdkEvent.Key.keyval k in + if GdkKeysyms._Break=k + then break (); + false + | l -> + if GdkEvent.Key.keyval k = GdkKeysyms._Tab then begin + prerr_endline "active_kp_handler for Tab"; + self#indent_current_line; + true + end else false + end method disconnected_keypress_handler k = match GdkEvent.Key.state k with - | l when List.mem `CONTROL l -> - let k = GdkEvent.Key.keyval k in - if GdkKeysyms._c=k - then break (); - false - | l -> false - + | l when List.mem `CONTROL l -> + let k = GdkEvent.Key.keyval k in + if GdkKeysyms._c=k + then break (); + false + | l -> false + val mutable deact_id = None val mutable act_id = None @@ -1447,11 +1451,11 @@ Please restart and report NOW."; method deactivate () = is_active <- false; (match act_id with None -> () - | Some id -> - reset_initial (); - input_view#misc#disconnect id; - prerr_endline "DISCONNECTED old active : "; - print_id id; + | Some id -> + reset_initial (); + input_view#misc#disconnect id; + prerr_endline "DISCONNECTED old active : "; + print_id id; ); deact_id <- Some (input_view#event#connect#key_press self#disconnected_keypress_handler); @@ -1461,9 +1465,9 @@ Please restart and report NOW."; method activate () = is_active <- true; (match deact_id with None -> () - | Some id -> input_view#misc#disconnect id; - prerr_endline "DISCONNECTED old inactive : "; - print_id id + | Some id -> input_view#misc#disconnect id; + prerr_endline "DISCONNECTED old inactive : "; + print_id id ); act_id <- Some (input_view#event#connect#key_press self#active_keypress_handler); @@ -1473,65 +1477,62 @@ Please restart and report NOW."; (out_some ((Vector.get input_views index).analyzed_view)) #filename with | None -> () - | Some f -> - if not (is_in_coq_path f) then - begin - let dir = Filename.dirname f in - ignore (Coq.interp false - (Printf.sprintf "Add LoadPath \"%s\". " dir)) - end - - - + | Some f -> let dir = Filename.dirname f in + if not (is_in_loadpath dir) then + begin + ignore (Coq.interp false + (Printf.sprintf "Add LoadPath \"%s\". " dir)) + end + method electric_handler = input_buffer#connect#insert_text ~callback: (fun it x -> begin try - if last_index then begin - last_array.(0)<-x; - if (last_array.(1) ^ last_array.(0) = ".\n") then raise Found - end else begin - last_array.(1)<-x; - if (last_array.(0) ^ last_array.(1) = ".\n") then raise Found - end - with Found -> - begin - ignore (self#process_next_phrase false true true) - end; + if last_index then begin + last_array.(0)<-x; + if (last_array.(1) ^ last_array.(0) = ".\n") then raise Found + end else begin + last_array.(1)<-x; + if (last_array.(0) ^ last_array.(1) = ".\n") then raise Found + end + with Found -> + begin + ignore (self#process_next_phrase false true true) + end; end; last_index <- not last_index;) method private electric_paren tag = let oparen_code = Glib.Utf8.to_unichar "(" (ref 0) in let cparen_code = Glib.Utf8.to_unichar ")" (ref 0) in - ignore (input_buffer#connect#insert_text ~callback: - (fun it x -> - input_buffer#remove_tag - ~start:input_buffer#start_iter - ~stop:input_buffer#end_iter - tag; - if x = "" then () else - match x.[String.length x - 1] with - | ')' -> - let hit = self#get_insert in - let count = ref 0 in - if hit#nocopy#backward_find_char - (fun c -> - if c = oparen_code && !count = 0 then true - else if c = cparen_code then - (incr count;false) - else if c = oparen_code then - (decr count;false) - else false - ) - then - begin - prerr_endline "Found matching parenthesis"; - input_buffer#apply_tag tag ~start:hit ~stop:hit#forward_char - end - else () - | _ -> ()) - ) + ignore (input_buffer#connect#insert_text ~callback: + (fun it x -> + input_buffer#remove_tag + ~start:input_buffer#start_iter + ~stop:input_buffer#end_iter + tag; + if x = "" then () else + match x.[String.length x - 1] with + | ')' -> + let hit = self#get_insert in + let count = ref 0 in + if hit#nocopy#backward_find_char + (fun c -> + if c = oparen_code && !count = 0 then true + else if c = cparen_code then + (incr count;false) + else if c = oparen_code then + (decr count;false) + else false + ) + then + begin + prerr_endline "Found matching parenthesis"; + input_buffer#apply_tag tag ~start:hit ~stop:hit#forward_char + end + else () + | _ -> ()) + ) method help_for_keyword () = @@ -1561,33 +1562,33 @@ Please restart and report NOW."; ) ); ignore (input_buffer#connect#after#insert_text - ~callback:(fun it s -> - if auto_complete_on && - String.length s = 1 && s <> " " && s <> "\n" - then - let v = out_some (get_current_view ()).analyzed_view - in - let has_completed = - v#complete_at_offset - ((v#view#buffer#get_iter `SEL_BOUND)#offset) - in + ~callback:(fun it s -> + if auto_complete_on && + String.length s = 1 && s <> " " && s <> "\n" + then + let v = out_some (get_current_view ()).analyzed_view + in + let has_completed = + v#complete_at_offset + ((v#view#buffer#get_iter `SEL_BOUND)#offset) + in if has_completed then input_buffer#move_mark `SEL_BOUND (input_buffer#get_iter `SEL_BOUND)#forward_char; - - ) - ); - ignore (input_buffer#connect#modified_changed - ~callback: - (fun () -> - if input_buffer#modified then - set_tab_image index - ~icon:(match (out_some (current_all.analyzed_view))#filename with - | None -> `SAVE_AS - | Some _ -> `SAVE - ) - else set_tab_image index ~icon:`YES; - )); + + ) + ); + ignore (input_buffer#connect#modified_changed + ~callback: + (fun () -> + if input_buffer#modified then + set_tab_image index + ~icon:(match (out_some (current_all.analyzed_view))#filename with + | None -> `SAVE_AS + | Some _ -> `SAVE + ) + else set_tab_image index ~icon:`YES; + )); ignore (input_buffer#connect#changed ~callback:(fun () -> last_modification_time <- Unix.time (); @@ -1597,40 +1598,40 @@ Please restart and report NOW."; ~x:(Gdk.Rectangle.x r + Gdk.Rectangle.width r) ~y:(Gdk.Rectangle.y r + Gdk.Rectangle.height r) in - input_buffer#remove_tag_by_name - ~start:self#get_start_of_input - ~stop - "error"; - Highlight.highlight_around_current_line - input_buffer + input_buffer#remove_tag_by_name + ~start:self#get_start_of_input + ~stop + "error"; + Highlight.highlight_around_current_line + input_buffer ) ); ignore (input_buffer#add_selection_clipboard (cb())); let paren_highlight_tag = input_buffer#create_tag ~name:"paren" [`BACKGROUND "purple"] in - self#electric_paren paren_highlight_tag; - ignore (input_buffer#connect#after#mark_set - ~callback:(fun it (m:Gtk.text_mark) -> - !set_location - (Printf.sprintf - "Line: %5d Char: %3d" (self#get_insert#line + 1) - (self#get_insert#line_offset + 1)); - match GtkText.Mark.get_name m with - | Some "insert" -> - input_buffer#remove_tag - ~start:input_buffer#start_iter - ~stop:input_buffer#end_iter - paren_highlight_tag; - | Some s -> - prerr_endline (s^" moved") - | None -> () ) - ); - ignore (input_buffer#connect#insert_text - (fun it s -> - prerr_endline "Should recenter ?"; - if String.contains s '\n' then begin - prerr_endline "Should recenter : yes"; - self#recenter_insert - end)) + self#electric_paren paren_highlight_tag; + ignore (input_buffer#connect#after#mark_set + ~callback:(fun it (m:Gtk.text_mark) -> + !set_location + (Printf.sprintf + "Line: %5d Char: %3d" (self#get_insert#line + 1) + (self#get_insert#line_offset + 1)); + match GtkText.Mark.get_name m with + | Some "insert" -> + input_buffer#remove_tag + ~start:input_buffer#start_iter + ~stop:input_buffer#end_iter + paren_highlight_tag; + | Some s -> + prerr_endline (s^" moved") + | None -> () ) + ); + ignore (input_buffer#connect#insert_text + (fun it s -> + prerr_endline "Should recenter ?"; + if String.contains s '\n' then begin + prerr_endline "Should recenter : yes"; + self#recenter_insert + end)) end let create_input_tab filename = @@ -1640,63 +1641,63 @@ let create_input_tab filename = let image = GMisc.image ~packing:v_box#pack () in let label = GMisc.label ~text:filename ~packing:v_box#pack () in let fr1 = GBin.frame ~shadow_type:`ETCHED_OUT - ~packing:((notebook ())#append_page - ~tab_label:v_box#coerce) () + ~packing:((notebook ())#append_page + ~tab_label:v_box#coerce) () in let sw1 = GBin.scrolled_window - ~vpolicy:`AUTOMATIC - ~hpolicy:`AUTOMATIC - ~packing:fr1#add () + ~vpolicy:`AUTOMATIC + ~hpolicy:`AUTOMATIC + ~packing:fr1#add () in let tv1 = Undo.undoable_view ~buffer:b ~packing:(sw1#add) () in - prerr_endline ("Language: "^ b#start_iter#language); - tv1#misc#set_name "ScriptWindow"; - let _ = tv1#set_editable true in - let _ = tv1#set_wrap_mode `NONE in - b#place_cursor ~where:(b#start_iter); - ignore (tv1#event#connect#button_press ~callback: - (fun ev -> GdkEvent.Button.button ev = 3)); -(* ignore (tv1#event#connect#button_press ~callback: - (fun ev -> - if (GdkEvent.Button.button ev=2) then - (try - prerr_endline "Paste invoked"; - GtkSignal.emit_unit - (get_current_view()).view#as_view - GtkText.View.Signals.paste_clipboard; - true - with _ -> false) - else false - ));*) - tv1#misc#grab_focus (); - ignore (tv1#buffer#create_mark - ~name:"start_of_input" - tv1#buffer#start_iter); - ignore (tv1#buffer#create_tag - ~name:"kwd" - [`FOREGROUND "blue"]); - ignore (tv1#buffer#create_tag - ~name:"decl" - [`FOREGROUND "orange red"]); - ignore (tv1#buffer#create_tag - ~name:"comment" - [`FOREGROUND "brown"]); - ignore (tv1#buffer#create_tag - ~name:"reserved" - [`FOREGROUND "dark red"]); - ignore (tv1#buffer#create_tag - ~name:"error" - [`UNDERLINE `DOUBLE ; `FOREGROUND "red"]); - ignore (tv1#buffer#create_tag - ~name:"to_process" - [`BACKGROUND "light blue" ;`EDITABLE false]); - ignore (tv1#buffer#create_tag - ~name:"processed" - [`BACKGROUND "light green" ;`EDITABLE false]); - ignore (tv1#buffer#create_tag - ~name:"found" - [`BACKGROUND "blue"; `FOREGROUND "white"]); - tv1 + prerr_endline ("Language: "^ b#start_iter#language); + tv1#misc#set_name "ScriptWindow"; + let _ = tv1#set_editable true in + let _ = tv1#set_wrap_mode `NONE in + b#place_cursor ~where:(b#start_iter); + ignore (tv1#event#connect#button_press ~callback: + (fun ev -> GdkEvent.Button.button ev = 3)); + (* ignore (tv1#event#connect#button_press ~callback: + (fun ev -> + if (GdkEvent.Button.button ev=2) then + (try + prerr_endline "Paste invoked"; + GtkSignal.emit_unit + (get_current_view()).view#as_view + GtkText.View.Signals.paste_clipboard; + true + with _ -> false) + else false + ));*) + tv1#misc#grab_focus (); + ignore (tv1#buffer#create_mark + ~name:"start_of_input" + tv1#buffer#start_iter); + ignore (tv1#buffer#create_tag + ~name:"kwd" + [`FOREGROUND "blue"]); + ignore (tv1#buffer#create_tag + ~name:"decl" + [`FOREGROUND "orange red"]); + ignore (tv1#buffer#create_tag + ~name:"comment" + [`FOREGROUND "brown"]); + ignore (tv1#buffer#create_tag + ~name:"reserved" + [`FOREGROUND "dark red"]); + ignore (tv1#buffer#create_tag + ~name:"error" + [`UNDERLINE `DOUBLE ; `FOREGROUND "red"]); + ignore (tv1#buffer#create_tag + ~name:"to_process" + [`BACKGROUND "light blue" ;`EDITABLE false]); + ignore (tv1#buffer#create_tag + ~name:"processed" + [`BACKGROUND "light green" ;`EDITABLE false]); + ignore (tv1#buffer#create_tag + ~name:"found" + [`BACKGROUND "blue"; `FOREGROUND "white"]); + tv1 let last_make = ref "";; @@ -1713,9 +1714,9 @@ let search_next_error () = and e = int_of_string (Str.matched_group 4 !last_make) and msg_index = Str.match_beginning () in - last_make_index := Str.group_end 4; - (f,l,b,e, - String.sub !last_make msg_index (String.length !last_make - msg_index)) + last_make_index := Str.group_end 4; + (f,l,b,e, + String.sub !last_make msg_index (String.length !last_make - msg_index)) let main files = (* Statup preferences *) @@ -1723,1501 +1724,1501 @@ let main files = (* Main window *) let w = GWindow.window - ~wm_class:"CoqIde" ~wm_name:"CoqIde" - ~allow_grow:true ~allow_shrink:true - ~width:!current.window_width ~height:!current.window_height - ~title:"CoqIde" () - in - (try - let icon_image = lib_ide_file "coq.ico" in - let icon = GdkPixbuf.from_file icon_image in - w#set_icon (Some icon) - with _ -> ()); - - let vbox = GPack.vbox ~homogeneous:false ~packing:w#add () in - - - (* Menu bar *) - let menubar = GMenu.menu_bar ~packing:vbox#pack () in - - (* Toolbar *) - let toolbar = GButton.toolbar - ~orientation:`HORIZONTAL - ~style:`ICONS - ~tooltips:true - ~packing:(* handle#add *) - (vbox#pack ~expand:false ~fill:false) - () - in - show_toolbar := - (fun b -> if b then toolbar#misc#show () else toolbar#misc#hide ()); + ~wm_class:"CoqIde" ~wm_name:"CoqIde" + ~allow_grow:true ~allow_shrink:true + ~width:!current.window_width ~height:!current.window_height + ~title:"CoqIde" () + in + (try + let icon_image = lib_ide_file "coq.ico" in + let icon = GdkPixbuf.from_file icon_image in + w#set_icon (Some icon) + with _ -> ()); - let factory = new GMenu.factory ~accel_path:"<CoqIde MenuBar>/" menubar in - let accel_group = factory#accel_group in + let vbox = GPack.vbox ~homogeneous:false ~packing:w#add () in - (* File Menu *) - let file_menu = factory#add_submenu "_File" in - let file_factory = new GMenu.factory ~accel_path:"<CoqIde MenuBar>/File/" file_menu ~accel_group in + (* Menu bar *) + let menubar = GMenu.menu_bar ~packing:vbox#pack () in - (* File/Load Menu *) - let load f = - let f = absolute_filename f in - try - prerr_endline "Loading file starts"; - Vector.find_or_fail - (function - | {analyzed_view=Some av} -> - (match av#filename with - | None -> false - | Some fn -> same_file f fn) - | _ -> false) - !input_views; - prerr_endline "Loading: must open"; - let b = Buffer.create 1024 in - prerr_endline "Loading: get raw content"; - with_file f ~f:(input_channel b); - prerr_endline "Loading: convert content"; - let s = do_convert (Buffer.contents b) in - prerr_endline "Loading: create view"; - let view = create_input_tab (Glib.Convert.filename_to_utf8 - (Filename.basename f)) - in - prerr_endline "Loading: change font"; - view#misc#modify_font !current.text_font; - prerr_endline "Loading: adding view"; - let index = add_input_view {view = view; - analyzed_view = None; - } - in - let av = (new analyzed_view index) in - prerr_endline "Loading: register view"; - (get_input_view index).analyzed_view <- Some av; - prerr_endline "Loading: set filename"; - av#set_filename (Some f); - prerr_endline "Loading: stats"; - av#update_stats; - let input_buffer = view#buffer in - prerr_endline "Loading: fill buffer"; - input_buffer#set_text s; - input_buffer#place_cursor input_buffer#start_iter; - prerr_endline ("Loading: switch to view "^ string_of_int index); - set_current_view index; - set_tab_image index ~icon:`YES; - prerr_endline "Loading: highlight"; - Highlight.highlight_all input_buffer; - input_buffer#set_modified false; - prerr_endline "Loading: clear undo"; - av#view#clear_undo; - prerr_endline "Loading: success" - with - | Vector.Found i -> set_current_view i - | e -> !flash_info ("Load failed: "^(Printexc.to_string e)) - in - let load_m = file_factory#add_item "_Open/Create" - ~key:GdkKeysyms._O in - let load_f () = - match select_file ~title:"Load file" () with - | None -> () - | Some f -> load f - in - ignore (load_m#connect#activate (load_f)); - - (* File/Save Menu *) - let save_m = file_factory#add_item "_Save" - ~key:GdkKeysyms._S in - - - let save_f () = - let current = get_current_view () in - try - (match (out_some current.analyzed_view)#filename with - | None -> - begin match GToolbox.select_file ~title:"Save file" () - with - | None -> () - | Some f -> - if (out_some current.analyzed_view)#save_as f then begin - set_current_tab_label (Filename.basename f); - !flash_info ("File " ^ f ^ " saved") - end - else warning ("Save Failed (check if " ^ f ^ " is writable)") - end - | Some f -> - if (out_some current.analyzed_view)#save f then - !flash_info ("File " ^ f ^ " saved") - else warning ("Save Failed (check if " ^ f ^ " is writable)") - - ) - with - | e -> warning "Save: unexpected error" - in - ignore (save_m#connect#activate save_f); - - (* File/Save As Menu *) - let saveas_m = file_factory#add_item "S_ave as" - in - let saveas_f () = - let current = get_current_view () in - try (match (out_some current.analyzed_view)#filename with - | None -> - begin match GToolbox.select_file ~title:"Save file as" () - with - | None -> () - | Some f -> - if (out_some current.analyzed_view)#save_as f then begin - set_current_tab_label (Filename.basename f); - !flash_info "Saved" - end - else !flash_info "Save Failed" - end - | Some f -> - begin match GToolbox.select_file - ~dir:(ref (Filename.dirname f)) - ~filename:(Filename.basename f) - ~title:"Save file as" () - with - | None -> () - | Some f -> - if (out_some current.analyzed_view)#save_as f then begin - set_current_tab_label (Filename.basename f); - !flash_info "Saved" - end else !flash_info "Save Failed" - end); - with e -> !flash_info "Save Failed" - in - ignore (saveas_m#connect#activate saveas_f); - - (* File/Save All Menu *) - let saveall_m = file_factory#add_item "Sa_ve All" in - let saveall_f () = - Vector.iter - (function - | {view = view ; analyzed_view = Some av} -> - begin match av#filename with - | None -> () - | Some f -> - ignore (av#save f) - end - | _ -> () - ) input_views - in - let has_something_to_save () = - Vector.exists - (function - | {view=view} -> view#buffer#modified - ) - input_views - in - ignore (saveall_m#connect#activate saveall_f); - - (* File/Revert Menu *) - let revert_m = file_factory#add_item "_Revert All Buffers" in - let revert_f () = - Vector.iter - (function - {view = view ; analyzed_view = Some av} -> - (try - match av#filename,av#stats with - | Some f,Some stats -> - let new_stats = Unix.stat f in - if new_stats.Unix.st_mtime > stats.Unix.st_mtime - then av#revert - | Some _, None -> av#revert - | _ -> () - with _ -> av#revert) - | _ -> () - ) input_views - in - ignore (revert_m#connect#activate revert_f); - - (* File/Close Menu *) - let close_m = file_factory#add_item "_Close Buffer" in - let close_f () = - let v = out_some !active_view in - let act = get_current_view_page () in - if v = act then !flash_info "Cannot close an active view" - else remove_current_view_page () - in - ignore (close_m#connect#activate close_f); - - (* File/Print Menu *) - let print_f () = - let v = get_current_view () in - let av = out_some v.analyzed_view in - match av#filename with - | None -> - !flash_info "Cannot print: this buffer has no name" - | Some f -> - let cmd = - "cd " ^ Filename.dirname f ^ "; " ^ - !current.cmd_coqdoc ^ " -ps " ^ Filename.basename f ^ - " | " ^ !current.cmd_print - in - let s,_ = run_command av#insert_message cmd in - !flash_info (cmd ^ if s = Unix.WEXITED 0 then " succeeded" else " failed") - in - let print_m = file_factory#add_item "_Print" ~callback:print_f in - - (* File/Export to Menu *) - let export_f kind () = - let v = get_current_view () in - let av = out_some v.analyzed_view in - match av#filename with - | None -> - !flash_info "Cannot print: this buffer has no name" - | Some f -> - let basef = Filename.basename f in - let output = - let basef_we = try Filename.chop_extension basef with _ -> basef in - match kind with - | "latex" -> basef_we ^ ".tex" - | "dvi" | "ps" | "html" -> basef_we ^ "." ^ kind - | _ -> assert false - in - let cmd = - "cd " ^ Filename.dirname f ^ "; " ^ - !current.cmd_coqdoc ^ " --" ^ kind ^ " -o " ^ output ^ " " ^ basef - in - let s,_ = run_command av#insert_message cmd in - !flash_info (cmd ^ - if s = Unix.WEXITED 0 - then " succeeded" - else " failed") - in - let file_export_m = file_factory#add_submenu "E_xport to" in - - let file_export_factory = new GMenu.factory ~accel_path:"<CoqIde MenuBar>/Export/" file_export_m ~accel_group in - let export_html_m = - file_export_factory#add_item "_Html" ~callback:(export_f "html") - in - let export_latex_m = - file_export_factory#add_item "_LaTeX" ~callback:(export_f "latex") - in - let export_dvi_m = - file_export_factory#add_item "_Dvi" ~callback:(export_f "dvi") - in - let export_ps_m = - file_export_factory#add_item "_Ps" ~callback:(export_f "ps") - in - - (* File/Rehighlight Menu *) - let rehighlight_m = file_factory#add_item "Reh_ighlight" ~key:GdkKeysyms._L in - ignore (rehighlight_m#connect#activate - (fun () -> - Highlight.highlight_all - (get_current_view()).view#buffer; - (out_some (get_current_view()).analyzed_view)#recenter_insert)); - - (* File/Quit Menu *) - let quit_f () = - save_pref(); - if has_something_to_save () then - match (GToolbox.question_box ~title:"Quit" - ~buttons:["Save Named Buffers and Quit"; - "Quit without Saving"; - "Don't Quit"] - ~default:0 - ~icon: - (let img = GMisc.image () in - img#set_stock `DIALOG_WARNING; - img#set_icon_size `DIALOG; - img#coerce) - "There are unsaved buffers" - ) - with 1 -> saveall_f () ; exit 0 - | 2 -> exit 0 - | _ -> () - else exit 0 - in - let quit_m = file_factory#add_item "_Quit" ~key:GdkKeysyms._Q - ~callback:quit_f - in - ignore (w#event#connect#delete (fun _ -> quit_f (); true)); - - (* Edit Menu *) - let edit_menu = factory#add_submenu "_Edit" in - let edit_f = new GMenu.factory ~accel_path:"<CoqIde MenuBar>/Edit/" edit_menu ~accel_group in - ignore(edit_f#add_item "_Undo" ~key:GdkKeysyms._u ~callback: - (do_if_not_computing "undo" - (fun () -> - ignore ((out_some ((get_current_view()).analyzed_view))# - without_auto_complete - (fun () -> (get_current_view()).view#undo) ())))); - ignore(edit_f#add_item "_Clear Undo Stack" - (* ~key:GdkKeysyms._exclam *) - ~callback: - (fun () -> - ignore (get_current_view()).view#clear_undo)); - ignore(edit_f#add_separator ()); - ignore(edit_f#add_item "Cut" ~key:GdkKeysyms._X ~callback: - (fun () -> GtkSignal.emit_unit - (get_current_view()).view#as_view - GtkText.View.S.cut_clipboard)); - ignore(edit_f#add_item "Copy" ~key:GdkKeysyms._C ~callback: - (fun () -> GtkSignal.emit_unit - (get_current_view()).view#as_view - GtkText.View.S.copy_clipboard)); - ignore(edit_f#add_item "Paste" ~key:GdkKeysyms._V ~callback: - (fun () -> - try GtkSignal.emit_unit - (get_current_view()).view#as_view - GtkText.View.S.paste_clipboard - with _ -> prerr_endline "EMIT PASTE FAILED")); - ignore (edit_f#add_separator ()); - - -(* - let toggle_auto_complete_i = - edit_f#add_check_item "_Auto Completion" - ~active:!current.auto_complete - ~callback: - in -*) -(* - auto_complete := - (fun b -> match (get_current_view()).analyzed_view with - | Some av -> av#set_auto_complete b - | None -> ()); -*) - - let last_found = ref None in - let search_backward = ref false in - let find_w = GWindow.window - (* ~wm_class:"CoqIde" ~wm_name:"CoqIde" *) - (* ~allow_grow:true ~allow_shrink:true *) - (* ~width:!current.window_width ~height:!current.window_height *) - ~position:`CENTER - ~title:"CoqIde search/replace" () - in - let find_box = GPack.table - ~columns:3 ~rows:5 - ~col_spacings:10 ~row_spacings:10 ~border_width:10 - ~homogeneous:false ~packing:find_w#add () in - - let find_lbl = - GMisc.label ~text:"Find:" - ~xalign:1.0 - ~packing:(find_box#attach ~left:0 ~top:0 ~fill:`X) () - in - let find_entry = GEdit.entry - ~editable: true - ~packing: (find_box#attach ~left:1 ~top:0 ~expand:`X) - () - in - let replace_lbl = - GMisc.label ~text:"Replace with:" - ~xalign:1.0 - ~packing:(find_box#attach ~left:0 ~top:1 ~fill:`X) () - in - let replace_entry = GEdit.entry - ~editable: true - ~packing: (find_box#attach ~left:1 ~top:1 ~expand:`X) - () - in - let case_sensitive_check = - GButton.check_button - ~label:"case sensitive" - ~active:true - ~packing: (find_box#attach ~left:1 ~top:2) - () - in -(* - let find_backwards_check = - GButton.check_button - ~label:"search backwards" - ~active:false - ~packing: (find_box#attach ~left:1 ~top:3) + (* Toolbar *) + let toolbar = GButton.toolbar + ~orientation:`HORIZONTAL + ~style:`ICONS + ~tooltips:true + ~packing:(* handle#add *) + (vbox#pack ~expand:false ~fill:false) () - in -*) - let close_find_button = - GButton.button - ~label:"Close" - ~packing: (find_box#attach ~left:2 ~top:0) - () - in - let replace_button = - GButton.button - ~label:"Replace" - ~packing: (find_box#attach ~left:2 ~top:1) - () - in - let replace_find_button = - GButton.button - ~label:"Replace and find" - ~packing: (find_box#attach ~left:2 ~top:2) - () - in - let find_again_button = - GButton.button - ~label:"_Find again" - ~packing: (find_box#attach ~left:2 ~top:3) - () - in - let find_again_backward_button = - GButton.button - ~label:"Find _backward" - ~packing: (find_box#attach ~left:2 ~top:4) - () - in - let last_find () = - let v = (get_current_view()).view in - let b = v#buffer in - let start,stop = - match !last_found with - | None -> let i = b#get_iter_at_mark `INSERT in (i,i) - | Some(start,stop) -> - let start = b#get_iter_at_mark start - and stop = b#get_iter_at_mark stop - in - b#remove_tag_by_name ~start ~stop "found"; - last_found:=None; - start,stop in - (v,b,start,stop) - in - let do_replace () = - let v = (get_current_view()).view in - let b = v#buffer in - match !last_found with - | None -> () - | Some(start,stop) -> - let start = b#get_iter_at_mark start - and stop = b#get_iter_at_mark stop - in - b#delete ~start ~stop; - b#insert ~iter:start replace_entry#text; - last_found:=None - in - let find_from (v : Undo.undoable_view) - (b : GText.buffer) (starti : GText.iter) text = - prerr_endline ("Searching for " ^ text); - match (if !search_backward then starti#backward_search text - else starti#forward_search text) - with - | None -> () - | Some(start,stop) -> - b#apply_tag_by_name "found" ~start ~stop; - let start = `MARK (b#create_mark start) - and stop = `MARK (b#create_mark stop) - in - v#scroll_to_mark ~use_align:false ~yalign:0.75 ~within_margin:0.25 - stop; - last_found := Some(start,stop) - in - let do_find () = - let (v,b,starti,_) = last_find () in - find_from v b starti find_entry#text - in - let do_replace_find () = - do_replace(); - do_find() - in - let close_find () = - let (v,b,_,stop) = last_find () in - b#place_cursor stop; - find_w#misc#hide(); - v#coerce#misc#grab_focus() - in - to_do_on_page_switch := - (fun i -> if find_w#misc#visible then close_find()):: - !to_do_on_page_switch; - let find_again_forward () = - search_backward := false; - let (v,b,start,_) = last_find () in - let start = start#forward_chars 1 in - find_from v b start find_entry#text - in - let find_again_backward () = - search_backward := true; - let (v,b,start,_) = last_find () in - let start = start#backward_chars 1 in - find_from v b start find_entry#text - in - let key_find ev = - let s = GdkEvent.Key.state ev and k = GdkEvent.Key.keyval ev in - if k = GdkKeysyms._Escape then - begin - let (v,b,_,stop) = last_find () in - find_w#misc#hide(); - v#coerce#misc#grab_focus(); - true - end - else if k = GdkKeysyms._Return then - begin - close_find(); - true - end - else if List.mem `CONTROL s && k = GdkKeysyms._f then - begin - find_again_forward (); - true - end - else if List.mem `CONTROL s && k = GdkKeysyms._b then - begin - find_again_backward (); - true - end - else false (* to let default callback execute *) - in - let find_f ~backward () = - search_backward := backward; - find_w#show (); - find_w#present (); - find_entry#misc#grab_focus () - in - let find_i = edit_f#add_item "_Find in buffer" - ~key:GdkKeysyms._F - ~callback:(find_f ~backward:false) - in - let find_back_i = edit_f#add_item "Find _backwards" - ~key:GdkKeysyms._B - ~callback:(find_f ~backward:true) - in - let _ = close_find_button#connect#clicked close_find in - let _ = replace_button#connect#clicked do_replace in - let _ = replace_find_button#connect#clicked do_replace_find in - let _ = find_again_button#connect#clicked find_again_forward in - let _ = find_again_backward_button#connect#clicked find_again_backward in - let _ = find_entry#connect#changed do_find in - let _ = find_entry#event#connect#key_press ~callback:key_find in - let _ = find_w#event#connect#delete (fun _ -> find_w#misc#hide(); true) in -(* - let search_if = edit_f#add_item "Search _forward" - ~key:GdkKeysyms._greater - in - let search_ib = edit_f#add_item "Search _backward" - ~key:GdkKeysyms._less - in -*) -(* - let complete_i = edit_f#add_item "_Complete" - ~key:GdkKeysyms._comma - ~callback: - (do_if_not_computing - (fun b -> - let v = out_some (get_current_view ()).analyzed_view - - in v#complete_at_offset - ((v#view#buffer#get_iter `SEL_BOUND)#offset) - )) - in - complete_i#misc#set_state `INSENSITIVE; -*) - - ignore(edit_f#add_item "Complete Word" ~key:GdkKeysyms._slash ~callback: - (fun () -> - ignore ( - let av = out_some ((get_current_view()).analyzed_view) in - av#complete_at_offset (av#get_insert)#offset - ))); - - ignore(edit_f#add_separator ()); - (* external editor *) - let _ = - edit_f#add_item "External editor" ~callback: - (fun () -> - let av = out_some ((get_current_view()).analyzed_view) in - match av#filename with - | None -> () - | Some f -> - save_f (); - let l,r = !current.cmd_editor in - let _ = run_command av#insert_message (l ^ f ^ r) in - av#revert) - in - let _ = edit_f#add_separator () in - (* Preferences *) - let reset_revert_timer () = - disconnect_revert_timer (); - if !current.global_auto_revert then - revert_timer := Some - (GMain.Timeout.add ~ms:!current.global_auto_revert_delay - ~callback: - (fun () -> - do_if_not_computing "revert" (sync revert_f) (); - true)) - in reset_revert_timer (); (* to enable statup preferences timer *) - - let auto_save_f () = - Vector.iter - (function - {view = view ; analyzed_view = Some av} -> - (try - av#auto_save - with _ -> ()) - | _ -> () - ) - input_views - in + show_toolbar := + (fun b -> if b then toolbar#misc#show () else toolbar#misc#hide ()); - let reset_auto_save_timer () = - disconnect_auto_save_timer (); - if !current.auto_save then - auto_save_timer := Some - (GMain.Timeout.add ~ms:!current.auto_save_delay - ~callback: - (fun () -> - do_if_not_computing "autosave" (sync auto_save_f) (); - true)) - in reset_auto_save_timer (); (* to enable statup preferences timer *) - - - let edit_prefs_m = - edit_f#add_item "_Preferences" - ~callback:(fun () -> configure ();reset_revert_timer ()) - in -(* - let save_prefs_m = - configuration_factory#add_item "_Save preferences" - ~callback:(fun () -> save_pref ()) - in -*) - (* Navigation Menu *) - let navigation_menu = factory#add_submenu "_Navigation" in - let navigation_factory = - new GMenu.factory navigation_menu - ~accel_path:"<CoqIde MenuBar>/Navigation/" - ~accel_group - ~accel_modi:!current.modifier_for_navigation - in - let do_or_activate f () = - let current = get_current_view () in - let analyzed_view = out_some current.analyzed_view in - if analyzed_view#is_active then - ignore (f analyzed_view) - else - begin - !flash_info "New proof started"; - activate_input (notebook ())#current_page; - ignore (f analyzed_view) - end - in + let factory = new GMenu.factory ~accel_path:"<CoqIde MenuBar>/" menubar in + let accel_group = factory#accel_group in - let do_or_activate f = - do_if_not_computing "do_or_activate" - (do_or_activate - (fun av -> f av ; !pop_info();!push_info (Coq.current_status()))) - in + (* File Menu *) + let file_menu = factory#add_submenu "_File" in - let add_to_menu_toolbar text ~tooltip ?key ~callback icon = - begin - match key with None -> () - | Some key -> ignore (navigation_factory#add_item text ~key ~callback) - end; - ignore (toolbar#insert_button - ~tooltip - ~text:tooltip - ~icon:(stock_to_widget ~size:`LARGE_TOOLBAR icon) - ~callback - ()) - in - add_to_menu_toolbar - "_Save" - ~tooltip:"Save current buffer" - (* ~key:GdkKeysyms._Down *) - ~callback:save_f - `SAVE; - add_to_menu_toolbar - "_Forward" - ~tooltip:"Forward one command" - ~key:GdkKeysyms._Down - ~callback:(do_or_activate (fun a -> a#process_next_phrase true true true)) - `GO_DOWN; - add_to_menu_toolbar "_Backward" - ~tooltip:"Backward one command" - ~key:GdkKeysyms._Up - ~callback:(do_or_activate (fun a -> a#undo_last_step)) - `GO_UP; - add_to_menu_toolbar - "_Go to" - ~tooltip:"Go to cursor" - ~key:GdkKeysyms._Right - ~callback:(do_or_activate (fun a-> a#go_to_insert)) - `JUMP_TO; - add_to_menu_toolbar - "_Start" - ~tooltip:"Go to start" - ~key:GdkKeysyms._Home - ~callback:(do_or_activate (fun a -> a#reset_initial)) - `GOTO_TOP; - add_to_menu_toolbar - "_End" - ~tooltip:"Go to end" - ~key:GdkKeysyms._End - ~callback:(do_or_activate (fun a -> a#process_until_end_or_error)) - `GOTO_BOTTOM; - add_to_menu_toolbar "_Interrupt" - ~tooltip:"Interrupt computations" - ~key:GdkKeysyms._Break - ~callback:break - `STOP - ; - - (* Tactics Menu *) - let tactics_menu = factory#add_submenu "_Try Tactics" in - let tactics_factory = - new GMenu.factory tactics_menu - ~accel_path:"<CoqIde MenuBar>/Tactics/" - ~accel_group - ~accel_modi:!current.modifier_for_tactics - in - let do_if_active_raw f () = - let current = get_current_view () in - let analyzed_view = out_some current.analyzed_view in - if analyzed_view#is_active then ignore (f analyzed_view) - in - let do_if_active f = - do_if_not_computing "do_if_active" (do_if_active_raw f) in - -(* - let blaster_i = - tactics_factory#add_item "_Blaster" - ~key:GdkKeysyms._b - ~callback: (do_if_active_raw (fun a -> a#blaster ())) - (* Custom locking mechanism! *) - in - blaster_i#misc#set_state `INSENSITIVE; -*) - - ignore (tactics_factory#add_item "_auto" - ~key:GdkKeysyms._a - ~callback:(do_if_active (fun a -> a#insert_command "progress auto.\n" "auto.\n")) - ); - ignore (tactics_factory#add_item "_auto with *" - ~key:GdkKeysyms._asterisk - ~callback:(do_if_active (fun a -> a#insert_command - "progress auto with *.\n" - "auto with *.\n"))); - ignore (tactics_factory#add_item "_eauto" - ~key:GdkKeysyms._e - ~callback:(do_if_active (fun a -> a#insert_command - "progress eauto.\n" - "eauto.\n")) - ); - ignore (tactics_factory#add_item "_eauto with *" - ~key:GdkKeysyms._ampersand - ~callback:(do_if_active (fun a -> a#insert_command - "progress eauto with *.\n" - "eauto with *.\n")) - ); - ignore (tactics_factory#add_item "_intuition" - ~key:GdkKeysyms._i - ~callback:(do_if_active (fun a -> a#insert_command - "progress intuition.\n" - "intuition.\n")) - ); - ignore (tactics_factory#add_item "_omega" - ~key:GdkKeysyms._o - ~callback:(do_if_active (fun a -> a#insert_command - "omega.\n" "omega.\n")) - ); - ignore (tactics_factory#add_item "_simpl" - ~key:GdkKeysyms._s - ~callback:(do_if_active (fun a -> a#insert_command "progress simpl.\n" "simpl.\n" )) - ); - ignore (tactics_factory#add_item "_tauto" - ~key:GdkKeysyms._p - ~callback:(do_if_active (fun a -> a#insert_command "tauto.\n" "tauto.\n" )) - ); - ignore (tactics_factory#add_item "_trivial" - ~key:GdkKeysyms._v - ~callback:(do_if_active( fun a -> a#insert_command "progress trivial.\n" "trivial.\n" )) - ); - - - ignore (toolbar#insert_button - ~tooltip:"Proof Wizard" - ~text:"Wizard" - ~icon:(stock_to_widget ~size:`LARGE_TOOLBAR `DIALOG_INFO) - ~callback:(do_if_active (fun a -> a#tactic_wizard - !current.automatic_tactics - )) - ()); - - ignore (tactics_factory#add_item "<Proof _Wizard>" - ~key:GdkKeysyms._dollar - ~callback:(do_if_active (fun a -> a#tactic_wizard - !current.automatic_tactics - )) - ); - - ignore (tactics_factory#add_separator ()); - let add_simple_template (factory: GMenu.menu GMenu.factory) - (menu_text, text) = - let text = - let l = String.length text - 1 in - if String.get text l = '.' - then text ^"\n" - else text ^" " - in - ignore (factory#add_item menu_text - ~callback: - (fun () -> let {view = view } = get_current_view () in - ignore (view#buffer#insert_interactive text))) - in - List.iter - (fun l -> - match l with - | [] -> () - | [s] -> add_simple_template tactics_factory ("_"^s, s) - | s::_ -> - let a = "_@..." in - a.[1] <- s.[0]; - let f = tactics_factory#add_submenu a in - let ff = new GMenu.factory f ~accel_group in - List.iter - (fun x -> - add_simple_template - ff - ((String.sub x 0 1)^ - "_"^ - (String.sub x 1 (String.length x - 1)), - x)) - l - ) - Coq_commands.tactics; - - (* Templates Menu *) - let templates_menu = factory#add_submenu "Te_mplates" in - let templates_factory = new GMenu.factory templates_menu - ~accel_path:"<CoqIde MenuBar>/Templates/" - ~accel_group - ~accel_modi:!current.modifier_for_templates - in - let add_complex_template (menu_text, text, offset, len, key) = - (* Templates/Lemma *) - let callback () = - let {view = view } = get_current_view () in - if view#buffer#insert_interactive text then begin - let iter = view#buffer#get_iter_at_mark `INSERT in - ignore (iter#nocopy#backward_chars offset); - view#buffer#move_mark `INSERT iter; - ignore (iter#nocopy#backward_chars len); - view#buffer#move_mark `SEL_BOUND iter; - end in - ignore (templates_factory#add_item menu_text ~callback ?key) - in - add_complex_template - ("_Lemma __", "Lemma new_lemma : .\nProof.\n\nSave.\n", - 19, 9, Some GdkKeysyms._L); - add_complex_template - ("_Theorem __", "Theorem new_theorem : .\nProof.\n\nSave.\n", - 19, 11, Some GdkKeysyms._T); - add_complex_template - ("_Definition __", "Definition ident := .\n", - 6, 5, Some GdkKeysyms._D); - add_complex_template - ("_Inductive __", "Inductive ident : :=\n | : .\n", - 14, 5, Some GdkKeysyms._I); - add_complex_template - ("_Fixpoint __", "Fixpoint ident (_ : _) {struct _} : _ :=\n.\n", - 29, 5, Some GdkKeysyms._F); - add_complex_template("_Scheme __", - "Scheme new_scheme := Induction for _ Sort _ -with _ := Induction for _ Sort _.\n",61,10, Some GdkKeysyms._S); + let file_factory = new GMenu.factory ~accel_path:"<CoqIde MenuBar>/File/" file_menu ~accel_group in - (* Template for match *) - let callback () = - let w = get_current_word () in - try - let cases = Coq.make_cases w - in - let print c = function - | [x] -> Format.fprintf c " | %s => _@\n" x - | x::l -> Format.fprintf c " | (%s%a) => _@\n" x - (print_list (fun c s -> Format.fprintf c " %s" s)) l - | [] -> assert false + (* File/Load Menu *) + let load f = + let f = absolute_filename f in + try + prerr_endline "Loading file starts"; + Vector.find_or_fail + (function + | {analyzed_view=Some av} -> + (match av#filename with + | None -> false + | Some fn -> same_file f fn) + | _ -> false) + !input_views; + prerr_endline "Loading: must open"; + let b = Buffer.create 1024 in + prerr_endline "Loading: get raw content"; + with_file f ~f:(input_channel b); + prerr_endline "Loading: convert content"; + let s = do_convert (Buffer.contents b) in + prerr_endline "Loading: create view"; + let view = create_input_tab (Glib.Convert.filename_to_utf8 + (Filename.basename f)) + in + prerr_endline "Loading: change font"; + view#misc#modify_font !current.text_font; + prerr_endline "Loading: adding view"; + let index = add_input_view {view = view; + analyzed_view = None; + } + in + let av = (new analyzed_view index) in + prerr_endline "Loading: register view"; + (get_input_view index).analyzed_view <- Some av; + prerr_endline "Loading: set filename"; + av#set_filename (Some f); + prerr_endline "Loading: stats"; + av#update_stats; + let input_buffer = view#buffer in + prerr_endline "Loading: fill buffer"; + input_buffer#set_text s; + input_buffer#place_cursor input_buffer#start_iter; + prerr_endline ("Loading: switch to view "^ string_of_int index); + set_current_view index; + set_tab_image index ~icon:`YES; + prerr_endline "Loading: highlight"; + Highlight.highlight_all input_buffer; + input_buffer#set_modified false; + prerr_endline "Loading: clear undo"; + av#view#clear_undo; + prerr_endline "Loading: success" + with + | Vector.Found i -> set_current_view i + | e -> !flash_info ("Load failed: "^(Printexc.to_string e)) in - let b = Buffer.create 1024 in - let fmt = Format.formatter_of_buffer b in - Format.fprintf fmt "@[match var with@\n%aend@]@." - (print_list print) cases; - let s = Buffer.contents b in - prerr_endline s; - let {view = view } = get_current_view () in - ignore (view#buffer#delete_selection ()); - let m = view#buffer#create_mark - (view#buffer#get_iter `INSERT) + let load_m = file_factory#add_item "_Open/Create" + ~key:GdkKeysyms._O in + let load_f () = + match select_file ~title:"Load file" () with + | None -> () + | Some f -> load f in - if view#buffer#insert_interactive s then - let i = view#buffer#get_iter (`MARK m) in - let _ = i#nocopy#forward_chars 9 in - view#buffer#place_cursor i; - view#buffer#move_mark ~where:(i#backward_chars 3) - `SEL_BOUND - with Not_found -> !flash_info "Not an inductive type" - in - ignore (templates_factory#add_item "match ..." - ~key:GdkKeysyms._C - ~callback - ); - -(* - let add_simple_template (factory: GMenu.menu GMenu.factory) - (menu_text, text) = - let text = - let l = String.length text - 1 in - if String.get text l = '.' - then text ^"\n" - else text ^" " - in - ignore (factory#add_item menu_text - ~callback: - (fun () -> let {view = view } = get_current_view () in - ignore (view#buffer#insert_interactive text))) - in -*) - ignore (templates_factory#add_separator ()); -(* - List.iter (add_simple_template templates_factory) - [ "_auto", "auto "; - "_auto with *", "auto with * "; - "_eauto", "eauto "; - "_eauto with *", "eauto with * "; - "_intuition", "intuition "; - "_omega", "omega "; - "_simpl", "simpl "; - "_tauto", "tauto "; - "tri_vial", "trivial "; - ]; - ignore (templates_factory#add_separator ()); -*) - List.iter - (fun l -> - match l with - | [] -> () - | [s] -> add_simple_template templates_factory ("_"^s, s) - | s::_ -> - let a = "_@..." in - a.[1] <- s.[0]; - let f = templates_factory#add_submenu a in - let ff = new GMenu.factory f ~accel_group in - List.iter - (fun x -> - add_simple_template - ff - ((String.sub x 0 1)^ - "_"^ - (String.sub x 1 (String.length x - 1)), - x)) - l - ) - Coq_commands.commands; - - (* Queries Menu *) - let queries_menu = factory#add_submenu "_Queries" in - let queries_factory = new GMenu.factory queries_menu ~accel_group - ~accel_path:"<CoqIde MenuBar>/Queries" - ~accel_modi:[] - in - - (* Command/Show commands *) - let _ = - queries_factory#add_item "_SearchAbout " ~key:GdkKeysyms._F2 - ~callback:(fun () -> let term = get_current_word () in - (Command_windows.command_window ())#new_command - ~command:"SearchAbout" - ~term - ()) - in - let _ = - queries_factory#add_item "_Check " ~key:GdkKeysyms._F3 - ~callback:(fun () -> let term = get_current_word () in - (Command_windows.command_window ())#new_command - ~command:"Check" - ~term - ()) - in - let _ = - queries_factory#add_item "_Print " ~key:GdkKeysyms._F4 - ~callback:(fun () -> let term = get_current_word () in - (Command_windows.command_window ())#new_command - ~command:"Print" - ~term - ()) - in - let _ = - queries_factory#add_item "_Whelp Locate" - ~callback:(fun () -> let term = get_current_word () in - (Command_windows.command_window ())#new_command - ~command:"Whelp Locate" - ~term - ()) - in + ignore (load_m#connect#activate (load_f)); - (* Externals *) - let externals_menu = factory#add_submenu "_Compile" in - let externals_factory = new GMenu.factory externals_menu - ~accel_path:"<CoqIde MenuBar>/Compile/" - ~accel_group - ~accel_modi:[] - in - - (* Command/Compile Menu *) - let compile_f () = - let v = get_current_view () in - let av = out_some v.analyzed_view in - save_f (); - match av#filename with - | None -> - !flash_info "Active buffer has no name" - | Some f -> - let s,res = run_command - av#insert_message - (!current.cmd_coqc ^ " " ^ f) - in - if s = Unix.WEXITED 0 then - !flash_info (f ^ " successfully compiled") - else begin - !flash_info (f ^ " failed to compile"); - activate_input (notebook ())#current_page; - av#process_until_end_or_error; - av#insert_message "Compilation output:\n"; - av#insert_message res - end - in - let compile_m = - externals_factory#add_item "_Compile Buffer" ~callback:compile_f - in - - (* Command/Make Menu *) - let make_f () = - let v = get_active_view () in - let av = out_some v.analyzed_view in -(* - save_f (); -*) - av#insert_message "Command output:\n"; - let s,res = run_command av#insert_message !current.cmd_make in - last_make := res; - last_make_index := 0; - !flash_info (!current.cmd_make ^ if s = Unix.WEXITED 0 then " succeeded" else " failed") - in - let make_m = externals_factory#add_item "_Make" - ~key:GdkKeysyms._F6 - ~callback:make_f - in - + (* File/Save Menu *) + let save_m = file_factory#add_item "_Save" + ~key:GdkKeysyms._S in - (* Compile/Next Error *) - let next_error () = - try - let file,line,start,stop,error_msg = search_next_error () in - load file; - let v = get_current_view () in - let av = out_some v.analyzed_view in - let input_buffer = v.view#buffer in -(* - let init = input_buffer#start_iter in - let i = init#forward_lines (line-1) in -*) -(* - let convert_pos = byte_offset_to_char_offset phrase in - let start = convert_pos start in - let stop = convert_pos stop in -*) -(* - let starti = i#forward_chars start in - let stopi = i#forward_chars stop in -*) - let starti = input_buffer#get_iter_at_byte ~line:(line-1) start in - let stopi = input_buffer#get_iter_at_byte ~line:(line-1) stop in - input_buffer#apply_tag_by_name "error" - ~start:starti - ~stop:stopi; - input_buffer#place_cursor starti; - av#set_message error_msg; - v.view#misc#grab_focus () - with Not_found -> - last_make_index := 0; - let v = get_current_view () in - let av = out_some v.analyzed_view in - av#set_message "No more errors.\n" - in - let next_error_m = - externals_factory#add_item "_Next error" - ~key:GdkKeysyms._F7 - ~callback:next_error in - + + let save_f () = + let current = get_current_view () in + try + (match (out_some current.analyzed_view)#filename with + | None -> + begin match GToolbox.select_file ~title:"Save file" () + with + | None -> () + | Some f -> + if (out_some current.analyzed_view)#save_as f then begin + set_current_tab_label (Filename.basename f); + !flash_info ("File " ^ f ^ " saved") + end + else warning ("Save Failed (check if " ^ f ^ " is writable)") + end + | Some f -> + if (out_some current.analyzed_view)#save f then + !flash_info ("File " ^ f ^ " saved") + else warning ("Save Failed (check if " ^ f ^ " is writable)") + + ) + with + | e -> warning "Save: unexpected error" + in + ignore (save_m#connect#activate save_f); + + (* File/Save As Menu *) + let saveas_m = file_factory#add_item "S_ave as" + in + let saveas_f () = + let current = get_current_view () in + try (match (out_some current.analyzed_view)#filename with + | None -> + begin match GToolbox.select_file ~title:"Save file as" () + with + | None -> () + | Some f -> + if (out_some current.analyzed_view)#save_as f then begin + set_current_tab_label (Filename.basename f); + !flash_info "Saved" + end + else !flash_info "Save Failed" + end + | Some f -> + begin match GToolbox.select_file + ~dir:(ref (Filename.dirname f)) + ~filename:(Filename.basename f) + ~title:"Save file as" () + with + | None -> () + | Some f -> + if (out_some current.analyzed_view)#save_as f then begin + set_current_tab_label (Filename.basename f); + !flash_info "Saved" + end else !flash_info "Save Failed" + end); + with e -> !flash_info "Save Failed" + in + ignore (saveas_m#connect#activate saveas_f); + + (* File/Save All Menu *) + let saveall_m = file_factory#add_item "Sa_ve All" in + let saveall_f () = + Vector.iter + (function + | {view = view ; analyzed_view = Some av} -> + begin match av#filename with + | None -> () + | Some f -> + ignore (av#save f) + end + | _ -> () + ) input_views + in + let has_something_to_save () = + Vector.exists + (function + | {view=view} -> view#buffer#modified + ) + input_views + in + ignore (saveall_m#connect#activate saveall_f); + + (* File/Revert Menu *) + let revert_m = file_factory#add_item "_Revert All Buffers" in + let revert_f () = + Vector.iter + (function + {view = view ; analyzed_view = Some av} -> + (try + match av#filename,av#stats with + | Some f,Some stats -> + let new_stats = Unix.stat f in + if new_stats.Unix.st_mtime > stats.Unix.st_mtime + then av#revert + | Some _, None -> av#revert + | _ -> () + with _ -> av#revert) + | _ -> () + ) input_views + in + ignore (revert_m#connect#activate revert_f); + + (* File/Close Menu *) + let close_m = file_factory#add_item "_Close Buffer" in + let close_f () = + let v = out_some !active_view in + let act = get_current_view_page () in + if v = act then !flash_info "Cannot close an active view" + else remove_current_view_page () + in + ignore (close_m#connect#activate close_f); + + (* File/Print Menu *) + let print_f () = + let v = get_current_view () in + let av = out_some v.analyzed_view in + match av#filename with + | None -> + !flash_info "Cannot print: this buffer has no name" + | Some f -> + let cmd = + "cd " ^ Filename.dirname f ^ "; " ^ + !current.cmd_coqdoc ^ " -ps " ^ Filename.basename f ^ + " | " ^ !current.cmd_print + in + let s,_ = run_command av#insert_message cmd in + !flash_info (cmd ^ if s = Unix.WEXITED 0 then " succeeded" else " failed") + in + let print_m = file_factory#add_item "_Print" ~callback:print_f in + + (* File/Export to Menu *) + let export_f kind () = + let v = get_current_view () in + let av = out_some v.analyzed_view in + match av#filename with + | None -> + !flash_info "Cannot print: this buffer has no name" + | Some f -> + let basef = Filename.basename f in + let output = + let basef_we = try Filename.chop_extension basef with _ -> basef in + match kind with + | "latex" -> basef_we ^ ".tex" + | "dvi" | "ps" | "html" -> basef_we ^ "." ^ kind + | _ -> assert false + in + let cmd = + "cd " ^ Filename.dirname f ^ "; " ^ + !current.cmd_coqdoc ^ " --" ^ kind ^ " -o " ^ output ^ " " ^ basef + in + let s,_ = run_command av#insert_message cmd in + !flash_info (cmd ^ + if s = Unix.WEXITED 0 + then " succeeded" + else " failed") + in + let file_export_m = file_factory#add_submenu "E_xport to" in - (* Command/CoqMakefile Menu*) - let coq_makefile_f () = - let v = get_active_view () in - let av = out_some v.analyzed_view in - let s,res = run_command av#insert_message !current.cmd_coqmakefile in - !flash_info - (!current.cmd_coqmakefile ^ if s = Unix.WEXITED 0 then " succeeded" else " failed") - in - let _ = externals_factory#add_item "_Make makefile" ~callback:coq_makefile_f - in - (* Windows Menu *) - let configuration_menu = factory#add_submenu "_Windows" in - let configuration_factory = new GMenu.factory configuration_menu ~accel_path:"<CoqIde MenuBar>/Windows" ~accel_group - in - let queries_show_m = - configuration_factory#add_item - "Show _Query Window" - (* - ~key:GdkKeysyms._F12 - *) - ~callback:(Command_windows.command_window ())#window#present - in - let toolbar_show_m = - configuration_factory#add_item - "Show/Hide _Toolbar" - ~callback:(fun () -> - !current.show_toolbar <- not !current.show_toolbar; - !show_toolbar !current.show_toolbar) - in - let detach_menu = configuration_factory#add_item - "Detach _Script Window" - ~callback: - (do_if_not_computing "detach script window" (sync - (fun () -> - let nb = notebook () in - if nb#misc#toplevel#get_oid=w#coerce#get_oid then - begin - let nw = GWindow.window ~show:true () in - let parent = out_some nb#misc#parent in - ignore (nw#connect#destroy - ~callback: - (fun () -> nb#misc#reparent parent)); - nw#add_accel_group accel_group; - nb#misc#reparent nw#coerce - end - ))) - in - let detach_current_view = - configuration_factory#add_item - "Detach _View" - ~callback: - (do_if_not_computing "detach view" - (fun () -> - match get_current_view () with - | {view=v;analyzed_view=Some av} -> - let w = GWindow.window ~show:true - ~width:(!current.window_width/2) - ~height:(!current.window_height) - ~title:(match av#filename with - | None -> "*Unnamed*" - | Some f -> f) - () + let file_export_factory = new GMenu.factory ~accel_path:"<CoqIde MenuBar>/Export/" file_export_m ~accel_group in + let export_html_m = + file_export_factory#add_item "_Html" ~callback:(export_f "html") in - let sb = GBin.scrolled_window - ~packing:w#add () + let export_latex_m = + file_export_factory#add_item "_LaTeX" ~callback:(export_f "latex") in - let nv = GText.view - ~buffer:v#buffer - ~packing:sb#add - () + let export_dvi_m = + file_export_factory#add_item "_Dvi" ~callback:(export_f "dvi") + in + let export_ps_m = + file_export_factory#add_item "_Ps" ~callback:(export_f "ps") in - nv#misc#modify_font - !current.text_font; - ignore (w#connect#destroy - ~callback: - (fun () -> av#remove_detached_view w)); - av#add_detached_view w - | _ -> () - - )) - in - (* Help Menu *) - - let help_menu = factory#add_submenu "_Help" in - let help_factory = new GMenu.factory help_menu - ~accel_path:"<CoqIde MenuBar>/Help/" - ~accel_modi:[] - ~accel_group in - let _ = help_factory#add_item "Browse Coq _Manual" - ~callback: - (fun () -> - let av = out_some ((get_current_view ()).analyzed_view) in - browse av#insert_message (!current.doc_url ^ "main.html")) in - let _ = help_factory#add_item "Browse Coq _Library" - ~callback: - (fun () -> - let av = out_some ((get_current_view ()).analyzed_view) in - browse av#insert_message !current.library_url) in - let _ = - help_factory#add_item "Help for _keyword" ~key:GdkKeysyms._F1 - ~callback:(fun () -> - let av = out_some ((get_current_view ()).analyzed_view) in - av#help_for_keyword ()) - in - let _ = help_factory#add_separator () in -(* - let faq_m = help_factory#add_item "_FAQ" in -*) - let about_m = help_factory#add_item "_About" in - - (* End of menu *) - - (* The vertical Separator between Scripts and Goals *) - let hb = GPack.paned `HORIZONTAL ~border_width:5 ~packing:vbox#add () in - let fr_notebook = GBin.frame ~shadow_type:`IN ~packing:hb#add1 () in - _notebook := Some (GPack.notebook ~border_width:2 ~show_border:false ~scrollable:true - ~packing:fr_notebook#add - ()); - let nb = notebook () in - let hb2 = GPack.paned `VERTICAL ~packing:hb#add2 () in - let fr_a = GBin.frame ~shadow_type:`IN ~packing:hb2#add () in - let fr_b = GBin.frame ~shadow_type:`IN ~packing:hb2#add () in - let sw2 = GBin.scrolled_window - ~vpolicy:`AUTOMATIC - ~hpolicy:`AUTOMATIC - ~packing:(fr_a#add) () in - let sw3 = GBin.scrolled_window - ~vpolicy:`AUTOMATIC - ~hpolicy:`AUTOMATIC - ~packing:(fr_b#add) () in - let lower_hbox = GPack.hbox ~homogeneous:false ~packing:vbox#pack () in - let status_bar = GMisc.statusbar ~packing:(lower_hbox#pack ~expand:true) () - in - let search_lbl = GMisc.label ~text:"Search:" - ~show:false - ~packing:(lower_hbox#pack ~expand:false) () - in - let search_history = ref [] in - let search_input = GEdit.combo ~popdown_strings:!search_history - ~enable_arrow_keys:true - ~show:false - ~packing:(lower_hbox#pack ~expand:false) () - in - search_input#disable_activate (); - let ready_to_wrap_search = ref false in - - let start_of_search = ref None in - let start_of_found = ref None in - let end_of_found = ref None in - let search_forward = ref true in - let matched_word = ref None in - - let memo_search () = - matched_word := Some search_input#entry#text - -(* if not (List.mem search_input#entry#text !search_history) then - (search_history := - search_input#entry#text::!search_history; - search_input#set_popdown_strings !search_history); - start_of_search := None; - ready_to_wrap_search := false -*) - in - let end_search () = - prerr_endline "End Search"; - memo_search (); - let v = (get_current_view ()).view in - v#buffer#move_mark `SEL_BOUND (v#buffer#get_iter_at_mark `INSERT); - v#coerce#misc#grab_focus (); - search_input#entry#set_text ""; - search_lbl#misc#hide (); - search_input#misc#hide () - in - let end_search_focus_out () = - prerr_endline "End Search(focus out)"; - memo_search (); - let v = (get_current_view ()).view in - v#buffer#move_mark `SEL_BOUND (v#buffer#get_iter_at_mark `INSERT); - search_input#entry#set_text ""; - search_lbl#misc#hide (); - search_input#misc#hide () - in - ignore (search_input#entry#connect#activate ~callback:end_search); - ignore (search_input#entry#event#connect#key_press - ~callback:(fun k -> let kv = GdkEvent.Key.keyval k in - if - kv = GdkKeysyms._Right - || kv = GdkKeysyms._Up - || kv = GdkKeysyms._Left - || (kv = GdkKeysyms._g - && (List.mem `CONTROL (GdkEvent.Key.state k))) - then end_search (); - false)); - ignore (search_input#entry#event#connect#focus_out - ~callback:(fun _ -> end_search_focus_out (); false)); - to_do_on_page_switch := - (fun i -> - start_of_search := None; - ready_to_wrap_search:=false)::!to_do_on_page_switch; - -(* TODO : make it work !!! *) - let rec search_f () = - search_lbl#misc#show (); - search_input#misc#show (); - - prerr_endline "search_f called"; - if !start_of_search = None then begin - (* A full new search is starting *) - start_of_search := - Some ((get_current_view ()).view#buffer#create_mark - ((get_current_view ()).view#buffer#get_iter_at_mark `INSERT)); - start_of_found := !start_of_search; - end_of_found := !start_of_search; - matched_word := Some ""; - end; - let txt = search_input#entry#text in - let v = (get_current_view ()).view in - let iit = v#buffer#get_iter_at_mark `SEL_BOUND - and insert_iter = v#buffer#get_iter_at_mark `INSERT - in - prerr_endline ("SELBOUND="^(string_of_int iit#offset)); - prerr_endline ("INSERT="^(string_of_int insert_iter#offset)); - - (match - if !search_forward then iit#forward_search txt - else let npi = iit#forward_chars (Glib.Utf8.length txt) in - match - (npi#offset = (v#buffer#get_iter_at_mark `INSERT)#offset), - (let t = iit#get_text ~stop:npi in - !flash_info (t^"\n"^txt); - t = txt) - with - | true,true -> - (!flash_info "T,T";iit#backward_search txt) - | false,true -> !flash_info "F,T";Some (iit,npi) - | _,false -> - (iit#backward_search txt) - - with - | None -> - if !ready_to_wrap_search then begin - ready_to_wrap_search := false; - !flash_info "Search wrapped"; - v#buffer#place_cursor - (if !search_forward then v#buffer#start_iter else - v#buffer#end_iter); - search_f () - end else begin - if !search_forward then !flash_info "Search at end" - else !flash_info "Search at start"; - ready_to_wrap_search := true - end - | Some (start,stop) -> - prerr_endline "search: before moving marks"; - prerr_endline ("SELBOUND="^(string_of_int (v#buffer#get_iter_at_mark `SEL_BOUND)#offset)); - prerr_endline ("INSERT="^(string_of_int (v#buffer#get_iter_at_mark `INSERT)#offset)); - - v#buffer#move_mark `SEL_BOUND start; - v#buffer#move_mark `INSERT stop; - prerr_endline "search: after moving marks"; - prerr_endline ("SELBOUND="^(string_of_int (v#buffer#get_iter_at_mark `SEL_BOUND)#offset)); - prerr_endline ("INSERT="^(string_of_int (v#buffer#get_iter_at_mark `INSERT)#offset)); - v#scroll_to_mark `SEL_BOUND - ) - in - ignore (search_input#entry#event#connect#key_release - ~callback: - (fun ev -> - if GdkEvent.Key.keyval ev = GdkKeysyms._Escape then begin - let v = (get_current_view ()).view in - (match !start_of_search with - | None -> - prerr_endline "search_key_rel: Placing sel_bound"; - v#buffer#move_mark - `SEL_BOUND - (v#buffer#get_iter_at_mark `INSERT) - | Some mk -> let it = v#buffer#get_iter_at_mark - (`MARK mk) in - prerr_endline "search_key_rel: Placing cursor"; - v#buffer#place_cursor it; - start_of_search := None - ); - search_input#entry#set_text ""; - v#coerce#misc#grab_focus (); - end; - false - )); - ignore (search_input#entry#connect#changed search_f); - -(* - ignore (search_if#connect#activate - ~callback:(fun b -> - search_forward:= true; - search_input#entry#coerce#misc#grab_focus (); - search_f (); - ) - ); - ignore (search_ib#connect#activate - ~callback:(fun b -> - search_forward:= false; - - (* Must restore the SEL_BOUND mark after - grab_focus ! *) - let v = (get_current_view ()).view in - let old_sel = v#buffer#get_iter_at_mark `SEL_BOUND - in - search_input#entry#coerce#misc#grab_focus (); - v#buffer#move_mark `SEL_BOUND old_sel; - search_f (); - )); -*) - let status_context = status_bar#new_context "Messages" in - let flash_context = status_bar#new_context "Flash" in - ignore (status_context#push "Ready"); - status := Some status_bar; - push_info := (fun s -> ignore (status_context#push s)); - pop_info := (fun () -> status_context#pop ()); - flash_info := (fun ?(delay=5000) s -> flash_context#flash ~delay s); - - (* Location display *) - let l = GMisc.label - ~text:"Line: 1 Char: 1" - ~packing:lower_hbox#pack () in - l#coerce#misc#set_name "location"; - set_location := l#set_text; - - (* Progress Bar *) - pulse := - (let pb = GRange.progress_bar ~pulse_step:0.2 ~packing:lower_hbox#pack () - in pb#set_text "CoqIde started";pb)#pulse; - let tv2 = GText.view ~packing:(sw2#add) () in - tv2#misc#set_name "GoalWindow"; - let _ = tv2#set_editable false in - let tb2 = tv2#buffer in - let tv3 = GText.view ~packing:(sw3#add) () in - tv2#misc#set_name "MessageWindow"; - let _ = tv2#set_wrap_mode `CHAR in - let _ = tv3#set_wrap_mode `WORD in - let _ = tv3#set_editable false in - let _ = GtkBase.Widget.add_events tv2#as_widget - [`ENTER_NOTIFY;`POINTER_MOTION] in - let _ = - tv2#event#connect#motion_notify - ~callback: - (fun e -> - let win = match tv2#get_window `WIDGET with - | None -> assert false - | Some w -> w in - let x,y = Gdk.Window.get_pointer_location win in - let b_x,b_y = tv2#window_to_buffer_coords ~tag:`WIDGET ~x ~y in - let it = tv2#get_iter_at_location ~x:b_x ~y:b_y in - let tags = it#tags in - List.iter - (fun t -> - ignore(GtkText.Tag.event t#as_tag tv2#as_widget e it#as_iter)) - tags; - false) in - change_font := - (fun fd -> - tv2#misc#modify_font fd; - tv3#misc#modify_font fd; - Vector.iter - (fun {view=view} -> view#misc#modify_font fd) - input_views; - ); - let about (b:GText.buffer) = - (try - let image = lib_ide_file "coq.png" in - let startup_image = GdkPixbuf.from_file image in - b#insert_pixbuf ~iter:b#start_iter - ~pixbuf:startup_image; - b#insert ~iter:b#start_iter "\t\t"; - with _ -> ()); - let about_string = - "\nCoqIDE: an Integrated Development Environment for Coq\n\ + (* File/Rehighlight Menu *) + let rehighlight_m = file_factory#add_item "Reh_ighlight" ~key:GdkKeysyms._L in + ignore (rehighlight_m#connect#activate + (fun () -> + Highlight.highlight_all + (get_current_view()).view#buffer; + (out_some (get_current_view()).analyzed_view)#recenter_insert)); + + (* File/Quit Menu *) + let quit_f () = + save_pref(); + if has_something_to_save () then + match (GToolbox.question_box ~title:"Quit" + ~buttons:["Save Named Buffers and Quit"; + "Quit without Saving"; + "Don't Quit"] + ~default:0 + ~icon: + (let img = GMisc.image () in + img#set_stock `DIALOG_WARNING; + img#set_icon_size `DIALOG; + img#coerce) + "There are unsaved buffers" + ) + with 1 -> saveall_f () ; exit 0 + | 2 -> exit 0 + | _ -> () + else exit 0 + in + let quit_m = file_factory#add_item "_Quit" ~key:GdkKeysyms._Q + ~callback:quit_f + in + ignore (w#event#connect#delete (fun _ -> quit_f (); true)); + + (* Edit Menu *) + let edit_menu = factory#add_submenu "_Edit" in + let edit_f = new GMenu.factory ~accel_path:"<CoqIde MenuBar>/Edit/" edit_menu ~accel_group in + ignore(edit_f#add_item "_Undo" ~key:GdkKeysyms._u ~callback: + (do_if_not_computing "undo" + (fun () -> + ignore ((out_some ((get_current_view()).analyzed_view))# + without_auto_complete + (fun () -> (get_current_view()).view#undo) ())))); + ignore(edit_f#add_item "_Clear Undo Stack" + (* ~key:GdkKeysyms._exclam *) + ~callback: + (fun () -> + ignore (get_current_view()).view#clear_undo)); + ignore(edit_f#add_separator ()); + ignore(edit_f#add_item "Cut" ~key:GdkKeysyms._X ~callback: + (fun () -> GtkSignal.emit_unit + (get_current_view()).view#as_view + GtkText.View.S.cut_clipboard)); + ignore(edit_f#add_item "Copy" ~key:GdkKeysyms._C ~callback: + (fun () -> GtkSignal.emit_unit + (get_current_view()).view#as_view + GtkText.View.S.copy_clipboard)); + ignore(edit_f#add_item "Paste" ~key:GdkKeysyms._V ~callback: + (fun () -> + try GtkSignal.emit_unit + (get_current_view()).view#as_view + GtkText.View.S.paste_clipboard + with _ -> prerr_endline "EMIT PASTE FAILED")); + ignore (edit_f#add_separator ()); + + + (* + let toggle_auto_complete_i = + edit_f#add_check_item "_Auto Completion" + ~active:!current.auto_complete + ~callback: + in + *) + (* + auto_complete := + (fun b -> match (get_current_view()).analyzed_view with + | Some av -> av#set_auto_complete b + | None -> ()); + *) + + let last_found = ref None in + let search_backward = ref false in + let find_w = GWindow.window + (* ~wm_class:"CoqIde" ~wm_name:"CoqIde" *) + (* ~allow_grow:true ~allow_shrink:true *) + (* ~width:!current.window_width ~height:!current.window_height *) + ~position:`CENTER + ~title:"CoqIde search/replace" () + in + let find_box = GPack.table + ~columns:3 ~rows:5 + ~col_spacings:10 ~row_spacings:10 ~border_width:10 + ~homogeneous:false ~packing:find_w#add () in + + let find_lbl = + GMisc.label ~text:"Find:" + ~xalign:1.0 + ~packing:(find_box#attach ~left:0 ~top:0 ~fill:`X) () + in + let find_entry = GEdit.entry + ~editable: true + ~packing: (find_box#attach ~left:1 ~top:0 ~expand:`X) + () + in + let replace_lbl = + GMisc.label ~text:"Replace with:" + ~xalign:1.0 + ~packing:(find_box#attach ~left:0 ~top:1 ~fill:`X) () + in + let replace_entry = GEdit.entry + ~editable: true + ~packing: (find_box#attach ~left:1 ~top:1 ~expand:`X) + () + in + let case_sensitive_check = + GButton.check_button + ~label:"case sensitive" + ~active:true + ~packing: (find_box#attach ~left:1 ~top:2) + () + in + (* + let find_backwards_check = + GButton.check_button + ~label:"search backwards" + ~active:false + ~packing: (find_box#attach ~left:1 ~top:3) + () + in + *) + let close_find_button = + GButton.button + ~label:"Close" + ~packing: (find_box#attach ~left:2 ~top:0) + () + in + let replace_button = + GButton.button + ~label:"Replace" + ~packing: (find_box#attach ~left:2 ~top:1) + () + in + let replace_find_button = + GButton.button + ~label:"Replace and find" + ~packing: (find_box#attach ~left:2 ~top:2) + () + in + let find_again_button = + GButton.button + ~label:"_Find again" + ~packing: (find_box#attach ~left:2 ~top:3) + () + in + let find_again_backward_button = + GButton.button + ~label:"Find _backward" + ~packing: (find_box#attach ~left:2 ~top:4) + () + in + let last_find () = + let v = (get_current_view()).view in + let b = v#buffer in + let start,stop = + match !last_found with + | None -> let i = b#get_iter_at_mark `INSERT in (i,i) + | Some(start,stop) -> + let start = b#get_iter_at_mark start + and stop = b#get_iter_at_mark stop + in + b#remove_tag_by_name ~start ~stop "found"; + last_found:=None; + start,stop + in + (v,b,start,stop) + in + let do_replace () = + let v = (get_current_view()).view in + let b = v#buffer in + match !last_found with + | None -> () + | Some(start,stop) -> + let start = b#get_iter_at_mark start + and stop = b#get_iter_at_mark stop + in + b#delete ~start ~stop; + b#insert ~iter:start replace_entry#text; + last_found:=None + in + let find_from (v : Undo.undoable_view) + (b : GText.buffer) (starti : GText.iter) text = + prerr_endline ("Searching for " ^ text); + match (if !search_backward then starti#backward_search text + else starti#forward_search text) + with + | None -> () + | Some(start,stop) -> + b#apply_tag_by_name "found" ~start ~stop; + let start = `MARK (b#create_mark start) + and stop = `MARK (b#create_mark stop) + in + v#scroll_to_mark ~use_align:false ~yalign:0.75 ~within_margin:0.25 + stop; + last_found := Some(start,stop) + in + let do_find () = + let (v,b,starti,_) = last_find () in + find_from v b starti find_entry#text + in + let do_replace_find () = + do_replace(); + do_find() + in + let close_find () = + let (v,b,_,stop) = last_find () in + b#place_cursor stop; + find_w#misc#hide(); + v#coerce#misc#grab_focus() + in + to_do_on_page_switch := + (fun i -> if find_w#misc#visible then close_find()):: + !to_do_on_page_switch; + let find_again_forward () = + search_backward := false; + let (v,b,start,_) = last_find () in + let start = start#forward_chars 1 in + find_from v b start find_entry#text + in + let find_again_backward () = + search_backward := true; + let (v,b,start,_) = last_find () in + let start = start#backward_chars 1 in + find_from v b start find_entry#text + in + let key_find ev = + let s = GdkEvent.Key.state ev and k = GdkEvent.Key.keyval ev in + if k = GdkKeysyms._Escape then + begin + let (v,b,_,stop) = last_find () in + find_w#misc#hide(); + v#coerce#misc#grab_focus(); + true + end + else if k = GdkKeysyms._Return then + begin + close_find(); + true + end + else if List.mem `CONTROL s && k = GdkKeysyms._f then + begin + find_again_forward (); + true + end + else if List.mem `CONTROL s && k = GdkKeysyms._b then + begin + find_again_backward (); + true + end + else false (* to let default callback execute *) + in + let find_f ~backward () = + search_backward := backward; + find_w#show (); + find_w#present (); + find_entry#misc#grab_focus () + in + let find_i = edit_f#add_item "_Find in buffer" + ~key:GdkKeysyms._F + ~callback:(find_f ~backward:false) + in + let find_back_i = edit_f#add_item "Find _backwards" + ~key:GdkKeysyms._B + ~callback:(find_f ~backward:true) + in + let _ = close_find_button#connect#clicked close_find in + let _ = replace_button#connect#clicked do_replace in + let _ = replace_find_button#connect#clicked do_replace_find in + let _ = find_again_button#connect#clicked find_again_forward in + let _ = find_again_backward_button#connect#clicked find_again_backward in + let _ = find_entry#connect#changed do_find in + let _ = find_entry#event#connect#key_press ~callback:key_find in + let _ = find_w#event#connect#delete (fun _ -> find_w#misc#hide(); true) in + (* + let search_if = edit_f#add_item "Search _forward" + ~key:GdkKeysyms._greater + in + let search_ib = edit_f#add_item "Search _backward" + ~key:GdkKeysyms._less + in + *) + (* + let complete_i = edit_f#add_item "_Complete" + ~key:GdkKeysyms._comma + ~callback: + (do_if_not_computing + (fun b -> + let v = out_some (get_current_view ()).analyzed_view + + in v#complete_at_offset + ((v#view#buffer#get_iter `SEL_BOUND)#offset) + )) + in + complete_i#misc#set_state `INSENSITIVE; + *) + + ignore(edit_f#add_item "Complete Word" ~key:GdkKeysyms._slash ~callback: + (fun () -> + ignore ( + let av = out_some ((get_current_view()).analyzed_view) in + av#complete_at_offset (av#get_insert)#offset + ))); + + ignore(edit_f#add_separator ()); + (* external editor *) + let _ = + edit_f#add_item "External editor" ~callback: + (fun () -> + let av = out_some ((get_current_view()).analyzed_view) in + match av#filename with + | None -> () + | Some f -> + save_f (); + let l,r = !current.cmd_editor in + let _ = run_command av#insert_message (l ^ f ^ r) in + av#revert) + in + let _ = edit_f#add_separator () in + (* Preferences *) + let reset_revert_timer () = + disconnect_revert_timer (); + if !current.global_auto_revert then + revert_timer := Some + (GMain.Timeout.add ~ms:!current.global_auto_revert_delay + ~callback: + (fun () -> + do_if_not_computing "revert" (sync revert_f) (); + true)) + in reset_revert_timer (); (* to enable statup preferences timer *) + + let auto_save_f () = + Vector.iter + (function + {view = view ; analyzed_view = Some av} -> + (try + av#auto_save + with _ -> ()) + | _ -> () + ) + input_views + in + + let reset_auto_save_timer () = + disconnect_auto_save_timer (); + if !current.auto_save then + auto_save_timer := Some + (GMain.Timeout.add ~ms:!current.auto_save_delay + ~callback: + (fun () -> + do_if_not_computing "autosave" (sync auto_save_f) (); + true)) + in reset_auto_save_timer (); (* to enable statup preferences timer *) + + + let edit_prefs_m = + edit_f#add_item "_Preferences" + ~callback:(fun () -> configure ();reset_revert_timer ()) + in + (* + let save_prefs_m = + configuration_factory#add_item "_Save preferences" + ~callback:(fun () -> save_pref ()) + in + *) + (* Navigation Menu *) + let navigation_menu = factory#add_submenu "_Navigation" in + let navigation_factory = + new GMenu.factory navigation_menu + ~accel_path:"<CoqIde MenuBar>/Navigation/" + ~accel_group + ~accel_modi:!current.modifier_for_navigation + in + let do_or_activate f () = + let current = get_current_view () in + let analyzed_view = out_some current.analyzed_view in + if analyzed_view#is_active then + ignore (f analyzed_view) + else + begin + !flash_info "New proof started"; + activate_input (notebook ())#current_page; + ignore (f analyzed_view) + end + in + + let do_or_activate f = + do_if_not_computing "do_or_activate" + (do_or_activate + (fun av -> f av ; !pop_info();!push_info (Coq.current_status()))) + in + + let add_to_menu_toolbar text ~tooltip ?key ~callback icon = + begin + match key with None -> () + | Some key -> ignore (navigation_factory#add_item text ~key ~callback) + end; + ignore (toolbar#insert_button + ~tooltip + ~text:tooltip + ~icon:(stock_to_widget ~size:`LARGE_TOOLBAR icon) + ~callback + ()) + in + add_to_menu_toolbar + "_Save" + ~tooltip:"Save current buffer" + (* ~key:GdkKeysyms._Down *) + ~callback:save_f + `SAVE; + add_to_menu_toolbar + "_Forward" + ~tooltip:"Forward one command" + ~key:GdkKeysyms._Down + ~callback:(do_or_activate (fun a -> a#process_next_phrase true true true)) + `GO_DOWN; + add_to_menu_toolbar "_Backward" + ~tooltip:"Backward one command" + ~key:GdkKeysyms._Up + ~callback:(do_or_activate (fun a -> a#undo_last_step)) + `GO_UP; + add_to_menu_toolbar + "_Go to" + ~tooltip:"Go to cursor" + ~key:GdkKeysyms._Right + ~callback:(do_or_activate (fun a-> a#go_to_insert)) + `JUMP_TO; + add_to_menu_toolbar + "_Start" + ~tooltip:"Go to start" + ~key:GdkKeysyms._Home + ~callback:(do_or_activate (fun a -> a#reset_initial)) + `GOTO_TOP; + add_to_menu_toolbar + "_End" + ~tooltip:"Go to end" + ~key:GdkKeysyms._End + ~callback:(do_or_activate (fun a -> a#process_until_end_or_error)) + `GOTO_BOTTOM; + add_to_menu_toolbar "_Interrupt" + ~tooltip:"Interrupt computations" + ~key:GdkKeysyms._Break + ~callback:break + `STOP + ; + + (* Tactics Menu *) + let tactics_menu = factory#add_submenu "_Try Tactics" in + let tactics_factory = + new GMenu.factory tactics_menu + ~accel_path:"<CoqIde MenuBar>/Tactics/" + ~accel_group + ~accel_modi:!current.modifier_for_tactics + in + let do_if_active_raw f () = + let current = get_current_view () in + let analyzed_view = out_some current.analyzed_view in + if analyzed_view#is_active then ignore (f analyzed_view) + in + let do_if_active f = + do_if_not_computing "do_if_active" (do_if_active_raw f) in + + (* + let blaster_i = + tactics_factory#add_item "_Blaster" + ~key:GdkKeysyms._b + ~callback: (do_if_active_raw (fun a -> a#blaster ())) + (* Custom locking mechanism! *) + in + blaster_i#misc#set_state `INSENSITIVE; + *) + + ignore (tactics_factory#add_item "_auto" + ~key:GdkKeysyms._a + ~callback:(do_if_active (fun a -> a#insert_command "progress auto.\n" "auto.\n")) + ); + ignore (tactics_factory#add_item "_auto with *" + ~key:GdkKeysyms._asterisk + ~callback:(do_if_active (fun a -> a#insert_command + "progress auto with *.\n" + "auto with *.\n"))); + ignore (tactics_factory#add_item "_eauto" + ~key:GdkKeysyms._e + ~callback:(do_if_active (fun a -> a#insert_command + "progress eauto.\n" + "eauto.\n")) + ); + ignore (tactics_factory#add_item "_eauto with *" + ~key:GdkKeysyms._ampersand + ~callback:(do_if_active (fun a -> a#insert_command + "progress eauto with *.\n" + "eauto with *.\n")) + ); + ignore (tactics_factory#add_item "_intuition" + ~key:GdkKeysyms._i + ~callback:(do_if_active (fun a -> a#insert_command + "progress intuition.\n" + "intuition.\n")) + ); + ignore (tactics_factory#add_item "_omega" + ~key:GdkKeysyms._o + ~callback:(do_if_active (fun a -> a#insert_command + "omega.\n" "omega.\n")) + ); + ignore (tactics_factory#add_item "_simpl" + ~key:GdkKeysyms._s + ~callback:(do_if_active (fun a -> a#insert_command "progress simpl.\n" "simpl.\n" )) + ); + ignore (tactics_factory#add_item "_tauto" + ~key:GdkKeysyms._p + ~callback:(do_if_active (fun a -> a#insert_command "tauto.\n" "tauto.\n" )) + ); + ignore (tactics_factory#add_item "_trivial" + ~key:GdkKeysyms._v + ~callback:(do_if_active( fun a -> a#insert_command "progress trivial.\n" "trivial.\n" )) + ); + + + ignore (toolbar#insert_button + ~tooltip:"Proof Wizard" + ~text:"Wizard" + ~icon:(stock_to_widget ~size:`LARGE_TOOLBAR `DIALOG_INFO) + ~callback:(do_if_active (fun a -> a#tactic_wizard + !current.automatic_tactics + )) + ()); + + ignore (tactics_factory#add_item "<Proof _Wizard>" + ~key:GdkKeysyms._dollar + ~callback:(do_if_active (fun a -> a#tactic_wizard + !current.automatic_tactics + )) + ); + + ignore (tactics_factory#add_separator ()); + let add_simple_template (factory: GMenu.menu GMenu.factory) + (menu_text, text) = + let text = + let l = String.length text - 1 in + if String.get text l = '.' + then text ^"\n" + else text ^" " + in + ignore (factory#add_item menu_text + ~callback: + (fun () -> let {view = view } = get_current_view () in + ignore (view#buffer#insert_interactive text))) + in + List.iter + (fun l -> + match l with + | [] -> () + | [s] -> add_simple_template tactics_factory ("_"^s, s) + | s::_ -> + let a = "_@..." in + a.[1] <- s.[0]; + let f = tactics_factory#add_submenu a in + let ff = new GMenu.factory f ~accel_group in + List.iter + (fun x -> + add_simple_template + ff + ((String.sub x 0 1)^ + "_"^ + (String.sub x 1 (String.length x - 1)), + x)) + l + ) + Coq_commands.tactics; + + (* Templates Menu *) + let templates_menu = factory#add_submenu "Te_mplates" in + let templates_factory = new GMenu.factory templates_menu + ~accel_path:"<CoqIde MenuBar>/Templates/" + ~accel_group + ~accel_modi:!current.modifier_for_templates + in + let add_complex_template (menu_text, text, offset, len, key) = + (* Templates/Lemma *) + let callback () = + let {view = view } = get_current_view () in + if view#buffer#insert_interactive text then begin + let iter = view#buffer#get_iter_at_mark `INSERT in + ignore (iter#nocopy#backward_chars offset); + view#buffer#move_mark `INSERT iter; + ignore (iter#nocopy#backward_chars len); + view#buffer#move_mark `SEL_BOUND iter; + end in + ignore (templates_factory#add_item menu_text ~callback ?key) + in + add_complex_template + ("_Lemma __", "Lemma new_lemma : .\nProof.\n\nSave.\n", + 19, 9, Some GdkKeysyms._L); + add_complex_template + ("_Theorem __", "Theorem new_theorem : .\nProof.\n\nSave.\n", + 19, 11, Some GdkKeysyms._T); + add_complex_template + ("_Definition __", "Definition ident := .\n", + 6, 5, Some GdkKeysyms._D); + add_complex_template + ("_Inductive __", "Inductive ident : :=\n | : .\n", + 14, 5, Some GdkKeysyms._I); + add_complex_template + ("_Fixpoint __", "Fixpoint ident (_ : _) {struct _} : _ :=\n.\n", + 29, 5, Some GdkKeysyms._F); + add_complex_template("_Scheme __", + "Scheme new_scheme := Induction for _ Sort _ +with _ := Induction for _ Sort _.\n",61,10, Some GdkKeysyms._S); + + (* Template for match *) + let callback () = + let w = get_current_word () in + try + let cases = Coq.make_cases w + in + let print c = function + | [x] -> Format.fprintf c " | %s => _@\n" x + | x::l -> Format.fprintf c " | (%s%a) => _@\n" x + (print_list (fun c s -> Format.fprintf c " %s" s)) l + | [] -> assert false + in + let b = Buffer.create 1024 in + let fmt = Format.formatter_of_buffer b in + Format.fprintf fmt "@[match var with@\n%aend@]@." + (print_list print) cases; + let s = Buffer.contents b in + prerr_endline s; + let {view = view } = get_current_view () in + ignore (view#buffer#delete_selection ()); + let m = view#buffer#create_mark + (view#buffer#get_iter `INSERT) + in + if view#buffer#insert_interactive s then + let i = view#buffer#get_iter (`MARK m) in + let _ = i#nocopy#forward_chars 9 in + view#buffer#place_cursor i; + view#buffer#move_mark ~where:(i#backward_chars 3) + `SEL_BOUND + with Not_found -> !flash_info "Not an inductive type" + in + ignore (templates_factory#add_item "match ..." + ~key:GdkKeysyms._C + ~callback + ); + + (* + let add_simple_template (factory: GMenu.menu GMenu.factory) + (menu_text, text) = + let text = + let l = String.length text - 1 in + if String.get text l = '.' + then text ^"\n" + else text ^" " + in + ignore (factory#add_item menu_text + ~callback: + (fun () -> let {view = view } = get_current_view () in + ignore (view#buffer#insert_interactive text))) + in + *) + ignore (templates_factory#add_separator ()); + (* + List.iter (add_simple_template templates_factory) + [ "_auto", "auto "; + "_auto with *", "auto with * "; + "_eauto", "eauto "; + "_eauto with *", "eauto with * "; + "_intuition", "intuition "; + "_omega", "omega "; + "_simpl", "simpl "; + "_tauto", "tauto "; + "tri_vial", "trivial "; + ]; + ignore (templates_factory#add_separator ()); + *) + List.iter + (fun l -> + match l with + | [] -> () + | [s] -> add_simple_template templates_factory ("_"^s, s) + | s::_ -> + let a = "_@..." in + a.[1] <- s.[0]; + let f = templates_factory#add_submenu a in + let ff = new GMenu.factory f ~accel_group in + List.iter + (fun x -> + add_simple_template + ff + ((String.sub x 0 1)^ + "_"^ + (String.sub x 1 (String.length x - 1)), + x)) + l + ) + Coq_commands.commands; + + (* Queries Menu *) + let queries_menu = factory#add_submenu "_Queries" in + let queries_factory = new GMenu.factory queries_menu ~accel_group + ~accel_path:"<CoqIde MenuBar>/Queries" + ~accel_modi:[] + in + + (* Command/Show commands *) + let _ = + queries_factory#add_item "_SearchAbout " ~key:GdkKeysyms._F2 + ~callback:(fun () -> let term = get_current_word () in + (Command_windows.command_window ())#new_command + ~command:"SearchAbout" + ~term + ()) + in + let _ = + queries_factory#add_item "_Check " ~key:GdkKeysyms._F3 + ~callback:(fun () -> let term = get_current_word () in + (Command_windows.command_window ())#new_command + ~command:"Check" + ~term + ()) + in + let _ = + queries_factory#add_item "_Print " ~key:GdkKeysyms._F4 + ~callback:(fun () -> let term = get_current_word () in + (Command_windows.command_window ())#new_command + ~command:"Print" + ~term + ()) + in + let _ = + queries_factory#add_item "_Whelp Locate" + ~callback:(fun () -> let term = get_current_word () in + (Command_windows.command_window ())#new_command + ~command:"Whelp Locate" + ~term + ()) + in + + (* Externals *) + let externals_menu = factory#add_submenu "_Compile" in + let externals_factory = new GMenu.factory externals_menu + ~accel_path:"<CoqIde MenuBar>/Compile/" + ~accel_group + ~accel_modi:[] + in + + (* Command/Compile Menu *) + let compile_f () = + let v = get_current_view () in + let av = out_some v.analyzed_view in + save_f (); + match av#filename with + | None -> + !flash_info "Active buffer has no name" + | Some f -> + let s,res = run_command + av#insert_message + (!current.cmd_coqc ^ " " ^ f) + in + if s = Unix.WEXITED 0 then + !flash_info (f ^ " successfully compiled") + else begin + !flash_info (f ^ " failed to compile"); + activate_input (notebook ())#current_page; + av#process_until_end_or_error; + av#insert_message "Compilation output:\n"; + av#insert_message res + end + in + let compile_m = + externals_factory#add_item "_Compile Buffer" ~callback:compile_f + in + + (* Command/Make Menu *) + let make_f () = + let v = get_active_view () in + let av = out_some v.analyzed_view in + (* + save_f (); + *) + av#insert_message "Command output:\n"; + let s,res = run_command av#insert_message !current.cmd_make in + last_make := res; + last_make_index := 0; + !flash_info (!current.cmd_make ^ if s = Unix.WEXITED 0 then " succeeded" else " failed") + in + let make_m = externals_factory#add_item "_Make" + ~key:GdkKeysyms._F6 + ~callback:make_f + in + + + (* Compile/Next Error *) + let next_error () = + try + let file,line,start,stop,error_msg = search_next_error () in + load file; + let v = get_current_view () in + let av = out_some v.analyzed_view in + let input_buffer = v.view#buffer in + (* + let init = input_buffer#start_iter in + let i = init#forward_lines (line-1) in + *) + (* + let convert_pos = byte_offset_to_char_offset phrase in + let start = convert_pos start in + let stop = convert_pos stop in + *) + (* + let starti = i#forward_chars start in + let stopi = i#forward_chars stop in + *) + let starti = input_buffer#get_iter_at_byte ~line:(line-1) start in + let stopi = input_buffer#get_iter_at_byte ~line:(line-1) stop in + input_buffer#apply_tag_by_name "error" + ~start:starti + ~stop:stopi; + input_buffer#place_cursor starti; + av#set_message error_msg; + v.view#misc#grab_focus () + with Not_found -> + last_make_index := 0; + let v = get_current_view () in + let av = out_some v.analyzed_view in + av#set_message "No more errors.\n" + in + let next_error_m = + externals_factory#add_item "_Next error" + ~key:GdkKeysyms._F7 + ~callback:next_error in + + + (* Command/CoqMakefile Menu*) + let coq_makefile_f () = + let v = get_active_view () in + let av = out_some v.analyzed_view in + let s,res = run_command av#insert_message !current.cmd_coqmakefile in + !flash_info + (!current.cmd_coqmakefile ^ if s = Unix.WEXITED 0 then " succeeded" else " failed") + in + let _ = externals_factory#add_item "_Make makefile" ~callback:coq_makefile_f + in + (* Windows Menu *) + let configuration_menu = factory#add_submenu "_Windows" in + let configuration_factory = new GMenu.factory configuration_menu ~accel_path:"<CoqIde MenuBar>/Windows" ~accel_group + in + let queries_show_m = + configuration_factory#add_item + "Show _Query Window" + (* + ~key:GdkKeysyms._F12 + *) + ~callback:(Command_windows.command_window ())#window#present + in + let toolbar_show_m = + configuration_factory#add_item + "Show/Hide _Toolbar" + ~callback:(fun () -> + !current.show_toolbar <- not !current.show_toolbar; + !show_toolbar !current.show_toolbar) + in + let detach_menu = configuration_factory#add_item + "Detach _Script Window" + ~callback: + (do_if_not_computing "detach script window" (sync + (fun () -> + let nb = notebook () in + if nb#misc#toplevel#get_oid=w#coerce#get_oid then + begin + let nw = GWindow.window ~show:true () in + let parent = out_some nb#misc#parent in + ignore (nw#connect#destroy + ~callback: + (fun () -> nb#misc#reparent parent)); + nw#add_accel_group accel_group; + nb#misc#reparent nw#coerce + end + ))) + in + let detach_current_view = + configuration_factory#add_item + "Detach _View" + ~callback: + (do_if_not_computing "detach view" + (fun () -> + match get_current_view () with + | {view=v;analyzed_view=Some av} -> + let w = GWindow.window ~show:true + ~width:(!current.window_width/2) + ~height:(!current.window_height) + ~title:(match av#filename with + | None -> "*Unnamed*" + | Some f -> f) + () + in + let sb = GBin.scrolled_window + ~packing:w#add () + in + let nv = GText.view + ~buffer:v#buffer + ~packing:sb#add + () + in + nv#misc#modify_font + !current.text_font; + ignore (w#connect#destroy + ~callback: + (fun () -> av#remove_detached_view w)); + av#add_detached_view w + | _ -> () + + )) + in + (* Help Menu *) + + let help_menu = factory#add_submenu "_Help" in + let help_factory = new GMenu.factory help_menu + ~accel_path:"<CoqIde MenuBar>/Help/" + ~accel_modi:[] + ~accel_group in + let _ = help_factory#add_item "Browse Coq _Manual" + ~callback: + (fun () -> + let av = out_some ((get_current_view ()).analyzed_view) in + browse av#insert_message (!current.doc_url ^ "main.html")) in + let _ = help_factory#add_item "Browse Coq _Library" + ~callback: + (fun () -> + let av = out_some ((get_current_view ()).analyzed_view) in + browse av#insert_message !current.library_url) in + let _ = + help_factory#add_item "Help for _keyword" ~key:GdkKeysyms._F1 + ~callback:(fun () -> + let av = out_some ((get_current_view ()).analyzed_view) in + av#help_for_keyword ()) + in + let _ = help_factory#add_separator () in + (* + let faq_m = help_factory#add_item "_FAQ" in + *) + let about_m = help_factory#add_item "_About" in + + (* End of menu *) + + (* The vertical Separator between Scripts and Goals *) + let hb = GPack.paned `HORIZONTAL ~border_width:5 ~packing:vbox#add () in + let fr_notebook = GBin.frame ~shadow_type:`IN ~packing:hb#add1 () in + _notebook := Some (GPack.notebook ~border_width:2 ~show_border:false ~scrollable:true + ~packing:fr_notebook#add + ()); + let nb = notebook () in + let hb2 = GPack.paned `VERTICAL ~packing:hb#add2 () in + let fr_a = GBin.frame ~shadow_type:`IN ~packing:hb2#add () in + let fr_b = GBin.frame ~shadow_type:`IN ~packing:hb2#add () in + let sw2 = GBin.scrolled_window + ~vpolicy:`AUTOMATIC + ~hpolicy:`AUTOMATIC + ~packing:(fr_a#add) () in + let sw3 = GBin.scrolled_window + ~vpolicy:`AUTOMATIC + ~hpolicy:`AUTOMATIC + ~packing:(fr_b#add) () in + let lower_hbox = GPack.hbox ~homogeneous:false ~packing:vbox#pack () in + let status_bar = GMisc.statusbar ~packing:(lower_hbox#pack ~expand:true) () + in + let search_lbl = GMisc.label ~text:"Search:" + ~show:false + ~packing:(lower_hbox#pack ~expand:false) () + in + let search_history = ref [] in + let search_input = GEdit.combo ~popdown_strings:!search_history + ~enable_arrow_keys:true + ~show:false + ~packing:(lower_hbox#pack ~expand:false) () + in + search_input#disable_activate (); + let ready_to_wrap_search = ref false in + + let start_of_search = ref None in + let start_of_found = ref None in + let end_of_found = ref None in + let search_forward = ref true in + let matched_word = ref None in + + let memo_search () = + matched_word := Some search_input#entry#text + + (* if not (List.mem search_input#entry#text !search_history) then + (search_history := + search_input#entry#text::!search_history; + search_input#set_popdown_strings !search_history); + start_of_search := None; + ready_to_wrap_search := false + *) + + in + let end_search () = + prerr_endline "End Search"; + memo_search (); + let v = (get_current_view ()).view in + v#buffer#move_mark `SEL_BOUND (v#buffer#get_iter_at_mark `INSERT); + v#coerce#misc#grab_focus (); + search_input#entry#set_text ""; + search_lbl#misc#hide (); + search_input#misc#hide () + in + let end_search_focus_out () = + prerr_endline "End Search(focus out)"; + memo_search (); + let v = (get_current_view ()).view in + v#buffer#move_mark `SEL_BOUND (v#buffer#get_iter_at_mark `INSERT); + search_input#entry#set_text ""; + search_lbl#misc#hide (); + search_input#misc#hide () + in + ignore (search_input#entry#connect#activate ~callback:end_search); + ignore (search_input#entry#event#connect#key_press + ~callback:(fun k -> let kv = GdkEvent.Key.keyval k in + if + kv = GdkKeysyms._Right + || kv = GdkKeysyms._Up + || kv = GdkKeysyms._Left + || (kv = GdkKeysyms._g + && (List.mem `CONTROL (GdkEvent.Key.state k))) + then end_search (); + false)); + ignore (search_input#entry#event#connect#focus_out + ~callback:(fun _ -> end_search_focus_out (); false)); + to_do_on_page_switch := + (fun i -> + start_of_search := None; + ready_to_wrap_search:=false)::!to_do_on_page_switch; + + (* TODO : make it work !!! *) + let rec search_f () = + search_lbl#misc#show (); + search_input#misc#show (); + + prerr_endline "search_f called"; + if !start_of_search = None then begin + (* A full new search is starting *) + start_of_search := + Some ((get_current_view ()).view#buffer#create_mark + ((get_current_view ()).view#buffer#get_iter_at_mark `INSERT)); + start_of_found := !start_of_search; + end_of_found := !start_of_search; + matched_word := Some ""; + end; + let txt = search_input#entry#text in + let v = (get_current_view ()).view in + let iit = v#buffer#get_iter_at_mark `SEL_BOUND + and insert_iter = v#buffer#get_iter_at_mark `INSERT + in + prerr_endline ("SELBOUND="^(string_of_int iit#offset)); + prerr_endline ("INSERT="^(string_of_int insert_iter#offset)); + + (match + if !search_forward then iit#forward_search txt + else let npi = iit#forward_chars (Glib.Utf8.length txt) in + match + (npi#offset = (v#buffer#get_iter_at_mark `INSERT)#offset), + (let t = iit#get_text ~stop:npi in + !flash_info (t^"\n"^txt); + t = txt) + with + | true,true -> + (!flash_info "T,T";iit#backward_search txt) + | false,true -> !flash_info "F,T";Some (iit,npi) + | _,false -> + (iit#backward_search txt) + + with + | None -> + if !ready_to_wrap_search then begin + ready_to_wrap_search := false; + !flash_info "Search wrapped"; + v#buffer#place_cursor + (if !search_forward then v#buffer#start_iter else + v#buffer#end_iter); + search_f () + end else begin + if !search_forward then !flash_info "Search at end" + else !flash_info "Search at start"; + ready_to_wrap_search := true + end + | Some (start,stop) -> + prerr_endline "search: before moving marks"; + prerr_endline ("SELBOUND="^(string_of_int (v#buffer#get_iter_at_mark `SEL_BOUND)#offset)); + prerr_endline ("INSERT="^(string_of_int (v#buffer#get_iter_at_mark `INSERT)#offset)); + + v#buffer#move_mark `SEL_BOUND start; + v#buffer#move_mark `INSERT stop; + prerr_endline "search: after moving marks"; + prerr_endline ("SELBOUND="^(string_of_int (v#buffer#get_iter_at_mark `SEL_BOUND)#offset)); + prerr_endline ("INSERT="^(string_of_int (v#buffer#get_iter_at_mark `INSERT)#offset)); + v#scroll_to_mark `SEL_BOUND + ) + in + ignore (search_input#entry#event#connect#key_release + ~callback: + (fun ev -> + if GdkEvent.Key.keyval ev = GdkKeysyms._Escape then begin + let v = (get_current_view ()).view in + (match !start_of_search with + | None -> + prerr_endline "search_key_rel: Placing sel_bound"; + v#buffer#move_mark + `SEL_BOUND + (v#buffer#get_iter_at_mark `INSERT) + | Some mk -> let it = v#buffer#get_iter_at_mark + (`MARK mk) in + prerr_endline "search_key_rel: Placing cursor"; + v#buffer#place_cursor it; + start_of_search := None + ); + search_input#entry#set_text ""; + v#coerce#misc#grab_focus (); + end; + false + )); + ignore (search_input#entry#connect#changed search_f); + + (* + ignore (search_if#connect#activate + ~callback:(fun b -> + search_forward:= true; + search_input#entry#coerce#misc#grab_focus (); + search_f (); + ) + ); + ignore (search_ib#connect#activate + ~callback:(fun b -> + search_forward:= false; + + (* Must restore the SEL_BOUND mark after + grab_focus ! *) + let v = (get_current_view ()).view in + let old_sel = v#buffer#get_iter_at_mark `SEL_BOUND + in + search_input#entry#coerce#misc#grab_focus (); + v#buffer#move_mark `SEL_BOUND old_sel; + search_f (); + )); + *) + let status_context = status_bar#new_context "Messages" in + let flash_context = status_bar#new_context "Flash" in + ignore (status_context#push "Ready"); + status := Some status_bar; + push_info := (fun s -> ignore (status_context#push s)); + pop_info := (fun () -> status_context#pop ()); + flash_info := (fun ?(delay=5000) s -> flash_context#flash ~delay s); + + (* Location display *) + let l = GMisc.label + ~text:"Line: 1 Char: 1" + ~packing:lower_hbox#pack () in + l#coerce#misc#set_name "location"; + set_location := l#set_text; + + (* Progress Bar *) + pulse := + (let pb = GRange.progress_bar ~pulse_step:0.2 ~packing:lower_hbox#pack () + in pb#set_text "CoqIde started";pb)#pulse; + let tv2 = GText.view ~packing:(sw2#add) () in + tv2#misc#set_name "GoalWindow"; + let _ = tv2#set_editable false in + let tb2 = tv2#buffer in + let tv3 = GText.view ~packing:(sw3#add) () in + tv2#misc#set_name "MessageWindow"; + let _ = tv2#set_wrap_mode `CHAR in + let _ = tv3#set_wrap_mode `WORD in + let _ = tv3#set_editable false in + let _ = GtkBase.Widget.add_events tv2#as_widget + [`ENTER_NOTIFY;`POINTER_MOTION] in + let _ = + tv2#event#connect#motion_notify + ~callback: + (fun e -> + let win = match tv2#get_window `WIDGET with + | None -> assert false + | Some w -> w in + let x,y = Gdk.Window.get_pointer_location win in + let b_x,b_y = tv2#window_to_buffer_coords ~tag:`WIDGET ~x ~y in + let it = tv2#get_iter_at_location ~x:b_x ~y:b_y in + let tags = it#tags in + List.iter + (fun t -> + ignore(GtkText.Tag.event t#as_tag tv2#as_widget e it#as_iter)) + tags; + false) in + change_font := + (fun fd -> + tv2#misc#modify_font fd; + tv3#misc#modify_font fd; + Vector.iter + (fun {view=view} -> view#misc#modify_font fd) + input_views; + ); + let about (b:GText.buffer) = + (try + let image = lib_ide_file "coq.png" in + let startup_image = GdkPixbuf.from_file image in + b#insert_pixbuf ~iter:b#start_iter + ~pixbuf:startup_image; + b#insert ~iter:b#start_iter "\t\t"; + with _ -> ()); + let about_string = + "\nCoqIDE: an Integrated Development Environment for Coq\n\ \nMain author : Benjamin Monate\ \nContributors : Jean-Christophe Filliâtre\ \n Pierre Letouzey, Claude Marché\n\ @@ -3225,102 +3226,102 @@ with _ := Induction for _ Sort _.\n",61,10, Some GdkKeysyms._S); \n\thttp://coq.inria.fr/bin/coq-bugs\n\ \nVersion information\ \n-------------------\n" - in - if Glib.Utf8.validate about_string - then b#insert about_string; - let coq_version = Coq.version () in - if Glib.Utf8.validate coq_version - then b#insert coq_version; - - in - about tv2#buffer; - w#add_accel_group accel_group; - (* Remove default pango menu for textviews *) - ignore (tv2#event#connect#button_press ~callback: - (fun ev -> GdkEvent.Button.button ev = 3)); - ignore (tv3#event#connect#button_press ~callback: - (fun ev -> GdkEvent.Button.button ev = 3)); - tv2#misc#set_can_focus true; - tv3#misc#set_can_focus true; - ignore (tv2#buffer#create_mark - ~name:"end_of_conclusion" - tv2#buffer#start_iter); - ignore (tv3#buffer#create_tag - ~name:"error" - [`FOREGROUND "red"]); - w#show (); - message_view := Some tv3; - proof_view := Some tv2; - tv2#misc#modify_font !current.text_font; - tv3#misc#modify_font !current.text_font; - ignore (about_m#connect#activate - ~callback:(fun () -> tv2#buffer#set_text ""; about tv2#buffer)); -(* - ignore (faq_m#connect#activate - ~callback:(fun () -> - load (lib_ide_file "FAQ"))); - -*) - resize_window := (fun () -> - w#resize - ~width:!current.window_width - ~height:!current.window_height); - - ignore (w#misc#connect#size_allocate - (let old_w = ref 0 - and old_h = ref 0 in - fun {Gtk.width=w;Gtk.height=h} -> - if !old_w <> w or !old_h <> h then - begin - old_h := h; - old_w := w; - hb#set_position (w/2); - hb2#set_position (h/2); - !current.window_height <- h; - !current.window_width <- w; - end - )); - ignore(nb#connect#switch_page - ~callback: - (fun i -> - prerr_endline ("switch_page: starts " ^ string_of_int i); - List.iter (function f -> f i) !to_do_on_page_switch; - prerr_endline "switch_page: success") - ); - ignore(tv2#event#connect#enter_notify - (fun _ -> - if !current.contextual_menus_on_goal then - begin - let w = (out_some (get_active_view ()).analyzed_view) in - !push_info "Computing advanced goal's menus"; - prerr_endline "Entering Goal Window. Computing Menus...."; - w#show_goals_full; - prerr_endline "....Done with Goal menu"; - !pop_info(); - end; - false; - )); - if List.length files >=1 then - begin - List.iter (fun f -> - if Sys.file_exists f then load f else - if Filename.check_suffix f ".v" - then load f - else load (f^".v")) files; - activate_input 0 - end - else - begin - let view = create_input_tab "*Unnamed Buffer*" in - let index = add_input_view {view = view; - analyzed_view = None; - } - in - (get_input_view index).analyzed_view <- Some (new analyzed_view index); - activate_input index; - set_tab_image index ~icon:`YES; - view#misc#modify_font !current.text_font - end; + in + if Glib.Utf8.validate about_string + then b#insert about_string; + let coq_version = Coq.version () in + if Glib.Utf8.validate coq_version + then b#insert coq_version; + + in + about tv2#buffer; + w#add_accel_group accel_group; + (* Remove default pango menu for textviews *) + ignore (tv2#event#connect#button_press ~callback: + (fun ev -> GdkEvent.Button.button ev = 3)); + ignore (tv3#event#connect#button_press ~callback: + (fun ev -> GdkEvent.Button.button ev = 3)); + tv2#misc#set_can_focus true; + tv3#misc#set_can_focus true; + ignore (tv2#buffer#create_mark + ~name:"end_of_conclusion" + tv2#buffer#start_iter); + ignore (tv3#buffer#create_tag + ~name:"error" + [`FOREGROUND "red"]); + w#show (); + message_view := Some tv3; + proof_view := Some tv2; + tv2#misc#modify_font !current.text_font; + tv3#misc#modify_font !current.text_font; + ignore (about_m#connect#activate + ~callback:(fun () -> tv2#buffer#set_text ""; about tv2#buffer)); + (* + ignore (faq_m#connect#activate + ~callback:(fun () -> + load (lib_ide_file "FAQ"))); + + *) + resize_window := (fun () -> + w#resize + ~width:!current.window_width + ~height:!current.window_height); + + ignore (w#misc#connect#size_allocate + (let old_w = ref 0 + and old_h = ref 0 in + fun {Gtk.width=w;Gtk.height=h} -> + if !old_w <> w or !old_h <> h then + begin + old_h := h; + old_w := w; + hb#set_position (w/2); + hb2#set_position (h/2); + !current.window_height <- h; + !current.window_width <- w; + end + )); + ignore(nb#connect#switch_page + ~callback: + (fun i -> + prerr_endline ("switch_page: starts " ^ string_of_int i); + List.iter (function f -> f i) !to_do_on_page_switch; + prerr_endline "switch_page: success") + ); + ignore(tv2#event#connect#enter_notify + (fun _ -> + if !current.contextual_menus_on_goal then + begin + let w = (out_some (get_active_view ()).analyzed_view) in + !push_info "Computing advanced goal's menus"; + prerr_endline "Entering Goal Window. Computing Menus...."; + w#show_goals_full; + prerr_endline "....Done with Goal menu"; + !pop_info(); + end; + false; + )); + if List.length files >=1 then + begin + List.iter (fun f -> + if Sys.file_exists f then load f else + if Filename.check_suffix f ".v" + then load f + else load (f^".v")) files; + activate_input 0 + end + else + begin + let view = create_input_tab "*Unnamed Buffer*" in + let index = add_input_view {view = view; + analyzed_view = None; + } + in + (get_input_view index).analyzed_view <- Some (new analyzed_view index); + activate_input index; + set_tab_image index ~icon:`YES; + view#misc#modify_font !current.text_font + end; ;; @@ -3342,35 +3343,39 @@ let rec check_for_geoproof_input () = (* cb_Dr#clear does not work so i use : *) (* cb_Dr#set_text "Ack" *) done - - + + let start () = let files = Coq.init () in - ignore_break (); - GtkMain.Rc.add_default_file (lib_ide_file ".coqide-gtk2rc"); - (try - GtkMain.Rc.add_default_file (Filename.concat System.home ".coqide-gtk2rc"); - with Not_found -> ()); - ignore (GtkMain.Main.init ()); - GtkData.AccelGroup.set_default_mod_mask - (Some [`CONTROL;`SHIFT;`MOD1;`MOD3;`MOD4]); - cb_ := Some (GData.clipboard Gdk.Atom.primary); - ignore ( - Glib.Message.set_log_handler ~domain:"Gtk" ~levels:[`ERROR;`FLAG_FATAL; - `WARNING;`CRITICAL] - (fun ~level msg -> failwith ("Coqide internal error: " ^ msg))); - Command_windows.main (); - Blaster_window.main 9; - main files; - ignore (Thread.create check_for_geoproof_input ()); - while true do - try - GtkThread.main () - with - | Sys.Break -> prerr_endline "Interrupted." ; flush stderr - | e -> - Pervasives.prerr_endline ("CoqIde unexpected error:" ^ (Printexc.to_string e)); - flush stderr; - crash_save 127 - done - + ignore_break (); + GtkMain.Rc.add_default_file (lib_ide_file ".coqide-gtk2rc"); + (try + GtkMain.Rc.add_default_file (Filename.concat System.home ".coqide-gtk2rc"); + with Not_found -> ()); + ignore (GtkMain.Main.init ()); + GtkData.AccelGroup.set_default_mod_mask + (Some [`CONTROL;`SHIFT;`MOD1;`MOD3;`MOD4]); + cb_ := Some (GData.clipboard Gdk.Atom.primary); + ignore ( + Glib.Message.set_log_handler ~domain:"Gtk" ~levels:[`ERROR;`FLAG_FATAL; + `WARNING;`CRITICAL] + (fun ~level msg -> + if level land Glib.Message.log_level `WARNING <> 0 + then Pp.warning msg + else failwith ("Coqide internal error: " ^ msg))); + Command_windows.main (); + Blaster_window.main 9; + main files; + if !Coq_config.with_geoproof then ignore (Thread.create check_for_geoproof_input ()); + while true do + try + GtkThread.main () + with + | Sys.Break -> prerr_endline "Interrupted." ; flush stderr + | e -> + Pervasives.prerr_endline ("CoqIde unexpected error:" ^ (Printexc.to_string e)); + flush stderr; + crash_save 127 + done + + diff --git a/ide/highlight.mll b/ide/highlight.mll index d68cb8a4..27ead696 100644 --- a/ide/highlight.mll +++ b/ide/highlight.mll @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: highlight.mll 6362 2004-11-27 14:39:35Z herbelin $ *) +(* $Id: highlight.mll 8880 2006-05-31 10:52:08Z notin $ *) { @@ -21,29 +21,35 @@ let is_keyword = let h = Hashtbl.create 97 in List.iter (fun s -> Hashtbl.add h s ()) - [ "Add" ; "Defined" ; - "End" ; "Export" ; "Extraction" ; "Hint" ; "Hints" ; + [ "Add" ; "Check"; "Defined" ; + "End" ; "Eval"; "Export" ; "Extraction" ; "Hint" ; "Hints" ; "Implicits" ; "Import" ; - "Infix" ; "Load" ; "match" ; "Module" ; - "Proof" ; "Qed" ; - "Require" ; "Save" ; "Scheme" ; + "Infix" ; "Load" ; "Module" ; + "Notation"; "Proof" ; "Print"; "Qed" ; + "Require" ; "Reset"; "Undo"; "Save" ; "Section" ; "Unset" ; "Set" ; "Notation" ]; Hashtbl.mem h + let is_constr_kw = + let h = Hashtbl.create 97 in + List.iter (fun s -> Hashtbl.add h s ()) + [ "forall"; "fun"; "match"; "fix"; "cofix"; "with"; "for"; + "end"; "as"; "let"; "if"; "then"; "else"; "return"; + "Prop"; "Set"; "Type"]; + Hashtbl.mem h + let is_declaration = let h = Hashtbl.create 97 in - List.iter (fun s -> Hashtbl.add h s ()) - [ "Lemma" ; "Axiom" ; "CoFixpoint" ; "Definition" ; - "Fixpoint" ; "Hypothesis" ; - "Hypotheses" ; "Axioms" ; "Parameters" ; "Subclass" ; - "Remark" ; "Fact" ; "Conjecture" ; "Let" ; - "CoInductive" ; "Record" ; "Structure" ; - "Inductive" ; "Parameter" ; "Theorem" ; - "Variable" ; "Variables" - ]; - Hashtbl.mem h + List.iter (fun s -> Hashtbl.add h s ()) + [ "Theorem" ; "Lemma" ; "Fact" ; "Remark" ; "Corollary" ; "Proposition" ; "Property" ; + "Definition" ; "Let" ; "Example" ; "SubClass" ; "Inductive" ; "CoInductive" ; + "Record" ; "Structure" ; "Fixpoint" ; "CoFixpoint"; + "Hypothesis" ; "Variable" ; "Axiom" ; "Parameter" ; "Conjecture" ; + "Hypotheses" ; "Variables" ; "Axioms" ; "Parameters" + ]; + Hashtbl.mem h } @@ -55,24 +61,41 @@ let identchar = ['$' 'A'-'Z' 'a'-'z' '_' '\192'-'\214' '\216'-'\246' '\248'-'\255' '\'' '0'-'9'] let ident = firstchar identchar* +let thm_token = "Theorem" | "Lemma" | "Fact" | "Remark" | "Corollary" | "Proposition" | "Property" + +let def_token = "Definition" | "Let" | "Example" | "SubClass" + +let assumption = "Hypothesis" | "Variable" | "Axiom" | "Parameter" | "Conjecture" | + "Hypotheses" | "Variables" | "Axioms" | "Parameters" + let declaration = - "Lemma" | "Axiom" | "CoFixpoint" | "Definition" | - "Fixpoint" | "Hypothesis" | - "Inductive" | "Parameter" | "Theorem" | - "Variable" | "Variables" | "Declare" space+ "Module" + "Theorem" | "Lemma" | "Fact" | "Remark" | "Corollary" | "Proposition" | "Property" | + "Definition" | "Let" | "Example" | "SubClass" | + "Inductive" | "CoInductive" | + "Record" | "Structure" | + "Fixpoint" | "CoFixpoint" rule next_order = parse | "(*" { comment_start := lexeme_start lexbuf; comment lexbuf } | "Module Type" - { lexeme_start lexbuf,lexeme_end lexbuf, "kwd" } + { lexeme_start lexbuf, lexeme_end lexbuf, "kwd" } | ident as id { if is_keyword id then - lexeme_start lexbuf,lexeme_end lexbuf, "kwd" - else - next_order lexbuf } - | declaration space+ ident (space* ',' space* ident)* - { lexeme_start lexbuf, lexeme_end lexbuf, "decl" } + lexeme_start lexbuf, lexeme_end lexbuf, "kwd" + else + begin + if is_constr_kw id then + lexeme_start lexbuf, lexeme_end lexbuf, "kwd" + else + begin + if is_declaration id then + lexeme_start lexbuf, lexeme_end lexbuf, "decl" + else + next_order lexbuf + end + end + } | _ { next_order lexbuf} | eof { raise End_of_file } diff --git a/ide/ideutils.ml b/ide/ideutils.ml index 5143358a..65aef17f 100644 --- a/ide/ideutils.ml +++ b/ide/ideutils.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: ideutils.ml 7609 2005-11-25 17:14:39Z barras $ *) +(* $Id: ideutils.ml 8912 2006-06-07 11:20:58Z notin $ *) open Preferences @@ -314,8 +314,8 @@ let same_file f1 f2 = let s1 = Unix.stat f1 and s2 = Unix.stat f2 in - (s1.Unix.st_dev = s2.Unix.st_dev) && - (s1.Unix.st_ino = s2.Unix.st_ino) + (s1.Unix.st_dev = s2.Unix.st_dev) && + (s1.Unix.st_ino = s2.Unix.st_ino) with Unix.Unix_error _ -> false diff --git a/ide/preferences.ml b/ide/preferences.ml index 8629fe8e..4cf9627c 100644 --- a/ide/preferences.ml +++ b/ide/preferences.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: preferences.ml 7046 2005-05-20 07:38:25Z herbelin $ *) +(* $Id: preferences.ml 8920 2006-06-08 09:12:48Z notin $ *) open Configwin open Printf @@ -180,8 +180,7 @@ let save_pref () = add "encoding_use_utf8" [string_of_bool p.encoding_use_utf8] ++ add "encoding_manual" [p.encoding_manual] ++ - add "automatic_tactics" - (List.rev p.automatic_tactics) ++ + add "automatic_tactics" p.automatic_tactics ++ add "cmd_print" [p.cmd_print] ++ add "modifier_for_navigation" (List.map mod_to_str p.modifier_for_navigation) ++ diff --git a/interp/constrextern.ml b/interp/constrextern.ml index 6442cb94..daa57b77 100644 --- a/interp/constrextern.ml +++ b/interp/constrextern.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: constrextern.ml 8675 2006-03-31 18:21:20Z herbelin $ *) +(* $Id: constrextern.ml 8831 2006-05-19 09:29:54Z herbelin $ *) (*i*) open Pp @@ -27,6 +27,7 @@ open Pattern open Nametab open Notation open Reserve +open Detyping (*i*) (* Translation from rawconstr to front constr *) @@ -259,7 +260,7 @@ let rec same_raw c d = (fun (t1,(al1,oind1)) (t2,(al2,oind2)) -> same_raw t1 t2; if al1 <> al2 then failwith "RCases"; - option_iter2(fun (_,i1,nl1) (_,i2,nl2) -> + option_iter2(fun (_,i1,_,nl1) (_,i2,_,nl2) -> if i1<>i2 || nl1 <> nl2 then failwith "RCases") oind1 oind2) c1 c2; List.iter2 (fun (_,_,pl1,b1) (_,_,pl2,b2) -> List.iter2 same_patt pl1 pl2; @@ -622,6 +623,11 @@ let extern_optimal_prim_token scopes r r' = (**********************************************************************) (* mapping rawterms to constr_expr *) +let extern_rawsort = function + | RProp _ as s -> s + | RType (Some _) as s when !print_universes -> s + | RType _ -> RType None + let rec extern inctx scopes vars r = let r' = remove_coercions inctx r in try @@ -679,7 +685,7 @@ let rec extern inctx scopes vars r = let vars' = List.fold_right (name_fold Idset.add) (cases_predicate_names tml) vars in - let rtntypopt' = option_app (extern_typ scopes vars') rtntypopt in + let rtntypopt' = option_map (extern_typ scopes vars') rtntypopt in let tml = List.map (fun (tm,(na,x)) -> let na' = match na,tm with Anonymous, RVar (_,id) when @@ -689,26 +695,28 @@ let rec extern inctx scopes vars r = | Name id, RVar (_,id') when id=id' -> None | Name _, _ -> Some na in (sub_extern false scopes vars tm, - (na',option_app (fun (loc,ind,nal) -> + (na',option_map (fun (loc,ind,n,nal) -> + let params = list_tabulate + (fun _ -> RHole (dummy_loc,Evd.InternalHole)) n in let args = List.map (function | Anonymous -> RHole (dummy_loc,Evd.InternalHole) | Name id -> RVar (dummy_loc,id)) nal in - let t = RApp (dummy_loc,RRef (dummy_loc,IndRef ind),args) in + let t = RApp (dummy_loc,RRef (dummy_loc,IndRef ind),params@args) in (extern_typ scopes vars t)) x))) tml in let eqns = List.map (extern_eqn (rtntypopt<>None) scopes vars) eqns in CCases (loc,rtntypopt',tml,eqns) | RLetTuple (loc,nal,(na,typopt),tm,b) -> CLetTuple (loc,nal, - (option_app (fun _ -> na) typopt, - option_app (extern_typ scopes (add_vname vars na)) typopt), + (option_map (fun _ -> na) typopt, + option_map (extern_typ scopes (add_vname vars na)) typopt), sub_extern false scopes vars tm, extern false scopes (List.fold_left add_vname vars nal) b) | RIf (loc,c,(na,typopt),b1,b2) -> CIf (loc,sub_extern false scopes vars c, - (option_app (fun _ -> na) typopt, - option_app (extern_typ scopes (add_vname vars na)) typopt), + (option_map (fun _ -> na) typopt, + option_map (extern_typ scopes (add_vname vars na)) typopt), sub_extern false scopes vars b1, sub_extern false scopes vars b2) | RRec (loc,fk,idv,blv,tyv,bv) -> @@ -737,12 +745,7 @@ let rec extern inctx scopes vars r = in CCoFix (loc,(loc,idv.(n)),Array.to_list listdecl)) - | RSort (loc,s) -> - let s = match s with - | RProp _ -> s - | RType (Some _) when !print_universes -> s - | RType _ -> RType None in - CSort (loc,s) + | RSort (loc,s) -> CSort (loc,extern_rawsort s) | RHole (loc,e) -> CHole loc @@ -870,9 +873,18 @@ let extern_type at_top env t = let r = Detyping.detype at_top avoid (names_of_rel_context env) t in extern_rawtype (vars_of_env env) r +let extern_sort s = extern_rawsort (detype_sort s) + (******************************************************************) (* Main translation function from pattern -> constr_expr *) +let it_destPLambda n c = + let rec aux n nal c = + if n=0 then (nal,c) else match c with + | PLambda (na,_,c) -> aux (n-1) (na::nal) c + | _ -> anomaly "it_destPLambda" in + aux n [] c + let rec raw_of_pat env = function | PRef ref -> RRef (loc,ref) | PVar id -> RVar (loc,id) @@ -897,20 +909,24 @@ let rec raw_of_pat env = function RLetIn (loc,na,raw_of_pat env t, raw_of_pat (na::env) c) | PLambda (na,t,c) -> RLambda (loc,na,raw_of_pat env t, raw_of_pat (na::env) c) - | PCase ((_,cs),typopt,tm,[||]) -> - if typopt <> None then failwith "TODO: PCase to RCases"; - RCases (loc,(*(option_app (raw_of_pat env) typopt,*)None, - [raw_of_pat env tm,(Anonymous,None)],[]) - | PCase ((Some ind,cs),typopt,tm,bv) -> - let avoid = List.fold_right (name_fold (fun x l -> x::l)) env [] in - let mib,mip = lookup_mind_specif (Global.env()) ind in - let k = mip.Declarations.mind_nrealargs in - let nparams = mib.Declarations.mind_nparams in - let cstrnargs = mip.Declarations.mind_consnrealdecls in - Detyping.detype_case false (raw_of_pat env) (raw_of_eqns env) - (fun _ _ -> false (* lazy: don't try to display pattern with "if" *)) - avoid (ind,cs,nparams,cstrnargs,k) typopt tm bv - | PCase _ -> error "Unsupported case-analysis while printing pattern" + | PIf (c,b1,b2) -> + RIf (loc, raw_of_pat env c, (Anonymous,None), + raw_of_pat env b1, raw_of_pat env b2) + | PCase ((LetStyle,[|n|],ind,None),PMeta None,tm,[|b|]) -> + let nal,b = it_destRLambda_or_LetIn_names n (raw_of_pat env b) in + RLetTuple (loc,nal,(Anonymous,None),raw_of_pat env tm,b) + | PCase ((_,cstr_nargs,indo,ind_nargs),p,tm,bv) -> + let brs = Array.to_list (Array.map (raw_of_pat env) bv) in + let brns = Array.to_list cstr_nargs in + (* ind is None only if no branch and no return type *) + let ind = out_some indo in + let mat = simple_cases_matrix_of_branches ind brns brs in + let indnames,rtn = + if p = PMeta None then (Anonymous,None),None + else + let nparams,n = out_some ind_nargs in + return_type_of_predicate ind nparams n (raw_of_pat env p) in + RCases (loc,rtn,[raw_of_pat env tm,indnames],mat) | PFix f -> Detyping.detype false [] env (mkFix f) | PCoFix c -> Detyping.detype false [] env (mkCoFix c) | PSort s -> RSort (loc,s) diff --git a/interp/constrextern.mli b/interp/constrextern.mli index 1fc44250..ca145dd9 100644 --- a/interp/constrextern.mli +++ b/interp/constrextern.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: constrextern.mli 7837 2006-01-11 09:47:32Z herbelin $ i*) +(*i $Id: constrextern.mli 8831 2006-05-19 09:29:54Z herbelin $ i*) (*i*) open Util @@ -41,6 +41,7 @@ val extern_constr : bool -> env -> constr -> constr_expr val extern_constr_in_scope : bool -> scope_name -> env -> constr -> constr_expr val extern_reference : loc -> Idset.t -> global_reference -> reference val extern_type : bool -> env -> types -> constr_expr +val extern_sort : sorts -> rawsort (* Printing options *) val print_implicits : bool ref diff --git a/interp/constrintern.ml b/interp/constrintern.ml index 6fcd9d7a..678fb87b 100644 --- a/interp/constrintern.ml +++ b/interp/constrintern.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: constrintern.ml 8654 2006-03-22 15:36:58Z msozeau $ *) +(* $Id: constrintern.ml 8924 2006-06-08 17:49:01Z notin $ *) open Pp open Util @@ -22,6 +22,7 @@ open Cases open Topconstr open Nametab open Notation +open Inductiveops (* To interpret implicits and arg scopes of recursive variables in inductive types and recursive definitions *) @@ -38,8 +39,8 @@ let interning_grammar = ref false let for_grammar f x = interning_grammar := true; let a = f x in - interning_grammar := false; - a + interning_grammar := false; + a let variables_bind = ref false @@ -128,9 +129,9 @@ type coqdoc_state = Lexer.location_table * int * int let coqdoc_freeze () = let lt = Lexer.location_table() in let state = (lt,!token_number,!last_pos) in - token_number := 0; - last_pos := 0; - state + token_number := 0; + last_pos := 0; + state let coqdoc_unfreeze (lt,tn,lp) = Lexer.restore_location_table lt; @@ -138,21 +139,13 @@ let coqdoc_unfreeze (lt,tn,lp) = last_pos := lp let add_glob loc ref = -(*i - let sp = Nametab.sp_of_global (Global.env ()) ref in - let dir,_ = repr_path sp in - let rec find_module d = - try - let qid = let dir,id = split_dirpath d in make_qualid dir id in - let _ = Nametab.locate_loaded_library qid in d - with Not_found -> find_module (dirpath_prefix d) - in - let s = string_of_dirpath (find_module dir) in - i*) let sp = Nametab.sp_of_global ref in - let id = let _,id = repr_path sp in string_of_id id in - let dp = string_of_dirpath (Lib.library_part ref) in - dump_string (Printf.sprintf "R%d %s.%s\n" (fst (unloc loc)) dp id) + let lib_dp = Lib.library_part ref in + let mod_dp,id = repr_path sp in + let mod_dp_trunc = drop_dirpath_prefix lib_dp mod_dp in + let filepath = string_of_dirpath lib_dp in + let fullname = string_of_qualid (make_qualid mod_dp_trunc id) in + dump_string (Printf.sprintf "R%d %s %s\n" (fst (unloc loc)) filepath fullname) let loc_of_notation f loc args ntn = if args=[] or ntn.[0] <> '_' then fst (unloc loc) @@ -165,15 +158,15 @@ let dump_notation_location pos ((path,df),sc) = let rec next growing = let loc = Lexer.location_function !token_number in let (bp,_) = unloc loc in - if growing then if bp >= pos then loc else (incr token_number;next true) - else if bp = pos then loc - else if bp > pos then (decr token_number;next false) - else (incr token_number;next true) in + if growing then if bp >= pos then loc else (incr token_number;next true) + else if bp = pos then loc + else if bp > pos then (decr token_number;next false) + else (incr token_number;next true) in let loc = next (pos >= !last_pos) in - last_pos := pos; - let path = string_of_dirpath path in - let sc = match sc with Some sc -> " "^sc | None -> "" in - dump_string (Printf.sprintf "R%d %s \"%s\"%s\n" (fst (unloc loc)) path df sc) + last_pos := pos; + let path = string_of_dirpath path in + let sc = match sc with Some sc -> " "^sc | None -> "" in + dump_string (Printf.sprintf "R%d %s \"%s\"%s\n" (fst (unloc loc)) path df sc) (**********************************************************************) (* Contracting "{ _ }" in notations *) @@ -390,11 +383,6 @@ let check_constructor_length env loc cstr pl pl0 = if n <> nargs && n <> nhyps (* i.e. with let's *) then error_wrong_numarg_constructor_loc loc env cstr nargs -let check_inductive_length env (loc,ind,nal) = - let n = Inductiveops.inductive_nargs env ind in - if n <> List.length nal then - error_wrong_numarg_inductive_loc loc env ind n - (* Manage multiple aliases *) (* [merge_aliases] returns the sets of all aliases encountered at this @@ -506,20 +494,20 @@ let find_constructor ref = try extended_locate qid with Not_found -> raise (InternalisationError (loc,NotAConstructor ref)) in - match gref with - | SyntacticDef sp -> - let sdef = Syntax_def.search_syntactic_definition loc sp in - patt_of_rawterm loc sdef - | TrueGlobal r -> - let rec unf = function - | ConstRef cst -> - let v = Environ.constant_value (Global.env()) cst in - unf (global_of_constr v) - | ConstructRef c -> - if !dump then add_glob loc r; - c, [] - | _ -> raise Not_found - in unf r + match gref with + | SyntacticDef sp -> + let sdef = Syntax_def.search_syntactic_definition loc sp in + patt_of_rawterm loc sdef + | TrueGlobal r -> + let rec unf = function + | ConstRef cst -> + let v = Environ.constant_value (Global.env()) cst in + unf (global_of_constr v) + | ConstructRef c -> + if !dump then add_glob loc r; + c, [] + | _ -> raise Not_found + in unf r let find_pattern_variable = function | Ident (loc,id) -> id @@ -793,7 +781,7 @@ let internalise sigma globalenv env allow_soapp lvar c = RStructRec, List.fold_left intern_local_binder (env,[]) bl | CWfRec c -> - let before, after = list_chop (succ n) bl in + let before, after = list_chop (succ (out_some n)) bl in let ((ids',_,_),rafter) = List.fold_left intern_local_binder (env,[]) after in let ro = RWfRec (intern (ids', tmp_scope, scopes) c) in @@ -887,21 +875,21 @@ let internalise sigma globalenv env allow_soapp lvar c = let (tm,ind),nal = intern_case_item env citm in (tm,ind)::inds,List.fold_left (push_name_env lvar) env nal) tms ([],env) in - let rtnpo = option_app (intern_type env') rtnpo in + let rtnpo = option_map (intern_type env') rtnpo in let eqns' = List.map (intern_eqn (List.length tms) env) eqns in RCases (loc, rtnpo, tms, List.flatten eqns') | CLetTuple (loc, nal, (na,po), b, c) -> let env' = reset_tmp_scope env in let ((b',(na',_)),ids) = intern_case_item env' (b,(na,None)) in let env'' = List.fold_left (push_name_env lvar) env ids in - let p' = option_app (intern_type env'') po in + let p' = option_map (intern_type env'') po in RLetTuple (loc, nal, (na', p'), b', intern (List.fold_left (push_name_env lvar) env nal) c) | CIf (loc, c, (na,po), b1, b2) -> let env' = reset_tmp_scope env in let ((c',(na',_)),ids) = intern_case_item env' (c,(na,None)) in let env'' = List.fold_left (push_name_env lvar) env ids in - let p' = option_app (intern_type env'') po in + let p' = option_map (intern_type env'') po in RIf (loc, c', (na', p'), intern env b1, intern env b2) | CHole loc -> RHole (loc, Evd.QuestionMark) @@ -958,18 +946,25 @@ let internalise sigma globalenv env allow_soapp lvar c = let tids = names_of_cases_indtype t in let tids = List.fold_right Idset.add tids Idset.empty in let t = intern_type (tids,None,scopes) t in - let (_,_,nal as indsign) = + let (_,_,_,nal as indsign) = match t with - | RRef (loc,IndRef ind) -> (loc,ind,[]) + | RRef (loc,IndRef ind) -> (loc,ind,0,[]) | RApp (loc,RRef (_,IndRef ind),l) -> + let nparams, nrealargs = inductive_nargs globalenv ind in + let nindargs = nparams + nrealargs in + if List.length l <> nindargs then + error_wrong_numarg_inductive_loc loc globalenv ind nindargs; let nal = List.map (function | RHole _ -> Anonymous | RVar (_,id) -> Name id | c -> user_err_loc (loc_of_rawconstr c,"",str "Not a name")) l in - (loc,ind,nal) + let parnal,realnal = list_chop nparams nal in + if List.exists ((<>) Anonymous) parnal then + user_err_loc (loc,"", + str "The parameters of inductive type must be implicit"); + (loc,ind,nparams,realnal) | _ -> error_bad_inductive_type (loc_of_rawconstr t) in - check_inductive_length globalenv indsign; nal, Some indsign | None -> [], None in diff --git a/interp/coqlib.ml b/interp/coqlib.ml index afee83e8..79a217a1 100644 --- a/interp/coqlib.ml +++ b/interp/coqlib.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: coqlib.ml 8688 2006-04-07 15:08:12Z msozeau $ *) +(* $Id: coqlib.ml 8866 2006-05-28 16:21:04Z herbelin $ *) open Util open Pp @@ -152,12 +152,7 @@ type coq_sigma_data = { type 'a delayed = unit -> 'a -let build_sigma_set () = - { proj1 = init_constant ["Specif"] "projS1"; - proj2 = init_constant ["Specif"] "projS2"; - elim = init_constant ["Specif"] "sigS_rec"; - intro = init_constant ["Specif"] "existS"; - typ = init_constant ["Specif"] "sigS" } +let build_sigma_set () = anomaly "Use build_sigma_type" let build_sigma_type () = { proj1 = init_constant ["Specif"] "projT1"; @@ -257,7 +252,7 @@ let build_coq_ex () = Lazy.force coq_ex (* The following is less readable but does not depend on parsing *) let coq_eq_ref = lazy (init_reference ["Logic"] "eq") let coq_identity_ref = lazy (init_reference ["Datatypes"] "identity") -let coq_existS_ref = lazy (init_reference ["Specif"] "existS") +let coq_existS_ref = lazy (anomaly "use coq_existT_ref") let coq_existT_ref = lazy (init_reference ["Specif"] "existT") let coq_not_ref = lazy (init_reference ["Logic"] "not") let coq_False_ref = lazy (init_reference ["Logic"] "False") diff --git a/interp/genarg.ml b/interp/genarg.ml index 511cf88a..77ed1fe6 100644 --- a/interp/genarg.ml +++ b/interp/genarg.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: genarg.ml 7879 2006-01-16 13:58:09Z herbelin $ *) +(* $Id: genarg.ml 8926 2006-06-08 20:23:17Z herbelin $ *) open Pp open Util @@ -33,7 +33,6 @@ type argument_type = | ConstrArgType | ConstrMayEvalArgType | QuantHypArgType - | TacticArgType of int | OpenConstrArgType of bool | ConstrWithBindingsArgType | BindingsArgType @@ -44,7 +43,6 @@ type argument_type = | PairArgType of argument_type * argument_type | ExtraArgType of string -type 'a or_var = ArgArg of 'a | ArgVar of identifier located type 'a and_short_name = 'a * identifier located option type rawconstr_and_expr = rawconstr * constr_expr option @@ -54,6 +52,10 @@ type ('a,'b) generic_argument = argument_type * Obj.t let dyntab = ref ([] : string list) +type rlevel = constr_expr +type glevel = rawconstr_and_expr +type tlevel = constr + type ('a,'b,'c) abstract_argument_type = argument_type let create_arg s = @@ -142,10 +144,6 @@ let rawwit_constr_may_eval = ConstrMayEvalArgType let globwit_constr_may_eval = ConstrMayEvalArgType let wit_constr_may_eval = ConstrMayEvalArgType -let rawwit_tactic n = TacticArgType n -let globwit_tactic n = TacticArgType n -let wit_tactic n = TacticArgType n - let rawwit_open_constr_gen b = OpenConstrArgType b let globwit_open_constr_gen b = OpenConstrArgType b let wit_open_constr_gen b = OpenConstrArgType b @@ -220,7 +218,7 @@ let app_list1 f = function let app_opt f = function | (OptArgType t as u, l) -> let o = Obj.magic l in - (u, Obj.repr (option_app (fun x -> out_gen t (f (in_gen t x))) o)) + (u, Obj.repr (option_map (fun x -> out_gen t (f (in_gen t x))) o)) | _ -> failwith "Genarg: not an opt" let app_pair f1 f2 = function diff --git a/interp/genarg.mli b/interp/genarg.mli index 99de4ca4..37b30927 100644 --- a/interp/genarg.mli +++ b/interp/genarg.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: genarg.mli 7879 2006-01-16 13:58:09Z herbelin $ i*) +(*i $Id: genarg.mli 8926 2006-06-08 20:23:17Z herbelin $ i*) open Util open Names @@ -16,7 +16,6 @@ open Rawterm open Topconstr open Term -type 'a or_var = ArgArg of 'a | ArgVar of identifier located type 'a and_short_name = 'a * identifier located option (* In globalize tactics, we need to keep the initial [constr_expr] to recompute*) @@ -73,7 +72,6 @@ RefArgType reference global_reference ConstrArgType constr_expr constr ConstrMayEvalArgType constr_expr may_eval constr QuantHypArgType quantified_hypothesis quantified_hypothesis -TacticArgType raw_tactic_expr tactic OpenConstrArgType constr_expr open_constr ConstrBindingsArgType constr_expr with_bindings constr with_bindings List0ArgType of argument_type @@ -83,88 +81,94 @@ ExtraArgType of string '_a '_b \end{verbatim} *) -type ('a,'co,'ta) abstract_argument_type +(* All of [rlevel], [glevel] and [tlevel] must be non convertible + to ensure the injectivity of the type inference from type + [('co,'ta) generic_argument] to [('a,'co,'ta) abstract_argument_type] + is injective; this guarantees that, for 'b fixed, the type of + out_gen is monomorphic over 'a, hence type-safe +*) -val rawwit_bool : (bool,'co,'ta) abstract_argument_type -val globwit_bool : (bool,'co,'ta) abstract_argument_type -val wit_bool : (bool,'co,'ta) abstract_argument_type +type rlevel = constr_expr +type glevel = rawconstr_and_expr +type tlevel = constr + +type ('a,'co,'ta) abstract_argument_type -val rawwit_int : (int,'co,'ta) abstract_argument_type -val globwit_int : (int,'co,'ta) abstract_argument_type -val wit_int : (int,'co,'ta) abstract_argument_type +val rawwit_bool : (bool,rlevel,'ta) abstract_argument_type +val globwit_bool : (bool,glevel,'ta) abstract_argument_type +val wit_bool : (bool,tlevel,'ta) abstract_argument_type -val rawwit_int_or_var : (int or_var,'co,'ta) abstract_argument_type -val globwit_int_or_var : (int or_var,'co,'ta) abstract_argument_type -val wit_int_or_var : (int or_var,'co,'ta) abstract_argument_type +val rawwit_int : (int,rlevel,'ta) abstract_argument_type +val globwit_int : (int,glevel,'ta) abstract_argument_type +val wit_int : (int,tlevel,'ta) abstract_argument_type -val rawwit_string : (string,'co,'ta) abstract_argument_type -val globwit_string : (string,'co,'ta) abstract_argument_type -val wit_string : (string,'co,'ta) abstract_argument_type +val rawwit_int_or_var : (int or_var,rlevel,'ta) abstract_argument_type +val globwit_int_or_var : (int or_var,glevel,'ta) abstract_argument_type +val wit_int_or_var : (int or_var,tlevel,'ta) abstract_argument_type -val rawwit_pre_ident : (string,'co,'ta) abstract_argument_type -val globwit_pre_ident : (string,'co,'ta) abstract_argument_type -val wit_pre_ident : (string,'co,'ta) abstract_argument_type +val rawwit_string : (string,rlevel,'ta) abstract_argument_type +val globwit_string : (string,glevel,'ta) abstract_argument_type +val wit_string : (string,tlevel,'ta) abstract_argument_type -val rawwit_intro_pattern : (intro_pattern_expr,'co,'ta) abstract_argument_type -val globwit_intro_pattern : (intro_pattern_expr,'co,'ta) abstract_argument_type -val wit_intro_pattern : (intro_pattern_expr,'co,'ta) abstract_argument_type +val rawwit_pre_ident : (string,rlevel,'ta) abstract_argument_type +val globwit_pre_ident : (string,glevel,'ta) abstract_argument_type +val wit_pre_ident : (string,tlevel,'ta) abstract_argument_type -val rawwit_ident : (identifier,'co,'ta) abstract_argument_type -val globwit_ident : (identifier,'co,'ta) abstract_argument_type -val wit_ident : (identifier,'co,'ta) abstract_argument_type +val rawwit_intro_pattern : (intro_pattern_expr,rlevel,'ta) abstract_argument_type +val globwit_intro_pattern : (intro_pattern_expr,glevel,'ta) abstract_argument_type +val wit_intro_pattern : (intro_pattern_expr,tlevel,'ta) abstract_argument_type -val rawwit_var : (identifier located,'co,'ta) abstract_argument_type -val globwit_var : (identifier located,'co,'ta) abstract_argument_type -val wit_var : (identifier,'co,'ta) abstract_argument_type +val rawwit_ident : (identifier,rlevel,'ta) abstract_argument_type +val globwit_ident : (identifier,glevel,'ta) abstract_argument_type +val wit_ident : (identifier,tlevel,'ta) abstract_argument_type -val rawwit_ref : (reference,constr_expr,'ta) abstract_argument_type -val globwit_ref : (global_reference located or_var,rawconstr_and_expr,'ta) abstract_argument_type -val wit_ref : (global_reference,constr,'ta) abstract_argument_type +val rawwit_var : (identifier located,rlevel,'ta) abstract_argument_type +val globwit_var : (identifier located,glevel,'ta) abstract_argument_type +val wit_var : (identifier,tlevel,'ta) abstract_argument_type -val rawwit_quant_hyp : (quantified_hypothesis,'co,'ta) abstract_argument_type -val globwit_quant_hyp : (quantified_hypothesis,'co,'ta) abstract_argument_type -val wit_quant_hyp : (quantified_hypothesis,'co,'ta) abstract_argument_type +val rawwit_ref : (reference,rlevel,'ta) abstract_argument_type +val globwit_ref : (global_reference located or_var,glevel,'ta) abstract_argument_type +val wit_ref : (global_reference,tlevel,'ta) abstract_argument_type -val rawwit_sort : (rawsort,constr_expr,'ta) abstract_argument_type -val globwit_sort : (rawsort,rawconstr_and_expr,'ta) abstract_argument_type -val wit_sort : (sorts,constr,'ta) abstract_argument_type +val rawwit_quant_hyp : (quantified_hypothesis,rlevel,'ta) abstract_argument_type +val globwit_quant_hyp : (quantified_hypothesis,glevel,'ta) abstract_argument_type +val wit_quant_hyp : (quantified_hypothesis,tlevel,'ta) abstract_argument_type -val rawwit_constr : (constr_expr,constr_expr,'ta) abstract_argument_type -val globwit_constr : (rawconstr_and_expr,rawconstr_and_expr,'ta) abstract_argument_type -val wit_constr : (constr,constr,'ta) abstract_argument_type +val rawwit_sort : (rawsort,rlevel,'ta) abstract_argument_type +val globwit_sort : (rawsort,glevel,'ta) abstract_argument_type +val wit_sort : (sorts,tlevel,'ta) abstract_argument_type -val rawwit_constr_may_eval : ((constr_expr,reference) may_eval,constr_expr,'ta) abstract_argument_type -val globwit_constr_may_eval : ((rawconstr_and_expr,evaluable_global_reference and_short_name or_var) may_eval,rawconstr_and_expr,'ta) abstract_argument_type -val wit_constr_may_eval : (constr,constr,'ta) abstract_argument_type +val rawwit_constr : (constr_expr,rlevel,'ta) abstract_argument_type +val globwit_constr : (rawconstr_and_expr,glevel,'ta) abstract_argument_type +val wit_constr : (constr,tlevel,'ta) abstract_argument_type -val rawwit_open_constr_gen : bool -> (open_constr_expr,constr_expr,'ta) abstract_argument_type -val globwit_open_constr_gen : bool -> (open_rawconstr,rawconstr_and_expr,'ta) abstract_argument_type -val wit_open_constr_gen : bool -> (open_constr,constr,'ta) abstract_argument_type +val rawwit_constr_may_eval : ((constr_expr,reference) may_eval,rlevel,'ta) abstract_argument_type +val globwit_constr_may_eval : ((rawconstr_and_expr,evaluable_global_reference and_short_name or_var) may_eval,glevel,'ta) abstract_argument_type +val wit_constr_may_eval : (constr,tlevel,'ta) abstract_argument_type -val rawwit_open_constr : (open_constr_expr,constr_expr,'ta) abstract_argument_type -val globwit_open_constr : (open_rawconstr,rawconstr_and_expr,'ta) abstract_argument_type -val wit_open_constr : (open_constr,constr,'ta) abstract_argument_type +val rawwit_open_constr_gen : bool -> (open_constr_expr,rlevel,'ta) abstract_argument_type +val globwit_open_constr_gen : bool -> (open_rawconstr,glevel,'ta) abstract_argument_type +val wit_open_constr_gen : bool -> (open_constr,tlevel,'ta) abstract_argument_type -val rawwit_casted_open_constr : (open_constr_expr,constr_expr,'ta) abstract_argument_type -val globwit_casted_open_constr : (open_rawconstr,rawconstr_and_expr,'ta) abstract_argument_type -val wit_casted_open_constr : (open_constr,constr,'ta) abstract_argument_type +val rawwit_open_constr : (open_constr_expr,rlevel,'ta) abstract_argument_type +val globwit_open_constr : (open_rawconstr,glevel,'ta) abstract_argument_type +val wit_open_constr : (open_constr,tlevel,'ta) abstract_argument_type -val rawwit_constr_with_bindings : (constr_expr with_bindings,constr_expr,'ta) abstract_argument_type -val globwit_constr_with_bindings : (rawconstr_and_expr with_bindings,rawconstr_and_expr,'ta) abstract_argument_type -val wit_constr_with_bindings : (constr with_bindings,constr,'ta) abstract_argument_type +val rawwit_casted_open_constr : (open_constr_expr,rlevel,'ta) abstract_argument_type +val globwit_casted_open_constr : (open_rawconstr,glevel,'ta) abstract_argument_type +val wit_casted_open_constr : (open_constr,tlevel,'ta) abstract_argument_type -val rawwit_bindings : (constr_expr bindings,constr_expr,'ta) abstract_argument_type -val globwit_bindings : (rawconstr_and_expr bindings,rawconstr_and_expr,'ta) abstract_argument_type -val wit_bindings : (constr bindings,constr,'ta) abstract_argument_type +val rawwit_constr_with_bindings : (constr_expr with_bindings,rlevel,'ta) abstract_argument_type +val globwit_constr_with_bindings : (rawconstr_and_expr with_bindings,glevel,'ta) abstract_argument_type +val wit_constr_with_bindings : (constr with_bindings,tlevel,'ta) abstract_argument_type -val rawwit_red_expr : ((constr_expr,reference) red_expr_gen,constr_expr,'ta) abstract_argument_type -val globwit_red_expr : ((rawconstr_and_expr,evaluable_global_reference and_short_name or_var) red_expr_gen,rawconstr_and_expr,'ta) abstract_argument_type -val wit_red_expr : ((constr,evaluable_global_reference) red_expr_gen,constr,'ta) abstract_argument_type +val rawwit_bindings : (constr_expr bindings,rlevel,'ta) abstract_argument_type +val globwit_bindings : (rawconstr_and_expr bindings,glevel,'ta) abstract_argument_type +val wit_bindings : (constr bindings,tlevel,'ta) abstract_argument_type -(* TODO: transformer tactic en extra arg *) -val rawwit_tactic : int -> ('ta,constr_expr,'ta) abstract_argument_type -val globwit_tactic : int -> ('ta,rawconstr_and_expr,'ta) abstract_argument_type -val wit_tactic : int -> ('ta,constr,'ta) abstract_argument_type +val rawwit_red_expr : ((constr_expr,reference) red_expr_gen,rlevel,'ta) abstract_argument_type +val globwit_red_expr : ((rawconstr_and_expr,evaluable_global_reference and_short_name or_var) red_expr_gen,glevel,'ta) abstract_argument_type +val wit_red_expr : ((constr,evaluable_global_reference) red_expr_gen,tlevel,'ta) abstract_argument_type val wit_list0 : ('a,'co,'ta) abstract_argument_type -> ('a list,'co,'ta) abstract_argument_type @@ -217,9 +221,9 @@ val app_pair : polymorphism, on aimerait que 'b et 'c restent polymorphes à l'appel de create *) val create_arg : string -> - ('a,'co,'ta) abstract_argument_type - * ('globa,'globco,'globta) abstract_argument_type - * ('rawa,'rawco,'rawta) abstract_argument_type + ('a,tlevel,'ta) abstract_argument_type + * ('globa,glevel,'globta) abstract_argument_type + * ('rawa,rlevel,'rawta) abstract_argument_type val exists_argtype : string -> bool @@ -239,7 +243,6 @@ type argument_type = | ConstrArgType | ConstrMayEvalArgType | QuantHypArgType - | TacticArgType of int | OpenConstrArgType of bool | ConstrWithBindingsArgType | BindingsArgType diff --git a/interp/notation.ml b/interp/notation.ml index cb996dfe..7e101784 100644 --- a/interp/notation.ml +++ b/interp/notation.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: notation.ml 7984 2006-02-04 20:14:55Z herbelin $ *) +(* $Id: notation.ml 8752 2006-04-27 19:37:33Z herbelin $ *) (*i*) open Util @@ -234,12 +234,12 @@ let delay dir int loc x = (dir, (fun () -> int loc x)) let declare_numeral_interpreter sc dir interp (patl,uninterp,inpat) = declare_prim_token_interpreter sc (fun cont loc -> function Numeral n-> delay dir interp loc n | p -> cont loc p) - (patl, (fun r -> option_app mkNumeral (uninterp r)), inpat) + (patl, (fun r -> option_map mkNumeral (uninterp r)), inpat) let declare_string_interpreter sc dir interp (patl,uninterp,inpat) = declare_prim_token_interpreter sc (fun cont loc -> function String s -> delay dir interp loc s | p -> cont loc p) - (patl, (fun r -> option_app mkString (uninterp r)), inpat) + (patl, (fun r -> option_map mkString (uninterp r)), inpat) let check_required_module loc sc (sp,d) = try let _ = Nametab.absolute_reference sp in () @@ -389,7 +389,7 @@ let uninterp_prim_token_cases_pattern c = let availability_of_prim_token printer_scope scopes = let f scope = Hashtbl.mem prim_token_interpreter_tab scope in - option_app snd (find_without_delimiters f (Some printer_scope,None) scopes) + option_map snd (find_without_delimiters f (Some printer_scope,None) scopes) (* Miscellaneous *) diff --git a/interp/reserve.ml b/interp/reserve.ml index 476fd7e6..aee981bd 100644 --- a/interp/reserve.ml +++ b/interp/reserve.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: reserve.ml 7732 2005-12-26 13:51:24Z herbelin $ i*) +(*i $Id: reserve.ml 8752 2006-04-27 19:37:33Z herbelin $ i*) (* Reserved names *) @@ -59,17 +59,17 @@ let rec unloc = function | RLetIn (_,na,b,c) -> RLetIn (dummy_loc,na,unloc b,unloc c) | RCases (_,rtntypopt,tml,pl) -> RCases (dummy_loc, - (option_app unloc rtntypopt), + (option_map unloc rtntypopt), List.map (fun (tm,x) -> (unloc tm,x)) tml, List.map (fun (_,idl,p,c) -> (dummy_loc,idl,p,unloc c)) pl) | RLetTuple (_,nal,(na,po),b,c) -> - RLetTuple (dummy_loc,nal,(na,option_app unloc po),unloc b,unloc c) + RLetTuple (dummy_loc,nal,(na,option_map unloc po),unloc b,unloc c) | RIf (_,c,(na,po),b1,b2) -> - RIf (dummy_loc,unloc c,(na,option_app unloc po),unloc b1,unloc b2) + RIf (dummy_loc,unloc c,(na,option_map unloc po),unloc b1,unloc b2) | RRec (_,fk,idl,bl,tyl,bv) -> RRec (dummy_loc,fk,idl, Array.map (List.map - (fun (na,obd,ty) -> (na,option_app unloc obd, unloc ty))) + (fun (na,obd,ty) -> (na,option_map unloc obd, unloc ty))) bl, Array.map unloc tyl, Array.map unloc bv) diff --git a/interp/topconstr.ml b/interp/topconstr.ml index 82f74f40..f7256026 100644 --- a/interp/topconstr.ml +++ b/interp/topconstr.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: topconstr.ml 8624 2006-03-13 17:38:17Z msozeau $ *) +(* $Id: topconstr.ml 8875 2006-05-29 19:59:11Z msozeau $ *) (*i*) open Pp @@ -38,14 +38,14 @@ type aconstr = | AProd of name * aconstr * aconstr | ALetIn of name * aconstr * aconstr | ACases of aconstr option * - (aconstr * (name * (inductive * name list) option)) list * + (aconstr * (name * (inductive * int * name list) option)) list * (identifier list * cases_pattern list * aconstr) list | ALetTuple of name list * (name * aconstr option) * aconstr * aconstr | AIf of aconstr * (name * aconstr option) * aconstr * aconstr | ASort of rawsort | AHole of Evd.hole_kind | APatVar of patvar - | ACast of aconstr * cast_kind * aconstr + | ACast of aconstr * cast_type * aconstr let name_app f e = function | Name id -> let (id, e) = f id e in (e, Name id) @@ -76,25 +76,25 @@ let rawconstr_of_aconstr_with_binders loc g f e = function let e',tml' = List.fold_right (fun (tm,(na,t)) (e',tml') -> let e',t' = match t with | None -> e',None - | Some (ind,nal) -> + | Some (ind,npar,nal) -> let e',nal' = List.fold_right (fun na (e',nal) -> let e',na' = name_app g e' na in e',na'::nal) nal (e',[]) in - e',Some (loc,ind,nal') in + e',Some (loc,ind,npar,nal') in let e',na' = name_app g e' na in (e',(f e tm,(na',t'))::tml')) tml (e,[]) in let fold id (idl,e) = let (id,e) = g id e in (id::idl,e) in let eqnl' = List.map (fun (idl,pat,rhs) -> let (idl,e) = List.fold_right fold idl ([],e) in (loc,idl,pat,f e rhs)) eqnl in - RCases (loc,option_app (f e') rtntypopt,tml',eqnl') + RCases (loc,option_map (f e') rtntypopt,tml',eqnl') | ALetTuple (nal,(na,po),b,c) -> let e,nal = list_fold_map (name_app g) e nal in let e,na = name_app g e na in - RLetTuple (loc,nal,(na,option_app (f e) po),f e b,f e c) + RLetTuple (loc,nal,(na,option_map (f e) po),f e b,f e c) | AIf (c,(na,po),b1,b2) -> let e,na = name_app g e na in - RIf (loc,f e c,(na,option_app (f e) po),f e b1,f e b2) - | ACast (c,k,t) -> RCast (loc,f e c,k,f e t) + RIf (loc,f e c,(na,option_map (f e) po),f e b1,f e b2) + | ACast (c,k,t) -> RCast (loc,f e c, k,f e t) | ASort x -> RSort (loc,x) | AHole x -> RHole (loc,x) | APatVar n -> RPatVar (loc,(false,n)) @@ -182,20 +182,20 @@ let aconstr_and_vars_of_rawconstr a = let f (_,idl,pat,rhs) = found := idl@(!found); (idl,pat,aux rhs) in - ACases (option_app aux rtntypopt, + ACases (option_map aux rtntypopt, List.map (fun (tm,(na,x)) -> add_name found na; option_iter - (fun (_,_,nl) -> List.iter (add_name found) nl) x; - (aux tm,(na,option_app (fun (_,ind,nal) -> (ind,nal)) x))) tml, + (fun (_,_,_,nl) -> List.iter (add_name found) nl) x; + (aux tm,(na,option_map (fun (_,ind,n,nal) -> (ind,n,nal)) x))) tml, List.map f eqnl) | RLetTuple (loc,nal,(na,po),b,c) -> add_name found na; List.iter (add_name found) nal; - ALetTuple (nal,(na,option_app aux po),aux b,aux c) + ALetTuple (nal,(na,option_map aux po),aux b,aux c) | RIf (loc,c,(na,po),b1,b2) -> add_name found na; - AIf (aux c,(na,option_app aux po),aux b1,aux b2) + AIf (aux c,(na,option_map aux po),aux b1,aux b2) | RCast (_,c,k,t) -> ACast (aux c,k,aux t) | RSort (_,s) -> ASort s | RHole (_,w) -> AHole w @@ -289,9 +289,9 @@ let rec subst_aconstr subst bound raw = and rl' = list_smartmap (fun (a,(n,signopt) as x) -> let a' = subst_aconstr subst bound a in - let signopt' = option_app (fun ((indkn,i),nal as z) -> + let signopt' = option_map (fun ((indkn,i),n,nal as z) -> let indkn' = subst_kn subst indkn in - if indkn == indkn' then z else ((indkn',i),nal)) signopt in + if indkn == indkn' then z else ((indkn',i),n,nal)) signopt in if a' == a && signopt' == signopt then x else (a',(n,signopt'))) rl and branches' = list_smartmap @@ -341,7 +341,7 @@ let encode_list_value l = RApp (dummy_loc,RVar (dummy_loc,ldots_var),l) (* Pattern-matching rawconstr and aconstr *) let abstract_return_type_context pi mklam tml rtno = - option_app (fun rtn -> + option_map (fun rtn -> let nal = List.flatten (List.map (fun (_,(na,t)) -> match t with Some x -> (pi x)@[na] | None -> [na]) tml) in @@ -349,11 +349,11 @@ let abstract_return_type_context pi mklam tml rtno = rtno let abstract_return_type_context_rawconstr = - abstract_return_type_context pi3 + abstract_return_type_context (fun (_,_,_,nal) -> nal) (fun na c -> RLambda(dummy_loc,na,RHole(dummy_loc,Evd.InternalHole),c)) let abstract_return_type_context_aconstr = - abstract_return_type_context snd + abstract_return_type_context pi3 (fun na c -> ALambda(na,AHole Evd.InternalHole,c)) let rec adjust_scopes = function @@ -524,7 +524,7 @@ type constr_expr = | CPatVar of loc * (bool * patvar) | CEvar of loc * existential_key | CSort of loc * rawsort - | CCast of loc * constr_expr * cast_kind * constr_expr + | CCast of loc * constr_expr * cast_type * constr_expr | CNotation of loc * notation * constr_expr list | CPrim of loc * prim_token | CDelimiters of loc * string * constr_expr @@ -532,7 +532,7 @@ type constr_expr = and fixpoint_expr = - identifier * (int * recursion_order_expr) * local_binder list * constr_expr * constr_expr + identifier * (int option * recursion_order_expr) * local_binder list * constr_expr * constr_expr and local_binder = | LocalRawDef of name located * constr_expr @@ -718,15 +718,15 @@ let map_constr_expr_with_binders f g e = function indnal (option_fold_right (name_fold g) na e)) a e in - CCases (loc,option_app (f e') rtnpo, + CCases (loc,option_map (f e') rtnpo, List.map (fun (tm,x) -> (f e tm,x)) a,bl) | CLetTuple (loc,nal,(ona,po),b,c) -> let e' = List.fold_right (name_fold g) nal e in let e'' = option_fold_right (name_fold g) ona e in - CLetTuple (loc,nal,(ona,option_app (f e'') po),f e b,f e' c) + CLetTuple (loc,nal,(ona,option_map (f e'') po),f e b,f e' c) | CIf (loc,c,(ona,po),b1,b2) -> let e' = option_fold_right (name_fold g) ona e in - CIf (loc,f e c,(ona,option_app (f e') po),f e b1,f e b2) + CIf (loc,f e c,(ona,option_map (f e') po),f e b1,f e b2) | CFix (loc,id,dl) -> CFix (loc,id,List.map (fun (id,n,bl,t,d) -> let (e',bl') = map_local_binders f g e bl in diff --git a/interp/topconstr.mli b/interp/topconstr.mli index 2f4f667d..8305ea54 100644 --- a/interp/topconstr.mli +++ b/interp/topconstr.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: topconstr.mli 8624 2006-03-13 17:38:17Z msozeau $ i*) +(*i $Id: topconstr.mli 8875 2006-05-29 19:59:11Z msozeau $ i*) (*i*) open Pp @@ -34,14 +34,14 @@ type aconstr = | AProd of name * aconstr * aconstr | ALetIn of name * aconstr * aconstr | ACases of aconstr option * - (aconstr * (name * (inductive * name list) option)) list * + (aconstr * (name * (inductive * int * name list) option)) list * (identifier list * cases_pattern list * aconstr) list | ALetTuple of name list * (name * aconstr option) * aconstr * aconstr | AIf of aconstr * (name * aconstr option) * aconstr * aconstr | ASort of rawsort | AHole of Evd.hole_kind | APatVar of patvar - | ACast of aconstr * cast_kind * aconstr + | ACast of aconstr * cast_type * aconstr val rawconstr_of_aconstr_with_binders : loc -> (identifier -> 'a -> identifier * 'a) -> @@ -107,14 +107,14 @@ type constr_expr = | CPatVar of loc * (bool * patvar) | CEvar of loc * existential_key | CSort of loc * rawsort - | CCast of loc * constr_expr * cast_kind * constr_expr + | CCast of loc * constr_expr * cast_type * constr_expr | CNotation of loc * notation * constr_expr list | CPrim of loc * prim_token | CDelimiters of loc * string * constr_expr | CDynamic of loc * Dyn.t and fixpoint_expr = - identifier * (int * recursion_order_expr) * local_binder list * constr_expr * constr_expr + identifier * (int option * recursion_order_expr) * local_binder list * constr_expr * constr_expr and cofixpoint_expr = identifier * local_binder list * constr_expr * constr_expr @@ -143,7 +143,7 @@ val names_of_cases_indtype : constr_expr -> identifier list val mkIdentC : identifier -> constr_expr val mkRefC : reference -> constr_expr val mkAppC : constr_expr * constr_expr list -> constr_expr -val mkCastC : constr_expr * cast_kind * constr_expr -> constr_expr +val mkCastC : constr_expr * cast_type * constr_expr -> constr_expr val mkLambdaC : name located list * constr_expr * constr_expr -> constr_expr val mkLetInC : name located * constr_expr * constr_expr -> constr_expr val mkProdC : name located list * constr_expr * constr_expr -> constr_expr diff --git a/kernel/closure.ml b/kernel/closure.ml index 8e16a922..617611bf 100644 --- a/kernel/closure.ml +++ b/kernel/closure.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: closure.ml 7639 2005-12-02 10:01:15Z gregoire $ *) +(* $Id: closure.ml 8802 2006-05-10 20:47:28Z barras $ *) open Util open Pp @@ -394,90 +394,6 @@ let create mk_cl flgs env = (**********************************************************************) -(* The type of (machine) stacks (= lambda-bar-calculus' contexts) *) - -type 'a stack_member = - | Zapp of 'a list - | Zcase of case_info * 'a * 'a array - | Zfix of 'a * 'a stack - | Zshift of int - | Zupdate of 'a - -and 'a stack = 'a stack_member list - -let empty_stack = [] -let append_stack_list = function - | ([],s) -> s - | (l1, Zapp l :: s) -> Zapp (l1@l) :: s - | (l1, s) -> Zapp l1 :: s -let append_stack v s = append_stack_list (Array.to_list v, s) - -(* Collapse the shifts in the stack *) -let zshift n s = - match (n,s) with - (0,_) -> s - | (_,Zshift(k)::s) -> Zshift(n+k)::s - | _ -> Zshift(n)::s - -let rec stack_args_size = function - | Zapp l::s -> List.length l + stack_args_size s - | Zshift(_)::s -> stack_args_size s - | Zupdate(_)::s -> stack_args_size s - | _ -> 0 - -(* When used as an argument stack (only Zapp can appear) *) -let rec decomp_stack = function - | Zapp[v]::s -> Some (v, s) - | Zapp(v::l)::s -> Some (v, (Zapp l :: s)) - | Zapp [] :: s -> decomp_stack s - | _ -> None -let rec decomp_stackn = function - | Zapp [] :: s -> decomp_stackn s - | Zapp l :: s -> (Array.of_list l, s) - | _ -> assert false -let array_of_stack s = - let rec stackrec = function - | [] -> [] - | Zapp args :: s -> args :: (stackrec s) - | _ -> assert false - in Array.of_list (List.concat (stackrec s)) -let rec list_of_stack = function - | [] -> [] - | Zapp args :: s -> args @ (list_of_stack s) - | _ -> assert false -let rec app_stack = function - | f, [] -> f - | f, (Zapp [] :: s) -> app_stack (f, s) - | f, (Zapp args :: s) -> - app_stack (applist (f, args), s) - | _ -> assert false -let rec stack_assign s p c = match s with - | Zapp args :: s -> - let q = List.length args in - if p >= q then - Zapp args :: stack_assign s (p-q) c - else - (match list_chop p args with - (bef, _::aft) -> Zapp (bef@c::aft) :: s - | _ -> assert false) - | _ -> s -let rec stack_tail p s = - if p = 0 then s else - match s with - | Zapp args :: s -> - let q = List.length args in - if p >= q then stack_tail (p-q) s - else Zapp (list_skipn p args) :: s - | _ -> failwith "stack_tail" -let rec stack_nth s p = match s with - | Zapp args :: s -> - let q = List.length args in - if p >= q then stack_nth s (p-q) - else List.nth args p - | _ -> raise Not_found - - -(**********************************************************************) (* Lazy reduction: the one used in kernel operations *) (* type of shared terms. fconstr and frterm are mutually recursive. @@ -543,6 +459,81 @@ let update v1 (no,t) = v1) else {norm=no;term=t} +(**********************************************************************) +(* The type of (machine) stacks (= lambda-bar-calculus' contexts) *) + +type stack_member = + | Zapp of fconstr array + | Zcase of case_info * fconstr * fconstr array + | Zfix of fconstr * stack + | Zshift of int + | Zupdate of fconstr + +and stack = stack_member list + +let empty_stack = [] +let append_stack v s = + if Array.length v = 0 then s else + match s with + | Zapp l :: s -> Zapp (Array.append v l) :: s + | _ -> Zapp v :: s + +(* Collapse the shifts in the stack *) +let zshift n s = + match (n,s) with + (0,_) -> s + | (_,Zshift(k)::s) -> Zshift(n+k)::s + | _ -> Zshift(n)::s + +let rec stack_args_size = function + | Zapp v :: s -> Array.length v + stack_args_size s + | Zshift(_)::s -> stack_args_size s + | Zupdate(_)::s -> stack_args_size s + | _ -> 0 + +(* When used as an argument stack (only Zapp can appear) *) +let rec decomp_stack = function + | Zapp v :: s -> + (match Array.length v with + 0 -> decomp_stack s + | 1 -> Some (v.(0), s) + | _ -> + Some (v.(0), (Zapp (Array.sub v 1 (Array.length v - 1)) :: s))) + | _ -> None +let rec decomp_stackn = function + | Zapp v :: s -> if Array.length v = 0 then decomp_stackn s else (v, s) + | _ -> assert false +let array_of_stack s = + let rec stackrec = function + | [] -> [] + | Zapp args :: s -> args :: (stackrec s) + | _ -> assert false + in Array.concat (stackrec s) +let rec stack_assign s p c = match s with + | Zapp args :: s -> + let q = Array.length args in + if p >= q then + Zapp args :: stack_assign s (p-q) c + else + (let nargs = Array.copy args in + nargs.(p) <- c; + Zapp nargs :: s) + | _ -> s +let rec stack_tail p s = + if p = 0 then s else + match s with + | Zapp args :: s -> + let q = Array.length args in + if p >= q then stack_tail (p-q) s + else Zapp (Array.sub args p (q-p)) :: s + | _ -> failwith "stack_tail" +let rec stack_nth s p = match s with + | Zapp args :: s -> + let q = Array.length args in + if p >= q then stack_nth s (p-q) + else args.(p) + | _ -> raise Not_found + (* Lifting. Preserves sharing (useful only for cell with norm=Red). lft_fconstr always create a new cell, while lift_fconstr avoids it when the lift is 0. *) @@ -554,7 +545,7 @@ let rec lft_fconstr n ft = | FFix(fx,e) -> {norm=Cstr; term=FFix(fx,subs_shft(n,e))} | FCoFix(cfx,e) -> {norm=Cstr; term=FCoFix(cfx,subs_shft(n,e))} | FLIFT(k,m) -> lft_fconstr (n+k) m - | FLOCKED -> anomaly "lft_constr found locked term" + | FLOCKED -> assert false | _ -> {norm=ft.norm; term=FLIFT(n,ft)} let lift_fconstr k f = if k=0 then f else lft_fconstr k f @@ -568,7 +559,7 @@ let clos_rel e i = | Inl(n,mt) -> lift_fconstr n mt | Inr(k,None) -> {norm=Norm; term= FRel k} | Inr(k,Some p) -> - lift_fconstr (k-p) {norm=Norm;term=FFlex(RelKey p)} + lift_fconstr (k-p) {norm=Red;term=FFlex(RelKey p)} (* since the head may be reducible, we might introduce lifts of 0 *) let compact_stack head stk = @@ -654,9 +645,9 @@ and compact_v acc s v k i = let optimise_closure env c = if is_subs_id env then (env,c) else let (c',(_,s)) = compact_constr (0,[]) c 1 in - let env' = List.fold_left - (fun subs i -> subs_cons (clos_rel env i, subs)) (ESID 0) s in - (env',c') + let env' = + Array.map (fun i -> clos_rel env i) (Array.of_list s) in + (subs_cons (env', ESID 0),c') let mk_lambda env t = let (env,t) = optimise_closure env t in @@ -772,8 +763,7 @@ let rec to_constr constr_fun lfts v = let fr = mk_clos2 env t in let unfv = update v (fr.norm,fr.term) in to_constr constr_fun lfts unfv - | FLOCKED -> (*anomaly "Closure.to_constr: found locked term"*) -mkVar(id_of_string"_LOCK_") + | FLOCKED -> assert false (*mkVar(id_of_string"_LOCK_")*) (* This function defines the correspondance between constr and fconstr. When we find a closure whose substitution is the identity, @@ -802,14 +792,12 @@ let rec fstrong unfreeze_fun lfts v = let rec zip m stk = match stk with | [] -> m - | Zapp args :: s -> - let args = Array.of_list args in - zip {norm=neutr m.norm; term=FApp(m, args)} s + | Zapp args :: s -> zip {norm=neutr m.norm; term=FApp(m, args)} s | Zcase(ci,p,br)::s -> let t = FCases(ci, p, m, br) in zip {norm=neutr m.norm; term=t} s | Zfix(fx,par)::s -> - zip fx (par @ append_stack_list ([m], s)) + zip fx (par @ append_stack [|m|] s) | Zshift(n)::s -> zip (lift_fconstr n m) s | Zupdate(rf)::s -> @@ -842,31 +830,30 @@ let strip_update_shift_app head stk = strip_rec (e::rstk) (lift_fconstr k h) (depth+k) s | (Zapp args :: s) -> strip_rec (Zapp args :: rstk) - {norm=h.norm;term=FApp(h,Array.of_list args)} depth s + {norm=h.norm;term=FApp(h,args)} depth s | Zupdate(m)::s -> strip_rec rstk (update m (h.norm,h.term)) depth s | stk -> (depth,List.rev rstk, stk) in strip_rec [] head 0 stk -let rec get_nth_arg head n stk = +let get_nth_arg head n stk = assert (head.norm <> Red); let rec strip_rec rstk h depth n = function | Zshift(k) as e :: s -> strip_rec (e::rstk) (lift_fconstr k h) (depth+k) n s | Zapp args::s' -> - let q = List.length args in + let q = Array.length args in if n >= q then strip_rec (Zapp args::rstk) - {norm=h.norm;term=FApp(h,Array.of_list args)} depth (n-q) s' + {norm=h.norm;term=FApp(h,args)} depth (n-q) s' else - (match list_chop n args with - (bef, v::aft) -> - let stk' = - List.rev (if n = 0 then rstk else (Zapp bef :: rstk)) in - (Some (stk', v), append_stack_list (aft,s')) - | _ -> assert false) + let bef = Array.sub args 0 n in + let aft = Array.sub args (n+1) (q-n-1) in + let stk' = + List.rev (if n = 0 then rstk else (Zapp bef :: rstk)) in + (Some (stk', args.(n)), append_stack aft s') | Zupdate(m)::s -> strip_rec rstk (update m (h.norm,h.term)) depth n s | s -> (None, List.rev rstk @ s) in @@ -888,18 +875,15 @@ let rec get_args n tys f e stk = | Zshift k :: s -> get_args n tys f (subs_shft (k,e)) s | Zapp l :: s -> - let na = List.length l in - if n == na then - let e' = List.fold_left (fun e arg -> subs_cons(arg,e)) e l in - (Inl e',s) + let na = Array.length l in + if n == na then (Inl (subs_cons(l,e)),s) else if n < na then (* more arguments *) - let (args,eargs) = list_chop n l in - let e' = List.fold_left (fun e arg -> subs_cons(arg,e)) e args in - (Inl e', Zapp eargs :: s) + let args = Array.sub l 0 n in + let eargs = Array.sub l n (na-n) in + (Inl (subs_cons(args,e)), Zapp eargs :: s) else (* more lambdas *) - let (_,etys) = list_chop na tys in - let e' = List.fold_left (fun e arg -> subs_cons(arg,e)) e l in - get_args (n-na) etys f e' s + let etys = list_skipn na tys in + get_args (n-na) etys f (subs_cons(l,e)) s | _ -> (Inr {norm=Cstr;term=FLambda(n,tys,f,e)}, stk) @@ -908,7 +892,7 @@ let rec get_args n tys f e stk = let rec reloc_rargs_rec depth stk = match stk with Zapp args :: s -> - Zapp (lift_fconstr_list depth args) :: reloc_rargs_rec depth s + Zapp (lift_fconstr_vect depth args) :: reloc_rargs_rec depth s | Zshift(k)::s -> if k=depth then s else reloc_rargs_rec (depth-k) s | _ -> stk @@ -918,12 +902,12 @@ let reloc_rargs depth stk = let rec drop_parameters depth n stk = match stk with Zapp args::s -> - let q = List.length args in + let q = Array.length args in if n > q then drop_parameters depth (n-q) s else if n = q then reloc_rargs depth s else - let aft = list_skipn n args in - reloc_rargs depth (append_stack_list (aft,s)) + let aft = Array.sub args n (q-n) in + reloc_rargs depth (append_stack aft s) | Zshift(k)::s -> drop_parameters (depth-k) n s | [] -> assert (n=0); [] | _ -> assert false (* we know that n < stack_args_size(stk) *) @@ -949,15 +933,9 @@ let contract_fix_vect fix = (bds.(i), (fun j -> { norm = Cstr; term = FCoFix ((j,rdcl),env) }), env, Array.length bds) - | _ -> anomaly "Closure.contract_fix_vect: not a (co)fixpoint" + | _ -> assert false in - let rec subst_bodies_from_i i env = - if i = nfix then - (env, thisbody) - else - subst_bodies_from_i (i+1) (subs_cons (make_body i, env)) - in - subst_bodies_from_i 0 env + (subs_cons(Array.init nfix make_body, env), thisbody) (*********************************************************************) @@ -969,7 +947,7 @@ let rec knh m stk = match m.term with | FLIFT(k,a) -> knh a (zshift k stk) | FCLOS(t,e) -> knht e t (zupdate m stk) - | FLOCKED -> anomaly "Closure.knh: found lock" + | FLOCKED -> assert false | FApp(a,b) -> knh a (append_stack b (zupdate m stk)) | FCases(ci,p,t,br) -> knh t (Zcase(ci,p,br)::zupdate m stk) | FFix(((ri,n),(_,_,_)),_) -> @@ -1037,7 +1015,7 @@ let rec knr info m stk = knit info fxe fxbd (args@stk') | (_,args,s) -> (m,args@s)) | FLetIn (_,v,_,bd,e) when red_set info.i_flags fZETA -> - knit info (subs_cons(v,e)) bd stk + knit info (subs_cons([|v|],e)) bd stk | _ -> (m,stk) (* Computes the weak head normal form of a term *) @@ -1056,7 +1034,6 @@ let rec zip_term zfun m stk = match stk with | [] -> m | Zapp args :: s -> - let args = Array.of_list args in zip_term zfun (mkApp(m, Array.map zfun args)) s | Zcase(ci,p,br)::s -> let t = mkCase(ci, zfun p, m, Array.map zfun br) in diff --git a/kernel/closure.mli b/kernel/closure.mli index 706a089e..feec8395 100644 --- a/kernel/closure.mli +++ b/kernel/closure.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: closure.mli 7639 2005-12-02 10:01:15Z gregoire $ i*) +(*i $Id: closure.mli 8793 2006-05-05 17:41:41Z barras $ i*) (*i*) open Pp @@ -91,33 +91,6 @@ val info_flags: 'a infos -> reds val create: ('a infos -> constr -> 'a) -> reds -> env -> 'a infos (************************************************************************) -(*s A [stack] is a context of arguments, arguments are pushed by - [append_stack] one array at a time but popped with [decomp_stack] - one by one *) - -type 'a stack_member = - | Zapp of 'a list - | Zcase of case_info * 'a * 'a array - | Zfix of 'a * 'a stack - | Zshift of int - | Zupdate of 'a - -and 'a stack = 'a stack_member list - -val empty_stack : 'a stack -val append_stack : 'a array -> 'a stack -> 'a stack - -val decomp_stack : 'a stack -> ('a * 'a stack) option -val list_of_stack : 'a stack -> 'a list -val array_of_stack : 'a stack -> 'a array -val stack_assign : 'a stack -> int -> 'a -> 'a stack -val stack_args_size : 'a stack -> int -val app_stack : constr * constr stack -> constr -val stack_tail : int -> 'a stack -> 'a stack -val stack_nth : 'a stack -> int -> 'a -val zip_term : ('a -> constr) -> constr -> 'a stack -> constr - -(************************************************************************) (*s Lazy reduction. *) (* [fconstr] is the type of frozen constr *) @@ -146,17 +119,43 @@ type fterm = | FCLOS of constr * fconstr subs | FLOCKED +(************************************************************************) +(*s A [stack] is a context of arguments, arguments are pushed by + [append_stack] one array at a time but popped with [decomp_stack] + one by one *) + +type stack_member = + | Zapp of fconstr array + | Zcase of case_info * fconstr * fconstr array + | Zfix of fconstr * stack + | Zshift of int + | Zupdate of fconstr + +and stack = stack_member list + +val empty_stack : stack +val append_stack : fconstr array -> stack -> stack + +val decomp_stack : stack -> (fconstr * stack) option +val array_of_stack : stack -> fconstr array +val stack_assign : stack -> int -> fconstr -> stack +val stack_args_size : stack -> int +val stack_tail : int -> stack -> stack +val stack_nth : stack -> int -> fconstr +val zip_term : (fconstr -> constr) -> constr -> stack -> constr + (* To lazy reduce a constr, create a [clos_infos] with [create_clos_infos], inject the term to reduce with [inject]; then use a reduction function *) val inject : constr -> fconstr +(* mk_atom: prevents a term from being evaluated *) +val mk_atom : constr -> fconstr + val fterm_of : fconstr -> fterm val term_of_fconstr : fconstr -> constr val destFLambda : (fconstr subs -> constr -> fconstr) -> fconstr -> name * fconstr * fconstr -(* mk_atom: prevents a term from being evaluated *) -val mk_atom : constr -> fconstr (* Global and local constant cache *) type clos_infos @@ -173,7 +172,7 @@ val whd_val : clos_infos -> fconstr -> constr (* [whd_stack] performs weak head normalization in a given stack. It stops whenever a reduction is blocked. *) val whd_stack : - clos_infos -> fconstr -> fconstr stack -> fconstr * fconstr stack + clos_infos -> fconstr -> stack -> fconstr * stack (* Conversion auxiliary functions to do step by step normalisation *) @@ -195,8 +194,8 @@ val mk_clos_deep : (fconstr subs -> constr -> fconstr) -> fconstr subs -> constr -> fconstr -val kni: clos_infos -> fconstr -> fconstr stack -> fconstr * fconstr stack -val knr: clos_infos -> fconstr -> fconstr stack -> fconstr * fconstr stack +val kni: clos_infos -> fconstr -> stack -> fconstr * stack +val knr: clos_infos -> fconstr -> stack -> fconstr * stack val kl : clos_infos -> fconstr -> constr val to_constr : (lift -> fconstr -> constr) -> lift -> fconstr -> constr diff --git a/kernel/cooking.ml b/kernel/cooking.ml index a6aa2a8e..58c21d9f 100644 --- a/kernel/cooking.ml +++ b/kernel/cooking.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: cooking.ml 6748 2005-02-18 22:17:50Z herbelin $ i*) +(*i $Id: cooking.ml 8752 2006-04-27 19:37:33Z herbelin $ i*) open Pp open Util @@ -113,7 +113,7 @@ type recipe = { d_modlist : work_list } let on_body f = - option_app (fun c -> Declarations.from_val (f (Declarations.force c))) + option_map (fun c -> Declarations.from_val (f (Declarations.force c))) let cook_constant env r = let cb = r.d_from in diff --git a/kernel/declarations.ml b/kernel/declarations.ml index 33d9959c..c52b5c48 100644 --- a/kernel/declarations.ml +++ b/kernel/declarations.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: declarations.ml 8653 2006-03-22 09:41:17Z herbelin $ i*) +(*i $Id: declarations.ml 8845 2006-05-23 07:41:58Z herbelin $ i*) (*i*) open Util @@ -45,6 +45,13 @@ type constant_body = { (*s Inductive types (internal representation with redundant information). *) +let subst_rel_declaration sub (id,copt,t as x) = + let copt' = option_smartmap (subst_mps sub) copt in + let t' = subst_mps sub t in + if copt == copt' & t == t' then x else (id,copt',t') + +let subst_rel_context sub = list_smartmap (subst_rel_declaration sub) + type recarg = | Norec | Mrec of int @@ -83,6 +90,20 @@ let subst_wf_paths sub p = Rtree.smartmap (subst_recarg sub) p with In (params) : Un := cn1 : Tn1 | ... | cnpn : Tnpn *) +type polymorphic_inductive_arity = { + mind_param_levels : universe option list; + mind_level : universe; +} + +type monomorphic_inductive_arity = { + mind_user_arity : constr; + mind_sort : sorts; +} + +type inductive_arity = +| Monomorphic of monomorphic_inductive_arity +| Polymorphic of polymorphic_inductive_arity + type one_inductive_body = { (* Primitive datas *) @@ -90,8 +111,11 @@ type one_inductive_body = { (* Name of the type: [Ii] *) mind_typename : identifier; - (* Arity of [Ii] with parameters: [forall params, Ui] *) - mind_user_arity : types; + (* Arity context of [Ii] with parameters: [forall params, Ui] *) + mind_arity_ctxt : rel_context; + + (* Arity sort, original user arity, and allowed elim sorts, if monomorphic *) + mind_arity : inductive_arity; (* Names of the constructors: [cij] *) mind_consnames : identifier array; @@ -103,15 +127,9 @@ type one_inductive_body = { (* Derived datas *) - (* Head normalized arity so that the conclusion is a sort *) - mind_nf_arity : types; - (* Number of expected real arguments of the type (no let, no params) *) mind_nrealargs : int; - (* Conclusion of the arity *) - mind_sort : sorts; - (* List of allowed elimination sorts *) mind_kelim : sorts_family list; @@ -171,24 +189,29 @@ type mutual_inductive_body = { (* TODO: should be changed to non-coping after Term.subst_mps *) let subst_const_body sub cb = { const_hyps = (assert (cb.const_hyps=[]); []); - const_body = option_app (subst_constr_subst sub) cb.const_body; - const_type = type_app (subst_mps sub) cb.const_type; + const_body = option_map (subst_constr_subst sub) cb.const_body; + const_type = subst_mps sub cb.const_type; const_body_code = Cemitcodes.subst_to_patch_subst sub cb.const_body_code; (*const_type_code = Cemitcodes.subst_to_patch sub cb.const_type_code;*) const_constraints = cb.const_constraints; const_opaque = cb.const_opaque } +let subst_arity sub = function +| Monomorphic s -> + Monomorphic { + mind_user_arity = subst_mps sub s.mind_user_arity; + mind_sort = s.mind_sort; + } +| Polymorphic s as x -> x + let subst_mind_packet sub mbp = { mind_consnames = mbp.mind_consnames; mind_consnrealdecls = mbp.mind_consnrealdecls; mind_typename = mbp.mind_typename; - mind_nf_lc = - array_smartmap (type_app (subst_mps sub)) mbp.mind_nf_lc; - mind_nf_arity = type_app (subst_mps sub) mbp.mind_nf_arity; - mind_user_lc = - array_smartmap (type_app (subst_mps sub)) mbp.mind_user_lc; - mind_user_arity = type_app (subst_mps sub) mbp.mind_user_arity; - mind_sort = mbp.mind_sort; + mind_nf_lc = array_smartmap (subst_mps sub) mbp.mind_nf_lc; + mind_arity_ctxt = subst_rel_context sub mbp.mind_arity_ctxt; + mind_arity = subst_arity sub mbp.mind_arity; + mind_user_lc = array_smartmap (subst_mps sub) mbp.mind_user_lc; mind_nrealargs = mbp.mind_nrealargs; mind_kelim = mbp.mind_kelim; mind_recargs = subst_wf_paths sub mbp.mind_recargs (*wf_paths*); @@ -208,7 +231,7 @@ let subst_mind sub mib = map_rel_context (subst_mps sub) mib.mind_params_ctxt; mind_packets = array_smartmap (subst_mind_packet sub) mib.mind_packets ; mind_constraints = mib.mind_constraints ; - mind_equiv = option_app (subst_kn sub) mib.mind_equiv } + mind_equiv = option_map (subst_kn sub) mib.mind_equiv } (*s Modules: signature component specifications, module types, and diff --git a/kernel/declarations.mli b/kernel/declarations.mli index 7ad953e5..c96d2131 100644 --- a/kernel/declarations.mli +++ b/kernel/declarations.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: declarations.mli 8653 2006-03-22 09:41:17Z herbelin $ i*) +(*i $Id: declarations.mli 8845 2006-05-23 07:41:58Z herbelin $ i*) (*i*) open Names @@ -70,6 +70,20 @@ val subst_wf_paths : substitution -> wf_paths -> wf_paths \end{verbatim} *) +type polymorphic_inductive_arity = { + mind_param_levels : universe option list; + mind_level : universe; +} + +type monomorphic_inductive_arity = { + mind_user_arity : constr; + mind_sort : sorts; +} + +type inductive_arity = +| Monomorphic of monomorphic_inductive_arity +| Polymorphic of polymorphic_inductive_arity + type one_inductive_body = { (* Primitive datas *) @@ -77,8 +91,11 @@ type one_inductive_body = { (* Name of the type: [Ii] *) mind_typename : identifier; - (* Arity of [Ii] with parameters: [forall params, Ui] *) - mind_user_arity : types; + (* Arity context of [Ii] with parameters: [forall params, Ui] *) + mind_arity_ctxt : rel_context; + + (* Arity sort and original user arity if monomorphic *) + mind_arity : inductive_arity; (* Names of the constructors: [cij] *) mind_consnames : identifier array; @@ -90,15 +107,9 @@ type one_inductive_body = { (* Derived datas *) - (* Head normalized arity so that the conclusion is a sort *) - mind_nf_arity : types; - (* Number of expected real arguments of the type (no let, no params) *) mind_nrealargs : int; - (* Conclusion of the arity *) - mind_sort : sorts; - (* List of allowed elimination sorts *) mind_kelim : sorts_family list; diff --git a/kernel/environ.ml b/kernel/environ.ml index 77d77118..a1e19815 100644 --- a/kernel/environ.ml +++ b/kernel/environ.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: environ.ml 7830 2006-01-10 22:45:28Z herbelin $ *) +(* $Id: environ.ml 8810 2006-05-12 18:50:21Z barras $ *) open Util open Names @@ -91,7 +91,7 @@ let named_context_of_val = fst *** /!\ *** [f t] should be convertible with t *) let map_named_val f (ctxt,ctxtv) = let ctxt = - List.map (fun (id,body,typ) -> (id, option_app f body, f typ)) ctxt in + List.map (fun (id,body,typ) -> (id, option_map f body, f typ)) ctxt in (ctxt,ctxtv) let empty_named_context = empty_named_context @@ -186,6 +186,8 @@ let evaluable_constant cst env = (* Mutual Inductives *) let lookup_mind = lookup_mind +let scrape_mind = scrape_mind + let add_mind kn mib env = let new_inds = KNmap.add kn mib env.env_globals.env_inductives in diff --git a/kernel/environ.mli b/kernel/environ.mli index 701159da..cfc23651 100644 --- a/kernel/environ.mli +++ b/kernel/environ.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: environ.mli 7640 2005-12-05 10:16:24Z gregoire $ i*) +(*i $Id: environ.mli 8810 2006-05-12 18:50:21Z barras $ i*) (*i*) open Names @@ -140,6 +140,9 @@ val add_mind : mutual_inductive -> mutual_inductive_body -> env -> env (* raises [Not_found] if the required path is not found *) val lookup_mind : mutual_inductive -> env -> mutual_inductive_body +(* Find the ultimate inductive in the [mind_equiv] chain *) +val scrape_mind : env -> mutual_inductive -> mutual_inductive + (************************************************************************) (*s Modules *) val add_modtype : kernel_name -> module_type_body -> env -> env diff --git a/kernel/esubst.ml b/kernel/esubst.ml index 0a3f4578..e32fc963 100644 --- a/kernel/esubst.ml +++ b/kernel/esubst.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: esubst.ml 5920 2004-07-16 20:01:26Z herbelin $ *) +(* $Id: esubst.ml 8799 2006-05-09 21:15:07Z barras $ *) open Util @@ -55,7 +55,10 @@ let rec is_lift_id = function (* (bounded) explicit substitutions of type 'a *) type 'a subs = | ESID of int (* ESID(n) = %n END bounded identity *) - | CONS of 'a * 'a subs (* CONS(t,S) = (S.t) parallel substitution *) + | CONS of 'a array * 'a subs + (* CONS([|t1..tn|],S) = + (S.t1...tn) parallel substitution + beware of the order *) | SHIFT of int * 'a subs (* SHIFT(n,S) = (^n o S) terms in S are relocated *) (* with n vars *) | LIFT of int * 'a subs (* LIFT(n,S) = (%n S) stands for ((^n o S).n...1) *) @@ -64,7 +67,7 @@ type 'a subs = * Needn't be recursive if we always use these functions *) -let subs_cons(x,s) = CONS(x,s) +let subs_cons(x,s) = if Array.length x = 0 then s else CONS(x,s) let subs_liftn n = function | ESID p -> ESID (p+n) (* bounded identity lifted extends by p *) @@ -85,11 +88,12 @@ let subs_shift_cons = function | (k, SHIFT(n,s1), t) -> CONS(t,SHIFT(k+n, s1)) | (k, s, t) -> CONS(t,SHIFT(k, s));; -(* Tests whether a substitution is extensionnaly equal to the identity *) +(* Tests whether a substitution is equal to the identity *) let rec is_subs_id = function ESID _ -> true | LIFT(_,s) -> is_subs_id s | SHIFT(0,s) -> is_subs_id s + | CONS(x,s) -> Array.length x = 0 && is_subs_id s | _ -> false (* Expands de Bruijn k in the explicit substitution subs @@ -108,14 +112,15 @@ let rec is_subs_id = function * variable points k bindings beyond subs. *) let rec exp_rel lams k subs = - match (k,subs) with - | (1, CONS (def,_)) -> Inl(lams,def) - | (_, CONS (_,l)) -> exp_rel lams (pred k) l - | (_, LIFT (n,_)) when k<=n -> Inr(lams+k,None) - | (_, LIFT (n,l)) -> exp_rel (n+lams) (k-n) l - | (_, SHIFT (n,s)) -> exp_rel (n+lams) k s - | (_, ESID n) when k<=n -> Inr(lams+k,None) - | (_, ESID n) -> Inr(lams+k,Some (k-n)) + match subs with + | CONS (def,_) when k <= Array.length def + -> Inl(lams,def.(Array.length def - k)) + | CONS (v,l) -> exp_rel lams (k - Array.length v) l + | LIFT (n,_) when k<=n -> Inr(lams+k,None) + | LIFT (n,l) -> exp_rel (n+lams) (k-n) l + | SHIFT (n,s) -> exp_rel (n+lams) k s + | ESID n when k<=n -> Inr(lams+k,None) + | ESID n -> Inr(lams+k,Some (k-n)) let expand_rel k subs = exp_rel 0 k subs @@ -124,9 +129,20 @@ let rec comp mk_cl s1 s2 = | _, ESID _ -> s1 | ESID _, _ -> s2 | SHIFT(k,s), _ -> subs_shft(k, comp mk_cl s s2) - | _, CONS(x,s') -> CONS(mk_cl(s1,x), comp mk_cl s1 s') - | CONS(x,s), SHIFT(k,s') -> comp mk_cl s (subs_shft(k-1, s')) - | CONS(x,s), LIFT(k,s') -> CONS(x,comp mk_cl s (subs_liftn (k-1) s')) + | _, CONS(x,s') -> + CONS(Array.map (fun t -> mk_cl(s1,t)) x, comp mk_cl s1 s') + | CONS(x,s), SHIFT(k,s') -> + let lg = Array.length x in + if k == lg then comp mk_cl s s' + else if k > lg then comp mk_cl s (SHIFT(k-lg, s')) + else comp mk_cl (CONS(Array.sub x 0 (lg-k), s)) s' + | CONS(x,s), LIFT(k,s') -> + let lg = Array.length x in + if k == lg then CONS(x, comp mk_cl s s') + else if k > lg then CONS(x, comp mk_cl s (LIFT(k-lg, s'))) + else + CONS(Array.sub x (lg-k) k, + comp mk_cl (CONS(Array.sub x 0 (lg-k),s)) s') | LIFT(k,s), SHIFT(k',s') -> if k<k' then subs_shft(k, comp mk_cl s (subs_shft(k'-k, s'))) diff --git a/kernel/esubst.mli b/kernel/esubst.mli index 39fbbede..3b40bdfc 100644 --- a/kernel/esubst.mli +++ b/kernel/esubst.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: esubst.mli 6621 2005-01-21 17:24:37Z herbelin $ i*) +(*i $Id: esubst.mli 8799 2006-05-09 21:15:07Z barras $ i*) (*s Compact representation of explicit relocations. \\ [ELSHFT(l,n)] == lift of [n], then apply [lift l]. @@ -22,21 +22,22 @@ val el_lift : lift -> lift val reloc_rel : int -> lift -> int val is_lift_id : lift -> bool -(*s Explicit substitutions of type ['a]. [ESID n] = %n~END = bounded identity. - [CONS(t,S)] = $S.t$ i.e. parallel substitution. [SHIFT(n,S)] = - $(\uparrow n~o~S)$ i.e. terms in S are relocated with n vars. - [LIFT(n,S)] = $(\%n~S)$ stands for $((\uparrow n~o~S).n...1)$. *) +(*s Explicit substitutions of type ['a]. *) type 'a subs = - | ESID of int - | CONS of 'a * 'a subs - | SHIFT of int * 'a subs - | LIFT of int * 'a subs + | ESID of int (* ESID(n) = %n END bounded identity *) + | CONS of 'a array * 'a subs + (* CONS([|t1..tn|],S) = + (S.t1...tn) parallel substitution + beware of the order *) + | SHIFT of int * 'a subs (* SHIFT(n,S) = (^n o S) terms in S are relocated *) + (* with n vars *) + | LIFT of int * 'a subs (* LIFT(n,S) = (%n S) stands for ((^n o S).n...1) *) -val subs_cons: 'a * 'a subs -> 'a subs +val subs_cons: 'a array * 'a subs -> 'a subs val subs_shft: int * 'a subs -> 'a subs val subs_lift: 'a subs -> 'a subs val subs_liftn: int -> 'a subs -> 'a subs -val subs_shift_cons: int * 'a subs * 'a -> 'a subs +val subs_shift_cons: int * 'a subs * 'a array -> 'a subs val expand_rel: int -> 'a subs -> (int * 'a, int * int option) Util.union val is_subs_id: 'a subs -> bool -val comp : ('a subs * 'a -> 'a) -> 'a subs -> 'a subs -> 'a subs
\ No newline at end of file +val comp : ('a subs * 'a -> 'a) -> 'a subs -> 'a subs -> 'a subs diff --git a/kernel/indtypes.ml b/kernel/indtypes.ml index a3fc0db4..e7dc09ee 100644 --- a/kernel/indtypes.ml +++ b/kernel/indtypes.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: indtypes.ml 8653 2006-03-22 09:41:17Z herbelin $ *) +(* $Id: indtypes.ml 8871 2006-05-28 16:46:48Z herbelin $ *) open Util open Names @@ -116,12 +116,10 @@ let is_info_type env t = let is_small infos = List.for_all (fun (logic,small) -> small) infos let is_logic_constr infos = List.for_all (fun (logic,small) -> logic) infos -let is_logic_arity infos = - List.for_all (fun (logic,small) -> logic || small) infos (* An inductive definition is a "unit" if it has only one constructor and that all arguments expected by this constructor are - logical, this is the case for equality, conjonction of logical properties + logical, this is the case for equality, conjunction of logical properties *) let is_unit constrsinfos = match constrsinfos with (* One info = One constructor *) @@ -145,45 +143,54 @@ let small_unit constrsinfos = and isunit = is_unit constrsinfos in issmall, isunit -(* This (re)computes informations relevant to extraction and the sort of an - arity or type constructor; we do not to recompute universes constraints *) +(* Computing the levels of polymorphic inductive types -(* [smax] is the max of the sorts of the products of the constructor type *) + For each inductive type of a block that is of level u_i, we have + the constraints that u_i >= v_i where v_i is the type level of the + types of the constructors of this inductive type. Each v_i depends + of some of the u_i and of an extra (maybe non variable) universe, + say w_i that summarize all the other constraints. Typically, for + three inductive types, we could have -let enforce_type_constructor env arsort smax cst = - match smax, arsort with - | Type uc, Type ua -> enforce_geq ua uc cst - | Type uc, Prop Pos when engagement env <> Some ImpredicativeSet -> - error "Large non-propositional inductive types must be in Type" - | _,_ -> cst + u1,u2,u3,w1 <= u1 + u1 w2 <= u2 + u2,u3,w3 <= u3 -let type_one_constructor env_ar_par params arsort c = - let infos = infos_and_sort env_ar_par c in + From this system of inequations, we shall deduce - (* Each constructor is typed-checked here *) - let (j,cst) = infer_type env_ar_par c in - let full_cstr_type = it_mkProd_or_LetIn j.utj_val params in + w1,w2,w3 <= u1 + w1,w2 <= u2 + w1,w2,w3 <= u3 +*) - (* If the arity is at some level Type arsort, then the sort of the - constructor must be below arsort; here we consider constructors with the - global parameters (which add a priori more constraints on their sort) *) - let cst2 = enforce_type_constructor env_ar_par arsort j.utj_type cst in +let inductive_levels arities inds = + let levels = Array.map pi3 arities in + let cstrs_levels = Array.map (fun (_,_,_,_,lev) -> lev) inds in + (* Take the transitive closure of the system of constructors *) + (* level constraints and remove the recursive dependencies *) + solve_constraints_system levels cstrs_levels - (infos, full_cstr_type, cst2) +(* This (re)computes informations relevant to extraction and the sort of an + arity or type constructor; we do not to recompute universes constraints *) -let infer_constructor_packet env_ar params arsort lc = +let constraint_list_union = + List.fold_left Constraint.union Constraint.empty + +let infer_constructor_packet env_ar params lc = + (* builds the typing context "Gamma, I1:A1, ... In:An, params" *) let env_ar_par = push_rel_context params env_ar in - let (constrsinfos,jlc,cst) = - List.fold_right - (fun c (infosl,l,cst) -> - let (infos,ct,cst') = - type_one_constructor env_ar_par params arsort c in - (infos::infosl,ct::l, Constraint.union cst cst')) - lc - ([],[],Constraint.empty) in - let lc' = Array.of_list jlc in - let issmall,isunit = small_unit constrsinfos in - (issmall,isunit,lc',cst) + (* type-check the constructors *) + let jlc,cstl = List.split (List.map (infer_type env_ar_par) lc) in + let cst = constraint_list_union cstl in + let jlc = Array.of_list jlc in + (* generalize the constructor over the parameters *) + let lc'' = Array.map (fun j -> it_mkProd_or_LetIn j.utj_val params) jlc in + (* compute the max of the sorts of the products of the constructor type *) + let level = max_inductive_sort (Array.map (fun j -> j.utj_type) jlc) in + (* compute *) + let info = small_unit (List.map (infos_and_sort env_ar_par) lc) in + + (info,lc'',level,cst) (* Type-check an inductive definition. Does not check positivity conditions. *) @@ -192,50 +199,82 @@ let typecheck_inductive env mie = (* Check unicity of names *) mind_check_names mie; mind_check_arities env mie; - (* Params are typed-checked here *) - let params = mie.mind_entry_params in - let env_params, params, cstp = infer_local_decls env params in + (* Params are typed-checked here *) + let env_params, params, cst1 = infer_local_decls env mie.mind_entry_params in (* We first type arity of each inductive definition *) (* This allows to build the environment of arities and to share *) (* the set of constraints *) - let cst, arities, rev_params_arity_list = + let cst, env_arities, rev_arity_list = List.fold_left - (fun (cst,arities,l) ind -> + (fun (cst,env_ar,l) ind -> (* Arities (without params) are typed-checked here *) - let arity, cst2 = - infer_type env_params ind.mind_entry_arity in + let arity, cst2 = infer_type env_params ind.mind_entry_arity in (* We do not need to generate the universe of full_arity; if later, after the validation of the inductive definition, full_arity is used as argument or subject to cast, an upper universe will be generated *) - let id = ind.mind_entry_typename in let full_arity = it_mkProd_or_LetIn arity.utj_val params in - Constraint.union cst cst2, - Sign.add_rel_decl (Name id, None, full_arity) arities, - (params, id, full_arity, arity.utj_val)::l) - (cstp,empty_rel_context,[]) + let cst = Constraint.union cst cst2 in + let id = ind.mind_entry_typename in + let env_ar' = push_rel (Name id, None, full_arity) env_ar in + let lev = + (* Decide that if the conclusion is not explicitly Type *) + (* then the inductive type is not polymorphic *) + match kind_of_term (snd (decompose_prod_assum arity.utj_val)) with + | Sort (Type u) -> Some u + | _ -> None in + (cst,env_ar',(id,full_arity,lev)::l)) + (cst1,env,[]) mie.mind_entry_inds in - let env_arities = push_rel_context arities env in - - let params_arity_list = List.rev rev_params_arity_list in + let arity_list = List.rev rev_arity_list in (* Now, we type the constructors (without params) *) let inds,cst = List.fold_right2 - (fun ind (params,id,full_arity,short_arity) (inds,cst) -> - let (_,arsort) = dest_arity env full_arity in - let lc = ind.mind_entry_lc in - let (issmall,isunit,lc',cst') = - infer_constructor_packet env_arities params arsort lc in + (fun ind arity_data (inds,cst) -> + let (info,lc',cstrs_univ,cst') = + infer_constructor_packet env_arities params ind.mind_entry_lc in let consnames = ind.mind_entry_consnames in - let ind' = (id,full_arity,consnames,issmall,isunit,lc') - in + let ind' = (arity_data,consnames,info,lc',cstrs_univ) in (ind'::inds, Constraint.union cst cst')) mie.mind_entry_inds - params_arity_list + arity_list ([],cst) in - (env_arities, params, Array.of_list inds, cst) + + let inds = Array.of_list inds in + let arities = Array.of_list arity_list in + let param_ccls = List.fold_left (fun l (_,b,p) -> + if b = None then + let _,c = dest_prod_assum env p in + let u = match kind_of_term c with Sort (Type u) -> Some u | _ -> None in + u::l + else + l) [] params in + + (* Compute/check the sorts of the inductive types *) + let ind_min_levels = inductive_levels arities inds in + let inds, cst = + array_fold_map2' (fun ((id,full_arity,ar_level),cn,info,lc,_) lev cst -> + let sign, s = dest_arity env full_arity in + let status,cst = match s with + | Type _ when ar_level <> None (* Explicitly polymorphic *) -> + (* The polymorphic level is a function of the level of the *) + (* conclusions of the parameters *) + Inr (param_ccls, lev), cst + | Type u (* Not an explicit occurrence of Type *) -> + Inl (info,full_arity,s), enforce_geq u lev cst + | Prop Pos when engagement env <> Some ImpredicativeSet -> + (* Predicative set: check that the content is indeed predicative *) + if not (is_empty_univ lev) & not (is_base_univ lev) then + error "Large non-propositional inductive types must be in Type"; + Inl (info,full_arity,s), cst + | Prop _ -> + Inl (info,full_arity,s), cst in + (id,cn,lc,(sign,status)),cst) + inds ind_min_levels cst in + + (env_arities, params, inds, cst) (************************************************************************) (************************************************************************) @@ -479,7 +518,7 @@ let check_positivity env_ar params inds = List.rev (list_tabulate (fun j -> (Mrec j, Rtree.mk_param j)) ntypes) in let lparams = rel_context_length params in let nmr = rel_context_nhyps params in - let check_one i (_,_,_,_,_,lc) = + let check_one i (_,_,lc,_) = let ra_env = list_tabulate (fun _ -> (Norec,mk_norec)) lparams @ lra_ind in let ienv = (env_ar, 1+lparams, ntypes, ra_env) in @@ -505,22 +544,34 @@ let is_recursive = Rtree.is_infinite array_exists one_is_rec *) +(* Allowed eliminations *) + let all_sorts = [InProp;InSet;InType] -let impredicative_sorts = [InProp;InSet] +let small_sorts = [InProp;InSet] let logical_sorts = [InProp] -let allowed_sorts env issmall isunit = function - | Type _ -> all_sorts - | Prop Pos -> - if issmall then all_sorts - else impredicative_sorts - | Prop Null -> -(* 29/1/02: added InType which is derivable when the type is unit and small *) - if isunit then all_sorts - else logical_sorts +let allowed_sorts issmall isunit s = + match family_of_sort s with + (* Type: all elimination allowed *) + | InType -> all_sorts + + (* Small Set is predicative: all elimination allowed *) + | InSet when issmall -> all_sorts + + (* Large Set is necessarily impredicative: forbids large elimination *) + | InSet -> small_sorts + + (* Unitary/empty Prop: elimination to all sorts are realizable *) + (* unless the type is large. If it is large, forbids large elimination *) + (* which otherwise allows to simulate the inconsistent system Type:Type *) + | InProp when isunit -> if issmall then all_sorts else small_sorts + + (* Other propositions: elimination only to Prop *) + | InProp -> logical_sorts let fold_inductive_blocks f = - Array.fold_left (fun acc (_,ar,_,_,_,lc) -> f (Array.fold_left f acc lc) ar) + Array.fold_left (fun acc (_,_,lc,(arsign,_)) -> + f (Array.fold_left f acc lc) (it_mkProd_or_LetIn (* dummy *) mkSet arsign)) let used_section_variables env inds = let ids = fold_inductive_blocks @@ -534,10 +585,7 @@ let build_inductive env env_ar params isrecord isfinite inds nmr recargs cst = let hyps = used_section_variables env inds in let nparamargs = rel_context_nhyps params in (* Check one inductive *) - let build_one_packet (id,ar,cnames,issmall,isunit,lc) recarg = - (* Arity in normal form *) - let (ar_sign,ar_sort) = dest_arity env ar in - let nf_ar = if isArity ar then ar else mkArity (ar_sign,ar_sort) in + let build_one_packet (id,cnames,lc,(ar_sign,ar_kind)) recarg = (* Type of constructors in normal form *) let splayed_lc = Array.map (dest_prod_assum env_ar) lc in let nf_lc = Array.map (fun (d,b) -> it_mkProd_or_LetIn b d) splayed_lc in @@ -546,8 +594,19 @@ let build_inductive env env_ar params isrecord isfinite inds nmr recargs cst = Array.map (fun (d,_) -> rel_context_length d - rel_context_length params) splayed_lc in (* Elimination sorts *) - let isunit = isunit && ntypes = 1 && (not (is_recursive recargs.(0))) in - let kelim = allowed_sorts env issmall isunit ar_sort in + let arkind,kelim = match ar_kind with + | Inr (param_levels,lev) -> + Polymorphic { + mind_param_levels = param_levels; + mind_level = lev; + }, all_sorts + | Inl ((issmall,isunit),ar,s) -> + let isunit = isunit && ntypes = 1 && not (is_recursive recargs.(0)) in + let kelim = allowed_sorts issmall isunit s in + Monomorphic { + mind_user_arity = ar; + mind_sort = s; + }, kelim in let nconst, nblock = ref 0, ref 0 in let transf num = let arity = List.length (dest_subterms recarg).(num) in @@ -563,16 +622,15 @@ let build_inductive env env_ar params isrecord isfinite inds nmr recargs cst = let rtbl = Array.init (List.length cnames) transf in (* Build the inductive packet *) { mind_typename = id; - mind_user_arity = ar; - mind_nf_arity = nf_ar; + mind_arity = arkind; + mind_arity_ctxt = ar_sign; mind_nrealargs = rel_context_nhyps ar_sign - nparamargs; - mind_sort = ar_sort; mind_kelim = kelim; mind_consnames = Array.of_list cnames; mind_consnrealdecls = consnrealargs; mind_user_lc = lc; mind_nf_lc = nf_lc; - mind_recargs = recarg; + mind_recargs = recarg; mind_nb_constant = !nconst; mind_nb_args = !nblock; mind_reloc_tbl = rtbl; @@ -600,5 +658,5 @@ let check_inductive env mie = (* Then check positivity conditions *) let (nmr,recargs) = check_positivity env_ar params inds in (* Build the inductive packets *) - build_inductive env env_ar params mie.mind_entry_record mie.mind_entry_finite + build_inductive env env_ar params mie.mind_entry_record mie.mind_entry_finite inds nmr recargs cst diff --git a/kernel/inductive.ml b/kernel/inductive.ml index 736f4da1..d9f9f912 100644 --- a/kernel/inductive.ml +++ b/kernel/inductive.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: inductive.ml 8673 2006-03-29 21:21:52Z herbelin $ *) +(* $Id: inductive.ml 8871 2006-05-28 16:46:48Z herbelin $ *) open Util open Names @@ -47,6 +47,8 @@ let find_coinductive env c = when not (fst (lookup_mind_specif env ind)).mind_finite -> (ind, l) | _ -> raise Not_found +let inductive_params (mib,_) = mib.mind_nparams + (************************************************************************) (* Build the substitution that replaces Rels by the appropriate *) @@ -80,10 +82,12 @@ let instantiate_params full t args sign = let instantiate_partial_params = instantiate_params false -let full_inductive_instantiate mib params t = - instantiate_params true t params mib.mind_params_ctxt +let full_inductive_instantiate mib params sign = + let dummy = mk_Prop in + let t = mkArity (sign,dummy) in + fst (destArity (instantiate_params true t params mib.mind_params_ctxt)) -let full_constructor_instantiate (((mind,_),mib,_),params) = +let full_constructor_instantiate ((mind,_),(mib,_),params) = let inst_ind = constructor_instantiate mind mib in (fun t -> instantiate_params true (inst_ind t) params mib.mind_params_ctxt) @@ -93,22 +97,6 @@ let full_constructor_instantiate (((mind,_),mib,_),params) = (* Functions to build standard types related to inductive *) -(* For each inductive type of a block that is of level u_i, we have - the constraints that u_i >= v_i where v_i is the type level of the - types of the constructors of this inductive type. Each v_i depends - of some of the u_i and of an extra (maybe non variable) universe, - say w_i. Typically, for three inductive types, we could have - - u1,u2,u3,w1 <= u1 - u1 w2 <= u2 - u2,u3,w3 <= u3 - - From this system of inequations, we shall deduce - - w1,w2,w3 <= u1 - w1,w2 <= u2 - w1,w2,w3 <= u3 -*) let number_of_inductives mib = Array.length mib.mind_packets let number_of_constructors mip = Array.length mip.mind_consnames @@ -134,17 +122,6 @@ where Remark: Set (predicative) is encoded as Type(0) *) -let find_constraint levels level_bounds i nci = - if nci = 0 then mk_Prop - else - let level_bounds' = solve_constraints_system levels level_bounds in - let level = level_bounds'.(i) in - if nci = 1 & is_empty_universe level then mk_Prop - else if Univ.is_base level then mk_Set else Type level - -let find_inductive_level env (mib,mip) (_,i) levels level_bounds = - find_constraint levels level_bounds i (number_of_constructors mip) - let set_inductive_level env s t = let sign,s' = dest_prod_assum env t in if family_of_sort s <> family_of_sort (destSort s') then @@ -153,45 +130,69 @@ let set_inductive_level env s t = else t -let constructor_instances env (mib,mip) (_,i) args = - let nargs = Array.length args in - let args = Array.to_list args in - let uargs = - if nargs > mib.mind_nparams_rec then - fst (list_chop mib.mind_nparams_rec args) - else args in - let arities = - Array.map (fun mip -> destArity mip.mind_nf_arity) mib.mind_packets in - (* Compute the minimal type *) - let levels = Array.init - (number_of_inductives mib) (fun _ -> fresh_local_univ ()) in - let arities = list_tabulate (fun i -> - let ctx,s = arities.(i) in - let s = match s with Type _ -> Type (levels.(i)) | s -> s in - (Name mib.mind_packets.(i).mind_typename,None,mkArity (ctx,s))) - (number_of_inductives mib) in - (* Remark: all arities are closed hence no need for lift *) - let env_ar = push_rel_context (List.rev arities) env in - let uargs = List.map (lift (number_of_inductives mib)) uargs in - let lc = - Array.map (fun mip -> - Array.map (fun c -> - instantiate_partial_params c uargs mib.mind_params_ctxt) - mip.mind_nf_lc) - mib.mind_packets in - env_ar, lc, levels - -let is_small_inductive (mip,mib) = is_small (snd (destArity mib.mind_nf_arity)) - -let max_inductive_sort v = - let v = Array.map (function - | Type u -> u - | _ -> anomaly "Only type levels when computing the minimal sort of an inductive type") v in - Univ.sup_array v - -(* Type of an inductive type *) - -let type_of_inductive (_,mip) = mip.mind_user_arity +let sort_as_univ = function +| Type u -> u +| Prop Null -> neutral_univ +| Prop Pos -> base_univ + +let rec make_subst env exp act = + match exp, act with + (* Bind expected levels of parameters to actual levels *) + | None :: exp, _ :: act -> + make_subst env exp act + | Some u :: exp, t :: act -> + (u, sort_as_univ (snd (dest_arity env t))) :: make_subst env exp act + (* Not enough parameters, create a fresh univ *) + | Some u :: exp, [] -> + (u, fresh_local_univ ()) :: make_subst env exp [] + | None :: exp, [] -> + make_subst env exp [] + (* Uniform parameters are exhausted *) + | [], _ -> [] + +let sort_of_instantiated_universe mip subst level = + let level = subst_large_constraints subst level in + let nci = number_of_constructors mip in + if nci = 0 then mk_Prop + else + if is_empty_univ level then if nci = 1 then mk_Prop else mk_Set + else if is_base_univ level then mk_Set + else Type level + +let instantiate_inductive_with_param_levels env ar mip paramtyps = + let args = Array.to_list paramtyps in + let subst = make_subst env ar.mind_param_levels args in + sort_of_instantiated_universe mip subst ar.mind_level + +let type_of_inductive_knowing_parameters env mip paramtyps = + match mip.mind_arity with + | Monomorphic s -> + s.mind_user_arity + | Polymorphic ar -> + let s = instantiate_inductive_with_param_levels env ar mip paramtyps in + mkArity (mip.mind_arity_ctxt,s) + +(* The max of an array of universes *) + +let cumulate_constructor_univ u = function + | Prop Null -> u + | Prop Pos -> sup base_univ u + | Type u' -> sup u u' + +let max_inductive_sort = + Array.fold_left cumulate_constructor_univ neutral_univ + +(* Type of a (non applied) inductive type *) + +let type_of_inductive (_,mip) = + match mip.mind_arity with + | Monomorphic s -> s.mind_user_arity + | Polymorphic s -> + let subst = map_succeed (function + | Some u -> (u, fresh_local_univ ()) + | None -> failwith "") s.mind_param_levels in + let s = mkSort (sort_of_instantiated_universe mip subst s.mind_level) in + it_mkProd_or_LetIn s mip.mind_arity_ctxt (************************************************************************) (* Type of a constructor *) @@ -215,19 +216,11 @@ let arities_of_constructors ind specif = (************************************************************************) -let is_info_arity env c = - match dest_arity env c with - | (_,Prop Null) -> false - | (_,Prop Pos) -> true - | (_,Type _) -> true - -let error_elim_expln env kp ki = - if is_info_arity env kp && not (is_info_arity env ki) then - NonInformativeToInformative - else - match (kind_of_term kp,kind_of_term ki) with - | Sort (Type _), Sort (Prop _) -> StrongEliminationOnNonSmallType - | _ -> WrongArity +let error_elim_expln kp ki = + match kp,ki with + | (InType | InSet), InProp -> NonInformativeToInformative + | InType, InSet -> StrongEliminationOnNonSmallType (* if Set impredicative *) + | _ -> WrongArity (* Type of case predicates *) @@ -244,9 +237,20 @@ let local_rels ctxt = rels (* Get type of inductive, with parameters instantiated *) -let get_arity mib mip params = - let arity = mip.mind_nf_arity in - destArity (full_inductive_instantiate mib params arity) + +let inductive_sort_family mip = + match mip.mind_arity with + | Monomorphic s -> family_of_sort s.mind_sort + | Polymorphic _ -> InType + +let mind_arity mip = + mip.mind_arity_ctxt, inductive_sort_family mip + +let get_instantiated_arity (mib,mip) params = + let sign, s = mind_arity mip in + full_inductive_instantiate mib params sign, s + +let elim_sorts (_,mip) = mip.mind_kelim let rel_list n m = let rec reln l p = @@ -254,66 +258,48 @@ let rel_list n m = in reln [] 1 -let build_dependent_inductive ind mib mip params = +let build_dependent_inductive ind (_,mip) params = let nrealargs = mip.mind_nrealargs in applist (mkInd ind, (List.map (lift nrealargs) params)@(rel_list 0 nrealargs)) - (* This exception is local *) -exception LocalArity of (constr * constr * arity_error) option +exception LocalArity of (sorts_family * sorts_family * arity_error) option -let is_correct_arity env c pj ind mib mip params = - let kelim = mip.mind_kelim in - let arsign,s = get_arity mib mip params in - let nodep_ar = it_mkProd_or_LetIn (mkSort s) arsign in - let rec srec env pt t u = +let check_allowed_sort ksort specif = + if not (List.exists ((=) ksort) (elim_sorts specif)) then + let s = inductive_sort_family (snd specif) in + raise (LocalArity (Some(ksort,s,error_elim_expln ksort s))) + +let is_correct_arity env c pj ind specif params = + let arsign,_ = get_instantiated_arity specif params in + let rec srec env pt ar u = let pt' = whd_betadeltaiota env pt in - let t' = whd_betadeltaiota env t in - match kind_of_term pt', kind_of_term t' with - | Prod (na1,a1,a2), Prod (_,a1',a2') -> + match kind_of_term pt', ar with + | Prod (na1,a1,t), (_,None,a1')::ar' -> let univ = try conv env a1 a1' with NotConvertible -> raise (LocalArity None) in - srec (push_rel (na1,None,a1) env) a2 a2' (Constraint.union u univ) - | Prod (_,a1,a2), _ -> - let k = whd_betadeltaiota env a2 in - let ksort = match kind_of_term k with + srec (push_rel (na1,None,a1) env) t ar' (Constraint.union 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 mib mip params - 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 - if List.exists ((=) ksort) kelim then - (true, Constraint.union u univ) - else - raise (LocalArity (Some(k,t',error_elim_expln env k t'))) - | k, Prod (_,_,_) -> + check_allowed_sort ksort specif; + (true, Constraint.union u univ) + | Sort s', [] -> + check_allowed_sort (family_of_sort s') specif; + (false, u) + | _ -> raise (LocalArity None) - | k, ki -> - let ksort = match k with - | Sort s -> family_of_sort s - | _ -> raise (LocalArity None) in - if List.exists ((=) ksort) kelim then - (false, u) - else - raise (LocalArity (Some(pt',t',error_elim_expln env pt' t'))) in - try srec env pj.uj_type nodep_ar Constraint.empty + try srec env pj.uj_type (List.rev arsign) Constraint.empty with LocalArity kinds -> - let create_sort = function - | InProp -> mkProp - | InSet -> mkSet - | InType -> mkSort type_0 in - let listarity = List.map create_sort kelim -(* let listarity = - (List.map (fun s -> make_arity env true indf (create_sort s)) kelim) - @(List.map (fun s -> make_arity env false indf (create_sort s)) kelim)*) - in - error_elim_arity env ind listarity c pj kinds + error_elim_arity env ind (elim_sorts specif) c pj kinds (************************************************************************) @@ -321,13 +307,13 @@ let is_correct_arity env c pj ind mib mip params = (* [p] is the predicate, [i] is the constructor number (starting from 0), and [cty] is the type of the constructor (params not instantiated) *) -let build_branches_type ind mib mip params dep p = +let build_branches_type ind (_,mip as specif) params dep p = let build_one_branch i cty = - let typi = full_constructor_instantiate ((ind,mib,mip),params) cty in + let typi = full_constructor_instantiate (ind,specif,params) cty in let (args,ccl) = decompose_prod_assum typi in let nargs = rel_context_length args in let (_,allargs) = decompose_app ccl in - let (lparams,vargs) = list_chop mib.mind_nparams allargs in + let (lparams,vargs) = list_chop (inductive_params specif) allargs in let cargs = if dep then let cstr = ith_constructor_of_inductive ind (i+1) in @@ -346,12 +332,12 @@ let build_case_type dep p c realargs = beta_appvect p (Array.of_list args) let type_case_branches env (ind,largs) pj c = - let (mib,mip) = lookup_mind_specif env ind in - let nparams = mib.mind_nparams in + let specif = lookup_mind_specif env ind in + let nparams = inductive_params specif in let (params,realargs) = list_chop nparams largs in let p = pj.uj_val in - let (dep,univ) = is_correct_arity env c pj ind mib mip params in - let lc = build_branches_type ind mib mip params dep p in + let (dep,univ) = is_correct_arity env c pj ind specif params in + let lc = build_branches_type ind specif params dep p in let ty = build_case_type dep p c realargs in (lc, ty, univ) @@ -399,24 +385,27 @@ let check_case_info env indsp ci = first argument. *) -(*************************) -(* Environment annotated with marks on recursive arguments: - it is a triple (env,lst,n) where - - env is the typing environment - - lst is a mapping from de Bruijn indices to list of recargs - (tells which subterms of that variable are recursive) - - n is the de Bruijn index of the fixpoint for which we are - checking the guard condition. +(*************************************************************) +(* Environment annotated with marks on recursive arguments *) - Below are functions to handle such environment. - *) +(* tells whether it is a strict or loose subterm *) type size = Large | Strict +(* merging information *) let size_glb s1 s2 = match s1,s2 with Strict, Strict -> Strict | _ -> Large +(* possible specifications for a term: + - Not_subterm: when the size of a term is not related to the + recursive argument of the fixpoint + - Subterm: when the term is a subterm of the recursive argument + the wf_paths argument specifies which subterms are recursive + - Dead_code: when the term has been built by elimination over an + empty type + *) + type subterm_spec = Subterm of (size * wf_paths) | Dead_code @@ -517,31 +506,14 @@ let lookup_subterms env ind = (*********************************) -(* finds the inductive type of the recursive argument of a fixpoint *) -let inductive_of_fix env recarg body = - let (ctxt,b) = decompose_lam_n_assum recarg body in - let env' = push_rel_context ctxt env in - let (_,ty,_) = destLambda(whd_betadeltaiota env' b) in - let (i,_) = decompose_app (whd_betadeltaiota env' ty) in - destInd i - -(* - subterm_specif env c ind - - subterm_specif should test if [c] (building objects of inductive - type [ind], not necessarily the same as that of the recursive - argument) is a subterm of the recursive argument of the fixpoint we - are checking and fails with Not_found if not. In case it is, it - should send its recursive specification (i.e. on which arguments we - are allowed to make recursive calls). This recursive spec should be - the same size as the number of constructors of the type of c. - - Returns: - - [Some lc] if [c] is a strict subterm of the rec. arg. (or a Meta) - - [None] otherwise +(* [subterm_specif renv t] computes the recursive structure of [t] and + compare its size with the size of the initial recursive argument of + the fixpoint we are checking. [renv] collects such information + about variables. *) -let rec subterm_specif renv t ind = +let rec subterm_specif renv t = + (* maybe reduction is not always necessary! *) let f,l = decompose_app (whd_betadeltaiota renv.env t) in match kind_of_term f with | Rel k -> subterm_var k renv @@ -551,7 +523,7 @@ let rec subterm_specif renv t ind = else let lbr_spec = case_branches_specif renv c ci.ci_ind lbr in let stl = - Array.map (fun (renv',br') -> subterm_specif renv' br' ind) + Array.map (fun (renv',br') -> subterm_specif renv' br') lbr_spec in subterm_spec_glb stl @@ -561,33 +533,43 @@ let rec subterm_specif renv t ind = furthermore when f is applied to a term which is strictly less than n, one may assume that x itself is strictly less than n *) - let nbfix = Array.length typarray in - let recargs = lookup_subterms renv.env ind in - (* pushing the fixpoints *) - let renv' = push_fix_renv renv recdef in - let renv' = - assign_var_spec renv' (nbfix-i, Subterm(Strict,recargs)) in - let decrArg = recindxs.(i) in - let theBody = bodies.(i) in - let nbOfAbst = decrArg+1 in - let sign,strippedBody = decompose_lam_n_assum nbOfAbst theBody in - (* pushing the fix parameters *) - let renv'' = push_ctxt_renv renv' sign in - let renv'' = - if List.length l < nbOfAbst then renv'' - else - let decrarg_ind = inductive_of_fix renv''.env decrArg theBody in - let theDecrArg = List.nth l decrArg in - let arg_spec = subterm_specif renv theDecrArg decrarg_ind in - assign_var_spec renv'' (1, arg_spec) in - subterm_specif renv'' strippedBody ind - + let (ctxt,clfix) = dest_prod renv.env typarray.(i) in + let oind = + let env' = push_rel_context ctxt renv.env in + try Some(fst(find_inductive env' clfix)) + with Not_found -> None in + (match oind with + None -> Not_subterm (* happens if fix is polymorphic *) + | Some ind -> + let nbfix = Array.length typarray in + let recargs = lookup_subterms renv.env ind in + (* pushing the fixpoints *) + let renv' = push_fix_renv renv recdef in + let renv' = + (* Why Strict here ? To be general, it could also be + Large... *) + assign_var_spec renv' (nbfix-i, Subterm(Strict,recargs)) in + let decrArg = recindxs.(i) in + let theBody = bodies.(i) in + let nbOfAbst = decrArg+1 in + let sign,strippedBody = decompose_lam_n_assum nbOfAbst theBody in + (* pushing the fix parameters *) + let renv'' = push_ctxt_renv renv' sign in + let renv'' = + if List.length l < nbOfAbst then renv'' + else + let theDecrArg = List.nth l decrArg in + let arg_spec = subterm_specif renv theDecrArg in + assign_var_spec renv'' (1, arg_spec) in + subterm_specif renv'' strippedBody) + | Lambda (x,a,b) -> assert (l=[]); - subterm_specif (push_var_renv renv (x,a)) b ind + subterm_specif (push_var_renv renv (x,a)) b + + (* Metas and evars are considered OK *) + | (Meta _|Evar _) -> Dead_code - (* A term with metas is considered OK *) - | Meta _ -> Dead_code (* Other terms are not subterms *) | _ -> Not_subterm @@ -595,16 +577,20 @@ let rec subterm_specif renv t ind = object is a recursive subterm then compute the information associated to its own subterms. Rq: if branch is not eta-long, then the recursive information - is not propagated *) + is not propagated to the missing abstractions *) and case_branches_specif renv c ind lbr = - let c_spec = subterm_specif renv c ind in + let c_spec = subterm_specif renv c in let rec push_branch_args renv lrec c = - let c' = strip_outer_cast (whd_betadeltaiota renv.env c) in - match lrec, kind_of_term c' with - | (ra::lr,Lambda (x,a,b)) -> - let renv' = push_var renv (x,a,ra) in - push_branch_args renv' lr b - | (_,_) -> (renv,c') in + match lrec with + ra::lr -> + let c' = whd_betadeltaiota renv.env c in + (match kind_of_term c' with + Lambda(x,a,b) -> + let renv' = push_var renv (x,a,ra) in + push_branch_args renv' lr b + | _ -> (* branch not in eta-long form: cannot perform rec. calls *) + (renv,c')) + | [] -> (renv, c) in match c_spec with Subterm (_,t) -> let sub_spec = Array.map (List.map spec_of_tree) (dest_subterms t) in @@ -618,8 +604,8 @@ and case_branches_specif renv c ind lbr = | Not_subterm -> Array.map (fun c -> (renv,c)) lbr (* Check term c can be applied to one of the mutual fixpoints. *) -let check_is_subterm renv c ind = - match subterm_specif renv c ind with +let check_is_subterm renv c = + match subterm_specif renv c with Subterm (Strict,_) | Dead_code -> true | _ -> false @@ -642,42 +628,45 @@ let error_illegal_rec_call renv fx arg = let error_partial_apply renv fx = raise (FixGuardError (renv.env,NotEnoughArgumentsForFixCall fx)) - (* Check if [def] is a guarded fixpoint body with decreasing arg. given [recpos], the decreasing arguments of each mutually defined fixpoint. *) let check_one_fix renv recpos def = let nfi = Array.length recpos in + + (* Checks if [t] only make valid recursive calls *) let rec check_rec_call renv t = (* if [t] does not make recursive calls, it is guarded: *) - noccur_with_meta renv.rel_min nfi t or - (* Rq: why not try and expand some definitions ? *) - let f,l = decompose_app (whd_betaiotazeta renv.env t) in - match kind_of_term f with - | Rel p -> - (* Test if it is a recursive call: *) - if renv.rel_min <= p & p < renv.rel_min+nfi then - (* the position of the invoked fixpoint: *) - let glob = renv.rel_min+nfi-1-p in - (* the decreasing arg of the rec call: *) - let np = recpos.(glob) in - if List.length l <= np then error_partial_apply renv glob; - match list_chop np l with - (la,(z::lrest)) -> - (* Check the decreasing arg is smaller *) - if not (check_is_subterm renv z renv.inds.(glob)) then - error_illegal_rec_call renv glob z; - List.for_all (check_rec_call renv) (la@lrest) - | _ -> assert false - (* otherwise check the arguments are guarded: *) - else List.for_all (check_rec_call renv) l + if noccur_with_meta renv.rel_min nfi t then () + else + (* Rq: why not try and expand some definitions ? *) + let f,l = decompose_app (whd_betaiotazeta renv.env t) in + match kind_of_term f with + | Rel p -> + (* Test if [p] is a fixpoint (recursive call) *) + if renv.rel_min <= p & p < renv.rel_min+nfi then + (* the position of the invoked fixpoint: *) + let glob = renv.rel_min+nfi-1-p in + (* the decreasing arg of the rec call: *) + let np = recpos.(glob) in + if List.length l <= np then error_partial_apply renv glob + else + (match list_chop np l with + (la,(z::lrest)) -> + (* Check the decreasing arg is smaller *) + if not (check_is_subterm renv z) then + error_illegal_rec_call renv glob z; + List.iter (check_rec_call renv) (la@lrest) + | _ -> assert false) + (* otherwise check the arguments are guarded: *) + else List.iter (check_rec_call renv) l | Case (ci,p,c_0,lrest) -> - List.for_all (check_rec_call renv) (c_0::p::l) && + List.iter (check_rec_call renv) (c_0::p::l); (* compute the recarg information for the arguments of each branch *) let lbr = case_branches_specif renv c_0 ci.ci_ind lrest in - array_for_all (fun (renv',br') -> check_rec_call renv' br') lbr + Array.iter (fun (renv',br') -> check_rec_call renv' br') lbr (* Enables to traverse Fixpoint definitions in a more intelligent way, ie, the rule : @@ -695,65 +684,58 @@ let check_one_fix renv recpos def = Eduardo 7/9/98 *) | Fix ((recindxs,i),(_,typarray,bodies as recdef)) -> - List.for_all (check_rec_call renv) l && - array_for_all (check_rec_call renv) typarray && + List.iter (check_rec_call renv) l; + Array.iter (check_rec_call renv) typarray; let decrArg = recindxs.(i) in let renv' = push_fix_renv renv recdef in if (List.length l < (decrArg+1)) then - array_for_all (check_rec_call renv') bodies + Array.iter (check_rec_call renv') bodies else - let ok_vect = - Array.mapi - (fun j body -> - if i=j then - let decrarg_ind = - inductive_of_fix renv'.env decrArg body in - let theDecrArg = List.nth l decrArg in - let arg_spec = - subterm_specif renv theDecrArg decrarg_ind in - check_nested_fix_body renv' (decrArg+1) arg_spec body - else check_rec_call renv' body) - bodies in - array_for_all (fun b -> b) ok_vect + Array.iteri + (fun j body -> + if i=j then + let theDecrArg = List.nth l decrArg in + let arg_spec = subterm_specif renv theDecrArg in + check_nested_fix_body renv' (decrArg+1) arg_spec body + else check_rec_call renv' body) + bodies | Const kn -> - (try List.for_all (check_rec_call renv) l - with (FixGuardError _ ) as e -> - if evaluable_constant kn renv.env then - check_rec_call renv - (applist(constant_value renv.env kn, l)) - else raise e) + if evaluable_constant kn renv.env then + try List.iter (check_rec_call renv) l + with (FixGuardError _ ) -> + check_rec_call renv(applist(constant_value renv.env kn, l)) + else List.iter (check_rec_call renv) l (* The cases below simply check recursively the condition on the subterms *) | Cast (a,_, b) -> - List.for_all (check_rec_call renv) (a::b::l) + List.iter (check_rec_call renv) (a::b::l) | Lambda (x,a,b) -> - check_rec_call (push_var_renv renv (x,a)) b && - List.for_all (check_rec_call renv) (a::l) + check_rec_call (push_var_renv renv (x,a)) b; + List.iter (check_rec_call renv) (a::l) | Prod (x,a,b) -> - check_rec_call (push_var_renv renv (x,a)) b && - List.for_all (check_rec_call renv) (a::l) + check_rec_call (push_var_renv renv (x,a)) b; + List.iter (check_rec_call renv) (a::l) | CoFix (i,(_,typarray,bodies as recdef)) -> - array_for_all (check_rec_call renv) typarray && - List.for_all (check_rec_call renv) l && + Array.iter (check_rec_call renv) typarray; + List.iter (check_rec_call renv) l; let renv' = push_fix_renv renv recdef in - array_for_all (check_rec_call renv') bodies - - | Evar (_,la) -> - array_for_all (check_rec_call renv) la && - List.for_all (check_rec_call renv) l + Array.iter (check_rec_call renv') bodies - | Meta _ -> true + | Evar _ -> + List.iter (check_rec_call renv) l - | (App _ | LetIn _) -> - anomaly "check_rec_call: should have been reduced" + (* l is not checked because it is considered as the meta's context *) + | Meta _ -> () | (Ind _ | Construct _ | Var _ | Sort _) -> - List.for_all (check_rec_call renv) l + List.iter (check_rec_call renv) l + + | (App _ | LetIn _) -> assert false (* beta zeta reduction *) and check_nested_fix_body renv decr recArgsDecrArg body = if decr = 0 then @@ -761,11 +743,11 @@ let check_one_fix renv recpos def = else match kind_of_term body with | Lambda (x,a,b) -> + check_rec_call renv a; let renv' = push_var_renv renv (x,a) in - check_rec_call renv a && check_nested_fix_body renv' (decr-1) recArgsDecrArg b | _ -> anomaly "Not enough abstractions in fix body" - + in check_rec_call renv def @@ -784,7 +766,6 @@ let inductive_of_mutfix env ((nvect,bodynum),(names,types,bodies as recdef)) = error_ill_formed_rec_body env err names i in (* Check the i-th definition with recarg k *) let find_ind i k def = - if k < 0 then anomaly "negative recarg position"; (* check fi does not appear in the k+1 first abstractions, gives the type of the k+1-eme abstraction (must be an inductive) *) let rec check_occur env n def = @@ -813,8 +794,7 @@ let check_fix env ((nvect,_),(names,_,bodies as _recdef) as fix) = for i = 0 to Array.length bodies - 1 do let (fenv,body) = rdef.(i) in let renv = make_renv fenv minds nvect.(i) minds.(i) in - try - let _ = check_one_fix renv nvect body in () + try check_one_fix renv nvect body with FixGuardError (fixenv,err) -> error_ill_formed_rec_body fixenv err names i done @@ -825,14 +805,6 @@ let check_fix env fix = Profile.profile3 cfkey check_fix env fix;; *) (************************************************************************) -(* Scrape *) - -let rec scrape_mind env kn = - match (Environ.lookup_mind kn env).mind_equiv with - | None -> kn - | Some kn' -> scrape_mind env kn' - -(************************************************************************) (* Co-fixpoints. *) exception CoFixGuardError of env * guard_error @@ -852,25 +824,19 @@ let rec codomain_is_coind env c = let check_one_cofix env nbfix def deftype = let rec check_rec_call env alreadygrd n vlra t = - if noccur_with_meta n nbfix t then - true - else + if not (noccur_with_meta n nbfix t) then let c,args = decompose_app (whd_betadeltaiota env t) in match kind_of_term c with - | Meta _ -> true - | Rel p when n <= p && p < n+nbfix -> - (* recursive call *) - if alreadygrd then - if List.for_all (noccur_with_meta n nbfix) args then - true - else - raise (CoFixGuardError (env,NestedRecursiveOccurrences)) - else + (* recursive call: must be guarded and no nested recursive + call allowed *) + if not alreadygrd then raise (CoFixGuardError (env,UnguardedRecursiveCall t)) + else if not(List.for_all (noccur_with_meta n nbfix) args) then + raise (CoFixGuardError (env,NestedRecursiveOccurrences)) | Construct (_,i as cstr_kn) -> - let lra =vlra.(i-1) in + let lra = vlra.(i-1) in let mI = inductive_of_constructor cstr_kn in let (mib,mip) = lookup_mind_specif env mI in let realargs = list_skipn mib.mind_nparams args in @@ -883,17 +849,17 @@ let check_one_cofix env nbfix def deftype = (env,RecCallInNonRecArgOfConstructor t)) else let spec = dest_subterms rar in - check_rec_call env true n spec t && + check_rec_call env true n spec t; process_args_of_constr (lr, lrar) - | [],_ -> true + | [],_ -> () | _ -> anomaly_ill_typed () in process_args_of_constr (realargs, lra) | Lambda (x,a,b) -> assert (args = []); - if (noccur_with_meta n nbfix a) then - check_rec_call (push_rel (x, None, a) env) - alreadygrd (n+1) vlra b + if noccur_with_meta n nbfix a then + let env' = push_rel (x, None, a) env in + check_rec_call env' alreadygrd (n+1) vlra b else raise (CoFixGuardError (env,RecCallInTypeOfAbstraction a)) @@ -903,10 +869,8 @@ let check_one_cofix env nbfix def deftype = let nbfix = Array.length vdefs in if (array_for_all (noccur_with_meta n nbfix) varit) then let env' = push_rec_types recdef env in - (array_for_all - (check_rec_call env' alreadygrd (n+1) vlra) vdefs) - && - (List.for_all (check_rec_call env alreadygrd (n+1) vlra) args) + (Array.iter (check_rec_call env' alreadygrd (n+1) vlra) vdefs; + List.iter (check_rec_call env alreadygrd n vlra) args) else raise (CoFixGuardError (env,RecCallInTypeOfDef c)) else @@ -916,7 +880,7 @@ let check_one_cofix env nbfix def deftype = if (noccur_with_meta n nbfix p) then if (noccur_with_meta n nbfix tm) then if (List.for_all (noccur_with_meta n nbfix) args) then - (array_for_all (check_rec_call env alreadygrd n vlra) vrest) + Array.iter (check_rec_call env alreadygrd n vlra) vrest else raise (CoFixGuardError (env,RecCallInCaseFun c)) else @@ -924,7 +888,12 @@ let check_one_cofix env nbfix def deftype = else raise (CoFixGuardError (env,RecCallInCasePred c)) + | Meta _ -> () + | Evar _ -> + List.iter (check_rec_call env alreadygrd n vlra) args + | _ -> raise (CoFixGuardError (env,NotGuardedForm t)) in + let (mind, _) = codomain_is_coind env deftype in let vlra = lookup_subterms env mind in check_rec_call env false 1 (dest_subterms vlra) def @@ -936,9 +905,7 @@ let check_cofix env (bodynum,(names,types,bodies as recdef)) = let nbfix = Array.length bodies in for i = 0 to nbfix-1 do let fixenv = push_rec_types recdef env in - try - let _ = check_one_cofix fixenv nbfix bodies.(i) types.(i) - in () + try check_one_cofix fixenv nbfix bodies.(i) types.(i) with CoFixGuardError (errenv,err) -> error_ill_formed_rec_body errenv err names i done diff --git a/kernel/inductive.mli b/kernel/inductive.mli index e60f909e..d81904cc 100644 --- a/kernel/inductive.mli +++ b/kernel/inductive.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: inductive.mli 8673 2006-03-29 21:21:52Z herbelin $ i*) +(*i $Id: inductive.mli 8871 2006-05-28 16:46:48Z herbelin $ i*) (*i*) open Names @@ -38,6 +38,8 @@ val lookup_mind_specif : env -> inductive -> mind_specif val type_of_inductive : mind_specif -> types +val elim_sorts : mind_specif -> sorts_family list + (* Return type as quoted by the user *) val type_of_constructor : constructor -> mind_specif -> types @@ -58,28 +60,48 @@ val type_case_branches : env -> inductive * constr list -> unsafe_judgment -> constr -> types array * types * constraints +(* Return the arity of an inductive type *) +val mind_arity : one_inductive_body -> Sign.rel_context * sorts_family + +val inductive_sort_family : one_inductive_body -> sorts_family + (* Check a [case_info] actually correspond to a Case expression on the given inductive type. *) val check_case_info : env -> inductive -> case_info -> unit -(* Find the ultimate inductive in the [mind_equiv] chain *) - -val scrape_mind : env -> mutual_inductive -> mutual_inductive - (*s Guard conditions for fix and cofix-points. *) val check_fix : env -> fixpoint -> unit val check_cofix : env -> cofixpoint -> unit (*s Support for sort-polymorphic inductive types *) -val constructor_instances : env -> mind_specif -> inductive -> - constr array -> env * types array array * universe array +val type_of_inductive_knowing_parameters : + env -> one_inductive_body -> types array -> types val set_inductive_level : env -> sorts -> types -> types -val find_inductive_level : env -> mind_specif -> inductive -> - universe array -> universe array -> sorts - -val is_small_inductive : mind_specif -> bool - val max_inductive_sort : sorts array -> universe + +(***************************************************************) +(* Debug *) + +type size = Large | Strict +type subterm_spec = + Subterm of (size * wf_paths) + | Dead_code + | Not_subterm +type guard_env = + { env : env; + (* dB of last fixpoint *) + rel_min : int; + (* inductive of recarg of each fixpoint *) + inds : inductive array; + (* the recarg information of inductive family *) + recvec : wf_paths array; + (* dB of variables denoting subterms *) + genv : subterm_spec list; + } + +val subterm_specif : guard_env -> constr -> subterm_spec +val case_branches_specif : guard_env -> constr -> inductive -> + constr array -> (guard_env * constr) array diff --git a/kernel/modops.ml b/kernel/modops.ml index 3d041c6c..b2f02a5f 100644 --- a/kernel/modops.ml +++ b/kernel/modops.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: modops.ml 7639 2005-12-02 10:01:15Z gregoire $ i*) +(*i $Id: modops.ml 8879 2006-05-30 21:32:10Z letouzey $ i*) (*i*) open Util @@ -41,7 +41,7 @@ let error_incompatible_labels l l' = error ("Opening and closing labels are not the same: " ^string_of_label l^" <> "^string_of_label l'^" !") -let error_result_must_be_signature mtb = +let error_result_must_be_signature () = error "The result module type must be a signature" let error_signature_expected mtb = @@ -190,35 +190,13 @@ and constants_of_modtype env mp modtype = (subst_signature_msid msid mp sign) | MTBfunsig _ -> [] -(* returns a resolver for kn that maps mbid to mp and then delta-expands - the obtained constants according to env *) +(* returns a resolver for kn that maps mbid to mp *) +(* Nota: Some delta-expansions used to happen here. + Browse SVN if you want to know more. *) let resolver_of_environment mbid modtype mp env = let constants = constants_of_modtype env (MPbound mbid) modtype in - let resolve = - List.map - (fun (con,expecteddef) -> - let con' = replace_mp_in_con (MPbound mbid) mp con in - let constr = - try - if expecteddef.Declarations.const_body <> None then - (* Do not expand constants that already have a body in the - expected type (i.e. only parameters/axioms in the module type - are expanded). In the few examples we have this seems to - be the more reasonable behaviour for the user. *) - None - else - let constant = lookup_constant con' env in - if constant.Declarations.const_opaque then - None - else - option_app Declarations.force - constant.Declarations.const_body - with Not_found -> error_no_such_label (con_label con') - in - con,constr - ) constants - in - Mod_subst.make_resolver resolve + let resolve = List.map (fun (con,_) -> con,None) constants in + Mod_subst.make_resolver resolve (* we assume that the substitution of "mp" into "msid" is already done (or unnecessary) *) diff --git a/kernel/modops.mli b/kernel/modops.mli index 371860f5..2aca6511 100644 --- a/kernel/modops.mli +++ b/kernel/modops.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: modops.mli 6616 2005-01-21 17:18:23Z herbelin $ i*) +(*i $Id: modops.mli 8721 2006-04-15 15:30:04Z herbelin $ i*) (*i*) open Util @@ -74,7 +74,7 @@ val error_incompatible_labels : label -> label -> 'a val error_no_such_label : label -> 'a -val error_result_must_be_signature : module_type_body -> 'a +val error_result_must_be_signature : unit -> 'a val error_signature_expected : module_type_body -> 'a diff --git a/kernel/names.ml b/kernel/names.ml index 4c8cf7bb..ae5afebd 100644 --- a/kernel/names.ml +++ b/kernel/names.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: names.ml 7834 2006-01-11 00:15:01Z herbelin $ *) +(* $Id: names.ml 8852 2006-05-23 17:52:43Z notin $ *) open Pp open Util @@ -198,6 +198,10 @@ let con_label = label let pr_con = pr_kn let con_modpath = modpath +let mind_modpath = modpath +let ind_modpath ind = mind_modpath (fst ind) +let constr_modpath c = ind_modpath (fst c) + let ith_mutual_inductive (kn,_) i = (kn,i) let ith_constructor_of_inductive ind i = (ind,i) let inductive_of_constructor (ind,i) = ind diff --git a/kernel/names.mli b/kernel/names.mli index 5b0a7a30..82a638c0 100644 --- a/kernel/names.mli +++ b/kernel/names.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: names.mli 6736 2005-02-18 20:49:04Z herbelin $ i*) +(*i $Id: names.mli 8852 2006-05-23 17:52:43Z notin $ i*) (*s Identifiers *) @@ -134,6 +134,10 @@ val con_label : constant -> label val con_modpath : constant -> module_path val pr_con : constant -> Pp.std_ppcmds +val mind_modpath : mutual_inductive -> module_path +val ind_modpath : inductive -> module_path +val constr_modpath : constructor -> module_path + val ith_mutual_inductive : inductive -> int -> inductive val ith_constructor_of_inductive : inductive -> int -> constructor val inductive_of_constructor : constructor -> inductive diff --git a/kernel/pre_env.ml b/kernel/pre_env.ml index 5a45c167..947e4675 100644 --- a/kernel/pre_env.ml +++ b/kernel/pre_env.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: pre_env.ml 7642 2005-12-06 08:56:29Z gregoire $ *) +(* $Id: pre_env.ml 8810 2006-05-12 18:50:21Z barras $ *) open Util open Names @@ -144,3 +144,8 @@ let lookup_constant kn env = (* Mutual Inductives *) let lookup_mind kn env = KNmap.find kn env.env_globals.env_inductives + +let rec scrape_mind env kn = + match (lookup_mind kn env).mind_equiv with + | None -> kn + | Some kn' -> scrape_mind env kn' diff --git a/kernel/pre_env.mli b/kernel/pre_env.mli index be74decf..2642bc92 100644 --- a/kernel/pre_env.mli +++ b/kernel/pre_env.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: pre_env.mli 7642 2005-12-06 08:56:29Z gregoire $ *) +(* $Id: pre_env.mli 8810 2006-05-12 18:50:21Z barras $ *) open Util open Names @@ -83,4 +83,7 @@ val lookup_constant : constant -> env -> constant_body (* Mutual Inductives *) val lookup_mind : mutual_inductive -> env -> mutual_inductive_body +(* Find the ultimate inductive in the [mind_equiv] chain *) +val scrape_mind : env -> mutual_inductive -> mutual_inductive + diff --git a/kernel/reduction.ml b/kernel/reduction.ml index 6477078a..bd849dad 100644 --- a/kernel/reduction.ml +++ b/kernel/reduction.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: reduction.ml 7639 2005-12-02 10:01:15Z gregoire $ *) +(* $Id: reduction.ml 8845 2006-05-23 07:41:58Z herbelin $ *) open Util open Names @@ -41,8 +41,8 @@ let compare_stack_shape stk1 stk2 = ([],[]) -> bal=0 | ((Zupdate _|Zshift _)::s1, _) -> compare_rec bal s1 stk2 | (_, (Zupdate _|Zshift _)::s2) -> compare_rec bal stk1 s2 - | (Zapp l1::s1, _) -> compare_rec (bal+List.length l1) s1 stk2 - | (_, Zapp l2::s2) -> compare_rec (bal-List.length l2) stk1 s2 + | (Zapp l1::s1, _) -> compare_rec (bal+Array.length l1) s1 stk2 + | (_, Zapp l2::s2) -> compare_rec (bal-Array.length l2) stk1 s2 | (Zcase(c1,_,_)::s1, Zcase(c2,_,_)::s2) -> bal=0 (* && c1.ci_ind = c2.ci_ind *) && compare_rec 0 s1 s2 | (Zfix(_,a1)::s1, Zfix(_,a2)::s2) -> @@ -50,6 +50,16 @@ let compare_stack_shape stk1 stk2 = | (_,_) -> false in compare_rec 0 stk1 stk2 +type lft_constr_stack_elt = + Zlapp of (lift * fconstr) array + | Zlfix of (lift * fconstr) * lft_constr_stack + | Zlcase of case_info * lift * fconstr * fconstr array +and lft_constr_stack = lft_constr_stack_elt list + +let rec zlapp v = function + Zlapp v2 :: s -> zlapp (Array.append v v2) s + | s -> Zlapp v :: s + let pure_stack lfts stk = let rec pure_rec lfts stk = match stk with @@ -58,15 +68,13 @@ let pure_stack lfts stk = (match (zi,pure_rec lfts s) with (Zupdate _,lpstk) -> lpstk | (Zshift n,(l,pstk)) -> (el_shft n l, pstk) - | (Zapp a1,(l,Zapp a2::pstk)) -> - (l,Zapp (List.map (fun t -> (l,t)) a1 @ a2)::pstk) | (Zapp a, (l,pstk)) -> - (l,Zapp (List.map (fun t -> (l,t)) a)::pstk) + (l,zlapp (Array.map (fun t -> (l,t)) a) pstk) | (Zfix(fx,a),(l,pstk)) -> let (lfx,pa) = pure_rec l a in - (l, Zfix((lfx,fx),pa)::pstk) + (l, Zlfix((lfx,fx),pa)::pstk) | (Zcase(ci,p,br),(l,pstk)) -> - (l,Zcase(ci,(l,p),Array.map (fun t -> (l,t)) br)::pstk)) in + (l,Zlcase(ci,l,p,br)::pstk)) in snd (pure_rec lfts stk) (****************************************************************************) @@ -98,10 +106,10 @@ let whd_betadeltaiota_nolet env t = let beta_appvect c v = let rec stacklam env t stack = - match (decomp_stack stack,kind_of_term t) with - | Some (h,stacktl), Lambda (_,_,c) -> stacklam (h::env) c stacktl - | _ -> app_stack (substl env t, stack) in - stacklam [] c (append_stack v empty_stack) + match kind_of_term t, stack with + Lambda(_,_,c), arg::stacktl -> stacklam (arg::env) c stacktl + | _ -> applist (substl env t, stack) in + stacklam [] c (Array.to_list v) (********************************************************************) (* Conversion *) @@ -117,17 +125,17 @@ let compare_stacks f fmind lft1 stk1 lft2 stk2 cuniv = let rec cmp_rec pstk1 pstk2 cuniv = match (pstk1,pstk2) with | (z1::s1, z2::s2) -> - let c1 = cmp_rec s1 s2 cuniv in + let cu1 = cmp_rec s1 s2 cuniv in (match (z1,z2) with - | (Zapp a1,Zapp a2) -> List.fold_right2 f a1 a2 c1 - | (Zfix(fx1,a1),Zfix(fx2,a2)) -> - let c2 = f fx1 fx2 c1 in - cmp_rec a1 a2 c2 - | (Zcase(ci1,p1,br1),Zcase(ci2,p2,br2)) -> + | (Zlapp a1,Zlapp a2) -> array_fold_right2 f a1 a2 cu1 + | (Zlfix(fx1,a1),Zlfix(fx2,a2)) -> + let cu2 = f fx1 fx2 cu1 in + cmp_rec a1 a2 cu2 + | (Zlcase(ci1,l1,p1,br1),Zlcase(ci2,l2,p2,br2)) -> if not (fmind ci1.ci_ind ci2.ci_ind) then raise NotConvertible; - let c2 = f p1 p2 c1 in - array_fold_right2 f br1 br2 c2 + let cu2 = f (l1,p1) (l2,p2) cu1 in + array_fold_right2 (fun c1 c2 -> f (l1,c1) (l2,c2)) br1 br2 cu2 | _ -> assert false) | _ -> cuniv in if compare_stack_shape stk1 stk2 then @@ -291,10 +299,18 @@ and eqappr cv_pb infos appr1 appr2 cuniv = convert_stacks infos lft1 lft2 v1 v2 u2 else raise NotConvertible - | ( (FLetIn _, _) | (_, FLetIn _) | (FCases _,_) | (_,FCases _) - | (FApp _,_) | (_,FApp _) | (FCLOS _, _) | (_,FCLOS _) - | (FLIFT _, _) | (_,FLIFT _) | (FLOCKED,_) | (_,FLOCKED)) -> - anomaly "Unexpected term returned by fhnf" + (* Can happen because whd_stack on one arg may have side-effects + on the other arg and coulb be no more in hnf... *) + | ( (FLetIn _, _) | (FCases _,_) | (FApp _,_) + | (FCLOS _, _) | (FLIFT _, _)) -> + eqappr cv_pb infos (lft1, whd_stack infos hd1 v1) appr2 cuniv + + | ( (_, FLetIn _) | (_,FCases _) | (_,FApp _) + | (_,FCLOS _) | (_,FLIFT _)) -> + eqappr cv_pb infos (lft1, whd_stack infos hd1 v1) appr2 cuniv + + (* Should not happen because whd_stack unlocks references *) + | ((FLOCKED,_) | (_,FLOCKED)) -> assert false | _ -> raise NotConvertible @@ -422,7 +438,7 @@ let dest_prod_assum env = prodec_rec env Sign.empty_rel_context let dest_arity env c = - let l, c = dest_prod env c in + let l, c = dest_prod_assum env c in match kind_of_term c with | Sort s -> l,s | _ -> error "not an arity" diff --git a/kernel/safe_typing.ml b/kernel/safe_typing.ml index 34071182..95092814 100644 --- a/kernel/safe_typing.ml +++ b/kernel/safe_typing.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: safe_typing.ml 7602 2005-11-23 15:10:16Z barras $ *) +(* $Id: safe_typing.ml 8898 2006-06-05 23:15:51Z letouzey $ *) open Util open Names @@ -30,7 +30,6 @@ type modvariant = | NONE | SIG of (* funsig params *) (mod_bound_id * module_type_body) list | STRUCT of (* functor params *) (mod_bound_id * module_type_body) list - * (* optional result type *) module_type_body option | LIBRARY of dir_path type module_info = @@ -224,36 +223,18 @@ let add_module l me senv = (* Interactive modules *) -let start_module l params result senv = +let start_module l senv = check_label l senv.labset; - let rec trans_params env = function - | [] -> env,[] - | (mbid,mte)::rest -> - let mtb = translate_modtype env mte in - let env = - full_add_module (MPbound mbid) (module_body_of_type mtb) env - in - let env,transrest = trans_params env rest in - env, (mbid,mtb)::transrest - in - let env,params_body = trans_params senv.env params in - let check_sig mtb = match scrape_modtype env mtb with - | MTBsig _ -> () - | MTBfunsig _ -> error_result_must_be_signature mtb - | _ -> anomaly "start_module: modtype not scraped" - in - let result_body = option_app (translate_modtype env) result in - ignore (option_app check_sig result_body); let msid = make_msid senv.modinfo.seed (string_of_label l) in let mp = MPself msid in let modinfo = { msid = msid; modpath = mp; seed = senv.modinfo.seed; label = l; - variant = STRUCT(params_body,result_body) } + variant = STRUCT [] } in mp, { old = senv; - env = env; + env = senv.env; modinfo = modinfo; labset = Labset.empty; revsign = []; @@ -261,21 +242,21 @@ let start_module l params result senv = imports = senv.imports; loads = [] } - - -let end_module l senv = +let end_module l restype senv = let oldsenv = senv.old in let modinfo = senv.modinfo in - let params, restype = + let restype = option_map (translate_modtype senv.env) restype in + let params = match modinfo.variant with | NONE | LIBRARY _ | SIG _ -> error_no_module_to_end () - | STRUCT(params,restype) -> (params,restype) + | STRUCT params -> params in if l <> modinfo.label then error_incompatible_labels l modinfo.label; if not (empty_context senv.env) then error_local_context None; - let functorize_type = - List.fold_right - (fun (arg_id,arg_b) mtb -> MTBfunsig (arg_id,arg_b,mtb)) + let functorize_type tb = + List.fold_left + (fun mtb (arg_id,arg_b) -> MTBfunsig (arg_id,arg_b,mtb)) + tb params in let auto_tb = MTBsig (modinfo.msid, List.rev senv.revsign) in @@ -288,10 +269,10 @@ let end_module l senv = mtb, Some mtb, cst in let mexpr = - List.fold_right - (fun (arg_id,arg_b) mtb -> MEBfunctor (arg_id,arg_b,mtb)) - params + List.fold_left + (fun mtb (arg_id,arg_b) -> MEBfunctor (arg_id,arg_b,mtb)) (MEBstruct (modinfo.msid, List.rev senv.revstruct)) + params in let mb = { mod_expr = Some mexpr; @@ -326,31 +307,44 @@ let end_module l senv = loads = senv.loads@oldsenv.loads } +(* Adding parameters to modules or module types *) + +let add_module_parameter mbid mte senv = + if senv.revsign <> [] or senv.revstruct <> [] or senv.loads <> [] then + anomaly "Cannot add a module parameter to a non empty module"; + let mtb = translate_modtype senv.env mte in + let env = full_add_module (MPbound mbid) (module_body_of_type mtb) senv.env + in + let new_variant = match senv.modinfo.variant with + | STRUCT params -> STRUCT ((mbid,mtb) :: params) + | SIG params -> SIG ((mbid,mtb) :: params) + | _ -> + anomaly "Module parameters can only be added to modules or signatures" + in + { old = senv.old; + env = env; + modinfo = { senv.modinfo with variant = new_variant }; + labset = senv.labset; + revsign = []; + revstruct = []; + imports = senv.imports; + loads = [] } + + (* Interactive module types *) -let start_modtype l params senv = +let start_modtype l senv = check_label l senv.labset; - let rec trans_params env = function - | [] -> env,[] - | (mbid,mte)::rest -> - let mtb = translate_modtype env mte in - let env = - full_add_module (MPbound mbid) (module_body_of_type mtb) env - in - let env,transrest = trans_params env rest in - env, (mbid,mtb)::transrest - in - let env,params_body = trans_params senv.env params in let msid = make_msid senv.modinfo.seed (string_of_label l) in let mp = MPself msid in let modinfo = { msid = msid; modpath = mp; seed = senv.modinfo.seed; label = l; - variant = SIG params_body } + variant = SIG [] } in mp, { old = senv; - env = env; + env = senv.env; modinfo = modinfo; labset = Labset.empty; revsign = []; @@ -370,10 +364,10 @@ let end_modtype l senv = if not (empty_context senv.env) then error_local_context None; let res_tb = MTBsig (modinfo.msid, List.rev senv.revsign) in let mtb = - List.fold_right - (fun (arg_id,arg_b) mtb -> MTBfunsig (arg_id,arg_b,mtb)) - params + List.fold_left + (fun mtb (arg_id,arg_b) -> MTBfunsig (arg_id,arg_b,mtb)) res_tb + params in let kn = make_kn oldsenv.modinfo.modpath empty_dirpath l in let newenv = oldsenv.env in @@ -520,9 +514,9 @@ let import (dp,mb,depends,engmt) digest senv = let rec lighten_module mb = { mb with - mod_expr = option_app lighten_modexpr mb.mod_expr; + mod_expr = option_map lighten_modexpr mb.mod_expr; mod_type = lighten_modtype mb.mod_type; - mod_user_type = option_app lighten_modtype mb.mod_user_type } + mod_user_type = option_map lighten_modtype mb.mod_user_type } and lighten_modtype = function | MTBident kn as x -> x diff --git a/kernel/safe_typing.mli b/kernel/safe_typing.mli index 148a9d9d..c3d0abde 100644 --- a/kernel/safe_typing.mli +++ b/kernel/safe_typing.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: safe_typing.mli 7639 2005-12-02 10:01:15Z gregoire $ i*) +(*i $Id: safe_typing.mli 8723 2006-04-16 15:51:02Z herbelin $ i*) (*i*) open Names @@ -72,17 +72,17 @@ val set_engagement : engagement -> safe_environment -> safe_environment (*s Interactive module functions *) val start_module : - label -> (mod_bound_id * module_type_entry) list - -> module_type_entry option - -> safe_environment -> module_path * safe_environment + label -> safe_environment -> module_path * safe_environment val end_module : - label -> safe_environment -> module_path * safe_environment + label -> module_type_entry option + -> safe_environment -> module_path * safe_environment +val add_module_parameter : + mod_bound_id -> module_type_entry -> safe_environment -> safe_environment val start_modtype : - label -> (mod_bound_id * module_type_entry) list - -> safe_environment -> module_path * safe_environment + label -> safe_environment -> module_path * safe_environment val end_modtype : label -> safe_environment -> kernel_name * safe_environment diff --git a/kernel/sign.ml b/kernel/sign.ml index 7caf667f..75342f2c 100644 --- a/kernel/sign.ml +++ b/kernel/sign.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: sign.ml 7639 2005-12-02 10:01:15Z gregoire $ *) +(* $Id: sign.ml 8845 2006-05-23 07:41:58Z herbelin $ *) open Names open Util @@ -89,7 +89,7 @@ let push_named_to_rel_context hyps ctxt = let rec push = function | (id,b,t) :: l -> let s, hyps = push l in - let d = (Name id, option_app (subst_vars s) b, type_app (subst_vars s) t) in + let d = (Name id, option_map (subst_vars s) b, type_app (subst_vars s) t) in id::s, d::hyps | [] -> [],[] in let s, hyps = push hyps in @@ -191,3 +191,4 @@ let decompose_lam_n_assum n = | c -> error "decompose_lam_n_assum: not enough abstractions" in lamdec_rec empty_rel_context n + diff --git a/kernel/subtyping.ml b/kernel/subtyping.ml index 94251d90..bbc89e39 100644 --- a/kernel/subtyping.ml +++ b/kernel/subtyping.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: subtyping.ml 7639 2005-12-02 10:01:15Z gregoire $ i*) +(*i $Id: subtyping.ml 8845 2006-05-23 07:41:58Z herbelin $ i*) (*i*) open Util @@ -89,14 +89,15 @@ let check_inductive cst env msid1 l info1 mib2 spec2 = (* nf_arity later *) (* user_lc ignored *) (* user_arity ignored *) - let cst = check_conv cst conv_sort env p1.mind_sort p2.mind_sort in check (fun p -> p.mind_nrealargs); (* kelim ignored *) (* listrec ignored *) (* finite done *) (* nparams done *) (* params_ctxt done *) - let cst = check_conv cst conv env p1.mind_nf_arity p2.mind_nf_arity in + (* Don't check the sort of the type if polymorphic *) + let cst = check_conv cst conv env (type_of_inductive (mib1,p1)) (type_of_inductive (mib2,p2)) + in cst in let check_cons_types i cst p1 p2 = @@ -181,7 +182,7 @@ let check_constant cst env msid1 l info1 cb2 spec2 = "name.") ; assert (mind1.mind_hyps=[] && cb2.const_hyps=[]) ; if cb2.const_body <> None then error () ; - let arity1 = mind1.mind_packets.(i).mind_user_arity in + let arity1 = type_of_inductive (mind1,mind1.mind_packets.(i)) in check_conv cst conv_leq env arity1 cb2.const_type | IndConstr (((kn,i),j) as cstr,mind1) -> Util.error ("The kernel does not recognize yet that a parameter can be " ^ diff --git a/kernel/term.ml b/kernel/term.ml index 7060d000..228ae48a 100644 --- a/kernel/term.ml +++ b/kernel/term.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: term.ml 8049 2006-02-16 10:42:18Z coq $ *) +(* $Id: term.ml 8850 2006-05-23 16:11:31Z herbelin $ *) (* This module instantiates the structure of generic deBruijn terms to Coq *) @@ -643,7 +643,7 @@ let body_of_type ty = ty type named_declaration = identifier * constr option * types type rel_declaration = name * constr option * types -let map_named_declaration f (id, v, ty) = (id, option_app f v, f ty) +let map_named_declaration f (id, v, ty) = (id, option_map f v, f ty) let map_rel_declaration = map_named_declaration (****************************************************************************) @@ -752,36 +752,34 @@ let rec lift_substituend depth s = let make_substituend c = { sinfo=Unknown; sit=c } -let substn_many lamv n = +let substn_many lamv n c = let lv = Array.length lamv in - let rec substrec depth c = match kind_of_term c with - | Rel k -> - if k<=depth then - c - else if k-depth <= lv then - lift_substituend depth lamv.(k-depth-1) - else - mkRel (k-lv) - | _ -> map_constr_with_binders succ substrec depth c - in - substrec n + if lv = 0 then c + else + let rec substrec depth c = match kind_of_term c with + | Rel k -> + if k<=depth then c + else if k-depth <= lv then lift_substituend depth lamv.(k-depth-1) + else mkRel (k-lv) + | _ -> map_constr_with_binders succ substrec depth c in + substrec n c (* let substkey = Profile.declare_profile "substn_many";; let substn_many lamv n c = Profile.profile3 substkey substn_many lamv n c;; *) -let substnl laml k = - substn_many (Array.map make_substituend (Array.of_list laml)) k -let substl laml = - substn_many (Array.map make_substituend (Array.of_list laml)) 0 +let substnl laml n = + substn_many (Array.map make_substituend (Array.of_list laml)) n +let substl laml = substnl laml 0 let subst1 lam = substl [lam] -let substl_decl laml (id,bodyopt,typ) = - match bodyopt with - | None -> (id,None,substl laml typ) - | Some body -> (id, Some (substl laml body), type_app (substl laml) typ) +let substnl_decl laml k (id,bodyopt,typ) = + (id,option_map (substnl laml k) bodyopt,substnl laml k typ) +let substl_decl laml = substnl_decl laml 0 let subst1_decl lam = substl_decl [lam] +let subst1_named_decl = subst1_decl +let substl_named_decl = substl_decl (* (thin_val sigma) removes identity substitutions from sigma *) diff --git a/kernel/term.mli b/kernel/term.mli index 0eccd170..8d72e0d8 100644 --- a/kernel/term.mli +++ b/kernel/term.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: term.mli 8049 2006-02-16 10:42:18Z coq $ i*) +(*i $Id: term.mli 8850 2006-05-23 16:11:31Z herbelin $ i*) (*i*) open Names @@ -460,8 +460,12 @@ val substnl : constr list -> int -> constr -> constr val substl : constr list -> constr -> constr val subst1 : constr -> constr -> constr -val substl_decl : constr list -> named_declaration -> named_declaration -val subst1_decl : constr -> named_declaration -> named_declaration +val substnl_decl : constr list -> int -> rel_declaration -> rel_declaration +val substl_decl : constr list -> rel_declaration -> rel_declaration +val subst1_decl : constr -> rel_declaration -> rel_declaration + +val subst1_named_decl : constr -> named_declaration -> named_declaration +val substl_named_decl : constr list -> named_declaration -> named_declaration val replace_vars : (identifier * constr) list -> constr -> constr val subst_var : identifier -> constr -> constr diff --git a/kernel/type_errors.ml b/kernel/type_errors.ml index 3807ecdb..87de6698 100644 --- a/kernel/type_errors.ml +++ b/kernel/type_errors.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: type_errors.ml 8673 2006-03-29 21:21:52Z herbelin $ *) +(* $Id: type_errors.ml 8845 2006-05-23 07:41:58Z herbelin $ *) open Names open Term @@ -45,8 +45,8 @@ type type_error = | NotAType of unsafe_judgment | BadAssumption of unsafe_judgment | ReferenceVariables of constr - | ElimArity of inductive * types list * constr * unsafe_judgment - * (constr * constr * arity_error) option + | ElimArity of inductive * sorts_family list * constr * unsafe_judgment + * (sorts_family * sorts_family * arity_error) option | CaseNotInductive of unsafe_judgment | WrongCaseInfo of inductive * case_info | NumberBranches of unsafe_judgment * int diff --git a/kernel/type_errors.mli b/kernel/type_errors.mli index c56b174b..138c313c 100644 --- a/kernel/type_errors.mli +++ b/kernel/type_errors.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: type_errors.mli 6019 2004-08-06 18:15:24Z herbelin $ i*) +(*i $Id: type_errors.mli 8845 2006-05-23 07:41:58Z herbelin $ i*) (*i*) open Names @@ -47,8 +47,8 @@ type type_error = | NotAType of unsafe_judgment | BadAssumption of unsafe_judgment | ReferenceVariables of constr - | ElimArity of inductive * types list * constr * unsafe_judgment - * (constr * constr * arity_error) option + | ElimArity of inductive * sorts_family list * constr * unsafe_judgment + * (sorts_family * sorts_family * arity_error) option | CaseNotInductive of unsafe_judgment | WrongCaseInfo of inductive * case_info | NumberBranches of unsafe_judgment * int @@ -75,8 +75,8 @@ val error_assumption : env -> unsafe_judgment -> 'a val error_reference_variables : env -> constr -> 'a val error_elim_arity : - env -> inductive -> types list -> constr - -> unsafe_judgment -> (constr * constr * arity_error) option -> 'a + env -> inductive -> sorts_family list -> constr -> unsafe_judgment -> + (sorts_family * sorts_family * arity_error) option -> 'a val error_case_not_inductive : env -> unsafe_judgment -> 'a diff --git a/kernel/typeops.ml b/kernel/typeops.ml index 779a427a..8299a3c9 100644 --- a/kernel/typeops.ml +++ b/kernel/typeops.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: typeops.ml 8673 2006-03-29 21:21:52Z herbelin $ *) +(* $Id: typeops.ml 8871 2006-05-28 16:46:48Z herbelin $ *) open Util open Names @@ -245,14 +245,28 @@ let judge_of_cast env cj k tj = (* Inductive types. *) -let judge_of_inductive env i = - let constr = mkInd i in - let _ = - let (kn,_) = i in - let mib = lookup_mind kn env in - check_args env constr mib.mind_hyps in - let specif = lookup_mind_specif env i in - make_judge constr (type_of_inductive specif) +(* The type is parametric over the uniform parameters whose conclusion + is in Type; to enforce the internal constraints between the + parameters and the instances of Type occurring in the type of the + constructors, we use the level variables _statically_ assigned to + the conclusions of the parameters as mediators: e.g. if a parameter + has conclusion Type(alpha), static constraints of the form alpha<=v + exist between alpha and the Type's occurring in the constructor + types; when the parameters is finally instantiated by a term of + conclusion Type(u), then the constraints u<=alpha is computed in + the App case of execute; from this constraints, the expected + dynamic constraints of the form u<=v are enforced *) + +let judge_of_inductive_knowing_parameters env ind jl = + let c = mkInd ind in + let (mib,mip) = lookup_mind_specif env ind in + check_args env c mib.mind_hyps; + let paramstyp = Array.map (fun j -> j.uj_type) jl in + let t = Inductive.type_of_inductive_knowing_parameters env mip paramstyp in + make_judge c t + +let judge_of_inductive env ind = + judge_of_inductive_knowing_parameters env ind [||] (* Constructors. *) @@ -334,14 +348,15 @@ let rec execute env cstr cu = (* Lambda calculus operators *) | App (f,args) -> - let (j,cu1) = execute env f cu in - let (jl,cu2) = execute_array env args cu1 in - let (j',cu) = univ_combinator cu2 (judge_of_apply env j jl) in - if isInd f then - (* Sort-polymorphism of inductive types *) - adjust_inductive_level env (destInd f) args (j',cu) - else - (j',cu) + let (jl,cu1) = execute_array env args cu in + let (j,cu2) = + if isInd f then + (* Sort-polymorphism of inductive types *) + judge_of_inductive_knowing_parameters env (destInd f) jl, cu1 + else + execute env f cu1 + in + univ_combinator cu2 (judge_of_apply env j jl) | Lambda (name,c1,c2) -> let (varj,cu1) = execute_type env c1 cu in @@ -421,22 +436,6 @@ and execute_array env = array_fold_map' (execute env) and execute_list env = list_fold_map' (execute env) -and adjust_inductive_level env ind args (j,cu) = - let specif = lookup_mind_specif env ind in - if is_small_inductive specif then - (* No polymorphism *) - (j,cu) - else - (* Retyping constructor with the actual arguments *) - let env',llc,ls0 = constructor_instances env specif ind args in - let (llj,cu1) = array_fold_map' (execute_array env') llc cu in - let ls = - Array.map (fun lj -> - max_inductive_sort (Array.map (sort_judgment env) lj)) llj - in - let s = find_inductive_level env specif ind ls0 ls in - (on_judgment_type (set_inductive_level env s) j, cu1) - (* Derived functions *) let infer env constr = let (j,(cst,_)) = diff --git a/kernel/typeops.mli b/kernel/typeops.mli index 34ecd103..86a795b5 100644 --- a/kernel/typeops.mli +++ b/kernel/typeops.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: typeops.mli 8673 2006-03-29 21:21:52Z herbelin $ i*) +(*i $Id: typeops.mli 8871 2006-05-28 16:46:48Z herbelin $ i*) (*i*) open Names @@ -78,6 +78,9 @@ val judge_of_cast : val judge_of_inductive : env -> inductive -> unsafe_judgment +val judge_of_inductive_knowing_parameters : + env -> inductive -> unsafe_judgment array -> unsafe_judgment + val judge_of_constructor : env -> constructor -> unsafe_judgment (*s Type of Cases. *) diff --git a/kernel/univ.ml b/kernel/univ.ml index 23e50282..e76b7b02 100644 --- a/kernel/univ.ml +++ b/kernel/univ.ml @@ -6,7 +6,11 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: univ.ml 8673 2006-03-29 21:21:52Z herbelin $ *) +(* $Id: univ.ml 8845 2006-05-23 07:41:58Z herbelin $ *) + +(* Initial Caml version originates from CoC 4.8 [Dec 1988] *) +(* Extension with algebraic universes by HH [Sep 2001] *) +(* Additional support for sort-polymorphic inductive types by HH [Mar 2006] *) (* Universes are stratified by a partial ordering $\le$. Let $\~{}$ be the associated equivalence. We also have a strict ordering @@ -92,7 +96,7 @@ let sup u v = let gtl'' = list_union gtl gtl' in Max (list_subtract gel'' gtl'',gtl'') -let sup_array ls = Array.fold_right sup ls (Max ([],[])) +let neutral_univ = Max ([],[]) (* Comparison on this type is pointer equality *) type canonical_arc = @@ -125,7 +129,7 @@ let declare_univ u g = (* The level of Set *) let base_univ = Atom Base -let is_base = function +let is_base_univ = function | Atom Base -> true | Max ([Base],[]) -> warning "Non canonical Set"; true | u -> false @@ -428,11 +432,11 @@ let make_max = function | ([u],[]) -> Atom u | (le,lt) -> Max (le,lt) -let remove_constraint u = function +let remove_large_constraint u = function | Atom u' as x -> if u = u' then Max ([],[]) else x | Max (le,lt) -> make_max (list_remove u le,lt) -let is_empty_universe = function +let is_empty_univ = function | Max ([],[]) -> true | _ -> false @@ -454,22 +458,40 @@ where - the wi are arbitrary complex universes that do not mention the ui. *) +let is_direct_sort_constraint s v = match s with + | Some u -> is_direct_constraint u v + | None -> false + let solve_constraints_system levels level_bounds = let levels = - Array.map (function Atom u -> u | _ -> anomaly "expects Atom") levels in + Array.map (option_map (function Atom u -> u | _ -> anomaly "expects Atom")) + levels in let v = Array.copy level_bounds in let nind = Array.length v in for i=0 to nind-1 do for j=0 to nind-1 do - if i<>j & is_direct_constraint levels.(j) v.(i) then - v.(i) <- sup v.(i) v.(j) + if i<>j & is_direct_sort_constraint levels.(j) v.(i) then + v.(i) <- sup v.(i) level_bounds.(j) done; for j=0 to nind-1 do - v.(i) <- remove_constraint levels.(j) v.(i) + match levels.(j) with + | Some u -> v.(i) <- remove_large_constraint u v.(i) + | None -> () done done; v +let subst_large_constraint u u' v = + match u with + | Atom u -> + if is_direct_constraint u v then sup u' (remove_large_constraint u v) + else v + | _ -> + anomaly "expect a universe level" + +let subst_large_constraints = + List.fold_right (fun (u,u') -> subst_large_constraint u u') + (* Pretty-printing *) let num_universes g = diff --git a/kernel/univ.mli b/kernel/univ.mli index f39f05d9..f3af0861 100644 --- a/kernel/univ.mli +++ b/kernel/univ.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: univ.mli 8673 2006-03-29 21:21:52Z herbelin $ i*) +(*i $Id: univ.mli 8845 2006-05-23 07:41:58Z herbelin $ i*) (* Universes. *) @@ -14,9 +14,10 @@ type universe val base_univ : universe val prop_univ : universe +val neutral_univ : universe val make_univ : Names.dir_path * int -> universe -val is_base : universe -> bool +val is_base_univ : universe -> bool (* The type of a universe *) val super : universe -> universe @@ -24,9 +25,6 @@ val super : universe -> universe (* The max of 2 universes *) val sup : universe -> universe -> universe -(* The max of an array of universes *) -val sup_array : universe array -> universe - (*s Graphs of universes. *) type universes @@ -58,10 +56,15 @@ val merge_constraints : constraints -> universes -> universes val fresh_local_univ : unit -> universe -val solve_constraints_system : universe array -> universe array -> +val solve_constraints_system : universe option array -> universe array -> universe array -val is_empty_universe : universe -> bool +val is_empty_univ : universe -> bool + +val subst_large_constraint : universe -> universe -> universe -> universe + +val subst_large_constraints : + (universe * universe) list -> universe -> universe (*s Pretty-printing of universes. *) diff --git a/kernel/vconv.ml b/kernel/vconv.ml index f038c04f..653f8978 100644 --- a/kernel/vconv.ml +++ b/kernel/vconv.ml @@ -342,8 +342,8 @@ let constr_type_of_idkey env idkey = mkRel n, lift n ty let type_of_ind env ind = - let (_,mip) = Inductive.lookup_mind_specif env ind in - mip.mind_nf_arity + let specif = Inductive.lookup_mind_specif env ind in + Inductive.type_of_inductive specif let build_branches_type (mind,_ as _ind) mib mip params dep p rtbl = (* [build_one_branch i cty] construit le type de la ieme branche (commence @@ -461,7 +461,8 @@ and nf_stk env c t stk = in let aux = nf_predicate env (type_of_switch sw) - (hnf_prod_applist env mip.mind_nf_arity (Array.to_list params)) in + (hnf_prod_applist env (type_of_ind env ind) (Array.to_list params)) + in !dep,aux in (* Calcul du type des branches *) let btypes = diff --git a/lib/options.ml b/lib/options.ml index 0d934922..2e29f61b 100644 --- a/lib/options.ml +++ b/lib/options.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: options.ml 7740 2005-12-26 20:07:21Z herbelin $ *) +(* $Id: options.ml 8752 2006-04-27 19:37:33Z herbelin $ *) open Util @@ -70,11 +70,11 @@ let print_hyps_limit () = !print_hyps_limit (* A list of the areas of the system where "unsafe" operation * has been requested *) + let unsafe_set = ref Stringset.empty let add_unsafe s = unsafe_set := Stringset.add s !unsafe_set let is_unsafe s = Stringset.mem s !unsafe_set - (* Dump of globalization (to be used by coqdoc) *) let dump = ref false @@ -6,10 +6,18 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: pp.ml4 7751 2005-12-28 12:58:53Z herbelin $ *) +(* $Id: pp.ml4 8747 2006-04-27 16:00:49Z courtieu $ *) open Pp_control +(* This should not be used outside of this file. Use + Options.print_emacs instead. This one is updated when reading + command line options. This was the only way to make [Pp] depend on + an option without creating a circularity: [Options] -> [Util] -> + [Pp] -> [Options] *) +let print_emacs = ref false +let make_pp_emacs() = print_emacs:=true + (* The different kinds of blocks are: \begin{description} \item[hbox:] Horizontal block no line breaking; @@ -238,6 +246,17 @@ let pp_err_dirs = pp_dirs err_ft let ppcmds x = Ppdir_ppcmds x +(* Special chars for emacs, to detect warnings inside goal output *) +let emacs_warning_start_string = String.make 1 (Char.chr 254) +let emacs_warning_end_string = String.make 1 (Char.chr 255) + +let warnstart() = + if not !print_emacs then str "" else str emacs_warning_start_string + +let warnend() = + if not !print_emacs then str "" else str emacs_warning_end_string + + (* pretty printing functions WITHOUT FLUSH *) let pp_with ft strm = pp_dirs ft [< 'Ppdir_ppcmds strm >] @@ -246,10 +265,10 @@ let ppnl_with ft strm = pp_dirs ft [< 'Ppdir_ppcmds [< strm ; 'Ppcmd_force_newline >] >] let warning_with ft string = - ppnl_with ft [< str "Warning: " ; str string >] + ppnl_with ft [< warnstart() ; str "Warning: " ; str string ; warnend() >] let warn_with ft pps = - ppnl_with ft [< str "Warning: " ; pps >] + ppnl_with ft [< warnstart() ; str "Warning: " ; pps ; warnend() >] let pp_flush_with ft = Format.pp_print_flush ft @@ -263,7 +282,7 @@ let msgnl_with ft strm = pp_dirs ft [< 'Ppdir_ppcmds strm ; 'Ppdir_print_newline >] let msg_warning_with ft strm= - pp_dirs ft [< 'Ppdir_ppcmds [< str "Warning: "; strm>]; + pp_dirs ft [< 'Ppdir_ppcmds [< warnstart() ; str "Warning: "; strm ; warnend() >]; 'Ppdir_print_newline >] @@ -6,12 +6,17 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: pp.mli 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: pp.mli 8748 2006-04-27 16:01:26Z courtieu $ i*) (*i*) open Pp_control (*i*) +(* Modify pretty printing functions behavior for emacs ouput (special + chars inserted at some places). This function should called once in + module [Options], that's all. *) +val make_pp_emacs:unit -> unit + (* Pretty-printers. *) type ppcmd diff --git a/lib/system.ml b/lib/system.ml index fb3cf7b5..b8be9956 100644 --- a/lib/system.ml +++ b/lib/system.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: system.ml 7603 2005-11-23 17:21:53Z barras $ *) +(* $Id: system.ml 8877 2006-05-30 16:37:04Z notin $ *) open Pp open Util @@ -60,6 +60,9 @@ let glob s = expand_macros s 0 type physical_path = string type load_path = physical_path list +let physical_path_of_string s = s +let string_of_physical_path p = p + (* All subdirectories, recursively *) let exists_dir dir = diff --git a/lib/system.mli b/lib/system.mli index ea463732..2fea77ed 100644 --- a/lib/system.mli +++ b/lib/system.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: system.mli 7603 2005-11-23 17:21:53Z barras $ i*) +(*i $Id: system.mli 8877 2006-05-30 16:37:04Z notin $ i*) (*s Files and load paths. Load path entries remember the original root given by the user. For efficiency, we keep the full path (field @@ -20,6 +20,9 @@ val all_subdirs : unix_path:string -> (physical_path * string list) list val is_in_path : load_path -> string -> bool val where_in_path : load_path -> string -> physical_path * string +val physical_path_of_string : string -> physical_path +val string_of_physical_path : physical_path -> string + val make_suffix : string -> string -> string val file_readable_p : string -> bool diff --git a/lib/util.ml b/lib/util.ml index 2e6e1279..503dfeda 100644 --- a/lib/util.ml +++ b/lib/util.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -(* $Id: util.ml 8672 2006-03-29 21:06:33Z herbelin $ *) +(* $Id: util.ml 8867 2006-05-28 16:21:41Z herbelin $ *) open Pp @@ -214,6 +214,16 @@ let list_index x = in index_x 1 +let list_unique_index x = + let rec index_x n = function + | y::l -> + if x = y then + if List.mem x l then raise Not_found + else n + else index_x (succ n) l + | [] -> raise Not_found + in index_x 1 + let list_fold_left_i f = let rec it_list_f i a = function | [] -> a @@ -353,7 +363,19 @@ let list_prefix_of prefl l = | ([], _) -> true | (_, _) -> false in - prefrec (prefl,l) + prefrec (prefl,l) + +let list_drop_prefix p l = +(* if l=p++t then return t else l *) + let rec list_drop_prefix_rec = function + | ([], tl) -> Some tl + | (_, []) -> None + | (h1::tp, h2::tl) -> + if h1 = h2 then list_drop_prefix_rec (tp,tl) else None + in + match list_drop_prefix_rec (p,l) with + | Some r -> r + | None -> l let list_map_append f l = List.flatten (List.map f l) @@ -620,6 +642,13 @@ else let v' = Array.map (fun x -> let (y,e) = f x !e' in e' := e; y) v in (v',!e') +let array_fold_map2' f v1 v2 e = + let e' = ref e in + let v' = + array_map2 (fun x1 x2 -> let (y,e) = f x1 x2 !e' in e' := e; y) v1 v2 + in + (v',!e') + (* Matrices *) let matrix_transpose mat = @@ -672,7 +701,7 @@ let out_some = function | Some x -> x | None -> failwith "out_some" -let option_app f = function +let option_map f = function | None -> None | Some x -> Some (f x) diff --git a/lib/util.mli b/lib/util.mli index f77aa6b4..959ef802 100644 --- a/lib/util.mli +++ b/lib/util.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -(*i $Id: util.mli 8672 2006-03-29 21:06:33Z herbelin $ i*) +(*i $Id: util.mli 8867 2006-05-28 16:21:41Z herbelin $ i*) (*i*) open Pp @@ -100,6 +100,8 @@ val list_map2_i : val list_map3 : ('a -> 'b -> 'c -> 'd) -> 'a list -> 'b list -> 'c list -> 'd list val list_index : 'a -> 'a list -> int +(* [list_unique_index x l] returns [Not_found] if [x] doesn't occur exactly once *) +val list_unique_index : 'a -> 'a list -> int val list_iter_i : (int -> 'a -> unit) -> 'a list -> unit val list_fold_left_i : (int -> 'a -> 'b -> 'a) -> int -> 'a -> 'b list -> 'a val list_fold_right_and_left : @@ -121,6 +123,7 @@ val list_last : 'a list -> 'a val list_lastn : int -> 'a list -> 'a list val list_skipn : int -> 'a list -> 'a list val list_prefix_of : 'a list -> 'a list -> bool +val list_drop_prefix : 'a list -> 'a list -> 'a list (* [map_append f [x1; ...; xn]] returns [(f x1)@(f x2)@...@(f xn)] *) val list_map_append : ('a -> 'b list) -> 'a list -> 'b list (* raises [Invalid_argument] if the two lists don't have the same length *) @@ -170,6 +173,8 @@ val array_map_left : ('a -> 'b) -> 'a array -> 'b array val array_map_left_pair : ('a -> 'b) -> 'a array -> ('c -> 'd) -> 'c array -> 'b array * 'd array val array_fold_map' : ('a -> 'c -> 'b * 'c) -> 'a array -> 'c -> 'b array * 'c +val array_fold_map2' : + ('a -> 'b -> 'c -> 'd * 'c) -> 'a array -> 'b array -> 'c -> 'd array * 'c (*s Matrices *) @@ -199,7 +204,7 @@ val interval : int -> int -> int list val in_some : 'a -> 'a option val out_some : 'a option -> 'a -val option_app : ('a -> 'b) -> 'a option -> 'b option +val option_map : ('a -> 'b) -> 'a option -> 'b option val option_cons : 'a option -> 'a list -> 'a list val option_fold_right : ('a -> 'b -> 'b) -> 'a option -> 'b -> 'b val option_fold_left2 : ('a -> 'b -> 'c -> 'a) -> 'a -> 'b option -> diff --git a/library/declare.ml b/library/declare.ml index b1e55c20..81401a8e 100644 --- a/library/declare.ml +++ b/library/declare.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: declare.ml 7941 2006-01-28 23:07:59Z herbelin $ *) +(* $Id: declare.ml 8752 2006-04-27 19:37:33Z herbelin $ *) open Pp open Util @@ -204,7 +204,7 @@ let hcons_constant_declaration = function let (hcons1_constr,_) = hcons_constr (hcons_names()) in DefinitionEntry { const_entry_body = hcons1_constr ce.const_entry_body; - const_entry_type = option_app hcons1_constr ce.const_entry_type; + const_entry_type = option_map hcons1_constr ce.const_entry_type; const_entry_opaque = ce.const_entry_opaque; const_entry_boxed = ce.const_entry_boxed } | cd -> cd diff --git a/library/declaremods.ml b/library/declaremods.ml index 3b2196a5..aac2b599 100644 --- a/library/declaremods.ml +++ b/library/declaremods.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: declaremods.ml 7720 2005-12-24 00:25:55Z herbelin $ i*) +(*i $Id: declaremods.ml 8752 2006-04-27 19:37:33Z herbelin $ i*) open Pp open Util @@ -122,6 +122,18 @@ let msid_of_prefix (_,(mp,sec)) = anomaly ("Non-empty section in module name!" ^ string_of_mp mp ^ "." ^ string_of_dirpath sec) +(* Check that a module type is not functorial *) + +let rec check_sig env = function + | MTBident kn -> check_sig env (Environ.lookup_modtype kn env) + | MTBsig _ -> () + | MTBfunsig _ -> Modops.error_result_must_be_signature () + +let rec check_sig_entry env = function + | MTEident kn -> check_sig env (Environ.lookup_modtype kn env) + | MTEsig _ -> () + | MTEfunsig _ -> Modops.error_result_must_be_signature () + | MTEwith (mte,_) -> check_sig_entry env mte (* This function checks if the type calculated for the module [mp] is a subtype of [sub_mtb]. Uses only the global environment. *) @@ -434,58 +446,47 @@ let rec get_some_body mty env = match mty with replace_module (get_some_body mty env) id (Environ.lookup_module mp env) -let intern_args interp_modtype (env,oldargs) (idl,arg) = +let intern_args interp_modtype (idl,arg) = let lib_dir = Lib.library_dp() in let mbids = List.map (fun (_,id) -> make_mbid lib_dir (string_of_id id)) idl in - let mty = interp_modtype env arg in + let mty = interp_modtype (Global.env()) arg in let dirs = List.map (fun (_,id) -> make_dirpath [id]) idl in - let mps = List.map (fun mbid -> MPbound mbid) mbids in let substobjs = get_modtype_substobjs mty in - let substituted's = - List.map2 - (fun dir mp -> dir, mp, subst_substobjs dir mp substobjs) - dirs mps - in - List.iter - (fun (dir, mp, substituted) -> - do_module false "interp" load_objects 1 dir mp substobjs substituted) - substituted's; - let body = Modops.module_body_of_type (get_some_body mty env) in - let env = - List.fold_left (fun env mp -> Modops.add_module mp body env) env mps - in - env, List.map (fun mbid -> mbid,mty) mbids :: oldargs - + List.map2 + (fun dir mbid -> + Global.add_module_parameter mbid mty; + let mp = MPbound mbid in + let substituted = subst_substobjs dir mp substobjs in + do_module false "interp" load_objects 1 dir mp substobjs substituted; + (mbid,mty)) + dirs mbids + let start_module interp_modtype export id args res_o = let fs = Summary.freeze_summaries () in - let env = Global.env () in - let env,arg_entries_revlist = - List.fold_left (intern_args interp_modtype) (env,[]) args - in - let arg_entries = List.concat (List.rev arg_entries_revlist) in + + let mp = Global.start_module id in + let arg_entries = List.concat (List.map (intern_args interp_modtype) args) in let res_entry_o, sub_body_o = match res_o with None -> None, None - | Some (res, true) -> - Some (interp_modtype env res), None - | Some (res, false) -> - (* If the module type is non-restricting, we must translate it - here to catch errors as early as possible. If it is - estricting, the kernel takes care of it. *) - let sub_mte = - List.fold_right - (fun (arg_id,arg_t) mte -> MTEfunsig(arg_id,arg_t,mte)) - arg_entries - (interp_modtype env res) - in - let sub_mtb = - Mod_typing.translate_modtype (Global.env()) sub_mte - in + | Some (res, restricted) -> + (* we translate the module here to catch errors as early as possible *) + let mte = interp_modtype (Global.env()) res in + check_sig_entry (Global.env()) mte; + if restricted then + Some mte, None + else + let mtb = Mod_typing.translate_modtype (Global.env()) mte in + let sub_mtb = + List.fold_right + (fun (arg_id,arg_t) mte -> + let arg_t = Mod_typing.translate_modtype (Global.env()) arg_t + in MTBfunsig(arg_id,arg_t,mte)) + arg_entries mtb + in None, Some sub_mtb in - let mp = Global.start_module id arg_entries res_entry_o in - let mbids = List.map fst arg_entries in openmod_info:=(mbids,res_entry_o,sub_body_o); let prefix = Lib.start_module export id mp fs in @@ -496,8 +497,8 @@ let start_module interp_modtype export id args res_o = let end_module id = let oldoname,oldprefix,fs,lib_stack = Lib.end_module id in - let mp = Global.end_module id in let mbids, res_o, sub_o = !openmod_info in + let mp = Global.end_module id res_o in begin match sub_o with None -> () @@ -584,7 +585,7 @@ let register_library dir cenv objs digest = let msid,substitute,keep = objs in let substobjs = empty_subst, [], msid, substitute in let substituted = subst_substobjs dir mp substobjs in - let objects = option_app (fun seg -> seg@keep) substituted in + let objects = option_map (fun seg -> seg@keep) substituted in let modobjs = substobjs, objects in Hashtbl.add library_cache dir modobjs; modobjs @@ -644,13 +645,9 @@ let import_module export mp = let start_modtype interp_modtype id args = let fs = Summary.freeze_summaries () in - let env = Global.env () in - let env,arg_entries_revlist = - List.fold_left (intern_args interp_modtype) (env,[]) args - in - let arg_entries = List.concat (List.rev arg_entries_revlist) in - let mp = Global.start_modtype id arg_entries in + let mp = Global.start_modtype id in + let arg_entries = List.concat (List.map (intern_args interp_modtype) args) in let mbids = List.map fst arg_entries in openmodtype_info := mbids; @@ -685,12 +682,11 @@ let end_modtype id = let declare_modtype interp_modtype id args mty = let fs = Summary.freeze_summaries () in - let env = Global.env () in - let env,arg_entries_revlist = - List.fold_left (intern_args interp_modtype) (env,[]) args - in - let arg_entries = List.concat (List.rev arg_entries_revlist) in - let base_mty = interp_modtype env mty in + + let _ = Global.start_modtype id in + let arg_entries = List.concat (List.map (intern_args interp_modtype) args) in + + let base_mty = interp_modtype (Global.env()) mty in let entry = List.fold_right (fun (arg_id,arg_t) mte -> MTEfunsig(arg_id,arg_t,mte)) @@ -730,27 +726,25 @@ let rec get_module_substobjs env = function let declare_module interp_modtype interp_modexpr id args mty_o mexpr_o = - let fs = Summary.freeze_summaries () in - let env = Global.env () in - let env,arg_entries_revlist = - List.fold_left (intern_args interp_modtype) (env,[]) args - in - let arg_entries = List.concat (List.rev arg_entries_revlist) in + + let _ = Global.start_module id in + let arg_entries = List.concat (List.map (intern_args interp_modtype) args) in + let mty_entry_o, mty_sub_o = match mty_o with None -> None, None | (Some (mty, true)) -> Some (List.fold_right (fun (arg_id,arg_t) mte -> MTEfunsig(arg_id,arg_t,mte)) arg_entries - (interp_modtype env mty)), + (interp_modtype (Global.env()) mty)), None | (Some (mty, false)) -> None, Some (List.fold_right (fun (arg_id,arg_t) mte -> MTEfunsig(arg_id,arg_t,mte)) arg_entries - (interp_modtype env mty)) + (interp_modtype (Global.env()) mty)) in let mexpr_entry_o = match mexpr_o with None -> None @@ -758,12 +752,13 @@ let declare_module interp_modtype interp_modexpr id args mty_o mexpr_o = Some (List.fold_right (fun (mbid,mte) me -> MEfunctor(mbid,mte,me)) arg_entries - (interp_modexpr env mexpr)) + (interp_modexpr (Global.env()) mexpr)) in let entry = {mod_entry_type = mty_entry_o; mod_entry_expr = mexpr_entry_o } in + let env = Global.env() in let substobjs = match entry with | {mod_entry_type = Some mte} -> get_modtype_substobjs mte diff --git a/library/global.ml b/library/global.ml index b4d3a7ff..863d26b7 100644 --- a/library/global.ml +++ b/library/global.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: global.ml 7639 2005-12-02 10:01:15Z gregoire $ *) +(* $Id: global.ml 8723 2006-04-16 15:51:02Z herbelin $ *) open Util open Names @@ -73,22 +73,27 @@ let add_constraints c = global_env := add_constraints c !global_env let set_engagement c = global_env := set_engagement c !global_env -let start_module id params mtyo = +let start_module id = let l = label_of_id id in - let mp,newenv = start_module l params mtyo !global_env in + let mp,newenv = start_module l !global_env in global_env := newenv; mp - -let end_module id = + +let end_module id mtyo = let l = label_of_id id in - let mp,newenv = end_module l !global_env in + let mp,newenv = end_module l mtyo !global_env in global_env := newenv; mp -let start_modtype id params = +let add_module_parameter mbid mte = + let newenv = add_module_parameter mbid mte !global_env in + global_env := newenv + + +let start_modtype id = let l = label_of_id id in - let mp,newenv = start_modtype l params !global_env in + let mp,newenv = start_modtype l !global_env in global_env := newenv; mp diff --git a/library/global.mli b/library/global.mli index 278b9e65..96965465 100644 --- a/library/global.mli +++ b/library/global.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: global.mli 7899 2006-01-20 16:35:03Z barras $ i*) +(*i $Id: global.mli 8723 2006-04-16 15:51:02Z herbelin $ i*) (*i*) open Names @@ -63,20 +63,13 @@ val set_engagement : engagement -> unit (* [start_*] functions return the [module_path] valid for components of the started module / module type *) -val start_module : - identifier -> (mod_bound_id * module_type_entry) list - -> module_type_entry option - -> module_path +val start_module : identifier -> module_path +val end_module : identifier -> module_type_entry option -> module_path -val end_module : - identifier -> module_path +val add_module_parameter : mod_bound_id -> module_type_entry -> unit -val start_modtype : - identifier -> (mod_bound_id * module_type_entry) list - -> module_path - -val end_modtype : - identifier -> kernel_name +val start_modtype : identifier -> module_path +val end_modtype : identifier -> kernel_name (* Queries *) diff --git a/library/impargs.ml b/library/impargs.ml index 08ae2aa5..68fc046c 100644 --- a/library/impargs.ml +++ b/library/impargs.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: impargs.ml 8672 2006-03-29 21:06:33Z herbelin $ *) +(* $Id: impargs.ml 8845 2006-05-23 07:41:58Z herbelin $ *) open Util open Names @@ -282,14 +282,15 @@ let compute_mib_implicits kn = let ar = Array.to_list (Array.map (* No need to lift, arities contain no de Bruijn *) - (fun mip -> (Name mip.mind_typename, None, mip.mind_user_arity)) + (fun mip -> (Name mip.mind_typename, None, type_of_inductive (mib,mip))) mib.mind_packets) in let env_ar = push_rel_context ar env in let imps_one_inductive i mip = let ind = (kn,i) in - ((IndRef ind,auto_implicits env (body_of_type mip.mind_user_arity)), + let ar = type_of_inductive (mib,mip) in + ((IndRef ind,auto_implicits env ar), Array.mapi (fun j c -> (ConstructRef (ind,j+1),auto_implicits env_ar c)) - mip.mind_user_lc) + mip.mind_nf_lc) in Array.mapi imps_one_inductive mib.mind_packets diff --git a/library/lib.ml b/library/lib.ml index ee553cad..ba6b9c79 100644 --- a/library/lib.ml +++ b/library/lib.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: lib.ml 7710 2005-12-23 10:16:42Z herbelin $ *) +(* $Id: lib.ml 8852 2006-05-23 17:52:43Z notin $ *) open Pp open Util @@ -460,7 +460,7 @@ let open_section id = let discharge_item = function | ((sp,_ as oname),Leaf lobj) -> - option_app (fun o -> (basename sp,o)) (discharge_object (oname,lobj)) + option_map (fun o -> (basename sp,o)) (discharge_object (oname,lobj)) | _ -> None @@ -624,12 +624,30 @@ let reset_initial () = (* Misc *) +let mp_of_global ref = + match ref with + | VarRef id -> fst (current_prefix ()) + | ConstRef cst -> con_modpath cst + | IndRef ind -> ind_modpath ind + | ConstructRef constr -> constr_modpath constr + +let rec dp_of_mp modp = + match modp with + | MPfile dp -> dp + | MPbound _ | MPself _ -> library_dp () + | MPdot (mp,_) -> dp_of_mp mp + let library_part ref = + match ref with + | VarRef id -> library_dp () + | _ -> dp_of_mp (mp_of_global ref) + +let remove_section_part ref = let sp = Nametab.sp_of_global ref in let dir,_ = repr_path sp in match ref with | VarRef id -> - anomaly "library_part not supported on local variables" + anomaly "remove_section_part not supported on local variables" | _ -> if is_dirpath_prefix_of dir (cwd ()) then (* Not yet (fully) discharged *) diff --git a/library/lib.mli b/library/lib.mli index 22b6b6d8..e33c3aca 100644 --- a/library/lib.mli +++ b/library/lib.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: lib.mli 6758 2005-02-20 18:13:28Z herbelin $ i*) +(*i $Id: lib.mli 8852 2006-05-23 17:52:43Z notin $ i*) (*i*) open Util @@ -122,7 +122,8 @@ val end_compilation : dir_path -> object_prefix * library_segment val library_dp : unit -> dir_path (* Extract the library part of a name even if in a section *) -val library_part : global_reference -> dir_path +val library_part : global_reference -> dir_path +val remove_section_part : global_reference -> dir_path (*s Sections *) diff --git a/library/libnames.ml b/library/libnames.ml index 536a382d..48a7565e 100644 --- a/library/libnames.ml +++ b/library/libnames.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: libnames.ml 7052 2005-05-20 15:54:50Z herbelin $ i*) +(*i $Id: libnames.ml 8768 2006-04-28 14:25:31Z notin $ i*) open Pp open Util @@ -78,6 +78,14 @@ let dirpath_prefix p = match repr_dirpath p with let is_dirpath_prefix_of d1 d2 = list_prefix_of (List.rev (repr_dirpath d1)) (List.rev (repr_dirpath d2)) +let chop_dirpath n d = + let d1,d2 = list_chop n (List.rev (repr_dirpath d)) in + make_dirpath (List.rev d1), make_dirpath (List.rev d2) + +let drop_dirpath_prefix d1 d2 = + let d = Util.list_drop_prefix (List.rev (repr_dirpath d1)) (List.rev (repr_dirpath d2)) in + make_dirpath (List.rev d) + (* To know how qualified a name should be to be understood in the current env*) let add_dirpath_prefix id d = make_dirpath (repr_dirpath d @ [id]) diff --git a/library/libnames.mli b/library/libnames.mli index 06595e81..ab2185a6 100644 --- a/library/libnames.mli +++ b/library/libnames.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: libnames.mli 7052 2005-05-20 15:54:50Z herbelin $ i*) +(*i $Id: libnames.mli 8768 2006-04-28 14:25:31Z notin $ i*) (*i*) open Pp @@ -53,6 +53,8 @@ val split_dirpath : dir_path -> dir_path * identifier val extend_dirpath : dir_path -> module_ident -> dir_path val add_dirpath_prefix : module_ident -> dir_path -> dir_path +val chop_dirpath : int -> dir_path -> dir_path * dir_path +val drop_dirpath_prefix : dir_path -> dir_path -> dir_path val extract_dirpath_prefix : int -> dir_path -> dir_path val is_dirpath_prefix_of : dir_path -> dir_path -> bool diff --git a/library/libobject.ml b/library/libobject.ml index 708c19b1..7f383a3b 100644 --- a/library/libobject.ml +++ b/library/libobject.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: libobject.ml 6748 2005-02-18 22:17:50Z herbelin $ *) +(* $Id: libobject.ml 8752 2006-04-27 19:37:33Z herbelin $ *) open Util open Names @@ -109,12 +109,12 @@ let declare_object odecl = anomaly "somehow we got the wrong dynamic object in the classifyfun" and discharge (oname,lobj) = if Dyn.tag lobj = na then - option_app infun (odecl.discharge_function (oname,outfun lobj)) + option_map infun (odecl.discharge_function (oname,outfun lobj)) else anomaly "somehow we got the wrong dynamic object in the dischargefun" and exporter lobj = if Dyn.tag lobj = na then - option_app infun (odecl.export_function (outfun lobj)) + option_map infun (odecl.export_function (outfun lobj)) else anomaly "somehow we got the wrong dynamic object in the exportfun" diff --git a/library/library.ml b/library/library.ml index 760b6f07..cfd88ca0 100644 --- a/library/library.ml +++ b/library/library.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: library.ml 7732 2005-12-26 13:51:24Z herbelin $ *) +(* $Id: library.ml 8877 2006-05-30 16:37:04Z notin $ *) open Pp open Util @@ -57,7 +57,6 @@ let canonical_path_name p = (* We give up to find a canonical name and just simplify it... *) strip_path p - let find_logical_path phys_dir = let phys_dir = canonical_path_name phys_dir in match list_filter2 (fun p d -> p = phys_dir) !load_paths with @@ -65,38 +64,44 @@ let find_logical_path phys_dir = | _,[] -> Nameops.default_root_prefix | _,l -> anomaly ("Two logical paths are associated to "^phys_dir) +let is_in_load_paths phys_dir = + let dir = canonical_path_name phys_dir in + let lp = get_load_paths () in + let check_p = fun p -> (String.compare dir p) == 0 in + List.exists check_p lp + let remove_load_path dir = load_paths := list_filter2 (fun p d -> p <> dir) !load_paths let add_load_path (phys_path,coq_path) = let phys_path = canonical_path_name phys_path in - match list_filter2 (fun p d -> p = phys_path) !load_paths with - | _,[dir] -> - if coq_path <> dir - (* If this is not the default -I . to coqtop *) - && not - (phys_path = canonical_path_name Filename.current_dir_name - && coq_path = Nameops.default_root_prefix) - then - begin - (* Assume the user is concerned by library naming *) - if dir <> Nameops.default_root_prefix then - (Options.if_verbose warning (phys_path^" was previously bound to " - ^(string_of_dirpath dir) - ^("\nIt is remapped to "^(string_of_dirpath coq_path))); - flush_all ()); - remove_load_path phys_path; - load_paths := (phys_path::fst !load_paths, coq_path::snd !load_paths) - end - | _,[] -> - load_paths := (phys_path :: fst !load_paths, coq_path :: snd !load_paths) - | _ -> anomaly ("Two logical paths are associated to "^phys_path) + match list_filter2 (fun p d -> p = phys_path) !load_paths with + | _,[dir] -> + if coq_path <> dir + (* If this is not the default -I . to coqtop *) + && not + (phys_path = canonical_path_name Filename.current_dir_name + && coq_path = Nameops.default_root_prefix) + then + begin + (* Assume the user is concerned by library naming *) + if dir <> Nameops.default_root_prefix then + (Options.if_verbose warning (phys_path^" was previously bound to " + ^(string_of_dirpath dir) + ^("\nIt is remapped to "^(string_of_dirpath coq_path))); + flush_all ()); + remove_load_path phys_path; + load_paths := (phys_path::fst !load_paths, coq_path::snd !load_paths) + end + | _,[] -> + load_paths := (phys_path :: fst !load_paths, coq_path :: snd !load_paths) + | _ -> anomaly ("Two logical paths are associated to "^phys_path) let physical_paths (dp,lp) = dp let load_paths_of_dir_path dir = fst (list_filter2 (fun p d -> d = dir) !load_paths) - + let get_full_load_paths () = List.combine (fst !load_paths) (snd !load_paths) (************************************************************************) diff --git a/library/library.mli b/library/library.mli index f7620682..27ace544 100644 --- a/library/library.mli +++ b/library/library.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: library.mli 6748 2005-02-18 22:17:50Z herbelin $ i*) +(*i $Id: library.mli 8877 2006-05-30 16:37:04Z notin $ i*) (*i*) open Util @@ -64,6 +64,7 @@ val get_full_load_paths : unit -> (System.physical_path * dir_path) list val add_load_path : System.physical_path * dir_path -> unit val remove_load_path : System.physical_path -> unit val find_logical_path : System.physical_path -> dir_path +val is_in_load_paths : System.physical_path -> bool val load_paths_of_dir_path : dir_path -> System.physical_path list (*s Locate a library in the load paths *) diff --git a/library/nameops.ml b/library/nameops.ml index 6db5f75d..1c6a7d56 100644 --- a/library/nameops.ml +++ b/library/nameops.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: nameops.ml 6205 2004-10-12 10:13:15Z herbelin $ *) +(* $Id: nameops.ml 8727 2006-04-24 09:48:06Z herbelin $ *) open Pp open Util @@ -138,7 +138,7 @@ let next_ident_away_from id avoid = let out_name = function | Name id -> id - | Anonymous -> anomaly "out_name: expects a defined name" + | Anonymous -> failwith "out_name: expects a defined name" let name_fold f na a = match na with diff --git a/man/coqdoc.1 b/man/coqdoc.1 index 4a2fddee..c443e8b0 100644 --- a/man/coqdoc.1 +++ b/man/coqdoc.1 @@ -1,4 +1,4 @@ -.TH coqdoc 1 "December, 2005" +.TH coqdoc 1 "April, 2006" .SH NAME coqdoc \- A documentation tool for the Coq proof assistant @@ -43,6 +43,9 @@ Select a PostScript output. .B \-\-texmacs Select a TeXmacs output. .TP +.B \-\-stdout +Redirect the output to stdout +.TP .BI \-o \ file, \-\-output \ file Redirect the output into the file .I file. @@ -81,7 +84,7 @@ Be quiet. Do not print anything except errors. .B \-h, \ \-\-help Give a short summary of the options and exit. .TP -.BI +.B \-v, \ \-\-version Print the version and exit. @@ -122,6 +125,10 @@ Do not insert links to the Coq standard library. Set base URL for the Coq standard library (default is http://coq.inria.fr/library/). .TP +.BI \-\-coqlib_path \ dir +Set the base path where the Coq files are installed, especially style files coqdoc.sty and coqdoc.css. + +.TP .BI -R \ dir \ coqdir Map physical directory dir to Coq logical directory coqdir (similarly to Coq option -R). @@ -168,7 +175,7 @@ http://www.ctan.org/tex-archive/macros/latex/contrib/supported/unicode/. Give a LATEX input encoding, as an option to LATEX package inputenc. .TP -.BI --charset string +.BI --charset \ string Specify the HTML character set, to be inserted in the HTML header. diff --git a/parsing/argextend.ml4 b/parsing/argextend.ml4 index 650afe17..ec3c2c9c 100644 --- a/parsing/argextend.ml4 +++ b/parsing/argextend.ml4 @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: argextend.ml4 7739 2005-12-26 17:08:16Z herbelin $ *) +(* $Id: argextend.ml4 8926 2006-06-08 20:23:17Z herbelin $ *) open Genarg open Q_util @@ -30,7 +30,6 @@ let rec make_rawwit loc = function | ConstrArgType -> <:expr< Genarg.rawwit_constr >> | ConstrMayEvalArgType -> <:expr< Genarg.rawwit_constr_may_eval >> | QuantHypArgType -> <:expr< Genarg.rawwit_quant_hyp >> - | TacticArgType n -> <:expr< Genarg.rawwit_tactic $mlexpr_of_int n$ >> | RedExprArgType -> <:expr< Genarg.rawwit_red_expr >> | OpenConstrArgType b -> <:expr< Genarg.rawwit_open_constr_gen $mlexpr_of_bool b$ >> | ConstrWithBindingsArgType -> <:expr< Genarg.rawwit_constr_with_bindings >> @@ -56,7 +55,6 @@ let rec make_globwit loc = function | SortArgType -> <:expr< Genarg.globwit_sort >> | ConstrArgType -> <:expr< Genarg.globwit_constr >> | ConstrMayEvalArgType -> <:expr< Genarg.globwit_constr_may_eval >> - | TacticArgType n -> <:expr< Genarg.globwit_tactic $mlexpr_of_int n$ >> | RedExprArgType -> <:expr< Genarg.globwit_red_expr >> | OpenConstrArgType b -> <:expr< Genarg.globwit_open_constr_gen $mlexpr_of_bool b$ >> | ConstrWithBindingsArgType -> <:expr< Genarg.globwit_constr_with_bindings >> @@ -82,7 +80,6 @@ let rec make_wit loc = function | SortArgType -> <:expr< Genarg.wit_sort >> | ConstrArgType -> <:expr< Genarg.wit_constr >> | ConstrMayEvalArgType -> <:expr< Genarg.wit_constr_may_eval >> - | TacticArgType n -> <:expr< Genarg.wit_tactic $mlexpr_of_int n$ >> | RedExprArgType -> <:expr< Genarg.wit_red_expr >> | OpenConstrArgType b -> <:expr< Genarg.wit_open_constr_gen $mlexpr_of_bool b$ >> | ConstrWithBindingsArgType -> <:expr< Genarg.wit_constr_with_bindings >> @@ -193,6 +190,9 @@ let rec interp_entry_name loc s = OptArgType t, <:expr< Gramext.Sopt $g$ >> else let t, se = + if tactic_genarg_level s <> None then + Some (ExtraArgType s), <:expr< Tactic. tactic >> + else match Pcoq.entry_type (Pcoq.get_univ "prim") s with | Some _ as x -> x, <:expr< Prim. $lid:s$ >> | None -> diff --git a/parsing/egrammar.ml b/parsing/egrammar.ml index c723175c..9ec7c532 100644 --- a/parsing/egrammar.ml +++ b/parsing/egrammar.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: egrammar.ml 7762 2005-12-30 10:55:33Z herbelin $ *) +(* $Id: egrammar.ml 8926 2006-06-08 20:23:17Z herbelin $ *) open Pp open Util @@ -160,7 +160,7 @@ type grammar_tactic_production = let make_prod_item = function | TacTerm s -> (Gramext.Stoken (Lexer.terminal s), None) - | TacNonTerm (_,(nont,t), po) -> (nont, option_app (fun p -> (p,t)) po) + | TacNonTerm (_,(nont,t), po) -> (nont, option_map (fun p -> (p,t)) po) (* Tactic grammar extensions *) @@ -210,7 +210,7 @@ let rec interp_entry_name up_level u s = else try let i = find_index "tactic" s in - TacticArgType i, + ExtraArgType s, if i=up_level then Gramext.Sself else if i=up_level-1 then Gramext.Snext else Gramext.Snterml(Pcoq.Gram.Entry.obj Tactic.tactic_expr,string_of_int i) @@ -232,7 +232,7 @@ let make_vprod_item n univ = function | VTerm s -> (Gramext.Stoken (Lexer.terminal s), None) | VNonTerm (loc, nt, po) -> let (etyp, e) = interp_entry_name n univ nt in - e, option_app (fun p -> (p,etyp)) po + e, option_map (fun p -> (p,etyp)) po let get_tactic_entry n = if n = 0 then diff --git a/parsing/g_ascii_syntax.ml b/parsing/g_ascii_syntax.ml index e6324e00..ac54fc63 100644 --- a/parsing/g_ascii_syntax.ml +++ b/parsing/g_ascii_syntax.ml @@ -72,7 +72,7 @@ let make_ascii_string n = if n>=32 && n<=126 then String.make 1 (char_of_int n) else Printf.sprintf "%03d" n -let uninterp_ascii_string r = option_app make_ascii_string (uninterp_ascii r) +let uninterp_ascii_string r = option_map make_ascii_string (uninterp_ascii r) let _ = Notation.declare_string_interpreter "char_scope" diff --git a/parsing/g_constr.ml4 b/parsing/g_constr.ml4 index 9f7f7304..9ee312ff 100644 --- a/parsing/g_constr.ml4 +++ b/parsing/g_constr.ml4 @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: g_constr.ml4 8624 2006-03-13 17:38:17Z msozeau $ *) +(* $Id: g_constr.ml4 8875 2006-05-29 19:59:11Z msozeau $ *) open Pcoq open Constr @@ -28,7 +28,7 @@ let _ = List.iter (fun s -> Lexer.add_token("",s)) constr_kw let mk_cast = function (c,(_,None)) -> c - | (c,(_,Some ty)) -> CCast(join_loc (constr_loc c) (constr_loc ty), c, DEFAULTcast,ty) + | (c,(_,Some ty)) -> CCast(join_loc (constr_loc c) (constr_loc ty), c, CastConv DEFAULTcast, ty) let mk_lam = function ([],c) -> c @@ -59,14 +59,13 @@ let rec mkCLambdaN loc bll c = let rec index_and_rec_order_of_annot loc bl ann = match names_of_local_assums bl,ann with - | [_], (None, r) -> 0, r + | [_], (None, r) -> Some 0, r | lids, (Some x, ro) -> let ids = List.map snd lids in - (try list_index (snd x) ids - 1, ro + (try Some (list_index (snd x) ids - 1), ro with Not_found -> user_err_loc(fst x,"index_of_annot", Pp.str"no such fix variable")) - | _ -> user_err_loc(loc,"index_of_annot", - Pp.str "cannot guess decreasing argument of fix") + | _, (None, r) -> None, r let mk_fixb (id,bl,ann,body,(loc,tyc)) = let n,ro = index_and_rec_order_of_annot (fst id) bl ann in @@ -76,7 +75,7 @@ let mk_fixb (id,bl,ann,body,(loc,tyc)) = (snd id,(n,ro),bl,ty,body) let mk_cofixb (id,bl,ann,body,(loc,tyc)) = - let _ = option_app (fun (aloc,_) -> + let _ = option_map (fun (aloc,_) -> Util.user_err_loc (aloc,"Constr:mk_cofixb", Pp.str"Annotation forbidden in cofix expression")) (fst ann) in @@ -156,8 +155,8 @@ GEXTEND Gram [ "200" RIGHTA [ c = binder_constr -> c ] | "100" RIGHTA - [ c1 = operconstr; ":"; c2 = binder_constr -> CCast(loc,c1,DEFAULTcast,c2) - | c1 = operconstr; ":"; c2 = SELF -> CCast(loc,c1,DEFAULTcast,c2) ] + [ c1 = operconstr; ":"; c2 = binder_constr -> CCast(loc,c1, CastConv DEFAULTcast,c2) + | c1 = operconstr; ":"; c2 = SELF -> CCast(loc,c1,CastConv DEFAULTcast,c2) ] | "99" RIGHTA [ ] | "90" RIGHTA [ c1 = operconstr; "->"; c2 = binder_constr -> CArrow(loc,c1,c2) @@ -321,7 +320,7 @@ GEXTEND Gram | "("; id=name; ":="; c=lconstr; ")" -> LocalRawDef (id,c) | "("; id=name; ":"; t=lconstr; ":="; c=lconstr; ")" -> - LocalRawDef (id,CCast (join_loc (constr_loc t) loc,c,DEFAULTcast,t)) + LocalRawDef (id,CCast (join_loc (constr_loc t) loc,c, CastConv DEFAULTcast,t)) ] ] ; binder: diff --git a/parsing/g_ltac.ml4 b/parsing/g_ltac.ml4 index 6ed22c7e..eaa51810 100644 --- a/parsing/g_ltac.ml4 +++ b/parsing/g_ltac.ml4 @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: g_ltac.ml4 8129 2006-03-05 09:05:12Z herbelin $ *) +(* $Id: g_ltac.ml4 8878 2006-05-30 16:44:25Z herbelin $ *) open Pp open Util @@ -23,7 +23,7 @@ type let_clause_kind = | LETCLAUSE of (Names.identifier Util.located * raw_tactic_expr option * raw_tactic_arg) -let fail_default_value = Genarg.ArgArg 0 +let fail_default_value = ArgArg 0 let out_letin_clause loc = function | LETTOPCLAUSE _ -> user_err_loc (loc, "", (str "Syntax Error")) diff --git a/parsing/g_proofs.ml4 b/parsing/g_proofs.ml4 index 886b33e2..94205fa8 100644 --- a/parsing/g_proofs.ml4 +++ b/parsing/g_proofs.ml4 @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: g_proofs.ml4 7936 2006-01-28 18:36:54Z herbelin $ *) +(* $Id: g_proofs.ml4 8875 2006-05-29 19:59:11Z msozeau $ *) open Pcoq open Pp @@ -117,6 +117,6 @@ GEXTEND Gram ; constr_body: [ [ ":="; c = lconstr -> c - | ":"; t = lconstr; ":="; c = lconstr -> CCast(loc,c,Term.DEFAULTcast,t) ] ] + | ":"; t = lconstr; ":="; c = lconstr -> CCast(loc,c, Rawterm.CastConv Term.DEFAULTcast,t) ] ] ; END diff --git a/parsing/g_tactic.ml4 b/parsing/g_tactic.ml4 index 1974d8bc..cba2e7d0 100644 --- a/parsing/g_tactic.ml4 +++ b/parsing/g_tactic.ml4 @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: g_tactic.ml4 8651 2006-03-21 21:54:43Z jforest $ *) +(* $Id: g_tactic.ml4 8878 2006-05-30 16:44:25Z herbelin $ *) open Pp open Pcoq @@ -102,7 +102,7 @@ let mk_fix_tac (loc,id,bl,ann,ty) = (id,n,CProdN(loc,bl,ty)) let mk_cofix_tac (loc,id,bl,ann,ty) = - let _ = option_app (fun (aloc,_) -> + let _ = option_map (fun (aloc,_) -> Util.user_err_loc (aloc,"Constr:mk_cofix_tac", Pp.str"Annotation forbidden in cofix expression")) ann in @@ -121,8 +121,8 @@ GEXTEND Gram simple_intropattern; int_or_var: - [ [ n = integer -> Genarg.ArgArg n - | id = identref -> Genarg.ArgVar id ] ] + [ [ n = integer -> Rawterm.ArgArg n + | id = identref -> Rawterm.ArgVar id ] ] ; (* An identifier or a quotation meta-variable *) id_or_meta: @@ -155,11 +155,11 @@ GEXTEND Gram conversion: [ [ c = constr -> (None, c) | c1 = constr; "with"; c2 = constr -> (Some ([],c1), c2) - | c1 = constr; "at"; nl = LIST1 integer; "with"; c2 = constr -> + | c1 = constr; "at"; nl = LIST1 int_or_var; "with"; c2 = constr -> (Some (nl,c1), c2) ] ] ; occurrences: - [ [ "at"; nl = LIST1 integer -> nl + [ [ "at"; nl = LIST1 int_or_var -> nl | -> [] ] ] ; pattern_occ: @@ -240,7 +240,7 @@ GEXTEND Gram ] ] ; hypident_occ: - [ [ (id,l)=hypident; occs=occurrences -> (id,occs,l) ] ] + [ [ (id,l)=hypident; occs=occurrences -> ((occs,id),l) ] ] ; clause: [ [ "in"; "*"; occs=occurrences -> @@ -261,6 +261,11 @@ GEXTEND Gram [ [ "in"; idl = LIST1 id_or_meta -> idl | -> [] ] ] ; + orient: + [ [ "->" -> true + | "<-" -> false + | -> true ]] + ; fixdecl: [ [ "("; id = ident; bl=LIST0 Constr.binder; ann=fixannot; ":"; ty=lconstr; ")" -> (loc,id,bl,ann,ty) ] ] @@ -285,7 +290,8 @@ GEXTEND Gram [ [ "as"; ipat = simple_intropattern -> ipat | -> IntroAnonymous ] ] ; by_tactic: - [ [ IDENT "by"; tac = tactic -> TacComplete tac | -> TacId [] ] ] + [ [ IDENT "by"; tac = tactic_expr LEVEL "3" -> TacComplete tac + | -> TacId [] ] ] ; simple_tactic: [ [ @@ -411,6 +417,8 @@ GEXTEND Gram | IDENT "transitivity"; c = constr -> TacTransitivity c (* Equality and inversion *) + | IDENT "rewrite"; b = orient; c = constr_with_bindings ; cl = clause -> + TacRewrite (b,c,cl) | IDENT "dependent"; k = [ IDENT "simple"; IDENT "inversion" -> SimpleInversion | IDENT "inversion" -> FullInversion diff --git a/parsing/g_vernac.ml4 b/parsing/g_vernac.ml4 index 18a424a8..7405ae54 100644 --- a/parsing/g_vernac.ml4 +++ b/parsing/g_vernac.ml4 @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: g_vernac.ml4 8624 2006-03-13 17:38:17Z msozeau $ *) +(* $Id: g_vernac.ml4 8929 2006-06-08 22:35:58Z herbelin $ *) (*i camlp4deps: "parsing/grammar.cma" i*) open Pp @@ -218,16 +218,15 @@ GEXTEND Gram let ni = match fst annot with Some id -> - (try list_index (Name id) names - 1 - with Not_found -> Util.user_err_loc - (loc,"Fixpoint", - Pp.str "No argument named " ++ Nameops.pr_id id)) + (try Some (list_index (Name id) names - 1) + with Not_found -> Util.user_err_loc + (loc,"Fixpoint", + Pp.str "No argument named " ++ Nameops.pr_id id)) | None -> - if List.length names > 1 then - Util.user_err_loc - (loc,"Fixpoint", - Pp.str "the recursive argument needs to be specified"); - 0 in + (* If there is only one argument, it is the recursive one, + otherwise, we search the recursive index later *) + if List.length names = 1 then Some 0 else None + in ((id, (ni, snd annot), bl, type_, def),ntn) ] ] ; corec_definition: @@ -320,8 +319,8 @@ GEXTEND Gram VernacDeclareModuleType (id, bl, mty_o) | IDENT "Declare"; IDENT "Module"; export = export_token; id = identref; - bl = LIST0 module_binder; mty_o = of_module_type -> - VernacDeclareModule (export, id, bl, mty_o) + bl = LIST0 module_binder; ":"; mty = module_type -> + VernacDeclareModule (export, id, bl, (mty,true)) (* Section beginning *) | IDENT "Section"; id = identref -> VernacBeginSection id | IDENT "Chapter"; id = identref -> VernacBeginSection id @@ -430,7 +429,7 @@ GEXTEND Gram (* Implicit *) | IDENT "Implicit"; IDENT "Arguments"; qid = global; pos = OPT [ "["; l = LIST0 ident; "]" -> l ] -> - let pos = option_app (List.map (fun id -> ExplByName id)) pos in + let pos = option_map (List.map (fun id -> ExplByName id)) pos in VernacDeclareImplicits (qid,pos) | IDENT "Implicit"; ["Type" | IDENT "Types"]; diff --git a/parsing/g_xml.ml4 b/parsing/g_xml.ml4 index b4580750..5ad0193b 100644 --- a/parsing/g_xml.ml4 +++ b/parsing/g_xml.ml4 @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: g_xml.ml4 8624 2006-03-13 17:38:17Z msozeau $ *) +(* $Id: g_xml.ml4 8875 2006-05-29 19:59:11Z msozeau $ *) open Pp open Util @@ -19,6 +19,7 @@ open Tacexpr open Libnames open Nametab +open Detyping (* Generic xml parser without raw data *) @@ -83,7 +84,7 @@ let global_of_cdata (loc,a) = Nametab.locate (uri_of_data a) let inductive_of_cdata a = match global_of_cdata a with | IndRef (kn,_) -> kn - | _ -> failwith "kn" + | _ -> anomaly "XML parser: not an inductive" let ltacref_of_cdata (loc,a) = (loc,locate_tactic (uri_of_data a)) @@ -95,7 +96,9 @@ let sort_of_cdata (loc,a) = match a with let get_xml_sort al = sort_of_cdata (get_xml_attr "value" al) -let get_xml_inductive_kn al = inductive_of_cdata (get_xml_attr "uri" al) +let get_xml_inductive_kn al = + inductive_of_cdata (* uriType apparent synonym of uri *) + (try get_xml_attr "uri" al with _ -> get_xml_attr "uriType" al) let get_xml_constant al = constant_of_cdata (get_xml_attr "uri" al) @@ -105,43 +108,66 @@ let get_xml_inductive al = let get_xml_constructor al = (get_xml_inductive al, nmtoken (get_xml_attr "noConstr" al)) -let get_xml_name al = +let get_xml_binder al = try Name (ident_of_cdata (List.assoc "binder" al)) with Not_found -> Anonymous let get_xml_ident al = ident_of_cdata (get_xml_attr "binder" al) +let get_xml_name al = ident_of_cdata (get_xml_attr "name" al) + let get_xml_noFun al = nmtoken (get_xml_attr "noFun" al) +let get_xml_no al = nmtoken (get_xml_attr "no" al) + +(* A leak in the xml dtd: arities of constructor need to know global env *) + +let compute_branches_lengths ind = + let (_,mip) = Inductive.lookup_mind_specif (Global.env()) ind in + mip.Declarations.mind_consnrealdecls + +let compute_inductive_nargs ind = + Inductiveops.inductive_nargs (Global.env()) ind + (* Interpreting constr as a rawconstr *) let rec interp_xml_constr = function | XmlTag (loc,"REL",al,[]) -> RVar (loc, get_xml_ident al) - | XmlTag (loc,"VAR",al,[]) -> failwith "" - | XmlTag (loc,"LAMBDA",al,[x1;x2]) -> - let na,t = interp_xml_decl x1 in - RLambda (loc, na, t, interp_xml_target x2) - | XmlTag (loc,"PROD",al,[x1;x2]) -> - let na,t = interp_xml_decl x1 in - RProd (loc, na, t, interp_xml_target x2) + | XmlTag (loc,"VAR",al,[]) -> + error "XML parser: unable to interp free variables" + | XmlTag (loc,"LAMBDA",al,(_::_ as xl)) -> + let body,decls = list_sep_last xl in + let ctx = List.map interp_xml_decl decls in + List.fold_right (fun (na,t) b -> RLambda (loc, na, t, b)) + ctx (interp_xml_target body) + | XmlTag (loc,"PROD",al,(_::_ as xl)) -> + let body,decls = list_sep_last xl in + let ctx = List.map interp_xml_decl decls in + List.fold_right (fun (na,t) b -> RProd (loc, na, t, b)) + ctx (interp_xml_target body) | XmlTag (loc,"LETIN",al,[x1;x2]) -> let na,t = interp_xml_def x1 in RLetIn (loc, na, t, interp_xml_target x2) | XmlTag (loc,"APPLY",_,x::xl) -> RApp (loc, interp_xml_constr x, List.map interp_xml_constr xl) + | XmlTag (loc,"instantiate",_, + (XmlTag (_,("CONST"|"MUTIND"|"MUTCONSTRUCT"),_,_) as x)::xl) -> + RApp (loc, interp_xml_constr x, List.map interp_xml_arg xl) | XmlTag (loc,"META",al,xl) -> - failwith "META: TODO" + REvar (loc, get_xml_no al, Some (List.map interp_xml_substitution xl)) | XmlTag (loc,"CONST",al,[]) -> RRef (loc, ConstRef (get_xml_constant al)) - | XmlTag (loc,"MUTCASE",al,x::y::yl) -> (* BUGGE *) - failwith "XML MUTCASE TO DO"; -(* - ROrderedCase (loc,RegularStyle,Some (interp_xml_patternsType x), - interp_xml_inductiveTerm y, - Array.of_list (List.map interp_xml_pattern yl), - ref None) -*) + | XmlTag (loc,"MUTCASE",al,x::y::yl) -> + let ind = get_xml_inductive al in + let p = interp_xml_patternsType x in + let tm = interp_xml_inductiveTerm y in + let brs = List.map interp_xml_pattern yl in + let brns = Array.to_list (compute_branches_lengths ind) in + let mat = simple_cases_matrix_of_branches ind brns brs in + let nparams,n = compute_inductive_nargs ind in + let nal,rtn = return_type_of_predicate ind nparams n p in + RCases (loc,rtn,[tm,nal],mat) | XmlTag (loc,"MUTIND",al,[]) -> RRef (loc, IndRef (get_xml_inductive al)) | XmlTag (loc,"MUTCONSTRUCT",al,[]) -> @@ -149,12 +175,13 @@ let rec interp_xml_constr = function | XmlTag (loc,"FIX",al,xl) -> let li,lnct = List.split (List.map interp_xml_FixFunction xl) in let ln,lc,lt = list_split3 lnct in - RRec (loc, RFix (Array.of_list li, get_xml_noFun al), Array.of_list ln, [||], Array.of_list lc, Array.of_list lt) + let lctx = List.map (fun _ -> []) ln in + RRec (loc, RFix (Array.of_list li, get_xml_noFun al), Array.of_list ln, Array.of_list lctx, Array.of_list lc, Array.of_list lt) | XmlTag (loc,"COFIX",al,xl) -> let ln,lc,lt = list_split3 (List.map interp_xml_CoFixFunction xl) in RRec (loc, RCoFix (get_xml_noFun al), Array.of_list ln, [||], Array.of_list lc, Array.of_list lt) | XmlTag (loc,"CAST",al,[x1;x2]) -> - RCast (loc, interp_xml_term x1, DEFAULTcast, interp_xml_type x2) + RCast (loc, interp_xml_term x1, CastConv DEFAULTcast, interp_xml_type x2) | XmlTag (loc,"SORT",al,[]) -> RSort (loc, get_xml_sort al) | XmlTag (loc,s,_,_) -> user_err_loc (loc,"", str "Unexpected tag " ++ str s) @@ -177,10 +204,13 @@ and interp_xml_body x = interp_xml_constr_alias "body" x and interp_xml_pattern x = interp_xml_constr_alias "pattern" x and interp_xml_patternsType x = interp_xml_constr_alias "patternsType" x and interp_xml_inductiveTerm x = interp_xml_constr_alias "inductiveTerm" x +and interp_xml_arg x = interp_xml_constr_alias "arg" x +and interp_xml_substitution x = interp_xml_constr_alias "substitution" x + (* no support for empty substitution from official dtd *) and interp_xml_decl_alias s x = match interp_xml_tag s x with - | (_,al,[x]) -> (get_xml_name al, interp_xml_constr x) + | (_,al,[x]) -> (get_xml_binder al, interp_xml_constr x) | (loc,_,_) -> user_err_loc (loc,"",str "wrong number of arguments (expect one)") @@ -201,23 +231,22 @@ and interp_xml_recursionOrder x = | _ -> user_err_loc (locs,"",str "invalid recursion order") - and interp_xml_FixFunction x = match interp_xml_tag "FixFunction" x with - | (loc,al,[x1;x2;x3]) -> - ((nmtoken (get_xml_attr "recIndex" al), + | (loc,al,[x1;x2;x3]) -> (* Not in official cic.dtd, not in constr *) + ((Some (nmtoken (get_xml_attr "recIndex" al)), interp_xml_recursionOrder x1), - (get_xml_ident al, interp_xml_type x2, interp_xml_body x3)) - | (loc,al,[x1;x2]) -> (* For backwards compatibility *) - ((nmtoken (get_xml_attr "recIndex" al), RStructRec), - (get_xml_ident al, interp_xml_type x1, interp_xml_body x2)) + (get_xml_name al, interp_xml_type x2, interp_xml_body x3)) + | (loc,al,[x1;x2]) -> + ((Some (nmtoken (get_xml_attr "recIndex" al)), RStructRec), + (get_xml_name al, interp_xml_type x1, interp_xml_body x2)) | (loc,_,_) -> user_err_loc (loc,"",str "wrong number of arguments (expect one)") and interp_xml_CoFixFunction x = match interp_xml_tag "CoFixFunction" x with | (loc,al,[x1;x2]) -> - (get_xml_ident al, interp_xml_type x1, interp_xml_body x2) + (get_xml_name al, interp_xml_type x1, interp_xml_body x2) | (loc,_,_) -> user_err_loc (loc,"",str "wrong number of arguments (expect one)") diff --git a/parsing/lexer.ml4 b/parsing/lexer.ml4 index 6119b86e..c02dc59b 100644 --- a/parsing/lexer.ml4 +++ b/parsing/lexer.ml4 @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: lexer.ml4 7870 2006-01-15 20:29:09Z herbelin $ i*) +(*i $Id: lexer.ml4 8924 2006-06-08 17:49:01Z notin $ i*) open Pp open Token @@ -54,7 +54,7 @@ let ttree_find ttree str = in proc_rec ttree 0 -(* Lexer conventions on tokens *) +(* Errors occuring while lexing (explained as "Lexer error: ...") *) type error = | Illegal_character @@ -65,8 +65,163 @@ type error = exception Error of error +let err loc str = Stdpp.raise_with_loc (Util.make_loc loc) (Error str) + let bad_token str = raise (Error (Bad_token str)) +(* Lexer conventions on tokens *) + +type utf8_token = + Utf8Letter of int | Utf8IdentPart of int | Utf8Symbol | AsciiChar + +let error_unsupported_unicode_character n cs = + let bp = Stream.count cs in + err (bp,bp+n) (Bad_token "Unsupported Unicode character") + +let error_utf8 cs = + let bp = Stream.count cs in + err (bp, bp+1) Illegal_character + +let njunk n = Util.repeat n Stream.junk + +let check_utf8_trailing_byte cs c = + if Char.code c land 0xC0 <> 0x80 then error_utf8 cs + +(* Recognize utf8 blocks (of length less than 4 bytes) *) +(* but don't certify full utf8 compliance (e.g. no emptyness check) *) +let lookup_utf8_tail c cs = + let c1 = Char.code c in + if c1 land 0x40 = 0 or c1 land 0x38 = 0x38 then error_utf8 cs + else + let n, unicode = + if c1 land 0x20 = 0 then + match Stream.npeek 2 cs with + | [_;c2] -> + check_utf8_trailing_byte cs c2; + 2, (c1 land 0x1F) lsl 6 + (Char.code c2 land 0x3F) + | _ -> error_utf8 cs + else if c1 land 0x10 = 0 then + match Stream.npeek 3 cs with + | [_;c2;c3] -> + check_utf8_trailing_byte cs c2; check_utf8_trailing_byte cs c3; + 3, (c1 land 0x0F) lsl 12 + (Char.code c2 land 0x3F) lsl 6 + + (Char.code c3 land 0x3F) + | _ -> error_utf8 cs + else match Stream.npeek 4 cs with + | [_;c2;c3;c4] -> + check_utf8_trailing_byte cs c2; check_utf8_trailing_byte cs c3; + check_utf8_trailing_byte cs c4; + 4, (c1 land 0x07) lsl 18 + (Char.code c2 land 0x3F) lsl 12 + + (Char.code c3 land 0x3F) lsl 6 + (Char.code c4 land 0x3F) + | _ -> error_utf8 cs + in + match unicode land 0x1F000 with + | 0x0 -> + begin match unicode with + (* utf-8 Latin-1 non breaking space U00A0 *) + | 0x00A0 -> Utf8Letter n + (* utf-8 Latin-1 symbols U00A1-00BF *) + | x when 0x00A0 <= x & x <= 0x00BF -> Utf8Symbol + (* utf-8 Latin-1 letters U00C0-00D6 *) + | x when 0x00C0 <= x & x <= 0x00D6 -> Utf8Letter n + (* utf-8 Latin-1 symbol U00D7 *) + | 0x00D7 -> Utf8Symbol + (* utf-8 Latin-1 letters U00D8-00F6 *) + | x when 0x00D8 <= x & x <= 0x00F6 -> Utf8Letter n + (* utf-8 Latin-1 symbol U00F7 *) + | 0x00F7 -> Utf8Symbol + (* utf-8 Latin-1 letters U00F8-00FF *) + | x when 0x00F8 <= x & x <= 0x00FF -> Utf8Letter n + (* utf-8 Latin Extended A U0100-017F and Latin Extended B U0180-U0241 *) + | x when 0x0100 <= x & x <= 0x0241 -> Utf8Letter n + (* utf-8 Phonetic letters U0250-02AF *) + | x when 0x0250 <= x & x <= 0x02AF -> Utf8Letter n + (* utf-8 what do to with diacritics U0300-U036F ? *) + (* utf-8 Greek letters U0380-03FF *) + | x when 0x0380 <= x & x <= 0x03FF -> Utf8Letter n + (* utf-8 Cyrillic letters U0400-0481 *) + | x when 0x0400 <= x & x <= 0x0481 -> Utf8Letter n + (* utf-8 Cyrillic symbol U0482 *) + | 0x0482 -> Utf8Symbol + (* utf-8 what do to with diacritics U0483-U0489 \ U0487 ? *) + (* utf-8 Cyrillic letters U048A-U4F9 (Warning: 04CF) *) + | x when 0x048A <= x & x <= 0x04F9 -> Utf8Letter n + (* utf-8 Cyrillic supplements letters U0500-U050F *) + | x when 0x0500 <= x & x <= 0x050F -> Utf8Letter n + (* utf-8 Hebrew letters U05D0-05EA *) + | x when 0x05D0 <= x & x <= 0x05EA -> Utf8Letter n + (* utf-8 Hebrew letters U0621-064A *) + | x when 0x0621 <= x & x <= 0x064A -> Utf8Letter n + | _ -> error_unsupported_unicode_character n cs + end + | 0x1000 -> + begin match unicode with + (* utf-8 Georgian U10A0-10FF (has holes) *) + | x when 0x10A0 <= x & x <= 0x10FF -> Utf8Letter n + (* utf-8 Hangul Jamo U1100-11FF (has holes) *) + | x when 0x1100 <= x & x <= 0x11FF -> Utf8Letter n + (* utf-8 Latin additional letters U1E00-1E9B and U1EA0-1EF9 *) + | x when 0x1E00 <= x & x <= 0x1E9B -> Utf8Letter n + | x when 0x1EA0 <= x & x <= 0x1EF9 -> Utf8Letter n + | _ -> error_unsupported_unicode_character n cs + end + | 0x2000 -> + begin match unicode with + (* utf-8 general punctuation U2080-2089 *) + (* Hyphens *) + | x when 0x2010 <= x & x <= 0x2011 -> Utf8Letter n + (* Dashes and other symbols *) + | x when 0x2012 <= x & x <= 0x2027 -> Utf8Symbol + (* Per mille and per ten thousand signs *) + | x when 0x2030 <= x & x <= 0x2031 -> Utf8Symbol + (* Prime letters *) + | x when 0x2032 <= x & x <= 0x2034 or x = 0x2057 -> Utf8IdentPart n + (* Miscellaneous punctuation *) + | x when 0x2039 <= x & x <= 0x2056 -> Utf8Symbol + | x when 0x2058 <= x & x <= 0x205E -> Utf8Symbol + (* Invisible mathematical operators *) + | x when 0x2061 <= x & x <= 0x2063 -> Utf8Symbol + + (* utf-8 subscript U2080-2089 *) + | x when 0x2080 <= x & x <= 0x2089 -> Utf8IdentPart n + (* utf-8 letter-like U2100-214F *) + | x when 0x2100 <= x & x <= 0x214F -> Utf8Letter n + (* utf-8 number-forms U2153-2183 *) + | x when 0x2153 <= x & x <= 0x2183 -> Utf8Symbol + (* utf-8 arrows A U2190-21FF *) + (* utf-8 mathematical operators U2200-22FF *) + (* utf-8 miscellaneous technical U2300-23FF *) + | x when 0x2190 <= x & x <= 0x23FF -> Utf8Symbol + (* utf-8 box drawing U2500-257F has ceiling, etc. *) + (* utf-8 block elements U2580-259F *) + (* utf-8 geom. shapes U25A0-25FF (has triangles, losange, etc) *) + (* utf-8 miscellaneous symbols U2600-26FF *) + | x when 0x2500 <= x & x <= 0x26FF -> Utf8Symbol + (* utf-8 arrows B U2900-297F *) + | x when 0x2900 <= x & x <= 0x297F -> Utf8Symbol + (* utf-8 mathematical operators U2A00-2AFF *) + | x when 0x2A00 <= x & x <= 0x2AFF -> Utf8Symbol + | _ -> error_unsupported_unicode_character n cs + end + | _ -> + begin match unicode with + (* utf-8 Hiragana U3040-309F and Katakana U30A0-30FF *) + | x when 0x3040 <= x & x <= 0x30FF -> Utf8Letter n + (* utf-8 Unified CJK Ideographs U4E00-9FA5 *) + | x when 0x4E00 <= x & x <= 0x9FA5 -> Utf8Letter n + (* utf-8 Hangul syllables UAC00-D7AF *) + | x when 0xAC00 <= x & x <= 0xD7AF -> Utf8Letter n + (* utf-8 Gothic U10330-1034A *) + | x when 0x10330 <= x & x <= 0x1034A -> Utf8Letter n + | _ -> error_unsupported_unicode_character n cs + end + +let lookup_utf8 cs = + match Stream.peek cs with + | Some ('\x00'..'\x7F') -> Some AsciiChar + | Some ('\x80'..'\xFF' as c) -> Some (lookup_utf8_tail c cs) + | None -> None + let check_special_token str = let rec loop_symb = parser | [< ' (' ' | '\n' | '\r' | '\t' | '"') >] -> bad_token str @@ -76,35 +231,19 @@ let check_special_token str = loop_symb (Stream.of_string str) let check_ident str = - let first_letter = function - (''' | '0'..'9') -> false - | _ -> true in - let rec loop_id = parser - | [< ' ('$' | 'a'..'z' | 'A'..'Z' | '0'..'9' | ''' | '_'); s >] -> - loop_id s - (* utf-8 Greek letters U0380-03FF *) - | [< ' ('\xCE' | '\xCF'); ' ('\x80'..'\xBF'); s >] -> loop_id s - | [< ''\xE2'; 'c2; 'c3; s >] -> - (match c2, c3 with - (* utf-8 letter-like U2100-214F *) - | ( ('\x84', '\x80'..'\xBF') - | ('\x85', '\x80'..'\x8F') - (* utf-8 subscript U2080-2089 *) - | ('\x82', '\x80'..'\x89')) -> - loop_id s - (* utf-8 symbols (see [parse_226_tail]) *) - | (('\x86'..'\x8F' | '\x94'..'\x9B' - | '\xA4'..'\xA5' | '\xA8'..'\xAB'),_) -> - bad_token str - | _ -> - bad_token str) - | [< _ = Stream.empty >] -> () - | [< >] -> bad_token str + let rec loop_id intail = parser + | [< ' ('$' | 'a'..'z' | 'A'..'Z' | '_'); s >] -> + loop_id true s + | [< ' ('0'..'9' | ''') when intail; s >] -> + loop_id true s + | [< s >] -> + match lookup_utf8 s with + | Some (Utf8Letter n) -> njunk n s; loop_id true s + | Some (Utf8IdentPart n) when intail -> njunk n s; loop_id true s + | Some _ -> bad_token str + | None -> () in - if String.length str > 0 && first_letter str.[0] then - loop_id (Stream.of_string str) - else - bad_token str + loop_id false (Stream.of_string str) let check_keyword str = try check_special_token str @@ -145,9 +284,6 @@ let init () = let _ = init() -(* Errors occuring while lexing (explained as "Lexer error: ...") *) -let err loc str = Stdpp.raise_with_loc (Util.make_loc loc) (Error str) - (* The string buffering machinery *) let buff = ref (String.create 80) @@ -158,36 +294,20 @@ let store len x = !buff.[len] <- x; succ len -let mstore len s = - let rec add_rec len i = - if i == String.length s then len else add_rec (store len s.[i]) (succ i) - in - add_rec len 0 +let rec nstore n len cs = + if n>0 then nstore (n-1) (store len (Stream.next cs)) cs else len let get_buff len = String.sub !buff 0 len - (* The classical lexer: idents, numbers, quoted strings, comments *) let rec ident_tail len = parser | [< ' ('a'..'z' | 'A'..'Z' | '0'..'9' | ''' | '_' as c); s >] -> ident_tail (store len c) s - (* utf-8 Greek letters U0380-03FF *) - | [< ' ('\xCE' | '\xCF' as c1); ' ('\x80'..'\xBF' as c2) ; s >] -> - ident_tail (store (store len c1) c2) s | [< s >] -> - match Stream.peek s with - | Some '\xE2' -> - (match List.tl (Stream.npeek 3 s) with - (* utf-8 subscript U2080-2089 *) - | ['\x82' as c2; ('\x80'..'\x89' as c3)] - (* utf-8 letter-like U2100-214F part 1 *) - | ['\x84' as c2; ('\x80'..'\xBF' as c3)] - (* utf-8 letter-like U2100-214F part 2 *) - | ['\x85' as c2; ('\x80'..'\x8F' as c3)] -> - Stream.junk s; Stream.junk s; Stream.junk s; - ident_tail (store (store (store len '\xE2') c2) c3) s - | _ -> len) + match lookup_utf8 s with + | Some (Utf8IdentPart n | Utf8Letter n) -> + ident_tail (nstore n len s) s | _ -> len let rec number len = parser @@ -292,89 +412,61 @@ let rec comment bp = parser bp2 (* Parse a special token, using the [token_tree] *) -let progress_special c = function - | None -> None - | Some tt -> try Some (CharMap.find c tt.branch) with Not_found -> None - -let rec special tt cs = match tt with - | None -> None - | Some tt -> - match - match Stream.peek cs with - | Some c -> - (try Some (CharMap.find c tt.branch) with Not_found -> None) - | None -> None - with - | Some _ as tt' -> Stream.junk cs; special tt' cs - | None -> tt.node - +(* Peek as much utf-8 lexemes as possible *) +(* then look if a special token is obtained *) +let rec special tt cs = + match Stream.peek cs with + | Some c -> progress_from_byte 0 tt cs c + | None -> tt.node + + (* nr is the number of char peeked; n the number of char in utf8 block *) +and progress_utf8 nr n c tt cs = + try + let tt = CharMap.find c tt.branch in + let tt = + if n=1 then tt else + match Stream.npeek (n-nr) cs with + | l when List.length l = n-nr -> + let l = Util.list_skipn (1-nr) l in + List.iter (check_utf8_trailing_byte cs) l; + List.fold_left (fun tt c -> CharMap.find c tt.branch) tt l + | _ -> + error_utf8 cs + in + for i=1 to n-nr do Stream.junk cs done; + special tt cs + with Not_found -> + tt.node + +and progress_from_byte nr tt cs = function + (* Utf8 leading byte *) + | '\x00'..'\x7F' as c -> progress_utf8 nr 1 c tt cs + | '\xC0'..'\xDF' as c -> progress_utf8 nr 2 c tt cs + | '\xE0'..'\xEF' as c -> progress_utf8 nr 3 c tt cs + | '\xF0'..'\xF7' as c -> progress_utf8 nr 4 c tt cs + | _ (* '\x80'..\xBF'|'\xF8'..'\xFF' *) -> + error_utf8 cs + +(* Must be a special token *) let process_chars bp c cs = - let t = - try special (Some (CharMap.find c !token_tree.branch)) cs - with Not_found -> !token_tree.node - in + let t = progress_from_byte 1 !token_tree cs c in let ep = Stream.count cs in match t with | Some t -> (("", t), (bp, ep)) | None -> err (bp, ep) Undefined_token -type token_226_tail = - | TokSymbol of string option - | TokIdent of string - -(* 1110xxxx 10yyyyzz 10zztttt utf-8 codes for xxxx=0010 *) -let parse_226_tail tk = parser - | [< ''\x82' as c2; ' ('\x80'..'\x89' as c3); - (* utf-8 subscript U2080-2089 *) - len = ident_tail (store (store (store 0 '\xE2') c2) c3) >] -> - TokIdent (get_buff len) - | [< ''\x84' as c2; ' ('\x80'..'\xBF' as c3); - (* utf-8 letter-like U2100-214F part 1 *) - len = ident_tail (store (store (store 0 '\xE2') c2) c3) >] -> - TokIdent (get_buff len) - | [< ''\x85' as c2; ' ('\x80'..'\x8F' as c3); - (* utf-8 letter-like U2100-214F part 2 *) - len = ident_tail (store (store (store 0 '\xE2') c2) c3) >] -> - TokIdent (get_buff len) - | [< ' ('\x86'..'\x8F' | '\x94'..'\x9B' | '\xA4'..'\xA5' - | '\xA8'..'\xAB' as c2); 'c3; - (* utf-8 arrows A U2190-21FF *) - (* utf-8 mathematical operators U2200-22FF *) - (* utf-8 miscellaneous technical U2300-23FF *) - (* utf-8 box drawing U2500-257F has ceiling, etc. *) - (* utf-8 block elements U2580-259F *) - (* utf-8 geom. shapes U25A0-25FF (has triangles, losange, etc) *) - (* utf-8 miscellaneous symbols U2600-26FF *) - (* utf-8 arrows B U2900-297F *) - (* utf-8 mathematical operators U2A00-2AFF *) - t = special (progress_special c3 (progress_special c2 - (progress_special '\xE2' tk))) >] -> - TokSymbol t - | [< '_; '_ >] -> - (* Unsupported utf-8 code *) - TokSymbol None - (* Parse what follows a dot *) let parse_after_dot bp c = parser - | [< ' ('a'..'z' | 'A'..'Z' | '_' as c); - len = ident_tail (store 0 c) >] -> - ("FIELD", get_buff len) - (* utf-8 Greek letters U0380-03FF *) - | [< ' ('\xCE' | '\xCF' as c1); ' ('\x80'..'\xBF' as c2); - len = ident_tail (store (store 0 c1) c2) >] -> + | [< ' ('a'..'z' | 'A'..'Z' | '_' as c); len = ident_tail (store 0 c) >] -> ("FIELD", get_buff len) - (* utf-8 mathematical symbols have format E2 xx xx [E2=226] *) - | [< ''\xE2'; t = parse_226_tail - (progress_special '.' (Some !token_tree)) >] ep -> - (match t with - | TokSymbol (Some t) -> ("", t) - | TokSymbol None -> err (bp, ep) Undefined_token - | TokIdent t -> ("FIELD", t)) - | [< (t,_) = process_chars bp c >] -> t - + | [< s >] -> + match lookup_utf8 s with + | Some (Utf8Letter n) -> + ("FIELD", get_buff (ident_tail (nstore n 0 s) s)) + | Some (Utf8IdentPart _ | AsciiChar | Utf8Symbol) | None -> + fst (process_chars bp c s) (* Parse a token in a char stream *) - let rec next_token = parser bp | [< '' ' | '\t' | '\n' |'\r' as c; s >] -> comm_loc bp; push_char c; next_token s @@ -383,27 +475,13 @@ let rec next_token = parser bp (("METAIDENT", get_buff len), (bp,ep)) | [< ''.' as c; t = parse_after_dot bp c >] ep -> comment_stop bp; + if Options.do_translate() & t=("",".") then between_com := true; (t, (bp,ep)) | [< ' ('a'..'z' | 'A'..'Z' | '_' as c); len = ident_tail (store 0 c) >] ep -> let id = get_buff len in comment_stop bp; (try ("", find_keyword id) with Not_found -> ("IDENT", id)), (bp, ep) - (* utf-8 Greek letters U0380-03FF [CE80-CEBF and CF80-CFBF] *) - | [< ' ('\xCE' | '\xCF' as c1); ' ('\x80'..'\xBF' as c2); - len = ident_tail (store (store 0 c1) c2) >] ep -> - let id = get_buff len in - comment_stop bp; - (try ("", find_keyword id) with Not_found -> ("IDENT", id)), (bp, ep) - (* utf-8 mathematical symbols have format E2 xx xx [E2=226] *) - | [< ''\xE2'; t = parse_226_tail (Some !token_tree) >] ep -> - comment_stop bp; - (match t with - | TokSymbol (Some t) -> ("", t), (bp, ep) - | TokSymbol None -> err (bp, ep) Undefined_token - | TokIdent id -> - (try ("", find_keyword id) with Not_found -> ("IDENT", id)), - (bp, ep)) | [< ' ('0'..'9' as c); len = number (store 0 c) >] ep -> comment_stop bp; (("INT", get_buff len), (bp, ep)) @@ -419,8 +497,19 @@ let rec next_token = parser bp next_token s | [< t = process_chars bp c >] -> comment_stop bp; t >] -> t - | [< 'c; t = process_chars bp c >] -> comment_stop bp; t - | [< _ = Stream.empty >] -> comment_stop bp; (("EOI", ""), (bp, bp + 1)) + | [< s >] -> + match lookup_utf8 s with + | Some (Utf8Letter n) -> + let len = ident_tail (nstore n 0 s) s in + let id = get_buff len in + let ep = Stream.count s in + comment_stop bp; + (try ("",find_keyword id) with Not_found -> ("IDENT",id)), (bp, ep) + | Some (Utf8Symbol | AsciiChar | Utf8IdentPart _) -> + let t = process_chars bp (Stream.next s) s in + comment_stop bp; t + | None -> + comment_stop bp; (("EOI", ""), (bp, bp + 1)) (* Location table system for creating tables associating a token count to its location in a char stream (the source) *) @@ -461,10 +550,10 @@ let func cs = Stream.from (fun i -> let (tok, loc) = next_token cs in - loct_add loct i loc; Some tok) + loct_add loct i loc; Some tok) in - current_location_table := loct; - (ts, loct_func loct) + current_location_table := loct; + (ts, loct_func loct) type location_table = (int * int) option array array ref let location_table () = !current_location_table diff --git a/parsing/pcoq.ml4 b/parsing/pcoq.ml4 index d743fffa..127a911f 100644 --- a/parsing/pcoq.ml4 +++ b/parsing/pcoq.ml4 @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: pcoq.ml4 7826 2006-01-09 22:00:34Z herbelin $ i*) +(*i $Id: pcoq.ml4 8926 2006-06-08 20:23:17Z herbelin $ i*) open Pp open Util @@ -286,6 +286,55 @@ let force_entry_type (u, utab) s etyp = with Not_found -> new_entry etyp (u, utab) s +(* Tactics as arguments *) + +let tactic_main_level = 5 + +let (wit_tactic0,globwit_tactic0,rawwit_tactic0) = create_arg "tactic0" +let (wit_tactic1,globwit_tactic1,rawwit_tactic1) = create_arg "tactic1" +let (wit_tactic2,globwit_tactic2,rawwit_tactic2) = create_arg "tactic2" +let (wit_tactic3,globwit_tactic3,rawwit_tactic3) = create_arg "tactic3" +let (wit_tactic4,globwit_tactic4,rawwit_tactic4) = create_arg "tactic4" +let (wit_tactic5,globwit_tactic5,rawwit_tactic5) = create_arg "tactic5" + +let wit_tactic = function + | 0 -> wit_tactic0 + | 1 -> wit_tactic1 + | 2 -> wit_tactic2 + | 3 -> wit_tactic3 + | 4 -> wit_tactic4 + | 5 -> wit_tactic5 + | n -> anomaly ("Unavailable tactic level: "^string_of_int n) + +let globwit_tactic = function + | 0 -> globwit_tactic0 + | 1 -> globwit_tactic1 + | 2 -> globwit_tactic2 + | 3 -> globwit_tactic3 + | 4 -> globwit_tactic4 + | 5 -> globwit_tactic5 + | n -> anomaly ("Unavailable tactic level: "^string_of_int n) + +let rawwit_tactic = function + | 0 -> rawwit_tactic0 + | 1 -> rawwit_tactic1 + | 2 -> rawwit_tactic2 + | 3 -> rawwit_tactic3 + | 4 -> rawwit_tactic4 + | 5 -> rawwit_tactic5 + | n -> anomaly ("Unavailable tactic level: "^string_of_int n) + +let tactic_genarg_level s = + if String.length s = 7 && String.sub s 0 6 = "tactic" then + let c = s.[6] in if '5' >= c && c >= '0' then Some (Char.code c - 48) + else None + else None + +let is_tactic_genarg = function +| ExtraArgType s -> tactic_genarg_level s <> None +| _ -> false + + (* [make_gen_entry] builds entries extensible by giving its name (a string) *) (* For entries extensible only via the ML name, Gram.Entry.create is enough *) @@ -382,7 +431,6 @@ module Tactic = let tactic_arg = Gram.Entry.create "tactic:tactic_arg" let tactic_expr = Gram.Entry.create "tactic:tactic_expr" - let tactic_main_level = 5 let tactic = make_gen_entry utactic (rawwit_tactic tactic_main_level) "tactic" (* Main entry for quotations *) @@ -391,6 +439,7 @@ module Tactic = end + module Vernac_ = struct let gec_vernac s = Gram.Entry.create ("vernac:" ^ s) diff --git a/parsing/pcoq.mli b/parsing/pcoq.mli index fe6fd083..3998d71b 100644 --- a/parsing/pcoq.mli +++ b/parsing/pcoq.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: pcoq.mli 7826 2006-01-09 22:00:34Z herbelin $ i*) +(*i $Id: pcoq.mli 8926 2006-06-08 20:23:17Z herbelin $ i*) open Util open Names @@ -77,10 +77,46 @@ val force_entry_type : val create_constr_entry : string * gram_universe -> string -> constr_expr Gram.Entry.e -val create_generic_entry : string -> ('a, constr_expr,raw_tactic_expr) abstract_argument_type -> 'a Gram.Entry.e +val create_generic_entry : string -> ('a, rlevel,raw_tactic_expr) abstract_argument_type -> 'a Gram.Entry.e val get_generic_entry : string -> grammar_object Gram.Entry.e val get_generic_entry_type : string * gram_universe -> string -> Genarg.argument_type +(* Tactics as arguments *) + +val tactic_main_level : int + +val rawwit_tactic : int -> (raw_tactic_expr,rlevel,raw_tactic_expr) abstract_argument_type +val globwit_tactic : int -> (glob_tactic_expr,glevel,glob_tactic_expr) abstract_argument_type +val wit_tactic : int -> (glob_tactic_expr,tlevel,glob_tactic_expr) abstract_argument_type + +val rawwit_tactic0 : (raw_tactic_expr,rlevel,raw_tactic_expr) abstract_argument_type +val globwit_tactic0 : (glob_tactic_expr,glevel,glob_tactic_expr) abstract_argument_type +val wit_tactic0 : (glob_tactic_expr,tlevel,glob_tactic_expr) abstract_argument_type + +val rawwit_tactic1 : (raw_tactic_expr,rlevel,raw_tactic_expr) abstract_argument_type +val globwit_tactic1 : (glob_tactic_expr,glevel,glob_tactic_expr) abstract_argument_type +val wit_tactic1 : (glob_tactic_expr,tlevel,glob_tactic_expr) abstract_argument_type + +val rawwit_tactic2 : (raw_tactic_expr,rlevel,raw_tactic_expr) abstract_argument_type +val globwit_tactic2 : (glob_tactic_expr,glevel,glob_tactic_expr) abstract_argument_type +val wit_tactic2 : (glob_tactic_expr,tlevel,glob_tactic_expr) abstract_argument_type + +val rawwit_tactic3 : (raw_tactic_expr,rlevel,raw_tactic_expr) abstract_argument_type +val globwit_tactic3 : (glob_tactic_expr,glevel,glob_tactic_expr) abstract_argument_type +val wit_tactic3 : (glob_tactic_expr,tlevel,glob_tactic_expr) abstract_argument_type + +val rawwit_tactic4 : (raw_tactic_expr,rlevel,raw_tactic_expr) abstract_argument_type +val globwit_tactic4 : (glob_tactic_expr,glevel,glob_tactic_expr) abstract_argument_type +val wit_tactic4 : (glob_tactic_expr,tlevel,glob_tactic_expr) abstract_argument_type + +val rawwit_tactic5 : (raw_tactic_expr,rlevel,raw_tactic_expr) abstract_argument_type +val globwit_tactic5 : (glob_tactic_expr,glevel,glob_tactic_expr) abstract_argument_type +val wit_tactic5 : (glob_tactic_expr,tlevel,glob_tactic_expr) abstract_argument_type + +val is_tactic_genarg : argument_type -> bool + +val tactic_genarg_level : string -> int option + (* The main entry: reads an optional vernac command *) val main_entry : (loc * vernac_expr) option Gram.Entry.e @@ -148,7 +184,6 @@ module Tactic : val simple_intropattern : Genarg.intro_pattern_expr Gram.Entry.e val tactic_arg : raw_tactic_arg Gram.Entry.e val tactic_expr : raw_tactic_expr Gram.Entry.e - val tactic_main_level : int val tactic : raw_tactic_expr Gram.Entry.e val tactic_eoi : raw_tactic_expr Gram.Entry.e end diff --git a/parsing/ppconstr.ml b/parsing/ppconstr.ml index a43463c6..d55a6c1e 100644 --- a/parsing/ppconstr.ml +++ b/parsing/ppconstr.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: ppconstr.ml 8624 2006-03-13 17:38:17Z msozeau $ *) +(* $Id: ppconstr.ml 8878 2006-05-30 16:44:25Z herbelin $ *) (*i*) open Util @@ -117,7 +117,7 @@ let pr_optc pr = function let pr_universe = Univ.pr_uni -let pr_sort = function +let pr_rawsort = function | RProp Term.Null -> str "Prop" | RProp Term.Pos -> str "Set" | RType u -> str "Type" ++ pr_opt pr_universe u @@ -153,8 +153,8 @@ let pr_lname = function | lna -> pr_located pr_name lna let pr_or_var pr = function - | Genarg.ArgArg x -> pr x - | Genarg.ArgVar (loc,s) -> pr_lident (loc,s) + | ArgArg x -> pr x + | ArgVar (loc,s) -> pr_lident (loc,s) let pr_prim_token = function | Numeral n -> Bigint.pr_bigint n @@ -379,11 +379,11 @@ let pr_fixdecl pr prd dangling_with_for (id,(n,ro),bl,t,c) = let ids = names_of_local_assums bl in match ro with CStructRec -> - if List.length ids > 1 then - spc() ++ str "{struct " ++ pr_name (snd (List.nth ids n)) ++ str"}" + if List.length ids > 1 && n <> None then + spc() ++ str "{struct " ++ pr_name (snd (List.nth ids (out_some n))) ++ str"}" else mt() | CWfRec c -> - spc () ++ str "{wf " ++ pr lsimple c ++ pr_name (snd (List.nth ids n)) ++ str"}" + spc () ++ str "{wf " ++ pr lsimple c ++ pr_name (snd (List.nth ids (out_some n))) ++ str"}" in pr_recursive_decl pr prd dangling_with_for id bl annot t c @@ -563,7 +563,7 @@ let rec pr sep inherited a = | CHole _ -> str "_", latom | CEvar (_,n) -> str (Evd.string_of_existential n), latom | CPatVar (_,(_,p)) -> str "?" ++ pr_patvar p, latom - | CSort (_,s) -> pr_sort s, latom + | CSort (_,s) -> pr_rawsort s, latom | CCast (_,a,_,b) -> hv 0 (pr mt (lcast,L) a ++ cut () ++ str ":" ++ pr mt (-lcast,E) b), lcast @@ -619,19 +619,16 @@ let rec strip_context n iscast t = let pr_constr_expr c = pr lsimple c let pr_lconstr_expr c = pr ltop c let pr_pattern_expr c = pr lsimple c +let pr_lpattern_expr c = pr ltop c + let pr_cases_pattern_expr = pr_patt ltop let pr_binders = pr_undelimited_binders (pr ltop) -let pr_pattern_occ prc = function - ([],c) -> prc c - | (nl,c) -> hov 1 (prc c ++ spc() ++ str"at " ++ - hov 0 (prlist_with_sep spc int nl)) - -let pr_unfold_occ pr_ref = function - ([],qid) -> pr_ref qid - | (nl,qid) -> hov 1 (pr_ref qid ++ spc() ++ str"at " ++ - hov 0 (prlist_with_sep spc int nl)) +let pr_with_occurrences pr = function + ([],c) -> pr c + | (nl,c) -> hov 1 (pr c ++ spc() ++ str"at " ++ + hov 0 (prlist_with_sep spc (pr_or_var int) nl)) let pr_red_flag pr r = (if r.rBeta then pr_arg str "beta" else mt ()) ++ @@ -651,7 +648,7 @@ let pr_metaid id = str"?" ++ pr_id id let pr_red_expr (pr_constr,pr_lconstr,pr_ref) = function | Red false -> str "red" | Hnf -> str "hnf" - | Simpl o -> str "simpl" ++ pr_opt (pr_pattern_occ pr_constr) o + | Simpl o -> str "simpl" ++ pr_opt (pr_with_occurrences pr_constr) o | Cbv f -> if f = {rBeta=true;rIota=true;rZeta=true;rDelta=true;rConst=[]} then str "compute" @@ -661,11 +658,11 @@ let pr_red_expr (pr_constr,pr_lconstr,pr_ref) = function hov 1 (str "lazy" ++ pr_red_flag pr_ref f) | Unfold l -> hov 1 (str "unfold" ++ spc() ++ - prlist_with_sep pr_coma (pr_unfold_occ pr_ref) l) + prlist_with_sep pr_coma (pr_with_occurrences pr_ref) l) | Fold l -> hov 1 (str "fold" ++ prlist (pr_arg pr_constr) l) | Pattern l -> hov 1 (str "pattern" ++ - pr_arg (prlist_with_sep pr_coma (pr_pattern_occ pr_constr)) l) + pr_arg (prlist_with_sep pr_coma (pr_with_occurrences pr_constr)) l) | Red true -> error "Shouldn't be accessible from user" | ExtraRedExpr s -> str s diff --git a/parsing/ppconstr.mli b/parsing/ppconstr.mli index 7441f130..8f965d9b 100644 --- a/parsing/ppconstr.mli +++ b/parsing/ppconstr.mli @@ -7,7 +7,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: ppconstr.mli 7907 2006-01-21 11:03:29Z herbelin $ i*) +(*i $Id: ppconstr.mli 8878 2006-05-30 16:44:25Z herbelin $ i*) open Pp open Environ @@ -53,17 +53,20 @@ val pr_id : identifier -> std_ppcmds val pr_name : name -> std_ppcmds val pr_qualid : qualid -> std_ppcmds +val pr_with_occurrences : + ('a -> std_ppcmds) -> 'a with_occurrences -> std_ppcmds val pr_red_expr : - ('a -> std_ppcmds) * ('a -> std_ppcmds) * ('b -> std_ppcmds) -> + ('a -> std_ppcmds) * ('a -> std_ppcmds) * ('b -> std_ppcmds) -> ('a,'b) red_expr_gen -> std_ppcmds val pr_may_eval : - ('a -> std_ppcmds) -> ('a -> std_ppcmds) -> ('b -> std_ppcmds) -> + ('a -> std_ppcmds) -> ('a -> std_ppcmds) -> ('b -> std_ppcmds) -> ('a,'b) may_eval -> std_ppcmds -val pr_sort : rawsort -> std_ppcmds +val pr_rawsort : rawsort -> std_ppcmds val pr_binders : local_binder list -> std_ppcmds val pr_pattern_expr : Tacexpr.pattern_expr -> std_ppcmds +val pr_lpattern_expr : Tacexpr.pattern_expr -> std_ppcmds val pr_constr_expr : constr_expr -> std_ppcmds val pr_lconstr_expr : constr_expr -> std_ppcmds val pr_cases_pattern_expr : cases_pattern_expr -> std_ppcmds diff --git a/parsing/pptactic.ml b/parsing/pptactic.ml index e6c12f4f..2113ae89 100644 --- a/parsing/pptactic.ml +++ b/parsing/pptactic.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: pptactic.ml 8651 2006-03-21 21:54:43Z jforest $ *) +(* $Id: pptactic.ml 8926 2006-06-08 20:23:17Z herbelin $ *) open Pp open Names @@ -127,7 +127,7 @@ let rec pr_message_token prid = function | MsgInt n -> int n | MsgIdent id -> prid id -let rec pr_raw_generic prc prlc prtac prref x = +let rec pr_raw_generic prc prlc prtac prref (x:(Genarg.rlevel, Tacexpr.raw_tactic_expr) Genarg.generic_argument) = match Genarg.genarg_tag x with | BoolArgType -> pr_arg str (if out_gen rawwit_bool x then "true" else "false") | IntArgType -> pr_arg int (out_gen rawwit_int x) @@ -139,16 +139,14 @@ let rec pr_raw_generic prc prlc prtac prref x = | IdentArgType -> pr_arg pr_id (out_gen rawwit_ident x) | VarArgType -> pr_arg (pr_located pr_id) (out_gen rawwit_var x) | RefArgType -> pr_arg prref (out_gen rawwit_ref x) - | SortArgType -> pr_arg pr_sort (out_gen rawwit_sort x) + | SortArgType -> pr_arg pr_rawsort (out_gen rawwit_sort x) | ConstrArgType -> pr_arg prc (out_gen rawwit_constr x) | ConstrMayEvalArgType -> - pr_arg (pr_may_eval prc prlc prref) - (out_gen rawwit_constr_may_eval x) + pr_arg (pr_may_eval prc prlc prref) (out_gen rawwit_constr_may_eval x) | QuantHypArgType -> pr_arg pr_quantified_hypothesis (out_gen rawwit_quant_hyp x) | RedExprArgType -> pr_arg (pr_red_expr (prc,prlc,prref)) (out_gen rawwit_red_expr x) - | TacticArgType n -> pr_arg (prtac (n,E)) (out_gen (rawwit_tactic n) x) | OpenConstrArgType b -> pr_arg prc (snd (out_gen (rawwit_open_constr_gen b) x)) | ConstrWithBindingsArgType -> pr_arg (pr_with_bindings prc prlc) (out_gen rawwit_constr_with_bindings x) @@ -182,18 +180,18 @@ let rec pr_glob_generic prc prlc prtac x = | IdentArgType -> pr_arg pr_id (out_gen globwit_ident x) | VarArgType -> pr_arg (pr_located pr_id) (out_gen globwit_var x) | RefArgType -> pr_arg (pr_or_var (pr_located pr_global)) (out_gen globwit_ref x) - | SortArgType -> pr_arg pr_sort (out_gen globwit_sort x) + | SortArgType -> pr_arg pr_rawsort (out_gen globwit_sort x) | ConstrArgType -> pr_arg prc (out_gen globwit_constr x) | ConstrMayEvalArgType -> pr_arg (pr_may_eval prc prlc - (pr_or_var (pr_and_short_name pr_evaluable_reference))) (out_gen globwit_constr_may_eval x) + (pr_or_var (pr_and_short_name pr_evaluable_reference))) + (out_gen globwit_constr_may_eval x) | QuantHypArgType -> pr_arg pr_quantified_hypothesis (out_gen globwit_quant_hyp x) | RedExprArgType -> pr_arg (pr_red_expr (prc,prlc,pr_or_var (pr_and_short_name pr_evaluable_reference))) (out_gen globwit_red_expr x) - | TacticArgType n -> pr_arg (prtac (n,E)) (out_gen (globwit_tactic n) x) | OpenConstrArgType b -> pr_arg prc (snd (out_gen (globwit_open_constr_gen b) x)) | ConstrWithBindingsArgType -> pr_arg (pr_with_bindings prc prlc) (out_gen globwit_constr_with_bindings x) @@ -228,7 +226,7 @@ let rec pr_generic prc prlc prtac x = | IdentArgType -> pr_arg pr_id (out_gen wit_ident x) | VarArgType -> pr_arg pr_id (out_gen wit_var x) | RefArgType -> pr_arg pr_global (out_gen wit_ref x) - | SortArgType -> pr_arg prc (Term.mkSort (out_gen wit_sort x)) + | SortArgType -> pr_arg pr_sort (out_gen wit_sort x) | ConstrArgType -> pr_arg prc (out_gen wit_constr x) | ConstrMayEvalArgType -> pr_arg prc (out_gen wit_constr_may_eval x) @@ -237,7 +235,6 @@ let rec pr_generic prc prlc prtac x = | RedExprArgType -> pr_arg (pr_red_expr (prc,prlc,pr_evaluable_reference)) (out_gen wit_red_expr x) - | TacticArgType n -> pr_arg (prtac (n,E)) (out_gen (wit_tactic n) x) | OpenConstrArgType b -> pr_arg prc (snd (out_gen (wit_open_constr_gen b) x)) | ConstrWithBindingsArgType -> pr_arg (pr_with_bindings prc prlc) (out_gen wit_constr_with_bindings x) @@ -381,17 +378,14 @@ let pr_by_tactic prt = function | TacId [] -> mt () | tac -> spc() ++ str "by " ++ prt tac -let pr_occs pp = function - [] -> pp - | nl -> hov 1 (pp ++ spc() ++ str"at " ++ - hov 0 (prlist_with_sep spc int nl)) - let pr_hyp_location pr_id = function - | id, occs, InHyp -> spc () ++ pr_occs (pr_id id) occs - | id, occs, InHypTypeOnly -> - spc () ++ pr_occs (str "(type of " ++ pr_id id ++ str ")") occs - | id, occs, InHypValueOnly -> - spc () ++ pr_occs (str "(value of " ++ pr_id id ++ str ")") occs + | occs, InHyp -> spc () ++ pr_with_occurrences pr_id occs + | occs, InHypTypeOnly -> + spc () ++ + pr_with_occurrences (fun id -> str "(type of " ++ pr_id id ++ str ")") occs + | occs, InHypValueOnly -> + spc () ++ + pr_with_occurrences (fun id -> str "(value of " ++ pr_id id ++ str ")") occs let pr_in pp = spc () ++ hov 0 (str "in" ++ pp) @@ -401,11 +395,11 @@ let pr_simple_clause pr_id = function let pr_clauses pr_id = function { onhyps=None; onconcl=true; concl_occs=nl } -> - pr_in (pr_occs (str " *") nl) + pr_in (pr_with_occurrences (fun () -> str " *") (nl,())) | { onhyps=None; onconcl=false } -> pr_in (str " * |-") | { onhyps=Some l; onconcl=true; concl_occs=nl } -> pr_in (prlist_with_sep (fun () -> str",") (pr_hyp_location pr_id) l - ++ pr_occs (str" |- *") nl) + ++ pr_with_occurrences (fun () -> str" |- *") (nl,())) | { onhyps=Some l; onconcl=false } -> pr_in (prlist_with_sep (fun()->str",") (pr_hyp_location pr_id) l) @@ -418,6 +412,8 @@ let pr_clause_pattern pr_id = function ++ spc () ++ pr_id id) l ++ pr_opt (fun nl -> prlist_with_sep spc int nl ++ str " Goal") glopt +let pr_orient b = if b then mt () else str " <-" + let pr_induction_arg prc = function | ElimOnConstr c -> prc c | ElimOnIdent (loc,id) -> pr_with_comments loc (pr_id id) @@ -436,17 +432,27 @@ let pr_match_pattern pr_pat = function | Subterm (Some id,a) -> str "context " ++ pr_id id ++ str "[" ++ pr_pat a ++ str "]" -let pr_match_hyps pr_pat = function - | Hyp (nal,mp) -> pr_lname nal ++ str ":" ++ pr_match_pattern pr_pat mp +let pr_match_hyps pr_pat (Hyp (nal,mp)) = + pr_lname nal ++ str ":" ++ pr_match_pattern pr_pat mp let pr_match_rule m pr pr_pat = function | Pat ([],mp,t) when m -> pr_match_pattern pr_pat mp ++ spc () ++ str "=>" ++ brk (1,4) ++ pr t +(* + | Pat (rl,mp,t) -> + hv 0 (prlist_with_sep pr_coma (pr_match_hyps pr_pat) rl ++ + (if rl <> [] then spc () else mt ()) ++ + hov 0 (str "|-" ++ spc () ++ pr_match_pattern pr_pat mp ++ spc () ++ + str "=>" ++ brk (1,4) ++ pr t)) +*) | Pat (rl,mp,t) -> - prlist_with_sep (fun () -> str",") (pr_match_hyps pr_pat) rl ++ - spc () ++ str "|-" ++ spc () ++ pr_match_pattern pr_pat mp ++ spc () ++ - str "=>" ++ brk (1,4) ++ pr t + hov 0 ( + hv 0 (prlist_with_sep pr_coma (pr_match_hyps pr_pat) rl) ++ + (if rl <> [] then spc () else mt ()) ++ + hov 0 ( + str "|-" ++ spc () ++ pr_match_pattern pr_pat mp ++ spc () ++ + str "=>" ++ brk (1,4) ++ pr t)) | All t -> str "_" ++ spc () ++ str "=>" ++ brk (1,4) ++ pr t let pr_funvar = function @@ -532,38 +538,46 @@ let level_of (n,p) = match p with E -> n | L -> n-1 | Prec n -> n | Any -> lseq open Closure +(** A printer for tactics that polymorphically works on the three + "raw", "glob" and "typed" levels; in practice, the environment is + used only at the glob and typed level: it is used to feed the + constr printers *) + let make_pr_tac (pr_tac_level,pr_constr,pr_lconstr,pr_pat, pr_cst,pr_ind,pr_ref,pr_ident, - pr_extend,strip_prod_binders) = - -let pr_bindings env = - pr_bindings (pr_lconstr env) (pr_constr env) in -let pr_ex_bindings env = - pr_bindings_gen true (pr_lconstr env) (pr_constr env) in -let pr_with_bindings env = - pr_with_bindings (pr_lconstr env) (pr_constr env) in -let pr_eliminator env cb = - str "using" ++ pr_arg (pr_with_bindings env) cb in -let pr_extend env = - pr_extend (pr_constr env) (pr_lconstr env) (pr_tac_level env) in -let pr_red_expr env = - pr_red_expr (pr_constr env,pr_lconstr env,pr_cst env) in - -let pr_constrarg env c = spc () ++ pr_constr env c in -let pr_lconstrarg env c = spc () ++ pr_lconstr env c in + pr_extend,strip_prod_binders) env = + +(* The environment is not used by the tactic printer: it is passed to the + constr and cst printers; hence we can make some abbreviations *) +let pr_constr = pr_constr env in +let pr_lconstr = pr_lconstr env in +let pr_cst = pr_cst env in +let pr_ind = pr_ind env in +let pr_tac_level = pr_tac_level env in + +(* Other short cuts *) +let pr_bindings = pr_bindings pr_lconstr pr_constr in +let pr_ex_bindings = pr_bindings_gen true pr_lconstr pr_constr in +let pr_with_bindings = pr_with_bindings pr_lconstr pr_constr in +let pr_extend = pr_extend pr_constr pr_lconstr pr_tac_level in +let pr_red_expr = pr_red_expr (pr_constr,pr_lconstr,pr_cst) in + +let pr_constrarg c = spc () ++ pr_constr c in +let pr_lconstrarg c = spc () ++ pr_lconstr c in let pr_intarg n = spc () ++ int n in -let pr_binder_fix env (nal,t) = +(* Some printing combinators *) +let pr_eliminator cb = str "using" ++ pr_arg pr_with_bindings cb in + +let pr_binder_fix (nal,t) = (* match t with | CHole _ -> spc() ++ prlist_with_sep spc (pr_lname) nal | _ ->*) - let s = - prlist_with_sep spc (pr_lname) nal ++ str ":" ++ - pr_lconstr env t in + let s = prlist_with_sep spc pr_lname nal ++ str ":" ++ pr_lconstr t in spc() ++ hov 1 (str"(" ++ s ++ str")") in -let pr_fix_tac env (id,n,c) = +let pr_fix_tac (id,n,c) = let rec set_nth_name avoid n = function (nal,ty)::bll -> if n <= List.length nal then @@ -589,17 +603,17 @@ let pr_fix_tac env (id,n,c) = if List.length names = 1 then mt() else spc() ++ str"{struct " ++ pr_id idarg ++ str"}" in hov 1 (str"(" ++ pr_id id ++ - prlist (pr_binder_fix env) bll ++ annot ++ str" :" ++ - pr_lconstrarg env ty ++ str")") in + prlist pr_binder_fix bll ++ annot ++ str" :" ++ + pr_lconstrarg ty ++ str")") in (* spc() ++ hov 0 (pr_id id ++ pr_intarg n ++ str":" ++ pr_constrarg - env c) + c) *) -let pr_cofix_tac env (id,c) = - hov 1 (str"(" ++ pr_id id ++ str" :" ++ pr_lconstrarg env c ++ str")") in +let pr_cofix_tac (id,c) = + hov 1 (str"(" ++ pr_id id ++ str" :" ++ pr_lconstrarg c ++ str")") in (* Printing tactics as arguments *) -let rec pr_atom0 env = function +let rec pr_atom0 = function | TacIntroPattern [] -> str "intros" | TacIntroMove (None,None) -> str "intro" | TacAssumption -> str "assumption" @@ -607,77 +621,78 @@ let rec pr_atom0 env = function | TacTrivial ([],Some []) -> str "trivial" | TacAuto (None,[],Some []) -> str "auto" | TacReflexivity -> str "reflexivity" - | t -> str "(" ++ pr_atom1 env t ++ str ")" + | TacClear (true,[]) -> str "clear" + | t -> str "(" ++ pr_atom1 t ++ str ")" (* Main tactic printer *) -and pr_atom1 env = function +and pr_atom1 = function | TacAutoTDB _ | TacDestructHyp _ | TacDestructConcl | TacSuperAuto _ | TacExtend (_, ("GTauto"|"GIntuition"|"TSimplif"| "LinearIntuition"),_) -> errorlabstrm "Obsolete V8" (str "Tactic is not ported to V8.0") | TacExtend (loc,s,l) -> - pr_with_comments loc (pr_extend env 1 s l) + pr_with_comments loc (pr_extend 1 s l) | TacAlias (loc,s,l,_) -> - pr_with_comments loc (pr_extend env 1 s (List.map snd l)) + pr_with_comments loc (pr_extend 1 s (List.map snd l)) (* Basic tactics *) - | TacIntroPattern [] as t -> pr_atom0 env t + | TacIntroPattern [] as t -> pr_atom0 t | TacIntroPattern (_::_ as p) -> hov 1 (str "intros" ++ spc () ++ prlist_with_sep spc pr_intro_pattern p) | TacIntrosUntil h -> hv 1 (str "intros until" ++ pr_arg pr_quantified_hypothesis h) - | TacIntroMove (None,None) as t -> pr_atom0 env t + | TacIntroMove (None,None) as t -> pr_atom0 t | TacIntroMove (Some id1,None) -> str "intro " ++ pr_id id1 | TacIntroMove (ido1,Some id2) -> hov 1 (str "intro" ++ pr_opt pr_id ido1 ++ spc () ++ str "after " ++ pr_lident id2) - | TacAssumption as t -> pr_atom0 env t - | TacExact c -> hov 1 (str "exact" ++ pr_constrarg env c) - | TacExactNoCheck c -> hov 1 (str "exact_no_check" ++ pr_constrarg env c) - | TacApply cb -> hov 1 (str "apply" ++ spc () ++ pr_with_bindings env cb) + | TacAssumption as t -> pr_atom0 t + | TacExact c -> hov 1 (str "exact" ++ pr_constrarg c) + | TacExactNoCheck c -> hov 1 (str "exact_no_check" ++ pr_constrarg c) + | TacApply cb -> hov 1 (str "apply" ++ spc () ++ pr_with_bindings cb) | TacElim (cb,cbo) -> - hov 1 (str "elim" ++ pr_arg (pr_with_bindings env) cb ++ - pr_opt (pr_eliminator env) cbo) - | TacElimType c -> hov 1 (str "elimtype" ++ pr_constrarg env c) - | TacCase cb -> hov 1 (str "case" ++ spc () ++ pr_with_bindings env cb) - | TacCaseType c -> hov 1 (str "casetype" ++ pr_constrarg env c) + hov 1 (str "elim" ++ pr_arg pr_with_bindings cb ++ + pr_opt pr_eliminator cbo) + | TacElimType c -> hov 1 (str "elimtype" ++ pr_constrarg c) + | TacCase cb -> hov 1 (str "case" ++ spc () ++ pr_with_bindings cb) + | TacCaseType c -> hov 1 (str "casetype" ++ pr_constrarg c) | TacFix (ido,n) -> hov 1 (str "fix" ++ pr_opt pr_id ido ++ pr_intarg n) | TacMutualFix (id,n,l) -> hov 1 (str "fix" ++ spc () ++ pr_id id ++ pr_intarg n ++ spc() ++ - str"with " ++ prlist_with_sep spc (pr_fix_tac env) l) + str"with " ++ prlist_with_sep spc pr_fix_tac l) | TacCofix ido -> hov 1 (str "cofix" ++ pr_opt pr_id ido) | TacMutualCofix (id,l) -> hov 1 (str "cofix" ++ spc () ++ pr_id id ++ spc() ++ - str"with " ++ prlist_with_sep spc (pr_cofix_tac env) l) - | TacCut c -> hov 1 (str "cut" ++ pr_constrarg env c) + str"with " ++ prlist_with_sep spc pr_cofix_tac l) + | TacCut c -> hov 1 (str "cut" ++ pr_constrarg c) | TacAssert (Some tac,ipat,c) -> hov 1 (str "assert" ++ - pr_assumption (pr_lconstr env) (pr_constr env) ipat c ++ - pr_by_tactic (pr_tac_level env ltop) tac) + pr_assumption pr_lconstr pr_constr ipat c ++ + pr_by_tactic (pr_tac_level ltop) tac) | TacAssert (None,ipat,c) -> hov 1 (str "pose proof" ++ - pr_assertion (pr_lconstr env) (pr_constr env) ipat c) + pr_assertion pr_lconstr pr_constr ipat c) | TacGeneralize l -> hov 1 (str "generalize" ++ spc () ++ - prlist_with_sep spc (pr_constr env) l) + prlist_with_sep spc pr_constr l) | TacGeneralizeDep c -> hov 1 (str "generalize" ++ spc () ++ str "dependent" ++ - pr_constrarg env c) + pr_constrarg c) | TacLetTac (na,c,cl) when cl = nowhere -> - hov 1 (str "pose" ++ pr_pose (pr_lconstr env) (pr_constr env) na c) + hov 1 (str "pose" ++ pr_pose pr_lconstr pr_constr na c) | TacLetTac (na,c,cl) -> - hov 1 (str "set" ++ pr_pose (pr_lconstr env) (pr_constr env) na c ++ + hov 1 (str "set" ++ pr_pose pr_lconstr pr_constr na c ++ pr_clauses pr_ident cl) (* | TacInstantiate (n,c,ConclLocation ()) -> hov 1 (str "instantiate" ++ spc() ++ hov 1 (str"(" ++ pr_arg int n ++ str" :=" ++ - pr_lconstrarg env c ++ str ")" )) + pr_lconstrarg c ++ str ")" )) | TacInstantiate (n,c,HypLocation (id,hloc)) -> hov 1 (str "instantiate" ++ spc() ++ hov 1 (str"(" ++ pr_arg int n ++ str" :=" ++ - pr_lconstrarg env c ++ str ")" ) + pr_lconstrarg c ++ str ")" ) ++ str "in" ++ pr_hyp_location pr_ident (id,[],(hloc,ref None))) *) (* Derived basic tactics *) @@ -685,47 +700,49 @@ and pr_atom1 env = function hov 1 (str "simple induction" ++ pr_arg pr_quantified_hypothesis h) | TacNewInduction (h,e,ids) -> hov 1 (str "induction" ++ spc () ++ - prlist_with_sep spc (pr_induction_arg (pr_constr env)) h ++ - pr_opt (pr_eliminator env) e) + prlist_with_sep spc (pr_induction_arg pr_constr) h ++ + pr_with_names ids ++ + pr_opt pr_eliminator e) | TacSimpleDestruct h -> hov 1 (str "simple destruct" ++ pr_arg pr_quantified_hypothesis h) | TacNewDestruct (h,e,ids) -> hov 1 (str "destruct" ++ spc () ++ - prlist_with_sep spc (pr_induction_arg (pr_constr env)) h ++ + prlist_with_sep spc (pr_induction_arg pr_constr) h ++ pr_with_names ids ++ - pr_opt (pr_eliminator env) e) + pr_opt pr_eliminator e) | TacDoubleInduction (h1,h2) -> hov 1 (str "double induction" ++ pr_arg pr_quantified_hypothesis h1 ++ pr_arg pr_quantified_hypothesis h2) | TacDecomposeAnd c -> - hov 1 (str "decompose record" ++ pr_constrarg env c) + hov 1 (str "decompose record" ++ pr_constrarg c) | TacDecomposeOr c -> - hov 1 (str "decompose sum" ++ pr_constrarg env c) + hov 1 (str "decompose sum" ++ pr_constrarg c) | TacDecompose (l,c) -> hov 1 (str "decompose" ++ spc () ++ - hov 0 (str "[" ++ prlist_with_sep spc (pr_ind env) l - ++ str "]" ++ pr_constrarg env c)) + hov 0 (str "[" ++ prlist_with_sep spc pr_ind l + ++ str "]" ++ pr_constrarg c)) | TacSpecialize (n,c) -> hov 1 (str "specialize" ++ spc () ++ pr_opt int n ++ - pr_with_bindings env c) + pr_with_bindings c) | TacLApply c -> - hov 1 (str "lapply" ++ pr_constrarg env c) + hov 1 (str "lapply" ++ pr_constrarg c) (* Automation tactics *) - | TacTrivial ([],Some []) as x -> pr_atom0 env x + | TacTrivial ([],Some []) as x -> pr_atom0 x | TacTrivial (lems,db) -> hov 0 (str "trivial" ++ - pr_auto_using (pr_constr env) lems ++ pr_hintbases db) - | TacAuto (None,[],Some []) as x -> pr_atom0 env x + pr_auto_using pr_constr lems ++ pr_hintbases db) + | TacAuto (None,[],Some []) as x -> pr_atom0 x | TacAuto (n,lems,db) -> hov 0 (str "auto" ++ pr_opt (pr_or_var int) n ++ - pr_auto_using (pr_constr env) lems ++ pr_hintbases db) + pr_auto_using pr_constr lems ++ pr_hintbases db) | TacDAuto (n,p) -> hov 1 (str "auto" ++ pr_opt (pr_or_var int) n ++ str "decomp" ++ pr_opt int p) (* Context management *) + | TacClear (true,[]) as t -> pr_atom0 t | TacClear (keep,l) -> hov 1 (str "clear" ++ spc () ++ (if keep then str "- " else mt ()) ++ prlist_with_sep spc pr_ident l) @@ -743,77 +760,81 @@ and pr_atom1 env = function str "into" ++ brk (1,1) ++ pr_ident id2) (* Constructors *) - | TacLeft l -> hov 1 (str "left" ++ pr_bindings env l) - | TacRight l -> hov 1 (str "right" ++ pr_bindings env l) - | TacSplit (false,l) -> hov 1 (str "split" ++ pr_bindings env l) - | TacSplit (true,l) -> hov 1 (str "exists" ++ pr_ex_bindings env l) + | TacLeft l -> hov 1 (str "left" ++ pr_bindings l) + | TacRight l -> hov 1 (str "right" ++ pr_bindings l) + | TacSplit (false,l) -> hov 1 (str "split" ++ pr_bindings l) + | TacSplit (true,l) -> hov 1 (str "exists" ++ pr_ex_bindings l) | TacAnyConstructor (Some t) -> - hov 1 (str "constructor" ++ pr_arg (pr_tac_level env (latom,E)) t) - | TacAnyConstructor None as t -> pr_atom0 env t + hov 1 (str "constructor" ++ pr_arg (pr_tac_level (latom,E)) t) + | TacAnyConstructor None as t -> pr_atom0 t | TacConstructor (n,l) -> - hov 1 (str "constructor" ++ pr_or_metaid pr_intarg n ++ pr_bindings env l) + hov 1 (str "constructor" ++ pr_or_metaid pr_intarg n ++ pr_bindings l) (* Conversion *) | TacReduce (r,h) -> - hov 1 (pr_red_expr env r ++ + hov 1 (pr_red_expr r ++ pr_clauses pr_ident h) | TacChange (occ,c,h) -> hov 1 (str "change" ++ brk (1,1) ++ (match occ with None -> mt() - | Some([],c1) -> hov 1 (pr_constr env c1 ++ spc() ++ str "with ") + | Some([],c1) -> hov 1 (pr_constr c1 ++ spc() ++ str "with ") | Some(ocl,c1) -> - hov 1 (pr_constr env c1 ++ spc() ++ - str "at " ++ prlist_with_sep spc int ocl) ++ spc() ++ + hov 1 (pr_constr c1 ++ spc() ++ + str "at " ++ prlist_with_sep spc (pr_or_var int) ocl) ++ + spc() ++ str "with ") ++ - pr_constr env c ++ pr_clauses pr_ident h) + pr_constr c ++ pr_clauses pr_ident h) (* Equivalence relations *) - | TacReflexivity as x -> pr_atom0 env x + | TacReflexivity as x -> pr_atom0 x | TacSymmetry cls -> str "symmetry " ++ pr_clauses pr_ident cls - | TacTransitivity c -> str "transitivity" ++ pr_constrarg env c + | TacTransitivity c -> str "transitivity" ++ pr_constrarg c (* Equality and inversion *) + | TacRewrite (b,c,cl) -> + hov 1 (str "rewrite" ++ pr_orient b ++ spc() ++ pr_with_bindings c ++ + pr_clauses pr_ident cl) | TacInversion (DepInversion (k,c,ids),hyp) -> hov 1 (str "dependent " ++ pr_induction_kind k ++ spc () ++ pr_quantified_hypothesis hyp ++ - pr_with_names ids ++ pr_with_constr (pr_constr env) c) + pr_with_names ids ++ pr_with_constr pr_constr c) | TacInversion (NonDepInversion (k,cl,ids),hyp) -> hov 1 (pr_induction_kind k ++ spc () ++ pr_quantified_hypothesis hyp ++ pr_with_names ids ++ pr_simple_clause pr_ident cl) | TacInversion (InversionUsing (c,cl),hyp) -> hov 1 (str "inversion" ++ spc() ++ pr_quantified_hypothesis hyp ++ - spc () ++ str "using" ++ spc () ++ pr_constr env c ++ + spc () ++ str "using" ++ spc () ++ pr_constr c ++ pr_simple_clause pr_ident cl) in -let rec pr_tac env inherited tac = +let rec pr_tac inherited tac = let (strm,prec) = match tac with | TacAbstract (t,None) -> - str "abstract " ++ pr_tac env (labstract,L) t, labstract + str "abstract " ++ pr_tac (labstract,L) t, labstract | TacAbstract (t,Some s) -> hov 0 - (str "abstract (" ++ pr_tac env (labstract,L) t ++ str")" ++ spc () ++ + (str "abstract (" ++ pr_tac (labstract,L) t ++ str")" ++ spc () ++ str "using " ++ pr_id s), labstract | TacLetRecIn (l,t) -> hv 0 - (str "let rec " ++ pr_rec_clauses (pr_tac env ltop) l ++ str " in" ++ - fnl () ++ pr_tac env (llet,E) t), + (str "let rec " ++ pr_rec_clauses (pr_tac ltop) l ++ str " in" ++ + fnl () ++ pr_tac (llet,E) t), llet | TacLetIn (llc,u) -> v 0 - (hv 0 (pr_let_clauses (pr_tac env ltop) llc + (hv 0 (pr_let_clauses (pr_tac ltop) llc ++ str " in") ++ - fnl () ++ pr_tac env (llet,E) u), + fnl () ++ pr_tac (llet,E) u), llet | TacMatch (lz,t,lrul) -> - hov 0 (pr_lazy lz ++ str "match " ++ pr_tac env ltop t ++ str " with" + hov 0 (pr_lazy lz ++ str "match " ++ pr_tac ltop t ++ str " with" ++ prlist (fun r -> fnl () ++ str "| " ++ - pr_match_rule true (pr_tac env ltop) pr_pat r) + pr_match_rule true (pr_tac ltop) pr_pat r) lrul ++ fnl() ++ str "end"), lmatch @@ -822,79 +843,78 @@ let rec pr_tac env inherited tac = str (if lr then "match reverse goal with" else "match goal with") ++ prlist (fun r -> fnl () ++ str "| " ++ - pr_match_rule false (pr_tac env ltop) pr_pat r) + pr_match_rule false (pr_tac ltop) pr_pat r) lrul ++ fnl() ++ str "end"), lmatch | TacFun (lvar,body) -> -(* let env = List.fold_right (option_fold_right Idset.add) lvar env in*) hov 2 (str "fun" ++ prlist pr_funvar lvar ++ str " =>" ++ spc () ++ - pr_tac env (lfun,E) body), + pr_tac (lfun,E) body), lfun | TacThens (t,tl) -> - hov 1 (pr_tac env (lseq,E) t ++ pr_then () ++ spc () ++ - pr_seq_body (pr_tac env ltop) tl), + hov 1 (pr_tac (lseq,E) t ++ pr_then () ++ spc () ++ + pr_seq_body (pr_tac ltop) tl), lseq | TacThen (t1,t2) -> - hov 1 (pr_tac env (lseq,E) t1 ++ pr_then () ++ spc () ++ - pr_tac env (lseq,L) t2), + hov 1 (pr_tac (lseq,E) t1 ++ pr_then () ++ spc () ++ + pr_tac (lseq,L) t2), lseq | TacTry t -> - hov 1 (str "try" ++ spc () ++ pr_tac env (ltactical,E) t), + hov 1 (str "try" ++ spc () ++ pr_tac (ltactical,E) t), ltactical | TacDo (n,t) -> hov 1 (str "do " ++ pr_or_var int n ++ spc () ++ - pr_tac env (ltactical,E) t), + pr_tac (ltactical,E) t), ltactical | TacRepeat t -> - hov 1 (str "repeat" ++ spc () ++ pr_tac env (ltactical,E) t), + hov 1 (str "repeat" ++ spc () ++ pr_tac (ltactical,E) t), ltactical | TacProgress t -> - hov 1 (str "progress" ++ spc () ++ pr_tac env (ltactical,E) t), + hov 1 (str "progress" ++ spc () ++ pr_tac (ltactical,E) t), ltactical | TacInfo t -> - hov 1 (str "info" ++ spc () ++ pr_tac env (ltactical,E) t), + hov 1 (str "info" ++ spc () ++ pr_tac (ltactical,E) t), ltactical | TacOrelse (t1,t2) -> - hov 1 (pr_tac env (lorelse,L) t1 ++ str " ||" ++ brk (1,1) ++ - pr_tac env (lorelse,E) t2), + hov 1 (pr_tac (lorelse,L) t1 ++ str " ||" ++ brk (1,1) ++ + pr_tac (lorelse,E) t2), lorelse | TacFail (n,l) -> str "fail" ++ (if n=ArgArg 0 then mt () else pr_arg (pr_or_var int) n) ++ prlist (pr_arg (pr_message_token pr_ident)) l, latom | TacFirst tl -> - str "first" ++ spc () ++ pr_seq_body (pr_tac env ltop) tl, llet + str "first" ++ spc () ++ pr_seq_body (pr_tac ltop) tl, llet | TacSolve tl -> - str "solve" ++ spc () ++ pr_seq_body (pr_tac env ltop) tl, llet + str "solve" ++ spc () ++ pr_seq_body (pr_tac ltop) tl, llet | TacComplete t -> - str "complete" ++ spc () ++ pr_tac env (lcomplete,E) t, lcomplete + str "complete" ++ spc () ++ pr_tac (lcomplete,E) t, lcomplete | TacId l -> str "idtac" ++ prlist (pr_arg (pr_message_token pr_ident)) l, latom | TacAtom (loc,TacAlias (_,s,l,_)) -> pr_with_comments loc - (pr_extend env (level_of inherited) s (List.map snd l)), + (pr_extend (level_of inherited) s (List.map snd l)), latom | TacAtom (loc,t) -> - pr_with_comments loc (hov 1 (pr_atom1 env t)), ltatom - | TacArg(Tacexp e) -> pr_tac_level env (latom,E) e, latom + pr_with_comments loc (hov 1 (pr_atom1 t)), ltatom + | TacArg(Tacexp e) -> pr_tac_level (latom,E) e, latom | TacArg(ConstrMayEval (ConstrTerm c)) -> - str "constr:" ++ pr_constr env c, latom + str "constr:" ++ pr_constr c, latom | TacArg(ConstrMayEval c) -> - pr_may_eval (pr_constr env) (pr_lconstr env) (pr_cst env) c, leval + pr_may_eval pr_constr pr_lconstr pr_cst c, leval | TacArg(TacFreshId sopt) -> str "fresh" ++ pr_opt qs sopt, latom | TacArg(Integer n) -> int n, latom | TacArg(TacCall(loc,f,l)) -> pr_with_comments loc (hov 1 (pr_ref f ++ spc () ++ - prlist_with_sep spc (pr_tacarg env) l)), + prlist_with_sep spc pr_tacarg l)), lcall - | TacArg a -> pr_tacarg env a, latom + | TacArg a -> pr_tacarg a, latom in if prec_less prec inherited then strm else str"(" ++ strm ++ str")" -and pr_tacarg env = function +and pr_tacarg = function | TacDynamic (loc,t) -> pr_with_comments loc (str ("<dynamic ["^(Dyn.tag t)^"]>")) | MetaIdArg (loc,s) -> pr_with_comments loc (str ("$" ^ s)) @@ -902,13 +922,13 @@ and pr_tacarg env = function | TacVoid -> str "()" | Reference r -> pr_ref r | ConstrMayEval c -> - pr_may_eval (pr_constr env) (pr_lconstr env) (pr_cst env) c + pr_may_eval pr_constr pr_lconstr pr_cst c | TacFreshId sopt -> str "fresh" ++ pr_opt qs sopt | TacExternal (_,com,req,la) -> str "external" ++ spc() ++ qs com ++ spc() ++ qs req ++ - spc() ++ prlist_with_sep spc (pr_tacarg env) la + spc() ++ prlist_with_sep spc pr_tacarg la | (TacCall _|Tacexp _|Integer _) as a -> - str "ltac:" ++ pr_tac env (latom,E) (TacArg a) + str "ltac:" ++ pr_tac (latom,E) (TacArg a) in (pr_tac, pr_match_rule) @@ -936,7 +956,7 @@ let rec raw_printers = (pr_raw_tactic_level, drop_env pr_constr_expr, drop_env pr_lconstr_expr, - pr_pattern_expr, + pr_lpattern_expr, drop_env pr_reference, drop_env pr_reference, pr_reference, @@ -945,10 +965,10 @@ let rec raw_printers = strip_prod_binders_expr) and pr_raw_tactic_level env n (t:raw_tactic_expr) = - fst (make_pr_tac raw_printers) env n t + fst (make_pr_tac raw_printers env) n t and pr_raw_match_rule env t = - snd (make_pr_tac raw_printers) env t + snd (make_pr_tac raw_printers env) t let pr_and_constr_expr pr (c,_) = pr c @@ -956,7 +976,7 @@ let rec glob_printers = (pr_glob_tactic_level, (fun env -> pr_and_constr_expr (pr_rawconstr_env env)), (fun env -> pr_and_constr_expr (pr_lrawconstr_env env)), - (fun c -> pr_constr_pattern_env (Global.env()) c), + (fun c -> pr_lconstr_pattern_env (Global.env()) c), (fun env -> pr_or_var (pr_and_short_name (pr_evaluable_reference_env env))), (fun env -> pr_or_var (pr_inductive env)), pr_ltac_or_var (pr_located pr_ltac_constant), @@ -965,17 +985,16 @@ let rec glob_printers = strip_prod_binders_rawterm) and pr_glob_tactic_level env n (t:glob_tactic_expr) = - fst (make_pr_tac glob_printers) env n t + fst (make_pr_tac glob_printers env) n t and pr_glob_match_rule env t = - snd (make_pr_tac glob_printers) env t + snd (make_pr_tac glob_printers env) t -let ((pr_tactic_level:Environ.env -> tolerability -> Proof_type.tactic_expr -> std_ppcmds),_) = - make_pr_tac +let typed_printers = (pr_glob_tactic_level, pr_constr_env, pr_lconstr_env, - pr_constr_pattern, + pr_lconstr_pattern, pr_evaluable_reference_env, pr_inductive, pr_ltac_constant, @@ -983,6 +1002,8 @@ let ((pr_tactic_level:Environ.env -> tolerability -> Proof_type.tactic_expr -> s pr_extend, strip_prod_binders_constr) +let pr_tactic_level env = fst (make_pr_tac typed_printers env) + let pr_raw_tactic env = pr_raw_tactic_level env ltop let pr_glob_tactic env = pr_glob_tactic_level env ltop let pr_tactic env = pr_tactic_level env ltop @@ -996,3 +1017,14 @@ let _ = Tactic_debug.set_match_pattern_printer let _ = Tactic_debug.set_match_rule_printer (fun rl -> pr_match_rule false (pr_glob_tactic (Global.env())) pr_constr_pattern rl) + +open Pcoq + +let pr_tac_polymorphic n _ _ prtac = prtac (n,E) + +let _ = for i=0 to 5 do + declare_extra_genarg_pprule + (rawwit_tactic i, pr_tac_polymorphic i) + (globwit_tactic i, pr_tac_polymorphic i) + (wit_tactic i, pr_tac_polymorphic i) +done diff --git a/parsing/ppvernac.ml b/parsing/ppvernac.ml index 0b6e5771..aea44604 100644 --- a/parsing/ppvernac.ml +++ b/parsing/ppvernac.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: ppvernac.ml 8624 2006-03-13 17:38:17Z msozeau $ *) +(* $Id: ppvernac.ml 8831 2006-05-19 09:29:54Z herbelin $ *) open Pp open Names @@ -277,7 +277,7 @@ let pr_onescheme (id,dep,ind,s) = hov 0 (pr_lident id ++ str" :=") ++ spc() ++ hov 0 ((if dep then str"Induction for" else str"Minimality for") ++ spc() ++ pr_reference ind) ++ spc() ++ - hov 0 (str"Sort" ++ spc() ++ pr_sort s) + hov 0 (str"Sort" ++ spc() ++ pr_rawsort s) let begin_of_inductive = function [] -> 0 @@ -555,18 +555,23 @@ let rec pr_vernac = function else ([],def,type_) in let bl = bl @ bl' in let ids = List.flatten (List.map name_of_binder bl) in - let name = - try snd (List.nth ids n) - with Failure _ -> - warn (str "non-printable fixpoint \""++pr_id id++str"\""); - Anonymous in let annot = - match (ro : Topconstr.recursion_order_expr) with - CStructRec -> - if List.length ids > 1 then - spc() ++ str "{struct " ++ pr_name name ++ str"}" - else mt() - | CWfRec c -> spc() ++ str "{wf " ++ pr_name name ++ spc() ++ pr_lconstr_expr c ++ str"}" + match n with + | None -> mt () + | Some n -> + let name = + try snd (List.nth ids n) + with Failure _ -> + warn (str "non-printable fixpoint \""++pr_id id++str"\""); + Anonymous in + match (ro : Topconstr.recursion_order_expr) with + CStructRec -> + if List.length ids > 1 then + spc() ++ str "{struct " ++ pr_name name ++ str"}" + else mt() + | CWfRec c -> + spc() ++ str "{wf " ++ pr_name name ++ spc() ++ + pr_lconstr_expr c ++ str"}" in pr_id id ++ pr_binders_arg bl ++ annot ++ spc() ++ pr_type_option (fun c -> spc() ++ pr_lconstr_expr c) type_ @@ -823,6 +828,13 @@ and pr_extend s cl = try let rls = List.assoc s (Egrammar.get_extend_vernac_grammars()) in let rl = match_vernac_rule (List.map Genarg.genarg_tag cl) rls in + let start,rl,cl = + match rl with + | Egrammar.TacTerm s :: rl -> str s, rl, cl + | Egrammar.TacNonTerm _ :: rl -> + (* Will put an unnecessary extra space in front *) + pr_gen (Global.env()) (List.hd cl), rl, List.tl cl + | [] -> anomaly "Empty entry" in let (pp,_) = List.fold_left (fun (strm,args) pi -> @@ -831,7 +843,7 @@ and pr_extend s cl = (strm ++ pr_gen (Global.env()) (List.hd args), List.tl args) | Egrammar.TacTerm s -> (strm ++ spc() ++ str s, args)) - (mt(),cl) rl in + (start,cl) rl in hov 1 pp with Not_found -> hov 1 (str ("TODO("^s) ++ prlist_with_sep sep pr_arg cl ++ str ")") diff --git a/parsing/prettyp.ml b/parsing/prettyp.ml index a22f5796..4534369f 100644 --- a/parsing/prettyp.ml +++ b/parsing/prettyp.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: prettyp.ml 7938 2006-01-28 22:03:33Z herbelin $ *) +(* $Id: prettyp.ml 8845 2006-05-23 07:41:58Z herbelin $ *) open Pp open Util @@ -278,11 +278,11 @@ let print_constructors envpar names types = hv 0 (str " " ++ pc) let build_inductive sp tyi = - let (mib,mip) = Global.lookup_inductive (sp,tyi) in + let (mib,mip as specif) = Global.lookup_inductive (sp,tyi) in let params = mib.mind_params_ctxt in let args = extended_rel_list 0 params in let env = Global.env() in - let arity = hnf_prod_applist env mip.mind_user_arity args in + let arity = hnf_prod_applist env (Inductive.type_of_inductive specif) args in let cstrtypes = arities_of_constructors env (sp,tyi) in let cstrtypes = Array.map (fun c -> hnf_prod_applist env c args) cstrtypes in @@ -401,7 +401,7 @@ let print_context with_values = | h::rest when n = None or out_some n > 0 -> (match print_library_entry with_values h with | None -> prec n rest - | Some pp -> prec (option_app ((+) (-1)) n) rest ++ pp ++ fnl ()) + | Some pp -> prec (option_map ((+) (-1)) n) rest ++ pp ++ fnl ()) | _ -> mt () in prec diff --git a/parsing/printer.ml b/parsing/printer.ml index 82676b79..8cb5ac42 100644 --- a/parsing/printer.ml +++ b/parsing/printer.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: printer.ml 7855 2006-01-12 08:21:57Z herbelin $ *) +(* $Id: printer.ml 8831 2006-05-19 09:29:54Z herbelin $ *) open Pp open Util @@ -77,11 +77,18 @@ let pr_rawconstr c = let pr_cases_pattern t = pr_cases_pattern_expr (extern_cases_pattern Idset.empty t) +let pr_lconstr_pattern_env env c = + pr_lconstr_expr (extern_constr_pattern (names_of_rel_context env) c) let pr_constr_pattern_env env c = pr_constr_expr (extern_constr_pattern (names_of_rel_context env) c) + +let pr_lconstr_pattern t = + pr_lconstr_expr (extern_constr_pattern empty_names_context t) let pr_constr_pattern t = pr_constr_expr (extern_constr_pattern empty_names_context t) +let pr_sort s = pr_rawsort (extern_sort s) + let _ = Termops.set_print_constr pr_lconstr_env (**********************************************************************) diff --git a/parsing/printer.mli b/parsing/printer.mli index 66471d41..9d59bf75 100644 --- a/parsing/printer.mli +++ b/parsing/printer.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: printer.mli 7855 2006-01-12 08:21:57Z herbelin $ i*) +(*i $Id: printer.mli 8831 2006-05-19 09:29:54Z herbelin $ i*) (*i*) open Pp @@ -50,11 +50,16 @@ val pr_lrawconstr : rawconstr -> std_ppcmds val pr_rawconstr_env : env -> rawconstr -> std_ppcmds val pr_rawconstr : rawconstr -> std_ppcmds +val pr_lconstr_pattern_env : env -> constr_pattern -> std_ppcmds +val pr_lconstr_pattern : constr_pattern -> std_ppcmds + val pr_constr_pattern_env : env -> constr_pattern -> std_ppcmds val pr_constr_pattern : constr_pattern -> std_ppcmds val pr_cases_pattern : cases_pattern -> std_ppcmds +val pr_sort : sorts -> std_ppcmds + (* Printing global references using names as short as possible *) val pr_global_env : Idset.t -> global_reference -> std_ppcmds diff --git a/parsing/q_coqast.ml4 b/parsing/q_coqast.ml4 index 35801f73..b5b07091 100644 --- a/parsing/q_coqast.ml4 +++ b/parsing/q_coqast.ml4 @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: q_coqast.ml4 8651 2006-03-21 21:54:43Z jforest $ *) +(* $Id: q_coqast.ml4 8926 2006-06-08 20:23:17Z herbelin $ *) open Util open Names @@ -77,20 +77,22 @@ let mlexpr_of_located f (loc,x) = <:expr< ($dloc$, $f x$) >> let mlexpr_of_loc loc = <:expr< $dloc$ >> let mlexpr_of_or_var f = function - | Genarg.ArgArg x -> <:expr< Genarg.ArgArg $f x$ >> - | Genarg.ArgVar id -> <:expr< Genarg.ArgVar $mlexpr_of_located mlexpr_of_ident id$ >> + | Rawterm.ArgArg x -> <:expr< Rawterm.ArgArg $f x$ >> + | Rawterm.ArgVar id -> <:expr< Rawterm.ArgVar $mlexpr_of_located mlexpr_of_ident id$ >> let mlexpr_of_hyp = mlexpr_of_or_metaid (mlexpr_of_located mlexpr_of_ident) -let mlexpr_of_occs = mlexpr_of_list mlexpr_of_int +let mlexpr_of_occs = mlexpr_of_list (mlexpr_of_or_var mlexpr_of_int) + +let mlexpr_of_occurrences f = mlexpr_of_pair mlexpr_of_occs f let mlexpr_of_hyp_location = function - | id, occs, Tacexpr.InHyp -> - <:expr< ($mlexpr_of_hyp id$, $mlexpr_of_occs occs$, Tacexpr.InHyp) >> - | id, occs, Tacexpr.InHypTypeOnly -> - <:expr< ($mlexpr_of_hyp id$, $mlexpr_of_occs occs$, Tacexpr.InHypTypeOnly) >> - | id, occs, Tacexpr.InHypValueOnly -> - <:expr< ($mlexpr_of_hyp id$, $mlexpr_of_occs occs$, Tacexpr.InHypValueOnly) >> + | occs, Tacexpr.InHyp -> + <:expr< ($mlexpr_of_occurrences mlexpr_of_hyp occs$, Tacexpr.InHyp) >> + | occs, Tacexpr.InHypTypeOnly -> + <:expr< ($mlexpr_of_occurrences mlexpr_of_hyp occs$, Tacexpr.InHypTypeOnly) >> + | occs, Tacexpr.InHypValueOnly -> + <:expr< ($mlexpr_of_occurrences mlexpr_of_hyp occs$, Tacexpr.InHypValueOnly) >> let mlexpr_of_clause cl = <:expr< {Tacexpr.onhyps= @@ -140,7 +142,8 @@ let rec mlexpr_of_constr = function | _ -> failwith "mlexpr_of_constr: TODO" let mlexpr_of_occ_constr = - mlexpr_of_pair (mlexpr_of_list mlexpr_of_int) mlexpr_of_constr + mlexpr_of_pair (mlexpr_of_list (mlexpr_of_or_var mlexpr_of_int)) + mlexpr_of_constr let mlexpr_of_red_expr = function | Rawterm.Red b -> <:expr< Rawterm.Red $mlexpr_of_bool b$ >> @@ -151,7 +154,7 @@ let mlexpr_of_red_expr = function | Rawterm.Lazy f -> <:expr< Rawterm.Lazy $mlexpr_of_red_flags f$ >> | Rawterm.Unfold l -> - let f1 = mlexpr_of_list mlexpr_of_int in + let f1 = mlexpr_of_list (mlexpr_of_or_var mlexpr_of_int) in let f2 = mlexpr_of_reference in let f = mlexpr_of_list (mlexpr_of_pair f1 f2) in <:expr< Rawterm.Unfold $f l$ >> @@ -179,7 +182,6 @@ let rec mlexpr_of_argtype loc = function | Genarg.ConstrWithBindingsArgType -> <:expr< Genarg.ConstrWithBindingsArgType >> | Genarg.BindingsArgType -> <:expr< Genarg.BindingsArgType >> | Genarg.RedExprArgType -> <:expr< Genarg.RedExprArgType >> - | Genarg.TacticArgType n -> <:expr< Genarg.TacticArgType $mlexpr_of_int n$ >> | Genarg.SortArgType -> <:expr< Genarg.SortArgType >> | Genarg.ConstrArgType -> <:expr< Genarg.ConstrArgType >> | Genarg.ConstrMayEvalArgType -> <:expr< Genarg.ConstrMayEvalArgType >> diff --git a/parsing/tacextend.ml4 b/parsing/tacextend.ml4 index 48a124a7..3d41e388 100644 --- a/parsing/tacextend.ml4 +++ b/parsing/tacextend.ml4 @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: tacextend.ml4 7732 2005-12-26 13:51:24Z herbelin $ *) +(* $Id: tacextend.ml4 8926 2006-06-08 20:23:17Z herbelin $ *) open Genarg open Q_util @@ -36,8 +36,6 @@ let rec make_when loc = function <:expr< Genarg.genarg_tag $lid:p$ = $t$ && $l$ >> | _::l -> make_when loc l -let is_tactic_arg = function TacticArgType _ -> true | _ -> false - let rec make_let e = function | [] -> e | TacNonTerm(loc,t,_,Some p)::l -> @@ -47,7 +45,7 @@ let rec make_let e = function let v = (* Special case for tactics which must be stored in algebraic form to avoid marshalling closures and to be reprinted *) - if is_tactic_arg t then + if Pcoq.is_tactic_genarg t then <:expr< ($v$, Tacinterp.eval_tactic $v$) >> else v in <:expr< let $lid:p$ = $v$ in $e$ >> @@ -84,7 +82,7 @@ let rec make_args = function let rec make_eval_tactic e = function | [] -> e - | TacNonTerm(loc,TacticArgType _,_,Some p)::l -> + | TacNonTerm(loc,tag,_,Some p)::l when Pcoq.is_tactic_genarg tag -> let loc = join_loc loc (MLast.loc_of_expr e) in let e = make_eval_tactic e l in (* Special case for tactics which must be stored in algebraic diff --git a/pretyping/cases.ml b/pretyping/cases.ml index a32aaf45..b0fe83a3 100644 --- a/pretyping/cases.ml +++ b/pretyping/cases.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: cases.ml 8693 2006-04-10 12:05:05Z msozeau $ *) +(* $Id: cases.ml 8875 2006-05-29 19:59:11Z msozeau $ *) open Util open Names @@ -66,13 +66,10 @@ let error_needs_inversion env x t = module type S = sig val compile_cases : loc -> - (type_constraint -> env -> rawconstr -> unsafe_judgment) * + (type_constraint -> env -> rawconstr -> unsafe_judgment) * Evd.evar_defs ref -> type_constraint -> - env -> - rawconstr option * - (rawconstr * (name * (loc * inductive * name list) option)) list * - (loc * identifier list * cases_pattern list * rawconstr) list -> + env -> rawconstr option * tomatch_tuple * cases_clauses -> unsafe_judgment end @@ -138,14 +135,9 @@ type 'a lifted = int * 'a let insert_lifted a = (0,a);; -(* The pattern variables for [it] are in [user_ids] and the variables - to avoid are in [other_ids]. -*) - type rhs = { rhs_env : env; - other_ids : identifier list; - user_ids : identifier list; + avoid_ids : identifier list; rhs_lift : int; it : rawconstr } @@ -321,16 +313,21 @@ let rec find_row_ind = function | PatCstr(loc,c,_,_) :: _ -> Some (loc,c) let inductive_template isevars env tmloc ind = - let (mib,mip) = Inductive.lookup_mind_specif env ind in - let (ntys,_) = splay_prod env (Evd.evars_of !isevars) mip.mind_nf_arity in + let arsign = get_full_arity_sign env ind in let hole_source = match tmloc with | Some loc -> fun i -> (loc, Evd.TomatchTypeParameter (ind,i)) | None -> fun _ -> (dummy_loc, Evd.InternalHole) in - let (evarl,_) = + let (_,evarl,_) = List.fold_right - (fun (na,ty) (evl,n) -> - (e_new_evar isevars env ~src:(hole_source n) (substl evl ty))::evl,n+1) - ntys ([],1) in + (fun (na,b,ty) (subst,evarl,n) -> + match b with + | None -> + let ty' = substl subst ty in + let e = e_new_evar isevars env ~src:(hole_source n) ty' in + (e::subst,e::evarl,n+1) + | Some b -> + (b::subst,evarl,n+1)) + arsign ([],[],1) in applist (mkInd ind,List.rev evarl) let inh_coerce_to_ind isevars env ty tyi = @@ -349,7 +346,7 @@ let unify_tomatch_with_patterns isevars env typ tm = let find_tomatch_tycon isevars env loc = function (* Try first if some 'in I ...' is present and can be used as a constraint *) - | Some (_,ind,_),_ + | Some (_,ind,_,_),_ (* Otherwise try to get constraints from (the 1st) constructor in clauses *) | None, Some (_,(ind,_)) -> mk_tycon (inductive_template isevars env loc ind) @@ -434,7 +431,7 @@ let mkDeclTomatch na = function let map_tomatch_type f = function | IsInd (t,ind) -> IsInd (f t,map_inductive_type f ind) - | NotInd (c,t) -> NotInd (option_app f c, f t) + | NotInd (c,t) -> NotInd (option_map f c, f t) let liftn_tomatch_type n depth = map_tomatch_type (liftn n depth) let lift_tomatch_type n = liftn_tomatch_type n 1 @@ -701,7 +698,7 @@ let get_names env sign eqns = (* Otherwise, we take names from the parameters of the constructor but avoiding conflicts with user ids *) let allvars = - List.fold_left (fun l (_,eqn) -> list_union l eqn.rhs.other_ids) [] eqns in + List.fold_left (fun l (_,eqn) -> list_union l eqn.rhs.avoid_ids) [] eqns in let names4,_ = List.fold_left2 (fun (l,avoid) d na -> @@ -793,7 +790,7 @@ let prepare_unif_pb typ cs = let typ' = if noccur_between_without_evar 1 n typ then lift (-n) typ else (* TODO4-1 *) - error "Inference of annotation not yet implemented in this case" in + error "Unable to infer return clause of this pattern-matching problem" in let args = extended_rel_list (-n) cs.cs_args in let ci = applist (mkConstruct cs.cs_cstr, cs.cs_params@args) in @@ -1172,7 +1169,7 @@ let rec generalize_problem pb current = function let tomatch = regeneralize_index_tomatch (i+1) tomatch in { pb with tomatch = Abstract d :: tomatch; - pred = option_app (generalize_predicate current i d) pb'.pred } + pred = option_map (generalize_predicate current i d) pb'.pred } (* No more patterns: typing the right-hand-side of equations *) let build_leaf pb = @@ -1187,7 +1184,7 @@ let build_leaf pb = let shift_problem (current,t) pb = {pb with tomatch = Alias (current,current,NonDepAlias,type_of_tomatch t)::pb.tomatch; - pred = option_app (specialize_predicate_var (current,t)) pb.pred; + pred = option_map (specialize_predicate_var (current,t)) pb.pred; history = push_history_pattern 0 AliasLeaf pb.history; mat = List.map remove_current_pattern pb.mat } @@ -1257,7 +1254,7 @@ let build_branch current deps pb eqns const_info = { pb with env = push_rels sign pb.env; tomatch = List.rev_append currents tomatch; - pred = option_app (specialize_predicate (List.rev typs') dep_sign const_info) pb.pred; + pred = option_map (specialize_predicate (List.rev typs') dep_sign const_info) pb.pred; history = history; mat = List.map (push_rels_eqn_with_names sign) submat } @@ -1329,7 +1326,7 @@ and compile_generalization pb d rest = { pb with env = push_rel d pb.env; tomatch = rest; - pred = option_app ungeneralize_predicate pb.pred; + pred = option_map ungeneralize_predicate pb.pred; mat = List.map (push_rels_eqn [d]) pb.mat } in let patstat,j = compile pb in patstat, @@ -1355,7 +1352,7 @@ and compile_alias pb (deppat,nondeppat,d,t) rest = {pb with env = newenv; tomatch = tomatch; - pred = option_app (lift_predicate n) pb.pred; + pred = option_map (lift_predicate n) pb.pred; history = history; mat = mat } in let patstat,j = compile pb in @@ -1368,78 +1365,16 @@ substituer après par les initiaux *) (**************************************************************************) (* Preparation of the pattern-matching problem *) -(* Qu'est-ce qui faut pas faire pour traiter les alias ... *) - -(* On ne veut pas ajouter de primitive à Environ et le problème, c'est - donc de faire un renommage en se contraignant à parcourir l'env - dans le sens croissant. Ici, subst renomme des variables repérées - par leur numéro et seen_ids collecte celles dont on sait que les - variables de subst annule le scope *) -let rename_env subst env = - let n = ref (rel_context_length (rel_context env)) in - let seen_ids = ref [] in - process_rel_context - (fun (na,c,t as d) env -> - let d = - try - let id = List.assoc !n subst in - seen_ids := id :: !seen_ids; - (Name id,c,t) - with Not_found -> - match na with - | Name id when List.mem id !seen_ids -> (Anonymous,c,t) - | _ -> d in - decr n; - push_rel d env) env - -let is_dependent_indtype = function - | NotInd _ -> false - | IsInd (_, IndType(_,realargs)) -> realargs <> [] - -let prepare_initial_alias_eqn isdep tomatchl eqn = - let (subst, pats) = - List.fold_right2 - (fun pat (tm,tmtyp) (subst, stripped_pats) -> - match alias_of_pat pat with - | Anonymous -> (subst, pat::stripped_pats) - | Name idpat -> - match kind_of_term tm with - | Rel n when not (is_dependent_indtype tmtyp) & not isdep - -> (n, idpat)::subst, (unalias_pat pat::stripped_pats) - | _ -> (subst, pat::stripped_pats)) - eqn.patterns tomatchl ([], []) in - let env = rename_env subst eqn.rhs.rhs_env in - { eqn with patterns = pats; rhs = { eqn.rhs with rhs_env = env } } - -let prepare_initial_aliases isdep tomatchl mat = mat -(* List.map (prepare_initial_alias_eqn isdep tomatchl) mat*) - -(* -let prepare_initial_alias lpat tomatchl rhs = - List.fold_right2 - (fun pat tm (stripped_pats, rhs) -> - match alias_of_pat pat with - | Anonymous -> (pat::stripped_pats, rhs) - | Name _ as na -> - match tm with - | RVar _ -> - (unalias_pat pat::stripped_pats, - RLetIn (dummy_loc, na, tm, rhs)) - | _ -> (pat::stripped_pats, rhs)) - lpat tomatchl ([], rhs) -*) (* builds the matrix of equations testing that each eqn has n patterns * and linearizing the _ patterns. * Syntactic correctness has already been done in astterm *) let matx_of_eqns env tomatchl eqns = let build_eqn (loc,ids,lpat,rhs) = -(* let initial_lpat,initial_rhs = prepare_initial_alias lpat tomatchl rhs in*) let initial_lpat,initial_rhs = lpat,rhs in let initial_rhs = rhs in let rhs = { rhs_env = env; - other_ids = ids@(ids_of_named_context (named_context env)); - user_ids = ids; + avoid_ids = ids@(ids_of_named_context (named_context env)); rhs_lift = 0; it = initial_rhs } in { dependencies = []; @@ -1547,7 +1482,7 @@ let set_arity_signature dep n arsign tomatchl pred x = in decomp_block [] pred (tomatchl,arsign) -let prepare_predicate_from_tycon loc dep env isevars tomatchs c = +let prepare_predicate_from_tycon loc dep env isevars tomatchs sign c = let cook (n, l, env, signs) = function | c,IsInd (_,IndType(indf,realargs)) -> let indf' = lift_inductive_family n indf in @@ -1605,8 +1540,8 @@ let extract_arity_signature env0 tomatchl tmsign = match tm with | NotInd (bo,typ) -> (match t with - | None -> [na,option_app (lift n) bo,lift n typ] - | Some (loc,_,_) -> + | None -> [na,option_map (lift n) bo,lift n typ] + | Some (loc,_,_,_) -> user_err_loc (loc,"", str "Unexpected type annotation for a term of non inductive type")) | IsInd (_,IndType(indf,realargs)) -> @@ -1615,18 +1550,12 @@ let extract_arity_signature env0 tomatchl tmsign = let nrealargs = List.length realargs in let realnal = match t with - | Some (loc,ind',nal) -> - let nparams = List.length params in + | Some (loc,ind',nparams,realnal) -> if ind <> ind' then user_err_loc (loc,"",str "Wrong inductive type"); - let nindargs = nparams + nrealargs in - (* Normally done at interning time *) - if List.length nal <> nindargs then - error_wrong_numarg_inductive_loc loc env0 ind' nindargs; - let parnal,realnal = list_chop nparams nal in - if List.exists ((<>) Anonymous) parnal then - user_err_loc (loc,"", - str "The parameters of inductive type must be implicit"); + if List.length params <> nparams + or nrealargs <> List.length realnal then + anomaly "Ill-formed 'in' clause in cases"; List.rev realnal | None -> list_tabulate (fun _ -> Anonymous) nrealargs in let arsign = fst (get_arity env0 indf') in @@ -1665,7 +1594,7 @@ let prepare_predicate loc typing_fun isevars env tomatchs sign tycon = function (match tycon with | Some (None, t) -> let names,pred = - prepare_predicate_from_tycon loc false env isevars tomatchs t + prepare_predicate_from_tycon loc false env isevars tomatchs sign t in Some (build_initial_predicate false names pred) | _ -> None) @@ -1677,8 +1606,9 @@ let prepare_predicate loc typing_fun isevars env tomatchs sign tycon = function let allnames = List.rev (List.map (List.map pi1) arsign) in let predcclj = typing_fun (mk_tycon (new_Type ())) env rtntyp in let _ = - option_app (fun tycon -> - isevars := Coercion.inh_conv_coerces_to loc env !isevars predcclj.uj_val tycon) + option_map (fun tycon -> + isevars := Coercion.inh_conv_coerces_to loc env !isevars predcclj.uj_val + (lift_tycon_type (List.length arsign) tycon)) tycon in let predccl = (j_nf_isevar !isevars predcclj).uj_val in @@ -1701,9 +1631,6 @@ let compile_cases loc (typing_fun, isevars) (tycon : Evarutil.type_constraint) e let tmsign = List.map snd tomatchl in let pred = prepare_predicate loc typing_fun isevars env tomatchs tmsign tycon predopt in - (* We deal with initial aliases *) - let matx = prepare_initial_aliases (known_dependent pred) tomatchs matx in - (* We push the initial terms to match and push their alias to rhs' envs *) (* names of aliases will be recovered from patterns (hence Anonymous here) *) let initial_pushed = List.map (fun tm -> Pushed (tm,[])) tomatchs in diff --git a/pretyping/cases.mli b/pretyping/cases.mli index 5919c42a..9e902126 100644 --- a/pretyping/cases.mli +++ b/pretyping/cases.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: cases.mli 8654 2006-03-22 15:36:58Z msozeau $ i*) +(*i $Id: cases.mli 8741 2006-04-26 22:30:32Z herbelin $ i*) (*i*) open Util @@ -41,13 +41,9 @@ val error_wrong_numarg_inductive_loc : loc -> env -> inductive -> int -> 'a module type S = sig val compile_cases : loc -> - (type_constraint -> env -> rawconstr -> unsafe_judgment) * - evar_defs ref -> + (type_constraint -> env -> rawconstr -> unsafe_judgment) * evar_defs ref -> type_constraint -> - env -> - rawconstr option * - (rawconstr * (name * (loc * inductive * name list) option)) list * - (loc * identifier list * cases_pattern list * rawconstr) list -> + env -> rawconstr option * tomatch_tuple * cases_clauses -> unsafe_judgment end diff --git a/pretyping/cbv.ml b/pretyping/cbv.ml index 33166ba8..2a01e901 100644 --- a/pretyping/cbv.ml +++ b/pretyping/cbv.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: cbv.ml 7639 2005-12-02 10:01:15Z gregoire $ *) +(* $Id: cbv.ml 8802 2006-05-10 20:47:28Z barras $ *) open Util open Pp @@ -45,10 +45,10 @@ open Esubst *) type cbv_value = | VAL of int * constr - | LAM of name * constr * constr * cbv_value subs - | FIXP of fixpoint * cbv_value subs * cbv_value list - | COFIXP of cofixpoint * cbv_value subs * cbv_value list - | CONSTR of constructor * cbv_value list + | LAM of int * (name * constr) list * constr * cbv_value subs + | FIXP of fixpoint * cbv_value subs * cbv_value array + | COFIXP of cofixpoint * cbv_value subs * cbv_value array + | CONSTR of constructor * cbv_value array (* les vars pourraient etre des constr, cela permet de retarder les lift: utile ?? *) @@ -58,14 +58,15 @@ type cbv_value = *) let rec shift_value n = function | VAL (k,v) -> VAL ((k+n),v) - | LAM (x,a,b,s) -> LAM (x,a,b,subs_shft (n,s)) + | LAM (nlams,ctxt,b,s) -> LAM (nlams,ctxt,b,subs_shft (n,s)) | FIXP (fix,s,args) -> - FIXP (fix,subs_shft (n,s), List.map (shift_value n) args) + FIXP (fix,subs_shft (n,s), Array.map (shift_value n) args) | COFIXP (cofix,s,args) -> - COFIXP (cofix,subs_shft (n,s), List.map (shift_value n) args) + COFIXP (cofix,subs_shft (n,s), Array.map (shift_value n) args) | CONSTR (c,args) -> - CONSTR (c, List.map (shift_value n) args) - + CONSTR (c, Array.map (shift_value n) args) +let shift_value n v = + if n = 0 then v else shift_value n v (* Contracts a fixpoint: given a fixpoint and a bindings, * returns the corresponding fixpoint body, and the bindings in which @@ -74,22 +75,14 @@ let rec shift_value n = function * -> (S. [S]F0 . [S]F1 ... . [S]Fn-1, Ti) *) let contract_fixp env ((reci,i),(_,_,bds as bodies)) = - let make_body j = FIXP(((reci,j),bodies), env, []) in + let make_body j = FIXP(((reci,j),bodies), env, [||]) in let n = Array.length bds in - let rec subst_bodies_from_i i subs = - if i=n then subs - else subst_bodies_from_i (i+1) (subs_cons (make_body i, subs)) - in - subst_bodies_from_i 0 env, bds.(i) + subs_cons(Array.init n make_body, env), bds.(i) let contract_cofixp env (i,(_,_,bds as bodies)) = - let make_body j = COFIXP((j,bodies), env, []) in + let make_body j = COFIXP((j,bodies), env, [||]) in let n = Array.length bds in - let rec subst_bodies_from_i i subs = - if i=n then subs - else subst_bodies_from_i (i+1) (subs_cons (make_body i, subs)) - in - subst_bodies_from_i 0 env, bds.(i) + subs_cons(Array.init n make_body, env), bds.(i) let make_constr_ref n = function | RelKey p -> mkRel (n+p) @@ -99,9 +92,11 @@ let make_constr_ref n = function (* type of terms with a hole. This hole can appear only under App or Case. * TOP means the term is considered without context - * APP(l,stk) means the term is applied to l, and then we have the context st + * APP(v,stk) means the term is applied to v, and then the context stk + * (v.0 is the first argument). * this corresponds to the application stack of the KAM. - * The members of l are values: we evaluate arguments before the function. + * The members of l are values: we evaluate arguments before + calling the function. * CASE(t,br,pat,S,stk) means the term is in a case (which is himself in stk * t is the type of the case and br are the branches, all of them under * the subs S, pat is information on the patterns of the Case @@ -114,15 +109,15 @@ let make_constr_ref n = function type cbv_stack = | TOP - | APP of cbv_value list * cbv_stack + | APP of cbv_value array * cbv_stack | CASE of constr * constr array * case_info * cbv_value subs * cbv_stack (* Adds an application list. Collapse APPs! *) let stack_app appl stack = - match (appl, stack) with - | ([], _) -> stack - | (_, APP(args,stk)) -> APP(appl@args,stk) - | _ -> APP(appl, stack) + if Array.length appl = 0 then stack else + match stack with + | APP(args,stk) -> APP(Array.append appl args,stk) + | _ -> APP(appl, stack) open RedFlags @@ -137,23 +132,21 @@ let red_set_ref flags = function *) let strip_appl head stack = match head with - | FIXP (fix,env,app) -> (FIXP(fix,env,[]), stack_app app stack) - | COFIXP (cofix,env,app) -> (COFIXP(cofix,env,[]), stack_app app stack) - | CONSTR (c,app) -> (CONSTR(c,[]), stack_app app stack) + | FIXP (fix,env,app) -> (FIXP(fix,env,[||]), stack_app app stack) + | COFIXP (cofix,env,app) -> (COFIXP(cofix,env,[||]), stack_app app stack) + | CONSTR (c,app) -> (CONSTR(c,[||]), stack_app app stack) | _ -> (head, stack) -(* Tests if fixpoint reduction is possible. A reduction function is given as - argument *) -let rec check_app_constr = function - | ([], _) -> false - | ((CONSTR _)::_, 0) -> true - | (_::l, n) -> check_app_constr (l,(pred n)) - +(* Tests if fixpoint reduction is possible. *) let fixp_reducible flgs ((reci,i),_) stk = if red_set flgs fIOTA then - match stk with (* !!! for Acc_rec: reci.(i) = -2 *) - | APP(appl,_) -> reci.(i) >=0 & check_app_constr (appl, reci.(i)) + match stk with + | APP(appl,_) -> + Array.length appl > reci.(i) && + (match appl.(reci.(i)) with + CONSTR _ -> true + | _ -> false) | _ -> false else false @@ -166,6 +159,7 @@ let cofixp_reducible flgs _ stk = else false + (* The main recursive functions * * Go under applications and cases (pushed in the stack), expand head @@ -184,7 +178,7 @@ let rec norm_head info env t stack = | App (head,args) -> (* Applied terms are normalized immediately; they could be computed when getting out of the stack *) let nargs = Array.map (cbv_stack_term info TOP env) args in - norm_head info env head (stack_app (Array.to_list nargs) stack) + norm_head info env head (stack_app nargs stack) | Case (ci,p,c,v) -> norm_head info env c (CASE(p,v,ci,env,stack)) | Cast (ct,_,_) -> norm_head info env ct stack @@ -212,7 +206,7 @@ let rec norm_head info env t stack = or red_set (info_flags info) fDELTA *) then - subs_cons (cbv_stack_term info TOP env b,env) + subs_cons ([|cbv_stack_term info TOP env b|],env) else subs_lift env in if zeta then @@ -225,10 +219,12 @@ let rec norm_head info env t stack = (VAL(0,normt), stack) (* Considérer une coupure commutative ? *) (* non-neutral cases *) - | Lambda (x,a,b) -> (LAM(x,a,b,env), stack) - | Fix fix -> (FIXP(fix,env,[]), stack) - | CoFix cofix -> (COFIXP(cofix,env,[]), stack) - | Construct c -> (CONSTR(c, []), stack) + | Lambda _ -> + let ctxt,b = decompose_lam t in + (LAM(List.length ctxt, List.rev ctxt,b,env), stack) + | Fix fix -> (FIXP(fix,env,[||]), stack) + | CoFix cofix -> (COFIXP(cofix,env,[||]), stack) + | Construct c -> (CONSTR(c, [||]), stack) (* neutral cases *) | (Sort _ | Meta _ | Ind _|Evar _) -> (VAL(0, t), stack) @@ -253,10 +249,18 @@ and norm_head_ref k info env stack normt = and cbv_stack_term info stack env t = match norm_head info env t stack with (* a lambda meets an application -> BETA *) - | (LAM (x,a,b,env), APP (arg::args, stk)) + | (LAM (nlams,ctxt,b,env), APP (args, stk)) when red_set (info_flags info) fBETA -> - let subs = subs_cons (arg,env) in - cbv_stack_term info (stack_app args stk) subs b + let nargs = Array.length args in + if nargs == nlams then + cbv_stack_term info stk (subs_cons(args,env)) b + else if nlams < nargs then + let env' = subs_cons(Array.sub args 0 nlams, env) in + let eargs = Array.sub args nlams (nargs-nlams) in + cbv_stack_term info (APP(eargs,stk)) env' b + else + let ctxt' = list_skipn nargs ctxt in + LAM(nlams-nargs,ctxt', b, subs_cons(args,env)) (* a Fix applied enough -> IOTA *) | (FIXP(fix,env,_), stk) @@ -273,8 +277,9 @@ and cbv_stack_term info stack env t = (* constructor in a Case -> IOTA *) | (CONSTR((sp,n),_), APP(args,CASE(_,br,ci,env,stk))) when red_set (info_flags info) fIOTA -> - let real_args = list_skipn ci.ci_npar args in - cbv_stack_term info (stack_app real_args stk) env br.(n-1) + let cargs = + Array.sub args ci.ci_npar (Array.length args - ci.ci_npar) in + cbv_stack_term info (stack_app cargs stk) env br.(n-1) (* constructor of arity 0 in a Case -> IOTA *) | (CONSTR((_,n),_), CASE(_,br,_,env,stk)) @@ -287,6 +292,9 @@ and cbv_stack_term info stack env t = | (COFIXP(cofix,env,_), APP(appl,TOP)) -> COFIXP(cofix,env,appl) | (CONSTR(c,_), APP(appl,TOP)) -> CONSTR(c,appl) + (* absurd cases (ill-typed) *) + | (LAM _, CASE _) -> assert false + (* definitely a value *) | (head,stk) -> VAL(0,apply_stack info (cbv_norm_value info head) stk) @@ -298,7 +306,7 @@ and cbv_stack_term info stack env t = and apply_stack info t = function | TOP -> t | APP (args,st) -> - apply_stack info (applistc t (List.map (cbv_norm_value info) args)) st + apply_stack info (mkApp(t,Array.map (cbv_norm_value info) args)) st | CASE (ty,br,ci,env,st) -> apply_stack info (mkCase (ci, cbv_norm_term info env ty, t, @@ -314,28 +322,28 @@ and cbv_norm_term info env t = (* reduction of a cbv_value to a constr *) and cbv_norm_value info = function (* reduction under binders *) | VAL (n,v) -> lift n v - | LAM (x,a,b,env) -> - mkLambda (x, cbv_norm_term info env a, - cbv_norm_term info (subs_lift env) b) + | LAM (n,ctxt,b,env) -> + let nctxt = + list_map_i (fun i (x,ty) -> + (x,cbv_norm_term info (subs_liftn i env) ty)) 0 ctxt in + compose_lam (List.rev nctxt) (cbv_norm_term info (subs_liftn n env) b) | FIXP ((lij,(names,lty,bds)),env,args) -> - applistc + mkApp (mkFix (lij, (names, Array.map (cbv_norm_term info env) lty, Array.map (cbv_norm_term info - (subs_liftn (Array.length lty) env)) bds))) - (List.map (cbv_norm_value info) args) + (subs_liftn (Array.length lty) env)) bds)), + Array.map (cbv_norm_value info) args) | COFIXP ((j,(names,lty,bds)),env,args) -> - applistc + mkApp (mkCoFix (j, (names,Array.map (cbv_norm_term info env) lty, Array.map (cbv_norm_term info - (subs_liftn (Array.length lty) env)) bds))) - (List.map (cbv_norm_value info) args) + (subs_liftn (Array.length lty) env)) bds)), + Array.map (cbv_norm_value info) args) | CONSTR (c,args) -> - applistc - (mkConstruct c) - (List.map (cbv_norm_value info) args) + mkApp(mkConstruct c, Array.map (cbv_norm_value info) args) (* with profiling *) let cbv_norm infos constr = diff --git a/pretyping/cbv.mli b/pretyping/cbv.mli index dfdf12dd..8c969e2c 100644 --- a/pretyping/cbv.mli +++ b/pretyping/cbv.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: cbv.mli 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: cbv.mli 8799 2006-05-09 21:15:07Z barras $ i*) (*i*) open Names @@ -29,19 +29,19 @@ val cbv_norm : cbv_infos -> constr -> constr (*i This is for cbv debug *) type cbv_value = | VAL of int * constr - | LAM of name * constr * constr * cbv_value subs - | FIXP of fixpoint * cbv_value subs * cbv_value list - | COFIXP of cofixpoint * cbv_value subs * cbv_value list - | CONSTR of constructor * cbv_value list + | LAM of int * (name * constr) list * constr * cbv_value subs + | FIXP of fixpoint * cbv_value subs * cbv_value array + | COFIXP of cofixpoint * cbv_value subs * cbv_value array + | CONSTR of constructor * cbv_value array val shift_value : int -> cbv_value -> cbv_value type cbv_stack = | TOP - | APP of cbv_value list * cbv_stack + | APP of cbv_value array * cbv_stack | CASE of constr * constr array * case_info * cbv_value subs * cbv_stack -val stack_app : cbv_value list -> cbv_stack -> cbv_stack +val stack_app : cbv_value array -> cbv_stack -> cbv_stack val strip_appl : cbv_value -> cbv_stack -> cbv_value * cbv_stack (* recursive functions... *) diff --git a/pretyping/clenv.ml b/pretyping/clenv.ml index 0b88b14b..6113ec2d 100644 --- a/pretyping/clenv.ml +++ b/pretyping/clenv.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: clenv.ml 8688 2006-04-07 15:08:12Z msozeau $ *) +(* $Id: clenv.ml 8752 2006-04-27 19:37:33Z herbelin $ *) open Pp open Util @@ -84,10 +84,10 @@ let clenv_environments evd bound c = let dep = dependent (mkRel 1) c2 in let na' = if dep then na else Anonymous in let e' = meta_declare mv c1 ~name:na' e in - clrec (e', (mkMeta mv)::metas) (option_app ((+) (-1)) n) + clrec (e', (mkMeta mv)::metas) (option_map ((+) (-1)) n) (if dep then (subst1 (mkMeta mv) c2) else c2) | (n, LetIn (na,b,_,c)) -> - clrec (e,metas) (option_app ((+) (-1)) n) (subst1 b c) + clrec (e,metas) (option_map ((+) (-1)) n) (subst1 b c) | (n, _) -> (e, List.rev metas, c) in clrec (evd,[]) bound c @@ -100,10 +100,10 @@ let clenv_environments_evars env evd bound c = | (n, Prod (na,c1,c2)) -> let e',constr = Evarutil.new_evar e env c1 in let dep = dependent (mkRel 1) c2 in - clrec (e', constr::ts) (option_app ((+) (-1)) n) + clrec (e', constr::ts) (option_map ((+) (-1)) n) (if dep then (subst1 constr c2) else c2) | (n, LetIn (na,b,_,c)) -> - clrec (e,ts) (option_app ((+) (-1)) n) (subst1 b c) + clrec (e,ts) (option_map ((+) (-1)) n) (subst1 b c) | (n, _) -> (e, List.rev ts, c) in clrec (evd,[]) bound c diff --git a/pretyping/coercion.ml b/pretyping/coercion.ml index e01dac47..d0ee913f 100644 --- a/pretyping/coercion.ml +++ b/pretyping/coercion.ml @@ -5,7 +5,7 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: coercion.ml 8695 2006-04-10 16:33:52Z msozeau $ *) +(* $Id: coercion.ml 8875 2006-05-29 19:59:11Z msozeau $ *) open Util open Names @@ -35,6 +35,12 @@ module type S = sig type a sort; it fails if no coercion is applicable *) val inh_coerce_to_sort : loc -> env -> evar_defs -> unsafe_judgment -> evar_defs * unsafe_type_judgment + + (* [inh_coerce_to_base env isevars j] coerces [j] to its base type; i.e. it + inserts a coercion into [j], if needed, in such a way it gets as + type its base type (the notion depends on the coercion system) *) + val inh_coerce_to_base : loc -> + env -> evar_defs -> unsafe_judgment -> evar_defs * unsafe_judgment (* [inh_conv_coerce_to 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 @@ -143,6 +149,8 @@ module Default = struct | _ -> inh_tosort_force loc env isevars j + let inh_coerce_to_base loc env isevars j = (isevars, j) + let inh_coerce_to_fail env isevars c1 v t = let v', t' = try @@ -168,7 +176,7 @@ module Default = struct (match kind_of_term (whd_betadeltaiota env (evars_of isevars) t), kind_of_term (whd_betadeltaiota env (evars_of isevars) c1) with | Prod (_,t1,t2), Prod (name,u1,u2) -> - let v' = option_app (whd_betadeltaiota env (evars_of isevars)) v in + let v' = option_map (whd_betadeltaiota env (evars_of isevars)) v in let (evd',b) = match v' with Some v' -> @@ -184,7 +192,7 @@ module Default = struct let env1 = push_rel (x,None,v1) env in let (evd'', v2', t2') = inh_conv_coerce_to_fail loc env1 evd' (Some v2) t2 u2 in - (evd'', option_app (fun v2' -> mkLambda (x, v1, v2')) v2', + (evd'', option_map (fun v2' -> mkLambda (x, v1, v2')) v2', mkProd (x, v1, t2')) | None -> (* Mismatch on t1 and u1 or not a lambda: we eta-expand *) @@ -201,7 +209,7 @@ module Default = struct let (evd'', v2', t2') = let v2 = match v with - Some v -> option_app (fun v1' -> mkApp (lift 1 v, [|v1'|])) v1' + Some v -> option_map (fun v1' -> mkApp (lift 1 v, [|v1'|])) v1' | None -> None and evd', t2 = match v1' with @@ -212,7 +220,7 @@ module Default = struct in inh_conv_coerce_to_fail loc env1 evd' v2 t2 u2 in - (evd'', option_app (fun v2' -> mkLambda (name, u1, v2')) v2', + (evd'', option_map (fun v2' -> mkLambda (name, u1, v2')) v2', mkProd (name, u1, t2'))) | _ -> raise NoCoercion)) diff --git a/pretyping/coercion.mli b/pretyping/coercion.mli index f675beff..42ce27fd 100644 --- a/pretyping/coercion.mli +++ b/pretyping/coercion.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: coercion.mli 8688 2006-04-07 15:08:12Z msozeau $ i*) +(*i $Id: coercion.mli 8875 2006-05-29 19:59:11Z msozeau $ i*) (*i*) open Util @@ -33,13 +33,19 @@ module type S = sig type a sort; it fails if no coercion is applicable *) val inh_coerce_to_sort : loc -> env -> evar_defs -> unsafe_judgment -> evar_defs * unsafe_type_judgment + + (* [inh_coerce_to_base env isevars j] coerces [j] to its base type; i.e. it + inserts a coercion into [j], if needed, in such a way it gets as + type its base type (the notion depends on the coercion system) *) + val inh_coerce_to_base : loc -> + env -> evar_defs -> unsafe_judgment -> evar_defs * unsafe_judgment (* [inh_conv_coerce_to 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 -> env -> evar_defs -> unsafe_judgment -> type_constraint_type -> evar_defs * unsafe_judgment - + (* [inh_conv_coerces_to loc env isevars t t'] checks if an object of type [t] is coercible to an object of type [t'] adding evar constraints if needed; it fails if no coercion exists *) diff --git a/pretyping/detyping.ml b/pretyping/detyping.ml index 3f2aed34..7a170bcf 100644 --- a/pretyping/detyping.ml +++ b/pretyping/detyping.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: detyping.ml 8624 2006-03-13 17:38:17Z msozeau $ *) +(* $Id: detyping.ml 8875 2006-05-29 19:59:11Z msozeau $ *) open Pp open Util @@ -277,6 +277,25 @@ let extract_nondep_branches test c b n = | _ -> assert false in if test c n then Some (strip n b) else None +let it_destRLambda_or_LetIn_names n c = + let rec aux n nal c = + if n=0 then (List.rev nal,c) else match c with + | RLambda (_,na,_,c) -> aux (n-1) (na::nal) c + | RLetIn (_,na,_,c) -> aux (n-1) (na::nal) c + | _ -> + (* eta-expansion *) + let rec next l = + let x = Nameops.next_ident_away (id_of_string "x") l in + (* Not efficient but unusual and no function to get free rawvars *) + if occur_rawconstr x c then next (x::l) else x in + let x = next [] in + let a = RVar (dl,x) in + aux (n-1) (Name x :: nal) + (match c with + | RApp (loc,p,l) -> RApp (loc,c,l@[a]) + | _ -> (RApp (dl,c,[a]))) + in aux n [] c + let detype_case computable detype detype_eqns testdep avoid data p c bl = let (indsp,st,nparams,consnargsl,k) = data in let synth_type = synthetize_type () in @@ -286,32 +305,16 @@ let detype_case computable detype detype_eqns testdep avoid data p c bl = then Anonymous, None, None else - match option_app detype p with + match option_map detype p with | None -> Anonymous, None, None | Some p -> - let decompose_lam k c = - let rec lamdec_rec l avoid k c = - if k = 0 then List.rev l,c else match c with - | RLambda (_,x,t,c) -> - lamdec_rec (x::l) (name_cons x avoid) (k-1) c - | c -> - let x = next_ident_away (id_of_string "x") avoid in - lamdec_rec ((Name x)::l) (x::avoid) (k-1) - (let a = RVar (dl,x) in - match c with - | RApp (loc,p,l) -> RApp (loc,p,l@[a]) - | _ -> (RApp (dl,c,[a]))) - in - lamdec_rec [] [] k c in - let nl,typ = decompose_lam k p in + let nl,typ = it_destRLambda_or_LetIn_names k p in let n,typ = match typ with | RLambda (_,x,t,c) -> x, c | _ -> Anonymous, typ in let aliastyp = if List.for_all ((=) Anonymous) nl then None - else - let pars = list_tabulate (fun _ -> Anonymous) nparams in - Some (dl,indsp,pars@nl) in + else Some (dl,indsp,nparams,nl) in n, aliastyp, Some typ in let constructs = Array.init (Array.length bl) (fun i -> (indsp,i+1)) in @@ -331,22 +334,7 @@ let detype_case computable detype detype_eqns testdep avoid data p c bl = match tag with | LetStyle when aliastyp = None -> let bl' = Array.map detype bl in - let rec decomp_lam_force n avoid l p = - if n = 0 then (List.rev l,p) else - match p with - | RLambda (_,na,_,c) -> - decomp_lam_force (n-1) (name_cons na avoid) (na::l) c - | RLetIn (_,na,_,c) -> - decomp_lam_force (n-1) (name_cons na avoid) (na::l) c - | _ -> - let x = Nameops.next_ident_away (id_of_string "x") avoid in - decomp_lam_force (n-1) (x::avoid) (Name x :: l) - (* eta-expansion *) - (let a = RVar (dl,x) in - match p with - | RApp (loc,p,l) -> RApp (loc,p,l@[a]) - | _ -> (RApp (dl,p,[a]))) in - let (nal,d) = decomp_lam_force consnargsl.(0) avoid [] bl'.(0) in + let (nal,d) = it_destRLambda_or_LetIn_names consnargsl.(0) bl'.(0) in RLetTuple (dl,nal,(alias,pred),tomatch,d) | IfStyle when aliastyp = None -> let bl' = Array.map detype bl in @@ -360,6 +348,10 @@ let detype_case computable detype detype_eqns testdep avoid data p c bl = | _ -> RCases (dl,pred,[tomatch,(alias,aliastyp)],eqnl) +let detype_sort = function + | Prop c -> RProp c + | Type u -> RType (Some u) + (**********************************************************************) (* Main detyping function *) @@ -380,10 +372,9 @@ let rec detype isgoal avoid env t = let _ = Global.lookup_named id in RRef (dl, VarRef id) with _ -> RVar (dl, id)) - | Sort (Prop c) -> RSort (dl,RProp c) - | Sort (Type u) -> RSort (dl,RType (Some u)) + | Sort s -> RSort (dl,detype_sort s) | Cast (c1,k,c2) -> - RCast(dl,detype isgoal avoid env c1, k, + RCast(dl,detype isgoal avoid env c1, CastConv k, detype isgoal avoid env c2) | Prod (na,ty,c) -> detype_binder isgoal BProd avoid env na ty c | Lambda (na,ty,c) -> detype_binder isgoal BLambda avoid env na ty c @@ -421,7 +412,7 @@ and detype_fix isgoal avoid env (vn,_ as nvn) (names,tys,bodies) = let v = array_map3 (fun c t i -> share_names isgoal (i+1) [] def_avoid def_env c (lift n t)) bodies tys vn in - RRec(dl,RFix (Array.map (fun i -> i, RStructRec) (fst nvn), snd nvn),Array.of_list (List.rev lfi), + RRec(dl,RFix (Array.map (fun i -> Some i, RStructRec) (fst nvn), snd nvn),Array.of_list (List.rev lfi), Array.map (fun (bl,_,_) -> bl) v, Array.map (fun (_,_,ty) -> ty) v, Array.map (fun (_,bd,_) -> bd) v) @@ -587,9 +578,9 @@ let rec subst_rawconstr subst raw = let a' = subst_rawconstr subst a in let (n,topt) = x in let topt' = option_smartmap - (fun (loc,(sp,i),x as t) -> + (fun (loc,(sp,i),x,y as t) -> let sp' = subst_kn subst sp in - if sp == sp' then t else (loc,(sp',i),x)) topt in + if sp == sp' then t else (loc,(sp',i),x,y)) topt in if a == a' && topt == topt' then y else (a',(n,topt'))) rl and branches' = list_smartmap (fun (loc,idl,cpl,r as branch) -> @@ -645,3 +636,18 @@ let rec subst_rawconstr subst raw = RCast (loc,r1',k,r2') | RDynamic _ -> raw + +(* Utilities to transform kernel cases to simple pattern-matching problem *) + +let simple_cases_matrix_of_branches ind brns brs = + list_map2_i (fun i n b -> + let nal,c = it_destRLambda_or_LetIn_names n b in + let mkPatVar na = PatVar (dummy_loc,na) in + let p = PatCstr (dummy_loc,(ind,i+1),List.map mkPatVar nal,Anonymous) in + let ids = map_succeed Nameops.out_name nal in + (dummy_loc,ids,[p],c)) + 0 brns brs + +let return_type_of_predicate ind nparams n pred = + let nal,p = it_destRLambda_or_LetIn_names (n+1) pred in + (List.hd nal, Some (dummy_loc, ind, nparams, List.tl nal)), Some p diff --git a/pretyping/detyping.mli b/pretyping/detyping.mli index 0b35728c..bbe2fcc9 100644 --- a/pretyping/detyping.mli +++ b/pretyping/detyping.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: detyping.mli 7881 2006-01-16 14:03:05Z herbelin $ i*) +(*i $Id: detyping.mli 8831 2006-05-19 09:29:54Z herbelin $ i*) (*i*) open Util @@ -38,6 +38,8 @@ val detype_case : identifier list -> inductive * case_style * int * int array * int -> 'a option -> 'a -> 'a array -> rawconstr +val detype_sort : sorts -> rawsort + (* look for the index of a named var or a nondep var as it is renamed *) val lookup_name_as_renamed : env -> constr -> identifier -> int option val lookup_index_as_renamed : env -> constr -> int -> int option @@ -47,3 +49,12 @@ val force_wildcard : unit -> bool val synthetize_type : unit -> bool val force_if : case_info -> bool val force_let : case_info -> bool + +(* Utilities to transform kernel cases to simple pattern-matching problem *) + +val it_destRLambda_or_LetIn_names : int -> rawconstr -> name list * rawconstr +val simple_cases_matrix_of_branches : + inductive -> int list -> rawconstr list -> cases_clauses +val return_type_of_predicate : + inductive -> int -> int -> rawconstr -> predicate_pattern * rawconstr option + diff --git a/pretyping/evarconv.ml b/pretyping/evarconv.ml index 2b04b693..458f5bd3 100644 --- a/pretyping/evarconv.ml +++ b/pretyping/evarconv.ml @@ -6,14 +6,14 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: evarconv.ml 8111 2006-03-02 17:23:41Z herbelin $ *) +(* $Id: evarconv.ml 8793 2006-05-05 17:41:41Z barras $ *) open Util open Names open Term +open Closure open Reduction open Reductionops -open Closure open Environ open Typing open Classops @@ -41,7 +41,7 @@ let eval_flexible_term env c = match kind_of_term c with | Const c -> constant_opt_value env c | Rel n -> - (try let (_,v,_) = lookup_rel n env in option_app (lift n) v + (try let (_,v,_) = lookup_rel n env in option_map (lift n) v with Not_found -> None) | Var id -> (try let (_,v,_) = lookup_named id env in v with Not_found -> None) diff --git a/pretyping/evarutil.ml b/pretyping/evarutil.ml index aeaaefef..506cd03f 100644 --- a/pretyping/evarutil.ml +++ b/pretyping/evarutil.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: evarutil.ml 8695 2006-04-10 16:33:52Z msozeau $ *) +(* $Id: evarutil.ml 8759 2006-04-28 12:24:14Z herbelin $ *) open Util open Pp @@ -35,7 +35,7 @@ exception Uninstantiated_evar of existential_key let rec whd_ise sigma c = match kind_of_term c with - | Evar (ev,args) when Evd.in_dom sigma ev -> + | Evar (ev,args) when Evd.mem sigma ev -> if Evd.is_defined sigma ev then whd_ise sigma (existential_value sigma (ev,args)) else raise (Uninstantiated_evar ev) @@ -46,7 +46,7 @@ let rec whd_ise sigma c = let whd_castappevar_stack sigma c = let rec whrec (c, l as s) = match kind_of_term c with - | Evar (ev,args) when Evd.in_dom sigma ev & Evd.is_defined sigma ev -> + | Evar (ev,args) when Evd.mem sigma ev & Evd.is_defined sigma ev -> whrec (existential_value sigma (ev,args), l) | Cast (c,_,_) -> whrec (c, l) | App (f,args) -> whrec (f, Array.fold_right (fun a l -> a::l) args l) @@ -93,7 +93,7 @@ let collect_evars emap c = let rec collrec acc c = match kind_of_term c with | Evar (k,_) -> - if Evd.in_dom emap k & not (Evd.is_defined emap k) then k::acc + if Evd.mem emap k & not (Evd.is_defined emap k) then k::acc else (* No recursion on the evar instantiation *) acc | _ -> fold_constr collrec acc c in @@ -103,13 +103,14 @@ let push_dependent_evars sigma emap = Evd.fold (fun ev {evar_concl = ccl} (sigma',emap') -> List.fold_left (fun (sigma',emap') ev -> - (Evd.add sigma' ev (Evd.map emap' ev),Evd.rmv emap' ev)) + (Evd.add sigma' ev (Evd.find emap' ev),Evd.remove emap' ev)) (sigma',emap') (collect_evars emap' ccl)) emap (sigma,emap) (* replaces a mapping of existentials into a mapping of metas. Problem if an evar appears in the type of another one (pops anomaly) *) let evars_to_metas sigma (emap, c) = + let emap = nf_evars emap in let sigma',emap' = push_dependent_evars sigma emap in let change_exist evar = let ty = nf_betaiota (nf_evar emap (existential_type emap evar)) in @@ -117,7 +118,7 @@ let evars_to_metas sigma (emap, c) = mkCast (mkMeta n, DEFAULTcast, ty) in let rec replace c = match kind_of_term c with - Evar (k,_ as ev) when Evd.in_dom emap' k -> change_exist ev + Evar (k,_ as ev) when Evd.mem emap' k -> change_exist ev | _ -> map_constr replace c in (sigma', replace c) @@ -209,7 +210,7 @@ let push_rel_context_to_named_context env = let id = next_name_away na avoid in ((mkVar id)::subst, id::avoid, - push_named (id,option_app (substl subst) c, + push_named (id,option_map (substl subst) c, type_app (substl subst) t) env)) (rel_context env) ~init:([],ids_of_named_context (named_context env),env) @@ -297,7 +298,7 @@ let is_defined_equation env evd (ev,inst) rhs = is_pattern inst && not (occur_evar ev rhs) && try - let evi = Evd.map (evars_of evd) ev in + let evi = Evd.find (evars_of evd) ev in let (evd',body) = inverse_instance env evd ev evi inst rhs in evar_well_typed_body evd' ev evi body with Failure _ -> false @@ -313,7 +314,7 @@ let is_defined_equation env evd (ev,inst) rhs = let do_restrict_hyps evd ev args = let args = Array.to_list args in - let evi = Evd.map (evars_of !evd) ev in + let evi = Evd.find (evars_of !evd) ev in let env = evar_env evi in let hyps = evar_context evi in let (sign,ncargs) = list_filter2 (fun _ a -> closed0 a) (hyps,args) in @@ -395,7 +396,7 @@ let evar_define env (ev,argsv) rhs isevars = if occur_evar ev rhs then error_occur_check env (evars_of isevars) ev rhs; let args = Array.to_list argsv in - let evi = Evd.map (evars_of isevars) ev in + let evi = Evd.find (evars_of isevars) ev in (* the bindings to invert *) let worklist = make_subst (evar_env evi) args in let (isevars',body) = real_clean env isevars ev evi worklist rhs in @@ -502,7 +503,7 @@ let status_changed lev (pbty,t1,t2) = let solve_refl conv_algo env isevars ev argsv1 argsv2 = if argsv1 = argsv2 then (isevars,[]) else - let evd = Evd.map (evars_of isevars) ev in + let evd = Evd.find (evars_of isevars) ev in let hyps = evar_context evd in let (isevars',_,rsign) = array_fold_left2 @@ -599,7 +600,7 @@ let mk_valcon c = Some c cumulativity now includes Prop and Set in Type... It is, but that's not too bad *) let define_evar_as_abstraction abs evd (ev,args) = - let evi = Evd.map (evars_of evd) ev in + let evi = Evd.find (evars_of evd) ev in let evenv = evar_env evi in let (evd1,dom) = new_evar evd evenv (new_Type()) in let nvar = @@ -679,7 +680,7 @@ let lift_abstr_tycon_type n (abs, t) = else (Some (init, abs'), t) let lift_tycon_type n (abs, t) = (abs, lift n t) -let lift_tycon n = option_app (lift_tycon_type n) +let lift_tycon n = option_map (lift_tycon_type n) let pr_tycon_type env (abs, t) = match abs with diff --git a/pretyping/evd.ml b/pretyping/evd.ml index c9f771c9..33f88ebd 100644 --- a/pretyping/evd.ml +++ b/pretyping/evd.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: evd.ml 8688 2006-04-07 15:08:12Z msozeau $ *) +(* $Id: evd.ml 8759 2006-04-28 12:24:14Z herbelin $ *) open Pp open Util @@ -48,17 +48,16 @@ let empty = Evarmap.empty let to_list evc = Evarmap.fold (fun ev x acc -> (ev,x)::acc) evc [] let dom evc = Evarmap.fold (fun ev _ acc -> ev::acc) evc [] -let map evc k = Evarmap.find k evc -let rmv evc k = Evarmap.remove k evc -let remap evc k i = Evarmap.add k i evc -let in_dom evc k = Evarmap.mem k evc +let find evc k = Evarmap.find k evc +let remove evc k = Evarmap.remove k evc +let mem evc k = Evarmap.mem k evc let fold = Evarmap.fold let add evd ev newinfo = Evarmap.add ev newinfo evd let define evd ev body = let oldinfo = - try map evd ev + try find evd ev with Not_found -> error "Evd.define: cannot define undeclared evar" in let newinfo = { evar_concl = oldinfo.evar_concl; @@ -68,10 +67,10 @@ let define evd ev body = | Evar_empty -> Evarmap.add ev newinfo evd | _ -> anomaly "Evd.define: cannot define an isevar twice" -let is_evar sigma ev = in_dom sigma ev +let is_evar sigma ev = mem sigma ev let is_defined sigma ev = - let info = map sigma ev in + let info = find sigma ev in not (info.evar_body = Evar_empty) let evar_body ev = ev.evar_body @@ -112,7 +111,7 @@ let instantiate_evar sign c args = let existential_type sigma (n,args) = let info = - try map sigma n + try find sigma n with Not_found -> anomaly ("Evar "^(string_of_existential n)^" was not declared") in let hyps = evar_context info in @@ -121,7 +120,7 @@ let existential_type sigma (n,args) = exception NotInstantiatedEvar let existential_value sigma (n,args) = - let info = map sigma n in + let info = find sigma n in let hyps = evar_context info in match evar_body info with | Evar_defined c -> @@ -270,10 +269,9 @@ type evar_map = evar_map1 * sort_constraints let empty = empty, UniverseMap.empty let add (sigma,sm) k v = (add sigma k v, sm) let dom (sigma,_) = dom sigma -let map (sigma,_) = map sigma -let rmv (sigma,sm) k = (rmv sigma k, sm) -let remap (sigma,sm) k v = (remap sigma k v, sm) -let in_dom (sigma,_) = in_dom sigma +let find (sigma,_) = find sigma +let remove (sigma,sm) k = (remove sigma k, sm) +let mem (sigma,_) = mem sigma let to_list (sigma,_) = to_list sigma let fold f (sigma,_) = fold f sigma let define (sigma,sm) k v = (define sigma k v, sm) diff --git a/pretyping/evd.mli b/pretyping/evd.mli index 40ecce6e..cbc96b04 100644 --- a/pretyping/evd.mli +++ b/pretyping/evd.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: evd.mli 8688 2006-04-07 15:08:12Z msozeau $ i*) +(*i $Id: evd.mli 8759 2006-04-28 12:24:14Z herbelin $ i*) (*i*) open Util @@ -43,10 +43,9 @@ val empty : evar_map val add : evar_map -> evar -> evar_info -> evar_map val dom : evar_map -> evar list -val map : evar_map -> evar -> evar_info -val rmv : evar_map -> evar -> evar_map -val remap : evar_map -> evar -> evar_info -> evar_map -val in_dom : evar_map -> evar -> bool +val find : evar_map -> evar -> evar_info +val remove : evar_map -> evar -> evar_map +val mem : evar_map -> evar -> bool val to_list : evar_map -> (evar * evar_info) list val fold : (evar -> evar_info -> 'a -> 'a) -> evar_map -> 'a -> 'a diff --git a/pretyping/indrec.ml b/pretyping/indrec.ml index a587dd20..07ca5d83 100644 --- a/pretyping/indrec.ml +++ b/pretyping/indrec.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: indrec.ml 7662 2005-12-17 22:03:35Z herbelin $ *) +(* $Id: indrec.ml 8845 2006-05-23 07:41:58Z herbelin $ *) open Pp open Util @@ -48,13 +48,13 @@ let mkLambda_string s t c = mkLambda (Name (id_of_string s), t, c) lift_constructor et lift_inductive_family qui ne se contentent pas de lifter les paramètres globaux *) -let mis_make_case_com depopt env sigma (ind,mib,mip) kind = +let mis_make_case_com depopt env sigma ind (mib,mip as specif) kind = let lnamespar = mib.mind_params_ctxt in let dep = match depopt with - | None -> mip.mind_sort <> (Prop Null) + | None -> inductive_sort_family mip <> InProp | Some d -> d in - if not (List.exists ((=) kind) mip.mind_kelim) then + if not (List.mem kind (elim_sorts specif)) then raise (RecursionSchemeError (NotAllowedCaseAnalysis @@ -431,7 +431,7 @@ let mis_make_indrec env sigma listdepkind mib = it_mkLambda_or_LetIn_name env (put_arity env' 0 listdepkind) lnamesparrec else - mis_make_case_com (Some dep) env sigma (indi,mibi,mipi) kind + mis_make_case_com (Some dep) env sigma indi (mibi,mipi) kind in (* Body of mis_make_indrec *) list_tabulate make_one_rec nrec @@ -441,7 +441,7 @@ let mis_make_indrec env sigma listdepkind mib = let make_case_com depopt env sigma ity kind = let (mib,mip) = lookup_mind_specif env ity in - mis_make_case_com depopt env sigma (ity,mib,mip) kind + mis_make_case_com depopt env sigma ity (mib,mip) kind let make_case_dep env = make_case_com (Some true) env let make_case_nodep env = make_case_com (Some false) env @@ -504,7 +504,7 @@ let check_arities listdepkind = let _ = List.fold_left (fun ln ((_,ni),mibi,mipi,dep,kind) -> let id = mipi.mind_typename in - let kelim = mipi.mind_kelim in + let kelim = elim_sorts (mibi,mipi) in if not (List.exists ((=) kind) kelim) then raise (RecursionSchemeError (BadInduction (dep,id,new_sort_in_family kind))) else if List.mem ni ln then raise @@ -534,7 +534,7 @@ let build_mutual_indrec env sigma = function let build_indrec env sigma ind = let (mib,mip) = lookup_mind_specif env ind in - let kind = family_of_sort mip.mind_sort in + let kind = inductive_sort_family mip in let dep = kind <> InProp in List.hd (mis_make_indrec env sigma [(ind,mib,mip,dep,kind)] mib) @@ -596,7 +596,7 @@ let lookup_eliminator ind_sp s = pr_id id ++ spc () ++ str "The elimination of the inductive definition " ++ pr_id id ++ spc () ++ str "on sort " ++ - spc () ++ print_sort_family s ++ + spc () ++ pr_sort_family s ++ str " is probably not allowed") @@ -617,6 +617,6 @@ let lookup_eliminator ind_sp s = pr_id id ++ spc () ++ str "The elimination of the inductive definition " ++ pr_id base ++ spc () ++ str "on sort " ++ - spc () ++ print_sort_family s ++ + spc () ++ pr_sort_family s ++ str " is probably not allowed") *) diff --git a/pretyping/inductiveops.ml b/pretyping/inductiveops.ml index 57d966f1..e0cdeeee 100644 --- a/pretyping/inductiveops.ml +++ b/pretyping/inductiveops.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: inductiveops.ml 8653 2006-03-22 09:41:17Z herbelin $ *) +(* $Id: inductiveops.ml 8845 2006-05-23 07:41:58Z herbelin $ *) open Util open Names @@ -116,11 +116,15 @@ let constructor_nrealhyps env (ind,j) = let (mib,mip) = Inductive.lookup_mind_specif env ind in mip.mind_consnrealdecls.(j-1) +let get_full_arity_sign env ind = + let (mib,mip) = Inductive.lookup_mind_specif env ind in + mip.mind_arity_ctxt + (* Length of arity (w/o local defs) *) let inductive_nargs env ind = let (mib,mip) = Inductive.lookup_mind_specif env ind in - mip.mind_nrealargs + rel_context_nhyps mib.mind_params_ctxt + mib.mind_nparams, mip.mind_nrealargs (* Annotation for cases *) let make_case_info env ind style pats_source = @@ -196,10 +200,40 @@ let rec instantiate args c = match kind_of_term c, args with | _, [] -> c | _ -> anomaly "too short arity" +(* substitution in a signature *) + +let substnl_rel_context subst n sign = + let rec aux n = function + | d::sign -> substnl_decl subst n d :: aux (n+1) sign + | [] -> [] + in List.rev (aux n (List.rev sign)) + +let substl_rel_context subst = substnl_rel_context subst 0 + +let rec instantiate_context sign args = + let rec aux subst = function + | (_,None,_)::sign, a::args -> aux (a::subst) (sign,args) + | (_,Some b,_)::sign, args -> aux (substl subst b::subst) (sign,args) + | [], [] -> subst + | _ -> anomaly "Signature/instance mismatch in inductive family" + in aux [] (List.rev sign,args) + let get_arity env (ind,params) = let (mib,mip) = Inductive.lookup_mind_specif env ind in - let arity = mip.mind_nf_arity in - destArity (instantiate params arity) + let parsign = + (* Dynamically detect if called with an instance of recursively + uniform parameter only or also of non recursively uniform + parameters *) + let parsign = mib.mind_params_ctxt in + let nnonrecparams = mib.mind_nparams - mib.mind_nparams_rec in + if List.length params = rel_context_nhyps parsign - nnonrecparams then + snd (list_chop nnonrecparams mib.mind_params_ctxt) + else + parsign in + let arproperlength = List.length mip.mind_arity_ctxt - List.length parsign in + let arsign,_ = list_chop arproperlength mip.mind_arity_ctxt in + let subst = instantiate_context parsign params in + (substl_rel_context subst arsign, Inductive.inductive_sort_family mip) (* Functions to build standard types related to inductive *) let build_dependent_constructor cs = @@ -284,12 +318,12 @@ let find_coinductive env sigma c = (* find appropriate names for pattern variables. Useful in the Case and Inversion (case_then_using et case_nodep_then_using) tactics. *) -let is_predicate_explicitly_dep env pred nodep_ar = - let rec srec env pval nodep_ar = +let is_predicate_explicitly_dep env pred arsign = + let rec srec env pval arsign = let pv' = whd_betadeltaiota env Evd.empty pval in - match kind_of_term pv', kind_of_term nodep_ar with - | Lambda (na,t,b), Prod (_,_,a') -> - srec (push_rel_assum (na,t) env) b a' + match kind_of_term pv', arsign with + | Lambda (na,t,b), (_,None,_)::arsign -> + srec (push_rel_assum (na,t) env) b arsign | Lambda (na,_,_), _ -> (* The following code has impact on the introduction names @@ -317,12 +351,11 @@ let is_predicate_explicitly_dep env pred nodep_ar = | _ -> anomaly "Non eta-expanded dep-expanded \"match\" predicate" in - srec env pred nodep_ar + srec env pred arsign let is_elim_predicate_explicitly_dependent env pred indf = - let arsign,s = get_arity env indf in - let glob_t = it_mkProd_or_LetIn (mkSort s) arsign in - is_predicate_explicitly_dep env pred glob_t + let arsign,_ = get_arity env indf in + is_predicate_explicitly_dep env pred arsign let set_names env n brty = let (ctxt,cl) = decompose_prod_n_assum n brty in diff --git a/pretyping/inductiveops.mli b/pretyping/inductiveops.mli index 2993eed3..dcd86716 100644 --- a/pretyping/inductiveops.mli +++ b/pretyping/inductiveops.mli @@ -6,13 +6,14 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: inductiveops.mli 7955 2006-01-30 22:56:15Z herbelin $ i*) +(*i $Id: inductiveops.mli 8845 2006-05-23 07:41:58Z herbelin $ i*) open Names open Term open Declarations open Environ open Evd +open Sign (* The following three functions are similar to the ones defined in Inductive, but they expect an env *) @@ -42,8 +43,7 @@ val dest_ind_type : inductive_type -> inductive_family * constr list val map_inductive_type : (constr -> constr) -> inductive_type -> inductive_type val liftn_inductive_type : int -> int -> inductive_type -> inductive_type val lift_inductive_type : int -> inductive_type -> inductive_type -val substnl_ind_type : - constr list -> int -> inductive_type -> inductive_type +val substnl_ind_type : constr list -> int -> inductive_type -> inductive_type val mkAppliedInd : inductive_type -> constr val mis_is_recursive_subset : int list -> wf_paths -> bool @@ -51,16 +51,22 @@ val mis_is_recursive : inductive * mutual_inductive_body * one_inductive_body -> bool val mis_nf_constructor_type : inductive * mutual_inductive_body * one_inductive_body -> int -> constr -val mis_constr_nargs : inductive -> int array +(* Extract information from an inductive name *) + +val mis_constr_nargs : inductive -> int array val mis_constr_nargs_env : env -> inductive -> int array -val mis_constructor_nargs_env : env -> constructor -> int +(* Return number of expected parameters and of expected real arguments *) +val inductive_nargs : env -> inductive -> int * int +val mis_constructor_nargs_env : env -> constructor -> int val constructor_nrealargs : env -> constructor -> int val constructor_nrealhyps : env -> constructor -> int -val inductive_nargs : env -> inductive -> int +val get_full_arity_sign : env -> inductive -> rel_context + +(* Extract information from an inductive family *) type constructor_summary = { cs_cstr : constructor; @@ -68,17 +74,16 @@ type constructor_summary = { cs_nargs : int; cs_args : Sign.rel_context; cs_concl_realargs : constr array; -} +} val lift_constructor : int -> constructor_summary -> constructor_summary val get_constructor : inductive * mutual_inductive_body * one_inductive_body * constr list -> int -> constructor_summary -val get_arity : env -> inductive_family -> Sign.arity +val get_arity : env -> inductive_family -> rel_context * sorts_family val get_constructors : env -> inductive_family -> constructor_summary array val build_dependent_constructor : constructor_summary -> constr val build_dependent_inductive : env -> inductive_family -> constr -val make_arity_signature : - env -> bool -> inductive_family -> Sign.rel_context +val make_arity_signature : env -> bool -> inductive_family -> Sign.rel_context val make_arity : env -> bool -> inductive_family -> sorts -> types val build_branch_type : env -> bool -> constr -> constructor_summary -> types diff --git a/pretyping/matching.ml b/pretyping/matching.ml index 5ee245b5..12c1ea33 100644 --- a/pretyping/matching.ml +++ b/pretyping/matching.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: matching.ml 7970 2006-02-01 15:09:07Z herbelin $ *) +(* $Id: matching.ml 8827 2006-05-17 15:15:34Z jforest $ *) (*i*) open Util @@ -17,6 +17,7 @@ open Termops open Reductionops open Term open Rawterm +open Sign open Environ open Pattern (*i*) @@ -70,6 +71,11 @@ let memb_metavars m n = let eq_context ctxt1 ctxt2 = array_for_all2 eq_constr ctxt1 ctxt2 +let same_case_structure (_,cs1,ind,_) ci2 br1 br2 = + match ind with + | Some ind -> ind = ci2.ci_ind + | None -> cs1 = ci2.ci_cstr_nargs + let matches_core convert allow_partial_app pat c = let rec sorec stk sigma p t = let cT = strip_outer_cast t in @@ -79,7 +85,7 @@ let matches_core convert allow_partial_app pat c = List.map (function | PRel n -> n - | _ -> error "Only bound indices are currently allowed in second order pattern matching") + | _ -> error "Only bound indices allowed in second order pattern matching") args in let frels = Intset.elements (free_rels cT) in if list_subset frels relargs then @@ -150,15 +156,27 @@ let matches_core convert allow_partial_app pat c = if is_conv env evars c cT then sigma else raise PatternMatchingFailure - | PCase (_,_,a1,br1), Case (_,_,a2,br2) -> - (* On ne teste pas le prédicat *) - if (Array.length br1) = (Array.length br2) then - array_fold_left2 (sorec stk) (sorec stk sigma a1 a2) br1 br2 + | PIf (a1,b1,b1'), Case (ci,_,a2,[|b2;b2'|]) -> + let ctx,b2 = decompose_lam_n_assum ci.ci_cstr_nargs.(0) b2 in + let ctx',b2' = decompose_lam_n_assum ci.ci_cstr_nargs.(1) b2' in + let n = List.length ctx and n' = List.length ctx' in + if noccur_between 1 n b2 & noccur_between 1 n' b2' then + let s = List.fold_left (fun l (na,_,t) -> (na,t)::l) stk ctx in + let s' = List.fold_left (fun l (na,_,t) -> (na,t)::l) stk ctx' in + let b1 = lift_pattern n b1 and b1' = lift_pattern n' b1' in + sorec s' (sorec s (sorec stk sigma a1 a2) b1 b2) b1' b2' else raise PatternMatchingFailure - (* À faire *) - | PFix f0, Fix f1 when f0 = f1 -> sigma - | PCoFix c0, CoFix c1 when c0 = c1 -> sigma + + | PCase (ci1,p1,a1,br1), Case (ci2,p2,a2,br2) -> + if same_case_structure ci1 ci2 br1 br2 then + array_fold_left2 (sorec stk) + (sorec stk (sorec stk sigma a1 a2) p1 p2) br1 br2 + else + raise PatternMatchingFailure + + | PFix c1, Fix _ when eq_constr (mkFix c1) cT -> sigma + | PCoFix c1, CoFix _ when eq_constr (mkCoFix c1) cT -> sigma | _ -> raise PatternMatchingFailure in diff --git a/pretyping/pattern.ml b/pretyping/pattern.ml index 390b884c..ef97250a 100644 --- a/pretyping/pattern.ml +++ b/pretyping/pattern.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: pattern.ml 7732 2005-12-26 13:51:24Z herbelin $ *) +(* $Id: pattern.ml 8755 2006-04-27 22:22:15Z herbelin $ *) open Util open Names @@ -38,8 +38,9 @@ type constr_pattern = | PLetIn of name * constr_pattern * constr_pattern | PSort of rawsort | PMeta of patvar option - | PCase of (inductive option * case_style) - * constr_pattern option * constr_pattern * constr_pattern array + | PIf of constr_pattern * constr_pattern * constr_pattern + | PCase of (case_style * int array * inductive option * (int * int) option) + * constr_pattern * constr_pattern * constr_pattern array | PFix of fixpoint | PCoFix of cofixpoint @@ -49,9 +50,10 @@ let rec occur_meta_pattern = function | PLambda (na,t,c) -> (occur_meta_pattern t) or (occur_meta_pattern c) | PProd (na,t,c) -> (occur_meta_pattern t) or (occur_meta_pattern c) | PLetIn (na,t,c) -> (occur_meta_pattern t) or (occur_meta_pattern c) - | PCase(_,None,c,br) -> - (occur_meta_pattern c) or (array_exists occur_meta_pattern br) - | PCase(_,Some p,c,br) -> + | PIf (c,c1,c2) -> + (occur_meta_pattern c) or + (occur_meta_pattern c1) or (occur_meta_pattern c2) + | PCase(_,p,c,br) -> (occur_meta_pattern p) or (occur_meta_pattern c) or (array_exists occur_meta_pattern br) | PMeta _ | PSoApp _ -> true @@ -70,6 +72,7 @@ let rec head_pattern_bound t = | PProd (_,_,b) -> head_pattern_bound b | PLetIn (_,_,b) -> head_pattern_bound b | PApp (c,args) -> head_pattern_bound c + | PIf (c,_,_) -> head_pattern_bound c | PCase (_,p,c,br) -> head_pattern_bound c | PRef r -> r | PVar id -> VarRef id @@ -103,28 +106,43 @@ let rec pattern_of_constr t = | Construct sp -> PRef (ConstructRef sp) | Evar (n,ctxt) -> PEvar (n,Array.map pattern_of_constr ctxt) | Case (ci,p,a,br) -> - PCase ((Some ci.ci_ind,ci.ci_pp_info.style), - Some (pattern_of_constr p),pattern_of_constr a, + let cip = ci.ci_pp_info in + let no = Some (ci.ci_npar,cip.ind_nargs) in + PCase ((cip.style,ci.ci_cstr_nargs,Some ci.ci_ind,no), + pattern_of_constr p,pattern_of_constr a, Array.map pattern_of_constr br) | Fix f -> PFix f | CoFix f -> PCoFix f (* To process patterns, we need a translation without typing at all. *) -let rec inst lvar = function - | PVar id as x -> (try List.assoc id lvar with Not_found -> x) - | PApp (p,pl) -> PApp (inst lvar p, Array.map (inst lvar) pl) - | PSoApp (n,pl) -> PSoApp (n, List.map (inst lvar) pl) - | PLambda (n,a,b) -> PLambda (n,inst lvar a,inst lvar b) - | PProd (n,a,b) -> PProd (n,inst lvar a,inst lvar b) - | PLetIn (n,a,b) -> PLetIn (n,inst lvar a,inst lvar b) - | PCase (ci,po,p,pl) -> - PCase (ci,option_app (inst lvar) po,inst lvar p,Array.map (inst lvar) pl) +let map_pattern_with_binders g f l = function + | PApp (p,pl) -> PApp (f l p, Array.map (f l) pl) + | PSoApp (n,pl) -> PSoApp (n, List.map (f l) pl) + | PLambda (n,a,b) -> PLambda (n,f l a,f (g l) b) + | PProd (n,a,b) -> PProd (n,f l a,f (g l) b) + | PLetIn (n,a,b) -> PLetIn (n,f l a,f (g l) b) + | PIf (c,b1,b2) -> PIf (f l c,f l b1,f l b2) + | PCase (ci,po,p,pl) -> PCase (ci,f l po,f l p,Array.map (f l) pl) (* Non recursive *) - | (PEvar _ | PRel _ | PRef _ | PSort _ | PMeta _ as x) -> x + | (PVar _ | PEvar _ | PRel _ | PRef _ | PSort _ | PMeta _ (* Bound to terms *) - | (PFix _ | PCoFix _) -> - error ("Not instantiable pattern") + | PFix _ | PCoFix _ as x) -> x + +let map_pattern f = map_pattern_with_binders (fun () -> ()) (fun () -> f) () + +let rec instantiate_pattern lvar = function + | PVar id as x -> (try List.assoc id lvar with Not_found -> x) + | (PFix _ | PCoFix _) -> error ("Not instantiable pattern") + | c -> map_pattern (instantiate_pattern lvar) c + +let rec liftn_pattern k n = function + | PRel i as x -> if i >= n then PRel (i+k) else x + | PFix x -> PFix (destFix (liftn k n (mkFix x))) + | PCoFix x -> PCoFix (destCoFix (liftn k n (mkCoFix x))) + | c -> map_pattern_with_binders succ (liftn_pattern k) n c + +let lift_pattern k = liftn_pattern k 1 let rec subst_pattern subst pat = match pat with | PRef ref -> @@ -160,12 +178,20 @@ let rec subst_pattern subst pat = match pat with PLetIn (name,c1',c2') | PSort _ | PMeta _ -> pat - | PCase (cs,typ, c, branches) -> - let typ' = option_smartmap (subst_pattern subst) typ in + | PIf (c,c1,c2) -> + let c' = subst_pattern subst c in + let c1' = subst_pattern subst c1 in + let c2' = subst_pattern subst c2 in + if c' == c && c1' == c1 && c2' == c2 then pat else + PIf (c',c1',c2') + | PCase ((a,b,ind,n as cs),typ,c,branches) -> + let ind' = option_smartmap (Inductiveops.subst_inductive subst) ind in + let typ' = subst_pattern subst typ in let c' = subst_pattern subst c in let branches' = array_smartmap (subst_pattern subst) branches in + let cs' = if ind == ind' then cs else (a,b,ind',n) in if typ' == typ && c' == c && branches' == branches then pat else - PCase(cs,typ', c', branches') + PCase(cs',typ', c', branches') | PFix fixpoint -> let cstr = mkFix fixpoint in let fixpoint' = destFix (subst_mps subst cstr) in @@ -177,8 +203,8 @@ let rec subst_pattern subst pat = match pat with if cofixpoint' == cofixpoint then pat else PCoFix cofixpoint' - -let instantiate_pattern = inst +let mkPLambda na b = PLambda(na,PMeta None,b) +let rev_it_mkPLambda = List.fold_right mkPLambda let rec pat_of_raw metas vars = function | RVar (_,id) -> @@ -212,17 +238,30 @@ let rec pat_of_raw metas vars = function Pp.warning "Cast not taken into account in constr pattern"; pat_of_raw metas vars c | RIf (_,c,(_,None),b1,b2) -> - PCase ((None,IfStyle),None, pat_of_raw metas vars c, - [|pat_of_raw metas vars b1; pat_of_raw metas vars b2|]) - | RCases (loc,None,[c,_],brs) -> - let sp = + PIf (pat_of_raw metas vars c, + pat_of_raw metas vars b1,pat_of_raw metas vars b2) + | RLetTuple (loc,nal,(_,None),b,c) -> + let mkRLambda c na = RLambda (loc,na,RHole (loc,Evd.InternalHole),c) in + let c = List.fold_left mkRLambda c nal in + PCase ((LetStyle,[|1|],None,None),PMeta None,pat_of_raw metas vars b, + [|pat_of_raw metas vars c|]) + | RCases (loc,p,[c,(na,indnames)],brs) -> + let pred,ind_nargs, ind = match p,indnames with + | Some p, Some (_,ind,n,nal) -> + rev_it_mkPLambda nal (mkPLambda na (pat_of_raw metas vars p)), + Some (n,List.length nal),Some ind + | _ -> PMeta None, None, None in + let ind = match ind with Some _ -> ind | None -> match brs with | (_,_,[PatCstr(_,(ind,_),_,_)],_)::_ -> Some ind | _ -> None in - PCase ((sp,Term.RegularStyle),None, - pat_of_raw metas vars c, - Array.init (List.length brs) - (pat_of_raw_branch loc metas vars sp brs)) + let cbrs = + Array.init (List.length brs) (pat_of_raw_branch loc metas vars ind brs) + in + let cstr_nargs,brs = (Array.map fst cbrs, Array.map snd cbrs) in + PCase ((RegularStyle,cstr_nargs,ind,ind_nargs), pred, + pat_of_raw metas vars c, brs) + | r -> let loc = loc_of_rawconstr r in user_err_loc (loc,"pattern_of_rawconstr", Pp.str "Pattern not supported") @@ -230,12 +269,12 @@ let rec pat_of_raw metas vars = function and pat_of_raw_branch loc metas vars ind brs i = let bri = List.filter (function - (_,_,[PatCstr(_,c,lv,_)],_) -> snd c = i+1 + (_,_,[PatCstr(_,c,lv,Anonymous)],_) -> snd c = i+1 | (loc,_,_,_) -> user_err_loc (loc,"pattern_of_rawconstr", Pp.str "Not supported pattern")) brs in match bri with - [(_,_,[PatCstr(_,(indsp,_),lv,_)],br)] -> + | [(_,_,[PatCstr(_,(indsp,_),lv,_)],br)] -> if ind <> None & ind <> Some indsp then user_err_loc (loc,"pattern_of_rawconstr", Pp.str "All constructors must be in the same inductive type"); @@ -246,8 +285,7 @@ and pat_of_raw_branch loc metas vars ind brs i = user_err_loc (loc,"pattern_of_rawconstr", Pp.str "Not supported pattern")) lv in let vars' = List.rev lna @ vars in - List.fold_right (fun na b -> PLambda(na,PMeta None,b)) lna - (pat_of_raw metas vars' br) + List.length lv, rev_it_mkPLambda lna (pat_of_raw metas vars' br) | _ -> user_err_loc (loc,"pattern_of_rawconstr", str "No unique branch for " ++ int (i+1) ++ str"-th constructor") diff --git a/pretyping/pattern.mli b/pretyping/pattern.mli index 25a57ed2..1637fc5f 100644 --- a/pretyping/pattern.mli +++ b/pretyping/pattern.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: pattern.mli 7732 2005-12-26 13:51:24Z herbelin $ i*) +(*i $Id: pattern.mli 8755 2006-04-27 22:22:15Z herbelin $ i*) (*i*) open Pp @@ -39,8 +39,9 @@ type constr_pattern = | PLetIn of name * constr_pattern * constr_pattern | PSort of rawsort | PMeta of patvar option - | PCase of (inductive option * case_style) - * constr_pattern option * constr_pattern * constr_pattern array + | PIf of constr_pattern * constr_pattern * constr_pattern + | PCase of (case_style * int array * inductive option * (int * int) option) + * constr_pattern * constr_pattern * constr_pattern array | PFix of fixpoint | PCoFix of cofixpoint @@ -76,3 +77,5 @@ val pattern_of_rawconstr : rawconstr -> val instantiate_pattern : (identifier * constr_pattern) list -> constr_pattern -> constr_pattern + +val lift_pattern : int -> constr_pattern -> constr_pattern diff --git a/pretyping/pretype_errors.ml b/pretyping/pretype_errors.ml index 48295c92..f5a81659 100644 --- a/pretyping/pretype_errors.ml +++ b/pretyping/pretype_errors.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: pretype_errors.ml 8688 2006-04-07 15:08:12Z msozeau $ *) +(* $Id: pretype_errors.ml 8752 2006-04-27 19:37:33Z herbelin $ *) open Util open Stdpp @@ -59,7 +59,7 @@ let env_ise sigma env = Sign.fold_rel_context (fun (na,b,ty) e -> push_rel - (na, option_app (nf_evar sigma) b, nf_evar sigma ty) + (na, option_map (nf_evar sigma) b, nf_evar sigma ty) e) ctxt ~init:env0 @@ -75,7 +75,7 @@ let contract env lc = env | _ -> let t' = substl !l t in - let c' = option_app (substl !l) c in + let c' = option_map (substl !l) c in let na' = named_hd env t' na in l := (mkRel 1) :: List.map (lift 1) !l; push_rel (na',c',t') env in diff --git a/pretyping/pretyping.ml b/pretyping/pretyping.ml index 2d1e297f..ca797f97 100644 --- a/pretyping/pretyping.ml +++ b/pretyping/pretyping.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: pretyping.ml 8695 2006-04-10 16:33:52Z msozeau $ *) +(* $Id: pretyping.ml 8875 2006-05-29 19:59:11Z msozeau $ *) open Pp open Util @@ -273,7 +273,7 @@ module Pretyping_F (Coercion : Coercion.S) = struct | REvar (loc, ev, instopt) -> (* Ne faudrait-il pas s'assurer que hyps est bien un sous-contexte du contexte courant, et qu'il n'y a pas de Rel "caché" *) - let hyps = evar_context (Evd.map (evars_of !isevars) ev) in + let hyps = evar_context (Evd.find (evars_of !isevars) ev) in let args = match instopt with | None -> instance_from_named_context hyps | Some inst -> failwith "Evar subtitutions not implemented" in @@ -329,34 +329,43 @@ module Pretyping_F (Coercion : Coercion.S) = struct { uj_val = it_mkLambda_or_LetIn j.uj_val ctxt; uj_type = it_mkProd_or_LetIn j.uj_type ctxt }) ctxtv vdef in - evar_type_fixpoint loc env isevars names ftys vdefj; - let fixj = - match fixkind with - | RFix (vn,i) -> - let fix = ((Array.map fst vn, i),(names,ftys,Array.map j_val vdefj)) in - (try check_fix env fix with e -> Stdpp.raise_with_loc loc e); - make_judge (mkFix fix) ftys.(i) - | RCoFix i -> - let cofix = (i,(names,ftys,Array.map j_val vdefj)) in - (try check_cofix env cofix with e -> Stdpp.raise_with_loc loc e); - make_judge (mkCoFix cofix) ftys.(i) in - inh_conv_coerce_to_tycon loc env isevars fixj tycon + evar_type_fixpoint loc env isevars names ftys vdefj; + let fixj = match fixkind with + | RFix (vn,i) -> + let guard_indexes = Array.mapi + (fun i (n,_) -> match n with + | Some n -> n + | None -> + (* Recursive argument was not given by the user : We + check that there is only one inductive argument *) + let ctx = ctxtv.(i) in + let isIndApp t = + isInd (fst (decompose_app (strip_head_cast t))) in + (* This could be more precise (e.g. do some delta) *) + let lb = List.rev_map (fun (_,_,t) -> isIndApp t) ctx in + try (list_unique_index true lb) - 1 + with Not_found -> + Util.user_err_loc + (loc,"pretype", + Pp.str "cannot guess decreasing argument of fix")) + vn + in + let fix = ((guard_indexes, i),(names,ftys,Array.map j_val vdefj)) in + (try check_fix env fix with e -> Stdpp.raise_with_loc loc e); + make_judge (mkFix fix) ftys.(i) + | RCoFix i -> + let cofix = (i,(names,ftys,Array.map j_val vdefj)) in + (try check_cofix env cofix with e -> Stdpp.raise_with_loc loc e); + make_judge (mkCoFix cofix) ftys.(i) in + inh_conv_coerce_to_tycon loc env isevars fixj tycon | RSort (loc,s) -> inh_conv_coerce_to_tycon loc env isevars (pretype_sort s) tycon | RApp (loc,f,args) -> - let length = List.length args in - let ftycon = - match tycon with - None -> None - | Some (None, ty) -> mk_abstr_tycon length ty - | Some (Some (init, cur), ty) -> - Some (Some (length + init, length + cur), ty) - in let fj = pretype empty_tycon env isevars lvar f in let floc = loc_of_rawconstr f in - let rec apply_rec env n resj tycon = function + let rec apply_rec env n resj = function | [] -> resj | c::rest -> let argloc = loc_of_rawconstr c in @@ -367,38 +376,22 @@ module Pretyping_F (Coercion : Coercion.S) = struct let hj = pretype (mk_tycon c1) env isevars lvar c in let value, typ = applist (j_val resj, [j_val hj]), subst1 hj.uj_val c2 in let typ' = nf_isevar !isevars typ in - let tycon = - option_app - (fun (abs, ty) -> - match abs with - None -> - isevars := Coercion.inh_conv_coerces_to loc env !isevars typ' - (abs, ty); - (abs, ty) - | Some (init, cur) -> - isevars := Coercion.inh_conv_coerces_to loc env !isevars typ' - (abs, ty); - (Some (init, pred cur), ty)) - tycon - in apply_rec env (n+1) { uj_val = nf_isevar !isevars value; - uj_type = nf_isevar !isevars typ' } - (option_app (fun (abs, c) -> abs, nf_isevar !isevars c) tycon) rest - + uj_type = typ' } + rest | _ -> let hj = pretype empty_tycon env isevars lvar c in error_cant_apply_not_functional_loc (join_loc floc argloc) env (evars_of !isevars) resj [hj] in - let ftycon = option_app (lift_abstr_tycon_type (-1)) ftycon in - let resj = j_nf_evar (evars_of !isevars) (apply_rec env 1 fj ftycon args) in + let resj = j_nf_evar (evars_of !isevars) (apply_rec env 1 fj args) in let resj = match kind_of_term resj.uj_val with | App (f,args) when isInd f -> let sigma = evars_of !isevars in - let t = Retyping.type_of_applied_inductive env sigma (destInd f) args in + let t = Retyping.type_of_inductive_knowing_parameters env sigma (destInd f) args in let s = snd (splay_arity env sigma t) in on_judgment_type (set_inductive_level env s) resj (* Rem: no need to send sigma: no head evar, it's an arity *) @@ -573,12 +566,19 @@ module Pretyping_F (Coercion : Coercion.S) = struct tycon env (* loc *) (po,tml,eqns) | RCast(loc,c,k,t) -> - let tj = pretype_type empty_valcon env isevars lvar t in - let cj = pretype (mk_tycon tj.utj_val) env isevars lvar c in - (* User Casts are for helping pretyping, experimentally not to be kept*) - (* ... except for Correctness *) - let v = mkCast (cj.uj_val, k, tj.utj_val) in - let cj = { uj_val = v; uj_type = tj.utj_val } in + let cj = + match k with + CastCoerce -> + let cj = pretype empty_tycon env isevars lvar c in + evd_comb1 (Coercion.inh_coerce_to_base loc env) isevars cj + | CastConv k -> + let tj = pretype_type empty_valcon env isevars lvar t in + let cj = pretype (mk_tycon tj.utj_val) env isevars lvar c in + (* User Casts are for helping pretyping, experimentally not to be kept*) + (* ... except for Correctness *) + let v = mkCast (cj.uj_val, k, tj.utj_val) in + { uj_val = v; uj_type = tj.utj_val } + in inh_conv_coerce_to_tycon loc env isevars cj tycon | RDynamic (loc,d) -> @@ -640,8 +640,8 @@ module Pretyping_F (Coercion : Coercion.S) = struct let rec proc_rec c = match kind_of_term c with | Evar (ev,args) -> - assert (Evd.in_dom sigma ev); - if not (Evd.in_dom initial_sigma ev) then + assert (Evd.mem sigma ev); + if not (Evd.mem initial_sigma ev) then let (loc,k) = evar_source ev !isevars in error_unsolvable_implicit loc env sigma k | _ -> iter_constr proc_rec c diff --git a/pretyping/rawterm.ml b/pretyping/rawterm.ml index 5d177326..e61bf2c3 100644 --- a/pretyping/rawterm.ml +++ b/pretyping/rawterm.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: rawterm.ml 8624 2006-03-13 17:38:17Z msozeau $ *) +(* $Id: rawterm.ml 8878 2006-05-30 16:44:25Z herbelin $ *) (*i*) open Util @@ -47,6 +47,10 @@ type 'a bindings = type 'a with_bindings = 'a * 'a bindings +type cast_type = + | CastConv of cast_kind + | CastCoerce (* Cast to a base type (eg, an underlying inductive type) *) + type rawconstr = | RRef of (loc * global_reference) | RVar of (loc * identifier) @@ -56,9 +60,7 @@ type rawconstr = | RLambda of loc * name * rawconstr * rawconstr | RProd of loc * name * rawconstr * rawconstr | RLetIn of loc * name * rawconstr * rawconstr - | RCases of loc * rawconstr option * - (rawconstr * (name * (loc * inductive * name list) option)) list * - (loc * identifier list * cases_pattern list * rawconstr) list + | RCases of loc * rawconstr option * tomatch_tuple * cases_clauses | RLetTuple of loc * name list * (name * rawconstr option) * rawconstr * rawconstr | RIf of loc * rawconstr * (name * rawconstr option) * rawconstr * rawconstr @@ -66,19 +68,29 @@ type rawconstr = rawconstr array * rawconstr array | RSort of loc * rawsort | RHole of (loc * hole_kind) - | RCast of loc * rawconstr * cast_kind * rawconstr + | RCast of loc * rawconstr * cast_type * rawconstr | RDynamic of loc * Dyn.t and rawdecl = name * rawconstr option * rawconstr and fix_recursion_order = RStructRec | RWfRec of rawconstr -and fix_kind = RFix of ((int * fix_recursion_order) array * int) | RCoFix of int +and fix_kind = + | RFix of ((int option * fix_recursion_order) array * int) + | RCoFix of int + +and predicate_pattern = + name * (loc * inductive * int * name list) option + +and tomatch_tuple = (rawconstr * predicate_pattern) list + +and cases_clauses = + (loc * identifier list * cases_pattern list * rawconstr) list let cases_predicate_names tml = List.flatten (List.map (function | (tm,(na,None)) -> [na] - | (tm,(na,Some (_,_,nal))) -> na::nal) tml) + | (tm,(na,Some (_,_,_,nal))) -> na::nal) tml) (*i - if PRec (_, names, arities, bodies) is in env then arities are typed in env too and bodies are typed in env enriched by the @@ -89,7 +101,7 @@ let cases_predicate_names tml = - boolean in POldCase means it is recursive i*) -let map_rawdecl f (na,obd,ty) = (na,option_app f obd,f ty) +let map_rawdecl f (na,obd,ty) = (na,option_map f obd,f ty) let map_rawconstr f = function | RVar (loc,id) -> RVar (loc,id) @@ -98,13 +110,13 @@ let map_rawconstr f = function | RProd (loc,na,ty,c) -> RProd (loc,na,f ty,f c) | RLetIn (loc,na,b,c) -> RLetIn (loc,na,f b,f c) | RCases (loc,rtntypopt,tml,pl) -> - RCases (loc,option_app f rtntypopt, + RCases (loc,option_map f rtntypopt, List.map (fun (tm,x) -> (f tm,x)) tml, List.map (fun (loc,idl,p,c) -> (loc,idl,p,f c)) pl) | RLetTuple (loc,nal,(na,po),b,c) -> - RLetTuple (loc,nal,(na,option_app f po),f b,f c) + RLetTuple (loc,nal,(na,option_map f po),f b,f c) | RIf (loc,c,(na,po),b1,b2) -> - RIf (loc,f c,(na,option_app f po),f b1,f b2) + RIf (loc,f c,(na,option_map f po),f b1,f b2) | RRec (loc,fk,idl,bl,tyl,bv) -> RRec (loc,fk,idl,Array.map (List.map (map_rawdecl f)) bl, Array.map f tyl,Array.map f bv) @@ -137,7 +149,7 @@ let map_rawconstr_with_binders_loc loc g f e = function let g' id e = snd (g id e) in let h (_,idl,p,c) = (loc,idl,p,f (List.fold_right g' idl e) c) in RCases - (loc,option_app (f e) tyopt,List.map (f e) tml, List.map h pl) + (loc,option_map (f e) tyopt,List.map (f e) tml, List.map h pl) | RRec (_,fk,idl,tyl,bv) -> let idl',e' = fold_ident g idl e in RRec (loc,fk,idl',Array.map (f e) tyl,Array.map (f e') bv) @@ -251,22 +263,24 @@ type 'a raw_red_flag = { let all_flags = {rBeta = true; rIota = true; rZeta = true; rDelta = true; rConst = []} -type 'a occurrences = int list * 'a +type 'a or_var = ArgArg of 'a | ArgVar of identifier located + +type 'a with_occurrences = int or_var list * 'a type ('a,'b) red_expr_gen = | Red of bool | Hnf - | Simpl of 'a occurrences option + | Simpl of 'a with_occurrences option | Cbv of 'b raw_red_flag | Lazy of 'b raw_red_flag - | Unfold of 'b occurrences list + | Unfold of 'b with_occurrences list | Fold of 'a list - | Pattern of 'a occurrences list + | Pattern of 'a with_occurrences list | ExtraRedExpr of string | CbvVm type ('a,'b) may_eval = | ConstrTerm of 'a - | ConstrEval of ('a, 'b) red_expr_gen * 'a + | ConstrEval of ('a,'b) red_expr_gen * 'a | ConstrContext of (loc * identifier) * 'a | ConstrTypeOf of 'a diff --git a/pretyping/rawterm.mli b/pretyping/rawterm.mli index 22317b5f..b29cc7b6 100644 --- a/pretyping/rawterm.mli +++ b/pretyping/rawterm.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: rawterm.mli 8624 2006-03-13 17:38:17Z msozeau $ i*) +(*i $Id: rawterm.mli 8878 2006-05-30 16:44:25Z herbelin $ i*) (*i*) open Util @@ -44,6 +44,10 @@ type 'a bindings = type 'a with_bindings = 'a * 'a bindings +type cast_type = + | CastConv of cast_kind + | CastCoerce (* Cast to a base type (eg, an underlying inductive type) *) + type rawconstr = | RRef of (loc * global_reference) | RVar of (loc * identifier) @@ -53,9 +57,7 @@ type rawconstr = | RLambda of loc * name * rawconstr * rawconstr | RProd of loc * name * rawconstr * rawconstr | RLetIn of loc * name * rawconstr * rawconstr - | RCases of loc * rawconstr option * - (rawconstr * (name * (loc * inductive * name list) option)) list * - (loc * identifier list * cases_pattern list * rawconstr) list + | RCases of loc * rawconstr option * tomatch_tuple * cases_clauses | RLetTuple of loc * name list * (name * rawconstr option) * rawconstr * rawconstr | RIf of loc * rawconstr * (name * rawconstr option) * rawconstr * rawconstr @@ -63,17 +65,26 @@ type rawconstr = rawconstr array * rawconstr array | RSort of loc * rawsort | RHole of (loc * Evd.hole_kind) - | RCast of loc * rawconstr * cast_kind * rawconstr + | RCast of loc * rawconstr * cast_type * rawconstr | RDynamic of loc * Dyn.t and rawdecl = name * rawconstr option * rawconstr and fix_recursion_order = RStructRec | RWfRec of rawconstr -and fix_kind = RFix of ((int * fix_recursion_order) array * int) | RCoFix of int +and fix_kind = + | RFix of ((int option * fix_recursion_order) array * int) + | RCoFix of int + +and predicate_pattern = + name * (loc * inductive * int * name list) option + +and tomatch_tuple = (rawconstr * predicate_pattern) list -val cases_predicate_names : - (rawconstr * (name * (loc * inductive * name list) option)) list -> name list +and cases_clauses = + (loc * identifier list * cases_pattern list * rawconstr) list + +val cases_predicate_names : tomatch_tuple -> name list (*i - if PRec (_, names, arities, bodies) is in env then arities are typed in env too and bodies are typed in env enriched by the @@ -121,22 +132,24 @@ type 'a raw_red_flag = { val all_flags : 'a raw_red_flag -type 'a occurrences = int list * 'a +type 'a or_var = ArgArg of 'a | ArgVar of identifier located + +type 'a with_occurrences = int or_var list * 'a type ('a,'b) red_expr_gen = | Red of bool | Hnf - | Simpl of 'a occurrences option + | Simpl of 'a with_occurrences option | Cbv of 'b raw_red_flag | Lazy of 'b raw_red_flag - | Unfold of 'b occurrences list + | Unfold of 'b with_occurrences list | Fold of 'a list - | Pattern of 'a occurrences list + | Pattern of 'a with_occurrences list | ExtraRedExpr of string | CbvVm type ('a,'b) may_eval = | ConstrTerm of 'a - | ConstrEval of ('a, 'b) red_expr_gen * 'a + | ConstrEval of ('a,'b) red_expr_gen * 'a | ConstrContext of (loc * identifier) * 'a | ConstrTypeOf of 'a diff --git a/pretyping/recordops.ml b/pretyping/recordops.ml index 87997d99..5d38f52c 100644 --- a/pretyping/recordops.ml +++ b/pretyping/recordops.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: recordops.ml 8642 2006-03-17 10:09:02Z notin $ *) +(* $Id: recordops.ml 8752 2006-04-27 19:37:33Z herbelin $ *) open Util open Pp @@ -67,7 +67,7 @@ let subst_structure (_,subst,((kn,i),id,kl,projs as obj)) = let discharge_structure (_,(ind,id,kl,projs)) = Some (Lib.discharge_inductive ind, id, kl, - List.map (option_app Lib.discharge_con) projs) + List.map (option_map Lib.discharge_con) projs) let (inStruc,outStruc) = declare_object {(default_object "STRUCTURE") with diff --git a/pretyping/reductionops.ml b/pretyping/reductionops.ml index b590f743..82cc1b7d 100644 --- a/pretyping/reductionops.ml +++ b/pretyping/reductionops.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: reductionops.ml 8708 2006-04-14 08:13:02Z jforest $ *) +(* $Id: reductionops.ml 8845 2006-05-23 07:41:58Z herbelin $ *) open Pp open Util @@ -23,6 +23,91 @@ open Reduction exception Elimconst + +(**********************************************************************) +(* The type of (machine) stacks (= lambda-bar-calculus' contexts) *) + +type 'a stack_member = + | Zapp of 'a list + | Zcase of case_info * 'a * 'a array + | Zfix of 'a * 'a stack + | Zshift of int + | Zupdate of 'a + +and 'a stack = 'a stack_member list + +let empty_stack = [] +let append_stack_list = function + | ([],s) -> s + | (l1, Zapp l :: s) -> Zapp (l1@l) :: s + | (l1, s) -> Zapp l1 :: s +let append_stack v s = append_stack_list (Array.to_list v, s) + +(* Collapse the shifts in the stack *) +let zshift n s = + match (n,s) with + (0,_) -> s + | (_,Zshift(k)::s) -> Zshift(n+k)::s + | _ -> Zshift(n)::s + +let rec stack_args_size = function + | Zapp l::s -> List.length l + stack_args_size s + | Zshift(_)::s -> stack_args_size s + | Zupdate(_)::s -> stack_args_size s + | _ -> 0 + +(* When used as an argument stack (only Zapp can appear) *) +let rec decomp_stack = function + | Zapp[v]::s -> Some (v, s) + | Zapp(v::l)::s -> Some (v, (Zapp l :: s)) + | Zapp [] :: s -> decomp_stack s + | _ -> None +let rec decomp_stackn = function + | Zapp [] :: s -> decomp_stackn s + | Zapp l :: s -> (Array.of_list l, s) + | _ -> assert false +let array_of_stack s = + let rec stackrec = function + | [] -> [] + | Zapp args :: s -> args :: (stackrec s) + | _ -> assert false + in Array.of_list (List.concat (stackrec s)) +let rec list_of_stack = function + | [] -> [] + | Zapp args :: s -> args @ (list_of_stack s) + | _ -> assert false +let rec app_stack = function + | f, [] -> f + | f, (Zapp [] :: s) -> app_stack (f, s) + | f, (Zapp args :: s) -> + app_stack (applist (f, args), s) + | _ -> assert false +let rec stack_assign s p c = match s with + | Zapp args :: s -> + let q = List.length args in + if p >= q then + Zapp args :: stack_assign s (p-q) c + else + (match list_chop p args with + (bef, _::aft) -> Zapp (bef@c::aft) :: s + | _ -> assert false) + | _ -> s +let rec stack_tail p s = + if p = 0 then s else + match s with + | Zapp args :: s -> + let q = List.length args in + if p >= q then stack_tail (p-q) s + else Zapp (list_skipn p args) :: s + | _ -> failwith "stack_tail" +let rec stack_nth s p = match s with + | Zapp args :: s -> + let q = List.length args in + if p >= q then stack_nth s (p-q) + else List.nth args p + | _ -> raise Not_found + +(**************************************************************) (* The type of (machine) states (= lambda-bar-calculus' cuts) *) type state = constr * constr stack @@ -428,13 +513,13 @@ let whd_betadeltaiota_nolet env sigma x = let rec whd_evar sigma c = match kind_of_term c with | Evar (ev,args) - when Evd.in_dom sigma ev & Evd.is_defined sigma ev -> + when Evd.mem sigma ev & Evd.is_defined sigma ev -> whd_evar sigma (Evd.existential_value sigma (ev,args)) | Sort s when is_sort_variable sigma s -> whd_sort_variable sigma c | _ -> collapse_appl c -let nf_evar evd = - local_strong (whd_evar evd) +let nf_evar sigma = + local_strong (whd_evar sigma) (* lazy reduction functions. The infos must be created for each term *) let clos_norm_flags flgs env sigma t = @@ -451,113 +536,49 @@ let nf_betadeltaiota env sigma = du type checking : (fun x => x + x) M *) -let nf_betaiotaevar_preserving_vm_cast env sigma t = - let push decl (env,subst) = - (Environ.push_rel decl env, Esubst.subs_lift subst) in - let cons decl v (env, subst) = (push_rel decl env, Esubst.subs_cons (v,subst)) in - - let app_stack t (f, stack) = - let t' = app_stack (f,stack) in - match kind_of_term t, kind_of_term t' with - | App(f,args), App(f',args') when f == f' && array_for_all2 (==) args args' -> t - | _ -> t' - in - let rec whrec (env, subst as es) (t, stack as s) = - match kind_of_term t with - | Rel i -> - let t' = - match Esubst.expand_rel i subst with - | Inl (k,e) -> lift k e - | Inr (k,None) -> mkRel k - | Inr (k, Some p) -> lift (k-p) (mkRel p) (*??????? == mkRel k ! Julien *) - (* Est correct ??? *) - in - if t = t' then s else t', stack - | Meta _ | Var _ | Sort _ | Const _ | Ind _ | Construct _ -> s - | Evar (e,al) -> - let al' = Array.map (norm es) al in - begin match existential_opt_value sigma (e,al') with - | Some body -> whrec (env,Esubst.ESID 0) (body, stack) (**** ????? ****) - | None -> - if array_for_all2 (==) al al' then s else (mkEvar (e, al'), stack) - end - | Cast (c,VMcast,t) -> - let c' = norm es c in - let t' = norm es t in - if c == c' && t == t' then s - else (mkCast(c',VMcast,t'),stack) - | Cast (c,DEFAULTcast,_) -> - whrec es (c, stack) - - | Prod (na,t,c) -> - let t' = norm es t in - let c' = norm (push (na, None, t') es) c in - if t==t' && c==c' then s else (mkProd (na, t', c'), stack) - - | Lambda (na,t,c) -> - begin match decomp_stack stack with - | Some (a,m) -> - begin match kind_of_term a with - | Rel i when not (evaluable_rel i env) -> - whrec (cons (na,None,t) a es) (c, m) - | Var id when not (evaluable_named id env)-> - whrec (cons (na,None,t) a es) (c, m) - | _ -> - let t' = norm es t in - let c' = norm (push (na, None, t') es) c in - if t == t' && c == c' then s - else mkLambda (na, t', c'), stack - end - | _ -> - let t' = norm es t in - let c' = norm (push (na, None, t') es) c in - if t == t' && c == c' then s - else mkLambda(na,t',c'),stack - - end - | LetIn (na,b,t,c) -> - let b' = norm es b in - let t' = norm es t in - let c' = norm (push (na, Some b', t') es) c in - if b==b' && t==t' && c==c' then s - else mkLetIn (na, b', t', c'), stack - - | App (f,cl) -> - let cl' = Array.map (norm es) cl in - whrec es (f, append_stack cl' stack) - - | Case (ci,p,d,lf) -> - let (c,cargs) = whrec es (d, empty_stack) in - if reducible_mind_case c then - whrec es (reduce_mind_case - {mP=p; mconstr=c; mcargs=list_of_stack cargs; - mci=ci; mlf=lf}, stack) - else - let p' = norm es p in - let d' = app_stack d (c,cargs) in - let lf' = Array.map (norm es) lf in - if p==p' && d==d' && array_for_all2 (==) lf lf' then s - else (mkCase (ci, p', d', lf'), stack) - | Fix (ln,(lna,tl,bl)) -> - let tl' = Array.map (norm es) tl in - let es' = - array_fold_left2 (fun es na t -> push (na,None,t) es) es lna tl' in - let bl' = Array.map (norm es') bl in - if array_for_all2 (==) tl tl' && array_for_all2 (==) bl bl' - then s - else (mkFix (ln,(lna,tl',bl')), stack) - | CoFix(ln,(lna,tl,bl)) -> - let tl' = Array.map (norm es) tl in - let es' = - array_fold_left2 (fun es na t -> push (na,None,t) es) es lna tl in - let bl' = Array.map (norm es') bl in - if array_for_all2 (==) tl tl' && array_for_all2 (==) bl bl' - then s - else (mkCoFix (ln,(lna,tl',bl')), stack) - - and norm es t = app_stack t (whrec es (t,empty_stack)) in - norm (env, Esubst.ESID 0) t - +let rec whd_betaiotaevar_preserving_vm_cast env sigma t = + let rec stacklam_var subst t stack = + match (decomp_stack stack,kind_of_term t) with + | Some (h,stacktl), Lambda (_,_,c) -> + begin match kind_of_term h with + | Rel i when not (evaluable_rel i env) -> + stacklam_var (h::subst) c stacktl + | Var id when not (evaluable_named id env)-> + stacklam_var (h::subst) c stacktl + | _ -> whrec (substl subst t, stack) + end + | _ -> whrec (substl subst t, stack) + and whrec (x, stack as s) = + match kind_of_term x with + | Evar ev -> + (match existential_opt_value sigma ev with + | Some body -> whrec (body, stack) + | None -> s) + | Cast (c,VMcast,t) -> + let c = app_stack (whrec (c,empty_stack)) in + let t = app_stack (whrec (t,empty_stack)) in + (mkCast(c,VMcast,t),stack) + | Cast (c,DEFAULTcast,_) -> + whrec (c, stack) + | App (f,cl) -> whrec (f, append_stack cl stack) + | Lambda (na,t,c) -> + (match decomp_stack stack with + | Some (a,m) -> stacklam_var [a] c m + | _ -> s) + | Case (ci,p,d,lf) -> + let (c,cargs) = whrec (d, empty_stack) in + if reducible_mind_case c then + whrec (reduce_mind_case + {mP=p; mconstr=c; mcargs=list_of_stack cargs; + mci=ci; mlf=lf}, stack) + else + (mkCase (ci, p, app_stack (c,cargs), lf), stack) + | x -> s + in + app_stack (whrec (t,empty_stack)) + +let nf_betaiotaevar_preserving_vm_cast = + strong whd_betaiotaevar_preserving_vm_cast (* lazy weak head reduction functions *) let whd_flags flgs env sigma t = @@ -825,26 +846,6 @@ let is_arity env sigma c = match find_conclusion env sigma c with | Sort _ -> true | _ -> false - -let info_arity env sigma c = - match find_conclusion env sigma c with - | Sort (Prop Null) -> false - | Sort (Prop Pos) -> true - | _ -> raise IsType - -let is_info_arity env sigma c = - try (info_arity env sigma c) with IsType -> true - -let is_type_arity env sigma c = - match find_conclusion env sigma c with - | Sort (Type _) -> true - | _ -> false - -let is_info_type env sigma t = - let s = t.utj_type in - (s = Prop Pos) || - (s <> Prop Null && - try info_arity env sigma t.utj_val with IsType -> true) (*************************************) (* Metas *) diff --git a/pretyping/reductionops.mli b/pretyping/reductionops.mli index ff55cc0e..78afd22b 100644 --- a/pretyping/reductionops.mli +++ b/pretyping/reductionops.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: reductionops.mli 8708 2006-04-14 08:13:02Z jforest $ i*) +(*i $Id: reductionops.mli 8812 2006-05-13 11:46:02Z herbelin $ i*) (*i*) open Names @@ -21,6 +21,34 @@ open Closure exception Elimconst +(************************************************************************) +(*s A [stack] is a context of arguments, arguments are pushed by + [append_stack] one array at a time but popped with [decomp_stack] + one by one *) + +type 'a stack_member = + | Zapp of 'a list + | Zcase of case_info * 'a * 'a array + | Zfix of 'a * 'a stack + | Zshift of int + | Zupdate of 'a + +and 'a stack = 'a stack_member list + +val empty_stack : 'a stack +val append_stack : 'a array -> 'a stack -> 'a stack + +val decomp_stack : 'a stack -> ('a * 'a stack) option +val list_of_stack : 'a stack -> 'a list +val array_of_stack : 'a stack -> 'a array +val stack_assign : 'a stack -> int -> 'a -> 'a stack +val stack_args_size : 'a stack -> int +val app_stack : constr * constr stack -> constr +val stack_tail : int -> 'a stack -> 'a stack +val stack_nth : 'a stack -> int -> 'a + +(************************************************************************) + type state = constr * constr stack type contextual_reduction_function = env -> evar_map -> constr -> constr @@ -147,13 +175,6 @@ val reduce_mind_case : constr miota_args -> constr val find_conclusion : env -> evar_map -> constr -> (constr,constr) kind_of_term val is_arity : env -> evar_map -> constr -> bool -val is_info_type : env -> evar_map -> unsafe_type_judgment -> bool -val is_info_arity : env -> evar_map -> constr -> bool -(*i Pour l'extraction -val is_type_arity : env -> 'a evar_map -> constr -> bool -val is_info_cast_type : env -> 'a evar_map -> constr -> bool -val contents_of_cast_type : env -> 'a evar_map -> constr -> contents -i*) val whd_programs : reduction_function diff --git a/pretyping/retyping.ml b/pretyping/retyping.ml index 32da4cea..428a7306 100644 --- a/pretyping/retyping.ml +++ b/pretyping/retyping.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: retyping.ml 8673 2006-03-29 21:21:52Z herbelin $ *) +(* $Id: retyping.ml 8871 2006-05-28 16:46:48Z herbelin $ *) open Util open Term @@ -74,7 +74,7 @@ let typeur sigma metamap = | Fix ((_,i),(_,tys,_)) -> tys.(i) | CoFix (i,(_,tys,_)) -> tys.(i) | App(f,args) when isInd f -> - let t = type_of_applied_inductive env (destInd f) args in + let t = type_of_inductive_knowing_parameters env (destInd f) args in strip_outer_cast (subst_type env sigma t (Array.to_list args)) | App(f,args) -> strip_outer_cast @@ -98,7 +98,7 @@ let typeur sigma metamap = | Prop Null, (Type _ as s) -> s | Type u1, Type u2 -> Type (Univ.sup u1 u2)) | App(f,args) when isInd f -> - let t = type_of_applied_inductive env (destInd f) args in + let t = type_of_inductive_knowing_parameters env (destInd f) args in sort_of_atomic_type env sigma t args | App(f,args) -> sort_of_atomic_type env sigma (type_of env f) args | Lambda _ | Fix _ | Construct _ -> @@ -117,25 +117,17 @@ let typeur sigma metamap = anomaly "sort_of: Not a type (1)" | _ -> family_of_sort (decomp_sort env sigma (type_of env t)) - and type_of_applied_inductive env ind args = - let specif = lookup_mind_specif env ind in - let t = Inductive.type_of_inductive specif in - if is_small_inductive specif then - (* No polymorphism *) - t - else - (* Retyping constructor with the actual arguments *) - let env',llc,ls0 = constructor_instances env specif ind args in - let lls = Array.map (Array.map (sort_of env')) llc in - let ls = Array.map max_inductive_sort lls in - set_inductive_level env (find_inductive_level env specif ind ls0 ls) t + and type_of_inductive_knowing_parameters env ind args = + let (_,mip) = lookup_mind_specif env ind in + let argtyps = Array.map (fun c -> nf_evar sigma (type_of env c)) args in + Inductive.type_of_inductive_knowing_parameters env mip argtyps - in type_of, sort_of, sort_family_of, type_of_applied_inductive + in type_of, sort_of, sort_family_of, type_of_inductive_knowing_parameters let get_type_of env sigma c = let f,_,_,_ = typeur sigma [] in f env c let get_sort_of env sigma t = let _,f,_,_ = typeur sigma [] in f env t let get_sort_family_of env sigma c = let _,_,f,_ = typeur sigma [] in f env c -let type_of_applied_inductive env sigma ind args = +let type_of_inductive_knowing_parameters env sigma ind args = let _,_,_,f = typeur sigma [] in f env ind args let get_type_of_with_meta env sigma metamap = diff --git a/pretyping/retyping.mli b/pretyping/retyping.mli index 7adec66b..923123c5 100644 --- a/pretyping/retyping.mli +++ b/pretyping/retyping.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: retyping.mli 8673 2006-03-29 21:21:52Z herbelin $ i*) +(*i $Id: retyping.mli 8871 2006-05-28 16:46:48Z herbelin $ i*) (*i*) open Names @@ -34,5 +34,5 @@ val get_assumption_of : env -> evar_map -> constr -> types (* Makes an unsafe judgment from a constr *) val get_judgment_of : env -> evar_map -> constr -> unsafe_judgment -val type_of_applied_inductive : env -> evar_map -> inductive -> +val type_of_inductive_knowing_parameters : env -> evar_map -> inductive -> constr array -> types diff --git a/pretyping/tacred.ml b/pretyping/tacred.ml index 88af6290..006e14b3 100644 --- a/pretyping/tacred.ml +++ b/pretyping/tacred.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: tacred.ml 8003 2006-02-07 22:11:50Z herbelin $ *) +(* $Id: tacred.ml 8793 2006-05-05 17:41:41Z barras $ *) open Pp open Util @@ -18,8 +18,8 @@ open Termops open Declarations open Inductive open Environ -open Reductionops open Closure +open Reductionops open Cbv open Rawterm @@ -80,7 +80,7 @@ let reference_opt_value sigma env = function v | EvalRel n -> let (_,v,_) = lookup_rel n env in - option_app (lift n) v + option_map (lift n) v | EvalEvar ev -> Evd.existential_opt_value sigma ev exception NotEvaluable diff --git a/pretyping/tacred.mli b/pretyping/tacred.mli index a5468435..691fdf01 100644 --- a/pretyping/tacred.mli +++ b/pretyping/tacred.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: tacred.mli 8003 2006-02-07 22:11:50Z herbelin $ i*) +(*i $Id: tacred.mli 8878 2006-05-30 16:44:25Z herbelin $ i*) (*i*) open Names @@ -77,5 +77,5 @@ val reduce_to_quantified_ref : val reduce_to_atomic_ref : env -> evar_map -> Libnames.global_reference -> types -> types -val contextually : bool -> constr occurrences -> reduction_function +val contextually : bool -> int list * constr -> reduction_function -> reduction_function diff --git a/pretyping/termops.ml b/pretyping/termops.ml index 89de5537..823da969 100644 --- a/pretyping/termops.ml +++ b/pretyping/termops.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: termops.ml 8003 2006-02-07 22:11:50Z herbelin $ *) +(* $Id: termops.ml 8845 2006-05-23 07:41:58Z herbelin $ *) open Pp open Util @@ -25,7 +25,7 @@ let print_sort = function | Prop Null -> (str "Prop") | Type u -> (str "Type(" ++ Univ.pr_uni u ++ str ")") -let print_sort_family = function +let pr_sort_family = function | InSet -> (str "Set") | InProp -> (str "Prop") | InType -> (str "Type") @@ -961,7 +961,7 @@ let assums_of_rel_context sign = let lift_rel_context n sign = let rec liftrec k = function | (na,c,t)::sign -> - (na,option_app (liftn n k) c,type_app (liftn n k) t) + (na,option_map (liftn n k) c,type_app (liftn n k) t) ::(liftrec (k-1) sign) | [] -> [] in diff --git a/pretyping/termops.mli b/pretyping/termops.mli index 5f8b5376..49de4838 100644 --- a/pretyping/termops.mli +++ b/pretyping/termops.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: termops.mli 8003 2006-02-07 22:11:50Z herbelin $ i*) +(*i $Id: termops.mli 8845 2006-05-23 07:41:58Z herbelin $ i*) open Util open Pp @@ -24,7 +24,7 @@ val refresh_universes : types -> types (* printers *) val print_sort : sorts -> std_ppcmds -val print_sort_family : sorts_family -> std_ppcmds +val pr_sort_family : sorts_family -> std_ppcmds (* debug printer: do not use to display terms to the casual user... *) val set_print_constr : (env -> constr -> std_ppcmds) -> unit val print_constr : constr -> std_ppcmds diff --git a/pretyping/typing.ml b/pretyping/typing.ml index be922c7d..78902a7d 100644 --- a/pretyping/typing.ml +++ b/pretyping/typing.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: typing.ml 8673 2006-03-29 21:21:52Z herbelin $ *) +(* $Id: typing.ml 8871 2006-05-28 16:46:48Z herbelin $ *) open Util open Names @@ -88,14 +88,16 @@ let rec execute env evd cstr = judge_of_type u | App (f,args) -> - let j = execute env evd f in let jl = execute_array env evd args in - let (j,_) = judge_of_apply env j jl in + let j = if isInd f then (* Sort-polymorphism of inductive types *) - adjust_inductive_level env evd (destInd f) args j + judge_of_inductive_knowing_parameters env (destInd f) + (jv_nf_evar (evars_of evd) jl) else - j + execute env evd f + in + fst (judge_of_apply env j jl) | Lambda (name,c1,c2) -> let j = execute env evd c1 in @@ -141,25 +143,6 @@ and execute_array env evd = Array.map (execute env evd) and execute_list env evd = List.map (execute env evd) -and adjust_inductive_level env evd ind args j = - let specif = lookup_mind_specif env ind in - if is_small_inductive specif then - (* No polymorphism *) - j - else - (* Retyping constructor with the actual arguments *) - let env',llc,ls0 = constructor_instances env specif ind args in - let llj = Array.map (execute_array env' evd) llc in - let ls = - Array.map (fun lj -> - let ls = - Array.map (fun c -> decomp_sort env (evars_of evd) c.uj_type) lj - in - max_inductive_sort ls) llj - in - let s = find_inductive_level env specif ind ls0 ls in - on_judgment_type (set_inductive_level env s) j - let mcheck env evd c t = let sigma = Evd.evars_of evd in let j = execute env evd (nf_evar sigma c) in diff --git a/pretyping/unification.ml b/pretyping/unification.ml index e51f5e0e..e4bde925 100644 --- a/pretyping/unification.ml +++ b/pretyping/unification.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: unification.ml 7113 2005-06-05 17:13:06Z barras $ *) +(* $Id: unification.ml 8759 2006-04-28 12:24:14Z herbelin $ *) open Pp open Util @@ -259,7 +259,7 @@ let w_merge env with_types mod_delta metas evars evd = end and mimick_evar evd mod_delta hdc nargs sp = - let ev = Evd.map (evars_of evd) sp in + let ev = Evd.find (evars_of evd) sp in let sp_env = Global.env_of_context ev.evar_hyps in let (evd', c) = applyHead sp_env evd nargs hdc in let (mc,ec) = diff --git a/proofs/evar_refiner.ml b/proofs/evar_refiner.ml index 4ee8001c..7a23d052 100644 --- a/proofs/evar_refiner.ml +++ b/proofs/evar_refiner.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: evar_refiner.ml 8654 2006-03-22 15:36:58Z msozeau $ *) +(* $Id: evar_refiner.ml 8759 2006-04-28 12:24:14Z herbelin $ *) open Util open Names @@ -25,7 +25,7 @@ open Refiner let w_refine env ev rawc evd = if Evd.is_defined (evars_of evd) ev then error "Instantiate called on already-defined evar"; - let e_info = Evd.map (evars_of evd) ev in + let e_info = Evd.find (evars_of evd) ev in let env = Evd.evar_env e_info in let sigma,typed_c = Pretyping.Default.understand_tcc (evars_of evd) env diff --git a/proofs/logic.ml b/proofs/logic.ml index 1f79d73c..ffbc0d56 100644 --- a/proofs/logic.ml +++ b/proofs/logic.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: logic.ml 8696 2006-04-11 07:05:50Z herbelin $ *) +(* $Id: logic.ml 8871 2006-05-28 16:46:48Z herbelin $ *) open Pp open Util @@ -285,7 +285,7 @@ let rec mk_refgoals sigma goal goalacc conclty trm = | App (f,l) -> let (acc',hdty) = if isInd f & not (array_exists occur_meta l) (* we could be finer *) - then (goalacc,type_of_applied_inductive env sigma (destInd f) l) + then (goalacc,type_of_inductive_knowing_parameters env sigma (destInd f) l) else mk_hdgoals sigma goal goalacc f in let (acc'',conclty') = @@ -327,7 +327,7 @@ and mk_hdgoals sigma goal goalacc trm = | App (f,l) -> let (acc',hdty) = if isInd f & not (array_exists occur_meta l) (* we could be finer *) - then (goalacc,type_of_applied_inductive env sigma (destInd f) l) + then (goalacc,type_of_inductive_knowing_parameters env sigma (destInd f) l) else mk_hdgoals sigma goal goalacc f in mk_arggoals sigma goal acc' hdty (Array.to_list l) diff --git a/proofs/redexpr.ml b/proofs/redexpr.ml index 8b3b5f5f..eb47fc2e 100644 --- a/proofs/redexpr.ml +++ b/proofs/redexpr.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: redexpr.ml 7639 2005-12-02 10:01:15Z gregoire $ *) +(* $Id: redexpr.ml 8878 2006-05-30 16:44:25Z herbelin $ *) open Pp open Util @@ -93,19 +93,26 @@ let declare_red_expr s f = with Not_found -> red_expr_tab := Stringmap.add s f !red_expr_tab +let out_arg = function + | ArgVar _ -> anomaly "Unevaluated or_var variable" + | ArgArg x -> x + +let out_with_occurrences (l,c) = + (List.map out_arg l, c) + let reduction_of_red_expr = function | Red internal -> if internal then (try_red_product,DEFAULTcast) else (red_product,DEFAULTcast) | Hnf -> (hnf_constr,DEFAULTcast) - | Simpl (Some (_,c as lp)) -> - (contextually (is_reference c) lp nf,DEFAULTcast) + | Simpl (Some (_,c as lp)) -> + (contextually (is_reference c) (out_with_occurrences lp) nf,DEFAULTcast) | Simpl None -> (nf,DEFAULTcast) | Cbv f -> (cbv_norm_flags (make_flag f),DEFAULTcast) | Lazy f -> (clos_norm_flags (make_flag f),DEFAULTcast) - | Unfold ubinds -> (unfoldn ubinds,DEFAULTcast) + | Unfold ubinds -> (unfoldn (List.map out_with_occurrences ubinds),DEFAULTcast) | Fold cl -> (fold_commands cl,DEFAULTcast) - | Pattern lp -> (pattern_occs lp,DEFAULTcast) + | Pattern lp -> (pattern_occs (List.map out_with_occurrences lp),DEFAULTcast) | ExtraRedExpr s -> (try (Stringmap.find s !red_expr_tab,DEFAULTcast) with Not_found -> error("unknown user-defined reduction \""^s^"\"")) diff --git a/proofs/redexpr.mli b/proofs/redexpr.mli index c442b16e..cbac180a 100644 --- a/proofs/redexpr.mli +++ b/proofs/redexpr.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: redexpr.mli 7639 2005-12-02 10:01:15Z gregoire $ i*) +(*i $Id: redexpr.mli 8878 2006-05-30 16:44:25Z herbelin $ i*) open Names open Term @@ -17,6 +17,8 @@ open Reductionops type red_expr = (constr, evaluable_global_reference) red_expr_gen +val out_with_occurrences : 'a with_occurrences -> int list * 'a + val reduction_of_red_expr : red_expr -> reduction_function * cast_kind (* [true] if we should use the vm to verify the reduction *) diff --git a/proofs/refiner.ml b/proofs/refiner.ml index 2b878d37..067ae471 100644 --- a/proofs/refiner.ml +++ b/proofs/refiner.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: refiner.ml 8708 2006-04-14 08:13:02Z jforest $ *) +(* $Id: refiner.ml 8759 2006-04-28 12:24:14Z herbelin $ *) open Pp open Util @@ -263,7 +263,7 @@ let extract_open_proof sigma pf = let meta_cnt = ref 0 in let rec f () = incr meta_cnt; - if in_dom sigma (existential_of_int !meta_cnt) then f () + if Evd.mem sigma (existential_of_int !meta_cnt) then f () else !meta_cnt in f in diff --git a/proofs/tacexpr.ml b/proofs/tacexpr.ml index aff6b944..b721dacd 100644 --- a/proofs/tacexpr.ml +++ b/proofs/tacexpr.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: tacexpr.ml 8651 2006-03-21 21:54:43Z jforest $ i*) +(*i $Id: tacexpr.ml 8917 2006-06-07 16:59:05Z herbelin $ i*) open Names open Topconstr @@ -56,7 +56,7 @@ type hyp_location_flag = (* To distinguish body and type of local defs *) | InHypTypeOnly | InHypValueOnly -type 'a raw_hyp_location = 'a * int list * hyp_location_flag +type 'a raw_hyp_location = 'a with_occurrences * hyp_location_flag type 'a induction_arg = | ElimOnConstr of 'a @@ -80,6 +80,7 @@ type 'id message_token = | MsgInt of int | MsgIdent of 'id + type 'id gsimple_clause = ('id raw_hyp_location) option (* onhyps: [None] means *on every hypothesis* @@ -87,7 +88,7 @@ type 'id gsimple_clause = ('id raw_hyp_location) option type 'id gclause = { onhyps : 'id raw_hyp_location list option; onconcl : bool; - concl_occs :int list } + concl_occs : int or_var list } let nowhere = {onhyps=Some[]; onconcl=false; concl_occs=[]} @@ -175,8 +176,7 @@ type ('constr,'pat,'cst,'ind,'ref,'id,'tac) gen_atomic_tactic_expr = (* Conversion *) | TacReduce of ('constr,'cst) red_expr_gen * 'id gclause - | TacChange of - 'constr occurrences option * 'constr * 'id gclause + | TacChange of 'constr with_occurrences option * 'constr * 'id gclause (* Equivalence relations *) | TacReflexivity @@ -184,6 +184,7 @@ type ('constr,'pat,'cst,'ind,'ref,'id,'tac) gen_atomic_tactic_expr = | TacTransitivity of 'constr (* Equality and inversion *) + | TacRewrite of bool * 'constr with_bindings * 'id gclause | TacInversion of ('constr,'id) inversion_strength * quantified_hypothesis (* For ML extensions *) @@ -306,10 +307,10 @@ type closed_raw_generic_argument = (constr_expr,raw_tactic_expr) generic_argument type 'a raw_abstract_argument_type = - ('a,constr_expr,raw_tactic_expr) abstract_argument_type + ('a,rlevel,raw_tactic_expr) abstract_argument_type type 'a glob_abstract_argument_type = - ('a,rawconstr_and_expr,glob_tactic_expr) abstract_argument_type + ('a,glevel,glob_tactic_expr) abstract_argument_type type open_generic_argument = (Term.constr,glob_tactic_expr) generic_argument diff --git a/proofs/tactic_debug.ml b/proofs/tactic_debug.ml index 43807872..889e06a8 100644 --- a/proofs/tactic_debug.ml +++ b/proofs/tactic_debug.ml @@ -76,11 +76,12 @@ let rec prompt level = begin msg (fnl () ++ str "TcDebug (" ++ int level ++ str ") > "); flush stdout; - let inst = read_line () in + let exit () = skip:=0;allskip:=0;raise Sys.Break in + let inst = try read_line () with End_of_file -> exit () in match inst with | "" -> true | "s" -> false - | "x" -> print_char (Char.chr 8);skip:=0;allskip:=0;raise Sys.Break + | "x" -> print_char (Char.chr 8); exit () | "h"| "?" -> begin help (); diff --git a/scripts/coqmktop.ml b/scripts/coqmktop.ml index dec302e7..4cc676cf 100644 --- a/scripts/coqmktop.ml +++ b/scripts/coqmktop.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: coqmktop.ml 7538 2005-11-08 17:14:52Z herbelin $ *) +(* $Id: coqmktop.ml 8787 2006-05-04 13:25:52Z notin $ *) (* coqmktop is a script to link Coq, analogous to ocamlmktop. The command line contains options specific to coqmktop, options for the @@ -166,7 +166,7 @@ let parse_args () = parse ((List.rev(List.flatten (List.map (fun d -> ["-I";d]) (all_subdirs a))))@op,fl) rem | "-R" :: [] -> usage () - | ("-noassert"|"-compact"|"-g"|"-p"|"-thread" as o) :: rem -> + | ("-noassert"|"-compact"|"-g"|"-p"|"-thread"|"-dtypes" as o) :: rem -> parse (o::op,fl) rem | ("-h"|"--help") :: _ -> usage () | f :: rem -> diff --git a/tactics/auto.ml b/tactics/auto.ml index d5e5e556..7c1c375b 100644 --- a/tactics/auto.ml +++ b/tactics/auto.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: auto.ml 7937 2006-01-28 19:58:11Z herbelin $ *) +(* $Id: auto.ml 8878 2006-05-30 16:44:25Z herbelin $ *) open Pp open Util @@ -778,7 +778,7 @@ let gen_auto n lems dbnames = | None -> full_auto n lems | Some l -> auto n lems l -let inj_or_var = option_app (fun n -> Genarg.ArgArg n) +let inj_or_var = option_map (fun n -> ArgArg n) let h_auto n lems l = Refiner.abstract_tactic (TacAuto (inj_or_var n,lems,l)) (gen_auto n lems l) @@ -849,7 +849,7 @@ let compileAutoArg contac = function (tclTHEN (Tacticals.tryAllClauses (function - | Some (id,_,_) -> Dhyp.h_destructHyp false id + | Some ((_,id),_) -> Dhyp.h_destructHyp false id | None -> Dhyp.h_destructConcl)) contac) diff --git a/tactics/dhyp.ml b/tactics/dhyp.ml index 511e0950..f82b1f82 100644 --- a/tactics/dhyp.ml +++ b/tactics/dhyp.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: dhyp.ml 7732 2005-12-26 13:51:24Z herbelin $ *) +(* $Id: dhyp.ml 8878 2006-05-30 16:44:25Z herbelin $ *) (* Chet's comments about this tactic : @@ -265,10 +265,10 @@ let match_dpat dp cls gls = | ({onhyps=lo;onconcl=false},HypLocation(_,hypd,concld)) -> let hl = match lo with Some l -> l - | None -> List.map (fun id -> (id,[],InHyp)) (pf_ids_of_hyps gls) in + | None -> List.map (fun id -> (([],id),InHyp)) (pf_ids_of_hyps gls) in if not (List.for_all - (fun (id,_,hl) -> + (fun ((_,id),hl) -> let cltyp = pf_get_hyp_typ gls id in let cl = pf_concl gls in (hl=InHyp) & @@ -297,7 +297,7 @@ let applyDestructor cls discard dd gls = let tacl = List.map (fun cl -> match cl, dd.d_code with - | Some (id,_,_), (Some x, tac) -> + | Some ((_,id),_), (Some x, tac) -> let arg = ConstrMayEval(ConstrTerm (RRef(dummy_loc,VarRef id),None)) in TacLetIn ([(dummy_loc, x), None, arg], tac) @@ -308,7 +308,7 @@ let applyDestructor cls discard dd gls = let discard_0 = List.map (fun cl -> match (cl,dd.d_pat) with - | (Some (id,_,_),HypLocation(discardable,_,_)) -> + | (Some ((_,id),_),HypLocation(discardable,_,_)) -> if discard & discardable then thin [id] else tclIDTAC | (None,ConclLocation _) -> tclIDTAC | _ -> error "ApplyDestructor" ) cll in @@ -356,7 +356,7 @@ let rec search n = (tclTHEN (Tacticals.tryAllClauses (function - | Some (id,_,_) -> (dHyp id) + | Some ((_,id),_) -> (dHyp id) | None -> dConcl )) (search (n-1)))] diff --git a/tactics/eauto.ml4 b/tactics/eauto.ml4 index 457f8318..32abc347 100644 --- a/tactics/eauto.ml4 +++ b/tactics/eauto.ml4 @@ -8,7 +8,7 @@ (*i camlp4deps: "parsing/grammar.cma" i*) -(* $Id: eauto.ml4 7991 2006-02-05 22:56:16Z herbelin $ *) +(* $Id: eauto.ml4 8878 2006-05-30 16:44:25Z herbelin $ *) open Pp open Util @@ -107,7 +107,7 @@ let e_split = e_constructor_tac (Some 1) 1 TACTIC EXTEND econstructor [ "econstructor" integer(n) "with" bindings(c) ] -> [ e_constructor_tac None n c ] | [ "econstructor" integer(n) ] -> [ e_constructor_tac None n NoBindings ] -| [ "econstructor" tactic_opt(t) ] -> [ e_any_constructor (option_app Tacinterp.eval_tactic t) ] +| [ "econstructor" tactic_opt(t) ] -> [ e_any_constructor (option_map Tacinterp.eval_tactic t) ] END TACTIC EXTEND eleft @@ -149,7 +149,7 @@ let rec prolog l n gl = let prolog_tac l n gl = let n = match n with - | Genarg.ArgArg n -> n + | ArgArg n -> n | _ -> error "Prolog called with a non closed argument" in try (prolog l n gl) @@ -383,12 +383,12 @@ let gen_eauto d np lems = function let make_depth = function | None -> !default_search_depth - | Some (Genarg.ArgArg d) -> d + | Some (ArgArg d) -> d | _ -> error "EAuto called with a non closed argument" let make_dimension n = function | None -> (true,make_depth n) - | Some (Genarg.ArgArg d) -> (false,d) + | Some (ArgArg d) -> (false,d) | _ -> error "EAuto called with a non closed argument" open Genarg diff --git a/tactics/eqdecide.ml4 b/tactics/eqdecide.ml4 index 9cbc549f..0a33164e 100644 --- a/tactics/eqdecide.ml4 +++ b/tactics/eqdecide.ml4 @@ -14,7 +14,7 @@ (*i camlp4deps: "parsing/grammar.cma" i*) -(* $Id: eqdecide.ml4 8652 2006-03-22 08:27:14Z herbelin $ *) +(* $Id: eqdecide.ml4 8780 2006-05-02 21:58:58Z letouzey $ *) open Util open Names @@ -103,7 +103,7 @@ let mkGenDecideEqGoal rectype g = let eqCase tac = (tclTHEN intro - (tclTHEN (tclLAST_HYP Extratactics.h_rewriteLR) + (tclTHEN (tclLAST_HYP Equality.rewriteLR) (tclTHEN clear_last tac))) diff --git a/tactics/equality.ml b/tactics/equality.ml index be79c348..42fc1201 100644 --- a/tactics/equality.ml +++ b/tactics/equality.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: equality.ml 8677 2006-04-02 17:05:59Z herbelin $ *) +(* $Id: equality.ml 8878 2006-05-30 16:44:25Z herbelin $ *) open Pp open Util @@ -69,27 +69,47 @@ let elimination_sort_of_clause = function | None -> elimination_sort_of_goal | Some id -> elimination_sort_of_hyp id +(* The next function decides in particular whether to try a regular + rewrite or a setoid rewrite. + + Old approach was: + break everything, if [eq] appears in head position + then regular rewrite else try setoid rewrite + + New approach is: + if head position is a known setoid relation then setoid rewrite + else back to the old approach +*) + let general_rewrite_bindings_clause cls lft2rgt (c,l) gl = let ctype = pf_type_of gl c in - let env = pf_env gl in - let sigma = project gl in - let _,t = splay_prod env sigma ctype in - match match_with_equation t with - | None -> - if l = NoBindings - then general_s_rewrite_clause cls lft2rgt c [] gl - else error "The term provided does not end with an equation" - | Some (hdcncl,_) -> - let hdcncls = string_of_inductive hdcncl in - let suffix = elimination_suffix (elimination_sort_of_clause cls gl) in - let dir = if cls=None then lft2rgt else not lft2rgt in - let rwr_thm = if dir then hdcncls^suffix^"_r" else hdcncls^suffix in - let elim = - try pf_global gl (id_of_string rwr_thm) - with Not_found -> - error ("Cannot find rewrite principle "^rwr_thm) - in - general_elim_clause cls (c,l) (elim,NoBindings) gl + (* A delta-reduction would be here too strong, since it would + break search for a defined setoid relation in head position. *) + let t = snd (decompose_prod (whd_betaiotazeta ctype)) in + let head = if isApp t then fst (destApp t) else t in + if relation_table_mem head && l = NoBindings then + general_s_rewrite_clause cls lft2rgt c [] gl + else + (* Original code. In particular, [splay_prod] performs delta-reduction. *) + let env = pf_env gl in + let sigma = project gl in + let _,t = splay_prod env sigma t in + match match_with_equation t with + | None -> + if l = NoBindings + then general_s_rewrite_clause cls lft2rgt c [] gl + else error "The term provided does not end with an equation" + | Some (hdcncl,_) -> + let hdcncls = string_of_inductive hdcncl in + let suffix = elimination_suffix (elimination_sort_of_clause cls gl) in + let dir = if cls=None then lft2rgt else not lft2rgt in + let rwr_thm = if dir then hdcncls^suffix^"_r" else hdcncls^suffix in + let elim = + try pf_global gl (id_of_string rwr_thm) + with Not_found -> + error ("Cannot find rewrite principle "^rwr_thm) + in + general_elim_clause cls (c,l) (elim,NoBindings) gl let general_rewrite_bindings = general_rewrite_bindings_clause None let general_rewrite l2r c = general_rewrite_bindings l2r (c,NoBindings) @@ -99,6 +119,37 @@ let general_rewrite_bindings_in l2r id = let general_rewrite_in l2r id c = general_rewrite_bindings_clause (Some id) l2r (c,NoBindings) + +let general_multi_rewrite l2r c cl = + let rec do_hyps = function + | [] -> tclIDTAC + | ((_,id),_) :: l -> + tclTHENFIRST (general_rewrite_bindings_in l2r id c) (do_hyps l) + in + let rec try_do_hyps = function + | [] -> tclIDTAC + | id :: l -> + tclTHENFIRST + (tclTRY (general_rewrite_bindings_in l2r id c)) + (try_do_hyps l) + in + if cl.concl_occs <> [] then + error "The \"at\" syntax isn't available yet for the rewrite tactic" + else + tclTHENFIRST + (if cl.onconcl then general_rewrite_bindings l2r c else tclIDTAC) + (match cl.onhyps with + | Some l -> do_hyps l + | None -> + fun gl -> + (* try to rewrite in all hypothesis + (except maybe the rewritten one) *) + let ids = match kind_of_term (fst c) with + | Var id -> list_remove id (pf_ids_of_hyps gl) + | _ -> pf_ids_of_hyps gl + in try_do_hyps ids gl) + + (* Conditional rewriting, the success of a rewriting is related to the resolution of the conditions by a given tactic *) @@ -472,7 +523,7 @@ let onNegatedEquality tac gls = let discrSimpleClause = function | None -> onNegatedEquality discrEq - | Some (id,_,_) -> onEquality discrEq id + | Some ((_,id),_) -> onEquality discrEq id let discr = onEquality discrEq @@ -496,8 +547,7 @@ let discrHyp id gls = discrClause (onHyp id) gls let find_sigma_data s = match s with - | Prop Pos -> build_sigma_set () (* Set *) - | Type _ -> build_sigma_type () (* Type *) + | Prop Pos | Type _ -> build_sigma_type () (* Set/Type *) | Prop Null -> error "find_sigma_data" (* [make_tuple env sigma (rterm,rty) lind] assumes [lind] is the lesser @@ -505,7 +555,7 @@ let find_sigma_data s = Then we build the term - [(existS A P (mkRel lind) rterm)] of type [(sigS A P)] + [(existT A P (mkRel lind) rterm)] of type [(sigS A P)] where [A] is the type of [mkRel lind] and [P] is [\na:A.rty{1/lind}] *) @@ -636,7 +686,7 @@ let sig_clausal_form env sigma sort_of_ty siglen ty dflt = [make_iterated_tuple sigma env (term,typ) (z,zty)] is to build the tuple - [existS [xn]Pn Rel(in) .. (existS [x2]P2 Rel(i2) (existS [x1]P1 Rel(i1) z))] + [existT [xn]Pn Rel(in) .. (existT [x2]P2 Rel(i2) (existT [x1]P1 Rel(i1) z))] where P1 is zty[i1/x1], P2 is {x1 | P1[i2/x2]} etc. @@ -651,7 +701,7 @@ let sig_clausal_form env sigma sort_of_ty siglen ty dflt = need also to construct a default value for the other branches of the destructor. As default value, we take a tuple of the form - [existS [xn]Pn ?n (... existS [x2]P2 ?2 (existS [x1]P1 ?1 term))] + [existT [xn]Pn ?n (... existT [x2]P2 ?2 (existT [x1]P1 ?1 term))] but for this we have to solve the following unification problem: @@ -866,7 +916,7 @@ let bareRevSubstInConcl lbeq body (t,e1,e2) gls = Given that dep_pair looks like: - (existS e1 (existS e2 ... (existS en en+1) ... )) + (existT e1 (existT e2 ... (existT en en+1) ... )) and B might contain instances of the ei, we will return the term: @@ -1010,7 +1060,7 @@ let unfold_body x gl = | _ -> errorlabstrm "unfold_body" (pr_id x ++ str" is not a defined hypothesis") in let aft = afterHyp x gl in - let hl = List.fold_right (fun (y,yval,_) cl -> (y,[],InHyp) :: cl) aft [] in + let hl = List.fold_right (fun (y,yval,_) cl -> (([],y),InHyp) :: cl) aft [] in let xvar = mkVar x in let rfun _ _ c = replace_term xvar xval c in tclTHENLIST @@ -1089,6 +1139,8 @@ let subst_all gl = let test (_,c) = try let (_,x,y) = snd (find_eq_data_decompose c) in + (* J.F.: added to prevent failure on goal containing x=x as an hyp *) + if eq_constr x y then failwith "caught"; match kind_of_term x with Var x -> x | _ -> match kind_of_term y with Var y -> y | _ -> failwith "caught" with PatternMatchingFailure -> failwith "caught" diff --git a/tactics/equality.mli b/tactics/equality.mli index 3e4bfed7..9ee565c5 100644 --- a/tactics/equality.mli +++ b/tactics/equality.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: equality.mli 8651 2006-03-21 21:54:43Z jforest $ i*) +(*i $Id: equality.mli 8780 2006-05-02 21:58:58Z letouzey $ i*) (*i*) open Names @@ -43,6 +43,9 @@ val general_rewrite_bindings_in : val general_rewrite_in : bool -> identifier -> constr -> tactic +val general_multi_rewrite : + bool -> constr with_bindings -> clause -> tactic + val conditional_rewrite : bool -> tactic -> constr with_bindings -> tactic val conditional_rewrite_in : bool -> identifier -> tactic -> constr with_bindings -> tactic diff --git a/tactics/evar_tactics.ml b/tactics/evar_tactics.ml index 73f88206..31c060f1 100644 --- a/tactics/evar_tactics.ml +++ b/tactics/evar_tactics.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: evar_tactics.ml 7875 2006-01-16 09:55:24Z herbelin $ *) +(* $Id: evar_tactics.ml 8759 2006-04-28 12:24:14Z herbelin $ *) open Term open Util @@ -23,7 +23,7 @@ open Termops let evar_list evc c = let rec evrec acc c = match kind_of_term c with - | Evar (n, _) when Evd.in_dom evc n -> c :: acc + | Evar (n, _) when Evd.mem evc n -> c :: acc | _ -> fold_constr evrec acc c in evrec [] c diff --git a/tactics/extraargs.ml4 b/tactics/extraargs.ml4 index ca1e43cb..5a0b4b8c 100644 --- a/tactics/extraargs.ml4 +++ b/tactics/extraargs.ml4 @@ -8,7 +8,7 @@ (*i camlp4deps: "parsing/grammar.cma" i*) -(* $Id: extraargs.ml4 7841 2006-01-11 11:24:54Z herbelin $ *) +(* $Id: extraargs.ml4 8739 2006-04-26 22:23:37Z herbelin $ *) open Pp open Pcoq @@ -34,7 +34,8 @@ ARGUMENT EXTEND orient TYPED AS bool PRINTED BY pr_orient END (* For Setoid rewrite *) -let pr_morphism_signature _ _ _ = Setoid_replace.pr_morphism_signature +let pr_morphism_signature _ _ _ s = + spc () ++ Setoid_replace.pr_morphism_signature s ARGUMENT EXTEND morphism_signature TYPED AS morphism_signature diff --git a/tactics/extratactics.ml4 b/tactics/extratactics.ml4 index a9ee65d7..48bd87ee 100644 --- a/tactics/extratactics.ml4 +++ b/tactics/extratactics.ml4 @@ -8,7 +8,7 @@ (*i camlp4deps: "parsing/grammar.cma" i*) -(* $Id: extratactics.ml4 8651 2006-03-21 21:54:43Z jforest $ *) +(* $Id: extratactics.ml4 8926 2006-06-08 20:23:17Z herbelin $ *) open Pp open Pcoq @@ -20,6 +20,9 @@ open Names (* Equality *) open Equality +(* Pierre L: for an easy implementation of "rewrite ... in <clause>", rewrite + has moved to g_tactics.ml4 + TACTIC EXTEND rewrite | [ "rewrite" orient(b) constr_with_bindings(c) ] -> [general_rewrite_bindings b c] @@ -30,57 +33,45 @@ TACTIC EXTEND rewrite_in [general_rewrite_bindings_in b h c] END -let h_rewriteLR x = h_rewrite true (x,Rawterm.NoBindings) +let h_rewriteLR x = h_rewrite true (x,Rawterm.NoBindings) +*) (* Julien: Mise en commun des differentes version de replace with in by - TODO: améliorer l'affichage et deplacer dans extraargs + TODO: deplacer dans extraargs *) - -let pr_by_arg_tac prc _ _ opt_c = +let pr_by_arg_tac _prc _prlc prtac opt_c = match opt_c with | None -> mt () - | Some c -> spc () ++ hov 2 (str "by" ++ spc () ) + | Some t -> spc () ++ hov 2 (str "by" ++ spc () ++ prtac (3,Ppextend.E) t) (* Julien Forest: on voudrait pouvoir passer la loc mais je n'ai pas reussi *) -let pr_in_arg_hyp = -fun prc _ _ opt_c-> +let pr_in_arg_hyp _prc _prlc _prtac opt_c = match opt_c with | None -> mt () - | Some c -> - spc () ++ hov 2 (str "by" ++ spc () ++ - Pptactic.pr_or_var (fun _ -> mt ()) - (ArgVar(Util.dummy_loc,c)) - ) - - - + | Some id -> spc () ++ hov 2 (str "by" ++ spc () ++ Nameops.pr_id id) ARGUMENT EXTEND by_arg_tac TYPED AS tactic_opt PRINTED BY pr_by_arg_tac -| [ "by" tactic(c) ] -> [ Some c ] +| [ "by" tactic3(c) ] -> [ Some c ] | [ ] -> [ None ] END ARGUMENT EXTEND in_arg_hyp TYPED AS ident_opt PRINTED BY pr_in_arg_hyp -| [ "in" int_or_var(c) ] -> - [ match c with - | ArgVar(_,c) -> Some (c) - | _ -> Util.error "in must be used with an identifier" - ] +| [ "in" ident(c) ] -> [ Some (c) ] | [ ] -> [ None ] END TACTIC EXTEND replace -| ["replace" constr(c1) "with" constr(c2) in_arg_hyp(in_hyp) by_arg_tac(tac) ] -> - [ new_replace c1 c2 in_hyp (Util.option_app Tacinterp.eval_tactic tac) ] + ["replace" constr(c1) "with" constr(c2) in_arg_hyp(in_hyp) by_arg_tac(tac) ] +-> [ new_replace c1 c2 in_hyp (Util.option_map Tacinterp.eval_tactic tac) ] END (* Julien: diff --git a/tactics/extratactics.mli b/tactics/extratactics.mli index d0034ca5..e42a40e7 100644 --- a/tactics/extratactics.mli +++ b/tactics/extratactics.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: extratactics.mli 8651 2006-03-21 21:54:43Z jforest $ i*) +(*i $Id: extratactics.mli 8780 2006-05-02 21:58:58Z letouzey $ i*) open Names open Term @@ -15,7 +15,6 @@ open Rawterm val h_discrHyp : quantified_hypothesis -> tactic val h_injHyp : quantified_hypothesis -> tactic -val h_rewriteLR : constr -> tactic val refine_tac : Genarg.open_constr -> tactic diff --git a/tactics/hiddentac.ml b/tactics/hiddentac.ml index 1fe1c51e..76014955 100644 --- a/tactics/hiddentac.ml +++ b/tactics/hiddentac.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: hiddentac.ml 7875 2006-01-16 09:55:24Z herbelin $ *) +(* $Id: hiddentac.ml 8878 2006-05-30 16:44:25Z herbelin $ *) open Term open Proof_type @@ -23,7 +23,7 @@ let inj_id id = (dummy_loc,id) (* Basic tactics *) let h_intro_move x y = - abstract_tactic (TacIntroMove (x, option_app inj_id y)) (intro_move x y) + abstract_tactic (TacIntroMove (x, option_map inj_id y)) (intro_move x y) let h_intro x = h_intro_move (Some x) None let h_intros_until x = abstract_tactic (TacIntrosUntil x) (intros_until x) let h_assumption = abstract_tactic TacAssumption assumption @@ -88,7 +88,9 @@ let h_simplest_right = h_right NoBindings (* Conversion *) let h_reduce r cl = abstract_tactic (TacReduce (r,cl)) (reduce r cl) -let h_change oc c cl = abstract_tactic (TacChange (oc,c,cl)) (change oc c cl) +let h_change oc c cl = + abstract_tactic (TacChange (oc,c,cl)) + (change (option_map Redexpr.out_with_occurrences oc) c cl) (* Equivalence relations *) let h_reflexivity = abstract_tactic TacReflexivity intros_reflexivity diff --git a/tactics/hiddentac.mli b/tactics/hiddentac.mli index bfab1f45..df1dfde0 100644 --- a/tactics/hiddentac.mli +++ b/tactics/hiddentac.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: hiddentac.mli 8651 2006-03-21 21:54:43Z jforest $ i*) +(*i $Id: hiddentac.mli 8878 2006-05-30 16:44:25Z herbelin $ i*) (*i*) open Names @@ -89,7 +89,7 @@ val h_simplest_right : tactic (* Conversion *) val h_reduce : Redexpr.red_expr -> Tacticals.clause -> tactic val h_change : - constr occurrences option -> constr -> Tacticals.clause -> tactic + constr with_occurrences option -> constr -> Tacticals.clause -> tactic (* Equivalence relations *) val h_reflexivity : tactic diff --git a/tactics/hipattern.ml4 b/tactics/hipattern.ml4 index 64a0e0f1..fca84fd2 100644 --- a/tactics/hipattern.ml4 +++ b/tactics/hipattern.ml4 @@ -8,7 +8,7 @@ (*i camlp4deps: "parsing/grammar.cma parsing/q_constr.cmo" i*) -(* $Id: hipattern.ml4 8652 2006-03-22 08:27:14Z herbelin $ *) +(* $Id: hipattern.ml4 8866 2006-05-28 16:21:04Z herbelin $ *) open Pp open Util @@ -279,7 +279,6 @@ let dest_nf_eq gls eqn = (* Patterns "(existS ?1 ?2 ?3 ?4)" and "(existT ?1 ?2 ?3 ?4)" *) let coq_ex_pattern_gen ex = lazy PATTERN [ %ex ?X1 ?X2 ?X3 ?X4 ] -let coq_existS_pattern = coq_ex_pattern_gen coq_existS_ref let coq_existT_pattern = coq_ex_pattern_gen coq_existT_ref let match_sigma ex ex_pat = @@ -292,8 +291,7 @@ let match_sigma ex ex_pat = let find_sigma_data_decompose ex = (* fails with PatternMatchingFailure *) first_match (match_sigma ex) - [coq_existS_pattern, build_sigma_set; - coq_existT_pattern, build_sigma_type] + [coq_existT_pattern, build_sigma_type] (* Pattern "(sig ?1 ?2)" *) let coq_sig_pattern = lazy PATTERN [ %coq_sig_ref ?X1 ?X2 ] diff --git a/tactics/hipattern.mli b/tactics/hipattern.mli index 1627a8ca..86cd191e 100644 --- a/tactics/hipattern.mli +++ b/tactics/hipattern.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: hipattern.mli 8652 2006-03-22 08:27:14Z herbelin $ i*) +(*i $Id: hipattern.mli 8866 2006-05-28 16:21:04Z herbelin $ i*) (*i*) open Util @@ -101,7 +101,7 @@ open Coqlib val find_eq_data_decompose : constr -> coq_leibniz_eq_data * (constr * constr * constr) -(* Match a term of the form [(existS A P t p)] or [(existT A P t p)] *) +(* Match a term of the form [(existT A P t p)] *) (* Returns associated lemmas and [A,P,t,p] *) val find_sigma_data_decompose : constr -> coq_sigma_data * (constr * constr * constr * constr) diff --git a/tactics/nbtermdn.ml b/tactics/nbtermdn.ml index 0867d220..554ce2e9 100644 --- a/tactics/nbtermdn.ml +++ b/tactics/nbtermdn.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: nbtermdn.ml 6427 2004-12-07 17:41:10Z sacerdot $ *) +(* $Id: nbtermdn.ml 8752 2006-04-27 19:37:33Z herbelin $ *) open Util open Names @@ -43,14 +43,14 @@ let get_dn dnm hkey = try Gmap.find hkey dnm with Not_found -> Btermdn.create () let add dn (na,(pat,valu)) = - let hkey = option_app fst (Termdn.constr_pat_discr pat) in + let hkey = option_map fst (Termdn.constr_pat_discr pat) in dn.table <- Gmap.add na (pat,valu) dn.table; let dnm = dn.patterns in dn.patterns <- Gmap.add hkey (Btermdn.add (get_dn dnm hkey) (pat,valu)) dnm let rmv dn na = let (pat,valu) = Gmap.find na dn.table in - let hkey = option_app fst (Termdn.constr_pat_discr pat) in + let hkey = option_map fst (Termdn.constr_pat_discr pat) in dn.table <- Gmap.remove na dn.table; let dnm = dn.patterns in dn.patterns <- Gmap.add hkey (Btermdn.rmv (get_dn dnm hkey) (pat,valu)) dnm @@ -62,7 +62,7 @@ let remap ndn na (pat,valu) = add ndn (na,(pat,valu)) let lookup dn valu = - let hkey = option_app fst (Termdn.constr_val_discr valu) in + let hkey = option_map fst (Termdn.constr_val_discr valu) in try Btermdn.lookup (Gmap.find hkey dn.patterns) valu with Not_found -> [] let app f dn = Gmap.iter f dn.table diff --git a/tactics/setoid_replace.ml b/tactics/setoid_replace.ml index a6331927..8c8d4d37 100644 --- a/tactics/setoid_replace.ml +++ b/tactics/setoid_replace.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: setoid_replace.ml 8683 2006-04-05 15:47:39Z letouzey $ *) +(* $Id: setoid_replace.ml 8900 2006-06-06 14:40:27Z letouzey $ *) open Tacmach open Proof_type @@ -85,7 +85,7 @@ type morphism_class = let subst_mps_in_relation_class subst = function Relation t -> Relation (subst_mps subst t) - | Leibniz t -> Leibniz (option_app (subst_mps subst) t) + | Leibniz t -> Leibniz (option_map (subst_mps subst) t) let subst_mps_in_argument_class subst (variance,rel) = variance, subst_mps_in_relation_class subst rel @@ -295,9 +295,9 @@ let relation_morphism_of_constr_morphism = let subst_relation subst relation = let rel_a' = subst_mps subst relation.rel_a in let rel_aeq' = subst_mps subst relation.rel_aeq in - let rel_refl' = option_app (subst_mps subst) relation.rel_refl in - let rel_sym' = option_app (subst_mps subst) relation.rel_sym in - let rel_trans' = option_app (subst_mps subst) relation.rel_trans in + let rel_refl' = option_map (subst_mps subst) relation.rel_refl in + let rel_sym' = option_map (subst_mps subst) relation.rel_sym in + let rel_trans' = option_map (subst_mps subst) relation.rel_trans in let rel_X_relation_class' = subst_mps subst relation.rel_X_relation_class in let rel_Xreflexive_relation_class' = subst_mps subst relation.rel_Xreflexive_relation_class @@ -638,9 +638,9 @@ let apply_to_relation subst rel = assert (new_quantifiers_no >= 0) ; { rel_a = mkApp (rel.rel_a, subst) ; rel_aeq = mkApp (rel.rel_aeq, subst) ; - rel_refl = option_app (fun c -> mkApp (c,subst)) rel.rel_refl ; - rel_sym = option_app (fun c -> mkApp (c,subst)) rel.rel_sym; - rel_trans = option_app (fun c -> mkApp (c,subst)) rel.rel_trans; + rel_refl = option_map (fun c -> mkApp (c,subst)) rel.rel_refl ; + rel_sym = option_map (fun c -> mkApp (c,subst)) rel.rel_sym; + rel_trans = option_map (fun c -> mkApp (c,subst)) rel.rel_trans; rel_quantifiers_no = new_quantifiers_no; rel_X_relation_class = mkApp (rel.rel_X_relation_class, subst); rel_Xreflexive_relation_class = @@ -763,6 +763,8 @@ let unify_relation_class_carrier_with_type env rel t = | Leibniz None -> Leibniz (Some t) | Relation rel -> Relation (unify_relation_carrier_with_type env rel t) +exception Impossible + (* first order matching with a bit of conversion *) (* Note: the type checking operations performed by the function could *) (* be done once and for all abstracting the morphism structure using *) @@ -772,27 +774,28 @@ let unify_relation_class_carrier_with_type env rel t = let unify_morphism_with_arguments gl (c,av) {args=args; output=output; lem=lem; morphism_theory=morphism_theory} t = - let al = Array.to_list av in + let avlen = Array.length av in let argsno = List.length args in - let quantifiers,al' = Util.list_chop (List.length al - argsno) al in + if avlen < argsno then raise Impossible; (* partial application *) + let al = Array.to_list av in + let quantifiers,al' = Util.list_chop (avlen - argsno) al in let quantifiersv = Array.of_list quantifiers in let c' = mkApp (c,quantifiersv) in - if dependent t c' then None else ( - (* these are pf_type_of we could avoid *) - let al'_type = List.map (Tacmach.pf_type_of gl) al' in - let args' = + if dependent t c' then raise Impossible; + (* these are pf_type_of we could avoid *) + let al'_type = List.map (Tacmach.pf_type_of gl) al' in + let args' = List.map2 - (fun (var,rel) ty -> - var,unify_relation_class_carrier_with_type (pf_env gl) rel ty) - args al'_type in - (* this is another pf_type_of we could avoid *) - let ty = Tacmach.pf_type_of gl (mkApp (c,av)) in - let output' = unify_relation_class_carrier_with_type (pf_env gl) output ty in - let lem' = mkApp (lem,quantifiersv) in - let morphism_theory' = mkApp (morphism_theory,quantifiersv) in - Some - ({args=args'; output=output'; lem=lem'; morphism_theory=morphism_theory'}, - c',Array.of_list al')) + (fun (var,rel) ty -> + var,unify_relation_class_carrier_with_type (pf_env gl) rel ty) + args al'_type in + (* this is another pf_type_of we could avoid *) + let ty = Tacmach.pf_type_of gl (mkApp (c,av)) in + let output' = unify_relation_class_carrier_with_type (pf_env gl) output ty in + let lem' = mkApp (lem,quantifiersv) in + let morphism_theory' = mkApp (morphism_theory,quantifiersv) in + ({args=args'; output=output'; lem=lem'; morphism_theory=morphism_theory'}, + c',Array.of_list al') let new_morphism m signature id hook = if Nametab.exists_cci (Lib.make_path id) or is_section_variable id then @@ -1078,9 +1081,9 @@ let int_add_relation id a aeq refl sym trans = let a_instance = apply_to_rels a a_quantifiers_rev in let aeq_instance = apply_to_rels aeq a_quantifiers_rev in let sym_instance = - option_app (fun x -> apply_to_rels x a_quantifiers_rev) sym in + option_map (fun x -> apply_to_rels x a_quantifiers_rev) sym in let refl_instance = - option_app (fun x -> apply_to_rels x a_quantifiers_rev) refl in + option_map (fun x -> apply_to_rels x a_quantifiers_rev) refl in let trans_instance = apply_to_rels trans a_quantifiers_rev in let aeq_rel_class_and_var1, aeq_rel_class_and_var2, lemma, output = match sym_instance, refl_instance with @@ -1134,8 +1137,8 @@ let int_add_relation id a aeq refl sym trans = (* The vernac command "Add Relation ..." *) let add_relation id a aeq refl sym trans = - int_add_relation id (constr_of a) (constr_of aeq) (option_app constr_of refl) - (option_app constr_of sym) (option_app constr_of trans) + int_add_relation id (constr_of a) (constr_of aeq) (option_map constr_of refl) + (option_map constr_of sym) (option_map constr_of trans) (************************ Add Setoid ******************************************) @@ -1383,10 +1386,9 @@ let mark_occur gl ~new_goals t in_c input_relation input_direction = let mors_and_cs_and_als = List.fold_left (fun l (m,c,al) -> - match unify_morphism_with_arguments gl (c,al) m t with - Some res -> res::l - | None -> l - ) [] mors_and_cs_and_als + try (unify_morphism_with_arguments gl (c,al) m t) :: l + with Impossible -> l + ) [] mors_and_cs_and_als in List.filter (fun (mor,_,_) -> subrelation gl mor.output output_relation) @@ -1817,12 +1819,20 @@ let relation_rewrite_in id c1 c2 (direction,eqclause) ~new_goals gl = (* since we will actually rewrite in the opposite direction, we also need to replace every occurrence of c2 (resp. c1) in hyp with something that is convertible but not syntactically equal. To this aim we introduce a - let-in and then we will use the intro tactic to get rid of it *) - let let_in_abstract t in_t = - let t' = lift 1 t in - let in_t' = lift 1 in_t in - mkLetIn (Anonymous,t,pf_type_of gl t,subst_term t' in_t') in - let mangled_new_hyp = Termops.replace_term c1 c2 (let_in_abstract c2 hyp) in + let-in and then we will use the intro tactic to get rid of it. + Quite tricky to do properly since c1 can occur in c2 or vice-versa ! *) + let mangled_new_hyp = + let hyp = lift 2 hyp in + (* first, we backup every occurences of c1 in newly allocated (Rel 1) *) + let hyp = Termops.replace_term (lift 2 c1) (mkRel 1) hyp in + (* then, we factorize every occurences of c2 into (Rel 2) *) + let hyp = Termops.replace_term (lift 2 c2) (mkRel 2) hyp in + (* Now we substitute (Rel 1) (i.e. c1) for c2 *) + let hyp = subst1 (lift 1 c2) hyp in + (* Since subst1 has killed Rel 1 and decreased the other Rels, + Rel 1 is now coding for c2, we can build the let-in factorizing c2 *) + mkLetIn (Anonymous,c2,pf_type_of gl c2,hyp) + in let new_hyp = Termops.replace_term c1 c2 hyp in let oppdir = opposite_direction direction in cut_replacing id new_hyp diff --git a/tactics/setoid_replace.mli b/tactics/setoid_replace.mli index 5dc691a9..750addcc 100644 --- a/tactics/setoid_replace.mli +++ b/tactics/setoid_replace.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: setoid_replace.mli 6621 2005-01-21 17:24:37Z herbelin $ i*) +(*i $Id: setoid_replace.mli 8779 2006-05-02 20:59:21Z letouzey $ i*) open Term open Proof_type @@ -75,3 +75,6 @@ val add_setoid : val new_named_morphism : Names.identifier -> constr_expr -> morphism_signature option -> unit + +val relation_table_find : constr -> relation +val relation_table_mem : constr -> bool diff --git a/tactics/tacinterp.ml b/tactics/tacinterp.ml index e2487c4e..0f487009 100644 --- a/tactics/tacinterp.ml +++ b/tactics/tacinterp.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: tacinterp.ml 8654 2006-03-22 15:36:58Z msozeau $ *) +(* $Id: tacinterp.ml 8926 2006-06-08 20:23:17Z herbelin $ *) open Constrintern open Closure @@ -46,6 +46,7 @@ open Inductiveops open Syntax_def open Pretyping open Pretyping.Default +open Pcoq let error_syntactic_metavariables_not_allowed loc = user_err_loc @@ -514,7 +515,7 @@ let intern_redexp ist = function | Cbv f -> Cbv (intern_flag ist f) | Lazy f -> Lazy (intern_flag ist f) | Pattern l -> Pattern (List.map (intern_constr_occurrence ist) l) - | Simpl o -> Simpl (option_app (intern_constr_occurrence ist) o) + | Simpl o -> Simpl (option_map (intern_constr_occurrence ist) o) | (Red _ | Hnf | ExtraRedExpr _ | CbvVm as r ) -> r @@ -523,14 +524,14 @@ let intern_inversion_strength lf ist = function NonDepInversion (k,List.map (intern_hyp_or_metaid ist) idl, intern_intro_pattern lf ist ids) | DepInversion (k,copt,ids) -> - DepInversion (k, option_app (intern_constr ist) copt, + DepInversion (k, option_map (intern_constr ist) copt, intern_intro_pattern lf ist ids) | InversionUsing (c,idl) -> InversionUsing (intern_constr ist c, List.map (intern_hyp_or_metaid ist) idl) (* Interprets an hypothesis name *) -let intern_hyp_location ist (id,occs,hl) = - (intern_hyp ist (skip_metaid id), occs, hl) +let intern_hyp_location ist ((occs,id),hl) = + ((List.map (intern_int_or_var ist) occs,intern_hyp ist (skip_metaid id)), hl) let interp_constrpattern_gen sigma env ltacvar c = let c = intern_gen false ~allow_soapp:true ~ltacvars:(ltacvar,[]) @@ -618,29 +619,29 @@ let rec intern_atomic lf ist x = TacIntroPattern (List.map (intern_intro_pattern lf ist) l) | TacIntrosUntil hyp -> TacIntrosUntil (intern_quantified_hypothesis ist hyp) | TacIntroMove (ido,ido') -> - TacIntroMove (option_app (intern_ident lf ist) ido, - option_app (intern_hyp ist) ido') + TacIntroMove (option_map (intern_ident lf ist) ido, + option_map (intern_hyp ist) ido') | TacAssumption -> TacAssumption | TacExact c -> TacExact (intern_constr ist c) | TacExactNoCheck c -> TacExactNoCheck (intern_constr ist c) | TacApply cb -> TacApply (intern_constr_with_bindings ist cb) | TacElim (cb,cbo) -> TacElim (intern_constr_with_bindings ist cb, - option_app (intern_constr_with_bindings ist) cbo) + option_map (intern_constr_with_bindings ist) cbo) | TacElimType c -> TacElimType (intern_type ist c) | TacCase cb -> TacCase (intern_constr_with_bindings ist cb) | TacCaseType c -> TacCaseType (intern_type ist c) - | TacFix (idopt,n) -> TacFix (option_app (intern_ident lf ist) idopt,n) + | TacFix (idopt,n) -> TacFix (option_map (intern_ident lf ist) idopt,n) | TacMutualFix (id,n,l) -> let f (id,n,c) = (intern_ident lf ist id,n,intern_type ist c) in TacMutualFix (intern_ident lf ist id, n, List.map f l) - | TacCofix idopt -> TacCofix (option_app (intern_ident lf ist) idopt) + | TacCofix idopt -> TacCofix (option_map (intern_ident lf ist) idopt) | TacMutualCofix (id,l) -> let f (id,c) = (intern_ident lf ist id,intern_type ist c) in TacMutualCofix (intern_ident lf ist id, List.map f l) | TacCut c -> TacCut (intern_type ist c) | TacAssert (otac,ipat,c) -> - TacAssert (option_app (intern_tactic ist) otac, + TacAssert (option_map (intern_tactic ist) otac, intern_intro_pattern lf ist ipat, intern_constr_gen (otac<>None) ist c) | TacGeneralize cl -> TacGeneralize (List.map (intern_constr ist) cl) @@ -660,26 +661,26 @@ let rec intern_atomic lf ist x = (* Automation tactics *) | TacTrivial (lems,l) -> TacTrivial (List.map (intern_constr ist) lems,l) | TacAuto (n,lems,l) -> - TacAuto (option_app (intern_int_or_var ist) n, + TacAuto (option_map (intern_int_or_var ist) n, List.map (intern_constr ist) lems,l) | TacAutoTDB n -> TacAutoTDB n | TacDestructHyp (b,id) -> TacDestructHyp(b,intern_hyp ist id) | TacDestructConcl -> TacDestructConcl | TacSuperAuto (n,l,b1,b2) -> TacSuperAuto (n,l,b1,b2) - | TacDAuto (n,p) -> TacDAuto (option_app (intern_int_or_var ist) n,p) + | TacDAuto (n,p) -> TacDAuto (option_map (intern_int_or_var ist) n,p) (* Derived basic tactics *) | TacSimpleInduction h -> TacSimpleInduction (intern_quantified_hypothesis ist h) | TacNewInduction (lc,cbo,ids) -> TacNewInduction (List.map (intern_induction_arg ist) lc, - option_app (intern_constr_with_bindings ist) cbo, + option_map (intern_constr_with_bindings ist) cbo, (intern_intro_pattern lf ist ids)) | TacSimpleDestruct h -> TacSimpleDestruct (intern_quantified_hypothesis ist h) | TacNewDestruct (c,cbo,ids) -> TacNewDestruct (List.map (intern_induction_arg ist) c, - option_app (intern_constr_with_bindings ist) cbo, + option_map (intern_constr_with_bindings ist) cbo, (intern_intro_pattern lf ist ids)) | TacDoubleInduction (h1,h2) -> let h1 = intern_quantified_hypothesis ist h1 in @@ -703,14 +704,14 @@ let rec intern_atomic lf ist x = | TacLeft bl -> TacLeft (intern_bindings ist bl) | TacRight bl -> TacRight (intern_bindings ist bl) | TacSplit (b,bl) -> TacSplit (b,intern_bindings ist bl) - | TacAnyConstructor t -> TacAnyConstructor (option_app (intern_tactic ist) t) + | TacAnyConstructor t -> TacAnyConstructor (option_map (intern_tactic ist) t) | TacConstructor (n,bl) -> TacConstructor (n, intern_bindings ist bl) (* Conversion *) | TacReduce (r,cl) -> TacReduce (intern_redexp ist r, clause_app (intern_hyp_location ist) cl) | TacChange (occl,c,cl) -> - TacChange (option_app (intern_constr_occurrence ist) occl, + TacChange (option_map (intern_constr_occurrence ist) occl, intern_constr ist c, clause_app (intern_hyp_location ist) cl) (* Equivalence relations *) @@ -720,6 +721,9 @@ let rec intern_atomic lf ist x = | TacTransitivity c -> TacTransitivity (intern_constr ist c) (* Equality and inversion *) + | TacRewrite (b,c,cl) -> + TacRewrite (b,intern_constr_with_bindings ist c, + clause_app (intern_hyp_location ist) cl) | TacInversion (inv,hyp) -> TacInversion (intern_inversion_strength lf ist inv, intern_quantified_hypothesis ist hyp) @@ -750,7 +754,7 @@ and intern_tactic_seq ist = function | TacLetIn (l,u) -> let l = List.map (fun (n,c,b) -> - (n,option_app (intern_tactic ist) c, intern_tacarg !strict_check ist b)) l in + (n,option_map (intern_tactic ist) c, intern_tacarg !strict_check ist b)) l in let (l1,l2) = ist.ltacvars in let ist' = { ist with ltacvars = ((extract_let_names l)@l1,l2) } in ist.ltacvars, TacLetIn (l,intern_tactic ist' u) @@ -864,9 +868,6 @@ and intern_genarg ist x = (intern_quantified_hypothesis ist (out_gen rawwit_quant_hyp x)) | RedExprArgType -> in_gen globwit_red_expr (intern_redexp ist (out_gen rawwit_red_expr x)) - | TacticArgType n -> - in_gen (globwit_tactic n) (intern_tactic ist - (out_gen (rawwit_tactic n) x)) | OpenConstrArgType b -> in_gen (globwit_open_constr_gen b) ((),intern_constr ist (snd (out_gen (rawwit_open_constr_gen b) x))) @@ -880,7 +881,14 @@ and intern_genarg ist x = | List1ArgType _ -> app_list1 (intern_genarg ist) x | OptArgType _ -> app_opt (intern_genarg ist) x | PairArgType _ -> app_pair (intern_genarg ist) (intern_genarg ist) x - | ExtraArgType s -> lookup_genarg_glob s ist x + | ExtraArgType s -> + match tactic_genarg_level s with + | Some n -> + (* Special treatment of tactic arguments *) + in_gen (globwit_tactic n) (intern_tactic ist + (out_gen (rawwit_tactic n) x)) + | None -> + lookup_genarg_glob s ist x (************* End globalization ************) @@ -1121,10 +1129,12 @@ let interp_evaluable ist env = function | ArgVar (_,id) -> coerce_to_evaluable_ref env (List.assoc id ist.lfun) (* Interprets an hypothesis name *) -let interp_hyp_location ist gl (id,occs,hl) = (interp_hyp ist gl id,occs,hl) +let interp_hyp_location ist gl ((occs,id),hl) = + ((List.map (fun n -> ArgArg (interp_int_or_var ist n)) occs, + interp_hyp ist gl id),hl) let interp_clause ist gl { onhyps=ol; onconcl=b; concl_occs=occs } = - { onhyps=option_app(List.map (interp_hyp_location ist gl)) ol; + { onhyps=option_map(List.map (interp_hyp_location ist gl)) ol; onconcl=b; concl_occs=occs } @@ -1194,11 +1204,11 @@ let solve_remaining_evars env initial_sigma evars c = let isevars = ref evars in let rec proc_rec c = match kind_of_term (Reductionops.whd_evar (evars_of !isevars) c) with - | Evar (ev,args as k) when not (Evd.in_dom initial_sigma ev) -> + | Evar (ev,args as k) when not (Evd.mem initial_sigma ev) -> let (loc,src) = evar_source ev !isevars in let sigma = evars_of !isevars in (try - let evi = Evd.map sigma ev in + let evi = Evd.find sigma ev in let c = solvable_by_tactic env evi k src in isevars := Evd.evar_define ev c !isevars; c @@ -1261,7 +1271,9 @@ let interp_unfold ist env (l,qid) = let interp_flag ist env red = { red with rConst = List.map (interp_evaluable ist env) red.rConst } -let interp_pattern ist sigma env (l,c) = (l,interp_constr ist sigma env c) +let interp_pattern ist sigma env (l,c) = + (List.map (fun n -> ArgArg (interp_int_or_var ist n)) l, + interp_constr ist sigma env c) let pf_interp_pattern ist gl = interp_pattern ist (project gl) (pf_env gl) @@ -1271,7 +1283,7 @@ let redexp_interp ist sigma env = function | Cbv f -> Cbv (interp_flag ist env f) | Lazy f -> Lazy (interp_flag ist env f) | Pattern l -> Pattern (List.map (interp_pattern ist sigma env) l) - | Simpl o -> Simpl (option_app (interp_pattern ist sigma env) o) + | Simpl o -> Simpl (option_map (interp_pattern ist sigma env) o) | (Red _ | Hnf | ExtraRedExpr _ | CbvVm as r) -> r let pf_redexp_interp ist gl = redexp_interp ist (project gl) (pf_env gl) @@ -1568,7 +1580,7 @@ and interp_match_context ist g lz lr lmr = db_matched_concl ist.debug (pf_env goal) concl; apply_hyps_context ist env lz goal mt [] lgoal mhyps hyps with e when is_match_catchable e -> - (match e with + (match e with | PatternMatchingFailure -> db_matching_failure ist.debug | Eval_fail s -> db_eval_failure ist.debug s | _ -> db_logic_failure ist.debug e); @@ -1652,7 +1664,6 @@ and interp_genarg ist goal x = (out_gen globwit_quant_hyp x)) | RedExprArgType -> in_gen wit_red_expr (pf_redexp_interp ist goal (out_gen globwit_red_expr x)) - | TacticArgType n -> in_gen (wit_tactic n) (out_gen (globwit_tactic n) x) | OpenConstrArgType casted -> in_gen (wit_open_constr_gen casted) (pf_interp_open_constr casted ist goal @@ -1667,7 +1678,13 @@ and interp_genarg ist goal x = | List1ArgType _ -> app_list1 (interp_genarg ist goal) x | OptArgType _ -> app_opt (interp_genarg ist goal) x | PairArgType _ -> app_pair (interp_genarg ist goal) (interp_genarg ist goal) x - | ExtraArgType s -> lookup_interp_genarg s ist goal x + | ExtraArgType s -> + match tactic_genarg_level s with + | Some n -> + (* Special treatment of tactic arguments *) + in_gen (wit_tactic n) (out_gen (globwit_tactic n) x) + | None -> + lookup_interp_genarg s ist goal x (* Interprets the Match expressions *) and interp_match ist g lz constr lmr = @@ -1719,23 +1736,23 @@ and interp_atomic ist gl = function | TacIntrosUntil hyp -> h_intros_until (interp_quantified_hypothesis ist hyp) | TacIntroMove (ido,ido') -> - h_intro_move (option_app (interp_ident ist) ido) - (option_app (interp_hyp ist gl) ido') + h_intro_move (option_map (interp_ident ist) ido) + (option_map (interp_hyp ist gl) ido') | TacAssumption -> h_assumption | TacExact c -> h_exact (pf_interp_casted_constr ist gl c) | TacExactNoCheck c -> h_exact_no_check (pf_interp_constr ist gl c) | TacApply cb -> h_apply (interp_constr_with_bindings ist gl cb) | TacElim (cb,cbo) -> h_elim (interp_constr_with_bindings ist gl cb) - (option_app (interp_constr_with_bindings ist gl) cbo) + (option_map (interp_constr_with_bindings ist gl) cbo) | TacElimType c -> h_elim_type (pf_interp_type ist gl c) | TacCase cb -> h_case (interp_constr_with_bindings ist gl cb) | TacCaseType c -> h_case_type (pf_interp_type ist gl c) - | TacFix (idopt,n) -> h_fix (option_app (interp_ident ist) idopt) n + | TacFix (idopt,n) -> h_fix (option_map (interp_ident ist) idopt) n | TacMutualFix (id,n,l) -> let f (id,n,c) = (interp_ident ist id,n,pf_interp_type ist gl c) in h_mutual_fix (interp_ident ist id) n (List.map f l) - | TacCofix idopt -> h_cofix (option_app (interp_ident ist) idopt) + | TacCofix idopt -> h_cofix (option_map (interp_ident ist) idopt) | TacMutualCofix (id,l) -> let f (id,c) = (interp_ident ist id,pf_interp_type ist gl c) in h_mutual_cofix (interp_ident ist id) (List.map f l) @@ -1743,7 +1760,7 @@ and interp_atomic ist gl = function | TacAssert (t,ipat,c) -> let c = (if t=None then pf_interp_constr else pf_interp_type) ist gl c in abstract_tactic (TacAssert (t,ipat,c)) - (Tactics.forward (option_app (interp_tactic ist) t) + (Tactics.forward (option_map (interp_tactic ist) t) (interp_intro_pattern ist ipat) c) | TacGeneralize cl -> h_generalize (List.map (pf_interp_constr ist gl) cl) | TacGeneralizeDep c -> h_generalize_dep (pf_interp_constr ist gl c) @@ -1760,29 +1777,29 @@ and interp_atomic ist gl = function (* Automation tactics *) | TacTrivial (lems,l) -> Auto.h_trivial (List.map (pf_interp_constr ist gl) lems) - (option_app (List.map (interp_hint_base ist)) l) + (option_map (List.map (interp_hint_base ist)) l) | TacAuto (n,lems,l) -> - Auto.h_auto (option_app (interp_int_or_var ist) n) + Auto.h_auto (option_map (interp_int_or_var ist) n) (List.map (pf_interp_constr ist gl) lems) - (option_app (List.map (interp_hint_base ist)) l) + (option_map (List.map (interp_hint_base ist)) l) | TacAutoTDB n -> Dhyp.h_auto_tdb n | TacDestructHyp (b,id) -> Dhyp.h_destructHyp b (interp_hyp ist gl id) | TacDestructConcl -> Dhyp.h_destructConcl | TacSuperAuto (n,l,b1,b2) -> Auto.h_superauto n l b1 b2 - | TacDAuto (n,p) -> Auto.h_dauto (option_app (interp_int_or_var ist) n,p) + | TacDAuto (n,p) -> Auto.h_dauto (option_map (interp_int_or_var ist) n,p) (* Derived basic tactics *) | TacSimpleInduction h -> h_simple_induction (interp_quantified_hypothesis ist h) | TacNewInduction (lc,cbo,ids) -> h_new_induction (List.map (interp_induction_arg ist gl) lc) - (option_app (interp_constr_with_bindings ist gl) cbo) + (option_map (interp_constr_with_bindings ist gl) cbo) (interp_intro_pattern ist ids) | TacSimpleDestruct h -> h_simple_destruct (interp_quantified_hypothesis ist h) | TacNewDestruct (c,cbo,ids) -> h_new_destruct (List.map (interp_induction_arg ist gl) c) - (option_app (interp_constr_with_bindings ist gl) cbo) + (option_map (interp_constr_with_bindings ist gl) cbo) (interp_intro_pattern ist ids) | TacDoubleInduction (h1,h2) -> let h1 = interp_quantified_hypothesis ist h1 in @@ -1811,7 +1828,7 @@ and interp_atomic ist gl = function | TacSplit (_,bl) -> h_split (interp_bindings ist gl bl) | TacAnyConstructor t -> abstract_tactic (TacAnyConstructor t) - (Tactics.any_constructor (option_app (interp_tactic ist) t)) + (Tactics.any_constructor (option_map (interp_tactic ist) t)) | TacConstructor (n,bl) -> h_constructor (skip_metaid n) (interp_bindings ist gl bl) @@ -1819,7 +1836,7 @@ and interp_atomic ist gl = function | TacReduce (r,cl) -> h_reduce (pf_redexp_interp ist gl r) (interp_clause ist gl cl) | TacChange (occl,c,cl) -> - h_change (option_app (pf_interp_pattern ist gl) occl) + h_change (option_map (pf_interp_pattern ist gl) occl) (pf_interp_constr ist gl c) (interp_clause ist gl cl) (* Equivalence relations *) @@ -1828,8 +1845,12 @@ and interp_atomic ist gl = function | TacTransitivity c -> h_transitivity (pf_interp_constr ist gl c) (* Equality and inversion *) + | TacRewrite (b,c,cl) -> + Equality.general_multi_rewrite b + (interp_constr_with_bindings ist gl c) + (interp_clause ist gl cl) | TacInversion (DepInversion (k,c,ids),hyp) -> - Inv.dinv k (option_app (pf_interp_constr ist gl) c) + Inv.dinv k (option_map (pf_interp_constr ist gl) c) (interp_intro_pattern ist ids) (interp_declared_or_quantified_hypothesis ist gl hyp) | TacInversion (NonDepInversion (k,idl,ids),hyp) -> @@ -1868,13 +1889,17 @@ and interp_atomic ist gl = function | ConstrMayEvalArgType -> VConstr (interp_constr_may_eval ist gl (out_gen globwit_constr_may_eval x)) - | TacticArgType n -> - val_interp ist gl (out_gen (globwit_tactic n) x) + | ExtraArgType s when tactic_genarg_level s <> None -> + (* Special treatment of tactic arguments *) + val_interp ist gl + (out_gen (globwit_tactic (out_some (tactic_genarg_level s))) x) | StringArgType | BoolArgType | QuantHypArgType | RedExprArgType - | OpenConstrArgType _ | ConstrWithBindingsArgType | BindingsArgType - | ExtraArgType _ | List0ArgType _ | List1ArgType _ | OptArgType _ | PairArgType _ + | OpenConstrArgType _ | ConstrWithBindingsArgType + | ExtraArgType _ | BindingsArgType + | List0ArgType _ | List1ArgType _ | OptArgType _ | PairArgType _ -> error "This generic type is not supported in alias" + in let lfun = (List.map (fun (x,c) -> (x,f c)) l)@ist.lfun in let v = locate_tactic_call loc (val_interp { ist with lfun=lfun } gl body) @@ -1938,7 +1963,7 @@ let subst_and_short_name f (c,n) = let subst_or_var f = function | ArgVar _ as x -> x - | ArgArg (x) -> ArgArg (f x) + | ArgArg x -> ArgArg (f x) let subst_located f (_loc,id) = (loc,f id) @@ -1977,7 +2002,7 @@ let subst_redexp subst = function | Cbv f -> Cbv (subst_flag subst f) | Lazy f -> Lazy (subst_flag subst f) | Pattern l -> Pattern (List.map (subst_constr_occurrence subst) l) - | Simpl o -> Simpl (option_app (subst_constr_occurrence subst) o) + | Simpl o -> Simpl (option_map (subst_constr_occurrence subst) o) | (Red _ | Hnf | ExtraRedExpr _ | CbvVm as r) -> r let subst_raw_may_eval subst = function @@ -2005,7 +2030,7 @@ let rec subst_atomic subst (t:glob_atomic_tactic_expr) = match t with | TacApply cb -> TacApply (subst_raw_with_bindings subst cb) | TacElim (cb,cbo) -> TacElim (subst_raw_with_bindings subst cb, - option_app (subst_raw_with_bindings subst) cbo) + option_map (subst_raw_with_bindings subst) cbo) | TacElimType c -> TacElimType (subst_rawconstr subst c) | TacCase cb -> TacCase (subst_raw_with_bindings subst cb) | TacCaseType c -> TacCaseType (subst_rawconstr subst c) @@ -2035,11 +2060,11 @@ let rec subst_atomic subst (t:glob_atomic_tactic_expr) = match t with | TacSimpleInduction h as x -> x | TacNewInduction (lc,cbo,ids) -> (* Pierre C. est-ce correct? *) TacNewInduction (List.map (subst_induction_arg subst) lc, - option_app (subst_raw_with_bindings subst) cbo, ids) + option_map (subst_raw_with_bindings subst) cbo, ids) | TacSimpleDestruct h as x -> x | TacNewDestruct (c,cbo,ids) -> TacNewDestruct (List.map (subst_induction_arg subst) c, (* Julien F. est-ce correct? *) - option_app (subst_raw_with_bindings subst) cbo, ids) + option_map (subst_raw_with_bindings subst) cbo, ids) | TacDoubleInduction (h1,h2) as x -> x | TacDecomposeAnd c -> TacDecomposeAnd (subst_rawconstr subst c) | TacDecomposeOr c -> TacDecomposeOr (subst_rawconstr subst c) @@ -2059,13 +2084,13 @@ let rec subst_atomic subst (t:glob_atomic_tactic_expr) = match t with | TacLeft bl -> TacLeft (subst_bindings subst bl) | TacRight bl -> TacRight (subst_bindings subst bl) | TacSplit (b,bl) -> TacSplit (b,subst_bindings subst bl) - | TacAnyConstructor t -> TacAnyConstructor (option_app (subst_tactic subst) t) + | TacAnyConstructor t -> TacAnyConstructor (option_map (subst_tactic subst) t) | TacConstructor (n,bl) -> TacConstructor (n, subst_bindings subst bl) (* Conversion *) | TacReduce (r,cl) -> TacReduce (subst_redexp subst r, cl) | TacChange (occl,c,cl) -> - TacChange (option_app (subst_constr_occurrence subst) occl, + TacChange (option_map (subst_constr_occurrence subst) occl, subst_rawconstr subst c, cl) (* Equivalence relations *) @@ -2073,8 +2098,9 @@ let rec subst_atomic subst (t:glob_atomic_tactic_expr) = match t with | TacTransitivity c -> TacTransitivity (subst_rawconstr subst c) (* Equality and inversion *) + | TacRewrite (b,c,cl) -> TacRewrite (b, subst_raw_with_bindings subst c,cl) | TacInversion (DepInversion (k,c,l),hyp) -> - TacInversion (DepInversion (k,option_app (subst_rawconstr subst) c,l),hyp) + TacInversion (DepInversion (k,option_map (subst_rawconstr subst) c,l),hyp) | TacInversion (NonDepInversion _,_) as x -> x | TacInversion (InversionUsing (c,cl),hyp) -> TacInversion (InversionUsing (subst_rawconstr subst c,cl),hyp) @@ -2093,7 +2119,7 @@ and subst_tactic subst (t:glob_tactic_expr) = match t with let lrc = List.map (fun (n,b) -> (n,subst_tactic_fun subst b)) lrc in TacLetRecIn (lrc,(subst_tactic subst u:glob_tactic_expr)) | TacLetIn (l,u) -> - let l = List.map (fun (n,c,b) -> (n,option_app (subst_tactic subst) c,subst_tacarg subst b)) l in + let l = List.map (fun (n,c,b) -> (n,option_map (subst_tactic subst) c,subst_tacarg subst b)) l in TacLetIn (l,subst_tactic subst u) | TacMatchContext (lz,lr,lmr) -> TacMatchContext(lz,lr, subst_match_rule subst lmr) @@ -2172,9 +2198,6 @@ 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)) - | TacticArgType n -> - in_gen (globwit_tactic n) - (subst_tactic subst (out_gen (globwit_tactic n) x)) | OpenConstrArgType b -> in_gen (globwit_open_constr_gen b) ((),subst_rawconstr subst (snd (out_gen (globwit_open_constr_gen b) x))) @@ -2188,7 +2211,14 @@ and subst_genarg subst (x:glob_generic_argument) = | List1ArgType _ -> app_list1 (subst_genarg subst) x | OptArgType _ -> app_opt (subst_genarg subst) x | PairArgType _ -> app_pair (subst_genarg subst) (subst_genarg subst) x - | ExtraArgType s -> lookup_genarg_subst s subst x + | ExtraArgType s -> + match tactic_genarg_level s with + | Some n -> + (* Special treatment of tactic arguments *) + in_gen (globwit_tactic n) + (subst_tactic subst (out_gen (globwit_tactic n) x)) + | None -> + lookup_genarg_subst s subst x (***************************************************************************) (* Tactic registration *) diff --git a/tactics/tacticals.ml b/tactics/tacticals.ml index d7bbb2a4..ff6ac41a 100644 --- a/tactics/tacticals.ml +++ b/tactics/tacticals.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: tacticals.ml 7909 2006-01-21 11:09:18Z herbelin $ *) +(* $Id: tacticals.ml 8878 2006-05-30 16:44:25Z herbelin $ *) open Pp open Util @@ -119,13 +119,13 @@ type clause = identifier gclause let allClauses = { onhyps=None; onconcl=true; concl_occs=[] } let allHyps = { onhyps=None; onconcl=false; concl_occs=[] } -let onHyp id = { onhyps=Some[(id,[],InHyp)]; onconcl=false; concl_occs=[] } +let onHyp id = { onhyps=Some[(([],id),InHyp)]; onconcl=false; concl_occs=[] } let onConcl = { onhyps=Some[]; onconcl=true; concl_occs=[] } let simple_clause_list_of cl gls = let hyps = match cl.onhyps with - None -> List.map (fun id -> Some(id,[],InHyp)) (pf_ids_of_hyps gls) + None -> List.map (fun id -> Some(([],id),InHyp)) (pf_ids_of_hyps gls) | Some l -> List.map (fun h -> Some h) l in if cl.onconcl then None::hyps else hyps @@ -167,7 +167,7 @@ let nth_clause n gl = let clause_type cls gl = match simple_clause_of cls with | None -> pf_concl gl - | Some (id,_,_) -> pf_get_hyp_typ gl id + | Some ((_,id),_) -> pf_get_hyp_typ gl id (* Functions concerning matching of clausal environments *) @@ -217,7 +217,7 @@ let onAllClausesLR tac = onClausesLR tac allClauses let onNthLastHyp n tac gls = tac (nth_clause n gls) gls let tryAllHyps tac = - tryClauses (function Some(id,_,_) -> tac id | _ -> assert false) allHyps + tryClauses (function Some((_,id),_) -> tac id | _ -> assert false) allHyps let onNLastHyps n tac = onHyps (nLastHyps n) (tclMAP tac) let onLastHyp tac gls = tac (lastHyp gls) gls diff --git a/tactics/tactics.ml b/tactics/tactics.ml index 1d97dc4f..4eaf0259 100644 --- a/tactics/tactics.ml +++ b/tactics/tactics.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: tactics.ml 8701 2006-04-12 08:07:35Z courtieu $ *) +(* $Id: tactics.ml 8878 2006-05-30 16:44:25Z herbelin $ *) open Pp open Util @@ -147,7 +147,7 @@ type tactic_reduction = env -> evar_map -> constr -> constr let reduct_in_concl (redfun,sty) gl = convert_concl_no_check (pf_reduce redfun gl (pf_concl gl)) sty gl -let reduct_in_hyp redfun (id,_,where) gl = +let reduct_in_hyp redfun ((_,id),where) gl = let (_,c, ty) = pf_get_hyp gl id in let redfun' = (*under_casts*) (pf_reduce redfun gl) in match c with @@ -967,19 +967,21 @@ let quantify lconstr = the left of each x1, ...). *) - +let out_arg = function + | ArgVar _ -> anomaly "Unevaluated or_var variable" + | ArgArg x -> x let occurrences_of_hyp id cls = let rec hyp_occ = function [] -> None - | (id',occs,hl)::_ when id=id' -> Some occs + | ((occs,id'),hl)::_ when id=id' -> Some (List.map out_arg occs) | _::l -> hyp_occ l in match cls.onhyps with None -> Some [] | Some l -> hyp_occ l let occurrences_of_goal cls = - if cls.onconcl then Some cls.concl_occs else None + if cls.onconcl then Some (List.map out_arg cls.concl_occs) else None let in_every_hyp cls = (cls.onhyps=None) @@ -1001,7 +1003,7 @@ let letin_abstract id c occs gl = then raise (RefinerError (DoesNotOccurIn (c,hyp))) else raise Not_found else - (subst1_decl (mkVar id) newdecl, true) + (subst1_named_decl (mkVar id) newdecl, true) with Not_found -> (d,List.exists (fun ((id,_,_),dep) -> dep && occur_var_in_decl env id d) ctxt) @@ -1053,7 +1055,7 @@ let letin_abstract id c occs gl = then raise (RefinerError (DoesNotOccurIn (c,hyp))) else depdecls else - (subst1_decl (mkVar id) newdecl)::depdecls in + (subst1_named_decl (mkVar id) newdecl)::depdecls in let depdecls = fold_named_context compute_dependency env ~init:[] in let ccl = match occurrences_of_goal occs with | None -> pf_concl gl @@ -1081,9 +1083,9 @@ let forward usetac ipat c gl = match usetac with | None -> let t = refresh_universes (pf_type_of gl c) in - tclTHENS (assert_as true ipat t) [exact_no_check c; tclIDTAC] gl + tclTHENFIRST (assert_as true ipat t) (exact_no_check c) gl | Some tac -> - tclTHENS (assert_as true ipat c) [tac; tclIDTAC] gl + tclTHENFIRST (assert_as true ipat c) tac gl (*****************************) (* High-level induction *) @@ -2004,7 +2006,7 @@ let unfold_body x gl = | _ -> errorlabstrm "unfold_body" (pr_id x ++ str" is not a defined hypothesis") in let aft = afterHyp x gl in - let hl = List.fold_right (fun (y,yval,_) cl -> (y,[],InHyp) :: cl) aft [] in + let hl = List.fold_right (fun (y,yval,_) cl -> (([],y),InHyp) :: cl) aft [] in let xvar = mkVar x in let rfun _ _ c = replace_term xvar xval c in tclTHENLIST @@ -2191,7 +2193,7 @@ let dAnd cls = onClauses (function | None -> simplest_split - | Some (id,_,_) -> andE id) + | Some ((_,id),_) -> andE id) cls let orE id gl = @@ -2205,7 +2207,7 @@ let orE id gl = let dorE b cls = onClauses (function - | (Some (id,_,_)) -> orE id + | (Some ((_,id),_)) -> orE id | None -> (if b then right else left) NoBindings) cls @@ -2225,7 +2227,7 @@ let dImp cls = onClauses (function | None -> intro - | Some (id,_,_) -> impE id) + | Some ((_,id),_) -> impE id) cls (************************************************) @@ -2300,7 +2302,7 @@ let intros_symmetry = onClauses (function | None -> tclTHEN intros symmetry - | Some (id,_,_) -> symmetry_in id) + | Some ((_,id),_) -> symmetry_in id) (* Transitivity tactics *) diff --git a/tactics/tactics.mli b/tactics/tactics.mli index 5d04da9a..aaacee8f 100644 --- a/tactics/tactics.mli +++ b/tactics/tactics.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: tactics.mli 8698 2006-04-11 15:12:48Z jforest $ i*) +(*i $Id: tactics.mli 8878 2006-05-30 16:44:25Z herbelin $ i*) (*i*) open Names @@ -115,8 +115,8 @@ type tactic_reduction = env -> evar_map -> constr -> constr val reduct_in_hyp : tactic_reduction -> hyp_location -> tactic val reduct_option : tactic_reduction * cast_kind -> simple_clause -> tactic val reduct_in_concl : tactic_reduction * cast_kind -> tactic -val change_in_concl : constr occurrences option -> constr -> tactic -val change_in_hyp : constr occurrences option -> constr -> hyp_location -> +val change_in_concl : (int list * constr) option -> constr -> tactic +val change_in_hyp : (int list * constr) option -> constr -> hyp_location -> tactic val red_in_concl : tactic val red_in_hyp : hyp_location -> tactic @@ -139,7 +139,7 @@ val unfold_option : -> tactic val reduce : red_expr -> clause -> tactic val change : - constr occurrences option -> constr -> clause -> tactic + (int list * constr) option -> constr -> clause -> tactic val unfold_constr : global_reference -> tactic val pattern_option : (int list * constr) list -> simple_clause -> tactic diff --git a/test-suite/failure/Uminus.v b/test-suite/failure/Uminus.v new file mode 100644 index 00000000..6866f19a --- /dev/null +++ b/test-suite/failure/Uminus.v @@ -0,0 +1,62 @@ +(* Check that the encoding of system U- fails *) + +Inductive prop : Prop := down : Prop -> prop. + +Definition up (p:prop) : Prop := let (A) := p in A. + +Lemma p2p1 : forall A:Prop, up (down A) -> A. +Proof. +exact (fun A x => x). +Qed. + +Lemma p2p2 : forall A:Prop, A -> up (down A). +Proof. +exact (fun A x => x). +Qed. + +(** Hurkens' paradox *) + +Definition V := forall A:Prop, ((A -> prop) -> A -> prop) -> A -> prop. +Definition U := V -> prop. +Definition sb (z:V) : V := fun A r a => r (z A r) a. +Definition le (i:U -> prop) (x:U) : prop := + x (fun A r a => i (fun v => sb v A r a)). +Definition induct (i:U -> prop) : Prop := + forall x:U, up (le i x) -> up (i x). +Definition WF : U := fun z => down (induct (z U le)). +Definition I (x:U) : Prop := + (forall i:U -> prop, up (le i x) -> up (i (fun v => sb v U le x))) -> False. + +Lemma Omega : forall i:U -> prop, induct i -> up (i WF). +Proof. +intros i y. +apply y. +unfold le, WF, induct in |- *. +intros x H0. +apply y. +exact H0. +Qed. + +Lemma lemma1 : induct (fun u => down (I u)). +Proof. +unfold induct in |- *. +intros x p. +intro q. +apply (q (fun u => down (I u)) p). +intro i. +apply q with (i := fun y => i (fun v:V => sb v U le y)). +Qed. + +Lemma lemma2 : (forall i:U -> prop, induct i -> up (i WF)) -> False. +Proof. +intro x. +apply (x (fun u => down (I u)) lemma1). +intros i H0. +apply (x (fun y => i (fun v => sb v U le y))). +apply H0. +Qed. + +Theorem paradox : False. +Proof. +exact (lemma2 Omega). +Qed. diff --git a/test-suite/modules/mod_decl.v b/test-suite/modules/mod_decl.v index aad493ce..b886eb59 100644 --- a/test-suite/modules/mod_decl.v +++ b/test-suite/modules/mod_decl.v @@ -34,7 +34,7 @@ Module Type T. Declare Module M1: SIG. - Declare Module M2 <: SIG. + Module M2 <: SIG. Definition A := nat. End M2. diff --git a/test-suite/modules/objects2.v b/test-suite/modules/objects2.v new file mode 100644 index 00000000..e286609e --- /dev/null +++ b/test-suite/modules/objects2.v @@ -0,0 +1,11 @@ +(* Check that non logical object loading is done after registration of + the logical objects in the environment +*) + +(* Bug #1118 (simplified version), submitted by Evelyne Contejean + (used to failed in pre-V8.1 trunk because of a call to lookup_mind + for structure objects) +*) + +Module Type S. Record t : Set := { a : nat; b : nat }. End S. +Module Make (X:S). Module Y:=X. End Make. diff --git a/test-suite/output/Cases.out b/test-suite/output/Cases.out index 63137edb..a3033e94 100644 --- a/test-suite/output/Cases.out +++ b/test-suite/output/Cases.out @@ -2,7 +2,7 @@ t_rect = fun (P : t -> Type) (f : let x := t in forall x0 : x, P x0 -> P (k x0)) => fix F (t : t) : P t := match t as t0 return (P t0) with - | k x x0 => f x0 (F x0) + | k _ x0 => f x0 (F x0) end : forall P : t -> Type, (let x := t in forall x0 : x, P x0 -> P (k x0)) -> forall t : t, P t diff --git a/test-suite/output/InitSyntax.out b/test-suite/output/InitSyntax.out index 4ed72c50..c7f3ed7d 100644 --- a/test-suite/output/InitSyntax.out +++ b/test-suite/output/InitSyntax.out @@ -1,4 +1,4 @@ -Inductive sig2 (A : Set) (P : A -> Prop) (Q : A -> Prop) : Set := +Inductive sig2 (A : Type) (P : A -> Prop) (Q : A -> Prop) : Type := exist2 : forall x : A, P x -> Q x -> sig2 P Q For sig2: Argument A is implicit For exist2: Argument A is implicit diff --git a/test-suite/output/Tactics.out b/test-suite/output/Tactics.out index 71c59e43..8e8b8059 100644 --- a/test-suite/output/Tactics.out +++ b/test-suite/output/Tactics.out @@ -1 +1,4 @@ intro H; split; [ a H | e H ]. +intros; match goal with + | |- context [if ?X then _ else _] => case X + end; trivial. diff --git a/test-suite/output/Tactics.v b/test-suite/output/Tactics.v index 24a33651..8fa91994 100644 --- a/test-suite/output/Tactics.v +++ b/test-suite/output/Tactics.v @@ -7,3 +7,12 @@ Lemma test : True -> True /\ True. intro H; split; [a H|e H]. Show Script. Qed. + +(* Test printing of match context *) +(* Used to fail after translator removal (see bug #1070) *) + +Lemma test2 : forall n:nat, forall f: nat -> bool, O = if (f n) then O else O. +Proof. +intros;match goal with |- context [if ?X then _ else _ ] => case X end;trivial. +Show Script. +Qed. diff --git a/test-suite/success/Destruct.v b/test-suite/success/Destruct.v deleted file mode 100644 index b909e45e..00000000 --- a/test-suite/success/Destruct.v +++ /dev/null @@ -1,13 +0,0 @@ -(* Submitted by Robert Schneck *) - -Parameter A B C D : Prop. -Axiom X : A -> B -> C /\ D. - -Lemma foo : A -> B -> C. -Proof. -intros. -destruct X. (* Should find axiom X and should handle arguments of X *) -assumption. -assumption. -assumption. -Qed. diff --git a/test-suite/success/Funind.v b/test-suite/success/Funind.v index 84a58a3a..939d06c7 100644 --- a/test-suite/success/Funind.v +++ b/test-suite/success/Funind.v @@ -5,25 +5,17 @@ Definition iszero (n : nat) : bool := | _ => false end. - Functional Scheme iszer_ind := Induction for iszero. +Functional Scheme iszero_ind := Induction for iszero Sort Prop. Lemma toto : forall n : nat, n = 0 -> iszero n = true. intros x eg. functional induction iszero x; simpl in |- *. trivial. - subst x. -inversion H_eq_. +inversion eg. Qed. -(* We can even reuse the proof as a scheme: *) - - Functional Scheme toto_ind := Induction for iszero. - - - - -Definition ftest (n m : nat) : nat := +Function ftest (n m : nat) : nat := match n with | O => match m with | O => 0 @@ -32,27 +24,25 @@ Definition ftest (n m : nat) : nat := | S p => 0 end. - Functional Scheme ftest_ind := Induction for ftest. - Lemma test1 : forall n m : nat, ftest n m <= 2. intros n m. functional induction ftest n m; auto. Qed. - +Require Import Arith. Lemma test11 : forall m : nat, ftest 0 m <= 2. intros m. functional induction ftest 0 m. auto. -auto. +auto. +auto with *. Qed. - -Definition lamfix (m : nat) := - fix trivfun (n : nat) : nat := match n with - | O => m - | S p => trivfun p - end. +Function lamfix (m n : nat) {struct n } : nat := + match n with + | O => m + | S p => lamfix m p + end. (* Parameter v1 v2 : nat. *) @@ -68,12 +58,12 @@ Defined. (* polymorphic function *) Require Import List. - Functional Scheme app_ind := Induction for app. +Functional Scheme app_ind := Induction for app Sort Prop. Lemma appnil : forall (A : Set) (l l' : list A), l' = nil -> l = l ++ l'. intros A l l'. functional induction app A l l'; intuition. - rewrite <- H1; trivial. + rewrite <- H0; trivial. Qed. @@ -83,7 +73,7 @@ Qed. Require Export Arith. -Fixpoint trivfun (n : nat) : nat := +Function trivfun (n : nat) : nat := match n with | O => 0 | S m => trivfun m @@ -97,18 +87,16 @@ Parameter varessai : nat. Lemma first_try : trivfun varessai = 0. functional induction trivfun varessai. trivial. -simpl in |- *. assumption. Defined. - Functional Scheme triv_ind := Induction for trivfun. + Functional Scheme triv_ind := Induction for trivfun Sort Prop. Lemma bisrepetita : forall n' : nat, trivfun n' = 0. intros n'. functional induction trivfun n'. trivial. -simpl in |- *. assumption. Qed. @@ -118,14 +106,14 @@ Qed. -Fixpoint iseven (n : nat) : bool := +Function iseven (n : nat) : bool := match n with | O => true | S (S m) => iseven m | _ => false end. -Fixpoint funex (n : nat) : nat := +Function funex (n : nat) : nat := match iseven n with | true => n | false => match n with @@ -134,7 +122,7 @@ Fixpoint funex (n : nat) : nat := end end. -Fixpoint nat_equal_bool (n m : nat) {struct n} : bool := +Function nat_equal_bool (n m : nat) {struct n} : bool := match n with | O => match m with | O => true @@ -149,6 +137,7 @@ Fixpoint nat_equal_bool (n m : nat) {struct n} : bool := Require Export Div2. +Functional Scheme div2_ind := Induction for div2 Sort Prop. Lemma div2_inf : forall n : nat, div2 n <= n. intros n. functional induction div2 n. @@ -157,34 +146,27 @@ auto. apply le_S. apply le_n_S. -exact H. +exact IHn0. Qed. (* reuse this lemma as a scheme:*) - Functional Scheme div2_ind := Induction for div2_inf. -Fixpoint nested_lam (n : nat) : nat -> nat := +Function nested_lam (n : nat) : nat -> nat := match n with | O => fun m : nat => 0 | S n' => fun m : nat => m + nested_lam n' m end. - Functional Scheme nested_lam_ind := Induction for nested_lam. Lemma nest : forall n m : nat, nested_lam n m = n * m. intros n m. - functional induction nested_lam n m; auto. -Qed. - -Lemma nest2 : forall n m : nat, nested_lam n m = n * m. -intros n m. pattern n, m in |- *. -apply nested_lam_ind; simpl in |- *; intros; auto. + functional induction nested_lam n m; simpl;auto. Qed. -Fixpoint essai (x : nat) (p : nat * nat) {struct x} : nat := - let (n, m) := p in +Function essai (x : nat) (p : nat * nat) {struct x} : nat := + let (n, m) := (p: nat*nat) in match n with | O => 0 | S q => match x with @@ -198,12 +180,12 @@ Lemma essai_essai : intros x p. functional induction essai x p; intros. inversion H. -simpl in |- *; try abstract auto with arith. -simpl in |- *; try abstract auto with arith. +auto with arith. + auto with arith. Qed. -Fixpoint plus_x_not_five'' (n m : nat) {struct n} : nat := +Function plus_x_not_five'' (n m : nat) {struct n} : nat := let x := nat_equal_bool m 5 in let y := 0 in match n with @@ -218,21 +200,18 @@ Fixpoint plus_x_not_five'' (n m : nat) {struct n} : nat := Lemma notplusfive'' : forall x y : nat, y = 5 -> plus_x_not_five'' x y = x. intros a b. -unfold plus_x_not_five'' in |- *. functional induction plus_x_not_five'' a b; intros hyp; simpl in |- *; auto. Qed. Lemma iseq_eq : forall n m : nat, n = m -> nat_equal_bool n m = true. intros n m. -unfold nat_equal_bool in |- *. functional induction nat_equal_bool n m; simpl in |- *; intros hyp; auto. -inversion hyp. +rewrite <- hyp in H1; simpl in H1;tauto. inversion hyp. Qed. Lemma iseq_eq' : forall n m : nat, nat_equal_bool n m = true -> n = m. intros n m. -unfold nat_equal_bool in |- *. functional induction nat_equal_bool n m; simpl in |- *; intros eg; auto. inversion eg. inversion eg. @@ -242,6 +221,8 @@ Qed. Inductive istrue : bool -> Prop := istrue0 : istrue true. +Functional Scheme plus_ind := Induction for plus Sort Prop. + Lemma inf_x_plusxy' : forall x y : nat, x <= x + y. intros n m. functional induction plus n m; intros. @@ -264,7 +245,7 @@ intros n. functional induction plus 0 n; intros; auto with arith. Qed. -Fixpoint mod2 (n : nat) : nat := +Function mod2 (n : nat) : nat := match n with | O => 0 | S (S m) => S (mod2 m) @@ -276,13 +257,13 @@ intros n. functional induction mod2 n; simpl in |- *; auto with arith. Qed. -Definition isfour (n : nat) : bool := +Function isfour (n : nat) : bool := match n with | S (S (S (S O))) => true | _ => false end. -Definition isononeorfour (n : nat) : bool := +Function isononeorfour (n : nat) : bool := match n with | S O => true | S (S (S (S O))) => true @@ -294,15 +275,22 @@ intros n. functional induction isononeorfour n; intros istr; simpl in |- *; inversion istr. apply istrue0. +destruct n. inversion istr. +destruct n. tauto. +destruct n. inversion istr. +destruct n. inversion istr. +destruct n. tauto. +simpl in *. inversion H1. Qed. Lemma toto' : forall n m : nat, n = 4 -> istrue (isononeorfour n). intros n. functional induction isononeorfour n; intros m istr; inversion istr. apply istrue0. +rewrite H in H0; simpl in H0;tauto. Qed. -Definition ftest4 (n m : nat) : nat := +Function ftest4 (n m : nat) : nat := match n with | O => match m with | O => 0 @@ -321,13 +309,20 @@ Qed. Lemma test4' : forall n m : nat, ftest4 (S n) m <= 2. intros n m. - functional induction ftest4 (S n) m. +assert ({n0 | n0 = S n}). +exists (S n);reflexivity. +destruct H as [n0 H1]. +rewrite <- H1;revert H1. + functional induction ftest4 n0 m. +inversion 1. +inversion 1. + auto with arith. auto with arith. Qed. -Definition ftest44 (x : nat * nat) (n m : nat) : nat := - let (p, q) := x in +Function ftest44 (x : nat * nat) (n m : nat) : nat := + let (p, q) := (x: nat*nat) in match n with | O => match m with | O => 0 @@ -349,7 +344,7 @@ auto with arith. auto with arith. Qed. -Fixpoint ftest2 (n m : nat) {struct n} : nat := +Function ftest2 (n m : nat) {struct n} : nat := match n with | O => match m with | O => 0 @@ -363,7 +358,7 @@ intros n m. functional induction ftest2 n m; simpl in |- *; intros; auto. Qed. -Fixpoint ftest3 (n m : nat) {struct n} : nat := +Function ftest3 (n m : nat) {struct n} : nat := match n with | O => 0 | S p => match m with @@ -384,7 +379,7 @@ simpl in |- *. auto. Qed. -Fixpoint ftest5 (n m : nat) {struct n} : nat := +Function ftest5 (n m : nat) {struct n} : nat := match n with | O => 0 | S p => match m with @@ -405,7 +400,7 @@ simpl in |- *. auto. Qed. -Definition ftest7 (n : nat) : nat := +Function ftest7 (n : nat) : nat := match ftest5 n 0 with | O => 0 | S r => 0 @@ -416,11 +411,10 @@ Lemma essai7 : (Hrec0 : forall n r : nat, ftest5 n 0 = S r -> ftest7 n <= 2) (n : nat), ftest7 n <= 2. intros hyp1 hyp2 n. -unfold ftest7 in |- *. functional induction ftest7 n; auto. Qed. -Fixpoint ftest6 (n m : nat) {struct n} : nat := +Function ftest6 (n m : nat) {struct n} : nat := match n with | O => 0 | S p => match ftest5 p 0 with @@ -445,7 +439,6 @@ Qed. Lemma essai6 : forall n m : nat, ftest6 n m <= 2. intros n m. -unfold ftest6 in |- *. functional induction ftest6 n m; simpl in |- *; auto. Qed. diff --git a/test-suite/success/If.v b/test-suite/success/If.v deleted file mode 100644 index b7f06dcf..00000000 --- a/test-suite/success/If.v +++ /dev/null @@ -1,7 +0,0 @@ -(* Check correct use of if-then-else predicate annotation (cf bug 690) *) - -Check fun b : bool => - if b as b0 return (if b0 then b0 = true else b0 = false) - then refl_equal true - else refl_equal false. - diff --git a/test-suite/success/Notations.v b/test-suite/success/Notations.v new file mode 100644 index 00000000..a9e2c59a --- /dev/null +++ b/test-suite/success/Notations.v @@ -0,0 +1,9 @@ +(* Check that "where" clause behaves as if given independently of the *) +(* definition (variant of bug #113? submitted by Assia Mahboubi) *) + +Fixpoint plus1 (n m:nat) {struct n} : nat := + match n with + | O => m + | S p => S (p+m) + end + where "n + m" := (plus1 n m) : nat_scope. diff --git a/test-suite/success/Omega0.v b/test-suite/success/Omega0.v new file mode 100644 index 00000000..4614c90d --- /dev/null +++ b/test-suite/success/Omega0.v @@ -0,0 +1,149 @@ +Require Import ZArith Omega. +Open Scope Z_scope. + +(* Pierre L: examples gathered while debugging romega. *) + +Lemma test_romega_0 : + forall m m', + 0<= m <= 1 -> 0<= m' <= 1 -> (0 < m <-> 0 < m') -> m = m'. +Proof. +intros. +(*omega.*) +Admitted. + +Lemma test_romega_0b : + forall m m', + 0<= m <= 1 -> 0<= m' <= 1 -> (0 < m <-> 0 < m') -> m = m'. +Proof. +intros m m'. +(*omega.*) +Admitted. + +Lemma test_romega_1 : + forall (z z1 z2 : Z), + z2 <= z1 -> + z1 <= z2 -> + z1 >= 0 -> + z2 >= 0 -> + z1 >= z2 /\ z = z1 \/ z1 <= z2 /\ z = z2 -> + z >= 0. +Proof. +intros. +omega. +Qed. + +Lemma test_romega_1b : + forall (z z1 z2 : Z), + z2 <= z1 -> + z1 <= z2 -> + z1 >= 0 -> + z2 >= 0 -> + z1 >= z2 /\ z = z1 \/ z1 <= z2 /\ z = z2 -> + z >= 0. +Proof. +intros z z1 z2. +omega. +Qed. + +Lemma test_romega_2 : forall a b c:Z, + 0<=a-b<=1 -> b-c<=2 -> a-c<=3. +Proof. +intros. +omega. +Qed. + +Lemma test_romega_2b : forall a b c:Z, + 0<=a-b<=1 -> b-c<=2 -> a-c<=3. +Proof. +intros a b c. +omega. +Qed. + +Lemma test_romega_3 : forall a b h hl hr ha hb, + 0 <= ha - hl <= 1 -> + -2 <= hl - hr <= 2 -> + h =b+1 -> + (ha >= hr /\ a = ha \/ ha <= hr /\ a = hr) -> + (hl >= hr /\ b = hl \/ hl <= hr /\ b = hr) -> + (-3 <= ha -hr <=3 -> 0 <= hb - a <= 1) -> + (-2 <= ha-hr <=2 -> hb = a + 1) -> + 0 <= hb - h <= 1. +Proof. +intros. +omega. +Qed. + +Lemma test_romega_3b : forall a b h hl hr ha hb, + 0 <= ha - hl <= 1 -> + -2 <= hl - hr <= 2 -> + h =b+1 -> + (ha >= hr /\ a = ha \/ ha <= hr /\ a = hr) -> + (hl >= hr /\ b = hl \/ hl <= hr /\ b = hr) -> + (-3 <= ha -hr <=3 -> 0 <= hb - a <= 1) -> + (-2 <= ha-hr <=2 -> hb = a + 1) -> + 0 <= hb - h <= 1. +Proof. +intros a b h hl hr ha hb. +omega. +Qed. + + +Lemma test_romega_4 : forall hr ha, + ha = 0 -> + (ha = 0 -> hr =0) -> + hr = 0. +Proof. +intros hr ha. +omega. +Qed. + +Lemma test_romega_5 : forall hr ha, + ha = 0 -> + (~ha = 0 \/ hr =0) -> + hr = 0. +Proof. +intros hr ha. +omega. +Qed. + +Lemma test_romega_6 : forall z, z>=0 -> 0>z+2 -> False. +Proof. +intros. +omega. +Qed. + +Lemma test_romega_6b : forall z, z>=0 -> 0>z+2 -> False. +Proof. +intros z. +omega. +Qed. + +Lemma test_romega_7 : forall z, + 0>=0 /\ z=0 \/ 0<=0 /\ z =0 -> 1 = z+1. +Proof. +intros. +omega. +Qed. + +Lemma test_romega_7b : forall z, + 0>=0 /\ z=0 \/ 0<=0 /\ z =0 -> 1 = z+1. +Proof. +intros. +omega. +Qed. + +(* Magaud #240 *) + +Lemma test_romega_8 : forall x y:Z, x*x<y*y-> ~ y*y <= x*x. +intros. +omega. +Qed. + +Lemma test_romega_8b : forall x y:Z, x*x<y*y-> ~ y*y <= x*x. +intros x y. +omega. +Qed. + + + + diff --git a/test-suite/success/ROmega.v b/test-suite/success/ROmega.v new file mode 100644 index 00000000..04b666ed --- /dev/null +++ b/test-suite/success/ROmega.v @@ -0,0 +1,98 @@ + +Require Import ZArith ROmega. + +(* Submitted by Xavier Urbain 18 Jan 2002 *) + +Lemma lem1 : + forall x y : Z, (-5 < x < 5)%Z -> (-5 < y)%Z -> (-5 < x + y + 5)%Z. +Proof. +intros x y. + (*romega.*) +Admitted. + +(* Proposed by Pierre Crégut *) + +Lemma lem2 : forall x : Z, (x < 4)%Z -> (x > 2)%Z -> x = 3%Z. +intro. + romega. +Qed. + +(* Proposed by Jean-Christophe Filliâtre *) + +Lemma lem3 : forall x y : Z, x = y -> (x + x)%Z = (y + y)%Z. +Proof. +intros. + (*romega.*) +Admitted. + +(* Proposed by Jean-Christophe Filliâtre: confusion between an Omega *) +(* internal variable and a section variable (June 2001) *) + +Section A. +Variable x y : Z. +Hypothesis H : (x > y)%Z. +Lemma lem4 : (x > y)%Z. + romega. +Qed. +End A. + +(* Proposed by Yves Bertot: because a section var, L was wrongly renamed L0 *) +(* May 2002 *) + +Section B. +Variable R1 R2 S1 S2 H S : Z. +Hypothesis I : (R1 < 0)%Z -> R2 = (R1 + (2 * S1 - 1))%Z. +Hypothesis J : (R1 < 0)%Z -> S2 = (S1 - 1)%Z. +Hypothesis K : (R1 >= 0)%Z -> R2 = R1. +Hypothesis L : (R1 >= 0)%Z -> S2 = S1. +Hypothesis M : (H <= 2 * S)%Z. +Hypothesis N : (S < H)%Z. +Lemma lem5 : (H > 0)%Z. + romega. +Qed. +End B. + +(* From Nicolas Oury (bug #180): handling -> on Set (fixed Oct 2002) *) +Lemma lem6 : + forall (A : Set) (i : Z), (i <= 0)%Z -> ((i <= 0)%Z -> A) -> (i <= 0)%Z. +intros. + romega. +Qed. + +(* Adapted from an example in Nijmegen/FTA/ftc/RefSeparating (Oct 2002) *) +Require Import Omega. +Section C. +Parameter g : forall m : nat, m <> 0 -> Prop. +Parameter f : forall (m : nat) (H : m <> 0), g m H. +Variable n : nat. +Variable ap_n : n <> 0. +Let delta := f n ap_n. +Lemma lem7 : n = n. + (*romega.*) (*ROMEGA CANT DEAL WITH NAT*) +Admitted. +End C. + +(* Problem of dependencies *) +Require Import Omega. +Lemma lem8 : forall H : 0 = 0 -> 0 = 0, H = H -> 0 = 0. +intros. +(* romega.*) (*ROMEGA CANT DEAL WITH NAT*) +Admitted. + +(* Bug that what caused by the use of intro_using in Omega *) +Require Import Omega. +Lemma lem9 : + forall p q : nat, ~ (p <= q /\ p < q \/ q <= p /\ p < q) -> p < p \/ p <= p. +intros. +(* romega.*)(*ROMEGA CANT DEAL WITH NAT*) +Admitted. + +(* Check that the interpretation of mult on nat enforces its positivity *) +(* Submitted by Hubert Thierry (bug #743) *) +(* Postponed... problem with goals of the form "(n*m=0)%nat -> (n*m=0)%Z" +Require Omega. +Lemma lem10 : (n, m : nat) (le n (plus n (mult n m))). +Proof. +Intros; Omega. +Qed. +*) diff --git a/test-suite/success/ROmega0.v b/test-suite/success/ROmega0.v new file mode 100644 index 00000000..0efca1e1 --- /dev/null +++ b/test-suite/success/ROmega0.v @@ -0,0 +1,149 @@ +Require Import ZArith ROmega. +Open Scope Z_scope. + +(* Pierre L: examples gathered while debugging romega. *) + +Lemma test_romega_0 : + forall m m', + 0<= m <= 1 -> 0<= m' <= 1 -> (0 < m <-> 0 < m') -> m = m'. +Proof. +intros. +(*romega.*) +Admitted. + +Lemma test_romega_0b : + forall m m', + 0<= m <= 1 -> 0<= m' <= 1 -> (0 < m <-> 0 < m') -> m = m'. +Proof. +intros m m'. +(*romega.*) +Admitted. + +Lemma test_romega_1 : + forall (z z1 z2 : Z), + z2 <= z1 -> + z1 <= z2 -> + z1 >= 0 -> + z2 >= 0 -> + z1 >= z2 /\ z = z1 \/ z1 <= z2 /\ z = z2 -> + z >= 0. +Proof. +intros. +romega. +Qed. + +Lemma test_romega_1b : + forall (z z1 z2 : Z), + z2 <= z1 -> + z1 <= z2 -> + z1 >= 0 -> + z2 >= 0 -> + z1 >= z2 /\ z = z1 \/ z1 <= z2 /\ z = z2 -> + z >= 0. +Proof. +intros z z1 z2. +(* romega. *) +Admitted. + +Lemma test_romega_2 : forall a b c:Z, + 0<=a-b<=1 -> b-c<=2 -> a-c<=3. +Proof. +intros. +romega. +Qed. + +Lemma test_romega_2b : forall a b c:Z, + 0<=a-b<=1 -> b-c<=2 -> a-c<=3. +Proof. +intros a b c. +(*romega.*) +Admitted. + +Lemma test_romega_3 : forall a b h hl hr ha hb, + 0 <= ha - hl <= 1 -> + -2 <= hl - hr <= 2 -> + h =b+1 -> + (ha >= hr /\ a = ha \/ ha <= hr /\ a = hr) -> + (hl >= hr /\ b = hl \/ hl <= hr /\ b = hr) -> + (-3 <= ha -hr <=3 -> 0 <= hb - a <= 1) -> + (-2 <= ha-hr <=2 -> hb = a + 1) -> + 0 <= hb - h <= 1. +Proof. +intros. +romega. +Qed. + +Lemma test_romega_3b : forall a b h hl hr ha hb, + 0 <= ha - hl <= 1 -> + -2 <= hl - hr <= 2 -> + h =b+1 -> + (ha >= hr /\ a = ha \/ ha <= hr /\ a = hr) -> + (hl >= hr /\ b = hl \/ hl <= hr /\ b = hr) -> + (-3 <= ha -hr <=3 -> 0 <= hb - a <= 1) -> + (-2 <= ha-hr <=2 -> hb = a + 1) -> + 0 <= hb - h <= 1. +Proof. +intros a b h hl hr ha hb. +romega. +Qed. + + +Lemma test_romega_4 : forall hr ha, + ha = 0 -> + (ha = 0 -> hr =0) -> + hr = 0. +Proof. +intros hr ha. +romega. +Qed. + +Lemma test_romega_5 : forall hr ha, + ha = 0 -> + (~ha = 0 \/ hr =0) -> + hr = 0. +Proof. +intros hr ha. +romega. +Qed. + +Lemma test_romega_6 : forall z, z>=0 -> 0>z+2 -> False. +Proof. +intros. +romega. +Qed. + +Lemma test_romega_6b : forall z, z>=0 -> 0>z+2 -> False. +Proof. +intros z. +(*romega. *) +Admitted. + +Lemma test_romega_7 : forall z, + 0>=0 /\ z=0 \/ 0<=0 /\ z =0 -> 1 = z+1. +Proof. +intros. +(*romega.*) +Admitted. + +Lemma test_romega_7b : forall z, + 0>=0 /\ z=0 \/ 0<=0 /\ z =0 -> 1 = z+1. +Proof. +intros. +(*romega.*) +Admitted. + +(* Magaud #240 *) + +Lemma test_romega_8 : forall x y:Z, x*x<y*y-> ~ y*y <= x*x. +intros. +romega. +Qed. + +Lemma test_romega_8b : forall x y:Z, x*x<y*y-> ~ y*y <= x*x. +intros x y. +romega. +Qed. + + + + diff --git a/test-suite/success/ROmega2.v b/test-suite/success/ROmega2.v new file mode 100644 index 00000000..9d47c9f6 --- /dev/null +++ b/test-suite/success/ROmega2.v @@ -0,0 +1,28 @@ +Require Import ZArith ROmega. + +(* Submitted by Yegor Bryukhov (#922) *) + +Open Scope Z_scope. + +Lemma Test46 : +forall v1 v2 v3 v4 v5 : Z, +((2 * v4) + (5)) + (8 * v2) <= ((4 * v4) + (3 * v4)) + (5 * v4) -> +9 * v4 > (1 * v4) + ((2 * v1) + (0 * v2)) -> +((9 * v3) + (2 * v5)) + (5 * v2) = 3 * v4 -> +0 > 6 * v1 -> +(0 * v3) + (6 * v2) <> 2 -> +(0 * v3) + (5 * v5) <> ((4 * v2) + (8 * v2)) + (2 * v5) -> +7 * v3 > 5 * v5 -> +0 * v4 >= ((5 * v1) + (4 * v1)) + ((6 * v5) + (3 * v5)) -> +7 * v2 = ((3 * v2) + (6 * v5)) + (7 * v2) -> +0 * v3 > 7 * v1 -> +9 * v2 < 9 * v5 -> +(2 * v3) + (8 * v1) <= 5 * v4 -> +5 * v2 = ((5 * v1) + (0 * v5)) + (1 * v2) -> +0 * v5 <= 9 * v2 -> +((7 * v1) + (1 * v3)) + ((2 * v3) + (1 * v3)) >= ((6 * v5) + (4)) + ((1) + (9)) +-> False. +intros. +(*romega.*) +Admitted. + diff --git a/test-suite/success/RecTutorial.v b/test-suite/success/RecTutorial.v index d79b85df..60e170e4 100644 --- a/test-suite/success/RecTutorial.v +++ b/test-suite/success/RecTutorial.v @@ -1011,7 +1011,7 @@ Implicit Arguments Vnil [A]. Implicit Arguments Vhead [A n]. Implicit Arguments Vtail [A n]. -Definition Vid : forall (A : Set)(n:nat), vector A n -> vector A n. +Definition Vid : forall (A : Type)(n:nat), vector A n -> vector A n. Proof. destruct n; intro v. exact Vnil. @@ -1024,7 +1024,7 @@ Eval simpl in (fun (A:Set)(v:vector A 0) => v). -Lemma Vid_eq : forall (n:nat) (A:Set)(v:vector A n), v=(Vid _ n v). +Lemma Vid_eq : forall (n:nat) (A:Type)(v:vector A n), v=(Vid _ n v). Proof. destruct v. reflexivity. diff --git a/test-suite/success/destruct.v b/test-suite/success/destruct.v index ede573a3..9f938e10 100644 --- a/test-suite/success/destruct.v +++ b/test-suite/success/destruct.v @@ -1,3 +1,17 @@ +(* Submitted by Robert Schneck *) + +Parameter A B C D : Prop. +Axiom X : A -> B -> C /\ D. + +Lemma foo : A -> B -> C. +Proof. +intros. +destruct X. (* Should find axiom X and should handle arguments of X *) +assumption. +assumption. +assumption. +Qed. + (* Simplification of bug 711 *) Parameter f : true = false. @@ -7,3 +21,5 @@ set (b := true) in *. (* Check that it doesn't fail with an anomaly *) (* Ultimately, adapt destruct to make it succeeding *) try destruct b. +Abort. + diff --git a/test-suite/success/evars.v b/test-suite/success/evars.v index 64875fba..baeec147 100644 --- a/test-suite/success/evars.v +++ b/test-suite/success/evars.v @@ -59,7 +59,7 @@ Check (* Check instantiation of nested evars (bug #1089) *) -Check (fun f:(forall (v:Set->Set), v (v nat) -> nat) => f _ (Some (Some O))). +Check (fun f:(forall (v:Type->Type), v (v nat) -> nat) => f _ (Some (Some O))). (* This used to fail with anomaly "evar was not declared" in V8.0pl3 *) diff --git a/test-suite/success/if.v b/test-suite/success/if.v index 3f763863..9fde95e8 100644 --- a/test-suite/success/if.v +++ b/test-suite/success/if.v @@ -3,3 +3,10 @@ Check (fun b : bool => if b then Type else nat). +(* Check correct use of if-then-else predicate annotation (cf bug 690) *) + +Check fun b : bool => + if b as b0 return (if b0 then b0 = true else b0 = false) + then refl_equal true + else refl_equal false. + diff --git a/test-suite/success/refine.v b/test-suite/success/refine.v index b61cf275..4346ce9a 100644 --- a/test-suite/success/refine.v +++ b/test-suite/success/refine.v @@ -64,3 +64,26 @@ intro P. refine (P _ _). reflexivity. Abort. + +(* Submitted by Jacek Chrzaszcz (bug #1102) *) + +(* le problème a été résolu ici par normalisation des evars présentes + dans les types d'evars, mais le problème reste a priori ouvert dans + le cas plus général d'evars non instanciées dans les types d'autres + evars *) + +Goal exists n:nat, n=n. +refine (ex_intro _ _ _). +Abort. + +(* Used to failed with error not clean *) + +Definition div : + forall x:nat, (forall y:nat, forall n:nat, {q:nat | y = q*n}) -> + forall n:nat, {q:nat | x = q*n}. +refine + (fun m div_rec n => + match div_rec m n with + | exist _ _ => _ + end). +Abort. diff --git a/test-suite/success/unicode_utf8.v b/test-suite/success/unicode_utf8.v index e3c4dd30..19e306fe 100644 --- a/test-suite/success/unicode_utf8.v +++ b/test-suite/success/unicode_utf8.v @@ -4,6 +4,9 @@ (* Check Greek letters *) Definition test_greek : nat -> nat := fun Δ => Δ. +Parameter â„ : Set. +Parameter Ï€ : â„. (* Check indices *) Definition test_indices : nat -> nat := fun xâ‚ => xâ‚. +Definition π₂ := snd. diff --git a/theories/Arith/Compare_dec.v b/theories/Arith/Compare_dec.v index 3a87ee1a..d2eead86 100644 --- a/theories/Arith/Compare_dec.v +++ b/theories/Arith/Compare_dec.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Compare_dec.v 8642 2006-03-17 10:09:02Z notin $ i*) +(*i $Id: Compare_dec.v 8733 2006-04-25 22:52:18Z letouzey $ i*) Require Import Le. Require Import Lt. @@ -105,3 +105,139 @@ Qed. Theorem not_lt : forall n m, ~ n < m -> n >= m. intros x y H; exact (not_gt y x H). Qed. + + +(** A ternary comparison function in the spirit of [Zcompare]. *) + +Definition nat_compare (n m:nat) := + match lt_eq_lt_dec n m with + | inleft (left _) => Lt + | inleft (right _) => Eq + | inright _ => Gt + end. + +Lemma nat_compare_S : forall n m, nat_compare (S n) (S m) = nat_compare n m. +Proof. + unfold nat_compare; intros. + simpl; destruct (lt_eq_lt_dec n m) as [[H|H]|H]; simpl; auto. +Qed. + +Lemma nat_compare_eq : forall n m, nat_compare n m = Eq -> n = m. +Proof. + induction n; destruct m; simpl; auto. + unfold nat_compare; destruct (lt_eq_lt_dec 0 (S m)) as [[H|H]|H]; + auto; intros; try discriminate. + unfold nat_compare; destruct (lt_eq_lt_dec (S n) 0) as [[H|H]|H]; + auto; intros; try discriminate. + rewrite nat_compare_S; auto. +Qed. + +Lemma nat_compare_lt : forall n m, n<m <-> nat_compare n m = Lt. +Proof. + induction n; destruct m; simpl. + unfold nat_compare; simpl; intuition; [inversion H | discriminate H]. + split; auto with arith. + split; [inversion 1 |]. + unfold nat_compare; destruct (lt_eq_lt_dec (S n) 0) as [[H|H]|H]; + auto; intros; try discriminate. + rewrite nat_compare_S. + generalize (IHn m); clear IHn; intuition. +Qed. + +Lemma nat_compare_gt : forall n m, n>m <-> nat_compare n m = Gt. +Proof. + induction n; destruct m; simpl. + unfold nat_compare; simpl; intuition; [inversion H | discriminate H]. + split; [inversion 1 |]. + unfold nat_compare; destruct (lt_eq_lt_dec 0 (S m)) as [[H|H]|H]; + auto; intros; try discriminate. + split; auto with arith. + rewrite nat_compare_S. + generalize (IHn m); clear IHn; intuition. +Qed. + +Lemma nat_compare_le : forall n m, n<=m <-> nat_compare n m <> Gt. +Proof. + split. + intros. + intro. + destruct (nat_compare_gt n m). + generalize (le_lt_trans _ _ _ H (H2 H0)). + exact (lt_irrefl n). + intros. + apply not_gt. + swap H. + destruct (nat_compare_gt n m); auto. +Qed. + +Lemma nat_compare_ge : forall n m, n>=m <-> nat_compare n m <> Lt. +Proof. + split. + intros. + intro. + destruct (nat_compare_lt n m). + generalize (le_lt_trans _ _ _ H (H2 H0)). + exact (lt_irrefl m). + intros. + apply not_lt. + swap H. + destruct (nat_compare_lt n m); auto. +Qed. + +(** A boolean version of [le] over [nat]. *) + +Fixpoint leb (m:nat) : nat -> bool := + match m with + | O => fun _:nat => true + | S m' => + fun n:nat => match n with + | O => false + | S n' => leb m' n' + end + end. + +Lemma leb_correct : forall m n:nat, m <= n -> leb m n = true. +Proof. + induction m as [| m IHm]. trivial. + destruct n. intro H. elim (le_Sn_O _ H). + intros. simpl in |- *. apply IHm. apply le_S_n. assumption. +Qed. + +Lemma leb_complete : forall m n:nat, leb m n = true -> m <= n. +Proof. + induction m. trivial with arith. + destruct n. intro H. discriminate H. + auto with arith. +Qed. + +Lemma leb_correct_conv : forall m n:nat, m < n -> leb n m = false. +Proof. + intros. + generalize (leb_complete n m). + destruct (leb n m); auto. + intros. + elim (lt_irrefl _ (lt_le_trans _ _ _ H (H0 (refl_equal true)))). +Qed. + +Lemma leb_complete_conv : forall m n:nat, leb n m = false -> m < n. +Proof. + intros. elim (le_or_lt n m). intro. conditional trivial rewrite leb_correct in H. discriminate H. + trivial. +Qed. + +Lemma leb_compare : forall n m, leb n m = true <-> nat_compare n m <> Gt. +Proof. + induction n; destruct m; simpl. + unfold nat_compare; simpl. + intuition; discriminate. + split; auto with arith. + unfold nat_compare; destruct (lt_eq_lt_dec 0 (S m)) as [[H|H]|H]; + intuition; try discriminate. + inversion H. + split; try (intros; discriminate). + unfold nat_compare; destruct (lt_eq_lt_dec (S n) 0) as [[H|H]|H]; + intuition; try discriminate. + inversion H. + rewrite nat_compare_S; auto. +Qed. + diff --git a/theories/Arith/Div2.v b/theories/Arith/Div2.v index 6e5d292f..ca1f39af 100644 --- a/theories/Arith/Div2.v +++ b/theories/Arith/Div2.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Div2.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: Div2.v 8733 2006-04-25 22:52:18Z letouzey $ i*) Require Import Lt. Require Import Plus. @@ -173,3 +173,25 @@ Lemma odd_S2n : forall n, odd n -> {p : nat | n = S (double p)}. Proof. intros n H. exists (div2 n). auto with arith. Qed. + +(** Doubling before dividing by two brings back to the initial number. *) + +Lemma div2_double : forall n:nat, div2 (2*n) = n. +Proof. + induction n. + simpl; auto. + simpl. + replace (n+S(n+0)) with (S (2*n)). + f_equal; auto. + simpl; auto with arith. +Qed. + +Lemma div2_double_plus_one : forall n:nat, div2 (S (2*n)) = n. +Proof. + induction n. + simpl; auto. + simpl. + replace (n+S(n+0)) with (S (2*n)). + f_equal; auto. + simpl; auto with arith. +Qed. diff --git a/theories/Bool/Bvector.v b/theories/Bool/Bvector.v index b58ed280..576993c9 100644 --- a/theories/Bool/Bvector.v +++ b/theories/Bool/Bvector.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Bvector.v 6844 2005-03-16 13:09:55Z herbelin $ i*) +(*i $Id: Bvector.v 8866 2006-05-28 16:21:04Z herbelin $ i*) (** Bit vectors. Contribution by Jean Duprat (ENS Lyon). *) @@ -18,37 +18,37 @@ Open Local Scope nat_scope. (* On s'inspire de List.v pour fabriquer les vecteurs de bits. -La dimension du vecteur est un paramètre trop important pour +La dimension du vecteur est un paramètre trop important pour se contenter de la fonction "length". -La première idée est de faire un record avec la liste et la longueur. +La première idée est de faire un record avec la liste et la longueur. Malheureusement, cette verification a posteriori amene a faire de nombreux lemmes pour gerer les longueurs. -La seconde idée est de faire un type dépendant dans lequel la -longueur est un paramètre de construction. Cela complique un -peu les inductions structurelles, la solution qui a ma préférence -est alors d'utiliser un terme de preuve comme définition, car le -mécanisme d'inférence du type du filtrage n'est pas aussi puissant que -celui implanté par les tactiques d'élimination. +La seconde idée est de faire un type dépendant dans lequel la +longueur est un paramètre de construction. Cela complique un +peu les inductions structurelles, la solution qui a ma préférence +est alors d'utiliser un terme de preuve comme définition, car le +mécanisme d'inférence du type du filtrage n'est pas aussi puissant que +celui implanté par les tactiques d'élimination. *) Section VECTORS. (* -Un vecteur est une liste de taille n d'éléments d'un ensemble A. -Si la taille est non nulle, on peut extraire la première composante et -le reste du vecteur, la dernière composante ou rajouter ou enlever -une composante (carry) ou repeter la dernière composante en fin de vecteur. -On peut aussi tronquer le vecteur de ses p dernières composantes ou -au contraire l'étendre (concaténer) d'un vecteur de longueur p. -Une fonction unaire sur A génère une fonction des vecteurs de taille n -dans les vecteurs de taille n en appliquant f terme à terme. -Une fonction binaire sur A génère une fonction des couple de vecteurs -de taille n dans les vecteurs de taille n en appliquant f terme à terme. +Un vecteur est une liste de taille n d'éléments d'un ensemble A. +Si la taille est non nulle, on peut extraire la première composante et +le reste du vecteur, la dernière composante ou rajouter ou enlever +une composante (carry) ou repeter la dernière composante en fin de vecteur. +On peut aussi tronquer le vecteur de ses p dernières composantes ou +au contraire l'étendre (concaténer) d'un vecteur de longueur p. +Une fonction unaire sur A génère une fonction des vecteurs de taille n +dans les vecteurs de taille n en appliquant f terme à terme. +Une fonction binaire sur A génère une fonction des couple de vecteurs +de taille n dans les vecteurs de taille n en appliquant f terme à terme. *) -Variable A : Set. +Variable A : Type. -Inductive vector : nat -> Set := +Inductive vector : nat -> Type := | Vnil : vector 0 | Vcons : forall (a:A) (n:nat), vector n -> vector (S n). @@ -59,7 +59,7 @@ Defined. Definition Vtail : forall n:nat, vector (S n) -> vector n. Proof. - intros n v; inversion v; exact H0. + intros n v; inversion v as [|_ n0 H0 H1]; exact H0. Defined. Definition Vlast : forall n:nat, vector (S n) -> A. @@ -68,7 +68,7 @@ Proof. inversion v. exact a. - inversion v. + inversion v as [| n0 a H0 H1]. exact (f H0). Defined. @@ -85,7 +85,7 @@ Proof. induction n as [| n f]; intro v. exact Vnil. - inversion v. + inversion v as [| a n0 H0 H1]. exact (Vcons a n (f H0)). Defined. @@ -94,7 +94,7 @@ Proof. induction n as [| n f]; intros a v. exact (Vcons a 0 v). - inversion v. + inversion v as [| a0 n0 H0 H1 ]. exact (Vcons a (S n) (f a H0)). Defined. @@ -104,7 +104,7 @@ Proof. inversion v. exact (Vcons a 1 v). - inversion v. + inversion v as [| a n0 H0 H1 ]. exact (Vcons a (S (S n)) (f H0)). Defined. @@ -128,7 +128,7 @@ Proof. induction n as [| n f]; intros p v v0. simpl in |- *; exact v0. - inversion v. + inversion v as [| a n0 H0 H1]. simpl in |- *; exact (Vcons a (n + p) (f p H0 v0)). Defined. @@ -139,7 +139,7 @@ Proof. induction n as [| n g]; intro v. exact Vnil. - inversion v. + inversion v as [| a n0 H0 H1]. exact (Vcons (f a) n (g H0)). Defined. @@ -150,10 +150,35 @@ Proof. induction n as [| n h]; intros v v0. exact Vnil. - inversion v; inversion v0. + inversion v as [| a n0 H0 H1]; inversion v0 as [| a0 n1 H2 H3]. exact (Vcons (g a a0) n (h H0 H2)). Defined. +Definition Vid : forall n:nat, vector n -> vector n. +Proof. +destruct n; intro X. +exact Vnil. +exact (Vcons (Vhead _ X) _ (Vtail _ X)). +Defined. + +Lemma Vid_eq : forall (n:nat) (v:vector n), v=(Vid n v). +Proof. +destruct v; auto. +Qed. + +Lemma VSn_eq : + forall (n : nat) (v : vector (S n)), v = Vcons (Vhead _ v) _ (Vtail _ v). +Proof. +intros. +exact (Vid_eq _ v). +Qed. + +Lemma V0_eq : forall (v : vector 0), v = Vnil. +Proof. +intros. +exact (Vid_eq _ v). +Qed. + End VECTORS. (* suppressed: incompatible with Coq-Art book @@ -164,14 +189,14 @@ Implicit Arguments Vcons [A n]. Section BOOLEAN_VECTORS. (* -Un vecteur de bits est un vecteur sur l'ensemble des booléens de longueur fixe. -ATTENTION : le stockage s'effectue poids FAIBLE en tête. +Un vecteur de bits est un vecteur sur l'ensemble des booléens de longueur fixe. +ATTENTION : le stockage s'effectue poids FAIBLE en tête. On en extrait le bit de poids faible (head) et la fin du vecteur (tail). -On calcule la négation d'un vecteur, le et, le ou et le xor bit à bit de 2 vecteurs. -On calcule les décalages d'une position vers la gauche (vers les poids forts, on +On calcule la négation d'un vecteur, le et, le ou et le xor bit à bit de 2 vecteurs. +On calcule les décalages d'une position vers la gauche (vers les poids forts, on utilise donc Vshiftout, vers la droite (vers les poids faibles, on utilise Vshiftin) en -insérant un bit 'carry' (logique) ou en répétant le bit de poids fort (arithmétique). -ATTENTION : Tous les décalages prennent la taille moins un comme paramètre +insérant un bit 'carry' (logique) ou en répétant le bit de poids fort (arithmétique). +ATTENTION : Tous les décalages prennent la taille moins un comme paramètre (ils ne travaillent que sur des vecteurs au moins de longueur un). *) diff --git a/theories/Bool/DecBool.v b/theories/Bool/DecBool.v index b95b25fd..31ff029c 100644 --- a/theories/Bool/DecBool.v +++ b/theories/Bool/DecBool.v @@ -6,11 +6,11 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: DecBool.v 8642 2006-03-17 10:09:02Z notin $ i*) +(*i $Id: DecBool.v 8866 2006-05-28 16:21:04Z herbelin $ i*) Set Implicit Arguments. -Definition ifdec (A B:Prop) (C:Set) (H:{A} + {B}) (x y:C) : C := +Definition ifdec (A B:Prop) (C:Type) (H:{A} + {B}) (x y:C) : C := if H then x else y. @@ -28,4 +28,4 @@ intros; case H; auto. intro; absurd A; trivial. Qed. -Unset Implicit Arguments.
\ No newline at end of file +Unset Implicit Arguments. diff --git a/theories/FSets/FMapAVL.v b/theories/FSets/FMapAVL.v new file mode 100644 index 00000000..425528ee --- /dev/null +++ b/theories/FSets/FMapAVL.v @@ -0,0 +1,2058 @@ + +(***********************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * INRIA-Rocquencourt & LRI-CNRS-Orsay *) +(* \VV/ *************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(***********************************************************************) + +(* Finite map library. *) + +(* $Id: FMapAVL.v 8899 2006-06-06 11:09:43Z jforest $ *) + +(** This module implements map using AVL trees. + It follows the implementation from Ocaml's standard library. *) + +Require Import FSetInterface. +Require Import FMapInterface. +Require Import FMapList. + +Require Import ZArith. +Require Import Int. + +Set Firstorder Depth 3. +Set Implicit Arguments. +Unset Strict Implicit. + + +Module Raw (I:Int)(X: OrderedType). +Import I. +Module II:=MoreInt(I). +Import II. +Open Scope Int_scope. + +Module E := X. +Module MX := OrderedTypeFacts X. +Module PX := KeyOrderedType X. +Module L := FMapList.Raw X. +Import MX. +Import PX. + +Definition key := X.t. + +(** * Trees *) + +Section Elt. + +Variable elt : Set. + +(* Now in KeyOrderedType: +Definition eqk (p p':key*elt) := X.eq (fst p) (fst p'). +Definition eqke (p p':key*elt) := + X.eq (fst p) (fst p') /\ (snd p) = (snd p'). +Definition ltk (p p':key*elt) := X.lt (fst p) (fst p'). +*) + +Notation eqk := (eqk (elt:= elt)). +Notation eqke := (eqke (elt:= elt)). +Notation ltk := (ltk (elt:= elt)). + +Inductive tree : Set := + | Leaf : tree + | Node : tree -> key -> elt -> tree -> int -> tree. + +Notation t := tree. + +(** The Sixth field of [Node] is the height of the tree *) + +(** * Occurrence in a tree *) + +Inductive MapsTo (x : key)(e : elt) : tree -> Prop := + | MapsRoot : forall l r h y, + X.eq x y -> MapsTo x e (Node l y e r h) + | MapsLeft : forall l r h y e', + MapsTo x e l -> MapsTo x e (Node l y e' r h) + | MapsRight : forall l r h y e', + MapsTo x e r -> MapsTo x e (Node l y e' r h). + +Inductive In (x : key) : tree -> Prop := + | InRoot : forall l r h y e, + X.eq x y -> In x (Node l y e r h) + | InLeft : forall l r h y e', + In x l -> In x (Node l y e' r h) + | InRight : forall l r h y e', + In x r -> In x (Node l y e' r h). + +Definition In0 (k:key)(m:t) : Prop := exists e:elt, MapsTo k e m. + +(** * Binary search trees *) + +(** [lt_tree x s]: all elements in [s] are smaller than [x] + (resp. greater for [gt_tree]) *) + +Definition lt_tree x s := forall y:key, In y s -> X.lt y x. +Definition gt_tree x s := forall y:key, In y s -> X.lt x y. + +(** [bst t] : [t] is a binary search tree *) + +Inductive bst : tree -> Prop := + | BSLeaf : bst Leaf + | BSNode : forall x e l r h, + bst l -> bst r -> lt_tree x l -> gt_tree x r -> bst (Node l x e r h). + +(** * AVL trees *) + +(** [avl s] : [s] is a properly balanced AVL tree, + i.e. for any node the heights of the two children + differ by at most 2 *) + +Definition height (s : tree) : int := + match s with + | Leaf => 0 + | Node _ _ _ _ h => h + end. + +Inductive avl : tree -> Prop := + | RBLeaf : avl Leaf + | RBNode : forall x e l r h, + avl l -> + avl r -> + -(2) <= height l - height r <= 2 -> + h = max (height l) (height r) + 1 -> + avl (Node l x e r h). + +(* We should end this section before the big proofs that follows, + otherwise the discharge takes a lot of time. *) +End Elt. + +(** Some helpful hints and tactics. *) + +Notation t := tree. +Hint Constructors tree. +Hint Constructors MapsTo. +Hint Constructors In. +Hint Constructors bst. +Hint Constructors avl. +Hint Unfold lt_tree gt_tree. + +Ltac inv f := + match goal with + | H:f (Leaf _) |- _ => inversion_clear H; inv f + | H:f _ (Leaf _) |- _ => inversion_clear H; inv f + | H:f _ _ (Leaf _) |- _ => inversion_clear H; inv f + | H:f _ _ _ (Leaf _) |- _ => inversion_clear H; inv f + | H:f (Node _ _ _ _ _) |- _ => inversion_clear H; inv f + | H:f _ (Node _ _ _ _ _) |- _ => inversion_clear H; inv f + | H:f _ _ (Node _ _ _ _ _) |- _ => inversion_clear H; inv f + | H:f _ _ _ (Node _ _ _ _ _) |- _ => inversion_clear H; inv f + | _ => idtac + end. + +Ltac safe_inv f := match goal with + | H:f (Node _ _ _ _ _) |- _ => + generalize H; inversion_clear H; safe_inv f + | H:f _ (Node _ _ _ _ _) |- _ => + generalize H; inversion_clear H; safe_inv f + | _ => intros + end. + +Ltac inv_all f := + match goal with + | H: f _ |- _ => inversion_clear H; inv f + | H: f _ _ |- _ => inversion_clear H; inv f + | H: f _ _ _ |- _ => inversion_clear H; inv f + | H: f _ _ _ _ |- _ => inversion_clear H; inv f + | _ => idtac + end. + +Ltac order := match goal with + | H: lt_tree ?x ?s, H1: In ?y ?s |- _ => generalize (H _ H1); clear H; order + | H: gt_tree ?x ?s, H1: In ?y ?s |- _ => generalize (H _ H1); clear H; order + | _ => MX.order +end. + +Ltac intuition_in := repeat progress (intuition; inv In; inv MapsTo). +Ltac firstorder_in := repeat progress (firstorder; inv In; inv MapsTo). + +Lemma height_non_negative : forall elt (s : t elt), avl s -> height s >= 0. +Proof. + induction s; simpl; intros; auto with zarith. + inv avl; intuition; omega_max. +Qed. + +Ltac avl_nn_hyp H := + let nz := fresh "nz" in assert (nz := height_non_negative H). + +Ltac avl_nn h := + let t := type of h in + match type of t with + | Prop => avl_nn_hyp h + | _ => match goal with H : avl h |- _ => avl_nn_hyp H end + end. + +(* Repeat the previous tactic. + Drawback: need to clear the [avl _] hyps ... Thank you Ltac *) + +Ltac avl_nns := + match goal with + | H:avl _ |- _ => avl_nn_hyp H; clear H; avl_nns + | _ => idtac + end. + + +(** Facts about [MapsTo] and [In]. *) + +Lemma MapsTo_In : forall elt k e (m:t elt), MapsTo k e m -> In k m. +Proof. + induction 1; auto. +Qed. +Hint Resolve MapsTo_In. + +Lemma In_MapsTo : forall elt k (m:t elt), In k m -> exists e, MapsTo k e m. +Proof. + induction 1; try destruct IHIn as (e,He); exists e; auto. +Qed. + +Lemma In_alt : forall elt k (m:t elt), In0 k m <-> In k m. +Proof. + split. + intros (e,H); eauto. + unfold In0; apply In_MapsTo; auto. +Qed. + +Lemma MapsTo_1 : + forall elt (m:t elt) x y e, X.eq x y -> MapsTo x e m -> MapsTo y e m. +Proof. + induction m; simpl; intuition_in; eauto. +Qed. +Hint Immediate MapsTo_1. + +Lemma In_1 : + forall elt (m:t elt) x y, X.eq x y -> In x m -> In y m. +Proof. + intros elt m x y; induction m; simpl; intuition_in; eauto. +Qed. + + +(** Results about [lt_tree] and [gt_tree] *) + +Lemma lt_leaf : forall elt x, lt_tree x (Leaf elt). +Proof. + unfold lt_tree in |- *; intros; intuition_in. +Qed. + +Lemma gt_leaf : forall elt x, gt_tree x (Leaf elt). +Proof. + unfold gt_tree in |- *; intros; intuition_in. +Qed. + +Lemma lt_tree_node : forall elt x y (l:t elt) r e h, + lt_tree x l -> lt_tree x r -> X.lt y x -> lt_tree x (Node l y e r h). +Proof. + unfold lt_tree in *; firstorder_in; order. +Qed. + +Lemma gt_tree_node : forall elt x y (l:t elt) r e h, + gt_tree x l -> gt_tree x r -> X.lt x y -> gt_tree x (Node l y e r h). +Proof. + unfold gt_tree in *; firstorder_in; order. +Qed. + +Hint Resolve lt_leaf gt_leaf lt_tree_node gt_tree_node. + +Lemma lt_left : forall elt x y (l: t elt) r e h, + lt_tree x (Node l y e r h) -> lt_tree x l. +Proof. + intuition_in. +Qed. + +Lemma lt_right : forall elt x y (l:t elt) r e h, + lt_tree x (Node l y e r h) -> lt_tree x r. +Proof. + intuition_in. +Qed. + +Lemma gt_left : forall elt x y (l:t elt) r e h, + gt_tree x (Node l y e r h) -> gt_tree x l. +Proof. + intuition_in. +Qed. + +Lemma gt_right : forall elt x y (l:t elt) r e h, + gt_tree x (Node l y e r h) -> gt_tree x r. +Proof. + intuition_in. +Qed. + +Hint Resolve lt_left lt_right gt_left gt_right. + +Lemma lt_tree_not_in : + forall elt x (t : t elt), lt_tree x t -> ~ In x t. +Proof. + intros; intro; generalize (H _ H0); order. +Qed. + +Lemma lt_tree_trans : + forall elt x y, X.lt x y -> forall (t:t elt), lt_tree x t -> lt_tree y t. +Proof. + firstorder eauto. +Qed. + +Lemma gt_tree_not_in : + forall elt x (t : t elt), gt_tree x t -> ~ In x t. +Proof. + intros; intro; generalize (H _ H0); order. +Qed. + +Lemma gt_tree_trans : + forall elt x y, X.lt y x -> forall (t:t elt), gt_tree x t -> gt_tree y t. +Proof. + firstorder eauto. +Qed. + +Hint Resolve lt_tree_not_in lt_tree_trans gt_tree_not_in gt_tree_trans. + +(** Results about [avl] *) + +Lemma avl_node : forall elt x e (l:t elt) r, + avl l -> + avl r -> + -(2) <= height l - height r <= 2 -> + avl (Node l x e r (max (height l) (height r) + 1)). +Proof. + intros; auto. +Qed. +Hint Resolve avl_node. + +(** * Helper functions *) + +(** [create l x r] creates a node, assuming [l] and [r] + to be balanced and [|height l - height r| <= 2]. *) + +Definition create elt (l:t elt) x e r := + Node l x e r (max (height l) (height r) + 1). + +Lemma create_bst : + forall elt (l:t elt) x e r, bst l -> bst r -> lt_tree x l -> gt_tree x r -> + bst (create l x e r). +Proof. + unfold create; auto. +Qed. +Hint Resolve create_bst. + +Lemma create_avl : + forall elt (l:t elt) x e r, avl l -> avl r -> -(2) <= height l - height r <= 2 -> + avl (create l x e r). +Proof. + unfold create; auto. +Qed. + +Lemma create_height : + forall elt (l:t elt) x e r, avl l -> avl r -> -(2) <= height l - height r <= 2 -> + height (create l x e r) = max (height l) (height r) + 1. +Proof. + unfold create; intros; auto. +Qed. + +Lemma create_in : + forall elt (l:t elt) x e r y, In y (create l x e r) <-> X.eq y x \/ In y l \/ In y r. +Proof. + unfold create; split; [ inversion_clear 1 | ]; intuition. +Qed. + +(** trick for emulating [assert false] in Coq *) + +Notation assert_false := Leaf. + +(** [bal l x e r] acts as [create], but performs one step of + rebalancing if necessary, i.e. assumes [|height l - height r| <= 3]. *) + +Definition bal elt (l: tree elt) x e r := + let hl := height l in + let hr := height r in + if gt_le_dec hl (hr+2) then + match l with + | Leaf => assert_false _ + | Node ll lx le lr _ => + if ge_lt_dec (height ll) (height lr) then + create ll lx le (create lr x e r) + else + match lr with + | Leaf => assert_false _ + | Node lrl lrx lre lrr _ => + create (create ll lx le lrl) lrx lre (create lrr x e r) + end + end + else + if gt_le_dec hr (hl+2) then + match r with + | Leaf => assert_false _ + | Node rl rx re rr _ => + if ge_lt_dec (height rr) (height rl) then + create (create l x e rl) rx re rr + else + match rl with + | Leaf => assert_false _ + | Node rll rlx rle rlr _ => + create (create l x e rll) rlx rle (create rlr rx re rr) + end + end + else + create l x e r. + +Ltac bal_tac := + intros elt l x e r; + unfold bal; + destruct (gt_le_dec (height l) (height r + 2)); + [ destruct l as [ |ll lx le lr lh]; + [ | destruct (ge_lt_dec (height ll) (height lr)); + [ | destruct lr ] ] + | destruct (gt_le_dec (height r) (height l + 2)); + [ destruct r as [ |rl rx re rr rh]; + [ | destruct (ge_lt_dec (height rr) (height rl)); + [ | destruct rl ] ] + | ] ]; intros. + +Ltac bal_tac_imp := match goal with + | |- context [ assert_false ] => + inv avl; avl_nns; simpl in *; false_omega + | _ => idtac +end. + +Lemma bal_bst : forall elt (l:t elt) x e r, bst l -> bst r -> + lt_tree x l -> gt_tree x r -> bst (bal l x e r). +Proof. + bal_tac; + inv bst; repeat apply create_bst; auto; unfold create; + apply lt_tree_node || apply gt_tree_node; auto; + eapply lt_tree_trans || eapply gt_tree_trans || eauto; eauto. +Qed. + +Lemma bal_avl : forall elt (l:t elt) x e r, avl l -> avl r -> + -(3) <= height l - height r <= 3 -> avl (bal l x e r). +Proof. + bal_tac; inv avl; repeat apply create_avl; simpl in *; auto; omega_max. +Qed. + +Lemma bal_height_1 : forall elt (l:t elt) x e r, avl l -> avl r -> + -(3) <= height l - height r <= 3 -> + 0 <= height (bal l x e r) - max (height l) (height r) <= 1. +Proof. + bal_tac; inv avl; avl_nns; simpl in *; omega_max. +Qed. + +Lemma bal_height_2 : + forall elt (l:t elt) x e r, avl l -> avl r -> -(2) <= height l - height r <= 2 -> + height (bal l x e r) == max (height l) (height r) +1. +Proof. + bal_tac; inv avl; simpl in *; omega_max. +Qed. + +Lemma bal_in : forall elt (l:t elt) x e r y, avl l -> avl r -> + (In y (bal l x e r) <-> X.eq y x \/ In y l \/ In y r). +Proof. + bal_tac; bal_tac_imp; repeat rewrite create_in; intuition_in. +Qed. + +Lemma bal_mapsto : forall elt (l:t elt) x e r y e', avl l -> avl r -> + (MapsTo y e' (bal l x e r) <-> MapsTo y e' (create l x e r)). +Proof. + bal_tac; bal_tac_imp; unfold create; intuition_in. +Qed. + +Ltac omega_bal := match goal with + | H:avl ?l, H':avl ?r |- context [ bal ?l ?x ?e ?r ] => + generalize (bal_height_1 x e H H') (bal_height_2 x e H H'); + omega_max + end. + +(** * Insertion *) + +Function add (elt:Set)(x:key)(e:elt)(s:t elt) { struct s } : t elt := match s with + | Leaf => Node (Leaf _) x e (Leaf _) 1 + | Node l y e' r h => + match X.compare x y with + | LT _ => bal (add x e l) y e' r + | EQ _ => Node l y e r h + | GT _ => bal l y e' (add x e r) + end + end. + +Lemma add_avl_1 : forall elt (m:t elt) x e, avl m -> + avl (add x e m) /\ 0 <= height (add x e m) - height m <= 1. +Proof. + intros elt m x e; functional induction (add x e m); intros; inv avl; simpl in *. + intuition; try constructor; simpl; auto; try omega_max. + (* LT *) + destruct IHt; auto. + split. + apply bal_avl; auto; omega_max. + omega_bal. + (* EQ *) + intuition; omega_max. + (* GT *) + destruct IHt; auto. + split. + apply bal_avl; auto; omega_max. + omega_bal. +Qed. + +Lemma add_avl : forall elt (m:t elt) x e, avl m -> avl (add x e m). +Proof. + intros; generalize (add_avl_1 x e H); intuition. +Qed. +Hint Resolve add_avl. + +Lemma add_in : forall elt (m:t elt) x y e, avl m -> + (In y (add x e m) <-> X.eq y x \/ In y m). +Proof. + intros elt m x y e; functional induction (add x e m); auto; intros. + intuition_in. + (* LT *) + inv avl. + rewrite bal_in; auto. + rewrite (IHt H1); intuition_in. + (* EQ *) + inv avl. + firstorder_in. + eapply In_1; eauto. + (* GT *) + inv avl. + rewrite bal_in; auto. + rewrite (IHt H2); intuition_in. +Qed. + +Lemma add_bst : forall elt (m:t elt) x e, bst m -> avl m -> bst (add x e m). +Proof. + intros elt m x e; functional induction (add x e m); + intros; inv bst; inv avl; auto; apply bal_bst; auto. + (* lt_tree -> lt_tree (add ...) *) + red; red in H4. + intros. + rewrite (add_in x y0 e H) in H1. + intuition. + eauto. + (* gt_tree -> gt_tree (add ...) *) + red; red in H5. + intros. + rewrite (add_in x y0 e H6) in H1. + intuition. + apply lt_eq with x; auto. +Qed. + +Lemma add_1 : forall elt (m:t elt) x y e, avl m -> X.eq x y -> MapsTo y e (add x e m). +Proof. + intros elt m x y e; functional induction (add x e m); + intros; inv bst; inv avl; try rewrite bal_mapsto; unfold create; eauto. +Qed. + +Lemma add_2 : forall elt (m:t elt) x y e e', avl m -> ~X.eq x y -> + MapsTo y e m -> MapsTo y e (add x e' m). +Proof. + intros elt m x y e e'; induction m; simpl; auto. + destruct (X.compare x k); + intros; inv bst; inv avl; try rewrite bal_mapsto; unfold create; auto; + inv MapsTo; auto; order. +Qed. + +Lemma add_3 : forall elt (m:t elt) x y e e', avl m -> ~X.eq x y -> + MapsTo y e (add x e' m) -> MapsTo y e m. +Proof. + intros elt m x y e e'; induction m; simpl; auto. + intros; inv avl; inv MapsTo; auto; order. + destruct (X.compare x k); intro; inv avl; + try rewrite bal_mapsto; auto; unfold create; intros; inv MapsTo; auto; + order. +Qed. + + +(** * Extraction of minimum binding + + morally, [remove_min] is to be applied to a non-empty tree + [t = Node l x e r h]. Since we can't deal here with [assert false] + for [t=Leaf], we pre-unpack [t] (and forget about [h]). +*) + +Function remove_min (elt:Set)(l:t elt)(x:key)(e:elt)(r:t elt) { struct l } : t elt*(key*elt) := + match l with + | Leaf => (r,(x,e)) + | Node ll lx le lr lh => let (l',m) := (remove_min ll lx le lr : t elt*(key*elt)) in (bal l' x e r, m) + end. + +Lemma remove_min_avl_1 : forall elt (l:t elt) x e r h, avl (Node l x e r h) -> + avl (fst (remove_min l x e r)) /\ + 0 <= height (Node l x e r h) - height (fst (remove_min l x e r)) <= 1. +Proof. + intros elt l x e r; functional induction (remove_min l x e r); simpl in *; intros. + inv avl; simpl in *; split; auto. + avl_nns; omega_max. + (* l = Node *) + inversion_clear H. + destruct (IHp lh); auto. + split; simpl in *. + rewrite_all H0. simpl in *. + apply bal_avl; subst;auto; omega_max. + rewrite_all H0;simpl in *;omega_bal. +Qed. + +Lemma remove_min_avl : forall elt (l:t elt) x e r h, avl (Node l x e r h) -> + avl (fst (remove_min l x e r)). +Proof. + intros; generalize (remove_min_avl_1 H); intuition. +Qed. + +Lemma remove_min_in : forall elt (l:t elt) x e r h y, avl (Node l x e r h) -> + (In y (Node l x e r h) <-> + X.eq y (fst (snd (remove_min l x e r))) \/ In y (fst (remove_min l x e r))). +Proof. + intros elt l x e r; functional induction (remove_min l x e r); simpl in *; intros. + intuition_in. + (* l = Node *) + inversion_clear H. + generalize (remove_min_avl H1). + + rewrite_all H0; simpl; intros. + rewrite bal_in; auto. + generalize (IHp lh y H1). + intuition. + inversion_clear H8; intuition. +Qed. + +Lemma remove_min_mapsto : forall elt (l:t elt) x e r h y e', avl (Node l x e r h) -> + (MapsTo y e' (Node l x e r h) <-> + ((X.eq y (fst (snd (remove_min l x e r))) /\ e' = (snd (snd (remove_min l x e r)))) + \/ MapsTo y e' (fst (remove_min l x e r)))). +Proof. + intros elt l x e r; functional induction (remove_min l x e r); simpl in *; intros. + intuition_in; subst; auto. + (* l = Node *) + inversion_clear H. + generalize (remove_min_avl H1). + rewrite_all H0; simpl; intros. + rewrite bal_mapsto; auto; unfold create. + simpl in *;destruct (IHp lh y e'). + auto. + intuition. + inversion_clear H3; intuition. + inversion_clear H10; intuition. +Qed. + +Lemma remove_min_bst : forall elt (l:t elt) x e r h, + bst (Node l x e r h) -> avl (Node l x e r h) -> bst (fst (remove_min l x e r)). +Proof. + intros elt l x e r; functional induction (remove_min l x e r); simpl in *; intros. + inv bst; auto. + inversion_clear H; inversion_clear H1. + apply bal_bst; auto. + rewrite_all H0;simpl in *;firstorder. + intro; intros. + generalize (remove_min_in y H). + rewrite_all H0; simpl in *. + destruct 1. + apply H4; intuition. +Qed. + +Lemma remove_min_gt_tree : forall elt (l:t elt) x e r h, + bst (Node l x e r h) -> avl (Node l x e r h) -> + gt_tree (fst (snd (remove_min l x e r))) (fst (remove_min l x e r)). +Proof. + intros elt l x e r; functional induction (remove_min l x e r); simpl in *; intros. + inv bst; auto. + inversion_clear H; inversion_clear H1. + intro; intro. + rewrite_all H0;simpl in *. + generalize (IHp lh H2 H); clear H7 H8 IHp. + generalize (remove_min_avl H). + generalize (remove_min_in (fst m) H). + rewrite H0; simpl; intros. + rewrite (bal_in x e y H8 H6) in H1. + destruct H7. + firstorder. + apply lt_eq with x; auto. + apply X.lt_trans with x; auto. +Qed. + +(** * Merging two trees + + [merge t1 t2] builds the union of [t1] and [t2] assuming all elements + of [t1] to be smaller than all elements of [t2], and + [|height t1 - height t2| <= 2]. +*) + +Function merge (elt:Set) (s1 s2 : t elt) : tree elt := match s1,s2 with + | Leaf, _ => s2 + | _, Leaf => s1 + | _, Node l2 x2 e2 r2 h2 => + match remove_min l2 x2 e2 r2 with + (s2',(x,e)) => bal s1 x e s2' + end +end. + +Lemma merge_avl_1 : forall elt (s1 s2:t elt), avl s1 -> avl s2 -> + -(2) <= height s1 - height s2 <= 2 -> + avl (merge s1 s2) /\ + 0<= height (merge s1 s2) - max (height s1) (height s2) <=1. +Proof. + intros elt s1 s2; functional induction (merge s1 s2); simpl in *; intros. + split; auto; avl_nns; omega_max. + destruct s1;try contradiction;clear H1. + split; auto; avl_nns; simpl in *; omega_max. + destruct s1;try contradiction;clear H1. + generalize (remove_min_avl_1 H0). + rewrite H2; simpl;destruct 1. + split. + apply bal_avl; auto. + simpl; omega_max. + omega_bal. +Qed. + +Lemma merge_avl : forall elt (s1 s2:t elt), avl s1 -> avl s2 -> + -(2) <= height s1 - height s2 <= 2 -> avl (merge s1 s2). +Proof. + intros; generalize (merge_avl_1 H H0 H1); intuition. +Qed. + +Lemma merge_in : forall elt (s1 s2:t elt) y, bst s1 -> avl s1 -> bst s2 -> avl s2 -> + (In y (merge s1 s2) <-> In y s1 \/ In y s2). +Proof. + intros elt s1 s2; functional induction (merge s1 s2);intros. + intuition_in. + intuition_in. + destruct s1;try contradiction;clear H1. +(* rewrite H_eq_2; rewrite H_eq_2 in H_eq_1; clear H_eq_2. *) + replace s2' with (fst (remove_min l2 x2 e2 r2)); [|rewrite H2; auto]. + rewrite bal_in; auto. + generalize (remove_min_avl H4); rewrite H2; simpl; auto. + generalize (remove_min_in y H4); rewrite H2; simpl; intro. + rewrite H1; intuition. +Qed. + +Lemma merge_mapsto : forall elt (s1 s2:t elt) y e, bst s1 -> avl s1 -> bst s2 -> avl s2 -> + (MapsTo y e (merge s1 s2) <-> MapsTo y e s1 \/ MapsTo y e s2). +Proof. + intros elt s1 s2; functional induction (@merge elt s1 s2); intros. + intuition_in. + intuition_in. + destruct s1;try contradiction;clear H1. + replace s2' with (fst (remove_min l2 x2 e2 r2)); [|rewrite H2; auto]. + rewrite bal_mapsto; auto; unfold create. + generalize (remove_min_avl H4); rewrite H2; simpl; auto. + generalize (remove_min_mapsto y e0 H4); rewrite H2; simpl; intro. + rewrite H1; intuition (try subst; auto). + inversion_clear H1; intuition. +Qed. + +Lemma merge_bst : forall elt (s1 s2:t elt), bst s1 -> avl s1 -> bst s2 -> avl s2 -> + (forall y1 y2 : key, In y1 s1 -> In y2 s2 -> X.lt y1 y2) -> + bst (merge s1 s2). +Proof. + intros elt s1 s2; functional induction (@merge elt s1 s2); intros; auto. + + apply bal_bst; auto. + destruct s1;try contradiction. + generalize (remove_min_bst H3); rewrite H2; simpl in *; auto. + destruct s1;try contradiction. + intro; intro. + apply H5; auto. + generalize (remove_min_in x H4); rewrite H2; simpl; intuition. + destruct s1;try contradiction. + generalize (remove_min_gt_tree H3); rewrite H2; simpl; auto. +Qed. + +(** * Deletion *) + +Function remove (elt:Set)(x:key)(s:t elt) { struct s } : t elt := match s with + | Leaf => Leaf _ + | Node l y e r h => + match X.compare x y with + | LT _ => bal (remove x l) y e r + | EQ _ => merge l r + | GT _ => bal l y e (remove x r) + end + end. + +Lemma remove_avl_1 : forall elt (s:t elt) x, avl s -> + avl (remove x s) /\ 0 <= height s - height (remove x s) <= 1. +Proof. + intros elt s x; functional induction (@remove elt x s); intros. + split; auto; omega_max. + (* LT *) + inv avl. + destruct (IHt H1). + split. + apply bal_avl; auto. + omega_max. + omega_bal. + (* EQ *) + inv avl. + generalize (merge_avl_1 H1 H2 H3). + intuition omega_max. + (* GT *) + inv avl. + destruct (IHt H2). + split. + apply bal_avl; auto. + omega_max. + omega_bal. +Qed. + +Lemma remove_avl : forall elt (s:t elt) x, avl s -> avl (remove x s). +Proof. + intros; generalize (remove_avl_1 x H); intuition. +Qed. +Hint Resolve remove_avl. + +Lemma remove_in : forall elt (s:t elt) x y, bst s -> avl s -> + (In y (remove x s) <-> ~ X.eq y x /\ In y s). +Proof. + intros elt s x; functional induction (@remove elt x s); simpl; intros. + intuition_in. + (* LT *) + inv avl; inv bst; clear H0. + rewrite bal_in; auto. + generalize (IHt y0 H1); intuition; [ order | order | intuition_in ]. + (* EQ *) + inv avl; inv bst; clear H0. + rewrite merge_in; intuition; [ order | order | intuition_in ]. + elim H9; eauto. + (* GT *) + inv avl; inv bst; clear H0. + rewrite bal_in; auto. + generalize (IHt y0 H6); intuition; [ order | order | intuition_in ]. +Qed. + +Lemma remove_bst : forall elt (s:t elt) x, bst s -> avl s -> bst (remove x s). +Proof. + intros elt s x; functional induction (@remove elt x s); simpl; intros. + auto. + (* LT *) + inv avl; inv bst. + apply bal_bst; auto. + intro; intro. + rewrite (remove_in x y0 H1) in H; auto. + destruct H; eauto. + (* EQ *) + inv avl; inv bst. + apply merge_bst; eauto. + (* GT *) + inv avl; inv bst. + apply bal_bst; auto. + intro; intro. + rewrite (remove_in x y0 H6) in H; auto. + destruct H; eauto. +Qed. + +Lemma remove_1 : forall elt (m:t elt) x y, bst m -> avl m -> X.eq x y -> ~ In y (remove x m). +Proof. + intros; rewrite remove_in; intuition. +Qed. + +Lemma remove_2 : forall elt (m:t elt) x y e, bst m -> avl m -> ~X.eq x y -> + MapsTo y e m -> MapsTo y e (remove x m). +Proof. + intros elt m x y e; induction m; simpl; auto. + destruct (X.compare x k); + intros; inv bst; inv avl; try rewrite bal_mapsto; unfold create; auto; + try solve [inv MapsTo; auto]. + rewrite merge_mapsto; auto. + inv MapsTo; auto; order. +Qed. + +Lemma remove_3 : forall elt (m:t elt) x y e, bst m -> avl m -> + MapsTo y e (remove x m) -> MapsTo y e m. +Proof. + intros elt m x y e; induction m; simpl; auto. + destruct (X.compare x k); intros Bs Av; inv avl; inv bst; + try rewrite bal_mapsto; auto; unfold create. + intros; inv MapsTo; auto. + rewrite merge_mapsto; intuition. + intros; inv MapsTo; auto. +Qed. + +Section Elt2. + +Variable elt:Set. + +Notation eqk := (eqk (elt:= elt)). +Notation eqke := (eqke (elt:= elt)). +Notation ltk := (ltk (elt:= elt)). + +(** * Empty map *) + +Definition Empty m := forall (a : key)(e:elt) , ~ MapsTo a e m. + +Definition empty := (Leaf elt). + +Lemma empty_bst : bst empty. +Proof. + unfold empty; auto. +Qed. + +Lemma empty_avl : avl empty. +Proof. + unfold empty; auto. +Qed. + +Lemma empty_1 : Empty empty. +Proof. + unfold empty, Empty; intuition_in. +Qed. + +(** * Emptyness test *) + +Definition is_empty (s:t elt) := match s with Leaf => true | _ => false end. + +Lemma is_empty_1 : forall s, Empty s -> is_empty s = true. +Proof. + destruct s as [|r x e l h]; simpl; auto. + intro H; elim (H x e); auto. +Qed. + +Lemma is_empty_2 : forall s, is_empty s = true -> Empty s. +Proof. + destruct s; simpl; intros; try discriminate; red; intuition_in. +Qed. + +(** * Appartness *) + +(** The [mem] function is deciding appartness. It exploits the [bst] property + to achieve logarithmic complexity. *) + +Function mem (x:key)(m:t elt) { struct m } : bool := + match m with + | Leaf => false + | Node l y e r _ => match X.compare x y with + | LT _ => mem x l + | EQ _ => true + | GT _ => mem x r + end + end. +Implicit Arguments mem. + +Lemma mem_1 : forall s x, bst s -> In x s -> mem x s = true. +Proof. + intros s x. + functional induction (mem x s); inversion_clear 1; auto. + intuition_in. + intuition_in; firstorder; absurd (X.lt x y); eauto. + intuition_in; firstorder; absurd (X.lt y x); eauto. +Qed. + +Lemma mem_2 : forall s x, mem x s = true -> In x s. +Proof. + intros s x. + functional induction (mem x s); firstorder; intros; try discriminate. +Qed. + +Function find (x:key)(m:t elt) { struct m } : option elt := + match m with + | Leaf => None + | Node l y e r _ => match X.compare x y with + | LT _ => find x l + | EQ _ => Some e + | GT _ => find x r + end + end. + +Lemma find_1 : forall m x e, bst m -> MapsTo x e m -> find x m = Some e. +Proof. + intros m x e. + functional induction (find x m); inversion_clear 1; auto. + intuition_in. + intuition_in; firstorder; absurd (X.lt x y); eauto. + intuition_in; auto. + absurd (X.lt x y); eauto. + absurd (X.lt y x); eauto. + intuition_in; firstorder; absurd (X.lt y x); eauto. +Qed. + +Lemma find_2 : forall m x e, find x m = Some e -> MapsTo x e m. +Proof. + intros m x. + functional induction (find x m); subst;firstorder; intros; try discriminate. + inversion H; subst; auto. +Qed. + +(** An all-in-one spec for [add] used later in the naive [map2] *) + +Lemma add_spec : forall m x y e , bst m -> avl m -> + find x (add y e m) = if eq_dec x y then Some e else find x m. +Proof. +intros. +destruct (eq_dec x y). +apply find_1. +apply add_bst; auto. +eapply MapsTo_1 with y; eauto. +apply add_1; auto. +case_eq (find x m); intros. +apply find_1. +apply add_bst; auto. +apply add_2; auto. +apply find_2; auto. +case_eq (find x (add y e m)); auto; intros. +rewrite <- H1; symmetry. +apply find_1; auto. +eapply add_3; eauto. +apply find_2; eauto. +Qed. + +(** * Elements *) + +(** [elements_tree_aux acc t] catenates the elements of [t] in infix + order to the list [acc] *) + +Fixpoint elements_aux (acc : list (key*elt)) (t : t elt) {struct t} : list (key*elt) := + match t with + | Leaf => acc + | Node l x e r _ => elements_aux ((x,e) :: elements_aux acc r) l + end. + +(** then [elements] is an instanciation with an empty [acc] *) + +Definition elements := elements_aux nil. + +Lemma elements_aux_mapsto : forall s acc x e, + InA eqke (x,e) (elements_aux acc s) <-> MapsTo x e s \/ InA eqke (x,e) acc. +Proof. + induction s as [ | l Hl x e r Hr h ]; simpl; auto. + intuition. + inversion H0. + intros. + rewrite Hl. + destruct (Hr acc x0 e0); clear Hl Hr. + intuition; inversion_clear H3; intuition. + destruct H0; simpl in *; subst; intuition. +Qed. + +Lemma elements_mapsto : forall s x e, InA eqke (x,e) (elements s) <-> MapsTo x e s. +Proof. + intros; generalize (elements_aux_mapsto s nil x e); intuition. + inversion_clear H0. +Qed. + +Lemma elements_in : forall s x, L.PX.In x (elements s) <-> In x s. +Proof. + intros. + unfold L.PX.In. + rewrite <- In_alt; unfold In0. + firstorder. + exists x0. + rewrite <- elements_mapsto; auto. + exists x0. + unfold L.PX.MapsTo; rewrite elements_mapsto; auto. +Qed. + +Lemma elements_aux_sort : forall s acc, bst s -> sort ltk acc -> + (forall x e y, InA eqke (x,e) acc -> In y s -> X.lt y x) -> + sort ltk (elements_aux acc s). +Proof. + induction s as [ | l Hl y e r Hr h]; simpl; intuition. + inv bst. + apply Hl; auto. + constructor. + apply Hr; eauto. + apply (InA_InfA (eqke_refl (elt:=elt))); intros (y',e') H6. + destruct (elements_aux_mapsto r acc y' e'); intuition. + red; simpl; eauto. + red; simpl; eauto. + intros. + inversion_clear H. + destruct H7; simpl in *. + order. + destruct (elements_aux_mapsto r acc x e0); intuition eauto. +Qed. + +Lemma elements_sort : forall s : t elt, bst s -> sort ltk (elements s). +Proof. + intros; unfold elements; apply elements_aux_sort; auto. + intros; inversion H0. +Qed. +Hint Resolve elements_sort. + + +(** * Fold *) + +Fixpoint fold (A : Set) (f : key -> elt -> A -> A)(s : t elt) {struct s} : A -> A := + fun a => match s with + | Leaf => a + | Node l x e r _ => fold f r (f x e (fold f l a)) + end. + +Definition fold' (A : Set) (f : key -> elt -> A -> A)(s : t elt) := + L.fold f (elements s). + +Lemma fold_equiv_aux : + forall (A : Set) (s : t elt) (f : key -> elt -> A -> A) (a : A) acc, + L.fold f (elements_aux acc s) a = L.fold f acc (fold f s a). +Proof. + simple induction s. + simpl in |- *; intuition. + simpl in |- *; intros. + rewrite H. + simpl. + apply H0. +Qed. + +Lemma fold_equiv : + forall (A : Set) (s : t elt) (f : key -> elt -> A -> A) (a : A), + fold f s a = fold' f s a. +Proof. + unfold fold', elements in |- *. + simple induction s; simpl in |- *; auto; intros. + rewrite fold_equiv_aux. + rewrite H0. + simpl in |- *; auto. +Qed. + +Lemma fold_1 : + forall (s:t elt)(Hs:bst s)(A : Set)(i:A)(f : key -> elt -> A -> A), + fold f s i = fold_left (fun a p => f (fst p) (snd p) a) (elements s) i. +Proof. + intros. + rewrite fold_equiv. + unfold fold'. + rewrite L.fold_1. + unfold L.elements; auto. +Qed. + +(** * Comparison *) + +Definition Equal (cmp:elt->elt->bool) m m' := + (forall k, In k m <-> In k m') /\ + (forall k e e', MapsTo k e m -> MapsTo k e' m' -> cmp e e' = true). + +(** ** Enumeration of the elements of a tree *) + +Inductive enumeration : Set := + | End : enumeration + | More : key -> elt -> t elt -> enumeration -> enumeration. + +(** [flatten_e e] returns the list of elements of [e] i.e. the list + of elements actually compared *) + +Fixpoint flatten_e (e : enumeration) : list (key*elt) := match e with + | End => nil + | More x e t r => (x,e) :: elements t ++ flatten_e r + end. + +(** [sorted_e e] expresses that elements in the enumeration [e] are + sorted, and that all trees in [e] are binary search trees. *) + +Inductive In_e (p:key*elt) : enumeration -> Prop := + | InEHd1 : + forall (y : key)(d:elt) (s : t elt) (e : enumeration), + eqke p (y,d) -> In_e p (More y d s e) + | InEHd2 : + forall (y : key) (d:elt) (s : t elt) (e : enumeration), + MapsTo (fst p) (snd p) s -> In_e p (More y d s e) + | InETl : + forall (y : key) (d:elt) (s : t elt) (e : enumeration), + In_e p e -> In_e p (More y d s e). + +Hint Constructors In_e. + +Inductive sorted_e : enumeration -> Prop := + | SortedEEnd : sorted_e End + | SortedEMore : + forall (x : key) (d:elt) (s : t elt) (e : enumeration), + bst s -> + (gt_tree x s) -> + sorted_e e -> + (forall p, In_e p e -> ltk (x,d) p) -> + (forall p, + MapsTo (fst p) (snd p) s -> forall q, In_e q e -> ltk p q) -> + sorted_e (More x d s e). + +Hint Constructors sorted_e. + +Lemma in_flatten_e : + forall p e, InA eqke p (flatten_e e) -> In_e p e. +Proof. + simple induction e; simpl in |- *; intuition. + inversion_clear H. + inversion_clear H0; auto. + elim (InA_app H1); auto. + destruct (elements_mapsto t a b); auto. +Qed. + +Lemma sorted_flatten_e : + forall e : enumeration, sorted_e e -> sort ltk (flatten_e e). +Proof. + simple induction e; simpl in |- *; intuition. + apply cons_sort. + apply (SortA_app (eqke_refl (elt:=elt))); inversion_clear H0; auto. + intros; apply H5; auto. + rewrite <- elements_mapsto; auto; destruct x; auto. + apply in_flatten_e; auto. + inversion_clear H0. + apply In_InfA; intros. + intros; elim (in_app_or _ _ _ H0); intuition. + generalize (In_InA (eqke_refl (elt:=elt)) H6). + destruct y; rewrite elements_mapsto; eauto. + apply H4; apply in_flatten_e; auto. + apply In_InA; auto. +Qed. + +Lemma elements_app : + forall s acc, elements_aux acc s = elements s ++ acc. +Proof. + simple induction s; simpl in |- *; intuition. + rewrite H0. + rewrite H. + unfold elements; simpl. + do 2 rewrite H. + rewrite H0. + repeat rewrite <- app_nil_end. + repeat rewrite app_ass; auto. +Qed. + +Lemma compare_flatten_1 : + forall t1 t2 x e z l, + elements t1 ++ (x,e) :: elements t2 ++ l = + elements (Node t1 x e t2 z) ++ l. +Proof. + simpl in |- *; unfold elements in |- *; simpl in |- *; intuition. + repeat rewrite elements_app. + repeat rewrite <- app_nil_end. + repeat rewrite app_ass; auto. +Qed. + +(** key lemma for correctness *) + +Lemma flatten_e_elements : + forall l r x d z e, + elements l ++ flatten_e (More x d r e) = + elements (Node l x d r z) ++ flatten_e e. +Proof. + intros; simpl. + apply compare_flatten_1. +Qed. + +Open Scope Z_scope. + +(** termination of [compare_aux] *) + +Fixpoint measure_e_t (s : t elt) : Z := match s with + | Leaf => 0 + | Node l _ _ r _ => 1 + measure_e_t l + measure_e_t r + end. + +Fixpoint measure_e (e : enumeration) : Z := match e with + | End => 0 + | More _ _ s r => 1 + measure_e_t s + measure_e r + end. + +Ltac Measure_e_t := unfold measure_e_t in |- *; fold measure_e_t in |- *. +Ltac Measure_e := unfold measure_e in |- *; fold measure_e in |- *. + +Lemma measure_e_t_0 : forall s : t elt, measure_e_t s >= 0. +Proof. + simple induction s. + simpl in |- *; omega. + intros. + Measure_e_t; omega. +Qed. + +Ltac Measure_e_t_0 s := generalize (@measure_e_t_0 s); intro. + +Lemma measure_e_0 : forall e : enumeration, measure_e e >= 0. +Proof. + simple induction e. + simpl in |- *; omega. + intros. + Measure_e; Measure_e_t_0 t; omega. +Qed. + +Ltac Measure_e_0 e := generalize (@measure_e_0 e); intro. + +(** Induction principle over the sum of the measures for two lists *) + +Definition compare_rec2 : + forall P : enumeration -> enumeration -> Set, + (forall x x' : enumeration, + (forall y y' : enumeration, + measure_e y + measure_e y' < measure_e x + measure_e x' -> P y y') -> + P x x') -> + forall x x' : enumeration, P x x'. +Proof. + intros P H x x'. + apply well_founded_induction_type_2 + with (R := fun yy' xx' : enumeration * enumeration => + measure_e (fst yy') + measure_e (snd yy') < + measure_e (fst xx') + measure_e (snd xx')); auto. + apply Wf_nat.well_founded_lt_compat + with (f := fun xx' : enumeration * enumeration => + Zabs_nat (measure_e (fst xx') + measure_e (snd xx'))). + intros; apply Zabs.Zabs_nat_lt. + Measure_e_0 (fst x0); Measure_e_0 (snd x0); Measure_e_0 (fst y); + Measure_e_0 (snd y); intros; omega. +Qed. + +(** [cons t e] adds the elements of tree [t] on the head of + enumeration [e]. Code: + +let rec cons s e = match s with + | Empty -> e + | Node(l, k, d, r, _) -> cons l (More(k, d, r, e)) +*) + +Definition cons : forall s e, bst s -> sorted_e e -> + (forall x y, MapsTo (fst x) (snd x) s -> In_e y e -> ltk x y) -> + { r : enumeration + | sorted_e r /\ + measure_e r = measure_e_t s + measure_e e /\ + flatten_e r = elements s ++ flatten_e e + }. +Proof. + simple induction s; intuition. + (* s = Leaf *) + exists e; intuition. + (* s = Node t k e t0 z *) + clear H0. + case (H (More k e t0 e0)); clear H; intuition. + inv bst; auto. + constructor; inversion_clear H1; auto. + inversion_clear H0; inv bst; intuition. + destruct y; red; red in H4; simpl in *; intuition. + apply lt_eq with k; eauto. + destruct y; red; simpl in *; intuition. + apply X.lt_trans with k; eauto. + exists x; intuition. + generalize H4; Measure_e; intros; Measure_e_t; omega. + rewrite H5. + apply flatten_e_elements. +Qed. + +Definition equal_aux : + forall (cmp: elt -> elt -> bool)(e1 e2:enumeration), + sorted_e e1 -> sorted_e e2 -> + { L.Equal cmp (flatten_e e1) (flatten_e e2) } + + { ~ L.Equal cmp (flatten_e e1) (flatten_e e2) }. +Proof. + intros cmp e1 e2; pattern e1, e2 in |- *; apply compare_rec2. + simple destruct x; simple destruct x'; intuition. + (* x = x' = End *) + left; unfold L.Equal in |- *; intuition. + inversion H2. + (* x = End x' = More *) + right; simpl in |- *; auto. + destruct 1. + destruct (H2 k). + destruct H5; auto. + exists e; auto. + inversion H5. + (* x = More x' = End *) + right; simpl in |- *; auto. + destruct 1. + destruct (H2 k). + destruct H4; auto. + exists e; auto. + inversion H4. + (* x = More k e t e0, x' = More k0 e3 t0 e4 *) + case (X.compare k k0); intro. + (* k < k0 *) + right. + destruct 1. + clear H3 H. + assert (L.PX.In k (flatten_e (More k0 e3 t0 e4))). + destruct (H2 k). + apply H; simpl; exists e; auto. + destruct H. + generalize (Sort_In_cons_2 (sorted_flatten_e H1) (InA_eqke_eqk H)). + compute. + intuition order. + (* k = k0 *) + case_eq (cmp e e3). + intros EQ. + destruct (@cons t e0) as [c1 (H2,(H3,H4))]; try inversion_clear H0; auto. + destruct (@cons t0 e4) as [c2 (H5,(H6,H7))]; try inversion_clear H1; auto. + destruct (H c1 c2); clear H; intuition. + Measure_e; omega. + left. + rewrite H4 in e6; rewrite H7 in e6. + simpl; rewrite <- L.equal_cons; auto. + apply (sorted_flatten_e H0). + apply (sorted_flatten_e H1). + right. + simpl; rewrite <- L.equal_cons; auto. + apply (sorted_flatten_e H0). + apply (sorted_flatten_e H1). + swap f. + rewrite H4; rewrite H7; auto. + right. + destruct 1. + rewrite (H4 k) in H2; try discriminate; simpl; auto. + (* k > k0 *) + right. + destruct 1. + clear H3 H. + assert (L.PX.In k0 (flatten_e (More k e t e0))). + destruct (H2 k0). + apply H3; simpl; exists e3; auto. + destruct H. + generalize (Sort_In_cons_2 (sorted_flatten_e H0) (InA_eqke_eqk H)). + compute. + intuition order. +Qed. + +Lemma Equal_elements : forall cmp s s', + Equal cmp s s' <-> L.Equal cmp (elements s) (elements s'). +Proof. +unfold Equal, L.Equal; split; split; intros. +do 2 rewrite elements_in; firstorder. +destruct H. +apply (H2 k); rewrite <- elements_mapsto; auto. +do 2 rewrite <- elements_in; firstorder. +destruct H. +apply (H2 k); unfold L.PX.MapsTo; rewrite elements_mapsto; auto. +Qed. + +Definition equal : forall cmp s s', bst s -> bst s' -> + {Equal cmp s s'} + {~ Equal cmp s s'}. +Proof. + intros cmp s1 s2 s1_bst s2_bst; simpl. + destruct (@cons s1 End); auto. + inversion_clear 2. + destruct (@cons s2 End); auto. + inversion_clear 2. + simpl in a; rewrite <- app_nil_end in a. + simpl in a0; rewrite <- app_nil_end in a0. + destruct (@equal_aux cmp x x0); intuition. + left. + rewrite H4 in e; rewrite H5 in e. + rewrite Equal_elements; auto. + right. + swap n. + rewrite H4; rewrite H5. + rewrite <- Equal_elements; auto. +Qed. + +End Elt2. + +Section Elts. + +Variable elt elt' elt'' : Set. + +Section Map. +Variable f : elt -> elt'. + +Fixpoint map (m:t elt) {struct m} : t elt' := + match m with + | Leaf => Leaf _ + | Node l v d r h => Node (map l) v (f d) (map r) h + end. + +Lemma map_height : forall m, height (map m) = height m. +Proof. +destruct m; simpl; auto. +Qed. + +Lemma map_avl : forall m, avl m -> avl (map m). +Proof. +induction m; simpl; auto. +inversion_clear 1; constructor; auto; do 2 rewrite map_height; auto. +Qed. + +Lemma map_1 : forall (m: tree elt)(x:key)(e:elt), + MapsTo x e m -> MapsTo x (f e) (map m). +Proof. +induction m; simpl; inversion_clear 1; auto. +Qed. + +Lemma map_2 : forall (m: t elt)(x:key), + In x (map m) -> In x m. +Proof. +induction m; simpl; inversion_clear 1; auto. +Qed. + +Lemma map_bst : forall m, bst m -> bst (map m). +Proof. +induction m; simpl; auto. +inversion_clear 1; constructor; auto. +red; intros; apply H2; apply map_2; auto. +red; intros; apply H3; apply map_2; auto. +Qed. + +End Map. +Section Mapi. +Variable f : key -> elt -> elt'. + +Fixpoint mapi (m:t elt) {struct m} : t elt' := + match m with + | Leaf => Leaf _ + | Node l v d r h => Node (mapi l) v (f v d) (mapi r) h + end. + +Lemma mapi_height : forall m, height (mapi m) = height m. +Proof. +destruct m; simpl; auto. +Qed. + +Lemma mapi_avl : forall m, avl m -> avl (mapi m). +Proof. +induction m; simpl; auto. +inversion_clear 1; constructor; auto; do 2 rewrite mapi_height; auto. +Qed. + +Lemma mapi_1 : forall (m: tree elt)(x:key)(e:elt), + MapsTo x e m -> exists y, X.eq y x /\ MapsTo x (f y e) (mapi m). +Proof. +induction m; simpl; inversion_clear 1; auto. +exists k; auto. +destruct (IHm1 _ _ H0). +exists x0; intuition. +destruct (IHm2 _ _ H0). +exists x0; intuition. +Qed. + +Lemma mapi_2 : forall (m: t elt)(x:key), + In x (mapi m) -> In x m. +Proof. +induction m; simpl; inversion_clear 1; auto. +Qed. + +Lemma mapi_bst : forall m, bst m -> bst (mapi m). +Proof. +induction m; simpl; auto. +inversion_clear 1; constructor; auto. +red; intros; apply H2; apply mapi_2; auto. +red; intros; apply H3; apply mapi_2; auto. +Qed. + +End Mapi. + +Section Map2. +Variable f : option elt -> option elt' -> option elt''. + +(* Not exactly pretty nor perfect, but should suffice as a first naive implem. + Anyway, map2 isn't in Ocaml... +*) + +Definition anti_elements (l:list (key*elt'')) := L.fold (@add _) l (empty _). + +Definition map2 (m:t elt)(m':t elt') : t elt'' := + anti_elements (L.map2 f (elements m) (elements m')). + +Lemma anti_elements_avl_aux : forall (l:list (key*elt''))(m:t elt''), + avl m -> avl (L.fold (@add _) l m). +Proof. +unfold anti_elements; induction l. +simpl; auto. +simpl; destruct a; intros. +apply IHl. +apply add_avl; auto. +Qed. + +Lemma anti_elements_avl : forall l, avl (anti_elements l). +Proof. +unfold anti_elements, empty; intros; apply anti_elements_avl_aux; auto. +Qed. + +Lemma anti_elements_bst_aux : forall (l:list (key*elt''))(m:t elt''), + bst m -> avl m -> bst (L.fold (@add _) l m). +Proof. +induction l. +simpl; auto. +simpl; destruct a; intros. +apply IHl. +apply add_bst; auto. +apply add_avl; auto. +Qed. + +Lemma anti_elements_bst : forall l, bst (anti_elements l). +Proof. +unfold anti_elements, empty; intros; apply anti_elements_bst_aux; auto. +Qed. + +Lemma anti_elements_mapsto_aux : forall (l:list (key*elt'')) m k e, + bst m -> avl m -> NoDupA (eqk (elt:=elt'')) l -> + (forall x, L.PX.In x l -> In x m -> False) -> + (MapsTo k e (L.fold (@add _) l m) <-> L.PX.MapsTo k e l \/ MapsTo k e m). +Proof. +induction l. +simpl; auto. +intuition. +inversion H4. +simpl; destruct a; intros. +rewrite IHl; clear IHl. +apply add_bst; auto. +apply add_avl; auto. +inversion H1; auto. +intros. +inversion_clear H1. +assert (~X.eq x k). + swap H5. + destruct H3. + apply InA_eqA with (x,x0); eauto. +apply (H2 x). +destruct H3; exists x0; auto. +revert H4; do 2 rewrite <- In_alt; destruct 1; exists x0; auto. +eapply add_3; eauto. +intuition. +assert (find k0 (add k e m) = Some e0). + apply find_1; auto. + apply add_bst; auto. +clear H4. +rewrite add_spec in H3; auto. +destruct (eq_dec k0 k). +inversion_clear H3; subst; auto. +right; apply find_2; auto. +inversion_clear H4; auto. +compute in H3; destruct H3. +subst; right; apply add_1; auto. +inversion_clear H1. +destruct (eq_dec k0 k). +destruct (H2 k); eauto. +right; apply add_2; auto. +Qed. + +Lemma anti_elements_mapsto : forall l k e, NoDupA (eqk (elt:=elt'')) l -> + (MapsTo k e (anti_elements l) <-> L.PX.MapsTo k e l). +Proof. +intros. +unfold anti_elements. +rewrite anti_elements_mapsto_aux; auto; unfold empty; auto. +inversion 2. +intuition. +inversion H1. +Qed. + +Lemma map2_avl : forall (m: t elt)(m': t elt'), avl (map2 m m'). +Proof. +unfold map2; intros; apply anti_elements_avl; auto. +Qed. + +Lemma map2_bst : forall (m: t elt)(m': t elt'), bst (map2 m m'). +Proof. +unfold map2; intros; apply anti_elements_bst; auto. +Qed. + +Lemma find_elements : forall (elt:Set)(m: t elt) x, bst m -> + L.find x (elements m) = find x m. +Proof. +intros. +case_eq (find x m); intros. +apply L.find_1. +apply elements_sort; auto. +red; rewrite elements_mapsto. +apply find_2; auto. +case_eq (L.find x (elements m)); auto; intros. +rewrite <- H0; symmetry. +apply find_1; auto. +rewrite <- elements_mapsto. +apply L.find_2; auto. +Qed. + +Lemma find_anti_elements : forall (l: list (key*elt'')) x, sort (@ltk _) l -> + find x (anti_elements l) = L.find x l. +Proof. +intros. +case_eq (L.find x l); intros. +apply find_1. +apply anti_elements_bst; auto. +rewrite anti_elements_mapsto. +apply L.PX.Sort_NoDupA; auto. +apply L.find_2; auto. +case_eq (find x (anti_elements l)); auto; intros. +rewrite <- H0; symmetry. +apply L.find_1; auto. +rewrite <- anti_elements_mapsto. +apply L.PX.Sort_NoDupA; auto. +apply find_2; auto. +Qed. + +Lemma map2_1 : forall (m: t elt)(m': t elt')(x:key), bst m -> bst m' -> + In x m \/ In x m' -> find x (map2 m m') = f (find x m) (find x m'). +Proof. +unfold map2; intros. +rewrite find_anti_elements; auto. +rewrite <- find_elements; auto. +rewrite <- find_elements; auto. +apply L.map2_1; auto. +apply elements_sort; auto. +apply elements_sort; auto. +do 2 rewrite elements_in; auto. +apply L.map2_sorted; auto. +apply elements_sort; auto. +apply elements_sort; auto. +Qed. + +Lemma map2_2 : forall (m: t elt)(m': t elt')(x:key), bst m -> bst m' -> + In x (map2 m m') -> In x m \/ In x m'. +Proof. +unfold map2; intros. +do 2 rewrite <- elements_in. +apply L.map2_2 with (f:=f); auto. +apply elements_sort; auto. +apply elements_sort; auto. +revert H1. +rewrite <- In_alt. +destruct 1. +exists x0. +rewrite <- anti_elements_mapsto; auto. +apply L.PX.Sort_NoDupA; auto. +apply L.map2_sorted; auto. +apply elements_sort; auto. +apply elements_sort; auto. +Qed. + +End Map2. +End Elts. +End Raw. + +(** * Encapsulation + + Now, in order to really provide a functor implementing [S], we + need to encapsulate everything into a type of balanced binary search trees. *) + +Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. + + Module E := X. + Module Raw := Raw I X. + + Record bbst (elt:Set) : Set := + Bbst {this :> Raw.tree elt; is_bst : Raw.bst this; is_avl: Raw.avl this}. + + Definition t := bbst. + Definition key := E.t. + + Section Elt. + Variable elt elt' elt'': Set. + + Implicit Types m : t elt. + Implicit Types x y : key. + Implicit Types e : elt. + + Definition empty : t elt := Bbst (Raw.empty_bst elt) (Raw.empty_avl elt). + Definition is_empty m : bool := Raw.is_empty m.(this). + Definition add x e m : t elt := + Bbst (Raw.add_bst x e m.(is_bst) m.(is_avl)) (Raw.add_avl x e m.(is_avl)). + Definition remove x m : t elt := + Bbst (Raw.remove_bst x m.(is_bst) m.(is_avl)) (Raw.remove_avl x m.(is_avl)). + Definition mem x m : bool := Raw.mem x m.(this). + Definition find x m : option elt := Raw.find x m.(this). + Definition map f m : t elt' := + Bbst (Raw.map_bst f m.(is_bst)) (Raw.map_avl f m.(is_avl)). + Definition mapi (f:key->elt->elt') m : t elt' := + Bbst (Raw.mapi_bst f m.(is_bst)) (Raw.mapi_avl f m.(is_avl)). + Definition map2 f m (m':t elt') : t elt'' := + Bbst (Raw.map2_bst f m m') (Raw.map2_avl f m m'). + Definition elements m : list (key*elt) := Raw.elements m.(this). + Definition fold (A:Set) (f:key->elt->A->A) m i := Raw.fold (A:=A) f m.(this) i. + Definition equal cmp m m' : bool := + if (Raw.equal cmp m.(is_bst) m'.(is_bst)) then true else false. + + Definition MapsTo x e m : Prop := Raw.MapsTo x e m.(this). + Definition In x m : Prop := Raw.In0 x m.(this). + Definition Empty m : Prop := Raw.Empty m.(this). + + Definition eq_key : (key*elt) -> (key*elt) -> Prop := @Raw.PX.eqk elt. + Definition eq_key_elt : (key*elt) -> (key*elt) -> Prop := @Raw.PX.eqke elt. + Definition lt_key : (key*elt) -> (key*elt) -> Prop := @Raw.PX.ltk elt. + + Lemma MapsTo_1 : forall m x y e, E.eq x y -> MapsTo x e m -> MapsTo y e m. + Proof. intros m; exact (@Raw.MapsTo_1 _ m.(this)). Qed. + + Lemma mem_1 : forall m x, In x m -> mem x m = true. + Proof. + unfold In, mem; intros m x; rewrite Raw.In_alt; simpl; apply Raw.mem_1; auto. + apply m.(is_bst). + Qed. + + Lemma mem_2 : forall m x, mem x m = true -> In x m. + Proof. + unfold In, mem; intros m x; rewrite Raw.In_alt; simpl; apply Raw.mem_2; auto. + Qed. + + Lemma empty_1 : Empty empty. + Proof. exact (@Raw.empty_1 elt). Qed. + + Lemma is_empty_1 : forall m, Empty m -> is_empty m = true. + Proof. intros m; exact (@Raw.is_empty_1 _ m.(this)). Qed. + Lemma is_empty_2 : forall m, is_empty m = true -> Empty m. + Proof. intros m; exact (@Raw.is_empty_2 _ m.(this)). Qed. + + Lemma add_1 : forall m x y e, E.eq x y -> MapsTo y e (add x e m). + Proof. intros m x y e; exact (@Raw.add_1 elt _ x y e m.(is_avl)). Qed. + Lemma add_2 : forall m x y e e', ~ E.eq x y -> MapsTo y e m -> MapsTo y e (add x e' m). + Proof. intros m x y e e'; exact (@Raw.add_2 elt _ x y e e' m.(is_avl)). Qed. + Lemma add_3 : forall m x y e e', ~ E.eq x y -> MapsTo y e (add x e' m) -> MapsTo y e m. + Proof. intros m x y e e'; exact (@Raw.add_3 elt _ x y e e' m.(is_avl)). Qed. + + Lemma remove_1 : forall m x y, E.eq x y -> ~ In y (remove x m). + Proof. + unfold In, remove; intros m x y; rewrite Raw.In_alt; simpl; apply Raw.remove_1; auto. + apply m.(is_bst). + apply m.(is_avl). + Qed. + Lemma remove_2 : forall m x y e, ~ E.eq x y -> MapsTo y e m -> MapsTo y e (remove x m). + Proof. intros m x y e; exact (@Raw.remove_2 elt _ x y e m.(is_bst) m.(is_avl)). Qed. + Lemma remove_3 : forall m x y e, MapsTo y e (remove x m) -> MapsTo y e m. + Proof. intros m x y e; exact (@Raw.remove_3 elt _ x y e m.(is_bst) m.(is_avl)). Qed. + + + Lemma find_1 : forall m x e, MapsTo x e m -> find x m = Some e. + Proof. intros m x e; exact (@Raw.find_1 elt _ x e m.(is_bst)). Qed. + Lemma find_2 : forall m x e, find x m = Some e -> MapsTo x e m. + Proof. intros m; exact (@Raw.find_2 elt m.(this)). Qed. + + Lemma fold_1 : forall m (A : Set) (i : A) (f : key -> elt -> A -> A), + fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (elements m) i. + Proof. intros m; exact (@Raw.fold_1 elt m.(this) m.(is_bst)). Qed. + + Lemma elements_1 : forall m x e, + MapsTo x e m -> InA eq_key_elt (x,e) (elements m). + Proof. + intros; unfold elements, MapsTo, eq_key_elt; rewrite Raw.elements_mapsto; auto. + Qed. + + Lemma elements_2 : forall m x e, + InA eq_key_elt (x,e) (elements m) -> MapsTo x e m. + Proof. + intros; unfold elements, MapsTo, eq_key_elt; rewrite <- Raw.elements_mapsto; auto. + Qed. + + Lemma elements_3 : forall m, sort lt_key (elements m). + Proof. intros m; exact (@Raw.elements_sort elt m.(this) m.(is_bst)). Qed. + + Definition Equal cmp m m' := + (forall k, In k m <-> In k m') /\ + (forall k e e', MapsTo k e m -> MapsTo k e' m' -> cmp e e' = true). + + Lemma Equal_Equal : forall cmp m m', Equal cmp m m' <-> Raw.Equal cmp m m'. + Proof. + intros; unfold Equal, Raw.Equal, In; intuition. + generalize (H0 k); do 2 rewrite Raw.In_alt; intuition. + generalize (H0 k); do 2 rewrite Raw.In_alt; intuition. + generalize (H0 k); do 2 rewrite <- Raw.In_alt; intuition. + generalize (H0 k); do 2 rewrite <- Raw.In_alt; intuition. + Qed. + + Lemma equal_1 : forall m m' cmp, + Equal cmp m m' -> equal cmp m m' = true. + Proof. + unfold equal; intros m m' cmp; rewrite Equal_Equal. + destruct (@Raw.equal _ cmp m m'); auto. + Qed. + + Lemma equal_2 : forall m m' cmp, + equal cmp m m' = true -> Equal cmp m m'. + Proof. + unfold equal; intros; rewrite Equal_Equal. + destruct (@Raw.equal _ cmp m m'); auto; try discriminate. + Qed. + + End Elt. + + Lemma map_1 : forall (elt elt':Set)(m: t elt)(x:key)(e:elt)(f:elt->elt'), + MapsTo x e m -> MapsTo x (f e) (map f m). + Proof. intros elt elt' m x e f; exact (@Raw.map_1 elt elt' f m.(this) x e). Qed. + + Lemma map_2 : forall (elt elt':Set)(m:t elt)(x:key)(f:elt->elt'), In x (map f m) -> In x m. + Proof. + intros elt elt' m x f; do 2 unfold In in *; do 2 rewrite Raw.In_alt; simpl. + apply Raw.map_2; auto. + Qed. + + Lemma mapi_1 : forall (elt elt':Set)(m: t elt)(x:key)(e:elt) + (f:key->elt->elt'), MapsTo x e m -> + exists y, E.eq y x /\ MapsTo x (f y e) (mapi f m). + Proof. intros elt elt' m x e f; exact (@Raw.mapi_1 elt elt' f m.(this) x e). Qed. + Lemma mapi_2 : forall (elt elt':Set)(m: t elt)(x:key) + (f:key->elt->elt'), In x (mapi f m) -> In x m. + Proof. + intros elt elt' m x f; unfold In in *; do 2 rewrite Raw.In_alt; simpl; apply Raw.mapi_2; auto. + Qed. + + Lemma map2_1 : forall (elt elt' elt'':Set)(m: t elt)(m': t elt') + (x:key)(f:option elt->option elt'->option elt''), + In x m \/ In x m' -> + find x (map2 f m m') = f (find x m) (find x m'). + Proof. + unfold find, map2, In; intros elt elt' elt'' m m' x f. + do 2 rewrite Raw.In_alt; intros; simpl; apply Raw.map2_1; auto. + apply m.(is_bst). + apply m'.(is_bst). + Qed. + + Lemma map2_2 : forall (elt elt' elt'':Set)(m: t elt)(m': t elt') + (x:key)(f:option elt->option elt'->option elt''), + In x (map2 f m m') -> In x m \/ In x m'. + Proof. + unfold In, map2; intros elt elt' elt'' m m' x f. + do 3 rewrite Raw.In_alt; intros; simpl in *; eapply Raw.map2_2; eauto. + apply m.(is_bst). + apply m'.(is_bst). + Qed. + +End IntMake. + + +Module IntMake_ord (I:Int)(X: OrderedType)(D : OrderedType) <: + Sord with Module Data := D + with Module MapS.E := X. + + Module Data := D. + Module MapS := IntMake(I)(X). + Import MapS. + + Module MD := OrderedTypeFacts(D). + Import MD. + + Module LO := FMapList.Make_ord(X)(D). + + Definition t := MapS.t D.t. + + Definition cmp e e' := match D.compare e e' with EQ _ => true | _ => false end. + + Definition elements (m:t) := + LO.MapS.Build_slist (Raw.elements_sort m.(is_bst)). + + Definition eq : t -> t -> Prop := + fun m1 m2 => LO.eq (elements m1) (elements m2). + + Definition lt : t -> t -> Prop := + fun m1 m2 => LO.lt (elements m1) (elements m2). + + Lemma eq_1 : forall m m', Equal cmp m m' -> eq m m'. + Proof. + intros m m'. + unfold eq. + rewrite Equal_Equal. + rewrite Raw.Equal_elements. + intros. + apply LO.eq_1. + auto. + Qed. + + Lemma eq_2 : forall m m', eq m m' -> Equal cmp m m'. + Proof. + intros m m'. + unfold eq. + rewrite Equal_Equal. + rewrite Raw.Equal_elements. + intros. + generalize (LO.eq_2 H). + auto. + Qed. + + Lemma eq_refl : forall m : t, eq m m. + Proof. + unfold eq; intros; apply LO.eq_refl. + Qed. + + Lemma eq_sym : forall m1 m2 : t, eq m1 m2 -> eq m2 m1. + Proof. + unfold eq; intros; apply LO.eq_sym; auto. + Qed. + + Lemma eq_trans : forall m1 m2 m3 : t, eq m1 m2 -> eq m2 m3 -> eq m1 m3. + Proof. + unfold eq; intros; eapply LO.eq_trans; eauto. + Qed. + + Lemma lt_trans : forall m1 m2 m3 : t, lt m1 m2 -> lt m2 m3 -> lt m1 m3. + Proof. + unfold lt; intros; eapply LO.lt_trans; eauto. + Qed. + + Lemma lt_not_eq : forall m1 m2 : t, lt m1 m2 -> ~ eq m1 m2. + Proof. + unfold lt, eq; intros; apply LO.lt_not_eq; auto. + Qed. + + Import Raw. + + Definition flatten_slist (e:enumeration D.t)(He:sorted_e e) := + LO.MapS.Build_slist (sorted_flatten_e He). + + Open Scope Z_scope. + + Definition compare_aux : + forall (e1 e2:enumeration D.t)(He1:sorted_e e1)(He2: sorted_e e2), + Compare LO.lt LO.eq (flatten_slist He1) (flatten_slist He2). + Proof. + intros e1 e2; pattern e1, e2 in |- *; apply compare_rec2. + simple destruct x; simple destruct x'; intuition. + (* x = x' = End *) + constructor 2. + compute; auto. + (* x = End x' = More *) + constructor 1. + compute; auto. + (* x = More x' = End *) + constructor 3. + compute; auto. + (* x = More k t0 t1 e, x' = More k0 t2 t3 e0 *) + case (X.compare k k0); intro. + (* k < k0 *) + constructor 1. + compute; MX.elim_comp; auto. + (* k = k0 *) + destruct (D.compare t t1). + constructor 1. + compute; MX.elim_comp; auto. + destruct (@cons _ t0 e) as [c1 (H2,(H3,H4))]; try inversion_clear He1; auto. + destruct (@cons _ t2 e0) as [c2 (H5,(H6,H7))]; try inversion_clear He2; auto. + assert (measure_e c1 + measure_e c2 < + measure_e (More k t t0 e) + + measure_e (More k0 t1 t2 e0)). + unfold measure_e in *; fold measure_e in *; omega. + destruct (H c1 c2 H0 H2 H5); clear H. + constructor 1. + unfold flatten_slist, LO.lt in *; simpl; simpl in l. + MX.elim_comp. + right; split; auto. + rewrite <- H7; rewrite <- H4; auto. + constructor 2. + unfold flatten_slist, LO.eq in *; simpl; simpl in e5. + MX.elim_comp. + split; auto. + rewrite <- H7; rewrite <- H4; auto. + constructor 3. + unfold flatten_slist, LO.lt in *; simpl; simpl in l. + MX.elim_comp. + right; split; auto. + rewrite <- H7; rewrite <- H4; auto. + constructor 3. + compute; MX.elim_comp; auto. + (* k > k0 *) + constructor 3. + compute; MX.elim_comp; auto. + Qed. + + Definition compare : forall m1 m2, Compare lt eq m1 m2. + Proof. + intros (m1,m1_bst,m1_avl) (m2,m2_bst,m2_avl); simpl. + destruct (@cons _ m1 (End _)) as [x1 (H1,H11)]; auto. + apply SortedEEnd. + inversion_clear 2. + destruct (@cons _ m2 (End _)) as [x2 (H2,H22)]; auto. + apply SortedEEnd. + inversion_clear 2. + simpl in H11; rewrite <- app_nil_end in H11. + simpl in H22; rewrite <- app_nil_end in H22. + destruct (compare_aux H1 H2); intuition. + constructor 1. + unfold lt, LO.lt, IntMake_ord.elements, flatten_slist in *; simpl in *. + rewrite <- H0; rewrite <- H4; auto. + constructor 2. + unfold eq, LO.eq, IntMake_ord.elements, flatten_slist in *; simpl in *. + rewrite <- H0; rewrite <- H4; auto. + constructor 3. + unfold lt, LO.lt, IntMake_ord.elements, flatten_slist in *; simpl in *. + rewrite <- H0; rewrite <- H4; auto. + Qed. + +End IntMake_ord. + +(* For concrete use inside Coq, we propose an instantiation of [Int] by [Z]. *) + +Module Make (X: OrderedType) <: S with Module E := X + :=IntMake(Z_as_Int)(X). + +Module Make_ord (X: OrderedType)(D: OrderedType) + <: Sord with Module Data := D + with Module MapS.E := X + :=IntMake_ord(Z_as_Int)(X)(D). diff --git a/theories/FSets/FMapFacts.v b/theories/FSets/FMapFacts.v new file mode 100644 index 00000000..0105095a --- /dev/null +++ b/theories/FSets/FMapFacts.v @@ -0,0 +1,557 @@ +(***********************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * INRIA-Rocquencourt & LRI-CNRS-Orsay *) +(* \VV/ *************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(***********************************************************************) + +(* $Id: FMapFacts.v 8882 2006-05-31 21:55:30Z letouzey $ *) + +(** * Finite maps library *) + +(** This functor derives additional facts from [FMapInterface.S]. These + facts are mainly the specifications of [FMapInterface.S] written using + different styles: equivalence and boolean equalities. +*) + +Require Import Bool. +Require Import OrderedType. +Require Export FMapInterface. +Set Implicit Arguments. +Unset Strict Implicit. + +Module Facts (M: S). +Module ME := OrderedTypeFacts M.E. +Import ME. +Import M. +Import Logic. (* to unmask [eq] *) +Import Peano. (* to unmask [lt] *) + +Lemma MapsTo_fun : forall (elt:Set) m x (e e':elt), + MapsTo x e m -> MapsTo x e' m -> e=e'. +Proof. +intros. +generalize (find_1 H) (find_1 H0); clear H H0. +intros; rewrite H in H0; injection H0; auto. +Qed. + +(** * Specifications written using equivalences *) + +Section IffSpec. +Variable elt elt' elt'': Set. +Implicit Type m: t elt. +Implicit Type x y z: key. +Implicit Type e: elt. + +Lemma MapsTo_iff : forall m x y e, E.eq x y -> (MapsTo x e m <-> MapsTo y e m). +Proof. +split; apply MapsTo_1; auto. +Qed. + +Lemma In_iff : forall m x y, E.eq x y -> (In x m <-> In y m). +Proof. +unfold In. +split; intros (e0,H0); exists e0. +apply (MapsTo_1 H H0); auto. +apply (MapsTo_1 (E.eq_sym H) H0); auto. +Qed. + +Lemma find_mapsto_iff : forall m x e, MapsTo x e m <-> find x m = Some e. +Proof. +split; [apply find_1|apply find_2]. +Qed. + +Lemma not_find_mapsto_iff : forall m x, ~In x m <-> find x m = None. +Proof. +intros. +generalize (find_mapsto_iff m x); destruct (find x m). +split; intros; try discriminate. +destruct H0. +exists e; rewrite H; auto. +split; auto. +intros; intros (e,H1). +rewrite H in H1; discriminate. +Qed. + +Lemma mem_in_iff : forall m x, In x m <-> mem x m = true. +Proof. +split; [apply mem_1|apply mem_2]. +Qed. + +Lemma not_mem_in_iff : forall m x, ~In x m <-> mem x m = false. +Proof. +intros; rewrite mem_in_iff; destruct (mem x m); intuition. +Qed. + +Lemma equal_iff : forall m m' cmp, Equal cmp m m' <-> equal cmp m m' = true. +Proof. +split; [apply equal_1|apply equal_2]. +Qed. + +Lemma empty_mapsto_iff : forall x e, MapsTo x e (empty elt) <-> False. +Proof. +intuition; apply (empty_1 H). +Qed. + +Lemma empty_in_iff : forall x, In x (empty elt) <-> False. +Proof. +unfold In. +split; [intros (e,H); rewrite empty_mapsto_iff in H|]; intuition. +Qed. + +Lemma is_empty_iff : forall m, Empty m <-> is_empty m = true. +Proof. +split; [apply is_empty_1|apply is_empty_2]. +Qed. + +Lemma add_mapsto_iff : forall m x y e e', + MapsTo y e' (add x e m) <-> + (E.eq x y /\ e=e') \/ + (~E.eq x y /\ MapsTo y e' m). +Proof. +intros. +intuition. +destruct (eq_dec x y); [left|right]. +split; auto. +symmetry; apply (MapsTo_fun (e':=e) H); auto. +split; auto; apply add_3 with x e; auto. +subst; auto. +Qed. + +Lemma add_in_iff : forall m x y e, In y (add x e m) <-> E.eq x y \/ In y m. +Proof. +unfold In; split. +intros (e',H). +destruct (eq_dec x y) as [E|E]; auto. +right; exists e'; auto. +apply (add_3 E H). +destruct (eq_dec x y) as [E|E]; auto. +intros. +exists e; apply add_1; auto. +intros [H|(e',H)]. +destruct E; auto. +exists e'; apply add_2; auto. +Qed. + +Lemma add_neq_mapsto_iff : forall m x y e e', + ~ E.eq x y -> (MapsTo y e' (add x e m) <-> MapsTo y e' m). +Proof. +split; [apply add_3|apply add_2]; auto. +Qed. + +Lemma add_neq_in_iff : forall m x y e, + ~ E.eq x y -> (In y (add x e m) <-> In y m). +Proof. +split; intros (e',H0); exists e'. +apply (add_3 H H0). +apply add_2; auto. +Qed. + +Lemma remove_mapsto_iff : forall m x y e, + MapsTo y e (remove x m) <-> ~E.eq x y /\ MapsTo y e m. +Proof. +intros. +split; intros. +split. +assert (In y (remove x m)) by (exists e; auto). +intro H1; apply (remove_1 H1 H0). +apply remove_3 with x; auto. +apply remove_2; intuition. +Qed. + +Lemma remove_in_iff : forall m x y, In y (remove x m) <-> ~E.eq x y /\ In y m. +Proof. +unfold In; split. +intros (e,H). +split. +assert (In y (remove x m)) by (exists e; auto). +intro H1; apply (remove_1 H1 H0). +exists e; apply remove_3 with x; auto. +intros (H,(e,H0)); exists e; apply remove_2; auto. +Qed. + +Lemma remove_neq_mapsto_iff : forall m x y e, + ~ E.eq x y -> (MapsTo y e (remove x m) <-> MapsTo y e m). +Proof. +split; [apply remove_3|apply remove_2]; auto. +Qed. + +Lemma remove_neq_in_iff : forall m x y, + ~ E.eq x y -> (In y (remove x m) <-> In y m). +Proof. +split; intros (e',H0); exists e'. +apply (remove_3 H0). +apply remove_2; auto. +Qed. + +Lemma elements_mapsto_iff : forall m x e, + MapsTo x e m <-> InA (@eq_key_elt _) (x,e) (elements m). +Proof. +split; [apply elements_1 | apply elements_2]. +Qed. + +Lemma elements_in_iff : forall m x, + In x m <-> exists e, InA (@eq_key_elt _) (x,e) (elements m). +Proof. +unfold In; split; intros (e,H); exists e; [apply elements_1 | apply elements_2]; auto. +Qed. + +Lemma map_mapsto_iff : forall m x b (f : elt -> elt'), + MapsTo x b (map f m) <-> exists a, b = f a /\ MapsTo x a m. +Proof. +split. +case_eq (find x m); intros. +exists e. +split. +apply (MapsTo_fun (m:=map f m) (x:=x)); auto. +apply find_2; auto. +assert (In x (map f m)) by (exists b; auto). +destruct (map_2 H1) as (a,H2). +rewrite (find_1 H2) in H; discriminate. +intros (a,(H,H0)). +subst b; auto. +Qed. + +Lemma map_in_iff : forall m x (f : elt -> elt'), + In x (map f m) <-> In x m. +Proof. +split; intros; eauto. +destruct H as (a,H). +exists (f a); auto. +Qed. + +Lemma mapi_in_iff : forall m x (f:key->elt->elt'), + In x (mapi f m) <-> In x m. +Proof. +split; intros; eauto. +destruct H as (a,H). +destruct (mapi_1 f H) as (y,(H0,H1)). +exists (f y a); auto. +Qed. + +(* Unfortunately, we don't have simple equivalences for [mapi] + and [MapsTo]. The only correct one needs compatibility of [f]. *) + +Lemma mapi_inv : forall m x b (f : key -> elt -> elt'), + MapsTo x b (mapi f m) -> + exists a, exists y, E.eq y x /\ b = f y a /\ MapsTo x a m. +Proof. +intros; case_eq (find x m); intros. +exists e. +destruct (@mapi_1 _ _ m x e f) as (y,(H1,H2)). +apply find_2; auto. +exists y; repeat split; auto. +apply (MapsTo_fun (m:=mapi f m) (x:=x)); auto. +assert (In x (mapi f m)) by (exists b; auto). +destruct (mapi_2 H1) as (a,H2). +rewrite (find_1 H2) in H0; discriminate. +Qed. + +Lemma mapi_1bis : forall m x e (f:key->elt->elt'), + (forall x y e, E.eq x y -> f x e = f y e) -> + MapsTo x e m -> MapsTo x (f x e) (mapi f m). +Proof. +intros. +destruct (mapi_1 f H0) as (y,(H1,H2)). +replace (f x e) with (f y e) by auto. +auto. +Qed. + +Lemma mapi_mapsto_iff : forall m x b (f:key->elt->elt'), + (forall x y e, E.eq x y -> f x e = f y e) -> + (MapsTo x b (mapi f m) <-> exists a, b = f x a /\ MapsTo x a m). +Proof. +split. +intros. +destruct (mapi_inv H0) as (a,(y,(H1,(H2,H3)))). +exists a; split; auto. +subst b; auto. +intros (a,(H0,H1)). +subst b. +apply mapi_1bis; auto. +Qed. + +(** Things are even worse for [map2] : we don't try to state any + equivalence, see instead boolean results below. *) + +End IffSpec. + +(** Useful tactic for simplifying expressions like [In y (add x e (remove z m))] *) + +Ltac map_iff := + repeat (progress ( + rewrite add_mapsto_iff || rewrite add_in_iff || + rewrite remove_mapsto_iff || rewrite remove_in_iff || + rewrite empty_mapsto_iff || rewrite empty_in_iff || + rewrite map_mapsto_iff || rewrite map_in_iff || + rewrite mapi_in_iff)). + +(** * Specifications written using boolean predicates *) + +Section BoolSpec. + +Lemma mem_find_b : forall (elt:Set)(m:t elt)(x:key), mem x m = if find x m then true else false. +Proof. +intros. +generalize (find_mapsto_iff m x)(mem_in_iff m x); unfold In. +destruct (find x m); destruct (mem x m); auto. +intros. +rewrite <- H0; exists e; rewrite H; auto. +intuition. +destruct H0 as (e,H0). +destruct (H e); intuition discriminate. +Qed. + +Variable elt elt' elt'' : Set. +Implicit Types m : t elt. +Implicit Types x y z : key. +Implicit Types e : elt. + +Lemma mem_b : forall m x y, E.eq x y -> mem x m = mem y m. +Proof. +intros. +generalize (mem_in_iff m x) (mem_in_iff m y)(In_iff m H). +destruct (mem x m); destruct (mem y m); intuition. +Qed. + +Lemma find_o : forall m x y, E.eq x y -> find x m = find y m. +Proof. +intros. +generalize (find_mapsto_iff m x) (find_mapsto_iff m y) (fun e => MapsTo_iff m e H). +destruct (find x m); destruct (find y m); intros. +rewrite <- H0; rewrite H2; rewrite H1; auto. +symmetry; rewrite <- H1; rewrite <- H2; rewrite H0; auto. +rewrite <- H0; rewrite H2; rewrite H1; auto. +auto. +Qed. + +Lemma empty_o : forall x, find x (empty elt) = None. +Proof. +intros. +case_eq (find x (empty elt)); intros; auto. +generalize (find_2 H). +rewrite empty_mapsto_iff; intuition. +Qed. + +Lemma empty_a : forall x, mem x (empty elt) = false. +Proof. +intros. +case_eq (mem x (empty elt)); intros; auto. +generalize (mem_2 H). +rewrite empty_in_iff; intuition. +Qed. + +Lemma add_eq_o : forall m x y e, + E.eq x y -> find y (add x e m) = Some e. +Proof. +auto. +Qed. + +Lemma add_neq_o : forall m x y e, + ~ E.eq x y -> find y (add x e m) = find y m. +Proof. +intros. +case_eq (find y m); intros; auto. +case_eq (find y (add x e m)); intros; auto. +rewrite <- H0; symmetry. +apply find_1; apply add_3 with x e; auto. +Qed. +Hint Resolve add_neq_o. + +Lemma add_o : forall m x y e, + find y (add x e m) = if eq_dec x y then Some e else find y m. +Proof. +intros; destruct (eq_dec x y); auto. +Qed. + +Lemma add_eq_b : forall m x y e, + E.eq x y -> mem y (add x e m) = true. +Proof. +intros; rewrite mem_find_b; rewrite add_eq_o; auto. +Qed. + +Lemma add_neq_b : forall m x y e, + ~E.eq x y -> mem y (add x e m) = mem y m. +Proof. +intros; do 2 rewrite mem_find_b; rewrite add_neq_o; auto. +Qed. + +Lemma add_b : forall m x y e, + mem y (add x e m) = eqb x y || mem y m. +Proof. +intros; do 2 rewrite mem_find_b; rewrite add_o; unfold eqb. +destruct (eq_dec x y); simpl; auto. +Qed. + +Lemma remove_eq_o : forall m x y, + E.eq x y -> find y (remove x m) = None. +Proof. +intros. +generalize (remove_1 (m:=m) H). +generalize (find_mapsto_iff (remove x m) y). +destruct (find y (remove x m)); auto. +destruct 2. +exists e; rewrite H0; auto. +Qed. +Hint Resolve remove_eq_o. + +Lemma remove_neq_o : forall m x y, + ~ E.eq x y -> find y (remove x m) = find y m. +Proof. +intros. +case_eq (find y m); intros; auto. +case_eq (find y (remove x m)); intros; auto. +rewrite <- H0; symmetry. +apply find_1; apply remove_3 with x; auto. +Qed. +Hint Resolve remove_neq_o. + +Lemma remove_o : forall m x y, + find y (remove x m) = if eq_dec x y then None else find y m. +Proof. +intros; destruct (eq_dec x y); auto. +Qed. + +Lemma remove_eq_b : forall m x y, + E.eq x y -> mem y (remove x m) = false. +Proof. +intros; rewrite mem_find_b; rewrite remove_eq_o; auto. +Qed. + +Lemma remove_neq_b : forall m x y, + ~ E.eq x y -> mem y (remove x m) = mem y m. +Proof. +intros; do 2 rewrite mem_find_b; rewrite remove_neq_o; auto. +Qed. + +Lemma remove_b : forall m x y, + mem y (remove x m) = negb (eqb x y) && mem y m. +Proof. +intros; do 2 rewrite mem_find_b; rewrite remove_o; unfold eqb. +destruct (eq_dec x y); auto. +Qed. + +Definition option_map (A:Set)(B:Set)(f:A->B)(o:option A) : option B := + match o with + | Some a => Some (f a) + | None => None + end. + +Lemma map_o : forall m x (f:elt->elt'), + find x (map f m) = option_map f (find x m). +Proof. +intros. +generalize (find_mapsto_iff (map f m) x) (find_mapsto_iff m x) + (fun b => map_mapsto_iff m x b f). +destruct (find x (map f m)); destruct (find x m); simpl; auto; intros. +rewrite <- H; rewrite H1; exists e0; rewrite H0; auto. +destruct (H e) as [_ H2]. +rewrite H1 in H2. +destruct H2 as (a,(_,H2)); auto. +rewrite H0 in H2; discriminate. +rewrite <- H; rewrite H1; exists e; rewrite H0; auto. +Qed. + +Lemma map_b : forall m x (f:elt->elt'), + mem x (map f m) = mem x m. +Proof. +intros; do 2 rewrite mem_find_b; rewrite map_o. +destruct (find x m); simpl; auto. +Qed. + +Lemma mapi_b : forall m x (f:key->elt->elt'), + mem x (mapi f m) = mem x m. +Proof. +intros. +generalize (mem_in_iff (mapi f m) x) (mem_in_iff m x) (mapi_in_iff m x f). +destruct (mem x (mapi f m)); destruct (mem x m); simpl; auto; intros. +symmetry; rewrite <- H0; rewrite <- H1; rewrite H; auto. +rewrite <- H; rewrite H1; rewrite H0; auto. +Qed. + +Lemma mapi_o : forall m x (f:key->elt->elt'), + (forall x y e, E.eq x y -> f x e = f y e) -> + find x (mapi f m) = option_map (f x) (find x m). +Proof. +intros. +generalize (find_mapsto_iff (mapi f m) x) (find_mapsto_iff m x) + (fun b => mapi_mapsto_iff m x b H). +destruct (find x (mapi f m)); destruct (find x m); simpl; auto; intros. +rewrite <- H0; rewrite H2; exists e0; rewrite H1; auto. +destruct (H0 e) as [_ H3]. +rewrite H2 in H3. +destruct H3 as (a,(_,H3)); auto. +rewrite H1 in H3; discriminate. +rewrite <- H0; rewrite H2; exists e; rewrite H1; auto. +Qed. + +Lemma map2_1bis : forall (m: t elt)(m': t elt') x + (f:option elt->option elt'->option elt''), + f None None = None -> + find x (map2 f m m') = f (find x m) (find x m'). +Proof. +intros. +case_eq (find x m); intros. +rewrite <- H0. +apply map2_1; auto. +left; exists e; auto. +case_eq (find x m'); intros. +rewrite <- H0; rewrite <- H1. +apply map2_1; auto. +right; exists e; auto. +rewrite H. +case_eq (find x (map2 f m m')); intros; auto. +assert (In x (map2 f m m')) by (exists e; auto). +destruct (map2_2 H3) as [(e0,H4)|(e0,H4)]. +rewrite (find_1 H4) in H0; discriminate. +rewrite (find_1 H4) in H1; discriminate. +Qed. + +Lemma elements_o : forall m x, + find x m = findA (eqb x) (elements m). +Proof. +intros. +assert (forall e, find x m = Some e <-> InA (eq_key_elt (elt:=elt)) (x,e) (elements m)). + intros; rewrite <- find_mapsto_iff; apply elements_mapsto_iff. +assert (NoDupA (eq_key (elt:=elt)) (elements m)). + apply SortA_NoDupA with (lt_key (elt:=elt)); unfold eq_key, lt_key; intuition eauto. + destruct y; simpl in *. + apply (E.lt_not_eq H0 H1). + exact (elements_3 m). +generalize (fun e => @findA_NoDupA _ _ _ E.eq_sym E.eq_trans eq_dec (elements m) x e H0). +unfold eqb. +destruct (find x m); destruct (findA (fun y : E.t => if eq_dec x y then true else false) (elements m)); + simpl; auto; intros. +symmetry; rewrite <- H1; rewrite <- H; auto. +symmetry; rewrite <- H1; rewrite <- H; auto. +rewrite H; rewrite H1; auto. +Qed. + +Lemma elements_b : forall m x, mem x m = existsb (fun p => eqb x (fst p)) (elements m). +Proof. +intros. +generalize (mem_in_iff m x)(elements_in_iff m x) + (existsb_exists (fun p => eqb x (fst p)) (elements m)). +destruct (mem x m); destruct (existsb (fun p => eqb x (fst p)) (elements m)); auto; intros. +symmetry; rewrite H1. +destruct H0 as (H0,_). +destruct H0 as (e,He); [ intuition |]. +rewrite InA_alt in He. +destruct He as ((y,e'),(Ha1,Ha2)). +compute in Ha1; destruct Ha1; subst e'. +exists (y,e); split; simpl; auto. +unfold eqb; destruct (eq_dec x y); intuition. +rewrite <- H; rewrite H0. +destruct H1 as (H1,_). +destruct H1 as ((y,e),(Ha1,Ha2)); [intuition|]. +simpl in Ha2. +unfold eqb in *; destruct (eq_dec x y); auto; try discriminate. +exists e; rewrite InA_alt. +exists (y,e); intuition. +compute; auto. +Qed. + +End BoolSpec. + +End Facts. diff --git a/theories/FSets/FMapIntMap.v b/theories/FSets/FMapIntMap.v new file mode 100644 index 00000000..c7681bd4 --- /dev/null +++ b/theories/FSets/FMapIntMap.v @@ -0,0 +1,622 @@ +(***********************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * INRIA-Rocquencourt & LRI-CNRS-Orsay *) +(* \VV/ *************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(***********************************************************************) + +(* Finite sets library. + * Authors: Pierre Letouzey and Jean-Christophe Filliâtre + * Institution: LRI, CNRS UMR 8623 - Université Paris Sud + * 91405 Orsay, France *) + +(* $Id: FMapIntMap.v 8876 2006-05-30 13:43:15Z letouzey $ *) + +Require Import Bool. +Require Import NArith Ndigits Ndec Nnat. +Require Import Allmaps. +Require Import OrderedType. +Require Import OrderedTypeEx. +Require Import FMapInterface FMapList. + + +Set Implicit Arguments. + +(** * An implementation of [FMapInterface.S] based on [IntMap] *) + +(** Keys are of type [N]. The main functions are directly taken from + [IntMap]. Since they have no exact counterpart in [IntMap], functions + [fold], [map2] and [equal] are for now obtained by translation + to sorted lists. *) + +(** [N] is an ordered type, using not the usual order on numbers, + but lexicographic ordering on bits (lower bit considered first). *) + +Module NUsualOrderedType <: UsualOrderedType. + Definition t:=N. + Definition eq:=@eq N. + Definition eq_refl := @refl_equal t. + Definition eq_sym := @sym_eq t. + Definition eq_trans := @trans_eq t. + + Definition lt p q:= Nless p q = true. + + Definition lt_trans := Nless_trans. + + Lemma lt_not_eq : forall x y : t, lt x y -> ~ eq x y. + Proof. + intros; intro. + rewrite H0 in H. + red in H. + rewrite Nless_not_refl in H; discriminate. + Qed. + + Definition compare : forall x y : t, Compare lt eq x y. + Proof. + intros x y. + destruct (Nless_total x y) as [[H|H]|H]. + apply LT; unfold lt; auto. + apply GT; unfold lt; auto. + apply EQ; auto. + Qed. + +End NUsualOrderedType. + + +(** The module of maps over [N] keys based on [IntMap] *) + +Module MapIntMap <: S with Module E:=NUsualOrderedType. + + Module E:=NUsualOrderedType. + Module ME:=OrderedTypeFacts(E). + Module PE:=KeyOrderedType(E). + + Definition key := N. + + Definition t := Map. + + Section A. + Variable A:Set. + + Definition empty : t A := M0 A. + + Definition is_empty (m : t A) : bool := + MapEmptyp _ (MapCanonicalize _ m). + + Definition find (x:key)(m: t A) : option A := MapGet _ m x. + + Definition mem (x:key)(m: t A) : bool := + match find x m with + | Some _ => true + | None => false + end. + + Definition add (x:key)(v:A)(m:t A) : t A := MapPut _ m x v. + + Definition remove (x:key)(m:t A) : t A := MapRemove _ m x. + + Definition elements (m : t A) : list (N*A) := alist_of_Map _ m. + + Definition MapsTo (x:key)(v:A)(m:t A) := find x m = Some v. + + Definition In (x:key)(m:t A) := exists e:A, MapsTo x e m. + + Definition Empty m := forall (a : key)(e:A) , ~ MapsTo a e m. + + Definition eq_key (p p':key*A) := E.eq (fst p) (fst p'). + + Definition eq_key_elt (p p':key*A) := + E.eq (fst p) (fst p') /\ (snd p) = (snd p'). + + Definition lt_key (p p':key*A) := E.lt (fst p) (fst p'). + + Lemma Empty_alt : forall m, Empty m <-> forall a, find a m = None. + Proof. + unfold Empty, MapsTo. + intuition. + generalize (H a). + destruct (find a m); intuition. + elim (H0 a0); auto. + rewrite H in H0; discriminate. + Qed. + + Section Spec. + Variable m m' m'' : t A. + Variable x y z : key. + Variable e e' : A. + + Lemma MapsTo_1 : E.eq x y -> MapsTo x e m -> MapsTo y e m. + Proof. intros; rewrite <- H; auto. Qed. + + Lemma find_1 : MapsTo x e m -> find x m = Some e. + Proof. unfold MapsTo; auto. Qed. + + Lemma find_2 : find x m = Some e -> MapsTo x e m. + Proof. red; auto. Qed. + + Lemma empty_1 : Empty empty. + Proof. + rewrite Empty_alt; intros; unfold empty, find; simpl; auto. + Qed. + + Lemma is_empty_1 : Empty m -> is_empty m = true. + Proof. + unfold Empty, is_empty, find; intros. + cut (MapCanonicalize _ m = M0 _). + intros; rewrite H0; simpl; auto. + apply mapcanon_unique. + apply mapcanon_exists_2. + constructor. + red; red; simpl; intros. + rewrite <- (mapcanon_exists_1 _ m). + unfold MapsTo, find in *. + generalize (H a). + destruct (MapGet _ m a); auto. + intros; generalize (H0 a0); destruct 1; auto. + Qed. + + Lemma is_empty_2 : is_empty m = true -> Empty m. + Proof. + unfold Empty, is_empty, MapsTo, find; intros. + generalize (MapEmptyp_complete _ _ H); clear H; intros. + rewrite (mapcanon_exists_1 _ m). + rewrite H; simpl; auto. + discriminate. + Qed. + + Lemma mem_1 : In x m -> mem x m = true. + Proof. + unfold In, MapsTo, mem. + destruct (find x m); auto. + destruct 1; discriminate. + Qed. + + Lemma mem_2 : forall m x, mem x m = true -> In x m. + Proof. + unfold In, MapsTo, mem. + intros. + destruct (find x0 m0); auto; try discriminate. + exists a; auto. + Qed. + + Lemma add_1 : E.eq x y -> MapsTo y e (add x e m). + Proof. + unfold MapsTo, find, add. + intro H; rewrite H; clear H. + rewrite MapPut_semantics. + rewrite Neqb_correct; auto. + Qed. + + Lemma add_2 : ~ E.eq x y -> MapsTo y e m -> MapsTo y e (add x e' m). + Proof. + unfold MapsTo, find, add. + intros. + rewrite MapPut_semantics. + rewrite H0. + generalize (Neqb_complete x y). + destruct (Neqb x y); auto. + intros. + elim H; auto. + apply H1; auto. + Qed. + + Lemma add_3 : ~ E.eq x y -> MapsTo y e (add x e' m) -> MapsTo y e m. + Proof. + unfold MapsTo, find, add. + rewrite MapPut_semantics. + intro H. + generalize (Neqb_complete x y). + destruct (Neqb x y); auto. + intros; elim H; auto. + apply H0; auto. + Qed. + + Lemma remove_1 : E.eq x y -> ~ In y (remove x m). + Proof. + unfold In, MapsTo, find, remove. + rewrite MapRemove_semantics. + intro H. + rewrite H; rewrite Neqb_correct. + red; destruct 1; discriminate. + Qed. + + Lemma remove_2 : ~ E.eq x y -> MapsTo y e m -> MapsTo y e (remove x m). + Proof. + unfold MapsTo, find, remove. + rewrite MapRemove_semantics. + intros. + rewrite H0. + generalize (Neqb_complete x y). + destruct (Neqb x y); auto. + intros; elim H; apply H1; auto. + Qed. + + Lemma remove_3 : MapsTo y e (remove x m) -> MapsTo y e m. + Proof. + unfold MapsTo, find, remove. + rewrite MapRemove_semantics. + destruct (Neqb x y); intros; auto. + discriminate. + Qed. + + Lemma alist_sorted_sort : forall l, alist_sorted A l=true -> sort lt_key l. + Proof. + induction l. + auto. + simpl. + destruct a. + destruct l. + auto. + destruct p. + intros; destruct (andb_prop _ _ H); auto. + Qed. + + Lemma elements_3 : sort lt_key (elements m). + Proof. + unfold elements. + apply alist_sorted_sort. + apply alist_of_Map_sorts. + Qed. + + Lemma elements_1 : + MapsTo x e m -> InA eq_key_elt (x,e) (elements m). + Proof. + unfold MapsTo, find, elements. + rewrite InA_alt. + intro H. + exists (x,e). + split. + red; simpl; unfold E.eq; auto. + rewrite alist_of_Map_semantics in H. + generalize H. + set (l:=alist_of_Map A m); clearbody l; clear. + induction l; simpl; auto. + intro; discriminate. + destruct a; simpl; auto. + generalize (Neqb_complete a x). + destruct (Neqb a x); auto. + left. + injection H0; auto. + intros; f_equal; auto. + Qed. + + Lemma elements_2 : + InA eq_key_elt (x,e) (elements m) -> MapsTo x e m. + Proof. + generalize elements_3. + unfold MapsTo, find, elements. + rewrite InA_alt. + intros H ((e0,a),(H0,H1)). + red in H0; simpl in H0; unfold E.eq in H0; destruct H0; subst. + rewrite alist_of_Map_semantics. + generalize H H1; clear H H1. + set (l:=alist_of_Map A m); clearbody l; clear. + induction l; simpl; auto. + intro; contradiction. + intros. + destruct a0; simpl. + inversion H1. + injection H0; intros; subst. + rewrite Neqb_correct; auto. + assert (InA eq_key (e0,a) l). + rewrite InA_alt. + exists (e0,a); split; auto. + red; simpl; auto; red; auto. + generalize (PE.Sort_In_cons_1 H H2). + unfold PE.ltk; simpl. + intros H3; generalize (E.lt_not_eq H3). + generalize (Neqb_complete a0 e0). + destruct (Neqb a0 e0); auto. + destruct 2. + apply H4; auto. + inversion H; auto. + Qed. + + Definition Equal cmp m m' := + (forall k, In k m <-> In k m') /\ + (forall k e e', MapsTo k e m -> MapsTo k e' m' -> cmp e e' = true). + + (** unfortunately, the [MapFold] of [IntMap] isn't compatible with + the FMap interface. We use a naive version for now : *) + + Definition fold (B:Set)(f:key -> A -> B -> B)(m:t A)(i:B) : B := + fold_left (fun a p => f (fst p) (snd p) a) (elements m) i. + + Lemma fold_1 : + forall (B:Set) (i : B) (f : key -> A -> B -> B), + fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (elements m) i. + Proof. auto. Qed. + + End Spec. + + Variable B : Set. + + Fixpoint mapi_aux (pf:N->N)(f : N -> A -> B)(m:t A) { struct m }: t B := + match m with + | M0 => M0 _ + | M1 x y => M1 _ x (f (pf x) y) + | M2 m0 m1 => M2 _ (mapi_aux (fun n => pf (Ndouble n)) f m0) + (mapi_aux (fun n => pf (Ndouble_plus_one n)) f m1) + end. + + Definition mapi := mapi_aux (fun n => n). + + Definition map (f:A->B) := mapi (fun _ => f). + + End A. + + Lemma mapi_aux_1 : forall (elt elt':Set)(m: t elt)(pf:N->N)(x:key)(e:elt) + (f:key->elt->elt'), MapsTo x e m -> + exists y, E.eq y x /\ MapsTo x (f (pf y) e) (mapi_aux pf f m). + Proof. + unfold MapsTo; induction m; simpl; auto. + inversion 1. + + intros. + exists x; split; [red; auto|]. + generalize (Neqb_complete a x). + destruct (Neqb a x); try discriminate. + injection H; intros; subst; auto. + rewrite H1; auto. + + intros. + exists x; split; [red;auto|]. + destruct x; simpl in *. + destruct (IHm1 (fun n : N => pf (Ndouble n)) _ _ f H) as (y,(Hy,Hy')). + rewrite Hy in Hy'; simpl in Hy'; auto. + destruct p; simpl in *. + destruct (IHm2 (fun n : N => pf (Ndouble_plus_one n)) _ _ f H) as (y,(Hy,Hy')). + rewrite Hy in Hy'; simpl in Hy'; auto. + destruct (IHm1 (fun n : N => pf (Ndouble n)) _ _ f H) as (y,(Hy,Hy')). + rewrite Hy in Hy'; simpl in Hy'; auto. + destruct (IHm2 (fun n : N => pf (Ndouble_plus_one n)) _ _ f H) as (y,(Hy,Hy')). + rewrite Hy in Hy'; simpl in Hy'; auto. + Qed. + + Lemma mapi_1 : forall (elt elt':Set)(m: t elt)(x:key)(e:elt) + (f:key->elt->elt'), MapsTo x e m -> + exists y, E.eq y x /\ MapsTo x (f y e) (mapi f m). + Proof. + intros elt elt' m; exact (mapi_aux_1 (fun n => n)). + Qed. + + Lemma mapi_aux_2 : forall (elt elt':Set)(m: t elt)(pf:N->N)(x:key) + (f:key->elt->elt'), In x (mapi_aux pf f m) -> In x m. + Proof. + unfold In, MapsTo. + induction m; simpl in *. + intros pf x f (e,He); inversion He. + intros pf x f (e,He). + exists a0. + destruct (Neqb a x); try discriminate; auto. + intros pf x f (e,He). + destruct x; [|destruct p]; eauto. + Qed. + + Lemma mapi_2 : forall (elt elt':Set)(m: t elt)(x:key) + (f:key->elt->elt'), In x (mapi f m) -> In x m. + Proof. + intros elt elt' m; exact (mapi_aux_2 m (fun n => n)). + Qed. + + Lemma map_1 : forall (elt elt':Set)(m: t elt)(x:key)(e:elt)(f:elt->elt'), + MapsTo x e m -> MapsTo x (f e) (map f m). + Proof. + unfold map; intros. + destruct (@mapi_1 _ _ m x e (fun _ => f)) as (e',(_,H0)); auto. + Qed. + + Lemma map_2 : forall (elt elt':Set)(m: t elt)(x:key)(f:elt->elt'), + In x (map f m) -> In x m. + Proof. + unfold map; intros. + eapply mapi_2; eauto. + Qed. + + Module L := FMapList.Raw E. + + (** Not exactly pretty nor perfect, but should suffice as a first naive implem. + Anyway, map2 isn't in Ocaml... + *) + + Definition anti_elements (A:Set)(l:list (key*A)) := L.fold (@add _) l (empty _). + + Definition map2 (A B C:Set)(f:option A->option B -> option C)(m:t A)(m':t B) : t C := + anti_elements (L.map2 f (elements m) (elements m')). + + Lemma add_spec : forall (A:Set)(m:t A) x y e, + find x (add y e m) = if ME.eq_dec x y then Some e else find x m. + Proof. + intros. + destruct (ME.eq_dec x y). + apply find_1. + eapply MapsTo_1 with y; eauto. + red; auto. + apply add_1; auto. + red; auto. + case_eq (find x m); intros. + apply find_1. + apply add_2; unfold E.eq in *; auto. + case_eq (find x (add y e m)); auto; intros. + rewrite <- H; symmetry. + apply find_1; auto. + apply (@add_3 _ m y x a e); unfold E.eq in *; auto. + Qed. + + Lemma anti_elements_mapsto_aux : forall (A:Set)(l:list (key*A)) m k e, + NoDupA (eq_key (A:=A)) l -> + (forall x, L.PX.In x l -> In x m -> False) -> + (MapsTo k e (L.fold (@add _) l m) <-> L.PX.MapsTo k e l \/ MapsTo k e m). + Proof. + induction l. + simpl; auto. + intuition. + inversion H2. + simpl; destruct a; intros. + rewrite IHl; clear IHl. + inversion H; auto. + intros. + inversion_clear H. + assert (~E.eq x k). + swap H3. + destruct H1. + apply InA_eqA with (x,x0); eauto. + unfold eq_key, E.eq; eauto. + unfold eq_key, E.eq; congruence. + apply (H0 x). + destruct H1; exists x0; auto. + revert H2. + unfold In. + intros (e',He'). + exists e'; apply (@add_3 _ m k x e' a); unfold E.eq; auto. + intuition. + red in H2. + rewrite add_spec in H2; auto. + destruct (ME.eq_dec k0 k). + inversion_clear H2; subst; auto. + right; apply find_2; auto. + inversion_clear H2; auto. + compute in H1; destruct H1. + subst; right; apply add_1; auto. + red; auto. + inversion_clear H. + destruct (ME.eq_dec k0 k). + unfold E.eq in *; subst. + destruct (H0 k); eauto. + red; eauto. + right; apply add_2; unfold E.eq in *; auto. + Qed. + + Lemma anti_elements_mapsto : forall (A:Set) l k e, NoDupA (eq_key (A:=A)) l -> + (MapsTo k e (anti_elements l) <-> L.PX.MapsTo k e l). + Proof. + intros. + unfold anti_elements. + rewrite anti_elements_mapsto_aux; auto; unfold empty; auto. + inversion 2. + inversion H2. + intuition. + inversion H1. + Qed. + + Lemma find_anti_elements : forall (A:Set)(l: list (key*A)) x, sort (@lt_key _) l -> + find x (anti_elements l) = L.find x l. + Proof. + intros. + case_eq (L.find x l); intros. + apply find_1. + rewrite anti_elements_mapsto. + apply L.PX.Sort_NoDupA; auto. + apply L.find_2; auto. + case_eq (find x (anti_elements l)); auto; intros. + rewrite <- H0; symmetry. + apply L.find_1; auto. + rewrite <- anti_elements_mapsto. + apply L.PX.Sort_NoDupA; auto. + apply find_2; auto. + Qed. + + Lemma find_elements : forall (A:Set)(m: t A) x, + L.find x (elements m) = find x m. + Proof. + intros. + case_eq (find x m); intros. + apply L.find_1. + apply elements_3; auto. + red; apply elements_1. + apply find_2; auto. + case_eq (L.find x (elements m)); auto; intros. + rewrite <- H; symmetry. + apply find_1; auto. + apply elements_2. + apply L.find_2; auto. + Qed. + + Lemma elements_in : forall (A:Set)(s:t A) x, L.PX.In x (elements s) <-> In x s. + Proof. + intros. + unfold L.PX.In, In. + firstorder. + exists x0. + red; rewrite <- find_elements; auto. + apply L.find_1; auto. + apply elements_3. + exists x0. + apply L.find_2. + rewrite find_elements; auto. + Qed. + + Lemma map2_1 : forall (A B C:Set)(m: t A)(m': t B)(x:key) + (f:option A->option B ->option C), + In x m \/ In x m' -> find x (map2 f m m') = f (find x m) (find x m'). + Proof. + unfold map2; intros. + rewrite find_anti_elements; auto. + rewrite <- find_elements; auto. + rewrite <- find_elements; auto. + apply L.map2_1; auto. + apply elements_3; auto. + apply elements_3; auto. + do 2 rewrite elements_in; auto. + apply L.map2_sorted; auto. + apply elements_3; auto. + apply elements_3; auto. + Qed. + + Lemma map2_2 : forall (A B C: Set)(m: t A)(m': t B)(x:key) + (f:option A->option B ->option C), + In x (map2 f m m') -> In x m \/ In x m'. + Proof. + unfold map2; intros. + do 2 rewrite <- elements_in. + apply L.map2_2 with (f:=f); auto. + apply elements_3; auto. + apply elements_3; auto. + destruct H. + exists x0. + rewrite <- anti_elements_mapsto; auto. + apply L.PX.Sort_NoDupA; auto. + apply L.map2_sorted; auto. + apply elements_3; auto. + apply elements_3; auto. + Qed. + + (** same trick for [equal] *) + + Definition equal (A:Set)(cmp:A -> A -> bool)(m m' : t A) : bool := + L.equal cmp (elements m) (elements m'). + + Lemma equal_1 : + forall (A:Set)(m: t A)(m': t A)(cmp: A -> A -> bool), + Equal cmp m m' -> equal cmp m m' = true. + Proof. + unfold equal, Equal. + intros. + apply L.equal_1. + apply elements_3. + apply elements_3. + unfold L.Equal. + destruct H. + split; intros. + do 2 rewrite elements_in; auto. + apply (H0 k); + red; rewrite <- find_elements; apply L.find_1; auto; + apply elements_3. + Qed. + + Lemma equal_2 : + forall (A:Set)(m: t A)(m': t A)(cmp: A -> A -> bool), + equal cmp m m' = true -> Equal cmp m m'. + Proof. + unfold equal, Equal. + intros. + destruct (L.equal_2 (elements_3 m) (elements_3 m') H); clear H. + split. + intros; do 2 rewrite <- elements_in; auto. + intros; apply (H1 k); + apply L.find_2; rewrite find_elements;auto. + Qed. + +End MapIntMap. + diff --git a/theories/FSets/FMapList.v b/theories/FSets/FMapList.v index 2d083d5b..c671ba82 100644 --- a/theories/FSets/FMapList.v +++ b/theories/FSets/FMapList.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -(* $Id: FMapList.v 8667 2006-03-28 11:59:44Z letouzey $ *) +(* $Id: FMapList.v 8899 2006-06-06 11:09:43Z jforest $ *) (** * Finite map library *) @@ -26,7 +26,7 @@ Module Raw (X:OrderedType). Module E := X. Module MX := OrderedTypeFacts X. -Module PX := PairOrderedType X. +Module PX := KeyOrderedType X. Import MX. Import PX. @@ -36,7 +36,7 @@ Definition t (elt:Set) := list (X.t * elt). Section Elt. Variable elt : Set. -(* Now in PairOrderedtype: +(* Now in KeyOrderedType: Definition eqk (p p':key*elt) := X.eq (fst p) (fst p'). Definition eqke (p p':key*elt) := X.eq (fst p) (fst p') /\ (snd p) = (snd p'). @@ -96,7 +96,7 @@ Qed. (** * [mem] *) -Fixpoint mem (k : key) (s : t elt) {struct s} : bool := +Function mem (k : key) (s : t elt) {struct s} : bool := match s with | nil => false | (k',_) :: l => @@ -110,33 +110,33 @@ Fixpoint mem (k : key) (s : t elt) {struct s} : bool := Lemma mem_1 : forall m (Hm:Sort m) x, In x m -> mem x m = true. Proof. intros m Hm x; generalize Hm; clear Hm. - functional induction mem x m;intros sorted belong1;trivial. + functional induction (mem x m);intros sorted belong1;trivial. inversion belong1. inversion H. - absurd (In k ((k', e) :: l));try assumption. - apply Sort_Inf_NotIn with e;auto. + absurd (In x ((k', _x) :: l));try assumption. + apply Sort_Inf_NotIn with _x;auto. - apply H. + apply IHb. elim (sort_inv sorted);auto. elim (In_inv belong1);auto. intro abs. - absurd (X.eq k k');auto. + absurd (X.eq x k');auto. Qed. Lemma mem_2 : forall m (Hm:Sort m) x, mem x m = true -> In x m. Proof. intros m Hm x; generalize Hm; clear Hm; unfold PX.In,PX.MapsTo. - functional induction mem x m; intros sorted hyp;try ((inversion hyp);fail). - exists e; auto. - induction H; auto. - exists x; auto. + functional induction (mem x m); intros sorted hyp;try ((inversion hyp);fail). + exists _x; auto. + induction IHb; auto. + exists x0; auto. inversion_clear sorted; auto. Qed. (** * [find] *) -Fixpoint find (k:key) (s: t elt) {struct s} : option elt := +Function find (k:key) (s: t elt) {struct s} : option elt := match s with | nil => None | (k',x)::s' => @@ -150,31 +150,31 @@ Fixpoint find (k:key) (s: t elt) {struct s} : option elt := Lemma find_2 : forall m x e, find x m = Some e -> MapsTo x e m. Proof. intros m x. unfold PX.MapsTo. - functional induction find x m;simpl;intros e' eqfind; inversion eqfind; auto. + functional induction (find x m);simpl;intros e' eqfind; inversion eqfind; auto. Qed. Lemma find_1 : forall m (Hm:Sort m) x e, MapsTo x e m -> find x m = Some e. Proof. intros m Hm x e; generalize Hm; clear Hm; unfold PX.MapsTo. - functional induction find x m;simpl; subst; try clear H_eq_1. + functional induction (find x m);simpl; subst; try clear H_eq_1. inversion 2. inversion_clear 2. - compute in H0; destruct H0; order. - generalize (Sort_In_cons_1 Hm (InA_eqke_eqk H0)); compute; order. + clear H0;compute in H1; destruct H1;order. + clear H0;generalize (Sort_In_cons_1 Hm (InA_eqke_eqk H1)); compute; order. - inversion_clear 2. + clear H0;inversion_clear 2. compute in H0; destruct H0; intuition congruence. generalize (Sort_In_cons_1 Hm (InA_eqke_eqk H0)); compute; order. - do 2 inversion_clear 1; auto. - compute in H3; destruct H3; order. + clear H0; do 2 inversion_clear 1; auto. + compute in H2; destruct H2; order. Qed. (** * [add] *) -Fixpoint add (k : key) (x : elt) (s : t elt) {struct s} : t elt := +Function add (k : key) (x : elt) (s : t elt) {struct s} : t elt := match s with | nil => (k,x) :: nil | (k',y) :: l => @@ -189,7 +189,7 @@ Lemma add_1 : forall m x y e, X.eq x y -> MapsTo y e (add x e m). Proof. intros m x y e; generalize y; clear y. unfold PX.MapsTo. - functional induction add x e m;simpl;auto. + functional induction (add x e m);simpl;auto. Qed. Lemma add_2 : forall m x y e e', @@ -197,25 +197,29 @@ Lemma add_2 : forall m x y e e', Proof. intros m x y e e'. generalize y e; clear y e; unfold PX.MapsTo. - functional induction add x e' m;simpl;auto; clear H_eq_1. - intros y' e' eqky'; inversion_clear 1; destruct H0; simpl in *. + functional induction (add x e' m) ;simpl;auto; clear H0. + subst;auto. + + intros y' e'' eqky'; inversion_clear 1; destruct H0; simpl in *. order. auto. auto. - intros y' e' eqky'; inversion_clear 1; intuition. + intros y' e'' eqky'; inversion_clear 1; intuition. Qed. + Lemma add_3 : forall m x y e e', ~ X.eq x y -> MapsTo y e (add x e' m) -> MapsTo y e m. Proof. intros m x y e e'. generalize y e; clear y e; unfold PX.MapsTo. - functional induction add x e' m;simpl; intros. - apply (In_inv_3 H0); compute; auto. + functional induction (add x e' m);simpl; intros. apply (In_inv_3 H0); compute; auto. - constructor 2; apply (In_inv_3 H0); compute; auto. + apply (In_inv_3 H1); compute; auto. + constructor 2; apply (In_inv_3 H1); compute; auto. inversion_clear H1; auto. Qed. + Lemma add_Inf : forall (m:t elt)(x x':key)(e e':elt), Inf (x',e') m -> ltk (x',e') (x,e) -> Inf (x',e') (add x e m). Proof. @@ -242,7 +246,7 @@ Qed. (** * [remove] *) -Fixpoint remove (k : key) (s : t elt) {struct s} : t elt := +Function remove (k : key) (s : t elt) {struct s} : t elt := match s with | nil => nil | (k',x) :: l => @@ -256,30 +260,36 @@ Fixpoint remove (k : key) (s : t elt) {struct s} : t elt := Lemma remove_1 : forall m (Hm:Sort m) x y, X.eq x y -> ~ In y (remove x m). Proof. intros m Hm x y; generalize Hm; clear Hm. - functional induction remove x m;simpl;intros;subst;try clear H_eq_1. + functional induction (remove x m);simpl;intros;subst. red; inversion 1; inversion H1. - apply Sort_Inf_NotIn with x; auto. - constructor; compute; order. + apply Sort_Inf_NotIn with x0; auto. + clear H0;constructor; compute; order. - inversion_clear Hm. - apply Sort_Inf_NotIn with x; auto. - apply Inf_eq with (k',x);auto; compute; apply X.eq_trans with k; auto. + clear H0;inversion_clear Hm. + apply Sort_Inf_NotIn with x0; auto. + apply Inf_eq with (k',x0);auto; compute; apply X.eq_trans with x; auto. - inversion_clear Hm. - assert (notin:~ In y (remove k l)) by auto. - intros (x0,abs). + clear H0;inversion_clear Hm. + assert (notin:~ In y (remove x l)) by auto. + intros (x1,abs). inversion_clear abs. - compute in H3; destruct H3; order. - apply notin; exists x0; auto. + compute in H2; destruct H2; order. + apply notin; exists x1; auto. Qed. + Lemma remove_2 : forall m (Hm:Sort m) x y e, ~ X.eq x y -> MapsTo y e m -> MapsTo y e (remove x m). Proof. intros m Hm x y e; generalize Hm; clear Hm; unfold PX.MapsTo. - functional induction remove x m;auto; try clear H_eq_1. + functional induction (remove x m);subst;auto; + match goal with + | [H: X.compare _ _ = _ |- _ ] => clear H + | _ => idtac + end. + inversion_clear 3; auto. compute in H1; destruct H1; order. @@ -290,7 +300,7 @@ Lemma remove_3 : forall m (Hm:Sort m) x y e, MapsTo y e (remove x m) -> MapsTo y e m. Proof. intros m Hm x y e; generalize Hm; clear Hm; unfold PX.MapsTo. - functional induction remove x m;auto. + functional induction (remove x m);subst;auto. inversion_clear 1; inversion_clear 1; auto. Qed. @@ -341,8 +351,7 @@ Qed. (** * [fold] *) -Fixpoint fold (A:Set)(f:key->elt->A->A)(m:t elt) {struct m} : A -> A := - fun acc => +Function fold (A:Set)(f:key->elt->A->A)(m:t elt) (acc:A) {struct m} : A := match m with | nil => acc | (k,e)::m' => fold f m' (f k e acc) @@ -351,12 +360,12 @@ Fixpoint fold (A:Set)(f:key->elt->A->A)(m:t elt) {struct m} : A -> A := Lemma fold_1 : forall m (A:Set)(i:A)(f:key->elt->A->A), fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (elements m) i. Proof. - intros; functional induction fold A f m i; auto. + intros; functional induction (fold f m i); auto. Qed. (** * [equal] *) -Fixpoint equal (cmp:elt->elt->bool)(m m' : t elt) { struct m } : bool := +Function equal (cmp:elt->elt->bool)(m m' : t elt) { struct m } : bool := match m, m' with | nil, nil => true | (x,e)::l, (x',e')::l' => @@ -375,56 +384,52 @@ Lemma equal_1 : forall m (Hm:Sort m) m' (Hm': Sort m') cmp, Equal cmp m m' -> equal cmp m m' = true. Proof. intros m Hm m' Hm' cmp; generalize Hm Hm'; clear Hm Hm'. - functional induction equal cmp m m'; simpl; auto; unfold Equal; - intuition; subst; try clear H_eq_3. + functional induction (equal cmp m m'); simpl; subst;auto; unfold Equal; + intuition; subst; match goal with + | [H: X.compare _ _ = _ |- _ ] => clear H + | _ => idtac + end. - destruct p as (k,e). - destruct (H0 k). - destruct H2. - exists e; auto. - inversion H2. - destruct (H0 x). - destruct H. - exists e; auto. - inversion H. - destruct (H0 x). - assert (In x ((x',e')::l')). - apply H; auto. - exists e; auto. - destruct (In_inv H3). - order. - inversion_clear Hm'. - assert (Inf (x,e) l'). - apply Inf_lt with (x',e'); auto. - elim (Sort_Inf_NotIn H5 H7 H4). - - assert (cmp e e' = true). + assert (cmp_e_e':cmp e e' = true). apply H2 with x; auto. - rewrite H0; simpl. - apply H; auto. + rewrite cmp_e_e'; simpl. + apply IHb; auto. inversion_clear Hm; auto. inversion_clear Hm'; auto. unfold Equal; intuition. - destruct (H1 k). + destruct (H0 k). assert (In k ((x,e) ::l)). - destruct H3 as (e'', hyp); exists e''; auto. - destruct (In_inv (H4 H6)); auto. + destruct H as (e'', hyp); exists e''; auto. + destruct (In_inv (H1 H4)); auto. inversion_clear Hm. - elim (Sort_Inf_NotIn H8 H9). - destruct H3 as (e'', hyp); exists e''; auto. + elim (Sort_Inf_NotIn H6 H7). + destruct H as (e'', hyp); exists e''; auto. apply MapsTo_eq with k; auto; order. - destruct (H1 k). + destruct (H0 k). assert (In k ((x',e') ::l')). - destruct H3 as (e'', hyp); exists e''; auto. - destruct (In_inv (H5 H6)); auto. + destruct H as (e'', hyp); exists e''; auto. + destruct (In_inv (H3 H4)); auto. inversion_clear Hm'. - elim (Sort_Inf_NotIn H8 H9). - destruct H3 as (e'', hyp); exists e''; auto. + elim (Sort_Inf_NotIn H6 H7). + destruct H as (e'', hyp); exists e''; auto. apply MapsTo_eq with k; auto; order. apply H2 with k; destruct (eq_dec x k); auto. + + destruct (X.compare x x'); try contradiction;clear H2. + destruct (H0 x). + assert (In x ((x',e')::l')). + apply H; auto. + exists e; auto. + destruct (In_inv H3). + order. + inversion_clear Hm'. + assert (Inf (x,e) l'). + apply Inf_lt with (x',e'); auto. + elim (Sort_Inf_NotIn H5 H7 H4). + destruct (H0 x'). assert (In x' ((x,e)::l)). apply H2; auto. @@ -435,43 +440,70 @@ Proof. assert (Inf (x',e') l). apply Inf_lt with (x,e); auto. elim (Sort_Inf_NotIn H5 H7 H4). + + destruct m; + destruct m';try contradiction. + + clear H1;destruct p as (k,e). + destruct (H0 k). + destruct H1. + exists e; auto. + inversion H1. + + destruct p as (x,e). + destruct (H0 x). + destruct H. + exists e; auto. + inversion H. + + destruct p;destruct p0;contradiction. Qed. + Lemma equal_2 : forall m (Hm:Sort m) m' (Hm:Sort m') cmp, equal cmp m m' = true -> Equal cmp m m'. Proof. intros m Hm m' Hm' cmp; generalize Hm Hm'; clear Hm Hm'. - functional induction equal cmp m m'; simpl; auto; unfold Equal; - intuition; try discriminate; subst; try clear H_eq_3; - try solve [inversion H0]; destruct (andb_prop _ _ H0); clear H0; - inversion_clear Hm; inversion_clear Hm'. - - destruct (H H0 H5 H3). - destruct (In_inv H1). + functional induction (equal cmp m m'); simpl; subst;auto; unfold Equal; + intuition; try discriminate; subst; match goal with + | [H: X.compare _ _ = _ |- _ ] => clear H + | _ => idtac + end. + + inversion H0. + + inversion_clear Hm;inversion_clear Hm'. + destruct (andb_prop _ _ H); clear H. + destruct (IHb H1 H3 H6). + destruct (In_inv H0). exists e'; constructor; split; trivial; apply X.eq_trans with x; auto. - destruct (H7 k). - destruct (H10 H9) as (e'',hyp). + destruct (H k). + destruct (H9 H8) as (e'',hyp). exists e''; auto. - destruct (H H0 H5 H3). - destruct (In_inv H1). + inversion_clear Hm;inversion_clear Hm'. + destruct (andb_prop _ _ H); clear H. + destruct (IHb H1 H3 H6). + destruct (In_inv H0). exists e; constructor; split; trivial; apply X.eq_trans with x'; auto. - destruct (H7 k). - destruct (H11 H9) as (e'',hyp). + destruct (H k). + destruct (H10 H8) as (e'',hyp). exists e''; auto. - destruct (H H0 H6 H4). - inversion_clear H1. - destruct H10; simpl in *; subst. + inversion_clear Hm;inversion_clear Hm'. + destruct (andb_prop _ _ H); clear H. + destruct (IHb H1 H4 H7). + inversion_clear H0. + destruct H9; simpl in *; subst. inversion_clear H2. - destruct H10; simpl in *; subst; auto. - elim (Sort_Inf_NotIn H6 H7). + destruct H9; simpl in *; subst; auto. + elim (Sort_Inf_NotIn H4 H5). exists e'0; apply MapsTo_eq with k; auto; order. inversion_clear H2. - destruct H1; simpl in *; subst; auto. - elim (Sort_Inf_NotIn H0 H5). - exists e1; apply MapsTo_eq with k; auto; order. - apply H9 with k; auto. + destruct H0; simpl in *; subst; auto. + elim (Sort_Inf_NotIn H1 H3). + exists e0; apply MapsTo_eq with k; auto; order. + apply H8 with k; auto. Qed. (** This lemma isn't part of the spec of [Equal], but is used in [FMapAVL] *) @@ -791,7 +823,7 @@ Proof. exact (combine_lelistA _ H0 H1). inversion_clear Hm; inversion_clear Hm'. constructor; auto. - assert (lelistA (ltk (elt:=elt')) (k, e') m') by apply Inf_eq with (k',e'); auto. + assert (lelistA (ltk (elt:=elt')) (k, e') m') by (apply Inf_eq with (k',e'); auto). exact (combine_lelistA _ H0 H3). inversion_clear Hm; inversion_clear Hm'. constructor; auto. @@ -1006,84 +1038,126 @@ Module Make (X: OrderedType) <: S with Module E := X. Module Raw := Raw X. Module E := X. -Definition key := X.t. +Definition key := E.t. Record slist (elt:Set) : Set := {this :> Raw.t elt; sorted : sort (@Raw.PX.ltk elt) this}. -Definition t (elt:Set) := slist elt. +Definition t (elt:Set) : Set := slist elt. Section Elt. Variable elt elt' elt'':Set. Implicit Types m : t elt. - - Definition empty := Build_slist (Raw.empty_sorted elt). - Definition is_empty m := Raw.is_empty m.(this). - Definition add x e m := Build_slist (Raw.add_sorted m.(sorted) x e). - Definition find x m := Raw.find x m.(this). - Definition remove x m := Build_slist (Raw.remove_sorted m.(sorted) x). - Definition mem x m := Raw.mem x m.(this). + Implicit Types x y : key. + Implicit Types e : elt. + + Definition empty : t elt := Build_slist (Raw.empty_sorted elt). + Definition is_empty m : bool := Raw.is_empty m.(this). + Definition add x e m : t elt := Build_slist (Raw.add_sorted m.(sorted) x e). + Definition find x m : option elt := Raw.find x m.(this). + Definition remove x m : t elt := Build_slist (Raw.remove_sorted m.(sorted) x). + Definition mem x m : bool := Raw.mem x m.(this). Definition map f m : t elt' := Build_slist (Raw.map_sorted m.(sorted) f). - Definition mapi f m : t elt' := Build_slist (Raw.mapi_sorted m.(sorted) f). + Definition mapi (f:key->elt->elt') m : t elt' := Build_slist (Raw.mapi_sorted m.(sorted) f). Definition map2 f m (m':t elt') : t elt'' := - Build_slist (Raw.map2_sorted f m.(sorted) m'.(sorted)). - Definition elements m := @Raw.elements elt m.(this). - Definition fold A f m i := @Raw.fold elt A f m.(this) i. - Definition equal cmp m m' := @Raw.equal elt cmp m.(this) m'.(this). - - Definition MapsTo x e m := Raw.PX.MapsTo x e m.(this). - Definition In x m := Raw.PX.In x m.(this). - Definition Empty m := Raw.Empty m.(this). - Definition Equal cmp m m' := @Raw.Equal elt cmp m.(this) m'.(this). - - Definition eq_key := Raw.PX.eqk. - Definition eq_key_elt := Raw.PX.eqke. - Definition lt_key := Raw.PX.ltk. - - Definition MapsTo_1 m := @Raw.PX.MapsTo_eq elt m.(this). - - Definition mem_1 m := @Raw.mem_1 elt m.(this) m.(sorted). - Definition mem_2 m := @Raw.mem_2 elt m.(this) m.(sorted). - - Definition empty_1 := @Raw.empty_1. - - Definition is_empty_1 m := @Raw.is_empty_1 elt m.(this). - Definition is_empty_2 m := @Raw.is_empty_2 elt m.(this). - - Definition add_1 m := @Raw.add_1 elt m.(this). - Definition add_2 m := @Raw.add_2 elt m.(this). - Definition add_3 m := @Raw.add_3 elt m.(this). - - Definition remove_1 m := @Raw.remove_1 elt m.(this) m.(sorted). - Definition remove_2 m := @Raw.remove_2 elt m.(this) m.(sorted). - Definition remove_3 m := @Raw.remove_3 elt m.(this) m.(sorted). - - Definition find_1 m := @Raw.find_1 elt m.(this) m.(sorted). - Definition find_2 m := @Raw.find_2 elt m.(this). - - Definition elements_1 m := @Raw.elements_1 elt m.(this). - Definition elements_2 m := @Raw.elements_2 elt m.(this). - Definition elements_3 m := @Raw.elements_3 elt m.(this) m.(sorted). - - Definition fold_1 m := @Raw.fold_1 elt m.(this). - - Definition map_1 m := @Raw.map_1 elt elt' m.(this). - Definition map_2 m := @Raw.map_2 elt elt' m.(this). - - Definition mapi_1 m := @Raw.mapi_1 elt elt' m.(this). - Definition mapi_2 m := @Raw.mapi_2 elt elt' m.(this). - - Definition map2_1 m (m':t elt') x f := - @Raw.map2_1 elt elt' elt'' f m.(this) m.(sorted) m'.(this) m'.(sorted) x. - Definition map2_2 m (m':t elt') x f := - @Raw.map2_2 elt elt' elt'' f m.(this) m.(sorted) m'.(this) m'.(sorted) x. - - Definition equal_1 m m' := - @Raw.equal_1 elt m.(this) m.(sorted) m'.(this) m'.(sorted). - Definition equal_2 m m' := - @Raw.equal_2 elt m.(this) m.(sorted) m'.(this) m'.(sorted). + Build_slist (Raw.map2_sorted f m.(sorted) m'.(sorted)). + Definition elements m : list (key*elt) := @Raw.elements elt m.(this). + Definition fold (A:Set)(f:key->elt->A->A) m (i:A) : A := @Raw.fold elt A f m.(this) i. + Definition equal cmp m m' : bool := @Raw.equal elt cmp m.(this) m'.(this). + + Definition MapsTo x e m : Prop := Raw.PX.MapsTo x e m.(this). + Definition In x m : Prop := Raw.PX.In x m.(this). + Definition Empty m : Prop := Raw.Empty m.(this). + Definition Equal cmp m m' : Prop := @Raw.Equal elt cmp m.(this) m'.(this). + + Definition eq_key : (key*elt) -> (key*elt) -> Prop := @Raw.PX.eqk elt. + Definition eq_key_elt : (key*elt) -> (key*elt) -> Prop:= @Raw.PX.eqke elt. + Definition lt_key : (key*elt) -> (key*elt) -> Prop := @Raw.PX.ltk elt. + + Lemma MapsTo_1 : forall m x y e, E.eq x y -> MapsTo x e m -> MapsTo y e m. + Proof. intros m; exact (@Raw.PX.MapsTo_eq elt m.(this)). Qed. + + Lemma mem_1 : forall m x, In x m -> mem x m = true. + Proof. intros m; exact (@Raw.mem_1 elt m.(this) m.(sorted)). Qed. + Lemma mem_2 : forall m x, mem x m = true -> In x m. + Proof. intros m; exact (@Raw.mem_2 elt m.(this) m.(sorted)). Qed. + + Lemma empty_1 : Empty empty. + Proof. exact (@Raw.empty_1 elt). Qed. + + Lemma is_empty_1 : forall m, Empty m -> is_empty m = true. + Proof. intros m; exact (@Raw.is_empty_1 elt m.(this)). Qed. + Lemma is_empty_2 : forall m, is_empty m = true -> Empty m. + Proof. intros m; exact (@Raw.is_empty_2 elt m.(this)). Qed. + + Lemma add_1 : forall m x y e, E.eq x y -> MapsTo y e (add x e m). + Proof. intros m; exact (@Raw.add_1 elt m.(this)). Qed. + Lemma add_2 : forall m x y e e', ~ E.eq x y -> MapsTo y e m -> MapsTo y e (add x e' m). + Proof. intros m; exact (@Raw.add_2 elt m.(this)). Qed. + Lemma add_3 : forall m x y e e', ~ E.eq x y -> MapsTo y e (add x e' m) -> MapsTo y e m. + Proof. intros m; exact (@Raw.add_3 elt m.(this)). Qed. + + Lemma remove_1 : forall m x y, E.eq x y -> ~ In y (remove x m). + Proof. intros m; exact (@Raw.remove_1 elt m.(this) m.(sorted)). Qed. + Lemma remove_2 : forall m x y e, ~ E.eq x y -> MapsTo y e m -> MapsTo y e (remove x m). + Proof. intros m; exact (@Raw.remove_2 elt m.(this) m.(sorted)). Qed. + Lemma remove_3 : forall m x y e, MapsTo y e (remove x m) -> MapsTo y e m. + Proof. intros m; exact (@Raw.remove_3 elt m.(this) m.(sorted)). Qed. + + Lemma find_1 : forall m x e, MapsTo x e m -> find x m = Some e. + Proof. intros m; exact (@Raw.find_1 elt m.(this) m.(sorted)). Qed. + Lemma find_2 : forall m x e, find x m = Some e -> MapsTo x e m. + Proof. intros m; exact (@Raw.find_2 elt m.(this)). Qed. + + Lemma elements_1 : forall m x e, MapsTo x e m -> InA eq_key_elt (x,e) (elements m). + Proof. intros m; exact (@Raw.elements_1 elt m.(this)). Qed. + Lemma elements_2 : forall m x e, InA eq_key_elt (x,e) (elements m) -> MapsTo x e m. + Proof. intros m; exact (@Raw.elements_2 elt m.(this)). Qed. + Lemma elements_3 : forall m, sort lt_key (elements m). + Proof. intros m; exact (@Raw.elements_3 elt m.(this) m.(sorted)). Qed. + + Lemma fold_1 : forall m (A : Set) (i : A) (f : key -> elt -> A -> A), + fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (elements m) i. + Proof. intros m; exact (@Raw.fold_1 elt m.(this)). Qed. + + Lemma equal_1 : forall m m' cmp, Equal cmp m m' -> equal cmp m m' = true. + Proof. intros m m'; exact (@Raw.equal_1 elt m.(this) m.(sorted) m'.(this) m'.(sorted)). Qed. + Lemma equal_2 : forall m m' cmp, equal cmp m m' = true -> Equal cmp m m'. + Proof. intros m m'; exact (@Raw.equal_2 elt m.(this) m.(sorted) m'.(this) m'.(sorted)). Qed. End Elt. + + Lemma map_1 : forall (elt elt':Set)(m: t elt)(x:key)(e:elt)(f:elt->elt'), + MapsTo x e m -> MapsTo x (f e) (map f m). + Proof. intros elt elt' m; exact (@Raw.map_1 elt elt' m.(this)). Qed. + Lemma map_2 : forall (elt elt':Set)(m: t elt)(x:key)(f:elt->elt'), + In x (map f m) -> In x m. + Proof. intros elt elt' m; exact (@Raw.map_2 elt elt' m.(this)). Qed. + + Lemma mapi_1 : forall (elt elt':Set)(m: t elt)(x:key)(e:elt) + (f:key->elt->elt'), MapsTo x e m -> + exists y, E.eq y x /\ MapsTo x (f y e) (mapi f m). + Proof. intros elt elt' m; exact (@Raw.mapi_1 elt elt' m.(this)). Qed. + Lemma mapi_2 : forall (elt elt':Set)(m: t elt)(x:key) + (f:key->elt->elt'), In x (mapi f m) -> In x m. + Proof. intros elt elt' m; exact (@Raw.mapi_2 elt elt' m.(this)). Qed. + + Lemma map2_1 : forall (elt elt' elt'':Set)(m: t elt)(m': t elt') + (x:key)(f:option elt->option elt'->option elt''), + In x m \/ In x m' -> + find x (map2 f m m') = f (find x m) (find x m'). + Proof. + intros elt elt' elt'' m m' x f; + exact (@Raw.map2_1 elt elt' elt'' f m.(this) m.(sorted) m'.(this) m'.(sorted) x). + Qed. + Lemma map2_2 : forall (elt elt' elt'':Set)(m: t elt)(m': t elt') + (x:key)(f:option elt->option elt'->option elt''), + In x (map2 f m m') -> In x m \/ In x m'. + Proof. + intros elt elt' elt'' m m' x f; + exact (@Raw.map2_2 elt elt' elt'' f m.(this) m.(sorted) m'.(this) m'.(sorted) x). + Qed. + End Make. Module Make_ord (X: OrderedType)(D : OrderedType) <: diff --git a/theories/FSets/FMapPositive.v b/theories/FSets/FMapPositive.v new file mode 100644 index 00000000..dcb7fb49 --- /dev/null +++ b/theories/FSets/FMapPositive.v @@ -0,0 +1,1153 @@ +(***********************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * INRIA-Rocquencourt & LRI-CNRS-Orsay *) +(* \VV/ *************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(***********************************************************************) + +(* Finite sets library. + * Authors: Pierre Letouzey and Jean-Christophe Filliâtre + * Institution: LRI, CNRS UMR 8623 - Université Paris Sud + * 91405 Orsay, France *) + +(* $Id: FMapPositive.v 8773 2006-04-29 14:31:32Z letouzey $ *) + +Require Import ZArith. +Require Import OrderedType. +Require Import FMapInterface. + +Set Implicit Arguments. + +Open Scope positive_scope. + +(** * An implementation of [FMapInterface.S] for positive keys. *) + +(** This file is an adaptation to the [FMap] framework of a work by + Xavier Leroy and Sandrine Blazy (used for building certified compilers). + Keys are of type [positive], and maps are binary trees: the sequence + of binary digits of a positive number corresponds to a path in such a tree. + This is quite similar to the [IntMap] library, except that no path compression + is implemented, and that the current file is simple enough to be + self-contained. *) + +(** Even if [positive] can be seen as an ordered type with respect to the + usual order (see [OrderedTypeEx]), we use here a lexicographic order + over bits, which is more natural here (lower bits are considered first). *) + +Module PositiveOrderedTypeBits <: OrderedType. + Definition t:=positive. + Definition eq:=@eq positive. + + Fixpoint bits_lt (p q:positive) { struct p } : Prop := + match p, q with + | xH, xI _ => True + | xH, _ => False + | xO p, xO q => bits_lt p q + | xO _, _ => True + | xI p, xI q => bits_lt p q + | xI _, _ => False + end. + + Definition lt:=bits_lt. + + Lemma eq_refl : forall x : t, eq x x. + Proof. red; auto. Qed. + + Lemma eq_sym : forall x y : t, eq x y -> eq y x. + Proof. red; auto. Qed. + + Lemma eq_trans : forall x y z : t, eq x y -> eq y z -> eq x z. + Proof. red; intros; transitivity y; auto. Qed. + + Lemma bits_lt_trans : forall x y z : positive, bits_lt x y -> bits_lt y z -> bits_lt x z. + Proof. + induction x. + induction y; destruct z; simpl; eauto; intuition. + induction y; destruct z; simpl; eauto; intuition. + induction y; destruct z; simpl; eauto; intuition. + Qed. + + Lemma lt_trans : forall x y z : t, lt x y -> lt y z -> lt x z. + Proof. + exact bits_lt_trans. + Qed. + + Lemma bits_lt_antirefl : forall x : positive, ~ bits_lt x x. + Proof. + induction x; simpl; auto. + Qed. + + Lemma lt_not_eq : forall x y : t, lt x y -> ~ eq x y. + Proof. + intros; intro. + rewrite <- H0 in H; clear H0 y. + unfold lt in H. + exact (bits_lt_antirefl x H). + Qed. + + Definition compare : forall x y : t, Compare lt eq x y. + Proof. + induction x; destruct y. + (* I I *) + destruct (IHx y). + apply LT; auto. + apply EQ; rewrite e; red; auto. + apply GT; auto. + (* I O *) + apply GT; simpl; auto. + (* I H *) + apply GT; simpl; auto. + (* O I *) + apply LT; simpl; auto. + (* O O *) + destruct (IHx y). + apply LT; auto. + apply EQ; rewrite e; red; auto. + apply GT; auto. + (* O H *) + apply LT; simpl; auto. + (* H I *) + apply LT; simpl; auto. + (* H O *) + apply GT; simpl; auto. + (* H H *) + apply EQ; red; auto. + Qed. + +End PositiveOrderedTypeBits. + +(** Other positive stuff *) + +Lemma peq_dec (x y: positive): {x = y} + {x <> y}. +Proof. + intros. case_eq ((x ?= y) Eq); intros. + left. apply Pcompare_Eq_eq; auto. + right. red. intro. subst y. rewrite (Pcompare_refl x) in H. discriminate. + right. red. intro. subst y. rewrite (Pcompare_refl x) in H. discriminate. +Qed. + +Fixpoint append (i j : positive) {struct i} : positive := + match i with + | xH => j + | xI ii => xI (append ii j) + | xO ii => xO (append ii j) + end. + +Lemma append_assoc_0 : + forall (i j : positive), append i (xO j) = append (append i (xO xH)) j. +Proof. + induction i; intros; destruct j; simpl; + try rewrite (IHi (xI j)); + try rewrite (IHi (xO j)); + try rewrite <- (IHi xH); + auto. +Qed. + +Lemma append_assoc_1 : + forall (i j : positive), append i (xI j) = append (append i (xI xH)) j. +Proof. + induction i; intros; destruct j; simpl; + try rewrite (IHi (xI j)); + try rewrite (IHi (xO j)); + try rewrite <- (IHi xH); + auto. +Qed. + +Lemma append_neutral_r : forall (i : positive), append i xH = i. +Proof. + induction i; simpl; congruence. +Qed. + +Lemma append_neutral_l : forall (i : positive), append xH i = i. +Proof. + simpl; auto. +Qed. + + +(** The module of maps over positive keys *) + +Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. + + Module E:=PositiveOrderedTypeBits. + + Definition key := positive. + + Inductive tree (A : Set) : Set := + | Leaf : tree A + | Node : tree A -> option A -> tree A -> tree A. + + Definition t := tree. + + Section A. + Variable A:Set. + + Implicit Arguments Leaf [A]. + + Definition empty : t A := Leaf. + + Fixpoint is_empty (m : t A) {struct m} : bool := + match m with + | Leaf => true + | Node l None r => (is_empty l) && (is_empty r) + | _ => false + end. + + Fixpoint find (i : positive) (m : t A) {struct i} : option A := + match m with + | Leaf => None + | Node l o r => + match i with + | xH => o + | xO ii => find ii l + | xI ii => find ii r + end + end. + + Fixpoint mem (i : positive) (m : t A) {struct i} : bool := + match m with + | Leaf => false + | Node l o r => + match i with + | xH => match o with None => false | _ => true end + | xO ii => mem ii l + | xI ii => mem ii r + end + end. + + Fixpoint add (i : positive) (v : A) (m : t A) {struct i} : t A := + match m with + | Leaf => + match i with + | xH => Node Leaf (Some v) Leaf + | xO ii => Node (add ii v Leaf) None Leaf + | xI ii => Node Leaf None (add ii v Leaf) + end + | Node l o r => + match i with + | xH => Node l (Some v) r + | xO ii => Node (add ii v l) o r + | xI ii => Node l o (add ii v r) + end + end. + + Fixpoint remove (i : positive) (m : t A) {struct i} : t A := + match i with + | xH => + match m with + | Leaf => Leaf + | Node Leaf o Leaf => Leaf + | Node l o r => Node l None r + end + | xO ii => + match m with + | Leaf => Leaf + | Node l None Leaf => + match remove ii l with + | Leaf => Leaf + | mm => Node mm None Leaf + end + | Node l o r => Node (remove ii l) o r + end + | xI ii => + match m with + | Leaf => Leaf + | Node Leaf None r => + match remove ii r with + | Leaf => Leaf + | mm => Node Leaf None mm + end + | Node l o r => Node l o (remove ii r) + end + end. + + (** [elements] *) + + Fixpoint xelements (m : t A) (i : positive) {struct m} + : list (positive * A) := + match m with + | Leaf => nil + | Node l None r => + (xelements l (append i (xO xH))) ++ (xelements r (append i (xI xH))) + | Node l (Some x) r => + (xelements l (append i (xO xH))) + ++ ((i, x) :: xelements r (append i (xI xH))) + end. + + (* Note: function [xelements] above is inefficient. We should apply + deforestation to it, but that makes the proofs even harder. *) + + Definition elements (m : t A) := xelements m xH. + + Section CompcertSpec. + + Theorem gempty: + forall (i: positive), find i empty = None. + Proof. + destruct i; simpl; auto. + Qed. + + Theorem gss: + forall (i: positive) (x: A) (m: t A), find i (add i x m) = Some x. + Proof. + induction i; destruct m; simpl; auto. + Qed. + + Lemma gleaf : forall (i : positive), find i (Leaf : t A) = None. + Proof. exact gempty. Qed. + + Theorem gso: + forall (i j: positive) (x: A) (m: t A), + i <> j -> find i (add j x m) = find i m. + Proof. + induction i; intros; destruct j; destruct m; simpl; + try rewrite <- (gleaf i); auto; try apply IHi; congruence. + Qed. + + Lemma rleaf : forall (i : positive), remove i (Leaf : t A) = Leaf. + Proof. destruct i; simpl; auto. Qed. + + Theorem grs: + forall (i: positive) (m: t A), find i (remove i m) = None. + Proof. + induction i; destruct m. + simpl; auto. + destruct m1; destruct o; destruct m2 as [ | ll oo rr]; simpl; auto. + rewrite (rleaf i); auto. + cut (find i (remove i (Node ll oo rr)) = None). + destruct (remove i (Node ll oo rr)); auto; apply IHi. + apply IHi. + simpl; auto. + destruct m1 as [ | ll oo rr]; destruct o; destruct m2; simpl; auto. + rewrite (rleaf i); auto. + cut (find i (remove i (Node ll oo rr)) = None). + destruct (remove i (Node ll oo rr)); auto; apply IHi. + apply IHi. + simpl; auto. + destruct m1; destruct m2; simpl; auto. + Qed. + + Theorem gro: + forall (i j: positive) (m: t A), + i <> j -> find i (remove j m) = find i m. + Proof. + induction i; intros; destruct j; destruct m; + try rewrite (rleaf (xI j)); + try rewrite (rleaf (xO j)); + try rewrite (rleaf 1); auto; + destruct m1; destruct o; destruct m2; + simpl; + try apply IHi; try congruence; + try rewrite (rleaf j); auto; + try rewrite (gleaf i); auto. + cut (find i (remove j (Node m2_1 o m2_2)) = find i (Node m2_1 o m2_2)); + [ destruct (remove j (Node m2_1 o m2_2)); try rewrite (gleaf i); auto + | apply IHi; congruence ]. + destruct (remove j (Node m1_1 o0 m1_2)); simpl; try rewrite (gleaf i); + auto. + destruct (remove j (Node m2_1 o m2_2)); simpl; try rewrite (gleaf i); + auto. + cut (find i (remove j (Node m1_1 o0 m1_2)) = find i (Node m1_1 o0 m1_2)); + [ destruct (remove j (Node m1_1 o0 m1_2)); try rewrite (gleaf i); auto + | apply IHi; congruence ]. + destruct (remove j (Node m2_1 o m2_2)); simpl; try rewrite (gleaf i); + auto. + destruct (remove j (Node m1_1 o0 m1_2)); simpl; try rewrite (gleaf i); + auto. + Qed. + + Lemma xelements_correct: + forall (m: t A) (i j : positive) (v: A), + find i m = Some v -> List.In (append j i, v) (xelements m j). + Proof. + induction m; intros. + rewrite (gleaf i) in H; congruence. + destruct o; destruct i; simpl; simpl in H. + rewrite append_assoc_1; apply in_or_app; right; apply in_cons; + apply IHm2; auto. + rewrite append_assoc_0; apply in_or_app; left; apply IHm1; auto. + rewrite append_neutral_r; apply in_or_app; injection H; + intro EQ; rewrite EQ; right; apply in_eq. + rewrite append_assoc_1; apply in_or_app; right; apply IHm2; auto. + rewrite append_assoc_0; apply in_or_app; left; apply IHm1; auto. + congruence. + Qed. + + Theorem elements_correct: + forall (m: t A) (i: positive) (v: A), + find i m = Some v -> List.In (i, v) (elements m). + Proof. + intros m i v H. + exact (xelements_correct m i xH H). + Qed. + + Fixpoint xfind (i j : positive) (m : t A) {struct j} : option A := + match i, j with + | _, xH => find i m + | xO ii, xO jj => xfind ii jj m + | xI ii, xI jj => xfind ii jj m + | _, _ => None + end. + + Lemma xfind_left : + forall (j i : positive) (m1 m2 : t A) (o : option A) (v : A), + xfind i (append j (xO xH)) m1 = Some v -> xfind i j (Node m1 o m2) = Some v. + Proof. + induction j; intros; destruct i; simpl; simpl in H; auto; try congruence. + destruct i; congruence. + Qed. + + Lemma xelements_ii : + forall (m: t A) (i j : positive) (v: A), + List.In (xI i, v) (xelements m (xI j)) -> List.In (i, v) (xelements m j). + Proof. + induction m. + simpl; auto. + intros; destruct o; simpl; simpl in H; destruct (in_app_or _ _ _ H); + apply in_or_app. + left; apply IHm1; auto. + right; destruct (in_inv H0). + injection H1; intros Eq1 Eq2; rewrite Eq1; rewrite Eq2; apply in_eq. + apply in_cons; apply IHm2; auto. + left; apply IHm1; auto. + right; apply IHm2; auto. + Qed. + + Lemma xelements_io : + forall (m: t A) (i j : positive) (v: A), + ~List.In (xI i, v) (xelements m (xO j)). + Proof. + induction m. + simpl; auto. + intros; destruct o; simpl; intro H; destruct (in_app_or _ _ _ H). + apply (IHm1 _ _ _ H0). + destruct (in_inv H0). + congruence. + apply (IHm2 _ _ _ H1). + apply (IHm1 _ _ _ H0). + apply (IHm2 _ _ _ H0). + Qed. + + Lemma xelements_oo : + forall (m: t A) (i j : positive) (v: A), + List.In (xO i, v) (xelements m (xO j)) -> List.In (i, v) (xelements m j). + Proof. + induction m. + simpl; auto. + intros; destruct o; simpl; simpl in H; destruct (in_app_or _ _ _ H); + apply in_or_app. + left; apply IHm1; auto. + right; destruct (in_inv H0). + injection H1; intros Eq1 Eq2; rewrite Eq1; rewrite Eq2; apply in_eq. + apply in_cons; apply IHm2; auto. + left; apply IHm1; auto. + right; apply IHm2; auto. + Qed. + + Lemma xelements_oi : + forall (m: t A) (i j : positive) (v: A), + ~List.In (xO i, v) (xelements m (xI j)). + Proof. + induction m. + simpl; auto. + intros; destruct o; simpl; intro H; destruct (in_app_or _ _ _ H). + apply (IHm1 _ _ _ H0). + destruct (in_inv H0). + congruence. + apply (IHm2 _ _ _ H1). + apply (IHm1 _ _ _ H0). + apply (IHm2 _ _ _ H0). + Qed. + + Lemma xelements_ih : + forall (m1 m2: t A) (o: option A) (i : positive) (v: A), + List.In (xI i, v) (xelements (Node m1 o m2) xH) -> List.In (i, v) (xelements m2 xH). + Proof. + destruct o; simpl; intros; destruct (in_app_or _ _ _ H). + absurd (List.In (xI i, v) (xelements m1 2)); auto; apply xelements_io; auto. + destruct (in_inv H0). + congruence. + apply xelements_ii; auto. + absurd (List.In (xI i, v) (xelements m1 2)); auto; apply xelements_io; auto. + apply xelements_ii; auto. + Qed. + + Lemma xelements_oh : + forall (m1 m2: t A) (o: option A) (i : positive) (v: A), + List.In (xO i, v) (xelements (Node m1 o m2) xH) -> List.In (i, v) (xelements m1 xH). + Proof. + destruct o; simpl; intros; destruct (in_app_or _ _ _ H). + apply xelements_oo; auto. + destruct (in_inv H0). + congruence. + absurd (List.In (xO i, v) (xelements m2 3)); auto; apply xelements_oi; auto. + apply xelements_oo; auto. + absurd (List.In (xO i, v) (xelements m2 3)); auto; apply xelements_oi; auto. + Qed. + + Lemma xelements_hi : + forall (m: t A) (i : positive) (v: A), + ~List.In (xH, v) (xelements m (xI i)). + Proof. + induction m; intros. + simpl; auto. + destruct o; simpl; intro H; destruct (in_app_or _ _ _ H). + generalize H0; apply IHm1; auto. + destruct (in_inv H0). + congruence. + generalize H1; apply IHm2; auto. + generalize H0; apply IHm1; auto. + generalize H0; apply IHm2; auto. + Qed. + + Lemma xelements_ho : + forall (m: t A) (i : positive) (v: A), + ~List.In (xH, v) (xelements m (xO i)). + Proof. + induction m; intros. + simpl; auto. + destruct o; simpl; intro H; destruct (in_app_or _ _ _ H). + generalize H0; apply IHm1; auto. + destruct (in_inv H0). + congruence. + generalize H1; apply IHm2; auto. + generalize H0; apply IHm1; auto. + generalize H0; apply IHm2; auto. + Qed. + + Lemma find_xfind_h : + forall (m: t A) (i: positive), find i m = xfind i xH m. + Proof. + destruct i; simpl; auto. + Qed. + + Lemma xelements_complete: + forall (i j : positive) (m: t A) (v: A), + List.In (i, v) (xelements m j) -> xfind i j m = Some v. + Proof. + induction i; simpl; intros; destruct j; simpl. + apply IHi; apply xelements_ii; auto. + absurd (List.In (xI i, v) (xelements m (xO j))); auto; apply xelements_io. + destruct m. + simpl in H; tauto. + rewrite find_xfind_h. apply IHi. apply (xelements_ih _ _ _ _ _ H). + absurd (List.In (xO i, v) (xelements m (xI j))); auto; apply xelements_oi. + apply IHi; apply xelements_oo; auto. + destruct m. + simpl in H; tauto. + rewrite find_xfind_h. apply IHi. apply (xelements_oh _ _ _ _ _ H). + absurd (List.In (xH, v) (xelements m (xI j))); auto; apply xelements_hi. + absurd (List.In (xH, v) (xelements m (xO j))); auto; apply xelements_ho. + destruct m. + simpl in H; tauto. + destruct o; simpl in H; destruct (in_app_or _ _ _ H). + absurd (List.In (xH, v) (xelements m1 (xO xH))); auto; apply xelements_ho. + destruct (in_inv H0). + congruence. + absurd (List.In (xH, v) (xelements m2 (xI xH))); auto; apply xelements_hi. + absurd (List.In (xH, v) (xelements m1 (xO xH))); auto; apply xelements_ho. + absurd (List.In (xH, v) (xelements m2 (xI xH))); auto; apply xelements_hi. + Qed. + + Theorem elements_complete: + forall (m: t A) (i: positive) (v: A), + List.In (i, v) (elements m) -> find i m = Some v. + Proof. + intros m i v H. + unfold elements in H. + rewrite find_xfind_h. + exact (xelements_complete i xH m v H). + Qed. + + End CompcertSpec. + + Definition MapsTo (i:positive)(v:A)(m:t A) := find i m = Some v. + + Definition In (i:positive)(m:t A) := exists e:A, MapsTo i e m. + + Definition Empty m := forall (a : positive)(e:A) , ~ MapsTo a e m. + + Definition eq_key (p p':positive*A) := E.eq (fst p) (fst p'). + + Definition eq_key_elt (p p':positive*A) := + E.eq (fst p) (fst p') /\ (snd p) = (snd p'). + + Definition lt_key (p p':positive*A) := E.lt (fst p) (fst p'). + + Lemma mem_find : + forall m x, mem x m = match find x m with None => false | _ => true end. + Proof. + induction m; destruct x; simpl; auto. + Qed. + + Lemma Empty_alt : forall m, Empty m <-> forall a, find a m = None. + Proof. + unfold Empty, MapsTo. + intuition. + generalize (H a). + destruct (find a m); intuition. + elim (H0 a0); auto. + rewrite H in H0; discriminate. + Qed. + + Lemma Empty_Node : forall l o r, Empty (Node l o r) <-> o=None /\ Empty l /\ Empty r. + Proof. + intros l o r. + split. + rewrite Empty_alt. + split. + destruct o; auto. + generalize (H 1); simpl; auto. + split; rewrite Empty_alt; intros. + generalize (H (xO a)); auto. + generalize (H (xI a)); auto. + intros (H,(H0,H1)). + subst. + rewrite Empty_alt; intros. + destruct a; auto. + simpl; generalize H1; rewrite Empty_alt; auto. + simpl; generalize H0; rewrite Empty_alt; auto. + Qed. + + Section FMapSpec. + + Lemma mem_1 : forall m x, In x m -> mem x m = true. + Proof. + unfold In, MapsTo; intros m x; rewrite mem_find. + destruct 1 as (e0,H0); rewrite H0; auto. + Qed. + + Lemma mem_2 : forall m x, mem x m = true -> In x m. + Proof. + unfold In, MapsTo; intros m x; rewrite mem_find. + destruct (find x m). + exists a; auto. + intros; discriminate. + Qed. + + Variable m m' m'' : t A. + Variable x y z : key. + Variable e e' : A. + + Lemma MapsTo_1 : E.eq x y -> MapsTo x e m -> MapsTo y e m. + Proof. intros; rewrite <- H; auto. Qed. + + Lemma find_1 : MapsTo x e m -> find x m = Some e. + Proof. unfold MapsTo; auto. Qed. + + Lemma find_2 : find x m = Some e -> MapsTo x e m. + Proof. red; auto. Qed. + + Lemma empty_1 : Empty empty. + Proof. + rewrite Empty_alt; apply gempty. + Qed. + + Lemma is_empty_1 : Empty m -> is_empty m = true. + Proof. + induction m; simpl; auto. + rewrite Empty_Node. + intros (H,(H0,H1)). + subst; simpl. + rewrite IHt0_1; simpl; auto. + Qed. + + Lemma is_empty_2 : is_empty m = true -> Empty m. + Proof. + induction m; simpl; auto. + rewrite Empty_alt. + intros _; exact gempty. + rewrite Empty_Node. + destruct o. + intros; discriminate. + intro H; destruct (andb_prop _ _ H); intuition. + Qed. + + Lemma add_1 : E.eq x y -> MapsTo y e (add x e m). + Proof. + unfold MapsTo. + intro H; rewrite H; clear H. + apply gss. + Qed. + + Lemma add_2 : ~ E.eq x y -> MapsTo y e m -> MapsTo y e (add x e' m). + Proof. + unfold MapsTo. + intros; rewrite gso; auto. + Qed. + + Lemma add_3 : ~ E.eq x y -> MapsTo y e (add x e' m) -> MapsTo y e m. + Proof. + unfold MapsTo. + intro H; rewrite gso; auto. + Qed. + + Lemma remove_1 : E.eq x y -> ~ In y (remove x m). + Proof. + intros; intro. + generalize (mem_1 H0). + rewrite mem_find. + rewrite H. + rewrite grs. + intros; discriminate. + Qed. + + Lemma remove_2 : ~ E.eq x y -> MapsTo y e m -> MapsTo y e (remove x m). + Proof. + unfold MapsTo. + intro H; rewrite gro; auto. + Qed. + + Lemma remove_3 : MapsTo y e (remove x m) -> MapsTo y e m. + Proof. + unfold MapsTo. + destruct (peq_dec x y). + subst. + rewrite grs; intros; discriminate. + rewrite gro; auto. + Qed. + + Lemma elements_1 : + MapsTo x e m -> InA eq_key_elt (x,e) (elements m). + Proof. + unfold MapsTo. + rewrite InA_alt. + intro H. + exists (x,e). + split. + red; simpl; unfold E.eq; auto. + apply elements_correct; auto. + Qed. + + Lemma elements_2 : + InA eq_key_elt (x,e) (elements m) -> MapsTo x e m. + Proof. + unfold MapsTo. + rewrite InA_alt. + intros ((e0,a),(H,H0)). + red in H; simpl in H; unfold E.eq in H; destruct H; subst. + apply elements_complete; auto. + Qed. + + Lemma xelements_bits_lt_1 : forall p p0 q m v, + List.In (p0,v) (xelements m (append p (xO q))) -> E.bits_lt p0 p. + Proof. + intros. + generalize (xelements_complete _ _ _ _ H); clear H; intros. + revert H; revert v; revert m; revert q; revert p0. + induction p; destruct p0; simpl; intros; eauto; try discriminate. + Qed. + + Lemma xelements_bits_lt_2 : forall p p0 q m v, + List.In (p0,v) (xelements m (append p (xI q))) -> E.bits_lt p p0. + Proof. + intros. + generalize (xelements_complete _ _ _ _ H); clear H; intros. + revert H; revert v; revert m; revert q; revert p0. + induction p; destruct p0; simpl; intros; eauto; try discriminate. + Qed. + + Lemma xelements_sort : forall p, sort lt_key (xelements m p). + Proof. + induction m. + simpl; auto. + destruct o; simpl; intros. + (* Some *) + apply (SortA_app (eqA:=eq_key_elt)); auto. + compute; intuition. + constructor; auto. + apply In_InfA; intros. + destruct y0. + red; red; simpl. + eapply xelements_bits_lt_2; eauto. + intros x0 y0. + do 2 rewrite InA_alt. + intros (y1,(Hy1,H)) (y2,(Hy2,H0)). + destruct y1; destruct x0; compute in Hy1; destruct Hy1; subst. + destruct y2; destruct y0; compute in Hy2; destruct Hy2; subst. + red; red; simpl. + destruct H0. + injection H0; clear H0; intros _ H0; subst. + eapply xelements_bits_lt_1; eauto. + apply E.bits_lt_trans with p. + eapply xelements_bits_lt_1; eauto. + eapply xelements_bits_lt_2; eauto. + (* None *) + apply (SortA_app (eqA:=eq_key_elt)); auto. + compute; intuition. + intros x0 y0. + do 2 rewrite InA_alt. + intros (y1,(Hy1,H)) (y2,(Hy2,H0)). + destruct y1; destruct x0; compute in Hy1; destruct Hy1; subst. + destruct y2; destruct y0; compute in Hy2; destruct Hy2; subst. + red; red; simpl. + apply E.bits_lt_trans with p. + eapply xelements_bits_lt_1; eauto. + eapply xelements_bits_lt_2; eauto. + Qed. + + Lemma elements_3 : sort lt_key (elements m). + Proof. + unfold elements. + apply xelements_sort; auto. + Qed. + + End FMapSpec. + + (** [map] and [mapi] *) + + Variable B : Set. + + Fixpoint xmapi (f : positive -> A -> B) (m : t A) (i : positive) + {struct m} : t B := + match m with + | Leaf => @Leaf B + | Node l o r => Node (xmapi f l (append i (xO xH))) + (option_map (f i) o) + (xmapi f r (append i (xI xH))) + end. + + Definition mapi (f : positive -> A -> B) m := xmapi f m xH. + + Definition map (f : A -> B) m := mapi (fun _ => f) m. + + End A. + + Lemma xgmapi: + forall (A B: Set) (f: positive -> A -> B) (i j : positive) (m: t A), + find i (xmapi f m j) = option_map (f (append j i)) (find i m). + Proof. + induction i; intros; destruct m; simpl; auto. + rewrite (append_assoc_1 j i); apply IHi. + rewrite (append_assoc_0 j i); apply IHi. + rewrite (append_neutral_r j); auto. + Qed. + + Theorem gmapi: + forall (A B: Set) (f: positive -> A -> B) (i: positive) (m: t A), + find i (mapi f m) = option_map (f i) (find i m). + Proof. + intros. + unfold mapi. + replace (f i) with (f (append xH i)). + apply xgmapi. + rewrite append_neutral_l; auto. + Qed. + + Lemma mapi_1 : + forall (elt elt':Set)(m: t elt)(x:key)(e:elt)(f:key->elt->elt'), + MapsTo x e m -> + exists y, E.eq y x /\ MapsTo x (f y e) (mapi f m). + Proof. + intros. + exists x. + split; [red; auto|]. + apply find_2. + generalize (find_1 H); clear H; intros. + rewrite gmapi. + rewrite H. + simpl; auto. + Qed. + + Lemma mapi_2 : + forall (elt elt':Set)(m: t elt)(x:key)(f:key->elt->elt'), + In x (mapi f m) -> In x m. + Proof. + intros. + apply mem_2. + rewrite mem_find. + destruct H as (v,H). + generalize (find_1 H); clear H; intros. + rewrite gmapi in H. + destruct (find x m); auto. + simpl in *; discriminate. + Qed. + + Lemma map_1 : forall (elt elt':Set)(m: t elt)(x:key)(e:elt)(f:elt->elt'), + MapsTo x e m -> MapsTo x (f e) (map f m). + Proof. + intros; unfold map. + destruct (mapi_1 (fun _ => f) H); intuition. + Qed. + + Lemma map_2 : forall (elt elt':Set)(m: t elt)(x:key)(f:elt->elt'), + In x (map f m) -> In x m. + Proof. + intros; unfold map in *; eapply mapi_2; eauto. + Qed. + + Section map2. + Variable A B C : Set. + Variable f : option A -> option B -> option C. + + Implicit Arguments Leaf [A]. + + Fixpoint xmap2_l (m : t A) {struct m} : t C := + match m with + | Leaf => Leaf + | Node l o r => Node (xmap2_l l) (f o None) (xmap2_l r) + end. + + Lemma xgmap2_l : forall (i : positive) (m : t A), + f None None = None -> find i (xmap2_l m) = f (find i m) None. + Proof. + induction i; intros; destruct m; simpl; auto. + Qed. + + Fixpoint xmap2_r (m : t B) {struct m} : t C := + match m with + | Leaf => Leaf + | Node l o r => Node (xmap2_r l) (f None o) (xmap2_r r) + end. + + Lemma xgmap2_r : forall (i : positive) (m : t B), + f None None = None -> find i (xmap2_r m) = f None (find i m). + Proof. + induction i; intros; destruct m; simpl; auto. + Qed. + + Fixpoint _map2 (m1 : t A)(m2 : t B) {struct m1} : t C := + match m1 with + | Leaf => xmap2_r m2 + | Node l1 o1 r1 => + match m2 with + | Leaf => xmap2_l m1 + | Node l2 o2 r2 => Node (_map2 l1 l2) (f o1 o2) (_map2 r1 r2) + end + end. + + Lemma gmap2: forall (i: positive)(m1:t A)(m2: t B), + f None None = None -> + find i (_map2 m1 m2) = f (find i m1) (find i m2). + Proof. + induction i; intros; destruct m1; destruct m2; simpl; auto; + try apply xgmap2_r; try apply xgmap2_l; auto. + Qed. + + End map2. + + Definition map2 (elt elt' elt'':Set)(f:option elt->option elt'->option elt'') := + _map2 (fun o1 o2 => match o1,o2 with None,None => None | _, _ => f o1 o2 end). + + Lemma map2_1 : forall (elt elt' elt'':Set)(m: t elt)(m': t elt') + (x:key)(f:option elt->option elt'->option elt''), + In x m \/ In x m' -> + find x (map2 f m m') = f (find x m) (find x m'). + Proof. + intros. + unfold map2. + rewrite gmap2; auto. + generalize (@mem_1 _ m x) (@mem_1 _ m' x). + do 2 rewrite mem_find. + destruct (find x m); simpl; auto. + destruct (find x m'); simpl; auto. + intros. + destruct H; intuition; try discriminate. + Qed. + + Lemma map2_2 : forall (elt elt' elt'':Set)(m: t elt)(m': t elt') + (x:key)(f:option elt->option elt'->option elt''), + In x (map2 f m m') -> In x m \/ In x m'. + Proof. + intros. + generalize (mem_1 H); clear H; intros. + rewrite mem_find in H. + unfold map2 in H. + rewrite gmap2 in H; auto. + generalize (@mem_2 _ m x) (@mem_2 _ m' x). + do 2 rewrite mem_find. + destruct (find x m); simpl in *; auto. + destruct (find x m'); simpl in *; auto. + Qed. + + + Definition fold (A B : Set) (f: positive -> A -> B -> B) (tr: t A) (v: B) := + List.fold_left (fun a p => f (fst p) (snd p) a) (elements tr) v. + + Lemma fold_1 : + forall (A:Set)(m:t A)(B:Set)(i : B) (f : key -> A -> B -> B), + fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (elements m) i. + Proof. + intros; unfold fold; auto. + Qed. + + Fixpoint equal (A:Set)(cmp : A -> A -> bool)(m1 m2 : t A) {struct m1} : bool := + match m1, m2 with + | Leaf, _ => is_empty m2 + | _, Leaf => is_empty m1 + | Node l1 o1 r1, Node l2 o2 r2 => + (match o1, o2 with + | None, None => true + | Some v1, Some v2 => cmp v1 v2 + | _, _ => false + end) + && equal cmp l1 l2 && equal cmp r1 r2 + end. + + Definition Equal (A:Set)(cmp:A->A->bool)(m m':t A) := + (forall k, In k m <-> In k m') /\ + (forall k e e', MapsTo k e m -> MapsTo k e' m' -> cmp e e' = true). + + Lemma equal_1 : forall (A:Set)(m m':t A)(cmp:A->A->bool), + Equal cmp m m' -> equal cmp m m' = true. + Proof. + induction m. + (* m = Leaf *) + destruct 1. + simpl. + apply is_empty_1. + red; red; intros. + assert (In a (Leaf A)). + rewrite H. + exists e; auto. + destruct H2; red in H2. + destruct a; simpl in *; discriminate. + (* m = Node *) + destruct m'. + (* m' = Leaf *) + destruct 1. + simpl. + destruct o. + assert (In xH (Leaf A)). + rewrite <- H. + exists a; red; auto. + destruct H1; red in H1; simpl in H1; discriminate. + apply andb_true_intro; split; apply is_empty_1; red; red; intros. + assert (In (xO a) (Leaf A)). + rewrite <- H. + exists e; auto. + destruct H2; red in H2; simpl in H2; discriminate. + assert (In (xI a) (Leaf A)). + rewrite <- H. + exists e; auto. + destruct H2; red in H2; simpl in H2; discriminate. + (* m' = Node *) + destruct 1. + assert (Equal cmp m1 m'1). + split. + intros k; generalize (H (xO k)); unfold In, MapsTo; simpl; auto. + intros k e e'; generalize (H0 (xO k) e e'); unfold In, MapsTo; simpl; auto. + assert (Equal cmp m2 m'2). + split. + intros k; generalize (H (xI k)); unfold In, MapsTo; simpl; auto. + intros k e e'; generalize (H0 (xI k) e e'); unfold In, MapsTo; simpl; auto. + simpl. + destruct o; destruct o0; simpl. + repeat (apply andb_true_intro; split); auto. + apply (H0 xH); red; auto. + generalize (H xH); unfold In, MapsTo; simpl; intuition. + destruct H4; try discriminate; eauto. + generalize (H xH); unfold In, MapsTo; simpl; intuition. + destruct H5; try discriminate; eauto. + apply andb_true_intro; split; auto. + Qed. + + Lemma equal_2 : forall (A:Set)(m m':t A)(cmp:A->A->bool), + equal cmp m m' = true -> Equal cmp m m'. + Proof. + induction m. + (* m = Leaf *) + simpl. + split; intros. + split. + destruct 1; red in H0; destruct k; discriminate. + destruct 1; elim (is_empty_2 H H0). + red in H0; destruct k; discriminate. + (* m = Node *) + destruct m'. + (* m' = Leaf *) + simpl. + destruct o; intros; try discriminate. + destruct (andb_prop _ _ H); clear H. + split; intros. + split; unfold In, MapsTo; destruct 1. + destruct k; simpl in *; try discriminate. + destruct (is_empty_2 H1 (find_2 _ _ H)). + destruct (is_empty_2 H0 (find_2 _ _ H)). + destruct k; simpl in *; discriminate. + unfold In, MapsTo; destruct k; simpl in *; discriminate. + (* m' = Node *) + destruct o; destruct o0; simpl; intros; try discriminate. + destruct (andb_prop _ _ H); clear H. + destruct (andb_prop _ _ H0); clear H0. + destruct (IHm1 _ _ H2); clear H2 IHm1. + destruct (IHm2 _ _ H1); clear H1 IHm2. + split; intros. + destruct k; unfold In, MapsTo in *; simpl; auto. + split; eauto. + destruct k; unfold In, MapsTo in *; simpl in *. + eapply H4; eauto. + eapply H3; eauto. + congruence. + destruct (andb_prop _ _ H); clear H. + destruct (IHm1 _ _ H0); clear H0 IHm1. + destruct (IHm2 _ _ H1); clear H1 IHm2. + split; intros. + destruct k; unfold In, MapsTo in *; simpl; auto. + split; eauto. + destruct k; unfold In, MapsTo in *; simpl in *. + eapply H3; eauto. + eapply H2; eauto. + try discriminate. + Qed. + +End PositiveMap. + +(** Here come some additionnal facts about this implementation. + Most are facts that cannot be derivable from the general interface. *) + + +Module PositiveMapAdditionalFacts. + Import PositiveMap. + + (* Derivable from the Map interface *) + Theorem gsspec: + forall (A:Set)(i j: positive) (x: A) (m: t A), + find i (add j x m) = if peq_dec i j then Some x else find i m. + Proof. + intros. + destruct (peq_dec i j); [ rewrite e; apply gss | apply gso; auto ]. + Qed. + + (* Not derivable from the Map interface *) + Theorem gsident: + forall (A:Set)(i: positive) (m: t A) (v: A), + find i m = Some v -> add i v m = m. + Proof. + induction i; intros; destruct m; simpl; simpl in H; try congruence. + rewrite (IHi m2 v H); congruence. + rewrite (IHi m1 v H); congruence. + Qed. + + Lemma xmap2_lr : + forall (A B : Set)(f g: option A -> option A -> option B)(m : t A), + (forall (i j : option A), f i j = g j i) -> + xmap2_l f m = xmap2_r g m. + Proof. + induction m; intros; simpl; auto. + rewrite IHm1; auto. + rewrite IHm2; auto. + rewrite H; auto. + Qed. + + Theorem map2_commut: + forall (A B: Set) (f g: option A -> option A -> option B), + (forall (i j: option A), f i j = g j i) -> + forall (m1 m2: t A), + _map2 f m1 m2 = _map2 g m2 m1. + Proof. + intros A B f g Eq1. + assert (Eq2: forall (i j: option A), g i j = f j i). + intros; auto. + induction m1; intros; destruct m2; simpl; + try rewrite Eq1; + repeat rewrite (xmap2_lr f g); + repeat rewrite (xmap2_lr g f); + auto. + rewrite IHm1_1. + rewrite IHm1_2. + auto. + Qed. + +End PositiveMapAdditionalFacts. + diff --git a/theories/FSets/FMapWeak.v b/theories/FSets/FMapWeak.v index 90ebeffc..1ad190a4 100644 --- a/theories/FSets/FMapWeak.v +++ b/theories/FSets/FMapWeak.v @@ -6,7 +6,10 @@ (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -(* $Id: FMapWeak.v 8639 2006-03-16 19:21:55Z letouzey $ *) +(* $Id: FMapWeak.v 8844 2006-05-22 17:22:36Z letouzey $ *) +Require Export DecidableType. +Require Export DecidableTypeEx. Require Export FMapWeakInterface. Require Export FMapWeakList. +Require Export FMapWeakFacts.
\ No newline at end of file diff --git a/theories/FSets/FMapWeakFacts.v b/theories/FSets/FMapWeakFacts.v new file mode 100644 index 00000000..18f73a3f --- /dev/null +++ b/theories/FSets/FMapWeakFacts.v @@ -0,0 +1,599 @@ +(***********************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * INRIA-Rocquencourt & LRI-CNRS-Orsay *) +(* \VV/ *************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(***********************************************************************) + +(* $Id: FMapWeakFacts.v 8882 2006-05-31 21:55:30Z letouzey $ *) + +(** * Finite maps library *) + +(** This functor derives additional facts from [FMapWeakInterface.S]. These + facts are mainly the specifications of [FMapWeakInterface.S] written using + different styles: equivalence and boolean equalities. +*) + +Require Import Bool. +Require Import OrderedType. +Require Export FMapWeakInterface. +Set Implicit Arguments. +Unset Strict Implicit. + +Module Facts (M: S). +Import M. +Import Logic. (* to unmask [eq] *) +Import Peano. (* to unmask [lt] *) + +Lemma MapsTo_fun : forall (elt:Set) m x (e e':elt), + MapsTo x e m -> MapsTo x e' m -> e=e'. +Proof. +intros. +generalize (find_1 H) (find_1 H0); clear H H0. +intros; rewrite H in H0; injection H0; auto. +Qed. + +(** * Specifications written using equivalences *) + +Section IffSpec. +Variable elt elt' elt'': Set. +Implicit Type m: t elt. +Implicit Type x y z: key. +Implicit Type e: elt. + +Lemma MapsTo_iff : forall m x y e, E.eq x y -> (MapsTo x e m <-> MapsTo y e m). +Proof. +split; apply MapsTo_1; auto. +Qed. + +Lemma In_iff : forall m x y, E.eq x y -> (In x m <-> In y m). +Proof. +unfold In. +split; intros (e0,H0); exists e0. +apply (MapsTo_1 H H0); auto. +apply (MapsTo_1 (E.eq_sym H) H0); auto. +Qed. + +Lemma find_mapsto_iff : forall m x e, MapsTo x e m <-> find x m = Some e. +Proof. +split; [apply find_1|apply find_2]. +Qed. + +Lemma not_find_mapsto_iff : forall m x, ~In x m <-> find x m = None. +Proof. +intros. +generalize (find_mapsto_iff m x); destruct (find x m). +split; intros; try discriminate. +destruct H0. +exists e; rewrite H; auto. +split; auto. +intros; intros (e,H1). +rewrite H in H1; discriminate. +Qed. + +Lemma mem_in_iff : forall m x, In x m <-> mem x m = true. +Proof. +split; [apply mem_1|apply mem_2]. +Qed. + +Lemma not_mem_in_iff : forall m x, ~In x m <-> mem x m = false. +Proof. +intros; rewrite mem_in_iff; destruct (mem x m); intuition. +Qed. + +Lemma equal_iff : forall m m' cmp, Equal cmp m m' <-> equal cmp m m' = true. +Proof. +split; [apply equal_1|apply equal_2]. +Qed. + +Lemma empty_mapsto_iff : forall x e, MapsTo x e (empty elt) <-> False. +Proof. +intuition; apply (empty_1 H). +Qed. + +Lemma empty_in_iff : forall x, In x (empty elt) <-> False. +Proof. +unfold In. +split; [intros (e,H); rewrite empty_mapsto_iff in H|]; intuition. +Qed. + +Lemma is_empty_iff : forall m, Empty m <-> is_empty m = true. +Proof. +split; [apply is_empty_1|apply is_empty_2]. +Qed. + +Lemma add_mapsto_iff : forall m x y e e', + MapsTo y e' (add x e m) <-> + (E.eq x y /\ e=e') \/ + (~E.eq x y /\ MapsTo y e' m). +Proof. +intros. +intuition. +destruct (E.eq_dec x y); [left|right]. +split; auto. +symmetry; apply (MapsTo_fun (e':=e) H); auto. +split; auto; apply add_3 with x e; auto. +subst; auto. +Qed. + +Lemma add_in_iff : forall m x y e, In y (add x e m) <-> E.eq x y \/ In y m. +Proof. +unfold In; split. +intros (e',H). +destruct (E.eq_dec x y) as [E|E]; auto. +right; exists e'; auto. +apply (add_3 E H). +destruct (E.eq_dec x y) as [E|E]; auto. +intros. +exists e; apply add_1; auto. +intros [H|(e',H)]. +destruct E; auto. +exists e'; apply add_2; auto. +Qed. + +Lemma add_neq_mapsto_iff : forall m x y e e', + ~ E.eq x y -> (MapsTo y e' (add x e m) <-> MapsTo y e' m). +Proof. +split; [apply add_3|apply add_2]; auto. +Qed. + +Lemma add_neq_in_iff : forall m x y e, + ~ E.eq x y -> (In y (add x e m) <-> In y m). +Proof. +split; intros (e',H0); exists e'. +apply (add_3 H H0). +apply add_2; auto. +Qed. + +Lemma remove_mapsto_iff : forall m x y e, + MapsTo y e (remove x m) <-> ~E.eq x y /\ MapsTo y e m. +Proof. +intros. +split; intros. +split. +assert (In y (remove x m)) by (exists e; auto). +intro H1; apply (remove_1 H1 H0). +apply remove_3 with x; auto. +apply remove_2; intuition. +Qed. + +Lemma remove_in_iff : forall m x y, In y (remove x m) <-> ~E.eq x y /\ In y m. +Proof. +unfold In; split. +intros (e,H). +split. +assert (In y (remove x m)) by (exists e; auto). +intro H1; apply (remove_1 H1 H0). +exists e; apply remove_3 with x; auto. +intros (H,(e,H0)); exists e; apply remove_2; auto. +Qed. + +Lemma remove_neq_mapsto_iff : forall m x y e, + ~ E.eq x y -> (MapsTo y e (remove x m) <-> MapsTo y e m). +Proof. +split; [apply remove_3|apply remove_2]; auto. +Qed. + +Lemma remove_neq_in_iff : forall m x y, + ~ E.eq x y -> (In y (remove x m) <-> In y m). +Proof. +split; intros (e',H0); exists e'. +apply (remove_3 H0). +apply remove_2; auto. +Qed. + +Lemma elements_mapsto_iff : forall m x e, + MapsTo x e m <-> InA (@eq_key_elt _) (x,e) (elements m). +Proof. +split; [apply elements_1 | apply elements_2]. +Qed. + +Lemma elements_in_iff : forall m x, + In x m <-> exists e, InA (@eq_key_elt _) (x,e) (elements m). +Proof. +unfold In; split; intros (e,H); exists e; [apply elements_1 | apply elements_2]; auto. +Qed. + +Lemma map_mapsto_iff : forall m x b (f : elt -> elt'), + MapsTo x b (map f m) <-> exists a, b = f a /\ MapsTo x a m. +Proof. +split. +case_eq (find x m); intros. +exists e. +split. +apply (MapsTo_fun (m:=map f m) (x:=x)); auto. +apply find_2; auto. +assert (In x (map f m)) by (exists b; auto). +destruct (map_2 H1) as (a,H2). +rewrite (find_1 H2) in H; discriminate. +intros (a,(H,H0)). +subst b; auto. +Qed. + +Lemma map_in_iff : forall m x (f : elt -> elt'), + In x (map f m) <-> In x m. +Proof. +split; intros; eauto. +destruct H as (a,H). +exists (f a); auto. +Qed. + +Lemma mapi_in_iff : forall m x (f:key->elt->elt'), + In x (mapi f m) <-> In x m. +Proof. +split; intros; eauto. +destruct H as (a,H). +destruct (mapi_1 f H) as (y,(H0,H1)). +exists (f y a); auto. +Qed. + +(* Unfortunately, we don't have simple equivalences for [mapi] + and [MapsTo]. The only correct one needs compatibility of [f]. *) + +Lemma mapi_inv : forall m x b (f : key -> elt -> elt'), + MapsTo x b (mapi f m) -> + exists a, exists y, E.eq y x /\ b = f y a /\ MapsTo x a m. +Proof. +intros; case_eq (find x m); intros. +exists e. +destruct (@mapi_1 _ _ m x e f) as (y,(H1,H2)). +apply find_2; auto. +exists y; repeat split; auto. +apply (MapsTo_fun (m:=mapi f m) (x:=x)); auto. +assert (In x (mapi f m)) by (exists b; auto). +destruct (mapi_2 H1) as (a,H2). +rewrite (find_1 H2) in H0; discriminate. +Qed. + +Lemma mapi_1bis : forall m x e (f:key->elt->elt'), + (forall x y e, E.eq x y -> f x e = f y e) -> + MapsTo x e m -> MapsTo x (f x e) (mapi f m). +Proof. +intros. +destruct (mapi_1 f H0) as (y,(H1,H2)). +replace (f x e) with (f y e) by auto. +auto. +Qed. + +Lemma mapi_mapsto_iff : forall m x b (f:key->elt->elt'), + (forall x y e, E.eq x y -> f x e = f y e) -> + (MapsTo x b (mapi f m) <-> exists a, b = f x a /\ MapsTo x a m). +Proof. +split. +intros. +destruct (mapi_inv H0) as (a,(y,(H1,(H2,H3)))). +exists a; split; auto. +subst b; auto. +intros (a,(H0,H1)). +subst b. +apply mapi_1bis; auto. +Qed. + +(** Things are even worse for [map2] : we don't try to state any + equivalence, see instead boolean results below. *) + +End IffSpec. + +(** Useful tactic for simplifying expressions like [In y (add x e (remove z m))] *) + +Ltac map_iff := + repeat (progress ( + rewrite add_mapsto_iff || rewrite add_in_iff || + rewrite remove_mapsto_iff || rewrite remove_in_iff || + rewrite empty_mapsto_iff || rewrite empty_in_iff || + rewrite map_mapsto_iff || rewrite map_in_iff || + rewrite mapi_in_iff)). + +(** * Specifications written using boolean predicates *) + +Section BoolSpec. + +Definition eqb x y := if E.eq_dec x y then true else false. + +Lemma mem_find_b : forall (elt:Set)(m:t elt)(x:key), mem x m = if find x m then true else false. +Proof. +intros. +generalize (find_mapsto_iff m x)(mem_in_iff m x); unfold In. +destruct (find x m); destruct (mem x m); auto. +intros. +rewrite <- H0; exists e; rewrite H; auto. +intuition. +destruct H0 as (e,H0). +destruct (H e); intuition discriminate. +Qed. + +Variable elt elt' elt'' : Set. +Implicit Types m : t elt. +Implicit Types x y z : key. +Implicit Types e : elt. + +Lemma mem_b : forall m x y, E.eq x y -> mem x m = mem y m. +Proof. +intros. +generalize (mem_in_iff m x) (mem_in_iff m y)(In_iff m H). +destruct (mem x m); destruct (mem y m); intuition. +Qed. + +Lemma find_o : forall m x y, E.eq x y -> find x m = find y m. +Proof. +intros. +generalize (find_mapsto_iff m x) (find_mapsto_iff m y) (fun e => MapsTo_iff m e H). +destruct (find x m); destruct (find y m); intros. +rewrite <- H0; rewrite H2; rewrite H1; auto. +symmetry; rewrite <- H1; rewrite <- H2; rewrite H0; auto. +rewrite <- H0; rewrite H2; rewrite H1; auto. +auto. +Qed. + +Lemma empty_o : forall x, find x (empty elt) = None. +Proof. +intros. +case_eq (find x (empty elt)); intros; auto. +generalize (find_2 H). +rewrite empty_mapsto_iff; intuition. +Qed. + +Lemma empty_a : forall x, mem x (empty elt) = false. +Proof. +intros. +case_eq (mem x (empty elt)); intros; auto. +generalize (mem_2 H). +rewrite empty_in_iff; intuition. +Qed. + +Lemma add_eq_o : forall m x y e, + E.eq x y -> find y (add x e m) = Some e. +Proof. +auto. +Qed. + +Lemma add_neq_o : forall m x y e, + ~ E.eq x y -> find y (add x e m) = find y m. +Proof. +intros. +case_eq (find y m); intros; auto. +case_eq (find y (add x e m)); intros; auto. +rewrite <- H0; symmetry. +apply find_1; apply add_3 with x e; auto. +Qed. +Hint Resolve add_neq_o. + +Lemma add_o : forall m x y e, + find y (add x e m) = if E.eq_dec x y then Some e else find y m. +Proof. +intros; destruct (E.eq_dec x y); auto. +Qed. + +Lemma add_eq_b : forall m x y e, + E.eq x y -> mem y (add x e m) = true. +Proof. +intros; rewrite mem_find_b; rewrite add_eq_o; auto. +Qed. + +Lemma add_neq_b : forall m x y e, + ~E.eq x y -> mem y (add x e m) = mem y m. +Proof. +intros; do 2 rewrite mem_find_b; rewrite add_neq_o; auto. +Qed. + +Lemma add_b : forall m x y e, + mem y (add x e m) = eqb x y || mem y m. +Proof. +intros; do 2 rewrite mem_find_b; rewrite add_o; unfold eqb. +destruct (E.eq_dec x y); simpl; auto. +Qed. + +Lemma remove_eq_o : forall m x y, + E.eq x y -> find y (remove x m) = None. +Proof. +intros. +generalize (remove_1 (m:=m) H). +generalize (find_mapsto_iff (remove x m) y). +destruct (find y (remove x m)); auto. +destruct 2. +exists e; rewrite H0; auto. +Qed. +Hint Resolve remove_eq_o. + +Lemma remove_neq_o : forall m x y, + ~ E.eq x y -> find y (remove x m) = find y m. +Proof. +intros. +case_eq (find y m); intros; auto. +case_eq (find y (remove x m)); intros; auto. +rewrite <- H0; symmetry. +apply find_1; apply remove_3 with x; auto. +Qed. +Hint Resolve remove_neq_o. + +Lemma remove_o : forall m x y, + find y (remove x m) = if E.eq_dec x y then None else find y m. +Proof. +intros; destruct (E.eq_dec x y); auto. +Qed. + +Lemma remove_eq_b : forall m x y, + E.eq x y -> mem y (remove x m) = false. +Proof. +intros; rewrite mem_find_b; rewrite remove_eq_o; auto. +Qed. + +Lemma remove_neq_b : forall m x y, + ~ E.eq x y -> mem y (remove x m) = mem y m. +Proof. +intros; do 2 rewrite mem_find_b; rewrite remove_neq_o; auto. +Qed. + +Lemma remove_b : forall m x y, + mem y (remove x m) = negb (eqb x y) && mem y m. +Proof. +intros; do 2 rewrite mem_find_b; rewrite remove_o; unfold eqb. +destruct (E.eq_dec x y); auto. +Qed. + +Definition option_map (A:Set)(B:Set)(f:A->B)(o:option A) : option B := + match o with + | Some a => Some (f a) + | None => None + end. + +Lemma map_o : forall m x (f:elt->elt'), + find x (map f m) = option_map f (find x m). +Proof. +intros. +generalize (find_mapsto_iff (map f m) x) (find_mapsto_iff m x) + (fun b => map_mapsto_iff m x b f). +destruct (find x (map f m)); destruct (find x m); simpl; auto; intros. +rewrite <- H; rewrite H1; exists e0; rewrite H0; auto. +destruct (H e) as [_ H2]. +rewrite H1 in H2. +destruct H2 as (a,(_,H2)); auto. +rewrite H0 in H2; discriminate. +rewrite <- H; rewrite H1; exists e; rewrite H0; auto. +Qed. + +Lemma map_b : forall m x (f:elt->elt'), + mem x (map f m) = mem x m. +Proof. +intros; do 2 rewrite mem_find_b; rewrite map_o. +destruct (find x m); simpl; auto. +Qed. + +Lemma mapi_b : forall m x (f:key->elt->elt'), + mem x (mapi f m) = mem x m. +Proof. +intros. +generalize (mem_in_iff (mapi f m) x) (mem_in_iff m x) (mapi_in_iff m x f). +destruct (mem x (mapi f m)); destruct (mem x m); simpl; auto; intros. +symmetry; rewrite <- H0; rewrite <- H1; rewrite H; auto. +rewrite <- H; rewrite H1; rewrite H0; auto. +Qed. + +Lemma mapi_o : forall m x (f:key->elt->elt'), + (forall x y e, E.eq x y -> f x e = f y e) -> + find x (mapi f m) = option_map (f x) (find x m). +Proof. +intros. +generalize (find_mapsto_iff (mapi f m) x) (find_mapsto_iff m x) + (fun b => mapi_mapsto_iff m x b H). +destruct (find x (mapi f m)); destruct (find x m); simpl; auto; intros. +rewrite <- H0; rewrite H2; exists e0; rewrite H1; auto. +destruct (H0 e) as [_ H3]. +rewrite H2 in H3. +destruct H3 as (a,(_,H3)); auto. +rewrite H1 in H3; discriminate. +rewrite <- H0; rewrite H2; exists e; rewrite H1; auto. +Qed. + +Lemma map2_1bis : forall (m: t elt)(m': t elt') x + (f:option elt->option elt'->option elt''), + f None None = None -> + find x (map2 f m m') = f (find x m) (find x m'). +Proof. +intros. +case_eq (find x m); intros. +rewrite <- H0. +apply map2_1; auto. +left; exists e; auto. +case_eq (find x m'); intros. +rewrite <- H0; rewrite <- H1. +apply map2_1; auto. +right; exists e; auto. +rewrite H. +case_eq (find x (map2 f m m')); intros; auto. +assert (In x (map2 f m m')) by (exists e; auto). +destruct (map2_2 H3) as [(e0,H4)|(e0,H4)]. +rewrite (find_1 H4) in H0; discriminate. +rewrite (find_1 H4) in H1; discriminate. +Qed. + +Fixpoint findA (A B:Set)(f : A -> bool) (l:list (A*B)) : option B := + match l with + | nil => None + | (a,b)::l => if f a then Some b else findA f l + end. + +Lemma findA_NoDupA : + forall (A B:Set) + (eqA:A->A->Prop) + (eqA_sym: forall a b, eqA a b -> eqA b a) + (eqA_trans: forall a b c, eqA a b -> eqA b c -> eqA a c) + (eqA_dec : forall a a', { eqA a a' }+{~eqA a a' }) + (l:list (A*B))(x:A)(e:B), + NoDupA (fun p p' => eqA (fst p) (fst p')) l -> + (InA (fun p p' => eqA (fst p) (fst p') /\ snd p = snd p') (x,e) l <-> + findA (fun y:A => if eqA_dec x y then true else false) l = Some e). +Proof. +induction l; simpl; intros. +split; intros; try discriminate. +inversion H0. +destruct a as (y,e'). +inversion_clear H. +split; intros. +inversion_clear H. +simpl in *; destruct H2; subst e'. +destruct (eqA_dec x y); intuition. +destruct (eqA_dec x y); simpl. +destruct H0. +generalize e0 H2 eqA_trans eqA_sym; clear. +induction l. +inversion 2. +inversion_clear 2; intros; auto. +destruct a. +compute in H; destruct H. +subst b. +constructor 1; auto. +simpl. +apply eqA_trans with x; auto. +rewrite <- IHl; auto. +destruct (eqA_dec x y); simpl in *. +inversion H; clear H; intros; subst e'; auto. +constructor 2. +rewrite IHl; auto. +Qed. + +Lemma elements_o : forall m x, + find x m = findA (eqb x) (elements m). +Proof. +intros. +assert (forall e, find x m = Some e <-> InA (eq_key_elt (elt:=elt)) (x,e) (elements m)). + intros; rewrite <- find_mapsto_iff; apply elements_mapsto_iff. +assert (NoDupA (eq_key (elt:=elt)) (elements m)). + exact (elements_3 m). +generalize (fun e => @findA_NoDupA _ _ _ E.eq_sym E.eq_trans E.eq_dec (elements m) x e H0). +unfold eqb. +destruct (find x m); destruct (findA (fun y : E.t => if E.eq_dec x y then true else false) (elements m)); + simpl; auto; intros. +symmetry; rewrite <- H1; rewrite <- H; auto. +symmetry; rewrite <- H1; rewrite <- H; auto. +rewrite H; rewrite H1; auto. +Qed. + +Lemma elements_b : forall m x, mem x m = existsb (fun p => eqb x (fst p)) (elements m). +Proof. +intros. +generalize (mem_in_iff m x)(elements_in_iff m x) + (existsb_exists (fun p => eqb x (fst p)) (elements m)). +destruct (mem x m); destruct (existsb (fun p => eqb x (fst p)) (elements m)); auto; intros. +symmetry; rewrite H1. +destruct H0 as (H0,_). +destruct H0 as (e,He); [ intuition |]. +rewrite InA_alt in He. +destruct He as ((y,e'),(Ha1,Ha2)). +compute in Ha1; destruct Ha1; subst e'. +exists (y,e); split; simpl; auto. +unfold eqb; destruct (E.eq_dec x y); intuition. +rewrite <- H; rewrite H0. +destruct H1 as (H1,_). +destruct H1 as ((y,e),(Ha1,Ha2)); [intuition|]. +simpl in Ha2. +unfold eqb in *; destruct (E.eq_dec x y); auto; try discriminate. +exists e; rewrite InA_alt. +exists (y,e); intuition. +compute; auto. +Qed. + +End BoolSpec. + +End Facts. diff --git a/theories/FSets/FMapWeakList.v b/theories/FSets/FMapWeakList.v index ce3893e0..3a91b868 100644 --- a/theories/FSets/FMapWeakList.v +++ b/theories/FSets/FMapWeakList.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -(* $Id: FMapWeakList.v 8639 2006-03-16 19:21:55Z letouzey $ *) +(* $Id: FMapWeakList.v 8899 2006-06-06 11:09:43Z jforest $ *) (** * Finite map library *) @@ -24,7 +24,7 @@ Arguments Scope list [type_scope]. Module Raw (X:DecidableType). -Module PX := PairDecidableType X. +Module PX := KeyDecidableType X. Import PX. Definition key := X.t. @@ -34,7 +34,7 @@ Section Elt. Variable elt : Set. -(* now in PairDecidableType: +(* now in KeyDecidableType: Definition eqk (p p':key*elt) := X.eq (fst p) (fst p'). Definition eqke (p p':key*elt) := X.eq (fst p) (fst p') /\ (snd p) = (snd p'). @@ -91,7 +91,7 @@ Qed. (** * [mem] *) -Fixpoint mem (k : key) (s : t elt) {struct s} : bool := +Function mem (k : key) (s : t elt) {struct s} : bool := match s with | nil => false | (k',_) :: l => if X.eq_dec k k' then true else mem k l @@ -100,30 +100,30 @@ Fixpoint mem (k : key) (s : t elt) {struct s} : bool := Lemma mem_1 : forall m (Hm:NoDupA m) x, In x m -> mem x m = true. Proof. intros m Hm x; generalize Hm; clear Hm. - functional induction mem x m;intros NoDup belong1;trivial. + functional induction (mem x m);intros NoDup belong1;trivial. inversion belong1. inversion H. inversion_clear NoDup. inversion_clear belong1. - inversion_clear H3. - compute in H4; destruct H4. - elim H; auto. - apply H0; auto. - exists x; auto. + inversion_clear H2. + compute in H3; destruct H3. + contradiction. + apply IHb; auto. + exists x0; auto. Qed. Lemma mem_2 : forall m (Hm:NoDupA m) x, mem x m = true -> In x m. Proof. intros m Hm x; generalize Hm; clear Hm; unfold PX.In,PX.MapsTo. - functional induction mem x m; intros NoDup hyp; try discriminate. - exists e; auto. + functional induction (mem x m); intros NoDup hyp; try discriminate. + exists _x; auto. inversion_clear NoDup. - destruct H0; auto. - exists x; auto. + destruct IHb; auto. + exists x0; auto. Qed. (** * [find] *) -Fixpoint find (k:key) (s: t elt) {struct s} : option elt := +Function find (k:key) (s: t elt) {struct s} : option elt := match s with | nil => None | (k',x)::s' => if X.eq_dec k k' then Some x else find k s' @@ -132,23 +132,23 @@ Fixpoint find (k:key) (s: t elt) {struct s} : option elt := Lemma find_2 : forall m x e, find x m = Some e -> MapsTo x e m. Proof. intros m x. unfold PX.MapsTo. - functional induction find x m;simpl;intros e' eqfind; inversion eqfind; auto. + functional induction (find x m);simpl;intros e' eqfind; inversion eqfind; auto. Qed. Lemma find_1 : forall m (Hm:NoDupA m) x e, MapsTo x e m -> find x m = Some e. Proof. intros m Hm x e; generalize Hm; clear Hm; unfold PX.MapsTo. - functional induction find x m;simpl; subst; try clear H_eq_1. + functional induction (find x m);simpl; subst; try clear H_eq_1. inversion 2. do 2 inversion_clear 1. compute in H3; destruct H3; subst; trivial. - elim H0; apply InA_eqk with (k,e); auto. + elim H; apply InA_eqk with (x,e); auto. do 2 inversion_clear 1; auto. - compute in H4; destruct H4; elim H; auto. + compute in H3; destruct H3; elim _x; auto. Qed. (* Not part of the exported specifications, used later for [combine]. *) @@ -166,7 +166,7 @@ Qed. (** * [add] *) -Fixpoint add (k : key) (x : elt) (s : t elt) {struct s} : t elt := +Function add (k : key) (x : elt) (s : t elt) {struct s} : t elt := match s with | nil => (k,x) :: nil | (k',y) :: l => if X.eq_dec k k' then (k,x)::l else (k',y)::add k x l @@ -175,26 +175,26 @@ Fixpoint add (k : key) (x : elt) (s : t elt) {struct s} : t elt := Lemma add_1 : forall m x y e, X.eq x y -> MapsTo y e (add x e m). Proof. intros m x y e; generalize y; clear y; unfold PX.MapsTo. - functional induction add x e m;simpl;auto. + functional induction (add x e m);simpl;auto. Qed. Lemma add_2 : forall m x y e e', ~ X.eq x y -> MapsTo y e m -> MapsTo y e (add x e' m). Proof. intros m x y e e'; generalize y e; clear y e; unfold PX.MapsTo. - functional induction add x e' m;simpl;auto. - intros y' e' eqky'; inversion_clear 1. + functional induction (add x e' m);simpl;auto. + intros y' e'' eqky'; inversion_clear 1. destruct H1; simpl in *. elim eqky'; apply X.eq_trans with k'; auto. auto. - intros y' e' eqky'; inversion_clear 1; intuition. + intros y' e'' eqky'; inversion_clear 1; intuition. Qed. Lemma add_3 : forall m x y e e', ~ X.eq x y -> MapsTo y e (add x e' m) -> MapsTo y e m. Proof. intros m x y e e'. generalize y e; clear y e; unfold PX.MapsTo. - functional induction add x e' m;simpl;auto. + functional induction (add x e' m);simpl;auto. intros; apply (In_inv_3 H0); auto. constructor 2; apply (In_inv_3 H1); auto. inversion_clear 2; auto. @@ -204,12 +204,12 @@ Lemma add_3' : forall m x y e e', ~ X.eq x y -> InA eqk (y,e) (add x e' m) -> InA eqk (y,e) m. Proof. intros m x y e e'. generalize y e; clear y e. - functional induction add x e' m;simpl;auto. + functional induction (add x e' m);simpl;auto. inversion_clear 2. compute in H1; elim H; auto. inversion H1. constructor 2; inversion_clear H1; auto. - compute in H2; elim H0; auto. + compute in H2; elim H; auto. inversion_clear 2; auto. Qed. @@ -257,7 +257,7 @@ Qed. (** * [remove] *) -Fixpoint remove (k : key) (s : t elt) {struct s} : t elt := +Function remove (k : key) (s : t elt) {struct s} : t elt := match s with | nil => nil | (k',x) :: l => if X.eq_dec k k' then l else (k',x) :: remove k l @@ -266,7 +266,7 @@ Fixpoint remove (k : key) (s : t elt) {struct s} : t elt := Lemma remove_1 : forall m (Hm:NoDupA m) x y, X.eq x y -> ~ In y (remove x m). Proof. intros m Hm x y; generalize Hm; clear Hm. - functional induction remove x m;simpl;intros;auto. + functional induction (remove x m);simpl;intros;auto. red; inversion 1; inversion H1. @@ -275,14 +275,14 @@ Proof. swap H1. destruct H3 as (e,H3); unfold PX.MapsTo in H3. apply InA_eqk with (y,e); auto. - compute; apply X.eq_trans with k; auto. + compute; apply X.eq_trans with x; auto. intro H2. destruct H2 as (e,H2); inversion_clear H2. - compute in H3; destruct H3. - elim H; apply X.eq_trans with y; auto. + compute in H1; destruct H1. + elim _x; apply X.eq_trans with y; auto. inversion_clear Hm. - elim (H0 H4 H1). + elim (IHt0 H3 H). exists e; auto. Qed. @@ -290,10 +290,10 @@ Lemma remove_2 : forall m (Hm:NoDupA m) x y e, ~ X.eq x y -> MapsTo y e m -> MapsTo y e (remove x m). Proof. intros m Hm x y e; generalize Hm; clear Hm; unfold PX.MapsTo. - functional induction remove x m;auto. + functional induction (remove x m);auto. inversion_clear 3; auto. compute in H2; destruct H2. - elim H0; apply X.eq_trans with k'; auto. + elim H; apply X.eq_trans with k'; auto. inversion_clear 1; inversion_clear 2; auto. Qed. @@ -302,7 +302,7 @@ Lemma remove_3 : forall m (Hm:NoDupA m) x y e, MapsTo y e (remove x m) -> MapsTo y e m. Proof. intros m Hm x y e; generalize Hm; clear Hm; unfold PX.MapsTo. - functional induction remove x m;auto. + functional induction (remove x m);auto. do 2 inversion_clear 1; auto. Qed. @@ -310,7 +310,7 @@ Lemma remove_3' : forall m (Hm:NoDupA m) x y e, InA eqk (y,e) (remove x m) -> InA eqk (y,e) m. Proof. intros m Hm x y e; generalize Hm; clear Hm; unfold PX.MapsTo. - functional induction remove x m;auto. + functional induction (remove x m);auto. do 2 inversion_clear 1; auto. Qed. @@ -347,8 +347,7 @@ Qed. (** * [fold] *) -Fixpoint fold (A:Set)(f:key->elt->A->A)(m:t elt) {struct m} : A -> A := - fun acc => +Function fold (A:Set)(f:key->elt->A->A)(m:t elt) (acc : A) {struct m} : A := match m with | nil => acc | (k,e)::m' => fold f m' (f k e acc) @@ -357,7 +356,7 @@ Fixpoint fold (A:Set)(f:key->elt->A->A)(m:t elt) {struct m} : A -> A := Lemma fold_1 : forall m (A:Set)(i:A)(f:key->elt->A->A), fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (elements m) i. Proof. - intros; functional induction fold A f m i; auto. + intros; functional induction (@fold A f m i); auto. Qed. (** * [equal] *) @@ -878,83 +877,124 @@ Module Make (X: DecidableType) <: S with Module E:=X. Module Raw := Raw X. Module E := X. - Definition key := X.t. + Definition key := E.t. Record slist (elt:Set) : Set := {this :> Raw.t elt; NoDup : NoDupA (@Raw.PX.eqk elt) this}. Definition t (elt:Set) := slist elt. - Section Elt. +Section Elt. Variable elt elt' elt'':Set. Implicit Types m : t elt. - - Definition empty := Build_slist (Raw.empty_NoDup elt). - Definition is_empty m := Raw.is_empty m.(this). - Definition add x e m := Build_slist (Raw.add_NoDup m.(NoDup) x e). - Definition find x m := Raw.find x m.(this). - Definition remove x m := Build_slist (Raw.remove_NoDup m.(NoDup) x). - Definition mem x m := Raw.mem x m.(this). + Implicit Types x y : key. + Implicit Types e : elt. + + Definition empty : t elt := Build_slist (Raw.empty_NoDup elt). + Definition is_empty m : bool := Raw.is_empty m.(this). + Definition add x e m : t elt := Build_slist (Raw.add_NoDup m.(NoDup) x e). + Definition find x m : option elt := Raw.find x m.(this). + Definition remove x m : t elt := Build_slist (Raw.remove_NoDup m.(NoDup) x). + Definition mem x m : bool := Raw.mem x m.(this). Definition map f m : t elt' := Build_slist (Raw.map_NoDup m.(NoDup) f). - Definition mapi f m : t elt' := Build_slist (Raw.mapi_NoDup m.(NoDup) f). + Definition mapi (f:key->elt->elt') m : t elt' := Build_slist (Raw.mapi_NoDup m.(NoDup) f). Definition map2 f m (m':t elt') : t elt'' := - Build_slist (Raw.map2_NoDup f m.(NoDup) m'.(NoDup)). - Definition elements m := @Raw.elements elt m.(this). - Definition fold A f m i := @Raw.fold elt A f m.(this) i. - Definition equal cmp m m' := @Raw.equal elt cmp m.(this) m'.(this). - - Definition MapsTo x e m := Raw.PX.MapsTo x e m.(this). - Definition In x m := Raw.PX.In x m.(this). - Definition Empty m := Raw.Empty m.(this). - Definition Equal cmp m m' := @Raw.Equal elt cmp m.(this) m'.(this). + Build_slist (Raw.map2_NoDup f m.(NoDup) m'.(NoDup)). + Definition elements m : list (key*elt) := @Raw.elements elt m.(this). + Definition fold (A:Set)(f:key->elt->A->A) m (i:A) : A := @Raw.fold elt A f m.(this) i. + Definition equal cmp m m' : bool := @Raw.equal elt cmp m.(this) m'.(this). + + Definition MapsTo x e m : Prop := Raw.PX.MapsTo x e m.(this). + Definition In x m : Prop := Raw.PX.In x m.(this). + Definition Empty m : Prop := Raw.Empty m.(this). + Definition Equal cmp m m' : Prop := @Raw.Equal elt cmp m.(this) m'.(this). + + Definition eq_key : (key*elt) -> (key*elt) -> Prop := @Raw.PX.eqk elt. + Definition eq_key_elt : (key*elt) -> (key*elt) -> Prop:= @Raw.PX.eqke elt. + + Lemma MapsTo_1 : forall m x y e, E.eq x y -> MapsTo x e m -> MapsTo y e m. + Proof. intros m; exact (@Raw.PX.MapsTo_eq elt m.(this)). Qed. + + Lemma mem_1 : forall m x, In x m -> mem x m = true. + Proof. intros m; exact (@Raw.mem_1 elt m.(this) m.(NoDup)). Qed. + Lemma mem_2 : forall m x, mem x m = true -> In x m. + Proof. intros m; exact (@Raw.mem_2 elt m.(this) m.(NoDup)). Qed. + + Lemma empty_1 : Empty empty. + Proof. exact (@Raw.empty_1 elt). Qed. + + Lemma is_empty_1 : forall m, Empty m -> is_empty m = true. + Proof. intros m; exact (@Raw.is_empty_1 elt m.(this)). Qed. + Lemma is_empty_2 : forall m, is_empty m = true -> Empty m. + Proof. intros m; exact (@Raw.is_empty_2 elt m.(this)). Qed. + + Lemma add_1 : forall m x y e, E.eq x y -> MapsTo y e (add x e m). + Proof. intros m; exact (@Raw.add_1 elt m.(this)). Qed. + Lemma add_2 : forall m x y e e', ~ E.eq x y -> MapsTo y e m -> MapsTo y e (add x e' m). + Proof. intros m; exact (@Raw.add_2 elt m.(this)). Qed. + Lemma add_3 : forall m x y e e', ~ E.eq x y -> MapsTo y e (add x e' m) -> MapsTo y e m. + Proof. intros m; exact (@Raw.add_3 elt m.(this)). Qed. + + Lemma remove_1 : forall m x y, E.eq x y -> ~ In y (remove x m). + Proof. intros m; exact (@Raw.remove_1 elt m.(this) m.(NoDup)). Qed. + Lemma remove_2 : forall m x y e, ~ E.eq x y -> MapsTo y e m -> MapsTo y e (remove x m). + Proof. intros m; exact (@Raw.remove_2 elt m.(this) m.(NoDup)). Qed. + Lemma remove_3 : forall m x y e, MapsTo y e (remove x m) -> MapsTo y e m. + Proof. intros m; exact (@Raw.remove_3 elt m.(this) m.(NoDup)). Qed. + + Lemma find_1 : forall m x e, MapsTo x e m -> find x m = Some e. + Proof. intros m; exact (@Raw.find_1 elt m.(this) m.(NoDup)). Qed. + Lemma find_2 : forall m x e, find x m = Some e -> MapsTo x e m. + Proof. intros m; exact (@Raw.find_2 elt m.(this)). Qed. + + Lemma elements_1 : forall m x e, MapsTo x e m -> InA eq_key_elt (x,e) (elements m). + Proof. intros m; exact (@Raw.elements_1 elt m.(this)). Qed. + Lemma elements_2 : forall m x e, InA eq_key_elt (x,e) (elements m) -> MapsTo x e m. + Proof. intros m; exact (@Raw.elements_2 elt m.(this)). Qed. + Lemma elements_3 : forall m, NoDupA eq_key (elements m). + Proof. intros m; exact (@Raw.elements_3 elt m.(this) m.(NoDup)). Qed. + + Lemma fold_1 : forall m (A : Set) (i : A) (f : key -> elt -> A -> A), + fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (elements m) i. + Proof. intros m; exact (@Raw.fold_1 elt m.(this)). Qed. + + Lemma equal_1 : forall m m' cmp, Equal cmp m m' -> equal cmp m m' = true. + Proof. intros m m'; exact (@Raw.equal_1 elt m.(this) m.(NoDup) m'.(this) m'.(NoDup)). Qed. + Lemma equal_2 : forall m m' cmp, equal cmp m m' = true -> Equal cmp m m'. + Proof. intros m m'; exact (@Raw.equal_2 elt m.(this) m.(NoDup) m'.(this) m'.(NoDup)). Qed. - Definition eq_key (p p':key*elt) := X.eq (fst p) (fst p'). + End Elt. - Definition eq_key_elt (p p':key*elt) := - X.eq (fst p) (fst p') /\ (snd p) = (snd p'). - - Definition MapsTo_1 m := @Raw.PX.MapsTo_eq elt m.(this). - - Definition mem_1 m := @Raw.mem_1 elt m.(this) m.(NoDup). - Definition mem_2 m := @Raw.mem_2 elt m.(this) m.(NoDup). - - Definition empty_1 := @Raw.empty_1. - - Definition is_empty_1 m := @Raw.is_empty_1 elt m.(this). - Definition is_empty_2 m := @Raw.is_empty_2 elt m.(this). - - Definition add_1 m := @Raw.add_1 elt m.(this). - Definition add_2 m := @Raw.add_2 elt m.(this). - Definition add_3 m := @Raw.add_3 elt m.(this). + Lemma map_1 : forall (elt elt':Set)(m: t elt)(x:key)(e:elt)(f:elt->elt'), + MapsTo x e m -> MapsTo x (f e) (map f m). + Proof. intros elt elt' m; exact (@Raw.map_1 elt elt' m.(this)). Qed. + Lemma map_2 : forall (elt elt':Set)(m: t elt)(x:key)(f:elt->elt'), + In x (map f m) -> In x m. + Proof. intros elt elt' m; exact (@Raw.map_2 elt elt' m.(this)). Qed. + + Lemma mapi_1 : forall (elt elt':Set)(m: t elt)(x:key)(e:elt) + (f:key->elt->elt'), MapsTo x e m -> + exists y, E.eq y x /\ MapsTo x (f y e) (mapi f m). + Proof. intros elt elt' m; exact (@Raw.mapi_1 elt elt' m.(this)). Qed. + Lemma mapi_2 : forall (elt elt':Set)(m: t elt)(x:key) + (f:key->elt->elt'), In x (mapi f m) -> In x m. + Proof. intros elt elt' m; exact (@Raw.mapi_2 elt elt' m.(this)). Qed. + + Lemma map2_1 : forall (elt elt' elt'':Set)(m: t elt)(m': t elt') + (x:key)(f:option elt->option elt'->option elt''), + In x m \/ In x m' -> + find x (map2 f m m') = f (find x m) (find x m'). + Proof. + intros elt elt' elt'' m m' x f; + exact (@Raw.map2_1 elt elt' elt'' f m.(this) m.(NoDup) m'.(this) m'.(NoDup) x). + Qed. + Lemma map2_2 : forall (elt elt' elt'':Set)(m: t elt)(m': t elt') + (x:key)(f:option elt->option elt'->option elt''), + In x (map2 f m m') -> In x m \/ In x m'. + Proof. + intros elt elt' elt'' m m' x f; + exact (@Raw.map2_2 elt elt' elt'' f m.(this) m.(NoDup) m'.(this) m'.(NoDup) x). + Qed. - Definition remove_1 m := @Raw.remove_1 elt m.(this) m.(NoDup). - Definition remove_2 m := @Raw.remove_2 elt m.(this) m.(NoDup). - Definition remove_3 m := @Raw.remove_3 elt m.(this) m.(NoDup). - - Definition find_1 m := @Raw.find_1 elt m.(this) m.(NoDup). - Definition find_2 m := @Raw.find_2 elt m.(this). - - Definition elements_1 m := @Raw.elements_1 elt m.(this). - Definition elements_2 m := @Raw.elements_2 elt m.(this). - Definition elements_3 m := @Raw.elements_3 elt m.(this) m.(NoDup). - - Definition fold_1 m := @Raw.fold_1 elt m.(this). - - Definition map_1 m := @Raw.map_1 elt elt' m.(this). - Definition map_2 m := @Raw.map_2 elt elt' m.(this). - - Definition mapi_1 m := @Raw.mapi_1 elt elt' m.(this). - Definition mapi_2 m := @Raw.mapi_2 elt elt' m.(this). - - Definition map2_1 m (m':t elt') x f := - @Raw.map2_1 elt elt' elt'' f m.(this) m.(NoDup) m'.(this) m'.(NoDup) x. - Definition map2_2 m (m':t elt') x f := - @Raw.map2_2 elt elt' elt'' f m.(this) m.(NoDup) m'.(this) m'.(NoDup) x. - - Definition equal_1 m m' := @Raw.equal_1 elt m.(this) m.(NoDup) m'.(this) m'.(NoDup). - Definition equal_2 m m' := @Raw.equal_2 elt m.(this) m.(NoDup) m'.(this) m'.(NoDup). - - End Elt. End Make. - diff --git a/theories/FSets/FMaps.v b/theories/FSets/FMaps.v index ae5b86c9..72ccad3f 100644 --- a/theories/FSets/FMaps.v +++ b/theories/FSets/FMaps.v @@ -6,7 +6,13 @@ (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -(* $Id: FMaps.v 8667 2006-03-28 11:59:44Z letouzey $ *) +(* $Id: FMaps.v 8844 2006-05-22 17:22:36Z letouzey $ *) +Require Export OrderedType. +Require Export OrderedTypeEx. +Require Export OrderedTypeAlt. Require Export FMapInterface. Require Export FMapList. +Require Export FMapPositive. +Require Export FMapIntMap. +Require Export FMapFacts.
\ No newline at end of file diff --git a/theories/FSets/FSetAVL.v b/theories/FSets/FSetAVL.v new file mode 100644 index 00000000..b385f50e --- /dev/null +++ b/theories/FSets/FSetAVL.v @@ -0,0 +1,2900 @@ + +(***********************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * INRIA-Rocquencourt & LRI-CNRS-Orsay *) +(* \VV/ *************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(***********************************************************************) + +(* Finite sets library. + * Authors: Pierre Letouzey and Jean-Christophe Filliâtre + * Institution: LRI, CNRS UMR 8623 - Université Paris Sud + * 91405 Orsay, France *) + +(* $Id: FSetAVL.v 8899 2006-06-06 11:09:43Z jforest $ *) + +(** This module implements sets using AVL trees. + It follows the implementation from Ocaml's standard library. *) + +Require Import FSetInterface. +Require Import FSetList. +Require Import ZArith. +Require Import Int. + +Set Firstorder Depth 3. + +Module Raw (I:Int)(X:OrderedType). +Import I. +Module II:=MoreInt(I). +Import II. +Open Scope Int_scope. + +Module E := X. +Module MX := OrderedTypeFacts X. + +Definition elt := X.t. + +(** * Trees *) + +Inductive tree : Set := + | Leaf : tree + | Node : tree -> X.t -> tree -> int -> tree. + +Notation t := tree. + +(** The fourth field of [Node] is the height of the tree *) + +(** A tactic to repeat [inversion_clear] on all hyps of the + form [(f (Node _ _ _ _))] *) +Ltac inv f := + match goal with + | H:f Leaf |- _ => inversion_clear H; inv f + | H:f _ Leaf |- _ => inversion_clear H; inv f + | H:f (Node _ _ _ _) |- _ => inversion_clear H; inv f + | H:f _ (Node _ _ _ _) |- _ => inversion_clear H; inv f + | _ => idtac + end. + +(** Same, but with a backup of the original hypothesis. *) + +Ltac safe_inv f := match goal with + | H:f (Node _ _ _ _) |- _ => + generalize H; inversion_clear H; safe_inv f + | _ => intros + end. + +(** * Occurrence in a tree *) + +Inductive In (x : elt) : tree -> Prop := + | IsRoot : + forall (l r : tree) (h : int) (y : elt), + X.eq x y -> In x (Node l y r h) + | InLeft : + forall (l r : tree) (h : int) (y : elt), + In x l -> In x (Node l y r h) + | InRight : + forall (l r : tree) (h : int) (y : elt), + In x r -> In x (Node l y r h). + +Hint Constructors In. + +Ltac intuition_in := repeat progress (intuition; inv In). + +(** [In] is compatible with [X.eq] *) + +Lemma In_1 : + forall s x y, X.eq x y -> In x s -> In y s. +Proof. + induction s; simpl; intuition_in; eauto. +Qed. +Hint Immediate In_1. + +(** * Binary search trees *) + +(** [lt_tree x s]: all elements in [s] are smaller than [x] + (resp. greater for [gt_tree]) *) + +Definition lt_tree (x : elt) (s : tree) := + forall y:elt, In y s -> X.lt y x. +Definition gt_tree (x : elt) (s : tree) := + forall y:elt, In y s -> X.lt x y. + +Hint Unfold lt_tree gt_tree. + +Ltac order := match goal with + | H: lt_tree ?x ?s, H1: In ?y ?s |- _ => generalize (H _ H1); clear H; order + | H: gt_tree ?x ?s, H1: In ?y ?s |- _ => generalize (H _ H1); clear H; order + | _ => MX.order +end. + +(** Results about [lt_tree] and [gt_tree] *) + +Lemma lt_leaf : forall x : elt, lt_tree x Leaf. +Proof. + unfold lt_tree in |- *; intros; inversion H. +Qed. + +Lemma gt_leaf : forall x : elt, gt_tree x Leaf. +Proof. + unfold gt_tree in |- *; intros; inversion H. +Qed. + +Lemma lt_tree_node : + forall (x y : elt) (l r : tree) (h : int), + lt_tree x l -> lt_tree x r -> X.lt y x -> lt_tree x (Node l y r h). +Proof. + unfold lt_tree in *; intuition_in; order. +Qed. + +Lemma gt_tree_node : + forall (x y : elt) (l r : tree) (h : int), + gt_tree x l -> gt_tree x r -> X.lt x y -> gt_tree x (Node l y r h). +Proof. + unfold gt_tree in *; intuition_in; order. +Qed. + +Hint Resolve lt_leaf gt_leaf lt_tree_node gt_tree_node. + +Lemma lt_tree_not_in : + forall (x : elt) (t : tree), lt_tree x t -> ~ In x t. +Proof. + intros; intro; order. +Qed. + +Lemma lt_tree_trans : + forall x y, X.lt x y -> forall t, lt_tree x t -> lt_tree y t. +Proof. + firstorder eauto. +Qed. + +Lemma gt_tree_not_in : + forall (x : elt) (t : tree), gt_tree x t -> ~ In x t. +Proof. + intros; intro; order. +Qed. + +Lemma gt_tree_trans : + forall x y, X.lt y x -> forall t, gt_tree x t -> gt_tree y t. +Proof. + firstorder eauto. +Qed. + +Hint Resolve lt_tree_not_in lt_tree_trans gt_tree_not_in gt_tree_trans. + +(** [bst t] : [t] is a binary search tree *) + +Inductive bst : tree -> Prop := + | BSLeaf : bst Leaf + | BSNode : + forall (x : elt) (l r : tree) (h : int), + bst l -> bst r -> lt_tree x l -> gt_tree x r -> bst (Node l x r h). + +Hint Constructors bst. + +(** * AVL trees *) + +(** [avl s] : [s] is a properly balanced AVL tree, + i.e. for any node the heights of the two children + differ by at most 2 *) + +Definition height (s : tree) : int := + match s with + | Leaf => 0 + | Node _ _ _ h => h + end. + +Inductive avl : tree -> Prop := + | RBLeaf : avl Leaf + | RBNode : + forall (x : elt) (l r : tree) (h : int), + avl l -> + avl r -> + -(2) <= height l - height r <= 2 -> + h = max (height l) (height r) + 1 -> + avl (Node l x r h). + +Hint Constructors avl. + +(** Results about [avl] *) + +Lemma avl_node : + forall (x : elt) (l r : tree), + avl l -> + avl r -> + -(2) <= height l - height r <= 2 -> + avl (Node l x r (max (height l) (height r) + 1)). +Proof. + intros; auto. +Qed. +Hint Resolve avl_node. + +(** The tactics *) + +Lemma height_non_negative : forall s : tree, avl s -> height s >= 0. +Proof. + induction s; simpl; intros; auto with zarith. + inv avl; intuition; omega_max. +Qed. +Implicit Arguments height_non_negative. + +(** When [H:avl r], typing [avl_nn H] or [avl_nn r] adds [height r>=0] *) + +Ltac avl_nn_hyp H := + let nz := fresh "nz" in assert (nz := height_non_negative H). + +Ltac avl_nn h := + let t := type of h in + match type of t with + | Prop => avl_nn_hyp h + | _ => match goal with H : avl h |- _ => avl_nn_hyp H end + end. + +(* Repeat the previous tactic. + Drawback: need to clear the [avl _] hyps ... Thank you Ltac *) + +Ltac avl_nns := + match goal with + | H:avl _ |- _ => avl_nn_hyp H; clear H; avl_nns + | _ => idtac + end. + +(** * Some shortcuts. *) + +Definition Equal s s' := forall a : elt, In a s <-> In a s'. +Definition Subset s s' := forall a : elt, In a s -> In a s'. +Definition Empty s := forall a : elt, ~ In a s. +Definition For_all (P : elt -> Prop) s := forall x, In x s -> P x. +Definition Exists (P : elt -> Prop) s := exists x, In x s /\ P x. + +(** * Empty set *) + +Definition empty := Leaf. + +Lemma empty_bst : bst empty. +Proof. + auto. +Qed. + +Lemma empty_avl : avl empty. +Proof. + auto. +Qed. + +Lemma empty_1 : Empty empty. +Proof. + intro; intro. + inversion H. +Qed. + +(** * Emptyness test *) + +Definition is_empty (s:t) := match s with Leaf => true | _ => false end. + +Lemma is_empty_1 : forall s, Empty s -> is_empty s = true. +Proof. + destruct s as [|r x l h]; simpl; auto. + intro H; elim (H x); auto. +Qed. + +Lemma is_empty_2 : forall s, is_empty s = true -> Empty s. +Proof. + destruct s; simpl; intros; try discriminate; red; auto. +Qed. + +(** * Appartness *) + +(** The [mem] function is deciding appartness. It exploits the [bst] property + to achieve logarithmic complexity. *) + +Function mem (x:elt)(s:t) { struct s } : bool := + match s with + | Leaf => false + | Node l y r _ => match X.compare x y with + | LT _ => mem x l + | EQ _ => true + | GT _ => mem x r + end + end. + +Lemma mem_1 : forall s x, bst s -> In x s -> mem x s = true. +Proof. + intros s x. + functional induction (mem x s); inversion_clear 1; auto. + inversion_clear 1. + inversion_clear 1; auto; absurd (X.lt x y); eauto. + inversion_clear 1; auto; absurd (X.lt y x); eauto. +Qed. + +Lemma mem_2 : forall s x, mem x s = true -> In x s. +Proof. + intros s x. + functional induction (mem x s); auto; intros; try discriminate. +Qed. + +(** * Singleton set *) + +Definition singleton (x : elt) := Node Leaf x Leaf 1. + +Lemma singleton_bst : forall x : elt, bst (singleton x). +Proof. + unfold singleton; auto. +Qed. + +Lemma singleton_avl : forall x : elt, avl (singleton x). +Proof. + unfold singleton; intro. + constructor; auto; try red; simpl; omega_max. +Qed. + +Lemma singleton_1 : forall x y, In y (singleton x) -> X.eq x y. +Proof. + unfold singleton; inversion_clear 1; auto; inversion_clear H0. +Qed. + +Lemma singleton_2 : forall x y, X.eq x y -> In y (singleton x). +Proof. + unfold singleton; auto. +Qed. + +(** * Helper functions *) + +(** [create l x r] creates a node, assuming [l] and [r] + to be balanced and [|height l - height r| <= 2]. *) + +Definition create l x r := + Node l x r (max (height l) (height r) + 1). + +Lemma create_bst : + forall l x r, bst l -> bst r -> lt_tree x l -> gt_tree x r -> + bst (create l x r). +Proof. + unfold create; auto. +Qed. +Hint Resolve create_bst. + +Lemma create_avl : + forall l x r, avl l -> avl r -> -(2) <= height l - height r <= 2 -> + avl (create l x r). +Proof. + unfold create; auto. +Qed. + +Lemma create_height : + forall l x r, avl l -> avl r -> -(2) <= height l - height r <= 2 -> + height (create l x r) = max (height l) (height r) + 1. +Proof. + unfold create; intros; auto. +Qed. + +Lemma create_in : + forall l x r y, In y (create l x r) <-> X.eq y x \/ In y l \/ In y r. +Proof. + unfold create; split; [ inversion_clear 1 | ]; intuition. +Qed. + +(** trick for emulating [assert false] in Coq *) + +Definition assert_false := Leaf. + +(** [bal l x r] acts as [create], but performs one step of + rebalancing if necessary, i.e. assumes [|height l - height r| <= 3]. *) + +Definition bal l x r := + let hl := height l in + let hr := height r in + if gt_le_dec hl (hr+2) then + match l with + | Leaf => assert_false + | Node ll lx lr _ => + if ge_lt_dec (height ll) (height lr) then + create ll lx (create lr x r) + else + match lr with + | Leaf => assert_false + | Node lrl lrx lrr _ => + create (create ll lx lrl) lrx (create lrr x r) + end + end + else + if gt_le_dec hr (hl+2) then + match r with + | Leaf => assert_false + | Node rl rx rr _ => + if ge_lt_dec (height rr) (height rl) then + create (create l x rl) rx rr + else + match rl with + | Leaf => assert_false + | Node rll rlx rlr _ => + create (create l x rll) rlx (create rlr rx rr) + end + end + else + create l x r. + +Ltac bal_tac := + intros l x r; + unfold bal; + destruct (gt_le_dec (height l) (height r + 2)); + [ destruct l as [ |ll lx lr lh]; + [ | destruct (ge_lt_dec (height ll) (height lr)); + [ | destruct lr ] ] + | destruct (gt_le_dec (height r) (height l + 2)); + [ destruct r as [ |rl rx rr rh]; + [ | destruct (ge_lt_dec (height rr) (height rl)); + [ | destruct rl ] ] + | ] ]; intros. + +Lemma bal_bst : forall l x r, bst l -> bst r -> + lt_tree x l -> gt_tree x r -> bst (bal l x r). +Proof. + (* intros l x r; functional induction bal l x r. MARCHE PAS !*) + bal_tac; + inv bst; repeat apply create_bst; auto; unfold create; + apply lt_tree_node || apply gt_tree_node; auto; + eapply lt_tree_trans || eapply gt_tree_trans || eauto; eauto. +Qed. + +Lemma bal_avl : forall l x r, avl l -> avl r -> + -(3) <= height l - height r <= 3 -> avl (bal l x r). +Proof. + bal_tac; inv avl; repeat apply create_avl; simpl in *; auto; omega_max. +Qed. + +Lemma bal_height_1 : forall l x r, avl l -> avl r -> + -(3) <= height l - height r <= 3 -> + 0 <= height (bal l x r) - max (height l) (height r) <= 1. +Proof. + bal_tac; inv avl; avl_nns; simpl in *; omega_max. +Qed. + +Lemma bal_height_2 : + forall l x r, avl l -> avl r -> -(2) <= height l - height r <= 2 -> + height (bal l x r) == max (height l) (height r) +1. +Proof. + bal_tac; inv avl; simpl in *; omega_max. +Qed. + +Lemma bal_in : forall l x r y, avl l -> avl r -> + (In y (bal l x r) <-> X.eq y x \/ In y l \/ In y r). +Proof. + bal_tac; + solve [repeat rewrite create_in; intuition_in + |inv avl; avl_nns; simpl in *; false_omega]. +Qed. + +Ltac omega_bal := match goal with + | H:avl ?l, H':avl ?r |- context [ bal ?l ?x ?r ] => + generalize (bal_height_1 l x r H H') (bal_height_2 l x r H H'); + omega_max + end. + +(** * Insertion *) + +Function add (x:elt)(s:t) { struct s } : t := match s with + | Leaf => Node Leaf x Leaf 1 + | Node l y r h => + match X.compare x y with + | LT _ => bal (add x l) y r + | EQ _ => Node l y r h + | GT _ => bal l y (add x r) + end + end. + +Lemma add_avl_1 : forall s x, avl s -> + avl (add x s) /\ 0 <= height (add x s) - height s <= 1. +Proof. + intros s x; functional induction (add x s); subst;intros; inv avl; simpl in *. + intuition; try constructor; simpl; auto; try omega_max. + (* LT *) + destruct IHt; auto. + split. + apply bal_avl; auto; omega_max. + omega_bal. + (* EQ *) + intuition; omega_max. + (* GT *) + destruct IHt; auto. + split. + apply bal_avl; auto; omega_max. + omega_bal. +Qed. + +Lemma add_avl : forall s x, avl s -> avl (add x s). +Proof. + intros; generalize (add_avl_1 s x H); intuition. +Qed. +Hint Resolve add_avl. + +Lemma add_in : forall s x y, avl s -> + (In y (add x s) <-> X.eq y x \/ In y s). +Proof. + intros s x; functional induction (add x s); auto; intros. + intuition_in. + (* LT *) + inv avl. + rewrite bal_in; auto. + rewrite (IHt y0 H1); intuition_in. + (* EQ *) + inv avl. + intuition. + eapply In_1; eauto. + (* GT *) + inv avl. + rewrite bal_in; auto. + rewrite (IHt y0 H2); intuition_in. +Qed. + +Lemma add_bst : forall s x, bst s -> avl s -> bst (add x s). +Proof. + intros s x; functional induction (add x s); auto; intros. + inv bst; inv avl; apply bal_bst; auto. + (* lt_tree -> lt_tree (add ...) *) + red; red in H5. + intros. + rewrite (add_in l x y0 H) in H1. + intuition. + eauto. + inv bst; inv avl; apply bal_bst; auto. + (* gt_tree -> gt_tree (add ...) *) + red; red in H5. + intros. + rewrite (add_in r x y0 H6) in H1. + intuition. + apply MX.lt_eq with x; auto. +Qed. + +(** * Join + + Same as [bal] but does not assume anything regarding heights + of [l] and [r]. +*) + +Fixpoint join (l:t) : elt -> t -> t := + match l with + | Leaf => add + | Node ll lx lr lh => fun x => + fix join_aux (r:t) : t := match r with + | Leaf => add x l + | Node rl rx rr rh => + if gt_le_dec lh (rh+2) then bal ll lx (join lr x r) + else if gt_le_dec rh (lh+2) then bal (join_aux rl) rx rr + else create l x r + end + end. + +Ltac join_tac := + intro l; induction l as [| ll _ lx lr Hlr lh]; + [ | intros x r; induction r as [| rl Hrl rx rr _ rh]; unfold join; + [ | destruct (gt_le_dec lh (rh+2)); + [ match goal with |- context b [ bal ?a ?b ?c] => + replace (bal a b c) + with (bal ll lx (join lr x (Node rl rx rr rh))); [ | auto] + end + | destruct (gt_le_dec rh (lh+2)); + [ match goal with |- context b [ bal ?a ?b ?c] => + replace (bal a b c) + with (bal (join (Node ll lx lr lh) x rl) rx rr); [ | auto] + end + | ] ] ] ]; intros. + +Lemma join_avl_1 : forall l x r, avl l -> avl r -> avl (join l x r) /\ + 0<= height (join l x r) - max (height l) (height r) <= 1. +Proof. + (* intros l x r; functional induction join l x r. AUTRE PROBLEME! *) + join_tac. + + split; simpl; auto. + destruct (add_avl_1 r x H0). + avl_nns; omega_max. + split; auto. + set (l:=Node ll lx lr lh) in *. + destruct (add_avl_1 l x H). + simpl (height Leaf). + avl_nns; omega_max. + + inversion_clear H. + assert (height (Node rl rx rr rh) = rh); auto. + set (r := Node rl rx rr rh) in *; clearbody r. + destruct (Hlr x r H2 H0); clear Hrl Hlr. + set (j := join lr x r) in *; clearbody j. + simpl. + assert (-(3) <= height ll - height j <= 3) by omega_max. + split. + apply bal_avl; auto. + omega_bal. + + inversion_clear H0. + assert (height (Node ll lx lr lh) = lh); auto. + set (l := Node ll lx lr lh) in *; clearbody l. + destruct (Hrl H H1); clear Hrl Hlr. + set (j := join l x rl) in *; clearbody j. + simpl. + assert (-(3) <= height j - height rr <= 3) by omega_max. + split. + apply bal_avl; auto. + omega_bal. + + clear Hrl Hlr. + assert (height (Node ll lx lr lh) = lh); auto. + assert (height (Node rl rx rr rh) = rh); auto. + set (l := Node ll lx lr lh) in *; clearbody l. + set (r := Node rl rx rr rh) in *; clearbody r. + assert (-(2) <= height l - height r <= 2) by omega_max. + split. + apply create_avl; auto. + rewrite create_height; auto; omega_max. +Qed. + +Lemma join_avl : forall l x r, avl l -> avl r -> avl (join l x r). +Proof. + intros; generalize (join_avl_1 l x r H H0); intuition. +Qed. +Hint Resolve join_avl. + +Lemma join_in : forall l x r y, avl l -> avl r -> + (In y (join l x r) <-> X.eq y x \/ In y l \/ In y r). +Proof. + join_tac. + simpl. + rewrite add_in; intuition_in. + + rewrite add_in; intuition_in. + + inv avl. + rewrite bal_in; auto. + rewrite Hlr; clear Hlr Hrl; intuition_in. + + inv avl. + rewrite bal_in; auto. + rewrite Hrl; clear Hlr Hrl; intuition_in. + + apply create_in. +Qed. + +Lemma join_bst : forall l x r, bst l -> avl l -> bst r -> avl r -> + lt_tree x l -> gt_tree x r -> bst (join l x r). +Proof. + join_tac. + apply add_bst; auto. + apply add_bst; auto. + + inv bst; safe_inv avl. + apply bal_bst; auto. + clear Hrl Hlr H13 H14 H16 H17 z; intro; intros. + set (r:=Node rl rx rr rh) in *; clearbody r. + rewrite (join_in lr x r y) in H13; auto. + intuition. + apply MX.lt_eq with x; eauto. + eauto. + + inv bst; safe_inv avl. + apply bal_bst; auto. + clear Hrl Hlr H13 H14 H16 H17 z; intro; intros. + set (l:=Node ll lx lr lh) in *; clearbody l. + rewrite (join_in l x rl y) in H13; auto. + intuition. + apply MX.eq_lt with x; eauto. + eauto. + + apply create_bst; auto. +Qed. + +(** * Extraction of minimum element + + morally, [remove_min] is to be applied to a non-empty tree + [t = Node l x r h]. Since we can't deal here with [assert false] + for [t=Leaf], we pre-unpack [t] (and forget about [h]). +*) + +Function remove_min (l:t)(x:elt)(r:t) { struct l } : t*elt := + match l with + | Leaf => (r,x) + | Node ll lx lr lh => let (l',m) := (remove_min ll lx lr : t*elt) in (bal l' x r, m) + end. + +Lemma remove_min_avl_1 : forall l x r h, avl (Node l x r h) -> + avl (fst (remove_min l x r)) /\ + 0 <= height (Node l x r h) - height (fst (remove_min l x r)) <= 1. +Proof. + intros l x r; functional induction (remove_min l x r); subst;simpl in *; intros. + inv avl; simpl in *; split; auto. + avl_nns; omega_max. + (* l = Node *) + inversion_clear H. + rewrite H0 in IHp;simpl in IHp;destruct (IHp lh); auto. + split; simpl in *. + apply bal_avl; auto; omega_max. + omega_bal. +Qed. + +Lemma remove_min_avl : forall l x r h, avl (Node l x r h) -> + avl (fst (remove_min l x r)). +Proof. + intros; generalize (remove_min_avl_1 l x r h H); intuition. +Qed. + +Lemma remove_min_in : forall l x r h y, avl (Node l x r h) -> + (In y (Node l x r h) <-> + X.eq y (snd (remove_min l x r)) \/ In y (fst (remove_min l x r))). +Proof. + intros l x r; functional induction (remove_min l x r); simpl in *; intros. + intuition_in. + (* l = Node *) + inversion_clear H. + generalize (remove_min_avl ll lx lr lh H1). + rewrite H0; simpl; intros. + rewrite bal_in; auto. + rewrite H0 in IHp;generalize (IHp lh y H1). + intuition. + inversion_clear H8; intuition. +Qed. + +Lemma remove_min_bst : forall l x r h, + bst (Node l x r h) -> avl (Node l x r h) -> bst (fst (remove_min l x r)). +Proof. + intros l x r; functional induction (remove_min l x r); subst;simpl in *; intros. + inv bst; auto. + inversion_clear H; inversion_clear H1. + rewrite_all H0;simpl in *. + apply bal_bst; auto. + firstorder. + intro; intros. + generalize (remove_min_in ll lx lr lh y H). + rewrite H0; simpl. + destruct 1. + apply H4; intuition. +Qed. + +Lemma remove_min_gt_tree : forall l x r h, + bst (Node l x r h) -> avl (Node l x r h) -> + gt_tree (snd (remove_min l x r)) (fst (remove_min l x r)). +Proof. + intros l x r; functional induction (remove_min l x r); subst;simpl in *; intros. + inv bst; auto. + inversion_clear H; inversion_clear H1. + intro; intro. + generalize (IHp lh H2 H); clear H8 H7 IHp. + generalize (remove_min_avl ll lx lr lh H). + generalize (remove_min_in ll lx lr lh m H). + rewrite H0; simpl; intros. + rewrite (bal_in l' x r y H8 H6) in H1. + destruct H7. + firstorder. + apply MX.lt_eq with x; auto. + apply X.lt_trans with x; auto. +Qed. + +(** * Merging two trees + + [merge t1 t2] builds the union of [t1] and [t2] assuming all elements + of [t1] to be smaller than all elements of [t2], and + [|height t1 - height t2| <= 2]. +*) + +Function merge (s1 s2 :t) : t:= match s1,s2 with + | Leaf, _ => s2 + | _, Leaf => s1 + | _, Node l2 x2 r2 h2 => + let (s2',m) := remove_min l2 x2 r2 in bal s1 m s2' +end. + +Lemma merge_avl_1 : forall s1 s2, avl s1 -> avl s2 -> + -(2) <= height s1 - height s2 <= 2 -> + avl (merge s1 s2) /\ + 0<= height (merge s1 s2) - max (height s1) (height s2) <=1. +Proof. + intros s1 s2; functional induction (merge s1 s2); subst;simpl in *; intros. + split; auto; avl_nns; omega_max. + split; auto; avl_nns; simpl in *; omega_max. + destruct s1;try contradiction;clear H1. + generalize (remove_min_avl_1 l2 x2 r2 h2 H0). + rewrite H2; simpl; destruct 1. + split. + apply bal_avl; auto. + simpl; omega_max. + omega_bal. +Qed. + +Lemma merge_avl : forall s1 s2, avl s1 -> avl s2 -> + -(2) <= height s1 - height s2 <= 2 -> avl (merge s1 s2). +Proof. + intros; generalize (merge_avl_1 s1 s2 H H0 H1); intuition. +Qed. + +Lemma merge_in : forall s1 s2 y, bst s1 -> avl s1 -> bst s2 -> avl s2 -> + (In y (merge s1 s2) <-> In y s1 \/ In y s2). +Proof. + intros s1 s2; functional induction (merge s1 s2); subst; simpl in *; intros. + intuition_in. + intuition_in. + destruct s1;try contradiction;clear H1. + replace s2' with (fst (remove_min l2 x2 r2)); [|rewrite H2; auto]. + rewrite bal_in; auto. + generalize (remove_min_avl l2 x2 r2 h2); rewrite H2; simpl; auto. + generalize (remove_min_in l2 x2 r2 h2 y); rewrite H2; simpl; intro. + rewrite H1; intuition. +Qed. + +Lemma merge_bst : forall s1 s2, bst s1 -> avl s1 -> bst s2 -> avl s2 -> + (forall y1 y2 : elt, In y1 s1 -> In y2 s2 -> X.lt y1 y2) -> + bst (merge s1 s2). +Proof. + intros s1 s2; functional induction (merge s1 s2); subst;simpl in *; intros; auto. + destruct s1;try contradiction;clear H1. + apply bal_bst; auto. + generalize (remove_min_bst l2 x2 r2 h2); rewrite H2; simpl in *; auto. + intro; intro. + apply H5; auto. + generalize (remove_min_in l2 x2 r2 h2 m); rewrite H2; simpl; intuition. + generalize (remove_min_gt_tree l2 x2 r2 h2); rewrite H2; simpl; auto. +Qed. + +(** * Deletion *) + +Function remove (x:elt)(s:tree) { struct s } : t := match s with + | Leaf => Leaf + | Node l y r h => + match X.compare x y with + | LT _ => bal (remove x l) y r + | EQ _ => merge l r + | GT _ => bal l y (remove x r) + end + end. + +Lemma remove_avl_1 : forall s x, avl s -> + avl (remove x s) /\ 0 <= height s - height (remove x s) <= 1. +Proof. + intros s x; functional induction (remove x s); subst;simpl; intros. + intuition; omega_max. + (* LT *) + inv avl. + destruct (IHt H1). + split. + apply bal_avl; auto. + omega_max. + omega_bal. + (* EQ *) + inv avl. + generalize (merge_avl_1 l r H1 H2 H3). + intuition omega_max. + (* GT *) + inv avl. + destruct (IHt H2). + split. + apply bal_avl; auto. + omega_max. + omega_bal. +Qed. + +Lemma remove_avl : forall s x, avl s -> avl (remove x s). +Proof. + intros; generalize (remove_avl_1 s x H); intuition. +Qed. +Hint Resolve remove_avl. + +Lemma remove_in : forall s x y, bst s -> avl s -> + (In y (remove x s) <-> ~ X.eq y x /\ In y s). +Proof. + intros s x; functional induction (remove x s); subst;simpl; intros. + intuition_in. + (* LT *) + inv avl; inv bst; clear H0. + rewrite bal_in; auto. + generalize (IHt y0 H1); intuition; [ order | order | intuition_in ]. + (* EQ *) + inv avl; inv bst; clear H0. + rewrite merge_in; intuition; [ order | order | intuition_in ]. + elim H9; eauto. + (* GT *) + inv avl; inv bst; clear H0. + rewrite bal_in; auto. + generalize (IHt y0 H6); intuition; [ order | order | intuition_in ]. +Qed. + +Lemma remove_bst : forall s x, bst s -> avl s -> bst (remove x s). +Proof. + intros s x; functional induction (remove x s); simpl; intros. + auto. + (* LT *) + inv avl; inv bst. + apply bal_bst; auto. + intro; intro. + rewrite (remove_in l x y0) in H; auto. + destruct H; eauto. + (* EQ *) + inv avl; inv bst. + apply merge_bst; eauto. + (* GT *) + inv avl; inv bst. + apply bal_bst; auto. + intro; intro. + rewrite (remove_in r x y0) in H; auto. + destruct H; eauto. +Qed. + + (** * Minimum element *) + +Function min_elt (s:t) : option elt := match s with + | Leaf => None + | Node Leaf y _ _ => Some y + | Node l _ _ _ => min_elt l +end. + +Lemma min_elt_1 : forall s x, min_elt s = Some x -> In x s. +Proof. + intro s; functional induction (min_elt s); subst; simpl. + inversion 1. + inversion 1; auto. + intros. + destruct l; auto. +Qed. + +Lemma min_elt_2 : forall s x y, bst s -> + min_elt s = Some x -> In y s -> ~ X.lt y x. +Proof. + intro s; functional induction (min_elt s); subst;simpl. + inversion_clear 2. + inversion_clear 1. + inversion 1; subst. + inversion_clear 1; auto. + inversion_clear H5. + destruct l;try contradiction. + inversion_clear 1. + simpl. + destruct l1. + inversion 1; subst. + assert (X.lt x _x) by (apply H3; auto). + inversion_clear 1; auto; order. + assert (X.lt t _x) by auto. + inversion_clear 2; auto; + (assert (~ X.lt t x) by auto); order. +Qed. + +Lemma min_elt_3 : forall s, min_elt s = None -> Empty s. +Proof. + intro s; functional induction (min_elt s); subst;simpl. + red; auto. + inversion 1. + destruct l;try contradiction. + clear H0;intro H0. + destruct (IHo H0 t); auto. +Qed. + + +(** * Maximum element *) + +Function max_elt (s:t) : option elt := match s with + | Leaf => None + | Node _ y Leaf _ => Some y + | Node _ _ r _ => max_elt r +end. + +Lemma max_elt_1 : forall s x, max_elt s = Some x -> In x s. +Proof. + intro s; functional induction (max_elt s); subst;simpl. + inversion 1. + inversion 1; auto. + destruct r;try contradiction; auto. +Qed. + +Lemma max_elt_2 : forall s x y, bst s -> + max_elt s = Some x -> In y s -> ~ X.lt x y. +Proof. + intro s; functional induction (max_elt s); subst;simpl. + inversion_clear 2. + inversion_clear 1. + inversion 1; subst. + inversion_clear 1; auto. + inversion_clear H5. + destruct r;try contradiction. + inversion_clear 1. +(* inversion 1; subst. *) +(* assert (X.lt y x) by (apply H4; auto). *) +(* inversion_clear 1; auto; order. *) + assert (X.lt _x0 t) by auto. + inversion_clear 2; auto; + (assert (~ X.lt x t) by auto); order. +Qed. + +Lemma max_elt_3 : forall s, max_elt s = None -> Empty s. +Proof. + intro s; functional induction (max_elt s); subst;simpl. + red; auto. + inversion 1. + destruct r;try contradiction. + clear H0;intros H0; destruct (IHo H0 t); auto. +Qed. + +(** * Any element *) + +Definition choose := min_elt. + +Lemma choose_1 : forall s x, choose s = Some x -> In x s. +Proof. + exact min_elt_1. +Qed. + +Lemma choose_2 : forall s, choose s = None -> Empty s. +Proof. + exact min_elt_3. +Qed. + +(** * Concatenation + + Same as [merge] but does not assume anything about heights. +*) + +Function concat (s1 s2 : t) : t := + match s1, s2 with + | Leaf, _ => s2 + | _, Leaf => s1 + | _, Node l2 x2 r2 h2 => + let (s2',m) := remove_min l2 x2 r2 in + join s1 m s2' + end. + +Lemma concat_avl : forall s1 s2, avl s1 -> avl s2 -> avl (concat s1 s2). +Proof. + intros s1 s2; functional induction (concat s1 s2); subst;auto. + destruct s1;try contradiction;clear H1. + intros; apply join_avl; auto. + generalize (remove_min_avl l2 x2 r2 h2 H0); rewrite H2; simpl; auto. +Qed. + +Lemma concat_bst : forall s1 s2, bst s1 -> avl s1 -> bst s2 -> avl s2 -> + (forall y1 y2 : elt, In y1 s1 -> In y2 s2 -> X.lt y1 y2) -> + bst (concat s1 s2). +Proof. + intros s1 s2; functional induction (concat s1 s2); subst ;auto. + destruct s1;try contradiction;clear H1. + intros; apply join_bst; auto. + generalize (remove_min_bst l2 x2 r2 h2 H1 H3); rewrite H2; simpl; auto. + generalize (remove_min_avl l2 x2 r2 h2 H3); rewrite H2; simpl; auto. + generalize (remove_min_in l2 x2 r2 h2 m H3); rewrite H2; simpl; auto. + destruct 1; intuition. + generalize (remove_min_gt_tree l2 x2 r2 h2 H1 H3); rewrite H2; simpl; auto. +Qed. + +Lemma concat_in : forall s1 s2 y, bst s1 -> avl s1 -> bst s2 -> avl s2 -> + (forall y1 y2 : elt, In y1 s1 -> In y2 s2 -> X.lt y1 y2) -> + (In y (concat s1 s2) <-> In y s1 \/ In y s2). +Proof. + intros s1 s2; functional induction (concat s1 s2);subst;simpl. + intuition. + inversion_clear H5. + destruct s1;try contradiction;clear H1;intuition. + inversion_clear H5. + destruct s1;try contradiction;clear H1; intros. + rewrite (join_in (Node s1_1 t s1_2 i) m s2' y H0). + generalize (remove_min_avl l2 x2 r2 h2 H3); rewrite H2; simpl; auto. + generalize (remove_min_in l2 x2 r2 h2 y H3); rewrite H2; simpl. + intro EQ; rewrite EQ; intuition. +Qed. + +(** * Splitting + + [split x s] returns a triple [(l, present, r)] where + - [l] is the set of elements of [s] that are [< x] + - [r] is the set of elements of [s] that are [> x] + - [present] is [true] if and only if [s] contains [x]. +*) + +Function split (x:elt)(s:t) {struct s} : t * (bool * t) := match s with + | Leaf => (Leaf, (false, Leaf)) + | Node l y r h => + match X.compare x y with + | LT _ => match split x l with + | (ll,(pres,rl)) => (ll, (pres, join rl y r)) + end + | EQ _ => (l, (true, r)) + | GT _ => match split x r with + | (rl,(pres,rr)) => (join l y rl, (pres, rr)) + end + end + end. + +Lemma split_avl : forall s x, avl s -> + avl (fst (split x s)) /\ avl (snd (snd (split x s))). +Proof. + intros s x; functional induction (split x s);subst;simpl in *. + auto. + rewrite H1 in IHp;simpl in IHp;inversion_clear 1; intuition. + simpl; inversion_clear 1; auto. + rewrite H1 in IHp;simpl in IHp;inversion_clear 1; intuition. +Qed. + +Lemma split_in_1 : forall s x y, bst s -> avl s -> + (In y (fst (split x s)) <-> In y s /\ X.lt y x). +Proof. + intros s x; functional induction (split x s);subst;simpl in *. + intuition; try inversion_clear H1. + (* LT *) + rewrite H1 in IHp;simpl in *; inversion_clear 1; inversion_clear 1; clear H8 H9. + rewrite (IHp y0 H2 H6); clear IHp H0. + intuition. + inversion_clear H0; auto; order. + (* EQ *) + simpl in *; inversion_clear 1; inversion_clear 1; clear H8 H7 H0. + intuition. + order. + intuition_in; order. + (* GT *) + rewrite H1 in IHp;simpl in *; inversion_clear 1; inversion_clear 1; clear H9 H8. + rewrite join_in; auto. + generalize (split_avl r x H7); rewrite H1; simpl; intuition. + rewrite (IHp y0 H3 H7); clear H1. + intuition; [ eauto | eauto | intuition_in ]. +Qed. + +Lemma split_in_2 : forall s x y, bst s -> avl s -> + (In y (snd (snd (split x s))) <-> In y s /\ X.lt x y). +Proof. + intros s x; functional induction (split x s);subst;simpl in *. + intuition; try inversion_clear H1. + (* LT *) + rewrite H1 in IHp; simpl in *; inversion_clear 1; inversion_clear 1; clear H9 H8. + rewrite join_in; auto. + generalize (split_avl l x H6); rewrite H1; simpl; intuition. + rewrite (IHp y0 H2 H6); clear IHp H0. + intuition; [ order | order | intuition_in ]. + (* EQ *) + simpl in *; inversion_clear 1; inversion_clear 1; clear H8 H7 H0. + intuition; [ order | intuition_in; order ]. + (* GT *) + rewrite H1 in IHp; simpl in *; inversion_clear 1; inversion_clear 1; clear H9 H8. + rewrite (IHp y0 H3 H7); clear IHp H0. + intuition; intuition_in; order. +Qed. + +Lemma split_in_3 : forall s x, bst s -> avl s -> + (fst (snd (split x s)) = true <-> In x s). +Proof. + intros s x; functional induction (split x s);subst;simpl in *. + intuition; try inversion_clear H1. + (* LT *) + rewrite H1 in IHp; simpl in *; inversion_clear 1; inversion_clear 1; clear H9 H8. + rewrite IHp; auto. + intuition_in; absurd (X.lt x y); eauto. + (* EQ *) + simpl in *; inversion_clear 1; inversion_clear 1; intuition. + (* GT *) + rewrite H1 in IHp; simpl in *; inversion_clear 1; inversion_clear 1; clear H9 H8. + rewrite IHp; auto. + intuition_in; absurd (X.lt y x); eauto. +Qed. + +Lemma split_bst : forall s x, bst s -> avl s -> + bst (fst (split x s)) /\ bst (snd (snd (split x s))). +Proof. + intros s x; functional induction (split x s);subst;simpl in *. + intuition. + (* LT *) + rewrite H1 in IHp; simpl in *; inversion_clear 1; inversion_clear 1. + intuition. + apply join_bst; auto. + generalize (split_avl l x H6); rewrite H1; simpl; intuition. + intro; intro. + generalize (split_in_2 l x y0 H2 H6); rewrite H1; simpl; intuition. + (* EQ *) + simpl in *; inversion_clear 1; inversion_clear 1; intuition. + (* GT *) + rewrite H1 in IHp; simpl in *; inversion_clear 1; inversion_clear 1. + intuition. + apply join_bst; auto. + generalize (split_avl r x H7); rewrite H1; simpl; intuition. + intro; intro. + generalize (split_in_1 r x y0 H3 H7); rewrite H1; simpl; intuition. +Qed. + +(** * Intersection *) + +Fixpoint inter (s1 s2 : t) {struct s1} : t := match s1, s2 with + | Leaf,_ => Leaf + | _,Leaf => Leaf + | Node l1 x1 r1 h1, _ => + match split x1 s2 with + | (l2',(true,r2')) => join (inter l1 l2') x1 (inter r1 r2') + | (l2',(false,r2')) => concat (inter l1 l2') (inter r1 r2') + end + end. + +Lemma inter_avl : forall s1 s2, avl s1 -> avl s2 -> avl (inter s1 s2). +Proof. + (* intros s1 s2; functional induction inter s1 s2; auto. BOF BOF *) + induction s1 as [ | l1 Hl1 x1 r1 Hr1 h1]; simpl; auto. + destruct s2 as [ | l2 x2 r2 h2]; intros; auto. + generalize H0; inv avl. + set (r:=Node l2 x2 r2 h2) in *; clearbody r; intros. + destruct (split_avl r x1 H8). + destruct (split x1 r) as [l2' (b,r2')]; simpl in *. + destruct b; [ apply join_avl | apply concat_avl ]; auto. +Qed. + +Lemma inter_bst_in : forall s1 s2, bst s1 -> avl s1 -> bst s2 -> avl s2 -> + bst (inter s1 s2) /\ (forall y, In y (inter s1 s2) <-> In y s1 /\ In y s2). +Proof. + induction s1 as [ | l1 Hl1 x1 r1 Hr1 h1]; simpl; auto. + intuition; inversion_clear H3. + destruct s2 as [ | l2 x2 r2 h2]; intros. + simpl; intuition; inversion_clear H3. + generalize H1 H2; inv avl; inv bst. + set (r:=Node l2 x2 r2 h2) in *; clearbody r; intros. + destruct (split_avl r x1 H17). + destruct (split_bst r x1 H16 H17). + split. + (* bst *) + destruct (split x1 r) as [l2' (b,r2')]; simpl in *. + destruct (Hl1 l2'); auto. + destruct (Hr1 r2'); auto. + destruct b. + (* bst join *) + apply join_bst; try apply inter_avl; firstorder. + (* bst concat *) + apply concat_bst; try apply inter_avl; auto. + intros; generalize (H22 y1) (H24 y2); intuition eauto. + (* in *) + intros. + destruct (split_in_1 r x1 y H16 H17). + destruct (split_in_2 r x1 y H16 H17). + destruct (split_in_3 r x1 H16 H17). + destruct (split x1 r) as [l2' (b,r2')]; simpl in *. + destruct (Hl1 l2'); auto. + destruct (Hr1 r2'); auto. + destruct b. + (* in join *) + rewrite join_in; try apply inter_avl; auto. + rewrite H30. + rewrite H28. + intuition_in. + apply In_1 with x1; auto. + (* in concat *) + rewrite concat_in; try apply inter_avl; auto. + intros. + intros; generalize (H28 y1) (H30 y2); intuition eauto. + rewrite H30. + rewrite H28. + intuition_in. + generalize (H26 (In_1 _ _ _ H22 H35)); intro; discriminate. +Qed. + +Lemma inter_bst : forall s1 s2, bst s1 -> avl s1 -> bst s2 -> avl s2 -> + bst (inter s1 s2). +Proof. + intros; generalize (inter_bst_in s1 s2); intuition. +Qed. + +Lemma inter_in : forall s1 s2 y, bst s1 -> avl s1 -> bst s2 -> avl s2 -> + (In y (inter s1 s2) <-> In y s1 /\ In y s2). +Proof. + intros; generalize (inter_bst_in s1 s2); firstorder. +Qed. + +(** * Difference *) + +Fixpoint diff (s1 s2 : t) { struct s1 } : t := match s1, s2 with + | Leaf, _ => Leaf + | _, Leaf => s1 + | Node l1 x1 r1 h1, _ => + match split x1 s2 with + | (l2',(true,r2')) => concat (diff l1 l2') (diff r1 r2') + | (l2',(false,r2')) => join (diff l1 l2') x1 (diff r1 r2') + end +end. + +Lemma diff_avl : forall s1 s2, avl s1 -> avl s2 -> avl (diff s1 s2). +Proof. + (* intros s1 s2; functional induction diff s1 s2; auto. BOF BOF *) + induction s1 as [ | l1 Hl1 x1 r1 Hr1 h1]; simpl; auto. + destruct s2 as [ | l2 x2 r2 h2]; intros; auto. + generalize H0; inv avl. + set (r:=Node l2 x2 r2 h2) in *; clearbody r; intros. + destruct (split_avl r x1 H8). + destruct (split x1 r) as [l2' (b,r2')]; simpl in *. + destruct b; [ apply concat_avl | apply join_avl ]; auto. +Qed. + +Lemma diff_bst_in : forall s1 s2, bst s1 -> avl s1 -> bst s2 -> avl s2 -> + bst (diff s1 s2) /\ (forall y, In y (diff s1 s2) <-> In y s1 /\ ~In y s2). +Proof. + induction s1 as [ | l1 Hl1 x1 r1 Hr1 h1]; simpl; auto. + intuition; inversion_clear H3. + destruct s2 as [ | l2 x2 r2 h2]; intros; auto. + intuition; inversion_clear H4. + generalize H1 H2; inv avl; inv bst. + set (r:=Node l2 x2 r2 h2) in *; clearbody r; intros. + destruct (split_avl r x1 H17). + destruct (split_bst r x1 H16 H17). + split. + (* bst *) + destruct (split x1 r) as [l2' (b,r2')]; simpl in *. + destruct (Hl1 l2'); auto. + destruct (Hr1 r2'); auto. + destruct b. + (* bst concat *) + apply concat_bst; try apply diff_avl; auto. + intros; generalize (H22 y1) (H24 y2); intuition eauto. + (* bst join *) + apply join_bst; try apply diff_avl; firstorder. + (* in *) + intros. + destruct (split_in_1 r x1 y H16 H17). + destruct (split_in_2 r x1 y H16 H17). + destruct (split_in_3 r x1 H16 H17). + destruct (split x1 r) as [l2' (b,r2')]; simpl in *. + destruct (Hl1 l2'); auto. + destruct (Hr1 r2'); auto. + destruct b. + (* in concat *) + rewrite concat_in; try apply diff_avl; auto. + intros. + intros; generalize (H28 y1) (H30 y2); intuition eauto. + rewrite H30. + rewrite H28. + intuition_in. + elim H35; apply In_1 with x1; auto. + (* in join *) + rewrite join_in; try apply diff_avl; auto. + rewrite H30. + rewrite H28. + intuition_in. + generalize (H26 (In_1 _ _ _ H34 H24)); intro; discriminate. +Qed. + +Lemma diff_bst : forall s1 s2, bst s1 -> avl s1 -> bst s2 -> avl s2 -> + bst (diff s1 s2). +Proof. + intros; generalize (diff_bst_in s1 s2); intuition. +Qed. + +Lemma diff_in : forall s1 s2 y, bst s1 -> avl s1 -> bst s2 -> avl s2 -> + (In y (diff s1 s2) <-> In y s1 /\ ~In y s2). +Proof. + intros; generalize (diff_bst_in s1 s2); firstorder. +Qed. + +(** * Elements *) + +(** [elements_tree_aux acc t] catenates the elements of [t] in infix + order to the list [acc] *) + +Fixpoint elements_aux (acc : list X.t) (t : tree) {struct t} : list X.t := + match t with + | Leaf => acc + | Node l x r _ => elements_aux (x :: elements_aux acc r) l + end. + +(** then [elements] is an instanciation with an empty [acc] *) + +Definition elements := elements_aux nil. + +Lemma elements_aux_in : forall s acc x, + InA X.eq x (elements_aux acc s) <-> In x s \/ InA X.eq x acc. +Proof. + induction s as [ | l Hl x r Hr h ]; simpl; auto. + intuition. + inversion H0. + intros. + rewrite Hl. + destruct (Hr acc x0); clear Hl Hr. + intuition; inversion_clear H3; intuition. +Qed. + +Lemma elements_in : forall s x, InA X.eq x (elements s) <-> In x s. +Proof. + intros; generalize (elements_aux_in s nil x); intuition. + inversion_clear H0. +Qed. + +Lemma elements_aux_sort : forall s acc, bst s -> sort X.lt acc -> + (forall x y : elt, InA X.eq x acc -> In y s -> X.lt y x) -> + sort X.lt (elements_aux acc s). +Proof. + induction s as [ | l Hl y r Hr h]; simpl; intuition. + inv bst. + apply Hl; auto. + constructor. + apply Hr; auto. + apply MX.In_Inf; intros. + destruct (elements_aux_in r acc y0); intuition. + intros. + inversion_clear H. + order. + destruct (elements_aux_in r acc x); intuition eauto. +Qed. + +Lemma elements_sort : forall s : tree, bst s -> sort X.lt (elements s). +Proof. + intros; unfold elements; apply elements_aux_sort; auto. + intros; inversion H0. +Qed. +Hint Resolve elements_sort. + +(** * Filter *) + +Section F. +Variable f : elt -> bool. + +Fixpoint filter_acc (acc:t)(s:t) { struct s } : t := match s with + | Leaf => acc + | Node l x r h => + filter_acc (filter_acc (if f x then add x acc else acc) l) r + end. + +Definition filter := filter_acc Leaf. + +Lemma filter_acc_avl : forall s acc, avl s -> avl acc -> + avl (filter_acc acc s). +Proof. + induction s; simpl; auto. + intros. + inv avl. + apply IHs2; auto. + apply IHs1; auto. + destruct (f t); auto. +Qed. +Hint Resolve filter_acc_avl. + +Lemma filter_acc_bst : forall s acc, bst s -> avl s -> bst acc -> avl acc -> + bst (filter_acc acc s). +Proof. + induction s; simpl; auto. + intros. + inv avl; inv bst. + destruct (f t); auto. + apply IHs2; auto. + apply IHs1; auto. + apply add_bst; auto. +Qed. + +Lemma filter_acc_in : forall s acc, avl s -> avl acc -> + compat_bool X.eq f -> forall x : elt, + In x (filter_acc acc s) <-> In x acc \/ In x s /\ f x = true. +Proof. + induction s; simpl; intros. + intuition_in. + inv bst; inv avl. + rewrite IHs2; auto. + destruct (f t); auto. + rewrite IHs1; auto. + destruct (f t); auto. + case_eq (f t); intros. + rewrite (add_in); auto. + intuition_in. + rewrite (H1 _ _ H8). + intuition. + intuition_in. + rewrite (H1 _ _ H8) in H9. + rewrite H in H9; discriminate. +Qed. + +Lemma filter_avl : forall s, avl s -> avl (filter s). +Proof. + unfold filter; intros; apply filter_acc_avl; auto. +Qed. + +Lemma filter_bst : forall s, bst s -> avl s -> bst (filter s). +Proof. + unfold filter; intros; apply filter_acc_bst; auto. +Qed. + +Lemma filter_in : forall s, avl s -> + compat_bool X.eq f -> forall x : elt, + In x (filter s) <-> In x s /\ f x = true. +Proof. + unfold filter; intros; rewrite filter_acc_in; intuition_in. +Qed. + +(** * Partition *) + +Fixpoint partition_acc (acc : t*t)(s : t) { struct s } : t*t := + match s with + | Leaf => acc + | Node l x r _ => + let (acct,accf) := acc in + partition_acc + (partition_acc + (if f x then (add x acct, accf) else (acct, add x accf)) l) r + end. + +Definition partition := partition_acc (Leaf,Leaf). + +Lemma partition_acc_avl_1 : forall s acc, avl s -> + avl (fst acc) -> avl (fst (partition_acc acc s)). +Proof. + induction s; simpl; auto. + destruct acc as [acct accf]; simpl in *. + intros. + inv avl. + apply IHs2; auto. + apply IHs1; auto. + destruct (f t); simpl; auto. +Qed. + +Lemma partition_acc_avl_2 : forall s acc, avl s -> + avl (snd acc) -> avl (snd (partition_acc acc s)). +Proof. + induction s; simpl; auto. + destruct acc as [acct accf]; simpl in *. + intros. + inv avl. + apply IHs2; auto. + apply IHs1; auto. + destruct (f t); simpl; auto. +Qed. +Hint Resolve partition_acc_avl_1 partition_acc_avl_2. + +Lemma partition_acc_bst_1 : forall s acc, bst s -> avl s -> + bst (fst acc) -> avl (fst acc) -> + bst (fst (partition_acc acc s)). +Proof. + induction s; simpl; auto. + destruct acc as [acct accf]; simpl in *. + intros. + inv avl; inv bst. + destruct (f t); auto. + apply IHs2; simpl; auto. + apply IHs1; simpl; auto. + apply add_bst; auto. + apply partition_acc_avl_1; simpl; auto. +Qed. + +Lemma partition_acc_bst_2 : forall s acc, bst s -> avl s -> + bst (snd acc) -> avl (snd acc) -> + bst (snd (partition_acc acc s)). +Proof. + induction s; simpl; auto. + destruct acc as [acct accf]; simpl in *. + intros. + inv avl; inv bst. + destruct (f t); auto. + apply IHs2; simpl; auto. + apply IHs1; simpl; auto. + apply add_bst; auto. + apply partition_acc_avl_2; simpl; auto. +Qed. + +Lemma partition_acc_in_1 : forall s acc, avl s -> avl (fst acc) -> + compat_bool X.eq f -> forall x : elt, + In x (fst (partition_acc acc s)) <-> + In x (fst acc) \/ In x s /\ f x = true. +Proof. + induction s; simpl; intros. + intuition_in. + destruct acc as [acct accf]; simpl in *. + inv bst; inv avl. + rewrite IHs2; auto. + destruct (f t); auto. + apply partition_acc_avl_1; simpl; auto. + rewrite IHs1; auto. + destruct (f t); simpl; auto. + case_eq (f t); simpl; intros. + rewrite (add_in); auto. + intuition_in. + rewrite (H1 _ _ H8). + intuition. + intuition_in. + rewrite (H1 _ _ H8) in H9. + rewrite H in H9; discriminate. +Qed. + +Lemma partition_acc_in_2 : forall s acc, avl s -> avl (snd acc) -> + compat_bool X.eq f -> forall x : elt, + In x (snd (partition_acc acc s)) <-> + In x (snd acc) \/ In x s /\ f x = false. +Proof. + induction s; simpl; intros. + intuition_in. + destruct acc as [acct accf]; simpl in *. + inv bst; inv avl. + rewrite IHs2; auto. + destruct (f t); auto. + apply partition_acc_avl_2; simpl; auto. + rewrite IHs1; auto. + destruct (f t); simpl; auto. + case_eq (f t); simpl; intros. + intuition. + intuition_in. + rewrite (H1 _ _ H8) in H9. + rewrite H in H9; discriminate. + rewrite (add_in); auto. + intuition_in. + rewrite (H1 _ _ H8). + intuition. +Qed. + +Lemma partition_avl_1 : forall s, avl s -> avl (fst (partition s)). +Proof. + unfold partition; intros; apply partition_acc_avl_1; auto. +Qed. + +Lemma partition_avl_2 : forall s, avl s -> avl (snd (partition s)). +Proof. + unfold partition; intros; apply partition_acc_avl_2; auto. +Qed. + +Lemma partition_bst_1 : forall s, bst s -> avl s -> + bst (fst (partition s)). +Proof. + unfold partition; intros; apply partition_acc_bst_1; auto. +Qed. + +Lemma partition_bst_2 : forall s, bst s -> avl s -> + bst (snd (partition s)). +Proof. + unfold partition; intros; apply partition_acc_bst_2; auto. +Qed. + +Lemma partition_in_1 : forall s, avl s -> + compat_bool X.eq f -> forall x : elt, + In x (fst (partition s)) <-> In x s /\ f x = true. +Proof. + unfold partition; intros; rewrite partition_acc_in_1; + simpl in *; intuition_in. +Qed. + +Lemma partition_in_2 : forall s, avl s -> + compat_bool X.eq f -> forall x : elt, + In x (snd (partition s)) <-> In x s /\ f x = false. +Proof. + unfold partition; intros; rewrite partition_acc_in_2; + simpl in *; intuition_in. +Qed. + +(** [for_all] and [exists] *) + +Fixpoint for_all (s:t) : bool := match s with + | Leaf => true + | Node l x r _ => f x && for_all l && for_all r +end. + +Lemma for_all_1 : forall s, compat_bool E.eq f -> + For_all (fun x => f x = true) s -> for_all s = true. +Proof. + induction s; simpl; auto. + intros. + rewrite IHs1; try red; auto. + rewrite IHs2; try red; auto. + generalize (H0 t). + destruct (f t); simpl; auto. +Qed. + +Lemma for_all_2 : forall s, compat_bool E.eq f -> + for_all s = true -> For_all (fun x => f x = true) s. +Proof. + induction s; simpl; auto; intros; red; intros; inv In. + destruct (andb_prop _ _ H0); auto. + destruct (andb_prop _ _ H1); eauto. + apply IHs1; auto. + destruct (andb_prop _ _ H0); auto. + destruct (andb_prop _ _ H1); auto. + apply IHs2; auto. + destruct (andb_prop _ _ H0); auto. +Qed. + +Fixpoint exists_ (s:t) : bool := match s with + | Leaf => false + | Node l x r _ => f x || exists_ l || exists_ r +end. + +Lemma exists_1 : forall s, compat_bool E.eq f -> + Exists (fun x => f x = true) s -> exists_ s = true. +Proof. + induction s; simpl; destruct 2 as (x,(U,V)); inv In. + rewrite (H _ _ (X.eq_sym H0)); rewrite V; auto. + apply orb_true_intro; left. + apply orb_true_intro; right; apply IHs1; firstorder. + apply orb_true_intro; right; apply IHs2; firstorder. +Qed. + +Lemma exists_2 : forall s, compat_bool E.eq f -> + exists_ s = true -> Exists (fun x => f x = true) s. +Proof. + induction s; simpl; intros. + discriminate. + destruct (orb_true_elim _ _ H0) as [H1|H1]. + destruct (orb_true_elim _ _ H1) as [H2|H2]. + exists t; auto. + destruct (IHs1 H H2); firstorder. + destruct (IHs2 H H1); firstorder. +Qed. + +End F. + +(** * Fold *) + +Module L := FSetList.Raw X. + +Fixpoint fold (A : Set) (f : elt -> A -> A)(s : tree) {struct s} : A -> A := + fun a => match s with + | Leaf => a + | Node l x r _ => fold A f r (f x (fold A f l a)) + end. +Implicit Arguments fold [A]. + +Definition fold' (A : Set) (f : elt -> A -> A)(s : tree) := + L.fold f (elements s). +Implicit Arguments fold' [A]. + +Lemma fold_equiv_aux : + forall (A : Set) (s : tree) (f : elt -> A -> A) (a : A) (acc : list elt), + L.fold f (elements_aux acc s) a = L.fold f acc (fold f s a). +Proof. + simple induction s. + simpl in |- *; intuition. + simpl in |- *; intros. + rewrite H. + simpl. + apply H0. +Qed. + +Lemma fold_equiv : + forall (A : Set) (s : tree) (f : elt -> A -> A) (a : A), + fold f s a = fold' f s a. +Proof. + unfold fold', elements in |- *. + simple induction s; simpl in |- *; auto; intros. + rewrite fold_equiv_aux. + rewrite H0. + simpl in |- *; auto. +Qed. + +Lemma fold_1 : + forall (s:t)(Hs:bst s)(A : Set)(f : elt -> A -> A)(i : A), + fold f s i = fold_left (fun a e => f e a) (elements s) i. +Proof. + intros. + rewrite fold_equiv. + unfold fold'. + rewrite L.fold_1. + unfold L.elements; auto. + apply elements_sort; auto. +Qed. + +(** * Cardinal *) + +Fixpoint cardinal (s : tree) : nat := + match s with + | Leaf => 0%nat + | Node l _ r _ => S (cardinal l + cardinal r) + end. + +Lemma cardinal_elements_aux_1 : + forall s acc, (length acc + cardinal s)%nat = length (elements_aux acc s). +Proof. + simple induction s; simpl in |- *; intuition. + rewrite <- H. + simpl in |- *. + rewrite <- H0; omega. +Qed. + +Lemma cardinal_elements_1 : forall s : tree, cardinal s = length (elements s). +Proof. + exact (fun s => cardinal_elements_aux_1 s nil). +Qed. + +(** NB: the remaining functions (union, subset, compare) are still defined + in a dependent style, due to the use of well-founded induction. *) + +(** Induction over cardinals *) + +Lemma sorted_subset_cardinal : forall l' l : list X.t, + sort X.lt l -> sort X.lt l' -> + (forall x : elt, InA X.eq x l -> InA X.eq x l') -> (length l <= length l')%nat. +Proof. + simple induction l'; simpl in |- *; intuition. + destruct l; trivial; intros. + absurd (InA X.eq t nil); intuition. + inversion_clear H2. + inversion_clear H1. + destruct l0; simpl in |- *; intuition. + inversion_clear H0. + apply le_n_S. + case (X.compare t a); intro. + absurd (InA X.eq t (a :: l)). + intro. + inversion_clear H0. + order. + assert (X.lt a t). + apply MX.Sort_Inf_In with l; auto. + order. + firstorder. + apply H; auto. + intros. + assert (InA X.eq x (a :: l)). + apply H2; auto. + inversion_clear H6; auto. + assert (X.lt t x). + apply MX.Sort_Inf_In with l0; auto. + order. + apply le_trans with (length (t :: l0)). + simpl in |- *; omega. + apply (H (t :: l0)); auto. + intros. + assert (InA X.eq x (a :: l)); firstorder. + inversion_clear H6; auto. + assert (X.lt a x). + apply MX.Sort_Inf_In with (t :: l0); auto. + elim (X.lt_not_eq (x:=a) (y:=x)); auto. +Qed. + +Lemma cardinal_subset : forall a b : tree, bst a -> bst b -> + (forall y : elt, In y a -> In y b) -> + (cardinal a <= cardinal b)%nat. +Proof. + intros. + do 2 rewrite cardinal_elements_1. + apply sorted_subset_cardinal; auto. + intros. + generalize (elements_in a x) (elements_in b x). + intuition. +Qed. + +Lemma cardinal_left : forall (l r : tree) (x : elt) (h : int), + (cardinal l < cardinal (Node l x r h))%nat. +Proof. + simpl in |- *; intuition. +Qed. + +Lemma cardinal_right : + forall (l r : tree) (x : elt) (h : int), + (cardinal r < cardinal (Node l x r h))%nat. +Proof. + simpl in |- *; intuition. +Qed. + +Lemma cardinal_rec2 : forall P : tree -> tree -> Set, + (forall s1 s2 : tree, + (forall t1 t2 : tree, + (cardinal t1 + cardinal t2 < cardinal s1 + cardinal s2)%nat -> P t1 t2) + -> P s1 s2) -> + forall s1 s2 : tree, P s1 s2. +Proof. + intros P H s1 s2. + apply well_founded_induction_type_2 + with (R := fun yy' xx' : tree * tree => + (cardinal (fst yy') + cardinal (snd yy') < + cardinal (fst xx') + cardinal (snd xx'))%nat); auto. + apply (Wf_nat.well_founded_ltof _ + (fun xx' : tree * tree => (cardinal (fst xx') + cardinal (snd xx'))%nat)). +Qed. + +Lemma height_0 : forall s, avl s -> height s = 0 -> s = Leaf. +Proof. + destruct 1; intuition; simpl in *. + avl_nns; simpl in *; false_omega_max. +Qed. + +(** * Union + + [union s1 s2] does an induction over the sum of the cardinals of + [s1] and [s2]. Code is +<< + let rec union s1 s2 = + match (s1, s2) with + (Empty, t2) -> t2 + | (t1, Empty) -> t1 + | (Node(l1, v1, r1, h1), Node(l2, v2, r2, h2)) -> + if h1 >= h2 then + if h2 = 1 then add v2 s1 else begin + let (l2', _, r2') = split v1 s2 in + join (union l1 l2') v1 (union r1 r2') + end + else + if h1 = 1 then add v1 s2 else begin + let (l1', _, r1') = split v2 s1 in + join (union l1' l2) v2 (union r1' r2) + end +>> +*) + +Definition union : + forall s1 s2, bst s1 -> avl s1 -> bst s2 -> avl s2 -> + {s' : t | bst s' /\ avl s' /\ forall x : elt, In x s' <-> In x s1 \/ In x s2}. +Proof. + intros s1 s2; pattern s1, s2; apply cardinal_rec2; clear s1 s2. + destruct s1 as [| l1 x1 r1 h1]; intros. + (* s = Leaf *) + clear H. + exists s2; intuition_in. + (* s1 = Node l1 x1 r1 *) + destruct s2 as [| l2 x2 r2 h2]; simpl in |- *. + (* s2 = Leaf *) + clear H. + exists (Node l1 x1 r1 h1); simpl; intuition_in. + (* x' = Node l2 x2 r2 *) + case (ge_lt_dec h1 h2); intro. + (* h1 >= h2 *) + case (eq_dec h2 1); intro. + (* h2 = 1 *) + clear H. + exists (add x2 (Node l1 x1 r1 h1)); auto. + inv avl; inv bst. + avl_nn l2; avl_nn r2. + rewrite (height_0 _ H); [ | omega_max]. + rewrite (height_0 _ H4); [ | omega_max]. + split; [apply add_bst; auto|]. + split; [apply add_avl; auto|]. + intros. + rewrite (add_in (Node l1 x1 r1 h1) x2 x); intuition_in. + (* h2 <> 1 *) + (* split x1 s2 = l2',_,r2' *) + case_eq (split x1 (Node l2 x2 r2 h2)); intros l2' (b,r2') EqSplit. + set (s2 := Node l2 x2 r2 h2) in *; clearbody s2. + generalize (split_avl s2 x1 H3); rewrite EqSplit; simpl in *; intros (A,B). + generalize (split_bst s2 x1 H2 H3); rewrite EqSplit; simpl in *; intros (C,D). + generalize (split_in_1 s2 x1); rewrite EqSplit; simpl in *; intros. + generalize (split_in_2 s2 x1); rewrite EqSplit; simpl in *; intros. + (* union l1 l2' = l0 *) + destruct (H l1 l2') as [l0 (H7,(H8,H9))]; inv avl; inv bst; auto. + assert (cardinal l2' <= cardinal s2)%nat. + apply cardinal_subset; trivial. + intros y; rewrite (H4 y); intuition. + omega. + (* union r1 r2' = r0 *) + destruct (H r1 r2') as [r0 (H10,(H11,H12))]; inv avl; inv bst; auto. + assert (cardinal r2' <= cardinal s2)%nat. + apply cardinal_subset; trivial. + intros y; rewrite (H5 y); intuition. + omega. + exists (join l0 x1 r0). + inv avl; inv bst; clear H. + split. + apply join_bst; auto. + red; intros. + rewrite (H9 y) in H. + destruct H; auto. + rewrite (H4 y) in H; intuition. + red; intros. + rewrite (H12 y) in H. + destruct H; auto. + rewrite (H5 y) in H; intuition. + split. + apply join_avl; auto. + intros. + rewrite join_in; auto. + rewrite H9. + rewrite H12. + rewrite H4; auto. + rewrite H5; auto. + intuition_in. + case (X.compare x x1); intuition. + (* h1 < h2 *) + case (eq_dec h1 1); intro. + (* h1 = 1 *) + exists (add x1 (Node l2 x2 r2 h2)); auto. + inv avl; inv bst. + avl_nn l1; avl_nn r1. + rewrite (height_0 _ H3); [ | omega_max]. + rewrite (height_0 _ H8); [ | omega_max]. + split; [apply add_bst; auto|]. + split; [apply add_avl; auto|]. + intros. + rewrite (add_in (Node l2 x2 r2 h2) x1 x); intuition_in. + (* h1 <> 1 *) + (* split x2 s1 = l1',_,r1' *) + case_eq (split x2 (Node l1 x1 r1 h1)); intros l1' (b,r1') EqSplit. + set (s1 := Node l1 x1 r1 h1) in *; clearbody s1. + generalize (split_avl s1 x2 H1); rewrite EqSplit; simpl in *; intros (A,B). + generalize (split_bst s1 x2 H0 H1); rewrite EqSplit; simpl in *; intros (C,D). + generalize (split_in_1 s1 x2); rewrite EqSplit; simpl in *; intros. + generalize (split_in_2 s1 x2); rewrite EqSplit; simpl in *; intros. + (* union l1' l2 = l0 *) + destruct (H l1' l2) as [l0 (H7,(H8,H9))]; inv avl; inv bst; auto. + assert (cardinal l1' <= cardinal s1)%nat. + apply cardinal_subset; trivial. + intros y; rewrite (H4 y); intuition. + omega. + (* union r1' r2 = r0 *) + destruct (H r1' r2) as [r0 (H10,(H11,H12))]; inv avl; inv bst; auto. + assert (cardinal r1' <= cardinal s1)%nat. + apply cardinal_subset; trivial. + intros y; rewrite (H5 y); intuition. + omega. + exists (join l0 x2 r0). + inv avl; inv bst; clear H. + split. + apply join_bst; auto. + red; intros. + rewrite (H9 y) in H. + destruct H; auto. + rewrite (H4 y) in H; intuition. + red; intros. + rewrite (H12 y) in H. + destruct H; auto. + rewrite (H5 y) in H; intuition. + split. + apply join_avl; auto. + intros. + rewrite join_in; auto. + rewrite H9. + rewrite H12. + rewrite H4; auto. + rewrite H5; auto. + intuition_in. + case (X.compare x x2); intuition. +Qed. + + +(** * Subset +<< + let rec subset s1 s2 = + match (s1, s2) with + Empty, _ -> true + | _, Empty -> false + | Node (l1, v1, r1, _), (Node (l2, v2, r2, _) as t2) -> + let c = Ord.compare v1 v2 in + if c = 0 then + subset l1 l2 && subset r1 r2 + else if c < 0 then + subset (Node (l1, v1, Empty, 0)) l2 && subset r1 t2 + else + subset (Node (Empty, v1, r1, 0)) r2 && subset l1 t2 +>> +*) + +Definition subset : forall s1 s2 : t, bst s1 -> bst s2 -> + {Subset s1 s2} + {~ Subset s1 s2}. +Proof. + intros s1 s2; pattern s1, s2; apply cardinal_rec2; clear s1 s2. + destruct s1 as [| l1 x1 r1 h1]; intros. + (* s1 = Leaf *) + left; red; intros; inv In. + (* s1 = Node l1 x1 r1 h1 *) + destruct s2 as [| l2 x2 r2 h2]. + (* s2 = Leaf *) + right; intros; intro. + assert (In x1 Leaf); auto. + inversion_clear H3. + (* s2 = Node l2 x2 r2 h2 *) + case (X.compare x1 x2); intro. + (* x1 < x2 *) + case (H (Node l1 x1 Leaf 0) l2); inv bst; auto; intros. + simpl in |- *; omega. + case (H r1 (Node l2 x2 r2 h2)); inv bst; auto; intros. + simpl in |- *; omega. + clear H; left; red; intuition. + generalize (s a) (s0 a); clear s s0; intuition_in. + clear H; right; red; firstorder. + clear H; right; red; inv bst; intuition. + apply n; red; intros. + assert (In a (Node l2 x2 r2 h2)) by (inv In; auto). + intuition_in; order. + (* x1 = x2 *) + case (H l1 l2); inv bst; auto; intros. + simpl in |- *; omega. + case (H r1 r2); inv bst; auto; intros. + simpl in |- *; omega. + clear H; left; red; intuition_in; eauto. + clear H; right; red; inv bst; intuition. + apply n; red; intros. + assert (In a (Node l2 x2 r2 h2)) by auto. + intuition_in; order. + clear H; right; red; inv bst; intuition. + apply n; red; intros. + assert (In a (Node l2 x2 r2 h2)) by auto. + intuition_in; order. + (* x1 > x2 *) + case (H (Node Leaf x1 r1 0) r2); inv bst; auto; intros. + simpl in |- *; omega. + intros; case (H l1 (Node l2 x2 r2 h2)); inv bst; auto; intros. + simpl in |- *; omega. + clear H; left; red; intuition. + generalize (s a) (s0 a); clear s s0; intuition_in. + clear H; right; red; firstorder. + clear H; right; red; inv bst; intuition. + apply n; red; intros. + assert (In a (Node l2 x2 r2 h2)) by (inv In; auto). + intuition_in; order. +Qed. + +(** * Comparison *) + +(** ** Relations [eq] and [lt] over trees *) + +Definition eq : t -> t -> Prop := Equal. + +Lemma eq_refl : forall s : t, eq s s. +Proof. + unfold eq, Equal in |- *; intuition. +Qed. + +Lemma eq_sym : forall s s' : t, eq s s' -> eq s' s. +Proof. + unfold eq, Equal in |- *; firstorder. +Qed. + +Lemma eq_trans : forall s s' s'' : t, eq s s' -> eq s' s'' -> eq s s''. +Proof. + unfold eq, Equal in |- *; firstorder. +Qed. + +Lemma eq_L_eq : + forall s s' : t, eq s s' -> L.eq (elements s) (elements s'). +Proof. + unfold eq, Equal, L.eq, L.Equal in |- *; intros. + generalize (elements_in s a) (elements_in s' a). + firstorder. +Qed. + +Lemma L_eq_eq : + forall s s' : t, L.eq (elements s) (elements s') -> eq s s'. +Proof. + unfold eq, Equal, L.eq, L.Equal in |- *; intros. + generalize (elements_in s a) (elements_in s' a). + firstorder. +Qed. +Hint Resolve eq_L_eq L_eq_eq. + +Definition lt (s1 s2 : t) : Prop := L.lt (elements s1) (elements s2). + +Definition lt_trans (s s' s'' : t) (h : lt s s') + (h' : lt s' s'') : lt s s'' := L.lt_trans h h'. + +Lemma lt_not_eq : forall s s' : t, bst s -> bst s' -> lt s s' -> ~ eq s s'. +Proof. + unfold lt in |- *; intros; intro. + apply L.lt_not_eq with (s := elements s) (s' := elements s'); auto. +Qed. + +(** A new comparison algorithm suggested by Xavier Leroy: + +type enumeration = End | More of elt * t * enumeration + +let rec cons s e = match s with + | Empty -> e + | Node(l, v, r, _) -> cons l (More(v, r, e)) + +let rec compare_aux e1 e2 = match (e1, e2) with + | (End, End) -> 0 + | (End, More _) -> -1 + | (More _, End) -> 1 + | (More(v1, r1, k1), More(v2, r2, k2)) -> + let c = Ord.compare v1 v2 in + if c <> 0 then c else compare_aux (cons r1 k1) (cons r2 k2) + +let compare s1 s2 = compare_aux (cons s1 End) (cons s2 End) +*) + +(** ** Enumeration of the elements of a tree *) + +Inductive enumeration : Set := + | End : enumeration + | More : elt -> tree -> enumeration -> enumeration. + +(** [flatten_e e] returns the list of elements of [e] i.e. the list + of elements actually compared *) + +Fixpoint flatten_e (e : enumeration) : list elt := match e with + | End => nil + | More x t r => x :: elements t ++ flatten_e r + end. + +(** [sorted_e e] expresses that elements in the enumeration [e] are + sorted, and that all trees in [e] are binary search trees. *) + +Inductive In_e (x:elt) : enumeration -> Prop := + | InEHd1 : + forall (y : elt) (s : tree) (e : enumeration), + X.eq x y -> In_e x (More y s e) + | InEHd2 : + forall (y : elt) (s : tree) (e : enumeration), + In x s -> In_e x (More y s e) + | InETl : + forall (y : elt) (s : tree) (e : enumeration), + In_e x e -> In_e x (More y s e). + +Hint Constructors In_e. + +Inductive sorted_e : enumeration -> Prop := + | SortedEEnd : sorted_e End + | SortedEMore : + forall (x : elt) (s : tree) (e : enumeration), + bst s -> + (gt_tree x s) -> + sorted_e e -> + (forall y : elt, In_e y e -> X.lt x y) -> + (forall y : elt, + In y s -> forall z : elt, In_e z e -> X.lt y z) -> + sorted_e (More x s e). + +Hint Constructors sorted_e. + +Lemma in_app : + forall (x : elt) (l1 l2 : list elt), + InA X.eq x (l1 ++ l2) -> InA X.eq x l1 \/ InA X.eq x l2. +Proof. + simple induction l1; simpl in |- *; intuition. + inversion_clear H0; auto. + elim (H l2 H1); auto. +Qed. + +Lemma in_flatten_e : + forall (x : elt) (e : enumeration), InA X.eq x (flatten_e e) -> In_e x e. +Proof. + simple induction e; simpl in |- *; intuition. + inversion_clear H. + inversion_clear H0; auto. + elim (in_app x _ _ H1); auto. + destruct (elements_in t x); auto. +Qed. + +Lemma sort_app : + forall l1 l2 : list elt, sort X.lt l1 -> sort X.lt l2 -> + (forall x y : elt, InA X.eq x l1 -> InA X.eq y l2 -> X.lt x y) -> + sort X.lt (l1 ++ l2). +Proof. + simple induction l1; simpl in |- *; intuition. + apply cons_sort; auto. + apply H; auto. + inversion_clear H0; trivial. + induction l as [| a0 l Hrecl]; simpl in |- *; intuition. + induction l2 as [| a0 l2 Hrecl2]; simpl in |- *; intuition. + inversion_clear H0; inversion_clear H4; auto. +Qed. + +Lemma sorted_flatten_e : + forall e : enumeration, sorted_e e -> sort X.lt (flatten_e e). +Proof. + simple induction e; simpl in |- *; intuition. + apply cons_sort. + apply sort_app; inversion H0; auto. + intros; apply H8; auto. + destruct (elements_in t x0); auto. + apply in_flatten_e; auto. + apply L.MX.ListIn_Inf. + inversion_clear H0. + intros; elim (in_app_or _ _ _ H0); intuition. + destruct (elements_in t y); auto. + apply H4; apply in_flatten_e; auto. +Qed. + +Lemma elements_app : + forall (s : tree) (acc : list elt), elements_aux acc s = elements s ++ acc. +Proof. + simple induction s; simpl in |- *; intuition. + rewrite H0. + rewrite H. + unfold elements; simpl. + do 2 rewrite H. + rewrite H0. + repeat rewrite <- app_nil_end. + repeat rewrite app_ass; auto. +Qed. + +Lemma compare_flatten_1 : + forall (t0 t2 : tree) (t1 : elt) (z : int) (l : list elt), + elements t0 ++ t1 :: elements t2 ++ l = + elements (Node t0 t1 t2 z) ++ l. +Proof. + simpl in |- *; unfold elements in |- *; simpl in |- *; intuition. + repeat rewrite elements_app. + repeat rewrite <- app_nil_end. + repeat rewrite app_ass; auto. +Qed. + +(** key lemma for correctness *) + +Lemma flatten_e_elements : + forall (x : elt) (l r : tree) (z : int) (e : enumeration), + elements l ++ flatten_e (More x r e) = elements (Node l x r z) ++ flatten_e e. +Proof. + intros; simpl. + apply compare_flatten_1. +Qed. + +(** termination of [compare_aux] *) + +Open Scope Z_scope. + +Fixpoint measure_e_t (s : tree) : Z := match s with + | Leaf => 0 + | Node l _ r _ => 1 + measure_e_t l + measure_e_t r + end. + +Fixpoint measure_e (e : enumeration) : Z := match e with + | End => 0 + | More _ s r => 1 + measure_e_t s + measure_e r + end. + +Ltac Measure_e_t := unfold measure_e_t in |- *; fold measure_e_t in |- *. +Ltac Measure_e := unfold measure_e in |- *; fold measure_e in |- *. + +Lemma measure_e_t_0 : forall s : tree, measure_e_t s >= 0. +Proof. + simple induction s. + simpl in |- *; omega. + intros. + Measure_e_t; omega. (* BUG Simpl! *) +Qed. + +Ltac Measure_e_t_0 s := generalize (measure_e_t_0 s); intro. + +Lemma measure_e_0 : forall e : enumeration, measure_e e >= 0. +Proof. + simple induction e. + simpl in |- *; omega. + intros. + Measure_e; Measure_e_t_0 t; omega. +Qed. + +Ltac Measure_e_0 e := generalize (measure_e_0 e); intro. + +(** Induction principle over the sum of the measures for two lists *) + +Definition compare_rec2 : + forall P : enumeration -> enumeration -> Set, + (forall x x' : enumeration, + (forall y y' : enumeration, + measure_e y + measure_e y' < measure_e x + measure_e x' -> P y y') -> + P x x') -> + forall x x' : enumeration, P x x'. +Proof. + intros P H x x'. + apply well_founded_induction_type_2 + with (R := fun yy' xx' : enumeration * enumeration => + measure_e (fst yy') + measure_e (snd yy') < + measure_e (fst xx') + measure_e (snd xx')); auto. + apply Wf_nat.well_founded_lt_compat + with (f := fun xx' : enumeration * enumeration => + Zabs_nat (measure_e (fst xx') + measure_e (snd xx'))). + intros; apply Zabs.Zabs_nat_lt. + Measure_e_0 (fst x0); Measure_e_0 (snd x0); Measure_e_0 (fst y); + Measure_e_0 (snd y); intros; omega. +Qed. + +(** [cons t e] adds the elements of tree [t] on the head of + enumeration [e]. Code: + +let rec cons s e = match s with + | Empty -> e + | Node(l, v, r, _) -> cons l (More(v, r, e)) +*) + +Definition cons : forall (s : tree) (e : enumeration), bst s -> sorted_e e -> + (forall (x y : elt), In x s -> In_e y e -> X.lt x y) -> + { r : enumeration + | sorted_e r /\ + measure_e r = measure_e_t s + measure_e e /\ + flatten_e r = elements s ++ flatten_e e + }. +Proof. + simple induction s; intuition. + (* s = Leaf *) + exists e; intuition. + (* s = Node t t0 t1 z *) + clear H0. + case (H (More t0 t1 e)); clear H; intuition. + inv bst; auto. + constructor; inversion_clear H1; auto. + inversion_clear H0; inv bst; intuition; order. + exists x; intuition. + generalize H4; Measure_e; intros; Measure_e_t; omega. + rewrite H5. + apply flatten_e_elements. +Qed. + +Lemma l_eq_cons : + forall (l1 l2 : list elt) (x y : elt), + X.eq x y -> L.eq l1 l2 -> L.eq (x :: l1) (y :: l2). +Proof. + unfold L.eq, L.Equal in |- *; intuition. + inversion_clear H1; generalize (H0 a); clear H0; intuition. + apply InA_eqA with x; eauto. + inversion_clear H1; generalize (H0 a); clear H0; intuition. + apply InA_eqA with y; eauto. +Qed. + +Definition compare_aux : + forall e1 e2 : enumeration, sorted_e e1 -> sorted_e e2 -> + Compare L.lt L.eq (flatten_e e1) (flatten_e e2). +Proof. + intros e1 e2; pattern e1, e2 in |- *; apply compare_rec2. + simple destruct x; simple destruct x'; intuition. + (* x = x' = End *) + constructor 2; unfold L.eq, L.Equal in |- *; intuition. + (* x = End x' = More *) + constructor 1; simpl in |- *; auto. + (* x = More x' = End *) + constructor 3; simpl in |- *; auto. + (* x = More e t e0, x' = More e3 t0 e4 *) + case (X.compare e e3); intro. + (* e < e3 *) + constructor 1; simpl; auto. + (* e = e3 *) + destruct (cons t e0) as [c1 (H2,(H3,H4))]; try inversion_clear H0; auto. + destruct (cons t0 e4) as [c2 (H5,(H6,H7))]; try inversion_clear H1; auto. + destruct (H c1 c2); clear H; intuition. + Measure_e; omega. + constructor 1; simpl. + apply L.lt_cons_eq; auto. + rewrite H4 in l; rewrite H7 in l; auto. + constructor 2; simpl. + apply l_eq_cons; auto. + rewrite H4 in e6; rewrite H7 in e6; auto. + constructor 3; simpl. + apply L.lt_cons_eq; auto. + rewrite H4 in l; rewrite H7 in l; auto. + (* e > e3 *) + constructor 3; simpl; auto. +Qed. + +Definition compare : forall s1 s2, bst s1 -> bst s2 -> Compare lt eq s1 s2. +Proof. + intros s1 s2 s1_bst s2_bst; unfold lt, eq; simpl. + destruct (cons s1 End); intuition. + inversion_clear H0. + destruct (cons s2 End); intuition. + inversion_clear H3. + simpl in H2; rewrite <- app_nil_end in H2. + simpl in H5; rewrite <- app_nil_end in H5. + destruct (compare_aux x x0); intuition. + constructor 1; simpl in |- *. + rewrite H2 in l; rewrite H5 in l; auto. + constructor 2; apply L_eq_eq; simpl in |- *. + rewrite H2 in e; rewrite H5 in e; auto. + constructor 3; simpl in |- *. + rewrite H2 in l; rewrite H5 in l; auto. +Qed. + +(** * Equality test *) + +Definition equal : forall s s' : t, bst s -> bst s' -> {Equal s s'} + {~ Equal s s'}. +Proof. + intros s s' Hs Hs'; case (compare s s'); auto; intros. + right; apply lt_not_eq; auto. + right; intro; apply (lt_not_eq s' s); auto; apply eq_sym; auto. +Qed. + +(** We provide additionally a different implementation for union, subset and + equal, which is less efficient, but uses structural induction, hence computes + within Coq. *) + +(** Alternative union based on fold. + Complexity : [min(|s|,|s'|)*log(max(|s|,|s'|))] *) + +Definition union' s s' := + if ge_lt_dec (height s) (height s') then fold add s' s else fold add s s'. + +Lemma fold_add_avl : forall s s', avl s -> avl s' -> avl (fold add s s'). +Proof. + induction s; simpl; intros; inv avl; auto. +Qed. +Hint Resolve fold_add_avl. + +Lemma union'_avl : forall s s', avl s -> avl s' -> avl (union' s s'). +Proof. + unfold union'; intros; destruct (ge_lt_dec (height s) (height s')); auto. +Qed. + +Lemma fold_add_bst : forall s s', bst s -> avl s -> bst s' -> avl s' -> + bst (fold add s s'). +Proof. + induction s; simpl; intros; inv avl; inv bst; auto. + apply IHs2; auto. + apply add_bst; auto. +Qed. + +Lemma union'_bst : forall s s', bst s -> avl s -> bst s' -> avl s' -> + bst (union' s s'). +Proof. + unfold union'; intros; destruct (ge_lt_dec (height s) (height s')); + apply fold_add_bst; auto. +Qed. + +Lemma fold_add_in : forall s s' y, bst s -> avl s -> bst s' -> avl s' -> + (In y (fold add s s') <-> In y s \/ In y s'). +Proof. + induction s; simpl; intros; inv avl; inv bst; auto. + intuition_in. + rewrite IHs2; auto. + apply add_bst; auto. + apply fold_add_bst; auto. + rewrite add_in; auto. + rewrite IHs1; auto. + intuition_in. +Qed. + +Lemma union'_in : forall s s' y, bst s -> avl s -> bst s' -> avl s' -> + (In y (union' s s') <-> In y s \/ In y s'). +Proof. + unfold union'; intros; destruct (ge_lt_dec (height s) (height s')). + rewrite fold_add_in; intuition. + apply fold_add_in; auto. +Qed. + +(** Alternative subset based on diff. *) + +Definition subset' s s' := is_empty (diff s s'). + +Lemma subset'_1 : forall s s', bst s -> avl s -> bst s' -> avl s' -> + Subset s s' -> subset' s s' = true. +Proof. + unfold subset', Subset; intros; apply is_empty_1; red; intros. + rewrite (diff_in); intuition. +Qed. + +Lemma subset'_2 : forall s s', bst s -> avl s -> bst s' -> avl s' -> + subset' s s' = true -> Subset s s'. +Proof. + unfold subset', Subset; intros; generalize (is_empty_2 _ H3 a); unfold Empty. + rewrite (diff_in); intuition. + generalize (mem_2 s' a) (mem_1 s' a); destruct (mem a s'); intuition. +Qed. + +(** Alternative equal based on subset *) + +Definition equal' s s' := subset' s s' && subset' s' s. + +Lemma equal'_1 : forall s s', bst s -> avl s -> bst s' -> avl s' -> + Equal s s' -> equal' s s' = true. +Proof. + unfold equal', Equal; intros. + rewrite subset'_1; firstorder; simpl. + apply subset'_1; firstorder. +Qed. + +Lemma equal'_2 : forall s s', bst s -> avl s -> bst s' -> avl s' -> + equal' s s' = true -> Equal s s'. +Proof. + unfold equal', Equal; intros; destruct (andb_prop _ _ H3); split; + apply subset'_2; auto. +Qed. + +End Raw. + +(** * Encapsulation + + Now, in order to really provide a functor implementing [S], we + need to encapsulate everything into a type of balanced binary search trees. *) + +Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. + + Module E := X. + Module Raw := Raw I X. + + Record bbst : Set := Bbst {this :> Raw.t; is_bst : Raw.bst this; is_avl: Raw.avl this}. + Definition t := bbst. + Definition elt := E.t. + + Definition In (x : elt) (s : t) : Prop := Raw.In x s. + Definition Equal (s s':t) : Prop := forall a : elt, In a s <-> In a s'. + Definition Subset (s s':t) : Prop := forall a : elt, In a s -> In a s'. + Definition Empty (s:t) : Prop := forall a : elt, ~ In a s. + Definition For_all (P : elt -> Prop) (s:t) : Prop := forall x, In x s -> P x. + Definition Exists (P : elt -> Prop) (s:t) : Prop := exists x, In x s /\ P x. + + Lemma In_1 : forall (s:t)(x y:elt), E.eq x y -> In x s -> In y s. + Proof. intro s; exact (Raw.In_1 s). Qed. + + Definition mem (x:elt)(s:t) : bool := Raw.mem x s. + + Definition empty : t := Bbst _ Raw.empty_bst Raw.empty_avl. + Definition is_empty (s:t) : bool := Raw.is_empty s. + Definition singleton (x:elt) : t := Bbst _ (Raw.singleton_bst x) (Raw.singleton_avl x). + Definition add (x:elt)(s:t) : t := + Bbst _ (Raw.add_bst s x (is_bst s) (is_avl s)) + (Raw.add_avl s x (is_avl s)). + Definition remove (x:elt)(s:t) : t := + Bbst _ (Raw.remove_bst s x (is_bst s) (is_avl s)) + (Raw.remove_avl s x (is_avl s)). + Definition inter (s s':t) : t := + Bbst _ (Raw.inter_bst _ _ (is_bst s) (is_avl s) (is_bst s') (is_avl s')) + (Raw.inter_avl _ _ (is_avl s) (is_avl s')). + Definition diff (s s':t) : t := + Bbst _ (Raw.diff_bst _ _ (is_bst s) (is_avl s) (is_bst s') (is_avl s')) + (Raw.diff_avl _ _ (is_avl s) (is_avl s')). + Definition elements (s:t) : list elt := Raw.elements s. + Definition min_elt (s:t) : option elt := Raw.min_elt s. + Definition max_elt (s:t) : option elt := Raw.max_elt s. + Definition choose (s:t) : option elt := Raw.choose s. + Definition fold (B : Set) (f : elt -> B -> B) (s:t) : B -> B := Raw.fold f s. + Definition cardinal (s:t) : nat := Raw.cardinal s. + Definition filter (f : elt -> bool) (s:t) : t := + Bbst _ (Raw.filter_bst f _ (is_bst s) (is_avl s)) + (Raw.filter_avl f _ (is_avl s)). + Definition for_all (f : elt -> bool) (s:t) : bool := Raw.for_all f s. + Definition exists_ (f : elt -> bool) (s:t) : bool := Raw.exists_ f s. + Definition partition (f : elt -> bool) (s:t) : t * t := + let p := Raw.partition f s in + (Bbst (fst p) (Raw.partition_bst_1 f _ (is_bst s) (is_avl s)) + (Raw.partition_avl_1 f _ (is_avl s)), + Bbst (snd p) (Raw.partition_bst_2 f _ (is_bst s) (is_avl s)) + (Raw.partition_avl_2 f _ (is_avl s))). + + Definition union (s s':t) : t := + let (u,p) := Raw.union _ _ (is_bst s) (is_avl s) (is_bst s') (is_avl s') in + let (b,p) := p in + let (a,_) := p in + Bbst u b a. + + Definition union' (s s' : t) : t := + Bbst _ (Raw.union'_bst _ _ (is_bst s) (is_avl s) (is_bst s') (is_avl s')) + (Raw.union'_avl _ _ (is_avl s) (is_avl s')). + + Definition equal (s s': t) : bool := if Raw.equal _ _ (is_bst s) (is_bst s') then true else false. + Definition equal' (s s':t) : bool := Raw.equal' s s'. + + Definition subset (s s':t) : bool := if Raw.subset _ _ (is_bst s) (is_bst s') then true else false. + Definition subset' (s s':t) : bool := Raw.subset' s s'. + + Definition eq (s s':t) : Prop := Raw.eq s s'. + Definition lt (s s':t) : Prop := Raw.lt s s'. + + Definition compare (s s':t) : Compare lt eq s s'. + Proof. + intros; elim (Raw.compare _ _ (is_bst s) (is_bst s')); + [ constructor 1 | constructor 2 | constructor 3 ]; + auto. + Defined. + + (* specs *) + Section Specs. + Variable s s' s'': t. + Variable x y : elt. + + Hint Resolve is_bst is_avl. + + Lemma mem_1 : In x s -> mem x s = true. + Proof. exact (Raw.mem_1 s x (is_bst s)). Qed. + Lemma mem_2 : mem x s = true -> In x s. + Proof. exact (Raw.mem_2 s x). Qed. + + Lemma equal_1 : Equal s s' -> equal s s' = true. + Proof. + unfold equal; destruct (Raw.equal s s'); simpl; auto. + Qed. + + Lemma equal_2 : equal s s' = true -> Equal s s'. + Proof. + unfold equal; destruct (Raw.equal s s'); simpl; intuition; discriminate. + Qed. + + Lemma equal'_1 : Equal s s' -> equal' s s' = true. + Proof. exact (Raw.equal'_1 _ _ (is_bst s) (is_avl s) (is_bst s') (is_avl s')). Qed. + Lemma equal'_2 : equal' s s' = true -> Equal s s'. + Proof. exact (Raw.equal'_2 _ _ (is_bst s) (is_avl s) (is_bst s') (is_avl s')). Qed. + + Lemma subset_1 : Subset s s' -> subset s s' = true. + Proof. + unfold subset; destruct (Raw.subset s s'); simpl; intuition. + Qed. + + Lemma subset_2 : subset s s' = true -> Subset s s'. + Proof. + unfold subset; destruct (Raw.subset s s'); simpl; intuition discriminate. + Qed. + + Lemma subset'_1 : Subset s s' -> subset' s s' = true. + Proof. exact (Raw.subset'_1 _ _ (is_bst s) (is_avl s) (is_bst s') (is_avl s')). Qed. + Lemma subset'_2 : subset' s s' = true -> Subset s s'. + Proof. exact (Raw.subset'_2 _ _ (is_bst s) (is_avl s) (is_bst s') (is_avl s')). Qed. + + Lemma empty_1 : Empty empty. + Proof. exact Raw.empty_1. Qed. + + Lemma is_empty_1 : Empty s -> is_empty s = true. + Proof. exact (Raw.is_empty_1 s). Qed. + Lemma is_empty_2 : is_empty s = true -> Empty s. + Proof. exact (Raw.is_empty_2 s). Qed. + + Lemma add_1 : E.eq x y -> In y (add x s). + Proof. + unfold add, In; simpl; rewrite Raw.add_in; auto. + Qed. + + Lemma add_2 : In y s -> In y (add x s). + Proof. + unfold add, In; simpl; rewrite Raw.add_in; auto. + Qed. + + Lemma add_3 : ~ E.eq x y -> In y (add x s) -> In y s. + Proof. + unfold add, In; simpl; rewrite Raw.add_in; intuition. + elim H; auto. + Qed. + + Lemma remove_1 : E.eq x y -> ~ In y (remove x s). + Proof. + unfold remove, In; simpl; rewrite Raw.remove_in; intuition. + Qed. + + Lemma remove_2 : ~ E.eq x y -> In y s -> In y (remove x s). + Proof. + unfold remove, In; simpl; rewrite Raw.remove_in; intuition. + Qed. + + Lemma remove_3 : In y (remove x s) -> In y s. + Proof. + unfold remove, In; simpl; rewrite Raw.remove_in; intuition. + Qed. + + Lemma singleton_1 : In y (singleton x) -> E.eq x y. + Proof. exact (Raw.singleton_1 x y). Qed. + Lemma singleton_2 : E.eq x y -> In y (singleton x). + Proof. exact (Raw.singleton_2 x y). Qed. + + Lemma union_1 : In x (union s s') -> In x s \/ In x s'. + Proof. + unfold union, In; simpl. + destruct (Raw.union s s' (is_bst s) (is_avl s) (is_bst s') (is_avl s')) + as (u,(b,(a,i))). + simpl in *; rewrite i; auto. + Qed. + + Lemma union_2 : In x s -> In x (union s s'). + Proof. + unfold union, In; simpl. + destruct (Raw.union s s' (is_bst s) (is_avl s) (is_bst s') (is_avl s')) + as (u,(b,(a,i))). + simpl in *; rewrite i; auto. + Qed. + + Lemma union_3 : In x s' -> In x (union s s'). + Proof. + unfold union, In; simpl. + destruct (Raw.union s s' (is_bst s) (is_avl s) (is_bst s') (is_avl s')) + as (u,(b,(a,i))). + simpl in *; rewrite i; auto. + Qed. + + Lemma union'_1 : In x (union' s s') -> In x s \/ In x s'. + Proof. + unfold union', In; simpl; rewrite Raw.union'_in; intuition. + Qed. + + Lemma union'_2 : In x s -> In x (union' s s'). + Proof. + unfold union', In; simpl; rewrite Raw.union'_in; intuition. + Qed. + + Lemma union'_3 : In x s' -> In x (union' s s'). + Proof. + unfold union', In; simpl; rewrite Raw.union'_in; intuition. + Qed. + + Lemma inter_1 : In x (inter s s') -> In x s. + Proof. + unfold inter, In; simpl; rewrite Raw.inter_in; intuition. + Qed. + + Lemma inter_2 : In x (inter s s') -> In x s'. + Proof. + unfold inter, In; simpl; rewrite Raw.inter_in; intuition. + Qed. + + Lemma inter_3 : In x s -> In x s' -> In x (inter s s'). + Proof. + unfold inter, In; simpl; rewrite Raw.inter_in; intuition. + Qed. + + Lemma diff_1 : In x (diff s s') -> In x s. + Proof. + unfold diff, In; simpl; rewrite Raw.diff_in; intuition. + Qed. + + Lemma diff_2 : In x (diff s s') -> ~ In x s'. + Proof. + unfold diff, In; simpl; rewrite Raw.diff_in; intuition. + Qed. + + Lemma diff_3 : In x s -> ~ In x s' -> In x (diff s s'). + Proof. + unfold diff, In; simpl; rewrite Raw.diff_in; intuition. + Qed. + + Lemma fold_1 : forall (A : Set) (i : A) (f : elt -> A -> A), + fold A f s i = fold_left (fun a e => f e a) (elements s) i. + Proof. + unfold fold, elements; intros; apply Raw.fold_1; auto. + Qed. + + Lemma cardinal_1 : cardinal s = length (elements s). + Proof. + unfold cardinal, elements; intros; apply Raw.cardinal_elements_1; auto. + Qed. + + Section Filter. + Variable f : elt -> bool. + + Lemma filter_1 : compat_bool E.eq f -> In x (filter f s) -> In x s. + Proof. + intro; unfold filter, In; simpl; rewrite Raw.filter_in; intuition. + Qed. + + Lemma filter_2 : compat_bool E.eq f -> In x (filter f s) -> f x = true. + Proof. + intro; unfold filter, In; simpl; rewrite Raw.filter_in; intuition. + Qed. + + Lemma filter_3 : compat_bool E.eq f -> In x s -> f x = true -> In x (filter f s). + Proof. + intro; unfold filter, In; simpl; rewrite Raw.filter_in; intuition. + Qed. + + Lemma for_all_1 : compat_bool E.eq f -> For_all (fun x => f x = true) s -> for_all f s = true. + Proof. exact (Raw.for_all_1 f s). Qed. + Lemma for_all_2 : compat_bool E.eq f -> for_all f s = true -> For_all (fun x => f x = true) s. + Proof. exact (Raw.for_all_2 f s). Qed. + + Lemma exists_1 : compat_bool E.eq f -> Exists (fun x => f x = true) s -> exists_ f s = true. + Proof. exact (Raw.exists_1 f s). Qed. + Lemma exists_2 : compat_bool E.eq f -> exists_ f s = true -> Exists (fun x => f x = true) s. + Proof. exact (Raw.exists_2 f s). Qed. + + Lemma partition_1 : compat_bool E.eq f -> + Equal (fst (partition f s)) (filter f s). + Proof. + unfold partition, filter, Equal, In; simpl ;intros H a. + rewrite Raw.partition_in_1; auto. + rewrite Raw.filter_in; intuition. + Qed. + + Lemma partition_2 : compat_bool E.eq f -> + Equal (snd (partition f s)) (filter (fun x => negb (f x)) s). + Proof. + unfold partition, filter, Equal, In; simpl ;intros H a. + rewrite Raw.partition_in_2; auto. + rewrite Raw.filter_in; intuition. + red; intros. + f_equal; auto. + destruct (f a); auto. + destruct (f a); auto. + Qed. + + End Filter. + + Lemma elements_1 : In x s -> InA E.eq x (elements s). + Proof. + unfold elements, In; rewrite Raw.elements_in; auto. + Qed. + + Lemma elements_2 : InA E.eq x (elements s) -> In x s. + Proof. + unfold elements, In; rewrite Raw.elements_in; auto. + Qed. + + Lemma elements_3 : sort E.lt (elements s). + Proof. exact (Raw.elements_sort _ (is_bst s)). Qed. + + Lemma min_elt_1 : min_elt s = Some x -> In x s. + Proof. exact (Raw.min_elt_1 s x). Qed. + Lemma min_elt_2 : min_elt s = Some x -> In y s -> ~ E.lt y x. + Proof. exact (Raw.min_elt_2 s x y (is_bst s)). Qed. + Lemma min_elt_3 : min_elt s = None -> Empty s. + Proof. exact (Raw.min_elt_3 s). Qed. + + Lemma max_elt_1 : max_elt s = Some x -> In x s. + Proof. exact (Raw.max_elt_1 s x). Qed. + Lemma max_elt_2 : max_elt s = Some x -> In y s -> ~ E.lt x y. + Proof. exact (Raw.max_elt_2 s x y (is_bst s)). Qed. + Lemma max_elt_3 : max_elt s = None -> Empty s. + Proof. exact (Raw.max_elt_3 s). Qed. + + Lemma choose_1 : choose s = Some x -> In x s. + Proof. exact (Raw.choose_1 s x). Qed. + Lemma choose_2 : choose s = None -> Empty s. + Proof. exact (Raw.choose_2 s). Qed. + + Lemma eq_refl : eq s s. + Proof. exact (Raw.eq_refl s). Qed. + Lemma eq_sym : eq s s' -> eq s' s. + Proof. exact (Raw.eq_sym s s'). Qed. + Lemma eq_trans : eq s s' -> eq s' s'' -> eq s s''. + Proof. exact (Raw.eq_trans s s' s''). Qed. + + Lemma lt_trans : lt s s' -> lt s' s'' -> lt s s''. + Proof. exact (Raw.lt_trans s s' s''). Qed. + Lemma lt_not_eq : lt s s' -> ~eq s s'. + Proof. exact (Raw.lt_not_eq _ _ (is_bst s) (is_bst s')). Qed. + + End Specs. +End IntMake. + +(* For concrete use inside Coq, we propose an instantiation of [Int] by [Z]. *) + +Module Make (X: OrderedType) <: S with Module E := X + :=IntMake(Z_as_Int)(X). + + diff --git a/theories/FSets/FSetBridge.v b/theories/FSets/FSetBridge.v index 3ea50df8..08985cfc 100644 --- a/theories/FSets/FSetBridge.v +++ b/theories/FSets/FSetBridge.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -(* $Id: FSetBridge.v 8639 2006-03-16 19:21:55Z letouzey $ *) +(* $Id: FSetBridge.v 8834 2006-05-20 00:41:35Z letouzey $ *) (** * Finite sets library *) @@ -109,7 +109,7 @@ Module DepOfNodep (M: S) <: Sdep with Module E := M.E. Definition elements : forall s : t, - {l : list elt | ME.Sort l /\ (forall x : elt, In x s <-> ME.In x l)}. + {l : list elt | sort E.lt l /\ (forall x : elt, In x s <-> InA E.eq x l)}. Proof. intros; exists (elements s); intuition. Defined. @@ -394,17 +394,17 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. Definition elements (s : t) : list elt := let (l, _) := elements s in l. - Lemma elements_1 : forall (s : t) (x : elt), In x s -> ME.In x (elements s). + Lemma elements_1 : forall (s : t) (x : elt), In x s -> InA E.eq x (elements s). Proof. intros; unfold elements in |- *; case (M.elements s); firstorder. Qed. - Lemma elements_2 : forall (s : t) (x : elt), ME.In x (elements s) -> In x s. + Lemma elements_2 : forall (s : t) (x : elt), InA E.eq x (elements s) -> In x s. Proof. intros s x; unfold elements in |- *; case (M.elements s); firstorder. Qed. - Lemma elements_3 : forall s : t, ME.Sort (elements s). + Lemma elements_3 : forall s : t, sort E.lt (elements s). Proof. intros; unfold elements in |- *; case (M.elements s); firstorder. Qed. diff --git a/theories/FSets/FSetEqProperties.v b/theories/FSets/FSetEqProperties.v index 006d78c7..d7062d5a 100644 --- a/theories/FSets/FSetEqProperties.v +++ b/theories/FSets/FSetEqProperties.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -(* $Id: FSetEqProperties.v 8639 2006-03-16 19:21:55Z letouzey $ *) +(* $Id: FSetEqProperties.v 8853 2006-05-23 18:17:38Z herbelin $ *) (** * Finite sets library *) @@ -276,7 +276,7 @@ Lemma is_empty_cardinal: is_empty s = zerob (cardinal s). Proof. intros; apply bool_1; split; intros. rewrite cardinal_1; simpl; auto. -assert (cardinal s = 0) by apply zerob_true_elim; auto. +assert (cardinal s = 0) by (apply zerob_true_elim; auto). auto. Qed. @@ -672,7 +672,7 @@ unfold Add, MP.Add; intros. repeat rewrite filter_iff; auto. rewrite H0; clear H0. assert (E.eq x y -> f y = true) by - intro H0; rewrite <- (Comp _ _ H0); auto. + (intro H0; rewrite <- (Comp _ _ H0); auto). tauto. Qed. @@ -704,6 +704,11 @@ assert (f a || g a = true <-> f a = true \/ g a = true). tauto. Qed. +Lemma filter_union: forall s s', filter f (union s s') [=] union (filter f s) (filter f s'). +Proof. +unfold Equal; intros; set_iff; repeat rewrite filter_iff; auto; set_iff; tauto. +Qed. + (** Properties of [for_all] *) Lemma for_all_mem_1: forall s, diff --git a/theories/FSets/FSetFacts.v b/theories/FSets/FSetFacts.v index d8c0b802..aa57f066 100644 --- a/theories/FSets/FSetFacts.v +++ b/theories/FSets/FSetFacts.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -(* $Id: FSetFacts.v 8681 2006-04-05 11:56:14Z letouzey $ *) +(* $Id: FSetFacts.v 8882 2006-05-31 21:55:30Z letouzey $ *) (** * Finite sets library *) @@ -131,7 +131,7 @@ Proof. split; [apply exists_1 | apply exists_2]; auto. Qed. -Lemma elements_iff : In x s <-> ME.In x (elements s). +Lemma elements_iff : In x s <-> InA E.eq x (elements s). Proof. split; [apply elements_1 | apply elements_2]. Qed. @@ -159,6 +159,12 @@ generalize (mem_iff s x) (mem_iff s y)(In_eq_iff s H). destruct (mem x s); destruct (mem y s); intuition. Qed. +Lemma empty_b : mem y empty = false. +Proof. +generalize (empty_iff y)(mem_iff empty y). +destruct (mem y empty); intuition. +Qed. + Lemma add_b : mem y (add x s) = eqb x y || mem y s. Proof. generalize (mem_iff (add x s) y)(mem_iff s y)(add_iff s x y); unfold eqb. diff --git a/theories/FSets/FSetInterface.v b/theories/FSets/FSetInterface.v index c177abfe..64ad234b 100644 --- a/theories/FSets/FSetInterface.v +++ b/theories/FSets/FSetInterface.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -(* $Id: FSetInterface.v 8671 2006-03-29 08:31:28Z letouzey $ *) +(* $Id: FSetInterface.v 8820 2006-05-15 11:44:05Z letouzey $ *) (** * Finite set library *) @@ -153,7 +153,7 @@ Module Type S. Section Spec. Variable s s' s'' : t. - Variable x y z : elt. + Variable x y : elt. (** Specification of [In] *) Parameter In_1 : E.eq x y -> In x s -> In y s. @@ -254,6 +254,8 @@ Module Type S. Parameter partition_2 : compat_bool E.eq f -> snd (partition f s) [=] filter (fun x => negb (f x)) s. + End Filter. + (** Specification of [elements] *) Parameter elements_1 : In x s -> InA E.eq x (elements s). Parameter elements_2 : InA E.eq x (elements s) -> In x s. @@ -275,7 +277,6 @@ Module Type S. (* Parameter choose_equal: (equal s s')=true -> E.eq (choose s) (choose s'). *) - End Filter. End Spec. (* begin hide *) diff --git a/theories/FSets/FSetList.v b/theories/FSets/FSetList.v index ca86ffcc..f6205542 100644 --- a/theories/FSets/FSetList.v +++ b/theories/FSets/FSetList.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -(* $Id: FSetList.v 8667 2006-03-28 11:59:44Z letouzey $ *) +(* $Id: FSetList.v 8834 2006-05-20 00:41:35Z letouzey $ *) (** * Finite sets library *) @@ -199,6 +199,8 @@ Module Raw (X: OrderedType). (** ** Proofs of set operation specifications. *) + Section ForNotations. + Notation Sort := (sort X.lt). Notation Inf := (lelistA X.lt). Notation In := (InA X.eq). @@ -1020,6 +1022,9 @@ Module Raw (X: OrderedType). destruct (e1 a0); auto. Defined. + End ForNotations. + Hint Constructors lt. + End Raw. (** * Encapsulation @@ -1029,135 +1034,213 @@ End Raw. Module Make (X: OrderedType) <: S with Module E := X. - Module E := X. Module Raw := Raw X. + Module E := X. - Record slist : Set := {this :> Raw.t; sorted : sort X.lt this}. + Record slist : Set := {this :> Raw.t; sorted : sort E.lt this}. Definition t := slist. - Definition elt := X.t. + Definition elt := E.t. - Definition In (x : elt) (s : t) := InA X.eq x s.(this). - Definition Equal s s' := forall a : elt, In a s <-> In a s'. - Definition Subset s s' := forall a : elt, In a s -> In a s'. - Definition Empty s := forall a : elt, ~ In a s. - Definition For_all (P : elt -> Prop) s := forall x, In x s -> P x. - Definition Exists (P : elt -> Prop) s := exists x, In x s /\ P x. - - Definition In_1 (s : t) := Raw.MX.In_eq (l:=s.(this)). - - Definition mem (x : elt) (s : t) := Raw.mem x s. - Definition mem_1 (s : t) := Raw.mem_1 (sorted s). - Definition mem_2 (s : t) := Raw.mem_2 (s:=s). - - Definition add x s := Build_slist (Raw.add_sort (sorted s) x). - Definition add_1 (s : t) := Raw.add_1 (sorted s). - Definition add_2 (s : t) := Raw.add_2 (sorted s). - Definition add_3 (s : t) := Raw.add_3 (sorted s). - - Definition remove x s := Build_slist (Raw.remove_sort (sorted s) x). - Definition remove_1 (s : t) := Raw.remove_1 (sorted s). - Definition remove_2 (s : t) := Raw.remove_2 (sorted s). - Definition remove_3 (s : t) := Raw.remove_3 (sorted s). - - Definition singleton x := Build_slist (Raw.singleton_sort x). - Definition singleton_1 := Raw.singleton_1. - Definition singleton_2 := Raw.singleton_2. - - Definition union (s s' : t) := + Definition In (x : elt) (s : t) : Prop := InA E.eq x s.(this). + Definition Equal (s s':t) : Prop := forall a : elt, In a s <-> In a s'. + Definition Subset (s s':t) : Prop := forall a : elt, In a s -> In a s'. + Definition Empty (s:t) : Prop := forall a : elt, ~ In a s. + Definition For_all (P : elt -> Prop)(s:t) : Prop := forall x, In x s -> P x. + Definition Exists (P : elt -> Prop)(s:t) : Prop := exists x, In x s /\ P x. + + Definition mem (x : elt) (s : t) : bool := Raw.mem x s. + Definition add (x : elt)(s : t) : t := Build_slist (Raw.add_sort (sorted s) x). + Definition remove (x : elt)(s : t) : t := Build_slist (Raw.remove_sort (sorted s) x). + Definition singleton (x : elt) : t := Build_slist (Raw.singleton_sort x). + Definition union (s s' : t) : t := Build_slist (Raw.union_sort (sorted s) (sorted s')). - Definition union_1 (s s' : t) := Raw.union_1 (sorted s) (sorted s'). - Definition union_2 (s s' : t) := Raw.union_2 (sorted s) (sorted s'). - Definition union_3 (s s' : t) := Raw.union_3 (sorted s) (sorted s'). - - Definition inter (s s' : t) := + Definition inter (s s' : t) : t := Build_slist (Raw.inter_sort (sorted s) (sorted s')). - Definition inter_1 (s s' : t) := Raw.inter_1 (sorted s) (sorted s'). - Definition inter_2 (s s' : t) := Raw.inter_2 (sorted s) (sorted s'). - Definition inter_3 (s s' : t) := Raw.inter_3 (sorted s) (sorted s'). - - Definition diff (s s' : t) := + Definition diff (s s' : t) : t := Build_slist (Raw.diff_sort (sorted s) (sorted s')). - Definition diff_1 (s s' : t) := Raw.diff_1 (sorted s) (sorted s'). - Definition diff_2 (s s' : t) := Raw.diff_2 (sorted s) (sorted s'). - Definition diff_3 (s s' : t) := Raw.diff_3 (sorted s) (sorted s'). - - Definition equal (s s' : t) := Raw.equal s s'. - Definition equal_1 (s s' : t) := Raw.equal_1 (sorted s) (sorted s'). - Definition equal_2 (s s' : t) := Raw.equal_2 (s:=s) (s':=s'). - - Definition subset (s s' : t) := Raw.subset s s'. - Definition subset_1 (s s' : t) := Raw.subset_1 (sorted s) (sorted s'). - Definition subset_2 (s s' : t) := Raw.subset_2 (s:=s) (s':=s'). + Definition equal (s s' : t) : bool := Raw.equal s s'. + Definition subset (s s' : t) : bool := Raw.subset s s'. + Definition empty : t := Build_slist Raw.empty_sort. + Definition is_empty (s : t) : bool := Raw.is_empty s. + Definition elements (s : t) : list elt := Raw.elements s. + Definition min_elt (s : t) : option elt := Raw.min_elt s. + Definition max_elt (s : t) : option elt := Raw.max_elt s. + Definition choose (s : t) : option elt := Raw.choose s. + Definition fold (B : Set) (f : elt -> B -> B) (s : t) : B -> B := Raw.fold (B:=B) f s. + Definition cardinal (s : t) : nat := Raw.cardinal s. + Definition filter (f : elt -> bool) (s : t) : t := + Build_slist (Raw.filter_sort (sorted s) f). + Definition for_all (f : elt -> bool) (s : t) : bool := Raw.for_all f s. + Definition exists_ (f : elt -> bool) (s : t) : bool := Raw.exists_ f s. + Definition partition (f : elt -> bool) (s : t) : t * t := + let p := Raw.partition f s in + (Build_slist (this:=fst p) (Raw.partition_sort_1 (sorted s) f), + Build_slist (this:=snd p) (Raw.partition_sort_2 (sorted s) f)). + Definition eq (s s' : t) : Prop := Raw.eq s s'. + Definition lt (s s' : t) : Prop := Raw.lt s s'. - Definition empty := Build_slist Raw.empty_sort. - Definition empty_1 := Raw.empty_1. - - Definition is_empty (s : t) := Raw.is_empty s. - Definition is_empty_1 (s : t) := Raw.is_empty_1 (s:=s). - Definition is_empty_2 (s : t) := Raw.is_empty_2 (s:=s). - - Definition elements (s : t) := Raw.elements s. - Definition elements_1 (s : t) := Raw.elements_1 (s:=s). - Definition elements_2 (s : t) := Raw.elements_2 (s:=s). - Definition elements_3 (s : t) := Raw.elements_3 (sorted s). - - Definition min_elt (s : t) := Raw.min_elt s. - Definition min_elt_1 (s : t) := Raw.min_elt_1 (s:=s). - Definition min_elt_2 (s : t) := Raw.min_elt_2 (sorted s). - Definition min_elt_3 (s : t) := Raw.min_elt_3 (s:=s). - - Definition max_elt (s : t) := Raw.max_elt s. - Definition max_elt_1 (s : t) := Raw.max_elt_1 (s:=s). - Definition max_elt_2 (s : t) := Raw.max_elt_2 (sorted s). - Definition max_elt_3 (s : t) := Raw.max_elt_3 (s:=s). - - Definition choose := min_elt. - Definition choose_1 := min_elt_1. - Definition choose_2 := min_elt_3. + Section Spec. + Variable s s' s'': t. + Variable x y : elt. + + Lemma In_1 : E.eq x y -> In x s -> In y s. + Proof. exact (fun H H' => Raw.MX.In_eq H H'). Qed. - Definition fold (B : Set) (f : elt -> B -> B) (s : t) := Raw.fold (B:=B) f s. - Definition fold_1 (s : t) := Raw.fold_1 (sorted s). + Lemma mem_1 : In x s -> mem x s = true. + Proof. exact (fun H => Raw.mem_1 s.(sorted) H). Qed. + Lemma mem_2 : mem x s = true -> In x s. + Proof. exact (fun H => Raw.mem_2 H). Qed. - Definition cardinal (s : t) := Raw.cardinal s. - Definition cardinal_1 (s : t) := Raw.cardinal_1 (sorted s). + Lemma equal_1 : Equal s s' -> equal s s' = true. + Proof. exact (Raw.equal_1 s.(sorted) s'.(sorted)). Qed. + Lemma equal_2 : equal s s' = true -> Equal s s'. + Proof. exact (fun H => Raw.equal_2 H). Qed. + + Lemma subset_1 : Subset s s' -> subset s s' = true. + Proof. exact (Raw.subset_1 s.(sorted) s'.(sorted)). Qed. + Lemma subset_2 : subset s s' = true -> Subset s s'. + Proof. exact (fun H => Raw.subset_2 H). Qed. + + Lemma empty_1 : Empty empty. + Proof. exact Raw.empty_1. Qed. + + Lemma is_empty_1 : Empty s -> is_empty s = true. + Proof. exact (fun H => Raw.is_empty_1 H). Qed. + Lemma is_empty_2 : is_empty s = true -> Empty s. + Proof. exact (fun H => Raw.is_empty_2 H). Qed. - Definition filter (f : elt -> bool) (s : t) := - Build_slist (Raw.filter_sort (sorted s) f). - Definition filter_1 (s : t) := Raw.filter_1 (s:=s). - Definition filter_2 (s : t) := Raw.filter_2 (s:=s). - Definition filter_3 (s : t) := Raw.filter_3 (s:=s). + Lemma add_1 : E.eq x y -> In y (add x s). + Proof. exact (fun H => Raw.add_1 s.(sorted) H). Qed. + Lemma add_2 : In y s -> In y (add x s). + Proof. exact (fun H => Raw.add_2 s.(sorted) x H). Qed. + Lemma add_3 : ~ E.eq x y -> In y (add x s) -> In y s. + Proof. exact (fun H => Raw.add_3 s.(sorted) H). Qed. + + Lemma remove_1 : E.eq x y -> ~ In y (remove x s). + Proof. exact (fun H => Raw.remove_1 s.(sorted) H). Qed. + Lemma remove_2 : ~ E.eq x y -> In y s -> In y (remove x s). + Proof. exact (fun H H' => Raw.remove_2 s.(sorted) H H'). Qed. + Lemma remove_3 : In y (remove x s) -> In y s. + Proof. exact (fun H => Raw.remove_3 s.(sorted) H). Qed. + + Lemma singleton_1 : In y (singleton x) -> E.eq x y. + Proof. exact (fun H => Raw.singleton_1 H). Qed. + Lemma singleton_2 : E.eq x y -> In y (singleton x). + Proof. exact (fun H => Raw.singleton_2 H). Qed. + + Lemma union_1 : In x (union s s') -> In x s \/ In x s'. + Proof. exact (fun H => Raw.union_1 s.(sorted) s'.(sorted) H). Qed. + Lemma union_2 : In x s -> In x (union s s'). + Proof. exact (fun H => Raw.union_2 s.(sorted) s'.(sorted) H). Qed. + Lemma union_3 : In x s' -> In x (union s s'). + Proof. exact (fun H => Raw.union_3 s.(sorted) s'.(sorted) H). Qed. + + Lemma inter_1 : In x (inter s s') -> In x s. + Proof. exact (fun H => Raw.inter_1 s.(sorted) s'.(sorted) H). Qed. + Lemma inter_2 : In x (inter s s') -> In x s'. + Proof. exact (fun H => Raw.inter_2 s.(sorted) s'.(sorted) H). Qed. + Lemma inter_3 : In x s -> In x s' -> In x (inter s s'). + Proof. exact (fun H => Raw.inter_3 s.(sorted) s'.(sorted) H). Qed. + + Lemma diff_1 : In x (diff s s') -> In x s. + Proof. exact (fun H => Raw.diff_1 s.(sorted) s'.(sorted) H). Qed. + Lemma diff_2 : In x (diff s s') -> ~ In x s'. + Proof. exact (fun H => Raw.diff_2 s.(sorted) s'.(sorted) H). Qed. + Lemma diff_3 : In x s -> ~ In x s' -> In x (diff s s'). + Proof. exact (fun H => Raw.diff_3 s.(sorted) s'.(sorted) H). Qed. - Definition for_all (f : elt -> bool) (s : t) := Raw.for_all f s. - Definition for_all_1 (s : t) := Raw.for_all_1 (s:=s). - Definition for_all_2 (s : t) := Raw.for_all_2 (s:=s). + Lemma fold_1 : forall (A : Set) (i : A) (f : elt -> A -> A), + fold f s i = fold_left (fun a e => f e a) (elements s) i. + Proof. exact (Raw.fold_1 s.(sorted)). Qed. - Definition exists_ (f : elt -> bool) (s : t) := Raw.exists_ f s. - Definition exists_1 (s : t) := Raw.exists_1 (s:=s). - Definition exists_2 (s : t) := Raw.exists_2 (s:=s). + Lemma cardinal_1 : cardinal s = length (elements s). + Proof. exact (Raw.cardinal_1 s.(sorted)). Qed. - Definition partition (f : elt -> bool) (s : t) := - let p := Raw.partition f s in - (Build_slist (this:=fst p) (Raw.partition_sort_1 (sorted s) f), - Build_slist (this:=snd p) (Raw.partition_sort_2 (sorted s) f)). - Definition partition_1 (s : t) := Raw.partition_1 s. - Definition partition_2 (s : t) := Raw.partition_2 s. - - Definition eq (s s' : t) := Raw.eq s s'. - Definition eq_refl (s : t) := Raw.eq_refl s. - Definition eq_sym (s s' : t) := Raw.eq_sym (s:=s) (s':=s'). - Definition eq_trans (s s' s'' : t) := - Raw.eq_trans (s:=s) (s':=s') (s'':=s''). + Section Filter. - Definition lt (s s' : t) := Raw.lt s s'. - Definition lt_trans (s s' s'' : t) := - Raw.lt_trans (s:=s) (s':=s') (s'':=s''). - Definition lt_not_eq (s s' : t) := Raw.lt_not_eq (sorted s) (sorted s'). - - Definition compare : forall s s' : t, Compare lt eq s s'. - Proof. - intros; elim (Raw.compare (sorted s) (sorted s')); - [ constructor 1 | constructor 2 | constructor 3 ]; - auto. - Defined. + Variable f : elt -> bool. + + Lemma filter_1 : compat_bool E.eq f -> In x (filter f s) -> In x s. + Proof. exact (@Raw.filter_1 s x f). Qed. + Lemma filter_2 : compat_bool E.eq f -> In x (filter f s) -> f x = true. + Proof. exact (@Raw.filter_2 s x f). Qed. + Lemma filter_3 : + compat_bool E.eq f -> In x s -> f x = true -> In x (filter f s). + Proof. exact (@Raw.filter_3 s x f). Qed. + + Lemma for_all_1 : + compat_bool E.eq f -> + For_all (fun x => f x = true) s -> for_all f s = true. + Proof. exact (@Raw.for_all_1 s f). Qed. + Lemma for_all_2 : + compat_bool E.eq f -> + for_all f s = true -> For_all (fun x => f x = true) s. + Proof. exact (@Raw.for_all_2 s f). Qed. + + Lemma exists_1 : + compat_bool E.eq f -> + Exists (fun x => f x = true) s -> exists_ f s = true. + Proof. exact (@Raw.exists_1 s f). Qed. + Lemma exists_2 : + compat_bool E.eq f -> + exists_ f s = true -> Exists (fun x => f x = true) s. + Proof. exact (@Raw.exists_2 s f). Qed. + + Lemma partition_1 : + compat_bool E.eq f -> Equal (fst (partition f s)) (filter f s). + Proof. exact (@Raw.partition_1 s f). Qed. + Lemma partition_2 : + compat_bool E.eq f -> + Equal (snd (partition f s)) (filter (fun x => negb (f x)) s). + Proof. exact (@Raw.partition_2 s f). Qed. + + End Filter. + + Lemma elements_1 : In x s -> InA E.eq x (elements s). + Proof. exact (fun H => Raw.elements_1 H). Qed. + Lemma elements_2 : InA E.eq x (elements s) -> In x s. + Proof. exact (fun H => Raw.elements_2 H). Qed. + Lemma elements_3 : sort E.lt (elements s). + Proof. exact (Raw.elements_3 s.(sorted)). Qed. + + Lemma min_elt_1 : min_elt s = Some x -> In x s. + Proof. exact (fun H => Raw.min_elt_1 H). Qed. + Lemma min_elt_2 : min_elt s = Some x -> In y s -> ~ E.lt y x. + Proof. exact (fun H => Raw.min_elt_2 s.(sorted) H). Qed. + Lemma min_elt_3 : min_elt s = None -> Empty s. + Proof. exact (fun H => Raw.min_elt_3 H). Qed. + + Lemma max_elt_1 : max_elt s = Some x -> In x s. + Proof. exact (fun H => Raw.max_elt_1 H). Qed. + Lemma max_elt_2 : max_elt s = Some x -> In y s -> ~ E.lt x y. + Proof. exact (fun H => Raw.max_elt_2 s.(sorted) H). Qed. + Lemma max_elt_3 : max_elt s = None -> Empty s. + Proof. exact (fun H => Raw.max_elt_3 H). Qed. + + Lemma choose_1 : choose s = Some x -> In x s. + Proof. exact (fun H => Raw.choose_1 H). Qed. + Lemma choose_2 : choose s = None -> Empty s. + Proof. exact (fun H => Raw.choose_2 H). Qed. + + Lemma eq_refl : eq s s. + Proof. exact (Raw.eq_refl s). Qed. + Lemma eq_sym : eq s s' -> eq s' s. + Proof. exact (@Raw.eq_sym s s'). Qed. + Lemma eq_trans : eq s s' -> eq s' s'' -> eq s s''. + Proof. exact (@Raw.eq_trans s s' s''). Qed. + + Lemma lt_trans : lt s s' -> lt s' s'' -> lt s s''. + Proof. exact (@Raw.lt_trans s s' s''). Qed. + Lemma lt_not_eq : lt s s' -> ~ eq s s'. + Proof. exact (Raw.lt_not_eq s.(sorted) s'.(sorted)). Qed. + + Definition compare : Compare lt eq s s'. + Proof. + elim (Raw.compare s.(sorted) s'.(sorted)); + [ constructor 1 | constructor 2 | constructor 3 ]; + auto. + Defined. + + End Spec. End Make. diff --git a/theories/FSets/FSetProperties.v b/theories/FSets/FSetProperties.v index 23843084..6e93a546 100644 --- a/theories/FSets/FSetProperties.v +++ b/theories/FSets/FSetProperties.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -(* $Id: FSetProperties.v 8639 2006-03-16 19:21:55Z letouzey $ *) +(* $Id: FSetProperties.v 8853 2006-05-23 18:17:38Z herbelin $ *) (** * Finite sets library *) @@ -21,49 +21,13 @@ Require Import FSetFacts. Set Implicit Arguments. Unset Strict Implicit. -Section Misc. -Variable A B : Set. -Variable eqA : A -> A -> Prop. -Variable eqB : B -> B -> Prop. - -(** Two-argument functions that allow to reorder its arguments. *) -Definition transpose (f : A -> B -> B) := - forall (x y : A) (z : B), eqB (f x (f y z)) (f y (f x z)). - -(** Compatibility of a two-argument function with respect to two equalities. *) -Definition compat_op (f : A -> B -> B) := - forall (x x' : A) (y y' : B), eqA x x' -> eqB y y' -> eqB (f x y) (f x' y'). - -(** Compatibility of a function upon natural numbers. *) -Definition compat_nat (f : A -> nat) := - forall x x' : A, eqA x x' -> f x = f x'. - -End Misc. Hint Unfold transpose compat_op compat_nat. - Hint Extern 1 (Setoid_Theory _ _) => constructor; congruence. -Ltac trans_st x := match goal with - | H : Setoid_Theory _ ?eqA |- ?eqA _ _ => - apply (Seq_trans _ _ H) with x; auto - end. - -Ltac sym_st := match goal with - | H : Setoid_Theory _ ?eqA |- ?eqA _ _ => - apply (Seq_sym _ _ H); auto - end. - -Ltac refl_st := match goal with - | H : Setoid_Theory _ ?eqA |- ?eqA _ _ => - apply (Seq_refl _ _ H); auto - end. - -Definition gen_st : forall A : Set, Setoid_Theory _ (@eq A). -Proof. auto. Qed. - Module Properties (M: S). - Module ME := OrderedTypeFacts M.E. - Import ME. + Module ME:=OrderedTypeFacts(M.E). + Import ME. (* for ME.eq_dec *) + Import M.E. Import M. Import Logic. (* to unmask [eq] *) Import Peano. (* to unmask [lt] *) @@ -82,26 +46,29 @@ Module Properties (M: S). Qed. Section BasicProperties. - Variable s s' s'' s1 s2 s3 : t. - Variable x : elt. (** properties of [Equal] *) - Lemma equal_refl : s[=]s. + Lemma equal_refl : forall s, s[=]s. Proof. - apply eq_refl. + unfold Equal; intuition. Qed. - Lemma equal_sym : s[=]s' -> s'[=]s. + Lemma equal_sym : forall s s', s[=]s' -> s'[=]s. Proof. - apply eq_sym. + unfold Equal; intros. + rewrite H; intuition. Qed. - Lemma equal_trans : s1[=]s2 -> s2[=]s3 -> s1[=]s3. + Lemma equal_trans : forall s1 s2 s3, s1[=]s2 -> s2[=]s3 -> s1[=]s3. Proof. - intros; apply eq_trans with s2; auto. + unfold Equal; intros. + rewrite H; exact (H0 a). Qed. + Variable s s' s'' s1 s2 s3 : t. + Variable x x' : elt. + (** properties of [Subset] *) Lemma subset_refl : s[<=]s. @@ -154,6 +121,11 @@ Module Properties (M: S). Proof. unfold Subset; intuition. Qed. + + Lemma double_inclusion : s1[=]s2 <-> s1[<=]s2 /\ s2[<=]s1. + Proof. + unfold Subset, Equal; split; intros; intuition; generalize (H a); intuition. + Qed. (** properties of [empty] *) @@ -174,6 +146,11 @@ Module Properties (M: S). unfold Equal; intros; set_iff; intuition. rewrite <- H1; auto. Qed. + + Lemma add_add : add x (add x' s) [=] add x' (add x s). + Proof. + unfold Equal; intros; set_iff; tauto. + Qed. (** properties of [remove] *) @@ -185,7 +162,7 @@ Module Properties (M: S). Lemma Equal_remove : s[=]s' -> remove x s [=] remove x s'. Proof. - intros; rewrite H; apply eq_refl. + intros; rewrite H; apply equal_refl. Qed. (** properties of [add] and [remove] *) @@ -223,12 +200,12 @@ Module Properties (M: S). Lemma union_equal_1 : s[=]s' -> union s s'' [=] union s' s''. Proof. - intros; rewrite H; apply eq_refl. + intros; rewrite H; apply equal_refl. Qed. Lemma union_equal_2 : s'[=]s'' -> union s s' [=] union s s''. Proof. - intros; rewrite H; apply eq_refl. + intros; rewrite H; apply equal_refl. Qed. Lemma union_assoc : union (union s s') s'' [=] union s (union s' s''). @@ -261,6 +238,16 @@ Module Properties (M: S). unfold Subset; intros H H0 a; set_iff; intuition. Qed. + Lemma union_subset_4 : s[<=]s' -> union s s'' [<=] union s' s''. + Proof. + unfold Subset; intros H a; set_iff; intuition. + Qed. + + Lemma union_subset_5 : s[<=]s' -> union s'' s [<=] union s'' s'. + Proof. + unfold Subset; intros H a; set_iff; intuition. + Qed. + Lemma empty_union_1 : Empty s -> union s s' [=] s'. Proof. unfold Equal, Empty; intros; set_iff; firstorder. @@ -290,12 +277,12 @@ Module Properties (M: S). Lemma inter_equal_1 : s[=]s' -> inter s s'' [=] inter s' s''. Proof. - intros; rewrite H; apply eq_refl. + intros; rewrite H; apply equal_refl. Qed. Lemma inter_equal_2 : s'[=]s'' -> inter s s' [=] inter s s''. Proof. - intros; rewrite H; apply eq_refl. + intros; rewrite H; apply equal_refl. Qed. Lemma inter_assoc : inter (inter s s') s'' [=] inter s (inter s' s''). @@ -447,140 +434,14 @@ Module Properties (M: S). empty_diff_2 union_Add inter_Add union_Equal inter_Add_2 not_in_union inter_subset_1 inter_subset_2 inter_subset_3 diff_subset diff_subset_equal remove_diff_singleton diff_inter_empty diff_inter_all Add_add Add_remove - Equal_remove : set. - - Notation NoDup := (NoDupA E.eq). - Notation EqList := (eqlistA E.eq). - - Section NoDupA_Remove. - - Let ListAdd x l l' := forall y : elt, ME.In y l' <-> E.eq x y \/ ME.In y l. - - Lemma removeA_add : - forall s s' x x', NoDup s -> NoDup (x' :: s') -> - ~ E.eq x x' -> ~ ME.In x s -> - ListAdd x s (x' :: s') -> ListAdd x (removeA eq_dec x' s) s'. - Proof. - unfold ListAdd; intros. - inversion_clear H0. - rewrite removeA_InA; auto; [apply E.eq_trans|]. - split; intros. - destruct (eq_dec x y); auto; intros. - right; split; auto. - destruct (H3 y); clear H3. - destruct H6; intuition. - swap H4; apply In_eq with y; auto. - destruct H0. - assert (ME.In y (x' :: s')) by rewrite H3; auto. - inversion_clear H6; auto. - elim H1; apply E.eq_trans with y; auto. - destruct H0. - assert (ME.In y (x' :: s')) by rewrite H3; auto. - inversion_clear H7; auto. - elim H6; auto. - Qed. - - Variables (A:Set)(eqA:A->A->Prop)(st:Setoid_Theory _ eqA). - Variables (f:elt->A->A)(Comp:compat_op E.eq eqA f)(Ass:transpose eqA f). - Variables (i:A). - - Lemma removeA_fold_right_0 : - forall s x, NoDup s -> ~ME.In x s -> - eqA (fold_right f i s) (fold_right f i (removeA eq_dec x s)). - Proof. - simple induction s; simpl; intros. - refl_st. - inversion_clear H0. - destruct (eq_dec x a); simpl; intros. - absurd_hyp e; auto. - apply Comp; auto. - Qed. - - Lemma removeA_fold_right : - forall s x, NoDup s -> ME.In x s -> - eqA (fold_right f i s) (f x (fold_right f i (removeA eq_dec x s))). - Proof. - simple induction s; simpl. - inversion_clear 2. - intros. - inversion_clear H0. - destruct (eq_dec x a); simpl; intros. - apply Comp; auto. - apply removeA_fold_right_0; auto. - swap H2; apply ME.In_eq with x; auto. - inversion_clear H1. - destruct n; auto. - trans_st (f a (f x (fold_right f i (removeA eq_dec x l)))). - Qed. - - Lemma fold_right_equal : - forall s s', NoDup s -> NoDup s' -> - EqList s s' -> eqA (fold_right f i s) (fold_right f i s'). - Proof. - simple induction s. - destruct s'; simpl. - intros; refl_st; auto. - unfold eqlistA; intros. - destruct (H1 t0). - assert (X : ME.In t0 nil); auto; inversion X. - intros x l Hrec s' N N' E; simpl in *. - trans_st (f x (fold_right f i (removeA eq_dec x s'))). - apply Comp; auto. - apply Hrec; auto. - inversion N; auto. - apply removeA_NoDupA; auto; apply E.eq_trans. - apply removeA_eqlistA; auto; [apply E.eq_trans|]. - inversion_clear N; auto. - sym_st. - apply removeA_fold_right; auto. - unfold eqlistA in E. - rewrite <- E; auto. - Qed. - - Lemma fold_right_add : - forall s' s x, NoDup s -> NoDup s' -> ~ ME.In x s -> - ListAdd x s s' -> eqA (fold_right f i s') (f x (fold_right f i s)). - Proof. - simple induction s'. - unfold ListAdd; intros. - destruct (H2 x); clear H2. - assert (X : ME.In x nil); auto; inversion X. - intros x' l' Hrec s x N N' IN EQ; simpl. - (* if x=x' *) - destruct (eq_dec x x'). - apply Comp; auto. - apply fold_right_equal; auto. - inversion_clear N'; trivial. - unfold eqlistA; unfold ListAdd in EQ; intros. - destruct (EQ x0); clear EQ. - split; intros. - destruct H; auto. - inversion_clear N'. - destruct H2; apply In_eq with x0; auto; order. - assert (X:ME.In x0 (x' :: l')); auto; inversion_clear X; auto. - destruct IN; apply In_eq with x0; auto; order. - (* else x<>x' *) - trans_st (f x' (f x (fold_right f i (removeA eq_dec x' s)))). - apply Comp; auto. - apply Hrec; auto. - apply removeA_NoDupA; auto; apply E.eq_trans. - inversion_clear N'; auto. - rewrite removeA_InA; auto; [apply E.eq_trans|intuition]. - apply removeA_add; auto. - trans_st (f x (f x' (fold_right f i (removeA eq_dec x' s)))). - apply Comp; auto. - sym_st. - apply removeA_fold_right; auto. - destruct (EQ x'). - destruct H; auto; destruct n; auto. - Qed. - - End NoDupA_Remove. + Equal_remove add_add : set. (** * Alternative (weaker) specifications for [fold] *) Section Old_Spec_Now_Properties. + Notation NoDup := (NoDupA E.eq). + (** When [FSets] was first designed, the order in which Ocaml's [Set.fold] takes the set elements was unspecified. This specification reflects this fact: *) @@ -629,7 +490,9 @@ Module Properties (M: S). intros; destruct (fold_0 s i f) as (l,(Hl, (Hl1, Hl2))); destruct (fold_0 s' i f) as (l',(Hl', (Hl'1, Hl'2))). rewrite Hl2; rewrite Hl'2; clear Hl2 Hl'2. - apply fold_right_add with (eqA := eqA); auto. + apply fold_right_add with (eqA:=E.eq)(eqB:=eqA); auto. + eauto. + exact eq_dec. rewrite <- Hl1; auto. intros; rewrite <- Hl1; rewrite <- Hl'1; auto. Qed. @@ -897,8 +760,8 @@ Module Properties (M: S). forall s p, fold (fun _ => S) s p = fold (fun _ => S) s 0 + p. Proof. assert (st := gen_st nat). - assert (fe : compat_op E.eq (@eq _) (fun _ => S)) by unfold compat_op; auto. - assert (fp : transpose (@eq _) (fun _:elt => S)) by unfold transpose; auto. + assert (fe : compat_op E.eq (@eq _) (fun _ => S)) by (unfold compat_op; auto). + assert (fp : transpose (@eq _) (fun _:elt => S)) by (unfold transpose; auto). intros s p; pattern s; apply set_induction; clear s; intros. rewrite (fold_1 st p (fun _ => S) H). rewrite (fold_1 st 0 (fun _ => S) H); trivial. @@ -956,7 +819,23 @@ Module Properties (M: S). rewrite (inter_subset_equal H); auto with arith. Qed. - Lemma union_inter_cardinal : + Lemma subset_cardinal_lt : + forall s s' x, s[<=]s' -> In x s' -> ~In x s -> cardinal s < cardinal s'. + Proof. + intros. + rewrite <- (diff_inter_cardinal s' s). + rewrite (inter_sym s' s). + rewrite (inter_subset_equal H). + generalize (@cardinal_inv_1 (diff s' s)). + destruct (cardinal (diff s' s)). + intro H2; destruct (H2 (refl_equal _) x). + set_iff; auto. + intros _. + change (0 + cardinal s < S n + cardinal s). + apply Plus.plus_lt_le_compat; auto with arith. + Qed. + + Theorem union_inter_cardinal : forall s s', cardinal (union s s') + cardinal (inter s s') = cardinal s + cardinal s' . Proof. intros. @@ -965,6 +844,15 @@ Module Properties (M: S). apply fold_union_inter with (eqA:=@eq nat); auto. Qed. + Lemma union_cardinal_inter : + forall s s', cardinal (union s s') = cardinal s + cardinal s' - cardinal (inter s s'). + Proof. + intros. + rewrite <- union_inter_cardinal. + rewrite Plus.plus_comm. + auto with arith. + Qed. + Lemma union_cardinal_le : forall s s', cardinal (union s s') <= cardinal s + cardinal s'. Proof. diff --git a/theories/FSets/FSetToFiniteSet.v b/theories/FSets/FSetToFiniteSet.v new file mode 100644 index 00000000..8cf85efe --- /dev/null +++ b/theories/FSets/FSetToFiniteSet.v @@ -0,0 +1,139 @@ +(***********************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * INRIA-Rocquencourt & LRI-CNRS-Orsay *) +(* \VV/ *************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(***********************************************************************) + +(* Finite sets library. + * Authors: Pierre Letouzey and Jean-Christophe Filliâtre + * Institution: LRI, CNRS UMR 8623 - Université Paris Sud + * 91405 Orsay, France *) + +(* $Id: FSetToFiniteSet.v 8876 2006-05-30 13:43:15Z letouzey $ *) + +Require Import Ensembles Finite_sets. +Require Import FSetInterface FSetProperties OrderedTypeEx. + +(** * Going from [FSets] with usual equality + to the old [Ensembles] and [Finite_sets] theory. *) + +Module S_to_Finite_set (U:UsualOrderedType)(M:S with Module E := U). + Module MP:= Properties(M). + Import M MP FM Ensembles Finite_sets. + + Definition mkEns : M.t -> Ensemble M.elt := + fun s x => M.In x s. + + Notation " !! " := mkEns. + + Lemma In_In : forall s x, M.In x s <-> In _ (!!s) x. + Proof. + unfold In; compute; auto. + Qed. + + Lemma Subset_Included : forall s s', s[<=]s' <-> Included _ (!!s) (!!s'). + Proof. + unfold Subset, Included, In, mkEns; intuition. + Qed. + + Notation " a === b " := (Same_set M.elt a b) (at level 70, no associativity). + + Lemma Equal_Same_set : forall s s', s[=]s' <-> !!s === !!s'. + Proof. + intros. + rewrite double_inclusion. + unfold Subset, Included, Same_set, In, mkEns; intuition. + Qed. + + Lemma empty_Empty_Set : !!M.empty === Empty_set _. + Proof. + unfold Same_set, Included, mkEns, In. + split; intro; set_iff; inversion 1. + Qed. + + Lemma Empty_Empty_set : forall s, Empty s -> !!s === Empty_set _. + Proof. + unfold Same_set, Included, mkEns, In. + split; intros. + destruct(H x H0). + inversion H0. + Qed. + + Lemma singleton_Singleton : forall x, !!(M.singleton x) === Singleton _ x . + Proof. + unfold Same_set, Included, mkEns, In. + split; intro; set_iff; inversion 1; try constructor; auto. + Qed. + + Lemma union_Union : forall s s', !!(union s s') === Union _ (!!s) (!!s'). + Proof. + unfold Same_set, Included, mkEns, In. + split; intro; set_iff; inversion 1; [ constructor 1 | constructor 2 | | ]; auto. + Qed. + + Lemma inter_Intersection : forall s s', !!(inter s s') === Intersection _ (!!s) (!!s'). + Proof. + unfold Same_set, Included, mkEns, In. + split; intro; set_iff; inversion 1; try constructor; auto. + Qed. + + Lemma add_Add : forall x s, !!(add x s) === Add _ (!!s) x. + Proof. + unfold Same_set, Included, mkEns, In. + split; intro; set_iff; inversion 1; unfold E.eq; auto with sets. + inversion H0. + constructor 2; constructor. + constructor 1; auto. + Qed. + + Lemma Add_Add : forall x s s', MP.Add x s s' -> !!s' === Add _ (!!s) x. + Proof. + unfold Same_set, Included, mkEns, In. + split; intros. + red in H; rewrite H in H0. + destruct H0. + inversion H0. + constructor 2; constructor. + constructor 1; auto. + red in H; rewrite H; unfold E.eq in *. + inversion H0; auto. + inversion H1; auto. + Qed. + + Lemma remove_Subtract : forall x s, !!(remove x s) === Subtract _ (!!s) x. + Proof. + unfold Same_set, Included, mkEns, In. + split; intro; set_iff; inversion 1; unfold E.eq in *; auto with sets. + split; auto. + swap H1. + inversion H2; auto. + Qed. + + Lemma mkEns_Finite : forall s, Finite _ (!!s). + Proof. + intro s; pattern s; apply set_induction; clear s; intros. + intros; replace (!!s) with (Empty_set elt); auto with sets. + symmetry; apply Extensionality_Ensembles. + apply Empty_Empty_set; auto. + replace (!!s') with (Add _ (!!s) x). + constructor 2; auto. + symmetry; apply Extensionality_Ensembles. + apply Add_Add; auto. + Qed. + + Lemma mkEns_cardinal : forall s, cardinal _ (!!s) (M.cardinal s). + Proof. + intro s; pattern s; apply set_induction; clear s; intros. + intros; replace (!!s) with (Empty_set elt); auto with sets. + rewrite cardinal_1; auto with sets. + symmetry; apply Extensionality_Ensembles. + apply Empty_Empty_set; auto. + replace (!!s') with (Add _ (!!s) x). + rewrite (cardinal_2 H0 H1); auto with sets. + symmetry; apply Extensionality_Ensembles. + apply Add_Add; auto. + Qed. + +End S_to_Finite_set. diff --git a/theories/FSets/FSetWeak.v b/theories/FSets/FSetWeak.v index 7ed61c9f..bfe34cd7 100644 --- a/theories/FSets/FSetWeak.v +++ b/theories/FSets/FSetWeak.v @@ -6,9 +6,11 @@ (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -(* $Id: FSetWeak.v 8641 2006-03-17 09:56:54Z letouzey $ *) +(* $Id: FSetWeak.v 8819 2006-05-15 09:52:36Z letouzey $ *) Require Export DecidableType. +Require Export DecidableTypeEx. Require Export FSetWeakInterface. Require Export FSetFacts. +Require Export FSetProperties. Require Export FSetWeakList. diff --git a/theories/FSets/FSetWeakFacts.v b/theories/FSets/FSetWeakFacts.v index 46a73cc9..61797a95 100644 --- a/theories/FSets/FSetWeakFacts.v +++ b/theories/FSets/FSetWeakFacts.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -(* $Id: FSetWeakFacts.v 8681 2006-04-05 11:56:14Z letouzey $ *) +(* $Id: FSetWeakFacts.v 8882 2006-05-31 21:55:30Z letouzey $ *) (** * Finite sets library *) @@ -159,6 +159,12 @@ generalize (mem_iff s x) (mem_iff s y)(In_eq_iff s H). destruct (mem x s); destruct (mem y s); intuition. Qed. +Lemma empty_b : mem y empty = false. +Proof. +generalize (empty_iff y)(mem_iff empty y). +destruct (mem y empty); intuition. +Qed. + Lemma add_b : mem y (add x s) = eqb x y || mem y s. Proof. generalize (mem_iff (add x s) y)(mem_iff s y)(add_iff s x y); unfold eqb. diff --git a/theories/FSets/FSetWeakInterface.v b/theories/FSets/FSetWeakInterface.v index c1845494..a281ce22 100644 --- a/theories/FSets/FSetWeakInterface.v +++ b/theories/FSets/FSetWeakInterface.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -(* $Id: FSetWeakInterface.v 8641 2006-03-17 09:56:54Z letouzey $ *) +(* $Id: FSetWeakInterface.v 8820 2006-05-15 11:44:05Z letouzey $ *) (** * Finite sets library *) @@ -132,8 +132,8 @@ Module Type S. Section Spec. - Variable s s' s'' : t. - Variable x y z : elt. + Variable s s' : t. + Variable x y : elt. (** Specification of [In] *) Parameter In_1 : E.eq x y -> In x s -> In y s. @@ -226,15 +226,17 @@ Module Type S. compat_bool E.eq f -> Equal (snd (partition f s)) (filter (fun x => negb (f x)) s). + End Filter. + (** Specification of [elements] *) Parameter elements_1 : In x s -> InA E.eq x (elements s). Parameter elements_2 : InA E.eq x (elements s) -> In x s. + Parameter elements_3 : NoDupA E.eq (elements s). (** Specification of [choose] *) Parameter choose_1 : choose s = Some x -> In x s. Parameter choose_2 : choose s = None -> Empty s. - End Filter. End Spec. Hint Immediate In_1. @@ -243,6 +245,7 @@ Module Type S. is_empty_1 is_empty_2 choose_1 choose_2 add_1 add_2 add_3 remove_1 remove_2 remove_3 singleton_1 singleton_2 union_1 union_2 union_3 inter_1 inter_2 inter_3 diff_1 diff_2 diff_3 filter_1 filter_2 filter_3 for_all_1 - for_all_2 exists_1 exists_2 partition_1 partition_2 elements_1 elements_2. + for_all_2 exists_1 exists_2 partition_1 partition_2 elements_1 elements_2 + elements_3. End S. diff --git a/theories/FSets/FSetWeakList.v b/theories/FSets/FSetWeakList.v index 74c81f37..97080b7a 100644 --- a/theories/FSets/FSetWeakList.v +++ b/theories/FSets/FSetWeakList.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -(* $Id: FSetWeakList.v 8639 2006-03-16 19:21:55Z letouzey $ *) +(* $Id: FSetWeakList.v 8834 2006-05-20 00:41:35Z letouzey $ *) (** * Finite sets library *) @@ -114,7 +114,7 @@ Module Raw (X: DecidableType). end. (** ** Proofs of set operation specifications. *) - + Section ForNotations. Notation NoDup := (NoDupA X.eq). Notation In := (InA X.eq). @@ -750,6 +750,7 @@ Module Raw (X: DecidableType). unfold eq, Equal; firstorder. Qed. + End ForNotations. End Raw. (** * Encapsulation @@ -759,115 +760,177 @@ End Raw. Module Make (X: DecidableType) <: S with Module E := X. - Module E := X. Module Raw := Raw X. + Module E := X. - Record slist : Set := {this :> Raw.t; unique : NoDupA X.eq this}. + Record slist : Set := {this :> Raw.t; unique : NoDupA E.eq this}. Definition t := slist. - Definition elt := X.t. + Definition elt := E.t. - Definition In (x : elt) (s : t) := InA X.eq x s.(this). - Definition Equal s s' := forall a : elt, In a s <-> In a s'. - Definition Subset s s' := forall a : elt, In a s -> In a s'. - Definition Empty s := forall a : elt, ~ In a s. - Definition For_all (P : elt -> Prop) (s : t) := + Definition In (x : elt) (s : t) : Prop := InA E.eq x s.(this). + Definition Equal (s s':t) : Prop := forall a : elt, In a s <-> In a s'. + Definition Subset (s s':t) : Prop := forall a : elt, In a s -> In a s'. + Definition Empty (s:t) : Prop := forall a : elt, ~ In a s. + Definition For_all (P : elt -> Prop) (s : t) : Prop := forall x : elt, In x s -> P x. - Definition Exists (P : elt -> Prop) (s : t) := exists x : elt, In x s /\ P x. - - Definition In_1 (s : t) := Raw.In_eq (s:=s). - - Definition mem (x : elt) (s : t) := Raw.mem x s. - Definition mem_1 (s : t) := Raw.mem_1 (s:=s). - Definition mem_2 (s : t) := Raw.mem_2 (s:=s). - - Definition add x s := Build_slist (Raw.add_unique (unique s) x). - Definition add_1 (s : t) := Raw.add_1 (unique s). - Definition add_2 (s : t) := Raw.add_2 (unique s). - Definition add_3 (s : t) := Raw.add_3 (unique s). - - Definition remove x s := Build_slist (Raw.remove_unique (unique s) x). - Definition remove_1 (s : t) := Raw.remove_1 (unique s). - Definition remove_2 (s : t) := Raw.remove_2 (unique s). - Definition remove_3 (s : t) := Raw.remove_3 (unique s). - - Definition singleton x := Build_slist (Raw.singleton_unique x). - Definition singleton_1 := Raw.singleton_1. - Definition singleton_2 := Raw.singleton_2. - - Definition union (s s' : t) := - Build_slist (Raw.union_unique (unique s) (unique s')). - Definition union_1 (s s' : t) := Raw.union_1 (unique s) (unique s'). - Definition union_2 (s s' : t) := Raw.union_2 (unique s) (unique s'). - Definition union_3 (s s' : t) := Raw.union_3 (unique s) (unique s'). + Definition Exists (P : elt -> Prop) (s : t) : Prop := exists x : elt, In x s /\ P x. - Definition inter (s s' : t) := + Definition mem (x : elt) (s : t) : bool := Raw.mem x s. + Definition add (x : elt)(s : t) : t := Build_slist (Raw.add_unique (unique s) x). + Definition remove (x : elt)(s : t) : t := Build_slist (Raw.remove_unique (unique s) x). + Definition singleton (x : elt) : t := Build_slist (Raw.singleton_unique x). + Definition union (s s' : t) : t := + Build_slist (Raw.union_unique (unique s) (unique s')). + Definition inter (s s' : t) : t := Build_slist (Raw.inter_unique (unique s) (unique s')). - Definition inter_1 (s s' : t) := Raw.inter_1 (unique s) (unique s'). - Definition inter_2 (s s' : t) := Raw.inter_2 (unique s) (unique s'). - Definition inter_3 (s s' : t) := Raw.inter_3 (unique s) (unique s'). - - Definition diff (s s' : t) := + Definition diff (s s' : t) : t := Build_slist (Raw.diff_unique (unique s) (unique s')). - Definition diff_1 (s s' : t) := Raw.diff_1 (unique s) (unique s'). - Definition diff_2 (s s' : t) := Raw.diff_2 (unique s) (unique s'). - Definition diff_3 (s s' : t) := Raw.diff_3 (unique s) (unique s'). - - Definition equal (s s' : t) := Raw.equal s s'. - Definition equal_1 (s s' : t) := Raw.equal_1 (unique s) (unique s'). - Definition equal_2 (s s' : t) := Raw.equal_2 (unique s) (unique s'). - - Definition subset (s s' : t) := Raw.subset s s'. - Definition subset_1 (s s' : t) := Raw.subset_1 (unique s) (unique s'). - Definition subset_2 (s s' : t) := Raw.subset_2 (unique s) (unique s'). + Definition equal (s s' : t) : bool := Raw.equal s s'. + Definition subset (s s' : t) : bool := Raw.subset s s'. + Definition empty : t := Build_slist Raw.empty_unique. + Definition is_empty (s : t) : bool := Raw.is_empty s. + Definition elements (s : t) : list elt := Raw.elements s. + Definition choose (s:t) : option elt := Raw.choose s. + Definition fold (B : Set) (f : elt -> B -> B) (s : t) : B -> B := Raw.fold (B:=B) f s. + Definition cardinal (s : t) : nat := Raw.cardinal s. + Definition filter (f : elt -> bool) (s : t) : t := + Build_slist (Raw.filter_unique (unique s) f). + Definition for_all (f : elt -> bool) (s : t) : bool := Raw.for_all f s. + Definition exists_ (f : elt -> bool) (s : t) : bool := Raw.exists_ f s. + Definition partition (f : elt -> bool) (s : t) : t * t := + let p := Raw.partition f s in + (Build_slist (this:=fst p) (Raw.partition_unique_1 (unique s) f), + Build_slist (this:=snd p) (Raw.partition_unique_2 (unique s) f)). + + Section Spec. + Variable s s' : t. + Variable x y : elt. - Definition empty := Build_slist Raw.empty_unique. - Definition empty_1 := Raw.empty_1. + Lemma In_1 : E.eq x y -> In x s -> In y s. + Proof. exact (fun H H' => Raw.In_eq H H'). Qed. - Definition is_empty (s : t) := Raw.is_empty s. - Definition is_empty_1 (s : t) := Raw.is_empty_1 (s:=s). - Definition is_empty_2 (s : t) := Raw.is_empty_2 (s:=s). - - Definition elements (s : t) := Raw.elements s. - Definition elements_1 (s : t) := Raw.elements_1 (s:=s). - Definition elements_2 (s : t) := Raw.elements_2 (s:=s). - Definition elements_3 (s : t) := Raw.elements_3 (unique s). - - Definition choose (s:t) := Raw.choose s. - Definition choose_1 (s : t) := Raw.choose_1 (s:=s). - Definition choose_2 (s : t) := Raw.choose_2 (s:=s). - - Definition fold (B : Set) (f : elt -> B -> B) (s : t) := Raw.fold (B:=B) f s. - Definition fold_1 (s : t) := Raw.fold_1 (unique s). + Lemma mem_1 : In x s -> mem x s = true. + Proof. exact (fun H => Raw.mem_1 H). Qed. + Lemma mem_2 : mem x s = true -> In x s. + Proof. exact (fun H => Raw.mem_2 H). Qed. - Definition cardinal (s : t) := Raw.cardinal s. - Definition cardinal_1 (s : t) := Raw.cardinal_1 (unique s). + Lemma equal_1 : Equal s s' -> equal s s' = true. + Proof. exact (Raw.equal_1 s.(unique) s'.(unique)). Qed. + Lemma equal_2 : equal s s' = true -> Equal s s'. + Proof. exact (Raw.equal_2 s.(unique) s'.(unique)). Qed. + + Lemma subset_1 : Subset s s' -> subset s s' = true. + Proof. exact (Raw.subset_1 s.(unique) s'.(unique)). Qed. + Lemma subset_2 : subset s s' = true -> Subset s s'. + Proof. exact (Raw.subset_2 s.(unique) s'.(unique)). Qed. + + Lemma empty_1 : Empty empty. + Proof. exact Raw.empty_1. Qed. + + Lemma is_empty_1 : Empty s -> is_empty s = true. + Proof. exact (fun H => Raw.is_empty_1 H). Qed. + Lemma is_empty_2 : is_empty s = true -> Empty s. + Proof. exact (fun H => Raw.is_empty_2 H). Qed. - Definition filter (f : elt -> bool) (s : t) := - Build_slist (Raw.filter_unique (unique s) f). - Definition filter_1 (s : t)(x:elt)(f: elt -> bool)(H:compat_bool X.eq f) := - @Raw.filter_1 s x f. - Definition filter_2 (s : t) := Raw.filter_2 (s:=s). - Definition filter_3 (s : t) := Raw.filter_3 (s:=s). + Lemma add_1 : E.eq x y -> In y (add x s). + Proof. exact (fun H => Raw.add_1 s.(unique) H). Qed. + Lemma add_2 : In y s -> In y (add x s). + Proof. exact (fun H => Raw.add_2 s.(unique) x H). Qed. + Lemma add_3 : ~ E.eq x y -> In y (add x s) -> In y s. + Proof. exact (fun H => Raw.add_3 s.(unique) H). Qed. + + Lemma remove_1 : E.eq x y -> ~ In y (remove x s). + Proof. exact (fun H => Raw.remove_1 s.(unique) H). Qed. + Lemma remove_2 : ~ E.eq x y -> In y s -> In y (remove x s). + Proof. exact (fun H H' => Raw.remove_2 s.(unique) H H'). Qed. + Lemma remove_3 : In y (remove x s) -> In y s. + Proof. exact (fun H => Raw.remove_3 s.(unique) H). Qed. + + Lemma singleton_1 : In y (singleton x) -> E.eq x y. + Proof. exact (fun H => Raw.singleton_1 H). Qed. + Lemma singleton_2 : E.eq x y -> In y (singleton x). + Proof. exact (fun H => Raw.singleton_2 H). Qed. + + Lemma union_1 : In x (union s s') -> In x s \/ In x s'. + Proof. exact (fun H => Raw.union_1 s.(unique) s'.(unique) H). Qed. + Lemma union_2 : In x s -> In x (union s s'). + Proof. exact (fun H => Raw.union_2 s.(unique) s'.(unique) H). Qed. + Lemma union_3 : In x s' -> In x (union s s'). + Proof. exact (fun H => Raw.union_3 s.(unique) s'.(unique) H). Qed. + + Lemma inter_1 : In x (inter s s') -> In x s. + Proof. exact (fun H => Raw.inter_1 s.(unique) s'.(unique) H). Qed. + Lemma inter_2 : In x (inter s s') -> In x s'. + Proof. exact (fun H => Raw.inter_2 s.(unique) s'.(unique) H). Qed. + Lemma inter_3 : In x s -> In x s' -> In x (inter s s'). + Proof. exact (fun H => Raw.inter_3 s.(unique) s'.(unique) H). Qed. + + Lemma diff_1 : In x (diff s s') -> In x s. + Proof. exact (fun H => Raw.diff_1 s.(unique) s'.(unique) H). Qed. + Lemma diff_2 : In x (diff s s') -> ~ In x s'. + Proof. exact (fun H => Raw.diff_2 s.(unique) s'.(unique) H). Qed. + Lemma diff_3 : In x s -> ~ In x s' -> In x (diff s s'). + Proof. exact (fun H => Raw.diff_3 s.(unique) s'.(unique) H). Qed. - Definition for_all (f : elt -> bool) (s : t) := Raw.for_all f s. - Definition for_all_1 (s : t) := Raw.for_all_1 (s:=s). - Definition for_all_2 (s : t) := Raw.for_all_2 (s:=s). + Lemma fold_1 : forall (A : Set) (i : A) (f : elt -> A -> A), + fold f s i = fold_left (fun a e => f e a) (elements s) i. + Proof. exact (Raw.fold_1 s.(unique)). Qed. - Definition exists_ (f : elt -> bool) (s : t) := Raw.exists_ f s. - Definition exists_1 (s : t) := Raw.exists_1 (s:=s). - Definition exists_2 (s : t) := Raw.exists_2 (s:=s). + Lemma cardinal_1 : cardinal s = length (elements s). + Proof. exact (Raw.cardinal_1 s.(unique)). Qed. - Definition partition (f : elt -> bool) (s : t) := - let p := Raw.partition f s in - (Build_slist (this:=fst p) (Raw.partition_unique_1 (unique s) f), - Build_slist (this:=snd p) (Raw.partition_unique_2 (unique s) f)). - Definition partition_1 (s : t) := Raw.partition_1 s. - Definition partition_2 (s : t) := Raw.partition_2 s. - - Definition eq (s s' : t) := Raw.eq s s'. - Definition eq_refl (s : t) := Raw.eq_refl s. - Definition eq_sym (s s' : t) := Raw.eq_sym (s:=s) (s':=s'). - Definition eq_trans (s s' s'' : t) := - Raw.eq_trans (s:=s) (s':=s') (s'':=s''). + Section Filter. + + Variable f : elt -> bool. + + Lemma filter_1 : compat_bool E.eq f -> In x (filter f s) -> In x s. + Proof. exact (fun H => @Raw.filter_1 s x f). Qed. + Lemma filter_2 : compat_bool E.eq f -> In x (filter f s) -> f x = true. + Proof. exact (@Raw.filter_2 s x f). Qed. + Lemma filter_3 : + compat_bool E.eq f -> In x s -> f x = true -> In x (filter f s). + Proof. exact (@Raw.filter_3 s x f). Qed. + + Lemma for_all_1 : + compat_bool E.eq f -> + For_all (fun x => f x = true) s -> for_all f s = true. + Proof. exact (@Raw.for_all_1 s f). Qed. + Lemma for_all_2 : + compat_bool E.eq f -> + for_all f s = true -> For_all (fun x => f x = true) s. + Proof. exact (@Raw.for_all_2 s f). Qed. + + Lemma exists_1 : + compat_bool E.eq f -> + Exists (fun x => f x = true) s -> exists_ f s = true. + Proof. exact (@Raw.exists_1 s f). Qed. + Lemma exists_2 : + compat_bool E.eq f -> + exists_ f s = true -> Exists (fun x => f x = true) s. + Proof. exact (@Raw.exists_2 s f). Qed. + + Lemma partition_1 : + compat_bool E.eq f -> Equal (fst (partition f s)) (filter f s). + Proof. exact (@Raw.partition_1 s f). Qed. + Lemma partition_2 : + compat_bool E.eq f -> + Equal (snd (partition f s)) (filter (fun x => negb (f x)) s). + Proof. exact (@Raw.partition_2 s f). Qed. + + End Filter. + + Lemma elements_1 : In x s -> InA E.eq x (elements s). + Proof. exact (fun H => Raw.elements_1 H). Qed. + Lemma elements_2 : InA E.eq x (elements s) -> In x s. + Proof. exact (fun H => Raw.elements_2 H). Qed. + Lemma elements_3 : NoDupA E.eq (elements s). + Proof. exact (Raw.elements_3 s.(unique)). Qed. + + Lemma choose_1 : choose s = Some x -> In x s. + Proof. exact (fun H => Raw.choose_1 H). Qed. + Lemma choose_2 : choose s = None -> Empty s. + Proof. exact (fun H => Raw.choose_2 H). Qed. + + End Spec. End Make. diff --git a/theories/FSets/FSetWeakProperties.v b/theories/FSets/FSetWeakProperties.v new file mode 100644 index 00000000..a0054d36 --- /dev/null +++ b/theories/FSets/FSetWeakProperties.v @@ -0,0 +1,896 @@ +(***********************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * INRIA-Rocquencourt & LRI-CNRS-Orsay *) +(* \VV/ *************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(***********************************************************************) + +(* $Id: FSetWeakProperties.v 8853 2006-05-23 18:17:38Z herbelin $ *) + +(** * Finite sets library *) + +(** NB: this file is a clone of [FSetProperties] for weak sets + and should remain so until we find a way to share the two. *) + +(** This functor derives additional properties from [FSetWeakInterface.S]. + Contrary to the functor in [FSetWeakEqProperties] it uses + predicates over sets instead of sets operations, i.e. + [In x s] instead of [mem x s=true], + [Equal s s'] instead of [equal s s'=true], etc. *) + +Require Export FSetWeakInterface. +Require Import FSetWeakFacts. +Set Implicit Arguments. +Unset Strict Implicit. + +Hint Unfold transpose compat_op. +Hint Extern 1 (Setoid_Theory _ _) => constructor; congruence. + +Module Properties (M: S). + Import M.E. + Import M. + Import Logic. (* to unmask [eq] *) + Import Peano. (* to unmask [lt] *) + + (** Results about lists without duplicates *) + + Module FM := Facts M. + Import FM. + + Definition Add (x : elt) (s s' : t) := + forall y : elt, In y s' <-> E.eq x y \/ In y s. + + Lemma In_dec : forall x s, {In x s} + {~ In x s}. + Proof. + intros; generalize (mem_iff s x); case (mem x s); intuition. + Qed. + + Section BasicProperties. + + (** properties of [Equal] *) + + Lemma equal_refl : forall s, s[=]s. + Proof. + unfold Equal; intuition. + Qed. + + Lemma equal_sym : forall s s', s[=]s' -> s'[=]s. + Proof. + unfold Equal; intros. + rewrite H; intuition. + Qed. + + Lemma equal_trans : forall s1 s2 s3, s1[=]s2 -> s2[=]s3 -> s1[=]s3. + Proof. + unfold Equal; intros. + rewrite H; exact (H0 a). + Qed. + + Variable s s' s'' s1 s2 s3 : t. + Variable x x' : elt. + + (** properties of [Subset] *) + + Lemma subset_refl : s[<=]s. + Proof. + unfold Subset; intuition. + Qed. + + Lemma subset_antisym : s[<=]s' -> s'[<=]s -> s[=]s'. + Proof. + unfold Subset, Equal; intuition. + Qed. + + Lemma subset_trans : s1[<=]s2 -> s2[<=]s3 -> s1[<=]s3. + Proof. + unfold Subset; intuition. + Qed. + + Lemma subset_equal : s[=]s' -> s[<=]s'. + Proof. + unfold Subset, Equal; firstorder. + Qed. + + Lemma subset_empty : empty[<=]s. + Proof. + unfold Subset; intros a; set_iff; intuition. + Qed. + + Lemma subset_remove_3 : s1[<=]s2 -> remove x s1 [<=] s2. + Proof. + unfold Subset; intros H a; set_iff; intuition. + Qed. + + Lemma subset_diff : s1[<=]s3 -> diff s1 s2 [<=] s3. + Proof. + unfold Subset; intros H a; set_iff; intuition. + Qed. + + Lemma subset_add_3 : In x s2 -> s1[<=]s2 -> add x s1 [<=] s2. + Proof. + unfold Subset; intros H H0 a; set_iff; intuition. + rewrite <- H2; auto. + Qed. + + Lemma subset_add_2 : s1[<=]s2 -> s1[<=] add x s2. + Proof. + unfold Subset; intuition. + Qed. + + Lemma in_subset : In x s1 -> s1[<=]s2 -> In x s2. + Proof. + unfold Subset; intuition. + Qed. + + Lemma double_inclusion : s1[=]s2 <-> s1[<=]s2 /\ s2[<=]s1. + Proof. + unfold Subset, Equal; split; intros; intuition; generalize (H a); intuition. + Qed. + + (** properties of [empty] *) + + Lemma empty_is_empty_1 : Empty s -> s[=]empty. + Proof. + unfold Empty, Equal; intros; generalize (H a); set_iff; tauto. + Qed. + + Lemma empty_is_empty_2 : s[=]empty -> Empty s. + Proof. + unfold Empty, Equal; intros; generalize (H a); set_iff; tauto. + Qed. + + (** properties of [add] *) + + Lemma add_equal : In x s -> add x s [=] s. + Proof. + unfold Equal; intros; set_iff; intuition. + rewrite <- H1; auto. + Qed. + + Lemma add_add : add x (add x' s) [=] add x' (add x s). + Proof. + unfold Equal; intros; set_iff; tauto. + Qed. + + (** properties of [remove] *) + + Lemma remove_equal : ~ In x s -> remove x s [=] s. + Proof. + unfold Equal; intros; set_iff; intuition. + rewrite H1 in H; auto. + Qed. + + Lemma Equal_remove : s[=]s' -> remove x s [=] remove x s'. + Proof. + intros; rewrite H; apply equal_refl. + Qed. + + (** properties of [add] and [remove] *) + + Lemma add_remove : In x s -> add x (remove x s) [=] s. + Proof. + unfold Equal; intros; set_iff; elim (eq_dec x a); intuition. + rewrite <- H1; auto. + Qed. + + Lemma remove_add : ~In x s -> remove x (add x s) [=] s. + Proof. + unfold Equal; intros; set_iff; elim (eq_dec x a); intuition. + rewrite H1 in H; auto. + Qed. + + (** properties of [singleton] *) + + Lemma singleton_equal_add : singleton x [=] add x empty. + Proof. + unfold Equal; intros; set_iff; intuition. + Qed. + + (** properties of [union] *) + + Lemma union_sym : union s s' [=] union s' s. + Proof. + unfold Equal; intros; set_iff; tauto. + Qed. + + Lemma union_subset_equal : s[<=]s' -> union s s' [=] s'. + Proof. + unfold Subset, Equal; intros; set_iff; intuition. + Qed. + + Lemma union_equal_1 : s[=]s' -> union s s'' [=] union s' s''. + Proof. + intros; rewrite H; apply equal_refl. + Qed. + + Lemma union_equal_2 : s'[=]s'' -> union s s' [=] union s s''. + Proof. + intros; rewrite H; apply equal_refl. + Qed. + + Lemma union_assoc : union (union s s') s'' [=] union s (union s' s''). + Proof. + unfold Equal; intros; set_iff; tauto. + Qed. + + Lemma add_union_singleton : add x s [=] union (singleton x) s. + Proof. + unfold Equal; intros; set_iff; tauto. + Qed. + + Lemma union_add : union (add x s) s' [=] add x (union s s'). + Proof. + unfold Equal; intros; set_iff; tauto. + Qed. + + Lemma union_subset_1 : s [<=] union s s'. + Proof. + unfold Subset; intuition. + Qed. + + Lemma union_subset_2 : s' [<=] union s s'. + Proof. + unfold Subset; intuition. + Qed. + + Lemma union_subset_3 : s[<=]s'' -> s'[<=]s'' -> union s s' [<=] s''. + Proof. + unfold Subset; intros H H0 a; set_iff; intuition. + Qed. + + Lemma union_subset_4 : s[<=]s' -> union s s'' [<=] union s' s''. + Proof. + unfold Subset; intros H a; set_iff; intuition. + Qed. + + Lemma union_subset_5 : s[<=]s' -> union s'' s [<=] union s'' s'. + Proof. + unfold Subset; intros H a; set_iff; intuition. + Qed. + + Lemma empty_union_1 : Empty s -> union s s' [=] s'. + Proof. + unfold Equal, Empty; intros; set_iff; firstorder. + Qed. + + Lemma empty_union_2 : Empty s -> union s' s [=] s'. + Proof. + unfold Equal, Empty; intros; set_iff; firstorder. + Qed. + + Lemma not_in_union : ~In x s -> ~In x s' -> ~In x (union s s'). + Proof. + intros; set_iff; intuition. + Qed. + + (** properties of [inter] *) + + Lemma inter_sym : inter s s' [=] inter s' s. + Proof. + unfold Equal; intros; set_iff; tauto. + Qed. + + Lemma inter_subset_equal : s[<=]s' -> inter s s' [=] s. + Proof. + unfold Equal; intros; set_iff; intuition. + Qed. + + Lemma inter_equal_1 : s[=]s' -> inter s s'' [=] inter s' s''. + Proof. + intros; rewrite H; apply equal_refl. + Qed. + + Lemma inter_equal_2 : s'[=]s'' -> inter s s' [=] inter s s''. + Proof. + intros; rewrite H; apply equal_refl. + Qed. + + Lemma inter_assoc : inter (inter s s') s'' [=] inter s (inter s' s''). + Proof. + unfold Equal; intros; set_iff; tauto. + Qed. + + Lemma union_inter_1 : inter (union s s') s'' [=] union (inter s s'') (inter s' s''). + Proof. + unfold Equal; intros; set_iff; tauto. + Qed. + + Lemma union_inter_2 : union (inter s s') s'' [=] inter (union s s'') (union s' s''). + Proof. + unfold Equal; intros; set_iff; tauto. + Qed. + + Lemma inter_add_1 : In x s' -> inter (add x s) s' [=] add x (inter s s'). + Proof. + unfold Equal; intros; set_iff; intuition. + rewrite <- H1; auto. + Qed. + + Lemma inter_add_2 : ~ In x s' -> inter (add x s) s' [=] inter s s'. + Proof. + unfold Equal; intros; set_iff; intuition. + destruct H; rewrite H0; auto. + Qed. + + Lemma empty_inter_1 : Empty s -> Empty (inter s s'). + Proof. + unfold Empty; intros; set_iff; firstorder. + Qed. + + Lemma empty_inter_2 : Empty s' -> Empty (inter s s'). + Proof. + unfold Empty; intros; set_iff; firstorder. + Qed. + + Lemma inter_subset_1 : inter s s' [<=] s. + Proof. + unfold Subset; intro a; set_iff; tauto. + Qed. + + Lemma inter_subset_2 : inter s s' [<=] s'. + Proof. + unfold Subset; intro a; set_iff; tauto. + Qed. + + Lemma inter_subset_3 : + s''[<=]s -> s''[<=]s' -> s''[<=] inter s s'. + Proof. + unfold Subset; intros H H' a; set_iff; intuition. + Qed. + + (** properties of [diff] *) + + Lemma empty_diff_1 : Empty s -> Empty (diff s s'). + Proof. + unfold Empty, Equal; intros; set_iff; firstorder. + Qed. + + Lemma empty_diff_2 : Empty s -> diff s' s [=] s'. + Proof. + unfold Empty, Equal; intros; set_iff; firstorder. + Qed. + + Lemma diff_subset : diff s s' [<=] s. + Proof. + unfold Subset; intros a; set_iff; tauto. + Qed. + + Lemma diff_subset_equal : s[<=]s' -> diff s s' [=] empty. + Proof. + unfold Subset, Equal; intros; set_iff; intuition; absurd (In a empty); auto. + Qed. + + Lemma remove_diff_singleton : + remove x s [=] diff s (singleton x). + Proof. + unfold Equal; intros; set_iff; intuition. + Qed. + + Lemma diff_inter_empty : inter (diff s s') (inter s s') [=] empty. + Proof. + unfold Equal; intros; set_iff; intuition; absurd (In a empty); auto. + Qed. + + Lemma diff_inter_all : union (diff s s') (inter s s') [=] s. + Proof. + unfold Equal; intros; set_iff; intuition. + elim (In_dec a s'); auto. + Qed. + + (** properties of [Add] *) + + Lemma Add_add : Add x s (add x s). + Proof. + unfold Add; intros; set_iff; intuition. + Qed. + + Lemma Add_remove : In x s -> Add x (remove x s) s. + Proof. + unfold Add; intros; set_iff; intuition. + elim (eq_dec x y); auto. + rewrite <- H1; auto. + Qed. + + Lemma union_Add : Add x s s' -> Add x (union s s'') (union s' s''). + Proof. + unfold Add; intros; set_iff; rewrite H; tauto. + Qed. + + Lemma inter_Add : + In x s'' -> Add x s s' -> Add x (inter s s'') (inter s' s''). + Proof. + unfold Add; intros; set_iff; rewrite H0; intuition. + rewrite <- H2; auto. + Qed. + + Lemma union_Equal : + In x s'' -> Add x s s' -> union s s'' [=] union s' s''. + Proof. + unfold Add, Equal; intros; set_iff; rewrite H0; intuition. + rewrite <- H1; auto. + Qed. + + Lemma inter_Add_2 : + ~In x s'' -> Add x s s' -> inter s s'' [=] inter s' s''. + Proof. + unfold Add, Equal; intros; set_iff; rewrite H0; intuition. + destruct H; rewrite H1; auto. + Qed. + + End BasicProperties. + + Hint Immediate equal_sym: set. + Hint Resolve equal_refl equal_trans : set. + + Hint Immediate add_remove remove_add union_sym inter_sym: set. + Hint Resolve subset_refl subset_equal subset_antisym + subset_trans subset_empty subset_remove_3 subset_diff subset_add_3 + subset_add_2 in_subset empty_is_empty_1 empty_is_empty_2 add_equal + remove_equal singleton_equal_add union_subset_equal union_equal_1 + union_equal_2 union_assoc add_union_singleton union_add union_subset_1 + union_subset_2 union_subset_3 inter_subset_equal inter_equal_1 inter_equal_2 + inter_assoc union_inter_1 union_inter_2 inter_add_1 inter_add_2 + empty_inter_1 empty_inter_2 empty_union_1 empty_union_2 empty_diff_1 + empty_diff_2 union_Add inter_Add union_Equal inter_Add_2 not_in_union + inter_subset_1 inter_subset_2 inter_subset_3 diff_subset diff_subset_equal + remove_diff_singleton diff_inter_empty diff_inter_all Add_add Add_remove + Equal_remove add_add : set. + + (** * Alternative (weaker) specifications for [fold] *) + + Section Old_Spec_Now_Properties. + + Notation NoDup := (NoDupA E.eq). + + (** When [FSets] was first designed, the order in which Ocaml's [Set.fold] + takes the set elements was unspecified. This specification reflects this fact: + *) + + Lemma fold_0 : + forall s (A : Set) (i : A) (f : elt -> A -> A), + exists l : list elt, + NoDup l /\ + (forall x : elt, In x s <-> InA E.eq x l) /\ + fold f s i = fold_right f i l. + Proof. + intros; exists (rev (elements s)); split. + apply NoDupA_rev; auto. + exact E.eq_trans. + split; intros. + rewrite elements_iff; do 2 rewrite InA_alt. + split; destruct 1; generalize (In_rev (elements s) x0); exists x0; intuition. + rewrite fold_left_rev_right. + apply fold_1. + Qed. + + (** An alternate (and previous) specification for [fold] was based on + the recursive structure of a set. It is now lemmas [fold_1] and + [fold_2]. *) + + Lemma fold_1 : + forall s (A : Set) (eqA : A -> A -> Prop) + (st : Setoid_Theory A eqA) (i : A) (f : elt -> A -> A), + Empty s -> eqA (fold f s i) i. + Proof. + unfold Empty; intros; destruct (fold_0 s i f) as (l,(H1, (H2, H3))). + rewrite H3; clear H3. + generalize H H2; clear H H2; case l; simpl; intros. + refl_st. + elim (H e). + elim (H2 e); intuition. + Qed. + + Lemma fold_2 : + forall s s' x (A : Set) (eqA : A -> A -> Prop) + (st : Setoid_Theory A eqA) (i : A) (f : elt -> A -> A), + compat_op E.eq eqA f -> + transpose eqA f -> + ~ In x s -> Add x s s' -> eqA (fold f s' i) (f x (fold f s i)). + Proof. + intros; destruct (fold_0 s i f) as (l,(Hl, (Hl1, Hl2))); + destruct (fold_0 s' i f) as (l',(Hl', (Hl'1, Hl'2))). + rewrite Hl2; rewrite Hl'2; clear Hl2 Hl'2. + apply fold_right_add with (eqA:=E.eq)(eqB:=eqA); auto. + eauto. + exact eq_dec. + rewrite <- Hl1; auto. + intros; rewrite <- Hl1; rewrite <- Hl'1; auto. + Qed. + + (** Similar specifications for [cardinal]. *) + + Lemma cardinal_fold : forall s, cardinal s = fold (fun _ => S) s 0. + Proof. + intros; rewrite cardinal_1; rewrite M.fold_1. + symmetry; apply fold_left_length; auto. + Qed. + + Lemma cardinal_0 : + forall s, exists l : list elt, + NoDupA E.eq l /\ + (forall x : elt, In x s <-> InA E.eq x l) /\ + cardinal s = length l. + Proof. + intros; exists (elements s); intuition; apply cardinal_1. + Qed. + + Lemma cardinal_1 : forall s, Empty s -> cardinal s = 0. + Proof. + intros; rewrite cardinal_fold; apply fold_1; auto. + Qed. + + Lemma cardinal_2 : + forall s s' x, ~ In x s -> Add x s s' -> cardinal s' = S (cardinal s). + Proof. + intros; do 2 rewrite cardinal_fold. + change S with ((fun _ => S) x). + apply fold_2; auto. + Qed. + + End Old_Spec_Now_Properties. + + (** * Induction principle over sets *) + + Lemma cardinal_inv_1 : forall s, cardinal s = 0 -> Empty s. + Proof. + intros s; rewrite M.cardinal_1; intros H a; red. + rewrite elements_iff. + destruct (elements s); simpl in *; discriminate || inversion 1. + Qed. + Hint Resolve cardinal_inv_1. + + Lemma cardinal_inv_2 : + forall s n, cardinal s = S n -> { x : elt | In x s }. + Proof. + intros; rewrite M.cardinal_1 in H. + generalize (elements_2 (s:=s)). + destruct (elements s); try discriminate. + exists e; auto. + Qed. + + Lemma Equal_cardinal_aux : + forall n s s', cardinal s = n -> s[=]s' -> cardinal s = cardinal s'. + Proof. + simple induction n; intros. + rewrite H; symmetry . + apply cardinal_1. + rewrite <- H0; auto. + destruct (cardinal_inv_2 H0) as (x,H2). + revert H0. + rewrite (cardinal_2 (s:=remove x s) (s':=s) (x:=x)); auto with set. + rewrite (cardinal_2 (s:=remove x s') (s':=s') (x:=x)); auto with set. + rewrite H1 in H2; auto with set. + Qed. + + Lemma Equal_cardinal : forall s s', s[=]s' -> cardinal s = cardinal s'. + Proof. + intros; apply Equal_cardinal_aux with (cardinal s); auto. + Qed. + + Add Morphism cardinal : cardinal_m. + Proof. + exact Equal_cardinal. + Qed. + + Hint Resolve Add_add Add_remove Equal_remove cardinal_inv_1 Equal_cardinal. + + Lemma cardinal_induction : + forall P : t -> Type, + (forall s, Empty s -> P s) -> + (forall s s', P s -> forall x, ~In x s -> Add x s s' -> P s') -> + forall n s, cardinal s = n -> P s. + Proof. + simple induction n; intros; auto. + destruct (cardinal_inv_2 H) as (x,H0). + apply X0 with (remove x s) x; auto. + apply X1; auto. + rewrite (cardinal_2 (x:=x)(s:=remove x s)(s':=s)) in H; auto. + Qed. + + Lemma set_induction : + forall P : t -> Type, + (forall s : t, Empty s -> P s) -> + (forall s s' : t, P s -> forall x : elt, ~In x s -> Add x s s' -> P s') -> + forall s : t, P s. + Proof. + intros; apply cardinal_induction with (cardinal s); auto. + Qed. + + (** Other properties of [fold]. *) + + Section Fold. + Variables (A:Set)(eqA:A->A->Prop)(st:Setoid_Theory _ eqA). + Variables (f:elt->A->A)(Comp:compat_op E.eq eqA f)(Ass:transpose eqA f). + + Section Fold_1. + Variable i i':A. + + Lemma fold_empty : eqA (fold f empty i) i. + Proof. + apply fold_1; auto. + Qed. + + Lemma fold_equal : + forall s s', s[=]s' -> eqA (fold f s i) (fold f s' i). + Proof. + intros s; pattern s; apply set_induction; clear s; intros. + trans_st i. + apply fold_1; auto. + sym_st; apply fold_1; auto. + rewrite <- H0; auto. + trans_st (f x (fold f s i)). + apply fold_2 with (eqA := eqA); auto. + sym_st; apply fold_2 with (eqA := eqA); auto. + unfold Add in *; intros. + rewrite <- H2; auto. + Qed. + + Lemma fold_add : forall s x, ~In x s -> + eqA (fold f (add x s) i) (f x (fold f s i)). + Proof. + intros; apply fold_2 with (eqA := eqA); auto. + Qed. + + Lemma add_fold : forall s x, In x s -> + eqA (fold f (add x s) i) (fold f s i). + Proof. + intros; apply fold_equal; auto with set. + Qed. + + Lemma remove_fold_1: forall s x, In x s -> + eqA (f x (fold f (remove x s) i)) (fold f s i). + Proof. + intros. + sym_st. + apply fold_2 with (eqA:=eqA); auto. + Qed. + + Lemma remove_fold_2: forall s x, ~In x s -> + eqA (fold f (remove x s) i) (fold f s i). + Proof. + intros. + apply fold_equal; auto with set. + Qed. + + Lemma fold_commutes : forall s x, + eqA (fold f s (f x i)) (f x (fold f s i)). + Proof. + intros; pattern s; apply set_induction; clear s; intros. + trans_st (f x i). + apply fold_1; auto. + sym_st. + apply Comp; auto. + apply fold_1; auto. + trans_st (f x0 (fold f s (f x i))). + apply fold_2 with (eqA:=eqA); auto. + trans_st (f x0 (f x (fold f s i))). + trans_st (f x (f x0 (fold f s i))). + apply Comp; auto. + sym_st. + apply fold_2 with (eqA:=eqA); auto. + Qed. + + Lemma fold_init : forall s, eqA i i' -> + eqA (fold f s i) (fold f s i'). + Proof. + intros; pattern s; apply set_induction; clear s; intros. + trans_st i. + apply fold_1; auto. + trans_st i'. + sym_st; apply fold_1; auto. + trans_st (f x (fold f s i)). + apply fold_2 with (eqA:=eqA); auto. + trans_st (f x (fold f s i')). + sym_st; apply fold_2 with (eqA:=eqA); auto. + Qed. + + End Fold_1. + Section Fold_2. + Variable i:A. + + Lemma fold_union_inter : forall s s', + eqA (fold f (union s s') (fold f (inter s s') i)) + (fold f s (fold f s' i)). + Proof. + intros; pattern s; apply set_induction; clear s; intros. + trans_st (fold f s' (fold f (inter s s') i)). + apply fold_equal; auto with set. + trans_st (fold f s' i). + apply fold_init; auto. + apply fold_1; auto with set. + sym_st; apply fold_1; auto. + rename s'0 into s''. + destruct (In_dec x s'). + (* In x s' *) + trans_st (fold f (union s'' s') (f x (fold f (inter s s') i))); auto with set. + apply fold_init; auto. + apply fold_2 with (eqA:=eqA); auto with set. + rewrite inter_iff; intuition. + trans_st (f x (fold f s (fold f s' i))). + trans_st (fold f (union s s') (f x (fold f (inter s s') i))). + apply fold_equal; auto. + apply equal_sym; apply union_Equal with x; auto with set. + trans_st (f x (fold f (union s s') (fold f (inter s s') i))). + apply fold_commutes; auto. + sym_st; apply fold_2 with (eqA:=eqA); auto. + (* ~(In x s') *) + trans_st (f x (fold f (union s s') (fold f (inter s'' s') i))). + apply fold_2 with (eqA:=eqA); auto with set. + trans_st (f x (fold f (union s s') (fold f (inter s s') i))). + apply Comp;auto. + apply fold_init;auto. + apply fold_equal;auto. + apply equal_sym; apply inter_Add_2 with x; auto with set. + trans_st (f x (fold f s (fold f s' i))). + sym_st; apply fold_2 with (eqA:=eqA); auto. + Qed. + + End Fold_2. + Section Fold_3. + Variable i:A. + + Lemma fold_diff_inter : forall s s', + eqA (fold f (diff s s') (fold f (inter s s') i)) (fold f s i). + Proof. + intros. + trans_st (fold f (union (diff s s') (inter s s')) + (fold f (inter (diff s s') (inter s s')) i)). + sym_st; apply fold_union_inter; auto. + trans_st (fold f s (fold f (inter (diff s s') (inter s s')) i)). + apply fold_equal; auto with set. + apply fold_init; auto. + apply fold_1; auto with set. + Qed. + + Lemma fold_union: forall s s', (forall x, ~In x s\/~In x s') -> + eqA (fold f (union s s') i) (fold f s (fold f s' i)). + Proof. + intros. + trans_st (fold f (union s s') (fold f (inter s s') i)). + apply fold_init; auto. + sym_st; apply fold_1; auto with set. + unfold Empty; intro a; generalize (H a); set_iff; tauto. + apply fold_union_inter; auto. + Qed. + + End Fold_3. + End Fold. + + Lemma fold_plus : + forall s p, fold (fun _ => S) s p = fold (fun _ => S) s 0 + p. + Proof. + assert (st := gen_st nat). + assert (fe : compat_op E.eq (@eq _) (fun _ => S)) by (unfold compat_op; auto). + assert (fp : transpose (@eq _) (fun _:elt => S)) by (unfold transpose; auto). + intros s p; pattern s; apply set_induction; clear s; intros. + rewrite (fold_1 st p (fun _ => S) H). + rewrite (fold_1 st 0 (fun _ => S) H); trivial. + assert (forall p s', Add x s s' -> fold (fun _ => S) s' p = S (fold (fun _ => S) s p)). + change S with ((fun _ => S) x). + intros; apply fold_2; auto. + rewrite H2; auto. + rewrite (H2 0); auto. + rewrite H. + simpl; auto. + Qed. + + (** properties of [cardinal] *) + + Lemma empty_cardinal : cardinal empty = 0. + Proof. + rewrite cardinal_fold; apply fold_1; auto. + Qed. + + Hint Immediate empty_cardinal cardinal_1 : set. + + Lemma singleton_cardinal : forall x, cardinal (singleton x) = 1. + Proof. + intros. + rewrite (singleton_equal_add x). + replace 0 with (cardinal empty); auto with set. + apply cardinal_2 with x; auto with set. + Qed. + + Hint Resolve singleton_cardinal: set. + + Lemma diff_inter_cardinal : + forall s s', cardinal (diff s s') + cardinal (inter s s') = cardinal s . + Proof. + intros; do 3 rewrite cardinal_fold. + rewrite <- fold_plus. + apply fold_diff_inter with (eqA:=@eq nat); auto. + Qed. + + Lemma union_cardinal: + forall s s', (forall x, ~In x s\/~In x s') -> + cardinal (union s s')=cardinal s+cardinal s'. + Proof. + intros; do 3 rewrite cardinal_fold. + rewrite <- fold_plus. + apply fold_union; auto. + Qed. + + Lemma subset_cardinal : + forall s s', s[<=]s' -> cardinal s <= cardinal s' . + Proof. + intros. + rewrite <- (diff_inter_cardinal s' s). + rewrite (inter_sym s' s). + rewrite (inter_subset_equal H); auto with arith. + Qed. + + Lemma subset_cardinal_lt : + forall s s' x, s[<=]s' -> In x s' -> ~In x s -> cardinal s < cardinal s'. + Proof. + intros. + rewrite <- (diff_inter_cardinal s' s). + rewrite (inter_sym s' s). + rewrite (inter_subset_equal H). + generalize (@cardinal_inv_1 (diff s' s)). + destruct (cardinal (diff s' s)). + intro H2; destruct (H2 (refl_equal _) x). + set_iff; auto. + intros _. + change (0 + cardinal s < S n + cardinal s). + apply Plus.plus_lt_le_compat; auto with arith. + Qed. + + Theorem union_inter_cardinal : + forall s s', cardinal (union s s') + cardinal (inter s s') = cardinal s + cardinal s' . + Proof. + intros. + do 4 rewrite cardinal_fold. + do 2 rewrite <- fold_plus. + apply fold_union_inter with (eqA:=@eq nat); auto. + Qed. + + Lemma union_cardinal_inter : + forall s s', cardinal (union s s') = cardinal s + cardinal s' - cardinal (inter s s'). + Proof. + intros. + rewrite <- union_inter_cardinal. + rewrite Plus.plus_comm. + auto with arith. + Qed. + + Lemma union_cardinal_le : + forall s s', cardinal (union s s') <= cardinal s + cardinal s'. + Proof. + intros; generalize (union_inter_cardinal s s'). + intros; rewrite <- H; auto with arith. + Qed. + + Lemma add_cardinal_1 : + forall s x, In x s -> cardinal (add x s) = cardinal s. + Proof. + auto with set. + Qed. + + Lemma add_cardinal_2 : + forall s x, ~In x s -> cardinal (add x s) = S (cardinal s). + Proof. + intros. + do 2 rewrite cardinal_fold. + change S with ((fun _ => S) x); + apply fold_add with (eqA:=@eq nat); auto. + Qed. + + Lemma remove_cardinal_1 : + forall s x, In x s -> S (cardinal (remove x s)) = cardinal s. + Proof. + intros. + do 2 rewrite cardinal_fold. + change S with ((fun _ =>S) x). + apply remove_fold_1 with (eqA:=@eq nat); auto. + Qed. + + Lemma remove_cardinal_2 : + forall s x, ~In x s -> cardinal (remove x s) = cardinal s. + Proof. + auto with set. + Qed. + + Hint Resolve subset_cardinal union_cardinal add_cardinal_1 add_cardinal_2. + +End Properties. diff --git a/theories/FSets/FSets.v b/theories/FSets/FSets.v index 9dfcd51f..b0402db6 100644 --- a/theories/FSets/FSets.v +++ b/theories/FSets/FSets.v @@ -6,9 +6,11 @@ (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -(* $Id: FSets.v 8667 2006-03-28 11:59:44Z letouzey $ *) +(* $Id: FSets.v 8897 2006-06-05 21:04:10Z letouzey $ *) Require Export OrderedType. +Require Export OrderedTypeEx. +Require Export OrderedTypeAlt. Require Export FSetInterface. Require Export FSetBridge. Require Export FSetProperties. diff --git a/theories/FSets/OrderedType.v b/theories/FSets/OrderedType.v index 2bf08dc7..f966cd4d 100644 --- a/theories/FSets/OrderedType.v +++ b/theories/FSets/OrderedType.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -(* $Id: OrderedType.v 8667 2006-03-28 11:59:44Z letouzey $ *) +(* $Id: OrderedType.v 8834 2006-05-20 00:41:35Z letouzey $ *) Require Export SetoidList. Set Implicit Arguments. @@ -313,6 +313,8 @@ Ltac false_order := elimtype False; order. (* Specialization of resuts about lists modulo. *) +Section ForNotations. + Notation In:=(InA eq). Notation Inf:=(lelistA lt). Notation Sort:=(sort lt). @@ -346,12 +348,14 @@ Proof. exact (InfA_alt eq_refl eq_sym lt_trans lt_eq eq_lt). Qed. Lemma Sort_NoDup : forall l, Sort l -> NoDup l. Proof. exact (SortA_NoDupA eq_refl eq_sym lt_trans lt_not_eq lt_eq eq_lt) . Qed. +End ForNotations. + Hint Resolve ListIn_In Sort_NoDup Inf_lt. Hint Immediate In_eq Inf_lt. End OrderedTypeFacts. -Module PairOrderedType(O:OrderedType). +Module KeyOrderedType(O:OrderedType). Import O. Module MO:=OrderedTypeFacts(O). Import MO. @@ -561,6 +565,6 @@ Module PairOrderedType(O:OrderedType). Hint Resolve Sort_Inf_NotIn. Hint Resolve In_inv_2 In_inv_3. -End PairOrderedType. +End KeyOrderedType. diff --git a/theories/FSets/OrderedTypeAlt.v b/theories/FSets/OrderedTypeAlt.v new file mode 100644 index 00000000..9bcfbfc7 --- /dev/null +++ b/theories/FSets/OrderedTypeAlt.v @@ -0,0 +1,129 @@ +(***********************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * INRIA-Rocquencourt & LRI-CNRS-Orsay *) +(* \VV/ *************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(***********************************************************************) + +(* Finite sets library. + * Authors: Pierre Letouzey and Jean-Christophe Filliâtre + * Institution: LRI, CNRS UMR 8623 - Université Paris Sud + * 91405 Orsay, France *) + +(* $Id: OrderedTypeAlt.v 8773 2006-04-29 14:31:32Z letouzey $ *) + +Require Import OrderedType. + +(** * An alternative (but equivalent) presentation for an Ordered Type inferface. *) + +(** NB: [comparison], defined in [theories/Init/datatypes.v] is [Eq|Lt|Gt] +whereas [compare], defined in [theories/FSets/OrderedType.v] is [EQ _ | LT _ | GT _ ] +*) + +Module Type OrderedTypeAlt. + + Parameter t : Set. + + Parameter compare : t -> t -> comparison. + + Infix "?=" := compare (at level 70, no associativity). + + Parameter compare_sym : + forall x y, (y?=x) = CompOpp (x?=y). + Parameter compare_trans : + forall c x y z, (x?=y) = c -> (y?=z) = c -> (x?=z) = c. + +End OrderedTypeAlt. + +(** From this new presentation to the original one. *) + +Module OrderedType_from_Alt (O:OrderedTypeAlt) <: OrderedType. + Import O. + + Definition t := t. + + Definition eq x y := (x?=y) = Eq. + Definition lt x y := (x?=y) = Lt. + + Lemma eq_refl : forall x, eq x x. + Proof. + intro x. + unfold eq. + assert (H:=compare_sym x x). + destruct (x ?= x); simpl in *; try discriminate; auto. + Qed. + + Lemma eq_sym : forall x y, eq x y -> eq y x. + Proof. + unfold eq; intros. + rewrite compare_sym. + rewrite H; simpl; auto. + Qed. + + Definition eq_trans := (compare_trans Eq). + + Definition lt_trans := (compare_trans Lt). + + Lemma lt_not_eq : forall x y, lt x y -> ~eq x y. + Proof. + unfold eq, lt; intros. + rewrite H; discriminate. + Qed. + + Definition compare : forall x y, Compare lt eq x y. + Proof. + intros. + case_eq (x ?= y); intros. + apply EQ; auto. + apply LT; auto. + apply GT; red. + rewrite compare_sym; rewrite H; auto. + Defined. + +End OrderedType_from_Alt. + +(** From the original presentation to this alternative one. *) + +Module OrderedType_to_Alt (O:OrderedType) <: OrderedTypeAlt. + Import O. + Module MO:=OrderedTypeFacts(O). + Import MO. + + Definition t := t. + + Definition compare x y := match compare x y with + | LT _ => Lt + | EQ _ => Eq + | GT _ => Gt + end. + + Infix "?=" := compare (at level 70, no associativity). + + Lemma compare_sym : + forall x y, (y?=x) = CompOpp (x?=y). + Proof. + intros x y. + unfold compare. + destruct (O.compare y x); elim_comp; simpl; auto. + Qed. + + Lemma compare_trans : + forall c x y z, (x?=y) = c -> (y?=z) = c -> (x?=z) = c. + Proof. + intros c x y z. + destruct c; unfold compare. + destruct (O.compare x y); intros; try discriminate. + destruct (O.compare y z); intros; try discriminate. + elim_comp; auto. + destruct (O.compare x y); intros; try discriminate. + destruct (O.compare y z); intros; try discriminate. + elim_comp; auto. + destruct (O.compare x y); intros; try discriminate. + destruct (O.compare y z); intros; try discriminate. + elim_comp; auto. + Qed. + +End OrderedType_to_Alt. + + diff --git a/theories/FSets/OrderedTypeEx.v b/theories/FSets/OrderedTypeEx.v new file mode 100644 index 00000000..1c5a4054 --- /dev/null +++ b/theories/FSets/OrderedTypeEx.v @@ -0,0 +1,248 @@ +(***********************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * INRIA-Rocquencourt & LRI-CNRS-Orsay *) +(* \VV/ *************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(***********************************************************************) + +(* Finite sets library. + * Authors: Pierre Letouzey and Jean-Christophe Filliâtre + * Institution: LRI, CNRS UMR 8623 - Université Paris Sud + * 91405 Orsay, France *) + +(* $Id: OrderedTypeEx.v 8836 2006-05-20 21:34:27Z letouzey $ *) + +Require Import OrderedType. +Require Import ZArith. +Require Import Omega. +Require Import NArith Ndec. +Require Import Compare_dec. + +(** * Examples of Ordered Type structures. *) + +(** First, a particular case of [OrderedType] where + the equality is the usual one of Coq. *) + +Module Type UsualOrderedType. + Parameter t : Set. + Definition eq := @eq t. + Parameter lt : t -> t -> Prop. + Definition eq_refl := @refl_equal t. + Definition eq_sym := @sym_eq t. + Definition eq_trans := @trans_eq t. + Axiom lt_trans : forall x y z : t, lt x y -> lt y z -> lt x z. + Axiom lt_not_eq : forall x y : t, lt x y -> ~ eq x y. + Parameter compare : forall x y : t, Compare lt eq x y. +End UsualOrderedType. + +(** a [UsualOrderedType] is in particular an [OrderedType]. *) + +Module UOT_to_OT (U:UsualOrderedType) <: OrderedType := U. + +(** [nat] is an ordered type with respect to the usual order on natural numbers. *) + +Module Nat_as_OT <: UsualOrderedType. + + Definition t := nat. + + Definition eq := @eq nat. + Definition eq_refl := @refl_equal t. + Definition eq_sym := @sym_eq t. + Definition eq_trans := @trans_eq t. + + Definition lt := lt. + + Lemma lt_trans : forall x y z : t, lt x y -> lt y z -> lt x z. + Proof. unfold lt in |- *; intros; apply lt_trans with y; auto. Qed. + + Lemma lt_not_eq : forall x y : t, lt x y -> ~ eq x y. + Proof. unfold lt, eq in |- *; intros; omega. Qed. + + Definition compare : forall x y : t, Compare lt eq x y. + Proof. + intros; case (lt_eq_lt_dec x y). + simple destruct 1; intro. + constructor 1; auto. + constructor 2; auto. + intro; constructor 3; auto. + Qed. + +End Nat_as_OT. + + +(** [Z] is an ordered type with respect to the usual order on integers. *) + +Open Scope Z_scope. + +Module Z_as_OT <: UsualOrderedType. + + Definition t := Z. + Definition eq := @eq Z. + Definition eq_refl := @refl_equal t. + Definition eq_sym := @sym_eq t. + Definition eq_trans := @trans_eq t. + + Definition lt (x y:Z) := (x<y). + + Lemma lt_trans : forall x y z, x<y -> y<z -> x<z. + Proof. intros; omega. Qed. + + Lemma lt_not_eq : forall x y, x<y -> ~ x=y. + Proof. intros; omega. Qed. + + Definition compare : forall x y, Compare lt eq x y. + Proof. + intros x y; case_eq (x ?= y); intros. + apply EQ; unfold eq; apply Zcompare_Eq_eq; auto. + apply LT; unfold lt, Zlt; auto. + apply GT; unfold lt, Zlt; rewrite <- Zcompare_Gt_Lt_antisym; auto. + Defined. + +End Z_as_OT. + +(** [positive] is an ordered type with respect to the usual order on natural numbers. *) + +Open Scope positive_scope. + +Module Positive_as_OT <: UsualOrderedType. + Definition t:=positive. + Definition eq:=@eq positive. + Definition eq_refl := @refl_equal t. + Definition eq_sym := @sym_eq t. + Definition eq_trans := @trans_eq t. + + Definition lt p q:= (p ?= q) Eq = Lt. + + Lemma lt_trans : forall x y z : t, lt x y -> lt y z -> lt x z. + Proof. + unfold lt; intros x y z. + change ((Zpos x < Zpos y)%Z -> (Zpos y < Zpos z)%Z -> (Zpos x < Zpos z)%Z). + omega. + Qed. + + Lemma lt_not_eq : forall x y : t, lt x y -> ~ eq x y. + Proof. + intros; intro. + rewrite H0 in H. + unfold lt in H. + rewrite Pcompare_refl in H; discriminate. + Qed. + + Definition compare : forall x y : t, Compare lt eq x y. + Proof. + intros x y. + case_eq ((x ?= y) Eq); intros. + apply EQ; apply Pcompare_Eq_eq; auto. + apply LT; unfold lt; auto. + apply GT; unfold lt. + replace Eq with (CompOpp Eq); auto. + rewrite <- Pcompare_antisym; rewrite H; auto. + Qed. + +End Positive_as_OT. + + +(** [N] is an ordered type with respect to the usual order on natural numbers. *) + +Open Scope positive_scope. + +Module N_as_OT <: UsualOrderedType. + Definition t:=N. + Definition eq:=@eq N. + Definition eq_refl := @refl_equal t. + Definition eq_sym := @sym_eq t. + Definition eq_trans := @trans_eq t. + + Definition lt p q:= Nle q p = false. + + Definition lt_trans := Nlt_trans. + + Lemma lt_not_eq : forall x y : t, lt x y -> ~ eq x y. + Proof. + intros; intro. + rewrite H0 in H. + unfold lt in H. + rewrite Nle_refl in H; discriminate. + Qed. + + Definition compare : forall x y : t, Compare lt eq x y. + Proof. + intros x y. + case_eq ((x ?= y)%N); intros. + apply EQ; apply Ncompare_Eq_eq; auto. + apply LT; unfold lt; auto. + generalize (Nle_Ncompare y x). + destruct (Nle y x); auto. + rewrite <- Ncompare_antisym. + destruct (x ?= y)%N; simpl; try discriminate. + intros (H0,_); elim H0; auto. + apply GT; unfold lt. + generalize (Nle_Ncompare x y). + destruct (Nle x y); auto. + destruct (x ?= y)%N; simpl; try discriminate. + intros (H0,_); elim H0; auto. + Qed. + +End N_as_OT. + + +(** From two ordered types, we can build a new OrderedType + over their cartesian product, using the lexicographic order. *) + +Module PairOrderedType(O1 O2:OrderedType) <: OrderedType. + Module MO1:=OrderedTypeFacts(O1). + Module MO2:=OrderedTypeFacts(O2). + + Definition t := prod O1.t O2.t. + + Definition eq x y := O1.eq (fst x) (fst y) /\ O2.eq (snd x) (snd y). + + Definition lt x y := + O1.lt (fst x) (fst y) \/ + (O1.eq (fst x) (fst y) /\ O2.lt (snd x) (snd y)). + + Lemma eq_refl : forall x : t, eq x x. + Proof. + intros (x1,x2); red; simpl; auto. + Qed. + + Lemma eq_sym : forall x y : t, eq x y -> eq y x. + Proof. + intros (x1,x2) (y1,y2); unfold eq; simpl; intuition. + Qed. + + Lemma eq_trans : forall x y z : t, eq x y -> eq y z -> eq x z. + Proof. + intros (x1,x2) (y1,y2) (z1,z2); unfold eq; simpl; intuition eauto. + Qed. + + Lemma lt_trans : forall x y z : t, lt x y -> lt y z -> lt x z. + Proof. + intros (x1,x2) (y1,y2) (z1,z2); unfold eq, lt; simpl; intuition. + left; eauto. + left; eapply MO1.lt_eq; eauto. + left; eapply MO1.eq_lt; eauto. + right; split; eauto. + Qed. + + Lemma lt_not_eq : forall x y : t, lt x y -> ~ eq x y. + Proof. + intros (x1,x2) (y1,y2); unfold eq, lt; simpl; intuition. + apply (O1.lt_not_eq H0 H1). + apply (O2.lt_not_eq H3 H2). + Qed. + + Definition compare : forall x y : t, Compare lt eq x y. + intros (x1,x2) (y1,y2). + destruct (O1.compare x1 y1). + apply LT; unfold lt; auto. + destruct (O2.compare x2 y2). + apply LT; unfold lt; auto. + apply EQ; unfold eq; auto. + apply GT; unfold lt; auto. + apply GT; unfold lt; auto. + Qed. + +End PairOrderedType. + diff --git a/theories/Init/Datatypes.v b/theories/Init/Datatypes.v index f71f58c6..fdd7ba35 100644 --- a/theories/Init/Datatypes.v +++ b/theories/Init/Datatypes.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Datatypes.v 8642 2006-03-17 10:09:02Z notin $ i*) +(*i $Id: Datatypes.v 8872 2006-05-29 07:36:28Z herbelin $ i*) Set Implicit Arguments. @@ -47,7 +47,7 @@ Inductive Empty_set : Set :=. member is the singleton datatype [identity A a a] whose sole inhabitant is denoted [refl_identity A a] *) -Inductive identity (A:Type) (a:A) : A -> Set := +Inductive identity (A:Type) (a:A) : A -> Type := refl_identity : identity (A:=A) a a. Hint Resolve refl_identity: core v62. @@ -57,13 +57,13 @@ Implicit Arguments identity_rect [A]. (** [option A] is the extension of [A] with an extra element [None] *) -Inductive option (A:Set) : Set := +Inductive option (A:Type) : Type := | Some : A -> option A | None : option A. Implicit Arguments None [A]. -Definition option_map (A B:Set) (f:A->B) o := +Definition option_map (A B:Type) (f:A->B) o := match o with | Some a => Some (f a) | None => None @@ -71,7 +71,7 @@ Definition option_map (A B:Set) (f:A->B) o := (** [sum A B], written [A + B], is the disjoint sum of [A] and [B] *) (* Syntax defined in Specif.v *) -Inductive sum (A B:Set) : Set := +Inductive sum (A B:Type) : Type := | inl : A -> sum A B | inr : B -> sum A B. @@ -80,7 +80,7 @@ Notation "x + y" := (sum x y) : type_scope. (** [prod A B], written [A * B], is the product of [A] and [B]; the pair [pair A B a b] of [a] and [b] is abbreviated [(a,b)] *) -Inductive prod (A B:Set) : Set := +Inductive prod (A B:Type) : Type := pair : A -> B -> prod A B. Add Printing Let prod. @@ -88,31 +88,38 @@ Notation "x * y" := (prod x y) : type_scope. Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope. Section projections. - Variables A B : Set. - Definition fst (p:A * B) := match p with - | (x, y) => x - end. - Definition snd (p:A * B) := match p with - | (x, y) => y - end. + Variables A B : Type. + Definition fst (p:A * B) := match p with + | (x, y) => x + end. + Definition snd (p:A * B) := match p with + | (x, y) => y + end. End projections. Hint Resolve pair inl inr: core v62. Lemma surjective_pairing : - forall (A B:Set) (p:A * B), p = pair (fst p) (snd p). + forall (A B:Type) (p:A * B), p = pair (fst p) (snd p). Proof. destruct p; reflexivity. Qed. Lemma injective_projections : - forall (A B:Set) (p1 p2:A * B), + forall (A B:Type) (p1 p2:A * B), fst p1 = fst p2 -> snd p1 = snd p2 -> p1 = p2. Proof. destruct p1; destruct p2; simpl in |- *; intros Hfst Hsnd. rewrite Hfst; rewrite Hsnd; reflexivity. Qed. +Definition prod_uncurry (A B C:Type) (f:prod A B -> C) + (x:A) (y:B) : C := f (pair x y). + +Definition prod_curry (A B C:Type) (f:A -> B -> C) + (p:prod A B) : C := match p with + | pair x y => f x y + end. (** Comparison *) @@ -127,3 +134,15 @@ Definition CompOpp (r:comparison) := | Lt => Gt | Gt => Lt end. + +(* Compatibility *) + +Notation prodT := prod (only parsing). +Notation pairT := pair (only parsing). +Notation prodT_rect := prod_rect (only parsing). +Notation prodT_rec := prod_rec (only parsing). +Notation prodT_ind := prod_ind (only parsing). +Notation fstT := fst (only parsing). +Notation sndT := snd (only parsing). +Notation prodT_uncurry := prod_uncurry (only parsing). +Notation prodT_curry := prod_curry (only parsing). diff --git a/theories/Init/Logic.v b/theories/Init/Logic.v index cbf8d7a7..71583718 100644 --- a/theories/Init/Logic.v +++ b/theories/Init/Logic.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Logic.v 8642 2006-03-17 10:09:02Z notin $ i*) +(*i $Id: Logic.v 8936 2006-06-09 15:43:33Z herbelin $ i*) Set Implicit Arguments. @@ -280,13 +280,36 @@ Qed. Hint Immediate sym_eq sym_not_eq: core v62. -(** Other notations *) +(** Basic definitions about relations and properties *) -Notation "'exists' ! x , P" := - (exists x', (fun x => P) x' /\ forall x'', (fun x => P) x'' -> x' = x'') +Definition subrelation (A B : Type) (R R' : A->B->Prop) := + forall x y, R x y -> R' x y. + +Definition unique (A : Type) (P : A->Prop) (x:A) := + P x /\ forall (x':A), P x' -> x=x'. + +Definition uniqueness (A:Type) (P:A->Prop) := forall x y, P x -> P y -> x = y. + +(** Unique existence *) + +Notation "'exists' ! x , P" := (ex (unique (fun x => P))) (at level 200, x ident, right associativity, format "'[' 'exists' ! '/ ' x , '/ ' P ']'") : type_scope. Notation "'exists' ! x : A , P" := - (exists x' : A, (fun x => P) x' /\ forall x'':A, (fun x => P) x'' -> x' = x'') + (ex (unique (fun x:A => P))) (at level 200, x ident, right associativity, format "'[' 'exists' ! '/ ' x : A , '/ ' P ']'") : type_scope. + +Lemma unique_existence : forall (A:Type) (P:A->Prop), + ((exists x, P x) /\ uniqueness P) <-> (exists! x, P x). +Proof. +intros A P; split. + intros ((x,Hx),Huni); exists x; red; auto. + intros (x,(Hx,Huni)); split. + exists x; assumption. + intros x' x'' Hx' Hx''; transitivity x. + symmetry; auto. + auto. +Qed. + + diff --git a/theories/Init/Logic_Type.v b/theories/Init/Logic_Type.v index 857ffe94..dbe944b0 100644 --- a/theories/Init/Logic_Type.v +++ b/theories/Init/Logic_Type.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Logic_Type.v 8642 2006-03-17 10:09:02Z notin $ i*) +(*i $Id: Logic_Type.v 8866 2006-05-28 16:21:04Z herbelin $ i*) (** This module defines type constructors for types in [Type] ([Datatypes.v] and [Logic.v] defined them for types in [Set]) *) @@ -20,32 +20,6 @@ Require Export Logic. Definition notT (A:Type) := A -> False. -(** Conjunction of types in [Type] *) - -Inductive prodT (A B:Type) : Type := - pairT : A -> B -> prodT A B. - -Section prodT_proj. - - Variables A B : Type. - - Definition fstT (H:prodT A B) := match H with - | pairT x _ => x - end. - Definition sndT (H:prodT A B) := match H with - | pairT _ y => y - end. - -End prodT_proj. - -Definition prodT_uncurry (A B C:Type) (f:prodT A B -> C) - (x:A) (y:B) : C := f (pairT x y). - -Definition prodT_curry (A B C:Type) (f:A -> B -> C) - (p:prodT A B) : C := match p with - | pairT x y => f x y - end. - (** Properties of [identity] *) Section identity_is_a_congruence. diff --git a/theories/Init/Notations.v b/theories/Init/Notations.v index 3ca93067..416647b4 100644 --- a/theories/Init/Notations.v +++ b/theories/Init/Notations.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Notations.v 6410 2004-12-06 11:34:35Z herbelin $ i*) +(*i $Id: Notations.v 8866 2006-05-28 16:21:04Z herbelin $ i*) (** These are the notations whose level and associativity are imposed by Coq *) @@ -62,6 +62,9 @@ Reserved Notation "{ x }" (at level 0, x at level 99). (** Notations for sigma-types or subsets *) +Reserved Notation "{ x | P }" (at level 0, x at level 99). +Reserved Notation "{ x | P & Q }" (at level 0, x at level 99). + Reserved Notation "{ x : A | P }" (at level 0, x at level 99). Reserved Notation "{ x : A | P & Q }" (at level 0, x at level 99). diff --git a/theories/Init/Specif.v b/theories/Init/Specif.v index e7fc1ac4..dd2f7697 100644 --- a/theories/Init/Specif.v +++ b/theories/Init/Specif.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Specif.v 8642 2006-03-17 10:09:02Z notin $ i*) +(*i $Id: Specif.v 8866 2006-05-28 16:21:04Z herbelin $ i*) (** Basic specifications : sets that may contain logical information *) @@ -19,42 +19,45 @@ Require Import Logic. (** Subsets and Sigma-types *) (** [(sig A P)], or more suggestively [{x:A | P x}], denotes the subset - of elements of the Set [A] which satisfy the predicate [P]. + of elements of the type [A] which satisfy the predicate [P]. Similarly [(sig2 A P Q)], or [{x:A | P x & Q x}], denotes the subset - of elements of the Set [A] which satisfy both [P] and [Q]. *) + of elements of the type [A] which satisfy both [P] and [Q]. *) -Inductive sig (A:Set) (P:A -> Prop) : Set := - exist : forall x:A, P x -> sig (A:=A) P. +Inductive sig (A:Type) (P:A -> Prop) : Type := + exist : forall x:A, P x -> sig P. -Inductive sig2 (A:Set) (P Q:A -> Prop) : Set := - exist2 : forall x:A, P x -> Q x -> sig2 (A:=A) P Q. +Inductive sig2 (A:Type) (P Q:A -> Prop) : Type := + exist2 : forall x:A, P x -> Q x -> sig2 P Q. -(** [(sigS A P)], or more suggestively [{x:A & (P x)}] is a Sigma-type. - It is a variant of subset where [P] is now of type [Set]. - Similarly for [(sigS2 A P Q)], also written [{x:A & (P x) & (Q x)}]. *) - -Inductive sigS (A:Set) (P:A -> Set) : Set := - existS : forall x:A, P x -> sigS (A:=A) P. +(** [(sigT A P)], or more suggestively [{x:A & (P x)}] is a Sigma-type. + Similarly for [(sigT2 A P Q)], also written [{x:A & (P x) & (Q x)}]. *) -Inductive sigS2 (A:Set) (P Q:A -> Set) : Set := - existS2 : forall x:A, P x -> Q x -> sigS2 (A:=A) P Q. +Inductive sigT (A:Type) (P:A -> Type) : Type := + existT : forall x:A, P x -> sigT P. + +Inductive sigT2 (A:Type) (P Q:A -> Type) : Type := + existT2 : forall x:A, P x -> Q x -> sigT2 P Q. + +(* Notations *) Arguments Scope sig [type_scope type_scope]. Arguments Scope sig2 [type_scope type_scope type_scope]. -Arguments Scope sigS [type_scope type_scope]. -Arguments Scope sigS2 [type_scope type_scope type_scope]. +Arguments Scope sigT [type_scope type_scope]. +Arguments Scope sigT2 [type_scope type_scope type_scope]. +Notation "{ x | P }" := (sig (fun x => P)) : type_scope. +Notation "{ x | P & Q }" := (sig2 (fun x => P) (fun x => Q)) : type_scope. Notation "{ x : A | P }" := (sig (fun x:A => P)) : type_scope. Notation "{ x : A | P & Q }" := (sig2 (fun x:A => P) (fun x:A => Q)) : type_scope. -Notation "{ x : A & P }" := (sigS (fun x:A => P)) : type_scope. -Notation "{ x : A & P & Q }" := (sigS2 (fun x:A => P) (fun x:A => Q)) : +Notation "{ x : A & P }" := (sigT (fun x:A => P)) : type_scope. +Notation "{ x : A & P & Q }" := (sigT2 (fun x:A => P) (fun x:A => Q)) : type_scope. Add Printing Let sig. Add Printing Let sig2. -Add Printing Let sigS. -Add Printing Let sigS2. +Add Printing Let sigT. +Add Printing Let sigT2. (** Projections of [sig] @@ -67,7 +70,7 @@ Add Printing Let sigS2. Section Subset_projections. - Variable A : Set. + Variable A : Type. Variable P : A -> Prop. Definition proj1_sig (e:sig P) := match e with @@ -82,24 +85,24 @@ Section Subset_projections. End Subset_projections. -(** Projections of [sigS] +(** Projections of [sigT] An element [x] of a sigma-type [{y:A & P y}] is a dependent pair made of an [a] of type [A] and an [h] of type [P a]. Then, - [(projS1 x)] is the first projection and [(projS2 x)] is the - second projection, the type of which depends on the [projS1]. *) + [(projT1 x)] is the first projection and [(projT2 x)] is the + second projection, the type of which depends on the [projT1]. *) Section Projections. - Variable A : Set. - Variable P : A -> Set. + Variable A : Type. + Variable P : A -> Type. - Definition projS1 (x:sigS P) : A := match x with - | existS a _ => a + Definition projT1 (x:sigT P) : A := match x with + | existT a _ => a end. - Definition projS2 (x:sigS P) : P (projS1 x) := - match x return P (projS1 x) with - | existS _ h => h + Definition projT2 (x:sigT P) : P (projT1 x) := + match x return P (projT1 x) with + | existT _ h => h end. End Projections. @@ -118,7 +121,7 @@ Add Printing If sumbool. (** [sumor] is an option type equipped with the justification of why it may not be a regular value *) -Inductive sumor (A:Set) (B:Prop) : Set := +Inductive sumor (A:Type) (B:Prop) : Type := | inleft : A -> A + {B} | inright : B -> A + {B} where "A + { B }" := (sumor A B) : type_scope. @@ -146,12 +149,12 @@ Section Choice_lemmas. Qed. Lemma Choice2 : - (forall x:S, sigS (fun y:S' => R' x y)) -> - sigS (fun f:S -> S' => forall z:S, R' z (f z)). + (forall x:S, sigT (fun y:S' => R' x y)) -> + sigT (fun f:S -> S' => forall z:S, R' z (f z)). Proof. intro H. exists (fun z:S => match H z with - | existS y _ => y + | existT y _ => y end). intro z; destruct (H z); trivial. Qed. @@ -176,7 +179,7 @@ End Choice_lemmas. (** A result of type [(Exc A)] is either a normal value of type [A] or an [error] : - [Inductive Exc [A:Set] : Set := value : A->(Exc A) | error : (Exc A)]. + [Inductive Exc [A:Type] : Type := value : A->(Exc A) | error : (Exc A)]. It is implemented using the option type. *) @@ -199,24 +202,18 @@ Qed. Hint Resolve left right inleft inright: core v62. -(** Sigma-type for types in [Type] *) - -Inductive sigT (A:Type) (P:A -> Type) : Type := - existT : forall x:A, P x -> sigT (A:=A) P. - -Section projections_sigT. - - Variable A : Type. - Variable P : A -> Type. - - Definition projT1 (H:sigT P) : A := match H with - | existT x _ => x - end. - - Definition projT2 : forall x:sigT P, P (projT1 x) := - fun H:sigT P => match H return P (projT1 H) with - | existT x h => h - end. - -End projections_sigT. - +(* Compatibility *) + +Notation sigS := sigT (only parsing). +Notation existS := existT (only parsing). +Notation sigS_rect := sigT_rect (only parsing). +Notation sigS_rec := sigT_rec (only parsing). +Notation sigS_ind := sigT_ind (only parsing). +Notation projS1 := projT1 (only parsing). +Notation projS2 := projT2 (only parsing). + +Notation sigS2 := sigT2 (only parsing). +Notation existS2 := existT2 (only parsing). +Notation sigS2_rect := sigT2_rect (only parsing). +Notation sigS2_rec := sigT2_rec (only parsing). +Notation sigS2_ind := sigT2_ind (only parsing). diff --git a/theories/IntMap/Adalloc.v b/theories/IntMap/Adalloc.v index 2136bfb5..ca8e7eeb 100644 --- a/theories/IntMap/Adalloc.v +++ b/theories/IntMap/Adalloc.v @@ -5,15 +5,15 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Adalloc.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: Adalloc.v 8733 2006-04-25 22:52:18Z letouzey $ i*) Require Import Bool. Require Import Sumbool. -Require Import ZArith. Require Import Arith. -Require Import Addr. -Require Import Adist. -Require Import Addec. +Require Import NArith. +Require Import Ndigits. +Require Import Ndec. +Require Import Nnat. Require Import Map. Require Import Fset. @@ -21,215 +21,36 @@ Section AdAlloc. Variable A : Set. - Definition nat_of_ad (a:ad) := - match a with - | ad_z => 0 - | ad_x p => nat_of_P p - end. - - Fixpoint nat_le (m:nat) : nat -> bool := - match m with - | O => fun _:nat => true - | S m' => - fun n:nat => match n with - | O => false - | S n' => nat_le m' n' - end - end. - - Lemma nat_le_correct : forall m n:nat, m <= n -> nat_le m n = true. - Proof. - induction m as [| m IHm]. trivial. - destruct n. intro H. elim (le_Sn_O _ H). - intros. simpl in |- *. apply IHm. apply le_S_n. assumption. - Qed. - - Lemma nat_le_complete : forall m n:nat, nat_le m n = true -> m <= n. - Proof. - induction m. trivial with arith. - destruct n. intro H. discriminate H. - auto with arith. - Qed. - - Lemma nat_le_correct_conv : forall m n:nat, m < n -> nat_le n m = false. - Proof. - intros. elim (sumbool_of_bool (nat_le n m)). intro H0. - elim (lt_irrefl _ (lt_le_trans _ _ _ H (nat_le_complete _ _ H0))). - trivial. - Qed. - - Lemma nat_le_complete_conv : forall m n:nat, nat_le n m = false -> m < n. - Proof. - intros. elim (le_or_lt n m). intro. conditional trivial rewrite nat_le_correct in H. discriminate H. - trivial. - Qed. - - Definition ad_of_nat (n:nat) := - match n with - | O => ad_z - | S n' => ad_x (P_of_succ_nat n') - end. - - Lemma ad_of_nat_of_ad : forall a:ad, ad_of_nat (nat_of_ad a) = a. - Proof. - destruct a as [| p]. reflexivity. - simpl in |- *. elim (ZL4 p). intros n H. rewrite H. simpl in |- *. rewrite <- nat_of_P_o_P_of_succ_nat_eq_succ in H. - rewrite nat_of_P_inj with (1 := H). reflexivity. - Qed. - - Lemma nat_of_ad_of_nat : forall n:nat, nat_of_ad (ad_of_nat n) = n. - Proof. - induction n. trivial. - intros. simpl in |- *. apply nat_of_P_o_P_of_succ_nat_eq_succ. - Qed. - - Definition ad_le (a b:ad) := nat_le (nat_of_ad a) (nat_of_ad b). - - Lemma ad_le_refl : forall a:ad, ad_le a a = true. - Proof. - intro. unfold ad_le in |- *. apply nat_le_correct. apply le_n. - Qed. - - Lemma ad_le_antisym : - forall a b:ad, ad_le a b = true -> ad_le b a = true -> a = b. - Proof. - unfold ad_le in |- *. intros. rewrite <- (ad_of_nat_of_ad a). rewrite <- (ad_of_nat_of_ad b). - rewrite (le_antisym _ _ (nat_le_complete _ _ H) (nat_le_complete _ _ H0)). reflexivity. - Qed. - - Lemma ad_le_trans : - forall a b c:ad, ad_le a b = true -> ad_le b c = true -> ad_le a c = true. - Proof. - unfold ad_le in |- *. intros. apply nat_le_correct. apply le_trans with (m := nat_of_ad b). - apply nat_le_complete. assumption. - apply nat_le_complete. assumption. - Qed. - - Lemma ad_le_lt_trans : - forall a b c:ad, - ad_le a b = true -> ad_le c b = false -> ad_le c a = false. - Proof. - unfold ad_le in |- *. intros. apply nat_le_correct_conv. apply le_lt_trans with (m := nat_of_ad b). - apply nat_le_complete. assumption. - apply nat_le_complete_conv. assumption. - Qed. - - Lemma ad_lt_le_trans : - forall a b c:ad, - ad_le b a = false -> ad_le b c = true -> ad_le c a = false. - Proof. - unfold ad_le in |- *. intros. apply nat_le_correct_conv. apply lt_le_trans with (m := nat_of_ad b). - apply nat_le_complete_conv. assumption. - apply nat_le_complete. assumption. - Qed. - - Lemma ad_lt_trans : - forall a b c:ad, - ad_le b a = false -> ad_le c b = false -> ad_le c a = false. - Proof. - unfold ad_le in |- *. intros. apply nat_le_correct_conv. apply lt_trans with (m := nat_of_ad b). - apply nat_le_complete_conv. assumption. - apply nat_le_complete_conv. assumption. - Qed. - - Lemma ad_lt_le_weak : forall a b:ad, ad_le b a = false -> ad_le a b = true. - Proof. - unfold ad_le in |- *. intros. apply nat_le_correct. apply lt_le_weak. - apply nat_le_complete_conv. assumption. - Qed. - - Definition ad_min (a b:ad) := if ad_le a b then a else b. - - Lemma ad_min_choice : forall a b:ad, {ad_min a b = a} + {ad_min a b = b}. - Proof. - unfold ad_min in |- *. intros. elim (sumbool_of_bool (ad_le a b)). intro H. left. rewrite H. - reflexivity. - intro H. right. rewrite H. reflexivity. - Qed. - - Lemma ad_min_le_1 : forall a b:ad, ad_le (ad_min a b) a = true. - Proof. - unfold ad_min in |- *. intros. elim (sumbool_of_bool (ad_le a b)). intro H. rewrite H. - apply ad_le_refl. - intro H. rewrite H. apply ad_lt_le_weak. assumption. - Qed. - - Lemma ad_min_le_2 : forall a b:ad, ad_le (ad_min a b) b = true. - Proof. - unfold ad_min in |- *. intros. elim (sumbool_of_bool (ad_le a b)). intro H. rewrite H. assumption. - intro H. rewrite H. apply ad_le_refl. - Qed. - - Lemma ad_min_le_3 : - forall a b c:ad, ad_le a (ad_min b c) = true -> ad_le a b = true. - Proof. - unfold ad_min in |- *. intros. elim (sumbool_of_bool (ad_le b c)). intro H0. rewrite H0 in H. - assumption. - intro H0. rewrite H0 in H. apply ad_lt_le_weak. apply ad_le_lt_trans with (b := c); assumption. - Qed. - - Lemma ad_min_le_4 : - forall a b c:ad, ad_le a (ad_min b c) = true -> ad_le a c = true. - Proof. - unfold ad_min in |- *. intros. elim (sumbool_of_bool (ad_le b c)). intro H0. rewrite H0 in H. - apply ad_le_trans with (b := b); assumption. - intro H0. rewrite H0 in H. assumption. - Qed. - - Lemma ad_min_le_5 : - forall a b c:ad, - ad_le a b = true -> ad_le a c = true -> ad_le a (ad_min b c) = true. - Proof. - intros. elim (ad_min_choice b c). intro H1. rewrite H1. assumption. - intro H1. rewrite H1. assumption. - Qed. - - Lemma ad_min_lt_3 : - forall a b c:ad, ad_le (ad_min b c) a = false -> ad_le b a = false. - Proof. - unfold ad_min in |- *. intros. elim (sumbool_of_bool (ad_le b c)). intro H0. rewrite H0 in H. - assumption. - intro H0. rewrite H0 in H. apply ad_lt_trans with (b := c); assumption. - Qed. - - Lemma ad_min_lt_4 : - forall a b c:ad, ad_le (ad_min b c) a = false -> ad_le c a = false. - Proof. - unfold ad_min in |- *. intros. elim (sumbool_of_bool (ad_le b c)). intro H0. rewrite H0 in H. - apply ad_lt_le_trans with (b := b); assumption. - intro H0. rewrite H0 in H. assumption. - Qed. - (** Allocator: returns an address not in the domain of [m]. This allocator is optimal in that it returns the lowest possible address, in the usual ordering on integers. It is not the most efficient, however. *) Fixpoint ad_alloc_opt (m:Map A) : ad := match m with - | M0 => ad_z - | M1 a _ => if ad_eq a ad_z then ad_x 1 else ad_z + | M0 => N0 + | M1 a _ => if Neqb a N0 then Npos 1 else N0 | M2 m1 m2 => - ad_min (ad_double (ad_alloc_opt m1)) - (ad_double_plus_un (ad_alloc_opt m2)) + Nmin (Ndouble (ad_alloc_opt m1)) + (Ndouble_plus_one (ad_alloc_opt m2)) end. Lemma ad_alloc_opt_allocates_1 : - forall m:Map A, MapGet A m (ad_alloc_opt m) = NONE A. + forall m:Map A, MapGet A m (ad_alloc_opt m) = None. Proof. induction m as [| a| m0 H m1 H0]. reflexivity. - simpl in |- *. elim (sumbool_of_bool (ad_eq a ad_z)). intro H. rewrite H. - rewrite (ad_eq_complete _ _ H). reflexivity. + simpl in |- *. elim (sumbool_of_bool (Neqb a N0)). intro H. rewrite H. + rewrite (Neqb_complete _ _ H). reflexivity. intro H. rewrite H. rewrite H. reflexivity. intros. change - (ad_alloc_opt (M2 A m0 m1)) with (ad_min (ad_double (ad_alloc_opt m0)) - (ad_double_plus_un (ad_alloc_opt m1))) + (ad_alloc_opt (M2 A m0 m1)) with (Nmin (Ndouble (ad_alloc_opt m0)) + (Ndouble_plus_one (ad_alloc_opt m1))) in |- *. elim - (ad_min_choice (ad_double (ad_alloc_opt m0)) - (ad_double_plus_un (ad_alloc_opt m1))). - intro H1. rewrite H1. rewrite MapGet_M2_bit_0_0. rewrite ad_double_div_2. assumption. - apply ad_double_bit_0. - intro H1. rewrite H1. rewrite MapGet_M2_bit_0_1. rewrite ad_double_plus_un_div_2. assumption. - apply ad_double_plus_un_bit_0. + (Nmin_choice (Ndouble (ad_alloc_opt m0)) + (Ndouble_plus_one (ad_alloc_opt m1))). + intro H1. rewrite H1. rewrite MapGet_M2_bit_0_0. rewrite Ndouble_div2. assumption. + apply Ndouble_bit0. + intro H1. rewrite H1. rewrite MapGet_M2_bit_0_1. rewrite Ndouble_plus_one_div2. assumption. + apply Ndouble_plus_one_bit0. Qed. Lemma ad_alloc_opt_allocates : @@ -241,122 +62,30 @@ Section AdAlloc. (** Moreover, this is optimal: all addresses below [(ad_alloc_opt m)] are in [dom m]: *) - Lemma nat_of_ad_double : - forall a:ad, nat_of_ad (ad_double a) = 2 * nat_of_ad a. - Proof. - destruct a as [| p]. trivial. - exact (nat_of_P_xO p). - Qed. - - Lemma nat_of_ad_double_plus_un : - forall a:ad, nat_of_ad (ad_double_plus_un a) = S (2 * nat_of_ad a). - Proof. - destruct a as [| p]. trivial. - exact (nat_of_P_xI p). - Qed. - - Lemma ad_le_double_mono : - forall a b:ad, - ad_le a b = true -> ad_le (ad_double a) (ad_double b) = true. - Proof. - unfold ad_le in |- *. intros. rewrite nat_of_ad_double. rewrite nat_of_ad_double. apply nat_le_correct. - simpl in |- *. apply plus_le_compat. apply nat_le_complete. assumption. - apply plus_le_compat. apply nat_le_complete. assumption. - apply le_n. - Qed. - - Lemma ad_le_double_plus_un_mono : - forall a b:ad, - ad_le a b = true -> - ad_le (ad_double_plus_un a) (ad_double_plus_un b) = true. - Proof. - unfold ad_le in |- *. intros. rewrite nat_of_ad_double_plus_un. rewrite nat_of_ad_double_plus_un. - apply nat_le_correct. apply le_n_S. simpl in |- *. apply plus_le_compat. apply nat_le_complete. - assumption. - apply plus_le_compat. apply nat_le_complete. assumption. - apply le_n. - Qed. - - Lemma ad_le_double_mono_conv : - forall a b:ad, - ad_le (ad_double a) (ad_double b) = true -> ad_le a b = true. - Proof. - unfold ad_le in |- *. intros a b. rewrite nat_of_ad_double. rewrite nat_of_ad_double. intro. - apply nat_le_correct. apply (mult_S_le_reg_l 1). apply nat_le_complete. assumption. - Qed. - - Lemma ad_le_double_plus_un_mono_conv : - forall a b:ad, - ad_le (ad_double_plus_un a) (ad_double_plus_un b) = true -> - ad_le a b = true. - Proof. - unfold ad_le in |- *. intros a b. rewrite nat_of_ad_double_plus_un. rewrite nat_of_ad_double_plus_un. - intro. apply nat_le_correct. apply (mult_S_le_reg_l 1). apply le_S_n. apply nat_le_complete. - assumption. - Qed. - - Lemma ad_lt_double_mono : - forall a b:ad, - ad_le a b = false -> ad_le (ad_double a) (ad_double b) = false. - Proof. - intros. elim (sumbool_of_bool (ad_le (ad_double a) (ad_double b))). intro H0. - rewrite (ad_le_double_mono_conv _ _ H0) in H. discriminate H. - trivial. - Qed. - - Lemma ad_lt_double_plus_un_mono : - forall a b:ad, - ad_le a b = false -> - ad_le (ad_double_plus_un a) (ad_double_plus_un b) = false. - Proof. - intros. elim (sumbool_of_bool (ad_le (ad_double_plus_un a) (ad_double_plus_un b))). intro H0. - rewrite (ad_le_double_plus_un_mono_conv _ _ H0) in H. discriminate H. - trivial. - Qed. - - Lemma ad_lt_double_mono_conv : - forall a b:ad, - ad_le (ad_double a) (ad_double b) = false -> ad_le a b = false. - Proof. - intros. elim (sumbool_of_bool (ad_le a b)). intro H0. rewrite (ad_le_double_mono _ _ H0) in H. - discriminate H. - trivial. - Qed. - - Lemma ad_lt_double_plus_un_mono_conv : - forall a b:ad, - ad_le (ad_double_plus_un a) (ad_double_plus_un b) = false -> - ad_le a b = false. - Proof. - intros. elim (sumbool_of_bool (ad_le a b)). intro H0. - rewrite (ad_le_double_plus_un_mono _ _ H0) in H. discriminate H. - trivial. - Qed. - Lemma ad_alloc_opt_optimal_1 : forall (m:Map A) (a:ad), - ad_le (ad_alloc_opt m) a = false -> {y : A | MapGet A m a = SOME A y}. + Nle (ad_alloc_opt m) a = false -> {y : A | MapGet A m a = Some y}. Proof. - induction m as [| a y| m0 H m1 H0]. simpl in |- *. unfold ad_le in |- *. simpl in |- *. intros. discriminate H. - simpl in |- *. intros b H. elim (sumbool_of_bool (ad_eq a ad_z)). intro H0. rewrite H0 in H. - unfold ad_le in H. cut (ad_z = b). intro. split with y. rewrite <- H1. rewrite H0. reflexivity. - rewrite <- (ad_of_nat_of_ad b). - rewrite <- (le_n_O_eq _ (le_S_n _ _ (nat_le_complete_conv _ _ H))). reflexivity. + induction m as [| a y| m0 H m1 H0]. simpl in |- *. unfold Nle in |- *. simpl in |- *. intros. discriminate H. + simpl in |- *. intros b H. elim (sumbool_of_bool (Neqb a N0)). intro H0. rewrite H0 in H. + unfold Nle in H. cut (N0 = b). intro. split with y. rewrite <- H1. rewrite H0. reflexivity. + rewrite <- (N_of_nat_of_N b). + rewrite <- (le_n_O_eq _ (le_S_n _ _ (leb_complete_conv _ _ H))). reflexivity. intro H0. rewrite H0 in H. discriminate H. - intros. simpl in H1. elim (ad_double_or_double_plus_un a). intro H2. elim H2. intros a0 H3. - rewrite H3 in H1. elim (H _ (ad_lt_double_mono_conv _ _ (ad_min_lt_3 _ _ _ H1))). intros y H4. - split with y. rewrite H3. rewrite MapGet_M2_bit_0_0. rewrite ad_double_div_2. assumption. - apply ad_double_bit_0. + intros. simpl in H1. elim (Ndouble_or_double_plus_un a). intro H2. elim H2. intros a0 H3. + rewrite H3 in H1. elim (H _ (Nlt_double_mono_conv _ _ (Nmin_lt_3 _ _ _ H1))). intros y H4. + split with y. rewrite H3. rewrite MapGet_M2_bit_0_0. rewrite Ndouble_div2. assumption. + apply Ndouble_bit0. intro H2. elim H2. intros a0 H3. rewrite H3 in H1. - elim (H0 _ (ad_lt_double_plus_un_mono_conv _ _ (ad_min_lt_4 _ _ _ H1))). intros y H4. - split with y. rewrite H3. rewrite MapGet_M2_bit_0_1. rewrite ad_double_plus_un_div_2. + elim (H0 _ (Nlt_double_plus_one_mono_conv _ _ (Nmin_lt_4 _ _ _ H1))). intros y H4. + split with y. rewrite H3. rewrite MapGet_M2_bit_0_1. rewrite Ndouble_plus_one_div2. assumption. - apply ad_double_plus_un_bit_0. + apply Ndouble_plus_one_bit0. Qed. Lemma ad_alloc_opt_optimal : forall (m:Map A) (a:ad), - ad_le (ad_alloc_opt m) a = false -> in_dom A a m = true. + Nle (ad_alloc_opt m) a = false -> in_dom A a m = true. Proof. intros. unfold in_dom in |- *. elim (ad_alloc_opt_optimal_1 m a H). intros y H0. rewrite H0. reflexivity. diff --git a/theories/IntMap/Addec.v b/theories/IntMap/Addec.v deleted file mode 100644 index f1a937a3..00000000 --- a/theories/IntMap/Addec.v +++ /dev/null @@ -1,193 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) -(*i $Id: Addec.v 5920 2004-07-16 20:01:26Z herbelin $ i*) - -(** Equality on adresses *) - -Require Import Bool. -Require Import Sumbool. -Require Import ZArith. -Require Import Addr. - -Fixpoint ad_eq_1 (p1 p2:positive) {struct p2} : bool := - match p1, p2 with - | xH, xH => true - | xO p'1, xO p'2 => ad_eq_1 p'1 p'2 - | xI p'1, xI p'2 => ad_eq_1 p'1 p'2 - | _, _ => false - end. - -Definition ad_eq (a a':ad) := - match a, a' with - | ad_z, ad_z => true - | ad_x p, ad_x p' => ad_eq_1 p p' - | _, _ => false - end. - -Lemma ad_eq_correct : forall a:ad, ad_eq a a = true. -Proof. - destruct a; trivial. - induction p; trivial. -Qed. - -Lemma ad_eq_complete : forall a a':ad, ad_eq a a' = true -> a = a'. -Proof. - destruct a. destruct a'; trivial. destruct p. - discriminate 1. - discriminate 1. - discriminate 1. - destruct a'. intros. discriminate H. - unfold ad_eq in |- *. intros. cut (p = p0). intros. rewrite H0. reflexivity. - generalize dependent p0. - induction p as [p IHp| p IHp| ]. destruct p0; intro H. - rewrite (IHp p0). reflexivity. - exact H. - discriminate H. - discriminate H. - destruct p0; intro H. discriminate H. - rewrite (IHp p0 H). reflexivity. - discriminate H. - destruct p0 as [p| p| ]; intro H. discriminate H. - discriminate H. - trivial. -Qed. - -Lemma ad_eq_comm : forall a a':ad, ad_eq a a' = ad_eq a' a. -Proof. - intros. cut (forall b b':bool, ad_eq a a' = b -> ad_eq a' a = b' -> b = b'). - intros. apply H. reflexivity. - reflexivity. - destruct b. intros. cut (a = a'). - intro. rewrite H1 in H0. rewrite (ad_eq_correct a') in H0. exact H0. - apply ad_eq_complete. exact H. - destruct b'. intros. cut (a' = a). - intro. rewrite H1 in H. rewrite H1 in H0. rewrite <- H. exact H0. - apply ad_eq_complete. exact H0. - trivial. -Qed. - -Lemma ad_xor_eq_true : - forall a a':ad, ad_xor a a' = ad_z -> ad_eq a a' = true. -Proof. - intros. rewrite (ad_xor_eq a a' H). apply ad_eq_correct. -Qed. - -Lemma ad_xor_eq_false : - forall (a a':ad) (p:positive), ad_xor a a' = ad_x p -> ad_eq a a' = false. -Proof. - intros. elim (sumbool_of_bool (ad_eq a a')). intro H0. - rewrite (ad_eq_complete a a' H0) in H. rewrite (ad_xor_nilpotent a') in H. discriminate H. - trivial. -Qed. - -Lemma ad_bit_0_1_not_double : - forall a:ad, - ad_bit_0 a = true -> forall a0:ad, ad_eq (ad_double a0) a = false. -Proof. - intros. elim (sumbool_of_bool (ad_eq (ad_double a0) a)). intro H0. - rewrite <- (ad_eq_complete _ _ H0) in H. rewrite (ad_double_bit_0 a0) in H. discriminate H. - trivial. -Qed. - -Lemma ad_not_div_2_not_double : - forall a a0:ad, - ad_eq (ad_div_2 a) a0 = false -> ad_eq a (ad_double a0) = false. -Proof. - intros. elim (sumbool_of_bool (ad_eq (ad_double a0) a)). intro H0. - rewrite <- (ad_eq_complete _ _ H0) in H. rewrite (ad_double_div_2 a0) in H. - rewrite (ad_eq_correct a0) in H. discriminate H. - intro. rewrite ad_eq_comm. assumption. -Qed. - -Lemma ad_bit_0_0_not_double_plus_un : - forall a:ad, - ad_bit_0 a = false -> forall a0:ad, ad_eq (ad_double_plus_un a0) a = false. -Proof. - intros. elim (sumbool_of_bool (ad_eq (ad_double_plus_un a0) a)). intro H0. - rewrite <- (ad_eq_complete _ _ H0) in H. rewrite (ad_double_plus_un_bit_0 a0) in H. - discriminate H. - trivial. -Qed. - -Lemma ad_not_div_2_not_double_plus_un : - forall a a0:ad, - ad_eq (ad_div_2 a) a0 = false -> ad_eq (ad_double_plus_un a0) a = false. -Proof. - intros. elim (sumbool_of_bool (ad_eq a (ad_double_plus_un a0))). intro H0. - rewrite (ad_eq_complete _ _ H0) in H. rewrite (ad_double_plus_un_div_2 a0) in H. - rewrite (ad_eq_correct a0) in H. discriminate H. - intro H0. rewrite ad_eq_comm. assumption. -Qed. - -Lemma ad_bit_0_neq : - forall a a':ad, - ad_bit_0 a = false -> ad_bit_0 a' = true -> ad_eq a a' = false. -Proof. - intros. elim (sumbool_of_bool (ad_eq a a')). intro H1. rewrite (ad_eq_complete _ _ H1) in H. - rewrite H in H0. discriminate H0. - trivial. -Qed. - -Lemma ad_div_eq : - forall a a':ad, ad_eq a a' = true -> ad_eq (ad_div_2 a) (ad_div_2 a') = true. -Proof. - intros. cut (a = a'). intros. rewrite H0. apply ad_eq_correct. - apply ad_eq_complete. exact H. -Qed. - -Lemma ad_div_neq : - forall a a':ad, - ad_eq (ad_div_2 a) (ad_div_2 a') = false -> ad_eq a a' = false. -Proof. - intros. elim (sumbool_of_bool (ad_eq a a')). intro H0. - rewrite (ad_eq_complete _ _ H0) in H. rewrite (ad_eq_correct (ad_div_2 a')) in H. discriminate H. - trivial. -Qed. - -Lemma ad_div_bit_eq : - forall a a':ad, - ad_bit_0 a = ad_bit_0 a' -> ad_div_2 a = ad_div_2 a' -> a = a'. -Proof. - intros. apply ad_faithful. unfold eqf in |- *. destruct n. - rewrite ad_bit_0_correct. rewrite ad_bit_0_correct. assumption. - rewrite <- ad_div_2_correct. rewrite <- ad_div_2_correct. - rewrite H0. reflexivity. -Qed. - -Lemma ad_div_bit_neq : - forall a a':ad, - ad_eq a a' = false -> - ad_bit_0 a = ad_bit_0 a' -> ad_eq (ad_div_2 a) (ad_div_2 a') = false. -Proof. - intros. elim (sumbool_of_bool (ad_eq (ad_div_2 a) (ad_div_2 a'))). intro H1. - rewrite (ad_div_bit_eq _ _ H0 (ad_eq_complete _ _ H1)) in H. - rewrite (ad_eq_correct a') in H. discriminate H. - trivial. -Qed. - -Lemma ad_neq : - forall a a':ad, - ad_eq a a' = false -> - ad_bit_0 a = negb (ad_bit_0 a') \/ - ad_eq (ad_div_2 a) (ad_div_2 a') = false. -Proof. - intros. cut (ad_bit_0 a = ad_bit_0 a' \/ ad_bit_0 a = negb (ad_bit_0 a')). - intros. elim H0. intro. right. apply ad_div_bit_neq. assumption. - assumption. - intro. left. assumption. - case (ad_bit_0 a); case (ad_bit_0 a'); auto. -Qed. - -Lemma ad_double_or_double_plus_un : - forall a:ad, - {a0 : ad | a = ad_double a0} + {a1 : ad | a = ad_double_plus_un a1}. -Proof. - intro. elim (sumbool_of_bool (ad_bit_0 a)). intro H. right. split with (ad_div_2 a). - rewrite (ad_div_2_double_plus_un a H). reflexivity. - intro H. left. split with (ad_div_2 a). rewrite (ad_div_2_double a H). reflexivity. -Qed.
\ No newline at end of file diff --git a/theories/IntMap/Addr.v b/theories/IntMap/Addr.v deleted file mode 100644 index 727117b3..00000000 --- a/theories/IntMap/Addr.v +++ /dev/null @@ -1,491 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) -(*i $Id: Addr.v 5920 2004-07-16 20:01:26Z herbelin $ i*) - -(** Representation of adresses by the [positive] type of binary numbers *) - -Require Import Bool. -Require Import ZArith. - -Inductive ad : Set := - | ad_z : ad - | ad_x : positive -> ad. - -Lemma ad_sum : forall a:ad, {p : positive | a = ad_x p} + {a = ad_z}. -Proof. - destruct a; auto. - left; exists p; trivial. -Qed. - -Fixpoint p_xor (p p2:positive) {struct p} : ad := - match p with - | xH => - match p2 with - | xH => ad_z - | xO p'2 => ad_x (xI p'2) - | xI p'2 => ad_x (xO p'2) - end - | xO p' => - match p2 with - | xH => ad_x (xI p') - | xO p'2 => - match p_xor p' p'2 with - | ad_z => ad_z - | ad_x p'' => ad_x (xO p'') - end - | xI p'2 => - match p_xor p' p'2 with - | ad_z => ad_x 1 - | ad_x p'' => ad_x (xI p'') - end - end - | xI p' => - match p2 with - | xH => ad_x (xO p') - | xO p'2 => - match p_xor p' p'2 with - | ad_z => ad_x 1 - | ad_x p'' => ad_x (xI p'') - end - | xI p'2 => - match p_xor p' p'2 with - | ad_z => ad_z - | ad_x p'' => ad_x (xO p'') - end - end - end. - -Definition ad_xor (a a':ad) := - match a with - | ad_z => a' - | ad_x p => match a' with - | ad_z => a - | ad_x p' => p_xor p p' - end - end. - -Lemma ad_xor_neutral_left : forall a:ad, ad_xor ad_z a = a. -Proof. - trivial. -Qed. - -Lemma ad_xor_neutral_right : forall a:ad, ad_xor a ad_z = a. -Proof. - destruct a; trivial. -Qed. - -Lemma ad_xor_comm : forall a a':ad, ad_xor a a' = ad_xor a' a. -Proof. - destruct a; destruct a'; simpl in |- *; auto. - generalize p0; clear p0; induction p as [p Hrecp| p Hrecp| ]; simpl in |- *; - auto. - destruct p0; simpl in |- *; trivial; intros. - rewrite Hrecp; trivial. - rewrite Hrecp; trivial. - destruct p0; simpl in |- *; trivial; intros. - rewrite Hrecp; trivial. - rewrite Hrecp; trivial. - destruct p0 as [p| p| ]; simpl in |- *; auto. -Qed. - -Lemma ad_xor_nilpotent : forall a:ad, ad_xor a a = ad_z. -Proof. - destruct a; trivial. - simpl in |- *. induction p as [p IHp| p IHp| ]; trivial. - simpl in |- *. rewrite IHp; reflexivity. - simpl in |- *. rewrite IHp; reflexivity. -Qed. - -Fixpoint ad_bit_1 (p:positive) : nat -> bool := - match p with - | xH => fun n:nat => match n with - | O => true - | S _ => false - end - | xO p => - fun n:nat => match n with - | O => false - | S n' => ad_bit_1 p n' - end - | xI p => fun n:nat => match n with - | O => true - | S n' => ad_bit_1 p n' - end - end. - -Definition ad_bit (a:ad) := - match a with - | ad_z => fun _:nat => false - | ad_x p => ad_bit_1 p - end. - -Definition eqf (f g:nat -> bool) := forall n:nat, f n = g n. - -Lemma ad_faithful_1 : forall a:ad, eqf (ad_bit ad_z) (ad_bit a) -> ad_z = a. -Proof. - destruct a. trivial. - induction p as [p IHp| p IHp| ]; intro H. absurd (ad_z = ad_x p). discriminate. - exact (IHp (fun n:nat => H (S n))). - absurd (ad_z = ad_x p). discriminate. - exact (IHp (fun n:nat => H (S n))). - absurd (false = true). discriminate. - exact (H 0). -Qed. - -Lemma ad_faithful_2 : - forall a:ad, eqf (ad_bit (ad_x 1)) (ad_bit a) -> ad_x 1 = a. -Proof. - destruct a. intros. absurd (true = false). discriminate. - exact (H 0). - destruct p. intro H. absurd (ad_z = ad_x p). discriminate. - exact (ad_faithful_1 (ad_x p) (fun n:nat => H (S n))). - intros. absurd (true = false). discriminate. - exact (H 0). - trivial. -Qed. - -Lemma ad_faithful_3 : - forall (a:ad) (p:positive), - (forall p':positive, eqf (ad_bit (ad_x p)) (ad_bit (ad_x p')) -> p = p') -> - eqf (ad_bit (ad_x (xO p))) (ad_bit a) -> ad_x (xO p) = a. -Proof. - destruct a. intros. cut (eqf (ad_bit ad_z) (ad_bit (ad_x (xO p)))). - intro. rewrite (ad_faithful_1 (ad_x (xO p)) H1). reflexivity. - unfold eqf in |- *. intro. unfold eqf in H0. rewrite H0. reflexivity. - case p. intros. absurd (false = true). discriminate. - exact (H0 0). - intros. rewrite (H p0 (fun n:nat => H0 (S n))). reflexivity. - intros. absurd (false = true). discriminate. - exact (H0 0). -Qed. - -Lemma ad_faithful_4 : - forall (a:ad) (p:positive), - (forall p':positive, eqf (ad_bit (ad_x p)) (ad_bit (ad_x p')) -> p = p') -> - eqf (ad_bit (ad_x (xI p))) (ad_bit a) -> ad_x (xI p) = a. -Proof. - destruct a. intros. cut (eqf (ad_bit ad_z) (ad_bit (ad_x (xI p)))). - intro. rewrite (ad_faithful_1 (ad_x (xI p)) H1). reflexivity. - unfold eqf in |- *. intro. unfold eqf in H0. rewrite H0. reflexivity. - case p. intros. rewrite (H p0 (fun n:nat => H0 (S n))). reflexivity. - intros. absurd (true = false). discriminate. - exact (H0 0). - intros. absurd (ad_z = ad_x p0). discriminate. - cut (eqf (ad_bit (ad_x 1)) (ad_bit (ad_x (xI p0)))). - intro. exact (ad_faithful_1 (ad_x p0) (fun n:nat => H1 (S n))). - unfold eqf in |- *. unfold eqf in H0. intro. rewrite H0. reflexivity. -Qed. - -Lemma ad_faithful : forall a a':ad, eqf (ad_bit a) (ad_bit a') -> a = a'. -Proof. - destruct a. exact ad_faithful_1. - induction p. intros a' H. apply ad_faithful_4. intros. cut (ad_x p = ad_x p'). - intro. inversion H1. reflexivity. - exact (IHp (ad_x p') H0). - assumption. - intros. apply ad_faithful_3. intros. cut (ad_x p = ad_x p'). intro. inversion H1. reflexivity. - exact (IHp (ad_x p') H0). - assumption. - exact ad_faithful_2. -Qed. - -Definition adf_xor (f g:nat -> bool) (n:nat) := xorb (f n) (g n). - -Lemma ad_xor_sem_1 : forall a':ad, ad_bit (ad_xor ad_z a') 0 = ad_bit a' 0. -Proof. - trivial. -Qed. - -Lemma ad_xor_sem_2 : - forall a':ad, ad_bit (ad_xor (ad_x 1) a') 0 = negb (ad_bit a' 0). -Proof. - intro. case a'. trivial. - simpl in |- *. intro. - case p; trivial. -Qed. - -Lemma ad_xor_sem_3 : - forall (p:positive) (a':ad), - ad_bit (ad_xor (ad_x (xO p)) a') 0 = ad_bit a' 0. -Proof. - intros. case a'. trivial. - simpl in |- *. intro. - case p0; trivial. intro. - case (p_xor p p1); trivial. - intro. case (p_xor p p1); trivial. -Qed. - -Lemma ad_xor_sem_4 : - forall (p:positive) (a':ad), - ad_bit (ad_xor (ad_x (xI p)) a') 0 = negb (ad_bit a' 0). -Proof. - intros. case a'. trivial. - simpl in |- *. intro. case p0; trivial. intro. - case (p_xor p p1); trivial. - intro. - case (p_xor p p1); trivial. -Qed. - -Lemma ad_xor_sem_5 : - forall a a':ad, ad_bit (ad_xor a a') 0 = adf_xor (ad_bit a) (ad_bit a') 0. -Proof. - destruct a. intro. change (ad_bit a' 0 = xorb false (ad_bit a' 0)) in |- *. rewrite false_xorb. trivial. - case p. exact ad_xor_sem_4. - intros. change (ad_bit (ad_xor (ad_x (xO p0)) a') 0 = xorb false (ad_bit a' 0)) - in |- *. - rewrite false_xorb. apply ad_xor_sem_3. exact ad_xor_sem_2. -Qed. - -Lemma ad_xor_sem_6 : - forall n:nat, - (forall a a':ad, ad_bit (ad_xor a a') n = adf_xor (ad_bit a) (ad_bit a') n) -> - forall a a':ad, - ad_bit (ad_xor a a') (S n) = adf_xor (ad_bit a) (ad_bit a') (S n). -Proof. - intros. case a. unfold adf_xor in |- *. unfold ad_bit at 2 in |- *. rewrite false_xorb. reflexivity. - case a'. unfold adf_xor in |- *. unfold ad_bit at 3 in |- *. intro. rewrite xorb_false. reflexivity. - intros. case p0. case p. intros. - change - (ad_bit (ad_xor (ad_x (xI p2)) (ad_x (xI p1))) (S n) = - adf_xor (ad_bit (ad_x p2)) (ad_bit (ad_x p1)) n) - in |- *. - rewrite <- H. simpl in |- *. - case (p_xor p2 p1); trivial. - intros. - change - (ad_bit (ad_xor (ad_x (xI p2)) (ad_x (xO p1))) (S n) = - adf_xor (ad_bit (ad_x p2)) (ad_bit (ad_x p1)) n) - in |- *. - rewrite <- H. simpl in |- *. - case (p_xor p2 p1); trivial. - intro. unfold adf_xor in |- *. unfold ad_bit at 3 in |- *. unfold ad_bit_1 in |- *. rewrite xorb_false. reflexivity. - case p. intros. - change - (ad_bit (ad_xor (ad_x (xO p2)) (ad_x (xI p1))) (S n) = - adf_xor (ad_bit (ad_x p2)) (ad_bit (ad_x p1)) n) - in |- *. - rewrite <- H. simpl in |- *. - case (p_xor p2 p1); trivial. - intros. - change - (ad_bit (ad_xor (ad_x (xO p2)) (ad_x (xO p1))) (S n) = - adf_xor (ad_bit (ad_x p2)) (ad_bit (ad_x p1)) n) - in |- *. - rewrite <- H. simpl in |- *. - case (p_xor p2 p1); trivial. - intro. unfold adf_xor in |- *. unfold ad_bit at 3 in |- *. unfold ad_bit_1 in |- *. rewrite xorb_false. reflexivity. - unfold adf_xor in |- *. unfold ad_bit at 2 in |- *. unfold ad_bit_1 in |- *. rewrite false_xorb. simpl in |- *. case p; trivial. -Qed. - -Lemma ad_xor_semantics : - forall a a':ad, eqf (ad_bit (ad_xor a a')) (adf_xor (ad_bit a) (ad_bit a')). -Proof. - unfold eqf in |- *. intros. generalize a a'. elim n. exact ad_xor_sem_5. - exact ad_xor_sem_6. -Qed. - -Lemma eqf_sym : forall f f':nat -> bool, eqf f f' -> eqf f' f. -Proof. - unfold eqf in |- *. intros. rewrite H. reflexivity. -Qed. - -Lemma eqf_refl : forall f:nat -> bool, eqf f f. -Proof. - unfold eqf in |- *. trivial. -Qed. - -Lemma eqf_trans : - forall f f' f'':nat -> bool, eqf f f' -> eqf f' f'' -> eqf f f''. -Proof. - unfold eqf in |- *. intros. rewrite H. exact (H0 n). -Qed. - -Lemma adf_xor_eq : - forall f f':nat -> bool, eqf (adf_xor f f') (fun n:nat => false) -> eqf f f'. -Proof. - unfold eqf in |- *. unfold adf_xor in |- *. intros. apply xorb_eq. apply H. -Qed. - -Lemma ad_xor_eq : forall a a':ad, ad_xor a a' = ad_z -> a = a'. -Proof. - intros. apply ad_faithful. apply adf_xor_eq. apply eqf_trans with (f' := ad_bit (ad_xor a a')). - apply eqf_sym. apply ad_xor_semantics. - rewrite H. unfold eqf in |- *. trivial. -Qed. - -Lemma adf_xor_assoc : - forall f f' f'':nat -> bool, - eqf (adf_xor (adf_xor f f') f'') (adf_xor f (adf_xor f' f'')). -Proof. - unfold eqf in |- *. unfold adf_xor in |- *. intros. apply xorb_assoc. -Qed. - -Lemma eqf_xor_1 : - forall f f' f'' f''':nat -> bool, - eqf f f' -> eqf f'' f''' -> eqf (adf_xor f f'') (adf_xor f' f'''). -Proof. - unfold eqf in |- *. intros. unfold adf_xor in |- *. rewrite H. rewrite H0. reflexivity. -Qed. - -Lemma ad_xor_assoc : - forall a a' a'':ad, ad_xor (ad_xor a a') a'' = ad_xor a (ad_xor a' a''). -Proof. - intros. apply ad_faithful. - apply eqf_trans with - (f' := adf_xor (adf_xor (ad_bit a) (ad_bit a')) (ad_bit a'')). - apply eqf_trans with (f' := adf_xor (ad_bit (ad_xor a a')) (ad_bit a'')). - apply ad_xor_semantics. - apply eqf_xor_1. apply ad_xor_semantics. - apply eqf_refl. - apply eqf_trans with - (f' := adf_xor (ad_bit a) (adf_xor (ad_bit a') (ad_bit a''))). - apply adf_xor_assoc. - apply eqf_trans with (f' := adf_xor (ad_bit a) (ad_bit (ad_xor a' a''))). - apply eqf_xor_1. apply eqf_refl. - apply eqf_sym. apply ad_xor_semantics. - apply eqf_sym. apply ad_xor_semantics. -Qed. - -Definition ad_double (a:ad) := - match a with - | ad_z => ad_z - | ad_x p => ad_x (xO p) - end. - -Definition ad_double_plus_un (a:ad) := - match a with - | ad_z => ad_x 1 - | ad_x p => ad_x (xI p) - end. - -Definition ad_div_2 (a:ad) := - match a with - | ad_z => ad_z - | ad_x xH => ad_z - | ad_x (xO p) => ad_x p - | ad_x (xI p) => ad_x p - end. - -Lemma ad_double_div_2 : forall a:ad, ad_div_2 (ad_double a) = a. -Proof. - destruct a; trivial. -Qed. - -Lemma ad_double_plus_un_div_2 : - forall a:ad, ad_div_2 (ad_double_plus_un a) = a. -Proof. - destruct a; trivial. -Qed. - -Lemma ad_double_inj : forall a0 a1:ad, ad_double a0 = ad_double a1 -> a0 = a1. -Proof. - intros. rewrite <- (ad_double_div_2 a0). rewrite H. apply ad_double_div_2. -Qed. - -Lemma ad_double_plus_un_inj : - forall a0 a1:ad, ad_double_plus_un a0 = ad_double_plus_un a1 -> a0 = a1. -Proof. - intros. rewrite <- (ad_double_plus_un_div_2 a0). rewrite H. apply ad_double_plus_un_div_2. -Qed. - -Definition ad_bit_0 (a:ad) := - match a with - | ad_z => false - | ad_x (xO _) => false - | _ => true - end. - -Lemma ad_double_bit_0 : forall a:ad, ad_bit_0 (ad_double a) = false. -Proof. - destruct a; trivial. -Qed. - -Lemma ad_double_plus_un_bit_0 : - forall a:ad, ad_bit_0 (ad_double_plus_un a) = true. -Proof. - destruct a; trivial. -Qed. - -Lemma ad_div_2_double : - forall a:ad, ad_bit_0 a = false -> ad_double (ad_div_2 a) = a. -Proof. - destruct a. trivial. destruct p. intro H. discriminate H. - intros. reflexivity. - intro H. discriminate H. -Qed. - -Lemma ad_div_2_double_plus_un : - forall a:ad, ad_bit_0 a = true -> ad_double_plus_un (ad_div_2 a) = a. -Proof. - destruct a. intro. discriminate H. - destruct p. intros. reflexivity. - intro H. discriminate H. - intro. reflexivity. -Qed. - -Lemma ad_bit_0_correct : forall a:ad, ad_bit a 0 = ad_bit_0 a. -Proof. - destruct a; trivial. - destruct p; trivial. -Qed. - -Lemma ad_div_2_correct : - forall (a:ad) (n:nat), ad_bit (ad_div_2 a) n = ad_bit a (S n). -Proof. - destruct a; trivial. - destruct p; trivial. -Qed. - -Lemma ad_xor_bit_0 : - forall a a':ad, ad_bit_0 (ad_xor a a') = xorb (ad_bit_0 a) (ad_bit_0 a'). -Proof. - intros. rewrite <- ad_bit_0_correct. rewrite (ad_xor_semantics a a' 0). - unfold adf_xor in |- *. rewrite ad_bit_0_correct. rewrite ad_bit_0_correct. reflexivity. -Qed. - -Lemma ad_xor_div_2 : - forall a a':ad, ad_div_2 (ad_xor a a') = ad_xor (ad_div_2 a) (ad_div_2 a'). -Proof. - intros. apply ad_faithful. unfold eqf in |- *. intro. - rewrite (ad_xor_semantics (ad_div_2 a) (ad_div_2 a') n). - rewrite ad_div_2_correct. - rewrite (ad_xor_semantics a a' (S n)). - unfold adf_xor in |- *. rewrite ad_div_2_correct. rewrite ad_div_2_correct. - reflexivity. -Qed. - -Lemma ad_neg_bit_0 : - forall a a':ad, - ad_bit_0 (ad_xor a a') = true -> ad_bit_0 a = negb (ad_bit_0 a'). -Proof. - intros. rewrite <- true_xorb. rewrite <- H. rewrite ad_xor_bit_0. - rewrite xorb_assoc. rewrite xorb_nilpotent. rewrite xorb_false. reflexivity. -Qed. - -Lemma ad_neg_bit_0_1 : - forall a a':ad, ad_xor a a' = ad_x 1 -> ad_bit_0 a = negb (ad_bit_0 a'). -Proof. - intros. apply ad_neg_bit_0. rewrite H. reflexivity. -Qed. - -Lemma ad_neg_bit_0_2 : - forall (a a':ad) (p:positive), - ad_xor a a' = ad_x (xI p) -> ad_bit_0 a = negb (ad_bit_0 a'). -Proof. - intros. apply ad_neg_bit_0. rewrite H. reflexivity. -Qed. - -Lemma ad_same_bit_0 : - forall (a a':ad) (p:positive), - ad_xor a a' = ad_x (xO p) -> ad_bit_0 a = ad_bit_0 a'. -Proof. - intros. rewrite <- (xorb_false (ad_bit_0 a)). cut (ad_bit_0 (ad_x (xO p)) = false). - intro. rewrite <- H0. rewrite <- H. rewrite ad_xor_bit_0. rewrite <- xorb_assoc. - rewrite xorb_nilpotent. rewrite false_xorb. reflexivity. - reflexivity. -Qed.
\ No newline at end of file diff --git a/theories/IntMap/Allmaps.v b/theories/IntMap/Allmaps.v index f9a0feac..d5af8f80 100644 --- a/theories/IntMap/Allmaps.v +++ b/theories/IntMap/Allmaps.v @@ -5,17 +5,12 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Allmaps.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: Allmaps.v 8733 2006-04-25 22:52:18Z letouzey $ i*) -Require Export Addr. -Require Export Adist. -Require Export Addec. Require Export Map. - Require Export Fset. Require Export Mapaxioms. Require Export Mapiter. - Require Export Mapsubset. Require Export Lsort. Require Export Mapfold. diff --git a/theories/IntMap/Fset.v b/theories/IntMap/Fset.v index 27f739c1..5b46c969 100644 --- a/theories/IntMap/Fset.v +++ b/theories/IntMap/Fset.v @@ -5,16 +5,15 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Fset.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: Fset.v 8733 2006-04-25 22:52:18Z letouzey $ i*) (*s Sets operations on maps *) Require Import Bool. Require Import Sumbool. -Require Import ZArith. -Require Import Addr. -Require Import Adist. -Require Import Addec. +Require Import NArith. +Require Import Ndigits. +Require Import Ndec. Require Import Map. Section Dom. @@ -26,7 +25,7 @@ Section Dom. | M0 => fun _:Map B => M0 A | M1 a y => fun m':Map B => match MapGet B m' a with - | NONE => M0 A + | None => M0 A | _ => m end | M2 m1 m2 => @@ -35,8 +34,8 @@ Section Dom. | M0 => M0 A | M1 a' y' => match MapGet A m a' with - | NONE => M0 A - | SOME y => M1 A a' y + | None => M0 A + | Some y => M1 A a' y end | M2 m'1 m'2 => makeM2 A (MapDomRestrTo m1 m'1) (MapDomRestrTo m2 m'2) @@ -48,35 +47,35 @@ Section Dom. eqm A (MapGet A (MapDomRestrTo m m')) (fun a0:ad => match MapGet B m' a0 with - | NONE => NONE A + | None => None | _ => MapGet A m a0 end). Proof. unfold eqm in |- *. simple induction m. simpl in |- *. intros. case (MapGet B m' a); trivial. - intros. simpl in |- *. elim (sumbool_of_bool (ad_eq a a1)). intro H. rewrite H. - rewrite <- (ad_eq_complete _ _ H). case (MapGet B m' a). reflexivity. + intros. simpl in |- *. elim (sumbool_of_bool (Neqb a a1)). intro H. rewrite H. + rewrite <- (Neqb_complete _ _ H). case (MapGet B m' a); try reflexivity. intro. apply M1_semantics_1. intro H. rewrite H. case (MapGet B m' a). - case (MapGet B m' a1); reflexivity. case (MapGet B m' a1); intros; exact (M1_semantics_2 A a a1 a0 H). + case (MapGet B m' a1); reflexivity. simple induction m'. trivial. - unfold MapDomRestrTo in |- *. intros. elim (sumbool_of_bool (ad_eq a a1)). + unfold MapDomRestrTo in |- *. intros. elim (sumbool_of_bool (Neqb a a1)). intro H1. - rewrite (ad_eq_complete _ _ H1). rewrite (M1_semantics_1 B a1 a0). - case (MapGet A (M2 A m0 m1) a1). reflexivity. + rewrite (Neqb_complete _ _ H1). rewrite (M1_semantics_1 B a1 a0). + case (MapGet A (M2 A m0 m1) a1); try reflexivity. intro. apply M1_semantics_1. - intro H1. rewrite (M1_semantics_2 B a a1 a0 H1). case (MapGet A (M2 A m0 m1) a). reflexivity. + intro H1. rewrite (M1_semantics_2 B a a1 a0 H1). case (MapGet A (M2 A m0 m1) a); try reflexivity. intro. exact (M1_semantics_2 A a a1 a2 H1). intros. change (MapGet A (makeM2 A (MapDomRestrTo m0 m2) (MapDomRestrTo m1 m3)) a = match MapGet B (M2 B m2 m3) a with - | NONE => NONE A - | SOME _ => MapGet A (M2 A m0 m1) a + | None => None + | Some _ => MapGet A (M2 A m0 m1) a end) in |- *. rewrite (makeM2_M2 A (MapDomRestrTo m0 m2) (MapDomRestrTo m1 m3) a). - rewrite MapGet_M2_bit_0_if. rewrite (H0 m3 (ad_div_2 a)). rewrite (H m2 (ad_div_2 a)). + rewrite MapGet_M2_bit_0_if. rewrite (H0 m3 (Ndiv2 a)). rewrite (H m2 (Ndiv2 a)). rewrite (MapGet_M2_bit_0_if B m2 m3 a). rewrite (MapGet_M2_bit_0_if A m0 m1 a). - case (ad_bit_0 a); reflexivity. + case (Nbit0 a); reflexivity. Qed. Fixpoint MapDomRestrBy (m:Map A) : Map B -> Map A := @@ -84,7 +83,7 @@ Section Dom. | M0 => fun _:Map B => M0 A | M1 a y => fun m':Map B => match MapGet B m' a with - | NONE => m + | None => m | _ => M0 A end | M2 m1 m2 => @@ -102,37 +101,38 @@ Section Dom. eqm A (MapGet A (MapDomRestrBy m m')) (fun a0:ad => match MapGet B m' a0 with - | NONE => MapGet A m a0 - | _ => NONE A + | None => MapGet A m a0 + | _ => None end). Proof. unfold eqm in |- *. simple induction m. simpl in |- *. intros. case (MapGet B m' a); trivial. - intros. simpl in |- *. elim (sumbool_of_bool (ad_eq a a1)). intro H. rewrite H. - rewrite (ad_eq_complete _ _ H). case (MapGet B m' a1). apply M1_semantics_1. - trivial. - intro H. rewrite H. case (MapGet B m' a). rewrite (M1_semantics_2 A a a1 a0 H). + intros. simpl in |- *. elim (sumbool_of_bool (Neqb a a1)). intro H. rewrite H. + rewrite (Neqb_complete _ _ H). case (MapGet B m' a1). trivial. + apply M1_semantics_1. + intro H. rewrite H. case (MapGet B m' a). case (MapGet B m' a1); trivial. + rewrite (M1_semantics_2 A a a1 a0 H). case (MapGet B m' a1); trivial. simple induction m'. trivial. unfold MapDomRestrBy in |- *. intros. rewrite (MapRemove_semantics A (M2 A m0 m1) a a1). - elim (sumbool_of_bool (ad_eq a a1)). intro H1. rewrite H1. rewrite (ad_eq_complete _ _ H1). + elim (sumbool_of_bool (Neqb a a1)). intro H1. rewrite H1. rewrite (Neqb_complete _ _ H1). rewrite (M1_semantics_1 B a1 a0). reflexivity. intro H1. rewrite H1. rewrite (M1_semantics_2 B a a1 a0 H1). reflexivity. intros. change (MapGet A (makeM2 A (MapDomRestrBy m0 m2) (MapDomRestrBy m1 m3)) a = match MapGet B (M2 B m2 m3) a with - | NONE => MapGet A (M2 A m0 m1) a - | SOME _ => NONE A + | None => MapGet A (M2 A m0 m1) a + | Some _ => None end) in |- *. rewrite (makeM2_M2 A (MapDomRestrBy m0 m2) (MapDomRestrBy m1 m3) a). - rewrite MapGet_M2_bit_0_if. rewrite (H0 m3 (ad_div_2 a)). rewrite (H m2 (ad_div_2 a)). + rewrite MapGet_M2_bit_0_if. rewrite (H0 m3 (Ndiv2 a)). rewrite (H m2 (Ndiv2 a)). rewrite (MapGet_M2_bit_0_if B m2 m3 a). rewrite (MapGet_M2_bit_0_if A m0 m1 a). - case (ad_bit_0 a); reflexivity. + case (Nbit0 a); reflexivity. Qed. Definition in_dom (a:ad) (m:Map A) := match MapGet A m a with - | NONE => false + | None => false | _ => true end. @@ -141,32 +141,32 @@ Section Dom. trivial. Qed. - Lemma in_dom_M1 : forall (a a0:ad) (y:A), in_dom a0 (M1 A a y) = ad_eq a a0. + Lemma in_dom_M1 : forall (a a0:ad) (y:A), in_dom a0 (M1 A a y) = Neqb a a0. Proof. - unfold in_dom in |- *. intros. simpl in |- *. case (ad_eq a a0); reflexivity. + unfold in_dom in |- *. intros. simpl in |- *. case (Neqb a a0); reflexivity. Qed. Lemma in_dom_M1_1 : forall (a:ad) (y:A), in_dom a (M1 A a y) = true. Proof. - intros. rewrite in_dom_M1. apply ad_eq_correct. + intros. rewrite in_dom_M1. apply Neqb_correct. Qed. Lemma in_dom_M1_2 : forall (a a0:ad) (y:A), in_dom a0 (M1 A a y) = true -> a = a0. Proof. - intros. apply (ad_eq_complete a a0). rewrite (in_dom_M1 a a0 y) in H. assumption. + intros. apply (Neqb_complete a a0). rewrite (in_dom_M1 a a0 y) in H. assumption. Qed. Lemma in_dom_some : forall (m:Map A) (a:ad), - in_dom a m = true -> {y : A | MapGet A m a = SOME A y}. + in_dom a m = true -> {y : A | MapGet A m a = Some y}. Proof. unfold in_dom in |- *. intros. elim (option_sum _ (MapGet A m a)). trivial. intro H0. rewrite H0 in H. discriminate H. Qed. Lemma in_dom_none : - forall (m:Map A) (a:ad), in_dom a m = false -> MapGet A m a = NONE A. + forall (m:Map A) (a:ad), in_dom a m = false -> MapGet A m a = None. Proof. unfold in_dom in |- *. intros. elim (option_sum _ (MapGet A m a)). intro H0. elim H0. intros y H1. rewrite H1 in H. discriminate H. @@ -175,33 +175,33 @@ Section Dom. Lemma in_dom_put : forall (m:Map A) (a0:ad) (y0:A) (a:ad), - in_dom a (MapPut A m a0 y0) = orb (ad_eq a a0) (in_dom a m). + in_dom a (MapPut A m a0 y0) = orb (Neqb a a0) (in_dom a m). Proof. unfold in_dom in |- *. intros. rewrite (MapPut_semantics A m a0 y0 a). - elim (sumbool_of_bool (ad_eq a a0)). intro H. rewrite H. rewrite (ad_eq_comm a a0) in H. + elim (sumbool_of_bool (Neqb a a0)). intro H. rewrite H. rewrite (Neqb_comm a a0) in H. rewrite H. rewrite orb_true_b. reflexivity. - intro H. rewrite H. rewrite (ad_eq_comm a a0) in H. rewrite H. rewrite orb_false_b. + intro H. rewrite H. rewrite (Neqb_comm a a0) in H. rewrite H. rewrite orb_false_b. reflexivity. Qed. Lemma in_dom_put_behind : forall (m:Map A) (a0:ad) (y0:A) (a:ad), - in_dom a (MapPut_behind A m a0 y0) = orb (ad_eq a a0) (in_dom a m). + in_dom a (MapPut_behind A m a0 y0) = orb (Neqb a a0) (in_dom a m). Proof. unfold in_dom in |- *. intros. rewrite (MapPut_behind_semantics A m a0 y0 a). - elim (sumbool_of_bool (ad_eq a a0)). intro H. rewrite H. rewrite (ad_eq_comm a a0) in H. + elim (sumbool_of_bool (Neqb a a0)). intro H. rewrite H. rewrite (Neqb_comm a a0) in H. rewrite H. case (MapGet A m a); reflexivity. - intro H. rewrite H. rewrite (ad_eq_comm a a0) in H. rewrite H. case (MapGet A m a); trivial. + intro H. rewrite H. rewrite (Neqb_comm a a0) in H. rewrite H. case (MapGet A m a); trivial. Qed. Lemma in_dom_remove : forall (m:Map A) (a0 a:ad), - in_dom a (MapRemove A m a0) = andb (negb (ad_eq a a0)) (in_dom a m). + in_dom a (MapRemove A m a0) = andb (negb (Neqb a a0)) (in_dom a m). Proof. unfold in_dom in |- *. intros. rewrite (MapRemove_semantics A m a0 a). - elim (sumbool_of_bool (ad_eq a a0)). intro H. rewrite H. rewrite (ad_eq_comm a a0) in H. + elim (sumbool_of_bool (Neqb a a0)). intro H. rewrite H. rewrite (Neqb_comm a a0) in H. rewrite H. reflexivity. - intro H. rewrite H. rewrite (ad_eq_comm a a0) in H. rewrite H. + intro H. rewrite H. rewrite (Neqb_comm a a0) in H. rewrite H. case (MapGet A m a); reflexivity. Qed. @@ -272,35 +272,35 @@ Section FSetDefs. Lemma MapDom_semantics_1 : forall (m:Map A) (a:ad) (y:A), - MapGet A m a = SOME A y -> in_FSet a (MapDom m) = true. + MapGet A m a = Some y -> in_FSet a (MapDom m) = true. Proof. simple induction m. intros. discriminate H. unfold MapDom in |- *. unfold in_FSet in |- *. unfold in_dom in |- *. unfold MapGet in |- *. intros a y a0 y0. - case (ad_eq a a0). trivial. + case (Neqb a a0). trivial. intro. discriminate H. intros m0 H m1 H0 a y. rewrite (MapGet_M2_bit_0_if A m0 m1 a). simpl in |- *. unfold in_FSet in |- *. unfold in_dom in |- *. rewrite (MapGet_M2_bit_0_if unit (MapDom m0) (MapDom m1) a). - case (ad_bit_0 a). unfold in_FSet, in_dom in H0. intro. apply H0 with (y := y). assumption. + case (Nbit0 a). unfold in_FSet, in_dom in H0. intro. apply H0 with (y := y). assumption. unfold in_FSet, in_dom in H. intro. apply H with (y := y). assumption. Qed. Lemma MapDom_semantics_2 : forall (m:Map A) (a:ad), - in_FSet a (MapDom m) = true -> {y : A | MapGet A m a = SOME A y}. + in_FSet a (MapDom m) = true -> {y : A | MapGet A m a = Some y}. Proof. simple induction m. intros. discriminate H. - unfold MapDom in |- *. unfold in_FSet in |- *. unfold in_dom in |- *. unfold MapGet in |- *. intros a y a0. case (ad_eq a a0). + unfold MapDom in |- *. unfold in_FSet in |- *. unfold in_dom in |- *. unfold MapGet in |- *. intros a y a0. case (Neqb a a0). intro. split with y. reflexivity. intro. discriminate H. intros m0 H m1 H0 a. rewrite (MapGet_M2_bit_0_if A m0 m1 a). simpl in |- *. unfold in_FSet in |- *. unfold in_dom in |- *. rewrite (MapGet_M2_bit_0_if unit (MapDom m0) (MapDom m1) a). - case (ad_bit_0 a). unfold in_FSet, in_dom in H0. intro. apply H0. assumption. + case (Nbit0 a). unfold in_FSet, in_dom in H0. intro. apply H0. assumption. unfold in_FSet, in_dom in H. intro. apply H. assumption. Qed. Lemma MapDom_semantics_3 : forall (m:Map A) (a:ad), - MapGet A m a = NONE A -> in_FSet a (MapDom m) = false. + MapGet A m a = None -> in_FSet a (MapDom m) = false. Proof. intros. elim (sumbool_of_bool (in_FSet a (MapDom m))). intro H0. elim (MapDom_semantics_2 m a H0). intros y H1. rewrite H in H1. discriminate H1. @@ -309,7 +309,7 @@ Section FSetDefs. Lemma MapDom_semantics_4 : forall (m:Map A) (a:ad), - in_FSet a (MapDom m) = false -> MapGet A m a = NONE A. + in_FSet a (MapDom m) = false -> MapGet A m a = None. Proof. intros. elim (option_sum A (MapGet A m a)). intro H0. elim H0. intros y H1. rewrite (MapDom_semantics_1 m a y H1) in H. discriminate H. diff --git a/theories/IntMap/Lsort.v b/theories/IntMap/Lsort.v index d31d8133..c8d793a1 100644 --- a/theories/IntMap/Lsort.v +++ b/theories/IntMap/Lsort.v @@ -5,15 +5,14 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Lsort.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: Lsort.v 8733 2006-04-25 22:52:18Z letouzey $ i*) Require Import Bool. Require Import Sumbool. Require Import Arith. -Require Import ZArith. -Require Import Addr. -Require Import Adist. -Require Import Addec. +Require Import NArith. +Require Import Ndigits. +Require Import Ndec. Require Import Map. Require Import List. Require Import Mapiter. @@ -22,199 +21,19 @@ Section LSort. Variable A : Set. - Fixpoint ad_less_1 (a a':ad) (p:positive) {struct p} : bool := - match p with - | xO p' => ad_less_1 (ad_div_2 a) (ad_div_2 a') p' - | _ => andb (negb (ad_bit_0 a)) (ad_bit_0 a') - end. - - Definition ad_less (a a':ad) := - match ad_xor a a' with - | ad_z => false - | ad_x p => ad_less_1 a a' p - end. - - Lemma ad_bit_0_less : - forall a a':ad, - ad_bit_0 a = false -> ad_bit_0 a' = true -> ad_less a a' = true. - Proof. - intros. elim (ad_sum (ad_xor a a')). intro H1. elim H1. intros p H2. unfold ad_less in |- *. - rewrite H2. generalize H2. elim p. intros. simpl in |- *. rewrite H. rewrite H0. reflexivity. - intros. cut (ad_bit_0 (ad_xor a a') = false). intro. rewrite (ad_xor_bit_0 a a') in H5. - rewrite H in H5. rewrite H0 in H5. discriminate H5. - rewrite H4. reflexivity. - intro. simpl in |- *. rewrite H. rewrite H0. reflexivity. - intro H1. cut (ad_bit_0 (ad_xor a a') = false). intro. rewrite (ad_xor_bit_0 a a') in H2. - rewrite H in H2. rewrite H0 in H2. discriminate H2. - rewrite H1. reflexivity. - Qed. - - Lemma ad_bit_0_gt : - forall a a':ad, - ad_bit_0 a = true -> ad_bit_0 a' = false -> ad_less a a' = false. - Proof. - intros. elim (ad_sum (ad_xor a a')). intro H1. elim H1. intros p H2. unfold ad_less in |- *. - rewrite H2. generalize H2. elim p. intros. simpl in |- *. rewrite H. rewrite H0. reflexivity. - intros. cut (ad_bit_0 (ad_xor a a') = false). intro. rewrite (ad_xor_bit_0 a a') in H5. - rewrite H in H5. rewrite H0 in H5. discriminate H5. - rewrite H4. reflexivity. - intro. simpl in |- *. rewrite H. rewrite H0. reflexivity. - intro H1. unfold ad_less in |- *. rewrite H1. reflexivity. - Qed. - - Lemma ad_less_not_refl : forall a:ad, ad_less a a = false. - Proof. - intro. unfold ad_less in |- *. rewrite (ad_xor_nilpotent a). reflexivity. - Qed. - - Lemma ad_ind_double : - forall (a:ad) (P:ad -> Prop), - P ad_z -> - (forall a:ad, P a -> P (ad_double a)) -> - (forall a:ad, P a -> P (ad_double_plus_un a)) -> P a. - Proof. - intros; elim a. trivial. - simple induction p. intros. - apply (H1 (ad_x p0)); trivial. - intros; apply (H0 (ad_x p0)); trivial. - intros; apply (H1 ad_z); assumption. - Qed. - - Lemma ad_rec_double : - forall (a:ad) (P:ad -> Set), - P ad_z -> - (forall a:ad, P a -> P (ad_double a)) -> - (forall a:ad, P a -> P (ad_double_plus_un a)) -> P a. - Proof. - intros; elim a. trivial. - simple induction p. intros. - apply (H1 (ad_x p0)); trivial. - intros; apply (H0 (ad_x p0)); trivial. - intros; apply (H1 ad_z); assumption. - Qed. - - Lemma ad_less_def_1 : - forall a a':ad, ad_less (ad_double a) (ad_double a') = ad_less a a'. - Proof. - simple induction a. simple induction a'. reflexivity. - trivial. - simple induction a'. unfold ad_less in |- *. simpl in |- *. elim p; trivial. - unfold ad_less in |- *. simpl in |- *. intro. case (p_xor p p0). reflexivity. - trivial. - Qed. - - Lemma ad_less_def_2 : - forall a a':ad, - ad_less (ad_double_plus_un a) (ad_double_plus_un a') = ad_less a a'. - Proof. - simple induction a. simple induction a'. reflexivity. - trivial. - simple induction a'. unfold ad_less in |- *. simpl in |- *. elim p; trivial. - unfold ad_less in |- *. simpl in |- *. intro. case (p_xor p p0). reflexivity. - trivial. - Qed. - - Lemma ad_less_def_3 : - forall a a':ad, ad_less (ad_double a) (ad_double_plus_un a') = true. - Proof. - intros. apply ad_bit_0_less. apply ad_double_bit_0. - apply ad_double_plus_un_bit_0. - Qed. - - Lemma ad_less_def_4 : - forall a a':ad, ad_less (ad_double_plus_un a) (ad_double a') = false. - Proof. - intros. apply ad_bit_0_gt. apply ad_double_plus_un_bit_0. - apply ad_double_bit_0. - Qed. - - Lemma ad_less_z : forall a:ad, ad_less a ad_z = false. - Proof. - simple induction a. reflexivity. - unfold ad_less in |- *. intro. rewrite (ad_xor_neutral_right (ad_x p)). elim p; trivial. - Qed. - - Lemma ad_z_less_1 : - forall a:ad, ad_less ad_z a = true -> {p : positive | a = ad_x p}. - Proof. - simple induction a. intro. discriminate H. - intros. split with p. reflexivity. - Qed. - - Lemma ad_z_less_2 : forall a:ad, ad_less ad_z a = false -> a = ad_z. - Proof. - simple induction a. trivial. - unfold ad_less in |- *. simpl in |- *. cut (forall p:positive, ad_less_1 ad_z (ad_x p) p = false -> False). - intros. elim (H p H0). - simple induction p. intros. discriminate H0. - intros. exact (H H0). - intro. discriminate H. - Qed. - - Lemma ad_less_trans : - forall a a' a'':ad, - ad_less a a' = true -> ad_less a' a'' = true -> ad_less a a'' = true. - Proof. - intro a. apply ad_ind_double with - (P := fun a:ad => - forall a' a'':ad, - ad_less a a' = true -> - ad_less a' a'' = true -> ad_less a a'' = true). - intros. elim (sumbool_of_bool (ad_less ad_z a'')). trivial. - intro H1. rewrite (ad_z_less_2 a'' H1) in H0. rewrite (ad_less_z a') in H0. discriminate H0. - intros a0 H a'. apply ad_ind_double with - (P := fun a':ad => - forall a'':ad, - ad_less (ad_double a0) a' = true -> - ad_less a' a'' = true -> ad_less (ad_double a0) a'' = true). - intros. rewrite (ad_less_z (ad_double a0)) in H0. discriminate H0. - intros a1 H0 a'' H1. rewrite (ad_less_def_1 a0 a1) in H1. - apply ad_ind_double with - (P := fun a'':ad => - ad_less (ad_double a1) a'' = true -> - ad_less (ad_double a0) a'' = true). - intro. rewrite (ad_less_z (ad_double a1)) in H2. discriminate H2. - intros. rewrite (ad_less_def_1 a1 a2) in H3. rewrite (ad_less_def_1 a0 a2). - exact (H a1 a2 H1 H3). - intros. apply ad_less_def_3. - intros a1 H0 a'' H1. apply ad_ind_double with - (P := fun a'':ad => - ad_less (ad_double_plus_un a1) a'' = true -> - ad_less (ad_double a0) a'' = true). - intro. rewrite (ad_less_z (ad_double_plus_un a1)) in H2. discriminate H2. - intros. rewrite (ad_less_def_4 a1 a2) in H3. discriminate H3. - intros. apply ad_less_def_3. - intros a0 H a'. apply ad_ind_double with - (P := fun a':ad => - forall a'':ad, - ad_less (ad_double_plus_un a0) a' = true -> - ad_less a' a'' = true -> - ad_less (ad_double_plus_un a0) a'' = true). - intros. rewrite (ad_less_z (ad_double_plus_un a0)) in H0. discriminate H0. - intros. rewrite (ad_less_def_4 a0 a1) in H1. discriminate H1. - intros a1 H0 a'' H1. apply ad_ind_double with - (P := fun a'':ad => - ad_less (ad_double_plus_un a1) a'' = true -> - ad_less (ad_double_plus_un a0) a'' = true). - intro. rewrite (ad_less_z (ad_double_plus_un a1)) in H2. discriminate H2. - intros. rewrite (ad_less_def_4 a1 a2) in H3. discriminate H3. - rewrite (ad_less_def_2 a0 a1) in H1. intros. rewrite (ad_less_def_2 a1 a2) in H3. - rewrite (ad_less_def_2 a0 a2). exact (H a1 a2 H1 H3). - Qed. - Fixpoint alist_sorted (l:alist A) : bool := match l with | nil => true | (a, _) :: l' => match l' with | nil => true - | (a', y') :: l'' => andb (ad_less a a') (alist_sorted l') + | (a', y') :: l'' => andb (Nless a a') (alist_sorted l') end end. Fixpoint alist_nth_ad (n:nat) (l:alist A) {struct l} : ad := match l with - | nil => ad_z (* dummy *) + | nil => N0 (* dummy *) | (a, y) :: l' => match n with | O => a | S n' => alist_nth_ad n' l' @@ -224,7 +43,7 @@ Section LSort. Definition alist_sorted_1 (l:alist A) := forall n:nat, S (S n) <= length l -> - ad_less (alist_nth_ad n l) (alist_nth_ad (S n) l) = true. + Nless (alist_nth_ad n l) (alist_nth_ad (S n) l) = true. Lemma alist_sorted_imp_1 : forall l:alist A, alist_sorted l = true -> alist_sorted_1 l. @@ -235,7 +54,7 @@ Section LSort. intro r0. elim r0. intros a0 y0. simple induction n. intros. simpl in |- *. simpl in H1. exact (proj1 (andb_prop _ _ H1)). intros. change - (ad_less (alist_nth_ad n0 ((a0, y0) :: l1)) + (Nless (alist_nth_ad n0 ((a0, y0) :: l1)) (alist_nth_ad (S n0) ((a0, y0) :: l1)) = true) in |- *. apply H0. exact (proj2 (andb_prop _ _ H1)). @@ -245,13 +64,13 @@ Section LSort. Definition alist_sorted_2 (l:alist A) := forall m n:nat, m < n -> - S n <= length l -> ad_less (alist_nth_ad m l) (alist_nth_ad n l) = true. + S n <= length l -> Nless (alist_nth_ad m l) (alist_nth_ad n l) = true. Lemma alist_sorted_1_imp_2 : forall l:alist A, alist_sorted_1 l -> alist_sorted_2 l. Proof. unfold alist_sorted_1, alist_sorted_2, lt in |- *. intros l H m n H0. elim H0. exact (H m). - intros. apply ad_less_trans with (a' := alist_nth_ad m0 l). apply H2. apply le_Sn_le. + intros. apply Nless_trans with (a' := alist_nth_ad m0 l). apply H2. apply le_Sn_le. assumption. apply H. assumption. Qed. @@ -262,7 +81,7 @@ Section LSort. unfold alist_sorted_2, lt in |- *. simple induction l. trivial. intro r. elim r. intros a y. simple induction l0. trivial. intro r0. elim r0. intros a0 y0. intros. - change (andb (ad_less a a0) (alist_sorted ((a0, y0) :: l1)) = true) + change (andb (Nless a a0) (alist_sorted ((a0, y0) :: l1)) = true) in |- *. apply andb_true_intro. split. apply (H1 0 1). apply le_n. simpl in |- *. apply le_n_S. apply le_n_S. apply le_O_n. @@ -319,7 +138,7 @@ Section LSort. (forall n n':nat, S n <= length l -> S n' <= length l' -> - ad_less (alist_nth_ad n l) (alist_nth_ad n' l') = true) -> + Nless (alist_nth_ad n l) (alist_nth_ad n' l') = true) -> alist_sorted_2 (aapp A l l'). Proof. unfold alist_sorted_2, lt in |- *. intros. rewrite (aapp_length l l') in H3. @@ -348,14 +167,14 @@ Section LSort. Lemma alist_nth_ad_semantics : forall (l:alist A) (n:nat), S n <= length l -> - {y : A | alist_semantics A l (alist_nth_ad n l) = SOME A y}. + {y : A | alist_semantics A l (alist_nth_ad n l) = Some y}. Proof. simple induction l. intros. elim (le_Sn_O _ H). intro r. elim r. intros a y l0 H. simple induction n. simpl in |- *. intro. split with y. - rewrite (ad_eq_correct a). reflexivity. + rewrite (Neqb_correct a). reflexivity. intros. elim (H _ (le_S_n _ _ H1)). intros y0 H2. - elim (sumbool_of_bool (ad_eq a (alist_nth_ad n0 l0))). intro H3. split with y. - rewrite (ad_eq_complete _ _ H3). simpl in |- *. rewrite (ad_eq_correct (alist_nth_ad n0 l0)). + elim (sumbool_of_bool (Neqb a (alist_nth_ad n0 l0))). intro H3. split with y. + rewrite (Neqb_complete _ _ H3). simpl in |- *. rewrite (Neqb_correct (alist_nth_ad n0 l0)). reflexivity. intro H3. split with y0. simpl in |- *. rewrite H3. assumption. Qed. @@ -373,16 +192,16 @@ Section LSort. Qed. Definition ad_monotonic (pf:ad -> ad) := - forall a a':ad, ad_less a a' = true -> ad_less (pf a) (pf a') = true. + forall a a':ad, Nless a a' = true -> Nless (pf a) (pf a') = true. - Lemma ad_double_monotonic : ad_monotonic ad_double. + Lemma Ndouble_monotonic : ad_monotonic Ndouble. Proof. - unfold ad_monotonic in |- *. intros. rewrite ad_less_def_1. assumption. + unfold ad_monotonic in |- *. intros. rewrite Nless_def_1. assumption. Qed. - Lemma ad_double_plus_un_monotonic : ad_monotonic ad_double_plus_un. + Lemma Ndouble_plus_one_monotonic : ad_monotonic Ndouble_plus_one. Proof. - unfold ad_monotonic in |- *. intros. rewrite ad_less_def_2. assumption. + unfold ad_monotonic in |- *. intros. rewrite Nless_def_2. assumption. Qed. Lemma ad_comp_monotonic : @@ -395,18 +214,18 @@ Section LSort. Lemma ad_comp_double_monotonic : forall pf:ad -> ad, - ad_monotonic pf -> ad_monotonic (fun a0:ad => pf (ad_double a0)). + ad_monotonic pf -> ad_monotonic (fun a0:ad => pf (Ndouble a0)). Proof. intros. apply ad_comp_monotonic. assumption. - exact ad_double_monotonic. + exact Ndouble_monotonic. Qed. Lemma ad_comp_double_plus_un_monotonic : forall pf:ad -> ad, - ad_monotonic pf -> ad_monotonic (fun a0:ad => pf (ad_double_plus_un a0)). + ad_monotonic pf -> ad_monotonic (fun a0:ad => pf (Ndouble_plus_one a0)). Proof. intros. apply ad_comp_monotonic. assumption. - exact ad_double_plus_un_monotonic. + exact Ndouble_plus_one_monotonic. Qed. Lemma alist_of_Map_sorts_1 : @@ -420,22 +239,22 @@ Section LSort. intros. simpl in |- *. apply alist_sorted_1_imp_2. apply alist_sorted_imp_1. reflexivity. intros. simpl in |- *. apply alist_conc_sorted. exact - (H (fun a0:ad => pf (ad_double a0)) (ad_comp_double_monotonic pf H1)). + (H (fun a0:ad => pf (Ndouble a0)) (ad_comp_double_monotonic pf H1)). exact - (H0 (fun a0:ad => pf (ad_double_plus_un a0)) + (H0 (fun a0:ad => pf (Ndouble_plus_one a0)) (ad_comp_double_plus_un_monotonic pf H1)). intros. elim - (alist_of_Map_nth_ad m0 (fun a0:ad => pf (ad_double a0)) + (alist_of_Map_nth_ad m0 (fun a0:ad => pf (Ndouble a0)) (MapFold1 A (alist A) (anil A) (aapp A) (fun (a0:ad) (y:A) => acons A (a0, y) (anil A)) - (fun a0:ad => pf (ad_double a0)) m0) (refl_equal _) n H2). + (fun a0:ad => pf (Ndouble a0)) m0) (refl_equal _) n H2). intros a H4. rewrite H4. elim - (alist_of_Map_nth_ad m1 (fun a0:ad => pf (ad_double_plus_un a0)) + (alist_of_Map_nth_ad m1 (fun a0:ad => pf (Ndouble_plus_one a0)) (MapFold1 A (alist A) (anil A) (aapp A) (fun (a0:ad) (y:A) => acons A (a0, y) (anil A)) - (fun a0:ad => pf (ad_double_plus_un a0)) m1) ( + (fun a0:ad => pf (Ndouble_plus_one a0)) m1) ( refl_equal _) n' H3). - intros a' H5. rewrite H5. unfold ad_monotonic in H1. apply H1. apply ad_less_def_3. + intros a' H5. rewrite H5. unfold ad_monotonic in H1. apply H1. apply Nless_def_3. Qed. Lemma alist_of_Map_sorts : @@ -444,7 +263,7 @@ Section LSort. intro. apply alist_sorted_2_imp. exact (alist_of_Map_sorts_1 m (fun a0:ad => a0) - (fun (a a':ad) (p:ad_less a a' = true) => p)). + (fun (a a':ad) (p:Nless a a' = true) => p)). Qed. Lemma alist_of_Map_sorts1 : @@ -458,59 +277,25 @@ Section LSort. Proof. intro. apply alist_sorted_1_imp_2. apply alist_of_Map_sorts1. Qed. - - Lemma ad_less_total : - forall a a':ad, {ad_less a a' = true} + {ad_less a' a = true} + {a = a'}. - Proof. - intro a. refine - (ad_rec_double a - (fun a:ad => - forall a':ad, - {ad_less a a' = true} + {ad_less a' a = true} + {a = a'}) _ _ _). - intro. elim (sumbool_of_bool (ad_less ad_z a')). intro H. left. left. assumption. - intro H. right. rewrite (ad_z_less_2 a' H). reflexivity. - intros a0 H a'. refine - (ad_rec_double a' - (fun a':ad => - {ad_less (ad_double a0) a' = true} + - {ad_less a' (ad_double a0) = true} + {ad_double a0 = a'}) _ _ _). - elim (sumbool_of_bool (ad_less ad_z (ad_double a0))). intro H0. left. right. assumption. - intro H0. right. exact (ad_z_less_2 _ H0). - intros a1 H0. rewrite ad_less_def_1. rewrite ad_less_def_1. elim (H a1). intro H1. - left. assumption. - intro H1. right. rewrite H1. reflexivity. - intros a1 H0. left. left. apply ad_less_def_3. - intros a0 H a'. refine - (ad_rec_double a' - (fun a':ad => - {ad_less (ad_double_plus_un a0) a' = true} + - {ad_less a' (ad_double_plus_un a0) = true} + - {ad_double_plus_un a0 = a'}) _ _ _). - left. right. case a0; reflexivity. - intros a1 H0. left. right. apply ad_less_def_3. - intros a1 H0. rewrite ad_less_def_2. rewrite ad_less_def_2. elim (H a1). intro H1. - left. assumption. - intro H1. right. rewrite H1. reflexivity. - Qed. Lemma alist_too_low : forall (l:alist A) (a a':ad) (y:A), - ad_less a a' = true -> + Nless a a' = true -> alist_sorted_2 ((a', y) :: l) -> - alist_semantics A ((a', y) :: l) a = NONE A. + alist_semantics A ((a', y) :: l) a = None. Proof. - simple induction l. intros. simpl in |- *. elim (sumbool_of_bool (ad_eq a' a)). intro H1. - rewrite (ad_eq_complete _ _ H1) in H. rewrite (ad_less_not_refl a) in H. discriminate H. + simple induction l. intros. simpl in |- *. elim (sumbool_of_bool (Neqb a' a)). intro H1. + rewrite (Neqb_complete _ _ H1) in H. rewrite (Nless_not_refl a) in H. discriminate H. intro H1. rewrite H1. reflexivity. intro r. elim r. intros a y l0 H a0 a1 y0 H0 H1. change - (match ad_eq a1 a0 with - | true => SOME A y0 + (match Neqb a1 a0 with + | true => Some y0 | false => alist_semantics A ((a, y) :: l0) a0 - end = NONE A) in |- *. - elim (sumbool_of_bool (ad_eq a1 a0)). intro H2. rewrite (ad_eq_complete _ _ H2) in H0. - rewrite (ad_less_not_refl a0) in H0. discriminate H0. - intro H2. rewrite H2. apply H. apply ad_less_trans with (a' := a1). assumption. + end = None) in |- *. + elim (sumbool_of_bool (Neqb a1 a0)). intro H2. rewrite (Neqb_complete _ _ H2) in H0. + rewrite (Nless_not_refl a0) in H0. discriminate H0. + intro H2. rewrite H2. apply H. apply Nless_trans with (a' := a1). assumption. unfold alist_sorted_2 in H1. apply (H1 0 1). apply lt_n_Sn. simpl in |- *. apply le_n_S. apply le_n_S. apply le_O_n. apply alist_sorted_1_imp_2. apply alist_sorted_imp_1. @@ -521,13 +306,13 @@ Section LSort. Lemma alist_semantics_nth_ad : forall (l:alist A) (a:ad) (y:A), - alist_semantics A l a = SOME A y -> + alist_semantics A l a = Some y -> {n : nat | S n <= length l /\ alist_nth_ad n l = a}. Proof. simple induction l. intros. discriminate H. - intro r. elim r. intros a y l0 H a0 y0 H0. simpl in H0. elim (sumbool_of_bool (ad_eq a a0)). + intro r. elim r. intros a y l0 H a0 y0 H0. simpl in H0. elim (sumbool_of_bool (Neqb a a0)). intro H1. rewrite H1 in H0. split with 0. split. simpl in |- *. apply le_n_S. apply le_O_n. - simpl in |- *. exact (ad_eq_complete _ _ H1). + simpl in |- *. exact (Neqb_complete _ _ H1). intro H1. rewrite H1 in H0. elim (H a0 y0 H0). intros n' H2. split with (S n'). split. simpl in |- *. apply le_n_S. exact (proj1 H2). exact (proj2 H2). @@ -538,16 +323,16 @@ Section LSort. alist_sorted_2 ((a, y) :: l) -> eqm A (alist_semantics A l) (fun a0:ad => - if ad_eq a a0 then NONE A else alist_semantics A ((a, y) :: l) a0). + if Neqb a a0 then None else alist_semantics A ((a, y) :: l) a0). Proof. - unfold eqm in |- *. intros. elim (sumbool_of_bool (ad_eq a a0)). intro H0. rewrite H0. - rewrite <- (ad_eq_complete _ _ H0). unfold alist_sorted_2 in H. + unfold eqm in |- *. intros. elim (sumbool_of_bool (Neqb a a0)). intro H0. rewrite H0. + rewrite <- (Neqb_complete _ _ H0). unfold alist_sorted_2 in H. elim (option_sum A (alist_semantics A l a)). intro H1. elim H1. intros y0 H2. elim (alist_semantics_nth_ad l a y0 H2). intros n H3. elim H3. intros. cut - (ad_less (alist_nth_ad 0 ((a, y) :: l)) + (Nless (alist_nth_ad 0 ((a, y) :: l)) (alist_nth_ad (S n) ((a, y) :: l)) = true). - intro. simpl in H6. rewrite H5 in H6. rewrite (ad_less_not_refl a) in H6. discriminate H6. + intro. simpl in H6. rewrite H5 in H6. rewrite (Nless_not_refl a) in H6. discriminate H6. apply H. apply lt_O_Sn. simpl in |- *. apply le_n_S. assumption. trivial. @@ -563,7 +348,7 @@ Section LSort. eqm A (alist_semantics A l) (alist_semantics A l'). Proof. unfold eqm in |- *. intros. rewrite (alist_semantics_tail _ _ _ H a0). - rewrite (alist_semantics_tail _ _ _ H0 a0). case (ad_eq a a0). reflexivity. + rewrite (alist_semantics_tail _ _ _ H0 a0). case (Neqb a a0). reflexivity. exact (H1 a0). Qed. @@ -583,40 +368,40 @@ Section LSort. unfold eqm in |- *. simple induction l. simple induction l'. trivial. intro r. elim r. intros a y l0 H H0 H1 H2. simpl in H0. cut - (NONE A = - match ad_eq a a with - | true => SOME A y + (None = + match Neqb a a with + | true => Some y | false => alist_semantics A l0 a end). - rewrite (ad_eq_correct a). intro. discriminate H3. + rewrite (Neqb_correct a). intro. discriminate H3. exact (H0 a). intro r. elim r. intros a y l0 H. simple induction l'. intros. simpl in H0. cut - (match ad_eq a a with - | true => SOME A y + (match Neqb a a with + | true => Some y | false => alist_semantics A l0 a - end = NONE A). - rewrite (ad_eq_correct a). intro. discriminate H3. + end = None). + rewrite (Neqb_correct a). intro. discriminate H3. exact (H0 a). - intro r'. elim r'. intros a' y' l'0 H0 H1 H2 H3. elim (ad_less_total a a'). intro H4. + intro r'. elim r'. intros a' y' l'0 H0 H1 H2 H3. elim (Nless_total a a'). intro H4. elim H4. intro H5. cut (alist_semantics A ((a, y) :: l0) a = alist_semantics A ((a', y') :: l'0) a). intro. rewrite (alist_too_low l'0 a a' y' H5 H3) in H6. simpl in H6. - rewrite (ad_eq_correct a) in H6. discriminate H6. + rewrite (Neqb_correct a) in H6. discriminate H6. exact (H1 a). intro H5. cut (alist_semantics A ((a, y) :: l0) a' = alist_semantics A ((a', y') :: l'0) a'). intro. rewrite (alist_too_low l0 a' a y H5 H2) in H6. simpl in H6. - rewrite (ad_eq_correct a') in H6. discriminate H6. + rewrite (Neqb_correct a') in H6. discriminate H6. exact (H1 a'). intro H4. rewrite H4. cut (alist_semantics A ((a, y) :: l0) a = alist_semantics A ((a', y') :: l'0) a). - intro. simpl in H5. rewrite H4 in H5. rewrite (ad_eq_correct a') in H5. inversion H5. + intro. simpl in H5. rewrite H4 in H5. rewrite (Neqb_correct a') in H5. inversion H5. rewrite H4 in H1. rewrite H7 in H1. cut (l0 = l'0). intro. rewrite H6. reflexivity. apply H. rewrite H4 in H2. rewrite H7 in H2. exact (alist_semantics_same_tail l0 l'0 a' y' H2 H3 H1). diff --git a/theories/IntMap/Map.v b/theories/IntMap/Map.v index 5345f81b..2be6de04 100644 --- a/theories/IntMap/Map.v +++ b/theories/IntMap/Map.v @@ -5,21 +5,26 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Map.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: Map.v 8733 2006-04-25 22:52:18Z letouzey $ i*) (** Definition of finite sets as trees indexed by adresses *) Require Import Bool. Require Import Sumbool. -Require Import ZArith. -Require Import Addr. -Require Import Adist. -Require Import Addec. +Require Import NArith. +Require Import Ndigits. +Require Import Ndec. +(* The type [ad] of addresses is now [N] in [BinNat]. *) + +Definition ad := N. + +(* a Notation or complete replacement would be nice, + but that would changes hyps names *) Section MapDefs. -(** We define maps from ad to A. *) +(** We now define maps from ad to A. *) Variable A : Set. Inductive Map : Set := @@ -27,31 +32,28 @@ Section MapDefs. | M1 : ad -> A -> Map | M2 : Map -> Map -> Map. - Inductive option : Set := - | NONE : option - | SOME : A -> option. - - Lemma option_sum : forall o:option, {y : A | o = SOME y} + {o = NONE}. + Lemma option_sum : forall o:option A, {y : A | o = Some y} + {o = None}. Proof. - simple induction o. right. reflexivity. + simple induction o. left. split with a. reflexivity. + right. reflexivity. Qed. (** The semantics of maps is given by the function [MapGet]. The semantics of a map [m] is a partial, finite function from [ad] to [A]: *) - Fixpoint MapGet (m:Map) : ad -> option := + Fixpoint MapGet (m:Map) : ad -> option A := match m with - | M0 => fun a:ad => NONE - | M1 x y => fun a:ad => if ad_eq x a then SOME y else NONE + | M0 => fun a:ad => None + | M1 x y => fun a:ad => if Neqb x a then Some y else None | M2 m1 m2 => fun a:ad => match a with - | ad_z => MapGet m1 ad_z - | ad_x xH => MapGet m2 ad_z - | ad_x (xO p) => MapGet m1 (ad_x p) - | ad_x (xI p) => MapGet m2 (ad_x p) + | N0 => MapGet m1 N0 + | Npos xH => MapGet m2 N0 + | Npos (xO p) => MapGet m1 (Npos p) + | Npos (xI p) => MapGet m2 (Npos p) end end. @@ -59,9 +61,9 @@ Section MapDefs. Definition MapSingleton := M1. - Definition eqm (g g':ad -> option) := forall a:ad, g a = g' a. + Definition eqm (g g':ad -> option A) := forall a:ad, g a = g' a. - Lemma newMap_semantics : eqm (MapGet newMap) (fun a:ad => NONE). + Lemma newMap_semantics : eqm (MapGet newMap) (fun a:ad => None). Proof. simpl in |- *. unfold eqm in |- *. trivial. Qed. @@ -69,61 +71,61 @@ Section MapDefs. Lemma MapSingleton_semantics : forall (a:ad) (y:A), eqm (MapGet (MapSingleton a y)) - (fun a':ad => if ad_eq a a' then SOME y else NONE). + (fun a':ad => if Neqb a a' then Some y else None). Proof. simpl in |- *. unfold eqm in |- *. trivial. Qed. - Lemma M1_semantics_1 : forall (a:ad) (y:A), MapGet (M1 a y) a = SOME y. + Lemma M1_semantics_1 : forall (a:ad) (y:A), MapGet (M1 a y) a = Some y. Proof. - unfold MapGet in |- *. intros. rewrite (ad_eq_correct a). reflexivity. + unfold MapGet in |- *. intros. rewrite (Neqb_correct a). reflexivity. Qed. Lemma M1_semantics_2 : - forall (a a':ad) (y:A), ad_eq a a' = false -> MapGet (M1 a y) a' = NONE. + forall (a a':ad) (y:A), Neqb a a' = false -> MapGet (M1 a y) a' = None. Proof. intros. simpl in |- *. rewrite H. reflexivity. Qed. Lemma Map2_semantics_1 : forall m m':Map, - eqm (MapGet m) (fun a:ad => MapGet (M2 m m') (ad_double a)). + eqm (MapGet m) (fun a:ad => MapGet (M2 m m') (Ndouble a)). Proof. unfold eqm in |- *. simple induction a; trivial. Qed. Lemma Map2_semantics_1_eq : - forall (m m':Map) (f:ad -> option), - eqm (MapGet (M2 m m')) f -> eqm (MapGet m) (fun a:ad => f (ad_double a)). + forall (m m':Map) (f:ad -> option A), + eqm (MapGet (M2 m m')) f -> eqm (MapGet m) (fun a:ad => f (Ndouble a)). Proof. unfold eqm in |- *. intros. - rewrite <- (H (ad_double a)). + rewrite <- (H (Ndouble a)). exact (Map2_semantics_1 m m' a). Qed. Lemma Map2_semantics_2 : forall m m':Map, - eqm (MapGet m') (fun a:ad => MapGet (M2 m m') (ad_double_plus_un a)). + eqm (MapGet m') (fun a:ad => MapGet (M2 m m') (Ndouble_plus_one a)). Proof. unfold eqm in |- *. simple induction a; trivial. Qed. Lemma Map2_semantics_2_eq : - forall (m m':Map) (f:ad -> option), + forall (m m':Map) (f:ad -> option A), eqm (MapGet (M2 m m')) f -> - eqm (MapGet m') (fun a:ad => f (ad_double_plus_un a)). + eqm (MapGet m') (fun a:ad => f (Ndouble_plus_one a)). Proof. unfold eqm in |- *. intros. - rewrite <- (H (ad_double_plus_un a)). + rewrite <- (H (Ndouble_plus_one a)). exact (Map2_semantics_2 m m' a). Qed. Lemma MapGet_M2_bit_0_0 : forall a:ad, - ad_bit_0 a = false -> - forall m m':Map, MapGet (M2 m m') a = MapGet m (ad_div_2 a). + Nbit0 a = false -> + forall m m':Map, MapGet (M2 m m') a = MapGet m (Ndiv2 a). Proof. simple induction a; trivial. simple induction p. intros. discriminate H0. trivial. @@ -132,8 +134,8 @@ Section MapDefs. Lemma MapGet_M2_bit_0_1 : forall a:ad, - ad_bit_0 a = true -> - forall m m':Map, MapGet (M2 m m') a = MapGet m' (ad_div_2 a). + Nbit0 a = true -> + forall m m':Map, MapGet (M2 m m') a = MapGet m' (Ndiv2 a). Proof. simple induction a. intros. discriminate H. simple induction p. trivial. @@ -144,19 +146,19 @@ Section MapDefs. Lemma MapGet_M2_bit_0_if : forall (m m':Map) (a:ad), MapGet (M2 m m') a = - (if ad_bit_0 a then MapGet m' (ad_div_2 a) else MapGet m (ad_div_2 a)). + (if Nbit0 a then MapGet m' (Ndiv2 a) else MapGet m (Ndiv2 a)). Proof. - intros. elim (sumbool_of_bool (ad_bit_0 a)). intro H. rewrite H. + intros. elim (sumbool_of_bool (Nbit0 a)). intro H. rewrite H. apply MapGet_M2_bit_0_1; assumption. intro H. rewrite H. apply MapGet_M2_bit_0_0; assumption. Qed. Lemma MapGet_M2_bit_0 : forall (m m' m'':Map) (a:ad), - (if ad_bit_0 a then MapGet (M2 m' m) a else MapGet (M2 m m'') a) = - MapGet m (ad_div_2 a). + (if Nbit0 a then MapGet (M2 m' m) a else MapGet (M2 m m'') a) = + MapGet m (Ndiv2 a). Proof. - intros. elim (sumbool_of_bool (ad_bit_0 a)). intro H. rewrite H. + intros. elim (sumbool_of_bool (Nbit0 a)). intro H. rewrite H. apply MapGet_M2_bit_0_1; assumption. intro H. rewrite H. apply MapGet_M2_bit_0_0; assumption. Qed. @@ -165,9 +167,9 @@ Section MapDefs. forall m m':Map, eqm (MapGet (M2 m m')) (fun a:ad => - match ad_bit_0 a with - | false => MapGet m (ad_div_2 a) - | true => MapGet m' (ad_div_2 a) + match Nbit0 a with + | false => MapGet m (Ndiv2 a) + | true => MapGet m' (Ndiv2 a) end). Proof. unfold eqm in |- *. @@ -176,20 +178,20 @@ Section MapDefs. Qed. Lemma Map2_semantics_3_eq : - forall (m m':Map) (f f':ad -> option), + forall (m m':Map) (f f':ad -> option A), eqm (MapGet m) f -> eqm (MapGet m') f' -> eqm (MapGet (M2 m m')) (fun a:ad => - match ad_bit_0 a with - | false => f (ad_div_2 a) - | true => f' (ad_div_2 a) + match Nbit0 a with + | false => f (Ndiv2 a) + | true => f' (Ndiv2 a) end). Proof. unfold eqm in |- *. intros. - rewrite <- (H (ad_div_2 a)). - rewrite <- (H0 (ad_div_2 a)). + rewrite <- (H (Ndiv2 a)). + rewrite <- (H0 (Ndiv2 a)). exact (Map2_semantics_3 m m' a). Qed. @@ -197,15 +199,15 @@ Section MapDefs. Map := match p with | xO p' => - let m := MapPut1 (ad_div_2 a) y (ad_div_2 a') y' p' in - match ad_bit_0 a with + let m := MapPut1 (Ndiv2 a) y (Ndiv2 a') y' p' in + match Nbit0 a with | false => M2 m M0 | true => M2 M0 m end | _ => - match ad_bit_0 a with - | false => M2 (M1 (ad_div_2 a) y) (M1 (ad_div_2 a') y') - | true => M2 (M1 (ad_div_2 a') y') (M1 (ad_div_2 a) y) + match Nbit0 a with + | false => M2 (M1 (Ndiv2 a) y) (M1 (Ndiv2 a') y') + | true => M2 (M1 (Ndiv2 a') y') (M1 (Ndiv2 a) y) end end. @@ -218,14 +220,14 @@ Section MapDefs. (*i Lemma MapGet_M2_bit_0_1' : (m,m',m'',m''':Map) - (a:ad) (MapGet (if (ad_bit_0 a) then (M2 m m') else (M2 m'' m''')) a)= - (MapGet (if (ad_bit_0 a) then m' else m'') (ad_div_2 a)). + (a:ad) (MapGet (if (Nbit0 a) then (M2 m m') else (M2 m'' m''')) a)= + (MapGet (if (Nbit0 a) then m' else m'') (Ndiv2 a)). Proof. - Intros. Rewrite (MapGet_if_commute (ad_bit_0 a)). Rewrite (MapGet_if_commute (ad_bit_0 a)). - Cut (ad_bit_0 a)=false\/(ad_bit_0 a)=true. Intros. Elim H. Intros. Rewrite H0. + Intros. Rewrite (MapGet_if_commute (Nbit0 a)). Rewrite (MapGet_if_commute (Nbit0 a)). + Cut (Nbit0 a)=false\/(Nbit0 a)=true. Intros. Elim H. Intros. Rewrite H0. Apply MapGet_M2_bit_0_0. Assumption. Intros. Rewrite H0. Apply MapGet_M2_bit_0_1. Assumption. - Case (ad_bit_0 a); Auto. + Case (Nbit0 a); Auto. Qed. i*) @@ -237,107 +239,107 @@ Section MapDefs. Lemma MapGet_M2_bit_0_2 : forall (m m' m'':Map) (a:ad), - MapGet (if ad_bit_0 a then M2 m m' else M2 m' m'') a = - MapGet m' (ad_div_2 a). + MapGet (if Nbit0 a then M2 m m' else M2 m' m'') a = + MapGet m' (Ndiv2 a). Proof. intros. rewrite MapGet_if_commute. apply MapGet_M2_bit_0. Qed. Lemma MapPut1_semantics_1 : forall (p:positive) (a a':ad) (y y':A), - ad_xor a a' = ad_x p -> MapGet (MapPut1 a y a' y' p) a = SOME y. + Nxor a a' = Npos p -> MapGet (MapPut1 a y a' y' p) a = Some y. Proof. simple induction p. intros. unfold MapPut1 in |- *. rewrite MapGet_M2_bit_0_2. apply M1_semantics_1. - intros. simpl in |- *. rewrite MapGet_M2_bit_0_2. apply H. rewrite <- ad_xor_div_2. rewrite H0. + intros. simpl in |- *. rewrite MapGet_M2_bit_0_2. apply H. rewrite <- Nxor_div2. rewrite H0. reflexivity. intros. unfold MapPut1 in |- *. rewrite MapGet_M2_bit_0_2. apply M1_semantics_1. Qed. Lemma MapPut1_semantics_2 : forall (p:positive) (a a':ad) (y y':A), - ad_xor a a' = ad_x p -> MapGet (MapPut1 a y a' y' p) a' = SOME y'. + Nxor a a' = Npos p -> MapGet (MapPut1 a y a' y' p) a' = Some y'. Proof. - simple induction p. intros. unfold MapPut1 in |- *. rewrite (ad_neg_bit_0_2 a a' p0 H0). + simple induction p. intros. unfold MapPut1 in |- *. rewrite (Nneg_bit0_2 a a' p0 H0). rewrite if_negb. rewrite MapGet_M2_bit_0_2. apply M1_semantics_1. - intros. simpl in |- *. rewrite (ad_same_bit_0 a a' p0 H0). rewrite MapGet_M2_bit_0_2. - apply H. rewrite <- ad_xor_div_2. rewrite H0. reflexivity. - intros. unfold MapPut1 in |- *. rewrite (ad_neg_bit_0_1 a a' H). rewrite if_negb. + intros. simpl in |- *. rewrite (Nsame_bit0 a a' p0 H0). rewrite MapGet_M2_bit_0_2. + apply H. rewrite <- Nxor_div2. rewrite H0. reflexivity. + intros. unfold MapPut1 in |- *. rewrite (Nneg_bit0_1 a a' H). rewrite if_negb. rewrite MapGet_M2_bit_0_2. apply M1_semantics_1. Qed. - Lemma MapGet_M2_both_NONE : + Lemma MapGet_M2_both_None : forall (m m':Map) (a:ad), - MapGet m (ad_div_2 a) = NONE -> - MapGet m' (ad_div_2 a) = NONE -> MapGet (M2 m m') a = NONE. + MapGet m (Ndiv2 a) = None -> + MapGet m' (Ndiv2 a) = None -> MapGet (M2 m m') a = None. Proof. intros. rewrite (Map2_semantics_3 m m' a). - case (ad_bit_0 a); assumption. + case (Nbit0 a); assumption. Qed. Lemma MapPut1_semantics_3 : forall (p:positive) (a a' a0:ad) (y y':A), - ad_xor a a' = ad_x p -> - ad_eq a a0 = false -> - ad_eq a' a0 = false -> MapGet (MapPut1 a y a' y' p) a0 = NONE. - Proof. - simple induction p. intros. unfold MapPut1 in |- *. elim (ad_neq a a0 H1). intro. rewrite H3. rewrite if_negb. - rewrite MapGet_M2_bit_0_2. apply M1_semantics_2. apply ad_div_bit_neq. assumption. - rewrite (ad_neg_bit_0_2 a a' p0 H0) in H3. rewrite (negb_intro (ad_bit_0 a')). - rewrite (negb_intro (ad_bit_0 a0)). rewrite H3. reflexivity. - intro. elim (ad_neq a' a0 H2). intro. rewrite (ad_neg_bit_0_2 a a' p0 H0). rewrite H4. - rewrite (negb_elim (ad_bit_0 a0)). rewrite MapGet_M2_bit_0_2. + Nxor a a' = Npos p -> + Neqb a a0 = false -> + Neqb a' a0 = false -> MapGet (MapPut1 a y a' y' p) a0 = None. + Proof. + simple induction p. intros. unfold MapPut1 in |- *. elim (Nneq_elim a a0 H1). intro. rewrite H3. rewrite if_negb. + rewrite MapGet_M2_bit_0_2. apply M1_semantics_2. apply Ndiv2_bit_neq. assumption. + rewrite (Nneg_bit0_2 a a' p0 H0) in H3. rewrite (negb_intro (Nbit0 a')). + rewrite (negb_intro (Nbit0 a0)). rewrite H3. reflexivity. + intro. elim (Nneq_elim a' a0 H2). intro. rewrite (Nneg_bit0_2 a a' p0 H0). rewrite H4. + rewrite (negb_elim (Nbit0 a0)). rewrite MapGet_M2_bit_0_2. apply M1_semantics_2; assumption. - intro; case (ad_bit_0 a); apply MapGet_M2_both_NONE; apply M1_semantics_2; + intro; case (Nbit0 a); apply MapGet_M2_both_None; apply M1_semantics_2; assumption. - intros. simpl in |- *. elim (ad_neq a a0 H1). intro. rewrite H3. rewrite if_negb. + intros. simpl in |- *. elim (Nneq_elim a a0 H1). intro. rewrite H3. rewrite if_negb. rewrite MapGet_M2_bit_0_2. reflexivity. - intro. elim (ad_neq a' a0 H2). intro. rewrite (ad_same_bit_0 a a' p0 H0). rewrite H4. + intro. elim (Nneq_elim a' a0 H2). intro. rewrite (Nsame_bit0 a a' p0 H0). rewrite H4. rewrite if_negb. rewrite MapGet_M2_bit_0_2. reflexivity. - intro. cut (ad_xor (ad_div_2 a) (ad_div_2 a') = ad_x p0). intro. - case (ad_bit_0 a); apply MapGet_M2_both_NONE; trivial; apply H; + intro. cut (Nxor (Ndiv2 a) (Ndiv2 a') = Npos p0). intro. + case (Nbit0 a); apply MapGet_M2_both_None; trivial; apply H; assumption. - rewrite <- ad_xor_div_2. rewrite H0. reflexivity. - intros. simpl in |- *. elim (ad_neq a a0 H0). intro. rewrite H2. rewrite if_negb. - rewrite MapGet_M2_bit_0_2. apply M1_semantics_2. apply ad_div_bit_neq. assumption. - rewrite (ad_neg_bit_0_1 a a' H) in H2. rewrite (negb_intro (ad_bit_0 a')). - rewrite (negb_intro (ad_bit_0 a0)). rewrite H2. reflexivity. - intro. elim (ad_neq a' a0 H1). intro. rewrite (ad_neg_bit_0_1 a a' H). rewrite H3. - rewrite (negb_elim (ad_bit_0 a0)). rewrite MapGet_M2_bit_0_2. + rewrite <- Nxor_div2. rewrite H0. reflexivity. + intros. simpl in |- *. elim (Nneq_elim a a0 H0). intro. rewrite H2. rewrite if_negb. + rewrite MapGet_M2_bit_0_2. apply M1_semantics_2. apply Ndiv2_bit_neq. assumption. + rewrite (Nneg_bit0_1 a a' H) in H2. rewrite (negb_intro (Nbit0 a')). + rewrite (negb_intro (Nbit0 a0)). rewrite H2. reflexivity. + intro. elim (Nneq_elim a' a0 H1). intro. rewrite (Nneg_bit0_1 a a' H). rewrite H3. + rewrite (negb_elim (Nbit0 a0)). rewrite MapGet_M2_bit_0_2. apply M1_semantics_2; assumption. - intro. case (ad_bit_0 a); apply MapGet_M2_both_NONE; apply M1_semantics_2; + intro. case (Nbit0 a); apply MapGet_M2_both_None; apply M1_semantics_2; assumption. Qed. Lemma MapPut1_semantics : forall (p:positive) (a a':ad) (y y':A), - ad_xor a a' = ad_x p -> + Nxor a a' = Npos p -> eqm (MapGet (MapPut1 a y a' y' p)) (fun a0:ad => - if ad_eq a a0 - then SOME y - else if ad_eq a' a0 then SOME y' else NONE). - Proof. - unfold eqm in |- *. intros. elim (sumbool_of_bool (ad_eq a a0)). intro H0. rewrite H0. - rewrite <- (ad_eq_complete _ _ H0). exact (MapPut1_semantics_1 p a a' y y' H). - intro H0. rewrite H0. elim (sumbool_of_bool (ad_eq a' a0)). intro H1. - rewrite <- (ad_eq_complete _ _ H1). rewrite (ad_eq_correct a'). + if Neqb a a0 + then Some y + else if Neqb a' a0 then Some y' else None). + Proof. + unfold eqm in |- *. intros. elim (sumbool_of_bool (Neqb a a0)). intro H0. rewrite H0. + rewrite <- (Neqb_complete _ _ H0). exact (MapPut1_semantics_1 p a a' y y' H). + intro H0. rewrite H0. elim (sumbool_of_bool (Neqb a' a0)). intro H1. + rewrite <- (Neqb_complete _ _ H1). rewrite (Neqb_correct a'). exact (MapPut1_semantics_2 p a a' y y' H). intro H1. rewrite H1. exact (MapPut1_semantics_3 p a a' a0 y y' H H0 H1). Qed. Lemma MapPut1_semantics' : forall (p:positive) (a a':ad) (y y':A), - ad_xor a a' = ad_x p -> + Nxor a a' = Npos p -> eqm (MapGet (MapPut1 a y a' y' p)) (fun a0:ad => - if ad_eq a' a0 - then SOME y' - else if ad_eq a a0 then SOME y else NONE). + if Neqb a' a0 + then Some y' + else if Neqb a a0 then Some y else None). Proof. unfold eqm in |- *. intros. rewrite (MapPut1_semantics p a a' y y' H a0). - elim (sumbool_of_bool (ad_eq a a0)). intro H0. rewrite H0. - rewrite <- (ad_eq_complete a a0 H0). rewrite (ad_eq_comm a' a). - rewrite (ad_xor_eq_false a a' p H). reflexivity. + elim (sumbool_of_bool (Neqb a a0)). intro H0. rewrite H0. + rewrite <- (Neqb_complete a a0 H0). rewrite (Neqb_comm a' a). + rewrite (Nxor_eq_false a a' p H). reflexivity. intro H0. rewrite H0. reflexivity. Qed. @@ -346,17 +348,17 @@ Section MapDefs. | M0 => M1 | M1 a y => fun (a':ad) (y':A) => - match ad_xor a a' with - | ad_z => M1 a' y' - | ad_x p => MapPut1 a y a' y' p + match Nxor a a' with + | N0 => M1 a' y' + | Npos p => MapPut1 a y a' y' p end | M2 m1 m2 => fun (a:ad) (y:A) => match a with - | ad_z => M2 (MapPut m1 ad_z y) m2 - | ad_x xH => M2 m1 (MapPut m2 ad_z y) - | ad_x (xO p) => M2 (MapPut m1 (ad_x p) y) m2 - | ad_x (xI p) => M2 m1 (MapPut m2 (ad_x p) y) + | N0 => M2 (MapPut m1 N0 y) m2 + | Npos xH => M2 m1 (MapPut m2 N0 y) + | Npos (xO p) => M2 (MapPut m1 (Npos p) y) m2 + | Npos (xI p) => M2 m1 (MapPut m2 (Npos p) y) end end. @@ -370,39 +372,39 @@ Section MapDefs. Lemma MapPut_semantics_2_1 : forall (a:ad) (y y':A) (a0:ad), MapGet (MapPut (M1 a y) a y') a0 = - (if ad_eq a a0 then SOME y' else NONE). + (if Neqb a a0 then Some y' else None). Proof. - simpl in |- *. intros. rewrite (ad_xor_nilpotent a). trivial. + simpl in |- *. intros. rewrite (Nxor_nilpotent a). trivial. Qed. Lemma MapPut_semantics_2_2 : forall (a a':ad) (y y':A) (a0 a'':ad), - ad_xor a a' = a'' -> + Nxor a a' = a'' -> MapGet (MapPut (M1 a y) a' y') a0 = - (if ad_eq a' a0 then SOME y' else if ad_eq a a0 then SOME y else NONE). + (if Neqb a' a0 then Some y' else if Neqb a a0 then Some y else None). Proof. - simple induction a''. intro. rewrite (ad_xor_eq _ _ H). rewrite MapPut_semantics_2_1. - case (ad_eq a' a0); trivial. + simple induction a''. intro. rewrite (Nxor_eq _ _ H). rewrite MapPut_semantics_2_1. + case (Neqb a' a0); trivial. intros. simpl in |- *. rewrite H. rewrite (MapPut1_semantics p a a' y y' H a0). - elim (sumbool_of_bool (ad_eq a a0)). intro H0. rewrite H0. rewrite <- (ad_eq_complete _ _ H0). - rewrite (ad_eq_comm a' a). rewrite (ad_xor_eq_false _ _ _ H). reflexivity. + elim (sumbool_of_bool (Neqb a a0)). intro H0. rewrite H0. rewrite <- (Neqb_complete _ _ H0). + rewrite (Neqb_comm a' a). rewrite (Nxor_eq_false _ _ _ H). reflexivity. intro H0. rewrite H0. reflexivity. Qed. Lemma MapPut_semantics_2 : forall (a a':ad) (y y':A) (a0:ad), MapGet (MapPut (M1 a y) a' y') a0 = - (if ad_eq a' a0 then SOME y' else if ad_eq a a0 then SOME y else NONE). + (if Neqb a' a0 then Some y' else if Neqb a a0 then Some y else None). Proof. - intros. apply MapPut_semantics_2_2 with (a'' := ad_xor a a'); trivial. + intros. apply MapPut_semantics_2_2 with (a'' := Nxor a a'); trivial. Qed. Lemma MapPut_semantics_3_1 : forall (m m':Map) (a:ad) (y:A), MapPut (M2 m m') a y = - (if ad_bit_0 a - then M2 m (MapPut m' (ad_div_2 a) y) - else M2 (MapPut m (ad_div_2 a) y) m'). + (if Nbit0 a + then M2 m (MapPut m' (Ndiv2 a) y) + else M2 (MapPut m (Ndiv2 a) y) m'). Proof. simple induction a. trivial. simple induction p; trivial. @@ -411,24 +413,24 @@ Section MapDefs. Lemma MapPut_semantics : forall (m:Map) (a:ad) (y:A), eqm (MapGet (MapPut m a y)) - (fun a':ad => if ad_eq a a' then SOME y else MapGet m a'). + (fun a':ad => if Neqb a a' then Some y else MapGet m a'). Proof. unfold eqm in |- *. simple induction m. exact MapPut_semantics_1. intros. unfold MapGet at 2 in |- *. apply MapPut_semantics_2; assumption. intros. rewrite MapPut_semantics_3_1. rewrite (MapGet_M2_bit_0_if m0 m1 a0). - elim (sumbool_of_bool (ad_bit_0 a)). intro H1. rewrite H1. rewrite MapGet_M2_bit_0_if. - elim (sumbool_of_bool (ad_bit_0 a0)). intro H2. rewrite H2. - rewrite (H0 (ad_div_2 a) y (ad_div_2 a0)). elim (sumbool_of_bool (ad_eq a a0)). - intro H3. rewrite H3. rewrite (ad_div_eq _ _ H3). reflexivity. - intro H3. rewrite H3. rewrite <- H2 in H1. rewrite (ad_div_bit_neq _ _ H3 H1). reflexivity. - intro H2. rewrite H2. rewrite (ad_eq_comm a a0). rewrite (ad_bit_0_neq a0 a H2 H1). + elim (sumbool_of_bool (Nbit0 a)). intro H1. rewrite H1. rewrite MapGet_M2_bit_0_if. + elim (sumbool_of_bool (Nbit0 a0)). intro H2. rewrite H2. + rewrite (H0 (Ndiv2 a) y (Ndiv2 a0)). elim (sumbool_of_bool (Neqb a a0)). + intro H3. rewrite H3. rewrite (Ndiv2_eq _ _ H3). reflexivity. + intro H3. rewrite H3. rewrite <- H2 in H1. rewrite (Ndiv2_bit_neq _ _ H3 H1). reflexivity. + intro H2. rewrite H2. rewrite (Neqb_comm a a0). rewrite (Nbit0_neq a0 a H2 H1). reflexivity. - intro H1. rewrite H1. rewrite MapGet_M2_bit_0_if. elim (sumbool_of_bool (ad_bit_0 a0)). - intro H2. rewrite H2. rewrite (ad_bit_0_neq a a0 H1 H2). reflexivity. - intro H2. rewrite H2. rewrite (H (ad_div_2 a) y (ad_div_2 a0)). - elim (sumbool_of_bool (ad_eq a a0)). intro H3. rewrite H3. - rewrite (ad_div_eq a a0 H3). reflexivity. - intro H3. rewrite H3. rewrite <- H2 in H1. rewrite (ad_div_bit_neq a a0 H3 H1). reflexivity. + intro H1. rewrite H1. rewrite MapGet_M2_bit_0_if. elim (sumbool_of_bool (Nbit0 a0)). + intro H2. rewrite H2. rewrite (Nbit0_neq a a0 H1 H2). reflexivity. + intro H2. rewrite H2. rewrite (H (Ndiv2 a) y (Ndiv2 a0)). + elim (sumbool_of_bool (Neqb a a0)). intro H3. rewrite H3. + rewrite (Ndiv2_eq a a0 H3). reflexivity. + intro H3. rewrite H3. rewrite <- H2 in H1. rewrite (Ndiv2_bit_neq a a0 H3 H1). reflexivity. Qed. Fixpoint MapPut_behind (m:Map) : ad -> A -> Map := @@ -436,26 +438,26 @@ Section MapDefs. | M0 => M1 | M1 a y => fun (a':ad) (y':A) => - match ad_xor a a' with - | ad_z => m - | ad_x p => MapPut1 a y a' y' p + match Nxor a a' with + | N0 => m + | Npos p => MapPut1 a y a' y' p end | M2 m1 m2 => fun (a:ad) (y:A) => match a with - | ad_z => M2 (MapPut_behind m1 ad_z y) m2 - | ad_x xH => M2 m1 (MapPut_behind m2 ad_z y) - | ad_x (xO p) => M2 (MapPut_behind m1 (ad_x p) y) m2 - | ad_x (xI p) => M2 m1 (MapPut_behind m2 (ad_x p) y) + | N0 => M2 (MapPut_behind m1 N0 y) m2 + | Npos xH => M2 m1 (MapPut_behind m2 N0 y) + | Npos (xO p) => M2 (MapPut_behind m1 (Npos p) y) m2 + | Npos (xI p) => M2 m1 (MapPut_behind m2 (Npos p) y) end end. Lemma MapPut_behind_semantics_3_1 : forall (m m':Map) (a:ad) (y:A), MapPut_behind (M2 m m') a y = - (if ad_bit_0 a - then M2 m (MapPut_behind m' (ad_div_2 a) y) - else M2 (MapPut_behind m (ad_div_2 a) y) m'). + (if Nbit0 a + then M2 m (MapPut_behind m' (Ndiv2 a) y) + else M2 (MapPut_behind m (Ndiv2 a) y) m'). Proof. simple induction a. trivial. simple induction p; trivial. @@ -463,52 +465,52 @@ Section MapDefs. Lemma MapPut_behind_as_before_1 : forall a a' a0:ad, - ad_eq a' a0 = false -> + Neqb a' a0 = false -> forall y y':A, MapGet (MapPut (M1 a y) a' y') a0 = MapGet (MapPut_behind (M1 a y) a' y') a0. Proof. - intros a a' a0. simpl in |- *. intros H y y'. elim (ad_sum (ad_xor a a')). intro H0. elim H0. + intros a a' a0. simpl in |- *. intros H y y'. elim (Ndiscr (Nxor a a')). intro H0. elim H0. intros p H1. rewrite H1. reflexivity. - intro H0. rewrite H0. rewrite (ad_xor_eq _ _ H0). rewrite (M1_semantics_2 a' a0 y H). + intro H0. rewrite H0. rewrite (Nxor_eq _ _ H0). rewrite (M1_semantics_2 a' a0 y H). exact (M1_semantics_2 a' a0 y' H). Qed. Lemma MapPut_behind_as_before : forall (m:Map) (a:ad) (y:A) (a0:ad), - ad_eq a a0 = false -> + Neqb a a0 = false -> MapGet (MapPut m a y) a0 = MapGet (MapPut_behind m a y) a0. Proof. simple induction m. trivial. intros a y a' y' a0 H. exact (MapPut_behind_as_before_1 a a' a0 H y y'). intros. rewrite MapPut_semantics_3_1. rewrite MapPut_behind_semantics_3_1. - elim (sumbool_of_bool (ad_bit_0 a)). intro H2. rewrite H2. rewrite MapGet_M2_bit_0_if. - rewrite MapGet_M2_bit_0_if. elim (sumbool_of_bool (ad_bit_0 a0)). intro H3. - rewrite H3. apply H0. rewrite <- H3 in H2. exact (ad_div_bit_neq a a0 H1 H2). + elim (sumbool_of_bool (Nbit0 a)). intro H2. rewrite H2. rewrite MapGet_M2_bit_0_if. + rewrite MapGet_M2_bit_0_if. elim (sumbool_of_bool (Nbit0 a0)). intro H3. + rewrite H3. apply H0. rewrite <- H3 in H2. exact (Ndiv2_bit_neq a a0 H1 H2). intro H3. rewrite H3. reflexivity. intro H2. rewrite H2. rewrite MapGet_M2_bit_0_if. rewrite MapGet_M2_bit_0_if. - elim (sumbool_of_bool (ad_bit_0 a0)). intro H3. rewrite H3. reflexivity. - intro H3. rewrite H3. apply H. rewrite <- H3 in H2. exact (ad_div_bit_neq a a0 H1 H2). + elim (sumbool_of_bool (Nbit0 a0)). intro H3. rewrite H3. reflexivity. + intro H3. rewrite H3. apply H. rewrite <- H3 in H2. exact (Ndiv2_bit_neq a a0 H1 H2). Qed. Lemma MapPut_behind_new : forall (m:Map) (a:ad) (y:A), MapGet (MapPut_behind m a y) a = match MapGet m a with - | SOME y' => SOME y' - | _ => SOME y + | Some y' => Some y' + | _ => Some y end. Proof. - simple induction m. simpl in |- *. intros. rewrite (ad_eq_correct a). reflexivity. - intros. elim (ad_sum (ad_xor a a1)). intro H. elim H. intros p H0. simpl in |- *. - rewrite H0. rewrite (ad_xor_eq_false a a1 p). exact (MapPut1_semantics_2 p a a1 a0 y H0). + simple induction m. simpl in |- *. intros. rewrite (Neqb_correct a). reflexivity. + intros. elim (Ndiscr (Nxor a a1)). intro H. elim H. intros p H0. simpl in |- *. + rewrite H0. rewrite (Nxor_eq_false a a1 p). exact (MapPut1_semantics_2 p a a1 a0 y H0). assumption. - intro H. simpl in |- *. rewrite H. rewrite <- (ad_xor_eq _ _ H). rewrite (ad_eq_correct a). + intro H. simpl in |- *. rewrite H. rewrite <- (Nxor_eq _ _ H). rewrite (Neqb_correct a). exact (M1_semantics_1 a a0). intros. rewrite MapPut_behind_semantics_3_1. rewrite (MapGet_M2_bit_0_if m0 m1 a). - elim (sumbool_of_bool (ad_bit_0 a)). intro H1. rewrite H1. rewrite (MapGet_M2_bit_0_1 a H1). - exact (H0 (ad_div_2 a) y). - intro H1. rewrite H1. rewrite (MapGet_M2_bit_0_0 a H1). exact (H (ad_div_2 a) y). + elim (sumbool_of_bool (Nbit0 a)). intro H1. rewrite H1. rewrite (MapGet_M2_bit_0_1 a H1). + exact (H0 (Ndiv2 a) y). + intro H1. rewrite H1. rewrite (MapGet_M2_bit_0_0 a H1). exact (H (Ndiv2 a) y). Qed. Lemma MapPut_behind_semantics : @@ -516,12 +518,12 @@ Section MapDefs. eqm (MapGet (MapPut_behind m a y)) (fun a':ad => match MapGet m a' with - | SOME y' => SOME y' - | _ => if ad_eq a a' then SOME y else NONE + | Some y' => Some y' + | _ => if Neqb a a' then Some y else None end). Proof. - unfold eqm in |- *. intros. elim (sumbool_of_bool (ad_eq a a0)). intro H. rewrite H. - rewrite (ad_eq_complete _ _ H). apply MapPut_behind_new. + unfold eqm in |- *. intros. elim (sumbool_of_bool (Neqb a a0)). intro H. rewrite H. + rewrite (Neqb_complete _ _ H). apply MapPut_behind_new. intro H. rewrite H. rewrite <- (MapPut_behind_as_before m a y a0 H). rewrite (MapPut_semantics m a y a0). rewrite H. case (MapGet m a0); trivial. Qed. @@ -529,41 +531,41 @@ Section MapDefs. Definition makeM2 (m m':Map) := match m, m' with | M0, M0 => M0 - | M0, M1 a y => M1 (ad_double_plus_un a) y - | M1 a y, M0 => M1 (ad_double a) y + | M0, M1 a y => M1 (Ndouble_plus_one a) y + | M1 a y, M0 => M1 (Ndouble a) y | _, _ => M2 m m' end. Lemma makeM2_M2 : forall m m':Map, eqm (MapGet (makeM2 m m')) (MapGet (M2 m m')). Proof. - unfold eqm in |- *. intros. elim (sumbool_of_bool (ad_bit_0 a)). intro H. + unfold eqm in |- *. intros. elim (sumbool_of_bool (Nbit0 a)). intro H. rewrite (MapGet_M2_bit_0_1 a H m m'). case m'. case m. reflexivity. - intros a0 y. simpl in |- *. rewrite (ad_bit_0_1_not_double a H a0). reflexivity. + intros a0 y. simpl in |- *. rewrite (Nodd_not_double a H a0). reflexivity. intros m1 m2. unfold makeM2 in |- *. rewrite MapGet_M2_bit_0_1. reflexivity. assumption. - case m. intros a0 y. simpl in |- *. elim (sumbool_of_bool (ad_eq a0 (ad_div_2 a))). - intro H0. rewrite H0. rewrite (ad_eq_complete _ _ H0). rewrite (ad_div_2_double_plus_un a H). - rewrite (ad_eq_correct a). reflexivity. - intro H0. rewrite H0. rewrite (ad_eq_comm a0 (ad_div_2 a)) in H0. - rewrite (ad_not_div_2_not_double_plus_un a a0 H0). reflexivity. + case m. intros a0 y. simpl in |- *. elim (sumbool_of_bool (Neqb a0 (Ndiv2 a))). + intro H0. rewrite H0. rewrite (Neqb_complete _ _ H0). rewrite (Ndiv2_double_plus_one a H). + rewrite (Neqb_correct a). reflexivity. + intro H0. rewrite H0. rewrite (Neqb_comm a0 (Ndiv2 a)) in H0. + rewrite (Nnot_div2_not_double_plus_one a a0 H0). reflexivity. intros a0 y0 a1 y1. unfold makeM2 in |- *. rewrite MapGet_M2_bit_0_1. reflexivity. assumption. intros m1 m2 a0 y. unfold makeM2 in |- *. rewrite MapGet_M2_bit_0_1. reflexivity. assumption. intros m1 m2. unfold makeM2 in |- *. - cut (MapGet (M2 m (M2 m1 m2)) a = MapGet (M2 m1 m2) (ad_div_2 a)). + cut (MapGet (M2 m (M2 m1 m2)) a = MapGet (M2 m1 m2) (Ndiv2 a)). case m; trivial. exact (MapGet_M2_bit_0_1 a H m (M2 m1 m2)). intro H. rewrite (MapGet_M2_bit_0_0 a H m m'). case m. case m'. reflexivity. - intros a0 y. simpl in |- *. rewrite (ad_bit_0_0_not_double_plus_un a H a0). reflexivity. + intros a0 y. simpl in |- *. rewrite (Neven_not_double_plus_one a H a0). reflexivity. intros m1 m2. unfold makeM2 in |- *. rewrite MapGet_M2_bit_0_0. reflexivity. assumption. - case m'. intros a0 y. simpl in |- *. elim (sumbool_of_bool (ad_eq a0 (ad_div_2 a))). intro H0. - rewrite H0. rewrite (ad_eq_complete _ _ H0). rewrite (ad_div_2_double a H). - rewrite (ad_eq_correct a). reflexivity. - intro H0. rewrite H0. rewrite (ad_eq_comm (ad_double a0) a). - rewrite (ad_eq_comm a0 (ad_div_2 a)) in H0. rewrite (ad_not_div_2_not_double a a0 H0). + case m'. intros a0 y. simpl in |- *. elim (sumbool_of_bool (Neqb a0 (Ndiv2 a))). intro H0. + rewrite H0. rewrite (Neqb_complete _ _ H0). rewrite (Ndiv2_double a H). + rewrite (Neqb_correct a). reflexivity. + intro H0. rewrite H0. rewrite (Neqb_comm (Ndouble a0) a). + rewrite (Neqb_comm a0 (Ndiv2 a)) in H0. rewrite (Nnot_div2_not_double a a0 H0). reflexivity. intros a0 y0 a1 y1. unfold makeM2 in |- *. rewrite MapGet_M2_bit_0_0. reflexivity. assumption. @@ -576,55 +578,55 @@ Section MapDefs. match m with | M0 => fun _:ad => M0 | M1 a y => - fun a':ad => match ad_eq a a' with + fun a':ad => match Neqb a a' with | true => M0 | false => m end | M2 m1 m2 => fun a:ad => - if ad_bit_0 a - then makeM2 m1 (MapRemove m2 (ad_div_2 a)) - else makeM2 (MapRemove m1 (ad_div_2 a)) m2 + if Nbit0 a + then makeM2 m1 (MapRemove m2 (Ndiv2 a)) + else makeM2 (MapRemove m1 (Ndiv2 a)) m2 end. Lemma MapRemove_semantics : forall (m:Map) (a:ad), eqm (MapGet (MapRemove m a)) - (fun a':ad => if ad_eq a a' then NONE else MapGet m a'). - Proof. - unfold eqm in |- *. simple induction m. simpl in |- *. intros. case (ad_eq a a0); trivial. - intros. simpl in |- *. elim (sumbool_of_bool (ad_eq a1 a2)). intro H. rewrite H. - elim (sumbool_of_bool (ad_eq a a1)). intro H0. rewrite H0. reflexivity. - intro H0. rewrite H0. rewrite (ad_eq_complete _ _ H) in H0. exact (M1_semantics_2 a a2 a0 H0). - intro H. elim (sumbool_of_bool (ad_eq a a1)). intro H0. rewrite H0. rewrite H. - rewrite <- (ad_eq_complete _ _ H0) in H. rewrite H. reflexivity. + (fun a':ad => if Neqb a a' then None else MapGet m a'). + Proof. + unfold eqm in |- *. simple induction m. simpl in |- *. intros. case (Neqb a a0); trivial. + intros. simpl in |- *. elim (sumbool_of_bool (Neqb a1 a2)). intro H. rewrite H. + elim (sumbool_of_bool (Neqb a a1)). intro H0. rewrite H0. reflexivity. + intro H0. rewrite H0. rewrite (Neqb_complete _ _ H) in H0. exact (M1_semantics_2 a a2 a0 H0). + intro H. elim (sumbool_of_bool (Neqb a a1)). intro H0. rewrite H0. rewrite H. + rewrite <- (Neqb_complete _ _ H0) in H. rewrite H. reflexivity. intro H0. rewrite H0. rewrite H. reflexivity. intros. change (MapGet - (if ad_bit_0 a - then makeM2 m0 (MapRemove m1 (ad_div_2 a)) - else makeM2 (MapRemove m0 (ad_div_2 a)) m1) a0 = - (if ad_eq a a0 then NONE else MapGet (M2 m0 m1) a0)) + (if Nbit0 a + then makeM2 m0 (MapRemove m1 (Ndiv2 a)) + else makeM2 (MapRemove m0 (Ndiv2 a)) m1) a0 = + (if Neqb a a0 then None else MapGet (M2 m0 m1) a0)) in |- *. - elim (sumbool_of_bool (ad_bit_0 a)). intro H1. rewrite H1. - rewrite (makeM2_M2 m0 (MapRemove m1 (ad_div_2 a)) a0). elim (sumbool_of_bool (ad_bit_0 a0)). - intro H2. rewrite MapGet_M2_bit_0_1. rewrite (H0 (ad_div_2 a) (ad_div_2 a0)). - elim (sumbool_of_bool (ad_eq a a0)). intro H3. rewrite H3. rewrite (ad_div_eq _ _ H3). + elim (sumbool_of_bool (Nbit0 a)). intro H1. rewrite H1. + rewrite (makeM2_M2 m0 (MapRemove m1 (Ndiv2 a)) a0). elim (sumbool_of_bool (Nbit0 a0)). + intro H2. rewrite MapGet_M2_bit_0_1. rewrite (H0 (Ndiv2 a) (Ndiv2 a0)). + elim (sumbool_of_bool (Neqb a a0)). intro H3. rewrite H3. rewrite (Ndiv2_eq _ _ H3). reflexivity. - intro H3. rewrite H3. rewrite <- H2 in H1. rewrite (ad_div_bit_neq _ _ H3 H1). + intro H3. rewrite H3. rewrite <- H2 in H1. rewrite (Ndiv2_bit_neq _ _ H3 H1). rewrite (MapGet_M2_bit_0_1 a0 H2 m0 m1). reflexivity. assumption. - intro H2. rewrite (MapGet_M2_bit_0_0 a0 H2 m0 (MapRemove m1 (ad_div_2 a))). - rewrite (ad_eq_comm a a0). rewrite (ad_bit_0_neq _ _ H2 H1). + intro H2. rewrite (MapGet_M2_bit_0_0 a0 H2 m0 (MapRemove m1 (Ndiv2 a))). + rewrite (Neqb_comm a a0). rewrite (Nbit0_neq _ _ H2 H1). rewrite (MapGet_M2_bit_0_0 a0 H2 m0 m1). reflexivity. - intro H1. rewrite H1. rewrite (makeM2_M2 (MapRemove m0 (ad_div_2 a)) m1 a0). - elim (sumbool_of_bool (ad_bit_0 a0)). intro H2. rewrite MapGet_M2_bit_0_1. - rewrite (MapGet_M2_bit_0_1 a0 H2 m0 m1). rewrite (ad_bit_0_neq a a0 H1 H2). reflexivity. + intro H1. rewrite H1. rewrite (makeM2_M2 (MapRemove m0 (Ndiv2 a)) m1 a0). + elim (sumbool_of_bool (Nbit0 a0)). intro H2. rewrite MapGet_M2_bit_0_1. + rewrite (MapGet_M2_bit_0_1 a0 H2 m0 m1). rewrite (Nbit0_neq a a0 H1 H2). reflexivity. assumption. - intro H2. rewrite MapGet_M2_bit_0_0. rewrite (H (ad_div_2 a) (ad_div_2 a0)). - rewrite (MapGet_M2_bit_0_0 a0 H2 m0 m1). elim (sumbool_of_bool (ad_eq a a0)). intro H3. - rewrite H3. rewrite (ad_div_eq _ _ H3). reflexivity. - intro H3. rewrite H3. rewrite <- H2 in H1. rewrite (ad_div_bit_neq _ _ H3 H1). reflexivity. + intro H2. rewrite MapGet_M2_bit_0_0. rewrite (H (Ndiv2 a) (Ndiv2 a0)). + rewrite (MapGet_M2_bit_0_0 a0 H2 m0 m1). elim (sumbool_of_bool (Neqb a a0)). intro H3. + rewrite H3. rewrite (Ndiv2_eq _ _ H3). reflexivity. + intro H3. rewrite H3. rewrite <- H2 in H1. rewrite (Ndiv2_bit_neq _ _ H3 H1). reflexivity. assumption. Qed. @@ -653,21 +655,21 @@ Section MapDefs. eqm (MapGet (MapMerge m m')) (fun a0:ad => match MapGet m' a0 with - | SOME y' => SOME y' - | NONE => MapGet m a0 + | Some y' => Some y' + | None => MapGet m a0 end). Proof. unfold eqm in |- *. simple induction m. intros. simpl in |- *. case (MapGet m' a); trivial. intros. simpl in |- *. rewrite (MapPut_behind_semantics m' a a0 a1). reflexivity. simple induction m'. trivial. intros. unfold MapMerge in |- *. rewrite (MapPut_semantics (M2 m0 m1) a a0 a1). - elim (sumbool_of_bool (ad_eq a a1)). intro H1. rewrite H1. rewrite (ad_eq_complete _ _ H1). + elim (sumbool_of_bool (Neqb a a1)). intro H1. rewrite H1. rewrite (Neqb_complete _ _ H1). rewrite (M1_semantics_1 a1 a0). reflexivity. intro H1. rewrite H1. rewrite (M1_semantics_2 a a1 a0 H1). reflexivity. intros. cut (MapMerge (M2 m0 m1) (M2 m2 m3) = M2 (MapMerge m0 m2) (MapMerge m1 m3)). - intro. rewrite H3. rewrite MapGet_M2_bit_0_if. rewrite (H0 m3 (ad_div_2 a)). - rewrite (H m2 (ad_div_2 a)). rewrite (MapGet_M2_bit_0_if m2 m3 a). - rewrite (MapGet_M2_bit_0_if m0 m1 a). case (ad_bit_0 a); trivial. + intro. rewrite H3. rewrite MapGet_M2_bit_0_if. rewrite (H0 m3 (Ndiv2 a)). + rewrite (H m2 (Ndiv2 a)). rewrite (MapGet_M2_bit_0_if m2 m3 a). + rewrite (MapGet_M2_bit_0_if m0 m1 a). case (Nbit0 a); trivial. reflexivity. Qed. @@ -680,7 +682,7 @@ Section MapDefs. | M1 a y => fun m':Map => match MapGet m' a with - | NONE => MapPut m' a y + | None => MapPut m' a y | _ => MapRemove m' a end | M2 m1 m2 => @@ -689,7 +691,7 @@ Section MapDefs. | M0 => m | M1 a' y' => match MapGet m a' with - | NONE => MapPut m a' y' + | None => MapPut m a' y' | _ => MapRemove m a' end | M2 m'1 m'2 => makeM2 (MapDelta m1 m'1) (MapDelta m2 m'2) @@ -701,17 +703,17 @@ Section MapDefs. Proof. unfold eqm in |- *. simple induction m. simple induction m'; reflexivity. simple induction m'. reflexivity. - unfold MapDelta in |- *. intros. elim (sumbool_of_bool (ad_eq a a1)). intro H. - rewrite <- (ad_eq_complete _ _ H). rewrite (M1_semantics_1 a a2). - rewrite (M1_semantics_1 a a0). simpl in |- *. rewrite (ad_eq_correct a). reflexivity. - intro H. rewrite (M1_semantics_2 a a1 a0 H). rewrite (ad_eq_comm a a1) in H. + unfold MapDelta in |- *. intros. elim (sumbool_of_bool (Neqb a a1)). intro H. + rewrite <- (Neqb_complete _ _ H). rewrite (M1_semantics_1 a a2). + rewrite (M1_semantics_1 a a0). simpl in |- *. rewrite (Neqb_correct a). reflexivity. + intro H. rewrite (M1_semantics_2 a a1 a0 H). rewrite (Neqb_comm a a1) in H. rewrite (M1_semantics_2 a1 a a2 H). rewrite (MapPut_semantics (M1 a a0) a1 a2 a3). - rewrite (MapPut_semantics (M1 a1 a2) a a0 a3). elim (sumbool_of_bool (ad_eq a a3)). - intro H0. rewrite H0. rewrite (ad_eq_complete _ _ H0) in H. rewrite H. - rewrite (ad_eq_complete _ _ H0). rewrite (M1_semantics_1 a3 a0). reflexivity. + rewrite (MapPut_semantics (M1 a1 a2) a a0 a3). elim (sumbool_of_bool (Neqb a a3)). + intro H0. rewrite H0. rewrite (Neqb_complete _ _ H0) in H. rewrite H. + rewrite (Neqb_complete _ _ H0). rewrite (M1_semantics_1 a3 a0). reflexivity. intro H0. rewrite H0. rewrite (M1_semantics_2 a a3 a0 H0). - elim (sumbool_of_bool (ad_eq a1 a3)). intro H1. rewrite H1. - rewrite (ad_eq_complete _ _ H1). exact (M1_semantics_1 a3 a2). + elim (sumbool_of_bool (Neqb a1 a3)). intro H1. rewrite H1. + rewrite (Neqb_complete _ _ H1). exact (M1_semantics_1 a3 a2). intro H1. rewrite H1. exact (M1_semantics_2 a1 a3 a2 H1). intros. reflexivity. simple induction m'. reflexivity. @@ -720,24 +722,25 @@ Section MapDefs. rewrite (makeM2_M2 (MapDelta m2 m0) (MapDelta m3 m1) a). rewrite (MapGet_M2_bit_0_if (MapDelta m0 m2) (MapDelta m1 m3) a). rewrite (MapGet_M2_bit_0_if (MapDelta m2 m0) (MapDelta m3 m1) a). - rewrite (H0 m3 (ad_div_2 a)). rewrite (H m2 (ad_div_2 a)). reflexivity. + rewrite (H0 m3 (Ndiv2 a)). rewrite (H m2 (Ndiv2 a)). reflexivity. Qed. Lemma MapDelta_semantics_1_1 : forall (a:ad) (y:A) (m':Map) (a0:ad), - MapGet (M1 a y) a0 = NONE -> - MapGet m' a0 = NONE -> MapGet (MapDelta (M1 a y) m') a0 = NONE. + MapGet (M1 a y) a0 = None -> + MapGet m' a0 = None -> MapGet (MapDelta (M1 a y) m') a0 = None. Proof. - intros. unfold MapDelta in |- *. elim (sumbool_of_bool (ad_eq a a0)). intro H1. - rewrite (ad_eq_complete _ _ H1) in H. rewrite (M1_semantics_1 a0 y) in H. discriminate H. - intro H1. case (MapGet m' a). rewrite (MapPut_semantics m' a y a0). rewrite H1. assumption. + intros. unfold MapDelta in |- *. elim (sumbool_of_bool (Neqb a a0)). intro H1. + rewrite (Neqb_complete _ _ H1) in H. rewrite (M1_semantics_1 a0 y) in H. discriminate H. + intro H1. case (MapGet m' a). rewrite (MapRemove_semantics m' a a0). rewrite H1. trivial. + rewrite (MapPut_semantics m' a y a0). rewrite H1. assumption. Qed. Lemma MapDelta_semantics_1 : forall (m m':Map) (a:ad), - MapGet m a = NONE -> - MapGet m' a = NONE -> MapGet (MapDelta m m') a = NONE. + MapGet m a = None -> + MapGet m' a = None -> MapGet (MapDelta m m') a = None. Proof. simple induction m. trivial. exact MapDelta_semantics_1_1. @@ -745,7 +748,7 @@ Section MapDefs. intros. rewrite (MapDelta_semantics_comm (M2 m0 m1) (M1 a a0) a1). apply MapDelta_semantics_1_1; trivial. intros. simpl in |- *. rewrite (makeM2_M2 (MapDelta m0 m2) (MapDelta m1 m3) a). - rewrite MapGet_M2_bit_0_if. elim (sumbool_of_bool (ad_bit_0 a)). intro H5. rewrite H5. + rewrite MapGet_M2_bit_0_if. elim (sumbool_of_bool (Nbit0 a)). intro H5. rewrite H5. apply H0. rewrite (MapGet_M2_bit_0_1 a H5 m0 m1) in H3. exact H3. rewrite (MapGet_M2_bit_0_1 a H5 m2 m3) in H4. exact H4. intro H5. rewrite H5. apply H. rewrite (MapGet_M2_bit_0_0 a H5 m0 m1) in H3. exact H3. @@ -754,31 +757,32 @@ Section MapDefs. Lemma MapDelta_semantics_2_1 : forall (a:ad) (y:A) (m':Map) (a0:ad) (y0:A), - MapGet (M1 a y) a0 = NONE -> - MapGet m' a0 = SOME y0 -> MapGet (MapDelta (M1 a y) m') a0 = SOME y0. + MapGet (M1 a y) a0 = None -> + MapGet m' a0 = Some y0 -> MapGet (MapDelta (M1 a y) m') a0 = Some y0. Proof. - intros. unfold MapDelta in |- *. elim (sumbool_of_bool (ad_eq a a0)). intro H1. - rewrite (ad_eq_complete _ _ H1) in H. rewrite (M1_semantics_1 a0 y) in H. discriminate H. - intro H1. case (MapGet m' a). rewrite (MapPut_semantics m' a y a0). rewrite H1. assumption. + intros. unfold MapDelta in |- *. elim (sumbool_of_bool (Neqb a a0)). intro H1. + rewrite (Neqb_complete _ _ H1) in H. rewrite (M1_semantics_1 a0 y) in H. discriminate H. + intro H1. case (MapGet m' a). rewrite (MapRemove_semantics m' a a0). rewrite H1. trivial. + rewrite (MapPut_semantics m' a y a0). rewrite H1. assumption. Qed. Lemma MapDelta_semantics_2_2 : forall (a:ad) (y:A) (m':Map) (a0:ad) (y0:A), - MapGet (M1 a y) a0 = SOME y0 -> - MapGet m' a0 = NONE -> MapGet (MapDelta (M1 a y) m') a0 = SOME y0. + MapGet (M1 a y) a0 = Some y0 -> + MapGet m' a0 = None -> MapGet (MapDelta (M1 a y) m') a0 = Some y0. Proof. - intros. unfold MapDelta in |- *. elim (sumbool_of_bool (ad_eq a a0)). intro H1. - rewrite (ad_eq_complete _ _ H1) in H. rewrite (ad_eq_complete _ _ H1). - rewrite H0. rewrite (MapPut_semantics m' a0 y a0). rewrite (ad_eq_correct a0). + intros. unfold MapDelta in |- *. elim (sumbool_of_bool (Neqb a a0)). intro H1. + rewrite (Neqb_complete _ _ H1) in H. rewrite (Neqb_complete _ _ H1). + rewrite H0. rewrite (MapPut_semantics m' a0 y a0). rewrite (Neqb_correct a0). rewrite (M1_semantics_1 a0 y) in H. simple inversion H. assumption. intro H1. rewrite (M1_semantics_2 a a0 y H1) in H. discriminate H. Qed. Lemma MapDelta_semantics_2 : forall (m m':Map) (a:ad) (y:A), - MapGet m a = NONE -> - MapGet m' a = SOME y -> MapGet (MapDelta m m') a = SOME y. + MapGet m a = None -> + MapGet m' a = Some y -> MapGet (MapDelta m m') a = Some y. Proof. simple induction m. trivial. exact MapDelta_semantics_2_1. @@ -786,7 +790,7 @@ Section MapDefs. intros. rewrite (MapDelta_semantics_comm (M2 m0 m1) (M1 a a0) a1). apply MapDelta_semantics_2_2; assumption. intros. simpl in |- *. rewrite (makeM2_M2 (MapDelta m0 m2) (MapDelta m1 m3) a). - rewrite MapGet_M2_bit_0_if. elim (sumbool_of_bool (ad_bit_0 a)). intro H5. rewrite H5. + rewrite MapGet_M2_bit_0_if. elim (sumbool_of_bool (Nbit0 a)). intro H5. rewrite H5. apply H0. rewrite <- (MapGet_M2_bit_0_1 a H5 m0 m1). assumption. rewrite <- (MapGet_M2_bit_0_1 a H5 m2 m3). assumption. intro H5. rewrite H5. apply H. rewrite <- (MapGet_M2_bit_0_0 a H5 m0 m1). assumption. @@ -795,19 +799,19 @@ Section MapDefs. Lemma MapDelta_semantics_3_1 : forall (a0:ad) (y0:A) (m':Map) (a:ad) (y y':A), - MapGet (M1 a0 y0) a = SOME y -> - MapGet m' a = SOME y' -> MapGet (MapDelta (M1 a0 y0) m') a = NONE. + MapGet (M1 a0 y0) a = Some y -> + MapGet m' a = Some y' -> MapGet (MapDelta (M1 a0 y0) m') a = None. Proof. - intros. unfold MapDelta in |- *. elim (sumbool_of_bool (ad_eq a0 a)). intro H1. - rewrite (ad_eq_complete a0 a H1). rewrite H0. rewrite (MapRemove_semantics m' a a). - rewrite (ad_eq_correct a). reflexivity. + intros. unfold MapDelta in |- *. elim (sumbool_of_bool (Neqb a0 a)). intro H1. + rewrite (Neqb_complete a0 a H1). rewrite H0. rewrite (MapRemove_semantics m' a a). + rewrite (Neqb_correct a). reflexivity. intro H1. rewrite (M1_semantics_2 a0 a y0 H1) in H. discriminate H. Qed. Lemma MapDelta_semantics_3 : forall (m m':Map) (a:ad) (y y':A), - MapGet m a = SOME y -> - MapGet m' a = SOME y' -> MapGet (MapDelta m m') a = NONE. + MapGet m a = Some y -> + MapGet m' a = Some y' -> MapGet (MapDelta m m') a = None. Proof. simple induction m. intros. discriminate H. exact MapDelta_semantics_3_1. @@ -815,10 +819,10 @@ Section MapDefs. intros. rewrite (MapDelta_semantics_comm (M2 m0 m1) (M1 a a0) a1). exact (MapDelta_semantics_3_1 a a0 (M2 m0 m1) a1 y' y H2 H1). intros. simpl in |- *. rewrite (makeM2_M2 (MapDelta m0 m2) (MapDelta m1 m3) a). - rewrite MapGet_M2_bit_0_if. elim (sumbool_of_bool (ad_bit_0 a)). intro H5. rewrite H5. - apply (H0 m3 (ad_div_2 a) y y'). rewrite <- (MapGet_M2_bit_0_1 a H5 m0 m1). assumption. + rewrite MapGet_M2_bit_0_if. elim (sumbool_of_bool (Nbit0 a)). intro H5. rewrite H5. + apply (H0 m3 (Ndiv2 a) y y'). rewrite <- (MapGet_M2_bit_0_1 a H5 m0 m1). assumption. rewrite <- (MapGet_M2_bit_0_1 a H5 m2 m3). assumption. - intro H5. rewrite H5. apply (H m2 (ad_div_2 a) y y'). + intro H5. rewrite H5. apply (H m2 (Ndiv2 a) y y'). rewrite <- (MapGet_M2_bit_0_0 a H5 m0 m1). assumption. rewrite <- (MapGet_M2_bit_0_0 a H5 m2 m3). assumption. Qed. @@ -828,9 +832,9 @@ Section MapDefs. eqm (MapGet (MapDelta m m')) (fun a0:ad => match MapGet m a0, MapGet m' a0 with - | NONE, SOME y' => SOME y' - | SOME y, NONE => SOME y - | _, _ => NONE + | None, Some y' => Some y' + | Some y, None => Some y + | _, _ => None end). Proof. unfold eqm in |- *. intros. elim (option_sum (MapGet m' a)). intro H. elim H. intros a0 H0. diff --git a/theories/IntMap/Mapaxioms.v b/theories/IntMap/Mapaxioms.v index b6a2b134..0722bcfa 100644 --- a/theories/IntMap/Mapaxioms.v +++ b/theories/IntMap/Mapaxioms.v @@ -5,14 +5,13 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Mapaxioms.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: Mapaxioms.v 8733 2006-04-25 22:52:18Z letouzey $ i*) Require Import Bool. Require Import Sumbool. -Require Import ZArith. -Require Import Addr. -Require Import Adist. -Require Import Addec. +Require Import NArith. +Require Import Ndigits. +Require Import Ndec. Require Import Map. Require Import Fset. @@ -59,8 +58,8 @@ Section MapAxioms. eqmap (MapPut A m a y) (MapMerge A m (M1 A a y)). Proof. unfold eqmap, eqm in |- *. intros. rewrite (MapPut_semantics A m a y a0). - rewrite (MapMerge_semantics A m (M1 A a y) a0). unfold MapGet at 2 in |- *. - elim (sumbool_of_bool (ad_eq a a0)); intro H; rewrite H; reflexivity. + rewrite (MapMerge_semantics A m (M1 A a y) a0). unfold MapGet at 2. + elim (sumbool_of_bool (Neqb a a0)); intro H; rewrite H; reflexivity. Qed. Lemma MapPut_ext : @@ -70,7 +69,7 @@ Section MapAxioms. Proof. unfold eqmap, eqm in |- *. intros. rewrite (MapPut_semantics A m' a y a0). rewrite (MapPut_semantics A m a y a0). - case (ad_eq a a0); [ reflexivity | apply H ]. + case (Neqb a a0); [ reflexivity | apply H ]. Qed. Lemma MapPut_behind_as_Merge : @@ -115,7 +114,7 @@ Section MapAxioms. forall m m':Map A, eqmap (MapMerge A m m') (M0 A) -> eqmap m (M0 A). Proof. unfold eqmap, eqm in |- *. intros. cut (MapGet A (MapMerge A m m') a = MapGet A (M0 A) a). - rewrite (MapMerge_semantics A m m' a). case (MapGet A m' a). trivial. + rewrite (MapMerge_semantics A m m' a). case (MapGet A m' a); trivial. intros. discriminate H0. exact (H a). Qed. @@ -124,8 +123,7 @@ Section MapAxioms. forall m m':Map A, eqmap (MapMerge A m m') (M0 A) -> eqmap m' (M0 A). Proof. unfold eqmap, eqm in |- *. intros. cut (MapGet A (MapMerge A m m') a = MapGet A (M0 A) a). - rewrite (MapMerge_semantics A m m' a). case (MapGet A m' a). trivial. - intros. discriminate H0. + rewrite (MapMerge_semantics A m m' a). case (MapGet A m' a); trivial. exact (H a). Qed. @@ -190,8 +188,8 @@ Section MapAxioms. eqmap (MapRemove A m a) (MapDomRestrBy A B m (M1 B a y)). Proof. unfold eqmap, eqm in |- *. intros. rewrite (MapRemove_semantics A m a a0). - rewrite (MapDomRestrBy_semantics A B m (M1 B a y) a0). elim (sumbool_of_bool (ad_eq a a0)). - intro H. rewrite H. rewrite (ad_eq_complete a a0 H). rewrite (M1_semantics_1 B a0 y). + rewrite (MapDomRestrBy_semantics A B m (M1 B a y) a0). elim (sumbool_of_bool (Neqb a a0)). + intro H. rewrite H. rewrite (Neqb_complete a a0 H). rewrite (M1_semantics_1 B a0 y). reflexivity. intro H. rewrite H. rewrite (M1_semantics_2 B a a0 y H). reflexivity. Qed. @@ -202,7 +200,7 @@ Section MapAxioms. Proof. unfold eqmap, eqm in |- *. intros. rewrite (MapRemove_semantics A m' a a0). rewrite (MapRemove_semantics A m a a0). - case (ad_eq a a0); [ reflexivity | apply H ]. + case (Neqb a a0); [ reflexivity | apply H ]. Qed. Lemma MapDomRestrTo_empty_m_1 : @@ -259,7 +257,7 @@ Section MapAxioms. elim (MapDom_semantics_2 B m' a H). intros y H0. rewrite H0. unfold in_FSet, in_dom in H. generalize H. case (MapGet unit (MapDom B m') a); trivial. intro H1. discriminate H1. intro H. rewrite (MapDom_semantics_4 B m' a H). unfold in_FSet, in_dom in H. - generalize H. case (MapGet unit (MapDom B m') a). trivial. + generalize H. case (MapGet unit (MapDom B m') a); trivial. intros H0 H1. discriminate H1. Qed. @@ -298,7 +296,7 @@ Section MapAxioms. unfold in_FSet, in_dom in H. generalize H. case (MapGet unit (MapDom B m') a); trivial. intro H1. discriminate H1. intro H. rewrite (MapDom_semantics_4 B m' a H). unfold in_FSet, in_dom in H. - generalize H. case (MapGet unit (MapDom B m') a). trivial. + generalize H. case (MapGet unit (MapDom B m') a); trivial. intros H0 H1. discriminate H1. Qed. diff --git a/theories/IntMap/Mapc.v b/theories/IntMap/Mapc.v index d7a779ff..163373bf 100644 --- a/theories/IntMap/Mapc.v +++ b/theories/IntMap/Mapc.v @@ -5,15 +5,12 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Mapc.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: Mapc.v 8733 2006-04-25 22:52:18Z letouzey $ i*) Require Import Bool. Require Import Sumbool. Require Import Arith. -Require Import ZArith. -Require Import Addr. -Require Import Adist. -Require Import Addec. +Require Import NArith. Require Import Map. Require Import Mapaxioms. Require Import Fset. diff --git a/theories/IntMap/Mapcanon.v b/theories/IntMap/Mapcanon.v index 23e0669e..33741b98 100644 --- a/theories/IntMap/Mapcanon.v +++ b/theories/IntMap/Mapcanon.v @@ -5,15 +5,14 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Mapcanon.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: Mapcanon.v 8733 2006-04-25 22:52:18Z letouzey $ i*) Require Import Bool. Require Import Sumbool. Require Import Arith. -Require Import ZArith. -Require Import Addr. -Require Import Adist. -Require Import Addec. +Require Import NArith. +Require Import Ndigits. +Require Import Ndec. Require Import Map. Require Import Mapaxioms. Require Import Mapiter. @@ -57,37 +56,37 @@ Section MapCanon. forall m0 m1 m2 m3:Map A, eqmap A (M2 A m0 m1) (M2 A m2 m3) -> eqmap A m0 m2. Proof. - unfold eqmap, eqm in |- *. intros. rewrite <- (ad_double_div_2 a). - rewrite <- (MapGet_M2_bit_0_0 A _ (ad_double_bit_0 a) m0 m1). - rewrite <- (MapGet_M2_bit_0_0 A _ (ad_double_bit_0 a) m2 m3). - exact (H (ad_double a)). + unfold eqmap, eqm in |- *. intros. rewrite <- (Ndouble_div2 a). + rewrite <- (MapGet_M2_bit_0_0 A _ (Ndouble_bit0 a) m0 m1). + rewrite <- (MapGet_M2_bit_0_0 A _ (Ndouble_bit0 a) m2 m3). + exact (H (Ndouble a)). Qed. Lemma M2_eqmap_2 : forall m0 m1 m2 m3:Map A, eqmap A (M2 A m0 m1) (M2 A m2 m3) -> eqmap A m1 m3. Proof. - unfold eqmap, eqm in |- *. intros. rewrite <- (ad_double_plus_un_div_2 a). - rewrite <- (MapGet_M2_bit_0_1 A _ (ad_double_plus_un_bit_0 a) m0 m1). - rewrite <- (MapGet_M2_bit_0_1 A _ (ad_double_plus_un_bit_0 a) m2 m3). - exact (H (ad_double_plus_un a)). + unfold eqmap, eqm in |- *. intros. rewrite <- (Ndouble_plus_one_div2 a). + rewrite <- (MapGet_M2_bit_0_1 A _ (Ndouble_plus_one_bit0 a) m0 m1). + rewrite <- (MapGet_M2_bit_0_1 A _ (Ndouble_plus_one_bit0 a) m2 m3). + exact (H (Ndouble_plus_one a)). Qed. Lemma mapcanon_unique : forall m m':Map A, mapcanon m -> mapcanon m' -> eqmap A m m' -> m = m'. Proof. simple induction m. simple induction m'. trivial. - intros a y H H0 H1. cut (NONE A = MapGet A (M1 A a y) a). simpl in |- *. rewrite (ad_eq_correct a). + intros a y H H0 H1. cut (None = MapGet A (M1 A a y) a). simpl in |- *. rewrite (Neqb_correct a). intro. discriminate H2. exact (H1 a). intros. cut (2 <= MapCard A (M0 A)). intro. elim (le_Sn_O _ H4). rewrite (MapCard_ext A _ _ H3). exact (mapcanon_M2 _ _ H2). - intros a y. simple induction m'. intros. cut (MapGet A (M1 A a y) a = NONE A). simpl in |- *. - rewrite (ad_eq_correct a). intro. discriminate H2. + intros a y. simple induction m'. intros. cut (MapGet A (M1 A a y) a = None). simpl in |- *. + rewrite (Neqb_correct a). intro. discriminate H2. exact (H1 a). intros a0 y0 H H0 H1. cut (MapGet A (M1 A a y) a = MapGet A (M1 A a0 y0) a). simpl in |- *. - rewrite (ad_eq_correct a). intro. elim (sumbool_of_bool (ad_eq a0 a)). intro H3. - rewrite H3 in H2. inversion H2. rewrite (ad_eq_complete _ _ H3). reflexivity. + rewrite (Neqb_correct a). intro. elim (sumbool_of_bool (Neqb a0 a)). intro H3. + rewrite H3 in H2. inversion H2. rewrite (Neqb_complete _ _ H3). reflexivity. intro H3. rewrite H3 in H2. discriminate H2. exact (H1 a). intros. cut (2 <= MapCard A (M1 A a y)). intro. elim (le_Sn_O _ (le_S_n _ _ H4)). @@ -109,19 +108,19 @@ Section MapCanon. Lemma MapPut1_canon : forall (p:positive) (a a':ad) (y y':A), mapcanon (MapPut1 A a y a' y' p). Proof. - simple induction p. simpl in |- *. intros. case (ad_bit_0 a). apply M2_canon. apply M1_canon. + simple induction p. simpl in |- *. intros. case (Nbit0 a). apply M2_canon. apply M1_canon. apply M1_canon. apply le_n. apply M2_canon. apply M1_canon. apply M1_canon. apply le_n. - simpl in |- *. intros. case (ad_bit_0 a). apply M2_canon. apply M0_canon. + simpl in |- *. intros. case (Nbit0 a). apply M2_canon. apply M0_canon. apply H. simpl in |- *. rewrite MapCard_Put1_equals_2. apply le_n. apply M2_canon. apply H. apply M0_canon. simpl in |- *. rewrite MapCard_Put1_equals_2. apply le_n. - simpl in |- *. simpl in |- *. intros. case (ad_bit_0 a). apply M2_canon. apply M1_canon. + simpl in |- *. simpl in |- *. intros. case (Nbit0 a). apply M2_canon. apply M1_canon. apply M1_canon. simpl in |- *. apply le_n. apply M2_canon. apply M1_canon. @@ -134,28 +133,28 @@ Section MapCanon. mapcanon m -> forall (a:ad) (y:A), mapcanon (MapPut A m a y). Proof. simple induction m. intros. simpl in |- *. apply M1_canon. - intros a0 y0 H a y. simpl in |- *. case (ad_xor a0 a). apply M1_canon. + intros a0 y0 H a y. simpl in |- *. case (Nxor a0 a). apply M1_canon. intro. apply MapPut1_canon. intros. simpl in |- *. elim a. apply M2_canon. apply H. exact (mapcanon_M2_1 m0 m1 H1). exact (mapcanon_M2_2 m0 m1 H1). simpl in |- *. apply le_trans with (m := MapCard A m0 + MapCard A m1). exact (mapcanon_M2 _ _ H1). - apply plus_le_compat. exact (MapCard_Put_lb A m0 ad_z y). + apply plus_le_compat. exact (MapCard_Put_lb A m0 N0 y). apply le_n. intro. case p. intro. apply M2_canon. exact (mapcanon_M2_1 m0 m1 H1). apply H0. exact (mapcanon_M2_2 m0 m1 H1). simpl in |- *. apply le_trans with (m := MapCard A m0 + MapCard A m1). exact (mapcanon_M2 m0 m1 H1). - apply plus_le_compat_l. exact (MapCard_Put_lb A m1 (ad_x p0) y). + apply plus_le_compat_l. exact (MapCard_Put_lb A m1 (Npos p0) y). intro. apply M2_canon. apply H. exact (mapcanon_M2_1 m0 m1 H1). exact (mapcanon_M2_2 m0 m1 H1). simpl in |- *. apply le_trans with (m := MapCard A m0 + MapCard A m1). exact (mapcanon_M2 m0 m1 H1). - apply plus_le_compat_r. exact (MapCard_Put_lb A m0 (ad_x p0) y). + apply plus_le_compat_r. exact (MapCard_Put_lb A m0 (Npos p0) y). apply M2_canon. apply (mapcanon_M2_1 m0 m1 H1). apply H0. apply (mapcanon_M2_2 m0 m1 H1). simpl in |- *. apply le_trans with (m := MapCard A m0 + MapCard A m1). exact (mapcanon_M2 m0 m1 H1). - apply plus_le_compat_l. exact (MapCard_Put_lb A m1 ad_z y). + apply plus_le_compat_l. exact (MapCard_Put_lb A m1 N0 y). Qed. Lemma MapPut_behind_canon : @@ -163,37 +162,37 @@ Section MapCanon. mapcanon m -> forall (a:ad) (y:A), mapcanon (MapPut_behind A m a y). Proof. simple induction m. intros. simpl in |- *. apply M1_canon. - intros a0 y0 H a y. simpl in |- *. case (ad_xor a0 a). apply M1_canon. + intros a0 y0 H a y. simpl in |- *. case (Nxor a0 a). apply M1_canon. intro. apply MapPut1_canon. intros. simpl in |- *. elim a. apply M2_canon. apply H. exact (mapcanon_M2_1 m0 m1 H1). exact (mapcanon_M2_2 m0 m1 H1). simpl in |- *. apply le_trans with (m := MapCard A m0 + MapCard A m1). exact (mapcanon_M2 _ _ H1). - apply plus_le_compat. rewrite MapCard_Put_behind_Put. exact (MapCard_Put_lb A m0 ad_z y). + apply plus_le_compat. rewrite MapCard_Put_behind_Put. exact (MapCard_Put_lb A m0 N0 y). apply le_n. intro. case p. intro. apply M2_canon. exact (mapcanon_M2_1 m0 m1 H1). apply H0. exact (mapcanon_M2_2 m0 m1 H1). simpl in |- *. apply le_trans with (m := MapCard A m0 + MapCard A m1). exact (mapcanon_M2 m0 m1 H1). - apply plus_le_compat_l. rewrite MapCard_Put_behind_Put. exact (MapCard_Put_lb A m1 (ad_x p0) y). + apply plus_le_compat_l. rewrite MapCard_Put_behind_Put. exact (MapCard_Put_lb A m1 (Npos p0) y). intro. apply M2_canon. apply H. exact (mapcanon_M2_1 m0 m1 H1). exact (mapcanon_M2_2 m0 m1 H1). simpl in |- *. apply le_trans with (m := MapCard A m0 + MapCard A m1). exact (mapcanon_M2 m0 m1 H1). - apply plus_le_compat_r. rewrite MapCard_Put_behind_Put. exact (MapCard_Put_lb A m0 (ad_x p0) y). + apply plus_le_compat_r. rewrite MapCard_Put_behind_Put. exact (MapCard_Put_lb A m0 (Npos p0) y). apply M2_canon. apply (mapcanon_M2_1 m0 m1 H1). apply H0. apply (mapcanon_M2_2 m0 m1 H1). simpl in |- *. apply le_trans with (m := MapCard A m0 + MapCard A m1). exact (mapcanon_M2 m0 m1 H1). - apply plus_le_compat_l. rewrite MapCard_Put_behind_Put. exact (MapCard_Put_lb A m1 ad_z y). + apply plus_le_compat_l. rewrite MapCard_Put_behind_Put. exact (MapCard_Put_lb A m1 N0 y). Qed. Lemma makeM2_canon : forall m m':Map A, mapcanon m -> mapcanon m' -> mapcanon (makeM2 A m m'). Proof. intro. case m. intro. case m'. intros. exact M0_canon. - intros a y H H0. exact (M1_canon (ad_double_plus_un a) y). + intros a y H H0. exact (M1_canon (Ndouble_plus_one a) y). intros. simpl in |- *. apply M2_canon; try assumption. exact (mapcanon_M2 m0 m1 H0). - intros a y m'. case m'. intros. exact (M1_canon (ad_double a) y). + intros a y m'. case m'. intros. exact (M1_canon (Ndouble a) y). intros a0 y0 H H0. simpl in |- *. apply M2_canon; try assumption. apply le_n. intros. simpl in |- *. apply M2_canon; try assumption. apply le_trans with (m := MapCard A (M2 A m0 m1)). exact (mapcanon_M2 _ _ H0). @@ -216,7 +215,7 @@ Section MapCanon. intros. simpl in |- *. unfold eqmap, eqm in |- *. intro. rewrite (makeM2_M2 A (MapCanonicalize m0) (MapCanonicalize m1) a). rewrite MapGet_M2_bit_0_if. rewrite MapGet_M2_bit_0_if. - rewrite <- (H (ad_div_2 a)). rewrite <- (H0 (ad_div_2 a)). reflexivity. + rewrite <- (H (Ndiv2 a)). rewrite <- (H0 (Ndiv2 a)). reflexivity. Qed. Lemma mapcanon_exists_2 : forall m:Map A, mapcanon (MapCanonicalize m). @@ -237,9 +236,9 @@ Section MapCanon. forall m:Map A, mapcanon m -> forall a:ad, mapcanon (MapRemove A m a). Proof. simple induction m. intros. exact M0_canon. - intros a y H a0. simpl in |- *. case (ad_eq a a0). exact M0_canon. + intros a y H a0. simpl in |- *. case (Neqb a a0). exact M0_canon. assumption. - intros. simpl in |- *. case (ad_bit_0 a). apply makeM2_canon. exact (mapcanon_M2_1 _ _ H1). + intros. simpl in |- *. case (Nbit0 a). apply makeM2_canon. exact (mapcanon_M2_1 _ _ H1). apply H0. exact (mapcanon_M2_2 _ _ H1). apply makeM2_canon. apply H. exact (mapcanon_M2_1 _ _ H1). exact (mapcanon_M2_2 _ _ H1). @@ -265,12 +264,13 @@ Section MapCanon. forall m m':Map A, mapcanon m -> mapcanon m' -> mapcanon (MapDelta A m m'). Proof. simple induction m. intros. exact H0. - simpl in |- *. intros a y m' H H0. case (MapGet A m' a). exact (MapPut_canon m' H0 a y). + simpl in |- *. intros a y m' H H0. case (MapGet A m' a). intro. exact (MapRemove_canon m' H0 a). + exact (MapPut_canon m' H0 a y). simple induction m'. intros. exact H1. - unfold MapDelta in |- *. intros a y H1 H2. case (MapGet A (M2 A m0 m1) a). - exact (MapPut_canon _ H1 a y). + unfold MapDelta in |- *. intros a y H1 H2. case (MapGet A (M2 A m0 m1) a). intro. exact (MapRemove_canon _ H1 a). + exact (MapPut_canon _ H1 a y). intros. simpl in |- *. apply makeM2_canon. apply H. exact (mapcanon_M2_1 _ _ H3). exact (mapcanon_M2_1 _ _ H4). apply H0. exact (mapcanon_M2_2 _ _ H3). @@ -284,11 +284,13 @@ Section MapCanon. mapcanon m -> forall m':Map B, mapcanon (MapDomRestrTo A B m m'). Proof. simple induction m. intros. exact M0_canon. - simpl in |- *. intros a y H m'. case (MapGet B m' a). exact M0_canon. + simpl in |- *. intros a y H m'. case (MapGet B m' a). intro. apply M1_canon. + exact M0_canon. simple induction m'. exact M0_canon. - unfold MapDomRestrTo in |- *. intros a y. case (MapGet A (M2 A m0 m1) a). exact M0_canon. + unfold MapDomRestrTo in |- *. intros a y. case (MapGet A (M2 A m0 m1) a). intro. apply M1_canon. + exact M0_canon. intros. simpl in |- *. apply makeM2_canon. apply H. exact (mapcanon_M2_1 m0 m1 H1). apply H0. exact (mapcanon_M2_2 m0 m1 H1). Qed. @@ -298,10 +300,10 @@ Section MapCanon. mapcanon m -> forall m':Map B, mapcanon (MapDomRestrBy A B m m'). Proof. simple induction m. intros. exact M0_canon. - simpl in |- *. intros a y H m'. case (MapGet B m' a). assumption. + simpl in |- *. intros a y H m'. case (MapGet B m' a); try assumption. intro. exact M0_canon. simple induction m'. exact H1. - intros a y. simpl in |- *. case (ad_bit_0 a). apply makeM2_canon. exact (mapcanon_M2_1 _ _ H1). + intros a y. simpl in |- *. case (Nbit0 a). apply makeM2_canon. exact (mapcanon_M2_1 _ _ H1). apply MapRemove_canon. exact (mapcanon_M2_2 _ _ H1). apply makeM2_canon. apply MapRemove_canon. exact (mapcanon_M2_1 _ _ H1). exact (mapcanon_M2_2 _ _ H1). diff --git a/theories/IntMap/Mapcard.v b/theories/IntMap/Mapcard.v index 35efac47..36be9bf9 100644 --- a/theories/IntMap/Mapcard.v +++ b/theories/IntMap/Mapcard.v @@ -5,15 +5,14 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Mapcard.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: Mapcard.v 8733 2006-04-25 22:52:18Z letouzey $ i*) Require Import Bool. Require Import Sumbool. Require Import Arith. -Require Import ZArith. -Require Import Addr. -Require Import Adist. -Require Import Addec. +Require Import NArith. +Require Import Ndigits. +Require Import Ndec. Require Import Map. Require Import Mapaxioms. Require Import Mapiter. @@ -38,80 +37,80 @@ Section MapCard. Qed. Lemma MapCard_is_O : - forall m:Map A, MapCard A m = 0 -> forall a:ad, MapGet A m a = NONE A. + forall m:Map A, MapCard A m = 0 -> forall a:ad, MapGet A m a = None. Proof. simple induction m. trivial. intros a y H. discriminate H. intros. simpl in H1. elim (plus_is_O _ _ H1). intros. rewrite (MapGet_M2_bit_0_if A m0 m1 a). - case (ad_bit_0 a). apply H0. assumption. + case (Nbit0 a). apply H0. assumption. apply H. assumption. Qed. Lemma MapCard_is_not_O : forall (m:Map A) (a:ad) (y:A), - MapGet A m a = SOME A y -> {n : nat | MapCard A m = S n}. + MapGet A m a = Some y -> {n : nat | MapCard A m = S n}. Proof. simple induction m. intros. discriminate H. - intros a y a0 y0 H. simpl in H. elim (sumbool_of_bool (ad_eq a a0)). intro H0. split with 0. + intros a y a0 y0 H. simpl in H. elim (sumbool_of_bool (Neqb a a0)). intro H0. split with 0. reflexivity. intro H0. rewrite H0 in H. discriminate H. - intros. elim (sumbool_of_bool (ad_bit_0 a)). intro H2. - rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1) in H1. elim (H0 (ad_div_2 a) y H1). intros n H3. + intros. elim (sumbool_of_bool (Nbit0 a)). intro H2. + rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1) in H1. elim (H0 (Ndiv2 a) y H1). intros n H3. simpl in |- *. rewrite H3. split with (MapCard A m0 + n). rewrite <- (plus_Snm_nSm (MapCard A m0) n). reflexivity. - intro H2. rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1) in H1. elim (H (ad_div_2 a) y H1). + intro H2. rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1) in H1. elim (H (Ndiv2 a) y H1). intros n H3. simpl in |- *. rewrite H3. split with (n + MapCard A m1). reflexivity. Qed. Lemma MapCard_is_one : forall m:Map A, - MapCard A m = 1 -> {a : ad & {y : A | MapGet A m a = SOME A y}}. + MapCard A m = 1 -> {a : ad & {y : A | MapGet A m a = Some y}}. Proof. simple induction m. intro. discriminate H. intros a y H. split with a. split with y. apply M1_semantics_1. intros. simpl in H1. elim (plus_is_one (MapCard A m0) (MapCard A m1) H1). - intro H2. elim H2. intros. elim (H0 H4). intros a H5. split with (ad_double_plus_un a). - rewrite (MapGet_M2_bit_0_1 A _ (ad_double_plus_un_bit_0 a) m0 m1). - rewrite ad_double_plus_un_div_2. exact H5. - intro H2. elim H2. intros. elim (H H3). intros a H5. split with (ad_double a). - rewrite (MapGet_M2_bit_0_0 A _ (ad_double_bit_0 a) m0 m1). - rewrite ad_double_div_2. exact H5. + intro H2. elim H2. intros. elim (H0 H4). intros a H5. split with (Ndouble_plus_one a). + rewrite (MapGet_M2_bit_0_1 A _ (Ndouble_plus_one_bit0 a) m0 m1). + rewrite Ndouble_plus_one_div2. exact H5. + intro H2. elim H2. intros. elim (H H3). intros a H5. split with (Ndouble a). + rewrite (MapGet_M2_bit_0_0 A _ (Ndouble_bit0 a) m0 m1). + rewrite Ndouble_div2. exact H5. Qed. Lemma MapCard_is_one_unique : forall m:Map A, MapCard A m = 1 -> forall (a a':ad) (y y':A), - MapGet A m a = SOME A y -> - MapGet A m a' = SOME A y' -> a = a' /\ y = y'. + MapGet A m a = Some y -> + MapGet A m a' = Some y' -> a = a' /\ y = y'. Proof. simple induction m. intro. discriminate H. - intros. elim (sumbool_of_bool (ad_eq a a1)). intro H2. rewrite (ad_eq_complete _ _ H2) in H0. - rewrite (M1_semantics_1 A a1 a0) in H0. inversion H0. elim (sumbool_of_bool (ad_eq a a')). - intro H5. rewrite (ad_eq_complete _ _ H5) in H1. rewrite (M1_semantics_1 A a' a0) in H1. - inversion H1. rewrite <- (ad_eq_complete _ _ H2). rewrite <- (ad_eq_complete _ _ H5). + intros. elim (sumbool_of_bool (Neqb a a1)). intro H2. rewrite (Neqb_complete _ _ H2) in H0. + rewrite (M1_semantics_1 A a1 a0) in H0. inversion H0. elim (sumbool_of_bool (Neqb a a')). + intro H5. rewrite (Neqb_complete _ _ H5) in H1. rewrite (M1_semantics_1 A a' a0) in H1. + inversion H1. rewrite <- (Neqb_complete _ _ H2). rewrite <- (Neqb_complete _ _ H5). rewrite <- H4. rewrite <- H6. split; reflexivity. intro H5. rewrite (M1_semantics_2 A a a' a0 H5) in H1. discriminate H1. intro H2. rewrite (M1_semantics_2 A a a1 a0 H2) in H0. discriminate H0. intros. simpl in H1. elim (plus_is_one _ _ H1). intro H4. elim H4. intros. - rewrite (MapGet_M2_bit_0_if A m0 m1 a) in H2. elim (sumbool_of_bool (ad_bit_0 a)). + rewrite (MapGet_M2_bit_0_if A m0 m1 a) in H2. elim (sumbool_of_bool (Nbit0 a)). intro H7. rewrite H7 in H2. rewrite (MapGet_M2_bit_0_if A m0 m1 a') in H3. - elim (sumbool_of_bool (ad_bit_0 a')). intro H8. rewrite H8 in H3. elim (H0 H6 _ _ _ _ H2 H3). - intros. split. rewrite <- (ad_div_2_double_plus_un a H7). - rewrite <- (ad_div_2_double_plus_un a' H8). rewrite H9. reflexivity. + elim (sumbool_of_bool (Nbit0 a')). intro H8. rewrite H8 in H3. elim (H0 H6 _ _ _ _ H2 H3). + intros. split. rewrite <- (Ndiv2_double_plus_one a H7). + rewrite <- (Ndiv2_double_plus_one a' H8). rewrite H9. reflexivity. assumption. - intro H8. rewrite H8 in H3. rewrite (MapCard_is_O m0 H5 (ad_div_2 a')) in H3. + intro H8. rewrite H8 in H3. rewrite (MapCard_is_O m0 H5 (Ndiv2 a')) in H3. discriminate H3. - intro H7. rewrite H7 in H2. rewrite (MapCard_is_O m0 H5 (ad_div_2 a)) in H2. + intro H7. rewrite H7 in H2. rewrite (MapCard_is_O m0 H5 (Ndiv2 a)) in H2. discriminate H2. intro H4. elim H4. intros. rewrite (MapGet_M2_bit_0_if A m0 m1 a) in H2. - elim (sumbool_of_bool (ad_bit_0 a)). intro H7. rewrite H7 in H2. - rewrite (MapCard_is_O m1 H6 (ad_div_2 a)) in H2. discriminate H2. + elim (sumbool_of_bool (Nbit0 a)). intro H7. rewrite H7 in H2. + rewrite (MapCard_is_O m1 H6 (Ndiv2 a)) in H2. discriminate H2. intro H7. rewrite H7 in H2. rewrite (MapGet_M2_bit_0_if A m0 m1 a') in H3. - elim (sumbool_of_bool (ad_bit_0 a')). intro H8. rewrite H8 in H3. - rewrite (MapCard_is_O m1 H6 (ad_div_2 a')) in H3. discriminate H3. + elim (sumbool_of_bool (Nbit0 a')). intro H8. rewrite H8 in H3. + rewrite (MapCard_is_O m1 H6 (Ndiv2 a')) in H3. discriminate H3. intro H8. rewrite H8 in H3. elim (H H5 _ _ _ _ H2 H3). intros. split. - rewrite <- (ad_div_2_double a H7). rewrite <- (ad_div_2_double a' H8). + rewrite <- (Ndiv2_double a H7). rewrite <- (Ndiv2_double a' H8). rewrite H9. reflexivity. assumption. Qed. @@ -139,8 +138,8 @@ Section MapCard. Proof. simple induction m. trivial. trivial. - intros. simpl in |- *. rewrite <- (H (fun a0:ad => pf (ad_double a0))). - rewrite <- (H0 (fun a0:ad => pf (ad_double_plus_un a0))). reflexivity. + intros. simpl in |- *. rewrite <- (H (fun a0:ad => pf (Ndouble a0))). + rewrite <- (H0 (fun a0:ad => pf (Ndouble_plus_one a0))). reflexivity. Qed. Lemma MapCard_as_Fold : @@ -164,10 +163,10 @@ Section MapCard. forall (p:positive) (a a':ad) (y y':A), MapCard A (MapPut1 A a y a' y' p) = 2. Proof. - simple induction p. intros. simpl in |- *. case (ad_bit_0 a); reflexivity. - intros. simpl in |- *. case (ad_bit_0 a). exact (H (ad_div_2 a) (ad_div_2 a') y y'). - simpl in |- *. rewrite <- plus_n_O. exact (H (ad_div_2 a) (ad_div_2 a') y y'). - intros. simpl in |- *. case (ad_bit_0 a); reflexivity. + simple induction p. intros. simpl in |- *. case (Nbit0 a); reflexivity. + intros. simpl in |- *. case (Nbit0 a). exact (H (Ndiv2 a) (Ndiv2 a') y y'). + simpl in |- *. rewrite <- plus_n_O. exact (H (Ndiv2 a) (Ndiv2 a') y y'). + intros. simpl in |- *. case (Nbit0 a); reflexivity. Qed. Lemma MapCard_Put_sum : @@ -177,17 +176,17 @@ Section MapCard. Proof. simple induction m. simpl in |- *. intros. rewrite H in H1. simpl in H1. right. rewrite H0. rewrite H1. reflexivity. - intros a y m' a0 y0 n n' H H0 H1. simpl in H. elim (ad_sum (ad_xor a a0)). intro H2. + intros a y m' a0 y0 n n' H H0 H1. simpl in H. elim (Ndiscr (Nxor a a0)). intro H2. elim H2. intros p H3. rewrite H3 in H. rewrite H in H1. rewrite (MapCard_Put1_equals_2 p a a0 y y0) in H1. simpl in H0. right. rewrite H0. rewrite H1. reflexivity. intro H2. rewrite H2 in H. rewrite H in H1. simpl in H1. simpl in H0. left. rewrite H0. rewrite H1. reflexivity. intros. simpl in H2. rewrite (MapPut_semantics_3_1 A m0 m1 a y) in H1. - elim (sumbool_of_bool (ad_bit_0 a)). intro H4. rewrite H4 in H1. + elim (sumbool_of_bool (Nbit0 a)). intro H4. rewrite H4 in H1. elim - (H0 (MapPut A m1 (ad_div_2 a) y) (ad_div_2 a) y ( - MapCard A m1) (MapCard A (MapPut A m1 (ad_div_2 a) y)) ( + (H0 (MapPut A m1 (Ndiv2 a) y) (Ndiv2 a) y ( + MapCard A m1) (MapCard A (MapPut A m1 (Ndiv2 a) y)) ( refl_equal _) (refl_equal _) (refl_equal _)). intro H5. rewrite H1 in H3. simpl in H3. rewrite H5 in H3. rewrite <- H2 in H3. left. assumption. @@ -196,8 +195,8 @@ Section MapCard. simpl in H3. rewrite <- H2 in H3. right. assumption. intro H4. rewrite H4 in H1. elim - (H (MapPut A m0 (ad_div_2 a) y) (ad_div_2 a) y ( - MapCard A m0) (MapCard A (MapPut A m0 (ad_div_2 a) y)) ( + (H (MapPut A m0 (Ndiv2 a) y) (Ndiv2 a) y ( + MapCard A m0) (MapCard A (MapPut A m0 (Ndiv2 a) y)) ( refl_equal _) (refl_equal _) (refl_equal _)). intro H5. rewrite H1 in H3. simpl in H3. rewrite H5 in H3. rewrite <- H2 in H3. left. assumption. @@ -233,35 +232,35 @@ Section MapCard. Lemma MapCard_Put_1 : forall (m:Map A) (a:ad) (y:A), MapCard A (MapPut A m a y) = MapCard A m -> - {y : A | MapGet A m a = SOME A y}. + {y : A | MapGet A m a = Some y}. Proof. simple induction m. intros. discriminate H. - intros a y a0 y0 H. simpl in H. elim (ad_sum (ad_xor a a0)). intro H0. elim H0. + intros a y a0 y0 H. simpl in H. elim (Ndiscr (Nxor a a0)). intro H0. elim H0. intros p H1. rewrite H1 in H. rewrite (MapCard_Put1_equals_2 p a a0 y y0) in H. discriminate H. - intro H0. rewrite H0 in H. rewrite (ad_xor_eq _ _ H0). split with y. apply M1_semantics_1. - intros. rewrite (MapPut_semantics_3_1 A m0 m1 a y) in H1. elim (sumbool_of_bool (ad_bit_0 a)). - intro H2. rewrite H2 in H1. simpl in H1. elim (H0 (ad_div_2 a) y ((fun n m p:nat => plus_reg_l m p n) _ _ _ H1)). + intro H0. rewrite H0 in H. rewrite (Nxor_eq _ _ H0). split with y. apply M1_semantics_1. + intros. rewrite (MapPut_semantics_3_1 A m0 m1 a y) in H1. elim (sumbool_of_bool (Nbit0 a)). + intro H2. rewrite H2 in H1. simpl in H1. elim (H0 (Ndiv2 a) y ((fun n m p:nat => plus_reg_l m p n) _ _ _ H1)). intros y0 H3. split with y0. rewrite <- H3. exact (MapGet_M2_bit_0_1 A a H2 m0 m1). intro H2. rewrite H2 in H1. simpl in H1. rewrite - (plus_comm (MapCard A (MapPut A m0 (ad_div_2 a) y)) (MapCard A m1)) + (plus_comm (MapCard A (MapPut A m0 (Ndiv2 a) y)) (MapCard A m1)) in H1. rewrite (plus_comm (MapCard A m0) (MapCard A m1)) in H1. - elim (H (ad_div_2 a) y ((fun n m p:nat => plus_reg_l m p n) _ _ _ H1)). intros y0 H3. split with y0. + elim (H (Ndiv2 a) y ((fun n m p:nat => plus_reg_l m p n) _ _ _ H1)). intros y0 H3. split with y0. rewrite <- H3. exact (MapGet_M2_bit_0_0 A a H2 m0 m1). Qed. Lemma MapCard_Put_2 : forall (m:Map A) (a:ad) (y:A), - MapCard A (MapPut A m a y) = S (MapCard A m) -> MapGet A m a = NONE A. + MapCard A (MapPut A m a y) = S (MapCard A m) -> MapGet A m a = None. Proof. simple induction m. trivial. - intros. simpl in H. elim (sumbool_of_bool (ad_eq a a1)). intro H0. - rewrite (ad_eq_complete _ _ H0) in H. rewrite (ad_xor_nilpotent a1) in H. discriminate H. + intros. simpl in H. elim (sumbool_of_bool (Neqb a a1)). intro H0. + rewrite (Neqb_complete _ _ H0) in H. rewrite (Nxor_nilpotent a1) in H. discriminate H. intro H0. exact (M1_semantics_2 A a a1 a0 H0). - intros. elim (sumbool_of_bool (ad_bit_0 a)). intro H2. - rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1). apply (H0 (ad_div_2 a) y). + intros. elim (sumbool_of_bool (Nbit0 a)). intro H2. + rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1). apply (H0 (Ndiv2 a) y). apply (fun n m p:nat => plus_reg_l m p n) with (n := MapCard A m0). rewrite <- (plus_Snm_nSm (MapCard A m0) (MapCard A m1)). simpl in H1. simpl in |- *. rewrite <- H1. clear H1. @@ -269,11 +268,11 @@ Section MapCard. induction p. reflexivity. discriminate H2. reflexivity. - intro H2. rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1). apply (H (ad_div_2 a) y). + intro H2. rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1). apply (H (Ndiv2 a) y). cut - (MapCard A (MapPut A m0 (ad_div_2 a) y) + MapCard A m1 = + (MapCard A (MapPut A m0 (Ndiv2 a) y) + MapCard A m1 = S (MapCard A m0) + MapCard A m1). - intro. rewrite (plus_comm (MapCard A (MapPut A m0 (ad_div_2 a) y)) (MapCard A m1)) + intro. rewrite (plus_comm (MapCard A (MapPut A m0 (Ndiv2 a) y)) (MapCard A m1)) in H3. rewrite (plus_comm (S (MapCard A m0)) (MapCard A m1)) in H3. exact ((fun n m p:nat => plus_reg_l m p n) _ _ _ H3). simpl in |- *. simpl in H1. rewrite <- H1. induction a. trivial. @@ -284,7 +283,7 @@ Section MapCard. Lemma MapCard_Put_1_conv : forall (m:Map A) (a:ad) (y y':A), - MapGet A m a = SOME A y -> MapCard A (MapPut A m a y') = MapCard A m. + MapGet A m a = Some y -> MapCard A (MapPut A m a y') = MapCard A m. Proof. intros. elim @@ -297,7 +296,7 @@ Section MapCard. Lemma MapCard_Put_2_conv : forall (m:Map A) (a:ad) (y:A), - MapGet A m a = NONE A -> MapCard A (MapPut A m a y) = S (MapCard A m). + MapGet A m a = None -> MapCard A (MapPut A m a y) = S (MapCard A m). Proof. intros. elim @@ -331,10 +330,10 @@ Section MapCard. MapDom A (MapPut_behind A m a y) = MapDom A (MapPut A m a y). Proof. simple induction m. trivial. - intros a y a0 y0. simpl in |- *. elim (ad_sum (ad_xor a a0)). intro H. elim H. + intros a y a0 y0. simpl in |- *. elim (Ndiscr (Nxor a a0)). intro H. elim H. intros p H0. rewrite H0. reflexivity. - intro H. rewrite H. rewrite (ad_xor_eq _ _ H). reflexivity. - intros. simpl in |- *. elim (ad_sum a). intro H1. elim H1. intros p H2. rewrite H2. case p. + intro H. rewrite H. rewrite (Nxor_eq _ _ H). reflexivity. + intros. simpl in |- *. elim (Ndiscr a). intro H1. elim H1. intros p H2. rewrite H2. case p. intro p0. simpl in |- *. rewrite H0. reflexivity. intro p0. simpl in |- *. rewrite H. reflexivity. simpl in |- *. rewrite H0. reflexivity. @@ -370,27 +369,27 @@ Section MapCard. n = MapCard A m -> n' = MapCard A m' -> {n = n'} + {n = S n'}. Proof. simple induction m. simpl in |- *. intros. rewrite H in H1. simpl in H1. left. rewrite H1. assumption. - simpl in |- *. intros. elim (sumbool_of_bool (ad_eq a a1)). intro H2. rewrite H2 in H. + simpl in |- *. intros. elim (sumbool_of_bool (Neqb a a1)). intro H2. rewrite H2 in H. rewrite H in H1. simpl in H1. right. rewrite H1. assumption. intro H2. rewrite H2 in H. rewrite H in H1. simpl in H1. left. rewrite H1. assumption. - intros. simpl in H1. simpl in H2. elim (sumbool_of_bool (ad_bit_0 a)). intro H4. + intros. simpl in H1. simpl in H2. elim (sumbool_of_bool (Nbit0 a)). intro H4. rewrite H4 in H1. rewrite H1 in H3. - rewrite (MapCard_makeM2 m0 (MapRemove A m1 (ad_div_2 a))) in H3. + rewrite (MapCard_makeM2 m0 (MapRemove A m1 (Ndiv2 a))) in H3. elim - (H0 (MapRemove A m1 (ad_div_2 a)) (ad_div_2 a) ( - MapCard A m1) (MapCard A (MapRemove A m1 (ad_div_2 a))) + (H0 (MapRemove A m1 (Ndiv2 a)) (Ndiv2 a) ( + MapCard A m1) (MapCard A (MapRemove A m1 (Ndiv2 a))) (refl_equal _) (refl_equal _) (refl_equal _)). intro H5. rewrite H5 in H2. left. rewrite H3. exact H2. intro H5. rewrite H5 in H2. rewrite <- - (plus_Snm_nSm (MapCard A m0) (MapCard A (MapRemove A m1 (ad_div_2 a)))) + (plus_Snm_nSm (MapCard A m0) (MapCard A (MapRemove A m1 (Ndiv2 a)))) in H2. right. rewrite H3. exact H2. intro H4. rewrite H4 in H1. rewrite H1 in H3. - rewrite (MapCard_makeM2 (MapRemove A m0 (ad_div_2 a)) m1) in H3. + rewrite (MapCard_makeM2 (MapRemove A m0 (Ndiv2 a)) m1) in H3. elim - (H (MapRemove A m0 (ad_div_2 a)) (ad_div_2 a) ( - MapCard A m0) (MapCard A (MapRemove A m0 (ad_div_2 a))) + (H (MapRemove A m0 (Ndiv2 a)) (Ndiv2 a) ( + MapCard A m0) (MapCard A (MapRemove A m0 (Ndiv2 a))) (refl_equal _) (refl_equal _) (refl_equal _)). intro H5. rewrite H5 in H2. left. rewrite H3. exact H2. intro H5. rewrite H5 in H2. right. rewrite H3. exact H2. @@ -422,20 +421,20 @@ Section MapCard. Lemma MapCard_Remove_1 : forall (m:Map A) (a:ad), - MapCard A (MapRemove A m a) = MapCard A m -> MapGet A m a = NONE A. + MapCard A (MapRemove A m a) = MapCard A m -> MapGet A m a = None. Proof. simple induction m. trivial. - simpl in |- *. intros a y a0 H. elim (sumbool_of_bool (ad_eq a a0)). intro H0. + simpl in |- *. intros a y a0 H. elim (sumbool_of_bool (Neqb a a0)). intro H0. rewrite H0 in H. discriminate H. intro H0. rewrite H0. reflexivity. - intros. simpl in H1. elim (sumbool_of_bool (ad_bit_0 a)). intro H2. rewrite H2 in H1. - rewrite (MapCard_makeM2 m0 (MapRemove A m1 (ad_div_2 a))) in H1. + intros. simpl in H1. elim (sumbool_of_bool (Nbit0 a)). intro H2. rewrite H2 in H1. + rewrite (MapCard_makeM2 m0 (MapRemove A m1 (Ndiv2 a))) in H1. rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1). apply H0. exact ((fun n m p:nat => plus_reg_l m p n) _ _ _ H1). intro H2. rewrite H2 in H1. - rewrite (MapCard_makeM2 (MapRemove A m0 (ad_div_2 a)) m1) in H1. + rewrite (MapCard_makeM2 (MapRemove A m0 (Ndiv2 a)) m1) in H1. rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1). apply H. rewrite - (plus_comm (MapCard A (MapRemove A m0 (ad_div_2 a))) (MapCard A m1)) + (plus_comm (MapCard A (MapRemove A m0 (Ndiv2 a))) (MapCard A m1)) in H1. rewrite (plus_comm (MapCard A m0) (MapCard A m1)) in H1. exact ((fun n m p:nat => plus_reg_l m p n) _ _ _ H1). Qed. @@ -443,36 +442,36 @@ Section MapCard. Lemma MapCard_Remove_2 : forall (m:Map A) (a:ad), S (MapCard A (MapRemove A m a)) = MapCard A m -> - {y : A | MapGet A m a = SOME A y}. + {y : A | MapGet A m a = Some y}. Proof. simple induction m. intros. discriminate H. - intros a y a0 H. simpl in H. elim (sumbool_of_bool (ad_eq a a0)). intro H0. - rewrite (ad_eq_complete _ _ H0). split with y. exact (M1_semantics_1 A a0 y). + intros a y a0 H. simpl in H. elim (sumbool_of_bool (Neqb a a0)). intro H0. + rewrite (Neqb_complete _ _ H0). split with y. exact (M1_semantics_1 A a0 y). intro H0. rewrite H0 in H. discriminate H. - intros. simpl in H1. elim (sumbool_of_bool (ad_bit_0 a)). intro H2. rewrite H2 in H1. - rewrite (MapCard_makeM2 m0 (MapRemove A m1 (ad_div_2 a))) in H1. + intros. simpl in H1. elim (sumbool_of_bool (Nbit0 a)). intro H2. rewrite H2 in H1. + rewrite (MapCard_makeM2 m0 (MapRemove A m1 (Ndiv2 a))) in H1. rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1). apply H0. change - (S (MapCard A m0) + MapCard A (MapRemove A m1 (ad_div_2 a)) = + (S (MapCard A m0) + MapCard A (MapRemove A m1 (Ndiv2 a)) = MapCard A m0 + MapCard A m1) in H1. rewrite - (plus_Snm_nSm (MapCard A m0) (MapCard A (MapRemove A m1 (ad_div_2 a)))) + (plus_Snm_nSm (MapCard A m0) (MapCard A (MapRemove A m1 (Ndiv2 a)))) in H1. exact ((fun n m p:nat => plus_reg_l m p n) _ _ _ H1). intro H2. rewrite H2 in H1. rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1). apply H. - rewrite (MapCard_makeM2 (MapRemove A m0 (ad_div_2 a)) m1) in H1. + rewrite (MapCard_makeM2 (MapRemove A m0 (Ndiv2 a)) m1) in H1. change - (S (MapCard A (MapRemove A m0 (ad_div_2 a))) + MapCard A m1 = + (S (MapCard A (MapRemove A m0 (Ndiv2 a))) + MapCard A m1 = MapCard A m0 + MapCard A m1) in H1. rewrite - (plus_comm (S (MapCard A (MapRemove A m0 (ad_div_2 a)))) (MapCard A m1)) + (plus_comm (S (MapCard A (MapRemove A m0 (Ndiv2 a)))) (MapCard A m1)) in H1. rewrite (plus_comm (MapCard A m0) (MapCard A m1)) in H1. exact ((fun n m p:nat => plus_reg_l m p n) _ _ _ H1). Qed. Lemma MapCard_Remove_1_conv : forall (m:Map A) (a:ad), - MapGet A m a = NONE A -> MapCard A (MapRemove A m a) = MapCard A m. + MapGet A m a = None -> MapCard A (MapRemove A m a) = MapCard A m. Proof. intros. elim @@ -486,7 +485,7 @@ Section MapCard. Lemma MapCard_Remove_2_conv : forall (m:Map A) (a:ad) (y:A), - MapGet A m a = SOME A y -> S (MapCard A (MapRemove A m a)) = MapCard A m. + MapGet A m a = Some y -> S (MapCard A (MapRemove A m a)) = MapCard A m. Proof. intros. elim @@ -577,20 +576,20 @@ Section MapCard. Proof. simple induction m. intros. apply Map_M0_disjoint. simpl in |- *. intros. rewrite (MapCard_Put_behind_Put m' a a0) in H. unfold MapDisjoint, in_dom in |- *. - simpl in |- *. intros. elim (sumbool_of_bool (ad_eq a a1)). intro H2. - rewrite (ad_eq_complete _ _ H2) in H. rewrite (MapCard_Put_2 m' a1 a0 H) in H1. + simpl in |- *. intros. elim (sumbool_of_bool (Neqb a a1)). intro H2. + rewrite (Neqb_complete _ _ H2) in H. rewrite (MapCard_Put_2 m' a1 a0 H) in H1. discriminate H1. intro H2. rewrite H2 in H0. discriminate H0. simple induction m'. intros. apply Map_disjoint_M0. intros a y H1. rewrite <- (MapCard_ext _ _ (MapPut_as_Merge A (M2 A m0 m1) a y)) in H1. unfold MapCard at 3 in H1. rewrite <- (plus_Snm_nSm (MapCard A (M2 A m0 m1)) 0) in H1. rewrite <- (plus_n_O (S (MapCard A (M2 A m0 m1)))) in H1. unfold MapDisjoint, in_dom in |- *. - unfold MapGet at 2 in |- *. intros. elim (sumbool_of_bool (ad_eq a a0)). intro H4. - rewrite <- (ad_eq_complete _ _ H4) in H2. rewrite (MapCard_Put_2 _ _ _ H1) in H2. + unfold MapGet at 2 in |- *. intros. elim (sumbool_of_bool (Neqb a a0)). intro H4. + rewrite <- (Neqb_complete _ _ H4) in H2. rewrite (MapCard_Put_2 _ _ _ H1) in H2. discriminate H2. intro H4. rewrite H4 in H3. discriminate H3. - intros. unfold MapDisjoint in |- *. intros. elim (sumbool_of_bool (ad_bit_0 a)). intro H6. - unfold MapDisjoint in H0. apply H0 with (m' := m3) (a := ad_div_2 a). apply le_antisym. + intros. unfold MapDisjoint in |- *. intros. elim (sumbool_of_bool (Nbit0 a)). intro H6. + unfold MapDisjoint in H0. apply H0 with (m' := m3) (a := Ndiv2 a). apply le_antisym. apply MapMerge_Card_ub. apply (fun p n m:nat => plus_le_reg_l n m p) with (p := MapCard A m0 + MapCard A m2). @@ -606,7 +605,7 @@ Section MapCard. unfold in_dom in |- *. rewrite H7. reflexivity. elim (in_dom_some _ _ _ H5). intros y H7. rewrite (MapGet_M2_bit_0_1 _ a H6 m2 m3) in H7. unfold in_dom in |- *. rewrite H7. reflexivity. - intro H6. unfold MapDisjoint in H. apply H with (m' := m2) (a := ad_div_2 a). apply le_antisym. + intro H6. unfold MapDisjoint in H. apply H with (m' := m2) (a := Ndiv2 a). apply le_antisym. apply MapMerge_Card_ub. apply (fun p n m:nat => plus_le_reg_l n m p) with (p := MapCard A m1 + MapCard A m3). @@ -637,15 +636,15 @@ Section MapCard. simple induction m. intros. discriminate H. intros a y n H. split with a. unfold in_dom in |- *. rewrite (M1_semantics_1 _ a y). reflexivity. intros. simpl in H1. elim (O_or_S (MapCard _ m0)). intro H2. elim H2. intros m2 H3. - elim (H _ (sym_eq H3)). intros a H4. split with (ad_double a). unfold in_dom in |- *. - rewrite (MapGet_M2_bit_0_0 A (ad_double a) (ad_double_bit_0 a) m0 m1). - rewrite (ad_double_div_2 a). elim (in_dom_some _ _ _ H4). intros y H5. rewrite H5. reflexivity. + elim (H _ (sym_eq H3)). intros a H4. split with (Ndouble a). unfold in_dom in |- *. + rewrite (MapGet_M2_bit_0_0 A (Ndouble a) (Ndouble_bit0 a) m0 m1). + rewrite (Ndouble_div2 a). elim (in_dom_some _ _ _ H4). intros y H5. rewrite H5. reflexivity. intro H2. rewrite <- H2 in H1. simpl in H1. elim (H0 _ H1). intros a H3. - split with (ad_double_plus_un a). unfold in_dom in |- *. + split with (Ndouble_plus_one a). unfold in_dom in |- *. rewrite - (MapGet_M2_bit_0_1 A (ad_double_plus_un a) (ad_double_plus_un_bit_0 a) + (MapGet_M2_bit_0_1 A (Ndouble_plus_one a) (Ndouble_plus_one_bit0 a) m0 m1). - rewrite (ad_double_plus_un_div_2 a). elim (in_dom_some _ _ _ H3). intros y H4. rewrite H4. + rewrite (Ndouble_plus_one_div2 a). elim (in_dom_some _ _ _ H3). intros y H4. rewrite H4. reflexivity. Qed. @@ -675,11 +674,11 @@ Section MapCard2. rewrite <- (MapCard_Remove_2_conv _ m a y H4) in H1. inversion_clear H1. reflexivity. rewrite <- (MapCard_Remove_2_conv _ m' a y' H6) in H2. inversion_clear H2. reflexivity. unfold eqmap, eqm in |- *. intro. rewrite (MapPut_semantics _ (MapRemove B m' a) a y' a0). - elim (sumbool_of_bool (ad_eq a a0)). intro H7. rewrite H7. rewrite <- (ad_eq_complete _ _ H7). + elim (sumbool_of_bool (Neqb a a0)). intro H7. rewrite H7. rewrite <- (Neqb_complete _ _ H7). apply sym_eq. assumption. intro H7. rewrite H7. rewrite (MapRemove_semantics _ m' a a0). rewrite H7. reflexivity. unfold eqmap, eqm in |- *. intro. rewrite (MapPut_semantics _ (MapRemove A m a) a y a0). - elim (sumbool_of_bool (ad_eq a a0)). intro H7. rewrite H7. rewrite <- (ad_eq_complete _ _ H7). + elim (sumbool_of_bool (Neqb a a0)). intro H7. rewrite H7. rewrite <- (Neqb_complete _ _ H7). apply sym_eq. assumption. intro H7. rewrite H7. rewrite (MapRemove_semantics A m a a0). rewrite H7. reflexivity. Qed. @@ -695,8 +694,9 @@ Section MapCard2. intro H. rewrite H. simpl in |- *. apply le_O_n. simple induction m'. simpl in |- *. apply le_O_n. - intros a y. unfold MapDomRestrTo in |- *. case (MapGet A (M2 A m0 m1) a). simpl in |- *. apply le_O_n. + intros a y. unfold MapDomRestrTo in |- *. case (MapGet A (M2 A m0 m1) a). simpl in |- *. intro. simpl in |- *. apply le_n. + apply le_O_n. intros. simpl in |- *. rewrite (MapCard_makeM2 A (MapDomRestrTo A B m0 m2) (MapDomRestrTo A B m1 m3)) . diff --git a/theories/IntMap/Mapfold.v b/theories/IntMap/Mapfold.v index 335a1384..eb58cb64 100644 --- a/theories/IntMap/Mapfold.v +++ b/theories/IntMap/Mapfold.v @@ -5,14 +5,13 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Mapfold.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: Mapfold.v 8733 2006-04-25 22:52:18Z letouzey $ i*) Require Import Bool. Require Import Sumbool. -Require Import ZArith. -Require Import Addr. -Require Import Adist. -Require Import Addec. +Require Import NArith. +Require Import Ndigits. +Require Import Ndec. Require Import Map. Require Import Fset. Require Import Mapaxioms. @@ -50,22 +49,22 @@ Section MapFoldResults. Lemma MapFold_ext_f_1 : forall (m:Map A) (f g:ad -> A -> M) (pf:ad -> ad), - (forall (a:ad) (y:A), MapGet _ m a = SOME _ y -> f (pf a) y = g (pf a) y) -> + (forall (a:ad) (y:A), MapGet _ m a = Some y -> f (pf a) y = g (pf a) y) -> MapFold1 _ _ neutral op f pf m = MapFold1 _ _ neutral op g pf m. Proof. simple induction m. trivial. - simpl in |- *. intros. apply H. rewrite (ad_eq_correct a). reflexivity. - intros. simpl in |- *. rewrite (H f g (fun a0:ad => pf (ad_double a0))). - rewrite (H0 f g (fun a0:ad => pf (ad_double_plus_un a0))). reflexivity. - intros. apply H1. rewrite MapGet_M2_bit_0_1. rewrite ad_double_plus_un_div_2. assumption. - apply ad_double_plus_un_bit_0. - intros. apply H1. rewrite MapGet_M2_bit_0_0. rewrite ad_double_div_2. assumption. - apply ad_double_bit_0. + simpl in |- *. intros. apply H. rewrite (Neqb_correct a). reflexivity. + intros. simpl in |- *. rewrite (H f g (fun a0:ad => pf (Ndouble a0))). + rewrite (H0 f g (fun a0:ad => pf (Ndouble_plus_one a0))). reflexivity. + intros. apply H1. rewrite MapGet_M2_bit_0_1. rewrite Ndouble_plus_one_div2. assumption. + apply Ndouble_plus_one_bit0. + intros. apply H1. rewrite MapGet_M2_bit_0_0. rewrite Ndouble_div2. assumption. + apply Ndouble_bit0. Qed. Lemma MapFold_ext_f : forall (f g:ad -> A -> M) (m:Map A), - (forall (a:ad) (y:A), MapGet _ m a = SOME _ y -> f a y = g a y) -> + (forall (a:ad) (y:A), MapGet _ m a = Some y -> f a y = g a y) -> MapFold _ _ neutral op f m = MapFold _ _ neutral op g m. Proof. intros. exact (MapFold_ext_f_1 m f g (fun a0:ad => a0) H). @@ -80,11 +79,11 @@ Section MapFoldResults. intros. simpl in |- *. apply H. intros. simpl in |- *. rewrite - (H f f' (fun a0:ad => pf (ad_double a0)) - (fun a0:ad => pf' (ad_double a0))). + (H f f' (fun a0:ad => pf (Ndouble a0)) + (fun a0:ad => pf' (Ndouble a0))). rewrite - (H0 f f' (fun a0:ad => pf (ad_double_plus_un a0)) - (fun a0:ad => pf' (ad_double_plus_un a0))). + (H0 f f' (fun a0:ad => pf (Ndouble_plus_one a0)) + (fun a0:ad => pf' (Ndouble_plus_one a0))). reflexivity. intros. apply H1. intros. apply H1. @@ -112,81 +111,83 @@ Section MapFoldResults. Lemma MapFold_Put_disjoint_1 : forall (p:positive) (f:ad -> A -> M) (pf:ad -> ad) (a1 a2:ad) (y1 y2:A), - ad_xor a1 a2 = ad_x p -> + Nxor a1 a2 = Npos p -> MapFold1 A M neutral op f pf (MapPut1 A a1 y1 a2 y2 p) = op (f (pf a1) y1) (f (pf a2) y2). Proof. - simple induction p. intros. simpl in |- *. elim (sumbool_of_bool (ad_bit_0 a1)). intro H1. rewrite H1. - simpl in |- *. rewrite ad_div_2_double_plus_un. rewrite ad_div_2_double. apply comm. - change (ad_bit_0 a2 = negb true) in |- *. rewrite <- H1. rewrite (ad_neg_bit_0_2 _ _ _ H0). + simple induction p. intros. simpl in |- *. elim (sumbool_of_bool (Nbit0 a1)). intro H1. rewrite H1. + simpl in |- *. rewrite Ndiv2_double_plus_one. rewrite Ndiv2_double. apply comm. + change (Nbit0 a2 = negb true) in |- *. rewrite <- H1. rewrite (Nneg_bit0_2 _ _ _ H0). rewrite negb_elim. reflexivity. assumption. - intro H1. rewrite H1. simpl in |- *. rewrite ad_div_2_double. rewrite ad_div_2_double_plus_un. + intro H1. rewrite H1. simpl in |- *. rewrite Ndiv2_double. rewrite Ndiv2_double_plus_one. reflexivity. - change (ad_bit_0 a2 = negb false) in |- *. rewrite <- H1. rewrite (ad_neg_bit_0_2 _ _ _ H0). + change (Nbit0 a2 = negb false) in |- *. rewrite <- H1. rewrite (Nneg_bit0_2 _ _ _ H0). rewrite negb_elim. reflexivity. assumption. - simpl in |- *. intros. elim (sumbool_of_bool (ad_bit_0 a1)). intro H1. rewrite H1. simpl in |- *. + simpl in |- *. intros. elim (sumbool_of_bool (Nbit0 a1)). intro H1. rewrite H1. simpl in |- *. rewrite nleft. rewrite - (H f (fun a0:ad => pf (ad_double_plus_un a0)) ( - ad_div_2 a1) (ad_div_2 a2) y1 y2). - rewrite ad_div_2_double_plus_un. rewrite ad_div_2_double_plus_un. reflexivity. - rewrite <- (ad_same_bit_0 _ _ _ H0). assumption. + (H f (fun a0:ad => pf (Ndouble_plus_one a0)) ( + Ndiv2 a1) (Ndiv2 a2) y1 y2). + rewrite Ndiv2_double_plus_one. rewrite Ndiv2_double_plus_one. reflexivity. + unfold Nodd. + rewrite <- (Nsame_bit0 _ _ _ H0). assumption. assumption. - rewrite <- ad_xor_div_2. rewrite H0. reflexivity. + rewrite <- Nxor_div2. rewrite H0. reflexivity. intro H1. rewrite H1. simpl in |- *. rewrite nright. rewrite - (H f (fun a0:ad => pf (ad_double a0)) (ad_div_2 a1) (ad_div_2 a2) y1 y2) + (H f (fun a0:ad => pf (Ndouble a0)) (Ndiv2 a1) (Ndiv2 a2) y1 y2) . - rewrite ad_div_2_double. rewrite ad_div_2_double. reflexivity. - rewrite <- (ad_same_bit_0 _ _ _ H0). assumption. + rewrite Ndiv2_double. rewrite Ndiv2_double. reflexivity. + unfold Neven. + rewrite <- (Nsame_bit0 _ _ _ H0). assumption. assumption. - rewrite <- ad_xor_div_2. rewrite H0. reflexivity. - intros. simpl in |- *. elim (sumbool_of_bool (ad_bit_0 a1)). intro H0. rewrite H0. simpl in |- *. - rewrite ad_div_2_double. rewrite ad_div_2_double_plus_un. apply comm. + rewrite <- Nxor_div2. rewrite H0. reflexivity. + intros. simpl in |- *. elim (sumbool_of_bool (Nbit0 a1)). intro H0. rewrite H0. simpl in |- *. + rewrite Ndiv2_double. rewrite Ndiv2_double_plus_one. apply comm. assumption. - change (ad_bit_0 a2 = negb true) in |- *. rewrite <- H0. rewrite (ad_neg_bit_0_1 _ _ H). + change (Nbit0 a2 = negb true) in |- *. rewrite <- H0. rewrite (Nneg_bit0_1 _ _ H). rewrite negb_elim. reflexivity. - intro H0. rewrite H0. simpl in |- *. rewrite ad_div_2_double. rewrite ad_div_2_double_plus_un. + intro H0. rewrite H0. simpl in |- *. rewrite Ndiv2_double. rewrite Ndiv2_double_plus_one. reflexivity. - change (ad_bit_0 a2 = negb false) in |- *. rewrite <- H0. rewrite (ad_neg_bit_0_1 _ _ H). + change (Nbit0 a2 = negb false) in |- *. rewrite <- H0. rewrite (Nneg_bit0_1 _ _ H). rewrite negb_elim. reflexivity. assumption. Qed. Lemma MapFold_Put_disjoint_2 : forall (f:ad -> A -> M) (m:Map A) (a:ad) (y:A) (pf:ad -> ad), - MapGet A m a = NONE A -> + MapGet A m a = None -> MapFold1 A M neutral op f pf (MapPut A m a y) = op (f (pf a) y) (MapFold1 A M neutral op f pf m). Proof. simple induction m. intros. simpl in |- *. rewrite (nright (f (pf a) y)). reflexivity. - intros a1 y1 a2 y2 pf H. simpl in |- *. elim (ad_sum (ad_xor a1 a2)). intro H0. elim H0. + intros a1 y1 a2 y2 pf H. simpl in |- *. elim (Ndiscr (Nxor a1 a2)). intro H0. elim H0. intros p H1. rewrite H1. rewrite comm. exact (MapFold_Put_disjoint_1 p f pf a1 a2 y1 y2 H1). - intro H0. rewrite (ad_eq_complete _ _ (ad_xor_eq_true _ _ H0)) in H. + intro H0. rewrite (Neqb_complete _ _ (Nxor_eq_true _ _ H0)) in H. rewrite (M1_semantics_1 A a2 y1) in H. discriminate H. - intros. elim (sumbool_of_bool (ad_bit_0 a)). intro H2. - cut (MapPut A (M2 A m0 m1) a y = M2 A m0 (MapPut A m1 (ad_div_2 a) y)). intro. - rewrite H3. simpl in |- *. rewrite (H0 (ad_div_2 a) y (fun a0:ad => pf (ad_double_plus_un a0))). - rewrite ad_div_2_double_plus_un. rewrite <- assoc. + intros. elim (sumbool_of_bool (Nbit0 a)). intro H2. + cut (MapPut A (M2 A m0 m1) a y = M2 A m0 (MapPut A m1 (Ndiv2 a) y)). intro. + rewrite H3. simpl in |- *. rewrite (H0 (Ndiv2 a) y (fun a0:ad => pf (Ndouble_plus_one a0))). + rewrite Ndiv2_double_plus_one. rewrite <- assoc. rewrite - (comm (MapFold1 A M neutral op f (fun a0:ad => pf (ad_double a0)) m0) + (comm (MapFold1 A M neutral op f (fun a0:ad => pf (Ndouble a0)) m0) (f (pf a) y)). rewrite assoc. reflexivity. assumption. rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1) in H1. assumption. - simpl in |- *. elim (ad_sum a). intro H3. elim H3. intro p. elim p. intros p0 H4 H5. rewrite H5. + simpl in |- *. elim (Ndiscr a). intro H3. elim H3. intro p. elim p. intros p0 H4 H5. rewrite H5. reflexivity. intros p0 H4 H5. rewrite H5 in H2. discriminate H2. intro H4. rewrite H4. reflexivity. intro H3. rewrite H3 in H2. discriminate H2. - intro H2. cut (MapPut A (M2 A m0 m1) a y = M2 A (MapPut A m0 (ad_div_2 a) y) m1). - intro. rewrite H3. simpl in |- *. rewrite (H (ad_div_2 a) y (fun a0:ad => pf (ad_double a0))). - rewrite ad_div_2_double. rewrite <- assoc. reflexivity. + intro H2. cut (MapPut A (M2 A m0 m1) a y = M2 A (MapPut A m0 (Ndiv2 a) y) m1). + intro. rewrite H3. simpl in |- *. rewrite (H (Ndiv2 a) y (fun a0:ad => pf (Ndouble a0))). + rewrite Ndiv2_double. rewrite <- assoc. reflexivity. assumption. rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1) in H1. assumption. - simpl in |- *. elim (ad_sum a). intro H3. elim H3. intro p. elim p. intros p0 H4 H5. rewrite H5 in H2. + simpl in |- *. elim (Ndiscr a). intro H3. elim H3. intro p. elim p. intros p0 H4 H5. rewrite H5 in H2. discriminate H2. intros p0 H4 H5. rewrite H5. reflexivity. intro H4. rewrite H4 in H2. discriminate H2. @@ -195,7 +196,7 @@ Section MapFoldResults. Lemma MapFold_Put_disjoint : forall (f:ad -> A -> M) (m:Map A) (a:ad) (y:A), - MapGet A m a = NONE A -> + MapGet A m a = None -> MapFold A M neutral op f (MapPut A m a y) = op (f a y) (MapFold A M neutral op f m). Proof. @@ -204,7 +205,7 @@ Section MapFoldResults. Lemma MapFold_Put_behind_disjoint_2 : forall (f:ad -> A -> M) (m:Map A) (a:ad) (y:A) (pf:ad -> ad), - MapGet A m a = NONE A -> + MapGet A m a = None -> MapFold1 A M neutral op f pf (MapPut_behind A m a y) = op (f (pf a) y) (MapFold1 A M neutral op f pf m). Proof. @@ -213,12 +214,12 @@ Section MapFoldResults. apply eqmap_trans with (m' := MapMerge A (M1 A a y) m). apply MapPut_behind_as_Merge. apply eqmap_trans with (m' := MapMerge A m (M1 A a y)). apply eqmap_trans with (m' := MapDelta A (M1 A a y) m). apply eqmap_sym. apply MapDelta_disjoint. - unfold MapDisjoint in |- *. unfold in_dom in |- *. simpl in |- *. intros. elim (sumbool_of_bool (ad_eq a a0)). - intro H2. rewrite (ad_eq_complete _ _ H2) in H. rewrite H in H1. discriminate H1. + unfold MapDisjoint in |- *. unfold in_dom in |- *. simpl in |- *. intros. elim (sumbool_of_bool (Neqb a a0)). + intro H2. rewrite (Neqb_complete _ _ H2) in H. rewrite H in H1. discriminate H1. intro H2. rewrite H2 in H0. discriminate H0. apply eqmap_trans with (m' := MapDelta A m (M1 A a y)). apply MapDelta_sym. apply MapDelta_disjoint. unfold MapDisjoint in |- *. unfold in_dom in |- *. simpl in |- *. intros. - elim (sumbool_of_bool (ad_eq a a0)). intro H2. rewrite (ad_eq_complete _ _ H2) in H. + elim (sumbool_of_bool (Neqb a a0)). intro H2. rewrite (Neqb_complete _ _ H2) in H. rewrite H in H0. discriminate H0. intro H2. rewrite H2 in H1. discriminate H1. apply eqmap_sym. apply MapPut_as_Merge. @@ -226,7 +227,7 @@ Section MapFoldResults. Lemma MapFold_Put_behind_disjoint : forall (f:ad -> A -> M) (m:Map A) (a:ad) (y:A), - MapGet A m a = NONE A -> + MapGet A m a = None -> MapFold A M neutral op f (MapPut_behind A m a y) = op (f a y) (MapFold A M neutral op f m). Proof. @@ -245,8 +246,8 @@ Section MapFoldResults. simple induction m2. intros. simpl in |- *. rewrite nright. reflexivity. intros. unfold MapMerge in |- *. rewrite (MapFold_Put_disjoint_2 f (M2 A m m0) a a0 pf). apply comm. apply in_dom_none. exact (MapDisjoint_M1_r _ _ (M2 A m m0) a a0 H1). - intros. simpl in |- *. rewrite (H m3 (fun a0:ad => pf (ad_double a0))). - rewrite (H0 m4 (fun a0:ad => pf (ad_double_plus_un a0))). + intros. simpl in |- *. rewrite (H m3 (fun a0:ad => pf (Ndouble a0))). + rewrite (H0 m4 (fun a0:ad => pf (Ndouble_plus_one a0))). cut (forall a b c d:M, op (op a b) (op c d) = op (op a c) (op b d)). intro. apply H4. intros. rewrite assoc. rewrite <- (assoc b c d). rewrite (comm b c). rewrite (assoc c b d). rewrite assoc. reflexivity. @@ -346,22 +347,22 @@ Section MapFoldExists. forall (f:ad -> A -> bool) (m:Map A) (pf:ad -> ad), MapFold1 A bool false orb f pf m = match MapSweep1 A f pf m with - | SOME _ => true + | Some _ => true | _ => false end. Proof. simple induction m. trivial. intros a y pf. simpl in |- *. unfold MapSweep2 in |- *. case (f (pf a) y); reflexivity. - intros. simpl in |- *. rewrite (H (fun a0:ad => pf (ad_double a0))). - rewrite (H0 (fun a0:ad => pf (ad_double_plus_un a0))). - case (MapSweep1 A f (fun a0:ad => pf (ad_double a0)) m0); reflexivity. + intros. simpl in |- *. rewrite (H (fun a0:ad => pf (Ndouble a0))). + rewrite (H0 (fun a0:ad => pf (Ndouble_plus_one a0))). + case (MapSweep1 A f (fun a0:ad => pf (Ndouble a0)) m0); reflexivity. Qed. Lemma MapFold_orb : forall (f:ad -> A -> bool) (m:Map A), MapFold A bool false orb f m = match MapSweep A f m with - | SOME _ => true + | Some _ => true | _ => false end. Proof. @@ -381,7 +382,7 @@ Section DMergeDef. forall (m:Map (Map A)) (a:ad), in_dom A a (DMerge m) = match MapSweep _ (fun (_:ad) (m0:Map A) => in_dom A a m0) m with - | SOME _ => true + | Some _ => true | _ => false end. Proof. @@ -397,7 +398,7 @@ Section DMergeDef. forall (m:Map (Map A)) (a:ad), in_dom A a (DMerge m) = true -> {b : ad & - {m0 : Map A | MapGet _ m b = SOME _ m0 /\ in_dom A a m0 = true}}. + {m0 : Map A | MapGet _ m b = Some m0 /\ in_dom A a m0 = true}}. Proof. intros m a. rewrite in_dom_DMerge_1. elim @@ -411,7 +412,7 @@ Section DMergeDef. Lemma in_dom_DMerge_3 : forall (m:Map (Map A)) (a b:ad) (m0:Map A), - MapGet _ m a = SOME _ m0 -> + MapGet _ m a = Some m0 -> in_dom A b m0 = true -> in_dom A b (DMerge m) = true. Proof. intros m a b m0 H H0. rewrite in_dom_DMerge_1. diff --git a/theories/IntMap/Mapiter.v b/theories/IntMap/Mapiter.v index 31e98c49..a8ba7e39 100644 --- a/theories/IntMap/Mapiter.v +++ b/theories/IntMap/Mapiter.v @@ -5,14 +5,13 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Mapiter.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: Mapiter.v 8733 2006-04-25 22:52:18Z letouzey $ i*) Require Import Bool. Require Import Sumbool. -Require Import ZArith. -Require Import Addr. -Require Import Adist. -Require Import Addec. +Require Import NArith. +Require Import Ndigits. +Require Import Ndec. Require Import Map. Require Import Mapaxioms. Require Import Fset. @@ -27,17 +26,17 @@ Section MapIter. Variable f : ad -> A -> bool. Definition MapSweep2 (a0:ad) (y:A) := - if f a0 y then SOME _ (a0, y) else NONE _. + if f a0 y then Some (a0, y) else None. Fixpoint MapSweep1 (pf:ad -> ad) (m:Map A) {struct m} : option (ad * A) := match m with - | M0 => NONE _ + | M0 => None | M1 a y => MapSweep2 (pf a) y | M2 m m' => - match MapSweep1 (fun a:ad => pf (ad_double a)) m with - | SOME r => SOME _ r - | NONE => MapSweep1 (fun a:ad => pf (ad_double_plus_un a)) m' + match MapSweep1 (fun a:ad => pf (Ndouble a)) m with + | Some r => Some r + | None => MapSweep1 (fun a:ad => pf (Ndouble_plus_one a)) m' end end. @@ -45,27 +44,27 @@ Section MapIter. Lemma MapSweep_semantics_1_1 : forall (m:Map A) (pf:ad -> ad) (a:ad) (y:A), - MapSweep1 pf m = SOME _ (a, y) -> f a y = true. + MapSweep1 pf m = Some (a, y) -> f a y = true. Proof. simple induction m. intros. discriminate H. simpl in |- *. intros a y pf a0 y0. elim (sumbool_of_bool (f (pf a) y)). intro H. unfold MapSweep2 in |- *. rewrite H. intro H0. inversion H0. rewrite <- H3. assumption. intro H. unfold MapSweep2 in |- *. rewrite H. intro H0. discriminate H0. - simpl in |- *. intros. elim (option_sum (ad * A) (MapSweep1 (fun a0:ad => pf (ad_double a0)) m0)). + simpl in |- *. intros. elim (option_sum (ad * A) (MapSweep1 (fun a0:ad => pf (Ndouble a0)) m0)). intro H2. elim H2. intros r H3. rewrite H3 in H1. inversion H1. rewrite H5 in H3. - exact (H (fun a0:ad => pf (ad_double a0)) a y H3). - intro H2. rewrite H2 in H1. exact (H0 (fun a0:ad => pf (ad_double_plus_un a0)) a y H1). + exact (H (fun a0:ad => pf (Ndouble a0)) a y H3). + intro H2. rewrite H2 in H1. exact (H0 (fun a0:ad => pf (Ndouble_plus_one a0)) a y H1). Qed. Lemma MapSweep_semantics_1 : - forall (m:Map A) (a:ad) (y:A), MapSweep m = SOME _ (a, y) -> f a y = true. + forall (m:Map A) (a:ad) (y:A), MapSweep m = Some (a, y) -> f a y = true. Proof. intros. exact (MapSweep_semantics_1_1 m (fun a:ad => a) a y H). Qed. Lemma MapSweep_semantics_2_1 : forall (m:Map A) (pf:ad -> ad) (a:ad) (y:A), - MapSweep1 pf m = SOME _ (a, y) -> {a' : ad | a = pf a'}. + MapSweep1 pf m = Some (a, y) -> {a' : ad | a = pf a'}. Proof. simple induction m. intros. discriminate H. simpl in |- *. unfold MapSweep2 in |- *. intros a y pf a0 y0. case (f (pf a) y). intros. split with a. @@ -73,63 +72,63 @@ Section MapIter. intro. discriminate H. intros m0 H m1 H0 pf a y. simpl in |- *. elim - (option_sum (ad * A) (MapSweep1 (fun a0:ad => pf (ad_double a0)) m0)). intro H1. elim H1. + (option_sum (ad * A) (MapSweep1 (fun a0:ad => pf (Ndouble a0)) m0)). intro H1. elim H1. intros r H2. rewrite H2. intro H3. inversion H3. rewrite H5 in H2. - elim (H (fun a0:ad => pf (ad_double a0)) a y H2). intros a0 H6. split with (ad_double a0). + elim (H (fun a0:ad => pf (Ndouble a0)) a y H2). intros a0 H6. split with (Ndouble a0). assumption. - intro H1. rewrite H1. intro H2. elim (H0 (fun a0:ad => pf (ad_double_plus_un a0)) a y H2). - intros a0 H3. split with (ad_double_plus_un a0). assumption. + intro H1. rewrite H1. intro H2. elim (H0 (fun a0:ad => pf (Ndouble_plus_one a0)) a y H2). + intros a0 H3. split with (Ndouble_plus_one a0). assumption. Qed. Lemma MapSweep_semantics_2_2 : forall (m:Map A) (pf fp:ad -> ad), (forall a0:ad, fp (pf a0) = a0) -> forall (a:ad) (y:A), - MapSweep1 pf m = SOME _ (a, y) -> MapGet A m (fp a) = SOME _ y. + MapSweep1 pf m = Some (a, y) -> MapGet A m (fp a) = Some y. Proof. simple induction m. intros. discriminate H0. simpl in |- *. intros a y pf fp H a0 y0. unfold MapSweep2 in |- *. elim (sumbool_of_bool (f (pf a) y)). - intro H0. rewrite H0. intro H1. inversion H1. rewrite (H a). rewrite (ad_eq_correct a). + intro H0. rewrite H0. intro H1. inversion H1. rewrite (H a). rewrite (Neqb_correct a). reflexivity. intro H0. rewrite H0. intro H1. discriminate H1. - intros. rewrite (MapGet_M2_bit_0_if A m0 m1 (fp a)). elim (sumbool_of_bool (ad_bit_0 (fp a))). - intro H3. rewrite H3. elim (option_sum (ad * A) (MapSweep1 (fun a0:ad => pf (ad_double a0)) m0)). + intros. rewrite (MapGet_M2_bit_0_if A m0 m1 (fp a)). elim (sumbool_of_bool (Nbit0 (fp a))). + intro H3. rewrite H3. elim (option_sum (ad * A) (MapSweep1 (fun a0:ad => pf (Ndouble a0)) m0)). intro H4. simpl in H2. apply - (H0 (fun a0:ad => pf (ad_double_plus_un a0)) - (fun a0:ad => ad_div_2 (fp a0))). - intro. rewrite H1. apply ad_double_plus_un_div_2. + (H0 (fun a0:ad => pf (Ndouble_plus_one a0)) + (fun a0:ad => Ndiv2 (fp a0))). + intro. rewrite H1. apply Ndouble_plus_one_div2. elim - (option_sum (ad * A) (MapSweep1 (fun a0:ad => pf (ad_double a0)) m0)). intro H5. elim H5. + (option_sum (ad * A) (MapSweep1 (fun a0:ad => pf (Ndouble a0)) m0)). intro H5. elim H5. intros r H6. rewrite H6 in H2. inversion H2. rewrite H8 in H6. - elim (MapSweep_semantics_2_1 m0 (fun a0:ad => pf (ad_double a0)) a y H6). intros a0 H9. - rewrite H9 in H3. rewrite (H1 (ad_double a0)) in H3. rewrite (ad_double_bit_0 a0) in H3. + elim (MapSweep_semantics_2_1 m0 (fun a0:ad => pf (Ndouble a0)) a y H6). intros a0 H9. + rewrite H9 in H3. rewrite (H1 (Ndouble a0)) in H3. rewrite (Ndouble_bit0 a0) in H3. discriminate H3. intro H5. rewrite H5 in H2. assumption. intro H4. simpl in H2. rewrite H4 in H2. apply - (H0 (fun a0:ad => pf (ad_double_plus_un a0)) - (fun a0:ad => ad_div_2 (fp a0))). intro. - rewrite H1. apply ad_double_plus_un_div_2. + (H0 (fun a0:ad => pf (Ndouble_plus_one a0)) + (fun a0:ad => Ndiv2 (fp a0))). intro. + rewrite H1. apply Ndouble_plus_one_div2. assumption. intro H3. rewrite H3. simpl in H2. elim - (option_sum (ad * A) (MapSweep1 (fun a0:ad => pf (ad_double a0)) m0)). intro H4. elim H4. + (option_sum (ad * A) (MapSweep1 (fun a0:ad => pf (Ndouble a0)) m0)). intro H4. elim H4. intros r H5. rewrite H5 in H2. inversion H2. rewrite H7 in H5. apply - (H (fun a0:ad => pf (ad_double a0)) (fun a0:ad => ad_div_2 (fp a0))). intro. rewrite H1. - apply ad_double_div_2. + (H (fun a0:ad => pf (Ndouble a0)) (fun a0:ad => Ndiv2 (fp a0))). intro. rewrite H1. + apply Ndouble_div2. assumption. intro H4. rewrite H4 in H2. elim - (MapSweep_semantics_2_1 m1 (fun a0:ad => pf (ad_double_plus_un a0)) a y + (MapSweep_semantics_2_1 m1 (fun a0:ad => pf (Ndouble_plus_one a0)) a y H2). - intros a0 H5. rewrite H5 in H3. rewrite (H1 (ad_double_plus_un a0)) in H3. - rewrite (ad_double_plus_un_bit_0 a0) in H3. discriminate H3. + intros a0 H5. rewrite H5 in H3. rewrite (H1 (Ndouble_plus_one a0)) in H3. + rewrite (Ndouble_plus_one_bit0 a0) in H3. discriminate H3. Qed. Lemma MapSweep_semantics_2 : forall (m:Map A) (a:ad) (y:A), - MapSweep m = SOME _ (a, y) -> MapGet A m a = SOME _ y. + MapSweep m = Some (a, y) -> MapGet A m a = Some y. Proof. intros. exact @@ -139,28 +138,28 @@ Section MapIter. Lemma MapSweep_semantics_3_1 : forall (m:Map A) (pf:ad -> ad), - MapSweep1 pf m = NONE _ -> - forall (a:ad) (y:A), MapGet A m a = SOME _ y -> f (pf a) y = false. + MapSweep1 pf m = None -> + forall (a:ad) (y:A), MapGet A m a = Some y -> f (pf a) y = false. Proof. simple induction m. intros. discriminate H0. simpl in |- *. unfold MapSweep2 in |- *. intros a y pf. elim (sumbool_of_bool (f (pf a) y)). intro H. rewrite H. intro. discriminate H0. - intro H. rewrite H. intros H0 a0 y0. elim (sumbool_of_bool (ad_eq a a0)). intro H1. rewrite H1. - intro H2. inversion H2. rewrite <- H4. rewrite <- (ad_eq_complete _ _ H1). assumption. + intro H. rewrite H. intros H0 a0 y0. elim (sumbool_of_bool (Neqb a a0)). intro H1. rewrite H1. + intro H2. inversion H2. rewrite <- H4. rewrite <- (Neqb_complete _ _ H1). assumption. intro H1. rewrite H1. intro. discriminate H2. - intros. simpl in H1. elim (option_sum (ad * A) (MapSweep1 (fun a:ad => pf (ad_double a)) m0)). + intros. simpl in H1. elim (option_sum (ad * A) (MapSweep1 (fun a:ad => pf (Ndouble a)) m0)). intro H3. elim H3. intros r H4. rewrite H4 in H1. discriminate H1. - intro H3. rewrite H3 in H1. elim (sumbool_of_bool (ad_bit_0 a)). intro H4. - rewrite (MapGet_M2_bit_0_1 A a H4 m0 m1) in H2. rewrite <- (ad_div_2_double_plus_un a H4). - exact (H0 (fun a:ad => pf (ad_double_plus_un a)) H1 (ad_div_2 a) y H2). - intro H4. rewrite (MapGet_M2_bit_0_0 A a H4 m0 m1) in H2. rewrite <- (ad_div_2_double a H4). - exact (H (fun a:ad => pf (ad_double a)) H3 (ad_div_2 a) y H2). + intro H3. rewrite H3 in H1. elim (sumbool_of_bool (Nbit0 a)). intro H4. + rewrite (MapGet_M2_bit_0_1 A a H4 m0 m1) in H2. rewrite <- (Ndiv2_double_plus_one a H4). + exact (H0 (fun a:ad => pf (Ndouble_plus_one a)) H1 (Ndiv2 a) y H2). + intro H4. rewrite (MapGet_M2_bit_0_0 A a H4 m0 m1) in H2. rewrite <- (Ndiv2_double a H4). + exact (H (fun a:ad => pf (Ndouble a)) H3 (Ndiv2 a) y H2). Qed. Lemma MapSweep_semantics_3 : forall m:Map A, - MapSweep m = NONE _ -> - forall (a:ad) (y:A), MapGet A m a = SOME _ y -> f a y = false. + MapSweep m = None -> + forall (a:ad) (y:A), MapGet A m a = Some y -> f a y = false. Proof. intros. exact (MapSweep_semantics_3_1 m (fun a0:ad => a0) H a y H0). @@ -168,36 +167,36 @@ Section MapIter. Lemma MapSweep_semantics_4_1 : forall (m:Map A) (pf:ad -> ad) (a:ad) (y:A), - MapGet A m a = SOME A y -> + MapGet A m a = Some y -> f (pf a) y = true -> - {a' : ad & {y' : A | MapSweep1 pf m = SOME _ (a', y')}}. + {a' : ad & {y' : A | MapSweep1 pf m = Some (a', y')}}. Proof. simple induction m. intros. discriminate H. - intros. elim (sumbool_of_bool (ad_eq a a1)). intro H1. split with (pf a1). split with y. - rewrite (ad_eq_complete _ _ H1). unfold MapSweep1, MapSweep2 in |- *. - rewrite (ad_eq_complete _ _ H1) in H. rewrite (M1_semantics_1 _ a1 a0) in H. + intros. elim (sumbool_of_bool (Neqb a a1)). intro H1. split with (pf a1). split with y. + rewrite (Neqb_complete _ _ H1). unfold MapSweep1, MapSweep2 in |- *. + rewrite (Neqb_complete _ _ H1) in H. rewrite (M1_semantics_1 _ a1 a0) in H. inversion H. rewrite H0. reflexivity. intro H1. rewrite (M1_semantics_2 _ a a1 a0 H1) in H. discriminate H. - intros. elim (sumbool_of_bool (ad_bit_0 a)). intro H3. + intros. elim (sumbool_of_bool (Nbit0 a)). intro H3. rewrite (MapGet_M2_bit_0_1 _ _ H3 m0 m1) in H1. - rewrite <- (ad_div_2_double_plus_un a H3) in H2. - elim (H0 (fun a0:ad => pf (ad_double_plus_un a0)) (ad_div_2 a) y H1 H2). intros a'' H4. elim H4. - intros y'' H5. simpl in |- *. elim (option_sum _ (MapSweep1 (fun a:ad => pf (ad_double a)) m0)). + rewrite <- (Ndiv2_double_plus_one a H3) in H2. + elim (H0 (fun a0:ad => pf (Ndouble_plus_one a0)) (Ndiv2 a) y H1 H2). intros a'' H4. elim H4. + intros y'' H5. simpl in |- *. elim (option_sum _ (MapSweep1 (fun a:ad => pf (Ndouble a)) m0)). intro H6. elim H6. intro r. elim r. intros a''' y''' H7. rewrite H7. split with a'''. split with y'''. reflexivity. intro H6. rewrite H6. split with a''. split with y''. assumption. intro H3. rewrite (MapGet_M2_bit_0_0 _ _ H3 m0 m1) in H1. - rewrite <- (ad_div_2_double a H3) in H2. - elim (H (fun a0:ad => pf (ad_double a0)) (ad_div_2 a) y H1 H2). intros a'' H4. elim H4. + rewrite <- (Ndiv2_double a H3) in H2. + elim (H (fun a0:ad => pf (Ndouble a0)) (Ndiv2 a) y H1 H2). intros a'' H4. elim H4. intros y'' H5. split with a''. split with y''. simpl in |- *. rewrite H5. reflexivity. Qed. Lemma MapSweep_semantics_4 : forall (m:Map A) (a:ad) (y:A), - MapGet A m a = SOME A y -> - f a y = true -> {a' : ad & {y' : A | MapSweep m = SOME _ (a', y')}}. + MapGet A m a = Some y -> + f a y = true -> {a' : ad & {y' : A | MapSweep m = Some (a', y')}}. Proof. intros. exact (MapSweep_semantics_4_1 m (fun a0:ad => a0) a y H H0). Qed. @@ -212,8 +211,8 @@ Section MapIter. | M0 => M0 B | M1 a y => f (pf a) y | M2 m1 m2 => - MapMerge B (MapCollect1 f (fun a0:ad => pf (ad_double a0)) m1) - (MapCollect1 f (fun a0:ad => pf (ad_double_plus_un a0)) m2) + MapMerge B (MapCollect1 f (fun a0:ad => pf (Ndouble a0)) m1) + (MapCollect1 f (fun a0:ad => pf (Ndouble_plus_one a0)) m2) end. Definition MapCollect (f:ad -> A -> Map B) (m:Map A) := @@ -231,8 +230,8 @@ Section MapIter. | M0 => neutral | M1 a y => f (pf a) y | M2 m1 m2 => - op (MapFold1 f (fun a0:ad => pf (ad_double a0)) m1) - (MapFold1 f (fun a0:ad => pf (ad_double_plus_un a0)) m2) + op (MapFold1 f (fun a0:ad => pf (Ndouble a0)) m1) + (MapFold1 f (fun a0:ad => pf (Ndouble_plus_one a0)) m2) end. Definition MapFold (f:ad -> A -> M) (m:Map A) := @@ -258,11 +257,11 @@ Section MapIter. | M0 => (state, neutral) | M1 a y => f state (pf a) y | M2 m1 m2 => - match MapFold1_state state (fun a0:ad => pf (ad_double a0)) m1 with + match MapFold1_state state (fun a0:ad => pf (Ndouble a0)) m1 with | (state1, x1) => match MapFold1_state state1 - (fun a0:ad => pf (ad_double_plus_un a0)) m2 + (fun a0:ad => pf (Ndouble_plus_one a0)) m2 with | (state2, x2) => (state2, op x1 x2) end @@ -285,19 +284,19 @@ Section MapIter. simple induction m. trivial. intros. simpl in |- *. apply H. intros. simpl in |- *. rewrite - (pair_sp _ _ (MapFold1_state state (fun a0:ad => pf (ad_double a0)) m0)) + (pair_sp _ _ (MapFold1_state state (fun a0:ad => pf (Ndouble a0)) m0)) . - rewrite (H g (fun a0:ad => pf (ad_double a0)) H1 state). + rewrite (H g (fun a0:ad => pf (Ndouble a0)) H1 state). rewrite (pair_sp _ _ (MapFold1_state - (fst (MapFold1_state state (fun a0:ad => pf (ad_double a0)) m0)) - (fun a0:ad => pf (ad_double_plus_un a0)) m1)) + (fst (MapFold1_state state (fun a0:ad => pf (Ndouble a0)) m0)) + (fun a0:ad => pf (Ndouble_plus_one a0)) m1)) . simpl in |- *. rewrite - (H0 g (fun a0:ad => pf (ad_double_plus_un a0)) H1 - (fst (MapFold1_state state (fun a0:ad => pf (ad_double a0)) m0))) + (H0 g (fun a0:ad => pf (Ndouble_plus_one a0)) H1 + (fst (MapFold1_state state (fun a0:ad => pf (Ndouble a0)) m0))) . reflexivity. Qed. @@ -330,21 +329,21 @@ Section MapIter. Fixpoint alist_semantics (l:alist) : ad -> option A := match l with - | nil => fun _:ad => NONE A + | nil => fun _:ad => None | (a, y) :: l' => - fun a0:ad => if ad_eq a a0 then SOME A y else alist_semantics l' a0 + fun a0:ad => if Neqb a a0 then Some y else alist_semantics l' a0 end. Lemma alist_semantics_app : forall (l l':alist) (a:ad), alist_semantics (aapp l l') a = match alist_semantics l a with - | NONE => alist_semantics l' a - | SOME y => SOME A y + | None => alist_semantics l' a + | Some y => Some y end. Proof. unfold aapp in |- *. simple induction l. trivial. - intros. elim a. intros a1 y1. simpl in |- *. case (ad_eq a1 a0). reflexivity. + intros. elim a. intros a1 y1. simpl in |- *. case (Neqb a1 a0). reflexivity. apply H. Qed. @@ -352,53 +351,53 @@ Section MapIter. forall (m:Map A) (pf:ad -> ad) (a:ad) (y:A), alist_semantics (MapFold1 alist anil aapp (fun (a0:ad) (y:A) => acons (a0, y) anil) pf - m) a = SOME A y -> {a' : ad | a = pf a'}. + m) a = Some y -> {a' : ad | a = pf a'}. Proof. simple induction m. simpl in |- *. intros. discriminate H. - simpl in |- *. intros a y pf a0 y0. elim (sumbool_of_bool (ad_eq (pf a) a0)). intro H. rewrite H. - intro H0. split with a. rewrite (ad_eq_complete _ _ H). reflexivity. + simpl in |- *. intros a y pf a0 y0. elim (sumbool_of_bool (Neqb (pf a) a0)). intro H. rewrite H. + intro H0. split with a. rewrite (Neqb_complete _ _ H). reflexivity. intro H. rewrite H. intro H0. discriminate H0. intros. change (alist_semantics (aapp (MapFold1 alist anil aapp (fun (a0:ad) (y:A) => acons (a0, y) anil) - (fun a0:ad => pf (ad_double a0)) m0) + (fun a0:ad => pf (Ndouble a0)) m0) (MapFold1 alist anil aapp (fun (a0:ad) (y:A) => acons (a0, y) anil) - (fun a0:ad => pf (ad_double_plus_un a0)) m1)) a = - SOME A y) in H1. + (fun a0:ad => pf (Ndouble_plus_one a0)) m1)) a = + Some y) in H1. rewrite (alist_semantics_app (MapFold1 alist anil aapp (fun (a0:ad) (y0:A) => acons (a0, y0) anil) - (fun a0:ad => pf (ad_double a0)) m0) + (fun a0:ad => pf (Ndouble a0)) m0) (MapFold1 alist anil aapp (fun (a0:ad) (y0:A) => acons (a0, y0) anil) - (fun a0:ad => pf (ad_double_plus_un a0)) m1) a) + (fun a0:ad => pf (Ndouble_plus_one a0)) m1) a) in H1. elim (option_sum A (alist_semantics (MapFold1 alist anil aapp (fun (a0:ad) (y0:A) => acons (a0, y0) anil) - (fun a0:ad => pf (ad_double a0)) m0) a)). - intro H2. elim H2. intros y0 H3. elim (H (fun a0:ad => pf (ad_double a0)) a y0 H3). intros a0 H4. - split with (ad_double a0). assumption. - intro H2. rewrite H2 in H1. elim (H0 (fun a0:ad => pf (ad_double_plus_un a0)) a y H1). - intros a0 H3. split with (ad_double_plus_un a0). assumption. + (fun a0:ad => pf (Ndouble a0)) m0) a)). + intro H2. elim H2. intros y0 H3. elim (H (fun a0:ad => pf (Ndouble a0)) a y0 H3). intros a0 H4. + split with (Ndouble a0). assumption. + intro H2. rewrite H2 in H1. elim (H0 (fun a0:ad => pf (Ndouble_plus_one a0)) a y H1). + intros a0 H3. split with (Ndouble_plus_one a0). assumption. Qed. Definition ad_inj (pf:ad -> ad) := forall a0 a1:ad, pf a0 = pf a1 -> a0 = a1. Lemma ad_comp_double_inj : - forall pf:ad -> ad, ad_inj pf -> ad_inj (fun a0:ad => pf (ad_double a0)). + forall pf:ad -> ad, ad_inj pf -> ad_inj (fun a0:ad => pf (Ndouble a0)). Proof. - unfold ad_inj in |- *. intros. apply ad_double_inj. exact (H _ _ H0). + unfold ad_inj in |- *. intros. apply Ndouble_inj. exact (H _ _ H0). Qed. Lemma ad_comp_double_plus_un_inj : forall pf:ad -> ad, - ad_inj pf -> ad_inj (fun a0:ad => pf (ad_double_plus_un a0)). + ad_inj pf -> ad_inj (fun a0:ad => pf (Ndouble_plus_one a0)). Proof. - unfold ad_inj in |- *. intros. apply ad_double_plus_un_inj. exact (H _ _ H0). + unfold ad_inj in |- *. intros. apply Ndouble_plus_one_inj. exact (H _ _ H0). Qed. Lemma alist_of_Map_semantics_1 : @@ -411,10 +410,10 @@ Section MapIter. pf m) (pf a). Proof. simple induction m. trivial. - simpl in |- *. intros. elim (sumbool_of_bool (ad_eq a a1)). intro H0. rewrite H0. - rewrite (ad_eq_complete _ _ H0). rewrite (ad_eq_correct (pf a1)). reflexivity. - intro H0. rewrite H0. elim (sumbool_of_bool (ad_eq (pf a) (pf a1))). intro H1. - rewrite (H a a1 (ad_eq_complete _ _ H1)) in H0. rewrite (ad_eq_correct a1) in H0. + simpl in |- *. intros. elim (sumbool_of_bool (Neqb a a1)). intro H0. rewrite H0. + rewrite (Neqb_complete _ _ H0). rewrite (Neqb_correct (pf a1)). reflexivity. + intro H0. rewrite H0. elim (sumbool_of_bool (Neqb (pf a) (pf a1))). intro H1. + rewrite (H a a1 (Neqb_complete _ _ H1)) in H0. rewrite (Neqb_correct a1) in H0. discriminate H0. intro H1. rewrite H1. reflexivity. intros. change @@ -422,54 +421,53 @@ Section MapIter. alist_semantics (aapp (MapFold1 alist anil aapp (fun (a0:ad) (y:A) => acons (a0, y) anil) - (fun a0:ad => pf (ad_double a0)) m0) + (fun a0:ad => pf (Ndouble a0)) m0) (MapFold1 alist anil aapp (fun (a0:ad) (y:A) => acons (a0, y) anil) - (fun a0:ad => pf (ad_double_plus_un a0)) m1)) ( + (fun a0:ad => pf (Ndouble_plus_one a0)) m1)) ( pf a)) in |- *. rewrite alist_semantics_app. rewrite (MapGet_M2_bit_0_if A m0 m1 a). - elim (ad_double_or_double_plus_un a). intro H2. elim H2. intros a0 H3. rewrite H3. - rewrite (ad_double_bit_0 a0). + elim (Ndouble_or_double_plus_un a). intro H2. elim H2. intros a0 H3. rewrite H3. + rewrite (Ndouble_bit0 a0). rewrite <- - (H (fun a1:ad => pf (ad_double a1)) (ad_comp_double_inj pf H1) a0) + (H (fun a1:ad => pf (Ndouble a1)) (ad_comp_double_inj pf H1) a0) . - rewrite ad_double_div_2. case (MapGet A m0 a0). + rewrite Ndouble_div2. case (MapGet A m0 a0); trivial. elim (option_sum A (alist_semantics (MapFold1 alist anil aapp (fun (a1:ad) (y:A) => acons (a1, y) anil) - (fun a1:ad => pf (ad_double_plus_un a1)) m1) - (pf (ad_double a0)))). + (fun a1:ad => pf (Ndouble_plus_one a1)) m1) + (pf (Ndouble a0)))). intro H4. elim H4. intros y H5. elim - (alist_of_Map_semantics_1_1 m1 (fun a1:ad => pf (ad_double_plus_un a1)) - (pf (ad_double a0)) y H5). - intros a1 H6. cut (ad_bit_0 (ad_double a0) = ad_bit_0 (ad_double_plus_un a1)). - intro. rewrite (ad_double_bit_0 a0) in H7. rewrite (ad_double_plus_un_bit_0 a1) in H7. + (alist_of_Map_semantics_1_1 m1 (fun a1:ad => pf (Ndouble_plus_one a1)) + (pf (Ndouble a0)) y H5). + intros a1 H6. cut (Nbit0 (Ndouble a0) = Nbit0 (Ndouble_plus_one a1)). + intro. rewrite (Ndouble_bit0 a0) in H7. rewrite (Ndouble_plus_one_bit0 a1) in H7. discriminate H7. - rewrite (H1 (ad_double a0) (ad_double_plus_un a1) H6). reflexivity. + rewrite (H1 (Ndouble a0) (Ndouble_plus_one a1) H6). reflexivity. intro H4. rewrite H4. reflexivity. - trivial. - intro H2. elim H2. intros a0 H3. rewrite H3. rewrite (ad_double_plus_un_bit_0 a0). + intro H2. elim H2. intros a0 H3. rewrite H3. rewrite (Ndouble_plus_one_bit0 a0). rewrite <- - (H0 (fun a1:ad => pf (ad_double_plus_un a1)) + (H0 (fun a1:ad => pf (Ndouble_plus_one a1)) (ad_comp_double_plus_un_inj pf H1) a0). - rewrite ad_double_plus_un_div_2. + rewrite Ndouble_plus_one_div2. elim (option_sum A (alist_semantics (MapFold1 alist anil aapp (fun (a1:ad) (y:A) => acons (a1, y) anil) - (fun a1:ad => pf (ad_double a1)) m0) - (pf (ad_double_plus_un a0)))). + (fun a1:ad => pf (Ndouble a1)) m0) + (pf (Ndouble_plus_one a0)))). intro H4. elim H4. intros y H5. elim - (alist_of_Map_semantics_1_1 m0 (fun a1:ad => pf (ad_double a1)) - (pf (ad_double_plus_un a0)) y H5). - intros a1 H6. cut (ad_bit_0 (ad_double_plus_un a0) = ad_bit_0 (ad_double a1)). - intro H7. rewrite (ad_double_plus_un_bit_0 a0) in H7. rewrite (ad_double_bit_0 a1) in H7. + (alist_of_Map_semantics_1_1 m0 (fun a1:ad => pf (Ndouble a1)) + (pf (Ndouble_plus_one a0)) y H5). + intros a1 H6. cut (Nbit0 (Ndouble_plus_one a0) = Nbit0 (Ndouble a1)). + intro H7. rewrite (Ndouble_plus_one_bit0 a0) in H7. rewrite (Ndouble_bit0 a1) in H7. discriminate H7. - rewrite (H1 (ad_double_plus_un a0) (ad_double a1) H6). reflexivity. + rewrite (H1 (Ndouble_plus_one a0) (Ndouble a1) H6). reflexivity. intro H4. rewrite H4. reflexivity. Qed. @@ -491,9 +489,9 @@ Section MapIter. forall l:alist, eqm A (alist_semantics l) (MapGet A (Map_of_alist l)). Proof. unfold eqm in |- *. simple induction l. trivial. - intros r l0 H a. elim r. intros a0 y0. simpl in |- *. elim (sumbool_of_bool (ad_eq a0 a)). - intro H0. rewrite H0. rewrite (ad_eq_complete _ _ H0). - rewrite (MapPut_semantics A (Map_of_alist l0) a y0 a). rewrite (ad_eq_correct a). + intros r l0 H a. elim r. intros a0 y0. simpl in |- *. elim (sumbool_of_bool (Neqb a0 a)). + intro H0. rewrite H0. rewrite (Neqb_complete _ _ H0). + rewrite (MapPut_semantics A (Map_of_alist l0) a y0 a). rewrite (Neqb_correct a). reflexivity. intro H0. rewrite H0. rewrite (MapPut_semantics A (Map_of_alist l0) a0 y0 a). rewrite H0. apply H. @@ -551,7 +549,7 @@ Section MapIter. simple induction m. trivial. intros. simpl in |- *. rewrite H1. reflexivity. intros. simpl in |- *. rewrite (fold_right_aapp M neutral op H H0 f). - rewrite (H2 (fun a0:ad => pf (ad_double a0))). rewrite (H3 (fun a0:ad => pf (ad_double_plus_un a0))). + rewrite (H2 (fun a0:ad => pf (Ndouble a0))). rewrite (H3 (fun a0:ad => pf (Ndouble_plus_one a0))). reflexivity. Qed. @@ -590,7 +588,7 @@ Section MapIter. rewrite <- (alist_of_Map_semantics (MapMerge A m m') a). rewrite (MapMerge_semantics A m m' a). elim (option_sum _ (MapGet A m a)). intro H0. elim H0. intros y H1. rewrite H1. elim (option_sum _ (MapGet A m' a)). intro H2. elim H2. intros y' H3. - cut (MapGet A (MapDomRestrTo A A m m') a = NONE A). + cut (MapGet A (MapDomRestrTo A A m m') a = None). rewrite (MapDomRestrTo_semantics A A m m' a). rewrite H3. rewrite H1. intro. discriminate H4. exact (H a). intro H2. rewrite H2. reflexivity. diff --git a/theories/IntMap/Maplists.v b/theories/IntMap/Maplists.v index 1d53e6e5..56a3c160 100644 --- a/theories/IntMap/Maplists.v +++ b/theories/IntMap/Maplists.v @@ -5,10 +5,11 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Maplists.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: Maplists.v 8733 2006-04-25 22:52:18Z letouzey $ i*) -Require Import Addr. -Require Import Addec. +Require Import BinNat. +Require Import Ndigits. +Require Import Ndec. Require Import Map. Require Import Fset. Require Import Mapaxioms. @@ -28,7 +29,7 @@ Section MapLists. Fixpoint ad_in_list (a:ad) (l:list ad) {struct l} : bool := match l with | nil => false - | a' :: l' => orb (ad_eq a a') (ad_in_list a l') + | a' :: l' => orb (Neqb a a') (ad_in_list a l') end. Fixpoint ad_list_stutters (l:list ad) : bool := @@ -43,8 +44,8 @@ Section MapLists. {l1 : list ad & {l2 : list ad | l = l1 ++ x :: l2}}. Proof. simple induction l. intro. discriminate H. - intros. elim (sumbool_of_bool (ad_eq x a)). intro H1. simpl in H0. split with (nil (A:=ad)). - split with l0. rewrite (ad_eq_complete _ _ H1). reflexivity. + intros. elim (sumbool_of_bool (Neqb x a)). intro H1. simpl in H0. split with (nil (A:=ad)). + split with l0. rewrite (Neqb_complete _ _ H1). reflexivity. intro H2. simpl in H0. rewrite H2 in H0. simpl in H0. elim (H H0). intros l'1 H3. split with (a :: l'1). elim H3. intros l2 H4. split with l2. rewrite H4. reflexivity. Qed. @@ -223,7 +224,7 @@ Section MapLists. Lemma ad_in_list_app_1 : forall (l l':list ad) (x:ad), ad_in_list x (l ++ x :: l') = true. Proof. - simple induction l. simpl in |- *. intros. rewrite (ad_eq_correct x). reflexivity. + simple induction l. simpl in |- *. intros. rewrite (Neqb_correct x). reflexivity. intros. simpl in |- *. rewrite (H l' x). apply orb_b_true. Qed. @@ -353,18 +354,18 @@ Section MapLists. (fun (a:ad) (l:list ad) => ad_in_list a l) ( fun c:ad => refl_equal _) ad_in_list_app (fun (a0:ad) (_:A) => a0 :: nil) m a). - simpl in |- *. rewrite (MapFold_orb A (fun (a0:ad) (_:A) => orb (ad_eq a a0) false) m). + simpl in |- *. rewrite (MapFold_orb A (fun (a0:ad) (_:A) => orb (Neqb a a0) false) m). elim (option_sum _ - (MapSweep A (fun (a0:ad) (_:A) => orb (ad_eq a a0) false) m)). intro H. elim H. + (MapSweep A (fun (a0:ad) (_:A) => orb (Neqb a a0) false) m)). intro H. elim H. intro r. elim r. intros a0 y H0. rewrite H0. unfold in_dom in |- *. elim (orb_prop _ _ (MapSweep_semantics_1 _ _ _ _ _ H0)). intro H1. - rewrite (ad_eq_complete _ _ H1). rewrite (MapSweep_semantics_2 A _ _ _ _ H0). reflexivity. + rewrite (Neqb_complete _ _ H1). rewrite (MapSweep_semantics_2 A _ _ _ _ H0). reflexivity. intro H1. discriminate H1. intro H. rewrite H. elim (sumbool_of_bool (in_dom A a m)). intro H0. elim (in_dom_some A m a H0). intros y H1. elim (orb_false_elim _ _ (MapSweep_semantics_3 _ _ _ H _ _ H1)). intro H2. - rewrite (ad_eq_correct a) in H2. discriminate H2. + rewrite (Neqb_correct a) in H2. discriminate H2. exact (sym_eq (y:=_)). Qed. @@ -397,7 +398,7 @@ Section MapLists. pf m) = MapCard A m. Proof. simple induction m; try trivial. simpl in |- *. intros. rewrite ad_list_app_length. - rewrite (H (fun a0:ad => pf (ad_double a0))). rewrite (H0 (fun a0:ad => pf (ad_double_plus_un a0))). + rewrite (H (fun a0:ad => pf (Ndouble a0))). rewrite (H0 (fun a0:ad => pf (Ndouble_plus_one a0))). reflexivity. Qed. @@ -423,8 +424,8 @@ Section MapLists. MapFold1 unit (list ad) nil (app (A:=ad)) (fun (a:ad) (_:unit) => a :: nil) pf (MapDom A m). Proof. - simple induction m; try trivial. simpl in |- *. intros. rewrite (H (fun a0:ad => pf (ad_double a0))). - rewrite (H0 (fun a0:ad => pf (ad_double_plus_un a0))). reflexivity. + simple induction m; try trivial. simpl in |- *. intros. rewrite (H (fun a0:ad => pf (Ndouble a0))). + rewrite (H0 (fun a0:ad => pf (Ndouble_plus_one a0))). reflexivity. Qed. Lemma ad_list_of_dom_Dom : diff --git a/theories/IntMap/Mapsubset.v b/theories/IntMap/Mapsubset.v index e27943fb..6771c03e 100644 --- a/theories/IntMap/Mapsubset.v +++ b/theories/IntMap/Mapsubset.v @@ -5,15 +5,14 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Mapsubset.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: Mapsubset.v 8733 2006-04-25 22:52:18Z letouzey $ i*) Require Import Bool. Require Import Sumbool. Require Import Arith. -Require Import ZArith. -Require Import Addr. -Require Import Adist. -Require Import Addec. +Require Import NArith. +Require Import Ndigits. +Require Import Ndec. Require Import Map. Require Import Fset. Require Import Mapaxioms. @@ -28,7 +27,7 @@ Section MapSubsetDef. Definition MapSubset_1 (m:Map A) (m':Map B) := match MapSweep A (fun (a:ad) (_:A) => negb (in_dom B a m')) m with - | NONE => true + | None => true | _ => false end. @@ -76,10 +75,10 @@ Section MapSubsetDef. unfold eqmap, eqm, in_dom in |- *. intros. cut (match MapGet A m a with - | NONE => false - | SOME _ => true + | None => false + | Some _ => true end = false). - case (MapGet A m a). trivial. + case (MapGet A m a); trivial. intros. discriminate H0. exact (H a). Qed. @@ -346,7 +345,7 @@ Section MapDisjointDef. Definition MapDisjoint_1 (m:Map A) (m':Map B) := match MapSweep A (fun (a:ad) (_:A) => in_dom B a m') m with - | NONE => true + | None => true | _ => false end. @@ -395,7 +394,7 @@ Section MapDisjointDef. Proof. unfold MapDisjoint, MapDisjoint_2 in |- *. unfold eqmap, eqm in |- *. intros. elim (in_dom_some _ _ _ H0). intros y H2. elim (in_dom_some _ _ _ H1). intros y' H3. - cut (MapGet A (MapDomRestrTo A B m m') a = NONE A). intro. + cut (MapGet A (MapDomRestrTo A B m m') a = None). intro. rewrite (MapDomRestrTo_semantics _ _ m m' a) in H4. rewrite H3 in H4. rewrite H2 in H4. discriminate H4. exact (H a). @@ -449,11 +448,11 @@ Section MapDisjointExtra. Proof. unfold MapDisjoint, in_dom in |- *. intros. elim (option_sum _ (MapGet A m0 a)). intro H2. elim H2. intros y H3. elim (option_sum _ (MapGet B m2 a)). intro H4. elim H4. - intros y' H5. apply (H (ad_double a)). - rewrite (MapGet_M2_bit_0_0 _ (ad_double a) (ad_double_bit_0 a) m0 m1). - rewrite (ad_double_div_2 a). rewrite H3. reflexivity. - rewrite (MapGet_M2_bit_0_0 _ (ad_double a) (ad_double_bit_0 a) m2 m3). - rewrite (ad_double_div_2 a). rewrite H5. reflexivity. + intros y' H5. apply (H (Ndouble a)). + rewrite (MapGet_M2_bit_0_0 _ (Ndouble a) (Ndouble_bit0 a) m0 m1). + rewrite (Ndouble_div2 a). rewrite H3. reflexivity. + rewrite (MapGet_M2_bit_0_0 _ (Ndouble a) (Ndouble_bit0 a) m2 m3). + rewrite (Ndouble_div2 a). rewrite H5. reflexivity. intro H4. rewrite H4 in H1. discriminate H1. intro H2. rewrite H2 in H0. discriminate H0. Qed. @@ -464,15 +463,15 @@ Section MapDisjointExtra. Proof. unfold MapDisjoint, in_dom in |- *. intros. elim (option_sum _ (MapGet A m1 a)). intro H2. elim H2. intros y H3. elim (option_sum _ (MapGet B m3 a)). intro H4. elim H4. - intros y' H5. apply (H (ad_double_plus_un a)). + intros y' H5. apply (H (Ndouble_plus_one a)). rewrite - (MapGet_M2_bit_0_1 _ (ad_double_plus_un a) (ad_double_plus_un_bit_0 a) + (MapGet_M2_bit_0_1 _ (Ndouble_plus_one a) (Ndouble_plus_one_bit0 a) m0 m1). - rewrite (ad_double_plus_un_div_2 a). rewrite H3. reflexivity. + rewrite (Ndouble_plus_one_div2 a). rewrite H3. reflexivity. rewrite - (MapGet_M2_bit_0_1 _ (ad_double_plus_un a) (ad_double_plus_un_bit_0 a) + (MapGet_M2_bit_0_1 _ (Ndouble_plus_one a) (Ndouble_plus_one_bit0 a) m2 m3). - rewrite (ad_double_plus_un_div_2 a). rewrite H5. reflexivity. + rewrite (Ndouble_plus_one_div2 a). rewrite H5. reflexivity. intro H4. rewrite H4 in H1. discriminate H1. intro H2. rewrite H2 in H0. discriminate H0. Qed. @@ -482,11 +481,11 @@ Section MapDisjointExtra. MapDisjoint A B m0 m2 -> MapDisjoint A B m1 m3 -> MapDisjoint A B (M2 A m0 m1) (M2 B m2 m3). Proof. - unfold MapDisjoint, in_dom in |- *. intros. elim (sumbool_of_bool (ad_bit_0 a)). intro H3. + unfold MapDisjoint, in_dom in |- *. intros. elim (sumbool_of_bool (Nbit0 a)). intro H3. rewrite (MapGet_M2_bit_0_1 A a H3 m0 m1) in H1. - rewrite (MapGet_M2_bit_0_1 B a H3 m2 m3) in H2. exact (H0 (ad_div_2 a) H1 H2). + rewrite (MapGet_M2_bit_0_1 B a H3 m2 m3) in H2. exact (H0 (Ndiv2 a) H1 H2). intro H3. rewrite (MapGet_M2_bit_0_0 A a H3 m0 m1) in H1. - rewrite (MapGet_M2_bit_0_0 B a H3 m2 m3) in H2. exact (H (ad_div_2 a) H1 H2). + rewrite (MapGet_M2_bit_0_0 B a H3 m2 m3) in H2. exact (H (Ndiv2 a) H1 H2). Qed. Lemma MapDisjoint_M1_l : diff --git a/theories/Lists/List.v b/theories/Lists/List.v index ad91a350..751bc3da 100644 --- a/theories/Lists/List.v +++ b/theories/Lists/List.v @@ -1,730 +1,83 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) + (************************************************************************) + (* v * The Coq Proof Assistant / The Coq Development Team *) + (* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) + (* \VV/ **************************************************************) + (* // * This file is distributed under the terms of the *) + (* * GNU Lesser General Public License Version 2.1 *) + (************************************************************************) -(*i $Id: List.v 8686 2006-04-06 13:25:10Z letouzey $ i*) + (*i $Id: List.v 8866 2006-05-28 16:21:04Z herbelin $ i*) -Require Import Le Minus Min Bool. - -Section Lists. - -Variable A : Set. +Require Import Le Gt Minus Min Bool. +Require Import Setoid. Set Implicit Arguments. -Inductive list : Set := - | nil : list - | cons : A -> list -> list. - -Infix "::" := cons (at level 60, right associativity) : list_scope. - -Open Scope list_scope. - -Ltac now_show c := change c in |- *. - -(*************************) -(** Discrimination *) -(*************************) - -Lemma nil_cons : forall (a:A) (m:list), nil <> a :: m. -Proof. - intros; discriminate. -Qed. - -(*************************) -(** Head and tail *) -(*************************) - -Definition head (l:list) := - match l with - | nil => error - | x :: _ => value x - end. - -Definition tail (l:list) : list := - match l with - | nil => nil - | a :: m => m - end. - -(****************************************) -(** Length of lists *) -(****************************************) - -Fixpoint length (l:list) : nat := - match l with - | nil => 0 - | _ :: m => S (length m) - end. - -(******************************) -(** Length order of lists *) -(******************************) - -Section length_order. -Definition lel (l m:list) := length l <= length m. - -Variables a b : A. -Variables l m n : list. - -Lemma lel_refl : lel l l. -Proof. - unfold lel in |- *; auto with arith. -Qed. - -Lemma lel_trans : lel l m -> lel m n -> lel l n. -Proof. - unfold lel in |- *; intros. - now_show (length l <= length n). - apply le_trans with (length m); auto with arith. -Qed. - -Lemma lel_cons_cons : lel l m -> lel (a :: l) (b :: m). -Proof. - unfold lel in |- *; simpl in |- *; auto with arith. -Qed. - -Lemma lel_cons : lel l m -> lel l (b :: m). -Proof. - unfold lel in |- *; simpl in |- *; auto with arith. -Qed. - -Lemma lel_tail : lel (a :: l) (b :: m) -> lel l m. -Proof. - unfold lel in |- *; simpl in |- *; auto with arith. -Qed. - -Lemma lel_nil : forall l':list, lel l' nil -> nil = l'. -Proof. - intro l'; elim l'; auto with arith. - intros a' y H H0. - now_show (nil = a' :: y). - absurd (S (length y) <= 0); auto with arith. -Qed. -End length_order. - -Hint Resolve lel_refl lel_cons_cons lel_cons lel_nil lel_nil nil_cons. - -(*********************************) -(** The [In] predicate *) -(*********************************) - -Fixpoint In (a:A) (l:list) {struct l} : Prop := - match l with - | nil => False - | b :: m => b = a \/ In a m - end. - -Lemma in_eq : forall (a:A) (l:list), In a (a :: l). -Proof. - simpl in |- *; auto. -Qed. -Hint Resolve in_eq. - -Lemma in_cons : forall (a b:A) (l:list), In b l -> In b (a :: l). -Proof. - simpl in |- *; auto. -Qed. -Hint Resolve in_cons. - -Lemma in_nil : forall a:A, ~ In a nil. -Proof. - unfold not in |- *; intros a H; inversion_clear H. -Qed. - -Lemma in_inv : forall (a b:A) (l:list), In b (a :: l) -> a = b \/ In b l. -Proof. - intros a b l H; inversion_clear H; auto. -Qed. - -Lemma In_dec : - (forall x y:A, {x = y} + {x <> y}) -> - forall (a:A) (l:list), {In a l} + {~ In a l}. +(******************************************************************) +(** * Basics: definition of polymorphic lists and some operations *) +(******************************************************************) -Proof. - induction l as [| a0 l IHl]. - right; apply in_nil. - destruct (H a0 a); simpl in |- *; auto. - destruct IHl; simpl in |- *; auto. - right; unfold not in |- *; intros [Hc1| Hc2]; auto. -Defined. - -(**************************) -(** Nth element of a list *) -(**************************) - -Fixpoint nth (n:nat) (l:list) (default:A) {struct l} : A := - match n, l with - | O, x :: l' => x - | O, other => default - | S m, nil => default - | S m, x :: t => nth m t default - end. +(** ** Definitions *) -Fixpoint nth_ok (n:nat) (l:list) (default:A) {struct l} : bool := - match n, l with - | O, x :: l' => true - | O, other => false - | S m, nil => false - | S m, x :: t => nth_ok m t default - end. - -Lemma nth_in_or_default : - forall (n:nat) (l:list) (d:A), {In (nth n l d) l} + {nth n l d = d}. -(* Realizer nth_ok. Program_all. *) -Proof. - intros n l d; generalize n; induction l; intro n0. - right; case n0; trivial. - case n0; simpl in |- *. - auto. - intro n1; elim (IHl n1); auto. -Qed. - -Lemma nth_S_cons : - forall (n:nat) (l:list) (d a:A), - In (nth n l d) l -> In (nth (S n) (a :: l) d) (a :: l). -Proof. - simpl in |- *; auto. -Qed. - -Fixpoint nth_error (l:list) (n:nat) {struct n} : Exc A := - match n, l with - | O, x :: _ => value x - | S n, _ :: l => nth_error l n - | _, _ => error - end. - -Definition nth_default (default:A) (l:list) (n:nat) : A := - match nth_error l n with - | Some x => x - | None => default - end. - -Lemma nth_In : - forall (n:nat) (l:list) (d:A), n < length l -> In (nth n l d) l. - -Proof. -unfold lt in |- *; induction n as [| n hn]; simpl in |- *. -destruct l; simpl in |- *; [ inversion 2 | auto ]. -destruct l as [| a l hl]; simpl in |- *. -inversion 2. -intros d ie; right; apply hn; auto with arith. -Qed. - -Lemma nth_overflow : forall l n d, length l <= n -> nth n l d = d. -Proof. -induction l; destruct n; simpl; intros; auto. -inversion H. -apply IHl; auto with arith. -Qed. - -Lemma nth_indep : - forall l n d d', n < length l -> nth n l d = nth n l d'. -Proof. -induction l; simpl; intros; auto. -inversion H. -destruct n; simpl; auto with arith. -Qed. - - -(*************************) -(** Concatenation *) -(*************************) - -Fixpoint app (l m:list) {struct l} : list := - match l with - | nil => m - | a :: l1 => a :: app l1 m - end. - -Infix "++" := app (right associativity, at level 60) : list_scope. - -Lemma app_nil_end : forall l:list, l = l ++ nil. -Proof. - induction l; simpl in |- *; auto. - rewrite <- IHl; auto. -Qed. -Hint Resolve app_nil_end. - -Lemma app_ass : forall l m n:list, (l ++ m) ++ n = l ++ m ++ n. -Proof. - intros. induction l; simpl in |- *; auto. - now_show (a :: (l ++ m) ++ n = a :: l ++ m ++ n). - rewrite <- IHl; auto. -Qed. -Hint Resolve app_ass. - -Lemma ass_app : forall l m n:list, l ++ m ++ n = (l ++ m) ++ n. -Proof. - auto. -Qed. -Hint Resolve ass_app. - -Lemma app_comm_cons : forall (x y:list) (a:A), a :: x ++ y = (a :: x) ++ y. -Proof. - auto. -Qed. - -Lemma app_eq_nil : forall x y:list, x ++ y = nil -> x = nil /\ y = nil. -Proof. - destruct x as [| a l]; [ destruct y as [| a l] | destruct y as [| a0 l0] ]; - simpl in |- *; auto. - intros H; discriminate H. - intros; discriminate H. -Qed. - -Lemma app_cons_not_nil : forall (x y:list) (a:A), nil <> x ++ a :: y. -Proof. -unfold not in |- *. - destruct x as [| a l]; simpl in |- *; intros. - discriminate H. - discriminate H. -Qed. - -Lemma app_eq_unit : - forall (x y:list) (a:A), - x ++ y = a :: nil -> x = nil /\ y = a :: nil \/ x = a :: nil /\ y = nil. - -Proof. - destruct x as [| a l]; [ destruct y as [| a l] | destruct y as [| a0 l0] ]; - simpl in |- *. - intros a H; discriminate H. - left; split; auto. - right; split; auto. - generalize H. - generalize (app_nil_end l); intros E. - rewrite <- E; auto. - intros. - injection H. - intro. - cut (nil = l ++ a0 :: l0); auto. - intro. - generalize (app_cons_not_nil _ _ _ H1); intro. - elim H2. -Qed. - -Lemma app_inj_tail : - forall (x y:list) (a b:A), x ++ a :: nil = y ++ b :: nil -> x = y /\ a = b. -Proof. - induction x as [| x l IHl]; - [ destruct y as [| a l] | destruct y as [| a l0] ]; - simpl in |- *; auto. - intros a b H. - injection H. - auto. - intros a0 b H. - injection H; intros. - generalize (app_cons_not_nil _ _ _ H0); destruct 1. - intros a b H. - injection H; intros. - cut (nil = l ++ a :: nil); auto. - intro. - generalize (app_cons_not_nil _ _ _ H2); destruct 1. - intros a0 b H. - injection H; intros. - destruct (IHl l0 a0 b H0). - split; auto. - rewrite <- H1; rewrite <- H2; reflexivity. -Qed. - -Lemma app_length : forall l l', length (l++l') = length l + length l'. -Proof. -induction l; simpl; auto. -Qed. - -Lemma in_app_or : forall (l m:list) (a:A), In a (l ++ m) -> In a l \/ In a m. -Proof. - intros l m a. - elim l; simpl in |- *; auto. - intros a0 y H H0. - now_show ((a0 = a \/ In a y) \/ In a m). - elim H0; auto. - intro H1. - now_show ((a0 = a \/ In a y) \/ In a m). - elim (H H1); auto. -Qed. -Hint Immediate in_app_or. - -Lemma in_or_app : forall (l m:list) (a:A), In a l \/ In a m -> In a (l ++ m). -Proof. - intros l m a. - elim l; simpl in |- *; intro H. - now_show (In a m). - elim H; auto; intro H0. - now_show (In a m). - elim H0. (* subProof completed *) - intros y H0 H1. - now_show (H = a \/ In a (y ++ m)). - elim H1; auto 4. - intro H2. - now_show (H = a \/ In a (y ++ m)). - elim H2; auto. -Qed. -Hint Resolve in_or_app. - -Lemma app_nth1 : - forall l l' d n, n < length l -> nth n (l++l') d = nth n l d. -Proof. -induction l. -intros. -inversion H. -intros l' d n. -case n; simpl; auto. -intros; rewrite IHl; auto with arith. -Qed. - -Lemma app_nth2 : - forall l l' d n, n >= length l -> nth n (l++l') d = nth (n-length l) l' d. -Proof. -induction l. -intros. -simpl. -destruct n; auto. -intros l' d n. -case n; simpl; auto. -intros. -inversion H. -intros. -rewrite IHl; auto with arith. -Qed. - - -(***************************) -(** Set inclusion on list *) -(***************************) - -Definition incl (l m:list) := forall a:A, In a l -> In a m. -Hint Unfold incl. - -Lemma incl_refl : forall l:list, incl l l. -Proof. - auto. -Qed. -Hint Resolve incl_refl. - -Lemma incl_tl : forall (a:A) (l m:list), incl l m -> incl l (a :: m). -Proof. - auto. -Qed. -Hint Immediate incl_tl. - -Lemma incl_tran : forall l m n:list, incl l m -> incl m n -> incl l n. -Proof. - auto. -Qed. - -Lemma incl_appl : forall l m n:list, incl l n -> incl l (n ++ m). -Proof. - auto. -Qed. -Hint Immediate incl_appl. - -Lemma incl_appr : forall l m n:list, incl l n -> incl l (m ++ n). -Proof. - auto. -Qed. -Hint Immediate incl_appr. - -Lemma incl_cons : - forall (a:A) (l m:list), In a m -> incl l m -> incl (a :: l) m. -Proof. - unfold incl in |- *; simpl in |- *; intros a l m H H0 a0 H1. - now_show (In a0 m). - elim H1. - now_show (a = a0 -> In a0 m). - elim H1; auto; intro H2. - now_show (a = a0 -> In a0 m). - elim H2; auto. (* solves subgoal *) - now_show (In a0 l -> In a0 m). - auto. -Qed. -Hint Resolve incl_cons. - -Lemma incl_app : forall l m n:list, incl l n -> incl m n -> incl (l ++ m) n. -Proof. - unfold incl in |- *; simpl in |- *; intros l m n H H0 a H1. - now_show (In a n). - elim (in_app_or _ _ _ H1); auto. -Qed. -Hint Resolve incl_app. - - - -(********************************) -(** Decidable equality on lists *) -(********************************) - - -Lemma list_eq_dec : - (forall x y:A, {x = y} + {x <> y}) -> forall x y:list, {x = y} + {x <> y}. -Proof. - induction x as [| a l IHl]; destruct y as [| a0 l0]; auto. - destruct (H a a0) as [e| e]. - destruct (IHl l0) as [e'| e']. - left; rewrite e; rewrite e'; trivial. - right; red in |- *; intro. - apply e'; injection H0; trivial. - right; red in |- *; intro. - apply e; injection H0; trivial. -Qed. - -(*************************) -(** Reverse *) -(*************************) - -Fixpoint rev (l:list) : list := - match l with - | nil => nil - | x :: l' => rev l' ++ x :: nil - end. - -Lemma distr_rev : forall x y:list, rev (x ++ y) = rev y ++ rev x. -Proof. - induction x as [| a l IHl]. - destruct y as [| a l]. - simpl in |- *. - auto. - - simpl in |- *. - apply app_nil_end; auto. - - intro y. - simpl in |- *. - rewrite (IHl y). - apply (app_ass (rev y) (rev l) (a :: nil)). -Qed. - -Remark rev_unit : forall (l:list) (a:A), rev (l ++ a :: nil) = a :: rev l. -Proof. - intros. - apply (distr_rev l (a :: nil)); simpl in |- *; auto. -Qed. - -Lemma rev_involutive : forall l:list, rev (rev l) = l. -Proof. - induction l as [| a l IHl]. - simpl in |- *; auto. - - simpl in |- *. - rewrite (rev_unit (rev l) a). - rewrite IHl; auto. -Qed. - -Lemma In_rev : forall l x, In x l <-> In x (rev l). -Proof. -induction l. -simpl; intuition. -intros. -simpl. -intuition. -subst. -apply in_or_app; right; simpl; auto. -apply in_or_app; left; firstorder. -destruct (in_app_or _ _ _ H); firstorder. -Qed. - -Lemma rev_length : forall l, length (rev l) = length l. -Proof. -induction l;simpl; auto. -rewrite app_length. -rewrite IHl. -simpl. -elim (length l); simpl; auto. -Qed. - -Lemma rev_nth : forall l d n, n < length l -> - nth n (rev l) d = nth (length l - S n) l d. -Proof. -induction l. -intros; inversion H. -intros. -simpl in H. -simpl (rev (a :: l)). -simpl (length (a :: l) - S n). -inversion H. -rewrite <- minus_n_n; simpl. -rewrite <- rev_length. -rewrite app_nth2; auto. -rewrite <- minus_n_n; auto. -rewrite app_nth1; auto. -rewrite (minus_plus_simpl_l_reverse (length l) n 1). -replace (1 + length l) with (S (length l)); auto with arith. -rewrite <- minus_Sn_m; auto with arith; simpl. -apply IHl; auto. -rewrite rev_length; auto. -Qed. - -(****************************************************) -(** An alternative tail-recursive definition for reverse *) -(****************************************************) - -Fixpoint rev_acc (l l': list) {struct l} : list := - match l with - | nil => l' - | a::l => rev_acc l (a::l') - end. - -Lemma rev_acc_rev : forall l l', rev_acc l l' = rev l ++ l'. -Proof. -induction l; simpl; auto; intros. -rewrite <- ass_app; firstorder. -Qed. - -Lemma rev_alt : forall l, rev l = rev_acc l nil. -Proof. -intros; rewrite rev_acc_rev. -apply app_nil_end. -Qed. - -(*********************************************) -(** Reverse Induction Principle on Lists *) -(*********************************************) - -Section Reverse_Induction. - -Unset Implicit Arguments. - -Remark rev_list_ind : - forall P:list -> Prop, - P nil -> - (forall (a:A) (l:list), P (rev l) -> P (rev (a :: l))) -> - forall l:list, P (rev l). -Proof. - induction l; auto. -Qed. -Set Implicit Arguments. - -Lemma rev_ind : - forall P:list -> Prop, - P nil -> - (forall (x:A) (l:list), P l -> P (l ++ x :: nil)) -> forall l:list, P l. -Proof. - intros. - generalize (rev_involutive l). - intros E; rewrite <- E. - apply (rev_list_ind P). - auto. - - simpl in |- *. - intros. - apply (H0 a (rev l0)). - auto. -Qed. - -End Reverse_Induction. - -(***************************) -(** Last elements of a list *) -(***************************) - -(** [last l d] returns the last elements of the list [l], - or the default value [d] if [l] is empty. *) - -Fixpoint last (l:list)(d:A) {struct l} : A := - match l with - | nil => d - | a :: nil => a - | a :: l => last l d - end. - -(** [removelast l] remove the last element of [l] *) - -Fixpoint removelast (l:list) {struct l} : list := - match l with - | nil => nil - | a :: nil => nil - | a :: l => a :: removelast l - end. - -Lemma app_removelast_last : - forall l d, l<>nil -> l = removelast l ++ (last l d :: nil). -Proof. -induction l. -destruct 1; auto. -intros d _. -destruct l; auto. -pattern (a0::l) at 1; rewrite IHl with d; auto; discriminate. -Qed. - -Lemma exists_last : - forall l, l<>nil -> { l' : list & { a : A | l = l'++a::nil}}. -Proof. -induction l. -destruct 1; auto. -intros _. -destruct l. -exists nil; exists a; auto. -destruct IHl as [l' (a',H)]; try discriminate. -rewrite H. -exists (a::l'); exists a'; auto. -Qed. - -(********************************) -(* Cutting a list at some position *) -(********************************) - -Fixpoint firstn (n:nat)(l:list) {struct n} : list := - match n with - | 0 => nil - | S n => match l with - | nil => nil - | a::l => a::(firstn n l) - end - end. - -Fixpoint skipn (n:nat)(l:list) { struct n } : list := - match n with - | 0 => l - | S n => match l with - | nil => nil - | a::l => skipn n l - end - end. - -Lemma firstn_skipn : forall n l, firstn n l ++ skipn n l = l. -Proof. -induction n. -simpl; auto. -destruct l; simpl; auto. -f_equal; auto. -Qed. - -(**************) -(** Remove *) -(**************) - -Section Remove. - -Hypothesis eq_dec : forall x y : A, {x = y}+{x <> y}. - -Fixpoint remove (x : A) (l : list){struct l} : list := - match l with - | nil => nil - | y::tl => if (eq_dec x y) then remove x tl else y::(remove x tl) - end. - -End Remove. - -(***************************) -(** List without redundancy *) -(***************************) - -Inductive NoDup : list -> Prop := - | NoDup_nil : NoDup nil - | NoDup_cons : forall x l, ~ In x l -> NoDup l -> NoDup (x::l). +Section Lists. + Variable A : Type. + + Inductive list : Type := + | nil : list + | cons : A -> list -> list. + + Infix "::" := cons (at level 60, right associativity) : list_scope. + + Open Scope list_scope. + + (** Head and tail *) + Definition head (l:list) := + match l with + | nil => error + | x :: _ => value x + end. + + Definition tail (l:list) : list := + match l with + | nil => nil + | a :: m => m + end. + + (** Length of lists *) + Fixpoint length (l:list) : nat := + match l with + | nil => 0 + | _ :: m => S (length m) + end. + + (** The [In] predicate *) + Fixpoint In (a:A) (l:list) {struct l} : Prop := + match l with + | nil => False + | b :: m => b = a \/ In a m + end. + + + (** Concatenation of two lists *) + Fixpoint app (l m:list) {struct l} : list := + match l with + | nil => m + | a :: l1 => a :: app l1 m + end. + + Infix "++" := app (right associativity, at level 60) : list_scope. + End Lists. -(** Exporting list notations and hints *) +(** Exporting list notations and tactics *) Implicit Arguments nil [A]. Infix "::" := cons (at level 60, right associativity) : list_scope. Infix "++" := app (right associativity, at level 60) : list_scope. + +Ltac now_show c := change c in |- *. Open Scope list_scope. @@ -732,349 +85,1043 @@ Delimit Scope list_scope with list. Bind Scope list_scope with list. -Hint Resolve nil_cons app_nil_end ass_app app_ass: datatypes v62. + +(** ** Facts about lists *) + +Section Facts. + + Variable A : Type. + + + (** *** Genereric facts *) + + (** Discrimination *) + Theorem nil_cons : forall (x:A) (l:list A), nil <> x :: l. + Proof. + intros; discriminate. + Qed. + + + (** Destruction *) + + Theorem destruct_list : forall l : list A, {x:A & {tl:list A | l = x::tl}}+{l = nil}. + Proof. + induction l as [|a tl]. + right; reflexivity. + left; exists a; exists tl; reflexivity. + Qed. + + (** *** Head and tail *) + + Theorem head_nil : head (@nil A) = None. + Proof. + simpl; reflexivity. + Qed. + + Theorem head_cons : forall (l : list A) (x : A), head (x::l) = Some x. + Proof. + intros; simpl; reflexivity. + Qed. + + + (************************) + (** *** Facts about [In] *) + (************************) + + + (** Characterization of [In] *) + + Theorem in_eq : forall (a:A) (l:list A), In a (a :: l). + Proof. + simpl in |- *; auto. + Qed. + Hint Resolve in_eq. + + Theorem in_cons : forall (a b:A) (l:list A), In b l -> In b (a :: l). + Proof. + simpl in |- *; auto. + Qed. + Hint Resolve in_cons. + + Theorem in_nil : forall a:A, ~ In a nil. + Proof. + unfold not in |- *; intros a H; inversion_clear H. + Qed. + + Lemma In_split : forall x (l:list A), In x l -> exists l1, exists l2, l = l1++x::l2. + Proof. + induction l; simpl; destruct 1. + subst a; auto. + exists (@nil A); exists l; auto. + destruct (IHl H) as (l1,(l2,H0)). + exists (a::l1); exists l2; simpl; f_equal; auto. + Qed. + + (** Inversion *) + Theorem in_inv : forall (a b:A) (l:list A), In b (a :: l) -> a = b \/ In b l. + Proof. + intros a b l H; inversion_clear H; auto. + Qed. + + (** Decidability of [In] *) + Theorem In_dec : + (forall x y:A, {x = y} + {x <> y}) -> + forall (a:A) (l:list A), {In a l} + {~ In a l}. + Proof. + intro H; induction l as [| a0 l IHl]. + right; apply in_nil. + destruct (H a0 a); simpl in |- *; auto. + destruct IHl; simpl in |- *; auto. + right; unfold not in |- *; intros [Hc1| Hc2]; auto. + Defined. + + + (*************************) + (** *** Facts about [app] *) + (*************************) + + (** Discrimination *) + Theorem app_cons_not_nil : forall (x y:list A) (a:A), nil <> x ++ a :: y. + Proof. + unfold not in |- *. + destruct x as [| a l]; simpl in |- *; intros. + discriminate H. + discriminate H. + Qed. + + + (** Concat with [nil] *) + + Theorem app_nil_end : forall l:list A, l = l ++ nil. + Proof. + induction l; simpl in |- *; auto. + rewrite <- IHl; auto. + Qed. + Hint Resolve app_nil_end. + + + (** [app] is associative *) + Theorem app_ass : forall l m n:list A, (l ++ m) ++ n = l ++ m ++ n. + Proof. + intros. induction l; simpl in |- *; auto. + now_show (a :: (l ++ m) ++ n = a :: l ++ m ++ n). + rewrite <- IHl; auto. + Qed. + Hint Resolve app_ass. + + Theorem ass_app : forall l m n:list A, l ++ m ++ n = (l ++ m) ++ n. + Proof. + auto. + Qed. + Hint Resolve ass_app. + + (** [app] commutes with [cons] *) + Theorem app_comm_cons : forall (x y:list A) (a:A), a :: (x ++ y) = (a :: x) ++ y. + Proof. + auto. + Qed. + + + + (** Facts deduced from the result of a concatenation *) + + Theorem app_eq_nil : forall l l':list A, l ++ l' = nil -> l = nil /\ l' = nil. + Proof. + destruct l as [| x l]; destruct l' as [| y l']; simpl in |- *; auto. + intro; discriminate. + intros H; discriminate H. + Qed. + + Theorem app_eq_unit : + forall (x y:list A) (a:A), + x ++ y = a :: nil -> x = nil /\ y = a :: nil \/ x = a :: nil /\ y = nil. + Proof. + destruct x as [| a l]; [ destruct y as [| a l] | destruct y as [| a0 l0] ]; + simpl in |- *. + intros a H; discriminate H. + left; split; auto. + right; split; auto. + generalize H. + generalize (app_nil_end l); intros E. + rewrite <- E; auto. + intros. + injection H. + intro. + cut (nil = l ++ a0 :: l0); auto. + intro. + generalize (app_cons_not_nil _ _ _ H1); intro. + elim H2. + Qed. + + Lemma app_inj_tail : + forall (x y:list A) (a b:A), x ++ a :: nil = y ++ b :: nil -> x = y /\ a = b. + Proof. + induction x as [| x l IHl]; + [ destruct y as [| a l] | destruct y as [| a l0] ]; + simpl in |- *; auto. + intros a b H. + injection H. + auto. + intros a0 b H. + injection H; intros. + generalize (app_cons_not_nil _ _ _ H0); destruct 1. + intros a b H. + injection H; intros. + cut (nil = l ++ a :: nil); auto. + intro. + generalize (app_cons_not_nil _ _ _ H2); destruct 1. + intros a0 b H. + injection H; intros. + destruct (IHl l0 a0 b H0). + split; auto. + rewrite <- H1; rewrite <- H2; reflexivity. + Qed. + + + (** Compatibility wtih other operations *) + + Lemma app_length : forall l l' : list A, length (l++l') = length l + length l'. + Proof. + induction l; simpl; auto. + Qed. + + Lemma in_app_or : forall (l m:list A) (a:A), In a (l ++ m) -> In a l \/ In a m. + Proof. + intros l m a. + elim l; simpl in |- *; auto. + intros a0 y H H0. + now_show ((a0 = a \/ In a y) \/ In a m). + elim H0; auto. + intro H1. + now_show ((a0 = a \/ In a y) \/ In a m). + elim (H H1); auto. + Qed. + Hint Immediate in_app_or. + + Lemma in_or_app : forall (l m:list A) (a:A), In a l \/ In a m -> In a (l ++ m). + Proof. + intros l m a. + elim l; simpl in |- *; intro H. + now_show (In a m). + elim H; auto; intro H0. + now_show (In a m). + elim H0. (* subProof completed *) + intros y H0 H1. + now_show (H = a \/ In a (y ++ m)). + elim H1; auto 4. + intro H2. + now_show (H = a \/ In a (y ++ m)). + elim H2; auto. + Qed. + Hint Resolve in_or_app. + + +End Facts. + +Hint Resolve app_nil_end ass_app app_ass: datatypes v62. Hint Resolve app_comm_cons app_cons_not_nil: datatypes v62. Hint Immediate app_eq_nil: datatypes v62. Hint Resolve app_eq_unit app_inj_tail: datatypes v62. -Hint Resolve lel_refl lel_cons_cons lel_cons lel_nil lel_nil nil_cons: - datatypes v62. Hint Resolve in_eq in_cons in_inv in_nil in_app_or in_or_app: datatypes v62. -Hint Resolve incl_refl incl_tl incl_tran incl_appl incl_appr incl_cons - incl_app: datatypes v62. -Section Functions_on_lists. -(****************************************************************) -(** Some generic functions on lists and basic functions of them *) -(****************************************************************) -(*********) -(** Map *) -(*********) +(*******************************************) +(** * Operations on the elements of a list *) +(*******************************************) + +Section Elts. + + Variable A : Type. + + (*****************************) + (** ** Nth element of a list *) + (*****************************) + + Fixpoint nth (n:nat) (l:list A) (default:A) {struct l} : A := + match n, l with + | O, x :: l' => x + | O, other => default + | S m, nil => default + | S m, x :: t => nth m t default + end. + + Fixpoint nth_ok (n:nat) (l:list A) (default:A) {struct l} : bool := + match n, l with + | O, x :: l' => true + | O, other => false + | S m, nil => false + | S m, x :: t => nth_ok m t default + end. + + Lemma nth_in_or_default : + forall (n:nat) (l:list A) (d:A), {In (nth n l d) l} + {nth n l d = d}. + (* Realizer nth_ok. Program_all. *) + Proof. + intros n l d; generalize n; induction l; intro n0. + right; case n0; trivial. + case n0; simpl in |- *. + auto. + intro n1; elim (IHl n1); auto. + Qed. + + Lemma nth_S_cons : + forall (n:nat) (l:list A) (d a:A), + In (nth n l d) l -> In (nth (S n) (a :: l) d) (a :: l). + Proof. + simpl in |- *; auto. + Qed. + + Fixpoint nth_error (l:list A) (n:nat) {struct n} : Exc A := + match n, l with + | O, x :: _ => value x + | S n, _ :: l => nth_error l n + | _, _ => error + end. + + Definition nth_default (default:A) (l:list A) (n:nat) : A := + match nth_error l n with + | Some x => x + | None => default + end. + + Lemma nth_In : + forall (n:nat) (l:list A) (d:A), n < length l -> In (nth n l d) l. + + Proof. + unfold lt in |- *; induction n as [| n hn]; simpl in |- *. + destruct l; simpl in |- *; [ inversion 2 | auto ]. + destruct l as [| a l hl]; simpl in |- *. + inversion 2. + intros d ie; right; apply hn; auto with arith. + Qed. + + Lemma nth_overflow : forall l n d, length l <= n -> nth n l d = d. + Proof. + induction l; destruct n; simpl; intros; auto. + inversion H. + apply IHl; auto with arith. + Qed. + + Lemma nth_indep : + forall l n d d', n < length l -> nth n l d = nth n l d'. + Proof. + induction l; simpl; intros; auto. + inversion H. + destruct n; simpl; auto with arith. + Qed. + + Lemma app_nth1 : + forall l l' d n, n < length l -> nth n (l++l') d = nth n l d. + Proof. + induction l. + intros. + inversion H. + intros l' d n. + case n; simpl; auto. + intros; rewrite IHl; auto with arith. + Qed. + + Lemma app_nth2 : + forall l l' d n, n >= length l -> nth n (l++l') d = nth (n-length l) l' d. + Proof. + induction l. + intros. + simpl. + destruct n; auto. + intros l' d n. + case n; simpl; auto. + intros. + inversion H. + intros. + rewrite IHl; auto with arith. + Qed. + + + + + (*****************) + (** ** Remove *) + (*****************) + + Section Remove. + + Hypothesis eq_dec : forall x y : A, {x = y}+{x <> y}. + + Fixpoint remove (x : A) (l : list A){struct l} : list A := + match l with + | nil => nil + | y::tl => if (eq_dec x y) then remove x tl else y::(remove x tl) + end. + + Theorem remove_In : forall (l : list A) (x : A), ~ In x (remove x l). + Proof. + induction l as [|x l]; auto. + intro y; simpl; destruct (eq_dec y x) as [yeqx | yneqx]. + apply IHl. + unfold not; intro HF; simpl in HF; destruct HF; auto. + apply (IHl y); assumption. + Qed. + + End Remove. -Section Map. -Variables A B : Set. -Variable f : A -> B. -Fixpoint map (l:list A) : list B := - match l with - | nil => nil - | cons a t => cons (f a) (map t) - end. +(******************************) +(** ** Last element of a list *) +(******************************) -Lemma in_map : - forall (l:list A) (x:A), In x l -> In (f x) (map l). -Proof. - induction l as [| a l IHl]; simpl in |- *; - [ auto - | destruct 1; [ left; apply f_equal with (f := f); assumption | auto ] ]. -Qed. + (** [last l d] returns the last element of the list [l], + or the default value [d] if [l] is empty. *) -Lemma in_map_iff : forall l y, In y (map l) <-> exists x, f x = y /\ In x l. -Proof. -induction l; firstorder (subst; auto). -Qed. + Fixpoint last (l:list A) (d:A) {struct l} : A := + match l with + | nil => d + | a :: nil => a + | a :: l => last l d + end. -Lemma map_length : forall l, length (map l) = length l. -Proof. -induction l; simpl; auto. -Qed. + (** [removelast l] remove the last element of [l] *) + + Fixpoint removelast (l:list A) {struct l} : list A := + match l with + | nil => nil + | a :: nil => nil + | a :: l => a :: removelast l + end. + + Lemma app_removelast_last : + forall l d, l<>nil -> l = removelast l ++ (last l d :: nil). + Proof. + induction l. + destruct 1; auto. + intros d _. + destruct l; auto. + pattern (a0::l) at 1; rewrite IHl with d; auto; discriminate. + Qed. + + Lemma exists_last : + forall l, l<>nil -> { l' : (list A) & { a : A | l = l'++a::nil}}. + Proof. + induction l. + destruct 1; auto. + intros _. + destruct l. + exists (@nil A); exists a; auto. + destruct IHl as [l' (a',H)]; try discriminate. + rewrite H. + exists (a::l'); exists a'; auto. + Qed. + + + (****************************************) + (** ** Counting occurences of a element *) + (****************************************) + + Hypotheses eqA_dec : forall x y : A, {x = y}+{x <> y}. + + Fixpoint count_occ (l : list A) (x : A){struct l} : nat := + match l with + | nil => 0 + | y :: tl => + let n := count_occ tl x in + if eqA_dec y x then S n else n + end. + + (** Compatibility of count_occ with operations on list *) + Theorem count_occ_In : forall (l : list A) (x : A), In x l <-> count_occ l x > 0. + Proof. + induction l as [|y l]. + simpl; intros; split; [destruct 1 | apply gt_irrefl]. + simpl. intro x; destruct (eqA_dec y x) as [Heq|Hneq]. + rewrite Heq; intuition. + rewrite <- (IHl x). + tauto. + Qed. + + Theorem count_occ_inv_nil : forall (l : list A), (forall x:A, count_occ l x = 0) <-> l = nil. + Proof. + split. + (* Case -> *) + induction l as [|x l]. + trivial. + intro H. + elim (O_S (count_occ l x)). + apply sym_eq. + generalize (H x). + simpl. destruct (eqA_dec x x) as [|HF]. + trivial. + elim HF; reflexivity. + (* Case <- *) + intro H; rewrite H; simpl; reflexivity. + Qed. + + Lemma count_occ_nil : forall (x : A), count_occ nil x = 0. + Proof. + intro x; simpl; reflexivity. + Qed. + + Lemma count_occ_cons_eq : forall (l : list A) (x y : A), x = y -> count_occ (x::l) y = S (count_occ l y). + Proof. + intros l x y H; simpl. + destruct (eqA_dec x y); [reflexivity | contradiction]. + Qed. + + Lemma count_occ_cons_neq : forall (l : list A) (x y : A), x <> y -> count_occ (x::l) y = count_occ l y. + Proof. + intros l x y H; simpl. + destruct (eqA_dec x y); [contradiction | reflexivity]. + Qed. + +End Elts. + + + +(*******************************) +(** * Manipulating whole lists *) +(*******************************) + +Section ListOps. + + Variable A : Type. + + (*************************) + (** ** Reverse *) + (*************************) + + Fixpoint rev (l:list A) : list A := + match l with + | nil => nil + | x :: l' => rev l' ++ x :: nil + end. + + Lemma distr_rev : forall x y:list A, rev (x ++ y) = rev y ++ rev x. + Proof. + induction x as [| a l IHl]. + destruct y as [| a l]. + simpl in |- *. + auto. + + simpl in |- *. + apply app_nil_end; auto. + + intro y. + simpl in |- *. + rewrite (IHl y). + apply (app_ass (rev y) (rev l) (a :: nil)). + Qed. + + Remark rev_unit : forall (l:list A) (a:A), rev (l ++ a :: nil) = a :: rev l. + Proof. + intros. + apply (distr_rev l (a :: nil)); simpl in |- *; auto. + Qed. + + Lemma rev_involutive : forall l:list A, rev (rev l) = l. + Proof. + induction l as [| a l IHl]. + simpl in |- *; auto. + + simpl in |- *. + rewrite (rev_unit (rev l) a). + rewrite IHl; auto. + Qed. + + + (** Compatibility with other operations *) + + Lemma In_rev : forall l x, In x l <-> In x (rev l). + Proof. + induction l. + simpl; intuition. + intros. + simpl. + intuition. + subst. + apply in_or_app; right; simpl; auto. + apply in_or_app; left; firstorder. + destruct (in_app_or _ _ _ H); firstorder. + Qed. + + Lemma rev_length : forall l, length (rev l) = length l. + Proof. + induction l;simpl; auto. + rewrite app_length. + rewrite IHl. + simpl. + elim (length l); simpl; auto. + Qed. + + Lemma rev_nth : forall l d n, n < length l -> + nth n (rev l) d = nth (length l - S n) l d. + Proof. + induction l. + intros; inversion H. + intros. + simpl in H. + simpl (rev (a :: l)). + simpl (length (a :: l) - S n). + inversion H. + rewrite <- minus_n_n; simpl. + rewrite <- rev_length. + rewrite app_nth2; auto. + rewrite <- minus_n_n; auto. + rewrite app_nth1; auto. + rewrite (minus_plus_simpl_l_reverse (length l) n 1). + replace (1 + length l) with (S (length l)); auto with arith. + rewrite <- minus_Sn_m; auto with arith; simpl. + apply IHl; auto. + rewrite rev_length; auto. + Qed. + + + (** An alternative tail-recursive definition for reverse *) + + Fixpoint rev_acc (l l': list A) {struct l} : list A := + match l with + | nil => l' + | a::l => rev_acc l (a::l') + end. + + Lemma rev_acc_rev : forall l l', rev_acc l l' = rev l ++ l'. + Proof. + induction l; simpl; auto; intros. + rewrite <- ass_app; firstorder. + Qed. + + Lemma rev_alt : forall l, rev l = rev_acc l nil. + Proof. + intros; rewrite rev_acc_rev. + apply app_nil_end. + Qed. -Lemma map_nth : forall l d n, - nth n (map l) (f d) = f (nth n l d). -Proof. -induction l; simpl map; destruct n; firstorder. -Qed. -Lemma map_app : forall l l', - map (l++l') = (map l)++(map l'). -Proof. -induction l; simpl; auto. -intros; rewrite IHl; auto. -Qed. +(*********************************************) +(** Reverse Induction Principle on Lists *) +(*********************************************) + + Section Reverse_Induction. + + Unset Implicit Arguments. + + Lemma rev_list_ind : + forall P:list A-> Prop, + P nil -> + (forall (a:A) (l:list A), P (rev l) -> P (rev (a :: l))) -> + forall l:list A, P (rev l). + Proof. + induction l; auto. + Qed. + Set Implicit Arguments. + + Theorem rev_ind : + forall P:list A -> Prop, + P nil -> + (forall (x:A) (l:list A), P l -> P (l ++ x :: nil)) -> forall l:list A, P l. + Proof. + intros. + generalize (rev_involutive l). + intros E; rewrite <- E. + apply (rev_list_ind P). + auto. + + simpl in |- *. + intros. + apply (H0 a (rev l0)). + auto. + Qed. + + End Reverse_Induction. + + + + (***********************************) + (** ** Lists modulo permutation *) + (***********************************) + + Section Permutation. + + Inductive Permutation : list A -> list A -> Prop := + | perm_nil: Permutation nil nil + | perm_skip: forall (x:A) (l l':list A), Permutation l l' -> Permutation (cons x l) (cons x l') + | perm_swap: forall (x y:A) (l:list A), Permutation (cons y (cons x l)) (cons x (cons y l)) + | perm_trans: forall (l l' l'':list A), Permutation l l' -> Permutation l' l'' -> Permutation l l''. + + Hint Constructors Permutation. + + (** Some facts about [Permutation] *) + + Theorem Permutation_nil : forall (l : list A), Permutation nil l -> l = nil. + Proof. + intros l HF. + set (m:=@nil A) in HF; assert (m = nil); [reflexivity|idtac]; clearbody m. + induction HF; try elim (nil_cons (sym_eq H)); auto. + Qed. + + Theorem Permutation_nil_cons : forall (l : list A) (x : A), ~ Permutation nil (x::l). + Proof. + unfold not; intros l x HF. + elim (@nil_cons A x l). apply sym_eq. exact (Permutation_nil HF). + Qed. + + (** Permutation over lists is a equivalence relation *) + + Theorem Permutation_refl : forall l : list A, Permutation l l. + Proof. + induction l; constructor. exact IHl. + Qed. + + Theorem Permutation_sym : forall l l' : list A, Permutation l l' -> Permutation l' l. + Proof. + intros l l' Hperm; induction Hperm; auto. + apply perm_trans with (l':=l'); assumption. + Qed. + + Theorem Permutation_trans : forall l l' l'' : list A, Permutation l l' -> Permutation l' l'' -> Permutation l l''. + Proof. + exact perm_trans. + Qed. + + Hint Resolve Permutation_refl Permutation_sym Permutation_trans. + + (** Compatibility with others operations on lists *) + + Theorem Permutation_in : forall (l l' : list A) (x : A), Permutation l l' -> In x l -> In x l'. + Proof. + intros l l' x Hperm; induction Hperm; simpl; tauto. + Qed. + + Lemma Permutation_app_tail : forall (l l' tl : list A), Permutation l l' -> Permutation (l++tl) (l'++tl). + Proof. + intros l l' tl Hperm; induction Hperm as [|x l l'|x y l|l l' l'']; simpl; auto. + eapply Permutation_trans with (l':=l'++tl); trivial. + Qed. + + Lemma Permutation_app_head : forall (l tl tl' : list A), Permutation tl tl' -> Permutation (l++tl) (l++tl'). + Proof. + intros l tl tl' Hperm; induction l; [trivial | repeat rewrite <- app_comm_cons; constructor; assumption]. + Qed. + + Theorem Permutation_app : forall (l m l' m' : list A), Permutation l l' -> Permutation m m' -> Permutation (l++m) (l'++m'). + Proof. + intros l m l' m' Hpermll' Hpermmm'; induction Hpermll' as [|x l l'|x y l|l l' l'']; repeat rewrite <- app_comm_cons; auto. + apply Permutation_trans with (l' := (x :: y :: l ++ m)); + [idtac | repeat rewrite app_comm_cons; apply Permutation_app_head]; trivial. + apply Permutation_trans with (l' := (l' ++ m')); try assumption. + apply Permutation_app_tail; assumption. + Qed. + + Theorem Permutation_app_swap : forall (l l' : list A), Permutation (l++l') (l'++l). + Proof. + induction l as [|x l]. + simpl; intro l'; rewrite <- app_nil_end; trivial. + induction l' as [|y l']. + simpl; rewrite <- app_nil_end; trivial. + simpl; apply Permutation_trans with (l' := x :: y :: l' ++ l). + constructor; rewrite app_comm_cons; apply IHl. + apply Permutation_trans with (l' := y :: x :: l' ++ l); constructor. + apply Permutation_trans with (l' := x :: l ++ l'); auto. + Qed. + + Theorem Permutation_cons_app : forall (l l1 l2:list A) a, + Permutation l (l1 ++ l2) -> Permutation (a :: l) (l1 ++ a :: l2). + Proof. + intros l l1; revert l. + induction l1. + simpl. + intros; apply perm_skip; auto. + simpl; intros. + apply perm_trans with (a0::a::l1++l2). + apply perm_skip; auto. + apply perm_trans with (a::a0::l1++l2). + apply perm_swap; auto. + apply perm_skip; auto. + Qed. + Hint Resolve Permutation_cons_app. + + Theorem Permutation_length : forall (l l' : list A), Permutation l l' -> length l = length l'. + Proof. + intros l l' Hperm; induction Hperm; simpl; auto. + apply trans_eq with (y:= (length l')); trivial. + Qed. + + Theorem Permutation_rev : forall (l : list A), Permutation l (rev l). + Proof. + induction l as [| x l]; simpl; trivial. + apply Permutation_trans with (l' := (x::nil)++rev l). + simpl; auto. + apply Permutation_app_swap. + Qed. + + Theorem Permutation_ind_bis : + forall P : list A -> list A -> Prop, + P (@nil A) (@nil A) -> + (forall x l l', Permutation l l' -> P l l' -> P (x :: l) (x :: l')) -> + (forall x y l l', Permutation l l' -> P l l' -> P (y :: x :: l) (x :: y :: l')) -> + (forall l l' l'', Permutation l l' -> P l l' -> Permutation l' l'' -> P l' l'' -> P l l'') -> + forall l l', Permutation l l' -> P l l'. + Proof. + intros P Hnil Hskip Hswap Htrans. + induction 1; auto. + apply Htrans with (x::y::l); auto. + apply Hswap; auto. + induction l; auto. + apply Hskip; auto. + apply Hskip; auto. + induction l; auto. + eauto. + Qed. + + Ltac break_list l x l' H := + destruct l as [|x l']; simpl in *; + injection H; intros; subst; clear H. + + Theorem Permutation_app_inv : forall (l1 l2 l3 l4:list A) a, + Permutation (l1++a::l2) (l3++a::l4) -> Permutation (l1++l2) (l3 ++ l4). + Proof. + set (P:=fun l l' => + forall a l1 l2 l3 l4, l=l1++a::l2 -> l'=l3++a::l4 -> Permutation (l1++l2) (l3++l4)). + cut (forall l l', Permutation l l' -> P l l'). + intros; apply (H _ _ H0 a); auto. + intros; apply (Permutation_ind_bis P); unfold P; clear P; try clear H l l'; simpl; auto. + (* nil *) + intros; destruct l1; simpl in *; discriminate. + (* skip *) + intros x l l' H IH; intros. + break_list l1 b l1' H0; break_list l3 c l3' H1. + auto. + apply perm_trans with (l3'++c::l4); auto. + apply perm_trans with (l1'++a::l2); auto. + apply perm_skip. + apply (IH a l1' l2 l3' l4); auto. + (* swap *) + intros x y l l' Hp IH; intros. + break_list l1 b l1' H; break_list l3 c l3' H0. + auto. + break_list l3' b l3'' H. + auto. + apply perm_trans with (c::l3''++b::l4); auto. + break_list l1' c l1'' H1. + auto. + apply perm_trans with (b::l1''++c::l2); auto. + break_list l3' d l3'' H; break_list l1' e l1'' H1. + auto. + apply perm_trans with (e::a::l1''++l2); auto. + apply perm_trans with (e::l1''++a::l2); auto. + apply perm_trans with (d::a::l3''++l4); auto. + apply perm_trans with (d::l3''++a::l4); auto. + apply perm_trans with (e::d::l1''++l2); auto. + apply perm_skip; apply perm_skip. + apply (IH a l1'' l2 l3'' l4); auto. + (*trans*) + intros. + destruct (In_split a l') as (l'1,(l'2,H6)). + apply (Permutation_in a H). + subst l. + apply in_or_app; right; red; auto. + apply perm_trans with (l'1++l'2). + apply (H0 _ _ _ _ _ H3 H6). + apply (H2 _ _ _ _ _ H6 H4). + Qed. + + Theorem Permutation_cons_inv : + forall l l' a, Permutation (a::l) (a::l') -> Permutation l l'. + Proof. + intros; exact (Permutation_app_inv (@nil _) l (@nil _) l' a H). + Qed. + + Theorem Permutation_cons_app_inv : + forall l l1 l2 a, Permutation (a :: l) (l1 ++ a :: l2) -> Permutation l (l1 ++ l2). + Proof. + intros; exact (Permutation_app_inv (@nil _) l l1 l2 a H). + Qed. + + Theorem Permutation_app_inv_l : + forall l l1 l2, Permutation (l ++ l1) (l ++ l2) -> Permutation l1 l2. + Proof. + induction l; simpl; auto. + intros. + apply IHl. + apply Permutation_cons_inv with a; auto. + Qed. + + Theorem Permutation_app_inv_r : + forall l l1 l2, Permutation (l1 ++ l) (l2 ++ l) -> Permutation l1 l2. + Proof. + induction l. + intros l1 l2; do 2 rewrite <- app_nil_end; auto. + intros. + apply IHl. + apply Permutation_app_inv with a; auto. + Qed. + + End Permutation. + + + (***********************************) + (** ** Decidable equality on lists *) + (***********************************) + + Hypotheses eqA_dec : forall (x y : A), {x = y}+{x <> y}. + + Lemma list_eq_dec : + forall l l':list A, {l = l'} + {l <> l'}. + Proof. + induction l as [| x l IHl]; destruct l' as [| y l']. + left; trivial. + right; apply nil_cons. + right; unfold not; intro HF; apply (nil_cons (sym_eq HF)). + destruct (eqA_dec x y) as [xeqy|xneqy]; destruct (IHl l') as [leql'|lneql']; + try (right; unfold not; intro HF; injection HF; intros; contradiction). + rewrite xeqy; rewrite leql'; left; trivial. + Qed. + + +End ListOps. + + +(***************************************************) +(** * Applying functions to the elements of a list *) +(***************************************************) + +(************) +(** ** Map *) +(************) -Lemma map_rev : forall l, map (rev l) = rev (map l). -Proof. -induction l; simpl; auto. -rewrite map_app. -rewrite IHl; auto. -Qed. +Section Map. + Variables A B : Type. + Variable f : A -> B. + + Fixpoint map (l:list A) : list B := + match l with + | nil => nil + | cons a t => cons (f a) (map t) + end. + + Lemma in_map : + forall (l:list A) (x:A), In x l -> In (f x) (map l). + Proof. + induction l as [| a l IHl]; simpl in |- *; + [ auto + | destruct 1; [ left; apply f_equal with (f := f); assumption | auto ] ]. + Qed. + + Lemma in_map_iff : forall l y, In y (map l) <-> exists x, f x = y /\ In x l. + Proof. + induction l; firstorder (subst; auto). + Qed. + + Lemma map_length : forall l, length (map l) = length l. + Proof. + induction l; simpl; auto. + Qed. + + Lemma map_nth : forall l d n, + nth n (map l) (f d) = f (nth n l d). + Proof. + induction l; simpl map; destruct n; firstorder. + Qed. + + Lemma map_app : forall l l', + map (l++l') = (map l)++(map l'). + Proof. + induction l; simpl; auto. + intros; rewrite IHl; auto. + Qed. + + Lemma map_rev : forall l, map (rev l) = rev (map l). + Proof. + induction l; simpl; auto. + rewrite map_app. + rewrite IHl; auto. + Qed. + + Hint Constructors Permutation. + + Lemma Permutation_map : + forall l l', Permutation l l' -> Permutation (map l) (map l'). + Proof. + induction 1; simpl; auto; eauto. + Qed. + + (** [flat_map] *) + + Fixpoint flat_map (f:A -> list B) (l:list A) {struct l} : + list B := + match l with + | nil => nil + | cons x t => (f x)++(flat_map f t) + end. + + Lemma in_flat_map : forall (f:A->list B)(l:list A)(y:B), + In y (flat_map f l) <-> exists x, In x l /\ In y (f x). + Proof. + induction l; simpl; split; intros. + contradiction. + destruct H as (x,(H,_)); contradiction. + destruct (in_app_or _ _ _ H). + exists a; auto. + destruct (IHl y) as (H1,_); destruct (H1 H0) as (x,(H2,H3)). + exists x; auto. + apply in_or_app. + destruct H as (x,(H0,H1)); destruct H0. + subst; auto. + right; destruct (IHl y) as (_,H2); apply H2. + exists x; auto. + Qed. End Map. -Lemma map_map : forall (A B C:Set)(f:A->B)(g:B->C) l, +Lemma map_map : forall (A B C:Type)(f:A->B)(g:B->C) l, map g (map f l) = map (fun x => g (f x)) l. Proof. -induction l; simpl; auto. -rewrite IHl; auto. + induction l; simpl; auto. + rewrite IHl; auto. Qed. Lemma map_ext : - forall (A B : Set)(f g:A->B), (forall a, f a = g a) -> forall l, map f l = map g l. -Proof. -induction l; simpl; auto. -rewrite H; rewrite IHl; auto. -Qed. - -(********************************************) -(** Operations on lists of pairs or lists of lists *) -(********************************************) - -Section ListPairs. -Variable A B : Set. - -(** [split] derives two lists from a list of pairs *) - -Fixpoint split (l:list (A*B)) { struct l }: list A * list B := - match l with - | nil => (nil, nil) - | (x,y) :: tl => let (g,d) := split tl in (x::g, y::d) - end. - -Lemma in_split_l : forall (l:list (A*B))(p:A*B), - In p l -> In (fst p) (fst (split l)). -Proof. -induction l; simpl; intros; auto. -destruct p; destruct a; destruct (split l); simpl in *. -destruct H. -injection H; auto. -right; apply (IHl (a0,b) H). -Qed. - -Lemma in_split_r : forall (l:list (A*B))(p:A*B), - In p l -> In (snd p) (snd (split l)). -Proof. -induction l; simpl; intros; auto. -destruct p; destruct a; destruct (split l); simpl in *. -destruct H. -injection H; auto. -right; apply (IHl (a0,b) H). -Qed. - -Lemma split_nth : forall (l:list (A*B))(n:nat)(d:A*B), - nth n l d = (nth n (fst (split l)) (fst d), nth n (snd (split l)) (snd d)). -Proof. -induction l. -destruct n; destruct d; simpl; auto. -destruct n; destruct d; simpl; auto. -destruct a; destruct (split l); simpl; auto. -destruct a; destruct (split l); simpl in *; auto. -rewrite IHl; simpl; auto. -Qed. - -Lemma split_lenght_l : forall (l:list (A*B)), - length (fst (split l)) = length l. -Proof. -induction l; simpl; auto. -destruct a; destruct (split l); simpl; auto. -Qed. - -Lemma split_lenght_r : forall (l:list (A*B)), - length (snd (split l)) = length l. -Proof. -induction l; simpl; auto. -destruct a; destruct (split l); simpl; auto. -Qed. - -(** [combine] is the opposite of [split]. - Lists given to [combine] are meant to be of same length. - If not, [combine] stops on the shorter list *) - -Fixpoint combine (l : list A) (l' : list B){struct l} : list (A*B) := - match l,l' with - | x::tl, y::tl' => (x,y)::(combine tl tl') - | _, _ => nil - end. - -Lemma split_combine : forall (l: list (A*B)), - let (l1,l2) := split l in combine l1 l2 = l. -Proof. -induction l. -simpl; auto. -destruct a; simpl. -destruct (split l); simpl in *. -f_equal; auto. -Qed. - -Lemma combine_split : forall (l:list A)(l':list B), length l = length l' -> - split (combine l l') = (l,l'). -Proof. -induction l; destruct l'; simpl; intros; auto; try discriminate. -injection H; clear H; intros. -rewrite IHl; auto. -Qed. - -Lemma in_combine_l : forall (l:list A)(l':list B)(x:A)(y:B), - In (x,y) (combine l l') -> In x l. -Proof. -induction l. -simpl; auto. -destruct l'; simpl; auto; intros. -contradiction. -destruct H. -injection H; auto. -right; apply IHl with l' y; auto. -Qed. - -Lemma in_combine_r : forall (l:list A)(l':list B)(x:A)(y:B), - In (x,y) (combine l l') -> In y l'. -Proof. -induction l. -simpl; intros; contradiction. -destruct l'; simpl; auto; intros. -destruct H. -injection H; auto. -right; apply IHl with x; auto. -Qed. - -Lemma combine_length : forall (l:list A)(l':list B), - length (combine l l') = min (length l) (length l'). -Proof. -induction l. -simpl; auto. -destruct l'; simpl; auto. -Qed. - -Lemma combine_nth : forall (l:list A)(l':list B)(n:nat)(x:A)(y:B), - length l = length l' -> - nth n (combine l l') (x,y) = (nth n l x, nth n l' y). + forall (A B : Type)(f g:A->B), (forall a, f a = g a) -> forall l, map f l = map g l. Proof. -induction l; destruct l'; intros; try discriminate. -destruct n; simpl; auto. -destruct n; simpl in *; auto. + induction l; simpl; auto. + rewrite H; rewrite IHl; auto. Qed. -(** [flat_map] *) - -Fixpoint flat_map (f:A -> list B) (l:list A) {struct l} : - list B := - match l with - | nil => nil - | cons x t => (f x)++(flat_map f t) - end. - -Lemma in_flat_map : forall (f:A->list B)(l:list A)(y:B), - In y (flat_map f l) <-> exists x, In x l /\ In y (f x). -Proof. -induction l; simpl; split; intros. -contradiction. -destruct H as (x,(H,_)); contradiction. -destruct (in_app_or _ _ _ H). -exists a; auto. -destruct (IHl y) as (H1,_); destruct (H1 H0) as (x,(H2,H3)). -exists x; auto. -apply in_or_app. -destruct H as (x,(H0,H1)); destruct H0. -subst; auto. -right; destruct (IHl y) as (_,H2); apply H2. -exists x; auto. -Qed. - -(** [list_prod] has the same signature as [combine], but unlike - [combine], it adds every possible pairs, not only those at the - same position. *) - -Fixpoint list_prod (l:list A) (l':list B) {struct l} : - list (A * B) := - match l with - | nil => nil - | cons x t => (map (fun y:B => (x, y)) l')++(list_prod t l') - end. - -Lemma in_prod_aux : - forall (x:A) (y:B) (l:list B), - In y l -> In (x, y) (map (fun y0:B => (x, y0)) l). -Proof. - induction l; - [ simpl in |- *; auto - | simpl in |- *; destruct 1 as [H1| ]; - [ left; rewrite H1; trivial | right; auto ] ]. -Qed. - -Lemma in_prod : - forall (l:list A) (l':list B) (x:A) (y:B), - In x l -> In y l' -> In (x, y) (list_prod l l'). -Proof. - induction l; - [ simpl in |- *; tauto - | simpl in |- *; intros; apply in_or_app; destruct H; - [ left; rewrite H; apply in_prod_aux; assumption | right; auto ] ]. -Qed. - -Lemma in_prod_iff : - forall (l:list A)(l':list B)(x:A)(y:B), - In (x,y) (list_prod l l') <-> In x l /\ In y l'. -Proof. -split; [ | intros; apply in_prod; intuition ]. -induction l; simpl; intros. -intuition. -destruct (in_app_or _ _ _ H); clear H. -destruct (in_map_iff (fun y : B => (a, y)) l' (x,y)) as (H1,_). -destruct (H1 H0) as (z,(H2,H3)); clear H0 H1. -injection H2; clear H2; intros; subst; intuition. -intuition. -Qed. - -Lemma prod_length : forall (l:list A)(l':list B), - length (list_prod l l') = (length l) * (length l'). -Proof. -induction l; simpl; auto. -intros. -rewrite app_length. -rewrite map_length. -auto. -Qed. - -End ListPairs. - -(** [(list_power x y)] is [y^x], or the set of sequences of elts of [y] - indexed by elts of [x], sorted in lexicographic order. *) - -Fixpoint list_power (A B:Set)(l:list A) (l':list B) {struct l} : - list (list (A * B)) := - match l with - | nil => cons nil nil - | cons x t => - flat_map (fun f:list (A * B) => map (fun y:B => cons (x, y) f) l') - (list_power t l') - end. (************************************) (** Left-to-right iterator on lists *) (************************************) Section Fold_Left_Recursor. -Variables A B : Set. -Variable f : A -> B -> A. - -Fixpoint fold_left (l:list B) (a0:A) {struct l} : A := - match l with - | nil => a0 - | cons b t => fold_left t (f a0 b) - end. - -Lemma fold_left_app : forall (l l':list B)(i:A), - fold_left (l++l') i = fold_left l' (fold_left l i). -Proof. -induction l. -simpl; auto. -intros. -simpl. -auto. -Qed. + Variables A B : Type. + Variable f : A -> B -> A. + + Fixpoint fold_left (l:list B) (a0:A) {struct l} : A := + match l with + | nil => a0 + | cons b t => fold_left t (f a0 b) + end. + + Lemma fold_left_app : forall (l l':list B)(i:A), + fold_left (l++l') i = fold_left l' (fold_left l i). + Proof. + induction l. + simpl; auto. + intros. + simpl. + auto. + Qed. End Fold_Left_Recursor. Lemma fold_left_length : - forall (A:Set)(l:list A), fold_left (fun x _ => S x) l 0 = length l. + forall (A:Type)(l:list A), fold_left (fun x _ => S x) l 0 = length l. Proof. -intro A. -cut (forall (l:list A) n, fold_left (fun x _ => S x) l n = n + length l). -intros. -exact (H l 0). -induction l; simpl; auto. -intros; rewrite IHl. -simpl; auto with arith. + intro A. + cut (forall (l:list A) n, fold_left (fun x _ => S x) l n = n + length l). + intros. + exact (H l 0). + induction l; simpl; auto. + intros; rewrite IHl. + simpl; auto with arith. Qed. (************************************) @@ -1082,210 +1129,651 @@ Qed. (************************************) Section Fold_Right_Recursor. -Variables A B : Set. -Variable f : B -> A -> A. -Variable a0 : A. - -Fixpoint fold_right (l:list B) : A := - match l with - | nil => a0 - | cons b t => f b (fold_right t) - end. + Variables A B : Type. + Variable f : B -> A -> A. + Variable a0 : A. + + Fixpoint fold_right (l:list B) : A := + match l with + | nil => a0 + | cons b t => f b (fold_right t) + end. End Fold_Right_Recursor. -Lemma fold_right_app : forall (A B:Set)(f:A->B->B) l l' i, - fold_right f i (l++l') = fold_right f (fold_right f i l') l. -Proof. -induction l. -simpl; auto. -simpl; intros. -f_equal; auto. -Qed. - -Lemma fold_left_rev_right : forall (A B:Set)(f:A->B->B) l i, - fold_right f i (rev l) = fold_left (fun x y => f y x) l i. -Proof. -induction l. -simpl; auto. -intros. -simpl. -rewrite fold_right_app; simpl; auto. -Qed. - -Theorem fold_symmetric : - forall (A:Set) (f:A -> A -> A), - (forall x y z:A, f x (f y z) = f (f x y) z) -> - (forall x y:A, f x y = f y x) -> - forall (a0:A) (l:list A), fold_left f l a0 = fold_right f a0 l. -Proof. -destruct l as [| a l]. -reflexivity. -simpl in |- *. -rewrite <- H0. -generalize a0 a. -induction l as [| a3 l IHl]; simpl in |- *. -trivial. -intros. -rewrite H. -rewrite (H0 a2). -rewrite <- (H a1). -rewrite (H0 a1). -rewrite IHl. -reflexivity. -Qed. - -(********************************) -(** Boolean operations over lists *) -(********************************) - -Section Bool. -Variable A : Set. -Variable f : A -> bool. - -(** find whether a boolean function can be satisfied by an - elements of the list. *) - -Fixpoint existsb (l:list A) {struct l}: bool := - match l with - | nil => false - | a::l => f a || existsb l - end. - -Lemma existsb_exists : - forall l, existsb l = true <-> exists x, In x l /\ f x = true. -Proof. -induction l; simpl; intuition. -inversion H. -firstorder. -destruct (orb_prop _ _ H1); firstorder. -firstorder. -subst. -rewrite H2; auto. -Qed. - -Lemma existsb_nth : forall l n d, n < length l -> - existsb l = false -> f (nth n l d) = false. -Proof. -induction l. -inversion 1. -simpl; intros. -destruct (orb_false_elim _ _ H0); clear H0; auto. -destruct n ; auto. -rewrite IHl; auto with arith. -Qed. - -(** find whether a boolean function is satisfied by - all the elements of a list. *) - -Fixpoint forallb (l:list A) {struct l} : bool := - match l with - | nil => true - | a::l => f a && forallb l - end. - -Lemma forallb_forall : - forall l, forallb l = true <-> (forall x, In x l -> f x = true). -Proof. -induction l; simpl; intuition. -destruct (andb_prop _ _ H1). -congruence. -destruct (andb_prop _ _ H1); auto. -assert (forallb l = true). -apply H0; intuition. -rewrite H1; auto. -Qed. - -(** [filter] *) - -Fixpoint filter (l:list A) : list A := - match l with - | nil => nil - | x :: l => if f x then x::(filter l) else filter l - end. + Lemma fold_right_app : forall (A B:Type)(f:A->B->B) l l' i, + fold_right f i (l++l') = fold_right f (fold_right f i l') l. + Proof. + induction l. + simpl; auto. + simpl; intros. + f_equal; auto. + Qed. + + Lemma fold_left_rev_right : forall (A B:Type)(f:A->B->B) l i, + fold_right f i (rev l) = fold_left (fun x y => f y x) l i. + Proof. + induction l. + simpl; auto. + intros. + simpl. + rewrite fold_right_app; simpl; auto. + Qed. + + Theorem fold_symmetric : + forall (A:Type) (f:A -> A -> A), + (forall x y z:A, f x (f y z) = f (f x y) z) -> + (forall x y:A, f x y = f y x) -> + forall (a0:A) (l:list A), fold_left f l a0 = fold_right f a0 l. + Proof. + destruct l as [| a l]. + reflexivity. + simpl in |- *. + rewrite <- H0. + generalize a0 a. + induction l as [| a3 l IHl]; simpl in |- *. + trivial. + intros. + rewrite H. + rewrite (H0 a2). + rewrite <- (H a1). + rewrite (H0 a1). + rewrite IHl. + reflexivity. + Qed. + + + + (** [(list_power x y)] is [y^x], or the set of sequences of elts of [y] + indexed by elts of [x], sorted in lexicographic order. *) + + Fixpoint list_power (A B:Type)(l:list A) (l':list B) {struct l} : + list (list (A * B)) := + match l with + | nil => cons nil nil + | cons x t => + flat_map (fun f:list (A * B) => map (fun y:B => cons (x, y) f) l') + (list_power t l') + end. + + + (*************************************) + (** ** Boolean operations over lists *) + (*************************************) + + Section Bool. + Variable A : Type. + Variable f : A -> bool. + + (** find whether a boolean function can be satisfied by an + elements of the list. *) + + Fixpoint existsb (l:list A) {struct l}: bool := + match l with + | nil => false + | a::l => f a || existsb l + end. + + Lemma existsb_exists : + forall l, existsb l = true <-> exists x, In x l /\ f x = true. + Proof. + induction l; simpl; intuition. + inversion H. + firstorder. + destruct (orb_prop _ _ H1); firstorder. + firstorder. + subst. + rewrite H2; auto. + Qed. + + Lemma existsb_nth : forall l n d, n < length l -> + existsb l = false -> f (nth n l d) = false. + Proof. + induction l. + inversion 1. + simpl; intros. + destruct (orb_false_elim _ _ H0); clear H0; auto. + destruct n ; auto. + rewrite IHl; auto with arith. + Qed. + + (** find whether a boolean function is satisfied by + all the elements of a list. *) + + Fixpoint forallb (l:list A) {struct l} : bool := + match l with + | nil => true + | a::l => f a && forallb l + end. + + Lemma forallb_forall : + forall l, forallb l = true <-> (forall x, In x l -> f x = true). + Proof. + induction l; simpl; intuition. + destruct (andb_prop _ _ H1). + congruence. + destruct (andb_prop _ _ H1); auto. + assert (forallb l = true). + apply H0; intuition. + rewrite H1; auto. + Qed. + + (** [filter] *) + + Fixpoint filter (l:list A) : list A := + match l with + | nil => nil + | x :: l => if f x then x::(filter l) else filter l + end. + + Lemma filter_In : forall x l, In x (filter l) <-> In x l /\ f x = true. + Proof. + induction l; simpl. + intuition. + intros. + case_eq (f a); intros; simpl; intuition congruence. + Qed. + + (** [find] *) + + Fixpoint find (l:list A) : option A := + match l with + | nil => None + | x :: tl => if f x then Some x else find tl + end. + + (** [partition] *) + + Fixpoint partition (l:list A) {struct l} : list A * list A := + match l with + | nil => (nil, nil) + | x :: tl => let (g,d) := partition tl in + if f x then (x::g,d) else (g,x::d) + end. + + End Bool. + + + + + (******************************************************) + (** ** Operations on lists of pairs or lists of lists *) + (******************************************************) + + Section ListPairs. + Variables A B : Type. + + (** [split] derives two lists from a list of pairs *) + + Fixpoint split (l:list (A*B)) { struct l }: list A * list B := + match l with + | nil => (nil, nil) + | (x,y) :: tl => let (g,d) := split tl in (x::g, y::d) + end. + + Lemma in_split_l : forall (l:list (A*B))(p:A*B), + In p l -> In (fst p) (fst (split l)). + Proof. + induction l; simpl; intros; auto. + destruct p; destruct a; destruct (split l); simpl in *. + destruct H. + injection H; auto. + right; apply (IHl (a0,b) H). + Qed. + + Lemma in_split_r : forall (l:list (A*B))(p:A*B), + In p l -> In (snd p) (snd (split l)). + Proof. + induction l; simpl; intros; auto. + destruct p; destruct a; destruct (split l); simpl in *. + destruct H. + injection H; auto. + right; apply (IHl (a0,b) H). + Qed. + + Lemma split_nth : forall (l:list (A*B))(n:nat)(d:A*B), + nth n l d = (nth n (fst (split l)) (fst d), nth n (snd (split l)) (snd d)). + Proof. + induction l. + destruct n; destruct d; simpl; auto. + destruct n; destruct d; simpl; auto. + destruct a; destruct (split l); simpl; auto. + destruct a; destruct (split l); simpl in *; auto. + rewrite IHl; simpl; auto. + Qed. + + Lemma split_lenght_l : forall (l:list (A*B)), + length (fst (split l)) = length l. + Proof. + induction l; simpl; auto. + destruct a; destruct (split l); simpl; auto. + Qed. + + Lemma split_lenght_r : forall (l:list (A*B)), + length (snd (split l)) = length l. + Proof. + induction l; simpl; auto. + destruct a; destruct (split l); simpl; auto. + Qed. + + (** [combine] is the opposite of [split]. + Lists given to [combine] are meant to be of same length. + If not, [combine] stops on the shorter list *) + + Fixpoint combine (l : list A) (l' : list B){struct l} : list (A*B) := + match l,l' with + | x::tl, y::tl' => (x,y)::(combine tl tl') + | _, _ => nil + end. + + Lemma split_combine : forall (l: list (A*B)), + let (l1,l2) := split l in combine l1 l2 = l. + Proof. + induction l. + simpl; auto. + destruct a; simpl. + destruct (split l); simpl in *. + f_equal; auto. + Qed. + + Lemma combine_split : forall (l:list A)(l':list B), length l = length l' -> + split (combine l l') = (l,l'). + Proof. + induction l; destruct l'; simpl; intros; auto; try discriminate. + injection H; clear H; intros. + rewrite IHl; auto. + Qed. + + Lemma in_combine_l : forall (l:list A)(l':list B)(x:A)(y:B), + In (x,y) (combine l l') -> In x l. + Proof. + induction l. + simpl; auto. + destruct l'; simpl; auto; intros. + contradiction. + destruct H. + injection H; auto. + right; apply IHl with l' y; auto. + Qed. + + Lemma in_combine_r : forall (l:list A)(l':list B)(x:A)(y:B), + In (x,y) (combine l l') -> In y l'. + Proof. + induction l. + simpl; intros; contradiction. + destruct l'; simpl; auto; intros. + destruct H. + injection H; auto. + right; apply IHl with x; auto. + Qed. + + Lemma combine_length : forall (l:list A)(l':list B), + length (combine l l') = min (length l) (length l'). + Proof. + induction l. + simpl; auto. + destruct l'; simpl; auto. + Qed. + + Lemma combine_nth : forall (l:list A)(l':list B)(n:nat)(x:A)(y:B), + length l = length l' -> + nth n (combine l l') (x,y) = (nth n l x, nth n l' y). + Proof. + induction l; destruct l'; intros; try discriminate. + destruct n; simpl; auto. + destruct n; simpl in *; auto. + Qed. + + (** [list_prod] has the same signature as [combine], but unlike + [combine], it adds every possible pairs, not only those at the + same position. *) + + Fixpoint list_prod (l:list A) (l':list B) {struct l} : + list (A * B) := + match l with + | nil => nil + | cons x t => (map (fun y:B => (x, y)) l')++(list_prod t l') + end. + + Lemma in_prod_aux : + forall (x:A) (y:B) (l:list B), + In y l -> In (x, y) (map (fun y0:B => (x, y0)) l). + Proof. + induction l; + [ simpl in |- *; auto + | simpl in |- *; destruct 1 as [H1| ]; + [ left; rewrite H1; trivial | right; auto ] ]. + Qed. + + Lemma in_prod : + forall (l:list A) (l':list B) (x:A) (y:B), + In x l -> In y l' -> In (x, y) (list_prod l l'). + Proof. + induction l; + [ simpl in |- *; tauto + | simpl in |- *; intros; apply in_or_app; destruct H; + [ left; rewrite H; apply in_prod_aux; assumption | right; auto ] ]. + Qed. + + Lemma in_prod_iff : + forall (l:list A)(l':list B)(x:A)(y:B), + In (x,y) (list_prod l l') <-> In x l /\ In y l'. + Proof. + split; [ | intros; apply in_prod; intuition ]. + induction l; simpl; intros. + intuition. + destruct (in_app_or _ _ _ H); clear H. + destruct (in_map_iff (fun y : B => (a, y)) l' (x,y)) as (H1,_). + destruct (H1 H0) as (z,(H2,H3)); clear H0 H1. + injection H2; clear H2; intros; subst; intuition. + intuition. + Qed. + + Lemma prod_length : forall (l:list A)(l':list B), + length (list_prod l l') = (length l) * (length l'). + Proof. + induction l; simpl; auto. + intros. + rewrite app_length. + rewrite map_length. + auto. + Qed. + + End ListPairs. + + + + +(***************************************) +(** * Miscelenous operations on lists *) +(***************************************) -Lemma filter_In : forall x l, In x (filter l) <-> In x l /\ f x = true. -Proof. -induction l; simpl. -intuition. -intros. -case_eq (f a); intros; simpl; intuition congruence. -Qed. -(** [find] *) -Fixpoint find (l:list A) : option A := - match l with - | nil => None - | x :: tl => if f x then Some x else find tl - end. +(******************************) +(** ** Length order of lists *) +(******************************) -(** [partition] *) +Section length_order. + Variable A : Type. + + Definition lel (l m:list A) := length l <= length m. + + Variables a b : A. + Variables l m n : list A. + + Lemma lel_refl : lel l l. + Proof. + unfold lel in |- *; auto with arith. + Qed. + + Lemma lel_trans : lel l m -> lel m n -> lel l n. + Proof. + unfold lel in |- *; intros. + now_show (length l <= length n). + apply le_trans with (length m); auto with arith. + Qed. + + Lemma lel_cons_cons : lel l m -> lel (a :: l) (b :: m). + Proof. + unfold lel in |- *; simpl in |- *; auto with arith. + Qed. + + Lemma lel_cons : lel l m -> lel l (b :: m). + Proof. + unfold lel in |- *; simpl in |- *; auto with arith. + Qed. + + Lemma lel_tail : lel (a :: l) (b :: m) -> lel l m. + Proof. + unfold lel in |- *; simpl in |- *; auto with arith. + Qed. + + Lemma lel_nil : forall l':list A, lel l' nil -> nil = l'. + Proof. + intro l'; elim l'; auto with arith. + intros a' y H H0. + now_show (nil = a' :: y). + absurd (S (length y) <= 0); auto with arith. + Qed. +End length_order. -Fixpoint partition (l:list A) {struct l} : list A * list A := - match l with - | nil => (nil, nil) - | x :: tl => let (g,d) := partition tl in - if f x then (x::g,d) else (g,x::d) - end. +Hint Resolve lel_refl lel_cons_cons lel_cons lel_nil lel_nil nil_cons: + datatypes v62. -End Bool. +(******************************) +(** ** Set inclusion on list *) +(******************************) -(*********************************) -(** Sequence of natural numbers *) -(*********************************) +Section SetIncl. + + Variable A : Type. + + Definition incl (l m:list A) := forall a:A, In a l -> In a m. + Hint Unfold incl. + + Lemma incl_refl : forall l:list A, incl l l. + Proof. + auto. + Qed. + Hint Resolve incl_refl. + + Lemma incl_tl : forall (a:A) (l m:list A), incl l m -> incl l (a :: m). + Proof. + auto with datatypes. + Qed. + Hint Immediate incl_tl. + + Lemma incl_tran : forall l m n:list A, incl l m -> incl m n -> incl l n. + Proof. + auto. + Qed. + + Lemma incl_appl : forall l m n:list A, incl l n -> incl l (n ++ m). + Proof. + auto with datatypes. + Qed. + Hint Immediate incl_appl. + + Lemma incl_appr : forall l m n:list A, incl l n -> incl l (m ++ n). + Proof. + auto with datatypes. + Qed. + Hint Immediate incl_appr. + + Lemma incl_cons : + forall (a:A) (l m:list A), In a m -> incl l m -> incl (a :: l) m. + Proof. + unfold incl in |- *; simpl in |- *; intros a l m H H0 a0 H1. + now_show (In a0 m). + elim H1. + now_show (a = a0 -> In a0 m). + elim H1; auto; intro H2. + now_show (a = a0 -> In a0 m). + elim H2; auto. (* solves subgoal *) + now_show (In a0 l -> In a0 m). + auto. + Qed. + Hint Resolve incl_cons. + + Lemma incl_app : forall l m n:list A, incl l n -> incl m n -> incl (l ++ m) n. + Proof. + unfold incl in |- *; simpl in |- *; intros l m n H H0 a H1. + now_show (In a n). + elim (in_app_or _ _ _ H1); auto. + Qed. + Hint Resolve incl_app. + +End SetIncl. -(** [seq] computes the sequence of [len] contiguous integers - that starts at [start]. For instance, [seq 2 3] is [2::3::4::nil]. *) +Hint Resolve incl_refl incl_tl incl_tran incl_appl incl_appr incl_cons + incl_app: datatypes v62. -Fixpoint seq (start len:nat) {struct len} : list nat := - match len with - | 0 => nil - | S len => start :: seq (S start) len - end. -Lemma seq_length : forall len start, length (seq start len) = len. -Proof. -induction len; simpl; auto. -Qed. +(**************************************) +(* ** Cutting a list at some position *) +(**************************************) + +Section Cutting. + + Variable A : Type. + + Fixpoint firstn (n:nat)(l:list A) {struct n} : list A := + match n with + | 0 => nil + | S n => match l with + | nil => nil + | a::l => a::(firstn n l) + end + end. + + Fixpoint skipn (n:nat)(l:list A) { struct n } : list A := + match n with + | 0 => l + | S n => match l with + | nil => nil + | a::l => skipn n l + end + end. + + Lemma firstn_skipn : forall n l, firstn n l ++ skipn n l = l. + Proof. + induction n. + simpl; auto. + destruct l; simpl; auto. + f_equal; auto. + Qed. + +End Cutting. -Lemma seq_nth : forall len start n d, - n < len -> nth n (seq start len) d = start+n. -Proof. -induction len; intros. -inversion H. -simpl seq. -destruct n; simpl. -auto with arith. -rewrite IHlen;simpl; auto with arith. -Qed. -Lemma seq_shift : forall len start, - map S (seq start len) = seq (S start) len. -Proof. -induction len; simpl; auto. -intros. -rewrite IHlen. -auto with arith. -Qed. +(********************************) +(** ** Lists without redundancy *) +(********************************) -End Functions_on_lists. +Section ReDun. + + Variable A : Type. + + Inductive NoDup : list A -> Prop := + | NoDup_nil : NoDup nil + | NoDup_cons : forall x l, ~ In x l -> NoDup l -> NoDup (x::l). + + Lemma NoDup_remove_1 : forall l l' a, NoDup (l++a::l') -> NoDup (l++l'). + Proof. + induction l; simpl. + inversion_clear 1; auto. + inversion_clear 1. + constructor. + swap H0. + apply in_or_app; destruct (in_app_or _ _ _ H); simpl; tauto. + apply IHl with a0; auto. + Qed. + + Lemma NoDup_remove_2 : forall l l' a, NoDup (l++a::l') -> ~In a (l++l'). + Proof. + induction l; simpl. + inversion_clear 1; auto. + inversion_clear 1. + swap H0. + destruct H. + subst a0. + apply in_or_app; right; red; auto. + destruct (IHl _ _ H1); auto. + Qed. + + Lemma NoDup_Permutation : forall l l', + NoDup l -> NoDup l' -> (forall x, In x l <-> In x l') -> Permutation l l'. + Proof. + induction l. + destruct l'; simpl; intros. + apply perm_nil. + destruct (H1 a) as (_,H2); destruct H2; auto. + intros. + destruct (In_split a l') as (l'1,(l'2,H2)). + destruct (H1 a) as (H2,H3); simpl in *; auto. + subst l'. + apply Permutation_cons_app. + inversion_clear H. + apply IHl; auto. + apply NoDup_remove_1 with a; auto. + intro x; split; intros. + assert (In x (l'1++a::l'2)). + destruct (H1 x); simpl in *; auto. + apply in_or_app; destruct (in_app_or _ _ _ H4); auto. + destruct H5; auto. + subst x; destruct H2; auto. + assert (In x (l'1++a::l'2)). + apply in_or_app; destruct (in_app_or _ _ _ H); simpl; auto. + destruct (H1 x) as (_,H5); destruct H5; auto. + subst x. + destruct (NoDup_remove_2 _ _ _ H0 H). + Qed. + +End ReDun. + + +(***********************************) +(** ** Sequence of natural numbers *) +(***********************************) + +Section NatSeq. + + (** [seq] computes the sequence of [len] contiguous integers + that starts at [start]. For instance, [seq 2 3] is [2::3::4::nil]. *) + + Fixpoint seq (start len:nat) {struct len} : list nat := + match len with + | 0 => nil + | S len => start :: seq (S start) len + end. + + Lemma seq_length : forall len start, length (seq start len) = len. + Proof. + induction len; simpl; auto. + Qed. + + Lemma seq_nth : forall len start n d, + n < len -> nth n (seq start len) d = start+n. + Proof. + induction len; intros. + inversion H. + simpl seq. + destruct n; simpl. + auto with arith. + rewrite IHlen;simpl; auto with arith. + Qed. + + Lemma seq_shift : forall len start, + map S (seq start len) = seq (S start) len. + Proof. + induction len; simpl; auto. + intros. + rewrite IHlen. + auto with arith. + Qed. + +End NatSeq. + + + + (** * Exporting hints and tactics *) Hint Rewrite - rev_involutive (* rev (rev l) = l *) - rev_unit (* rev (l ++ a :: nil) = a :: rev l *) - map_nth (* nth n (map f l) (f d) = f (nth n l d) *) - map_length (* length (map f l) = length l *) - seq_length (* length (seq start len) = len *) - app_length (* length (l ++ l') = length l + length l' *) - rev_length (* length (rev l) = length l *) - : list. + rev_involutive (* rev (rev l) = l *) + rev_unit (* rev (l ++ a :: nil) = a :: rev l *) + map_nth (* nth n (map f l) (f d) = f (nth n l d) *) + map_length (* length (map f l) = length l *) + seq_length (* length (seq start len) = len *) + app_length (* length (l ++ l') = length l + length l' *) + rev_length (* length (rev l) = length l *) + : list. Hint Rewrite <- - app_nil_end (* l = l ++ nil *) - : list. + app_nil_end (* l = l ++ nil *) + : list. Ltac simpl_list := autorewrite with list. Ltac ssimpl_list := autorewrite with list using simpl. diff --git a/theories/Lists/SetoidList.v b/theories/Lists/SetoidList.v index 811dcab4..eb40594b 100644 --- a/theories/Lists/SetoidList.v +++ b/theories/Lists/SetoidList.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -(* $Id: SetoidList.v 8686 2006-04-06 13:25:10Z letouzey $ *) +(* $Id: SetoidList.v 8853 2006-05-23 18:17:38Z herbelin $ *) Require Export List. Require Export Sorting. @@ -80,6 +80,17 @@ Proof. Qed. Hint Resolve In_InA. +Lemma InA_split : forall l x, InA x l -> + exists l1, exists y, exists l2, + eqA x y /\ l = l1++y::l2. +Proof. +induction l; inversion_clear 1. +exists (@nil A); exists a; exists l; auto. +destruct (IHl x H0) as (l1,(y,(l2,(H1,H2)))). +exists (a::l1); exists y; exists l2; auto. +split; simpl; f_equal; auto. +Qed. + (** Results concerning lists modulo [eqA] and [ltA] *) Variable ltA : A -> A -> Prop. @@ -149,7 +160,7 @@ Proof. inversion_clear H0. constructor; auto. intro. - assert (ltA x x) by eapply SortA_InfA_InA; eauto. + assert (ltA x x) by (eapply SortA_InfA_InA; eauto). elim (ltA_not_eqA H3); auto. Qed. @@ -228,6 +239,18 @@ Section Remove. Hypothesis eqA_dec : forall x y : A, {eqA x y}+{~(eqA x y)}. +Lemma InA_dec : forall x l, { InA x l } + { ~ InA x l }. +Proof. +induction l. +right; auto. +red; inversion 1. +destruct (eqA_dec x a). +left; auto. +destruct IHl. +left; auto. +right; red; inversion_clear 1; tauto. +Qed. + Fixpoint removeA (x : A) (l : list A){struct l} : list A := match l with | nil => nil @@ -290,6 +313,149 @@ inversion_clear H1; auto. elim H2; auto. Qed. +Let addlistA x l l' := forall y, InA y l' <-> eqA x y \/ InA y l. + +Lemma removeA_add : + forall s s' x x', NoDupA s -> NoDupA (x' :: s') -> + ~ eqA x x' -> ~ InA x s -> + addlistA x s (x' :: s') -> addlistA x (removeA x' s) s'. +Proof. +unfold addlistA; intros. +inversion_clear H0. +rewrite removeA_InA; auto. +split; intros. +destruct (eqA_dec x y); auto; intros. +right; split; auto. +destruct (H3 y); clear H3. +destruct H6; intuition. +swap H4; apply InA_eqA with y; auto. +destruct H0. +assert (InA y (x' :: s')) by (rewrite H3; auto). +inversion_clear H6; auto. +elim H1; apply eqA_trans with y; auto. +destruct H0. +assert (InA y (x' :: s')) by (rewrite H3; auto). +inversion_clear H7; auto. +elim H6; auto. +Qed. + +Section Fold. + +Variable B:Set. +Variable eqB:B->B->Prop. + +(** Two-argument functions that allow to reorder its arguments. *) +Definition transpose (f : A -> B -> B) := + forall (x y : A) (z : B), eqB (f x (f y z)) (f y (f x z)). + +(** Compatibility of a two-argument function with respect to two equalities. *) +Definition compat_op (f : A -> B -> B) := + forall (x x' : A) (y y' : B), eqA x x' -> eqB y y' -> eqB (f x y) (f x' y'). + +(** Compatibility of a function upon natural numbers. *) +Definition compat_nat (f : A -> nat) := + forall x x' : A, eqA x x' -> f x = f x'. + +Variable st:Setoid_Theory _ eqB. +Variable f:A->B->B. +Variable Comp:compat_op f. +Variable Ass:transpose f. +Variable i:B. + +Lemma removeA_fold_right_0 : + forall s x, ~InA x s -> + eqB (fold_right f i s) (fold_right f i (removeA x s)). +Proof. + simple induction s; simpl; intros. + refl_st. + destruct (eqA_dec x a); simpl; intros. + absurd_hyp e; auto. + apply Comp; auto. +Qed. + +Lemma removeA_fold_right : + forall s x, NoDupA s -> InA x s -> + eqB (fold_right f i s) (f x (fold_right f i (removeA x s))). +Proof. + simple induction s; simpl. + inversion_clear 2. + intros. + inversion_clear H0. + destruct (eqA_dec x a); simpl; intros. + apply Comp; auto. + apply removeA_fold_right_0; auto. + swap H2; apply InA_eqA with x; auto. + inversion_clear H1. + destruct n; auto. + trans_st (f a (f x (fold_right f i (removeA x l)))). +Qed. + +Lemma fold_right_equal : + forall s s', NoDupA s -> NoDupA s' -> + eqlistA s s' -> eqB (fold_right f i s) (fold_right f i s'). +Proof. + simple induction s. + destruct s'; simpl. + intros; refl_st; auto. + unfold eqlistA; intros. + destruct (H1 a). + assert (X : InA a nil); auto; inversion X. + intros x l Hrec s' N N' E; simpl in *. + trans_st (f x (fold_right f i (removeA x s'))). + apply Comp; auto. + apply Hrec; auto. + inversion N; auto. + apply removeA_NoDupA; auto; apply eqA_trans. + apply removeA_eqlistA; auto. + inversion_clear N; auto. + sym_st. + apply removeA_fold_right; auto. + unfold eqlistA in E. + rewrite <- E; auto. +Qed. + +Lemma fold_right_add : + forall s' s x, NoDupA s -> NoDupA s' -> ~ InA x s -> + addlistA x s s' -> eqB (fold_right f i s') (f x (fold_right f i s)). +Proof. + simple induction s'. + unfold addlistA; intros. + destruct (H2 x); clear H2. + assert (X : InA x nil); auto; inversion X. + intros x' l' Hrec s x N N' IN EQ; simpl. + (* if x=x' *) + destruct (eqA_dec x x'). + apply Comp; auto. + apply fold_right_equal; auto. + inversion_clear N'; trivial. + unfold eqlistA; unfold addlistA in EQ; intros. + destruct (EQ x0); clear EQ. + split; intros. + destruct H; auto. + inversion_clear N'. + destruct H2; apply InA_eqA with x0; auto. + apply eqA_trans with x; auto. + assert (X:InA x0 (x' :: l')); auto; inversion_clear X; auto. + destruct IN; apply InA_eqA with x0; auto. + apply eqA_trans with x'; auto. + (* else x<>x' *) + trans_st (f x' (f x (fold_right f i (removeA x' s)))). + apply Comp; auto. + apply Hrec; auto. + apply removeA_NoDupA; auto; apply eqA_trans. + inversion_clear N'; auto. + rewrite removeA_InA; intuition. + apply removeA_add; auto. + trans_st (f x (f x' (fold_right f i (removeA x' s)))). + apply Comp; auto. + sym_st. + apply removeA_fold_right; auto. + destruct (EQ x'). + destruct H; auto; destruct n; auto. +Qed. + +End Fold. + End Remove. End Type_with_equality. @@ -298,3 +464,52 @@ Hint Constructors InA. Hint Constructors NoDupA. Hint Constructors sort. Hint Constructors lelistA. + +Section Find. +Variable A B : Set. +Variable eqA : A -> A -> Prop. +Hypothesis eqA_sym : forall x y, eqA x y -> eqA y x. +Hypothesis eqA_trans : forall x y z, eqA x y -> eqA y z -> eqA x z. +Hypothesis eqA_dec : forall x y : A, {eqA x y}+{~(eqA x y)}. + +Fixpoint findA (f : A -> bool) (l:list (A*B)) : option B := + match l with + | nil => None + | (a,b)::l => if f a then Some b else findA f l + end. + +Lemma findA_NoDupA : + forall l a b, + NoDupA (fun p p' => eqA (fst p) (fst p')) l -> + (InA (fun p p' => eqA (fst p) (fst p') /\ snd p = snd p') (a,b) l <-> + findA (fun a' => if eqA_dec a a' then true else false) l = Some b). +Proof. +induction l; simpl; intros. +split; intros; try discriminate. +inversion H0. +destruct a as (a',b'); rename a0 into a. +inversion_clear H. +split; intros. +inversion_clear H. +simpl in *; destruct H2; subst b'. +destruct (eqA_dec a a'); intuition. +destruct (eqA_dec a a'); simpl. +destruct H0. +generalize e H2 eqA_trans eqA_sym; clear. +induction l. +inversion 2. +inversion_clear 2; intros; auto. +destruct a0. +compute in H; destruct H. +subst b. +constructor 1; auto. +simpl. +apply eqA_trans with a; auto. +rewrite <- IHl; auto. +destruct (eqA_dec a a'); simpl in *. +inversion H; clear H; intros; subst b'; auto. +constructor 2. +rewrite IHl; auto. +Qed. + +End Find. diff --git a/theories/Lists/TheoryList.v b/theories/Lists/TheoryList.v index 19f97aec..2bfb70fe 100644 --- a/theories/Lists/TheoryList.v +++ b/theories/Lists/TheoryList.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: TheoryList.v 8642 2006-03-17 10:09:02Z notin $ i*) +(*i $Id: TheoryList.v 8866 2006-05-28 16:21:04Z herbelin $ i*) (** Some programs and results about lists following CAML Manual *) @@ -14,7 +14,7 @@ Require Export List. Set Implicit Arguments. Section Lists. -Variable A : Set. +Variable A : Type. (**********************) (** The null function *) @@ -325,7 +325,7 @@ Realizer find. *) Qed. -Variable B : Set. +Variable B : Type. Variable T : A -> B -> Prop. Variable TS_dec : forall a:A, {c : B | T a c} + {P a}. @@ -358,7 +358,7 @@ End Find_sec. Section Assoc_sec. -Variable B : Set. +Variable B : Type. Fixpoint assoc (a:A) (l:list (A * B)) {struct l} : Exc B := match l with diff --git a/theories/Logic/ChoiceFacts.v b/theories/Logic/ChoiceFacts.v index bc892ca9..e0be9ed3 100644 --- a/theories/Logic/ChoiceFacts.v +++ b/theories/Logic/ChoiceFacts.v @@ -1,3 +1,4 @@ +(* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) (* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) @@ -6,155 +7,453 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: ChoiceFacts.v 8132 2006-03-05 10:59:47Z herbelin $ i*) +(*i $Id: ChoiceFacts.v 8892 2006-06-04 17:59:53Z herbelin $ i*) -(** We show that the functional formulation of the axiom of Choice - (usual formulation in type theory) is equivalent to its relational - formulation (only formulation of set theory) + the axiom of - (parametric) definite description (aka axiom of unique choice) *) +(** ** Some facts and definitions concerning choice and description in + intuitionistic logic. -(** This shows that the axiom of choice can be assumed (under its - relational formulation) without known inconsistency with classical logic, - though definite description conflicts with classical logic *) +We investigate the relations between the following choice and +description principles + +- AC_rel = relational form of the (non extensional) axiom of choice + (a "set-theoretic" axiom of choice) +- AC_fun = functional form of the (non extensional) axiom of choice + (a "type-theoretic" axiom of choice) +- AC! = functional relation reification + (known as axiom of unique choice in topos theory, + sometimes called principle of definite description in + the context of constructive type theory) + +- GAC_rel = guarded relational form of the (non extensional) axiom of choice +- GAC_fun = guarded functional form of the (non extensional) axiom of choice +- GAC! = guarded functional relation reification + +- OAC_rel = "omniscient" relational form of the (non extensional) axiom of choice +- OAC_fun = "omniscient" functional form of the (non extensional) axiom of choice + (called AC* in Bell [Bell]) +- OAC! + +- ID_iota = intuitionistic definite description +- ID_epsilon = intuitionistic indefinite description + +- D_iota = (weakly classical) definite description principle +- D_epsilon = (weakly classical) indefinite description principle + +- PI = proof irrelevance +- IGP = independence of general premises + (an unconstrained generalisation of the constructive principle of + independence of premises) +- Drinker = drinker's paradox (small form) + (called Ex in Bell [Bell]) + +We let also + +IPL_2^2 = 2nd-order impredicative, 2nd-order functional minimal predicate logic +IPL_2 = 2nd-order impredicative minimal predicate logic +IPL^2 = 2nd-order functional minimal predicate logic (with ex. quant.) + +Table of contents + +A. Definitions + +B. IPL_2^2 |- AC_rel + AC! = AC_fun + +C. 1. AC_rel + PI -> GAC_rel and PL_2 |- AC_rel + IGP -> GAC_rel and GAC_rel = OAC_rel + +C. 2. IPL^2 |- AC_fun + IGP = GAC_fun = OAC_fun = AC_fun + Drinker + +D. Derivability of choice for decidable relations with well-ordered codomain + +E. Equivalence of choices on dependent or non dependent functional types + +F. Non contradiction of constructive descriptions wrt functional choices + +G. Definite description transports classical logic to the computational world -Section ChoiceEquivalences. +References: + +[Bell] John L. Bell, Choice principles in intuitionistic set theory, +unpublished. + +[Bell93] John L. Bell, Hilbert's Epsilon Operator in Intuitionistic +Type Theories, Mathematical Logic Quarterly, volume 39, 1993. + +[Carlstrøm05] Jesper Carlstrøm, Interpreting descriptions in +intentional type theory, Journal of Symbolic Logic 70(2):488-514, 2005. +*) + +Set Implicit Arguments. + +Notation Local "'inhabited' A" := A (at level 10, only parsing). + +(**********************************************************************) +(** *** A. Definitions *) + +(** Choice, reification and description schemes *) + +Section ChoiceSchemes. Variables A B :Type. -Definition RelationalChoice := - forall (R:A -> B -> Prop), - (forall x:A, exists y : B, R x y) -> - exists R' : A -> B -> Prop, - (forall x:A, - exists y : B, R x y /\ R' x y /\ (forall y':B, R' x y' -> y = y')). +Variables P:A->Prop. + +Variables R:A->B->Prop. + +(** **** Constructive choice and description *) + +(** AC_rel *) + +Definition RelationalChoice_on := + forall R:A->B->Prop, + (forall x : A, exists y : B, R x y) -> + (exists R' : A->B->Prop, subrelation R' R /\ forall x, exists! y, R' x y). + +(** AC_fun *) + +Definition FunctionalChoice_on := + forall R:A->B->Prop, + (forall x : A, exists y : B, R x y) -> + (exists f : A->B, forall x : A, R x (f x)). + +(** AC! or Functional Relation Reification (known as Axiom of Unique Choice + in topos theory; also called principle of definite description *) + +Definition FunctionalRelReification_on := + forall R:A->B->Prop, + (forall x : A, exists! y : B, R x y) -> + (exists f : A->B, forall x : A, R x (f x)). + +(** ID_epsilon (constructive version of indefinite description; + combined with proof-irrelevance, it may be connected to + Carlstrøm's type theory with a constructive indefinite description + operator) *) + +Definition ConstructiveIndefiniteDescription_on := + forall P:A->Prop, + (exists x, P x) -> { x:A | P x }. + +(** ID_iota (constructive version of definite description; combined + with proof-irrelevance, it may be connected to Carlstrøm's and + Stenlund's type theory with a constructive definite description + operator) *) + +Definition ConstructiveDefiniteDescription_on := + forall P:A->Prop, + (exists! x, P x) -> { x:A | P x }. + +(** **** Weakly classical choice and description *) -Definition FunctionalChoice := - forall (R:A -> B -> Prop), - (forall x:A, exists y : B, R x y) -> - exists f : A -> B, (forall x:A, R x (f x)). +(** GAC_rel *) -Definition ParamDefiniteDescription := - forall (R:A -> B -> Prop), - (forall x:A, exists y : B, R x y /\ (forall y':B, R x y' -> y = y')) -> - exists f : A -> B, (forall x:A, R x (f x)). +Definition GuardedRelationalChoice_on := + forall P : A->Prop, forall R : A->B->Prop, + (forall x : A, P x -> exists y : B, R x y) -> + (exists R' : A->B->Prop, + subrelation R' R /\ forall x, P x -> exists! y, R' x y). + +(** GAC_fun *) + +Definition GuardedFunctionalChoice_on := + forall P : A->Prop, forall R : A->B->Prop, + inhabited B -> + (forall x : A, P x -> exists y : B, R x y) -> + (exists f : A->B, forall x, P x -> R x (f x)). + +(** GFR_fun *) + +Definition GuardedFunctionalRelReification_on := + forall P : A->Prop, forall R : A->B->Prop, + inhabited B -> + (forall x : A, P x -> exists! y : B, R x y) -> + (exists f : A->B, forall x : A, P x -> R x (f x)). + +(** OAC_rel *) + +Definition OmniscientRelationalChoice_on := + forall R : A->B->Prop, + exists R' : A->B->Prop, + subrelation R' R /\ forall x : A, (exists y : B, R x y) -> exists! y, R' x y. + +(** OAC_fun *) + +Definition OmniscientFunctionalChoice_on := + forall R : A->B->Prop, + inhabited B -> + exists f : A->B, forall x : A, (exists y : B, R x y) -> R x (f x). + +(** D_epsilon *) + +Definition ClassicalIndefiniteDescription := + forall P:A->Prop, + A -> { x:A | (exists x, P x) -> P x }. + +(** D_iota *) + +Definition ClassicalDefiniteDescription := + forall P:A->Prop, + A -> { x:A | (exists! x, P x) -> P x }. + +End ChoiceSchemes. + +(** Generalized schemes *) + +Notation RelationalChoice := + (forall A B, RelationalChoice_on A B). +Notation FunctionalChoice := + (forall A B, FunctionalChoice_on A B). +Notation FunctionalChoiceOnInhabitedSet := + (forall A B, inhabited B -> FunctionalChoice_on A B). +Notation FunctionalRelReification := + (forall A B, FunctionalRelReification_on A B). + +Notation GuardedRelationalChoice := + (forall A B, GuardedRelationalChoice_on A B). +Notation GuardedFunctionalChoice := + (forall A B, GuardedFunctionalChoice_on A B). +Notation GuardedFunctionalRelReification := + (forall A B, GuardedFunctionalRelReification_on A B). + +Notation OmniscientRelationalChoice := + (forall A B, OmniscientRelationalChoice_on A B). +Notation OmniscientFunctionalChoice := + (forall A B, OmniscientFunctionalChoice_on A B). + +Notation ConstructiveDefiniteDescription := + (forall A, ConstructiveDefiniteDescription_on A). +Notation ConstructiveIndefiniteDescription := + (forall A, ConstructiveIndefiniteDescription_on A). + +(** Subclassical schemes *) + +Definition ProofIrrelevance := + forall (A:Prop) (a1 a2:A), a1 = a2. + +Definition IndependenceOfGeneralPremises := + forall (A:Type) (P:A -> Prop) (Q:Prop), + inhabited A -> + (Q -> exists x, P x) -> exists x, Q -> P x. + +Definition SmallDrinker'sParadox := + forall (A:Type) (P:A -> Prop), inhabited A -> + exists x, (exists x, P x) -> P x. + +(**********************************************************************) +(** *** B. AC_rel + PDP = AC_fun + + We show that the functional formulation of the axiom of Choice + (usual formulation in type theory) is equivalent to its relational + formulation (only formulation of set theory) + the axiom of + (parametric) definite description (aka axiom of unique choice) *) + +(** This shows that the axiom of choice can be assumed (under its + relational formulation) without known inconsistency with classical logic, + though definite description conflicts with classical logic *) Lemma description_rel_choice_imp_funct_choice : - ParamDefiniteDescription -> RelationalChoice -> FunctionalChoice. -intros Descr RelCh. -red in |- *; intros R H. -destruct (RelCh R H) as [R' H0]. -destruct (Descr R') as [f H1]. -intro x. -elim (H0 x); intros y [H2 [H3 H4]]; exists y; split; [ exact H3 | exact H4 ]. + forall A B : Type, + FunctionalRelReification_on A B -> RelationalChoice_on A B -> FunctionalChoice_on A B. +Proof. +intros A B Descr RelCh R H. +destruct (RelCh R H) as (R',(HR'R,H0)). +destruct (Descr R') as (f,Hf). +firstorder. exists f; intro x. -elim (H0 x); intros y [H2 [H3 H4]]. -rewrite <- (H4 (f x) (H1 x)). -exact H2. +destruct (H0 x) as (y,(HR'xy,Huniq)). +rewrite <- (Huniq (f x) (Hf x)). +apply HR'R; assumption. Qed. -Lemma funct_choice_imp_rel_choice : FunctionalChoice -> RelationalChoice. -intros FunCh. -red in |- *; intros R H. -destruct (FunCh R H) as [f H0]. -exists (fun x y => y = f x). -intro x; exists (f x); split; - [ apply H0 - | split; [ reflexivity | intros y H1; symmetry in |- *; exact H1 ] ]. +Lemma funct_choice_imp_rel_choice : + forall A B, FunctionalChoice_on A B -> RelationalChoice_on A B. +Proof. +intros A B FunCh R H. +destruct (FunCh R H) as (f,H0). +exists (fun x y => f x = y). +split. + intros x y Heq; rewrite <- Heq; trivial. + intro x; exists (f x); split. + reflexivity. + trivial. Qed. -Lemma funct_choice_imp_description : - FunctionalChoice -> ParamDefiniteDescription. -intros FunCh. -red in |- *; intros R H. +Lemma funct_choice_imp_description : + forall A B, FunctionalChoice_on A B -> FunctionalRelReification_on A B. +Proof. +intros A B FunCh R H. destruct (FunCh R) as [f H0]. (* 1 *) intro x. -elim (H x); intros y [H0 H1]. -exists y; exact H0. +destruct (H x) as (y,(HRxy,_)). +exists y; exact HRxy. (* 2 *) exists f; exact H0. Qed. Theorem FunChoice_Equiv_RelChoice_and_ParamDefinDescr : - FunctionalChoice <-> RelationalChoice /\ ParamDefiniteDescription. -split. + forall A B, FunctionalChoice_on A B <-> + RelationalChoice_on A B /\ FunctionalRelReification_on A B. +Proof. +intros A B; split. intro H; split; [ exact (funct_choice_imp_rel_choice H) | exact (funct_choice_imp_description H) ]. intros [H H0]; exact (description_rel_choice_imp_funct_choice H0 H). Qed. -End ChoiceEquivalences. +(**********************************************************************) +(** *** C. Connection between the guarded, non guarded and descriptive choices and *) (** We show that the guarded relational formulation of the axiom of Choice comes from the non guarded formulation in presence either of the independance of premises or proof-irrelevance *) -Definition GuardedRelationalChoice (A B:Type) := - forall (P:A -> Prop) (R:A -> B -> Prop), - (forall x:A, P x -> exists y : B, R x y) -> - exists R' : A -> B -> Prop, - (forall x:A, - P x -> - exists y : B, R x y /\ R' x y /\ (forall y':B, R' x y' -> y = y')). - -Definition ProofIrrelevance := forall (A:Prop) (a1 a2:A), a1 = a2. +(**********************************************************************) +(** **** C. 1. AC_rel + PI -> GAC_rel and AC_rel + IGP -> GAC_rel and GAC_rel = OAC_rel *) Lemma rel_choice_and_proof_irrel_imp_guarded_rel_choice : - (forall A B, RelationalChoice A B) - -> ProofIrrelevance -> (forall A B, GuardedRelationalChoice A B). + RelationalChoice -> ProofIrrelevance -> GuardedRelationalChoice. Proof. intros rel_choice proof_irrel. red in |- *; intros A B P R H. -destruct (rel_choice _ _ (fun (x:sigT P) (y:B) => R (projT1 x) y)) as [R' H0]. -intros [x HPx]. -destruct (H x HPx) as [y HRxy]. +destruct (rel_choice _ _ (fun (x:sigT P) (y:B) => R (projT1 x) y)) as (R',(HR'R,H0)). +intros (x,HPx). +destruct (H x HPx) as (y,HRxy). exists y; exact HRxy. set (R'' := fun (x:A) (y:B) => exists H : P x, R' (existT P x H) y). -exists R''; intros x HPx. -destruct (H0 (existT P x HPx)) as [y [HRxy [HR'xy Huniq]]]. -exists y. split. - exact HRxy. - split. - red in |- *; exists HPx; exact HR'xy. - intros y' HR''xy'. +exists R''; split. + intros x y (HPx,HR'xy). + change x with (projT1 (existT P x HPx)); apply HR'R; exact HR'xy. + intros x HPx. + destruct (H0 (existT P x HPx)) as (y,(HR'xy,Huniq)). + exists y; split. exists HPx; exact HR'xy. + intros y' (H'Px,HR'xy'). apply Huniq. - unfold R'' in HR''xy'. - destruct HR''xy' as [H'Px HR'xy']. - rewrite proof_irrel with (a1 := HPx) (a2 := H'Px). - exact HR'xy'. + rewrite proof_irrel with (a1 := HPx) (a2 := H'Px); exact HR'xy'. Qed. -Definition IndependenceOfGeneralPremises := - forall (A:Type) (P:A -> Prop) (Q:Prop), - (Q -> exists x, P x) -> exists x, Q -> P x. - Lemma rel_choice_indep_of_general_premises_imp_guarded_rel_choice : - forall A B, RelationalChoice A B -> - IndependenceOfGeneralPremises -> GuardedRelationalChoice A B. -Proof. -intros A B RelCh IndPrem. -red in |- *; intros P R H. -destruct (RelCh (fun x y => P x -> R x y)) as [R' H0]. - intro x. apply IndPrem. - apply H. - exists R'. - intros x HPx. - destruct (H0 x) as [y [H1 H2]]. - exists y. split. - apply (H1 HPx). - exact H2. + forall A B, inhabited B -> RelationalChoice_on A B -> + IndependenceOfGeneralPremises -> GuardedRelationalChoice_on A B. +Proof. +intros A B Inh AC_rel IndPrem P R H. +destruct (AC_rel (fun x y => P x -> R x y)) as (R',(HR'R,H0)). + intro x. apply IndPrem. exact Inh. intro Hx. + apply H; assumption. + exists (fun x y => P x /\ R' x y). + firstorder. +Qed. + +Lemma guarded_rel_choice_imp_rel_choice : + forall A B, GuardedRelationalChoice_on A B -> RelationalChoice_on A B. +Proof. +intros A B GAC_rel R H. +destruct (GAC_rel (fun _ => True) R) as (R',(HR'R,H0)). + firstorder. +exists R'; firstorder. Qed. +(** OAC_rel = GAC_rel *) + +Lemma guarded_iff_omniscient_rel_choice : + GuardedRelationalChoice <-> OmniscientRelationalChoice. +Proof. +split. + intros GAC_rel A B R. + apply (GAC_rel A B (fun x => exists y, R x y) R); auto. + intros OAC_rel A B P R H. + destruct (OAC_rel A B R) as (f,Hf); exists f; firstorder. +Qed. + +(**********************************************************************) +(** **** C. 2. AC_fun + IGP = GAC_fun = OAC_fun = AC_fun + Drinker *) + +(** AC_fun + IGP = GAC_fun *) + +Lemma guarded_fun_choice_imp_indep_of_general_premises : + GuardedFunctionalChoice -> IndependenceOfGeneralPremises. +Proof. +intros GAC_fun A P Q Inh H. +destruct (GAC_fun unit A (fun _ => Q) (fun _ => P) Inh) as (f,Hf). +tauto. +exists (f tt); auto. +Qed. + +Lemma guarded_fun_choice_imp_fun_choice : + GuardedFunctionalChoice -> FunctionalChoiceOnInhabitedSet. +Proof. +intros GAC_fun A B Inh R H. +destruct (GAC_fun A B (fun _ => True) R Inh) as (f,Hf). +firstorder. +exists f; auto. +Qed. + +Lemma fun_choice_and_indep_general_prem_imp_guarded_fun_choice : + FunctionalChoiceOnInhabitedSet -> IndependenceOfGeneralPremises + -> GuardedFunctionalChoice. +Proof. +intros AC_fun IndPrem A B P R Inh H. +apply (AC_fun A B Inh (fun x y => P x -> R x y)). +intro x; apply IndPrem; eauto. +Qed. + +(** AC_fun + Drinker = OAC_fun *) + +(** This was already observed by Bell [Bell] *) + +Lemma omniscient_fun_choice_imp_small_drinker : + OmniscientFunctionalChoice -> SmallDrinker'sParadox. +Proof. +intros OAC_fun A P Inh. +destruct (OAC_fun unit A (fun _ => P)) as (f,Hf). +auto. +exists (f tt); firstorder. +Qed. + +Lemma omniscient_fun_choice_imp_fun_choice : + OmniscientFunctionalChoice -> FunctionalChoiceOnInhabitedSet. +Proof. +intros OAC_fun A B Inh R H. +destruct (OAC_fun A B R Inh) as (f,Hf). +exists f; firstorder. +Qed. + +Lemma fun_choice_and_small_drinker_imp_omniscient_fun_choice : + FunctionalChoiceOnInhabitedSet -> SmallDrinker'sParadox + -> OmniscientFunctionalChoice. +Proof. +intros AC_fun Drinker A B R Inh. +destruct (AC_fun A B Inh (fun x y => (exists y, R x y) -> R x y)) as (f,Hf). + intro x; apply (Drinker B (R x) Inh). + exists f; assumption. +Qed. + +(** OAC_fun = GAC_fun *) + +(** This is derivable from the intuitionistic equivalence between IGP and Drinker +but we give a direct proof *) + +Lemma guarded_iff_omniscient_fun_choice : + GuardedFunctionalChoice <-> OmniscientFunctionalChoice. +Proof. +split. + intros GAC_fun A B R Inh. + apply (GAC_fun A B (fun x => exists y, R x y) R); auto. + intros OAC_fun A B P R Inh H. + destruct (OAC_fun A B R Inh) as (f,Hf). + exists f; firstorder. +Qed. + +(**********************************************************************) +(** *** D. Derivability of choice for decidable relations with well-ordered codomain *) (** Countable codomains, such as [nat], can be equipped with a well-order, which implies the existence of a least element on inhabited decidable subsets. As a consequence, the relational form of the axiom of choice is derivable on [nat] for decidable relations. - We show instead that definite description and the functional form - of the axiom of choice are equivalent on decidable relation with [nat] - as codomain + We show instead that functional relation reification and the + functional form of the axiom of choice are equivalent on decidable + relation with [nat] as codomain *) Require Import Wf_nat. @@ -163,12 +462,11 @@ Require Import Decidable. Require Import Arith. Definition has_unique_least_element (A:Type) (R:A->A->Prop) (P:A->Prop) := - (exists x, (P x /\ forall x', P x' -> R x x') - /\ forall x', P x' /\ (forall x'', P x'' -> R x' x'') -> x=x'). + exists! x, P x /\ forall x', P x' -> R x x'. Lemma dec_inh_nat_subset_has_unique_least_element : forall P:nat->Prop, (forall n, P n \/ ~ P n) -> - (exists n, P n) -> has_unique_least_element nat le P. + (exists n, P n) -> has_unique_least_element le P. Proof. intros P Pdec (n0,HPn0). assert @@ -194,30 +492,228 @@ assert assumption. destruct H0. rewrite Heqn; assumption. -destruct (H n0) as [(n,(Hltn,(Hmin,Huniqn)))|]; [exists n | exists n0]; - repeat split; + destruct (H n0) as [(n,(Hltn,(Hmin,Huniqn)))|]; [exists n | exists n0]; + repeat split; assumption || intros n' (HPn',Hminn'); apply le_antisym; auto. Qed. -Definition FunctionalChoice_on (A B:Type) (R:A->B->Prop) := - (forall x:A, exists y : B, R x y) -> - exists f : A -> B, (forall x:A, R x (f x)). +Definition FunctionalChoice_on_rel (A B:Type) (R:A->B->Prop) := + (forall x:A, exists y : B, R x y) -> + exists f : A -> B, (forall x:A, R x (f x)). Lemma classical_denumerable_description_imp_fun_choice : forall A:Type, - ParamDefiniteDescription A nat -> - forall R, (forall x y, decidable (R x y)) -> FunctionalChoice_on A nat R. + FunctionalRelReification_on A nat -> + forall R:A->nat->Prop, + (forall x y, decidable (R x y)) -> FunctionalChoice_on_rel R. Proof. intros A Descr. red in |- *; intros R Rdec H. set (R':= fun x y => R x y /\ forall y', R x y' -> y <= y'). -destruct (Descr R') as [f Hf]. +destruct (Descr R') as (f,Hf). intro x. apply (dec_inh_nat_subset_has_unique_least_element (R x)). apply Rdec. apply (H x). exists f. intros x. -destruct (Hf x) as [Hfx _]. +destruct (Hf x) as (Hfx,_). +assumption. +Qed. + +(**********************************************************************) +(** *** E. Choice on dependent and non dependent function types are equivalent *) + +(** **** E. 1. Choice on dependent and non dependent function types are equivalent *) + +Definition DependentFunctionalChoice_on (A:Type) (B:A -> Type) := + forall R:forall x:A, B x -> Prop, + (forall x:A, exists y : B x, R x y) -> + (exists f : (forall x:A, B x), forall x:A, R x (f x)). + +Notation DependentFunctionalChoice := + (forall A (B:A->Type), DependentFunctionalChoice_on B). + +(** The easy part *) + +Theorem dep_non_dep_functional_choice : + DependentFunctionalChoice -> FunctionalChoice. +Proof. +intros AC_depfun A B R H. + destruct (AC_depfun A (fun _ => B) R H) as (f,Hf). + exists f; trivial. +Qed. + +(** Deriving choice on product types requires some computation on + singleton propositional types, so we need computational + conjunction projections and dependent elimination of conjunction + and equality *) + +Scheme and_indd := Induction for and Sort Prop. +Scheme eq_indd := Induction for eq Sort Prop. + +Definition proj1_inf (A B:Prop) (p : A/\B) := + let (a,b) := p in a. + +Theorem non_dep_dep_functional_choice : + FunctionalChoice -> DependentFunctionalChoice. +Proof. +intros AC_fun A B R H. +pose (B' := { x:A & B x }). +pose (R' := fun (x:A) (y:B') => projT1 y = x /\ R (projT1 y) (projT2 y)). +destruct (AC_fun A B' R') as (f,Hf). +intros x. destruct (H x) as (y,Hy). +exists (existT (fun x => B x) x y). split; trivial. +exists (fun x => eq_rect _ _ (projT2 (f x)) _ (proj1_inf (Hf x))). +intro x; destruct (Hf x) as (Heq,HR) using and_indd. +destruct (f x); simpl in *. +destruct Heq using eq_indd; trivial. +Qed. + +(** **** E. 2. Reification of dependent and non dependent functional relation are equivalent *) + +Definition DependentFunctionalRelReification_on (A:Type) (B:A -> Type) := + forall (R:forall x:A, B x -> Prop), + (forall x:A, exists! y : B x, R x y) -> + (exists f : (forall x:A, B x), forall x:A, R x (f x)). + +Notation DependentFunctionalRelReification := + (forall A (B:A->Type), DependentFunctionalRelReification_on B). + +(** The easy part *) + +Theorem dep_non_dep_functional_rel_reification : + DependentFunctionalRelReification -> FunctionalRelReification. +Proof. +intros DepFunReify A B R H. + destruct (DepFunReify A (fun _ => B) R H) as (f,Hf). + exists f; trivial. +Qed. + +(** Deriving choice on product types requires some computation on + singleton propositional types, so we need computational + conjunction projections and dependent elimination of conjunction + and equality *) + +Theorem non_dep_dep_functional_rel_reification : + FunctionalRelReification -> DependentFunctionalRelReification. +Proof. +intros AC_fun A B R H. +pose (B' := { x:A & B x }). +pose (R' := fun (x:A) (y:B') => projT1 y = x /\ R (projT1 y) (projT2 y)). +destruct (AC_fun A B' R') as (f,Hf). +intros x. destruct (H x) as (y,(Hy,Huni)). + exists (existT (fun x => B x) x y). repeat split; trivial. + intros (x',y') (Heqx',Hy'). + simpl in *. + destruct Heqx'. + rewrite (Huni y'); trivial. +exists (fun x => eq_rect _ _ (projT2 (f x)) _ (proj1_inf (Hf x))). +intro x; destruct (Hf x) as (Heq,HR) using and_indd. +destruct (f x); simpl in *. +destruct Heq using eq_indd; trivial. +Qed. + +(**********************************************************************) +(** *** F. Non contradiction of constructive descriptions wrt functional axioms of choice *) + +(** **** F. 1. Non contradiction of indefinite description *) + +Lemma relative_non_contradiction_of_indefinite_desc : + (ConstructiveIndefiniteDescription -> False) + -> (FunctionalChoice -> False). +Proof. +intros H AC_fun. +assert (AC_depfun := non_dep_dep_functional_choice AC_fun). +pose (A0 := { A:Type & { P:A->Prop & exists x, P x }}). +pose (B0 := fun x:A0 => projT1 x). +pose (R0 := fun x:A0 => fun y:B0 x => projT1 (projT2 x) y). +pose (H0 := fun x:A0 => projT2 (projT2 x)). +destruct (AC_depfun A0 B0 R0 H0) as (f, Hf). +apply H. +intros A P H'. +exists (f (existT (fun _ => sigT _) A + (existT (fun P => exists x, P x) P H'))). +pose (Hf' := + Hf (existT (fun _ => sigT _) A + (existT (fun P => exists x, P x) P H'))). assumption. Qed. + +Lemma constructive_indefinite_descr_fun_choice : + ConstructiveIndefiniteDescription -> FunctionalChoice. +Proof. +intros IndefDescr A B R H. +exists (fun x => proj1_sig (IndefDescr B (R x) (H x))). +intro x. +apply (proj2_sig (IndefDescr B (R x) (H x))). +Qed. + +(** **** F. 2. Non contradiction of definite description *) + +Lemma relative_non_contradiction_of_definite_descr : + (ConstructiveDefiniteDescription -> False) + -> (FunctionalRelReification -> False). +Proof. +intros H FunReify. +assert (DepFunReify := non_dep_dep_functional_rel_reification FunReify). +pose (A0 := { A:Type & { P:A->Prop & exists! x, P x }}). +pose (B0 := fun x:A0 => projT1 x). +pose (R0 := fun x:A0 => fun y:B0 x => projT1 (projT2 x) y). +pose (H0 := fun x:A0 => projT2 (projT2 x)). +destruct (DepFunReify A0 B0 R0 H0) as (f, Hf). +apply H. +intros A P H'. +exists (f (existT (fun _ => sigT _) A + (existT (fun P => exists! x, P x) P H'))). +pose (Hf' := + Hf (existT (fun _ => sigT _) A + (existT (fun P => exists! x, P x) P H'))). +assumption. +Qed. + +Lemma constructive_definite_descr_fun_reification : + ConstructiveDefiniteDescription -> FunctionalRelReification. +Proof. +intros DefDescr A B R H. +exists (fun x => proj1_sig (DefDescr B (R x) (H x))). +intro x. +apply (proj2_sig (DefDescr B (R x) (H x))). +Qed. + +(**********************************************************************) +(** *** G. Excluded-middle + definite description => computational excluded-middle *) + +(** The idea for the following proof comes from [ChicliPottierSimpson02] *) + +(** Classical logic and axiom of unique choice (i.e. functional + relation reification), as shown in [ChicliPottierSimpson02], + implies the double-negation of excluded-middle in [Set] (which is + incompatible with the impredicativity of [Set]). + + We adapt the proof to show that constructive definite description + transports excluded-middle from [Prop] to [Set]. + + [ChicliPottierSimpson02] Laurent Chicli, Loïc Pottier, Carlos + Simpson, Mathematical Quotients and Quotient Types in Coq, + Proceedings of TYPES 2002, Lecture Notes in Computer Science 2646, + Springer Verlag. *) + +Require Import Setoid. + +Theorem constructive_definite_descr_excluded_middle : + ConstructiveDefiniteDescription -> + (forall P:Prop, P \/ ~ P) -> (forall P:Prop, {P} + {~ P}). +Proof. +intros Descr EM P. +pose (select := fun b:bool => if b then P else ~P). +assert { b:bool | select b } as ([|],HP). + apply Descr. + rewrite <- unique_existence; split. + destruct (EM P). + exists true; trivial. + exists false; trivial. + intros [|] [|] H1 H2; simpl in *; reflexivity || contradiction. +left; trivial. +right; trivial. +Qed. diff --git a/theories/Logic/ClassicalChoice.v b/theories/Logic/ClassicalChoice.v index 5a633f84..bb8186ae 100644 --- a/theories/Logic/ClassicalChoice.v +++ b/theories/Logic/ClassicalChoice.v @@ -6,28 +6,40 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: ClassicalChoice.v 6401 2004-12-05 16:44:57Z herbelin $ i*) +(*i $Id: ClassicalChoice.v 8892 2006-06-04 17:59:53Z herbelin $ i*) -(** This file provides classical logic and functional choice *) +(** This file provides classical logic, and functional choice *) -(** This file extends ClassicalDescription.v with the axiom of choice. - As ClassicalDescription.v, it implies the double-negation of - excluded-middle in Set and implies a strongly classical - world. Especially it conflicts with impredicativity of Set, knowing - that true<>false in Set. -*) +(** This file extends ClassicalUniqueChoice.v with the axiom of choice. + As ClassicalUniqueChoice.v, it implies the double-negation of + excluded-middle in [Set] and leads to a classical world populated + with non computable functions. Especially it conflicts with the + impredicativity of [Set], knowing that [true<>false] in [Set]. *) -Require Export ClassicalDescription. +Require Export ClassicalUniqueChoice. Require Export RelationalChoice. Require Import ChoiceFacts. +Set Implicit Arguments. + +Definition subset (U:Type) (P Q:U->Prop) : Prop := forall x, P x -> Q x. + +Theorem singleton_choice : + forall (A : Type) (P : A->Prop), + (exists x : A, P x) -> exists P' : A->Prop, subset P' P /\ exists! x, P' x. +Proof. +intros A P H. +destruct (relational_choice unit A (fun _ => P) (fun _ => H)) as (R',(Hsub,HR')). +exists (R' tt); firstorder. +Qed. + Theorem choice : - forall (A B:Type) (R:A -> B -> Prop), - (forall x:A, exists y : B, R x y) -> - exists f : A -> B, (forall x:A, R x (f x)). + forall (A B : Type) (R : A->B->Prop), + (forall x : A, exists y : B, R x y) -> + exists f : A->B, (forall x : A, R x (f x)). Proof. intros A B. apply description_rel_choice_imp_funct_choice. -exact (description A B). +exact (unique_choice A B). exact (relational_choice A B). Qed. diff --git a/theories/Logic/ClassicalDescription.v b/theories/Logic/ClassicalDescription.v index ce3e279c..7053266a 100644 --- a/theories/Logic/ClassicalDescription.v +++ b/theories/Logic/ClassicalDescription.v @@ -6,73 +6,95 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: ClassicalDescription.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: ClassicalDescription.v 8892 2006-06-04 17:59:53Z herbelin $ i*) (** This file provides classical logic and definite description *) -(** Classical logic and definite description, as shown in [1], - implies the double-negation of excluded-middle in Set, hence it - implies a strongly classical world. Especially it conflicts with - impredicativity of Set, knowing that true<>false in Set. +(** Classical definite description operator (i.e. iota) implies + excluded-middle in [Set] and leads to a classical world populated + with non computable functions. It conflicts with the + impredicativity of [Set] *) - [1] Laurent Chicli, Loïc Pottier, Carlos Simpson, Mathematical - Quotients and Quotient Types in Coq, Proceedings of TYPES 2002, - Lecture Notes in Computer Science 2646, Springer Verlag. -*) +Set Implicit Arguments. Require Export Classical. +Require Import ChoiceFacts. -Axiom - dependent_description : - forall (A:Type) (B:A -> Type) (R:forall x:A, B x -> Prop), - (forall x:A, - exists y : B x, R x y /\ (forall y':B x, R x y' -> y = y')) -> - exists f : forall x:A, B x, (forall x:A, R x (f x)). +Notation Local "'inhabited' A" := A (at level 200, only parsing). + +Axiom constructive_definite_description : + forall (A : Type) (P : A->Prop), (exists! x : A, P x) -> { x : A | P x }. + +(** The idea for the following proof comes from [ChicliPottierSimpson02] *) + +Theorem excluded_middle_informative : forall P:Prop, {P} + {~ P}. +Proof. +apply + (constructive_definite_descr_excluded_middle + constructive_definite_description classic). +Qed. + +Theorem classical_definite_description : + forall (A : Type) (P : A->Prop), inhabited A -> + { x : A | (exists! x : A, P x) -> P x }. +Proof. +intros A P i. +destruct (excluded_middle_informative (exists! x, P x)) as [Hex|HnonP]. + apply constructive_definite_description with (P:= fun x => (exists! x : A, P x) -> P x). + destruct Hex as (x,(Hx,Huni)). + exists x; split. + intros _; exact Hx. + firstorder. +exists i; tauto. +Qed. + +(** Church's iota operator *) -(** Principle of definite descriptions (aka axiom of unique choice) *) +Definition iota (A : Type) (i:inhabited A) (P : A->Prop) : A + := proj1_sig (classical_definite_description P i). + +Definition iota_spec (A : Type) (i:inhabited A) (P : A->Prop) : + (exists! x:A, P x) -> P (iota i P) + := proj2_sig (classical_definite_description P i). + +(** Weaker lemmas (compatibility lemmas) *) + +Unset Implicit Arguments. + +Lemma dependent_description : + forall (A:Type) (B:A -> Type) (R:forall x:A, B x -> Prop), + (forall x:A, exists! y : B x, R x y) -> + (exists f : (forall x:A, B x), forall x:A, R x (f x)). +Proof. +intros A B R H. +assert (Hexuni:forall x, exists! y, R x y). + intro x. apply H. +exists (fun x => proj1_sig (constructive_definite_description (R x) (Hexuni x))). +intro x. +apply (proj2_sig (constructive_definite_description (R x) (Hexuni x))). +Qed. Theorem description : forall (A B:Type) (R:A -> B -> Prop), - (forall x:A, exists y : B, R x y /\ (forall y':B, R x y' -> y = y')) -> - exists f : A -> B, (forall x:A, R x (f x)). + (forall x : A, exists! y : B, R x y) -> + (exists f : A->B, forall x:A, R x (f x)). Proof. intros A B. apply (dependent_description A (fun _ => B)). Qed. -(** The followig proof comes from [1] *) +(** Axiom of unique "choice" (functional reification of functional relations) *) + +Set Implicit Arguments. -Theorem classic_set : ((forall P:Prop, {P} + {~ P}) -> False) -> False. +Require Import Setoid. + +Theorem unique_choice : + forall (A B:Type) (R:A -> B -> Prop), + (forall x:A, exists! y : B, R x y) -> + (exists f : A -> B, forall x:A, R x (f x)). Proof. -intro HnotEM. -set (R := fun A b => A /\ true = b \/ ~ A /\ false = b). -assert (H : exists f : Prop -> bool, (forall A:Prop, R A (f A))). -apply description. -intro A. -destruct (classic A) as [Ha| Hnota]. - exists true; split. - left; split; [ assumption | reflexivity ]. - intros y [[_ Hy]| [Hna _]]. - assumption. - contradiction. - exists false; split. - right; split; [ assumption | reflexivity ]. - intros y [[Ha _]| [_ Hy]]. - contradiction. - assumption. -destruct H as [f Hf]. -apply HnotEM. -intro P. -assert (HfP := Hf P). -(* Elimination from Hf to Set is not allowed but from f to Set yes ! *) -destruct (f P). - left. - destruct HfP as [[Ha _]| [_ Hfalse]]. - assumption. - discriminate. - right. - destruct HfP as [[_ Hfalse]| [Hna _]]. - discriminate. - assumption. +intros A B R H. +apply (description A B). +intro x. apply H. Qed. - diff --git a/theories/Logic/ClassicalEpsilon.v b/theories/Logic/ClassicalEpsilon.v new file mode 100644 index 00000000..b7293bec --- /dev/null +++ b/theories/Logic/ClassicalEpsilon.v @@ -0,0 +1,90 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: ClassicalEpsilon.v 8933 2006-06-09 14:08:38Z herbelin $ i*) + +(** *** This file provides classical logic and indefinite description + (Hilbert's epsilon operator) *) + +(** Classical epsilon's operator (i.e. indefinite description) implies + excluded-middle in [Set] and leads to a classical world populated + with non computable functions. It conflicts with the + impredicativity of [Set] *) + +Require Export Classical. +Require Import ChoiceFacts. + +Set Implicit Arguments. + +Notation Local "'inhabited' A" := A (at level 200, only parsing). + +Axiom constructive_indefinite_description : + forall (A : Type) (P : A->Prop), + (ex P) -> { x : A | P x }. + +Lemma constructive_definite_description : + forall (A : Type) (P : A->Prop), + (exists! x : A, P x) -> { x : A | P x }. +Proof. +intros; apply constructive_indefinite_description; firstorder. +Qed. + +Theorem excluded_middle_informative : forall P:Prop, {P} + {~ P}. +Proof. +apply + (constructive_definite_descr_excluded_middle + constructive_definite_description classic). +Qed. + +Theorem classical_indefinite_description : + forall (A : Type) (P : A->Prop), inhabited A -> + { x : A | ex P -> P x }. +Proof. +intros A P i. +destruct (excluded_middle_informative (exists x, P x)) as [Hex|HnonP]. + apply constructive_indefinite_description with (P:= fun x => ex P -> P x). + destruct Hex as (x,Hx). + exists x; intros _; exact Hx. + firstorder. +Qed. + +(** Hilbert's epsilon operator *) + +Definition epsilon (A : Type) (i:inhabited A) (P : A->Prop) : A + := proj1_sig (classical_indefinite_description P i). + +Definition epsilon_spec (A : Type) (i:inhabited A) (P : A->Prop) : + (ex P) -> P (epsilon i P) + := proj2_sig (classical_indefinite_description P i). + +Opaque epsilon. + +(** Open question: is classical_indefinite_description constructively + provable from [relational_choice] and + [constructive_definite_description] (at least, using the fact that + [functional_choice] is provable from [relational_choice] and + [unique_choice], we know that the double negation of + [classical_indefinite_description] is provable (see + [relative_non_contradiction_of_indefinite_desc]). *) + +(** Remark: we use [ex P] rather than [exists x, P x] (which is [ex + (fun x => P x)] to ease unification *) + +(** *** Weaker lemmas (compatibility lemmas) *) + +Theorem choice : + forall (A B : Type) (R : A->B->Prop), + (forall x : A, exists y : B, R x y) -> + (exists f : A->B, forall x : A, R x (f x)). +Proof. +intros A B R H. +exists (fun x => proj1_sig (constructive_indefinite_description (H x))). +intro x. +apply (proj2_sig (constructive_indefinite_description (H x))). +Qed. + diff --git a/theories/Logic/ClassicalFacts.v b/theories/Logic/ClassicalFacts.v index 91056250..70da74d3 100644 --- a/theories/Logic/ClassicalFacts.v +++ b/theories/Logic/ClassicalFacts.v @@ -1,3 +1,4 @@ +(* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) (* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) @@ -6,7 +7,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: ClassicalFacts.v 8136 2006-03-05 21:57:47Z herbelin $ i*) +(*i $Id: ClassicalFacts.v 8892 2006-06-04 17:59:53Z herbelin $ i*) (** ** Some facts and definitions about classical logic diff --git a/theories/Logic/ClassicalUniqueChoice.v b/theories/Logic/ClassicalUniqueChoice.v new file mode 100644 index 00000000..79bef2af --- /dev/null +++ b/theories/Logic/ClassicalUniqueChoice.v @@ -0,0 +1,79 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: ClassicalUniqueChoice.v 8893 2006-06-04 18:04:53Z herbelin $ i*) + +(** This file provides classical logic and unique choice *) + +(** Classical logic and unique choice, as shown in + [ChicliPottierSimpson02], implies the double-negation of + excluded-middle in [Set], hence it implies a strongly classical + world. Especially it conflicts with the impredicativity of [Set]. + + [ChicliPottierSimpson02] Laurent Chicli, Loïc Pottier, Carlos + Simpson, Mathematical Quotients and Quotient Types in Coq, + Proceedings of TYPES 2002, Lecture Notes in Computer Science 2646, + Springer Verlag. *) + +Require Export Classical. + +Axiom + dependent_unique_choice : + forall (A:Type) (B:A -> Type) (R:forall x:A, B x -> Prop), + (forall x : A, exists! y : B x, R x y) -> + (exists f : (forall x:A, B x), forall x:A, R x (f x)). + +(** Unique choice reifies functional relations into functions *) + +Theorem unique_choice : + forall (A B:Type) (R:A -> B -> Prop), + (forall x:A, exists! y : B, R x y) -> + (exists f:A->B, forall x:A, R x (f x)). +Proof. +intros A B. +apply (dependent_unique_choice A (fun _ => B)). +Qed. + +(** The followig proof comes from [ChicliPottierSimpson02] *) + +Require Import Setoid. + +Theorem classic_set : ((forall P:Prop, {P} + {~ P}) -> False) -> False. +Proof. +intro HnotEM. +set (R := fun A b => A /\ true = b \/ ~ A /\ false = b). +assert (H : exists f : Prop -> bool, (forall A:Prop, R A (f A))). +apply unique_choice. +intro A. +destruct (classic A) as [Ha| Hnota]. + exists true; split. + left; split; [ assumption | reflexivity ]. + intros y [[_ Hy]| [Hna _]]. + assumption. + contradiction. + exists false; split. + right; split; [ assumption | reflexivity ]. + intros y [[Ha _]| [_ Hy]]. + contradiction. + assumption. +destruct H as [f Hf]. +apply HnotEM. +intro P. +assert (HfP := Hf P). +(* Elimination from Hf to Set is not allowed but from f to Set yes ! *) +destruct (f P). + left. + destruct HfP as [[Ha _]| [_ Hfalse]]. + assumption. + discriminate. + right. + destruct HfP as [[_ Hfalse]| [Hna _]]. + discriminate. + assumption. +Qed. + diff --git a/theories/Logic/Classical_Prop.v b/theories/Logic/Classical_Prop.v index f8b0e65b..ce3e84a7 100644 --- a/theories/Logic/Classical_Prop.v +++ b/theories/Logic/Classical_Prop.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Classical_Prop.v 8642 2006-03-17 10:09:02Z notin $ i*) +(*i $Id: Classical_Prop.v 8892 2006-06-04 17:59:53Z herbelin $ i*) (** Classical Propositional Logic *) @@ -22,6 +22,15 @@ unfold not in |- *; intros; elim (classic p); auto. intro NP; elim (H NP). Qed. +(** Peirce's law states [forall P Q:Prop, ((P -> Q) -> P) -> P]. + Thanks to [forall P, False -> P], it is equivalent to the + following form *) + +Lemma Peirce : forall P:Prop, ((P -> False) -> P) -> P. +Proof. +intros P H; destruct (classic P); auto. +Qed. + Lemma not_imply_elim : forall P Q:Prop, ~ (P -> Q) -> P. Proof. intros; apply NNPP; red in |- *. diff --git a/theories/FSets/DecidableType.v b/theories/Logic/DecidableType.v index 635f6bdb..a38b111f 100644 --- a/theories/FSets/DecidableType.v +++ b/theories/Logic/DecidableType.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -(* $Id: DecidableType.v 8639 2006-03-16 19:21:55Z letouzey $ *) +(* $Id: DecidableType.v 8933 2006-06-09 14:08:38Z herbelin $ *) Require Export SetoidList. Set Implicit Arguments. @@ -31,8 +31,9 @@ Module Type DecidableType. End DecidableType. +(** * Additional notions about keys and datas used in FMap *) -Module PairDecidableType(D:DecidableType). +Module KeyDecidableType(D:DecidableType). Import D. Section Elt. @@ -147,5 +148,9 @@ Module PairDecidableType(D:DecidableType). Hint Unfold MapsTo In. Hint Resolve In_inv_2 In_inv_3. +End KeyDecidableType. + + + + -End PairDecidableType. diff --git a/theories/Logic/DecidableTypeEx.v b/theories/Logic/DecidableTypeEx.v new file mode 100644 index 00000000..a4f99de2 --- /dev/null +++ b/theories/Logic/DecidableTypeEx.v @@ -0,0 +1,50 @@ +(***********************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * INRIA-Rocquencourt & LRI-CNRS-Orsay *) +(* \VV/ *************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(***********************************************************************) + +(* $Id: DecidableTypeEx.v 8933 2006-06-09 14:08:38Z herbelin $ *) + +Require Import DecidableType OrderedType OrderedTypeEx. +Set Implicit Arguments. +Unset Strict Implicit. + +(** * Examples of Decidable Type structures. *) + +(** A particular case of [DecidableType] where + the equality is the usual one of Coq. *) + +Module Type UsualDecidableType. + Parameter t : Set. + Definition eq := @eq t. + Definition eq_refl := @refl_equal t. + Definition eq_sym := @sym_eq t. + Definition eq_trans := @trans_eq t. + Parameter eq_dec : forall x y, { eq x y }+{~eq x y }. +End UsualDecidableType. + +(** a [UsualDecidableType] is in particular an [DecidableType]. *) + +Module UDT_to_DT (U:UsualDecidableType) <: DecidableType := U. + +(** An OrderedType can be seen as a DecidableType *) + +Module OT_as_DT (O:OrderedType) <: DecidableType. + Module OF := OrderedTypeFacts O. + Definition t := O.t. + Definition eq := O.eq. + Definition eq_refl := O.eq_refl. + Definition eq_sym := O.eq_sym. + Definition eq_trans := O.eq_trans. + Definition eq_dec := OF.eq_dec. +End OT_as_DT. + +(** (Usual) Decidable Type for [nat], [positive], [N], [Z] *) + +Module Nat_as_DT <: UsualDecidableType := OT_as_DT (Nat_as_OT). +Module Positive_as_DT <: UsualDecidableType := OT_as_DT (Positive_as_OT). +Module N_as_DT <: UsualDecidableType := OT_as_DT (N_as_OT). +Module Z_as_DT <: UsualDecidableType := OT_as_DT (Z_as_OT). diff --git a/theories/Logic/Diaconescu.v b/theories/Logic/Diaconescu.v index 3e94deda..19d5d7ec 100644 --- a/theories/Logic/Diaconescu.v +++ b/theories/Logic/Diaconescu.v @@ -1,3 +1,4 @@ +(* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) (* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) @@ -6,26 +7,46 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Diaconescu.v 6401 2004-12-05 16:44:57Z herbelin $ i*) +(*i $Id: Diaconescu.v 8892 2006-06-04 17:59:53Z herbelin $ i*) -(** R. Diaconescu [Diaconescu] showed that the Axiom of Choice in Set Theory - entails Excluded-Middle; S. Lacas and B. Werner [LacasWerner] - adapted the proof to show that the axiom of choice in equivalence - classes entails Excluded-Middle in Type Theory. +(** Diaconescu showed that the Axiom of Choice entails Excluded-Middle + in topoi [Diaconescu75]. Lacas and Werner adapted the proof to show + that the axiom of choice in equivalence classes entails + Excluded-Middle in Type Theory [LacasWerner99]. - This is an adaptatation of the proof by Hugo Herbelin to show that - the relational form of the Axiom of Choice + Extensionality for - predicates entails Excluded-Middle + Three variants of Diaconescu's result in type theory are shown below. - [Diaconescu] R. Diaconescu, Axiom of Choice and Complementation, in - Proceedings of AMS, vol 51, pp 176-178, 1975. + A. A proof that the relational form of the Axiom of Choice + + Extensionality for Predicates entails Excluded-Middle (by Hugo + Herbelin) - [LacasWerner] S. Lacas, B Werner, Which Choices imply the excluded middle?, - preprint, 1999. + B. A proof that the relational form of the Axiom of Choice + Proof + Irrelevance entails Excluded-Middle for Equality Statements (by + Benjamin Werner) + C. A proof that extensional Hilbert epsilon's description operator + entails excluded-middle (taken from Bell [Bell93]) + + See also [Carlström] for a discussion of the connection between the + Extensional Axiom of Choice and Excluded-Middle + + [Diaconescu75] Radu Diaconescu, Axiom of Choice and Complementation, + in Proceedings of AMS, vol 51, pp 176-178, 1975. + + [LacasWerner99] Samuel Lacas, Benjamin Werner, Which Choices imply + the excluded middle?, preprint, 1999. + + [Bell93] John L. Bell, Hilbert's epsilon operator and classical + logic, Journal of Philosophical Logic, 22: 1-18, 1993 + + [Carlström04] Jesper Carlström, EM + Ext_ + AC_int <-> AC_ext, + Mathematical Logic Quaterly, vol 50(3), pp 236-240, 2004. *) -Section PredExt_GuardRelChoice_imp_EM. +(**********************************************************************) +(** *** A. Pred. Ext. + Rel. Axiom of Choice -> Excluded-Middle *) + +Section PredExt_RelChoice_imp_EM. (** The axiom of extensionality for predicates *) @@ -59,15 +80,9 @@ Qed. Require Import ChoiceFacts. -Variable rel_choice : forall A B:Type, RelationalChoice A B. +Variable rel_choice : RelationalChoice. -Lemma guarded_rel_choice : - forall (A B:Type) (P:A -> Prop) (R:A -> B -> Prop), - (forall x:A, P x -> exists y : B, R x y) -> - exists R' : A -> B -> Prop, - (forall x:A, - P x -> - exists y : B, R x y /\ R' x y /\ (forall y':B, R' x y' -> y = y')). +Lemma guarded_rel_choice : GuardedRelationalChoice. Proof. apply (rel_choice_and_proof_irrel_imp_guarded_rel_choice rel_choice proof_irrel). @@ -78,16 +93,19 @@ Qed. Require Import Bool. -Lemma AC : +Lemma AC_bool_subset_to_bool : exists R : (bool -> Prop) -> bool -> Prop, (forall P:bool -> Prop, (exists b : bool, P b) -> exists b : bool, P b /\ R P b /\ (forall b':bool, R P b' -> b = b')). Proof. - apply guarded_rel_choice with - (P := fun Q:bool -> Prop => exists y : _, Q y) - (R := fun (Q:bool -> Prop) (y:bool) => Q y). - exact (fun _ H => H). + destruct (guarded_rel_choice _ _ + (fun Q:bool -> Prop => exists y : _, Q y) + (fun (Q:bool -> Prop) (y:bool) => Q y)) as (R,(HRsub,HR)). + exact (fun _ H => H). + exists R; intros P HP. + destruct (HR P HP) as (y,(Hy,Huni)). + exists y; firstorder. Qed. (** The proof of the excluded middle *) @@ -98,7 +116,7 @@ Proof. intro P. (** first we exhibit the choice functional relation R *) -destruct AC as [R H]. +destruct AC_bool_subset_to_bool as [R H]. set (class_of_true := fun b => b = true \/ P). set (class_of_false := fun b => b = false \/ P). @@ -135,4 +153,152 @@ left; assumption. Qed. -End PredExt_GuardRelChoice_imp_EM. +End PredExt_RelChoice_imp_EM. + +(**********************************************************************) +(** *** B. Proof-Irrel. + Rel. Axiom of Choice -> Excl.-Middle for Equality *) + +(** This is an adaptation of Diaconescu's paradox exploiting that + proof-irrelevance is some form of extensionality *) + +Section ProofIrrel_RelChoice_imp_EqEM. + +Variable rel_choice : RelationalChoice. + +Variable proof_irrelevance : forall P:Prop , forall x y:P, x=y. + +(** Let [a1] and [a2] be two elements in some type [A] *) + +Variable A :Type. +Variables a1 a2 : A. + +(** We build the subset [A'] of [A] made of [a1] and [a2] *) + +Definition A' := sigT (fun x => x=a1 \/ x=a2). + +Definition a1':A'. +exists a1 ; auto. +Defined. + +Definition a2':A'. +exists a2 ; auto. +Defined. + +(** By proof-irrelevance, projection is a retraction *) + +Lemma projT1_injective : a1=a2 -> a1'=a2'. +Proof. + intro Heq ; unfold a1', a2', A'. + rewrite Heq. + replace (or_introl (a2=a2) (refl_equal a2)) + with (or_intror (a2=a2) (refl_equal a2)). + reflexivity. + apply proof_irrelevance. +Qed. + +(** But from the actual proofs of being in [A'], we can assert in the + proof-irrelevant world the existence of relevant boolean witnesses *) + +Lemma decide : forall x:A', exists y:bool , + (projT1 x = a1 /\ y = true ) \/ (projT1 x = a2 /\ y = false). +Proof. + intros [a [Ha1|Ha2]]; [exists true | exists false]; auto. +Qed. + +(** Thanks to the axiom of choice, the boolean witnesses move from the + propositional world to the relevant world *) + +Theorem proof_irrel_rel_choice_imp_eq_dec : a1=a2 \/ ~a1=a2. +Proof. + destruct + (rel_choice A' bool + (fun x y => projT1 x = a1 /\ y = true \/ projT1 x = a2 /\ y = false)) + as (R,(HRsub,HR)). + apply decide. + destruct (HR a1') as (b1,(Ha1'b1,_Huni1)). + destruct (HRsub a1' b1 Ha1'b1) as [(_, Hb1true)|(Ha1a2, _Hb1false)]. + destruct (HR a2') as (b2,(Ha2'b2,Huni2)). + destruct (HRsub a2' b2 Ha2'b2) as [(Ha2a1, _Hb2true)|(_, Hb2false)]. + left; symmetry; assumption. + right; intro H. + subst b1; subst b2. + rewrite (projT1_injective H) in Ha1'b1. + assert (false = true) by auto using Huni2. + discriminate. + left; assumption. +Qed. + +(** An alternative more concise proof can be done by directly using + the guarded relational choice *) + +Declare Implicit Tactic auto. + +Lemma proof_irrel_rel_choice_imp_eq_dec' : a1=a2 \/ ~a1=a2. +Proof. + assert (decide: forall x:A, x=a1 \/ x=a2 -> + exists y:bool, x=a1 /\ y=true \/ x=a2 /\ y=false). + intros a [Ha1|Ha2]; [exists true | exists false]; auto. + assert (guarded_rel_choice := + rel_choice_and_proof_irrel_imp_guarded_rel_choice + rel_choice + proof_irrelevance). + destruct + (guarded_rel_choice A bool + (fun x => x=a1 \/ x=a2) + (fun x y => x=a1 /\ y=true \/ x=a2 /\ y=false)) + as (R,(HRsub,HR)). + apply decide. + destruct (HR a1) as (b1,(Ha1b1,_Huni1)). left; reflexivity. + destruct (HRsub a1 b1 Ha1b1) as [(_, Hb1true)|(Ha1a2, _Hb1false)]. + destruct (HR a2) as (b2,(Ha2b2,Huni2)). right; reflexivity. + destruct (HRsub a2 b2 Ha2b2) as [(Ha2a1, _Hb2true)|(_, Hb2false)]. + left; symmetry; assumption. + right; intro H. + subst b1; subst b2; subst a1. + assert (false = true) by auto using Huni2, Ha1b1. + discriminate. + left; assumption. +Qed. + +End ProofIrrel_RelChoice_imp_EqEM. + +(**********************************************************************) +(** *** B. Extensional Hilbert's epsilon description operator -> Excluded-Middle *) + +(** Proof sketch from Bell [Bell93] (with thanks to P. Castéran) *) + +Notation Local "'inhabited' A" := A (at level 10, only parsing). + +Section ExtensionalEpsilon_imp_EM. + +Variable epsilon : forall A : Type, inhabited A -> (A -> Prop) -> A. + +Hypothesis epsilon_spec : + forall (A:Type) (i:inhabited A) (P:A->Prop), + (exists x, P x) -> P (epsilon A i P). + +Hypothesis epsilon_extensionality : + forall (A:Type) (i:inhabited A) (P Q:A->Prop), + (forall a, P a <-> Q a) -> epsilon A i P = epsilon A i Q. + +Notation Local eps := (epsilon bool true) (only parsing). + +Theorem extensional_epsilon_imp_EM : forall P:Prop, P \/ ~ P. +Proof. +intro P. +pose (B := fun y => y=false \/ P). +pose (C := fun y => y=true \/ P). +assert (B (eps B)) as [Hfalse|HP] + by (apply epsilon_spec; exists false; left; reflexivity). +assert (C (eps C)) as [Htrue|HP] + by (apply epsilon_spec; exists true; left; reflexivity). + right; intro HP. + assert (forall y, B y <-> C y) by (intro y; split; intro; right; assumption). + rewrite epsilon_extensionality with (1:=H) in Hfalse. + rewrite Htrue in Hfalse. + discriminate. +auto. +auto. +Qed. + +End ExtensionalEpsilon_imp_EM. diff --git a/theories/Logic/RelationalChoice.v b/theories/Logic/RelationalChoice.v index 11979057..ec168f09 100644 --- a/theories/Logic/RelationalChoice.v +++ b/theories/Logic/RelationalChoice.v @@ -6,15 +6,12 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: RelationalChoice.v 6001 2004-08-01 09:27:26Z herbelin $ i*) +(*i $Id: RelationalChoice.v 8892 2006-06-04 17:59:53Z herbelin $ i*) (** This file axiomatizes the relational form of the axiom of choice *) -Axiom - relational_choice : - forall (A B:Type) (R:A -> B -> Prop), - (forall x:A, exists y : B, R x y) -> - exists R' : A -> B -> Prop, - (forall x:A, - exists y : B, - R x y /\ R' x y /\ (forall y':B, R' x y' -> y = y')). +Axiom relational_choice : + forall (A B : Type) (R : A->B->Prop), + (forall x : A, exists y : B, R x y) -> + exists R' : A->B->Prop, + subrelation R' R /\ forall x : A, exists! y : B, R' x y. diff --git a/theories/NArith/BinNat.v b/theories/NArith/BinNat.v index b4582d51..78353145 100644 --- a/theories/NArith/BinNat.v +++ b/theories/NArith/BinNat.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: BinNat.v 8685 2006-04-06 13:22:02Z letouzey $ i*) +(*i $Id: BinNat.v 8771 2006-04-29 11:55:57Z letouzey $ i*) Require Import BinPos. Unset Boxed Definitions. @@ -29,6 +29,12 @@ Arguments Scope Npos [positive_scope]. Open Local Scope N_scope. +Definition Ndiscr : forall n:N, { p:positive | n = Npos p } + { n = N0 }. +Proof. + destruct n; auto. + left; exists p; auto. +Defined. + (** Operation x -> 2*x+1 *) Definition Ndouble_plus_one x := @@ -39,10 +45,11 @@ Definition Ndouble_plus_one x := (** Operation x -> 2*x *) -Definition Ndouble n := match n with - | N0 => N0 - | Npos p => Npos (xO p) - end. +Definition Ndouble n := + match n with + | N0 => N0 + | Npos p => Npos (xO p) + end. (** Successor *) @@ -86,6 +93,34 @@ Definition Ncompare n m := Infix "?=" := Ncompare (at level 70, no associativity) : N_scope. +(** convenient induction principles *) + +Lemma N_ind_double : + forall (a:N) (P:N -> Prop), + P N0 -> + (forall a, P a -> P (Ndouble a)) -> + (forall a, P a -> P (Ndouble_plus_one a)) -> P a. +Proof. + intros; elim a. trivial. + simple induction p. intros. + apply (H1 (Npos p0)); trivial. + intros; apply (H0 (Npos p0)); trivial. + intros; apply (H1 N0); assumption. +Qed. + +Lemma N_rec_double : + forall (a:N) (P:N -> Set), + P N0 -> + (forall a, P a -> P (Ndouble a)) -> + (forall a, P a -> P (Ndouble_plus_one a)) -> P a. +Proof. + intros; elim a. trivial. + simple induction p. intros. + apply (H1 (Npos p0)); trivial. + intros; apply (H0 (Npos p0)); trivial. + intros; apply (H1 N0); assumption. +Qed. + (** Peano induction on binary natural numbers *) Theorem Nind : @@ -211,3 +246,47 @@ destruct n as [| n]; destruct m as [| m]; simpl in |- *; intro H; reflexivity || (try discriminate H). rewrite (Pcompare_Eq_eq n m H); reflexivity. Qed. + +Lemma Ncompare_refl : forall n, (n ?= n) = Eq. +Proof. +destruct n; simpl; auto. +apply Pcompare_refl. +Qed. + +Lemma Ncompare_antisym : forall n m, CompOpp (n ?= m) = (m ?= n). +Proof. +destruct n; destruct m; simpl; auto. +exact (Pcompare_antisym p p0 Eq). +Qed. + +(** Dividing by 2 *) + +Definition Ndiv2 (n:N) := + match n with + | N0 => N0 + | Npos 1 => N0 + | Npos (xO p) => Npos p + | Npos (xI p) => Npos p + end. + +Lemma Ndouble_div2 : forall n:N, Ndiv2 (Ndouble n) = n. +Proof. + destruct n; trivial. +Qed. + +Lemma Ndouble_plus_one_div2 : + forall n:N, Ndiv2 (Ndouble_plus_one n) = n. +Proof. + destruct n; trivial. +Qed. + +Lemma Ndouble_inj : forall n m, Ndouble n = Ndouble m -> n = m. +Proof. + intros. rewrite <- (Ndouble_div2 n). rewrite H. apply Ndouble_div2. +Qed. + +Lemma Ndouble_plus_one_inj : + forall n m, Ndouble_plus_one n = Ndouble_plus_one m -> n = m. +Proof. + intros. rewrite <- (Ndouble_plus_one_div2 n). rewrite H. apply Ndouble_plus_one_div2. +Qed. diff --git a/theories/NArith/Ndec.v b/theories/NArith/Ndec.v new file mode 100644 index 00000000..df2da25b --- /dev/null +++ b/theories/NArith/Ndec.v @@ -0,0 +1,412 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: Ndec.v 8733 2006-04-25 22:52:18Z letouzey $ i*) + +Require Import Bool. +Require Import Sumbool. +Require Import Arith. +Require Import BinPos. +Require Import BinNat. +Require Import Pnat. +Require Import Nnat. +Require Import Ndigits. + +(** A boolean equality over [N] *) + +Fixpoint Peqb (p1 p2:positive) {struct p2} : bool := + match p1, p2 with + | xH, xH => true + | xO p'1, xO p'2 => Peqb p'1 p'2 + | xI p'1, xI p'2 => Peqb p'1 p'2 + | _, _ => false + end. + +Lemma Peqb_correct : forall p, Peqb p p = true. +Proof. +induction p; auto. +Qed. + +Lemma Peqb_Pcompare : forall p p', Peqb p p' = true -> Pcompare p p' Eq = Eq. +Proof. + induction p; destruct p'; simpl; intros; try discriminate; auto. +Qed. + +Lemma Pcompare_Peqb : forall p p', Pcompare p p' Eq = Eq -> Peqb p p' = true. +Proof. +intros; rewrite <- (Pcompare_Eq_eq _ _ H). +apply Peqb_correct. +Qed. + +Definition Neqb (a a':N) := + match a, a' with + | N0, N0 => true + | Npos p, Npos p' => Peqb p p' + | _, _ => false + end. + +Lemma Neqb_correct : forall n, Neqb n n = true. +Proof. + destruct n; trivial. + simpl; apply Peqb_correct. +Qed. + +Lemma Neqb_Ncompare : forall n n', Neqb n n' = true -> Ncompare n n' = Eq. +Proof. + destruct n; destruct n'; simpl; intros; try discriminate; auto; apply Peqb_Pcompare; auto. +Qed. + +Lemma Ncompare_Neqb : forall n n', Ncompare n n' = Eq -> Neqb n n' = true. +Proof. +intros; rewrite <- (Ncompare_Eq_eq _ _ H). +apply Neqb_correct. +Qed. + +Lemma Neqb_complete : forall a a', Neqb a a' = true -> a = a'. +Proof. + intros. + apply Ncompare_Eq_eq. + apply Neqb_Ncompare; auto. +Qed. + +Lemma Neqb_comm : forall a a', Neqb a a' = Neqb a' a. +Proof. + intros; apply bool_1; split; intros. + rewrite (Neqb_complete _ _ H); apply Neqb_correct. + rewrite (Neqb_complete _ _ H); apply Neqb_correct. +Qed. + +Lemma Nxor_eq_true : + forall a a', Nxor a a' = N0 -> Neqb a a' = true. +Proof. + intros. rewrite (Nxor_eq a a' H). apply Neqb_correct. +Qed. + +Lemma Nxor_eq_false : + forall a a' p, Nxor a a' = Npos p -> Neqb a a' = false. +Proof. + intros. elim (sumbool_of_bool (Neqb a a')). intro H0. + rewrite (Neqb_complete a a' H0) in H. rewrite (Nxor_nilpotent a') in H. discriminate H. + trivial. +Qed. + +Lemma Nodd_not_double : + forall a, + Nodd a -> forall a0, Neqb (Ndouble a0) a = false. +Proof. + intros. elim (sumbool_of_bool (Neqb (Ndouble a0) a)). intro H0. + rewrite <- (Neqb_complete _ _ H0) in H. + unfold Nodd in H. + rewrite (Ndouble_bit0 a0) in H. discriminate H. + trivial. +Qed. + +Lemma Nnot_div2_not_double : + forall a a0, + Neqb (Ndiv2 a) a0 = false -> Neqb a (Ndouble a0) = false. +Proof. + intros. elim (sumbool_of_bool (Neqb (Ndouble a0) a)). intro H0. + rewrite <- (Neqb_complete _ _ H0) in H. rewrite (Ndouble_div2 a0) in H. + rewrite (Neqb_correct a0) in H. discriminate H. + intro. rewrite Neqb_comm. assumption. +Qed. + +Lemma Neven_not_double_plus_one : + forall a, + Neven a -> forall a0, Neqb (Ndouble_plus_one a0) a = false. +Proof. + intros. elim (sumbool_of_bool (Neqb (Ndouble_plus_one a0) a)). intro H0. + rewrite <- (Neqb_complete _ _ H0) in H. + unfold Neven in H. + rewrite (Ndouble_plus_one_bit0 a0) in H. + discriminate H. + trivial. +Qed. + +Lemma Nnot_div2_not_double_plus_one : + forall a a0, + Neqb (Ndiv2 a) a0 = false -> Neqb (Ndouble_plus_one a0) a = false. +Proof. + intros. elim (sumbool_of_bool (Neqb a (Ndouble_plus_one a0))). intro H0. + rewrite (Neqb_complete _ _ H0) in H. rewrite (Ndouble_plus_one_div2 a0) in H. + rewrite (Neqb_correct a0) in H. discriminate H. + intro H0. rewrite Neqb_comm. assumption. +Qed. + +Lemma Nbit0_neq : + forall a a', + Nbit0 a = false -> Nbit0 a' = true -> Neqb a a' = false. +Proof. + intros. elim (sumbool_of_bool (Neqb a a')). intro H1. rewrite (Neqb_complete _ _ H1) in H. + rewrite H in H0. discriminate H0. + trivial. +Qed. + +Lemma Ndiv2_eq : + forall a a', Neqb a a' = true -> Neqb (Ndiv2 a) (Ndiv2 a') = true. +Proof. + intros. cut (a = a'). intros. rewrite H0. apply Neqb_correct. + apply Neqb_complete. exact H. +Qed. + +Lemma Ndiv2_neq : + forall a a', + Neqb (Ndiv2 a) (Ndiv2 a') = false -> Neqb a a' = false. +Proof. + intros. elim (sumbool_of_bool (Neqb a a')). intro H0. + rewrite (Neqb_complete _ _ H0) in H. rewrite (Neqb_correct (Ndiv2 a')) in H. discriminate H. + trivial. +Qed. + +Lemma Ndiv2_bit_eq : + forall a a', + Nbit0 a = Nbit0 a' -> Ndiv2 a = Ndiv2 a' -> a = a'. +Proof. + intros. apply Nbit_faithful. unfold eqf in |- *. destruct n. + rewrite Nbit0_correct. rewrite Nbit0_correct. assumption. + rewrite <- Ndiv2_correct. rewrite <- Ndiv2_correct. + rewrite H0. reflexivity. +Qed. + +Lemma Ndiv2_bit_neq : + forall a a', + Neqb a a' = false -> + Nbit0 a = Nbit0 a' -> Neqb (Ndiv2 a) (Ndiv2 a') = false. +Proof. + intros. elim (sumbool_of_bool (Neqb (Ndiv2 a) (Ndiv2 a'))). intro H1. + rewrite (Ndiv2_bit_eq _ _ H0 (Neqb_complete _ _ H1)) in H. + rewrite (Neqb_correct a') in H. discriminate H. + trivial. +Qed. + +Lemma Nneq_elim : + forall a a', + Neqb a a' = false -> + Nbit0 a = negb (Nbit0 a') \/ + Neqb (Ndiv2 a) (Ndiv2 a') = false. +Proof. + intros. cut (Nbit0 a = Nbit0 a' \/ Nbit0 a = negb (Nbit0 a')). + intros. elim H0. intro. right. apply Ndiv2_bit_neq. assumption. + assumption. + intro. left. assumption. + case (Nbit0 a); case (Nbit0 a'); auto. +Qed. + +Lemma Ndouble_or_double_plus_un : + forall a, + {a0 : N | a = Ndouble a0} + {a1 : N | a = Ndouble_plus_one a1}. +Proof. + intro. elim (sumbool_of_bool (Nbit0 a)). intro H. right. split with (Ndiv2 a). + rewrite (Ndiv2_double_plus_one a H). reflexivity. + intro H. left. split with (Ndiv2 a). rewrite (Ndiv2_double a H). reflexivity. +Qed. + +(** A boolean order on [N] *) + +Definition Nle (a b:N) := leb (nat_of_N a) (nat_of_N b). + +Lemma Nle_Ncompare : forall a b, Nle a b = true <-> Ncompare a b <> Gt. +Proof. + intros; rewrite nat_of_Ncompare. + unfold Nle; apply leb_compare. +Qed. + +Lemma Nle_refl : forall a, Nle a a = true. +Proof. + intro. unfold Nle in |- *. apply leb_correct. apply le_n. +Qed. + +Lemma Nle_antisym : + forall a b, Nle a b = true -> Nle b a = true -> a = b. +Proof. + unfold Nle in |- *. intros. rewrite <- (N_of_nat_of_N a). rewrite <- (N_of_nat_of_N b). + rewrite (le_antisym _ _ (leb_complete _ _ H) (leb_complete _ _ H0)). reflexivity. +Qed. + +Lemma Nle_trans : + forall a b c, Nle a b = true -> Nle b c = true -> Nle a c = true. +Proof. + unfold Nle in |- *. intros. apply leb_correct. apply le_trans with (m := nat_of_N b). + apply leb_complete. assumption. + apply leb_complete. assumption. +Qed. + +Lemma Nle_lt_trans : + forall a b c, + Nle a b = true -> Nle c b = false -> Nle c a = false. +Proof. + unfold Nle in |- *. intros. apply leb_correct_conv. apply le_lt_trans with (m := nat_of_N b). + apply leb_complete. assumption. + apply leb_complete_conv. assumption. +Qed. + +Lemma Nlt_le_trans : + forall a b c, + Nle b a = false -> Nle b c = true -> Nle c a = false. +Proof. + unfold Nle in |- *. intros. apply leb_correct_conv. apply lt_le_trans with (m := nat_of_N b). + apply leb_complete_conv. assumption. + apply leb_complete. assumption. +Qed. + +Lemma Nlt_trans : + forall a b c, + Nle b a = false -> Nle c b = false -> Nle c a = false. +Proof. + unfold Nle in |- *. intros. apply leb_correct_conv. apply lt_trans with (m := nat_of_N b). + apply leb_complete_conv. assumption. + apply leb_complete_conv. assumption. +Qed. + +Lemma Nlt_le_weak : forall a b:N, Nle b a = false -> Nle a b = true. +Proof. + unfold Nle in |- *. intros. apply leb_correct. apply lt_le_weak. + apply leb_complete_conv. assumption. +Qed. + +Lemma Nle_double_mono : + forall a b, + Nle a b = true -> Nle (Ndouble a) (Ndouble b) = true. +Proof. + unfold Nle in |- *. intros. rewrite nat_of_Ndouble. rewrite nat_of_Ndouble. apply leb_correct. + simpl in |- *. apply plus_le_compat. apply leb_complete. assumption. + apply plus_le_compat. apply leb_complete. assumption. + apply le_n. +Qed. + +Lemma Nle_double_plus_one_mono : + forall a b, + Nle a b = true -> + Nle (Ndouble_plus_one a) (Ndouble_plus_one b) = true. +Proof. + unfold Nle in |- *. intros. rewrite nat_of_Ndouble_plus_one. rewrite nat_of_Ndouble_plus_one. + apply leb_correct. apply le_n_S. simpl in |- *. apply plus_le_compat. apply leb_complete. + assumption. + apply plus_le_compat. apply leb_complete. assumption. + apply le_n. +Qed. + +Lemma Nle_double_mono_conv : + forall a b, + Nle (Ndouble a) (Ndouble b) = true -> Nle a b = true. +Proof. + unfold Nle in |- *. intros a b. rewrite nat_of_Ndouble. rewrite nat_of_Ndouble. intro. + apply leb_correct. apply (mult_S_le_reg_l 1). apply leb_complete. assumption. +Qed. + +Lemma Nle_double_plus_one_mono_conv : + forall a b, + Nle (Ndouble_plus_one a) (Ndouble_plus_one b) = true -> + Nle a b = true. +Proof. + unfold Nle in |- *. intros a b. rewrite nat_of_Ndouble_plus_one. rewrite nat_of_Ndouble_plus_one. + intro. apply leb_correct. apply (mult_S_le_reg_l 1). apply le_S_n. apply leb_complete. + assumption. +Qed. + +Lemma Nlt_double_mono : + forall a b, + Nle a b = false -> Nle (Ndouble a) (Ndouble b) = false. +Proof. + intros. elim (sumbool_of_bool (Nle (Ndouble a) (Ndouble b))). intro H0. + rewrite (Nle_double_mono_conv _ _ H0) in H. discriminate H. + trivial. +Qed. + +Lemma Nlt_double_plus_one_mono : + forall a b, + Nle a b = false -> + Nle (Ndouble_plus_one a) (Ndouble_plus_one b) = false. +Proof. + intros. elim (sumbool_of_bool (Nle (Ndouble_plus_one a) (Ndouble_plus_one b))). intro H0. + rewrite (Nle_double_plus_one_mono_conv _ _ H0) in H. discriminate H. + trivial. +Qed. + +Lemma Nlt_double_mono_conv : + forall a b, + Nle (Ndouble a) (Ndouble b) = false -> Nle a b = false. +Proof. + intros. elim (sumbool_of_bool (Nle a b)). intro H0. rewrite (Nle_double_mono _ _ H0) in H. + discriminate H. + trivial. +Qed. + +Lemma Nlt_double_plus_one_mono_conv : + forall a b, + Nle (Ndouble_plus_one a) (Ndouble_plus_one b) = false -> + Nle a b = false. +Proof. + intros. elim (sumbool_of_bool (Nle a b)). intro H0. + rewrite (Nle_double_plus_one_mono _ _ H0) in H. discriminate H. + trivial. +Qed. + +(* A [min] function over [N] *) + +Definition Nmin (a b:N) := if Nle a b then a else b. + +Lemma Nmin_choice : forall a b, {Nmin a b = a} + {Nmin a b = b}. +Proof. + unfold Nmin in |- *. intros. elim (sumbool_of_bool (Nle a b)). intro H. left. rewrite H. + reflexivity. + intro H. right. rewrite H. reflexivity. +Qed. + +Lemma Nmin_le_1 : forall a b, Nle (Nmin a b) a = true. +Proof. + unfold Nmin in |- *. intros. elim (sumbool_of_bool (Nle a b)). intro H. rewrite H. + apply Nle_refl. + intro H. rewrite H. apply Nlt_le_weak. assumption. +Qed. + +Lemma Nmin_le_2 : forall a b, Nle (Nmin a b) b = true. +Proof. + unfold Nmin in |- *. intros. elim (sumbool_of_bool (Nle a b)). intro H. rewrite H. assumption. + intro H. rewrite H. apply Nle_refl. +Qed. + +Lemma Nmin_le_3 : + forall a b c, Nle a (Nmin b c) = true -> Nle a b = true. +Proof. + unfold Nmin in |- *. intros. elim (sumbool_of_bool (Nle b c)). intro H0. rewrite H0 in H. + assumption. + intro H0. rewrite H0 in H. apply Nlt_le_weak. apply Nle_lt_trans with (b := c); assumption. +Qed. + +Lemma Nmin_le_4 : + forall a b c, Nle a (Nmin b c) = true -> Nle a c = true. +Proof. + unfold Nmin in |- *. intros. elim (sumbool_of_bool (Nle b c)). intro H0. rewrite H0 in H. + apply Nle_trans with (b := b); assumption. + intro H0. rewrite H0 in H. assumption. +Qed. + +Lemma Nmin_le_5 : + forall a b c, + Nle a b = true -> Nle a c = true -> Nle a (Nmin b c) = true. +Proof. + intros. elim (Nmin_choice b c). intro H1. rewrite H1. assumption. + intro H1. rewrite H1. assumption. +Qed. + +Lemma Nmin_lt_3 : + forall a b c, Nle (Nmin b c) a = false -> Nle b a = false. +Proof. + unfold Nmin in |- *. intros. elim (sumbool_of_bool (Nle b c)). intro H0. rewrite H0 in H. + assumption. + intro H0. rewrite H0 in H. apply Nlt_trans with (b := c); assumption. +Qed. + +Lemma Nmin_lt_4 : + forall a b c, Nle (Nmin b c) a = false -> Nle c a = false. +Proof. + unfold Nmin in |- *. intros. elim (sumbool_of_bool (Nle b c)). intro H0. rewrite H0 in H. + apply Nlt_le_trans with (b := b); assumption. + intro H0. rewrite H0 in H. assumption. +Qed. diff --git a/theories/NArith/Ndigits.v b/theories/NArith/Ndigits.v new file mode 100644 index 00000000..ed8ced5b --- /dev/null +++ b/theories/NArith/Ndigits.v @@ -0,0 +1,767 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: Ndigits.v 8736 2006-04-26 21:18:44Z letouzey $ i*) + +Require Import Bool. +Require Import Bvector. +Require Import BinPos. +Require Import BinNat. + +(** Operation over bits of a [N] number. *) + +(** [xor] *) + +Fixpoint Pxor (p1 p2:positive) {struct p1} : N := + match p1, p2 with + | xH, xH => N0 + | xH, xO p2 => Npos (xI p2) + | xH, xI p2 => Npos (xO p2) + | xO p1, xH => Npos (xI p1) + | xO p1, xO p2 => Ndouble (Pxor p1 p2) + | xO p1, xI p2 => Ndouble_plus_one (Pxor p1 p2) + | xI p1, xH => Npos (xO p1) + | xI p1, xO p2 => Ndouble_plus_one (Pxor p1 p2) + | xI p1, xI p2 => Ndouble (Pxor p1 p2) + end. + +Definition Nxor (n n':N) := + match n, n' with + | N0, _ => n' + | _, N0 => n + | Npos p, Npos p' => Pxor p p' + end. + +Lemma Nxor_neutral_left : forall n:N, Nxor N0 n = n. +Proof. + trivial. +Qed. + +Lemma Nxor_neutral_right : forall n:N, Nxor n N0 = n. +Proof. + destruct n; trivial. +Qed. + +Lemma Nxor_comm : forall n n':N, Nxor n n' = Nxor n' n. +Proof. + destruct n; destruct n'; simpl; auto. + generalize p0; clear p0; induction p as [p Hrecp| p Hrecp| ]; simpl; + auto. + destruct p0; simpl; trivial; intros; rewrite Hrecp; trivial. + destruct p0; simpl; trivial; intros; rewrite Hrecp; trivial. + destruct p0 as [p| p| ]; simpl; auto. +Qed. + +Lemma Nxor_nilpotent : forall n:N, Nxor n n = N0. +Proof. + destruct n; trivial. + simpl. induction p as [p IHp| p IHp| ]; trivial. + simpl. rewrite IHp; reflexivity. + simpl. rewrite IHp; reflexivity. +Qed. + +(** Checking whether a particular bit is set on not *) + +Fixpoint Pbit (p:positive) : nat -> bool := + match p with + | xH => fun n:nat => match n with + | O => true + | S _ => false + end + | xO p => + fun n:nat => match n with + | O => false + | S n' => Pbit p n' + end + | xI p => fun n:nat => match n with + | O => true + | S n' => Pbit p n' + end + end. + +Definition Nbit (a:N) := + match a with + | N0 => fun _ => false + | Npos p => Pbit p + end. + +(** Auxiliary results about streams of bits *) + +Definition eqf (f g:nat -> bool) := forall n:nat, f n = g n. + +Lemma eqf_sym : forall f f':nat -> bool, eqf f f' -> eqf f' f. +Proof. + unfold eqf. intros. rewrite H. reflexivity. +Qed. + +Lemma eqf_refl : forall f:nat -> bool, eqf f f. +Proof. + unfold eqf. trivial. +Qed. + +Lemma eqf_trans : + forall f f' f'':nat -> bool, eqf f f' -> eqf f' f'' -> eqf f f''. +Proof. + unfold eqf. intros. rewrite H. exact (H0 n). +Qed. + +Definition xorf (f g:nat -> bool) (n:nat) := xorb (f n) (g n). + +Lemma xorf_eq : + forall f f', eqf (xorf f f') (fun n => false) -> eqf f f'. +Proof. + unfold eqf, xorf. intros. apply xorb_eq. apply H. +Qed. + +Lemma xorf_assoc : + forall f f' f'', + eqf (xorf (xorf f f') f'') (xorf f (xorf f' f'')). +Proof. + unfold eqf, xorf. intros. apply xorb_assoc. +Qed. + +Lemma eqf_xorf : + forall f f' f'' f''', + eqf f f' -> eqf f'' f''' -> eqf (xorf f f'') (xorf f' f'''). +Proof. + unfold eqf, xorf. intros. rewrite H. rewrite H0. reflexivity. +Qed. + +(** End of auxilliary results *) + +(** This part is aimed at proving that if two numbers produce + the same stream of bits, then they are equal. *) + +Lemma Nbit_faithful_1 : forall a:N, eqf (Nbit N0) (Nbit a) -> N0 = a. +Proof. + destruct a. trivial. + induction p as [p IHp| p IHp| ]; intro H. + absurd (N0 = Npos p). discriminate. + exact (IHp (fun n => H (S n))). + absurd (N0 = Npos p). discriminate. + exact (IHp (fun n => H (S n))). + absurd (false = true). discriminate. + exact (H 0). +Qed. + +Lemma Nbit_faithful_2 : + forall a:N, eqf (Nbit (Npos 1)) (Nbit a) -> Npos 1 = a. +Proof. + destruct a. intros. absurd (true = false). discriminate. + exact (H 0). + destruct p. intro H. absurd (N0 = Npos p). discriminate. + exact (Nbit_faithful_1 (Npos p) (fun n:nat => H (S n))). + intros. absurd (true = false). discriminate. + exact (H 0). + trivial. +Qed. + +Lemma Nbit_faithful_3 : + forall (a:N) (p:positive), + (forall p':positive, eqf (Nbit (Npos p)) (Nbit (Npos p')) -> p = p') -> + eqf (Nbit (Npos (xO p))) (Nbit a) -> Npos (xO p) = a. +Proof. + destruct a. intros. cut (eqf (Nbit N0) (Nbit (Npos (xO p)))). + intro. rewrite (Nbit_faithful_1 (Npos (xO p)) H1). reflexivity. + unfold eqf. intro. unfold eqf in H0. rewrite H0. reflexivity. + case p. intros. absurd (false = true). discriminate. + exact (H0 0). + intros. rewrite (H p0 (fun n => H0 (S n))). reflexivity. + intros. absurd (false = true). discriminate. + exact (H0 0). +Qed. + +Lemma Nbit_faithful_4 : + forall (a:N) (p:positive), + (forall p':positive, eqf (Nbit (Npos p)) (Nbit (Npos p')) -> p = p') -> + eqf (Nbit (Npos (xI p))) (Nbit a) -> Npos (xI p) = a. +Proof. + destruct a. intros. cut (eqf (Nbit N0) (Nbit (Npos (xI p)))). + intro. rewrite (Nbit_faithful_1 (Npos (xI p)) H1). reflexivity. + unfold eqf. intro. unfold eqf in H0. rewrite H0. reflexivity. + case p. intros. rewrite (H p0 (fun n:nat => H0 (S n))). reflexivity. + intros. absurd (true = false). discriminate. + exact (H0 0). + intros. absurd (N0 = Npos p0). discriminate. + cut (eqf (Nbit (Npos 1)) (Nbit (Npos (xI p0)))). + intro. exact (Nbit_faithful_1 (Npos p0) (fun n:nat => H1 (S n))). + unfold eqf in *. intro. rewrite H0. reflexivity. +Qed. + +Lemma Nbit_faithful : forall a a':N, eqf (Nbit a) (Nbit a') -> a = a'. +Proof. + destruct a. exact Nbit_faithful_1. + induction p. intros a' H. apply Nbit_faithful_4. intros. cut (Npos p = Npos p'). + intro. inversion H1. reflexivity. + exact (IHp (Npos p') H0). + assumption. + intros. apply Nbit_faithful_3. intros. cut (Npos p = Npos p'). intro. inversion H1. reflexivity. + exact (IHp (Npos p') H0). + assumption. + exact Nbit_faithful_2. +Qed. + +(** We now describe the semantics of [Nxor] in terms of bit streams. *) + +Lemma Nxor_sem_1 : forall a':N, Nbit (Nxor N0 a') 0 = Nbit a' 0. +Proof. + trivial. +Qed. + +Lemma Nxor_sem_2 : + forall a':N, Nbit (Nxor (Npos 1) a') 0 = negb (Nbit a' 0). +Proof. + intro. case a'. trivial. + simpl. intro. + case p; trivial. +Qed. + +Lemma Nxor_sem_3 : + forall (p:positive) (a':N), + Nbit (Nxor (Npos (xO p)) a') 0 = Nbit a' 0. +Proof. + intros. case a'. trivial. + simpl. intro. + case p0; trivial. intro. + case (Pxor p p1); trivial. + intro. case (Pxor p p1); trivial. +Qed. + +Lemma Nxor_sem_4 : + forall (p:positive) (a':N), + Nbit (Nxor (Npos (xI p)) a') 0 = negb (Nbit a' 0). +Proof. + intros. case a'. trivial. + simpl. intro. case p0; trivial. intro. + case (Pxor p p1); trivial. + intro. + case (Pxor p p1); trivial. +Qed. + +Lemma Nxor_sem_5 : + forall a a':N, Nbit (Nxor a a') 0 = xorf (Nbit a) (Nbit a') 0. +Proof. + destruct a. intro. change (Nbit a' 0 = xorb false (Nbit a' 0)). rewrite false_xorb. trivial. + case p. exact Nxor_sem_4. + intros. change (Nbit (Nxor (Npos (xO p0)) a') 0 = xorb false (Nbit a' 0)). + rewrite false_xorb. apply Nxor_sem_3. exact Nxor_sem_2. +Qed. + +Lemma Nxor_sem_6 : + forall n:nat, + (forall a a':N, Nbit (Nxor a a') n = xorf (Nbit a) (Nbit a') n) -> + forall a a':N, + Nbit (Nxor a a') (S n) = xorf (Nbit a) (Nbit a') (S n). +Proof. + intros. + generalize (fun p1 p2 => H (Npos p1) (Npos p2)); clear H; intro H. + unfold xorf in *. + case a. simpl Nbit; rewrite false_xorb. reflexivity. + case a'; intros. + simpl Nbit; rewrite xorb_false. reflexivity. + case p0. case p; intros; simpl Nbit in *. + rewrite <- H; simpl; case (Pxor p2 p1); trivial. + rewrite <- H; simpl; case (Pxor p2 p1); trivial. + rewrite xorb_false. reflexivity. + case p; intros; simpl Nbit in *. + rewrite <- H; simpl; case (Pxor p2 p1); trivial. + rewrite <- H; simpl; case (Pxor p2 p1); trivial. + rewrite xorb_false. reflexivity. + simpl Nbit. rewrite false_xorb. simpl. case p; trivial. +Qed. + +Lemma Nxor_semantics : + forall a a':N, eqf (Nbit (Nxor a a')) (xorf (Nbit a) (Nbit a')). +Proof. + unfold eqf. intros. generalize a a'. elim n. exact Nxor_sem_5. + exact Nxor_sem_6. +Qed. + +(** Consequences: + - only equal numbers lead to a null xor + - xor is associative +*) + +Lemma Nxor_eq : forall a a':N, Nxor a a' = N0 -> a = a'. +Proof. + intros. apply Nbit_faithful. apply xorf_eq. apply eqf_trans with (f' := Nbit (Nxor a a')). + apply eqf_sym. apply Nxor_semantics. + rewrite H. unfold eqf. trivial. +Qed. + +Lemma Nxor_assoc : + forall a a' a'':N, Nxor (Nxor a a') a'' = Nxor a (Nxor a' a''). +Proof. + intros. apply Nbit_faithful. + apply eqf_trans with + (f' := xorf (xorf (Nbit a) (Nbit a')) (Nbit a'')). + apply eqf_trans with (f' := xorf (Nbit (Nxor a a')) (Nbit a'')). + apply Nxor_semantics. + apply eqf_xorf. apply Nxor_semantics. + apply eqf_refl. + apply eqf_trans with + (f' := xorf (Nbit a) (xorf (Nbit a') (Nbit a''))). + apply xorf_assoc. + apply eqf_trans with (f' := xorf (Nbit a) (Nbit (Nxor a' a''))). + apply eqf_xorf. apply eqf_refl. + apply eqf_sym. apply Nxor_semantics. + apply eqf_sym. apply Nxor_semantics. +Qed. + +(** Checking whether a number is odd, i.e. + if its lower bit is set. *) + +Definition Nbit0 (n:N) := + match n with + | N0 => false + | Npos (xO _) => false + | _ => true + end. + +Definition Nodd (n:N) := Nbit0 n = true. +Definition Neven (n:N) := Nbit0 n = false. + +Lemma Nbit0_correct : forall n:N, Nbit n 0 = Nbit0 n. +Proof. + destruct n; trivial. + destruct p; trivial. +Qed. + +Lemma Ndouble_bit0 : forall n:N, Nbit0 (Ndouble n) = false. +Proof. + destruct n; trivial. +Qed. + +Lemma Ndouble_plus_one_bit0 : + forall n:N, Nbit0 (Ndouble_plus_one n) = true. +Proof. + destruct n; trivial. +Qed. + +Lemma Ndiv2_double : + forall n:N, Neven n -> Ndouble (Ndiv2 n) = n. +Proof. + destruct n. trivial. destruct p. intro H. discriminate H. + intros. reflexivity. + intro H. discriminate H. +Qed. + +Lemma Ndiv2_double_plus_one : + forall n:N, Nodd n -> Ndouble_plus_one (Ndiv2 n) = n. +Proof. + destruct n. intro. discriminate H. + destruct p. intros. reflexivity. + intro H. discriminate H. + intro. reflexivity. +Qed. + +Lemma Ndiv2_correct : + forall (a:N) (n:nat), Nbit (Ndiv2 a) n = Nbit a (S n). +Proof. + destruct a; trivial. + destruct p; trivial. +Qed. + +Lemma Nxor_bit0 : + forall a a':N, Nbit0 (Nxor a a') = xorb (Nbit0 a) (Nbit0 a'). +Proof. + intros. rewrite <- Nbit0_correct. rewrite (Nxor_semantics a a' 0). + unfold xorf. rewrite Nbit0_correct. rewrite Nbit0_correct. reflexivity. +Qed. + +Lemma Nxor_div2 : + forall a a':N, Ndiv2 (Nxor a a') = Nxor (Ndiv2 a) (Ndiv2 a'). +Proof. + intros. apply Nbit_faithful. unfold eqf. intro. + rewrite (Nxor_semantics (Ndiv2 a) (Ndiv2 a') n). + rewrite Ndiv2_correct. + rewrite (Nxor_semantics a a' (S n)). + unfold xorf. rewrite Ndiv2_correct. rewrite Ndiv2_correct. + reflexivity. +Qed. + +Lemma Nneg_bit0 : + forall a a':N, + Nbit0 (Nxor a a') = true -> Nbit0 a = negb (Nbit0 a'). +Proof. + intros. rewrite <- true_xorb. rewrite <- H. rewrite Nxor_bit0. + rewrite xorb_assoc. rewrite xorb_nilpotent. rewrite xorb_false. reflexivity. +Qed. + +Lemma Nneg_bit0_1 : + forall a a':N, Nxor a a' = Npos 1 -> Nbit0 a = negb (Nbit0 a'). +Proof. + intros. apply Nneg_bit0. rewrite H. reflexivity. +Qed. + +Lemma Nneg_bit0_2 : + forall (a a':N) (p:positive), + Nxor a a' = Npos (xI p) -> Nbit0 a = negb (Nbit0 a'). +Proof. + intros. apply Nneg_bit0. rewrite H. reflexivity. +Qed. + +Lemma Nsame_bit0 : + forall (a a':N) (p:positive), + Nxor a a' = Npos (xO p) -> Nbit0 a = Nbit0 a'. +Proof. + intros. rewrite <- (xorb_false (Nbit0 a)). cut (Nbit0 (Npos (xO p)) = false). + intro. rewrite <- H0. rewrite <- H. rewrite Nxor_bit0. rewrite <- xorb_assoc. + rewrite xorb_nilpotent. rewrite false_xorb. reflexivity. + reflexivity. +Qed. + +(** a lexicographic order on bits, starting from the lowest bit *) + +Fixpoint Nless_aux (a a':N) (p:positive) {struct p} : bool := + match p with + | xO p' => Nless_aux (Ndiv2 a) (Ndiv2 a') p' + | _ => andb (negb (Nbit0 a)) (Nbit0 a') + end. + +Definition Nless (a a':N) := + match Nxor a a' with + | N0 => false + | Npos p => Nless_aux a a' p + end. + +Lemma Nbit0_less : + forall a a', + Nbit0 a = false -> Nbit0 a' = true -> Nless a a' = true. +Proof. + intros. elim (Ndiscr (Nxor a a')). intro H1. elim H1. intros p H2. unfold Nless in |- *. + rewrite H2. generalize H2. elim p. intros. simpl in |- *. rewrite H. rewrite H0. reflexivity. + intros. cut (Nbit0 (Nxor a a') = false). intro. rewrite (Nxor_bit0 a a') in H5. + rewrite H in H5. rewrite H0 in H5. discriminate H5. + rewrite H4. reflexivity. + intro. simpl in |- *. rewrite H. rewrite H0. reflexivity. + intro H1. cut (Nbit0 (Nxor a a') = false). intro. rewrite (Nxor_bit0 a a') in H2. + rewrite H in H2. rewrite H0 in H2. discriminate H2. + rewrite H1. reflexivity. +Qed. + +Lemma Nbit0_gt : + forall a a', + Nbit0 a = true -> Nbit0 a' = false -> Nless a a' = false. +Proof. + intros. elim (Ndiscr (Nxor a a')). intro H1. elim H1. intros p H2. unfold Nless in |- *. + rewrite H2. generalize H2. elim p. intros. simpl in |- *. rewrite H. rewrite H0. reflexivity. + intros. cut (Nbit0 (Nxor a a') = false). intro. rewrite (Nxor_bit0 a a') in H5. + rewrite H in H5. rewrite H0 in H5. discriminate H5. + rewrite H4. reflexivity. + intro. simpl in |- *. rewrite H. rewrite H0. reflexivity. + intro H1. unfold Nless in |- *. rewrite H1. reflexivity. +Qed. + +Lemma Nless_not_refl : forall a, Nless a a = false. +Proof. + intro. unfold Nless in |- *. rewrite (Nxor_nilpotent a). reflexivity. +Qed. + +Lemma Nless_def_1 : + forall a a', Nless (Ndouble a) (Ndouble a') = Nless a a'. +Proof. + simple induction a. simple induction a'. reflexivity. + trivial. + simple induction a'. unfold Nless in |- *. simpl in |- *. elim p; trivial. + unfold Nless in |- *. simpl in |- *. intro. case (Pxor p p0). reflexivity. + trivial. +Qed. + +Lemma Nless_def_2 : + forall a a', + Nless (Ndouble_plus_one a) (Ndouble_plus_one a') = Nless a a'. +Proof. + simple induction a. simple induction a'. reflexivity. + trivial. + simple induction a'. unfold Nless in |- *. simpl in |- *. elim p; trivial. + unfold Nless in |- *. simpl in |- *. intro. case (Pxor p p0). reflexivity. + trivial. +Qed. + +Lemma Nless_def_3 : + forall a a', Nless (Ndouble a) (Ndouble_plus_one a') = true. +Proof. + intros. apply Nbit0_less. apply Ndouble_bit0. + apply Ndouble_plus_one_bit0. +Qed. + +Lemma Nless_def_4 : + forall a a', Nless (Ndouble_plus_one a) (Ndouble a') = false. +Proof. + intros. apply Nbit0_gt. apply Ndouble_plus_one_bit0. + apply Ndouble_bit0. +Qed. + +Lemma Nless_z : forall a, Nless a N0 = false. +Proof. + simple induction a. reflexivity. + unfold Nless in |- *. intro. rewrite (Nxor_neutral_right (Npos p)). elim p; trivial. +Qed. + +Lemma N0_less_1 : + forall a, Nless N0 a = true -> {p : positive | a = Npos p}. +Proof. + simple induction a. intro. discriminate H. + intros. split with p. reflexivity. +Qed. + +Lemma N0_less_2 : forall a, Nless N0 a = false -> a = N0. +Proof. + simple induction a. trivial. + unfold Nless in |- *. simpl in |- *. + cut (forall p:positive, Nless_aux N0 (Npos p) p = false -> False). + intros. elim (H p H0). + simple induction p. intros. discriminate H0. + intros. exact (H H0). + intro. discriminate H. +Qed. + +Lemma Nless_trans : + forall a a' a'', + Nless a a' = true -> Nless a' a'' = true -> Nless a a'' = true. +Proof. + intro a. pattern a; apply N_ind_double. + intros. case_eq (Nless N0 a''). trivial. + intro H1. rewrite (N0_less_2 a'' H1) in H0. rewrite (Nless_z a') in H0. discriminate H0. + intros a0 H a'. pattern a'; apply N_ind_double. + intros. rewrite (Nless_z (Ndouble a0)) in H0. discriminate H0. + intros a1 H0 a'' H1. rewrite (Nless_def_1 a0 a1) in H1. + pattern a''; apply N_ind_double; clear a''. + intro. rewrite (Nless_z (Ndouble a1)) in H2. discriminate H2. + intros. rewrite (Nless_def_1 a1 a2) in H3. rewrite (Nless_def_1 a0 a2). + exact (H a1 a2 H1 H3). + intros. apply Nless_def_3. + intros a1 H0 a'' H1. pattern a''; apply N_ind_double. + intro. rewrite (Nless_z (Ndouble_plus_one a1)) in H2. discriminate H2. + intros. rewrite (Nless_def_4 a1 a2) in H3. discriminate H3. + intros. apply Nless_def_3. + intros a0 H a'. pattern a'; apply N_ind_double. + intros. rewrite (Nless_z (Ndouble_plus_one a0)) in H0. discriminate H0. + intros. rewrite (Nless_def_4 a0 a1) in H1. discriminate H1. + intros a1 H0 a'' H1. pattern a''; apply N_ind_double. + intro. rewrite (Nless_z (Ndouble_plus_one a1)) in H2. discriminate H2. + intros. rewrite (Nless_def_4 a1 a2) in H3. discriminate H3. + rewrite (Nless_def_2 a0 a1) in H1. intros. rewrite (Nless_def_2 a1 a2) in H3. + rewrite (Nless_def_2 a0 a2). exact (H a1 a2 H1 H3). +Qed. + +Lemma Nless_total : + forall a a', {Nless a a' = true} + {Nless a' a = true} + {a = a'}. +Proof. + intro a. + pattern a; apply N_rec_double; clear a. + intro. case_eq (Nless N0 a'). intro H. left. left. auto. + intro H. right. rewrite (N0_less_2 a' H). reflexivity. + intros a0 H a'. + pattern a'; apply N_rec_double; clear a'. + case_eq (Nless N0 (Ndouble a0)). intro H0. left. right. auto. + intro H0. right. exact (N0_less_2 _ H0). + intros a1 H0. rewrite Nless_def_1. rewrite Nless_def_1. elim (H a1). intro H1. + left. assumption. + intro H1. right. rewrite H1. reflexivity. + intros a1 H0. left. left. apply Nless_def_3. + intros a0 H a'. + pattern a'; apply N_rec_double; clear a'. + left. right. case a0; reflexivity. + intros a1 H0. left. right. apply Nless_def_3. + intros a1 H0. rewrite Nless_def_2. rewrite Nless_def_2. elim (H a1). intro H1. + left. assumption. + intro H1. right. rewrite H1. reflexivity. +Qed. + +(** Number of digits in a number *) + +Fixpoint Psize (p:positive) : nat := + match p with + | xH => 1%nat + | xI p => S (Psize p) + | xO p => S (Psize p) + end. + +Definition Nsize (n:N) : nat := match n with + | N0 => 0%nat + | Npos p => Psize p + end. + + +(** conversions between N and bit vectors. *) + +Fixpoint P2Bv (p:positive) : Bvector (Psize p) := + match p return Bvector (Psize p) with + | xH => Bvect_true 1%nat + | xO p => Bcons false (Psize p) (P2Bv p) + | xI p => Bcons true (Psize p) (P2Bv p) + end. + +Definition N2Bv (n:N) : Bvector (Nsize n) := + match n as n0 return Bvector (Nsize n0) with + | N0 => Bnil + | Npos p => P2Bv p + end. + +Fixpoint Bv2N (n:nat)(bv:Bvector n) {struct bv} : N := + match bv with + | Vnil => N0 + | Vcons false n bv => Ndouble (Bv2N n bv) + | Vcons true n bv => Ndouble_plus_one (Bv2N n bv) + end. + +Lemma Bv2N_N2Bv : forall n, Bv2N _ (N2Bv n) = n. +Proof. +destruct n. +simpl; auto. +induction p; simpl in *; auto; rewrite IHp; simpl; auto. +Qed. + +(** The opposite composition is not so simple: if the considered + bit vector has some zeros on its right, they will disappear during + the return [Bv2N] translation: *) + +Lemma Bv2N_Nsize : forall n (bv:Bvector n), Nsize (Bv2N n bv) <= n. +Proof. +induction n; intros. +rewrite (V0_eq _ bv); simpl; auto. +rewrite (VSn_eq _ _ bv); simpl. +generalize (IHn (Vtail _ _ bv)); clear IHn. +destruct (Vhead _ _ bv); + destruct (Bv2N n (Vtail bool n bv)); + simpl; auto with arith. +Qed. + +(** In the previous lemma, we can only replace the inequality by + an equality whenever the highest bit is non-null. *) + +Lemma Bv2N_Nsize_1 : forall n (bv:Bvector (S n)), + Bsign _ bv = true <-> + Nsize (Bv2N _ bv) = (S n). +Proof. +induction n; intro. +rewrite (VSn_eq _ _ bv); simpl. +rewrite (V0_eq _ (Vtail _ _ bv)); simpl. +destruct (Vhead _ _ bv); simpl; intuition; try discriminate. +rewrite (VSn_eq _ _ bv); simpl. +generalize (IHn (Vtail _ _ bv)); clear IHn. +destruct (Vhead _ _ bv); + destruct (Bv2N (S n) (Vtail bool (S n) bv)); + simpl; intuition; try discriminate. +Qed. + +(** To state nonetheless a second result about composition of + conversions, we define a conversion on a given number of bits : *) + +Fixpoint N2Bv_gen (n:nat)(a:N) { struct n } : Bvector n := + match n return Bvector n with + | 0 => Bnil + | S n => match a with + | N0 => Bvect_false (S n) + | Npos xH => Bcons true _ (Bvect_false n) + | Npos (xO p) => Bcons false _ (N2Bv_gen n (Npos p)) + | Npos (xI p) => Bcons true _ (N2Bv_gen n (Npos p)) + end + end. + +(** The first [N2Bv] is then a special case of [N2Bv_gen] *) + +Lemma N2Bv_N2Bv_gen : forall (a:N), N2Bv a = N2Bv_gen (Nsize a) a. +Proof. +destruct a; simpl. +auto. +induction p; simpl; intros; auto; congruence. +Qed. + +(** In fact, if [k] is large enough, [N2Bv_gen k a] contains all digits of + [a] plus some zeros. *) + +Lemma N2Bv_N2Bv_gen_above : forall (a:N)(k:nat), + N2Bv_gen (Nsize a + k) a = Vextend _ _ _ (N2Bv a) (Bvect_false k). +Proof. +destruct a; simpl. +destruct k; simpl; auto. +induction p; simpl; intros;unfold Bcons; f_equal; auto. +Qed. + +(** Here comes now the second composition result. *) + +Lemma N2Bv_Bv2N : forall n (bv:Bvector n), + N2Bv_gen n (Bv2N n bv) = bv. +Proof. +induction n; intros. +rewrite (V0_eq _ bv); simpl; auto. +rewrite (VSn_eq _ _ bv); simpl. +generalize (IHn (Vtail _ _ bv)); clear IHn. +unfold Bcons. +destruct (Bv2N _ (Vtail _ _ bv)); + destruct (Vhead _ _ bv); intro H; rewrite <- H; simpl; trivial; + induction n; simpl; auto. +Qed. + +(** accessing some precise bits. *) + +Lemma Nbit0_Blow : forall n, forall (bv:Bvector (S n)), + Nbit0 (Bv2N _ bv) = Blow _ bv. +Proof. +intros. +unfold Blow. +pattern bv at 1; rewrite (VSn_eq _ _ bv). +simpl. +destruct (Bv2N n (Vtail bool n bv)); simpl; + destruct (Vhead bool n bv); auto. +Qed. + +Definition Bnth (n:nat)(bv:Bvector n)(p:nat) : p<n -> bool. +Proof. + induction 1. + intros. + elimtype False; inversion H. + intros. + destruct p. + exact a. + apply (IHbv p); auto with arith. +Defined. + +Lemma Bnth_Nbit : forall n (bv:Bvector n) p (H:p<n), + Bnth _ bv p H = Nbit (Bv2N _ bv) p. +Proof. +induction bv; intros. +inversion H. +destruct p; simpl; destruct (Bv2N n bv); destruct a; simpl in *; auto. +Qed. + +Lemma Nbit_Nsize : forall n p, Nsize n <= p -> Nbit n p = false. +Proof. +destruct n as [|n]. +simpl; auto. +induction n; simpl in *; intros; destruct p; auto with arith. +inversion H. +inversion H. +Qed. + +Lemma Nbit_Bth: forall n p (H:p < Nsize n), Nbit n p = Bnth _ (N2Bv n) p H. +Proof. +destruct n as [|n]. +inversion H. +induction n; simpl in *; intros; destruct p; auto with arith. +inversion H; inversion H1. +Qed. + +(** Xor is the same in the two worlds. *) + +Lemma Nxor_BVxor : forall n (bv bv' : Bvector n), + Bv2N _ (BVxor _ bv bv') = Nxor (Bv2N _ bv) (Bv2N _ bv'). +Proof. +induction n. +intros. +rewrite (V0_eq _ bv); rewrite (V0_eq _ bv'); simpl; auto. +intros. +rewrite (VSn_eq _ _ bv); rewrite (VSn_eq _ _ bv'); simpl; auto. +rewrite IHn. +destruct (Vhead bool n bv); destruct (Vhead bool n bv'); + destruct (Bv2N n (Vtail bool n bv)); destruct (Bv2N n (Vtail bool n bv')); simpl; auto. +Qed. + diff --git a/theories/IntMap/Adist.v b/theories/NArith/Ndist.v index 790218ce..d5bfc15c 100644 --- a/theories/IntMap/Adist.v +++ b/theories/NArith/Ndist.v @@ -5,40 +5,42 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Adist.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: Ndist.v 8733 2006-04-25 22:52:18Z letouzey $ i*) -Require Import Bool. -Require Import ZArith. Require Import Arith. Require Import Min. -Require Import Addr. +Require Import BinPos. +Require Import BinNat. +Require Import Ndigits. -Fixpoint ad_plength_1 (p:positive) : nat := - match p with - | xH => 0 - | xI _ => 0 - | xO p' => S (ad_plength_1 p') - end. +(** An ultrametric distance over [N] numbers *) Inductive natinf : Set := | infty : natinf | ni : nat -> natinf. -Definition ad_plength (a:ad) := +Fixpoint Pplength (p:positive) : nat := + match p with + | xH => 0 + | xI _ => 0 + | xO p' => S (Pplength p') + end. + +Definition Nplength (a:N) := match a with - | ad_z => infty - | ad_x p => ni (ad_plength_1 p) + | N0 => infty + | Npos p => ni (Pplength p) end. -Lemma ad_plength_infty : forall a:ad, ad_plength a = infty -> a = ad_z. +Lemma Nplength_infty : forall a:N, Nplength a = infty -> a = N0. Proof. simple induction a; trivial. - unfold ad_plength in |- *; intros; discriminate H. + unfold Nplength in |- *; intros; discriminate H. Qed. -Lemma ad_plength_zeros : - forall (a:ad) (n:nat), - ad_plength a = ni n -> forall k:nat, k < n -> ad_bit a k = false. +Lemma Nplength_zeros : + forall (a:N) (n:nat), + Nplength a = ni n -> forall k:nat, k < n -> Nbit a k = false. Proof. simple induction a; trivial. simple induction p. simple induction n. intros. inversion H1. @@ -46,33 +48,33 @@ Proof. intros. simpl in H1. discriminate H1. simple induction k. trivial. generalize H0. case n. intros. inversion H3. - intros. simpl in |- *. unfold ad_bit in H. apply (H n0). simpl in H1. inversion H1. reflexivity. + intros. simpl in |- *. unfold Nbit in H. apply (H n0). simpl in H1. inversion H1. reflexivity. exact (lt_S_n n1 n0 H3). simpl in |- *. intros n H. inversion H. intros. inversion H0. Qed. -Lemma ad_plength_one : - forall (a:ad) (n:nat), ad_plength a = ni n -> ad_bit a n = true. +Lemma Nplength_one : + forall (a:N) (n:nat), Nplength a = ni n -> Nbit a n = true. Proof. simple induction a. intros. inversion H. simple induction p. intros. simpl in H0. inversion H0. reflexivity. - intros. simpl in H0. inversion H0. simpl in |- *. unfold ad_bit in H. apply H. reflexivity. + intros. simpl in H0. inversion H0. simpl in |- *. unfold Nbit in H. apply H. reflexivity. intros. simpl in H. inversion H. reflexivity. Qed. -Lemma ad_plength_first_one : - forall (a:ad) (n:nat), - (forall k:nat, k < n -> ad_bit a k = false) -> - ad_bit a n = true -> ad_plength a = ni n. +Lemma Nplength_first_one : + forall (a:N) (n:nat), + (forall k:nat, k < n -> Nbit a k = false) -> + Nbit a n = true -> Nplength a = ni n. Proof. simple induction a. intros. simpl in H0. discriminate H0. simple induction p. intros. generalize H0. case n. intros. reflexivity. - intros. absurd (ad_bit (ad_x (xI p0)) 0 = false). trivial with bool. + intros. absurd (Nbit (Npos (xI p0)) 0 = false). trivial with bool. auto with bool arith. intros. generalize H0 H1. case n. intros. simpl in H3. discriminate H3. - intros. simpl in |- *. unfold ad_plength in H. - cut (ni (ad_plength_1 p0) = ni n0). intro. inversion H4. reflexivity. - apply H. intros. change (ad_bit (ad_x (xO p0)) (S k) = false) in |- *. apply H2. apply lt_n_S. exact H4. + intros. simpl in |- *. unfold Nplength in H. + cut (ni (Pplength p0) = ni n0). intro. inversion H4. reflexivity. + apply H. intros. change (Nbit (Npos (xO p0)) (S k) = false) in |- *. apply H2. apply lt_n_S. exact H4. exact H3. intro. case n. trivial. intros. simpl in H0. discriminate H0. @@ -220,117 +222,117 @@ Proof. unfold ni_le in |- *. unfold ni_min in |- *. intros. inversion H. apply le_min_r. Qed. -Lemma ad_plength_lb : - forall (a:ad) (n:nat), - (forall k:nat, k < n -> ad_bit a k = false) -> ni_le (ni n) (ad_plength a). +Lemma Nplength_lb : + forall (a:N) (n:nat), + (forall k:nat, k < n -> Nbit a k = false) -> ni_le (ni n) (Nplength a). Proof. simple induction a. intros. exact (ni_min_inf_r (ni n)). - intros. unfold ad_plength in |- *. apply le_ni_le. case (le_or_lt n (ad_plength_1 p)). trivial. - intro. absurd (ad_bit (ad_x p) (ad_plength_1 p) = false). + intros. unfold Nplength in |- *. apply le_ni_le. case (le_or_lt n (Pplength p)). trivial. + intro. absurd (Nbit (Npos p) (Pplength p) = false). rewrite - (ad_plength_one (ad_x p) (ad_plength_1 p) - (refl_equal (ad_plength (ad_x p)))). + (Nplength_one (Npos p) (Pplength p) + (refl_equal (Nplength (Npos p)))). discriminate. apply H. exact H0. Qed. -Lemma ad_plength_ub : - forall (a:ad) (n:nat), ad_bit a n = true -> ni_le (ad_plength a) (ni n). +Lemma Nplength_ub : + forall (a:N) (n:nat), Nbit a n = true -> ni_le (Nplength a) (ni n). Proof. simple induction a. intros. discriminate H. - intros. unfold ad_plength in |- *. apply le_ni_le. case (le_or_lt (ad_plength_1 p) n). trivial. - intro. absurd (ad_bit (ad_x p) n = true). + intros. unfold Nplength in |- *. apply le_ni_le. case (le_or_lt (Pplength p) n). trivial. + intro. absurd (Nbit (Npos p) n = true). rewrite - (ad_plength_zeros (ad_x p) (ad_plength_1 p) - (refl_equal (ad_plength (ad_x p))) n H0). + (Nplength_zeros (Npos p) (Pplength p) + (refl_equal (Nplength (Npos p))) n H0). discriminate. exact H. Qed. -(** We define an ultrametric distance between addresses: +(** We define an ultrametric distance between [N] numbers: $d(a,a')=1/2^pd(a,a')$, where $pd(a,a')$ is the number of identical bits at the beginning of $a$ and $a'$ (infinity if $a=a'$). Instead of working with $d$, we work with $pd$, namely - [ad_pdist]: *) + [Npdist]: *) -Definition ad_pdist (a a':ad) := ad_plength (ad_xor a a'). +Definition Npdist (a a':N) := Nplength (Nxor a a'). (** d is a distance, so $d(a,a')=0$ iff $a=a'$; this means that $pd(a,a')=infty$ iff $a=a'$: *) -Lemma ad_pdist_eq_1 : forall a:ad, ad_pdist a a = infty. +Lemma Npdist_eq_1 : forall a:N, Npdist a a = infty. Proof. - intros. unfold ad_pdist in |- *. rewrite ad_xor_nilpotent. reflexivity. + intros. unfold Npdist in |- *. rewrite Nxor_nilpotent. reflexivity. Qed. -Lemma ad_pdist_eq_2 : forall a a':ad, ad_pdist a a' = infty -> a = a'. +Lemma Npdist_eq_2 : forall a a':N, Npdist a a' = infty -> a = a'. Proof. - intros. apply ad_xor_eq. apply ad_plength_infty. exact H. + intros. apply Nxor_eq. apply Nplength_infty. exact H. Qed. (** $d$ is a distance, so $d(a,a')=d(a',a)$: *) -Lemma ad_pdist_comm : forall a a':ad, ad_pdist a a' = ad_pdist a' a. +Lemma Npdist_comm : forall a a':N, Npdist a a' = Npdist a' a. Proof. - unfold ad_pdist in |- *. intros. rewrite ad_xor_comm. reflexivity. + unfold Npdist in |- *. intros. rewrite Nxor_comm. reflexivity. Qed. (** $d$ is an ultrametric distance, that is, not only $d(a,a')\leq d(a,a'')+d(a'',a')$, but in fact $d(a,a')\leq max(d(a,a''),d(a'',a'))$. - This means that $min(pd(a,a''),pd(a'',a'))<=pd(a,a')$ (lemma [ad_pdist_ultra] below). - This follows from the fact that $a ~Ra~|a| = 1/2^{\texttt{ad\_plength}}(a))$ + This means that $min(pd(a,a''),pd(a'',a'))<=pd(a,a')$ (lemma [Npdist_ultra] below). + This follows from the fact that $a ~Ra~|a| = 1/2^{\texttt{Nplength}}(a))$ is an ultrametric norm, i.e. that $|a-a'| \leq max (|a-a''|, |a''-a'|)$, or equivalently that $|a+b|<=max(|a|,|b|)$, i.e. that - min $(\texttt{ad\_plength}(a), \texttt{ad\_plength}(b)) \leq - \texttt{ad\_plength} (a~\texttt{xor}~ b)$ - (lemma [ad_plength_ultra]). + min $(\texttt{Nplength}(a), \texttt{Nplength}(b)) \leq + \texttt{Nplength} (a~\texttt{xor}~ b)$ + (lemma [Nplength_ultra]). *) -Lemma ad_plength_ultra_1 : - forall a a':ad, - ni_le (ad_plength a) (ad_plength a') -> - ni_le (ad_plength a) (ad_plength (ad_xor a a')). +Lemma Nplength_ultra_1 : + forall a a':N, + ni_le (Nplength a) (Nplength a') -> + ni_le (Nplength a) (Nplength (Nxor a a')). Proof. - simple induction a. intros. unfold ni_le in H. unfold ad_plength at 1 3 in H. - rewrite (ni_min_inf_l (ad_plength a')) in H. - rewrite (ad_plength_infty a' H). simpl in |- *. apply ni_le_refl. - intros. unfold ad_plength at 1 in |- *. apply ad_plength_lb. intros. - cut (forall a'':ad, ad_xor (ad_x p) a' = a'' -> ad_bit a'' k = false). + simple induction a. intros. unfold ni_le in H. unfold Nplength at 1 3 in H. + rewrite (ni_min_inf_l (Nplength a')) in H. + rewrite (Nplength_infty a' H). simpl in |- *. apply ni_le_refl. + intros. unfold Nplength at 1 in |- *. apply Nplength_lb. intros. + cut (forall a'':N, Nxor (Npos p) a' = a'' -> Nbit a'' k = false). intros. apply H1. reflexivity. intro a''. case a''. intro. reflexivity. - intros. rewrite <- H1. rewrite (ad_xor_semantics (ad_x p) a' k). unfold adf_xor in |- *. + intros. rewrite <- H1. rewrite (Nxor_semantics (Npos p) a' k). unfold xorf in |- *. rewrite - (ad_plength_zeros (ad_x p) (ad_plength_1 p) - (refl_equal (ad_plength (ad_x p))) k H0). + (Nplength_zeros (Npos p) (Pplength p) + (refl_equal (Nplength (Npos p))) k H0). generalize H. case a'. trivial. - intros. cut (ad_bit (ad_x p1) k = false). intros. rewrite H3. reflexivity. - apply ad_plength_zeros with (n := ad_plength_1 p1). reflexivity. - apply (lt_le_trans k (ad_plength_1 p) (ad_plength_1 p1)). exact H0. + intros. cut (Nbit (Npos p1) k = false). intros. rewrite H3. reflexivity. + apply Nplength_zeros with (n := Pplength p1). reflexivity. + apply (lt_le_trans k (Pplength p) (Pplength p1)). exact H0. apply ni_le_le. exact H2. Qed. -Lemma ad_plength_ultra : - forall a a':ad, - ni_le (ni_min (ad_plength a) (ad_plength a')) (ad_plength (ad_xor a a')). +Lemma Nplength_ultra : + forall a a':N, + ni_le (ni_min (Nplength a) (Nplength a')) (Nplength (Nxor a a')). Proof. - intros. case (ni_le_total (ad_plength a) (ad_plength a')). intro. - cut (ni_min (ad_plength a) (ad_plength a') = ad_plength a). - intro. rewrite H0. apply ad_plength_ultra_1. exact H. + intros. case (ni_le_total (Nplength a) (Nplength a')). intro. + cut (ni_min (Nplength a) (Nplength a') = Nplength a). + intro. rewrite H0. apply Nplength_ultra_1. exact H. exact H. - intro. cut (ni_min (ad_plength a) (ad_plength a') = ad_plength a'). - intro. rewrite H0. rewrite ad_xor_comm. apply ad_plength_ultra_1. exact H. + intro. cut (ni_min (Nplength a) (Nplength a') = Nplength a'). + intro. rewrite H0. rewrite Nxor_comm. apply Nplength_ultra_1. exact H. rewrite ni_min_comm. exact H. Qed. -Lemma ad_pdist_ultra : - forall a a' a'':ad, - ni_le (ni_min (ad_pdist a a'') (ad_pdist a'' a')) (ad_pdist a a'). +Lemma Npdist_ultra : + forall a a' a'':N, + ni_le (ni_min (Npdist a a'') (Npdist a'' a')) (Npdist a a'). Proof. - intros. unfold ad_pdist in |- *. cut (ad_xor (ad_xor a a'') (ad_xor a'' a') = ad_xor a a'). - intro. rewrite <- H. apply ad_plength_ultra. - rewrite ad_xor_assoc. rewrite <- (ad_xor_assoc a'' a'' a'). rewrite ad_xor_nilpotent. - rewrite ad_xor_neutral_left. reflexivity. + intros. unfold Npdist in |- *. cut (Nxor (Nxor a a'') (Nxor a'' a') = Nxor a a'). + intro. rewrite <- H. apply Nplength_ultra. + rewrite Nxor_assoc. rewrite <- (Nxor_assoc a'' a'' a'). rewrite Nxor_nilpotent. + rewrite Nxor_neutral_left. reflexivity. Qed.
\ No newline at end of file diff --git a/theories/NArith/Nnat.v b/theories/NArith/Nnat.v new file mode 100644 index 00000000..6ba6ca3d --- /dev/null +++ b/theories/NArith/Nnat.v @@ -0,0 +1,177 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: Nnat.v 8733 2006-04-25 22:52:18Z letouzey $ i*) + +Require Import Arith. +Require Import Compare_dec. +Require Import Sumbool. +Require Import Div2. +Require Import BinPos. +Require Import BinNat. +Require Import Pnat. + +(** Translation from [N] to [nat] and back. *) + +Definition nat_of_N (a:N) := + match a with + | N0 => 0%nat + | Npos p => nat_of_P p + end. + +Definition N_of_nat (n:nat) := + match n with + | O => N0 + | S n' => Npos (P_of_succ_nat n') + end. + +Lemma N_of_nat_of_N : forall a:N, N_of_nat (nat_of_N a) = a. +Proof. + destruct a as [| p]. reflexivity. + simpl in |- *. elim (ZL4 p). intros n H. rewrite H. simpl in |- *. + rewrite <- nat_of_P_o_P_of_succ_nat_eq_succ in H. + rewrite nat_of_P_inj with (1 := H). reflexivity. +Qed. + +Lemma nat_of_N_of_nat : forall n:nat, nat_of_N (N_of_nat n) = n. +Proof. + induction n. trivial. + intros. simpl in |- *. apply nat_of_P_o_P_of_succ_nat_eq_succ. +Qed. + +(** Interaction of this translation and usual operations. *) + +Lemma nat_of_Ndouble : forall a, nat_of_N (Ndouble a) = 2*(nat_of_N a). +Proof. + destruct a; simpl nat_of_N; auto. + apply nat_of_P_xO. +Qed. + +Lemma N_of_double : forall n, N_of_nat (2*n) = Ndouble (N_of_nat n). +Proof. + intros. + pattern n at 1; rewrite <- (nat_of_N_of_nat n). + rewrite <- nat_of_Ndouble. + apply N_of_nat_of_N. +Qed. + +Lemma nat_of_Ndouble_plus_one : + forall a, nat_of_N (Ndouble_plus_one a) = S (2*(nat_of_N a)). +Proof. + destruct a; simpl nat_of_N; auto. + apply nat_of_P_xI. +Qed. + +Lemma N_of_double_plus_one : + forall n, N_of_nat (S (2*n)) = Ndouble_plus_one (N_of_nat n). +Proof. + intros. + pattern n at 1; rewrite <- (nat_of_N_of_nat n). + rewrite <- nat_of_Ndouble_plus_one. + apply N_of_nat_of_N. +Qed. + +Lemma nat_of_Nsucc : forall a, nat_of_N (Nsucc a) = S (nat_of_N a). +Proof. + destruct a; simpl. + apply nat_of_P_xH. + apply nat_of_P_succ_morphism. +Qed. + +Lemma N_of_S : forall n, N_of_nat (S n) = Nsucc (N_of_nat n). +Proof. + intros. + pattern n at 1; rewrite <- (nat_of_N_of_nat n). + rewrite <- nat_of_Nsucc. + apply N_of_nat_of_N. +Qed. + +Lemma nat_of_Nplus : + forall a a', nat_of_N (Nplus a a') = (nat_of_N a)+(nat_of_N a'). +Proof. + destruct a; destruct a'; simpl; auto. + apply nat_of_P_plus_morphism. +Qed. + +Lemma N_of_plus : + forall n n', N_of_nat (n+n') = Nplus (N_of_nat n) (N_of_nat n'). +Proof. + intros. + pattern n at 1; rewrite <- (nat_of_N_of_nat n). + pattern n' at 1; rewrite <- (nat_of_N_of_nat n'). + rewrite <- nat_of_Nplus. + apply N_of_nat_of_N. +Qed. + +Lemma nat_of_Nmult : + forall a a', nat_of_N (Nmult a a') = (nat_of_N a)*(nat_of_N a'). +Proof. + destruct a; destruct a'; simpl; auto. + apply nat_of_P_mult_morphism. +Qed. + +Lemma N_of_mult : + forall n n', N_of_nat (n*n') = Nmult (N_of_nat n) (N_of_nat n'). +Proof. + intros. + pattern n at 1; rewrite <- (nat_of_N_of_nat n). + pattern n' at 1; rewrite <- (nat_of_N_of_nat n'). + rewrite <- nat_of_Nmult. + apply N_of_nat_of_N. +Qed. + +Lemma nat_of_Ndiv2 : + forall a, nat_of_N (Ndiv2 a) = div2 (nat_of_N a). +Proof. + destruct a; simpl in *; auto. + destruct p; auto. + rewrite nat_of_P_xI. + rewrite div2_double_plus_one; auto. + rewrite nat_of_P_xO. + rewrite div2_double; auto. +Qed. + +Lemma N_of_div2 : + forall n, N_of_nat (div2 n) = Ndiv2 (N_of_nat n). +Proof. + intros. + pattern n at 1; rewrite <- (nat_of_N_of_nat n). + rewrite <- nat_of_Ndiv2. + apply N_of_nat_of_N. +Qed. + +Lemma nat_of_Ncompare : + forall a a', Ncompare a a' = nat_compare (nat_of_N a) (nat_of_N a'). +Proof. + destruct a; destruct a'; simpl. + compute; auto. + generalize (lt_O_nat_of_P p). + unfold nat_compare. + destruct (lt_eq_lt_dec 0 (nat_of_P p)) as [[H|H]|H]; auto. + rewrite <- H; inversion 1. + intros; generalize (lt_trans _ _ _ H0 H); inversion 1. + generalize (lt_O_nat_of_P p). + unfold nat_compare. + destruct (lt_eq_lt_dec (nat_of_P p) 0) as [[H|H]|H]; auto. + intros; generalize (lt_trans _ _ _ H0 H); inversion 1. + rewrite H; inversion 1. + unfold nat_compare. + destruct (lt_eq_lt_dec (nat_of_P p) (nat_of_P p0)) as [[H|H]|H]; auto. + apply nat_of_P_lt_Lt_compare_complement_morphism; auto. + rewrite (nat_of_P_inj _ _ H); apply Pcompare_refl. + apply nat_of_P_gt_Gt_compare_complement_morphism; auto. +Qed. + +Lemma N_of_nat_compare : + forall n n', nat_compare n n' = Ncompare (N_of_nat n) (N_of_nat n'). +Proof. + intros. + pattern n at 1; rewrite <- (nat_of_N_of_nat n). + pattern n' at 1; rewrite <- (nat_of_N_of_nat n'). + symmetry; apply nat_of_Ncompare. +Qed.
\ No newline at end of file diff --git a/theories/QArith/QArith.v b/theories/QArith/QArith.v new file mode 100644 index 00000000..03935e2b --- /dev/null +++ b/theories/QArith/QArith.v @@ -0,0 +1,13 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: QArith.v 8883 2006-05-31 21:56:37Z letouzey $ i*) + +Require Export QArith_base. +Require Export Qring. +Require Export Qreduction. diff --git a/theories/QArith/QArith_base.v b/theories/QArith/QArith_base.v new file mode 100644 index 00000000..1d56b747 --- /dev/null +++ b/theories/QArith/QArith_base.v @@ -0,0 +1,621 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: QArith_base.v 8883 2006-05-31 21:56:37Z letouzey $ i*) + +Require Export ZArith. +Require Export ZArithRing. +Require Export Setoid. + +(** * Definition of [Q] and basic properties *) + +(** Rationals are pairs of [Z] and [positive] numbers. *) + +Record Q : Set := Qmake {Qnum : Z; Qden : positive}. + +Delimit Scope Q_scope with Q. +Bind Scope Q_scope with Q. +Arguments Scope Qmake [Z_scope positive_scope]. +Open Scope Q_scope. +Ltac simpl_mult := repeat rewrite Zpos_mult_morphism. + +(** [a#b] denotes the fraction [a] over [b]. *) + +Notation "a # b" := (Qmake a b) (at level 55, no associativity) : Q_scope. + +Definition inject_Z (x : Z) := Qmake x 1. +Arguments Scope inject_Z [Z_scope]. + +Notation " 'QDen' p " := (Zpos (Qden p)) (at level 20, no associativity) : Q_scope. +Notation " 0 " := (0#1) : Q_scope. +Notation " 1 " := (1#1) : Q_scope. + +Definition Qeq (p q : Q) := (Qnum p * QDen q)%Z = (Qnum q * QDen p)%Z. +Definition Qle (x y : Q) := (Qnum x * QDen y <= Qnum y * QDen x)%Z. +Definition Qlt (x y : Q) := (Qnum x * QDen y < Qnum y * QDen x)%Z. +Notation Qgt := (fun x y : Q => Qlt y x). +Notation Qge := (fun x y : Q => Qle y x). + +Infix "==" := Qeq (at level 70, no associativity) : Q_scope. +Infix "<" := Qlt : Q_scope. +Infix "<=" := Qle : Q_scope. +Infix ">" := Qgt : Q_scope. +Infix ">=" := Qge : Q_scope. +Notation "x <= y <= z" := (x<=y/\y<=z) : Q_scope. + +Hint Unfold Qeq Qle Qlt: qarith. +Hint Extern 5 (?X1 <> ?X2) => intro; discriminate: qarith. + +(** Properties of equality. *) + +Theorem Qeq_refl : forall x, x == x. +Proof. + auto with qarith. +Qed. + +Theorem Qeq_sym : forall x y, x == y -> y == x. +Proof. + auto with qarith. +Qed. + +Theorem Qeq_trans : forall x y z, x == y -> y == z -> x == z. +Proof. +unfold Qeq in |- *; intros. +apply Zmult_reg_l with (QDen y). +auto with qarith. +ring; rewrite H; ring. +rewrite Zmult_assoc; rewrite H0; ring. +Qed. + +(** Furthermore, this equality is decidable: *) + +Theorem Qeq_dec : forall x y, {x==y} + {~ x==y}. +Proof. + intros; case (Z_eq_dec (Qnum x * QDen y) (Qnum y * QDen x)); auto. +Defined. + +(** We now consider [Q] seen as a setoid. *) + +Definition Q_Setoid : Setoid_Theory Q Qeq. +Proof. + split; unfold Qeq in |- *; auto; apply Qeq_trans. +Qed. + +Add Setoid Q Qeq Q_Setoid as Qsetoid. + +Hint Resolve (Seq_refl Q Qeq Q_Setoid): qarith. +Hint Resolve (Seq_sym Q Qeq Q_Setoid): qarith. +Hint Resolve (Seq_trans Q Qeq Q_Setoid): qarith. + +(** The addition, multiplication and opposite are defined + in the straightforward way: *) + +Definition Qplus (x y : Q) := + (Qnum x * QDen y + Qnum y * QDen x) # (Qden x * Qden y). + +Definition Qmult (x y : Q) := (Qnum x * Qnum y) # (Qden x * Qden y). + +Definition Qopp (x : Q) := (- Qnum x) # (Qden x). + +Definition Qminus (x y : Q) := Qplus x (Qopp y). + +Definition Qinv (x : Q) := + match Qnum x with + | Z0 => 0 + | Zpos p => (QDen x)#p + | Zneg p => (Zneg (Qden x))#p + end. + +Definition Qdiv (x y : Q) := Qmult x (Qinv y). + +Infix "+" := Qplus : Q_scope. +Notation "- x" := (Qopp x) : Q_scope. +Infix "-" := Qminus : Q_scope. +Infix "*" := Qmult : Q_scope. +Notation "/ x" := (Qinv x) : Q_scope. +Infix "/" := Qdiv : Q_scope. + +(** A light notation for [Zpos] *) + +Notation " ' x " := (Zpos x) (at level 20, no associativity) : Z_scope. + +(** Setoid compatibility results *) + +Add Morphism Qplus : Qplus_comp. +Proof. +unfold Qeq, Qplus; simpl. +Open Scope Z_scope. +intros (p1, p2) (q1, q2) H (r1, r2) (s1, s2) H0; simpl in *. +simpl_mult; ring. +replace (p1 * ('s2 * 'q2)) with (p1 * 'q2 * 's2) by ring. +rewrite H. +replace ('s2 * ('q2 * r1)) with (r1 * 's2 * 'q2) by ring. +rewrite H0. +ring. +Open Scope Q_scope. +Qed. + +Add Morphism Qopp : Qopp_comp. +Proof. +unfold Qeq, Qopp; simpl. +intros; ring; rewrite H; ring. +Qed. + +Add Morphism Qminus : Qminus_comp. +Proof. +intros. +unfold Qminus. +rewrite H; rewrite H0; auto with qarith. +Qed. + +Add Morphism Qmult : Qmult_comp. +Proof. +unfold Qeq; simpl. +Open Scope Z_scope. +intros (p1, p2) (q1, q2) H (r1, r2) (s1, s2) H0; simpl in *. +intros; simpl_mult; ring. +replace ('p2 * (q1 * s1)) with (q1 * 'p2 * s1) by ring. +rewrite <- H. +replace ('s2 * ('q2 * r1)) with (r1 * 's2 * 'q2) by ring. +rewrite H0. +ring. +Open Scope Q_scope. +Qed. + +Add Morphism Qinv : Qinv_comp. +Proof. +unfold Qeq, Qinv; simpl. +Open Scope Z_scope. +intros (p1, p2) (q1, q2); simpl. +case p1; simpl. +intros. +assert (q1 = 0). + elim (Zmult_integral q1 ('p2)); auto with zarith. + intros; discriminate. +subst; auto. +case q1; simpl; intros; try discriminate. +rewrite (Pmult_comm p2 p); rewrite (Pmult_comm q2 p0); auto. +case q1; simpl; intros; try discriminate. +rewrite (Pmult_comm p2 p); rewrite (Pmult_comm q2 p0); auto. +Open Scope Q_scope. +Qed. + +Add Morphism Qdiv : Qdiv_comp. +Proof. +intros; unfold Qdiv. +rewrite H; rewrite H0; auto with qarith. +Qed. + +Add Morphism Qle with signature Qeq ==> Qeq ==> iff as Qle_comp. +Proof. +cut (forall x1 x2, x1==x2 -> forall x3 x4, x3==x4 -> x1<=x3 -> x2<=x4). +split; apply H; assumption || (apply Qeq_sym ; assumption). + +unfold Qeq, Qle; simpl. +Open Scope Z_scope. +intros (p1, p2) (q1, q2) H (r1, r2) (s1, s2) H0 H1; simpl in *. +apply Zmult_le_reg_r with ('p2). +unfold Zgt; auto. +replace (q1 * 's2 * 'p2) with (q1 * 'p2 * 's2) by ring. +rewrite <- H. +apply Zmult_le_reg_r with ('r2). +unfold Zgt; auto. +replace (s1 * 'q2 * 'p2 * 'r2) with (s1 * 'r2 * 'q2 * 'p2) by ring. +rewrite <- H0. +replace (p1 * 'q2 * 's2 * 'r2) with ('q2 * 's2 * (p1 * 'r2)) by ring. +replace (r1 * 's2 * 'q2 * 'p2) with ('q2 * 's2 * (r1 * 'p2)) by ring. +auto with zarith. +Open Scope Q_scope. +Qed. + +Add Morphism Qlt with signature Qeq ==> Qeq ==> iff as Qlt_comp. +Proof. +cut (forall x1 x2, x1==x2 -> forall x3 x4, x3==x4 -> x1<x3 -> x2<x4). +split; apply H; assumption || (apply Qeq_sym ; assumption). + +unfold Qeq, Qlt; simpl. +Open Scope Z_scope. +intros (p1, p2) (q1, q2) H (r1, r2) (s1, s2) H0 H1; simpl in *. +apply Zgt_lt. +generalize (Zlt_gt _ _ H1); clear H1; intro H1. +apply Zmult_gt_reg_r with ('p2); auto with zarith. +replace (q1 * 's2 * 'p2) with (q1 * 'p2 * 's2) by ring. +rewrite <- H. +apply Zmult_gt_reg_r with ('r2); auto with zarith. +replace (s1 * 'q2 * 'p2 * 'r2) with (s1 * 'r2 * 'q2 * 'p2) by ring. +rewrite <- H0. +replace (p1 * 'q2 * 's2 * 'r2) with ('q2 * 's2 * (p1 * 'r2)) by ring. +replace (r1 * 's2 * 'q2 * 'p2) with ('q2 * 's2 * (r1 * 'p2)) by ring. +apply Zlt_gt. +apply Zmult_gt_0_lt_compat_l; auto with zarith. +Open Scope Q_scope. +Qed. + +(** [0] and [1] are apart *) + +Lemma Q_apart_0_1 : ~ 1 == 0. +Proof. + unfold Qeq; auto with qarith. +Qed. + +(** Addition is associative: *) + +Theorem Qplus_assoc : forall x y z, x+(y+z)==(x+y)+z. +Proof. + intros (x1, x2) (y1, y2) (z1, z2). + unfold Qeq, Qplus; simpl; simpl_mult; ring. +Qed. + +(** [0] is a neutral element for addition: *) + +Lemma Qplus_0_l : forall x, 0+x == x. +Proof. + intros (x1, x2); unfold Qeq, Qplus; simpl; ring. +Qed. + +Lemma Qplus_0_r : forall x, x+0 == x. +Proof. + intros (x1, x2); unfold Qeq, Qplus; simpl. + rewrite Pmult_comm; simpl; ring. +Qed. + +(** Commutativity of addition: *) + +Theorem Qplus_comm : forall x y, x+y == y+x. +Proof. + intros (x1, x2); unfold Qeq, Qplus; simpl. + intros; rewrite Pmult_comm; ring. +Qed. + +(** Properties of [Qopp] *) + +Lemma Qopp_involutive : forall q, - -q == q. +Proof. + red; simpl; intros; ring. +Qed. + +Theorem Qplus_opp_r : forall q, q+(-q) == 0. +Proof. + red; simpl; intro; ring. +Qed. + +(** Multiplication is associative: *) + +Theorem Qmult_assoc : forall n m p, n*(m*p)==(n*m)*p. +Proof. + intros; red; simpl; rewrite Pmult_assoc; ring. +Qed. + +(** [1] is a neutral element for multiplication: *) + +Lemma Qmult_1_l : forall n, 1*n == n. +Proof. + intro; red; simpl; destruct (Qnum n); auto. +Qed. + +Theorem Qmult_1_r : forall n, n*1==n. +Proof. + intro; red; simpl. + rewrite Zmult_1_r with (n := Qnum n). + rewrite Pmult_comm; simpl; trivial. +Qed. + +(** Commutativity of multiplication *) + +Theorem Qmult_comm : forall x y, x*y==y*x. +Proof. + intros; red; simpl; rewrite Pmult_comm; ring. +Qed. + +(** Distributivity *) + +Theorem Qmult_plus_distr_r : forall x y z, x*(y+z)==(x*y)+(x*z). +Proof. +intros (x1, x2) (y1, y2) (z1, z2). +unfold Qeq, Qmult, Qplus; simpl; simpl_mult; ring. +Qed. + +Theorem Qmult_plus_distr_l : forall x y z, (x+y)*z==(x*z)+(y*z). +Proof. +intros (x1, x2) (y1, y2) (z1, z2). +unfold Qeq, Qmult, Qplus; simpl; simpl_mult; ring. +Qed. + +(** Integrality *) + +Theorem Qmult_integral : forall x y, x*y==0 -> x==0 \/ y==0. +Proof. + intros (x1,x2) (y1,y2). + unfold Qeq, Qmult; simpl; intros. + destruct (Zmult_integral (x1*1)%Z (y1*1)%Z); auto. + rewrite <- H; ring. +Qed. + +Theorem Qmult_integral_l : forall x y, ~ x == 0 -> x*y == 0 -> y == 0. +Proof. + intros (x1, x2) (y1, y2). + unfold Qeq, Qmult; simpl; intros. + apply Zmult_integral_l with x1; auto with zarith. + rewrite <- H0; ring. +Qed. + +(** Inverse and division. *) + +Theorem Qmult_inv_r : forall x, ~ x == 0 -> x*(/x) == 1. +Proof. + intros (x1, x2); unfold Qeq, Qdiv, Qmult; case x1; simpl; + intros; simpl_mult; try ring. + elim H; auto. +Qed. + +Lemma Qinv_mult_distr : forall p q, / (p * q) == /p * /q. +Proof. +intros (x1,x2) (y1,y2); unfold Qeq, Qinv, Qmult; simpl. +destruct x1; simpl; auto; + destruct y1; simpl; auto. +Qed. + +Theorem Qdiv_mult_l : forall x y, ~ y == 0 -> (x*y)/y == x. +Proof. + intros; unfold Qdiv. + rewrite <- (Qmult_assoc x y (Qinv y)). + rewrite (Qmult_inv_r y H). + apply Qmult_1_r. +Qed. + +Theorem Qmult_div_r : forall x y, ~ y == 0 -> y*(x/y) == x. +Proof. + intros; unfold Qdiv. + rewrite (Qmult_assoc y x (Qinv y)). + rewrite (Qmult_comm y x). + fold (Qdiv (Qmult x y) y). + apply Qdiv_mult_l; auto. +Qed. + +(** Properties of order upon Q. *) + +Lemma Qle_refl : forall x, x<=x. +Proof. +unfold Qle; auto with zarith. +Qed. + +Lemma Qle_antisym : forall x y, x<=y -> y<=x -> x==y. +Proof. +unfold Qle, Qeq; auto with zarith. +Qed. + +Lemma Qle_trans : forall x y z, x<=y -> y<=z -> x<=z. +Proof. +unfold Qle; intros (x1, x2) (y1, y2) (z1, z2); simpl; intros. +Open Scope Z_scope. +apply Zmult_le_reg_r with ('y2). +red; trivial. +apply Zle_trans with (y1 * 'x2 * 'z2). +replace (x1 * 'z2 * 'y2) with (x1 * 'y2 * 'z2) by ring. +apply Zmult_le_compat_r; auto with zarith. +replace (y1 * 'x2 * 'z2) with (y1 * 'z2 * 'x2) by ring. +replace (z1 * 'x2 * 'y2) with (z1 * 'y2 * 'x2) by ring. +apply Zmult_le_compat_r; auto with zarith. +Open Scope Q_scope. +Qed. + +Lemma Qlt_not_eq : forall x y, x<y -> ~ x==y. +Proof. +unfold Qlt, Qeq; auto with zarith. +Qed. + +(** Large = strict or equal *) + +Lemma Qlt_le_weak : forall x y, x<y -> x<=y. +Proof. +unfold Qle, Qlt; auto with zarith. +Qed. + +Lemma Qle_lt_trans : forall x y z, x<=y -> y<z -> x<z. +Proof. +unfold Qle, Qlt; intros (x1, x2) (y1, y2) (z1, z2); simpl; intros. +Open Scope Z_scope. +apply Zgt_lt. +apply Zmult_gt_reg_r with ('y2). +red; trivial. +apply Zgt_le_trans with (y1 * 'x2 * 'z2). +replace (y1 * 'x2 * 'z2) with (y1 * 'z2 * 'x2) by ring. +replace (z1 * 'x2 * 'y2) with (z1 * 'y2 * 'x2) by ring. +apply Zmult_gt_compat_r; auto with zarith. +replace (x1 * 'z2 * 'y2) with (x1 * 'y2 * 'z2) by ring. +apply Zmult_le_compat_r; auto with zarith. +Open Scope Q_scope. +Qed. + +Lemma Qlt_le_trans : forall x y z, x<y -> y<=z -> x<z. +Proof. +unfold Qle, Qlt; intros (x1, x2) (y1, y2) (z1, z2); simpl; intros. +Open Scope Z_scope. +apply Zgt_lt. +apply Zmult_gt_reg_r with ('y2). +red; trivial. +apply Zle_gt_trans with (y1 * 'x2 * 'z2). +replace (y1 * 'x2 * 'z2) with (y1 * 'z2 * 'x2) by ring. +replace (z1 * 'x2 * 'y2) with (z1 * 'y2 * 'x2) by ring. +apply Zmult_le_compat_r; auto with zarith. +replace (x1 * 'z2 * 'y2) with (x1 * 'y2 * 'z2) by ring. +apply Zmult_gt_compat_r; auto with zarith. +Open Scope Q_scope. +Qed. + +Lemma Qlt_trans : forall x y z, x<y -> y<z -> x<z. +Proof. +intros. +apply Qle_lt_trans with y; auto. +apply Qlt_le_weak; auto. +Qed. + +(** [x<y] iff [~(y<=x)] *) + +Lemma Qnot_lt_le : forall x y, ~ x<y -> y<=x. +Proof. +unfold Qle, Qlt; auto with zarith. +Qed. + +Lemma Qnot_le_lt : forall x y, ~ x<=y -> y<x. +Proof. +unfold Qle, Qlt; auto with zarith. +Qed. + +Lemma Qlt_not_le : forall x y, x<y -> ~ y<=x. +Proof. +unfold Qle, Qlt; auto with zarith. +Qed. + +Lemma Qle_not_lt : forall x y, x<=y -> ~ y<x. +Proof. +unfold Qle, Qlt; auto with zarith. +Qed. + +Lemma Qle_lt_or_eq : forall x y, x<=y -> x<y \/ x==y. +Proof. +unfold Qle, Qlt, Qeq; intros; apply Zle_lt_or_eq; auto. +Qed. + +(** Some decidability results about orders. *) + +Lemma Q_dec : forall x y, {x<y} + {y<x} + {x==y}. +Proof. +unfold Qlt, Qle, Qeq; intros. +exact (Z_dec' (Qnum x * QDen y) (Qnum y * QDen x)). +Defined. + +Lemma Qlt_le_dec : forall x y, {x<y} + {y<=x}. +Proof. +unfold Qlt, Qle; intros. +exact (Z_lt_le_dec (Qnum x * QDen y) (Qnum y * QDen x)). +Defined. + +(** Compatibility of operations with respect to order. *) + +Lemma Qopp_le_compat : forall p q, p<=q -> -q <= -p. +Proof. +intros (a1,a2) (b1,b2); unfold Qle, Qlt; simpl. +do 2 rewrite <- Zopp_mult_distr_l; omega. +Qed. + +Lemma Qle_minus_iff : forall p q, p <= q <-> 0 <= q+-p. +Proof. +intros (x1,x2) (y1,y2); unfold Qle; simpl. +rewrite <- Zopp_mult_distr_l. +split; omega. +Qed. + +Lemma Qlt_minus_iff : forall p q, p < q <-> 0 < q+-p. +Proof. +intros (x1,x2) (y1,y2); unfold Qlt; simpl. +rewrite <- Zopp_mult_distr_l. +split; omega. +Qed. + +Lemma Qplus_le_compat : + forall x y z t, x<=y -> z<=t -> x+z <= y+t. +Proof. +unfold Qplus, Qle; intros (x1, x2) (y1, y2) (z1, z2) (t1, t2); + simpl; simpl_mult. +Open Scope Z_scope. +intros. +match goal with |- ?a <= ?b => ring a; ring b end. +apply Zplus_le_compat. +replace ('t2 * ('y2 * (z1 * 'x2))) with (z1 * 't2 * ('y2 * 'x2)) by ring. +replace ('z2 * ('x2 * (t1 * 'y2))) with (t1 * 'z2 * ('y2 * 'x2)) by ring. +apply Zmult_le_compat_r; auto with zarith. +replace ('t2 * ('y2 * ('z2 * x1))) with (x1 * 'y2 * ('z2 * 't2)) by ring. +replace ('z2 * ('x2 * ('t2 * y1))) with (y1 * 'x2 * ('z2 * 't2)) by ring. +apply Zmult_le_compat_r; auto with zarith. +Open Scope Q_scope. +Qed. + +Lemma Qmult_le_compat_r : forall x y z, x <= y -> 0 <= z -> x*z <= y*z. +Proof. +intros (a1,a2) (b1,b2) (c1,c2); unfold Qle, Qlt; simpl. +Open Scope Z_scope. +intros; simpl_mult. +replace (a1*c1*('b2*'c2)) with ((a1*'b2)*(c1*'c2)) by ring. +replace (b1*c1*('a2*'c2)) with ((b1*'a2)*(c1*'c2)) by ring. +apply Zmult_le_compat_r; auto with zarith. +Open Scope Q_scope. +Qed. + +Lemma Qmult_lt_0_le_reg_r : forall x y z, 0 < z -> x*z <= y*z -> x <= y. +Proof. +intros (a1,a2) (b1,b2) (c1,c2); unfold Qle, Qlt; simpl. +Open Scope Z_scope. +simpl_mult. +replace (a1*c1*('b2*'c2)) with ((a1*'b2)*(c1*'c2)) by ring. +replace (b1*c1*('a2*'c2)) with ((b1*'a2)*(c1*'c2)) by ring. +intros; apply Zmult_le_reg_r with (c1*'c2); auto with zarith. +Open Scope Q_scope. +Qed. + +Lemma Qmult_lt_compat_r : forall x y z, 0 < z -> x < y -> x*z < y*z. +Proof. +intros (a1,a2) (b1,b2) (c1,c2); unfold Qle, Qlt; simpl. +Open Scope Z_scope. +intros; simpl_mult. +replace (a1*c1*('b2*'c2)) with ((a1*'b2)*(c1*'c2)) by ring. +replace (b1*c1*('a2*'c2)) with ((b1*'a2)*(c1*'c2)) by ring. +apply Zmult_lt_compat_r; auto with zarith. +apply Zmult_lt_0_compat. +omega. +compute; auto. +Open Scope Q_scope. +Qed. + +(** Rational to the n-th power *) + +Fixpoint Qpower (q:Q)(n:nat) { struct n } : Q := + match n with + | O => 1 + | S n => q * (Qpower q n) + end. + +Notation " q ^ n " := (Qpower q n) : Q_scope. + +Lemma Qpower_1 : forall n, 1^n == 1. +Proof. +induction n; simpl; auto with qarith. +rewrite IHn; auto with qarith. +Qed. + +Lemma Qpower_0 : forall n, n<>O -> 0^n == 0. +Proof. +destruct n; simpl. +destruct 1; auto. +intros. +compute; auto. +Qed. + +Lemma Qpower_pos : forall p n, 0 <= p -> 0 <= p^n. +Proof. +induction n; simpl; auto with qarith. +intros; compute; intro; discriminate. +intros. +apply Qle_trans with (0*(p^n)). +compute; intro; discriminate. +apply Qmult_le_compat_r; auto. +Qed. + +Lemma Qinv_power_n : forall n p, (1#p)^n == /(inject_Z ('p))^n. +Proof. +induction n. +compute; auto. +simpl. +intros; rewrite IHn; clear IHn. +unfold Qdiv; rewrite Qinv_mult_distr. +setoid_replace (1#p) with (/ inject_Z ('p)). +apply Qeq_refl. +compute; auto. +Qed. + + diff --git a/theories/QArith/Qreals.v b/theories/QArith/Qreals.v new file mode 100644 index 00000000..5b7480c1 --- /dev/null +++ b/theories/QArith/Qreals.v @@ -0,0 +1,213 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: Qreals.v 8883 2006-05-31 21:56:37Z letouzey $ i*) + +Require Export Rbase. +Require Export QArith_base. + +(** * A field tactic for rational numbers. *) + +(** Since field cannot operate on setoid datatypes (yet?), + we translate Q goals into reals before applying field. *) + +Lemma IZR_nz : forall p : positive, IZR (Zpos p) <> 0%R. +intros; apply not_O_IZR; auto with qarith. +Qed. + +Hint Immediate IZR_nz. +Hint Resolve Rmult_integral_contrapositive. + +Definition Q2R (x : Q) : R := (IZR (Qnum x) * / IZR (QDen x))%R. + +Lemma eqR_Qeq : forall x y : Q, Q2R x = Q2R y -> x==y. +Proof. +unfold Qeq, Q2R in |- *; intros (x1, x2) (y1, y2); unfold Qnum, Qden in |- *; + intros. +apply eq_IZR. +do 2 rewrite mult_IZR. +set (X1 := IZR x1) in *; assert (X2nz := IZR_nz x2); + set (X2 := IZR (Zpos x2)) in *. +set (Y1 := IZR y1) in *; assert (Y2nz := IZR_nz y2); + set (Y2 := IZR (Zpos y2)) in *. +assert ((X2 * X1 * / X2)%R = (X2 * (Y1 * / Y2))%R). +rewrite <- H; field; auto. +rewrite Rinv_r_simpl_m in H0; auto; rewrite H0; field; auto. +Qed. + +Lemma Qeq_eqR : forall x y : Q, x==y -> Q2R x = Q2R y. +Proof. +unfold Qeq, Q2R in |- *; intros (x1, x2) (y1, y2); unfold Qnum, Qden in |- *; + intros. +set (X1 := IZR x1) in *; assert (X2nz := IZR_nz x2); + set (X2 := IZR (Zpos x2)) in *. +set (Y1 := IZR y1) in *; assert (Y2nz := IZR_nz y2); + set (Y2 := IZR (Zpos y2)) in *. +assert ((X1 * Y2)%R = (Y1 * X2)%R). + unfold X1, X2, Y1, Y2 in |- *; do 2 rewrite <- mult_IZR. + apply IZR_eq; auto. +clear H. +field; auto. +rewrite <- H0; field; auto. +Qed. + +Lemma Rle_Qle : forall x y : Q, (Q2R x <= Q2R y)%R -> x<=y. +Proof. +unfold Qle, Q2R in |- *; intros (x1, x2) (y1, y2); unfold Qnum, Qden in |- *; + intros. +apply le_IZR. +do 2 rewrite mult_IZR. +set (X1 := IZR x1) in *; assert (X2nz := IZR_nz x2); + set (X2 := IZR (Zpos x2)) in *. +set (Y1 := IZR y1) in *; assert (Y2nz := IZR_nz y2); + set (Y2 := IZR (Zpos y2)) in *. +replace (X1 * Y2)%R with (X1 * / X2 * (X2 * Y2))%R; try (field; auto). +replace (Y1 * X2)%R with (Y1 * / Y2 * (X2 * Y2))%R; try (field; auto). +apply Rmult_le_compat_r; auto. +apply Rmult_le_pos. +unfold X2 in |- *; replace 0%R with (IZR 0); auto; apply IZR_le; + auto with zarith. +unfold Y2 in |- *; replace 0%R with (IZR 0); auto; apply IZR_le; + auto with zarith. +Qed. + +Lemma Qle_Rle : forall x y : Q, x<=y -> (Q2R x <= Q2R y)%R. +Proof. +unfold Qle, Q2R in |- *; intros (x1, x2) (y1, y2); unfold Qnum, Qden in |- *; + intros. +set (X1 := IZR x1) in *; assert (X2nz := IZR_nz x2); + set (X2 := IZR (Zpos x2)) in *. +set (Y1 := IZR y1) in *; assert (Y2nz := IZR_nz y2); + set (Y2 := IZR (Zpos y2)) in *. +assert (X1 * Y2 <= Y1 * X2)%R. + unfold X1, X2, Y1, Y2 in |- *; do 2 rewrite <- mult_IZR. + apply IZR_le; auto. +clear H. +replace (X1 * / X2)%R with (X1 * Y2 * (/ X2 * / Y2))%R; try (field; auto). +replace (Y1 * / Y2)%R with (Y1 * X2 * (/ X2 * / Y2))%R; try (field; auto). +apply Rmult_le_compat_r; auto. +apply Rmult_le_pos; apply Rlt_le; apply Rinv_0_lt_compat. +unfold X2 in |- *; replace 0%R with (IZR 0); auto; apply IZR_lt; red in |- *; + auto with zarith. +unfold Y2 in |- *; replace 0%R with (IZR 0); auto; apply IZR_lt; red in |- *; + auto with zarith. +Qed. + +Lemma Rlt_Qlt : forall x y : Q, (Q2R x < Q2R y)%R -> x<y. +Proof. +unfold Qlt, Q2R in |- *; intros (x1, x2) (y1, y2); unfold Qnum, Qden in |- *; + intros. +apply lt_IZR. +do 2 rewrite mult_IZR. +set (X1 := IZR x1) in *; assert (X2nz := IZR_nz x2); + set (X2 := IZR (Zpos x2)) in *. +set (Y1 := IZR y1) in *; assert (Y2nz := IZR_nz y2); + set (Y2 := IZR (Zpos y2)) in *. +replace (X1 * Y2)%R with (X1 * / X2 * (X2 * Y2))%R; try (field; auto). +replace (Y1 * X2)%R with (Y1 * / Y2 * (X2 * Y2))%R; try (field; auto). +apply Rmult_lt_compat_r; auto. +apply Rmult_lt_0_compat. +unfold X2 in |- *; replace 0%R with (IZR 0); auto; apply IZR_lt; red in |- *; + auto with zarith. +unfold Y2 in |- *; replace 0%R with (IZR 0); auto; apply IZR_lt; red in |- *; + auto with zarith. +Qed. + +Lemma Qlt_Rlt : forall x y : Q, x<y -> (Q2R x < Q2R y)%R. +Proof. +unfold Qlt, Q2R in |- *; intros (x1, x2) (y1, y2); unfold Qnum, Qden in |- *; + intros. +set (X1 := IZR x1) in *; assert (X2nz := IZR_nz x2); + set (X2 := IZR (Zpos x2)) in *. +set (Y1 := IZR y1) in *; assert (Y2nz := IZR_nz y2); + set (Y2 := IZR (Zpos y2)) in *. +assert (X1 * Y2 < Y1 * X2)%R. + unfold X1, X2, Y1, Y2 in |- *; do 2 rewrite <- mult_IZR. + apply IZR_lt; auto. +clear H. +replace (X1 * / X2)%R with (X1 * Y2 * (/ X2 * / Y2))%R; try (field; auto). +replace (Y1 * / Y2)%R with (Y1 * X2 * (/ X2 * / Y2))%R; try (field; auto). +apply Rmult_lt_compat_r; auto. +apply Rmult_lt_0_compat; apply Rinv_0_lt_compat. +unfold X2 in |- *; replace 0%R with (IZR 0); auto; apply IZR_lt; red in |- *; + auto with zarith. +unfold Y2 in |- *; replace 0%R with (IZR 0); auto; apply IZR_lt; red in |- *; + auto with zarith. +Qed. + +Lemma Q2R_plus : forall x y : Q, Q2R (x+y) = (Q2R x + Q2R y)%R. +Proof. +unfold Qplus, Qeq, Q2R in |- *; intros (x1, x2) (y1, y2); + unfold Qden, Qnum in |- *. +simpl_mult. +rewrite plus_IZR. +do 3 rewrite mult_IZR. +field; auto. +Qed. + +Lemma Q2R_mult : forall x y : Q, Q2R (x*y) = (Q2R x * Q2R y)%R. +Proof. +unfold Qmult, Qeq, Q2R in |- *; intros (x1, x2) (y1, y2); + unfold Qden, Qnum in |- *. +simpl_mult. +do 2 rewrite mult_IZR. +field; auto. +Qed. + +Lemma Q2R_opp : forall x : Q, Q2R (- x) = (- Q2R x)%R. +Proof. +unfold Qopp, Qeq, Q2R in |- *; intros (x1, x2); unfold Qden, Qnum in |- *. +rewrite Ropp_Ropp_IZR. +field; auto. +Qed. + +Lemma Q2R_minus : forall x y : Q, Q2R (x-y) = (Q2R x - Q2R y)%R. +unfold Qminus in |- *; intros; rewrite Q2R_plus; rewrite Q2R_opp; auto. +Qed. + +Lemma Q2R_inv : forall x : Q, ~ x==0#1 -> Q2R (/x) = (/ Q2R x)%R. +Proof. +unfold Qinv, Q2R, Qeq in |- *; intros (x1, x2); unfold Qden, Qnum in |- *. +case x1. +simpl in |- *; intros; elim H; trivial. +intros; field; auto. +apply Rmult_integral_contrapositive; split; auto. +apply Rmult_integral_contrapositive; split; auto. +apply Rinv_neq_0_compat; auto. +intros; field; auto. +do 2 rewrite <- mult_IZR. +simpl in |- *; rewrite Pmult_comm; auto. +apply Rmult_integral_contrapositive; split; auto. +apply Rmult_integral_contrapositive; split; auto. +apply not_O_IZR; auto with qarith. +apply Rinv_neq_0_compat; auto. +Qed. + +Lemma Q2R_div : + forall x y : Q, ~ y==0#1 -> Q2R (x/y) = (Q2R x / Q2R y)%R. +Proof. +unfold Qdiv, Rdiv in |- *. +intros; rewrite Q2R_mult. +rewrite Q2R_inv; auto. +Qed. + +Hint Rewrite Q2R_plus Q2R_mult Q2R_opp Q2R_minus Q2R_inv Q2R_div : q2r_simpl. + +Ltac QField := apply eqR_Qeq; autorewrite with q2r_simpl; try field; auto. + +(** Examples of use: *) + +Goal forall x y z : Q, (x+y)*z == (x*z)+(y*z). +intros; QField. +Abort. + +Goal forall x y : Q, ~ y==0#1 -> (x/y)*y == x. +intros; QField. +intro; apply H; apply eqR_Qeq. +rewrite H0; unfold Q2R in |- *; simpl in |- *; field; auto with real. +Abort.
\ No newline at end of file diff --git a/theories/QArith/Qreduction.v b/theories/QArith/Qreduction.v new file mode 100644 index 00000000..049c195a --- /dev/null +++ b/theories/QArith/Qreduction.v @@ -0,0 +1,265 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: Qreduction.v 8883 2006-05-31 21:56:37Z letouzey $ i*) + +(** * Normalisation functions for rational numbers. *) + +Require Export QArith_base. +Require Export Znumtheory. + +(** First, a function that (tries to) build a positive back from a Z. *) + +Definition Z2P (z : Z) := + match z with + | Z0 => 1%positive + | Zpos p => p + | Zneg p => p + end. + +Lemma Z2P_correct : forall z : Z, (0 < z)%Z -> Zpos (Z2P z) = z. +Proof. + simple destruct z; simpl in |- *; auto; intros; discriminate. +Qed. + +Lemma Z2P_correct2 : forall z : Z, 0%Z <> z -> Zpos (Z2P z) = Zabs z. +Proof. + simple destruct z; simpl in |- *; auto; intros; elim H; auto. +Qed. + +(** A simple cancelation by powers of two *) + +Fixpoint Pfactor_twos (p p':positive) {struct p} : (positive*positive) := + match p, p' with + | xO p, xO p' => Pfactor_twos p p' + | _, _ => (p,p') + end. + +Definition Qfactor_twos (q:Q) := + let (p,q) := q in + match p with + | Z0 => 0 + | Zpos p => let (p,q) := Pfactor_twos p q in (Zpos p)#q + | Zneg p => let (p,q) := Pfactor_twos p q in (Zneg p)#q + end. + +Lemma Pfactor_twos_correct : forall p p', + (p*(snd (Pfactor_twos p p')))%positive = + (p'*(fst (Pfactor_twos p p')))%positive. +Proof. +induction p; intros. +simpl snd; simpl fst; rewrite Pmult_comm; auto. +destruct p'. +simpl snd; simpl fst; rewrite Pmult_comm; auto. +simpl; f_equal; auto. +simpl snd; simpl fst; rewrite Pmult_comm; auto. +simpl snd; simpl fst; rewrite Pmult_comm; auto. +Qed. + +Lemma Qfactor_twos_correct : forall q, Qfactor_twos q == q. +Proof. +intros (p,q). +destruct p. +red; simpl; auto. +simpl. +generalize (Pfactor_twos_correct p q); destruct (Pfactor_twos p q). +red; simpl. +intros; f_equal. +rewrite H; apply Pmult_comm. +simpl. +generalize (Pfactor_twos_correct p q); destruct (Pfactor_twos p q). +red; simpl. +intros; f_equal. +rewrite H; apply Pmult_comm. +Qed. +Hint Resolve Qfactor_twos_correct. + +(** Simplification of fractions using [Zgcd]. + This version can compute within Coq. *) + +Definition Qred (q:Q) := + let (q1,q2) := Qfactor_twos q in + let (r1,r2) := snd (Zggcd q1 (Zpos q2)) in r1#(Z2P r2). + +Lemma Qred_correct : forall q, (Qred q) == q. +Proof. +intros; apply Qeq_trans with (Qfactor_twos q); auto. +unfold Qred. +destruct (Qfactor_twos q) as (n,d); red; simpl. +generalize (Zggcd_gcd n ('d)) (Zgcd_is_pos n ('d)) + (Zgcd_is_gcd n ('d)) (Zggcd_correct_divisors n ('d)). +destruct (Zggcd n (Zpos d)) as (g,(nn,dd)); simpl. +Open Scope Z_scope. +intuition. +rewrite <- H in H0,H1; clear H. +rewrite H3; rewrite H4. +assert (0 <> g). + intro; subst g; discriminate. + +assert (0 < dd). + apply Zmult_gt_0_lt_0_reg_r with g. + omega. + rewrite Zmult_comm. + rewrite <- H4; compute; auto. +rewrite Z2P_correct; auto. +ring. +Qed. + +Lemma Qred_complete : forall p q, p==q -> Qred p = Qred q. +Proof. +intros. +assert (Qfactor_twos p == Qfactor_twos q). + apply Qeq_trans with p; auto. + apply Qeq_trans with q; auto. + symmetry; auto. +clear H. +unfold Qred. +destruct (Qfactor_twos p) as (a,b); +destruct (Qfactor_twos q) as (c,d); clear p q. +unfold Qeq in *; simpl in *. +Open Scope Z_scope. +generalize (Zggcd_gcd a ('b)) (Zgcd_is_gcd a ('b)) + (Zgcd_is_pos a ('b)) (Zggcd_correct_divisors a ('b)). +destruct (Zggcd a (Zpos b)) as (g,(aa,bb)). +generalize (Zggcd_gcd c ('d)) (Zgcd_is_gcd c ('d)) + (Zgcd_is_pos c ('d)) (Zggcd_correct_divisors c ('d)). +destruct (Zggcd c (Zpos d)) as (g',(cc,dd)). +simpl. +intro H; rewrite <- H; clear H. +intros Hg'1 Hg'2 (Hg'3,Hg'4). +intro H; rewrite <- H; clear H. +intros Hg1 Hg2 (Hg3,Hg4). +intros. +assert (g <> 0). + intro; subst g; discriminate. +assert (g' <> 0). + intro; subst g'; discriminate. +elim (rel_prime_cross_prod aa bb cc dd). +congruence. +unfold rel_prime in |- *. +(*rel_prime*) +constructor. +exists aa; auto with zarith. +exists bb; auto with zarith. +intros. +inversion Hg1. +destruct (H6 (g*x)). +rewrite Hg3. +destruct H2 as (xa,Hxa); exists xa; rewrite Hxa; ring. +rewrite Hg4. +destruct H3 as (xb,Hxb); exists xb; rewrite Hxb; ring. +exists q. +apply Zmult_reg_l with g; auto. +pattern g at 1; rewrite H7; ring. +(* /rel_prime *) +unfold rel_prime in |- *. +(* rel_prime *) +constructor. +exists cc; auto with zarith. +exists dd; auto with zarith. +intros. +inversion Hg'1. +destruct (H6 (g'*x)). +rewrite Hg'3. +destruct H2 as (xc,Hxc); exists xc; rewrite Hxc; ring. +rewrite Hg'4. +destruct H3 as (xd,Hxd); exists xd; rewrite Hxd; ring. +exists q. +apply Zmult_reg_l with g'; auto. +pattern g' at 1; rewrite H7; ring. +(* /rel_prime *) +assert (0<bb); [|auto with zarith]. + apply Zmult_gt_0_lt_0_reg_r with g. + omega. + rewrite Zmult_comm. + rewrite <- Hg4; compute; auto. +assert (0<dd); [|auto with zarith]. + apply Zmult_gt_0_lt_0_reg_r with g'. + omega. + rewrite Zmult_comm. + rewrite <- Hg'4; compute; auto. +apply Zmult_reg_l with (g'*g). +intro H2; elim (Zmult_integral _ _ H2); auto. +replace (g'*g*(aa*dd)) with ((g*aa)*(g'*dd)); [|ring]. +replace (g'*g*(bb*cc)) with ((g'*cc)*(g*bb)); [|ring]. +rewrite <- Hg3; rewrite <- Hg4; rewrite <- Hg'3; rewrite <- Hg'4; auto. +Open Scope Q_scope. +Qed. + +Add Morphism Qred : Qred_comp. +Proof. +intros q q' H. +rewrite (Qred_correct q); auto. +rewrite (Qred_correct q'); auto. +Qed. + +(** Another version, dedicated to extraction *) + +Definition Qred_extr (q : Q) := + let (q1, q2) := Qfactor_twos q in + let (p,_) := Zggcd_spec_pos (Zpos q2) (Zle_0_pos q2) q1 in + let (r2,r1) := snd p in r1#(Z2P r2). + +Lemma Qred_extr_Qred : forall q, Qred_extr q = Qred q. +Proof. +unfold Qred, Qred_extr. +intro q; destruct (Qfactor_twos q) as (n,p); clear q. +Open Scope Z_scope. +destruct (Zggcd_spec_pos (' p) (Zle_0_pos p) n) as ((g,(pp,nn)),H). +generalize (H (Zle_0_pos p)); clear H; intros (Hg1,(Hg2,(Hg4,Hg3))). +simpl. +generalize (Zggcd_gcd n ('p)) (Zgcd_is_gcd n ('p)) + (Zgcd_is_pos n ('p)) (Zggcd_correct_divisors n ('p)). +destruct (Zggcd n (Zpos p)) as (g',(nn',pp')); simpl. +intro H; rewrite <- H; clear H. +intros Hg'1 Hg'2 (Hg'3,Hg'4). +assert (g<>0). + intro; subst g; discriminate. +destruct (Zis_gcd_uniqueness_apart_sign n ('p) g g'); auto. +apply Zis_gcd_sym; auto. +subst g'. +f_equal. +apply Zmult_reg_l with g; auto; congruence. +f_equal. +apply Zmult_reg_l with g; auto; congruence. +elimtype False; omega. +Open Scope Q_scope. +Qed. + +Add Morphism Qred_extr : Qred_extr_comp. +Proof. +intros q q' H. +do 2 rewrite Qred_extr_Qred. +rewrite (Qred_correct q); auto. +rewrite (Qred_correct q'); auto. +Qed. + +Definition Qplus' (p q : Q) := Qred (Qplus p q). +Definition Qmult' (p q : Q) := Qred (Qmult p q). + +Lemma Qplus'_correct : forall p q : Q, (Qplus' p q)==(Qplus p q). +Proof. +intros; unfold Qplus' in |- *; apply Qred_correct; auto. +Qed. + +Lemma Qmult'_correct : forall p q : Q, (Qmult' p q)==(Qmult p q). +Proof. +intros; unfold Qmult' in |- *; apply Qred_correct; auto. +Qed. + +Add Morphism Qplus' : Qplus'_comp. +Proof. +intros; unfold Qplus' in |- *. +rewrite H; rewrite H0; auto with qarith. +Qed. + +Add Morphism Qmult' : Qmult'_comp. +intros; unfold Qmult' in |- *. +rewrite H; rewrite H0; auto with qarith. +Qed. + diff --git a/theories/QArith/Qring.v b/theories/QArith/Qring.v new file mode 100644 index 00000000..774b20f4 --- /dev/null +++ b/theories/QArith/Qring.v @@ -0,0 +1,91 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: Qring.v 8883 2006-05-31 21:56:37Z letouzey $ i*) + +Require Import Ring. +Require Export Setoid_ring. +Require Export QArith_base. + +(** * A ring tactic for rational numbers *) + +Definition Qeq_bool (x y : Q) := + if Qeq_dec x y then true else false. + +Lemma Qeq_bool_correct : forall x y : Q, Qeq_bool x y = true -> x==y. +intros x y; unfold Qeq_bool in |- *; case (Qeq_dec x y); simpl in |- *; auto. +intros _ H; inversion H. +Qed. + +Definition Qsrt : Setoid_Ring_Theory Qeq Qplus Qmult 1 0 Qopp Qeq_bool. +Proof. +constructor. +exact Qplus_comm. +exact Qplus_assoc. +exact Qmult_comm. +exact Qmult_assoc. +exact Qplus_0_l. +exact Qmult_1_l. +exact Qplus_opp_r. +exact Qmult_plus_distr_l. +unfold Is_true; intros x y; generalize (Qeq_bool_correct x y); + case (Qeq_bool x y); auto. +Qed. + +Add Setoid Ring Q Qeq Q_Setoid Qplus Qmult 1 0 Qopp Qeq_bool + Qplus_comp Qmult_comp Qopp_comp Qsrt + [ Qmake (*inject_Z*) Zpos 0%Z Zneg xI xO 1%positive ]. + +(** Exemple of use: *) + +Section Examples. + +Let ex1 : forall x y z : Q, (x+y)*z == (x*z)+(y*z). +intros. +ring. +Qed. + +Let ex2 : forall x y : Q, x+y == y+x. +intros. +ring. +Qed. + +Let ex3 : forall x y z : Q, (x+y)+z == x+(y+z). +intros. +ring. +Qed. + +Let ex4 : (inject_Z 1)+(inject_Z 1)==(inject_Z 2). +ring. +Qed. + +Let ex5 : 1+1 == 2#1. +ring. +Qed. + +Let ex6 : (1#1)+(1#1) == 2#1. +ring. +Qed. + +Let ex7 : forall x : Q, x-x== 0#1. +intro. +ring. +Qed. + +End Examples. + +Lemma Qopp_plus : forall a b, -(a+b) == -a + -b. +Proof. +intros; ring. +Qed. + +Lemma Qopp_opp : forall q, - -q==q. +Proof. +intros; ring. +Qed. + diff --git a/theories/Reals/Rbasic_fun.v b/theories/Reals/Rbasic_fun.v index 436a8011..0d1b06e2 100644 --- a/theories/Reals/Rbasic_fun.v +++ b/theories/Reals/Rbasic_fun.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Rbasic_fun.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: Rbasic_fun.v 8838 2006-05-22 09:26:36Z herbelin $ i*) (*********************************************************) (** Complements for the real numbers *) @@ -107,11 +107,13 @@ Lemma RmaxLess2 : forall r1 r2, r2 <= Rmax r1 r2. intros r1 r2; unfold Rmax in |- *; case (Rle_dec r1 r2); auto with real. Qed. -Lemma RmaxSym : forall p q:R, Rmax p q = Rmax q p. +Lemma Rmax_comm : forall p q:R, Rmax p q = Rmax q p. intros p q; unfold Rmax in |- *; case (Rle_dec p q); case (Rle_dec q p); auto; intros H1 H2; apply Rle_antisym; auto with real. Qed. +Notation RmaxSym := Rmax_comm (only parsing). + Lemma RmaxRmult : forall (p q:R) r, 0 <= r -> Rmax (r * p) (r * q) = r * Rmax p q. intros p q r H; unfold Rmax in |- *. @@ -467,4 +469,4 @@ intros p0; apply Rabs_right; auto with real zarith. intros p0; rewrite Rabs_Ropp. apply Rabs_right; auto with real zarith. Qed. -
\ No newline at end of file + diff --git a/theories/Reals/RiemannInt_SF.v b/theories/Reals/RiemannInt_SF.v index 71ab0b4c..b628de73 100644 --- a/theories/Reals/RiemannInt_SF.v +++ b/theories/Reals/RiemannInt_SF.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: RiemannInt_SF.v 6338 2004-11-22 09:10:51Z gregoire $ i*) +(*i $Id: RiemannInt_SF.v 8837 2006-05-22 08:41:18Z herbelin $ i*) Require Import Rbase. Require Import Rfunctions. @@ -218,17 +218,10 @@ Qed. Lemma StepFun_P5 : forall (a b:R) (f:R -> R) (l:Rlist), is_subdivision f a b l -> is_subdivision f b a l. -unfold is_subdivision in |- *; intros; elim X; intros; exists x; - unfold adapted_couple in p; decompose [and] p; clear p; - unfold adapted_couple in |- *; repeat split; try assumption. -rewrite H1; unfold Rmin in |- *; case (Rle_dec a b); intro; - case (Rle_dec b a); intro; try reflexivity. -apply Rle_antisym; assumption. -apply Rle_antisym; auto with real. -rewrite H0; unfold Rmax in |- *; case (Rle_dec a b); intro; - case (Rle_dec b a); intro; try reflexivity. -apply Rle_antisym; assumption. -apply Rle_antisym; auto with real. +destruct 1 as (x,(H0,(H1,(H2,(H3,H4))))); exists x; + repeat split; try assumption. +rewrite H1; apply Rmin_comm. +rewrite H2; apply Rmax_comm. Qed. Lemma StepFun_P6 : @@ -1483,19 +1476,16 @@ Lemma StepFun_P26 : is_subdivision f a b l1 -> is_subdivision g a b l1 -> is_subdivision (fun x:R => f x + l * g x) a b l1. -intros a b l f g l1; unfold is_subdivision in |- *; intros; elim X; elim X0; - intros; clear X X0; unfold adapted_couple in p, p0; - decompose [and] p; decompose [and] p0; clear p p0; - apply existT with (FF l1 (fun x:R => f x + l * g x)); - unfold adapted_couple in |- *; repeat split; try assumption. -apply StepFun_P20; apply neq_O_lt; red in |- *; intro; rewrite <- H8 in H7; - discriminate. -intros; unfold constant_D_eq, open_interval in |- *; - unfold constant_D_eq, open_interval in H9, H4; intros; +Proof. +intros a b l f g l1 (x0,(H0,(H1,(H2,(H3,H4))))) + (x,(_,(_,(_,(_,H9))))). + exists (FF l1 (fun x:R => f x + l * g x)); repeat split; try assumption. +apply StepFun_P20; rewrite H3; auto with arith. +intros i H8 x1 H10; unfold open_interval in H10, H9, H4; rewrite (H9 _ H8 _ H10); rewrite (H4 _ H8 _ H10); assert (H11 : l1 <> nil). -red in |- *; intro; rewrite H11 in H8; elim (lt_n_O _ H8). -assert (H12 := RList_P19 _ H11); elim H12; clear H12; intros r [r0 H12]; +red in |- *; intro H11; rewrite H11 in H8; elim (lt_n_O _ H8). +destruct (RList_P19 _ H11) as (r,(r0,H12)); rewrite H12; unfold FF in |- *; change (pos_Rl x0 i + l * pos_Rl x i = @@ -2142,18 +2132,16 @@ Qed. Lemma StepFun_P41 : forall (f:R -> R) (a b c:R), a <= b -> b <= c -> IsStepFun f a b -> IsStepFun f b c -> IsStepFun f a c. -unfold IsStepFun in |- *; unfold is_subdivision in |- *; intros; elim X; - clear X; intros l1 [lf1 H1]; elim X0; clear X0; intros l2 [lf2 H2]; - case (total_order_T a b); intro. -elim s; intro. -case (total_order_T b c); intro. -elim s0; intro. -split with (cons_Rlist l1 l2); split with (FF (cons_Rlist l1 l2) f); +Proof. +intros f a b c H H0 (l1,(lf1,H1)) (l2,(lf2,H2)); + destruct (total_order_T a b) as [[Hltab|Hab]|Hgtab]. + destruct (total_order_T b c) as [[Hltbc|Hbc]|Hgtbc]. +exists (cons_Rlist l1 l2); exists (FF (cons_Rlist l1 l2) f); apply StepFun_P40 with b lf1 lf2; assumption. -split with l1; split with lf1; rewrite b0 in H1; assumption. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 r)). -split with l2; split with lf2; rewrite <- b0 in H2; assumption. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)). +exists l1; exists lf1; rewrite Hbc in H1; assumption. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 Hgtbc)). +exists l2; exists lf2; rewrite <- Hab in H2; assumption. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H Hgtab)). Qed. Lemma StepFun_P42 : @@ -2431,14 +2419,14 @@ elim H; clear H; intros; unfold IsStepFun in X; unfold is_subdivision in X; adapted_couple f a b l1 lf1 -> a <= c <= b -> sigT (fun l:Rlist => sigT (fun l0:Rlist => adapted_couple f a c l l0))). -intros; unfold IsStepFun in |- *; unfold is_subdivision in |- *; eapply X. +intro X; unfold IsStepFun in |- *; unfold is_subdivision in |- *; eapply X. apply H2. split; assumption. clear f a b c H0 H H1 H2 l1 lf1; simple induction l1. intros; unfold adapted_couple in H; decompose [and] H; clear H; simpl in H4; discriminate. simple induction r0. -intros; assert (H1 : a = b). +intros X lf1 a b c f H H0; assert (H1 : a = b). unfold adapted_couple in H; decompose [and] H; clear H; simpl in H3; simpl in H2; assert (H7 : a <= b). elim H0; intros; apply Rle_trans with c; assumption. @@ -2452,7 +2440,7 @@ unfold Rmin in |- *; case (Rle_dec a b); intro; split with (cons r nil); split with lf1; assert (H2 : c = b). rewrite H1 in H0; elim H0; intros; apply Rle_antisym; assumption. rewrite H2; assumption. -intros; clear X; induction lf1 as [| r3 lf1 Hreclf1]. +intros r1 r2 _ X0 lf1 a b c f H H0; induction lf1 as [| r3 lf1 Hreclf1]. unfold adapted_couple in H; decompose [and] H; clear H; simpl in H4; discriminate. clear Hreclf1; assert (H1 : {c <= r1} + {r1 < c}). @@ -2546,13 +2534,13 @@ elim H; clear H; intros; unfold IsStepFun in X; unfold is_subdivision in X; adapted_couple f a b l1 lf1 -> a <= c <= b -> sigT (fun l:Rlist => sigT (fun l0:Rlist => adapted_couple f c b l l0))). -intros; unfold IsStepFun in |- *; unfold is_subdivision in |- *; eapply X; +intro X; unfold IsStepFun in |- *; unfold is_subdivision in |- *; eapply X; [ apply H2 | split; assumption ]. clear f a b c H0 H H1 H2 l1 lf1; simple induction l1. intros; unfold adapted_couple in H; decompose [and] H; clear H; simpl in H4; discriminate. simple induction r0. -intros; assert (H1 : a = b). +intros X lf1 a b c f H H0; assert (H1 : a = b). unfold adapted_couple in H; decompose [and] H; clear H; simpl in H3; simpl in H2; assert (H7 : a <= b). elim H0; intros; apply Rle_trans with c; assumption. @@ -2566,7 +2554,7 @@ unfold Rmin in |- *; case (Rle_dec a b); intro; split with (cons r nil); split with lf1; assert (H2 : c = b). rewrite H1 in H0; elim H0; intros; apply Rle_antisym; assumption. rewrite <- H2 in H1; rewrite <- H1; assumption. -intros; clear X; induction lf1 as [| r3 lf1 Hreclf1]. +intros r1 r2 _ X0 lf1 a b c f H H0; induction lf1 as [| r3 lf1 Hreclf1]. unfold adapted_couple in H; decompose [and] H; clear H; simpl in H4; discriminate. clear Hreclf1; assert (H1 : {c <= r1} + {r1 < c}). diff --git a/theories/Setoids/Setoid.v b/theories/Setoids/Setoid.v index 6ff73438..b670fc19 100644 --- a/theories/Setoids/Setoid.v +++ b/theories/Setoids/Setoid.v @@ -7,7 +7,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Setoid.v 6306 2004-11-16 16:11:10Z sacerdot $: i*) +(*i $Id: Setoid.v 8866 2006-05-28 16:21:04Z herbelin $: i*) Require Export Relation_Definitions. @@ -339,7 +339,7 @@ with Morphism_Context_List_rect2 := Induction for Morphism_Context_List Sort Typ Definition product_of_arguments : Arguments -> Type. induction 1. exact (carrier_of_relation_class a). - exact (prodT (carrier_of_relation_class a) IHX). + exact (prod (carrier_of_relation_class a) IHX). Defined. Definition get_rewrite_direction: rewrite_direction -> Argument_Class -> rewrite_direction. @@ -662,3 +662,26 @@ Implicit Arguments Setoid_Theory []. Implicit Arguments Seq_refl []. Implicit Arguments Seq_sym []. Implicit Arguments Seq_trans []. + + +(* Some tactics for manipulating Setoid Theory not officially + declared as Setoid. *) + +Ltac trans_st x := match goal with + | H : Setoid_Theory _ ?eqA |- ?eqA _ _ => + apply (Seq_trans _ _ H) with x; auto + end. + +Ltac sym_st := match goal with + | H : Setoid_Theory _ ?eqA |- ?eqA _ _ => + apply (Seq_sym _ _ H); auto + end. + +Ltac refl_st := match goal with + | H : Setoid_Theory _ ?eqA |- ?eqA _ _ => + apply (Seq_refl _ _ H); auto + end. + +Definition gen_st : forall A : Set, Setoid_Theory _ (@eq A). +Proof. constructor; congruence. Qed. + diff --git a/theories/Sorting/PermutEq.v b/theories/Sorting/PermutEq.v new file mode 100644 index 00000000..e56ff27d --- /dev/null +++ b/theories/Sorting/PermutEq.v @@ -0,0 +1,241 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: PermutEq.v 8853 2006-05-23 18:17:38Z herbelin $ i*) + +Require Import Omega. +Require Import Relations. +Require Import Setoid. +Require Import List. +Require Import Multiset. +Require Import Permutation. + +Set Implicit Arguments. + +(** This file is similar to [PermutSetoid], except that the equality used here + is Coq usual one instead of a setoid equality. In particular, we can then + prove the equivalence between [List.Permutation] and + [Permutation.permutation]. +*) + +Section Perm. + +Variable A : Set. +Hypothesis eq_dec : forall x y:A, {x=y} + {~ x=y}. + +Notation permutation := (permutation _ eq_dec). +Notation list_contents := (list_contents _ eq_dec). + +(** we can use [multiplicity] to define [In] and [NoDup]. *) + +Lemma multiplicity_In : + forall l a, In a l <-> 0 < multiplicity (list_contents l) a. +Proof. +induction l. +simpl. +split; inversion 1. +simpl. +split; intros. +inversion_clear H. +subst a0. +destruct (eq_dec a a) as [_|H]; auto with arith; destruct H; auto. +destruct (eq_dec a a0) as [H1|H1]; auto with arith; simpl. +rewrite <- IHl; auto. +destruct (eq_dec a a0); auto. +simpl in H. +right; rewrite IHl; auto. +Qed. + +Lemma multiplicity_In_O : + forall l a, ~ In a l -> multiplicity (list_contents l) a = 0. +Proof. +intros l a; rewrite multiplicity_In; + destruct (multiplicity (list_contents l) a); auto. +destruct 1; auto with arith. +Qed. + +Lemma multiplicity_In_S : + forall l a, In a l -> multiplicity (list_contents l) a >= 1. +Proof. +intros l a; rewrite multiplicity_In; auto. +Qed. + +Lemma multiplicity_NoDup : + forall l, NoDup l <-> (forall a, multiplicity (list_contents l) a <= 1). +Proof. +induction l. +simpl. +split; auto with arith. +intros; apply NoDup_nil. +split; simpl. +inversion_clear 1. +rewrite IHl in H1. +intros; destruct (eq_dec a a0) as [H2|H2]; simpl; auto. +subst a0. +rewrite multiplicity_In_O; auto. +intros; constructor. +rewrite multiplicity_In. +generalize (H a). +destruct (eq_dec a a) as [H0|H0]. +destruct (multiplicity (list_contents l) a); auto with arith. +simpl; inversion 1. +inversion H3. +destruct H0; auto. +rewrite IHl; intros. +generalize (H a0); auto with arith. +destruct (eq_dec a a0); simpl; auto with arith. +Qed. + +Lemma NoDup_permut : + forall l l', NoDup l -> NoDup l' -> + (forall x, In x l <-> In x l') -> permutation l l'. +Proof. +intros. +red; unfold meq; intros. +rewrite multiplicity_NoDup in H, H0. +generalize (H a) (H0 a) (H1 a); clear H H0 H1. +do 2 rewrite multiplicity_In. +destruct 3; omega. +Qed. + +(** Permutation is compatible with In. *) +Lemma permut_In_In : + forall l1 l2 e, permutation l1 l2 -> In e l1 -> In e l2. +Proof. +unfold Permutation.permutation, meq; intros l1 l2 e P IN. +generalize (P e); clear P. +destruct (In_dec eq_dec e l2) as [H|H]; auto. +rewrite (multiplicity_In_O _ _ H). +intros. +generalize (multiplicity_In_S _ _ IN). +rewrite H0. +inversion 1. +Qed. + +Lemma permut_cons_In : + forall l1 l2 e, permutation (e :: l1) l2 -> In e l2. +Proof. +intros; eapply permut_In_In; eauto. +red; auto. +Qed. + +(** Permutation of an empty list. *) +Lemma permut_nil : + forall l, permutation l nil -> l = nil. +Proof. +intro l; destruct l as [ | e l ]; trivial. +assert (In e (e::l)) by (red; auto). +intro Abs; generalize (permut_In_In _ Abs H). +inversion 1. +Qed. + +(** When used with [eq], this permutation notion is equivalent to + the one defined in [List.v]. *) + +Lemma permutation_Permutation : + forall l l', Permutation l l' <-> permutation l l'. +Proof. +split. +induction 1. +apply permut_refl. +apply permut_cons; auto. +change (permutation (y::x::l) ((x::nil)++y::l)). +apply permut_add_cons_inside; simpl; apply permut_refl. +apply permut_tran with l'; auto. +revert l'. +induction l. +intros. +rewrite (permut_nil (permut_sym H)). +apply Permutation_refl. +intros. +destruct (In_split _ _ (permut_cons_In H)) as (h2,(t2,H1)). +subst l'. +apply Permutation_cons_app. +apply IHl. +apply permut_remove_hd with a; auto. +Qed. + +(** Permutation for short lists. *) + +Lemma permut_length_1: + forall a b, permutation (a :: nil) (b :: nil) -> a=b. +Proof. +intros a b; unfold Permutation.permutation, meq; intro P; +generalize (P b); clear P; simpl. +destruct (eq_dec b b) as [H|H]; [ | destruct H; auto]. +destruct (eq_dec a b); simpl; auto; intros; discriminate. +Qed. + +Lemma permut_length_2 : + forall a1 b1 a2 b2, permutation (a1 :: b1 :: nil) (a2 :: b2 :: nil) -> + (a1=a2) /\ (b1=b2) \/ (a1=b2) /\ (a2=b1). +Proof. +intros a1 b1 a2 b2 P. +assert (H:=permut_cons_In P). +inversion_clear H. +left; split; auto. +apply permut_length_1. +red; red; intros. +generalize (P a); clear P; simpl. +destruct (eq_dec a1 a) as [H2|H2]; + destruct (eq_dec a2 a) as [H3|H3]; auto. +destruct H3; transitivity a1; auto. +destruct H2; transitivity a2; auto. +right. +inversion_clear H0; [|inversion H]. +split; auto. +apply permut_length_1. +red; red; intros. +generalize (P a); clear P; simpl. +destruct (eq_dec a1 a) as [H2|H2]; + destruct (eq_dec b2 a) as [H3|H3]; auto. +simpl; rewrite <- plus_n_Sm; inversion 1; auto. +destruct H3; transitivity a1; auto. +destruct H2; transitivity b2; auto. +Qed. + +(** Permutation is compatible with length. *) +Lemma permut_length : + forall l1 l2, permutation l1 l2 -> length l1 = length l2. +Proof. +induction l1; intros l2 H. +rewrite (permut_nil (permut_sym H)); auto. +destruct (In_split _ _ (permut_cons_In H)) as (h2,(t2,H1)). +subst l2. +rewrite app_length. +simpl; rewrite <- plus_n_Sm; f_equal. +rewrite <- app_length. +apply IHl1. +apply permut_remove_hd with a; auto. +Qed. + +Variable B : Set. +Variable eqB_dec : forall x y:B, { x=y }+{ ~x=y }. + +(** Permutation is compatible with map. *) + +Lemma permutation_map : + forall f l1 l2, permutation l1 l2 -> + Permutation.permutation _ eqB_dec (map f l1) (map f l2). +Proof. +intros f; induction l1. +intros l2 P; rewrite (permut_nil (permut_sym P)); apply permut_refl. +intros l2 P. +simpl. +destruct (In_split _ _ (permut_cons_In P)) as (h2,(t2,H1)). +subst l2. +rewrite map_app. +simpl. +apply permut_add_cons_inside. +rewrite <- map_app. +apply IHl1; auto. +apply permut_remove_hd with a; auto. +Qed. + +End Perm. + diff --git a/theories/Sorting/PermutSetoid.v b/theories/Sorting/PermutSetoid.v new file mode 100644 index 00000000..46ea088f --- /dev/null +++ b/theories/Sorting/PermutSetoid.v @@ -0,0 +1,243 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: PermutSetoid.v 8823 2006-05-16 16:17:43Z letouzey $ i*) + +Require Import Omega. +Require Import Relations. +Require Import List. +Require Import Multiset. +Require Import Permutation. +Require Import SetoidList. + +Set Implicit Arguments. + +(** This file contains additional results about permutations + with respect to an setoid equality (i.e. an equivalence relation). +*) + +Section Perm. + +Variable A : Set. +Variable eqA : relation A. +Hypothesis eqA_dec : forall x y:A, {eqA x y} + {~ eqA x y}. + +Notation permutation := (permutation _ eqA_dec). +Notation list_contents := (list_contents _ eqA_dec). + +(** The following lemmas need some knowledge on [eqA] *) + +Variable eqA_refl : forall x, eqA x x. +Variable eqA_sym : forall x y, eqA x y -> eqA y x. +Variable eqA_trans : forall x y z, eqA x y -> eqA y z -> eqA x z. + +(** we can use [multiplicity] to define [InA] and [NoDupA]. *) + +Lemma multiplicity_InA : + forall l a, InA eqA a l <-> 0 < multiplicity (list_contents l) a. +Proof. +induction l. +simpl. +split; inversion 1. +simpl. +split; intros. +inversion_clear H. +destruct (eqA_dec a a0) as [_|H1]; auto with arith. +destruct H1; auto. +destruct (eqA_dec a a0); auto with arith. +simpl; rewrite <- IHl; auto. +destruct (eqA_dec a a0) as [H0|H0]; auto. +simpl in H. +constructor 2; rewrite IHl; auto. +Qed. + +Lemma multiplicity_InA_O : + forall l a, ~ InA eqA a l -> multiplicity (list_contents l) a = 0. +Proof. +intros l a; rewrite multiplicity_InA; +destruct (multiplicity (list_contents l) a); auto with arith. +destruct 1; auto with arith. +Qed. + +Lemma multiplicity_InA_S : + forall l a, InA eqA a l -> multiplicity (list_contents l) a >= 1. +Proof. +intros l a; rewrite multiplicity_InA; auto with arith. +Qed. + +Lemma multiplicity_NoDupA : forall l, + NoDupA eqA l <-> (forall a, multiplicity (list_contents l) a <= 1). +Proof. +induction l. +simpl. +split; auto with arith. +split; simpl. +inversion_clear 1. +rewrite IHl in H1. +intros; destruct (eqA_dec a a0) as [H2|H2]; simpl; auto. +rewrite multiplicity_InA_O; auto. +swap H0. +apply InA_eqA with a0; auto. +intros; constructor. +rewrite multiplicity_InA. +generalize (H a). +destruct (eqA_dec a a) as [H0|H0]. +destruct (multiplicity (list_contents l) a); auto with arith. +simpl; inversion 1. +inversion H3. +destruct H0; auto. +rewrite IHl; intros. +generalize (H a0); auto with arith. +destruct (eqA_dec a a0); simpl; auto with arith. +Qed. + + +(** Permutation is compatible with InA. *) +Lemma permut_InA_InA : + forall l1 l2 e, permutation l1 l2 -> InA eqA e l1 -> InA eqA e l2. +Proof. +intros l1 l2 e. +do 2 rewrite multiplicity_InA. +unfold Permutation.permutation, meq. +intros H;rewrite H; auto. +Qed. + +Lemma permut_cons_InA : + forall l1 l2 e, permutation (e :: l1) l2 -> InA eqA e l2. +Proof. +intros; apply (permut_InA_InA (e:=e) H); auto. +Qed. + +(** Permutation of an empty list. *) +Lemma permut_nil : + forall l, permutation l nil -> l = nil. +Proof. +intro l; destruct l as [ | e l ]; trivial. +assert (InA eqA e (e::l)) by auto. +intro Abs; generalize (permut_InA_InA Abs H). +inversion 1. +Qed. + +(** Permutation for short lists. *) + +Lemma permut_length_1: + forall a b, permutation (a :: nil) (b :: nil) -> eqA a b. +Proof. +intros a b; unfold Permutation.permutation, meq; intro P; +generalize (P b); clear P; simpl. +destruct (eqA_dec b b) as [H|H]; [ | destruct H; auto]. +destruct (eqA_dec a b); simpl; auto; intros; discriminate. +Qed. + +Lemma permut_length_2 : + forall a1 b1 a2 b2, permutation (a1 :: b1 :: nil) (a2 :: b2 :: nil) -> + (eqA a1 a2) /\ (eqA b1 b2) \/ (eqA a1 b2) /\ (eqA a2 b1). +Proof. +intros a1 b1 a2 b2 P. +assert (H:=permut_cons_InA P). +inversion_clear H. +left; split; auto. +apply permut_length_1. +red; red; intros. +generalize (P a); clear P; simpl. +destruct (eqA_dec a1 a) as [H2|H2]; + destruct (eqA_dec a2 a) as [H3|H3]; auto. +destruct H3; apply eqA_trans with a1; auto. +destruct H2; apply eqA_trans with a2; auto. +right. +inversion_clear H0; [|inversion H]. +split; auto. +apply permut_length_1. +red; red; intros. +generalize (P a); clear P; simpl. +destruct (eqA_dec a1 a) as [H2|H2]; + destruct (eqA_dec b2 a) as [H3|H3]; auto. +simpl; rewrite <- plus_n_Sm; inversion 1; auto. +destruct H3; apply eqA_trans with a1; auto. +destruct H2; apply eqA_trans with b2; auto. +Qed. + +(** Permutation is compatible with length. *) +Lemma permut_length : + forall l1 l2, permutation l1 l2 -> length l1 = length l2. +Proof. +induction l1; intros l2 H. +rewrite (permut_nil (permut_sym H)); auto. +assert (H0:=permut_cons_InA H). +destruct (InA_split H0) as (h2,(b,(t2,(H1,H2)))). +subst l2. +rewrite app_length. +simpl; rewrite <- plus_n_Sm; f_equal. +rewrite <- app_length. +apply IHl1. +apply permut_remove_hd with b. +apply permut_tran with (a::l1); auto. +revert H1; unfold Permutation.permutation, meq; simpl. +intros; f_equal; auto. +destruct (eqA_dec b a0) as [H2|H2]; + destruct (eqA_dec a a0) as [H3|H3]; auto. +destruct H3; apply eqA_trans with b; auto. +destruct H2; apply eqA_trans with a; auto. +Qed. + +Lemma NoDupA_eqlistA_permut : + forall l l', NoDupA eqA l -> NoDupA eqA l' -> + eqlistA eqA l l' -> permutation l l'. +Proof. +intros. +red; unfold meq; intros. +rewrite multiplicity_NoDupA in H, H0. +generalize (H a) (H0 a) (H1 a); clear H H0 H1. +do 2 rewrite multiplicity_InA. +destruct 3; omega. +Qed. + + +Variable B : Set. +Variable eqB : B->B->Prop. +Variable eqB_dec : forall x y:B, { eqB x y }+{ ~eqB x y }. +Variable eqB_trans : forall x y z, eqB x y -> eqB y z -> eqB x z. + +(** Permutation is compatible with map. *) + +Lemma permut_map : + forall f, + (forall x y, eqA x y -> eqB (f x) (f y)) -> + forall l1 l2, permutation l1 l2 -> + Permutation.permutation _ eqB_dec (map f l1) (map f l2). +Proof. +intros f; induction l1. +intros l2 P; rewrite (permut_nil (permut_sym P)); apply permut_refl. +intros l2 P. +simpl. +assert (H0:=permut_cons_InA P). +destruct (InA_split H0) as (h2,(b,(t2,(H1,H2)))). +subst l2. +rewrite map_app. +simpl. +apply permut_tran with (f b :: map f l1). +revert H1; unfold Permutation.permutation, meq; simpl. +intros; f_equal; auto. +destruct (eqB_dec (f b) a0) as [H2|H2]; + destruct (eqB_dec (f a) a0) as [H3|H3]; auto. +destruct H3; apply eqB_trans with (f b); auto. +destruct H2; apply eqB_trans with (f a); auto. +apply permut_add_cons_inside. +rewrite <- map_app. +apply IHl1; auto. +apply permut_remove_hd with b. +apply permut_tran with (a::l1); auto. +revert H1; unfold Permutation.permutation, meq; simpl. +intros; f_equal; auto. +destruct (eqA_dec b a0) as [H2|H2]; + destruct (eqA_dec a a0) as [H3|H3]; auto. +destruct H3; apply eqA_trans with b; auto. +destruct H2; apply eqA_trans with a; auto. +Qed. + +End Perm. diff --git a/theories/Sorting/Permutation.v b/theories/Sorting/Permutation.v index b3287cd1..0f2e02b5 100644 --- a/theories/Sorting/Permutation.v +++ b/theories/Sorting/Permutation.v @@ -6,30 +6,39 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Permutation.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: Permutation.v 8823 2006-05-16 16:17:43Z letouzey $ i*) Require Import Relations. Require Import List. Require Import Multiset. +Require Import Arith. + +(** This file define a notion of permutation for lists, based on multisets: + there exists a permutation between two lists iff every elements have + the same multiplicities in the two lists. + + Unlike [List.Permutation], the present notion of permutation requires + a decidable equality. At the same time, this definition can be used + with a non-standard equality, whereas [List.Permutation] cannot. + + The present file contains basic results, obtained without any particular + assumption on the decidable equality used. + + File [PermutSetoid] contains additional results about permutations + with respect to an setoid equality (i.e. an equivalence relation). + + Finally, file [PermutEq] concerns Coq equality : this file is similar + to the previous one, but proves in addition that [List.Permutation] + and [permutation] are equivalent in this context. +*) Set Implicit Arguments. Section defs. Variable A : Set. -Variable leA : relation A. Variable eqA : relation A. - -Let gtA (x y:A) := ~ leA x y. - -Hypothesis leA_dec : forall x y:A, {leA x y} + {~ leA x y}. Hypothesis eqA_dec : forall x y:A, {eqA x y} + {~ eqA x y}. -Hypothesis leA_refl : forall x y:A, eqA x y -> leA x y. -Hypothesis leA_trans : forall x y z:A, leA x y -> leA y z -> leA x z. -Hypothesis leA_antisym : forall x y:A, leA x y -> leA y x -> eqA x y. - -Hint Resolve leA_refl: default. -Hint Immediate eqA_dec leA_dec leA_antisym: default. Let emptyBag := EmptyBag A. Let singletonBag := SingletonBag _ eqA_dec. @@ -63,6 +72,12 @@ unfold permutation in |- *; auto with datatypes. Qed. Hint Resolve permut_refl. +Lemma permut_sym : + forall l1 l2 : list A, permutation l1 l2 -> permutation l2 l1. +Proof. +unfold permutation, meq; intros; apply sym_eq; trivial. +Qed. + Lemma permut_tran : forall l m n:list A, permutation l m -> permutation m n -> permutation l n. Proof. @@ -70,51 +85,122 @@ unfold permutation in |- *; intros. apply meq_trans with (list_contents m); auto with datatypes. Qed. -Lemma permut_right : +Lemma permut_cons : forall l m:list A, permutation l m -> forall a:A, permutation (a :: l) (a :: m). Proof. unfold permutation in |- *; simpl in |- *; auto with datatypes. Qed. -Hint Resolve permut_right. +Hint Resolve permut_cons. Lemma permut_app : forall l l' m m':list A, permutation l l' -> permutation m m' -> permutation (l ++ m) (l' ++ m'). Proof. unfold permutation in |- *; intros. -apply meq_trans with (munion (list_contents l) (list_contents m)); +apply meq_trans with (munion (list_contents l) (list_contents m)); auto with datatypes. -apply meq_trans with (munion (list_contents l') (list_contents m')); +apply meq_trans with (munion (list_contents l') (list_contents m')); auto with datatypes. apply meq_trans with (munion (list_contents l') (list_contents m)); auto with datatypes. Qed. Hint Resolve permut_app. -Lemma permut_cons : - forall l m:list A, - permutation l m -> forall a:A, permutation (a :: l) (a :: m). +Lemma permut_add_inside : + forall a l1 l2 l3 l4, + permutation (l1 ++ l2) (l3 ++ l4) -> + permutation (l1 ++ a :: l2) (l3 ++ a :: l4). Proof. -intros l m H a. -change (permutation ((a :: nil) ++ l) ((a :: nil) ++ m)) in |- *. -apply permut_app; auto with datatypes. +unfold permutation, meq in *; intros. +generalize (H a0); clear H. +do 4 rewrite list_contents_app. +simpl. +destruct (eqA_dec a a0); simpl; auto with arith. +do 2 rewrite <- plus_n_Sm; f_equal; auto. +Qed. + +Lemma permut_add_cons_inside : + forall a l l1 l2, + permutation l (l1 ++ l2) -> + permutation (a :: l) (l1 ++ a :: l2). +Proof. +intros; +replace (a :: l) with (nil ++ a :: l); trivial; +apply permut_add_inside; trivial. Qed. -Hint Resolve permut_cons. Lemma permut_middle : forall (l m:list A) (a:A), permutation (a :: l ++ m) (l ++ a :: m). Proof. -unfold permutation in |- *. -simple induction l; simpl in |- *; auto with datatypes. -intros. -apply meq_trans with - (munion (singletonBag a) - (munion (singletonBag a0) (list_contents (l0 ++ m)))); - auto with datatypes. -apply munion_perm_left; auto with datatypes. +intros; apply permut_add_cons_inside; auto. Qed. Hint Resolve permut_middle. +Lemma permut_sym_app : + forall l1 l2, permutation (l1 ++ l2) (l2 ++ l1). +Proof. +intros l1 l2; +unfold permutation, meq; +intro a; do 2 rewrite list_contents_app; simpl; +auto with arith. +Qed. + +Lemma permut_rev : + forall l, permutation l (rev l). +Proof. +induction l. +simpl; auto. +simpl. +apply permut_add_cons_inside. +rewrite <- app_nil_end; auto. +Qed. + +(** Some inversion results. *) +Lemma permut_conv_inv : + forall e l1 l2, permutation (e :: l1) (e :: l2) -> permutation l1 l2. +Proof. +intros e l1 l2; unfold permutation, meq; simpl; intros H a; +generalize (H a); apply plus_reg_l. +Qed. + +Lemma permut_app_inv1 : + forall l l1 l2, permutation (l1 ++ l) (l2 ++ l) -> permutation l1 l2. +Proof. +intros l l1 l2; unfold permutation, meq; simpl; +intros H a; generalize (H a); clear H. +do 2 rewrite list_contents_app. +simpl. +intros; apply plus_reg_l with (multiplicity (list_contents l) a). +rewrite plus_comm; rewrite H; rewrite plus_comm. +trivial. +Qed. + +Lemma permut_app_inv2 : + forall l l1 l2, permutation (l ++ l1) (l ++ l2) -> permutation l1 l2. +Proof. +intros l l1 l2; unfold permutation, meq; simpl; +intros H a; generalize (H a); clear H. +do 2 rewrite list_contents_app. +simpl. +intros; apply plus_reg_l with (multiplicity (list_contents l) a). +trivial. +Qed. + +Lemma permut_remove_hd : + forall l l1 l2 a, + permutation (a :: l) (l1 ++ a :: l2) -> permutation l (l1 ++ l2). +Proof. +intros l l1 l2 a; unfold permutation, meq; simpl; intros H a0; generalize (H a0); clear H. +do 2 rewrite list_contents_app; simpl; intro H. +apply plus_reg_l with (if eqA_dec a a0 then 1 else 0). +rewrite H; clear H. +symmetry; rewrite plus_comm. +repeat rewrite <- plus_assoc; f_equal. +apply plus_comm. +Qed. + End defs. +(* For compatibilty *) +Notation permut_right := permut_cons. Unset Implicit Arguments. diff --git a/theories/ZArith/BinInt.v b/theories/ZArith/BinInt.v index 02cf5f2d..fda521de 100644 --- a/theories/ZArith/BinInt.v +++ b/theories/ZArith/BinInt.v @@ -6,10 +6,10 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: BinInt.v 6295 2004-11-12 16:40:39Z gregoire $ i*) +(*i $Id: BinInt.v 8883 2006-05-31 21:56:37Z letouzey $ i*) (***********************************************************) -(** Binary Integers (Pierre Crégut, CNET, Lannion, France) *) +(** Binary Integers (Pierre Crégut, CNET, Lannion, France) *) (***********************************************************) Require Export BinPos. @@ -703,6 +703,12 @@ Qed. (**********************************************************************) (** Properties of multiplication on binary integer numbers *) +Theorem Zpos_mult_morphism : + forall p q:positive, Zpos (p*q) = Zpos p * Zpos q. +Proof. +auto. +Qed. + (** One is neutral for multiplication *) Theorem Zmult_1_l : forall n:Z, Zpos 1 * n = n. @@ -935,6 +941,8 @@ Proof. intros; symmetry in |- *; apply Zmult_succ_l. Qed. + + (** Misc redundant properties *) Lemma Z_eq_mult : forall n m:Z, m = Z0 -> m * n = Z0. diff --git a/theories/ZArith/Int.v b/theories/ZArith/Int.v new file mode 100644 index 00000000..cb51b9d2 --- /dev/null +++ b/theories/ZArith/Int.v @@ -0,0 +1,421 @@ +(***********************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * INRIA-Rocquencourt & LRI-CNRS-Orsay *) +(* \VV/ *************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(***********************************************************************) + +(* Finite sets library. + * Authors: Pierre Letouzey and Jean-Christophe Filliâtre + * Institution: LRI, CNRS UMR 8623 - Université Paris Sud + * 91405 Orsay, France *) + +(* $Id: Int.v 8933 2006-06-09 14:08:38Z herbelin $ *) + +(** * An axiomatization of integers. *) + +(** We define a signature for an integer datatype based on [Z]. + The goal is to allow a switch after extraction to ocaml's + [big_int] or even [int] when finiteness isn't a problem + (typically : when mesuring the height of an AVL tree). +*) + +Require Import ZArith. +Require Import ROmega. +Delimit Scope Int_scope with I. + +Module Type Int. + + Open Scope Int_scope. + + Parameter int : Set. + + Parameter i2z : int -> Z. + Arguments Scope i2z [ Int_scope ]. + + Parameter _0 : int. + Parameter _1 : int. + Parameter _2 : int. + Parameter _3 : int. + Parameter plus : int -> int -> int. + Parameter opp : int -> int. + Parameter minus : int -> int -> int. + Parameter mult : int -> int -> int. + Parameter max : int -> int -> int. + + Notation "0" := _0 : Int_scope. + Notation "1" := _1 : Int_scope. + Notation "2" := _2 : Int_scope. + Notation "3" := _3 : Int_scope. + Infix "+" := plus : Int_scope. + Infix "-" := minus : Int_scope. + Infix "*" := mult : Int_scope. + Notation "- x" := (opp x) : Int_scope. + +(** For logical relations, we can rely on their counterparts in Z, + since they don't appear after extraction. Moreover, using tactics + like omega is easier this way. *) + + Notation "x == y" := (i2z x = i2z y) + (at level 70, y at next level, no associativity) : Int_scope. + Notation "x <= y" := (Zle (i2z x) (i2z y)): Int_scope. + Notation "x < y" := (Zlt (i2z x) (i2z y)) : Int_scope. + Notation "x >= y" := (Zge (i2z x) (i2z y)) : Int_scope. + Notation "x > y" := (Zgt (i2z x) (i2z y)): Int_scope. + Notation "x <= y <= z" := (x <= y /\ y <= z) : Int_scope. + Notation "x <= y < z" := (x <= y /\ y < z) : Int_scope. + Notation "x < y < z" := (x < y /\ y < z) : Int_scope. + Notation "x < y <= z" := (x < y /\ y <= z) : Int_scope. + + (** Some decidability fonctions (informative). *) + + Axiom gt_le_dec : forall x y: int, {x > y} + {x <= y}. + Axiom ge_lt_dec : forall x y : int, {x >= y} + {x < y}. + Axiom eq_dec : forall x y : int, { x == y } + {~ x==y }. + + (** Specifications *) + + (** First, we ask [i2z] to be injective. Said otherwise, our ad-hoc equality + [==] and the generic [=] are in fact equivalent. We define [==] + nonetheless since the translation to [Z] for using automatic tactic is easier. *) + + Axiom i2z_eq : forall n p : int, n == p -> n = p. + + (** Then, we express the specifications of the above parameters using their + Z counterparts. *) + + Open Scope Z_scope. + Axiom i2z_0 : i2z _0 = 0. + Axiom i2z_1 : i2z _1 = 1. + Axiom i2z_2 : i2z _2 = 2. + Axiom i2z_3 : i2z _3 = 3. + Axiom i2z_plus : forall n p, i2z (n + p) = i2z n + i2z p. + Axiom i2z_opp : forall n, i2z (-n) = -i2z n. + Axiom i2z_minus : forall n p, i2z (n - p) = i2z n - i2z p. + Axiom i2z_mult : forall n p, i2z (n * p) = i2z n * i2z p. + Axiom i2z_max : forall n p, i2z (max n p) = Zmax (i2z n) (i2z p). + +End Int. + +Module MoreInt (I:Int). + Import I. + + Open Scope Int_scope. + + (** A magic (but costly) tactic that goes from [int] back to the [Z] + friendly world ... *) + + Hint Rewrite -> + i2z_0 i2z_1 i2z_2 i2z_3 i2z_plus i2z_opp i2z_minus i2z_mult i2z_max : i2z. + + Ltac i2z := match goal with + | H : (eq (A:=int) ?a ?b) |- _ => + generalize (f_equal i2z H); + try autorewrite with i2z; clear H; intro H; i2z + | |- (eq (A:=int) ?a ?b) => apply (i2z_eq a b); try autorewrite with i2z; i2z + | H : _ |- _ => progress autorewrite with i2z in H; i2z + | _ => try autorewrite with i2z + end. + + (** A reflexive version of the [i2z] tactic *) + + (** this [i2z_refl] is actually weaker than [i2z]. For instance, if a + [i2z] is buried deep inside a subterm, [i2z_refl] may miss it. + See also the limitation about [Set] or [Type] part below. + Anyhow, [i2z_refl] is enough for applying [romega]. *) + + Ltac i2z_gen := match goal with + | |- (eq (A:=int) ?a ?b) => apply (i2z_eq a b); i2z_gen + | H : (eq (A:=int) ?a ?b) |- _ => + generalize (f_equal i2z H); clear H; i2z_gen + | H : (eq (A:=Z) ?a ?b) |- _ => generalize H; clear H; i2z_gen + | H : (Zlt ?a ?b) |- _ => generalize H; clear H; i2z_gen + | H : (Zle ?a ?b) |- _ => generalize H; clear H; i2z_gen + | H : (Zgt ?a ?b) |- _ => generalize H; clear H; i2z_gen + | H : (Zge ?a ?b) |- _ => generalize H; clear H; i2z_gen + | H : _ -> ?X |- _ => + (* A [Set] or [Type] part cannot be dealt with easily + using the [ExprP] datatype. So we forget it, leaving + a goal that can be weaker than the original. *) + match type of X with + | Type => clear H; i2z_gen + | Prop => generalize H; clear H; i2z_gen + end + | H : _ <-> _ |- _ => generalize H; clear H; i2z_gen + | H : _ /\ _ |- _ => generalize H; clear H; i2z_gen + | H : _ \/ _ |- _ => generalize H; clear H; i2z_gen + | H : ~ _ |- _ => generalize H; clear H; i2z_gen + | _ => idtac + end. + + Inductive ExprI : Set := + | EI0 : ExprI + | EI1 : ExprI + | EI2 : ExprI + | EI3 : ExprI + | EIplus : ExprI -> ExprI -> ExprI + | EIopp : ExprI -> ExprI + | EIminus : ExprI -> ExprI -> ExprI + | EImult : ExprI -> ExprI -> ExprI + | EImax : ExprI -> ExprI -> ExprI + | EIraw : int -> ExprI. + + Inductive ExprZ : Set := + | EZplus : ExprZ -> ExprZ -> ExprZ + | EZopp : ExprZ -> ExprZ + | EZminus : ExprZ -> ExprZ -> ExprZ + | EZmult : ExprZ -> ExprZ -> ExprZ + | EZmax : ExprZ -> ExprZ -> ExprZ + | EZofI : ExprI -> ExprZ + | EZraw : Z -> ExprZ. + + Inductive ExprP : Type := + | EPeq : ExprZ -> ExprZ -> ExprP + | EPlt : ExprZ -> ExprZ -> ExprP + | EPle : ExprZ -> ExprZ -> ExprP + | EPgt : ExprZ -> ExprZ -> ExprP + | EPge : ExprZ -> ExprZ -> ExprP + | EPimpl : ExprP -> ExprP -> ExprP + | EPequiv : ExprP -> ExprP -> ExprP + | EPand : ExprP -> ExprP -> ExprP + | EPor : ExprP -> ExprP -> ExprP + | EPneg : ExprP -> ExprP + | EPraw : Prop -> ExprP. + + (** [int] to [ExprI] *) + + Ltac i2ei trm := + match constr:trm with + | 0 => constr:EI0 + | 1 => constr:EI1 + | 2 => constr:EI2 + | 3 => constr:EI3 + | ?x + ?y => let ex := i2ei x with ey := i2ei y in constr:(EIplus ex ey) + | ?x - ?y => let ex := i2ei x with ey := i2ei y in constr:(EIminus ex ey) + | ?x * ?y => let ex := i2ei x with ey := i2ei y in constr:(EImult ex ey) + | max ?x ?y => let ex := i2ei x with ey := i2ei y in constr:(EImax ex ey) + | - ?x => let ex := i2ei x in constr:(EIopp ex) + | ?x => constr:(EIraw x) + end + + (** [Z] to [ExprZ] *) + + with z2ez trm := + match constr:trm with + | (?x+?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EZplus ex ey) + | (?x-?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EZminus ex ey) + | (?x*?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EZmult ex ey) + | (Zmax ?x ?y) => let ex := z2ez x with ey := z2ez y in constr:(EZmax ex ey) + | (-?x)%Z => let ex := z2ez x in constr:(EZopp ex) + | i2z ?x => let ex := i2ei x in constr:(EZofI ex) + | ?x => constr:(EZraw x) + end. + + (** [Prop] to [ExprP] *) + + Ltac p2ep trm := + match constr:trm with + | (?x <-> ?y) => let ex := p2ep x with ey := p2ep y in constr:(EPequiv ex ey) + | (?x -> ?y) => let ex := p2ep x with ey := p2ep y in constr:(EPimpl ex ey) + | (?x /\ ?y) => let ex := p2ep x with ey := p2ep y in constr:(EPand ex ey) + | (?x \/ ?y) => let ex := p2ep x with ey := p2ep y in constr:(EPor ex ey) + | (~ ?x) => let ex := p2ep x in constr:(EPneg ex) + | (eq (A:=Z) ?x ?y) => let ex := z2ez x with ey := z2ez y in constr:(EPeq ex ey) + | (?x<?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EPlt ex ey) + | (?x<=?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EPle ex ey) + | (?x>?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EPgt ex ey) + | (?x>=?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EPge ex ey) + | ?x => constr:(EPraw x) + end. + + (** [ExprI] to [int] *) + + Fixpoint ei2i (e:ExprI) : int := + match e with + | EI0 => 0 + | EI1 => 1 + | EI2 => 2 + | EI3 => 3 + | EIplus e1 e2 => (ei2i e1)+(ei2i e2) + | EIminus e1 e2 => (ei2i e1)-(ei2i e2) + | EImult e1 e2 => (ei2i e1)*(ei2i e2) + | EImax e1 e2 => max (ei2i e1) (ei2i e2) + | EIopp e => -(ei2i e) + | EIraw i => i + end. + + (** [ExprZ] to [Z] *) + + Fixpoint ez2z (e:ExprZ) : Z := + match e with + | EZplus e1 e2 => ((ez2z e1)+(ez2z e2))%Z + | EZminus e1 e2 => ((ez2z e1)-(ez2z e2))%Z + | EZmult e1 e2 => ((ez2z e1)*(ez2z e2))%Z + | EZmax e1 e2 => Zmax (ez2z e1) (ez2z e2) + | EZopp e => (-(ez2z e))%Z + | EZofI e => i2z (ei2i e) + | EZraw z => z + end. + + (** [ExprP] to [Prop] *) + + Fixpoint ep2p (e:ExprP) : Prop := + match e with + | EPeq e1 e2 => (ez2z e1) = (ez2z e2) + | EPlt e1 e2 => ((ez2z e1)<(ez2z e2))%Z + | EPle e1 e2 => ((ez2z e1)<=(ez2z e2))%Z + | EPgt e1 e2 => ((ez2z e1)>(ez2z e2))%Z + | EPge e1 e2 => ((ez2z e1)>=(ez2z e2))%Z + | EPimpl e1 e2 => (ep2p e1) -> (ep2p e2) + | EPequiv e1 e2 => (ep2p e1) <-> (ep2p e2) + | EPand e1 e2 => (ep2p e1) /\ (ep2p e2) + | EPor e1 e2 => (ep2p e1) \/ (ep2p e2) + | EPneg e => ~ (ep2p e) + | EPraw p => p + end. + + (** [ExprI] (supposed under a [i2z]) to a simplified [ExprZ] *) + + Fixpoint norm_ei (e:ExprI) : ExprZ := + match e with + | EI0 => EZraw (0%Z) + | EI1 => EZraw (1%Z) + | EI2 => EZraw (2%Z) + | EI3 => EZraw (3%Z) + | EIplus e1 e2 => EZplus (norm_ei e1) (norm_ei e2) + | EIminus e1 e2 => EZminus (norm_ei e1) (norm_ei e2) + | EImult e1 e2 => EZmult (norm_ei e1) (norm_ei e2) + | EImax e1 e2 => EZmax (norm_ei e1) (norm_ei e2) + | EIopp e => EZopp (norm_ei e) + | EIraw i => EZofI (EIraw i) + end. + + (** [ExprZ] to a simplified [ExprZ] *) + + Fixpoint norm_ez (e:ExprZ) : ExprZ := + match e with + | EZplus e1 e2 => EZplus (norm_ez e1) (norm_ez e2) + | EZminus e1 e2 => EZminus (norm_ez e1) (norm_ez e2) + | EZmult e1 e2 => EZmult (norm_ez e1) (norm_ez e2) + | EZmax e1 e2 => EZmax (norm_ez e1) (norm_ez e2) + | EZopp e => EZopp (norm_ez e) + | EZofI e => norm_ei e + | EZraw z => EZraw z + end. + + (** [ExprP] to a simplified [ExprP] *) + + Fixpoint norm_ep (e:ExprP) : ExprP := + match e with + | EPeq e1 e2 => EPeq (norm_ez e1) (norm_ez e2) + | EPlt e1 e2 => EPlt (norm_ez e1) (norm_ez e2) + | EPle e1 e2 => EPle (norm_ez e1) (norm_ez e2) + | EPgt e1 e2 => EPgt (norm_ez e1) (norm_ez e2) + | EPge e1 e2 => EPge (norm_ez e1) (norm_ez e2) + | EPimpl e1 e2 => EPimpl (norm_ep e1) (norm_ep e2) + | EPequiv e1 e2 => EPequiv (norm_ep e1) (norm_ep e2) + | EPand e1 e2 => EPand (norm_ep e1) (norm_ep e2) + | EPor e1 e2 => EPor (norm_ep e1) (norm_ep e2) + | EPneg e => EPneg (norm_ep e) + | EPraw p => EPraw p + end. + + Lemma norm_ei_correct : forall e:ExprI, ez2z (norm_ei e) = i2z (ei2i e). + Proof. + induction e; simpl; intros; i2z; auto; try congruence. + Qed. + + Lemma norm_ez_correct : forall e:ExprZ, ez2z (norm_ez e) = ez2z e. + Proof. + induction e; simpl; intros; i2z; auto; try congruence; apply norm_ei_correct. + Qed. + + Lemma norm_ep_correct : + forall e:ExprP, ep2p (norm_ep e) <-> ep2p e. + Proof. + induction e; simpl; repeat (rewrite norm_ez_correct); intuition. + Qed. + + Lemma norm_ep_correct2 : + forall e:ExprP, ep2p (norm_ep e) -> ep2p e. + Proof. + intros; destruct (norm_ep_correct e); auto. + Qed. + + Ltac i2z_refl := + i2z_gen; + match goal with |- ?t => + let e := p2ep t + in + (change (ep2p e); + apply norm_ep_correct2; + simpl) + end. + + Ltac iauto := i2z_refl; auto. + Ltac iomega := i2z_refl; intros; romega. + + Open Scope Z_scope. + + Lemma max_spec : forall (x y:Z), + x >= y /\ Zmax x y = x \/ + x < y /\ Zmax x y = y. + Proof. + intros; unfold Zmax, Zlt, Zge. + destruct (Zcompare x y); [ left | right | left ]; split; auto; discriminate. + Qed. + + Ltac omega_max_genspec x y := + generalize (max_spec x y); + let z := fresh "z" in let Hz := fresh "Hz" in + (set (z:=Zmax x y); clearbody z). + + Ltac omega_max_loop := + match goal with + (* hack: we don't want [i2z (height ...)] to be reduced by romega later... *) + | |- context [ i2z (?f ?x) ] => + let i := fresh "i2z" in (set (i:=i2z (f x)); clearbody i); omega_max_loop + | |- context [ Zmax ?x ?y ] => omega_max_genspec x y; omega_max_loop + | _ => intros + end. + + Ltac omega_max := i2z_refl; omega_max_loop; try romega. + + Ltac false_omega := i2z_refl; intros; romega. + Ltac false_omega_max := elimtype False; omega_max. + + Open Scope Int_scope. +End MoreInt. + + +(** It's always nice to know that our [Int] interface is realizable :-) *) + +Module Z_as_Int <: Int. + Open Scope Z_scope. + Definition int := Z. + Definition _0 := 0. + Definition _1 := 1. + Definition _2 := 2. + Definition _3 := 3. + Definition plus := Zplus. + Definition opp := Zopp. + Definition minus := Zminus. + Definition mult := Zmult. + Definition max := Zmax. + Definition gt_le_dec := Z_gt_le_dec. + Definition ge_lt_dec := Z_ge_lt_dec. + Definition eq_dec := Z_eq_dec. + Definition i2z : int -> Z := fun n => n. + Lemma i2z_eq : forall n p, i2z n=i2z p -> n = p. Proof. auto. Qed. + Lemma i2z_0 : i2z _0 = 0. Proof. auto. Qed. + Lemma i2z_1 : i2z _1 = 1. Proof. auto. Qed. + Lemma i2z_2 : i2z _2 = 2. Proof. auto. Qed. + Lemma i2z_3 : i2z _3 = 3. Proof. auto. Qed. + Lemma i2z_plus : forall n p, i2z (n + p) = i2z n + i2z p. Proof. auto. Qed. + Lemma i2z_opp : forall n, i2z (- n) = - i2z n. Proof. auto. Qed. + Lemma i2z_minus : forall n p, i2z (n - p) = i2z n - i2z p. Proof. auto. Qed. + Lemma i2z_mult : forall n p, i2z (n * p) = i2z n * i2z p. Proof. auto. Qed. + Lemma i2z_max : forall n p, i2z (max n p) = Zmax (i2z n) (i2z p). Proof. auto. Qed. +End Z_as_Int. + diff --git a/theories/ZArith/Zcompare.v b/theories/ZArith/Zcompare.v index 714abfc4..4003c338 100644 --- a/theories/ZArith/Zcompare.v +++ b/theories/ZArith/Zcompare.v @@ -383,7 +383,7 @@ Qed. (** Reverting [x ?= y] to trichotomy *) Lemma rename : - forall (A:Set) (P:A -> Prop) (x:A), (forall y:A, x = y -> P y) -> P x. + forall (A:Type) (P:A -> Prop) (x:A), (forall y:A, x = y -> P y) -> P x. Proof. auto with arith. Qed. diff --git a/theories/ZArith/Znumtheory.v b/theories/ZArith/Znumtheory.v index a1963446..b74f7585 100644 --- a/theories/ZArith/Znumtheory.v +++ b/theories/ZArith/Znumtheory.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Znumtheory.v 6984 2005-05-02 10:50:15Z herbelin $ i*) +(*i $Id: Znumtheory.v 8853 2006-05-23 18:17:38Z herbelin $ i*) Require Import ZArith_base. Require Import ZArithRing. @@ -367,11 +367,391 @@ rewrite H6; rewrite H7; ring. ring. Qed. +Lemma Zis_gcd_0_abs : forall b, + Zis_gcd 0 b (Zabs b) /\ Zabs b >= 0 /\ 0 = Zabs b * 0 /\ b = Zabs b * Zsgn b. +Proof. +intro b. +elim (Z_le_lt_eq_dec _ _ (Zabs_pos b)). +intros H0; split. +apply Zabs_ind. +intros; apply Zis_gcd_sym; apply Zis_gcd_0; auto. +intros; apply Zis_gcd_opp; apply Zis_gcd_0; auto. +repeat split; auto with zarith. +symmetry; apply Zabs_Zsgn. + +intros H0; rewrite <- H0. +rewrite <- (Zabs_Zsgn b); rewrite <- H0; simpl in |- *. +split; [ apply Zis_gcd_0 | idtac ]; auto with zarith. +Qed. + + (** We could obtain a [Zgcd] function via [euclid]. But we propose - here a more direct version of a [Zgcd], with better extraction - (no bezout coeffs). *) + here a more direct version of a [Zgcd], that can compute within Coq. + For that, we use an explicit measure in [nat], and we proved later + that using [2(d+1)] is enough, where [d] is the number of binary digits + of the first argument. *) + +Fixpoint Zgcdn (n:nat) : Z -> Z -> Z := fun a b => + match n with + | O => 1 (* arbitrary, since n should be big enough *) + | S n => match a with + | Z0 => Zabs b + | Zpos _ => Zgcdn n (Zmod b a) a + | Zneg a => Zgcdn n (Zmod b (Zpos a)) (Zpos a) + end + end. + +(* For technical reason, we don't use [Ndigit.Psize] but this + ad-hoc version: [Psize p = S (Psiz p)]. *) + +Fixpoint Psiz (p:positive) : nat := + match p with + | xH => O + | xI p => S (Psiz p) + | xO p => S (Psiz p) + end. + +Definition Zgcd_bound (a:Z) := match a with + | Z0 => S O + | Zpos p => let n := Psiz p in S (S (n+n)) + | Zneg p => let n := Psiz p in S (S (n+n)) +end. + +Definition Zgcd a b := Zgcdn (Zgcd_bound a) a b. + +(** A first obvious fact : [Zgcd a b] is positive. *) + +Lemma Zgcdn_is_pos : forall n a b, + 0 <= Zgcdn n a b. +Proof. +induction n. +simpl; auto with zarith. +destruct a; simpl; intros; auto with zarith; auto. +Qed. + +Lemma Zgcd_is_pos : forall a b, 0 <= Zgcd a b. +Proof. +intros; unfold Zgcd; apply Zgcdn_is_pos; auto. +Qed. + +(** We now prove that Zgcd is indeed a gcd. *) + +(** 1) We prove a weaker & easier bound. *) + +Lemma Zgcdn_linear_bound : forall n a b, + Zabs a < Z_of_nat n -> Zis_gcd a b (Zgcdn n a b). +Proof. +induction n. +simpl; intros. +elimtype False; generalize (Zabs_pos a); omega. +destruct a; intros; simpl; + [ generalize (Zis_gcd_0_abs b); intuition | | ]; + unfold Zmod; + generalize (Z_div_mod b (Zpos p) (refl_equal Gt)); + destruct (Zdiv_eucl b (Zpos p)) as (q,r); + intros (H0,H1); + rewrite inj_S in H; simpl Zabs in H; + assert (H2: Zabs r < Z_of_nat n) by (rewrite Zabs_eq; auto with zarith); + assert (IH:=IHn r (Zpos p) H2); clear IHn; + simpl in IH |- *; + rewrite H0. + apply Zis_gcd_for_euclid2; auto. + apply Zis_gcd_minus; apply Zis_gcd_sym. + apply Zis_gcd_for_euclid2; auto. +Qed. + +(** 2) For Euclid's algorithm, the worst-case situation corresponds + to Fibonacci numbers. Let's define them: *) + +Fixpoint fibonacci (n:nat) : Z := + match n with + | O => 1 + | S O => 1 + | S (S n as p) => fibonacci p + fibonacci n + end. + +Lemma fibonacci_pos : forall n, 0 <= fibonacci n. +Proof. +cut (forall N n, (n<N)%nat -> 0<=fibonacci n). +eauto. +induction N. +inversion 1. +intros. +destruct n. +simpl; auto with zarith. +destruct n. +simpl; auto with zarith. +change (0 <= fibonacci (S n) + fibonacci n). +generalize (IHN n) (IHN (S n)); omega. +Qed. + +Lemma fibonacci_incr : + forall n m, (n<=m)%nat -> fibonacci n <= fibonacci m. +Proof. +induction 1. +auto with zarith. +apply Zle_trans with (fibonacci m); auto. +clear. +destruct m. +simpl; auto with zarith. +change (fibonacci (S m) <= fibonacci (S m)+fibonacci m). +generalize (fibonacci_pos m); omega. +Qed. + +(** 3) We prove that fibonacci numbers are indeed worst-case: + for a given number [n], if we reach a conclusion about [gcd(a,b)] in + exactly [n+1] loops, then [fibonacci (n+1)<=a /\ fibonacci(n+2)<=b] *) + +Lemma Zgcdn_worst_is_fibonacci : forall n a b, + 0 < a < b -> + Zis_gcd a b (Zgcdn (S n) a b) -> + Zgcdn n a b <> Zgcdn (S n) a b -> + fibonacci (S n) <= a /\ + fibonacci (S (S n)) <= b. +Proof. +induction n. +simpl; intros. +destruct a; omega. +intros. +destruct a; [simpl in *; omega| | destruct H; discriminate]. +revert H1; revert H0. +set (m:=S n) in *; (assert (m=S n) by auto); clearbody m. +pattern m at 2; rewrite H0. +simpl Zgcdn. +unfold Zmod; generalize (Z_div_mod b (Zpos p) (refl_equal Gt)). +destruct (Zdiv_eucl b (Zpos p)) as (q,r). +intros (H1,H2). +destruct H2. +destruct (Zle_lt_or_eq _ _ H2). +generalize (IHn _ _ (conj H4 H3)). +intros H5 H6 H7. +replace (fibonacci (S (S m))) with (fibonacci (S m) + fibonacci m) by auto. +assert (r = Zpos p * (-q) + b) by (rewrite H1; ring). +destruct H5; auto. +pattern r at 1; rewrite H8. +apply Zis_gcd_sym. +apply Zis_gcd_for_euclid2; auto. +apply Zis_gcd_sym; auto. +split; auto. +rewrite H1. +apply Zplus_le_compat; auto. +apply Zle_trans with (Zpos p * 1); auto. +ring (Zpos p * 1); auto. +apply Zmult_le_compat_l. +destruct q. +omega. +assert (0 < Zpos p0) by (compute; auto). +omega. +assert (Zpos p * Zneg p0 < 0) by (compute; auto). +omega. +compute; intros; discriminate. +(* r=0 *) +subst r. +simpl; rewrite H0. +intros. +simpl in H4. +simpl in H5. +destruct n. +simpl in H5. +simpl. +omega. +simpl in H5. +elim H5; auto. +Qed. + +(** 3b) We reformulate the previous result in a more positive way. *) + +Lemma Zgcdn_ok_before_fibonacci : forall n a b, + 0 < a < b -> a < fibonacci (S n) -> + Zis_gcd a b (Zgcdn n a b). +Proof. +destruct a; [ destruct 1; elimtype False; omega | | destruct 1; discriminate]. +cut (forall k n b, + k = (S (nat_of_P p) - n)%nat -> + 0 < Zpos p < b -> Zpos p < fibonacci (S n) -> + Zis_gcd (Zpos p) b (Zgcdn n (Zpos p) b)). +destruct 2; eauto. +clear n; induction k. +intros. +assert (nat_of_P p < n)%nat by omega. +apply Zgcdn_linear_bound. +simpl. +generalize (inj_le _ _ H2). +rewrite inj_S. +rewrite <- Zpos_eq_Z_of_nat_o_nat_of_P; auto. +omega. +intros. +generalize (Zgcdn_worst_is_fibonacci n (Zpos p) b H0); intros. +assert (Zis_gcd (Zpos p) b (Zgcdn (S n) (Zpos p) b)). + apply IHk; auto. + omega. + replace (fibonacci (S (S n))) with (fibonacci (S n)+fibonacci n) by auto. + generalize (fibonacci_pos n); omega. +replace (Zgcdn n (Zpos p) b) with (Zgcdn (S n) (Zpos p) b); auto. +generalize (H2 H3); clear H2 H3; omega. +Qed. + +(** 4) The proposed bound leads to a fibonacci number that is big enough. *) + +Lemma Zgcd_bound_fibonacci : + forall a, 0 < a -> a < fibonacci (Zgcd_bound a). +Proof. +destruct a; [omega| | intro H; discriminate]. +intros _. +induction p. +simpl Zgcd_bound in *. +rewrite Zpos_xI. +rewrite plus_comm; simpl plus. +set (n:=S (Psiz p+Psiz p)) in *. +change (2*Zpos p+1 < + fibonacci (S n) + fibonacci n + fibonacci (S n)). +generalize (fibonacci_pos n). +omega. +simpl Zgcd_bound in *. +rewrite Zpos_xO. +rewrite plus_comm; simpl plus. +set (n:= S (Psiz p +Psiz p)) in *. +change (2*Zpos p < + fibonacci (S n) + fibonacci n + fibonacci (S n)). +generalize (fibonacci_pos n). +omega. +simpl; auto with zarith. +Qed. -Definition Zgcd_pos : +(* 5) the end: we glue everything together and take care of + situations not corresponding to [0<a<b]. *) + +Lemma Zgcd_is_gcd : + forall a b, Zis_gcd a b (Zgcd a b). +Proof. +unfold Zgcd; destruct a; intros. +simpl; generalize (Zis_gcd_0_abs b); intuition. +(*Zpos*) +generalize (Zgcd_bound_fibonacci (Zpos p)). +simpl Zgcd_bound. +set (n:=S (Psiz p+Psiz p)); (assert (n=S (Psiz p+Psiz p)) by auto); clearbody n. +simpl Zgcdn. +unfold Zmod. +generalize (Z_div_mod b (Zpos p) (refl_equal Gt)). +destruct (Zdiv_eucl b (Zpos p)) as (q,r). +intros (H1,H2) H3. +rewrite H1. +apply Zis_gcd_for_euclid2. +destruct H2. +destruct (Zle_lt_or_eq _ _ H0). +apply Zgcdn_ok_before_fibonacci; auto; omega. +subst r n; simpl. +apply Zis_gcd_sym; apply Zis_gcd_0. +(*Zneg*) +generalize (Zgcd_bound_fibonacci (Zpos p)). +simpl Zgcd_bound. +set (n:=S (Psiz p+Psiz p)); (assert (n=S (Psiz p+Psiz p)) by auto); clearbody n. +simpl Zgcdn. +unfold Zmod. +generalize (Z_div_mod b (Zpos p) (refl_equal Gt)). +destruct (Zdiv_eucl b (Zpos p)) as (q,r). +intros (H1,H2) H3. +rewrite H1. +apply Zis_gcd_minus. +apply Zis_gcd_sym. +apply Zis_gcd_for_euclid2. +destruct H2. +destruct (Zle_lt_or_eq _ _ H0). +apply Zgcdn_ok_before_fibonacci; auto; omega. +subst r n; simpl. +apply Zis_gcd_sym; apply Zis_gcd_0. +Qed. + +(** A generalized gcd: it additionnally keeps track of the divisors. *) + +Fixpoint Zggcdn (n:nat) : Z -> Z -> (Z*(Z*Z)) := fun a b => + match n with + | O => (1,(a,b)) (*(Zabs b,(0,Zsgn b))*) + | S n => match a with + | Z0 => (Zabs b,(0,Zsgn b)) + | Zpos _ => + let (q,r) := Zdiv_eucl b a in (* b = q*a+r *) + let (g,p) := Zggcdn n r a in + let (rr,aa) := p in (* r = g *rr /\ a = g * aa *) + (g,(aa,q*aa+rr)) + | Zneg a => + let (q,r) := Zdiv_eucl b (Zpos a) in (* b = q*(-a)+r *) + let (g,p) := Zggcdn n r (Zpos a) in + let (rr,aa) := p in (* r = g*rr /\ (-a) = g * aa *) + (g,(-aa,q*aa+rr)) + end + end. + +Definition Zggcd a b : Z * (Z * Z) := Zggcdn (Zgcd_bound a) a b. + +(** The first component of [Zggcd] is [Zgcd] *) + +Lemma Zggcdn_gcdn : forall n a b, + fst (Zggcdn n a b) = Zgcdn n a b. +Proof. +induction n; simpl; auto. +destruct a; unfold Zmod; simpl; intros; auto; + destruct (Zdiv_eucl b (Zpos p)) as (q,r); + rewrite <- IHn; + destruct (Zggcdn n r (Zpos p)) as (g,(rr,aa)); simpl; auto. +Qed. + +Lemma Zggcd_gcd : forall a b, fst (Zggcd a b) = Zgcd a b. +Proof. +intros; unfold Zggcd, Zgcd; apply Zggcdn_gcdn; auto. +Qed. + +(** [Zggcd] always returns divisors that are coherent with its + first output. *) + +Lemma Zggcdn_correct_divisors : forall n a b, + let (g,p) := Zggcdn n a b in + let (aa,bb):=p in + a=g*aa /\ b=g*bb. +Proof. +induction n. +simpl. +split; [destruct a|destruct b]; auto. +intros. +simpl. +destruct a. +rewrite Zmult_comm; simpl. +split; auto. +symmetry; apply Zabs_Zsgn. +generalize (Z_div_mod b (Zpos p)); +destruct (Zdiv_eucl b (Zpos p)) as (q,r). +generalize (IHn r (Zpos p)); +destruct (Zggcdn n r (Zpos p)) as (g,(rr,aa)). +intuition. +destruct H0. +compute; auto. +rewrite H; rewrite H1; rewrite H2; ring. +generalize (Z_div_mod b (Zpos p)); +destruct (Zdiv_eucl b (Zpos p)) as (q,r). +destruct 1. +compute; auto. +generalize (IHn r (Zpos p)); +destruct (Zggcdn n r (Zpos p)) as (g,(rr,aa)). +intuition. +destruct H0. +replace (Zneg p) with (-Zpos p) by compute; auto. +rewrite H4; ring. +rewrite H; rewrite H4; rewrite H0; ring. +Qed. + +Lemma Zggcd_correct_divisors : forall a b, + let (g,p) := Zggcd a b in + let (aa,bb):=p in + a=g*aa /\ b=g*bb. +Proof. +unfold Zggcd; intros; apply Zggcdn_correct_divisors; auto. +Qed. + +(** Due to the use of an explicit measure, the extraction of [Zgcd] + isn't optimal. We propose here another version [Zgcd_spec] that + doesn't suffer from this problem (but doesn't compute in Coq). *) + +Definition Zgcd_spec_pos : forall a:Z, 0 <= a -> forall b:Z, {g : Z | 0 <= a -> Zis_gcd a b g /\ g >= 0}. Proof. @@ -382,16 +762,7 @@ apply try assumption. intro x; case x. intros _ _ b; exists (Zabs b). - elim (Z_le_lt_eq_dec _ _ (Zabs_pos b)). - intros H0; split. - apply Zabs_ind. - intros; apply Zis_gcd_sym; apply Zis_gcd_0; auto. - intros; apply Zis_gcd_opp; apply Zis_gcd_0; auto. - auto with zarith. - - intros H0; rewrite <- H0. - rewrite <- (Zabs_Zsgn b); rewrite <- H0; simpl in |- *. - split; [ apply Zis_gcd_0 | idtac ]; auto with zarith. +generalize (Zis_gcd_0_abs b); intuition. intros p Hrec _ b. generalize (Z_div_mod b (Zpos p)). @@ -414,21 +785,58 @@ Proof. intros a; case (Z_gt_le_dec 0 a). intros; assert (0 <= - a). omega. -elim (Zgcd_pos (- a) H b); intros g Hgkl. +elim (Zgcd_spec_pos (- a) H b); intros g Hgkl. exists g. intuition. -intros Ha b; elim (Zgcd_pos a Ha b); intros g; exists g; intuition. +intros Ha b; elim (Zgcd_spec_pos a Ha b); intros g; exists g; intuition. Defined. -Definition Zgcd (a b:Z) := let (g, _) := Zgcd_spec a b in g. +(** A last version aimed at extraction that also returns the divisors. *) -Lemma Zgcd_is_pos : forall a b:Z, Zgcd a b >= 0. -intros a b; unfold Zgcd in |- *; case (Zgcd_spec a b); tauto. -Qed. +Definition Zggcd_spec_pos : + forall a:Z, + 0 <= a -> forall b:Z, {p : Z*(Z*Z) | let (g,p):=p in let (aa,bb):=p in + 0 <= a -> Zis_gcd a b g /\ g >= 0 /\ a=g*aa /\ b=g*bb}. +Proof. +intros a Ha. +pattern a; apply Zlt_0_rec; try assumption. +intro x; case x. +intros _ _ b; exists (Zabs b,(0,Zsgn b)). +intros _; apply Zis_gcd_0_abs. + +intros p Hrec _ b. +generalize (Z_div_mod b (Zpos p)). +case (Zdiv_eucl b (Zpos p)); intros q r Hqr. +elim Hqr; clear Hqr; intros; auto with zarith. +destruct (Hrec r H0 (Zpos p)) as ((g,(rr,pp)),Hgkl). +destruct H0. +destruct (Hgkl H0) as (H3,(H4,(H5,H6))). +exists (g,(pp,pp*q+rr)); intros. +split; auto. +rewrite H. +apply Zis_gcd_for_euclid2; auto. +repeat split; auto. +rewrite H; rewrite H6; rewrite H5; ring. -Lemma Zgcd_is_gcd : forall a b:Z, Zis_gcd a b (Zgcd a b). -intros a b; unfold Zgcd in |- *; case (Zgcd_spec a b); tauto. -Qed. +intros p _ H b. +elim H; auto. +Defined. + +Definition Zggcd_spec : + forall a b:Z, {p : Z*(Z*Z) | let (g,p):=p in let (aa,bb):=p in + Zis_gcd a b g /\ g >= 0 /\ a=g*aa /\ b=g*bb}. +Proof. +intros a; case (Z_gt_le_dec 0 a). +intros; assert (0 <= - a). +omega. +destruct (Zggcd_spec_pos (- a) H b) as ((g,(aa,bb)),Hgkl). +exists (g,(-aa,bb)). +intuition. +rewrite <- Zopp_mult_distr_r. +rewrite <- H2; auto with zarith. +intros Ha b; elim (Zggcd_spec_pos a Ha b); intros p; exists p. + repeat destruct p; intuition. +Defined. (** * Relative primality *) diff --git a/tools/check-translate b/tools/check-translate new file mode 100755 index 00000000..3dd82405 --- /dev/null +++ b/tools/check-translate @@ -0,0 +1,23 @@ +#!/bin/sh + +echo -------------- Producing translated files --------------------- +rm */*/*.v8 >& /dev/null +make COQ_XML=-translate theories || { echo ---- Failed to translate; exit 1; } +if [ -e translated ]; then rm -r translated; fi +if [ -e successful-translation ]; then rm -r successful-translation; fi +if [ -e failed-translation ]; then rm -r failed-translation; fi +mv theories translated +mkdir theories +echo -------------------- Upgrading files -------------------------- +cd translated +for i in */*.v +do + mkdir ../theories/`dirname $i` >& /dev/null + mv "$i"8 ../theories/$i +done +cd .. +echo --------------- Recompiling translated files ------------------ +make theories || { echo ---- Failed to recompile; mv theories failed-translation; mv translated theories; exit 1; } +echo ----------------- Recompilation successful -------------------- +if [ -e successful-translation ]; then rm -r successful-translation; fi +mv theories successful-translation; mv translated theories diff --git a/tools/coq_makefile.ml4 b/tools/coq_makefile.ml4 index cc3e9515..cd9d3669 100644 --- a/tools/coq_makefile.ml4 +++ b/tools/coq_makefile.ml4 @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: coq_makefile.ml4 7994 2006-02-06 08:48:37Z herbelin $ *) +(* $Id: coq_makefile.ml4 8840 2006-05-22 13:51:14Z notin $ *) (* créer un Makefile pour un développement Coq automatiquement *) @@ -197,7 +197,7 @@ let variables l = print "COQFLAGS=-q $(OPT) $(COQLIBS) $(OTHERFLAGS) $(COQ_XML)\n"; print "COQC=$(COQBIN)coqc\n"; print "GALLINA=gallina\n"; - print "COQDOC=coqdoc\n"; + print "COQDOC=$(COQBIN)coqdoc\n"; print "CAMLC=ocamlc -c\n"; print "CAMLOPTC=ocamlopt -c\n"; print "CAMLLINK=ocamlc\n"; diff --git a/tools/coqdep.ml b/tools/coqdep.ml index eb740712..6597c3f6 100644 --- a/tools/coqdep.ml +++ b/tools/coqdep.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: coqdep.ml 8642 2006-03-17 10:09:02Z notin $ *) +(* $Id: coqdep.ml 8923 2006-06-08 16:39:58Z herbelin $ *) open Printf open Coqdep_lexer @@ -162,8 +162,12 @@ let sort () = try while true do match coq_action lb with - | Require (_, s) -> - (try loop (List.assoc s !vKnown) with Not_found -> ()) + | Require (_, sl) -> + List.iter + (fun s -> + try loop (List.assoc s !vKnown) + with Not_found -> ()) + sl | RequireString (_, s) -> loop s | _ -> () done @@ -184,17 +188,18 @@ let traite_fichier_Coq verbose f = while true do let tok = coq_action buf in match tok with - | Require (spec,str) -> - if not (List.mem str !deja_vu_v) then begin - addQueue deja_vu_v str; - try - let file_str = safe_assoc verbose f str in - printf " %s%s" (canonize file_str) - (if spec then !suffixe_spec else !suffixe) - with Not_found -> - if verbose && not (List.mem_assoc str !coqlibKnown) then - warning_module_notfound f str - end + | Require (spec,strl) -> + List.iter (fun str -> + if not (List.mem str !deja_vu_v) then begin + addQueue deja_vu_v str; + try + let file_str = safe_assoc verbose f str in + printf " %s%s" (canonize file_str) + (if spec then !suffixe_spec else !suffixe) + with Not_found -> + if verbose && not (List.mem_assoc str !coqlibKnown) then + warning_module_notfound f str + end) strl | RequireString (spec,s) -> let str = Filename.basename s in if not (List.mem [str] !deja_vu_v) then begin @@ -332,7 +337,7 @@ let mL_dependencies () = flush stdout) (List.rev !mlAccu); List.iter - (fun ((name,ext,dirname) as pairname) -> + (fun ((name,ext,dirname)) -> let fullname = file_name ([name],dirname) in let (dep,_) = traite_fichier_ML fullname ext in printf "%s.cmi: %s%s" fullname fullname ext; diff --git a/tools/coqdep_lexer.mll b/tools/coqdep_lexer.mll index f7f37086..8ecab3b4 100755 --- a/tools/coqdep_lexer.mll +++ b/tools/coqdep_lexer.mll @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: coqdep_lexer.mll 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: coqdep_lexer.mll 8737 2006-04-26 21:55:21Z herbelin $ i*) { @@ -18,7 +18,7 @@ type spec = bool type coq_token = - | Require of spec * string list + | Require of spec * string list list | RequireString of spec * string | Declare of string list | Load of string @@ -27,7 +27,8 @@ exception Fin_fichier - let module_name = ref [] + let module_current_name = ref [] + let module_names = ref [] let ml_module_name = ref "" let specif = ref false @@ -48,13 +49,11 @@ let dot = '.' ( space+ | eof) rule coq_action = parse | "Require" space+ - { specif := false; opened_file lexbuf } + { specif := false; module_names := []; opened_file lexbuf } | "Require" space+ "Export" space+ - { specif := false; opened_file lexbuf} - | "Require" space+ "Syntax" space+ - { specif := false; opened_file lexbuf} + { specif := false; module_names := []; opened_file lexbuf} | "Require" space+ "Import" space+ - { specif := false; opened_file lexbuf} + { specif := false; module_names := []; opened_file lexbuf} | "Declare" space+ "ML" space+ "Module" space+ { mllist := []; modules lexbuf} | "Load" space+ @@ -175,7 +174,7 @@ and opened_file = parse | "Specification" { specif := true; opened_file lexbuf } | coq_ident - { module_name := [Lexing.lexeme lexbuf]; + { module_current_name := [Lexing.lexeme lexbuf]; opened_file_fields lexbuf } | '"' [^'"']* '"' { (*'"'*) @@ -186,23 +185,28 @@ and opened_file = parse Filename.chop_suffix str ".v" else str in RequireString (!specif, str) } - | eof { raise Fin_fichier } - | _ { opened_file lexbuf } + | eof { raise Fin_fichier } + | _ { opened_file lexbuf } and opened_file_fields = parse | "(*" (* "*)" *) { comment_depth := 1; comment lexbuf; opened_file_fields lexbuf } | space+ - { opened_file_fields lexbuf } + { opened_file_fields lexbuf } | coq_field - { module_name := - field_name (Lexing.lexeme lexbuf) :: !module_name; + { module_current_name := + field_name (Lexing.lexeme lexbuf) :: !module_current_name; opened_file_fields lexbuf } - | dot { Require (!specif, List.rev !module_name) } - | eof { raise Fin_fichier } - | _ { opened_file_fields lexbuf } - + | coq_ident { module_names := + List.rev !module_current_name :: !module_names; + module_current_name := [Lexing.lexeme lexbuf]; + opened_file_fields lexbuf } + | dot { module_names := + List.rev !module_current_name :: !module_names; + Require (!specif, List.rev !module_names) } + | eof { raise Fin_fichier } + | _ { opened_file_fields lexbuf } and modules = parse | space+ { modules lexbuf } diff --git a/tools/coqdoc/cdglobals.ml b/tools/coqdoc/cdglobals.ml index b5a4cb22..8a774876 100644 --- a/tools/coqdoc/cdglobals.ml +++ b/tools/coqdoc/cdglobals.ml @@ -44,6 +44,7 @@ let page_title = ref "" let title = ref "" let externals = ref true let coqlib = ref "http://coq.inria.fr/library/" +let coqlib_path = ref Coq_config.coqlib let raw_comments = ref false let charset = ref "iso-8859-1" @@ -69,4 +70,3 @@ type file = | Vernac_file of string * coq_module | Latex_file of string - diff --git a/tools/coqdoc/coqdoc.css b/tools/coqdoc/coqdoc.css index b59438e5..3900987e 100644 --- a/tools/coqdoc/coqdoc.css +++ b/tools/coqdoc/coqdoc.css @@ -28,16 +28,21 @@ body { padding: 0px 0px; #main a.idref:visited {color : #416DFF; text-decoration : none; } #main a.idref:link {color : #416DFF; text-decoration : none; } -#main a.idref:hover {color : Red; text-decoration : underline; } -#main a.idref:active {color : Red; text-decoration : underline; } +#main a.idref:hover {text-decoration : none; } +#main a.idref:active {text-decoration : none; } -#main .keyword { font-weight : bold; - color : Red } +#main a.modref:visited {color : #416DFF; text-decoration : none; } +#main a.modref:link {color : #416DFF; text-decoration : none; } +#main a.modref:hover {text-decoration : none; } +#main a.modref:active {text-decoration : none; } -#main .section { font-size : 20pt } +#main .keyword { color : #cf1d1d } +#main { color: black } + +#main .section { background-color:#899BD6; + font-size : 20pt } #main code { font-family: monospace; - font-size: 8pt; line-height: 50% } #main .doc { margin: 0px; @@ -45,10 +50,11 @@ body { padding: 0px 0px; font-family: sans-serif; font-size: 11pt; font-weight:bold; - background-color:#66ff66 } + color: black; + background-color: #90bdff; + border-style: plain} -#main .doc code { font-family: monospace; - font-size: 10pt} +#main .doc code { font-family: monospace} /* Pied de page */ @@ -56,4 +62,6 @@ body { padding: 0px 0px; font-family: sans-serif; } #footer a:visited { color: blue; } +#footer a:link { text-decoration: none; + color: #888888; } diff --git a/tools/coqdoc/index.mll b/tools/coqdoc/index.mll index ec89da2f..9b5716ff 100644 --- a/tools/coqdoc/index.mll +++ b/tools/coqdoc/index.mll @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: index.mll 8617 2006-03-08 10:47:12Z notin $ i*) +(*i $Id: index.mll 8863 2006-05-26 10:33:21Z notin $ i*) { @@ -34,11 +34,14 @@ type index_entry = | Ref of coq_module * string | Mod of coq_module * string -let table = Hashtbl.create 97 +let current_type = ref Library +let current_library = ref "" + (** referes to the file being parsed *) -let current_module = ref "" +let table = Hashtbl.create 97 + (** [table] is used to store references and definitions *) -let add_def loc ty id = Hashtbl.add table (!current_module, loc) (Def (id, ty)) +let add_def loc ty id = Hashtbl.add table (!current_library, loc) (Def (id, ty)) let add_ref m loc m' id = Hashtbl.add table (m, loc) (Ref (m', id)) @@ -46,7 +49,55 @@ let add_mod m loc m' id = Hashtbl.add table (m, loc) (Mod (m', id)) let find m l = Hashtbl.find table (m, l) -let current_type = ref Library + +(*s Manipulating path prefixes *) + +type stack = string list + +let rec string_of_stack st = + match st with + | [] -> "" + | x::[] -> x + | x::tl -> (string_of_stack tl) ^ "." ^ x + +let empty_stack = [] + +let module_stack = ref empty_stack +let section_stack = ref empty_stack + +let init_stack () = + module_stack := empty_stack; section_stack := empty_stack + +let push st p = st := p::!st +let pop st = + match !st with + | [] -> () + | _::tl -> st := tl + +let head st = + match st with + | [] -> "" + | x::_ -> x + +let begin_module m = push module_stack m +let begin_section s = push section_stack s + +let end_block id = + (** determines if it ends a module or a section and pops the stack *) + if ((String.compare (head !module_stack) id ) == 0) then + pop module_stack + else if ((String.compare (head !section_stack) id) == 0) then + pop section_stack + else + () + +let make_fullid id = + (** prepends the current module path to an id *) + let path = string_of_stack !module_stack in + if String.length path > 0 then + path ^ "." ^ id + else + id (* Coq modules *) @@ -83,7 +134,7 @@ let ref_module loc s = let n = String.length s in let i = String.rindex s ' ' in let id = String.sub s (i+1) (n-i-1) in - add_mod !current_module (loc+i+1) (Hashtbl.find modules id) id + add_mod !current_library (loc+i+1) (Hashtbl.find modules id) id with Not_found -> () @@ -104,25 +155,25 @@ let compare_entries (s1,_) (s2,_) = Alpha.compare_string s1 s2 let sort_entries el = let t = Hashtbl.create 97 in - List.iter - (fun c -> Hashtbl.add t c []) - ['A'; 'B'; 'C'; 'D'; 'E'; 'F'; 'G'; 'H'; 'I'; 'J'; 'K'; 'L'; 'M'; 'N'; - 'O'; 'P'; 'Q'; 'R'; 'S'; 'T'; 'U'; 'V'; 'W'; 'X'; 'Y'; 'Z'; '_']; - List.iter - (fun ((s,_) as e) -> - let c = Alpha.norm_char s.[0] in - let l = try Hashtbl.find t c with Not_found -> [] in - Hashtbl.replace t c (e :: l)) - el; - let res = ref [] in - Hashtbl.iter - (fun c l -> res := (c, List.sort compare_entries l) :: !res) t; - List.sort (fun (c1,_) (c2,_) -> Alpha.compare_char c1 c2) !res - + List.iter + (fun c -> Hashtbl.add t c []) + ['A'; 'B'; 'C'; 'D'; 'E'; 'F'; 'G'; 'H'; 'I'; 'J'; 'K'; 'L'; 'M'; 'N'; + 'O'; 'P'; 'Q'; 'R'; 'S'; 'T'; 'U'; 'V'; 'W'; 'X'; 'Y'; 'Z'; '_']; + List.iter + (fun ((s,_) as e) -> + let c = Alpha.norm_char s.[0] in + let l = try Hashtbl.find t c with Not_found -> [] in + Hashtbl.replace t c (e :: l)) + el; + let res = ref [] in + Hashtbl.iter + (fun c l -> res := (c, List.sort compare_entries l) :: !res) t; + List.sort (fun (c1,_) (c2,_) -> Alpha.compare_char c1 c2) !res + let index_size = List.fold_left (fun s (_,l) -> s + List.length l) 0 - + let hashtbl_elements h = Hashtbl.fold (fun x y l -> (x,y)::l) h [] - + let type_name = function | Library -> "library" | Module -> "module" @@ -133,28 +184,28 @@ let type_name = function | Variable -> "variable" | Axiom -> "axiom" | TacticDefinition -> "tactic" - + let all_entries () = let gl = ref [] in let add_g s m t = gl := (s,(m,t)) :: !gl in let bt = Hashtbl.create 11 in let add_bt t s m = let l = try Hashtbl.find bt t with Not_found -> [] in - Hashtbl.replace bt t ((s,m) :: l) + Hashtbl.replace bt t ((s,m) :: l) in let classify (m,_) e = match e with | Def (s,t) -> add_g s m t; add_bt t s m | Ref _ | Mod _ -> () in - Hashtbl.iter classify table; - Hashtbl.iter (fun id m -> add_g id m Library; add_bt Library id m) modules; - { idx_name = "global"; - idx_entries = sort_entries !gl; - idx_size = List.length !gl }, - Hashtbl.fold (fun t e l -> (t, { idx_name = type_name t; + Hashtbl.iter classify table; + Hashtbl.iter (fun id m -> add_g id m Library; add_bt Library id m) modules; + { idx_name = "global"; + idx_entries = sort_entries !gl; + idx_size = List.length !gl }, + Hashtbl.fold (fun t e l -> (t, { idx_name = type_name t; idx_entries = sort_entries e; idx_size = List.length e }) :: l) bt [] - + } (*s Shortcuts for regular expressions. *) @@ -165,15 +216,14 @@ let firstchar = ['$' 'A'-'Z' 'a'-'z' '_' '\192'-'\214' '\216'-'\246' '\248'-'\255'] let identchar = ['$' 'A'-'Z' 'a'-'z' '_' '\192'-'\214' '\216'-'\246' '\248'-'\255' - '\'' '0'-'9'] -let ident = - firstchar identchar* + '\'' '0'-'9'] +let ident = firstchar identchar* let begin_hide = "(*" space* "begin" space+ "hide" space* "*)" let end_hide = "(*" space* "end" space+ "hide" space* "*)" - + (*s Indexing entry point. *) - + rule traverse = parse | "Definition" space { current_type := Definition; index_ident lexbuf; traverse lexbuf } @@ -192,13 +242,15 @@ rule traverse = parse | "Record" space { current_type := Inductive; index_ident lexbuf; traverse lexbuf } | "Module" (space+ "Type")? space - { current_type := Module; index_ident lexbuf; traverse lexbuf } + { current_type := Module; module_ident lexbuf; traverse lexbuf } (*i*** | "Variable" 's'? space { current_type := Variable; index_idents lexbuf; traverse lexbuf } ***i*) | "Require" (space+ ("Export"|"Import"))? space+ ident { ref_module (lexeme_start lexbuf) (lexeme lexbuf); traverse lexbuf } + | "End" space+ + { end_ident lexbuf; traverse lexbuf } | begin_hide { skip_hide lexbuf; traverse lexbuf } | "(*" @@ -216,7 +268,16 @@ and index_ident = parse | space+ { index_ident lexbuf } | ident - { add_def (lexeme_start lexbuf) !current_type (lexeme lexbuf) } + { let fullid = + let id = lexeme lexbuf in + match !current_type with + | Definition + | Inductive + | Constructor + | Lemma -> make_fullid id + | _ -> id + in + add_def (lexeme_start lexbuf) !current_type fullid } | eof { () } | _ @@ -234,12 +295,12 @@ and index_idents = parse { () } | _ { skip_until_point lexbuf } - + (*s Index identifiers in an inductive definition (types and constructors). *) - + and inductive = parse | '|' | ":=" space* '|'? - { current_type := Constructor; index_ident lexbuf; inductive lexbuf } + { current_type := Constructor; index_ident lexbuf; inductive lexbuf } | "with" space { current_type := Inductive; index_ident lexbuf; inductive lexbuf } | '.' @@ -248,9 +309,9 @@ and inductive = parse { () } | _ { inductive lexbuf } - + (*s Index identifiers in a Fixpoint declaration. *) - + and fixpoint = parse | "with" space { index_ident lexbuf; fixpoint lexbuf } @@ -260,9 +321,9 @@ and fixpoint = parse { () } | _ { fixpoint lexbuf } - + (*s Skip a possibly nested comment. *) - + and comment = parse | "*)" { () } | "(*" { comment lexbuf; comment lexbuf } @@ -271,25 +332,48 @@ and comment = parse | _ { comment lexbuf } (*s Skip a constant string. *) - + and string = parse | '"' { () } | eof { eprintf " *** Unterminated string while indexing" } | _ { string lexbuf } (*s Skip everything until the next dot. *) - + and skip_until_point = parse | '.' { () } | eof { () } | _ { skip_until_point lexbuf } - + (*s Skip everything until [(* end hide *)] *) and skip_hide = parse | eof | end_hide { () } | _ { skip_hide lexbuf } +and end_ident = parse + | space+ + { end_ident lexbuf } + | ident + { let id = lexeme lexbuf in end_block id } + | eof + { () } + | _ + { () } + +and module_ident = parse + | space+ + { module_ident lexbuf } + | ident space* ":=" + { () } + | ident + { let id = lexeme lexbuf in + begin_module id; add_def (lexeme_start lexbuf) !current_type id } + | eof + { () } + | _ + { () } + { let read_glob f = @@ -306,10 +390,11 @@ and skip_hide = parse | 'R' -> (try let i = String.index s ' ' in + let j = String.index_from s (i+1) ' ' in let loc = int_of_string (String.sub s 1 (i - 1)) in - let sp = String.sub s (i + 1) (n - i - 1) in - let m',id = split_sp sp in - add_ref !cur_mod loc m' id + let lib_dp = String.sub s (i + 1) (j - i - 1) in + let full_id = String.sub s (j + 1) (n - j - 1) in + add_ref !cur_mod loc lib_dp full_id with Not_found -> ()) | _ -> () @@ -317,11 +402,11 @@ and skip_hide = parse done with End_of_file -> close_in c - + let scan_file f m = - current_module := m; + init_stack (); current_library := m; let c = open_in f in let lb = from_channel c in - traverse lb; - close_in c + traverse lb; + close_in c } diff --git a/tools/coqdoc/main.ml b/tools/coqdoc/main.ml index 177fc2bc..18a44a44 100644 --- a/tools/coqdoc/main.ml +++ b/tools/coqdoc/main.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: main.ml 8669 2006-03-28 17:34:15Z notin $ i*) +(*i $Id: main.ml 8777 2006-05-02 10:14:39Z notin $ i*) (* Modified by Lionel Elie Mamane <lionel@mamane.lu> on 9 & 10 Mar 2004: * - handling of absolute filenames (function coq_module) @@ -54,6 +54,7 @@ let usage () = prerr_endline " --no-externals no links to Coq standard library"; prerr_endline " --coqlib <url> set URL for Coq standard library"; prerr_endline " (default is http://coq.inria.fr/library/)"; + prerr_endline " --coqlib_path <dir> set the path where Coq files are installed"; prerr_endline " -R <dir> <coqdir> map physical dir to Coq dir"; prerr_endline " --latin1 set ISO-8859-1 input language"; prerr_endline " --utf8 set UTF-8 input language"; @@ -71,12 +72,12 @@ let banner () = eprintf "This is coqdoc version %s, compiled on %s\n" Coq_config.version Coq_config.compile_date; flush stderr - + let target_full_name f = match !target_language with | HTML -> f ^ ".html" | _ -> f ^ ".tex" - + (*s \textbf{Separation of files.} Files given on the command line are separated according to their type, which is determined by their suffix. Coq files have suffixe \verb!.v! or \verb!.g! and \LaTeX\ @@ -87,11 +88,11 @@ let check_if_file_exists f = eprintf "\ncoqdoc: %s: no such file\n" f; exit 1 end - + let paths = ref [] - + let add_path m l = paths := (m,l) :: !paths - + let exists_dir dir = try let _ = Unix.opendir dir in true with Unix.Unix_error _ -> false @@ -99,72 +100,72 @@ let add_rec_path f l = let rec traverse abs rel = add_path abs rel; let dirh = Unix.opendir abs in - try - while true do - let f = Unix.readdir dirh in - if f <> "" && f.[0] <> '.' && f <> "CVS" then - let abs' = Filename.concat abs f in - try - if exists_dir abs' then traverse abs' (rel ^ "." ^ f) - with Unix.Unix_error _ -> - () - done - with End_of_file -> - Unix.closedir dirh + try + while true do + let f = Unix.readdir dirh in + if f <> "" && f.[0] <> '.' && f <> "CVS" then + let abs' = Filename.concat abs f in + try + if exists_dir abs' then traverse abs' (rel ^ "." ^ f) + with Unix.Unix_error _ -> + () + done + with End_of_file -> + Unix.closedir dirh in - if exists_dir f then traverse f l + if exists_dir f then traverse f l (* turn A/B/C into A.B.C *) let make_path = Str.global_replace (Str.regexp "/") ".";; let coq_module file = -(* TODO - * LEM: - * We should also remove things like "/./" in the middle of the filename, - * rewrite "/foo/../bar" to "/bar", recognise different paths that lead - * to the same file / directory (via symlinks), etc. The best way to do - * all this would be to use the libc function realpath() on _both_ p and - * file / f before comparing them. - * - * The semantics of realpath() on file symlinks might not be what we - * want... (But it is what we want on directory symlinks.) So, we would - * have to cook up our own version of realpath()? - * - * Do all target platforms have realpath()? - *) + (* TODO + * LEM: + * We should also remove things like "/./" in the middle of the filename, + * rewrite "/foo/../bar" to "/bar", recognise different paths that lead + * to the same file / directory (via symlinks), etc. The best way to do + * all this would be to use the libc function realpath() on _both_ p and + * file / f before comparing them. + * + * The semantics of realpath() on file symlinks might not be what we + * want... (But it is what we want on directory symlinks.) So, we would + * have to cook up our own version of realpath()? + * + * Do all target platforms have realpath()? + *) let f = chop_extension file in - (* remove leading ./ and any number of slashes after *) + (* remove leading ./ and any number of slashes after *) let f = Str.replace_first (Str.regexp "^\\./+") "" f in - if (Str.string_before f 1) = "/" then - (* f is an absolute path. Prefixes must be matched with the beginning of f, - * not prepended - *) - let rec trypath = function - | [] -> make_path f - | (p, lg) :: r -> - (* make sure p ends with a single '/' - * This guarantees that we don't match a file whose name is - * of the form p ^ "foo". It means we may miss p itself, - * but this does not matter: coqdoc doesn't do anything - * of a directory anyway. *) - let p = (Str.replace_first (Str.regexp "/*$") "/" p) in - let p_quoted = (Str.quote p) in - if (Str.string_match (Str.regexp p_quoted) f 0) then - make_path (Filename.concat lg (Str.replace_first (Str.regexp (p_quoted ^ "/*")) "" f)) - else - trypath r - in trypath !paths - else (* f is a relative path *) - let rec trypath = function - | [] -> - make_path f - | (p,lg) :: r -> - let p_file = Filename.concat p file in - if Sys.file_exists p_file then - make_path (Filename.concat lg f) - else - trypath r - in trypath !paths;; + if (Str.string_before f 1) = "/" then + (* f is an absolute path. Prefixes must be matched with the beginning of f, + * not prepended + *) + let rec trypath = function + | [] -> make_path f + | (p, lg) :: r -> + (* make sure p ends with a single '/' + * This guarantees that we don't match a file whose name is + * of the form p ^ "foo". It means we may miss p itself, + * but this does not matter: coqdoc doesn't do anything + * of a directory anyway. *) + let p = (Str.replace_first (Str.regexp "/*$") "/" p) in + let p_quoted = (Str.quote p) in + if (Str.string_match (Str.regexp p_quoted) f 0) then + make_path (Filename.concat lg (Str.replace_first (Str.regexp (p_quoted ^ "/*")) "" f)) + else + trypath r + in trypath !paths + else (* f is a relative path *) + let rec trypath = function + | [] -> + make_path f + | (p,lg) :: r -> + let p_file = Filename.concat p file in + if Sys.file_exists p_file then + make_path (Filename.concat lg f) + else + trypath r + in trypath !paths;; let what_file f = check_if_file_exists f; @@ -176,43 +177,43 @@ let what_file f = eprintf "\ncoqdoc: don't know what to do with %s\n" f; exit 1 end - + (*s \textbf{Reading file names from a file.} - File names may be given - in a file instead of being given on the command - line. [(files_from_file f)] returns the list of file names contained - in the file named [f]. These file names must be separated by spaces, - tabulations or newlines. + * File names may be given + * in a file instead of being given on the command + * line. [(files_from_file f)] returns the list of file names contained + * in the file named [f]. These file names must be separated by spaces, + * tabulations or newlines. *) let files_from_file f = let files_from_channel ch = let buf = Buffer.create 80 in let l = ref [] in - try - while true do - match input_char ch with - | ' ' | '\t' | '\n' -> - if Buffer.length buf > 0 then l := (Buffer.contents buf) :: !l; - Buffer.clear buf - | c -> - Buffer.add_char buf c - done; [] - with End_of_file -> - List.rev !l + try + while true do + match input_char ch with + | ' ' | '\t' | '\n' -> + if Buffer.length buf > 0 then l := (Buffer.contents buf) :: !l; + Buffer.clear buf + | c -> + Buffer.add_char buf c + done; [] + with End_of_file -> + List.rev !l in - try - check_if_file_exists f; - let ch = open_in f in - let l = files_from_channel ch in - close_in ch;l - with Sys_error s -> begin - eprintf "\ncoqdoc: cannot read from file %s (%s)\n" f s; - exit 1 - end - + try + check_if_file_exists f; + let ch = open_in f in + let l = files_from_channel ch in + close_in ch;l + with Sys_error s -> begin + eprintf "\ncoqdoc: cannot read from file %s (%s)\n" f s; + exit 1 + end + (*s \textbf{Parsing of the command line.} *) - + let output_file = ref "" let dvi = ref false let ps = ref false @@ -222,9 +223,9 @@ let parse () = let add_file f = files := f :: !files in let rec parse_rec = function | [] -> () - + | ("-nopreamble" | "--nopreamble" | "--no-preamble" - | "-bodyonly" | "--bodyonly" | "--body-only") :: rem -> + | "-bodyonly" | "--bodyonly" | "--body-only") :: rem -> header_trailer := false; parse_rec rem | ("-p" | "--preamble") :: s :: rem -> push_in_preamble s; parse_rec rem @@ -239,7 +240,7 @@ let parse () = | ("-stdout" | "--stdout") :: rem -> out_to := StdOut; parse_rec rem | ("-o" | "--output") :: f :: rem -> - out_to := File f; parse_rec rem + out_to := File (Filename.basename f); output_dir := Filename.dirname f; parse_rec rem | ("-o" | "--output") :: [] -> usage () | ("-d" | "--directory") :: dir :: rem -> @@ -280,10 +281,10 @@ let parse () = Cdglobals.set_latin1 (); parse_rec rem | ("-utf8" | "--utf8") :: rem -> Cdglobals.set_utf8 (); parse_rec rem - + | ("-q" | "-quiet" | "--quiet") :: rem -> quiet := true; parse_rec rem - + | ("-h" | "-help" | "-?" | "--help") :: rem -> banner (); usage () | ("-v" | "-version" | "--version") :: _ -> @@ -317,13 +318,17 @@ let parse () = Cdglobals.coqlib := u; parse_rec rem | ("--coqlib" | "-coqlib") :: [] -> usage () + | ("--coqlib_path" | "-coqlib_path") :: d :: rem -> + Cdglobals.coqlib_path := d; parse_rec rem + | ("--coqlib_path" | "-coqlib_path") :: [] -> + usage () | f :: rem -> add_file (what_file f); parse_rec rem in - parse_rec (List.tl (Array.to_list Sys.argv)); - List.rev !files - + parse_rec (List.tl (Array.to_list Sys.argv)); + List.rev !files + (*s The following function produces the output. The default output is the \LaTeX\ document: in that case, we just call [Web.produce_document]. If option \verb!-dvi!, \verb!-ps! or \verb!-html! is invoked, then @@ -331,41 +336,41 @@ let parse () = let locally dir f x = let cwd = Sys.getcwd () in - try - Sys.chdir dir; let y = f x in Sys.chdir cwd; y - with e -> - Sys.chdir cwd; raise e + try + Sys.chdir dir; let y = f x in Sys.chdir cwd; y + with e -> + Sys.chdir cwd; raise e let clean_temp_files basefile = let remove f = try Sys.remove f with _ -> () in - remove (basefile ^ ".tex"); - remove (basefile ^ ".log"); - remove (basefile ^ ".aux"); - remove (basefile ^ ".dvi"); - remove (basefile ^ ".ps"); - remove (basefile ^ ".haux"); - remove (basefile ^ ".html") - + remove (basefile ^ ".tex"); + remove (basefile ^ ".log"); + remove (basefile ^ ".aux"); + remove (basefile ^ ".dvi"); + remove (basefile ^ ".ps"); + remove (basefile ^ ".haux"); + remove (basefile ^ ".html") + let clean_and_exit file res = clean_temp_files file; exit res - + let cat file = let c = open_in file in - try - while true do print_char (input_char c) done - with End_of_file -> - close_in c + try + while true do print_char (input_char c) done + with End_of_file -> + close_in c let copy src dst = let cin = open_in src and cout = open_out dst in - try - while true do Pervasives.output_char cout (input_char cin) done - with End_of_file -> - close_in cin; close_out cout + try + while true do Pervasives.output_char cout (input_char cin) done + with End_of_file -> + close_in cin; close_out cout (*s Functions for generating output files *) - + let gen_one_file l = let file = function | Vernac_file (f,m) -> @@ -416,15 +421,15 @@ let gen_mult_files l = let index_module = function | Vernac_file (_,m) -> Index.add_module m | Latex_file _ -> () - + let produce_document l = List.iter index_module l; (if !target_language=HTML then - let src = (Filename.concat Coq_config.coqlib "/tools/coqdoc/coqdoc.css") in + let src = (Filename.concat !Cdglobals.coqlib_path "/tools/coqdoc/coqdoc.css") in let dst = if !output_dir <> "" then Filename.concat !output_dir "coqdoc.css" else "coqdoc.css" in copy src dst); (if !target_language=LaTeX then - let src = (Filename.concat Coq_config.coqlib "/tools/coqdoc/coqdoc.sty") in + let src = (Filename.concat !Cdglobals.coqlib_path "/tools/coqdoc/coqdoc.sty") in let dst = if !output_dir <> "" then Filename.concat !output_dir "coqdoc.sty" else "coqdoc.sty" in @@ -439,7 +444,7 @@ let produce_document l = close_out_file() | MultFiles -> gen_mult_files l - + let produce_output fl = if not (!dvi || !ps) then begin produce_document fl @@ -493,7 +498,7 @@ let produce_output fl = let main () = let files = parse () in - if not !quiet then banner (); - if files <> [] then produce_output files - + if not !quiet then banner (); + if files <> [] then produce_output files + let _ = Printexc.catch main () diff --git a/tools/coqdoc/output.ml b/tools/coqdoc/output.ml index 4c4cf5ec..e6a0a72b 100644 --- a/tools/coqdoc/output.ml +++ b/tools/coqdoc/output.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: output.ml 8669 2006-03-28 17:34:15Z notin $ i*) +(*i $Id: output.ml 8863 2006-05-26 10:33:21Z notin $ i*) open Cdglobals open Index @@ -336,12 +336,12 @@ module Html = struct raw_ident s i*) - let ident_ref m s = match find_module m with + let ident_ref m fid s = match find_module m with | Local -> - printf "<a class=\"idref\" href=\"%s.html#%s\">" m s; raw_ident s; printf "</a>" + printf "<a class=\"idref\" href=\"%s.html#%s\">" m fid; raw_ident s; printf "</a>" | Coqlib when !externals -> let m = Filename.concat !coqlib m in - printf "<a class=\"idref\" href=\"%s.html#%s\">" m s; raw_ident s; printf "</a>" + printf "<a class=\"idref\" href=\"%s.html#%s\">" m fid; raw_ident s; printf "</a>" | Coqlib | Unknown -> raw_ident s @@ -351,18 +351,20 @@ module Html = struct raw_ident s; printf "</span>" end else - try - (match Index.find !current_module loc with - | Def _ -> - printf "<a name=\"%s\"></a>" s; raw_ident s - | Mod (m,s') when s = s' -> - module_ref m s - | Ref (m,s') when s = s' -> - ident_ref m s - | Mod _ | Ref _ -> - raw_ident s) - with Not_found -> - raw_ident s + begin + try + (match Index.find !current_module loc with + | Def (fullid,_) -> + printf "<a name=\"%s\"></a>" fullid; raw_ident s + | Mod (m,s') when s = s' -> + module_ref m s + | Ref (m,fullid) -> + ident_ref m fullid s + | Mod _ | Ref _ -> + raw_ident s) + with Not_found -> + raw_ident s + end let with_html_printing f tok = try diff --git a/tools/coqdoc/pretty.mll b/tools/coqdoc/pretty.mll index ad9057ad..5c6c7952 100644 --- a/tools/coqdoc/pretty.mll +++ b/tools/coqdoc/pretty.mll @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: pretty.mll 8666 2006-03-27 17:02:49Z notin $ i*) +(*i $Id: pretty.mll 8861 2006-05-24 15:52:15Z notin $ i*) (*s Utility functions for the scanners *) @@ -173,8 +173,11 @@ let firstchar = (* utf-8 letterlike symbols *) '\226' ('\132' ['\128'-'\191'] | '\133' ['\128'-'\143']) let identchar = - firstchar | ['\'' '0'-'9' '@'] -let identifier = firstchar identchar* + firstchar | ['\'' '0'-'9' '@' ] +let id = firstchar identchar* +let pfx_id = (id '.')* +let identifier = + id | pfx_id id let symbolchar_no_brackets = ['!' '$' '%' '&' '*' '+' ',' '@' '^' '#' diff --git a/toplevel/command.ml b/toplevel/command.ml index 7ff1b1b5..56a32f04 100644 --- a/toplevel/command.ml +++ b/toplevel/command.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: command.ml 8689 2006-04-07 20:20:16Z herbelin $ *) +(* $Id: command.ml 8875 2006-05-29 19:59:11Z msozeau $ *) open Pp open Util @@ -112,7 +112,7 @@ let constant_entry_of_com (bl,com,comtypopt,opacity,boxed) = | Some comtyp -> (* We use a cast to avoid troubles with evars in comtyp *) (* that can only be resolved knowing com *) - let b = abstract_constr_expr (mkCastC (com,DEFAULTcast,comtyp)) bl in + let b = abstract_constr_expr (mkCastC (com, Rawterm.CastConv DEFAULTcast,comtyp)) bl in let (body,typ) = destSubCast (interp_constr sigma env b) in { const_entry_body = body; const_entry_type = Some typ; @@ -219,7 +219,7 @@ let declare_one_elimination ind = let elim_scheme = Indrec.build_indrec env sigma ind in let npars = mib.mind_nparams_rec in let make_elim s = Indrec.instantiate_indrec_scheme s npars elim_scheme in - let kelim = mip.mind_kelim in + let kelim = elim_sorts (mib,mip) in (* in case the inductive has a type elimination, generates only one induction scheme, the other ones share the same code with the apropriate type *) @@ -457,7 +457,9 @@ let build_recursive (lnameargsardef:(fixpoint_expr *decl_notation) list) let lrecnames = List.map (fun ((f,_,_,_,_),_) -> f) lnameargsardef and sigma = Evd.empty and env0 = Global.env() - and nv = Array.of_list (List.map (fun ((_,n,_,_,_),_) -> n) lnameargsardef) in + and nv = Array.of_list (List.map (fun ((_,n,_,_,_),_) -> n) lnameargsardef) + and bl = Array.of_list (List.map (fun ((_,_,bl,_,_),_) -> bl) lnameargsardef) + in (* Build the recursive context and notations for the recursive types *) let (rec_sign,rec_impls,arityl) = List.fold_left @@ -502,9 +504,24 @@ let build_recursive (lnameargsardef:(fixpoint_expr *decl_notation) list) let recvec = Array.map (subst_vars (List.rev (Array.to_list namerec))) defrec in let recdecls = (Array.map (fun id -> Name id) namerec, arrec, recvec) in + let nvrec = Array.mapi + (fun i (n,_) -> match n with + | Some n -> n + | None -> + (* Recursive argument was not given by the user : + We check that there is only one inductive argument *) + let ctx = snd (interp_context sigma env0 bl.(i)) in + let isIndApp t = isInd (fst (decompose_app (strip_head_cast t))) in + (* This could be more precise (e.g. do some delta) *) + let lb = List.rev_map (fun (_,_,t) -> isIndApp t) ctx in + try (list_unique_index true lb) - 1 + with Not_found -> + error "the recursive argument needs to be specified") + nvrec + in let rec declare i fi = let ce = - { const_entry_body = mkFix ((Array.map fst nvrec,i),recdecls); (* ignore rec order *) + { const_entry_body = mkFix ((nvrec,i),recdecls); (* ignore rec order *) const_entry_type = Some arrec.(i); const_entry_opaque = false; const_entry_boxed = boxed} in diff --git a/toplevel/coqtop.ml b/toplevel/coqtop.ml index c3f79e0a..6d65ccc2 100644 --- a/toplevel/coqtop.ml +++ b/toplevel/coqtop.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: coqtop.ml 7740 2005-12-26 20:07:21Z herbelin $ *) +(* $Id: coqtop.ml 8932 2006-06-09 09:29:03Z notin $ *) open Pp open Util @@ -108,14 +108,16 @@ let add_compile verbose s = compile_list := (verbose,s) :: !compile_list let compile_files () = let init_state = States.freeze() in - List.iter - (fun (v,f) -> - States.unfreeze init_state; - if Options.do_translate () then - with_option translate_file (Vernac.compile v) f - else - Vernac.compile v f) - (List.rev !compile_list) + let coqdoc_init_state = Constrintern.coqdoc_freeze () in + List.iter + (fun (v,f) -> + States.unfreeze init_state; + Constrintern.coqdoc_unfreeze coqdoc_init_state; + if Options.do_translate () then + with_option translate_file (Vernac.compile v) f + else + Vernac.compile v f) + (List.rev !compile_list) let re_exec_version = ref "" let set_byte () = re_exec_version := "byte" @@ -172,7 +174,11 @@ let ide_args = ref [] let parse_args is_ide = let rec parse = function | [] -> () - + | "-with-geoproof" :: s :: rem -> + if s = "yes" then Coq_config.with_geoproof := true + else if s = "no" then Coq_config.with_geoproof := false + else usage (); + parse rem | "-impredicative-set" :: rem -> set_engagement Declarations.ImpredicativeSet; parse rem @@ -242,9 +248,9 @@ let parse_args is_ide = | "-debug" :: rem -> set_debug (); parse rem | "-vm" :: rem -> use_vm := true; parse rem - | "-emacs" :: rem -> Options.print_emacs := true; parse rem + | "-emacs" :: rem -> Options.print_emacs := true; Pp.make_pp_emacs(); parse rem - | "-where" :: _ -> print_endline Coq_config.coqlib; exit 0 + | "-where" :: _ -> print_endline (getenv_else "COQLIB" Coq_config.coqlib); exit 0 | ("-quiet"|"-silent") :: rem -> Options.make_silent true; parse rem diff --git a/toplevel/discharge.ml b/toplevel/discharge.ml index 6c543079..c011ba52 100644 --- a/toplevel/discharge.ml +++ b/toplevel/discharge.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: discharge.ml 7493 2005-11-02 22:12:16Z mohring $ *) +(* $Id: discharge.ml 8845 2006-05-23 07:41:58Z herbelin $ *) open Names open Util @@ -73,7 +73,7 @@ let process_inductive sechyps modlist mib = let inds = array_map_to_list (fun mip -> - let arity = expmod_constr modlist mip.mind_user_arity in + let arity = expmod_constr modlist (Termops.refresh_universes (Inductive.type_of_inductive (mib,mip))) in let lc = Array.map (expmod_constr modlist) mip.mind_user_lc in (mip.mind_typename, arity, diff --git a/toplevel/himsg.ml b/toplevel/himsg.ml index 3fe51b5a..73aaef30 100644 --- a/toplevel/himsg.ml +++ b/toplevel/himsg.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: himsg.ml 8005 2006-02-07 22:50:35Z herbelin $ *) +(* $Id: himsg.ml 8845 2006-05-23 07:41:58Z herbelin $ *) open Pp open Util @@ -81,14 +81,14 @@ let rec pr_disjunction pr = function | a::l -> pr a ++ str "," ++ spc () ++ pr_disjunction pr l | [] -> assert false -let explain_elim_arity ctx ind aritylst c pj okinds = +let explain_elim_arity ctx ind sorts c pj okinds = let ctx = make_all_name_different ctx in let pi = pr_inductive ctx ind in let pc = pr_lconstr_env ctx c in let msg = match okinds with | Some(kp,ki,explanation) -> - let pki = pr_lconstr_env ctx ki in - let pkp = pr_lconstr_env ctx kp in + let pki = pr_sort_family ki in + let pkp = pr_sort_family kp in let explanation = match explanation with | NonInformativeToInformative -> "proofs can be eliminated only to build proofs" @@ -107,13 +107,10 @@ let explain_elim_arity ctx ind aritylst c pj okinds = hov 0 ( str "Incorrect elimination of" ++ spc() ++ pc ++ spc () ++ str "in the inductive type " ++ spc() ++ quote pi ++ - (let sorts = List.map (fun x -> mkSort (new_sort_in_family x)) - (list_uniquize (List.map (fun ar -> - family_of_sort (destSort (snd (decompose_prod_assum ar)))) aritylst)) in - let ppar = pr_disjunction (pr_lconstr_env ctx) sorts in - let ppt = pr_lconstr_env ctx (snd (decompose_prod_assum pj.uj_type)) in - str "," ++ spc() ++ str "the return type has sort" ++ spc() ++ ppt ++ - spc () ++ str "while it should be " ++ ppar)) + (let ppar = pr_disjunction (fun s -> quote (pr_sort_family s)) sorts in + let ppt = pr_lconstr_env ctx (snd (decompose_prod_assum pj.uj_type)) in + str "," ++ spc() ++ str "the return type has sort" ++ spc() ++ ppt ++ + spc () ++ str "while it should be " ++ ppar)) ++ fnl () ++ msg let explain_case_not_inductive ctx cj = @@ -565,14 +562,14 @@ let error_bad_entry () = let error_not_allowed_case_analysis dep kind i = str (if dep then "Dependent" else "Non Dependent") ++ - str " case analysis on sort: " ++ print_sort kind ++ fnl () ++ + str " case analysis on sort: " ++ pr_sort kind ++ fnl () ++ str "is not allowed for inductive definition: " ++ pr_inductive (Global.env()) i let error_bad_induction dep indid kind = str (if dep then "Dependent" else "Non dependent") ++ str " induction for type " ++ pr_id indid ++ - str " and sort " ++ print_sort kind ++ spc () ++ + str " and sort " ++ pr_sort kind ++ spc () ++ str "is not allowed" let error_not_mutual_in_scheme () = diff --git a/toplevel/minicoq.ml b/toplevel/minicoq.ml index 490765a4..a3b51a11 100644 --- a/toplevel/minicoq.ml +++ b/toplevel/minicoq.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: minicoq.ml 5920 2004-07-16 20:01:26Z herbelin $ *) +(* $Id: minicoq.ml 8752 2006-04-27 19:37:33Z herbelin $ *) open Pp open Util @@ -54,7 +54,7 @@ let check c = let definition id ty c = let c = globalize [] c in - let ty = option_app (globalize []) ty in + let ty = option_map (globalize []) ty in let ce = { const_entry_body = c; const_entry_type = ty } in let sp = make_path [] id CCI in env := add_constant sp ce (locals()) !env; diff --git a/toplevel/record.ml b/toplevel/record.ml index b24e85da..9eeeb51e 100644 --- a/toplevel/record.ml +++ b/toplevel/record.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: record.ml 7941 2006-01-28 23:07:59Z herbelin $ *) +(* $Id: record.ml 8875 2006-05-29 19:59:11Z msozeau $ *) open Pp open Util @@ -36,7 +36,7 @@ let interp_decl sigma env = function | Vernacexpr.DefExpr((_,id),c,t) -> let c = match t with | None -> c - | Some t -> mkCastC (c,DEFAULTcast,t) + | Some t -> mkCastC (c, Rawterm.CastConv DEFAULTcast,t) in let j = interp_constr_judgment Evd.empty env c in (id,Some j.uj_val, j.uj_type) diff --git a/toplevel/toplevel.ml b/toplevel/toplevel.ml index a5c2564c..95c1b7d9 100644 --- a/toplevel/toplevel.ml +++ b/toplevel/toplevel.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: toplevel.ml 6947 2005-04-20 16:18:41Z coq $ *) +(* $Id: toplevel.ml 8748 2006-04-27 16:01:26Z courtieu $ *) open Pp open Util @@ -47,9 +47,12 @@ let resynch_buffer ibuf = ibuf.start <- ibuf.start + ll | _ -> () + (* Read a char in an input channel, displaying a prompt at every beginning of line. *) +let emacs_prompt_endstring = String.make 1 (Char.chr 249) + let prompt_char ic ibuf count = let bol = match ibuf.bols with | ll::_ -> ibuf.len == ll @@ -204,7 +207,6 @@ let make_prompt () = *) let make_emacs_prompt() = let statnum = string_of_int (Lib.current_command_label ()) in - let endchar = String.make 1 (Char.chr 249) in let dpth = Pfedit.current_proof_depth() in let pending = Pfedit.get_all_proof_names() in let pendingprompt = @@ -212,7 +214,7 @@ let make_emacs_prompt() = (fun acc x -> acc ^ (if acc <> "" then "|" else "") ^ Names.string_of_id x) "" pending in let proof_info = if dpth >= 0 then string_of_int dpth else "0" in - statnum ^ " |" ^ pendingprompt ^ "| " ^ proof_info ^ " < " ^ endchar + statnum ^ " |" ^ pendingprompt ^ "| " ^ proof_info ^ " < " ^ emacs_prompt_endstring (* A buffer to store the current command read on stdin. It is * initialized when a vernac command is immediately followed by "\n", diff --git a/toplevel/usage.ml b/toplevel/usage.ml index 354aff0b..782fdc80 100644 --- a/toplevel/usage.ml +++ b/toplevel/usage.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: usage.ml 6053 2004-09-03 14:33:35Z herbelin $ *) +(* $Id: usage.ml 8932 2006-06-09 09:29:03Z notin $ *) let version () = Printf.printf "The Coq Proof Assistant, version %s (%s)\n" @@ -54,6 +54,7 @@ let print_usage_channel co command = -boot boot mode (implies -q and -batch) -emacs tells Coq it is executed under Emacs -dump-glob f dump globalizations in file f (to be used by coqdoc) + -with-geoproof (yes|no) to (de)activate special functions for Geoproof within Coqide (default is yes) -impredicative-set set sort Set impredicative -dont-load-proofs don't load opaque proofs in memory -xml export XML files either to the hierarchy rooted in diff --git a/toplevel/vernac.ml b/toplevel/vernac.ml index 64d77b74..afe72f0f 100644 --- a/toplevel/vernac.ml +++ b/toplevel/vernac.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: vernac.ml 7744 2005-12-27 09:16:06Z herbelin $ *) +(* $Id: vernac.ml 8924 2006-06-08 17:49:01Z notin $ *) (* Parsing of vernacular. *) @@ -126,27 +126,30 @@ let rec vernac_com interpfun (loc,com) = (* end translator state *) (* coqdoc state *) let cds = Constrintern.coqdoc_freeze() in - if !Options.translate_file then begin - let _,f = find_file_in_path (Library.get_load_paths ()) - (make_suffix fname ".v") in - chan_translate := open_out (f^"8"); - Pp.comments := [] - end; - begin try - read_vernac_file verbosely (make_suffix fname ".v"); - if !Options.translate_file then close_out !chan_translate; - chan_translate := ch; - Lexer.restore_com_state cs; - Pp.comments := cl; - Constrintern.coqdoc_unfreeze cds; - with e -> - if !Options.translate_file then close_out !chan_translate; - chan_translate := ch; - Lexer.restore_com_state cs; - Pp.comments := cl; - Constrintern.coqdoc_unfreeze cds; - raise e end; - + if !Options.translate_file then + begin + let _,f = find_file_in_path (Library.get_load_paths ()) + (make_suffix fname ".v") in + chan_translate := open_out (f^"8"); + Pp.comments := [] + end; + begin + try + read_vernac_file verbosely (make_suffix fname ".v"); + if !Options.translate_file then close_out !chan_translate; + chan_translate := ch; + Lexer.restore_com_state cs; + Pp.comments := cl; + Constrintern.coqdoc_unfreeze cds + with e -> + if !Options.translate_file then close_out !chan_translate; + chan_translate := ch; + Lexer.restore_com_state cs; + Pp.comments := cl; + Constrintern.coqdoc_unfreeze cds; + raise e + end + | VernacList l -> List.iter (fun (_,v) -> interp v) l | VernacTime v -> diff --git a/toplevel/vernacentries.ml b/toplevel/vernacentries.ml index 7394bd8f..033fb0e6 100644 --- a/toplevel/vernacentries.ml +++ b/toplevel/vernacentries.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: vernacentries.ml 8700 2006-04-11 23:14:15Z courtieu $ i*) +(*i $Id: vernacentries.ml 8751 2006-04-27 16:17:51Z courtieu $ i*) (* Concrete syntax of the mathematical vernacular MV V2.6 *) @@ -345,7 +345,7 @@ let vernac_start_proof kind sopt (bl,t) lettop hook = let vernac_end_proof = function | Admitted -> admit () | Proved (is_opaque,idopt) -> - if_verbose show_script (); + if not !Options.print_emacs then if_verbose show_script (); match idopt with | None -> save_named is_opaque | Some ((_,id),None) -> save_anonymous is_opaque id diff --git a/toplevel/vernacentries.mli b/toplevel/vernacentries.mli index a2bcd990..bcd89490 100644 --- a/toplevel/vernacentries.mli +++ b/toplevel/vernacentries.mli @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: vernacentries.mli 6616 2005-01-21 17:18:23Z herbelin $ i*) +(*i $Id: vernacentries.mli 8781 2006-05-03 10:15:05Z jforest $ i*) (*i*) open Names @@ -52,3 +52,5 @@ val set_pcoq_hook : pcoq_hook -> unit val abort_refine : ('a -> unit) -> 'a -> unit;; val interp : Vernacexpr.vernac_expr -> unit + +val vernac_reset_name : identifier Util.located -> unit |