summaryrefslogtreecommitdiff
path: root/plugins
diff options
context:
space:
mode:
Diffstat (limited to 'plugins')
-rw-r--r--plugins/cc/ccalgo.ml2
-rw-r--r--plugins/cc/ccalgo.mli2
-rw-r--r--plugins/cc/ccproof.ml2
-rw-r--r--plugins/cc/ccproof.mli2
-rw-r--r--plugins/cc/cctac.ml8
-rw-r--r--plugins/cc/cctac.mli2
-rw-r--r--plugins/cc/g_congruence.ml42
-rw-r--r--plugins/decl_mode/decl_expr.mli2
-rw-r--r--plugins/decl_mode/decl_interp.ml2
-rw-r--r--plugins/decl_mode/decl_interp.mli2
-rw-r--r--plugins/decl_mode/decl_mode.ml2
-rw-r--r--plugins/decl_mode/decl_mode.mli2
-rw-r--r--plugins/decl_mode/decl_proof_instr.ml2
-rw-r--r--plugins/decl_mode/decl_proof_instr.mli2
-rw-r--r--plugins/decl_mode/g_decl_mode.ml42
-rw-r--r--plugins/decl_mode/ppdecl_proof.ml2
-rw-r--r--plugins/extraction/ExtrOcamlBasic.v2
-rw-r--r--plugins/extraction/ExtrOcamlBigIntConv.v2
-rw-r--r--plugins/extraction/ExtrOcamlIntConv.v2
-rw-r--r--plugins/extraction/ExtrOcamlNatBigInt.v2
-rw-r--r--plugins/extraction/ExtrOcamlNatInt.v2
-rw-r--r--plugins/extraction/ExtrOcamlString.v2
-rw-r--r--plugins/extraction/ExtrOcamlZBigInt.v8
-rw-r--r--plugins/extraction/ExtrOcamlZInt.v4
-rw-r--r--plugins/extraction/big.ml2
-rw-r--r--plugins/extraction/common.ml4
-rw-r--r--plugins/extraction/common.mli2
-rw-r--r--plugins/extraction/extract_env.ml6
-rw-r--r--plugins/extraction/extract_env.mli2
-rw-r--r--plugins/extraction/extraction.ml2
-rw-r--r--plugins/extraction/extraction.mli2
-rw-r--r--plugins/extraction/g_extraction.ml42
-rw-r--r--plugins/extraction/haskell.ml2
-rw-r--r--plugins/extraction/haskell.mli2
-rw-r--r--plugins/extraction/miniml.mli2
-rw-r--r--plugins/extraction/mlutil.ml2
-rw-r--r--plugins/extraction/mlutil.mli2
-rw-r--r--plugins/extraction/modutil.ml2
-rw-r--r--plugins/extraction/modutil.mli2
-rw-r--r--plugins/extraction/ocaml.ml2
-rw-r--r--plugins/extraction/ocaml.mli2
-rw-r--r--plugins/extraction/scheme.ml2
-rw-r--r--plugins/extraction/scheme.mli2
-rw-r--r--plugins/extraction/table.ml3
-rw-r--r--plugins/extraction/table.mli2
-rw-r--r--plugins/field/LegacyField.v2
-rw-r--r--plugins/field/LegacyField_Compl.v2
-rw-r--r--plugins/field/LegacyField_Tactic.v22
-rw-r--r--plugins/field/LegacyField_Theory.v182
-rw-r--r--plugins/field/field.ml42
-rw-r--r--plugins/firstorder/formula.ml2
-rw-r--r--plugins/firstorder/formula.mli2
-rw-r--r--plugins/firstorder/g_ground.ml42
-rw-r--r--plugins/firstorder/ground.ml2
-rw-r--r--plugins/firstorder/ground.mli2
-rw-r--r--plugins/firstorder/instances.ml2
-rw-r--r--plugins/firstorder/instances.mli2
-rw-r--r--plugins/firstorder/rules.ml2
-rw-r--r--plugins/firstorder/rules.mli2
-rw-r--r--plugins/firstorder/sequent.ml2
-rw-r--r--plugins/firstorder/sequent.mli2
-rw-r--r--plugins/firstorder/unify.ml2
-rw-r--r--plugins/firstorder/unify.mli2
-rw-r--r--plugins/fourier/Fourier.v2
-rw-r--r--plugins/fourier/Fourier_util.v34
-rw-r--r--plugins/fourier/fourier.ml2
-rw-r--r--plugins/fourier/fourierR.ml2
-rw-r--r--plugins/fourier/g_fourier.ml42
-rw-r--r--plugins/funind/Recdef.v2
-rw-r--r--plugins/funind/functional_principles_types.ml6
-rw-r--r--plugins/funind/g_indfun.ml42
-rw-r--r--plugins/funind/invfun.ml2
-rw-r--r--plugins/funind/merge.ml2
-rw-r--r--plugins/funind/recdef.ml2
-rw-r--r--plugins/micromega/CheckerMaker.v2
-rw-r--r--plugins/micromega/Env.v153
-rw-r--r--plugins/micromega/EnvRing.v1257
-rw-r--r--plugins/micromega/MExtraction.v4
-rw-r--r--plugins/micromega/OrderedRing.v2
-rw-r--r--plugins/micromega/Psatz.v8
-rw-r--r--plugins/micromega/QMicromega.v10
-rw-r--r--plugins/micromega/RMicromega.v30
-rw-r--r--plugins/micromega/Refl.v2
-rw-r--r--plugins/micromega/RingMicromega.v50
-rw-r--r--plugins/micromega/Tauto.v2
-rw-r--r--plugins/micromega/VarMap.v2
-rw-r--r--plugins/micromega/ZCoeff.v16
-rw-r--r--plugins/micromega/ZMicromega.v216
-rw-r--r--plugins/micromega/certificate.ml2
-rw-r--r--plugins/micromega/coq_micromega.ml23
-rw-r--r--plugins/micromega/csdpcert.ml2
-rw-r--r--plugins/micromega/g_micromega.ml42
-rw-r--r--plugins/micromega/mutils.ml2
-rw-r--r--plugins/micromega/persistent_cache.ml32
-rw-r--r--plugins/micromega/polynomial.ml2
-rw-r--r--plugins/micromega/sos.mli2
-rw-r--r--plugins/micromega/sos_types.ml2
-rw-r--r--plugins/nsatz/Nsatz.v40
-rw-r--r--plugins/nsatz/ideal.ml2
-rw-r--r--plugins/nsatz/nsatz.ml42
-rw-r--r--plugins/nsatz/polynom.ml2
-rw-r--r--plugins/nsatz/polynom.mli2
-rw-r--r--plugins/omega/Omega.v8
-rw-r--r--plugins/omega/OmegaLemmas.v266
-rw-r--r--plugins/omega/OmegaPlugin.v2
-rw-r--r--plugins/omega/PreOmega.v353
-rw-r--r--plugins/omega/coq_omega.ml59
-rw-r--r--plugins/omega/g_omega.ml42
-rw-r--r--plugins/omega/omega.ml2
-rw-r--r--plugins/quote/Quote.v4
-rw-r--r--plugins/quote/g_quote.ml42
-rw-r--r--plugins/quote/quote.ml2
-rw-r--r--plugins/ring/LegacyArithRing.v8
-rw-r--r--plugins/ring/LegacyNArithRing.v25
-rw-r--r--plugins/ring/LegacyRing.v6
-rw-r--r--plugins/ring/LegacyRing_theory.v42
-rw-r--r--plugins/ring/LegacyZArithRing.v8
-rw-r--r--plugins/ring/Ring_abstract.v90
-rw-r--r--plugins/ring/Ring_normalize.v142
-rw-r--r--plugins/ring/Setoid_ring.v2
-rw-r--r--plugins/ring/Setoid_ring_normalize.v122
-rw-r--r--plugins/ring/Setoid_ring_theory.v4
-rw-r--r--plugins/ring/g_ring.ml42
-rw-r--r--plugins/ring/ring.ml8
-rw-r--r--plugins/romega/ReflOmegaCore.v505
-rw-r--r--plugins/rtauto/Bintree.v16
-rw-r--r--plugins/rtauto/Rtauto.v2
-rw-r--r--plugins/rtauto/g_rtauto.ml42
-rw-r--r--plugins/rtauto/proof_search.ml2
-rw-r--r--plugins/rtauto/proof_search.mli2
-rw-r--r--plugins/rtauto/refl_tauto.ml4
-rw-r--r--plugins/rtauto/refl_tauto.mli2
-rw-r--r--plugins/setoid_ring/ArithRing.v10
-rw-r--r--plugins/setoid_ring/BinList.v77
-rw-r--r--plugins/setoid_ring/Cring.v27
-rw-r--r--plugins/setoid_ring/Field.v2
-rw-r--r--plugins/setoid_ring/Field_tac.v6
-rw-r--r--plugins/setoid_ring/Field_theory.v415
-rw-r--r--plugins/setoid_ring/InitialRing.v108
-rw-r--r--plugins/setoid_ring/Integral_domain.v5
-rw-r--r--plugins/setoid_ring/NArithRing.v2
-rw-r--r--plugins/setoid_ring/Ncring.v35
-rw-r--r--plugins/setoid_ring/Ncring_initial.v56
-rw-r--r--plugins/setoid_ring/Ncring_polynom.v111
-rw-r--r--plugins/setoid_ring/Ncring_tac.v10
-rw-r--r--plugins/setoid_ring/RealField.v64
-rw-r--r--plugins/setoid_ring/Ring.v4
-rw-r--r--plugins/setoid_ring/Ring_base.v2
-rw-r--r--plugins/setoid_ring/Ring_polynom.v1310
-rw-r--r--plugins/setoid_ring/Ring_tac.v7
-rw-r--r--plugins/setoid_ring/Ring_theory.v293
-rw-r--r--plugins/setoid_ring/Rings_Z.v2
-rw-r--r--plugins/setoid_ring/ZArithRing.v6
-rw-r--r--plugins/setoid_ring/newring.ml42
-rw-r--r--plugins/subtac/eterm.mli2
-rw-r--r--plugins/subtac/g_subtac.ml42
-rw-r--r--plugins/subtac/subtac.ml2
-rw-r--r--plugins/subtac/subtac_cases.ml2
-rw-r--r--plugins/subtac/subtac_cases.mli2
-rw-r--r--plugins/subtac/subtac_classes.ml2
-rw-r--r--plugins/subtac/subtac_classes.mli2
-rw-r--r--plugins/subtac/subtac_coercion.ml2
-rw-r--r--plugins/subtac/subtac_command.ml9
-rw-r--r--plugins/subtac/subtac_pretyping.ml2
-rw-r--r--plugins/subtac/subtac_pretyping_F.ml2
-rw-r--r--plugins/syntax/nat_syntax.ml6
-rw-r--r--plugins/syntax/numbers_syntax.ml96
-rw-r--r--plugins/syntax/r_syntax.ml2
-rw-r--r--plugins/syntax/z_syntax.ml2
-rw-r--r--plugins/xml/dumptree.ml42
170 files changed, 2882 insertions, 3779 deletions
diff --git a/plugins/cc/ccalgo.ml b/plugins/cc/ccalgo.ml
index e3d27f71..d0f81dad 100644
--- a/plugins/cc/ccalgo.ml
+++ b/plugins/cc/ccalgo.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/cc/ccalgo.mli b/plugins/cc/ccalgo.mli
index 78dbee3f..9653da2c 100644
--- a/plugins/cc/ccalgo.mli
+++ b/plugins/cc/ccalgo.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/cc/ccproof.ml b/plugins/cc/ccproof.ml
index bb1d50c9..c5bbd105 100644
--- a/plugins/cc/ccproof.ml
+++ b/plugins/cc/ccproof.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/cc/ccproof.mli b/plugins/cc/ccproof.mli
index 67819596..b8a8d229 100644
--- a/plugins/cc/ccproof.mli
+++ b/plugins/cc/ccproof.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/cc/cctac.ml b/plugins/cc/cctac.ml
index ec31f891..95ff4d34 100644
--- a/plugins/cc/cctac.ml
+++ b/plugins/cc/cctac.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -35,11 +35,11 @@ let _f_equal = constant ["Init";"Logic"] "f_equal"
let _eq_rect = constant ["Init";"Logic"] "eq_rect"
-let _refl_equal = constant ["Init";"Logic"] "refl_equal"
+let _refl_equal = constant ["Init";"Logic"] "eq_refl"
-let _sym_eq = constant ["Init";"Logic"] "sym_eq"
+let _sym_eq = constant ["Init";"Logic"] "eq_sym"
-let _trans_eq = constant ["Init";"Logic"] "trans_eq"
+let _trans_eq = constant ["Init";"Logic"] "eq_trans"
let _eq = constant ["Init";"Logic"] "eq"
diff --git a/plugins/cc/cctac.mli b/plugins/cc/cctac.mli
index 32f56163..365c172c 100644
--- a/plugins/cc/cctac.mli
+++ b/plugins/cc/cctac.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/cc/g_congruence.ml4 b/plugins/cc/g_congruence.ml4
index 881b9bee..c9805f02 100644
--- a/plugins/cc/g_congruence.ml4
+++ b/plugins/cc/g_congruence.ml4
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/decl_mode/decl_expr.mli b/plugins/decl_mode/decl_expr.mli
index fa6acaeb..69b0a0e3 100644
--- a/plugins/decl_mode/decl_expr.mli
+++ b/plugins/decl_mode/decl_expr.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/decl_mode/decl_interp.ml b/plugins/decl_mode/decl_interp.ml
index b3e076c4..7637fed2 100644
--- a/plugins/decl_mode/decl_interp.ml
+++ b/plugins/decl_mode/decl_interp.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/decl_mode/decl_interp.mli b/plugins/decl_mode/decl_interp.mli
index 46fbcec7..bd6ed064 100644
--- a/plugins/decl_mode/decl_interp.mli
+++ b/plugins/decl_mode/decl_interp.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/decl_mode/decl_mode.ml b/plugins/decl_mode/decl_mode.ml
index af6aa4bf..730051c1 100644
--- a/plugins/decl_mode/decl_mode.ml
+++ b/plugins/decl_mode/decl_mode.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/decl_mode/decl_mode.mli b/plugins/decl_mode/decl_mode.mli
index 4e636598..f23a97b4 100644
--- a/plugins/decl_mode/decl_mode.mli
+++ b/plugins/decl_mode/decl_mode.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/decl_mode/decl_proof_instr.ml b/plugins/decl_mode/decl_proof_instr.ml
index c1553b35..72caeaed 100644
--- a/plugins/decl_mode/decl_proof_instr.ml
+++ b/plugins/decl_mode/decl_proof_instr.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/decl_mode/decl_proof_instr.mli b/plugins/decl_mode/decl_proof_instr.mli
index 1205060a..775d2f53 100644
--- a/plugins/decl_mode/decl_proof_instr.mli
+++ b/plugins/decl_mode/decl_proof_instr.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/decl_mode/g_decl_mode.ml4 b/plugins/decl_mode/g_decl_mode.ml4
index 362f6a61..5699c1bf 100644
--- a/plugins/decl_mode/g_decl_mode.ml4
+++ b/plugins/decl_mode/g_decl_mode.ml4
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/decl_mode/ppdecl_proof.ml b/plugins/decl_mode/ppdecl_proof.ml
index b866efab..7ba0d4ff 100644
--- a/plugins/decl_mode/ppdecl_proof.ml
+++ b/plugins/decl_mode/ppdecl_proof.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/extraction/ExtrOcamlBasic.v b/plugins/extraction/ExtrOcamlBasic.v
index c9556972..3a54b252 100644
--- a/plugins/extraction/ExtrOcamlBasic.v
+++ b/plugins/extraction/ExtrOcamlBasic.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/extraction/ExtrOcamlBigIntConv.v b/plugins/extraction/ExtrOcamlBigIntConv.v
index 69e72918..265fbc52 100644
--- a/plugins/extraction/ExtrOcamlBigIntConv.v
+++ b/plugins/extraction/ExtrOcamlBigIntConv.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/extraction/ExtrOcamlIntConv.v b/plugins/extraction/ExtrOcamlIntConv.v
index 697ea6b3..cb866dc8 100644
--- a/plugins/extraction/ExtrOcamlIntConv.v
+++ b/plugins/extraction/ExtrOcamlIntConv.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/extraction/ExtrOcamlNatBigInt.v b/plugins/extraction/ExtrOcamlNatBigInt.v
index 0a303b63..fb45a8be 100644
--- a/plugins/extraction/ExtrOcamlNatBigInt.v
+++ b/plugins/extraction/ExtrOcamlNatBigInt.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/extraction/ExtrOcamlNatInt.v b/plugins/extraction/ExtrOcamlNatInt.v
index a0cb26b5..fd134899 100644
--- a/plugins/extraction/ExtrOcamlNatInt.v
+++ b/plugins/extraction/ExtrOcamlNatInt.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/extraction/ExtrOcamlString.v b/plugins/extraction/ExtrOcamlString.v
index f8f942c8..3d86d712 100644
--- a/plugins/extraction/ExtrOcamlString.v
+++ b/plugins/extraction/ExtrOcamlString.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/extraction/ExtrOcamlZBigInt.v b/plugins/extraction/ExtrOcamlZBigInt.v
index 12607b3a..a6ba9aa2 100644
--- a/plugins/extraction/ExtrOcamlZBigInt.v
+++ b/plugins/extraction/ExtrOcamlZBigInt.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -75,13 +75,13 @@ Extract Constant Z.compare => "Big.compare_case Eq Lt Gt".
Extract Constant Z.of_N => "fun p -> p".
Extract Constant Z.abs_N => "Big.abs".
-(** Zdiv and Zmod are quite complex to define in terms of (/) and (mod).
+(** Z.div and Z.modulo are quite complex to define in terms of (/) and (mod).
For the moment we don't even try *)
(** Test:
Require Import ZArith NArith.
Extraction "/tmp/test.ml"
- Pplus Ppred Pminus Pmult Pcompare Npred Nminus Ndiv Nmod Ncompare
- Zplus Zmult BinInt.Zcompare Z_of_N Zabs_N Zdiv.Zdiv Zmod.
+ Pos.add Pos.pred Pos.sub Pos.mul Pos.compare N.pred N.sub N.div N.modulo N.compare
+ Z.add Z.mul Z.compare Z.of_N Z.abs_N Z.div Z.modulo.
*)
diff --git a/plugins/extraction/ExtrOcamlZInt.v b/plugins/extraction/ExtrOcamlZInt.v
index 55ba0ca1..c8c40e73 100644
--- a/plugins/extraction/ExtrOcamlZInt.v
+++ b/plugins/extraction/ExtrOcamlZInt.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -74,7 +74,7 @@ Extract Constant Z.compare =>
Extract Constant Z.of_N => "fun p -> p".
Extract Constant Z.abs_N => "abs".
-(** Zdiv and Zmod are quite complex to define in terms of (/) and (mod).
+(** Z.div and Z.modulo are quite complex to define in terms of (/) and (mod).
For the moment we don't even try *)
diff --git a/plugins/extraction/big.ml b/plugins/extraction/big.ml
index 4c33691d..ddb57a25 100644
--- a/plugins/extraction/big.ml
+++ b/plugins/extraction/big.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/extraction/common.ml b/plugins/extraction/common.ml
index 0bd5b843..92b5949e 100644
--- a/plugins/extraction/common.ml
+++ b/plugins/extraction/common.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -197,7 +197,7 @@ let empty_env () = [], get_global_ids ()
let mktable autoclean =
let h = Hashtbl.create 97 in
if autoclean then register_cleanup (fun () -> Hashtbl.clear h);
- (Hashtbl.add h, Hashtbl.find h, fun () -> Hashtbl.clear h)
+ (Hashtbl.replace h, Hashtbl.find h, fun () -> Hashtbl.clear h)
(* We might have built [global_reference] whose canonical part is
inaccurate. We must hence compare only the user part,
diff --git a/plugins/extraction/common.mli b/plugins/extraction/common.mli
index 02a496be..f5d90a43 100644
--- a/plugins/extraction/common.mli
+++ b/plugins/extraction/common.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/extraction/extract_env.ml b/plugins/extraction/extract_env.ml
index 83ebb139..6aa47eff 100644
--- a/plugins/extraction/extract_env.ml
+++ b/plugins/extraction/extract_env.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -571,7 +571,9 @@ let separate_extraction lr =
(*s Simple extraction in the Coq toplevel. The vernacular command
is \verb!Extraction! [qualid]. *)
-let simple_extraction r = match locate_ref [r] with
+let simple_extraction r =
+ Vernacentries.dump_global (Genarg.AN r);
+ match locate_ref [r] with
| ([], [mp]) as p -> full_extr None p
| [r],[] ->
init false false;
diff --git a/plugins/extraction/extract_env.mli b/plugins/extraction/extract_env.mli
index e587bf21..75ac111d 100644
--- a/plugins/extraction/extract_env.mli
+++ b/plugins/extraction/extract_env.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/extraction/extraction.ml b/plugins/extraction/extraction.ml
index 219b3913..e76c6919 100644
--- a/plugins/extraction/extraction.ml
+++ b/plugins/extraction/extraction.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/extraction/extraction.mli b/plugins/extraction/extraction.mli
index 48f05acb..1eb9ca8e 100644
--- a/plugins/extraction/extraction.mli
+++ b/plugins/extraction/extraction.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/extraction/g_extraction.ml4 b/plugins/extraction/g_extraction.ml4
index 11a2d0e0..7dabb560 100644
--- a/plugins/extraction/g_extraction.ml4
+++ b/plugins/extraction/g_extraction.ml4
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/extraction/haskell.ml b/plugins/extraction/haskell.ml
index 96731ed2..6c78b533 100644
--- a/plugins/extraction/haskell.ml
+++ b/plugins/extraction/haskell.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/extraction/haskell.mli b/plugins/extraction/haskell.mli
index 0f8949e3..5e76be48 100644
--- a/plugins/extraction/haskell.mli
+++ b/plugins/extraction/haskell.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/extraction/miniml.mli b/plugins/extraction/miniml.mli
index 5a19cc3f..856a481e 100644
--- a/plugins/extraction/miniml.mli
+++ b/plugins/extraction/miniml.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/extraction/mlutil.ml b/plugins/extraction/mlutil.ml
index c244e046..a38b303f 100644
--- a/plugins/extraction/mlutil.ml
+++ b/plugins/extraction/mlutil.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/extraction/mlutil.mli b/plugins/extraction/mlutil.mli
index 029e8cf4..e10b6070 100644
--- a/plugins/extraction/mlutil.mli
+++ b/plugins/extraction/mlutil.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/extraction/modutil.ml b/plugins/extraction/modutil.ml
index 4e0dbcab..257e1c1c 100644
--- a/plugins/extraction/modutil.ml
+++ b/plugins/extraction/modutil.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/extraction/modutil.mli b/plugins/extraction/modutil.mli
index 0565522b..fb8d5e1b 100644
--- a/plugins/extraction/modutil.mli
+++ b/plugins/extraction/modutil.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/extraction/ocaml.ml b/plugins/extraction/ocaml.ml
index ed69ec45..289b2a1d 100644
--- a/plugins/extraction/ocaml.ml
+++ b/plugins/extraction/ocaml.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/extraction/ocaml.mli b/plugins/extraction/ocaml.mli
index fd60c69d..f55e2fd6 100644
--- a/plugins/extraction/ocaml.mli
+++ b/plugins/extraction/ocaml.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/extraction/scheme.ml b/plugins/extraction/scheme.ml
index 21507655..7915bc82 100644
--- a/plugins/extraction/scheme.ml
+++ b/plugins/extraction/scheme.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/extraction/scheme.mli b/plugins/extraction/scheme.mli
index eeca083c..405842f0 100644
--- a/plugins/extraction/scheme.mli
+++ b/plugins/extraction/scheme.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/extraction/table.ml b/plugins/extraction/table.ml
index 238befd2..e0a6e843 100644
--- a/plugins/extraction/table.ml
+++ b/plugins/extraction/table.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -842,6 +842,7 @@ let extract_constant_inline inline r ids s =
let extract_inductive r s l optstr =
check_inside_section ();
let g = Smartlocate.global_with_alias r in
+ Dumpglob.add_glob (loc_of_reference r) g;
match g with
| IndRef ((kn,i) as ip) ->
let mib = Global.lookup_mind kn in
diff --git a/plugins/extraction/table.mli b/plugins/extraction/table.mli
index a3b7124e..192426c3 100644
--- a/plugins/extraction/table.mli
+++ b/plugins/extraction/table.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/field/LegacyField.v b/plugins/field/LegacyField.v
index 011bc81e..504304c6 100644
--- a/plugins/field/LegacyField.v
+++ b/plugins/field/LegacyField.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/field/LegacyField_Compl.v b/plugins/field/LegacyField_Compl.v
index 97c70c0e..5e9ae430 100644
--- a/plugins/field/LegacyField_Compl.v
+++ b/plugins/field/LegacyField_Compl.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/field/LegacyField_Tactic.v b/plugins/field/LegacyField_Tactic.v
index 810443f8..41d2998c 100644
--- a/plugins/field/LegacyField_Tactic.v
+++ b/plugins/field/LegacyField_Tactic.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -150,7 +150,7 @@ Ltac apply_assoc FT lvar trm :=
match constr:(t = trm) with
| (?X1 = ?X1) => idtac
| _ =>
- rewrite <- (assoc_correct FT trm); change (assoc trm) with t in |- *
+ rewrite <- (assoc_correct FT trm); change (assoc trm) with t
end.
(**** Distribution *****)
@@ -161,7 +161,7 @@ Ltac apply_distrib FT lvar trm :=
| (?X1 = ?X1) => idtac
| _ =>
rewrite <- (distrib_correct FT trm);
- change (distrib trm) with t in |- *
+ change (distrib trm) with t
end.
(**** Multiplication by the inverse product ****)
@@ -175,7 +175,7 @@ Ltac weak_reduce :=
| |- context [(interp_ExprA ?X1 ?X2 _)] =>
cbv beta iota zeta
delta [interp_ExprA assoc_2nd eq_nat_dec mult_of_list X1 X2 A Azero
- Aone Aplus Amult Aopp Ainv] in |- *
+ Aone Aplus Amult Aopp Ainv]
end.
Ltac multiply mul :=
@@ -199,7 +199,7 @@ Ltac apply_multiply FT lvar trm :=
| (?X1 = ?X1) => idtac
| _ =>
rewrite <- (multiply_correct FT trm);
- change (multiply trm) with t in |- *
+ change (multiply trm) with t
end.
(**** Permutations and simplification ****)
@@ -210,7 +210,7 @@ Ltac apply_inverse mul FT lvar trm :=
| (?X1 = ?X1) => idtac
| _ =>
rewrite <- (inverse_correct FT trm mul);
- [ change (inverse_simplif mul trm) with t in |- * | assumption ]
+ [ change (inverse_simplif mul trm) with t | assumption ]
end.
(**** Inverse test ****)
@@ -252,11 +252,11 @@ Ltac apply_simplif sfun :=
Ltac unfolds FT :=
match get_component Aminus FT with
- | Some ?X1 => unfold X1 in |- *
+ | Some ?X1 => unfold X1
| _ => idtac
end;
match get_component Adiv FT with
- | Some ?X1 => unfold X1 in |- *
+ | Some ?X1 => unfold X1
| _ => idtac
end.
@@ -267,8 +267,8 @@ Ltac reduce FT :=
with AmultT := get_component Amult FT
with AoppT := get_component Aopp FT
with AinvT := get_component Ainv FT in
- (cbv beta iota zeta delta -[AzeroT AoneT AplusT AmultT AoppT AinvT] in |- * ||
- compute in |- *).
+ (cbv beta iota zeta delta -[AzeroT AoneT AplusT AmultT AoppT AinvT] ||
+ compute).
Ltac field_gen_aux FT :=
let AplusT := get_component Aplus FT in
@@ -280,7 +280,7 @@ Ltac field_gen_aux FT :=
cut
(let ft := FT in
let vm := lvar in interp_ExprA ft vm trm1 = interp_ExprA ft vm trm2);
- [ compute in |- *; auto
+ [ compute; auto
| intros ft vm; apply_simplif apply_distrib;
apply_simplif apply_assoc; multiply mul;
[ apply_simplif apply_multiply;
diff --git a/plugins/field/LegacyField_Theory.v b/plugins/field/LegacyField_Theory.v
index 20ffbc27..1d581a8f 100644
--- a/plugins/field/LegacyField_Theory.v
+++ b/plugins/field/LegacyField_Theory.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -44,20 +44,20 @@ Proof.
elim (H1 e0); intro y; elim (H2 e); intro y0;
try
(left; rewrite y; rewrite y0; auto) ||
- (right; red in |- *; intro; inversion H3; auto).
+ (right; red; intro; inversion H3; auto).
elim (H1 e0); intro y; elim (H2 e); intro y0;
try
(left; rewrite y; rewrite y0; auto) ||
- (right; red in |- *; intro; inversion H3; auto).
+ (right; red; intro; inversion H3; auto).
elim (H0 e); intro y.
left; rewrite y; auto.
- right; red in |- *; intro; inversion H1; auto.
+ right; red; intro; inversion H1; auto.
elim (H0 e); intro y.
left; rewrite y; auto.
- right; red in |- *; intro; inversion H1; auto.
+ right; red; intro; inversion H1; auto.
elim (eq_nat_dec n n0); intro y.
left; rewrite y; auto.
- right; red in |- *; intro; inversion H; auto.
+ right; red; intro; inversion H; auto.
Defined.
Definition eq_nat_dec := Eval compute in eq_nat_dec.
@@ -152,7 +152,7 @@ Lemma r_AmultT_mult :
forall r r1 r2:AT, AmultT r r1 = AmultT r r2 -> r <> AzeroT -> r1 = r2.
Proof.
intros; transitivity (AmultT (AmultT (AinvT r) r) r1).
- rewrite Th_inv_defT; [ symmetry in |- *; apply AmultT_1l; auto | auto ].
+ rewrite Th_inv_defT; [ symmetry ; apply AmultT_1l; auto | auto ].
transitivity (AmultT (AmultT (AinvT r) r) r2).
repeat rewrite AmultT_assoc; rewrite H; trivial.
rewrite Th_inv_defT; [ apply AmultT_1l; auto | auto ].
@@ -181,7 +181,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; legacy ring.
+ intros r1 r2 H; split; red; intro; apply H; rewrite H0; legacy ring.
Qed.
(************************)
@@ -262,11 +262,11 @@ Lemma merge_mult_correct1 :
Proof.
intros e1 e2; generalize e1; generalize e2; clear e1 e2.
simple induction e2; auto; intros.
-unfold merge_mult at 1 in |- *; fold merge_mult in |- *;
- unfold interp_ExprA at 2 in |- *; fold interp_ExprA in |- *;
- rewrite (H0 e e3 lvar); unfold interp_ExprA at 1 in |- *;
- fold interp_ExprA in |- *; unfold interp_ExprA at 5 in |- *;
- fold interp_ExprA in |- *; auto.
+unfold merge_mult at 1; fold merge_mult;
+ unfold interp_ExprA at 2; fold interp_ExprA;
+ rewrite (H0 e e3 lvar); unfold interp_ExprA at 1;
+ fold interp_ExprA; unfold interp_ExprA at 5;
+ fold interp_ExprA; auto.
Qed.
Lemma merge_mult_correct :
@@ -274,7 +274,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 |- *; legacy ring).
+elim e0; try (intros; simpl; legacy ring).
unfold interp_ExprA in H2; fold interp_ExprA in H2;
cut
(AmultT (interp_ExprA lvar e2)
@@ -284,7 +284,7 @@ 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 |- *; legacy ring.
+ simpl; legacy ring.
legacy ring.
Qed.
@@ -295,8 +295,8 @@ Lemma assoc_mult_correct1 :
interp_ExprA lvar (assoc_mult (EAmult e1 e2)).
Proof.
simple induction e1; auto; intros.
-rewrite <- (H e0 lvar); simpl in |- *; rewrite merge_mult_correct;
- simpl in |- *; rewrite merge_mult_correct; simpl in |- *;
+rewrite <- (H e0 lvar); simpl; rewrite merge_mult_correct;
+ simpl; rewrite merge_mult_correct; simpl;
auto.
Qed.
@@ -306,21 +306,21 @@ Lemma assoc_mult_correct :
Proof.
simple induction e; auto; intros.
elim e0; intros.
-intros; simpl in |- *; legacy ring.
-simpl in |- *; rewrite (AmultT_1l (interp_ExprA lvar (assoc_mult e1)));
+intros; simpl; legacy ring.
+simpl; rewrite (AmultT_1l (interp_ExprA lvar (assoc_mult e1)));
rewrite (AmultT_1l (interp_ExprA lvar e1)); apply H0.
-simpl in |- *; rewrite (H0 lvar); auto.
-simpl in |- *; rewrite merge_mult_correct; simpl in |- *;
- rewrite merge_mult_correct; simpl in |- *; rewrite AmultT_assoc;
- rewrite assoc_mult_correct1; rewrite H2; simpl in |- *;
+simpl; rewrite (H0 lvar); auto.
+simpl; rewrite merge_mult_correct; simpl;
+ rewrite merge_mult_correct; simpl; rewrite AmultT_assoc;
+ rewrite assoc_mult_correct1; rewrite H2; simpl;
rewrite <- assoc_mult_correct1 in H1; unfold interp_ExprA at 3 in H1;
fold interp_ExprA in H1; rewrite (H0 lvar) in H1;
rewrite (AmultT_comm (interp_ExprA lvar e3) (interp_ExprA lvar e1));
rewrite <- AmultT_assoc; rewrite H1; rewrite AmultT_assoc;
legacy ring.
-simpl in |- *; rewrite (H0 lvar); auto.
-simpl in |- *; rewrite (H0 lvar); auto.
-simpl in |- *; rewrite (H0 lvar); auto.
+simpl; rewrite (H0 lvar); auto.
+simpl; rewrite (H0 lvar); auto.
+simpl; rewrite (H0 lvar); auto.
Qed.
Lemma merge_plus_correct1 :
@@ -330,11 +330,11 @@ Lemma merge_plus_correct1 :
Proof.
intros e1 e2; generalize e1; generalize e2; clear e1 e2.
simple induction e2; auto; intros.
-unfold merge_plus at 1 in |- *; fold merge_plus in |- *;
- unfold interp_ExprA at 2 in |- *; fold interp_ExprA in |- *;
- rewrite (H0 e e3 lvar); unfold interp_ExprA at 1 in |- *;
- fold interp_ExprA in |- *; unfold interp_ExprA at 5 in |- *;
- fold interp_ExprA in |- *; auto.
+unfold merge_plus at 1; fold merge_plus;
+ unfold interp_ExprA at 2; fold interp_ExprA;
+ rewrite (H0 e e3 lvar); unfold interp_ExprA at 1;
+ fold interp_ExprA; unfold interp_ExprA at 5;
+ fold interp_ExprA; auto.
Qed.
Lemma merge_plus_correct :
@@ -342,7 +342,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 |- *; legacy ring).
+elim e0; try intros; try (simpl; legacy ring).
unfold interp_ExprA in H2; fold interp_ExprA in H2;
cut
(AplusT (interp_ExprA lvar e2)
@@ -352,7 +352,7 @@ 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 |- *; legacy ring.
+ simpl; legacy ring.
legacy ring.
Qed.
@@ -362,8 +362,8 @@ Lemma assoc_plus_correct :
interp_ExprA lvar (assoc (EAplus e1 e2)).
Proof.
simple induction e1; auto; intros.
-rewrite <- (H e0 lvar); simpl in |- *; rewrite merge_plus_correct;
- simpl in |- *; rewrite merge_plus_correct; simpl in |- *;
+rewrite <- (H e0 lvar); simpl; rewrite merge_plus_correct;
+ simpl; rewrite merge_plus_correct; simpl;
auto.
Qed.
@@ -373,11 +373,11 @@ Lemma assoc_correct :
Proof.
simple induction e; auto; intros.
elim e0; intros.
-simpl in |- *; rewrite (H0 lvar); auto.
-simpl in |- *; rewrite (H0 lvar); auto.
-simpl in |- *; rewrite merge_plus_correct; simpl in |- *;
- rewrite merge_plus_correct; simpl in |- *; rewrite AplusT_assoc;
- rewrite assoc_plus_correct; rewrite H2; simpl in |- *;
+simpl; rewrite (H0 lvar); auto.
+simpl; rewrite (H0 lvar); auto.
+simpl; rewrite merge_plus_correct; simpl;
+ rewrite merge_plus_correct; simpl; rewrite AplusT_assoc;
+ rewrite assoc_plus_correct; rewrite H2; simpl;
apply
(r_AplusT_plus (interp_ExprA lvar (assoc e1))
(AplusT (interp_ExprA lvar (assoc e2))
@@ -386,7 +386,7 @@ simpl in |- *; rewrite merge_plus_correct; simpl in |- *;
(interp_ExprA lvar e1))); rewrite <- AplusT_assoc;
rewrite
(AplusT_comm (interp_ExprA lvar (assoc e1)) (interp_ExprA lvar (assoc e2)))
- ; rewrite assoc_plus_correct; rewrite H1; simpl in |- *;
+ ; rewrite assoc_plus_correct; rewrite H1; simpl;
rewrite (H0 lvar);
rewrite <-
(AplusT_assoc (AplusT (interp_ExprA lvar e2) (interp_ExprA lvar e1))
@@ -399,15 +399,15 @@ simpl in |- *; rewrite merge_plus_correct; simpl in |- *;
rewrite <-
(AplusT_assoc (interp_ExprA lvar e2) (interp_ExprA lvar e3)
(interp_ExprA lvar e1)); apply AplusT_comm.
-unfold assoc in |- *; fold assoc in |- *; unfold interp_ExprA in |- *;
- fold interp_ExprA in |- *; rewrite assoc_mult_correct;
- rewrite (H0 lvar); simpl in |- *; auto.
-simpl in |- *; rewrite (H0 lvar); auto.
-simpl in |- *; rewrite (H0 lvar); auto.
-simpl in |- *; rewrite (H0 lvar); auto.
-unfold assoc in |- *; fold assoc in |- *; unfold interp_ExprA in |- *;
- fold interp_ExprA in |- *; rewrite assoc_mult_correct;
- simpl in |- *; auto.
+unfold assoc; fold assoc; unfold interp_ExprA;
+ fold interp_ExprA; rewrite assoc_mult_correct;
+ rewrite (H0 lvar); simpl; auto.
+simpl; rewrite (H0 lvar); auto.
+simpl; rewrite (H0 lvar); auto.
+simpl; rewrite (H0 lvar); auto.
+unfold assoc; fold assoc; unfold interp_ExprA;
+ fold interp_ExprA; rewrite assoc_mult_correct;
+ simpl; auto.
Qed.
(**** Distribution *****)
@@ -451,7 +451,7 @@ Lemma distrib_mult_right_correct :
interp_ExprA lvar (distrib_mult_right e1 e2) =
AmultT (interp_ExprA lvar e1) (interp_ExprA lvar e2).
Proof.
-simple induction e1; try intros; simpl in |- *; auto.
+simple induction e1; try intros; simpl; auto.
rewrite AmultT_comm; rewrite AmultT_AplusT_distr; rewrite (H e2 lvar);
rewrite (H0 e2 lvar); legacy ring.
Qed.
@@ -461,10 +461,10 @@ Lemma distrib_mult_left_correct :
interp_ExprA lvar (distrib_mult_left e1 e2) =
AmultT (interp_ExprA lvar e1) (interp_ExprA lvar e2).
Proof.
-simple induction e1; try intros; simpl in |- *.
-rewrite AmultT_Ol; rewrite distrib_mult_right_correct; simpl in |- *;
+simple induction e1; try intros; simpl.
+rewrite AmultT_Ol; rewrite distrib_mult_right_correct; simpl;
apply AmultT_Or.
-rewrite distrib_mult_right_correct; simpl in |- *; apply AmultT_comm.
+rewrite distrib_mult_right_correct; simpl; apply AmultT_comm.
rewrite AmultT_comm;
rewrite
(AmultT_AplusT_distr (interp_ExprA lvar e2) (interp_ExprA lvar e)
@@ -472,10 +472,10 @@ rewrite AmultT_comm;
rewrite (AmultT_comm (interp_ExprA lvar e2) (interp_ExprA lvar e));
rewrite (AmultT_comm (interp_ExprA lvar e2) (interp_ExprA lvar e0));
rewrite (H e2 lvar); rewrite (H0 e2 lvar); auto.
-rewrite distrib_mult_right_correct; simpl in |- *; apply AmultT_comm.
-rewrite distrib_mult_right_correct; simpl in |- *; apply AmultT_comm.
-rewrite distrib_mult_right_correct; simpl in |- *; apply AmultT_comm.
-rewrite distrib_mult_right_correct; simpl in |- *; apply AmultT_comm.
+rewrite distrib_mult_right_correct; simpl; apply AmultT_comm.
+rewrite distrib_mult_right_correct; simpl; apply AmultT_comm.
+rewrite distrib_mult_right_correct; simpl; apply AmultT_comm.
+rewrite distrib_mult_right_correct; simpl; apply AmultT_comm.
Qed.
Lemma distrib_correct :
@@ -483,13 +483,13 @@ Lemma distrib_correct :
interp_ExprA lvar (distrib e) = interp_ExprA lvar e.
Proof.
simple induction e; intros; auto.
-simpl in |- *; rewrite <- (H lvar); rewrite <- (H0 lvar);
- unfold distrib in |- *; simpl in |- *; auto.
-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 |- *; legacy ring.
+simpl; rewrite <- (H lvar); rewrite <- (H0 lvar);
+ unfold distrib; simpl; auto.
+simpl; rewrite <- (H lvar); rewrite <- (H0 lvar);
+ unfold distrib; simpl; apply distrib_mult_left_correct.
+simpl; fold AoppT; rewrite <- (H lvar);
+ unfold distrib; simpl; rewrite distrib_mult_right_correct;
+ simpl; fold AoppT; legacy ring.
Qed.
(**** Multiplication by the inverse product ****)
@@ -500,7 +500,7 @@ Lemma mult_eq :
interp_ExprA lvar (EAmult a e1) = interp_ExprA lvar (EAmult a e2) ->
interp_ExprA lvar e1 = interp_ExprA lvar e2.
Proof.
- simpl in |- *; intros;
+ simpl; intros;
apply
(r_AmultT_mult (interp_ExprA lvar a) (interp_ExprA lvar e1)
(interp_ExprA lvar e2)); assumption.
@@ -523,16 +523,16 @@ Lemma multiply_aux_correct :
interp_ExprA lvar (multiply_aux a e) =
AmultT (interp_ExprA lvar a) (interp_ExprA lvar e).
Proof.
-simple induction e; simpl in |- *; intros; try rewrite merge_mult_correct;
+simple induction e; simpl; intros; try rewrite merge_mult_correct;
auto.
- simpl in |- *; rewrite (H0 lvar); legacy ring.
+ simpl; rewrite (H0 lvar); legacy ring.
Qed.
Lemma multiply_correct :
forall (e:ExprA) (lvar:list (AT * nat)),
interp_ExprA lvar (multiply e) = interp_ExprA lvar e.
Proof.
- simple induction e; simpl in |- *; auto.
+ simple induction e; simpl; auto.
intros; apply multiply_aux_correct.
Qed.
@@ -583,27 +583,27 @@ Lemma monom_remove_correct :
AmultT (interp_ExprA lvar a) (interp_ExprA lvar e).
Proof.
simple induction e; intros.
-simpl in |- *; case (eqExprA EAzero (EAinv a)); intros;
- [ inversion e0 | simpl in |- *; trivial ].
-simpl in |- *; case (eqExprA EAone (EAinv a)); intros;
- [ inversion e0 | simpl in |- *; trivial ].
-simpl in |- *; case (eqExprA (EAplus e0 e1) (EAinv a)); intros;
- [ inversion e2 | simpl in |- *; trivial ].
-simpl in |- *; case (eqExprA e0 (EAinv a)); intros.
-rewrite e2; simpl in |- *; fold AinvT in |- *.
+simpl; case (eqExprA EAzero (EAinv a)); intros;
+ [ inversion e0 | simpl; trivial ].
+simpl; case (eqExprA EAone (EAinv a)); intros;
+ [ inversion e0 | simpl; trivial ].
+simpl; case (eqExprA (EAplus e0 e1) (EAinv a)); intros;
+ [ inversion e2 | simpl; trivial ].
+simpl; case (eqExprA e0 (EAinv a)); intros.
+rewrite e2; simpl; fold AinvT.
rewrite <-
(AmultT_assoc (interp_ExprA lvar a) (AinvT (interp_ExprA lvar a))
(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.
+simpl; rewrite H0; auto; legacy ring.
+simpl; fold AoppT; case (eqExprA (EAopp e0) (EAinv a));
+ intros; [ inversion e1 | simpl; trivial ].
+unfold monom_remove; case (eqExprA (EAinv e0) (EAinv a)); intros.
case (eqExprA e0 a); intros.
-rewrite e2; simpl in |- *; fold AinvT in |- *; rewrite AinvT_r; auto.
-inversion e1; simpl in |- *; exfalso; auto.
-simpl in |- *; trivial.
-unfold monom_remove in |- *; case (eqExprA (EAvar n) (EAinv a)); intros;
- [ inversion e0 | simpl in |- *; trivial ].
+rewrite e2; simpl; fold AinvT; rewrite AinvT_r; auto.
+inversion e1; simpl; exfalso; auto.
+simpl; trivial.
+unfold monom_remove; case (eqExprA (EAvar n) (EAinv a)); intros;
+ [ inversion e0 | simpl; trivial ].
Qed.
Lemma monom_simplif_rem_correct :
@@ -612,7 +612,7 @@ Lemma monom_simplif_rem_correct :
interp_ExprA lvar (monom_simplif_rem a e) =
AmultT (interp_ExprA lvar a) (interp_ExprA lvar e).
Proof.
-simple induction a; simpl in |- *; intros; try rewrite monom_remove_correct;
+simple induction a; simpl; intros; try rewrite monom_remove_correct;
auto.
elim (Rmult_neq_0_reg (interp_ExprA lvar e) (interp_ExprA lvar e0) H1);
intros.
@@ -626,9 +626,9 @@ Lemma monom_simplif_correct :
interp_ExprA lvar (monom_simplif a e) = interp_ExprA lvar e.
Proof.
simple induction e; intros; auto.
-simpl in |- *; case (eqExprA a e0); intros.
+simpl; case (eqExprA a e0); intros.
rewrite <- e2; apply monom_simplif_rem_correct; auto.
-simpl in |- *; trivial.
+simpl; trivial.
Qed.
Lemma inverse_correct :
@@ -637,8 +637,8 @@ Lemma inverse_correct :
interp_ExprA lvar (inverse_simplif a e) = interp_ExprA lvar e.
Proof.
simple induction e; intros; auto.
-simpl in |- *; rewrite (H0 a lvar H1); rewrite monom_simplif_correct; auto.
-unfold inverse_simplif in |- *; rewrite monom_simplif_correct; auto.
+simpl; rewrite (H0 a lvar H1); rewrite monom_simplif_correct; auto.
+unfold inverse_simplif; rewrite monom_simplif_correct; auto.
Qed.
End Theory_of_fields.
diff --git a/plugins/field/field.ml4 b/plugins/field/field.ml4
index 9e4f4d74..6c9fd325 100644
--- a/plugins/field/field.ml4
+++ b/plugins/field/field.ml4
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/firstorder/formula.ml b/plugins/firstorder/formula.ml
index d67dceea..f0043140 100644
--- a/plugins/firstorder/formula.ml
+++ b/plugins/firstorder/formula.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/firstorder/formula.mli b/plugins/firstorder/formula.mli
index 379aaff1..fe6238ab 100644
--- a/plugins/firstorder/formula.mli
+++ b/plugins/firstorder/formula.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/firstorder/g_ground.ml4 b/plugins/firstorder/g_ground.ml4
index 034dc3c2..9d3d8c99 100644
--- a/plugins/firstorder/g_ground.ml4
+++ b/plugins/firstorder/g_ground.ml4
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/firstorder/ground.ml b/plugins/firstorder/ground.ml
index 46708053..4d907b2c 100644
--- a/plugins/firstorder/ground.ml
+++ b/plugins/firstorder/ground.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/firstorder/ground.mli b/plugins/firstorder/ground.mli
index a4ee68fd..8b2ba20c 100644
--- a/plugins/firstorder/ground.mli
+++ b/plugins/firstorder/ground.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/firstorder/instances.ml b/plugins/firstorder/instances.ml
index 16831d3e..68f112d6 100644
--- a/plugins/firstorder/instances.ml
+++ b/plugins/firstorder/instances.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/firstorder/instances.mli b/plugins/firstorder/instances.mli
index be69b067..edccf213 100644
--- a/plugins/firstorder/instances.mli
+++ b/plugins/firstorder/instances.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/firstorder/rules.ml b/plugins/firstorder/rules.ml
index 23eeb2f6..33bb522f 100644
--- a/plugins/firstorder/rules.ml
+++ b/plugins/firstorder/rules.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/firstorder/rules.mli b/plugins/firstorder/rules.mli
index 7d1e57f4..d56efbcb 100644
--- a/plugins/firstorder/rules.mli
+++ b/plugins/firstorder/rules.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/firstorder/sequent.ml b/plugins/firstorder/sequent.ml
index f75678c6..43de96ab 100644
--- a/plugins/firstorder/sequent.ml
+++ b/plugins/firstorder/sequent.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/firstorder/sequent.mli b/plugins/firstorder/sequent.mli
index c5c2bb95..9e99e23b 100644
--- a/plugins/firstorder/sequent.mli
+++ b/plugins/firstorder/sequent.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/firstorder/unify.ml b/plugins/firstorder/unify.ml
index 299a0054..73c7f79c 100644
--- a/plugins/firstorder/unify.ml
+++ b/plugins/firstorder/unify.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/firstorder/unify.mli b/plugins/firstorder/unify.mli
index 06865611..a13709f4 100644
--- a/plugins/firstorder/unify.mli
+++ b/plugins/firstorder/unify.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/fourier/Fourier.v b/plugins/fourier/Fourier.v
index a1113d2d..f37d0027 100644
--- a/plugins/fourier/Fourier.v
+++ b/plugins/fourier/Fourier.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/fourier/Fourier_util.v b/plugins/fourier/Fourier_util.v
index 3d16f189..b10c304c 100644
--- a/plugins/fourier/Fourier_util.v
+++ b/plugins/fourier/Fourier_util.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -16,7 +16,7 @@ intros; apply Rmult_lt_compat_l; assumption.
Qed.
Lemma Rfourier_le : forall x1 y1 a:R, x1 <= y1 -> 0 < a -> a * x1 <= a * y1.
-red in |- *.
+red.
intros.
case H; auto with real.
Qed.
@@ -63,19 +63,19 @@ Lemma Rfourier_le_le :
x1 <= y1 -> x2 <= y2 -> 0 < a -> x1 + a * x2 <= y1 + a * y2.
intros x1 y1 x2 y2 a H H0 H1; try assumption.
case H0; intros.
-red in |- *.
+red.
left; try assumption.
apply Rfourier_le_lt; auto with real.
rewrite H2.
case H; intros.
-red in |- *.
+red.
left; try assumption.
rewrite (Rplus_comm x1 (a * y2)).
rewrite (Rplus_comm y1 (a * y2)).
apply Rplus_lt_compat_l.
try exact H3.
rewrite H3.
-red in |- *.
+red.
right; try assumption.
auto with real.
Qed.
@@ -84,7 +84,7 @@ Lemma Rlt_zero_pos_plus1 : forall x:R, 0 < x -> 0 < 1 + x.
intros x H; try assumption.
rewrite Rplus_comm.
apply Rle_lt_0_plus_1.
-red in |- *; auto with real.
+red; auto with real.
Qed.
Lemma Rlt_mult_inv_pos : forall x y:R, 0 < x -> 0 < y -> 0 < x * / y.
@@ -101,12 +101,12 @@ Qed.
Lemma Rle_zero_pos_plus1 : forall x:R, 0 <= x -> 0 <= 1 + x.
intros x H; try assumption.
case H; intros.
-red in |- *.
+red.
left; try assumption.
apply Rlt_zero_pos_plus1; auto with real.
rewrite <- H0.
replace (1 + 0) with 1.
-red in |- *; left.
+red; left.
exact Rlt_zero_1.
ring.
Qed.
@@ -114,28 +114,28 @@ Qed.
Lemma Rle_mult_inv_pos : forall x y:R, 0 <= x -> 0 < y -> 0 <= x * / y.
intros x y H H0; try assumption.
case H; intros.
-red in |- *; left.
+red; left.
apply Rlt_mult_inv_pos; auto with real.
rewrite <- H1.
-red in |- *; right; ring.
+red; right; ring.
Qed.
Lemma Rle_zero_1 : 0 <= 1.
-red in |- *; left.
+red; left.
exact Rlt_zero_1.
Qed.
Lemma Rle_not_lt : forall n d:R, 0 <= n * / d -> ~ 0 < - n * / d.
-intros n d H; red in |- *; intros H0; try exact H0.
+intros n d H; red; intros H0; try exact H0.
generalize (Rgt_not_le 0 (n * / d)).
intros H1; elim H1; try assumption.
replace (n * / d) with (- - (n * / d)).
replace 0 with (- -0).
replace (- (n * / d)) with (- n * / d).
replace (-0) with 0.
-red in |- *.
+red.
apply Ropp_gt_lt_contravar.
-red in |- *.
+red.
exact H0.
ring.
ring.
@@ -162,7 +162,7 @@ ring.
Qed.
Lemma Rnot_lt_lt : forall x y:R, ~ 0 < y - x -> ~ x < y.
-unfold not in |- *; intros.
+unfold not; intros.
apply H.
apply Rplus_lt_reg_r with x.
replace (x + 0) with x.
@@ -173,7 +173,7 @@ ring.
Qed.
Lemma Rnot_le_le : forall x y:R, ~ 0 <= y - x -> ~ x <= y.
-unfold not in |- *; intros.
+unfold not; intros.
apply H.
case H0; intros.
left.
@@ -188,7 +188,7 @@ rewrite H1; ring.
Qed.
Lemma Rfourier_gt_to_lt : forall x y:R, y > x -> x < y.
-unfold Rgt in |- *; intros; assumption.
+unfold Rgt; intros; assumption.
Qed.
Lemma Rfourier_ge_to_le : forall x y:R, y >= x -> x <= y.
diff --git a/plugins/fourier/fourier.ml b/plugins/fourier/fourier.ml
index 6c4d4d15..043c9e51 100644
--- a/plugins/fourier/fourier.ml
+++ b/plugins/fourier/fourier.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/fourier/fourierR.ml b/plugins/fourier/fourierR.ml
index 48493785..cdd10d70 100644
--- a/plugins/fourier/fourierR.ml
+++ b/plugins/fourier/fourierR.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/fourier/g_fourier.ml4 b/plugins/fourier/g_fourier.ml4
index 9276eda1..7c7cf64f 100644
--- a/plugins/fourier/g_fourier.ml4
+++ b/plugins/fourier/g_fourier.ml4
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/funind/Recdef.v b/plugins/funind/Recdef.v
index b29b8362..b2955e90 100644
--- a/plugins/funind/Recdef.v
+++ b/plugins/funind/Recdef.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/funind/functional_principles_types.ml b/plugins/funind/functional_principles_types.ml
index 6df9d574..00e966fb 100644
--- a/plugins/funind/functional_principles_types.ml
+++ b/plugins/funind/functional_principles_types.ml
@@ -142,12 +142,6 @@ let compute_new_princ_type_from_rel rel_to_fun sorts princ_type =
(* observe (str "replacing " ++ pr_lconstr c ++ str " by " ++ pr_lconstr res); *)
res
in
- let rec has_dummy_var t =
- fold_constr
- (fun b t -> b || (eq_constr t dummy_var) || (has_dummy_var t))
- false
- t
- in
let rec compute_new_princ_type remove env pre_princ : types*(constr list) =
let (new_princ_type,_) as res =
match kind_of_term pre_princ with
diff --git a/plugins/funind/g_indfun.ml4 b/plugins/funind/g_indfun.ml4
index 06abb8ce..85d79214 100644
--- a/plugins/funind/g_indfun.ml4
+++ b/plugins/funind/g_indfun.ml4
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/funind/invfun.ml b/plugins/funind/invfun.ml
index 95ca86c2..55451a9f 100644
--- a/plugins/funind/invfun.ml
+++ b/plugins/funind/invfun.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/funind/merge.ml b/plugins/funind/merge.ml
index 4eedf8dc..6ee2f352 100644
--- a/plugins/funind/merge.ml
+++ b/plugins/funind/merge.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/funind/recdef.ml b/plugins/funind/recdef.ml
index 3355300e..892c1a77 100644
--- a/plugins/funind/recdef.ml
+++ b/plugins/funind/recdef.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/micromega/CheckerMaker.v b/plugins/micromega/CheckerMaker.v
index 3031fd22..fa780671 100644
--- a/plugins/micromega/CheckerMaker.v
+++ b/plugins/micromega/CheckerMaker.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/micromega/Env.v b/plugins/micromega/Env.v
index 5f6c60be..caec7800 100644
--- a/plugins/micromega/Env.v
+++ b/plugins/micromega/Env.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -12,10 +12,9 @@
(* *)
(************************************************************************)
-Require Import ZArith.
-Require Import Coq.Arith.Max.
-Require Import List.
+Require Import BinInt List.
Set Implicit Arguments.
+Local Open Scope positive_scope.
Section S.
@@ -23,154 +22,78 @@ Section S.
Definition Env := positive -> D.
- Definition jump (j:positive) (e:Env) := fun x => e (Pplus x j).
+ Definition jump (j:positive) (e:Env) := fun x => e (x+j).
- Definition nth (n:positive) (e : Env ) := e n.
+ Definition nth (n:positive) (e:Env) := e n.
- Definition hd (x:D) (e: Env) := nth xH e.
+ Definition hd (e:Env) := nth 1 e.
- Definition tail (e: Env) := jump xH e.
+ Definition tail (e:Env) := jump 1 e.
- Lemma psucc : forall p, (match p with
- | xI y' => xO (Psucc y')
- | xO y' => xI y'
- | 1%positive => 2%positive
- end) = (p+1)%positive.
+ Lemma jump_add i j l x : jump (i + j) l x = jump i (jump j l) x.
Proof.
- destruct p.
- auto with zarith.
- rewrite xI_succ_xO.
- auto with zarith.
- reflexivity.
+ unfold jump. f_equal. apply Pos.add_assoc.
Qed.
- Lemma jump_Pplus : forall i j l,
- forall x, jump (i + j) l x = jump i (jump j l) x.
- Proof.
- unfold jump.
- intros.
- rewrite Pplus_assoc.
- reflexivity.
- Qed.
-
- Lemma jump_simpl : forall p l,
- forall x, jump p l x =
+ Lemma jump_simpl p l x :
+ jump p l x =
match p with
| xH => tail l x
| xO p => jump p (jump p l) x
| xI p => jump p (jump p (tail l)) x
end.
Proof.
- destruct p ; unfold tail ; intros ; repeat rewrite <- jump_Pplus.
- (* xI p = p + p + 1 *)
- rewrite xI_succ_xO.
- rewrite Pplus_diag.
- rewrite <- Pplus_one_succ_r.
- reflexivity.
- (* xO p = p + p *)
- rewrite Pplus_diag.
- reflexivity.
- reflexivity.
+ destruct p; unfold tail; rewrite <- ?jump_add; f_equal;
+ now rewrite Pos.add_diag.
Qed.
- Ltac jump_s :=
- repeat
- match goal with
- | |- context [jump xH ?e] => rewrite (jump_simpl xH)
- | |- context [jump (xO ?p) ?e] => rewrite (jump_simpl (xO p))
- | |- context [jump (xI ?p) ?e] => rewrite (jump_simpl (xI p))
- end.
-
- Lemma jump_tl : forall j l, forall x, tail (jump j l) x = jump j (tail l) x.
+ Lemma jump_tl j l x : tail (jump j l) x = jump j (tail l) x.
Proof.
- unfold tail.
- intros.
- repeat rewrite <- jump_Pplus.
- rewrite Pplus_comm.
- reflexivity.
+ unfold tail. rewrite <- !jump_add. f_equal. apply Pos.add_comm.
Qed.
- Lemma jump_Psucc : forall j l,
- forall x, (jump (Psucc j) l x) = (jump 1 (jump j l) x).
+ Lemma jump_succ j l x : jump (Pos.succ j) l x = jump 1 (jump j l) x.
Proof.
- intros.
- rewrite <- jump_Pplus.
- rewrite Pplus_one_succ_r.
- rewrite Pplus_comm.
- reflexivity.
+ rewrite <- jump_add. f_equal. symmetry. apply Pos.add_1_l.
Qed.
- Lemma jump_Pdouble_minus_one : forall i l,
- forall x, (jump (Pdouble_minus_one i) (tail l)) x = (jump i (jump i l)) x.
+ Lemma jump_pred_double i l x :
+ jump (Pos.pred_double i) (tail l) x = jump i (jump i l) x.
Proof.
- unfold tail.
- intros.
- repeat rewrite <- jump_Pplus.
- rewrite <- Pplus_one_succ_r.
- rewrite Psucc_o_double_minus_one_eq_xO.
- rewrite Pplus_diag.
- reflexivity.
+ unfold tail. rewrite <- !jump_add. f_equal.
+ now rewrite Pos.add_1_r, Pos.succ_pred_double, Pos.add_diag.
Qed.
- Lemma jump_x0_tail : forall p l, forall x, jump (xO p) (tail l) x = jump (xI p) l x.
- Proof.
- intros.
- unfold jump.
- unfold tail.
- unfold jump.
- rewrite <- Pplus_assoc.
- simpl.
- reflexivity.
- Qed.
-
- Lemma nth_spec : forall p l x,
+ Lemma nth_spec p l :
nth p l =
match p with
- | xH => hd x l
+ | xH => hd l
| xO p => nth p (jump p l)
| xI p => nth p (jump p (tail l))
end.
Proof.
- unfold nth.
- destruct p.
- intros.
- unfold jump, tail.
- unfold jump.
- rewrite Pplus_diag.
- rewrite xI_succ_xO.
- simpl.
- reflexivity.
- unfold jump.
- rewrite Pplus_diag.
- reflexivity.
- unfold hd.
- unfold nth.
- reflexivity.
+ unfold hd, nth, tail, jump.
+ destruct p; f_equal; now rewrite Pos.add_diag.
Qed.
-
- Lemma nth_jump : forall p l x, nth p (tail l) = hd x (jump p l).
+ Lemma nth_jump p l : nth p (tail l) = hd (jump p l).
Proof.
- unfold tail.
- unfold hd.
- unfold jump.
- unfold nth.
- intros.
- rewrite Pplus_comm.
- reflexivity.
+ unfold hd, nth, tail, jump. f_equal. apply Pos.add_comm.
Qed.
- Lemma nth_Pdouble_minus_one :
- forall p l, nth (Pdouble_minus_one p) (tail l) = nth p (jump p l).
+ Lemma nth_pred_double p l :
+ nth (Pos.pred_double p) (tail l) = nth p (jump p l).
Proof.
- intros.
- unfold tail.
- unfold nth, jump.
- rewrite Pplus_diag.
- rewrite <- Psucc_o_double_minus_one_eq_xO.
- rewrite Pplus_one_succ_r.
- reflexivity.
+ unfold nth, tail, jump. f_equal.
+ now rewrite Pos.add_1_r, Pos.succ_pred_double, Pos.add_diag.
Qed.
End S.
+Ltac jump_simpl :=
+ repeat
+ match goal with
+ | |- appcontext [jump xH] => rewrite (jump_simpl xH)
+ | |- appcontext [jump (xO ?p)] => rewrite (jump_simpl (xO p))
+ | |- appcontext [jump (xI ?p)] => rewrite (jump_simpl (xI p))
+ end.
diff --git a/plugins/micromega/EnvRing.v b/plugins/micromega/EnvRing.v
index 309ebdef..786c3393 100644
--- a/plugins/micromega/EnvRing.v
+++ b/plugins/micromega/EnvRing.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -11,15 +11,10 @@
Set Implicit Arguments.
-Require Import Setoid.
-Require Import BinList.
-Require Import Env.
-Require Import BinPos.
-Require Import BinNat.
-Require Import BinInt.
+Require Import Setoid Morphisms Env BinPos BinNat BinInt.
Require Export Ring_theory.
-Open Local Scope positive_scope.
+Local Open Scope positive_scope.
Import RingSyntax.
Section MakeRingPol.
@@ -30,7 +25,7 @@ Section MakeRingPol.
Variable req : R -> R -> Prop.
(* Ring properties *)
- Variable Rsth : Setoid_Theory R req.
+ Variable Rsth : Equivalence req.
Variable Reqe : ring_eq_ext radd rmul ropp req.
Variable ARth : almost_ring_theory rO rI radd rmul rsub ropp req.
@@ -42,35 +37,55 @@ Section MakeRingPol.
Variable CRmorph : ring_morph rO rI radd rmul rsub ropp req
cO cI cadd cmul csub copp ceqb phi.
- (* Power coefficients *)
+ (* Power coefficients *)
Variable Cpow : Type.
Variable Cp_phi : N -> Cpow.
Variable rpow : R -> Cpow -> R.
Variable pow_th : power_theory rI rmul req Cp_phi rpow.
-
(* R notations *)
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).
+ Infix "+" := radd. Infix "*" := rmul.
+ Infix "-" := rsub. Notation "- x" := (ropp x).
+ Infix "==" := req.
+ Infix "^" := (pow_pos rmul).
(* C notations *)
- Notation "x +! y" := (cadd x y). Notation "x *! y " := (cmul x y).
- Notation "x -! y " := (csub x y). Notation "-! x" := (copp x).
- Notation " x ?=! y" := (ceqb x y). Notation "[ x ]" := (phi x).
-
- (* Usefull tactics *)
- Add Setoid R req Rsth as R_set1.
- Ltac rrefl := gen_reflexivity Rsth.
- Add Morphism radd : radd_ext. exact (Radd_ext Reqe). Qed.
- Add Morphism rmul : rmul_ext. exact (Rmul_ext Reqe). Qed.
- Add Morphism ropp : ropp_ext. exact (Ropp_ext Reqe). Qed.
- Add Morphism rsub : rsub_ext. exact (ARsub_ext Rsth Reqe ARth). Qed.
+ Infix "+!" := cadd. Infix "*!" := cmul.
+ Infix "-! " := csub. Notation "-! x" := (copp x).
+ Infix "?=!" := ceqb. Notation "[ x ]" := (phi x).
+
+ (* Useful tactics *)
+ Add Morphism radd : radd_ext. exact (Radd_ext Reqe). Qed.
+ Add Morphism rmul : rmul_ext. exact (Rmul_ext Reqe). Qed.
+ Add Morphism ropp : ropp_ext. exact (Ropp_ext Reqe). Qed.
+ Add Morphism rsub : rsub_ext. exact (ARsub_ext Rsth Reqe ARth). Qed.
Ltac rsimpl := gen_srewrite Rsth Reqe ARth.
+
Ltac add_push := gen_add_push radd Rsth Reqe ARth.
Ltac mul_push := gen_mul_push rmul Rsth Reqe ARth.
+ Ltac add_permut_rec t :=
+ match t with
+ | ?x + ?y => add_permut_rec y || add_permut_rec x
+ | _ => add_push t; apply (Radd_ext Reqe); [|reflexivity]
+ end.
+
+ Ltac add_permut :=
+ repeat (reflexivity ||
+ match goal with |- ?t == _ => add_permut_rec t end).
+
+ Ltac mul_permut_rec t :=
+ match t with
+ | ?x * ?y => mul_permut_rec y || mul_permut_rec x
+ | _ => mul_push t; apply (Rmul_ext Reqe); [|reflexivity]
+ end.
+
+ Ltac mul_permut :=
+ repeat (reflexivity ||
+ match goal with |- ?t == _ => mul_permut_rec t end).
+
+
(* Definition of multivariable polynomials with coefficients in C :
Type [Pol] represents [X1 ... Xn].
The representation is Horner's where a [n] variable polynomial
@@ -117,19 +132,19 @@ Section MakeRingPol.
| _, _ => false
end.
- Notation " P ?== P' " := (Peq P P').
+ Infix "?==" := Peq.
Definition mkPinj j P :=
match P with
| Pc _ => P
- | Pinj j' Q => Pinj ((j + j'):positive) Q
+ | Pinj j' Q => Pinj (j + j') Q
| _ => Pinj j P
end.
Definition mkPinj_pred j P:=
match j with
| xH => P
- | xO j => Pinj (Pdouble_minus_one j) P
+ | xO j => Pinj (Pos.pred_double j) P
| xI j => Pinj (xO j) P
end.
@@ -157,14 +172,14 @@ Section MakeRingPol.
(** Addition et subtraction *)
- Fixpoint PaddC (P:Pol) (c:C) {struct P} : Pol :=
+ Fixpoint PaddC (P:Pol) (c:C) : Pol :=
match P with
| Pc c1 => Pc (c1 +! c)
| Pinj j Q => Pinj j (PaddC Q c)
| PX P i Q => PX P i (PaddC Q c)
end.
- Fixpoint PsubC (P:Pol) (c:C) {struct P} : Pol :=
+ Fixpoint PsubC (P:Pol) (c:C) : Pol :=
match P with
| Pc c1 => Pc (c1 -! c)
| Pinj j Q => Pinj j (PsubC Q c)
@@ -176,11 +191,11 @@ Section MakeRingPol.
Variable Pop : Pol -> Pol -> Pol.
Variable Q : Pol.
- Fixpoint PaddI (j:positive) (P:Pol){struct P} : Pol :=
+ Fixpoint PaddI (j:positive) (P:Pol) : Pol :=
match P with
| Pc c => mkPinj j (PaddC Q c)
| Pinj j' Q' =>
- match ZPminus j' j with
+ match Z.pos_sub j' j with
| Zpos k => mkPinj j (Pop (Pinj k Q') Q)
| Z0 => mkPinj j (Pop Q' Q)
| Zneg k => mkPinj j' (PaddI k Q')
@@ -188,16 +203,16 @@ Section MakeRingPol.
| PX P i Q' =>
match j with
| xH => PX P i (Pop Q' Q)
- | xO j => PX P i (PaddI (Pdouble_minus_one j) Q')
+ | xO j => PX P i (PaddI (Pos.pred_double j) Q')
| xI j => PX P i (PaddI (xO j) Q')
end
end.
- Fixpoint PsubI (j:positive) (P:Pol){struct P} : Pol :=
+ Fixpoint PsubI (j:positive) (P:Pol) : Pol :=
match P with
| Pc c => mkPinj j (PaddC (--Q) c)
| Pinj j' Q' =>
- match ZPminus j' j with
+ match Z.pos_sub j' j with
| Zpos k => mkPinj j (Pop (Pinj k Q') Q)
| Z0 => mkPinj j (Pop Q' Q)
| Zneg k => mkPinj j' (PsubI k Q')
@@ -205,41 +220,41 @@ Section MakeRingPol.
| PX P i Q' =>
match j with
| xH => PX P i (Pop Q' Q)
- | xO j => PX P i (PsubI (Pdouble_minus_one j) Q')
+ | xO j => PX P i (PsubI (Pos.pred_double j) Q')
| xI j => PX P i (PsubI (xO j) Q')
end
end.
Variable P' : Pol.
- Fixpoint PaddX (i':positive) (P:Pol) {struct P} : Pol :=
+ Fixpoint PaddX (i':positive) (P:Pol) : Pol :=
match P with
| Pc c => PX P' i' P
| Pinj j Q' =>
match j with
| xH => PX P' i' Q'
- | xO j => PX P' i' (Pinj (Pdouble_minus_one j) Q')
+ | xO j => PX P' i' (Pinj (Pos.pred_double j) Q')
| xI j => PX P' i' (Pinj (xO j) Q')
end
| PX P i Q' =>
- match ZPminus i i' with
+ match Z.pos_sub i i' with
| Zpos k => mkPX (Pop (PX P k P0) P') i' Q'
| Z0 => mkPX (Pop P P') i Q'
| Zneg k => mkPX (PaddX k P) i Q'
end
end.
- Fixpoint PsubX (i':positive) (P:Pol) {struct P} : Pol :=
+ Fixpoint PsubX (i':positive) (P:Pol) : Pol :=
match P with
| Pc c => PX (--P') i' P
| Pinj j Q' =>
match j with
| xH => PX (--P') i' Q'
- | xO j => PX (--P') i' (Pinj (Pdouble_minus_one j) Q')
+ | xO j => PX (--P') i' (Pinj (Pos.pred_double j) Q')
| xI j => PX (--P') i' (Pinj (xO j) Q')
end
| PX P i Q' =>
- match ZPminus i i' with
+ match Z.pos_sub i i' with
| Zpos k => mkPX (Pop (PX P k P0) P') i' Q'
| Z0 => mkPX (Pop P P') i Q'
| Zneg k => mkPX (PsubX k P) i Q'
@@ -259,18 +274,18 @@ Section MakeRingPol.
| Pinj j Q =>
match j with
| xH => PX P' i' (Padd Q Q')
- | xO j => PX P' i' (Padd (Pinj (Pdouble_minus_one j) Q) Q')
+ | xO j => PX P' i' (Padd (Pinj (Pos.pred_double j) Q) Q')
| xI j => PX P' i' (Padd (Pinj (xO j) Q) Q')
end
| PX P i Q =>
- match ZPminus i i' with
+ match Z.pos_sub i i' with
| Zpos k => mkPX (Padd (PX P k P0) P') i' (Padd Q Q')
| Z0 => mkPX (Padd P P') i (Padd Q Q')
| Zneg k => mkPX (PaddX Padd P' k P) i (Padd Q Q')
end
end
end.
- Notation "P ++ P'" := (Padd P P').
+ Infix "++" := Padd.
Fixpoint Psub (P P': Pol) {struct P'} : Pol :=
match P' with
@@ -282,22 +297,22 @@ Section MakeRingPol.
| Pinj j Q =>
match j with
| xH => PX (--P') i' (Psub Q Q')
- | xO j => PX (--P') i' (Psub (Pinj (Pdouble_minus_one j) Q) Q')
+ | xO j => PX (--P') i' (Psub (Pinj (Pos.pred_double j) Q) Q')
| xI j => PX (--P') i' (Psub (Pinj (xO j) Q) Q')
end
| PX P i Q =>
- match ZPminus i i' with
+ match Z.pos_sub i i' with
| Zpos k => mkPX (Psub (PX P k P0) P') i' (Psub Q Q')
| Z0 => mkPX (Psub P P') i (Psub Q Q')
| Zneg k => mkPX (PsubX Psub P' k P) i (Psub Q Q')
end
end
end.
- Notation "P -- P'" := (Psub P P').
+ Infix "--" := Psub.
(** Multiplication *)
- Fixpoint PmulC_aux (P:Pol) (c:C) {struct P} : Pol :=
+ Fixpoint PmulC_aux (P:Pol) (c:C) : Pol :=
match P with
| Pc c' => Pc (c' *! c)
| Pinj j Q => mkPinj j (PmulC_aux Q c)
@@ -311,11 +326,11 @@ Section MakeRingPol.
Section PmulI.
Variable Pmul : Pol -> Pol -> Pol.
Variable Q : Pol.
- Fixpoint PmulI (j:positive) (P:Pol) {struct P} : Pol :=
+ Fixpoint PmulI (j:positive) (P:Pol) : Pol :=
match P with
| Pc c => mkPinj j (PmulC Q c)
| Pinj j' Q' =>
- match ZPminus j' j with
+ match Z.pos_sub j' j with
| Zpos k => mkPinj j (Pmul (Pinj k Q') Q)
| Z0 => mkPinj j (Pmul Q' Q)
| Zneg k => mkPinj j' (PmulI k Q')
@@ -323,13 +338,12 @@ Section MakeRingPol.
| PX P' i' Q' =>
match j with
| xH => mkPX (PmulI xH P') i' (Pmul Q' Q)
- | xO j' => mkPX (PmulI j P') i' (PmulI (Pdouble_minus_one j') Q')
+ | xO j' => mkPX (PmulI j P') i' (PmulI (Pos.pred_double j') Q')
| xI j' => mkPX (PmulI j P') i' (PmulI (xO j') Q')
end
end.
End PmulI.
-(* A symmetric version of the multiplication *)
Fixpoint Pmul (P P'' : Pol) {struct P''} : Pol :=
match P'' with
@@ -342,7 +356,7 @@ Section MakeRingPol.
let QQ' :=
match j with
| xH => Pmul Q Q'
- | xO j => Pmul (Pinj (Pdouble_minus_one j) Q) Q'
+ | xO j => Pmul (Pinj (Pos.pred_double j) Q) Q'
| xI j => Pmul (Pinj (xO j) Q) Q'
end in
mkPX (Pmul P P') i' QQ'
@@ -355,25 +369,7 @@ Section MakeRingPol.
end
end.
-(* Non symmetric *)
-(*
- Fixpoint Pmul_aux (P P' : Pol) {struct P'} : Pol :=
- match P' with
- | Pc c' => PmulC P c'
- | Pinj j' Q' => PmulI Pmul_aux Q' j' P
- | PX P' i' Q' =>
- (mkPX (Pmul_aux P P') i' P0) ++ (PmulI Pmul_aux Q' xH P)
- end.
-
- Definition Pmul P P' :=
- match P with
- | Pc c => PmulC P' c
- | Pinj j Q => PmulI Pmul_aux Q j P'
- | PX P i Q =>
- (mkPX (Pmul_aux P P') i P0) ++ (PmulI Pmul_aux Q xH P')
- end.
-*)
- Notation "P ** P'" := (Pmul P P').
+ Infix "**" := Pmul.
Fixpoint Psquare (P:Pol) : Pol :=
match P with
@@ -388,26 +384,26 @@ Section MakeRingPol.
(** Monomial **)
+ (** A monomial is X1^k1...Xi^ki. Its representation
+ is a simplified version of the polynomial representation:
+
+ - [mon0] correspond to the polynom [P1].
+ - [(zmon j M)] corresponds to [(Pinj j ...)],
+ i.e. skip j variable indices.
+ - [(vmon i M)] is X^i*M with X the current variable,
+ its corresponds to (PX P1 i ...)]
+ *)
+
Inductive Mon: Set :=
- mon0: Mon
+ | mon0: Mon
| zmon: positive -> Mon -> Mon
| vmon: positive -> Mon -> Mon.
- Fixpoint Mphi(l:Env R) (M: Mon) {struct M} : R :=
- match M with
- mon0 => rI
- | zmon j M1 => Mphi (jump j l) M1
- | vmon i M1 =>
- let x := hd 0 l in
- let xi := pow_pos rmul x i in
- (Mphi (tail l) M1) * xi
- end.
-
Definition mkZmon j M :=
match M with mon0 => mon0 | _ => zmon j M end.
Definition zmon_pred j M :=
- match j with xH => M | _ => mkZmon (Ppred j) M end.
+ match j with xH => M | _ => mkZmon (Pos.pred j) M end.
Definition mkVmon i M :=
match M with
@@ -416,7 +412,7 @@ Section MakeRingPol.
| vmon i' m => vmon (i+i') m
end.
- Fixpoint MFactor (P: Pol) (M: Mon) {struct P}: Pol * Pol :=
+ Fixpoint MFactor (P: Pol) (M: Mon) : Pol * Pol :=
match P, M with
_, mon0 => (Pc cO, P)
| Pc _, _ => (P, Pc cO)
@@ -453,7 +449,7 @@ Section MakeRingPol.
| _ => Some (Padd Q1 (Pmul P2 R1))
end.
- Fixpoint PNSubst1 (P1: Pol) (M1: Mon) (P2: Pol) (n: nat) {struct n}: Pol :=
+ Fixpoint PNSubst1 (P1: Pol) (M1: Mon) (P2: Pol) (n: nat) : Pol :=
match POneSubst P1 M1 P2 with
Some P3 => match n with S n1 => PNSubst1 P3 M1 P2 n1 | _ => P3 end
| _ => P1
@@ -465,14 +461,13 @@ Section MakeRingPol.
| _ => None
end.
- Fixpoint PSubstL1 (P1: Pol) (LM1: list (Mon * Pol)) (n: nat) {struct LM1}:
- Pol :=
+ Fixpoint PSubstL1 (P1: Pol) (LM1: list (Mon * Pol)) (n: nat) : Pol :=
match LM1 with
cons (M1,P2) LM2 => PSubstL1 (PNSubst1 P1 M1 P2 n) LM2 n
| _ => P1
end.
- Fixpoint PSubstL (P1: Pol) (LM1: list (Mon * Pol)) (n: nat) {struct LM1}: option Pol :=
+ Fixpoint PSubstL (P1: Pol) (LM1: list (Mon * Pol)) (n: nat) : option Pol :=
match LM1 with
cons (M1,P2) LM2 =>
match PNSubst P1 M1 P2 n with
@@ -482,7 +477,7 @@ Section MakeRingPol.
| _ => None
end.
- Fixpoint PNSubstL (P1: Pol) (LM1: list (Mon * Pol)) (m n: nat) {struct m}: Pol :=
+ Fixpoint PNSubstL (P1: Pol) (LM1: list (Mon * Pol)) (m n: nat) : Pol :=
match PSubstL P1 LM1 n with
Some P3 => match m with S m1 => PNSubstL P3 LM1 m1 n | _ => P3 end
| _ => P1
@@ -490,726 +485,446 @@ Section MakeRingPol.
(** Evaluation of a polynomial towards R *)
- Fixpoint Pphi(l:Env R) (P:Pol) {struct P} : R :=
+ Fixpoint Pphi(l:Env R) (P:Pol) : R :=
match P with
| Pc c => [c]
| Pinj j Q => Pphi (jump j l) Q
- | PX P i Q =>
- let x := hd 0 l in
- let xi := pow_pos rmul x i in
- (Pphi l P) * xi + (Pphi (tail l) Q)
+ | PX P i Q => Pphi l P * (hd l) ^ i + Pphi (tail l) Q
end.
Reserved Notation "P @ l " (at level 10, no associativity).
Notation "P @ l " := (Pphi l P).
+
+ (** Evaluation of a monomial towards R *)
+
+ Fixpoint Mphi(l:Env R) (M: Mon) : R :=
+ match M with
+ | mon0 => rI
+ | zmon j M1 => Mphi (jump j l) M1
+ | vmon i M1 => Mphi (tail l) M1 * (hd l) ^ i
+ end.
+
+ Notation "M @@ l" := (Mphi l M) (at level 10, no associativity).
+
(** Proofs *)
- Lemma ZPminus_spec : forall x y,
- match ZPminus x y with
- | Z0 => x = y
- | Zpos k => x = (y + k)%positive
- | Zneg k => y = (x + k)%positive
+
+ Ltac destr_pos_sub :=
+ match goal with |- context [Z.pos_sub ?x ?y] =>
+ generalize (Z.pos_sub_discr x y); destruct (Z.pos_sub x y)
end.
+
+ Lemma Peq_ok P P' : (P ?== P') = true -> forall l, P@l == P'@ l.
Proof.
- induction x;destruct y.
- replace (ZPminus (xI x) (xI y)) with (Zdouble (ZPminus x y));trivial.
- assert (H := IHx y);destruct (ZPminus x y);unfold Zdouble;rewrite H;trivial.
- replace (ZPminus (xI x) (xO y)) with (Zdouble_plus_one (ZPminus x y));trivial.
- assert (H := IHx y);destruct (ZPminus x y);unfold Zdouble_plus_one;rewrite H;trivial.
- apply Pplus_xI_double_minus_one.
- simpl;trivial.
- replace (ZPminus (xO x) (xI y)) with (Zdouble_minus_one (ZPminus x y));trivial.
- assert (H := IHx y);destruct (ZPminus x y);unfold Zdouble_minus_one;rewrite H;trivial.
- apply Pplus_xI_double_minus_one.
- replace (ZPminus (xO x) (xO y)) with (Zdouble (ZPminus x y));trivial.
- assert (H := IHx y);destruct (ZPminus x y);unfold Zdouble;rewrite H;trivial.
- replace (ZPminus (xO x) xH) with (Zpos (Pdouble_minus_one x));trivial.
- rewrite <- Pplus_one_succ_l.
- rewrite Psucc_o_double_minus_one_eq_xO;trivial.
- replace (ZPminus xH (xI y)) with (Zneg (xO y));trivial.
- replace (ZPminus xH (xO y)) with (Zneg (Pdouble_minus_one y));trivial.
- rewrite <- Pplus_one_succ_l.
- rewrite Psucc_o_double_minus_one_eq_xO;trivial.
- simpl;trivial.
+ revert P';induction P;destruct P';simpl; intros H l; try easy.
+ - now apply (morph_eq CRmorph).
+ - destruct (Pos.compare_spec p p0); [ subst | easy | easy ].
+ now rewrite IHP.
+ - specialize (IHP1 P'1); specialize (IHP2 P'2).
+ destruct (Pos.compare_spec p p0); [ subst | easy | easy ].
+ destruct (P2 ?== P'1); [|easy].
+ rewrite H in *.
+ now rewrite IHP1, IHP2.
Qed.
- Lemma Peq_ok : forall P P',
- (P ?== P') = true -> forall l, P@l == P'@ l.
+ Lemma Peq_spec P P' :
+ BoolSpec (forall l, P@l == P'@l) True (P ?== P').
Proof.
- induction P;destruct P';simpl;intros;try discriminate;trivial.
- apply (morph_eq CRmorph);trivial.
- assert (H1 := Pos.compare_eq p p0); destruct (p ?= p0);
- try discriminate H.
- rewrite (IHP P' H); rewrite H1;trivial;rrefl.
- assert (H1 := Pos.compare_eq p p0); destruct (p ?= p0);
- try discriminate H.
- rewrite H1;trivial. clear H1.
- assert (H1 := IHP1 P'1);assert (H2 := IHP2 P'2);
- destruct (P2 ?== P'1);[destruct (P3 ?== P'2); [idtac|discriminate H]
- |discriminate H].
- rewrite (H1 H);rewrite (H2 H);rrefl.
+ generalize (Peq_ok P P'). destruct (P ?== P'); auto.
Qed.
- Lemma Pphi0 : forall l, P0@l == 0.
+ Lemma Pphi0 l : P0@l == 0.
Proof.
- intros;simpl;apply (morph0 CRmorph).
+ simpl;apply (morph0 CRmorph).
Qed.
-Lemma env_morph : forall p e1 e2, (forall x, e1 x = e2 x) ->
- p @ e1 = p @ e2.
+ Lemma Pphi1 l : P1@l == 1.
+ Proof.
+ simpl;apply (morph1 CRmorph).
+ Qed.
+
+Lemma env_morph p e1 e2 :
+ (forall x, e1 x = e2 x) -> p @ e1 = p @ e2.
Proof.
- induction p ; simpl.
- reflexivity.
- intros.
- apply IHp.
- intros.
- unfold jump.
- apply H.
- intros.
- rewrite (IHp1 e1 e2) ; auto.
- rewrite (IHp2 (tail e1) (tail e2)) ; auto.
- unfold hd. unfold nth. rewrite H. reflexivity.
- unfold tail. unfold jump. intros ; apply H.
+ revert e1 e2. induction p ; simpl.
+ - reflexivity.
+ - intros e1 e2 EQ. apply IHp. intros. apply EQ.
+ - intros e1 e2 EQ. f_equal; [f_equal|].
+ + now apply IHp1.
+ + f_equal. apply EQ.
+ + apply IHp2. intros; apply EQ.
Qed.
-Lemma Pjump_Pplus : forall P i j l, P @ (jump (i + j) l ) = P @ (jump j (jump i l)).
+Lemma Pjump_add P i j l :
+ P @ (jump (i + j) l) = P @ (jump j (jump i l)).
Proof.
- intros. apply env_morph. intros. rewrite <- jump_Pplus.
- rewrite Pplus_comm.
- reflexivity.
+ apply env_morph. intros. rewrite <- jump_add. f_equal.
+ apply Pos.add_comm.
Qed.
-Lemma Pjump_xO_tail : forall P p l,
+Lemma Pjump_xO_tail P p l :
P @ (jump (xO p) (tail l)) = P @ (jump (xI p) l).
Proof.
- intros.
- apply env_morph.
- intros.
- rewrite (@jump_simpl R (xI p)).
- rewrite (@jump_simpl R (xO p)).
- reflexivity.
+ apply env_morph. intros. now jump_simpl.
Qed.
-Lemma Pjump_Pdouble_minus_one : forall P p l,
- P @ (jump (Pdouble_minus_one p) (tail l)) = P @ (jump (xO p) l).
+Lemma Pjump_pred_double P p l :
+ P @ (jump (Pos.pred_double p) (tail l)) = P @ (jump (xO p) l).
Proof.
- intros.
- apply env_morph.
- intros.
- rewrite jump_Pdouble_minus_one.
- rewrite (@jump_simpl R (xO p)).
- reflexivity.
+ apply env_morph. intros.
+ rewrite jump_pred_double. now jump_simpl.
Qed.
-
-
- Lemma Pphi1 : forall l, P1@l == 1.
+ Lemma mkPinj_ok j l P : (mkPinj j P)@l == P@(jump j l).
Proof.
- intros;simpl;apply (morph1 CRmorph).
+ destruct P;simpl;rsimpl.
+ now rewrite Pjump_add.
Qed.
- Lemma mkPinj_ok : forall j l P, (mkPinj j P)@l == P@(jump j l).
+ Lemma pow_pos_add x i j : x^(j + i) == x^i * x^j.
Proof.
- intros j l p;destruct p;simpl;rsimpl.
- rewrite Pjump_Pplus.
- reflexivity.
+ rewrite Pos.add_comm.
+ apply (pow_pos_add Rsth Reqe.(Rmul_ext) ARth.(ARmul_assoc)).
Qed.
- Let pow_pos_Pplus :=
- pow_pos_Pplus rmul Rsth Reqe.(Rmul_ext) ARth.(ARmul_comm) ARth.(ARmul_assoc).
-
- Lemma mkPX_ok : forall l P i Q,
- (mkPX P i Q)@l == P@l*(pow_pos rmul (hd 0 l) i) + Q@(tail l).
+ Lemma ceqb_spec c c' : BoolSpec ([c] == [c']) True (c ?=! c').
Proof.
- intros l P i Q;unfold mkPX.
- destruct P;try (simpl;rrefl).
- assert (H := morph_eq CRmorph c cO);destruct (c ?=! cO);simpl;try rrefl.
- rewrite (H (refl_equal true));rewrite (morph0 CRmorph).
- rewrite mkPinj_ok;rsimpl;simpl;rrefl.
- assert (H := @Peq_ok P3 P0);destruct (P3 ?== P0);simpl;try rrefl.
- rewrite (H (refl_equal true));trivial.
- rewrite Pphi0. rewrite pow_pos_Pplus;rsimpl.
+ generalize (morph_eq CRmorph c c').
+ destruct (c ?=! c'); auto.
Qed.
-
- Ltac Esimpl :=
- repeat (progress (
- match goal with
- | |- context [P0@?l] => rewrite (Pphi0 l)
- | |- context [P1@?l] => rewrite (Pphi1 l)
- | |- context [(mkPinj ?j ?P)@?l] => rewrite (mkPinj_ok j l P)
- | |- context [(mkPX ?P ?i ?Q)@?l] => rewrite (mkPX_ok l P i Q)
- | |- context [[cO]] => rewrite (morph0 CRmorph)
- | |- context [[cI]] => rewrite (morph1 CRmorph)
- | |- context [[?x +! ?y]] => rewrite ((morph_add CRmorph) x y)
- | |- context [[?x *! ?y]] => rewrite ((morph_mul CRmorph) x y)
- | |- context [[?x -! ?y]] => rewrite ((morph_sub CRmorph) x y)
- | |- context [[-! ?x]] => rewrite ((morph_opp CRmorph) x)
- end));
- rsimpl; simpl.
-
- Lemma PaddC_ok : forall c P l, (PaddC P c)@l == P@l + [c].
+ Lemma mkPX_ok l P i Q :
+ (mkPX P i Q)@l == P@l * (hd l)^i + Q@(tail l).
Proof.
- induction P;simpl;intros;Esimpl;trivial.
- rewrite IHP2;rsimpl.
+ unfold mkPX. destruct P.
+ - case ceqb_spec; intros H; simpl; try reflexivity.
+ rewrite H, (morph0 CRmorph), mkPinj_ok; rsimpl.
+ - reflexivity.
+ - case Peq_spec; intros H; simpl; try reflexivity.
+ rewrite H, Pphi0, Pos.add_comm, pow_pos_add; rsimpl.
Qed.
- Lemma PsubC_ok : forall c P l, (PsubC P c)@l == P@l - [c].
+ Hint Rewrite
+ Pphi0
+ Pphi1
+ mkPinj_ok
+ mkPX_ok
+ (morph0 CRmorph)
+ (morph1 CRmorph)
+ (morph0 CRmorph)
+ (morph_add CRmorph)
+ (morph_mul CRmorph)
+ (morph_sub CRmorph)
+ (morph_opp CRmorph)
+ : Esimpl.
+
+ (* Quicker than autorewrite with Esimpl :-) *)
+ Ltac Esimpl := try rewrite_db Esimpl; rsimpl; simpl.
+
+ Lemma PaddC_ok c P l : (PaddC P c)@l == P@l + [c].
Proof.
- induction P;simpl;intros.
- Esimpl.
- rewrite IHP;rsimpl.
+ revert l;induction P;simpl;intros;Esimpl;trivial.
rewrite IHP2;rsimpl.
Qed.
- Lemma PmulC_aux_ok : forall c P l, (PmulC_aux P c)@l == P@l * [c].
+ Lemma PsubC_ok c P l : (PsubC P c)@l == P@l - [c].
Proof.
- induction P;simpl;intros;Esimpl;trivial.
- rewrite IHP1;rewrite IHP2;rsimpl.
- mul_push ([c]);rrefl.
+ revert l;induction P;simpl;intros.
+ - Esimpl.
+ - rewrite IHP;rsimpl.
+ - rewrite IHP2;rsimpl.
Qed.
- Lemma PmulC_ok : forall c P l, (PmulC P c)@l == P@l * [c].
+ Lemma PmulC_aux_ok c P l : (PmulC_aux P c)@l == P@l * [c].
Proof.
- intros c P l; unfold PmulC.
- assert (H:= morph_eq CRmorph c cO);destruct (c ?=! cO).
- rewrite (H (refl_equal true));Esimpl.
- assert (H1:= morph_eq CRmorph c cI);destruct (c ?=! cI).
- rewrite (H1 (refl_equal true));Esimpl.
- apply PmulC_aux_ok.
+ revert l;induction P;simpl;intros;Esimpl;trivial.
+ rewrite IHP1, IHP2;rsimpl. add_permut. mul_permut.
Qed.
- Lemma Popp_ok : forall P l, (--P)@l == - P@l.
+ Lemma PmulC_ok c P l : (PmulC P c)@l == P@l * [c].
Proof.
- induction P;simpl;intros.
- Esimpl.
- apply IHP.
- rewrite IHP1;rewrite IHP2;rsimpl.
+ unfold PmulC.
+ case ceqb_spec; intros H.
+ - rewrite H; Esimpl.
+ - case ceqb_spec; intros H'.
+ + rewrite H'; Esimpl.
+ + apply PmulC_aux_ok.
Qed.
- Ltac Esimpl2 :=
- Esimpl;
- repeat (progress (
- match goal with
- | |- context [(PaddC ?P ?c)@?l] => rewrite (PaddC_ok c P l)
- | |- context [(PsubC ?P ?c)@?l] => rewrite (PsubC_ok c P l)
- | |- context [(PmulC ?P ?c)@?l] => rewrite (PmulC_ok c P l)
- | |- context [(--?P)@?l] => rewrite (Popp_ok P l)
- end)); Esimpl.
-
-
-
-
- Lemma Padd_ok : forall P' P l, (P ++ P')@l == P@l + P'@l.
+ Lemma Popp_ok P l : (--P)@l == - P@l.
Proof.
- induction P';simpl;intros;Esimpl2.
- generalize P p l;clear P p l.
- induction P;simpl;intros.
- Esimpl2;apply (ARadd_comm ARth).
- assert (H := ZPminus_spec p p0);destruct (ZPminus p p0).
- rewrite H;Esimpl. rewrite IHP';rrefl.
- rewrite H;Esimpl. rewrite IHP';Esimpl.
- rewrite Pjump_Pplus. rrefl.
- rewrite H;Esimpl. rewrite IHP.
- rewrite Pjump_Pplus. rrefl.
- destruct p0;simpl.
- rewrite IHP2;simpl. rsimpl.
- rewrite Pjump_xO_tail. Esimpl.
- rewrite IHP2;simpl.
- rewrite Pjump_Pdouble_minus_one.
- rsimpl.
- rewrite IHP'.
- rsimpl.
- destruct P;simpl.
- Esimpl2;add_push [c];rrefl.
- destruct p0;simpl;Esimpl2.
- rewrite IHP'2;simpl.
- rewrite Pjump_xO_tail.
- rsimpl;add_push (P'1@l * (pow_pos rmul (hd 0 l) p));rrefl.
- rewrite IHP'2;simpl.
- rewrite Pjump_Pdouble_minus_one. rsimpl.
- add_push (P'1@l * (pow_pos rmul (hd 0 l) p));rrefl.
- rewrite IHP'2;rsimpl.
- unfold tail.
- add_push (P @ (jump 1 l));rrefl.
- assert (H := ZPminus_spec p0 p);destruct (ZPminus p0 p);Esimpl2.
- rewrite IHP'1;rewrite IHP'2;rsimpl.
- add_push (P3 @ (tail l));rewrite H;rrefl.
- rewrite IHP'1;rewrite IHP'2;simpl;Esimpl.
- rewrite H;rewrite Pplus_comm.
- rewrite pow_pos_Pplus;rsimpl.
- add_push (P3 @ (tail l));rrefl.
- assert (forall P k l,
- (PaddX Padd P'1 k P) @ l == P@l + P'1@l * pow_pos rmul (hd 0 l) k).
- induction P;simpl;intros;try apply (ARadd_comm ARth).
- destruct p2; simpl; try apply (ARadd_comm ARth).
- rewrite Pjump_xO_tail.
- apply (ARadd_comm ARth).
- rewrite Pjump_Pdouble_minus_one.
- apply (ARadd_comm ARth).
- assert (H1 := ZPminus_spec p2 k);destruct (ZPminus p2 k);Esimpl2.
- rewrite IHP'1;rsimpl; rewrite H1;add_push (P5 @ (tail l0));rrefl.
- rewrite IHP'1;simpl;Esimpl.
- rewrite H1;rewrite Pplus_comm.
- rewrite pow_pos_Pplus;simpl;Esimpl.
- add_push (P5 @ (tail l0));rrefl.
- rewrite IHP1;rewrite H1;rewrite Pplus_comm.
- rewrite pow_pos_Pplus;simpl;rsimpl.
- add_push (P5 @ (tail l0));rrefl.
- rewrite H0;rsimpl.
- add_push (P3 @ (tail l)).
- rewrite H;rewrite Pplus_comm.
- rewrite IHP'2;rewrite pow_pos_Pplus;rsimpl.
- add_push (P3 @ (tail l));rrefl.
+ revert l;induction P;simpl;intros.
+ - Esimpl.
+ - apply IHP.
+ - rewrite IHP1, IHP2;rsimpl.
Qed.
- Lemma Psub_ok : forall P' P l, (P -- P')@l == P@l - P'@l.
+ Hint Rewrite PaddC_ok PsubC_ok PmulC_ok Popp_ok : Esimpl.
+
+ Lemma PaddX_ok P' P k l :
+ (forall P l, (P++P')@l == P@l + P'@l) ->
+ (PaddX Padd P' k P) @ l == P@l + P'@l * (hd l)^k.
Proof.
- induction P';simpl;intros;Esimpl2;trivial.
- generalize P p l;clear P p l.
- induction P;simpl;intros.
- Esimpl2;apply (ARadd_comm ARth).
- assert (H := ZPminus_spec p p0);destruct (ZPminus p p0).
- rewrite H;Esimpl. rewrite IHP';rsimpl.
- rewrite H;Esimpl. rewrite IHP';Esimpl.
- rewrite <- Pjump_Pplus;rewrite Pplus_comm;rrefl.
- rewrite H;Esimpl. rewrite IHP.
- rewrite <- Pjump_Pplus;rewrite Pplus_comm;rrefl.
- destruct p0;simpl.
- rewrite IHP2;simpl; try rewrite Pjump_xO_tail ; rsimpl.
- rewrite IHP2;simpl.
- rewrite Pjump_Pdouble_minus_one;rsimpl.
- unfold tail ; rsimpl.
- rewrite IHP';rsimpl.
- destruct P;simpl.
- 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_pos rmul (hd 0 l) p));trivial.
- rewrite Pjump_xO_tail.
- add_push (P @ ((jump (xI p0) l)));rrefl.
- rewrite IHP'2;simpl;rewrite Pjump_Pdouble_minus_one;rsimpl.
- add_push (- (P'1 @ l * pow_pos rmul (hd 0 l) p));rrefl.
- unfold tail.
- rewrite IHP'2;rsimpl;add_push (P @ (jump 1 l));rrefl.
- assert (H := ZPminus_spec p0 p);destruct (ZPminus p0 p);Esimpl2.
- rewrite IHP'1; rewrite IHP'2;rsimpl.
- add_push (P3 @ (tail l));rewrite H;rrefl.
- rewrite IHP'1; rewrite IHP'2;rsimpl;simpl;Esimpl.
- rewrite H;rewrite Pplus_comm.
- rewrite pow_pos_Pplus;rsimpl.
- add_push (P3 @ (tail l));rrefl.
- assert (forall P k l,
- (PsubX Psub P'1 k P) @ l == P@l + - P'1@l * pow_pos rmul (hd 0 l) k).
- induction P;simpl;intros.
- rewrite Popp_ok;rsimpl;apply (ARadd_comm ARth);trivial.
- destruct p2;simpl; rewrite Popp_ok;rsimpl.
- rewrite Pjump_xO_tail.
- apply (ARadd_comm ARth);trivial.
- rewrite Pjump_Pdouble_minus_one.
- apply (ARadd_comm ARth);trivial.
- apply (ARadd_comm ARth);trivial.
- assert (H1 := ZPminus_spec p2 k);destruct (ZPminus p2 k);Esimpl2;rsimpl.
- rewrite IHP'1;rsimpl;add_push (P5 @ (tail l0));rewrite H1;rrefl.
- rewrite IHP'1;rewrite H1;rewrite Pplus_comm.
- rewrite pow_pos_Pplus;simpl;Esimpl.
- add_push (P5 @ (tail l0));rrefl.
- rewrite IHP1;rewrite H1;rewrite Pplus_comm.
- rewrite pow_pos_Pplus;simpl;rsimpl.
- add_push (P5 @ (tail l0));rrefl.
- rewrite H0;rsimpl.
- rewrite IHP'2;rsimpl;add_push (P3 @ (tail l)).
- rewrite H;rewrite Pplus_comm.
- rewrite pow_pos_Pplus;rsimpl.
+ intros IHP'.
+ revert k l. induction P;simpl;intros.
+ - add_permut.
+ - destruct p; simpl;
+ rewrite ?Pjump_xO_tail, ?Pjump_pred_double; add_permut.
+ - destr_pos_sub; intros ->;Esimpl.
+ + rewrite IHP';rsimpl. add_permut.
+ + rewrite IHP', pow_pos_add;simpl;Esimpl. add_permut.
+ + rewrite IHP1, pow_pos_add;rsimpl. add_permut.
Qed.
-(* Proof for the symmetric version *)
- Lemma PmulI_ok :
- forall P',
- (forall (P : Pol) (l : Env R), (Pmul P P') @ l == P @ l * P' @ l) ->
- forall (P : Pol) (p : positive) (l : Env R),
- (PmulI Pmul P' p P) @ l == P @ l * P' @ (jump p l).
+ Lemma Padd_ok P' P l : (P ++ P')@l == P@l + P'@l.
Proof.
- induction P;simpl;intros.
- Esimpl2;apply (ARmul_comm ARth).
- assert (H1 := ZPminus_spec p p0);destruct (ZPminus p p0);Esimpl2.
- rewrite H1; rewrite H;rrefl.
- rewrite H1; rewrite H.
- rewrite Pjump_Pplus;simpl;rrefl.
- rewrite H1.
- rewrite Pjump_Pplus;rewrite IHP;rrefl.
- destruct p0;Esimpl2.
- rewrite IHP1;rewrite IHP2;rsimpl.
- rewrite Pjump_xO_tail.
- mul_push (pow_pos rmul (hd 0 l) p);rrefl.
- rewrite IHP1;rewrite IHP2;simpl;rsimpl.
- mul_push (pow_pos rmul (hd 0 l) p); rewrite Pjump_Pdouble_minus_one.
- rrefl.
- rewrite IHP1;simpl;rsimpl.
- mul_push (pow_pos rmul (hd 0 l) p).
- rewrite H;rrefl.
+ revert P l; induction P';simpl;intros;Esimpl.
+ - revert p l; induction P;simpl;intros.
+ + Esimpl; add_permut.
+ + destr_pos_sub; intros ->;Esimpl.
+ * now rewrite IHP'.
+ * rewrite IHP';Esimpl. now rewrite Pjump_add.
+ * rewrite IHP. now rewrite Pjump_add.
+ + destruct p0;simpl.
+ * rewrite IHP2;simpl. rsimpl. rewrite Pjump_xO_tail. Esimpl.
+ * rewrite IHP2;simpl. rewrite Pjump_pred_double. rsimpl.
+ * rewrite IHP'. rsimpl.
+ - destruct P;simpl.
+ + Esimpl. add_permut.
+ + destruct p0;simpl;Esimpl; rewrite IHP'2; simpl.
+ * rewrite Pjump_xO_tail. rsimpl. add_permut.
+ * rewrite Pjump_pred_double. rsimpl. add_permut.
+ * rsimpl. unfold tail. add_permut.
+ + destr_pos_sub; intros ->; Esimpl.
+ * rewrite IHP'1, IHP'2;rsimpl. add_permut.
+ * rewrite IHP'1, IHP'2;simpl;Esimpl.
+ rewrite pow_pos_add;rsimpl. add_permut.
+ * rewrite PaddX_ok by trivial; rsimpl.
+ rewrite IHP'2, pow_pos_add; rsimpl. add_permut.
Qed.
-(*
- Lemma PmulI_ok :
- forall P',
- (forall (P : Pol) (l : list R), (Pmul_aux P P') @ l == P @ l * P' @ l) ->
- forall (P : Pol) (p : positive) (l : list R),
- (PmulI Pmul_aux P' p P) @ l == P @ l * P' @ (jump p l).
+ Lemma PsubX_ok P' P k l :
+ (forall P l, (P--P')@l == P@l - P'@l) ->
+ (PsubX Psub P' k P) @ l == P@l - P'@l * (hd l)^k.
Proof.
- induction P;simpl;intros.
- Esimpl2;apply (ARmul_comm ARth).
- assert (H1 := ZPminus_spec p p0);destruct (ZPminus p p0);Esimpl2.
- rewrite H1; rewrite H;rrefl.
- rewrite H1; rewrite H.
- rewrite Pplus_comm.
- rewrite jump_Pplus;simpl;rrefl.
- rewrite H1;rewrite Pplus_comm.
- rewrite jump_Pplus;rewrite IHP;rrefl.
- destruct p0;Esimpl2.
- rewrite IHP1;rewrite IHP2;simpl;rsimpl.
- mul_push (pow_pos rmul (hd 0 l) p);rrefl.
- rewrite IHP1;rewrite IHP2;simpl;rsimpl.
- mul_push (pow_pos rmul (hd 0 l) p); rewrite jump_Pdouble_minus_one;rrefl.
- rewrite IHP1;simpl;rsimpl.
- mul_push (pow_pos rmul (hd 0 l) p).
- rewrite H;rrefl.
+ intros IHP'.
+ revert k l. induction P;simpl;intros.
+ - rewrite Popp_ok;rsimpl; add_permut.
+ - destruct p; simpl;
+ rewrite Popp_ok;rsimpl;
+ rewrite ?Pjump_xO_tail, ?Pjump_pred_double; add_permut.
+ - destr_pos_sub; intros ->; Esimpl.
+ + rewrite IHP';rsimpl. add_permut.
+ + rewrite IHP', pow_pos_add;simpl;Esimpl. add_permut.
+ + rewrite IHP1, pow_pos_add;rsimpl. add_permut.
Qed.
- Lemma Pmul_aux_ok : forall P' P l,(Pmul_aux P P')@l == P@l * P'@l.
+ Lemma Psub_ok P' P l : (P -- P')@l == P@l - P'@l.
Proof.
- induction P';simpl;intros.
- Esimpl2;trivial.
- apply PmulI_ok;trivial.
- rewrite Padd_ok;Esimpl2.
- rewrite (PmulI_ok P'2 IHP'2). rewrite IHP'1. rrefl.
+ revert P l; induction P';simpl;intros;Esimpl.
+ - revert p l; induction P;simpl;intros.
+ + Esimpl; add_permut.
+ + destr_pos_sub; intros ->;Esimpl.
+ * rewrite IHP';rsimpl.
+ * rewrite IHP';Esimpl. now rewrite Pjump_add.
+ * rewrite IHP. now rewrite Pjump_add.
+ + destruct p0;simpl.
+ * rewrite IHP2;simpl. rsimpl. rewrite Pjump_xO_tail. Esimpl.
+ * rewrite IHP2;simpl. rewrite Pjump_pred_double. rsimpl.
+ * rewrite IHP'. rsimpl.
+ - destruct P;simpl.
+ + Esimpl; add_permut.
+ + destruct p0;simpl;Esimpl; rewrite IHP'2; simpl.
+ * rewrite Pjump_xO_tail. rsimpl. add_permut.
+ * rewrite Pjump_pred_double. rsimpl. add_permut.
+ * rsimpl. unfold tail. add_permut.
+ + destr_pos_sub; intros ->; Esimpl.
+ * rewrite IHP'1, IHP'2;rsimpl. add_permut.
+ * rewrite IHP'1, IHP'2;simpl;Esimpl.
+ rewrite pow_pos_add;rsimpl. add_permut.
+ * rewrite PsubX_ok by trivial;rsimpl.
+ rewrite IHP'2, pow_pos_add;rsimpl. add_permut.
Qed.
-*)
-(* Proof for the symmetric version *)
- Lemma Pmul_ok : forall P P' l, (P**P')@l == P@l * P'@l.
+ Lemma PmulI_ok P' :
+ (forall P l, (Pmul P P') @ l == P @ l * P' @ l) ->
+ forall P p l, (PmulI Pmul P' p P) @ l == P @ l * P' @ (jump p l).
Proof.
- intros P P';generalize P;clear P;induction P';simpl;intros.
- apply PmulC_ok. apply PmulI_ok;trivial.
- destruct P.
- rewrite (ARmul_comm ARth);Esimpl2;Esimpl2.
- Esimpl2. rewrite IHP'1;Esimpl2.
- assert (match p0 with
- | xI j => Pinj (xO j) P ** P'2
- | xO j => Pinj (Pdouble_minus_one j) P ** P'2
- | 1 => P ** P'2
- end @ (tail l) == P @ (jump p0 l) * P'2 @ (tail l)).
- destruct p0;rewrite IHP'2;Esimpl.
- rewrite Pjump_xO_tail. reflexivity.
- rewrite Pjump_Pdouble_minus_one;Esimpl.
- rewrite H;Esimpl.
- rewrite Padd_ok; Esimpl2. rewrite Padd_ok; Esimpl2.
- repeat (rewrite IHP'1 || rewrite IHP'2);simpl.
- rewrite PmulI_ok;trivial.
- unfold tail.
- mul_push (P'1@l). simpl. mul_push (P'2 @ (jump 1 l)). Esimpl.
+ intros IHP'.
+ induction P;simpl;intros.
+ - Esimpl; mul_permut.
+ - destr_pos_sub; intros ->;Esimpl.
+ + now rewrite IHP'.
+ + now rewrite IHP', Pjump_add.
+ + now rewrite IHP, Pjump_add.
+ - destruct p0;Esimpl; rewrite ?IHP1, ?IHP2; rsimpl.
+ + rewrite Pjump_xO_tail. f_equiv. mul_permut.
+ + rewrite Pjump_pred_double. f_equiv. mul_permut.
+ + rewrite IHP'. f_equiv. mul_permut.
Qed.
-(*
-Lemma Pmul_ok : forall P P' l, (P**P')@l == P@l * P'@l.
+ Lemma Pmul_ok P P' l : (P**P')@l == P@l * P'@l.
Proof.
- destruct P;simpl;intros.
- Esimpl2;apply (ARmul_comm ARth).
- rewrite (PmulI_ok P (Pmul_aux_ok P)).
- apply (ARmul_comm ARth).
- rewrite Padd_ok; Esimpl2.
- rewrite (PmulI_ok P3 (Pmul_aux_ok P3));trivial.
- rewrite Pmul_aux_ok;mul_push (P' @ l).
- rewrite (ARmul_comm ARth (P' @ l));rrefl.
+ revert P l;induction P';simpl;intros.
+ - apply PmulC_ok.
+ - apply PmulI_ok;trivial.
+ - destruct P.
+ + rewrite (ARmul_comm ARth). Esimpl.
+ + Esimpl. rewrite IHP'1;Esimpl. f_equiv.
+ destruct p0;rewrite IHP'2;Esimpl.
+ * now rewrite Pjump_xO_tail.
+ * rewrite Pjump_pred_double; Esimpl.
+ + rewrite Padd_ok, !mkPX_ok, Padd_ok, !mkPX_ok,
+ !IHP'1, !IHP'2, PmulI_ok; trivial. simpl. Esimpl.
+ unfold tail.
+ add_permut; f_equiv; mul_permut.
Qed.
-*)
- Lemma Psquare_ok : forall P l, (Psquare P)@l == P@l * P@l.
+ Lemma Psquare_ok P l : (Psquare P)@l == P@l * P@l.
Proof.
- induction P;simpl;intros;Esimpl2.
- apply IHP. rewrite Padd_ok. rewrite Pmul_ok;Esimpl2.
- rewrite IHP1;rewrite IHP2.
- mul_push (pow_pos rmul (hd 0 l) p). mul_push (P2@l).
- rrefl.
+ revert l;induction P;simpl;intros;Esimpl.
+ - apply IHP.
+ - rewrite Padd_ok, Pmul_ok;Esimpl.
+ rewrite IHP1, IHP2.
+ mul_push ((hd l)^p). now mul_push (P2@l).
Qed.
- Lemma Mphi_morph : forall P env env', (forall x, env x = env' x ) ->
- Mphi env P = Mphi env' P.
+ Lemma Mphi_morph M e1 e2 :
+ (forall x, e1 x = e2 x) -> M @@ e1 = M @@ e2.
Proof.
- induction P ; simpl.
- reflexivity.
- intros.
- apply IHP.
- intros.
- unfold jump.
- apply H.
- (**)
- intros.
- replace (Mphi (tail env) P) with (Mphi (tail env') P).
- unfold hd. unfold nth.
- rewrite H.
- reflexivity.
- apply IHP.
- unfold tail,jump.
- intros. symmetry. apply H.
+ revert e1 e2; induction M; simpl; intros e1 e2 EQ; trivial.
+ - apply IHM. intros; apply EQ.
+ - f_equal.
+ * apply IHM. intros; apply EQ.
+ * f_equal. apply EQ.
Qed.
-Lemma Mjump_xO_tail : forall M p l,
- Mphi (jump (xO p) (tail l)) M = Mphi (jump (xI p) l) M.
+Lemma Mjump_xO_tail M p l :
+ M @@ (jump (xO p) (tail l)) = M @@ (jump (xI p) l).
Proof.
- intros.
- apply Mphi_morph.
- intros.
- rewrite (@jump_simpl R (xI p)).
- rewrite (@jump_simpl R (xO p)).
- reflexivity.
+ apply Mphi_morph. intros. now jump_simpl.
Qed.
-Lemma Mjump_Pdouble_minus_one : forall M p l,
- Mphi (jump (Pdouble_minus_one p) (tail l)) M = Mphi (jump (xO p) l) M.
+Lemma Mjump_pred_double M p l :
+ M @@ (jump (Pos.pred_double p) (tail l)) = M @@ (jump (xO p) l).
Proof.
- intros.
- apply Mphi_morph.
- intros.
- rewrite jump_Pdouble_minus_one.
- rewrite (@jump_simpl R (xO p)).
- reflexivity.
+ apply Mphi_morph. intros.
+ rewrite jump_pred_double. now jump_simpl.
Qed.
-Lemma Mjump_Pplus : forall M i j l, Mphi (jump (i + j) l ) M = Mphi (jump j (jump i l)) M.
+Lemma Mjump_add M i j l :
+ M @@ (jump (i + j) l) = M @@ (jump j (jump i l)).
Proof.
- intros. apply Mphi_morph. intros. rewrite <- jump_Pplus.
- rewrite Pplus_comm.
- reflexivity.
+ apply Mphi_morph. intros. now rewrite <- jump_add, Pos.add_comm.
Qed.
-
-
- Lemma mkZmon_ok: forall M j l,
- Mphi l (mkZmon j M) == Mphi l (zmon j M).
- intros M j l; case M; simpl; intros; rsimpl.
+ Lemma mkZmon_ok M j l :
+ (mkZmon j M) @@ l == (zmon j M) @@ l.
+ Proof.
+ destruct M; simpl; rsimpl.
Qed.
- Lemma zmon_pred_ok : forall M j l,
- Mphi (tail l) (zmon_pred j M) == Mphi l (zmon j M).
+ Lemma zmon_pred_ok M j l :
+ (zmon_pred j M) @@ (tail l) == (zmon j M) @@ l.
Proof.
- destruct j; simpl;intros l; rsimpl.
- rewrite mkZmon_ok;rsimpl.
- simpl.
- rewrite Mjump_xO_tail.
- reflexivity.
- rewrite mkZmon_ok;simpl.
- rewrite Mjump_Pdouble_minus_one; rsimpl.
+ destruct j; simpl; rewrite ?mkZmon_ok; simpl; rsimpl.
+ - now rewrite Mjump_xO_tail.
+ - rewrite Mjump_pred_double; rsimpl.
Qed.
- Lemma mkVmon_ok : forall M i l, Mphi l (mkVmon i M) == Mphi l M*pow_pos rmul (hd 0 l) i.
+ Lemma mkVmon_ok M i l :
+ (mkVmon i M)@@l == M@@l * (hd l)^i.
Proof.
destruct M;simpl;intros;rsimpl.
- rewrite zmon_pred_ok;simpl;rsimpl.
- rewrite Pplus_comm;rewrite pow_pos_Pplus;rsimpl.
+ - rewrite zmon_pred_ok;simpl;rsimpl.
+ - rewrite pow_pos_add;rsimpl.
Qed.
+ Ltac destr_mfactor R S := match goal with
+ | H : context [MFactor ?P _] |- context [MFactor ?P ?M] =>
+ specialize (H M); destruct MFactor as (R,S)
+ end.
- Lemma Mphi_ok: forall P M l,
- let (Q,R) := MFactor P M in
- P@l == Q@l + (Mphi l M) * (R@l).
+ Lemma Mphi_ok P M l :
+ let (Q,R) := MFactor P M in
+ P@l == Q@l + M@@l * R@l.
Proof.
- intros P; elim P; simpl; auto; clear P.
- intros c M l; case M; simpl; auto; try intro p; try intro m;
- try rewrite (morph0 CRmorph); rsimpl.
-
- intros i P Hrec M l; case M; simpl; clear M.
- rewrite (morph0 CRmorph); rsimpl.
- intros j M.
- case_eq (i ?= j); intros He; simpl.
- rewrite (Pos.compare_eq _ _ He).
- generalize (Hrec M (jump j l)); case (MFactor P M);
- simpl; intros P2 Q2 H; repeat rewrite mkPinj_ok; auto.
- generalize (Hrec (zmon (j -i) M) (jump i l));
- case (MFactor P (zmon (j -i) M)); simpl.
- intros P2 Q2 H; repeat rewrite mkPinj_ok; auto.
- rewrite <- (Pplus_minus _ _ (ZC2 _ _ He)).
- rewrite Mjump_Pplus; auto.
- rewrite (morph0 CRmorph); rsimpl.
- intros P2 m; rewrite (morph0 CRmorph); rsimpl.
-
- intros P2 Hrec1 i Q2 Hrec2 M l; case M; simpl; auto.
- rewrite (morph0 CRmorph); rsimpl.
- intros j M1.
- generalize (Hrec1 (zmon j M1) l);
- case (MFactor P2 (zmon j M1)).
- intros R1 S1 H1.
- generalize (Hrec2 (zmon_pred j M1) (tail l));
- case (MFactor Q2 (zmon_pred j M1)); simpl.
- intros R2 S2 H2; rewrite H1; rewrite H2.
- repeat rewrite mkPX_ok; simpl.
- rsimpl.
- apply radd_ext; rsimpl.
- rewrite (ARadd_comm ARth); rsimpl.
- apply radd_ext; rsimpl.
- rewrite (ARadd_comm ARth); rsimpl.
- rewrite zmon_pred_ok;rsimpl.
- intros j M1.
- case_eq (i ?= j); intros He; simpl.
- rewrite (Pos.compare_eq _ _ He).
- generalize (Hrec1 (mkZmon xH M1) l); case (MFactor P2 (mkZmon xH M1));
- simpl; intros P3 Q3 H; repeat rewrite mkPinj_ok; auto.
- rewrite H; rewrite mkPX_ok; rsimpl.
- repeat (rewrite <-(ARadd_assoc ARth)).
- apply radd_ext; rsimpl.
- rewrite (ARadd_comm ARth); rsimpl.
- apply radd_ext; rsimpl.
- repeat (rewrite <-(ARmul_assoc ARth)).
- rewrite mkZmon_ok.
- apply rmul_ext; rsimpl.
- rewrite (ARmul_comm ARth); rsimpl.
- generalize (Hrec1 (vmon (j - i) M1) l);
- case (MFactor P2 (vmon (j - i) M1));
- simpl; intros P3 Q3 H; repeat rewrite mkPinj_ok; auto.
- rewrite H; rsimpl; repeat rewrite mkPinj_ok; auto.
- rewrite mkPX_ok; rsimpl.
- repeat (rewrite <-(ARadd_assoc ARth)).
- apply radd_ext; rsimpl.
- rewrite (ARadd_comm ARth); rsimpl.
- apply radd_ext; rsimpl.
- repeat (rewrite <-(ARmul_assoc ARth)).
- apply rmul_ext; rsimpl.
- rewrite (ARmul_comm ARth); rsimpl.
- apply rmul_ext; rsimpl.
- rewrite <- pow_pos_Pplus.
- rewrite (Pplus_minus _ _ (ZC2 _ _ He)); rsimpl.
- generalize (Hrec1 (mkZmon 1 M1) l);
- case (MFactor P2 (mkZmon 1 M1));
- simpl; intros P3 Q3 H; repeat rewrite mkPinj_ok; auto.
- rewrite H; rsimpl.
- rewrite mkPX_ok; rsimpl.
- repeat (rewrite <-(ARadd_assoc ARth)).
- apply radd_ext; rsimpl.
- rewrite (ARadd_comm ARth); rsimpl.
- apply radd_ext; rsimpl.
- rewrite mkZmon_ok.
- repeat (rewrite <-(ARmul_assoc ARth)).
- apply rmul_ext; rsimpl.
- rewrite (ARmul_comm ARth); rsimpl.
- rewrite mkPX_ok; simpl; rsimpl.
- rewrite (morph0 CRmorph); rsimpl.
- repeat (rewrite <-(ARmul_assoc ARth)).
- rewrite (ARmul_comm ARth (Q3@l)); rsimpl.
- apply rmul_ext; rsimpl.
- rewrite <- pow_pos_Pplus.
- rewrite (Pplus_minus _ _ He); rsimpl.
+ revert M l; induction P; destruct M; intros l; simpl; auto; Esimpl.
+ - case Pos.compare_spec; intros He; simpl.
+ * destr_mfactor R1 S1. now rewrite IHP, He, !mkPinj_ok.
+ * destr_mfactor R1 S1. rewrite IHP; simpl.
+ now rewrite !mkPinj_ok, <- Mjump_add, Pos.add_comm, Pos.sub_add.
+ * Esimpl.
+ - destr_mfactor R1 S1. destr_mfactor R2 S2.
+ rewrite IHP1, IHP2, !mkPX_ok, zmon_pred_ok; simpl; rsimpl.
+ add_permut.
+ - case Pos.compare_spec; intros He; simpl; destr_mfactor R1 S1;
+ rewrite ?He, IHP1, mkPX_ok, ?mkZmon_ok; simpl; rsimpl;
+ unfold tail; add_permut; mul_permut.
+ * rewrite <- pow_pos_add, Pos.add_comm, Pos.sub_add by trivial; rsimpl.
+ * rewrite mkPX_ok. simpl. Esimpl. mul_permut.
+ rewrite <- pow_pos_add, Pos.sub_add by trivial; rsimpl.
Qed.
-(* Proof for the symmetric version *)
-
- Lemma POneSubst_ok: forall P1 M1 P2 P3 l,
- POneSubst P1 M1 P2 = Some P3 -> Mphi l M1 == P2@l -> P1@l == P3@l.
+ Lemma POneSubst_ok P1 M1 P2 P3 l :
+ POneSubst P1 M1 P2 = Some P3 -> M1@@l == P2@l ->
+ P1@l == P3@l.
Proof.
- intros P2 M1 P3 P4 l; unfold POneSubst.
- generalize (Mphi_ok P2 M1 l); case (MFactor P2 M1); simpl; auto.
- intros Q1 R1; case R1.
- intros c H; rewrite H.
- generalize (morph_eq CRmorph c cO);
- case (c ?=! cO); simpl; auto.
- intros H1 H2; rewrite H1; auto; rsimpl.
- discriminate.
- intros _ H1 H2; injection H1; intros; subst.
- rewrite H2; rsimpl.
- (* new version *)
- rewrite Padd_ok; rewrite PmulC_ok; rsimpl.
- intros i P5 H; rewrite H.
- intros HH H1; injection HH; intros; subst; rsimpl.
- rewrite Padd_ok; rewrite PmulI_ok by (intros;apply Pmul_ok). rewrite H1; rsimpl.
- intros i P5 P6 H1 H2 H3; rewrite H1; rewrite H3.
- assert (P4 = Q1 ++ P3 ** PX i P5 P6).
- injection H2; intros; subst;trivial.
- rewrite H;rewrite Padd_ok;rewrite Pmul_ok;rsimpl.
-Qed.
-(*
- Lemma POneSubst_ok: forall P1 M1 P2 P3 l,
- POneSubst P1 M1 P2 = Some P3 -> Mphi l M1 == P2@l -> P1@l == P3@l.
-Proof.
- intros P2 M1 P3 P4 l; unfold POneSubst.
- generalize (Mphi_ok P2 M1 l); case (MFactor P2 M1); simpl; auto.
- intros Q1 R1; case R1.
- intros c H; rewrite H.
- generalize (morph_eq CRmorph c cO);
- case (c ?=! cO); simpl; auto.
- intros H1 H2; rewrite H1; auto; rsimpl.
- discriminate.
- intros _ H1 H2; injection H1; intros; subst.
- rewrite H2; rsimpl.
- rewrite Padd_ok; rewrite Pmul_ok; rsimpl.
- intros i P5 H; rewrite H.
- intros HH H1; injection HH; intros; subst; rsimpl.
- rewrite Padd_ok; rewrite Pmul_ok. rewrite H1; rsimpl.
- intros i P5 P6 H1 H2 H3; rewrite H1; rewrite H3.
- injection H2; intros; subst; rsimpl.
- rewrite Padd_ok.
- rewrite Pmul_ok; rsimpl.
+ unfold POneSubst.
+ assert (H := Mphi_ok P1). destr_mfactor R1 S1. rewrite H; clear H.
+ intros EQ EQ'. replace P3 with (R1 ++ P2 ** S1).
+ - rewrite EQ', Padd_ok, Pmul_ok; rsimpl.
+ - revert EQ. destruct S1; try now injection 1.
+ case ceqb_spec; now inversion 2.
Qed.
-*)
- Lemma PNSubst1_ok: forall n P1 M1 P2 l,
- Mphi l M1 == P2@l -> P1@l == (PNSubst1 P1 M1 P2 n)@l.
+
+ Lemma PNSubst1_ok n P1 M1 P2 l :
+ M1@@l == P2@l -> P1@l == (PNSubst1 P1 M1 P2 n)@l.
Proof.
- intros n; elim n; simpl; auto.
- intros P2 M1 P3 l H.
- generalize (fun P4 => @POneSubst_ok P2 M1 P3 P4 l);
- case (POneSubst P2 M1 P3); [idtac | intros; rsimpl].
- intros P4 Hrec; rewrite (Hrec P4); auto; rsimpl.
- intros n1 Hrec P2 M1 P3 l H.
- generalize (fun P4 => @POneSubst_ok P2 M1 P3 P4 l);
- case (POneSubst P2 M1 P3); [idtac | intros; rsimpl].
- intros P4 Hrec1; rewrite (Hrec1 P4); auto; rsimpl.
+ revert P1. induction n; simpl; intros P1;
+ generalize (POneSubst_ok P1 M1 P2); destruct POneSubst;
+ intros; rewrite <- ?IHn; auto; reflexivity.
Qed.
- Lemma PNSubst_ok: forall n P1 M1 P2 l P3,
- PNSubst P1 M1 P2 n = Some P3 -> Mphi l M1 == P2@l -> P1@l == P3@l.
+ Lemma PNSubst_ok n P1 M1 P2 l P3 :
+ PNSubst P1 M1 P2 n = Some P3 -> M1@@l == P2@l -> P1@l == P3@l.
Proof.
- intros n P2 M1 P3 l P4; unfold PNSubst.
- generalize (fun P4 => @POneSubst_ok P2 M1 P3 P4 l);
- case (POneSubst P2 M1 P3); [idtac | intros; discriminate].
- intros P5 H1; case n; try (intros; discriminate).
- intros n1 H2; injection H2; intros; subst.
- rewrite <- PNSubst1_ok; auto.
+ unfold PNSubst.
+ assert (H := POneSubst_ok P1 M1 P2); destruct POneSubst; try discriminate.
+ destruct n; inversion_clear 1.
+ intros. rewrite <- PNSubst1_ok; auto.
Qed.
- Fixpoint MPcond (LM1: list (Mon * Pol)) (l: Env R) {struct LM1} : Prop :=
- match LM1 with
- cons (M1,P2) LM2 => (Mphi l M1 == P2@l) /\ (MPcond LM2 l)
- | _ => True
- end.
+ Fixpoint MPcond (LM1: list (Mon * Pol)) (l: Env R) : Prop :=
+ match LM1 with
+ | cons (M1,P2) LM2 => (M1@@l == P2@l) /\ MPcond LM2 l
+ | _ => True
+ end.
- Lemma PSubstL1_ok: forall n LM1 P1 l,
- MPcond LM1 l -> P1@l == (PSubstL1 P1 LM1 n)@l.
+ Lemma PSubstL1_ok n LM1 P1 l :
+ MPcond LM1 l -> P1@l == (PSubstL1 P1 LM1 n)@l.
Proof.
- intros n LM1; elim LM1; simpl; auto.
- intros; rsimpl.
- intros (M2,P2) LM2 Hrec P3 l [H H1].
- rewrite <- Hrec; auto.
- apply PNSubst1_ok; auto.
+ revert P1; induction LM1 as [|(M2,P2) LM2 IH]; simpl; intros.
+ - reflexivity.
+ - rewrite <- IH by intuition. now apply PNSubst1_ok.
Qed.
- Lemma PSubstL_ok: forall n LM1 P1 P2 l,
- PSubstL P1 LM1 n = Some P2 -> MPcond LM1 l -> P1@l == P2@l.
+ Lemma PSubstL_ok n LM1 P1 P2 l :
+ PSubstL P1 LM1 n = Some P2 -> MPcond LM1 l -> P1@l == P2@l.
Proof.
- intros n LM1; elim LM1; simpl; auto.
- intros; discriminate.
- intros (M2,P2) LM2 Hrec P3 P4 l.
- generalize (PNSubst_ok n P3 M2 P2); case (PNSubst P3 M2 P2 n).
- intros P5 H0 H1 [H2 H3]; injection H1; intros; subst.
- rewrite <- PSubstL1_ok; auto.
- intros l1 H [H1 H2]; auto.
+ revert P1. induction LM1 as [|(M2,P2') LM2 IH]; simpl; intros.
+ - discriminate.
+ - assert (H':=PNSubst_ok n P3 M2 P2'). destruct PNSubst.
+ * injection H; intros <-. rewrite <- PSubstL1_ok; intuition.
+ * now apply IH.
Qed.
- Lemma PNSubstL_ok: forall m n LM1 P1 l,
- MPcond LM1 l -> P1@l == (PNSubstL P1 LM1 m n)@l.
+ Lemma PNSubstL_ok m n LM1 P1 l :
+ MPcond LM1 l -> P1@l == (PNSubstL P1 LM1 m n)@l.
Proof.
- intros m; elim m; simpl; auto.
- intros n LM1 P2 l H; generalize (fun P3 => @PSubstL_ok n LM1 P2 P3 l);
- case (PSubstL P2 LM1 n); intros; rsimpl; auto.
- intros m1 Hrec n LM1 P2 l H.
- generalize (fun P3 => @PSubstL_ok n LM1 P2 P3 l);
- case (PSubstL P2 LM1 n); intros; rsimpl; auto.
- rewrite <- Hrec; auto.
+ revert LM1 P1. induction m; simpl; intros;
+ assert (H' := PSubstL_ok n LM1 P2); destruct PSubstL;
+ auto; try reflexivity.
+ rewrite <- IHm; auto.
Qed.
(** Definition of polynomial expressions *)
@@ -1228,7 +943,7 @@ Proof.
(** evaluation of polynomial expressions towards R *)
- Fixpoint PEeval (l:Env R) (pe:PExpr) {struct pe} : R :=
+ Fixpoint PEeval (l:Env R) (pe:PExpr) : R :=
match pe with
| PEc c => phi c
| PEX j => nth j l
@@ -1241,60 +956,23 @@ Proof.
(** Correctness proofs *)
- Lemma mkX_ok : forall p l, nth p l == (mk_X p) @ l.
+ Lemma mkX_ok p l : nth p l == (mk_X p) @ l.
Proof.
destruct p;simpl;intros;Esimpl;trivial.
rewrite nth_spec ; auto.
unfold hd.
- rewrite <- nth_Pdouble_minus_one.
- rewrite (nth_jump (Pdouble_minus_one p) l 1).
- reflexivity.
+ now rewrite <- nth_pred_double, nth_jump.
Qed.
- Ltac Esimpl3 :=
- repeat match goal with
- | |- context [(?P1 ++ ?P2)@?l] => rewrite (Padd_ok P2 P1 l)
- | |- context [(?P1 -- ?P2)@?l] => rewrite (Psub_ok P2 P1 l)
- end;Esimpl2;try rrefl;try apply (ARadd_comm ARth).
-
-(* Power using the chinise algorithm *)
-(*Section POWER.
- Variable subst_l : Pol -> Pol.
- Fixpoint Ppow_pos (P:Pol) (p:positive){struct p} : Pol :=
- match p with
- | xH => P
- | xO p => subst_l (Psquare (Ppow_pos P p))
- | xI p => subst_l (Pmul P (Psquare (Ppow_pos P p)))
- end.
-
- Definition Ppow_N P n :=
- match n with
- | N0 => P1
- | Npos p => Ppow_pos P p
- end.
-
- Lemma Ppow_pos_ok : forall l, (forall P, subst_l P@l == P@l) ->
- forall P p, (Ppow_pos P p)@l == (pow_pos Pmul P p)@l.
- Proof.
- intros l subst_l_ok P.
- induction p;simpl;intros;try rrefl;try rewrite subst_l_ok.
- repeat rewrite Pmul_ok;rewrite Psquare_ok;rewrite IHp;rrefl.
- repeat rewrite Pmul_ok;rewrite Psquare_ok;rewrite IHp;rrefl.
- Qed.
-
- Lemma Ppow_N_ok : forall l, (forall P, subst_l P@l == P@l) ->
- forall P n, (Ppow_N P n)@l == (pow_N P1 Pmul P n)@l.
- Proof. destruct n;simpl. rrefl. apply Ppow_pos_ok. trivial. Qed.
-
- End POWER. *)
+ Hint Rewrite Padd_ok Psub_ok : Esimpl.
Section POWER.
Variable subst_l : Pol -> Pol.
- Fixpoint Ppow_pos (res P:Pol) (p:positive){struct p} : Pol :=
+ Fixpoint Ppow_pos (res P:Pol) (p:positive) : Pol :=
match p with
- | xH => subst_l (Pmul res P)
+ | xH => subst_l (res ** P)
| xO p => Ppow_pos (Ppow_pos res P p) P p
- | xI p => subst_l (Pmul (Ppow_pos (Ppow_pos res P p) P p) P)
+ | xI p => subst_l ((Ppow_pos (Ppow_pos res P p) P p) ** P)
end.
Definition Ppow_N P n :=
@@ -1303,17 +981,23 @@ Section POWER.
| Npos p => Ppow_pos P1 P p
end.
- Lemma Ppow_pos_ok : forall l, (forall P, subst_l P@l == P@l) ->
- forall res P p, (Ppow_pos res P p)@l == res@l * (pow_pos Pmul P p)@l.
+ Lemma Ppow_pos_ok l :
+ (forall P, subst_l P@l == P@l) ->
+ forall res P p, (Ppow_pos res P p)@l == res@l * (pow_pos Pmul P p)@l.
Proof.
- intros l subst_l_ok res P p. generalize res;clear res.
- induction p;simpl;intros;try rewrite subst_l_ok; repeat rewrite Pmul_ok;repeat rewrite IHp.
- rsimpl. mul_push (P@l);rsimpl. rsimpl. rrefl.
+ intros subst_l_ok res P p. revert res.
+ induction p;simpl;intros; rewrite ?subst_l_ok, ?Pmul_ok, ?IHp;
+ mul_permut.
Qed.
- Lemma Ppow_N_ok : forall l, (forall P, subst_l P@l == P@l) ->
- forall P n, (Ppow_N P n)@l == (pow_N P1 Pmul P n)@l.
- Proof. destruct n;simpl. rrefl. rewrite Ppow_pos_ok. trivial. Esimpl. auto. Qed.
+ Lemma Ppow_N_ok l :
+ (forall P, subst_l P@l == P@l) ->
+ forall P n, (Ppow_N P n)@l == (pow_N P1 Pmul P n)@l.
+ Proof.
+ destruct n;simpl.
+ - reflexivity.
+ - rewrite Ppow_pos_ok by trivial. Esimpl.
+ Qed.
End POWER.
@@ -1342,62 +1026,57 @@ Section POWER.
Definition norm_subst pe := subst_l (norm_aux pe).
- (*
- Fixpoint norm_subst (pe:PExpr) : Pol :=
+ (** Internally, [norm_aux] is expanded in a large number of cases.
+ To speed-up proofs, we use an alternative definition. *)
+
+ Definition get_PEopp pe :=
match pe with
- | PEc c => Pc c
- | PEX j => subst_l (mk_X j)
- | PEadd (PEopp pe1) pe2 => Psub (norm_subst pe2) (norm_subst pe1)
- | PEadd pe1 (PEopp pe2) =>
- Psub (norm_subst pe1) (norm_subst pe2)
- | PEadd pe1 pe2 => Padd (norm_subst pe1) (norm_subst pe2)
- | PEsub pe1 pe2 => Psub (norm_subst pe1) (norm_subst pe2)
- | PEmul pe1 pe2 => Pmul_subst (norm_subst pe1) (norm_subst pe2)
- | PEopp pe1 => Popp (norm_subst pe1)
- | PEpow pe1 n => Ppow_subst (norm_subst pe1) n
+ | PEopp pe' => Some pe'
+ | _ => None
end.
- Lemma norm_subst_spec :
- forall l pe, MPcond lmp l ->
- PEeval l pe == (norm_subst pe)@l.
+ Lemma norm_aux_PEadd pe1 pe2 :
+ norm_aux (PEadd pe1 pe2) =
+ match get_PEopp pe1, get_PEopp pe2 with
+ | Some pe1', _ => (norm_aux pe2) -- (norm_aux pe1')
+ | None, Some pe2' => (norm_aux pe1) -- (norm_aux pe2')
+ | None, None => (norm_aux pe1) ++ (norm_aux pe2)
+ end.
Proof.
- intros;assert (subst_l_ok:forall P, (subst_l P)@l == P@l).
- unfold subst_l;intros.
- rewrite <- PNSubstL_ok;trivial. rrefl.
- assert (Pms_ok:forall P1 P2, (Pmul_subst P1 P2)@l == P1@l*P2@l).
- intros;unfold Pmul_subst;rewrite subst_l_ok;rewrite Pmul_ok;rrefl.
- induction pe;simpl;Esimpl3.
- rewrite subst_l_ok;apply mkX_ok.
- rewrite IHpe1;rewrite IHpe2;destruct pe1;destruct pe2;Esimpl3.
- rewrite IHpe1;rewrite IHpe2;rrefl.
- rewrite Pms_ok;rewrite IHpe1;rewrite IHpe2;rrefl.
- rewrite IHpe;rrefl.
- unfold Ppow_subst. rewrite Ppow_N_ok. trivial.
- rewrite pow_th.(rpow_pow_N). destruct n0;Esimpl3.
- induction p;simpl;try rewrite IHp;try rewrite IHpe;repeat rewrite Pms_ok;
- repeat rewrite Pmul_ok;rrefl.
+ simpl (norm_aux (PEadd _ _)).
+ destruct pe1; [ | | | | | reflexivity | ];
+ destruct pe2; simpl get_PEopp; reflexivity.
Qed.
-*)
- Lemma norm_aux_spec :
- forall l pe, (*MPcond lmp l ->*)
- PEeval l pe == (norm_aux pe)@l.
+
+ Lemma norm_aux_PEopp pe :
+ match get_PEopp pe with
+ | Some pe' => norm_aux pe = -- (norm_aux pe')
+ | None => True
+ end.
Proof.
- intros.
- induction pe;simpl;Esimpl3.
- apply mkX_ok.
- rewrite IHpe1;rewrite IHpe2;destruct pe1;destruct pe2;Esimpl3.
- rewrite IHpe1;rewrite IHpe2;rrefl.
- rewrite IHpe1;rewrite IHpe2. rewrite Pmul_ok. rrefl.
- rewrite IHpe;rrefl.
- rewrite Ppow_N_ok by reflexivity.
- rewrite pow_th.(rpow_pow_N). destruct n0;Esimpl3.
- induction p;simpl;try rewrite IHp;try rewrite IHpe;repeat rewrite Pms_ok;
- repeat rewrite Pmul_ok;rrefl.
+ now destruct pe.
Qed.
+ Lemma norm_aux_spec l pe :
+ PEeval l pe == (norm_aux pe)@l.
+ Proof.
+ intros.
+ induction pe.
+ - reflexivity.
+ - apply mkX_ok.
+ - simpl PEeval. rewrite IHpe1, IHpe2.
+ assert (H1 := norm_aux_PEopp pe1).
+ assert (H2 := norm_aux_PEopp pe2).
+ rewrite norm_aux_PEadd.
+ do 2 destruct get_PEopp; rewrite ?H1, ?H2; Esimpl; add_permut.
+ - simpl. rewrite IHpe1, IHpe2. Esimpl.
+ - simpl. rewrite IHpe1, IHpe2. now rewrite Pmul_ok.
+ - simpl. rewrite IHpe. Esimpl.
+ - simpl. rewrite Ppow_N_ok by reflexivity.
+ rewrite pow_th.(rpow_pow_N). destruct n0; simpl; Esimpl.
+ induction p;simpl; now rewrite ?IHp, ?IHpe, ?Pms_ok, ?Pmul_ok.
+ Qed.
End NORM_SUBST_REC.
-
End MakeRingPol.
-
diff --git a/plugins/micromega/MExtraction.v b/plugins/micromega/MExtraction.v
index 19a98f87..64181cde 100644
--- a/plugins/micromega/MExtraction.v
+++ b/plugins/micromega/MExtraction.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -51,7 +51,7 @@ Extract Constant Rinv => "fun x -> 1 / x".
Extraction "micromega.ml"
List.map simpl_cone (*map_cone indexes*)
denorm Qpower
- n_of_Z N_of_nat ZTautoChecker ZWeakChecker QTautoChecker RTautoChecker find.
+ n_of_Z N.of_nat ZTautoChecker ZWeakChecker QTautoChecker RTautoChecker find.
diff --git a/plugins/micromega/OrderedRing.v b/plugins/micromega/OrderedRing.v
index 97517957..b260feab 100644
--- a/plugins/micromega/OrderedRing.v
+++ b/plugins/micromega/OrderedRing.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/micromega/Psatz.v b/plugins/micromega/Psatz.v
index 7f6cf79b..bcf84c6b 100644
--- a/plugins/micromega/Psatz.v
+++ b/plugins/micromega/Psatz.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -81,14 +81,14 @@ Ltac lra :=
first [ psatzl R | psatzl Q ].
Ltac lia :=
- zify ; unfold Zsucc in * ;
- (*cbv delta - [Zplus Zminus Zopp Zmult Zpower Zgt Zge Zle Zlt iff not] ;*) xlia ;
+ zify ; unfold Z.succ in * ;
+ (*cbv delta - [Z.add Z.sub Z.opp Z.mul Z.pow Z.gt Z.ge Z.le Z.lt iff not] ;*) xlia ;
intros __wit __varmap __ff ;
change (Tauto.eval_f (Zeval_formula (@find Z Z0 __varmap)) __ff) ;
apply (ZTautoChecker_sound __ff __wit); vm_compute ; reflexivity.
Ltac nia :=
- zify ; unfold Zsucc in * ;
+ zify ; unfold Z.succ in * ;
xnlia ;
intros __wit __varmap __ff ;
change (Tauto.eval_f (Zeval_formula (@find Z Z0 __varmap)) __ff) ;
diff --git a/plugins/micromega/QMicromega.v b/plugins/micromega/QMicromega.v
index f64504a5..792e2c3c 100644
--- a/plugins/micromega/QMicromega.v
+++ b/plugins/micromega/QMicromega.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -60,7 +60,7 @@ Proof.
Qed.
-(*Definition Zeval_expr := eval_pexpr 0 Zplus Zmult Zminus Zopp (fun x => x) (fun x => Z_of_N x) (Zpower).*)
+(*Definition Zeval_expr := eval_pexpr 0 Z.add Z.mul Z.sub Z.opp (fun x => x) (fun x => Z.of_N x) (Z.pow).*)
Require Import EnvRing.
Fixpoint Qeval_expr (env: PolEnv Q) (e: PExpr Q) : Q :=
@@ -71,7 +71,7 @@ Fixpoint Qeval_expr (env: PolEnv Q) (e: PExpr Q) : Q :=
| PEsub pe1 pe2 => (Qeval_expr env pe1) - (Qeval_expr env pe2)
| PEmul pe1 pe2 => (Qeval_expr env pe1) * (Qeval_expr env pe2)
| PEopp pe1 => - (Qeval_expr env pe1)
- | PEpow pe1 n => Qpower (Qeval_expr env pe1) (Z_of_N n)
+ | PEpow pe1 n => Qpower (Qeval_expr env pe1) (Z.of_N n)
end.
Lemma Qeval_expr_simpl : forall env e,
@@ -83,7 +83,7 @@ Lemma Qeval_expr_simpl : forall env e,
| PEsub pe1 pe2 => (Qeval_expr env pe1) - (Qeval_expr env pe2)
| PEmul pe1 pe2 => (Qeval_expr env pe1) * (Qeval_expr env pe2)
| PEopp pe1 => - (Qeval_expr env pe1)
- | PEpow pe1 n => Qpower (Qeval_expr env pe1) (Z_of_N n)
+ | PEpow pe1 n => Qpower (Qeval_expr env pe1) (Z.of_N n)
end.
Proof.
destruct e ; reflexivity.
@@ -91,7 +91,7 @@ Qed.
Definition Qeval_expr' := eval_pexpr Qplus Qmult Qminus Qopp (fun x => x) (fun x => x) (pow_N 1 Qmult).
-Lemma QNpower : forall r n, r ^ Z_of_N n = pow_N 1 Qmult r n.
+Lemma QNpower : forall r n, r ^ Z.of_N n = pow_N 1 Qmult r n.
Proof.
destruct n ; reflexivity.
Qed.
diff --git a/plugins/micromega/RMicromega.v b/plugins/micromega/RMicromega.v
index 2be99da1..d6f67485 100644
--- a/plugins/micromega/RMicromega.v
+++ b/plugins/micromega/RMicromega.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -85,17 +85,17 @@ Qed.
Ltac INR_nat_of_P :=
match goal with
- | H : context[INR (nat_of_P ?X)] |- _ =>
+ | H : context[INR (Pos.to_nat ?X)] |- _ =>
revert H ;
let HH := fresh in
- assert (HH := pos_INR_nat_of_P X) ; revert HH ; generalize (INR (nat_of_P X))
- | |- context[INR (nat_of_P ?X)] =>
+ assert (HH := pos_INR_nat_of_P X) ; revert HH ; generalize (INR (Pos.to_nat X))
+ | |- context[INR (Pos.to_nat ?X)] =>
let HH := fresh in
- assert (HH := pos_INR_nat_of_P X) ; revert HH ; generalize (INR (nat_of_P X))
+ assert (HH := pos_INR_nat_of_P X) ; revert HH ; generalize (INR (Pos.to_nat X))
end.
Ltac add_eq expr val := set (temp := expr) ;
- generalize (refl_equal temp) ;
+ generalize (eq_refl temp) ;
unfold temp at 1 ; generalize temp ; intro val ; clear temp.
Ltac Rinv_elim :=
@@ -210,7 +210,7 @@ Proof.
rewrite plus_IZR in *.
rewrite mult_IZR in *.
simpl.
- rewrite nat_of_P_mult_morphism.
+ rewrite Pos2Nat.inj_mul.
rewrite mult_INR.
rewrite mult_IZR.
simpl.
@@ -244,7 +244,7 @@ Proof.
simpl.
repeat rewrite mult_IZR.
simpl.
- rewrite nat_of_P_mult_morphism.
+ rewrite Pos2Nat.inj_mul.
rewrite mult_INR.
repeat INR_nat_of_P.
intros. field ; split ; apply Rlt_neq ; auto.
@@ -275,7 +275,7 @@ Proof.
apply Rlt_neq ; auto.
simpl in H.
exfalso.
- rewrite Pmult_comm in H.
+ rewrite Pos.mul_comm in H.
compute in H.
discriminate.
Qed.
@@ -291,7 +291,7 @@ Proof.
destruct x.
unfold Qopp.
simpl.
- rewrite Zopp_involutive.
+ rewrite Z.opp_involutive.
reflexivity.
Qed.
@@ -348,7 +348,7 @@ Proof.
intros.
assert ( 0 > x \/ 0 < x)%Q.
destruct x ; unfold Qlt, Qeq in * ; simpl in *.
- rewrite Zmult_1_r in *.
+ rewrite Z.mul_1_r in *.
destruct Qnum ; simpl in * ; intuition auto.
right. reflexivity.
left ; reflexivity.
@@ -379,7 +379,7 @@ Proof.
Qed.
-Notation to_nat := N.to_nat. (*Nnat.nat_of_N*)
+Notation to_nat := N.to_nat.
Lemma QSORaddon :
@SORaddon R
@@ -471,7 +471,7 @@ Definition INZ (n:N) : R :=
| Npos p => IZR (Zpos p)
end.
-Definition Reval_expr := eval_pexpr Rplus Rmult Rminus Ropp R_of_Rcst nat_of_N pow.
+Definition Reval_expr := eval_pexpr Rplus Rmult Rminus Ropp R_of_Rcst N.to_nat pow.
Definition Reval_op2 (o:Op2) : R -> R -> Prop :=
@@ -490,10 +490,10 @@ Definition Reval_formula (e: PolEnv R) (ff : Formula Rcst) :=
Definition Reval_formula' :=
- eval_sformula Rplus Rmult Rminus Ropp (@eq R) Rle Rlt nat_of_N pow R_of_Rcst.
+ eval_sformula Rplus Rmult Rminus Ropp (@eq R) Rle Rlt N.to_nat pow R_of_Rcst.
Definition QReval_formula :=
- eval_formula Rplus Rmult Rminus Ropp (@eq R) Rle Rlt IQR nat_of_N pow .
+ eval_formula Rplus Rmult Rminus Ropp (@eq R) Rle Rlt IQR N.to_nat pow .
Lemma Reval_formula_compat : forall env f, Reval_formula env f <-> Reval_formula' env f.
Proof.
diff --git a/plugins/micromega/Refl.v b/plugins/micromega/Refl.v
index b839195c..43bfb4d7 100644
--- a/plugins/micromega/Refl.v
+++ b/plugins/micromega/Refl.v
@@ -1,7 +1,7 @@
(* -*- coding: utf-8 -*- *)
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/micromega/RingMicromega.v b/plugins/micromega/RingMicromega.v
index 4af65086..fccacc74 100644
--- a/plugins/micromega/RingMicromega.v
+++ b/plugins/micromega/RingMicromega.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -142,7 +142,7 @@ Qed.
Definition PolC := Pol C. (* polynomials in generalized Horner form, defined in Ring_polynom or EnvRing *)
Definition PolEnv := Env R. (* For interpreting PolC *)
Definition eval_pol (env : PolEnv) (p:PolC) : R :=
- Pphi 0 rplus rtimes phi env p.
+ Pphi rplus rtimes phi env p.
Inductive Op1 : Set := (* relations with 0 *)
| Equal (* == 0 *)
@@ -320,7 +320,7 @@ Definition map_option2 (A B C : Type) (f : A -> B -> option C)
Arguments map_option2 [A B C] f o o'.
-Definition Rops_wd := mk_reqe rplus rtimes ropp req
+Definition Rops_wd := mk_reqe (*rplus rtimes ropp req*)
sor.(SORplus_wd)
sor.(SORtimes_wd)
sor.(SORopp_wd).
@@ -469,17 +469,11 @@ Fixpoint ge_bool (n m : nat) : bool :=
end
end.
-Lemma ge_bool_cases : forall n m, (if ge_bool n m then n >= m else n < m)%nat.
+Lemma ge_bool_cases : forall n m,
+ (if ge_bool n m then n >= m else n < m)%nat.
Proof.
- induction n ; simpl.
- destruct m ; simpl.
- constructor.
- omega.
- destruct m.
- constructor.
- omega.
- generalize (IHn m).
- destruct (ge_bool n m) ; omega.
+ induction n; destruct m ; simpl; auto with arith.
+ specialize (IHn m). destruct (ge_bool); auto with arith.
Qed.
@@ -593,7 +587,7 @@ Definition paddC := PaddC cplus.
Definition psubC := PsubC cminus.
Definition PsubC_ok : forall c P env, eval_pol env (psubC P c) == eval_pol env P - [c] :=
- let Rops_wd := mk_reqe rplus rtimes ropp req
+ let Rops_wd := mk_reqe (*rplus rtimes ropp req*)
sor.(SORplus_wd)
sor.(SORtimes_wd)
sor.(SORopp_wd) in
@@ -601,7 +595,7 @@ Definition PsubC_ok : forall c P env, eval_pol env (psubC P c) == eval_pol env
addon.(SORrm).
Definition PaddC_ok : forall c P env, eval_pol env (paddC P c) == eval_pol env P + [c] :=
- let Rops_wd := mk_reqe rplus rtimes ropp req
+ let Rops_wd := mk_reqe (*rplus rtimes ropp req*)
sor.(SORplus_wd)
sor.(SORtimes_wd)
sor.(SORopp_wd) in
@@ -882,13 +876,14 @@ Qed.
Fixpoint xdenorm (jmp : positive) (p: Pol C) : PExpr C :=
match p with
| Pc c => PEc c
- | Pinj j p => xdenorm (Pplus j jmp ) p
+ | Pinj j p => xdenorm (Pos.add j jmp ) p
| PX p j q => PEadd
(PEmul (xdenorm jmp p) (PEpow (PEX _ jmp) (Npos j)))
- (xdenorm (Psucc jmp) q)
+ (xdenorm (Pos.succ jmp) q)
end.
-Lemma xdenorm_correct : forall p i env, eval_pol (jump i env) p == eval_pexpr env (xdenorm (Psucc i) p).
+Lemma xdenorm_correct : forall p i env,
+ eval_pol (jump i env) p == eval_pexpr env (xdenorm (Pos.succ i) p).
Proof.
unfold eval_pol.
induction p.
@@ -896,22 +891,21 @@ Proof.
(* Pinj *)
simpl.
intros.
- rewrite Pplus_succ_permute_r.
+ rewrite Pos.add_succ_r.
rewrite <- IHp.
symmetry.
- rewrite Pplus_comm.
- rewrite Pjump_Pplus. reflexivity.
+ rewrite Pos.add_comm.
+ rewrite Pjump_add. reflexivity.
(* PX *)
simpl.
intros.
- rewrite <- IHp1.
- rewrite <- IHp2.
+ rewrite <- IHp1, <- IHp2.
unfold Env.tail , Env.hd.
- rewrite <- Pjump_Pplus.
- rewrite <- Pplus_one_succ_r.
+ rewrite <- Pjump_add.
+ rewrite Pos.add_1_r.
unfold Env.nth.
unfold jump at 2.
- rewrite Pplus_one_succ_l.
+ rewrite <- Pos.add_1_l.
rewrite addon.(SORpower).(rpow_pow_N).
unfold pow_N. ring.
Qed.
@@ -924,14 +918,14 @@ Proof.
induction p.
reflexivity.
simpl.
- rewrite <- Pplus_one_succ_r.
+ rewrite Pos.add_1_r.
apply xdenorm_correct.
simpl.
intros.
rewrite IHp1.
unfold Env.tail.
rewrite xdenorm_correct.
- change (Psucc xH) with 2%positive.
+ change (Pos.succ xH) with 2%positive.
rewrite addon.(SORpower).(rpow_pow_N).
simpl. reflexivity.
Qed.
diff --git a/plugins/micromega/Tauto.v b/plugins/micromega/Tauto.v
index b3ccdfcc..440070a1 100644
--- a/plugins/micromega/Tauto.v
+++ b/plugins/micromega/Tauto.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/micromega/VarMap.v b/plugins/micromega/VarMap.v
index f41252b7..9ff8044e 100644
--- a/plugins/micromega/VarMap.v
+++ b/plugins/micromega/VarMap.v
@@ -1,7 +1,7 @@
(* -*- coding: utf-8 -*- *)
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/micromega/ZCoeff.v b/plugins/micromega/ZCoeff.v
index 2bf3d8c3..e30295e6 100644
--- a/plugins/micromega/ZCoeff.v
+++ b/plugins/micromega/ZCoeff.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -109,7 +109,7 @@ Qed.
Lemma Zring_morph :
ring_morph 0 1 rplus rtimes rminus ropp req
- 0%Z 1%Z Zplus Zmult Zminus Zopp
+ 0%Z 1%Z Z.add Z.mul Z.sub Z.opp
Zeq_bool gen_order_phi_Z.
Proof.
exact (gen_phiZ_morph sor.(SORsetoid) ring_ops_wd sor.(SORrt)).
@@ -122,7 +122,7 @@ try apply (Rplus_pos_pos sor); try apply (Rtimes_pos_pos sor); try apply (Rplus_
try apply (Rlt_0_1 sor); assumption.
Qed.
-Lemma phi_pos1_succ : forall x : positive, phi_pos1 (Psucc x) == 1 + phi_pos1 x.
+Lemma phi_pos1_succ : forall x : positive, phi_pos1 (Pos.succ x) == 1 + phi_pos1 x.
Proof.
exact (ARgen_phiPOS_Psucc sor.(SORsetoid) ring_ops_wd
(Rth_ARth sor.(SORsetoid) ring_ops_wd sor.(SORrt))).
@@ -130,7 +130,7 @@ Qed.
Lemma clt_pos_morph : forall x y : positive, (x < y)%positive -> phi_pos1 x < phi_pos1 y.
Proof.
-intros x y H. pattern y; apply Plt_ind with x.
+intros x y H. pattern y; apply Pos.lt_ind with x.
rewrite phi_pos1_succ; apply (Rlt_succ_r sor).
clear y H; intros y _ H. rewrite phi_pos1_succ. now apply (Rlt_lt_succ sor).
assumption.
@@ -150,9 +150,9 @@ apply -> (Ropp_lt_mono sor); apply clt_pos_morph.
red. now rewrite Pos.compare_antisym.
Qed.
-Lemma Zcleb_morph : forall x y : Z, Zle_bool x y = true -> [x] <= [y].
+Lemma Zcleb_morph : forall x y : Z, Z.leb x y = true -> [x] <= [y].
Proof.
-unfold Zle_bool; intros x y H.
+unfold Z.leb; intros x y H.
case_eq (x ?= y)%Z; intro H1; rewrite H1 in H.
le_equal. apply Zring_morph.(morph_eq). unfold Zeq_bool; now rewrite H1.
le_less. now apply clt_morph.
@@ -162,9 +162,9 @@ Qed.
Lemma Zcneqb_morph : forall x y : Z, Zeq_bool x y = false -> [x] ~= [y].
Proof.
intros x y H. unfold Zeq_bool in H.
-case_eq (Zcompare x y); intro H1; rewrite H1 in *; (discriminate || clear H).
+case_eq (Z.compare x y); intro H1; rewrite H1 in *; (discriminate || clear H).
apply (Rlt_neq sor). now apply clt_morph.
-fold (x > y)%Z in H1. rewrite Zgt_iff_lt in H1.
+fold (x > y)%Z in H1. rewrite Z.gt_lt_iff in H1.
apply (Rneq_symm sor). apply (Rlt_neq sor). now apply clt_morph.
Qed.
diff --git a/plugins/micromega/ZMicromega.v b/plugins/micromega/ZMicromega.v
index 461f53b5..bdc4671d 100644
--- a/plugins/micromega/ZMicromega.v
+++ b/plugins/micromega/ZMicromega.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -34,20 +34,20 @@ Require Import EnvRing.
Open Scope Z_scope.
-Lemma Zsor : SOR 0 1 Zplus Zmult Zminus Zopp (@eq Z) Zle Zlt.
+Lemma Zsor : SOR 0 1 Z.add Z.mul Z.sub Z.opp (@eq Z) Z.le Z.lt.
Proof.
constructor ; intros ; subst ; try (intuition (auto with zarith)).
apply Zsth.
apply Zth.
- destruct (Ztrichotomy n m) ; intuition (auto with zarith).
- apply Zmult_lt_0_compat ; auto.
+ destruct (Z.lt_trichotomy n m) ; intuition.
+ apply Z.mul_pos_pos ; auto.
Qed.
Lemma ZSORaddon :
- SORaddon 0 1 Zplus Zmult Zminus Zopp (@eq Z) Zle (* ring elements *)
- 0%Z 1%Z Zplus Zmult Zminus Zopp (* coefficients *)
- Zeq_bool Zle_bool
- (fun x => x) (fun x => x) (pow_N 1 Zmult).
+ SORaddon 0 1 Z.add Z.mul Z.sub Z.opp (@eq Z) Z.le (* ring elements *)
+ 0%Z 1%Z Z.add Z.mul Z.sub Z.opp (* coefficients *)
+ Zeq_bool Z.leb
+ (fun x => x) (fun x => x) (pow_N 1 Z.mul).
Proof.
constructor.
constructor ; intros ; try reflexivity.
@@ -65,20 +65,20 @@ Fixpoint Zeval_expr (env : PolEnv Z) (e: PExpr Z) : Z :=
| PEX x => env x
| PEadd e1 e2 => Zeval_expr env e1 + Zeval_expr env e2
| PEmul e1 e2 => Zeval_expr env e1 * Zeval_expr env e2
- | PEpow e1 n => Zpower (Zeval_expr env e1) (Z_of_N n)
+ | PEpow e1 n => Z.pow (Zeval_expr env e1) (Z.of_N n)
| PEsub e1 e2 => (Zeval_expr env e1) - (Zeval_expr env e2)
- | PEopp e => Zopp (Zeval_expr env e)
+ | PEopp e => Z.opp (Zeval_expr env e)
end.
-Definition eval_expr := eval_pexpr Zplus Zmult Zminus Zopp (fun x => x) (fun x => x) (pow_N 1 Zmult).
+Definition eval_expr := eval_pexpr Z.add Z.mul Z.sub Z.opp (fun x => x) (fun x => x) (pow_N 1 Z.mul).
-Lemma ZNpower : forall r n, r ^ Z_of_N n = pow_N 1 Zmult r n.
+Lemma ZNpower : forall r n, r ^ Z.of_N n = pow_N 1 Z.mul r n.
Proof.
destruct n.
reflexivity.
simpl.
- unfold Zpower_pos.
- replace (pow_pos Zmult r p) with (1 * (pow_pos Zmult r p)) by ring.
+ unfold Z.pow_pos.
+ replace (pow_pos Z.mul r p) with (1 * (pow_pos Z.mul r p)) by ring.
generalize 1.
induction p; simpl ; intros ; repeat rewrite IHp ; ring.
Qed.
@@ -94,10 +94,10 @@ Definition Zeval_op2 (o : Op2) : Z -> Z -> Prop :=
match o with
| OpEq => @eq Z
| OpNEq => fun x y => ~ x = y
-| OpLe => Zle
-| OpGe => Zge
-| OpLt => Zlt
-| OpGt => Zgt
+| OpLe => Z.le
+| OpGe => Z.ge
+| OpLt => Z.lt
+| OpGt => Z.gt
end.
Definition Zeval_formula (env : PolEnv Z) (f : Formula Z):=
@@ -105,23 +105,23 @@ Definition Zeval_formula (env : PolEnv Z) (f : Formula Z):=
(Zeval_op2 op) (Zeval_expr env lhs) (Zeval_expr env rhs).
Definition Zeval_formula' :=
- eval_formula Zplus Zmult Zminus Zopp (@eq Z) Zle Zlt (fun x => x) (fun x => x) (pow_N 1 Zmult).
+ eval_formula Z.add Z.mul Z.sub Z.opp (@eq Z) Z.le Z.lt (fun x => x) (fun x => x) (pow_N 1 Z.mul).
Lemma Zeval_formula_compat : forall env f, Zeval_formula env f <-> Zeval_formula' env f.
Proof.
destruct f ; simpl.
rewrite Zeval_expr_compat. rewrite Zeval_expr_compat.
unfold eval_expr.
- generalize (eval_pexpr Zplus Zmult Zminus Zopp (fun x : Z => x)
- (fun x : N => x) (pow_N 1 Zmult) env Flhs).
- generalize ((eval_pexpr Zplus Zmult Zminus Zopp (fun x : Z => x)
- (fun x : N => x) (pow_N 1 Zmult) env Frhs)).
+ generalize (eval_pexpr Z.add Z.mul Z.sub Z.opp (fun x : Z => x)
+ (fun x : N => x) (pow_N 1 Z.mul) env Flhs).
+ generalize ((eval_pexpr Z.add Z.mul Z.sub Z.opp (fun x : Z => x)
+ (fun x : N => x) (pow_N 1 Z.mul) env Frhs)).
destruct Fop ; simpl; intros ; intuition (auto with zarith).
Qed.
Definition eval_nformula :=
- eval_nformula 0 Zplus Zmult (@eq Z) Zle Zlt (fun x => x) .
+ eval_nformula 0 Z.add Z.mul (@eq Z) Z.le Z.lt (fun x => x) .
Definition Zeval_op1 (o : Op1) : Z -> Prop :=
match o with
@@ -140,7 +140,7 @@ Qed.
Definition ZWitness := Psatz Z.
-Definition ZWeakChecker := check_normalised_formulas 0 1 Zplus Zmult Zeq_bool Zle_bool.
+Definition ZWeakChecker := check_normalised_formulas 0 1 Z.add Z.mul Zeq_bool Z.leb.
Lemma ZWeakChecker_sound : forall (l : list (NFormula Z)) (cm : ZWitness),
ZWeakChecker l cm = true ->
@@ -154,13 +154,13 @@ Proof.
exact H.
Qed.
-Definition psub := psub Z0 Zplus Zminus Zopp Zeq_bool.
+Definition psub := psub Z0 Z.add Z.sub Z.opp Zeq_bool.
-Definition padd := padd Z0 Zplus Zeq_bool.
+Definition padd := padd Z0 Z.add Zeq_bool.
-Definition norm := norm 0 1 Zplus Zmult Zminus Zopp Zeq_bool.
+Definition norm := norm 0 1 Z.add Z.mul Z.sub Z.opp Zeq_bool.
-Definition eval_pol := eval_pol 0 Zplus Zmult (fun x => x).
+Definition eval_pol := eval_pol Z.add Z.mul (fun x => x).
Lemma eval_pol_sub : forall env lhs rhs, eval_pol env (psub lhs rhs) = eval_pol env lhs - eval_pol env rhs.
Proof.
@@ -211,10 +211,10 @@ Proof.
repeat rewrite eval_pol_add;
repeat rewrite <- eval_pol_norm ; simpl in *;
unfold eval_expr;
- generalize ( eval_pexpr Zplus Zmult Zminus Zopp (fun x : Z => x)
- (fun x : N => x) (pow_N 1 Zmult) env lhs);
- generalize (eval_pexpr Zplus Zmult Zminus Zopp (fun x : Z => x)
- (fun x : N => x) (pow_N 1 Zmult) env rhs) ; intros z1 z2 ; intros ; subst;
+ generalize ( eval_pexpr Z.add Z.mul Z.sub Z.opp (fun x : Z => x)
+ (fun x : N => x) (pow_N 1 Z.mul) env lhs);
+ generalize (eval_pexpr Z.add Z.mul Z.sub Z.opp (fun x : Z => x)
+ (fun x : N => x) (pow_N 1 Z.mul) env rhs) ; intros z1 z2 ; intros ; subst;
intuition (auto with zarith).
Transparent padd.
Qed.
@@ -248,17 +248,17 @@ Proof.
repeat rewrite eval_pol_add;
repeat rewrite <- eval_pol_norm ; simpl in *;
unfold eval_expr;
- generalize ( eval_pexpr Zplus Zmult Zminus Zopp (fun x : Z => x)
- (fun x : N => x) (pow_N 1 Zmult) env lhs);
- generalize (eval_pexpr Zplus Zmult Zminus Zopp (fun x : Z => x)
- (fun x : N => x) (pow_N 1 Zmult) env rhs) ; intros z1 z2 ; intros ; subst;
+ generalize ( eval_pexpr Z.add Z.mul Z.sub Z.opp (fun x : Z => x)
+ (fun x : N => x) (pow_N 1 Z.mul) env lhs);
+ generalize (eval_pexpr Z.add Z.mul Z.sub Z.opp (fun x : Z => x)
+ (fun x : N => x) (pow_N 1 Z.mul) env rhs) ; intros z1 z2 ; intros ; subst;
intuition (auto with zarith).
Transparent padd.
Qed.
-Definition Zunsat := check_inconsistent 0 Zeq_bool Zle_bool.
+Definition Zunsat := check_inconsistent 0 Zeq_bool Z.leb.
-Definition Zdeduce := nformula_plus_nformula 0 Zplus Zeq_bool.
+Definition Zdeduce := nformula_plus_nformula 0 Z.add Zeq_bool.
Definition ZweakTautoChecker (w: list ZWitness) (f : BFormula (Formula Z)) : bool :=
@@ -270,7 +270,7 @@ Require Import Zdiv.
Open Scope Z_scope.
Definition ceiling (a b:Z) : Z :=
- let (q,r) := Zdiv_eucl a b in
+ let (q,r) := Z.div_eucl a b in
match r with
| Z0 => q
| _ => q + 1
@@ -279,47 +279,38 @@ Definition ceiling (a b:Z) : Z :=
Require Import Znumtheory.
-Lemma Zdivide_ceiling : forall a b, (b | a) -> ceiling a b = Zdiv a b.
+Lemma Zdivide_ceiling : forall a b, (b | a) -> ceiling a b = Z.div a b.
Proof.
unfold ceiling.
intros.
apply Zdivide_mod in H.
- case_eq (Zdiv_eucl a b).
+ case_eq (Z.div_eucl a b).
intros.
change z with (fst (z,z0)).
rewrite <- H0.
- change (fst (Zdiv_eucl a b)) with (Zdiv a b).
+ change (fst (Z.div_eucl a b)) with (Z.div a b).
change z0 with (snd (z,z0)).
rewrite <- H0.
- change (snd (Zdiv_eucl a b)) with (Zmod a b).
+ change (snd (Z.div_eucl a b)) with (Z.modulo a b).
rewrite H.
reflexivity.
Qed.
-Lemma narrow_interval_lower_bound : forall a b x, a > 0 -> a * x >= b -> x >= ceiling b a.
+Lemma narrow_interval_lower_bound a b x :
+ a > 0 -> a * x >= b -> x >= ceiling b a.
Proof.
+ rewrite !Z.ge_le_iff.
unfold ceiling.
- intros.
- generalize (Z_div_mod b a H).
- destruct (Zdiv_eucl b a).
- intros.
- destruct H1.
- destruct H2.
- subst.
- destruct (Ztrichotomy z0 0) as [ HH1 | [HH2 | HH3]]; destruct z0 ; try auto with zarith ; try discriminate.
- assert (HH :x >= z \/ x < z) by (destruct (Ztrichotomy x z) ; auto with zarith).
- destruct HH ;auto.
- generalize (Zmult_lt_compat_l _ _ _ H3 H1).
- auto with zarith.
- clear H2.
- assert (HH :x >= z +1 \/ x <= z) by (destruct (Ztrichotomy x z) ; intuition (auto with zarith)).
- destruct HH ;auto.
- assert (0 < a) by auto with zarith.
- generalize (Zmult_lt_0_le_compat_r _ _ _ H2 H1).
- intros.
- rewrite Zmult_comm in H4.
- rewrite (Zmult_comm z) in H4.
- auto with zarith.
+ intros Ha H.
+ generalize (Z_div_mod b a Ha).
+ destruct (Z.div_eucl b a) as (q,r). intros (->,(H1,H2)).
+ destruct r as [|r|r].
+ - rewrite Z.add_0_r in H.
+ apply Z.mul_le_mono_pos_l in H; auto with zarith.
+ - assert (0 < Z.pos r) by easy.
+ rewrite Z.add_1_r, Z.le_succ_l.
+ apply Z.mul_lt_mono_pos_l with a; auto with zarith.
+ - now elim H1.
Qed.
(** NB: narrow_interval_upper_bound is Zdiv.Zdiv_le_lower_bound *)
@@ -360,7 +351,7 @@ Proof.
destruct x ; simpl ; intuition congruence.
Qed.
-Definition ZgcdM (x y : Z) := Zmax (Zgcd x y) 1.
+Definition ZgcdM (x y : Z) := Z.max (Z.gcd x y) 1.
Fixpoint Zgcd_pol (p : PolC Z) : (Z * Z) :=
@@ -378,7 +369,7 @@ Fixpoint Zgcd_pol (p : PolC Z) : (Z * Z) :=
Fixpoint Zdiv_pol (p:PolC Z) (x:Z) : PolC Z :=
match p with
- | Pc c => Pc (Zdiv c x)
+ | Pc c => Pc (Z.div c x)
| Pinj j p => Pinj j (Zdiv_pol p x)
| PX p j q => PX (Zdiv_pol p x) j (Zdiv_pol q x)
end.
@@ -421,10 +412,10 @@ Proof.
intros.
simpl.
unfold ZgcdM.
- generalize (Zgcd_is_pos z1 z2).
- generalize (Zmax_spec (Zgcd z1 z2) 1).
- generalize (Zgcd_is_pos (Zmax (Zgcd z1 z2) 1) z).
- generalize (Zmax_spec (Zgcd (Zmax (Zgcd z1 z2) 1) z) 1).
+ generalize (Z.gcd_nonneg z1 z2).
+ generalize (Zmax_spec (Z.gcd z1 z2) 1).
+ generalize (Z.gcd_nonneg (Z.max (Z.gcd z1 z2) 1) z).
+ generalize (Zmax_spec (Z.gcd (Z.max (Z.gcd z1 z2) 1) z) 1).
auto with zarith.
Qed.
@@ -433,7 +424,7 @@ Proof.
intros.
induction H.
constructor.
- apply Zdivide_trans with (1:= H0) ; assumption.
+ apply Z.divide_trans with (1:= H0) ; assumption.
constructor. auto.
constructor ; auto.
Qed.
@@ -444,20 +435,20 @@ Proof.
exists c. ring.
Qed.
-Lemma Zgcd_minus : forall a b c, (a | c - b ) -> (Zgcd a b | c).
+Lemma Zgcd_minus : forall a b c, (a | c - b ) -> (Z.gcd a b | c).
Proof.
intros a b c (q,Hq).
destruct (Zgcd_is_gcd a b) as [(a',Ha) (b',Hb) _].
- set (g:=Zgcd a b) in *; clearbody g.
+ set (g:=Z.gcd a b) in *; clearbody g.
exists (q * a' + b').
- symmetry in Hq. rewrite <- Zeq_plus_swap in Hq.
+ symmetry in Hq. rewrite <- Z.add_move_r in Hq.
rewrite <- Hq, Hb, Ha. ring.
Qed.
Lemma Zdivide_pol_sub : forall p a b,
- 0 < Zgcd a b ->
- Zdivide_pol a (PsubC Zminus p b) ->
- Zdivide_pol (Zgcd a b) p.
+ 0 < Z.gcd a b ->
+ Zdivide_pol a (PsubC Z.sub p b) ->
+ Zdivide_pol (Z.gcd a b) p.
Proof.
induction p.
simpl.
@@ -477,7 +468,7 @@ Proof.
Qed.
Lemma Zdivide_pol_sub_0 : forall p a,
- Zdivide_pol a (PsubC Zminus p 0) ->
+ Zdivide_pol a (PsubC Z.sub p 0) ->
Zdivide_pol a p.
Proof.
induction p.
@@ -496,7 +487,7 @@ Qed.
Lemma Zgcd_pol_div : forall p g c,
- Zgcd_pol p = (g, c) -> Zdivide_pol g (PsubC Zminus p c).
+ Zgcd_pol p = (g, c) -> Zdivide_pol g (PsubC Z.sub p c).
Proof.
induction p ; simpl.
(* Pc *)
@@ -511,12 +502,12 @@ Proof.
case_eq (Zgcd_pol p1) ; case_eq (Zgcd_pol p3) ; intros.
inv H1.
unfold ZgcdM at 1.
- destruct (Zmax_spec (Zgcd (ZgcdM z1 z2) z) 1) as [HH1 | HH1];
+ destruct (Zmax_spec (Z.gcd (ZgcdM z1 z2) z) 1) as [HH1 | HH1];
destruct HH1 as [HH1 HH1'] ; rewrite HH1'.
constructor.
apply Zdivide_pol_Zdivide with (x:= ZgcdM z1 z2).
unfold ZgcdM.
- destruct (Zmax_spec (Zgcd z1 z2) 1) as [HH2 | HH2].
+ destruct (Zmax_spec (Z.gcd z1 z2) 1) as [HH2 | HH2].
destruct HH2.
rewrite H2.
apply Zdivide_pol_sub ; auto.
@@ -524,9 +515,9 @@ Proof.
destruct HH2. rewrite H2.
apply Zdivide_pol_one.
unfold ZgcdM in HH1. unfold ZgcdM.
- destruct (Zmax_spec (Zgcd z1 z2) 1) as [HH2 | HH2].
+ destruct (Zmax_spec (Z.gcd z1 z2) 1) as [HH2 | HH2].
destruct HH2. rewrite H2 in *.
- destruct (Zgcd_is_gcd (Zgcd z1 z2) z); auto.
+ destruct (Zgcd_is_gcd (Z.gcd z1 z2) z); auto.
destruct HH2. rewrite H2.
destruct (Zgcd_is_gcd 1 z); auto.
apply Zdivide_pol_Zdivide with (x:= z).
@@ -539,7 +530,7 @@ Qed.
-Lemma Zgcd_pol_correct_lt : forall p env g c, Zgcd_pol p = (g,c) -> 0 < g -> eval_pol env p = g * (eval_pol env (Zdiv_pol (PsubC Zminus p c) g)) + c.
+Lemma Zgcd_pol_correct_lt : forall p env g c, Zgcd_pol p = (g,c) -> 0 < g -> eval_pol env p = g * (eval_pol env (Zdiv_pol (PsubC Z.sub p c) g)) + c.
Proof.
intros.
rewrite <- Zdiv_pol_correct ; auto.
@@ -553,8 +544,8 @@ Qed.
Definition makeCuttingPlane (p : PolC Z) : PolC Z * Z :=
let (g,c) := Zgcd_pol p in
- if Zgt_bool g Z0
- then (Zdiv_pol (PsubC Zminus p c) g , Zopp (ceiling (Zopp c) g))
+ if Z.gtb g Z0
+ then (Zdiv_pol (PsubC Z.sub p c) g , Z.opp (ceiling (Z.opp c) g))
else (p,Z0).
@@ -562,13 +553,13 @@ Definition genCuttingPlane (f : NFormula Z) : option (PolC Z * Z * Op1) :=
let (e,op) := f in
match op with
| Equal => let (g,c) := Zgcd_pol e in
- if andb (Zgt_bool g Z0) (andb (negb (Zeq_bool c Z0)) (negb (Zeq_bool (Zgcd g c) g)))
+ if andb (Z.gtb g Z0) (andb (negb (Zeq_bool c Z0)) (negb (Zeq_bool (Z.gcd g c) g)))
then None (* inconsistent *)
else (* Could be optimised Zgcd_pol is recomputed *)
let (p,c) := makeCuttingPlane e in
Some (p,c,Equal)
| NonEqual => Some (e,Z0,op)
- | Strict => let (p,c) := makeCuttingPlane (PsubC Zminus e 1) in
+ | Strict => let (p,c) := makeCuttingPlane (PsubC Z.sub e 1) in
Some (p,c,NonStrict)
| NonStrict => let (p,c) := makeCuttingPlane e in
Some (p,c,NonStrict)
@@ -595,7 +586,7 @@ Qed.
Definition eval_Psatz : list (NFormula Z) -> ZWitness -> option (NFormula Z) :=
- eval_Psatz 0 1 Zplus Zmult Zeq_bool Zle_bool.
+ eval_Psatz 0 1 Z.add Z.mul Zeq_bool Z.leb.
Definition valid_cut_sign (op:Op1) :=
@@ -634,9 +625,9 @@ Fixpoint ZChecker (l:list (NFormula Z)) (pf : ZArithProof) {struct pf} : bool :
(fix label (pfs:list ZArithProof) :=
fun lb ub =>
match pfs with
- | nil => if Zgt_bool lb ub then true else false
- | pf::rsr => andb (ZChecker ((psub e1 (Pc lb), Equal) :: l) pf) (label rsr (Zplus lb 1%Z) ub)
- end) pf (Zopp z1) z2
+ | nil => if Z.gtb lb ub then true else false
+ | pf::rsr => andb (ZChecker ((psub e1 (Pc lb), Equal) :: l) pf) (label rsr (Z.add lb 1%Z) ub)
+ end) pf (Z.opp z1) z2
else false
| _ , _ => true
end
@@ -710,12 +701,12 @@ Proof.
unfold makeCuttingPlane in H0.
revert H0.
case_eq (Zgcd_pol e) ; intros g c0.
- generalize (Zgt_cases g 0) ; destruct (Zgt_bool g 0).
+ generalize (Zgt_cases g 0) ; destruct (Z.gtb g 0).
intros.
inv H2.
- change (RingMicromega.eval_pol 0 Zplus Zmult (fun x : Z => x)) with eval_pol in *.
+ change (RingMicromega.eval_pol Z.add Z.mul (fun x : Z => x)) with eval_pol in *.
apply Zgcd_pol_correct_lt with (env:=env) in H1.
- generalize (narrow_interval_lower_bound g (- c0) (eval_pol env (Zdiv_pol (PsubC Zminus e c0) g)) H0).
+ generalize (narrow_interval_lower_bound g (- c0) (eval_pol env (Zdiv_pol (PsubC Z.sub e c0) g)) H0).
auto with zarith.
auto with zarith.
(* g <= 0 *)
@@ -733,7 +724,7 @@ Proof.
(* Equal *)
destruct p as [[e' z] op].
case_eq (Zgcd_pol e) ; intros g c.
- case_eq (Zgt_bool g 0 && (negb (Zeq_bool c 0) && negb (Zeq_bool (Zgcd g c) g))) ; [discriminate|].
+ case_eq (Z.gtb g 0 && (negb (Zeq_bool c 0) && negb (Zeq_bool (Z.gcd g c) g))) ; [discriminate|].
case_eq (makeCuttingPlane e).
intros.
inv H3.
@@ -741,7 +732,7 @@ Proof.
rewrite H1 in H.
revert H.
change (eval_pol env e = 0) in H2.
- case_eq (Zgt_bool g 0).
+ case_eq (Z.gtb g 0).
intros.
rewrite <- Zgt_is_gt_bool in H.
rewrite Zgcd_pol_correct_lt with (1:= H1) in H2; auto with zarith.
@@ -749,7 +740,7 @@ Proof.
change (eval_pol env (padd e' (Pc z)) = 0).
inv H3.
rewrite eval_pol_add.
- set (x:=eval_pol env (Zdiv_pol (PsubC Zminus e c) g)) in *; clearbody x.
+ set (x:=eval_pol env (Zdiv_pol (PsubC Z.sub e c) g)) in *; clearbody x.
simpl.
rewrite andb_false_iff in H0.
destruct H0.
@@ -759,8 +750,7 @@ Proof.
rewrite negb_false_iff in H0.
apply Zeq_bool_eq in H0.
subst. simpl.
- rewrite Zplus_0_r in H2.
- apply Zmult_integral in H2.
+ rewrite Z.add_0_r, Z.mul_eq_0 in H2.
intuition auto with zarith.
rewrite negb_false_iff in H0.
apply Zeq_bool_eq in H0.
@@ -769,7 +759,7 @@ Proof.
inv HH.
apply Zdivide_opp_r in H4.
rewrite Zdivide_ceiling ; auto.
- apply Zeq_minus.
+ apply Z.sub_move_0_r.
apply Z.div_unique_exact ; auto with zarith.
intros.
unfold nformula_of_cutting_plane.
@@ -789,7 +779,7 @@ Proof.
simpl. auto with zarith.
(* Strict *)
destruct p as [[e' z] op].
- case_eq (makeCuttingPlane (PsubC Zminus e 1)).
+ case_eq (makeCuttingPlane (PsubC Z.sub e 1)).
intros.
inv H1.
apply makeCuttingPlane_ns_sound with (env:=env) (2:= H).
@@ -813,7 +803,7 @@ Proof.
destruct f.
destruct o.
case_eq (Zgcd_pol p) ; intros g c.
- case_eq (Zgt_bool g 0 && (negb (Zeq_bool c 0) && negb (Zeq_bool (Zgcd g c) g))).
+ case_eq (Z.gtb g 0 && (negb (Zeq_bool c 0) && negb (Zeq_bool (Z.gcd g c) g))).
intros.
flatten_bool.
rewrite negb_true_iff in H5.
@@ -823,16 +813,16 @@ Proof.
apply Zeq_bool_neq in H.
change (eval_pol env p = 0) in H2.
rewrite Zgcd_pol_correct_lt with (1:= H0) in H2; auto with zarith.
- set (x:=eval_pol env (Zdiv_pol (PsubC Zminus p c) g)) in *; clearbody x.
+ set (x:=eval_pol env (Zdiv_pol (PsubC Z.sub p c) g)) in *; clearbody x.
contradict H5.
apply Zis_gcd_gcd; auto with zarith.
constructor; auto with zarith.
exists (-x).
- rewrite <- Zopp_mult_distr_l, Zmult_comm; auto with zarith.
+ rewrite Z.mul_opp_l, Z.mul_comm; auto with zarith.
(**)
destruct (makeCuttingPlane p); discriminate.
discriminate.
- destruct (makeCuttingPlane (PsubC Zminus p 1)) ; discriminate.
+ destruct (makeCuttingPlane (PsubC Z.sub p 1)) ; discriminate.
destruct (makeCuttingPlane p) ; discriminate.
Qed.
@@ -920,7 +910,7 @@ Proof.
unfold nformula_of_cutting_plane in HCutR.
unfold eval_nformula in HCutR.
unfold RingMicromega.eval_nformula in HCutR.
- change (RingMicromega.eval_pol 0 Zplus Zmult (fun x : Z => x)) with eval_pol in HCutR.
+ change (RingMicromega.eval_pol Z.add Z.mul (fun x : Z => x)) with eval_pol in HCutR.
unfold eval_op1 in HCutR.
destruct op1 ; simpl in Hop1 ; try discriminate;
rewrite eval_pol_add in HCutR; simpl in HCutR; auto with zarith.
@@ -933,7 +923,7 @@ Proof.
unfold nformula_of_cutting_plane in HCutL.
unfold eval_nformula in HCutL.
unfold RingMicromega.eval_nformula in HCutL.
- change (RingMicromega.eval_pol 0 Zplus Zmult (fun x : Z => x)) with eval_pol in HCutL.
+ change (RingMicromega.eval_pol Z.add Z.mul (fun x : Z => x)) with eval_pol in HCutL.
unfold eval_op1 in HCutL.
rewrite eval_pol_add in HCutL. simpl in HCutL.
destruct op2 ; simpl in Hop2 ; try discriminate ; omega.
@@ -944,14 +934,14 @@ Proof.
intros.
assert (HH :forall x, -z1 <= x <= z2 -> exists pr,
(In pr pf /\
- ZChecker ((PsubC Zminus p1 x,Equal) :: l) pr = true)%Z).
+ ZChecker ((PsubC Z.sub p1 x,Equal) :: l) pr = true)%Z).
clear HZ0 Hop1 Hop2 HCutL HCutR H0 H1.
revert Hfix.
generalize (-z1). clear z1. intro z1.
revert z1 z2.
induction pf;simpl ;intros.
generalize (Zgt_cases z1 z2).
- destruct (Zgt_bool z1 z2).
+ destruct (Z.gtb z1 z2).
intros.
apply False_ind ; omega.
discriminate.
@@ -972,7 +962,7 @@ Proof.
zify. omega.
(*/asser *)
destruct (HH _ H1) as [pr [Hin Hcheker]].
- assert (make_impl (eval_nformula env) ((PsubC Zminus p1 (eval_pol env p1),Equal) :: l) False).
+ assert (make_impl (eval_nformula env) ((PsubC Z.sub p1 (eval_pol env p1),Equal) :: l) False).
apply (H pr);auto.
apply in_bdepth ; auto.
rewrite <- make_conj_impl in H2.
diff --git a/plugins/micromega/certificate.ml b/plugins/micromega/certificate.ml
index 540d1b9c..25579a87 100644
--- a/plugins/micromega/certificate.ml
+++ b/plugins/micromega/certificate.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/micromega/coq_micromega.ml b/plugins/micromega/coq_micromega.ml
index 8b7ee55b..2020447f 100644
--- a/plugins/micromega/coq_micromega.ml
+++ b/plugins/micromega/coq_micromega.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -300,6 +300,8 @@ struct
["Coq";"Reals" ; "Rpow_def"] ;
]
+ let z_modules = [["Coq";"ZArith";"BinInt"]]
+
(**
* Initialization : a large amount of Caml symbols are derived from
* ZMicromega.v
@@ -309,6 +311,7 @@ struct
let constant = gen_constant_in_modules "ZMicromega" coq_modules
let bin_constant = gen_constant_in_modules "ZMicromega" bin_module
let r_constant = gen_constant_in_modules "ZMicromega" r_modules
+ let z_constant = gen_constant_in_modules "ZMicromega" z_modules
(* let constant = gen_constant_in_modules "Omicron" coq_modules *)
let coq_and = lazy (init_constant "and")
@@ -371,17 +374,17 @@ struct
let coq_cutProof = lazy (constant "CutProof")
let coq_enumProof = lazy (constant "EnumProof")
- let coq_Zgt = lazy (constant "Zgt")
- let coq_Zge = lazy (constant "Zge")
- let coq_Zle = lazy (constant "Zle")
- let coq_Zlt = lazy (constant "Zlt")
+ let coq_Zgt = lazy (z_constant "Z.gt")
+ let coq_Zge = lazy (z_constant "Z.ge")
+ let coq_Zle = lazy (z_constant "Z.le")
+ let coq_Zlt = lazy (z_constant "Z.lt")
let coq_Eq = lazy (init_constant "eq")
- let coq_Zplus = lazy (constant "Zplus")
- let coq_Zminus = lazy (constant "Zminus")
- let coq_Zopp = lazy (constant "Zopp")
- let coq_Zmult = lazy (constant "Zmult")
- let coq_Zpower = lazy (constant "Zpower")
+ let coq_Zplus = lazy (z_constant "Z.add")
+ let coq_Zminus = lazy (z_constant "Z.sub")
+ let coq_Zopp = lazy (z_constant "Z.opp")
+ let coq_Zmult = lazy (z_constant "Z.mul")
+ let coq_Zpower = lazy (z_constant "Z.pow")
let coq_Qgt = lazy (constant "Qgt")
let coq_Qge = lazy (constant "Qge")
diff --git a/plugins/micromega/csdpcert.ml b/plugins/micromega/csdpcert.ml
index 1604b0eb..dfda5984 100644
--- a/plugins/micromega/csdpcert.ml
+++ b/plugins/micromega/csdpcert.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/micromega/g_micromega.ml4 b/plugins/micromega/g_micromega.ml4
index 3b6b6987..0d888f85 100644
--- a/plugins/micromega/g_micromega.ml4
+++ b/plugins/micromega/g_micromega.ml4
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/micromega/mutils.ml b/plugins/micromega/mutils.ml
index c4dbf6af..ccbf0406 100644
--- a/plugins/micromega/mutils.ml
+++ b/plugins/micromega/mutils.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/micromega/persistent_cache.ml b/plugins/micromega/persistent_cache.ml
index ed9fdcea..cb7a9280 100644
--- a/plugins/micromega/persistent_cache.ml
+++ b/plugins/micromega/persistent_cache.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -95,14 +95,24 @@ let read_key_elem inch =
| End_of_file -> None
| _ -> raise InvalidTableFormat
+(** In win32, it seems that we should unlock the exact zone
+ that has been locked, and not the whole file *)
-let unlock fd =
- try
- let pos = lseek fd 0 SEEK_CUR in
- ignore (lseek fd 0 SEEK_SET) ;
- lockf fd F_ULOCK 0 ;
+let locked_start = ref 0
+
+let lock fd =
+ locked_start := lseek fd 0 SEEK_CUR;
+ lockf fd F_LOCK 0
+
+let rlock fd =
+ locked_start := lseek fd 0 SEEK_CUR;
+ lockf fd F_RLOCK 0
+
+let unlock fd =
+ let pos = lseek fd 0 SEEK_CUR in
+ ignore (lseek fd !locked_start SEEK_SET);
+ lockf fd F_ULOCK 0;
ignore (lseek fd pos SEEK_SET)
- with exc -> failwith (Printexc.to_string exc)
let open_in f =
let flags = [O_RDONLY ; O_CREAT] in
@@ -118,7 +128,7 @@ let open_in f =
xload () in
try
(* Locking of the (whole) file while reading *)
- lockf finch F_RLOCK 0 ;
+ rlock finch;
finally
(fun () -> xload () )
(fun () ->
@@ -136,7 +146,7 @@ let open_in f =
let flags = [O_WRONLY; O_TRUNC;O_CREAT] in
let out = (openfile f flags 0o666) in
let outch = out_channel_of_descr out in
- lockf out F_LOCK 0 ;
+ lock out;
(try
Table.iter
(fun k e -> Marshal.to_channel outch (k,e) [Marshal.No_sharing]) htbl;
@@ -168,8 +178,8 @@ let add t k e =
let fd = descr_of_out_channel outch in
begin
Table.add tbl k e ;
- lockf fd F_LOCK 0 ;
- ignore (lseek fd 0 SEEK_END) ;
+ lock fd;
+ ignore (lseek fd 0 SEEK_END);
Marshal.to_channel outch (k,e) [Marshal.No_sharing] ;
flush outch ;
unlock fd
diff --git a/plugins/micromega/polynomial.ml b/plugins/micromega/polynomial.ml
index 14d312a5..36b05a72 100644
--- a/plugins/micromega/polynomial.ml
+++ b/plugins/micromega/polynomial.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/micromega/sos.mli b/plugins/micromega/sos.mli
index 3d907e19..bc08d3c9 100644
--- a/plugins/micromega/sos.mli
+++ b/plugins/micromega/sos.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/micromega/sos_types.ml b/plugins/micromega/sos_types.ml
index 91aa5855..f9d2fb0b 100644
--- a/plugins/micromega/sos_types.ml
+++ b/plugins/micromega/sos_types.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/nsatz/Nsatz.v b/plugins/nsatz/Nsatz.v
index 9a0c9090..4f4f2039 100644
--- a/plugins/nsatz/Nsatz.v
+++ b/plugins/nsatz/Nsatz.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -64,15 +64,15 @@ Definition PEZ := PExpr Z.
Definition P0Z : PolZ := P0 (C:=Z) 0%Z.
Definition PolZadd : PolZ -> PolZ -> PolZ :=
- @Padd Z 0%Z Zplus Zeq_bool.
+ @Padd Z 0%Z Z.add Zeq_bool.
Definition PolZmul : PolZ -> PolZ -> PolZ :=
- @Pmul Z 0%Z 1%Z Zplus Zmult Zeq_bool.
+ @Pmul Z 0%Z 1%Z Z.add Z.mul Zeq_bool.
Definition PolZeq := @Peq Z Zeq_bool.
Definition norm :=
- @norm_aux Z 0%Z 1%Z Zplus Zmult Zminus Zopp Zeq_bool.
+ @norm_aux Z 0%Z 1%Z Z.add Z.mul Z.sub Z.opp Zeq_bool.
Fixpoint mult_l (la : list PEZ) (lp: list PolZ) : PolZ :=
match la, lp with
@@ -100,16 +100,16 @@ Definition PhiR : list R -> PolZ -> R :=
Definition PEevalR : list R -> PEZ -> R :=
PEeval ring0 add mul sub opp
(gen_phiZ ring0 ring1 add mul opp)
- nat_of_N pow.
+ N.to_nat pow.
Lemma P0Z_correct : forall l, PhiR l P0Z = 0.
Proof. trivial. Qed.
Lemma Rext: ring_eq_ext add mul opp _==_.
-apply mk_reqe. intros. rewrite H ; rewrite H0; cring.
- intros. rewrite H; rewrite H0; cring.
-intros. rewrite H; cring. Qed.
-
+Proof.
+constructor; solve_proper.
+Qed.
+
Lemma Rset : Setoid_Theory R _==_.
apply ring_setoid.
Qed.
@@ -144,17 +144,15 @@ unfold PolZmul, PhiR. intros.
Qed.
Lemma R_power_theory
- : Ring_theory.power_theory ring1 mul _==_ nat_of_N pow.
-apply Ring_theory.mkpow_th. unfold pow. intros. rewrite Nnat.N_of_nat_of_N.
+ : Ring_theory.power_theory ring1 mul _==_ N.to_nat pow.
+apply Ring_theory.mkpow_th. unfold pow. intros. rewrite Nnat.N2Nat.id.
reflexivity. Qed.
Lemma norm_correct :
forall (l : list R) (pe : PEZ), PEevalR l pe == PhiR l (norm pe).
Proof.
intros;apply (norm_aux_spec Rset Rext (Rth_ARth Rset Rext Rtheory)
- (gen_phiZ_morph Rset Rext Rtheory) R_power_theory)
- with (lmp:= List.nil).
- compute;trivial.
+ (gen_phiZ_morph Rset Rext Rtheory) R_power_theory).
Qed.
Lemma PolZeq_correct : forall P P' l,
@@ -241,9 +239,9 @@ Fixpoint interpret3 t fv {struct t}: R :=
| (PEopp t1) =>
let v1 := interpret3 t1 fv in (-v1)
| (PEpow t1 t2) =>
- let v1 := interpret3 t1 fv in pow v1 (nat_of_N t2)
+ let v1 := interpret3 t1 fv in pow v1 (N.to_nat t2)
| (PEc t1) => (IZR1 t1)
- | (PEX n) => List.nth (pred (nat_of_P n)) fv 0
+ | (PEX n) => List.nth (pred (Pos.to_nat n)) fv 0
end.
@@ -308,9 +306,9 @@ Ltac nsatz_call radicalmax info nparam p lp kont :=
lazymatch n with
| 0%N => fail
| _ =>
- (let r := eval compute in (Nminus radicalmax (Npred n)) in
+ (let r := eval compute in (N.sub radicalmax (N.pred n)) in
nsatz_call_n info nparam p r lp kont) ||
- let n' := eval compute in (Npred n) in try_n n'
+ let n' := eval compute in (N.pred n) in try_n n'
end in
try_n radicalmax.
@@ -343,7 +341,7 @@ Ltac get_lpol g :=
end.
Ltac nsatz_generic radicalmax info lparam lvar :=
- let nparam := eval compute in (Z_of_nat (List.length lparam)) in
+ let nparam := eval compute in (Z.of_nat (List.length lparam)) in
match goal with
|- ?g => let lb := lterm_goal g in
match (match lvar with
@@ -397,7 +395,7 @@ Ltac nsatz_generic radicalmax info lparam lvar :=
(*simpl*) idtac;
repeat (split;[assumption|idtac]); exact I
| (*simpl in Hg2;*) (*simpl*) idtac;
- apply Rintegral_domain_pow with (interpret3 c fv) (nat_of_N r);
+ apply Rintegral_domain_pow with (interpret3 c fv) (N.to_nat r);
(*simpl*) idtac;
try apply integral_domain_one_zero;
try apply integral_domain_minus_one_zero;
@@ -502,7 +500,7 @@ omega.
Qed.
Instance Zcri: (Cring (Rr:=Zr)).
-red. exact Zmult_comm. Defined.
+red. exact Z.mul_comm. Defined.
Instance Zdi : (Integral_domain (Rcr:=Zcri)).
constructor.
diff --git a/plugins/nsatz/ideal.ml b/plugins/nsatz/ideal.ml
index b635fd1f..996dbadd 100644
--- a/plugins/nsatz/ideal.ml
+++ b/plugins/nsatz/ideal.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/nsatz/nsatz.ml4 b/plugins/nsatz/nsatz.ml4
index a317307e..14c7609d 100644
--- a/plugins/nsatz/nsatz.ml4
+++ b/plugins/nsatz/nsatz.ml4
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/nsatz/polynom.ml b/plugins/nsatz/polynom.ml
index 45fcb2d2..0eea961d 100644
--- a/plugins/nsatz/polynom.ml
+++ b/plugins/nsatz/polynom.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/nsatz/polynom.mli b/plugins/nsatz/polynom.mli
index b82b43b1..0643327f 100644
--- a/plugins/nsatz/polynom.mli
+++ b/plugins/nsatz/polynom.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/omega/Omega.v b/plugins/omega/Omega.v
index 3f9d0f44..ea5a8cb7 100644
--- a/plugins/omega/Omega.v
+++ b/plugins/omega/Omega.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -19,9 +19,9 @@ Require Export OmegaLemmas.
Require Export PreOmega.
Declare ML Module "omega_plugin".
-Hint Resolve Zle_refl Zplus_comm Zplus_assoc Zmult_comm Zmult_assoc Zplus_0_l
- Zplus_0_r Zmult_1_l Zplus_opp_l Zplus_opp_r Zmult_plus_distr_l
- Zmult_plus_distr_r: zarith.
+Hint Resolve Z.le_refl Z.add_comm Z.add_assoc Z.mul_comm Z.mul_assoc Z.add_0_l
+ Z.add_0_r Z.mul_1_l Z.add_opp_diag_l Z.add_opp_diag_r Z.mul_add_distr_r
+ Z.mul_add_distr_l: zarith.
Require Export Zhints.
diff --git a/plugins/omega/OmegaLemmas.v b/plugins/omega/OmegaLemmas.v
index 5b6f4670..1872f576 100644
--- a/plugins/omega/OmegaLemmas.v
+++ b/plugins/omega/OmegaLemmas.v
@@ -6,232 +6,192 @@
(* * GNU Lesser General Public License Version 2.1 *)
(***********************************************************************)
-Require Import ZArith_base.
-Open Local Scope Z_scope.
+Require Import BinInt Znat.
+Local Open Scope Z_scope.
(** Factorization lemmas *)
-Theorem Zred_factor0 : forall n:Z, n = n * 1.
- intro x; rewrite (Zmult_1_r x); reflexivity.
+Theorem Zred_factor0 n : n = n * 1.
+Proof.
+ now Z.nzsimpl.
Qed.
-Theorem Zred_factor1 : forall n:Z, n + n = n * 2.
+Theorem Zred_factor1 n : n + n = n * 2.
Proof.
- exact Zplus_diag_eq_mult_2.
+ rewrite Z.mul_comm. apply Z.add_diag.
Qed.
-Theorem Zred_factor2 : forall n m:Z, n + n * m = n * (1 + m).
+Theorem Zred_factor2 n m : n + n * m = n * (1 + m).
Proof.
- intros x y; pattern x at 1 in |- *; rewrite <- (Zmult_1_r x);
- rewrite <- Zmult_plus_distr_r; trivial with arith.
+ rewrite Z.mul_add_distr_l; now Z.nzsimpl.
Qed.
-Theorem Zred_factor3 : forall n m:Z, n * m + n = n * (1 + m).
+Theorem Zred_factor3 n m : n * m + n = n * (1 + m).
Proof.
- intros x y; pattern x at 2 in |- *; rewrite <- (Zmult_1_r x);
- rewrite <- Zmult_plus_distr_r; rewrite Zplus_comm;
- trivial with arith.
+ now Z.nzsimpl.
Qed.
-Theorem Zred_factor4 : forall n m p:Z, n * m + n * p = n * (m + p).
+Theorem Zred_factor4 n m p : n * m + n * p = n * (m + p).
Proof.
- intros x y z; symmetry in |- *; apply Zmult_plus_distr_r.
+ symmetry; apply Z.mul_add_distr_l.
Qed.
-Theorem Zred_factor5 : forall n m:Z, n * 0 + m = m.
+Theorem Zred_factor5 n m : n * 0 + m = m.
Proof.
- intros x y; rewrite <- Zmult_0_r_reverse; auto with arith.
+ now Z.nzsimpl.
Qed.
-Theorem Zred_factor6 : forall n:Z, n = n + 0.
+Theorem Zred_factor6 n : n = n + 0.
Proof.
- intro; rewrite Zplus_0_r; trivial with arith.
+ now Z.nzsimpl.
Qed.
(** Other specific variants of theorems dedicated for the Omega tactic *)
Lemma new_var : forall x : Z, exists y : Z, x = y.
-intros x; exists x; trivial with arith.
+Proof.
+intros x; now exists x.
Qed.
-Lemma OMEGA1 : forall x y : Z, x = y -> 0 <= x -> 0 <= y.
-intros x y H; rewrite H; auto with arith.
+Lemma OMEGA1 x y : x = y -> 0 <= x -> 0 <= y.
+Proof.
+now intros ->.
Qed.
-Lemma OMEGA2 : forall x y : Z, 0 <= x -> 0 <= y -> 0 <= x + y.
-exact Zplus_le_0_compat.
+Lemma OMEGA2 x y : 0 <= x -> 0 <= y -> 0 <= x + y.
+Proof.
+Z.order_pos.
Qed.
-Lemma OMEGA3 : forall x y k : Z, k > 0 -> x = y * k -> x = 0 -> y = 0.
-
-intros x y k H1 H2 H3; apply (Zmult_integral_l k);
- [ unfold not in |- *; intros H4; absurd (k > 0);
- [ rewrite H4; unfold Zgt in |- *; simpl in |- *; discriminate
- | assumption ]
- | rewrite <- H2; assumption ].
+Lemma OMEGA3 x y k : k > 0 -> x = y * k -> x = 0 -> y = 0.
+Proof.
+intros LT -> EQ. apply Z.mul_eq_0 in EQ. destruct EQ; now subst.
Qed.
-Lemma OMEGA4 : forall x y z : Z, x > 0 -> y > x -> z * y + x <> 0.
-
-unfold not in |- *; intros x y z H1 H2 H3; cut (y > 0);
- [ intros H4; cut (0 <= z * y + x);
- [ intros H5; generalize (Zmult_le_approx y z x H4 H2 H5); intros H6;
- absurd (z * y + x > 0);
- [ rewrite H3; unfold Zgt in |- *; simpl in |- *; discriminate
- | apply Zle_gt_trans with x;
- [ pattern x at 1 in |- *; rewrite <- (Zplus_0_l x);
- apply Zplus_le_compat_r; rewrite Zmult_comm;
- generalize H4; unfold Zgt in |- *; case y;
- [ simpl in |- *; intros H7; discriminate H7
- | intros p H7; rewrite <- (Zmult_0_r (Zpos p));
- unfold Zle in |- *; rewrite Zcompare_mult_compat;
- exact H6
- | simpl in |- *; intros p H7; discriminate H7 ]
- | assumption ] ]
- | rewrite H3; unfold Zle in |- *; simpl in |- *; discriminate ]
- | apply Zgt_trans with x; [ assumption | assumption ] ].
+Lemma OMEGA4 x y z : x > 0 -> y > x -> z * y + x <> 0.
+Proof.
+Z.swap_greater. intros Hx Hxy.
+rewrite Z.add_move_0_l, <- Z.mul_opp_l.
+destruct (Z.lt_trichotomy (-z) 1) as [LT|[->|GT]].
+- intro. revert LT. apply Z.le_ngt, (Z.le_succ_l 0).
+ apply Z.mul_pos_cancel_r with y; Z.order.
+- Z.nzsimpl. Z.order.
+- rewrite (Z.mul_lt_mono_pos_r y), Z.mul_1_l in GT; Z.order.
Qed.
-Lemma OMEGA5 : forall x y z : Z, x = 0 -> y = 0 -> x + y * z = 0.
-
-intros x y z H1 H2; rewrite H1; rewrite H2; simpl in |- *; trivial with arith.
+Lemma OMEGA5 x y z : x = 0 -> y = 0 -> x + y * z = 0.
+Proof.
+now intros -> ->.
Qed.
-Lemma OMEGA6 : forall x y z : Z, 0 <= x -> y = 0 -> 0 <= x + y * z.
-
-intros x y z H1 H2; rewrite H2; simpl in |- *; rewrite Zplus_0_r; assumption.
+Lemma OMEGA6 x y z : 0 <= x -> y = 0 -> 0 <= x + y * z.
+Proof.
+intros H ->. now Z.nzsimpl.
Qed.
-Lemma OMEGA7 :
- forall x y z t : Z, z > 0 -> t > 0 -> 0 <= x -> 0 <= y -> 0 <= x * z + y * t.
-
-intros x y z t H1 H2 H3 H4; rewrite <- (Zplus_0_l 0); apply Zplus_le_compat;
- apply Zmult_gt_0_le_0_compat; assumption.
+Lemma OMEGA7 x y z t :
+ z > 0 -> t > 0 -> 0 <= x -> 0 <= y -> 0 <= x * z + y * t.
+Proof.
+intros. Z.swap_greater. Z.order_pos.
Qed.
-Lemma OMEGA8 : forall x y : Z, 0 <= x -> 0 <= y -> x = - y -> x = 0.
-
-intros x y H1 H2 H3; elim (Zle_lt_or_eq 0 x H1);
- [ intros H4; absurd (0 < x);
- [ change (0 >= x) in |- *; apply Zle_ge; apply Zplus_le_reg_l with y;
- rewrite H3; rewrite Zplus_opp_r; rewrite Zplus_0_r;
- assumption
- | assumption ]
- | intros H4; rewrite H4; trivial with arith ].
+Lemma OMEGA8 x y : 0 <= x -> 0 <= y -> x = - y -> x = 0.
+Proof.
+intros H1 H2 H3. rewrite <- Z.opp_nonpos_nonneg in H2. Z.order.
Qed.
-Lemma OMEGA9 : forall x y z t : Z, y = 0 -> x = z -> y + (- x + z) * t = 0.
-
-intros x y z t H1 H2; rewrite H2; rewrite Zplus_opp_l; rewrite Zmult_0_l;
- rewrite Zplus_0_r; assumption.
+Lemma OMEGA9 x y z t : y = 0 -> x = z -> y + (- x + z) * t = 0.
+Proof.
+intros. subst. now rewrite Z.add_opp_diag_l.
Qed.
-Lemma OMEGA10 :
- forall v c1 c2 l1 l2 k1 k2 : Z,
+Lemma OMEGA10 v c1 c2 l1 l2 k1 k2 :
(v * c1 + l1) * k1 + (v * c2 + l2) * k2 =
v * (c1 * k1 + c2 * k2) + (l1 * k1 + l2 * k2).
-
-intros; repeat rewrite Zmult_plus_distr_l || rewrite Zmult_plus_distr_r;
- repeat rewrite Zmult_assoc; repeat elim Zplus_assoc;
- rewrite (Zplus_permute (l1 * k1) (v * c2 * k2)); trivial with arith.
+Proof.
+rewrite ?Z.mul_add_distr_r, ?Z.mul_add_distr_l, ?Z.mul_assoc.
+rewrite <- !Z.add_assoc. f_equal. apply Z.add_shuffle3.
Qed.
-Lemma OMEGA11 :
- forall v1 c1 l1 l2 k1 : Z,
+Lemma OMEGA11 v1 c1 l1 l2 k1 :
(v1 * c1 + l1) * k1 + l2 = v1 * (c1 * k1) + (l1 * k1 + l2).
-
-intros; repeat rewrite Zmult_plus_distr_l || rewrite Zmult_plus_distr_r;
- repeat rewrite Zmult_assoc; repeat elim Zplus_assoc;
- trivial with arith.
+Proof.
+rewrite ?Z.mul_add_distr_r, ?Z.mul_add_distr_l, ?Z.mul_assoc.
+now rewrite Z.add_assoc.
Qed.
-Lemma OMEGA12 :
- forall v2 c2 l1 l2 k2 : Z,
+Lemma OMEGA12 v2 c2 l1 l2 k2 :
l1 + (v2 * c2 + l2) * k2 = v2 * (c2 * k2) + (l1 + l2 * k2).
-
-intros; repeat rewrite Zmult_plus_distr_l || rewrite Zmult_plus_distr_r;
- repeat rewrite Zmult_assoc; repeat elim Zplus_assoc;
- rewrite Zplus_permute; trivial with arith.
+Proof.
+rewrite ?Z.mul_add_distr_r, ?Z.mul_add_distr_l, ?Z.mul_assoc.
+apply Z.add_shuffle3.
Qed.
-Lemma OMEGA13 :
- forall (v l1 l2 : Z) (x : positive),
+Lemma OMEGA13 (v l1 l2 : Z) (x : positive) :
v * Zpos x + l1 + (v * Zneg x + l2) = l1 + l2.
-
-intros; rewrite Zplus_assoc; rewrite (Zplus_comm (v * Zpos x) l1);
- rewrite (Zplus_assoc_reverse l1); rewrite <- Zmult_plus_distr_r;
- rewrite <- Zopp_neg; rewrite (Zplus_comm (- Zneg x) (Zneg x));
- rewrite Zplus_opp_r; rewrite Zmult_0_r; rewrite Zplus_0_r;
- trivial with arith.
+Proof.
+ rewrite Z.add_shuffle1.
+ rewrite <- Z.mul_add_distr_l, <- Pos2Z.opp_neg, Z.add_opp_diag_r.
+ now Z.nzsimpl.
Qed.
-Lemma OMEGA14 :
- forall (v l1 l2 : Z) (x : positive),
+Lemma OMEGA14 (v l1 l2 : Z) (x : positive) :
v * Zneg x + l1 + (v * Zpos x + l2) = l1 + l2.
-
-intros; rewrite Zplus_assoc; rewrite (Zplus_comm (v * Zneg x) l1);
- rewrite (Zplus_assoc_reverse l1); rewrite <- Zmult_plus_distr_r;
- rewrite <- Zopp_neg; rewrite Zplus_opp_r; rewrite Zmult_0_r;
- rewrite Zplus_0_r; trivial with arith.
+Proof.
+ rewrite Z.add_shuffle1.
+ rewrite <- Z.mul_add_distr_l, <- Pos2Z.opp_neg, Z.add_opp_diag_r.
+ now Z.nzsimpl.
Qed.
-Lemma OMEGA15 :
- forall v c1 c2 l1 l2 k2 : Z,
- v * c1 + l1 + (v * c2 + l2) * k2 = v * (c1 + c2 * k2) + (l1 + l2 * k2).
-intros; repeat rewrite Zmult_plus_distr_l || rewrite Zmult_plus_distr_r;
- repeat rewrite Zmult_assoc; repeat elim Zplus_assoc;
- rewrite (Zplus_permute l1 (v * c2 * k2)); trivial with arith.
+Lemma OMEGA15 v c1 c2 l1 l2 k2 :
+ v * c1 + l1 + (v * c2 + l2) * k2 = v * (c1 + c2 * k2) + (l1 + l2 * k2).
+Proof.
+ rewrite ?Z.mul_add_distr_r, ?Z.mul_add_distr_l, ?Z.mul_assoc.
+ apply Z.add_shuffle1.
Qed.
-Lemma OMEGA16 : forall v c l k : Z, (v * c + l) * k = v * (c * k) + l * k.
-
-intros; repeat rewrite Zmult_plus_distr_l || rewrite Zmult_plus_distr_r;
- repeat rewrite Zmult_assoc; repeat elim Zplus_assoc;
- trivial with arith.
+Lemma OMEGA16 v c l k : (v * c + l) * k = v * (c * k) + l * k.
+Proof.
+ now rewrite ?Z.mul_add_distr_r, ?Z.mul_add_distr_l, ?Z.mul_assoc.
Qed.
-Lemma OMEGA17 : forall x y z : Z, Zne x 0 -> y = 0 -> Zne (x + y * z) 0.
-
-unfold Zne, not in |- *; intros x y z H1 H2 H3; apply H1;
- apply Zplus_reg_l with (y * z); rewrite Zplus_comm;
- rewrite H3; rewrite H2; auto with arith.
+Lemma OMEGA17 x y z : Zne x 0 -> y = 0 -> Zne (x + y * z) 0.
+Proof.
+ unfold Zne, not. intros NE EQ. subst. now Z.nzsimpl.
Qed.
-Lemma OMEGA18 : forall x y k : Z, x = y * k -> Zne x 0 -> Zne y 0.
-
-unfold Zne, not in |- *; intros x y k H1 H2 H3; apply H2; rewrite H1;
- rewrite H3; auto with arith.
+Lemma OMEGA18 x y k : x = y * k -> Zne x 0 -> Zne y 0.
+Proof.
+ unfold Zne, not. intros. subst; auto.
Qed.
-Lemma OMEGA19 : forall x : Z, Zne x 0 -> 0 <= x + -1 \/ 0 <= x * -1 + -1.
-
-unfold Zne in |- *; intros x H; elim (Zle_or_lt 0 x);
- [ intros H1; elim Zle_lt_or_eq with (1 := H1);
- [ intros H2; left; change (0 <= Zpred x) in |- *; apply Zsucc_le_reg;
- rewrite <- Zsucc_pred; apply Zlt_le_succ; assumption
- | intros H2; absurd (x = 0); auto with arith ]
- | intros H1; right; rewrite <- Zopp_eq_mult_neg_1; rewrite Zplus_comm;
- apply Zle_left; apply Zsucc_le_reg; simpl in |- *;
- apply Zlt_le_succ; auto with arith ].
+Lemma OMEGA19 x : Zne x 0 -> 0 <= x + -1 \/ 0 <= x * -1 + -1.
+Proof.
+ unfold Zne. intros Hx. apply Z.lt_gt_cases in Hx.
+ destruct Hx as [LT|GT].
+ - right. change (-1) with (-(1)).
+ rewrite Z.mul_opp_r, <- Z.opp_add_distr. Z.nzsimpl.
+ rewrite Z.opp_nonneg_nonpos. now apply Z.le_succ_l.
+ - left. now apply Z.lt_le_pred.
Qed.
-Lemma OMEGA20 : forall x y z : Z, Zne x 0 -> y = 0 -> Zne (x + y * z) 0.
-
-unfold Zne, not in |- *; intros x y z H1 H2 H3; apply H1; rewrite H2 in H3;
- simpl in H3; rewrite Zplus_0_r in H3; trivial with arith.
+Lemma OMEGA20 x y z : Zne x 0 -> y = 0 -> Zne (x + y * z) 0.
+Proof.
+ unfold Zne, not. intros H1 H2 H3; apply H1; rewrite H2 in H3;
+ simpl in H3; rewrite Z.add_0_r in H3; trivial with arith.
Qed.
Definition fast_Zplus_comm (x y : Z) (P : Z -> Prop)
- (H : P (y + x)) := eq_ind_r P H (Zplus_comm x y).
+ (H : P (y + x)) := eq_ind_r P H (Z.add_comm x y).
Definition fast_Zplus_assoc_reverse (n m p : Z) (P : Z -> Prop)
(H : P (n + (m + p))) := eq_ind_r P H (Zplus_assoc_reverse n m p).
Definition fast_Zplus_assoc (n m p : Z) (P : Z -> Prop)
- (H : P (n + m + p)) := eq_ind_r P H (Zplus_assoc n m p).
+ (H : P (n + m + p)) := eq_ind_r P H (Z.add_assoc n m p).
Definition fast_Zplus_permute (n m p : Z) (P : Z -> Prop)
- (H : P (m + (n + p))) := eq_ind_r P H (Zplus_permute n m p).
+ (H : P (m + (n + p))) := eq_ind_r P H (Z.add_shuffle3 n m p).
Definition fast_OMEGA10 (v c1 c2 l1 l2 k1 k2 : Z) (P : Z -> Prop)
(H : P (v * (c1 * k1 + c2 * k2) + (l1 * k1 + l2 * k2))) :=
@@ -259,24 +219,24 @@ Definition fast_Zred_factor0 (x : Z) (P : Z -> Prop)
(H : P (x * 1)) := eq_ind_r P H (Zred_factor0 x).
Definition fast_Zopp_eq_mult_neg_1 (x : Z) (P : Z -> Prop)
- (H : P (x * -1)) := eq_ind_r P H (Zopp_eq_mult_neg_1 x).
+ (H : P (x * -1)) := eq_ind_r P H (Z.opp_eq_mul_m1 x).
Definition fast_Zmult_comm (x y : Z) (P : Z -> Prop)
- (H : P (y * x)) := eq_ind_r P H (Zmult_comm x y).
+ (H : P (y * x)) := eq_ind_r P H (Z.mul_comm x y).
Definition fast_Zopp_plus_distr (x y : Z) (P : Z -> Prop)
- (H : P (- x + - y)) := eq_ind_r P H (Zopp_plus_distr x y).
+ (H : P (- x + - y)) := eq_ind_r P H (Z.opp_add_distr x y).
Definition fast_Zopp_involutive (x : Z) (P : Z -> Prop) (H : P x) :=
- eq_ind_r P H (Zopp_involutive x).
+ eq_ind_r P H (Z.opp_involutive x).
Definition fast_Zopp_mult_distr_r (x y : Z) (P : Z -> Prop)
(H : P (x * - y)) := eq_ind_r P H (Zopp_mult_distr_r x y).
Definition fast_Zmult_plus_distr_l (n m p : Z) (P : Z -> Prop)
- (H : P (n * p + m * p)) := eq_ind_r P H (Zmult_plus_distr_l n m p).
+ (H : P (n * p + m * p)) := eq_ind_r P H (Z.mul_add_distr_r n m p).
Definition fast_Zmult_opp_comm (x y : Z) (P : Z -> Prop)
- (H : P (x * - y)) := eq_ind_r P H (Zmult_opp_comm x y).
+ (H : P (x * - y)) := eq_ind_r P H (Z.mul_opp_comm x y).
Definition fast_Zmult_assoc_reverse (n m p : Z) (P : Z -> Prop)
(H : P (n * (m * p))) := eq_ind_r P H (Zmult_assoc_reverse n m p).
@@ -300,8 +260,8 @@ Definition fast_Zred_factor6 (x : Z) (P : Z -> Prop)
(H : P (x + 0)) := eq_ind_r P H (Zred_factor6 x).
Theorem intro_Z :
- forall n:nat, exists y : Z, Z_of_nat n = y /\ 0 <= y * 1 + 0.
+ forall n:nat, exists y : Z, Z.of_nat n = y /\ 0 <= y * 1 + 0.
Proof.
- intros n; exists (Z_of_nat n); split; trivial.
- rewrite Zmult_1_r, Zplus_0_r. apply Zle_0_nat.
+ intros n; exists (Z.of_nat n); split; trivial.
+ rewrite Z.mul_1_r, Z.add_0_r. apply Nat2Z.is_nonneg.
Qed.
diff --git a/plugins/omega/OmegaPlugin.v b/plugins/omega/OmegaPlugin.v
index a3ab34a9..433db414 100644
--- a/plugins/omega/OmegaPlugin.v
+++ b/plugins/omega/OmegaPlugin.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/omega/PreOmega.v b/plugins/omega/PreOmega.v
index 46fd5682..60e606a6 100644
--- a/plugins/omega/PreOmega.v
+++ b/plugins/omega/PreOmega.v
@@ -1,6 +1,14 @@
-Require Import Arith Max Min ZArith_base NArith Nnat.
+(************************************************************************)
+(* v * The Coq Proof Assistant / The Coq Development Team *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
+(* \VV/ **************************************************************)
+(* // * This file is distributed under the terms of the *)
+(* * GNU Lesser General Public License Version 2.1 *)
+(************************************************************************)
-Open Local Scope Z_scope.
+Require Import Arith Max Min BinInt BinNat Znat Nnat.
+
+Local Open Scope Z_scope.
(** * zify: the Z-ification tactic *)
@@ -15,16 +23,16 @@ Open Local Scope Z_scope.
- { eq, le, lt, ge, gt } on { Z, positive, N, nat }
Recognized operations:
- - on Z: Zmin, Zmax, Zabs, Zsgn are translated in term of <= < =
- - on nat: + * - S O pred min max nat_of_P nat_of_N Zabs_nat
- - on positive: Zneg Zpos xI xO xH + * - Psucc Ppred Pmin Pmax P_of_succ_nat
- - on N: N0 Npos + * - Nsucc Nmin Nmax N_of_nat Zabs_N
+ - on Z: Z.min, Z.max, Z.abs, Z.sgn are translated in term of <= < =
+ - on nat: + * - S O pred min max Pos.to_nat N.to_nat Z.abs_nat
+ - on positive: Zneg Zpos xI xO xH + * - Pos.succ Pos.pred Pos.min Pos.max Pos.of_succ_nat
+ - on N: N0 Npos + * - N.succ N.min N.max N.of_nat Z.abs_N
*)
-(** I) translation of Zmax, Zmin, Zabs, Zsgn into recognized equations *)
+(** I) translation of Z.max, Z.min, Z.abs, Z.sgn into recognized equations *)
Ltac zify_unop_core t thm a :=
(* Let's introduce the specification theorem for t *)
@@ -48,7 +56,7 @@ Ltac zify_unop t thm a :=
end.
Ltac zify_unop_nored t thm a :=
- (* in this version, we don't try to reduce the unop (that can be (Zplus x)) *)
+ (* in this version, we don't try to reduce the unop (that can be (Z.add x)) *)
let isz := isZcst a in
match isz with
| true => zify_unop_core t thm a
@@ -72,14 +80,14 @@ Ltac zify_binop t thm a b:=
Ltac zify_op_1 :=
match goal with
- | |- context [ Zmax ?a ?b ] => zify_binop Zmax Zmax_spec a b
- | H : context [ Zmax ?a ?b ] |- _ => zify_binop Zmax Zmax_spec a b
- | |- context [ Zmin ?a ?b ] => zify_binop Zmin Zmin_spec a b
- | H : context [ Zmin ?a ?b ] |- _ => zify_binop Zmin Zmin_spec a b
- | |- context [ Zsgn ?a ] => zify_unop Zsgn Zsgn_spec a
- | H : context [ Zsgn ?a ] |- _ => zify_unop Zsgn Zsgn_spec a
- | |- context [ Zabs ?a ] => zify_unop Zabs Zabs_spec a
- | H : context [ Zabs ?a ] |- _ => zify_unop Zabs Zabs_spec a
+ | |- context [ Z.max ?a ?b ] => zify_binop Z.max Z.max_spec a b
+ | H : context [ Z.max ?a ?b ] |- _ => zify_binop Z.max Z.max_spec a b
+ | |- context [ Z.min ?a ?b ] => zify_binop Z.min Z.min_spec a b
+ | H : context [ Z.min ?a ?b ] |- _ => zify_binop Z.min Z.min_spec a b
+ | |- context [ Z.sgn ?a ] => zify_unop Z.sgn Z.sgn_spec a
+ | H : context [ Z.sgn ?a ] |- _ => zify_unop Z.sgn Z.sgn_spec a
+ | |- context [ Z.abs ?a ] => zify_unop Z.abs Z.abs_spec a
+ | H : context [ Z.abs ?a ] |- _ => zify_unop Z.abs Z.abs_spec a
end.
Ltac zify_op := repeat zify_op_1.
@@ -91,100 +99,95 @@ Ltac zify_op := repeat zify_op_1.
(** II) Conversion from nat to Z *)
-Definition Z_of_nat' := Z_of_nat.
+Definition Z_of_nat' := Z.of_nat.
Ltac hide_Z_of_nat t :=
- let z := fresh "z" in set (z:=Z_of_nat t) in *;
- change Z_of_nat with Z_of_nat' in z;
+ let z := fresh "z" in set (z:=Z.of_nat t) in *;
+ change Z.of_nat with Z_of_nat' in z;
unfold z in *; clear z.
Ltac zify_nat_rel :=
match goal with
(* I: equalities *)
- | H : (@eq nat ?a ?b) |- _ => generalize (inj_eq _ _ H); clear H; intro H
- | |- (@eq nat ?a ?b) => apply (inj_eq_rev a b)
- | H : context [ @eq nat ?a ?b ] |- _ => rewrite (inj_eq_iff a b) in H
- | |- context [ @eq nat ?a ?b ] => rewrite (inj_eq_iff a b)
+ | |- (@eq nat ?a ?b) => apply (Nat2Z.inj a b) (* shortcut *)
+ | H : context [ @eq nat ?a ?b ] |- _ => rewrite <- (Nat2Z.inj_iff a b) in H
+ | |- context [ @eq nat ?a ?b ] => rewrite <- (Nat2Z.inj_iff a b)
(* II: less than *)
- | H : (lt ?a ?b) |- _ => generalize (inj_lt _ _ H); clear H; intro H
- | |- (lt ?a ?b) => apply (inj_lt_rev a b)
- | H : context [ lt ?a ?b ] |- _ => rewrite (inj_lt_iff a b) in H
- | |- context [ lt ?a ?b ] => rewrite (inj_lt_iff a b)
+ | H : context [ lt ?a ?b ] |- _ => rewrite (Nat2Z.inj_lt a b) in H
+ | |- context [ lt ?a ?b ] => rewrite (Nat2Z.inj_lt a b)
(* III: less or equal *)
- | H : (le ?a ?b) |- _ => generalize (inj_le _ _ H); clear H; intro H
- | |- (le ?a ?b) => apply (inj_le_rev a b)
- | H : context [ le ?a ?b ] |- _ => rewrite (inj_le_iff a b) in H
- | |- context [ le ?a ?b ] => rewrite (inj_le_iff a b)
+ | H : context [ le ?a ?b ] |- _ => rewrite (Nat2Z.inj_le a b) in H
+ | |- context [ le ?a ?b ] => rewrite (Nat2Z.inj_le a b)
(* IV: greater than *)
- | H : (gt ?a ?b) |- _ => generalize (inj_gt _ _ H); clear H; intro H
- | |- (gt ?a ?b) => apply (inj_gt_rev a b)
- | H : context [ gt ?a ?b ] |- _ => rewrite (inj_gt_iff a b) in H
- | |- context [ gt ?a ?b ] => rewrite (inj_gt_iff a b)
+ | H : context [ gt ?a ?b ] |- _ => rewrite (Nat2Z.inj_gt a b) in H
+ | |- context [ gt ?a ?b ] => rewrite (Nat2Z.inj_gt a b)
(* V: greater or equal *)
- | H : (ge ?a ?b) |- _ => generalize (inj_ge _ _ H); clear H; intro H
- | |- (ge ?a ?b) => apply (inj_ge_rev a b)
- | H : context [ ge ?a ?b ] |- _ => rewrite (inj_ge_iff a b) in H
- | |- context [ ge ?a ?b ] => rewrite (inj_ge_iff a b)
+ | H : context [ ge ?a ?b ] |- _ => rewrite (Nat2Z.inj_ge a b) in H
+ | |- context [ ge ?a ?b ] => rewrite (Nat2Z.inj_ge a b)
end.
Ltac zify_nat_op :=
match goal with
(* misc type conversions: positive/N/Z to nat *)
- | H : context [ Z_of_nat (nat_of_P ?a) ] |- _ => rewrite <- (Zpos_eq_Z_of_nat_o_nat_of_P a) in H
- | |- context [ Z_of_nat (nat_of_P ?a) ] => rewrite <- (Zpos_eq_Z_of_nat_o_nat_of_P a)
- | H : context [ Z_of_nat (nat_of_N ?a) ] |- _ => rewrite (Z_of_nat_of_N a) in H
- | |- context [ Z_of_nat (nat_of_N ?a) ] => rewrite (Z_of_nat_of_N a)
- | H : context [ Z_of_nat (Zabs_nat ?a) ] |- _ => rewrite (inj_Zabs_nat a) in H
- | |- context [ Z_of_nat (Zabs_nat ?a) ] => rewrite (inj_Zabs_nat a)
-
- (* plus -> Zplus *)
- | H : context [ Z_of_nat (plus ?a ?b) ] |- _ => rewrite (inj_plus a b) in H
- | |- context [ Z_of_nat (plus ?a ?b) ] => rewrite (inj_plus a b)
-
- (* min -> Zmin *)
- | H : context [ Z_of_nat (min ?a ?b) ] |- _ => rewrite (inj_min a b) in H
- | |- context [ Z_of_nat (min ?a ?b) ] => rewrite (inj_min a b)
-
- (* max -> Zmax *)
- | H : context [ Z_of_nat (max ?a ?b) ] |- _ => rewrite (inj_max a b) in H
- | |- context [ Z_of_nat (max ?a ?b) ] => rewrite (inj_max a b)
-
- (* minus -> Zmax (Zminus ... ...) 0 *)
- | H : context [ Z_of_nat (minus ?a ?b) ] |- _ => rewrite (inj_minus a b) in H
- | |- context [ Z_of_nat (minus ?a ?b) ] => rewrite (inj_minus a b)
-
- (* pred -> minus ... -1 -> Zmax (Zminus ... -1) 0 *)
- | H : context [ Z_of_nat (pred ?a) ] |- _ => rewrite (pred_of_minus a) in H
- | |- context [ Z_of_nat (pred ?a) ] => rewrite (pred_of_minus a)
-
- (* mult -> Zmult and a positivity hypothesis *)
- | H : context [ Z_of_nat (mult ?a ?b) ] |- _ =>
- pose proof (Zle_0_nat (mult a b)); rewrite (inj_mult a b) in *
- | |- context [ Z_of_nat (mult ?a ?b) ] =>
- pose proof (Zle_0_nat (mult a b)); rewrite (inj_mult a b) in *
+ | H : context [ Z.of_nat (Pos.to_nat ?a) ] |- _ => rewrite (positive_nat_Z a) in H
+ | |- context [ Z.of_nat (Pos.to_nat ?a) ] => rewrite (positive_nat_Z a)
+ | H : context [ Z.of_nat (N.to_nat ?a) ] |- _ => rewrite (N_nat_Z a) in H
+ | |- context [ Z.of_nat (N.to_nat ?a) ] => rewrite (N_nat_Z a)
+ | H : context [ Z.of_nat (Z.abs_nat ?a) ] |- _ => rewrite (Zabs2Nat.id_abs a) in H
+ | |- context [ Z.of_nat (Z.abs_nat ?a) ] => rewrite (Zabs2Nat.id_abs a)
+
+ (* plus -> Z.add *)
+ | H : context [ Z.of_nat (plus ?a ?b) ] |- _ => rewrite (Nat2Z.inj_add a b) in H
+ | |- context [ Z.of_nat (plus ?a ?b) ] => rewrite (Nat2Z.inj_add a b)
+
+ (* min -> Z.min *)
+ | H : context [ Z.of_nat (min ?a ?b) ] |- _ => rewrite (Nat2Z.inj_min a b) in H
+ | |- context [ Z.of_nat (min ?a ?b) ] => rewrite (Nat2Z.inj_min a b)
+
+ (* max -> Z.max *)
+ | H : context [ Z.of_nat (max ?a ?b) ] |- _ => rewrite (Nat2Z.inj_max a b) in H
+ | |- context [ Z.of_nat (max ?a ?b) ] => rewrite (Nat2Z.inj_max a b)
+
+ (* minus -> Z.max (Z.sub ... ...) 0 *)
+ | H : context [ Z.of_nat (minus ?a ?b) ] |- _ => rewrite (Nat2Z.inj_sub_max a b) in H
+ | |- context [ Z.of_nat (minus ?a ?b) ] => rewrite (Nat2Z.inj_sub_max a b)
+
+ (* pred -> minus ... -1 -> Z.max (Z.sub ... -1) 0 *)
+ | H : context [ Z.of_nat (pred ?a) ] |- _ => rewrite (pred_of_minus a) in H
+ | |- context [ Z.of_nat (pred ?a) ] => rewrite (pred_of_minus a)
+
+ (* mult -> Z.mul and a positivity hypothesis *)
+ | H : context [ Z.of_nat (mult ?a ?b) ] |- _ =>
+ pose proof (Nat2Z.is_nonneg (mult a b));
+ rewrite (Nat2Z.inj_mul a b) in *
+ | |- context [ Z.of_nat (mult ?a ?b) ] =>
+ pose proof (Nat2Z.is_nonneg (mult a b));
+ rewrite (Nat2Z.inj_mul a b) in *
(* O -> Z0 *)
- | H : context [ Z_of_nat O ] |- _ => simpl (Z_of_nat O) in H
- | |- context [ Z_of_nat O ] => simpl (Z_of_nat O)
+ | H : context [ Z.of_nat O ] |- _ => simpl (Z.of_nat O) in H
+ | |- context [ Z.of_nat O ] => simpl (Z.of_nat O)
- (* S -> number or Zsucc *)
- | H : context [ Z_of_nat (S ?a) ] |- _ =>
+ (* S -> number or Z.succ *)
+ | H : context [ Z.of_nat (S ?a) ] |- _ =>
let isnat := isnatcst a in
match isnat with
- | true => simpl (Z_of_nat (S a)) in H
- | _ => rewrite (inj_S a) in H
+ | true => simpl (Z.of_nat (S a)) in H
+ | _ => rewrite (Nat2Z.inj_succ a) in H
end
- | |- context [ Z_of_nat (S ?a) ] =>
+ | |- context [ Z.of_nat (S ?a) ] =>
let isnat := isnatcst a in
match isnat with
- | true => simpl (Z_of_nat (S a))
- | _ => rewrite (inj_S a)
+ | true => simpl (Z.of_nat (S a))
+ | _ => rewrite (Nat2Z.inj_succ a)
end
(* atoms of type nat : we add a positivity condition (if not already there) *)
- | _ : 0 <= Z_of_nat ?a |- _ => hide_Z_of_nat a
- | _ : context [ Z_of_nat ?a ] |- _ => pose proof (Zle_0_nat a); hide_Z_of_nat a
- | |- context [ Z_of_nat ?a ] => pose proof (Zle_0_nat a); hide_Z_of_nat a
+ | _ : 0 <= Z.of_nat ?a |- _ => hide_Z_of_nat a
+ | _ : context [ Z.of_nat ?a ] |- _ =>
+ pose proof (Nat2Z.is_nonneg a); hide_Z_of_nat a
+ | |- context [ Z.of_nat ?a ] =>
+ pose proof (Nat2Z.is_nonneg a); hide_Z_of_nat a
end.
Ltac zify_nat := repeat zify_nat_rel; repeat zify_nat_op; unfold Z_of_nat' in *.
@@ -205,10 +208,9 @@ Ltac hide_Zpos t :=
Ltac zify_positive_rel :=
match goal with
(* I: equalities *)
- | H : (@eq positive ?a ?b) |- _ => generalize (Zpos_eq _ _ H); clear H; intro H
- | |- (@eq positive ?a ?b) => apply (Zpos_eq_rev a b)
- | H : context [ @eq positive ?a ?b ] |- _ => rewrite (Zpos_eq_iff a b) in H
- | |- context [ @eq positive ?a ?b ] => rewrite (Zpos_eq_iff a b)
+ | |- (@eq positive ?a ?b) => apply Pos2Z.inj
+ | H : context [ @eq positive ?a ?b ] |- _ => rewrite <- (Pos2Z.inj_iff a b) in H
+ | |- context [ @eq positive ?a ?b ] => rewrite <- (Pos2Z.inj_iff a b)
(* II: less than *)
| H : context [ (?a < ?b)%positive ] |- _ => change (a<b)%positive with (Zpos a<Zpos b) in H
| |- context [ (?a < ?b)%positive ] => change (a<b)%positive with (Zpos a<Zpos b)
@@ -240,64 +242,66 @@ Ltac zify_positive_op :=
end
(* misc type conversions: nat to positive *)
- | H : context [ Zpos (P_of_succ_nat ?a) ] |- _ => rewrite (Zpos_P_of_succ_nat a) in H
- | |- context [ Zpos (P_of_succ_nat ?a) ] => rewrite (Zpos_P_of_succ_nat a)
+ | H : context [ Zpos (Pos.of_succ_nat ?a) ] |- _ => rewrite (Zpos_P_of_succ_nat a) in H
+ | |- context [ Zpos (Pos.of_succ_nat ?a) ] => rewrite (Zpos_P_of_succ_nat a)
- (* Pplus -> Zplus *)
- | H : context [ Zpos (Pplus ?a ?b) ] |- _ => change (Zpos (Pplus a b)) with (Zplus (Zpos a) (Zpos b)) in H
- | |- context [ Zpos (Pplus ?a ?b) ] => change (Zpos (Pplus a b)) with (Zplus (Zpos a) (Zpos b))
+ (* Pos.add -> Z.add *)
+ | H : context [ Zpos (?a + ?b) ] |- _ => change (Zpos (a+b)) with (Zpos a + Zpos b) in H
+ | |- context [ Zpos (?a + ?b) ] => change (Zpos (a+b)) with (Zpos a + Zpos b)
- (* Pmin -> Zmin *)
- | H : context [ Zpos (Pmin ?a ?b) ] |- _ => rewrite (Zpos_min a b) in H
- | |- context [ Zpos (Pmin ?a ?b) ] => rewrite (Zpos_min a b)
+ (* Pos.min -> Z.min *)
+ | H : context [ Zpos (Pos.min ?a ?b) ] |- _ => rewrite (Pos2Z.inj_min a b) in H
+ | |- context [ Zpos (Pos.min ?a ?b) ] => rewrite (Pos2Z.inj_min a b)
- (* Pmax -> Zmax *)
- | H : context [ Zpos (Pmax ?a ?b) ] |- _ => rewrite (Zpos_max a b) in H
- | |- context [ Zpos (Pmax ?a ?b) ] => rewrite (Zpos_max a b)
+ (* Pos.max -> Z.max *)
+ | H : context [ Zpos (Pos.max ?a ?b) ] |- _ => rewrite (Pos2Z.inj_max a b) in H
+ | |- context [ Zpos (Pos.max ?a ?b) ] => rewrite (Pos2Z.inj_max a b)
- (* Pminus -> Zmax 1 (Zminus ... ...) *)
- | H : context [ Zpos (Pminus ?a ?b) ] |- _ => rewrite (Zpos_minus a b) in H
- | |- context [ Zpos (Pminus ?a ?b) ] => rewrite (Zpos_minus a b)
+ (* Pos.sub -> Z.max 1 (Z.sub ... ...) *)
+ | H : context [ Zpos (Pos.sub ?a ?b) ] |- _ => rewrite (Pos2Z.inj_sub a b) in H
+ | |- context [ Zpos (Pos.sub ?a ?b) ] => rewrite (Pos2Z.inj_sub a b)
- (* Psucc -> Zsucc *)
- | H : context [ Zpos (Psucc ?a) ] |- _ => rewrite (Zpos_succ_morphism a) in H
- | |- context [ Zpos (Psucc ?a) ] => rewrite (Zpos_succ_morphism a)
+ (* Pos.succ -> Z.succ *)
+ | H : context [ Zpos (Pos.succ ?a) ] |- _ => rewrite (Pos2Z.inj_succ a) in H
+ | |- context [ Zpos (Pos.succ ?a) ] => rewrite (Pos2Z.inj_succ a)
- (* Ppred -> Pminus ... -1 -> Zmax 1 (Zminus ... - 1) *)
- | H : context [ Zpos (Ppred ?a) ] |- _ => rewrite (Ppred_minus a) in H
- | |- context [ Zpos (Ppred ?a) ] => rewrite (Ppred_minus a)
+ (* Pos.pred -> Pos.sub ... -1 -> Z.max 1 (Z.sub ... - 1) *)
+ | H : context [ Zpos (Pos.pred ?a) ] |- _ => rewrite <- (Pos.sub_1_r a) in H
+ | |- context [ Zpos (Pos.pred ?a) ] => rewrite <- (Pos.sub_1_r a)
- (* Pmult -> Zmult and a positivity hypothesis *)
- | H : context [ Zpos (Pmult ?a ?b) ] |- _ =>
- pose proof (Zgt_pos_0 (Pmult a b)); rewrite (Zpos_mult_morphism a b) in *
- | |- context [ Zpos (Pmult ?a ?b) ] =>
- pose proof (Zgt_pos_0 (Pmult a b)); rewrite (Zpos_mult_morphism a b) in *
+ (* Pos.mul -> Z.mul and a positivity hypothesis *)
+ | H : context [ Zpos (?a * ?b) ] |- _ =>
+ pose proof (Pos2Z.is_pos (Pos.mul a b));
+ change (Zpos (a*b)) with (Zpos a * Zpos b) in *
+ | |- context [ Zpos (?a * ?b) ] =>
+ pose proof (Pos2Z.is_pos (Pos.mul a b));
+ change (Zpos (a*b)) with (Zpos a * Zpos b) in *
(* xO *)
| H : context [ Zpos (xO ?a) ] |- _ =>
let isp := isPcst a in
match isp with
| true => change (Zpos (xO a)) with (Zpos' (xO a)) in H
- | _ => rewrite (Zpos_xO a) in H
+ | _ => rewrite (Pos2Z.inj_xO a) in H
end
| |- context [ Zpos (xO ?a) ] =>
let isp := isPcst a in
match isp with
| true => change (Zpos (xO a)) with (Zpos' (xO a))
- | _ => rewrite (Zpos_xO a)
+ | _ => rewrite (Pos2Z.inj_xO a)
end
(* xI *)
| H : context [ Zpos (xI ?a) ] |- _ =>
let isp := isPcst a in
match isp with
| true => change (Zpos (xI a)) with (Zpos' (xI a)) in H
- | _ => rewrite (Zpos_xI a) in H
+ | _ => rewrite (Pos2Z.inj_xI a) in H
end
| |- context [ Zpos (xI ?a) ] =>
let isp := isPcst a in
match isp with
| true => change (Zpos (xI a)) with (Zpos' (xI a))
- | _ => rewrite (Zpos_xI a)
+ | _ => rewrite (Pos2Z.inj_xI a)
end
(* xI : nothing to do, just prevent adding a useless positivity condition *)
@@ -305,9 +309,9 @@ Ltac zify_positive_op :=
| |- context [ Zpos xH ] => hide_Zpos xH
(* atoms of type positive : we add a positivity condition (if not already there) *)
- | _ : Zpos ?a > 0 |- _ => hide_Zpos a
- | _ : context [ Zpos ?a ] |- _ => pose proof (Zgt_pos_0 a); hide_Zpos a
- | |- context [ Zpos ?a ] => pose proof (Zgt_pos_0 a); hide_Zpos a
+ | _ : 0 < Zpos ?a |- _ => hide_Zpos a
+ | _ : context [ Zpos ?a ] |- _ => pose proof (Pos2Z.is_pos a); hide_Zpos a
+ | |- context [ Zpos ?a ] => pose proof (Pos2Z.is_pos a); hide_Zpos a
end.
Ltac zify_positive :=
@@ -319,84 +323,75 @@ Ltac zify_positive :=
(* IV) conversion from N to Z *)
-Definition Z_of_N' := Z_of_N.
+Definition Z_of_N' := Z.of_N.
Ltac hide_Z_of_N t :=
- let z := fresh "z" in set (z:=Z_of_N t) in *;
- change Z_of_N with Z_of_N' in z;
+ let z := fresh "z" in set (z:=Z.of_N t) in *;
+ change Z.of_N with Z_of_N' in z;
unfold z in *; clear z.
Ltac zify_N_rel :=
match goal with
(* I: equalities *)
- | H : (@eq N ?a ?b) |- _ => generalize (Z_of_N_eq _ _ H); clear H; intro H
- | |- (@eq N ?a ?b) => apply (Z_of_N_eq_rev a b)
- | H : context [ @eq N ?a ?b ] |- _ => rewrite (Z_of_N_eq_iff a b) in H
- | |- context [ @eq N ?a ?b ] => rewrite (Z_of_N_eq_iff a b)
+ | |- (@eq N ?a ?b) => apply (N2Z.inj a b) (* shortcut *)
+ | H : context [ @eq N ?a ?b ] |- _ => rewrite <- (N2Z.inj_iff a b) in H
+ | |- context [ @eq N ?a ?b ] => rewrite <- (N2Z.inj_iff a b)
(* II: less than *)
- | H : (?a < ?b)%N |- _ => generalize (Z_of_N_lt _ _ H); clear H; intro H
- | |- (?a < ?b)%N => apply (Z_of_N_lt_rev a b)
- | H : context [ (?a < ?b)%N ] |- _ => rewrite (Z_of_N_lt_iff a b) in H
- | |- context [ (?a < ?b)%N ] => rewrite (Z_of_N_lt_iff a b)
+ | H : context [ (?a < ?b)%N ] |- _ => rewrite (N2Z.inj_lt a b) in H
+ | |- context [ (?a < ?b)%N ] => rewrite (N2Z.inj_lt a b)
(* III: less or equal *)
- | H : (?a <= ?b)%N |- _ => generalize (Z_of_N_le _ _ H); clear H; intro H
- | |- (?a <= ?b)%N => apply (Z_of_N_le_rev a b)
- | H : context [ (?a <= ?b)%N ] |- _ => rewrite (Z_of_N_le_iff a b) in H
- | |- context [ (?a <= ?b)%N ] => rewrite (Z_of_N_le_iff a b)
+ | H : context [ (?a <= ?b)%N ] |- _ => rewrite (N2Z.inj_le a b) in H
+ | |- context [ (?a <= ?b)%N ] => rewrite (N2Z.inj_le a b)
(* IV: greater than *)
- | H : (?a > ?b)%N |- _ => generalize (Z_of_N_gt _ _ H); clear H; intro H
- | |- (?a > ?b)%N => apply (Z_of_N_gt_rev a b)
- | H : context [ (?a > ?b)%N ] |- _ => rewrite (Z_of_N_gt_iff a b) in H
- | |- context [ (?a > ?b)%N ] => rewrite (Z_of_N_gt_iff a b)
+ | H : context [ (?a > ?b)%N ] |- _ => rewrite (N2Z.inj_gt a b) in H
+ | |- context [ (?a > ?b)%N ] => rewrite (N2Z.inj_gt a b)
(* V: greater or equal *)
- | H : (?a >= ?b)%N |- _ => generalize (Z_of_N_ge _ _ H); clear H; intro H
- | |- (?a >= ?b)%N => apply (Z_of_N_ge_rev a b)
- | H : context [ (?a >= ?b)%N ] |- _ => rewrite (Z_of_N_ge_iff a b) in H
- | |- context [ (?a >= ?b)%N ] => rewrite (Z_of_N_ge_iff a b)
+ | H : context [ (?a >= ?b)%N ] |- _ => rewrite (N2Z.inj_ge a b) in H
+ | |- context [ (?a >= ?b)%N ] => rewrite (N2Z.inj_ge a b)
end.
Ltac zify_N_op :=
match goal with
(* misc type conversions: nat to positive *)
- | H : context [ Z_of_N (N_of_nat ?a) ] |- _ => rewrite (Z_of_N_of_nat a) in H
- | |- context [ Z_of_N (N_of_nat ?a) ] => rewrite (Z_of_N_of_nat a)
- | H : context [ Z_of_N (Zabs_N ?a) ] |- _ => rewrite (Z_of_N_abs a) in H
- | |- context [ Z_of_N (Zabs_N ?a) ] => rewrite (Z_of_N_abs a)
- | H : context [ Z_of_N (Npos ?a) ] |- _ => rewrite (Z_of_N_pos a) in H
- | |- context [ Z_of_N (Npos ?a) ] => rewrite (Z_of_N_pos a)
- | H : context [ Z_of_N N0 ] |- _ => change (Z_of_N N0) with Z0 in H
- | |- context [ Z_of_N N0 ] => change (Z_of_N N0) with Z0
-
- (* Nplus -> Zplus *)
- | H : context [ Z_of_N (Nplus ?a ?b) ] |- _ => rewrite (Z_of_N_plus a b) in H
- | |- context [ Z_of_N (Nplus ?a ?b) ] => rewrite (Z_of_N_plus a b)
-
- (* Nmin -> Zmin *)
- | H : context [ Z_of_N (Nmin ?a ?b) ] |- _ => rewrite (Z_of_N_min a b) in H
- | |- context [ Z_of_N (Nmin ?a ?b) ] => rewrite (Z_of_N_min a b)
-
- (* Nmax -> Zmax *)
- | H : context [ Z_of_N (Nmax ?a ?b) ] |- _ => rewrite (Z_of_N_max a b) in H
- | |- context [ Z_of_N (Nmax ?a ?b) ] => rewrite (Z_of_N_max a b)
-
- (* Nminus -> Zmax 0 (Zminus ... ...) *)
- | H : context [ Z_of_N (Nminus ?a ?b) ] |- _ => rewrite (Z_of_N_minus a b) in H
- | |- context [ Z_of_N (Nminus ?a ?b) ] => rewrite (Z_of_N_minus a b)
-
- (* Nsucc -> Zsucc *)
- | H : context [ Z_of_N (Nsucc ?a) ] |- _ => rewrite (Z_of_N_succ a) in H
- | |- context [ Z_of_N (Nsucc ?a) ] => rewrite (Z_of_N_succ a)
-
- (* Nmult -> Zmult and a positivity hypothesis *)
- | H : context [ Z_of_N (Nmult ?a ?b) ] |- _ =>
- pose proof (Z_of_N_le_0 (Nmult a b)); rewrite (Z_of_N_mult a b) in *
- | |- context [ Z_of_N (Nmult ?a ?b) ] =>
- pose proof (Z_of_N_le_0 (Nmult a b)); rewrite (Z_of_N_mult a b) in *
+ | H : context [ Z.of_N (N.of_nat ?a) ] |- _ => rewrite (nat_N_Z a) in H
+ | |- context [ Z.of_N (N.of_nat ?a) ] => rewrite (nat_N_Z a)
+ | H : context [ Z.of_N (Z.abs_N ?a) ] |- _ => rewrite (N2Z.inj_abs_N a) in H
+ | |- context [ Z.of_N (Z.abs_N ?a) ] => rewrite (N2Z.inj_abs_N a)
+ | H : context [ Z.of_N (Npos ?a) ] |- _ => rewrite (N2Z.inj_pos a) in H
+ | |- context [ Z.of_N (Npos ?a) ] => rewrite (N2Z.inj_pos a)
+ | H : context [ Z.of_N N0 ] |- _ => change (Z.of_N N0) with Z0 in H
+ | |- context [ Z.of_N N0 ] => change (Z.of_N N0) with Z0
+
+ (* N.add -> Z.add *)
+ | H : context [ Z.of_N (N.add ?a ?b) ] |- _ => rewrite (N2Z.inj_add a b) in H
+ | |- context [ Z.of_N (N.add ?a ?b) ] => rewrite (N2Z.inj_add a b)
+
+ (* N.min -> Z.min *)
+ | H : context [ Z.of_N (N.min ?a ?b) ] |- _ => rewrite (N2Z.inj_min a b) in H
+ | |- context [ Z.of_N (N.min ?a ?b) ] => rewrite (N2Z.inj_min a b)
+
+ (* N.max -> Z.max *)
+ | H : context [ Z.of_N (N.max ?a ?b) ] |- _ => rewrite (N2Z.inj_max a b) in H
+ | |- context [ Z.of_N (N.max ?a ?b) ] => rewrite (N2Z.inj_max a b)
+
+ (* N.sub -> Z.max 0 (Z.sub ... ...) *)
+ | H : context [ Z.of_N (N.sub ?a ?b) ] |- _ => rewrite (N2Z.inj_sub_max a b) in H
+ | |- context [ Z.of_N (N.sub ?a ?b) ] => rewrite (N2Z.inj_sub_max a b)
+
+ (* N.succ -> Z.succ *)
+ | H : context [ Z.of_N (N.succ ?a) ] |- _ => rewrite (N2Z.inj_succ a) in H
+ | |- context [ Z.of_N (N.succ ?a) ] => rewrite (N2Z.inj_succ a)
+
+ (* N.mul -> Z.mul and a positivity hypothesis *)
+ | H : context [ Z.of_N (N.mul ?a ?b) ] |- _ =>
+ pose proof (N2Z.is_nonneg (N.mul a b)); rewrite (N2Z.inj_mul a b) in *
+ | |- context [ Z.of_N (N.mul ?a ?b) ] =>
+ pose proof (N2Z.is_nonneg (N.mul a b)); rewrite (N2Z.inj_mul a b) in *
(* atoms of type N : we add a positivity condition (if not already there) *)
- | _ : 0 <= Z_of_N ?a |- _ => hide_Z_of_N a
- | _ : context [ Z_of_N ?a ] |- _ => pose proof (Z_of_N_le_0 a); hide_Z_of_N a
- | |- context [ Z_of_N ?a ] => pose proof (Z_of_N_le_0 a); hide_Z_of_N a
+ | _ : 0 <= Z.of_N ?a |- _ => hide_Z_of_N a
+ | _ : context [ Z.of_N ?a ] |- _ => pose proof (N2Z.is_nonneg a); hide_Z_of_N a
+ | |- context [ Z.of_N ?a ] => pose proof (N2Z.is_nonneg a); hide_Z_of_N a
end.
Ltac zify_N := repeat zify_N_rel; repeat zify_N_op; unfold Z_of_N' in *.
diff --git a/plugins/omega/coq_omega.ml b/plugins/omega/coq_omega.ml
index d7dfe149..028ef95d 100644
--- a/plugins/omega/coq_omega.ml
+++ b/plugins/omega/coq_omega.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -170,6 +170,9 @@ let init_constant = gen_constant_in_modules "Omega" init_modules
let constant = gen_constant_in_modules "Omega" coq_modules
let z_constant = gen_constant_in_modules "Omega" [["Coq";"ZArith"]]
+let zbase_constant =
+ gen_constant_in_modules "Omega" [["Coq";"ZArith";"BinInt"]]
+
(* Zarith *)
let coq_xH = lazy (constant "xH")
@@ -181,20 +184,20 @@ let coq_Zneg = lazy (constant "Zneg")
let coq_Z = lazy (constant "Z")
let coq_comparison = lazy (constant "comparison")
let coq_Gt = lazy (constant "Gt")
-let coq_Zplus = lazy (constant "Zplus")
-let coq_Zmult = lazy (constant "Zmult")
-let coq_Zopp = lazy (constant "Zopp")
-let coq_Zminus = lazy (constant "Zminus")
-let coq_Zsucc = lazy (constant "Zsucc")
-let coq_Zpred = lazy (constant "Zpred")
-let coq_Zgt = lazy (constant "Zgt")
-let coq_Zle = lazy (constant "Zle")
-let coq_Z_of_nat = lazy (constant "Z_of_nat")
-let coq_inj_plus = lazy (constant "inj_plus")
-let coq_inj_mult = lazy (constant "inj_mult")
-let coq_inj_minus1 = lazy (constant "inj_minus1")
+let coq_Zplus = lazy (zbase_constant "Z.add")
+let coq_Zmult = lazy (zbase_constant "Z.mul")
+let coq_Zopp = lazy (zbase_constant "Z.opp")
+let coq_Zminus = lazy (zbase_constant "Z.sub")
+let coq_Zsucc = lazy (zbase_constant "Z.succ")
+let coq_Zpred = lazy (zbase_constant "Z.pred")
+let coq_Zgt = lazy (zbase_constant "Z.gt")
+let coq_Zle = lazy (zbase_constant "Z.le")
+let coq_Z_of_nat = lazy (zbase_constant "Z.of_nat")
+let coq_inj_plus = lazy (z_constant "Nat2Z.inj_add")
+let coq_inj_mult = lazy (z_constant "Nat2Z.inj_mul")
+let coq_inj_minus1 = lazy (z_constant "Nat2Z.inj_sub")
let coq_inj_minus2 = lazy (constant "inj_minus2")
-let coq_inj_S = lazy (z_constant "inj_S")
+let coq_inj_S = lazy (z_constant "Nat2Z.inj_succ")
let coq_inj_le = lazy (z_constant "Znat.inj_le")
let coq_inj_lt = lazy (z_constant "Znat.inj_lt")
let coq_inj_ge = lazy (z_constant "Znat.inj_ge")
@@ -250,10 +253,10 @@ let coq_Zle_left = lazy (constant "Zle_left")
let coq_new_var = lazy (constant "new_var")
let coq_intro_Z = lazy (constant "intro_Z")
-let coq_dec_eq = lazy (constant "dec_eq")
+let coq_dec_eq = lazy (zbase_constant "Z.eq_decidable")
let coq_dec_Zne = lazy (constant "dec_Zne")
-let coq_dec_Zle = lazy (constant "dec_Zle")
-let coq_dec_Zlt = lazy (constant "dec_Zlt")
+let coq_dec_Zle = lazy (zbase_constant "Z.le_decidable")
+let coq_dec_Zlt = lazy (zbase_constant "Z.lt_decidable")
let coq_dec_Zgt = lazy (constant "dec_Zgt")
let coq_dec_Zge = lazy (constant "dec_Zge")
@@ -265,10 +268,10 @@ let coq_Znot_ge_lt = lazy (constant "Znot_ge_lt")
let coq_Znot_gt_le = lazy (constant "Znot_gt_le")
let coq_neq = lazy (constant "neq")
let coq_Zne = lazy (constant "Zne")
-let coq_Zle = lazy (constant "Zle")
-let coq_Zgt = lazy (constant "Zgt")
-let coq_Zge = lazy (constant "Zge")
-let coq_Zlt = lazy (constant "Zlt")
+let coq_Zle = lazy (zbase_constant "Z.le")
+let coq_Zgt = lazy (zbase_constant "Z.gt")
+let coq_Zge = lazy (zbase_constant "Z.ge")
+let coq_Zlt = lazy (zbase_constant "Z.lt")
(* Peano/Datatypes *)
let coq_le = lazy (init_constant "le")
@@ -326,13 +329,13 @@ let evaluable_ref_of_constr s c = match kind_of_term (Lazy.force c) with
EvalConstRef kn
| _ -> anomaly ("Coq_omega: "^s^" is not an evaluable constant")
-let sp_Zsucc = lazy (evaluable_ref_of_constr "Zsucc" coq_Zsucc)
-let sp_Zpred = lazy (evaluable_ref_of_constr "Zpred" coq_Zpred)
-let sp_Zminus = lazy (evaluable_ref_of_constr "Zminus" coq_Zminus)
-let sp_Zle = lazy (evaluable_ref_of_constr "Zle" coq_Zle)
-let sp_Zgt = lazy (evaluable_ref_of_constr "Zgt" coq_Zgt)
-let sp_Zge = lazy (evaluable_ref_of_constr "Zge" coq_Zge)
-let sp_Zlt = lazy (evaluable_ref_of_constr "Zlt" coq_Zlt)
+let sp_Zsucc = lazy (evaluable_ref_of_constr "Z.succ" coq_Zsucc)
+let sp_Zpred = lazy (evaluable_ref_of_constr "Z.pred" coq_Zpred)
+let sp_Zminus = lazy (evaluable_ref_of_constr "Z.sub" coq_Zminus)
+let sp_Zle = lazy (evaluable_ref_of_constr "Z.le" coq_Zle)
+let sp_Zgt = lazy (evaluable_ref_of_constr "Z.gt" coq_Zgt)
+let sp_Zge = lazy (evaluable_ref_of_constr "Z.ge" coq_Zge)
+let sp_Zlt = lazy (evaluable_ref_of_constr "Z.lt" coq_Zlt)
let sp_not = lazy (evaluable_ref_of_constr "not" (lazy (build_coq_not ())))
let mk_var v = mkVar (id_of_string v)
diff --git a/plugins/omega/g_omega.ml4 b/plugins/omega/g_omega.ml4
index 84cc8464..1542b60c 100644
--- a/plugins/omega/g_omega.ml4
+++ b/plugins/omega/g_omega.ml4
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/omega/omega.ml b/plugins/omega/omega.ml
index 3a5aece7..98cad09e 100644
--- a/plugins/omega/omega.ml
+++ b/plugins/omega/omega.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/quote/Quote.v b/plugins/quote/Quote.v
index e2d8e67e..2206aedf 100644
--- a/plugins/quote/Quote.v
+++ b/plugins/quote/Quote.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -67,7 +67,7 @@ Fixpoint index_lt (n m:index) {struct m} : bool :=
end.
Lemma index_eq_prop : forall n m:index, index_eq n m = true -> n = m.
- simple induction n; simple induction m; simpl in |- *; intros.
+ simple induction n; simple induction m; simpl; intros.
rewrite (H i0 H1); reflexivity.
discriminate.
discriminate.
diff --git a/plugins/quote/g_quote.ml4 b/plugins/quote/g_quote.ml4
index 1f4ea97f..09b780fd 100644
--- a/plugins/quote/g_quote.ml4
+++ b/plugins/quote/g_quote.ml4
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/quote/quote.ml b/plugins/quote/quote.ml
index fbb75420..f0ca3bb9 100644
--- a/plugins/quote/quote.ml
+++ b/plugins/quote/quote.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/ring/LegacyArithRing.v b/plugins/ring/LegacyArithRing.v
index fd5bcd93..089dec02 100644
--- a/plugins/ring/LegacyArithRing.v
+++ b/plugins/ring/LegacyArithRing.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -13,7 +13,7 @@ Require Export LegacyRing.
Require Export Arith.
Require Import Eqdep_dec.
-Open Local Scope nat_scope.
+Local Open Scope nat_scope.
Fixpoint nateq (n m:nat) {struct m} : bool :=
match n, m with
@@ -75,14 +75,14 @@ Ltac rewrite_S_to_plus :=
(**) (**)
rewrite_S_to_plus_term X1
with t2 := rewrite_S_to_plus_term X2 in
- change (t1 = t2) in |- *
+ change (t1 = t2)
| |- (?X1 = ?X2) =>
try
let t1 :=
(**) (**)
rewrite_S_to_plus_term X1
with t2 := rewrite_S_to_plus_term X2 in
- change (t1 = t2) in |- *
+ change (t1 = t2)
end.
Ltac ring_nat := rewrite_S_to_plus; ring.
diff --git a/plugins/ring/LegacyNArithRing.v b/plugins/ring/LegacyNArithRing.v
index 5dcd6d84..7f1597a1 100644
--- a/plugins/ring/LegacyNArithRing.v
+++ b/plugins/ring/LegacyNArithRing.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -22,23 +22,22 @@ Definition Neq (n m:N) :=
Lemma Neq_prop : forall n m:N, Is_true (Neq n m) -> n = m.
intros n m H; unfold Neq in H.
- apply Ncompare_Eq_eq.
+ apply N.compare_eq.
destruct (n ?= m)%N; [ reflexivity | contradiction | contradiction ].
Qed.
-Definition NTheory : Semi_Ring_Theory Nplus Nmult 1%N 0%N Neq.
+Definition NTheory : Semi_Ring_Theory N.add N.mul 1%N 0%N Neq.
split.
- apply Nplus_comm.
- apply Nplus_assoc.
- apply Nmult_comm.
- apply Nmult_assoc.
- apply Nplus_0_l.
- apply Nmult_1_l.
- apply Nmult_0_l.
- apply Nmult_plus_distr_r.
-(* apply Nplus_reg_l.*)
+ apply N.add_comm.
+ apply N.add_assoc.
+ apply N.mul_comm.
+ apply N.mul_assoc.
+ apply N.add_0_l.
+ apply N.mul_1_l.
+ apply N.mul_0_l.
+ apply N.mul_add_distr_r.
apply Neq_prop.
Qed.
Add Legacy Semi Ring
- N Nplus Nmult 1%N 0%N Neq NTheory [ Npos 0%N xO xI 1%positive ].
+ N N.add N.mul 1%N 0%N Neq NTheory [ Npos 0%N xO xI 1%positive ].
diff --git a/plugins/ring/LegacyRing.v b/plugins/ring/LegacyRing.v
index d19e9f58..d4f40081 100644
--- a/plugins/ring/LegacyRing.v
+++ b/plugins/ring/LegacyRing.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -19,7 +19,7 @@ Declare ML Module "ring_plugin".
Definition BoolTheory :
Ring_Theory xorb andb true false (fun b:bool => b) eqb.
-split; simpl in |- *.
+split; simpl.
destruct n; destruct m; reflexivity.
destruct n; destruct m; destruct p; reflexivity.
destruct n; destruct m; reflexivity.
@@ -28,7 +28,7 @@ destruct n; reflexivity.
destruct n; reflexivity.
destruct n; reflexivity.
destruct n; destruct m; destruct p; reflexivity.
-destruct x; destruct y; reflexivity || simpl in |- *; tauto.
+destruct x; destruct y; reflexivity || simpl; tauto.
Defined.
Add Legacy Ring bool xorb andb true false (fun b:bool => b) eqb BoolTheory
diff --git a/plugins/ring/LegacyRing_theory.v b/plugins/ring/LegacyRing_theory.v
index ca3355a6..09de1bb4 100644
--- a/plugins/ring/LegacyRing_theory.v
+++ b/plugins/ring/LegacyRing_theory.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -58,22 +58,22 @@ Hint Resolve plus_comm plus_assoc mult_comm mult_assoc plus_zero_left
(* Lemmas whose form is x=y are also provided in form y=x because Auto does
not symmetry *)
Lemma SR_mult_assoc2 : forall n m p:A, n * m * p = n * (m * p).
-symmetry in |- *; eauto. Qed.
+symmetry ; eauto. Qed.
Lemma SR_plus_assoc2 : forall n m p:A, n + m + p = n + (m + p).
-symmetry in |- *; eauto. Qed.
+symmetry ; eauto. Qed.
Lemma SR_plus_zero_left2 : forall n:A, n = 0 + n.
-symmetry in |- *; eauto. Qed.
+symmetry ; eauto. Qed.
Lemma SR_mult_one_left2 : forall n:A, n = 1 * n.
-symmetry in |- *; eauto. Qed.
+symmetry ; eauto. Qed.
Lemma SR_mult_zero_left2 : forall n:A, 0 = 0 * n.
-symmetry in |- *; eauto. Qed.
+symmetry ; eauto. Qed.
Lemma SR_distr_left2 : forall n m p:A, n * p + m * p = (n + m) * p.
-symmetry in |- *; eauto. Qed.
+symmetry ; eauto. Qed.
Lemma SR_plus_permute : forall n m p:A, n + (m + p) = m + (n + p).
intros.
@@ -100,7 +100,7 @@ eauto.
Qed.
Lemma SR_distr_right2 : forall n m p:A, n * m + n * p = n * (m + p).
-symmetry in |- *; apply SR_distr_right. Qed.
+symmetry ; apply SR_distr_right. Qed.
Lemma SR_mult_zero_right : forall n:A, n * 0 = 0.
intro; rewrite mult_comm; eauto.
@@ -176,22 +176,22 @@ Hint Resolve plus_comm plus_assoc mult_comm mult_assoc plus_zero_left
(* Lemmas whose form is x=y are also provided in form y=x because Auto does
not symmetry *)
Lemma Th_mult_assoc2 : forall n m p:A, n * m * p = n * (m * p).
-symmetry in |- *; eauto. Qed.
+symmetry ; eauto. Qed.
Lemma Th_plus_assoc2 : forall n m p:A, n + m + p = n + (m + p).
-symmetry in |- *; eauto. Qed.
+symmetry ; eauto. Qed.
Lemma Th_plus_zero_left2 : forall n:A, n = 0 + n.
-symmetry in |- *; eauto. Qed.
+symmetry ; eauto. Qed.
Lemma Th_mult_one_left2 : forall n:A, n = 1 * n.
-symmetry in |- *; eauto. Qed.
+symmetry ; eauto. Qed.
Lemma Th_distr_left2 : forall n m p:A, n * p + m * p = (n + m) * p.
-symmetry in |- *; eauto. Qed.
+symmetry ; eauto. Qed.
Lemma Th_opp_def2 : forall n:A, 0 = n + - n.
-symmetry in |- *; eauto. Qed.
+symmetry ; eauto. Qed.
Lemma Th_plus_permute : forall n m p:A, n + (m + p) = m + (n + p).
intros.
@@ -214,7 +214,7 @@ Hint Resolve Th_plus_permute Th_mult_permute.
Lemma aux1 : forall a:A, a + a = a -> a = 0.
intros.
generalize (opp_def a).
-pattern a at 1 in |- *.
+pattern a at 1.
rewrite <- H.
rewrite <- plus_assoc.
rewrite opp_def.
@@ -233,7 +233,7 @@ Qed.
Hint Resolve Th_mult_zero_left.
Lemma Th_mult_zero_left2 : forall n:A, 0 = 0 * n.
-symmetry in |- *; eauto. Qed.
+symmetry ; eauto. Qed.
Lemma aux2 : forall x y z:A, x + y = 0 -> x + z = 0 -> y = z.
intros.
@@ -255,7 +255,7 @@ Qed.
Hint Resolve Th_opp_mult_left.
Lemma Th_opp_mult_left2 : forall x y:A, - x * y = - (x * y).
-symmetry in |- *; eauto. Qed.
+symmetry ; eauto. Qed.
Lemma Th_mult_zero_right : forall n:A, n * 0 = 0.
intro; elim mult_comm; eauto.
@@ -306,14 +306,14 @@ Qed.
Hint Resolve Th_opp_opp.
Lemma Th_opp_opp2 : forall n:A, n = - - n.
-symmetry in |- *; eauto. Qed.
+symmetry ; eauto. Qed.
Lemma Th_mult_opp_opp : forall x y:A, - x * - y = x * y.
intros; rewrite <- Th_opp_mult_left; rewrite <- Th_opp_mult_right; auto.
Qed.
Lemma Th_mult_opp_opp2 : forall x y:A, x * y = - x * - y.
-symmetry in |- *; apply Th_mult_opp_opp. Qed.
+symmetry ; apply Th_mult_opp_opp. Qed.
Lemma Th_opp_zero : - 0 = 0.
rewrite <- (plus_zero_left (- 0)).
@@ -342,7 +342,7 @@ eauto.
Qed.
Lemma Th_distr_right2 : forall n m p:A, n * m + n * p = n * (m + p).
-symmetry in |- *; apply Th_distr_right.
+symmetry ; apply Th_distr_right.
Qed.
End Theory_of_rings.
@@ -357,7 +357,7 @@ Definition Semi_Ring_Theory_of :
Ring_Theory Aplus Amult Aone Azero Aopp Aeq ->
Semi_Ring_Theory Aplus Amult Aone Azero Aeq.
intros until 1; case H.
-split; intros; simpl in |- *; eauto.
+split; intros; simpl; eauto.
Defined.
(* Every ring can be viewed as a semi-ring : this property will be used
diff --git a/plugins/ring/LegacyZArithRing.v b/plugins/ring/LegacyZArithRing.v
index 5845062d..3f01a5c3 100644
--- a/plugins/ring/LegacyZArithRing.v
+++ b/plugins/ring/LegacyZArithRing.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -21,15 +21,15 @@ Definition Zeq (x y:Z) :=
Lemma Zeq_prop : forall x y:Z, Is_true (Zeq x y) -> x = y.
intros x y H; unfold Zeq in H.
- apply Zcompare_Eq_eq.
+ apply Z.compare_eq.
destruct (x ?= y)%Z; [ reflexivity | contradiction | contradiction ].
Qed.
-Definition ZTheory : Ring_Theory Zplus Zmult 1%Z 0%Z Zopp Zeq.
+Definition ZTheory : Ring_Theory Z.add Z.mul 1%Z 0%Z Z.opp Zeq.
split; intros; eauto with zarith.
apply Zeq_prop; assumption.
Qed.
(* NatConstants and NatTheory are defined in Ring_theory.v *)
-Add Legacy Ring Z Zplus Zmult 1%Z 0%Z Zopp Zeq ZTheory
+Add Legacy Ring Z Z.add Z.mul 1%Z 0%Z Z.opp Zeq ZTheory
[ Zpos Zneg 0%Z xO xI 1%positive ].
diff --git a/plugins/ring/Ring_abstract.v b/plugins/ring/Ring_abstract.v
index 1763d70a..a00b7bcd 100644
--- a/plugins/ring/Ring_abstract.v
+++ b/plugins/ring/Ring_abstract.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -137,14 +137,13 @@ 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 refl_equal sym_equal trans_equal.
-(*Hints Resolve refl_eqT sym_eqT trans_eqT.*)
+Hint Resolve eq_refl eq_sym eq_trans.
Hint Immediate T.
Remark iacs_aux_ok :
forall (x:A) (s:abstract_sum), iacs_aux x s = Aplus x (interp_acs s).
Proof.
- simple induction s; simpl in |- *; intros.
+ simple induction s; simpl; intros.
trivial.
reflexivity.
Qed.
@@ -159,8 +158,8 @@ Lemma abstract_varlist_insert_ok :
simple induction s.
trivial.
- simpl in |- *; intros.
- elim (varlist_lt l v); simpl in |- *.
+ simpl; intros.
+ elim (varlist_lt l v); simpl.
eauto.
rewrite iacs_aux_ok.
rewrite H; auto.
@@ -178,13 +177,13 @@ Proof.
auto.
- simpl in |- *; elim (varlist_lt v v0); simpl in |- *.
+ simpl; elim (varlist_lt v v0); simpl.
repeat rewrite iacs_aux_ok.
- rewrite H; simpl in |- *; auto.
+ rewrite H; simpl; auto.
simpl in H0.
repeat rewrite iacs_aux_ok.
- rewrite H0. simpl in |- *; auto.
+ rewrite H0. simpl; auto.
Qed.
Lemma abstract_sum_scalar_ok :
@@ -193,9 +192,9 @@ Lemma abstract_sum_scalar_ok :
Amult (interp_vl Amult Aone Azero vm l) (interp_acs s).
Proof.
simple induction s.
- simpl in |- *; eauto.
+ simpl; eauto.
- simpl in |- *; intros.
+ simpl; intros.
rewrite iacs_aux_ok.
rewrite abstract_varlist_insert_ok.
rewrite H.
@@ -209,22 +208,22 @@ Lemma abstract_sum_prod_ok :
Proof.
simple induction x.
- intros; simpl in |- *; eauto.
+ intros; simpl; eauto.
destruct y as [| v0 a0]; intros.
- simpl in |- *; rewrite H; eauto.
+ simpl; rewrite H; eauto.
- unfold abstract_sum_prod in |- *; fold abstract_sum_prod in |- *.
+ unfold abstract_sum_prod; fold abstract_sum_prod.
rewrite abstract_sum_merge_ok.
rewrite abstract_sum_scalar_ok.
- rewrite H; simpl in |- *; auto.
+ rewrite H; simpl; auto.
Qed.
Theorem aspolynomial_normalize_ok :
forall x:aspolynomial, interp_asp x = interp_acs (aspolynomial_normalize x).
Proof.
- simple induction x; simpl in |- *; intros; trivial.
+ simple induction x; simpl; intros; trivial.
rewrite abstract_sum_merge_ok.
rewrite H; rewrite H0; eauto.
rewrite abstract_sum_prod_ok.
@@ -446,14 +445,13 @@ 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 refl_equal sym_equal trans_equal.
-(*Hints Resolve refl_eqT sym_eqT trans_eqT.*)
+Hint Resolve eq_refl eq_sym eq_trans.
Hint Immediate T.
Lemma isacs_aux_ok :
forall (x:A) (s:signed_sum), isacs_aux x s = Aplus x (interp_sacs s).
Proof.
- simple induction s; simpl in |- *; intros.
+ simple induction s; simpl; intros.
trivial.
reflexivity.
reflexivity.
@@ -462,15 +460,15 @@ Qed.
Hint Extern 10 (_ = _ :>A) => rewrite isacs_aux_ok: core.
Ltac solve1 v v0 H H0 :=
- simpl in |- *; elim (varlist_lt v v0); simpl in |- *; rewrite isacs_aux_ok;
- [ rewrite H; simpl in |- *; auto | simpl in H0; rewrite H0; auto ].
+ simpl; elim (varlist_lt v v0); simpl; rewrite isacs_aux_ok;
+ [ rewrite H; simpl; auto | simpl in H0; rewrite H0; auto ].
Lemma signed_sum_merge_ok :
forall x y:signed_sum,
interp_sacs (signed_sum_merge x y) = Aplus (interp_sacs x) (interp_sacs y).
simple induction x.
- intro; simpl in |- *; auto.
+ intro; simpl; auto.
simple induction y; intros.
@@ -478,8 +476,8 @@ Lemma signed_sum_merge_ok :
solve1 v v0 H H0.
- simpl in |- *; generalize (varlist_eq_prop v v0).
- elim (varlist_eq v v0); simpl in |- *.
+ simpl; generalize (varlist_eq_prop v v0).
+ elim (varlist_eq v v0); simpl.
intro Heq; rewrite (Heq I).
rewrite H.
@@ -499,8 +497,8 @@ Lemma signed_sum_merge_ok :
auto.
- simpl in |- *; generalize (varlist_eq_prop v v0).
- elim (varlist_eq v v0); simpl in |- *.
+ simpl; generalize (varlist_eq_prop v v0).
+ elim (varlist_eq v v0); simpl.
intro Heq; rewrite (Heq I).
rewrite H.
@@ -518,7 +516,7 @@ Lemma signed_sum_merge_ok :
Qed.
Ltac solve2 l v H :=
- elim (varlist_lt l v); simpl in |- *; rewrite isacs_aux_ok;
+ elim (varlist_lt l v); simpl; rewrite isacs_aux_ok;
[ auto | rewrite H; auto ].
Lemma plus_varlist_insert_ok :
@@ -530,12 +528,12 @@ Proof.
simple induction s.
trivial.
- simpl in |- *; intros.
+ simpl; intros.
solve2 l v H.
- simpl in |- *; intros.
+ simpl; intros.
generalize (varlist_eq_prop l v).
- elim (varlist_eq l v); simpl in |- *.
+ elim (varlist_eq l v); simpl.
intro Heq; rewrite (Heq I).
repeat rewrite isacs_aux_ok.
@@ -557,9 +555,9 @@ Proof.
simple induction s.
trivial.
- simpl in |- *; intros.
+ simpl; intros.
generalize (varlist_eq_prop l v).
- elim (varlist_eq l v); simpl in |- *.
+ elim (varlist_eq l v); simpl.
intro Heq; rewrite (Heq I).
repeat rewrite isacs_aux_ok.
@@ -570,10 +568,10 @@ Proof.
rewrite (Th_opp_def T).
auto.
- simpl in |- *; intros.
+ simpl; intros.
solve2 l v H.
- simpl in |- *; intros; solve2 l v H.
+ simpl; intros; solve2 l v H.
Qed.
@@ -581,9 +579,9 @@ Lemma signed_sum_opp_ok :
forall s:signed_sum, interp_sacs (signed_sum_opp s) = Aopp (interp_sacs s).
Proof.
- simple induction s; simpl in |- *; intros.
+ simple induction s; simpl; intros.
- symmetry in |- *; apply (Th_opp_zero T).
+ symmetry ; apply (Th_opp_zero T).
repeat rewrite isacs_aux_ok.
rewrite H.
@@ -607,14 +605,14 @@ Proof.
simple induction s.
trivial.
- simpl in |- *; intros.
+ simpl; intros.
rewrite plus_varlist_insert_ok.
rewrite (varlist_merge_ok A Aplus Amult Aone Azero Aeq vm T).
repeat rewrite isacs_aux_ok.
rewrite H.
auto.
- simpl in |- *; intros.
+ simpl; intros.
rewrite minus_varlist_insert_ok.
repeat rewrite isacs_aux_ok.
rewrite (varlist_merge_ok A Aplus Amult Aone Azero Aeq vm T).
@@ -631,11 +629,11 @@ Lemma minus_sum_scalar_ok :
Aopp (Amult (interp_vl Amult Aone Azero vm l) (interp_sacs s)).
Proof.
- simple induction s; simpl in |- *; intros.
+ simple induction s; simpl; intros.
- rewrite (Th_mult_zero_right T); symmetry in |- *; apply (Th_opp_zero T).
+ rewrite (Th_mult_zero_right T); symmetry ; apply (Th_opp_zero T).
- simpl in |- *; intros.
+ simpl; intros.
rewrite minus_varlist_insert_ok.
rewrite (varlist_merge_ok A Aplus Amult Aone Azero Aeq vm T).
repeat rewrite isacs_aux_ok.
@@ -644,7 +642,7 @@ Proof.
rewrite (Th_plus_opp_opp T).
reflexivity.
- simpl in |- *; intros.
+ simpl; intros.
rewrite plus_varlist_insert_ok.
repeat rewrite isacs_aux_ok.
rewrite (varlist_merge_ok A Aplus Amult Aone Azero Aeq vm T).
@@ -664,16 +662,16 @@ Proof.
simple induction x.
- simpl in |- *; eauto 1.
+ simpl; eauto 1.
- intros; simpl in |- *.
+ intros; simpl.
rewrite signed_sum_merge_ok.
rewrite plus_sum_scalar_ok.
repeat rewrite isacs_aux_ok.
rewrite H.
auto.
- intros; simpl in |- *.
+ intros; simpl.
repeat rewrite isacs_aux_ok.
rewrite signed_sum_merge_ok.
rewrite minus_sum_scalar_ok.
@@ -687,7 +685,7 @@ Qed.
Theorem apolynomial_normalize_ok :
forall p:apolynomial, interp_sacs (apolynomial_normalize p) = interp_ap p.
Proof.
- simple induction p; simpl in |- *; auto 1.
+ simple induction p; simpl; auto 1.
intros.
rewrite signed_sum_merge_ok.
rewrite H; rewrite H0; reflexivity.
diff --git a/plugins/ring/Ring_normalize.v b/plugins/ring/Ring_normalize.v
index c6dff3e0..d286208a 100644
--- a/plugins/ring/Ring_normalize.v
+++ b/plugins/ring/Ring_normalize.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -16,7 +16,7 @@ Proof.
intros.
apply index_eq_prop.
generalize H.
- case (index_eq n m); simpl in |- *; trivial; intros.
+ case (index_eq n m); simpl; trivial; intros.
contradiction.
Qed.
@@ -365,14 +365,13 @@ 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 refl_equal sym_equal trans_equal.
-(* Hints Resolve refl_eqT sym_eqT trans_eqT. *)
+Hint Resolve eq_refl eq_sym eq_trans.
Hint Immediate T.
Lemma varlist_eq_prop : forall x y:varlist, Is_true (varlist_eq x y) -> x = y.
Proof.
simple induction x; simple induction y; contradiction || (try reflexivity).
- simpl in |- *; intros.
+ simpl; intros.
generalize (andb_prop2 _ _ H1); intros; elim H2; intros.
rewrite (index_eq_prop _ _ H3); rewrite (H v0 H4); reflexivity.
Qed.
@@ -381,7 +380,7 @@ Remark ivl_aux_ok :
forall (v:varlist) (i:index),
ivl_aux i v = Amult (interp_var i) (interp_vl v).
Proof.
- simple induction v; simpl in |- *; intros.
+ simple induction v; simpl; intros.
trivial.
rewrite H; trivial.
Qed.
@@ -391,14 +390,14 @@ Lemma varlist_merge_ok :
interp_vl (varlist_merge x y) = Amult (interp_vl x) (interp_vl y).
Proof.
simple induction x.
- simpl in |- *; trivial.
+ simpl; trivial.
simple induction y.
- simpl in |- *; trivial.
- simpl in |- *; intros.
- elim (index_lt i i0); simpl in |- *; intros.
+ simpl; trivial.
+ simpl; intros.
+ elim (index_lt i i0); simpl; intros.
repeat rewrite ivl_aux_ok.
- rewrite H. simpl in |- *.
+ rewrite H. simpl.
rewrite ivl_aux_ok.
eauto.
@@ -411,7 +410,7 @@ Qed.
Remark ics_aux_ok :
forall (x:A) (s:canonical_sum), ics_aux x s = Aplus x (interp_cs s).
Proof.
- simple induction s; simpl in |- *; intros.
+ simple induction s; simpl; intros.
trivial.
reflexivity.
reflexivity.
@@ -421,7 +420,7 @@ Remark interp_m_ok :
forall (x:A) (l:varlist), interp_m x l = Amult x (interp_vl l).
Proof.
destruct l as [| i v].
- simpl in |- *; trivial.
+ simpl; trivial.
reflexivity.
Qed.
@@ -429,10 +428,10 @@ Lemma canonical_sum_merge_ok :
forall x y:canonical_sum,
interp_cs (canonical_sum_merge x y) = Aplus (interp_cs x) (interp_cs y).
-simple induction x; simpl in |- *.
+simple induction x; simpl.
trivial.
-simple induction y; simpl in |- *; intros.
+simple induction y; simpl; intros.
(* monom and nil *)
eauto.
@@ -440,25 +439,25 @@ eauto.
generalize (varlist_eq_prop v v0).
elim (varlist_eq v v0).
intros; rewrite (H1 I).
-simpl in |- *; repeat rewrite ics_aux_ok; rewrite H.
+simpl; repeat rewrite ics_aux_ok; rewrite H.
repeat rewrite interp_m_ok.
rewrite (SR_distr_left T).
repeat rewrite <- (SR_plus_assoc T).
apply f_equal with (f := Aplus (Amult a (interp_vl v0))).
trivial.
-elim (varlist_lt v v0); simpl in |- *.
+elim (varlist_lt v v0); simpl.
repeat rewrite ics_aux_ok.
-rewrite H; simpl in |- *; rewrite ics_aux_ok; eauto.
+rewrite H; simpl; rewrite ics_aux_ok; eauto.
-rewrite ics_aux_ok; rewrite H0; repeat rewrite ics_aux_ok; simpl in |- *;
+rewrite ics_aux_ok; rewrite H0; repeat rewrite ics_aux_ok; simpl;
eauto.
(* monom and varlist *)
generalize (varlist_eq_prop v v0).
elim (varlist_eq v v0).
intros; rewrite (H1 I).
-simpl in |- *; repeat rewrite ics_aux_ok; rewrite H.
+simpl; repeat rewrite ics_aux_ok; rewrite H.
repeat rewrite interp_m_ok.
rewrite (SR_distr_left T).
repeat rewrite <- (SR_plus_assoc T).
@@ -466,13 +465,13 @@ apply f_equal with (f := Aplus (Amult a (interp_vl v0))).
rewrite (SR_mult_one_left T).
trivial.
-elim (varlist_lt v v0); simpl in |- *.
+elim (varlist_lt v v0); simpl.
repeat rewrite ics_aux_ok.
-rewrite H; simpl in |- *; rewrite ics_aux_ok; eauto.
-rewrite ics_aux_ok; rewrite H0; repeat rewrite ics_aux_ok; simpl in |- *;
+rewrite H; simpl; rewrite ics_aux_ok; eauto.
+rewrite ics_aux_ok; rewrite H0; repeat rewrite ics_aux_ok; simpl;
eauto.
-simple induction y; simpl in |- *; intros.
+simple induction y; simpl; intros.
(* varlist and nil *)
trivial.
@@ -480,7 +479,7 @@ trivial.
generalize (varlist_eq_prop v v0).
elim (varlist_eq v v0).
intros; rewrite (H1 I).
-simpl in |- *; repeat rewrite ics_aux_ok; rewrite H.
+simpl; repeat rewrite ics_aux_ok; rewrite H.
repeat rewrite interp_m_ok.
rewrite (SR_distr_left T).
repeat rewrite <- (SR_plus_assoc T).
@@ -488,17 +487,17 @@ rewrite (SR_mult_one_left T).
apply f_equal with (f := Aplus (interp_vl v0)).
trivial.
-elim (varlist_lt v v0); simpl in |- *.
+elim (varlist_lt v v0); simpl.
repeat rewrite ics_aux_ok.
-rewrite H; simpl in |- *; rewrite ics_aux_ok; eauto.
-rewrite ics_aux_ok; rewrite H0; repeat rewrite ics_aux_ok; simpl in |- *;
+rewrite H; simpl; rewrite ics_aux_ok; eauto.
+rewrite ics_aux_ok; rewrite H0; repeat rewrite ics_aux_ok; simpl;
eauto.
(* varlist and varlist *)
generalize (varlist_eq_prop v v0).
elim (varlist_eq v v0).
intros; rewrite (H1 I).
-simpl in |- *; repeat rewrite ics_aux_ok; rewrite H.
+simpl; repeat rewrite ics_aux_ok; rewrite H.
repeat rewrite interp_m_ok.
rewrite (SR_distr_left T).
repeat rewrite <- (SR_plus_assoc T).
@@ -506,10 +505,10 @@ rewrite (SR_mult_one_left T).
apply f_equal with (f := Aplus (interp_vl v0)).
trivial.
-elim (varlist_lt v v0); simpl in |- *.
+elim (varlist_lt v v0); simpl.
repeat rewrite ics_aux_ok.
-rewrite H; simpl in |- *; rewrite ics_aux_ok; eauto.
-rewrite ics_aux_ok; rewrite H0; repeat rewrite ics_aux_ok; simpl in |- *;
+rewrite H; simpl; rewrite ics_aux_ok; eauto.
+rewrite ics_aux_ok; rewrite H0; repeat rewrite ics_aux_ok; simpl;
eauto.
Qed.
@@ -519,24 +518,24 @@ Lemma monom_insert_ok :
Aplus (Amult a (interp_vl l)) (interp_cs s).
intros; generalize s; simple induction s0.
-simpl in |- *; rewrite interp_m_ok; trivial.
+simpl; rewrite interp_m_ok; trivial.
-simpl in |- *; intros.
+simpl; intros.
generalize (varlist_eq_prop l v); elim (varlist_eq l v).
-intro Hr; rewrite (Hr I); simpl in |- *; rewrite interp_m_ok;
+intro Hr; rewrite (Hr I); simpl; rewrite interp_m_ok;
repeat rewrite ics_aux_ok; rewrite interp_m_ok; rewrite (SR_distr_left T);
eauto.
-elim (varlist_lt l v); simpl in |- *;
+elim (varlist_lt l v); simpl;
[ repeat rewrite interp_m_ok; rewrite ics_aux_ok; eauto
| repeat rewrite interp_m_ok; rewrite ics_aux_ok; rewrite H;
rewrite ics_aux_ok; eauto ].
-simpl in |- *; intros.
+simpl; intros.
generalize (varlist_eq_prop l v); elim (varlist_eq l v).
-intro Hr; rewrite (Hr I); simpl in |- *; rewrite interp_m_ok;
+intro Hr; rewrite (Hr I); simpl; rewrite interp_m_ok;
repeat rewrite ics_aux_ok; rewrite (SR_distr_left T);
rewrite (SR_mult_one_left T); eauto.
-elim (varlist_lt l v); simpl in |- *;
+elim (varlist_lt l v); simpl;
[ repeat rewrite interp_m_ok; rewrite ics_aux_ok; eauto
| repeat rewrite interp_m_ok; rewrite ics_aux_ok; rewrite H;
rewrite ics_aux_ok; eauto ].
@@ -547,24 +546,24 @@ Lemma varlist_insert_ok :
interp_cs (varlist_insert l s) = Aplus (interp_vl l) (interp_cs s).
intros; generalize s; simple induction s0.
-simpl in |- *; trivial.
+simpl; trivial.
-simpl in |- *; intros.
+simpl; intros.
generalize (varlist_eq_prop l v); elim (varlist_eq l v).
-intro Hr; rewrite (Hr I); simpl in |- *; rewrite interp_m_ok;
+intro Hr; rewrite (Hr I); simpl; rewrite interp_m_ok;
repeat rewrite ics_aux_ok; rewrite interp_m_ok; rewrite (SR_distr_left T);
rewrite (SR_mult_one_left T); eauto.
-elim (varlist_lt l v); simpl in |- *;
+elim (varlist_lt l v); simpl;
[ repeat rewrite interp_m_ok; rewrite ics_aux_ok; eauto
| repeat rewrite interp_m_ok; rewrite ics_aux_ok; rewrite H;
rewrite ics_aux_ok; eauto ].
-simpl in |- *; intros.
+simpl; intros.
generalize (varlist_eq_prop l v); elim (varlist_eq l v).
-intro Hr; rewrite (Hr I); simpl in |- *; rewrite interp_m_ok;
+intro Hr; rewrite (Hr I); simpl; rewrite interp_m_ok;
repeat rewrite ics_aux_ok; rewrite (SR_distr_left T);
rewrite (SR_mult_one_left T); eauto.
-elim (varlist_lt l v); simpl in |- *;
+elim (varlist_lt l v); simpl;
[ repeat rewrite interp_m_ok; rewrite ics_aux_ok; eauto
| repeat rewrite interp_m_ok; rewrite ics_aux_ok; rewrite H;
rewrite ics_aux_ok; eauto ].
@@ -574,9 +573,9 @@ Lemma canonical_sum_scalar_ok :
forall (a:A) (s:canonical_sum),
interp_cs (canonical_sum_scalar a s) = Amult a (interp_cs s).
simple induction s.
-simpl in |- *; eauto.
+simpl; eauto.
-simpl in |- *; intros.
+simpl; intros.
repeat rewrite ics_aux_ok.
repeat rewrite interp_m_ok.
rewrite H.
@@ -584,7 +583,7 @@ rewrite (SR_distr_right T).
repeat rewrite <- (SR_mult_assoc T).
reflexivity.
-simpl in |- *; intros.
+simpl; intros.
repeat rewrite ics_aux_ok.
repeat rewrite interp_m_ok.
rewrite H.
@@ -597,9 +596,9 @@ Lemma canonical_sum_scalar2_ok :
forall (l:varlist) (s:canonical_sum),
interp_cs (canonical_sum_scalar2 l s) = Amult (interp_vl l) (interp_cs s).
simple induction s.
-simpl in |- *; trivial.
+simpl; trivial.
-simpl in |- *; intros.
+simpl; intros.
rewrite monom_insert_ok.
repeat rewrite ics_aux_ok.
repeat rewrite interp_m_ok.
@@ -611,7 +610,7 @@ repeat rewrite <- (SR_plus_assoc T).
rewrite (SR_mult_permute T a (interp_vl l) (interp_vl v)).
reflexivity.
-simpl in |- *; intros.
+simpl; intros.
rewrite varlist_insert_ok.
repeat rewrite ics_aux_ok.
repeat rewrite interp_m_ok.
@@ -628,9 +627,9 @@ Lemma canonical_sum_scalar3_ok :
interp_cs (canonical_sum_scalar3 c l s) =
Amult c (Amult (interp_vl l) (interp_cs s)).
simple induction s.
-simpl in |- *; repeat rewrite (SR_mult_zero_right T); reflexivity.
+simpl; repeat rewrite (SR_mult_zero_right T); reflexivity.
-simpl in |- *; intros.
+simpl; intros.
rewrite monom_insert_ok.
repeat rewrite ics_aux_ok.
repeat rewrite interp_m_ok.
@@ -642,7 +641,7 @@ repeat rewrite <- (SR_plus_assoc T).
rewrite (SR_mult_permute T a (interp_vl l) (interp_vl v)).
reflexivity.
-simpl in |- *; intros.
+simpl; intros.
rewrite monom_insert_ok.
repeat rewrite ics_aux_ok.
repeat rewrite interp_m_ok.
@@ -658,7 +657,7 @@ Qed.
Lemma canonical_sum_prod_ok :
forall x y:canonical_sum,
interp_cs (canonical_sum_prod x y) = Amult (interp_cs x) (interp_cs y).
-simple induction x; simpl in |- *; intros.
+simple induction x; simpl; intros.
trivial.
rewrite canonical_sum_merge_ok.
@@ -667,7 +666,7 @@ rewrite ics_aux_ok.
rewrite interp_m_ok.
rewrite H.
rewrite (SR_mult_assoc T a (interp_vl v) (interp_cs y)).
-symmetry in |- *.
+symmetry .
eauto.
rewrite canonical_sum_merge_ok.
@@ -679,7 +678,7 @@ Qed.
Theorem spolynomial_normalize_ok :
forall p:spolynomial, interp_cs (spolynomial_normalize p) = interp_sp p.
-simple induction p; simpl in |- *; intros.
+simple induction p; simpl; intros.
reflexivity.
reflexivity.
@@ -700,7 +699,7 @@ simple induction s.
reflexivity.
(* cons_monom *)
-simpl in |- *; intros.
+simpl; intros.
generalize (SR_eq_prop T a Azero).
elim (Aeq a Azero).
intro Heq; rewrite (Heq I).
@@ -710,25 +709,25 @@ rewrite interp_m_ok.
rewrite (SR_mult_zero_left T).
trivial.
-intros; simpl in |- *.
+intros; simpl.
generalize (SR_eq_prop T a Aone).
elim (Aeq a Aone).
intro Heq; rewrite (Heq I).
-simpl in |- *.
+simpl.
repeat rewrite ics_aux_ok.
rewrite interp_m_ok.
rewrite H.
rewrite (SR_mult_one_left T).
reflexivity.
-simpl in |- *.
+simpl.
repeat rewrite ics_aux_ok.
rewrite interp_m_ok.
rewrite H.
reflexivity.
(* cons_varlist *)
-simpl in |- *; intros.
+simpl; intros.
repeat rewrite ics_aux_ok.
rewrite H.
reflexivity.
@@ -738,7 +737,7 @@ Qed.
Theorem spolynomial_simplify_ok :
forall p:spolynomial, interp_cs (spolynomial_simplify p) = interp_sp p.
intro.
-unfold spolynomial_simplify in |- *.
+unfold spolynomial_simplify.
rewrite canonical_sum_simplify_ok.
apply spolynomial_normalize_ok.
Qed.
@@ -794,8 +793,7 @@ 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 refl_equal sym_equal trans_equal.
-(*Hints Resolve refl_eqT sym_eqT trans_eqT.*)
+Hint Resolve eq_refl eq_sym eq_trans.
Hint Immediate T.
(*** Definitions *)
@@ -852,7 +850,7 @@ Unset Implicit Arguments.
Lemma spolynomial_of_ok :
forall p:polynomial,
interp_p p = interp_sp Aplus Amult Azero vm (spolynomial_of p).
-simple induction p; reflexivity || (simpl in |- *; intros).
+simple induction p; reflexivity || (simpl; intros).
rewrite H; rewrite H0; reflexivity.
rewrite H; rewrite H0; reflexivity.
rewrite H.
@@ -865,23 +863,23 @@ Theorem polynomial_normalize_ok :
forall p:polynomial,
polynomial_normalize p =
spolynomial_normalize Aplus Amult Aone (spolynomial_of p).
-simple induction p; reflexivity || (simpl in |- *; intros).
+simple induction p; reflexivity || (simpl; intros).
rewrite H; rewrite H0; reflexivity.
rewrite H; rewrite H0; reflexivity.
-rewrite H; simpl in |- *.
+rewrite H; simpl.
elim
(canonical_sum_scalar3 Aplus Amult Aone (Aopp Aone) Nil_var
(spolynomial_normalize Aplus Amult Aone (spolynomial_of p0)));
[ reflexivity
- | simpl in |- *; intros; rewrite H0; reflexivity
- | simpl in |- *; intros; rewrite H0; reflexivity ].
+ | simpl; intros; rewrite H0; reflexivity
+ | simpl; intros; rewrite H0; reflexivity ].
Qed.
Theorem polynomial_simplify_ok :
forall p:polynomial,
interp_cs Aplus Amult Aone Azero vm (polynomial_simplify p) = interp_p p.
intro.
-unfold polynomial_simplify in |- *.
+unfold polynomial_simplify.
rewrite spolynomial_of_ok.
rewrite polynomial_normalize_ok.
rewrite (canonical_sum_simplify_ok A Aplus Amult Aone Azero Aeq vm T).
diff --git a/plugins/ring/Setoid_ring.v b/plugins/ring/Setoid_ring.v
index 106a946d..4717edc9 100644
--- a/plugins/ring/Setoid_ring.v
+++ b/plugins/ring/Setoid_ring.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/ring/Setoid_ring_normalize.v b/plugins/ring/Setoid_ring_normalize.v
index ad75a8a4..b0d790e0 100644
--- a/plugins/ring/Setoid_ring_normalize.v
+++ b/plugins/ring/Setoid_ring_normalize.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -13,7 +13,7 @@ Set Implicit Arguments.
Lemma index_eq_prop : forall n m:index, Is_true (index_eq n m) -> n = m.
Proof.
- simple induction n; simple induction m; simpl in |- *;
+ simple induction n; simple induction m; simpl;
try reflexivity || contradiction.
intros; rewrite (H i0); trivial.
intros; rewrite (H i0); trivial.
@@ -387,14 +387,13 @@ Hint Resolve (SSR_plus_zero_right2 S T).
Hint Resolve (SSR_mult_one_right S T).
Hint Resolve (SSR_mult_one_right2 S T).
Hint Resolve (SSR_plus_reg_right S T).
-Hint Resolve refl_equal sym_equal trans_equal.
-(*Hints Resolve refl_eqT sym_eqT trans_eqT.*)
+Hint Resolve eq_refl eq_sym eq_trans.
Hint Immediate T.
Lemma varlist_eq_prop : forall x y:varlist, Is_true (varlist_eq x y) -> x = y.
Proof.
simple induction x; simple induction y; contradiction || (try reflexivity).
- simpl in |- *; intros.
+ simpl; intros.
generalize (andb_prop2 _ _ H1); intros; elim H2; intros.
rewrite (index_eq_prop _ _ H3); rewrite (H v0 H4); reflexivity.
Qed.
@@ -403,7 +402,7 @@ Remark ivl_aux_ok :
forall (v:varlist) (i:index),
Aequiv (ivl_aux i v) (Amult (interp_var i) (interp_vl v)).
Proof.
- simple induction v; simpl in |- *; intros.
+ simple induction v; simpl; intros.
trivial.
rewrite (H i); trivial.
Qed.
@@ -413,17 +412,17 @@ Lemma varlist_merge_ok :
Aequiv (interp_vl (varlist_merge x y)) (Amult (interp_vl x) (interp_vl y)).
Proof.
simple induction x.
- simpl in |- *; trivial.
+ simpl; trivial.
simple induction y.
- simpl in |- *; trivial.
- simpl in |- *; intros.
- elim (index_lt i i0); simpl in |- *; intros.
+ simpl; trivial.
+ simpl; intros.
+ elim (index_lt i i0); simpl; intros.
rewrite (ivl_aux_ok v i).
rewrite (ivl_aux_ok v0 i0).
rewrite (ivl_aux_ok (varlist_merge v (Cons_var i0 v0)) i).
rewrite (H (Cons_var i0 v0)).
- simpl in |- *.
+ simpl.
rewrite (ivl_aux_ok v0 i0).
eauto.
@@ -448,7 +447,7 @@ Remark ics_aux_ok :
forall (x:A) (s:canonical_sum),
Aequiv (ics_aux x s) (Aplus x (interp_setcs s)).
Proof.
- simple induction s; simpl in |- *; intros; trivial.
+ simple induction s; simpl; intros; trivial.
Qed.
Remark interp_m_ok :
@@ -468,16 +467,16 @@ Lemma canonical_sum_merge_ok :
Aequiv (interp_setcs (canonical_sum_merge x y))
(Aplus (interp_setcs x) (interp_setcs y)).
Proof.
-simple induction x; simpl in |- *.
+simple induction x; simpl.
trivial.
-simple induction y; simpl in |- *; intros.
+simple induction y; simpl; intros.
eauto.
generalize (varlist_eq_prop v v0).
elim (varlist_eq v v0).
intros; rewrite (H1 I).
-simpl in |- *.
+simpl.
rewrite (ics_aux_ok (interp_m a v0) c).
rewrite (ics_aux_ok (interp_m a0 v0) c0).
rewrite (ics_aux_ok (interp_m (Aplus a a0) v0) (canonical_sum_merge c c0)).
@@ -504,14 +503,14 @@ setoid_replace
[ idtac | trivial ].
auto.
-elim (varlist_lt v v0); simpl in |- *.
+elim (varlist_lt v v0); simpl.
intro.
rewrite
(ics_aux_ok (interp_m a v) (canonical_sum_merge c (Cons_monom a0 v0 c0)))
.
rewrite (ics_aux_ok (interp_m a v) c).
rewrite (ics_aux_ok (interp_m a0 v0) c0).
-rewrite (H (Cons_monom a0 v0 c0)); simpl in |- *.
+rewrite (H (Cons_monom a0 v0 c0)); simpl.
rewrite (ics_aux_ok (interp_m a0 v0) c0); auto.
intro.
@@ -537,13 +536,13 @@ rewrite
end) c0)).
rewrite H0.
rewrite (ics_aux_ok (interp_m a v) c);
- rewrite (ics_aux_ok (interp_m a0 v0) c0); simpl in |- *;
+ rewrite (ics_aux_ok (interp_m a0 v0) c0); simpl;
auto.
generalize (varlist_eq_prop v v0).
elim (varlist_eq v v0).
intros; rewrite (H1 I).
-simpl in |- *.
+simpl.
rewrite (ics_aux_ok (interp_m (Aplus a Aone) v0) (canonical_sum_merge c c0));
rewrite (ics_aux_ok (interp_m a v0) c);
rewrite (ics_aux_ok (interp_vl v0) c0).
@@ -570,13 +569,13 @@ setoid_replace (Amult Aone (interp_vl v0)) with (interp_vl v0);
[ idtac | trivial ].
auto.
-elim (varlist_lt v v0); simpl in |- *.
+elim (varlist_lt v v0); simpl.
intro.
rewrite
(ics_aux_ok (interp_m a v) (canonical_sum_merge c (Cons_varlist v0 c0)))
; rewrite (ics_aux_ok (interp_m a v) c);
rewrite (ics_aux_ok (interp_vl v0) c0).
-rewrite (H (Cons_varlist v0 c0)); simpl in |- *.
+rewrite (H (Cons_varlist v0 c0)); simpl.
rewrite (ics_aux_ok (interp_vl v0) c0).
auto.
@@ -602,16 +601,16 @@ rewrite
else Cons_varlist l2 (csm_aux t2)
end) c0)); rewrite H0.
rewrite (ics_aux_ok (interp_m a v) c); rewrite (ics_aux_ok (interp_vl v0) c0);
- simpl in |- *.
+ simpl.
auto.
-simple induction y; simpl in |- *; intros.
+simple induction y; simpl; intros.
trivial.
generalize (varlist_eq_prop v v0).
elim (varlist_eq v v0).
intros; rewrite (H1 I).
-simpl in |- *.
+simpl.
rewrite (ics_aux_ok (interp_m (Aplus Aone a) v0) (canonical_sum_merge c c0));
rewrite (ics_aux_ok (interp_vl v0) c);
rewrite (ics_aux_ok (interp_m a v0) c0); rewrite (H c0).
@@ -635,12 +634,12 @@ setoid_replace
[ idtac | trivial ].
auto.
-elim (varlist_lt v v0); simpl in |- *; intros.
+elim (varlist_lt v v0); simpl; intros.
rewrite
(ics_aux_ok (interp_vl v) (canonical_sum_merge c (Cons_monom a v0 c0)))
; rewrite (ics_aux_ok (interp_vl v) c);
rewrite (ics_aux_ok (interp_m a v0) c0).
-rewrite (H (Cons_monom a v0 c0)); simpl in |- *.
+rewrite (H (Cons_monom a v0 c0)); simpl.
rewrite (ics_aux_ok (interp_m a v0) c0); auto.
rewrite
@@ -664,11 +663,11 @@ rewrite
else Cons_varlist l2 (csm_aux2 t2)
end) c0)); rewrite H0.
rewrite (ics_aux_ok (interp_vl v) c); rewrite (ics_aux_ok (interp_m a v0) c0);
- simpl in |- *; auto.
+ simpl; auto.
generalize (varlist_eq_prop v v0).
elim (varlist_eq v v0); intros.
-rewrite (H1 I); simpl in |- *.
+rewrite (H1 I); simpl.
rewrite
(ics_aux_ok (interp_m (Aplus Aone Aone) v0) (canonical_sum_merge c c0))
; rewrite (ics_aux_ok (interp_vl v0) c);
@@ -692,12 +691,12 @@ setoid_replace
[ idtac | trivial ].
setoid_replace (Amult Aone (interp_vl v0)) with (interp_vl v0); auto.
-elim (varlist_lt v v0); simpl in |- *.
+elim (varlist_lt v v0); simpl.
rewrite
(ics_aux_ok (interp_vl v) (canonical_sum_merge c (Cons_varlist v0 c0)))
; rewrite (ics_aux_ok (interp_vl v) c);
rewrite (ics_aux_ok (interp_vl v0) c0); rewrite (H (Cons_varlist v0 c0));
- simpl in |- *.
+ simpl.
rewrite (ics_aux_ok (interp_vl v0) c0); auto.
rewrite
@@ -721,7 +720,7 @@ rewrite
else Cons_varlist l2 (csm_aux2 t2)
end) c0)); rewrite H0.
rewrite (ics_aux_ok (interp_vl v) c); rewrite (ics_aux_ok (interp_vl v0) c0);
- simpl in |- *; auto.
+ simpl; auto.
Qed.
Lemma monom_insert_ok :
@@ -730,10 +729,10 @@ Lemma monom_insert_ok :
(Aplus (Amult a (interp_vl l)) (interp_setcs s)).
Proof.
simple induction s; intros.
-simpl in |- *; rewrite (interp_m_ok a l); trivial.
+simpl; rewrite (interp_m_ok a l); trivial.
-simpl in |- *; generalize (varlist_eq_prop l v); elim (varlist_eq l v).
-intro Hr; rewrite (Hr I); simpl in |- *.
+simpl; generalize (varlist_eq_prop l v); elim (varlist_eq l v).
+intro Hr; rewrite (Hr I); simpl.
rewrite (ics_aux_ok (interp_m (Aplus a a0) v) c);
rewrite (ics_aux_ok (interp_m a0 v) c).
rewrite (interp_m_ok (Aplus a a0) v); rewrite (interp_m_ok a0 v).
@@ -742,7 +741,7 @@ setoid_replace (Amult (Aplus a a0) (interp_vl v)) with
[ idtac | trivial ].
auto.
-elim (varlist_lt l v); simpl in |- *; intros.
+elim (varlist_lt l v); simpl; intros.
rewrite (ics_aux_ok (interp_m a0 v) c).
rewrite (interp_m_ok a0 v); rewrite (interp_m_ok a l).
auto.
@@ -751,9 +750,9 @@ rewrite (ics_aux_ok (interp_m a0 v) (monom_insert a l c));
rewrite (ics_aux_ok (interp_m a0 v) c); rewrite H.
auto.
-simpl in |- *.
+simpl.
generalize (varlist_eq_prop l v); elim (varlist_eq l v).
-intro Hr; rewrite (Hr I); simpl in |- *.
+intro Hr; rewrite (Hr I); simpl.
rewrite (ics_aux_ok (interp_m (Aplus a Aone) v) c);
rewrite (ics_aux_ok (interp_vl v) c).
rewrite (interp_m_ok (Aplus a Aone) v).
@@ -764,7 +763,7 @@ setoid_replace (Amult Aone (interp_vl v)) with (interp_vl v);
[ idtac | trivial ].
auto.
-elim (varlist_lt l v); simpl in |- *; intros; auto.
+elim (varlist_lt l v); simpl; intros; auto.
rewrite (ics_aux_ok (interp_vl v) (monom_insert a l c)); rewrite H.
rewrite (ics_aux_ok (interp_vl v) c); auto.
Qed.
@@ -774,11 +773,11 @@ Lemma varlist_insert_ok :
Aequiv (interp_setcs (varlist_insert l s))
(Aplus (interp_vl l) (interp_setcs s)).
Proof.
-simple induction s; simpl in |- *; intros.
+simple induction s; simpl; intros.
trivial.
generalize (varlist_eq_prop l v); elim (varlist_eq l v).
-intro Hr; rewrite (Hr I); simpl in |- *.
+intro Hr; rewrite (Hr I); simpl.
rewrite (ics_aux_ok (interp_m (Aplus Aone a) v) c);
rewrite (ics_aux_ok (interp_m a v) c).
rewrite (interp_m_ok (Aplus Aone a) v); rewrite (interp_m_ok a v).
@@ -787,14 +786,14 @@ setoid_replace (Amult (Aplus Aone a) (interp_vl v)) with
[ idtac | trivial ].
setoid_replace (Amult Aone (interp_vl v)) with (interp_vl v); auto.
-elim (varlist_lt l v); simpl in |- *; intros; auto.
+elim (varlist_lt l v); simpl; intros; auto.
rewrite (ics_aux_ok (interp_m a v) (varlist_insert l c));
rewrite (ics_aux_ok (interp_m a v) c).
rewrite (interp_m_ok a v).
rewrite H; auto.
generalize (varlist_eq_prop l v); elim (varlist_eq l v).
-intro Hr; rewrite (Hr I); simpl in |- *.
+intro Hr; rewrite (Hr I); simpl.
rewrite (ics_aux_ok (interp_m (Aplus Aone Aone) v) c);
rewrite (ics_aux_ok (interp_vl v) c).
rewrite (interp_m_ok (Aplus Aone Aone) v).
@@ -803,7 +802,7 @@ setoid_replace (Amult (Aplus Aone Aone) (interp_vl v)) with
[ idtac | trivial ].
setoid_replace (Amult Aone (interp_vl v)) with (interp_vl v); auto.
-elim (varlist_lt l v); simpl in |- *; intros; auto.
+elim (varlist_lt l v); simpl; intros; auto.
rewrite (ics_aux_ok (interp_vl v) (varlist_insert l c)).
rewrite H.
rewrite (ics_aux_ok (interp_vl v) c); auto.
@@ -814,7 +813,7 @@ Lemma canonical_sum_scalar_ok :
Aequiv (interp_setcs (canonical_sum_scalar a s))
(Amult a (interp_setcs s)).
Proof.
-simple induction s; simpl in |- *; intros.
+simple induction s; simpl; intros.
trivial.
rewrite (ics_aux_ok (interp_m (Amult a a0) v) (canonical_sum_scalar a c));
@@ -837,7 +836,7 @@ Lemma canonical_sum_scalar2_ok :
Aequiv (interp_setcs (canonical_sum_scalar2 l s))
(Amult (interp_vl l) (interp_setcs s)).
Proof.
-simple induction s; simpl in |- *; intros; auto.
+simple induction s; simpl; intros; auto.
rewrite (monom_insert_ok a (varlist_merge l v) (canonical_sum_scalar2 l c)).
rewrite (ics_aux_ok (interp_m a v) c).
rewrite (interp_m_ok a v).
@@ -862,7 +861,7 @@ Lemma canonical_sum_scalar3_ok :
Aequiv (interp_setcs (canonical_sum_scalar3 c l s))
(Amult c (Amult (interp_vl l) (interp_setcs s))).
Proof.
-simple induction s; simpl in |- *; intros.
+simple induction s; simpl; intros.
rewrite (SSR_mult_zero_right S T (interp_vl l)).
auto.
@@ -911,7 +910,7 @@ Lemma canonical_sum_prod_ok :
Aequiv (interp_setcs (canonical_sum_prod x y))
(Amult (interp_setcs x) (interp_setcs y)).
Proof.
-simple induction x; simpl in |- *; intros.
+simple induction x; simpl; intros.
trivial.
rewrite
@@ -945,7 +944,7 @@ Theorem setspolynomial_normalize_ok :
forall p:setspolynomial,
Aequiv (interp_setcs (setspolynomial_normalize p)) (interp_setsp p).
Proof.
-simple induction p; simpl in |- *; intros; trivial.
+simple induction p; simpl; intros; trivial.
rewrite
(canonical_sum_merge_ok (setspolynomial_normalize s)
(setspolynomial_normalize s0)).
@@ -961,12 +960,12 @@ Lemma canonical_sum_simplify_ok :
forall s:canonical_sum,
Aequiv (interp_setcs (canonical_sum_simplify s)) (interp_setcs s).
Proof.
-simple induction s; simpl in |- *; intros.
+simple induction s; simpl; intros.
trivial.
generalize (SSR_eq_prop T a Azero).
elim (Aeq a Azero).
-simpl in |- *.
+simpl.
intros.
rewrite (ics_aux_ok (interp_m a v) c).
rewrite (interp_m_ok a v).
@@ -976,19 +975,19 @@ setoid_replace (Amult Azero (interp_vl v)) with Azero;
rewrite H.
trivial.
-intros; simpl in |- *.
+intros; simpl.
generalize (SSR_eq_prop T a Aone).
elim (Aeq a Aone).
intros.
rewrite (ics_aux_ok (interp_m a v) c).
rewrite (interp_m_ok a v).
rewrite (H1 I).
-simpl in |- *.
+simpl.
rewrite (ics_aux_ok (interp_vl v) (canonical_sum_simplify c)).
rewrite H.
auto.
-simpl in |- *.
+simpl.
intros.
rewrite (ics_aux_ok (interp_m a v) (canonical_sum_simplify c)).
rewrite (ics_aux_ok (interp_m a v) c).
@@ -1004,7 +1003,7 @@ Theorem setspolynomial_simplify_ok :
Aequiv (interp_setcs (setspolynomial_simplify p)) (interp_setsp p).
Proof.
intro.
-unfold setspolynomial_simplify in |- *.
+unfold setspolynomial_simplify.
rewrite (canonical_sum_simplify_ok (setspolynomial_normalize p)).
exact (setspolynomial_normalize_ok p).
Qed.
@@ -1052,8 +1051,7 @@ Hint Resolve (STh_plus_zero_right2 S T).
Hint Resolve (STh_mult_one_right S T).
Hint Resolve (STh_mult_one_right2 S T).
Hint Resolve (STh_plus_reg_right S plus_morph T).
-Hint Resolve refl_equal sym_equal trans_equal.
-(*Hints Resolve refl_eqT sym_eqT trans_eqT.*)
+Hint Resolve eq_refl eq_sym eq_trans.
Hint Immediate T.
@@ -1110,7 +1108,7 @@ Unset Implicit Arguments.
Lemma setspolynomial_of_ok :
forall p:setpolynomial,
Aequiv (interp_setp p) (interp_setsp vm (setspolynomial_of p)).
-simple induction p; trivial; simpl in |- *; intros.
+simple induction p; trivial; simpl; intros.
rewrite H; rewrite H0; trivial.
rewrite H; rewrite H0; trivial.
rewrite H.
@@ -1124,23 +1122,23 @@ Qed.
Theorem setpolynomial_normalize_ok :
forall p:setpolynomial,
setpolynomial_normalize p = setspolynomial_normalize (setspolynomial_of p).
-simple induction p; trivial; simpl in |- *; intros.
+simple induction p; trivial; simpl; intros.
rewrite H; rewrite H0; reflexivity.
rewrite H; rewrite H0; reflexivity.
-rewrite H; simpl in |- *.
+rewrite H; simpl.
elim
(canonical_sum_scalar3 (Aopp Aone) Nil_var
(setspolynomial_normalize (setspolynomial_of s)));
[ reflexivity
- | simpl in |- *; intros; rewrite H0; reflexivity
- | simpl in |- *; intros; rewrite H0; reflexivity ].
+ | simpl; intros; rewrite H0; reflexivity
+ | simpl; intros; rewrite H0; reflexivity ].
Qed.
Theorem setpolynomial_simplify_ok :
forall p:setpolynomial,
Aequiv (interp_setcs vm (setpolynomial_simplify p)) (interp_setp p).
intro.
-unfold setpolynomial_simplify in |- *.
+unfold setpolynomial_simplify.
rewrite (setspolynomial_of_ok p).
rewrite setpolynomial_normalize_ok.
rewrite
diff --git a/plugins/ring/Setoid_ring_theory.v b/plugins/ring/Setoid_ring_theory.v
index dd722f80..52f5968b 100644
--- a/plugins/ring/Setoid_ring_theory.v
+++ b/plugins/ring/Setoid_ring_theory.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -406,7 +406,7 @@ Unset Implicit Arguments.
Definition Semi_Setoid_Ring_Theory_of :
Setoid_Ring_Theory -> Semi_Setoid_Ring_Theory.
intros until 1; case H.
-split; intros; simpl in |- *; eauto.
+split; intros; simpl; eauto.
Defined.
Coercion Semi_Setoid_Ring_Theory_of : Setoid_Ring_Theory >->
diff --git a/plugins/ring/g_ring.ml4 b/plugins/ring/g_ring.ml4
index e306a531..8953b88f 100644
--- a/plugins/ring/g_ring.ml4
+++ b/plugins/ring/g_ring.ml4
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/ring/ring.ml b/plugins/ring/ring.ml
index 98d6361c..ae73069d 100644
--- a/plugins/ring/ring.ml
+++ b/plugins/ring/ring.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -449,7 +449,7 @@ let build_polynom gl th lc =
mkLApp(coq_Pplus, [|th.th_a; aux c1; aux c2 |])
| App (binop, [|c1; c2|]) when safe_pf_conv_x gl binop th.th_mult ->
mkLApp(coq_Pmult, [|th.th_a; aux c1; aux c2 |])
- (* The special case of Zminus *)
+ (* The special case of Z.sub *)
| App (binop, [|c1; c2|])
when safe_pf_conv_x gl c
(mkApp (th.th_plus, [|c1; mkApp(unbox th.th_opp, [|c2|])|])) ->
@@ -567,7 +567,7 @@ let build_apolynom gl th lc =
mkLApp(coq_APplus, [| aux c1; aux c2 |])
| App (binop, [|c1; c2|]) when safe_pf_conv_x gl binop th.th_mult ->
mkLApp(coq_APmult, [| aux c1; aux c2 |])
- (* The special case of Zminus *)
+ (* The special case of Z.sub *)
| App (binop, [|c1; c2|])
when safe_pf_conv_x gl c
(mkApp(th.th_plus, [|c1; mkApp(unbox th.th_opp,[|c2|]) |])) ->
@@ -628,7 +628,7 @@ let build_setpolynom gl th lc =
mkLApp(coq_SetPplus, [|th.th_a; aux c1; aux c2 |])
| App (binop, [|c1; c2|]) when safe_pf_conv_x gl binop th.th_mult ->
mkLApp(coq_SetPmult, [|th.th_a; aux c1; aux c2 |])
- (* The special case of Zminus *)
+ (* The special case of Z.sub *)
| App (binop, [|c1; c2|])
when safe_pf_conv_x gl c
(mkApp(th.th_plus, [|c1; mkApp(unbox th.th_opp,[|c2|])|])) ->
diff --git a/plugins/romega/ReflOmegaCore.v b/plugins/romega/ReflOmegaCore.v
index 56ae921e..11d9a071 100644
--- a/plugins/romega/ReflOmegaCore.v
+++ b/plugins/romega/ReflOmegaCore.v
@@ -86,73 +86,50 @@ Module Z_as_Int <: Int.
Definition int := Z.
Definition zero := 0.
Definition one := 1.
- Definition plus := Zplus.
- Definition opp := Zopp.
- Definition minus := Zminus.
- Definition mult := Zmult.
+ Definition plus := Z.add.
+ Definition opp := Z.opp.
+ Definition minus := Z.sub.
+ Definition mult := Z.mul.
Lemma ring : @ring_theory int zero one plus mult minus opp (@eq int).
Proof.
constructor.
- exact Zplus_0_l.
- exact Zplus_comm.
- exact Zplus_assoc.
- exact Zmult_1_l.
- exact Zmult_comm.
- exact Zmult_assoc.
- exact Zmult_plus_distr_l.
- unfold minus, Zminus; auto.
- exact Zplus_opp_r.
+ exact Z.add_0_l.
+ exact Z.add_comm.
+ exact Z.add_assoc.
+ exact Z.mul_1_l.
+ exact Z.mul_comm.
+ exact Z.mul_assoc.
+ exact Z.mul_add_distr_r.
+ unfold minus, Z.sub; auto.
+ exact Z.add_opp_diag_r.
Qed.
- Definition le := Zle.
- Definition lt := Zlt.
- Definition ge := Zge.
- Definition gt := Zgt.
- Lemma le_lt_iff : forall i j, (i<=j) <-> ~(j<i).
- Proof.
- split; intros.
- apply Zle_not_lt; auto.
- rewrite <- Zge_iff_le.
- apply Znot_lt_ge; auto.
- Qed.
- Definition ge_le_iff := Zge_iff_le.
- Definition gt_lt_iff := Zgt_iff_lt.
+ Definition le := Z.le.
+ Definition lt := Z.lt.
+ Definition ge := Z.ge.
+ Definition gt := Z.gt.
+ Definition le_lt_iff := Z.le_ngt.
+ Definition ge_le_iff := Z.ge_le_iff.
+ Definition gt_lt_iff := Z.gt_lt_iff.
- Definition lt_trans := Zlt_trans.
- Definition lt_not_eq := Zlt_not_eq.
+ Definition lt_trans := Z.lt_trans.
+ Definition lt_not_eq := Z.lt_neq.
- Definition lt_0_1 := Zlt_0_1.
- Definition plus_le_compat := Zplus_le_compat.
+ Definition lt_0_1 := Z.lt_0_1.
+ Definition plus_le_compat := Z.add_le_mono.
Definition mult_lt_compat_l := Zmult_lt_compat_l.
- Lemma opp_le_compat : forall i j, i<=j -> (-j)<=(-i).
- Proof.
- unfold Zle; intros; rewrite <- Zcompare_opp; auto.
- Qed.
+ Lemma opp_le_compat i j : i<=j -> (-j)<=(-i).
+ Proof. apply -> Z.opp_le_mono. Qed.
- Definition compare := Zcompare.
- Definition compare_Eq := Zcompare_Eq_iff_eq.
- Lemma compare_Lt : forall i j, compare i j = Lt <-> i<j.
- Proof. intros; unfold compare, Zlt; intuition. Qed.
- Lemma compare_Gt : forall i j, compare i j = Gt <-> i>j.
- Proof. intros; unfold compare, Zgt; intuition. Qed.
+ Definition compare := Z.compare.
+ Definition compare_Eq := Z.compare_eq_iff.
+ Lemma compare_Lt i j : compare i j = Lt <-> i<j.
+ Proof. reflexivity. Qed.
+ Lemma compare_Gt i j : compare i j = Gt <-> i>j.
+ Proof. reflexivity. Qed.
- Lemma le_lt_int : forall x y, x<y <-> x<=y+-(1).
- Proof.
- intros; split; intros.
- generalize (Zlt_left _ _ H); simpl; intros.
- apply Zle_left_rev; auto.
- apply Zlt_0_minus_lt.
- generalize (Zplus_le_lt_compat x (y+-1) (-x) (-x+1) H).
- rewrite Zplus_opp_r.
- rewrite <-Zplus_assoc.
- rewrite (Zplus_permute (-1)).
- simpl in *.
- rewrite Zplus_0_r.
- intro H'; apply H'.
- replace (-x+1) with (Zsucc (-x)); auto.
- apply Zlt_succ.
- Qed.
+ Definition le_lt_int := Z.lt_le_pred.
End Z_as_Int.
@@ -363,7 +340,7 @@ Module IntProperties (I:Int).
Lemma sum1 : forall a b c d : int, 0 = a -> 0 = b -> 0 = a * c + b * d.
Proof.
- intros; elim H; elim H0; simpl in |- *; auto.
+ intros; elim H; elim H0; simpl; auto.
now rewrite mult_0_l, mult_0_l, plus_0_l.
Qed.
@@ -1076,34 +1053,34 @@ Proof.
| intros; elim beq_nat_true with (1 := H); trivial ].
Qed.
-Ltac trivial_case := unfold not in |- *; intros; discriminate.
+Ltac trivial_case := unfold not; intros; discriminate.
Theorem eq_term_false :
forall t1 t2 : term, eq_term t1 t2 = false -> t1 <> t2.
Proof.
simple induction t1;
- [ intros z t2; case t2; try trivial_case; simpl in |- *; unfold not in |- *;
+ [ intros z t2; case t2; try trivial_case; simpl; unfold not;
intros; elim beq_false with (1 := H); simplify_eq H0;
auto
- | intros t11 H1 t12 H2 t2; case t2; try trivial_case; simpl in |- *;
- intros t21 t22 H3; unfold not in |- *; intro H4;
+ | intros t11 H1 t12 H2 t2; case t2; try trivial_case; simpl;
+ intros t21 t22 H3; unfold not; intro H4;
elim andb_false_elim with (1 := H3); intros H5;
[ elim H1 with (1 := H5); simplify_eq H4; auto
| elim H2 with (1 := H5); simplify_eq H4; auto ]
- | intros t11 H1 t12 H2 t2; case t2; try trivial_case; simpl in |- *;
- intros t21 t22 H3; unfold not in |- *; intro H4;
+ | intros t11 H1 t12 H2 t2; case t2; try trivial_case; simpl;
+ intros t21 t22 H3; unfold not; intro H4;
elim andb_false_elim with (1 := H3); intros H5;
[ elim H1 with (1 := H5); simplify_eq H4; auto
| elim H2 with (1 := H5); simplify_eq H4; auto ]
- | intros t11 H1 t12 H2 t2; case t2; try trivial_case; simpl in |- *;
- intros t21 t22 H3; unfold not in |- *; intro H4;
+ | intros t11 H1 t12 H2 t2; case t2; try trivial_case; simpl;
+ intros t21 t22 H3; unfold not; intro H4;
elim andb_false_elim with (1 := H3); intros H5;
[ elim H1 with (1 := H5); simplify_eq H4; auto
| elim H2 with (1 := H5); simplify_eq H4; auto ]
- | intros t11 H1 t2; case t2; try trivial_case; simpl in |- *; intros t21 H3;
- unfold not in |- *; intro H4; elim H1 with (1 := H3);
+ | intros t11 H1 t2; case t2; try trivial_case; simpl; intros t21 H3;
+ unfold not; intro H4; elim H1 with (1 := H3);
simplify_eq H4; auto
- | intros n t2; case t2; try trivial_case; simpl in |- *; unfold not in |- *;
+ | intros n t2; case t2; try trivial_case; simpl; unfold not;
intros; elim beq_nat_false with (1 := H); simplify_eq H0;
auto ].
Qed.
@@ -1123,17 +1100,17 @@ Qed.
avait utilisé le test précédent et fait une elimination dessus. *)
Ltac elim_eq_term t1 t2 :=
- pattern (eq_term t1 t2) in |- *; apply bool_eq_ind; intro Aux;
+ pattern (eq_term t1 t2); apply bool_eq_ind; intro Aux;
[ generalize (eq_term_true t1 t2 Aux); clear Aux
| generalize (eq_term_false t1 t2 Aux); clear Aux ].
Ltac elim_beq t1 t2 :=
- pattern (beq t1 t2) in |- *; apply bool_eq_ind; intro Aux;
+ pattern (beq t1 t2); apply bool_eq_ind; intro Aux;
[ generalize (beq_true t1 t2 Aux); clear Aux
| generalize (beq_false t1 t2 Aux); clear Aux ].
Ltac elim_bgt t1 t2 :=
- pattern (bgt t1 t2) in |- *; apply bool_eq_ind; intro Aux;
+ pattern (bgt t1 t2); apply bool_eq_ind; intro Aux;
[ generalize (bgt_true t1 t2 Aux); clear Aux
| generalize (bgt_false t1 t2 Aux); clear Aux ].
@@ -1209,15 +1186,15 @@ Theorem goal_to_hyps :
(interp_hyps envp env l -> False) -> interp_goal envp env l.
Proof.
simple induction l;
- [ simpl in |- *; auto
- | simpl in |- *; intros a l1 H1 H2 H3; apply H1; intro H4; apply H2; auto ].
+ [ simpl; auto
+ | simpl; intros a l1 H1 H2 H3; apply H1; intro H4; apply H2; auto ].
Qed.
Theorem hyps_to_goal :
forall (envp : list Prop) (env : list int) (l : hyps),
interp_goal envp env l -> interp_hyps envp env l -> False.
Proof.
- simple induction l; simpl in |- *; [ auto | intros; apply H; elim H1; auto ].
+ simple induction l; simpl; [ auto | intros; apply H; elim H1; auto ].
Qed.
(* \subsection{Manipulations sur les hypothèses} *)
@@ -1257,7 +1234,7 @@ Theorem valid_goal :
forall (ep : list Prop) (env : list int) (l : hyps) (a : hyps -> hyps),
valid_hyps a -> interp_goal ep env (a l) -> interp_goal ep env l.
Proof.
- intros; simpl in |- *; apply goal_to_hyps; intro H1;
+ intros; simpl; apply goal_to_hyps; intro H1;
apply (hyps_to_goal ep env (a l) H0); apply H; assumption.
Qed.
@@ -1282,7 +1259,7 @@ Theorem list_goal_to_hyps :
forall (envp : list Prop) (env : list int) (l : lhyps),
(interp_list_hyps envp env l -> False) -> interp_list_goal envp env l.
Proof.
- simple induction l; simpl in |- *;
+ simple induction l; simpl;
[ auto
| intros h1 l1 H H1; split;
[ apply goal_to_hyps; intro H2; apply H1; auto
@@ -1293,7 +1270,7 @@ Theorem list_hyps_to_goal :
forall (envp : list Prop) (env : list int) (l : lhyps),
interp_list_goal envp env l -> interp_list_hyps envp env l -> False.
Proof.
- simple induction l; simpl in |- *;
+ simple induction l; simpl;
[ auto
| intros h1 l1 H (H1, H2) H3; elim H3; intro H4;
[ apply hyps_to_goal with (1 := H1); assumption | auto ] ].
@@ -1310,7 +1287,7 @@ Definition valid_list_goal (f : hyps -> lhyps) :=
Theorem goal_valid :
forall f : hyps -> lhyps, valid_list_hyps f -> valid_list_goal f.
Proof.
- unfold valid_list_goal in |- *; intros f H ep e lp H1; apply goal_to_hyps;
+ unfold valid_list_goal; intros f H ep e lp H1; apply goal_to_hyps;
intro H2; apply list_hyps_to_goal with (1 := H1);
apply (H ep e lp); assumption.
Qed.
@@ -1321,8 +1298,8 @@ Theorem append_valid :
interp_list_hyps ep e (l1 ++ l2).
Proof.
intros ep e; simple induction l1;
- [ simpl in |- *; intros l2 [H| H]; [ contradiction | trivial ]
- | simpl in |- *; intros h1 t1 HR l2 [[H| H]| H];
+ [ simpl; intros l2 [H| H]; [ contradiction | trivial ]
+ | simpl; intros h1 t1 HR l2 [[H| H]| H];
[ auto
| right; apply (HR l2); left; trivial
| right; apply (HR l2); right; trivial ] ].
@@ -1338,11 +1315,11 @@ Theorem nth_valid :
forall (ep : list Prop) (e : list int) (i : nat) (l : hyps),
interp_hyps ep e l -> interp_proposition ep e (nth_hyps i l).
Proof.
- unfold nth_hyps in |- *; simple induction i;
- [ simple induction l; simpl in |- *; [ auto | intros; elim H0; auto ]
+ unfold nth_hyps; simple induction i;
+ [ simple induction l; simpl; [ auto | intros; elim H0; auto ]
| intros n H; simple induction l;
- [ simpl in |- *; trivial
- | intros; simpl in |- *; apply H; elim H1; auto ] ].
+ [ simpl; trivial
+ | intros; simpl; apply H; elim H1; auto ] ].
Qed.
(* Appliquer une opération (valide) sur deux hypothèses extraites de
@@ -1355,7 +1332,7 @@ Theorem apply_oper_2_valid :
forall (i j : nat) (f : proposition -> proposition -> proposition),
valid2 f -> valid_hyps (apply_oper_2 i j f).
Proof.
- intros i j f Hf; unfold apply_oper_2, valid_hyps in |- *; simpl in |- *;
+ intros i j f Hf; unfold apply_oper_2, valid_hyps; simpl;
intros lp Hlp; split; [ apply Hf; apply nth_valid; assumption | assumption ].
Qed.
@@ -1376,14 +1353,14 @@ Theorem apply_oper_1_valid :
forall (i : nat) (f : proposition -> proposition),
valid1 f -> valid_hyps (apply_oper_1 i f).
Proof.
- unfold valid_hyps in |- *; intros i f Hf ep e; elim i;
+ unfold valid_hyps; intros i f Hf ep e; elim i;
[ intro lp; case lp;
- [ simpl in |- *; trivial
- | simpl in |- *; intros p l' (H1, H2); split;
+ [ simpl; trivial
+ | simpl; intros p l' (H1, H2); split;
[ apply Hf with (1 := H1) | assumption ] ]
| intros n Hrec lp; case lp;
- [ simpl in |- *; auto
- | simpl in |- *; intros p l' (H1, H2); split;
+ [ simpl; auto
+ | simpl; intros p l' (H1, H2); split;
[ assumption | apply Hrec; assumption ] ] ].
Qed.
@@ -1421,14 +1398,14 @@ Definition apply_both (f g : term -> term) (t : term) :=
Theorem apply_left_stable :
forall f : term -> term, term_stable f -> term_stable (apply_left f).
Proof.
- unfold term_stable in |- *; intros f H e t; case t; auto; simpl in |- *;
+ unfold term_stable; intros f H e t; case t; auto; simpl;
intros; elim H; trivial.
Qed.
Theorem apply_right_stable :
forall f : term -> term, term_stable f -> term_stable (apply_right f).
Proof.
- unfold term_stable in |- *; intros f H e t; case t; auto; simpl in |- *;
+ unfold term_stable; intros f H e t; case t; auto; simpl;
intros t0 t1; elim H; trivial.
Qed.
@@ -1436,7 +1413,7 @@ Theorem apply_both_stable :
forall f g : term -> term,
term_stable f -> term_stable g -> term_stable (apply_both f g).
Proof.
- unfold term_stable in |- *; intros f g H1 H2 e t; case t; auto; simpl in |- *;
+ unfold term_stable; intros f g H1 H2 e t; case t; auto; simpl;
intros t0 t1; elim H1; elim H2; trivial.
Qed.
@@ -1444,7 +1421,7 @@ Theorem compose_term_stable :
forall f g : term -> term,
term_stable f -> term_stable g -> term_stable (fun t : term => f (g t)).
Proof.
- unfold term_stable in |- *; intros f g Hf Hg e t; elim Hf; apply Hg.
+ unfold term_stable; intros f g Hf Hg e t; elim Hf; apply Hg.
Qed.
(* \subsection{Les règles de réécriture} *)
@@ -1522,14 +1499,14 @@ Ltac loop t :=
| (if beq ?X1 ?X2 then _ else _) =>
let H := fresh "H" in
elim_beq X1 X2; intro H; try (rewrite H in *; clear H);
- simpl in |- *; auto; Simplify
+ simpl; auto; Simplify
| (if bgt ?X1 ?X2 then _ else _) =>
let H := fresh "H" in
- elim_bgt X1 X2; intro H; simpl in |- *; auto; Simplify
+ elim_bgt X1 X2; intro H; simpl; auto; Simplify
| (if eq_term ?X1 ?X2 then _ else _) =>
let H := fresh "H" in
elim_eq_term X1 X2; intro H; try (rewrite H in *; clear H);
- simpl in |- *; auto; Simplify
+ simpl; auto; Simplify
| (if _ && _ then _ else _) => rewrite andb_if; Simplify
| (if negb _ then _ else _) => rewrite negb_if; Simplify
| _ => fail
@@ -1543,7 +1520,7 @@ with Simplify := match goal with
Ltac prove_stable x th :=
match constr:x with
| ?X1 =>
- unfold term_stable, X1 in |- *; intros; Simplify; simpl in |- *;
+ unfold term_stable, X1; intros; Simplify; simpl;
apply th
end.
@@ -1663,7 +1640,7 @@ Definition T_OMEGA13 (t : term) :=
Theorem T_OMEGA13_stable : term_stable T_OMEGA13.
Proof.
- unfold term_stable, T_OMEGA13 in |- *; intros; Simplify; simpl in |- *;
+ unfold term_stable, T_OMEGA13; intros; Simplify; simpl;
apply OMEGA13.
Qed.
@@ -1910,16 +1887,16 @@ Fixpoint reduce (t : term) : term :=
Theorem reduce_stable : term_stable reduce.
Proof.
- unfold term_stable in |- *; intros e t; elim t; auto;
+ unfold term_stable; intros e t; elim t; auto;
try
- (intros t0 H0 t1 H1; simpl in |- *; rewrite H0; rewrite H1;
+ (intros t0 H0 t1 H1; simpl; rewrite H0; rewrite H1;
(case (reduce t0);
[ intro z0; case (reduce t1); intros; auto
| intros; auto
| intros; auto
| intros; auto
| intros; auto
- | intros; auto ])); intros t0 H0; simpl in |- *;
+ | intros; auto ])); intros t0 H0; simpl;
rewrite H0; case (reduce t0); intros; auto.
Qed.
@@ -1944,12 +1921,12 @@ Fixpoint fusion (trace : list t_fusion) (t : term) {struct trace} : term :=
Theorem fusion_stable : forall t : list t_fusion, term_stable (fusion t).
Proof.
- simple induction t; simpl in |- *;
+ simple induction t; simpl;
[ exact reduce_stable
| intros stp l H; case stp;
[ apply compose_term_stable;
[ apply apply_right_stable; assumption | exact T_OMEGA10_stable ]
- | unfold term_stable in |- *; intros e t1; rewrite T_OMEGA10_stable;
+ | unfold term_stable; intros e t1; rewrite T_OMEGA10_stable;
rewrite Tred_factor5_stable; apply H
| apply compose_term_stable;
[ apply apply_right_stable; assumption | exact T_OMEGA11_stable ]
@@ -1982,7 +1959,7 @@ Fixpoint fusion_cancel (trace : nat) (t : term) {struct trace} : term :=
Theorem fusion_cancel_stable : forall t : nat, term_stable (fusion_cancel t).
Proof.
- unfold term_stable, fusion_cancel in |- *; intros trace e; elim trace;
+ unfold term_stable, fusion_cancel; intros trace e; elim trace;
[ exact (reduce_stable e)
| intros n H t; elim H; exact (T_OMEGA13_stable e t) ].
Qed.
@@ -1999,7 +1976,7 @@ Fixpoint scalar_norm_add (trace : nat) (t : term) {struct trace} : term :=
Theorem scalar_norm_add_stable :
forall t : nat, term_stable (scalar_norm_add t).
Proof.
- unfold term_stable, scalar_norm_add in |- *; intros trace; elim trace;
+ unfold term_stable, scalar_norm_add; intros trace; elim trace;
[ exact reduce_stable
| intros n H e t; elim apply_right_stable;
[ exact (T_OMEGA11_stable e t) | exact H ] ].
@@ -2014,7 +1991,7 @@ Fixpoint scalar_norm (trace : nat) (t : term) {struct trace} : term :=
Theorem scalar_norm_stable : forall t : nat, term_stable (scalar_norm t).
Proof.
- unfold term_stable, scalar_norm in |- *; intros trace; elim trace;
+ unfold term_stable, scalar_norm; intros trace; elim trace;
[ exact reduce_stable
| intros n H e t; elim apply_right_stable;
[ exact (T_OMEGA16_stable e t) | exact H ] ].
@@ -2029,7 +2006,7 @@ Fixpoint add_norm (trace : nat) (t : term) {struct trace} : term :=
Theorem add_norm_stable : forall t : nat, term_stable (add_norm t).
Proof.
- unfold term_stable, add_norm in |- *; intros trace; elim trace;
+ unfold term_stable, add_norm; intros trace; elim trace;
[ exact reduce_stable
| intros n H e t; elim apply_right_stable;
[ exact (Tplus_assoc_r_stable e t) | exact H ] ].
@@ -2071,12 +2048,12 @@ Fixpoint t_rewrite (s : step) : term -> term :=
Theorem t_rewrite_stable : forall s : step, term_stable (t_rewrite s).
Proof.
- simple induction s; simpl in |- *;
+ simple induction s; simpl;
[ intros; apply apply_both_stable; auto
| intros; apply apply_left_stable; auto
| intros; apply apply_right_stable; auto
- | unfold term_stable in |- *; intros; elim H0; apply H
- | unfold term_stable in |- *; auto
+ | unfold term_stable; intros; elim H0; apply H
+ | unfold term_stable; auto
| exact Topp_plus_stable
| exact Topp_opp_stable
| exact Topp_mult_r_stable
@@ -2116,11 +2093,11 @@ Definition constant_not_nul (i : nat) (h : hyps) :=
Theorem constant_not_nul_valid :
forall i : nat, valid_hyps (constant_not_nul i).
Proof.
- unfold valid_hyps, constant_not_nul in |- *; intros;
- generalize (nth_valid ep e i lp); Simplify; simpl in |- *.
+ unfold valid_hyps, constant_not_nul; intros;
+ generalize (nth_valid ep e i lp); Simplify; simpl.
- elim_beq i1 i0; auto; simpl in |- *; intros H1 H2;
- elim H1; symmetry in |- *; auto.
+ elim_beq i1 i0; auto; simpl; intros H1 H2;
+ elim H1; symmetry ; auto.
Qed.
(* \paragraph{[O_CONSTANT_NEG]} *)
@@ -2134,8 +2111,8 @@ Definition constant_neg (i : nat) (h : hyps) :=
Theorem constant_neg_valid : forall i : nat, valid_hyps (constant_neg i).
Proof.
- unfold valid_hyps, constant_neg in |- *; intros;
- generalize (nth_valid ep e i lp); Simplify; simpl in |- *.
+ unfold valid_hyps, constant_neg; intros;
+ generalize (nth_valid ep e i lp); Simplify; simpl.
rewrite gt_lt_iff in H0; rewrite le_lt_iff; intuition.
Qed.
@@ -2157,7 +2134,7 @@ Theorem not_exact_divide_valid :
forall (k1 k2 : int) (body : term) (t i : nat),
valid_hyps (not_exact_divide k1 k2 body t i).
Proof.
- unfold valid_hyps, not_exact_divide in |- *; intros;
+ unfold valid_hyps, not_exact_divide; intros;
generalize (nth_valid ep e i lp); Simplify.
rewrite (scalar_norm_add_stable t e), <-H1.
do 2 rewrite <- scalar_norm_add_stable; simpl in *; intros.
@@ -2186,16 +2163,16 @@ Definition contradiction (t i j : nat) (l : hyps) :=
Theorem contradiction_valid :
forall t i j : nat, valid_hyps (contradiction t i j).
Proof.
- unfold valid_hyps, contradiction in |- *; intros t i j ep e l H;
+ unfold valid_hyps, contradiction; intros t i j ep e l H;
generalize (nth_valid _ _ i _ H); generalize (nth_valid _ _ j _ H);
case (nth_hyps i l); auto; intros t1 t2; case t1;
auto; case (nth_hyps j l);
auto; intros t3 t4; case t3; auto;
- simpl in |- *; intros z z' H1 H2;
- generalize (refl_equal (interp_term e (fusion_cancel t (t2 + t4)%term)));
- pattern (fusion_cancel t (t2 + t4)%term) at 2 3 in |- *;
- case (fusion_cancel t (t2 + t4)%term); simpl in |- *;
- auto; intro k; elim (fusion_cancel_stable t); simpl in |- *.
+ simpl; intros z z' H1 H2;
+ generalize (eq_refl (interp_term e (fusion_cancel t (t2 + t4)%term)));
+ pattern (fusion_cancel t (t2 + t4)%term) at 2 3;
+ case (fusion_cancel t (t2 + t4)%term); simpl;
+ auto; intro k; elim (fusion_cancel_stable t); simpl.
Simplify; intro H3.
generalize (OMEGA2 _ _ H2 H1); rewrite H3.
rewrite gt_lt_iff in H0; rewrite le_lt_iff; intuition.
@@ -2250,23 +2227,23 @@ Definition negate_contradict_inv (t i1 i2 : nat) (h : hyps) :=
Theorem negate_contradict_valid :
forall i j : nat, valid_hyps (negate_contradict i j).
Proof.
- unfold valid_hyps, negate_contradict in |- *; intros i j ep e l H;
+ unfold valid_hyps, negate_contradict; intros i j ep e l H;
generalize (nth_valid _ _ i _ H); generalize (nth_valid _ _ j _ H);
case (nth_hyps i l); auto; intros t1 t2; case t1;
auto; intros z; auto; case (nth_hyps j l);
auto; intros t3 t4; case t3; auto; intros z';
- auto; simpl in |- *; intros H1 H2; Simplify.
+ auto; simpl; intros H1 H2; Simplify.
Qed.
Theorem negate_contradict_inv_valid :
forall t i j : nat, valid_hyps (negate_contradict_inv t i j).
Proof.
- unfold valid_hyps, negate_contradict_inv in |- *; intros t i j ep e l H;
+ unfold valid_hyps, negate_contradict_inv; intros t i j ep e l H;
generalize (nth_valid _ _ i _ H); generalize (nth_valid _ _ j _ H);
case (nth_hyps i l); auto; intros t1 t2; case t1;
auto; intros z; auto; case (nth_hyps j l);
auto; intros t3 t4; case t3; auto; intros z';
- auto; simpl in |- *; intros H1 H2; Simplify;
+ auto; simpl; intros H1 H2; Simplify;
[
rewrite <- scalar_norm_stable in H2; simpl in *;
elim (mult_integral (interp_term e t4) (-(1))); intuition;
@@ -2333,9 +2310,9 @@ Definition sum (k1 k2 : int) (trace : list t_fusion)
Theorem sum_valid :
forall (k1 k2 : int) (t : list t_fusion), valid2 (sum k1 k2 t).
Proof.
- unfold valid2 in |- *; intros k1 k2 t ep e p1 p2; unfold sum in |- *;
- Simplify; simpl in |- *; auto; try elim (fusion_stable t);
- simpl in |- *; intros;
+ unfold valid2; intros k1 k2 t ep e p1 p2; unfold sum;
+ Simplify; simpl; auto; try elim (fusion_stable t);
+ simpl; intros;
[ apply sum1; assumption
| apply sum2; try assumption; apply sum4; assumption
| rewrite plus_comm; apply sum2; try assumption; apply sum4; assumption
@@ -2367,10 +2344,10 @@ Definition exact_divide (k : int) (body : term) (t : nat)
Theorem exact_divide_valid :
forall (k : int) (t : term) (n : nat), valid1 (exact_divide k t n).
Proof.
- unfold valid1, exact_divide in |- *; intros k1 k2 t ep e p1;
+ unfold valid1, exact_divide; intros k1 k2 t ep e p1;
Simplify; simpl; auto; subst;
rewrite <- scalar_norm_stable; simpl; intros;
- [ destruct (mult_integral _ _ (sym_eq H0)); intuition
+ [ destruct (mult_integral _ _ (eq_sym H0)); intuition
| contradict H0; rewrite <- H0, mult_0_l; auto
].
Qed.
@@ -2397,9 +2374,9 @@ Theorem divide_and_approx_valid :
forall (k1 k2 : int) (body : term) (t : nat),
valid1 (divide_and_approx k1 k2 body t).
Proof.
- unfold valid1, divide_and_approx in |- *; intros k1 k2 body t ep e p1;
+ unfold valid1, divide_and_approx; intros k1 k2 body t ep e p1;
Simplify; simpl; auto; subst;
- elim (scalar_norm_add_stable t e); simpl in |- *.
+ elim (scalar_norm_add_stable t e); simpl.
intro H2; apply mult_le_approx with (3 := H2); assumption.
Qed.
@@ -2421,9 +2398,9 @@ Definition merge_eq (t : nat) (prop1 prop2 : proposition) :=
Theorem merge_eq_valid : forall n : nat, valid2 (merge_eq n).
Proof.
- unfold valid2, merge_eq in |- *; intros n ep e p1 p2; Simplify; simpl in |- *;
- auto; elim (scalar_norm_stable n e); simpl in |- *;
- intros; symmetry in |- *; apply OMEGA8 with (2 := H0);
+ unfold valid2, merge_eq; intros n ep e p1 p2; Simplify; simpl;
+ auto; elim (scalar_norm_stable n e); simpl;
+ intros; symmetry ; apply OMEGA8 with (2 := H0);
[ assumption | elim opp_eq_mult_neg_1; trivial ].
Qed.
@@ -2440,8 +2417,8 @@ Definition constant_nul (i : nat) (h : hyps) :=
Theorem constant_nul_valid : forall i : nat, valid_hyps (constant_nul i).
Proof.
- unfold valid_hyps, constant_nul in |- *; intros;
- generalize (nth_valid ep e i lp); Simplify; simpl in |- *;
+ unfold valid_hyps, constant_nul; intros;
+ generalize (nth_valid ep e i lp); Simplify; simpl;
intro H1; absurd (0 = 0); intuition.
Qed.
@@ -2462,8 +2439,8 @@ Definition state (m : int) (s : step) (prop1 prop2 : proposition) :=
Theorem state_valid : forall (m : int) (s : step), valid2 (state m s).
Proof.
- unfold valid2 in |- *; intros m s ep e p1 p2; unfold state in |- *; Simplify;
- simpl in |- *; auto; elim (t_rewrite_stable s e); simpl in |- *;
+ unfold valid2; intros m s ep e p1 p2; unfold state; Simplify;
+ simpl; auto; elim (t_rewrite_stable s e); simpl;
intros H1 H2; elim H1.
now rewrite H2, plus_opp_l, plus_0_l, mult_0_l.
Qed.
@@ -2490,18 +2467,18 @@ Theorem split_ineq_valid :
valid_list_hyps f1 ->
valid_list_hyps f2 -> valid_list_hyps (split_ineq i t f1 f2).
Proof.
- unfold valid_list_hyps, split_ineq in |- *; intros i t f1 f2 H1 H2 ep e lp H;
+ unfold valid_list_hyps, split_ineq; intros i t f1 f2 H1 H2 ep e lp H;
generalize (nth_valid _ _ i _ H); case (nth_hyps i lp);
- simpl in |- *; auto; intros t1 t2; case t1; simpl in |- *;
- auto; intros z; simpl in |- *; auto; intro H3.
+ simpl; auto; intros t1 t2; case t1; simpl;
+ auto; intros z; simpl; auto; intro H3.
Simplify.
apply append_valid; elim (OMEGA19 (interp_term e t2));
- [ intro H4; left; apply H1; simpl in |- *; elim (add_norm_stable t);
- simpl in |- *; auto
- | intro H4; right; apply H2; simpl in |- *; elim (scalar_norm_add_stable t);
- simpl in |- *; auto
- | generalize H3; unfold not in |- *; intros E1 E2; apply E1;
- symmetry in |- *; trivial ].
+ [ intro H4; left; apply H1; simpl; elim (add_norm_stable t);
+ simpl; auto
+ | intro H4; right; apply H2; simpl; elim (scalar_norm_add_stable t);
+ simpl; auto
+ | generalize H3; unfold not; intros E1 E2; apply E1;
+ symmetry ; trivial ].
Qed.
@@ -2534,47 +2511,47 @@ Fixpoint execute_omega (t : t_omega) (l : hyps) {struct t} : lhyps :=
Theorem omega_valid : forall t : t_omega, valid_list_hyps (execute_omega t).
Proof.
- simple induction t; simpl in |- *;
- [ unfold valid_list_hyps in |- *; simpl in |- *; intros; left;
+ simple induction t; simpl;
+ [ unfold valid_list_hyps; simpl; intros; left;
apply (constant_not_nul_valid n ep e lp H)
- | unfold valid_list_hyps in |- *; simpl in |- *; intros; left;
+ | unfold valid_list_hyps; simpl; intros; left;
apply (constant_neg_valid n ep e lp H)
- | unfold valid_list_hyps, valid_hyps in |- *;
+ | unfold valid_list_hyps, valid_hyps;
intros k1 k2 body n t' Ht' m ep e lp H; apply Ht';
apply
(apply_oper_1_valid m (divide_and_approx k1 k2 body n)
(divide_and_approx_valid k1 k2 body n) ep e lp H)
- | unfold valid_list_hyps in |- *; simpl in |- *; intros; left;
+ | unfold valid_list_hyps; simpl; intros; left;
apply (not_exact_divide_valid i i0 t0 n n0 ep e lp H)
- | unfold valid_list_hyps, valid_hyps in |- *;
+ | unfold valid_list_hyps, valid_hyps;
intros k body n t' Ht' m ep e lp H; apply Ht';
apply
(apply_oper_1_valid m (exact_divide k body n)
(exact_divide_valid k body n) ep e lp H)
- | unfold valid_list_hyps, valid_hyps in |- *;
+ | unfold valid_list_hyps, valid_hyps;
intros k1 i1 k2 i2 trace t' Ht' ep e lp H; apply Ht';
apply
(apply_oper_2_valid i1 i2 (sum k1 k2 trace) (sum_valid k1 k2 trace) ep e
lp H)
- | unfold valid_list_hyps in |- *; simpl in |- *; intros; left;
+ | unfold valid_list_hyps; simpl; intros; left;
apply (contradiction_valid n n0 n1 ep e lp H)
- | unfold valid_list_hyps, valid_hyps in |- *;
+ | unfold valid_list_hyps, valid_hyps;
intros trace i1 i2 t' Ht' ep e lp H; apply Ht';
apply
(apply_oper_2_valid i1 i2 (merge_eq trace) (merge_eq_valid trace) ep e
lp H)
- | intros t' i k1 H1 k2 H2; unfold valid_list_hyps in |- *; simpl in |- *;
+ | intros t' i k1 H1 k2 H2; unfold valid_list_hyps; simpl;
intros ep e lp H;
apply
(split_ineq_valid i t' (execute_omega k1) (execute_omega k2) H1 H2 ep e
lp H)
- | unfold valid_list_hyps in |- *; simpl in |- *; intros i ep e lp H; left;
+ | unfold valid_list_hyps; simpl; intros i ep e lp H; left;
apply (constant_nul_valid i ep e lp H)
- | unfold valid_list_hyps in |- *; simpl in |- *; intros i j ep e lp H; left;
+ | unfold valid_list_hyps; simpl; intros i j ep e lp H; left;
apply (negate_contradict_valid i j ep e lp H)
- | unfold valid_list_hyps in |- *; simpl in |- *; intros n i j ep e lp H;
+ | unfold valid_list_hyps; simpl; intros n i j ep e lp H;
left; apply (negate_contradict_inv_valid n i j ep e lp H)
- | unfold valid_list_hyps, valid_hyps in |- *;
+ | unfold valid_list_hyps, valid_hyps;
intros m s i1 i2 t' Ht' ep e lp H; apply Ht';
apply (apply_oper_2_valid i1 i2 (state m s) (state_valid m s) ep e lp H) ].
Qed.
@@ -2596,9 +2573,9 @@ Definition move_right (s : step) (p : proposition) :=
Theorem move_right_valid : forall s : step, valid1 (move_right s).
Proof.
- unfold valid1, move_right in |- *; intros s ep e p; Simplify; simpl in |- *;
- elim (t_rewrite_stable s e); simpl in |- *;
- [ symmetry in |- *; apply egal_left; assumption
+ unfold valid1, move_right; intros s ep e p; Simplify; simpl;
+ elim (t_rewrite_stable s e); simpl;
+ [ symmetry ; apply egal_left; assumption
| intro; apply le_left; assumption
| intro; apply le_left; rewrite <- ge_le_iff; assumption
| intro; apply lt_left; rewrite <- gt_lt_iff; assumption
@@ -2611,7 +2588,7 @@ Definition do_normalize (i : nat) (s : step) := apply_oper_1 i (move_right s).
Theorem do_normalize_valid :
forall (i : nat) (s : step), valid_hyps (do_normalize i s).
Proof.
- intros; unfold do_normalize in |- *; apply apply_oper_1_valid;
+ intros; unfold do_normalize; apply apply_oper_1_valid;
apply move_right_valid.
Qed.
@@ -2625,7 +2602,7 @@ Fixpoint do_normalize_list (l : list step) (i : nat)
Theorem do_normalize_list_valid :
forall (l : list step) (i : nat), valid_hyps (do_normalize_list l i).
Proof.
- simple induction l; simpl in |- *; unfold valid_hyps in |- *;
+ simple induction l; simpl; unfold valid_hyps;
[ auto
| intros a l' Hl' i ep e lp H; unfold valid_hyps in Hl'; apply Hl';
apply (do_normalize_valid i a ep e lp); assumption ].
@@ -2654,8 +2631,8 @@ Theorem append_goal :
interp_list_goal ep e (l1 ++ l2).
Proof.
intros ep e; simple induction l1;
- [ simpl in |- *; intros l2 (H1, H2); assumption
- | simpl in |- *; intros h1 t1 HR l2 ((H1, H2), H3); split; auto ].
+ [ simpl; intros l2 (H1, H2); assumption
+ | simpl; intros h1 t1 HR l2 ((H1, H2), H3); split; auto ].
Qed.
(* A simple decidability checker : if the proposition belongs to the
@@ -2684,11 +2661,11 @@ Theorem decidable_correct :
forall (ep : list Prop) (e : list int) (p : proposition),
decidability p = true -> decidable (interp_proposition ep e p).
Proof.
- simple induction p; simpl in |- *; intros;
+ simple induction p; simpl; intros;
[ apply dec_eq
| apply dec_le
| left; auto
- | right; unfold not in |- *; auto
+ | right; unfold not; auto
| apply dec_not; auto
| apply dec_ge
| apply dec_gt
@@ -2724,7 +2701,7 @@ Theorem interp_full_false :
forall (ep : list Prop) (e : list int) (l : hyps) (c : proposition),
(interp_hyps ep e l -> interp_proposition ep e c) -> interp_full ep e (l, c).
Proof.
- simple induction l; unfold interp_full in |- *; simpl in |- *;
+ simple induction l; unfold interp_full; simpl;
[ auto | intros a l1 H1 c H2 H3; apply H1; auto ].
Qed.
@@ -2744,12 +2721,12 @@ Theorem to_contradict_valid :
forall (ep : list Prop) (e : list int) (lc : hyps * proposition),
interp_goal ep e (to_contradict lc) -> interp_full ep e lc.
Proof.
- intros ep e lc; case lc; intros l c; simpl in |- *;
- pattern (decidability c) in |- *; apply bool_eq_ind;
- [ simpl in |- *; intros H H1; apply interp_full_false; intros H2;
+ intros ep e lc; case lc; intros l c; simpl;
+ pattern (decidability c); apply bool_eq_ind;
+ [ simpl; intros H H1; apply interp_full_false; intros H2;
apply not_not;
[ apply decidable_correct; assumption
- | unfold not at 1 in |- *; intro H3; apply hyps_to_goal with (2 := H2);
+ | unfold not at 1; intro H3; apply hyps_to_goal with (2 := H2);
auto ]
| intros H1 H2; apply interp_full_false; intro H3;
elim hyps_to_goal with (1 := H2); assumption ].
@@ -2813,7 +2790,7 @@ Theorem map_cons_val :
interp_proposition ep e p ->
interp_list_hyps ep e l -> interp_list_hyps ep e (map_cons _ p l).
Proof.
- simple induction l; simpl in |- *; [ auto | intros; elim H1; intro H2; auto ].
+ simple induction l; simpl; [ auto | intros; elim H1; intro H2; auto ].
Qed.
Hint Resolve map_cons_val append_valid decidable_correct.
@@ -2822,43 +2799,43 @@ Theorem destructure_hyps_valid :
forall n : nat, valid_list_hyps (destructure_hyps n).
Proof.
simple induction n;
- [ unfold valid_list_hyps in |- *; simpl in |- *; auto
- | unfold valid_list_hyps at 2 in |- *; intros n1 H ep e lp; case lp;
- [ simpl in |- *; auto
+ [ unfold valid_list_hyps; simpl; auto
+ | unfold valid_list_hyps at 2; intros n1 H ep e lp; case lp;
+ [ simpl; auto
| intros p l; case p;
try
- (simpl in |- *; intros; apply map_cons_val; simpl in |- *; elim H0;
+ (simpl; intros; apply map_cons_val; simpl; elim H0;
auto);
[ intro p'; case p';
try
- (simpl in |- *; intros; apply map_cons_val; simpl in |- *; elim H0;
+ (simpl; intros; apply map_cons_val; simpl; elim H0;
auto);
- [ simpl in |- *; intros p1 (H1, H2);
- pattern (decidability p1) in |- *; apply bool_eq_ind;
+ [ simpl; intros p1 (H1, H2);
+ pattern (decidability p1); apply bool_eq_ind;
intro H3;
- [ apply H; simpl in |- *; split;
+ [ apply H; simpl; split;
[ apply not_not; auto | assumption ]
| auto ]
- | simpl in |- *; intros p1 p2 (H1, H2); apply H; simpl in |- *;
+ | simpl; intros p1 p2 (H1, H2); apply H; simpl;
elim not_or with (1 := H1); auto
- | simpl in |- *; intros p1 p2 (H1, H2);
- pattern (decidability p1) in |- *; apply bool_eq_ind;
+ | simpl; intros p1 p2 (H1, H2);
+ pattern (decidability p1); apply bool_eq_ind;
intro H3;
[ apply append_valid; elim not_and with (2 := H1);
- [ intro; left; apply H; simpl in |- *; auto
- | intro; right; apply H; simpl in |- *; auto
+ [ intro; left; apply H; simpl; auto
+ | intro; right; apply H; simpl; auto
| auto ]
| auto ] ]
- | simpl in |- *; intros p1 p2 (H1, H2); apply append_valid;
- (elim H1; intro H3; simpl in |- *; [ left | right ]);
- apply H; simpl in |- *; auto
- | simpl in |- *; intros; apply H; simpl in |- *; tauto
- | simpl in |- *; intros p1 p2 (H1, H2);
- pattern (decidability p1) in |- *; apply bool_eq_ind;
+ | simpl; intros p1 p2 (H1, H2); apply append_valid;
+ (elim H1; intro H3; simpl; [ left | right ]);
+ apply H; simpl; auto
+ | simpl; intros; apply H; simpl; tauto
+ | simpl; intros p1 p2 (H1, H2);
+ pattern (decidability p1); apply bool_eq_ind;
intro H3;
[ apply append_valid; elim imp_simp with (2 := H1);
- [ intro H4; left; simpl in |- *; apply H; simpl in |- *; auto
- | intro H4; right; simpl in |- *; apply H; simpl in |- *; auto
+ [ intro H4; left; simpl; apply H; simpl; auto
+ | intro H4; right; simpl; apply H; simpl; auto
| auto ]
| auto ] ] ] ].
Qed.
@@ -2881,8 +2858,8 @@ Theorem p_apply_left_stable :
forall f : proposition -> proposition,
prop_stable f -> prop_stable (p_apply_left f).
Proof.
- unfold prop_stable in |- *; intros f H ep e p; split;
- (case p; simpl in |- *; auto; intros p1; elim (H ep e p1); tauto).
+ unfold prop_stable; intros f H ep e p; split;
+ (case p; simpl; auto; intros p1; elim (H ep e p1); tauto).
Qed.
Definition p_apply_right (f : proposition -> proposition)
@@ -2899,8 +2876,8 @@ Theorem p_apply_right_stable :
forall f : proposition -> proposition,
prop_stable f -> prop_stable (p_apply_right f).
Proof.
- unfold prop_stable in |- *; intros f H ep e p; split;
- (case p; simpl in |- *; auto;
+ unfold prop_stable; intros f H ep e p; split;
+ (case p; simpl; auto;
[ intros p1; elim (H ep e p1); tauto
| intros p1 p2; elim (H ep e p2); tauto
| intros p1 p2; elim (H ep e p2); tauto
@@ -2923,42 +2900,42 @@ Theorem p_invert_stable :
forall f : proposition -> proposition,
prop_stable f -> prop_stable (p_invert f).
Proof.
- unfold prop_stable in |- *; intros f H ep e p; split;
- (case p; simpl in |- *; auto;
- [ intros t1 t2; elim (H ep e (NeqTerm t1 t2)); simpl in |- *;
+ unfold prop_stable; intros f H ep e p; split;
+ (case p; simpl; auto;
+ [ intros t1 t2; elim (H ep e (NeqTerm t1 t2)); simpl;
generalize (dec_eq (interp_term e t1) (interp_term e t2));
- unfold decidable in |- *; tauto
- | intros t1 t2; elim (H ep e (GtTerm t1 t2)); simpl in |- *;
+ unfold decidable; tauto
+ | intros t1 t2; elim (H ep e (GtTerm t1 t2)); simpl;
generalize (dec_gt (interp_term e t1) (interp_term e t2));
- unfold decidable in |- *; rewrite le_lt_iff, <- gt_lt_iff; tauto
- | intros t1 t2; elim (H ep e (LtTerm t1 t2)); simpl in |- *;
+ unfold decidable; rewrite le_lt_iff, <- gt_lt_iff; tauto
+ | intros t1 t2; elim (H ep e (LtTerm t1 t2)); simpl;
generalize (dec_lt (interp_term e t1) (interp_term e t2));
- unfold decidable in |- *; rewrite ge_le_iff, le_lt_iff; tauto
- | intros t1 t2; elim (H ep e (LeqTerm t1 t2)); simpl in |- *;
+ unfold decidable; rewrite ge_le_iff, le_lt_iff; tauto
+ | intros t1 t2; elim (H ep e (LeqTerm t1 t2)); simpl;
generalize (dec_gt (interp_term e t1) (interp_term e t2));
- unfold decidable in |- *; repeat rewrite le_lt_iff;
+ unfold decidable; repeat rewrite le_lt_iff;
repeat rewrite gt_lt_iff; tauto
- | intros t1 t2; elim (H ep e (GeqTerm t1 t2)); simpl in |- *;
+ | intros t1 t2; elim (H ep e (GeqTerm t1 t2)); simpl;
generalize (dec_lt (interp_term e t1) (interp_term e t2));
- unfold decidable in |- *; repeat rewrite ge_le_iff;
+ unfold decidable; repeat rewrite ge_le_iff;
repeat rewrite le_lt_iff; tauto
- | intros t1 t2; elim (H ep e (EqTerm t1 t2)); simpl in |- *;
+ | intros t1 t2; elim (H ep e (EqTerm t1 t2)); simpl;
generalize (dec_eq (interp_term e t1) (interp_term e t2));
unfold decidable; tauto ]).
Qed.
Theorem move_right_stable : forall s : step, prop_stable (move_right s).
Proof.
- unfold move_right, prop_stable in |- *; intros s ep e p; split;
- [ Simplify; simpl in |- *; elim (t_rewrite_stable s e); simpl in |- *;
- [ symmetry in |- *; apply egal_left; assumption
+ unfold move_right, prop_stable; intros s ep e p; split;
+ [ Simplify; simpl; elim (t_rewrite_stable s e); simpl;
+ [ symmetry ; apply egal_left; assumption
| intro; apply le_left; assumption
| intro; apply le_left; rewrite <- ge_le_iff; assumption
| intro; apply lt_left; rewrite <- gt_lt_iff; assumption
| intro; apply lt_left; assumption
| intro; apply ne_left_2; assumption ]
- | case p; simpl in |- *; intros; auto; generalize H; elim (t_rewrite_stable s);
- simpl in |- *; intro H1;
+ | case p; simpl; intros; auto; generalize H; elim (t_rewrite_stable s);
+ simpl; intro H1;
[ rewrite (plus_0_r_reverse (interp_term e t0)); rewrite H1;
rewrite plus_permute; rewrite plus_opp_r;
rewrite plus_0_r; trivial
@@ -2969,7 +2946,7 @@ Proof.
rewrite plus_opp_r; assumption
| rewrite gt_lt_iff; apply lt_left_inv; assumption
| apply lt_left_inv; assumption
- | unfold not in |- *; intro H2; apply H1;
+ | unfold not; intro H2; apply H1;
rewrite H2; rewrite plus_opp_r; trivial ] ].
Qed.
@@ -2985,12 +2962,12 @@ Fixpoint p_rewrite (s : p_step) : proposition -> proposition :=
Theorem p_rewrite_stable : forall s : p_step, prop_stable (p_rewrite s).
Proof.
- simple induction s; simpl in |- *;
+ simple induction s; simpl;
[ intros; apply p_apply_left_stable; trivial
| intros; apply p_apply_right_stable; trivial
| intros; apply p_invert_stable; apply move_right_stable
| apply move_right_stable
- | unfold prop_stable in |- *; simpl in |- *; intros; split; auto ].
+ | unfold prop_stable; simpl; intros; split; auto ].
Qed.
Fixpoint normalize_hyps (l : list h_step) (lh : hyps) {struct l} : hyps :=
@@ -3002,11 +2979,11 @@ Fixpoint normalize_hyps (l : list h_step) (lh : hyps) {struct l} : hyps :=
Theorem normalize_hyps_valid :
forall l : list h_step, valid_hyps (normalize_hyps l).
Proof.
- simple induction l; unfold valid_hyps in |- *; simpl in |- *;
+ simple induction l; unfold valid_hyps; simpl;
[ auto
| intros n_s r; case n_s; intros n s H ep e lp H1; apply H;
apply apply_oper_1_valid;
- [ unfold valid1 in |- *; intros ep1 e1 p1 H2;
+ [ unfold valid1; intros ep1 e1 p1 H2;
elim (p_rewrite_stable s ep1 e1 p1); auto
| assumption ] ].
Qed.
@@ -3073,21 +3050,21 @@ Theorem extract_valid :
forall s : list direction,
valid1 (extract_hyp_pos s) /\ co_valid1 (extract_hyp_neg s).
Proof.
- unfold valid1, co_valid1 in |- *; simple induction s;
+ unfold valid1, co_valid1; simple induction s;
[ split;
- [ simpl in |- *; auto
- | intros ep e p1; case p1; simpl in |- *; auto; intro p;
- pattern (decidability p) in |- *; apply bool_eq_ind;
+ [ simpl; auto
+ | intros ep e p1; case p1; simpl; auto; intro p;
+ pattern (decidability p); apply bool_eq_ind;
[ intro H; generalize (decidable_correct ep e p H);
- unfold decidable in |- *; tauto
- | simpl in |- *; auto ] ]
+ unfold decidable; tauto
+ | simpl; auto ] ]
| intros a s' (H1, H2); simpl in H2; split; intros ep e p; case a; auto;
- case p; auto; simpl in |- *; intros;
+ case p; auto; simpl; intros;
(apply H1; tauto) ||
(apply H2; tauto) ||
- (pattern (decidability p0) in |- *; apply bool_eq_ind;
+ (pattern (decidability p0); apply bool_eq_ind;
[ intro H3; generalize (decidable_correct ep e p0 H3);
- unfold decidable in |- *; intro H4; apply H1;
+ unfold decidable; intro H4; apply H1;
tauto
| intro; tauto ]) ].
Qed.
@@ -3117,29 +3094,29 @@ Fixpoint decompose_solve (s : e_step) (h : hyps) {struct s} : lhyps :=
Theorem decompose_solve_valid :
forall s : e_step, valid_list_goal (decompose_solve s).
Proof.
- intro s; apply goal_valid; unfold valid_list_hyps in |- *; elim s;
- simpl in |- *; intros;
+ intro s; apply goal_valid; unfold valid_list_hyps; elim s;
+ simpl; intros;
[ cut (interp_proposition ep e1 (extract_hyp_pos l (nth_hyps n lp)));
- [ case (extract_hyp_pos l (nth_hyps n lp)); simpl in |- *; auto;
- [ intro p; case p; simpl in |- *; auto; intros p1 p2 H2;
- pattern (decidability p1) in |- *; apply bool_eq_ind;
+ [ case (extract_hyp_pos l (nth_hyps n lp)); simpl; auto;
+ [ intro p; case p; simpl; auto; intros p1 p2 H2;
+ pattern (decidability p1); apply bool_eq_ind;
[ intro H3; generalize (decidable_correct ep e1 p1 H3); intro H4;
apply append_valid; elim H4; intro H5;
- [ right; apply H0; simpl in |- *; tauto
- | left; apply H; simpl in |- *; tauto ]
- | simpl in |- *; auto ]
- | intros p1 p2 H2; apply append_valid; simpl in |- *; elim H2;
- [ intros H3; left; apply H; simpl in |- *; auto
- | intros H3; right; apply H0; simpl in |- *; auto ]
+ [ right; apply H0; simpl; tauto
+ | left; apply H; simpl; tauto ]
+ | simpl; auto ]
+ | intros p1 p2 H2; apply append_valid; simpl; elim H2;
+ [ intros H3; left; apply H; simpl; auto
+ | intros H3; right; apply H0; simpl; auto ]
| intros p1 p2 H2;
- pattern (decidability p1) in |- *; apply bool_eq_ind;
+ pattern (decidability p1); apply bool_eq_ind;
[ intro H3; generalize (decidable_correct ep e1 p1 H3); intro H4;
apply append_valid; elim H4; intro H5;
- [ right; apply H0; simpl in |- *; tauto
- | left; apply H; simpl in |- *; tauto ]
- | simpl in |- *; auto ] ]
+ [ right; apply H0; simpl; tauto
+ | left; apply H; simpl; tauto ]
+ | simpl; auto ] ]
| elim (extract_valid l); intros H2 H3; apply H2; apply nth_valid; auto ]
- | intros; apply H; simpl in |- *; split;
+ | intros; apply H; simpl; split;
[ elim (extract_valid l); intros H2 H3; apply H2; apply nth_valid; auto
| auto ]
| apply omega_valid with (1 := H) ].
@@ -3160,11 +3137,11 @@ Fixpoint reduce_lhyps (lp : lhyps) : lhyps :=
Theorem reduce_lhyps_valid : valid_lhyps reduce_lhyps.
Proof.
- unfold valid_lhyps in |- *; intros ep e lp; elim lp;
- [ simpl in |- *; auto
+ unfold valid_lhyps; intros ep e lp; elim lp;
+ [ simpl; auto
| intros a l HR; elim a;
- [ simpl in |- *; tauto
- | intros a1 l1; case l1; case a1; simpl in |- *; try tauto ] ].
+ [ simpl; tauto
+ | intros a1 l1; case l1; case a1; simpl; try tauto ] ].
Qed.
Theorem do_reduce_lhyps :
@@ -3184,13 +3161,13 @@ Definition do_concl_to_hyp :
interp_goal envp env (concl_to_hyp c :: l) ->
interp_goal_concl c envp env l.
Proof.
- simpl in |- *; intros envp env c l; induction l as [| a l Hrecl];
- [ simpl in |- *; unfold concl_to_hyp in |- *;
- pattern (decidability c) in |- *; apply bool_eq_ind;
+ simpl; intros envp env c l; induction l as [| a l Hrecl];
+ [ simpl; unfold concl_to_hyp;
+ pattern (decidability c); apply bool_eq_ind;
[ intro H; generalize (decidable_correct envp env c H);
- unfold decidable in |- *; simpl in |- *; tauto
- | simpl in |- *; intros H1 H2; elim H2; trivial ]
- | simpl in |- *; tauto ].
+ unfold decidable; simpl; tauto
+ | simpl; intros H1 H2; elim H2; trivial ]
+ | simpl; tauto ].
Qed.
Definition omega_tactic (t1 : e_step) (t2 : list h_step)
@@ -3203,7 +3180,7 @@ Theorem do_omega :
interp_list_goal envp env (omega_tactic t1 t2 c l) ->
interp_goal_concl c envp env l.
Proof.
- unfold omega_tactic in |- *; intros; apply do_concl_to_hyp;
+ unfold omega_tactic; intros; apply do_concl_to_hyp;
apply (normalize_hyps_goal t2); apply (decompose_solve_valid t1);
apply do_reduce_lhyps; assumption.
Qed.
diff --git a/plugins/rtauto/Bintree.v b/plugins/rtauto/Bintree.v
index 77f8f834..98dd257d 100644
--- a/plugins/rtauto/Bintree.v
+++ b/plugins/rtauto/Bintree.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -15,14 +15,14 @@ Open Scope positive_scope.
Ltac clean := try (simpl; congruence).
Lemma Gt_Psucc: forall p q,
- (p ?= Psucc q) = Gt -> (p ?= q) = Gt.
+ (p ?= Pos.succ q) = Gt -> (p ?= q) = Gt.
Proof.
intros. rewrite <- Pos.compare_succ_succ.
now apply Pos.lt_gt, Pos.lt_lt_succ, Pos.gt_lt.
Qed.
Lemma Psucc_Gt : forall p,
- (Psucc p ?= p) = Gt.
+ (Pos.succ p ?= p) = Gt.
Proof.
intros. apply Pos.lt_gt, Pos.lt_succ_diag_r.
Qed.
@@ -181,7 +181,7 @@ mkStore {index:positive;contents:Tree}.
Definition empty := mkStore xH Tempty.
Definition push a S :=
-mkStore (Psucc (index S)) (Tadd (index S) a (contents S)).
+mkStore (Pos.succ (index S)) (Tadd (index S) a (contents S)).
Definition get i S := Tget i (contents S).
@@ -214,7 +214,7 @@ intros a S.
rewrite Tget_Tadd.
rewrite Psucc_Gt.
intro W.
-change (get (Psucc (index S)) S =PNone).
+change (get (Pos.succ (index S)) S =PNone).
apply get_Full_Gt; auto.
apply Psucc_Gt.
Qed.
@@ -248,7 +248,7 @@ forall x, get i S = PSome x ->
Proof.
intros i a S F x H.
case_eq (i ?= index S);intro test.
-rewrite (Pcompare_Eq_eq _ _ test) in H.
+rewrite (Pos.compare_eq _ _ test) in H.
rewrite (get_Full_Eq _ F) in H;congruence.
rewrite <- H.
rewrite (get_push_Full i a).
@@ -260,13 +260,13 @@ Qed.
Lemma Full_index_one_empty : forall S, Full S -> index S = 1 -> S=empty.
intros [ind cont] F one; inversion F.
reflexivity.
-simpl index in one;assert (h:=Psucc_not_one (index S)).
+simpl index in one;assert (h:=Pos.succ_not_1 (index S)).
congruence.
Qed.
Lemma push_not_empty: forall a S, (push a S) <> empty.
intros a [ind cont];unfold push,empty.
-simpl;intro H;injection H; intros _ ; apply Psucc_not_one.
+simpl;intro H;injection H; intros _ ; apply Pos.succ_not_1.
Qed.
Fixpoint In (x:A) (S:Store) (F:Full S) {struct F}: Prop :=
diff --git a/plugins/rtauto/Rtauto.v b/plugins/rtauto/Rtauto.v
index 9cae7a44..3b596238 100644
--- a/plugins/rtauto/Rtauto.v
+++ b/plugins/rtauto/Rtauto.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/rtauto/g_rtauto.ml4 b/plugins/rtauto/g_rtauto.ml4
index 8d103d1b..96277e65 100644
--- a/plugins/rtauto/g_rtauto.ml4
+++ b/plugins/rtauto/g_rtauto.ml4
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/rtauto/proof_search.ml b/plugins/rtauto/proof_search.ml
index 576f7d4e..c1e83004 100644
--- a/plugins/rtauto/proof_search.ml
+++ b/plugins/rtauto/proof_search.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/rtauto/proof_search.mli b/plugins/rtauto/proof_search.mli
index 275e94cd..2adda33f 100644
--- a/plugins/rtauto/proof_search.mli
+++ b/plugins/rtauto/proof_search.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/rtauto/refl_tauto.ml b/plugins/rtauto/refl_tauto.ml
index 4a9a0e47..e8909f08 100644
--- a/plugins/rtauto/refl_tauto.ml
+++ b/plugins/rtauto/refl_tauto.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -32,7 +32,7 @@ let data_constant =
Coqlib.gen_constant "refl_tauto" ["Init";"Datatypes"]
let l_true_equals_true =
- lazy (mkApp(logic_constant "refl_equal",
+ lazy (mkApp(logic_constant "eq_refl",
[|data_constant "bool";data_constant "true"|]))
let pos_constant =
diff --git a/plugins/rtauto/refl_tauto.mli b/plugins/rtauto/refl_tauto.mli
index 643433b0..e5fb646a 100644
--- a/plugins/rtauto/refl_tauto.mli
+++ b/plugins/rtauto/refl_tauto.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/setoid_ring/ArithRing.v b/plugins/setoid_ring/ArithRing.v
index 06822ae1..ed35bb46 100644
--- a/plugins/setoid_ring/ArithRing.v
+++ b/plugins/setoid_ring/ArithRing.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -21,17 +21,17 @@ Lemma natSRth : semi_ring_theory O (S O) plus mult (@eq nat).
Lemma nat_morph_N :
semi_morph 0 1 plus mult (eq (A:=nat))
- 0%N 1%N N.add N.mul N.eqb nat_of_N.
+ 0%N 1%N N.add N.mul N.eqb N.to_nat.
Proof.
constructor;trivial.
- exact nat_of_Nplus.
- exact nat_of_Nmult.
+ exact N2Nat.inj_add.
+ exact N2Nat.inj_mul.
intros x y H. apply N.eqb_eq in H. now subst.
Qed.
Ltac natcst t :=
match isnatcst t with
- true => constr:(N_of_nat t)
+ true => constr:(N.of_nat t)
| _ => constr:InitialRing.NotConstant
end.
diff --git a/plugins/setoid_ring/BinList.v b/plugins/setoid_ring/BinList.v
index 7128280a..b3c59457 100644
--- a/plugins/setoid_ring/BinList.v
+++ b/plugins/setoid_ring/BinList.v
@@ -1,16 +1,15 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \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 Export List.
-Require Export ListTactics.
-Open Local Scope positive_scope.
+Set Implicit Arguments.
+Local Open Scope positive_scope.
Section MakeBinList.
Variable A : Type.
@@ -18,76 +17,64 @@ Section MakeBinList.
Fixpoint jump (p:positive) (l:list A) {struct p} : list A :=
match p with
- | xH => tail l
+ | xH => tl l
| xO p => jump p (jump p l)
- | xI p => jump p (jump p (tail l))
+ | xI p => jump p (jump p (tl l))
end.
Fixpoint nth (p:positive) (l:list A) {struct p} : A:=
match p with
| xH => hd default l
| xO p => nth p (jump p l)
- | xI p => nth p (jump p (tail l))
+ | xI p => nth p (jump p (tl l))
end.
- Lemma jump_tl : forall j l, tail (jump j l) = jump j (tail l).
+ Lemma jump_tl : forall j l, tl (jump j l) = jump j (tl l).
Proof.
- induction j;simpl;intros.
- repeat rewrite IHj;trivial.
- repeat rewrite IHj;trivial.
- trivial.
+ induction j;simpl;intros; now rewrite ?IHj.
Qed.
- Lemma jump_Psucc : forall j l,
- (jump (Psucc j) l) = (jump 1 (jump j l)).
+ Lemma jump_succ : forall j l,
+ jump (Pos.succ j) l = jump 1 (jump j l).
Proof.
induction j;simpl;intros.
- repeat rewrite IHj;simpl;repeat rewrite jump_tl;trivial.
- repeat rewrite jump_tl;trivial.
- trivial.
+ - rewrite !IHj; simpl; now rewrite !jump_tl.
+ - now rewrite !jump_tl.
+ - trivial.
Qed.
- Lemma jump_Pplus : forall i j l,
- (jump (i + j) l) = (jump i (jump j l)).
+ Lemma jump_add : forall i j l,
+ jump (i + j) l = jump i (jump j l).
Proof.
- induction i;intros.
- rewrite xI_succ_xO;rewrite Pplus_one_succ_r.
- rewrite <- Pplus_diag;repeat rewrite <- Pplus_assoc.
- repeat rewrite IHi.
- rewrite Pplus_comm;rewrite <- Pplus_one_succ_r;rewrite jump_Psucc;trivial.
- rewrite <- Pplus_diag;repeat rewrite <- Pplus_assoc.
- repeat rewrite IHi;trivial.
- rewrite Pplus_comm;rewrite <- Pplus_one_succ_r;rewrite jump_Psucc;trivial.
+ induction i using Pos.peano_ind; intros.
+ - now rewrite Pos.add_1_l, jump_succ.
+ - now rewrite Pos.add_succ_l, !jump_succ, IHi.
Qed.
- Lemma jump_Pdouble_minus_one : forall i l,
- (jump (Pdouble_minus_one i) (tail l)) = (jump i (jump i l)).
+ Lemma jump_pred_double : forall i l,
+ jump (Pos.pred_double i) (tl l) = jump i (jump i l).
Proof.
induction i;intros;simpl.
- repeat rewrite jump_tl;trivial.
- rewrite IHi. do 2 rewrite <- jump_tl;rewrite IHi;trivial.
- trivial.
+ - now rewrite !jump_tl.
+ - now rewrite IHi, <- 2 jump_tl, IHi.
+ - trivial.
Qed.
-
- Lemma nth_jump : forall p l, nth p (tail l) = hd default (jump p l).
+ Lemma nth_jump : forall p l, nth p (tl l) = hd default (jump p l).
Proof.
induction p;simpl;intros.
- rewrite <-jump_tl;rewrite IHp;trivial.
- rewrite <-jump_tl;rewrite IHp;trivial.
- trivial.
+ - now rewrite <-jump_tl, IHp.
+ - now rewrite <-jump_tl, IHp.
+ - trivial.
Qed.
- Lemma nth_Pdouble_minus_one :
- forall p l, nth (Pdouble_minus_one p) (tail l) = nth p (jump p l).
+ Lemma nth_pred_double :
+ forall p l, nth (Pos.pred_double p) (tl l) = nth p (jump p l).
Proof.
induction p;simpl;intros.
- repeat rewrite jump_tl;trivial.
- rewrite jump_Pdouble_minus_one.
- repeat rewrite <- jump_tl;rewrite IHp;trivial.
- trivial.
+ - now rewrite !jump_tl.
+ - now rewrite jump_pred_double, <- !jump_tl, IHp.
+ - trivial.
Qed.
End MakeBinList.
-
-
diff --git a/plugins/setoid_ring/Cring.v b/plugins/setoid_ring/Cring.v
index 3d6e53fc..02194d4f 100644
--- a/plugins/setoid_ring/Cring.v
+++ b/plugins/setoid_ring/Cring.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -42,10 +42,9 @@ Section cring.
Context {R:Type}`{Rr:Cring R}.
Lemma cring_eq_ext: ring_eq_ext _+_ _*_ -_ _==_.
-intros. apply mk_reqe;intros.
-rewrite H. rewrite H0. reflexivity.
-rewrite H. rewrite H0. reflexivity.
- rewrite H. reflexivity. Defined.
+Proof.
+intros. apply mk_reqe; solve_proper.
+Defined.
Lemma cring_almost_ring_theory:
almost_ring_theory (R:=R) zero one _+_ _*_ _-_ -_ _==_.
@@ -64,11 +63,11 @@ rewrite ring_sub_def ; reflexivity. Defined.
Lemma cring_morph:
ring_morph zero one _+_ _*_ _-_ -_ _==_
- 0%Z 1%Z Zplus Zmult Zminus Zopp Zeq_bool
+ 0%Z 1%Z Z.add Z.mul Z.sub Z.opp Zeq_bool
Ncring_initial.gen_phiZ.
intros. apply mkmorph ; intros; simpl; try reflexivity.
rewrite Ncring_initial.gen_phiZ_add; reflexivity.
-rewrite ring_sub_def. unfold Zminus. rewrite Ncring_initial.gen_phiZ_add.
+rewrite ring_sub_def. unfold Z.sub. rewrite Ncring_initial.gen_phiZ_add.
rewrite Ncring_initial.gen_phiZ_opp; reflexivity.
rewrite Ncring_initial.gen_phiZ_mul; reflexivity.
rewrite Ncring_initial.gen_phiZ_opp; reflexivity.
@@ -80,7 +79,7 @@ Lemma cring_power_theory :
intros; apply Ring_theory.mkpow_th. reflexivity. Defined.
Lemma cring_div_theory:
- div_theory _==_ Zplus Zmult Ncring_initial.gen_phiZ Z.quotrem.
+ div_theory _==_ Z.add Z.mul Ncring_initial.gen_phiZ Z.quotrem.
intros. apply InitialRing.Ztriv_div_th. unfold Setoid_Theory.
simpl. apply ring_setoid. Defined.
@@ -102,7 +101,7 @@ Ltac cring_gen :=
ring_setoid
cring_eq_ext
cring_almost_ring_theory
- Z 0%Z 1%Z Zplus Zmult Zminus Zopp Zeq_bool
+ Z 0%Z 1%Z Z.add Z.mul Z.sub Z.opp Zeq_bool
Ncring_initial.gen_phiZ
cring_morph
N
@@ -126,7 +125,7 @@ Ltac cring:=
cring_compute.
Instance Zcri: (Cring (Rr:=Zr)).
-red. exact Zmult_comm. Defined.
+red. exact Z.mul_comm. Defined.
(* Cring_simplify *)
@@ -136,7 +135,7 @@ Ltac cring_simplify_aux lterm fv lexpr hyp :=
match lexpr with
| ?e::?le =>
let t := constr:(@Ring_polynom.norm_subst
- Z 0%Z 1%Z Zplus Zmult Zminus Zopp Zeq_bool Z.quotrem O nil e) in
+ Z 0%Z 1%Z Z.add Z.mul Z.sub Z.opp Zeq_bool Z.quotrem O nil e) in
let te :=
constr:(@Ring_polynom.Pphi_dev
_ 0 1 _+_ _*_ _-_ -_
@@ -149,7 +148,7 @@ Ltac cring_simplify_aux lterm fv lexpr hyp :=
let t':= fresh "t" in
pose (t' := nft);
assert (eq1 : t = t');
- [vm_cast_no_check (refl_equal t')|
+ [vm_cast_no_check (eq_refl t')|
let eq2 := fresh "ring" in
assert (eq2:(@Ring_polynom.PEeval
_ zero _+_ _*_ _-_ -_ Z Ncring_initial.gen_phiZ N (fun n:N => n)
@@ -159,7 +158,7 @@ Ltac cring_simplify_aux lterm fv lexpr hyp :=
ring_setoid
cring_eq_ext
cring_almost_ring_theory
- Z 0%Z 1%Z Zplus Zmult Zminus Zopp Zeq_bool
+ Z 0%Z 1%Z Z.add Z.mul Z.sub Z.opp Zeq_bool
Ncring_initial.gen_phiZ
cring_morph
N
@@ -169,7 +168,7 @@ Ltac cring_simplify_aux lterm fv lexpr hyp :=
Z.quotrem
cring_div_theory
get_signZ get_signZ_th
- O nil fv I nil (refl_equal nil) );
+ O nil fv I nil (eq_refl nil) );
intro eq3; apply eq3; reflexivity|
match hyp with
| 1%nat => rewrite eq2
diff --git a/plugins/setoid_ring/Field.v b/plugins/setoid_ring/Field.v
index 90f2f497..6d454ba8 100644
--- a/plugins/setoid_ring/Field.v
+++ b/plugins/setoid_ring/Field.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/setoid_ring/Field_tac.v b/plugins/setoid_ring/Field_tac.v
index da42bbd9..8ac952c0 100644
--- a/plugins/setoid_ring/Field_tac.v
+++ b/plugins/setoid_ring/Field_tac.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -447,7 +447,7 @@ Ltac prove_field_eqn ope FLD fv expr :=
pose (res' := res);
let lemma := get_L1 FLD in
let lemma :=
- constr:(lemma O fv List.nil expr' res' I List.nil (refl_equal _)) in
+ constr:(lemma O fv List.nil expr' res' I List.nil (eq_refl _)) in
let ty := type of lemma in
let lhs := match ty with
forall _, ?lhs=_ -> _ => lhs
@@ -487,7 +487,7 @@ Ltac reduce_field_expr ope kont FLD fv expr :=
kont c.
(* Hack to let a Ltac return a term in the context of a primitive tactic *)
-Ltac return_term x := generalize (refl_equal x).
+Ltac return_term x := generalize (eq_refl x).
Ltac get_term :=
match goal with
| |- ?x = _ -> _ => x
diff --git a/plugins/setoid_ring/Field_theory.v b/plugins/setoid_ring/Field_theory.v
index 40138526..bc05c252 100644
--- a/plugins/setoid_ring/Field_theory.v
+++ b/plugins/setoid_ring/Field_theory.v
@@ -1,13 +1,13 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
Require Ring.
-Import Ring_polynom Ring_tac Ring_theory InitialRing Setoid List.
+Import Ring_polynom Ring_tac Ring_theory InitialRing Setoid List Morphisms.
Require Import ZArith_base.
(*Require Import Omega.*)
Set Implicit Arguments.
@@ -27,7 +27,7 @@ Section MakeFieldPol.
Notation "x == y" := (req x y) (at level 70, no associativity).
(* Equality properties *)
- Variable Rsth : Setoid_Theory R req.
+ Variable Rsth : Equivalence req.
Variable Reqe : ring_eq_ext radd rmul ropp req.
Variable SRinv_ext : forall p q, p == q -> / p == / q.
@@ -75,7 +75,6 @@ Qed.
(* Useful tactics *)
- Add Setoid R req Rsth as R_set1.
Add Morphism radd : radd_ext. exact (Radd_ext Reqe). Qed.
Add Morphism rmul : rmul_ext. exact (Rmul_ext Reqe). Qed.
Add Morphism ropp : ropp_ext. exact (Ropp_ext Reqe). Qed.
@@ -116,16 +115,17 @@ Notation NPphi_pow := (Pphi_pow rO rI radd rmul rsub ropp cO cI ceqb phi Cp_phi
(* add abstract semi-ring to help with some proofs *)
Add Ring Rring : (ARth_SRth ARth).
+Local Hint Extern 2 (_ == _) => f_equiv.
(* additional ring properties *)
Lemma rsub_0_l : forall r, 0 - r == - r.
-intros; rewrite (ARsub_def ARth) in |- *;ring.
+intros; rewrite (ARsub_def ARth);ring.
Qed.
Lemma rsub_0_r : forall r, r - 0 == r.
-intros; rewrite (ARsub_def ARth) in |- *.
-rewrite (ARopp_zero Rsth Reqe ARth) in |- *; ring.
+intros; rewrite (ARsub_def ARth).
+rewrite (ARopp_zero Rsth Reqe ARth); ring.
Qed.
(***************************************************************************
@@ -135,42 +135,40 @@ Qed.
***************************************************************************)
Theorem rdiv_simpl: forall p q, ~ q == 0 -> q * (p / q) == p.
+Proof.
intros p q H.
-rewrite rdiv_def in |- *.
+rewrite rdiv_def.
transitivity (/ q * q * p); [ ring | idtac ].
-rewrite rinv_l in |- *; auto.
+rewrite rinv_l; auto.
Qed.
Hint Resolve rdiv_simpl .
-Theorem SRdiv_ext:
- forall p1 p2, p1 == p2 -> forall q1 q2, q1 == q2 -> p1 / q1 == p2 / q2.
-intros p1 p2 H q1 q2 H0.
+Instance SRdiv_ext: Proper (req ==> req ==> req) rdiv.
+Proof.
+intros p1 p2 Ep q1 q2 Eq.
transitivity (p1 * / q1); auto.
transitivity (p2 * / q2); auto.
Qed.
-Hint Resolve SRdiv_ext .
-
- Add Morphism rdiv : rdiv_ext. exact SRdiv_ext. Qed.
+Hint Resolve SRdiv_ext.
Lemma rmul_reg_l : forall p q1 q2,
~ p == 0 -> p * q1 == p * q2 -> q1 == q2.
-intros.
-rewrite <- (@rdiv_simpl q1 p) in |- *; trivial.
-rewrite <- (@rdiv_simpl q2 p) in |- *; trivial.
-repeat rewrite rdiv_def in |- *.
-repeat rewrite (ARmul_assoc ARth) in |- *.
-auto.
+Proof.
+intros p q1 q2 H EQ.
+rewrite <- (@rdiv_simpl q1 p) by trivial.
+rewrite <- (@rdiv_simpl q2 p) by trivial.
+rewrite !rdiv_def, !(ARmul_assoc ARth).
+now rewrite EQ.
Qed.
Theorem field_is_integral_domain : forall r1 r2,
~ r1 == 0 -> ~ r2 == 0 -> ~ r1 * r2 == 0.
Proof.
-red in |- *; intros.
-apply H0.
+intros r1 r2 H1 H2. contradict H2.
transitivity (1 * r2); auto.
transitivity (/ r1 * r1 * r2); auto.
-rewrite <- (ARmul_assoc ARth) in |- *.
-rewrite H1 in |- *.
+rewrite <- (ARmul_assoc ARth).
+rewrite H2.
apply ARmul_0_r with (1 := Rsth) (2 := ARth).
Qed.
@@ -179,15 +177,15 @@ Theorem ropp_neq_0 : forall r,
intros.
setoid_replace (- r) with (- (1) * r).
apply field_is_integral_domain; trivial.
- rewrite <- (ARopp_mul_l ARth) in |- *.
- rewrite (ARmul_1_l ARth) in |- *.
+ rewrite <- (ARopp_mul_l ARth).
+ rewrite (ARmul_1_l ARth).
reflexivity.
Qed.
Theorem rdiv_r_r : forall r, ~ r == 0 -> r / r == 1.
intros.
-rewrite (AFdiv_def AFth) in |- *.
-rewrite (ARmul_comm ARth) in |- *.
+rewrite (AFdiv_def AFth).
+rewrite (ARmul_comm ARth).
apply (AFinv_l AFth).
trivial.
Qed.
@@ -203,14 +201,14 @@ Theorem rdiv2:
r1 / r2 + r3 / r4 == (r1 * r4 + r3 * r2) / (r2 * r4).
Proof.
intros r1 r2 r3 r4 H H0.
-assert (~ r2 * r4 == 0) by complete (apply field_is_integral_domain; trivial).
+assert (~ r2 * r4 == 0) by (apply field_is_integral_domain; trivial).
apply rmul_reg_l with (r2 * r4); trivial.
-rewrite rdiv_simpl in |- *; trivial.
-rewrite (ARdistr_r Rsth Reqe ARth) in |- *.
+rewrite rdiv_simpl; trivial.
+rewrite (ARdistr_r Rsth Reqe ARth).
apply (Radd_ext Reqe).
- transitivity (r2 * (r1 / r2) * r4); [ ring | auto ].
- transitivity (r2 * (r4 * (r3 / r4))); auto.
- transitivity (r2 * r3); auto.
+- transitivity (r2 * (r1 / r2) * r4); [ ring | auto ].
+- transitivity (r2 * (r4 * (r3 / r4))); auto.
+ transitivity (r2 * r3); auto.
Qed.
@@ -225,35 +223,36 @@ assert (HH1: ~ r2 == 0) by (intros HH; case H; rewrite HH; ring).
assert (HH2: ~ r5 == 0) by (intros HH; case H; rewrite HH; ring).
assert (HH3: ~ r4 == 0) by (intros HH; case H0; rewrite HH; ring).
assert (HH4: ~ r2 * (r4 * r5) == 0)
- by complete (repeat apply field_is_integral_domain; trivial).
+ by (repeat apply field_is_integral_domain; trivial).
apply rmul_reg_l with (r2 * (r4 * r5)); trivial.
-rewrite rdiv_simpl in |- *; trivial.
-rewrite (ARdistr_r Rsth Reqe ARth) in |- *.
+rewrite rdiv_simpl; trivial.
+rewrite (ARdistr_r Rsth Reqe ARth).
apply (Radd_ext Reqe).
transitivity ((r2 * r5) * (r1 / (r2 * r5)) * r4); [ ring | auto ].
transitivity ((r4 * r5) * (r3 / (r4 * r5)) * r2); [ ring | auto ].
Qed.
Theorem rdiv5: forall r1 r2, - (r1 / r2) == - r1 / r2.
+Proof.
intros r1 r2.
transitivity (- (r1 * / r2)); auto.
transitivity (- r1 * / r2); auto.
Qed.
Hint Resolve rdiv5 .
-Theorem rdiv3:
- forall r1 r2 r3 r4,
+Theorem rdiv3 r1 r2 r3 r4 :
~ r2 == 0 ->
~ r4 == 0 ->
r1 / r2 - r3 / r4 == (r1 * r4 - r3 * r2) / (r2 * r4).
-intros r1 r2 r3 r4 H H0.
+Proof.
+intros H2 H4.
assert (~ r2 * r4 == 0) by (apply field_is_integral_domain; trivial).
transitivity (r1 / r2 + - (r3 / r4)); auto.
transitivity (r1 / r2 + - r3 / r4); auto.
-transitivity ((r1 * r4 + - r3 * r2) / (r2 * r4)); auto.
+transitivity ((r1 * r4 + - r3 * r2) / (r2 * r4)).
apply rdiv2; auto.
-apply SRdiv_ext; auto.
-transitivity (r1 * r4 + - (r3 * r2)); symmetry; auto.
+f_equiv.
+transitivity (r1 * r4 + - (r3 * r2)); auto.
Qed.
@@ -279,13 +278,13 @@ intros r1 r2 H H0.
assert (~ r1 / r2 == 0) as Hk.
intros H1; case H.
transitivity (r2 * (r1 / r2)); auto.
- rewrite H1 in |- *; ring.
+ rewrite H1; ring.
apply rmul_reg_l with (r1 / r2); auto.
transitivity (/ (r1 / r2) * (r1 / r2)); auto.
transitivity 1; auto.
- repeat rewrite rdiv_def in |- *.
+ repeat rewrite rdiv_def.
transitivity (/ r1 * r1 * (/ r2 * r2)); [ idtac | ring ].
- repeat rewrite rinv_l in |- *; auto.
+ repeat rewrite rinv_l; auto.
Qed.
Hint Resolve rdiv6 .
@@ -296,11 +295,11 @@ Hint Resolve rdiv6 .
(r1 / r2) * (r3 / r4) == (r1 * r3) / (r2 * r4).
Proof.
intros r1 r2 r3 r4 H H0.
-assert (~ r2 * r4 == 0) by complete (apply field_is_integral_domain; trivial).
+assert (~ r2 * r4 == 0) by (apply field_is_integral_domain; trivial).
apply rmul_reg_l with (r2 * r4); trivial.
-rewrite rdiv_simpl in |- *; trivial.
+rewrite rdiv_simpl; trivial.
transitivity (r2 * (r1 / r2) * (r4 * (r3 / r4))); [ ring | idtac ].
-repeat rewrite rdiv_simpl in |- *; trivial.
+repeat rewrite rdiv_simpl; trivial.
Qed.
Theorem rdiv4b:
@@ -334,8 +333,8 @@ Theorem rdiv7:
(r1 / r2) / (r3 / r4) == (r1 * r4) / (r2 * r3).
Proof.
intros.
-rewrite (rdiv_def (r1 / r2)) in |- *.
-rewrite rdiv6 in |- *; trivial.
+rewrite (rdiv_def (r1 / r2)).
+rewrite rdiv6; trivial.
apply rdiv4; trivial.
Qed.
@@ -373,14 +372,14 @@ Theorem cross_product_eq : forall r1 r2 r3 r4,
~ r2 == 0 -> ~ r4 == 0 -> r1 * r4 == r3 * r2 -> r1 / r2 == r3 / r4.
intros.
transitivity (r1 / r2 * (r4 / r4)).
- rewrite rdiv_r_r in |- *; trivial.
- symmetry in |- *.
+ rewrite rdiv_r_r; trivial.
+ symmetry .
apply (ARmul_1_r Rsth ARth).
- rewrite rdiv4 in |- *; trivial.
- rewrite H1 in |- *.
- rewrite (ARmul_comm ARth r2 r4) in |- *.
- rewrite <- rdiv4 in |- *; trivial.
- rewrite rdiv_r_r in |- * by trivial.
+ rewrite rdiv4; trivial.
+ rewrite H1.
+ rewrite (ARmul_comm ARth r2 r4).
+ rewrite <- rdiv4; trivial.
+ rewrite rdiv_r_r by trivial.
apply (ARmul_1_r Rsth ARth).
Qed.
@@ -410,14 +409,7 @@ Qed.
Add Morphism (pow_N rI rmul) with signature req ==> eq ==> req as pow_N_morph.
intros x y H [|p];simpl;auto. apply pow_morph;trivial.
Qed.
-(*
-Lemma rpow_morph : forall x y n, x == y ->rpow x (Cp_phi n) == rpow y (Cp_phi n).
-Proof.
- intros; repeat rewrite pow_th.(rpow_pow_N).
- destruct n;simpl. apply eq_refl.
- induction p;simpl;try rewrite IHp;try rewrite H; apply eq_refl.
-Qed.
-*)
+
Theorem PExpr_eq_semi_correct:
forall l e1 e2, PExpr_eq e1 e2 = true -> NPEeval l e1 == NPEeval l e2.
intros l e1; elim e1.
@@ -459,8 +451,8 @@ Theorem NPEadd_correct:
forall l e1 e2, NPEeval l (NPEadd e1 e2) == NPEeval l (PEadd e1 e2).
Proof.
intros l e1 e2.
-destruct e1; destruct e2; simpl in |- *; try reflexivity; try apply ceqb_rect;
- try (intro eq_c; rewrite eq_c in |- *); simpl in |- *;try apply eq_refl;
+destruct e1; destruct e2; simpl; try reflexivity; try apply ceqb_rect;
+ try (intro eq_c; rewrite eq_c); simpl;try apply eq_refl;
try (ring [(morph0 CRmorph)]).
apply (morph_add CRmorph).
Qed.
@@ -511,9 +503,9 @@ Qed.
Theorem NPEmul_correct : forall l e1 e2,
NPEeval l (NPEmul e1 e2) == NPEeval l (PEmul e1 e2).
-induction e1;destruct e2; simpl in |- *;try reflexivity;
+induction e1;destruct e2; simpl;try reflexivity;
repeat apply ceqb_rect;
- try (intro eq_c; rewrite eq_c in |- *); simpl in |- *; try reflexivity;
+ try (intro eq_c; rewrite eq_c); simpl; try reflexivity;
try ring [(morph0 CRmorph) (morph1 CRmorph)].
apply (morph_mul CRmorph).
case N.eqb_spec; intros H; try rewrite <- H; clear H.
@@ -537,9 +529,9 @@ Definition NPEsub e1 e2 :=
Theorem NPEsub_correct:
forall l e1 e2, NPEeval l (NPEsub e1 e2) == NPEeval l (PEsub e1 e2).
intros l e1 e2.
-destruct e1; destruct e2; simpl in |- *; try reflexivity; try apply ceqb_rect;
- try (intro eq_c; rewrite eq_c in |- *); simpl in |- *;
- try rewrite (morph0 CRmorph) in |- *; try reflexivity;
+destruct e1; destruct e2; simpl; try reflexivity; try apply ceqb_rect;
+ try (intro eq_c; rewrite eq_c); simpl;
+ try rewrite (morph0 CRmorph); try reflexivity;
try (symmetry; apply rsub_0_l); try (symmetry; apply rsub_0_r).
apply (morph_sub CRmorph).
Qed.
@@ -659,8 +651,8 @@ destruct H; trivial.
Qed.
Theorem PCond_app_inv_l: forall l l1 l2, PCond l (l1 ++ l2) -> PCond l l1.
-intros l l1 l2; elim l1; simpl app in |- *.
- simpl in |- *; auto.
+intros l l1 l2; elim l1; simpl app.
+ simpl; auto.
destruct l0; simpl in *.
destruct l2; firstorder.
firstorder.
@@ -675,8 +667,8 @@ Qed.
Definition absurd_PCond := cons (PEc cO) nil.
Lemma absurd_PCond_bottom : forall l, ~ PCond l absurd_PCond.
-unfold absurd_PCond in |- *; simpl in |- *.
-red in |- *; intros.
+unfold absurd_PCond; simpl.
+red; intros.
apply H.
apply (morph0 CRmorph).
Qed.
@@ -705,10 +697,10 @@ Fixpoint isIn (e1:PExpr C) (p1:positive)
end
end
| PEpow e3 N0 => None
- | PEpow e3 (Npos p3) => isIn e1 p1 e3 (Pmult p3 p2)
+ | PEpow e3 (Npos p3) => isIn e1 p1 e3 (Pos.mul p3 p2)
| _ =>
if PExpr_eq e1 e2 then
- match Zminus (Zpos p1) (Zpos p2) with
+ match Z.pos_sub p1 p2 with
| Zpos p => Some (Npos p, PEc cI)
| Z0 => Some (N0, PEc cI)
| Zneg p => Some (N0, NPEpow e2 (Npos p))
@@ -719,21 +711,19 @@ Fixpoint isIn (e1:PExpr C) (p1:positive)
Definition ZtoN z := match z with Zpos p => Npos p | _ => N0 end.
Definition NtoZ n := match n with Npos p => Zpos p | _ => Z0 end.
- Notation pow_pos_plus := (Ring_theory.pow_pos_Pplus _ Rsth Reqe.(Rmul_ext)
- ARth.(ARmul_comm) ARth.(ARmul_assoc)).
+ Notation pow_pos_add :=
+ (Ring_theory.pow_pos_add Rsth Reqe.(Rmul_ext) ARth.(ARmul_assoc)).
- Lemma Z_pos_sub_gt : forall p q, (p > q)%positive ->
+ Lemma Z_pos_sub_gt p q : (p > q)%positive ->
Z.pos_sub p q = Zpos (p - q).
- Proof.
- intros. apply Z.pos_sub_gt. now apply Pos.gt_lt.
- Qed.
+ Proof. intros; now apply Z.pos_sub_gt, Pos.gt_lt. Qed.
Ltac simpl_pos_sub := rewrite ?Z_pos_sub_gt in * by assumption.
Lemma isIn_correct_aux : forall l e1 e2 p1 p2,
match
(if PExpr_eq e1 e2 then
- match Zminus (Zpos p1) (Zpos p2) with
+ match Z.sub (Zpos p1) (Zpos p2) with
| Zpos p => Some (Npos p, PEc cI)
| Z0 => Some (N0, PEc cI)
| Zneg p => Some (N0, NPEpow e2 (Npos p))
@@ -750,33 +740,28 @@ Proof.
intros l e1 e2 p1 p2; generalize (PExpr_eq_semi_correct l e1 e2);
case (PExpr_eq e1 e2); simpl; auto; intros H.
rewrite Z.pos_sub_spec.
- case_eq ((p1 ?= p2)%positive);intros;simpl.
- repeat rewrite pow_th.(rpow_pow_N);simpl. split. 2:refine (refl_equal _).
- rewrite (Pcompare_Eq_eq _ _ H0).
- rewrite H by trivial. ring [ (morph1 CRmorph)].
- fold (p2 - p1 =? 1)%positive.
- fold (NPEpow e2 (Npos (p2 - p1))).
- rewrite NPEpow_correct;simpl.
- repeat rewrite pow_th.(rpow_pow_N);simpl.
- rewrite H;trivial. split. 2:refine (refl_equal _).
- rewrite <- pow_pos_plus; rewrite Pplus_minus;auto. apply ZC2;trivial.
- repeat rewrite pow_th.(rpow_pow_N);simpl.
- rewrite H;trivial.
- change (Z.pos_sub p1 (p1-p2)) with (Zpos p1 - Zpos (p1 -p2))%Z.
- replace (Zpos (p1 - p2)) with (Zpos p1 - Zpos p2)%Z.
- split.
- repeat rewrite Zth.(Rsub_def). rewrite (Ring_theory.Ropp_add Zsth Zeqe Zth).
- rewrite Zplus_assoc, Z.add_opp_diag_r. simpl.
- ring [ (morph1 CRmorph)].
- assert (Zpos p1 > 0 /\ Zpos p2 > 0)%Z. split;refine (refl_equal _).
- apply Zplus_gt_reg_l with (Zpos p2).
- rewrite Zplus_minus. change (Zpos p2 + Zpos p1 > 0 + Zpos p1)%Z.
- apply Zplus_gt_compat_r. refine (refl_equal _).
- simpl. now simpl_pos_sub.
+ case Pos.compare_spec;intros;simpl.
+ - repeat rewrite pow_th.(rpow_pow_N);simpl. split. 2:reflexivity.
+ subst. rewrite H by trivial. ring [ (morph1 CRmorph)].
+ - fold (p2 - p1 =? 1)%positive.
+ fold (NPEpow e2 (Npos (p2 - p1))).
+ rewrite NPEpow_correct;simpl.
+ repeat rewrite pow_th.(rpow_pow_N);simpl.
+ rewrite H;trivial. split. 2:reflexivity.
+ rewrite <- pow_pos_add. now rewrite Pos.add_comm, Pos.sub_add.
+ - repeat rewrite pow_th.(rpow_pow_N);simpl.
+ rewrite H;trivial.
+ rewrite Z.pos_sub_gt by now apply Pos.sub_decr.
+ replace (p1 - (p1 - p2))%positive with p2;
+ [| rewrite Pos.sub_sub_distr, Pos.add_comm;
+ auto using Pos.add_sub, Pos.sub_decr ].
+ split.
+ simpl. ring [ (morph1 CRmorph)].
+ now apply Z.lt_gt, Pos.sub_decr.
Qed.
Lemma pow_pos_pow_pos : forall x p1 p2, pow_pos rmul (pow_pos rmul x p1) p2 == pow_pos rmul x (p1*p2).
-induction p1;simpl;intros;repeat rewrite pow_pos_mul;repeat rewrite pow_pos_plus;simpl.
+induction p1;simpl;intros;repeat rewrite pow_pos_mul;repeat rewrite pow_pos_add;simpl.
ring [(IHp1 p2)]. ring [(IHp1 p2)]. auto.
Qed.
@@ -808,8 +793,9 @@ destruct n.
(pow_pos rmul (NPEeval l e1) p4 * NPEeval l p5) ==
pow_pos rmul (NPEeval l e1) p4 * pow_pos rmul (NPEeval l e1) (p1 - p4) *
NPEeval l p3 *NPEeval l p5) by ring. rewrite H;clear H.
- rewrite <- pow_pos_plus. rewrite Pplus_minus.
- split. symmetry;apply ARth.(ARmul_assoc). refine (refl_equal _). trivial.
+ rewrite <- pow_pos_add.
+ rewrite Pos.add_comm, Pos.sub_add by (now apply Z.gt_lt in H4).
+ split. symmetry;apply ARth.(ARmul_assoc). reflexivity.
repeat rewrite pow_th.(rpow_pow_N);simpl.
intros (H1,H2) (H3,H4).
simpl_pos_sub. simpl in H1, H3.
@@ -822,15 +808,15 @@ destruct n.
(pow_pos rmul (NPEeval l e1) (p4 - p6) * NPEeval l p5) ==
pow_pos rmul (NPEeval l e1) (p1 - p4) * pow_pos rmul (NPEeval l e1) (p4 - p6) *
NPEeval l p3 * NPEeval l p5) by ring. rewrite H0;clear H0.
- rewrite <- pow_pos_plus.
+ rewrite <- pow_pos_add.
replace (p1 - p4 + (p4 - p6))%positive with (p1 - p6)%positive.
rewrite NPEmul_correct. simpl;ring.
assert
(Zpos p1 - Zpos p6 = Zpos p1 - Zpos p4 + (Zpos p4 - Zpos p6))%Z.
change ((Zpos p1 - Zpos p6)%Z = (Zpos p1 + (- Zpos p4) + (Zpos p4 +(- Zpos p6)))%Z).
- rewrite <- Zplus_assoc. rewrite (Zplus_assoc (- Zpos p4)).
+ rewrite <- Z.add_assoc. rewrite (Z.add_assoc (- Zpos p4)).
simpl. rewrite Z.pos_sub_diag. simpl. reflexivity.
- unfold Zminus, Zopp in H0. simpl in H0.
+ unfold Z.sub, Z.opp in H0. simpl in H0.
simpl_pos_sub. inversion H0; trivial.
simpl. repeat rewrite pow_th.(rpow_pow_N).
intros H1 (H2,H3). simpl_pos_sub.
@@ -875,7 +861,7 @@ Fixpoint split_aux (e1: PExpr C) (p:positive) (e2:PExpr C) {struct e1}: rsplit :
(NPEmul (common r1) (common r2))
(right r2)
| PEpow e3 N0 => mk_rsplit (PEc cI) (PEc cI) e2
- | PEpow e3 (Npos p3) => split_aux e3 (Pmult p3 p) e2
+ | PEpow e3 (Npos p3) => split_aux e3 (Pos.mul p3 p) e2
| _ =>
match isIn e1 p e2 xH with
| Some (N0,e3) => mk_rsplit (PEc cI) (NPEpow e1 (Npos p)) e3
@@ -903,7 +889,8 @@ Proof.
repeat rewrite pow_th.(rpow_pow_N);simpl).
intros (H, Hgt);split;try ring [H CRmorph.(morph1)].
intros (H, Hgt). simpl_pos_sub. simpl in H;split;try ring [H].
- rewrite <- pow_pos_plus. rewrite Pplus_minus. reflexivity. trivial.
+ apply Z.gt_lt in Hgt.
+ now rewrite <- pow_pos_add, Pos.add_comm, Pos.sub_add.
simpl;intros. repeat rewrite NPEmul_correct;simpl.
rewrite NPEpow_correct;simpl. split;ring [CRmorph.(morph1)].
Qed.
@@ -1025,13 +1012,13 @@ Theorem Pcond_Fnorm:
forall l e,
PCond l (condition (Fnorm e)) -> ~ NPEeval l (denum (Fnorm e)) == 0.
intros l e; elim e.
- simpl in |- *; intros _ _; rewrite (morph1 CRmorph) in |- *; exact rI_neq_rO.
- simpl in |- *; intros _ _; rewrite (morph1 CRmorph) in |- *; exact rI_neq_rO.
+ simpl; intros _ _; rewrite (morph1 CRmorph); exact rI_neq_rO.
+ simpl; intros _ _; rewrite (morph1 CRmorph); exact rI_neq_rO.
intros e1 Hrec1 e2 Hrec2 Hcond.
simpl condition in Hcond.
- simpl denum in |- *.
- rewrite NPEmul_correct in |- *.
- simpl in |- *.
+ simpl denum.
+ rewrite NPEmul_correct.
+ simpl.
apply field_is_integral_domain.
intros HH; case Hrec1; auto.
apply PCond_app_inv_l with (1 := Hcond).
@@ -1042,9 +1029,9 @@ intros l e; elim e.
rewrite (split_correct_r l (denum (Fnorm e1)) (denum (Fnorm e2))); auto.
intros e1 Hrec1 e2 Hrec2 Hcond.
simpl condition in Hcond.
- simpl denum in |- *.
- rewrite NPEmul_correct in |- *.
- simpl in |- *.
+ simpl denum.
+ rewrite NPEmul_correct.
+ simpl.
apply field_is_integral_domain.
intros HH; case Hrec1; auto.
apply PCond_app_inv_l with (1 := Hcond).
@@ -1055,9 +1042,9 @@ intros l e; elim e.
rewrite (split_correct_r l (denum (Fnorm e1)) (denum (Fnorm e2))); auto.
intros e1 Hrec1 e2 Hrec2 Hcond.
simpl condition in Hcond.
- simpl denum in |- *.
- rewrite NPEmul_correct in |- *.
- simpl in |- *.
+ simpl denum.
+ rewrite NPEmul_correct.
+ simpl.
apply field_is_integral_domain.
intros HH; apply Hrec1.
apply PCond_app_inv_l with (1 := Hcond).
@@ -1069,17 +1056,17 @@ intros l e; elim e.
rewrite NPEmul_correct; simpl; rewrite HH; ring.
intros e1 Hrec1 Hcond.
simpl condition in Hcond.
- simpl denum in |- *.
+ simpl denum.
auto.
intros e1 Hrec1 Hcond.
simpl condition in Hcond.
- simpl denum in |- *.
+ simpl denum.
apply PCond_cons_inv_l with (1:=Hcond).
intros e1 Hrec1 e2 Hrec2 Hcond.
simpl condition in Hcond.
- simpl denum in |- *.
- rewrite NPEmul_correct in |- *.
- simpl in |- *.
+ simpl denum.
+ rewrite NPEmul_correct.
+ simpl.
apply field_is_integral_domain.
intros HH; apply Hrec1.
specialize PCond_cons_inv_r with (1:=Hcond); intro Hcond1.
@@ -1222,9 +1209,9 @@ Theorem Fnorm_crossproduct:
PCond l (condition nfe1 ++ condition nfe2) ->
FEeval l fe1 == FEeval l fe2.
intros l fe1 fe2 nfe1 nfe2 Hcrossprod Hcond; subst nfe1 nfe2.
-rewrite Fnorm_FEeval_PEeval in |- * by
+rewrite Fnorm_FEeval_PEeval by
apply PCond_app_inv_l with (1 := Hcond).
- rewrite Fnorm_FEeval_PEeval in |- * by
+ rewrite Fnorm_FEeval_PEeval by
apply PCond_app_inv_r with (1 := Hcond).
apply cross_product_eq; trivial.
apply Pcond_Fnorm.
@@ -1319,9 +1306,9 @@ apply Fnorm_crossproduct; trivial.
match goal with
[ |- NPEeval l ?x == NPEeval l ?y] =>
rewrite (ring_rw_correct Rsth Reqe ARth CRmorph pow_th cdiv_th get_sign_spec
- O nil l I (refl_equal nil) x (refl_equal (Nnorm O nil x)));
+ O nil l I Logic.eq_refl x Logic.eq_refl);
rewrite (ring_rw_correct Rsth Reqe ARth CRmorph pow_th cdiv_th get_sign_spec
- O nil l I (refl_equal nil) y (refl_equal (Nnorm O nil y)))
+ O nil l I Logic.eq_refl y Logic.eq_refl)
end.
trivial.
Qed.
@@ -1341,28 +1328,28 @@ Proof.
intros n l lpe fe1 fe2 Hlpe lmp Hlmp nfe1 eq1 nfe2 eq2 den eq3 Hcrossprod Hcond;
subst nfe1 nfe2 den lmp.
apply Fnorm_crossproduct; trivial.
-simpl in |- *.
-rewrite (split_correct_l l (denum (Fnorm fe1)) (denum (Fnorm fe2))) in |- *.
-rewrite (split_correct_r l (denum (Fnorm fe1)) (denum (Fnorm fe2))) in |- *.
-rewrite NPEmul_correct in |- *.
-rewrite NPEmul_correct in |- *.
-simpl in |- *.
-repeat rewrite (ARmul_assoc ARth) in |- *.
+simpl.
+rewrite (split_correct_l l (denum (Fnorm fe1)) (denum (Fnorm fe2))).
+rewrite (split_correct_r l (denum (Fnorm fe1)) (denum (Fnorm fe2))).
+rewrite NPEmul_correct.
+rewrite NPEmul_correct.
+simpl.
+repeat rewrite (ARmul_assoc ARth).
rewrite <-(
let x := PEmul (num (Fnorm fe1))
(rsplit_right (split (denum (Fnorm fe1)) (denum (Fnorm fe2)))) in
ring_rw_correct Rsth Reqe ARth CRmorph pow_th cdiv_th get_sign_spec n lpe l
- Hlpe (refl_equal (Nmk_monpol_list lpe))
- x (refl_equal (Nnorm n (Nmk_monpol_list lpe) x))) in Hcrossprod.
+ Hlpe Logic.eq_refl
+ x Logic.eq_refl) in Hcrossprod.
rewrite <-(
let x := (PEmul (num (Fnorm fe2))
(rsplit_left
(split (denum (Fnorm fe1)) (denum (Fnorm fe2))))) in
ring_rw_correct Rsth Reqe ARth CRmorph pow_th cdiv_th get_sign_spec n lpe l
- Hlpe (refl_equal (Nmk_monpol_list lpe))
- x (refl_equal (Nnorm n (Nmk_monpol_list lpe) x))) in Hcrossprod.
+ Hlpe Logic.eq_refl
+ x Logic.eq_refl) in Hcrossprod.
simpl in Hcrossprod.
-rewrite Hcrossprod in |- *.
+rewrite Hcrossprod.
reflexivity.
Qed.
@@ -1381,28 +1368,28 @@ Proof.
intros n l lpe fe1 fe2 Hlpe lmp Hlmp nfe1 eq1 nfe2 eq2 den eq3 Hcrossprod Hcond;
subst nfe1 nfe2 den lmp.
apply Fnorm_crossproduct; trivial.
-simpl in |- *.
-rewrite (split_correct_l l (denum (Fnorm fe1)) (denum (Fnorm fe2))) in |- *.
-rewrite (split_correct_r l (denum (Fnorm fe1)) (denum (Fnorm fe2))) in |- *.
-rewrite NPEmul_correct in |- *.
-rewrite NPEmul_correct in |- *.
-simpl in |- *.
-repeat rewrite (ARmul_assoc ARth) in |- *.
+simpl.
+rewrite (split_correct_l l (denum (Fnorm fe1)) (denum (Fnorm fe2))).
+rewrite (split_correct_r l (denum (Fnorm fe1)) (denum (Fnorm fe2))).
+rewrite NPEmul_correct.
+rewrite NPEmul_correct.
+simpl.
+repeat rewrite (ARmul_assoc ARth).
rewrite <-(
let x := PEmul (num (Fnorm fe1))
(rsplit_right (split (denum (Fnorm fe1)) (denum (Fnorm fe2)))) in
ring_rw_pow_correct Rsth Reqe ARth CRmorph pow_th cdiv_th get_sign_spec n lpe l
- Hlpe (refl_equal (Nmk_monpol_list lpe))
- x (refl_equal (Nnorm n (Nmk_monpol_list lpe) x))) in Hcrossprod.
+ Hlpe Logic.eq_refl
+ x Logic.eq_refl) in Hcrossprod.
rewrite <-(
let x := (PEmul (num (Fnorm fe2))
(rsplit_left
(split (denum (Fnorm fe1)) (denum (Fnorm fe2))))) in
ring_rw_pow_correct Rsth Reqe ARth CRmorph pow_th cdiv_th get_sign_spec n lpe l
- Hlpe (refl_equal (Nmk_monpol_list lpe))
- x (refl_equal (Nnorm n (Nmk_monpol_list lpe) x))) in Hcrossprod.
+ Hlpe Logic.eq_refl
+ x Logic.eq_refl) in Hcrossprod.
simpl in Hcrossprod.
-rewrite Hcrossprod in |- *.
+rewrite Hcrossprod.
reflexivity.
Qed.
@@ -1522,7 +1509,7 @@ Fixpoint Fapp (l m:list (PExpr C)) {struct l} : list (PExpr C) :=
Lemma fcons_correct : forall l l1,
PCond l (Fapp l1 nil) -> PCond l l1.
-induction l1; simpl in |- *; intros.
+induction l1; simpl; intros.
trivial.
elim PCond_fcons_inv with (1 := H); intros.
destruct l1; auto.
@@ -1603,7 +1590,7 @@ intros l a; elim a; try (intros; apply PFcons0_fcons_inv; auto; fail).
simpl in H1.
case (H _ H1); intros H2 H3.
case (H0 _ H3); intros H4 H5; split; auto.
- simpl in |- *.
+ simpl.
apply field_is_integral_domain; trivial.
simpl;intros. rewrite pow_th.(rpow_pow_N).
destruct (H _ H0);split;auto.
@@ -1631,7 +1618,7 @@ generalize (fun h => X (morph_eq CRmorph c1 c2 h)).
generalize (@ceqb_complete c1 c2).
case (c1 ?=! c2); auto; intros.
apply X0.
-red in |- *; intro.
+red; intro.
absurd (false = true); auto; discriminate.
Qed.
@@ -1647,18 +1634,18 @@ Fixpoint Fcons1 (e:PExpr C) (l:list (PExpr C)) {struct e} : list (PExpr C) :=
Theorem PFcons1_fcons_inv:
forall l a l1, PCond l (Fcons1 a l1) -> ~ NPEeval l a == 0 /\ PCond l l1.
intros l a; elim a; try (intros; apply PFcons0_fcons_inv; auto; fail).
- simpl in |- *; intros c l1.
+ simpl; intros c l1.
apply ceqb_rect_complete; intros.
elim (@absurd_PCond_bottom l H0).
split; trivial.
- rewrite <- (morph0 CRmorph) in |- *; trivial.
+ rewrite <- (morph0 CRmorph); trivial.
intros p H p0 H0 l1 H1.
simpl in H1.
case (H _ H1); intros H2 H3.
case (H0 _ H3); intros H4 H5; split; auto.
- simpl in |- *.
+ simpl.
apply field_is_integral_domain; trivial.
- simpl in |- *; intros p H l1.
+ simpl; intros p H l1.
apply ceqb_rect_complete; intros.
elim (@absurd_PCond_bottom l H1).
destruct (H _ H1).
@@ -1677,7 +1664,7 @@ Definition Fcons2 e l := Fcons1 (PExpr_simp e) l.
Theorem PFcons2_fcons_inv:
forall l a l1, PCond l (Fcons2 a l1) -> ~ NPEeval l a == 0 /\ PCond l l1.
-unfold Fcons2 in |- *; intros l a l1 H; split;
+unfold Fcons2; intros l a l1 H; split;
case (PFcons1_fcons_inv l (PExpr_simp a) l1); auto.
intros H1 H2 H3; case H1.
transitivity (NPEeval l a); trivial.
@@ -1756,50 +1743,48 @@ Hypothesis gen_phiPOS_not_0 : forall p, ~ gen_phiPOS1 rI radd rmul p == 0.
Lemma add_inj_r : forall p x y,
gen_phiPOS1 rI radd rmul p + x == gen_phiPOS1 rI radd rmul p + y -> x==y.
intros p x y.
-elim p using Pind; simpl in |- *; intros.
+elim p using Pos.peano_ind; simpl; intros.
apply S_inj; trivial.
apply H.
apply S_inj.
- repeat rewrite (ARadd_assoc ARth) in |- *.
- rewrite <- (ARgen_phiPOS_Psucc Rsth Reqe ARth) in |- *; trivial.
+ repeat rewrite (ARadd_assoc ARth).
+ rewrite <- (ARgen_phiPOS_Psucc Rsth Reqe ARth); trivial.
Qed.
Lemma gen_phiPOS_inj : forall x y,
gen_phiPOS rI radd rmul x == gen_phiPOS rI radd rmul y ->
x = y.
intros x y.
-repeat rewrite <- (same_gen Rsth Reqe ARth) in |- *.
+repeat rewrite <- (same_gen Rsth Reqe ARth).
case (Pos.compare_spec x y).
intros.
trivial.
intros.
elim gen_phiPOS_not_0 with (y - x)%positive.
apply add_inj_r with x.
- symmetry in |- *.
- rewrite (ARadd_0_r Rsth ARth) in |- *.
- rewrite <- (ARgen_phiPOS_add Rsth Reqe ARth) in |- *.
- rewrite Pplus_minus in |- *; trivial.
- now apply Pos.lt_gt.
+ symmetry.
+ rewrite (ARadd_0_r Rsth ARth).
+ rewrite <- (ARgen_phiPOS_add Rsth Reqe ARth).
+ now rewrite Pos.add_comm, Pos.sub_add.
intros.
elim gen_phiPOS_not_0 with (x - y)%positive.
apply add_inj_r with y.
- rewrite (ARadd_0_r Rsth ARth) in |- *.
- rewrite <- (ARgen_phiPOS_add Rsth Reqe ARth) in |- *.
- rewrite Pplus_minus in |- *; trivial.
- now apply Pos.lt_gt.
+ rewrite (ARadd_0_r Rsth ARth).
+ rewrite <- (ARgen_phiPOS_add Rsth Reqe ARth).
+ now rewrite Pos.add_comm, Pos.sub_add.
Qed.
Lemma gen_phiN_inj : forall x y,
gen_phiN rO rI radd rmul x == gen_phiN rO rI radd rmul y ->
x = y.
-destruct x; destruct y; simpl in |- *; intros; trivial.
+destruct x; destruct y; simpl; intros; trivial.
elim gen_phiPOS_not_0 with p.
- symmetry in |- *.
- rewrite (same_gen Rsth Reqe ARth) in |- *; trivial.
+ symmetry .
+ rewrite (same_gen Rsth Reqe ARth); trivial.
elim gen_phiPOS_not_0 with p.
- rewrite (same_gen Rsth Reqe ARth) in |- *; trivial.
- rewrite gen_phiPOS_inj with (1 := H) in |- *; trivial.
+ rewrite (same_gen Rsth Reqe ARth); trivial.
+ rewrite gen_phiPOS_inj with (1 := H); trivial.
Qed.
Lemma gen_phiN_complete : forall x y,
@@ -1824,17 +1809,17 @@ Section Field.
Lemma ring_S_inj : forall x y, 1+x==1+y -> x==y.
intros.
transitivity (x + (1 + - (1))).
- rewrite (Ropp_def Rth) in |- *.
- symmetry in |- *.
+ rewrite (Ropp_def Rth).
+ symmetry .
apply (ARadd_0_r Rsth ARth).
transitivity (y + (1 + - (1))).
- repeat rewrite <- (ARplus_assoc ARth) in |- *.
- repeat rewrite (ARadd_assoc ARth) in |- *.
+ repeat rewrite <- (ARplus_assoc ARth).
+ repeat rewrite (ARadd_assoc ARth).
apply (Radd_ext Reqe).
- repeat rewrite <- (ARadd_comm ARth 1) in |- *.
+ repeat rewrite <- (ARadd_comm ARth 1).
trivial.
reflexivity.
- rewrite (Ropp_def Rth) in |- *.
+ rewrite (Ropp_def Rth).
apply (ARadd_0_r Rsth ARth).
Qed.
@@ -1846,14 +1831,14 @@ Let gen_phiPOS_inject :=
Lemma gen_phiPOS_discr_sgn : forall x y,
~ gen_phiPOS rI radd rmul x == - gen_phiPOS rI radd rmul y.
-red in |- *; intros.
+red; intros.
apply gen_phiPOS_not_0 with (y + x)%positive.
-rewrite (ARgen_phiPOS_add Rsth Reqe ARth) in |- *.
+rewrite (ARgen_phiPOS_add Rsth Reqe ARth).
transitivity (gen_phiPOS1 1 radd rmul y + - gen_phiPOS1 1 radd rmul y).
apply (Radd_ext Reqe); trivial.
reflexivity.
- rewrite (same_gen Rsth Reqe ARth) in |- *.
- rewrite (same_gen Rsth Reqe ARth) in |- *.
+ rewrite (same_gen Rsth Reqe ARth).
+ rewrite (same_gen Rsth Reqe ARth).
trivial.
apply (Ropp_def Rth).
Qed.
@@ -1861,33 +1846,33 @@ Qed.
Lemma gen_phiZ_inj : forall x y,
gen_phiZ rO rI radd rmul ropp x == gen_phiZ rO rI radd rmul ropp y ->
x = y.
-destruct x; destruct y; simpl in |- *; intros.
+destruct x; destruct y; simpl; intros.
trivial.
elim gen_phiPOS_not_0 with p.
- rewrite (same_gen Rsth Reqe ARth) in |- *.
- symmetry in |- *; trivial.
+ rewrite (same_gen Rsth Reqe ARth).
+ symmetry ; trivial.
elim gen_phiPOS_not_0 with p.
- rewrite (same_gen Rsth Reqe ARth) in |- *.
- rewrite <- (Ropp_opp Rsth Reqe Rth (gen_phiPOS 1 radd rmul p)) in |- *.
- rewrite <- H in |- *.
+ rewrite (same_gen Rsth Reqe ARth).
+ rewrite <- (Ropp_opp Rsth Reqe Rth (gen_phiPOS 1 radd rmul p)).
+ rewrite <- H.
apply (ARopp_zero Rsth Reqe ARth).
elim gen_phiPOS_not_0 with p.
- rewrite (same_gen Rsth Reqe ARth) in |- *.
+ rewrite (same_gen Rsth Reqe ARth).
trivial.
- rewrite gen_phiPOS_inject with (1 := H) in |- *; trivial.
+ rewrite gen_phiPOS_inject with (1 := H); trivial.
elim gen_phiPOS_discr_sgn with (1 := H).
elim gen_phiPOS_not_0 with p.
- rewrite (same_gen Rsth Reqe ARth) in |- *.
- rewrite <- (Ropp_opp Rsth Reqe Rth (gen_phiPOS 1 radd rmul p)) in |- *.
- rewrite H in |- *.
+ rewrite (same_gen Rsth Reqe ARth).
+ rewrite <- (Ropp_opp Rsth Reqe Rth (gen_phiPOS 1 radd rmul p)).
+ rewrite H.
apply (ARopp_zero Rsth Reqe ARth).
elim gen_phiPOS_discr_sgn with p0 p.
- symmetry in |- *; trivial.
+ symmetry ; trivial.
replace p0 with p; trivial.
apply gen_phiPOS_inject.
- rewrite <- (Ropp_opp Rsth Reqe Rth (gen_phiPOS 1 radd rmul p)) in |- *.
- rewrite <- (Ropp_opp Rsth Reqe Rth (gen_phiPOS 1 radd rmul p0)) in |- *.
- rewrite H in |- *; trivial.
+ rewrite <- (Ropp_opp Rsth Reqe Rth (gen_phiPOS 1 radd rmul p)).
+ rewrite <- (Ropp_opp Rsth Reqe Rth (gen_phiPOS 1 radd rmul p0)).
+ rewrite H; trivial.
reflexivity.
Qed.
@@ -1896,8 +1881,8 @@ Lemma gen_phiZ_complete : forall x y,
Zeq_bool x y = true.
intros.
replace y with x.
- unfold Zeq_bool in |- *.
- rewrite Zcompare_refl in |- *; trivial.
+ unfold Zeq_bool.
+ rewrite Z.compare_refl; trivial.
apply gen_phiZ_inj; trivial.
Qed.
diff --git a/plugins/setoid_ring/InitialRing.v b/plugins/setoid_ring/InitialRing.v
index 763dbe7b..e805151c 100644
--- a/plugins/setoid_ring/InitialRing.v
+++ b/plugins/setoid_ring/InitialRing.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -27,14 +27,14 @@ Definition NotConstant := false.
Lemma Zsth : Setoid_Theory Z (@eq Z).
Proof (Eqsth Z).
-Lemma Zeqe : ring_eq_ext Zplus Zmult Zopp (@eq Z).
-Proof (Eq_ext Zplus Zmult Zopp).
+Lemma Zeqe : ring_eq_ext Z.add Z.mul Z.opp (@eq Z).
+Proof (Eq_ext Z.add Z.mul Z.opp).
-Lemma Zth : ring_theory Z0 (Zpos xH) Zplus Zmult Zminus Zopp (@eq Z).
+Lemma Zth : ring_theory Z0 (Zpos xH) Z.add Z.mul Z.sub Z.opp (@eq Z).
Proof.
- constructor. exact Zplus_0_l. exact Zplus_comm. exact Zplus_assoc.
- exact Zmult_1_l. exact Zmult_comm. exact Zmult_assoc.
- exact Zmult_plus_distr_l. trivial. exact Zminus_diag.
+ constructor. exact Z.add_0_l. exact Z.add_comm. exact Z.add_assoc.
+ exact Z.mul_1_l. exact Z.mul_comm. exact Z.mul_assoc.
+ exact Z.mul_add_distr_r. trivial. exact Z.sub_diag.
Qed.
(** Two generic morphisms from Z to (abrbitrary) rings, *)
@@ -92,12 +92,12 @@ Section ZMORPHISM.
| _ => None
end.
- Lemma get_signZ_th : sign_theory Zopp Zeq_bool get_signZ.
+ Lemma get_signZ_th : sign_theory Z.opp Zeq_bool get_signZ.
Proof.
constructor.
destruct c;intros;try discriminate.
injection H;clear H;intros H1;subst c'.
- simpl. unfold Zeq_bool. rewrite Zcompare_refl. trivial.
+ simpl. unfold Zeq_bool. rewrite Z.compare_refl. trivial.
Qed.
@@ -116,7 +116,7 @@ Section ZMORPHISM.
Qed.
Lemma ARgen_phiPOS_Psucc : forall x,
- gen_phiPOS1 (Psucc x) == 1 + (gen_phiPOS1 x).
+ gen_phiPOS1 (Pos.succ x) == 1 + (gen_phiPOS1 x).
Proof.
induction x;simpl;norm.
rewrite IHx;norm.
@@ -127,7 +127,7 @@ Section ZMORPHISM.
gen_phiPOS1 (x + y) == (gen_phiPOS1 x) + (gen_phiPOS1 y).
Proof.
induction x;destruct y;simpl;norm.
- rewrite Pplus_carry_spec.
+ rewrite Pos.add_carry_spec.
rewrite ARgen_phiPOS_Psucc.
rewrite IHx;norm.
add_push (gen_phiPOS1 y);add_push 1;rrefl.
@@ -208,10 +208,10 @@ Section ZMORPHISM.
(*proof that [.] satisfies morphism specifications*)
Lemma gen_phiZ_morph :
ring_morph 0 1 radd rmul rsub ropp req Z0 (Zpos xH)
- Zplus Zmult Zminus Zopp Zeq_bool gen_phiZ.
+ Z.add Z.mul Z.sub Z.opp Zeq_bool gen_phiZ.
Proof.
assert ( SRmorph : semi_morph 0 1 radd rmul req Z0 (Zpos xH)
- Zplus Zmult Zeq_bool gen_phiZ).
+ Z.add Z.mul Zeq_bool gen_phiZ).
apply mkRmorph;simpl;try rrefl.
apply gen_phiZ_add. apply gen_phiZ_mul. apply gen_Zeqb_ok.
apply (Smorph_morph Rsth Reqe Rth Zth SRmorph gen_phiZ_ext).
@@ -396,14 +396,14 @@ Section NWORDMORPHISM.
Lemma gen_phiNword0_ok : forall w, Nw_is0 w = true -> gen_phiNword w == 0.
Proof.
-induction w; simpl in |- *; intros; auto.
+induction w; simpl; intros; auto.
reflexivity.
destruct a.
destruct w.
reflexivity.
- rewrite IHw in |- *; trivial.
+ rewrite IHw; trivial.
apply (ARopp_zero Rsth Reqe ARth).
discriminate.
@@ -412,7 +412,7 @@ Qed.
Lemma gen_phiNword_cons : forall w n,
gen_phiNword (n::w) == gen_phiN rO rI radd rmul n - gen_phiNword w.
induction w.
- destruct n; simpl in |- *; norm.
+ destruct n; simpl; norm.
intros.
destruct n; norm.
@@ -423,27 +423,27 @@ Qed.
destruct w; intros.
destruct n; norm.
- unfold Nwcons in |- *.
- rewrite gen_phiNword_cons in |- *.
+ unfold Nwcons.
+ rewrite gen_phiNword_cons.
reflexivity.
Qed.
Lemma gen_phiNword_ok : forall w1 w2,
Nweq_bool w1 w2 = true -> gen_phiNword w1 == gen_phiNword w2.
induction w1; intros.
- simpl in |- *.
- rewrite (gen_phiNword0_ok _ H) in |- *.
+ simpl.
+ rewrite (gen_phiNword0_ok _ H).
reflexivity.
- rewrite gen_phiNword_cons in |- *.
+ rewrite gen_phiNword_cons.
destruct w2.
simpl in H.
destruct a; try discriminate.
- rewrite (gen_phiNword0_ok _ H) in |- *.
+ rewrite (gen_phiNword0_ok _ H).
norm.
simpl in H.
- rewrite gen_phiNword_cons in |- *.
+ rewrite gen_phiNword_cons.
case_eq (N.eqb a n); intros H0.
rewrite H0 in H.
apply N.eqb_eq in H0. rewrite <- H0.
@@ -457,27 +457,27 @@ Qed.
Lemma Nwadd_ok : forall x y,
gen_phiNword (Nwadd x y) == gen_phiNword x + gen_phiNword y.
induction x; intros.
- simpl in |- *.
+ simpl.
norm.
destruct y.
simpl Nwadd; norm.
- simpl Nwadd in |- *.
- repeat rewrite gen_phiNword_cons in |- *.
- rewrite (fun sreq => gen_phiN_add Rsth sreq (ARth_SRth ARth)) in |- * by
+ simpl Nwadd.
+ repeat rewrite gen_phiNword_cons.
+ rewrite (fun sreq => gen_phiN_add Rsth sreq (ARth_SRth ARth)) by
(destruct Reqe; constructor; trivial).
- rewrite IHx in |- *.
+ rewrite IHx.
norm.
add_push (- gen_phiNword x); reflexivity.
Qed.
Lemma Nwopp_ok : forall x, gen_phiNword (Nwopp x) == - gen_phiNword x.
-simpl in |- *.
-unfold Nwopp in |- *; simpl in |- *.
+simpl.
+unfold Nwopp; simpl.
intros.
-rewrite gen_phiNword_Nwcons in |- *; norm.
+rewrite gen_phiNword_Nwcons; norm.
Qed.
Lemma Nwscal_ok : forall n x,
@@ -485,12 +485,12 @@ Lemma Nwscal_ok : forall n x,
induction x; intros.
norm.
- simpl Nwscal in |- *.
- repeat rewrite gen_phiNword_cons in |- *.
- rewrite (fun sreq => gen_phiN_mult Rsth sreq (ARth_SRth ARth)) in |- *
+ simpl Nwscal.
+ repeat rewrite gen_phiNword_cons.
+ rewrite (fun sreq => gen_phiN_mult Rsth sreq (ARth_SRth ARth))
by (destruct Reqe; constructor; trivial).
- rewrite IHx in |- *.
+ rewrite IHx.
norm.
Qed.
@@ -500,19 +500,19 @@ induction x; intros.
norm.
destruct a.
- simpl Nwmul in |- *.
- rewrite Nwopp_ok in |- *.
- rewrite IHx in |- *.
- rewrite gen_phiNword_cons in |- *.
+ simpl Nwmul.
+ rewrite Nwopp_ok.
+ rewrite IHx.
+ rewrite gen_phiNword_cons.
norm.
- simpl Nwmul in |- *.
- unfold Nwsub in |- *.
- rewrite Nwadd_ok in |- *.
- rewrite Nwscal_ok in |- *.
- rewrite Nwopp_ok in |- *.
- rewrite IHx in |- *.
- rewrite gen_phiNword_cons in |- *.
+ simpl Nwmul.
+ unfold Nwsub.
+ rewrite Nwadd_ok.
+ rewrite Nwscal_ok.
+ rewrite Nwopp_ok.
+ rewrite IHx.
+ rewrite gen_phiNword_cons.
norm.
Qed.
@@ -528,9 +528,9 @@ constructor.
exact Nwadd_ok.
intros.
- unfold Nwsub in |- *.
- rewrite Nwadd_ok in |- *.
- rewrite Nwopp_ok in |- *.
+ unfold Nwsub.
+ rewrite Nwadd_ok.
+ rewrite Nwopp_ok.
norm.
exact Nwmul_ok.
@@ -741,10 +741,10 @@ Ltac gen_ring_sign morph sspec :=
Ltac default_div_spec set reqe arth morph :=
match type of morph with
| @ring_morph ?R ?r0 ?rI ?radd ?rmul ?rsub ?ropp ?req
- Z ?c0 ?c1 Zplus Zmult ?csub ?copp ?ceq_b ?phi =>
+ Z ?c0 ?c1 Z.add Z.mul ?csub ?copp ?ceq_b ?phi =>
constr:(mkhypo (Ztriv_div_th set phi))
| @ring_morph ?R ?r0 ?rI ?radd ?rmul ?rsub ?ropp ?req
- N ?c0 ?c1 Nplus Nmult ?csub ?copp ?ceq_b ?phi =>
+ N ?c0 ?c1 N.add N.mul ?csub ?copp ?ceq_b ?phi =>
constr:(mkhypo (Ntriv_div_th set phi))
| @ring_morph ?R ?r0 ?rI ?radd ?rmul ?rsub ?ropp ?req
?C ?c0 ?c1 ?cadd ?cmul ?csub ?copp ?ceq_b ?phi =>
@@ -836,7 +836,7 @@ Ltac isPcst t :=
| xO ?p => isPcst p
| xH => constr:true
(* nat -> positive *)
- | P_of_succ_nat ?n => isnatcst n
+ | Pos.of_succ_nat ?n => isnatcst n
| _ => constr:false
end.
@@ -853,9 +853,9 @@ Ltac isZcst t :=
| Zpos ?p => isPcst p
| Zneg ?p => isPcst p
(* injection nat -> Z *)
- | Z_of_nat ?n => isnatcst n
+ | Z.of_nat ?n => isnatcst n
(* injection N -> Z *)
- | Z_of_N ?n => isNcst n
+ | Z.of_N ?n => isNcst n
(* *)
| _ => constr:false
end.
diff --git a/plugins/setoid_ring/Integral_domain.v b/plugins/setoid_ring/Integral_domain.v
index 5a224e38..0c16fe1a 100644
--- a/plugins/setoid_ring/Integral_domain.v
+++ b/plugins/setoid_ring/Integral_domain.v
@@ -19,7 +19,7 @@ rewrite H0. rewrite <- H. cring.
Qed.
-Definition pow (r : R) (n : nat) := Ring_theory.pow_N 1 mul r (N_of_nat n).
+Definition pow (r : R) (n : nat) := Ring_theory.pow_N 1 mul r (N.of_nat n).
Lemma pow_not_zero: forall p n, pow p n == 0 -> p == 0.
induction n. unfold pow; simpl. intros. absurd (1 == 0).
@@ -29,9 +29,8 @@ intros.
case (integral_domain_product p (pow p n) H). trivial. trivial.
unfold pow; simpl.
clear IHn. induction n; simpl; try cring.
- rewrite Ring_theory.pow_pos_Psucc. cring. apply ring_setoid.
+ rewrite Ring_theory.pow_pos_succ. cring. apply ring_setoid.
apply ring_mult_comp.
-apply cring_mul_comm.
apply ring_mul_assoc.
Qed.
diff --git a/plugins/setoid_ring/NArithRing.v b/plugins/setoid_ring/NArithRing.v
index fafd16ab..fae98d83 100644
--- a/plugins/setoid_ring/NArithRing.v
+++ b/plugins/setoid_ring/NArithRing.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/setoid_ring/Ncring.v b/plugins/setoid_ring/Ncring.v
index 9a30fa47..7789ba3e 100644
--- a/plugins/setoid_ring/Ncring.v
+++ b/plugins/setoid_ring/Ncring.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -106,9 +106,10 @@ Context {R:Type}`{Rr:Ring R}.
(* Powers *)
- Lemma pow_pos_comm : forall x j, x * pow_pos x j == pow_pos x j * x.
+Lemma pow_pos_comm : forall x j, x * pow_pos x j == pow_pos x j * x.
+Proof.
induction j; simpl. rewrite <- ring_mul_assoc.
-rewrite <- ring_mul_assoc.
+rewrite <- ring_mul_assoc.
rewrite <- IHj. rewrite (ring_mul_assoc (pow_pos x j) x (pow_pos x j)).
rewrite <- IHj. rewrite <- ring_mul_assoc. reflexivity.
rewrite <- ring_mul_assoc. rewrite <- IHj.
@@ -116,10 +117,10 @@ rewrite ring_mul_assoc. rewrite IHj.
rewrite <- ring_mul_assoc. rewrite IHj. reflexivity. reflexivity.
Qed.
- Lemma pow_pos_Psucc : forall x j, pow_pos x (Psucc j) == x * pow_pos x j.
- Proof.
- induction j; simpl.
- rewrite IHj.
+Lemma pow_pos_succ : forall x j, pow_pos x (Pos.succ j) == x * pow_pos x j.
+Proof.
+induction j; simpl.
+ rewrite IHj.
rewrite <- (ring_mul_assoc x (pow_pos x j) (x * pow_pos x j)).
rewrite (ring_mul_assoc (pow_pos x j) x (pow_pos x j)).
rewrite <- pow_pos_comm.
@@ -127,20 +128,20 @@ rewrite <- ring_mul_assoc. reflexivity.
reflexivity. reflexivity.
Qed.
- Lemma pow_pos_Pplus : forall x i j,
- pow_pos x (i + j) == pow_pos x i * pow_pos x j.
- Proof.
+Lemma pow_pos_add : forall x i j,
+ pow_pos x (i + j) == pow_pos x i * pow_pos x j.
+Proof.
intro x;induction i;intros.
- rewrite xI_succ_xO;rewrite Pplus_one_succ_r.
- rewrite <- Pplus_diag;repeat rewrite <- Pplus_assoc.
+ rewrite Pos.xI_succ_xO;rewrite <- Pos.add_1_r.
+ rewrite <- Pos.add_diag;repeat rewrite <- Pos.add_assoc.
repeat rewrite IHi.
- rewrite Pplus_comm;rewrite <- Pplus_one_succ_r;
- rewrite pow_pos_Psucc.
+ rewrite Pos.add_comm;rewrite Pos.add_1_r;
+ rewrite pow_pos_succ.
simpl;repeat rewrite ring_mul_assoc. reflexivity.
- rewrite <- Pplus_diag;repeat rewrite <- Pplus_assoc.
+ rewrite <- Pos.add_diag;repeat rewrite <- Pos.add_assoc.
repeat rewrite IHi. rewrite ring_mul_assoc. reflexivity.
- rewrite Pplus_comm;rewrite <- Pplus_one_succ_r;rewrite pow_pos_Psucc.
- simpl. reflexivity.
+ rewrite Pos.add_comm;rewrite Pos.add_1_r;rewrite pow_pos_succ.
+ simpl. reflexivity.
Qed.
Definition id_phi_N (x:N) : N := x.
diff --git a/plugins/setoid_ring/Ncring_initial.v b/plugins/setoid_ring/Ncring_initial.v
index 3c79f7d9..528ad4f1 100644
--- a/plugins/setoid_ring/Ncring_initial.v
+++ b/plugins/setoid_ring/Ncring_initial.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -27,20 +27,17 @@ Definition NotConstant := false.
(** Z is a ring and a setoid*)
-Lemma Zsth : Setoid_Theory Z (@eq Z).
-constructor;red;intros;subst;trivial.
-Qed.
+Lemma Zsth : Equivalence (@eq Z).
+Proof. exact Z.eq_equiv. Qed.
-Instance Zops:@Ring_ops Z 0%Z 1%Z Zplus Zmult Zminus Zopp (@eq Z).
+Instance Zops:@Ring_ops Z 0%Z 1%Z Z.add Z.mul Z.sub Z.opp (@eq Z).
Instance Zr: (@Ring _ _ _ _ _ _ _ _ Zops).
-constructor;
-try (try apply Zsth;
- try (unfold respectful, Proper; unfold equality; unfold eq_notation in *;
- intros; try rewrite H; try rewrite H0; reflexivity)).
- exact Zplus_comm. exact Zplus_assoc.
- exact Zmult_1_l. exact Zmult_1_r. exact Zmult_assoc.
- exact Zmult_plus_distr_l. intros; apply Zmult_plus_distr_r. exact Zminus_diag.
+Proof.
+constructor; try apply Zsth; try solve_proper.
+ exact Z.add_comm. exact Z.add_assoc.
+ exact Z.mul_1_l. exact Z.mul_1_r. exact Z.mul_assoc.
+ exact Z.mul_add_distr_r. intros; apply Z.mul_add_distr_l. exact Z.sub_diag.
Defined.
(*Instance ZEquality: @Equality Z:= (@eq Z).*)
@@ -102,7 +99,7 @@ Ltac rsimpl := simpl.
Qed.
Lemma ARgen_phiPOS_Psucc : forall x,
- gen_phiPOS1 (Psucc x) == 1 + (gen_phiPOS1 x).
+ gen_phiPOS1 (Pos.succ x) == 1 + (gen_phiPOS1 x).
Proof.
induction x;rsimpl;norm.
rewrite IHx. gen_rewrite. add_push 1. reflexivity.
@@ -112,7 +109,7 @@ Ltac rsimpl := simpl.
gen_phiPOS1 (x + y) == (gen_phiPOS1 x) + (gen_phiPOS1 y).
Proof.
induction x;destruct y;simpl;norm.
- rewrite Pplus_carry_spec.
+ rewrite Pos.add_carry_spec.
rewrite ARgen_phiPOS_Psucc.
rewrite IHx;norm.
add_push (gen_phiPOS1 y);add_push 1;reflexivity.
@@ -152,20 +149,13 @@ Ltac rsimpl := simpl.
== gen_phiPOS1 x + -gen_phiPOS1 y.
Proof.
intros x y.
- rewrite Z.pos_sub_spec.
- assert (HH0 := Pminus_mask_Gt x y). unfold Pos.gt in HH0.
- assert (HH1 := Pminus_mask_Gt y x). unfold Pos.gt in HH1.
- rewrite Pos.compare_antisym in HH1.
- destruct (Pos.compare_spec x y) as [HH|HH|HH].
- subst. rewrite ring_opp_def;reflexivity.
- destruct HH1 as [h [HHeq1 [HHeq2 HHor]]];trivial.
- unfold Pminus; rewrite HHeq1;rewrite <- HHeq2.
- rewrite ARgen_phiPOS_add;simpl;norm.
- rewrite ring_opp_def;norm.
- destruct HH0 as [h [HHeq1 [HHeq2 HHor]]];trivial.
- unfold Pminus; rewrite HHeq1;rewrite <- HHeq2.
- rewrite ARgen_phiPOS_add;simpl;norm.
- add_push (gen_phiPOS1 h). rewrite ring_opp_def ; norm.
+ generalize (Z.pos_sub_discr x y).
+ destruct (Z.pos_sub x y) as [|p|p]; intros; subst.
+ - now rewrite ring_opp_def.
+ - rewrite ARgen_phiPOS_add;simpl;norm.
+ add_push (gen_phiPOS1 p). rewrite ring_opp_def;norm.
+ - rewrite ARgen_phiPOS_add;simpl;norm.
+ rewrite ring_opp_def;norm.
Qed.
Lemma match_compOpp : forall x (B:Type) (be bl bg:B),
@@ -206,16 +196,14 @@ Lemma gen_phiZ_opp : forall x, [- x] == - [x].
Global Instance gen_phiZ_morph :
(@Ring_morphism (Z:Type) R _ _ _ _ _ _ _ Zops Zr _ _ _ _ _ _ _ _ _ gen_phiZ) . (* beurk!*)
apply Build_Ring_morphism; simpl;try reflexivity.
- apply gen_phiZ_add. intros. rewrite ring_sub_def.
-replace (Zminus x y) with (x + (-y))%Z. rewrite gen_phiZ_add.
-rewrite gen_phiZ_opp. rewrite ring_sub_def. reflexivity.
+ apply gen_phiZ_add. intros. rewrite ring_sub_def.
+replace (x-y)%Z with (x + (-y))%Z.
+now rewrite gen_phiZ_add, gen_phiZ_opp, ring_sub_def.
reflexivity.
- apply gen_phiZ_mul. apply gen_phiZ_opp. apply gen_phiZ_ext.
+ apply gen_phiZ_mul. apply gen_phiZ_opp. apply gen_phiZ_ext.
Defined.
End ZMORPHISM.
Instance multiplication_phi_ring{R:Type}`{Ring R} : Multiplication :=
{multiplication x y := (gen_phiZ x) * y}.
-
-
diff --git a/plugins/setoid_ring/Ncring_polynom.v b/plugins/setoid_ring/Ncring_polynom.v
index c0d31587..8e4b613f 100644
--- a/plugins/setoid_ring/Ncring_polynom.v
+++ b/plugins/setoid_ring/Ncring_polynom.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -52,7 +52,7 @@ Instance equalityb_coef : Equalityb C :=
match P, P' with
| Pc c, Pc c' => c =? c'
| PX P i n Q, PX P' i' n' Q' =>
- match Pcompare i i' Eq, Pcompare n n' Eq with
+ match Pos.compare i i', Pos.compare n n' with
| Eq, Eq => if Peq P P' then Peq Q Q' else false
| _,_ => false
end
@@ -67,7 +67,7 @@ Instance equalityb_pol : Equalityb Pol :=
match P with
| Pc c => if c =? 0 then Q else PX P i n Q
| PX P' i' n' Q' =>
- match Pcompare i i' Eq with
+ match Pos.compare i i' with
| Eq => if Q' =? P0 then PX P' i (n + n') Q else PX P i n Q
| _ => PX P i n Q
end
@@ -109,13 +109,13 @@ Fixpoint PaddX (i n:positive)(Q:Pol){struct Q}:=
match Q with
| Pc c => mkPX P i n Q
| PX P' i' n' Q' =>
- match Pcompare i i' Eq with
+ match Pos.compare i i' with
| (* i > i' *)
Gt => mkPX P i n Q
| (* i < i' *)
Lt => mkPX P' i' n' (PaddX i n Q')
| (* i = i' *)
- Eq => match ZPminus n n' with
+ Eq => match Z.pos_sub n n' with
| (* n > n' *)
Zpos k => mkPX (PaddX i k P') i' n' Q'
| (* n = n' *)
@@ -178,61 +178,25 @@ Definition Psub(P P':Pol):= P ++ (--P').
Reserved Notation "P @ l " (at level 10, no associativity).
Notation "P @ l " := (Pphi l P).
+
(** Proofs *)
- Lemma ZPminus_spec : forall x y,
- match ZPminus x y with
- | Z0 => x = y
- | Zpos k => x = (y + k)%positive
- | Zneg k => y = (x + k)%positive
+
+ Ltac destr_pos_sub H :=
+ match goal with |- context [Z.pos_sub ?x ?y] =>
+ assert (H := Z.pos_sub_discr x y); destruct (Z.pos_sub x y)
end.
- Proof.
- induction x;destruct y.
- replace (ZPminus (xI x) (xI y)) with (Zdouble (ZPminus x y));trivial.
- assert (Hh := IHx y);destruct (ZPminus x y);unfold Zdouble;
-rewrite Hh;trivial.
- replace (ZPminus (xI x) (xO y)) with (Zdouble_plus_one (ZPminus x y));
-trivial.
- assert (Hh := IHx y);destruct (ZPminus x y);unfold Zdouble_plus_one;
-rewrite Hh;trivial.
- apply Pplus_xI_double_minus_one.
- simpl;trivial.
- replace (ZPminus (xO x) (xI y)) with (Zdouble_minus_one (ZPminus x y));
-trivial.
- assert (Hh := IHx y);destruct (ZPminus x y);unfold Zdouble_minus_one;
-rewrite Hh;trivial.
- apply Pplus_xI_double_minus_one.
- replace (ZPminus (xO x) (xO y)) with (Zdouble (ZPminus x y));trivial.
- assert (Hh := IHx y);destruct (ZPminus x y);unfold Zdouble;rewrite Hh;
-trivial.
- replace (ZPminus (xO x) xH) with (Zpos (Pdouble_minus_one x));trivial.
- rewrite <- Pplus_one_succ_l.
- rewrite Psucc_o_double_minus_one_eq_xO;trivial.
- replace (ZPminus xH (xI y)) with (Zneg (xO y));trivial.
- replace (ZPminus xH (xO y)) with (Zneg (Pdouble_minus_one y));trivial.
- rewrite <- Pplus_one_succ_l.
- rewrite Psucc_o_double_minus_one_eq_xO;trivial.
- simpl;trivial.
- Qed.
Lemma Peq_ok : forall P P',
(P =? P') = true -> forall l, P@l == P'@ l.
Proof.
- induction P;destruct P';simpl;intros;try discriminate;trivial.
- apply ring_morphism_eq.
- apply Ceqb_eq ;trivial.
- assert (H1h := IHP1 P'1);assert (H2h := IHP2 P'2).
- simpl in H1h. destruct (Peq P2 P'1). simpl in H2h;
-destruct (Peq P3 P'2).
- rewrite (H1h);trivial . rewrite (H2h);trivial.
-assert (H3h := Pcompare_Eq_eq p p1);
- destruct (Pos.compare_cont p p1 Eq);
-assert (H4h := Pcompare_Eq_eq p0 p2);
-destruct (Pos.compare_cont p0 p2 Eq); try (discriminate H).
- rewrite H3h;trivial. rewrite H4h;trivial. reflexivity.
- destruct (Pos.compare_cont p p1 Eq); destruct (Pos.compare_cont p0 p2 Eq);
- try (discriminate H).
- destruct (Pos.compare_cont p p1 Eq); destruct (Pos.compare_cont p0 p2 Eq);
- try (discriminate H).
+ induction P;destruct P';simpl;intros ;try easy.
+ - now apply ring_morphism_eq, Ceqb_eq.
+ - specialize (IHP1 P'1). specialize (IHP2 P'2).
+ simpl in IHP1, IHP2.
+ destruct (Pos.compare_spec p p1); try discriminate;
+ destruct (Pos.compare_spec p0 p2); try discriminate.
+ destruct (Peq P2 P'1); try discriminate.
+ subst; now rewrite IHP1, IHP2.
Qed.
Lemma Pphi0 : forall l, P0@l == 0.
@@ -255,12 +219,12 @@ destruct (Pos.compare_cont p0 p2 Eq); try (discriminate H).
simpl; case_eq (Ceqb c 0);simpl;try reflexivity.
intros.
rewrite Hh. rewrite ring_morphism0.
- rsimpl. apply Ceqb_eq. trivial. assert (Hh1 := Pcompare_Eq_eq i p);
-destruct (Pos.compare_cont i p Eq).
+ rsimpl. apply Ceqb_eq. trivial.
+ destruct (Pos.compare_spec i p).
assert (Hh := @Peq_ok P3 P0). case_eq (P3=? P0). intro. simpl.
rewrite Hh.
- rewrite Pphi0. rsimpl. rewrite Pplus_comm. rewrite pow_pos_Pplus;rsimpl.
-rewrite Hh1;trivial. reflexivity. trivial. intros. simpl. reflexivity. simpl. reflexivity.
+ rewrite Pphi0. rsimpl. rewrite Pos.add_comm. rewrite pow_pos_add;rsimpl.
+ subst;trivial. reflexivity. trivial. intros. simpl. reflexivity. simpl. reflexivity.
simpl. reflexivity.
Qed.
@@ -331,13 +295,13 @@ Lemma PaddXPX: forall P i n Q,
match Q with
| Pc c => mkPX P i n Q
| PX P' i' n' Q' =>
- match Pcompare i i' Eq with
+ match Pos.compare i i' with
| (* i > i' *)
Gt => mkPX P i n Q
| (* i < i' *)
Lt => mkPX P' i' n' (PaddX Padd P i n Q')
| (* i = i' *)
- Eq => match ZPminus n n' with
+ Eq => match Z.pos_sub n n' with
| (* n > n' *)
Zpos k => mkPX (PaddX Padd P i k P') i' n' Q'
| (* n = n' *)
@@ -359,17 +323,17 @@ Lemma PaddX_ok2 : forall P2,
induction P2;simpl;intros. split. intros. apply PaddCl_ok.
induction P. unfold PaddX. intros. rewrite mkPX_ok.
simpl. rsimpl.
-intros. simpl. assert (Hh := Pcompare_Eq_eq k p);
- destruct (Pos.compare_cont k p Eq).
- assert (H1h := ZPminus_spec n p0);destruct (ZPminus n p0). Esimpl2.
+intros. simpl.
+ destruct (Pos.compare_spec k p) as [Hh|Hh|Hh].
+ destr_pos_sub H1h. Esimpl2.
rewrite Hh; trivial. rewrite H1h. reflexivity.
simpl. rewrite mkPX_ok. rewrite IHP1. Esimpl2.
- rewrite Pplus_comm in H1h.
+ rewrite Pos.add_comm in H1h.
rewrite H1h.
-rewrite pow_pos_Pplus. Esimpl2.
+rewrite pow_pos_add. Esimpl2.
rewrite Hh; trivial. reflexivity.
-rewrite mkPX_ok. rewrite PaddCl_ok. Esimpl2. rewrite Pplus_comm in H1h.
-rewrite H1h. Esimpl2. rewrite pow_pos_Pplus. Esimpl2.
+rewrite mkPX_ok. rewrite PaddCl_ok. Esimpl2. rewrite Pos.add_comm in H1h.
+rewrite H1h. Esimpl2. rewrite pow_pos_add. Esimpl2.
rewrite Hh; trivial. reflexivity.
rewrite mkPX_ok. rewrite IHP2. Esimpl2.
rewrite (ring_add_comm (P2 @ l * pow_pos (nth 0 p l) p0)
@@ -382,19 +346,18 @@ split. intros. rewrite H0. rewrite H1.
Esimpl2.
induction P. unfold PaddX. intros. rewrite mkPX_ok. simpl. reflexivity.
intros. rewrite PaddXPX.
-assert (H3h := Pcompare_Eq_eq k p1);
- destruct (Pos.compare_cont k p1 Eq).
-assert (H4h := ZPminus_spec n p2);destruct (ZPminus n p2).
+destruct (Pos.compare_spec k p1) as [H3h|H3h|H3h].
+destr_pos_sub H4h.
rewrite mkPX_ok. simpl. rewrite H0. rewrite H1. Esimpl2.
rewrite H4h. rewrite H3h;trivial. reflexivity.
rewrite mkPX_ok. rewrite IHP1. Esimpl2. rewrite H3h;trivial.
-rewrite Pplus_comm in H4h.
-rewrite H4h. rewrite pow_pos_Pplus. Esimpl2.
+rewrite Pos.add_comm in H4h.
+rewrite H4h. rewrite pow_pos_add. Esimpl2.
rewrite mkPX_ok. simpl. rewrite H0. rewrite H1.
rewrite mkPX_ok.
Esimpl2. rewrite H3h;trivial.
- rewrite Pplus_comm in H4h.
-rewrite H4h. rewrite pow_pos_Pplus. Esimpl2.
+ rewrite Pos.add_comm in H4h.
+rewrite H4h. rewrite pow_pos_add. Esimpl2.
rewrite mkPX_ok. simpl. rewrite IHP2. Esimpl2.
gen_add_push (P2 @ l * pow_pos (nth 0 p1 l) p2). try reflexivity.
rewrite mkPX_ok. simpl. reflexivity.
diff --git a/plugins/setoid_ring/Ncring_tac.v b/plugins/setoid_ring/Ncring_tac.v
index 34731eb3..44f8e7ff 100644
--- a/plugins/setoid_ring/Ncring_tac.v
+++ b/plugins/setoid_ring/Ncring_tac.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -104,7 +104,7 @@ Instance reify_pow (R:Type) `{Ring R}
Instance reify_var (R:Type) t lvar i
`{nth R t lvar i}
`{Rr: Ring (T:=R)}
- : reify (Rr:= Rr) (PEX Z (P_of_succ_nat i))lvar t
+ : reify (Rr:= Rr) (PEX Z (Pos.of_succ_nat i))lvar t
| 100.
Class reifylist (R:Type)`{Rr:Ring (T:=R)} (lexpr:list (PExpr Z)) (lvar:list R)
@@ -202,7 +202,7 @@ Ltac ring_simplify_aux lterm fv lexpr hyp :=
match lexpr with
| ?e::?le => (* e:PExpr Z est la réification de t0:R *)
let t := constr:(@Ncring_polynom.norm_subst
- Z 0%Z 1%Z Zplus Zmult Zminus Zopp (@eq Z) Zops Zeq_bool e) in
+ Z 0%Z 1%Z Z.add Z.mul Z.sub Z.opp (@eq Z) Zops Zeq_bool e) in
(* t:Pol Z *)
let te :=
constr:(@Ncring_polynom.Pphi Z
@@ -212,13 +212,13 @@ Ltac ring_simplify_aux lterm fv lexpr hyp :=
let t':= fresh "t" in
pose (t' := nft);
assert (eq1 : t = t');
- [vm_cast_no_check (refl_equal t')|
+ [vm_cast_no_check (eq_refl t')|
let eq2 := fresh "ring" in
assert (eq2:(@Ncring_polynom.PEeval Z
_ 0 1 _+_ _*_ _-_ -_ _==_ _ Ncring_initial.gen_phiZ N (fun n:N => n)
(@Ring_theory.pow_N _ 1 multiplication) fv e) == te);
[apply (@Ncring_polynom.norm_subst_ok
- Z _ 0%Z 1%Z Zplus Zmult Zminus Zopp (@eq Z)
+ Z _ 0%Z 1%Z Z.add Z.mul Z.sub Z.opp (@eq Z)
_ _ 0 1 _+_ _*_ _-_ -_ _==_ _ _ Ncring_initial.gen_phiZ _
(@comm _ 0 1 _+_ _*_ _-_ -_ _==_ _ _) _ Zeqb_ok);
apply mkpow_th; reflexivity
diff --git a/plugins/setoid_ring/RealField.v b/plugins/setoid_ring/RealField.v
index 56473adb..29372212 100644
--- a/plugins/setoid_ring/RealField.v
+++ b/plugins/setoid_ring/RealField.v
@@ -5,21 +5,21 @@ Require Import Rdefinitions.
Require Import Rpow_def.
Require Import Raxioms.
-Open Local Scope R_scope.
+Local Open Scope R_scope.
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.
+ symmetry ; apply Rplus_assoc.
intro; apply Rmult_1_l.
exact Rmult_comm.
- symmetry in |- *; apply Rmult_assoc.
+ symmetry ; apply Rmult_assoc.
intros m n p.
- rewrite Rmult_comm in |- *.
- rewrite (Rmult_comm n p) in |- *.
- rewrite (Rmult_comm m p) in |- *.
+ rewrite Rmult_comm.
+ rewrite (Rmult_comm n p).
+ rewrite (Rmult_comm m p).
apply Rmult_plus_distr_l.
reflexivity.
exact Rplus_opp_r.
@@ -42,17 +42,17 @@ 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 |- *.
+ unfold Rminus.
+ rewrite (Rplus_comm (IZR (up x)) (- x)).
+ rewrite <- Rplus_assoc.
+ rewrite Rplus_opp_r.
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.
+ unfold Rminus.
+ rewrite (Rplus_comm (IZR (up x)) (- x)).
+ rewrite <- Rplus_assoc.
+ rewrite Rplus_opp_r.
+ rewrite Rplus_0_l; trivial.
Qed.
Notation Rset := (Eqsth R).
@@ -61,7 +61,7 @@ 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 |- *.
+ rewrite Rplus_comm.
apply Rplus_lt_compat_l.
replace 1 with (0 + 1).
apply Rlt_n_Sn.
@@ -69,19 +69,19 @@ apply Rlt_trans with (0 + 1).
Qed.
Lemma Rgen_phiPOS : forall x, InitialRing.gen_phiPOS1 1 Rplus Rmult x > 0.
-unfold Rgt in |- *.
-induction x; simpl in |- *; intros.
+unfold Rgt.
+induction x; simpl; intros.
apply Rlt_trans with (1 + 0).
- rewrite Rplus_comm in |- *.
+ rewrite Rplus_comm.
apply Rlt_n_Sn.
apply Rplus_lt_compat_l.
- rewrite <- (Rmul_0_l Rset Rext RTheory 2) in |- *.
- rewrite Rmult_comm in |- *.
+ rewrite <- (Rmul_0_l Rset Rext RTheory 2).
+ rewrite Rmult_comm.
apply Rmult_lt_compat_l.
apply Rlt_0_2.
trivial.
- rewrite <- (Rmul_0_l Rset Rext RTheory 2) in |- *.
- rewrite Rmult_comm in |- *.
+ rewrite <- (Rmul_0_l Rset Rext RTheory 2).
+ rewrite Rmult_comm.
apply Rmult_lt_compat_l.
apply Rlt_0_2.
trivial.
@@ -93,9 +93,9 @@ Qed.
Lemma Rgen_phiPOS_not_0 :
forall x, InitialRing.gen_phiPOS1 1 Rplus Rmult x <> 0.
-red in |- *; intros.
+red; intros.
specialize (Rgen_phiPOS x).
-rewrite H in |- *; intro.
+rewrite H; intro.
apply (Rlt_asym 0 0); trivial.
Qed.
@@ -107,23 +107,23 @@ Proof gen_phiZ_complete Rset Rext Rfield Rgen_phiPOS_not_0.
Lemma Rdef_pow_add : forall (x:R) (n m:nat), pow x (n + m) = pow x n * pow x m.
Proof.
- intros x n; elim n; simpl in |- *; auto with real.
+ intros x n; elim n; simpl; auto with real.
intros n0 H' m; rewrite H'; auto with real.
Qed.
-Lemma R_power_theory : power_theory 1%R Rmult (eq (A:=R)) nat_of_N pow.
+Lemma R_power_theory : power_theory 1%R Rmult (@eq R) N.to_nat pow.
Proof.
constructor. destruct n. reflexivity.
- simpl. induction p;simpl.
- rewrite ZL6. rewrite Rdef_pow_add;rewrite IHp. reflexivity.
- unfold nat_of_P;simpl;rewrite ZL6;rewrite Rdef_pow_add;rewrite IHp;trivial.
- rewrite Rmult_comm;apply Rmult_1_l.
+ simpl. induction p.
+ - rewrite Pos2Nat.inj_xI. simpl. now rewrite plus_0_r, Rdef_pow_add, IHp.
+ - rewrite Pos2Nat.inj_xO. simpl. now rewrite plus_0_r, Rdef_pow_add, IHp.
+ - simpl. rewrite Rmult_comm;apply Rmult_1_l.
Qed.
Ltac Rpow_tac t :=
match isnatcst t with
| false => constr:(InitialRing.NotConstant)
- | _ => constr:(N_of_nat t)
+ | _ => constr:(N.of_nat t)
end.
Add Field RField : Rfield
diff --git a/plugins/setoid_ring/Ring.v b/plugins/setoid_ring/Ring.v
index c44c2edf..7c1bf981 100644
--- a/plugins/setoid_ring/Ring.v
+++ b/plugins/setoid_ring/Ring.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -14,7 +14,7 @@ Require Export Ring_tac.
Lemma BoolTheory :
ring_theory false true xorb andb xorb (fun b:bool => b) (eq(A:=bool)).
-split; simpl in |- *.
+split; simpl.
destruct x; reflexivity.
destruct x; destruct y; reflexivity.
destruct x; destruct y; destruct z; reflexivity.
diff --git a/plugins/setoid_ring/Ring_base.v b/plugins/setoid_ring/Ring_base.v
index 6d4360d6..dc5248b2 100644
--- a/plugins/setoid_ring/Ring_base.v
+++ b/plugins/setoid_ring/Ring_base.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/setoid_ring/Ring_polynom.v b/plugins/setoid_ring/Ring_polynom.v
index b722a31b..b23ba352 100644
--- a/plugins/setoid_ring/Ring_polynom.v
+++ b/plugins/setoid_ring/Ring_polynom.v
@@ -1,20 +1,16 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \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 Import BinList.
-Require Import BinPos.
-Require Import BinNat.
-Require Import BinInt.
+Require Import Setoid Morphisms BinList BinPos BinNat BinInt.
Require Export Ring_theory.
-Open Local Scope positive_scope.
+Local Open Scope positive_scope.
Import RingSyntax.
Section MakeRingPol.
@@ -25,7 +21,7 @@ Section MakeRingPol.
Variable req : R -> R -> Prop.
(* Ring properties *)
- Variable Rsth : Setoid_Theory R req.
+ Variable Rsth : Equivalence req.
Variable Reqe : ring_eq_ext radd rmul ropp req.
Variable ARth : almost_ring_theory rO rI radd rmul rsub ropp req.
@@ -37,7 +33,7 @@ Section MakeRingPol.
Variable CRmorph : ring_morph rO rI radd rmul rsub ropp req
cO cI cadd cmul csub copp ceqb phi.
- (* Power coefficients *)
+ (* Power coefficients *)
Variable Cpow : Type.
Variable Cp_phi : N -> Cpow.
Variable rpow : R -> Cpow -> R.
@@ -50,26 +46,47 @@ Section MakeRingPol.
(* R notations *)
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).
+ Infix "+" := radd. Infix "*" := rmul.
+ Infix "-" := rsub. Notation "- x" := (ropp x).
+ Infix "==" := req.
+ Infix "^" := (pow_pos rmul).
(* C notations *)
- Notation "x +! y" := (cadd x y). Notation "x *! y " := (cmul x y).
- Notation "x -! y " := (csub x y). Notation "-! x" := (copp x).
- Notation " x ?=! y" := (ceqb x y). Notation "[ x ]" := (phi x).
+ Infix "+!" := cadd. Infix "*!" := cmul.
+ Infix "-! " := csub. Notation "-! x" := (copp x).
+ Infix "?=!" := ceqb. Notation "[ x ]" := (phi x).
(* Useful tactics *)
- Add Setoid R req Rsth as R_set1.
- Ltac rrefl := gen_reflexivity Rsth.
- Add Morphism radd : radd_ext. exact (Radd_ext Reqe). Qed.
- Add Morphism rmul : rmul_ext. exact (Rmul_ext Reqe). Qed.
- Add Morphism ropp : ropp_ext. exact (Ropp_ext Reqe). Qed.
- Add Morphism rsub : rsub_ext. exact (ARsub_ext Rsth Reqe ARth). Qed.
+ Add Morphism radd : radd_ext. exact (Radd_ext Reqe). Qed.
+ Add Morphism rmul : rmul_ext. exact (Rmul_ext Reqe). Qed.
+ Add Morphism ropp : ropp_ext. exact (Ropp_ext Reqe). Qed.
+ Add Morphism rsub : rsub_ext. exact (ARsub_ext Rsth Reqe ARth). Qed.
Ltac rsimpl := gen_srewrite Rsth Reqe ARth.
+
Ltac add_push := gen_add_push radd Rsth Reqe ARth.
Ltac mul_push := gen_mul_push rmul Rsth Reqe ARth.
+ Ltac add_permut_rec t :=
+ match t with
+ | ?x + ?y => add_permut_rec y || add_permut_rec x
+ | _ => add_push t; apply (Radd_ext Reqe); [|reflexivity]
+ end.
+
+ Ltac add_permut :=
+ repeat (reflexivity ||
+ match goal with |- ?t == _ => add_permut_rec t end).
+
+ Ltac mul_permut_rec t :=
+ match t with
+ | ?x * ?y => mul_permut_rec y || mul_permut_rec x
+ | _ => mul_push t; apply (Rmul_ext Reqe); [|reflexivity]
+ end.
+
+ Ltac mul_permut :=
+ repeat (reflexivity ||
+ match goal with |- ?t == _ => mul_permut_rec t end).
+
+
(* Definition of multivariable polynomials with coefficients in C :
Type [Pol] represents [X1 ... Xn].
The representation is Horner's where a [n] variable polynomial
@@ -116,19 +133,19 @@ Section MakeRingPol.
| _, _ => false
end.
- Notation " P ?== P' " := (Peq P P').
+ Infix "?==" := Peq.
Definition mkPinj j P :=
match P with
| Pc _ => P
- | Pinj j' Q => Pinj ((j + j'):positive) Q
+ | Pinj j' Q => Pinj (j + j') Q
| _ => Pinj j P
end.
Definition mkPinj_pred j P:=
match j with
| xH => P
- | xO j => Pinj (Pdouble_minus_one j) P
+ | xO j => Pinj (Pos.pred_double j) P
| xI j => Pinj (xO j) P
end.
@@ -156,14 +173,14 @@ Section MakeRingPol.
(** Addition et subtraction *)
- Fixpoint PaddC (P:Pol) (c:C) {struct P} : Pol :=
+ Fixpoint PaddC (P:Pol) (c:C) : Pol :=
match P with
| Pc c1 => Pc (c1 +! c)
| Pinj j Q => Pinj j (PaddC Q c)
| PX P i Q => PX P i (PaddC Q c)
end.
- Fixpoint PsubC (P:Pol) (c:C) {struct P} : Pol :=
+ Fixpoint PsubC (P:Pol) (c:C) : Pol :=
match P with
| Pc c1 => Pc (c1 -! c)
| Pinj j Q => Pinj j (PsubC Q c)
@@ -175,11 +192,11 @@ Section MakeRingPol.
Variable Pop : Pol -> Pol -> Pol.
Variable Q : Pol.
- Fixpoint PaddI (j:positive) (P:Pol){struct P} : Pol :=
+ Fixpoint PaddI (j:positive) (P:Pol) : Pol :=
match P with
| Pc c => mkPinj j (PaddC Q c)
| Pinj j' Q' =>
- match ZPminus j' j with
+ match Z.pos_sub j' j with
| Zpos k => mkPinj j (Pop (Pinj k Q') Q)
| Z0 => mkPinj j (Pop Q' Q)
| Zneg k => mkPinj j' (PaddI k Q')
@@ -187,16 +204,16 @@ Section MakeRingPol.
| PX P i Q' =>
match j with
| xH => PX P i (Pop Q' Q)
- | xO j => PX P i (PaddI (Pdouble_minus_one j) Q')
+ | xO j => PX P i (PaddI (Pos.pred_double j) Q')
| xI j => PX P i (PaddI (xO j) Q')
end
end.
- Fixpoint PsubI (j:positive) (P:Pol){struct P} : Pol :=
+ Fixpoint PsubI (j:positive) (P:Pol) : Pol :=
match P with
| Pc c => mkPinj j (PaddC (--Q) c)
| Pinj j' Q' =>
- match ZPminus j' j with
+ match Z.pos_sub j' j with
| Zpos k => mkPinj j (Pop (Pinj k Q') Q)
| Z0 => mkPinj j (Pop Q' Q)
| Zneg k => mkPinj j' (PsubI k Q')
@@ -204,41 +221,41 @@ Section MakeRingPol.
| PX P i Q' =>
match j with
| xH => PX P i (Pop Q' Q)
- | xO j => PX P i (PsubI (Pdouble_minus_one j) Q')
+ | xO j => PX P i (PsubI (Pos.pred_double j) Q')
| xI j => PX P i (PsubI (xO j) Q')
end
end.
Variable P' : Pol.
- Fixpoint PaddX (i':positive) (P:Pol) {struct P} : Pol :=
+ Fixpoint PaddX (i':positive) (P:Pol) : Pol :=
match P with
| Pc c => PX P' i' P
| Pinj j Q' =>
match j with
| xH => PX P' i' Q'
- | xO j => PX P' i' (Pinj (Pdouble_minus_one j) Q')
+ | xO j => PX P' i' (Pinj (Pos.pred_double j) Q')
| xI j => PX P' i' (Pinj (xO j) Q')
end
| PX P i Q' =>
- match ZPminus i i' with
+ match Z.pos_sub i i' with
| Zpos k => mkPX (Pop (PX P k P0) P') i' Q'
| Z0 => mkPX (Pop P P') i Q'
| Zneg k => mkPX (PaddX k P) i Q'
end
end.
- Fixpoint PsubX (i':positive) (P:Pol) {struct P} : Pol :=
+ Fixpoint PsubX (i':positive) (P:Pol) : Pol :=
match P with
| Pc c => PX (--P') i' P
| Pinj j Q' =>
match j with
| xH => PX (--P') i' Q'
- | xO j => PX (--P') i' (Pinj (Pdouble_minus_one j) Q')
+ | xO j => PX (--P') i' (Pinj (Pos.pred_double j) Q')
| xI j => PX (--P') i' (Pinj (xO j) Q')
end
| PX P i Q' =>
- match ZPminus i i' with
+ match Z.pos_sub i i' with
| Zpos k => mkPX (Pop (PX P k P0) P') i' Q'
| Z0 => mkPX (Pop P P') i Q'
| Zneg k => mkPX (PsubX k P) i Q'
@@ -258,18 +275,18 @@ Section MakeRingPol.
| Pinj j Q =>
match j with
| xH => PX P' i' (Padd Q Q')
- | xO j => PX P' i' (Padd (Pinj (Pdouble_minus_one j) Q) Q')
+ | xO j => PX P' i' (Padd (Pinj (Pos.pred_double j) Q) Q')
| xI j => PX P' i' (Padd (Pinj (xO j) Q) Q')
end
| PX P i Q =>
- match ZPminus i i' with
+ match Z.pos_sub i i' with
| Zpos k => mkPX (Padd (PX P k P0) P') i' (Padd Q Q')
| Z0 => mkPX (Padd P P') i (Padd Q Q')
| Zneg k => mkPX (PaddX Padd P' k P) i (Padd Q Q')
end
end
end.
- Notation "P ++ P'" := (Padd P P').
+ Infix "++" := Padd.
Fixpoint Psub (P P': Pol) {struct P'} : Pol :=
match P' with
@@ -281,22 +298,22 @@ Section MakeRingPol.
| Pinj j Q =>
match j with
| xH => PX (--P') i' (Psub Q Q')
- | xO j => PX (--P') i' (Psub (Pinj (Pdouble_minus_one j) Q) Q')
+ | xO j => PX (--P') i' (Psub (Pinj (Pos.pred_double j) Q) Q')
| xI j => PX (--P') i' (Psub (Pinj (xO j) Q) Q')
end
| PX P i Q =>
- match ZPminus i i' with
+ match Z.pos_sub i i' with
| Zpos k => mkPX (Psub (PX P k P0) P') i' (Psub Q Q')
| Z0 => mkPX (Psub P P') i (Psub Q Q')
| Zneg k => mkPX (PsubX Psub P' k P) i (Psub Q Q')
end
end
end.
- Notation "P -- P'" := (Psub P P').
+ Infix "--" := Psub.
(** Multiplication *)
- Fixpoint PmulC_aux (P:Pol) (c:C) {struct P} : Pol :=
+ Fixpoint PmulC_aux (P:Pol) (c:C) : Pol :=
match P with
| Pc c' => Pc (c' *! c)
| Pinj j Q => mkPinj j (PmulC_aux Q c)
@@ -310,11 +327,11 @@ Section MakeRingPol.
Section PmulI.
Variable Pmul : Pol -> Pol -> Pol.
Variable Q : Pol.
- Fixpoint PmulI (j:positive) (P:Pol) {struct P} : Pol :=
+ Fixpoint PmulI (j:positive) (P:Pol) : Pol :=
match P with
| Pc c => mkPinj j (PmulC Q c)
| Pinj j' Q' =>
- match ZPminus j' j with
+ match Z.pos_sub j' j with
| Zpos k => mkPinj j (Pmul (Pinj k Q') Q)
| Z0 => mkPinj j (Pmul Q' Q)
| Zneg k => mkPinj j' (PmulI k Q')
@@ -322,13 +339,12 @@ Section MakeRingPol.
| PX P' i' Q' =>
match j with
| xH => mkPX (PmulI xH P') i' (Pmul Q' Q)
- | xO j' => mkPX (PmulI j P') i' (PmulI (Pdouble_minus_one j') Q')
+ | xO j' => mkPX (PmulI j P') i' (PmulI (Pos.pred_double j') Q')
| xI j' => mkPX (PmulI j P') i' (PmulI (xO j') Q')
end
end.
End PmulI.
-(* A symmetric version of the multiplication *)
Fixpoint Pmul (P P'' : Pol) {struct P''} : Pol :=
match P'' with
@@ -341,7 +357,7 @@ Section MakeRingPol.
let QQ' :=
match j with
| xH => Pmul Q Q'
- | xO j => Pmul (Pinj (Pdouble_minus_one j) Q) Q'
+ | xO j => Pmul (Pinj (Pos.pred_double j) Q) Q'
| xI j => Pmul (Pinj (xO j) Q) Q'
end in
mkPX (Pmul P P') i' QQ'
@@ -354,25 +370,7 @@ Section MakeRingPol.
end
end.
-(* Non symmetric *)
-(*
- Fixpoint Pmul_aux (P P' : Pol) {struct P'} : Pol :=
- match P' with
- | Pc c' => PmulC P c'
- | Pinj j' Q' => PmulI Pmul_aux Q' j' P
- | PX P' i' Q' =>
- (mkPX (Pmul_aux P P') i' P0) ++ (PmulI Pmul_aux Q' xH P)
- end.
-
- Definition Pmul P P' :=
- match P with
- | Pc c => PmulC P' c
- | Pinj j Q => PmulI Pmul_aux Q j P'
- | PX P i Q =>
- (mkPX (Pmul_aux P P') i P0) ++ (PmulI Pmul_aux Q xH P')
- end.
-*)
- Notation "P ** P'" := (Pmul P P').
+ Infix "**" := Pmul.
Fixpoint Psquare (P:Pol) : Pol :=
match P with
@@ -387,26 +385,26 @@ Section MakeRingPol.
(** Monomial **)
+ (** A monomial is X1^k1...Xi^ki. Its representation
+ is a simplified version of the polynomial representation:
+
+ - [mon0] correspond to the polynom [P1].
+ - [(zmon j M)] corresponds to [(Pinj j ...)],
+ i.e. skip j variable indices.
+ - [(vmon i M)] is X^i*M with X the current variable,
+ its corresponds to (PX P1 i ...)]
+ *)
+
Inductive Mon: Set :=
- mon0: Mon
+ | mon0: Mon
| zmon: positive -> Mon -> Mon
| vmon: positive -> Mon -> Mon.
- Fixpoint Mphi(l:list R) (M: Mon) {struct M} : R :=
- match M with
- mon0 => rI
- | zmon j M1 => Mphi (jump j l) M1
- | vmon i M1 =>
- let x := hd 0 l in
- let xi := pow_pos rmul x i in
- (Mphi (tail l) M1) * xi
- end.
-
Definition mkZmon j M :=
match M with mon0 => mon0 | _ => zmon j M end.
Definition zmon_pred j M :=
- match j with xH => M | _ => mkZmon (Ppred j) M end.
+ match j with xH => M | _ => mkZmon (Pos.pred j) M end.
Definition mkVmon i M :=
match M with
@@ -421,7 +419,7 @@ Section MakeRingPol.
| Pinj j1 P1 =>
let (R,S) := CFactor P1 c in
(mkPinj j1 R, mkPinj j1 S)
- | PX P1 i Q1 =>
+ | PX P1 i Q1 =>
let (R1, S1) := CFactor P1 c in
let (R2, S2) := CFactor Q1 c in
(mkPX R1 i R2, mkPX S1 i S2)
@@ -429,10 +427,7 @@ Section MakeRingPol.
Fixpoint MFactor (P: Pol) (c: C) (M: Mon) {struct P}: Pol * Pol :=
match P, M with
- _, mon0 =>
- if (ceqb c cI) then (Pc cO, P) else
-(* if (ceqb c (copp cI)) then (Pc cO, Popp P) else Not in almost ring *)
- CFactor P c
+ _, mon0 => if (ceqb c cI) then (Pc cO, P) else CFactor P c
| Pc _, _ => (P, Pc cO)
| Pinj j1 P1, zmon j2 M1 =>
match j1 ?= j2 with
@@ -468,7 +463,7 @@ Section MakeRingPol.
| _ => Some (Padd Q1 (Pmul P2 R1))
end.
- Fixpoint PNSubst1 (P1: Pol) (cM1: C * Mon) (P2: Pol) (n: nat) {struct n}: Pol :=
+ Fixpoint PNSubst1 (P1: Pol) (cM1: C * Mon) (P2: Pol) (n: nat) : Pol :=
match POneSubst P1 cM1 P2 with
Some P3 => match n with S n1 => PNSubst1 P3 cM1 P2 n1 | _ => P3 end
| _ => P1
@@ -480,14 +475,13 @@ Section MakeRingPol.
| _ => None
end.
- Fixpoint PSubstL1 (P1: Pol) (LM1: list ((C * Mon) * Pol)) (n: nat) {struct LM1}:
- Pol :=
+ Fixpoint PSubstL1 (P1: Pol) (LM1: list ((C * Mon) * Pol)) (n: nat) : Pol :=
match LM1 with
cons (M1,P2) LM2 => PSubstL1 (PNSubst1 P1 M1 P2 n) LM2 n
| _ => P1
end.
- Fixpoint PSubstL (P1: Pol) (LM1: list ((C * Mon) * Pol)) (n: nat) {struct LM1}: option Pol :=
+ Fixpoint PSubstL (P1: Pol) (LM1: list ((C * Mon) * Pol)) (n: nat) : option Pol :=
match LM1 with
cons (M1,P2) LM2 =>
match PNSubst P1 M1 P2 n with
@@ -497,7 +491,7 @@ Section MakeRingPol.
| _ => None
end.
- Fixpoint PNSubstL (P1: Pol) (LM1: list ((C * Mon) * Pol)) (m n: nat) {struct m}: Pol :=
+ Fixpoint PNSubstL (P1: Pol) (LM1: list ((C * Mon) * Pol)) (m n: nat) : Pol :=
match PSubstL P1 LM1 n with
Some P3 => match m with S m1 => PNSubstL P3 LM1 m1 n | _ => P3 end
| _ => P1
@@ -505,658 +499,409 @@ Section MakeRingPol.
(** Evaluation of a polynomial towards R *)
- Fixpoint Pphi(l:list R) (P:Pol) {struct P} : R :=
+ Local Notation hd := (List.hd 0).
+
+ Fixpoint Pphi(l:list R) (P:Pol) : R :=
match P with
| Pc c => [c]
| Pinj j Q => Pphi (jump j l) Q
- | PX P i Q =>
- let x := hd 0 l in
- let xi := pow_pos rmul x i in
- (Pphi l P) * xi + (Pphi (tail l) Q)
+ | PX P i Q => Pphi l P * (hd l) ^ i + Pphi (tail l) Q
end.
Reserved Notation "P @ l " (at level 10, no associativity).
Notation "P @ l " := (Pphi l P).
+
+ (** Evaluation of a monomial towards R *)
+
+ Fixpoint Mphi(l:list R) (M: Mon) : R :=
+ match M with
+ | mon0 => rI
+ | zmon j M1 => Mphi (jump j l) M1
+ | vmon i M1 => Mphi (tail l) M1 * (hd l) ^ i
+ end.
+
+ Notation "M @@ l" := (Mphi l M) (at level 10, no associativity).
+
(** Proofs *)
- Lemma ZPminus_spec : forall x y,
- match ZPminus x y with
- | Z0 => x = y
- | Zpos k => x = (y + k)%positive
- | Zneg k => y = (x + k)%positive
+
+ Ltac destr_pos_sub :=
+ match goal with |- context [Z.pos_sub ?x ?y] =>
+ generalize (Z.pos_sub_discr x y); destruct (Z.pos_sub x y)
end.
+
+ Lemma jump_add' i j (l:list R) : jump (i + j) l = jump j (jump i l).
+ Proof. rewrite Pos.add_comm. apply jump_add. Qed.
+
+ Lemma Peq_ok P P' : (P ?== P') = true -> forall l, P@l == P'@ l.
Proof.
- induction x;destruct y.
- replace (ZPminus (xI x) (xI y)) with (Zdouble (ZPminus x y));trivial.
- assert (H := IHx y);destruct (ZPminus x y);unfold Zdouble;rewrite H;trivial.
- replace (ZPminus (xI x) (xO y)) with (Zdouble_plus_one (ZPminus x y));trivial.
- assert (H := IHx y);destruct (ZPminus x y);unfold Zdouble_plus_one;rewrite H;trivial.
- apply Pplus_xI_double_minus_one.
- simpl;trivial.
- replace (ZPminus (xO x) (xI y)) with (Zdouble_minus_one (ZPminus x y));trivial.
- assert (H := IHx y);destruct (ZPminus x y);unfold Zdouble_minus_one;rewrite H;trivial.
- apply Pplus_xI_double_minus_one.
- replace (ZPminus (xO x) (xO y)) with (Zdouble (ZPminus x y));trivial.
- assert (H := IHx y);destruct (ZPminus x y);unfold Zdouble;rewrite H;trivial.
- replace (ZPminus (xO x) xH) with (Zpos (Pdouble_minus_one x));trivial.
- rewrite <- Pplus_one_succ_l.
- rewrite Psucc_o_double_minus_one_eq_xO;trivial.
- replace (ZPminus xH (xI y)) with (Zneg (xO y));trivial.
- replace (ZPminus xH (xO y)) with (Zneg (Pdouble_minus_one y));trivial.
- rewrite <- Pplus_one_succ_l.
- rewrite Psucc_o_double_minus_one_eq_xO;trivial.
- simpl;trivial.
+ revert P';induction P;destruct P';simpl; intros H l; try easy.
+ - now apply (morph_eq CRmorph).
+ - destruct (Pos.compare_spec p p0); [ subst | easy | easy ].
+ now rewrite IHP.
+ - specialize (IHP1 P'1); specialize (IHP2 P'2).
+ destruct (Pos.compare_spec p p0); [ subst | easy | easy ].
+ destruct (P2 ?== P'1); [|easy].
+ rewrite H in *.
+ now rewrite IHP1, IHP2.
Qed.
- Lemma Peq_ok : forall P P',
- (P ?== P') = true -> forall l, P@l == P'@ l.
+ Lemma Peq_spec P P' :
+ BoolSpec (forall l, P@l == P'@l) True (P ?== P').
Proof.
- induction P;destruct P';simpl;intros;try discriminate;trivial.
- apply (morph_eq CRmorph);trivial.
- assert (H1 := Pos.compare_eq p p0); destruct (p ?= p0);
- try discriminate H.
- rewrite (IHP P' H); rewrite H1;trivial;rrefl.
- assert (H1 := Pos.compare_eq p p0); destruct (p ?= p0);
- try discriminate H.
- rewrite H1;trivial. clear H1.
- assert (H1 := IHP1 P'1);assert (H2 := IHP2 P'2);
- destruct (P2 ?== P'1);[destruct (P3 ?== P'2); [idtac|discriminate H]
- |discriminate H].
- rewrite (H1 H);rewrite (H2 H);rrefl.
+ generalize (Peq_ok P P'). destruct (P ?== P'); auto.
Qed.
- Lemma Pphi0 : forall l, P0@l == 0.
+ Lemma Pphi0 l : P0@l == 0.
Proof.
- intros;simpl;apply (morph0 CRmorph).
+ simpl;apply (morph0 CRmorph).
Qed.
- Lemma Pphi1 : forall l, P1@l == 1.
+ Lemma Pphi1 l : P1@l == 1.
Proof.
- intros;simpl;apply (morph1 CRmorph).
+ simpl;apply (morph1 CRmorph).
Qed.
- Lemma mkPinj_ok : forall j l P, (mkPinj j P)@l == P@(jump j l).
+ Lemma mkPinj_ok j l P : (mkPinj j P)@l == P@(jump j l).
Proof.
- intros j l p;destruct p;simpl;rsimpl.
- rewrite <-jump_Pplus;rewrite Pplus_comm;rrefl.
+ destruct P;simpl;rsimpl.
+ now rewrite jump_add'.
Qed.
- Let pow_pos_Pplus :=
- pow_pos_Pplus rmul Rsth Reqe.(Rmul_ext) ARth.(ARmul_comm) ARth.(ARmul_assoc).
+ Lemma pow_pos_add x i j : x^(j + i) == x^i * x^j.
+ Proof.
+ rewrite Pos.add_comm.
+ apply (pow_pos_add Rsth Reqe.(Rmul_ext) ARth.(ARmul_assoc)).
+ Qed.
- Lemma mkPX_ok : forall l P i Q,
- (mkPX P i Q)@l == P@l*(pow_pos rmul (hd 0 l) i) + Q@(tail l).
+ Lemma ceqb_spec c c' : BoolSpec ([c] == [c']) True (c ?=! c').
Proof.
- intros l P i Q;unfold mkPX.
- destruct P;try (simpl;rrefl).
- assert (H := morph_eq CRmorph c cO);destruct (c ?=! cO);simpl;try rrefl.
- rewrite (H (refl_equal true));rewrite (morph0 CRmorph).
- rewrite mkPinj_ok;rsimpl;simpl;rrefl.
- assert (H := @Peq_ok P3 P0);destruct (P3 ?== P0);simpl;try rrefl.
- rewrite (H (refl_equal true));trivial.
- rewrite Pphi0. rewrite pow_pos_Pplus;rsimpl.
+ generalize (morph_eq CRmorph c c').
+ destruct (c ?=! c'); auto.
Qed.
- Ltac Esimpl :=
- repeat (progress (
- match goal with
- | |- context [?P@?l] =>
- match P with
- | P0 => rewrite (Pphi0 l)
- | P1 => rewrite (Pphi1 l)
- | (mkPinj ?j ?P) => rewrite (mkPinj_ok j l P)
- | (mkPX ?P ?i ?Q) => rewrite (mkPX_ok l P i Q)
- end
- | |- context [[?c]] =>
- match c with
- | cO => rewrite (morph0 CRmorph)
- | cI => rewrite (morph1 CRmorph)
- | ?x +! ?y => rewrite ((morph_add CRmorph) x y)
- | ?x *! ?y => rewrite ((morph_mul CRmorph) x y)
- | ?x -! ?y => rewrite ((morph_sub CRmorph) x y)
- | -! ?x => rewrite ((morph_opp CRmorph) x)
- end
- end));
- rsimpl; simpl.
-
- Lemma PaddC_ok : forall c P l, (PaddC P c)@l == P@l + [c].
+ Lemma mkPX_ok l P i Q :
+ (mkPX P i Q)@l == P@l * (hd l)^i + Q@(tail l).
Proof.
- induction P;simpl;intros;Esimpl;trivial.
- rewrite IHP2;rsimpl.
+ unfold mkPX. destruct P.
+ - case ceqb_spec; intros H; simpl; try reflexivity.
+ rewrite H, (morph0 CRmorph), mkPinj_ok; rsimpl.
+ - reflexivity.
+ - case Peq_spec; intros H; simpl; try reflexivity.
+ rewrite H, Pphi0, Pos.add_comm, pow_pos_add; rsimpl.
Qed.
- Lemma PsubC_ok : forall c P l, (PsubC P c)@l == P@l - [c].
+ Hint Rewrite
+ Pphi0
+ Pphi1
+ mkPinj_ok
+ mkPX_ok
+ (morph0 CRmorph)
+ (morph1 CRmorph)
+ (morph0 CRmorph)
+ (morph_add CRmorph)
+ (morph_mul CRmorph)
+ (morph_sub CRmorph)
+ (morph_opp CRmorph)
+ : Esimpl.
+
+ (* Quicker than autorewrite with Esimpl :-) *)
+ Ltac Esimpl := try rewrite_db Esimpl; rsimpl; simpl.
+
+ Lemma PaddC_ok c P l : (PaddC P c)@l == P@l + [c].
Proof.
- induction P;simpl;intros.
- Esimpl.
- rewrite IHP;rsimpl.
+ revert l;induction P;simpl;intros;Esimpl;trivial.
rewrite IHP2;rsimpl.
Qed.
- Lemma PmulC_aux_ok : forall c P l, (PmulC_aux P c)@l == P@l * [c].
+ Lemma PsubC_ok c P l : (PsubC P c)@l == P@l - [c].
Proof.
- induction P;simpl;intros;Esimpl;trivial.
- rewrite IHP1;rewrite IHP2;rsimpl.
- mul_push ([c]);rrefl.
+ revert l;induction P;simpl;intros.
+ - Esimpl.
+ - rewrite IHP;rsimpl.
+ - rewrite IHP2;rsimpl.
Qed.
- Lemma PmulC_ok : forall c P l, (PmulC P c)@l == P@l * [c].
+ Lemma PmulC_aux_ok c P l : (PmulC_aux P c)@l == P@l * [c].
Proof.
- intros c P l; unfold PmulC.
- assert (H:= morph_eq CRmorph c cO);destruct (c ?=! cO).
- rewrite (H (refl_equal true));Esimpl.
- assert (H1:= morph_eq CRmorph c cI);destruct (c ?=! cI).
- rewrite (H1 (refl_equal true));Esimpl.
- apply PmulC_aux_ok.
+ revert l;induction P;simpl;intros;Esimpl;trivial.
+ rewrite IHP1, IHP2;rsimpl. add_permut. mul_permut.
Qed.
- Lemma Popp_ok : forall P l, (--P)@l == - P@l.
+ Lemma PmulC_ok c P l : (PmulC P c)@l == P@l * [c].
Proof.
- induction P;simpl;intros.
- Esimpl.
- apply IHP.
- rewrite IHP1;rewrite IHP2;rsimpl.
+ unfold PmulC.
+ case ceqb_spec; intros H.
+ - rewrite H; Esimpl.
+ - case ceqb_spec; intros H'.
+ + rewrite H'; Esimpl.
+ + apply PmulC_aux_ok.
Qed.
- Ltac Esimpl2 :=
- Esimpl;
- repeat (progress (
- match goal with
- | |- context [(PaddC ?P ?c)@?l] => rewrite (PaddC_ok c P l)
- | |- context [(PsubC ?P ?c)@?l] => rewrite (PsubC_ok c P l)
- | |- context [(PmulC ?P ?c)@?l] => rewrite (PmulC_ok c P l)
- | |- context [(--?P)@?l] => rewrite (Popp_ok P l)
- end)); Esimpl.
-
- Lemma Padd_ok : forall P' P l, (P ++ P')@l == P@l + P'@l.
+ Lemma Popp_ok P l : (--P)@l == - P@l.
Proof.
- induction P';simpl;intros;Esimpl2.
- generalize P p l;clear P p l.
- induction P;simpl;intros.
- Esimpl2;apply (ARadd_comm ARth).
- assert (H := ZPminus_spec p p0);destruct (ZPminus p p0).
- rewrite H;Esimpl. rewrite IHP';rrefl.
- rewrite H;Esimpl. rewrite IHP';Esimpl.
- rewrite <- jump_Pplus;rewrite Pplus_comm;rrefl.
- rewrite H;Esimpl. rewrite IHP.
- rewrite <- jump_Pplus;rewrite Pplus_comm;rrefl.
- destruct p0;simpl.
- rewrite IHP2;simpl;rsimpl.
- rewrite IHP2;simpl.
- rewrite jump_Pdouble_minus_one;rsimpl.
- rewrite IHP';rsimpl.
- destruct P;simpl.
- Esimpl2;add_push [c];rrefl.
- destruct p0;simpl;Esimpl2.
- rewrite IHP'2;simpl.
- rsimpl;add_push (P'1@l * (pow_pos rmul (hd 0 l) p));rrefl.
- rewrite IHP'2;simpl.
- rewrite jump_Pdouble_minus_one;rsimpl;add_push (P'1@l * (pow_pos rmul (hd 0 l) p));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 @ (tail l));rewrite H;rrefl.
- rewrite IHP'1;rewrite IHP'2;simpl;Esimpl.
- rewrite H;rewrite Pplus_comm.
- rewrite pow_pos_Pplus;rsimpl.
- add_push (P3 @ (tail l));rrefl.
- assert (forall P k l,
- (PaddX Padd P'1 k P) @ l == P@l + P'1@l * pow_pos rmul (hd 0 l) k).
- induction P;simpl;intros;try apply (ARadd_comm ARth).
- destruct p2;simpl;try apply (ARadd_comm ARth).
- rewrite jump_Pdouble_minus_one;apply (ARadd_comm ARth).
- assert (H1 := ZPminus_spec p2 k);destruct (ZPminus p2 k);Esimpl2.
- rewrite IHP'1;rsimpl; rewrite H1;add_push (P5 @ (tail l0));rrefl.
- rewrite IHP'1;simpl;Esimpl.
- rewrite H1;rewrite Pplus_comm.
- rewrite pow_pos_Pplus;simpl;Esimpl.
- add_push (P5 @ (tail l0));rrefl.
- rewrite IHP1;rewrite H1;rewrite Pplus_comm.
- rewrite pow_pos_Pplus;simpl;rsimpl.
- add_push (P5 @ (tail l0));rrefl.
- rewrite H0;rsimpl.
- add_push (P3 @ (tail l)).
- rewrite H;rewrite Pplus_comm.
- rewrite IHP'2;rewrite pow_pos_Pplus;rsimpl.
- add_push (P3 @ (tail l));rrefl.
+ revert l;induction P;simpl;intros.
+ - Esimpl.
+ - apply IHP.
+ - rewrite IHP1, IHP2;rsimpl.
Qed.
- Lemma Psub_ok : forall P' P l, (P -- P')@l == P@l - P'@l.
+ Hint Rewrite PaddC_ok PsubC_ok PmulC_ok Popp_ok : Esimpl.
+
+ Lemma PaddX_ok P' P k l :
+ (forall P l, (P++P')@l == P@l + P'@l) ->
+ (PaddX Padd P' k P) @ l == P@l + P'@l * (hd l)^k.
Proof.
- induction P';simpl;intros;Esimpl2;trivial.
- generalize P p l;clear P p l.
- induction P;simpl;intros.
- Esimpl2;apply (ARadd_comm ARth).
- assert (H := ZPminus_spec p p0);destruct (ZPminus p p0).
- rewrite H;Esimpl. rewrite IHP';rsimpl.
- rewrite H;Esimpl. rewrite IHP';Esimpl.
- rewrite <- jump_Pplus;rewrite Pplus_comm;rrefl.
- rewrite H;Esimpl. rewrite IHP.
- rewrite <- jump_Pplus;rewrite Pplus_comm;rrefl.
- destruct p0;simpl.
- rewrite IHP2;simpl;rsimpl.
- rewrite IHP2;simpl.
- rewrite jump_Pdouble_minus_one;rsimpl.
- rewrite IHP';rsimpl.
- destruct P;simpl.
- 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_pos rmul (hd 0 l) p));trivial.
- 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_pos rmul (hd 0 l) p));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 @ (tail l));rewrite H;rrefl.
- rewrite IHP'1; rewrite IHP'2;rsimpl;simpl;Esimpl.
- rewrite H;rewrite Pplus_comm.
- rewrite pow_pos_Pplus;rsimpl.
- add_push (P3 @ (tail l));rrefl.
- assert (forall P k l,
- (PsubX Psub P'1 k P) @ l == P@l + - P'1@l * pow_pos rmul (hd 0 l) k).
- induction P;simpl;intros.
- rewrite Popp_ok;rsimpl;apply (ARadd_comm ARth);trivial.
- destruct p2;simpl;rewrite Popp_ok;rsimpl.
- apply (ARadd_comm ARth);trivial.
- rewrite jump_Pdouble_minus_one;apply (ARadd_comm ARth);trivial.
- apply (ARadd_comm ARth);trivial.
- assert (H1 := ZPminus_spec p2 k);destruct (ZPminus p2 k);Esimpl2;rsimpl.
- rewrite IHP'1;rsimpl;add_push (P5 @ (tail l0));rewrite H1;rrefl.
- rewrite IHP'1;rewrite H1;rewrite Pplus_comm.
- rewrite pow_pos_Pplus;simpl;Esimpl.
- add_push (P5 @ (tail l0));rrefl.
- rewrite IHP1;rewrite H1;rewrite Pplus_comm.
- rewrite pow_pos_Pplus;simpl;rsimpl.
- add_push (P5 @ (tail l0));rrefl.
- rewrite H0;rsimpl.
- rewrite IHP'2;rsimpl;add_push (P3 @ (tail l)).
- rewrite H;rewrite Pplus_comm.
- rewrite pow_pos_Pplus;rsimpl.
+ intros IHP'.
+ revert k l. induction P;simpl;intros.
+ - add_permut.
+ - destruct p; simpl;
+ rewrite ?jump_pred_double; add_permut.
+ - destr_pos_sub; intros ->;Esimpl.
+ + rewrite IHP';rsimpl. add_permut.
+ + rewrite IHP', pow_pos_add;simpl;Esimpl. add_permut.
+ + rewrite IHP1, pow_pos_add;rsimpl. add_permut.
Qed.
-(* Proof for the symmetriv version *)
- Lemma PmulI_ok :
- forall P',
- (forall (P : Pol) (l : list R), (Pmul P P') @ l == P @ l * P' @ l) ->
- forall (P : Pol) (p : positive) (l : list R),
- (PmulI Pmul P' p P) @ l == P @ l * P' @ (jump p l).
+ Lemma Padd_ok P' P l : (P ++ P')@l == P@l + P'@l.
Proof.
- induction P;simpl;intros.
- Esimpl2;apply (ARmul_comm ARth).
- assert (H1 := ZPminus_spec p p0);destruct (ZPminus p p0);Esimpl2.
- rewrite H1; rewrite H;rrefl.
- rewrite H1; rewrite H.
- rewrite Pplus_comm.
- rewrite jump_Pplus;simpl;rrefl.
- rewrite H1;rewrite Pplus_comm.
- rewrite jump_Pplus;rewrite IHP;rrefl.
- destruct p0;Esimpl2.
- rewrite IHP1;rewrite IHP2;simpl;rsimpl.
- mul_push (pow_pos rmul (hd 0 l) p);rrefl.
- rewrite IHP1;rewrite IHP2;simpl;rsimpl.
- mul_push (pow_pos rmul (hd 0 l) p); rewrite jump_Pdouble_minus_one;rrefl.
- rewrite IHP1;simpl;rsimpl.
- mul_push (pow_pos rmul (hd 0 l) p).
- rewrite H;rrefl.
+ revert P l; induction P';simpl;intros;Esimpl.
+ - revert p l; induction P;simpl;intros.
+ + Esimpl; add_permut.
+ + destr_pos_sub; intros ->;Esimpl.
+ * now rewrite IHP'.
+ * rewrite IHP';Esimpl. now rewrite jump_add'.
+ * rewrite IHP. now rewrite jump_add'.
+ + destruct p0;simpl.
+ * rewrite IHP2;simpl. rsimpl.
+ * rewrite IHP2;simpl. rewrite jump_pred_double. rsimpl.
+ * rewrite IHP'. rsimpl.
+ - destruct P;simpl.
+ + Esimpl. add_permut.
+ + destruct p0;simpl;Esimpl; rewrite IHP'2; simpl.
+ * rsimpl. add_permut.
+ * rewrite jump_pred_double. rsimpl. add_permut.
+ * rsimpl. add_permut.
+ + destr_pos_sub; intros ->; Esimpl.
+ * rewrite IHP'1, IHP'2;rsimpl. add_permut.
+ * rewrite IHP'1, IHP'2;simpl;Esimpl.
+ rewrite pow_pos_add;rsimpl. add_permut.
+ * rewrite PaddX_ok by trivial; rsimpl.
+ rewrite IHP'2, pow_pos_add; rsimpl. add_permut.
Qed.
-(*
- Lemma PmulI_ok :
- forall P',
- (forall (P : Pol) (l : list R), (Pmul_aux P P') @ l == P @ l * P' @ l) ->
- forall (P : Pol) (p : positive) (l : list R),
- (PmulI Pmul_aux P' p P) @ l == P @ l * P' @ (jump p l).
+ Lemma PsubX_ok P' P k l :
+ (forall P l, (P--P')@l == P@l - P'@l) ->
+ (PsubX Psub P' k P) @ l == P@l - P'@l * (hd l)^k.
Proof.
- induction P;simpl;intros.
- Esimpl2;apply (ARmul_comm ARth).
- assert (H1 := ZPminus_spec p p0);destruct (ZPminus p p0);Esimpl2.
- rewrite H1; rewrite H;rrefl.
- rewrite H1; rewrite H.
- rewrite Pplus_comm.
- rewrite jump_Pplus;simpl;rrefl.
- rewrite H1;rewrite Pplus_comm.
- rewrite jump_Pplus;rewrite IHP;rrefl.
- destruct p0;Esimpl2.
- rewrite IHP1;rewrite IHP2;simpl;rsimpl.
- mul_push (pow_pos rmul (hd 0 l) p);rrefl.
- rewrite IHP1;rewrite IHP2;simpl;rsimpl.
- mul_push (pow_pos rmul (hd 0 l) p); rewrite jump_Pdouble_minus_one;rrefl.
- rewrite IHP1;simpl;rsimpl.
- mul_push (pow_pos rmul (hd 0 l) p).
- rewrite H;rrefl.
+ intros IHP'.
+ revert k l. induction P;simpl;intros.
+ - rewrite Popp_ok;rsimpl; add_permut.
+ - destruct p; simpl;
+ rewrite Popp_ok;rsimpl;
+ rewrite ?jump_pred_double; add_permut.
+ - destr_pos_sub; intros ->; Esimpl.
+ + rewrite IHP';rsimpl. add_permut.
+ + rewrite IHP', pow_pos_add;simpl;Esimpl. add_permut.
+ + rewrite IHP1, pow_pos_add;rsimpl. add_permut.
Qed.
- Lemma Pmul_aux_ok : forall P' P l,(Pmul_aux P P')@l == P@l * P'@l.
+ Lemma Psub_ok P' P l : (P -- P')@l == P@l - P'@l.
Proof.
- induction P';simpl;intros.
- Esimpl2;trivial.
- apply PmulI_ok;trivial.
- rewrite Padd_ok;Esimpl2.
- rewrite (PmulI_ok P'2 IHP'2). rewrite IHP'1. rrefl.
+ revert P l; induction P';simpl;intros;Esimpl.
+ - revert p l; induction P;simpl;intros.
+ + Esimpl; add_permut.
+ + destr_pos_sub; intros ->;Esimpl.
+ * rewrite IHP';rsimpl.
+ * rewrite IHP';Esimpl. now rewrite jump_add'.
+ * rewrite IHP. now rewrite jump_add'.
+ + destruct p0;simpl.
+ * rewrite IHP2;simpl. rsimpl.
+ * rewrite IHP2;simpl. rewrite jump_pred_double. rsimpl.
+ * rewrite IHP'. rsimpl.
+ - destruct P;simpl.
+ + Esimpl; add_permut.
+ + destruct p0;simpl;Esimpl; rewrite IHP'2; simpl.
+ * rsimpl. add_permut.
+ * rewrite jump_pred_double. rsimpl. add_permut.
+ * rsimpl. add_permut.
+ + destr_pos_sub; intros ->; Esimpl.
+ * rewrite IHP'1, IHP'2;rsimpl. add_permut.
+ * rewrite IHP'1, IHP'2;simpl;Esimpl.
+ rewrite pow_pos_add;rsimpl. add_permut.
+ * rewrite PsubX_ok by trivial;rsimpl.
+ rewrite IHP'2, pow_pos_add;rsimpl. add_permut.
Qed.
-*)
-(* Proof for the symmetric version *)
- Lemma Pmul_ok : forall P P' l, (P**P')@l == P@l * P'@l.
+ Lemma PmulI_ok P' :
+ (forall P l, (Pmul P P') @ l == P @ l * P' @ l) ->
+ forall P p l, (PmulI Pmul P' p P) @ l == P @ l * P' @ (jump p l).
Proof.
- intros P P';generalize P;clear P;induction P';simpl;intros.
- apply PmulC_ok. apply PmulI_ok;trivial.
- destruct P.
- rewrite (ARmul_comm ARth);Esimpl2;Esimpl2.
- Esimpl2. rewrite IHP'1;Esimpl2.
- assert (match p0 with
- | xI j => Pinj (xO j) P ** P'2
- | xO j => Pinj (Pdouble_minus_one j) P ** P'2
- | 1 => P ** P'2
- end @ (tail l) == P @ (jump p0 l) * P'2 @ (tail l)).
- destruct p0;simpl;rewrite IHP'2;Esimpl.
- rewrite jump_Pdouble_minus_one;Esimpl.
- rewrite H;Esimpl.
- rewrite Padd_ok; Esimpl2. rewrite Padd_ok; Esimpl2.
- repeat (rewrite IHP'1 || rewrite IHP'2);simpl.
- rewrite PmulI_ok;trivial.
- mul_push (P'1@l). simpl. mul_push (P'2 @ (tail l)). Esimpl.
+ intros IHP'.
+ induction P;simpl;intros.
+ - Esimpl; mul_permut.
+ - destr_pos_sub; intros ->;Esimpl.
+ + now rewrite IHP'.
+ + now rewrite IHP', jump_add'.
+ + now rewrite IHP, jump_add'.
+ - destruct p0;Esimpl; rewrite ?IHP1, ?IHP2; rsimpl.
+ + f_equiv. mul_permut.
+ + rewrite jump_pred_double. f_equiv. mul_permut.
+ + rewrite IHP'. f_equiv. mul_permut.
Qed.
-(*
-Lemma Pmul_ok : forall P P' l, (P**P')@l == P@l * P'@l.
+ Lemma Pmul_ok P P' l : (P**P')@l == P@l * P'@l.
Proof.
- destruct P;simpl;intros.
- Esimpl2;apply (ARmul_comm ARth).
- rewrite (PmulI_ok P (Pmul_aux_ok P)).
- apply (ARmul_comm ARth).
- rewrite Padd_ok; Esimpl2.
- rewrite (PmulI_ok P3 (Pmul_aux_ok P3));trivial.
- rewrite Pmul_aux_ok;mul_push (P' @ l).
- rewrite (ARmul_comm ARth (P' @ l));rrefl.
+ revert P l;induction P';simpl;intros.
+ - apply PmulC_ok.
+ - apply PmulI_ok;trivial.
+ - destruct P.
+ + rewrite (ARmul_comm ARth). Esimpl.
+ + Esimpl. f_equiv. rewrite IHP'1; Esimpl.
+ destruct p0;rewrite IHP'2;Esimpl.
+ rewrite jump_pred_double; Esimpl.
+ + rewrite Padd_ok, !mkPX_ok, Padd_ok, !mkPX_ok,
+ !IHP'1, !IHP'2, PmulI_ok; trivial. simpl. Esimpl.
+ add_permut; f_equiv; mul_permut.
Qed.
-*)
- Lemma Psquare_ok : forall P l, (Psquare P)@l == P@l * P@l.
+ Lemma Psquare_ok P l : (Psquare P)@l == P@l * P@l.
Proof.
- induction P;simpl;intros;Esimpl2.
- apply IHP. rewrite Padd_ok. rewrite Pmul_ok;Esimpl2.
- rewrite IHP1;rewrite IHP2.
- mul_push (pow_pos rmul (hd 0 l) p). mul_push (P2@l).
- rrefl.
+ revert l;induction P;simpl;intros;Esimpl.
+ - apply IHP.
+ - rewrite Padd_ok, Pmul_ok;Esimpl.
+ rewrite IHP1, IHP2.
+ mul_push ((hd l)^p). now mul_push (P2@l).
Qed.
-
- Lemma mkZmon_ok: forall M j l,
- Mphi l (mkZmon j M) == Mphi l (zmon j M).
- intros M j l; case M; simpl; intros; rsimpl.
+ Lemma mkZmon_ok M j l :
+ (mkZmon j M) @@ l == (zmon j M) @@ l.
+ Proof.
+ destruct M; simpl; rsimpl.
Qed.
- Lemma zmon_pred_ok : forall M j l,
- Mphi (tail l) (zmon_pred j M) == Mphi l (zmon j M).
+ Lemma zmon_pred_ok M j l :
+ (zmon_pred j M) @@ (tail l) == (zmon j M) @@ l.
Proof.
- destruct j; simpl;intros auto; rsimpl.
- rewrite mkZmon_ok;rsimpl.
- rewrite mkZmon_ok;simpl. rewrite jump_Pdouble_minus_one; rsimpl.
+ destruct j; simpl; rewrite ?mkZmon_ok; simpl; rsimpl.
+ rewrite jump_pred_double; rsimpl.
Qed.
- Lemma mkVmon_ok : forall M i l, Mphi l (mkVmon i M) == Mphi l M*pow_pos rmul (hd 0 l) i.
+ Lemma mkVmon_ok M i l :
+ (mkVmon i M)@@l == M@@l * (hd l)^i.
Proof.
destruct M;simpl;intros;rsimpl.
- rewrite zmon_pred_ok;simpl;rsimpl.
- rewrite Pplus_comm;rewrite pow_pos_Pplus;rsimpl.
+ - rewrite zmon_pred_ok;simpl;rsimpl.
+ - rewrite pow_pos_add;rsimpl.
Qed.
- Lemma Mcphi_ok: forall P c l,
- let (Q,R) := CFactor P c in
- P@l == Q@l + (phi c) * (R@l).
+ Ltac destr_factor := match goal with
+ | H : context [CFactor ?P _] |- context [CFactor ?P ?c] =>
+ destruct (CFactor P c); destr_factor; rewrite H; clear H
+ | H : context [MFactor ?P _ _] |- context [MFactor ?P ?c ?M] =>
+ specialize (H M); destruct (MFactor P c M); destr_factor; rewrite H; clear H
+ | _ => idtac
+ end.
+
+ Lemma Mcphi_ok P c l :
+ let (Q,R) := CFactor P c in
+ P@l == Q@l + [c] * R@l.
Proof.
- intros P; elim P; simpl; auto; clear P.
- intros c c1 l; generalize (div_th.(div_eucl_th) c c1); case cdiv.
- intros q r H; rewrite H.
- Esimpl.
- rewrite (ARadd_comm ARth); rsimpl.
- intros i P Hrec c l.
- generalize (Hrec c (jump i l)); case CFactor.
- intros R1 S1; Esimpl; auto.
- intros Q1 Qrec i R1 Rrec c l.
- generalize (Qrec c l); case CFactor; intros S1 S2 HS.
- generalize (Rrec c (tail l)); case CFactor; intros S3 S4 HS1.
- rewrite HS; rewrite HS1; Esimpl.
- apply (Radd_ext Reqe); rsimpl.
- repeat rewrite <- (ARadd_assoc ARth).
- apply (Radd_ext Reqe); rsimpl.
- rewrite (ARadd_comm ARth); rsimpl.
+ revert l.
+ induction P as [c0 | j P IH | P1 IH1 i P2 IH2]; intros l; Esimpl.
+ - assert (H := div_th.(div_eucl_th) c0 c).
+ destruct cdiv as (q,r). rewrite H; Esimpl. add_permut.
+ - destr_factor. Esimpl.
+ - destr_factor. Esimpl. add_permut.
Qed.
- Lemma Mphi_ok: forall P (cM: C * Mon) l,
- let (c,M) := cM in
- let (Q,R) := MFactor P c M in
- P@l == Q@l + (phi c) * (Mphi l M) * (R@l).
+ Lemma Mphi_ok P (cM: C * Mon) l :
+ let (c,M) := cM in
+ let (Q,R) := MFactor P c M in
+ P@l == Q@l + [c] * M@@l * R@l.
Proof.
- intros P; elim P; simpl; auto; clear P.
- intros c (c1, M) l; case M; simpl; auto.
- assert (H1:= morph_eq CRmorph c1 cI);destruct (c1 ?=! cI).
- rewrite (H1 (refl_equal true));Esimpl.
- try rewrite (morph0 CRmorph); rsimpl.
- generalize (div_th.(div_eucl_th) c c1); case (cdiv c c1).
- intros q r H; rewrite H; clear H H1.
- Esimpl.
- rewrite (ARadd_comm ARth); rsimpl.
- intros p m; Esimpl.
- intros p m; Esimpl.
- intros i P Hrec (c,M) l; case M; simpl; clear M.
- assert (H1:= morph_eq CRmorph c cI);destruct (c ?=! cI).
- rewrite (H1 (refl_equal true));Esimpl.
- Esimpl.
- generalize (Mcphi_ok P c (jump i l)); case CFactor.
- intros R1 Q1 HH; rewrite HH; Esimpl.
- intros j M.
- case_eq (i ?= j); intros He; simpl.
- rewrite (Pos.compare_eq _ _ He).
- generalize (Hrec (c, M) (jump j l)); case (MFactor P c M);
- simpl; intros P2 Q2 H; repeat rewrite mkPinj_ok; auto.
- generalize (Hrec (c, (zmon (j -i) M)) (jump i l));
- case (MFactor P c (zmon (j -i) M)); simpl.
- intros P2 Q2 H; repeat rewrite mkPinj_ok; auto.
- rewrite <- (Pplus_minus _ _ (ZC2 _ _ He)).
- rewrite Pplus_comm; rewrite jump_Pplus; auto.
- rewrite (morph0 CRmorph); rsimpl.
- intros P2 m; rewrite (morph0 CRmorph); rsimpl.
-
- intros P2 Hrec1 i Q2 Hrec2 (c, M) l; case M; simpl; auto.
- assert (H1:= morph_eq CRmorph c cI);destruct (c ?=! cI).
- rewrite (H1 (refl_equal true));Esimpl.
- Esimpl.
- generalize (Mcphi_ok P2 c l); case CFactor.
- intros S1 S2 HS.
- generalize (Mcphi_ok Q2 c (tail l)); case CFactor.
- intros S3 S4 HS1; Esimpl; rewrite HS; rewrite HS1.
- rsimpl.
- apply (Radd_ext Reqe); rsimpl.
- repeat rewrite <- (ARadd_assoc ARth).
- apply (Radd_ext Reqe); rsimpl.
- rewrite (ARadd_comm ARth); rsimpl.
- intros j M1.
- generalize (Hrec1 (c,zmon j M1) l);
- case (MFactor P2 c (zmon j M1)).
- intros R1 S1 H1.
- generalize (Hrec2 (c, zmon_pred j M1) (List.tail l));
- case (MFactor Q2 c (zmon_pred j M1)); simpl.
- intros R2 S2 H2; rewrite H1; rewrite H2.
- repeat rewrite mkPX_ok; simpl.
- rsimpl.
- apply radd_ext; rsimpl.
- rewrite (ARadd_comm ARth); rsimpl.
- apply radd_ext; rsimpl.
- rewrite (ARadd_comm ARth); rsimpl.
- rewrite zmon_pred_ok;rsimpl.
- intros j M1.
- case_eq (i ?= j); intros He; simpl.
- rewrite (Pos.compare_eq _ _ He).
- generalize (Hrec1 (c, mkZmon xH M1) l); case (MFactor P2 c (mkZmon xH M1));
- simpl; intros P3 Q3 H; repeat rewrite mkPinj_ok; auto.
- rewrite H; rewrite mkPX_ok; rsimpl.
- repeat (rewrite <-(ARadd_assoc ARth)).
- apply radd_ext; rsimpl.
- rewrite (ARadd_comm ARth); rsimpl.
- apply radd_ext; rsimpl.
- repeat (rewrite <-(ARmul_assoc ARth)).
- rewrite mkZmon_ok.
- apply rmul_ext; rsimpl.
- repeat (rewrite <-(ARmul_assoc ARth)).
- apply rmul_ext; rsimpl.
- rewrite (ARmul_comm ARth); rsimpl.
- generalize (Hrec1 (c, vmon (j - i) M1) l);
- case (MFactor P2 c (vmon (j - i) M1));
- simpl; intros P3 Q3 H; repeat rewrite mkPinj_ok; auto.
- rewrite H; rsimpl; repeat rewrite mkPinj_ok; auto.
- rewrite mkPX_ok; rsimpl.
- repeat (rewrite <-(ARadd_assoc ARth)).
- apply radd_ext; rsimpl.
- rewrite (ARadd_comm ARth); rsimpl.
- apply radd_ext; rsimpl.
- repeat (rewrite <-(ARmul_assoc ARth)).
- apply rmul_ext; rsimpl.
- rewrite (ARmul_comm ARth); rsimpl.
- apply rmul_ext; rsimpl.
- rewrite <- (ARmul_comm ARth (Mphi (tail l) M1)); rsimpl.
- repeat (rewrite <-(ARmul_assoc ARth)).
- apply rmul_ext; rsimpl.
- rewrite <- pow_pos_Pplus.
- rewrite (Pplus_minus _ _ (ZC2 _ _ He)); rsimpl.
- generalize (Hrec1 (c, mkZmon 1 M1) l);
- case (MFactor P2 c (mkZmon 1 M1));
- simpl; intros P3 Q3 H; repeat rewrite mkPinj_ok; auto.
- rewrite H; rsimpl.
- rewrite mkPX_ok; rsimpl.
- repeat (rewrite <-(ARadd_assoc ARth)).
- apply radd_ext; rsimpl.
- rewrite (ARadd_comm ARth); rsimpl.
- apply radd_ext; rsimpl.
- rewrite mkZmon_ok.
- repeat (rewrite <-(ARmul_assoc ARth)).
- apply rmul_ext; rsimpl.
- rewrite (ARmul_comm ARth); rsimpl.
- rewrite mkPX_ok; simpl; rsimpl.
- rewrite (morph0 CRmorph); rsimpl.
- repeat (rewrite <-(ARmul_assoc ARth)).
- rewrite (ARmul_comm ARth (Q3@l)); rsimpl.
- apply rmul_ext; rsimpl.
- rewrite (ARmul_comm ARth); rsimpl.
- repeat (rewrite <- (ARmul_assoc ARth)).
- apply rmul_ext; rsimpl.
- rewrite <- pow_pos_Pplus.
- rewrite (Pplus_minus _ _ He); rsimpl.
+ destruct cM as (c,M). revert M l.
+ induction P; destruct M; intros l; simpl; auto;
+ try (case ceqb_spec; intro He);
+ try (case Pos.compare_spec; intros He); rewrite ?He;
+ destr_factor; simpl; Esimpl.
+ - assert (H := div_th.(div_eucl_th) c0 c).
+ destruct cdiv as (q,r). rewrite H; Esimpl. add_permut.
+ - assert (H := Mcphi_ok P c). destr_factor. Esimpl.
+ - now rewrite <- jump_add, Pos.sub_add.
+ - assert (H2 := Mcphi_ok P2 c). assert (H3 := Mcphi_ok P3 c).
+ destr_factor. Esimpl. add_permut.
+ - rewrite zmon_pred_ok. simpl. add_permut.
+ - rewrite mkZmon_ok. simpl. add_permut. mul_permut.
+ - add_permut. mul_permut.
+ rewrite <- pow_pos_add, Pos.add_comm, Pos.sub_add by trivial; rsimpl.
+ - rewrite mkZmon_ok. simpl. Esimpl. add_permut. mul_permut.
+ rewrite <- pow_pos_add, Pos.sub_add by trivial; rsimpl.
Qed.
-(* Proof for the symmetric version *)
-
- Lemma POneSubst_ok: forall P1 M1 P2 P3 l,
- POneSubst P1 M1 P2 = Some P3 -> phi (fst M1) * Mphi l (snd M1) == P2@l -> P1@l == P3@l.
+ Lemma POneSubst_ok P1 cM1 P2 P3 l :
+ POneSubst P1 cM1 P2 = Some P3 ->
+ [fst cM1] * (snd cM1)@@l == P2@l -> P1@l == P3@l.
Proof.
- intros P2 (cc,M1) P3 P4 l; unfold POneSubst.
- generalize (Mphi_ok P2 (cc, M1) l); case (MFactor P2 cc M1); simpl; auto.
- intros Q1 R1; case R1.
- intros c H; rewrite H.
- generalize (morph_eq CRmorph c cO);
- case (c ?=! cO); simpl; auto.
- intros H1 H2; rewrite H1; auto; rsimpl.
- discriminate.
- intros _ H1 H2; injection H1; intros; subst.
- rewrite H2; rsimpl.
- (* new version *)
- rewrite Padd_ok; rewrite PmulC_ok; rsimpl.
- intros i P5 H; rewrite H.
- intros HH H1; injection HH; intros; subst; rsimpl.
- rewrite Padd_ok; rewrite PmulI_ok by (intros;apply Pmul_ok). rewrite H1; rsimpl.
- intros i P5 P6 H1 H2 H3; rewrite H1; rewrite H3.
- assert (P4 = Q1 ++ P3 ** PX i P5 P6).
- injection H2; intros; subst;trivial.
- rewrite H;rewrite Padd_ok;rewrite Pmul_ok;rsimpl.
- Qed.
-(*
- Lemma POneSubst_ok: forall P1 M1 P2 P3 l,
- POneSubst P1 M1 P2 = Some P3 -> Mphi l M1 == P2@l -> P1@l == P3@l.
-Proof.
- intros P2 M1 P3 P4 l; unfold POneSubst.
- generalize (Mphi_ok P2 M1 l); case (MFactor P2 M1); simpl; auto.
- intros Q1 R1; case R1.
- intros c H; rewrite H.
- generalize (morph_eq CRmorph c cO);
- case (c ?=! cO); simpl; auto.
- intros H1 H2; rewrite H1; auto; rsimpl.
- discriminate.
- intros _ H1 H2; injection H1; intros; subst.
- rewrite H2; rsimpl.
- rewrite Padd_ok; rewrite Pmul_ok; rsimpl.
- intros i P5 H; rewrite H.
- intros HH H1; injection HH; intros; subst; rsimpl.
- rewrite Padd_ok; rewrite Pmul_ok. rewrite H1; rsimpl.
- intros i P5 P6 H1 H2 H3; rewrite H1; rewrite H3.
- injection H2; intros; subst; rsimpl.
- rewrite Padd_ok.
- rewrite Pmul_ok; rsimpl.
+ destruct cM1 as (cc,M1).
+ unfold POneSubst.
+ assert (H := Mphi_ok P1 (cc, M1) l). simpl in H.
+ destruct MFactor as (R1,S1); simpl. rewrite H. clear H.
+ intros EQ EQ'. replace P3 with (R1 ++ P2 ** S1).
+ - rewrite EQ', Padd_ok, Pmul_ok; rsimpl.
+ - revert EQ. destruct S1; try now injection 1.
+ case ceqb_spec; now inversion 2.
Qed.
-*)
- Lemma PNSubst1_ok: forall n P1 M1 P2 l,
- [fst M1] * Mphi l (snd M1) == P2@l -> P1@l == (PNSubst1 P1 M1 P2 n)@l.
+
+ Lemma PNSubst1_ok n P1 cM1 P2 l :
+ [fst cM1] * (snd cM1)@@l == P2@l ->
+ P1@l == (PNSubst1 P1 cM1 P2 n)@l.
Proof.
- intros n; elim n; simpl; auto.
- intros P2 M1 P3 l H.
- generalize (fun P4 => @POneSubst_ok P2 M1 P3 P4 l);
- case (POneSubst P2 M1 P3); [idtac | intros; rsimpl].
- intros P4 Hrec; rewrite (Hrec P4); auto; rsimpl.
- intros n1 Hrec P2 M1 P3 l H.
- generalize (fun P4 => @POneSubst_ok P2 M1 P3 P4 l);
- case (POneSubst P2 M1 P3); [idtac | intros; rsimpl].
- intros P4 Hrec1; rewrite (Hrec1 P4); auto; rsimpl.
+ revert P1. induction n; simpl; intros P1;
+ generalize (POneSubst_ok P1 cM1 P2); destruct POneSubst;
+ intros; rewrite <- ?IHn; auto; reflexivity.
Qed.
- Lemma PNSubst_ok: forall n P1 M1 P2 l P3,
- PNSubst P1 M1 P2 n = Some P3 -> [fst M1] * Mphi l (snd M1) == P2@l -> P1@l == P3@l.
+ Lemma PNSubst_ok n P1 cM1 P2 l P3 :
+ PNSubst P1 cM1 P2 n = Some P3 ->
+ [fst cM1] * (snd cM1)@@l == P2@l -> P1@l == P3@l.
Proof.
- intros n P2 (cc, M1) P3 l P4; unfold PNSubst.
- generalize (fun P4 => @POneSubst_ok P2 (cc,M1) P3 P4 l);
- case (POneSubst P2 (cc,M1) P3); [idtac | intros; discriminate].
- intros P5 H1; case n; try (intros; discriminate).
- intros n1 H2; injection H2; intros; subst.
- rewrite <- PNSubst1_ok; auto.
+ unfold PNSubst.
+ assert (H := POneSubst_ok P1 cM1 P2); destruct POneSubst; try discriminate.
+ destruct n; inversion_clear 1.
+ intros. rewrite <- PNSubst1_ok; auto.
Qed.
- Fixpoint MPcond (LM1: list (C * Mon * Pol)) (l: list R) {struct LM1} : Prop :=
- match LM1 with
- cons (M1,P2) LM2 => ([fst M1] * Mphi l (snd M1) == P2@l) /\ (MPcond LM2 l)
- | _ => True
- end.
+ Fixpoint MPcond (LM1: list (C * Mon * Pol)) (l: list R) : Prop :=
+ match LM1 with
+ | (M1,P2) :: LM2 => ([fst M1] * (snd M1)@@l == P2@l) /\ MPcond LM2 l
+ | _ => True
+ end.
- Lemma PSubstL1_ok: forall n LM1 P1 l,
- MPcond LM1 l -> P1@l == (PSubstL1 P1 LM1 n)@l.
+ Lemma PSubstL1_ok n LM1 P1 l :
+ MPcond LM1 l -> P1@l == (PSubstL1 P1 LM1 n)@l.
Proof.
- intros n LM1; elim LM1; simpl; auto.
- intros; rsimpl.
- intros (M2,P2) LM2 Hrec P3 l [H H1].
- rewrite <- Hrec; auto.
- apply PNSubst1_ok; auto.
+ revert P1; induction LM1 as [|(M2,P2) LM2 IH]; simpl; intros.
+ - reflexivity.
+ - rewrite <- IH by intuition. now apply PNSubst1_ok.
Qed.
- Lemma PSubstL_ok: forall n LM1 P1 P2 l,
- PSubstL P1 LM1 n = Some P2 -> MPcond LM1 l -> P1@l == P2@l.
+ Lemma PSubstL_ok n LM1 P1 P2 l :
+ PSubstL P1 LM1 n = Some P2 -> MPcond LM1 l -> P1@l == P2@l.
Proof.
- intros n LM1; elim LM1; simpl; auto.
- intros; discriminate.
- intros (M2,P2) LM2 Hrec P3 P4 l.
- generalize (PNSubst_ok n P3 M2 P2); case (PNSubst P3 M2 P2 n).
- intros P5 H0 H1 [H2 H3]; injection H1; intros; subst.
- rewrite <- PSubstL1_ok; auto.
- intros l1 H [H1 H2]; auto.
+ revert P1. induction LM1 as [|(M2,P2') LM2 IH]; simpl; intros.
+ - discriminate.
+ - assert (H':=PNSubst_ok n P3 M2 P2'). destruct PNSubst.
+ * injection H; intros <-. rewrite <- PSubstL1_ok; intuition.
+ * now apply IH.
Qed.
- Lemma PNSubstL_ok: forall m n LM1 P1 l,
- MPcond LM1 l -> P1@l == (PNSubstL P1 LM1 m n)@l.
+ Lemma PNSubstL_ok m n LM1 P1 l :
+ MPcond LM1 l -> P1@l == (PNSubstL P1 LM1 m n)@l.
Proof.
- intros m; elim m; simpl; auto.
- intros n LM1 P2 l H; generalize (fun P3 => @PSubstL_ok n LM1 P2 P3 l);
- case (PSubstL P2 LM1 n); intros; rsimpl; auto.
- intros m1 Hrec n LM1 P2 l H.
- generalize (fun P3 => @PSubstL_ok n LM1 P2 P3 l);
- case (PSubstL P2 LM1 n); intros; rsimpl; auto.
- rewrite <- Hrec; auto.
+ revert LM1 P1. induction m; simpl; intros;
+ assert (H' := PSubstL_ok n LM1 P2); destruct PSubstL;
+ auto; try reflexivity.
+ rewrite <- IHm; auto.
Qed.
(** Definition of polynomial expressions *)
@@ -1190,58 +935,22 @@ Strategy expand [PEeval].
(** Correctness proofs *)
- Lemma mkX_ok : forall p l, nth 0 p l == (mk_X p) @ l.
+ Lemma mkX_ok p l : nth 0 p l == (mk_X p) @ l.
Proof.
destruct p;simpl;intros;Esimpl;trivial.
- rewrite <-jump_tl;rewrite nth_jump;rrefl.
- rewrite <- nth_jump.
- rewrite nth_Pdouble_minus_one;rrefl.
+ - now rewrite <-jump_tl, nth_jump.
+ - now rewrite <- nth_jump, nth_pred_double.
Qed.
- Ltac Esimpl3 :=
- repeat match goal with
- | |- context [(?P1 ++ ?P2)@?l] => rewrite (Padd_ok P2 P1 l)
- | |- context [(?P1 -- ?P2)@?l] => rewrite (Psub_ok P2 P1 l)
- end;Esimpl2;try rrefl;try apply (ARadd_comm ARth).
-
-(* Power using the chinise algorithm *)
-(*Section POWER.
- Variable subst_l : Pol -> Pol.
- Fixpoint Ppow_pos (P:Pol) (p:positive){struct p} : Pol :=
- match p with
- | xH => P
- | xO p => subst_l (Psquare (Ppow_pos P p))
- | xI p => subst_l (Pmul P (Psquare (Ppow_pos P p)))
- end.
-
- Definition Ppow_N P n :=
- match n with
- | N0 => P1
- | Npos p => Ppow_pos P p
- end.
-
- Lemma Ppow_pos_ok : forall l, (forall P, subst_l P@l == P@l) ->
- forall P p, (Ppow_pos P p)@l == (pow_pos Pmul P p)@l.
- Proof.
- intros l subst_l_ok P.
- induction p;simpl;intros;try rrefl;try rewrite subst_l_ok.
- repeat rewrite Pmul_ok;rewrite Psquare_ok;rewrite IHp;rrefl.
- repeat rewrite Pmul_ok;rewrite Psquare_ok;rewrite IHp;rrefl.
- Qed.
-
- Lemma Ppow_N_ok : forall l, (forall P, subst_l P@l == P@l) ->
- forall P n, (Ppow_N P n)@l == (pow_N P1 Pmul P n)@l.
- Proof. destruct n;simpl. rrefl. apply Ppow_pos_ok. trivial. Qed.
-
- End POWER. *)
+ Hint Rewrite Padd_ok Psub_ok : Esimpl.
Section POWER.
Variable subst_l : Pol -> Pol.
- Fixpoint Ppow_pos (res P:Pol) (p:positive){struct p} : Pol :=
+ Fixpoint Ppow_pos (res P:Pol) (p:positive) : Pol :=
match p with
- | xH => subst_l (Pmul res P)
+ | xH => subst_l (res ** P)
| xO p => Ppow_pos (Ppow_pos res P p) P p
- | xI p => subst_l (Pmul (Ppow_pos (Ppow_pos res P p) P p) P)
+ | xI p => subst_l ((Ppow_pos (Ppow_pos res P p) P p) ** P)
end.
Definition Ppow_N P n :=
@@ -1250,17 +959,23 @@ Section POWER.
| Npos p => Ppow_pos P1 P p
end.
- Lemma Ppow_pos_ok : forall l, (forall P, subst_l P@l == P@l) ->
- forall res P p, (Ppow_pos res P p)@l == res@l * (pow_pos Pmul P p)@l.
+ Lemma Ppow_pos_ok l :
+ (forall P, subst_l P@l == P@l) ->
+ forall res P p, (Ppow_pos res P p)@l == res@l * (pow_pos Pmul P p)@l.
Proof.
- intros l subst_l_ok res P p. generalize res;clear res.
- induction p;simpl;intros;try rewrite subst_l_ok; repeat rewrite Pmul_ok;repeat rewrite IHp.
- rsimpl. mul_push (P@l);rsimpl. rsimpl. rrefl.
+ intros subst_l_ok res P p. revert res.
+ induction p;simpl;intros; rewrite ?subst_l_ok, ?Pmul_ok, ?IHp;
+ mul_permut.
Qed.
- Lemma Ppow_N_ok : forall l, (forall P, subst_l P@l == P@l) ->
- forall P n, (Ppow_N P n)@l == (pow_N P1 Pmul P n)@l.
- Proof. destruct n;simpl. rrefl. rewrite Ppow_pos_ok by trivial. Esimpl. Qed.
+ Lemma Ppow_N_ok l :
+ (forall P, subst_l P@l == P@l) ->
+ forall P n, (Ppow_N P n)@l == (pow_N P1 Pmul P n)@l.
+ Proof.
+ destruct n;simpl.
+ - reflexivity.
+ - rewrite Ppow_pos_ok by trivial. Esimpl.
+ Qed.
End POWER.
@@ -1277,69 +992,66 @@ Section POWER.
match pe with
| PEc c => Pc c
| PEX j => mk_X j
- | PEadd (PEopp pe1) pe2 => Psub (norm_aux pe2) (norm_aux pe1)
- | PEadd pe1 (PEopp pe2) =>
- Psub (norm_aux pe1) (norm_aux pe2)
- | PEadd pe1 pe2 => Padd (norm_aux pe1) (norm_aux pe2)
- | PEsub pe1 pe2 => Psub (norm_aux pe1) (norm_aux pe2)
- | PEmul pe1 pe2 => Pmul (norm_aux pe1) (norm_aux pe2)
- | PEopp pe1 => Popp (norm_aux pe1)
+ | PEadd (PEopp pe1) pe2 => (norm_aux pe2) -- (norm_aux pe1)
+ | PEadd pe1 (PEopp pe2) => (norm_aux pe1) -- (norm_aux pe2)
+ | PEadd pe1 pe2 => (norm_aux pe1) ++ (norm_aux pe2)
+ | PEsub pe1 pe2 => (norm_aux pe1) -- (norm_aux pe2)
+ | PEmul pe1 pe2 => (norm_aux pe1) ** (norm_aux pe2)
+ | PEopp pe1 => -- (norm_aux pe1)
| PEpow pe1 n => Ppow_N (fun p => p) (norm_aux pe1) n
end.
Definition norm_subst pe := subst_l (norm_aux pe).
- (*
- Fixpoint norm_subst (pe:PExpr) : Pol :=
+ (** Internally, [norm_aux] is expanded in a large number of cases.
+ To speed-up proofs, we use an alternative definition. *)
+
+ Definition get_PEopp pe :=
match pe with
- | PEc c => Pc c
- | PEX j => subst_l (mk_X j)
- | PEadd (PEopp pe1) pe2 => Psub (norm_subst pe2) (norm_subst pe1)
- | PEadd pe1 (PEopp pe2) =>
- Psub (norm_subst pe1) (norm_subst pe2)
- | PEadd pe1 pe2 => Padd (norm_subst pe1) (norm_subst pe2)
- | PEsub pe1 pe2 => Psub (norm_subst pe1) (norm_subst pe2)
- | PEmul pe1 pe2 => Pmul_subst (norm_subst pe1) (norm_subst pe2)
- | PEopp pe1 => Popp (norm_subst pe1)
- | PEpow pe1 n => Ppow_subst (norm_subst pe1) n
+ | PEopp pe' => Some pe'
+ | _ => None
end.
- Lemma norm_subst_spec :
- forall l pe, MPcond lmp l ->
- PEeval l pe == (norm_subst pe)@l.
+ Lemma norm_aux_PEadd pe1 pe2 :
+ norm_aux (PEadd pe1 pe2) =
+ match get_PEopp pe1, get_PEopp pe2 with
+ | Some pe1', _ => (norm_aux pe2) -- (norm_aux pe1')
+ | None, Some pe2' => (norm_aux pe1) -- (norm_aux pe2')
+ | None, None => (norm_aux pe1) ++ (norm_aux pe2)
+ end.
Proof.
- intros;assert (subst_l_ok:forall P, (subst_l P)@l == P@l).
- unfold subst_l;intros.
- rewrite <- PNSubstL_ok;trivial. rrefl.
- assert (Pms_ok:forall P1 P2, (Pmul_subst P1 P2)@l == P1@l*P2@l).
- intros;unfold Pmul_subst;rewrite subst_l_ok;rewrite Pmul_ok;rrefl.
- induction pe;simpl;Esimpl3.
- rewrite subst_l_ok;apply mkX_ok.
- rewrite IHpe1;rewrite IHpe2;destruct pe1;destruct pe2;Esimpl3.
- rewrite IHpe1;rewrite IHpe2;rrefl.
- rewrite Pms_ok;rewrite IHpe1;rewrite IHpe2;rrefl.
- rewrite IHpe;rrefl.
- unfold Ppow_subst. rewrite Ppow_N_ok. trivial.
- rewrite pow_th.(rpow_pow_N). destruct n0;Esimpl3.
- induction p;simpl;try rewrite IHp;try rewrite IHpe;repeat rewrite Pms_ok;
- repeat rewrite Pmul_ok;rrefl.
+ simpl (norm_aux (PEadd _ _)).
+ destruct pe1; [ | | | | | reflexivity | ];
+ destruct pe2; simpl get_PEopp; reflexivity.
Qed.
-*)
- Lemma norm_aux_spec :
- forall l pe, MPcond lmp l ->
- PEeval l pe == (norm_aux pe)@l.
+
+ Lemma norm_aux_PEopp pe :
+ match get_PEopp pe with
+ | Some pe' => norm_aux pe = -- (norm_aux pe')
+ | None => True
+ end.
+ Proof.
+ now destruct pe.
+ Qed.
+
+ Lemma norm_aux_spec l pe :
+ PEeval l pe == (norm_aux pe)@l.
Proof.
intros.
- induction pe;simpl;Esimpl3.
- apply mkX_ok.
- rewrite IHpe1;rewrite IHpe2;destruct pe1;destruct pe2;Esimpl3.
- rewrite IHpe1;rewrite IHpe2;rrefl.
- rewrite IHpe1;rewrite IHpe2. rewrite Pmul_ok. rrefl.
- rewrite IHpe;rrefl.
- rewrite Ppow_N_ok by (intros;rrefl).
- rewrite pow_th.(rpow_pow_N). destruct n0;Esimpl3.
- induction p;simpl;try rewrite IHp;try rewrite IHpe;repeat rewrite Pms_ok;
- repeat rewrite Pmul_ok;rrefl.
+ induction pe.
+ - reflexivity.
+ - apply mkX_ok.
+ - simpl PEeval. rewrite IHpe1, IHpe2.
+ assert (H1 := norm_aux_PEopp pe1).
+ assert (H2 := norm_aux_PEopp pe2).
+ rewrite norm_aux_PEadd.
+ do 2 destruct get_PEopp; rewrite ?H1, ?H2; Esimpl; add_permut.
+ - simpl. rewrite IHpe1, IHpe2. Esimpl.
+ - simpl. rewrite IHpe1, IHpe2. now rewrite Pmul_ok.
+ - simpl. rewrite IHpe. Esimpl.
+ - simpl. rewrite Ppow_N_ok by reflexivity.
+ rewrite pow_th.(rpow_pow_N). destruct n0; simpl; Esimpl.
+ induction p;simpl; now rewrite ?IHp, ?IHpe, ?Pms_ok, ?Pmul_ok.
Qed.
Lemma norm_subst_spec :
@@ -1347,7 +1059,7 @@ Section POWER.
PEeval l pe == (norm_subst pe)@l.
Proof.
intros;unfold norm_subst.
- unfold subst_l;rewrite <- PNSubstL_ok;trivial. apply norm_aux_spec. trivial.
+ unfold subst_l;rewrite <- PNSubstL_ok;trivial. apply norm_aux_spec.
Qed.
End NORM_SUBST_REC.
@@ -1514,27 +1226,27 @@ Section POWER.
(rP:R) (P:Pol) (fv:list R) (n:N) (lm:list (R*positive)) {struct P} : R :=
match P with
| Pc c =>
- let lm := add_pow_list (hd 0 fv) n lm in
+ let lm := add_pow_list (hd fv) n lm in
mkadd_mult rP c lm
| Pinj j Q =>
- add_mult_dev rP Q (jump j fv) N0 (add_pow_list (hd 0 fv) n lm)
+ add_mult_dev rP Q (jump j fv) N0 (add_pow_list (hd fv) n lm)
| PX P i Q =>
- let rP := add_mult_dev rP P fv (Nplus (Npos i) n) lm in
+ let rP := add_mult_dev rP P fv (N.add (Npos i) n) lm in
if Q ?== P0 then rP
- else add_mult_dev rP Q (tail fv) N0 (add_pow_list (hd 0 fv) n lm)
+ else add_mult_dev rP Q (tail fv) N0 (add_pow_list (hd fv) n lm)
end.
Fixpoint mult_dev (P:Pol) (fv : list R) (n:N)
(lm:list (R*positive)) {struct P} : R :=
(* P@l * (hd 0 l)^n * lm *)
match P with
- | Pc c => mkmult_c c (add_pow_list (hd 0 fv) n lm)
- | Pinj j Q => mult_dev Q (jump j fv) N0 (add_pow_list (hd 0 fv) n lm)
+ | Pc c => mkmult_c c (add_pow_list (hd fv) n lm)
+ | Pinj j Q => mult_dev Q (jump j fv) N0 (add_pow_list (hd fv) n lm)
| PX P i Q =>
- let rP := mult_dev P fv (Nplus (Npos i) n) lm in
+ let rP := mult_dev P fv (N.add (Npos i) n) lm in
if Q ?== P0 then rP
else
- let lmq := add_pow_list (hd 0 fv) n lm in
+ let lmq := add_pow_list (hd fv) n lm in
add_mult_dev rP Q (tail fv) N0 lmq
end.
@@ -1575,7 +1287,7 @@ Section POWER.
(forall l lr : list (R * positive), r_list_pow (rev_append l lr) == r_list_pow lr * r_list_pow l).
induction l;intros;simpl;Esimpl.
destruct a;rewrite IHl;Esimpl.
- rewrite (ARmul_comm ARth (pow_pos rmul r p)). rrefl.
+ rewrite (ARmul_comm ARth (pow_pos rmul r p)). reflexivity.
intros;unfold rev'. rewrite H;simpl;Esimpl.
Qed.
@@ -1617,11 +1329,11 @@ Qed.
Qed.
Lemma add_mult_dev_ok : forall P rP fv n lm,
- add_mult_dev rP P fv n lm == rP + P@fv*pow_N rI rmul (hd 0 fv) n * r_list_pow lm.
+ add_mult_dev rP P fv n lm == rP + P@fv*pow_N rI rmul (hd fv) n * r_list_pow lm.
Proof.
induction P;simpl;intros.
- rewrite mkadd_mult_ok. rewrite add_pow_list_ok; Esimpl.
- rewrite IHP. simpl. rewrite add_pow_list_ok; Esimpl.
+ rewrite mkadd_mult_ok. rewrite add_pow_list_ok; Esimpl.
+ rewrite IHP. simpl. rewrite add_pow_list_ok; Esimpl.
change (match P3 with
| Pc c => c ?=! cO
| Pinj _ _ => false
@@ -1630,17 +1342,19 @@ Qed.
change match n with
| N0 => Npos p
| Npos q => Npos (p + q)
- end with (Nplus (Npos p) n);trivial.
+ end with (N.add (Npos p) n);trivial.
assert (H := Peq_ok P3 P0).
destruct (P3 ?== P0).
- rewrite (H (refl_equal true)).
- rewrite IHP1. destruct n;simpl;Esimpl;rewrite pow_pos_Pplus;Esimpl.
- rewrite IHP2.
- rewrite IHP1. destruct n;simpl;Esimpl;rewrite pow_pos_Pplus;Esimpl.
+ rewrite (H eq_refl).
+ rewrite IHP1. destruct n;simpl;Esimpl;rewrite pow_pos_add;Esimpl.
+ add_permut. mul_permut.
+ rewrite IHP2.
+ rewrite IHP1. destruct n;simpl;Esimpl;rewrite pow_pos_add;Esimpl.
+ add_permut. mul_permut.
Qed.
Lemma mult_dev_ok : forall P fv n lm,
- mult_dev P fv n lm == P@fv * pow_N rI rmul (hd 0 fv) n * r_list_pow lm.
+ mult_dev P fv n lm == P@fv * pow_N rI rmul (hd fv) n * r_list_pow lm.
Proof.
induction P;simpl;intros;Esimpl.
rewrite mkmult_c_ok;rewrite add_pow_list_ok;Esimpl.
@@ -1653,13 +1367,15 @@ Qed.
change match n with
| N0 => Npos p
| Npos q => Npos (p + q)
- end with (Nplus (Npos p) n);trivial.
+ end with (N.add (Npos p) n);trivial.
assert (H := Peq_ok P3 P0).
destruct (P3 ?== P0).
- rewrite (H (refl_equal true)).
- rewrite IHP1. destruct n;simpl;Esimpl;rewrite pow_pos_Pplus;Esimpl.
+ rewrite (H eq_refl).
+ rewrite IHP1. destruct n;simpl;Esimpl;rewrite pow_pos_add;Esimpl.
+ mul_permut.
rewrite add_mult_dev_ok. rewrite IHP1; rewrite add_pow_list_ok.
- destruct n;simpl;Esimpl;rewrite pow_pos_Pplus;Esimpl.
+ destruct n;simpl;Esimpl;rewrite pow_pos_add;Esimpl.
+ add_permut; mul_permut.
Qed.
Lemma Pphi_avoid_ok : forall P fv, Pphi_avoid fv P == P@fv.
@@ -1676,18 +1392,18 @@ Qed.
let mkmult_pow r x p := rmul r (mkpow x p) in
Pphi_avoid mkpow mkopp_pow mkmult_pow.
- Lemma local_mkpow_ok :
- forall (r : R) (p : positive),
+ Lemma local_mkpow_ok r p :
match p with
| xI _ => rpow r (Cp_phi (Npos p))
| xO _ => rpow r (Cp_phi (Npos p))
| 1 => r
end == pow_pos rmul r p.
- Proof. intros r p;destruct p;try rewrite pow_th.(rpow_pow_N);reflexivity. Qed.
+ Proof. destruct p; now rewrite ?pow_th.(rpow_pow_N). Qed.
Lemma Pphi_pow_ok : forall P fv, Pphi_pow fv P == P@fv.
Proof.
- unfold Pphi_pow;intros;apply Pphi_avoid_ok;intros;try rewrite local_mkpow_ok;rrefl.
+ unfold Pphi_pow;intros;apply Pphi_avoid_ok;intros;
+ now rewrite ?local_mkpow_ok.
Qed.
Lemma ring_rw_pow_correct : forall n lH l,
@@ -1697,7 +1413,7 @@ Qed.
PEeval l pe == Pphi_pow l npe.
Proof.
intros n lH l H1 lmp Heq1 pe npe Heq2.
- rewrite Pphi_pow_ok. rewrite <- Heq2;rewrite <- Heq1.
+ rewrite Pphi_pow_ok, <- Heq2, <- Heq1.
apply norm_subst_ok. trivial.
Qed.
@@ -1711,58 +1427,48 @@ Qed.
Definition mkpow x p :=
match p with
| xH => x
- | xO p => mkmult_pow x x (Pdouble_minus_one p)
+ | xO p => mkmult_pow x x (Pos.pred_double p)
| xI p => mkmult_pow x x (xO p)
end.
Definition mkopp_pow x p :=
match p with
| xH => -x
- | xO p => mkmult_pow (-x) x (Pdouble_minus_one p)
+ | xO p => mkmult_pow (-x) x (Pos.pred_double p)
| xI p => mkmult_pow (-x) x (xO p)
end.
Definition Pphi_dev := Pphi_avoid mkpow mkopp_pow mkmult_pow.
- Lemma mkmult_pow_ok : forall p r x, mkmult_pow r x p == r*pow_pos rmul x p.
+ Lemma mkmult_pow_ok p r x : mkmult_pow r x p == r * x^p.
Proof.
- induction p;intros;simpl;Esimpl.
- repeat rewrite IHp;Esimpl.
- repeat rewrite IHp;Esimpl.
+ revert r; induction p;intros;simpl;Esimpl;rewrite !IHp;Esimpl.
Qed.
- Lemma mkpow_ok : forall p x, mkpow x p == pow_pos rmul x p.
+ Lemma mkpow_ok p x : mkpow x p == x^p.
Proof.
destruct p;simpl;intros;Esimpl.
- repeat rewrite mkmult_pow_ok;Esimpl.
- rewrite mkmult_pow_ok;Esimpl.
- pattern x at 1;replace x with (pow_pos rmul x 1).
- rewrite <- pow_pos_Pplus.
- rewrite <- Pplus_one_succ_l.
- rewrite Psucc_o_double_minus_one_eq_xO.
- simpl;Esimpl.
- trivial.
+ - rewrite !mkmult_pow_ok;Esimpl.
+ - rewrite mkmult_pow_ok;Esimpl.
+ change x with (x^1) at 1.
+ now rewrite <- pow_pos_add, Pos.add_1_r, Pos.succ_pred_double.
Qed.
- Lemma mkopp_pow_ok : forall p x, mkopp_pow x p == - pow_pos rmul x p.
+ Lemma mkopp_pow_ok p x : mkopp_pow x p == - x^p.
Proof.
destruct p;simpl;intros;Esimpl.
- repeat rewrite mkmult_pow_ok;Esimpl.
- rewrite mkmult_pow_ok;Esimpl.
- pattern x at 1;replace x with (pow_pos rmul x 1).
- rewrite <- pow_pos_Pplus.
- rewrite <- Pplus_one_succ_l.
- rewrite Psucc_o_double_minus_one_eq_xO.
- simpl;Esimpl.
- trivial.
+ - rewrite !mkmult_pow_ok;Esimpl.
+ - rewrite mkmult_pow_ok;Esimpl.
+ change x with (x^1) at 1.
+ now rewrite <- pow_pos_add, Pos.add_1_r, Pos.succ_pred_double.
Qed.
Lemma Pphi_dev_ok : forall P fv, Pphi_dev fv P == P@fv.
Proof.
unfold Pphi_dev;intros;apply Pphi_avoid_ok.
- intros;apply mkpow_ok.
- intros;apply mkopp_pow_ok.
- intros;apply mkmult_pow_ok.
+ - intros;apply mkpow_ok.
+ - intros;apply mkopp_pow_ok.
+ - intros;apply mkmult_pow_ok.
Qed.
Lemma ring_rw_correct : forall n lH l,
@@ -1776,6 +1482,4 @@ Qed.
apply norm_subst_ok. trivial.
Qed.
-
End MakeRingPol.
-
diff --git a/plugins/setoid_ring/Ring_tac.v b/plugins/setoid_ring/Ring_tac.v
index d33e9a82..7a7ffcfd 100644
--- a/plugins/setoid_ring/Ring_tac.v
+++ b/plugins/setoid_ring/Ring_tac.v
@@ -3,6 +3,7 @@ Require Import Setoid.
Require Import BinPos.
Require Import Ring_polynom.
Require Import BinList.
+Require Export ListTactics.
Require Import InitialRing.
Require Import Quote.
Declare ML Module "newring_plugin".
@@ -14,7 +15,7 @@ Ltac compute_assertion eqn t' t :=
let nft := eval vm_compute in t in
pose (t' := nft);
assert (eqn : t = t');
- [vm_cast_no_check (refl_equal t')|idtac].
+ [vm_cast_no_check (eq_refl t')|idtac].
Ltac relation_carrier req :=
let ty := type of req in
@@ -340,7 +341,7 @@ Ltac Ring RNG lemma lH :=
|| idtac "can not automatically proof hypothesis :";
idtac " maybe a left member of a hypothesis is not a monomial")
| vm_compute;
- (exact (refl_equal true) || fail "not a valid ring equation")]).
+ (exact (eq_refl true) || fail "not a valid ring equation")]).
Ltac Ring_norm_gen f RNG lemma lH rl :=
let mkFV := get_RingFV RNG in
@@ -385,7 +386,7 @@ Ltac Ring_simplify_gen f RNG lH rl :=
let lemma := get_SimplifyLemma RNG in
let l := fresh "to_rewrite" in
pose (l:= rl);
- generalize (refl_equal l);
+ generalize (eq_refl l);
unfold l at 2;
get_Pre RNG ();
let rl :=
diff --git a/plugins/setoid_ring/Ring_theory.v b/plugins/setoid_ring/Ring_theory.v
index ab992552..42ce4edc 100644
--- a/plugins/setoid_ring/Ring_theory.v
+++ b/plugins/setoid_ring/Ring_theory.v
@@ -1,14 +1,12 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
-Require Import Setoid.
-Require Import BinPos.
-Require Import BinNat.
+Require Import Setoid Morphisms BinPos BinNat.
Set Implicit Arguments.
@@ -35,48 +33,42 @@ Section Power.
Variable rI : R.
Variable rmul : R -> R -> R.
Variable req : R -> R -> Prop.
- Variable Rsth : Setoid_Theory R req.
- Notation "x * y " := (rmul x y).
- Notation "x == y" := (req x y).
+ Variable Rsth : Equivalence req.
+ Infix "*" := rmul.
+ Infix "==" := req.
- Hypothesis mul_ext :
- forall x1 x2, x1 == x2 -> forall y1 y2, y1 == y2 -> x1 * y1 == x2 * y2.
- Hypothesis mul_comm : forall x y, x * y == y * x.
+ Hypothesis mul_ext : Proper (req ==> req ==> req) rmul.
Hypothesis mul_assoc : forall x y z, x * (y * z) == (x * y) * z.
- Add Setoid R req Rsth as R_set_Power.
- Add Morphism rmul : rmul_ext_Power. exact mul_ext. Qed.
-
- Fixpoint pow_pos (x:R) (i:positive) {struct i}: R :=
+ Fixpoint pow_pos (x:R) (i:positive) : R :=
match i with
| xH => x
- | xO i => let p := pow_pos x i in rmul p p
- | xI i => let p := pow_pos x i in rmul x (rmul p p)
+ | xO i => let p := pow_pos x i in p * p
+ | xI i => let p := pow_pos x i in x * (p * p)
end.
- Lemma pow_pos_Psucc : forall x j, pow_pos x (Psucc j) == x * pow_pos x j.
+ Lemma pow_pos_swap x j : pow_pos x j * x == x * pow_pos x j.
Proof.
- induction j;simpl.
- rewrite IHj.
- rewrite (mul_comm x (pow_pos x j *pow_pos x j)).
- setoid_rewrite (mul_comm x (pow_pos x j)) at 2.
- repeat rewrite mul_assoc. apply (Seq_refl _ _ Rsth).
- repeat rewrite mul_assoc. apply (Seq_refl _ _ Rsth).
- apply (Seq_refl _ _ Rsth).
+ induction j; simpl; rewrite <- ?mul_assoc.
+ - f_equiv. now do 2 (rewrite IHj, mul_assoc).
+ - now do 2 (rewrite IHj, mul_assoc).
+ - reflexivity.
Qed.
- Lemma pow_pos_Pplus : forall x i j, pow_pos x (i + j) == pow_pos x i * pow_pos x j.
+ Lemma pow_pos_succ x j :
+ pow_pos x (Pos.succ j) == x * pow_pos x j.
Proof.
- intro x;induction i;intros.
- rewrite xI_succ_xO;rewrite Pplus_one_succ_r.
- rewrite <- Pplus_diag;repeat rewrite <- Pplus_assoc.
- repeat rewrite IHi.
- rewrite Pplus_comm;rewrite <- Pplus_one_succ_r;rewrite pow_pos_Psucc.
- simpl;repeat rewrite mul_assoc. apply (Seq_refl _ _ Rsth).
- rewrite <- Pplus_diag;repeat rewrite <- Pplus_assoc.
- repeat rewrite IHi;rewrite mul_assoc. apply (Seq_refl _ _ Rsth).
- rewrite Pplus_comm;rewrite <- Pplus_one_succ_r;rewrite pow_pos_Psucc;
- simpl. apply (Seq_refl _ _ Rsth).
+ induction j; simpl; try reflexivity.
+ rewrite IHj, <- mul_assoc; f_equiv.
+ now rewrite mul_assoc, pow_pos_swap, mul_assoc.
+ Qed.
+
+ Lemma pow_pos_add x i j :
+ pow_pos x (i + j) == pow_pos x i * pow_pos x j.
+ Proof.
+ induction i using Pos.peano_ind.
+ - now rewrite Pos.add_1_l, pow_pos_succ.
+ - now rewrite Pos.add_succ_l, !pow_pos_succ, IHi, mul_assoc.
Qed.
Definition pow_N (x:R) (p:N) :=
@@ -87,9 +79,9 @@ Section Power.
Definition id_phi_N (x:N) : N := x.
- Lemma pow_N_pow_N : forall x n, pow_N x (id_phi_N n) == pow_N x n.
+ Lemma pow_N_pow_N x n : pow_N x (id_phi_N n) == pow_N x n.
Proof.
- intros; apply (Seq_refl _ _ Rsth).
+ reflexivity.
Qed.
End Power.
@@ -98,19 +90,18 @@ Section DEFINITIONS.
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).
+ Notation "0" := rO. Notation "1" := rI.
+ Infix "==" := req. Infix "+" := radd. Infix "*" := rmul.
+ Infix "-" := rsub. Notation "- x" := (ropp x).
(** Semi Ring *)
Record semi_ring_theory : Prop := mk_srt {
SRadd_0_l : forall n, 0 + n == n;
- SRadd_comm : forall n m, n + m == m + n ;
+ SRadd_comm : forall n m, n + m == m + n ;
SRadd_assoc : forall n m p, n + (m + p) == (n + m) + p;
SRmul_1_l : forall n, 1*n == n;
SRmul_0_l : forall n, 0*n == 0;
- SRmul_comm : forall n m, n*m == m*n;
+ SRmul_comm : forall n m, n*m == m*n;
SRmul_assoc : forall n m p, n*(m*p) == (n*m)*p;
SRdistr_l : forall n m p, (n + m)*p == n*p + m*p
}.
@@ -119,11 +110,11 @@ Section DEFINITIONS.
(*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_comm : forall x y, x + y == y + x;
+ ARadd_comm : forall x y, x + y == y + x;
ARadd_assoc : forall x y z, x + (y + z) == (x + y) + z;
ARmul_1_l : forall x, 1 * x == x;
ARmul_0_l : forall x, 0 * x == 0;
- ARmul_comm : forall x y, x * y == y * x;
+ ARmul_comm : forall x y, x * y == y * x;
ARmul_assoc : forall x y z, x * (y * z) == (x * y) * z;
ARdistr_l : forall x y z, (x + y) * z == (x * z) + (y * z);
ARopp_mul_l : forall x y, -(x * y) == -x * y;
@@ -134,10 +125,10 @@ Section DEFINITIONS.
(** Ring *)
Record ring_theory : Prop := mk_rt {
Radd_0_l : forall x, 0 + x == x;
- Radd_comm : forall x y, x + y == y + x;
+ Radd_comm : forall x y, x + y == y + x;
Radd_assoc : forall x y z, x + (y + z) == (x + y) + z;
Rmul_1_l : forall x, 1 * x == x;
- Rmul_comm : forall x y, x * y == y * x;
+ Rmul_comm : forall x y, x * y == y * x;
Rmul_assoc : forall x y z, x * (y * z) == (x * y) * z;
Rdistr_l : forall x y z, (x + y) * z == (x * z) + (y * z);
Rsub_def : forall x y, x - y == x + -y;
@@ -148,19 +139,15 @@ Section DEFINITIONS.
Record sring_eq_ext : Prop := mk_seqe {
(* SRing operators are compatible with equality *)
- SRadd_ext :
- forall x1 x2, x1 == x2 -> forall y1 y2, y1 == y2 -> x1 + y1 == x2 + y2;
- SRmul_ext :
- forall x1 x2, x1 == x2 -> forall y1 y2, y1 == y2 -> x1 * y1 == x2 * y2
+ SRadd_ext : Proper (req ==> req ==> req) radd;
+ SRmul_ext : Proper (req ==> req ==> req) rmul
}.
Record ring_eq_ext : Prop := mk_reqe {
(* Ring operators are compatible with equality *)
- Radd_ext :
- forall x1 x2, x1 == x2 -> forall y1 y2, y1 == y2 -> x1 + y1 == x2 + y2;
- Rmul_ext :
- forall x1 x2, x1 == x2 -> forall y1 y2, y1 == y2 -> x1 * y1 == x2 * y2;
- Ropp_ext : forall x1 x2, x1 == x2 -> -x1 == -x2
+ Radd_ext : Proper (req ==> req ==> req) radd;
+ Rmul_ext : Proper (req ==> req ==> req) rmul;
+ Ropp_ext : Proper (req ==> req) ropp
}.
(** Interpretation morphisms definition*)
@@ -170,9 +157,9 @@ Section DEFINITIONS.
Variable ceqb : C->C->bool.
(* [phi] est un morphisme de [C] dans [R] *)
Variable phi : C -> R.
- Notation "x +! y" := (cadd x y). Notation "x -! y " := (csub x y).
- Notation "x *! y " := (cmul x y). Notation "-! x" := (copp x).
- Notation "x ?=! y" := (ceqb x y). Notation "[ x ]" := (phi x).
+ Infix "+!" := cadd. Infix "-!" := csub.
+ Infix "*!" := cmul. Notation "-! x" := (copp x).
+ Infix "?=!" := ceqb. Notation "[ x ]" := (phi x).
(*for semi rings*)
Record semi_morph : Prop := mkRmorph {
@@ -216,15 +203,13 @@ Section DEFINITIONS.
End MORPHISM.
(** Identity is a morphism *)
- Variable Rsth : Setoid_Theory R req.
- Add Setoid R req Rsth as R_setoid1.
+ Variable Rsth : Equivalence req.
Variable reqb : R->R->bool.
Hypothesis morph_req : forall x y, (reqb x y) = true -> x == y.
Definition IDphi (x:R) := x.
Lemma IDmorph : ring_morph rO rI radd rmul rsub ropp reqb IDphi.
Proof.
- apply (mkmorph rO rI radd rmul rsub ropp reqb IDphi);intros;unfold IDphi;
- try apply (Seq_refl _ _ Rsth);auto.
+ now apply (mkmorph rO rI radd rmul rsub ropp reqb IDphi).
Qed.
(** Specification of the power function *)
@@ -239,35 +224,31 @@ Section DEFINITIONS.
End POWER.
- Definition pow_N_th := mkpow_th id_phi_N (pow_N rI rmul) (pow_N_pow_N rI rmul Rsth).
+ Definition pow_N_th :=
+ mkpow_th id_phi_N (pow_N rI rmul) (pow_N_pow_N rI rmul Rsth).
End DEFINITIONS.
-
-
Section ALMOST_RING.
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).
+ Notation "0" := rO. Notation "1" := rI.
+ Infix "==" := req. Infix "+" := radd. Infix "* " := rmul.
+ Infix "-" := rsub. Notation "- x" := (ropp x).
(** Leibniz equality leads to a setoid theory and is extensional*)
- Lemma Eqsth : Setoid_Theory R (@eq R).
- Proof. constructor;red;intros;subst;trivial. Qed.
+ Lemma Eqsth : Equivalence (@eq R).
+ Proof. exact eq_equivalence. Qed.
Lemma Eq_s_ext : sring_eq_ext radd rmul (@eq R).
- Proof. constructor;intros;subst;trivial. Qed.
+ Proof. constructor;solve_proper. Qed.
Lemma Eq_ext : ring_eq_ext radd rmul ropp (@eq R).
- Proof. constructor;intros;subst;trivial. Qed.
+ Proof. constructor;solve_proper. Qed.
- Variable Rsth : Setoid_Theory R req.
- Add Setoid R req Rsth as R_setoid2.
- Ltac sreflexivity := apply (Seq_refl _ _ Rsth).
+ Variable Rsth : Equivalence req.
Section SEMI_RING.
Variable SReqe : sring_eq_ext radd rmul req.
@@ -282,23 +263,24 @@ Section ALMOST_RING.
Definition SRsub x y := x + -y. Notation "x - y " := (SRsub x y).
Lemma SRopp_ext : forall x y, x == y -> -x == -y.
- Proof. intros x y H;exact H. Qed.
+ Proof. intros x y H; exact H. Qed.
Lemma SReqe_Reqe : ring_eq_ext radd rmul SRopp req.
Proof.
- constructor. exact (SRadd_ext SReqe). exact (SRmul_ext SReqe).
- exact SRopp_ext.
+ constructor.
+ - exact (SRadd_ext SReqe).
+ - exact (SRmul_ext SReqe).
+ - exact SRopp_ext.
Qed.
Lemma SRopp_mul_l : forall x y, -(x * y) == -x * y.
- Proof. intros;sreflexivity. Qed.
+ Proof. reflexivity. Qed.
Lemma SRopp_add : forall x y, -(x + y) == -x + -y.
- Proof. intros;sreflexivity. Qed.
-
+ Proof. reflexivity. Qed.
Lemma SRsub_def : forall x y, x - y == x + -y.
- Proof. intros;sreflexivity. Qed.
+ Proof. reflexivity. Qed.
Lemma SRth_ARth : almost_ring_theory 0 1 radd rmul SRsub SRopp req.
Proof (mk_art 0 1 radd rmul SRsub SRopp req
@@ -315,7 +297,7 @@ Section ALMOST_RING.
Definition SRIDmorph : ring_morph 0 1 radd rmul SRsub SRopp req
0 1 radd rmul SRsub SRopp reqb (@IDphi R).
Proof.
- apply mkmorph;intros;try sreflexivity. unfold IDphi;auto.
+ now apply mkmorph.
Qed.
(* a semi_morph can be extended to a ring_morph for the almost_ring derived
@@ -331,9 +313,7 @@ Section ALMOST_RING.
ring_morph rO rI radd rmul SRsub SRopp req
cO cI cadd cmul cadd (fun x => x) ceqb phi.
Proof.
- case Smorph; intros; constructor; auto.
- unfold SRopp in |- *; intros.
- setoid_reflexivity.
+ case Smorph; now constructor.
Qed.
End SEMI_RING.
@@ -347,31 +327,28 @@ Section ALMOST_RING.
Variable Rth : ring_theory 0 1 radd rmul rsub ropp req.
(** Rings are almost rings*)
- Lemma Rmul_0_l : forall x, 0 * x == 0.
+ Lemma Rmul_0_l x : 0 * x == 0.
Proof.
- intro x; setoid_replace (0*x) with ((0+1)*x + -x).
- rewrite (Radd_0_l Rth); rewrite (Rmul_1_l Rth).
- rewrite (Ropp_def Rth);sreflexivity.
+ setoid_replace (0*x) with ((0+1)*x + -x).
+ now rewrite (Radd_0_l Rth), (Rmul_1_l Rth), (Ropp_def Rth).
- rewrite (Rdistr_l Rth);rewrite (Rmul_1_l Rth).
- rewrite <- (Radd_assoc Rth); rewrite (Ropp_def Rth).
- rewrite (Radd_comm Rth); rewrite (Radd_0_l Rth);sreflexivity.
+ rewrite (Rdistr_l Rth), (Rmul_1_l Rth).
+ rewrite <- (Radd_assoc Rth), (Ropp_def Rth).
+ now rewrite (Radd_comm Rth), (Radd_0_l Rth).
Qed.
- Lemma Ropp_mul_l : forall x y, -(x * y) == -x * y.
+ Lemma Ropp_mul_l x y : -(x * y) == -x * y.
Proof.
- intros x y;rewrite <-(Radd_0_l Rth (- x * y)).
- rewrite (Radd_comm Rth).
- rewrite <-(Ropp_def Rth (x*y)).
- rewrite (Radd_assoc Rth).
- rewrite <- (Rdistr_l Rth).
- rewrite (Rth.(Radd_comm) (-x));rewrite (Ropp_def Rth).
- rewrite Rmul_0_l;rewrite (Radd_0_l Rth);sreflexivity.
+ rewrite <-(Radd_0_l Rth (- x * y)).
+ rewrite (Radd_comm Rth), <-(Ropp_def Rth (x*y)).
+ rewrite (Radd_assoc Rth), <- (Rdistr_l Rth).
+ rewrite (Rth.(Radd_comm) (-x)), (Ropp_def Rth).
+ now rewrite Rmul_0_l, (Radd_0_l Rth).
Qed.
- Lemma Ropp_add : forall x y, -(x + y) == -x + -y.
+ Lemma Ropp_add x y : -(x + y) == -x + -y.
Proof.
- intros x y;rewrite <- ((Radd_0_l Rth) (-(x+y))).
+ rewrite <- ((Radd_0_l Rth) (-(x+y))).
rewrite <- ((Ropp_def Rth) x).
rewrite <- ((Radd_0_l Rth) (x + - x + - (x + y))).
rewrite <- ((Ropp_def Rth) y).
@@ -383,17 +360,17 @@ Section ALMOST_RING.
rewrite ((Radd_comm Rth) y).
rewrite <- ((Radd_assoc Rth) (- x)).
rewrite ((Radd_assoc Rth) y).
- rewrite ((Radd_comm Rth) y);rewrite (Ropp_def Rth).
- rewrite ((Radd_comm Rth) (-x) 0);rewrite (Radd_0_l Rth).
- apply (Radd_comm Rth).
+ rewrite ((Radd_comm Rth) y), (Ropp_def Rth).
+ rewrite ((Radd_comm Rth) (-x) 0), (Radd_0_l Rth).
+ now apply (Radd_comm Rth).
Qed.
- Lemma Ropp_opp : forall x, - -x == x.
+ Lemma Ropp_opp x : - -x == x.
Proof.
- intros x; rewrite <- (Radd_0_l Rth (- -x)).
+ rewrite <- (Radd_0_l Rth (- -x)).
rewrite <- (Ropp_def Rth x).
- rewrite <- (Radd_assoc Rth); rewrite (Ropp_def Rth).
- rewrite ((Radd_comm Rth) x);apply (Radd_0_l Rth).
+ rewrite <- (Radd_assoc Rth), (Ropp_def Rth).
+ rewrite ((Radd_comm Rth) x); now apply (Radd_0_l Rth).
Qed.
Lemma Rth_ARth : almost_ring_theory 0 1 radd rmul rsub ropp req.
@@ -407,10 +384,10 @@ Section ALMOST_RING.
Variable (cO cI : C) (cadd cmul csub: C->C->C) (copp : C -> C).
Variable (ceq : C -> C -> Prop) (ceqb : C -> C -> bool).
Variable phi : C -> R.
- Notation "x +! y" := (cadd x y). Notation "x *! y " := (cmul x y).
- Notation "x -! y " := (csub x y). Notation "-! x" := (copp x).
- Notation "x ?=! y" := (ceqb x y). Notation "[ x ]" := (phi x).
- Variable Csth : Setoid_Theory C ceq.
+ Infix "+!" := cadd. Infix "*!" := cmul.
+ Infix "-!" := csub. Notation "-! x" := (copp x).
+ Notation "?=!" := ceqb. Notation "[ x ]" := (phi x).
+ Variable Csth : Equivalence ceq.
Variable Ceqe : ring_eq_ext cadd cmul copp ceq.
Add Setoid C ceq Csth as C_setoid.
Add Morphism cadd : cadd_ext. exact (Radd_ext Ceqe). Qed.
@@ -420,9 +397,9 @@ Section ALMOST_RING.
Variable Smorph : semi_morph 0 1 radd rmul req cO cI cadd cmul ceqb phi.
Variable phi_ext : forall x y, ceq x y -> [x] == [y].
Add Morphism phi : phi_ext1. exact phi_ext. Qed.
- Lemma Smorph_opp : forall x, [-!x] == -[x].
+ Lemma Smorph_opp x : [-!x] == -[x].
Proof.
- intros x;rewrite <- (Rth.(Radd_0_l) [-!x]).
+ rewrite <- (Rth.(Radd_0_l) [-!x]).
rewrite <- ((Ropp_def Rth) [x]).
rewrite ((Radd_comm Rth) [x]).
rewrite <- (Radd_assoc Rth).
@@ -430,17 +407,18 @@ Section ALMOST_RING.
rewrite (Ropp_def Cth).
rewrite (Smorph0 Smorph).
rewrite (Radd_comm Rth (-[x])).
- apply (Radd_0_l Rth);sreflexivity.
+ now apply (Radd_0_l Rth).
Qed.
- Lemma Smorph_sub : forall x y, [x -! y] == [x] - [y].
+ Lemma Smorph_sub x y : [x -! y] == [x] - [y].
Proof.
- intros x y; rewrite (Rsub_def Cth);rewrite (Rsub_def Rth).
- rewrite (Smorph_add Smorph);rewrite Smorph_opp;sreflexivity.
+ rewrite (Rsub_def Cth), (Rsub_def Rth).
+ now rewrite (Smorph_add Smorph), Smorph_opp.
Qed.
- Lemma Smorph_morph : ring_morph 0 1 radd rmul rsub ropp req
- cO cI cadd cmul csub copp ceqb phi.
+ Lemma Smorph_morph :
+ ring_morph 0 1 radd rmul rsub ropp req
+ cO cI cadd cmul csub copp ceqb phi.
Proof
(mkmorph 0 1 radd rmul rsub ropp req cO cI cadd cmul csub copp ceqb phi
(Smorph0 Smorph) (Smorph1 Smorph)
@@ -458,17 +436,11 @@ elim ARth; intros.
constructor; trivial.
Qed.
- Lemma ARsub_ext :
- forall x1 x2, x1 == x2 -> forall y1 y2, y1 == y2 -> x1 - y1 == x2 - y2.
+ Instance ARsub_ext : Proper (req ==> req ==> req) rsub.
Proof.
- intros.
- setoid_replace (x1 - y1) with (x1 + -y1).
- setoid_replace (x2 - y2) with (x2 + -y2).
- rewrite H;rewrite H0;sreflexivity.
- apply (ARsub_def ARth).
- apply (ARsub_def ARth).
+ intros x1 x2 Ex y1 y2 Ey.
+ now rewrite !(ARsub_def ARth), Ex, Ey.
Qed.
- Add Morphism rsub : rsub_ext. exact ARsub_ext. Qed.
Ltac mrewrite :=
repeat first
@@ -479,64 +451,56 @@ Qed.
| rewrite (ARmul_0_l ARth)
| rewrite <- ((ARmul_comm ARth) 0)
| rewrite (ARdistr_l ARth)
- | sreflexivity
+ | reflexivity
| match goal with
| |- context [?z * (?x + ?y)] => rewrite ((ARmul_comm ARth) z (x+y))
end].
- Lemma ARadd_0_r : forall x, (x + 0) == x.
- Proof. intros; mrewrite. Qed.
+ Lemma ARadd_0_r x : x + 0 == x.
+ Proof. mrewrite. Qed.
- Lemma ARmul_1_r : forall x, x * 1 == x.
- Proof. intros;mrewrite. Qed.
+ Lemma ARmul_1_r x : x * 1 == x.
+ Proof. mrewrite. Qed.
- Lemma ARmul_0_r : forall x, x * 0 == 0.
- Proof. intros;mrewrite. Qed.
+ Lemma ARmul_0_r x : x * 0 == 0.
+ Proof. mrewrite. Qed.
- Lemma ARdistr_r : forall x y z, z * (x + y) == z*x + z*y.
+ Lemma ARdistr_r x y z : z * (x + y) == z*x + z*y.
Proof.
- intros;mrewrite.
- repeat rewrite (ARth.(ARmul_comm) z);sreflexivity.
+ mrewrite. now rewrite !(ARth.(ARmul_comm) z).
Qed.
- Lemma ARadd_assoc1 : forall x y z, (x + y) + z == (y + z) + x.
+ Lemma ARadd_assoc1 x y z : (x + y) + z == (y + z) + x.
Proof.
- intros;rewrite <-(ARth.(ARadd_assoc) x).
- rewrite (ARth.(ARadd_comm) x);sreflexivity.
+ now rewrite <-(ARth.(ARadd_assoc) x), (ARth.(ARadd_comm) x).
Qed.
- Lemma ARadd_assoc2 : forall x y z, (y + x) + z == (y + z) + x.
+ Lemma ARadd_assoc2 x y z : (y + x) + z == (y + z) + x.
Proof.
- intros; repeat rewrite <- (ARadd_assoc ARth);
- rewrite ((ARadd_comm ARth) x); sreflexivity.
+ now rewrite <- !(ARadd_assoc ARth), ((ARadd_comm ARth) x).
Qed.
- Lemma ARmul_assoc1 : forall x y z, (x * y) * z == (y * z) * x.
+ Lemma ARmul_assoc1 x y z : (x * y) * z == (y * z) * x.
Proof.
- intros;rewrite <-((ARmul_assoc ARth) x).
- rewrite ((ARmul_comm ARth) x);sreflexivity.
+ now rewrite <- ((ARmul_assoc ARth) x), ((ARmul_comm ARth) x).
Qed.
- Lemma ARmul_assoc2 : forall x y z, (y * x) * z == (y * z) * x.
+ Lemma ARmul_assoc2 x y z : (y * x) * z == (y * z) * x.
Proof.
- intros; repeat rewrite <- (ARmul_assoc ARth);
- rewrite ((ARmul_comm ARth) x); sreflexivity.
+ now rewrite <- !(ARmul_assoc ARth), ((ARmul_comm ARth) x).
Qed.
- Lemma ARopp_mul_r : forall x y, - (x * y) == x * -y.
+ Lemma ARopp_mul_r x y : - (x * y) == x * -y.
Proof.
- intros;rewrite ((ARmul_comm ARth) x y);
- rewrite (ARopp_mul_l ARth); apply (ARmul_comm ARth).
+ rewrite ((ARmul_comm ARth) x y), (ARopp_mul_l ARth).
+ now apply (ARmul_comm ARth).
Qed.
Lemma ARopp_zero : -0 == 0.
Proof.
- rewrite <- (ARmul_0_r 0); rewrite (ARopp_mul_l ARth).
- repeat rewrite ARmul_0_r; sreflexivity.
+ now rewrite <- (ARmul_0_r 0), (ARopp_mul_l ARth), !ARmul_0_r.
Qed.
-
-
End ALMOST_RING.
@@ -611,6 +575,8 @@ Ltac gen_add_push add Rsth Reqe ARth x :=
progress rewrite (ARadd_assoc2 Rsth Reqe ARth x y z)
| |- context [add (add x ?y) ?z] =>
progress rewrite (ARadd_assoc1 Rsth ARth x y z)
+ | |- context [(add x ?y)] =>
+ progress rewrite (ARadd_comm ARth x y)
end).
Ltac gen_mul_push mul Rsth Reqe ARth x :=
@@ -619,5 +585,6 @@ Ltac gen_mul_push mul Rsth Reqe ARth x :=
progress rewrite (ARmul_assoc2 Rsth Reqe ARth x y z)
| |- context [mul (mul x ?y) ?z] =>
progress rewrite (ARmul_assoc1 Rsth ARth x y z)
+ | |- context [(mul x ?y)] =>
+ progress rewrite (ARmul_comm ARth x y)
end).
-
diff --git a/plugins/setoid_ring/Rings_Z.v b/plugins/setoid_ring/Rings_Z.v
index 88904865..58a4d7ea 100644
--- a/plugins/setoid_ring/Rings_Z.v
+++ b/plugins/setoid_ring/Rings_Z.v
@@ -3,7 +3,7 @@ Require Export Integral_domain.
Require Export Ncring_initial.
Instance Zcri: (Cring (Rr:=Zr)).
-red. exact Zmult_comm. Defined.
+red. exact Z.mul_comm. Defined.
Lemma Z_one_zero: 1%Z <> 0%Z.
omega.
diff --git a/plugins/setoid_ring/ZArithRing.v b/plugins/setoid_ring/ZArithRing.v
index d3ed36ee..3c4f6b86 100644
--- a/plugins/setoid_ring/ZArithRing.v
+++ b/plugins/setoid_ring/ZArithRing.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -39,14 +39,14 @@ Ltac Zpower_neg :=
repeat match goal with
| [|- ?G] =>
match G with
- | context c [Zpower _ (Zneg _)] =>
+ | context c [Z.pow _ (Zneg _)] =>
let t := context c [Z0] in
change t
end
end.
Add Ring Zr : Zth
- (decidable Zeq_bool_eq, constants [Zcst], preprocess [Zpower_neg;unfold Zsucc],
+ (decidable Zeq_bool_eq, constants [Zcst], preprocess [Zpower_neg;unfold Z.succ],
power_tac Zpower_theory [Zpow_tac],
(* The two following option are not needed, it is the default chose when the set of
coefficiant is usual ring Z *)
diff --git a/plugins/setoid_ring/newring.ml4 b/plugins/setoid_ring/newring.ml4
index 9d61c06d..580e78f6 100644
--- a/plugins/setoid_ring/newring.ml4
+++ b/plugins/setoid_ring/newring.ml4
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/subtac/eterm.mli b/plugins/subtac/eterm.mli
index 03d76f29..a0b693de 100644
--- a/plugins/subtac/eterm.mli
+++ b/plugins/subtac/eterm.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/subtac/g_subtac.ml4 b/plugins/subtac/g_subtac.ml4
index 6a131d39..956ccf09 100644
--- a/plugins/subtac/g_subtac.ml4
+++ b/plugins/subtac/g_subtac.ml4
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/subtac/subtac.ml b/plugins/subtac/subtac.ml
index d626396f..281e981b 100644
--- a/plugins/subtac/subtac.ml
+++ b/plugins/subtac/subtac.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/subtac/subtac_cases.ml b/plugins/subtac/subtac_cases.ml
index 16d4e21e..221b57ee 100644
--- a/plugins/subtac/subtac_cases.ml
+++ b/plugins/subtac/subtac_cases.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/subtac/subtac_cases.mli b/plugins/subtac/subtac_cases.mli
index 77537d33..91142067 100644
--- a/plugins/subtac/subtac_cases.mli
+++ b/plugins/subtac/subtac_cases.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/subtac/subtac_classes.ml b/plugins/subtac/subtac_classes.ml
index 6b3fe718..f11f611f 100644
--- a/plugins/subtac/subtac_classes.ml
+++ b/plugins/subtac/subtac_classes.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/subtac/subtac_classes.mli b/plugins/subtac/subtac_classes.mli
index 5b5c0203..2c9fbaf5 100644
--- a/plugins/subtac/subtac_classes.mli
+++ b/plugins/subtac/subtac_classes.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/subtac/subtac_coercion.ml b/plugins/subtac/subtac_coercion.ml
index eb29bd04..168a799d 100644
--- a/plugins/subtac/subtac_coercion.ml
+++ b/plugins/subtac/subtac_coercion.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/subtac/subtac_command.ml b/plugins/subtac/subtac_command.ml
index ced390aa..14a09032 100644
--- a/plugins/subtac/subtac_command.ml
+++ b/plugins/subtac/subtac_command.ml
@@ -380,9 +380,16 @@ let rec unfold f b =
| Some (x, b') -> x :: unfold f b'
| None -> []
+
+let find_annot loc id ctx =
+ try rel_index id ctx
+ with Not_found ->
+ user_err_loc(loc,"",
+ str "No parameter named " ++ Nameops.pr_id id ++ str".")
+
let compute_possible_guardness_evidences (n,_) (_, fixctx) fixtype =
match n with
- | Some (loc, n) -> [rel_index n fixctx]
+ | Some (loc, id) -> [find_annot loc id fixctx]
| None ->
(* If recursive argument was not given by user, we try all args.
An earlier approach was to look only for inductive arguments,
diff --git a/plugins/subtac/subtac_pretyping.ml b/plugins/subtac/subtac_pretyping.ml
index e56fa4f5..fac6b567 100644
--- a/plugins/subtac/subtac_pretyping.ml
+++ b/plugins/subtac/subtac_pretyping.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/subtac/subtac_pretyping_F.ml b/plugins/subtac/subtac_pretyping_F.ml
index 9a4e1883..95e756ab 100644
--- a/plugins/subtac/subtac_pretyping_F.ml
+++ b/plugins/subtac/subtac_pretyping_F.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/syntax/nat_syntax.ml b/plugins/syntax/nat_syntax.ml
index 446ae522..63b44008 100644
--- a/plugins/syntax/nat_syntax.ml
+++ b/plugins/syntax/nat_syntax.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -28,9 +28,11 @@ open Names
(* Parsing via scopes *)
(* For example, (nat_of_string "3") is <<(S (S (S O)))>> *)
+let threshold = of_int 5000
+
let nat_of_int dloc n =
if is_pos_or_zero n then begin
- if less_than (of_string "5000") n then
+ if less_than threshold n then
Flags.if_warn msg_warning
(strbrk "Stack overflow or segmentation fault happens when " ++
strbrk "working with large numbers in nat (observed threshold " ++
diff --git a/plugins/syntax/numbers_syntax.ml b/plugins/syntax/numbers_syntax.ml
index 19a3c899..b8636a74 100644
--- a/plugins/syntax/numbers_syntax.ml
+++ b/plugins/syntax/numbers_syntax.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -50,26 +50,10 @@ let bigN_t = make_mind_mpdot bigN_module "BigN" "t'"
let bigN_scope = "bigN_scope"
(* number of inlined level of bigN (actually the level 0 to n_inlined-1 are inlined) *)
-let n_inlined = of_string "7"
-let bigN_constructor =
- (* converts a bigint into an int the ugly way *)
- let rec to_int i =
- if equal i zero then
- 0
- else
- let (quo,rem) = div2_with_rest i in
- if rem then
- 2*(to_int quo)+1
- else
- 2*(to_int quo)
- in
- fun i ->
- ConstructRef ((bigN_t,0),
- if less_than i n_inlined then
- (to_int i)+1
- else
- (to_int n_inlined)+1
- )
+let n_inlined = 7
+
+let bigN_constructor i =
+ ConstructRef ((bigN_t,0),(min i n_inlined)+1)
(*bigZ stuff*)
let bigZ_module = ["Coq"; "Numbers"; "Integer"; "BigZ"; "BigZ" ]
@@ -150,55 +134,54 @@ let _ = Notation.declare_numeral_interpreter int31_scope
(*** Parsing for bigN in digital notation ***)
(* the base for bigN (in Coq) that is 2^31 in our case *)
-let base = pow two (of_string "31")
+let base = pow two 31
-(* base of the bigN of height N : *)
-let rank n = pow base (pow two n)
+(* base of the bigN of height N : (2^31)^(2^n) *)
+let rank n =
+ let rec rk n pow2 =
+ if n <= 0 then pow2
+ else rk (n-1) (mult pow2 pow2)
+ in rk n base
(* splits a number bi at height n, that is the rest needs 2^n int31 to be stored
it is expected to be used only when the quotient would also need 2^n int31 to be
stored *)
let split_at n bi =
- euclid bi (rank (sub_1 n))
+ euclid bi (rank (n-1))
(* search the height of the Coq bigint needed to represent the integer bi *)
let height bi =
- let rec height_aux n =
- if less_than bi (rank n) then
- n
- else
- height_aux (add_1 n)
- in
- height_aux zero
-
+ let rec hght n pow2 =
+ if less_than bi pow2 then n
+ else hght (n+1) (mult pow2 pow2)
+ in hght 0 base
(* n must be a non-negative integer (from bigint.ml) *)
let word_of_pos_bigint dloc hght n =
let ref_W0 = GRef (dloc, zn2z_W0) in
let ref_WW = GRef (dloc, zn2z_WW) in
let rec decomp hgt n =
- if is_neg_or_zero hgt then
+ if hgt <= 0 then
int31_of_pos_bigint dloc n
else if equal n zero then
GApp (dloc, ref_W0, [GHole (dloc, Evd.InternalHole)])
else
let (h,l) = split_at hgt n in
GApp (dloc, ref_WW, [GHole (dloc, Evd.InternalHole);
- decomp (sub_1 hgt) h;
- decomp (sub_1 hgt) l])
+ decomp (hgt-1) h;
+ decomp (hgt-1) l])
in
decomp hght n
let bigN_of_pos_bigint dloc n =
- let ref_constructor i = GRef (dloc, bigN_constructor i) in
- let result h word = GApp (dloc, ref_constructor h, if less_than h n_inlined then
- [word]
- else
- [Nat_syntax.nat_of_int dloc (sub h n_inlined);
- word])
+ let h = height n in
+ let ref_constructor = GRef (dloc, bigN_constructor h) in
+ let word = word_of_pos_bigint dloc h n in
+ let args =
+ if h < n_inlined then [word]
+ else [Nat_syntax.nat_of_int dloc (of_int (h-n_inlined));word]
in
- let hght = height n in
- result hght (word_of_pos_bigint dloc hght n)
+ GApp (dloc, ref_constructor, args)
let bigN_error_negative dloc =
Util.user_err_loc (dloc, "interp_bigN", Pp.str "bigN are only non-negative numbers.")
@@ -216,22 +199,17 @@ let bigint_of_word =
let rec get_height rc =
match rc with
| GApp (_,GRef(_,c), [_;lft;rght]) when c = zn2z_WW ->
- let hleft = get_height lft in
- let hright = get_height rght in
- add_1
- (if less_than hleft hright then
- hright
- else
- hleft)
- | _ -> zero
+ 1+max (get_height lft) (get_height rght)
+ | _ -> 0
in
let rec transform hght rc =
match rc with
| GApp (_,GRef(_,c),_) when c = zn2z_W0-> zero
- | GApp (_,GRef(_,c), [_;lft;rght]) when c=zn2z_WW-> let new_hght = sub_1 hght in
- add (mult (rank new_hght)
- (transform (new_hght) lft))
- (transform (new_hght) rght)
+ | GApp (_,GRef(_,c), [_;lft;rght]) when c=zn2z_WW->
+ let new_hght = hght-1 in
+ add (mult (rank new_hght)
+ (transform new_hght lft))
+ (transform new_hght rght)
| _ -> bigint_of_int31 rc
in
fun rc ->
@@ -256,12 +234,12 @@ let uninterp_bigN rc =
let bigN_list_of_constructors =
let rec build i =
- if less_than i (add_1 n_inlined) then
- GRef (Util.dummy_loc, bigN_constructor i)::(build (add_1 i))
+ if i < n_inlined+1 then
+ GRef (Util.dummy_loc, bigN_constructor i)::(build (i+1))
else
[]
in
- build zero
+ build 0
(* Actually declares the interpreter for bigN *)
let _ = Notation.declare_numeral_interpreter bigN_scope
diff --git a/plugins/syntax/r_syntax.ml b/plugins/syntax/r_syntax.ml
index b9c0bcd6..401c23f7 100644
--- a/plugins/syntax/r_syntax.ml
+++ b/plugins/syntax/r_syntax.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/syntax/z_syntax.ml b/plugins/syntax/z_syntax.ml
index f8bce8f7..032e0036 100644
--- a/plugins/syntax/z_syntax.ml
+++ b/plugins/syntax/z_syntax.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/xml/dumptree.ml4 b/plugins/xml/dumptree.ml4
index 56ce7ef2..cbc52c5f 100644
--- a/plugins/xml/dumptree.ml4
+++ b/plugins/xml/dumptree.ml4
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)