diff options
| author |  barras <barras@85f007b7-540e-0410-9357-904b9bb8a0f7> | 2006-09-26 11:18:22 +0000 |
|---|---|---|
| committer | barras <barras@85f007b7-540e-0410-9357-904b9bb8a0f7> | 2006-09-26 11:18:22 +0000 |
| commit | 351a500eada776832ac9b09657e42f5d6cd7210f (patch) | |
| tree | af45a745540e1154eab8955c17e03cbbe2e6b878 | |
| parent | 5155de9ee4bd01127a57c36cebbd01c5d903d048 (diff) | |
mise a jour du nouveau ring et ajout du nouveau field, avant renommages
git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@9178 85f007b7-540e-0410-9357-904b9bb8a0f7
73 files changed, 2008 insertions, 2248 deletions
@@ -2500,14 +2500,12 @@ contrib/cc/cctac.cmx: lib/util.cmx pretyping/termops.cmx kernel/term.cmx \ contrib/cc/cctac.cmi 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 + 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.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 + 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 @@ -2814,24 +2812,24 @@ 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 \ + 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 \ + 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 \ @@ -3266,16 +3264,14 @@ contrib/interface/dad.cmx: toplevel/vernacinterp.cmx toplevel/vernacexpr.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 + 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: 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 + 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 contrib/interface/history.cmx: contrib/interface/paths.cmx \ @@ -3386,16 +3382,16 @@ 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/extraargs.cmi \ - parsing/extend.cmi tactics/eauto.cmi library/decl_kinds.cmo \ - lib/bigint.cmi contrib/interface/ascent.cmi contrib/interface/xlate.cmi + interp/genarg.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: 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/extraargs.cmx \ - parsing/extend.cmx tactics/eauto.cmx library/decl_kinds.cmx \ - lib/bigint.cmx contrib/interface/ascent.cmi contrib/interface/xlate.cmi + interp/genarg.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: lib/pp.cmi contrib/jprover/opname.cmi \ contrib/jprover/jtunify.cmi contrib/jprover/jterm.cmi \ contrib/jprover/jlogic.cmi contrib/jprover/jall.cmi @@ -3499,23 +3495,23 @@ contrib/recdef/recdef.cmx: toplevel/vernacinterp.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 \ + proofs/tacexpr.cmo 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 \ +contrib/ring/g_quote.cmx: lib/util.cmx tactics/tacinterp.cmx \ + proofs/tacexpr.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/tacticals.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/tacticals.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 \ @@ -3599,28 +3595,32 @@ contrib/rtauto/refl_tauto.cmx: lib/util.cmx pretyping/termops.cmx \ kernel/environ.cmx interp/coqlib.cmx kernel/closure.cmx \ contrib/rtauto/refl_tauto.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 \ + pretyping/typing.cmi interp/topconstr.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/reductionops.cmi pretyping/rawterm.cmi contrib/ring/quote.cmo \ proofs/proof_type.cmi parsing/printer.cmi pretyping/pretyping.cmi \ - parsing/pptactic.cmi parsing/ppconstr.cmi lib/pp.cmi parsing/pcoq.cmi \ + parsing/pptactic.cmi lib/pp.cmi parsing/pcoq.cmi library/nametab.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 \ + library/libnames.cmi library/lib.cmi parsing/lexer.cmi library/global.cmi \ + interp/genarg.cmi pretyping/evd.cmi kernel/esubst.cmi kernel/environ.cmi \ + kernel/entries.cmi parsing/egrammar.cmi library/declare.cmi \ + library/decl_kinds.cmo 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 \ + pretyping/typing.cmx interp/topconstr.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/reductionops.cmx pretyping/rawterm.cmx contrib/ring/quote.cmx \ proofs/proof_type.cmx parsing/printer.cmx pretyping/pretyping.cmx \ - parsing/pptactic.cmx parsing/ppconstr.cmx lib/pp.cmx parsing/pcoq.cmx \ + parsing/pptactic.cmx lib/pp.cmx parsing/pcoq.cmx library/nametab.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 \ + library/libnames.cmx library/lib.cmx parsing/lexer.cmx library/global.cmx \ + interp/genarg.cmx pretyping/evd.cmx kernel/esubst.cmx kernel/environ.cmx \ + kernel/entries.cmx parsing/egrammar.cmx library/declare.cmx \ + library/decl_kinds.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 @@ -4107,74 +4107,66 @@ 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/3.09.1/caml/config.h \ - /usr/lib/ocaml/3.09.1/caml/compatibility.h \ - /usr/lib/ocaml/3.09.1/caml/misc.h /usr/lib/ocaml/3.09.1/caml/config.h \ - /usr/lib/ocaml/3.09.1/caml/mlvalues.h /usr/lib/ocaml/3.09.1/caml/misc.h \ - /usr/lib/ocaml/3.09.1/caml/fail.h /usr/lib/ocaml/3.09.1/caml/mlvalues.h \ - /usr/lib/ocaml/3.09.1/caml/memory.h kernel/byterun/coq_instruct.h \ + /usr/lib/ocaml/caml/config.h /usr/lib/ocaml/caml/compatibility.h \ + /usr/lib/ocaml/caml/misc.h /usr/lib/ocaml/caml/config.h \ + /usr/lib/ocaml/caml/mlvalues.h /usr/lib/ocaml/caml/misc.h \ + /usr/lib/ocaml/caml/fail.h /usr/lib/ocaml/caml/mlvalues.h \ + /usr/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/3.09.1/caml/mlvalues.h \ - /usr/lib/ocaml/3.09.1/caml/compatibility.h \ - /usr/lib/ocaml/3.09.1/caml/config.h /usr/lib/ocaml/3.09.1/caml/misc.h \ - /usr/lib/ocaml/3.09.1/caml/alloc.h \ - /usr/lib/ocaml/3.09.1/caml/mlvalues.h kernel/byterun/coq_instruct.h \ - kernel/byterun/coq_fix_code.h kernel/byterun/coq_memory.h \ - /usr/lib/ocaml/3.09.1/caml/config.h /usr/lib/ocaml/3.09.1/caml/fail.h \ - /usr/lib/ocaml/3.09.1/caml/misc.h /usr/lib/ocaml/3.09.1/caml/memory.h \ - kernel/byterun/coq_values.h kernel/byterun/coq_jumptbl.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 /usr/lib/ocaml/caml/mlvalues.h \ + kernel/byterun/coq_instruct.h kernel/byterun/coq_fix_code.h \ + kernel/byterun/coq_memory.h /usr/lib/ocaml/caml/config.h \ + /usr/lib/ocaml/caml/fail.h /usr/lib/ocaml/caml/misc.h \ + /usr/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/3.09.1/caml/mlvalues.h \ - /usr/lib/ocaml/3.09.1/caml/compatibility.h \ - /usr/lib/ocaml/3.09.1/caml/config.h /usr/lib/ocaml/3.09.1/caml/misc.h \ - /usr/lib/ocaml/3.09.1/caml/alloc.h \ - /usr/lib/ocaml/3.09.1/caml/mlvalues.h kernel/byterun/coq_instruct.h \ - kernel/byterun/coq_fix_code.h kernel/byterun/coq_memory.h \ - /usr/lib/ocaml/3.09.1/caml/config.h /usr/lib/ocaml/3.09.1/caml/fail.h \ - /usr/lib/ocaml/3.09.1/caml/misc.h /usr/lib/ocaml/3.09.1/caml/memory.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 /usr/lib/ocaml/caml/mlvalues.h \ + kernel/byterun/coq_instruct.h kernel/byterun/coq_fix_code.h \ + kernel/byterun/coq_memory.h /usr/lib/ocaml/caml/config.h \ + /usr/lib/ocaml/caml/fail.h /usr/lib/ocaml/caml/misc.h \ + /usr/lib/ocaml/caml/memory.h coq_values.o: kernel/byterun/coq_values.c kernel/byterun/coq_fix_code.h \ - /usr/lib/ocaml/3.09.1/caml/mlvalues.h \ - /usr/lib/ocaml/3.09.1/caml/compatibility.h \ - /usr/lib/ocaml/3.09.1/caml/config.h /usr/lib/ocaml/3.09.1/caml/misc.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 \ kernel/byterun/coq_instruct.h kernel/byterun/coq_memory.h \ - /usr/lib/ocaml/3.09.1/caml/config.h /usr/lib/ocaml/3.09.1/caml/fail.h \ - /usr/lib/ocaml/3.09.1/caml/mlvalues.h /usr/lib/ocaml/3.09.1/caml/misc.h \ - /usr/lib/ocaml/3.09.1/caml/memory.h kernel/byterun/coq_values.h \ - /usr/lib/ocaml/3.09.1/caml/alloc.h + /usr/lib/ocaml/caml/config.h /usr/lib/ocaml/caml/fail.h \ + /usr/lib/ocaml/caml/mlvalues.h /usr/lib/ocaml/caml/misc.h \ + /usr/lib/ocaml/caml/memory.h kernel/byterun/coq_values.h \ + /usr/lib/ocaml/caml/alloc.h coq_fix_code.d.o: kernel/byterun/coq_fix_code.c \ - /usr/lib/ocaml/3.09.1/caml/config.h \ - /usr/lib/ocaml/3.09.1/caml/compatibility.h \ - /usr/lib/ocaml/3.09.1/caml/misc.h /usr/lib/ocaml/3.09.1/caml/config.h \ - /usr/lib/ocaml/3.09.1/caml/mlvalues.h /usr/lib/ocaml/3.09.1/caml/misc.h \ - /usr/lib/ocaml/3.09.1/caml/fail.h /usr/lib/ocaml/3.09.1/caml/mlvalues.h \ - /usr/lib/ocaml/3.09.1/caml/memory.h kernel/byterun/coq_instruct.h \ + /usr/lib/ocaml/caml/config.h /usr/lib/ocaml/caml/compatibility.h \ + /usr/lib/ocaml/caml/misc.h /usr/lib/ocaml/caml/config.h \ + /usr/lib/ocaml/caml/mlvalues.h /usr/lib/ocaml/caml/misc.h \ + /usr/lib/ocaml/caml/fail.h /usr/lib/ocaml/caml/mlvalues.h \ + /usr/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/3.09.1/caml/mlvalues.h \ - /usr/lib/ocaml/3.09.1/caml/compatibility.h \ - /usr/lib/ocaml/3.09.1/caml/config.h /usr/lib/ocaml/3.09.1/caml/misc.h \ - /usr/lib/ocaml/3.09.1/caml/alloc.h \ - /usr/lib/ocaml/3.09.1/caml/mlvalues.h kernel/byterun/coq_instruct.h \ - kernel/byterun/coq_fix_code.h kernel/byterun/coq_memory.h \ - /usr/lib/ocaml/3.09.1/caml/config.h /usr/lib/ocaml/3.09.1/caml/fail.h \ - /usr/lib/ocaml/3.09.1/caml/misc.h /usr/lib/ocaml/3.09.1/caml/memory.h \ - kernel/byterun/coq_values.h kernel/byterun/coq_jumptbl.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 /usr/lib/ocaml/caml/mlvalues.h \ + kernel/byterun/coq_instruct.h kernel/byterun/coq_fix_code.h \ + kernel/byterun/coq_memory.h /usr/lib/ocaml/caml/config.h \ + /usr/lib/ocaml/caml/fail.h /usr/lib/ocaml/caml/misc.h \ + /usr/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/3.09.1/caml/mlvalues.h \ - /usr/lib/ocaml/3.09.1/caml/compatibility.h \ - /usr/lib/ocaml/3.09.1/caml/config.h /usr/lib/ocaml/3.09.1/caml/misc.h \ - /usr/lib/ocaml/3.09.1/caml/alloc.h \ - /usr/lib/ocaml/3.09.1/caml/mlvalues.h kernel/byterun/coq_instruct.h \ - kernel/byterun/coq_fix_code.h kernel/byterun/coq_memory.h \ - /usr/lib/ocaml/3.09.1/caml/config.h /usr/lib/ocaml/3.09.1/caml/fail.h \ - /usr/lib/ocaml/3.09.1/caml/misc.h /usr/lib/ocaml/3.09.1/caml/memory.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 /usr/lib/ocaml/caml/mlvalues.h \ + kernel/byterun/coq_instruct.h kernel/byterun/coq_fix_code.h \ + kernel/byterun/coq_memory.h /usr/lib/ocaml/caml/config.h \ + /usr/lib/ocaml/caml/fail.h /usr/lib/ocaml/caml/misc.h \ + /usr/lib/ocaml/caml/memory.h coq_values.d.o: kernel/byterun/coq_values.c kernel/byterun/coq_fix_code.h \ - /usr/lib/ocaml/3.09.1/caml/mlvalues.h \ - /usr/lib/ocaml/3.09.1/caml/compatibility.h \ - /usr/lib/ocaml/3.09.1/caml/config.h /usr/lib/ocaml/3.09.1/caml/misc.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 \ kernel/byterun/coq_instruct.h kernel/byterun/coq_memory.h \ - /usr/lib/ocaml/3.09.1/caml/config.h /usr/lib/ocaml/3.09.1/caml/fail.h \ - /usr/lib/ocaml/3.09.1/caml/mlvalues.h /usr/lib/ocaml/3.09.1/caml/misc.h \ - /usr/lib/ocaml/3.09.1/caml/memory.h kernel/byterun/coq_values.h \ - /usr/lib/ocaml/3.09.1/caml/alloc.h + /usr/lib/ocaml/caml/config.h /usr/lib/ocaml/caml/fail.h \ + /usr/lib/ocaml/caml/mlvalues.h /usr/lib/ocaml/caml/misc.h \ + /usr/lib/ocaml/caml/memory.h kernel/byterun/coq_values.h \ + /usr/lib/ocaml/caml/alloc.h diff --git a/.depend.coq b/.depend.coq index 17de70f70..af7a8d9ca 100644 --- a/.depend.coq +++ b/.depend.coq @@ -21,14 +21,14 @@ theories/FSets/FMapWeakFacts.vo: theories/FSets/FMapWeakFacts.v theories/Bool/Bo 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/FMapPositive.vo: theories/FSets/FMapPositive.v theories/Bool/Bool.vo 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 +theories/Reals/RIneq.vo: theories/Reals/RIneq.v theories/Reals/Raxioms.vo contrib/setoid_ring/NewZArithRing.vo contrib/omega/Omega.vo contrib/setoid_ring/Field_tac.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/Reals/R_Ifp.vo: theories/Reals/R_Ifp.v theories/Reals/Rbase.vo contrib/omega/Omega.vo @@ -36,8 +36,8 @@ theories/Reals/Rbasic_fun.vo: theories/Reals/Rbasic_fun.v theories/Reals/Rbase.v 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/ArithProp.vo: theories/Reals/ArithProp.v theories/Reals/Rbase.vo theories/Reals/Rbasic_fun.vo theories/Arith/Even.vo theories/Arith/Div2.vo contrib/setoid_ring/NewArithRing.vo +theories/Reals/Rfunctions.vo: theories/Reals/Rfunctions.v contrib/ring/ArithRing.vo contrib/setoid_ring/NewArithRing.vo 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 @@ -173,14 +173,14 @@ 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 theories/ZArith/Zpower.vo: theories/ZArith/Zpower.v theories/ZArith/ZArith_base.vo contrib/omega/Omega.vo theories/ZArith/Zcomplements.vo -theories/ZArith/Zcomplements.vo: theories/ZArith/Zcomplements.v contrib/ring/ZArithRing.vo theories/ZArith/ZArith_base.vo contrib/omega/Omega.vo theories/Arith/Wf_nat.vo theories/Lists/List.vo -theories/ZArith/Zdiv.vo: theories/ZArith/Zdiv.v theories/ZArith/ZArith_base.vo theories/ZArith/Zbool.vo contrib/omega/Omega.vo contrib/ring/ZArithRing.vo theories/ZArith/Zcomplements.vo -theories/ZArith/Zsqrt.vo: theories/ZArith/Zsqrt.v contrib/omega/Omega.vo theories/ZArith/ZArith_base.vo contrib/ring/ZArithRing.vo +theories/ZArith/Zcomplements.vo: theories/ZArith/Zcomplements.v contrib/setoid_ring/NewZArithRing.vo theories/ZArith/ZArith_base.vo contrib/omega/Omega.vo theories/Arith/Wf_nat.vo theories/Lists/List.vo +theories/ZArith/Zdiv.vo: theories/ZArith/Zdiv.v theories/ZArith/ZArith_base.vo theories/ZArith/Zbool.vo contrib/omega/Omega.vo contrib/setoid_ring/NewZArithRing.vo theories/ZArith/Zcomplements.vo +theories/ZArith/Zsqrt.vo: theories/ZArith/Zsqrt.v contrib/setoid_ring/NewZArithRing.vo contrib/omega/Omega.vo theories/ZArith/ZArith_base.vo theories/ZArith/Zwf.vo: theories/ZArith/Zwf.v theories/ZArith/ZArith_base.vo theories/Arith/Wf_nat.vo contrib/omega/Omega.vo theories/ZArith/ZArith_base.vo: theories/ZArith/ZArith_base.v theories/NArith/BinPos.vo theories/NArith/BinNat.vo theories/ZArith/BinInt.vo theories/ZArith/Zcompare.vo theories/ZArith/Zorder.vo theories/ZArith/Zeven.vo theories/ZArith/Zmin.vo theories/ZArith/Zmax.vo theories/ZArith/Zminmax.vo theories/ZArith/Zabs.vo theories/ZArith/Znat.vo theories/ZArith/auxiliary.vo theories/ZArith/ZArith_dec.vo theories/ZArith/Zbool.vo theories/ZArith/Zmisc.vo theories/ZArith/Wf_Z.vo theories/ZArith/Zhints.vo 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/NArith/Ndigits.vo theories/Arith/Wf_nat.vo +theories/ZArith/Znumtheory.vo: theories/ZArith/Znumtheory.v theories/ZArith/ZArith_base.vo contrib/setoid_ring/NewZArithRing.vo theories/ZArith/Zcomplements.vo theories/ZArith/Zdiv.vo theories/NArith/Ndigits.vo theories/Arith/Wf_nat.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 @@ -236,7 +236,7 @@ theories/FSets/FMapWeakFacts.vo: theories/FSets/FMapWeakFacts.v theories/Bool/Bo 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/FMapPositive.vo: theories/FSets/FMapPositive.v theories/Bool/Bool.vo 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 @@ -271,29 +271,77 @@ theories/Wellfounded/Well_Ordering.vo: theories/Wellfounded/Well_Ordering.v theo theories/Wellfounded/Lexicographic_Product.vo: theories/Wellfounded/Lexicographic_Product.v theories/Logic/Eqdep.vo theories/Relations/Relation_Operators.vo theories/Wellfounded/Transitive_Closure.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 +theories/Reals/RIneq.vo: theories/Reals/RIneq.v theories/Reals/Raxioms.vo contrib/setoid_ring/NewZArithRing.vo contrib/omega/Omega.vo contrib/setoid_ring/Field_tac.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/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 contrib/setoid_ring/NewArithRing.vo +theories/Reals/Rfunctions.vo: theories/Reals/Rfunctions.v contrib/ring/ArithRing.vo contrib/setoid_ring/NewArithRing.vo 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/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/QArith_base.vo: theories/QArith/QArith_base.v theories/ZArith/ZArith.vo contrib/setoid_ring/NewZArithRing.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/Qring.vo: theories/QArith/Qring.v contrib/setoid_ring/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 -theories/QArith/Qcanon.vo: theories/QArith/Qcanon.v theories/QArith/QArith.vo theories/Logic/Eqdep_dec.vo contrib/field/Field.vo +theories/QArith/Qcanon.vo: theories/QArith/Qcanon.v contrib/setoid_ring/NewField.vo contrib/setoid_ring/Field_tac.vo theories/QArith/QArith.vo theories/ZArith/Znumtheory.vo theories/Logic/Eqdep_dec.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 contrib/romega/ROmega.vo: contrib/romega/ROmega.v contrib/romega/ReflOmegaCore.vo -contrib/ring/ArithRing.vo: contrib/ring/ArithRing.v contrib/ring/Ring.vo theories/Arith/Arith.vo theories/Logic/Eqdep_dec.vo +contrib/ring/ArithRing.vo: contrib/ring/ArithRing.v theories/Bool/Bool.vo contrib/ring/LegacyRing.vo theories/Arith/Arith.vo theories/Logic/Eqdep_dec.vo contrib/ring/Ring_normalize.vo: contrib/ring/Ring_normalize.v contrib/ring/Ring_theory.vo contrib/ring/Quote.vo contrib/ring/Ring_theory.vo: contrib/ring/Ring_theory.v theories/Bool/Bool.vo -contrib/ring/Ring.vo: contrib/ring/Ring.v theories/Bool/Bool.vo contrib/ring/Ring_theory.vo contrib/ring/Quote.vo contrib/ring/Ring_normalize.vo contrib/ring/Ring_abstract.vo -contrib/ring/NArithRing.vo: contrib/ring/NArithRing.v contrib/ring/Ring.vo theories/ZArith/ZArith_base.vo theories/NArith/NArith.vo theories/Logic/Eqdep_dec.vo +contrib/ring/LegacyRing.vo: contrib/ring/LegacyRing.v theories/Bool/Bool.vo contrib/ring/Ring_theory.vo contrib/ring/Quote.vo contrib/ring/Ring_normalize.vo contrib/ring/Ring_abstract.vo +contrib/ring/NArithRing.vo: contrib/ring/NArithRing.v theories/Bool/Bool.vo contrib/ring/LegacyRing.vo theories/ZArith/ZArith_base.vo theories/NArith/NArith.vo theories/Logic/Eqdep_dec.vo contrib/ring/ZArithRing.vo: contrib/ring/ZArithRing.v contrib/ring/ArithRing.vo theories/ZArith/ZArith_base.vo theories/Logic/Eqdep_dec.vo contrib/ring/Ring_abstract.vo: contrib/ring/Ring_abstract.v contrib/ring/Ring_theory.vo contrib/ring/Quote.vo contrib/ring/Ring_normalize.vo contrib/ring/Quote.vo: contrib/ring/Quote.v @@ -301,18 +349,27 @@ contrib/ring/Setoid_ring_normalize.vo: contrib/ring/Setoid_ring_normalize.v cont 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 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/field/Field_Theory.vo: contrib/field/Field_Theory.v theories/Lists/List.vo theories/Arith/Peano_dec.vo contrib/ring/LegacyRing.vo contrib/field/Field_Compl.vo +contrib/field/Field_Tactic.vo: contrib/field/Field_Tactic.v theories/Lists/List.vo contrib/setoid_ring/Ring.vo contrib/field/Field_Compl.vo contrib/field/Field_Theory.vo +contrib/field/LegacyField.vo: contrib/field/LegacyField.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/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/LegacyField.vo theories/Reals/DiscrR.vo contrib/subtac/FixSub.vo: contrib/subtac/FixSub.v theories/Init/Wf.vo theories/Arith/Wf_nat.vo theories/Arith/Lt.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 -contrib/setoid_ring/BinList.vo: contrib/setoid_ring/BinList.v theories/NArith/BinPos.vo +contrib/setoid_ring/BinList.vo: contrib/setoid_ring/BinList.v theories/NArith/BinPos.vo theories/Lists/List.vo contrib/setoid_ring/Ring_th.vo: contrib/setoid_ring/Ring_th.v theories/Setoids/Setoid.vo contrib/setoid_ring/Pol.vo: contrib/setoid_ring/Pol.v theories/Setoids/Setoid.vo contrib/setoid_ring/BinList.vo theories/NArith/BinPos.vo theories/ZArith/BinInt.vo contrib/setoid_ring/Ring_th.vo -contrib/setoid_ring/Ring_tac.vo: contrib/setoid_ring/Ring_tac.v theories/Setoids/Setoid.vo contrib/setoid_ring/BinList.vo theories/NArith/BinPos.vo contrib/setoid_ring/Pol.vo contrib/setoid_ring/newring.cmo -contrib/setoid_ring/ZRing_th.vo: contrib/setoid_ring/ZRing_th.v contrib/setoid_ring/Ring_th.vo contrib/setoid_ring/Pol.vo contrib/setoid_ring/Ring_tac.vo theories/ZArith/ZArith_base.vo theories/ZArith/BinInt.vo theories/NArith/BinNat.vo theories/Setoids/Setoid.vo +contrib/setoid_ring/Ring_tac.vo: contrib/setoid_ring/Ring_tac.v theories/Setoids/Setoid.vo theories/NArith/BinPos.vo contrib/setoid_ring/Pol.vo contrib/setoid_ring/BinList.vo contrib/setoid_ring/newring.cmo +contrib/setoid_ring/ZRing_th.vo: contrib/setoid_ring/ZRing_th.v theories/ZArith/ZArith_base.vo theories/ZArith/BinInt.vo theories/NArith/BinNat.vo theories/Setoids/Setoid.vo contrib/setoid_ring/Ring_base.vo contrib/setoid_ring/Pol.vo +contrib/setoid_ring/Ring_equiv.vo: contrib/setoid_ring/Ring_equiv.v contrib/ring/Ring_theory.vo contrib/ring/Setoid_ring_theory.vo contrib/setoid_ring/Ring_th.vo +contrib/setoid_ring/Ring_base.vo: contrib/setoid_ring/Ring_base.v contrib/setoid_ring/newring.cmo contrib/setoid_ring/Ring_th.vo contrib/setoid_ring/Ring_tac.vo +contrib/setoid_ring/Ring.vo: contrib/setoid_ring/Ring.v theories/Bool/Bool.vo contrib/setoid_ring/Ring_th.vo contrib/setoid_ring/Ring_base.vo contrib/setoid_ring/ZRing_th.vo contrib/setoid_ring/Ring_equiv.vo +contrib/setoid_ring/NewArithRing.vo: contrib/setoid_ring/NewArithRing.v theories/Arith/Arith.vo contrib/setoid_ring/Ring.vo +contrib/setoid_ring/NewNArithRing.vo: contrib/setoid_ring/NewNArithRing.v theories/NArith/NArith.vo contrib/setoid_ring/Ring.vo +contrib/setoid_ring/NewZArithRing.vo: contrib/setoid_ring/NewZArithRing.v contrib/setoid_ring/Ring.vo +contrib/setoid_ring/NewField.vo: contrib/setoid_ring/NewField.v contrib/setoid_ring/Pol.vo theories/NArith/BinPos.vo contrib/setoid_ring/Ring.vo theories/ZArith/ZArith_base.vo contrib/setoid_ring/ZRing_th.vo +contrib/setoid_ring/Field_tac.vo: contrib/setoid_ring/Field_tac.v contrib/setoid_ring/Ring_tac.vo contrib/setoid_ring/ZRing_th.vo contrib/setoid_ring/NewField.vo +contrib/setoid_ring/RealField.vo: contrib/setoid_ring/RealField.v contrib/setoid_ring/Pol.vo contrib/setoid_ring/ZRing_th.vo contrib/setoid_ring/NewField.vo contrib/setoid_ring/Field_tac.vo contrib/setoid_ring/Ring.vo theories/Reals/Rdefinitions.vo theories/Reals/Raxioms.vo theories/Reals/RIneq.vo @@ -63,6 +63,11 @@ Tactics setoid_symmetry, setoid_transitivity, setoid_reflexivity and autorewite). New syntax for declaring relations and morphisms (old syntax still working with minor modifications, but deprecated). +- New implementation of the ring tactic with a built-in notion of coefficients + and a better usage of setoids. Previous implementation kept for compatibility + but is deprecated. +- New conversion tactic "vm_compute": evaluates the goal (or an hypothesis) + with a call-by-value strategy, using the compiled version of terms. - 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 @@ -317,10 +317,10 @@ ML4FILES += contrib/jprover/jprover.ml4 contrib/cc/g_congruence.ml4 \ contrib/funind/indfun_main.ml4 -CONTRIB=$(OMEGACMO) $(ROMEGACMO) $(RINGCMO) $(DPCMO) $(FIELDCMO) \ +CONTRIB=$(OMEGACMO) $(ROMEGACMO) $(RINGCMO) $(NEWRINGCMO) $(DPCMO) $(FIELDCMO) \ $(FOURIERCMO) $(EXTRACTIONCMO) $(JPROVERCMO) $(XMLCMO) \ $(CCCMO) $(FOCMO) $(SUBTACCMO) $(RTAUTOCMO) \ - $(RECDEFCMO) $(FUNINDCMO) $(NEWRINGCMO) + $(RECDEFCMO) $(FUNINDCMO) CMA=$(CLIBS) $(CAMLP4OBJS) CMXA=$(CMA:.cma=.cmxa) @@ -426,7 +426,7 @@ COQMKTOPCMX=config/coq_config.cmx scripts/tolink.cmx scripts/coqmktop.cmx $(COQMKTOPBYTE): $(COQMKTOPCMO) $(SHOW)'OCAMLC -o $@' - $(HIDE)$(OCAMLC) $(BYTEFLAGS) -o $@ -custom str.cma unix.cma \ + $(HIDE)$(OCAMLC) $(BYTEFLAGS) -o $@ str.cma unix.cma \ $(COQMKTOPCMO) $(OSDEPLIBS) $(COQMKTOPOPT): $(COQMKTOPCMX) @@ -454,7 +454,7 @@ COQCCMX=config/coq_config.cmx toplevel/usage.cmx scripts/coqc.cmx $(COQCBYTE): $(COQCCMO) $(COQTOPBYTE) $(BESTCOQTOP) $(SHOW)'OCAMLC -o $@' - $(HIDE)$(OCAMLC) $(BYTEFLAGS) -o $@ -custom unix.cma $(COQCCMO) $(OSDEPLIBS) + $(HIDE)$(OCAMLC) $(BYTEFLAGS) -o $@ unix.cma $(COQCCMO) $(OSDEPLIBS) $(COQCOPT): $(COQCCMX) $(COQTOPOPT) $(BESTCOQTOP) $(SHOW)'OCAMLOPT -o $@' @@ -754,14 +754,14 @@ PARSERCODE=contrib/interface/line_parser.cmo contrib/interface/vtp.cmo \ PARSERCMO=$(PARSERREQUIRES) $(PARSERCODE) PARSERCMX= $(PARSERREQUIRESCMX) $(PARSERCODE:.cmo=.cmx) -bin/parser$(EXE): $(PARSERCMO) +bin/parser$(EXE):$(LIBCOQRUN) $(PARSERCMO) $(SHOW)'OCAMLC -o $@' - $(HIDE)$(OCAMLC) -linkall -custom -cclib -lunix $(BYTEFLAGS) -o $@ \ - dynlink.cma $(CMA) $(PARSERCMO) + $(HIDE)$(OCAMLC) -custom -linkall $(BYTEFLAGS) -o $@ \ + dynlink.cma $(LIBCOQRUN) $(CMA) $(PARSERCMO) -bin/parser.opt$(EXE): $(PARSERCMX) +bin/parser.opt$(EXE): $(LIBCOQRUN) $(PARSERCMX) $(SHOW)'OCAMLOPT -o $@' - $(HIDE)$(OCAMLOPT) -linkall -cclib -lunix $(OPTFLAGS) -o $@ \ + $(HIDE)$(OCAMLOPT) -linkall $(OPTFLAGS) -o $@ \ $(LIBCOQRUN) $(CMXA) $(PARSERCMX) INTERFACEVO= @@ -1036,7 +1036,7 @@ ROMEGAVO=\ RINGVO=\ contrib/ring/ArithRing.vo contrib/ring/Ring_normalize.vo \ - contrib/ring/Ring_theory.vo contrib/ring/Ring.vo \ + contrib/ring/Ring_theory.vo contrib/ring/LegacyRing.vo \ contrib/ring/NArithRing.vo \ contrib/ring/ZArithRing.vo contrib/ring/Ring_abstract.vo \ contrib/ring/Quote.vo contrib/ring/Setoid_ring_normalize.vo \ @@ -1045,11 +1045,18 @@ RINGVO=\ NEWRINGVO=\ contrib/setoid_ring/BinList.vo contrib/setoid_ring/Ring_th.vo \ contrib/setoid_ring/Pol.vo contrib/setoid_ring/Ring_tac.vo \ - contrib/setoid_ring/ZRing_th.vo + contrib/setoid_ring/ZRing_th.vo contrib/setoid_ring/Ring_equiv.vo \ + contrib/setoid_ring/Ring_base.vo contrib/setoid_ring/Ring.vo \ + contrib/setoid_ring/NewArithRing.vo \ + contrib/setoid_ring/NewNArithRing.vo \ + contrib/setoid_ring/NewZArithRing.vo \ +contrib/setoid_ring/NewField.vo \ +contrib/setoid_ring/Field_tac.vo \ +contrib/setoid_ring/RealField.vo FIELDVO=\ contrib/field/Field_Compl.vo contrib/field/Field_Theory.vo \ - contrib/field/Field_Tactic.vo contrib/field/Field.vo + contrib/field/Field_Tactic.vo contrib/field/LegacyField.vo XMLVO= @@ -1156,7 +1163,7 @@ COQDEPCMO=config/coq_config.cmo tools/coqdep_lexer.cmo tools/coqdep.cmo $(COQDEP): $(COQDEPCMO) $(SHOW)'OCAMLC -o $@' - $(HIDE)$(OCAMLC) $(BYTEFLAGS) -custom -o $@ unix.cma $(COQDEPCMO) $(OSDEPLIBS) + $(HIDE)$(OCAMLC) $(BYTEFLAGS) -o $@ unix.cma $(COQDEPCMO) $(OSDEPLIBS) beforedepend:: tools/coqdep_lexer.ml $(COQDEP) @@ -1164,23 +1171,23 @@ GALLINACMO=tools/gallina_lexer.cmo tools/gallina.cmo $(GALLINA): $(GALLINACMO) $(SHOW)'OCAMLC -o $@' - $(HIDE)$(OCAMLC) $(BYTEFLAGS) -custom -o $@ $(GALLINACMO) + $(HIDE)$(OCAMLC) $(BYTEFLAGS) -o $@ $(GALLINACMO) beforedepend:: tools/gallina_lexer.ml $(COQMAKEFILE): tools/coq_makefile.cmo $(SHOW)'OCAMLC -o $@' - $(HIDE)$(OCAMLC) $(BYTEFLAGS) -custom -o $@ tools/coq_makefile.cmo + $(HIDE)$(OCAMLC) $(BYTEFLAGS) -o $@ tools/coq_makefile.cmo $(COQTEX): tools/coq-tex.cmo $(SHOW)'OCAMLC -o $@' - $(HIDE)$(OCAMLC) $(BYTEFLAGS) -custom -o $@ str.cma tools/coq-tex.cmo + $(HIDE)$(OCAMLC) $(BYTEFLAGS) -o $@ str.cma tools/coq-tex.cmo beforedepend:: tools/coqwc.ml $(COQWC): tools/coqwc.cmo $(SHOW)'OCAMLC -o $@' - $(HIDE)$(OCAMLC) $(BYTEFLAGS) -custom -o $@ tools/coqwc.cmo + $(HIDE)$(OCAMLC) $(BYTEFLAGS) -o $@ tools/coqwc.cmo beforedepend:: tools/coqdoc/pretty.ml tools/coqdoc/index.ml @@ -1190,7 +1197,7 @@ COQDOCCMO=$(CONFIG) tools/coqdoc/cdglobals.cmo tools/coqdoc/alpha.cmo \ $(COQDOC): $(COQDOCCMO) $(SHOW)'OCAMLC -o $@' - $(HIDE)$(OCAMLC) $(BYTEFLAGS) -custom -o $@ str.cma unix.cma $(COQDOCCMO) + $(HIDE)$(OCAMLC) $(BYTEFLAGS) -o $@ str.cma unix.cma $(COQDOCCMO) clean:: rm -f tools/coqdep_lexer.ml tools/gallina_lexer.ml @@ -1212,7 +1219,7 @@ MINICOQ=bin/minicoq$(EXE) $(MINICOQ): $(MINICOQCMO) $(SHOW)'OCAMLC -o $@' - $(HIDE)$(OCAMLC) $(BYTEFLAGS) -o $@ -custom $(CMA) $(MINICOQCMO) $(OSDEPLIBS) + $(HIDE)$(OCAMLC) $(BYTEFLAGS) -o $@ $(CMA) $(MINICOQCMO) $(OSDEPLIBS) archclean:: rm -f $(MINICOQ) diff --git a/contrib/field/Field_Tactic.v b/contrib/field/Field_Tactic.v index fb6a31e99..9298736d0 100644 --- a/contrib/field/Field_Tactic.v +++ b/contrib/field/Field_Tactic.v @@ -9,7 +9,7 @@ (* $Id$ *) Require Import List. -Require Import Ring. +Require Import LegacyRing. Require Export Field_Compl. Require Export Field_Theory. @@ -289,11 +289,12 @@ Ltac field_gen_aux FT := apply_simplif ltac:(apply_inverse mul); let id := grep_mult in clear id; weak_reduce; clear ft vm; first - [ inverse_test FT; ring | field_gen_aux FT ] + [ inverse_test FT; legacy ring | field_gen_aux FT ] | idtac ] ]) end. -Ltac field_gen FT := unfolds FT; (inverse_test FT; ring) || field_gen_aux FT. +Ltac field_gen FT := + unfolds FT; (inverse_test FT; legacy ring) || field_gen_aux FT. (*****************************) (* Term Simplification *) @@ -429,4 +430,4 @@ Ltac field_term FT exp := simpl_all_monomials ltac:(assoc_distrib ltac:(simpl_all_monomials ltac:(simpl_inv tma))) in let trep := eval_weak_reduce (interp_ExprA FT lvar tsmp) in - (replace exp with trep; [ ring trep | field_gen FT ]). + (replace exp with trep; [ legacy ring trep | field_gen FT ]). diff --git a/contrib/field/Field_Theory.v b/contrib/field/Field_Theory.v index 5fe69ddca..74d97f163 100644 --- a/contrib/field/Field_Theory.v +++ b/contrib/field/Field_Theory.v @@ -10,7 +10,7 @@ Require Import List. Require Import Peano_dec. -Require Import Ring. +Require Import LegacyRing. Require Import Field_Compl. Record Field_Theory : Type := @@ -88,10 +88,10 @@ Let AinvT := Ainv T. Let RTT := RT T. Let Th_inv_defT := Th_inv_def T. -Add Abstract Ring (A T) (Aplus T) (Amult T) (Aone T) ( +Add Legacy Abstract Ring (A T) (Aplus T) (Amult T) (Aone T) ( Azero T) (Aopp T) (Aeq T) (RT T). -Add Abstract Ring AT AplusT AmultT AoneT AzeroT AoppT AeqT RTT. +Add Legacy Abstract Ring AT AplusT AmultT AoneT AzeroT AoppT AeqT RTT. (***************************) (* Lemmas to be used *) @@ -99,55 +99,55 @@ Add Abstract Ring AT AplusT AmultT AoneT AzeroT AoppT AeqT RTT. Lemma AplusT_sym : forall r1 r2:AT, AplusT r1 r2 = AplusT r2 r1. Proof. - intros; ring. + intros; legacy ring. Qed. Lemma AplusT_assoc : forall r1 r2 r3:AT, AplusT (AplusT r1 r2) r3 = AplusT r1 (AplusT r2 r3). Proof. - intros; ring. + intros; legacy ring. Qed. Lemma AmultT_sym : forall r1 r2:AT, AmultT r1 r2 = AmultT r2 r1. Proof. - intros; ring. + intros; legacy ring. Qed. Lemma AmultT_assoc : forall r1 r2 r3:AT, AmultT (AmultT r1 r2) r3 = AmultT r1 (AmultT r2 r3). Proof. - intros; ring. + intros; legacy ring. Qed. Lemma AplusT_Ol : forall r:AT, AplusT AzeroT r = r. Proof. - intros; ring. + intros; legacy ring. Qed. Lemma AmultT_1l : forall r:AT, AmultT AoneT r = r. Proof. - intros; ring. + intros; legacy ring. Qed. Lemma AplusT_AoppT_r : forall r:AT, AplusT r (AoppT r) = AzeroT. Proof. - intros; ring. + intros; legacy ring. Qed. Lemma AmultT_AplusT_distr : forall r1 r2 r3:AT, AmultT r1 (AplusT r2 r3) = AplusT (AmultT r1 r2) (AmultT r1 r3). Proof. - intros; ring. + intros; legacy ring. Qed. Lemma r_AplusT_plus : forall r r1 r2:AT, AplusT r r1 = AplusT r r2 -> r1 = r2. Proof. intros; transitivity (AplusT (AplusT (AoppT r) r) r1). - ring. + legacy ring. transitivity (AplusT (AplusT (AoppT r) r) r2). repeat rewrite AplusT_assoc; rewrite <- H; reflexivity. - ring. + legacy ring. Qed. Lemma r_AmultT_mult : @@ -162,17 +162,17 @@ Qed. Lemma AmultT_Or : forall r:AT, AmultT r AzeroT = AzeroT. Proof. - intro; ring. + intro; legacy ring. Qed. Lemma AmultT_Ol : forall r:AT, AmultT AzeroT r = AzeroT. Proof. - intro; ring. + intro; legacy ring. Qed. Lemma AmultT_1r : forall r:AT, AmultT r AoneT = r. Proof. - intro; ring. + intro; legacy ring. Qed. Lemma AinvT_r : forall r:AT, r <> AzeroT -> AmultT r (AinvT r) = AoneT. @@ -183,7 +183,7 @@ Qed. Lemma Rmult_neq_0_reg : forall r1 r2:AT, AmultT r1 r2 <> AzeroT -> r1 <> AzeroT /\ r2 <> AzeroT. Proof. - intros r1 r2 H; split; red in |- *; intro; apply H; rewrite H0; ring. + intros r1 r2 H; split; red in |- *; intro; apply H; rewrite H0; legacy ring. Qed. (************************) @@ -276,7 +276,7 @@ Lemma merge_mult_correct : interp_ExprA lvar (merge_mult e1 e2) = interp_ExprA lvar (EAmult e1 e2). Proof. simple induction e1; auto; intros. -elim e0; try (intros; simpl in |- *; ring). +elim e0; try (intros; simpl in |- *; legacy ring). unfold interp_ExprA in H2; fold interp_ExprA in H2; cut (AmultT (interp_ExprA lvar e2) @@ -286,8 +286,8 @@ unfold interp_ExprA in H2; fold interp_ExprA in H2; (AmultT (AmultT (interp_ExprA lvar e) (interp_ExprA lvar e4)) (interp_ExprA lvar e2)) (interp_ExprA lvar e3)). intro H3; rewrite H3; rewrite <- H2; rewrite merge_mult_correct1; - simpl in |- *; ring. -ring. + simpl in |- *; legacy ring. +legacy ring. Qed. Lemma assoc_mult_correct1 : @@ -308,7 +308,7 @@ Lemma assoc_mult_correct : Proof. simple induction e; auto; intros. elim e0; intros. -intros; simpl in |- *; ring. +intros; simpl in |- *; legacy ring. simpl in |- *; rewrite (AmultT_1l (interp_ExprA lvar (assoc_mult e1))); rewrite (AmultT_1l (interp_ExprA lvar e1)); apply H0. simpl in |- *; rewrite (H0 lvar); auto. @@ -319,7 +319,7 @@ simpl in |- *; rewrite merge_mult_correct; simpl in |- *; fold interp_ExprA in H1; rewrite (H0 lvar) in H1; rewrite (AmultT_sym (interp_ExprA lvar e3) (interp_ExprA lvar e1)); rewrite <- AmultT_assoc; rewrite H1; rewrite AmultT_assoc; - ring. + legacy ring. simpl in |- *; rewrite (H0 lvar); auto. simpl in |- *; rewrite (H0 lvar); auto. simpl in |- *; rewrite (H0 lvar); auto. @@ -344,7 +344,7 @@ Lemma merge_plus_correct : interp_ExprA lvar (merge_plus e1 e2) = interp_ExprA lvar (EAplus e1 e2). Proof. simple induction e1; auto; intros. -elim e0; try intros; try (simpl in |- *; ring). +elim e0; try intros; try (simpl in |- *; legacy ring). unfold interp_ExprA in H2; fold interp_ExprA in H2; cut (AplusT (interp_ExprA lvar e2) @@ -354,8 +354,8 @@ unfold interp_ExprA in H2; fold interp_ExprA in H2; (AplusT (AplusT (interp_ExprA lvar e) (interp_ExprA lvar e4)) (interp_ExprA lvar e2)) (interp_ExprA lvar e3)). intro H3; rewrite H3; rewrite <- H2; rewrite merge_plus_correct1; - simpl in |- *; ring. -ring. + simpl in |- *; legacy ring. +legacy ring. Qed. Lemma assoc_plus_correct : @@ -455,7 +455,7 @@ Lemma distrib_mult_right_correct : Proof. simple induction e1; try intros; simpl in |- *; auto. rewrite AmultT_sym; rewrite AmultT_AplusT_distr; rewrite (H e2 lvar); - rewrite (H0 e2 lvar); ring. + rewrite (H0 e2 lvar); legacy ring. Qed. Lemma distrib_mult_left_correct : @@ -491,7 +491,7 @@ simpl in |- *; rewrite <- (H lvar); rewrite <- (H0 lvar); unfold distrib in |- *; simpl in |- *; apply distrib_mult_left_correct. simpl in |- *; fold AoppT in |- *; rewrite <- (H lvar); unfold distrib in |- *; simpl in |- *; rewrite distrib_mult_right_correct; - simpl in |- *; fold AoppT in |- *; ring. + simpl in |- *; fold AoppT in |- *; legacy ring. Qed. (**** Multiplication by the inverse product ****) @@ -527,7 +527,7 @@ Lemma multiply_aux_correct : Proof. simple induction e; simpl in |- *; intros; try rewrite merge_mult_correct; auto. - simpl in |- *; rewrite (H0 lvar); ring. + simpl in |- *; rewrite (H0 lvar); legacy ring. Qed. Lemma multiply_correct : @@ -595,8 +595,8 @@ simpl in |- *; case (eqExprA e0 (EAinv a)); intros. rewrite e2; simpl in |- *; fold AinvT in |- *. rewrite <- (AmultT_assoc (interp_ExprA lvar a) (AinvT (interp_ExprA lvar a)) - (interp_ExprA lvar e1)); rewrite AinvT_r; [ ring | assumption ]. -simpl in |- *; rewrite H0; auto; ring. + (interp_ExprA lvar e1)); rewrite AinvT_r; [ legacy ring | assumption ]. +simpl in |- *; rewrite H0; auto; legacy ring. simpl in |- *; fold AoppT in |- *; case (eqExprA (EAopp e0) (EAinv a)); intros; [ inversion e1 | simpl in |- *; trivial ]. unfold monom_remove in |- *; case (eqExprA (EAinv e0) (EAinv a)); intros. @@ -619,7 +619,7 @@ simple induction a; simpl in |- *; intros; try rewrite monom_remove_correct; elim (Rmult_neq_0_reg (interp_ExprA lvar e) (interp_ExprA lvar e0) H1); intros. rewrite (H0 (monom_remove e e1) lvar H3); rewrite monom_remove_correct; auto. -ring. +legacy ring. Qed. Lemma monom_simplif_correct : diff --git a/contrib/field/Field.v b/contrib/field/LegacyField.v index 5d08c57f4..5d08c57f4 100644 --- a/contrib/field/Field.v +++ b/contrib/field/LegacyField.v diff --git a/contrib/field/field.ml4 b/contrib/field/field.ml4 index 8e33f6292..f8f872134 100644 --- a/contrib/field/field.ml4 +++ b/contrib/field/field.ml4 @@ -139,7 +139,7 @@ ARGUMENT EXTEND minus_div_arg END VERNAC COMMAND EXTEND Field - [ "Add" "Field" + [ "Add" "Legacy" "Field" constr(a) constr(aplus) constr(amult) constr(aone) constr(azero) constr(aopp) constr(aeq) constr(ainv) constr(rth) constr(ainv_l) minus_div_arg(md) ] @@ -153,7 +153,7 @@ END (* Guesses the type and calls field_gen with the right theory *) let field g = - Coqlib.check_required_library ["Coq";"field";"Field"]; + Coqlib.check_required_library ["Coq";"field";"LegacyField"]; let typ = match Hipattern.match_with_equation (pf_concl g) with | Some (eq,t::args) when eq = (Coqlib.build_coq_eq_data()).Coqlib.eq -> t @@ -187,7 +187,7 @@ let field_term l g = (* Declaration of Field *) -TACTIC EXTEND field -| [ "field" ] -> [ field ] -| [ "field" ne_constr_list(l) ] -> [ field_term l ] +TACTIC EXTEND legacy_field +| [ "legacy" "field" ] -> [ field ] +| [ "legacy" "field" ne_constr_list(l) ] -> [ field_term l ] END diff --git a/contrib/fourier/Fourier.v b/contrib/fourier/Fourier.v index a97869b32..ac1592bee 100644 --- a/contrib/fourier/Fourier.v +++ b/contrib/fourier/Fourier.v @@ -17,7 +17,7 @@ Declare ML Module "fourierR". Declare ML Module "field". Require Export Fourier_util. -Require Export Field. +Require Export LegacyField. Require Export DiscrR. Ltac fourier := abstract (fourierz; field; discrR). diff --git a/contrib/interface/ascent.mli b/contrib/interface/ascent.mli index 97dfbfb1e..b6cc55f61 100644 --- a/contrib/interface/ascent.mli +++ b/contrib/interface/ascent.mli @@ -46,7 +46,7 @@ and ct_COMMAND = | CT_coerce_THEOREM_GOAL_to_COMMAND of ct_THEOREM_GOAL | CT_abort of ct_ID_OPT_OR_ALL | CT_abstraction of ct_ID * ct_FORMULA * ct_INT_LIST - | CT_add_field of ct_FORMULA * ct_FORMULA * ct_FORMULA * ct_FORMULA * ct_FORMULA * ct_FORMULA * ct_FORMULA * ct_FORMULA * ct_FORMULA * ct_FORMULA * ct_BINDING_LIST + | CT_add_field of ct_FORMULA * ct_FORMULA * ct_FORMULA * ct_FORMULA_OPT | CT_add_natural_feature of ct_NATURAL_FEATURE * ct_ID | CT_addpath of ct_STRING * ct_ID_OPT | CT_arguments_scope of ct_ID * ct_ID_OPT_LIST diff --git a/contrib/interface/debug_tac.ml4 b/contrib/interface/debug_tac.ml4 index e1b8e7125..890bb3ce5 100644 --- a/contrib/interface/debug_tac.ml4 +++ b/contrib/interface/debug_tac.ml4 @@ -336,7 +336,7 @@ let debug_tac = function add_tactic "DebugTac" debug_tac;; *) -Refiner.add_tactic "OnThen" on_then;; +Tacinterp.add_tactic "OnThen" on_then;; let rec clean_path tac l = match tac, l with diff --git a/contrib/interface/vtp.ml b/contrib/interface/vtp.ml index 9c26c0711..fe227f995 100644 --- a/contrib/interface/vtp.ml +++ b/contrib/interface/vtp.ml @@ -112,19 +112,12 @@ and fCOMMAND = function fFORMULA x2; fINT_LIST x3; fNODE "abstraction" 3 -| CT_add_field(x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11) -> +| CT_add_field(x1, x2, x3, x4) -> fFORMULA x1; fFORMULA x2; fFORMULA x3; - fFORMULA x4; - fFORMULA x5; - fFORMULA x6; - fFORMULA x7; - fFORMULA x8; - fFORMULA x9; - fFORMULA x10; - fBINDING_LIST x11; - fNODE "add_field" 11 + fFORMULA_OPT x4; + fNODE "add_field" 4 | CT_add_natural_feature(x1, x2) -> fNATURAL_FEATURE x1; fID x2; diff --git a/contrib/interface/xlate.ml b/contrib/interface/xlate.ml index 292a42873..a7288de9a 100644 --- a/contrib/interface/xlate.ml +++ b/contrib/interface/xlate.ml @@ -1670,27 +1670,14 @@ let rec xlate_vernac = CT_no_inline(CT_id_ne_list(loc_qualid_to_ct_ID fst, List.map loc_qualid_to_ct_ID l2)) | VernacExtend("Field", - [a;aplus;amult;aone;azero;aopp;aeq;ainv;fth;ainvl;minusdiv]) -> + [fth;ainv;ainvl;div]) -> (match List.map (fun v -> xlate_formula(out_gen rawwit_constr v)) - [a;aplus;amult;aone;azero;aopp;aeq;ainv;fth;ainvl] + [fth;ainv;ainvl] with - [a1;aplus1;amult1;aone1;azero1;aopp1;aeq1;ainv1;fth1;ainvl1] -> - let bind = - match out_gen Field.rawwit_minus_div_arg minusdiv with - None, None -> - CT_binding_list[] - | Some m, None -> - CT_binding_list[ - CT_binding(CT_coerce_ID_to_ID_OR_INT (CT_ident "minus"), xlate_formula m)] - | None, Some d -> - CT_binding_list[ - CT_binding(CT_coerce_ID_to_ID_OR_INT (CT_ident "div"), xlate_formula d)] - | Some m, Some d -> - CT_binding_list[ - CT_binding(CT_coerce_ID_to_ID_OR_INT (CT_ident "minus"), xlate_formula m); - CT_binding(CT_coerce_ID_to_ID_OR_INT (CT_ident "div"), xlate_formula d)] in - CT_add_field(a1, aplus1, amult1, aone1, azero1, aopp1, aeq1, - ainv1, fth1, ainvl1, bind) + [fth1;ainv1;ainvl1] -> + let adiv1 = + xlate_formula_opt (out_gen (wit_opt rawwit_constr) div) in + CT_add_field(fth1, ainv1, ainvl1, adiv1) |_ -> assert false) | VernacExtend ("HintRewrite", o::f::([b]|[_;b] as args)) -> let orient = out_gen Extraargs.rawwit_orient o in diff --git a/contrib/ring/ArithRing.v b/contrib/ring/ArithRing.v index 0d42dabfd..959d66c74 100644 --- a/contrib/ring/ArithRing.v +++ b/contrib/ring/ArithRing.v @@ -10,7 +10,8 @@ (* Instantiation of the Ring tactic for the naturals of Arith $*) -Require Export Ring. +Require Import Bool. +Require Export LegacyRing. Require Export Arith. Require Import Eqdep_dec. @@ -36,12 +37,12 @@ Hint Resolve nateq_prop: arithring. Definition NatTheory : Semi_Ring_Theory plus mult 1 0 nateq. split; intros; auto with arith arithring. - apply (fun n m p:nat => plus_reg_l m p n) with (n := n). - trivial. +(* apply (fun n m p:nat => plus_reg_l m p n) with (n := n). + trivial.*) Defined. -Add Semi Ring nat plus mult 1 0 nateq NatTheory [ 0 S ]. +Add Legacy Semi Ring nat plus mult 1 0 nateq NatTheory [ 0 S ]. Goal forall n:nat, S n = 1 + n. intro; reflexivity. diff --git a/contrib/ring/Ring.v b/contrib/ring/LegacyRing.v index d0c2b7da3..667e24d53 100644 --- a/contrib/ring/Ring.v +++ b/contrib/ring/LegacyRing.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id$ *) +(* $Id: Ring.v 5920 2004-07-16 20:01:26Z herbelin $ *) Require Export Bool. Require Export Ring_theory. @@ -32,5 +32,5 @@ destruct n; destruct m; destruct p; reflexivity. destruct x; destruct y; reflexivity || simpl in |- *; tauto. Defined. -Add Ring bool xorb andb true false (fun b:bool => b) eqb BoolTheory - [ true false ].
\ No newline at end of file +Add Legacy Ring bool xorb andb true false (fun b:bool => b) eqb BoolTheory + [ true false ]. diff --git a/contrib/ring/NArithRing.v b/contrib/ring/NArithRing.v index 41e3a7d7b..ee9fb3761 100644 --- a/contrib/ring/NArithRing.v +++ b/contrib/ring/NArithRing.v @@ -10,7 +10,8 @@ (* Instantiation of the Ring tactic for the binary natural numbers *) -Require Export Ring. +Require Import Bool. +Require Export LegacyRing. Require Export ZArith_base. Require Import NArith. Require Import Eqdep_dec. @@ -37,8 +38,9 @@ Definition NTheory : Semi_Ring_Theory Nplus Nmult 1%N 0%N Neq. apply Nmult_1_l. apply Nmult_0_l. apply Nmult_plus_distr_r. - apply Nplus_reg_l. +(* apply Nplus_reg_l.*) apply Neq_prop. Qed. -Add Semi Ring N Nplus Nmult 1%N 0%N Neq NTheory [ Npos 0%N xO xI 1%positive ]. +Add Legacy Semi Ring + N Nplus Nmult 1%N 0%N Neq NTheory [ Npos 0%N xO xI 1%positive ]. diff --git a/contrib/ring/Ring_abstract.v b/contrib/ring/Ring_abstract.v index 5d5046393..574c24421 100644 --- a/contrib/ring/Ring_abstract.v +++ b/contrib/ring/Ring_abstract.v @@ -129,7 +129,7 @@ Hint Resolve (SR_mult_zero_left T). Hint Resolve (SR_mult_zero_left2 T). Hint Resolve (SR_distr_left T). Hint Resolve (SR_distr_left2 T). -Hint Resolve (SR_plus_reg_left T). +(*Hint Resolve (SR_plus_reg_left T).*) Hint Resolve (SR_plus_permute T). Hint Resolve (SR_mult_permute T). Hint Resolve (SR_distr_right T). @@ -140,7 +140,7 @@ Hint Resolve (SR_plus_zero_right T). Hint Resolve (SR_plus_zero_right2 T). Hint Resolve (SR_mult_one_right T). Hint Resolve (SR_mult_one_right2 T). -Hint Resolve (SR_plus_reg_right T). +(*Hint Resolve (SR_plus_reg_right T).*) Hint Resolve refl_equal sym_equal trans_equal. (*Hints Resolve refl_eqT sym_eqT trans_eqT.*) Hint Immediate T. @@ -439,7 +439,7 @@ Hint Resolve (Th_mult_zero_left T). Hint Resolve (Th_mult_zero_left2 T). Hint Resolve (Th_distr_left T). Hint Resolve (Th_distr_left2 T). -Hint Resolve (Th_plus_reg_left T). +(*Hint Resolve (Th_plus_reg_left T).*) Hint Resolve (Th_plus_permute T). Hint Resolve (Th_mult_permute T). Hint Resolve (Th_distr_right T). @@ -449,7 +449,7 @@ Hint Resolve (Th_plus_zero_right T). Hint Resolve (Th_plus_zero_right2 T). Hint Resolve (Th_mult_one_right T). Hint Resolve (Th_mult_one_right2 T). -Hint Resolve (Th_plus_reg_right T). +(*Hint Resolve (Th_plus_reg_right T).*) Hint Resolve refl_equal sym_equal trans_equal. (*Hints Resolve refl_eqT sym_eqT trans_eqT.*) Hint Immediate T. diff --git a/contrib/ring/Ring_normalize.v b/contrib/ring/Ring_normalize.v index bd22fa39a..6d0d05778 100644 --- a/contrib/ring/Ring_normalize.v +++ b/contrib/ring/Ring_normalize.v @@ -356,7 +356,7 @@ Hint Resolve (SR_mult_zero_left T). Hint Resolve (SR_mult_zero_left2 T). Hint Resolve (SR_distr_left T). Hint Resolve (SR_distr_left2 T). -Hint Resolve (SR_plus_reg_left T). +(*Hint Resolve (SR_plus_reg_left T).*) Hint Resolve (SR_plus_permute T). Hint Resolve (SR_mult_permute T). Hint Resolve (SR_distr_right T). @@ -367,7 +367,7 @@ Hint Resolve (SR_plus_zero_right T). Hint Resolve (SR_plus_zero_right2 T). Hint Resolve (SR_mult_one_right T). Hint Resolve (SR_mult_one_right2 T). -Hint Resolve (SR_plus_reg_right T). +(*Hint Resolve (SR_plus_reg_right T).*) Hint Resolve refl_equal sym_equal trans_equal. (* Hints Resolve refl_eqT sym_eqT trans_eqT. *) Hint Immediate T. @@ -785,7 +785,7 @@ Hint Resolve (Th_mult_zero_left T). Hint Resolve (Th_mult_zero_left2 T). Hint Resolve (Th_distr_left T). Hint Resolve (Th_distr_left2 T). -Hint Resolve (Th_plus_reg_left T). +(*Hint Resolve (Th_plus_reg_left T).*) Hint Resolve (Th_plus_permute T). Hint Resolve (Th_mult_permute T). Hint Resolve (Th_distr_right T). @@ -796,7 +796,7 @@ Hint Resolve (Th_plus_zero_right T). Hint Resolve (Th_plus_zero_right2 T). Hint Resolve (Th_mult_one_right T). Hint Resolve (Th_mult_one_right2 T). -Hint Resolve (Th_plus_reg_right T). +(*Hint Resolve (Th_plus_reg_right T).*) Hint Resolve refl_equal sym_equal trans_equal. (*Hints Resolve refl_eqT sym_eqT trans_eqT.*) Hint Immediate T. diff --git a/contrib/ring/Ring_theory.v b/contrib/ring/Ring_theory.v index 31cc274b2..192ff1f57 100644 --- a/contrib/ring/Ring_theory.v +++ b/contrib/ring/Ring_theory.v @@ -39,7 +39,7 @@ Record Semi_Ring_Theory : Prop := SR_mult_one_left : forall n:A, 1 * n = n; SR_mult_zero_left : forall n:A, 0 * n = 0; SR_distr_left : forall n m p:A, (n + m) * p = n * p + m * p; - SR_plus_reg_left : forall n m p:A, n + m = n + p -> m = p; +(* SR_plus_reg_left : forall n m p:A, n + m = n + p -> m = p;*) SR_eq_prop : forall x y:A, Is_true (Aeq x y) -> x = y}. Variable T : Semi_Ring_Theory. @@ -52,10 +52,10 @@ Let plus_zero_left := SR_plus_zero_left T. Let mult_one_left := SR_mult_one_left T. Let mult_zero_left := SR_mult_zero_left T. Let distr_left := SR_distr_left T. -Let plus_reg_left := SR_plus_reg_left T. +(*Let plus_reg_left := SR_plus_reg_left T.*) Hint Resolve plus_comm plus_assoc mult_comm mult_assoc plus_zero_left - mult_one_left mult_zero_left distr_left plus_reg_left. + mult_one_left mult_zero_left distr_left (*plus_reg_left*). (* Lemmas whose form is x=y are also provided in form y=x because Auto does not symmetry *) @@ -126,11 +126,11 @@ Qed. Lemma SR_mult_one_right2 : forall n:A, n = n * 1. intro; elim mult_comm; auto. Qed. - +(* Lemma SR_plus_reg_right : forall n m p:A, m + n = p + n -> m = p. intros n m p; rewrite (plus_comm m n); rewrite (plus_comm p n); eauto. Qed. - +*) End Theory_of_semi_rings. Section Theory_of_rings. @@ -320,7 +320,7 @@ symmetry in |- *; apply Th_mult_opp_opp. Qed. Lemma Th_opp_zero : - 0 = 0. rewrite <- (plus_zero_left (- 0)). auto. Qed. - +(* Lemma Th_plus_reg_left : forall n m p:A, n + m = n + p -> m = p. intros; generalize (f_equal (fun z => - n + z) H). repeat rewrite plus_assoc. @@ -336,7 +336,7 @@ rewrite (plus_comm n m). rewrite (plus_comm n p). auto. Qed. - +*) Lemma Th_distr_right : forall n m p:A, n * (m + p) = n * m + n * p. intros. repeat rewrite (mult_comm n). @@ -349,7 +349,7 @@ Qed. End Theory_of_rings. -Hint Resolve Th_mult_zero_left Th_plus_reg_left: core. +Hint Resolve Th_mult_zero_left (*Th_plus_reg_left*): core. Unset Implicit Arguments. @@ -373,4 +373,4 @@ End product_ring. Section power_ring. -End power_ring.
\ No newline at end of file +End power_ring. diff --git a/contrib/ring/ZArithRing.v b/contrib/ring/ZArithRing.v index 9324fb602..075431827 100644 --- a/contrib/ring/ZArithRing.v +++ b/contrib/ring/ZArithRing.v @@ -32,5 +32,5 @@ Definition ZTheory : Ring_Theory Zplus Zmult 1%Z 0%Z Zopp Zeq. Qed. (* NatConstants and NatTheory are defined in Ring_theory.v *) -Add Ring Z Zplus Zmult 1%Z 0%Z Zopp Zeq ZTheory +Add Legacy Ring Z Zplus Zmult 1%Z 0%Z Zopp Zeq ZTheory [ Zpos Zneg 0%Z xO xI 1%positive ]. diff --git a/contrib/ring/g_ring.ml4 b/contrib/ring/g_ring.ml4 index 0cb86dfdd..5ca1bfced 100644 --- a/contrib/ring/g_ring.ml4 +++ b/contrib/ring/g_ring.ml4 @@ -12,9 +12,10 @@ open Quote open Ring +open Tacticals TACTIC EXTEND ring - [ "ring" constr_list(l) ] -> [ polynom l ] +| [ "legacy" "ring" constr_list(l) ] -> [ polynom l ] END (* The vernac commands "Add Ring" and co *) @@ -23,7 +24,7 @@ let cset_of_constrarg_list l = List.fold_right ConstrSet.add (List.map constr_of l) ConstrSet.empty VERNAC COMMAND EXTEND AddRing - [ "Add" "Ring" + [ "Add" "Legacy" "Ring" constr(a) constr(aplus) constr(amult) constr(aone) constr(azero) constr(aopp) constr(aeq) constr(t) "[" ne_constr_list(l) "]" ] -> [ add_theory true false false @@ -40,7 +41,7 @@ VERNAC COMMAND EXTEND AddRing (constr_of t) (cset_of_constrarg_list l) ] -| [ "Add" "Semi" "Ring" +| [ "Add" "Legacy" "Semi" "Ring" constr(a) constr(aplus) constr(amult) constr(aone) constr(azero) constr(aeq) constr(t) "[" ne_constr_list(l) "]" ] -> [ add_theory false false false @@ -57,7 +58,7 @@ VERNAC COMMAND EXTEND AddRing (constr_of t) (cset_of_constrarg_list l) ] -| [ "Add" "Abstract" "Ring" +| [ "Add" "Legacy" "Abstract" "Ring" constr(a) constr(aplus) constr(amult) constr(aone) constr(azero) constr(aopp) constr(aeq) constr(t) ] -> [ add_theory true true false @@ -74,7 +75,7 @@ VERNAC COMMAND EXTEND AddRing (constr_of t) ConstrSet.empty ] -| [ "Add" "Abstract" "Semi" "Ring" +| [ "Add" "Legacy" "Abstract" "Semi" "Ring" constr(a) constr(aplus) constr(amult) constr(aone) constr(azero) constr(aeq) constr(t) ] -> [ add_theory false true false @@ -91,7 +92,7 @@ VERNAC COMMAND EXTEND AddRing (constr_of t) ConstrSet.empty ] -| [ "Add" "Setoid" "Ring" +| [ "Add" "Legacy" "Setoid" "Ring" constr(a) constr(aequiv) constr(asetth) constr(aplus) constr(amult) constr(aone) constr(azero) constr(aopp) constr(aeq) constr(pm) constr(mm) constr(om) constr(t) "[" ne_constr_list(l) "]" ] @@ -112,7 +113,7 @@ VERNAC COMMAND EXTEND AddRing (constr_of t) (cset_of_constrarg_list l) ] -| [ "Add" "Semi" "Setoid" "Ring" +| [ "Add" "Legacy" "Semi" "Setoid" "Ring" constr(a) constr(aequiv) constr(asetth) constr(aplus) constr(amult) constr(aone) constr(azero) constr(aeq) constr(pm) constr(mm) constr(t) "[" ne_constr_list(l) "]" ] diff --git a/contrib/ring/quote.ml b/contrib/ring/quote.ml index 3b937c7a6..3c1645d47 100644 --- a/contrib/ring/quote.ml +++ b/contrib/ring/quote.ml @@ -298,7 +298,7 @@ let rec closed_under cset t = (ConstrSet.mem t cset) or (match (kind_of_term t) with | Cast(c,_,_) -> closed_under cset c - | App(f,l) -> closed_under cset f & array_for_all (closed_under cset) l + | App(f,l) -> closed_under cset f && array_for_all (closed_under cset) l | _ -> false) (*s [btree_of_array [| c1; c2; c3; c4; c5 |]] builds the complete diff --git a/contrib/ring/ring.ml b/contrib/ring/ring.ml index 48e8763d5..1c5121ef6 100644 --- a/contrib/ring/ring.ml +++ b/contrib/ring/ring.ml @@ -885,7 +885,7 @@ let match_with_equiv c = match (kind_of_term c) with | _ -> None let polynom lc gl = - Coqlib.check_required_library ["Coq";"ring";"Ring"]; + Coqlib.check_required_library ["Coq";"ring";"LegacyRing"]; match lc with (* If no argument is given, try to recognize either an equality or a declared relation with arguments c1 ... cn, diff --git a/contrib/setoid_ring/BinList.v b/contrib/setoid_ring/BinList.v index 0def087fd..28fc1afba 100644 --- a/contrib/setoid_ring/BinList.v +++ b/contrib/setoid_ring/BinList.v @@ -1,46 +1,45 @@ +(************************************************************************) +(* 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 *) +(************************************************************************) + Set Implicit Arguments. Require Import BinPos. +Require Import List. Open Scope positive_scope. - Section LIST. - - Variable A:Type. - Variable default:A. - - Inductive list : Type := - | nil : list - | cons : A -> list -> list. - - Infix "::" := cons (at level 60, right associativity). + Variable A : Type. + Variable default : A. Definition hd l := match l with hd :: _ => hd | _ => default end. - Definition tl l := match l with _ :: tl => tl | _ => nil end. - - Fixpoint jump (p:positive) (l:list) {struct p} : list := + Fixpoint jump (p:positive) (l:list A) {struct p} : list A := match p with - | xH => tl l + | xH => tail l | xO p => jump p (jump p l) - | xI p => jump p (jump p (tl l)) + | xI p => jump p (jump p (tail l)) end. - Fixpoint nth (p:positive) (l:list) {struct p} : A:= + Fixpoint nth (p:positive) (l:list A) {struct p} : A:= match p with | xH => hd l | xO p => nth p (jump p l) - | xI p => nth p (jump p (tl l)) + | xI p => nth p (jump p (tail l)) end. - Fixpoint rev_append (rev l : list) {struct l} : list := + Fixpoint rev_append (rev l : list A) {struct l} : list A := match l with | nil => rev | (cons h t) => rev_append (cons h rev) t end. - Definition rev l : list := rev_append nil l. + Definition rev l : list A := rev_append nil l. - Lemma jump_tl : forall j l, tl (jump j l) = jump j (tl l). + Lemma jump_tl : forall j l, tail (jump j l) = jump j (tail l). Proof. induction j;simpl;intros. repeat rewrite IHj;trivial. @@ -71,7 +70,7 @@ Section LIST. Qed. Lemma jump_Pdouble_minus_one : forall i l, - (jump (Pdouble_minus_one i) (tl l)) = (jump i (jump i l)). + (jump (Pdouble_minus_one i) (tail l)) = (jump i (jump i l)). Proof. induction i;intros;simpl. repeat rewrite jump_tl;trivial. @@ -80,7 +79,7 @@ Section LIST. Qed. - Lemma nth_jump : forall p l, nth p (tl l) = hd (jump p l). + Lemma nth_jump : forall p l, nth p (tail l) = hd (jump p l). Proof. induction p;simpl;intros. rewrite <-jump_tl;rewrite IHp;trivial. @@ -89,7 +88,7 @@ Section LIST. Qed. Lemma nth_Pdouble_minus_one : - forall p l, nth (Pdouble_minus_one p) (tl l) = nth p (jump p l). + forall p l, nth (Pdouble_minus_one p) (tail l) = nth p (jump p l). Proof. induction p;simpl;intros. repeat rewrite jump_tl;trivial. @@ -99,3 +98,64 @@ Section LIST. Qed. End LIST. +Notation list := List.list. +Notation tail := List.tail. +Notation cons := List.cons. +Notation nil := List.nil. + +Ltac list_fold_right fcons fnil l := + match l with + | (cons ?x ?tl) => fcons x ltac:(list_fold_right fcons fnil tl) + | nil => fnil + end. + +Ltac list_fold_left fcons fnil l := + match l with + | (cons ?x ?tl) => list_fold_left fcons ltac:(fcons x fnil) tl + | nil => fnil + end. + +Ltac list_iter f l := + match l with + | (cons ?x ?tl) => f x; list_iter f tl + | nil => idtac + end. + +Ltac list_iter_gen seq f l := + match l with + | (cons ?x ?tl) => + let t1 _ := f x in + let t2 _ := list_iter_gen seq f tl in + seq t1 t2 + | nil => idtac + end. + +Ltac AddFvTail a l := + match l with + | nil => constr:(cons a l) + | (cons a _) => l + | (cons ?x ?l) => let l' := AddFvTail a l in constr:(cons x l') + end. + +Ltac Find_at a l := + let rec find n l := + match l with + | nil => fail 100 "anomaly: Find_at" + | (cons a _) => eval compute in n + | (cons _ ?l) => find (Psucc n) l + end + in find 1%positive l. + +Ltac check_is_list t := + match t with + | cons _ ?l => check_is_list l + | nil => idtac + | _ => fail 100 "anomaly: failed to build a canonical list" + end. + +Ltac check_fv l := + check_is_list l; + match type of l with + | list _ => idtac + | _ => fail 100 "anomaly: built an ill-typed list" + end. diff --git a/contrib/setoid_ring/Pol.v b/contrib/setoid_ring/Pol.v index 2bf2574fe..ff5608b8a 100644 --- a/contrib/setoid_ring/Pol.v +++ b/contrib/setoid_ring/Pol.v @@ -1,3 +1,11 @@ +(************************************************************************) +(* 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 *) +(************************************************************************) + Set Implicit Arguments. Require Import Setoid. Require Export BinList. @@ -5,6 +13,8 @@ Require Import BinPos. Require Import BinInt. Require Export Ring_th. +Import RingSyntax. + Section MakeRingPol. (* Ring elements *) @@ -329,7 +339,7 @@ Section MakeRingPol. | PX P i Q => let x := hd 0 l in let xi := pow x i in - (Pphi l P) * xi + (Pphi (tl l) Q) + (Pphi l P) * xi + (Pphi (tail l) Q) end. Reserved Notation "P @ l " (at level 10, no associativity). @@ -418,7 +428,7 @@ Section MakeRingPol. Qed. Lemma mkPX_ok : forall l P i Q, - (mkPX P i Q)@l == P@l*(pow (hd 0 l) i) + Q@(tl l). + (mkPX P i Q)@l == P@l*(pow (hd 0 l) i) + Q@(tail l). Proof. intros l P i Q;unfold mkPX. destruct P;try (simpl;rrefl). @@ -519,33 +529,33 @@ Section MakeRingPol. rsimpl;add_push (P'1@l * (pow (hd 0 l) p));rrefl. rewrite IHP'2;simpl. rewrite jump_Pdouble_minus_one;rsimpl;add_push (P'1@l * (pow (hd 0 l) p));rrefl. - rewrite IHP'2;rsimpl. add_push (P @ (tl l));rrefl. + rewrite IHP'2;rsimpl. add_push (P @ (tail l));rrefl. assert (H := ZPminus_spec p0 p);destruct (ZPminus p0 p);Esimpl2. rewrite IHP'1;rewrite IHP'2;rsimpl. - add_push (P3 @ (tl l));rewrite H;rrefl. + add_push (P3 @ (tail l));rewrite H;rrefl. rewrite IHP'1;rewrite IHP'2;simpl;Esimpl. rewrite H;rewrite Pplus_comm. rewrite pow_Pplus;rsimpl. - add_push (P3 @ (tl l));rrefl. + add_push (P3 @ (tail l));rrefl. assert (forall P k l, (PaddX Padd P'1 k P) @ l == P@l + P'1@l * pow (hd 0 l) k). induction P;simpl;intros;try apply (ARadd_sym ARth). destruct p2;simpl;try apply (ARadd_sym ARth). rewrite jump_Pdouble_minus_one;apply (ARadd_sym ARth). assert (H1 := ZPminus_spec p2 k);destruct (ZPminus p2 k);Esimpl2. - rewrite IHP'1;rsimpl; rewrite H1;add_push (P5 @ (tl l0));rrefl. + rewrite IHP'1;rsimpl; rewrite H1;add_push (P5 @ (tail l0));rrefl. rewrite IHP'1;simpl;Esimpl. rewrite H1;rewrite Pplus_comm. rewrite pow_Pplus;simpl;Esimpl. - add_push (P5 @ (tl l0));rrefl. + add_push (P5 @ (tail l0));rrefl. rewrite IHP1;rewrite H1;rewrite Pplus_comm. rewrite pow_Pplus;simpl;rsimpl. - add_push (P5 @ (tl l0));rrefl. + add_push (P5 @ (tail l0));rrefl. rewrite H0;rsimpl. - add_push (P3 @ (tl l)). + add_push (P3 @ (tail l)). rewrite H;rewrite Pplus_comm. rewrite IHP'2;rewrite pow_Pplus;rsimpl. - add_push (P3 @ (tl l));rrefl. + add_push (P3 @ (tail l));rrefl. Qed. Lemma Psub_ok : forall P' P l, (P -- P')@l == P@l - P'@l. @@ -569,17 +579,17 @@ Section MakeRingPol. repeat rewrite Popp_ok;Esimpl2;rsimpl;add_push [c];try rrefl. destruct p0;simpl;Esimpl2. rewrite IHP'2;simpl;rsimpl;add_push (P'1@l * (pow (hd 0 l) p));trivial. - add_push (P @ (jump p0 (jump p0 (tl l))));rrefl. + add_push (P @ (jump p0 (jump p0 (tail l))));rrefl. rewrite IHP'2;simpl;rewrite jump_Pdouble_minus_one;rsimpl. add_push (- (P'1 @ l * pow (hd 0 l) p));rrefl. - rewrite IHP'2;rsimpl;add_push (P @ (tl l));rrefl. + rewrite IHP'2;rsimpl;add_push (P @ (tail l));rrefl. assert (H := ZPminus_spec p0 p);destruct (ZPminus p0 p);Esimpl2. rewrite IHP'1; rewrite IHP'2;rsimpl. - add_push (P3 @ (tl l));rewrite H;rrefl. + add_push (P3 @ (tail l));rewrite H;rrefl. rewrite IHP'1; rewrite IHP'2;rsimpl;simpl;Esimpl. rewrite H;rewrite Pplus_comm. rewrite pow_Pplus;rsimpl. - add_push (P3 @ (tl l));rrefl. + add_push (P3 @ (tail l));rrefl. assert (forall P k l, (PsubX Psub P'1 k P) @ l == P@l + - P'1@l * pow (hd 0 l) k). induction P;simpl;intros. @@ -589,15 +599,15 @@ Section MakeRingPol. rewrite jump_Pdouble_minus_one;apply (ARadd_sym ARth);trivial. apply (ARadd_sym ARth);trivial. assert (H1 := ZPminus_spec p2 k);destruct (ZPminus p2 k);Esimpl2;rsimpl. - rewrite IHP'1;rsimpl;add_push (P5 @ (tl l0));rewrite H1;rrefl. + rewrite IHP'1;rsimpl;add_push (P5 @ (tail l0));rewrite H1;rrefl. rewrite IHP'1;rewrite H1;rewrite Pplus_comm. rewrite pow_Pplus;simpl;Esimpl. - add_push (P5 @ (tl l0));rrefl. + add_push (P5 @ (tail l0));rrefl. rewrite IHP1;rewrite H1;rewrite Pplus_comm. rewrite pow_Pplus;simpl;rsimpl. - add_push (P5 @ (tl l0));rrefl. + add_push (P5 @ (tail l0));rrefl. rewrite H0;rsimpl. - rewrite IHP'2;rsimpl;add_push (P3 @ (tl l)). + rewrite IHP'2;rsimpl;add_push (P3 @ (tail l)). rewrite H;rewrite Pplus_comm. rewrite pow_Pplus;rsimpl. Qed. @@ -762,7 +772,7 @@ Section MakeRingPol. | Pinj j Q => add_mult_dev rP Q (jump j fv) lm | PX P i Q => let rP := add_mult_dev rP P fv (powl i (hd 0 fv) lm) in - if Q ?== P0 then rP else add_mult_dev rP Q (tl fv) lm + if Q ?== P0 then rP else add_mult_dev rP Q (tail fv) lm end. Definition mkmult1 lm := @@ -778,10 +788,10 @@ Section MakeRingPol. | Pinj j Q => mult_dev Q (jump j fv) lm | PX P i Q => let rP := mult_dev P fv (powl i (hd 0 fv) lm) in - if Q ?== P0 then rP else add_mult_dev rP Q (tl fv) lm + if Q ?== P0 then rP else add_mult_dev rP Q (tail fv) lm end. - Definition Pphi_dev fv P := mult_dev P fv (nil R). + Definition Pphi_dev fv P := mult_dev P fv nil. Add Morphism mkmult : mkmult_ext. intros r r0 eqr l;generalize l r r0 eqr;clear l r r0 eqr; @@ -898,15 +908,15 @@ Section MakeRingPol. rewrite <- Pphi_mult_dev;simpl;Esimpl. Qed. - Lemma Pphi_dev_ok : forall l pe, PEeval l pe == Pphi_dev l (norm pe). + Lemma Pphi_dev_gen_ok : forall l pe, PEeval l pe == Pphi_dev l (norm pe). Proof. intros l pe;rewrite <- Pphi_Pphi_dev;apply norm_ok. Qed. - Lemma Pphi_dev_ok' : + Lemma Pphi_dev_ok : forall l pe npe, norm pe = npe -> PEeval l pe == Pphi_dev l npe. Proof. - intros l pe npe npe_eq; subst npe; apply Pphi_dev_ok. + intros l pe npe npe_eq; subst npe; apply Pphi_dev_gen_ok. Qed. (* The same but building a PExpr *) @@ -939,7 +949,7 @@ Section MakeRingPol. | Pinj j Q => Padd_mult_dev rP Q (jump j fv) lm | PX P i Q => let rP := Padd_mult_dev rP P fv (Ppowl i (hd P0 fv) lm) in - if Q ?== P0 then rP else Padd_mult_dev rP Q (tl fv) lm + if Q ?== P0 then rP else Padd_mult_dev rP Q (tail fv) lm end. Definition Pmkmult1 lm := @@ -955,10 +965,10 @@ Section MakeRingPol. | Pinj j Q => Pmult_dev Q (jump j fv) lm | PX P i Q => let rP := Pmult_dev P fv (Ppowl i (hd (PEc r0) fv) lm) in - if Q ?== P0 then rP else Padd_mult_dev rP Q (tl fv) lm + if Q ?== P0 then rP else Padd_mult_dev rP Q (tail fv) lm end. - Definition Pphi_dev2 fv P := Pmult_dev P fv (nil PExpr). + Definition Pphi_dev2 fv P := Pmult_dev P fv nil. ... *) @@ -1009,7 +1019,7 @@ Section MakeRingPol. | Pinj j Q => Pphi_dev (jump j fv) Q | PX P i Q => let rP := mult_dev P fv (pow_dev i (hd 0 fv)) in - add_dev rP Q (tl fv) + add_dev rP Q (tail fv) end with add_dev (ra:R) (P:Pol) (fv:list R) {struct P} : R := @@ -1018,7 +1028,7 @@ Section MakeRingPol. | Pinj j Q => add_dev ra Q (jump j fv) | PX P i Q => let ra := add_mult_dev ra P fv (pow_dev i (hd 0 fv)) in - add_dev ra Q (tl fv) + add_dev ra Q (tail fv) end with mult_dev (P:Pol) (fv:list R) (rm:R) {struct P} : R := @@ -1027,7 +1037,7 @@ Section MakeRingPol. | Pinj j Q => mult_dev Q (jump j fv) rm | PX P i Q => let ra := mult_dev P fv (pow_mult i (hd 0 fv) rm) in - add_mult_dev ra Q (tl fv) rm + add_mult_dev ra Q (tail fv) rm end with add_mult_dev (ra:R) (P:Pol) (fv:list R) (rm:R) {struct P} : R := @@ -1037,7 +1047,7 @@ Section MakeRingPol. | PX P i Q => let rmP := pow_mult i (hd 0 fv) rm in let raP := add_mult_dev ra P fv rmP in - add_mult_dev raP Q (tl fv) rm + add_mult_dev raP Q (tail fv) rm end. Lemma Pphi_add_mult_dev : forall P ra fv rm, @@ -1049,7 +1059,7 @@ Section MakeRingPol. rewrite (H (refl_equal true));rewrite CRmorph.(morph0);Esimpl. rrefl. apply IHP. - rewrite (IHP2 (add_mult_dev ra P2 fv (pow_mult p (hd 0 fv) rm)) (tl fv) rm). + rewrite (IHP2 (add_mult_dev ra P2 fv (pow_mult p (hd 0 fv) rm)) (tail fv) rm). rewrite (IHP1 ra fv (pow_mult p (hd 0 fv) rm)). rewrite (pow_mult_pow p (hd 0 fv) rm);rsimpl. Qed. @@ -1062,7 +1072,7 @@ Section MakeRingPol. rewrite (H (refl_equal true));rewrite CRmorph.(morph0);Esimpl. rrefl. apply IHP. - rewrite (IHP2 (add_mult_dev ra P2 fv (pow_dev p (hd 0 fv))) (tl fv)). + rewrite (IHP2 (add_mult_dev ra P2 fv (pow_dev p (hd 0 fv))) (tail fv)). rewrite (Pphi_add_mult_dev P2 ra fv (pow_dev p (hd 0 fv))). rewrite (pow_dev_pow p (hd 0 fv));rsimpl. Qed. @@ -1076,7 +1086,7 @@ Section MakeRingPol. rrefl. apply IHP. rewrite (Pphi_add_mult_dev P3 - (mult_dev P2 fv (pow_mult p (hd 0 fv) rm)) (tl fv) rm). + (mult_dev P2 fv (pow_mult p (hd 0 fv) rm)) (tail fv) rm). rewrite (IHP1 fv (pow_mult p (hd 0 fv) rm)). rewrite (pow_mult_pow p (hd 0 fv) rm);rsimpl. Qed. @@ -1085,7 +1095,7 @@ Section MakeRingPol. Proof. induction P;simpl;intros. rrefl. trivial. - rewrite (Pphi_add_dev P3 (mult_dev P2 fv (pow_dev p (hd 0 fv))) (tl fv)). + rewrite (Pphi_add_dev P3 (mult_dev P2 fv (pow_dev p (hd 0 fv))) (tail fv)). rewrite (Pphi_mult_dev P2 fv (pow_dev p (hd 0 fv))). rewrite (pow_dev_pow p (hd 0 fv));rsimpl. Qed. @@ -1101,7 +1111,7 @@ Section MakeRingPol. | (nil _) => constr:(rev) | (cons ?h ?t) => let rev := constr:(cons h rev) in rev_append rev t end in - rev_append (nil R) l. + rev_append (@nil R) l. Ltac TPphi_dev add mul := let tl l := match l with (cons ?h ?t) => constr:(t) end in diff --git a/contrib/setoid_ring/Ring.v b/contrib/setoid_ring/Ring.v new file mode 100644 index 000000000..45f59a557 --- /dev/null +++ b/contrib/setoid_ring/Ring.v @@ -0,0 +1,44 @@ +(************************************************************************) +(* 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 *) +(************************************************************************) + +Require Import Bool. +Require Export Ring_th. +Require Export Ring_base. +Require Import ZRing_th. +Require Import Ring_equiv. + +Lemma BoolTheory : + ring_theory false true xorb andb xorb (fun b:bool => b) (eq(A:=bool)). +split; simpl in |- *. +destruct x; reflexivity. +destruct x; destruct y; reflexivity. +destruct x; destruct y; destruct z; reflexivity. +reflexivity. +destruct x; destruct y; reflexivity. +destruct x; destruct y; reflexivity. +destruct x; destruct y; destruct z; reflexivity. +reflexivity. +destruct x; reflexivity. +Qed. + +Unboxed Definition bool_eq (b1 b2:bool) := + if b1 then b2 else negb b2. + +Lemma bool_eq_ok : forall b1 b2, bool_eq b1 b2 = true -> b1 = b2. +destruct b1; destruct b2; auto. +Qed. + +Ltac bool_cst t := + let t := eval hnf in t in + match t with + true => constr:true + | false => constr:false + | _ => NotConstant + end. + +Add Ring bool_ring : BoolTheory (decidable bool_eq_ok, constants [bool_cst]). diff --git a/contrib/setoid_ring/Ring_base.v b/contrib/setoid_ring/Ring_base.v new file mode 100644 index 000000000..2209f0643 --- /dev/null +++ b/contrib/setoid_ring/Ring_base.v @@ -0,0 +1,15 @@ +(************************************************************************) +(* 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 *) +(************************************************************************) + +(* This module gathers the necessary base to build an instance of the + ring tactic. Abstract rings need more theory, depending on + ZArith_base. *) + +Declare ML Module "newring". +Require Export Ring_th. +Require Export Ring_tac. diff --git a/contrib/setoid_ring/Ring_equiv.v b/contrib/setoid_ring/Ring_equiv.v new file mode 100644 index 000000000..135a59e01 --- /dev/null +++ b/contrib/setoid_ring/Ring_equiv.v @@ -0,0 +1,74 @@ +Require Import Ring_theory. +Require Import Coq.ring.Setoid_ring_theory. +Require Import Ring_th. + +Set Implicit Arguments. + +Section Old2New. + +Variable A : Type. + +Variable Aplus : A -> A -> A. +Variable Amult : A -> A -> A. +Variable Aone : A. +Variable Azero : A. +Variable Aopp : A -> A. +Variable Aeq : A -> A -> bool. +Variable R : Ring_Theory Aplus Amult Aone Azero Aopp Aeq. + +Let Aminus := fun x y => Aplus x (Aopp y). + +Lemma ring_equiv1 : + ring_theory Azero Aone Aplus Amult Aminus Aopp (eq (A:=A)). +Proof. +destruct R. +split; eauto. +Qed. + +End Old2New. + +Section New2OldRing. + Variable R : Type. + Variable (rO rI : R) (radd rmul rsub: R->R->R) (ropp : R -> R). + Variable Rth : ring_theory rO rI radd rmul rsub ropp (eq (A:=R)). + + Variable reqb : R -> R -> bool. + Variable reqb_ok : forall x y, reqb x y = true -> x = y. + + Lemma ring_equiv2 : + Ring_Theory radd rmul rI rO ropp reqb. +Proof. +elim Rth; intros; constructor; eauto. +intros. +apply reqb_ok. +destruct (reqb x y); trivial; intros. +elim H. +Qed. + + Definition default_eqb : R -> R -> bool := fun x y => false. + Lemma default_eqb_ok : forall x y, default_eqb x y = true -> x = y. +Proof. +discriminate 1. +Qed. + +End New2OldRing. + +Section New2OldSemiRing. + Variable R : Type. + Variable (rO rI : R) (radd rmul: R->R->R). + Variable SRth : semi_ring_theory rO rI radd rmul (eq (A:=R)). + + Variable reqb : R -> R -> bool. + Variable reqb_ok : forall x y, reqb x y = true -> x = y. + + Lemma sring_equiv2 : + Semi_Ring_Theory radd rmul rI rO reqb. +Proof. +elim SRth; intros; constructor; eauto. +intros. +apply reqb_ok. +destruct (reqb x y); trivial; intros. +elim H. +Qed. + +End New2OldSemiRing. diff --git a/contrib/setoid_ring/Ring_tac.v b/contrib/setoid_ring/Ring_tac.v index 6c3f87a5b..a6ac66881 100644 --- a/contrib/setoid_ring/Ring_tac.v +++ b/contrib/setoid_ring/Ring_tac.v @@ -1,76 +1,63 @@ Set Implicit Arguments. Require Import Setoid. -Require Import BinList. Require Import BinPos. Require Import Pol. +Require Import BinList. Declare ML Module "newring". -(* Some Tactics *) - -Ltac compute_assertion id t := - let t' := eval compute in t in - (assert (id : t = t'); [exact_no_check (refl_equal t')|idtac]). - -Ltac compute_assertion' id id' t := - let t' := eval compute in t in +(* adds a definition id' on the normal form of t and an hypothesis id + stating that t = id' (tries to produces a proof as small as possible) *) +Ltac compute_assertion id id' t := + let t' := eval vm_compute in t in (pose (id' := t'); assert (id : t = id'); [exact_no_check (refl_equal id')|idtac]). -Ltac compute_replace' id t := - let t' := eval compute in t in - (replace t with t' in id; [idtac|exact_no_check (refl_equal t')]). +(********************************************************************) +(* Tacticals to build reflexive tactics *) -Ltac bin_list_fold_right fcons fnil l := - match l with - | (cons ?x ?tl) => fcons x ltac:(bin_list_fold_right fcons fnil tl) - | (nil _) => fnil - end. - -Ltac bin_list_fold_left fcons fnil l := - match l with - | (cons ?x ?tl) => bin_list_fold_left fcons ltac:(fcons x fnil) tl - | (nil _) => fnil - end. - -Ltac bin_list_iter f l := - match l with - | (cons ?x ?tl) => f x; bin_list_iter f tl - | (nil _) => idtac +Ltac OnEquation req := + match goal with + | |- req ?lhs ?rhs => (fun f => f lhs rhs) + | _ => fail 1 "Goal is not an equation (of expected equality)" end. - -(** A tactic that reverses a list *) -Ltac Trev R l := - let rec rev_append rev l := - match l with - | (nil _) => constr:(rev) - | (cons ?h ?t) => let rev := constr:(cons h rev) in rev_append rev t - end in - rev_append (nil R) l. -(* to avoid conflicts with Coq booleans*) +Ltac ApplyLemmaAndSimpl tac lemma pe:= + let npe := fresh "ast_nf" in + let H := fresh "eq_nf" in + let Heq := fresh "thm" in + let npe_spec := + match type of (lemma pe) with + forall (npe:_), ?npe_spec = npe -> _ => npe_spec + | _ => fail 1 "ApplyLemmaAndSimpl: cannot find norm expression" + end in + (compute_assertion H npe npe_spec; + (assert (Heq:=lemma _ _ H) || fail "anomaly: failed to apply lemma"); + clear H; + tac Heq; + rewrite Heq; clear Heq npe). + +(* General scheme of reflexive tactics using of correctness lemma + that involves normalisation of one expression *) +Ltac ReflexiveRewriteTactic FV_tac SYN_tac SIMPL_tac lemma2 req rl := + let R := match type of req with ?R -> _ => R end in + (* build the atom list *) + let fv := list_fold_left FV_tac (@List.nil R) rl in + (* some type-checking to avoid late errors *) + (check_fv fv; + (* rewrite steps *) + list_iter + ltac:(fun r => + let ast := SYN_tac r fv in + (try ApplyLemmaAndSimpl SIMPL_tac (lemma2 fv) ast)) + rl). + +(********************************************************) + +(* An object to return when an expression is not recognized as a constant *) Definition NotConstant := false. - -Ltac IN a l := - match l with - | (cons a ?l) => true - | (cons _ ?l) => IN a l - | (nil _) => false - end. - -Ltac AddFv a l := - match (IN a l) with - | true => l - | _ => constr:(cons a l) - end. - -Ltac Find_at a l := - match l with - | (nil _) => fail 1 "ring anomaly" - | (cons a _) => constr:1%positive - | (cons _ ?l) => let p := Find_at a l in eval compute in (Psucc p) - end. +(* Building the atom list of a ring expression *) Ltac FV Cst add mul sub opp t fv := let rec TFV t fv := match Cst t with @@ -80,13 +67,13 @@ Ltac FV Cst add mul sub opp t fv := | (mul ?t1 ?t2) => TFV t2 ltac:(TFV t1 fv) | (sub ?t1 ?t2) => TFV t2 ltac:(TFV t1 fv) | (opp ?t1) => TFV t1 fv - | _ => AddFv t fv + | _ => AddFvTail t fv end | _ => fv - end + end in TFV t fv. - (* syntaxification *) + (* syntaxification of ring expressions *) Ltac mkPolexpr C Cst radd rmul rsub ropp t fv := let rec mkP t := match Cst t with @@ -111,67 +98,45 @@ Ltac FV Cst add mul sub opp t fv := in mkP t. (* ring tactics *) -Ltac Make_ring_rewrite_step lemma pe:= - let npe := fresh "npe" in - let H := fresh "eq_npe" in - let Heq := fresh "ring_thm" in - let npe_spec := - match type of (lemma pe) with - forall (npe:_), ?npe_spec = npe -> _ => npe_spec - | _ => fail 1 "cannot find norm expression" - end in - (compute_assertion' H npe npe_spec; - assert (Heq:=lemma _ _ H); clear H; - protect_fv in Heq; - (rewrite Heq; clear Heq npe) || clear npe). - - -Ltac Make_ring_rw_list Cst_tac lemma req rl := - match type of lemma with - forall (l:list ?R) (pe:PExpr ?C) (npe:Pol ?C), - _ = npe -> - req (PEeval ?rO ?add ?mul ?sub ?opp ?phi l pe) _ => - let mkFV := FV Cst_tac add mul sub opp in - let mkPol := mkPolexpr C Cst_tac add mul sub opp in - (* build the atom list *) - let rfv := bin_list_fold_left mkFV (nil R) rl in - let fv := Trev R rfv in - (* rewrite *) - bin_list_iter - ltac:(fun r => - let pe := mkPol r fv in - Make_ring_rewrite_step (lemma fv) pe) - rl - | _ => fail 1 "bad lemma" - end. - -Ltac Make_ring_rw Cst_tac lemma req r := - Make_ring_rw_list Cst_tac lemma req (cons r (nil _)). - - (* Building the generic tactic *) - Ltac Make_ring_tac Cst_tac lemma1 lemma2 req := - match type of lemma2 with - forall (l:list ?R) (pe:PExpr ?C) (npe:Pol ?C), - _ = npe -> - req (PEeval ?rO ?add ?mul ?sub ?opp ?phi l pe) _ => - match goal with - | |- req ?r1 ?r2 => - let mkFV := FV Cst_tac add mul sub opp in - let mkPol := mkPolexpr C Cst_tac add mul sub opp in - let rfv := mkFV (add r1 r2) (nil R) in - let fv := Trev R rfv in - let pe1 := mkPol r1 fv in - let pe2 := mkPol r2 fv in - ((apply (lemma1 fv pe1 pe2); - vm_compute; - exact (refl_equal true)) || - (Make_ring_rewrite_step (lemma2 fv) pe1; - Make_ring_rewrite_step (lemma2 fv) pe2)) - | _ => fail 1 "goal is not an equality from a declared ring" - end - end. + Ltac Ring Cst_tac lemma1 req := + let Make_tac := + match type of lemma1 with + | forall (l:list ?R) (pe1 pe2:PExpr ?C), + _ = true -> + req (PEeval ?rO ?add ?mul ?sub ?opp ?phi l pe1) _ => + let mkFV := FV Cst_tac add mul sub opp in + let mkPol := mkPolexpr C Cst_tac add mul sub opp in + (fun f => f R mkFV mkPol) + | _ => fail 1 "ring anomaly: bad correctness lemma" + end in + let Main r1 r2 R mkFV mkPol := + let fv := mkFV r1 (@List.nil R) in + let fv := mkFV r2 fv in + (check_fv fv; + let pe1 := mkPol r1 fv in + let pe2 := mkPol r2 fv in + (apply (lemma1 fv pe1 pe2) || fail "typing error while applying ring"); + vm_compute; + (exact (refl_equal true) || fail "not a valid ring equation")) in + Make_tac ltac:(OnEquation req Main). + +Ltac Ring_simplify Cst_tac lemma2 req rl := + let Make_tac := + match type of lemma2 with + forall (l:list ?R) (pe:PExpr ?C) (npe:Pol ?C), + _ = npe -> + req (PEeval ?rO ?add ?mul ?sub ?opp ?phi l pe) _ => + let mkFV := FV Cst_tac add mul sub opp in + let mkPol := mkPolexpr C Cst_tac add mul sub opp in + let simpl_ring H := protect_fv "ring" in H in + (fun tac => tac mkFV mkPol simpl_ring lemma2 req rl) + | _ => fail 1 "ring anomaly: bad correctness lemma" + end in + Make_tac ReflexiveRewriteTactic. +(* A simple macro tactic to be prefered to ring_simplify *) +Ltac ring_replace t1 t2 := replace t1 with t2 by ring. (* coefs belong to the same type as the target ring (concrete ring) *) Definition ring_id_correct @@ -183,14 +148,7 @@ Definition ring_id_correct Definition ring_rw_id_correct R rO rI radd rmul rsub ropp req rSet req_th ARth reqb reqb_ok := - @Pphi_dev_ok R rO rI radd rmul rsub ropp req rSet req_th ARth - R rO rI radd rmul rsub ropp reqb - (@IDphi R) - (@IDmorph R rO rI radd rmul rsub ropp req rSet reqb reqb_ok). - -Definition ring_rw_id_correct' - R rO rI radd rmul rsub ropp req rSet req_th ARth reqb reqb_ok := - @Pphi_dev_ok' R rO rI radd rmul rsub ropp req rSet req_th ARth + @Pphi_dev_ok R rO rI radd rmul rsub ropp req rSet req_th ARth R rO rI radd rmul rsub ropp reqb (@IDphi R) (@IDmorph R rO rI radd rmul rsub ropp req rSet reqb reqb_ok). @@ -204,551 +162,3 @@ Definition ring_rw_id_eq_correct @ring_rw_id_correct R rO rI radd rmul rsub ropp (@eq R) (Eqsth R) (Eq_ext _ _ _) ARth reqb reqb_ok. -Definition ring_rw_id_eq_correct' - R rO rI radd rmul rsub ropp ARth reqb reqb_ok := - @ring_rw_id_correct' R rO rI radd rmul rsub ropp (@eq R) - (Eqsth R) (Eq_ext _ _ _) ARth reqb reqb_ok. - -(* -Require Import ZArith. -Require Import Setoid. -Require Import Ring_tac. -Import BinList. -Import Ring_th. -Open Scope Z_scope. - -Add New Ring Zr : (Rth_ARth (Eqsth Z) (Eq_ext _ _ _) Zth) - Computational Zeqb_ok - Constant Zcst. - -Goal forall a b, (a+b*2)*(a+b*2)=1. -intros. - setoid ring ((a + b * 2) * (a + b * 2)). - - Make_ring_rw_list Zcst - (ring_rw_id_correct' (Eqsth Z) (Eq_ext _ _ _) - (Rth_ARth (Eqsth Z) (Eq_ext _ _ _) Zth) Zeq_bool Zeqb_ok) - (eq (A:=Z)) - (cons ((a+b)*(a+b)) (nil _)). - - -Goal forall a b, (a+b)*(a+b)=1. -intros. -Ltac zringl := - Make_ring_rw3_list ltac:(inv_gen_phiZ 0 1 Zplus Zmult Zopp) - (ring_rw_id_correct (Eqsth Z) (Eq_ext _ _ _) - (Rth_ARth (Eqsth Z) (Eq_ext _ _ _) Zth) Zeq_bool Zeqb_ok) - (eq (A:=Z)) -(BinList.cons ((a+b)*(a+b)) (BinList.nil _)). - -Open Scope Z_scope. - -let Cst_tac := inv_gen_phiZ 0 1 Zplus Zmult Zopp in -let lemma := - constr:(ring_rw_id_correct' (Eqsth Z) (Eq_ext _ _ _) - (Rth_ARth (Eqsth Z) (Eq_ext _ _ _) Zth) Zeq_bool Zeqb_ok) in -let req := constr:(eq (A:=Z)) in -let rl := constr:(cons ((a+b)*(a+b)) (nil _)) in -Make_ring_rw_list Cst_tac lemma req rl. - -let fv := constr:(cons a (cons b (nil _))) in -let pe := - constr:(PEmul (PEadd (PEX Z 1) (PEX Z 2)) (PEadd (PEX Z 1) (PEX Z 2))) in -Make_ring_rewrite_step (lemma fv) pe. - - - - -OK - -Lemma L0 : - forall (l : list Z) (pe : PExpr Z) pe', - pe' = norm 0 1 Zplus Zmult Zminus Zopp Zeq_bool pe -> - PEeval 0 Zplus Zmult Zminus Zopp (IDphi (R:=Z)) l pe = - Pphi_dev 0 1 Zplus Zmult 0 1 Zeq_bool (IDphi (R:=Z)) l pe'. -intros; subst pe'. -apply - (ring_rw_id_correct (Eqsth Z) (Eq_ext _ _ _) - (Rth_ARth (Eqsth Z) (Eq_ext _ _ _) Zth) Zeq_bool Zeqb_ok). -Qed. -Lemma L0' : - forall (l : list Z) (pe : PExpr Z) pe', - norm 0 1 Zplus Zmult Zminus Zopp Zeq_bool pe = pe' -> - PEeval 0 Zplus Zmult Zminus Zopp (IDphi (R:=Z)) l pe = - Pphi_dev 0 1 Zplus Zmult 0 1 Zeq_bool (IDphi (R:=Z)) l pe'. -intros; subst pe'. -apply - (ring_rw_id_correct (Eqsth Z) (Eq_ext _ _ _) - (Rth_ARth (Eqsth Z) (Eq_ext _ _ _) Zth) Zeq_bool Zeqb_ok). -Qed. - -pose (pe:=PEmul (PEadd (PEX Z 1) (PEX Z 2)) (PEadd (PEX Z 1) (PEX Z 2))). -compute_assertion ipattern:H (norm 0 1 Zplus Zmult Zminus Zopp Zeq_bool pe). -let fv := constr:(cons a (cons b (nil _))) in -assert (Heq := L0 fv _ (sym_equal H)); clear H. - protect_fv' in Heq. - rewrite Heq; clear Heq; clear pe. - - -MIEUX (mais taille preuve = taille de pe + taille de nf(pe)... ): - - -Lemma L : - forall (l : list Z) (pe : PExpr Z) pe' (x y :Z), - pe' = norm 0 1 Zplus Zmult Zminus Zopp Zeq_bool pe -> - x = PEeval 0 Zplus Zmult Zminus Zopp (IDphi (R:=Z)) l pe -> - y = Pphi_dev 0 1 Zplus Zmult 0 1 Zeq_bool (IDphi (R:=Z)) l pe' -> - x=y. -intros; subst x y pe'. -apply - (ring_rw_id_correct (Eqsth Z) (Eq_ext _ _ _) - (Rth_ARth (Eqsth Z) (Eq_ext _ _ _) Zth) Zeq_bool Zeqb_ok). -Qed. -Lemma L' : - forall (l : list Z) (pe : PExpr Z) pe' (x y :Z), - Peq Zeq_bool pe' (norm 0 1 Zplus Zmult Zminus Zopp Zeq_bool pe) = true -> - x = PEeval 0 Zplus Zmult Zminus Zopp (IDphi (R:=Z)) l pe -> - y = Pphi_dev 0 1 Zplus Zmult 0 1 Zeq_bool (IDphi (R:=Z)) l pe' -> - forall (P:Z->Type), P y -> P x. -intros. - rewrite L with (2:=H0) (3:=H1); trivial. -apply (Peq_ok (Eqsth Z) (Eq_ext _ _ _) - (IDmorph 0 1 Zplus Zminus Zmult Zopp (Eqsth Z) Zeq_bool Zeqb_ok) ). - - (IDmorph (Eqsth Z) (Eq_ext _ _ _) Zeqb_ok). - - - (Rth_ARth (Eqsth Z) (Eq_ext _ _ _) Zth)). -Qed. - -eapply L' - with (x:=(a+b)*(a+b)) - (pe:=PEmul (PEadd (PEX Z 1) (PEX Z 2)) (PEadd (PEX Z 1) (PEX Z 2))) - (l:=cons a (cons b (nil Z)));[compute;reflexivity|reflexivity|idtac|idtac];norm_evars;[protect_fv';reflexivity|idtac];norm_evars. - - - - - -set (x:=a). -set (x0:=b). -set (fv:=cons x (cons x0 (nil Z))). -let fv:=constr:(cons a (cons b (nil Z))) in -let lemma := constr : (ring_rw_id_correct (Eqsth Z) (Eq_ext _ _ _) - (Rth_ARth (Eqsth Z) (Eq_ext _ _ _) Zth) Zeq_bool Zeqb_ok) in -let pe := - constr : (PEmul (PEadd (PEX Z 1) (PEX Z 2)) (PEadd (PEX Z 1) (PEX Z 2))) in -assert (Heq := lemma fv pe). -set (npe:=norm 0 1 Zplus Zmult Zminus Zopp Zeq_bool - (PEmul (PEadd (PEX Z 1) (PEX Z 2)) (PEadd (PEX Z 1) (PEX Z 2)))). -fold npe in Heq. -move npe after fv. -let fv' := eval red in fv in -compute in npe. -subst npe. -let fv' := eval red in fv in -compute_without_globals_of (fv',Zplus,0,1,Zmult,Zopp,Zminus) in Heq. -rewrite Heq. -clear Heq fv; subst x x0. - - -simpl in Heq. -unfold Pphi_dev in Heq. -unfold mult_dev in Heq. -unfold P0, Peq in *. -unfold Zeq_bool at 3, Zcompare, Pcompare in Heq. -unfold fv, hd, tl in Heq. -unfold powl, rev, rev_append in Heq. -unfold mkmult1 in Heq. -unfold mkmult in Heq. -unfold add_mult_dev in |- *. -unfold add_mult_dev at 2 in Heq. -unfold P0, Peq at 1 in Heq. -unfold Zeq_bool at 2 3 4 5 6, Zcompare, Pcompare in Heq. -unfold hd, powl, rev, rev_append in Heq. -unfold mkadd_mult in Heq. -unfold mkmult in Heq. -unfold add_mult_dev in Heq. -unfold P0, Peq in Heq. -unfold Zeq_bool, Zcompare, Pcompare in Heq. -unfold hd,powl, rev,rev_append in Heq. -unfold mkadd_mult in Heq. -unfold mkmult in Heq. -unfold IDphi in Heq. - - fv := cons x (cons x0 (nil Z)) - PEmul (PEadd (PEX Z 1) (PEX Z 2)) (PEadd (PEX Z 1) (PEX Z 2)) - Heq : PEeval 0 Zplus Zmult Zminus Zopp (IDphi (R:=Z)) fv - (PEmul (PEadd (PEX Z 1) (PEX Z 2)) (PEadd (PEX Z 1) (PEX Z 2))) = - Pphi_dev 0 1 Zplus Zmult 0 1 Zeq_bool (IDphi (R:=Z)) fv - (norm 0 1 Zplus Zmult Zminus Zopp Zeq_bool - (PEmul (PEadd (PEX Z 1) (PEX Z 2)) (PEadd (PEX Z 1) (PEX Z 2)))) - - - -let Cst_tac := inv_gen_phiZ 0 1 Zplus Zmult Zopp in -let lemma := - constr:(ring_rw_id_correct (Eqsth Z) (Eq_ext _ _ _) - (Rth_ARth (Eqsth Z) (Eq_ext _ _ _) Zth) Zeq_bool Zeqb_ok) in -let req := constr:(eq (A:=Z)) in -let rl := constr:(BinList.cons ((a+b)*(a+b)) (BinList.nil _)) in - match type of lemma with - forall (l:list ?R) (pe:PExpr ?C), - req (PEeval ?rO ?add ?mul ?sub ?opp ?phi l pe) _ => - Constant natcst. - - -Require Import Setoid. -Open Scope nat_scope. - -Require Import Ring_th. -Require Import Arith. - -Add New Ring natr : (SRth_ARth (Eqsth nat) natSRth) - Computational nateq_ok - Constant natcst. - - -Require Import Rbase. -Open Scope R_scope. - - Lemma Rth : ring_theory 0 1 Rplus Rmult Rminus Ropp (@eq R). - Proof. - constructor. exact Rplus_0_l. exact Rplus_comm. - intros;symmetry;apply Rplus_assoc. - exact Rmult_1_l. exact Rmult_comm. - intros;symmetry;apply Rmult_assoc. - exact Rmult_plus_distr_r. trivial. exact Rplus_opp_r. - Qed. - -Add New Ring Rr : Rth Abstract. - -Goal forall a b, (a+b*10)*(a+b*10)=1. -intros. - -Module Zring. - Import Zpol. - Import BinPos. - Import BinInt. - -Ltac is_PCst p := - match p with - | xH => true - | (xO ?p') => is_PCst p' - | (xI ?p') => is_PCst p' - | _ => false - end. - -Ltac ZCst t := - match t with - | Z0 => constr:t - | (Zpos ?p) => - match (is_PCst p) with - | false => NotConstant - | _ => constr:t - end - | (Zneg ?p) => - match (is_PCst p) with - | false => NotConstant - | _ => constr:t - end - | _ => NotConstant - end. - -Ltac zring := - Make_ring_tac ZCst - (Zpol.ring_gen_eq_correct Zth) (Zpol.ring_rw_gen_eq_correct Zth) (@eq Z). - -Ltac zrewrite := - Make_ring_rw3 ZCst (Zpol.ring_rw_gen_eq_correct Zth) (@eq Z). - -Ltac zrewrite_list := - Make_ring_rw3_list ZCst (Zpol.ring_rw_gen_eq_correct Zth) (@eq Z). - -End Zring. -*) - - - -(* -(*** Intanciation for Z*) -Require Import ZArith. -Open Scope Z_scope. - -Module Zring. - Let R := Z. - Let rO := 0. - Let rI := 1. - Let radd := Zplus. - Let rmul := Zmult. - Let rsub := Zminus. - Let ropp := Zopp. - Let Rth := Zth. - Let reqb := Zeq_bool. - Let req_morph := Zeqb_ok. - - (* CE_Entries *) - Let C := R. - Let cO := rO. - Let cI := rI. - Let cadd := radd. - Let cmul := rmul. - Let csub := rsub. - Let copp := ropp. - Let req := (@eq R). - Let ceqb := reqb. - Let phi := @IDphi R. - Let Rsth : Setoid_Theory R req := Eqsth R. - Let Reqe : ring_eq_ext radd rmul ropp req := - (@Eq_ext R radd rmul ropp). - Let ARth : almost_ring_theory rO rI radd rmul rsub ropp req := - (@Rth_ARth R rO rI radd rmul rsub ropp req Rsth Reqe Rth). - Let CRmorph : ring_morph rO rI radd rmul rsub ropp req - cO cI cadd cmul csub copp ceqb phi := - (@IDmorph R rO rI radd rmul rsub ropp req Rsth reqb req_morph). - - Definition Peq := Eval red in (Pol.Peq ceqb). - Definition mkPinj := Eval red in (@Pol.mkPinj C). - Definition mkPX := - Eval red; - change (Pol.Peq ceqb) with Peq; - change (@Pol.mkPinj Z) with mkPinj in - (Pol.mkPX cO ceqb). - - Definition P0 := Eval red in (Pol.P0 cO). - Definition P1 := Eval red in (Pol.P1 cI). - - Definition X := - Eval red; change (Pol.P0 cO) with P0; change (Pol.P1 cI) with P1 in - (Pol.X cO cI). - - Definition mkX := - Eval red; change (Pol.X cO cI) with X in - (mkX cO cI). - - Definition PaddC - Definition PaddI - Definition PaddX - - Definition Padd := - Eval red in - - (Pol.Padd cO cadd ceqb) - - Definition PmulC - Definition PmulI - Definition Pmul_aux - Definition Pmul - - Definition PsubC - Definition PsubI - Definition PsubX - Definition Psub - - - - Definition norm := - Eval red; - change (Pol.Padd cO cadd ceqb) with Padd; - change (Pol.Pmul cO cI cadd cmul ceqb) with Pmul; - change (Pol.Psub cO cadd csub copp ceqb) with Psub; - change (Pol.Popp copp) with Psub; - - in - (Pol.norm cO cI cadd cmul csub copp ceqb). - - - -End Zring. - -Ltac is_PCst p := - match p with - | xH => true - | (xO ?p') => is_PCst p' - | (xI ?p') => is_PCst p' - | _ => false - end. - -Ltac ZCst t := - match t with - | Z0 => constr:t - | (Zpos ?p) => - match (is_PCst p) with - | false => NotConstant - | _ => t - end - | (Zneg ?p) => - match (is_PCst p) with - | false => NotConstant - | _ => t - end - | _ => NotConstant - end. - -Ltac zring := - Zring.Make_ring_tac Zplus Zmult Zminus Zopp (@eq Z) ZCst. - -Ltac zrewrite := - Zring.Make_ring_rw3 Zplus Zmult Zminus Zopp ZCst. -*) - -(* -(* Instanciation for Bool *) -Require Import Bool. - -Module BCE. - Definition R := bool. - Definition rO := false. - Definition rI := true. - Definition radd := xorb. - Definition rmul := andb. - Definition rsub := xorb. - Definition ropp b:bool := b. - Lemma Rth : ring_theory rO rI radd rmul rsub ropp (@eq bool). - Proof. - constructor. - exact false_xorb. - exact xorb_comm. - intros; symmetry in |- *; apply xorb_assoc. - exact andb_true_b. - exact andb_comm. - exact andb_assoc. - destruct x; destruct y; destruct z; reflexivity. - intros; reflexivity. - exact xorb_nilpotent. - Qed. - - Definition reqb := eqb. - Definition req_morph := eqb_prop. -End BCE. - -Module BEntries := CE_Entries BCE. - -Module Bring := MakeRingPol BEntries. - -Ltac BCst t := - match t with - | true => true - | false => false - | _ => NotConstant - end. - -Ltac bring := - Bring.Make_ring_tac xorb andb xorb (fun b:bool => b) (@eq bool) BCst. - -Ltac brewrite := - Zring.Make_ring_rw3 Zplus Zmult Zminus Zopp ZCst. -*) - -(*Module Rring. - -(* Instanciation for R *) -Require Import Rbase. -Open Scope R_scope. - - Lemma Rth : ring_theory 0 1 Rplus Rmult Rminus Ropp (@eq R). - Proof. - constructor. exact Rplus_0_l. exact Rplus_comm. - intros;symmetry;apply Rplus_assoc. - exact Rmult_1_l. exact Rmult_comm. - intros;symmetry;apply Rmult_assoc. - exact Rmult_plus_distr_r. trivial. exact Rplus_opp_r. - Qed. - -Ltac RCst := inv_gen_phiZ 0 1 Rplus Rmul Ropp. - -Ltac rring := - Make_ring_tac RCst - (Zpol.ring_gen_eq_correct Rth) (Zpol.ring_rw_gen_eq_correct Rth) (@eq R). - -Ltac rrewrite := - Make_ring_rw3 RCst (Zpol.ring_rw_gen_eq_correct Rth) (@eq R). - -Ltac rrewrite_list := - Make_ring_rw3_list RCst (Zpol.ring_rw_gen_eq_correct Rth) (@eq R). - -End Rring. -*) -(************************) -(* -(* Instanciation for N *) -Require Import NArith. -Open Scope N_scope. - -Module NCSE. - Definition R := N. - Definition rO := 0. - Definition rI := 1. - Definition radd := Nplus. - Definition rmul := Nmult. - Definition SRth := Nth. - Definition reqb := Neq_bool. - Definition req_morph := Neq_bool_ok. -End NCSE. - -Module NEntries := CSE_Entries NCSE. - -Module Nring := MakeRingPol NEntries. - -Ltac NCst := inv_gen_phiN 0 1 Nplus Nmult. - -Ltac nring := - Nring.Make_ring_tac Nplus Nmult (@SRsub N Nplus) (@SRopp N) (@eq N) NCst. - -Ltac nrewrite := - Nring.Make_ring_rw3 Nplus Nmult (@SRsub N Nplus) (@SRopp N) NCst. - -(* Instanciation for nat *) -Open Scope nat_scope. - -Module NatASE. - Definition R := nat. - Definition rO := 0. - Definition rI := 1. - Definition radd := plus. - Definition rmul := mult. - Lemma SRth : semi_ring_theory O (S O) plus mult (@eq nat). - Proof. - constructor. exact plus_0_l. exact plus_comm. exact plus_assoc. - exact mult_1_l. exact mult_0_l. exact mult_comm. exact mult_assoc. - exact mult_plus_distr_r. - Qed. -End NatASE. - -Module NatEntries := ASE_Entries NatASE. - -Module Natring := MakeRingPol NatEntries. - -Ltac natCst t := - match t with - | O => N0 - | (S ?n) => - match (natCst n) with - | NotConstant => NotConstant - | ?p => constr:(Nsucc p) - end - | _ => NotConstant - end. - -Ltac natring := - Natring.Make_ring_tac plus mult (@SRsub nat plus) (@SRopp nat) (@eq nat) natCst. - -Ltac natrewrite := - Natring.Make_ring_rw3 plus mult (@SRsub nat plus) (@SRopp nat) natCst. - -(* Generic tactic, checks the type of the terms and applies the -suitable instanciation*) - -Ltac newring := - match goal with - | |- (?r1 = ?r2) => - match (type of r1) with - | Z => zring - | R => rring - | bool => bring - | N => nring - | nat => natring - end - end. - -*) diff --git a/contrib/setoid_ring/Ring_th.v b/contrib/setoid_ring/Ring_th.v index 9583dd2d9..a7dacaa75 100644 --- a/contrib/setoid_ring/Ring_th.v +++ b/contrib/setoid_ring/Ring_th.v @@ -1,7 +1,15 @@ -Require Import Setoid. - Set Implicit Arguments. +(************************************************************************) +(* 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 *) +(************************************************************************) +Require Import Setoid. +Set Implicit Arguments. +Module RingSyntax. Reserved Notation "x ?=! y" (at level 70, no associativity). Reserved Notation "x +! y " (at level 50, left associativity). Reserved Notation "x -! y" (at level 50, left associativity). @@ -17,8 +25,8 @@ Reserved Notation "x ** y" (at level 40, left associativity). Reserved Notation "-- x" (at level 35, right associativity). Reserved Notation "x == y" (at level 70, no associativity). - - +End RingSyntax. +Import RingSyntax. Section DEFINITIONS. Variable R : Type. @@ -42,7 +50,7 @@ Section DEFINITIONS. }. (** Almost Ring *) -(*Almost ring are no ring : Ropp_def is missi**) +(*Almost ring are no ring : Ropp_def is missing **) Record almost_ring_theory : Prop := mk_art { ARadd_0_l : forall x, 0 + x == x; ARadd_sym : forall x y, x + y == y + x; @@ -343,6 +351,12 @@ Section ALMOST_RING. (** Usefull lemmas on almost ring *) Variable ARth : almost_ring_theory 0 1 radd rmul rsub ropp req. + Lemma ARth_SRth : semi_ring_theory 0 1 radd rmul req. +Proof. +elim ARth; intros. +constructor; trivial. +Qed. + Lemma ARsub_ext : forall x1 x2, x1 == x2 -> forall y1 y2, y1 == y2 -> x1 - y1 == x2 - y2. Proof. diff --git a/contrib/setoid_ring/ZRing_th.v b/contrib/setoid_ring/ZRing_th.v index 9060428b9..08eb54aa8 100644 --- a/contrib/setoid_ring/ZRing_th.v +++ b/contrib/setoid_ring/ZRing_th.v @@ -1,11 +1,20 @@ -Require Import Ring_th. -Require Import Pol. -Require Import Ring_tac. +(************************************************************************) +(* 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 *) +(************************************************************************) + Require Import ZArith_base. Require Import BinInt. Require Import BinNat. Require Import Setoid. - Set Implicit Arguments. +Require Import Ring_base. +Require Import Pol. +Set Implicit Arguments. + +Import RingSyntax. (** Z is a ring and a setoid*) @@ -255,6 +264,14 @@ Lemma Neq_bool_ok : forall x y, Neq_bool x y = true -> x = y. rewrite H;trivial. Qed. +Lemma Neq_bool_complete : forall x y, Neq_bool x y = true -> x = y. + Proof. + intros x y;unfold Neq_bool. + assert (H:=Ncompare_Eq_eq x y); + destruct (Ncompare x y);intros;try discriminate. + rewrite H;trivial. + Qed. + (**Same as above : definition of two,extensionaly equal, generic morphisms *) (**from N to any semi-ring*) Section NMORPHISM. @@ -326,271 +343,9 @@ Section NMORPHISM. Qed. End NMORPHISM. -(* -Section NNMORPHISM. -Variable R : Type. - Variable (rO rI : R) (radd rmul rsub: R->R->R) (ropp : R -> R). - Variable req : R -> R -> Prop. - Notation "0" := rO. Notation "1" := rI. - Notation "x + y" := (radd x y). Notation "x * y " := (rmul x y). - Notation "x - y " := (rsub x y). Notation "- x" := (ropp x). - Notation "x == y" := (req x y). - Variable Rsth : Setoid_Theory R req. - Add Setoid R req Rsth as R_setoid5. - Ltac rrefl := gen_reflexivity Rsth. - Variable Reqe : ring_eq_ext radd rmul ropp req. - Add Morphism radd : radd_ext5. exact Reqe.(Radd_ext). Qed. - Add Morphism rmul : rmul_ext5. exact Reqe.(Rmul_ext). Qed. - Add Morphism ropp : ropp_ext5. exact Reqe.(Ropp_ext). Qed. - - Lemma SReqe : sring_eq_ext radd rmul req. - case Reqe; constructor; trivial. - Qed. - - Variable ARth : almost_ring_theory 0 1 radd rmul rsub ropp req. - Add Morphism rsub : rsub_ext6. exact (ARsub_ext Rsth Reqe ARth). Qed. - Ltac norm := gen_srewrite 0 1 radd rmul rsub ropp req Rsth Reqe ARth. - Ltac add_push := gen_add_push radd Rsth Reqe ARth. - - Lemma SRth : semi_ring_theory 0 1 radd rmul req. - case ARth; constructor; trivial. - Qed. - - Definition NN := prod N N. - Definition gen_phiNN (x:NN) := - rsub (gen_phiN rO rI radd rmul (fst x)) (gen_phiN rO rI radd rmul (snd x)). - Notation "[ x ]" := (gen_phiNN x). - - Definition NNadd (x y : NN) : NN := - (fst x + fst y, snd x + snd y)%N. - Definition NNmul (x y : NN) : NN := - (fst x * fst y + snd x * snd y, fst y * snd x + fst x * snd y)%N. - Definition NNopp (x:NN) : NN := (snd x, fst x)%N. - Definition NNsub (x y:NN) : NN := (fst x + snd y, fst y + snd x)%N. - - - Lemma gen_phiNN_add : forall x y, [NNadd x y] == [x] + [y]. - Proof. -intros. -unfold NNadd, gen_phiNN in |- *; simpl in |- *. -repeat rewrite (gen_phiN_add Rsth SReqe SRth). -norm. -add_push (- gen_phiN 0 1 radd rmul (snd x)). -rrefl. -Qed. - - Hypothesis ropp_involutive : forall x, - - x == x. - - - Lemma gen_phiNN_mult : forall x y, [NNmul x y] == [x] * [y]. - Proof. -intros. -unfold NNmul, gen_phiNN in |- *; simpl in |- *. -repeat rewrite (gen_phiN_add Rsth SReqe SRth). -repeat rewrite (gen_phiN_mult Rsth SReqe SRth). -norm. -rewrite ropp_involutive. -add_push (- (gen_phiN 0 1 radd rmul (fst y) * gen_phiN 0 1 radd rmul (snd x))). -add_push ( gen_phiN 0 1 radd rmul (snd x) * gen_phiN 0 1 radd rmul (snd y)). -rewrite (ARmul_sym ARth (gen_phiN 0 1 radd rmul (fst y)) - (gen_phiN 0 1 radd rmul (snd x))). -rrefl. -Qed. - - Lemma gen_phiNN_sub : forall x y, [NNsub x y] == [x] - [y]. -intros. -unfold NNsub, gen_phiNN; simpl. -repeat rewrite (gen_phiN_add Rsth SReqe SRth). -repeat rewrite (ARsub_def ARth). -repeat rewrite (ARopp_add ARth). -repeat rewrite (ARadd_assoc ARth). -rewrite ropp_involutive. -add_push (- gen_phiN 0 1 radd rmul (fst y)). -add_push ( - gen_phiN 0 1 radd rmul (snd x)). -rrefl. -Qed. - - -Definition NNeqbool (x y: NN) := - andb (Neq_bool (fst x) (fst y)) (Neq_bool (snd x) (snd y)). - -Lemma NNeqbool_ok0 : forall x y, - NNeqbool x y = true -> x = y. -unfold NNeqbool in |- *. -intros. -assert (Neq_bool (fst x) (fst y) = true). - generalize H. - case (Neq_bool (fst x) (fst y)); simpl in |- *; trivial. - assert (Neq_bool (snd x) (snd y) = true). - rewrite H0 in H; simpl in |- *; trivial. - generalize H0 H1. - destruct x; destruct y; simpl in |- *. - intros. - replace n with n1. - replace n2 with n0; trivial. - apply Neq_bool_ok; trivial. - symmetry in |- *. - apply Neq_bool_ok; trivial. -Qed. - - -(*gen_phiN satisfies morphism specifications*) - Lemma gen_phiNN_morph : ring_morph 0 1 radd rmul rsub ropp req - (N0,N0) (Npos xH,N0) NNadd NNmul NNsub NNopp NNeqbool gen_phiNN. - Proof. - constructor;intros;simpl; try rrefl. - apply gen_phiN_add. apply gen_phiN_sub. apply gen_phiN_mult. - rewrite (Neq_bool_ok x y);trivial. rrefl. - Qed. - -End NNMORPHISM. - -Section NSTARMORPHISM. -Variable R : Type. - Variable (rO rI : R) (radd rmul rsub: R->R->R) (ropp : R -> R). - Variable req : R -> R -> Prop. - Notation "0" := rO. Notation "1" := rI. - Notation "x + y" := (radd x y). Notation "x * y " := (rmul x y). - Notation "x - y " := (rsub x y). Notation "- x" := (ropp x). - Notation "x == y" := (req x y). - Variable Rsth : Setoid_Theory R req. - Add Setoid R req Rsth as R_setoid3. - Ltac rrefl := gen_reflexivity Rsth. - Variable Reqe : ring_eq_ext radd rmul ropp req. - Add Morphism radd : radd_ext3. exact Reqe.(Radd_ext). Qed. - Add Morphism rmul : rmul_ext3. exact Reqe.(Rmul_ext). Qed. - Add Morphism ropp : ropp_ext3. exact Reqe.(Ropp_ext). Qed. - - Lemma SReqe : sring_eq_ext radd rmul req. - case Reqe; constructor; trivial. - Qed. - - Variable ARth : almost_ring_theory 0 1 radd rmul rsub ropp req. - Add Morphism rsub : rsub_ext7. exact (ARsub_ext Rsth Reqe ARth). Qed. - Ltac norm := gen_srewrite 0 1 radd rmul rsub ropp req Rsth Reqe ARth. - Ltac add_push := gen_add_push radd Rsth Reqe ARth. - - Lemma SRth : semi_ring_theory 0 1 radd rmul req. - case ARth; constructor; trivial. - Qed. - - Inductive Nword : Set := - Nlast (p:positive) - | Ndigit (n:N) (w:Nword). - - Fixpoint opp_iter (n:nat) (t:R) {struct n} : R := - match n with - O => t - | S k => ropp (opp_iter k t) - end. - - Fixpoint gen_phiNword (x:Nword) (n:nat) {struct x} : R := - match x with - Nlast p => opp_iter n (gen_phi_pos p) - | Ndigit N0 w => gen_phiNword w (S n) - | Ndigit m w => radd (opp_iter n (gen_phiN m)) (gen_phiNword w (S n)) - end. - Notation "[ x ]" := (gen_phiNword x). - - Fixpoint Nwadd (x y : Nword) {struct x} : Nword := - match x, y with - Nlast p1, Nlast p2 => Nlast (p1+p2)%positive - | Nlast p1, Ndigit n w => Ndigit (Npos p1 + n)%N w - | Ndigit n w, Nlast p1 => Ndigit (n + Npos p1)%N w - | Ndigit n1 w1, Ndigit n2 w2 => Ndigit (n1+n2)%N (Nwadd w1 w2) - end. - Fixpoint Nwmulp (x:positive) (y:Nword) {struct y} : Nword := - match y with - Nlast p => Nlast (x*p)%positive - | Ndigit n w => Ndigit (Npos x * n)%N (Nwmulp x w) - end. - Definition Nwmul (x y : Nword) {struct x} : Nword := - match x with - Nlast k => Nmulp k y - | Ndigit N0 w => Ndigit N0 (Nwmul w y) - | Ndigit (Npos k) w => - Nwadd (Nwmulp k y) (Ndigit N0 (Nwmul w y)) - end. - - Definition Nwopp (x:Nword) : Nword := Ndigit N0 x. - Definition Nwsub (x y:NN) : NN := (Nwadd x (Ndigit N0 y)). - - - Lemma gen_phiNN_add : forall x y, [NNadd x y] == [x] + [y]. - Proof. -intros. -unfold NNadd, gen_phiNN in |- *; simpl in |- *. -repeat rewrite (gen_phiN_add Rsth SReqe SRth). -norm. -add_push (- gen_phiN 0 1 radd rmul (snd x)). -rrefl. -Qed. - - Lemma gen_phiNN_mult : forall x y, [NNmul x y] == [x] * [y]. - Proof. -intros. -unfold NNmul, gen_phiNN in |- *; simpl in |- *. -repeat rewrite (gen_phiN_add Rsth SReqe SRth). -repeat rewrite (gen_phiN_mult Rsth SReqe SRth). -norm. -rewrite ropp_involutive. -add_push (- (gen_phiN 0 1 radd rmul (fst y) * gen_phiN 0 1 radd rmul (snd x))). -add_push ( gen_phiN 0 1 radd rmul (snd x) * gen_phiN 0 1 radd rmul (snd y)). -rewrite (ARmul_sym ARth (gen_phiN 0 1 radd rmul (fst y)) - (gen_phiN 0 1 radd rmul (snd x))). -rrefl. -Qed. - - Lemma gen_phiNN_sub : forall x y, [NNsub x y] == [x] - [y]. -intros. -unfold NNsub, gen_phiNN; simpl. -repeat rewrite (gen_phiN_add Rsth SReqe SRth). -repeat rewrite (ARsub_def ARth). -repeat rewrite (ARopp_add ARth). -repeat rewrite (ARadd_assoc ARth). -rewrite ropp_involutive. -add_push (- gen_phiN 0 1 radd rmul (fst y)). -add_push ( - gen_phiN 0 1 radd rmul (snd x)). -rrefl. -Qed. - - -Definition NNeqbool (x y: NN) := - andb (Neq_bool (fst x) (fst y)) (Neq_bool (snd x) (snd y)). - -Lemma NNeqbool_ok0 : forall x y, - NNeqbool x y = true -> x = y. -unfold NNeqbool in |- *. -intros. -assert (Neq_bool (fst x) (fst y) = true). - generalize H. - case (Neq_bool (fst x) (fst y)); simpl in |- *; trivial. - assert (Neq_bool (snd x) (snd y) = true). - rewrite H0 in H; simpl in |- *; trivial. - generalize H0 H1. - destruct x; destruct y; simpl in |- *. - intros. - replace n with n1. - replace n2 with n0; trivial. - apply Neq_bool_ok; trivial. - symmetry in |- *. - apply Neq_bool_ok; trivial. -Qed. - - -(*gen_phiN satisfies morphism specifications*) - Lemma gen_phiNN_morph : ring_morph 0 1 radd rmul rsub ropp req - (N0,N0) (Npos xH,N0) NNadd NNmul NNsub NNopp NNeqbool gen_phiNN. - Proof. - constructor;intros;simpl; try rrefl. - apply gen_phiN_add. apply gen_phiN_sub. apply gen_phiN_mult. - rewrite (Neq_bool_ok x y);trivial. rrefl. - Qed. - -End NSTARMORPHISM. -*) - (* syntaxification of constants in an abstract ring *) + (* syntaxification of constants in an abstract ring: + the inverse of gen_phiPOS *) Ltac inv_gen_phi_pos rI add mul t := let rec inv_cst t := match t with @@ -600,7 +355,7 @@ End NSTARMORPHISM. | (mul (add rI rI) ?p) => (* 2p *) match inv_cst p with NotConstant => NotConstant - | 1%positive => NotConstant + | 1%positive => NotConstant (* 2*1 is not convertible to 2 *) | ?p => constr:(xO p) end | (add rI (mul (add rI rI) ?p)) => (* 1+2p *) @@ -613,6 +368,7 @@ End NSTARMORPHISM. end in inv_cst t. +(* The inverse of gen_phiN *) Ltac inv_gen_phiN rO rI add mul t := match t with rO => constr:0%N @@ -623,6 +379,7 @@ End NSTARMORPHISM. end end. +(* The inverse of gen_phiZ *) Ltac inv_gen_phiZ rO rI add mul opp t := match t with rO => constr:0%Z @@ -637,6 +394,7 @@ End NSTARMORPHISM. | ?p => constr:(Zpos p) end end. + (* coefs = Z (abstract ring) *) Module Zpol. @@ -650,15 +408,7 @@ Definition ring_gen_correct Definition ring_rw_gen_correct R rO rI radd rmul rsub ropp req rSet req_th Rth := - @Pphi_dev_ok R rO rI radd rmul rsub ropp req rSet req_th - (Rth_ARth rSet req_th Rth) - Z 0%Z 1%Z Zplus Zmult Zminus Zopp Zeq_bool - (@gen_phiZ R rO rI radd rmul ropp) - (@gen_phiZ_morph R rO rI radd rmul rsub ropp req rSet req_th Rth). - -Definition ring_rw_gen_correct' - R rO rI radd rmul rsub ropp req rSet req_th Rth := - @Pphi_dev_ok' R rO rI radd rmul rsub ropp req rSet req_th + @Pphi_dev_ok R rO rI radd rmul rsub ropp req rSet req_th (Rth_ARth rSet req_th Rth) Z 0%Z 1%Z Zplus Zmult Zminus Zopp Zeq_bool (@gen_phiZ R rO rI radd rmul ropp) @@ -672,10 +422,6 @@ Definition ring_rw_gen_eq_correct R rO rI radd rmul rsub ropp Rth := @ring_rw_gen_correct R rO rI radd rmul rsub ropp (@eq R) (Eqsth R) (Eq_ext _ _ _) Rth. -Definition ring_rw_gen_eq_correct' R rO rI radd rmul rsub ropp Rth := - @ring_rw_gen_correct' - R rO rI radd rmul rsub ropp (@eq R) (Eqsth R) (Eq_ext _ _ _) Rth. - End Zpol. (* coefs = N (abstract semi-ring) *) @@ -692,16 +438,7 @@ Definition ring_gen_correct Definition ring_rw_gen_correct R rO rI radd rmul req rSet req_th SRth := - @Pphi_dev_ok R rO rI radd rmul (SRsub radd) (@SRopp R) req rSet - (SReqe_Reqe req_th) - (SRth_ARth rSet SRth) - N 0%N 1%N Nplus Nmult (SRsub Nplus) (@SRopp N) Neq_bool - (@gen_phiN R rO rI radd rmul) - (@gen_phiN_morph R rO rI radd rmul req rSet req_th SRth). - -Definition ring_rw_gen_correct' - R rO rI radd rmul req rSet req_th SRth := - @Pphi_dev_ok' R rO rI radd rmul (SRsub radd) (@SRopp R) req rSet + @Pphi_dev_ok R rO rI radd rmul (SRsub radd) (@SRopp R) req rSet (SReqe_Reqe req_th) (SRth_ARth rSet SRth) N 0%N 1%N Nplus Nmult (SRsub Nplus) (@SRopp N) Neq_bool @@ -712,91 +449,8 @@ Definition ring_gen_eq_correct R rO rI radd rmul SRth := @ring_gen_correct R rO rI radd rmul (@eq R) (Eqsth R) (Eq_s_ext _ _) SRth. -Definition ring_rw_gen_eq_correct R rO rI radd rmul SRth := - @ring_rw_gen_correct - R rO rI radd rmul (@eq R) (Eqsth R) (Eq_s_ext _ _) SRth. - Definition ring_rw_gen_eq_correct' R rO rI radd rmul SRth := - @ring_rw_gen_correct' + @ring_rw_gen_correct R rO rI radd rmul (@eq R) (Eqsth R) (Eq_s_ext _ _) SRth. End Npol. - -(* Z *) - -Ltac isZcst t := - match t with - Z0 => constr:true - | Zpos ?p => isZcst p - | Zneg ?p => isZcst p - | xI ?p => isZcst p - | xO ?p => isZcst p - | xH => constr:true - | _ => constr:false - end. -Ltac Zcst t := - match isZcst t with - true => t - | _ => NotConstant - end. - -Add New Ring Zr : Zth Computational Zeqb_ok Constant Zcst. - -(* N *) - -Ltac isNcst t := - match t with - N0 => constr:true - | Npos ?p => isNcst p - | xI ?p => isNcst p - | xO ?p => isNcst p - | xH => constr:true - | _ => constr:false - end. -Ltac Ncst t := - match isNcst t with - true => t - | _ => NotConstant - end. - -Add New Ring Nr : Nth Computational Neq_bool_ok Constant Ncst. - -(* nat *) - -Ltac isnatcst t := - match t with - O => true - | S ?p => isnatcst p - | _ => false - end. -Ltac natcst t := - match isnatcst t with - true => t - | _ => NotConstant - end. - - Lemma natSRth : semi_ring_theory O (S O) plus mult (@eq nat). - Proof. - constructor. exact plus_0_l. exact plus_comm. exact plus_assoc. - exact mult_1_l. exact mult_0_l. exact mult_comm. exact mult_assoc. - exact mult_plus_distr_r. - Qed. - - -Unboxed Fixpoint nateq (n m:nat) {struct m} : bool := - match n, m with - | O, O => true - | S n', S m' => nateq n' m' - | _, _ => false - end. - -Lemma nateq_ok : forall n m:nat, nateq n m = true -> n = m. -Proof. - simple induction n; simple induction m; simpl; intros; try discriminate. - trivial. - rewrite (H n1 H1). - trivial. -Qed. - -Add New Ring natr : natSRth Computational nateq_ok Constant natcst. - diff --git a/contrib/setoid_ring/newring.ml4 b/contrib/setoid_ring/newring.ml4 index f35b457a5..7526cc8a6 100644 --- a/contrib/setoid_ring/newring.ml4 +++ b/contrib/setoid_ring/newring.ml4 @@ -16,6 +16,7 @@ open Names open Term open Closure open Environ +open Libnames open Tactics open Rawterm open Tacticals @@ -27,11 +28,120 @@ open Setoid_replace open Proof_type open Coqlib open Tacmach -open Ppconstr open Mod_subst open Tacinterp open Libobject open Printer +open Declare +open Decl_kinds +open Entries + +(****************************************************************************) +(* controlled reduction *) + +let mark_arg i c = mkEvar(i,[|c|]);; +let unmark_arg f c = + match destEvar c with + | (i,[|c|]) -> f i c + | _ -> assert false;; + +type protect_flag = Eval|Prot|Rec ;; + +let tag_arg tag_rec map i c = + match map i with + Eval -> inject c + | Prot -> mk_atom c + | Rec -> if i = -1 then inject c else tag_rec c + +let rec mk_clos_but f_map t = + match f_map t with + | Some map -> tag_arg (mk_clos_but f_map) map (-1) t + | None -> + (match kind_of_term t with + App(f,args) -> mk_clos_app_but f_map f args 0 + | _ -> mk_atom t) + +and mk_clos_app_but f_map f args n = + if n >= Array.length args then mk_atom(mkApp(f, args)) + else + let fargs, args' = array_chop n args in + let f' = mkApp(f,fargs) in + match f_map f' with + Some map -> + mk_clos_deep + (fun _ -> unmark_arg (tag_arg (mk_clos_but f_map) map)) + (Esubst.ESID 0) + (mkApp (mark_arg (-1) f', Array.mapi mark_arg args')) + | None -> mk_clos_app_but f_map f args (n+1) +;; + +let interp_map l c = + try + let (im,am) = List.assoc c l in + Some(fun i -> + if List.mem i im then Eval + else if List.mem i am then Prot + else if i = -1 then Eval + else Rec) + with Not_found -> None + +let interp_map l t = + try Some(List.assoc t l) with Not_found -> None + +let protect_maps = ref ([]:(string*(constr->'a)) list) +let add_map s m = protect_maps := (s,m) :: !protect_maps +let lookup_map map = + try List.assoc map !protect_maps + with Not_found -> + errorlabstrm"lookup_map"(str"map "++qs map++str"not found") + +let protect_red map env sigma c = + kl (create_clos_infos betadeltaiota env) + (mk_clos_but (lookup_map map c) c);; + +let protect_tac map = + Tactics.reduct_option (protect_red map,DEFAULTcast) None ;; + +let protect_tac_in map id = + Tactics.reduct_option (protect_red map,DEFAULTcast) (Some(([],id),InHyp));; + + +TACTIC EXTEND protect_fv + [ "protect_fv" string(map) "in" ident(id) ] -> + [ protect_tac_in map id ] +| [ "protect_fv" string(map) ] -> + [ protect_tac map ] +END;; + +(****************************************************************************) + +let closed_term t l = + let l = List.map constr_of_global l in + let cs = List.fold_right Quote.ConstrSet.add l Quote.ConstrSet.empty in + if Quote.closed_under cs t then tclIDTAC else tclFAIL 0 (mt()) +;; + +TACTIC EXTEND closed_term + [ "closed_term" constr(t) "[" ne_reference_list(l) "]" ] -> + [ closed_term t l ] +END +;; +(* +let closed_term_ast l = + TacFun([Some(id_of_string"t")], + TacAtom(dummy_loc,TacExtend(dummy_loc,"closed_term", + [Genarg.in_gen Genarg.wit_constr (mkVar(id_of_string"t")); + Genarg.in_gen (Genarg.wit_list1 Genarg.wit_ref) l]))) +*) +let closed_term_ast l = + let l = List.map (fun gr -> ArgArg(dummy_loc,gr)) l in + TacFun([Some(id_of_string"t")], + TacAtom(dummy_loc,TacExtend(dummy_loc,"closed_term", + [Genarg.in_gen Genarg.globwit_constr (RVar(dummy_loc,id_of_string"t"),None); + Genarg.in_gen (Genarg.wit_list1 Genarg.globwit_ref) l]))) +(* +let _ = add_tacdef false ((dummy_loc,id_of_string"ring_closed_term" +*) (****************************************************************************) (* Library linking *) @@ -40,11 +150,15 @@ let contrib_name = "setoid_ring" let ring_dir = ["Coq";contrib_name] -let setoids_dir = ["Coq";"Setoids"] let ring_modules = [ring_dir@["BinList"];ring_dir@["Ring_th"];ring_dir@["Pol"]; - ring_dir@["Ring_tac"];ring_dir@["ZRing_th"]] -let stdlib_modules = [setoids_dir@["Setoid"]] + ring_dir@["Ring_tac"];ring_dir@["Field_tac"];ring_dir@["ZRing_th"]] +let stdlib_modules = + [["Coq";"Setoids";"Setoid"]; + ["Coq";"ZArith";"BinInt"]; + ["Coq";"ZArith";"Zbool"]; + ["Coq";"NArith";"BinNat"]; + ["Coq";"NArith";"BinPos"]] let coq_constant c = lazy (Coqlib.gen_constant_in_modules "Ring" stdlib_modules c) @@ -66,23 +180,18 @@ let carg c = TacDynamic(dummy_loc,Pretyping.constr_in c) let mk_cst l s = lazy (Coqlib.gen_constant "newring" l s);; let pol_cst s = mk_cst [contrib_name;"Pol"] s ;; -let ic c = - let env = Global.env() and sigma = Evd.empty in - Constrintern.interp_constr sigma env c - - (* Ring theory *) (* almost_ring defs *) let coq_almost_ring_theory = ring_constant "almost_ring_theory" let coq_ring_lemma1 = ring_constant "ring_correct" -let coq_ring_lemma2 = ring_constant "Pphi_dev_ok'" +let coq_ring_lemma2 = ring_constant "Pphi_dev_ok" let ring_comp1 = ring_constant "ring_id_correct" -let ring_comp2 = ring_constant "ring_rw_id_correct'" +let ring_comp2 = ring_constant "ring_rw_id_correct" let ring_abs1 = ringtac_constant "Zpol" "ring_gen_correct" -let ring_abs2 = ringtac_constant "Zpol" "ring_rw_gen_correct'" +let ring_abs2 = ringtac_constant "Zpol" "ring_rw_gen_correct" let sring_abs1 = ringtac_constant "Npol" "ring_gen_correct" -let sring_abs2 = ringtac_constant "Npol" "ring_rw_gen_correct'" +let sring_abs2 = ringtac_constant "Npol" "ring_rw_gen_correct" (* setoid and morphism utilities *) let coq_mk_Setoid = coq_constant "Build_Setoid_Theory" @@ -105,148 +214,138 @@ let coq_SRsub = ring_constant "SRsub" let coq_SRopp = ring_constant "SRopp" let coq_SReqe_Reqe = ring_constant "SReqe_Reqe" -let ltac_setoid_ring = ltac"Make_ring_tac" -let ltac_setoid_ring_rewrite = ltac"Make_ring_rw_list" +let ltac_setoid_ring = ltac"Ring" +let ltac_setoid_ring_rewrite = ltac"Ring_simplify" let ltac_inv_morphZ = zltac"inv_gen_phiZ" let ltac_inv_morphN = zltac"inv_gen_phiN" -let coq_cons = ring_constant "cons" -let coq_nil = ring_constant "nil" + +let list_dir = ["Lists";"List"] +(* let list_dir =[contrib_name;"BinList"] *) +let coq_cons = mk_cst list_dir "cons" +let coq_nil = mk_cst list_dir "nil" let lapp f args = mkApp(Lazy.force f,args) let dest_rel t = match kind_of_term t with App(f,args) when Array.length args >= 2 -> - mkApp(f,Array.sub args 0 (Array.length args - 2)) - | _ -> failwith "cannot find relation" - -(****************************************************************************) -(* controlled reduction *) - -let mark_arg i c = mkEvar(i,[|c|]);; -let unmark_arg f c = - match destEvar c with - | (i,[|c|]) -> f i c - | _ -> assert false;; - -type protect_flag = Eval|Prot|Rec ;; - -let tag_arg tag_rec map i c = - match map i with - Eval -> inject c - | Prot -> mk_atom c - | Rec -> if i = -1 then inject c else tag_rec c - -let rec mk_clos_but f_map t = - match f_map t with - | Some map -> tag_arg (mk_clos_but f_map) map (-1) t - | None -> - (match kind_of_term t with - App(f,args) -> mk_clos_app_but f_map f args 0 - (* unspecified constants are evaluated *) - | _ -> inject t) - -and mk_clos_app_but f_map f args n = - if n >= Array.length args then inject(mkApp(f, args)) - else - let fargs, args' = array_chop n args in - let f' = mkApp(f,fargs) in - match f_map f' with - Some map -> - mk_clos_deep - (fun _ -> unmark_arg (tag_arg (mk_clos_but f_map) map)) - (Esubst.ESID 0) - (mkApp (mark_arg (-1) f', Array.mapi mark_arg args')) - | None -> mk_clos_app_but f_map f args (n+1) -;; - -let interp_map l c = - try - let (im,am) = List.assoc c l in - Some(fun i -> - if List.mem i im then Eval - else if List.mem i am then Prot - else if i = -1 then Eval - else Rec) - with Not_found -> None - -let interp_map l t = - try Some(List.assoc t l) with Not_found -> None - -let arg_map = - [mk_cst [contrib_name;"BinList"] "cons",(function -1->Eval|2->Rec|_->Prot); - mk_cst [contrib_name;"BinList"] "nil", (function -1->Eval|_ -> Prot); - (* Pphi_dev: evaluate polynomial and coef operations, protect - ring operations and make recursive call on morphism and var map *) - pol_cst "Pphi_dev", (function -1|6|7|8|11->Eval|9|10->Rec|_->Prot); - (* PEeval: evaluate polynomial, protect ring operations - and make recursive call on morphism and var map *) - pol_cst "PEeval", (function -1|9->Eval|7|8->Rec|_->Prot); - (* Do not evaluate ring operations... *) - ring_constant "gen_phiZ", (function -1|6->Eval|_->Prot); - ring_constant "gen_phiN", (function -1|5->Eval|_->Prot); -];; + (mkApp(f,Array.sub args 0 (Array.length args - 2)), + args.(Array.length args - 2), + args.(Array.length args - 1)) + | _ -> error "ring: cannot find relation" (* Equality: do not evaluate but make recursive call on both sides *) -let is_ring_thm req = +let map_with_eq arg_map c = + let (req,_,_) = dest_rel c in interp_map ((req,(function -1->Prot|_->Rec)):: List.map (fun (c,map) -> (Lazy.force c,map)) arg_map) ;; -let protect_red env sigma c = - let req = dest_rel c in - kl (create_clos_infos betadeltaiota env) - (mk_clos_but (is_ring_thm req) c);; +let _ = add_map "ring" + (map_with_eq + [coq_cons,(function -1->Eval|2->Rec|_->Prot); + coq_nil, (function -1->Eval|_ -> Prot); + (* Pphi_dev: evaluate polynomial and coef operations, protect + ring operations and make recursive call on the var map *) + pol_cst "Pphi_dev", (function -1|6|7|8|9|11->Eval|10->Rec|_->Prot); + (* PEeval: evaluate morphism and polynomial, protect ring + operations and make recursive call on the var map *) + pol_cst "PEeval", (function -1|7|9->Eval|8->Rec|_->Prot)]);; + +let ic c = + let env = Global.env() and sigma = Evd.empty in + Constrintern.interp_constr sigma env c -let protect_tac = - Tactics.reduct_option (protect_red,DEFAULTcast) None ;; +let ty c = Typing.type_of (Global.env()) Evd.empty c -let protect_tac_in id = - Tactics.reduct_option (protect_red,DEFAULTcast) (Some(([],id),InHyp));; +let decl_constant na c = + mkConst(declare_constant (id_of_string na) (DefinitionEntry + { const_entry_body = c; + const_entry_type = None; + const_entry_opaque = true; + const_entry_boxed = true}, + IsProof Lemma)) -TACTIC EXTEND protect_fv - [ "protect_fv" "in" ident(id) ] -> - [ protect_tac_in id ] -| [ "protect_fv" ] -> - [ protect_tac ] -END;; +let ltac_call tac args = + TacArg(TacCall(dummy_loc, ArgArg(dummy_loc, Lazy.force tac),args)) (****************************************************************************) (* Ring database *) -let ty c = Typing.type_of (Global.env()) Evd.empty c - - type ring_info = { ring_carrier : types; ring_req : constr; ring_cst_tac : glob_tactic_expr; ring_lemma1 : constr; - ring_lemma2 : constr } + ring_lemma2 : constr; + ring_pre_tac : glob_tactic_expr; + ring_post_tac : glob_tactic_expr } module Cmap = Map.Make(struct type t = constr let compare = compare end) let from_carrier = ref Cmap.empty let from_relation = ref Cmap.empty +let from_name = ref Spmap.empty + +let ring_for_carrier r = Cmap.find r !from_carrier +let ring_for_relation rel = Cmap.find rel !from_relation +let ring_lookup_by_name ref = + Spmap.find (Nametab.locate_obj (snd(qualid_of_reference ref))) !from_name + + +let find_ring_structure env sigma l cl oname = + match oname, l with + Some rf, _ -> + (try ring_lookup_by_name rf + with Not_found -> + errorlabstrm "ring" + (str "found no ring named "++pr_reference rf)) + | None, t::cl' -> + let ty = Retyping.get_type_of env sigma t in + let check c = + let ty' = Retyping.get_type_of env sigma c in + if not (Reductionops.is_conv env sigma ty ty') then + errorlabstrm "ring" + (str"arguments of ring_simplify do not have all the same type") + in + List.iter check cl'; + (try ring_for_carrier ty + with Not_found -> + errorlabstrm "ring" + (str"cannot find a declared ring structure over"++ + spc()++str"\""++pr_constr ty++str"\"")) + | None, [] -> + let (req,_,_) = dest_rel cl in + (try ring_for_relation req + with Not_found -> + errorlabstrm "ring" + (str"cannot find a declared ring structure for equality"++ + spc()++str"\""++pr_constr req++str"\"")) let _ = Summary.declare_summary "tactic-new-ring-table" - { Summary.freeze_function = (fun () -> !from_carrier,!from_relation); + { Summary.freeze_function = + (fun () -> !from_carrier,!from_relation,!from_name); Summary.unfreeze_function = - (fun (ct,rt) -> from_carrier := ct; from_relation := rt); + (fun (ct,rt,nt) -> + from_carrier := ct; from_relation := rt; from_name := nt); Summary.init_function = - (fun () -> from_carrier := Cmap.empty; from_relation := Cmap.empty); + (fun () -> + from_carrier := Cmap.empty; from_relation := Cmap.empty; + from_name := Spmap.empty); Summary.survive_module = false; Summary.survive_section = false } -let add_entry _ e = - let _ = ty e.ring_lemma1 in +let add_entry (sp,_kn) e = +(* let _ = ty e.ring_lemma1 in let _ = ty e.ring_lemma2 in +*) from_carrier := Cmap.add e.ring_carrier e !from_carrier; - from_relation := Cmap.add e.ring_req e !from_relation + from_relation := Cmap.add e.ring_req e !from_relation; + from_name := Spmap.add sp e !from_name let subst_th (_,subst,th) = @@ -255,17 +354,23 @@ let subst_th (_,subst,th) = let thm1' = subst_mps subst th.ring_lemma1 in let thm2' = subst_mps subst th.ring_lemma2 in let tac'= subst_tactic subst th.ring_cst_tac in + let pretac'= subst_tactic subst th.ring_pre_tac in + let posttac'= subst_tactic subst th.ring_post_tac in if c' == th.ring_carrier && eq' == th.ring_req && thm1' == th.ring_lemma1 && thm2' == th.ring_lemma2 && - tac' == th.ring_cst_tac then th + tac' == th.ring_cst_tac && + pretac' == th.ring_pre_tac && + posttac' == th.ring_post_tac then th else { ring_carrier = c'; ring_req = eq'; ring_cst_tac = tac'; ring_lemma1 = thm1'; - ring_lemma2 = thm2' } + ring_lemma2 = thm2'; + ring_pre_tac = pretac'; + ring_post_tac = posttac' } let (theory_to_obj, obj_to_theory) = @@ -280,10 +385,6 @@ let (theory_to_obj, obj_to_theory) = export_function = export_th } -let ring_for_carrier r = Cmap.find r !from_carrier - -let ring_for_relation rel = Cmap.find rel !from_relation - let setoid_of_relation r = lapp coq_mk_Setoid [|r.rel_a; r.rel_aeq; @@ -293,14 +394,16 @@ let op_morph r add mul opp req m1 m2 m3 = lapp coq_mk_reqe [| r; add; mul; opp; req; m1; m2; m3 |] let op_smorph r add mul req m1 m2 = - lapp coq_SReqe_Reqe - [| r;add;mul;req;lapp coq_mk_seqe [| r; add; mul; req; m1; m2 |]|] + lapp coq_mk_seqe [| r; add; mul; req; m1; m2 |] + +let smorph2morph r add mul req sm = + lapp coq_SReqe_Reqe [| r;add;mul;req;sm|] let sr_sub r add = lapp coq_SRsub [|r;add|] let sr_opp r = lapp coq_SRopp [|r|] -let dest_morphism kind th sth = - let th_typ = Retyping.get_type_of (Global.env()) Evd.empty th in +let dest_morphism env sigma kind th sth = + let th_typ = Retyping.get_type_of env sigma th in match kind_of_term th_typ with App(f,[|_;_;_;_;_;_;_;_;c;czero;cone;cadd;cmul;csub;copp;ceqb;phi|]) when f = Lazy.force coq_ring_morph -> @@ -311,16 +414,21 @@ let dest_morphism kind th sth = lapp coq_SRmorph_Rmorph [|r;zero;one;add;mul;req;sth;c;czero;cone;cadd;cmul;ceqb;phi;th|]in (th,[|c;czero;cone;cadd;cmul;cadd;sr_opp c;ceqb;phi|]) - | _ -> failwith "bad ring_morph lemma" + | _ -> error "bad ring_morph lemma" -let dest_eq_test th = - let th_typ = Retyping.get_type_of (Global.env()) Evd.empty th in +let dest_eq_test env sigma th = + let th_typ = Retyping.get_type_of env sigma th in match decompose_prod th_typ with (_,h)::_,_ -> (match snd(destApplication h) with - [|_;lhs;_|] -> fst(destApplication lhs) - | _ -> failwith "bad lemma for decidability of equality") - | _ -> failwith "bad lemma for decidability of equality" + [|_;lhs;_|] -> + let (f,args) = destApplication lhs in + if Array.length args < 2 then + error "bad lemma for decidability of equality" + else + mkApp(f,Array.sub args 0 (Array.length args -2)) + | _ -> error "bad lemma for decidability of equality") + | _ -> error "bad lemma for decidability of equality" let default_ring_equality is_semi (r,add,mul,opp,req) = let is_setoid = function @@ -348,7 +456,10 @@ let default_ring_equality is_semi (r,add,mul,opp,req) = error "ring multiplication should be declared as a morphism" in let op_morph = if is_semi <> Some true then - (let opp_m = default_morphism ~filter:is_endomorphism opp in + (let opp_m = + try default_morphism ~filter:is_endomorphism opp + with Not_found -> + error "ring opposite should be declared as a morphism" in let op_morph = op_morph r add mul opp req add_m.lem mul_m.lem opp_m.lem in msgnl @@ -372,8 +483,8 @@ let build_setoid_params is_semi r add mul opp req eqth = Some th -> th | None -> default_ring_equality is_semi (r,add,mul,opp,req) -let dest_ring th_spec = - let th_typ = Retyping.get_type_of (Global.env()) Evd.empty th_spec in +let dest_ring env sigma th_spec = + let th_typ = Retyping.get_type_of env sigma th_spec in match kind_of_term th_typ with App(f,[|r;zero;one;add;mul;sub;opp;req|]) when f = Lazy.force coq_almost_ring_theory -> @@ -403,42 +514,91 @@ type coeff_spec = type cst_tac_spec = CstTac of raw_tactic_expr - | Closed of constr list - - -let add_theory name rth eqth morphth cst_tac = - Coqlib.check_required_library ["Coq";"setoid_ring";"Ring_tac"]; - let (kind,r,zero,one,add,mul,sub,opp,req) = dest_ring rth in + | Closed of reference list + +(* +let ring_equiv_constant c = + lazy (Coqlib.gen_constant_in_modules "Ring" [ring_dir@["Ring_equiv"]] c) +let ring_def_eqb_ok = ring_equiv_constant "default_eqb_ok" +let ring_equiv2 = ring_equiv_constant "ring_equiv2" +let sring_equiv2 = ring_equiv_constant "sring_equiv2" +let ring_m_plus = ring_constant "Radd_ext" +let ring_m_mul = ring_constant "Rmul_ext" +let ring_m_opp = ring_constant "Ropp_ext" + +let old_morph is_semi r add mul opp req morph = + { Ring.plusm = lapp ring_m_plus [|r;add;mul;opp;req;morph|]; + Ring.multm = lapp ring_m_mul [|r;add;mul;opp;req;morph|]; + Ring.oppm = + if is_semi then None + else Some (lapp ring_m_opp [|r;add;mul;opp;req;morph|]) + } + +let add_old_theory env sigma is_semi is_setoid + r zero one add mul sub opp req rth sth ops_morph morphth = +(try + let opp_o = if is_semi then None else Some opp in + let (is_abs, eqb_ok) = + match morphth with + Computational c -> (false, c) + | _ -> (true, lapp ring_def_eqb_ok [|r|]) in + let eqb = dest_eq_test env sigma eqb_ok in + let rth = + if is_setoid then failwith "not impl" + else + if is_semi then + lapp sring_equiv2 [|r;zero;one;add;mul;rth;eqb;eqb_ok|] + else + lapp ring_equiv2 [|r;zero;one;add;mul;sub;opp;rth;eqb;eqb_ok|] in + Ring.add_theory (not is_semi) is_abs is_setoid r + (Some req) (Some sth) + (if is_setoid then Some(old_morph is_semi r add mul opp req ops_morph) + else None) + add mul one zero opp_o eqb rth Quote.ConstrSet.empty +with _ -> + prerr_endline "Warning: could not add old ring structure") +*) + +let add_theory name rth eqth morphth cst_tac (pre,post) = + let env = Global.env() in + let sigma = Evd.empty in + let (kind,r,zero,one,add,mul,sub,opp,req) = dest_ring env sigma rth in let (sth,morph) = build_setoid_params kind r add mul opp req eqth in let args0 = [|r;zero;one;add;mul;sub;opp;req;sth;morph|] in + let args0' = [|r;zero;one;add;mul;req;sth;morph|] in let (lemma1,lemma2) = match morphth with | Computational c -> - let reqb = dest_eq_test c in + let reqb = dest_eq_test env sigma c in let rth = build_almost_ring kind r zero one add mul sub opp req sth morph rth in let args = Array.append args0 [|rth;reqb;c|] in (lapp ring_comp1 args, lapp ring_comp2 args) | Morphism m -> - let (m,args1) = dest_morphism kind m sth in + let (m,args1) = dest_morphism env sigma kind m sth in let rth = build_almost_ring kind r zero one add mul sub opp req sth morph rth in let args = Array.concat [args0;[|rth|]; args1; [|m|]] in (lapp coq_ring_lemma1 args, lapp coq_ring_lemma2 args) | Abstract -> - Coqlib.check_required_library ["Coq";"setoid_ring";"ZRing_th"]; - let args1 = Array.append args0 [|rth|] in + (try check_required_library (ring_dir@["Ring"]) + with UserError _ -> + error "You must require \"Ring\" to declare an abstract ring"); (match kind with None -> error "an almost_ring cannot be abstract" | Some true -> + let args1 = Array.append args0' [|rth|] in (lapp sring_abs1 args1, lapp sring_abs2 args1) | Some false -> + let args1 = Array.append args0 [|rth|] in (lapp ring_abs1 args1, lapp ring_abs2 args1)) in + let lemma1 = decl_constant (string_of_id name^"_ring_lemma1") lemma1 in + let lemma2 = decl_constant (string_of_id name^"_ring_lemma2") lemma2 in let cst_tac = match cst_tac with Some (CstTac t) -> Tacinterp.glob_tactic t - | Some (Closed lc) -> failwith "TODO" + | Some (Closed lc) -> closed_term_ast (List.map Nametab.global lc) | None -> (match kind with Some true -> @@ -448,6 +608,14 @@ let add_theory name rth eqth morphth cst_tac = 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 pretac = + match pre with + Some t -> Tacinterp.glob_tactic t + | _ -> TacId [] in + let posttac = + match post with + Some t -> Tacinterp.glob_tactic t + | _ -> TacId [] in let _ = Lib.add_leaf name (theory_to_obj @@ -455,71 +623,499 @@ let add_theory name rth eqth morphth cst_tac = ring_req = req; ring_cst_tac = cst_tac; ring_lemma1 = lemma1; - ring_lemma2 = lemma2 }) in + ring_lemma2 = lemma2; + ring_pre_tac = pretac; + ring_post_tac = posttac }) in + (* old ring theory *) +(* let _ = + match kind with + Some is_semi -> + add_old_theory env sigma is_semi (eqth <> None) + r zero one add mul sub opp req rth sth morph morphth + | _ -> () in +*) () -VERNAC ARGUMENT EXTEND ring_coefs -| [ "Computational" constr(c)] -> [ Computational (ic c) ] -| [ "Abstract" ] -> [ Abstract ] -| [ "Coefficients" constr(m)] -> [ Morphism (ic m) ] -| [ ] -> [ Abstract ] +type ring_mod = + Ring_kind of coeff_spec + | Const_tac of cst_tac_spec + | Pre_tac of raw_tactic_expr + | Post_tac of raw_tactic_expr + | Setoid of Topconstr.constr_expr * Topconstr.constr_expr + +VERNAC ARGUMENT EXTEND ring_mod + | [ "decidable" constr(eq_test) ] -> [ Ring_kind(Computational (ic eq_test)) ] + | [ "abstract" ] -> [ Ring_kind Abstract ] + | [ "morphism" constr(morph) ] -> [ Ring_kind(Morphism (ic morph)) ] + | [ "constants" "[" tactic(cst_tac) "]" ] -> [ Const_tac(CstTac cst_tac) ] + | [ "closed" "[" ne_global_list(l) "]" ] -> [ Const_tac(Closed l) ] + | [ "preprocess" "[" tactic(pre) "]" ] -> [ Pre_tac pre ] + | [ "postprocess" "[" tactic(post) "]" ] -> [ Post_tac post ] + | [ "setoid" constr(sth) constr(ext) ] -> [ Setoid(sth,ext) ] END -VERNAC ARGUMENT EXTEND ring_cst_tac -| [ "Constant" tactic(c)] -> [ Some(CstTac c) ] -| [ "[" ne_constr_list(l) "]" ] -> [ Some(Closed (List.map ic l)) ] -| [ ] -> [ None ] -END +let set_once s r v = + if !r = None then r := Some v else error (s^" cannot be set twice") + +let process_ring_mods l = + let kind = ref None in + let set = ref None in + let cst_tac = ref None in + let pre = ref None in + let post = ref None in + List.iter(function + Ring_kind k -> set_once "ring kind" kind k + | Const_tac t -> set_once "tactic recognizing constants" cst_tac t + | Pre_tac t -> set_once "preprocess tactic" pre t + | Post_tac t -> set_once "postprocess tactic" post t + | Setoid(sth,ext) -> set_once "setoid" set (ic sth,ic ext)) l; + let k = match !kind with Some k -> k | None -> Abstract in + (k, !set, !cst_tac, !pre, !post) VERNAC COMMAND EXTEND AddSetoidRing -| [ "Add" "New" "Ring" ident(id) ":" constr(t) ring_coefs(c) - "Setoid" constr(e) constr(m) ring_cst_tac(tac) ] -> - [ add_theory id (ic t) (Some (ic e, ic m)) c tac ] -| [ "Add" "New" "Ring" ident(id) ":" constr(t) ring_coefs(c) - ring_cst_tac(tac) ] -> - [ add_theory id (ic t) None c tac ] + | [ "Add" "Ring" ident(id) ":" constr(t) ring_mods(l) ] -> + [ let (k,set,cst,pre,post) = process_ring_mods l in + add_theory id (ic t) set k cst (pre,post) ] END - (*****************************************************************************) (* The tactics consist then only in a lookup in the ring database and call the appropriate ltac. *) let ring gl = - let req = dest_rel (pf_concl gl) in - let e = - try ring_for_relation req - with Not_found -> - errorlabstrm "ring" - (str"cannot find a declared ring structure for equality"++ - spc()++str"\""++pr_constr req++str"\"") in - Tacinterp.eval_tactic - (TacArg(TacCall(dummy_loc, - 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 - -let ring_rewrite rl = - let ty = Retyping.get_type_of (Global.env()) Evd.empty (List.hd rl) in - let e = - try ring_for_carrier ty - with Not_found -> - errorlabstrm "ring" - (str"cannot find a declared ring structure over"++ - spc()++str"\""++pr_constr ty++str"\"") in - let rl = List.fold_right (fun x l -> lapp coq_cons [|ty;x;l|]) rl - (lapp coq_nil [|ty|]) in + let env = pf_env gl in + let sigma = project gl in + let e = find_ring_structure env sigma [] (pf_concl gl) None in + let main_tac = + ltac_call ltac_setoid_ring + (Tacexp e.ring_cst_tac:: List.map carg [e.ring_lemma1;e.ring_req]) in + Tacinterp.eval_tactic (TacThen(e.ring_pre_tac,main_tac)) gl + +let ring_rewrite rl gl = + let env = pf_env gl in + let sigma = project gl in + let e = find_ring_structure env sigma rl (pf_concl gl) None in + let rl = + match rl with + [] -> let (_,t1,t2) = dest_rel (pf_concl gl) in [t1;t2] + | _ -> rl in + let rl = List.fold_right + (fun x l -> lapp coq_cons [|e.ring_carrier;x;l|]) rl + (lapp coq_nil [|e.ring_carrier|]) in + let main_tac = + ltac_call ltac_setoid_ring_rewrite + (Tacexp e.ring_cst_tac::List.map carg [e.ring_lemma2;e.ring_req;rl]) in Tacinterp.eval_tactic - (TacArg(TacCall(dummy_loc, - 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 - | [] -> ring - | l -> ring_rewrite l + (TacThen(e.ring_pre_tac,TacThen(main_tac,e.ring_post_tac))) gl TACTIC EXTEND setoid_ring - [ "setoid" "ring" constr_list(l) ] -> [ setoid_ring l ] + [ "ring" ] -> [ ring ] +| [ "ring_simplify" constr_list(l) ] -> [ ring_rewrite l ] +END + +(***********************************************************************) +let fld_cst s = mk_cst [contrib_name;"NewField"] s ;; + +let field_modules = List.map + (fun f -> ["Coq";contrib_name;f]) + ["NewField";"Field_tac"] + +let new_field_path = + make_dirpath (List.map id_of_string ["Field_tac";contrib_name;"Coq"]) + +let field_constant c = + lazy (Coqlib.gen_constant_in_modules "Field" field_modules c) + +let field_ltac s = + lazy(make_kn (MPfile new_field_path) (make_dirpath []) (mk_label s)) + +let field_lemma = field_constant "Fnorm_correct2" +let field_simplify_eq_lemma = field_constant "Field_simplify_eq_correct" +let field_simplify_lemma = field_constant "Pphi_dev_div_ok" + +let afield_theory = field_constant "almost_field_theory" +let field_theory = field_constant "field_theory" +let sfield_theory = field_constant "semi_field_theory" +let field_Rth = field_constant "AF_AR" + +let field_tac = field_ltac "Make_field_tac" +let field_simplify_eq_tac = field_ltac "Make_field_simplify_eq_tac" +let field_simplify_tac = field_ltac "Make_field_simplify_tac" + + +let _ = add_map "field" + (map_with_eq + [coq_cons,(function -1->Eval|2->Rec|_->Prot); + coq_nil, (function -1->Eval|_ -> Prot); + (* Pphi_dev: evaluate polynomial and coef operations, protect + ring operations and make recursive call on the var map *) + pol_cst "Pphi_dev", (function -1|6|7|8|9|11->Eval|10->Rec|_->Prot); + (* PEeval: evaluate morphism and polynomial, protect ring + operations and make recursive call on the var map *) + pol_cst "PEeval", (function -1|7|9->Eval|8->Rec|_->Prot); +(* fld_cst "FEeval", (function -1|9|11->Eval|10->Rec|_->Prot);*) + (* PCond: evaluate morphism and denum list, protect ring + operations and make recursive call on the var map *) + fld_cst "PCond", (function -1|8|10->Eval|9->Rec|_->Prot)]);; + + +let dest_field env sigma th_spec = + let th_typ = Retyping.get_type_of env sigma th_spec in + match kind_of_term th_typ with + | App(f,[|r;zero;one;add;mul;sub;opp;div;inv;req|]) + when f = Lazy.force afield_theory -> + let rth = lapp field_Rth + [|r;zero;one;add;mul;sub;opp;div;inv;req;th_spec|] in + (None,r,zero,one,add,mul,sub,opp,div,inv,req,rth) + | App(f,[|r;zero;one;add;mul;sub;opp;div;inv;req|]) + when f = Lazy.force field_theory -> + let rth = + lapp (field_constant"F_R") + [|r;zero;one;add;mul;sub;opp;div;inv;req;th_spec|] in + (Some false,r,zero,one,add,mul,sub,opp,div,inv,req,rth) + | App(f,[|r;zero;one;add;mul;div;inv;req|]) + when f = Lazy.force sfield_theory -> + let rth = lapp (field_constant"SF_SR") + [|r;zero;one;add;mul;div;inv;req;th_spec|] in + (Some true,r,zero,one,add,mul,sr_sub r add,sr_opp r,div,inv,req,rth) + | _ -> error "bad field structure" + +let build_almost_field + kind r zero one add mul sub opp div inv req sth morph th = + match kind with + None -> th + | Some true -> + lapp (field_constant "SF2AF") + [|r;zero;one;add;mul;div;inv;req;sth;th|] + | Some false -> + lapp (field_constant "F2AF") + [|r;zero;one;add;mul;sub;opp;div;inv;req;sth;morph;th|] + +type field_info = + { field_carrier : types; + field_req : constr; + field_cst_tac : glob_tactic_expr; + field_ok : constr; + field_simpl_eq_ok : constr; + field_simpl_ok : constr; + field_cond : constr; + field_pre_tac : glob_tactic_expr; + field_post_tac : glob_tactic_expr } + +let field_from_carrier = ref Cmap.empty +let field_from_relation = ref Cmap.empty +let field_from_name = ref Spmap.empty + + +let field_for_carrier r = Cmap.find r !field_from_carrier +let field_for_relation rel = Cmap.find rel !field_from_relation +let field_lookup_by_name ref = + Spmap.find (Nametab.locate_obj (snd(qualid_of_reference ref))) + !field_from_name + + +let find_field_structure env sigma l cl oname = + check_required_library (ring_dir@["Field_tac"]); + match oname, l with + Some rf, _ -> + (try field_lookup_by_name rf + with Not_found -> + errorlabstrm "field" + (str "found no field named "++pr_reference rf)) + | None, t::cl' -> + let ty = Retyping.get_type_of env sigma t in + let check c = + let ty' = Retyping.get_type_of env sigma c in + if not (Reductionops.is_conv env sigma ty ty') then + errorlabstrm "field" + (str"arguments of field_simplify do not have all the same type") + in + List.iter check cl'; + (try field_for_carrier ty + with Not_found -> + errorlabstrm "field" + (str"cannot find a declared field structure over"++ + spc()++str"\""++pr_constr ty++str"\"")) + | None, [] -> + let (req,_,_) = dest_rel cl in + (try field_for_relation req + with Not_found -> + errorlabstrm "field" + (str"cannot find a declared field structure for equality"++ + spc()++str"\""++pr_constr req++str"\"")) + +let _ = + Summary.declare_summary "tactic-new-field-table" + { Summary.freeze_function = + (fun () -> !field_from_carrier,!field_from_relation,!field_from_name); + Summary.unfreeze_function = + (fun (ct,rt,nt) -> + field_from_carrier := ct; field_from_relation := rt; + field_from_name := nt); + Summary.init_function = + (fun () -> + field_from_carrier := Cmap.empty; field_from_relation := Cmap.empty; + field_from_name := Spmap.empty); + Summary.survive_module = false; + Summary.survive_section = false } + +let add_field_entry (sp,_kn) e = + let _ = ty e.field_ok in + let _ = ty e.field_simpl_eq_ok in + let _ = ty e.field_simpl_ok in + let _ = ty e.field_cond in + field_from_carrier := Cmap.add e.field_carrier e !field_from_carrier; + field_from_relation := Cmap.add e.field_req e !field_from_relation; + field_from_name := Spmap.add sp e !field_from_name + + +let subst_th (_,subst,th) = + let c' = subst_mps subst th.field_carrier in + let eq' = subst_mps subst th.field_req in + let thm1' = subst_mps subst th.field_ok in + let thm2' = subst_mps subst th.field_simpl_eq_ok in + let thm3' = subst_mps subst th.field_simpl_ok in + let thm4' = subst_mps subst th.field_cond in + let tac'= subst_tactic subst th.field_cst_tac in + let pretac'= subst_tactic subst th.field_pre_tac in + let posttac'= subst_tactic subst th.field_post_tac in + if c' == th.field_carrier && + eq' == th.field_req && + thm1' == th.field_ok && + thm2' == th.field_simpl_eq_ok && + thm3' == th.field_simpl_ok && + thm4' == th.field_cond && + tac' == th.field_cst_tac && + pretac' == th.field_pre_tac && + posttac' == th.field_post_tac then th + else + { field_carrier = c'; + field_req = eq'; + field_cst_tac = tac'; + field_ok = thm1'; + field_simpl_eq_ok = thm2'; + field_simpl_ok = thm3'; + field_cond = thm4'; + field_pre_tac = pretac'; + field_post_tac = posttac' } + + +let (ftheory_to_obj, obj_to_ftheory) = + let cache_th (name,th) = add_field_entry name th + and export_th x = Some x in + declare_object + {(default_object "tactic-new-field-theory") with + open_function = (fun i o -> if i=1 then cache_th o); + cache_function = cache_th; + subst_function = subst_th; + classify_function = (fun (_,x) -> Substitute x); + export_function = export_th } + +let default_field_equality r inv req = + let is_setoid = function + {rel_refl=Some _; rel_sym=Some _;rel_trans=Some _} -> true + | _ -> false in + match default_relation_for_carrier ~filter:is_setoid r with + Leibniz _ -> + mkApp((Coqlib.build_coq_eq_data()).congr,[|r;r;inv|]) + | Relation rel -> + let is_endomorphism = function + { args=args } -> List.for_all + (function (var,Relation rel) -> + var=None && eq_constr req rel + | _ -> false) args in + let inv_m = + try default_morphism ~filter:is_endomorphism inv + with Not_found -> + error "field inverse should be declared as a morphism" in + inv_m.lem + + +let n_morph r zero one add mul = +[|Lazy.force(coq_constant"N"); +Lazy.force(coq_constant"N0"); +lapp(coq_constant"Npos")[|Lazy.force(coq_constant"xH")|]; +Lazy.force(coq_constant"Nplus"); +Lazy.force(coq_constant"Nmult"); +Lazy.force(coq_constant"Nminus"); +Lazy.force(coq_constant"Nopp"); +Lazy.force(ring_constant"Neq_bool"); +lapp(ring_constant"gen_phiN")[|r;zero;one;add;mul|] +|] +let z_morph r zero one add mul opp = +[|Lazy.force(coq_constant"Z"); +Lazy.force(coq_constant"Z0"); +lapp(coq_constant"Zpos")[|Lazy.force(coq_constant"xH")|]; +Lazy.force(coq_constant"Zplus"); +Lazy.force(coq_constant"Zmult"); +Lazy.force(coq_constant"Zminus"); +Lazy.force(coq_constant"Zopp"); +Lazy.force(coq_constant"Zeq_bool"); +lapp(ring_constant"gen_phiZ")[|r;zero;one;add;mul;opp|] +|] + +let add_field_theory name fth eqth morphth cst_tac inj (pre,post) = + let env = Global.env() in + let sigma = Evd.empty in + let (kind,r,zero,one,add,mul,sub,opp,div,inv,req,rth) = + dest_field env sigma fth in + let (sth,morph) = build_setoid_params None r add mul opp req eqth in + let eqth = Some(sth,morph) in + let _ = add_theory name rth eqth morphth cst_tac (None,None) in + let afth = build_almost_field + kind r zero one add mul sub opp div inv req sth morph fth in + let inv_m = default_field_equality r inv req in + let args0 = + [|r;zero;one;add;mul;sub;opp;div;inv;req;sth;morph;inv_m;afth|] in + let args0' = + [|r;zero;one;add;mul;sub;opp;div;inv;req;sth;morph;afth|] in + let (m,args1) = + match morphth with + Computational c -> + let reqb = dest_eq_test env sigma c in + let idphi = ring_constant "IDphi" in + let idmorph = lapp (ring_constant "IDmorph") + [|r;zero;one;add;mul;sub;opp;req;sth;reqb;c|] in + (idmorph,[|r;zero;one;add;mul;sub;opp;reqb;lapp idphi [|r|]|]) + | Morphism m -> + dest_morphism env sigma kind m sth + | Abstract -> + (match kind with + None -> error "an almost_field cannot be abstract" + | Some true -> + (lapp(ring_constant"gen_phiN_morph") + [|r;zero;one;add;mul;req;sth;morph;rth|], + n_morph r zero one add mul) + | Some false -> + (lapp(ring_constant"gen_phiZ_morph") + [|r;zero;one;add;mul;sub;opp;req;sth;morph;rth|], + z_morph r zero one add mul opp)) in + let args = Array.concat [args0;args1;[|m|]] in + let args' = Array.concat [args0';args1;[|m|]] in + let lemma1 = lapp field_lemma args in + let lemma2 = lapp field_simplify_eq_lemma args in + let lemma3 = lapp field_simplify_lemma args in + let lemma1 = decl_constant (string_of_id name^"_field_lemma1") lemma1 in + let lemma2 = decl_constant (string_of_id name^"_field_lemma2") lemma2 in + let lemma3 = decl_constant (string_of_id name^"_field_lemma3") lemma3 in + let cond_lemma = + match inj with + | Some thm -> + lapp (field_constant"Pcond_simpl_complete") + (Array.append args' [|thm|]) + | None -> lapp (field_constant"Pcond_simpl_gen") args' in + let cond_lemma = decl_constant (string_of_id name^"_lemma4") cond_lemma in + let cst_tac = match cst_tac with + Some (CstTac t) -> Tacinterp.glob_tactic t + | Some (Closed lc) -> closed_term_ast (List.map Nametab.global lc) + | None -> + (match kind with + Some true -> + 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 = 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 pretac = + match pre with + Some t -> Tacinterp.glob_tactic t + | _ -> TacId [] in + let posttac = + match post with + Some t -> Tacinterp.glob_tactic t + | _ -> TacId [] in + let _ = + Lib.add_leaf name + (ftheory_to_obj + { field_carrier = r; + field_req = req; + field_cst_tac = cst_tac; + field_ok = lemma1; + field_simpl_eq_ok = lemma2; + field_simpl_ok = lemma3; + field_cond = cond_lemma; + field_pre_tac = pretac; + field_post_tac = posttac }) in () + +type field_mod = + Ring_mod of ring_mod + | Inject of Topconstr.constr_expr + +VERNAC ARGUMENT EXTEND field_mod + | [ ring_mod(m) ] -> [ Ring_mod m ] + | [ "infinite" constr(inj) ] -> [ Inject inj ] +END + +let process_field_mods l = + let kind = ref None in + let set = ref None in + let cst_tac = ref None in + let pre = ref None in + let post = ref None in + let inj = ref None in + List.iter(function + Ring_mod(Ring_kind k) -> set_once "field kind" kind k + | Ring_mod(Const_tac t) -> + set_once "tactic recognizing constants" cst_tac t + | Ring_mod(Pre_tac t) -> set_once "preprocess tactic" pre t + | Ring_mod(Post_tac t) -> set_once "postprocess tactic" post t + | Ring_mod(Setoid(sth,ext)) -> set_once "setoid" set (ic sth,ic ext) + | Inject i -> set_once "infinite property" inj (ic i)) l; + let k = match !kind with Some k -> k | None -> Abstract in + (k, !set, !inj, !cst_tac, !pre, !post) + +VERNAC COMMAND EXTEND AddSetoidField +| [ "Add" "Field" ident(id) ":" constr(t) field_mods(l) ] -> + [ let (k,set,inj,cst_tac,pre,post) = process_field_mods l in + add_field_theory id (ic t) set k cst_tac inj (pre,post) ] END +let field gl = + let env = pf_env gl in + let sigma = project gl in + let e = find_field_structure env sigma [] (pf_concl gl) None in + let main_tac = + ltac_call field_tac + [carg e.field_ok;carg e.field_cond; + carg e.field_req; Tacexp e.field_cst_tac] in + Tacinterp.eval_tactic + (TacThen(e.field_pre_tac,TacThen(main_tac,e.field_post_tac))) gl + +let field_simplify_eq gl = + let env = pf_env gl in + let sigma = project gl in + let e = find_field_structure env sigma [] (pf_concl gl) None in + let main_tac = + ltac_call field_simplify_eq_tac + [carg e.field_simpl_eq_ok;carg e.field_cond; + carg e.field_req; Tacexp e.field_cst_tac] in + Tacinterp.eval_tactic + (TacThen(e.field_pre_tac,TacThen(main_tac,e.field_post_tac))) gl + +let field_simplify rl gl = + let env = pf_env gl in + let sigma = project gl in + let e = find_field_structure env sigma rl (pf_concl gl) None in + let rl = + match rl with + [] -> let (_,t1,t2) = dest_rel (pf_concl gl) in [t1;t2] + | _ -> rl in + let rl = List.fold_right + (fun x l -> lapp coq_cons [|e.field_carrier;x;l|]) rl + (lapp coq_nil [|e.field_carrier|]) in + let main_tac = + ltac_call field_simplify_tac + [carg e.field_simpl_ok;carg e.field_cond; + carg e.field_req; Tacexp e.field_cst_tac; + carg rl] in + Tacinterp.eval_tactic + (TacThen(e.field_pre_tac,TacThen(main_tac,e.field_post_tac))) gl + +TACTIC EXTEND setoid_field + [ "field" ] -> [ field ] +END +TACTIC EXTEND setoid_field_simplify + [ "field_simplify_eq" ] -> [ field_simplify_eq ] +| [ "field_simplify" constr_list(l) ] -> [ field_simplify l ] +END diff --git a/dev/include b/dev/include index 563edd042..42d2a0171 100644 --- a/dev/include +++ b/dev/include @@ -25,6 +25,7 @@ #install_printer (* tactic *) pptac;; #install_printer (* object *) ppobj;; #install_printer (* global_reference *) ppglobal;; +#install_printer (* generic_argument *) pp_generic_argument;; #install_printer (* fconstr *) ppfconstr;; diff --git a/dev/top_printers.ml b/dev/top_printers.ml index 276918706..e1ee29e4f 100644 --- a/dev/top_printers.ml +++ b/dev/top_printers.ml @@ -27,6 +27,8 @@ open Clenv open Cerrors open Evd open Goptions +open Genarg + let _ = Constrextern.print_evar_arguments := true let _ = set_bool_option_value (SecondaryTable ("Printing","Matching")) false @@ -309,6 +311,39 @@ let ppfconstr c = ppconstr (Closure.term_of_fconstr c) let pploc x = let (l,r) = unloc x in print_string"(";print_int l;print_string",";print_int r;print_string")" +(* extendable tactic arguments *) +let rec pr_argument_type = function + (* Basic types *) + | BoolArgType -> str"bool" + | IntArgType -> str"int" + | IntOrVarArgType -> str"int-or-var" + | StringArgType -> str"string" + | PreIdentArgType -> str"pre-ident" + | IntroPatternArgType -> str"intro-pattern" + | IdentArgType -> str"ident" + | VarArgType -> str"var" + | RefArgType -> str"ref" + (* Specific types *) + | SortArgType -> str"sort" + | ConstrArgType -> str"constr" + | ConstrMayEvalArgType -> str"constr-may-eval" + | QuantHypArgType -> str"qhyp" + | OpenConstrArgType _ -> str"open-constr" + | ConstrWithBindingsArgType -> str"constr-with-bindings" + | BindingsArgType -> str"bindings" + | RedExprArgType -> str"redexp" + | List0ArgType t -> pr_argument_type t ++ str" list0" + | List1ArgType t -> pr_argument_type t ++ str" list1" + | OptArgType t -> pr_argument_type t ++ str" opt" + | PairArgType (t1,t2) -> + str"("++ pr_argument_type t1 ++ str"*" ++ pr_argument_type t2 ++str")" + | ExtraArgType s -> str"\"" ++ str s ++ str "\"" + +let pp_argument_type t = pp (pr_argument_type t) + +let pp_generic_argument arg = + pp(str"<genarg:"++pr_argument_type(genarg_tag arg)++str">") + (**********************************************************************) (* Vernac-level debugging commands *) diff --git a/parsing/q_util.ml4 b/parsing/q_util.ml4 index ac1f3f050..bc8cd40ec 100644 --- a/parsing/q_util.ml4 +++ b/parsing/q_util.ml4 @@ -71,6 +71,15 @@ open Vernacexpr open Pcoq open Genarg +let modifiers e = +<:expr< Gramext.srules + [([], Gramext.action(fun _loc -> [])); + ([Gramext.Stoken ("", "("); + Gramext.Slist1sep ($e$, Gramext.Stoken ("", ",")); + Gramext.Stoken ("", ")")], + Gramext.action (fun _ l _ _loc -> l))] + >> + let rec interp_entry_name loc s = let l = String.length s in if l > 8 & String.sub s 0 3 = "ne_" & String.sub s (l-5) 5 = "_list" then @@ -82,6 +91,9 @@ let rec interp_entry_name loc s = else if l > 4 & String.sub s (l-4) 4 = "_opt" then let t, g = interp_entry_name loc (String.sub s 0 (l-4)) in OptArgType t, <:expr< Gramext.Sopt $g$ >> + else if l > 5 & String.sub s (l-5) 5 = "_mods" then + let t, g = interp_entry_name loc (String.sub s 0 (l-1)) in + List0ArgType t, modifiers g else let s = if s = "hyp" then "var" else s in let t, se, lev = diff --git a/parsing/tacextend.ml4 b/parsing/tacextend.ml4 index 20cf99b1b..f62aaf202 100644 --- a/parsing/tacextend.ml4 +++ b/parsing/tacextend.ml4 @@ -165,7 +165,7 @@ let declare_tactic loc s cl = open Pcoq; declare $list:hidden$ end; try - let _=Refiner.add_tactic $se$ (fun [ $list:make_clauses s cl$ ]) in + let _=Tacinterp.add_tactic $se$ (fun [ $list:make_clauses s cl$ ]) in List.iter (fun s -> Tacinterp.add_primitive_tactic s (Tacexpr.TacAtom($default_loc$, diff --git a/proofs/refiner.ml b/proofs/refiner.ml index 48c9238e0..9d5fb3151 100644 --- a/proofs/refiner.ml +++ b/proofs/refiner.ml @@ -157,31 +157,6 @@ let leaf g = goal = g; ref = None } -(* Tactics table. *) - -let tac_tab = Hashtbl.create 17 - -let add_tactic s t = - if Hashtbl.mem tac_tab s then - errorlabstrm ("Refiner.add_tactic: ") - (str ("Cannot redeclare tactic "^s)); - Hashtbl.add tac_tab s t - -let overwriting_add_tactic s t = - if Hashtbl.mem tac_tab s then begin - Hashtbl.remove tac_tab s; - warning ("Overwriting definition of tactic "^s) - end; - Hashtbl.add tac_tab s t - -let lookup_tactic s = - try - Hashtbl.find tac_tab s - with Not_found -> - errorlabstrm "Refiner.lookup_tactic" - (str"The tactic " ++ str s ++ str" is not installed") - - (* refiner r is a tactic applying the rule r *) let check_subproof_connection gl spfl = @@ -201,6 +176,11 @@ let abstract_operation syntax semantics gls = let abstract_tactic_expr te tacfun gls = abstract_operation (Tactic te) tacfun gls +let abstract_tactic te = abstract_tactic_expr (Tacexpr.TacAtom (dummy_loc,te)) + +let abstract_extended_tactic s args = + abstract_tactic (Tacexpr.TacExtend (dummy_loc, s, args)) + let refiner = function | Prim pr as r -> let prim_fun = prim_refiner pr in @@ -254,20 +234,6 @@ let local_Constraints gl = refiner Change_evars gl let norm_evar_tac = local_Constraints -(* -let vernac_tactic (s,args) = - let tacfun = lookup_tactic s args in - abstract_extra_tactic s args tacfun -*) -let abstract_tactic te = abstract_tactic_expr (Tacexpr.TacAtom (dummy_loc,te)) - -let abstract_extended_tactic s args = - abstract_tactic (Tacexpr.TacExtend (dummy_loc, s, args)) - -let vernac_tactic (s,args) = - let tacfun = lookup_tactic s args in - abstract_extended_tactic s args tacfun - (* [extract_open_proof : proof_tree -> constr * (int * constr) list] takes a (not necessarly complete) proof and gives a pair (pfterm,obl) where pfterm is the constr corresponding to the proof diff --git a/proofs/refiner.mli b/proofs/refiner.mli index 097ff99a9..72afde93e 100644 --- a/proofs/refiner.mli +++ b/proofs/refiner.mli @@ -32,10 +32,6 @@ val apply_sig_tac : type transformation_tactic = proof_tree -> (goal list * validation) -val add_tactic : string -> (closed_generic_argument list -> tactic) -> unit -val overwriting_add_tactic : string -> (closed_generic_argument list -> tactic) -> unit -val lookup_tactic : string -> (closed_generic_argument list) -> tactic - (*s Hiding the implementation of tactics. *) (* [abstract_tactic tac] hides the (partial) proof produced by [tac] under @@ -46,7 +42,6 @@ val abstract_tactic_expr : tactic_expr -> tactic -> tactic val abstract_extended_tactic : string -> closed_generic_argument list -> tactic -> tactic val refiner : rule -> tactic -val vernac_tactic : string * closed_generic_argument list -> tactic val frontier : transformation_tactic val list_pf : proof_tree -> goal list val unTAC : tactic -> goal sigma -> proof_tree sigma diff --git a/tactics/setoid_replace.ml b/tactics/setoid_replace.ml index e9a204ada..b803a878a 100644 --- a/tactics/setoid_replace.ml +++ b/tactics/setoid_replace.ml @@ -155,7 +155,7 @@ let coq_MSCovariant = lazy(constant ["Setoid"] "MSCovariant") let coq_MSContravariant = lazy(constant ["Setoid"] "MSContravariant") let coq_singl = lazy(constant ["Setoid"] "singl") -let coq_cons = lazy(constant ["Setoid"] "cons") +let coq_cons = lazy(constant ["Setoid"] "necons") let coq_equality_morphism_of_asymmetric_areflexive_transitive_relation = lazy(constant ["Setoid"] diff --git a/tactics/tacinterp.ml b/tactics/tacinterp.ml index b6ad913f6..2d9889116 100644 --- a/tactics/tacinterp.ml +++ b/tactics/tacinterp.ml @@ -248,6 +248,34 @@ let _ = Summary.survive_module = false; Summary.survive_section = false } +(* Tactics table (TacExtend). *) + +let tac_tab = Hashtbl.create 17 + +let add_tactic s t = + if Hashtbl.mem tac_tab s then + errorlabstrm ("Refiner.add_tactic: ") + (str ("Cannot redeclare tactic "^s)); + Hashtbl.add tac_tab s t + +let overwriting_add_tactic s t = + if Hashtbl.mem tac_tab s then begin + Hashtbl.remove tac_tab s; + warning ("Overwriting definition of tactic "^s) + end; + Hashtbl.add tac_tab s t + +let lookup_tactic s = + try + Hashtbl.find tac_tab s + with Not_found -> + errorlabstrm "Refiner.lookup_tactic" + (str"The tactic " ++ str s ++ str" is not installed") +(* +let vernac_tactic (s,args) = + let tacfun = lookup_tactic s args in + abstract_extended_tactic s args tacfun +*) (* Interpretation of extra generic arguments *) type glob_sign = { ltacvars : identifier list * identifier list; @@ -2062,7 +2090,10 @@ and interp_atomic ist gl = function (* For extensions *) | TacExtend (loc,opn,l) -> - fun gl -> vernac_tactic (opn,List.map (interp_genarg ist gl) l) gl + let tac = lookup_tactic opn in + fun gl -> + let args = List.map (interp_genarg ist gl) l in + abstract_extended_tactic opn args (tac args) gl | TacAlias (loc,_,l,(_,body)) -> fun gl -> let rec f x = match genarg_tag x with | IntArgType -> @@ -2143,7 +2174,7 @@ let interp_tac_gen lfun debug t gl = ltacvars = (List.map fst lfun, []); ltacrecvars = []; gsigma = project gl; genv = pf_env gl } t) gl -let eval_tactic t = interp_tactic { lfun=[]; debug=get_debug() } t +let eval_tactic t gls = interp_tactic { lfun=[]; debug=get_debug() } t gls let interp t = interp_tac_gen [] (get_debug()) t @@ -2191,7 +2222,7 @@ let subst_induction_arg subst = function | ElimOnIdent id as x -> x let subst_and_short_name f (c,n) = - assert (n=None); (* since tacdef are strictly globalized *) +(* assert (n=None); *)(* since tacdef are strictly globalized *) (f c,None) let subst_or_var f = function diff --git a/tactics/tacinterp.mli b/tactics/tacinterp.mli index f343bc949..ca9b076d9 100644 --- a/tactics/tacinterp.mli +++ b/tactics/tacinterp.mli @@ -64,6 +64,14 @@ val add_tacdef : bool -> (identifier Util.located * raw_tactic_expr) list -> unit val add_primitive_tactic : string -> glob_tactic_expr -> unit +(* Tactic extensions *) +val add_tactic : + string -> (closed_generic_argument list -> tactic) -> unit +val overwriting_add_tactic : + string -> (closed_generic_argument list -> tactic) -> unit +val lookup_tactic : + string -> (closed_generic_argument list) -> tactic + (* Adds an interpretation function for extra generic arguments *) type glob_sign = { ltacvars : identifier list * identifier list; diff --git a/theories/FSets/FMapPositive.v b/theories/FSets/FMapPositive.v index 9008b3623..10f6d44f3 100644 --- a/theories/FSets/FMapPositive.v +++ b/theories/FSets/FMapPositive.v @@ -13,6 +13,7 @@ (* $Id$ *) +Require Import Bool. Require Import ZArith. Require Import OrderedType. Require Import FMapInterface. diff --git a/theories/QArith/QArith_base.v b/theories/QArith/QArith_base.v index f22f12a4c..47be9d236 100644 --- a/theories/QArith/QArith_base.v +++ b/theories/QArith/QArith_base.v @@ -9,7 +9,7 @@ (*i $Id$ i*) Require Export ZArith. -Require Export ZArithRing. +Require Export NewZArithRing. Require Export Setoid. (** * Definition of [Q] and basic properties *) @@ -104,8 +104,10 @@ 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. +transitivity (Qnum x * QDen y * QDen z)%Z; try ring. +rewrite H. +transitivity (Qnum y * QDen z * QDen x)%Z; try ring. +rewrite H0; ring. Qed. (** Furthermore, this equality is decidable: *) @@ -167,10 +169,10 @@ 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. +simpl_mult; ring_simplify. +replace (p1 * 'r2 * 'q2) with (p1 * 'q2 * 'r2) by ring. rewrite H. -replace ('s2 * ('q2 * r1)) with (r1 * 's2 * 'q2) by ring. +replace (r1 * 'p2 * 'q2 * 's2) with (r1 * 's2 * 'p2 * 'q2) by ring. rewrite H0. ring. Close Scope Z_scope. @@ -179,7 +181,11 @@ Qed. Add Morphism Qopp : Qopp_comp. Proof. unfold Qeq, Qopp; simpl. -intros; ring; rewrite H; ring. +Open Scope Z_scope. +intros. +replace (- Qnum x1 * ' Qden x2) with (- (Qnum x1 * ' Qden x2)) by ring. +rewrite H in |- *; ring. +Close Scope Z_scope. Qed. Add Morphism Qminus : Qminus_comp. @@ -194,10 +200,10 @@ 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. +intros; simpl_mult; ring_simplify. +replace (q1 * s1 * 'p2) with (q1 * 'p2 * s1) by ring. rewrite <- H. -replace ('s2 * ('q2 * r1)) with (r1 * 's2 * 'q2) by ring. +replace (p1 * r1 * 'q2 * 's2) with (r1 * 's2 * p1 * 'q2) by ring. rewrite H0. ring. Close Scope Z_scope. @@ -579,14 +585,13 @@ 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. +match goal with |- ?a <= ?b => ring_simplify a b end. +rewrite Zplus_comm. 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. +match goal with |- ?a <= ?b => ring_simplify z1 t1 ('z2) ('t2) a b end. +auto with zarith. +match goal with |- ?a <= ?b => ring_simplify x1 y1 ('x2) ('y2) a b end. +auto with zarith. Close Scope Z_scope. Qed. diff --git a/theories/QArith/Qcanon.v b/theories/QArith/Qcanon.v index 026e850ea..40c310ff4 100644 --- a/theories/QArith/Qcanon.v +++ b/theories/QArith/Qcanon.v @@ -8,6 +8,7 @@ (*i $Id$ i*) +Require Import NewField Field_tac. Require Import QArith. Require Import Znumtheory. Require Import Eqdep_dec. @@ -493,6 +494,7 @@ intros x y; unfold Qc_eq_bool in |- *; case (Qc_eq_dec x y); simpl in |- *; auto intros _ H; inversion H. Qed. +(* Definition Qcrt : Ring_Theory Qcplus Qcmult 1 0 Qcopp Qc_eq_bool. Proof. constructor. @@ -507,17 +509,41 @@ exact Qcmult_plus_distr_l. unfold Is_true; intros x y; generalize (Qc_eq_bool_correct x y); case (Qc_eq_bool x y); auto. Qed. - Add Ring Qc Qcplus Qcmult 1 0 Qcopp Qc_eq_bool Qcrt [ Qcmake ]. +*) +Definition Qcrt : ring_theory 0 1 Qcplus Qcmult Qcminus Qcopp (eq(A:=Qc)). +Proof. +constructor. + exact Qcplus_0_l. + exact Qcplus_comm. + exact Qcplus_assoc. + exact Qcmult_1_l. + exact Qcmult_comm. + exact Qcmult_assoc. + exact Qcmult_plus_distr_l. + reflexivity. + exact Qcplus_opp_r. +Qed. -(** A field tactic for rational numbers *) +Definition Qcft : + field_theory _ 0%Qc 1%Qc Qcplus Qcmult Qcminus Qcopp Qcdiv Qcinv (eq(A:=Qc)). +Proof. +constructor. + exact Qcrt. + exact Q_apart_0_1. + reflexivity. + exact Qcmult_inv_l. +Qed. -Require Import Field. +Add Field Qcfield : Qcft. +(** A field tactic for rational numbers *) + +(* Add Field Qc Qcplus Qcmult 1 0 Qcopp Qc_eq_bool Qcinv Qcrt Qcmult_inv_l with div:=Qcdiv. - -Example test_field : forall x y : Qc, y<>0 -> (x/y)*y = x. +*) +Example test_field : (forall x y : Qc, y<>0 -> (x/y)*y = x)%Qc. intros. field. auto. diff --git a/theories/QArith/Qreals.v b/theories/QArith/Qreals.v index e4b22dd56..5b4d8db03 100644 --- a/theories/QArith/Qreals.v +++ b/theories/QArith/Qreals.v @@ -52,8 +52,9 @@ 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. +field_simplify_eq; auto. +ring_simplify X1 Y2 (Y2 * X1)%R. +rewrite H0 in |- *; ring. Qed. Lemma Rle_Qle : forall x y : Q, (Q2R x <= Q2R y)%R -> x<=y. @@ -176,16 +177,11 @@ 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. +intros; + change (IZR (Zneg x2)) with (- IZR (' x2))%R in |- *; + change (IZR (Zneg p)) with (- IZR (' p))%R in |- *; + field; (*auto 8 with real.*) + repeat split; auto; auto with real. Qed. Lemma Q2R_div : @@ -210,4 +206,4 @@ 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 +Abort. diff --git a/theories/QArith/Qring.v b/theories/QArith/Qring.v index 84a968475..0c4c8399c 100644 --- a/theories/QArith/Qring.v +++ b/theories/QArith/Qring.v @@ -8,8 +8,7 @@ (*i $Id$ i*) -Require Import Ring. -Require Export Setoid_ring. +Require Export Ring. Require Export QArith_base. (** * A ring tactic for rational numbers *) @@ -22,25 +21,38 @@ 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. +Definition Qsrt : ring_theory 0 1 Qplus Qmult Qminus Qopp Qeq. Proof. constructor. +exact Qplus_0_l. exact Qplus_comm. exact Qplus_assoc. +exact Qmult_1_l. 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. +reflexivity. +exact Qplus_opp_r. 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 ]. - +Ltac isQcst t := + let t := eval hnf in t in + match t with + Qmake ?n ?d => + match isZcst n with + true => isZcst d + | _ => false + end + | _ => false + end. + +Ltac Qcst t := + match isQcst t with + true => t + | _ => NotConstant + end. + +Add Ring Qring : Qsrt (decidable Qeq_bool_correct, constants [Qcst]). (** Exemple of use: *) Section Examples. diff --git a/theories/Reals/AltSeries.v b/theories/Reals/AltSeries.v index dc365842b..0dfe58552 100644 --- a/theories/Reals/AltSeries.v +++ b/theories/Reals/AltSeries.v @@ -88,11 +88,9 @@ rewrite Rplus_0_r; replace (Un (S (2 * S N)) + (-1 * Un (S (2 * S N)) + Un (S (S (2 * S N))))) with (Un (S (S (2 * S N)))); [ idtac | ring ]. apply H. -apply INR_eq; rewrite mult_INR; repeat rewrite S_INR; rewrite mult_INR; - repeat rewrite S_INR; ring. +ring_nat. apply HrecN. -apply INR_eq; repeat rewrite S_INR; do 2 rewrite mult_INR; - repeat rewrite S_INR; ring. +ring_nat. Qed. (* A more general inequality *) @@ -293,8 +291,7 @@ rewrite (Rmult_comm (INR (2 * S n + 1))); rewrite Rmult_assoc; do 2 rewrite Rmult_1_r; apply le_INR. replace (2 * S n + 1)%nat with (S (S (2 * n + 1))). apply le_trans with (S (2 * n + 1)); apply le_n_Sn. -apply INR_eq; do 2 rewrite S_INR; do 2 rewrite plus_INR; - do 2 rewrite mult_INR; repeat rewrite S_INR; ring. +ring_nat. apply not_O_INR; discriminate. apply not_O_INR; replace (2 * n + 1)%nat with (S (2 * n)); [ discriminate | ring ]. @@ -445,4 +442,4 @@ rewrite Rmult_1_l; replace (2 + 1) with 3; [ prove_sup0 | ring ]. rewrite Rplus_comm; pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; prove_sup0. assumption. -Qed.
\ No newline at end of file +Qed. diff --git a/theories/Reals/ArithProp.v b/theories/Reals/ArithProp.v index 2ec3e2afb..c05ea465d 100644 --- a/theories/Reals/ArithProp.v +++ b/theories/Reals/ArithProp.v @@ -12,6 +12,8 @@ Require Import Rbase. Require Import Rbasic_fun. Require Import Even. Require Import Div2. +Require Import NewArithRing. + Open Local Scope Z_scope. Open Local Scope R_scope. @@ -175,4 +177,4 @@ replace (S n + 0)%nat with (S n); [ apply le_n_Sn | ring ]. replace (S n + S i)%nat with (S (S n + i)). apply le_S; assumption. apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; do 2 rewrite S_INR; ring. -Qed.
\ No newline at end of file +Qed. diff --git a/theories/Reals/Cauchy_prod.v b/theories/Reals/Cauchy_prod.v index a4fa36c62..972482fe8 100644 --- a/theories/Reals/Cauchy_prod.v +++ b/theories/Reals/Cauchy_prod.v @@ -171,16 +171,17 @@ apply sum_eq; intros; (pred (N - i))). replace (S (S (pred (N - i) + i))) with (S N). replace (N - pred (N - i))%nat with (S i). -ring. +reflexivity. rewrite pred_of_minus; apply INR_eq; repeat rewrite minus_INR. -rewrite S_INR; ring. +rewrite S_INR; simpl; ring. apply le_trans with (pred (pred N)). assumption. apply le_trans with (pred N); apply le_pred_n. apply INR_le; rewrite minus_INR. apply Rplus_le_reg_l with (INR i - 1). -replace (INR i - 1 + INR 1) with (INR i); [ idtac | ring ]. -replace (INR i - 1 + (INR N - INR i)) with (INR N - INR 1); [ idtac | ring ]. +replace (INR i - 1 + INR 1) with (INR i); [ idtac | simpl; ring ]. +replace (INR i - 1 + (INR N - INR i)) with (INR N - INR 1); + [ idtac | simpl; ring ]. rewrite <- minus_INR. apply le_INR; apply le_trans with (pred (pred N)). assumption. @@ -219,15 +220,16 @@ apply S_pred with 0%nat; assumption. apply le_pred_n. apply INR_eq; rewrite pred_of_minus; do 3 rewrite S_INR; rewrite plus_INR; repeat rewrite minus_INR. -ring. +simpl; ring. apply le_trans with (pred (pred N)). assumption. apply le_trans with (pred N); apply le_pred_n. apply INR_le. rewrite minus_INR. apply Rplus_le_reg_l with (INR i - 1). -replace (INR i - 1 + INR 1) with (INR i); [ idtac | ring ]. -replace (INR i - 1 + (INR N - INR i)) with (INR N - INR 1); [ idtac | ring ]. +replace (INR i - 1 + INR 1) with (INR i); [ idtac | simpl; ring ]. +replace (INR i - 1 + (INR N - INR i)) with (INR N - INR 1); + [ idtac | simpl; ring ]. rewrite <- minus_INR. apply le_INR. apply le_trans with (pred (pred N)). @@ -246,7 +248,7 @@ apply INR_le. rewrite pred_of_minus. repeat rewrite minus_INR. apply Rplus_le_reg_l with (INR i - 1). -replace (INR i - 1 + INR 1) with (INR i); [ idtac | ring ]. +replace (INR i - 1 + INR 1) with (INR i); [ idtac | simpl; ring ]. replace (INR i - 1 + (INR N - INR i - INR 1)) with (INR N - INR 1 - INR 1). repeat rewrite <- minus_INR. apply le_INR. @@ -259,7 +261,7 @@ rewrite le_plus_minus_r. simpl in |- *; assumption. apply le_trans with 2%nat; [ apply le_n_Sn | assumption ]. apply le_trans with 2%nat; [ apply le_n_Sn | assumption ]. -ring. +simpl; ring. apply le_trans with (pred (pred N)). assumption. apply le_trans with (pred N); apply le_pred_n. @@ -295,8 +297,7 @@ rewrite (sum_plus (fun k:nat => sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) - (pred (N - k))) (fun k:nat => An (S k) * Bn (S N))) - . + (pred (N - k))) (fun k:nat => An (S k) * Bn (S N))). apply Rplus_eq_compat_l. rewrite scal_sum; reflexivity. apply sum_eq; intros; rewrite Rplus_comm; @@ -310,12 +311,12 @@ apply sum_eq; intros. replace (S N - S i0)%nat with (N - i0)%nat; [ idtac | reflexivity ]. replace (S i0 + i)%nat with (S (i0 + i)). reflexivity. -apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; rewrite S_INR; ring. +apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; rewrite S_INR; simpl; ring. cut ((N - i)%nat = pred (S N - i)). intro; rewrite H5; reflexivity. rewrite pred_of_minus. apply INR_eq; repeat rewrite minus_INR. -rewrite S_INR; ring. +rewrite S_INR; simpl; ring. apply le_trans with N. apply le_trans with (pred N). assumption. @@ -328,7 +329,7 @@ apply le_n_S. apply le_trans with (pred N). assumption. apply le_pred_n. -apply INR_eq; rewrite S_INR; rewrite plus_INR; ring. +apply INR_eq; rewrite S_INR; rewrite plus_INR; simpl; ring. apply le_trans with N. apply le_trans with (pred N). assumption. @@ -351,7 +352,7 @@ assumption. apply le_pred_n. rewrite pred_of_minus. apply INR_eq; repeat rewrite minus_INR. -repeat rewrite S_INR; ring. +repeat rewrite S_INR; simpl; ring. apply le_trans with N. apply le_trans with (pred N). assumption. @@ -364,7 +365,7 @@ apply le_n_S. apply le_trans with (pred N). assumption. apply le_pred_n. -apply INR_eq; rewrite S_INR; rewrite plus_INR; ring. +apply INR_eq; rewrite S_INR; rewrite plus_INR; simpl; ring. apply le_trans with N. apply le_trans with (pred N). assumption. @@ -396,13 +397,13 @@ replace (pred (N - S i)) with (pred (pred (N - i))). apply sum_eq; intros. replace (i0 + S i)%nat with (S (i0 + i)). reflexivity. -apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; rewrite S_INR; ring. +apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; rewrite S_INR; simpl; ring. cut (pred (N - i) = (N - S i)%nat). intro; rewrite H5; reflexivity. rewrite pred_of_minus. apply INR_eq. repeat rewrite minus_INR. -repeat rewrite S_INR; ring. +repeat rewrite S_INR; simpl; ring. apply le_trans with (S (pred (pred N))). apply le_n_S; assumption. replace (S (pred (pred N))) with (pred N). @@ -426,7 +427,7 @@ apply le_trans with (pred (pred N)). assumption. apply le_pred_n. symmetry in |- *; apply S_pred with 0%nat; assumption. -apply INR_eq; rewrite S_INR; rewrite plus_INR; ring. +apply INR_eq; rewrite S_INR; rewrite plus_INR; simpl; ring. apply le_trans with (pred (pred N)). assumption. apply le_trans with (pred N); apply le_pred_n. @@ -448,11 +449,11 @@ cut ((N - pred N)%nat = 1%nat). intro; rewrite H2; reflexivity. rewrite pred_of_minus. apply INR_eq; repeat rewrite minus_INR. -ring. +simpl; ring. apply lt_le_S; assumption. rewrite <- pred_of_minus; apply le_pred_n. simpl in |- *; symmetry in |- *; apply S_pred with 0%nat; assumption. inversion H. left; reflexivity. right; apply lt_le_trans with 1%nat; [ apply lt_n_Sn | exact H1 ]. -Qed.
\ No newline at end of file +Qed. diff --git a/theories/Reals/Cos_plus.v b/theories/Reals/Cos_plus.v index d3040246a..c81ac1acf 100644 --- a/theories/Reals/Cos_plus.v +++ b/theories/Reals/Cos_plus.v @@ -208,10 +208,7 @@ replace (2 * N)%nat with (S (N + pred N)). apply le_n_S. apply plus_le_compat_l; assumption. rewrite pred_of_minus. -apply INR_eq; rewrite S_INR; rewrite plus_INR; rewrite mult_INR; - rewrite minus_INR. -repeat rewrite S_INR; ring. -apply lt_le_S; assumption. +omega. apply Rle_trans with (sum_f_R0 (fun k:nat => @@ -234,31 +231,7 @@ unfold Rdiv in |- *; apply Rmult_le_compat_l. left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. apply C_maj. -apply (fun m n p:nat => mult_le_compat_l p n m). -apply le_n_S. -apply plus_le_compat_r. -apply le_trans with (pred (N - n)). -assumption. -apply le_S_n. -replace (S (pred (N - n))) with (N - n)%nat. -apply le_trans with N. -apply (fun p n m:nat => plus_le_reg_l n m p) with n. -rewrite <- le_plus_minus. -apply le_plus_r. -apply le_trans with (pred N). -assumption. -apply le_pred_n. -apply le_n_Sn. -apply S_pred with 0%nat. -apply plus_lt_reg_l with n. -rewrite <- le_plus_minus. -replace (n + 0)%nat with n; [ idtac | ring ]. -apply le_lt_trans with (pred N). -assumption. -apply lt_pred_n_n; assumption. -apply le_trans with (pred N). -assumption. -apply le_pred_n. +omega. right. unfold Rdiv in |- *; rewrite Rmult_comm. unfold Binomial.C in |- *. @@ -270,9 +243,7 @@ rewrite Rinv_mult_distr. unfold Rsqr in |- *; reflexivity. apply INR_fact_neq_0. apply INR_fact_neq_0. -apply INR_eq; rewrite S_INR; rewrite minus_INR. -rewrite mult_INR; repeat rewrite S_INR; rewrite plus_INR; ring. -apply le_n_2n. +omega. apply INR_fact_neq_0. unfold Rdiv in |- *; rewrite Rmult_comm. unfold Binomial.C in |- *. @@ -282,57 +253,7 @@ rewrite Rmult_1_l. replace (2 * S (N + n) - 2 * S (n0 + n))%nat with (2 * (N - n0))%nat. rewrite mult_INR. reflexivity. -apply INR_eq; rewrite minus_INR. -do 3 rewrite mult_INR; repeat rewrite S_INR; do 2 rewrite plus_INR; - rewrite minus_INR. -ring. -apply le_trans with (pred (N - n)). -assumption. -apply le_S_n. -replace (S (pred (N - n))) with (N - n)%nat. -apply le_trans with N. -apply (fun p n m:nat => plus_le_reg_l n m p) with n. -rewrite <- le_plus_minus. -apply le_plus_r. -apply le_trans with (pred N). -assumption. -apply le_pred_n. -apply le_n_Sn. -apply S_pred with 0%nat. -apply plus_lt_reg_l with n. -rewrite <- le_plus_minus. -replace (n + 0)%nat with n; [ idtac | ring ]. -apply le_lt_trans with (pred N). -assumption. -apply lt_pred_n_n; assumption. -apply le_trans with (pred N). -assumption. -apply le_pred_n. -apply (fun m n p:nat => mult_le_compat_l p n m). -apply le_n_S. -apply plus_le_compat_r. -apply le_trans with (pred (N - n)). -assumption. -apply le_S_n. -replace (S (pred (N - n))) with (N - n)%nat. -apply le_trans with N. -apply (fun p n m:nat => plus_le_reg_l n m p) with n. -rewrite <- le_plus_minus. -apply le_plus_r. -apply le_trans with (pred N). -assumption. -apply le_pred_n. -apply le_n_Sn. -apply S_pred with 0%nat. -apply plus_lt_reg_l with n. -rewrite <- le_plus_minus. -replace (n + 0)%nat with n; [ idtac | ring ]. -apply le_lt_trans with (pred N). -assumption. -apply lt_pred_n_n; assumption. -apply le_trans with (pred N). -assumption. -apply le_pred_n. +omega. apply INR_fact_neq_0. apply Rle_trans with (sum_f_R0 (fun k:nat => INR N / INR (fact (S N)) * C ^ (4 * N)) (pred N)). @@ -352,24 +273,8 @@ unfold C in |- *; apply RmaxLess1. apply Rle_trans with (Rsqr (/ INR (fact (S (N + n)))) * INR N). apply Rmult_le_compat_l. apply Rle_0_sqr. -replace (S (pred (N - n))) with (N - n)%nat. apply le_INR. -apply (fun p n m:nat => plus_le_reg_l n m p) with n. -rewrite <- le_plus_minus. -apply le_plus_r. -apply le_trans with (pred N). -assumption. -apply le_pred_n. -apply S_pred with 0%nat. -apply plus_lt_reg_l with n. -rewrite <- le_plus_minus. -replace (n + 0)%nat with n; [ idtac | ring ]. -apply le_lt_trans with (pred N). -assumption. -apply lt_pred_n_n; assumption. -apply le_trans with (pred N). -assumption. -apply le_pred_n. +omega. rewrite Rmult_comm; unfold Rdiv in |- *; apply Rmult_le_compat_l. apply pos_INR. apply Rle_trans with (/ INR (fact (S (N + n)))). @@ -549,31 +454,7 @@ replace (2 * S (S (N + n)))%nat with (2 * (N - n0) + 1 + (2 * S (n0 + n) + 1))%nat. repeat rewrite pow_add. ring. -apply INR_eq; repeat rewrite plus_INR; do 3 rewrite mult_INR. -rewrite minus_INR. -repeat rewrite S_INR; do 2 rewrite plus_INR; ring. -apply le_trans with (pred (N - n)). -exact H1. -apply le_S_n. -replace (S (pred (N - n))) with (N - n)%nat. -apply le_trans with N. -apply (fun p n m:nat => plus_le_reg_l n m p) with n. -rewrite <- le_plus_minus. -apply le_plus_r. -apply le_trans with (pred N). -assumption. -apply le_pred_n. -apply le_n_Sn. -apply S_pred with 0%nat. -apply plus_lt_reg_l with n. -rewrite <- le_plus_minus. -replace (n + 0)%nat with n; [ idtac | ring ]. -apply le_lt_trans with (pred N). -assumption. -apply lt_pred_n_n; assumption. -apply le_trans with (pred N). -assumption. -apply le_pred_n. +omega. apply INR_fact_neq_0. apply INR_fact_neq_0. apply Rle_ge; left; apply Rinv_0_lt_compat. @@ -602,8 +483,7 @@ apply plus_le_compat_l. apply le_trans with (pred N). assumption. apply le_pred_n. -apply INR_eq; do 2 rewrite S_INR; rewrite plus_INR; rewrite mult_INR. -repeat rewrite S_INR; ring. +ring_nat. apply Rle_trans with (sum_f_R0 (fun k:nat => @@ -632,33 +512,8 @@ apply C_maj. apply le_trans with (2 * S (S (n0 + n)))%nat. replace (2 * S (S (n0 + n)))%nat with (S (2 * S (n0 + n) + 1)). apply le_n_Sn. -apply INR_eq; rewrite S_INR; rewrite plus_INR; do 2 rewrite mult_INR; - repeat rewrite S_INR; rewrite plus_INR; ring. -apply (fun m n p:nat => mult_le_compat_l p n m). -repeat apply le_n_S. -apply plus_le_compat_r. -apply le_trans with (pred (N - n)). -assumption. -apply le_S_n. -replace (S (pred (N - n))) with (N - n)%nat. -apply le_trans with N. -apply (fun p n m:nat => plus_le_reg_l n m p) with n. -rewrite <- le_plus_minus. -apply le_plus_r. -apply le_trans with (pred N). -assumption. -apply le_pred_n. -apply le_n_Sn. -apply S_pred with 0%nat. -apply plus_lt_reg_l with n. -rewrite <- le_plus_minus. -replace (n + 0)%nat with n; [ idtac | ring ]. -apply le_lt_trans with (pred N). -assumption. -apply lt_pred_n_n; assumption. -apply le_trans with (pred N). -assumption. -apply le_pred_n. +ring_nat. +omega. right. unfold Rdiv in |- *; rewrite Rmult_comm. unfold Binomial.C in |- *. @@ -670,9 +525,7 @@ rewrite Rinv_mult_distr. unfold Rsqr in |- *; reflexivity. apply INR_fact_neq_0. apply INR_fact_neq_0. -apply INR_eq; do 2 rewrite S_INR; rewrite minus_INR. -rewrite mult_INR; repeat rewrite S_INR; rewrite plus_INR; ring. -apply le_n_2n. +omega. apply INR_fact_neq_0. unfold Rdiv in |- *; rewrite Rmult_comm. unfold Binomial.C in |- *. @@ -683,62 +536,7 @@ replace (2 * S (S (N + n)) - (2 * S (n0 + n) + 1))%nat with (2 * (N - n0) + 1)%nat. rewrite mult_INR. reflexivity. -apply INR_eq; rewrite minus_INR. -do 2 rewrite plus_INR; do 3 rewrite mult_INR; repeat rewrite S_INR; - do 2 rewrite plus_INR; rewrite minus_INR. -ring. -apply le_trans with (pred (N - n)). -assumption. -apply le_S_n. -replace (S (pred (N - n))) with (N - n)%nat. -apply le_trans with N. -apply (fun p n m:nat => plus_le_reg_l n m p) with n. -rewrite <- le_plus_minus. -apply le_plus_r. -apply le_trans with (pred N). -assumption. -apply le_pred_n. -apply le_n_Sn. -apply S_pred with 0%nat. -apply plus_lt_reg_l with n. -rewrite <- le_plus_minus. -replace (n + 0)%nat with n; [ idtac | ring ]. -apply le_lt_trans with (pred N). -assumption. -apply lt_pred_n_n; assumption. -apply le_trans with (pred N). -assumption. -apply le_pred_n. -apply le_trans with (2 * S (S (n0 + n)))%nat. -replace (2 * S (S (n0 + n)))%nat with (S (2 * S (n0 + n) + 1)). -apply le_n_Sn. -apply INR_eq; rewrite S_INR; rewrite plus_INR; do 2 rewrite mult_INR; - repeat rewrite S_INR; rewrite plus_INR; ring. -apply (fun m n p:nat => mult_le_compat_l p n m). -repeat apply le_n_S. -apply plus_le_compat_r. -apply le_trans with (pred (N - n)). -assumption. -apply le_S_n. -replace (S (pred (N - n))) with (N - n)%nat. -apply le_trans with N. -apply (fun p n m:nat => plus_le_reg_l n m p) with n. -rewrite <- le_plus_minus. -apply le_plus_r. -apply le_trans with (pred N). -assumption. -apply le_pred_n. -apply le_n_Sn. -apply S_pred with 0%nat. -apply plus_lt_reg_l with n. -rewrite <- le_plus_minus. -replace (n + 0)%nat with n; [ idtac | ring ]. -apply le_lt_trans with (pred N). -assumption. -apply lt_pred_n_n; assumption. -apply le_trans with (pred N). -assumption. -apply le_pred_n. +omega. apply INR_fact_neq_0. apply Rle_trans with (sum_f_R0 (fun k:nat => INR N / INR (fact (S (S N))) * C ^ (4 * S N)) @@ -761,22 +559,8 @@ apply Rmult_le_compat_l. apply Rle_0_sqr. replace (S (pred (N - n))) with (N - n)%nat. apply le_INR. -apply (fun p n m:nat => plus_le_reg_l n m p) with n. -rewrite <- le_plus_minus. -apply le_plus_r. -apply le_trans with (pred N). -assumption. -apply le_pred_n. -apply S_pred with 0%nat. -apply plus_lt_reg_l with n. -rewrite <- le_plus_minus. -replace (n + 0)%nat with n; [ idtac | ring ]. -apply le_lt_trans with (pred N). -assumption. -apply lt_pred_n_n; assumption. -apply le_trans with (pred N). -assumption. -apply le_pred_n. +omega. +omega. rewrite Rmult_comm; unfold Rdiv in |- *; apply Rmult_le_compat_l. apply pos_INR. apply Rle_trans with (/ INR (fact (S (S (N + n))))). @@ -806,8 +590,7 @@ rewrite <- Rinv_l_sym. rewrite Rmult_1_r. apply le_INR. apply fact_le. -repeat apply le_n_S. -apply le_plus_l. +omega. apply INR_fact_neq_0. apply INR_fact_neq_0. rewrite sum_cte. @@ -1058,4 +841,4 @@ intro. apply S_pred with 0%nat; assumption. apply lt_le_trans with N; assumption. unfold N in |- *; apply lt_O_Sn. -Qed.
\ No newline at end of file +Qed. diff --git a/theories/Reals/Cos_rel.v b/theories/Reals/Cos_rel.v index ba108e95e..a3dbca23d 100644 --- a/theories/Reals/Cos_rel.v +++ b/theories/Reals/Cos_rel.v @@ -83,7 +83,6 @@ replace ((-1) ^ (n - l) / INR (fact (2 * (n - l) + 1)) * y ^ (2 * (n - l) + 1))) (pred (n - k))) ( pred n)) with (Reste2 x y n). -ring. replace (sum_f_R0 (fun k:nat => @@ -98,7 +97,7 @@ replace sum_f_R0 (fun l:nat => C (2 * k) (2 * l) * x ^ (2 * l) * y ^ (2 * (k - l))) k) (S n)). -set +pose (sin_nnn := fun n:nat => match n with @@ -109,8 +108,10 @@ set (fun l:nat => C (2 * S p) (S (2 * l)) * x ^ S (2 * l) * y ^ S (2 * (p - l))) p end). +ring_simplify. replace - (- +(* (- old ring compat *) + (-1 * sum_f_R0 (fun k:nat => sum_f_R0 @@ -123,19 +124,13 @@ unfold C1 in |- *. apply sum_eq; intros. induction i as [| i Hreci]. simpl in |- *. -rewrite Rplus_0_l. -replace (C 0 0) with 1. -unfold Rdiv in |- *; rewrite Rinv_1. -ring. -unfold C in |- *. -rewrite <- minus_n_n. -simpl in |- *. -unfold Rdiv in |- *; rewrite Rmult_1_r; rewrite Rinv_1; ring. +unfold C in |- *; simpl in |- *. +field; discrR. unfold sin_nnn in |- *. rewrite <- Rmult_plus_distr_l. apply Rmult_eq_compat_l. rewrite binomial. -set (Wn := fun i0:nat => C (2 * S i) i0 * x ^ i0 * y ^ (2 * S i - i0)). +pose (Wn := fun i0:nat => C (2 * S i) i0 * x ^ i0 * y ^ (2 * S i - i0)). replace (sum_f_R0 (fun l:nat => C (2 * S i) (2 * l) * x ^ (2 * l) * y ^ (2 * (S i - l))) @@ -145,42 +140,39 @@ replace (fun l:nat => C (2 * S i) (S (2 * l)) * x ^ S (2 * l) * y ^ S (2 * (i - l))) i) with (sum_f_R0 (fun l:nat => Wn (S (2 * l))) i). -rewrite Rplus_comm. +(*rewrite Rplus_comm.*) (* compatibility old ring... *) apply sum_decomposition. apply sum_eq; intros. unfold Wn in |- *. apply Rmult_eq_compat_l. replace (2 * S i - S (2 * i0))%nat with (S (2 * (i - i0))). reflexivity. -apply INR_eq. -rewrite S_INR; rewrite mult_INR. -repeat rewrite minus_INR. -rewrite mult_INR; repeat rewrite S_INR. -rewrite mult_INR; repeat rewrite S_INR; ring. -replace (2 * S i)%nat with (S (S (2 * i))). -apply le_n_S. -apply le_trans with (2 * i)%nat. -apply (fun m n p:nat => mult_le_compat_l p n m); assumption. -apply le_n_Sn. -apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; - ring. -assumption. +omega. apply sum_eq; intros. unfold Wn in |- *. apply Rmult_eq_compat_l. replace (2 * S i - 2 * i0)%nat with (2 * (S i - i0))%nat. reflexivity. -apply INR_eq. -rewrite mult_INR. -repeat rewrite minus_INR. -rewrite mult_INR; repeat rewrite S_INR. -rewrite mult_INR; repeat rewrite S_INR; ring. -apply (fun m n p:nat => mult_le_compat_l p n m); assumption. -assumption. -rewrite <- (Ropp_involutive (sum_f_R0 sin_nnn (S n))). -apply Ropp_eq_compat. -replace (- sum_f_R0 sin_nnn (S n)) with (-1 * sum_f_R0 sin_nnn (S n)); - [ idtac | ring ]. +omega. +replace (sum_f_R0 sin_nnn (S n)) with (-1 * (-1 * sum_f_R0 sin_nnn (S n))). +(*replace (* compatibility old ring... *) + (- + sum_f_R0 + (fun k:nat => + sum_f_R0 + (fun p:nat => + (-1) ^ p / INR (fact (2 * p + 1)) * x ^ (2 * p + 1) * + ((-1) ^ (k - p) / INR (fact (2 * (k - p) + 1)) * + y ^ (2 * (k - p) + 1))) k) n) with + (-1 * + sum_f_R0 + (fun k:nat => + sum_f_R0 + (fun p:nat => + (-1) ^ p / INR (fact (2 * p + 1)) * x ^ (2 * p + 1) * + ((-1) ^ (k - p) / INR (fact (2 * (k - p) + 1)) * + y ^ (2 * (k - p) + 1))) k) n);[idtac|ring].*) +apply Rmult_eq_compat_l. rewrite scal_sum. rewrite decomp_sum. replace (sin_nnn 0%nat) with 0. @@ -218,25 +210,13 @@ replace (S (2 * i0)) with (2 * i0 + 1)%nat; [ apply Rmult_eq_compat_l | ring ]. replace (2 * S i - (2 * i0 + 1))%nat with (2 * (i - i0) + 1)%nat. reflexivity. -apply INR_eq. -rewrite plus_INR; rewrite mult_INR; repeat rewrite minus_INR. -rewrite plus_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; ring. -replace (2 * i0 + 1)%nat with (S (2 * i0)). -replace (2 * S i)%nat with (S (S (2 * i))). -apply le_n_S. -apply le_trans with (2 * i)%nat. -apply (fun m n p:nat => mult_le_compat_l p n m); assumption. -apply le_n_Sn. -apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; - ring. -apply INR_eq; rewrite S_INR; rewrite plus_INR; rewrite mult_INR; - repeat rewrite S_INR; ring. -assumption. +omega. apply INR_fact_neq_0. apply INR_fact_neq_0. apply INR_fact_neq_0. reflexivity. apply lt_O_Sn. +ring. apply sum_eq; intros. rewrite scal_sum. apply sum_eq; intros. @@ -259,11 +239,7 @@ rewrite Rmult_1_l. rewrite Rinv_mult_distr. replace (2 * i - 2 * i0)%nat with (2 * (i - i0))%nat. reflexivity. -apply INR_eq. -rewrite mult_INR; repeat rewrite minus_INR. -do 2 rewrite mult_INR; repeat rewrite S_INR; ring. -apply (fun m n p:nat => mult_le_compat_l p n m); assumption. -assumption. +omega. apply INR_fact_neq_0. apply INR_fact_neq_0. apply INR_fact_neq_0. diff --git a/theories/Reals/DiscrR.v b/theories/Reals/DiscrR.v index 1c41aeb0c..519593381 100644 --- a/theories/Reals/DiscrR.v +++ b/theories/Reals/DiscrR.v @@ -12,7 +12,7 @@ Require Import RIneq. Require Import Omega. Open Local Scope R_scope. Lemma Rlt_R0_R2 : 0 < 2. -replace 2 with (INR 2); [ apply lt_INR_0; apply lt_O_Sn | reflexivity ]. +change 2 with (INR 2); apply lt_INR_0; apply lt_O_Sn. Qed. Lemma Rplus_lt_pos : forall x y:R, 0 < x -> 0 < y -> 0 < x + y. @@ -36,17 +36,14 @@ Ltac discrR := try match goal with | |- (?X1 <> ?X2) => - replace 2 with (IZR 2); - [ replace 1 with (IZR 1); - [ replace 0 with (IZR 0); - [ repeat - rewrite <- plus_IZR || - rewrite <- mult_IZR || - rewrite <- Ropp_Ropp_IZR || rewrite Z_R_minus; - apply IZR_neq; try discriminate - | reflexivity ] - | reflexivity ] - | reflexivity ] + change 2 with (IZR 2); + change 1 with (IZR 1); + change 0 with (IZR 0); + repeat + rewrite <- plus_IZR || + rewrite <- mult_IZR || + rewrite <- Ropp_Ropp_IZR || rewrite Z_R_minus; + apply IZR_neq; try discriminate end. Ltac prove_sup0 := @@ -60,17 +57,13 @@ Ltac prove_sup0 := end. Ltac omega_sup := - replace 2 with (IZR 2); - [ replace 1 with (IZR 1); - [ replace 0 with (IZR 0); - [ repeat - rewrite <- plus_IZR || - rewrite <- mult_IZR || - rewrite <- Ropp_Ropp_IZR || rewrite Z_R_minus; - apply IZR_lt; omega - | reflexivity ] - | reflexivity ] - | reflexivity ]. + change 2 with (IZR 2); + change 1 with (IZR 1); + change 0 with (IZR 0); + repeat + rewrite <- plus_IZR || + rewrite <- mult_IZR || rewrite <- Ropp_Ropp_IZR || rewrite Z_R_minus; + apply IZR_lt; omega. Ltac prove_sup := match goal with @@ -84,14 +77,10 @@ Ltac prove_sup := end. Ltac Rcompute := - replace 2 with (IZR 2); - [ replace 1 with (IZR 1); - [ replace 0 with (IZR 0); - [ repeat - rewrite <- plus_IZR || - rewrite <- mult_IZR || - rewrite <- Ropp_Ropp_IZR || rewrite Z_R_minus; - apply IZR_eq; try reflexivity - | reflexivity ] - | reflexivity ] - | reflexivity ].
\ No newline at end of file + change 2 with (IZR 2); + change 1 with (IZR 1); + change 0 with (IZR 0); + repeat + rewrite <- plus_IZR || + rewrite <- mult_IZR || rewrite <- Ropp_Ropp_IZR || rewrite Z_R_minus; + apply IZR_eq; try reflexivity. diff --git a/theories/Reals/Exp_prop.v b/theories/Reals/Exp_prop.v index b0849be4a..a44bf1456 100644 --- a/theories/Reals/Exp_prop.v +++ b/theories/Reals/Exp_prop.v @@ -83,8 +83,7 @@ intro; induction N as [| N HrecN]. reflexivity. replace (2 * S N)%nat with (S (S (2 * N))). simpl in |- *; simpl in HrecN; rewrite HrecN; reflexivity. -apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; - ring. +ring_nat. Qed. Lemma div2_S_double : forall N:nat, div2 (S (2 * N)) = N. @@ -92,8 +91,7 @@ intro; induction N as [| N HrecN]. reflexivity. replace (2 * S N)%nat with (S (S (2 * N))). simpl in |- *; simpl in HrecN; rewrite HrecN; reflexivity. -apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; - ring. +ring_nat. Qed. Lemma div2_not_R0 : forall N:nat, (1 < N)%nat -> (0 < div2 N)%nat. @@ -315,7 +313,7 @@ ring. replace N with (N0 + N0)%nat. symmetry in |- *; apply minus_plus. rewrite H4. -apply INR_eq; rewrite plus_INR; rewrite mult_INR; do 2 rewrite S_INR; ring. +ring. apply INR_fact_neq_0. apply INR_fact_neq_0. apply INR_fact_neq_0. @@ -362,8 +360,7 @@ apply H. apply le_trans with (pred N). apply H0. apply le_pred_n. -apply INR_eq; rewrite H4. -do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; ring. +rewrite H4; ring_nat. cut (S N = (2 * S N0)%nat). intro. replace (C (S N) (S N0) / INR (fact (S N))) with (/ Rsqr (INR (fact (S N0)))). @@ -384,8 +381,7 @@ apply INR_fact_neq_0. apply INR_fact_neq_0. apply INR_fact_neq_0. apply INR_fact_neq_0. -apply INR_eq; rewrite H4; do 2 rewrite S_INR; do 2 rewrite mult_INR; - repeat rewrite S_INR; ring. +rewrite H4; ring_nat. unfold C, Rdiv in |- *. rewrite (Rmult_comm (INR (fact (S N)))). rewrite Rmult_assoc; rewrite <- Rinv_r_sym. @@ -491,8 +487,7 @@ rewrite Rmult_1_r. simpl in |- *. pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left; apply Rlt_0_1. -apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; - ring. +ring_nat. unfold Rsqr in |- *; apply prod_neq_R0; apply INR_fact_neq_0. unfold Rsqr in |- *; apply prod_neq_R0; apply not_O_INR; discriminate. assert (H0 := even_odd_cor N). @@ -506,23 +501,14 @@ replace (pred (S (S (2 * pred N0)))) with (S (2 * pred N0)). rewrite div2_S_double. apply S_pred with 0%nat; apply H3. reflexivity. -replace N0 with (S (pred N0)). -apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; - ring. -symmetry in |- *; apply S_pred with 0%nat; apply H3. -rewrite H2 in H. -apply neq_O_lt. -red in |- *; intro. -rewrite <- H3 in H. -simpl in H. -elim (lt_n_O _ H). +omega. +omega. rewrite H2. replace (pred (S (2 * N0))) with (2 * N0)%nat; [ idtac | reflexivity ]. replace (S (S (2 * N0))) with (2 * S N0)%nat. do 2 rewrite div2_double. reflexivity. -apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; - ring. +ring_nat. apply S_pred with 0%nat; apply H. Qed. @@ -575,28 +561,15 @@ intro. rewrite H6. replace (pred (2 * N1)) with (S (2 * pred N1)). rewrite div2_S_double. -replace (S (pred N1)) with N1. -apply INR_le. -right. -do 3 rewrite mult_INR; repeat rewrite S_INR; ring. -apply S_pred with 0%nat; apply H7. -replace (2 * N1)%nat with (S (S (2 * pred N1))). -reflexivity. -pattern N1 at 2 in |- *; replace N1 with (S (pred N1)). -apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; - ring. -symmetry in |- *; apply S_pred with 0%nat; apply H7. -apply INR_lt. -apply Rmult_lt_reg_l with (INR 2). -simpl in |- *; prove_sup0. -rewrite Rmult_0_r; rewrite <- mult_INR. -apply lt_INR_0. -rewrite <- H6. +omega. +omega. +assert (0 < n)%nat. apply lt_le_trans with 2%nat. apply lt_O_Sn. apply le_trans with (max (2 * S N0) 2). apply le_max_r. apply H3. +omega. rewrite H6. replace (pred (S (2 * N1))) with (2 * N1)%nat. rewrite div2_double. @@ -604,9 +577,8 @@ replace (4 * S N1)%nat with (2 * (2 * S N1))%nat. apply (fun m n p:nat => mult_le_compat_l p n m). replace (2 * S N1)%nat with (S (S (2 * N1))). apply le_n_Sn. -apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; - ring. -ring. +ring_nat. +ring_nat. reflexivity. apply INR_fact_neq_0. apply INR_fact_neq_0. @@ -643,8 +615,7 @@ apply S_pred with 0%nat; apply H8. replace (2 * N1)%nat with (S (S (2 * pred N1))). reflexivity. pattern N1 at 2 in |- *; replace N1 with (S (pred N1)). -apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; - ring. +ring_nat. symmetry in |- *; apply S_pred with 0%nat; apply H8. apply INR_lt. apply Rmult_lt_reg_l with (INR 2). @@ -662,8 +633,7 @@ replace (pred (S (2 * N1))) with (2 * N1)%nat. rewrite div2_double. replace (2 * S N1)%nat with (S (S (2 * N1))). apply le_n_Sn. -apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; - ring. +ring_nat. reflexivity. apply le_trans with (max (2 * S N0) 2). apply le_max_l. diff --git a/theories/Reals/PartSum.v b/theories/Reals/PartSum.v index 9fe077a4e..74f93cb87 100644 --- a/theories/Reals/PartSum.v +++ b/theories/Reals/PartSum.v @@ -262,8 +262,7 @@ rewrite (tech5 An (S (2 * S N))). rewrite (tech5 An (2 * S N)). rewrite <- HrecN. ring. -apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR. -ring. +ring_nat. Qed. Lemma sum_Rle : diff --git a/theories/Reals/RIneq.v b/theories/Reals/RIneq.v index 70bc25eff..3b5d241fa 100644 --- a/theories/Reals/RIneq.v +++ b/theories/Reals/RIneq.v @@ -13,9 +13,9 @@ (***************************************************************************) Require Export Raxioms. -Require Export ZArithRing. +Require Export NewZArithRing. Require Import Omega. -Require Export Field. +Require Export Field_tac. Import NewField. Open Local Scope Z_scope. Open Local Scope R_scope. @@ -26,25 +26,105 @@ Implicit Type r : R. (** Instantiating Ring tactic on reals *) (***************************************************************************) -Lemma RTheory : Ring_Theory Rplus Rmult 1 0 Ropp (fun x y:R => false). - split. - exact Rplus_comm. - symmetry in |- *; apply Rplus_assoc. - exact Rmult_comm. - symmetry in |- *; apply Rmult_assoc. - intro; apply Rplus_0_l. - intro; apply Rmult_1_l. - exact Rplus_opp_r. - intros. - rewrite Rmult_comm. - rewrite (Rmult_comm n p). - rewrite (Rmult_comm m p). - apply Rmult_plus_distr_l. - intros; contradiction. -Defined. - -Add Field R Rplus Rmult 1 0 Ropp (fun x y:R => false) Rinv RTheory Rinv_l - with minus := Rminus div := Rdiv. +Lemma RTheory : ring_theory 0 1 Rplus Rmult Rminus Ropp (eq (A:=R)). +Proof. +constructor. + intro; apply Rplus_0_l. + exact Rplus_comm. + symmetry in |- *; apply Rplus_assoc. + intro; apply Rmult_1_l. + exact Rmult_comm. + symmetry in |- *; apply Rmult_assoc. + intros m n p. + rewrite Rmult_comm in |- *. + rewrite (Rmult_comm n p) in |- *. + rewrite (Rmult_comm m p) in |- *. + apply Rmult_plus_distr_l. + reflexivity. + exact Rplus_opp_r. +Qed. + +Lemma Rfield : + field_theory R 0 1 Rplus Rmult Rminus Ropp Rdiv Rinv (eq(A:=R)). +Proof. +constructor. + exact RTheory. + exact R1_neq_R0. + reflexivity. + exact Rinv_l. +Qed. + +Lemma Rlt_n_Sn : forall x, x < x + 1. +Proof. +intro. +elim archimed with x; intros. +destruct H0. + apply Rlt_trans with (IZR (up x)); trivial. + replace (IZR (up x)) with (x + (IZR (up x) - x))%R. + apply Rplus_lt_compat_l; trivial. + unfold Rminus in |- *. + rewrite (Rplus_comm (IZR (up x)) (- x)) in |- *. + rewrite <- Rplus_assoc in |- *. + rewrite Rplus_opp_r in |- *. + apply Rplus_0_l. + elim H0. + unfold Rminus in |- *. + rewrite (Rplus_comm (IZR (up x)) (- x)) in |- *. + rewrite <- Rplus_assoc in |- *. + rewrite Rplus_opp_r in |- *. + rewrite Rplus_0_l in |- *; trivial. +Qed. + +Notation Rset := (Eqsth R). +Notation Rext := (Eq_ext Rplus Rmult Ropp). + +Lemma Rlt_0_2 : 0 < 2. +apply Rlt_trans with (0 + 1). + apply Rlt_n_Sn. + rewrite Rplus_comm in |- *. + apply Rplus_lt_compat_l. + replace 1 with (0 + 1). + apply Rlt_n_Sn. + apply Rplus_0_l. +Qed. + +Lemma Rgen_phiPOS : forall x, ZRing_th.gen_phiPOS1 1 Rplus Rmult x > 0. +unfold Rgt in |- *. +induction x; simpl in |- *; intros. + apply Rlt_trans with (1 + 0). + rewrite Rplus_comm in |- *. + apply Rlt_n_Sn. + apply Rplus_lt_compat_l. + rewrite <- (Rmul_0_l Rset Rext RTheory 2) in |- *. + rewrite Rmult_comm in |- *. + apply Rmult_lt_compat_l. + apply Rlt_0_2. + trivial. + rewrite <- (Rmul_0_l Rset Rext RTheory 2) in |- *. + rewrite Rmult_comm in |- *. + apply Rmult_lt_compat_l. + apply Rlt_0_2. + trivial. + replace 1 with (0 + 1). + apply Rlt_n_Sn. + apply Rplus_0_l. +Qed. + + +Lemma Rgen_phiPOS_not_0 : forall x, ZRing_th.gen_phiPOS1 1 Rplus Rmult x <> 0. +red in |- *; intros. +specialize (Rgen_phiPOS x). +rewrite H in |- *; intro. +apply (Rlt_asym 0 0); trivial. +Qed. + +Lemma Zeq_bool_complete : forall x y, + ZRing_th.gen_phiZ 0%R 1%R Rplus Rmult Ropp x = + ZRing_th.gen_phiZ 0%R 1%R Rplus Rmult Ropp y -> + Zeq_bool x y = true. +Proof gen_phiZ_complete _ _ _ _ _ _ _ _ _ _ Rset Rext Rfield Rgen_phiPOS_not_0. + +Add Field RField : Rfield (infinite Zeq_bool_complete). (**************************************************************************) (** Relation between orders and equality *) @@ -259,7 +339,7 @@ Qed. (*********************************************************) Lemma Rplus_ne : forall r, r + 0 = r /\ 0 + r = r. -intro; split; ring. +split; ring. Qed. Hint Resolve Rplus_ne: real v62. @@ -270,15 +350,16 @@ Hint Resolve Rplus_0_r: real. (**********) Lemma Rplus_opp_l : forall r, - r + r = 0. - intro; ring. +intro; ring. Qed. Hint Resolve Rplus_opp_l: real. (**********) Lemma Rplus_opp_r_uniq : forall r1 r2, r1 + r2 = 0 -> r2 = - r1. - intros x y H; replace y with (- x + x + y); - [ rewrite Rplus_assoc; rewrite H; ring | ring ]. + intros x y H; + replace y with (- x + x + y) by ring. + rewrite Rplus_assoc; rewrite H; ring. Qed. (*i New i*) @@ -311,16 +392,16 @@ Qed. (**********) Lemma Rinv_r : forall r, r <> 0 -> r * / r = 1. - intros; rewrite Rmult_comm; auto with real. + intros; field; trivial. Qed. Hint Resolve Rinv_r: real. Lemma Rinv_l_sym : forall r, r <> 0 -> 1 = / r * r. - symmetry in |- *; auto with real. + intros; field; trivial. Qed. Lemma Rinv_r_sym : forall r, r <> 0 -> 1 = r * / r. - symmetry in |- *; auto with real. + intros; field; trivial. Qed. Hint Resolve Rinv_l_sym Rinv_r_sym: real. @@ -359,10 +440,10 @@ Qed. (**********) Lemma Rmult_eq_reg_l : forall r r1 r2, r * r1 = r * r2 -> r <> 0 -> r1 = r2. intros; transitivity (/ r * r * r1). - rewrite Rinv_l; auto with real. + field; trivial. transitivity (/ r * r * r2). repeat rewrite Rmult_assoc; rewrite H; trivial. - rewrite Rinv_l; auto with real. + field; trivial. Qed. (**********) @@ -481,7 +562,7 @@ Qed. Hint Resolve Rmult_opp_opp: real. Lemma Ropp_mult_distr_r_reverse : forall r1 r2, r1 * - r2 = - (r1 * r2). -intros; rewrite <- Ropp_mult_distr_l_reverse; ring. +intros; ring. Qed. (** Substraction *) @@ -557,7 +638,7 @@ Qed. (** Inverse *) Lemma Rinv_1 : / 1 = 1. -field; auto with real. +field. Qed. Hint Resolve Rinv_1: real. @@ -570,19 +651,19 @@ Hint Resolve Rinv_neq_0_compat: real. (*********) Lemma Rinv_involutive : forall r, r <> 0 -> / / r = r. -intros; field; auto with real. +intros; field; trivial. Qed. Hint Resolve Rinv_involutive: real. (*********) Lemma Rinv_mult_distr : forall r1 r2, r1 <> 0 -> r2 <> 0 -> / (r1 * r2) = / r1 * / r2. -intros; field; auto with real. +intros; field; auto. Qed. (*********) Lemma Ropp_inv_permute : forall r, r <> 0 -> - / r = / - r. -intros; field; auto with real. +intros; field; trivial. Qed. Lemma Rinv_r_simpl_r : forall r1 r2, r1 <> 0 -> r1 * / r1 * r2 = r2. @@ -1602,7 +1683,7 @@ intro H4; rewrite Rmult_1_r; replace (2 * x) with (x + x). rewrite (Rplus_comm y); intro H5; apply Rplus_le_reg_l with x; assumption. ring. -replace 2 with (INR 2); [ apply not_O_INR; discriminate | ring ]. +replace 2 with (INR 2); [ apply not_O_INR; discriminate | reflexivity ]. pattern y at 2 in |- *; replace y with (y / 2 + y / 2). unfold Rminus, Rdiv in |- *. repeat rewrite Rmult_plus_distr_r. diff --git a/theories/Reals/R_Ifp.v b/theories/Reals/R_Ifp.v index d6f796c42..5d35ad0dd 100644 --- a/theories/Reals/R_Ifp.v +++ b/theories/Reals/R_Ifp.v @@ -542,4 +542,4 @@ intros; unfold frac_part in |- *; generalize (plus_Int_part2 r1 r2 H); intro; rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2))); rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2))); unfold Rminus in |- *; trivial with zarith real. -Qed.
\ No newline at end of file +Qed. diff --git a/theories/Reals/Ranalysis.v b/theories/Reals/Ranalysis.v index f438ec863..a7118505b 100644 --- a/theories/Reals/Ranalysis.v +++ b/theories/Reals/Ranalysis.v @@ -797,6 +797,6 @@ Ltac reg := [ simplify_derive aux X2; try unfold plus_fct, minus_fct, mult_fct, div_fct, id, fct_cte, - inv_fct, opp_fct in |- *; try ring + inv_fct, opp_fct in |- *; (ring || ring_simplify) | try apply pr_nu ]) || is_diff_pt)) - end.
\ No newline at end of file + end. diff --git a/theories/Reals/Ranalysis1.v b/theories/Reals/Ranalysis1.v index 248c8ce73..5a9ea513c 100644 --- a/theories/Reals/Ranalysis1.v +++ b/theories/Reals/Ranalysis1.v @@ -1114,7 +1114,7 @@ apply Ropp_gt_lt_contravar; Rmin (delta / 2) ((b + - c) / 2))) in |- *; apply Rplus_lt_le_0_compat; [ assumption | rewrite <- Ropp_0; apply Ropp_ge_le_contravar; apply Rle_ge; assumption ]. -ring. +unfold Rminus; ring. rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; assumption. replace ((f (c + Rmin (delta / 2) ((b - c) / 2)) - f c) / @@ -1306,10 +1306,7 @@ prove_sup0. replace (2 * (c + (a - c) / 2)) with (a + c). rewrite double. apply Rplus_lt_compat_l; assumption. -ring. -rewrite <- Rplus_assoc. -rewrite <- double_var. -ring. +field; discrR. assumption. unfold Rabs in |- *; case (Rcase_abs (Rmax (- (delta / 2)) ((a - c) / 2))). intro; generalize (RmaxLess1 (- (delta / 2)) ((a - c) / 2)); intro; diff --git a/theories/Reals/Rbase.v b/theories/Reals/Rbase.v index 506853967..ab1c07474 100644 --- a/theories/Reals/Rbase.v +++ b/theories/Reals/Rbase.v @@ -11,4 +11,4 @@ Require Export Rdefinitions. Require Export Raxioms. Require Export RIneq. -Require Export DiscrR.
\ No newline at end of file +Require Export DiscrR. diff --git a/theories/Reals/Rfunctions.v b/theories/Reals/Rfunctions.v index 295c59ca1..878d5f73d 100644 --- a/theories/Reals/Rfunctions.v +++ b/theories/Reals/Rfunctions.v @@ -15,6 +15,8 @@ (** Definition of the sum functions *) (* *) (********************************************************) +Require Export ArithRing. (* for ring_nat... *) +Require Export NewArithRing. Require Import Rbase. Require Export R_Ifp. @@ -380,8 +382,7 @@ replace (2 * S n)%nat with (S (S (2 * n))). replace (x ^ S (S (2 * n))) with (x * x * x ^ (2 * n)). rewrite Hrecn; reflexivity. simpl in |- *; ring. -apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; - ring. +ring_nat. Qed. Lemma pow_le : forall (a:R) (n:nat), 0 <= a -> 0 <= a ^ n. @@ -429,7 +430,7 @@ do 2 rewrite pow_add. rewrite Hrecn2. simpl in |- *. ring. -apply INR_eq; rewrite plus_INR; do 2 rewrite mult_INR; rewrite S_INR; ring. +ring_nat. Qed. Lemma pow_incr : forall (x y:R) (n:nat), 0 <= x <= y -> x ^ n <= y ^ n. @@ -747,7 +748,7 @@ Qed. (*********) Lemma R_dist_sym : forall x y:R, R_dist x y = R_dist y x. Proof. -unfold R_dist in |- *; intros; split_Rabs; ring. +unfold R_dist in |- *; intros; split_Rabs; try ring. generalize (Ropp_gt_lt_0_contravar (y - x) r); intro; rewrite (Ropp_minus_distr y x) in H; generalize (Rlt_asym (x - y) 0 r0); intro; unfold Rgt in H; elimtype False; auto. diff --git a/theories/Reals/Rgeom.v b/theories/Reals/Rgeom.v index e7858a18f..5e953d94c 100644 --- a/theories/Reals/Rgeom.v +++ b/theories/Reals/Rgeom.v @@ -146,7 +146,7 @@ intros; unfold xr, yr in |- *; (- x1 * sin theta + y1 * cos theta - (- x2 * sin theta + y2 * cos theta)) with (cos theta * (y1 - y2) + sin theta * (x2 - x1)); [ repeat rewrite Rsqr_plus; repeat rewrite Rsqr_mult; repeat rewrite cos2; - ring; replace (x2 - x1) with (- (x1 - x2)); + ring_simplify; replace (x2 - x1) with (- (x1 - x2)); [ rewrite <- Rsqr_neg; ring | ring ] | ring ] | ring ]. @@ -184,4 +184,4 @@ Lemma isometric_trans_rot : Rsqr (xt (xr x1 y1 theta) tx - xt (xr x2 y2 theta) tx) + Rsqr (yt (yr x1 y1 theta) ty - yt (yr x2 y2 theta) ty). intros; rewrite <- isometric_translation; apply isometric_rotation_0. -Qed.
\ No newline at end of file +Qed. diff --git a/theories/Reals/Rpower.v b/theories/Reals/Rpower.v index d850d7f89..2bab67b8e 100644 --- a/theories/Reals/Rpower.v +++ b/theories/Reals/Rpower.v @@ -323,7 +323,7 @@ apply Ropp_lt_cancel. apply Rplus_lt_reg_r with (r := y). replace (y + - (y * exp (- eps))) with (y * (1 - exp (- eps))); [ idtac | ring ]. -replace (y + - x) with (Rabs (x - y)); [ idtac | ring ]. +replace (y + - x) with (Rabs (x - y)). apply Rlt_le_trans with (1 := H5); apply Rmin_r. rewrite Rabs_left; [ ring | idtac ]. apply (Rlt_minus _ _ Hxy). @@ -345,7 +345,7 @@ apply H. rewrite Hxyy. apply Rplus_lt_reg_r with (r := - y). replace (- y + y * exp eps) with (y * (exp eps - 1)); [ idtac | ring ]. -replace (- y + x) with (Rabs (x - y)); [ idtac | ring ]. +replace (- y + x) with (Rabs (x - y)). apply Rlt_le_trans with (1 := H5); apply Rmin_l. rewrite Rabs_right; [ ring | idtac ]. left; apply (Rgt_minus _ _ Hxy). @@ -619,7 +619,7 @@ intros x H0; repeat split. assumption. apply D_in_ext with (f := fun x:R => / x * (z * exp (z * ln x))). unfold Rminus in |- *; rewrite Rpower_plus; rewrite Rpower_Ropp; - rewrite (Rpower_1 _ H); ring. + rewrite (Rpower_1 _ H); unfold Rpower; ring. apply Dcomp with (f := ln) (g := fun x:R => exp (z * x)) diff --git a/theories/Reals/Rprod.v b/theories/Reals/Rprod.v index b29fb6a98..09f3eb5d2 100644 --- a/theories/Reals/Rprod.v +++ b/theories/Reals/Rprod.v @@ -38,13 +38,9 @@ rewrite H1; simpl in |- *; rewrite <- minus_n_n; simpl in |- *; ring. replace (S n - k)%nat with (S (n - k)). simpl in |- *; replace (k + S (n - k))%nat with (S n). rewrite Hrecn; [ ring | assumption ]. -apply INR_eq; rewrite S_INR; rewrite plus_INR; rewrite S_INR; - rewrite minus_INR; [ ring | assumption ]. -apply INR_eq; rewrite S_INR; repeat rewrite minus_INR. -rewrite S_INR; ring. -apply le_trans with n; [ assumption | apply le_n_Sn ]. -assumption. -inversion H; [ left; reflexivity | right; assumption ]. +omega. +omega. +omega. Qed. (**********) @@ -116,18 +112,8 @@ apply prod_SO_Rle; intros; split. apply pos_INR. apply le_INR; apply plus_le_compat_r; assumption. assumption. -apply INR_eq; repeat rewrite minus_INR. -rewrite mult_INR; repeat rewrite S_INR; ring. -apply le_trans with N; [ assumption | apply le_n_2n ]. -apply (fun p n m:nat => plus_le_reg_l n m p) with k; rewrite <- le_plus_minus. -replace (2 * N)%nat with (N + N)%nat; [ idtac | ring ]. -apply plus_le_compat_r; assumption. -assumption. -assumption. -apply (fun p n m:nat => plus_le_reg_l n m p) with k; rewrite <- le_plus_minus. -replace (2 * N)%nat with (N + N)%nat; [ idtac | ring ]. -apply plus_le_compat_r; assumption. -assumption. +omega. +omega. rewrite <- (Rmult_comm (prod_f_SO (fun l:nat => INR l) k)); rewrite (prod_SO_split (fun l:nat => INR l) k N). rewrite Rmult_assoc; apply Rmult_le_compat_l. @@ -140,24 +126,11 @@ replace (N - (2 * N - k))%nat with (k - N)%nat. apply prod_SO_Rle; intros; split. apply pos_INR. apply le_INR; apply plus_le_compat_r. -apply (fun p n m:nat => plus_le_reg_l n m p) with k; rewrite <- le_plus_minus. -replace (2 * N)%nat with (N + N)%nat; [ idtac | ring ]; - apply plus_le_compat_r; assumption. -assumption. -apply INR_eq; repeat rewrite minus_INR. -rewrite mult_INR; do 2 rewrite S_INR; ring. -assumption. -apply (fun p n m:nat => plus_le_reg_l n m p) with k; rewrite <- le_plus_minus. -replace (2 * N)%nat with (N + N)%nat; [ idtac | ring ]; - apply plus_le_compat_r; assumption. -assumption. -assumption. -apply (fun p n m:nat => plus_le_reg_l n m p) with k; rewrite <- le_plus_minus. -replace (2 * N)%nat with (N + N)%nat; [ idtac | ring ]; - apply plus_le_compat_r; assumption. -assumption. +omega. +omega. +omega. assumption. -elim (le_dec k N); intro; [ left; assumption | right; assumption ]. +omega. Qed. (**********) @@ -186,6 +159,5 @@ assumption. reflexivity. rewrite mult_INR; apply prod_neq_R0; apply INR_fact_neq_0. apply prod_neq_R0; apply INR_fact_neq_0. -apply INR_eq; rewrite minus_INR; - [ rewrite mult_INR; do 2 rewrite S_INR; ring | apply le_n_2n ]. +omega. Qed. diff --git a/theories/Reals/Rsigma.v b/theories/Reals/Rsigma.v index ee2d7c55d..319701ca1 100644 --- a/theories/Reals/Rsigma.v +++ b/theories/Reals/Rsigma.v @@ -52,21 +52,15 @@ apply (decomp_sum (fun i:nat => f (S k + i))). apply lt_minus_O_lt; assumption. apply sum_eq; intros; replace (S k + S i)%nat with (S (S k) + i)%nat. reflexivity. -apply INR_eq; do 2 rewrite plus_INR; do 3 rewrite S_INR; ring. +ring_nat. replace (high - S (S k))%nat with (high - S k - 1)%nat. apply pred_of_minus. -apply INR_eq; repeat rewrite minus_INR. -do 4 rewrite S_INR; ring. -apply lt_le_S; assumption. -apply lt_le_weak; assumption. -apply lt_le_S; apply lt_minus_O_lt; assumption. +omega. unfold sigma in |- *; replace (S k - low)%nat with (S (k - low)). pattern (S k) at 1 in |- *; replace (S k) with (low + S (k - low))%nat. symmetry in |- *; apply (tech5 (fun i:nat => f (low + i))). -apply INR_eq; rewrite plus_INR; do 2 rewrite S_INR; rewrite minus_INR. -ring. -assumption. -apply minus_Sn_m; assumption. +omega. +omega. rewrite <- H2; unfold sigma in |- *; rewrite <- minus_n_n; simpl in |- *; replace (high - S low)%nat with (pred (high - low)). replace (sum_f_R0 (fun k0:nat => f (S (low + k0))) (pred (high - low))) with @@ -76,14 +70,8 @@ apply lt_minus_O_lt. apply le_lt_trans with (S k); [ rewrite H2; apply le_n | assumption ]. apply sum_eq; intros; replace (S (low + i)) with (low + S i)%nat. reflexivity. -apply INR_eq; rewrite plus_INR; do 2 rewrite S_INR; rewrite plus_INR; ring. -replace (high - S low)%nat with (high - low - 1)%nat. -apply pred_of_minus. -apply INR_eq; repeat rewrite minus_INR. -do 2 rewrite S_INR; ring. -apply lt_le_S; rewrite H2; assumption. -rewrite H2; apply lt_le_weak; assumption. -apply lt_le_S; apply lt_minus_O_lt; rewrite H2; assumption. +ring_nat. +omega. inversion H; [ right; reflexivity | left; assumption ]. Qed. @@ -137,4 +125,4 @@ intro; unfold sigma in |- *; rewrite <- minus_n_n. simpl in |- *; replace (low + 0)%nat with low; [ reflexivity | ring ]. Qed. -End Sigma.
\ No newline at end of file +End Sigma. diff --git a/theories/Reals/Rtrigo.v b/theories/Reals/Rtrigo.v index f8db0463f..7f6b59b35 100644 --- a/theories/Reals/Rtrigo.v +++ b/theories/Reals/Rtrigo.v @@ -251,18 +251,24 @@ Qed. Lemma sin_period : forall (x:R) (k:nat), sin (x + 2 * INR k * PI) = sin x. intros x k; induction k as [| k Hreck]. -cut (x + 2 * INR 0 * PI = x); [ intro; rewrite H; reflexivity | ring ]. -replace (x + 2 * INR (S k) * PI) with (x + 2 * INR k * PI + 2 * PI); - [ rewrite sin_plus; rewrite sin_2PI; rewrite cos_2PI; ring; apply Hreck - | rewrite S_INR; ring ]. +simpl in |- *; ring_simplify (x + 2 * 0 * PI). +trivial. + +replace (x + 2 * INR (S k) * PI) with (x + 2 * INR k * PI + 2 * PI). +rewrite sin_plus in |- *; rewrite sin_2PI in |- *; rewrite cos_2PI in |- *. +ring_simplify; trivial. +rewrite S_INR in |- *; ring. Qed. Lemma cos_period : forall (x:R) (k:nat), cos (x + 2 * INR k * PI) = cos x. intros x k; induction k as [| k Hreck]. -cut (x + 2 * INR 0 * PI = x); [ intro; rewrite H; reflexivity | ring ]. -replace (x + 2 * INR (S k) * PI) with (x + 2 * INR k * PI + 2 * PI); - [ rewrite cos_plus; rewrite sin_2PI; rewrite cos_2PI; ring; apply Hreck - | rewrite S_INR; ring ]. +simpl in |- *; ring_simplify (x + 2 * 0 * PI). +trivial. + +replace (x + 2 * INR (S k) * PI) with (x + 2 * INR k * PI + 2 * PI). +rewrite cos_plus in |- *; rewrite sin_2PI in |- *; rewrite cos_2PI in |- *. +ring_simplify; trivial. +rewrite S_INR in |- *; ring. Qed. Lemma sin_shift : forall x:R, sin (PI / 2 - x) = cos x. @@ -421,12 +427,10 @@ intro; apply Rplus_le_le_0_compat; repeat apply Rmult_le_pos; unfold x in |- *; replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ]. prove_sup0. -apply INR_eq; do 2 rewrite S_INR; do 3 rewrite plus_INR; rewrite mult_INR; - repeat rewrite S_INR; ring. +ring_nat. apply INR_fact_neq_0. apply INR_fact_neq_0. -apply INR_eq; do 3 rewrite plus_INR; do 2 rewrite mult_INR; - repeat rewrite S_INR; ring. +ring_nat. Qed. Lemma SIN : forall a:R, 0 <= a -> a <= PI -> sin_lb a <= sin a <= sin_ub a. @@ -1494,9 +1498,10 @@ Lemma cos_eq_0_0 : forall x:R, cos x = 0 -> exists k : Z, x = IZR k * PI + PI / 2. intros x H; rewrite cos_sin in H; generalize (sin_eq_0_0 (PI / INR 2 + x) H); intro H2; elim H2; intros x0 H3; exists (x0 - Z_of_nat 1)%Z; - rewrite <- Z_R_minus; ring; rewrite Rmult_comm; rewrite <- H3; - unfold INR in |- *. -rewrite (double_var (- PI)); unfold Rdiv in |- *; ring. + rewrite <- Z_R_minus; simpl; ring_simplify; +(* rewrite (Rmult_comm PI);*) (* old ring compat *) + rewrite <- H3; simpl; + field; repeat split; discrR. Qed. Lemma cos_eq_0_1 : diff --git a/theories/Reals/Rtrigo_alt.v b/theories/Reals/Rtrigo_alt.v index 7a4921628..f74b2763c 100644 --- a/theories/Reals/Rtrigo_alt.v +++ b/theories/Reals/Rtrigo_alt.v @@ -119,8 +119,7 @@ replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ]. apply INR_fact_neq_0. apply INR_fact_neq_0. simpl in |- *; ring. -apply INR_eq; do 2 rewrite S_INR; do 2 rewrite plus_INR; - do 2 rewrite mult_INR; repeat rewrite S_INR; ring. +ring_nat. assert (H3 := cv_speed_pow_fact a); unfold Un in |- *; unfold Un_cv in H3; unfold R_dist in H3; unfold Un_cv in |- *; unfold R_dist in |- *; intros; elim (H3 eps H4); intros N H5. @@ -133,7 +132,7 @@ apply le_n_2n. apply (fun m n p:nat => mult_le_compat_l p n m); apply le_n_Sn. apply (fun m n p:nat => mult_le_compat_l p n m); apply le_n_S; assumption. apply le_n_Sn. -apply INR_eq; rewrite S_INR; rewrite plus_INR; rewrite mult_INR; reflexivity. +ring. assert (X := exist_sin (Rsqr a)); elim X; intros. cut (x = sin a / a). intro; rewrite H3 in p; unfold sin_in in p; unfold infinit_sum in p; @@ -201,12 +200,10 @@ unfold Rdiv in |- *; ring. reflexivity. replace (2 * (n + 1))%nat with (S (S (2 * n))). reflexivity. -apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; rewrite plus_INR; - repeat rewrite S_INR; ring. +ring. replace (2 * n + 1)%nat with (S (2 * n)). reflexivity. -apply INR_eq; rewrite S_INR; rewrite plus_INR; rewrite mult_INR; - repeat rewrite S_INR; ring. +ring. intro; elim H1; intros. split. apply Rplus_le_reg_l with (- a). @@ -219,12 +216,10 @@ unfold sin_term in |- *; simpl in |- *; unfold Rdiv in |- *; rewrite Rinv_1; ring. replace (2 * (n + 1))%nat with (S (S (2 * n))). apply lt_O_Sn. -apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; rewrite plus_INR; - repeat rewrite S_INR; ring. +ring. replace (2 * n + 1)%nat with (S (2 * n)). apply lt_O_Sn. -apply INR_eq; rewrite S_INR; rewrite plus_INR; rewrite mult_INR; - repeat rewrite S_INR; ring. +ring. inversion H; [ assumption | elim Hyp_a; symmetry in |- *; assumption ]. Qed. @@ -318,8 +313,7 @@ replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ]. apply INR_fact_neq_0. apply INR_fact_neq_0. simpl in |- *; ring. -apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; - ring. +ring_nat. assert (H4 := cv_speed_pow_fact a0); unfold Un in |- *; unfold Un_cv in H4; unfold R_dist in H4; unfold Un_cv in |- *; unfold R_dist in |- *; intros; elim (H4 eps H5); intros N H6; exists N; intros. @@ -385,12 +379,10 @@ unfold Rdiv in |- *; ring. reflexivity. replace (2 * (n0 + 1))%nat with (S (S (2 * n0))). reflexivity. -apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; rewrite plus_INR; - repeat rewrite S_INR; ring. +ring. replace (2 * n0 + 1)%nat with (S (2 * n0)). reflexivity. -apply INR_eq; rewrite S_INR; rewrite plus_INR; rewrite mult_INR; - repeat rewrite S_INR; ring. +ring. intro; elim H2; intros; split. apply Rplus_le_reg_l with (-1). rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l; @@ -402,12 +394,10 @@ unfold cos_term in |- *; simpl in |- *; unfold Rdiv in |- *; rewrite Rinv_1; ring. replace (2 * (n0 + 1))%nat with (S (S (2 * n0))). apply lt_O_Sn. -apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; rewrite plus_INR; - repeat rewrite S_INR; ring. +ring. replace (2 * n0 + 1)%nat with (S (2 * n0)). apply lt_O_Sn. -apply INR_eq; rewrite S_INR; rewrite plus_INR; rewrite mult_INR; - repeat rewrite S_INR; ring. +ring. intros; case (total_order_T 0 a); intro. elim s; intro. apply H; [ left; assumption | assumption ]. diff --git a/theories/Reals/Rtrigo_reg.v b/theories/Reals/Rtrigo_reg.v index d9e96b9c5..88ddbccc1 100644 --- a/theories/Reals/Rtrigo_reg.v +++ b/theories/Reals/Rtrigo_reg.v @@ -98,8 +98,7 @@ unfold Rsqr in |- *; ring. apply pow_nonzero; assumption. replace (2 * S n)%nat with (S (S (2 * n))). simpl in |- *; ring. -apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; - ring. +ring_nat. apply Rle_ge; apply pow_le; left; apply (cond_pos r). apply Rle_ge; apply pow_le; left; apply (cond_pos r). apply Rabs_no_R0; apply pow_nonzero; assumption. @@ -277,8 +276,7 @@ unfold Rsqr in |- *; ring. apply pow_nonzero; assumption. replace (2 * S n)%nat with (S (S (2 * n))). simpl in |- *; ring. -apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; - ring. +ring_nat. apply Rle_ge; apply pow_le; left; apply (cond_pos r). apply Rle_ge; apply pow_le; left; apply (cond_pos r). apply Rabs_no_R0; apply pow_nonzero; assumption. diff --git a/theories/Reals/SeqProp.v b/theories/Reals/SeqProp.v index 484e0f217..06e6771f8 100644 --- a/theories/Reals/SeqProp.v +++ b/theories/Reals/SeqProp.v @@ -1228,8 +1228,8 @@ apply plus_lt_compat_r. apply lt_le_trans with 1%nat; [ apply lt_O_Sn | assumption ]. apply INR_fact_neq_0. apply not_O_INR; discriminate. -apply INR_eq; rewrite S_INR; do 3 rewrite plus_INR; reflexivity. -apply INR_eq; do 3 rewrite plus_INR; do 2 rewrite S_INR; ring. +ring_nat. +ring_nat. unfold Vn in |- *; rewrite Rmult_assoc; unfold Rdiv in |- *; rewrite (Rmult_comm (Un 0%nat)); rewrite (Rmult_comm (Un n)). repeat apply Rmult_le_compat_l. @@ -1253,12 +1253,11 @@ rewrite fact_simpl; rewrite mult_INR; rewrite Rmult_assoc; rewrite Rmult_1_r; apply Rle_trans with (INR M_nat). left; rewrite INR_IZR_INZ. rewrite <- H4; assert (H8 := archimed (Rabs x)); elim H8; intros; assumption. -apply le_INR; apply le_trans with (S M_nat); - [ apply le_n_Sn | apply le_n_S; apply le_plus_l ]. +apply le_INR; omega. apply INR_fact_neq_0. apply INR_fact_neq_0. -apply INR_eq; rewrite S_INR; do 3 rewrite plus_INR; reflexivity. -apply INR_eq; do 3 rewrite plus_INR; do 2 rewrite S_INR; ring. +ring_nat. +ring_nat. intro; unfold Un in |- *; unfold Rdiv in |- *; apply Rmult_lt_0_compat. apply pow_lt; assumption. apply Rinv_0_lt_compat; apply lt_INR_0; apply neq_O_lt; red in |- *; intro; diff --git a/theories/Setoids/Setoid.v b/theories/Setoids/Setoid.v index 884f05e52..b56818629 100644 --- a/theories/Setoids/Setoid.v +++ b/theories/Setoids/Setoid.v @@ -82,7 +82,7 @@ Lemma about_carrier_of_relation_class_and_relation_class_of_argument_class : Inductive nelistT (A : Type) : Type := singl : A -> nelistT A - | cons : A -> nelistT A -> nelistT A. + | necons : A -> nelistT A -> nelistT A. Definition Arguments := nelistT Argument_Class. @@ -132,7 +132,7 @@ Record Morphism_Theory In Out : Type := Definition list_of_Leibniz_of_list_of_types: nelistT Type -> Arguments. induction 1. exact (singl (Leibniz _ a)). - exact (cons (Leibniz _ a) IHX). + exact (necons (Leibniz _ a) IHX). Defined. (* every function is a morphism from Leibniz+ to Leibniz *) @@ -175,7 +175,7 @@ Defined. Definition equality_morphism_of_symmetric_areflexive_transitive_relation: forall (A: Type)(Aeq: relation A)(sym: symmetric _ Aeq)(trans: transitive _ Aeq), let ASetoidClass := SymmetricAreflexive _ sym in - (Morphism_Theory (cons ASetoidClass (singl ASetoidClass)) Iff_Relation_Class). + (Morphism_Theory (necons ASetoidClass (singl ASetoidClass)) Iff_Relation_Class). intros. exists Aeq. unfold make_compatibility_goal; simpl; split; eauto. @@ -184,7 +184,7 @@ Defined. Definition equality_morphism_of_symmetric_reflexive_transitive_relation: forall (A: Type)(Aeq: relation A)(refl: reflexive _ Aeq)(sym: symmetric _ Aeq) (trans: transitive _ Aeq), let ASetoidClass := SymmetricReflexive _ sym refl in - (Morphism_Theory (cons ASetoidClass (singl ASetoidClass)) Iff_Relation_Class). + (Morphism_Theory (necons ASetoidClass (singl ASetoidClass)) Iff_Relation_Class). intros. exists Aeq. unfold make_compatibility_goal; simpl; split; eauto. @@ -194,7 +194,7 @@ Definition equality_morphism_of_asymmetric_areflexive_transitive_relation: forall (A: Type)(Aeq: relation A)(trans: transitive _ Aeq), let ASetoidClass1 := AsymmetricAreflexive Contravariant Aeq in let ASetoidClass2 := AsymmetricAreflexive Covariant Aeq in - (Morphism_Theory (cons ASetoidClass1 (singl ASetoidClass2)) Impl_Relation_Class). + (Morphism_Theory (necons ASetoidClass1 (singl ASetoidClass2)) Impl_Relation_Class). intros. exists Aeq. unfold make_compatibility_goal; simpl; unfold impl; eauto. @@ -204,7 +204,7 @@ Definition equality_morphism_of_asymmetric_reflexive_transitive_relation: forall (A: Type)(Aeq: relation A)(refl: reflexive _ Aeq)(trans: transitive _ Aeq), let ASetoidClass1 := AsymmetricReflexive Contravariant refl in let ASetoidClass2 := AsymmetricReflexive Covariant refl in - (Morphism_Theory (cons ASetoidClass1 (singl ASetoidClass2)) Impl_Relation_Class). + (Morphism_Theory (necons ASetoidClass1 (singl ASetoidClass2)) Impl_Relation_Class). intros. exists Aeq. unfold make_compatibility_goal; simpl; unfold impl; eauto. @@ -331,7 +331,7 @@ with Morphism_Context_List Hole dir : check_if_variance_is_respected (variance_of_argument_class S) dir' dir'' -> Morphism_Context Hole dir (relation_class_of_argument_class S) dir' -> Morphism_Context_List Hole dir dir'' L -> - Morphism_Context_List Hole dir dir'' (cons S L). + Morphism_Context_List Hole dir dir'' (necons S L). Scheme Morphism_Context_rect2 := Induction for Morphism_Context Sort Type with Morphism_Context_List_rect2 := Induction for Morphism_Context_List Sort Type. diff --git a/theories/ZArith/Zcomplements.v b/theories/ZArith/Zcomplements.v index d3b8a37f0..718ac3b03 100644 --- a/theories/ZArith/Zcomplements.v +++ b/theories/ZArith/Zcomplements.v @@ -8,7 +8,8 @@ (*i $Id$ i*) -Require Import ZArithRing. +Require Import NewZArithRing. + Require Import ZArith_base. Require Import Omega. Require Import Wf_nat. @@ -209,4 +210,4 @@ End Zlength_properties. Implicit Arguments Zlength_correct [A]. Implicit Arguments Zlength_cons [A]. -Implicit Arguments Zlength_nil_inv [A].
\ No newline at end of file +Implicit Arguments Zlength_nil_inv [A]. diff --git a/theories/ZArith/Zdiv.v b/theories/ZArith/Zdiv.v index 025e03d4a..52f85eada 100644 --- a/theories/ZArith/Zdiv.v +++ b/theories/ZArith/Zdiv.v @@ -22,7 +22,7 @@ Then only after proves the main required property. Require Export ZArith_base. Require Import Zbool. Require Import Omega. -Require Import ZArithRing. +Require Import NewZArithRing. Require Import Zcomplements. Open Local Scope Z_scope. @@ -148,7 +148,7 @@ case (Zgt_bool b (2 * r)); rewrite BinInt.Zpos_xO; (split; [ ring | omega ]). generalize (Zge_cases b 2). -case (Zge_bool b 2); (intros; split; [ ring | omega ]). +case (Zge_bool b 2); (intros; split; [ try ring | omega ]). omega. Qed. diff --git a/theories/ZArith/Znumtheory.v b/theories/ZArith/Znumtheory.v index 05076ebd3..14bfa6357 100644 --- a/theories/ZArith/Znumtheory.v +++ b/theories/ZArith/Znumtheory.v @@ -9,7 +9,7 @@ (*i $Id$ i*) Require Import ZArith_base. -Require Import ZArithRing. +Require Import NewZArithRing. Require Import Zcomplements. Require Import Zdiv. Require Import Ndigits. @@ -164,7 +164,7 @@ left; rewrite H0; rewrite e; ring. assert (Hqq0 : q0 * q = 1). apply Zmult_reg_l with a. assumption. -ring. +ring_simplify. pattern a at 2 in |- *; rewrite H2; ring. assert (q | 1). rewrite <- Hqq0; auto with zarith. diff --git a/theories/ZArith/Zsqrt.v b/theories/ZArith/Zsqrt.v index f61999362..3d57561ea 100644 --- a/theories/ZArith/Zsqrt.v +++ b/theories/ZArith/Zsqrt.v @@ -8,9 +8,9 @@ (* $Id$ *) +Require Import NewZArithRing. Require Import Omega. Require Export ZArith_base. -Require Export ZArithRing. Open Local Scope Z_scope. (**********************************************************************) @@ -86,7 +86,7 @@ refine end end end); clear sqrtrempos; repeat compute_POS; - try (try rewrite Heq; ring; fail); try omega. + try (try rewrite Heq; ring); try omega. Defined. (** Define with integer input, but with a strong (readable) specification. *) @@ -132,7 +132,7 @@ refine (fun r:Z => 0 = 0 * 0 + r /\ 0 * 0 <= 0 < (0 + 1) * (0 + 1)) 0 _) end); try omega. -split; [ omega | rewrite Heq; ring ((s + 1) * (s + 1)); omega ]. +split; [ omega | rewrite Heq; ring_simplify ((s + 1) * (s + 1)); omega ]. Defined. (** Define a function of type Z->Z that computes the integer square root, |